summaryrefslogtreecommitdiff
path: root/theories
diff options
context:
space:
mode:
Diffstat (limited to 'theories')
-rw-r--r--theories/Arith/Arith.v2
-rw-r--r--theories/Arith/Arith_base.v4
-rw-r--r--theories/Arith/Between.v2
-rw-r--r--theories/Arith/Bool_nat.v2
-rw-r--r--theories/Arith/Compare.v2
-rw-r--r--theories/Arith/Compare_dec.v230
-rw-r--r--theories/Arith/Div2.v167
-rw-r--r--theories/Arith/EqNat.v100
-rw-r--r--theories/Arith/Euclid.v52
-rw-r--r--theories/Arith/Even.v299
-rw-r--r--theories/Arith/Factorial.v29
-rw-r--r--theories/Arith/Gt.v133
-rw-r--r--theories/Arith/Le.v122
-rw-r--r--theories/Arith/Lt.v172
-rw-r--r--theories/Arith/Max.v8
-rw-r--r--theories/Arith/Min.v8
-rw-r--r--theories/Arith/Minus.v139
-rw-r--r--theories/Arith/Mult.v201
-rw-r--r--theories/Arith/PeanoNat.v755
-rw-r--r--theories/Arith/Peano_dec.v65
-rw-r--r--theories/Arith/Plus.v191
-rw-r--r--theories/Arith/Wf_nat.v93
-rw-r--r--theories/Arith/vo.itarget1
-rw-r--r--theories/Bool/Bool.v12
-rw-r--r--theories/Bool/BoolEq.v2
-rw-r--r--theories/Bool/Bvector.v10
-rw-r--r--theories/Bool/DecBool.v2
-rw-r--r--theories/Bool/IfProp.v2
-rw-r--r--theories/Bool/Sumbool.v2
-rw-r--r--theories/Bool/Zerob.v2
-rw-r--r--theories/Classes/CEquivalence.v139
-rw-r--r--theories/Classes/CMorphisms.v701
-rw-r--r--theories/Classes/CRelationClasses.v359
-rw-r--r--theories/Classes/DecidableClass.v92
-rw-r--r--theories/Classes/EquivDec.v13
-rw-r--r--theories/Classes/Equivalence.v38
-rw-r--r--theories/Classes/Init.v2
-rw-r--r--theories/Classes/Morphisms.v577
-rw-r--r--theories/Classes/Morphisms_Prop.v59
-rw-r--r--theories/Classes/Morphisms_Relations.v10
-rw-r--r--theories/Classes/RelationClasses.v432
-rw-r--r--theories/Classes/RelationPairs.v116
-rw-r--r--theories/Classes/SetoidClass.v2
-rw-r--r--theories/Classes/SetoidDec.v6
-rw-r--r--theories/Classes/SetoidTactics.v3
-rw-r--r--theories/Classes/vo.itarget4
-rw-r--r--theories/FSets/FMapAVL.v62
-rw-r--r--theories/FSets/FMapFacts.v72
-rw-r--r--theories/FSets/FMapFullAVL.v12
-rw-r--r--theories/FSets/FMapList.v41
-rw-r--r--theories/FSets/FMapPositive.v119
-rw-r--r--theories/FSets/FMapWeakList.v27
-rw-r--r--theories/FSets/FSetBridge.v20
-rw-r--r--theories/FSets/FSetCompat.v2
-rw-r--r--theories/FSets/FSetDecide.v6
-rw-r--r--theories/FSets/FSetEqProperties.v2
-rw-r--r--theories/FSets/FSetInterface.v2
-rw-r--r--theories/FSets/FSetPositive.v95
-rw-r--r--theories/FSets/FSetProperties.v3
-rw-r--r--theories/Init/Datatypes.v25
-rw-r--r--theories/Init/Logic.v232
-rw-r--r--theories/Init/Logic_Type.v2
-rw-r--r--theories/Init/Nat.v297
-rw-r--r--theories/Init/Notations.v13
-rw-r--r--theories/Init/Peano.v139
-rw-r--r--theories/Init/Prelude.v6
-rw-r--r--theories/Init/Specif.v123
-rw-r--r--theories/Init/Tactics.v4
-rw-r--r--theories/Init/Wf.v22
-rw-r--r--theories/Init/vo.itarget1
-rw-r--r--theories/Lists/List.v1047
-rw-r--r--theories/Lists/ListDec.v103
-rw-r--r--theories/Lists/ListSet.v22
-rw-r--r--theories/Lists/ListTactics.v2
-rw-r--r--theories/Lists/SetoidList.v189
-rw-r--r--theories/Lists/SetoidPermutation.v3
-rw-r--r--theories/Lists/StreamMemo.v2
-rw-r--r--theories/Lists/Streams.v2
-rw-r--r--theories/Lists/vo.itarget1
-rw-r--r--theories/Logic/Berardi.v20
-rw-r--r--theories/Logic/ChoiceFacts.v65
-rw-r--r--theories/Logic/Classical.v2
-rw-r--r--theories/Logic/ClassicalChoice.v2
-rw-r--r--theories/Logic/ClassicalDescription.v2
-rw-r--r--theories/Logic/ClassicalEpsilon.v2
-rw-r--r--theories/Logic/ClassicalFacts.v109
-rw-r--r--theories/Logic/ClassicalUniqueChoice.v6
-rw-r--r--theories/Logic/Classical_Pred_Set.v48
-rw-r--r--theories/Logic/Classical_Pred_Type.v2
-rw-r--r--theories/Logic/Classical_Prop.v2
-rw-r--r--theories/Logic/Classical_Type.v14
-rw-r--r--theories/Logic/ConstructiveEpsilon.v14
-rw-r--r--theories/Logic/Decidable.v11
-rw-r--r--theories/Logic/Description.v4
-rw-r--r--theories/Logic/Diaconescu.v18
-rw-r--r--theories/Logic/Epsilon.v2
-rw-r--r--theories/Logic/Eqdep.v2
-rw-r--r--theories/Logic/EqdepFacts.v153
-rw-r--r--theories/Logic/Eqdep_dec.v124
-rw-r--r--theories/Logic/ExtensionalityFacts.v2
-rw-r--r--theories/Logic/FinFun.v400
-rw-r--r--theories/Logic/FunctionalExtensionality.v32
-rw-r--r--theories/Logic/Hurkens.v700
-rw-r--r--theories/Logic/IndefiniteDescription.v4
-rw-r--r--theories/Logic/JMeq.v8
-rw-r--r--theories/Logic/ProofIrrelevance.v2
-rw-r--r--theories/Logic/ProofIrrelevanceFacts.v4
-rw-r--r--theories/Logic/RelationalChoice.v2
-rw-r--r--theories/Logic/SetIsType.v4
-rw-r--r--theories/Logic/WKL.v261
-rw-r--r--theories/Logic/WeakFan.v105
-rw-r--r--theories/Logic/vo.itarget6
-rw-r--r--theories/MSets/MSetAVL.v5
-rw-r--r--theories/MSets/MSetDecide.v6
-rw-r--r--theories/MSets/MSetEqProperties.v5
-rw-r--r--theories/MSets/MSetGenTree.v24
-rw-r--r--theories/MSets/MSetInterface.v1
-rw-r--r--theories/MSets/MSetList.v21
-rw-r--r--theories/MSets/MSetPositive.v62
-rw-r--r--theories/MSets/MSetRBT.v21
-rw-r--r--theories/MSets/MSetWeakList.v18
-rw-r--r--theories/NArith/BinNat.v233
-rw-r--r--theories/NArith/BinNatDef.v10
-rw-r--r--theories/NArith/NArith.v2
-rw-r--r--theories/NArith/Ndec.v12
-rw-r--r--theories/NArith/Ndigits.v113
-rw-r--r--theories/NArith/Ndist.v59
-rw-r--r--theories/NArith/Ndiv_def.v2
-rw-r--r--theories/NArith/Ngcd_def.v2
-rw-r--r--theories/NArith/Nnat.v63
-rw-r--r--theories/NArith/Nsqrt_def.v2
-rw-r--r--theories/Numbers/BigNumPrelude.v2
-rw-r--r--theories/Numbers/BinNums.v4
-rw-r--r--theories/Numbers/Cyclic/Abstract/CyclicAxioms.v21
-rw-r--r--theories/Numbers/Cyclic/Abstract/NZCyclic.v8
-rw-r--r--theories/Numbers/Cyclic/DoubleCyclic/DoubleAdd.v37
-rw-r--r--theories/Numbers/Cyclic/DoubleCyclic/DoubleBase.v8
-rw-r--r--theories/Numbers/Cyclic/DoubleCyclic/DoubleCyclic.v164
-rw-r--r--theories/Numbers/Cyclic/DoubleCyclic/DoubleDiv.v44
-rw-r--r--theories/Numbers/Cyclic/DoubleCyclic/DoubleDivn1.v5
-rw-r--r--theories/Numbers/Cyclic/DoubleCyclic/DoubleLift.v2
-rw-r--r--theories/Numbers/Cyclic/DoubleCyclic/DoubleMul.v12
-rw-r--r--theories/Numbers/Cyclic/DoubleCyclic/DoubleSqrt.v20
-rw-r--r--theories/Numbers/Cyclic/DoubleCyclic/DoubleSub.v11
-rw-r--r--theories/Numbers/Cyclic/DoubleCyclic/DoubleType.v5
-rw-r--r--theories/Numbers/Cyclic/Int31/Cyclic31.v270
-rw-r--r--theories/Numbers/Cyclic/Int31/Int31.v15
-rw-r--r--theories/Numbers/Cyclic/Int31/Ring31.v2
-rw-r--r--theories/Numbers/Cyclic/ZModulo/ZModulo.v55
-rw-r--r--theories/Numbers/Integer/Abstract/ZAdd.v2
-rw-r--r--theories/Numbers/Integer/Abstract/ZAddOrder.v2
-rw-r--r--theories/Numbers/Integer/Abstract/ZAxioms.v2
-rw-r--r--theories/Numbers/Integer/Abstract/ZBase.v2
-rw-r--r--theories/Numbers/Integer/Abstract/ZBits.v2
-rw-r--r--theories/Numbers/Integer/Abstract/ZDivEucl.v2
-rw-r--r--theories/Numbers/Integer/Abstract/ZDivFloor.v2
-rw-r--r--theories/Numbers/Integer/Abstract/ZDivTrunc.v2
-rw-r--r--theories/Numbers/Integer/Abstract/ZGcd.v2
-rw-r--r--theories/Numbers/Integer/Abstract/ZLcm.v2
-rw-r--r--theories/Numbers/Integer/Abstract/ZLt.v2
-rw-r--r--theories/Numbers/Integer/Abstract/ZMaxMin.v2
-rw-r--r--theories/Numbers/Integer/Abstract/ZMul.v2
-rw-r--r--theories/Numbers/Integer/Abstract/ZMulOrder.v2
-rw-r--r--theories/Numbers/Integer/Abstract/ZParity.v2
-rw-r--r--theories/Numbers/Integer/Abstract/ZPow.v2
-rw-r--r--theories/Numbers/Integer/Abstract/ZProperties.v27
-rw-r--r--theories/Numbers/Integer/Abstract/ZSgnAbs.v2
-rw-r--r--theories/Numbers/Integer/BigZ/BigZ.v12
-rw-r--r--theories/Numbers/Integer/BigZ/ZMake.v4
-rw-r--r--theories/Numbers/Integer/Binary/ZBinary.v2
-rw-r--r--theories/Numbers/Integer/NatPairs/ZNatPairs.v6
-rw-r--r--theories/Numbers/Integer/SpecViaZ/ZSig.v2
-rw-r--r--theories/Numbers/Integer/SpecViaZ/ZSigZAxioms.v2
-rw-r--r--theories/Numbers/NaryFunctions.v2
-rw-r--r--theories/Numbers/NatInt/NZAdd.v2
-rw-r--r--theories/Numbers/NatInt/NZAddOrder.v2
-rw-r--r--theories/Numbers/NatInt/NZAxioms.v5
-rw-r--r--theories/Numbers/NatInt/NZBase.v7
-rw-r--r--theories/Numbers/NatInt/NZBits.v2
-rw-r--r--theories/Numbers/NatInt/NZDiv.v2
-rw-r--r--theories/Numbers/NatInt/NZDomain.v40
-rw-r--r--theories/Numbers/NatInt/NZGcd.v6
-rw-r--r--theories/Numbers/NatInt/NZLog.v2
-rw-r--r--theories/Numbers/NatInt/NZMul.v2
-rw-r--r--theories/Numbers/NatInt/NZMulOrder.v2
-rw-r--r--theories/Numbers/NatInt/NZOrder.v6
-rw-r--r--theories/Numbers/NatInt/NZParity.v4
-rw-r--r--theories/Numbers/NatInt/NZPow.v4
-rw-r--r--theories/Numbers/NatInt/NZProperties.v2
-rw-r--r--theories/Numbers/NatInt/NZSqrt.v6
-rw-r--r--theories/Numbers/Natural/Abstract/NAdd.v2
-rw-r--r--theories/Numbers/Natural/Abstract/NAddOrder.v2
-rw-r--r--theories/Numbers/Natural/Abstract/NAxioms.v2
-rw-r--r--theories/Numbers/Natural/Abstract/NBase.v2
-rw-r--r--theories/Numbers/Natural/Abstract/NBits.v2
-rw-r--r--theories/Numbers/Natural/Abstract/NDefOps.v3
-rw-r--r--theories/Numbers/Natural/Abstract/NDiv.v2
-rw-r--r--theories/Numbers/Natural/Abstract/NGcd.v2
-rw-r--r--theories/Numbers/Natural/Abstract/NIso.v2
-rw-r--r--theories/Numbers/Natural/Abstract/NLcm.v2
-rw-r--r--theories/Numbers/Natural/Abstract/NLog.v2
-rw-r--r--theories/Numbers/Natural/Abstract/NMaxMin.v2
-rw-r--r--theories/Numbers/Natural/Abstract/NMulOrder.v2
-rw-r--r--theories/Numbers/Natural/Abstract/NOrder.v2
-rw-r--r--theories/Numbers/Natural/Abstract/NParity.v2
-rw-r--r--theories/Numbers/Natural/Abstract/NPow.v2
-rw-r--r--theories/Numbers/Natural/Abstract/NProperties.v23
-rw-r--r--theories/Numbers/Natural/Abstract/NSqrt.v2
-rw-r--r--theories/Numbers/Natural/Abstract/NStrongRec.v7
-rw-r--r--theories/Numbers/Natural/Abstract/NSub.v2
-rw-r--r--theories/Numbers/Natural/BigN/BigN.v20
-rw-r--r--theories/Numbers/Natural/BigN/NMake.v150
-rw-r--r--theories/Numbers/Natural/BigN/NMake_gen.ml24
-rw-r--r--theories/Numbers/Natural/BigN/Nbasic.v5
-rw-r--r--theories/Numbers/Natural/Binary/NBinary.v2
-rw-r--r--theories/Numbers/Natural/Peano/NPeano.v806
-rw-r--r--theories/Numbers/Natural/SpecViaZ/NSig.v2
-rw-r--r--theories/Numbers/Natural/SpecViaZ/NSigNAxioms.v2
-rw-r--r--theories/Numbers/NumPrelude.v2
-rw-r--r--theories/Numbers/Rational/BigQ/BigQ.v11
-rw-r--r--theories/Numbers/Rational/BigQ/QMake.v28
-rw-r--r--theories/Numbers/Rational/SpecViaQ/QSig.v4
-rw-r--r--theories/PArith/BinPos.v46
-rw-r--r--theories/PArith/BinPosDef.v42
-rw-r--r--theories/PArith/PArith.v2
-rw-r--r--theories/PArith/POrderedType.v2
-rw-r--r--theories/PArith/Pnat.v136
-rw-r--r--theories/Program/Basics.v2
-rw-r--r--theories/Program/Combinators.v2
-rw-r--r--theories/Program/Equality.v4
-rw-r--r--theories/Program/Program.v2
-rw-r--r--theories/Program/Subset.v14
-rw-r--r--theories/Program/Syntax.v2
-rw-r--r--theories/Program/Tactics.v2
-rw-r--r--theories/Program/Utils.v2
-rw-r--r--theories/Program/Wf.v23
-rw-r--r--theories/QArith/QArith.v2
-rw-r--r--theories/QArith/QArith_base.v6
-rw-r--r--theories/QArith/QOrderedType.v2
-rw-r--r--theories/QArith/Qabs.v2
-rw-r--r--theories/QArith/Qcanon.v24
-rw-r--r--theories/QArith/Qfield.v2
-rw-r--r--theories/QArith/Qminmax.v2
-rw-r--r--theories/QArith/Qpower.v3
-rw-r--r--theories/QArith/Qreals.v33
-rw-r--r--theories/QArith/Qreduction.v4
-rw-r--r--theories/QArith/Qring.v2
-rw-r--r--theories/QArith/Qround.v2
-rw-r--r--theories/Reals/Alembert.v113
-rw-r--r--theories/Reals/AltSeries.v16
-rw-r--r--theories/Reals/ArithProp.v23
-rw-r--r--theories/Reals/Binomial.v9
-rw-r--r--theories/Reals/Cauchy_prod.v2
-rw-r--r--theories/Reals/Cos_plus.v3
-rw-r--r--theories/Reals/Cos_rel.v78
-rw-r--r--theories/Reals/DiscrR.v5
-rw-r--r--theories/Reals/Exp_prop.v59
-rw-r--r--theories/Reals/Integration.v2
-rw-r--r--theories/Reals/LegacyRfield.v38
-rw-r--r--theories/Reals/MVT.v119
-rw-r--r--theories/Reals/Machin.v8
-rw-r--r--theories/Reals/NewtonInt.v304
-rw-r--r--theories/Reals/PSeries_reg.v349
-rw-r--r--theories/Reals/PartSum.v65
-rw-r--r--theories/Reals/RIneq.v145
-rw-r--r--theories/Reals/RList.v20
-rw-r--r--theories/Reals/ROrderedType.v4
-rw-r--r--theories/Reals/R_Ifp.v2
-rw-r--r--theories/Reals/R_sqr.v58
-rw-r--r--theories/Reals/R_sqrt.v11
-rw-r--r--theories/Reals/Ranalysis.v2
-rw-r--r--theories/Reals/Ranalysis1.v122
-rw-r--r--theories/Reals/Ranalysis2.v9
-rw-r--r--theories/Reals/Ranalysis3.v4
-rw-r--r--theories/Reals/Ranalysis4.v58
-rw-r--r--theories/Reals/Ranalysis5.v97
-rw-r--r--theories/Reals/Ranalysis_reg.v7
-rw-r--r--theories/Reals/Ratan.v27
-rw-r--r--theories/Reals/Raxioms.v2
-rw-r--r--theories/Reals/Rbase.v2
-rw-r--r--theories/Reals/Rbasic_fun.v248
-rw-r--r--theories/Reals/Rcomplete.v45
-rw-r--r--theories/Reals/Rdefinitions.v2
-rw-r--r--theories/Reals/Rderiv.v16
-rw-r--r--theories/Reals/Reals.v2
-rw-r--r--theories/Reals/Rfunctions.v32
-rw-r--r--theories/Reals/Rgeom.v2
-rw-r--r--theories/Reals/RiemannInt.v774
-rw-r--r--theories/Reals/RiemannInt_SF.v350
-rw-r--r--theories/Reals/Rlimit.v23
-rw-r--r--theories/Reals/Rlogic.v364
-rw-r--r--theories/Reals/Rminmax.v2
-rw-r--r--theories/Reals/Rpow_def.v2
-rw-r--r--theories/Reals/Rpower.v165
-rw-r--r--theories/Reals/Rprod.v3
-rw-r--r--theories/Reals/Rseries.v39
-rw-r--r--theories/Reals/Rsigma.v3
-rw-r--r--theories/Reals/Rsqrt_def.v165
-rw-r--r--theories/Reals/Rtopology.v326
-rw-r--r--theories/Reals/Rtrigo.v5
-rw-r--r--theories/Reals/Rtrigo1.v33
-rw-r--r--theories/Reals/Rtrigo_alt.v50
-rw-r--r--theories/Reals/Rtrigo_calc.v2
-rw-r--r--theories/Reals/Rtrigo_def.v6
-rw-r--r--theories/Reals/Rtrigo_fun.v149
-rw-r--r--theories/Reals/Rtrigo_reg.v18
-rw-r--r--theories/Reals/SeqProp.v64
-rw-r--r--theories/Reals/SeqSeries.v68
-rw-r--r--theories/Reals/SplitAbsolu.v4
-rw-r--r--theories/Reals/SplitRmult.v2
-rw-r--r--theories/Reals/Sqrt_reg.v47
-rw-r--r--theories/Reals/vo.itarget1
-rw-r--r--theories/Relations/Operators_Properties.v33
-rw-r--r--theories/Relations/Relation_Definitions.v2
-rw-r--r--theories/Relations/Relation_Operators.v18
-rw-r--r--theories/Relations/Relations.v2
-rw-r--r--theories/Setoids/Setoid.v5
-rw-r--r--theories/Sets/Classical_sets.v4
-rw-r--r--theories/Sets/Constructive_sets.v2
-rw-r--r--theories/Sets/Cpo.v8
-rw-r--r--theories/Sets/Ensembles.v2
-rw-r--r--theories/Sets/Finite_sets.v2
-rw-r--r--theories/Sets/Finite_sets_facts.v4
-rw-r--r--theories/Sets/Image.v4
-rw-r--r--theories/Sets/Infinite_sets.v4
-rw-r--r--theories/Sets/Integers.v4
-rw-r--r--theories/Sets/Multiset.v2
-rw-r--r--theories/Sets/Partial_Order.v6
-rw-r--r--theories/Sets/Permut.v2
-rw-r--r--theories/Sets/Powerset.v2
-rw-r--r--theories/Sets/Powerset_Classical_facts.v4
-rw-r--r--theories/Sets/Powerset_facts.v2
-rw-r--r--theories/Sets/Relations_1.v2
-rw-r--r--theories/Sets/Relations_1_facts.v2
-rw-r--r--theories/Sets/Relations_2.v2
-rw-r--r--theories/Sets/Relations_2_facts.v2
-rw-r--r--theories/Sets/Relations_3.v2
-rw-r--r--theories/Sets/Relations_3_facts.v2
-rw-r--r--theories/Sets/Uniset.v2
-rw-r--r--theories/Sorting/Heap.v12
-rw-r--r--theories/Sorting/Mergesort.v2
-rw-r--r--theories/Sorting/PermutEq.v8
-rw-r--r--theories/Sorting/PermutSetoid.v6
-rw-r--r--theories/Sorting/Permutation.v462
-rw-r--r--theories/Sorting/Sorted.v6
-rw-r--r--theories/Sorting/Sorting.v2
-rw-r--r--theories/Strings/Ascii.v7
-rw-r--r--theories/Strings/String.v6
-rw-r--r--theories/Structures/DecidableType.v4
-rw-r--r--theories/Structures/DecidableTypeEx.v2
-rw-r--r--theories/Structures/Equalities.v8
-rw-r--r--theories/Structures/EqualitiesFacts.v2
-rw-r--r--theories/Structures/GenericMinMax.v10
-rw-r--r--theories/Structures/OrderedType.v14
-rw-r--r--theories/Structures/OrderedTypeEx.v4
-rw-r--r--theories/Structures/Orders.v6
-rw-r--r--theories/Structures/OrdersEx.v8
-rw-r--r--theories/Structures/OrdersFacts.v4
-rw-r--r--theories/Structures/OrdersLists.v2
-rw-r--r--theories/Structures/OrdersTac.v9
-rw-r--r--theories/Unicode/Utf8.v2
-rw-r--r--theories/Unicode/Utf8_core.v4
-rw-r--r--theories/Vectors/Fin.v174
-rw-r--r--theories/Vectors/Vector.v2
-rw-r--r--theories/Vectors/VectorDef.v136
-rw-r--r--theories/Vectors/VectorEq.v80
-rw-r--r--theories/Vectors/VectorSpec.v12
-rw-r--r--theories/Vectors/vo.itarget1
-rw-r--r--theories/Wellfounded/Disjoint_Union.v2
-rw-r--r--theories/Wellfounded/Inclusion.v2
-rw-r--r--theories/Wellfounded/Inverse_Image.v2
-rw-r--r--theories/Wellfounded/Lexicographic_Exponentiation.v269
-rw-r--r--theories/Wellfounded/Lexicographic_Product.v2
-rw-r--r--theories/Wellfounded/Transitive_Closure.v2
-rw-r--r--theories/Wellfounded/Union.v2
-rw-r--r--theories/Wellfounded/Well_Ordering.v2
-rw-r--r--theories/Wellfounded/Wellfounded.v2
-rw-r--r--theories/ZArith/BinInt.v365
-rw-r--r--theories/ZArith/BinIntDef.v10
-rw-r--r--theories/ZArith/Wf_Z.v10
-rw-r--r--theories/ZArith/ZArith.v2
-rw-r--r--theories/ZArith/ZArith_base.v2
-rw-r--r--theories/ZArith/ZArith_dec.v2
-rw-r--r--theories/ZArith/ZOdiv.v88
-rw-r--r--theories/ZArith/ZOdiv_def.v15
-rw-r--r--theories/ZArith/Zabs.v2
-rw-r--r--theories/ZArith/Zbool.v2
-rw-r--r--theories/ZArith/Zcompare.v2
-rw-r--r--theories/ZArith/Zcomplements.v42
-rw-r--r--theories/ZArith/Zdigits.v15
-rw-r--r--theories/ZArith/Zdiv.v24
-rw-r--r--theories/ZArith/Zeuclid.v2
-rw-r--r--theories/ZArith/Zeven.v8
-rw-r--r--theories/ZArith/Zgcd_alt.v6
-rw-r--r--theories/ZArith/Zhints.v2
-rw-r--r--theories/ZArith/Zlogarithm.v4
-rw-r--r--theories/ZArith/Zmax.v2
-rw-r--r--theories/ZArith/Zmin.v2
-rw-r--r--theories/ZArith/Zminmax.v2
-rw-r--r--theories/ZArith/Zmisc.v2
-rw-r--r--theories/ZArith/Znat.v32
-rw-r--r--theories/ZArith/Znumtheory.v15
-rw-r--r--theories/ZArith/Zorder.v2
-rw-r--r--theories/ZArith/Zpow_alt.v8
-rw-r--r--theories/ZArith/Zpow_def.v2
-rw-r--r--theories/ZArith/Zpow_facts.v6
-rw-r--r--theories/ZArith/Zpower.v26
-rw-r--r--theories/ZArith/Zquot.v2
-rw-r--r--theories/ZArith/Zsqrt_compat.v14
-rw-r--r--theories/ZArith/Zwf.v2
-rw-r--r--theories/ZArith/auxiliary.v2
-rw-r--r--theories/ZArith/vo.itarget2
412 files changed, 12236 insertions, 7880 deletions
diff --git a/theories/Arith/Arith.v b/theories/Arith/Arith.v
index 1ed22762..620a4201 100644
--- a/theories/Arith/Arith.v
+++ b/theories/Arith/Arith.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Arith/Arith_base.v b/theories/Arith/Arith_base.v
index 19803729..a99c4113 100644
--- a/theories/Arith/Arith_base.v
+++ b/theories/Arith/Arith_base.v
@@ -1,11 +1,13 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
(************************************************************************)
+Require Export PeanoNat.
+
Require Export Le.
Require Export Lt.
Require Export Plus.
diff --git a/theories/Arith/Between.v b/theories/Arith/Between.v
index 3693bf22..06723541 100644
--- a/theories/Arith/Between.v
+++ b/theories/Arith/Between.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Arith/Bool_nat.v b/theories/Arith/Bool_nat.v
index 537ee5c3..f91f3340 100644
--- a/theories/Arith/Bool_nat.v
+++ b/theories/Arith/Bool_nat.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Arith/Compare.v b/theories/Arith/Compare.v
index e5c36cf4..400f2d81 100644
--- a/theories/Arith/Compare.v
+++ b/theories/Arith/Compare.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Arith/Compare_dec.v b/theories/Arith/Compare_dec.v
index cdad6b35..a97cf6dc 100644
--- a/theories/Arith/Compare_dec.v
+++ b/theories/Arith/Compare_dec.v
@@ -1,15 +1,12 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
(************************************************************************)
-Require Import Le.
-Require Import Lt.
-Require Import Gt.
-Require Import Decidable.
+Require Import Le Lt Gt Decidable PeanoNat.
Local Open Scope nat_scope.
@@ -29,31 +26,31 @@ Defined.
Definition gt_eq_gt_dec n m : {m > n} + {n = m} + {n > m}.
Proof.
- intros; apply lt_eq_lt_dec; assumption.
+ now apply lt_eq_lt_dec.
Defined.
Definition le_lt_dec n m : {n <= m} + {m < n}.
Proof.
induction n in m |- *.
- auto with arith.
- destruct m.
- auto with arith.
- elim (IHn m); auto with arith.
+ - left; auto with arith.
+ - destruct m.
+ + right; auto with arith.
+ + elim (IHn m); [left|right]; auto with arith.
Defined.
Definition le_le_S_dec n m : {n <= m} + {S m <= n}.
Proof.
- intros; exact (le_lt_dec n m).
+ exact (le_lt_dec n m).
Defined.
Definition le_ge_dec n m : {n <= m} + {n >= m}.
Proof.
- intros; elim (le_lt_dec n m); auto with arith.
+ elim (le_lt_dec n m); auto with arith.
Defined.
Definition le_gt_dec n m : {n <= m} + {n > m}.
Proof.
- intros; exact (le_lt_dec n m).
+ exact (le_lt_dec n m).
Defined.
Definition le_lt_eq_dec n m : n <= m -> {n < m} + {n = m}.
@@ -62,162 +59,121 @@ Proof.
intros; absurd (m < n); auto with arith.
Defined.
-Theorem le_dec : forall n m, {n <= m} + {~ n <= m}.
+Theorem le_dec n m : {n <= m} + {~ n <= m}.
Proof.
- intros n m. destruct (le_gt_dec n m).
- auto with arith.
- right. apply gt_not_le. assumption.
+ destruct (le_gt_dec n m).
+ - now left.
+ - right. now apply gt_not_le.
Defined.
-Theorem lt_dec : forall n m, {n < m} + {~ n < m}.
+Theorem lt_dec n m : {n < m} + {~ n < m}.
Proof.
- intros; apply le_dec.
+ apply le_dec.
Defined.
-Theorem gt_dec : forall n m, {n > m} + {~ n > m}.
+Theorem gt_dec n m : {n > m} + {~ n > m}.
Proof.
- intros; apply lt_dec.
+ apply lt_dec.
Defined.
-Theorem ge_dec : forall n m, {n >= m} + {~ n >= m}.
+Theorem ge_dec n m : {n >= m} + {~ n >= m}.
Proof.
- intros; apply le_dec.
+ apply le_dec.
Defined.
(** Proofs of decidability *)
-Theorem dec_le : forall n m, decidable (n <= m).
+Theorem dec_le n m : decidable (n <= m).
Proof.
- intros n m; destruct (le_dec n m); unfold decidable; auto.
+ apply Nat.le_decidable.
Qed.
-Theorem dec_lt : forall n m, decidable (n < m).
+Theorem dec_lt n m : decidable (n < m).
Proof.
- intros; apply dec_le.
+ apply Nat.lt_decidable.
Qed.
-Theorem dec_gt : forall n m, decidable (n > m).
+Theorem dec_gt n m : decidable (n > m).
Proof.
- intros; apply dec_lt.
+ apply Nat.lt_decidable.
Qed.
-Theorem dec_ge : forall n m, decidable (n >= m).
+Theorem dec_ge n m : decidable (n >= m).
Proof.
- intros; apply dec_le.
+ apply Nat.le_decidable.
Qed.
-Theorem not_eq : forall n m, n <> m -> n < m \/ m < n.
+Theorem not_eq n m : n <> m -> n < m \/ m < n.
Proof.
- intros x y H; elim (lt_eq_lt_dec x y);
- [ intros H1; elim H1;
- [ auto with arith | intros H2; absurd (x = y); assumption ]
- | auto with arith ].
+ apply Nat.lt_gt_cases.
Qed.
-
-Theorem not_le : forall n m, ~ n <= m -> n > m.
+Theorem not_le n m : ~ n <= m -> n > m.
Proof.
- intros x y H; elim (le_gt_dec x y);
- [ intros H1; absurd (x <= y); assumption | trivial with arith ].
+ apply Nat.nle_gt.
Qed.
-Theorem not_gt : forall n m, ~ n > m -> n <= m.
+Theorem not_gt n m : ~ n > m -> n <= m.
Proof.
- intros x y H; elim (le_gt_dec x y);
- [ trivial with arith | intros H1; absurd (x > y); assumption ].
+ apply Nat.nlt_ge.
Qed.
-Theorem not_ge : forall n m, ~ n >= m -> n < m.
+Theorem not_ge n m : ~ n >= m -> n < m.
Proof.
- intros x y H; exact (not_le y x H).
+ apply Nat.nle_gt.
Qed.
-Theorem not_lt : forall n m, ~ n < m -> n >= m.
+Theorem not_lt n m : ~ n < m -> n >= m.
Proof.
- intros x y H; exact (not_gt y x H).
+ apply Nat.nlt_ge.
Qed.
-(** A ternary comparison function in the spirit of [Z.compare]. *)
+(** A ternary comparison function in the spirit of [Z.compare].
+ See now [Nat.compare] and its properties.
+ In scope [nat_scope], the notation for [Nat.compare] is "?=" *)
-Fixpoint nat_compare n m :=
- match n, m with
- | O, O => Eq
- | O, S _ => Lt
- | S _, O => Gt
- | S n', S m' => nat_compare n' m'
- end.
+Notation nat_compare := Nat.compare (compat "8.4").
-Lemma nat_compare_S : forall n m, nat_compare (S n) (S m) = nat_compare n m.
-Proof.
- reflexivity.
-Qed.
+Notation nat_compare_spec := Nat.compare_spec (compat "8.4").
+Notation nat_compare_eq_iff := Nat.compare_eq_iff (compat "8.4").
+Notation nat_compare_S := Nat.compare_succ (compat "8.4").
-Lemma nat_compare_eq_iff : forall n m, nat_compare n m = Eq <-> n = m.
+Lemma nat_compare_lt n m : n<m <-> (n ?= m) = Lt.
Proof.
- induction n; destruct m; simpl; split; auto; try discriminate;
- destruct (IHn m); auto.
+ symmetry. apply Nat.compare_lt_iff.
Qed.
-Lemma nat_compare_eq : forall n m, nat_compare n m = Eq -> n = m.
+Lemma nat_compare_gt n m : n>m <-> (n ?= m) = Gt.
Proof.
- intros; apply -> nat_compare_eq_iff; auto.
+ symmetry. apply Nat.compare_gt_iff.
Qed.
-Lemma nat_compare_lt : forall n m, n<m <-> nat_compare n m = Lt.
+Lemma nat_compare_le n m : n<=m <-> (n ?= m) <> Gt.
Proof.
- induction n; destruct m; simpl; split; auto with arith;
- try solve [inversion 1].
- destruct (IHn m); auto with arith.
- destruct (IHn m); auto with arith.
+ symmetry. apply Nat.compare_le_iff.
Qed.
-Lemma nat_compare_gt : forall n m, n>m <-> nat_compare n m = Gt.
+Lemma nat_compare_ge n m : n>=m <-> (n ?= m) <> Lt.
Proof.
- induction n; destruct m; simpl; split; auto with arith;
- try solve [inversion 1].
- destruct (IHn m); auto with arith.
- destruct (IHn m); auto with arith.
+ symmetry. apply Nat.compare_ge_iff.
Qed.
-Lemma nat_compare_le : forall n m, n<=m <-> nat_compare n m <> Gt.
-Proof.
- split.
- intros LE; contradict LE.
- apply lt_not_le. apply <- nat_compare_gt; auto.
- intros NGT. apply not_lt. contradict NGT.
- apply -> nat_compare_gt; auto.
-Qed.
-
-Lemma nat_compare_ge : forall n m, n>=m <-> nat_compare n m <> Lt.
-Proof.
- split.
- intros GE; contradict GE.
- apply lt_not_le. apply <- nat_compare_lt; auto.
- intros NLT. apply not_lt. contradict NLT.
- apply -> nat_compare_lt; auto.
-Qed.
+(** Some projections of the above equivalences. *)
-Lemma nat_compare_spec :
- forall x y, CompareSpec (x=y) (x<y) (y<x) (nat_compare x y).
+Lemma nat_compare_eq n m : (n ?= m) = Eq -> n = m.
Proof.
- intros.
- destruct (nat_compare x y) eqn:?; constructor.
- apply nat_compare_eq; auto.
- apply <- nat_compare_lt; auto.
- apply <- nat_compare_gt; auto.
+ apply Nat.compare_eq_iff.
Qed.
-(** Some projections of the above equivalences. *)
-
-Lemma nat_compare_Lt_lt : forall n m, nat_compare n m = Lt -> n<m.
+Lemma nat_compare_Lt_lt n m : (n ?= m) = Lt -> n<m.
Proof.
- intros; apply <- nat_compare_lt; auto.
+ apply Nat.compare_lt_iff.
Qed.
-Lemma nat_compare_Gt_gt : forall n m, nat_compare n m = Gt -> n>m.
+Lemma nat_compare_Gt_gt n m : (n ?= m) = Gt -> n>m.
Proof.
- intros; apply <- nat_compare_gt; auto.
+ apply Nat.compare_gt_iff.
Qed.
(** A previous definition of [nat_compare] in terms of [lt_eq_lt_dec].
@@ -230,70 +186,48 @@ Definition nat_compare_alt (n m:nat) :=
| inright _ => Gt
end.
-Lemma nat_compare_equiv: forall n m,
- nat_compare n m = nat_compare_alt n m.
+Lemma nat_compare_equiv n m : (n ?= m) = nat_compare_alt n m.
Proof.
- intros; unfold nat_compare_alt; destruct lt_eq_lt_dec as [[LT|EQ]|GT].
- apply -> nat_compare_lt; auto.
- apply <- nat_compare_eq_iff; auto.
- apply -> nat_compare_gt; auto.
+ unfold nat_compare_alt; destruct lt_eq_lt_dec as [[|]|].
+ - now apply Nat.compare_lt_iff.
+ - now apply Nat.compare_eq_iff.
+ - now apply Nat.compare_gt_iff.
Qed.
+(** A boolean version of [le] over [nat].
+ See now [Nat.leb] and its properties.
+ In scope [nat_scope], the notation for [Nat.leb] is "<=?" *)
-(** A boolean version of [le] over [nat]. *)
-
-Fixpoint leb (m:nat) : nat -> bool :=
- match m with
- | O => fun _:nat => true
- | S m' =>
- fun n:nat => match n with
- | O => false
- | S n' => leb m' n'
- end
- end.
+Notation leb := Nat.leb (compat "8.4").
-Lemma leb_correct : forall m n, m <= n -> leb m n = true.
-Proof.
- induction m as [| m IHm]. trivial.
- destruct n. intro H. elim (le_Sn_O _ H).
- intros. simpl. apply IHm. apply le_S_n. assumption.
-Qed.
+Notation leb_iff := Nat.leb_le (compat "8.4").
-Lemma leb_complete : forall m n, leb m n = true -> m <= n.
+Lemma leb_iff_conv m n : (n <=? m) = false <-> m < n.
Proof.
- induction m. trivial with arith.
- destruct n. intro H. discriminate H.
- auto with arith.
+ rewrite Nat.leb_nle. apply Nat.nle_gt.
Qed.
-Lemma leb_iff : forall m n, leb m n = true <-> m <= n.
+Lemma leb_correct m n : m <= n -> (m <=? n) = true.
Proof.
- split; auto using leb_correct, leb_complete.
+ apply Nat.leb_le.
Qed.
-Lemma leb_correct_conv : forall m n, m < n -> leb n m = false.
+Lemma leb_complete m n : (m <=? n) = true -> m <= n.
Proof.
- intros.
- generalize (leb_complete n m).
- destruct (leb n m); auto.
- intros; elim (lt_not_le m n); auto.
+ apply Nat.leb_le.
Qed.
-Lemma leb_complete_conv : forall m n, leb n m = false -> m < n.
+Lemma leb_correct_conv m n : m < n -> (n <=? m) = false.
Proof.
- intros m n EQ. apply not_le.
- intro LE. apply leb_correct in LE. rewrite LE in EQ; discriminate.
+ apply leb_iff_conv.
Qed.
-Lemma leb_iff_conv : forall m n, leb n m = false <-> m < n.
+Lemma leb_complete_conv m n : (n <=? m) = false -> m < n.
Proof.
- split; auto using leb_complete_conv, leb_correct_conv.
+ apply leb_iff_conv.
Qed.
-Lemma leb_compare : forall n m, leb n m = true <-> nat_compare n m <> Gt.
+Lemma leb_compare n m : (n <=? m) = true <-> (n ?= m) <> Gt.
Proof.
- split; intros.
- apply -> nat_compare_le. auto using leb_complete.
- apply leb_correct. apply <- nat_compare_le; auto.
+ rewrite Nat.compare_le_iff. apply Nat.leb_le.
Qed.
-
diff --git a/theories/Arith/Div2.v b/theories/Arith/Div2.v
index 45fddd72..1c65a192 100644
--- a/theories/Arith/Div2.v
+++ b/theories/Arith/Div2.v
@@ -1,15 +1,16 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
(************************************************************************)
-Require Import Lt.
-Require Import Plus.
-Require Import Compare_dec.
-Require Import Even.
+(** Nota : this file is OBSOLETE, and left only for compatibility.
+ Please consider using [Nat.div2] directly, and results about it
+ (see file PeanoNat). *)
+
+Require Import PeanoNat Even.
Local Open Scope nat_scope.
@@ -17,12 +18,7 @@ Implicit Type n : nat.
(** Here we define [n/2] and prove some of its properties *)
-Fixpoint div2 n : nat :=
- match n with
- | O => 0
- | S O => 0
- | S (S n') => S (div2 n')
- end.
+Notation div2 := Nat.div2 (compat "8.4").
(** Since [div2] is recursively defined on [0], [1] and [(S (S n))], it is
useful to prove the corresponding induction principle *)
@@ -31,53 +27,48 @@ Lemma ind_0_1_SS :
forall P:nat -> Prop,
P 0 -> P 1 -> (forall n, P n -> P (S (S n))) -> forall n, P n.
Proof.
- intros P H0 H1 Hn.
- cut (forall n, P n /\ P (S n)).
- intros H'n n. elim (H'n n). auto with arith.
-
- induction n. auto with arith.
- intros. elim IHn; auto with arith.
+ intros P H0 H1 H2.
+ fix 1.
+ destruct n as [|[|n]].
+ - exact H0.
+ - exact H1.
+ - apply H2, ind_0_1_SS.
Qed.
(** [0 <n => n/2 < n] *)
-Lemma lt_div2 : forall n, 0 < n -> div2 n < n.
-Proof.
- intro n. pattern n. apply ind_0_1_SS.
- (* n = 0 *)
- inversion 1.
- (* n=1 *)
- simpl; trivial.
- (* n=S S n' *)
- intro n'; case (zerop n').
- intro n'_eq_0. rewrite n'_eq_0. auto with arith.
- auto with arith.
-Qed.
+Lemma lt_div2 n : 0 < n -> div2 n < n.
+Proof. apply Nat.lt_div2. Qed.
Hint Resolve lt_div2: arith.
(** Properties related to the parity *)
-Lemma even_div2 : forall n, even n -> div2 n = div2 (S n)
-with odd_div2 : forall n, odd n -> S (div2 n) = div2 (S n).
+Lemma even_div2 n : even n -> div2 n = div2 (S n).
Proof.
- destruct n; intro H.
- (* 0 *) trivial.
- (* S n *) inversion_clear H. apply odd_div2 in H0 as <-. trivial.
- destruct n; intro.
- (* 0 *) inversion H.
- (* S n *) inversion_clear H. apply even_div2 in H0 as <-. trivial.
+ rewrite Even.even_equiv. intros (p,->).
+ rewrite Nat.div2_succ_double. apply Nat.div2_double.
Qed.
-Lemma div2_even n : div2 n = div2 (S n) -> even n
-with div2_odd n : S (div2 n) = div2 (S n) -> odd n.
+Lemma odd_div2 n : odd n -> S (div2 n) = div2 (S n).
Proof.
-{ destruct n; intro H.
- - constructor.
- - constructor. apply div2_odd. rewrite H. trivial. }
-{ destruct n; intro H.
- - discriminate.
- - constructor. apply div2_even. injection H as <-. trivial. }
+ rewrite Even.odd_equiv. intros (p,->).
+ rewrite Nat.add_1_r, Nat.div2_succ_double.
+ simpl. f_equal. symmetry. apply Nat.div2_double.
+Qed.
+
+Lemma div2_even n : div2 n = div2 (S n) -> even n.
+Proof.
+ destruct (even_or_odd n) as [Ev|Od]; trivial.
+ apply odd_div2 in Od. rewrite <- Od. intro Od'.
+ elim (n_Sn _ Od').
+Qed.
+
+Lemma div2_odd n : S (div2 n) = div2 (S n) -> odd n.
+Proof.
+ destruct (even_or_odd n) as [Ev|Od]; trivial.
+ apply even_div2 in Ev. rewrite <- Ev. intro Ev'.
+ symmetry in Ev'. elim (n_Sn _ Ev').
Qed.
Hint Resolve even_div2 div2_even odd_div2 div2_odd: arith.
@@ -93,58 +84,52 @@ Qed.
(** Properties related to the double ([2n]) *)
-Definition double n := n + n.
+Notation double := Nat.double (compat "8.4").
-Hint Unfold double: arith.
+Hint Unfold double Nat.double: arith.
-Lemma double_S : forall n, double (S n) = S (S (double n)).
+Lemma double_S n : double (S n) = S (S (double n)).
Proof.
- intro. unfold double. simpl. auto with arith.
+ apply Nat.add_succ_r.
Qed.
-Lemma double_plus : forall n (m:nat), double (n + m) = double n + double m.
+Lemma double_plus n m : double (n + m) = double n + double m.
Proof.
- intros m n. unfold double.
- do 2 rewrite plus_assoc_reverse. rewrite (plus_permute n).
- reflexivity.
+ apply Nat.add_shuffle1.
Qed.
Hint Resolve double_S: arith.
-Lemma even_odd_double :
- forall n,
- (even n <-> n = double (div2 n)) /\ (odd n <-> n = S (double (div2 n))).
+Lemma even_odd_double n :
+ (even n <-> n = double (div2 n)) /\ (odd n <-> n = S (double (div2 n))).
Proof.
- intro n. pattern n. apply ind_0_1_SS.
- (* n = 0 *)
- split; split; auto with arith.
- intro H. inversion H.
- (* n = 1 *)
- split; split; auto with arith.
- intro H. inversion H. inversion H1.
- (* n = (S (S n')) *)
- intros. destruct H as ((IH1,IH2),(IH3,IH4)).
- split; split.
- intro H. inversion H. inversion H1.
- simpl. rewrite (double_S (div2 n0)). auto with arith.
- simpl. rewrite (double_S (div2 n0)). intro H. injection H. auto with arith.
- intro H. inversion H. inversion H1.
- simpl. rewrite (double_S (div2 n0)). auto with arith.
- simpl. rewrite (double_S (div2 n0)). intro H. injection H. auto with arith.
+ revert n. fix 1. destruct n as [|[|n]].
+ - (* n = 0 *)
+ split; split; auto with arith. inversion 1.
+ - (* n = 1 *)
+ split; split; auto with arith. inversion_clear 1. inversion H0.
+ - (* n = (S (S n')) *)
+ destruct (even_odd_double n) as ((Ev,Ev'),(Od,Od')).
+ split; split; simpl div2; rewrite ?double_S.
+ + inversion_clear 1. inversion_clear H0. auto.
+ + injection 1. auto with arith.
+ + inversion_clear 1. inversion_clear H0. auto.
+ + injection 1. auto with arith.
Qed.
+
(** Specializations *)
-Lemma even_double : forall n, even n -> n = double (div2 n).
-Proof fun n => proj1 (proj1 (even_odd_double n)).
+Lemma even_double n : even n -> n = double (div2 n).
+Proof proj1 (proj1 (even_odd_double n)).
-Lemma double_even : forall n, n = double (div2 n) -> even n.
-Proof fun n => proj2 (proj1 (even_odd_double n)).
+Lemma double_even n : n = double (div2 n) -> even n.
+Proof proj2 (proj1 (even_odd_double n)).
-Lemma odd_double : forall n, odd n -> n = S (double (div2 n)).
-Proof fun n => proj1 (proj2 (even_odd_double n)).
+Lemma odd_double n : odd n -> n = S (double (div2 n)).
+Proof proj1 (proj2 (even_odd_double n)).
-Lemma double_odd : forall n, n = S (double (div2 n)) -> odd n.
-Proof fun n => proj2 (proj2 (even_odd_double n)).
+Lemma double_odd n : n = S (double (div2 n)) -> odd n.
+Proof proj2 (proj2 (even_odd_double n)).
Hint Resolve even_double double_even odd_double double_odd: arith.
@@ -166,22 +151,8 @@ Defined.
(** Doubling before dividing by two brings back to the initial number. *)
-Lemma div2_double : forall n:nat, div2 (2*n) = n.
-Proof.
- induction n.
- simpl; auto.
- simpl.
- replace (n+S(n+0)) with (S (2*n)).
- f_equal; auto.
- simpl; auto with arith.
-Qed.
+Lemma div2_double n : div2 (2*n) = n.
+Proof. apply Nat.div2_double. Qed.
-Lemma div2_double_plus_one : forall n:nat, div2 (S (2*n)) = n.
-Proof.
- induction n.
- simpl; auto.
- simpl.
- replace (n+S(n+0)) with (S (2*n)).
- f_equal; auto.
- simpl; auto with arith.
-Qed.
+Lemma div2_double_plus_one n : div2 (S (2*n)) = n.
+Proof. apply Nat.div2_succ_double. Qed.
diff --git a/theories/Arith/EqNat.v b/theories/Arith/EqNat.v
index 597cd287..2771670e 100644
--- a/theories/Arith/EqNat.v
+++ b/theories/Arith/EqNat.v
@@ -1,16 +1,15 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
(************************************************************************)
-(** Equality on natural numbers *)
-
+Require Import PeanoNat.
Local Open Scope nat_scope.
-Implicit Types m n x y : nat.
+(** Equality on natural numbers *)
(** * Propositional equality *)
@@ -22,28 +21,33 @@ Fixpoint eq_nat n m : Prop :=
| S n1, S m1 => eq_nat n1 m1
end.
-Theorem eq_nat_refl : forall n, eq_nat n n.
+Theorem eq_nat_refl n : eq_nat n n.
+Proof.
induction n; simpl; auto.
Qed.
Hint Resolve eq_nat_refl: arith v62.
(** [eq] restricted to [nat] and [eq_nat] are equivalent *)
-Lemma eq_eq_nat : forall n m, n = m -> eq_nat n m.
- induction 1; trivial with arith.
+Theorem eq_nat_is_eq n m : eq_nat n m <-> n = m.
+Proof.
+ split.
+ - revert m; induction n; destruct m; simpl; contradiction || auto.
+ - intros <-; apply eq_nat_refl.
Qed.
-Hint Immediate eq_eq_nat: arith v62.
-Lemma eq_nat_eq : forall n m, eq_nat n m -> n = m.
- induction n; induction m; simpl; contradiction || auto with arith.
+Lemma eq_eq_nat n m : n = m -> eq_nat n m.
+Proof.
+ apply eq_nat_is_eq.
Qed.
-Hint Immediate eq_nat_eq: arith v62.
-Theorem eq_nat_is_eq : forall n m, eq_nat n m <-> n = m.
+Lemma eq_nat_eq n m : eq_nat n m -> n = m.
Proof.
- split; auto with arith.
+ apply eq_nat_is_eq.
Qed.
+Hint Immediate eq_eq_nat eq_nat_eq: arith v62.
+
Theorem eq_nat_elim :
forall n (P:nat -> Prop), P n -> forall m, eq_nat n m -> P m.
Proof.
@@ -52,63 +56,47 @@ Qed.
Theorem eq_nat_decide : forall n m, {eq_nat n m} + {~ eq_nat n m}.
Proof.
- induction n.
- destruct m as [| n].
- auto with arith.
- intros; right; red; trivial with arith.
- destruct m as [| n0].
- right; red; auto with arith.
- intros.
- simpl.
- apply IHn.
+ induction n; destruct m; simpl.
+ - left; trivial.
+ - right; intro; trivial.
+ - right; intro; trivial.
+ - apply IHn.
Defined.
-(** * Boolean equality on [nat] *)
+(** * Boolean equality on [nat].
-Fixpoint beq_nat n m : bool :=
- match n, m with
- | O, O => true
- | O, S _ => false
- | S _, O => false
- | S n1, S m1 => beq_nat n1 m1
- end.
+ We reuse the one already defined in module [Nat].
+ In scope [nat_scope], the notation "=?" can be used. *)
-Lemma beq_nat_refl : forall n, true = beq_nat n n.
-Proof.
- intro x; induction x; simpl; auto.
-Qed.
+Notation beq_nat := Nat.eqb (compat "8.4").
-Definition beq_nat_eq : forall x y, true = beq_nat x y -> x = y.
-Proof.
- double induction x y; simpl.
- reflexivity.
- intros n H1 H2. discriminate H2.
- intros n H1 H2. discriminate H2.
- intros n H1 z H2 H3. case (H2 _ H3). reflexivity.
-Defined.
+Notation beq_nat_true_iff := Nat.eqb_eq (compat "8.4").
+Notation beq_nat_false_iff := Nat.eqb_neq (compat "8.4").
-Lemma beq_nat_true : forall x y, beq_nat x y = true -> x=y.
+Lemma beq_nat_refl n : true = (n =? n).
Proof.
- induction x; destruct y; simpl; auto; intros; discriminate.
+ symmetry. apply Nat.eqb_refl.
Qed.
-Lemma beq_nat_false : forall x y, beq_nat x y = false -> x<>y.
+Lemma beq_nat_true n m : (n =? m) = true -> n=m.
Proof.
- induction x; destruct y; simpl; auto; intros; discriminate.
+ apply Nat.eqb_eq.
Qed.
-Lemma beq_nat_true_iff : forall x y, beq_nat x y = true <-> x=y.
+Lemma beq_nat_false n m : (n =? m) = false -> n<>m.
Proof.
- split. apply beq_nat_true.
- intros; subst; symmetry; apply beq_nat_refl.
+ apply Nat.eqb_neq.
Qed.
-Lemma beq_nat_false_iff : forall x y, beq_nat x y = false <-> x<>y.
+(** TODO: is it really useful here to have a Defined ?
+ Otherwise we could use Nat.eqb_eq *)
+
+Definition beq_nat_eq : forall n m, true = (n =? m) -> n = m.
Proof.
- intros x y.
- split. apply beq_nat_false.
- generalize (beq_nat_true_iff x y).
- destruct beq_nat; auto.
- intros IFF NEQ. elim NEQ. apply IFF; auto.
-Qed.
+ induction n; destruct m; simpl.
+ - reflexivity.
+ - discriminate.
+ - discriminate.
+ - intros H. case (IHn _ H). reflexivity.
+Defined.
diff --git a/theories/Arith/Euclid.v b/theories/Arith/Euclid.v
index 8748b726..eaacab02 100644
--- a/theories/Arith/Euclid.v
+++ b/theories/Arith/Euclid.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -19,16 +19,12 @@ Inductive diveucl a b : Set :=
Lemma eucl_dev : forall n, n > 0 -> forall m:nat, diveucl m n.
Proof.
- intros b H a; pattern a; apply gt_wf_rec; intros n H0.
- elim (le_gt_dec b n).
- intro lebn.
- elim (H0 (n - b)); auto with arith.
- intros q r g e.
- apply divex with (S q) r; simpl; auto with arith.
- elim plus_assoc.
- elim e; auto with arith.
- intros gtbn.
- apply divex with 0 n; simpl; auto with arith.
+ induction m as (m,H0) using gt_wf_rec.
+ destruct (le_gt_dec n m) as [Hlebn|Hgtbn].
+ destruct (H0 (m - n)) as (q,r,Hge0,Heq); auto with arith.
+ apply divex with (S q) r; trivial.
+ simpl; rewrite <- plus_assoc, <- Heq; auto with arith.
+ apply divex with 0 m; simpl; trivial.
Defined.
Lemma quotient :
@@ -36,17 +32,12 @@ Lemma quotient :
n > 0 ->
forall m:nat, {q : nat | exists r : nat, m = q * n + r /\ n > r}.
Proof.
- intros b H a; pattern a; apply gt_wf_rec; intros n H0.
- elim (le_gt_dec b n).
- intro lebn.
- elim (H0 (n - b)); auto with arith.
- intros q Hq; exists (S q).
- elim Hq; intros r Hr.
- exists r; simpl; elim Hr; intros.
- elim plus_assoc.
- elim H1; auto with arith.
- intros gtbn.
- exists 0; exists n; simpl; auto with arith.
+ induction m as (m,H0) using gt_wf_rec.
+ destruct (le_gt_dec n m) as [Hlebn|Hgtbn].
+ destruct (H0 (m - n)) as (q & Hq); auto with arith; exists (S q).
+ destruct Hq as (r & Heq & Hgt); exists r; split; trivial.
+ simpl; rewrite <- plus_assoc, <- Heq; auto with arith.
+ exists 0; exists m; simpl; auto with arith.
Defined.
Lemma modulo :
@@ -54,15 +45,10 @@ Lemma modulo :
n > 0 ->
forall m:nat, {r : nat | exists q : nat, m = q * n + r /\ n > r}.
Proof.
- intros b H a; pattern a; apply gt_wf_rec; intros n H0.
- elim (le_gt_dec b n).
- intro lebn.
- elim (H0 (n - b)); auto with arith.
- intros r Hr; exists r.
- elim Hr; intros q Hq.
- elim Hq; intros; exists (S q); simpl.
- elim plus_assoc.
- elim H1; auto with arith.
- intros gtbn.
- exists n; exists 0; simpl; auto with arith.
+ induction m as (m,H0) using gt_wf_rec.
+ destruct (le_gt_dec n m) as [Hlebn|Hgtbn].
+ destruct (H0 (m - n)) as (r & Hr); auto with arith; exists r.
+ destruct Hr as (q & Heq & Hgt); exists (S q); split; trivial.
+ simpl; rewrite <- plus_assoc, <- Heq; auto with arith.
+ exists m; exists 0; simpl; auto with arith.
Defined.
diff --git a/theories/Arith/Even.v b/theories/Arith/Even.v
index 1e175971..0f94a8ed 100644
--- a/theories/Arith/Even.v
+++ b/theories/Arith/Even.v
@@ -1,21 +1,27 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
(************************************************************************)
+(** Nota : this file is OBSOLETE, and left only for compatibility.
+ Please consider instead predicates [Nat.Even] and [Nat.Odd]
+ and Boolean functions [Nat.even] and [Nat.odd]. *)
+
(** Here we define the predicates [even] and [odd] by mutual induction
and we prove the decidability and the exclusion of those predicates.
The main results about parity are proved in the module Div2. *)
+Require Import PeanoNat.
+
Local Open Scope nat_scope.
Implicit Types m n : nat.
-(** * Definition of [even] and [odd], and basic facts *)
+(** * Inductive definition of [even] and [odd] *)
Inductive even : nat -> Prop :=
| even_O : even 0
@@ -26,225 +32,150 @@ with odd : nat -> Prop :=
Hint Constructors even: arith.
Hint Constructors odd: arith.
-Lemma even_or_odd : forall n, even n \/ odd n.
+(** * Equivalence with predicates [Nat.Even] and [Nat.odd] *)
+
+Lemma even_equiv : forall n, even n <-> Nat.Even n.
+Proof.
+ fix 1.
+ destruct n as [|[|n]]; simpl.
+ - split; [now exists 0 | constructor].
+ - split.
+ + inversion_clear 1. inversion_clear H0.
+ + now rewrite <- Nat.even_spec.
+ - rewrite Nat.Even_succ_succ, <- even_equiv.
+ split.
+ + inversion_clear 1. now inversion_clear H0.
+ + now do 2 constructor.
+Qed.
+
+Lemma odd_equiv : forall n, odd n <-> Nat.Odd n.
+Proof.
+ fix 1.
+ destruct n as [|[|n]]; simpl.
+ - split.
+ + inversion_clear 1.
+ + now rewrite <- Nat.odd_spec.
+ - split; [ now exists 0 | do 2 constructor ].
+ - rewrite Nat.Odd_succ_succ, <- odd_equiv.
+ split.
+ + inversion_clear 1. now inversion_clear H0.
+ + now do 2 constructor.
+Qed.
+
+(** Basic facts *)
+
+Lemma even_or_odd n : even n \/ odd n.
Proof.
induction n.
- auto with arith.
- elim IHn; auto with arith.
+ - auto with arith.
+ - elim IHn; auto with arith.
Qed.
-Lemma even_odd_dec : forall n, {even n} + {odd n}.
+Lemma even_odd_dec n : {even n} + {odd n}.
Proof.
induction n.
- auto with arith.
- elim IHn; auto with arith.
+ - auto with arith.
+ - elim IHn; auto with arith.
Defined.
-Lemma not_even_and_odd : forall n, even n -> odd n -> False.
+Lemma not_even_and_odd n : even n -> odd n -> False.
Proof.
induction n.
- intros even_0 odd_0. inversion odd_0.
- intros even_Sn odd_Sn. inversion even_Sn. inversion odd_Sn. auto with arith.
+ - intros Ev Od. inversion Od.
+ - intros Ev Od. inversion Ev. inversion Od. auto with arith.
Qed.
(** * Facts about [even] & [odd] wrt. [plus] *)
-Lemma even_plus_split : forall n m,
- (even (n + m) -> even n /\ even m \/ odd n /\ odd m)
-with odd_plus_split : forall n m,
+Ltac parity2bool :=
+ rewrite ?even_equiv, ?odd_equiv, <- ?Nat.even_spec, <- ?Nat.odd_spec.
+
+Ltac parity_binop_spec :=
+ rewrite ?Nat.even_add, ?Nat.odd_add, ?Nat.even_mul, ?Nat.odd_mul.
+
+Ltac parity_binop :=
+ parity2bool; parity_binop_spec; unfold Nat.odd;
+ do 2 destruct Nat.even; simpl; tauto.
+
+
+Lemma even_plus_split n m :
+ even (n + m) -> even n /\ even m \/ odd n /\ odd m.
+Proof. parity_binop. Qed.
+
+Lemma odd_plus_split n m :
odd (n + m) -> odd n /\ even m \/ even n /\ odd m.
-Proof.
-intros. clear even_plus_split. destruct n; simpl in *.
- auto with arith.
- inversion_clear H;
- apply odd_plus_split in H0 as [(H0,?)|(H0,?)]; auto with arith.
-intros. clear odd_plus_split. destruct n; simpl in *.
- auto with arith.
- inversion_clear H;
- apply even_plus_split in H0 as [(H0,?)|(H0,?)]; auto with arith.
-Qed.
+Proof. parity_binop. Qed.
-Lemma even_even_plus : forall n m, even n -> even m -> even (n + m)
-with odd_plus_l : forall n m, odd n -> even m -> odd (n + m).
-Proof.
-intros n m [|] ?. trivial. apply even_S, odd_plus_l; trivial.
-intros n m [] ?. apply odd_S, even_even_plus; trivial.
-Qed.
+Lemma even_even_plus n m : even n -> even m -> even (n + m).
+Proof. parity_binop. Qed.
-Lemma odd_plus_r : forall n m, even n -> odd m -> odd (n + m)
-with odd_even_plus : forall n m, odd n -> odd m -> even (n + m).
-Proof.
-intros n m [|] ?. trivial. apply odd_S, odd_even_plus; trivial.
-intros n m [] ?. apply even_S, odd_plus_r; trivial.
-Qed.
+Lemma odd_plus_l n m : odd n -> even m -> odd (n + m).
+Proof. parity_binop. Qed.
+
+Lemma odd_plus_r n m : even n -> odd m -> odd (n + m).
+Proof. parity_binop. Qed.
-Lemma even_plus_aux : forall n m,
+Lemma odd_even_plus n m : odd n -> odd m -> even (n + m).
+Proof. parity_binop. Qed.
+
+Lemma even_plus_aux n m :
(odd (n + m) <-> odd n /\ even m \/ even n /\ odd m) /\
(even (n + m) <-> even n /\ even m \/ odd n /\ odd m).
-Proof.
-split; split; auto using odd_plus_split, even_plus_split.
-intros [[]|[]]; auto using odd_plus_r, odd_plus_l.
-intros [[]|[]]; auto using even_even_plus, odd_even_plus.
-Qed.
+Proof. parity_binop. Qed.
-Lemma even_plus_even_inv_r : forall n m, even (n + m) -> even n -> even m.
-Proof.
- intros n m H; destruct (even_plus_split n m) as [[]|[]]; auto.
- intro; destruct (not_even_and_odd n); auto.
-Qed.
+Lemma even_plus_even_inv_r n m : even (n + m) -> even n -> even m.
+Proof. parity_binop. Qed.
-Lemma even_plus_even_inv_l : forall n m, even (n + m) -> even m -> even n.
-Proof.
- intros n m H; destruct (even_plus_split n m) as [[]|[]]; auto.
- intro; destruct (not_even_and_odd m); auto.
-Qed.
+Lemma even_plus_even_inv_l n m : even (n + m) -> even m -> even n.
+Proof. parity_binop. Qed.
-Lemma even_plus_odd_inv_r : forall n m, even (n + m) -> odd n -> odd m.
-Proof.
- intros n m H; destruct (even_plus_split n m) as [[]|[]]; auto.
- intro; destruct (not_even_and_odd n); auto.
-Qed.
+Lemma even_plus_odd_inv_r n m : even (n + m) -> odd n -> odd m.
+Proof. parity_binop. Qed.
-Lemma even_plus_odd_inv_l : forall n m, even (n + m) -> odd m -> odd n.
-Proof.
- intros n m H; destruct (even_plus_split n m) as [[]|[]]; auto.
- intro; destruct (not_even_and_odd m); auto.
-Qed.
-Hint Resolve even_even_plus odd_even_plus: arith.
+Lemma even_plus_odd_inv_l n m : even (n + m) -> odd m -> odd n.
+Proof. parity_binop. Qed.
-Lemma odd_plus_even_inv_l : forall n m, odd (n + m) -> odd m -> even n.
-Proof.
- intros n m H; destruct (odd_plus_split n m) as [[]|[]]; auto.
- intro; destruct (not_even_and_odd m); auto.
-Qed.
+Lemma odd_plus_even_inv_l n m : odd (n + m) -> odd m -> even n.
+Proof. parity_binop. Qed.
-Lemma odd_plus_even_inv_r : forall n m, odd (n + m) -> odd n -> even m.
-Proof.
- intros n m H; destruct (odd_plus_split n m) as [[]|[]]; auto.
- intro; destruct (not_even_and_odd n); auto.
-Qed.
+Lemma odd_plus_even_inv_r n m : odd (n + m) -> odd n -> even m.
+Proof. parity_binop. Qed.
-Lemma odd_plus_odd_inv_l : forall n m, odd (n + m) -> even m -> odd n.
-Proof.
- intros n m H; destruct (odd_plus_split n m) as [[]|[]]; auto.
- intro; destruct (not_even_and_odd m); auto.
-Qed.
+Lemma odd_plus_odd_inv_l n m : odd (n + m) -> even m -> odd n.
+Proof. parity_binop. Qed.
-Lemma odd_plus_odd_inv_r : forall n m, odd (n + m) -> even n -> odd m.
-Proof.
- intros n m H; destruct (odd_plus_split n m) as [[]|[]]; auto.
- intro; destruct (not_even_and_odd n); auto.
-Qed.
-Hint Resolve odd_plus_l odd_plus_r: arith.
+Lemma odd_plus_odd_inv_r n m : odd (n + m) -> even n -> odd m.
+Proof. parity_binop. Qed.
(** * Facts about [even] and [odd] wrt. [mult] *)
-Lemma even_mult_aux :
- forall n m,
- (odd (n * m) <-> odd n /\ odd m) /\ (even (n * m) <-> even n \/ even m).
-Proof.
- intros n; elim n; simpl; auto with arith.
- intros m; split; split; auto with arith.
- intros H'; inversion H'.
- intros H'; elim H'; auto.
- intros n0 H' m; split; split; auto with arith.
- intros H'0.
- elim (even_plus_aux m (n0 * m)); intros H'3 H'4; case H'3; intros H'1 H'2;
- case H'1; auto.
- intros H'5; elim H'5; intros H'6 H'7; auto with arith.
- split; auto with arith.
- case (H' m).
- intros H'8 H'9; case H'9.
- intros H'10; case H'10; auto with arith.
- intros H'11 H'12; case (not_even_and_odd m); auto with arith.
- intros H'5; elim H'5; intros H'6 H'7; case (not_even_and_odd (n0 * m)); auto.
- case (H' m).
- intros H'8 H'9; case H'9; auto.
- intros H'0; elim H'0; intros H'1 H'2; clear H'0.
- elim (even_plus_aux m (n0 * m)); auto.
- intros H'0 H'3.
- elim H'0.
- intros H'4 H'5; apply H'5; auto.
- left; split; auto with arith.
- case (H' m).
- intros H'6 H'7; elim H'7.
- intros H'8 H'9; apply H'9.
- left.
- inversion H'1; auto.
- intros H'0.
- elim (even_plus_aux m (n0 * m)); intros H'3 H'4; case H'4.
- intros H'1 H'2.
- elim H'1; auto.
- intros H; case H; auto.
- intros H'5; elim H'5; intros H'6 H'7; auto with arith.
- left.
- case (H' m).
- intros H'8; elim H'8.
- intros H'9; elim H'9; auto with arith.
- intros H'0; elim H'0; intros H'1.
- case (even_or_odd m); intros H'2.
- apply even_even_plus; auto.
- case (H' m).
- intros H H0; case H0; auto.
- apply odd_even_plus; auto.
- inversion H'1; case (H' m); auto.
- intros H1; case H1; auto.
- apply even_even_plus; auto.
- case (H' m).
- intros H H0; case H0; auto.
-Qed.
+Lemma even_mult_aux n m :
+ (odd (n * m) <-> odd n /\ odd m) /\ (even (n * m) <-> even n \/ even m).
+Proof. parity_binop. Qed.
-Lemma even_mult_l : forall n m, even n -> even (n * m).
-Proof.
- intros n m; case (even_mult_aux n m); auto.
- intros H H0; case H0; auto.
-Qed.
+Lemma even_mult_l n m : even n -> even (n * m).
+Proof. parity_binop. Qed.
-Lemma even_mult_r : forall n m, even m -> even (n * m).
-Proof.
- intros n m; case (even_mult_aux n m); auto.
- intros H H0; case H0; auto.
-Qed.
-Hint Resolve even_mult_l even_mult_r: arith.
+Lemma even_mult_r n m : even m -> even (n * m).
+Proof. parity_binop. Qed.
-Lemma even_mult_inv_r : forall n m, even (n * m) -> odd n -> even m.
-Proof.
- intros n m H' H'0.
- case (even_mult_aux n m).
- intros H'1 H'2; elim H'2.
- intros H'3; elim H'3; auto.
- intros H; case (not_even_and_odd n); auto.
-Qed.
+Lemma even_mult_inv_r n m : even (n * m) -> odd n -> even m.
+Proof. parity_binop. Qed.
-Lemma even_mult_inv_l : forall n m, even (n * m) -> odd m -> even n.
-Proof.
- intros n m H' H'0.
- case (even_mult_aux n m).
- intros H'1 H'2; elim H'2.
- intros H'3; elim H'3; auto.
- intros H; case (not_even_and_odd m); auto.
-Qed.
+Lemma even_mult_inv_l n m : even (n * m) -> odd m -> even n.
+Proof. parity_binop. Qed.
-Lemma odd_mult : forall n m, odd n -> odd m -> odd (n * m).
-Proof.
- intros n m; case (even_mult_aux n m); intros H; case H; auto.
-Qed.
-Hint Resolve even_mult_l even_mult_r odd_mult: arith.
+Lemma odd_mult n m : odd n -> odd m -> odd (n * m).
+Proof. parity_binop. Qed.
-Lemma odd_mult_inv_l : forall n m, odd (n * m) -> odd n.
-Proof.
- intros n m H'.
- case (even_mult_aux n m).
- intros H'1 H'2; elim H'1.
- intros H'3; elim H'3; auto.
-Qed.
+Lemma odd_mult_inv_l n m : odd (n * m) -> odd n.
+Proof. parity_binop. Qed.
-Lemma odd_mult_inv_r : forall n m, odd (n * m) -> odd m.
-Proof.
- intros n m H'.
- case (even_mult_aux n m).
- intros H'1 H'2; elim H'1.
- intros H'3; elim H'3; auto.
-Qed.
+Lemma odd_mult_inv_r n m : odd (n * m) -> odd m.
+Proof. parity_binop. Qed.
+
+Hint Resolve
+ even_even_plus odd_even_plus odd_plus_l odd_plus_r
+ even_mult_l even_mult_r even_mult_l even_mult_r odd_mult : arith.
diff --git a/theories/Arith/Factorial.v b/theories/Arith/Factorial.v
index 870ea4e1..7d29f23c 100644
--- a/theories/Arith/Factorial.v
+++ b/theories/Arith/Factorial.v
@@ -1,14 +1,12 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
(************************************************************************)
-Require Import Plus.
-Require Import Mult.
-Require Import Lt.
+Require Import PeanoNat Plus Mult Lt.
Local Open Scope nat_scope.
(** Factorial *)
@@ -21,28 +19,19 @@ Fixpoint fact (n:nat) : nat :=
Arguments fact n%nat.
-Lemma lt_O_fact : forall n:nat, 0 < fact n.
+Lemma lt_O_fact n : 0 < fact n.
Proof.
- simple induction n; unfold lt; simpl; auto with arith.
+ induction n; simpl; auto with arith.
Qed.
-Lemma fact_neq_0 : forall n:nat, fact n <> 0.
+Lemma fact_neq_0 n : fact n <> 0.
Proof.
- intro.
- apply not_eq_sym.
- apply lt_O_neq.
- apply lt_O_fact.
+ apply Nat.neq_0_lt_0, lt_O_fact.
Qed.
-Lemma fact_le : forall n m:nat, n <= m -> fact n <= fact m.
+Lemma fact_le n m : n <= m -> fact n <= fact m.
Proof.
induction 1.
- apply le_n.
- assert (1 * fact n <= S m * fact m).
- apply mult_le_compat.
- apply lt_le_S; apply lt_O_Sn.
- assumption.
- simpl (1 * fact n) in H0.
- rewrite <- plus_n_O in H0.
- assumption.
+ - apply le_n.
+ - simpl. transitivity (fact m). trivial. apply Nat.le_add_r.
Qed.
diff --git a/theories/Arith/Gt.v b/theories/Arith/Gt.v
index afd146e7..e406ff0d 100644
--- a/theories/Arith/Gt.v
+++ b/theories/Arith/Gt.v
@@ -1,154 +1,145 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
(************************************************************************)
-(** Theorems about [gt] in [nat]. [gt] is defined in [Init/Peano.v] as:
+(** Theorems about [gt] in [nat].
+
+ This file is DEPRECATED now, see module [PeanoNat.Nat] instead,
+ which favor [lt] over [gt].
+
+ [gt] is defined in [Init/Peano.v] as:
<<
Definition gt (n m:nat) := m < n.
>>
*)
-Require Import Le.
-Require Import Lt.
-Require Import Plus.
+Require Import PeanoNat Le Lt Plus.
Local Open Scope nat_scope.
-Implicit Types m n p : nat.
-
(** * Order and successor *)
-Theorem gt_Sn_O : forall n, S n > 0.
-Proof.
- auto with arith.
-Qed.
-Hint Resolve gt_Sn_O: arith v62.
+Theorem gt_Sn_O n : S n > 0.
+Proof Nat.lt_0_succ _.
-Theorem gt_Sn_n : forall n, S n > n.
-Proof.
- auto with arith.
-Qed.
-Hint Resolve gt_Sn_n: arith v62.
+Theorem gt_Sn_n n : S n > n.
+Proof Nat.lt_succ_diag_r _.
-Theorem gt_n_S : forall n m, n > m -> S n > S m.
+Theorem gt_n_S n m : n > m -> S n > S m.
Proof.
- auto with arith.
+ apply Nat.succ_lt_mono.
Qed.
-Hint Resolve gt_n_S: arith v62.
-Lemma gt_S_n : forall n m, S m > S n -> m > n.
+Lemma gt_S_n n m : S m > S n -> m > n.
Proof.
- auto with arith.
+ apply Nat.succ_lt_mono.
Qed.
-Hint Immediate gt_S_n: arith v62.
-Theorem gt_S : forall n m, S n > m -> n > m \/ m = n.
+Theorem gt_S n m : S n > m -> n > m \/ m = n.
Proof.
- intros n m H; unfold gt; apply le_lt_or_eq; auto with arith.
+ intro. now apply Nat.lt_eq_cases, Nat.succ_le_mono.
Qed.
-Lemma gt_pred : forall n m, m > S n -> pred m > n.
+Lemma gt_pred n m : m > S n -> pred m > n.
Proof.
- auto with arith.
+ apply Nat.lt_succ_lt_pred.
Qed.
-Hint Immediate gt_pred: arith v62.
(** * Irreflexivity *)
-Lemma gt_irrefl : forall n, ~ n > n.
-Proof lt_irrefl.
-Hint Resolve gt_irrefl: arith v62.
+Lemma gt_irrefl n : ~ n > n.
+Proof Nat.lt_irrefl _.
(** * Asymmetry *)
-Lemma gt_asym : forall n m, n > m -> ~ m > n.
-Proof fun n m => lt_asym m n.
-
-Hint Resolve gt_asym: arith v62.
+Lemma gt_asym n m : n > m -> ~ m > n.
+Proof Nat.lt_asymm _ _.
(** * Relating strict and large orders *)
-Lemma le_not_gt : forall n m, n <= m -> ~ n > m.
-Proof le_not_lt.
-Hint Resolve le_not_gt: arith v62.
-
-Lemma gt_not_le : forall n m, n > m -> ~ n <= m.
+Lemma le_not_gt n m : n <= m -> ~ n > m.
Proof.
-auto with arith.
+ apply Nat.le_ngt.
Qed.
-Hint Resolve gt_not_le: arith v62.
+Lemma gt_not_le n m : n > m -> ~ n <= m.
+Proof.
+ apply Nat.lt_nge.
+Qed.
-Theorem le_S_gt : forall n m, S n <= m -> m > n.
+Theorem le_S_gt n m : S n <= m -> m > n.
Proof.
- auto with arith.
+ apply Nat.le_succ_l.
Qed.
-Hint Immediate le_S_gt: arith v62.
-Lemma gt_S_le : forall n m, S m > n -> n <= m.
+Lemma gt_S_le n m : S m > n -> n <= m.
Proof.
- intros n p; exact (lt_n_Sm_le n p).
+ apply Nat.succ_le_mono.
Qed.
-Hint Immediate gt_S_le: arith v62.
-Lemma gt_le_S : forall n m, m > n -> S n <= m.
+Lemma gt_le_S n m : m > n -> S n <= m.
Proof.
- auto with arith.
+ apply Nat.le_succ_l.
Qed.
-Hint Resolve gt_le_S: arith v62.
-Lemma le_gt_S : forall n m, n <= m -> S m > n.
+Lemma le_gt_S n m : n <= m -> S m > n.
Proof.
- auto with arith.
+ apply Nat.succ_le_mono.
Qed.
-Hint Resolve le_gt_S: arith v62.
(** * Transitivity *)
-Theorem le_gt_trans : forall n m p, m <= n -> m > p -> n > p.
+Theorem le_gt_trans n m p : m <= n -> m > p -> n > p.
Proof.
- red; intros; apply lt_le_trans with m; auto with arith.
+ intros. now apply Nat.lt_le_trans with m.
Qed.
-Theorem gt_le_trans : forall n m p, n > m -> p <= m -> n > p.
+Theorem gt_le_trans n m p : n > m -> p <= m -> n > p.
Proof.
- red; intros; apply le_lt_trans with m; auto with arith.
+ intros. now apply Nat.le_lt_trans with m.
Qed.
-Lemma gt_trans : forall n m p, n > m -> m > p -> n > p.
+Lemma gt_trans n m p : n > m -> m > p -> n > p.
Proof.
- red; intros n m p H1 H2.
- apply lt_trans with m; auto with arith.
+ intros. now apply Nat.lt_trans with m.
Qed.
-Theorem gt_trans_S : forall n m p, S n > m -> m > p -> n > p.
+Theorem gt_trans_S n m p : S n > m -> m > p -> n > p.
Proof.
- red; intros; apply lt_le_trans with m; auto with arith.
+ intros. apply Nat.lt_le_trans with m; trivial. now apply Nat.succ_le_mono.
Qed.
-Hint Resolve gt_trans_S le_gt_trans gt_le_trans: arith v62.
-
(** * Comparison to 0 *)
-Theorem gt_0_eq : forall n, n > 0 \/ 0 = n.
+Theorem gt_0_eq n : n > 0 \/ 0 = n.
Proof.
- intro n; apply gt_S; auto with arith.
+ destruct n; [now right | left; apply Nat.lt_0_succ].
Qed.
(** * Simplification and compatibility *)
-Lemma plus_gt_reg_l : forall n m p, p + n > p + m -> n > m.
+Lemma plus_gt_reg_l n m p : p + n > p + m -> n > m.
Proof.
- red; intros n m p H; apply plus_lt_reg_l with p; auto with arith.
+ apply Nat.add_lt_mono_l.
Qed.
-Lemma plus_gt_compat_l : forall n m p, n > m -> p + n > p + m.
+Lemma plus_gt_compat_l n m p : n > m -> p + n > p + m.
Proof.
- auto with arith.
+ apply Nat.add_lt_mono_l.
Qed.
+
+(** * Hints *)
+
+Hint Resolve gt_Sn_O gt_Sn_n gt_n_S : arith v62.
+Hint Immediate gt_S_n gt_pred : arith v62.
+Hint Resolve gt_irrefl gt_asym : arith v62.
+Hint Resolve le_not_gt gt_not_le : arith v62.
+Hint Immediate le_S_gt gt_S_le : arith v62.
+Hint Resolve gt_le_S le_gt_S : arith v62.
+Hint Resolve gt_trans_S le_gt_trans gt_le_trans: arith v62.
Hint Resolve plus_gt_compat_l: arith v62.
(* begin hide *)
diff --git a/theories/Arith/Le.v b/theories/Arith/Le.v
index 6a3a583c..875863e4 100644
--- a/theories/Arith/Le.v
+++ b/theories/Arith/Le.v
@@ -1,12 +1,16 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
(************************************************************************)
-(** Order on natural numbers. [le] is defined in [Init/Peano.v] as:
+(** Order on natural numbers.
+
+ This file is mostly OBSOLETE now, see module [PeanoNat.Nat] instead.
+
+ [le] is defined in [Init/Peano.v] as:
<<
Inductive le (n:nat) : nat -> Prop :=
| le_n : n <= n
@@ -14,110 +18,58 @@ Inductive le (n:nat) : nat -> Prop :=
where "n <= m" := (le n m) : nat_scope.
>>
- *)
+*)
-Local Open Scope nat_scope.
+Require Import PeanoNat.
-Implicit Types m n p : nat.
+Local Open Scope nat_scope.
-(** * [le] is a pre-order *)
+(** * [le] is an order on [nat] *)
-(** Reflexivity *)
-Theorem le_refl : forall n, n <= n.
-Proof.
- exact le_n.
-Qed.
+Notation le_refl := Nat.le_refl (compat "8.4").
+Notation le_trans := Nat.le_trans (compat "8.4").
+Notation le_antisym := Nat.le_antisymm (compat "8.4").
-(** Transitivity *)
-Theorem le_trans : forall n m p, n <= m -> m <= p -> n <= p.
-Proof.
- induction 2; auto.
-Qed.
Hint Resolve le_trans: arith v62.
+Hint Immediate le_antisym: arith v62.
-(** * Properties of [le] w.r.t. successor, predecessor and 0 *)
-
-(** Comparison to 0 *)
-
-Theorem le_0_n : forall n, 0 <= n.
-Proof.
- induction n; auto.
-Qed.
-
-Theorem le_Sn_0 : forall n, ~ S n <= 0.
-Proof.
- red; intros n H.
- change (IsSucc 0); elim H; simpl; auto with arith.
-Qed.
+(** * Properties of [le] w.r.t 0 *)
-Hint Resolve le_0_n le_Sn_0: arith v62.
+Notation le_0_n := Nat.le_0_l (compat "8.4"). (* 0 <= n *)
+Notation le_Sn_0 := Nat.nle_succ_0 (compat "8.4"). (* ~ S n <= 0 *)
-Theorem le_n_0_eq : forall n, n <= 0 -> 0 = n.
+Lemma le_n_0_eq n : n <= 0 -> 0 = n.
Proof.
- induction n; auto with arith.
- intro; contradiction le_Sn_0 with n.
+ intros. symmetry. now apply Nat.le_0_r.
Qed.
-Hint Immediate le_n_0_eq: arith v62.
+(** * Properties of [le] w.r.t successor *)
-(** [le] and successor *)
+(** See also [Nat.succ_le_mono]. *)
Theorem le_n_S : forall n m, n <= m -> S n <= S m.
-Proof.
- induction 1; auto.
-Qed.
+Proof Peano.le_n_S.
-Theorem le_n_Sn : forall n, n <= S n.
-Proof.
- auto.
-Qed.
+Theorem le_S_n : forall n m, S n <= S m -> n <= m.
+Proof Peano.le_S_n.
-Hint Resolve le_n_S le_n_Sn : arith v62.
+Notation le_n_Sn := Nat.le_succ_diag_r (compat "8.4"). (* n <= S n *)
+Notation le_Sn_n := Nat.nle_succ_diag_l (compat "8.4"). (* ~ S n <= n *)
Theorem le_Sn_le : forall n m, S n <= m -> n <= m.
-Proof.
- intros n m H; apply le_trans with (S n); auto with arith.
-Qed.
-Hint Immediate le_Sn_le: arith v62.
+Proof Nat.lt_le_incl.
-Theorem le_S_n : forall n m, S n <= S m -> n <= m.
-Proof.
- exact Peano.le_S_n.
-Qed.
-Hint Immediate le_S_n: arith v62.
+Hint Resolve le_0_n le_Sn_0: arith v62.
+Hint Resolve le_n_S le_n_Sn le_Sn_n : arith v62.
+Hint Immediate le_n_0_eq le_Sn_le le_S_n : arith v62.
-Theorem le_Sn_n : forall n, ~ S n <= n.
-Proof.
- induction n; auto with arith.
-Qed.
-Hint Resolve le_Sn_n: arith v62.
+(** * Properties of [le] w.r.t predecessor *)
-(** [le] and predecessor *)
+Notation le_pred_n := Nat.le_pred_l (compat "8.4"). (* pred n <= n *)
+Notation le_pred := Nat.pred_le_mono (compat "8.4"). (* n<=m -> pred n <= pred m *)
-Theorem le_pred_n : forall n, pred n <= n.
-Proof.
- induction n; auto with arith.
-Qed.
Hint Resolve le_pred_n: arith v62.
-Theorem le_pred : forall n m, n <= m -> pred n <= pred m.
-Proof.
- exact Peano.le_pred.
-Qed.
-
-(** * [le] is a order on [nat] *)
-(** Antisymmetry *)
-
-Theorem le_antisym : forall n m, n <= m -> m <= n -> n = m.
-Proof.
- intros n m H; destruct H as [|m' H]; auto with arith.
- intros H1.
- absurd (S m' <= m'); auto with arith.
- apply le_trans with n; auto with arith.
-Qed.
-Hint Immediate le_antisym: arith v62.
-
-
(** * A different elimination principle for the order on natural numbers *)
Lemma le_elim_rel :
@@ -126,10 +78,10 @@ Lemma le_elim_rel :
(forall p (q:nat), p <= q -> P p q -> P (S p) (S q)) ->
forall n m, n <= m -> P n m.
Proof.
- induction n; auto with arith.
- intros m Le.
- elim Le; auto with arith.
-Qed.
+ intros P H0 HS.
+ induction n; trivial.
+ intros m Le. elim Le; auto with arith.
+ Qed.
(* begin hide *)
Notation le_O_n := le_0_n (only parsing).
diff --git a/theories/Arith/Lt.v b/theories/Arith/Lt.v
index 3ce42a6e..b783ca33 100644
--- a/theories/Arith/Lt.v
+++ b/theories/Arith/Lt.v
@@ -1,190 +1,154 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
(************************************************************************)
-(** Theorems about [lt] in nat. [lt] is defined in library [Init/Peano.v] as:
+(** Strict order on natural numbers.
+
+ This file is mostly OBSOLETE now, see module [PeanoNat.Nat] instead.
+
+ [lt] is defined in library [Init/Peano.v] as:
<<
Definition lt (n m:nat) := S n <= m.
Infix "<" := lt : nat_scope.
>>
*)
-Require Import Le.
-Local Open Scope nat_scope.
+Require Import PeanoNat.
-Implicit Types m n p : nat.
+Local Open Scope nat_scope.
(** * Irreflexivity *)
-Theorem lt_irrefl : forall n, ~ n < n.
-Proof le_Sn_n.
+Notation lt_irrefl := Nat.lt_irrefl (compat "8.4"). (* ~ x < x *)
+
Hint Resolve lt_irrefl: arith v62.
(** * Relationship between [le] and [lt] *)
-Theorem lt_le_S : forall n m, n < m -> S n <= m.
+Theorem lt_le_S n m : n < m -> S n <= m.
Proof.
- auto with arith.
+ apply Nat.le_succ_l.
Qed.
-Hint Immediate lt_le_S: arith v62.
-Theorem lt_n_Sm_le : forall n m, n < S m -> n <= m.
+Theorem lt_n_Sm_le n m : n < S m -> n <= m.
Proof.
- auto with arith.
+ apply Nat.lt_succ_r.
Qed.
-Hint Immediate lt_n_Sm_le: arith v62.
-Theorem le_lt_n_Sm : forall n m, n <= m -> n < S m.
+Theorem le_lt_n_Sm n m : n <= m -> n < S m.
Proof.
- auto with arith.
+ apply Nat.lt_succ_r.
Qed.
+
+Hint Immediate lt_le_S: arith v62.
+Hint Immediate lt_n_Sm_le: arith v62.
Hint Immediate le_lt_n_Sm: arith v62.
-Theorem le_not_lt : forall n m, n <= m -> ~ m < n.
+Theorem le_not_lt n m : n <= m -> ~ m < n.
Proof.
- induction 1; auto with arith.
+ apply Nat.le_ngt.
Qed.
-Theorem lt_not_le : forall n m, n < m -> ~ m <= n.
+Theorem lt_not_le n m : n < m -> ~ m <= n.
Proof.
- red; intros n m Lt Le; exact (le_not_lt m n Le Lt).
+ apply Nat.lt_nge.
Qed.
+
Hint Immediate le_not_lt lt_not_le: arith v62.
(** * Asymmetry *)
-Theorem lt_asym : forall n m, n < m -> ~ m < n.
-Proof.
- induction 1; auto with arith.
-Qed.
+Notation lt_asym := Nat.lt_asymm (compat "8.4"). (* n<m -> ~m<n *)
-(** * Order and successor *)
+(** * Order and 0 *)
-Theorem lt_n_Sn : forall n, n < S n.
-Proof.
- auto with arith.
-Qed.
-Hint Resolve lt_n_Sn: arith v62.
+Notation lt_0_Sn := Nat.lt_0_succ (compat "8.4"). (* 0 < S n *)
+Notation lt_n_0 := Nat.nlt_0_r (compat "8.4"). (* ~ n < 0 *)
-Theorem lt_S : forall n m, n < m -> n < S m.
+Theorem neq_0_lt n : 0 <> n -> 0 < n.
Proof.
- auto with arith.
+ intros. now apply Nat.neq_0_lt_0, Nat.neq_sym.
Qed.
-Hint Resolve lt_S: arith v62.
-Theorem lt_n_S : forall n m, n < m -> S n < S m.
+Theorem lt_0_neq n : 0 < n -> 0 <> n.
Proof.
- auto with arith.
+ intros. now apply Nat.neq_sym, Nat.neq_0_lt_0.
Qed.
-Hint Resolve lt_n_S: arith v62.
-Theorem lt_S_n : forall n m, S n < S m -> n < m.
+Hint Resolve lt_0_Sn lt_n_0 : arith v62.
+Hint Immediate neq_0_lt lt_0_neq: arith v62.
+
+(** * Order and successor *)
+
+Notation lt_n_Sn := Nat.lt_succ_diag_r (compat "8.4"). (* n < S n *)
+Notation lt_S := Nat.lt_lt_succ_r (compat "8.4"). (* n < m -> n < S m *)
+
+Theorem lt_n_S n m : n < m -> S n < S m.
Proof.
- auto with arith.
+ apply Nat.succ_lt_mono.
Qed.
-Hint Immediate lt_S_n: arith v62.
-Theorem lt_0_Sn : forall n, 0 < S n.
+Theorem lt_S_n n m : S n < S m -> n < m.
Proof.
- auto with arith.
+ apply Nat.succ_lt_mono.
Qed.
-Hint Resolve lt_0_Sn: arith v62.
-Theorem lt_n_0 : forall n, ~ n < 0.
-Proof le_Sn_0.
-Hint Resolve lt_n_0: arith v62.
+Hint Resolve lt_n_Sn lt_S lt_n_S : arith v62.
+Hint Immediate lt_S_n : arith v62.
(** * Predecessor *)
-Lemma S_pred : forall n m, m < n -> n = S (pred n).
+Lemma S_pred n m : m < n -> n = S (pred n).
Proof.
-induction 1; auto with arith.
+ intros. symmetry. now apply Nat.lt_succ_pred with m.
Qed.
-Lemma lt_pred : forall n m, S n < m -> n < pred m.
+Lemma lt_pred n m : S n < m -> n < pred m.
Proof.
-induction 1; simpl; auto with arith.
+ apply Nat.lt_succ_lt_pred.
Qed.
-Hint Immediate lt_pred: arith v62.
-Lemma lt_pred_n_n : forall n, 0 < n -> pred n < n.
-destruct 1; simpl; auto with arith.
+Lemma lt_pred_n_n n : 0 < n -> pred n < n.
+Proof.
+ intros. now apply Nat.lt_pred_l, Nat.neq_0_lt_0.
Qed.
+
+Hint Immediate lt_pred: arith v62.
Hint Resolve lt_pred_n_n: arith v62.
(** * Transitivity properties *)
-Theorem lt_trans : forall n m p, n < m -> m < p -> n < p.
-Proof.
- induction 2; auto with arith.
-Qed.
-
-Theorem lt_le_trans : forall n m p, n < m -> m <= p -> n < p.
-Proof.
- induction 2; auto with arith.
-Qed.
-
-Theorem le_lt_trans : forall n m p, n <= m -> m < p -> n < p.
-Proof.
- induction 2; auto with arith.
-Qed.
+Notation lt_trans := Nat.lt_trans (compat "8.4").
+Notation lt_le_trans := Nat.lt_le_trans (compat "8.4").
+Notation le_lt_trans := Nat.le_lt_trans (compat "8.4").
Hint Resolve lt_trans lt_le_trans le_lt_trans: arith v62.
(** * Large = strict or equal *)
-Theorem le_lt_or_eq : forall n m, n <= m -> n < m \/ n = m.
-Proof.
- induction 1; auto with arith.
-Qed.
+Notation le_lt_or_eq_iff := Nat.lt_eq_cases (compat "8.4").
-Theorem le_lt_or_eq_iff : forall n m, n <= m <-> n < m \/ n = m.
+Theorem le_lt_or_eq n m : n <= m -> n < m \/ n = m.
Proof.
- split.
- intros; apply le_lt_or_eq; auto.
- destruct 1; subst; auto with arith.
+ apply Nat.lt_eq_cases.
Qed.
-Theorem lt_le_weak : forall n m, n < m -> n <= m.
-Proof.
- auto with arith.
-Qed.
+Notation lt_le_weak := Nat.lt_le_incl (compat "8.4").
+
Hint Immediate lt_le_weak: arith v62.
(** * Dichotomy *)
-Theorem le_or_lt : forall n m, n <= m \/ m < n.
-Proof.
- intros n m; pattern n, m; apply nat_double_ind; auto with arith.
- induction 1; auto with arith.
-Qed.
-
-Theorem nat_total_order : forall n m, n <> m -> n < m \/ m < n.
-Proof.
- intros m n diff.
- elim (le_or_lt n m); [ intro H'0 | auto with arith ].
- elim (le_lt_or_eq n m); auto with arith.
- intro H'; elim diff; auto with arith.
-Qed.
-
-(** * Comparison to 0 *)
+Notation le_or_lt := Nat.le_gt_cases (compat "8.4"). (* n <= m \/ m < n *)
-Theorem neq_0_lt : forall n, 0 <> n -> 0 < n.
+Theorem nat_total_order n m : n <> m -> n < m \/ m < n.
Proof.
- induction n; auto with arith.
- intros; absurd (0 = 0); trivial with arith.
+ apply Nat.lt_gt_cases.
Qed.
-Hint Immediate neq_0_lt: arith v62.
-
-Theorem lt_0_neq : forall n, 0 < n -> 0 <> n.
-Proof.
- induction 1; auto with arith.
-Qed.
-Hint Immediate lt_0_neq: arith v62.
(* begin hide *)
Notation lt_O_Sn := lt_0_Sn (only parsing).
@@ -192,3 +156,7 @@ Notation neq_O_lt := neq_0_lt (only parsing).
Notation lt_O_neq := lt_0_neq (only parsing).
Notation lt_n_O := lt_n_0 (only parsing).
(* end hide *)
+
+(** For compatibility, we "Require" the same files as before *)
+
+Require Import Le.
diff --git a/theories/Arith/Max.v b/theories/Arith/Max.v
index 721428e5..26875373 100644
--- a/theories/Arith/Max.v
+++ b/theories/Arith/Max.v
@@ -1,19 +1,19 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
(************************************************************************)
-(** THIS FILE IS DEPRECATED. Use [NPeano.Nat] instead. *)
+(** THIS FILE IS DEPRECATED. Use [PeanoNat.Nat] instead. *)
-Require Import NPeano.
+Require Import PeanoNat.
Local Open Scope nat_scope.
Implicit Types m n p : nat.
-Notation max := Peano.max (only parsing).
+Notation max := Nat.max (only parsing).
Definition max_0_l := Nat.max_0_l.
Definition max_0_r := Nat.max_0_r.
diff --git a/theories/Arith/Min.v b/theories/Arith/Min.v
index 206ebc4b..f2fa3aec 100644
--- a/theories/Arith/Min.v
+++ b/theories/Arith/Min.v
@@ -1,19 +1,19 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
(************************************************************************)
-(** THIS FILE IS DEPRECATED. Use [NPeano.Nat] instead. *)
+(** THIS FILE IS DEPRECATED. Use [PeanoNat.Nat] instead. *)
-Require Import NPeano.
+Require Import PeanoNat.
Local Open Scope nat_scope.
Implicit Types m n p : nat.
-Notation min := Peano.min (only parsing).
+Notation min := Nat.min (only parsing).
Definition min_0_l := Nat.min_0_l.
Definition min_0_r := Nat.min_0_r.
diff --git a/theories/Arith/Minus.v b/theories/Arith/Minus.v
index 9bfced44..6e312e4f 100644
--- a/theories/Arith/Minus.v
+++ b/theories/Arith/Minus.v
@@ -1,156 +1,119 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
(************************************************************************)
-(** [minus] (difference between two natural numbers) is defined in [Init/Peano.v] as:
+(** Properties of subtraction between natural numbers.
+
+ This file is mostly OBSOLETE now, see module [PeanoNat.Nat] instead.
+
+ [minus] is now an alias for [Nat.sub], which is defined in [Init/Nat.v] as:
<<
-Fixpoint minus (n m:nat) : nat :=
+Fixpoint sub (n m:nat) : nat :=
match n, m with
- | O, _ => n
- | S k, O => S k
| S k, S l => k - l
+ | _, _ => n
end
-where "n - m" := (minus n m) : nat_scope.
+where "n - m" := (sub n m) : nat_scope.
>>
*)
-Require Import Lt.
-Require Import Le.
+Require Import PeanoNat Lt Le.
Local Open Scope nat_scope.
-Implicit Types m n p : nat.
-
(** * 0 is right neutral *)
-Lemma minus_n_O : forall n, n = n - 0.
+Lemma minus_n_O n : n = n - 0.
Proof.
- induction n; simpl; auto with arith.
+ symmetry. apply Nat.sub_0_r.
Qed.
-Hint Resolve minus_n_O: arith v62.
(** * Permutation with successor *)
-Lemma minus_Sn_m : forall n m, m <= n -> S (n - m) = S n - m.
+Lemma minus_Sn_m n m : m <= n -> S (n - m) = S n - m.
Proof.
- intros n m Le; pattern m, n; apply le_elim_rel; simpl;
- auto with arith.
+ intros. symmetry. now apply Nat.sub_succ_l.
Qed.
-Hint Resolve minus_Sn_m: arith v62.
-Theorem pred_of_minus : forall n, pred n = n - 1.
+Theorem pred_of_minus n : pred n = n - 1.
Proof.
- intro x; induction x; simpl; auto with arith.
+ symmetry. apply Nat.sub_1_r.
Qed.
(** * Diagonal *)
-Lemma minus_diag : forall n, n - n = 0.
-Proof.
- induction n; simpl; auto with arith.
-Qed.
+Notation minus_diag := Nat.sub_diag (compat "8.4"). (* n - n = 0 *)
-Lemma minus_diag_reverse : forall n, 0 = n - n.
+Lemma minus_diag_reverse n : 0 = n - n.
Proof.
- auto using minus_diag.
+ symmetry. apply Nat.sub_diag.
Qed.
-Hint Resolve minus_diag_reverse: arith v62.
Notation minus_n_n := minus_diag_reverse.
(** * Simplification *)
-Lemma minus_plus_simpl_l_reverse : forall n m p, n - m = p + n - (p + m).
+Lemma minus_plus_simpl_l_reverse n m p : n - m = p + n - (p + m).
Proof.
- induction p; simpl; auto with arith.
+ now rewrite Nat.sub_add_distr, Nat.add_comm, Nat.add_sub.
Qed.
-Hint Resolve minus_plus_simpl_l_reverse: arith v62.
(** * Relation with plus *)
-Lemma plus_minus : forall n m p, n = m + p -> p = n - m.
+Lemma plus_minus n m p : n = m + p -> p = n - m.
Proof.
- intros n m p; pattern m, n; apply nat_double_ind; simpl;
- intros.
- replace (n0 - 0) with n0; auto with arith.
- absurd (0 = S (n0 + p)); auto with arith.
- auto with arith.
+ symmetry. now apply Nat.add_sub_eq_l.
Qed.
-Hint Immediate plus_minus: arith v62.
-Lemma minus_plus : forall n m, n + m - n = m.
- symmetry ; auto with arith.
+Lemma minus_plus n m : n + m - n = m.
+Proof.
+ rewrite Nat.add_comm. apply Nat.add_sub.
Qed.
-Hint Resolve minus_plus: arith v62.
-Lemma le_plus_minus : forall n m, n <= m -> m = n + (m - n).
+Lemma le_plus_minus_r n m : n <= m -> n + (m - n) = m.
Proof.
- intros n m Le; pattern n, m; apply le_elim_rel; simpl;
- auto with arith.
+ rewrite Nat.add_comm. apply Nat.sub_add.
Qed.
-Hint Resolve le_plus_minus: arith v62.
-Lemma le_plus_minus_r : forall n m, n <= m -> n + (m - n) = m.
+Lemma le_plus_minus n m : n <= m -> m = n + (m - n).
Proof.
- symmetry ; auto with arith.
+ intros. symmetry. rewrite Nat.add_comm. now apply Nat.sub_add.
Qed.
-Hint Resolve le_plus_minus_r: arith v62.
(** * Relation with order *)
-Theorem minus_le_compat_r : forall n m p : nat, n <= m -> n - p <= m - p.
-Proof.
- intros n m p; generalize n m; clear n m; induction p as [|p HI].
- intros n m; rewrite <- (minus_n_O n); rewrite <- (minus_n_O m); trivial.
-
- intros n m Hnm; apply le_elim_rel with (n:=n) (m:=m); auto with arith.
- intros q r H _. simpl. auto using HI.
-Qed.
-
-Theorem minus_le_compat_l : forall n m p : nat, n <= m -> p - m <= p - n.
-Proof.
- intros n m p; generalize n m; clear n m; induction p as [|p HI].
- trivial.
+Notation minus_le_compat_r :=
+ Nat.sub_le_mono_r (compat "8.4"). (* n <= m -> n - p <= m - p. *)
- intros n m Hnm; apply le_elim_rel with (n:=n) (m:=m); trivial.
- intros q; destruct q; auto with arith.
- simpl.
- apply le_trans with (m := p - 0); [apply HI | rewrite <- minus_n_O];
- auto with arith.
+Notation minus_le_compat_l :=
+ Nat.sub_le_mono_l (compat "8.4"). (* n <= m -> p - m <= p - n. *)
- intros q r Hqr _. simpl. auto using HI.
-Qed.
+Notation le_minus := Nat.le_sub_l (compat "8.4"). (* n - m <= n *)
+Notation lt_minus := Nat.sub_lt (compat "8.4"). (* m <= n -> 0 < m -> n-m < n *)
-Corollary le_minus : forall n m, n - m <= n.
+Lemma lt_O_minus_lt n m : 0 < n - m -> m < n.
Proof.
- intros n m; rewrite minus_n_O; auto using minus_le_compat_l with arith.
+ apply Nat.lt_add_lt_sub_r.
Qed.
-Lemma lt_minus : forall n m, m <= n -> 0 < m -> n - m < n.
+Theorem not_le_minus_0 n m : ~ m <= n -> n - m = 0.
Proof.
- intros n m Le; pattern m, n; apply le_elim_rel; simpl;
- auto using le_minus with arith.
- intros; absurd (0 < 0); auto with arith.
+ intros. now apply Nat.sub_0_le, Nat.lt_le_incl, Nat.lt_nge.
Qed.
-Hint Resolve lt_minus: arith v62.
-Lemma lt_O_minus_lt : forall n m, 0 < n - m -> m < n.
-Proof.
- intros n m; pattern n, m; apply nat_double_ind; simpl;
- auto with arith.
- intros; absurd (0 < 0); trivial with arith.
-Qed.
-Hint Immediate lt_O_minus_lt: arith v62.
+(** * Hints *)
-Theorem not_le_minus_0 : forall n m, ~ m <= n -> n - m = 0.
-Proof.
- intros y x; pattern y, x; apply nat_double_ind;
- [ simpl; trivial with arith
- | intros n H; absurd (0 <= S n); [ assumption | apply le_O_n ]
- | simpl; intros n m H1 H2; apply H1; unfold not; intros H3;
- apply H2; apply le_n_S; assumption ].
-Qed.
+Hint Resolve minus_n_O: arith v62.
+Hint Resolve minus_Sn_m: arith v62.
+Hint Resolve minus_diag_reverse: arith v62.
+Hint Resolve minus_plus_simpl_l_reverse: arith v62.
+Hint Immediate plus_minus: arith v62.
+Hint Resolve minus_plus: arith v62.
+Hint Resolve le_plus_minus: arith v62.
+Hint Resolve le_plus_minus_r: arith v62.
+Hint Resolve lt_minus: arith v62.
+Hint Immediate lt_O_minus_lt: arith v62.
diff --git a/theories/Arith/Mult.v b/theories/Arith/Mult.v
index 588afde3..2d82920b 100644
--- a/theories/Arith/Mult.v
+++ b/theories/Arith/Mult.v
@@ -1,220 +1,144 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
(************************************************************************)
-Require Export Plus.
-Require Export Minus.
-Require Export Lt.
-Require Export Le.
+(** * Properties of multiplication.
-Local Open Scope nat_scope.
+ This file is mostly OBSOLETE now, see module [PeanoNat.Nat] instead.
+
+ [Nat.mul] is defined in [Init/Nat.v].
+*)
-Implicit Types m n p : nat.
+Require Import PeanoNat.
+(** For Compatibility: *)
+Require Export Plus Minus Le Lt.
-(** Theorems about multiplication in [nat]. [mult] is defined in module [Init/Peano.v]. *)
+Local Open Scope nat_scope.
(** * [nat] is a semi-ring *)
(** ** Zero property *)
-Lemma mult_0_r : forall n, n * 0 = 0.
-Proof.
- intro; symmetry ; apply mult_n_O.
-Qed.
-
-Lemma mult_0_l : forall n, 0 * n = 0.
-Proof.
- reflexivity.
-Qed.
+Notation mult_0_l := Nat.mul_0_l (compat "8.4"). (* 0 * n = 0 *)
+Notation mult_0_r := Nat.mul_0_r (compat "8.4"). (* n * 0 = 0 *)
(** ** 1 is neutral *)
-Lemma mult_1_l : forall n, 1 * n = n.
-Proof.
- simpl; auto with arith.
-Qed.
-Hint Resolve mult_1_l: arith v62.
+Notation mult_1_l := Nat.mul_1_l (compat "8.4"). (* 1 * n = n *)
+Notation mult_1_r := Nat.mul_1_r (compat "8.4"). (* n * 1 = n *)
-Lemma mult_1_r : forall n, n * 1 = n.
-Proof.
- induction n; [ trivial |
- simpl; rewrite IHn; reflexivity].
-Qed.
-Hint Resolve mult_1_r: arith v62.
+Hint Resolve mult_1_l mult_1_r: arith v62.
(** ** Commutativity *)
-Lemma mult_comm : forall n m, n * m = m * n.
-Proof.
-intros; induction n; simpl; auto with arith.
-rewrite <- mult_n_Sm.
-rewrite IHn; apply plus_comm.
-Qed.
+Notation mult_comm := Nat.mul_comm (compat "8.4"). (* n * m = m * n *)
+
Hint Resolve mult_comm: arith v62.
(** ** Distributivity *)
-Lemma mult_plus_distr_r : forall n m p, (n + m) * p = n * p + m * p.
-Proof.
- intros; induction n; simpl; auto with arith.
- rewrite <- plus_assoc, IHn; auto with arith.
-Qed.
-Hint Resolve mult_plus_distr_r: arith v62.
+Notation mult_plus_distr_r :=
+ Nat.mul_add_distr_r (compat "8.4"). (* (n+m)*p = n*p + m*p *)
-Lemma mult_plus_distr_l : forall n m p, n * (m + p) = n * m + n * p.
-Proof.
- induction n. trivial.
- intros. simpl. rewrite IHn. symmetry. apply plus_permute_2_in_4.
-Qed.
+Notation mult_plus_distr_l :=
+ Nat.mul_add_distr_l (compat "8.4"). (* n*(m+p) = n*m + n*p *)
-Lemma mult_minus_distr_r : forall n m p, (n - m) * p = n * p - m * p.
-Proof.
- intros; induction n, m using nat_double_ind; simpl; auto with arith.
- rewrite <- minus_plus_simpl_l_reverse; auto with arith.
-Qed.
-Hint Resolve mult_minus_distr_r: arith v62.
+Notation mult_minus_distr_r :=
+ Nat.mul_sub_distr_r (compat "8.4"). (* (n-m)*p = n*p - m*p *)
-Lemma mult_minus_distr_l : forall n m p, n * (m - p) = n * m - n * p.
-Proof.
- intros n m p.
- rewrite mult_comm, mult_minus_distr_r, (mult_comm m n), (mult_comm p n); reflexivity.
-Qed.
+Notation mult_minus_distr_l :=
+ Nat.mul_sub_distr_l (compat "8.4"). (* n*(m-p) = n*m - n*p *)
+
+Hint Resolve mult_plus_distr_r: arith v62.
+Hint Resolve mult_minus_distr_r: arith v62.
Hint Resolve mult_minus_distr_l: arith v62.
(** ** Associativity *)
-Lemma mult_assoc_reverse : forall n m p, n * m * p = n * (m * p).
-Proof.
- intros; induction n; simpl; auto with arith.
- rewrite mult_plus_distr_r.
- induction IHn; auto with arith.
-Qed.
-Hint Resolve mult_assoc_reverse: arith v62.
+Notation mult_assoc := Nat.mul_assoc (compat "8.4"). (* n*(m*p)=n*m*p *)
-Lemma mult_assoc : forall n m p, n * (m * p) = n * m * p.
+Lemma mult_assoc_reverse n m p : n * m * p = n * (m * p).
Proof.
- auto with arith.
+ symmetry. apply Nat.mul_assoc.
Qed.
+
+Hint Resolve mult_assoc_reverse: arith v62.
Hint Resolve mult_assoc: arith v62.
(** ** Inversion lemmas *)
-Lemma mult_is_O : forall n m, n * m = 0 -> n = 0 \/ m = 0.
+Lemma mult_is_O n m : n * m = 0 -> n = 0 \/ m = 0.
Proof.
- destruct n as [| n]; simpl; intros m H.
- left; trivial.
- right; apply plus_is_O in H; destruct H; trivial.
+ apply Nat.eq_mul_0.
Qed.
-Lemma mult_is_one : forall n m, n * m = 1 -> n = 1 /\ m = 1.
+Lemma mult_is_one n m : n * m = 1 -> n = 1 /\ m = 1.
Proof.
- destruct n as [|n]; simpl; intros m H.
- edestruct O_S; eauto.
- destruct plus_is_one with (1:=H) as [[-> Hnm] | [-> Hnm]].
- simpl in H; rewrite mult_0_r in H; elim (O_S _ H).
- rewrite mult_1_r in Hnm; auto.
+ apply Nat.eq_mul_1.
Qed.
(** ** Multiplication and successor *)
-Lemma mult_succ_l : forall n m:nat, S n * m = n * m + m.
-Proof.
- intros; simpl. rewrite plus_comm. reflexivity.
-Qed.
-
-Lemma mult_succ_r : forall n m:nat, n * S m = n * m + n.
-Proof.
- induction n as [| p H]; intro m; simpl.
- reflexivity.
- rewrite H, <- plus_n_Sm; apply f_equal; rewrite plus_assoc; reflexivity.
-Qed.
+Notation mult_succ_l := Nat.mul_succ_l (compat "8.4"). (* S n * m = n * m + m *)
+Notation mult_succ_r := Nat.mul_succ_r (compat "8.4"). (* n * S m = n * m + n *)
(** * Compatibility with orders *)
-Lemma mult_O_le : forall n m, m = 0 \/ n <= m * n.
+Lemma mult_O_le n m : m = 0 \/ n <= m * n.
Proof.
- induction m; simpl; auto with arith.
+ destruct m; [left|right]; simpl; trivial using Nat.le_add_r.
Qed.
Hint Resolve mult_O_le: arith v62.
-Lemma mult_le_compat_l : forall n m p, n <= m -> p * n <= p * m.
+Lemma mult_le_compat_l n m p : n <= m -> p * n <= p * m.
Proof.
- induction p as [| p IHp]; intros; simpl.
- apply le_n.
- auto using plus_le_compat.
+ apply Nat.mul_le_mono_nonneg_l, Nat.le_0_l. (* TODO : get rid of 0<=n hyp *)
Qed.
Hint Resolve mult_le_compat_l: arith.
-
-Lemma mult_le_compat_r : forall n m p, n <= m -> n * p <= m * p.
+Lemma mult_le_compat_r n m p : n <= m -> n * p <= m * p.
Proof.
- intros m n p H; rewrite mult_comm, (mult_comm n); auto with arith.
+ apply Nat.mul_le_mono_nonneg_r, Nat.le_0_l.
Qed.
-Lemma mult_le_compat :
- forall n m p (q:nat), n <= m -> p <= q -> n * p <= m * q.
+Lemma mult_le_compat n m p q : n <= m -> p <= q -> n * p <= m * q.
Proof.
- intros m n p q Hmn Hpq; induction Hmn.
- induction Hpq.
- (* m*p<=m*p *)
- apply le_n.
- (* m*p<=m*m0 -> m*p<=m*(S m0) *)
- rewrite <- mult_n_Sm; apply le_trans with (m * m0).
- assumption.
- apply le_plus_l.
- (* m*p<=m0*q -> m*p<=(S m0)*q *)
- simpl; apply le_trans with (m0 * q).
- assumption.
- apply le_plus_r.
+ intros. apply Nat.mul_le_mono_nonneg; trivial; apply Nat.le_0_l.
Qed.
-Lemma mult_S_lt_compat_l : forall n m p, m < p -> S n * m < S n * p.
+Lemma mult_S_lt_compat_l n m p : m < p -> S n * m < S n * p.
Proof.
- induction n; intros; simpl in *.
- rewrite <- 2 plus_n_O; assumption.
- auto using plus_lt_compat.
+ apply Nat.mul_lt_mono_pos_l, Nat.lt_0_succ.
Qed.
Hint Resolve mult_S_lt_compat_l: arith.
-Lemma mult_lt_compat_l : forall n m p, n < m -> 0 < p -> p * n < p * m.
+Lemma mult_lt_compat_l n m p : n < m -> 0 < p -> p * n < p * m.
Proof.
- intros m n p H Hp. destruct p. elim (lt_irrefl _ Hp).
- now apply mult_S_lt_compat_l.
+ intros. now apply Nat.mul_lt_mono_pos_l.
Qed.
-Lemma mult_lt_compat_r : forall n m p, n < m -> 0 < p -> n * p < m * p.
+Lemma mult_lt_compat_r n m p : n < m -> 0 < p -> n * p < m * p.
Proof.
- intros m n p H Hp. destruct p. elim (lt_irrefl _ Hp).
- rewrite (mult_comm m), (mult_comm n). now apply mult_S_lt_compat_l.
+ intros. now apply Nat.mul_lt_mono_pos_r.
Qed.
-Lemma mult_S_le_reg_l : forall n m p, S n * m <= S n * p -> m <= p.
+Lemma mult_S_le_reg_l n m p : S n * m <= S n * p -> m <= p.
Proof.
- intros m n p H; destruct (le_or_lt n p). trivial.
- assert (H1:S m * n < S m * n).
- apply le_lt_trans with (m := S m * p). assumption.
- apply mult_S_lt_compat_l. assumption.
- elim (lt_irrefl _ H1).
+ apply Nat.mul_le_mono_pos_l, Nat.lt_0_succ.
Qed.
(** * n|->2*n and n|->2n+1 have disjoint image *)
-Theorem odd_even_lem : forall p q, 2 * p + 1 <> 2 * q.
+Theorem odd_even_lem p q : 2 * p + 1 <> 2 * q.
Proof.
- induction p; destruct q.
- discriminate.
- simpl; rewrite plus_comm. discriminate.
- discriminate.
- intro H0; destruct (IHp q).
- replace (2 * q) with (2 * S q - 2).
- rewrite <- H0; simpl.
- repeat rewrite (fun x y => plus_comm x (S y)); simpl; auto.
- simpl; rewrite (fun y => plus_comm q (S y)); destruct q; simpl; auto.
+ intro. apply (Nat.Even_Odd_False (2*q)).
+ - now exists q.
+ - now exists p.
Qed.
@@ -232,10 +156,9 @@ Fixpoint mult_acc (s:nat) m n : nat :=
Lemma mult_acc_aux : forall n m p, m + n * p = mult_acc m p n.
Proof.
- induction n as [| p IHp]; simpl; auto.
- intros s m; rewrite <- plus_tail_plus; rewrite <- IHp.
- rewrite <- plus_assoc_reverse; apply f_equal2; auto.
- rewrite plus_comm; auto.
+ induction n as [| n IHn]; simpl; auto.
+ intros. rewrite Nat.add_assoc, IHn. f_equal.
+ rewrite Nat.add_comm. apply plus_tail_plus.
Qed.
Definition tail_mult n m := mult_acc 0 m n.
diff --git a/theories/Arith/PeanoNat.v b/theories/Arith/PeanoNat.v
new file mode 100644
index 00000000..799031a2
--- /dev/null
+++ b/theories/Arith/PeanoNat.v
@@ -0,0 +1,755 @@
+(************************************************************************)
+(* v * The Coq Proof Assistant / The Coq Development Team *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* \VV/ **************************************************************)
+(* // * This file is distributed under the terms of the *)
+(* * GNU Lesser General Public License Version 2.1 *)
+(************************************************************************)
+(* Evgeny Makarov, INRIA, 2007 *)
+(************************************************************************)
+
+Require Import NAxioms NProperties OrdersFacts.
+
+(** Implementation of [NAxiomsSig] by [nat] *)
+
+Module Nat
+ <: NAxiomsSig
+ <: UsualDecidableTypeFull
+ <: OrderedTypeFull
+ <: TotalOrder.
+
+(** Operations over [nat] are defined in a separate module *)
+
+Include Coq.Init.Nat.
+
+(** When including property functors, inline t eq zero one two lt le succ *)
+
+Set Inline Level 50.
+
+(** All operations are well-defined (trivial here since eq is Leibniz) *)
+
+Definition eq_equiv : Equivalence (@eq nat) := eq_equivalence.
+Local Obligation Tactic := simpl_relation.
+Program Instance succ_wd : Proper (eq==>eq) S.
+Program Instance pred_wd : Proper (eq==>eq) pred.
+Program Instance add_wd : Proper (eq==>eq==>eq) plus.
+Program Instance sub_wd : Proper (eq==>eq==>eq) minus.
+Program Instance mul_wd : Proper (eq==>eq==>eq) mult.
+Program Instance pow_wd : Proper (eq==>eq==>eq) pow.
+Program Instance div_wd : Proper (eq==>eq==>eq) div.
+Program Instance mod_wd : Proper (eq==>eq==>eq) modulo.
+Program Instance lt_wd : Proper (eq==>eq==>iff) lt.
+Program Instance testbit_wd : Proper (eq==>eq==>eq) testbit.
+
+(** Bi-directional induction. *)
+
+Theorem bi_induction :
+ forall A : nat -> Prop, Proper (eq==>iff) A ->
+ A 0 -> (forall n : nat, A n <-> A (S n)) -> forall n : nat, A n.
+Proof.
+intros A A_wd A0 AS. apply nat_ind. assumption. intros; now apply -> AS.
+Qed.
+
+(** Recursion fonction *)
+
+Definition recursion {A} : A -> (nat -> A -> A) -> nat -> A :=
+ nat_rect (fun _ => A).
+
+Instance recursion_wd {A} (Aeq : relation A) :
+ Proper (Aeq ==> (eq==>Aeq==>Aeq) ==> eq ==> Aeq) recursion.
+Proof.
+intros a a' Ha f f' Hf n n' Hn. subst n'.
+induction n; simpl; auto. apply Hf; auto.
+Qed.
+
+Theorem recursion_0 :
+ forall {A} (a : A) (f : nat -> A -> A), recursion a f 0 = a.
+Proof.
+reflexivity.
+Qed.
+
+Theorem recursion_succ :
+ forall {A} (Aeq : relation A) (a : A) (f : nat -> A -> A),
+ Aeq a a -> Proper (eq==>Aeq==>Aeq) f ->
+ forall n : nat, Aeq (recursion a f (S n)) (f n (recursion a f n)).
+Proof.
+unfold Proper, respectful in *; induction n; simpl; auto.
+Qed.
+
+(** ** Remaining constants not defined in Coq.Init.Nat *)
+
+(** NB: Aliasing [le] is mandatory, since only a Definition can implement
+ an interface Parameter... *)
+
+Definition eq := @Logic.eq nat.
+Definition le := Peano.le.
+Definition lt := Peano.lt.
+
+(** ** Basic specifications : pred add sub mul *)
+
+Lemma pred_succ n : pred (S n) = n.
+Proof.
+reflexivity.
+Qed.
+
+Lemma pred_0 : pred 0 = 0.
+Proof.
+reflexivity.
+Qed.
+
+Lemma one_succ : 1 = S 0.
+Proof.
+reflexivity.
+Qed.
+
+Lemma two_succ : 2 = S 1.
+Proof.
+reflexivity.
+Qed.
+
+Lemma add_0_l n : 0 + n = n.
+Proof.
+reflexivity.
+Qed.
+
+Lemma add_succ_l n m : (S n) + m = S (n + m).
+Proof.
+reflexivity.
+Qed.
+
+Lemma sub_0_r n : n - 0 = n.
+Proof.
+now destruct n.
+Qed.
+
+Lemma sub_succ_r n m : n - (S m) = pred (n - m).
+Proof.
+revert m. induction n; destruct m; simpl; auto. apply sub_0_r.
+Qed.
+
+Lemma mul_0_l n : 0 * n = 0.
+Proof.
+reflexivity.
+Qed.
+
+Lemma mul_succ_l n m : S n * m = n * m + m.
+Proof.
+assert (succ_r : forall x y, x+S y = S(x+y)) by now induction x.
+assert (comm : forall x y, x+y = y+x).
+{ induction x; simpl; auto. intros; rewrite succ_r; now f_equal. }
+now rewrite comm.
+Qed.
+
+Lemma lt_succ_r n m : n < S m <-> n <= m.
+Proof.
+split. apply Peano.le_S_n. induction 1; auto.
+Qed.
+
+(** ** Boolean comparisons *)
+
+Lemma eqb_eq n m : eqb n m = true <-> n = m.
+Proof.
+ revert m.
+ induction n; destruct m; simpl; rewrite ?IHn; split; try easy.
+ - now intros ->.
+ - now injection 1.
+Qed.
+
+Lemma leb_le n m : (n <=? m) = true <-> n <= m.
+Proof.
+ revert m.
+ induction n; destruct m; simpl.
+ - now split.
+ - split; trivial. intros; apply Peano.le_0_n.
+ - now split.
+ - rewrite IHn; split.
+ + apply Peano.le_n_S.
+ + apply Peano.le_S_n.
+Qed.
+
+Lemma ltb_lt n m : (n <? m) = true <-> n < m.
+Proof.
+ apply leb_le.
+Qed.
+
+(** ** Decidability of equality over [nat]. *)
+
+Lemma eq_dec : forall n m : nat, {n = m} + {n <> m}.
+Proof.
+ induction n; destruct m.
+ - now left.
+ - now right.
+ - now right.
+ - destruct (IHn m); [left|right]; auto.
+Defined.
+
+(** ** Ternary comparison *)
+
+(** With [nat], it would be easier to prove first [compare_spec],
+ then the properties below. But then we wouldn't be able to
+ benefit from functor [BoolOrderFacts] *)
+
+Lemma compare_eq_iff n m : (n ?= m) = Eq <-> n = m.
+Proof.
+ revert m; induction n; destruct m; simpl; rewrite ?IHn; split; auto; easy.
+Qed.
+
+Lemma compare_lt_iff n m : (n ?= m) = Lt <-> n < m.
+Proof.
+ revert m; induction n; destruct m; simpl; rewrite ?IHn; split; try easy.
+ - intros _. apply Peano.le_n_S, Peano.le_0_n.
+ - apply Peano.le_n_S.
+ - apply Peano.le_S_n.
+Qed.
+
+Lemma compare_le_iff n m : (n ?= m) <> Gt <-> n <= m.
+Proof.
+ revert m; induction n; destruct m; simpl; rewrite ?IHn.
+ - now split.
+ - split; intros. apply Peano.le_0_n. easy.
+ - split. now destruct 1. inversion 1.
+ - split; intros. now apply Peano.le_n_S. now apply Peano.le_S_n.
+Qed.
+
+Lemma compare_antisym n m : (m ?= n) = CompOpp (n ?= m).
+Proof.
+ revert m; induction n; destruct m; simpl; trivial.
+Qed.
+
+Lemma compare_succ n m : (S n ?= S m) = (n ?= m).
+Proof.
+ reflexivity.
+Qed.
+
+
+(* BUG: Ajout d'un cas * après preuve finie (deuxième niveau +++*** ) :
+ * ---> Anomaly: Uncaught exception Proofview.IndexOutOfRange(_). Please report. *)
+
+(** ** Minimum, maximum *)
+
+Lemma max_l : forall n m, m <= n -> max n m = n.
+Proof.
+ exact Peano.max_l.
+Qed.
+
+Lemma max_r : forall n m, n <= m -> max n m = m.
+Proof.
+ exact Peano.max_r.
+Qed.
+
+Lemma min_l : forall n m, n <= m -> min n m = n.
+Proof.
+ exact Peano.min_l.
+Qed.
+
+Lemma min_r : forall n m, m <= n -> min n m = m.
+Proof.
+ exact Peano.min_r.
+Qed.
+
+(** Some more advanced properties of comparison and orders,
+ including [compare_spec] and [lt_irrefl] and [lt_eq_cases]. *)
+
+Include BoolOrderFacts.
+
+(** We can now derive all properties of basic functions and orders,
+ and use these properties for proving the specs of more advanced
+ functions. *)
+
+Include NBasicProp <+ UsualMinMaxLogicalProperties <+ UsualMinMaxDecProperties.
+
+(** ** Power *)
+
+Lemma pow_neg_r a b : b<0 -> a^b = 0. inversion 1. Qed.
+
+Lemma pow_0_r a : a^0 = 1.
+Proof. reflexivity. Qed.
+
+Lemma pow_succ_r a b : 0<=b -> a^(S b) = a * a^b.
+Proof. reflexivity. Qed.
+
+(** ** Square *)
+
+Lemma square_spec n : square n = n * n.
+Proof. reflexivity. Qed.
+
+(** ** Parity *)
+
+Definition Even n := exists m, n = 2*m.
+Definition Odd n := exists m, n = 2*m+1.
+
+Module Private_Parity.
+
+Lemma Even_1 : ~ Even 1.
+Proof.
+ intros ([|], H); try discriminate.
+ simpl in H. now rewrite <- plus_n_Sm in H.
+Qed.
+
+Lemma Even_2 n : Even n <-> Even (S (S n)).
+Proof.
+ split; intros (m,H).
+ - exists (S m). rewrite H. simpl. now rewrite plus_n_Sm.
+ - destruct m; try discriminate.
+ exists m. simpl in H. rewrite <- plus_n_Sm in H. now inversion H.
+Qed.
+
+Lemma Odd_0 : ~ Odd 0.
+Proof.
+ now intros ([|], H).
+Qed.
+
+Lemma Odd_2 n : Odd n <-> Odd (S (S n)).
+Proof.
+ split; intros (m,H).
+ - exists (S m). rewrite H. simpl. now rewrite <- (plus_n_Sm m).
+ - destruct m; try discriminate.
+ exists m. simpl in H. rewrite <- plus_n_Sm in H. inversion H.
+ simpl. now rewrite <- !plus_n_Sm, <- !plus_n_O.
+Qed.
+
+End Private_Parity.
+Import Private_Parity.
+
+Lemma even_spec : forall n, even n = true <-> Even n.
+Proof.
+ fix 1.
+ destruct n as [|[|n]]; simpl.
+ - split; [ now exists 0 | trivial ].
+ - split; [ discriminate | intro H; elim (Even_1 H) ].
+ - rewrite even_spec. apply Even_2.
+Qed.
+
+Lemma odd_spec : forall n, odd n = true <-> Odd n.
+Proof.
+ unfold odd.
+ fix 1.
+ destruct n as [|[|n]]; simpl.
+ - split; [ discriminate | intro H; elim (Odd_0 H) ].
+ - split; [ now exists 0 | trivial ].
+ - rewrite odd_spec. apply Odd_2.
+Qed.
+
+(** ** Division *)
+
+Lemma divmod_spec : forall x y q u, u <= y ->
+ let (q',u') := divmod x y q u in
+ x + (S y)*q + (y-u) = (S y)*q' + (y-u') /\ u' <= y.
+Proof.
+ induction x.
+ - simpl; intuition.
+ - intros y q u H. destruct u; simpl divmod.
+ + generalize (IHx y (S q) y (le_n y)). destruct divmod as (q',u').
+ intros (EQ,LE); split; trivial.
+ rewrite <- EQ, sub_0_r, sub_diag, add_0_r.
+ now rewrite !add_succ_l, <- add_succ_r, <- add_assoc, mul_succ_r.
+ + assert (H' : u <= y).
+ { apply le_trans with (S u); trivial. do 2 constructor. }
+ generalize (IHx y q u H'). destruct divmod as (q',u').
+ intros (EQ,LE); split; trivial.
+ rewrite <- EQ.
+ rewrite !add_succ_l, <- add_succ_r. f_equal. now rewrite <- sub_succ_l.
+Qed.
+
+Lemma div_mod x y : y<>0 -> x = y*(x/y) + x mod y.
+Proof.
+ intros Hy.
+ destruct y; [ now elim Hy | clear Hy ].
+ unfold div, modulo.
+ generalize (divmod_spec x y 0 y (le_n y)).
+ destruct divmod as (q,u).
+ intros (U,V).
+ simpl in *.
+ now rewrite mul_0_r, sub_diag, !add_0_r in U.
+Qed.
+
+Lemma mod_bound_pos x y : 0<=x -> 0<y -> 0 <= x mod y < y.
+Proof.
+ intros Hx Hy. split. apply le_0_l.
+ destruct y; [ now elim Hy | clear Hy ].
+ unfold modulo.
+ apply lt_succ_r, le_sub_l.
+Qed.
+
+(** ** Square root *)
+
+Lemma sqrt_iter_spec : forall k p q r,
+ q = p+p -> r<=q ->
+ let s := sqrt_iter k p q r in
+ s*s <= k + p*p + (q - r) < (S s)*(S s).
+Proof.
+ induction k.
+ - (* k = 0 *)
+ simpl; intros p q r Hq Hr.
+ split.
+ + apply le_add_r.
+ + apply lt_succ_r.
+ rewrite mul_succ_r.
+ rewrite add_assoc, (add_comm p), <- add_assoc.
+ apply add_le_mono_l.
+ rewrite <- Hq. apply le_sub_l.
+ - (* k = S k' *)
+ destruct r.
+ + (* r = 0 *)
+ intros Hq _.
+ replace (S k + p*p + (q-0)) with (k + (S p)*(S p) + (S (S q) - S (S q))).
+ * apply IHk.
+ simpl. now rewrite add_succ_r, Hq. apply le_n.
+ * rewrite sub_diag, sub_0_r, add_0_r. simpl.
+ rewrite add_succ_r; f_equal. rewrite <- add_assoc; f_equal.
+ rewrite mul_succ_r, (add_comm p), <- add_assoc. now f_equal.
+ + (* r = S r' *)
+ intros Hq Hr.
+ replace (S k + p*p + (q-S r)) with (k + p*p + (q - r)).
+ * apply IHk; trivial. apply le_trans with (S r); trivial. do 2 constructor.
+ * simpl. rewrite <- add_succ_r. f_equal. rewrite <- sub_succ_l; trivial.
+Qed.
+
+Lemma sqrt_specif n : (sqrt n)*(sqrt n) <= n < S (sqrt n) * S (sqrt n).
+Proof.
+ set (s:=sqrt n).
+ replace n with (n + 0*0 + (0-0)).
+ apply sqrt_iter_spec; auto.
+ simpl. now rewrite !add_0_r.
+Qed.
+
+Definition sqrt_spec a (Ha:0<=a) := sqrt_specif a.
+
+Lemma sqrt_neg a : a<0 -> sqrt a = 0.
+Proof. inversion 1. Qed.
+
+(** ** Logarithm *)
+
+Lemma log2_iter_spec : forall k p q r,
+ 2^(S p) = q + S r -> r < 2^p ->
+ let s := log2_iter k p q r in
+ 2^s <= k + q < 2^(S s).
+Proof.
+ induction k.
+ - (* k = 0 *)
+ intros p q r EQ LT. simpl log2_iter. cbv zeta.
+ split.
+ + rewrite add_0_l.
+ rewrite (add_le_mono_l _ _ (2^p)).
+ simpl pow in EQ. rewrite add_0_r in EQ. rewrite EQ.
+ rewrite add_comm. apply add_le_mono_r. apply LT.
+ + rewrite EQ, add_comm. apply add_lt_mono_l.
+ apply lt_succ_r, le_0_l.
+ - (* k = S k' *)
+ intros p q r EQ LT. destruct r.
+ + (* r = 0 *)
+ rewrite add_succ_r, add_0_r in EQ.
+ rewrite add_succ_l, <- add_succ_r. apply IHk.
+ * rewrite <- EQ. remember (S p) as p'; simpl. now rewrite add_0_r.
+ * rewrite EQ. constructor.
+ + (* r = S r' *)
+ rewrite add_succ_l, <- add_succ_r. apply IHk.
+ * now rewrite add_succ_l, <- add_succ_r.
+ * apply le_lt_trans with (S r); trivial. do 2 constructor.
+Qed.
+
+Lemma log2_spec n : 0<n ->
+ 2^(log2 n) <= n < 2^(S (log2 n)).
+Proof.
+ intros.
+ set (s:=log2 n).
+ replace n with (pred n + 1).
+ apply log2_iter_spec; auto.
+ rewrite add_1_r.
+ apply succ_pred. now apply neq_sym, lt_neq.
+Qed.
+
+Lemma log2_nonpos n : n<=0 -> log2 n = 0.
+Proof.
+ inversion 1; now subst.
+Qed.
+
+(** ** Gcd *)
+
+Definition divide x y := exists z, y=z*x.
+Notation "( x | y )" := (divide x y) (at level 0) : nat_scope.
+
+Lemma gcd_divide : forall a b, (gcd a b | a) /\ (gcd a b | b).
+Proof.
+ fix 1.
+ intros [|a] b; simpl.
+ split.
+ now exists 0.
+ exists 1. simpl. now rewrite <- plus_n_O.
+ fold (b mod (S a)).
+ destruct (gcd_divide (b mod (S a)) (S a)) as (H,H').
+ set (a':=S a) in *.
+ split; auto.
+ rewrite (div_mod b a') at 2 by discriminate.
+ destruct H as (u,Hu), H' as (v,Hv).
+ rewrite mul_comm.
+ exists ((b/a')*v + u).
+ rewrite mul_add_distr_r.
+ now rewrite <- mul_assoc, <- Hv, <- Hu.
+Qed.
+
+Lemma gcd_divide_l : forall a b, (gcd a b | a).
+Proof.
+ intros. apply gcd_divide.
+Qed.
+
+Lemma gcd_divide_r : forall a b, (gcd a b | b).
+Proof.
+ intros. apply gcd_divide.
+Qed.
+
+Lemma gcd_greatest : forall a b c, (c|a) -> (c|b) -> (c|gcd a b).
+Proof.
+ fix 1.
+ intros [|a] b; simpl; auto.
+ fold (b mod (S a)).
+ intros c H H'. apply gcd_greatest; auto.
+ set (a':=S a) in *.
+ rewrite (div_mod b a') in H' by discriminate.
+ destruct H as (u,Hu), H' as (v,Hv).
+ exists (v - (b/a')*u).
+ rewrite mul_comm in Hv.
+ rewrite mul_sub_distr_r, <- Hv, <- mul_assoc, <-Hu.
+ now rewrite add_comm, add_sub.
+Qed.
+
+Lemma gcd_nonneg a b : 0<=gcd a b.
+Proof. apply le_0_l. Qed.
+
+
+(** ** Bitwise operations *)
+
+Lemma div2_double n : div2 (2*n) = n.
+Proof.
+ induction n; trivial.
+ simpl mul. rewrite add_succ_r. simpl. now f_equal.
+Qed.
+
+Lemma div2_succ_double n : div2 (S (2*n)) = n.
+Proof.
+ induction n; trivial.
+ simpl. f_equal. now rewrite add_succ_r.
+Qed.
+
+Lemma le_div2 n : div2 (S n) <= n.
+Proof.
+ revert n.
+ fix 1.
+ destruct n; simpl; trivial. apply lt_succ_r.
+ destruct n; [simpl|]; trivial. now constructor.
+Qed.
+
+Lemma lt_div2 n : 0 < n -> div2 n < n.
+Proof.
+ destruct n.
+ - inversion 1.
+ - intros _. apply lt_succ_r, le_div2.
+Qed.
+
+Lemma div2_decr a n : a <= S n -> div2 a <= n.
+Proof.
+ destruct a; intros H.
+ - simpl. apply le_0_l.
+ - apply succ_le_mono in H.
+ apply le_trans with a; [ apply le_div2 | trivial ].
+Qed.
+
+Lemma double_twice : forall n, double n = 2*n.
+Proof.
+ simpl; intros. now rewrite add_0_r.
+Qed.
+
+Lemma testbit_0_l : forall n, testbit 0 n = false.
+Proof.
+ now induction n.
+Qed.
+
+Lemma testbit_odd_0 a : testbit (2*a+1) 0 = true.
+Proof.
+ unfold testbit. rewrite odd_spec. now exists a.
+Qed.
+
+Lemma testbit_even_0 a : testbit (2*a) 0 = false.
+Proof.
+ unfold testbit, odd. rewrite (proj2 (even_spec _)); trivial.
+ now exists a.
+Qed.
+
+Lemma testbit_odd_succ' a n : testbit (2*a+1) (S n) = testbit a n.
+Proof.
+ unfold testbit; fold testbit.
+ rewrite add_1_r. f_equal.
+ apply div2_succ_double.
+Qed.
+
+Lemma testbit_even_succ' a n : testbit (2*a) (S n) = testbit a n.
+Proof.
+ unfold testbit; fold testbit. f_equal. apply div2_double.
+Qed.
+
+Lemma shiftr_specif : forall a n m,
+ testbit (shiftr a n) m = testbit a (m+n).
+Proof.
+ induction n; intros m. trivial.
+ now rewrite add_0_r.
+ now rewrite add_succ_r, <- add_succ_l, <- IHn.
+Qed.
+
+Lemma shiftl_specif_high : forall a n m, n<=m ->
+ testbit (shiftl a n) m = testbit a (m-n).
+Proof.
+ induction n; intros m H. trivial.
+ now rewrite sub_0_r.
+ destruct m. inversion H.
+ simpl. apply succ_le_mono in H.
+ change (shiftl a (S n)) with (double (shiftl a n)).
+ rewrite double_twice, div2_double. now apply IHn.
+Qed.
+
+Lemma shiftl_spec_low : forall a n m, m<n ->
+ testbit (shiftl a n) m = false.
+Proof.
+ induction n; intros m H. inversion H.
+ change (shiftl a (S n)) with (double (shiftl a n)).
+ destruct m; simpl.
+ unfold odd. apply negb_false_iff.
+ apply even_spec. exists (shiftl a n). apply double_twice.
+ rewrite double_twice, div2_double. apply IHn.
+ now apply succ_le_mono.
+Qed.
+
+Lemma div2_bitwise : forall op n a b,
+ div2 (bitwise op (S n) a b) = bitwise op n (div2 a) (div2 b).
+Proof.
+ intros. unfold bitwise; fold bitwise.
+ destruct (op (odd a) (odd b)).
+ now rewrite div2_succ_double.
+ now rewrite add_0_l, div2_double.
+Qed.
+
+Lemma odd_bitwise : forall op n a b,
+ odd (bitwise op (S n) a b) = op (odd a) (odd b).
+Proof.
+ intros. unfold bitwise; fold bitwise.
+ destruct (op (odd a) (odd b)).
+ apply odd_spec. rewrite add_comm. eexists; eauto.
+ unfold odd. apply negb_false_iff. apply even_spec.
+ rewrite add_0_l; eexists; eauto.
+Qed.
+
+Lemma testbit_bitwise_1 : forall op, (forall b, op false b = false) ->
+ forall n m a b, a<=n ->
+ testbit (bitwise op n a b) m = op (testbit a m) (testbit b m).
+Proof.
+ intros op Hop.
+ induction n; intros m a b Ha.
+ simpl. inversion Ha; subst. now rewrite testbit_0_l.
+ destruct m.
+ apply odd_bitwise.
+ unfold testbit; fold testbit. rewrite div2_bitwise.
+ apply IHn. now apply div2_decr.
+Qed.
+
+Lemma testbit_bitwise_2 : forall op, op false false = false ->
+ forall n m a b, a<=n -> b<=n ->
+ testbit (bitwise op n a b) m = op (testbit a m) (testbit b m).
+Proof.
+ intros op Hop.
+ induction n; intros m a b Ha Hb.
+ simpl. inversion Ha; inversion Hb; subst. now rewrite testbit_0_l.
+ destruct m.
+ apply odd_bitwise.
+ unfold testbit; fold testbit. rewrite div2_bitwise.
+ apply IHn; now apply div2_decr.
+Qed.
+
+Lemma land_spec a b n :
+ testbit (land a b) n = testbit a n && testbit b n.
+Proof.
+ unfold land. apply testbit_bitwise_1; trivial.
+Qed.
+
+Lemma ldiff_spec a b n :
+ testbit (ldiff a b) n = testbit a n && negb (testbit b n).
+Proof.
+ unfold ldiff. apply testbit_bitwise_1; trivial.
+Qed.
+
+Lemma lor_spec a b n :
+ testbit (lor a b) n = testbit a n || testbit b n.
+Proof.
+ unfold lor. apply testbit_bitwise_2.
+ - trivial.
+ - destruct (compare_spec a b).
+ + rewrite max_l; subst; trivial.
+ + apply lt_le_incl in H. now rewrite max_r.
+ + apply lt_le_incl in H. now rewrite max_l.
+ - destruct (compare_spec a b).
+ + rewrite max_r; subst; trivial.
+ + apply lt_le_incl in H. now rewrite max_r.
+ + apply lt_le_incl in H. now rewrite max_l.
+Qed.
+
+Lemma lxor_spec a b n :
+ testbit (lxor a b) n = xorb (testbit a n) (testbit b n).
+Proof.
+ unfold lxor. apply testbit_bitwise_2.
+ - trivial.
+ - destruct (compare_spec a b).
+ + rewrite max_l; subst; trivial.
+ + apply lt_le_incl in H. now rewrite max_r.
+ + apply lt_le_incl in H. now rewrite max_l.
+ - destruct (compare_spec a b).
+ + rewrite max_r; subst; trivial.
+ + apply lt_le_incl in H. now rewrite max_r.
+ + apply lt_le_incl in H. now rewrite max_l.
+Qed.
+
+Lemma div2_spec a : div2 a = shiftr a 1.
+Proof.
+ reflexivity.
+Qed.
+
+(** Aliases with extra dummy hypothesis, to fulfil the interface *)
+
+Definition testbit_odd_succ a n (_:0<=n) := testbit_odd_succ' a n.
+Definition testbit_even_succ a n (_:0<=n) := testbit_even_succ' a n.
+Lemma testbit_neg_r a n (H:n<0) : testbit a n = false.
+Proof. inversion H. Qed.
+
+Definition shiftl_spec_high a n m (_:0<=m) := shiftl_specif_high a n m.
+Definition shiftr_spec a n m (_:0<=m) := shiftr_specif a n m.
+
+(** Properties of advanced functions (pow, sqrt, log2, ...) *)
+
+Include NExtraProp.
+
+End Nat.
+
+(** Re-export notations that should be available even when
+ the [Nat] module is not imported. *)
+
+Bind Scope nat_scope with Nat.t nat.
+
+Infix "^" := Nat.pow : nat_scope.
+Infix "=?" := Nat.eqb (at level 70) : nat_scope.
+Infix "<=?" := Nat.leb (at level 70) : nat_scope.
+Infix "<?" := Nat.ltb (at level 70) : nat_scope.
+Infix "?=" := Nat.compare (at level 70) : nat_scope.
+Infix "/" := Nat.div : nat_scope.
+Infix "mod" := Nat.modulo (at level 40, no associativity) : nat_scope.
+
+Hint Unfold Nat.le : core.
+Hint Unfold Nat.lt : core.
+
+(** [Nat] contains an [order] tactic for natural numbers *)
+
+(** Note that [Nat.order] is domain-agnostic: it will not prove
+ [1<=2] or [x<=x+x], but rather things like [x<=y -> y<=x -> x=y]. *)
+
+Section TestOrder.
+ Let test : forall x y, x<=y -> y<=x -> x=y.
+ Proof.
+ Nat.order.
+ Qed.
+End TestOrder.
diff --git a/theories/Arith/Peano_dec.v b/theories/Arith/Peano_dec.v
index e288a43f..a7ede3fc 100644
--- a/theories/Arith/Peano_dec.v
+++ b/theories/Arith/Peano_dec.v
@@ -1,52 +1,61 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
(************************************************************************)
-Require Import Decidable.
+Require Import Decidable PeanoNat.
Require Eqdep_dec.
-Require Import Le Lt.
Local Open Scope nat_scope.
Implicit Types m n x y : nat.
-Theorem O_or_S : forall n, {m : nat | S m = n} + {0 = n}.
+Theorem O_or_S n : {m : nat | S m = n} + {0 = n}.
Proof.
induction n.
- auto.
- left; exists n; auto.
+ - now right.
+ - left; exists n; auto.
Defined.
-Theorem eq_nat_dec : forall n m, {n = m} + {n <> m}.
-Proof.
- induction n; destruct m; auto.
- elim (IHn m); auto.
-Defined.
+Notation eq_nat_dec := Nat.eq_dec (compat "8.4").
Hint Resolve O_or_S eq_nat_dec: arith.
-Theorem dec_eq_nat : forall n m, decidable (n = m).
- intros x y; unfold decidable; elim (eq_nat_dec x y); auto with arith.
+Theorem dec_eq_nat n m : decidable (n = m).
+Proof.
+ elim (Nat.eq_dec n m); [left|right]; trivial.
Defined.
-Definition UIP_nat:= Eqdep_dec.UIP_dec eq_nat_dec.
+Definition UIP_nat:= Eqdep_dec.UIP_dec Nat.eq_dec.
-Lemma le_unique: forall m n (h1 h2: m <= n), h1 = h2.
+Import EqNotations.
+
+Lemma le_unique: forall m n (le_mn1 le_mn2 : m <= n), le_mn1 = le_mn2.
Proof.
-fix 3.
-refine (fun m _ h1 => match h1 as h' in _ <= k return forall hh: m <= k, h' = hh
- with le_n => _ |le_S i H => _ end).
-refine (fun hh => match hh as h' in _ <= k return forall eq: m = k,
- le_n m = match eq in _ = p return m <= p -> m <= m with |eq_refl => fun bli => bli end h' with
- |le_n => fun eq => _ |le_S j H' => fun eq => _ end eq_refl).
-rewrite (UIP_nat _ _ eq eq_refl). reflexivity.
-subst m. destruct (Lt.lt_irrefl j H').
-refine (fun hh => match hh as h' in _ <= k return match k as k' return m <= k' -> Prop
- with |0 => fun _ => True |S i' => fun h'' => forall H':m <= i', le_S m i' H' = h'' end h'
- with |le_n => _ |le_S j H2 => fun H' => _ end H).
-destruct m. exact I. intros; destruct (Lt.lt_irrefl m H').
-f_equal. apply le_unique.
+intros m n.
+generalize (eq_refl (S n)).
+generalize n at -1.
+induction (S n) as [|n0 IHn0]; try discriminate.
+clear n; intros n H; injection H; clear H; intro H.
+rewrite <- H; intros le_mn1 le_mn2; clear n H.
+pose (def_n2 := eq_refl n0); transitivity (eq_ind _ _ le_mn2 _ def_n2).
+ 2: reflexivity.
+generalize def_n2; revert le_mn1 le_mn2.
+generalize n0 at 1 4 5 7; intros n1 le_mn1.
+destruct le_mn1; intros le_mn2; destruct le_mn2.
++ now intros def_n0; rewrite (UIP_nat _ _ def_n0 eq_refl).
++ intros def_n0; generalize le_mn2; rewrite <-def_n0; intros le_mn0.
+ now destruct (Nat.nle_succ_diag_l _ le_mn0).
++ intros def_n0; generalize le_mn1; rewrite def_n0; intros le_mn0.
+ now destruct (Nat.nle_succ_diag_l _ le_mn0).
++ intros def_n0; injection def_n0; intros ->.
+ rewrite (UIP_nat _ _ def_n0 eq_refl); simpl.
+ assert (H : le_mn1 = le_mn2).
+ now apply IHn0.
+now rewrite H.
Qed.
+
+(** For compatibility *)
+Require Import Le Lt. \ No newline at end of file
diff --git a/theories/Arith/Plus.v b/theories/Arith/Plus.v
index 5428ada3..3b823da6 100644
--- a/theories/Arith/Plus.v
+++ b/theories/Arith/Plus.v
@@ -6,176 +6,139 @@
(* * GNU Lesser General Public License Version 2.1 *)
(************************************************************************)
-(** Properties of addition. [add] is defined in [Init/Peano.v] as:
+(** Properties of addition.
+
+ This file is mostly OBSOLETE now, see module [PeanoNat.Nat] instead.
+
+ [Nat.add] is defined in [Init/Nat.v] as:
<<
-Fixpoint plus (n m:nat) : nat :=
+Fixpoint add (n m:nat) : nat :=
match n with
| O => m
| S p => S (p + m)
end
-where "n + m" := (plus n m) : nat_scope.
+where "n + m" := (add n m) : nat_scope.
>>
- *)
+*)
-Require Import Le.
-Require Import Lt.
+Require Import PeanoNat.
Local Open Scope nat_scope.
-Implicit Types m n p q : nat.
-
-(** * Zero is neutral
-Deprecated : Already in Init/Peano.v *)
-Notation plus_0_l := plus_O_n (only parsing).
-Definition plus_0_r n := eq_sym (plus_n_O n).
-
-(** * Commutativity *)
-
-Lemma plus_comm : forall n m, n + m = m + n.
-Proof.
- intros n m; elim n; simpl; auto with arith.
- intros y H; elim (plus_n_Sm m y); auto with arith.
-Qed.
-Hint Immediate plus_comm: arith v62.
-
-(** * Associativity *)
+(** * Neutrality of 0, commutativity, associativity *)
-Definition plus_Snm_nSm : forall n m, S n + m = n + S m:=
- plus_n_Sm.
+Notation plus_0_l := Nat.add_0_l (compat "8.4").
+Notation plus_0_r := Nat.add_0_r (compat "8.4").
+Notation plus_comm := Nat.add_comm (compat "8.4").
+Notation plus_assoc := Nat.add_assoc (compat "8.4").
-Lemma plus_assoc : forall n m p, n + (m + p) = n + m + p.
-Proof.
- intros n m p; elim n; simpl; auto with arith.
-Qed.
-Hint Resolve plus_assoc: arith v62.
+Notation plus_permute := Nat.add_shuffle3 (compat "8.4").
-Lemma plus_permute : forall n m p, n + (m + p) = m + (n + p).
-Proof.
- intros; rewrite (plus_assoc m n p); rewrite (plus_comm m n); auto with arith.
-Qed.
+Definition plus_Snm_nSm : forall n m, S n + m = n + S m :=
+ Peano.plus_n_Sm.
-Lemma plus_assoc_reverse : forall n m p, n + m + p = n + (m + p).
+Lemma plus_assoc_reverse n m p : n + m + p = n + (m + p).
Proof.
- auto with arith.
+ symmetry. apply Nat.add_assoc.
Qed.
-Hint Resolve plus_assoc_reverse: arith v62.
(** * Simplification *)
-Lemma plus_reg_l : forall n m p, p + n = p + m -> n = m.
+Lemma plus_reg_l n m p : p + n = p + m -> n = m.
Proof.
- intros m p n; induction n; simpl; auto with arith.
+ apply Nat.add_cancel_l.
Qed.
-Lemma plus_le_reg_l : forall n m p, p + n <= p + m -> n <= m.
+Lemma plus_le_reg_l n m p : p + n <= p + m -> n <= m.
Proof.
- induction p; simpl; auto with arith.
+ apply Nat.add_le_mono_l.
Qed.
-Lemma plus_lt_reg_l : forall n m p, p + n < p + m -> n < m.
+Lemma plus_lt_reg_l n m p : p + n < p + m -> n < m.
Proof.
- induction p; simpl; auto with arith.
+ apply Nat.add_lt_mono_l.
Qed.
(** * Compatibility with order *)
-Lemma plus_le_compat_l : forall n m p, n <= m -> p + n <= p + m.
+Lemma plus_le_compat_l n m p : n <= m -> p + n <= p + m.
Proof.
- induction p; simpl; auto with arith.
+ apply Nat.add_le_mono_l.
Qed.
-Hint Resolve plus_le_compat_l: arith v62.
-Lemma plus_le_compat_r : forall n m p, n <= m -> n + p <= m + p.
+Lemma plus_le_compat_r n m p : n <= m -> n + p <= m + p.
Proof.
- induction 1; simpl; auto with arith.
+ apply Nat.add_le_mono_r.
Qed.
-Hint Resolve plus_le_compat_r: arith v62.
-Lemma le_plus_l : forall n m, n <= n + m.
+Lemma plus_lt_compat_l n m p : n < m -> p + n < p + m.
Proof.
- induction n; simpl; auto with arith.
+ apply Nat.add_lt_mono_l.
Qed.
-Hint Resolve le_plus_l: arith v62.
-Lemma le_plus_r : forall n m, m <= n + m.
+Lemma plus_lt_compat_r n m p : n < m -> n + p < m + p.
Proof.
- intros n m; elim n; simpl; auto with arith.
+ apply Nat.add_lt_mono_r.
Qed.
-Hint Resolve le_plus_r: arith v62.
-Theorem le_plus_trans : forall n m p, n <= m -> n <= m + p.
+Lemma plus_le_compat n m p q : n <= m -> p <= q -> n + p <= m + q.
Proof.
- intros; apply le_trans with (m := m); auto with arith.
+ apply Nat.add_le_mono.
Qed.
-Hint Resolve le_plus_trans: arith v62.
-Theorem lt_plus_trans : forall n m p, n < m -> n < m + p.
+Lemma plus_le_lt_compat n m p q : n <= m -> p < q -> n + p < m + q.
Proof.
- intros; apply lt_le_trans with (m := m); auto with arith.
+ apply Nat.add_le_lt_mono.
Qed.
-Hint Immediate lt_plus_trans: arith v62.
-Lemma plus_lt_compat_l : forall n m p, n < m -> p + n < p + m.
+Lemma plus_lt_le_compat n m p q : n < m -> p <= q -> n + p < m + q.
Proof.
- induction p; simpl; auto with arith.
+ apply Nat.add_lt_le_mono.
Qed.
-Hint Resolve plus_lt_compat_l: arith v62.
-Lemma plus_lt_compat_r : forall n m p, n < m -> n + p < m + p.
+Lemma plus_lt_compat n m p q : n < m -> p < q -> n + p < m + q.
Proof.
- intros n m p H; rewrite (plus_comm n p); rewrite (plus_comm m p).
- elim p; auto with arith.
+ apply Nat.add_lt_mono.
Qed.
-Hint Resolve plus_lt_compat_r: arith v62.
-Lemma plus_le_compat : forall n m p q, n <= m -> p <= q -> n + p <= m + q.
+Lemma le_plus_l n m : n <= n + m.
Proof.
- intros n m p q H H0.
- elim H; simpl; auto with arith.
+ apply Nat.le_add_r.
Qed.
-Lemma plus_le_lt_compat : forall n m p q, n <= m -> p < q -> n + p < m + q.
+Lemma le_plus_r n m : m <= n + m.
Proof.
- unfold lt. intros. change (S n + p <= m + q). rewrite plus_Snm_nSm.
- apply plus_le_compat; assumption.
+ rewrite Nat.add_comm. apply Nat.le_add_r.
Qed.
-Lemma plus_lt_le_compat : forall n m p q, n < m -> p <= q -> n + p < m + q.
+Theorem le_plus_trans n m p : n <= m -> n <= m + p.
Proof.
- unfold lt. intros. change (S n + p <= m + q). apply plus_le_compat; assumption.
+ intros. now rewrite <- Nat.le_add_r.
Qed.
-Lemma plus_lt_compat : forall n m p q, n < m -> p < q -> n + p < m + q.
+Theorem lt_plus_trans n m p : n < m -> n < m + p.
Proof.
- intros. apply plus_lt_le_compat. assumption.
- apply lt_le_weak. assumption.
+ intros. apply Nat.lt_le_trans with m. trivial. apply Nat.le_add_r.
Qed.
(** * Inversion lemmas *)
-Lemma plus_is_O : forall n m, n + m = 0 -> n = 0 /\ m = 0.
+Lemma plus_is_O n m : n + m = 0 -> n = 0 /\ m = 0.
Proof.
- intro m; destruct m as [| n]; auto.
- intros. discriminate H.
+ destruct n; now split.
Qed.
-Definition plus_is_one :
- forall m n, m + n = 1 -> {m = 0 /\ n = 1} + {m = 1 /\ n = 0}.
+Definition plus_is_one m n :
+ m + n = 1 -> {m = 0 /\ n = 1} + {m = 1 /\ n = 0}.
Proof.
- intro m; destruct m as [| n]; auto.
- destruct n; auto.
- intros.
- simpl in H. discriminate H.
+ destruct m as [| m]; auto.
+ destruct m; auto.
+ discriminate.
Defined.
(** * Derived properties *)
-Lemma plus_permute_2_in_4 : forall n m p q, n + m + (p + q) = n + p + (m + q).
-Proof.
- intros m n p q.
- rewrite <- (plus_assoc m n (p + q)). rewrite (plus_assoc n p q).
- rewrite (plus_comm n p). rewrite <- (plus_assoc p n q). apply plus_assoc.
-Qed.
+Notation plus_permute_2_in_4 := Nat.add_shuffle1 (compat "8.4").
(** * Tail-recursive plus *)
@@ -190,31 +153,37 @@ Fixpoint tail_plus n m : nat :=
end.
Lemma plus_tail_plus : forall n m, n + m = tail_plus n m.
+Proof.
induction n as [| n IHn]; simpl; auto.
intro m; rewrite <- IHn; simpl; auto.
Qed.
(** * Discrimination *)
-Lemma succ_plus_discr : forall n m, n <> S (plus m n).
+Lemma succ_plus_discr n m : n <> S (m+n).
Proof.
- intros n m; induction n as [|n IHn].
- discriminate.
- intro H; apply IHn; apply eq_add_S; rewrite H; rewrite <- plus_n_Sm;
- reflexivity.
+ apply Nat.succ_add_discr.
Qed.
-Lemma n_SSn : forall n, n <> S (S n).
-Proof.
- intro n; exact (succ_plus_discr n 1).
-Qed.
+Lemma n_SSn n : n <> S (S n).
+Proof (succ_plus_discr n 1).
-Lemma n_SSSn : forall n, n <> S (S (S n)).
-Proof.
- intro n; exact (succ_plus_discr n 2).
-Qed.
+Lemma n_SSSn n : n <> S (S (S n)).
+Proof (succ_plus_discr n 2).
-Lemma n_SSSSn : forall n, n <> S (S (S (S n))).
-Proof.
- intro n; exact (succ_plus_discr n 3).
-Qed.
+Lemma n_SSSSn n : n <> S (S (S (S n))).
+Proof (succ_plus_discr n 3).
+
+
+(** * Compatibility Hints *)
+
+Hint Immediate plus_comm : arith v62.
+Hint Resolve plus_assoc plus_assoc_reverse : arith v62.
+Hint Resolve plus_le_compat_l plus_le_compat_r : arith v62.
+Hint Resolve le_plus_l le_plus_r le_plus_trans : arith v62.
+Hint Immediate lt_plus_trans : arith v62.
+Hint Resolve plus_lt_compat_l plus_lt_compat_r : arith v62.
+
+(** For compatibility, we "Require" the same files as before *)
+
+Require Import Le Lt.
diff --git a/theories/Arith/Wf_nat.v b/theories/Arith/Wf_nat.v
index 8cd195f8..64764830 100644
--- a/theories/Arith/Wf_nat.v
+++ b/theories/Arith/Wf_nat.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -8,7 +8,7 @@
(** Well-founded relations and natural numbers *)
-Require Import Lt.
+Require Import PeanoNat Lt.
Local Open Scope nat_scope.
@@ -24,16 +24,12 @@ Definition gtof (a b:A) := f b > f a.
Theorem well_founded_ltof : well_founded ltof.
Proof.
- red.
- cut (forall n (a:A), f a < n -> Acc ltof a).
- intros H a; apply (H (S (f a))); auto with arith.
- induction n.
- intros; absurd (f a < 0); auto with arith.
- intros a ltSma.
- apply Acc_intro.
- unfold ltof; intros b ltfafb.
- apply IHn.
- apply lt_le_trans with (f a); auto with arith.
+ assert (H : forall n (a:A), f a < n -> Acc ltof a).
+ { induction n.
+ - intros; absurd (f a < 0); auto with arith.
+ - intros a Ha. apply Acc_intro. unfold ltof at 1. intros b Hb.
+ apply IHn. apply Nat.lt_le_trans with (f a); auto with arith. }
+ intros a. apply (H (S (f a))). auto with arith.
Defined.
Theorem well_founded_gtof : well_founded gtof.
@@ -67,15 +63,13 @@ Theorem induction_ltof1 :
forall P:A -> Set,
(forall x:A, (forall y:A, ltof y x -> P y) -> P x) -> forall a:A, P a.
Proof.
- intros P F; cut (forall n (a:A), f a < n -> P a).
- intros H a; apply (H (S (f a))); auto with arith.
- induction n.
- intros; absurd (f a < 0); auto with arith.
- intros a ltSma.
- apply F.
- unfold ltof; intros b ltfafb.
- apply IHn.
- apply lt_le_trans with (f a); auto with arith.
+ intros P F.
+ assert (H : forall n (a:A), f a < n -> P a).
+ { induction n.
+ - intros; absurd (f a < 0); auto with arith.
+ - intros a Ha. apply F. unfold ltof. intros b Hb.
+ apply IHn. apply Nat.lt_le_trans with (f a); auto with arith. }
+ intros a. apply (H (S (f a))). auto with arith.
Defined.
Theorem induction_gtof1 :
@@ -108,16 +102,12 @@ Hypothesis H_compat : forall x y:A, R x y -> f x < f y.
Theorem well_founded_lt_compat : well_founded R.
Proof.
- red.
- cut (forall n (a:A), f a < n -> Acc R a).
- intros H a; apply (H (S (f a))); auto with arith.
- induction n.
- intros; absurd (f a < 0); auto with arith.
- intros a ltSma.
- apply Acc_intro.
- intros b ltfafb.
- apply IHn.
- apply lt_le_trans with (f a); auto with arith.
+ assert (H : forall n (a:A), f a < n -> Acc R a).
+ { induction n.
+ - intros; absurd (f a < 0); auto with arith.
+ - intros a Ha. apply Acc_intro. intros b Hb.
+ apply IHn. apply Nat.lt_le_trans with (f a); auto with arith. }
+ intros a. apply (H (S (f a))). auto with arith.
Defined.
End Well_founded_Nat.
@@ -208,6 +198,7 @@ End LT_WF_REL.
Lemma well_founded_inv_rel_inv_lt_rel :
forall (A:Set) (F:A -> nat -> Prop), well_founded (inv_lt_rel A F).
+Proof.
intros; apply (well_founded_inv_lt_rel_compat A (inv_lt_rel A F) F); trivial.
Qed.
@@ -230,34 +221,20 @@ Proof.
intros P Pdec (n0,HPn0).
assert
(forall n, (exists n', n'<n /\ P n' /\ forall n'', P n'' -> n'<=n'')
- \/(forall n', P n' -> n<=n')).
- induction n.
- right.
- intros n' Hn'.
- apply le_O_n.
- destruct IHn.
- left; destruct H as (n', (Hlt', HPn')).
- exists n'; split.
- apply lt_S; assumption.
- assumption.
- destruct (Pdec n).
- left; exists n; split.
- apply lt_n_Sn.
- split; assumption.
- right.
- intros n' Hltn'.
- destruct (le_lt_eq_dec n n') as [Hltn|Heqn].
- apply H; assumption.
- assumption.
- destruct H0.
- rewrite Heqn; assumption.
- destruct (H n0) as [(n,(Hltn,(Hmin,Huniqn)))|]; [exists n | exists n0];
- repeat split;
- assumption || intros n' (HPn',Hminn'); apply le_antisym; auto.
+ \/ (forall n', P n' -> n<=n')).
+ { induction n.
+ - right. intros. apply Nat.le_0_l.
+ - destruct IHn as [(n' & IH1 & IH2)|IH].
+ + left. exists n'; auto with arith.
+ + destruct (Pdec n) as [HP|HP].
+ * left. exists n; auto with arith.
+ * right. intros n' Hn'.
+ apply Nat.le_neq; split; auto. intros <-. auto. }
+ destruct (H n0) as [(n & H1 & H2 & H3)|H0]; [exists n | exists n0];
+ repeat split; trivial;
+ intros n' (HPn',Hn'); apply Nat.le_antisymm; auto.
Qed.
Unset Implicit Arguments.
-Notation iter_nat := @nat_iter (only parsing).
-Notation iter_nat_plus := @nat_iter_plus (only parsing).
-Notation iter_nat_invariant := @nat_iter_invariant (only parsing).
+Notation iter_nat n A f x := (nat_rect (fun _ => A) x (fun _ => f) n) (only parsing).
diff --git a/theories/Arith/vo.itarget b/theories/Arith/vo.itarget
index 0b6564e1..0b3d31e9 100644
--- a/theories/Arith/vo.itarget
+++ b/theories/Arith/vo.itarget
@@ -1,3 +1,4 @@
+PeanoNat.vo
Arith_base.vo
Arith.vo
Between.vo
diff --git a/theories/Bool/Bool.v b/theories/Bool/Bool.v
index 5ec8f806..cc12cf47 100644
--- a/theories/Bool/Bool.v
+++ b/theories/Bool/Bool.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -458,16 +458,22 @@ Notation demorgan4 := orb_andb_distrib_l (only parsing).
(** Absorption *)
-Lemma absoption_andb : forall b1 b2:bool, b1 && (b1 || b2) = b1.
+Lemma absorption_andb : forall b1 b2:bool, b1 && (b1 || b2) = b1.
Proof.
destr_bool.
Qed.
-Lemma absoption_orb : forall b1 b2:bool, b1 || b1 && b2 = b1.
+Lemma absorption_orb : forall b1 b2:bool, b1 || b1 && b2 = b1.
Proof.
destr_bool.
Qed.
+(* begin hide *)
+(* Compatibility *)
+Notation absoption_andb := absorption_andb (only parsing).
+Notation absoption_orb := absorption_orb (only parsing).
+(* end hide *)
+
(*********************************)
(** * Properties of [xorb] *)
(*********************************)
diff --git a/theories/Bool/BoolEq.v b/theories/Bool/BoolEq.v
index 53892754..11af2fd1 100644
--- a/theories/Bool/BoolEq.v
+++ b/theories/Bool/BoolEq.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Bool/Bvector.v b/theories/Bool/Bvector.v
index 2b0e40a3..7c63f069 100644
--- a/theories/Bool/Bvector.v
+++ b/theories/Bool/Bvector.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -60,13 +60,13 @@ Definition Bhigh := @Vector.tl bool.
Definition Bsign := @Vector.last bool.
-Definition Bneg n (v : Bvector n) := Vector.map negb v.
+Definition Bneg := @Vector.map _ _ negb.
-Definition BVand n (v : Bvector n) := Vector.map2 andb v.
+Definition BVand := @Vector.map2 _ _ _ andb.
-Definition BVor n (v : Bvector n) := Vector.map2 orb v.
+Definition BVor := @Vector.map2 _ _ _ orb.
-Definition BVxor n (v : Bvector n) := Vector.map2 xorb v.
+Definition BVxor := @Vector.map2 _ _ _ xorb.
Definition BshiftL (n:nat) (bv:Bvector (S n)) (carry:bool) :=
Bcons carry n (Vector.shiftout bv).
diff --git a/theories/Bool/DecBool.v b/theories/Bool/DecBool.v
index e89d31a4..e0b8ec9b 100644
--- a/theories/Bool/DecBool.v
+++ b/theories/Bool/DecBool.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Bool/IfProp.v b/theories/Bool/IfProp.v
index c371f584..a0acbe8c 100644
--- a/theories/Bool/IfProp.v
+++ b/theories/Bool/IfProp.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Bool/Sumbool.v b/theories/Bool/Sumbool.v
index 4b61ebe7..c2e9183b 100644
--- a/theories/Bool/Sumbool.v
+++ b/theories/Bool/Sumbool.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Bool/Zerob.v b/theories/Bool/Zerob.v
index b23544b3..e146f25f 100644
--- a/theories/Bool/Zerob.v
+++ b/theories/Bool/Zerob.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Classes/CEquivalence.v b/theories/Classes/CEquivalence.v
new file mode 100644
index 00000000..65353ed2
--- /dev/null
+++ b/theories/Classes/CEquivalence.v
@@ -0,0 +1,139 @@
+(************************************************************************)
+(* v * The Coq Proof Assistant / The Coq Development Team *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* \VV/ **************************************************************)
+(* // * This file is distributed under the terms of the *)
+(* * GNU Lesser General Public License Version 2.1 *)
+(************************************************************************)
+
+(** * Typeclass-based setoids. Definitions on [Equivalence].
+
+ Author: Matthieu Sozeau
+ Institution: LRI, CNRS UMR 8623 - University Paris Sud
+*)
+
+Require Import Coq.Program.Basics.
+Require Import Coq.Program.Tactics.
+
+Require Import Coq.Classes.Init.
+Require Import Relation_Definitions.
+Require Export Coq.Classes.CRelationClasses.
+Require Import Coq.Classes.CMorphisms.
+
+Set Implicit Arguments.
+Unset Strict Implicit.
+
+Generalizable Variables A R eqA B S eqB.
+Local Obligation Tactic := try solve [simpl_crelation].
+
+Local Open Scope signature_scope.
+
+Definition equiv `{Equivalence A R} : crelation A := R.
+
+(** Overloaded notations for setoid equivalence and inequivalence.
+ Not to be confused with [eq] and [=]. *)
+
+Notation " x === y " := (equiv x y) (at level 70, no associativity) : equiv_scope.
+
+Notation " x =/= y " := (complement equiv x y) (at level 70, no associativity) : equiv_scope.
+
+Local Open Scope equiv_scope.
+
+(** Overloading for [PER]. *)
+
+Definition pequiv `{PER A R} : crelation A := R.
+
+(** Overloaded notation for partial equivalence. *)
+
+Infix "=~=" := pequiv (at level 70, no associativity) : equiv_scope.
+
+(** Shortcuts to make proof search easier. *)
+
+Program Instance equiv_reflexive `(sa : Equivalence A) : Reflexive equiv.
+
+Program Instance equiv_symmetric `(sa : Equivalence A) : Symmetric equiv.
+
+Program Instance equiv_transitive `(sa : Equivalence A) : Transitive equiv.
+
+ Next Obligation.
+ Proof. intros A R sa x y z Hxy Hyz.
+ now transitivity y.
+ Qed.
+
+(** Use the [substitute] command which substitutes an equivalence in every hypothesis. *)
+
+Ltac setoid_subst H :=
+ match type of H with
+ ?x === ?y => substitute H ; clear H x
+ end.
+
+Ltac setoid_subst_nofail :=
+ match goal with
+ | [ H : ?x === ?y |- _ ] => setoid_subst H ; setoid_subst_nofail
+ | _ => idtac
+ end.
+
+(** [subst*] will try its best at substituting every equality in the goal. *)
+
+Tactic Notation "subst" "*" := subst_no_fail ; setoid_subst_nofail.
+
+(** Simplify the goal w.r.t. equivalence. *)
+
+Ltac equiv_simplify_one :=
+ match goal with
+ | [ H : ?x === ?x |- _ ] => clear H
+ | [ H : ?x === ?y |- _ ] => setoid_subst H
+ | [ |- ?x =/= ?y ] => let name:=fresh "Hneq" in intro name
+ | [ |- ~ ?x === ?y ] => let name:=fresh "Hneq" in intro name
+ end.
+
+Ltac equiv_simplify := repeat equiv_simplify_one.
+
+(** "reify" relations which are equivalences to applications of the overloaded [equiv] method
+ for easy recognition in tactics. *)
+
+Ltac equivify_tac :=
+ match goal with
+ | [ s : Equivalence ?A ?R, H : ?R ?x ?y |- _ ] => change R with (@equiv A R s) in H
+ | [ s : Equivalence ?A ?R |- context C [ ?R ?x ?y ] ] => change (R x y) with (@equiv A R s x y)
+ end.
+
+Ltac equivify := repeat equivify_tac.
+
+Section Respecting.
+
+ (** Here we build an equivalence instance for functions which relates respectful ones only,
+ we do not export it. *)
+
+ Definition respecting `(eqa : Equivalence A (R : crelation A),
+ eqb : Equivalence B (R' : crelation B)) : Type :=
+ { morph : A -> B & respectful R R' morph morph }.
+
+ Program Instance respecting_equiv `(eqa : Equivalence A R, eqb : Equivalence B R') :
+ Equivalence (fun (f g : respecting eqa eqb) =>
+ forall (x y : A), R x y -> R' (projT1 f x) (projT1 g y)).
+
+ Solve Obligations with unfold respecting in * ; simpl_crelation ; program_simpl.
+
+ Next Obligation.
+ Proof.
+ intros. intros f g h H H' x y Rxy.
+ unfold respecting in *. program_simpl. transitivity (g y); auto. firstorder.
+ Qed.
+
+End Respecting.
+
+(** The default equivalence on function spaces, with higher-priority than [eq]. *)
+
+Instance pointwise_reflexive {A} `(reflb : Reflexive B eqB) :
+ Reflexive (pointwise_relation A eqB) | 9.
+Proof. firstorder. Qed.
+Instance pointwise_symmetric {A} `(symb : Symmetric B eqB) :
+ Symmetric (pointwise_relation A eqB) | 9.
+Proof. firstorder. Qed.
+Instance pointwise_transitive {A} `(transb : Transitive B eqB) :
+ Transitive (pointwise_relation A eqB) | 9.
+Proof. firstorder. Qed.
+Instance pointwise_equivalence {A} `(eqb : Equivalence B eqB) :
+ Equivalence (pointwise_relation A eqB) | 9.
+Proof. split; apply _. Qed.
diff --git a/theories/Classes/CMorphisms.v b/theories/Classes/CMorphisms.v
new file mode 100644
index 00000000..073cd5e9
--- /dev/null
+++ b/theories/Classes/CMorphisms.v
@@ -0,0 +1,701 @@
+(* -*- coding: utf-8 -*- *)
+(************************************************************************)
+(* v * The Coq Proof Assistant / The Coq Development Team *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* \VV/ **************************************************************)
+(* // * This file is distributed under the terms of the *)
+(* * GNU Lesser General Public License Version 2.1 *)
+(************************************************************************)
+
+(** * Typeclass-based morphism definition and standard, minimal instances
+
+ Author: Matthieu Sozeau
+ Institution: LRI, CNRS UMR 8623 - University Paris Sud
+*)
+
+Require Import Coq.Program.Basics.
+Require Import Coq.Program.Tactics.
+Require Export Coq.Classes.CRelationClasses.
+
+Generalizable Variables A eqA B C D R RA RB RC m f x y.
+Local Obligation Tactic := simpl_crelation.
+
+Set Universe Polymorphism.
+
+(** * Morphisms.
+
+ We now turn to the definition of [Proper] and declare standard instances.
+ These will be used by the [setoid_rewrite] tactic later. *)
+
+(** A morphism for a relation [R] is a proper element of the relation.
+ The relation [R] will be instantiated by [respectful] and [A] by an arrow
+ type for usual morphisms. *)
+Section Proper.
+ Context {A B : Type}.
+
+ Class Proper (R : crelation A) (m : A) :=
+ proper_prf : R m m.
+
+ (** Every element in the carrier of a reflexive relation is a morphism
+ for this relation. We use a proxy class for this case which is used
+ internally to discharge reflexivity constraints. The [Reflexive]
+ instance will almost always be used, but it won't apply in general to
+ any kind of [Proper (A -> B) _ _] goal, making proof-search much
+ slower. A cleaner solution would be to be able to set different
+ priorities in different hint bases and select a particular hint
+ database for resolution of a type class constraint. *)
+
+ Class ProperProxy (R : crelation A) (m : A) :=
+ proper_proxy : R m m.
+
+ Lemma eq_proper_proxy (x : A) : ProperProxy (@eq A) x.
+ Proof. firstorder. Qed.
+
+ Lemma reflexive_proper_proxy `(Reflexive A R) (x : A) : ProperProxy R x.
+ Proof. firstorder. Qed.
+
+ Lemma proper_proper_proxy x `(Proper R x) : ProperProxy R x.
+ Proof. firstorder. Qed.
+
+ (** Respectful morphisms. *)
+
+ (** The fully dependent version, not used yet. *)
+
+ Definition respectful_hetero
+ (A B : Type)
+ (C : A -> Type) (D : B -> Type)
+ (R : A -> B -> Type)
+ (R' : forall (x : A) (y : B), C x -> D y -> Type) :
+ (forall x : A, C x) -> (forall x : B, D x) -> Type :=
+ fun f g => forall x y, R x y -> R' x y (f x) (g y).
+
+ (** The non-dependent version is an instance where we forget dependencies. *)
+
+ Definition respectful (R : crelation A) (R' : crelation B) : crelation (A -> B) :=
+ Eval compute in @respectful_hetero A A (fun _ => B) (fun _ => B) R (fun _ _ => R').
+End Proper.
+
+(** We favor the use of Leibniz equality or a declared reflexive crelation
+ when resolving [ProperProxy], otherwise, if the crelation is given (not an evar),
+ we fall back to [Proper]. *)
+Hint Extern 1 (ProperProxy _ _) =>
+ class_apply @eq_proper_proxy || class_apply @reflexive_proper_proxy : typeclass_instances.
+
+Hint Extern 2 (ProperProxy ?R _) =>
+ not_evar R; class_apply @proper_proper_proxy : typeclass_instances.
+
+(** Notations reminiscent of the old syntax for declaring morphisms. *)
+Delimit Scope signature_scope with signature.
+
+Module ProperNotations.
+
+ Notation " R ++> R' " := (@respectful _ _ (R%signature) (R'%signature))
+ (right associativity, at level 55) : signature_scope.
+
+ Notation " R ==> R' " := (@respectful _ _ (R%signature) (R'%signature))
+ (right associativity, at level 55) : signature_scope.
+
+ Notation " R --> R' " := (@respectful _ _ (flip (R%signature)) (R'%signature))
+ (right associativity, at level 55) : signature_scope.
+
+End ProperNotations.
+
+Arguments Proper {A}%type R%signature m.
+Arguments respectful {A B}%type (R R')%signature _ _.
+
+Export ProperNotations.
+
+Local Open Scope signature_scope.
+
+(** [solve_proper] try to solve the goal [Proper (?==> ... ==>?) f]
+ by repeated introductions and setoid rewrites. It should work
+ fine when [f] is a combination of already known morphisms and
+ quantifiers. *)
+
+Ltac solve_respectful t :=
+ match goal with
+ | |- respectful _ _ _ _ =>
+ let H := fresh "H" in
+ intros ? ? H; solve_respectful ltac:(setoid_rewrite H; t)
+ | _ => t; reflexivity
+ end.
+
+Ltac solve_proper := unfold Proper; solve_respectful ltac:(idtac).
+
+(** [f_equiv] is a clone of [f_equal] that handles setoid equivalences.
+ For example, if we know that [f] is a morphism for [E1==>E2==>E],
+ then the goal [E (f x y) (f x' y')] will be transformed by [f_equiv]
+ into the subgoals [E1 x x'] and [E2 y y'].
+*)
+
+Ltac f_equiv :=
+ match goal with
+ | |- ?R (?f ?x) (?f' _) =>
+ let T := type of x in
+ let Rx := fresh "R" in
+ evar (Rx : crelation T);
+ let H := fresh in
+ assert (H : (Rx==>R)%signature f f');
+ unfold Rx in *; clear Rx; [ f_equiv | apply H; clear H; try reflexivity ]
+ | |- ?R ?f ?f' =>
+ solve [change (Proper R f); eauto with typeclass_instances | reflexivity ]
+ | _ => idtac
+ end.
+
+Section Relations.
+ Context {A B : Type}.
+
+ (** [forall_def] reifies the dependent product as a definition. *)
+
+ Definition forall_def (P : A -> Type) : Type := forall x : A, P x.
+
+ (** Dependent pointwise lifting of a crelation on the range. *)
+
+ Definition forall_relation (P : A -> Type)
+ (sig : forall a, crelation (P a)) : crelation (forall x, P x) :=
+ fun f g => forall a, sig a (f a) (g a).
+
+ (** Non-dependent pointwise lifting *)
+ Definition pointwise_relation (R : crelation B) : crelation (A -> B) :=
+ fun f g => forall a, R (f a) (g a).
+
+ Lemma pointwise_pointwise (R : crelation B) :
+ relation_equivalence (pointwise_relation R) (@eq A ==> R).
+ Proof. intros. split. simpl_crelation. firstorder. Qed.
+
+ (** Subcrelations induce a morphism on the identity. *)
+
+ Global Instance subrelation_id_proper `(subrelation A RA RA') : Proper (RA ==> RA') id.
+ Proof. firstorder. Qed.
+
+ (** The subrelation property goes through products as usual. *)
+
+ Lemma subrelation_respectful `(subl : subrelation A RA' RA, subr : subrelation B RB RB') :
+ subrelation (RA ==> RB) (RA' ==> RB').
+ Proof. simpl_crelation. Qed.
+
+ (** And of course it is reflexive. *)
+
+ Lemma subrelation_refl R : @subrelation A R R.
+ Proof. simpl_crelation. Qed.
+
+ (** [Proper] is itself a covariant morphism for [subrelation].
+ We use an unconvertible premise to avoid looping.
+ *)
+
+ Lemma subrelation_proper `(mor : Proper A R' m)
+ `(unc : Unconvertible (crelation A) R R')
+ `(sub : subrelation A R' R) : Proper R m.
+ Proof.
+ intros. apply sub. apply mor.
+ Qed.
+
+ Global Instance proper_subrelation_proper_arrow :
+ Proper (subrelation ++> eq ==> arrow) (@Proper A).
+ Proof. reduce. subst. firstorder. Qed.
+
+ Global Instance pointwise_subrelation `(sub : subrelation B R R') :
+ subrelation (pointwise_relation R) (pointwise_relation R') | 4.
+ Proof. reduce. unfold pointwise_relation in *. apply sub. auto. Qed.
+
+ (** For dependent function types. *)
+ Lemma forall_subrelation (P : A -> Type) (R S : forall x : A, crelation (P x)) :
+ (forall a, subrelation (R a) (S a)) ->
+ subrelation (forall_relation P R) (forall_relation P S).
+ Proof. reduce. firstorder. Qed.
+End Relations.
+Typeclasses Opaque respectful pointwise_relation forall_relation.
+Arguments forall_relation {A P}%type sig%signature _ _.
+Arguments pointwise_relation A%type {B}%type R%signature _ _.
+
+Hint Unfold Reflexive : core.
+Hint Unfold Symmetric : core.
+Hint Unfold Transitive : core.
+
+(** Resolution with subrelation: favor decomposing products over applying reflexivity
+ for unconstrained goals. *)
+Ltac subrelation_tac T U :=
+ (is_ground T ; is_ground U ; class_apply @subrelation_refl) ||
+ class_apply @subrelation_respectful || class_apply @subrelation_refl.
+
+Hint Extern 3 (@subrelation _ ?T ?U) => subrelation_tac T U : typeclass_instances.
+
+CoInductive apply_subrelation : Prop := do_subrelation.
+
+Ltac proper_subrelation :=
+ match goal with
+ [ H : apply_subrelation |- _ ] => clear H ; class_apply @subrelation_proper
+ end.
+
+Hint Extern 5 (@Proper _ ?H _) => proper_subrelation : typeclass_instances.
+
+(** Essential subrelation instances for [iff], [impl] and [pointwise_relation]. *)
+
+Instance iff_impl_subrelation : subrelation iff impl | 2.
+Proof. firstorder. Qed.
+
+Instance iff_flip_impl_subrelation : subrelation iff (flip impl) | 2.
+Proof. firstorder. Qed.
+
+(** Essential subrelation instances for [iffT] and [arrow]. *)
+
+Instance iffT_arrow_subrelation : subrelation iffT arrow | 2.
+Proof. firstorder. Qed.
+
+Instance iffT_flip_arrow_subrelation : subrelation iffT (flip arrow) | 2.
+Proof. firstorder. Qed.
+
+(** We use an extern hint to help unification. *)
+
+Hint Extern 4 (subrelation (@forall_relation ?A ?B ?R) (@forall_relation _ _ ?S)) =>
+ apply (@forall_subrelation A B R S) ; intro : typeclass_instances.
+
+Section GenericInstances.
+ (* Share universes *)
+ Context {A B C : Type}.
+
+ (** We can build a PER on the Coq function space if we have PERs on the domain and
+ codomain. *)
+
+ Program Instance respectful_per `(PER A R, PER B R') : PER (R ==> R').
+
+ Next Obligation.
+ Proof with auto.
+ assert(R x0 x0).
+ transitivity y0... symmetry...
+ transitivity (y x0)...
+ Qed.
+
+ (** The complement of a crelation conserves its proper elements. *)
+
+ Program Definition complement_proper
+ `(mR : Proper (A -> A -> Prop) (RA ==> RA ==> iff) R) :
+ Proper (RA ==> RA ==> iff) (complement R) := _.
+
+ Next Obligation.
+ Proof.
+ unfold complement.
+ pose (mR x y X x0 y0 X0).
+ intuition.
+ Qed.
+
+ (** The [flip] too, actually the [flip] instance is a bit more general. *)
+
+ Program Definition flip_proper
+ `(mor : Proper (A -> B -> C) (RA ==> RB ==> RC) f) :
+ Proper (RB ==> RA ==> RC) (flip f) := _.
+
+ Next Obligation.
+ Proof.
+ apply mor ; auto.
+ Qed.
+
+
+ (** Every Transitive crelation gives rise to a binary morphism on [impl],
+ contravariant in the first argument, covariant in the second. *)
+
+ Global Program
+ Instance trans_contra_co_type_morphism
+ `(Transitive A R) : Proper (R --> R ++> arrow) R.
+
+ Next Obligation.
+ Proof with auto.
+ transitivity x...
+ transitivity x0...
+ Qed.
+
+ (** Proper declarations for partial applications. *)
+
+ Global Program
+ Instance trans_contra_inv_impl_type_morphism
+ `(Transitive A R) : Proper (R --> flip arrow) (R x) | 3.
+
+ Next Obligation.
+ Proof with auto.
+ transitivity y...
+ Qed.
+
+ Global Program
+ Instance trans_co_impl_type_morphism
+ `(Transitive A R) : Proper (R ++> arrow) (R x) | 3.
+
+ Next Obligation.
+ Proof with auto.
+ transitivity x0...
+ Qed.
+
+ Global Program
+ Instance trans_sym_co_inv_impl_type_morphism
+ `(PER A R) : Proper (R ++> flip arrow) (R x) | 3.
+
+ Next Obligation.
+ Proof with auto.
+ transitivity y... symmetry...
+ Qed.
+
+ Global Program Instance trans_sym_contra_arrow_morphism
+ `(PER A R) : Proper (R --> arrow) (R x) | 3.
+
+ Next Obligation.
+ Proof with auto.
+ transitivity x0... symmetry...
+ Qed.
+
+ Global Program Instance per_partial_app_type_morphism
+ `(PER A R) : Proper (R ==> iffT) (R x) | 2.
+
+ Next Obligation.
+ Proof with auto.
+ split. intros ; transitivity x0...
+ intros.
+ transitivity y...
+ symmetry...
+ Qed.
+
+ (** Every Transitive crelation induces a morphism by "pushing" an [R x y] on the left of an [R x z] proof to get an [R y z] goal. *)
+
+ Global Program
+ Instance trans_co_eq_inv_arrow_morphism
+ `(Transitive A R) : Proper (R ==> (@eq A) ==> flip arrow) R | 2.
+
+ Next Obligation.
+ Proof with auto.
+ transitivity y...
+ Qed.
+
+ (** Every Symmetric and Transitive crelation gives rise to an equivariant morphism. *)
+
+ Global Program
+ Instance PER_type_morphism `(PER A R) : Proper (R ==> R ==> iffT) R | 1.
+
+ Next Obligation.
+ Proof with auto.
+ split ; intros.
+ transitivity x0... transitivity x... symmetry...
+
+ transitivity y... transitivity y0... symmetry...
+ Qed.
+
+ Lemma symmetric_equiv_flip `(Symmetric A R) : relation_equivalence R (flip R).
+ Proof. firstorder. Qed.
+
+ Global Program Instance compose_proper RA RB RC :
+ Proper ((RB ==> RC) ==> (RA ==> RB) ==> (RA ==> RC)) (@compose A B C).
+
+ Next Obligation.
+ Proof.
+ simpl_crelation.
+ unfold compose. firstorder.
+ Qed.
+
+ (** Coq functions are morphisms for Leibniz equality,
+ applied only if really needed. *)
+
+ Global Instance reflexive_eq_dom_reflexive `(Reflexive B R') :
+ Reflexive (@Logic.eq A ==> R').
+ Proof. simpl_crelation. Qed.
+
+ (** [respectful] is a morphism for crelation equivalence . *)
+ Set Printing All. Set Printing Universes.
+ Global Instance respectful_morphism :
+ Proper (relation_equivalence ++> relation_equivalence ++> relation_equivalence)
+ (@respectful A B).
+ Proof.
+ intros R R' HRR' S S' HSS' f g.
+ unfold respectful , relation_equivalence in *; simpl in *.
+ split ; intros H x y Hxy.
+ apply (fst (HSS' _ _)). apply H. now apply (snd (HRR' _ _)).
+ apply (snd (HSS' _ _)). apply H. now apply (fst (HRR' _ _)).
+ Qed.
+
+ (** [R] is Reflexive, hence we can build the needed proof. *)
+
+ Lemma Reflexive_partial_app_morphism `(Proper (A -> B) (R ==> R') m, ProperProxy A R x) :
+ Proper R' (m x).
+ Proof. simpl_crelation. Qed.
+
+ Class Params (of : A) (arity : nat).
+
+ Lemma flip_respectful (R : crelation A) (R' : crelation B) :
+ relation_equivalence (flip (R ==> R')) (flip R ==> flip R').
+ Proof.
+ intros.
+ unfold flip, respectful.
+ split ; intros ; intuition.
+ Qed.
+
+
+ (** Treating flip: can't make them direct instances as we
+ need at least a [flip] present in the goal. *)
+
+ Lemma flip1 `(subrelation A R' R) : subrelation (flip (flip R')) R.
+ Proof. firstorder. Qed.
+
+ Lemma flip2 `(subrelation A R R') : subrelation R (flip (flip R')).
+ Proof. firstorder. Qed.
+
+ (** That's if and only if *)
+
+ Lemma eq_subrelation `(Reflexive A R) : subrelation (@eq A) R.
+ Proof. simpl_crelation. Qed.
+
+ (** Once we have normalized, we will apply this instance to simplify the problem. *)
+
+ Definition proper_flip_proper `(mor : Proper A R m) : Proper (flip R) m := mor.
+
+ (** Every reflexive crelation gives rise to a morphism,
+ only for immediately solving goals without variables. *)
+
+ Lemma reflexive_proper `{Reflexive A R} (x : A) : Proper R x.
+ Proof. firstorder. Qed.
+
+ Lemma proper_eq (x : A) : Proper (@eq A) x.
+ Proof. intros. apply reflexive_proper. Qed.
+
+End GenericInstances.
+
+Class PartialApplication.
+
+CoInductive normalization_done : Prop := did_normalization.
+
+Ltac partial_application_tactic :=
+ let rec do_partial_apps H m cont :=
+ match m with
+ | ?m' ?x => class_apply @Reflexive_partial_app_morphism ;
+ [(do_partial_apps H m' ltac:idtac)|clear H]
+ | _ => cont
+ end
+ in
+ let rec do_partial H ar m :=
+ match ar with
+ | 0%nat => do_partial_apps H m ltac:(fail 1)
+ | S ?n' =>
+ match m with
+ ?m' ?x => do_partial H n' m'
+ end
+ end
+ in
+ let params m sk fk :=
+ (let m' := fresh in head_of_constr m' m ;
+ let n := fresh in evar (n:nat) ;
+ let v := eval compute in n in clear n ;
+ let H := fresh in
+ assert(H:Params m' v) by typeclasses eauto ;
+ let v' := eval compute in v in subst m';
+ (sk H v' || fail 1))
+ || fk
+ in
+ let on_morphism m cont :=
+ params m ltac:(fun H n => do_partial H n m)
+ ltac:(cont)
+ in
+ match goal with
+ | [ _ : normalization_done |- _ ] => fail 1
+ | [ _ : @Params _ _ _ |- _ ] => fail 1
+ | [ |- @Proper ?T _ (?m ?x) ] =>
+ match goal with
+ | [ H : PartialApplication |- _ ] =>
+ class_apply @Reflexive_partial_app_morphism; [|clear H]
+ | _ => on_morphism (m x)
+ ltac:(class_apply @Reflexive_partial_app_morphism)
+ end
+ end.
+
+(** Bootstrap !!! *)
+
+Instance proper_proper : Proper (relation_equivalence ==> eq ==> iffT) (@Proper A).
+Proof.
+ intros A R R' HRR' x y <-. red in HRR'.
+ split ; red ; intros.
+ now apply (fst (HRR' _ _)).
+ now apply (snd (HRR' _ _)).
+Qed.
+
+Ltac proper_reflexive :=
+ match goal with
+ | [ _ : normalization_done |- _ ] => fail 1
+ | _ => class_apply proper_eq || class_apply @reflexive_proper
+ end.
+
+
+Hint Extern 1 (subrelation (flip _) _) => class_apply @flip1 : typeclass_instances.
+Hint Extern 1 (subrelation _ (flip _)) => class_apply @flip2 : typeclass_instances.
+
+Hint Extern 1 (Proper _ (complement _)) => apply @complement_proper
+ : typeclass_instances.
+Hint Extern 1 (Proper _ (flip _)) => apply @flip_proper
+ : typeclass_instances.
+Hint Extern 2 (@Proper _ (flip _) _) => class_apply @proper_flip_proper
+ : typeclass_instances.
+Hint Extern 4 (@Proper _ _ _) => partial_application_tactic
+ : typeclass_instances.
+Hint Extern 7 (@Proper _ _ _) => proper_reflexive
+ : typeclass_instances.
+
+(** Special-purpose class to do normalization of signatures w.r.t. flip. *)
+
+Section Normalize.
+ Context (A : Type).
+
+ Class Normalizes (m : crelation A) (m' : crelation A) : Prop :=
+ normalizes : relation_equivalence m m'.
+
+ (** Current strategy: add [flip] everywhere and reduce using [subrelation]
+ afterwards. *)
+
+ Lemma proper_normalizes_proper `(Normalizes R0 R1, Proper A R1 m) : Proper R0 m.
+ Proof.
+ red in H, H0. red in H.
+ apply (snd (H _ _)).
+ assumption.
+ Qed.
+
+ Lemma flip_atom R : Normalizes R (flip (flip R)).
+ Proof.
+ firstorder.
+ Qed.
+
+End Normalize.
+
+Lemma flip_arrow `(NA : Normalizes A R (flip R'''), NB : Normalizes B R' (flip R'')) :
+ Normalizes (A -> B) (R ==> R') (flip (R''' ==> R'')%signature).
+Proof.
+ unfold Normalizes in *. intros.
+ rewrite NA, NB. firstorder.
+Qed.
+
+Ltac normalizes :=
+ match goal with
+ | [ |- Normalizes _ (respectful _ _) _ ] => class_apply @flip_arrow
+ | _ => class_apply @flip_atom
+ end.
+
+Ltac proper_normalization :=
+ match goal with
+ | [ _ : normalization_done |- _ ] => fail 1
+ | [ _ : apply_subrelation |- @Proper _ ?R _ ] =>
+ let H := fresh "H" in
+ set(H:=did_normalization) ; class_apply @proper_normalizes_proper
+ end.
+
+Hint Extern 1 (Normalizes _ _ _) => normalizes : typeclass_instances.
+Hint Extern 6 (@Proper _ _ _) => proper_normalization
+ : typeclass_instances.
+
+(** When the crelation on the domain is symmetric, we can
+ flip the crelation on the codomain. Same for binary functions. *)
+
+Lemma proper_sym_flip :
+ forall `(Symmetric A R1)`(Proper (A->B) (R1==>R2) f),
+ Proper (R1==>flip R2) f.
+Proof.
+intros A R1 Sym B R2 f Hf.
+intros x x' Hxx'. apply Hf, Sym, Hxx'.
+Qed.
+
+Lemma proper_sym_flip_2 :
+ forall `(Symmetric A R1)`(Symmetric B R2)`(Proper (A->B->C) (R1==>R2==>R3) f),
+ Proper (R1==>R2==>flip R3) f.
+Proof.
+intros A R1 Sym1 B R2 Sym2 C R3 f Hf.
+intros x x' Hxx' y y' Hyy'. apply Hf; auto.
+Qed.
+
+(** When the crelation on the domain is symmetric, a predicate is
+ compatible with [iff] as soon as it is compatible with [impl].
+ Same with a binary crelation. *)
+
+Lemma proper_sym_impl_iff : forall `(Symmetric A R)`(Proper _ (R==>impl) f),
+ Proper (R==>iff) f.
+Proof.
+intros A R Sym f Hf x x' Hxx'. repeat red in Hf. split; eauto.
+Qed.
+
+Lemma proper_sym_arrow_iffT : forall `(Symmetric A R)`(Proper _ (R==>arrow) f),
+ Proper (R==>iffT) f.
+Proof.
+intros A R Sym f Hf x x' Hxx'. repeat red in Hf. split; eauto.
+Qed.
+
+Lemma proper_sym_impl_iff_2 :
+ forall `(Symmetric A R)`(Symmetric B R')`(Proper _ (R==>R'==>impl) f),
+ Proper (R==>R'==>iff) f.
+Proof.
+intros A R Sym B R' Sym' f Hf x x' Hxx' y y' Hyy'.
+repeat red in Hf. split; eauto.
+Qed.
+
+Lemma proper_sym_arrow_iffT_2 :
+ forall `(Symmetric A R)`(Symmetric B R')`(Proper _ (R==>R'==>arrow) f),
+ Proper (R==>R'==>iffT) f.
+Proof.
+intros A R Sym B R' Sym' f Hf x x' Hxx' y y' Hyy'.
+repeat red in Hf. split; eauto.
+Qed.
+
+(** A [PartialOrder] is compatible with its underlying equivalence. *)
+Require Import Relation_Definitions.
+
+Instance PartialOrder_proper_type `(PartialOrder A eqA R) :
+ Proper (eqA==>eqA==>iffT) R.
+Proof.
+intros.
+apply proper_sym_arrow_iffT_2; auto with *.
+intros x x' Hx y y' Hy Hr.
+transitivity x.
+generalize (partial_order_equivalence x x'); compute; intuition.
+transitivity y; auto.
+generalize (partial_order_equivalence y y'); compute; intuition.
+Qed.
+
+(** From a [PartialOrder] to the corresponding [StrictOrder]:
+ [lt = le /\ ~eq].
+ If the order is total, we could also say [gt = ~le]. *)
+
+Lemma PartialOrder_StrictOrder `(PartialOrder A eqA R) :
+ StrictOrder (relation_conjunction R (complement eqA)).
+Proof.
+split; compute.
+intros x (_,Hx). apply Hx, Equivalence_Reflexive.
+intros x y z (Hxy,Hxy') (Hyz,Hyz'). split.
+apply PreOrder_Transitive with y; assumption.
+intro Hxz.
+apply Hxy'.
+apply partial_order_antisym; auto.
+rewrite Hxz. auto.
+Qed.
+
+(** From a [StrictOrder] to the corresponding [PartialOrder]:
+ [le = lt \/ eq].
+ If the order is total, we could also say [ge = ~lt]. *)
+
+Lemma StrictOrder_PreOrder
+ `(Equivalence A eqA, StrictOrder A R, Proper _ (eqA==>eqA==>iffT) R) :
+ PreOrder (relation_disjunction R eqA).
+Proof.
+split.
+intros x. right. reflexivity.
+intros x y z [Hxy|Hxy] [Hyz|Hyz].
+left. transitivity y; auto.
+left. rewrite <- Hyz; auto.
+left. rewrite Hxy; auto.
+right. transitivity y; auto.
+Qed.
+
+Hint Extern 4 (PreOrder (relation_disjunction _ _)) =>
+ class_apply StrictOrder_PreOrder : typeclass_instances.
+
+Lemma StrictOrder_PartialOrder
+ `(Equivalence A eqA, StrictOrder A R, Proper _ (eqA==>eqA==>iffT) R) :
+ PartialOrder eqA (relation_disjunction R eqA).
+Proof.
+intros. intros x y. compute. intuition.
+elim (StrictOrder_Irreflexive x).
+transitivity y; auto.
+Qed.
+
+Hint Extern 4 (StrictOrder (relation_conjunction _ _)) =>
+ class_apply PartialOrder_StrictOrder : typeclass_instances.
+
+Hint Extern 4 (PartialOrder _ (relation_disjunction _ _)) =>
+ class_apply StrictOrder_PartialOrder : typeclass_instances.
diff --git a/theories/Classes/CRelationClasses.v b/theories/Classes/CRelationClasses.v
new file mode 100644
index 00000000..35b2b8a3
--- /dev/null
+++ b/theories/Classes/CRelationClasses.v
@@ -0,0 +1,359 @@
+(* -*- coding: utf-8 -*- *)
+(************************************************************************)
+(* v * The Coq Proof Assistant / The Coq Development Team *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* \VV/ **************************************************************)
+(* // * This file is distributed under the terms of the *)
+(* * GNU Lesser General Public License Version 2.1 *)
+(************************************************************************)
+
+(** * Typeclass-based relations, tactics and standard instances
+
+ This is the basic theory needed to formalize morphisms and setoids.
+
+ Author: Matthieu Sozeau
+ Institution: LRI, CNRS UMR 8623 - University Paris Sud
+*)
+
+Require Export Coq.Classes.Init.
+Require Import Coq.Program.Basics.
+Require Import Coq.Program.Tactics.
+
+Generalizable Variables A B C D R S T U l eqA eqB eqC eqD.
+
+Set Universe Polymorphism.
+
+Definition crelation (A : Type) := A -> A -> Type.
+
+Definition arrow (A B : Type) := A -> B.
+
+Definition flip {A B C : Type} (f : A -> B -> C) := fun x y => f y x.
+
+Definition iffT (A B : Type) := ((A -> B) * (B -> A))%type.
+
+(** We allow to unfold the [crelation] definition while doing morphism search. *)
+
+Section Defs.
+ Context {A : Type}.
+
+ (** We rebind crelational properties in separate classes to be able to overload each proof. *)
+
+ Class Reflexive (R : crelation A) :=
+ reflexivity : forall x : A, R x x.
+
+ Definition complement (R : crelation A) : crelation A :=
+ fun x y => R x y -> False.
+
+ (** Opaque for proof-search. *)
+ Typeclasses Opaque complement iffT.
+
+ (** These are convertible. *)
+ Lemma complement_inverse R : complement (flip R) = flip (complement R).
+ Proof. reflexivity. Qed.
+
+ Class Irreflexive (R : crelation A) :=
+ irreflexivity : Reflexive (complement R).
+
+ Class Symmetric (R : crelation A) :=
+ symmetry : forall {x y}, R x y -> R y x.
+
+ Class Asymmetric (R : crelation A) :=
+ asymmetry : forall {x y}, R x y -> (complement R y x : Type).
+
+ Class Transitive (R : crelation A) :=
+ transitivity : forall {x y z}, R x y -> R y z -> R x z.
+
+ (** Various combinations of reflexivity, symmetry and transitivity. *)
+
+ (** A [PreOrder] is both Reflexive and Transitive. *)
+
+ Class PreOrder (R : crelation A) := {
+ PreOrder_Reflexive :> Reflexive R | 2 ;
+ PreOrder_Transitive :> Transitive R | 2 }.
+
+ (** A [StrictOrder] is both Irreflexive and Transitive. *)
+
+ Class StrictOrder (R : crelation A) := {
+ StrictOrder_Irreflexive :> Irreflexive R ;
+ StrictOrder_Transitive :> Transitive R }.
+
+ (** By definition, a strict order is also asymmetric *)
+ Global Instance StrictOrder_Asymmetric `(StrictOrder R) : Asymmetric R.
+ Proof. firstorder. Qed.
+
+ (** A partial equivalence crelation is Symmetric and Transitive. *)
+
+ Class PER (R : crelation A) := {
+ PER_Symmetric :> Symmetric R | 3 ;
+ PER_Transitive :> Transitive R | 3 }.
+
+ (** Equivalence crelations. *)
+
+ Class Equivalence (R : crelation A) := {
+ Equivalence_Reflexive :> Reflexive R ;
+ Equivalence_Symmetric :> Symmetric R ;
+ Equivalence_Transitive :> Transitive R }.
+
+ (** An Equivalence is a PER plus reflexivity. *)
+
+ Global Instance Equivalence_PER {R} `(Equivalence R) : PER R | 10 :=
+ { PER_Symmetric := Equivalence_Symmetric ;
+ PER_Transitive := Equivalence_Transitive }.
+
+ (** We can now define antisymmetry w.r.t. an equivalence crelation on the carrier. *)
+
+ Class Antisymmetric eqA `{equ : Equivalence eqA} (R : crelation A) :=
+ antisymmetry : forall {x y}, R x y -> R y x -> eqA x y.
+
+ Class subrelation (R R' : crelation A) :=
+ is_subrelation : forall {x y}, R x y -> R' x y.
+
+ (** Any symmetric crelation is equal to its inverse. *)
+
+ Lemma subrelation_symmetric R `(Symmetric R) : subrelation (flip R) R.
+ Proof. hnf. intros x y H'. red in H'. apply symmetry. assumption. Qed.
+
+ Section flip.
+
+ Lemma flip_Reflexive `{Reflexive R} : Reflexive (flip R).
+ Proof. tauto. Qed.
+
+ Program Definition flip_Irreflexive `(Irreflexive R) : Irreflexive (flip R) :=
+ irreflexivity (R:=R).
+
+ Program Definition flip_Symmetric `(Symmetric R) : Symmetric (flip R) :=
+ fun x y H => symmetry (R:=R) H.
+
+ Program Definition flip_Asymmetric `(Asymmetric R) : Asymmetric (flip R) :=
+ fun x y H H' => asymmetry (R:=R) H H'.
+
+ Program Definition flip_Transitive `(Transitive R) : Transitive (flip R) :=
+ fun x y z H H' => transitivity (R:=R) H' H.
+
+ Program Definition flip_Antisymmetric `(Antisymmetric eqA R) :
+ Antisymmetric eqA (flip R).
+ Proof. firstorder. Qed.
+
+ (** Inversing the larger structures *)
+
+ Lemma flip_PreOrder `(PreOrder R) : PreOrder (flip R).
+ Proof. firstorder. Qed.
+
+ Lemma flip_StrictOrder `(StrictOrder R) : StrictOrder (flip R).
+ Proof. firstorder. Qed.
+
+ Lemma flip_PER `(PER R) : PER (flip R).
+ Proof. firstorder. Qed.
+
+ Lemma flip_Equivalence `(Equivalence R) : Equivalence (flip R).
+ Proof. firstorder. Qed.
+
+ End flip.
+
+ Section complement.
+
+ Definition complement_Irreflexive `(Reflexive R)
+ : Irreflexive (complement R).
+ Proof. firstorder. Qed.
+
+ Definition complement_Symmetric `(Symmetric R) : Symmetric (complement R).
+ Proof. firstorder. Qed.
+ End complement.
+
+
+ (** Rewrite crelation on a given support: declares a crelation as a rewrite
+ crelation for use by the generalized rewriting tactic.
+ It helps choosing if a rewrite should be handled
+ by the generalized or the regular rewriting tactic using leibniz equality.
+ Users can declare an [RewriteRelation A RA] anywhere to declare default
+ crelations. This is also done automatically by the [Declare Relation A RA]
+ commands. *)
+
+ Class RewriteRelation (RA : crelation A).
+
+ (** Any [Equivalence] declared in the context is automatically considered
+ a rewrite crelation. *)
+
+ Global Instance equivalence_rewrite_crelation `(Equivalence eqA) : RewriteRelation eqA.
+
+ (** Leibniz equality. *)
+ Section Leibniz.
+ Global Instance eq_Reflexive : Reflexive (@eq A) := @eq_refl A.
+ Global Instance eq_Symmetric : Symmetric (@eq A) := @eq_sym A.
+ Global Instance eq_Transitive : Transitive (@eq A) := @eq_trans A.
+
+ (** Leibinz equality [eq] is an equivalence crelation.
+ The instance has low priority as it is always applicable
+ if only the type is constrained. *)
+
+ Global Program Instance eq_equivalence : Equivalence (@eq A) | 10.
+ End Leibniz.
+
+End Defs.
+
+(** Default rewrite crelations handled by [setoid_rewrite]. *)
+Instance: RewriteRelation impl.
+Instance: RewriteRelation iff.
+
+(** Hints to drive the typeclass resolution avoiding loops
+ due to the use of full unification. *)
+Hint Extern 1 (Reflexive (complement _)) => class_apply @irreflexivity : typeclass_instances.
+Hint Extern 3 (Symmetric (complement _)) => class_apply complement_Symmetric : typeclass_instances.
+Hint Extern 3 (Irreflexive (complement _)) => class_apply complement_Irreflexive : typeclass_instances.
+
+Hint Extern 3 (Reflexive (flip _)) => apply flip_Reflexive : typeclass_instances.
+Hint Extern 3 (Irreflexive (flip _)) => class_apply flip_Irreflexive : typeclass_instances.
+Hint Extern 3 (Symmetric (flip _)) => class_apply flip_Symmetric : typeclass_instances.
+Hint Extern 3 (Asymmetric (flip _)) => class_apply flip_Asymmetric : typeclass_instances.
+Hint Extern 3 (Antisymmetric (flip _)) => class_apply flip_Antisymmetric : typeclass_instances.
+Hint Extern 3 (Transitive (flip _)) => class_apply flip_Transitive : typeclass_instances.
+Hint Extern 3 (StrictOrder (flip _)) => class_apply flip_StrictOrder : typeclass_instances.
+Hint Extern 3 (PreOrder (flip _)) => class_apply flip_PreOrder : typeclass_instances.
+
+Hint Extern 4 (subrelation (flip _) _) =>
+ class_apply @subrelation_symmetric : typeclass_instances.
+
+Hint Resolve irreflexivity : ord.
+
+Unset Implicit Arguments.
+
+(** A HintDb for crelations. *)
+
+Ltac solve_crelation :=
+ match goal with
+ | [ |- ?R ?x ?x ] => reflexivity
+ | [ H : ?R ?x ?y |- ?R ?y ?x ] => symmetry ; exact H
+ end.
+
+Hint Extern 4 => solve_crelation : crelations.
+
+(** We can already dualize all these properties. *)
+
+(** * Standard instances. *)
+
+Ltac reduce_hyp H :=
+ match type of H with
+ | context [ _ <-> _ ] => fail 1
+ | _ => red in H ; try reduce_hyp H
+ end.
+
+Ltac reduce_goal :=
+ match goal with
+ | [ |- _ <-> _ ] => fail 1
+ | _ => red ; intros ; try reduce_goal
+ end.
+
+Tactic Notation "reduce" "in" hyp(Hid) := reduce_hyp Hid.
+
+Ltac reduce := reduce_goal.
+
+Tactic Notation "apply" "*" constr(t) :=
+ first [ refine t | refine (t _) | refine (t _ _) | refine (t _ _ _) | refine (t _ _ _ _) |
+ refine (t _ _ _ _ _) | refine (t _ _ _ _ _ _) | refine (t _ _ _ _ _ _ _) ].
+
+Ltac simpl_crelation :=
+ unfold flip, impl, arrow ; try reduce ; program_simpl ;
+ try ( solve [ dintuition ]).
+
+Local Obligation Tactic := simpl_crelation.
+
+(** Logical implication. *)
+
+Program Instance impl_Reflexive : Reflexive impl.
+Program Instance impl_Transitive : Transitive impl.
+
+(** Logical equivalence. *)
+
+Instance iff_Reflexive : Reflexive iff := iff_refl.
+Instance iff_Symmetric : Symmetric iff := iff_sym.
+Instance iff_Transitive : Transitive iff := iff_trans.
+
+(** Logical equivalence [iff] is an equivalence crelation. *)
+
+Program Instance iff_equivalence : Equivalence iff.
+Program Instance arrow_Reflexive : Reflexive arrow.
+Program Instance arrow_Transitive : Transitive arrow.
+
+Instance iffT_Reflexive : Reflexive iffT.
+Proof. firstorder. Defined.
+Instance iffT_Symmetric : Symmetric iffT.
+Proof. firstorder. Defined.
+Instance iffT_Transitive : Transitive iffT.
+Proof. firstorder. Defined.
+
+(** We now develop a generalization of results on crelations for arbitrary predicates.
+ The resulting theory can be applied to homogeneous binary crelations but also to
+ arbitrary n-ary predicates. *)
+
+Local Open Scope list_scope.
+
+(** A compact representation of non-dependent arities, with the codomain singled-out. *)
+
+(** We define the various operations which define the algebra on binary crelations *)
+Section Binary.
+ Context {A : Type}.
+
+ Definition relation_equivalence : crelation (crelation A) :=
+ fun R R' => forall x y, iffT (R x y) (R' x y).
+
+ Global Instance: RewriteRelation relation_equivalence.
+
+ Definition relation_conjunction (R : crelation A) (R' : crelation A) : crelation A :=
+ fun x y => prod (R x y) (R' x y).
+
+ Definition relation_disjunction (R : crelation A) (R' : crelation A) : crelation A :=
+ fun x y => sum (R x y) (R' x y).
+
+ (** Relation equivalence is an equivalence, and subrelation defines a partial order. *)
+
+ Set Automatic Introduction.
+
+ Global Instance relation_equivalence_equivalence :
+ Equivalence relation_equivalence.
+ Proof. split; red; unfold relation_equivalence, iffT. firstorder.
+ firstorder.
+ intros. specialize (X x0 y0). specialize (X0 x0 y0). firstorder.
+ Qed.
+
+ Global Instance relation_implication_preorder : PreOrder (@subrelation A).
+ Proof. firstorder. Qed.
+
+ (** *** Partial Order.
+ A partial order is a preorder which is additionally antisymmetric.
+ We give an equivalent definition, up-to an equivalence crelation
+ on the carrier. *)
+
+ Class PartialOrder eqA `{equ : Equivalence A eqA} R `{preo : PreOrder A R} :=
+ partial_order_equivalence : relation_equivalence eqA (relation_conjunction R (flip R)).
+
+ (** The equivalence proof is sufficient for proving that [R] must be a
+ morphism for equivalence (see Morphisms). It is also sufficient to
+ show that [R] is antisymmetric w.r.t. [eqA] *)
+
+ Global Instance partial_order_antisym `(PartialOrder eqA R) : ! Antisymmetric A eqA R.
+ Proof with auto.
+ reduce_goal.
+ apply H. firstorder.
+ Qed.
+
+ Lemma PartialOrder_inverse `(PartialOrder eqA R) : PartialOrder eqA (flip R).
+ Proof. unfold flip; constructor; unfold flip. intros. apply H. apply symmetry. apply X.
+ unfold relation_conjunction. intros [H1 H2]. apply H. constructor; assumption. Qed.
+End Binary.
+
+Hint Extern 3 (PartialOrder (flip _)) => class_apply PartialOrder_inverse : typeclass_instances.
+
+(** The partial order defined by subrelation and crelation equivalence. *)
+
+(* Program Instance subrelation_partial_order : *)
+(* ! PartialOrder (crelation A) relation_equivalence subrelation. *)
+(* Obligation Tactic := idtac. *)
+
+(* Next Obligation. *)
+(* Proof. *)
+(* intros x. refine (fun x => x). *)
+(* Qed. *)
+
+Typeclasses Opaque relation_equivalence.
+
+
diff --git a/theories/Classes/DecidableClass.v b/theories/Classes/DecidableClass.v
new file mode 100644
index 00000000..9fe3d0fe
--- /dev/null
+++ b/theories/Classes/DecidableClass.v
@@ -0,0 +1,92 @@
+(************************************************************************)
+(* v * The Coq Proof Assistant / The Coq Development Team *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* \VV/ **************************************************************)
+(* // * This file is distributed under the terms of the *)
+(* * GNU Lesser General Public License Version 2.1 *)
+(************************************************************************)
+
+(** * A typeclass to ease the handling of decidable properties. *)
+
+(** A proposition is decidable whenever it is reflected by a boolean. *)
+
+Class Decidable (P : Prop) := {
+ Decidable_witness : bool;
+ Decidable_spec : Decidable_witness = true <-> P
+}.
+
+(** Alternative ways of specifying the reflection property. *)
+
+Lemma Decidable_sound : forall P (H : Decidable P),
+ Decidable_witness = true -> P.
+Proof.
+intros P H Hp; apply -> Decidable_spec; assumption.
+Qed.
+
+Lemma Decidable_complete : forall P (H : Decidable P),
+ P -> Decidable_witness = true.
+Proof.
+intros P H Hp; apply <- Decidable_spec; assumption.
+Qed.
+
+Lemma Decidable_sound_alt : forall P (H : Decidable P),
+ ~ P -> Decidable_witness = false.
+Proof.
+intros P [wit spec] Hd; simpl; destruct wit; tauto.
+Qed.
+
+Lemma Decidable_complete_alt : forall P (H : Decidable P),
+ Decidable_witness = false -> ~ P.
+Proof.
+intros P [wit spec] Hd Hc; simpl in *; intuition congruence.
+Qed.
+
+(** The generic function that should be used to program, together with some
+ useful tactics. *)
+
+Definition decide P {H : Decidable P} := Decidable_witness (Decidable:=H).
+
+Ltac _decide_ P H :=
+ let b := fresh "b" in
+ set (b := decide P) in *;
+ assert (H : decide P = b) by reflexivity;
+ clearbody b;
+ destruct b; [apply Decidable_sound in H|apply Decidable_complete_alt in H].
+
+Tactic Notation "decide" constr(P) "as" ident(H) :=
+ _decide_ P H.
+
+Tactic Notation "decide" constr(P) :=
+ let H := fresh "H" in _decide_ P H.
+
+(** Some usual instances. *)
+
+Require Import Bool Arith ZArith.
+
+Program Instance Decidable_eq_bool : forall (x y : bool), Decidable (eq x y) := {
+ Decidable_witness := Bool.eqb x y
+}.
+Next Obligation.
+ apply eqb_true_iff.
+Qed.
+
+Program Instance Decidable_eq_nat : forall (x y : nat), Decidable (eq x y) := {
+ Decidable_witness := Nat.eqb x y
+}.
+Next Obligation.
+ apply Nat.eqb_eq.
+Qed.
+
+Program Instance Decidable_le_nat : forall (x y : nat), Decidable (x <= y) := {
+ Decidable_witness := Nat.leb x y
+}.
+Next Obligation.
+ apply Nat.leb_le.
+Qed.
+
+Program Instance Decidable_eq_Z : forall (x y : Z), Decidable (eq x y) := {
+ Decidable_witness := Z.eqb x y
+}.
+Next Obligation.
+ apply Z.eqb_eq.
+Qed.
diff --git a/theories/Classes/EquivDec.v b/theories/Classes/EquivDec.v
index 8e3715ff..59e800c2 100644
--- a/theories/Classes/EquivDec.v
+++ b/theories/Classes/EquivDec.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -53,7 +53,9 @@ Local Open Scope program_scope.
(** Invert the branches. *)
-Program Definition nequiv_dec `{EqDec A} (x y : A) : { x =/= y } + { x === y } := swap_sumbool (x == y).
+Program Definition nequiv_dec `{EqDec A} (x y : A) : { x =/= y } + { x === y } :=
+ swap_sumbool (x == y).
+
(** Overloaded notation for inequality. *)
@@ -138,8 +140,7 @@ Program Instance list_eqdec `(eqa : EqDec A eq) : ! EqDec (list A) eq :=
| _, _ => in_right
end }.
- Solve Obligations using unfold equiv, complement in * ; program_simpl ; intuition (discriminate || eauto).
-
- Next Obligation. destruct y ; intuition eauto. Defined.
+ Next Obligation. destruct y ; unfold not in *; eauto. Defined.
- Solve Obligations using unfold equiv, complement in * ; program_simpl ; intuition (discriminate || eauto).
+ Solve Obligations with unfold equiv, complement in * ;
+ program_simpl ; intuition (discriminate || eauto).
diff --git a/theories/Classes/Equivalence.v b/theories/Classes/Equivalence.v
index 0e9adf64..c281af80 100644
--- a/theories/Classes/Equivalence.v
+++ b/theories/Classes/Equivalence.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -24,7 +24,7 @@ Set Implicit Arguments.
Unset Strict Implicit.
Generalizable Variables A R eqA B S eqB.
-Local Obligation Tactic := simpl_relation.
+Local Obligation Tactic := try solve [simpl_relation].
Local Open Scope signature_scope.
@@ -56,8 +56,8 @@ Program Instance equiv_symmetric `(sa : Equivalence A) : Symmetric equiv.
Program Instance equiv_transitive `(sa : Equivalence A) : Transitive equiv.
Next Obligation.
- Proof.
- transitivity y ; auto.
+ Proof. intros A R sa x y z Hxy Hyz.
+ now transitivity y.
Qed.
(** Use the [substitute] command which substitutes an equivalence in every hypothesis. *)
@@ -105,27 +105,35 @@ Section Respecting.
(** Here we build an equivalence instance for functions which relates respectful ones only,
we do not export it. *)
- Definition respecting `(eqa : Equivalence A (R : relation A), eqb : Equivalence B (R' : relation B)) : Type :=
+ Definition respecting `(eqa : Equivalence A (R : relation A),
+ eqb : Equivalence B (R' : relation B)) : Type :=
{ morph : A -> B | respectful R R' morph morph }.
Program Instance respecting_equiv `(eqa : Equivalence A R, eqb : Equivalence B R') :
- Equivalence (fun (f g : respecting eqa eqb) => forall (x y : A), R x y -> R' (proj1_sig f x) (proj1_sig g y)).
+ Equivalence (fun (f g : respecting eqa eqb) =>
+ forall (x y : A), R x y -> R' (proj1_sig f x) (proj1_sig g y)).
- Solve Obligations using unfold respecting in * ; simpl_relation ; program_simpl.
+ Solve Obligations with unfold respecting in * ; simpl_relation ; program_simpl.
Next Obligation.
- Proof.
- unfold respecting in *. program_simpl. transitivity (y y0); auto. apply H0. reflexivity.
+ Proof.
+ intros. intros f g h H H' x y Rxy.
+ unfold respecting in *. program_simpl. transitivity (g y); auto. firstorder.
Qed.
End Respecting.
(** The default equivalence on function spaces, with higher-priority than [eq]. *)
-Program Instance pointwise_equivalence {A} `(eqb : Equivalence B eqB) :
+Instance pointwise_reflexive {A} `(reflb : Reflexive B eqB) :
+ Reflexive (pointwise_relation A eqB) | 9.
+Proof. firstorder. Qed.
+Instance pointwise_symmetric {A} `(symb : Symmetric B eqB) :
+ Symmetric (pointwise_relation A eqB) | 9.
+Proof. firstorder. Qed.
+Instance pointwise_transitive {A} `(transb : Transitive B eqB) :
+ Transitive (pointwise_relation A eqB) | 9.
+Proof. firstorder. Qed.
+Instance pointwise_equivalence {A} `(eqb : Equivalence B eqB) :
Equivalence (pointwise_relation A eqB) | 9.
-
- Next Obligation.
- Proof.
- transitivity (y a) ; auto.
- Qed.
+Proof. split; apply _. Qed.
diff --git a/theories/Classes/Init.v b/theories/Classes/Init.v
index 1a56c1a3..9574cf85 100644
--- a/theories/Classes/Init.v
+++ b/theories/Classes/Init.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Classes/Morphisms.v b/theories/Classes/Morphisms.v
index 9d5a3233..1bdce654 100644
--- a/theories/Classes/Morphisms.v
+++ b/theories/Classes/Morphisms.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-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -18,7 +18,7 @@ Require Import Coq.Program.Tactics.
Require Import Coq.Relations.Relation_Definitions.
Require Export Coq.Classes.RelationClasses.
-Generalizable All Variables.
+Generalizable Variables A eqA B C D R RA RB RC m f x y.
Local Obligation Tactic := simpl_relation.
(** * Morphisms.
@@ -29,15 +29,39 @@ Local Obligation Tactic := simpl_relation.
(** A morphism for a relation [R] is a proper element of the relation.
The relation [R] will be instantiated by [respectful] and [A] by an arrow
type for usual morphisms. *)
-
-Class Proper {A} (R : relation A) (m : A) : Prop :=
- proper_prf : R m m.
-
-(** Respectful morphisms. *)
-
-(** The fully dependent version, not used yet. *)
-
-Definition respectful_hetero
+Section Proper.
+ Let U := Type.
+ Context {A B : U}.
+
+ Class Proper (R : relation A) (m : A) : Prop :=
+ proper_prf : R m m.
+
+ (** Every element in the carrier of a reflexive relation is a morphism
+ for this relation. We use a proxy class for this case which is used
+ internally to discharge reflexivity constraints. The [Reflexive]
+ instance will almost always be used, but it won't apply in general to
+ any kind of [Proper (A -> B) _ _] goal, making proof-search much
+ slower. A cleaner solution would be to be able to set different
+ priorities in different hint bases and select a particular hint
+ database for resolution of a type class constraint. *)
+
+ Class ProperProxy (R : relation A) (m : A) : Prop :=
+ proper_proxy : R m m.
+
+ Lemma eq_proper_proxy (x : A) : ProperProxy (@eq A) x.
+ Proof. firstorder. Qed.
+
+ Lemma reflexive_proper_proxy `(Reflexive A R) (x : A) : ProperProxy R x.
+ Proof. firstorder. Qed.
+
+ Lemma proper_proper_proxy x `(Proper R x) : ProperProxy R x.
+ Proof. firstorder. Qed.
+
+ (** Respectful morphisms. *)
+
+ (** The fully dependent version, not used yet. *)
+
+ Definition respectful_hetero
(A B : Type)
(C : A -> Type) (D : B -> Type)
(R : A -> B -> Prop)
@@ -45,18 +69,24 @@ Definition respectful_hetero
(forall x : A, C x) -> (forall x : B, D x) -> Prop :=
fun f g => forall x y, R x y -> R' x y (f x) (g y).
-(** The non-dependent version is an instance where we forget dependencies. *)
+ (** The non-dependent version is an instance where we forget dependencies. *)
+
+ Definition respectful (R : relation A) (R' : relation B) : relation (A -> B) :=
+ Eval compute in @respectful_hetero A A (fun _ => B) (fun _ => B) R (fun _ _ => R').
-Definition respectful {A B : Type}
- (R : relation A) (R' : relation B) : relation (A -> B) :=
- Eval compute in @respectful_hetero A A (fun _ => B) (fun _ => B) R (fun _ _ => R').
+End Proper.
-(** Notations reminiscent of the old syntax for declaring morphisms. *)
+(** We favor the use of Leibniz equality or a declared reflexive relation
+ when resolving [ProperProxy], otherwise, if the relation is given (not an evar),
+ we fall back to [Proper]. *)
+Hint Extern 1 (ProperProxy _ _) =>
+ class_apply @eq_proper_proxy || class_apply @reflexive_proper_proxy : typeclass_instances.
-Delimit Scope signature_scope with signature.
+Hint Extern 2 (ProperProxy ?R _) =>
+ not_evar R; class_apply @proper_proper_proxy : typeclass_instances.
-Arguments Proper {A}%type R%signature m.
-Arguments respectful {A B}%type (R R')%signature _ _.
+(** Notations reminiscent of the old syntax for declaring morphisms. *)
+Delimit Scope signature_scope with signature.
Module ProperNotations.
@@ -66,11 +96,14 @@ Module ProperNotations.
Notation " R ==> R' " := (@respectful _ _ (R%signature) (R'%signature))
(right associativity, at level 55) : signature_scope.
- Notation " R --> R' " := (@respectful _ _ (inverse (R%signature)) (R'%signature))
+ Notation " R --> R' " := (@respectful _ _ (flip (R%signature)) (R'%signature))
(right associativity, at level 55) : signature_scope.
End ProperNotations.
+Arguments Proper {A}%type R%signature m.
+Arguments respectful {A B}%type (R R')%signature _ _.
+
Export ProperNotations.
Local Open Scope signature_scope.
@@ -106,80 +139,89 @@ Ltac f_equiv :=
assert (H : (Rx==>R)%signature f f');
unfold Rx in *; clear Rx; [ f_equiv | apply H; clear H; try reflexivity ]
| |- ?R ?f ?f' =>
- try reflexivity;
- change (Proper R f); eauto with typeclass_instances; fail
+ solve [change (Proper R f); eauto with typeclass_instances | reflexivity ]
| _ => idtac
end.
-(** [forall_def] reifies the dependent product as a definition. *)
-
-Definition forall_def {A : Type} (B : A -> Type) : Type := forall x : A, B x.
-
-(** Dependent pointwise lifting of a relation on the range. *)
-
-Definition forall_relation {A : Type} {B : A -> Type}
- (sig : forall a, relation (B a)) : relation (forall x, B x) :=
- fun f g => forall a, sig a (f a) (g a).
-
-Arguments forall_relation {A B}%type sig%signature _ _.
-
-(** Non-dependent pointwise lifting *)
+Section Relations.
+ Let U := Type.
+ Context {A B : U} (P : A -> U).
+
+ (** [forall_def] reifies the dependent product as a definition. *)
+
+ Definition forall_def : Type := forall x : A, P x.
+
+ (** Dependent pointwise lifting of a relation on the range. *)
+
+ Definition forall_relation
+ (sig : forall a, relation (P a)) : relation (forall x, P x) :=
+ fun f g => forall a, sig a (f a) (g a).
+
+ (** Non-dependent pointwise lifting *)
+ Definition pointwise_relation (R : relation B) : relation (A -> B) :=
+ fun f g => forall a, R (f a) (g a).
+
+ Lemma pointwise_pointwise (R : relation B) :
+ relation_equivalence (pointwise_relation R) (@eq A ==> R).
+ Proof. intros. split; reduce; subst; firstorder. Qed.
+
+ (** Subrelations induce a morphism on the identity. *)
+
+ Global Instance subrelation_id_proper `(subrelation A RA RA') : Proper (RA ==> RA') id.
+ Proof. firstorder. Qed.
+
+ (** The subrelation property goes through products as usual. *)
+
+ Lemma subrelation_respectful `(subl : subrelation A RA' RA, subr : subrelation B RB RB') :
+ subrelation (RA ==> RB) (RA' ==> RB').
+ Proof. unfold subrelation in *; firstorder. Qed.
+
+ (** And of course it is reflexive. *)
+
+ Lemma subrelation_refl R : @subrelation A R R.
+ Proof. unfold subrelation; firstorder. Qed.
+
+ (** [Proper] is itself a covariant morphism for [subrelation].
+ We use an unconvertible premise to avoid looping.
+ *)
+
+ Lemma subrelation_proper `(mor : Proper A R' m)
+ `(unc : Unconvertible (relation A) R R')
+ `(sub : subrelation A R' R) : Proper R m.
+ Proof.
+ intros. apply sub. apply mor.
+ Qed.
-Definition pointwise_relation (A : Type) {B : Type} (R : relation B) : relation (A -> B) :=
- Eval compute in forall_relation (B:=fun _ => B) (fun _ => R).
+ Global Instance proper_subrelation_proper :
+ Proper (subrelation ++> eq ==> impl) (@Proper A).
+ Proof. reduce. subst. firstorder. Qed.
-Lemma pointwise_pointwise A B (R : relation B) :
- relation_equivalence (pointwise_relation A R) (@eq A ==> R).
-Proof. intros. split. simpl_relation. firstorder. Qed.
-
-(** We can build a PER on the Coq function space if we have PERs on the domain and
- codomain. *)
+ Global Instance pointwise_subrelation `(sub : subrelation B R R') :
+ subrelation (pointwise_relation R) (pointwise_relation R') | 4.
+ Proof. reduce. unfold pointwise_relation in *. apply sub. apply H. Qed.
+
+ (** For dependent function types. *)
+ Lemma forall_subrelation (R S : forall x : A, relation (P x)) :
+ (forall a, subrelation (R a) (S a)) -> subrelation (forall_relation R) (forall_relation S).
+ Proof. reduce. apply H. apply H0. Qed.
+End Relations.
+Typeclasses Opaque respectful pointwise_relation forall_relation.
+Arguments forall_relation {A P}%type sig%signature _ _.
+Arguments pointwise_relation A%type {B}%type R%signature _ _.
+
Hint Unfold Reflexive : core.
Hint Unfold Symmetric : core.
Hint Unfold Transitive : core.
-Typeclasses Opaque respectful pointwise_relation forall_relation.
-
-Program Instance respectful_per `(PER A R, PER B R') : PER (R ==> R').
-
- Next Obligation.
- Proof with auto.
- assert(R x0 x0).
- transitivity y0... symmetry...
- transitivity (y x0)...
- Qed.
-
-(** Subrelations induce a morphism on the identity. *)
-
-Instance subrelation_id_proper `(subrelation A R₁ R₂) : Proper (R₁ ==> R₂) id.
-Proof. firstorder. Qed.
-
-(** The subrelation property goes through products as usual. *)
-
-Lemma subrelation_respectful `(subl : subrelation A R₂ R₁, subr : subrelation B S₁ S₂) :
- subrelation (R₁ ==> S₁) (R₂ ==> S₂).
-Proof. simpl_relation. apply subr. apply H. apply subl. apply H0. Qed.
-
-(** And of course it is reflexive. *)
-
-Lemma subrelation_refl A R : @subrelation A R R.
-Proof. simpl_relation. Qed.
-
+(** Resolution with subrelation: favor decomposing products over applying reflexivity
+ for unconstrained goals. *)
Ltac subrelation_tac T U :=
(is_ground T ; is_ground U ; class_apply @subrelation_refl) ||
class_apply @subrelation_respectful || class_apply @subrelation_refl.
Hint Extern 3 (@subrelation _ ?T ?U) => subrelation_tac T U : typeclass_instances.
-(** [Proper] is itself a covariant morphism for [subrelation]. *)
-
-Lemma subrelation_proper `(mor : Proper A R₁ m, unc : Unconvertible (relation A) R₁ R₂,
- sub : subrelation A R₁ R₂) : Proper R₂ m.
-Proof.
- intros. apply sub. apply mor.
-Qed.
-
CoInductive apply_subrelation : Prop := do_subrelation.
Ltac proper_subrelation :=
@@ -189,117 +231,112 @@ Ltac proper_subrelation :=
Hint Extern 5 (@Proper _ ?H _) => proper_subrelation : typeclass_instances.
-Instance proper_subrelation_proper :
- Proper (subrelation ++> eq ==> impl) (@Proper A).
-Proof. reduce. subst. firstorder. Qed.
-
(** Essential subrelation instances for [iff], [impl] and [pointwise_relation]. *)
Instance iff_impl_subrelation : subrelation iff impl | 2.
Proof. firstorder. Qed.
-Instance iff_inverse_impl_subrelation : subrelation iff (inverse impl) | 2.
+Instance iff_flip_impl_subrelation : subrelation iff (flip impl) | 2.
Proof. firstorder. Qed.
-Instance pointwise_subrelation {A} `(sub : subrelation B R R') :
- subrelation (pointwise_relation A R) (pointwise_relation A R') | 4.
-Proof. reduce. unfold pointwise_relation in *. apply sub. apply H. Qed.
-
-(** For dependent function types. *)
-Lemma forall_subrelation A (B : A -> Type) (R S : forall x : A, relation (B x)) :
- (forall a, subrelation (R a) (S a)) -> subrelation (forall_relation R) (forall_relation S).
-Proof. reduce. apply H. apply H0. Qed.
-
(** We use an extern hint to help unification. *)
Hint Extern 4 (subrelation (@forall_relation ?A ?B ?R) (@forall_relation _ _ ?S)) =>
apply (@forall_subrelation A B R S) ; intro : typeclass_instances.
-(** Any symmetric relation is equal to its inverse. *)
-
-Lemma subrelation_symmetric A R `(Symmetric A R) : subrelation (inverse R) R.
-Proof. reduce. red in H0. symmetry. assumption. Qed.
+Section GenericInstances.
+ (* Share universes *)
+ Let U := Type.
+ Context {A B C : U}.
-Hint Extern 4 (subrelation (inverse _) _) =>
- class_apply @subrelation_symmetric : typeclass_instances.
-
-(** The complement of a relation conserves its proper elements. *)
+ (** We can build a PER on the Coq function space if we have PERs on the domain and
+ codomain. *)
+
+ Program Instance respectful_per `(PER A R, PER B R') : PER (R ==> R').
-Program Definition complement_proper
- `(mR : Proper (A -> A -> Prop) (RA ==> RA ==> iff) R) :
- Proper (RA ==> RA ==> iff) (complement R) := _.
+ Next Obligation.
+ Proof with auto.
+ assert(R x0 x0).
+ transitivity y0... symmetry...
+ transitivity (y x0)...
+ Qed.
- Next Obligation.
+ (** The complement of a relation conserves its proper elements. *)
+
+ Program Definition complement_proper
+ `(mR : Proper (A -> A -> Prop) (RA ==> RA ==> iff) R) :
+ Proper (RA ==> RA ==> iff) (complement R) := _.
+
+ Next Obligation.
Proof.
unfold complement.
pose (mR x y H x0 y0 H0).
intuition.
Qed.
-Hint Extern 1 (Proper _ (complement _)) =>
- apply @complement_proper : typeclass_instances.
-
-(** The [inverse] too, actually the [flip] instance is a bit more general. *)
-
-Program Definition flip_proper
- `(mor : Proper (A -> B -> C) (RA ==> RB ==> RC) f) :
- Proper (RB ==> RA ==> RC) (flip f) := _.
+ (** The [flip] too, actually the [flip] instance is a bit more general. *)
+ Program Definition flip_proper
+ `(mor : Proper (A -> B -> C) (RA ==> RB ==> RC) f) :
+ Proper (RB ==> RA ==> RC) (flip f) := _.
+
Next Obligation.
Proof.
apply mor ; auto.
Qed.
-Hint Extern 1 (Proper _ (flip _)) =>
- apply @flip_proper : typeclass_instances.
-(** Every Transitive relation gives rise to a binary morphism on [impl],
+ (** Every Transitive relation gives rise to a binary morphism on [impl],
contravariant in the first argument, covariant in the second. *)
-
-Program Instance trans_contra_co_morphism
- `(Transitive A R) : Proper (R --> R ++> impl) R.
-
+
+ Global Program
+ Instance trans_contra_co_morphism
+ `(Transitive A R) : Proper (R --> R ++> impl) R.
+
Next Obligation.
Proof with auto.
transitivity x...
transitivity x0...
Qed.
-(** Proper declarations for partial applications. *)
+ (** Proper declarations for partial applications. *)
-Program Instance trans_contra_inv_impl_morphism
- `(Transitive A R) : Proper (R --> inverse impl) (R x) | 3.
+ Global Program
+ Instance trans_contra_inv_impl_morphism
+ `(Transitive A R) : Proper (R --> flip impl) (R x) | 3.
Next Obligation.
Proof with auto.
transitivity y...
Qed.
-Program Instance trans_co_impl_morphism
- `(Transitive A R) : Proper (R ++> impl) (R x) | 3.
+ Global Program
+ Instance trans_co_impl_morphism
+ `(Transitive A R) : Proper (R ++> impl) (R x) | 3.
Next Obligation.
Proof with auto.
transitivity x0...
Qed.
-Program Instance trans_sym_co_inv_impl_morphism
- `(PER A R) : Proper (R ++> inverse impl) (R x) | 3.
+ Global Program
+ Instance trans_sym_co_inv_impl_morphism
+ `(PER A R) : Proper (R ++> flip impl) (R x) | 3.
Next Obligation.
Proof with auto.
transitivity y... symmetry...
Qed.
-Program Instance trans_sym_contra_impl_morphism
- `(PER A R) : Proper (R --> impl) (R x) | 3.
+ Global Program Instance trans_sym_contra_impl_morphism
+ `(PER A R) : Proper (R --> impl) (R x) | 3.
Next Obligation.
Proof with auto.
transitivity x0... symmetry...
Qed.
-Program Instance per_partial_app_morphism
+ Global Program Instance per_partial_app_morphism
`(PER A R) : Proper (R ==> iff) (R x) | 2.
Next Obligation.
@@ -310,20 +347,21 @@ Program Instance per_partial_app_morphism
symmetry...
Qed.
-(** Every Transitive relation induces a morphism by "pushing" an [R x y] on the left of an [R x z] proof
- to get an [R y z] goal. *)
+ (** Every Transitive relation induces a morphism by "pushing" an [R x y] on the left of an [R x z] proof to get an [R y z] goal. *)
-Program Instance trans_co_eq_inv_impl_morphism
- `(Transitive A R) : Proper (R ==> (@eq A) ==> inverse impl) R | 2.
+ Global Program
+ Instance trans_co_eq_inv_impl_morphism
+ `(Transitive A R) : Proper (R ==> (@eq A) ==> flip impl) R | 2.
Next Obligation.
Proof with auto.
transitivity y...
Qed.
-(** Every Symmetric and Transitive relation gives rise to an equivariant morphism. *)
+ (** Every Symmetric and Transitive relation gives rise to an equivariant morphism. *)
-Program Instance PER_morphism `(PER A R) : Proper (R ==> R ==> iff) R | 1.
+ Global Program
+ Instance PER_morphism `(PER A R) : Proper (R ==> R ==> iff) R | 1.
Next Obligation.
Proof with auto.
@@ -333,11 +371,11 @@ Program Instance PER_morphism `(PER A R) : Proper (R ==> R ==> iff) R | 1.
transitivity y... transitivity y0... symmetry...
Qed.
-Lemma symmetric_equiv_inverse `(Symmetric A R) : relation_equivalence R (flip R).
-Proof. firstorder. Qed.
+ Lemma symmetric_equiv_flip `(Symmetric A R) : relation_equivalence R (flip R).
+ Proof. firstorder. Qed.
-Program Instance compose_proper A B C R₀ R₁ R₂ :
- Proper ((R₁ ==> R₂) ==> (R₀ ==> R₁) ==> (R₀ ==> R₂)) (@compose A B C).
+ Global Program Instance compose_proper RA RB RC :
+ Proper ((RB ==> RC) ==> (RA ==> RB) ==> (RA ==> RC)) (@compose A B C).
Next Obligation.
Proof.
@@ -345,68 +383,84 @@ Program Instance compose_proper A B C R₀ R₁ R₂ :
unfold compose. apply H. apply H0. apply H1.
Qed.
-(** Coq functions are morphisms for Leibniz equality,
- applied only if really needed. *)
-
-Instance reflexive_eq_dom_reflexive (A : Type) `(Reflexive B R') :
- Reflexive (@Logic.eq A ==> R').
-Proof. simpl_relation. Qed.
+ (** Coq functions are morphisms for Leibniz equality,
+ applied only if really needed. *)
-(** [respectful] is a morphism for relation equivalence. *)
-
-Instance respectful_morphism :
- Proper (relation_equivalence ++> relation_equivalence ++> relation_equivalence) (@respectful A B).
-Proof.
- reduce.
- unfold respectful, relation_equivalence, predicate_equivalence in * ; simpl in *.
- split ; intros.
+ Global Instance reflexive_eq_dom_reflexive `(Reflexive B R') :
+ Reflexive (@Logic.eq A ==> R').
+ Proof. simpl_relation. Qed.
+ (** [respectful] is a morphism for relation equivalence. *)
+
+ Global Instance respectful_morphism :
+ Proper (relation_equivalence ++> relation_equivalence ++> relation_equivalence)
+ (@respectful A B).
+ Proof.
+ reduce.
+ unfold respectful, relation_equivalence, predicate_equivalence in * ; simpl in *.
+ split ; intros.
+
rewrite <- H0.
apply H1.
rewrite H.
assumption.
-
+
rewrite H0.
apply H1.
rewrite <- H.
assumption.
-Qed.
-
-(** Every element in the carrier of a reflexive relation is a morphism for this relation.
- We use a proxy class for this case which is used internally to discharge reflexivity constraints.
- The [Reflexive] instance will almost always be used, but it won't apply in general to any kind of
- [Proper (A -> B) _ _] goal, making proof-search much slower. A cleaner solution would be to be able
- to set different priorities in different hint bases and select a particular hint database for
- resolution of a type class constraint.*)
-
-Class ProperProxy {A} (R : relation A) (m : A) : Prop :=
- proper_proxy : R m m.
-
-Lemma eq_proper_proxy A (x : A) : ProperProxy (@eq A) x.
-Proof. firstorder. Qed.
-
-Lemma reflexive_proper_proxy `(Reflexive A R) (x : A) : ProperProxy R x.
-Proof. firstorder. Qed.
-
-Lemma proper_proper_proxy `(Proper A R x) : ProperProxy R x.
-Proof. firstorder. Qed.
-
-Hint Extern 1 (ProperProxy _ _) =>
- class_apply @eq_proper_proxy || class_apply @reflexive_proper_proxy : typeclass_instances.
-Hint Extern 2 (ProperProxy ?R _) => not_evar R; class_apply @proper_proper_proxy : typeclass_instances.
+ Qed.
-(** [R] is Reflexive, hence we can build the needed proof. *)
+ (** [R] is Reflexive, hence we can build the needed proof. *)
-Lemma Reflexive_partial_app_morphism `(Proper (A -> B) (R ==> R') m, ProperProxy A R x) :
- Proper R' (m x).
-Proof. simpl_relation. Qed.
+ Lemma Reflexive_partial_app_morphism `(Proper (A -> B) (R ==> R') m, ProperProxy A R x) :
+ Proper R' (m x).
+ Proof. simpl_relation. Qed.
+
+ Lemma flip_respectful (R : relation A) (R' : relation B) :
+ relation_equivalence (flip (R ==> R')) (flip R ==> flip R').
+ Proof.
+ intros.
+ unfold flip, respectful.
+ split ; intros ; intuition.
+ Qed.
-Class Params {A : Type} (of : A) (arity : nat).
+
+ (** Treating flip: can't make them direct instances as we
+ need at least a [flip] present in the goal. *)
+
+ Lemma flip1 `(subrelation A R' R) : subrelation (flip (flip R')) R.
+ Proof. firstorder. Qed.
+
+ Lemma flip2 `(subrelation A R R') : subrelation R (flip (flip R')).
+ Proof. firstorder. Qed.
+
+ (** That's if and only if *)
+
+ Lemma eq_subrelation `(Reflexive A R) : subrelation (@eq A) R.
+ Proof. simpl_relation. Qed.
+
+ (** Once we have normalized, we will apply this instance to simplify the problem. *)
+
+ Definition proper_flip_proper `(mor : Proper A R m) : Proper (flip R) m := mor.
+
+ (** Every reflexive relation gives rise to a morphism,
+ only for immediately solving goals without variables. *)
+
+ Lemma reflexive_proper `{Reflexive A R} (x : A) : Proper R x.
+ Proof. firstorder. Qed.
+
+ Lemma proper_eq (x : A) : Proper (@eq A) x.
+ Proof. intros. apply reflexive_proper. Qed.
+
+End GenericInstances.
Class PartialApplication.
CoInductive normalization_done : Prop := did_normalization.
+Class Params {A : Type} (of : A) (arity : nat).
+
Ltac partial_application_tactic :=
let rec do_partial_apps H m cont :=
match m with
@@ -450,68 +504,6 @@ Ltac partial_application_tactic :=
end
end.
-Hint Extern 4 (@Proper _ _ _) => partial_application_tactic : typeclass_instances.
-
-Lemma inverse_respectful : forall (A : Type) (R : relation A) (B : Type) (R' : relation B),
- relation_equivalence (inverse (R ==> R')) (inverse R ==> inverse R').
-Proof.
- intros.
- unfold flip, respectful.
- split ; intros ; intuition.
-Qed.
-
-(** Special-purpose class to do normalization of signatures w.r.t. inverse. *)
-
-Class Normalizes (A : Type) (m : relation A) (m' : relation A) : Prop :=
- normalizes : relation_equivalence m m'.
-
-(** Current strategy: add [inverse] everywhere and reduce using [subrelation]
- afterwards. *)
-
-Lemma inverse_atom A R : Normalizes A R (inverse (inverse R)).
-Proof.
- firstorder.
-Qed.
-
-Lemma inverse_arrow `(NA : Normalizes A R (inverse R'''), NB : Normalizes B R' (inverse R'')) :
- Normalizes (A -> B) (R ==> R') (inverse (R''' ==> R'')%signature).
-Proof. unfold Normalizes in *. intros.
- rewrite NA, NB. firstorder.
-Qed.
-
-Ltac inverse :=
- match goal with
- | [ |- Normalizes _ (respectful _ _) _ ] => class_apply @inverse_arrow
- | _ => class_apply @inverse_atom
- end.
-
-Hint Extern 1 (Normalizes _ _ _) => inverse : typeclass_instances.
-
-(** Treating inverse: can't make them direct instances as we
- need at least a [flip] present in the goal. *)
-
-Lemma inverse1 `(subrelation A R' R) : subrelation (inverse (inverse R')) R.
-Proof. firstorder. Qed.
-
-Lemma inverse2 `(subrelation A R R') : subrelation R (inverse (inverse R')).
-Proof. firstorder. Qed.
-
-Hint Extern 1 (subrelation (flip _) _) => class_apply @inverse1 : typeclass_instances.
-Hint Extern 1 (subrelation _ (flip _)) => class_apply @inverse2 : typeclass_instances.
-
-(** That's if and only if *)
-
-Lemma eq_subrelation `(Reflexive A R) : subrelation (@eq A) R.
-Proof. simpl_relation. Qed.
-
-(* Hint Extern 3 (subrelation eq ?R) => not_evar R ; class_apply eq_subrelation : typeclass_instances. *)
-
-(** Once we have normalized, we will apply this instance to simplify the problem. *)
-
-Definition proper_inverse_proper `(mor : Proper A R m) : Proper (inverse R) m := mor.
-
-Hint Extern 2 (@Proper _ (flip _) _) => class_apply @proper_inverse_proper : typeclass_instances.
-
(** Bootstrap !!! *)
Instance proper_proper : Proper (relation_equivalence ==> eq ==> iff) (@Proper A).
@@ -525,46 +517,88 @@ Proof.
apply H0.
Qed.
-Lemma proper_normalizes_proper `(Normalizes A R0 R1, Proper A R1 m) : Proper R0 m.
-Proof.
- red in H, H0.
- setoid_rewrite H.
- assumption.
-Qed.
-
-Ltac proper_normalization :=
+Ltac proper_reflexive :=
match goal with
| [ _ : normalization_done |- _ ] => fail 1
- | [ _ : apply_subrelation |- @Proper _ ?R _ ] => let H := fresh "H" in
- set(H:=did_normalization) ; class_apply @proper_normalizes_proper
+ | _ => class_apply proper_eq || class_apply @reflexive_proper
end.
-Hint Extern 6 (@Proper _ _ _) => proper_normalization : typeclass_instances.
-(** Every reflexive relation gives rise to a morphism, only for immediately solving goals without variables. *)
+Hint Extern 1 (subrelation (flip _) _) => class_apply @flip1 : typeclass_instances.
+Hint Extern 1 (subrelation _ (flip _)) => class_apply @flip2 : typeclass_instances.
-Lemma reflexive_proper `{Reflexive A R} (x : A)
- : Proper R x.
-Proof. firstorder. Qed.
+Hint Extern 1 (Proper _ (complement _)) => apply @complement_proper
+ : typeclass_instances.
+Hint Extern 1 (Proper _ (flip _)) => apply @flip_proper
+ : typeclass_instances.
+Hint Extern 2 (@Proper _ (flip _) _) => class_apply @proper_flip_proper
+ : typeclass_instances.
+Hint Extern 4 (@Proper _ _ _) => partial_application_tactic
+ : typeclass_instances.
+Hint Extern 7 (@Proper _ _ _) => proper_reflexive
+ : typeclass_instances.
-Lemma proper_eq A (x : A) : Proper (@eq A) x.
-Proof. intros. apply reflexive_proper. Qed.
+(** Special-purpose class to do normalization of signatures w.r.t. flip. *)
-Ltac proper_reflexive :=
+Section Normalize.
+ Context (A : Type).
+
+ Class Normalizes (m : relation A) (m' : relation A) : Prop :=
+ normalizes : relation_equivalence m m'.
+
+ (** Current strategy: add [flip] everywhere and reduce using [subrelation]
+ afterwards. *)
+
+ Lemma proper_normalizes_proper `(Normalizes R0 R1, Proper A R1 m) : Proper R0 m.
+ Proof.
+ red in H, H0.
+ rewrite H.
+ assumption.
+ Qed.
+
+ Lemma flip_atom R : Normalizes R (flip (flip R)).
+ Proof.
+ firstorder.
+ Qed.
+
+End Normalize.
+
+Lemma flip_arrow {A : Type} {B : Type}
+ `(NA : Normalizes A R (flip R'''), NB : Normalizes B R' (flip R'')) :
+ Normalizes (A -> B) (R ==> R') (flip (R''' ==> R'')%signature).
+Proof.
+ unfold Normalizes in *. intros.
+ unfold relation_equivalence in *.
+ unfold predicate_equivalence in *. simpl in *.
+ unfold respectful. unfold flip in *. firstorder.
+ apply NB. apply H. apply NA. apply H0.
+ apply NB. apply H. apply NA. apply H0.
+Qed.
+
+Ltac normalizes :=
match goal with
- | [ _ : normalization_done |- _ ] => fail 1
- | _ => class_apply proper_eq || class_apply @reflexive_proper
+ | [ |- Normalizes _ (respectful _ _) _ ] => class_apply @flip_arrow
+ | _ => class_apply @flip_atom
end.
-Hint Extern 7 (@Proper _ _ _) => proper_reflexive : typeclass_instances.
+Ltac proper_normalization :=
+ match goal with
+ | [ _ : normalization_done |- _ ] => fail 1
+ | [ _ : apply_subrelation |- @Proper _ ?R _ ] =>
+ let H := fresh "H" in
+ set(H:=did_normalization) ; class_apply @proper_normalizes_proper
+ end.
+Hint Extern 1 (Normalizes _ _ _) => normalizes : typeclass_instances.
+Hint Extern 6 (@Proper _ _ _) => proper_normalization
+ : typeclass_instances.
(** When the relation on the domain is symmetric, we can
- inverse the relation on the codomain. Same for binary functions. *)
+ flip the relation on the codomain. Same for binary functions. *)
Lemma proper_sym_flip :
forall `(Symmetric A R1)`(Proper (A->B) (R1==>R2) f),
- Proper (R1==>inverse R2) f.
+ Proper (R1==>flip R2) f.
Proof.
intros A R1 Sym B R2 f Hf.
intros x x' Hxx'. apply Hf, Sym, Hxx'.
@@ -572,7 +606,7 @@ Qed.
Lemma proper_sym_flip_2 :
forall `(Symmetric A R1)`(Symmetric B R2)`(Proper (A->B->C) (R1==>R2==>R3) f),
- Proper (R1==>R2==>inverse R3) f.
+ Proper (R1==>R2==>flip R3) f.
Proof.
intros A R1 Sym1 B R2 Sym2 C R3 f Hf.
intros x x' Hxx' y y' Hyy'. apply Hf; auto.
@@ -627,8 +661,6 @@ apply partial_order_antisym; auto.
rewrite Hxz; auto.
Qed.
-Hint Extern 4 (StrictOrder (relation_conjunction _ _)) =>
- class_apply PartialOrder_StrictOrder : typeclass_instances.
(** From a [StrictOrder] to the corresponding [PartialOrder]:
[le = lt \/ eq].
@@ -659,5 +691,8 @@ elim (StrictOrder_Irreflexive x).
transitivity y; auto.
Qed.
+Hint Extern 4 (StrictOrder (relation_conjunction _ _)) =>
+ class_apply PartialOrder_StrictOrder : typeclass_instances.
+
Hint Extern 4 (PartialOrder _ (relation_disjunction _ _)) =>
class_apply StrictOrder_PartialOrder : typeclass_instances.
diff --git a/theories/Classes/Morphisms_Prop.v b/theories/Classes/Morphisms_Prop.v
index c3737658..096c96e5 100644
--- a/theories/Classes/Morphisms_Prop.v
+++ b/theories/Classes/Morphisms_Prop.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -16,7 +16,7 @@ Require Import Coq.Classes.Morphisms.
Require Import Coq.Program.Basics.
Require Import Coq.Program.Tactics.
-Local Obligation Tactic := simpl_relation.
+Local Obligation Tactic := try solve [simpl_relation | firstorder auto].
(** Standard instances for [not], [iff] and [impl]. *)
@@ -52,61 +52,20 @@ Program Instance iff_iff_iff_impl_morphism : Proper (iff ==> iff ==> iff) impl.
Program Instance ex_iff_morphism {A : Type} : Proper (pointwise_relation A iff ==> iff) (@ex A).
- Next Obligation.
- Proof.
- unfold pointwise_relation in H.
- split ; intros.
- destruct H0 as [x1 H1].
- exists x1. rewrite H in H1. assumption.
-
- destruct H0 as [x1 H1].
- exists x1. rewrite H. assumption.
- Qed.
-
Program Instance ex_impl_morphism {A : Type} :
Proper (pointwise_relation A impl ==> impl) (@ex A) | 1.
- Next Obligation.
- Proof.
- unfold pointwise_relation in H.
- exists H0. apply H. assumption.
- Qed.
-
-Program Instance ex_inverse_impl_morphism {A : Type} :
- Proper (pointwise_relation A (inverse impl) ==> inverse impl) (@ex A) | 1.
-
- Next Obligation.
- Proof.
- unfold pointwise_relation in H.
- exists H0. apply H. assumption.
- Qed.
+Program Instance ex_flip_impl_morphism {A : Type} :
+ Proper (pointwise_relation A (flip impl) ==> flip impl) (@ex A) | 1.
Program Instance all_iff_morphism {A : Type} :
Proper (pointwise_relation A iff ==> iff) (@all A).
- Next Obligation.
- Proof.
- unfold pointwise_relation, all in *.
- intuition ; specialize (H x0) ; intuition.
- Qed.
-
Program Instance all_impl_morphism {A : Type} :
Proper (pointwise_relation A impl ==> impl) (@all A) | 1.
- Next Obligation.
- Proof.
- unfold pointwise_relation, all in *.
- intuition ; specialize (H x0) ; intuition.
- Qed.
-
-Program Instance all_inverse_impl_morphism {A : Type} :
- Proper (pointwise_relation A (inverse impl) ==> inverse impl) (@all A) | 1.
-
- Next Obligation.
- Proof.
- unfold pointwise_relation, all in *.
- intuition ; specialize (H x0) ; intuition.
- Qed.
+Program Instance all_flip_impl_morphism {A : Type} :
+ Proper (pointwise_relation A (flip impl) ==> flip impl) (@all A) | 1.
(** Equivalent points are simultaneously accessible or not *)
@@ -116,13 +75,13 @@ Instance Acc_pt_morphism {A:Type}(E R : A->A->Prop)
Proof.
apply proper_sym_impl_iff; auto with *.
intros x y EQ WF. apply Acc_intro; intros z Hz.
- rewrite <- EQ in Hz. now apply Acc_inv with x.
+rewrite <- EQ in Hz. now apply Acc_inv with x.
Qed.
(** Equivalent relations have the same accessible points *)
Instance Acc_rel_morphism {A:Type} :
- Proper (@relation_equivalence A ==> Logic.eq ==> iff) (@Acc A).
+ Proper (relation_equivalence ==> Logic.eq ==> iff) (@Acc A).
Proof.
apply proper_sym_impl_iff_2. red; now symmetry. red; now symmetry.
intros R R' EQ a a' Ha WF. subst a'.
@@ -133,7 +92,7 @@ Qed.
(** Equivalent relations are simultaneously well-founded or not *)
Instance well_founded_morphism {A : Type} :
- Proper (@relation_equivalence A ==> iff) (@well_founded A).
+ Proper (relation_equivalence ==> iff) (@well_founded A).
Proof.
unfold well_founded. solve_proper.
Qed.
diff --git a/theories/Classes/Morphisms_Relations.v b/theories/Classes/Morphisms_Relations.v
index 34115e57..68a8c06a 100644
--- a/theories/Classes/Morphisms_Relations.v
+++ b/theories/Classes/Morphisms_Relations.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -30,8 +30,6 @@ Instance relation_disjunction_morphism : Proper (relation_equivalence (A:=A) ==>
(* Predicate equivalence is exactly the same as the pointwise lifting of [iff]. *)
-Require Import List.
-
Lemma predicate_equivalence_pointwise (l : Tlist) :
Proper (@predicate_equivalence l ==> pointwise_lifting iff l) id.
Proof. do 2 red. unfold predicate_equivalence. auto. Qed.
@@ -40,7 +38,7 @@ Lemma predicate_implication_pointwise (l : Tlist) :
Proper (@predicate_implication l ==> pointwise_lifting impl l) id.
Proof. do 2 red. unfold predicate_implication. auto. Qed.
-(** The instanciation at relation allows to rewrite applications of relations
+(** The instantiation at relation allows rewriting applications of relations
[R x y] to [R' x y] when [R] and [R'] are in [relation_equivalence]. *)
Instance relation_equivalence_pointwise :
@@ -52,6 +50,6 @@ Instance subrelation_pointwise :
Proof. intro. apply (predicate_implication_pointwise (Tcons A (Tcons A Tnil))). Qed.
-Lemma inverse_pointwise_relation A (R : relation A) :
- relation_equivalence (pointwise_relation A (inverse R)) (inverse (pointwise_relation A R)).
+Lemma flip_pointwise_relation A (R : relation A) :
+ relation_equivalence (pointwise_relation A (flip R)) (flip (pointwise_relation A R)).
Proof. intros. split; firstorder. Qed.
diff --git a/theories/Classes/RelationClasses.v b/theories/Classes/RelationClasses.v
index 5c4dd532..1a40e5d5 100644
--- a/theories/Classes/RelationClasses.v
+++ b/theories/Classes/RelationClasses.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-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -20,43 +20,191 @@ Require Import Coq.Program.Basics.
Require Import Coq.Program.Tactics.
Require Import Coq.Relations.Relation_Definitions.
-(** We allow to unfold the [relation] definition while doing morphism search. *)
-
-Notation inverse R := (flip (R:relation _) : relation _).
-
-Definition complement {A} (R : relation A) : relation A := fun x y => R x y -> False.
-
-(** Opaque for proof-search. *)
-Typeclasses Opaque complement.
-
-(** These are convertible. *)
-
-Lemma complement_inverse : forall A (R : relation A), complement (inverse R) = inverse (complement R).
-Proof. reflexivity. Qed.
+Generalizable Variables A B C D R S T U l eqA eqB eqC eqD.
-(** We rebind relations in separate classes to be able to overload each proof. *)
+(** We allow to unfold the [relation] definition while doing morphism search. *)
-Set Implicit Arguments.
-Unset Strict Implicit.
+Section Defs.
+ Context {A : Type}.
+
+ (** We rebind relational properties in separate classes to be able to overload each proof. *)
+
+ Class Reflexive (R : relation A) :=
+ reflexivity : forall x : A, R x x.
+
+ Definition complement (R : relation A) : relation A := fun x y => R x y -> False.
+
+ (** Opaque for proof-search. *)
+ Typeclasses Opaque complement.
+
+ (** These are convertible. *)
+ Lemma complement_inverse R : complement (flip R) = flip (complement R).
+ Proof. reflexivity. Qed.
+
+ Class Irreflexive (R : relation A) :=
+ irreflexivity : Reflexive (complement R).
+
+ Class Symmetric (R : relation A) :=
+ symmetry : forall {x y}, R x y -> R y x.
+
+ Class Asymmetric (R : relation A) :=
+ asymmetry : forall {x y}, R x y -> R y x -> False.
+
+ Class Transitive (R : relation A) :=
+ transitivity : forall {x y z}, R x y -> R y z -> R x z.
+
+ (** Various combinations of reflexivity, symmetry and transitivity. *)
+
+ (** A [PreOrder] is both Reflexive and Transitive. *)
+
+ Class PreOrder (R : relation A) : Prop := {
+ PreOrder_Reflexive :> Reflexive R | 2 ;
+ PreOrder_Transitive :> Transitive R | 2 }.
+
+ (** A [StrictOrder] is both Irreflexive and Transitive. *)
+
+ Class StrictOrder (R : relation A) : Prop := {
+ StrictOrder_Irreflexive :> Irreflexive R ;
+ StrictOrder_Transitive :> Transitive R }.
+
+ (** By definition, a strict order is also asymmetric *)
+ Global Instance StrictOrder_Asymmetric `(StrictOrder R) : Asymmetric R.
+ Proof. firstorder. Qed.
+
+ (** A partial equivalence relation is Symmetric and Transitive. *)
+
+ Class PER (R : relation A) : Prop := {
+ PER_Symmetric :> Symmetric R | 3 ;
+ PER_Transitive :> Transitive R | 3 }.
+
+ (** Equivalence relations. *)
+
+ Class Equivalence (R : relation A) : Prop := {
+ Equivalence_Reflexive :> Reflexive R ;
+ Equivalence_Symmetric :> Symmetric R ;
+ Equivalence_Transitive :> Transitive R }.
+
+ (** An Equivalence is a PER plus reflexivity. *)
+
+ Global Instance Equivalence_PER {R} `(E:Equivalence R) : PER R | 10 :=
+ { }.
+
+ (** We can now define antisymmetry w.r.t. an equivalence relation on the carrier. *)
+
+ Class Antisymmetric eqA `{equ : Equivalence eqA} (R : relation A) :=
+ antisymmetry : forall {x y}, R x y -> R y x -> eqA x y.
+
+ Class subrelation (R R' : relation A) : Prop :=
+ is_subrelation : forall {x y}, R x y -> R' x y.
+
+ (** Any symmetric relation is equal to its inverse. *)
+
+ Lemma subrelation_symmetric R `(Symmetric R) : subrelation (flip R) R.
+ Proof. hnf. intros. red in H0. apply symmetry. assumption. Qed.
+
+ Section flip.
+
+ Lemma flip_Reflexive `{Reflexive R} : Reflexive (flip R).
+ Proof. tauto. Qed.
+
+ Program Definition flip_Irreflexive `(Irreflexive R) : Irreflexive (flip R) :=
+ irreflexivity (R:=R).
+
+ Program Definition flip_Symmetric `(Symmetric R) : Symmetric (flip R) :=
+ fun x y H => symmetry (R:=R) H.
+
+ Program Definition flip_Asymmetric `(Asymmetric R) : Asymmetric (flip R) :=
+ fun x y H H' => asymmetry (R:=R) H H'.
+
+ Program Definition flip_Transitive `(Transitive R) : Transitive (flip R) :=
+ fun x y z H H' => transitivity (R:=R) H' H.
+
+ Program Definition flip_Antisymmetric `(Antisymmetric eqA R) :
+ Antisymmetric eqA (flip R).
+ Proof. firstorder. Qed.
+
+ (** Inversing the larger structures *)
+
+ Lemma flip_PreOrder `(PreOrder R) : PreOrder (flip R).
+ Proof. firstorder. Qed.
+
+ Lemma flip_StrictOrder `(StrictOrder R) : StrictOrder (flip R).
+ Proof. firstorder. Qed.
+
+ Lemma flip_PER `(PER R) : PER (flip R).
+ Proof. firstorder. Qed.
+
+ Lemma flip_Equivalence `(Equivalence R) : Equivalence (flip R).
+ Proof. firstorder. Qed.
+
+ End flip.
+
+ Section complement.
+
+ Definition complement_Irreflexive `(Reflexive R)
+ : Irreflexive (complement R).
+ Proof. firstorder. Qed.
+
+ Definition complement_Symmetric `(Symmetric R) : Symmetric (complement R).
+ Proof. firstorder. Qed.
+ End complement.
+
+
+ (** Rewrite relation on a given support: declares a relation as a rewrite
+ relation for use by the generalized rewriting tactic.
+ It helps choosing if a rewrite should be handled
+ by the generalized or the regular rewriting tactic using leibniz equality.
+ Users can declare an [RewriteRelation A RA] anywhere to declare default
+ relations. This is also done automatically by the [Declare Relation A RA]
+ commands. *)
-Class Reflexive {A} (R : relation A) :=
- reflexivity : forall x, R x x.
+ Class RewriteRelation (RA : relation A).
-Class Irreflexive {A} (R : relation A) :=
- irreflexivity : Reflexive (complement R).
+ (** Any [Equivalence] declared in the context is automatically considered
+ a rewrite relation. *)
+
+ Global Instance equivalence_rewrite_relation `(Equivalence eqA) : RewriteRelation eqA.
+
+ (** Leibniz equality. *)
+ Section Leibniz.
+ Global Instance eq_Reflexive : Reflexive (@eq A) := @eq_refl A.
+ Global Instance eq_Symmetric : Symmetric (@eq A) := @eq_sym A.
+ Global Instance eq_Transitive : Transitive (@eq A) := @eq_trans A.
+
+ (** Leibinz equality [eq] is an equivalence relation.
+ The instance has low priority as it is always applicable
+ if only the type is constrained. *)
+
+ Global Program Instance eq_equivalence : Equivalence (@eq A) | 10.
+ End Leibniz.
+
+End Defs.
+
+(** Default rewrite relations handled by [setoid_rewrite]. *)
+Instance: RewriteRelation impl.
+Instance: RewriteRelation iff.
+(** Hints to drive the typeclass resolution avoiding loops
+ due to the use of full unification. *)
Hint Extern 1 (Reflexive (complement _)) => class_apply @irreflexivity : typeclass_instances.
+Hint Extern 3 (Symmetric (complement _)) => class_apply complement_Symmetric : typeclass_instances.
+Hint Extern 3 (Irreflexive (complement _)) => class_apply complement_Irreflexive : typeclass_instances.
-Class Symmetric {A} (R : relation A) :=
- symmetry : forall x y, R x y -> R y x.
+Hint Extern 3 (Reflexive (flip _)) => apply flip_Reflexive : typeclass_instances.
+Hint Extern 3 (Irreflexive (flip _)) => class_apply flip_Irreflexive : typeclass_instances.
+Hint Extern 3 (Symmetric (flip _)) => class_apply flip_Symmetric : typeclass_instances.
+Hint Extern 3 (Asymmetric (flip _)) => class_apply flip_Asymmetric : typeclass_instances.
+Hint Extern 3 (Antisymmetric (flip _)) => class_apply flip_Antisymmetric : typeclass_instances.
+Hint Extern 3 (Transitive (flip _)) => class_apply flip_Transitive : typeclass_instances.
+Hint Extern 3 (StrictOrder (flip _)) => class_apply flip_StrictOrder : typeclass_instances.
+Hint Extern 3 (PreOrder (flip _)) => class_apply flip_PreOrder : typeclass_instances.
-Class Asymmetric {A} (R : relation A) :=
- asymmetry : forall x y, R x y -> R y x -> False.
+Hint Extern 4 (subrelation (flip _) _) =>
+ class_apply @subrelation_symmetric : typeclass_instances.
-Class Transitive {A} (R : relation A) :=
- transitivity : forall x y z, R x y -> R y z -> R x z.
+Arguments irreflexivity {A R Irreflexive} [x] _.
-Hint Resolve @irreflexivity : ord.
+Hint Resolve irreflexivity : ord.
Unset Implicit Arguments.
@@ -72,40 +220,6 @@ Hint Extern 4 => solve_relation : relations.
(** We can already dualize all these properties. *)
-Generalizable Variables A B C D R S T U l eqA eqB eqC eqD.
-
-Lemma flip_Reflexive `{Reflexive A R} : Reflexive (flip R).
-Proof. tauto. Qed.
-
-Hint Extern 3 (Reflexive (flip _)) => apply flip_Reflexive : typeclass_instances.
-
-Program Definition flip_Irreflexive `(Irreflexive A R) : Irreflexive (flip R) :=
- irreflexivity (R:=R).
-
-Program Definition flip_Symmetric `(Symmetric A R) : Symmetric (flip R) :=
- fun x y H => symmetry (R:=R) H.
-
-Program Definition flip_Asymmetric `(Asymmetric A R) : Asymmetric (flip R) :=
- fun x y H H' => asymmetry (R:=R) H H'.
-
-Program Definition flip_Transitive `(Transitive A R) : Transitive (flip R) :=
- fun x y z H H' => transitivity (R:=R) H' H.
-
-Hint Extern 3 (Irreflexive (flip _)) => class_apply flip_Irreflexive : typeclass_instances.
-Hint Extern 3 (Symmetric (flip _)) => class_apply flip_Symmetric : typeclass_instances.
-Hint Extern 3 (Asymmetric (flip _)) => class_apply flip_Asymmetric : typeclass_instances.
-Hint Extern 3 (Transitive (flip _)) => class_apply flip_Transitive : typeclass_instances.
-
-Definition Reflexive_complement_Irreflexive `(Reflexive A (R : relation A))
- : Irreflexive (complement R).
-Proof. firstorder. Qed.
-
-Definition complement_Symmetric `(Symmetric A (R : relation A)) : Symmetric (complement R).
-Proof. firstorder. Qed.
-
-Hint Extern 3 (Symmetric (complement _)) => class_apply complement_Symmetric : typeclass_instances.
-Hint Extern 3 (Irreflexive (complement _)) => class_apply Reflexive_complement_Irreflexive : typeclass_instances.
-
(** * Standard instances. *)
Ltac reduce_hyp H :=
@@ -130,7 +244,7 @@ Tactic Notation "apply" "*" constr(t) :=
Ltac simpl_relation :=
unfold flip, impl, arrow ; try reduce ; program_simpl ;
- try ( solve [ intuition ]).
+ try ( solve [ dintuition ]).
Local Obligation Tactic := simpl_relation.
@@ -145,54 +259,6 @@ Instance iff_Reflexive : Reflexive iff := iff_refl.
Instance iff_Symmetric : Symmetric iff := iff_sym.
Instance iff_Transitive : Transitive iff := iff_trans.
-(** Leibniz equality. *)
-
-Instance eq_Reflexive {A} : Reflexive (@eq A) := @eq_refl A.
-Instance eq_Symmetric {A} : Symmetric (@eq A) := @eq_sym A.
-Instance eq_Transitive {A} : Transitive (@eq A) := @eq_trans A.
-
-(** Various combinations of reflexivity, symmetry and transitivity. *)
-
-(** A [PreOrder] is both Reflexive and Transitive. *)
-
-Class PreOrder {A} (R : relation A) : Prop := {
- PreOrder_Reflexive :> Reflexive R | 2 ;
- PreOrder_Transitive :> Transitive R | 2 }.
-
-(** A partial equivalence relation is Symmetric and Transitive. *)
-
-Class PER {A} (R : relation A) : Prop := {
- PER_Symmetric :> Symmetric R | 3 ;
- PER_Transitive :> Transitive R | 3 }.
-
-(** Equivalence relations. *)
-
-Class Equivalence {A} (R : relation A) : Prop := {
- Equivalence_Reflexive :> Reflexive R ;
- Equivalence_Symmetric :> Symmetric R ;
- Equivalence_Transitive :> Transitive R }.
-
-(** An Equivalence is a PER plus reflexivity. *)
-
-Instance Equivalence_PER `(Equivalence A R) : PER R | 10 :=
- { PER_Symmetric := Equivalence_Symmetric ;
- PER_Transitive := Equivalence_Transitive }.
-
-(** We can now define antisymmetry w.r.t. an equivalence relation on the carrier. *)
-
-Class Antisymmetric A eqA `{equ : Equivalence A eqA} (R : relation A) :=
- antisymmetry : forall {x y}, R x y -> R y x -> eqA x y.
-
-Program Definition flip_antiSymmetric `(Antisymmetric A eqA R) :
- Antisymmetric A eqA (flip R).
-Proof. firstorder. Qed.
-
-(** Leibinz equality [eq] is an equivalence relation.
- The instance has low priority as it is always applicable
- if only the type is constrained. *)
-
-Program Instance eq_equivalence : Equivalence (@eq A) | 10.
-
(** Logical equivalence [iff] is an equivalence relation. *)
Program Instance iff_equivalence : Equivalence iff.
@@ -203,9 +269,6 @@ Program Instance iff_equivalence : Equivalence iff.
Local Open Scope list_scope.
-(* Notation " [ ] " := nil : list_scope. *)
-(* Notation " [ x ; .. ; y ] " := (cons x .. (cons y nil) ..) (at level 1) : list_scope. *)
-
(** A compact representation of non-dependent arities, with the codomain singled-out. *)
(* Note, we do not use [list Type] because it imposes unnecessary universe constraints *)
@@ -316,7 +379,8 @@ Notation "∙⊥∙" := false_predicate : predicate_scope.
(** Predicate equivalence is an equivalence, and predicate implication defines a preorder. *)
-Program Instance predicate_equivalence_equivalence : Equivalence (@predicate_equivalence l).
+Program Instance predicate_equivalence_equivalence :
+ Equivalence (@predicate_equivalence l).
Next Obligation.
induction l ; firstorder.
@@ -345,106 +409,66 @@ Program Instance predicate_implication_preorder :
(** We define the various operations which define the algebra on binary relations,
from the general ones. *)
-Definition relation_equivalence {A : Type} : relation (relation A) :=
- @predicate_equivalence (_::_::Tnil).
-
-Class subrelation {A:Type} (R R' : relation A) : Prop :=
- is_subrelation : @predicate_implication (A::A::Tnil) R R'.
-
-Arguments subrelation {A} R R'.
-
-Definition relation_conjunction {A} (R : relation A) (R' : relation A) : relation A :=
- @predicate_intersection (A::A::Tnil) R R'.
-
-Definition relation_disjunction {A} (R : relation A) (R' : relation A) : relation A :=
- @predicate_union (A::A::Tnil) R R'.
-
-(** Relation equivalence is an equivalence, and subrelation defines a partial order. *)
-
-Set Automatic Introduction.
-
-Instance relation_equivalence_equivalence (A : Type) :
- Equivalence (@relation_equivalence A).
-Proof. exact (@predicate_equivalence_equivalence (A::A::Tnil)). Qed.
-
-Instance relation_implication_preorder A : PreOrder (@subrelation A).
-Proof. exact (@predicate_implication_preorder (A::A::Tnil)). Qed.
-
-(** *** Partial Order.
+Section Binary.
+ Context {A : Type}.
+
+ Definition relation_equivalence : relation (relation A) :=
+ @predicate_equivalence (_::_::Tnil).
+
+ Global Instance: RewriteRelation relation_equivalence.
+
+ Definition relation_conjunction (R : relation A) (R' : relation A) : relation A :=
+ @predicate_intersection (A::A::Tnil) R R'.
+
+ Definition relation_disjunction (R : relation A) (R' : relation A) : relation A :=
+ @predicate_union (A::A::Tnil) R R'.
+
+ (** Relation equivalence is an equivalence, and subrelation defines a partial order. *)
+
+ Set Automatic Introduction.
+
+ Global Instance relation_equivalence_equivalence :
+ Equivalence relation_equivalence.
+ Proof. exact (@predicate_equivalence_equivalence (A::A::Tnil)). Qed.
+
+ Global Instance relation_implication_preorder : PreOrder (@subrelation A).
+ Proof. exact (@predicate_implication_preorder (A::A::Tnil)). Qed.
+
+ (** *** Partial Order.
A partial order is a preorder which is additionally antisymmetric.
We give an equivalent definition, up-to an equivalence relation
on the carrier. *)
-Class PartialOrder {A} eqA `{equ : Equivalence A eqA} R `{preo : PreOrder A R} :=
- partial_order_equivalence : relation_equivalence eqA (relation_conjunction R (inverse R)).
+ Class PartialOrder eqA `{equ : Equivalence A eqA} R `{preo : PreOrder A R} :=
+ partial_order_equivalence : relation_equivalence eqA (relation_conjunction R (flip R)).
+
+ (** The equivalence proof is sufficient for proving that [R] must be a
+ morphism for equivalence (see Morphisms). It is also sufficient to
+ show that [R] is antisymmetric w.r.t. [eqA] *)
+
+ Global Instance partial_order_antisym `(PartialOrder eqA R) : ! Antisymmetric A eqA R.
+ Proof with auto.
+ reduce_goal.
+ pose proof partial_order_equivalence as poe. do 3 red in poe.
+ apply <- poe. firstorder.
+ Qed.
-(** The equivalence proof is sufficient for proving that [R] must be a morphism
- for equivalence (see Morphisms).
- It is also sufficient to show that [R] is antisymmetric w.r.t. [eqA] *)
-Instance partial_order_antisym `(PartialOrder A eqA R) : ! Antisymmetric A eqA R.
-Proof with auto.
- reduce_goal.
- pose proof partial_order_equivalence as poe. do 3 red in poe.
- apply <- poe. firstorder.
-Qed.
+ Lemma PartialOrder_inverse `(PartialOrder eqA R) : PartialOrder eqA (flip R).
+ Proof. firstorder. Qed.
+End Binary.
+
+Hint Extern 3 (PartialOrder (flip _)) => class_apply PartialOrder_inverse : typeclass_instances.
(** The partial order defined by subrelation and relation equivalence. *)
Program Instance subrelation_partial_order :
! PartialOrder (relation A) relation_equivalence subrelation.
- Next Obligation.
- Proof.
- unfold relation_equivalence in *. compute; firstorder.
- Qed.
+Next Obligation.
+Proof.
+ unfold relation_equivalence in *. compute; firstorder.
+Qed.
Typeclasses Opaque arrows predicate_implication predicate_equivalence
- relation_equivalence pointwise_lifting.
-
-(** Rewrite relation on a given support: declares a relation as a rewrite
- relation for use by the generalized rewriting tactic.
- It helps choosing if a rewrite should be handled
- by the generalized or the regular rewriting tactic using leibniz equality.
- Users can declare an [RewriteRelation A RA] anywhere to declare default
- relations. This is also done automatically by the [Declare Relation A RA]
- commands. *)
-
-Class RewriteRelation {A : Type} (RA : relation A).
-
-Instance: RewriteRelation impl.
-Instance: RewriteRelation iff.
-Instance: RewriteRelation (@relation_equivalence A).
-
-(** Any [Equivalence] declared in the context is automatically considered
- a rewrite relation. *)
-
-Instance equivalence_rewrite_relation `(Equivalence A eqA) : RewriteRelation eqA.
-
-(** Strict Order *)
-
-Class StrictOrder {A : Type} (R : relation A) : Prop := {
- StrictOrder_Irreflexive :> Irreflexive R ;
- StrictOrder_Transitive :> Transitive R
-}.
-
-Instance StrictOrder_Asymmetric `(StrictOrder A R) : Asymmetric R.
-Proof. firstorder. Qed.
-
-(** Inversing a [StrictOrder] gives another [StrictOrder] *)
-
-Lemma StrictOrder_inverse `(StrictOrder A R) : StrictOrder (inverse R).
-Proof. firstorder. Qed.
-
-(** Same for [PartialOrder]. *)
-
-Lemma PreOrder_inverse `(PreOrder A R) : PreOrder (inverse R).
-Proof. firstorder. Qed.
-
-Hint Extern 3 (StrictOrder (inverse _)) => class_apply StrictOrder_inverse : typeclass_instances.
-Hint Extern 3 (PreOrder (inverse _)) => class_apply PreOrder_inverse : typeclass_instances.
-
-Lemma PartialOrder_inverse `(PartialOrder A eqA R) : PartialOrder eqA (inverse R).
-Proof. firstorder. Qed.
-
-Hint Extern 3 (PartialOrder (inverse _)) => class_apply PartialOrder_inverse : typeclass_instances.
+ relation_equivalence pointwise_lifting.
diff --git a/theories/Classes/RelationPairs.v b/theories/Classes/RelationPairs.v
index 2b010206..cbde5f9a 100644
--- a/theories/Classes/RelationPairs.v
+++ b/theories/Classes/RelationPairs.v
@@ -9,8 +9,8 @@
(** * Relations over pairs *)
+Require Import SetoidList.
Require Import Relations Morphisms.
-
(* NB: This should be system-wide someday, but for that we need to
fix the simpl tactic, since "simpl fst" would be refused for
the moment.
@@ -40,7 +40,7 @@ Generalizable Variables A B RA RB Ri Ro f.
(** Any function from [A] to [B] allow to obtain a relation over [A]
out of a relation over [B]. *)
-Definition RelCompFun {A B}(R:relation B)(f:A->B) : relation A :=
+Definition RelCompFun {A} {B : Type}(R:relation B)(f:A->B) : relation A :=
fun a a' => R (f a) (f a').
Infix "@@" := RelCompFun (at level 30, right associativity) : signature_scope.
@@ -62,13 +62,13 @@ Instance snd_measure : @Measure (A * B) B Snd.
(** We define a product relation over [A*B]: each components should
satisfy the corresponding initial relation. *)
-Definition RelProd {A B}(RA:relation A)(RB:relation B) : relation (A*B) :=
- relation_conjunction (RA @@1) (RB @@2).
+Definition RelProd {A : Type} {B : Type} (RA:relation A)(RB:relation B) : relation (A*B) :=
+ relation_conjunction (@RelCompFun (A * B) A RA fst) (RB @@2).
Infix "*" := RelProd : signature_scope.
Section RelCompFun_Instances.
- Context {A B : Type} (R : relation B).
+ Context {A : Type} {B : Type} (R : relation B).
Global Instance RelCompFun_Reflexive
`(Measure A B f, Reflexive _ R) : Reflexive (R@@f).
@@ -94,57 +94,61 @@ Section RelCompFun_Instances.
End RelCompFun_Instances.
-Instance RelProd_Reflexive {A B}(RA:relation A)(RB:relation B)
- `(Reflexive _ RA, Reflexive _ RB) : Reflexive (RA*RB).
-Proof. firstorder. Qed.
-
-Instance RelProd_Symmetric {A B}(RA:relation A)(RB:relation B)
- `(Symmetric _ RA, Symmetric _ RB) : Symmetric (RA*RB).
-Proof. firstorder. Qed.
-
-Instance RelProd_Transitive {A B}(RA:relation A)(RB:relation B)
- `(Transitive _ RA, Transitive _ RB) : Transitive (RA*RB).
-Proof. firstorder. Qed.
-
-Program Instance RelProd_Equivalence {A B}(RA:relation A)(RB:relation B)
- `(Equivalence _ RA, Equivalence _ RB) : Equivalence (RA*RB).
-
-Lemma FstRel_ProdRel {A B}(RA:relation A) :
- relation_equivalence (RA @@1) (RA*(fun _ _ : B => True)).
-Proof. firstorder. Qed.
-
-Lemma SndRel_ProdRel {A B}(RB:relation B) :
- relation_equivalence (RB @@2) ((fun _ _ : A =>True) * RB).
-Proof. firstorder. Qed.
-
-Instance FstRel_sub {A B} (RA:relation A)(RB:relation B):
- subrelation (RA*RB) (RA @@1).
-Proof. firstorder. Qed.
-
-Instance SndRel_sub {A B} (RA:relation A)(RB:relation B):
- subrelation (RA*RB) (RB @@2).
-Proof. firstorder. Qed.
-
-Instance pair_compat { A B } (RA:relation A)(RB:relation B) :
- Proper (RA==>RB==> RA*RB) (@pair _ _).
-Proof. firstorder. Qed.
-
-Instance fst_compat { A B } (RA:relation A)(RB:relation B) :
- Proper (RA*RB ==> RA) Fst.
-Proof.
-intros (x,y) (x',y') (Hx,Hy); compute in *; auto.
-Qed.
-
-Instance snd_compat { A B } (RA:relation A)(RB:relation B) :
- Proper (RA*RB ==> RB) Snd.
-Proof.
-intros (x,y) (x',y') (Hx,Hy); compute in *; auto.
-Qed.
-
-Instance RelCompFun_compat {A B}(f:A->B)(R : relation B)
- `(Proper _ (Ri==>Ri==>Ro) R) :
- Proper (Ri@@f==>Ri@@f==>Ro) (R@@f)%signature.
-Proof. unfold RelCompFun; firstorder. Qed.
+Section RelProd_Instances.
+
+ Context {A : Type} {B : Type} (RA : relation A) (RB : relation B).
+
+ Global Instance RelProd_Reflexive `(Reflexive _ RA, Reflexive _ RB) : Reflexive (RA*RB).
+ Proof. firstorder. Qed.
+
+ Global Instance RelProd_Symmetric `(Symmetric _ RA, Symmetric _ RB)
+ : Symmetric (RA*RB).
+ Proof. firstorder. Qed.
+
+ Global Instance RelProd_Transitive
+ `(Transitive _ RA, Transitive _ RB) : Transitive (RA*RB).
+ Proof. firstorder. Qed.
+
+ Global Program Instance RelProd_Equivalence
+ `(Equivalence _ RA, Equivalence _ RB) : Equivalence (RA*RB).
+
+ Lemma FstRel_ProdRel :
+ relation_equivalence (RA @@1) (RA*(fun _ _ : B => True)).
+ Proof. firstorder. Qed.
+
+ Lemma SndRel_ProdRel :
+ relation_equivalence (RB @@2) ((fun _ _ : A =>True) * RB).
+ Proof. firstorder. Qed.
+
+ Global Instance FstRel_sub :
+ subrelation (RA*RB) (RA @@1).
+ Proof. firstorder. Qed.
+
+ Global Instance SndRel_sub :
+ subrelation (RA*RB) (RB @@2).
+ Proof. firstorder. Qed.
+
+ Global Instance pair_compat :
+ Proper (RA==>RB==> RA*RB) (@pair _ _).
+ Proof. firstorder. Qed.
+
+ Global Instance fst_compat :
+ Proper (RA*RB ==> RA) Fst.
+ Proof.
+ intros (x,y) (x',y') (Hx,Hy); compute in *; auto.
+ Qed.
+
+ Global Instance snd_compat :
+ Proper (RA*RB ==> RB) Snd.
+ Proof.
+ intros (x,y) (x',y') (Hx,Hy); compute in *; auto.
+ Qed.
+
+ Global Instance RelCompFun_compat (f:A->B)
+ `(Proper _ (Ri==>Ri==>Ro) RB) :
+ Proper (Ri@@f==>Ri@@f==>Ro) (RB@@f)%signature.
+ Proof. unfold RelCompFun; firstorder. Qed.
+End RelProd_Instances.
Hint Unfold RelProd RelCompFun.
Hint Extern 2 (RelProd _ _ _ _) => split.
diff --git a/theories/Classes/SetoidClass.v b/theories/Classes/SetoidClass.v
index e7b94081..f20100fe 100644
--- a/theories/Classes/SetoidClass.v
+++ b/theories/Classes/SetoidClass.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Classes/SetoidDec.v b/theories/Classes/SetoidDec.v
index 79168084..bf05934e 100644
--- a/theories/Classes/SetoidDec.v
+++ b/theories/Classes/SetoidDec.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-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -108,7 +108,7 @@ Program Instance prod_eqdec `(! EqDec (eq_setoid A), ! EqDec (eq_setoid B))
else in_right
else in_right.
- Solve Obligations using unfold complement ; program_simpl.
+ Solve Obligations with unfold complement ; program_simpl.
(** Objects of function spaces with countable domains like bool
have decidable equality. *)
@@ -121,7 +121,7 @@ Program Instance bool_function_eqdec `(! EqDec (eq_setoid A))
else in_right
else in_right.
- Solve Obligations using try red ; unfold equiv, complement ; program_simpl.
+ Solve Obligations with try red ; unfold complement ; program_simpl.
Next Obligation.
Proof.
diff --git a/theories/Classes/SetoidTactics.v b/theories/Classes/SetoidTactics.v
index 07d1203c..8ca93341 100644
--- a/theories/Classes/SetoidTactics.v
+++ b/theories/Classes/SetoidTactics.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -12,6 +12,7 @@
Institution: LRI, CNRS UMR 8623 - University Paris Sud
*)
+Require Coq.Classes.CRelationClasses Coq.Classes.CMorphisms.
Require Import Coq.Classes.Morphisms Coq.Classes.Morphisms_Prop.
Require Export Coq.Classes.RelationClasses Coq.Relations.Relation_Definitions.
Require Import Coq.Classes.Equivalence Coq.Program.Basics.
diff --git a/theories/Classes/vo.itarget b/theories/Classes/vo.itarget
index 9daf133b..18147f2a 100644
--- a/theories/Classes/vo.itarget
+++ b/theories/Classes/vo.itarget
@@ -1,3 +1,4 @@
+DecidableClass.vo
Equivalence.vo
EquivDec.vo
Init.vo
@@ -9,3 +10,6 @@ SetoidClass.vo
SetoidDec.vo
SetoidTactics.vo
RelationPairs.vo
+CRelationClasses.vo
+CMorphisms.vo
+CEquivalence.vo
diff --git a/theories/FSets/FMapAVL.v b/theories/FSets/FMapAVL.v
index c68216e6..c9e5b8dd 100644
--- a/theories/FSets/FMapAVL.v
+++ b/theories/FSets/FMapAVL.v
@@ -270,7 +270,7 @@ Fixpoint elements_aux (acc : list (key*elt)) m : list (key*elt) :=
| Node l x d r _ => elements_aux ((x,d) :: elements_aux acc r) l
end.
-(** then [elements] is an instanciation with an empty [acc] *)
+(** then [elements] is an instantiation with an empty [acc] *)
Definition elements := elements_aux nil.
@@ -342,7 +342,7 @@ Notation "t #r" := (t_right t) (at level 9, format "t '#r'").
Fixpoint map (elt elt' : Type)(f : elt -> elt')(m : t elt) : t elt' :=
match m with
- | Leaf => Leaf _
+ | Leaf _ => Leaf _
| Node l x d r h => Node (map f l) x (f d) (map f r) h
end.
@@ -350,7 +350,7 @@ Fixpoint map (elt elt' : Type)(f : elt -> elt')(m : t elt) : t elt' :=
Fixpoint mapi (elt elt' : Type)(f : key -> elt -> elt')(m : t elt) : t elt' :=
match m with
- | Leaf => Leaf _
+ | Leaf _ => Leaf _
| Node l x d r h => Node (mapi f l) x (f x d) (mapi f r) h
end.
@@ -359,7 +359,7 @@ Fixpoint mapi (elt elt' : Type)(f : key -> elt -> elt')(m : t elt) : t elt' :=
Fixpoint map_option (elt elt' : Type)(f : key -> elt -> option elt')(m : t elt)
: t elt' :=
match m with
- | Leaf => Leaf _
+ | Leaf _ => Leaf _
| Node l x d r h =>
match f x d with
| Some d' => join (map_option f l) x d' (map_option f r)
@@ -370,7 +370,7 @@ Fixpoint map_option (elt elt' : Type)(f : key -> elt -> option elt')(m : t elt)
(** * Optimized map2
Suggestion by B. Gregoire: a [map2] function with specialized
- arguments allowing to bypass some tree traversal. Instead of one
+ arguments that allows bypassing some tree traversal. Instead of one
[f0] of type [key -> option elt -> option elt' -> option elt''],
we ask here for:
- [f] which is a specialisation of [f0] when first option isn't [None]
@@ -389,8 +389,8 @@ Variable mapr : t elt' -> t elt''.
Fixpoint map2_opt m1 m2 :=
match m1, m2 with
- | Leaf, _ => mapr m2
- | _, Leaf => mapl m1
+ | Leaf _, _ => mapr m2
+ | _, Leaf _ => mapl m1
| Node l1 x1 d1 r1 h1, _ =>
let (l2',o2,r2') := split x1 m2 in
match f x1 d1 o2 with
@@ -534,7 +534,7 @@ Ltac order := match goal with
| _ => MX.order
end.
-Ltac intuition_in := repeat progress (intuition; inv In; inv MapsTo).
+Ltac intuition_in := repeat (intuition; inv In; inv MapsTo).
(* Function/Functional Scheme can't deal with internal fix.
Let's do its job by hand: *)
@@ -1247,11 +1247,11 @@ Proof.
intros m1 m2; functional induction (concat m1 m2); intros; auto;
try factornode _x _x0 _x1 _x2 _x3 as m1.
apply join_bst; auto.
- change (bst (m2',xd)#1); rewrite <-e1; eauto.
+ change (bst (m2',xd)#1). rewrite <-e1; eauto.
intros y Hy.
apply H1; auto.
rewrite remove_min_in, e1; simpl; auto.
- change (gt_tree (m2',xd)#2#1 (m2',xd)#1); rewrite <-e1; eauto.
+ change (gt_tree (m2',xd)#2#1 (m2',xd)#1). rewrite <-e1; eauto.
Qed.
Hint Resolve concat_bst.
@@ -1270,10 +1270,10 @@ Proof.
inv bst.
rewrite H2, join_find; auto; clear H2.
- simpl; destruct X.compare; simpl; auto.
+ simpl; destruct X.compare as [Hlt| |Hlt]; simpl; auto.
destruct (find y m2'); auto.
symmetry; rewrite not_find_iff; auto; intro.
- apply (MX.lt_not_gt l); apply H1; auto; rewrite H3; auto.
+ apply (MX.lt_not_gt Hlt); apply H1; auto; rewrite H3; auto.
intros z Hz; apply H1; auto; rewrite H3; auto.
Qed.
@@ -1367,7 +1367,7 @@ Proof.
induction s; simpl; intros; auto.
rewrite IHs1, IHs2.
unfold elements; simpl.
- rewrite 2 IHs1, IHs2, <- !app_nil_end, !app_ass; auto.
+ rewrite 2 IHs1, IHs2, !app_nil_r, !app_ass; auto.
Qed.
Lemma elements_node :
@@ -1376,7 +1376,7 @@ Lemma elements_node :
elements (Node t1 x e t2 z) ++ l.
Proof.
unfold elements; simpl; intros.
- rewrite !elements_app, <- !app_nil_end, !app_ass; auto.
+ rewrite !elements_app, !app_nil_r, !app_ass; auto.
Qed.
(** * Fold *)
@@ -1424,7 +1424,7 @@ Qed.
i.e. the list of elements actually compared *)
Fixpoint flatten_e (e : enumeration elt) : list (key*elt) := match e with
- | End => nil
+ | End _ => nil
| More x e t r => (x,e) :: elements t ++ flatten_e r
end.
@@ -1433,14 +1433,14 @@ Lemma flatten_e_elements :
elements l ++ flatten_e (More x d r e) =
elements (Node l x d r z) ++ flatten_e e.
Proof.
- intros; simpl; apply elements_node.
+ intros; apply elements_node.
Qed.
Lemma cons_1 : forall (s:t elt) e,
flatten_e (cons s e) = elements s ++ flatten_e e.
Proof.
- induction s; simpl; auto; intros.
- rewrite IHs1; apply flatten_e_elements; auto.
+ induction s; auto; intros.
+ simpl flatten_e; rewrite IHs1; apply flatten_e_elements; auto.
Qed.
(** Proof of correction for the comparison *)
@@ -1478,7 +1478,7 @@ Lemma equal_cont_IfEq : forall m1 cont e2 l,
(forall e, IfEq (cont e) l (flatten_e e)) ->
IfEq (equal_cont cmp m1 cont e2) (elements m1 ++ l) (flatten_e e2).
Proof.
- induction m1 as [|l1 Hl1 x1 d1 r1 Hr1 h1]; simpl; intros; auto.
+ induction m1 as [|l1 Hl1 x1 d1 r1 Hr1 h1]; intros; auto.
rewrite <- elements_node; simpl.
apply Hl1; auto.
clear e2; intros [|x2 d2 r2 e2].
@@ -1491,9 +1491,9 @@ Lemma equal_IfEq : forall (m1 m2:t elt),
IfEq (equal cmp m1 m2) (elements m1) (elements m2).
Proof.
intros; unfold equal.
- rewrite (app_nil_end (elements m1)).
+ rewrite <- (app_nil_r (elements m1)).
replace (elements m2) with (flatten_e (cons m2 (End _)))
- by (rewrite cons_1; simpl; rewrite <-app_nil_end; auto).
+ by (rewrite cons_1; simpl; rewrite app_nil_r; auto).
apply equal_cont_IfEq.
intros.
apply equal_end_IfEq; auto.
@@ -1622,8 +1622,8 @@ Lemma map_option_find : forall (m:t elt)(x:key),
Proof.
intros m; functional induction (map_option f m); simpl; auto; intros;
inv bst; rewrite join_find || rewrite concat_find; auto; simpl;
- try destruct X.compare; simpl; auto.
-rewrite (f_compat d e); auto.
+ try destruct X.compare as [Hlt|Heq|Hlt]; simpl; auto.
+rewrite (f_compat d Heq); auto.
intros y H;
destruct (map_option_2 H) as (? & ? & ?); eauto using MapsTo_In.
intros y H;
@@ -1631,7 +1631,7 @@ intros y H;
rewrite <- IHt, IHt0; auto; nonify (find x0 r); auto.
rewrite IHt, IHt0; auto; nonify (find x0 r); nonify (find x0 l); auto.
-rewrite (f_compat d e); auto.
+rewrite (f_compat d Heq); auto.
rewrite <- IHt0, IHt; auto; nonify (find x0 l); auto.
destruct (find x0 (map_option f r)); auto.
@@ -1930,7 +1930,7 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X.
Lemma Equivb_Equivb : forall cmp m m',
Equivb cmp m m' <-> Raw.Proofs.Equivb cmp m m'.
Proof.
- intros; unfold Equivb, Equiv, Raw.Proofs.Equivb, In; intuition.
+ intros; unfold Equivb, Equiv, Raw.Proofs.Equivb, In. intuition.
generalize (H0 k); do 2 rewrite In_alt; intuition.
generalize (H0 k); do 2 rewrite In_alt; intuition.
generalize (H0 k); do 2 rewrite <- In_alt; intuition.
@@ -2016,7 +2016,7 @@ Module IntMake_ord (I:Int)(X: OrderedType)(D : OrderedType) <:
Definition compare_more x1 d1 (cont:R.enumeration D.t -> comparison) e2 :=
match e2 with
- | R.End => Gt
+ | R.End _ => Gt
| R.More x2 d2 r2 e2 =>
match X.compare x1 x2 with
| EQ _ => match D.compare d1 d2 with
@@ -2033,7 +2033,7 @@ Module IntMake_ord (I:Int)(X: OrderedType)(D : OrderedType) <:
Fixpoint compare_cont s1 (cont:R.enumeration D.t -> comparison) e2 :=
match s1 with
- | R.Leaf => cont e2
+ | R.Leaf _ => cont e2
| R.Node l1 x1 d1 r1 _ =>
compare_cont l1 (compare_more x1 d1 (compare_cont r1 cont)) e2
end.
@@ -2041,7 +2041,7 @@ Module IntMake_ord (I:Int)(X: OrderedType)(D : OrderedType) <:
(** Initial continuation *)
Definition compare_end (e2:R.enumeration D.t) :=
- match e2 with R.End => Eq | _ => Lt end.
+ match e2 with R.End _ => Eq | _ => Lt end.
(** The complete comparison *)
@@ -2084,7 +2084,7 @@ Module IntMake_ord (I:Int)(X: OrderedType)(D : OrderedType) <:
(forall e, Cmp (cont e) l (P.flatten_e e)) ->
Cmp (compare_cont s1 cont e2) (R.elements s1 ++ l) (P.flatten_e e2).
Proof.
- induction s1 as [|l1 Hl1 x1 d1 r1 Hr1 h1]; simpl; intros; auto.
+ induction s1 as [|l1 Hl1 x1 d1 r1 Hr1 h1]; intros; auto.
rewrite <- P.elements_node; simpl.
apply Hl1; auto. clear e2. intros [|x2 d2 r2 e2].
simpl; auto.
@@ -2096,9 +2096,9 @@ Module IntMake_ord (I:Int)(X: OrderedType)(D : OrderedType) <:
Cmp (compare_pure s1 s2) (R.elements s1) (R.elements s2).
Proof.
intros; unfold compare_pure.
- rewrite (app_nil_end (R.elements s1)).
+ rewrite <- (app_nil_r (R.elements s1)).
replace (R.elements s2) with (P.flatten_e (R.cons s2 (R.End _))) by
- (rewrite P.cons_1; simpl; rewrite <- app_nil_end; auto).
+ (rewrite P.cons_1; simpl; rewrite app_nil_r; auto).
auto using compare_cont_Cmp, compare_end_Cmp.
Qed.
diff --git a/theories/FSets/FMapFacts.v b/theories/FSets/FMapFacts.v
index 0c1448c9..8c6f4b64 100644
--- a/theories/FSets/FMapFacts.v
+++ b/theories/FSets/FMapFacts.v
@@ -437,12 +437,6 @@ intros; do 2 rewrite mem_find_b; rewrite remove_o; unfold eqb.
destruct (eq_dec x y); auto.
Qed.
-Definition option_map (A B:Type)(f:A->B)(o:option A) : option B :=
- match o with
- | Some a => Some (f a)
- | None => None
- end.
-
Lemma map_o : forall m x (f:elt->elt'),
find x (map f m) = option_map f (find x m).
Proof.
@@ -519,7 +513,7 @@ Proof.
intros. rewrite eq_option_alt. intro e.
rewrite <- find_mapsto_iff, elements_mapsto_iff.
unfold eqb.
-rewrite <- findA_NoDupA; intuition; try apply elements_3w; eauto.
+rewrite <- findA_NoDupA; dintuition; try apply elements_3w; eauto.
Qed.
Lemma elements_b : forall m x,
@@ -678,9 +672,9 @@ Qed.
Add Parametric Morphism elt : (@Empty elt)
with signature Equal ==> iff as Empty_m.
Proof.
-unfold Empty; intros m m' Hm; intuition.
-rewrite <-Hm in H0; eauto.
-rewrite Hm in H0; eauto.
+unfold Empty; intros m m' Hm. split; intros; intro.
+rewrite <-Hm in H0; eapply H, H0.
+rewrite Hm in H0; eapply H, H0.
Qed.
Add Parametric Morphism elt : (@is_empty elt)
@@ -708,18 +702,18 @@ Add Parametric Morphism elt : (@add elt)
with signature E.eq ==> eq ==> Equal ==> Equal as add_m.
Proof.
intros k k' Hk e m m' Hm y.
-rewrite add_o, add_o; do 2 destruct eq_dec; auto.
-elim n; rewrite <-Hk; auto.
-elim n; rewrite Hk; auto.
+rewrite add_o, add_o; do 2 destruct eq_dec as [|?Hnot]; auto.
+elim Hnot; rewrite <-Hk; auto.
+elim Hnot; rewrite Hk; auto.
Qed.
Add Parametric Morphism elt : (@remove elt)
with signature E.eq ==> Equal ==> Equal as remove_m.
Proof.
intros k k' Hk m m' Hm y.
-rewrite remove_o, remove_o; do 2 destruct eq_dec; auto.
-elim n; rewrite <-Hk; auto.
-elim n; rewrite Hk; auto.
+rewrite remove_o, remove_o; do 2 destruct eq_dec as [|?Hnot]; auto.
+elim Hnot; rewrite <-Hk; auto.
+elim Hnot; rewrite Hk; auto.
Qed.
Add Parametric Morphism elt elt' : (@map elt elt')
@@ -835,8 +829,8 @@ Module WProperties_fun (E:DecidableType)(M:WSfun E).
Definition uncurry {U V W : Type} (f : U -> V -> W) : U*V -> W :=
fun p => f (fst p) (snd p).
- Definition of_list (l : list (key*elt)) :=
- List.fold_right (uncurry (@add _)) (empty _) l.
+ Definition of_list :=
+ List.fold_right (uncurry (@add _)) (empty elt).
Definition to_list := elements.
@@ -867,7 +861,7 @@ Module WProperties_fun (E:DecidableType)(M:WSfun E).
inversion_clear Hnodup as [| ? ? Hnotin Hnodup'].
specialize (IH k Hnodup'); clear Hnodup'.
rewrite add_o, IH.
- unfold eqb; do 2 destruct eq_dec; auto; elim n; eauto.
+ unfold eqb; do 2 destruct eq_dec as [|?Hnot]; auto; elim Hnot; eauto.
Qed.
Lemma of_list_2 : forall l, NoDupA eqk l ->
@@ -934,7 +928,7 @@ Module WProperties_fun (E:DecidableType)(M:WSfun E).
apply InA_eqke_eqk with k e'; auto.
rewrite <- of_list_1; auto.
intro k'. rewrite Hsame, add_o, of_list_1b. simpl.
- unfold eqb. do 2 destruct eq_dec; auto; elim n; eauto.
+ unfold eqb. do 2 destruct eq_dec as [|?Hnot]; auto; elim Hnot; eauto.
inversion_clear Hdup; auto.
apply IHl.
intros; eapply Hstep'; eauto.
@@ -1124,6 +1118,27 @@ Module WProperties_fun (E:DecidableType)(M:WSfun E).
auto with *.
Qed.
+ Lemma fold_Equal2 : forall m1 m2 i j, Equal m1 m2 -> eqA i j ->
+ eqA (fold f m1 i) (fold f m2 j).
+ Proof.
+ intros.
+ rewrite 2 fold_spec_right.
+ assert (NoDupA eqk (rev (elements m1))) by (auto with * ).
+ assert (NoDupA eqk (rev (elements m2))) by (auto with * ).
+ apply fold_right_equivlistA_restr2 with (R:=complement eqk)(eqA:=eqke)
+ ; auto with *.
+ - intros (k1,e1) (k2,e2) (Hk,He) a1 a2 Ha; simpl in *; apply Comp; auto.
+ - unfold complement, eq_key, eq_key_elt; repeat red. intuition eauto.
+ - intros (k,e) (k',e') z z' h h'; unfold eq_key, uncurry;simpl; auto.
+ rewrite h'.
+ auto.
+ - rewrite <- NoDupA_altdef; auto.
+ - intros (k,e).
+ rewrite 2 InA_rev, <- 2 elements_mapsto_iff, 2 find_mapsto_iff, H;
+ auto with *.
+ Qed.
+
+
Lemma fold_Add : forall m1 m2 k e i, ~In k m1 -> Add k e m1 m2 ->
eqA (fold f m2 i) (f k e (fold f m1 i)).
Proof.
@@ -1871,14 +1886,9 @@ Module OrdProperties (M:S).
find_mapsto_iff, (H0 t0), <- find_mapsto_iff,
add_mapsto_iff by (auto with *).
unfold O.eqke, O.ltk; simpl.
- destruct (E.compare t0 x); intuition.
- right; split; auto; ME.order.
- ME.order.
- elim H.
- exists e0; apply MapsTo_1 with t0; auto.
- right; right; split; auto; ME.order.
- ME.order.
- right; split; auto; ME.order.
+ destruct (E.compare t0 x); intuition; try fold (~E.eq x t0); auto.
+ - elim H; exists e0; apply MapsTo_1 with t0; auto.
+ - fold (~E.lt t0 x); auto.
Qed.
Lemma elements_Add_Above : forall m m' x e,
@@ -1901,7 +1911,7 @@ Module OrdProperties (M:S).
find_mapsto_iff, (H0 t0), <- find_mapsto_iff,
add_mapsto_iff by (auto with *).
unfold O.eqke; simpl. intuition.
- destruct (E.eq_dec x t0); auto.
+ destruct (E.eq_dec x t0) as [Heq|Hneq]; auto.
exfalso.
assert (In t0 m).
exists e0; auto.
@@ -1930,7 +1940,7 @@ Module OrdProperties (M:S).
find_mapsto_iff, (H0 t0), <- find_mapsto_iff,
add_mapsto_iff by (auto with *).
unfold O.eqke; simpl. intuition.
- destruct (E.eq_dec x t0); auto.
+ destruct (E.eq_dec x t0) as [Heq|Hneq]; auto.
exfalso.
assert (In t0 m).
exists e0; auto.
@@ -1986,7 +1996,7 @@ Module OrdProperties (M:S).
inversion_clear H1; [ | inversion_clear H2; eauto ].
red in H3; simpl in H3; destruct H3.
destruct p as (p1,p2).
- destruct (E.eq_dec p1 x).
+ destruct (E.eq_dec p1 x) as [Heq|Hneq].
apply ME.lt_eq with p1; auto.
inversion_clear H2.
inversion_clear H5.
diff --git a/theories/FSets/FMapFullAVL.v b/theories/FSets/FMapFullAVL.v
index e1c60351..a7be3232 100644
--- a/theories/FSets/FMapFullAVL.v
+++ b/theories/FSets/FMapFullAVL.v
@@ -660,7 +660,7 @@ Module IntMake_ord (I:Int)(X: OrderedType)(D : OrderedType) <:
Fixpoint cardinal_e (e:Raw.enumeration D.t) :=
match e with
- | Raw.End => 0%nat
+ | Raw.End _ => 0%nat
| Raw.More _ _ r e => S (Raw.cardinal r + cardinal_e e)
end.
@@ -674,12 +674,14 @@ Module IntMake_ord (I:Int)(X: OrderedType)(D : OrderedType) <:
Definition cardinal_e_2 ee :=
(cardinal_e (fst ee) + cardinal_e (snd ee))%nat.
+ Local Unset Keyed Unification.
+
Function compare_aux (ee:Raw.enumeration D.t * Raw.enumeration D.t)
{ measure cardinal_e_2 ee } : comparison :=
match ee with
- | (Raw.End, Raw.End) => Eq
- | (Raw.End, Raw.More _ _ _ _) => Lt
- | (Raw.More _ _ _ _, Raw.End) => Gt
+ | (Raw.End _, Raw.End _) => Eq
+ | (Raw.End _, Raw.More _ _ _ _) => Lt
+ | (Raw.More _ _ _ _, Raw.End _) => Gt
| (Raw.More x1 d1 r1 e1, Raw.More x2 d2 r2 e2) =>
match X.compare x1 x2 with
| EQ _ => match D.compare d1 d2 with
@@ -726,7 +728,7 @@ Module IntMake_ord (I:Int)(X: OrderedType)(D : OrderedType) <:
intros.
assert (H1:=cons_1 m1 (Raw.End _)).
assert (H2:=cons_1 m2 (Raw.End _)).
- simpl in *; rewrite <- app_nil_end in *; rewrite <-H1,<-H2.
+ simpl in *; rewrite app_nil_r in *; rewrite <-H1,<-H2.
apply (@compare_aux_Cmp (Raw.cons m1 (Raw.End _),
Raw.cons m2 (Raw.End _))).
Qed.
diff --git a/theories/FSets/FMapList.v b/theories/FSets/FMapList.v
index f15ab222..13cb559b 100644
--- a/theories/FSets/FMapList.v
+++ b/theories/FSets/FMapList.v
@@ -403,7 +403,7 @@ Proof.
apply H1 with k; destruct (X.eq_dec x k); auto.
- destruct (X.compare x x'); try contradiction; clear y.
+ destruct (X.compare x x') as [Hlt|Heq|Hlt]; try contradiction; clear y.
destruct (H0 x).
assert (In x ((x',e')::l')).
apply H; auto.
@@ -527,7 +527,7 @@ Fixpoint mapi (f: key -> elt -> elt') (m:t elt) : t elt' :=
| nil => nil
| (k,e)::m' => (k,f k e) :: mapi f m'
end.
-
+
End Elt.
Section Elt2.
(* A new section is necessary for previous definitions to work
@@ -543,14 +543,13 @@ Proof.
intros m x e f.
(* functional induction map elt elt' f m. *) (* Marche pas ??? *)
induction m.
- inversion 1.
+ inversion 1.
destruct a as (x',e').
simpl.
- inversion_clear 1.
+ inversion_clear 1.
constructor 1.
unfold eqke in *; simpl in *; intuition congruence.
- constructor 2.
unfold MapsTo in *; auto.
Qed.
@@ -799,7 +798,7 @@ Proof.
intros.
simpl.
destruct a as (k,e); destruct a0 as (k',e').
- destruct (X.compare k k').
+ destruct (X.compare k k') as [Hlt|Heq|Hlt].
inversion_clear Hm.
constructor; auto.
assert (lelistA (ltk (elt:=elt')) (k, e') ((k',e')::m')) by auto.
@@ -868,8 +867,8 @@ Proof.
induction m'.
(* m' = nil *)
intros; destruct a; simpl.
- destruct (X.compare x t0); simpl; auto.
- inversion_clear Hm; clear H0 l Hm' IHm t0.
+ destruct (X.compare x t0) as [Hlt| |Hlt]; simpl; auto.
+ inversion_clear Hm; clear H0 Hlt Hm' IHm t0.
induction m; simpl; auto.
inversion_clear H.
destruct a.
@@ -923,7 +922,7 @@ Proof.
destruct o; destruct o'; simpl in *; try discriminate; auto.
destruct a as (k,(oo,oo')); simpl in *.
inversion_clear H2.
- destruct (X.compare x k); simpl in *.
+ destruct (X.compare x k) as [Hlt|Heq|Hlt]; simpl in *.
(* x < k *)
destruct (f' (oo,oo')); simpl.
elim_comp.
@@ -959,7 +958,7 @@ Proof.
destruct a as (k,(oo,oo')).
simpl.
inversion_clear H2.
- destruct (X.compare x k).
+ destruct (X.compare x k) as [Hlt|Heq|Hlt].
(* x < k *)
unfold f'; simpl.
destruct (f oo oo'); simpl.
@@ -1208,7 +1207,7 @@ Proof.
destruct a as (x,e).
destruct p as (x',e').
unfold equal; simpl.
- destruct (X.compare x x'); simpl; intuition.
+ destruct (X.compare x x') as [Hlt|Heq|Hlt]; simpl; intuition.
unfold cmp at 1.
MD.elim_comp; clear H; simpl.
inversion_clear Hl.
@@ -1245,21 +1244,21 @@ Lemma eq_refl : forall m : t, eq m m.
Proof.
intros (m,Hm); induction m; unfold eq; simpl; auto.
destruct a.
- destruct (X.compare t0 t0); auto.
- apply (MapS.Raw.MX.lt_antirefl l); auto.
+ destruct (X.compare t0 t0) as [Hlt|Heq|Hlt]; auto.
+ apply (MapS.Raw.MX.lt_antirefl Hlt); auto.
split.
apply D.eq_refl.
inversion_clear Hm.
apply (IHm H).
- apply (MapS.Raw.MX.lt_antirefl l); auto.
+ apply (MapS.Raw.MX.lt_antirefl Hlt); auto.
Qed.
-Lemma eq_sym : forall m1 m2 : t, eq m1 m2 -> eq m2 m1.
+Lemma eq_sym : forall m1 m2 : t, eq m1 m2 -> eq m2 m1.
Proof.
intros (m,Hm); induction m;
intros (m', Hm'); destruct m'; unfold eq; simpl;
try destruct a as (x,e); try destruct p as (x',e'); auto.
- destruct (X.compare x x'); MapS.Raw.MX.elim_comp; intuition.
+ destruct (X.compare x x') as [Hlt|Heq|Hlt]; MapS.Raw.MX.elim_comp; intuition.
inversion_clear Hm; inversion_clear Hm'.
apply (IHm H0 (Build_slist H4)); auto.
Qed.
@@ -1272,8 +1271,8 @@ Proof.
try destruct a as (x,e);
try destruct p as (x',e');
try destruct p0 as (x'',e''); try contradiction; auto.
- destruct (X.compare x x');
- destruct (X.compare x' x'');
+ destruct (X.compare x x') as [Hlt|Heq|Hlt];
+ destruct (X.compare x' x'') as [Hlt'|Heq'|Hlt'];
MapS.Raw.MX.elim_comp; intuition.
apply D.eq_trans with e'; auto.
inversion_clear Hm1; inversion_clear Hm2; inversion_clear Hm3.
@@ -1288,8 +1287,8 @@ Proof.
try destruct a as (x,e);
try destruct p as (x',e');
try destruct p0 as (x'',e''); try contradiction; auto.
- destruct (X.compare x x');
- destruct (X.compare x' x'');
+ destruct (X.compare x x') as [Hlt|Heq|Hlt];
+ destruct (X.compare x' x'') as [Hlt'|Heq'|Hlt'];
MapS.Raw.MX.elim_comp; intuition.
left; apply D.lt_trans with e'; auto.
left; apply lt_eq with e'; auto.
@@ -1307,7 +1306,7 @@ Proof.
intros (m2, Hm2); destruct m2; unfold eq, lt; simpl;
try destruct a as (x,e);
try destruct p as (x',e'); try contradiction; auto.
- destruct (X.compare x x'); auto.
+ destruct (X.compare x x') as [Hlt|Heq|Hlt]; auto.
intuition.
exact (D.lt_not_eq H0 H1).
inversion_clear Hm1; inversion_clear Hm2.
diff --git a/theories/FSets/FMapPositive.v b/theories/FSets/FMapPositive.v
index c59f7c22..3eac15b0 100644
--- a/theories/FSets/FMapPositive.v
+++ b/theories/FSets/FMapPositive.v
@@ -8,13 +8,11 @@
(** * FMapPositive : an implementation of FMapInterface for [positive] keys. *)
-Require Import Bool ZArith OrderedType OrderedTypeEx FMapInterface.
+Require Import Bool OrderedType ZArith OrderedType OrderedTypeEx FMapInterface.
Set Implicit Arguments.
Local Open Scope positive_scope.
-
Local Unset Elimination Schemes.
-Local Unset Case Analysis Schemes.
(** This file is an adaptation to the [FMap] framework of a work by
Xavier Leroy and Sandrine Blazy (used for building certified compilers).
@@ -71,7 +69,7 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits.
Module E:=PositiveOrderedTypeBits.
Module ME:=KeyOrderedType E.
- Definition key := positive.
+ Definition key := positive : Type.
Inductive tree (A : Type) :=
| Leaf : tree A
@@ -84,7 +82,7 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits.
Section A.
Variable A:Type.
- Arguments Leaf [A].
+ Arguments Leaf {A}.
Definition empty : t A := Leaf.
@@ -95,7 +93,7 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits.
| _ => false
end.
- Fixpoint find (i : positive) (m : t A) : option A :=
+ Fixpoint find (i : key) (m : t A) : option A :=
match m with
| Leaf => None
| Node l o r =>
@@ -106,7 +104,7 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits.
end
end.
- Fixpoint mem (i : positive) (m : t A) : bool :=
+ Fixpoint mem (i : key) (m : t A) : bool :=
match m with
| Leaf => false
| Node l o r =>
@@ -117,7 +115,7 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits.
end
end.
- Fixpoint add (i : positive) (v : A) (m : t A) : t A :=
+ Fixpoint add (i : key) (v : A) (m : t A) : t A :=
match m with
| Leaf =>
match i with
@@ -133,7 +131,7 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits.
end
end.
- Fixpoint remove (i : positive) (m : t A) : t A :=
+ Fixpoint remove (i : key) (m : t A) : t A :=
match i with
| xH =>
match m with
@@ -165,7 +163,7 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits.
(** [elements] *)
- Fixpoint xelements (m : t A) (i : positive) : list (positive * A) :=
+ Fixpoint xelements (m : t A) (i : key) : list (key * A) :=
match m with
| Leaf => nil
| Node l None r =>
@@ -192,33 +190,33 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits.
Section CompcertSpec.
Theorem gempty:
- forall (i: positive), find i empty = None.
+ forall (i: key), find i empty = None.
Proof.
destruct i; simpl; auto.
Qed.
Theorem gss:
- forall (i: positive) (x: A) (m: t A), find i (add i x m) = Some x.
+ forall (i: key) (x: A) (m: t A), find i (add i x m) = Some x.
Proof.
induction i; destruct m; simpl; auto.
Qed.
- Lemma gleaf : forall (i : positive), find i (Leaf : t A) = None.
+ Lemma gleaf : forall (i : key), find i (Leaf : t A) = None.
Proof. exact gempty. Qed.
Theorem gso:
- forall (i j: positive) (x: A) (m: t A),
+ forall (i j: key) (x: A) (m: t A),
i <> j -> find i (add j x m) = find i m.
Proof.
induction i; intros; destruct j; destruct m; simpl;
try rewrite <- (gleaf i); auto; try apply IHi; congruence.
Qed.
- Lemma rleaf : forall (i : positive), remove i (Leaf : t A) = Leaf.
+ Lemma rleaf : forall (i : key), remove i Leaf = Leaf.
Proof. destruct i; simpl; auto. Qed.
Theorem grs:
- forall (i: positive) (m: t A), find i (remove i m) = None.
+ forall (i: key) (m: t A), find i (remove i m) = None.
Proof.
induction i; destruct m.
simpl; auto.
@@ -238,7 +236,7 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits.
Qed.
Theorem gro:
- forall (i j: positive) (m: t A),
+ forall (i j: key) (m: t A),
i <> j -> find i (remove j m) = find i m.
Proof.
induction i; intros; destruct j; destruct m;
@@ -267,11 +265,11 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits.
Qed.
Lemma xelements_correct:
- forall (m: t A) (i j : positive) (v: A),
+ forall (m: t A) (i j : key) (v: A),
find i m = Some v -> List.In (append j i, v) (xelements m j).
Proof.
induction m; intros.
- rewrite (gleaf i) in H; congruence.
+ rewrite (gleaf i) in H; discriminate.
destruct o; destruct i; simpl; simpl in H.
rewrite append_assoc_1; apply in_or_app; right; apply in_cons;
apply IHm2; auto.
@@ -284,14 +282,14 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits.
Qed.
Theorem elements_correct:
- forall (m: t A) (i: positive) (v: A),
+ forall (m: t A) (i: key) (v: A),
find i m = Some v -> List.In (i, v) (elements m).
Proof.
intros m i v H.
exact (xelements_correct m i xH H).
Qed.
- Fixpoint xfind (i j : positive) (m : t A) : option A :=
+ Fixpoint xfind (i j : key) (m : t A) : option A :=
match i, j with
| _, xH => find i m
| xO ii, xO jj => xfind ii jj m
@@ -300,7 +298,7 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits.
end.
Lemma xfind_left :
- forall (j i : positive) (m1 m2 : t A) (o : option A) (v : A),
+ forall (j i : key) (m1 m2 : t A) (o : option A) (v : A),
xfind i (append j (xO xH)) m1 = Some v -> xfind i j (Node m1 o m2) = Some v.
Proof.
induction j; intros; destruct i; simpl; simpl in H; auto; try congruence.
@@ -308,7 +306,7 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits.
Qed.
Lemma xelements_ii :
- forall (m: t A) (i j : positive) (v: A),
+ forall (m: t A) (i j : key) (v: A),
List.In (xI i, v) (xelements m (xI j)) -> List.In (i, v) (xelements m j).
Proof.
induction m.
@@ -324,7 +322,7 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits.
Qed.
Lemma xelements_io :
- forall (m: t A) (i j : positive) (v: A),
+ forall (m: t A) (i j : key) (v: A),
~List.In (xI i, v) (xelements m (xO j)).
Proof.
induction m.
@@ -339,7 +337,7 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits.
Qed.
Lemma xelements_oo :
- forall (m: t A) (i j : positive) (v: A),
+ forall (m: t A) (i j : key) (v: A),
List.In (xO i, v) (xelements m (xO j)) -> List.In (i, v) (xelements m j).
Proof.
induction m.
@@ -355,7 +353,7 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits.
Qed.
Lemma xelements_oi :
- forall (m: t A) (i j : positive) (v: A),
+ forall (m: t A) (i j : key) (v: A),
~List.In (xO i, v) (xelements m (xI j)).
Proof.
induction m.
@@ -370,7 +368,7 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits.
Qed.
Lemma xelements_ih :
- forall (m1 m2: t A) (o: option A) (i : positive) (v: A),
+ forall (m1 m2: t A) (o: option A) (i : key) (v: A),
List.In (xI i, v) (xelements (Node m1 o m2) xH) -> List.In (i, v) (xelements m2 xH).
Proof.
destruct o; simpl; intros; destruct (in_app_or _ _ _ H).
@@ -383,7 +381,7 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits.
Qed.
Lemma xelements_oh :
- forall (m1 m2: t A) (o: option A) (i : positive) (v: A),
+ forall (m1 m2: t A) (o: option A) (i : key) (v: A),
List.In (xO i, v) (xelements (Node m1 o m2) xH) -> List.In (i, v) (xelements m1 xH).
Proof.
destruct o; simpl; intros; destruct (in_app_or _ _ _ H).
@@ -396,7 +394,7 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits.
Qed.
Lemma xelements_hi :
- forall (m: t A) (i : positive) (v: A),
+ forall (m: t A) (i : key) (v: A),
~List.In (xH, v) (xelements m (xI i)).
Proof.
induction m; intros.
@@ -411,7 +409,7 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits.
Qed.
Lemma xelements_ho :
- forall (m: t A) (i : positive) (v: A),
+ forall (m: t A) (i : key) (v: A),
~List.In (xH, v) (xelements m (xO i)).
Proof.
induction m; intros.
@@ -426,13 +424,13 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits.
Qed.
Lemma find_xfind_h :
- forall (m: t A) (i: positive), find i m = xfind i xH m.
+ forall (m: t A) (i: key), find i m = xfind i xH m.
Proof.
destruct i; simpl; auto.
Qed.
Lemma xelements_complete:
- forall (i j : positive) (m: t A) (v: A),
+ forall (i j : key) (m: t A) (v: A),
List.In (i, v) (xelements m j) -> xfind i j m = Some v.
Proof.
induction i; simpl; intros; destruct j; simpl.
@@ -460,7 +458,7 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits.
Qed.
Theorem elements_complete:
- forall (m: t A) (i: positive) (v: A),
+ forall (m: t A) (i: key) (v: A),
List.In (i, v) (elements m) -> find i m = Some v.
Proof.
intros m i v H.
@@ -481,22 +479,22 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits.
End CompcertSpec.
- Definition MapsTo (i:positive)(v:A)(m:t A) := find i m = Some v.
+ Definition MapsTo (i:key)(v:A)(m:t A) := find i m = Some v.
- Definition In (i:positive)(m:t A) := exists e:A, MapsTo i e m.
+ Definition In (i:key)(m:t A) := exists e:A, MapsTo i e m.
- Definition Empty m := forall (a : positive)(e:A) , ~ MapsTo a e m.
+ Definition Empty m := forall (a : key)(e:A) , ~ MapsTo a e m.
- Definition eq_key (p p':positive*A) := E.eq (fst p) (fst p').
+ Definition eq_key (p p':key*A) := E.eq (fst p) (fst p').
- Definition eq_key_elt (p p':positive*A) :=
+ Definition eq_key_elt (p p':key*A) :=
E.eq (fst p) (fst p') /\ (snd p) = (snd p').
- Definition lt_key (p p':positive*A) := E.lt (fst p) (fst p').
+ Definition lt_key (p p':key*A) := E.lt (fst p) (fst p').
- Global Program Instance eqk_equiv : Equivalence eq_key.
- Global Program Instance eqke_equiv : Equivalence eq_key_elt.
- Global Program Instance ltk_strorder : StrictOrder lt_key.
+ Global Instance eqk_equiv : Equivalence eq_key := _.
+ Global Instance eqke_equiv : Equivalence eq_key_elt := _.
+ Global Instance ltk_strorder : StrictOrder lt_key := _.
Lemma mem_find :
forall m x, mem x m = match find x m with None => false | _ => true end.
@@ -717,8 +715,8 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits.
Lemma elements_3w : NoDupA eq_key (elements m).
Proof.
- change eq_key with (@ME.eqk A).
- apply ME.Sort_NoDupA; apply elements_3; auto.
+ apply ME.Sort_NoDupA.
+ apply elements_3.
Qed.
End FMapSpec.
@@ -729,9 +727,9 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits.
Section Mapi.
- Variable f : positive -> A -> B.
+ Variable f : key -> A -> B.
- Fixpoint xmapi (m : t A) (i : positive) : t B :=
+ Fixpoint xmapi (m : t A) (i : key) : t B :=
match m with
| Leaf => @Leaf B
| Node l o r => Node (xmapi l (append i (xO xH)))
@@ -748,7 +746,7 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits.
End A.
Lemma xgmapi:
- forall (A B: Type) (f: positive -> A -> B) (i j : positive) (m: t A),
+ forall (A B: Type) (f: key -> A -> B) (i j : key) (m: t A),
find i (xmapi f m j) = option_map (f (append j i)) (find i m).
Proof.
induction i; intros; destruct m; simpl; auto.
@@ -758,7 +756,7 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits.
Qed.
Theorem gmapi:
- forall (A B: Type) (f: positive -> A -> B) (i: positive) (m: t A),
+ forall (A B: Type) (f: key -> A -> B) (i: key) (m: t A),
find i (mapi f m) = option_map (f i) (find i m).
Proof.
intros.
@@ -814,7 +812,7 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits.
Variable A B C : Type.
Variable f : option A -> option B -> option C.
- Arguments Leaf [A].
+ Arguments Leaf {A}.
Fixpoint xmap2_l (m : t A) : t C :=
match m with
@@ -822,7 +820,7 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits.
| Node l o r => Node (xmap2_l l) (f o None) (xmap2_l r)
end.
- Lemma xgmap2_l : forall (i : positive) (m : t A),
+ Lemma xgmap2_l : forall (i : key) (m : t A),
f None None = None -> find i (xmap2_l m) = f (find i m) None.
Proof.
induction i; intros; destruct m; simpl; auto.
@@ -834,7 +832,7 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits.
| Node l o r => Node (xmap2_r l) (f None o) (xmap2_r r)
end.
- Lemma xgmap2_r : forall (i : positive) (m : t B),
+ Lemma xgmap2_r : forall (i : key) (m : t B),
f None None = None -> find i (xmap2_r m) = f None (find i m).
Proof.
induction i; intros; destruct m; simpl; auto.
@@ -850,7 +848,7 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits.
end
end.
- Lemma gmap2: forall (i: positive)(m1:t A)(m2: t B),
+ Lemma gmap2: forall (i: key)(m1:t A)(m2: t B),
f None None = None ->
find i (_map2 m1 m2) = f (find i m1) (find i m2).
Proof.
@@ -898,11 +896,11 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits.
Section Fold.
Variables A B : Type.
- Variable f : positive -> A -> B -> B.
+ Variable f : key -> A -> B -> B.
- Fixpoint xfoldi (m : t A) (v : B) (i : positive) :=
+ Fixpoint xfoldi (m : t A) (v : B) (i : key) :=
match m with
- | Leaf => v
+ | Leaf _ => v
| Node l (Some x) r =>
xfoldi r (f i x (xfoldi l v (append i 2))) (append i 3)
| Node l None r =>
@@ -940,8 +938,8 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits.
Fixpoint equal (A:Type)(cmp : A -> A -> bool)(m1 m2 : t A) : bool :=
match m1, m2 with
- | Leaf, _ => is_empty m2
- | _, Leaf => is_empty m1
+ | Leaf _, _ => is_empty m2
+ | _, Leaf _ => is_empty m1
| Node l1 o1 r1, Node l2 o2 r2 =>
(match o1, o2 with
| None, None => true
@@ -1072,16 +1070,16 @@ Module PositiveMapAdditionalFacts.
(* Derivable from the Map interface *)
Theorem gsspec:
- forall (A:Type)(i j: positive) (x: A) (m: t A),
+ forall (A:Type)(i j: key) (x: A) (m: t A),
find i (add j x m) = if E.eq_dec i j then Some x else find i m.
Proof.
intros.
- destruct (E.eq_dec i j); [ rewrite e; apply gss | apply gso; auto ].
+ destruct (E.eq_dec i j) as [ ->|]; [ apply gss | apply gso; auto ].
Qed.
(* Not derivable from the Map interface *)
Theorem gsident:
- forall (A:Type)(i: positive) (m: t A) (v: A),
+ forall (A:Type)(i: key) (m: t A) (v: A),
find i m = Some v -> add i v m = m.
Proof.
induction i; intros; destruct m; simpl; simpl in H; try congruence.
@@ -1120,4 +1118,3 @@ Module PositiveMapAdditionalFacts.
Qed.
End PositiveMapAdditionalFacts.
-
diff --git a/theories/FSets/FMapWeakList.v b/theories/FSets/FMapWeakList.v
index 6c1e8ca8..0f11dd7a 100644
--- a/theories/FSets/FMapWeakList.v
+++ b/theories/FSets/FMapWeakList.v
@@ -146,9 +146,10 @@ Proof.
induction m; simpl; auto; destruct a; intros.
inversion_clear Hm.
rewrite (IHm H1 x x'); auto.
- destruct (X.eq_dec x t0); destruct (X.eq_dec x' t0); trivial.
- elim n; apply X.eq_trans with x; auto.
- elim n; apply X.eq_trans with x'; auto.
+ destruct (X.eq_dec x t0) as [|Hneq]; destruct (X.eq_dec x' t0) as [|?Hneq'];
+ trivial.
+ elim Hneq'; apply X.eq_trans with x; auto.
+ elim Hneq; apply X.eq_trans with x'; auto.
Qed.
(** * [add] *)
@@ -600,18 +601,18 @@ Definition combine_l (m:t elt)(m':t elt') : t oee' :=
Definition combine_r (m:t elt)(m':t elt') : t oee' :=
mapi (fun k e' => (find k m, Some e')) m'.
-Definition fold_right_pair (A B C:Type)(f:A->B->C->C)(l:list (A*B))(i:C) :=
- List.fold_right (fun p => f (fst p) (snd p)) i l.
+Definition fold_right_pair (A B C:Type)(f:A->B->C->C) :=
+ List.fold_right (fun p => f (fst p) (snd p)).
Definition combine (m:t elt)(m':t elt') : t oee' :=
let l := combine_l m m' in
let r := combine_r m m' in
- fold_right_pair (add (elt:=oee')) l r.
+ fold_right_pair (add (elt:=oee')) r l.
Lemma fold_right_pair_NoDup :
forall l r (Hl: NoDupA (eqk (elt:=oee')) l)
(Hl: NoDupA (eqk (elt:=oee')) r),
- NoDupA (eqk (elt:=oee')) (fold_right_pair (add (elt:=oee')) l r).
+ NoDupA (eqk (elt:=oee')) (fold_right_pair (add (elt:=oee')) r l).
Proof.
induction l; simpl; auto.
destruct a; simpl; auto.
@@ -733,7 +734,7 @@ Definition option_cons (A:Type)(k:key)(o:option A)(l:list (key*A)) :=
Definition map2 m m' :=
let m0 : t oee' := combine m m' in
let m1 : t (option elt'') := map (fun p => f (fst p) (snd p)) m0 in
- fold_right_pair (option_cons (A:=elt'')) m1 nil.
+ fold_right_pair (option_cons (A:=elt'')) nil m1.
Lemma map2_NoDup :
forall m (Hm:NoDupA (@eqk elt) m) m' (Hm':NoDupA (@eqk elt') m'),
@@ -787,14 +788,14 @@ Proof.
destruct o; destruct o'; simpl in *; try discriminate; auto.
destruct a as (k,(oo,oo')); simpl in *.
inversion_clear H2.
- destruct (X.eq_dec x k); simpl in *.
+ destruct (X.eq_dec x k) as [|Hneq]; simpl in *.
(* x = k *)
assert (at_least_one_then_f o o' = f oo oo').
destruct o; destruct o'; simpl in *; inversion_clear H; auto.
rewrite H2.
unfold f'; simpl.
destruct (f oo oo'); simpl.
- destruct (X.eq_dec x k); try contradict n; auto.
+ destruct (X.eq_dec x k) as [|Hneq]; try contradict Hneq; auto.
destruct (IHm0 H1) as (_,H4); apply H4; auto.
case_eq (find x m0); intros; auto.
elim H0.
@@ -804,7 +805,7 @@ Proof.
(* k < x *)
unfold f'; simpl.
destruct (f oo oo'); simpl.
- destruct (X.eq_dec x k); [ contradict n; auto | auto].
+ destruct (X.eq_dec x k); [ contradict Hneq; auto | auto].
destruct (IHm0 H1) as (H3,_); apply H3; auto.
destruct (IHm0 H1) as (H3,_); apply H3; auto.
@@ -812,13 +813,13 @@ Proof.
destruct a as (k,(oo,oo')).
simpl.
inversion_clear H2.
- destruct (X.eq_dec x k).
+ destruct (X.eq_dec x k) as [|Hneq].
(* x = k *)
discriminate.
(* k < x *)
unfold f'; simpl.
destruct (f oo oo'); simpl.
- destruct (X.eq_dec x k); [ contradict n; auto | auto].
+ destruct (X.eq_dec x k); [ contradict Hneq; auto | auto].
destruct (IHm0 H1) as (_,H4); apply H4; auto.
destruct (IHm0 H1) as (_,H4); apply H4; auto.
Qed.
diff --git a/theories/FSets/FSetBridge.v b/theories/FSets/FSetBridge.v
index 1ac544e1..97f140b3 100644
--- a/theories/FSets/FSetBridge.v
+++ b/theories/FSets/FSetBridge.v
@@ -284,7 +284,7 @@ Module DepOfNodep (Import M: S) <: Sdep with Module E := M.E.
Lemma choose_equal : forall s s', Equal s s' ->
match choose s, choose s' with
- | inleft (exist x _), inleft (exist x' _) => E.eq x x'
+ | inleft (exist _ x _), inleft (exist _ x' _) => E.eq x x'
| inright _, inright _ => True
| _, _ => False
end.
@@ -423,7 +423,7 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E.
Definition choose (s : t) : option elt :=
match choose s with
- | inleft (exist x _) => Some x
+ | inleft (exist _ x _) => Some x
| inright _ => None
end.
@@ -472,7 +472,7 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E.
Definition min_elt (s : t) : option elt :=
match min_elt s with
- | inleft (exist x _) => Some x
+ | inleft (exist _ x _) => Some x
| inright _ => None
end.
@@ -500,7 +500,7 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E.
Definition max_elt (s : t) : option elt :=
match max_elt s with
- | inleft (exist x _) => Some x
+ | inleft (exist _ x _) => Some x
| inright _ => None
end.
@@ -673,24 +673,24 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E.
forall (s : t) (x : elt) (f : elt -> bool),
compat_bool E.eq f -> In x (filter f s) -> In x s.
Proof.
- intros s x f; unfold filter; case M.filter; intuition.
- generalize (i (compat_P_aux H)); firstorder.
+ intros s x f; unfold filter; case M.filter as (x0,Hiff); intuition.
+ generalize (Hiff (compat_P_aux H)); firstorder.
Qed.
Lemma filter_2 :
forall (s : t) (x : elt) (f : elt -> bool),
compat_bool E.eq f -> In x (filter f s) -> f x = true.
Proof.
- intros s x f; unfold filter; case M.filter; intuition.
- generalize (i (compat_P_aux H)); firstorder.
+ intros s x f; unfold filter; case M.filter as (x0,Hiff); intuition.
+ generalize (Hiff (compat_P_aux H)); firstorder.
Qed.
Lemma filter_3 :
forall (s : t) (x : elt) (f : elt -> bool),
compat_bool E.eq f -> In x s -> f x = true -> In x (filter f s).
Proof.
- intros s x f; unfold filter; case M.filter; intuition.
- generalize (i (compat_P_aux H)); firstorder.
+ intros s x f; unfold filter; case M.filter as (x0,Hiff); intuition.
+ generalize (Hiff (compat_P_aux H)); firstorder.
Qed.
Definition for_all (f : elt -> bool) (s : t) : bool :=
diff --git a/theories/FSets/FSetCompat.v b/theories/FSets/FSetCompat.v
index 6b3d86d3..b1769da3 100644
--- a/theories/FSets/FSetCompat.v
+++ b/theories/FSets/FSetCompat.v
@@ -283,6 +283,8 @@ Module Update_WSets
Lemma is_empty_spec : is_empty s = true <-> Empty s.
Proof. intros; symmetry; apply MF.is_empty_iff. Qed.
+
+ Declare Equivalent Keys In M.In.
Lemma add_spec : In y (add x s) <-> E.eq y x \/ In y s.
Proof. intros. rewrite MF.add_iff. intuition. Qed.
diff --git a/theories/FSets/FSetDecide.v b/theories/FSets/FSetDecide.v
index f64df9fe..ad067eb3 100644
--- a/theories/FSets/FSetDecide.v
+++ b/theories/FSets/FSetDecide.v
@@ -15,7 +15,7 @@
(** This file implements a decision procedure for a certain
class of propositions involving finite sets. *)
-Require Import Decidable DecidableTypeEx FSetFacts.
+Require Import Decidable Setoid DecidableTypeEx FSetFacts.
(** First, a version for Weak Sets in functorial presentation *)
@@ -115,8 +115,8 @@ the above form:
not affect the namespace if you import the enclosing
module [Decide]. *)
Module FSetLogicalFacts.
- Require Export Decidable.
- Require Export Setoid.
+ Export Decidable.
+ Export Setoid.
(** ** Lemmas and Tactics About Decidable Propositions *)
diff --git a/theories/FSets/FSetEqProperties.v b/theories/FSets/FSetEqProperties.v
index ac495c04..f2f4cc2c 100644
--- a/theories/FSets/FSetEqProperties.v
+++ b/theories/FSets/FSetEqProperties.v
@@ -822,7 +822,7 @@ Proof.
intros.
rewrite for_all_exists in H; auto.
rewrite negb_true_iff in H.
-elim (for_all_mem_4 (fun x =>negb (f x)) Comp' s);intros;auto.
+destruct (for_all_mem_4 (fun x =>negb (f x)) Comp' s) as (x,p); auto.
elim p;intros.
exists x;split;auto.
rewrite <-negb_false_iff; auto.
diff --git a/theories/FSets/FSetInterface.v b/theories/FSets/FSetInterface.v
index a0361119..c791f49a 100644
--- a/theories/FSets/FSetInterface.v
+++ b/theories/FSets/FSetInterface.v
@@ -497,7 +497,7 @@ Module Type Sdep.
in the dependent version of [choose], so we leave it separate. *)
Parameter choose_equal : forall s s', Equal s s' ->
match choose s, choose s' with
- | inleft (exist x _), inleft (exist x' _) => E.eq x x'
+ | inleft (exist _ x _), inleft (exist _ x' _) => E.eq x x'
| inright _, inright _ => True
| _, _ => False
end.
diff --git a/theories/FSets/FSetPositive.v b/theories/FSets/FSetPositive.v
index e5d55ac5..7398c6d6 100644
--- a/theories/FSets/FSetPositive.v
+++ b/theories/FSets/FSetPositive.v
@@ -19,20 +19,15 @@
Require Import Bool BinPos OrderedType OrderedTypeEx FSetInterface.
Set Implicit Arguments.
-
Local Open Scope lazy_bool_scope.
Local Open Scope positive_scope.
-
Local Unset Elimination Schemes.
-Local Unset Case Analysis Schemes.
-Local Unset Boolean Equality Schemes.
-
Module PositiveSet <: S with Module E:=PositiveOrderedTypeBits.
Module E:=PositiveOrderedTypeBits.
- Definition elt := positive.
+ Definition elt := positive : Type.
Inductive tree :=
| Leaf : tree
@@ -40,9 +35,9 @@ Module PositiveSet <: S with Module E:=PositiveOrderedTypeBits.
Scheme tree_ind := Induction for tree Sort Prop.
- Definition t := tree.
+ Definition t := tree : Type.
- Definition empty := Leaf.
+ Definition empty : t := Leaf.
Fixpoint is_empty (m : t) : bool :=
match m with
@@ -50,7 +45,7 @@ Module PositiveSet <: S with Module E:=PositiveOrderedTypeBits.
| Node l b r => negb b &&& is_empty l &&& is_empty r
end.
- Fixpoint mem (i : positive) (m : t) : bool :=
+ Fixpoint mem (i : elt) (m : t) {struct m} : bool :=
match m with
| Leaf => false
| Node l o r =>
@@ -61,7 +56,7 @@ Module PositiveSet <: S with Module E:=PositiveOrderedTypeBits.
end
end.
- Fixpoint add (i : positive) (m : t) : t :=
+ Fixpoint add (i : elt) (m : t) : t :=
match m with
| Leaf =>
match i with
@@ -81,13 +76,13 @@ Module PositiveSet <: S with Module E:=PositiveOrderedTypeBits.
(** helper function to avoid creating empty trees that are not leaves *)
- Definition node l (b: bool) r :=
+ Definition node (l : t) (b: bool) (r : t) : t :=
if b then Node l b r else
match l,r with
| Leaf,Leaf => Leaf
| _,_ => Node l false r end.
- Fixpoint remove (i : positive) (m : t) : t :=
+ Fixpoint remove (i : elt) (m : t) {struct m} : t :=
match m with
| Leaf => Leaf
| Node l o r =>
@@ -98,7 +93,7 @@ Module PositiveSet <: S with Module E:=PositiveOrderedTypeBits.
end
end.
- Fixpoint union (m m': t) :=
+ Fixpoint union (m m': t) : t :=
match m with
| Leaf => m'
| Node l o r =>
@@ -108,7 +103,7 @@ Module PositiveSet <: S with Module E:=PositiveOrderedTypeBits.
end
end.
- Fixpoint inter (m m': t) :=
+ Fixpoint inter (m m': t) : t :=
match m with
| Leaf => Leaf
| Node l o r =>
@@ -118,7 +113,7 @@ Module PositiveSet <: S with Module E:=PositiveOrderedTypeBits.
end
end.
- Fixpoint diff (m m': t) :=
+ Fixpoint diff (m m': t) : t :=
match m with
| Leaf => Leaf
| Node l o r =>
@@ -150,7 +145,7 @@ Module PositiveSet <: S with Module E:=PositiveOrderedTypeBits.
(** reverses [y] and concatenate it with [x] *)
- Fixpoint rev_append y x :=
+ Fixpoint rev_append (y x : elt) : elt :=
match y with
| 1 => x
| y~1 => rev_append y x~1
@@ -161,8 +156,8 @@ Module PositiveSet <: S with Module E:=PositiveOrderedTypeBits.
Section Fold.
- Variables B : Type.
- Variable f : positive -> B -> B.
+ Variable B : Type.
+ Variable f : elt -> B -> B.
(** the additional argument, [i], records the current path, in
reverse order (this should be more efficient: we reverse this argument
@@ -170,7 +165,7 @@ Module PositiveSet <: S with Module E:=PositiveOrderedTypeBits.
we also use this convention in all functions below
*)
- Fixpoint xfold (m : t) (v : B) (i : positive) :=
+ Fixpoint xfold (m : t) (v : B) (i : elt) :=
match m with
| Leaf => v
| Node l true r =>
@@ -184,9 +179,9 @@ Module PositiveSet <: S with Module E:=PositiveOrderedTypeBits.
Section Quantifiers.
- Variable f : positive -> bool.
+ Variable f : elt -> bool.
- Fixpoint xforall (m : t) (i : positive) :=
+ Fixpoint xforall (m : t) (i : elt) :=
match m with
| Leaf => true
| Node l o r =>
@@ -194,21 +189,21 @@ Module PositiveSet <: S with Module E:=PositiveOrderedTypeBits.
end.
Definition for_all m := xforall m 1.
- Fixpoint xexists (m : t) (i : positive) :=
+ Fixpoint xexists (m : t) (i : elt) :=
match m with
| Leaf => false
| Node l o r => (o &&& f (rev i)) ||| xexists r i~1 ||| xexists l i~0
end.
Definition exists_ m := xexists m 1.
- Fixpoint xfilter (m : t) (i : positive) :=
+ Fixpoint xfilter (m : t) (i : elt) : t :=
match m with
| Leaf => Leaf
| Node l o r => node (xfilter l i~0) (o &&& f (rev i)) (xfilter r i~1)
end.
Definition filter m := xfilter m 1.
- Fixpoint xpartition (m : t) (i : positive) :=
+ Fixpoint xpartition (m : t) (i : elt) : t * t :=
match m with
| Leaf => (Leaf,Leaf)
| Node l o r =>
@@ -226,7 +221,7 @@ Module PositiveSet <: S with Module E:=PositiveOrderedTypeBits.
(** uses [a] to accumulate values rather than doing a lot of concatenations *)
- Fixpoint xelements (m : t) (i : positive) (a: list positive) :=
+ Fixpoint xelements (m : t) (i : elt) (a: list elt) :=
match m with
| Leaf => a
| Node l false r => xelements l i~0 (xelements r i~1 a)
@@ -250,7 +245,7 @@ Module PositiveSet <: S with Module E:=PositiveOrderedTypeBits.
(** would it be more efficient to use a path like in the above functions ? *)
- Fixpoint choose (m: t) :=
+ Fixpoint choose (m: t) : option elt :=
match m with
| Leaf => None
| Node l o r => if o then Some 1 else
@@ -260,7 +255,7 @@ Module PositiveSet <: S with Module E:=PositiveOrderedTypeBits.
end
end.
- Fixpoint min_elt (m: t) :=
+ Fixpoint min_elt (m: t) : option elt :=
match m with
| Leaf => None
| Node l o r =>
@@ -270,7 +265,7 @@ Module PositiveSet <: S with Module E:=PositiveOrderedTypeBits.
end
end.
- Fixpoint max_elt (m: t) :=
+ Fixpoint max_elt (m: t) : option elt :=
match m with
| Leaf => None
| Node l o r =>
@@ -311,6 +306,9 @@ Module PositiveSet <: S with Module E:=PositiveOrderedTypeBits.
Notation "s [<=] t" := (Subset s t) (at level 70, no associativity).
Definition eq := Equal.
+
+ Declare Equivalent Keys Equal eq.
+
Definition lt m m' := compare_fun m m' = Lt.
(** Specification of [In] *)
@@ -355,10 +353,7 @@ Module PositiveSet <: S with Module E:=PositiveOrderedTypeBits.
case o; trivial.
destruct l; trivial.
destruct r; trivial.
- symmetry. destruct x.
- apply mem_Leaf.
- apply mem_Leaf.
- reflexivity.
+ now destruct x.
Qed.
Local Opaque node.
@@ -367,8 +362,7 @@ Module PositiveSet <: S with Module E:=PositiveOrderedTypeBits.
Lemma is_empty_spec: forall s, Empty s <-> is_empty s = true.
Proof.
unfold Empty, In.
- induction s as [|l IHl o r IHr]; simpl.
- setoid_rewrite mem_Leaf. firstorder.
+ induction s as [|l IHl o r IHr]; simpl. now split.
rewrite <- 2andb_lazy_alt, 2andb_true_iff, <- IHl, <- IHr. clear IHl IHr.
destruct o; simpl; split.
intro H. elim (H 1). reflexivity.
@@ -759,7 +753,7 @@ Module PositiveSet <: S with Module E:=PositiveOrderedTypeBits.
Proof. intros. rewrite diff_spec. split; assumption. Qed.
(** Specification of [fold] *)
-
+
Lemma fold_1: forall s (A : Type) (i : A) (f : elt -> A -> A),
fold f s i = fold_left (fun a e => f e a) (elements s) i.
Proof.
@@ -807,15 +801,15 @@ Module PositiveSet <: S with Module E:=PositiveOrderedTypeBits.
rewrite <- andb_lazy_alt. apply andb_true_iff.
Qed.
- Lemma filter_1 : forall s x f, compat_bool E.eq f ->
+ Lemma filter_1 : forall s x f, @compat_bool elt E.eq f ->
In x (filter f s) -> In x s.
Proof. unfold filter. intros s x f _. rewrite xfilter_spec. tauto. Qed.
- Lemma filter_2 : forall s x f, compat_bool E.eq f ->
+ Lemma filter_2 : forall s x f, @compat_bool elt E.eq f ->
In x (filter f s) -> f x = true.
Proof. unfold filter. intros s x f _. rewrite xfilter_spec. tauto. Qed.
- Lemma filter_3 : forall s x f, compat_bool E.eq f -> In x s ->
+ Lemma filter_3 : forall s x f, @compat_bool elt E.eq f -> In x s ->
f x = true -> In x (filter f s).
Proof. unfold filter. intros s x f _. rewrite xfilter_spec. tauto. Qed.
@@ -826,8 +820,7 @@ Module PositiveSet <: S with Module E:=PositiveOrderedTypeBits.
xforall f s i = true <-> For_all (fun x => f (i@x) = true) s.
Proof.
unfold For_all, In. intro f.
- induction s as [|l IHl o r IHr]; intros i; simpl.
- setoid_rewrite mem_Leaf. intuition discriminate.
+ induction s as [|l IHl o r IHr]; intros i; simpl. now split.
rewrite <- 2andb_lazy_alt, <- orb_lazy_alt, 2 andb_true_iff.
rewrite IHl, IHr. clear IHl IHr.
split.
@@ -841,11 +834,11 @@ Module PositiveSet <: S with Module E:=PositiveOrderedTypeBits.
apply H. assumption.
Qed.
- Lemma for_all_1 : forall s f, compat_bool E.eq f ->
+ Lemma for_all_1 : forall s f, @compat_bool elt E.eq f ->
For_all (fun x => f x = true) s -> for_all f s = true.
Proof. intros s f _. unfold for_all. rewrite xforall_spec. trivial. Qed.
- Lemma for_all_2 : forall s f, compat_bool E.eq f ->
+ Lemma for_all_2 : forall s f, @compat_bool elt E.eq f ->
for_all f s = true -> For_all (fun x => f x = true) s.
Proof. intros s f _. unfold for_all. rewrite xforall_spec. trivial. Qed.
@@ -857,7 +850,7 @@ Module PositiveSet <: S with Module E:=PositiveOrderedTypeBits.
Proof.
unfold Exists, In. intro f.
induction s as [|l IHl o r IHr]; intros i; simpl.
- setoid_rewrite mem_Leaf. firstorder.
+ split; [ discriminate | now intros [ _ [? _]]].
rewrite <- 2orb_lazy_alt, 2orb_true_iff, <- andb_lazy_alt, andb_true_iff.
rewrite IHl, IHr. clear IHl IHr.
split.
@@ -868,11 +861,11 @@ Module PositiveSet <: S with Module E:=PositiveOrderedTypeBits.
intros [[x|x|] H]; eauto.
Qed.
- Lemma exists_1 : forall s f, compat_bool E.eq f ->
+ Lemma exists_1 : forall s f, @compat_bool elt E.eq f ->
Exists (fun x => f x = true) s -> exists_ f s = true.
Proof. intros s f _. unfold exists_. rewrite xexists_spec. trivial. Qed.
- Lemma exists_2 : forall s f, compat_bool E.eq f ->
+ Lemma exists_2 : forall s f, @compat_bool elt E.eq f ->
exists_ f s = true -> Exists (fun x => f x = true) s.
Proof. intros s f _. unfold exists_. rewrite xexists_spec. trivial. Qed.
@@ -888,11 +881,11 @@ Module PositiveSet <: S with Module E:=PositiveOrderedTypeBits.
destruct o; simpl; rewrite IHl, IHr; reflexivity.
Qed.
- Lemma partition_1 : forall s f, compat_bool E.eq f ->
+ Lemma partition_1 : forall s f, @compat_bool elt E.eq f ->
Equal (fst (partition f s)) (filter f s).
Proof. intros. rewrite partition_filter. apply eq_refl. Qed.
- Lemma partition_2 : forall s f, compat_bool E.eq f ->
+ Lemma partition_2 : forall s f, @compat_bool elt E.eq f ->
Equal (snd (partition f s)) (filter (fun x => negb (f x)) s).
Proof. intros. rewrite partition_filter. apply eq_refl. Qed.
@@ -909,7 +902,7 @@ Module PositiveSet <: S with Module E:=PositiveOrderedTypeBits.
induction s as [|l IHl o r IHr]; simpl.
intros. split; intro H.
left. assumption.
- destruct H as [H|[x [Hx Hx']]]. assumption. elim (empty_1 Hx').
+ destruct H as [H|[x [Hx Hx']]]. assumption. discriminate.
intros j acc y. case o.
rewrite IHl. rewrite InA_cons. rewrite IHr. clear IHl IHr. split.
@@ -1000,7 +993,7 @@ Module PositiveSet <: S with Module E:=PositiveOrderedTypeBits.
constructor.
intros x H. apply E.lt_not_eq in H. apply H. reflexivity.
intro. apply E.lt_trans.
- intros ? ? <- ? ? <-. reflexivity.
+ solve_proper.
apply elements_3.
Qed.
@@ -1111,7 +1104,7 @@ Module PositiveSet <: S with Module E:=PositiveOrderedTypeBits.
destruct (min_elt r).
injection H. intros <-. clear H.
destruct y as [z|z|].
- apply (IHr p z); trivial.
+ apply (IHr e z); trivial.
elim (Hp _ H').
discriminate.
discriminate.
@@ -1165,7 +1158,7 @@ Module PositiveSet <: S with Module E:=PositiveOrderedTypeBits.
injection H. intros <-. clear H.
destruct y as [z|z|].
elim (Hp _ H').
- apply (IHl p z); trivial.
+ apply (IHl e z); trivial.
discriminate.
discriminate.
Qed.
diff --git a/theories/FSets/FSetProperties.v b/theories/FSets/FSetProperties.v
index d53ce0c8..25b042ca 100644
--- a/theories/FSets/FSetProperties.v
+++ b/theories/FSets/FSetProperties.v
@@ -995,8 +995,7 @@ Module OrdProperties (M:S).
leb_1, gtb_1, (H0 a) by auto with *.
intuition.
destruct (E.compare a x); intuition.
- right; right; split; auto with *.
- ME.order.
+ fold (~E.lt a x); auto with *.
Qed.
Definition Above x s := forall y, In y s -> E.lt y x.
diff --git a/theories/Init/Datatypes.v b/theories/Init/Datatypes.v
index e7e6ed9e..de615301 100644
--- a/theories/Init/Datatypes.v
+++ b/theories/Init/Datatypes.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -87,7 +87,7 @@ Hint Constructors eq_true : eq_true.
Definition is_true b := b = true.
(** [is_true] can be activated as a coercion by
- (Local) Coercion is_true : bool >-> Prop.
+ ([Local]) [Coercion is_true : bool >-> Sortclass].
*)
(** Additional rewriting lemmas about [eq_true] *)
@@ -143,18 +143,20 @@ Arguments S _%nat.
(********************************************************************)
(** * Container datatypes *)
+(* Set Universe Polymorphism. *)
+
(** [option A] is the extension of [A] with an extra element [None] *)
Inductive option (A:Type) : Type :=
| Some : A -> option A
| None : option A.
-Arguments None [A].
+Arguments None {A}.
-Definition option_map (A B:Type) (f:A->B) o :=
+Definition option_map (A B:Type) (f:A->B) (o : option A) : option B :=
match o with
- | Some a => Some (f a)
- | None => None
+ | Some a => @Some B (f a)
+ | None => @None B
end.
(** [sum A B], written [A + B], is the disjoint sum of [A] and [B] *)
@@ -182,7 +184,8 @@ Notation "( x , y , .. , z )" := (pair .. (pair x y) .. z) : core_scope.
Arguments pair {A B} _ _.
Section projections.
- Variables A B : Type.
+ Context {A : Type} {B : Type}.
+
Definition fst (p:A * B) := match p with
| (x, y) => x
end.
@@ -221,7 +224,7 @@ Inductive list (A : Type) : Type :=
| nil : list A
| cons : A -> list A -> list A.
-Arguments nil [A].
+Arguments nil {A}.
Infix "::" := cons (at level 60, right associativity) : list_scope.
Delimit Scope list_scope with list.
Bind Scope list_scope with list.
@@ -244,8 +247,10 @@ Definition app (A : Type) : list A -> list A -> list A :=
| a :: l1 => a :: app l1 m
end.
+
Infix "++" := app (right associativity, at level 60) : list_scope.
+(* Unset Universe Polymorphism. *)
(********************************************************************)
(** * The comparison datatype *)
@@ -310,6 +315,7 @@ Defined.
Definition CompSpec {A} (eq lt : A->A->Prop)(x y:A) : comparison -> Prop :=
CompareSpec (eq x y) (lt x y) (lt y x).
+
Definition CompSpecT {A} (eq lt : A->A->Prop)(x y:A) : comparison -> Type :=
CompareSpecT (eq x y) (lt x y) (lt y x).
Hint Unfold CompSpec CompSpecT.
@@ -339,6 +345,9 @@ Arguments identity_rect [A] a P f y i.
Definition ID := forall A:Type, A -> A.
Definition id : ID := fun A x => x.
+Definition IDProp := forall A:Prop, A -> A.
+Definition idProp : IDProp := fun A x => x.
+
(* begin hide *)
diff --git a/theories/Init/Logic.v b/theories/Init/Logic.v
index e5f7a78b..d2971552 100644
--- a/theories/Init/Logic.v
+++ b/theories/Init/Logic.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -8,17 +8,23 @@
Set Implicit Arguments.
-Require Import Notations.
+Require Export Notations.
+
+Notation "A -> B" := (forall (_ : A), B) : type_scope.
(** * Propositional connectives *)
(** [True] is the always true proposition *)
+
Inductive True : Prop :=
I : True.
(** [False] is the always false proposition *)
Inductive False : Prop :=.
+(** [proof_admitted] is used to implement the admit tactic *)
+Axiom proof_admitted : False.
+
(** [not A], written [~A], is the negation of [A] *)
Definition not (A:Prop) := A -> False.
@@ -92,6 +98,36 @@ End Equivalence.
Hint Unfold iff: extcore.
+(** Backward direction of the equivalences above does not need assumptions *)
+
+Theorem and_iff_compat_l : forall A B C : Prop,
+ (B <-> C) -> (A /\ B <-> A /\ C).
+Proof.
+ intros ? ? ? [Hl Hr]; split; intros [? ?]; (split; [ assumption | ]);
+ [apply Hl | apply Hr]; assumption.
+Qed.
+
+Theorem and_iff_compat_r : forall A B C : Prop,
+ (B <-> C) -> (B /\ A <-> C /\ A).
+Proof.
+ intros ? ? ? [Hl Hr]; split; intros [? ?]; (split; [ | assumption ]);
+ [apply Hl | apply Hr]; assumption.
+Qed.
+
+Theorem or_iff_compat_l : forall A B C : Prop,
+ (B <-> C) -> (A \/ B <-> A \/ C).
+Proof.
+ intros ? ? ? [Hl Hr]; split; (intros [?|?]; [left; assumption| right]);
+ [apply Hl | apply Hr]; assumption.
+Qed.
+
+Theorem or_iff_compat_r : forall A B C : Prop,
+ (B <-> C) -> (B \/ A <-> C \/ A).
+Proof.
+ intros ? ? ? [Hl Hr]; split; (intros [?|?]; [left| right; assumption]);
+ [apply Hl | apply Hr]; assumption.
+Qed.
+
(** Some equivalences *)
Theorem neg_false : forall A : Prop, ~ A <-> (A <-> False).
@@ -104,73 +140,62 @@ Qed.
Theorem and_cancel_l : forall A B C : Prop,
(B -> A) -> (C -> A) -> ((A /\ B <-> A /\ C) <-> (B <-> C)).
Proof.
- intros; tauto.
+ intros A B C Hl Hr.
+ split; [ | apply and_iff_compat_l]; intros [HypL HypR]; split; intros.
+ + apply HypL; split; [apply Hl | ]; assumption.
+ + apply HypR; split; [apply Hr | ]; assumption.
Qed.
Theorem and_cancel_r : forall A B C : Prop,
(B -> A) -> (C -> A) -> ((B /\ A <-> C /\ A) <-> (B <-> C)).
Proof.
- intros; tauto.
+ intros A B C Hl Hr.
+ split; [ | apply and_iff_compat_r]; intros [HypL HypR]; split; intros.
+ + apply HypL; split; [ | apply Hl ]; assumption.
+ + apply HypR; split; [ | apply Hr ]; assumption.
Qed.
Theorem and_comm : forall A B : Prop, A /\ B <-> B /\ A.
Proof.
- intros; tauto.
+ intros; split; intros [? ?]; split; assumption.
Qed.
Theorem and_assoc : forall A B C : Prop, (A /\ B) /\ C <-> A /\ B /\ C.
Proof.
- intros; tauto.
+ intros; split; [ intros [[? ?] ?]| intros [? [? ?]]]; repeat split; assumption.
Qed.
Theorem or_cancel_l : forall A B C : Prop,
(B -> ~ A) -> (C -> ~ A) -> ((A \/ B <-> A \/ C) <-> (B <-> C)).
Proof.
- intros; tauto.
+ intros ? ? ? Fl Fr; split; [ | apply or_iff_compat_l]; intros [Hl Hr]; split; intros.
+ { destruct Hl; [ right | destruct Fl | ]; assumption. }
+ { destruct Hr; [ right | destruct Fr | ]; assumption. }
Qed.
Theorem or_cancel_r : forall A B C : Prop,
(B -> ~ A) -> (C -> ~ A) -> ((B \/ A <-> C \/ A) <-> (B <-> C)).
Proof.
- intros; tauto.
+ intros ? ? ? Fl Fr; split; [ | apply or_iff_compat_r]; intros [Hl Hr]; split; intros.
+ { destruct Hl; [ left | | destruct Fl ]; assumption. }
+ { destruct Hr; [ left | | destruct Fr ]; assumption. }
Qed.
Theorem or_comm : forall A B : Prop, (A \/ B) <-> (B \/ A).
Proof.
- intros; tauto.
+ intros; split; (intros [? | ?]; [ right | left ]; assumption).
Qed.
Theorem or_assoc : forall A B C : Prop, (A \/ B) \/ C <-> A \/ B \/ C.
Proof.
- intros; tauto.
-Qed.
-
-(** Backward direction of the equivalences above does not need assumptions *)
-
-Theorem and_iff_compat_l : forall A B C : Prop,
- (B <-> C) -> (A /\ B <-> A /\ C).
-Proof.
- intros; tauto.
-Qed.
-
-Theorem and_iff_compat_r : forall A B C : Prop,
- (B <-> C) -> (B /\ A <-> C /\ A).
-Proof.
- intros; tauto.
-Qed.
-
-Theorem or_iff_compat_l : forall A B C : Prop,
- (B <-> C) -> (A \/ B <-> A \/ C).
-Proof.
- intros; tauto.
-Qed.
-
-Theorem or_iff_compat_r : forall A B C : Prop,
- (B <-> C) -> (B \/ A <-> C \/ A).
-Proof.
- intros; tauto.
+ intros; split; [ intros [[?|?]|?]| intros [?|[?|?]]].
+ + left; assumption.
+ + right; left; assumption.
+ + right; right; assumption.
+ + left; left; assumption.
+ + left; right; assumption.
+ + right; assumption.
Qed.
-
Lemma iff_and : forall A B : Prop, (A <-> B) -> (A -> B) /\ (B -> A).
Proof.
intros A B []; split; trivial.
@@ -178,7 +203,7 @@ Qed.
Lemma iff_to_and : forall A B : Prop, (A <-> B) <-> (A -> B) /\ (B -> A).
Proof.
- intros; tauto.
+ intros; split; intros [Hl Hr]; (split; intros; [ apply Hl | apply Hr]); assumption.
Qed.
(** [(IF_then_else P Q R)], written [IF P then Q else R] denotes
@@ -204,11 +229,6 @@ Notation "'IF' c1 'then' c2 'else' c3" := (IF_then_else c1 c2 c3)
is provided too.
*)
-(** Remark: [exists x, Q] denotes [ex (fun x => Q)] so that [exists x,
- P x] is in fact equivalent to [ex (fun x => P x)] which may be not
- convertible to [ex P] if [P] is not itself an abstraction *)
-
-
Inductive ex (A:Type) (P:A -> Prop) : Prop :=
ex_intro : forall x:A, P x -> ex (A:=A) P.
@@ -277,7 +297,8 @@ Arguments eq_ind [A] x P _ y _.
Arguments eq_rec [A] x P _ y _.
Arguments eq_rect [A] x P _ y _.
-Hint Resolve I conj or_introl or_intror eq_refl: core.
+Hint Resolve I conj or_introl or_intror : core.
+Hint Resolve eq_refl: core.
Hint Resolve ex_intro ex_intro2: core.
Section Logic_lemmas.
@@ -297,19 +318,16 @@ Section Logic_lemmas.
Proof.
destruct 1; trivial.
Defined.
- Opaque eq_sym.
Theorem eq_trans : x = y -> y = z -> x = z.
Proof.
destruct 2; trivial.
Defined.
- Opaque eq_trans.
Theorem f_equal : x = y -> f x = f y.
Proof.
destruct 1; trivial.
Defined.
- Opaque f_equal.
Theorem not_eq_sym : x <> y -> y <> x.
Proof.
@@ -320,7 +338,7 @@ Section Logic_lemmas.
Definition eq_ind_r :
forall (A:Type) (x:A) (P:A -> Prop), P x -> forall y:A, y = x -> P y.
- intros A x P H y H0; elim eq_sym with (1 := H0); assumption.
+ intros A x P H y H0. elim eq_sym with (1 := H0); assumption.
Defined.
Definition eq_rec_r :
@@ -336,13 +354,40 @@ End Logic_lemmas.
Module EqNotations.
Notation "'rew' H 'in' H'" := (eq_rect _ _ H' _ H)
- (at level 10, H' at level 10).
+ (at level 10, H' at level 10,
+ format "'[' 'rew' H in '/' H' ']'").
+ Notation "'rew' [ P ] H 'in' H'" := (eq_rect _ P H' _ H)
+ (at level 10, H' at level 10,
+ format "'[' 'rew' [ P ] '/ ' H in '/' H' ']'").
Notation "'rew' <- H 'in' H'" := (eq_rect_r _ H' H)
- (at level 10, H' at level 10).
+ (at level 10, H' at level 10,
+ format "'[' 'rew' <- H in '/' H' ']'").
+ Notation "'rew' <- [ P ] H 'in' H'" := (eq_rect_r P H' H)
+ (at level 10, H' at level 10,
+ format "'[' 'rew' <- [ P ] '/ ' H in '/' H' ']'").
Notation "'rew' -> H 'in' H'" := (eq_rect _ _ H' _ H)
(at level 10, H' at level 10, only parsing).
+ Notation "'rew' -> [ P ] H 'in' H'" := (eq_rect _ P H' _ H)
+ (at level 10, H' at level 10, only parsing).
+
End EqNotations.
+Import EqNotations.
+
+Lemma rew_opp_r : forall A (P:A->Type) (x y:A) (H:x=y) (a:P y), rew H in rew <- H in a = a.
+Proof.
+intros.
+destruct H.
+reflexivity.
+Defined.
+
+Lemma rew_opp_l : forall A (P:A->Type) (x y:A) (H:x=y) (a:P x), rew <- H in rew H in a = a.
+Proof.
+intros.
+destruct H.
+reflexivity.
+Defined.
+
Theorem f_equal2 :
forall (A1 A2 B:Type) (f:A1 -> A2 -> B) (x1 y1:A1)
(x2 y2:A2), x1 = y1 -> x2 = y2 -> f x1 x2 = f y1 y2.
@@ -376,6 +421,91 @@ Proof.
destruct 1; destruct 1; destruct 1; destruct 1; destruct 1; reflexivity.
Qed.
+Theorem f_equal_compose : forall A B C (a b:A) (f:A->B) (g:B->C) (e:a=b),
+ f_equal g (f_equal f e) = f_equal (fun a => g (f a)) e.
+Proof.
+ destruct e. reflexivity.
+Defined.
+
+(** The goupoid structure of equality *)
+
+Theorem eq_trans_refl_l : forall A (x y:A) (e:x=y), eq_trans eq_refl e = e.
+Proof.
+ destruct e. reflexivity.
+Defined.
+
+Theorem eq_trans_refl_r : forall A (x y:A) (e:x=y), eq_trans e eq_refl = e.
+Proof.
+ destruct e. reflexivity.
+Defined.
+
+Theorem eq_sym_involutive : forall A (x y:A) (e:x=y), eq_sym (eq_sym e) = e.
+Proof.
+ destruct e; reflexivity.
+Defined.
+
+Theorem eq_trans_sym_inv_l : forall A (x y:A) (e:x=y), eq_trans (eq_sym e) e = eq_refl.
+Proof.
+ destruct e; reflexivity.
+Defined.
+
+Theorem eq_trans_sym_inv_r : forall A (x y:A) (e:x=y), eq_trans e (eq_sym e) = eq_refl.
+Proof.
+ destruct e; reflexivity.
+Defined.
+
+Theorem eq_trans_assoc : forall A (x y z t:A) (e:x=y) (e':y=z) (e'':z=t),
+ eq_trans e (eq_trans e' e'') = eq_trans (eq_trans e e') e''.
+Proof.
+ destruct e''; reflexivity.
+Defined.
+
+(** Extra properties of equality *)
+
+Theorem eq_id_comm_l : forall A (f:A->A) (Hf:forall a, a = f a), forall a, f_equal f (Hf a) = Hf (f a).
+Proof.
+ intros.
+ unfold f_equal.
+ rewrite <- (eq_trans_sym_inv_l (Hf a)).
+ destruct (Hf a) at 1 2.
+ destruct (Hf a).
+ reflexivity.
+Defined.
+
+Theorem eq_id_comm_r : forall A (f:A->A) (Hf:forall a, f a = a), forall a, f_equal f (Hf a) = Hf (f a).
+Proof.
+ intros.
+ unfold f_equal.
+ rewrite <- (eq_trans_sym_inv_l (Hf (f (f a)))).
+ set (Hfsymf := fun a => eq_sym (Hf a)).
+ change (eq_sym (Hf (f (f a)))) with (Hfsymf (f (f a))).
+ pattern (Hfsymf (f (f a))).
+ destruct (eq_id_comm_l f Hfsymf (f a)).
+ destruct (eq_id_comm_l f Hfsymf a).
+ unfold Hfsymf.
+ destruct (Hf a). simpl.
+ rewrite eq_trans_refl_l.
+ reflexivity.
+Defined.
+
+Lemma eq_trans_map_distr : forall A B x y z (f:A->B) (e:x=y) (e':y=z), f_equal f (eq_trans e e') = eq_trans (f_equal f e) (f_equal f e').
+Proof.
+destruct e'.
+reflexivity.
+Defined.
+
+Lemma eq_sym_map_distr : forall A B (x y:A) (f:A->B) (e:x=y), eq_sym (f_equal f e) = f_equal f (eq_sym e).
+Proof.
+destruct e.
+reflexivity.
+Defined.
+
+Lemma eq_trans_sym_distr : forall A (x y z:A) (e:x=y) (e':y=z), eq_sym (eq_trans e e') = eq_trans (eq_sym e') (eq_sym e).
+Proof.
+destruct e, e'.
+reflexivity.
+Defined.
+
(* Aliases *)
Notation sym_eq := eq_sym (compat "8.3").
@@ -474,7 +604,7 @@ Declare Right Step eq_trans.
Lemma iff_stepl : forall A B C : Prop, (A <-> B) -> (A <-> C) -> (C <-> B).
Proof.
- intros; tauto.
+ intros ? ? ? [? ?] [? ?]; split; intros; auto.
Qed.
Declare Left Step iff_stepl.
diff --git a/theories/Init/Logic_Type.v b/theories/Init/Logic_Type.v
index b2f83e03..1e126463 100644
--- a/theories/Init/Logic_Type.v
+++ b/theories/Init/Logic_Type.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Init/Nat.v b/theories/Init/Nat.v
new file mode 100644
index 00000000..afb46436
--- /dev/null
+++ b/theories/Init/Nat.v
@@ -0,0 +1,297 @@
+(************************************************************************)
+(* v * The Coq Proof Assistant / The Coq Development Team *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* \VV/ **************************************************************)
+(* // * This file is distributed under the terms of the *)
+(* * GNU Lesser General Public License Version 2.1 *)
+(************************************************************************)
+
+Require Import Notations Logic Datatypes.
+
+Local Open Scope nat_scope.
+
+(**********************************************************************)
+(** * Peano natural numbers, definitions of operations *)
+(**********************************************************************)
+
+(** This file is meant to be used as a whole module,
+ without importing it, leading to qualified definitions
+ (e.g. Nat.pred) *)
+
+Definition t := nat.
+
+(** ** Constants *)
+
+Definition zero := 0.
+Definition one := 1.
+Definition two := 2.
+
+(** ** Basic operations *)
+
+Definition succ := S.
+
+Definition pred n :=
+ match n with
+ | 0 => n
+ | S u => u
+ end.
+
+Fixpoint add n m :=
+ match n with
+ | 0 => m
+ | S p => S (p + m)
+ end
+
+where "n + m" := (add n m) : nat_scope.
+
+Definition double n := n + n.
+
+Fixpoint mul n m :=
+ match n with
+ | 0 => 0
+ | S p => m + p * m
+ end
+
+where "n * m" := (mul n m) : nat_scope.
+
+(** Truncated subtraction: [n-m] is [0] if [n<=m] *)
+
+Fixpoint sub n m :=
+ match n, m with
+ | S k, S l => k - l
+ | _, _ => n
+ end
+
+where "n - m" := (sub n m) : nat_scope.
+
+(** ** Comparisons *)
+
+Fixpoint eqb n m : bool :=
+ match n, m with
+ | 0, 0 => true
+ | 0, S _ => false
+ | S _, 0 => false
+ | S n', S m' => eqb n' m'
+ end.
+
+Fixpoint leb n m : bool :=
+ match n, m with
+ | 0, _ => true
+ | _, 0 => false
+ | S n', S m' => leb n' m'
+ end.
+
+Definition ltb n m := leb (S n) m.
+
+Infix "=?" := eqb (at level 70) : nat_scope.
+Infix "<=?" := leb (at level 70) : nat_scope.
+Infix "<?" := ltb (at level 70) : nat_scope.
+
+Fixpoint compare n m : comparison :=
+ match n, m with
+ | 0, 0 => Eq
+ | 0, S _ => Lt
+ | S _, 0 => Gt
+ | S n', S m' => compare n' m'
+ end.
+
+Infix "?=" := compare (at level 70) : nat_scope.
+
+(** ** Minimum, maximum *)
+
+Fixpoint max n m :=
+ match n, m with
+ | 0, _ => m
+ | S n', 0 => n
+ | S n', S m' => S (max n' m')
+ end.
+
+Fixpoint min n m :=
+ match n, m with
+ | 0, _ => 0
+ | S n', 0 => 0
+ | S n', S m' => S (min n' m')
+ end.
+
+(** ** Parity tests *)
+
+Fixpoint even n : bool :=
+ match n with
+ | 0 => true
+ | 1 => false
+ | S (S n') => even n'
+ end.
+
+Definition odd n := negb (even n).
+
+(** ** Power *)
+
+Fixpoint pow n m :=
+ match m with
+ | 0 => 1
+ | S m => n * (n^m)
+ end
+
+where "n ^ m" := (pow n m) : nat_scope.
+
+(** ** Euclidean division *)
+
+(** This division is linear and tail-recursive.
+ In [divmod], [y] is the predecessor of the actual divisor,
+ and [u] is [y] minus the real remainder
+*)
+
+Fixpoint divmod x y q u :=
+ match x with
+ | 0 => (q,u)
+ | S x' => match u with
+ | 0 => divmod x' y (S q) y
+ | S u' => divmod x' y q u'
+ end
+ end.
+
+Definition div x y :=
+ match y with
+ | 0 => y
+ | S y' => fst (divmod x y' 0 y')
+ end.
+
+Definition modulo x y :=
+ match y with
+ | 0 => y
+ | S y' => y' - snd (divmod x y' 0 y')
+ end.
+
+Infix "/" := div : nat_scope.
+Infix "mod" := modulo (at level 40, no associativity) : nat_scope.
+
+
+(** ** Greatest common divisor *)
+
+(** We use Euclid algorithm, which is normally not structural,
+ but Coq is now clever enough to accept this (behind modulo
+ there is a subtraction, which now preserves being a subterm)
+*)
+
+Fixpoint gcd a b :=
+ match a with
+ | O => b
+ | S a' => gcd (b mod (S a')) (S a')
+ end.
+
+(** ** Square *)
+
+Definition square n := n * n.
+
+(** ** Square root *)
+
+(** The following square root function is linear (and tail-recursive).
+ With Peano representation, we can't do better. For faster algorithm,
+ see Psqrt/Zsqrt/Nsqrt...
+
+ We search the square root of n = k + p^2 + (q - r)
+ with q = 2p and 0<=r<=q. We start with p=q=r=0, hence
+ looking for the square root of n = k. Then we progressively
+ decrease k and r. When k = S k' and r=0, it means we can use (S p)
+ as new sqrt candidate, since (S k')+p^2+2p = k'+(S p)^2.
+ When k reaches 0, we have found the biggest p^2 square contained
+ in n, hence the square root of n is p.
+*)
+
+Fixpoint sqrt_iter k p q r :=
+ match k with
+ | O => p
+ | S k' => match r with
+ | O => sqrt_iter k' (S p) (S (S q)) (S (S q))
+ | S r' => sqrt_iter k' p q r'
+ end
+ end.
+
+Definition sqrt n := sqrt_iter n 0 0 0.
+
+(** ** Log2 *)
+
+(** This base-2 logarithm is linear and tail-recursive.
+
+ In [log2_iter], we maintain the logarithm [p] of the counter [q],
+ while [r] is the distance between [q] and the next power of 2,
+ more precisely [q + S r = 2^(S p)] and [r<2^p]. At each
+ recursive call, [q] goes up while [r] goes down. When [r]
+ is 0, we know that [q] has almost reached a power of 2,
+ and we increase [p] at the next call, while resetting [r]
+ to [q].
+
+ Graphically (numbers are [q], stars are [r]) :
+
+<<
+ 10
+ 9
+ 8
+ 7 *
+ 6 *
+ 5 ...
+ 4
+ 3 *
+ 2 *
+ 1 * *
+0 * * *
+>>
+
+ We stop when [k], the global downward counter reaches 0.
+ At that moment, [q] is the number we're considering (since
+ [k+q] is invariant), and [p] its logarithm.
+*)
+
+Fixpoint log2_iter k p q r :=
+ match k with
+ | O => p
+ | S k' => match r with
+ | O => log2_iter k' (S p) (S q) q
+ | S r' => log2_iter k' p (S q) r'
+ end
+ end.
+
+Definition log2 n := log2_iter (pred n) 0 1 0.
+
+(** Iterator on natural numbers *)
+
+Definition iter (n:nat) {A} (f:A->A) (x:A) : A :=
+ nat_rect (fun _ => A) x (fun _ => f) n.
+
+(** Bitwise operations *)
+
+(** We provide here some bitwise operations for unary numbers.
+ Some might be really naive, they are just there for fullfiling
+ the same interface as other for natural representations. As
+ soon as binary representations such as NArith are available,
+ it is clearly better to convert to/from them and use their ops.
+*)
+
+Fixpoint div2 n :=
+ match n with
+ | 0 => 0
+ | S 0 => 0
+ | S (S n') => S (div2 n')
+ end.
+
+Fixpoint testbit a n : bool :=
+ match n with
+ | 0 => odd a
+ | S n => testbit (div2 a) n
+ end.
+
+Definition shiftl a := nat_rect _ a (fun _ => double).
+Definition shiftr a := nat_rect _ a (fun _ => div2).
+
+Fixpoint bitwise (op:bool->bool->bool) n a b :=
+ match n with
+ | 0 => 0
+ | S n' =>
+ (if op (odd a) (odd b) then 1 else 0) +
+ 2*(bitwise op n' (div2 a) (div2 b))
+ end.
+
+Definition land a b := bitwise andb a a b.
+Definition lor a b := bitwise orb (max a b) a b.
+Definition ldiff a b := bitwise (fun b b' => andb b (negb b')) a a b.
+Definition lxor a b := bitwise xorb (max a b) a b.
diff --git a/theories/Init/Notations.v b/theories/Init/Notations.v
index c745f9c9..424ca0c8 100644
--- a/theories/Init/Notations.v
+++ b/theories/Init/Notations.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -10,6 +10,7 @@
(** Notations for propositional connectives *)
+Reserved Notation "x -> y" (at level 99, right associativity, y at level 200).
Reserved Notation "x <-> y" (at level 95, no associativity).
Reserved Notation "x /\ y" (at level 80, right associativity).
Reserved Notation "x \/ y" (at level 85, right associativity).
@@ -79,3 +80,13 @@ Delimit Scope core_scope with core.
Open Scope core_scope.
Open Scope type_scope.
+
+(** ML Tactic Notations *)
+
+Declare ML Module "coretactics".
+Declare ML Module "extratactics".
+Declare ML Module "eauto".
+Declare ML Module "g_class".
+Declare ML Module "g_eqdecide".
+Declare ML Module "g_rewrite".
+Declare ML Module "tauto".
diff --git a/theories/Init/Peano.v b/theories/Init/Peano.v
index ef2d9584..7a14ab39 100644
--- a/theories/Init/Peano.v
+++ b/theories/Init/Peano.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -26,21 +26,22 @@
Require Import Notations.
Require Import Datatypes.
Require Import Logic.
+Require Coq.Init.Nat.
Open Scope nat_scope.
Definition eq_S := f_equal S.
+Definition f_equal_nat := f_equal (A:=nat).
-Hint Resolve (f_equal S): v62.
-Hint Resolve (f_equal (A:=nat)): core.
+Hint Resolve eq_S: v62.
+Hint Resolve f_equal_nat: core.
(** The predecessor function *)
-Definition pred (n:nat) : nat := match n with
- | O => n
- | S u => u
- end.
-Hint Resolve (f_equal pred): v62.
+Notation pred := Nat.pred (compat "8.4").
+
+Definition f_equal_pred := f_equal pred.
+Hint Resolve f_equal_pred: v62.
Theorem pred_Sn : forall n:nat, n = pred (S n).
Proof.
@@ -80,16 +81,13 @@ Hint Resolve n_Sn: core.
(** Addition *)
-Fixpoint plus (n m:nat) : nat :=
- match n with
- | O => m
- | S p => S (p + m)
- end
-
-where "n + m" := (plus n m) : nat_scope.
+Notation plus := Nat.add (compat "8.4").
+Infix "+" := Nat.add : nat_scope.
-Hint Resolve (f_equal2 plus): v62.
-Hint Resolve (f_equal2 (A1:=nat) (A2:=nat)): core.
+Definition f_equal2_plus := f_equal2 plus.
+Hint Resolve f_equal2_plus: v62.
+Definition f_equal2_nat := f_equal2 (A1:=nat) (A2:=nat).
+Hint Resolve f_equal2_nat: core.
Lemma plus_n_O : forall n:nat, n = n + 0.
Proof.
@@ -99,7 +97,7 @@ Hint Resolve plus_n_O: core.
Lemma plus_O_n : forall n:nat, 0 + n = n.
Proof.
- auto.
+ reflexivity.
Qed.
Lemma plus_n_Sm : forall n m:nat, S (n + m) = n + S m.
@@ -110,7 +108,7 @@ Hint Resolve plus_n_Sm: core.
Lemma plus_Sn_m : forall n m:nat, S n + m = S (n + m).
Proof.
- auto.
+ reflexivity.
Qed.
(** Standard associated names *)
@@ -120,15 +118,11 @@ Notation plus_succ_r_reverse := plus_n_Sm (compat "8.2").
(** Multiplication *)
-Fixpoint mult (n m:nat) : nat :=
- match n with
- | O => 0
- | S p => m + p * m
- end
-
-where "n * m" := (mult n m) : nat_scope.
+Notation mult := Nat.mul (compat "8.4").
+Infix "*" := Nat.mul : nat_scope.
-Hint Resolve (f_equal2 mult): core.
+Definition f_equal2_mult := f_equal2 mult.
+Hint Resolve f_equal2_mult: core.
Lemma mult_n_O : forall n:nat, 0 = n * 0.
Proof.
@@ -151,14 +145,8 @@ Notation mult_succ_r_reverse := mult_n_Sm (compat "8.2").
(** Truncated subtraction: [m-n] is [0] if [n>=m] *)
-Fixpoint minus (n m:nat) : nat :=
- match n, m with
- | O, _ => n
- | S k, O => n
- | S k, S l => k - l
- end
-
-where "n - m" := (minus n m) : nat_scope.
+Notation minus := Nat.sub (compat "8.4").
+Infix "-" := Nat.sub : nat_scope.
(** Definition of the usual orders, the basic properties of [le] and [lt]
can be found in files Le and Lt *)
@@ -202,6 +190,16 @@ Proof.
intros n m. exact (le_pred (S n) (S m)).
Qed.
+Theorem le_0_n : forall n, 0 <= n.
+Proof.
+ induction n; constructor; trivial.
+Qed.
+
+Theorem le_n_S : forall n m, n <= m -> S n <= S m.
+Proof.
+ induction 1; constructor; trivial.
+Qed.
+
(** Case analysis *)
Theorem nat_case :
@@ -224,73 +222,48 @@ Qed.
(** Maximum and minimum : definitions and specifications *)
-Fixpoint max n m : nat :=
- match n, m with
- | O, _ => m
- | S n', O => n
- | S n', S m' => S (max n' m')
- end.
-
-Fixpoint min n m : nat :=
- match n, m with
- | O, _ => 0
- | S n', O => 0
- | S n', S m' => S (min n' m')
- end.
+Notation max := Nat.max (compat "8.4").
+Notation min := Nat.min (compat "8.4").
-Theorem max_l : forall n m : nat, m <= n -> max n m = n.
+Lemma max_l n m : m <= n -> Nat.max n m = n.
Proof.
-induction n; destruct m; simpl; auto. inversion 1.
-intros. apply f_equal. apply IHn. apply le_S_n. trivial.
+ revert m; induction n; destruct m; simpl; trivial.
+ - inversion 1.
+ - intros. apply f_equal, IHn, le_S_n; trivial.
Qed.
-Theorem max_r : forall n m : nat, n <= m -> max n m = m.
+Lemma max_r n m : n <= m -> Nat.max n m = m.
Proof.
-induction n; destruct m; simpl; auto. inversion 1.
-intros. apply f_equal. apply IHn. apply le_S_n. trivial.
+ revert m; induction n; destruct m; simpl; trivial.
+ - inversion 1.
+ - intros. apply f_equal, IHn, le_S_n; trivial.
Qed.
-Theorem min_l : forall n m : nat, n <= m -> min n m = n.
+Lemma min_l n m : n <= m -> Nat.min n m = n.
Proof.
-induction n; destruct m; simpl; auto. inversion 1.
-intros. apply f_equal. apply IHn. apply le_S_n. trivial.
+ revert m; induction n; destruct m; simpl; trivial.
+ - inversion 1.
+ - intros. apply f_equal, IHn, le_S_n; trivial.
Qed.
-Theorem min_r : forall n m : nat, m <= n -> min n m = m.
+Lemma min_r n m : m <= n -> Nat.min n m = m.
Proof.
-induction n; destruct m; simpl; auto. inversion 1.
-intros. apply f_equal. apply IHn. apply le_S_n. trivial.
+ revert m; induction n; destruct m; simpl; trivial.
+ - inversion 1.
+ - intros. apply f_equal, IHn, le_S_n; trivial.
Qed.
-(** [n]th iteration of the function [f] *)
-Fixpoint nat_iter (n:nat) {A} (f:A->A) (x:A) : A :=
- match n with
- | O => x
- | S n' => f (nat_iter n' f x)
- end.
-
-Lemma nat_iter_succ_r n {A} (f:A->A) (x:A) :
- nat_iter (S n) f x = nat_iter n f (f x).
+Lemma nat_rect_succ_r {A} (f: A -> A) (x:A) n :
+ nat_rect (fun _ => A) x (fun _ => f) (S n) = nat_rect (fun _ => A) (f x) (fun _ => f) n.
Proof.
induction n; intros; simpl; rewrite <- ?IHn; trivial.
Qed.
-Theorem nat_iter_plus :
+Theorem nat_rect_plus :
forall (n m:nat) {A} (f:A -> A) (x:A),
- nat_iter (n + m) f x = nat_iter n f (nat_iter m f x).
+ nat_rect (fun _ => A) x (fun _ => f) (n + m) =
+ nat_rect (fun _ => A) (nat_rect (fun _ => A) x (fun _ => f) m) (fun _ => f) n.
Proof.
induction n; intros; simpl; rewrite ?IHn; trivial.
Qed.
-
-(** Preservation of invariants : if [f : A->A] preserves the invariant [Inv],
- then the iterates of [f] also preserve it. *)
-
-Theorem nat_iter_invariant :
- forall (n:nat) {A} (f:A -> A) (P : A -> Prop),
- (forall x, P x -> P (f x)) ->
- forall x, P x -> P (nat_iter n f x).
-Proof.
- induction n; simpl; trivial.
- intros A f P Hf x Hx. apply Hf, IHn; trivial.
-Qed.
diff --git a/theories/Init/Prelude.v b/theories/Init/Prelude.v
index 2614ce40..4894eba4 100644
--- a/theories/Init/Prelude.v
+++ b/theories/Init/Prelude.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -8,8 +8,10 @@
Require Export Notations.
Require Export Logic.
+Require Export Logic_Type.
Require Export Datatypes.
Require Export Specif.
+Require Coq.Init.Nat.
Require Export Peano.
Require Export Coq.Init.Wf.
Require Export Coq.Init.Tactics.
@@ -20,7 +22,5 @@ Declare ML Module "decl_mode_plugin".
Declare ML Module "cc_plugin".
Declare ML Module "ground_plugin".
Declare ML Module "recdef_plugin".
-Declare ML Module "subtac_plugin".
-Declare ML Module "xml_plugin".
(* Default substrings not considered by queries like SearchAbout *)
Add Search Blacklist "_admitted" "_subproof" "Private_".
diff --git a/theories/Init/Specif.v b/theories/Init/Specif.v
index cc5a1932..1384901b 100644
--- a/theories/Init/Specif.v
+++ b/theories/Init/Specif.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -45,11 +45,11 @@ Arguments sigT2 (A P Q)%type.
Notation "{ x | P }" := (sig (fun x => P)) : type_scope.
Notation "{ x | P & Q }" := (sig2 (fun x => P) (fun x => Q)) : type_scope.
-Notation "{ x : A | P }" := (sig (fun x:A => P)) : type_scope.
-Notation "{ x : A | P & Q }" := (sig2 (fun x:A => P) (fun x:A => Q)) :
+Notation "{ x : A | P }" := (sig (A:=A) (fun x => P)) : type_scope.
+Notation "{ x : A | P & Q }" := (sig2 (A:=A) (fun x => P) (fun x => Q)) :
type_scope.
-Notation "{ x : A & P }" := (sigT (fun x:A => P)) : type_scope.
-Notation "{ x : A & P & Q }" := (sigT2 (fun x:A => P) (fun x:A => Q)) :
+Notation "{ x : A & P }" := (sigT (A:=A) (fun x => P)) : type_scope.
+Notation "{ x : A & P & Q }" := (sigT2 (A:=A) (fun x => P) (fun x => Q)) :
type_scope.
Add Printing Let sig.
@@ -65,24 +65,57 @@ Add Printing Let sigT2.
[(proj1_sig y)] is the witness [a] and [(proj2_sig y)] is the
proof of [(P a)] *)
-
+(* Set Universe Polymorphism. *)
Section Subset_projections.
Variable A : Type.
Variable P : A -> Prop.
Definition proj1_sig (e:sig P) := match e with
- | exist a b => a
+ | exist _ a b => a
end.
Definition proj2_sig (e:sig P) :=
match e return P (proj1_sig e) with
- | exist a b => b
+ | exist _ a b => b
end.
End Subset_projections.
+(** [sig2] of a predicate can be projected to a [sig].
+
+ This allows [proj1_sig] and [proj2_sig] to be usable with [sig2].
+
+ The [let] statements occur in the body of the [exist] so that
+ [proj1_sig] of a coerced [X : sig2 P Q] will unify with [let (a,
+ _, _) := X in a] *)
+
+Definition sig_of_sig2 (A : Type) (P Q : A -> Prop) (X : sig2 P Q) : sig P
+ := exist P
+ (let (a, _, _) := X in a)
+ (let (x, p, _) as s return (P (let (a, _, _) := s in a)) := X in p).
+
+(** Projections of [sig2]
+
+ An element [y] of a subset [{x:A | (P x) & (Q x)}] is the triple
+ of an [a] of type [A], a of a proof [h] that [a] satisfies [P],
+ and a proof [h'] that [a] satisfies [Q]. Then
+ [(proj1_sig (sig_of_sig2 y))] is the witness [a],
+ [(proj2_sig (sig_of_sig2 y))] is the proof of [(P a)], and
+ [(proj3_sig y)] is the proof of [(Q a)]. *)
+
+Section Subset_projections2.
+
+ Variable A : Type.
+ Variables P Q : A -> Prop.
+
+ Definition proj3_sig (e : sig2 P Q) :=
+ let (a, b, c) return Q (proj1_sig (sig_of_sig2 e)) := e in c.
+
+End Subset_projections2.
+
+
(** Projections of [sigT]
An element [x] of a sigma-type [{y:A & P y}] is a dependent pair
@@ -90,31 +123,71 @@ End Subset_projections.
[(projT1 x)] is the first projection and [(projT2 x)] is the
second projection, the type of which depends on the [projT1]. *)
+
+
Section Projections.
Variable A : Type.
Variable P : A -> Type.
Definition projT1 (x:sigT P) : A := match x with
- | existT a _ => a
+ | existT _ a _ => a
end.
+
Definition projT2 (x:sigT P) : P (projT1 x) :=
match x return P (projT1 x) with
- | existT _ h => h
+ | existT _ _ h => h
end.
End Projections.
+(** [sigT2] of a predicate can be projected to a [sigT].
+
+ This allows [projT1] and [projT2] to be usable with [sigT2].
+
+ The [let] statements occur in the body of the [existT] so that
+ [projT1] of a coerced [X : sigT2 P Q] will unify with [let (a,
+ _, _) := X in a] *)
+
+Definition sigT_of_sigT2 (A : Type) (P Q : A -> Type) (X : sigT2 P Q) : sigT P
+ := existT P
+ (let (a, _, _) := X in a)
+ (let (x, p, _) as s return (P (let (a, _, _) := s in a)) := X in p).
+
+(** Projections of [sigT2]
+
+ An element [x] of a sigma-type [{y:A & P y & Q y}] is a dependent
+ pair made of an [a] of type [A], an [h] of type [P a], and an [h']
+ of type [Q a]. Then, [(projT1 (sigT_of_sigT2 x))] is the first
+ projection, [(projT2 (sigT_of_sigT2 x))] is the second projection,
+ and [(projT3 x)] is the third projection, the types of which
+ depends on the [projT1]. *)
+
+Section Projections2.
+
+ Variable A : Type.
+ Variables P Q : A -> Type.
+
+ Definition projT3 (e : sigT2 P Q) :=
+ let (a, b, c) return Q (projT1 (sigT_of_sigT2 e)) := e in c.
+
+End Projections2.
+
(** [sigT] of a predicate is equivalent to [sig] *)
-Lemma sig_of_sigT : forall (A:Type) (P:A->Prop), sigT P -> sig P.
-Proof. destruct 1 as (x,H); exists x; trivial. Defined.
+Definition sig_of_sigT (A : Type) (P : A -> Prop) (X : sigT P) : sig P
+ := exist P (projT1 X) (projT2 X).
+
+Definition sigT_of_sig (A : Type) (P : A -> Prop) (X : sig P) : sigT P
+ := existT P (proj1_sig X) (proj2_sig X).
-Lemma sigT_of_sig : forall (A:Type) (P:A->Prop), sig P -> sigT P.
-Proof. destruct 1 as (x,H); exists x; trivial. Defined.
+(** [sigT2] of a predicate is equivalent to [sig2] *)
-Coercion sigT_of_sig : sig >-> sigT.
-Coercion sig_of_sigT : sigT >-> sig.
+Definition sig2_of_sigT2 (A : Type) (P Q : A -> Prop) (X : sigT2 P Q) : sig2 P Q
+ := exist2 P Q (projT1 (sigT_of_sigT2 X)) (projT2 (sigT_of_sigT2 X)) (projT3 X).
+
+Definition sigT2_of_sig2 (A : Type) (P Q : A -> Prop) (X : sig2 P Q) : sigT2 P Q
+ := existT2 P Q (proj1_sig (sig_of_sig2 X)) (proj2_sig (sig_of_sig2 X)) (proj3_sig X).
(** [sumbool] is a boolean type equipped with the justification of
their value *)
@@ -142,6 +215,8 @@ Add Printing If sumor.
Arguments inleft {A B} _ , [A] B _.
Arguments inright {A B} _ , A [B] _.
+(* Unset Universe Polymorphism. *)
+
(** Various forms of the axiom of choice for specifications *)
Section Choice_lemmas.
@@ -187,10 +262,10 @@ Section Dependent_choice_lemmas.
(forall x:X, {y | R x y}) ->
forall x0, {f : nat -> X | f O = x0 /\ forall n, R (f n) (f (S n))}.
Proof.
- intros H x0.
+ intros H x0.
set (f:=fix f n := match n with O => x0 | S n' => proj1_sig (H (f n')) end).
exists f.
- split. reflexivity.
+ split. reflexivity.
induction n; simpl; apply proj2_sig.
Defined.
@@ -203,12 +278,14 @@ End Dependent_choice_lemmas.
[Inductive Exc [A:Type] : Type := value : A->(Exc A) | error : (Exc A)].
It is implemented using the option type. *)
+Section Exc.
+ Variable A : Type.
-Definition Exc := option.
-Definition value := Some.
-Definition error := @None.
-
-Arguments error [A].
+ Definition Exc := option A.
+ Definition value := @Some A.
+ Definition error := @None A.
+End Exc.
+Arguments error {A}.
Definition except := False_rec. (* for compatibility with previous versions *)
diff --git a/theories/Init/Tactics.v b/theories/Init/Tactics.v
index 4a7b9283..9e828e6e 100644
--- a/theories/Init/Tactics.v
+++ b/theories/Init/Tactics.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -68,7 +68,7 @@ Ltac absurd_hyp H :=
let T := type of H in
absurd T.
-(* A useful complement to contradict. Here H:A while G allows to conclude ~A *)
+(* A useful complement to contradict. Here H:A while G allows concluding ~A *)
Ltac false_hyp H G :=
let T := type of H in absurd T; [ apply G | assumption ].
diff --git a/theories/Init/Wf.v b/theories/Init/Wf.v
index 9db64787..6501b1e1 100644
--- a/theories/Init/Wf.v
+++ b/theories/Init/Wf.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -150,3 +150,23 @@ End Well_founded_2.
Notation Acc_iter := Fix_F (only parsing). (* compatibility *)
Notation Acc_iter_2 := Fix_F_2 (only parsing). (* compatibility *)
+
+
+
+(* Added by Julien Forest on 13/11/20 *)
+Section Acc_generator.
+ Variable A : Type.
+ Variable R : A -> A -> Prop.
+
+ (* *Lazily* add 2^n - 1 Acc_intro on top of wf.
+ Needed for fast reductions using Function and Program Fixpoint
+ and probably using Fix and Fix_F_2
+ *)
+ Fixpoint Acc_intro_generator n (wf : well_founded R) :=
+ match n with
+ | O => wf
+ | S n => fun x => Acc_intro x (fun y _ => Acc_intro_generator n (Acc_intro_generator n wf) y)
+ end.
+
+
+End Acc_generator.
diff --git a/theories/Init/vo.itarget b/theories/Init/vo.itarget
index f53d55e7..cc62e66c 100644
--- a/theories/Init/vo.itarget
+++ b/theories/Init/vo.itarget
@@ -7,3 +7,4 @@ Prelude.vo
Specif.vo
Tactics.vo
Wf.vo
+Nat.vo \ No newline at end of file
diff --git a/theories/Lists/List.v b/theories/Lists/List.v
index f5a12b09..3cba090f 100644
--- a/theories/Lists/List.v
+++ b/theories/Lists/List.v
@@ -1,15 +1,16 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
(************************************************************************)
-Require Import Le Gt Minus Bool Setoid.
+Require Setoid.
+Require Import PeanoNat Le Gt Minus Bool.
Set Implicit Arguments.
-
+(* Set Universe Polymorphism. *)
(******************************************************************)
(** * Basics: definition of polymorphic lists and some operations *)
@@ -20,6 +21,16 @@ Set Implicit Arguments.
Open Scope list_scope.
+(** Standard notations for lists.
+In a special module to avoid conflicts. *)
+Module ListNotations.
+Notation " [ ] " := nil (format "[ ]") : list_scope.
+Notation " [ x ] " := (cons x nil) : list_scope.
+Notation " [ x ; .. ; y ] " := (cons x .. (cons y nil) ..) : list_scope.
+End ListNotations.
+
+Import ListNotations.
+
Section Lists.
Variable A : Type.
@@ -28,44 +39,31 @@ Section Lists.
Definition hd (default:A) (l:list A) :=
match l with
- | nil => default
+ | [] => default
| x :: _ => x
end.
Definition hd_error (l:list A) :=
match l with
- | nil => error
+ | [] => error
| x :: _ => value x
end.
Definition tl (l:list A) :=
match l with
- | nil => nil
+ | [] => nil
| a :: m => m
end.
(** The [In] predicate *)
Fixpoint In (a:A) (l:list A) : Prop :=
match l with
- | nil => False
+ | [] => False
| b :: m => b = a \/ In a m
end.
End Lists.
-
-(** Standard notations for lists.
-In a special module to avoid conflict. *)
-Module ListNotations.
-Notation " [ ] " := nil : list_scope.
-Notation " [ x ] " := (cons x nil) : list_scope.
-Notation " [ x ; .. ; y ] " := (cons x .. (cons y nil) ..) : list_scope.
-End ListNotations.
-
-Import ListNotations.
-
-(** ** Facts about lists *)
-
Section Facts.
Variable A : Type.
@@ -89,6 +87,24 @@ Section Facts.
left; exists a, tail; reflexivity.
Qed.
+ Lemma hd_error_tl_repr : forall l (a:A) r,
+ hd_error l = Some a /\ tl l = r <-> l = a :: r.
+ Proof. destruct l as [|x xs].
+ - unfold hd_error, tl; intros a r. split; firstorder discriminate.
+ - intros. simpl. split.
+ * intros (H1, H2). inversion H1. rewrite H2. reflexivity.
+ * inversion 1. subst. auto.
+ Qed.
+
+ Lemma hd_error_some_nil : forall l (a:A), hd_error l = Some a -> l <> nil.
+ Proof. unfold hd_error. destruct l; now discriminate. Qed.
+
+ Theorem length_zero_iff_nil (l : list A):
+ length l = 0 <-> l=[].
+ Proof.
+ split; [now destruct l | now intros ->].
+ Qed.
+
(** *** Head and tail *)
Theorem hd_error_nil : hd_error (@nil A) = None.
@@ -119,6 +135,12 @@ Section Facts.
simpl; auto.
Qed.
+ Theorem not_in_cons (x a : A) (l : list A):
+ ~ In x (a::l) <-> x<>a /\ ~ In x l.
+ Proof.
+ simpl. intuition.
+ Qed.
+
Theorem in_nil : forall a:A, ~ In a [].
Proof.
unfold not; intros a H; inversion_clear H.
@@ -130,7 +152,7 @@ Section Facts.
subst a; auto.
exists [], l; auto.
destruct (IHl H) as (l1,(l2,H0)).
- exists (a::l1), l2; simpl; f_equal; auto.
+ exists (a::l1), l2; simpl. apply f_equal. auto.
Qed.
(** Inversion *)
@@ -173,7 +195,7 @@ Section Facts.
Qed.
Theorem app_nil_r : forall l:list A, l ++ [] = l.
- Proof.
+ Proof.
induction l; simpl; f_equal; auto.
Qed.
@@ -228,10 +250,8 @@ Section Facts.
intros.
injection H.
intro.
- cut ([] = l ++ a0 :: l0); auto.
- intro.
- generalize (app_cons_not_nil _ _ _ H1); intro.
- elim H2.
+ assert ([] = l ++ a0 :: l0) by auto.
+ apply app_cons_not_nil in H1 as [].
Qed.
Lemma app_inj_tail :
@@ -240,22 +260,20 @@ Section Facts.
induction x as [| x l IHl];
[ destruct y as [| a l] | destruct y as [| a l0] ];
simpl; auto.
- intros a b H.
- injection H.
- auto.
- intros a0 b H.
- injection H; intros.
- generalize (app_cons_not_nil _ _ _ H0); destruct 1.
- intros a b H.
- injection H; intros.
- cut ([] = l ++ [a]); auto.
- intro.
- generalize (app_cons_not_nil _ _ _ H2); destruct 1.
- intros a0 b H.
- injection H; intros.
- destruct (IHl l0 a0 b H0).
- split; auto.
- rewrite <- H1; rewrite <- H2; reflexivity.
+ - intros a b H.
+ injection H.
+ auto.
+ - intros a0 b H.
+ injection H as H1 H0.
+ apply app_cons_not_nil in H0 as [].
+ - intros a b H.
+ injection H as H1 H0.
+ assert ([] = l ++ [a]) by auto.
+ apply app_cons_not_nil in H as [].
+ - intros a0 b H.
+ injection H as <- H0.
+ destruct (IHl l0 a0 b H0) as (<-,<-).
+ split; auto.
Qed.
@@ -360,13 +378,12 @@ Section Elts.
Lemma nth_in_or_default :
forall (n:nat) (l:list A) (d:A), {In (nth n l d) l} + {nth n l d = d}.
- (* Realizer nth_ok. Program_all. *)
Proof.
- intros n l d; generalize n; induction l; intro n0.
- right; case n0; trivial.
- case n0; simpl.
- auto.
- intro n1; elim (IHl n1); auto.
+ intros n l d; revert n; induction l.
+ - right; destruct n; trivial.
+ - intros [|n]; simpl.
+ * left; auto.
+ * destruct (IHl n); auto.
Qed.
Lemma nth_S_cons :
@@ -395,60 +412,132 @@ Section Elts.
unfold nth_default; induction n; intros [ | ] ?; simpl; auto.
Qed.
+ (** Results about [nth] *)
+
Lemma nth_In :
forall (n:nat) (l:list A) (d:A), n < length l -> In (nth n l d) l.
-
Proof.
unfold lt; induction n as [| n hn]; simpl.
- destruct l; simpl; [ inversion 2 | auto ].
- destruct l as [| a l hl]; simpl.
- inversion 2.
- intros d ie; right; apply hn; auto with arith.
+ - destruct l; simpl; [ inversion 2 | auto ].
+ - destruct l as [| a l hl]; simpl.
+ * inversion 2.
+ * intros d ie; right; apply hn; auto with arith.
+ Qed.
+
+ Lemma In_nth l x d : In x l ->
+ exists n, n < length l /\ nth n l d = x.
+ Proof.
+ induction l as [|a l IH].
+ - easy.
+ - intros [H|H].
+ * subst; exists 0; simpl; auto with arith.
+ * destruct (IH H) as (n & Hn & Hn').
+ exists (S n); simpl; auto with arith.
Qed.
Lemma nth_overflow : forall l n d, length l <= n -> nth n l d = d.
Proof.
induction l; destruct n; simpl; intros; auto.
- inversion H.
- apply IHl; auto with arith.
+ - inversion H.
+ - apply IHl; auto with arith.
Qed.
Lemma nth_indep :
forall l n d d', n < length l -> nth n l d = nth n l d'.
Proof.
- induction l; simpl; intros; auto.
- inversion H.
- destruct n; simpl; auto with arith.
+ induction l.
+ - inversion 1.
+ - intros [|n] d d'; simpl; auto with arith.
Qed.
Lemma app_nth1 :
forall l l' d n, n < length l -> nth n (l++l') d = nth n l d.
Proof.
induction l.
- intros.
- inversion H.
- intros l' d n.
- case n; simpl; auto.
- intros; rewrite IHl; auto with arith.
+ - inversion 1.
+ - intros l' d [|n]; simpl; auto with arith.
Qed.
Lemma app_nth2 :
forall l l' d n, n >= length l -> nth n (l++l') d = nth (n-length l) l' d.
Proof.
- induction l.
- intros.
- simpl.
- destruct n; auto.
- intros l' d n.
- case n; simpl; auto.
- intros.
- inversion H.
- intros.
- rewrite IHl; auto with arith.
+ induction l; intros l' d [|n]; auto.
+ - inversion 1.
+ - intros; simpl; rewrite IHl; auto with arith.
+ Qed.
+
+ Lemma nth_split n l d : n < length l ->
+ exists l1, exists l2, l = l1 ++ nth n l d :: l2 /\ length l1 = n.
+ Proof.
+ revert l.
+ induction n as [|n IH]; intros [|a l] H; try easy.
+ - exists nil; exists l; now simpl.
+ - destruct (IH l) as (l1 & l2 & Hl & Hl1); auto with arith.
+ exists (a::l1); exists l2; simpl; split; now f_equal.
Qed.
+ (** Results about [nth_error] *)
+ Lemma nth_error_In l n x : nth_error l n = Some x -> In x l.
+ Proof.
+ revert n. induction l as [|a l IH]; intros [|n]; simpl; try easy.
+ - injection 1; auto.
+ - eauto.
+ Qed.
+ Lemma In_nth_error l x : In x l -> exists n, nth_error l n = Some x.
+ Proof.
+ induction l as [|a l IH].
+ - easy.
+ - intros [H|H].
+ * subst; exists 0; simpl; auto with arith.
+ * destruct (IH H) as (n,Hn).
+ exists (S n); simpl; auto with arith.
+ Qed.
+
+ Lemma nth_error_None l n : nth_error l n = None <-> length l <= n.
+ Proof.
+ revert n. induction l; destruct n; simpl.
+ - split; auto.
+ - split; auto with arith.
+ - split; now auto with arith.
+ - rewrite IHl; split; auto with arith.
+ Qed.
+
+ Lemma nth_error_Some l n : nth_error l n <> None <-> n < length l.
+ Proof.
+ revert n. induction l; destruct n; simpl.
+ - split; [now destruct 1 | inversion 1].
+ - split; [now destruct 1 | inversion 1].
+ - split; now auto with arith.
+ - rewrite IHl; split; auto with arith.
+ Qed.
+
+ Lemma nth_error_split l n a : nth_error l n = Some a ->
+ exists l1, exists l2, l = l1 ++ a :: l2 /\ length l1 = n.
+ Proof.
+ revert l.
+ induction n as [|n IH]; intros [|x l] H; simpl in *; try easy.
+ - exists nil; exists l. injection H; clear H; intros; now subst.
+ - destruct (IH _ H) as (l1 & l2 & H1 & H2).
+ exists (x::l1); exists l2; simpl; split; now f_equal.
+ Qed.
+
+ Lemma nth_error_app1 l l' n : n < length l ->
+ nth_error (l++l') n = nth_error l n.
+ Proof.
+ revert l.
+ induction n; intros [|a l] H; auto; try solve [inversion H].
+ simpl in *. apply IHn. auto with arith.
+ Qed.
+
+ Lemma nth_error_app2 l l' n : length l <= n ->
+ nth_error (l++l') n = nth_error l' (n-length l).
+ Proof.
+ revert l.
+ induction n; intros [|a l] H; auto; try solve [inversion H].
+ simpl in *. apply IHn. auto with arith.
+ Qed.
(*****************)
(** ** Remove *)
@@ -541,19 +630,29 @@ Section Elts.
match l with
| [] => 0
| y :: tl =>
- let n := count_occ tl x in
- if eq_dec y x then S n else n
+ let n := count_occ tl x in
+ if eq_dec y x then S n else n
end.
(** Compatibility of count_occ with operations on list *)
- Theorem count_occ_In (l : list A) (x : A) : In x l <-> count_occ l x > 0.
+ Theorem count_occ_In l x : In x l <-> count_occ l x > 0.
Proof.
induction l as [|y l]; simpl.
- split; [destruct 1 | apply gt_irrefl].
- destruct eq_dec as [->|Hneq]; rewrite IHl; intuition.
Qed.
- Theorem count_occ_inv_nil (l : list A) :
+ Theorem count_occ_not_In l x : ~ In x l <-> count_occ l x = 0.
+ Proof.
+ rewrite count_occ_In. unfold gt. now rewrite Nat.nlt_ge, Nat.le_0_r.
+ Qed.
+
+ Lemma count_occ_nil x : count_occ [] x = 0.
+ Proof.
+ reflexivity.
+ Qed.
+
+ Theorem count_occ_inv_nil l :
(forall x:A, count_occ l x = 0) <-> l = [].
Proof.
split.
@@ -563,27 +662,20 @@ Section Elts.
- now intros ->.
Qed.
- Lemma count_occ_nil : forall (x : A), count_occ [] x = 0.
- Proof.
- intro x; simpl; reflexivity.
- Qed.
-
- Lemma count_occ_cons_eq : forall (l : list A) (x y : A), x = y -> count_occ (x::l) y = S (count_occ l y).
+ Lemma count_occ_cons_eq l x y :
+ x = y -> count_occ (x::l) y = S (count_occ l y).
Proof.
- intros l x y H; simpl.
- destruct (eq_dec x y); [reflexivity | contradiction].
+ intros H. simpl. now destruct (eq_dec x y).
Qed.
- Lemma count_occ_cons_neq : forall (l : list A) (x y : A), x <> y -> count_occ (x::l) y = count_occ l y.
+ Lemma count_occ_cons_neq l x y :
+ x <> y -> count_occ (x::l) y = count_occ l y.
Proof.
- intros l x y H; simpl.
- destruct (eq_dec x y); [contradiction | reflexivity].
+ intros H. simpl. now destruct (eq_dec x y).
Qed.
End Elts.
-
-
(*******************************)
(** * Manipulating whole lists *)
(*******************************)
@@ -739,6 +831,33 @@ Section ListOps.
End Reverse_Induction.
+ (*************************)
+ (** ** Concatenation *)
+ (*************************)
+
+ Fixpoint concat (l : list (list A)) : list A :=
+ match l with
+ | nil => nil
+ | cons x l => x ++ concat l
+ end.
+
+ Lemma concat_nil : concat nil = nil.
+ Proof.
+ reflexivity.
+ Qed.
+
+ Lemma concat_cons : forall x l, concat (cons x l) = x ++ concat l.
+ Proof.
+ reflexivity.
+ Qed.
+
+ Lemma concat_app : forall l1 l2, concat (l1 ++ l2) = concat l1 ++ concat l2.
+ Proof.
+ intros l1; induction l1 as [|x l1 IH]; intros l2; simpl.
+ + reflexivity.
+ + rewrite IH; apply app_assoc.
+ Qed.
+
(***********************************)
(** ** Decidable equality on lists *)
(***********************************)
@@ -759,15 +878,20 @@ End ListOps.
(************)
Section Map.
- Variables A B : Type.
+ Variables (A : Type) (B : Type).
Variable f : A -> B.
Fixpoint map (l:list A) : list B :=
match l with
- | nil => nil
- | cons a t => cons (f a) (map t)
+ | [] => []
+ | a :: t => (f a) :: (map t)
end.
+ Lemma map_cons (x:A)(l:list A) : map (x::l) = (f x) :: (map l).
+ Proof.
+ reflexivity.
+ Qed.
+
Lemma in_map :
forall (l:list A) (x:A), In x l -> In (f x) (map l).
Proof.
@@ -815,6 +939,25 @@ Section Map.
destruct l; simpl; reflexivity || discriminate.
Qed.
+ (** [map] and count of occurrences *)
+
+ Hypothesis decA: forall x1 x2 : A, {x1 = x2} + {x1 <> x2}.
+ Hypothesis decB: forall y1 y2 : B, {y1 = y2} + {y1 <> y2}.
+ Hypothesis Hfinjective: forall x1 x2: A, (f x1) = (f x2) -> x1 = x2.
+
+ Theorem count_occ_map x l:
+ count_occ decA l x = count_occ decB (map l) (f x).
+ Proof.
+ revert x. induction l as [| a l' Hrec]; intro x; simpl.
+ - reflexivity.
+ - specialize (Hrec x).
+ destruct (decA a x) as [H1|H1], (decB (f a) (f x)) as [H2|H2].
+ * rewrite Hrec. reflexivity.
+ * contradiction H2. rewrite H1. reflexivity.
+ * specialize (Hfinjective H2). contradiction H1.
+ * assumption.
+ Qed.
+
(** [flat_map] *)
Definition flat_map (f:A -> list B) :=
@@ -826,7 +969,7 @@ Section Map.
Lemma in_flat_map : forall (f:A->list B)(l:list A)(y:B),
In y (flat_map f l) <-> exists x, In x l /\ In y (f x).
- Proof.
+ Proof using A B.
induction l; simpl; split; intros.
contradiction.
destruct H as (x,(H,_)); contradiction.
@@ -843,6 +986,21 @@ Section Map.
End Map.
+Lemma flat_map_concat_map : forall A B (f : A -> list B) l,
+ flat_map f l = concat (map f l).
+Proof.
+intros A B f l; induction l as [|x l IH]; simpl.
++ reflexivity.
++ rewrite IH; reflexivity.
+Qed.
+
+Lemma concat_map : forall A B (f : A -> B) l, map f (concat l) = concat (map (map f) l).
+Proof.
+intros A B f l; induction l as [|x l IH]; simpl.
++ reflexivity.
++ rewrite map_app, IH; reflexivity.
+Qed.
+
Lemma map_id : forall (A :Type) (l : list A),
map (fun x => x) l = l.
Proof.
@@ -869,7 +1027,7 @@ Qed.
(************************************)
Section Fold_Left_Recursor.
- Variables A B : Type.
+ Variables (A : Type) (B : Type).
Variable f : A -> B -> A.
Fixpoint fold_left (l:list B) (a0:A) : A :=
@@ -893,10 +1051,8 @@ End Fold_Left_Recursor.
Lemma fold_left_length :
forall (A:Type)(l:list A), fold_left (fun x _ => S x) l 0 = length l.
Proof.
- intro A.
- cut (forall (l:list A) n, fold_left (fun x _ => S x) l n = n + length l).
- intros.
- exact (H l 0).
+ intros A l.
+ enough (H : forall n, fold_left (fun x _ => S x) l n = n + length l) by exact (H 0).
induction l; simpl; auto.
intros; rewrite IHl.
simpl; auto with arith.
@@ -907,7 +1063,7 @@ Qed.
(************************************)
Section Fold_Right_Recursor.
- Variables A B : Type.
+ Variables (A : Type) (B : Type).
Variable f : B -> A -> A.
Variable a0 : A.
@@ -939,29 +1095,17 @@ End Fold_Right_Recursor.
Qed.
Theorem fold_symmetric :
- forall (A:Type) (f:A -> A -> A),
- (forall x y z:A, f x (f y z) = f (f x y) z) ->
- (forall x y:A, f x y = f y x) ->
- forall (a0:A) (l:list A), fold_left f l a0 = fold_right f a0 l.
+ forall (A : Type) (f : A -> A -> A),
+ (forall x y z : A, f x (f y z) = f (f x y) z) ->
+ forall (a0 : A), (forall y : A, f a0 y = f y a0) ->
+ forall (l : list A), fold_left f l a0 = fold_right f a0 l.
Proof.
- destruct l as [| a l].
- reflexivity.
- simpl.
- rewrite <- H0.
- generalize a0 a.
- induction l as [| a3 l IHl]; simpl.
- trivial.
- intros.
- rewrite H.
- rewrite (H0 a2).
- rewrite <- (H a1).
- rewrite (H0 a1).
- rewrite IHl.
- reflexivity.
+ intros A f assoc a0 comma0 l.
+ induction l as [ | a1 l ]; [ simpl; reflexivity | ].
+ simpl. rewrite <- IHl. clear IHl. revert a1. induction l; [ auto | ].
+ simpl. intro. rewrite <- assoc. rewrite IHl. rewrite IHl. auto.
Qed.
-
-
(** [(list_power x y)] is [y^x], or the set of sequences of elts of [y]
indexed by elts of [x], sorted in lexicographic order. *)
@@ -1075,6 +1219,21 @@ End Fold_Right_Recursor.
| x :: tl => if f x then Some x else find tl
end.
+ Lemma find_some l x : find l = Some x -> In x l /\ f x = true.
+ Proof.
+ induction l as [|a l IH]; simpl; [easy| ].
+ case_eq (f a); intros Ha Eq.
+ * injection Eq as ->; auto.
+ * destruct (IH Eq); auto.
+ Qed.
+
+ Lemma find_none l : find l = None -> forall x, In x l -> f x = false.
+ Proof.
+ induction l as [|a l IH]; simpl; [easy|].
+ case_eq (f a); intros Ha Eq x IN; [easy|].
+ destruct IN as [<-|IN]; auto.
+ Qed.
+
(** [partition] *)
Fixpoint partition (l:list A) : list A * list A :=
@@ -1084,6 +1243,53 @@ End Fold_Right_Recursor.
if f x then (x::g,d) else (g,x::d)
end.
+ Theorem partition_cons1 a l l1 l2:
+ partition l = (l1, l2) ->
+ f a = true ->
+ partition (a::l) = (a::l1, l2).
+ Proof.
+ simpl. now intros -> ->.
+ Qed.
+
+ Theorem partition_cons2 a l l1 l2:
+ partition l = (l1, l2) ->
+ f a=false ->
+ partition (a::l) = (l1, a::l2).
+ Proof.
+ simpl. now intros -> ->.
+ Qed.
+
+ Theorem partition_length l l1 l2:
+ partition l = (l1, l2) ->
+ length l = length l1 + length l2.
+ Proof.
+ revert l1 l2. induction l as [ | a l' Hrec]; intros l1 l2.
+ - now intros [= <- <- ].
+ - simpl. destruct (f a), (partition l') as (left, right);
+ intros [= <- <- ]; simpl; rewrite (Hrec left right); auto.
+ Qed.
+
+ Theorem partition_inv_nil (l : list A):
+ partition l = ([], []) <-> l = [].
+ Proof.
+ split.
+ - destruct l as [|a l' _].
+ * intuition.
+ * simpl. destruct (f a), (partition l'); now intros [= -> ->].
+ - now intros ->.
+ Qed.
+
+ Theorem elements_in_partition l l1 l2:
+ partition l = (l1, l2) ->
+ forall x:A, In x l <-> In x l1 \/ In x l2.
+ Proof.
+ revert l1 l2. induction l as [| a l' Hrec]; simpl; intros l1 l2 Eq x.
+ - injection Eq as <- <-. tauto.
+ - destruct (partition l') as (left, right).
+ specialize (Hrec left right eq_refl x).
+ destruct (f a); injection Eq as <- <-; simpl; tauto.
+ Qed.
+
End Bool.
@@ -1094,14 +1300,14 @@ End Fold_Right_Recursor.
(******************************************************)
Section ListPairs.
- Variables A B : Type.
+ Variables (A : Type) (B : Type).
(** [split] derives two lists from a list of pairs *)
Fixpoint split (l:list (A*B)) : list A * list B :=
match l with
- | nil => (nil, nil)
- | (x,y) :: tl => let (g,d) := split tl in (x::g, y::d)
+ | [] => ([], [])
+ | (x,y) :: tl => let (left,right) := split tl in (x::left, y::right)
end.
Lemma in_split_l : forall (l:list (A*B))(p:A*B),
@@ -1479,6 +1685,61 @@ Section Cutting.
End Cutting.
+(**********************************************************************)
+(** ** Predicate for List addition/removal (no need for decidability) *)
+(**********************************************************************)
+
+Section Add.
+
+ Variable A : Type.
+
+ (* [Add a l l'] means that [l'] is exactly [l], with [a] added
+ once somewhere *)
+ Inductive Add (a:A) : list A -> list A -> Prop :=
+ | Add_head l : Add a l (a::l)
+ | Add_cons x l l' : Add a l l' -> Add a (x::l) (x::l').
+
+ Lemma Add_app a l1 l2 : Add a (l1++l2) (l1++a::l2).
+ Proof.
+ induction l1; simpl; now constructor.
+ Qed.
+
+ Lemma Add_split a l l' :
+ Add a l l' -> exists l1 l2, l = l1++l2 /\ l' = l1++a::l2.
+ Proof.
+ induction 1.
+ - exists nil; exists l; split; trivial.
+ - destruct IHAdd as (l1 & l2 & Hl & Hl').
+ exists (x::l1); exists l2; split; simpl; f_equal; trivial.
+ Qed.
+
+ Lemma Add_in a l l' : Add a l l' ->
+ forall x, In x l' <-> In x (a::l).
+ Proof.
+ induction 1; intros; simpl in *; rewrite ?IHAdd; tauto.
+ Qed.
+
+ Lemma Add_length a l l' : Add a l l' -> length l' = S (length l).
+ Proof.
+ induction 1; simpl; auto with arith.
+ Qed.
+
+ Lemma Add_inv a l : In a l -> exists l', Add a l' l.
+ Proof.
+ intro Ha. destruct (in_split _ _ Ha) as (l1 & l2 & ->).
+ exists (l1 ++ l2). apply Add_app.
+ Qed.
+
+ Lemma incl_Add_inv a l u v :
+ ~In a l -> incl (a::l) v -> Add a u v -> incl l u.
+ Proof.
+ intros Ha H AD y Hy.
+ assert (Hy' : In y (a::u)).
+ { rewrite <- (Add_in AD). apply H; simpl; auto. }
+ destruct Hy'; [ subst; now elim Ha | trivial ].
+ Qed.
+
+End Add.
(********************************)
(** ** Lists without redundancy *)
@@ -1492,31 +1753,187 @@ Section ReDun.
| NoDup_nil : NoDup nil
| NoDup_cons : forall x l, ~ In x l -> NoDup l -> NoDup (x::l).
- Lemma NoDup_remove_1 : forall l l' a, NoDup (l++a::l') -> NoDup (l++l').
+ Lemma NoDup_Add a l l' : Add a l l' -> (NoDup l' <-> NoDup l /\ ~In a l).
Proof.
- induction l; simpl.
- inversion_clear 1; auto.
- inversion_clear 1.
- constructor.
- contradict H0.
- apply in_or_app; destruct (in_app_or _ _ _ H0); simpl; tauto.
- apply IHl with a0; auto.
+ induction 1 as [l|x l l' AD IH].
+ - split; [ inversion_clear 1; now split | now constructor ].
+ - split.
+ + inversion_clear 1. rewrite IH in *. rewrite (Add_in AD) in *.
+ simpl in *; split; try constructor; intuition.
+ + intros (N,IN). inversion_clear N. constructor.
+ * rewrite (Add_in AD); simpl in *; intuition.
+ * apply IH. split; trivial. simpl in *; intuition.
Qed.
- Lemma NoDup_remove_2 : forall l l' a, NoDup (l++a::l') -> ~In a (l++l').
+ Lemma NoDup_remove l l' a :
+ NoDup (l++a::l') -> NoDup (l++l') /\ ~In a (l++l').
Proof.
- induction l; simpl.
- inversion_clear 1; auto.
- inversion_clear 1.
- contradict H0.
- destruct H0.
- subst a0.
- apply in_or_app; right; red; auto.
- destruct (IHl _ _ H1); auto.
+ apply NoDup_Add. apply Add_app.
+ Qed.
+
+ Lemma NoDup_remove_1 l l' a : NoDup (l++a::l') -> NoDup (l++l').
+ Proof.
+ intros. now apply NoDup_remove with a.
+ Qed.
+
+ Lemma NoDup_remove_2 l l' a : NoDup (l++a::l') -> ~In a (l++l').
+ Proof.
+ intros. now apply NoDup_remove.
+ Qed.
+
+ Theorem NoDup_cons_iff a l:
+ NoDup (a::l) <-> ~ In a l /\ NoDup l.
+ Proof.
+ split.
+ + inversion_clear 1. now split.
+ + now constructor.
+ Qed.
+
+ (** Effective computation of a list without duplicates *)
+
+ Hypothesis decA: forall x y : A, {x = y} + {x <> y}.
+
+ Fixpoint nodup (l : list A) : list A :=
+ match l with
+ | [] => []
+ | x::xs => if in_dec decA x xs then nodup xs else x::(nodup xs)
+ end.
+
+ Lemma nodup_In l x : In x (nodup l) <-> In x l.
+ Proof.
+ induction l as [|a l' Hrec]; simpl.
+ - reflexivity.
+ - destruct (in_dec decA a l'); simpl; rewrite Hrec.
+ * intuition; now subst.
+ * reflexivity.
+ Qed.
+
+ Lemma NoDup_nodup l: NoDup (nodup l).
+ Proof.
+ induction l as [|a l' Hrec]; simpl.
+ - constructor.
+ - destruct (in_dec decA a l'); simpl.
+ * assumption.
+ * constructor; [ now rewrite nodup_In | assumption].
+ Qed.
+
+ Lemma nodup_inv k l a : nodup k = a :: l -> ~ In a l.
+ Proof.
+ intros H.
+ assert (H' : NoDup (a::l)).
+ { rewrite <- H. apply NoDup_nodup. }
+ now inversion_clear H'.
+ Qed.
+
+ Theorem NoDup_count_occ l:
+ NoDup l <-> (forall x:A, count_occ decA l x <= 1).
+ Proof.
+ induction l as [| a l' Hrec].
+ - simpl; split; auto. constructor.
+ - rewrite NoDup_cons_iff, Hrec, (count_occ_not_In decA). clear Hrec. split.
+ + intros (Ha, H) x. simpl. destruct (decA a x); auto.
+ subst; now rewrite Ha.
+ + split.
+ * specialize (H a). rewrite count_occ_cons_eq in H; trivial.
+ now inversion H.
+ * intros x. specialize (H x). simpl in *. destruct (decA a x); auto.
+ now apply Nat.lt_le_incl.
+ Qed.
+
+ Theorem NoDup_count_occ' l:
+ NoDup l <-> (forall x:A, In x l -> count_occ decA l x = 1).
+ Proof.
+ rewrite NoDup_count_occ.
+ setoid_rewrite (count_occ_In decA). unfold gt, lt in *.
+ split; intros H x; specialize (H x);
+ set (n := count_occ decA l x) in *; clearbody n.
+ (* the rest would be solved by omega if we had it here... *)
+ - now apply Nat.le_antisymm.
+ - destruct (Nat.le_gt_cases 1 n); trivial.
+ + rewrite H; trivial.
+ + now apply Nat.lt_le_incl.
+ Qed.
+
+ (** Alternative characterisations of being without duplicates,
+ thanks to [nth_error] and [nth] *)
+
+ Lemma NoDup_nth_error l :
+ NoDup l <->
+ (forall i j, i<length l -> nth_error l i = nth_error l j -> i = j).
+ Proof.
+ split.
+ { intros H; induction H as [|a l Hal Hl IH]; intros i j Hi E.
+ - inversion Hi.
+ - destruct i, j; simpl in *; auto.
+ * elim Hal. eapply nth_error_In; eauto.
+ * elim Hal. eapply nth_error_In; eauto.
+ * f_equal. apply IH; auto with arith. }
+ { induction l as [|a l]; intros H; constructor.
+ * intro Ha. apply In_nth_error in Ha. destruct Ha as (n,Hn).
+ assert (n < length l) by (now rewrite <- nth_error_Some, Hn).
+ specialize (H 0 (S n)). simpl in H. discriminate H; auto with arith.
+ * apply IHl.
+ intros i j Hi E. apply eq_add_S, H; simpl; auto with arith. }
+ Qed.
+
+ Lemma NoDup_nth l d :
+ NoDup l <->
+ (forall i j, i<length l -> j<length l ->
+ nth i l d = nth j l d -> i = j).
+ Proof.
+ split.
+ { intros H; induction H as [|a l Hal Hl IH]; intros i j Hi Hj E.
+ - inversion Hi.
+ - destruct i, j; simpl in *; auto.
+ * elim Hal. subst a. apply nth_In; auto with arith.
+ * elim Hal. subst a. apply nth_In; auto with arith.
+ * f_equal. apply IH; auto with arith. }
+ { induction l as [|a l]; intros H; constructor.
+ * intro Ha. eapply In_nth in Ha. destruct Ha as (n & Hn & Hn').
+ specialize (H 0 (S n)). simpl in H. discriminate H; eauto with arith.
+ * apply IHl.
+ intros i j Hi Hj E. apply eq_add_S, H; simpl; auto with arith. }
+ Qed.
+
+ (** Having [NoDup] hypotheses bring more precise facts about [incl]. *)
+
+ Lemma NoDup_incl_length l l' :
+ NoDup l -> incl l l' -> length l <= length l'.
+ Proof.
+ intros N. revert l'. induction N as [|a l Hal N IH]; simpl.
+ - auto with arith.
+ - intros l' H.
+ destruct (Add_inv a l') as (l'', AD). { apply H; simpl; auto. }
+ rewrite (Add_length AD). apply le_n_S. apply IH.
+ now apply incl_Add_inv with a l'.
+ Qed.
+
+ Lemma NoDup_length_incl l l' :
+ NoDup l -> length l' <= length l -> incl l l' -> incl l' l.
+ Proof.
+ intros N. revert l'. induction N as [|a l Hal N IH].
+ - destruct l'; easy.
+ - intros l' E H x Hx.
+ destruct (Add_inv a l') as (l'', AD). { apply H; simpl; auto. }
+ rewrite (Add_in AD) in Hx. simpl in Hx.
+ destruct Hx as [Hx|Hx]; [left; trivial|right].
+ revert x Hx. apply (IH l''); trivial.
+ * apply le_S_n. now rewrite <- (Add_length AD).
+ * now apply incl_Add_inv with a l'.
Qed.
End ReDun.
+(** NoDup and map *)
+
+(** NB: the reciprocal result holds only for injective functions,
+ see FinFun.v *)
+
+Lemma NoDup_map_inv A B (f:A->B) l : NoDup (map f l) -> NoDup l.
+Proof.
+ induction l; simpl; inversion_clear 1; subst; constructor; auto.
+ intro H. now apply (in_map f) in H.
+Qed.
(***********************************)
(** ** Sequence of natural numbers *)
@@ -1558,149 +1975,252 @@ Section NatSeq.
auto with arith.
Qed.
+ Lemma in_seq len start n :
+ In n (seq start len) <-> start <= n < start+len.
+ Proof.
+ revert start. induction len; simpl; intros.
+ - rewrite <- plus_n_O. split;[easy|].
+ intros (H,H'). apply (Lt.lt_irrefl _ (Lt.le_lt_trans _ _ _ H H')).
+ - rewrite IHlen, <- plus_n_Sm; simpl; split.
+ * intros [H|H]; subst; intuition auto with arith.
+ * intros (H,H'). destruct (Lt.le_lt_or_eq _ _ H); intuition.
+ Qed.
+
+ Lemma seq_NoDup len start : NoDup (seq start len).
+ Proof.
+ revert start; induction len; simpl; constructor; trivial.
+ rewrite in_seq. intros (H,_). apply (Lt.lt_irrefl _ H).
+ Qed.
+
End NatSeq.
+Section Exists_Forall.
-(** * Existential and universal predicates over lists *)
+ (** * Existential and universal predicates over lists *)
-Inductive Exists {A} (P:A->Prop) : list A -> Prop :=
- | Exists_cons_hd : forall x l, P x -> Exists P (x::l)
- | Exists_cons_tl : forall x l, Exists P l -> Exists P (x::l).
-Hint Constructors Exists.
+ Variable A:Type.
-Lemma Exists_exists : forall A P (l:list A),
- Exists P l <-> (exists x, In x l /\ P x).
-Proof.
-split.
-induction 1; firstorder.
-induction l; firstorder; subst; auto.
-Qed.
+ Section One_predicate.
+
+ Variable P:A->Prop.
+
+ Inductive Exists : list A -> Prop :=
+ | Exists_cons_hd : forall x l, P x -> Exists (x::l)
+ | Exists_cons_tl : forall x l, Exists l -> Exists (x::l).
-Lemma Exists_nil : forall A (P:A->Prop), Exists P nil <-> False.
-Proof. split; inversion 1. Qed.
+ Hint Constructors Exists.
-Lemma Exists_cons : forall A (P:A->Prop) x l,
- Exists P (x::l) <-> P x \/ Exists P l.
-Proof. split; inversion 1; auto. Qed.
+ Lemma Exists_exists (l:list A) :
+ Exists l <-> (exists x, In x l /\ P x).
+ Proof.
+ split.
+ - induction 1; firstorder.
+ - induction l; firstorder; subst; auto.
+ Qed.
+ Lemma Exists_nil : Exists nil <-> False.
+ Proof. split; inversion 1. Qed.
+
+ Lemma Exists_cons x l:
+ Exists (x::l) <-> P x \/ Exists l.
+ Proof. split; inversion 1; auto. Qed.
+
+ Lemma Exists_dec l:
+ (forall x:A, {P x} + { ~ P x }) ->
+ {Exists l} + {~ Exists l}.
+ Proof.
+ intro Pdec. induction l as [|a l' Hrec].
+ - right. now rewrite Exists_nil.
+ - destruct Hrec as [Hl'|Hl'].
+ * left. now apply Exists_cons_tl.
+ * destruct (Pdec a) as [Ha|Ha].
+ + left. now apply Exists_cons_hd.
+ + right. now inversion_clear 1.
+ Qed.
-Inductive Forall {A} (P:A->Prop) : list A -> Prop :=
- | Forall_nil : Forall P nil
- | Forall_cons : forall x l, P x -> Forall P l -> Forall P (x::l).
+ Inductive Forall : list A -> Prop :=
+ | Forall_nil : Forall nil
+ | Forall_cons : forall x l, P x -> Forall l -> Forall (x::l).
+
+ Hint Constructors Forall.
+
+ Lemma Forall_forall (l:list A):
+ Forall l <-> (forall x, In x l -> P x).
+ Proof.
+ split.
+ - induction 1; firstorder; subst; auto.
+ - induction l; firstorder.
+ Qed.
+
+ Lemma Forall_inv : forall (a:A) l, Forall (a :: l) -> P a.
+ Proof.
+ intros; inversion H; trivial.
+ Qed.
+
+ Lemma Forall_rect : forall (Q : list A -> Type),
+ Q [] -> (forall b l, P b -> Q (b :: l)) -> forall l, Forall l -> Q l.
+ Proof.
+ intros Q H H'; induction l; intro; [|eapply H', Forall_inv]; eassumption.
+ Qed.
+
+ Lemma Forall_dec :
+ (forall x:A, {P x} + { ~ P x }) ->
+ forall l:list A, {Forall l} + {~ Forall l}.
+ Proof.
+ intro Pdec. induction l as [|a l' Hrec].
+ - left. apply Forall_nil.
+ - destruct Hrec as [Hl'|Hl'].
+ + destruct (Pdec a) as [Ha|Ha].
+ * left. now apply Forall_cons.
+ * right. now inversion_clear 1.
+ + right. now inversion_clear 1.
+ Qed.
+
+ End One_predicate.
+
+ Lemma Forall_Exists_neg (P:A->Prop)(l:list A) :
+ Forall (fun x => ~ P x) l <-> ~(Exists P l).
+ Proof.
+ rewrite Forall_forall, Exists_exists. firstorder.
+ Qed.
+
+ Lemma Exists_Forall_neg (P:A->Prop)(l:list A) :
+ (forall x, P x \/ ~P x) ->
+ Exists (fun x => ~ P x) l <-> ~(Forall P l).
+ Proof.
+ intro Dec.
+ split.
+ - rewrite Forall_forall, Exists_exists; firstorder.
+ - intros NF.
+ induction l as [|a l IH].
+ + destruct NF. constructor.
+ + destruct (Dec a) as [Ha|Ha].
+ * apply Exists_cons_tl, IH. contradict NF. now constructor.
+ * now apply Exists_cons_hd.
+ Qed.
+
+ Lemma Forall_Exists_dec (P:A->Prop) :
+ (forall x:A, {P x} + { ~ P x }) ->
+ forall l:list A,
+ {Forall P l} + {Exists (fun x => ~ P x) l}.
+ Proof.
+ intros Pdec l.
+ destruct (Forall_dec P Pdec l); [left|right]; trivial.
+ apply Exists_Forall_neg; trivial.
+ intro x. destruct (Pdec x); [now left|now right].
+ Qed.
+
+ Lemma Forall_impl : forall (P Q : A -> Prop), (forall a, P a -> Q a) ->
+ forall l, Forall P l -> Forall Q l.
+ Proof.
+ intros P Q H l. rewrite !Forall_forall. firstorder.
+ Qed.
+
+End Exists_Forall.
+
+Hint Constructors Exists.
Hint Constructors Forall.
-Lemma Forall_forall : forall A P (l:list A),
- Forall P l <-> (forall x, In x l -> P x).
-Proof.
-split.
-induction 1; firstorder; subst; auto.
-induction l; firstorder.
-Qed.
+Section Forall2.
-Lemma Forall_inv : forall A P (a:A) l, Forall P (a :: l) -> P a.
-Proof.
-intros; inversion H; trivial.
-Defined.
+ (** [Forall2]: stating that elements of two lists are pairwise related. *)
-Lemma Forall_rect : forall A (P:A->Prop) (Q : list A -> Type),
- Q [] -> (forall b l, P b -> Q (b :: l)) -> forall l, Forall P l -> Q l.
-Proof.
-intros A P Q H H'; induction l; intro; [|eapply H', Forall_inv]; eassumption.
-Defined.
+ Variables A B : Type.
+ Variable R : A -> B -> Prop.
-Lemma Forall_impl : forall A (P Q : A -> Prop), (forall a, P a -> Q a) ->
- forall l, Forall P l -> Forall Q l.
-Proof.
- intros A P Q Himp l H.
- induction H; firstorder.
-Qed.
+ Inductive Forall2 : list A -> list B -> Prop :=
+ | Forall2_nil : Forall2 [] []
+ | Forall2_cons : forall x y l l',
+ R x y -> Forall2 l l' -> Forall2 (x::l) (y::l').
-(** [Forall2]: stating that elements of two lists are pairwise related. *)
+ Hint Constructors Forall2.
-Inductive Forall2 A B (R:A->B->Prop) : list A -> list B -> Prop :=
- | Forall2_nil : Forall2 R [] []
- | Forall2_cons : forall x y l l',
- R x y -> Forall2 R l l' -> Forall2 R (x::l) (y::l').
-Hint Constructors Forall2.
+ Theorem Forall2_refl : Forall2 [] [].
+ Proof. intros; apply Forall2_nil. Qed.
+
+ Theorem Forall2_app_inv_l : forall l1 l2 l',
+ Forall2 (l1 ++ l2) l' ->
+ exists l1' l2', Forall2 l1 l1' /\ Forall2 l2 l2' /\ l' = l1' ++ l2'.
+ Proof.
+ induction l1; intros.
+ exists [], l'; auto.
+ simpl in H; inversion H; subst; clear H.
+ apply IHl1 in H4 as (l1' & l2' & Hl1 & Hl2 & ->).
+ exists (y::l1'), l2'; simpl; auto.
+ Qed.
-Theorem Forall2_refl : forall A B (R:A->B->Prop), Forall2 R [] [].
-Proof. exact Forall2_nil. Qed.
+ Theorem Forall2_app_inv_r : forall l1' l2' l,
+ Forall2 l (l1' ++ l2') ->
+ exists l1 l2, Forall2 l1 l1' /\ Forall2 l2 l2' /\ l = l1 ++ l2.
+ Proof.
+ induction l1'; intros.
+ exists [], l; auto.
+ simpl in H; inversion H; subst; clear H.
+ apply IHl1' in H4 as (l1 & l2 & Hl1 & Hl2 & ->).
+ exists (x::l1), l2; simpl; auto.
+ Qed.
-Theorem Forall2_app_inv_l : forall A B (R:A->B->Prop) l1 l2 l',
- Forall2 R (l1 ++ l2) l' ->
- exists l1' l2', Forall2 R l1 l1' /\ Forall2 R l2 l2' /\ l' = l1' ++ l2'.
-Proof.
- induction l1; intros.
- exists [], l'; auto.
- simpl in H; inversion H; subst; clear H.
- apply IHl1 in H4 as (l1' & l2' & Hl1 & Hl2 & ->).
- exists (y::l1'), l2'; simpl; auto.
-Qed.
+ Theorem Forall2_app : forall l1 l2 l1' l2',
+ Forall2 l1 l1' -> Forall2 l2 l2' -> Forall2 (l1 ++ l2) (l1' ++ l2').
+ Proof.
+ intros. induction l1 in l1', H, H0 |- *; inversion H; subst; simpl; auto.
+ Qed.
+End Forall2.
-Theorem Forall2_app_inv_r : forall A B (R:A->B->Prop) l1' l2' l,
- Forall2 R l (l1' ++ l2') ->
- exists l1 l2, Forall2 R l1 l1' /\ Forall2 R l2 l2' /\ l = l1 ++ l2.
-Proof.
- induction l1'; intros.
- exists [], l; auto.
- simpl in H; inversion H; subst; clear H.
- apply IHl1' in H4 as (l1 & l2 & Hl1 & Hl2 & ->).
- exists (x::l1), l2; simpl; auto.
-Qed.
+Hint Constructors Forall2.
-Theorem Forall2_app : forall A B (R:A->B->Prop) l1 l2 l1' l2',
- Forall2 R l1 l1' -> Forall2 R l2 l2' -> Forall2 R (l1 ++ l2) (l1' ++ l2').
-Proof.
- intros. induction l1 in l1', H, H0 |- *; inversion H; subst; simpl; auto.
-Qed.
+Section ForallPairs.
-(** [ForallPairs] : specifies that a certain relation should
+ (** [ForallPairs] : specifies that a certain relation should
always hold when inspecting all possible pairs of elements of a list. *)
-Definition ForallPairs A (R : A -> A -> Prop) l :=
- forall a b, In a l -> In b l -> R a b.
+ Variable A : Type.
+ Variable R : A -> A -> Prop.
-(** [ForallOrdPairs] : we still check a relation over all pairs
+ Definition ForallPairs l :=
+ forall a b, In a l -> In b l -> R a b.
+
+ (** [ForallOrdPairs] : we still check a relation over all pairs
of elements of a list, but now the order of elements matters. *)
-Inductive ForallOrdPairs A (R : A -> A -> Prop) : list A -> Prop :=
- | FOP_nil : ForallOrdPairs R nil
- | FOP_cons : forall a l,
- Forall (R a) l -> ForallOrdPairs R l -> ForallOrdPairs R (a::l).
-Hint Constructors ForallOrdPairs.
+ Inductive ForallOrdPairs : list A -> Prop :=
+ | FOP_nil : ForallOrdPairs nil
+ | FOP_cons : forall a l,
+ Forall (R a) l -> ForallOrdPairs l -> ForallOrdPairs (a::l).
-Lemma ForallOrdPairs_In : forall A (R:A->A->Prop) l,
- ForallOrdPairs R l ->
- forall x y, In x l -> In y l -> x=y \/ R x y \/ R y x.
-Proof.
- induction 1.
- inversion 1.
- simpl; destruct 1; destruct 1; repeat subst; auto.
- right; left. apply -> Forall_forall; eauto.
- right; right. apply -> Forall_forall; eauto.
-Qed.
+ Hint Constructors ForallOrdPairs.
+ Lemma ForallOrdPairs_In : forall l,
+ ForallOrdPairs l ->
+ forall x y, In x l -> In y l -> x=y \/ R x y \/ R y x.
+ Proof.
+ induction 1.
+ inversion 1.
+ simpl; destruct 1; destruct 1; repeat subst; auto.
+ right; left. apply -> Forall_forall; eauto.
+ right; right. apply -> Forall_forall; eauto.
+ Qed.
-(** [ForallPairs] implies [ForallOrdPairs]. The reverse implication is true
+ (** [ForallPairs] implies [ForallOrdPairs]. The reverse implication is true
only when [R] is symmetric and reflexive. *)
-Lemma ForallPairs_ForallOrdPairs : forall A (R:A->A->Prop) l,
- ForallPairs R l -> ForallOrdPairs R l.
-Proof.
- induction l; auto. intros H.
- constructor.
- apply <- Forall_forall. intros; apply H; simpl; auto.
- apply IHl. red; intros; apply H; simpl; auto.
-Qed.
+ Lemma ForallPairs_ForallOrdPairs l: ForallPairs l -> ForallOrdPairs l.
+ Proof.
+ induction l; auto. intros H.
+ constructor.
+ apply <- Forall_forall. intros; apply H; simpl; auto.
+ apply IHl. red; intros; apply H; simpl; auto.
+ Qed.
-Lemma ForallOrdPairs_ForallPairs : forall A (R:A->A->Prop),
- (forall x, R x x) ->
- (forall x y, R x y -> R y x) ->
- forall l, ForallOrdPairs R l -> ForallPairs R l.
-Proof.
- intros A R Refl Sym l Hl x y Hx Hy.
- destruct (ForallOrdPairs_In Hl _ _ Hx Hy); subst; intuition.
-Qed.
+ Lemma ForallOrdPairs_ForallPairs :
+ (forall x, R x x) ->
+ (forall x y, R x y -> R y x) ->
+ forall l, ForallOrdPairs l -> ForallPairs l.
+ Proof.
+ intros Refl Sym l Hl x y Hx Hy.
+ destruct (ForallOrdPairs_In Hl _ _ Hx Hy); subst; intuition.
+ Qed.
+End ForallPairs.
(** * Inversion of predicates over lists based on head symbol *)
@@ -1767,3 +2287,28 @@ Notation AllS := Forall (only parsing). (* was formerly in TheoryList *)
Hint Resolve app_nil_end : datatypes v62.
(* end hide *)
+
+Section Repeat.
+
+ Variable A : Type.
+ Fixpoint repeat (x : A) (n: nat ) :=
+ match n with
+ | O => []
+ | S k => x::(repeat x k)
+ end.
+
+ Theorem repeat_length x n:
+ length (repeat x n) = n.
+ Proof.
+ induction n as [| k Hrec]; simpl; rewrite ?Hrec; reflexivity.
+ Qed.
+
+ Theorem repeat_spec n x y:
+ In y (repeat x n) -> y=x.
+ Proof.
+ induction n as [|k Hrec]; simpl; destruct 1; auto.
+ Qed.
+
+End Repeat.
+
+(* Unset Universe Polymorphism. *)
diff --git a/theories/Lists/ListDec.v b/theories/Lists/ListDec.v
new file mode 100644
index 00000000..8bd2daaf
--- /dev/null
+++ b/theories/Lists/ListDec.v
@@ -0,0 +1,103 @@
+(************************************************************************)
+(* v * The Coq Proof Assistant / The Coq Development Team *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* \VV/ **************************************************************)
+(* // * This file is distributed under the terms of the *)
+(* * GNU Lesser General Public License Version 2.1 *)
+(************************************************************************)
+
+(** Decidability results about lists *)
+
+Require Import List Decidable.
+Set Implicit Arguments.
+
+Definition decidable_eq A := forall x y:A, decidable (x=y).
+
+Section Dec_in_Prop.
+Variables (A:Type)(dec:decidable_eq A).
+
+Lemma In_decidable x (l:list A) : decidable (In x l).
+Proof using A dec.
+ induction l as [|a l IH].
+ - now right.
+ - destruct (dec a x).
+ + left. now left.
+ + destruct IH; simpl; [left|right]; tauto.
+Qed.
+
+Lemma incl_decidable (l l':list A) : decidable (incl l l').
+Proof using A dec.
+ induction l as [|a l IH].
+ - left. inversion 1.
+ - destruct (In_decidable a l') as [IN|IN].
+ + destruct IH as [IC|IC].
+ * left. destruct 1; subst; auto.
+ * right. contradict IC. intros x H. apply IC; now right.
+ + right. contradict IN. apply IN; now left.
+Qed.
+
+Lemma NoDup_decidable (l:list A) : decidable (NoDup l).
+Proof using A dec.
+ induction l as [|a l IH].
+ - left; now constructor.
+ - destruct (In_decidable a l).
+ + right. inversion_clear 1. tauto.
+ + destruct IH.
+ * left. now constructor.
+ * right. inversion_clear 1. tauto.
+Qed.
+
+End Dec_in_Prop.
+
+Section Dec_in_Type.
+Variables (A:Type)(dec : forall x y:A, {x=y}+{x<>y}).
+
+Definition In_dec := List.In_dec dec. (* Already in List.v *)
+
+Lemma incl_dec (l l':list A) : {incl l l'}+{~incl l l'}.
+Proof using A dec.
+ induction l as [|a l IH].
+ - left. inversion 1.
+ - destruct (In_dec a l') as [IN|IN].
+ + destruct IH as [IC|IC].
+ * left. destruct 1; subst; auto.
+ * right. contradict IC. intros x H. apply IC; now right.
+ + right. contradict IN. apply IN; now left.
+Qed.
+
+Lemma NoDup_dec (l:list A) : {NoDup l}+{~NoDup l}.
+Proof using A dec.
+ induction l as [|a l IH].
+ - left; now constructor.
+ - destruct (In_dec a l).
+ + right. inversion_clear 1. tauto.
+ + destruct IH.
+ * left. now constructor.
+ * right. inversion_clear 1. tauto.
+Qed.
+
+End Dec_in_Type.
+
+(** An extra result: thanks to decidability, a list can be purged
+ from redundancies. *)
+
+Lemma uniquify_map A B (d:decidable_eq B)(f:A->B)(l:list A) :
+ exists l', NoDup (map f l') /\ incl (map f l) (map f l').
+Proof.
+ induction l.
+ - exists nil. simpl. split; [now constructor | red; trivial].
+ - destruct IHl as (l' & N & I).
+ destruct (In_decidable d (f a) (map f l')).
+ + exists l'; simpl; split; trivial.
+ intros x [Hx|Hx]. now subst. now apply I.
+ + exists (a::l'); simpl; split.
+ * now constructor.
+ * intros x [Hx|Hx]. subst; now left. right; now apply I.
+Qed.
+
+Lemma uniquify A (d:decidable_eq A)(l:list A) :
+ exists l', NoDup l' /\ incl l l'.
+Proof.
+ destruct (uniquify_map d id l) as (l',H).
+ exists l'. now rewrite !map_id in H.
+Qed.
diff --git a/theories/Lists/ListSet.v b/theories/Lists/ListSet.v
index 37d051a3..0a0bf0de 100644
--- a/theories/Lists/ListSet.v
+++ b/theories/Lists/ListSet.v
@@ -1,16 +1,18 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
(************************************************************************)
-(** A Library for finite sets, implemented as lists *)
+(** A library for finite sets, implemented as lists *)
-(** List is loaded, but not exported.
- This allow to "hide" the definitions, functions and theorems of List
- and to see only the ones of ListSet *)
+(** This is a light implementation of finite sets as lists; for a more
+ extensive library, you might rather consider MSetWeakList.v. In
+ addition, if your domain is totally ordered, you might also
+ consider implementations of finite sets with access in logarithmic
+ time (e.g. MSetRBT.v which is based on red-black trees). *)
Require Import List.
@@ -116,7 +118,7 @@ Section first_definitions.
simple induction x; simpl; intros.
apply H0; red; trivial.
case (Aeq_dec a a0); auto with datatypes.
- intro; apply H; intros; auto.
+ intro Hneg; apply H; intros; auto.
apply H1; red; intro.
case H3; auto.
Qed.
@@ -147,8 +149,8 @@ Section first_definitions.
simple induction x; simpl.
tauto.
intros a0 l; elim (Aeq_dec a a0).
- intros; discriminate H0.
- unfold not; intros; elim H1; auto with datatypes.
+ intros _ _ [=].
+ unfold not; intros H H0 H1 [|]; auto with datatypes.
Qed.
Lemma set_mem_complete2 :
@@ -157,7 +159,7 @@ Section first_definitions.
simple induction x; simpl.
tauto.
intros a0 l; elim (Aeq_dec a a0).
- intros; elim H0; auto with datatypes.
+ intros H H0 []; auto with datatypes.
tauto.
Qed.
@@ -204,7 +206,7 @@ Section first_definitions.
simpl; do 3 intro.
elim (Aeq_dec b a0).
simpl; tauto.
- simpl; intros; elim H0.
+ simpl; intros H0 [|].
trivial with datatypes.
tauto.
tauto.
diff --git a/theories/Lists/ListTactics.v b/theories/Lists/ListTactics.v
index 64c11cd8..f19d95a9 100644
--- a/theories/Lists/ListTactics.v
+++ b/theories/Lists/ListTactics.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Lists/SetoidList.v b/theories/Lists/SetoidList.v
index 0fd1693e..b57c3f04 100644
--- a/theories/Lists/SetoidList.v
+++ b/theories/Lists/SetoidList.v
@@ -11,7 +11,7 @@ Require Export Sorted.
Require Export Setoid Basics Morphisms.
Set Implicit Arguments.
Unset Strict Implicit.
-
+(* Set Universe Polymorphism. *)
(** * Logical relations over lists with respect to a setoid equality
or ordering. *)
@@ -34,7 +34,7 @@ Hint Constructors InA.
of the previous one. Having [InA = Exists eqA] raises too
many compatibility issues. For now, we only state the equivalence: *)
-Lemma InA_altdef : forall x l, InA x l <-> Exists (eqA x) l.
+Lemma InA_altdef : forall x l, InA x l <-> Exists (eqA x) l.
Proof. split; induction 1; auto. Qed.
Lemma InA_cons : forall x y l, InA x (y::l) <-> eqA x y \/ InA x l.
@@ -101,10 +101,12 @@ Proof. split; induction 1; auto. Qed.
(** Results concerning lists modulo [eqA] *)
Hypothesis eqA_equiv : Equivalence eqA.
-
-Hint Resolve (@Equivalence_Reflexive _ _ eqA_equiv).
-Hint Resolve (@Equivalence_Transitive _ _ eqA_equiv).
-Hint Immediate (@Equivalence_Symmetric _ _ eqA_equiv).
+Definition eqarefl := (@Equivalence_Reflexive _ _ eqA_equiv).
+Definition eqatrans := (@Equivalence_Transitive _ _ eqA_equiv).
+Definition eqasym := (@Equivalence_Symmetric _ _ eqA_equiv).
+
+Hint Resolve eqarefl eqatrans.
+Hint Immediate eqasym.
Ltac inv := invlist InA; invlist sort; invlist lelistA; invlist NoDupA.
@@ -123,7 +125,6 @@ Proof.
intros x y z H; revert z; induction H; auto.
inversion 1; subst; auto. invlist eqlistA; eauto with *.
Qed.
-
(** Moreover, [eqlistA] implies [equivlistA]. A reverse result
will be proved later for sorted list without duplicates. *)
@@ -149,7 +150,7 @@ Qed.
Lemma InA_eqA : forall l x y, eqA x y -> InA x l -> InA y l.
Proof.
- intros l x y H H'. rewrite <- H; auto.
+ intros l x y H H'. rewrite <- H. auto.
Qed.
Hint Immediate InA_eqA.
@@ -496,7 +497,7 @@ Proof.
apply Hrec; auto.
inv; auto.
eapply NoDupA_split; eauto.
- invlist ForallOrdPairs; auto.
+ invlist ForallOrdPairs; auto.
eapply equivlistA_NoDupA_split; eauto.
transitivity (f y (fold_right f i (s1++s2))).
apply Comp; auto. reflexivity.
@@ -545,6 +546,155 @@ Qed.
End Fold.
+
+Section Fold2.
+
+Variable B:Type.
+Variable eqB:B->B->Prop.
+Variable st:Equivalence eqB.
+Variable f:A->B->B.
+Variable Comp:Proper (eqA==>eqB==>eqB) f.
+
+
+Lemma fold_right_eqlistA2 :
+ forall s s' (i j:B) (heqij: eqB i j) (heqss': eqlistA s s'),
+ eqB (fold_right f i s) (fold_right f j s').
+Proof.
+ intros s.
+ induction s;intros.
+ - inversion heqss'.
+ subst.
+ simpl.
+ assumption.
+ - inversion heqss'.
+ subst.
+ simpl.
+ apply Comp.
+ + assumption.
+ + apply IHs;assumption.
+Qed.
+
+Section Fold2_With_Restriction.
+
+Variable R : A -> A -> Prop.
+Hypothesis R_sym : Symmetric R.
+Hypothesis R_compat : Proper (eqA==>eqA==>iff) R.
+
+(** Two-argument functions that allow to reorder their arguments. *)
+Definition transpose2 (f : A -> B -> B) :=
+ forall (x y : A) (z z': B), eqB z z' -> eqB (f x (f y z)) (f y (f x z')).
+
+(** A version of transpose with restriction on where it should hold *)
+Definition transpose_restr2 (R : A -> A -> Prop)(f : A -> B -> B) :=
+ forall (x y : A) (z z': B), R x y -> eqB z z' -> eqB (f x (f y z)) (f y (f x z')).
+
+Variable TraR :transpose_restr2 R f.
+
+Lemma fold_right_commutes_restr2 :
+ forall s1 s2 x (i j:B) (heqij: eqB i j), ForallOrdPairs R (s1++x::s2) ->
+ eqB (fold_right f i (s1++x::s2)) (f x (fold_right f j (s1++s2))).
+Proof.
+induction s1; simpl; auto; intros.
+- apply Comp.
+ + destruct eqA_equiv. apply Equivalence_Reflexive.
+ + eapply fold_right_eqlistA2.
+ * assumption.
+ * reflexivity.
+- transitivity (f a (f x (fold_right f j (s1++s2)))).
+ apply Comp; auto.
+ eapply IHs1.
+ assumption.
+ invlist ForallOrdPairs; auto.
+ apply TraR.
+ invlist ForallOrdPairs; auto.
+ rewrite Forall_forall in H0; apply H0.
+ apply in_or_app; simpl; auto.
+ reflexivity.
+Qed.
+
+Lemma fold_right_equivlistA_restr2 :
+ forall s s' (i j:B) (heqij: eqB i j),
+ NoDupA s -> NoDupA s' -> ForallOrdPairs R s ->
+ eqB i j ->
+ equivlistA s s' -> eqB (fold_right f i s) (fold_right f j s').
+Proof.
+ simple induction s.
+ destruct s'; simpl.
+ intros. assumption.
+ unfold equivlistA; intros.
+ destruct (H3 a).
+ assert (InA a nil) by auto; inv.
+ intros x l Hrec s' i j heqij N N' F eqij E; simpl in *.
+ assert (InA x s') by (rewrite <- (E x); auto).
+ destruct (InA_split H) as (s1,(y,(s2,(H1,H2)))).
+ subst s'.
+ transitivity (f x (fold_right f j (s1++s2))).
+ - apply Comp; auto.
+ apply Hrec; auto.
+ inv; auto.
+ eapply NoDupA_split; eauto.
+ invlist ForallOrdPairs; auto.
+ eapply equivlistA_NoDupA_split; eauto.
+ - transitivity (f y (fold_right f i (s1++s2))).
+ + apply Comp; auto.
+ symmetry.
+ apply fold_right_eqlistA2.
+ * assumption.
+ * reflexivity.
+ + symmetry.
+ apply fold_right_commutes_restr2.
+ symmetry.
+ assumption.
+ apply ForallOrdPairs_inclA with (x::l); auto.
+ red; intros; rewrite E; auto.
+Qed.
+
+
+Lemma fold_right_add_restr2 :
+ forall s' s i j x, NoDupA s -> NoDupA s' -> eqB i j -> ForallOrdPairs R s' -> ~ InA x s ->
+ equivlistA s' (x::s) -> eqB (fold_right f i s') (f x (fold_right f j s)).
+Proof.
+ intros; apply (@fold_right_equivlistA_restr2 s' (x::s) i j); auto.
+Qed.
+
+End Fold2_With_Restriction.
+
+Variable Tra :transpose2 f.
+
+Lemma fold_right_commutes2 : forall s1 s2 i x x',
+ eqA x x' ->
+ eqB (fold_right f i (s1++x::s2)) (f x' (fold_right f i (s1++s2))).
+Proof.
+ induction s1;simpl;intros.
+- apply Comp;auto.
+ reflexivity.
+- transitivity (f a (f x' (fold_right f i (s1++s2)))); auto.
+ + apply Comp;auto.
+ + apply Tra.
+ reflexivity.
+Qed.
+
+Lemma fold_right_equivlistA2 :
+ forall s s' i j, NoDupA s -> NoDupA s' -> eqB i j ->
+ equivlistA s s' -> eqB (fold_right f i s) (fold_right f j s').
+Proof.
+red in Tra.
+intros; apply fold_right_equivlistA_restr2 with (R:=fun _ _ => True);
+repeat red; auto.
+apply ForallPairs_ForallOrdPairs; try red; auto.
+Qed.
+
+Lemma fold_right_add2 :
+ forall s' s i j x, NoDupA s -> NoDupA s' -> eqB i j -> ~ InA x s ->
+ equivlistA s' (x::s) -> eqB (fold_right f i s') (f x (fold_right f j s)).
+Proof.
+ intros.
+ replace (f x (fold_right f j s)) with (fold_right f j (x::s)) by auto.
+ eapply fold_right_equivlistA2;auto.
+Qed.
+
+End Fold2.
+
Section Remove.
Hypothesis eqA_dec : forall x y : A, {eqA x y}+{~(eqA x y)}.
@@ -582,14 +732,14 @@ split.
intro; inv.
destruct 1; inv.
intros.
-destruct (eqA_dec x a); simpl; auto.
+destruct (eqA_dec x a) as [Heq|Hnot]; simpl; auto.
rewrite IHl; split; destruct 1; split; auto.
inv; auto.
destruct H0; transitivity a; auto.
split.
intro; inv.
split; auto.
-contradict n.
+contradict Hnot.
transitivity y; auto.
rewrite (IHl x y) in H0; destruct H0; auto.
destruct 1; inv; auto.
@@ -633,7 +783,9 @@ Variable ltA : A -> A -> Prop.
Hypothesis ltA_strorder : StrictOrder ltA.
Hypothesis ltA_compat : Proper (eqA==>eqA==>iff) ltA.
-Hint Resolve (@StrictOrder_Transitive _ _ ltA_strorder).
+Let sotrans := (@StrictOrder_Transitive _ _ ltA_strorder).
+
+Hint Resolve sotrans.
Notation InfA:=(lelistA ltA).
Notation SortA:=(sort ltA).
@@ -647,7 +799,7 @@ Proof.
Qed.
Global Instance InfA_compat : Proper (eqA==>eqlistA==>iff) InfA.
-Proof.
+Proof using eqA_equiv ltA_compat. (* and not ltA_strorder *)
intros x x' Hxx' l l' Hll'.
inversion_clear Hll'.
intuition.
@@ -658,7 +810,7 @@ Qed.
(** For compatibility, can be deduced from [InfA_compat] *)
Lemma InfA_eqA l x y : eqA x y -> InfA y l -> InfA x l.
-Proof.
+Proof using eqA_equiv ltA_compat.
intros H; now rewrite H.
Qed.
Hint Immediate InfA_ltA InfA_eqA.
@@ -759,7 +911,7 @@ Qed.
Global Instance rev_eqlistA_compat : Proper (eqlistA==>eqlistA) (@rev A).
Proof.
repeat red. intros.
-rewrite (app_nil_end (rev x)), (app_nil_end (rev y)).
+rewrite <- (app_nil_r (rev x)), <- (app_nil_r (rev y)).
apply eqlistA_rev_app; auto.
Qed.
@@ -815,13 +967,12 @@ intros.
rewrite filter_In in H; destruct H.
eapply SortA_InfA_InA; eauto.
Qed.
-
Arguments eq {A} x _.
Lemma filter_InA : forall f, Proper (eqA==>eq) f ->
forall l x, InA x (List.filter f l) <-> InA x l /\ f x = true.
Proof.
-clear ltA ltA_compat ltA_strorder.
+clear sotrans ltA ltA_strorder ltA_compat.
intros; do 2 rewrite InA_alt; intuition.
destruct H0 as (y,(H0,H1)); rewrite filter_In in H1; exists y; intuition.
destruct H0 as (y,(H0,H1)); rewrite filter_In in H1; intuition.
@@ -888,9 +1039,9 @@ split; intros.
invlist InA.
compute in H2; destruct H2. subst b'.
destruct (eqA_dec a a'); intuition.
-destruct (eqA_dec a a'); simpl.
+destruct (eqA_dec a a') as [HeqA|]; simpl.
contradict H0.
-revert e H2; clear - eqA_equiv.
+revert HeqA H2; clear - eqA_equiv.
induction l.
intros; invlist InA.
intros; invlist InA; auto.
diff --git a/theories/Lists/SetoidPermutation.v b/theories/Lists/SetoidPermutation.v
index b0657b63..afc7c25b 100644
--- a/theories/Lists/SetoidPermutation.v
+++ b/theories/Lists/SetoidPermutation.v
@@ -7,6 +7,7 @@
(***********************************************************************)
Require Import SetoidList.
+(* Set Universe Polymorphism. *)
Set Implicit Arguments.
Unset Strict Implicit.
@@ -88,7 +89,7 @@ Lemma PermutationA_cons_app l l₁ l₂ x :
PermutationA l (l₁ ++ l₂) -> PermutationA (x :: l) (l₁ ++ x :: l₂).
Proof.
intros E. rewrite E.
- now rewrite app_comm_cons, PermutationA_cons_append, <-app_assoc.
+ now rewrite app_comm_cons, (PermutationA_cons_append l₁ x), <- app_assoc.
Qed.
Lemma PermutationA_middle l₁ l₂ x :
diff --git a/theories/Lists/StreamMemo.v b/theories/Lists/StreamMemo.v
index fd5ab100..74d464c5 100644
--- a/theories/Lists/StreamMemo.v
+++ b/theories/Lists/StreamMemo.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Lists/Streams.v b/theories/Lists/Streams.v
index fa9b7873..cc4fb179 100644
--- a/theories/Lists/Streams.v
+++ b/theories/Lists/Streams.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Lists/vo.itarget b/theories/Lists/vo.itarget
index 04994f59..82dd1be8 100644
--- a/theories/Lists/vo.itarget
+++ b/theories/Lists/vo.itarget
@@ -1,6 +1,7 @@
ListSet.vo
ListTactics.vo
List.vo
+ListDec.vo
SetoidList.vo
SetoidPermutation.vo
StreamMemo.vo
diff --git a/theories/Logic/Berardi.v b/theories/Logic/Berardi.v
index 9f01c565..d72f4072 100644
--- a/theories/Logic/Berardi.v
+++ b/theories/Logic/Berardi.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -67,18 +67,13 @@ Variables A B : Prop.
Record retract : Prop :=
{i : A -> B; j : B -> A; inv : forall a:A, j (i a) = a}.
-
Record retract_cond : Prop :=
{i2 : A -> B; j2 : B -> A; inv2 : retract -> forall a:A, j2 (i2 a) = a}.
-
(** The dependent elimination above implies the axiom of choice: *)
-Lemma AC : forall r:retract_cond, retract -> forall a:A, j2 r (i2 r a) = a.
-Proof.
-intros r.
-case r; simpl.
-trivial.
-Qed.
+
+Lemma AC : forall r:retract_cond, retract -> forall a:A, r.(j2) (r.(i2) a) = a.
+Proof. intros r. exact r.(inv2). Qed.
End Retracts.
@@ -114,7 +109,7 @@ Proof.
exists g f.
intro a.
unfold f, g; simpl.
-apply AC.
+apply AC.
exists (fun x:pow U => x) (fun x:pow U => x).
trivial.
Qed.
@@ -132,9 +127,10 @@ Lemma not_has_fixpoint : R R = Not_b (R R).
Proof.
unfold R at 1.
unfold g.
-rewrite AC with (r := L1 U U) (a := fun u:U => Not_b (u U u)).
+rewrite AC.
+trivial.
+exists (fun x:pow U => x) (fun x:pow U => x).
trivial.
-exists (fun x:pow U => x) (fun x:pow U => x); trivial.
Qed.
diff --git a/theories/Logic/ChoiceFacts.v b/theories/Logic/ChoiceFacts.v
index d8fb5dd4..d2327498 100644
--- a/theories/Logic/ChoiceFacts.v
+++ b/theories/Logic/ChoiceFacts.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-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -52,7 +52,7 @@ We let also
- IPL^2 = 2nd-order functional minimal predicate logic (with ex. quant.)
- IPL_2^2 = 2nd-order impredicative, 2nd-order functional minimal pred. logic (with ex. quant.)
-with no prerequisite on the non-emptyness of domains
+with no prerequisite on the non-emptiness of domains
Table of contents
@@ -89,12 +89,19 @@ intentional type theory, Journal of Symbolic Logic 70(2):488-514, 2005.
*)
Set Implicit Arguments.
+Local Unset Intuition Negation Unfolding.
(**********************************************************************)
(** * Definitions *)
(** Choice, reification and description schemes *)
+(** We make them all polymorphic. Most of them have existentials as conclusion
+ so they require polymorphism otherwise their first application (e.g. to an
+ existential in [Set]) will fix the level of [A].
+*)
+(* Set Universe Polymorphism. *)
+
Section ChoiceSchemes.
Variables A B :Type.
@@ -216,39 +223,39 @@ End ChoiceSchemes.
(** Generalized schemes *)
Notation RelationalChoice :=
- (forall A B, RelationalChoice_on A B).
+ (forall A B : Type, RelationalChoice_on A B).
Notation FunctionalChoice :=
- (forall A B, FunctionalChoice_on A B).
+ (forall A B : Type, FunctionalChoice_on A B).
Definition FunctionalDependentChoice :=
- (forall A, FunctionalDependentChoice_on A).
+ (forall A : Type, FunctionalDependentChoice_on A).
Definition FunctionalCountableChoice :=
- (forall A, FunctionalCountableChoice_on A).
+ (forall A : Type, FunctionalCountableChoice_on A).
Notation FunctionalChoiceOnInhabitedSet :=
- (forall A B, inhabited B -> FunctionalChoice_on A B).
+ (forall A B : Type, inhabited B -> FunctionalChoice_on A B).
Notation FunctionalRelReification :=
- (forall A B, FunctionalRelReification_on A B).
+ (forall A B : Type, FunctionalRelReification_on A B).
Notation GuardedRelationalChoice :=
- (forall A B, GuardedRelationalChoice_on A B).
+ (forall A B : Type, GuardedRelationalChoice_on A B).
Notation GuardedFunctionalChoice :=
- (forall A B, GuardedFunctionalChoice_on A B).
+ (forall A B : Type, GuardedFunctionalChoice_on A B).
Notation GuardedFunctionalRelReification :=
- (forall A B, GuardedFunctionalRelReification_on A B).
+ (forall A B : Type, GuardedFunctionalRelReification_on A B).
Notation OmniscientRelationalChoice :=
- (forall A B, OmniscientRelationalChoice_on A B).
+ (forall A B : Type, OmniscientRelationalChoice_on A B).
Notation OmniscientFunctionalChoice :=
- (forall A B, OmniscientFunctionalChoice_on A B).
+ (forall A B : Type, OmniscientFunctionalChoice_on A B).
Notation ConstructiveDefiniteDescription :=
- (forall A, ConstructiveDefiniteDescription_on A).
+ (forall A : Type, ConstructiveDefiniteDescription_on A).
Notation ConstructiveIndefiniteDescription :=
- (forall A, ConstructiveIndefiniteDescription_on A).
+ (forall A : Type, ConstructiveIndefiniteDescription_on A).
Notation IotaStatement :=
- (forall A, IotaStatement_on A).
+ (forall A : Type, IotaStatement_on A).
Notation EpsilonStatement :=
- (forall A, EpsilonStatement_on A).
+ (forall A : Type, EpsilonStatement_on A).
(** Subclassical schemes *)
@@ -292,7 +299,7 @@ Proof.
Qed.
Lemma funct_choice_imp_rel_choice :
- forall A B, FunctionalChoice_on A B -> RelationalChoice_on A B.
+ forall A B : Type, FunctionalChoice_on A B -> RelationalChoice_on A B.
Proof.
intros A B FunCh R H.
destruct (FunCh R H) as (f,H0).
@@ -305,7 +312,7 @@ Proof.
Qed.
Lemma funct_choice_imp_description :
- forall A B, FunctionalChoice_on A B -> FunctionalRelReification_on A B.
+ forall A B : Type, FunctionalChoice_on A B -> FunctionalRelReification_on A B.
Proof.
intros A B FunCh R H.
destruct (FunCh R) as [f H0].
@@ -318,10 +325,10 @@ Proof.
Qed.
Corollary FunChoice_Equiv_RelChoice_and_ParamDefinDescr :
- forall A B, FunctionalChoice_on A B <->
+ forall A B : Type, FunctionalChoice_on A B <->
RelationalChoice_on A B /\ FunctionalRelReification_on A B.
Proof.
- intros A B; split.
+ intros A B. split.
intro H; split;
[ exact (funct_choice_imp_rel_choice H)
| exact (funct_choice_imp_description H) ].
@@ -333,7 +340,7 @@ Qed.
(** We show that the guarded formulations of the axiom of choice
are equivalent to their "omniscient" variant and comes from the non guarded
- formulation in presence either of the independance of general premises
+ formulation in presence either of the independence of general premises
or subset types (themselves derivable from subtypes thanks to proof-
irrelevance) *)
@@ -362,7 +369,7 @@ Proof.
Qed.
Lemma rel_choice_indep_of_general_premises_imp_guarded_rel_choice :
- forall A B, inhabited B -> RelationalChoice_on A B ->
+ forall A B : Type, inhabited B -> RelationalChoice_on A B ->
IndependenceOfGeneralPremises -> GuardedRelationalChoice_on A B.
Proof.
intros A B Inh AC_rel IndPrem P R H.
@@ -374,7 +381,7 @@ Proof.
Qed.
Lemma guarded_rel_choice_imp_rel_choice :
- forall A B, GuardedRelationalChoice_on A B -> RelationalChoice_on A B.
+ forall A B : Type, GuardedRelationalChoice_on A B -> RelationalChoice_on A B.
Proof.
intros A B GAC_rel R H.
destruct (GAC_rel (fun _ => True) R) as (R',(HR'R,H0)).
@@ -793,12 +800,13 @@ be applied on the same Type universes on both sides of the first
Require Import Setoid.
Theorem constructive_definite_descr_excluded_middle :
- ConstructiveDefiniteDescription ->
+ (forall A : Type, ConstructiveDefiniteDescription_on A) ->
(forall P:Prop, P \/ ~ P) -> (forall P:Prop, {P} + {~ P}).
Proof.
intros Descr EM P.
pose (select := fun b:bool => if b then P else ~P).
assert { b:bool | select b } as ([|],HP).
+ red in Descr.
apply Descr.
rewrite <- unique_existence; split.
destruct (EM P).
@@ -814,14 +822,13 @@ Corollary fun_reification_descr_computational_excluded_middle_in_prop_context :
(forall P:Prop, P \/ ~ P) ->
forall C:Prop, ((forall P:Prop, {P} + {~ P}) -> C) -> C.
Proof.
- intros FunReify EM C H.
- apply relative_non_contradiction_of_definite_descr; trivial.
- auto using constructive_definite_descr_excluded_middle.
+ intros FunReify EM C H. intuition auto using
+ constructive_definite_descr_excluded_middle,
+ (relative_non_contradiction_of_definite_descr (C:=C)).
Qed.
(**********************************************************************)
(** * Choice => Dependent choice => Countable choice *)
-
(* The implications below are standard *)
Require Import Arith.
diff --git a/theories/Logic/Classical.v b/theories/Logic/Classical.v
index 6085594b..600db472 100644
--- a/theories/Logic/Classical.v
+++ b/theories/Logic/Classical.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Logic/ClassicalChoice.v b/theories/Logic/ClassicalChoice.v
index ba7e87d1..07153b35 100644
--- a/theories/Logic/ClassicalChoice.v
+++ b/theories/Logic/ClassicalChoice.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Logic/ClassicalDescription.v b/theories/Logic/ClassicalDescription.v
index 7d79913a..bdad50e2 100644
--- a/theories/Logic/ClassicalDescription.v
+++ b/theories/Logic/ClassicalDescription.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Logic/ClassicalEpsilon.v b/theories/Logic/ClassicalEpsilon.v
index 161db112..2d9a1ffd 100644
--- a/theories/Logic/ClassicalEpsilon.v
+++ b/theories/Logic/ClassicalEpsilon.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-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Logic/ClassicalFacts.v b/theories/Logic/ClassicalFacts.v
index c6e140f5..6f736e45 100644
--- a/theories/Logic/ClassicalFacts.v
+++ b/theories/Logic/ClassicalFacts.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-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -339,8 +339,8 @@ Section Proof_irrelevance_EM_CC.
(** [p2b] and [b2p] form a retract if [~b1=b2] *)
- Definition p2b A := or_elim A (~ A) B (fun _ => b1) (fun _ => b2) (em A).
- Definition b2p b := b1 = b.
+ Let p2b A := or_elim A (~ A) B (fun _ => b1) (fun _ => b2) (em A).
+ Let b2p b := b1 = b.
Lemma p2p1 : forall A:Prop, A -> b2p (p2b A).
Proof.
@@ -367,16 +367,90 @@ Section Proof_irrelevance_EM_CC.
Proof.
refine (or_elim _ _ _ _ _ (em (b1 = b2))); intro H.
trivial.
- apply (paradox B p2b b2p (p2p2 H) p2p1).
+ apply (NoRetractFromSmallPropositionToProp.paradox B p2b b2p (p2p2 H) p2p1).
Qed.
End Proof_irrelevance_EM_CC.
-(** Remark: Hurkens' paradox still holds with a retract from the
- _negative_ fragment of [Prop] into [bool], hence weak classical
- logic, i.e. [forall A, ~A\/~~A], is enough for deriving
- proof-irrelevance.
-*)
+(** Hurkens' paradox still holds with a retract from the _negative_
+ fragment of [Prop] into [bool], hence weak classical logic,
+ i.e. [forall A, ~A\/~~A], is enough for deriving a weak version of
+ proof-irrelevance. This is enough to derive a contradiction from a
+ [Set]-bound weak excluded middle wih an impredicative [Set]
+ universe. *)
+
+Section Proof_irrelevance_WEM_CC.
+
+ Variable or : Prop -> Prop -> Prop.
+ Variable or_introl : forall A B:Prop, A -> or A B.
+ Variable or_intror : forall A B:Prop, B -> or A B.
+ Hypothesis or_elim : forall A B C:Prop, (A -> C) -> (B -> C) -> or A B -> C.
+ Hypothesis
+ or_elim_redl :
+ forall (A B C:Prop) (f:A -> C) (g:B -> C) (a:A),
+ f a = or_elim A B C f g (or_introl A B a).
+ Hypothesis
+ or_elim_redr :
+ forall (A B C:Prop) (f:A -> C) (g:B -> C) (b:B),
+ g b = or_elim A B C f g (or_intror A B b).
+ Hypothesis
+ or_dep_elim :
+ forall (A B:Prop) (P:or A B -> Prop),
+ (forall a:A, P (or_introl A B a)) ->
+ (forall b:B, P (or_intror A B b)) -> forall b:or A B, P b.
+
+ Hypothesis wem : forall A:Prop, or (~~A) (~ A).
+
+ Local Notation NProp := NoRetractToNegativeProp.NProp.
+ Local Notation El := NoRetractToNegativeProp.El.
+
+ Variable B : Prop.
+ Variables b1 b2 : B.
+
+ (** [p2b] and [b2p] form a retract if [~b1=b2] *)
+
+ Let p2b (A:NProp) := or_elim (~~El A) (~El A) B (fun _ => b1) (fun _ => b2) (wem (El A)).
+ Let b2p b : NProp := exist (fun P=>~~P -> P) (~~(b1 = b)) (fun h x => h (fun k => k x)).
+
+ Lemma wp2p1 : forall A:NProp, El A -> El (b2p (p2b A)).
+ Proof.
+ intros A. unfold p2b.
+ apply or_dep_elim with (b := wem (El A)).
+ + intros nna a.
+ rewrite <- or_elim_redl.
+ cbn. auto.
+ + intros n x.
+ destruct (n x).
+ Qed.
+
+ Lemma wp2p2 : b1 <> b2 -> forall A:NProp, El (b2p (p2b A)) -> El A.
+ Proof.
+ intro not_eq_b1_b2.
+ intros A. unfold p2b.
+ apply or_dep_elim with (b := wem (El A)).
+ + cbn.
+ intros x _.
+ destruct A. cbn in x |- *.
+ auto.
+ + intros na.
+ rewrite <- or_elim_redr. cbn.
+ intros h. destruct (h not_eq_b1_b2).
+ Qed.
+
+ (** By Hurkens's paradox, we get a weak form of proof irrelevance. *)
+
+ Theorem wproof_irrelevance_cc : ~~(b1 = b2).
+ Proof.
+ intros h.
+ refine (let NB := exist (fun P=>~~P -> P) B _ in _).
+ { exact (fun _ => b1). }
+ pose proof (NoRetractToNegativeProp.paradox NB p2b b2p (wp2p2 h) wp2p1) as paradox.
+ refine (let F := exist (fun P=>~~P->P) False _ in _).
+ { auto. }
+ exact (paradox F).
+ Qed.
+
+End Proof_irrelevance_WEM_CC.
(************************************************************************)
(** ** CIC |- excluded-middle -> proof-irrelevance *)
@@ -405,6 +479,23 @@ Section Proof_irrelevance_CCI.
End Proof_irrelevance_CCI.
+(** The same holds with weak excluded middle. The proof is a little
+ more involved, however. *)
+
+
+
+Section Weak_proof_irrelevance_CCI.
+
+ Hypothesis wem : forall A:Prop, ~~A \/ ~ A.
+
+ Theorem wem_proof_irrelevance_cci : forall (B:Prop) (b1 b2:B), ~~b1 = b2.
+ Proof.
+ exact (wproof_irrelevance_cc or or_introl or_intror or_ind or_elim_redl
+ or_elim_redr or_indd wem).
+ Qed.
+
+End Weak_proof_irrelevance_CCI.
+
(** Remark: in the Set-impredicative CCI, Hurkens' paradox still holds with
[bool] in [Set] and since [~true=false] for [true] and [false]
in [bool] from [Set], we get the inconsistency of
diff --git a/theories/Logic/ClassicalUniqueChoice.v b/theories/Logic/ClassicalUniqueChoice.v
index 1cdff497..4b0ec15e 100644
--- a/theories/Logic/ClassicalUniqueChoice.v
+++ b/theories/Logic/ClassicalUniqueChoice.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-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -42,8 +42,8 @@ intros A B.
apply (dependent_unique_choice A (fun _ => B)).
Qed.
-(** The following proof comes from [[ChicliPottierSimpson02]] *)
+(** The following proof comes from [[ChicliPottierSimpson02]] *)
Require Import Setoid.
Theorem classic_set_in_prop_context :
@@ -78,7 +78,7 @@ destruct (f P).
right.
destruct HfP as [[_ Hfalse]| [Hna _]].
discriminate.
- assumption.
+ assumption.
Qed.
Corollary not_not_classic_set :
diff --git a/theories/Logic/Classical_Pred_Set.v b/theories/Logic/Classical_Pred_Set.v
deleted file mode 100644
index d634217f..00000000
--- a/theories/Logic/Classical_Pred_Set.v
+++ /dev/null
@@ -1,48 +0,0 @@
-(************************************************************************)
-(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
-(* \VV/ **************************************************************)
-(* // * This file is distributed under the terms of the *)
-(* * GNU Lesser General Public License Version 2.1 *)
-(************************************************************************)
-
-(* File created for Coq V5.10.14b, Oct 1995, by duplication of
- Classical_Pred_Type.v *)
-
-(** This file is obsolete, use Classical_Pred_Type.v via Classical.v
-instead *)
-
-(** Classical Predicate Logic on Set*)
-
-Require Import Classical_Pred_Type.
-
-Section Generic.
-Variable U : Set.
-
-(** de Morgan laws for quantifiers *)
-
-Lemma not_all_ex_not :
- forall P:U -> Prop, ~ (forall n:U, P n) -> exists n : U, ~ P n.
-Proof (Classical_Pred_Type.not_all_ex_not U).
-
-Lemma not_all_not_ex :
- forall P:U -> Prop, ~ (forall n:U, ~ P n) -> exists n : U, P n.
-Proof (Classical_Pred_Type.not_all_not_ex U).
-
-Lemma not_ex_all_not :
- forall P:U -> Prop, ~ (exists n : U, P n) -> forall n:U, ~ P n.
-Proof (Classical_Pred_Type.not_ex_all_not U).
-
-Lemma not_ex_not_all :
- forall P:U -> Prop, ~ (exists n : U, ~ P n) -> forall n:U, P n.
-Proof (Classical_Pred_Type.not_ex_not_all U).
-
-Lemma ex_not_not_all :
- forall P:U -> Prop, (exists n : U, ~ P n) -> ~ (forall n:U, P n).
-Proof (Classical_Pred_Type.ex_not_not_all U).
-
-Lemma all_not_not_ex :
- forall P:U -> Prop, (forall n:U, ~ P n) -> ~ (exists n : U, P n).
-Proof (Classical_Pred_Type.all_not_not_ex U).
-
-End Generic.
diff --git a/theories/Logic/Classical_Pred_Type.v b/theories/Logic/Classical_Pred_Type.v
index 78eae431..8468ced3 100644
--- a/theories/Logic/Classical_Pred_Type.v
+++ b/theories/Logic/Classical_Pred_Type.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Logic/Classical_Prop.v b/theories/Logic/Classical_Prop.v
index 7fbd6da8..be75c4e9 100644
--- a/theories/Logic/Classical_Prop.v
+++ b/theories/Logic/Classical_Prop.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Logic/Classical_Type.v b/theories/Logic/Classical_Type.v
deleted file mode 100644
index 90d55160..00000000
--- a/theories/Logic/Classical_Type.v
+++ /dev/null
@@ -1,14 +0,0 @@
-(************************************************************************)
-(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
-(* \VV/ **************************************************************)
-(* // * This file is distributed under the terms of the *)
-(* * GNU Lesser General Public License Version 2.1 *)
-(************************************************************************)
-
-(** This file is obsolete, use Classical.v instead *)
-
-(** Classical Logic for Type *)
-
-Require Export Classical_Prop.
-Require Export Classical_Pred_Type.
diff --git a/theories/Logic/ConstructiveEpsilon.v b/theories/Logic/ConstructiveEpsilon.v
index 7403208a..6f5bfae4 100644
--- a/theories/Logic/ConstructiveEpsilon.v
+++ b/theories/Logic/ConstructiveEpsilon.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -51,9 +51,9 @@ Hypothesis P_dec : forall n, {P n}+{~(P n)}.
any number before any witness (not necessarily the [x] of [exists x :A, P x])
makes the search eventually stops. *)
-Inductive before_witness : nat -> Prop :=
- | stop : forall n, P n -> before_witness n
- | next : forall n, before_witness (S n) -> before_witness n.
+Inductive before_witness (n:nat) : Prop :=
+ | stop : P n -> before_witness n
+ | next : before_witness (S n) -> before_witness n.
(* Computation of the initial termination certificate *)
Fixpoint O_witness (n : nat) : before_witness n -> before_witness 0 :=
@@ -67,9 +67,9 @@ is structurally smaller even in the [stop] case. *)
Definition inv_before_witness :
forall n, before_witness n -> ~(P n) -> before_witness (S n) :=
fun n b =>
- match b in before_witness n return ~ P n -> before_witness (S n) with
- | stop n p => fun not_p => match (not_p p) with end
- | next n b => fun _ => b
+ match b return ~ P n -> before_witness (S n) with
+ | stop _ p => fun not_p => match (not_p p) with end
+ | next _ b => fun _ => b
end.
Fixpoint linear_search m (b : before_witness m) : {n : nat | P n} :=
diff --git a/theories/Logic/Decidable.v b/theories/Logic/Decidable.v
index 3724d8e2..545f92bd 100644
--- a/theories/Logic/Decidable.v
+++ b/theories/Logic/Decidable.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -175,7 +175,16 @@ Proof.
unfold decidable. tauto.
Qed.
+(* Functional relations on decidable co-domains are decidable *)
+Theorem dec_functional_relation :
+ forall (X Y : Type) (A:X->Y->Prop), (forall y y' : Y, decidable (y=y')) ->
+ (forall x, exists! y, A x y) -> forall x y, decidable (A x y).
+Proof.
+intros X Y A Hdec H x y.
+destruct (H x) as (y',(Hex,Huniq)).
+destruct (Hdec y y') as [->|Hnot]; firstorder.
+Qed.
(** With the following hint database, we can leverage [auto] to check
decidability of propositions. *)
diff --git a/theories/Logic/Description.v b/theories/Logic/Description.v
index 69ed908f..70cc0787 100644
--- a/theories/Logic/Description.v
+++ b/theories/Logic/Description.v
@@ -1,13 +1,13 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
(************************************************************************)
(** This file provides a constructive form of definite description; it
- allows to build functions from the proof of their existence in any
+ allows building functions from the proof of their existence in any
context; this is weaker than Church's iota operator *)
Require Import ChoiceFacts.
diff --git a/theories/Logic/Diaconescu.v b/theories/Logic/Diaconescu.v
index 71458647..64517354 100644
--- a/theories/Logic/Diaconescu.v
+++ b/theories/Logic/Diaconescu.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-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -99,7 +99,7 @@ Lemma AC_bool_subset_to_bool :
Proof.
destruct (guarded_rel_choice _ _
(fun Q:bool -> Prop => exists y : _, Q y)
- (fun (Q:bool -> Prop) (y:bool) => Q y)) as (R,(HRsub,HR)).
+ (fun (Q:bool -> Prop) (y:bool) => Q y)) as (R,(HRsub,HR)).
exact (fun _ H => H).
exists R; intros P HP.
destruct (HR P HP) as (y,(Hy,Huni)).
@@ -113,23 +113,23 @@ Theorem pred_ext_and_rel_choice_imp_EM : forall P:Prop, P \/ ~ P.
Proof.
intro P.
-(** first we exhibit the choice functional relation R *)
+(* first we exhibit the choice functional relation R *)
destruct AC_bool_subset_to_bool as [R H].
set (class_of_true := fun b => b = true \/ P).
set (class_of_false := fun b => b = false \/ P).
-(** the actual "decision": is (R class_of_true) = true or false? *)
+(* the actual "decision": is (R class_of_true) = true or false? *)
destruct (H class_of_true) as [b0 [H0 [H0' H0'']]].
exists true; left; reflexivity.
destruct H0.
-(** the actual "decision": is (R class_of_false) = true or false? *)
+(* the actual "decision": is (R class_of_false) = true or false? *)
destruct (H class_of_false) as [b1 [H1 [H1' H1'']]].
exists false; left; reflexivity.
destruct H1.
-(** case where P is false: (R class_of_true)=true /\ (R class_of_false)=false *)
+(* case where P is false: (R class_of_true)=true /\ (R class_of_false)=false *)
right.
intro HP.
assert (Hequiv : forall b:bool, class_of_true b <-> class_of_false b).
@@ -145,7 +145,7 @@ rewrite <- H0''. reflexivity.
rewrite Heq.
assumption.
-(** cases where P is true *)
+(* cases where P is true *)
left; assumption.
left; assumption.
@@ -154,7 +154,7 @@ Qed.
End PredExt_RelChoice_imp_EM.
(**********************************************************************)
-(** * B. Proof-Irrel. + Rel. Axiom of Choice -> Excl.-Middle for Equality *)
+(** * Proof-Irrel. + Rel. Axiom of Choice -> Excl.-Middle for Equality *)
(** This is an adaptation of Diaconescu's theorem, exploiting the
form of extensionality provided by proof-irrelevance *)
@@ -172,7 +172,7 @@ Variables a1 a2 : A.
(** We build the subset [A'] of [A] made of [a1] and [a2] *)
-Definition A' := sigT (fun x => x=a1 \/ x=a2).
+Definition A' := @sigT A (fun x => x=a1 \/ x=a2).
Definition a1':A'.
exists a1 ; auto.
diff --git a/theories/Logic/Epsilon.v b/theories/Logic/Epsilon.v
index e4663604..fe17cde4 100644
--- a/theories/Logic/Epsilon.v
+++ b/theories/Logic/Epsilon.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Logic/Eqdep.v b/theories/Logic/Eqdep.v
index e6c38c77..d9ffe68d 100644
--- a/theories/Logic/Eqdep.v
+++ b/theories/Logic/Eqdep.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-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Logic/EqdepFacts.v b/theories/Logic/EqdepFacts.v
index c0fc0d72..34aba486 100644
--- a/theories/Logic/EqdepFacts.v
+++ b/theories/Logic/EqdepFacts.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-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -52,6 +52,8 @@ Table of contents:
Import EqNotations.
+(* Set Universe Polymorphism. *)
+
Section Dependent_Equality.
Variable U : Type.
@@ -140,7 +142,7 @@ Qed.
Notation equiv_eqex_eqdep := eq_sigT_iff_eq_dep (only parsing). (* Compat *)
Lemma eq_sig_eq_dep :
- forall (U:Prop) (P:U -> Prop) (p q:U) (x:P p) (y:P q),
+ forall (U:Type) (P:U -> Prop) (p q:U) (x:P p) (y:P q),
exist P p x = exist P q y -> eq_dep p x q y.
Proof.
intros.
@@ -149,24 +151,25 @@ Proof.
Qed.
Lemma eq_dep_eq_sig :
- forall (U:Prop) (P:U -> Prop) (p q:U) (x:P p) (y:P q),
+ forall (U:Type) (P:U -> Prop) (p q:U) (x:P p) (y:P q),
eq_dep p x q y -> exist P p x = exist P q y.
Proof.
destruct 1; reflexivity.
Qed.
Lemma eq_sig_iff_eq_dep :
- forall (U:Prop) (P:U -> Prop) (p q:U) (x:P p) (y:P q),
+ forall (U:Type) (P:U -> Prop) (p q:U) (x:P p) (y:P q),
exist P p x = exist P q y <-> eq_dep p x q y.
Proof.
split; auto using eq_sig_eq_dep, eq_dep_eq_sig.
Qed.
-(** Dependent equality is equivalent to a dependent pair of equalities *)
+(** Dependent equality is equivalent tco a dependent pair of equalities *)
Set Implicit Arguments.
-Lemma eq_sigT_sig_eq : forall X P (x1 x2:X) H1 H2, existT P x1 H1 = existT P x2 H2 <-> {H:x1=x2 | rew H in H1 = H2}.
+Lemma eq_sigT_sig_eq : forall X P (x1 x2:X) H1 H2, existT P x1 H1 = existT P x2 H2 <->
+ {H:x1=x2 | rew H in H1 = H2}.
Proof.
intros; split; intro H.
- change x2 with (projT1 (existT P x2 H2)).
@@ -234,82 +237,113 @@ Section Equivalences.
(** Invariance by Substitution of Reflexive Equality Proofs *)
- Definition Eq_rect_eq :=
- forall (p:U) (Q:U -> Type) (x:Q p) (h:p = p), x = eq_rect p Q x p h.
+ Definition Eq_rect_eq_on (p : U) (Q : U -> Type) (x : Q p) :=
+ forall (h : p = p), x = eq_rect p Q x p h.
+ Definition Eq_rect_eq := forall p Q x, Eq_rect_eq_on p Q x.
(** Injectivity of Dependent Equality *)
- Definition Eq_dep_eq :=
- forall (P:U->Type) (p:U) (x y:P p), eq_dep p x p y -> x = y.
+ Definition Eq_dep_eq_on (P : U -> Type) (p : U) (x : P p) :=
+ forall (y : P p), eq_dep p x p y -> x = y.
+ Definition Eq_dep_eq := forall P p x, Eq_dep_eq_on P p x.
(** Uniqueness of Identity Proofs (UIP) *)
- Definition UIP_ :=
- forall (x y:U) (p1 p2:x = y), p1 = p2.
+ Definition UIP_on_ (x y : U) (p1 : x = y) :=
+ forall (p2 : x = y), p1 = p2.
+ Definition UIP_ := forall x y p1, UIP_on_ x y p1.
(** Uniqueness of Reflexive Identity Proofs *)
- Definition UIP_refl_ :=
- forall (x:U) (p:x = x), p = eq_refl x.
+ Definition UIP_refl_on_ (x : U) :=
+ forall (p : x = x), p = eq_refl x.
+ Definition UIP_refl_ := forall x, UIP_refl_on_ x.
(** Streicher's axiom K *)
- Definition Streicher_K_ :=
- forall (x:U) (P:x = x -> Prop), P (eq_refl x) -> forall p:x = x, P p.
+ Definition Streicher_K_on_ (x : U) (P : x = x -> Prop) :=
+ P (eq_refl x) -> forall p : x = x, P p.
+ Definition Streicher_K_ := forall x P, Streicher_K_on_ x P.
(** Injectivity of Dependent Equality is a consequence of *)
(** Invariance by Substitution of Reflexive Equality Proof *)
- Lemma eq_rect_eq__eq_dep1_eq :
- Eq_rect_eq -> forall (P:U->Type) (p:U) (x y:P p), eq_dep1 p x p y -> x = y.
+ Lemma eq_rect_eq_on__eq_dep1_eq_on (p : U) (P : U -> Type) (y : P p) :
+ Eq_rect_eq_on p P y -> forall (x : P p), eq_dep1 p x p y -> x = y.
Proof.
intro eq_rect_eq.
simple destruct 1; intro.
rewrite <- eq_rect_eq; auto.
Qed.
+ Lemma eq_rect_eq__eq_dep1_eq :
+ Eq_rect_eq -> forall (P:U->Type) (p:U) (x y:P p), eq_dep1 p x p y -> x = y.
+ Proof (fun eq_rect_eq P p y x =>
+ @eq_rect_eq_on__eq_dep1_eq_on p P x (eq_rect_eq p P x) y).
- Lemma eq_rect_eq__eq_dep_eq : Eq_rect_eq -> Eq_dep_eq.
+ Lemma eq_rect_eq_on__eq_dep_eq_on (p : U) (P : U -> Type) (x : P p) :
+ Eq_rect_eq_on p P x -> Eq_dep_eq_on P p x.
Proof.
intros eq_rect_eq; red; intros.
- apply (eq_rect_eq__eq_dep1_eq eq_rect_eq); apply eq_dep_dep1; trivial.
+ symmetry; apply (eq_rect_eq_on__eq_dep1_eq_on _ _ _ eq_rect_eq).
+ apply eq_dep_sym in H; apply eq_dep_dep1; trivial.
Qed.
+ Lemma eq_rect_eq__eq_dep_eq : Eq_rect_eq -> Eq_dep_eq.
+ Proof (fun eq_rect_eq P p x y =>
+ @eq_rect_eq_on__eq_dep_eq_on p P x (eq_rect_eq p P x) y).
(** Uniqueness of Identity Proofs (UIP) is a consequence of *)
(** Injectivity of Dependent Equality *)
- Lemma eq_dep_eq__UIP : Eq_dep_eq -> UIP_.
+ Lemma eq_dep_eq_on__UIP_on (x y : U) (p1 : x = y) :
+ Eq_dep_eq_on (fun y => x = y) x eq_refl -> UIP_on_ x y p1.
Proof.
intro eq_dep_eq; red.
- intros; apply eq_dep_eq with (P := fun y => x = y).
- elim p2 using eq_indd.
elim p1 using eq_indd.
+ intros; apply eq_dep_eq.
+ elim p2 using eq_indd.
apply eq_dep_intro.
Qed.
+ Lemma eq_dep_eq__UIP : Eq_dep_eq -> UIP_.
+ Proof (fun eq_dep_eq x y p1 =>
+ @eq_dep_eq_on__UIP_on x y p1 (eq_dep_eq _ _ _)).
(** Uniqueness of Reflexive Identity Proofs is a direct instance of UIP *)
- Lemma UIP__UIP_refl : UIP_ -> UIP_refl_.
+ Lemma UIP_on__UIP_refl_on (x : U) :
+ UIP_on_ x x eq_refl -> UIP_refl_on_ x.
Proof.
- intro UIP; red; intros; apply UIP.
+ intro UIP; red; intros; symmetry; apply UIP.
Qed.
+ Lemma UIP__UIP_refl : UIP_ -> UIP_refl_.
+ Proof (fun UIP x p =>
+ @UIP_on__UIP_refl_on x (UIP x x eq_refl) p).
(** Streicher's axiom K is a direct consequence of Uniqueness of
Reflexive Identity Proofs *)
- Lemma UIP_refl__Streicher_K : UIP_refl_ -> Streicher_K_.
+ Lemma UIP_refl_on__Streicher_K_on (x : U) (P : x = x -> Prop) :
+ UIP_refl_on_ x -> Streicher_K_on_ x P.
Proof.
intro UIP_refl; red; intros; rewrite UIP_refl; assumption.
Qed.
+ Lemma UIP_refl__Streicher_K : UIP_refl_ -> Streicher_K_.
+ Proof (fun UIP_refl x P =>
+ @UIP_refl_on__Streicher_K_on x P (UIP_refl x)).
(** We finally recover from K the Invariance by Substitution of
Reflexive Equality Proofs *)
- Lemma Streicher_K__eq_rect_eq : Streicher_K_ -> Eq_rect_eq.
+ Lemma Streicher_K_on__eq_rect_eq_on (p : U) (P : U -> Type) (x : P p) :
+ Streicher_K_on_ p (fun h => x = rew -> [P] h in x)
+ -> Eq_rect_eq_on p P x.
Proof.
intro Streicher_K; red; intros.
- apply Streicher_K with (p := h).
+ apply Streicher_K.
reflexivity.
Qed.
+ Lemma Streicher_K__eq_rect_eq : Streicher_K_ -> Eq_rect_eq.
+ Proof (fun Streicher_K p P x =>
+ @Streicher_K_on__eq_rect_eq_on p P x (Streicher_K p _)).
(** Remark: It is reasonable to think that [eq_rect_eq] is strictly
stronger than [eq_rec_eq] (which is [eq_rect_eq] restricted on [Set]):
@@ -317,7 +351,7 @@ Section Equivalences.
[Definition Eq_rec_eq :=
forall (P:U -> Set) (p:U) (x:P p) (h:p = p), x = eq_rec p P x p h.]
- Typically, [eq_rect_eq] allows to prove UIP and Streicher's K what
+ Typically, [eq_rect_eq] allows proving UIP and Streicher's K what
does not seem possible with [eq_rec_eq]. In particular, the proof of [UIP]
requires to use [eq_rect_eq] on [fun y -> x=y] which is in [Type] but not
in [Set].
@@ -325,22 +359,55 @@ Section Equivalences.
End Equivalences.
+(** UIP_refl is downward closed (a short proof of the key lemma of Voevodsky's
+ proof of inclusion of h-level n into h-level n+1; see hlevelntosn
+ in https://github.com/vladimirias/Foundations.git). *)
+
+Theorem UIP_shift_on (X : Type) (x : X) :
+ UIP_refl_on_ X x -> forall y : x = x, UIP_refl_on_ (x = x) y.
+Proof.
+ intros UIP_refl y.
+ rewrite (UIP_refl y).
+ intros z.
+ assert (UIP:forall y' y'' : x = x, y' = y'').
+ { intros. apply eq_trans with (eq_refl x). apply UIP_refl.
+ symmetry. apply UIP_refl. }
+ transitivity (eq_trans (eq_trans (UIP (eq_refl x) (eq_refl x)) z)
+ (eq_sym (UIP (eq_refl x) (eq_refl x)))).
+ - destruct z. destruct (UIP _ _). reflexivity.
+ - change
+ (match eq_refl x as y' in _ = x' return y' = y' -> Prop with
+ | eq_refl => fun z => z = (eq_refl (eq_refl x))
+ end (eq_trans (eq_trans (UIP (eq_refl x) (eq_refl x)) z)
+ (eq_sym (UIP (eq_refl x) (eq_refl x))))).
+ destruct z. destruct (UIP _ _). reflexivity.
+Qed.
+Theorem UIP_shift : forall U, UIP_refl_ U -> forall x:U, UIP_refl_ (x = x).
+Proof (fun U UIP_refl x =>
+ @UIP_shift_on U x (UIP_refl x)).
+
Section Corollaries.
Variable U:Type.
(** UIP implies the injectivity of equality on dependent pairs in Type *)
- Definition Inj_dep_pair :=
- forall (P:U -> Type) (p:U) (x y:P p), existT P p x = existT P p y -> x = y.
- Lemma eq_dep_eq__inj_pair2 : Eq_dep_eq U -> Inj_dep_pair.
+ Definition Inj_dep_pair_on (P : U -> Type) (p : U) (x : P p) :=
+ forall (y : P p), existT P p x = existT P p y -> x = y.
+ Definition Inj_dep_pair := forall P p x, Inj_dep_pair_on P p x.
+
+ Lemma eq_dep_eq_on__inj_pair2_on (P : U -> Type) (p : U) (x : P p) :
+ Eq_dep_eq_on U P p x -> Inj_dep_pair_on P p x.
Proof.
intro eq_dep_eq; red; intros.
apply eq_dep_eq.
apply eq_sigT_eq_dep.
assumption.
Qed.
+ Lemma eq_dep_eq__inj_pair2 : Eq_dep_eq U -> Inj_dep_pair.
+ Proof (fun eq_dep_eq P p x =>
+ @eq_dep_eq_on__inj_pair2_on P p x (eq_dep_eq P p x)).
End Corollaries.
@@ -412,5 +479,27 @@ Notation inj_pairT2 := inj_pair2.
End EqdepTheory.
+(** Basic facts about eq_dep *)
+
+Lemma f_eq_dep :
+ forall U (P:U->Type) R p q x y (f:forall p, P p -> R p),
+ eq_dep p x q y -> eq_dep p (f p x) q (f q y).
+Proof.
+intros * []. reflexivity.
+Qed.
+
+Lemma eq_dep_non_dep :
+ forall U P p q x y, @eq_dep U (fun _ => P) p x q y -> x = y.
+Proof.
+intros * []. reflexivity.
+Qed.
+
+Lemma f_eq_dep_non_dep :
+ forall U (P:U->Type) R p q x y (f:forall p, P p -> R),
+ eq_dep p x q y -> f p x = f q y.
+Proof.
+intros * []. reflexivity.
+Qed.
+
Arguments eq_dep U P p x q _ : clear implicits.
Arguments eq_dep1 U P p x q y : clear implicits.
diff --git a/theories/Logic/Eqdep_dec.v b/theories/Logic/Eqdep_dec.v
index 015c7a5f..65011e8e 100644
--- a/theories/Logic/Eqdep_dec.v
+++ b/theories/Logic/Eqdep_dec.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -35,6 +35,7 @@ Table of contents:
(** * Streicher's K and injectivity of dependent pair hold on decidable types *)
Set Implicit Arguments.
+(* Set Universe Polymorphism. *)
Section EqdepDec.
@@ -49,12 +50,12 @@ Section EqdepDec.
case u; trivial.
Qed.
- Variable eq_dec : forall x y:A, x = y \/ x <> y.
-
Variable x : A.
+ Variable eq_dec : forall y:A, x = y \/ x <> y.
+
Let nu (y:A) (u:x = y) : x = y :=
- match eq_dec x y with
+ match eq_dec y with
| or_introl eqxy => eqxy
| or_intror neqxy => False_ind _ (neqxy u)
end.
@@ -62,17 +63,17 @@ Section EqdepDec.
Let nu_constant : forall (y:A) (u v:x = y), nu u = nu v.
intros.
unfold nu.
- case (eq_dec x y); intros.
+ destruct (eq_dec y) as [Heq|Hneq].
reflexivity.
- case n; trivial.
+ case Hneq; trivial.
Qed.
Let nu_inv (y:A) (v:x = y) : x = y := comp (nu (eq_refl x)) v.
- Remark nu_left_inv : forall (y:A) (u:x = y), nu_inv (nu u) = u.
+ Remark nu_left_inv_on : forall (y:A) (u:x = y), nu_inv (nu u) = u.
Proof.
intros.
case u; unfold nu_inv.
@@ -80,20 +81,20 @@ Section EqdepDec.
Qed.
- Theorem eq_proofs_unicity : forall (y:A) (p1 p2:x = y), p1 = p2.
+ Theorem eq_proofs_unicity_on : forall (y:A) (p1 p2:x = y), p1 = p2.
Proof.
intros.
- elim nu_left_inv with (u := p1).
- elim nu_left_inv with (u := p2).
+ elim nu_left_inv_on with (u := p1).
+ elim nu_left_inv_on with (u := p2).
elim nu_constant with y p1 p2.
reflexivity.
Qed.
- Theorem K_dec :
+ Theorem K_dec_on :
forall P:x = x -> Prop, P (eq_refl x) -> forall p:x = x, P p.
Proof.
intros.
- elim eq_proofs_unicity with x (eq_refl x) p.
+ elim eq_proofs_unicity_on with x (eq_refl x) p.
trivial.
Qed.
@@ -101,27 +102,26 @@ Section EqdepDec.
Let proj (P:A -> Prop) (exP:ex P) (def:P x) : P x :=
match exP with
- | ex_intro x' prf =>
- match eq_dec x' x with
- | or_introl eqprf => eq_ind x' P prf x eqprf
+ | ex_intro _ x' prf =>
+ match eq_dec x' with
+ | or_introl eqprf => eq_ind x' P prf x (eq_sym eqprf)
| _ => def
end
end.
- Theorem inj_right_pair :
+ Theorem inj_right_pair_on :
forall (P:A -> Prop) (y y':P x),
ex_intro P x y = ex_intro P x y' -> y = y'.
Proof.
intros.
cut (proj (ex_intro P x y) y = proj (ex_intro P x y') y).
simpl.
- case (eq_dec x x).
- intro e.
- elim e using K_dec; trivial.
+ destruct (eq_dec x) as [Heq|Hneq].
+ elim Heq using K_dec_on; trivial.
intros.
- case n; trivial.
+ case Hneq; trivial.
case H.
reflexivity.
@@ -129,6 +129,28 @@ Section EqdepDec.
End EqdepDec.
+(** Now we prove the versions that require decidable equality for the entire type
+ rather than just on the given element. The rest of the file uses this total
+ decidable equality. We could do everything using decidable equality at a point
+ (because the induction rule for [eq] is really an induction rule for
+ [{ y : A | x = y }]), but we don't currently, because changing everything
+ would break backward compatibility and no-one has yet taken the time to define
+ the pointed versions, and then re-define the non-pointed versions in terms of
+ those. *)
+
+Theorem eq_proofs_unicity A (eq_dec : forall x y : A, x = y \/ x <> y) (x : A)
+: forall (y:A) (p1 p2:x = y), p1 = p2.
+Proof (@eq_proofs_unicity_on A x (eq_dec x)).
+
+Theorem K_dec A (eq_dec : forall x y : A, x = y \/ x <> y) (x : A)
+: forall P:x = x -> Prop, P (eq_refl x) -> forall p:x = x, P p.
+Proof (@K_dec_on A x (eq_dec x)).
+
+Theorem inj_right_pair A (eq_dec : forall x y : A, x = y \/ x <> y) (x : A)
+: forall (P:A -> Prop) (y y':P x),
+ ex_intro P x y = ex_intro P x y' -> y = y'.
+Proof (@inj_right_pair_on A x (eq_dec x)).
+
Require Import EqdepFacts.
(** We deduce axiom [K] for (decidable) types *)
@@ -181,7 +203,7 @@ Unset Implicit Arguments.
Module Type DecidableType.
- Parameter U:Type.
+ Monomorphic Parameter U:Type.
Axiom eq_dec : forall x y:U, {x = y} + {x <> y}.
End DecidableType.
@@ -249,7 +271,7 @@ End DecidableEqDep.
Module Type DecidableSet.
- Parameter U:Type.
+ Parameter U:Set.
Axiom eq_dec : forall x y:U, {x = y} + {x <> y}.
End DecidableSet.
@@ -272,23 +294,23 @@ Module DecidableEqDepSet (M:DecidableSet).
Theorem eq_dep_eq :
forall (P:U->Type) (p:U) (x y:P p), eq_dep U P p x p y -> x = y.
- Proof N.eq_dep_eq.
+ Proof (eq_rect_eq__eq_dep_eq U eq_rect_eq).
(** Uniqueness of Identity Proofs (UIP) *)
Lemma UIP : forall (x y:U) (p1 p2:x = y), p1 = p2.
- Proof N.UIP.
+ Proof (eq_dep_eq__UIP U eq_dep_eq).
(** Uniqueness of Reflexive Identity Proofs *)
Lemma UIP_refl : forall (x:U) (p:x = x), p = eq_refl x.
- Proof N.UIP_refl.
+ Proof (UIP__UIP_refl U UIP).
(** Streicher's axiom K *)
Lemma Streicher_K :
forall (x:U) (P:x = x -> Prop), P (eq_refl x) -> forall p:x = x, P p.
- Proof N.Streicher_K.
+ Proof (K_dec_type eq_dec).
(** Proof-irrelevance on subsets of decidable sets *)
@@ -318,7 +340,53 @@ Proof.
intros A eq_dec.
apply eq_dep_eq__inj_pair2.
apply eq_rect_eq__eq_dep_eq.
- unfold Eq_rect_eq.
- apply eq_rect_eq_dec.
+ unfold Eq_rect_eq, Eq_rect_eq_on.
+ intros; apply eq_rect_eq_dec.
apply eq_dec.
Qed.
+
+ (** Examples of short direct proofs of unicity of reflexivity proofs
+ on specific domains *)
+
+Lemma UIP_refl_unit (x : tt = tt) : x = eq_refl tt.
+Proof.
+ change (match tt as b return tt = b -> Prop with
+ | tt => fun x => x = eq_refl tt
+ end x).
+ destruct x; reflexivity.
+Defined.
+
+Lemma UIP_refl_bool (b:bool) (x : b = b) : x = eq_refl.
+Proof.
+ destruct b.
+ - change (match true as b return true=b -> Prop with
+ | true => fun x => x = eq_refl
+ | _ => fun _ => True
+ end x).
+ destruct x; reflexivity.
+ - change (match false as b return false=b -> Prop with
+ | false => fun x => x = eq_refl
+ | _ => fun _ => True
+ end x).
+ destruct x; reflexivity.
+Defined.
+
+Lemma UIP_refl_nat (n:nat) (x : n = n) : x = eq_refl.
+Proof.
+ induction n.
+ - change (match 0 as n return 0=n -> Prop with
+ | 0 => fun x => x = eq_refl
+ | _ => fun _ => True
+ end x).
+ destruct x; reflexivity.
+ - specialize IHn with (f_equal pred x).
+ change eq_refl with (f_equal S (@eq_refl _ n)).
+ rewrite <- IHn; clear IHn.
+ change (match S n as n' return S n = n' -> Prop with
+ | 0 => fun _ => True
+ | S n' => fun x =>
+ x = f_equal S (f_equal pred x)
+ end x).
+ pattern (S n) at 2 3, x.
+ destruct x; reflexivity.
+Defined.
diff --git a/theories/Logic/ExtensionalityFacts.v b/theories/Logic/ExtensionalityFacts.v
index 27fb147f..61ee9eb9 100644
--- a/theories/Logic/ExtensionalityFacts.v
+++ b/theories/Logic/ExtensionalityFacts.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Logic/FinFun.v b/theories/Logic/FinFun.v
new file mode 100644
index 00000000..670aa219
--- /dev/null
+++ b/theories/Logic/FinFun.v
@@ -0,0 +1,400 @@
+(************************************************************************)
+(* v * The Coq Proof Assistant / The Coq Development Team *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* \VV/ **************************************************************)
+(* // * This file is distributed under the terms of the *)
+(* * GNU Lesser General Public License Version 2.1 *)
+(************************************************************************)
+
+(** * Functions on finite domains *)
+
+(** Main result : for functions [f:A->A] with finite [A],
+ f injective <-> f bijective <-> f surjective. *)
+
+Require Import List Compare_dec EqNat Decidable ListDec. Require Fin.
+Set Implicit Arguments.
+
+(** General definitions *)
+
+Definition Injective {A B} (f : A->B) :=
+ forall x y, f x = f y -> x = y.
+
+Definition Surjective {A B} (f : A->B) :=
+ forall y, exists x, f x = y.
+
+Definition Bijective {A B} (f : A->B) :=
+ exists g:B->A, (forall x, g (f x) = x) /\ (forall y, f (g y) = y).
+
+(** Finiteness is defined here via exhaustive list enumeration *)
+
+Definition Full {A:Type} (l:list A) := forall a:A, In a l.
+Definition Finite (A:Type) := exists (l:list A), Full l.
+
+(** In many following proofs, it will be convenient to have
+ list enumerations without duplicates. As soon as we have
+ decidability of equality (in Prop), this is equivalent
+ to the previous notion. *)
+
+Definition Listing {A:Type} (l:list A) := NoDup l /\ Full l.
+Definition Finite' (A:Type) := exists (l:list A), Listing l.
+
+Lemma Finite_alt A (d:decidable_eq A) : Finite A <-> Finite' A.
+Proof.
+ split.
+ - intros (l,F). destruct (uniquify d l) as (l' & N & I).
+ exists l'. split; trivial.
+ intros x. apply I, F.
+ - intros (l & _ & F). now exists l.
+Qed.
+
+(** Injections characterized in term of lists *)
+
+Lemma Injective_map_NoDup A B (f:A->B) (l:list A) :
+ Injective f -> NoDup l -> NoDup (map f l).
+Proof.
+ intros Ij. induction 1 as [|x l X N IH]; simpl; constructor; trivial.
+ rewrite in_map_iff. intros (y & E & Y). apply Ij in E. now subst.
+Qed.
+
+Lemma Injective_list_carac A B (d:decidable_eq A)(f:A->B) :
+ Injective f <-> (forall l, NoDup l -> NoDup (map f l)).
+Proof.
+ split.
+ - intros. now apply Injective_map_NoDup.
+ - intros H x y E.
+ destruct (d x y); trivial.
+ assert (N : NoDup (x::y::nil)).
+ { repeat constructor; simpl; intuition. }
+ specialize (H _ N). simpl in H. rewrite E in H.
+ inversion_clear H; simpl in *; intuition.
+Qed.
+
+Lemma Injective_carac A B (l:list A) : Listing l ->
+ forall (f:A->B), Injective f <-> NoDup (map f l).
+Proof.
+ intros L f. split.
+ - intros Ij. apply Injective_map_NoDup; trivial. apply L.
+ - intros N x y E.
+ assert (X : In x l) by apply L.
+ assert (Y : In y l) by apply L.
+ apply In_nth_error in X. destruct X as (i,X).
+ apply In_nth_error in Y. destruct Y as (j,Y).
+ assert (X' := map_nth_error f _ _ X).
+ assert (Y' := map_nth_error f _ _ Y).
+ assert (i = j).
+ { rewrite NoDup_nth_error in N. apply N.
+ - rewrite <- nth_error_Some. now rewrite X'.
+ - rewrite X', Y'. now f_equal. }
+ subst j. rewrite Y in X. now injection X.
+Qed.
+
+(** Surjection characterized in term of lists *)
+
+Lemma Surjective_list_carac A B (f:A->B):
+ Surjective f <-> (forall lB, exists lA, incl lB (map f lA)).
+Proof.
+ split.
+ - intros Su.
+ induction lB as [|b lB IH].
+ + now exists nil.
+ + destruct (Su b) as (a,E).
+ destruct IH as (lA,IC).
+ exists (a::lA). simpl. rewrite E.
+ intros x [X|X]; simpl; intuition.
+ - intros H y.
+ destruct (H (y::nil)) as (lA,IC).
+ assert (IN : In y (map f lA)) by (apply (IC y); now left).
+ rewrite in_map_iff in IN. destruct IN as (x & E & _).
+ now exists x.
+Qed.
+
+Lemma Surjective_carac A B : Finite B -> decidable_eq B ->
+ forall f:A->B, Surjective f <-> (exists lA, Listing (map f lA)).
+Proof.
+ intros (lB,FB) d. split.
+ - rewrite Surjective_list_carac.
+ intros Su. destruct (Su lB) as (lA,IC).
+ destruct (uniquify_map d f lA) as (lA' & N & IC').
+ exists lA'. split; trivial.
+ intro x. apply IC', IC, FB.
+ - intros (lA & N & FA) y.
+ generalize (FA y). rewrite in_map_iff. intros (x & E & _).
+ now exists x.
+Qed.
+
+(** Main result : *)
+
+Lemma Endo_Injective_Surjective :
+ forall A, Finite A -> decidable_eq A ->
+ forall f:A->A, Injective f <-> Surjective f.
+Proof.
+ intros A F d f. rewrite (Surjective_carac F d). split.
+ - apply (Finite_alt d) in F. destruct F as (l,L).
+ rewrite (Injective_carac L); intros.
+ exists l; split; trivial.
+ destruct L as (N,F).
+ assert (I : incl l (map f l)).
+ { apply NoDup_length_incl; trivial.
+ - now rewrite map_length.
+ - intros x _. apply F. }
+ intros x. apply I, F.
+ - clear F d. intros (l,L).
+ assert (N : NoDup l). { apply (NoDup_map_inv f), L. }
+ assert (I : incl (map f l) l).
+ { apply NoDup_length_incl; trivial.
+ - now rewrite map_length.
+ - intros x _. apply L. }
+ assert (L' : Listing l).
+ { split; trivial.
+ intro x. apply I, L. }
+ apply (Injective_carac L'), L.
+Qed.
+
+(** An injective and surjective function is bijective.
+ We need here stronger hypothesis : decidability of equality in Type. *)
+
+Definition EqDec (A:Type) := forall x y:A, {x=y}+{x<>y}.
+
+(** First, we show that a surjective f has an inverse function g such that
+ f.g = id. *)
+
+(* NB: instead of (Finite A), we could ask for (RecEnum A) with:
+Definition RecEnum A := exists h:nat->A, surjective h.
+*)
+
+Lemma Finite_Empty_or_not A :
+ Finite A -> (A->False) \/ exists a:A,True.
+Proof.
+ intros (l,F).
+ destruct l.
+ - left; exact F.
+ - right; now exists a.
+Qed.
+
+Lemma Surjective_inverse :
+ forall A B, Finite A -> EqDec B ->
+ forall f:A->B, Surjective f ->
+ exists g:B->A, forall x, f (g x) = x.
+Proof.
+ intros A B F d f Su.
+ destruct (Finite_Empty_or_not F) as [noA | (a,_)].
+ - (* A is empty : g is obtained via False_rect *)
+ assert (noB : B -> False). { intros y. now destruct (Su y). }
+ exists (fun y => False_rect _ (noB y)).
+ intro y. destruct (noB y).
+ - (* A is inhabited by a : we use it in Option.get *)
+ destruct F as (l,F).
+ set (h := fun x k => if d (f k) x then true else false).
+ set (get := fun o => match o with Some y => y | None => a end).
+ exists (fun x => get (List.find (h x) l)).
+ intros x.
+ case_eq (find (h x) l); simpl; clear get; [intros y H|intros H].
+ * apply find_some in H. destruct H as (_,H). unfold h in H.
+ now destruct (d (f y) x) in H.
+ * exfalso.
+ destruct (Su x) as (y & Y).
+ generalize (find_none _ l H y (F y)).
+ unfold h. now destruct (d (f y) x).
+Qed.
+
+(** Same, with more knowledge on the inverse function: g.f = f.g = id *)
+
+Lemma Injective_Surjective_Bijective :
+ forall A B, Finite A -> EqDec B ->
+ forall f:A->B, Injective f -> Surjective f -> Bijective f.
+Proof.
+ intros A B F d f Ij Su.
+ destruct (Surjective_inverse F d Su) as (g, E).
+ exists g. split; trivial.
+ intros y. apply Ij. now rewrite E.
+Qed.
+
+
+(** An example of finite type : [Fin.t] *)
+
+Lemma Fin_Finite n : Finite (Fin.t n).
+Proof.
+ induction n.
+ - exists nil.
+ red;inversion a.
+ - destruct IHn as (l,Hl).
+ exists (Fin.F1 :: map Fin.FS l).
+ intros a. revert n a l Hl.
+ refine (@Fin.caseS _ _ _); intros.
+ + now left.
+ + right. now apply in_map.
+Qed.
+
+(** Instead of working on a finite subset of nat, another
+ solution is to use restricted [nat->nat] functions, and
+ to consider them only below a certain bound [n]. *)
+
+Definition bFun n (f:nat->nat) := forall x, x < n -> f x < n.
+
+Definition bInjective n (f:nat->nat) :=
+ forall x y, x < n -> y < n -> f x = f y -> x = y.
+
+Definition bSurjective n (f:nat->nat) :=
+ forall y, y < n -> exists x, x < n /\ f x = y.
+
+(** We show that this is equivalent to the use of [Fin.t n]. *)
+
+Module Fin2Restrict.
+
+Notation n2f := Fin.of_nat_lt.
+Definition f2n {n} (x:Fin.t n) := proj1_sig (Fin.to_nat x).
+Definition f2n_ok n (x:Fin.t n) : f2n x < n := proj2_sig (Fin.to_nat x).
+Definition n2f_f2n : forall n x, n2f (f2n_ok x) = x := @Fin.of_nat_to_nat_inv.
+Definition f2n_n2f x n h : f2n (n2f h) = x := f_equal (@proj1_sig _ _) (@Fin.to_nat_of_nat x n h).
+Definition n2f_ext : forall x n h h', n2f h = n2f h' := @Fin.of_nat_ext.
+Definition f2n_inj : forall n x y, f2n x = f2n y -> x = y := @Fin.to_nat_inj.
+
+Definition extend n (f:Fin.t n -> Fin.t n) : (nat->nat) :=
+ fun x =>
+ match le_lt_dec n x with
+ | left _ => 0
+ | right h => f2n (f (n2f h))
+ end.
+
+Definition restrict n (f:nat->nat)(hf : bFun n f) : (Fin.t n -> Fin.t n) :=
+ fun x => let (x',h) := Fin.to_nat x in n2f (hf _ h).
+
+Ltac break_dec H :=
+ let H' := fresh "H" in
+ destruct le_lt_dec as [H'|H'];
+ [elim (Lt.le_not_lt _ _ H' H)
+ |try rewrite (n2f_ext H' H) in *; try clear H'].
+
+Lemma extend_ok n f : bFun n (@extend n f).
+Proof.
+ intros x h. unfold extend. break_dec h. apply f2n_ok.
+Qed.
+
+Lemma extend_f2n n f (x:Fin.t n) : extend f (f2n x) = f2n (f x).
+Proof.
+ generalize (n2f_f2n x). unfold extend, f2n, f2n_ok.
+ destruct (Fin.to_nat x) as (x',h); simpl.
+ break_dec h.
+ now intros ->.
+Qed.
+
+Lemma extend_n2f n f x (h:x<n) : n2f (extend_ok f h) = f (n2f h).
+Proof.
+ generalize (extend_ok f h). unfold extend in *. break_dec h. intros h'.
+ rewrite <- n2f_f2n. now apply n2f_ext.
+Qed.
+
+Lemma restrict_f2n n f hf (x:Fin.t n) :
+ f2n (@restrict n f hf x) = f (f2n x).
+Proof.
+ unfold restrict, f2n. destruct (Fin.to_nat x) as (x',h); simpl.
+ apply f2n_n2f.
+Qed.
+
+Lemma restrict_n2f n f hf x (h:x<n) :
+ @restrict n f hf (n2f h) = n2f (hf _ h).
+Proof.
+ unfold restrict. generalize (f2n_n2f h). unfold f2n.
+ destruct (Fin.to_nat (n2f h)) as (x',h'); simpl. intros ->.
+ now apply n2f_ext.
+Qed.
+
+Lemma extend_surjective n f :
+ bSurjective n (@extend n f) <-> Surjective f.
+Proof.
+ split.
+ - intros hf y.
+ destruct (hf _ (f2n_ok y)) as (x & h & Eq).
+ exists (n2f h).
+ apply f2n_inj. now rewrite <- Eq, <- extend_f2n, f2n_n2f.
+ - intros hf y hy.
+ destruct (hf (n2f hy)) as (x,Eq).
+ exists (f2n x).
+ split.
+ + apply f2n_ok.
+ + rewrite extend_f2n, Eq. apply f2n_n2f.
+Qed.
+
+Lemma extend_injective n f :
+ bInjective n (@extend n f) <-> Injective f.
+Proof.
+ split.
+ - intros hf x y Eq.
+ apply f2n_inj. apply hf; try apply f2n_ok.
+ now rewrite 2 extend_f2n, Eq.
+ - intros hf x y hx hy Eq.
+ rewrite <- (f2n_n2f hx), <- (f2n_n2f hy). f_equal.
+ apply hf.
+ rewrite <- 2 extend_n2f.
+ generalize (extend_ok f hx) (extend_ok f hy).
+ rewrite Eq. apply n2f_ext.
+Qed.
+
+Lemma restrict_surjective n f h :
+ Surjective (@restrict n f h) <-> bSurjective n f.
+Proof.
+ split.
+ - intros hf y hy.
+ destruct (hf (n2f hy)) as (x,Eq).
+ exists (f2n x).
+ split.
+ + apply f2n_ok.
+ + rewrite <- (restrict_f2n h), Eq. apply f2n_n2f.
+ - intros hf y.
+ destruct (hf _ (f2n_ok y)) as (x & hx & Eq).
+ exists (n2f hx).
+ apply f2n_inj. now rewrite restrict_f2n, f2n_n2f.
+Qed.
+
+Lemma restrict_injective n f h :
+ Injective (@restrict n f h) <-> bInjective n f.
+Proof.
+ split.
+ - intros hf x y hx hy Eq.
+ rewrite <- (f2n_n2f hx), <- (f2n_n2f hy). f_equal.
+ apply hf.
+ rewrite 2 restrict_n2f.
+ generalize (h x hx) (h y hy).
+ rewrite Eq. apply n2f_ext.
+ - intros hf x y Eq.
+ apply f2n_inj. apply hf; try apply f2n_ok.
+ now rewrite <- 2 (restrict_f2n h), Eq.
+Qed.
+
+End Fin2Restrict.
+Import Fin2Restrict.
+
+(** We can now use Proof via the equivalence ... *)
+
+Lemma bInjective_bSurjective n (f:nat->nat) :
+ bFun n f -> (bInjective n f <-> bSurjective n f).
+Proof.
+ intros h.
+ rewrite <- (restrict_injective h), <- (restrict_surjective h).
+ apply Endo_Injective_Surjective.
+ - apply Fin_Finite.
+ - intros x y. destruct (Fin.eq_dec x y); [left|right]; trivial.
+Qed.
+
+Lemma bSurjective_bBijective n (f:nat->nat) :
+ bFun n f -> bSurjective n f ->
+ exists g, bFun n g /\ forall x, x < n -> g (f x) = x /\ f (g x) = x.
+Proof.
+ intro hf.
+ rewrite <- (restrict_surjective hf). intros Su.
+ assert (Ij : Injective (restrict hf)).
+ { apply Endo_Injective_Surjective; trivial.
+ - apply Fin_Finite.
+ - intros x y. destruct (Fin.eq_dec x y); [left|right]; trivial. }
+ assert (Bi : Bijective (restrict hf)).
+ { apply Injective_Surjective_Bijective; trivial.
+ - apply Fin_Finite.
+ - exact Fin.eq_dec. }
+ destruct Bi as (g & Hg & Hg').
+ exists (extend g).
+ split.
+ - apply extend_ok.
+ - intros x Hx. split.
+ + now rewrite <- (f2n_n2f Hx), <- (restrict_f2n hf), extend_f2n, Hg.
+ + now rewrite <- (f2n_n2f Hx), extend_f2n, <- (restrict_f2n hf), Hg'.
+Qed.
diff --git a/theories/Logic/FunctionalExtensionality.v b/theories/Logic/FunctionalExtensionality.v
index 7d7792d5..eb50a3aa 100644
--- a/theories/Logic/FunctionalExtensionality.v
+++ b/theories/Logic/FunctionalExtensionality.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -19,6 +19,12 @@ Proof.
auto.
Qed.
+Lemma equal_f_dep : forall {A B} {f g : forall (x : A), B x},
+ f = g -> forall x, f x = g x.
+Proof.
+intros A B f g <- H; reflexivity.
+Qed.
+
(** Statements of functional extensionality for simple and dependent functions. *)
Axiom functional_extensionality_dep : forall {A} {B : A -> Type},
@@ -31,13 +37,35 @@ Proof.
intros ; eauto using @functional_extensionality_dep.
Qed.
+(** Extensionality of [forall]s follows from functional extensionality. *)
+Lemma forall_extensionality {A} {B C : A -> Type} (H : forall x : A, B x = C x)
+: (forall x, B x) = (forall x, C x).
+Proof.
+ apply functional_extensionality in H. destruct H. reflexivity.
+Defined.
+
+Lemma forall_extensionalityP {A} {B C : A -> Prop} (H : forall x : A, B x = C x)
+: (forall x, B x) = (forall x, C x).
+Proof.
+ apply functional_extensionality in H. destruct H. reflexivity.
+Defined.
+
+Lemma forall_extensionalityS {A} {B C : A -> Set} (H : forall x : A, B x = C x)
+: (forall x, B x) = (forall x, C x).
+Proof.
+ apply functional_extensionality in H. destruct H. reflexivity.
+Defined.
+
(** Apply [functional_extensionality], introducing variable x. *)
Tactic Notation "extensionality" ident(x) :=
match goal with
[ |- ?X = ?Y ] =>
(apply (@functional_extensionality _ _ X Y) ||
- apply (@functional_extensionality_dep _ _ X Y)) ; intro x
+ apply (@functional_extensionality_dep _ _ X Y) ||
+ apply forall_extensionalityP ||
+ apply forall_extensionalityS ||
+ apply forall_extensionality) ; intro x
end.
(** Eta expansion follows from extensionality. *)
diff --git a/theories/Logic/Hurkens.v b/theories/Logic/Hurkens.v
index 95e98038..ede51f57 100644
--- a/theories/Logic/Hurkens.v
+++ b/theories/Logic/Hurkens.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -8,74 +8,686 @@
(* Hurkens.v *)
(************************************************************************)
-(** This is Hurkens paradox [Hurkens] in system U-, adapted by Herman
- Geuvers [Geuvers] to show the inconsistency in the pure calculus of
- constructions of a retract from Prop into a small type.
+(** Exploiting Hurkens's paradox [[Hurkens95]] for system U- so as to
+ derive various contradictory contexts.
+
+ The file is divided into various sub-modules which all follow the
+ same structure: a section introduces the contradictory hypotheses
+ and a theorem named [paradox] concludes the module with a proof of
+ [False].
+
+ - The [Generic] module contains the actual Hurkens's paradox for a
+ postulated shallow encoding of system U- in Coq. This is an
+ adaptation by Arnaud Spiwack of a previous, more restricted
+ implementation by Herman Geuvers. It is used to derive every
+ other special cases of the paradox in this file.
+
+ - The [NoRetractToImpredicativeUniverse] module contains a simple
+ and effective formulation by Herman Geuvers [[Geuvers01]] of a
+ result by Thierry Coquand [[Coquand90]]. It states that no
+ impredicative sort can contain a type of which it is a
+ retract. This result implies that Coq with classical logic
+ stated in impredicative Set is inconsistent and that classical
+ logic stated in Prop implies proof-irrelevance (see
+ [ClassicalFacts.v])
+
+ - The [NoRetractFromSmallPropositionToProp] module is a
+ specialisation of the [NoRetractToImpredicativeUniverse] module
+ to the case where the impredicative sort is [Prop].
+
+ - The [NoRetractToModalProposition] module is a strengthening of
+ the [NoRetractFromSmallPropositionToProp] module. It shows that
+ given a monadic modality (aka closure operator) [M], the type of
+ modal propositions (i.e. such that [M A -> A]) cannot be a
+ retract of a modal proposition. It is an example of use of the
+ paradox where the universes of system U- are not mapped to
+ universes of Coq.
+
+ - The [NoRetractToNegativeProp] module is the specialisation of
+ the [NoRetractFromSmallPropositionToProp] module where the
+ modality is double-negation. This result implies that the
+ principle of weak excluded middle ([forall A, ~~A\/~A]) implies
+ a weak variant of proof irrelevance.
+
+ - The [NoRetractFromTypeToProp] module proves that [Prop] cannot
+ be a retract of a larger type.
+
+ - The [TypeNeqSmallType] module proves that [Type] is different
+ from any smaller type.
+
+ - The [PropNeqType] module proves that [Prop] is different from
+ any larger [Type]. It is an instance of the previous result.
References:
- - [Hurkens] A. J. Hurkens, "A simplification of Girard's paradox",
+ - [[Coquand90]] T. Coquand, "Metamathematical Investigations of a
+ Calculus of Constructions", Proceedings of Logic in Computer
+ Science (LICS'90), 1990.
+
+ - [[Hurkens95]] A. J. Hurkens, "A simplification of Girard's paradox",
Proceedings of the 2nd international conference Typed Lambda-Calculi
and Applications (TLCA'95), 1995.
- - [Geuvers] "Inconsistency of Classical Logic in Type Theory", 2001
- (see http://www.cs.kun.nl/~herman/note.ps.gz).
+ - [[Geuvers01]] H. Geuvers, "Inconsistency of Classical Logic in Type
+ Theory", 2001, revised 2007
+ (see {{http://www.cs.ru.nl/~herman/PUBS/newnote.ps.gz}}).
*)
+
+Set Universe Polymorphism.
+
+(* begin show *)
+
+(** * A modular proof of Hurkens's paradox. *)
+
+(** It relies on an axiomatisation of a shallow embedding of system U-
+ (i.e. types of U- are interpreted by types of Coq). The
+ universes are encoded in a style, due to Martin-Löf, where they
+ are given by a set of names and a family [El:Name->Type] which
+ interprets each name into a type. This allows the encoding of
+ universe to be decoupled from Coq's universes. Dependent products
+ and abstractions are similarly postulated rather than encoded as
+ Coq's dependent products and abstractions. *)
+
+Module Generic.
+
+(* begin hide *)
+(* Notations used in the proof. Hidden in coqdoc. *)
+
+Reserved Notation "'∀₁' x : A , B" (at level 200, x ident, A at level 200,right associativity).
+Reserved Notation "A '⟶₁' B" (at level 99, right associativity, B at level 200).
+Reserved Notation "'λ₁' x , u" (at level 200, x ident, right associativity).
+Reserved Notation "f '·₁' x" (at level 5, left associativity).
+Reserved Notation "'∀₂' A , F" (at level 200, A ident, right associativity).
+Reserved Notation "'λ₂' x , u" (at level 200, x ident, right associativity).
+Reserved Notation "f '·₁' [ A ]" (at level 5, left associativity).
+Reserved Notation "'∀₀' x : A , B" (at level 200, x ident, A at level 200,right associativity).
+Reserved Notation "A '⟶₀' B" (at level 99, right associativity, B at level 200).
+Reserved Notation "'λ₀' x , u" (at level 200, x ident, right associativity).
+Reserved Notation "f '·₀' x" (at level 5, left associativity).
+Reserved Notation "'∀₀¹' A : U , F" (at level 200, A ident, right associativity).
+Reserved Notation "'λ₀¹' x , u" (at level 200, x ident, right associativity).
+Reserved Notation "f '·₀' [ A ]" (at level 5, left associativity).
+
+(* end hide *)
+
+Section Paradox.
+
+(** ** Axiomatisation of impredicative universes in a Martin-Löf style *)
+
+(** System U- has two impredicative universes. In the proof of the
+ paradox they are slightly asymmetric (in particular the reduction
+ rules of the small universe are not needed). Therefore, the
+ axioms are duplicated allowing for a weaker requirement than the
+ actual system U-. *)
+
+
+(** *** Large universe *)
+Variable U1 : Type.
+Variable El1 : U1 -> Type.
+(** **** Closure by small product *)
+Variable Forall1 : forall u:U1, (El1 u -> U1) -> U1.
+ Notation "'∀₁' x : A , B" := (Forall1 A (fun x => B)).
+ Notation "A '⟶₁' B" := (Forall1 A (fun _ => B)).
+Variable lam1 : forall u B, (forall x:El1 u, El1 (B x)) -> El1 (∀₁ x:u, B x).
+ Notation "'λ₁' x , u" := (lam1 _ _ (fun x => u)).
+Variable app1 : forall u B (f:El1 (Forall1 u B)) (x:El1 u), El1 (B x).
+ Notation "f '·₁' x" := (app1 _ _ f x).
+Variable beta1 : forall u B (f:forall x:El1 u, El1 (B x)) x,
+ (λ₁ y, f y) ·₁ x = f x.
+(** **** Closure by large products *)
+(** [U1] only needs to quantify over itself. *)
+Variable ForallU1 : (U1->U1) -> U1.
+ Notation "'∀₂' A , F" := (ForallU1 (fun A => F)).
+Variable lamU1 : forall F, (forall A:U1, El1 (F A)) -> El1 (∀₂ A, F A).
+ Notation "'λ₂' x , u" := (lamU1 _ (fun x => u)).
+Variable appU1 : forall F (f:El1(∀₂ A,F A)) (A:U1), El1 (F A).
+ Notation "f '·₁' [ A ]" := (appU1 _ f A).
+Variable betaU1 : forall F (f:forall A:U1, El1 (F A)) A,
+ (λ₂ x, f x) ·₁ [ A ] = f A.
+
+(** *** Small universe *)
+(** The small universe is an element of the large one. *)
+Variable u0 : U1.
+Notation U0 := (El1 u0).
+Variable El0 : U0 -> Type.
+(** **** Closure by small product *)
+(** [U0] does not need reduction rules *)
+Variable Forall0 : forall u:U0, (El0 u -> U0) -> U0.
+ Notation "'∀₀' x : A , B" := (Forall0 A (fun x => B)).
+ Notation "A '⟶₀' B" := (Forall0 A (fun _ => B)).
+Variable lam0 : forall u B, (forall x:El0 u, El0 (B x)) -> El0 (∀₀ x:u, B x).
+ Notation "'λ₀' x , u" := (lam0 _ _ (fun x => u)).
+Variable app0 : forall u B (f:El0 (Forall0 u B)) (x:El0 u), El0 (B x).
+ Notation "f '·₀' x" := (app0 _ _ f x).
+(** **** Closure by large products *)
+Variable ForallU0 : forall u:U1, (El1 u->U0) -> U0.
+ Notation "'∀₀¹' A : U , F" := (ForallU0 U (fun A => F)).
+Variable lamU0 : forall U F, (forall A:El1 U, El0 (F A)) -> El0 (∀₀¹ A:U, F A).
+ Notation "'λ₀¹' x , u" := (lamU0 _ _ (fun x => u)).
+Variable appU0 : forall U F (f:El0(∀₀¹ A:U,F A)) (A:El1 U), El0 (F A).
+ Notation "f '·₀' [ A ]" := (appU0 _ _ f A).
+
+(** ** Automating the rewrite rules of our encoding. *)
+Local Ltac simplify :=
+ (* spiwack: ideally we could use [rewrite_strategy] here, but I am a tad
+ scared of the idea of depending on setoid rewrite in such a simple
+ file. *)
+ (repeat rewrite ?beta1, ?betaU1);
+ lazy beta.
+
+Local Ltac simplify_in h :=
+ (repeat rewrite ?beta1, ?betaU1 in h);
+ lazy beta in h.
+
+
+(** ** Hurkens's paradox. *)
+
+(** An inhabitant of [U0] standing for [False]. *)
+Variable F:U0.
+
+(** *** Preliminary definitions *)
+
+Definition V : U1 := ∀₂ A, ((A ⟶₁ u0) ⟶₁ A ⟶₁ u0) ⟶₁ A ⟶₁ u0.
+Definition U : U1 := V ⟶₁ u0.
+
+Definition sb (z:El1 V) : El1 V := λ₂ A, λ₁ r, λ₁ a, r ·₁ (z·₁[A]·₁r) ·₁ a.
+
+Definition le (i:El1 (U⟶₁u0)) (x:El1 U) : U0 :=
+ x ·₁ (λ₂ A, λ₁ r, λ₁ a, i ·₁ (λ₁ v, (sb v) ·₁ [A] ·₁ r ·₁ a)).
+Definition le' : El1 ((U⟶₁u0) ⟶₁ U ⟶₁ u0) := λ₁ i, λ₁ x, le i x.
+Definition induct (i:El1 (U⟶₁u0)) : U0 :=
+ ∀₀¹ x:U, le i x ⟶₀ i ·₁ x.
+
+Definition WF : El1 U := λ₁ z, (induct (z·₁[U] ·₁ le')).
+Definition I (x:El1 U) : U0 :=
+ (∀₀¹ i:U⟶₁u0, le i x ⟶₀ i ·₁ (λ₁ v, (sb v) ·₁ [U] ·₁ le' ·₁ x)) ⟶₀ F
+.
+
+(** *** Proof *)
+
+Lemma Omega : El0 (∀₀¹ i:U⟶₁u0, induct i ⟶₀ i ·₁ WF).
+Proof.
+ refine (λ₀¹ i, λ₀ y, _).
+ refine (y·₀[_]·₀_).
+ unfold le,WF,induct. simplify.
+ refine (λ₀¹ x, λ₀ h0, _). simplify.
+ refine (y·₀[_]·₀_).
+ unfold le. simplify.
+ unfold sb at 1. simplify.
+ unfold le' at 1. simplify.
+ exact h0.
+Qed.
+
+Lemma lemma1 : El0 (induct (λ₁ u, I u)).
+Proof.
+ unfold induct.
+ refine (λ₀¹ x, λ₀ p, _). simplify.
+ refine (λ₀ q,_).
+ assert (El0 (I (λ₁ v, (sb v)·₁[U]·₁le'·₁x))) as h.
+ { generalize (q·₀[λ₁ u, I u]·₀p). simplify.
+ intros q'.
+ exact q'. }
+ refine (h·₀_).
+ refine (λ₀¹ i,_).
+ refine (λ₀ h', _).
+ generalize (q·₀[λ₁ y, i ·₁ (λ₁ v, (sb v)·₁[U] ·₁ le' ·₁ y)]). simplify.
+ intros q'.
+ refine (q'·₀_). clear q'.
+ unfold le at 1 in h'. simplify_in h'.
+ unfold sb at 1 in h'. simplify_in h'.
+ unfold le' at 1 in h'. simplify_in h'.
+ exact h'.
+Qed.
+
+Lemma lemma2 : El0 ((∀₀¹i:U⟶₁u0, induct i ⟶₀ i·₁WF) ⟶₀ F).
+Proof.
+ refine (λ₀ x, _).
+ assert (El0 (I WF)) as h.
+ { generalize (x·₀[λ₁ u, I u]·₀lemma1). simplify.
+ intros q.
+ exact q. }
+ refine (h·₀_). clear h.
+ refine (λ₀¹ i, λ₀ h0, _).
+ generalize (x·₀[λ₁ y, i·₁(λ₁ v, (sb v)·₁[U]·₁le'·₁y)]). simplify.
+ intros q.
+ refine (q·₀_). clear q.
+ unfold le in h0. simplify_in h0.
+ unfold WF in h0. simplify_in h0.
+ exact h0.
+Qed.
+
+Theorem paradox : El0 F.
+Proof.
+ exact (lemma2·₀Omega).
+Qed.
+
+End Paradox.
+
+(** The [paradox] tactic can be called as a shortcut to use the paradox. *)
+Ltac paradox h :=
+ refine ((fun h => _) (paradox _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ ));cycle 1.
+
+End Generic.
+
+(** * Impredicative universes are not retracts. *)
+
+(** There can be no retract to an impredicative Coq universe from a
+ smaller type. In this version of the proof, the impredicativity of
+ the universe is postulated with a pair of functions from the
+ universe to its type and back which commute with dependent product
+ in an appropriate way. *)
+
+Module NoRetractToImpredicativeUniverse.
+
Section Paradox.
+Let U2 := Type.
+Let U1:U2 := Type.
+Variable U0:U1.
+
+(** *** [U1] is impredicative *)
+Variable u22u1 : U2 -> U1.
+Hypothesis u22u1_unit : forall (c:U2), c -> u22u1 c.
+(** [u22u1_counit] and [u22u1_coherent] only apply to dependent
+ product so that the equations happen in the smaller [U1] rather
+ than [U2]. Indeed, it is not generally the case that one can
+ project from a large universe to an impredicative universe and
+ then get back the original type again. It would be too strong a
+ hypothesis to require (in particular, it is not true of
+ [Prop]). The formulation is reminiscent of the monadic
+ characteristic of the projection from a large type to [Prop].*)
+Hypothesis u22u1_counit : forall (F:U1->U1), u22u1 (forall A,F A) -> (forall A,F A).
+Hypothesis u22u1_coherent : forall (F:U1 -> U1) (f:forall x:U1, F x) (x:U1),
+ u22u1_counit _ (u22u1_unit _ f) x = f x.
+
+(** *** [U0] is a retract of [U1] *)
+Variable u02u1 : U0 -> U1.
+Variable u12u0 : U1 -> U0.
+Hypothesis u12u0_unit : forall (b:U1), b -> u02u1 (u12u0 b).
+Hypothesis u12u0_counit : forall (b:U1), u02u1 (u12u0 b) -> b.
+
+(** ** Paradox *)
+
+Theorem paradox : forall F:U1, F.
+Proof.
+ intros F.
+ Generic.paradox h.
+ (** Large universe *)
+ + exact U1.
+ + exact (fun X => X).
+ + cbn. exact (fun u F => forall x:u, F x).
+ + cbn. exact (fun _ _ x => x).
+ + cbn. exact (fun _ _ x => x).
+ + cbn. easy.
+ + cbn. exact (fun F => u22u1 (forall x, F x)).
+ + cbn. exact (fun _ x => u22u1_unit _ x).
+ + cbn. exact (fun _ x => u22u1_counit _ x).
+ + cbn. intros **. now rewrite u22u1_coherent.
+ (** Small universe *)
+ + exact U0.
+ (** The interpretation of the small universe is the image of
+ [U0] in [U1]. *)
+ + cbn. exact (fun X => u02u1 X).
+ + cbn. exact (fun u F => u12u0 (forall x:(u02u1 u), u02u1 (F x))).
+ + cbn. intros * x. exact (u12u0_unit _ x).
+ + cbn. intros * x. exact (u12u0_counit _ x).
+ + cbn. exact (fun u F => u12u0 (forall x:u, u02u1 (F x))).
+ + cbn. intros * x. exact (u12u0_unit _ x).
+ + cbn. intros * x. exact (u12u0_counit _ x).
+ + cbn. exact (u12u0 F).
+ + cbn in h.
+ exact (u12u0_counit _ h).
+Qed.
+
+End Paradox.
+
+End NoRetractToImpredicativeUniverse.
+
+(** * Prop is not a retract *)
+
+(** The existence in the pure Calculus of Constructions of a retract
+ from [Prop] into a small type of [Prop] is inconsistent. This is a
+ special case of the previous result. *)
+
+Module NoRetractFromSmallPropositionToProp.
+
+Section Paradox.
+
+(** ** Retract of [Prop] in a small type *)
+
+(** The retract is axiomatized using logical equivalence as the
+ equality on propositions. *)
+
Variable bool : Prop.
Variable p2b : Prop -> bool.
Variable b2p : bool -> Prop.
Hypothesis p2p1 : forall A:Prop, b2p (p2b A) -> A.
Hypothesis p2p2 : forall A:Prop, A -> b2p (p2b A).
-Variable B : Prop.
-
-Definition V := forall A:Prop, ((A -> bool) -> A -> bool) -> A -> bool.
-Definition U := V -> bool.
-Definition sb (z:V) : V := fun A r a => r (z A r) a.
-Definition le (i:U -> bool) (x:U) : bool :=
- x (fun A r a => i (fun v => sb v A r a)).
-Definition induct (i:U -> bool) : Prop :=
- forall x:U, b2p (le i x) -> b2p (i x).
-Definition WF : U := fun z => p2b (induct (z U le)).
-Definition I (x:U) : Prop :=
- (forall i:U -> bool, b2p (le i x) -> b2p (i (fun v => sb v U le x))) -> B.
-
-Lemma Omega : forall i:U -> bool, induct i -> b2p (i WF).
+
+(** ** Paradox *)
+
+Theorem paradox : forall B:Prop, B.
Proof.
-intros i y.
-apply y.
-unfold le, WF, induct.
-apply p2p2.
-intros x H0.
-apply y.
-exact H0.
+ intros B.
+ pose proof
+ (NoRetractToImpredicativeUniverse.paradox@{Type Prop}) as P.
+ refine (P _ _ _ _ _ _ _ _ _ _);clear P.
+ + exact bool.
+ + exact (fun x => forall P:Prop, (x->P)->P).
+ + cbn. exact (fun _ x P k => k x).
+ + cbn. intros F P x.
+ apply P.
+ intros f.
+ exact (f x).
+ + cbn. easy.
+ + exact b2p.
+ + exact p2b.
+ + exact p2p2.
+ + exact p2p1.
Qed.
-Lemma lemma1 : induct (fun u => p2b (I u)).
+End Paradox.
+
+End NoRetractFromSmallPropositionToProp.
+
+(** * Modal fragments of [Prop] are not retracts *)
+
+(** In presence of a a monadic modality on [Prop], we can define a
+ subset of [Prop] of modal propositions which is also a complete
+ Heyting algebra. These cannot be a retract of a modal
+ proposition. This is a case where the universe in system U- are
+ not encoded as Coq universes. *)
+
+Module NoRetractToModalProposition.
+
+(** ** Monadic modality *)
+
+Section Paradox.
+
+Variable M : Prop -> Prop.
+Hypothesis unit : forall A:Prop, A -> M A.
+Hypothesis join : forall A:Prop, M (M A) -> M A.
+Hypothesis incr : forall A B:Prop, (A->B) -> M A -> M B.
+
+Lemma strength: forall A (P:A->Prop), M(forall x:A,P x) -> forall x:A,M(P x).
Proof.
-unfold induct.
-intros x p.
-apply (p2p2 (I x)).
-intro q.
-apply (p2p1 (I (fun v:V => sb v U le x)) (q (fun u => p2b (I u)) p)).
-intro i.
-apply q with (i := fun y => i (fun v:V => sb v U le y)).
+ eauto.
Qed.
-Lemma lemma2 : (forall i:U -> bool, induct i -> b2p (i WF)) -> B.
+(** ** The universe of modal propositions *)
+
+Definition MProp := { P:Prop | M P -> P }.
+Definition El : MProp -> Prop := @proj1_sig _ _.
+
+Lemma modal : forall P:MProp, M(El P) -> El P.
Proof.
-intro x.
-apply (p2p1 (I WF) (x (fun u => p2b (I u)) lemma1)).
-intros i H0.
-apply (x (fun y => i (fun v => sb v U le y))).
-apply (p2p1 _ H0).
+ intros [P m]. cbn.
+ exact m.
Qed.
-Theorem paradox : B.
+Definition Forall {A:Type} (P:A->MProp) : MProp.
+Proof.
+ refine (exist _ _ _).
+ + exact (forall x:A, El (P x)).
+ + intros h x.
+ eapply strength in h.
+ eauto using modal.
+Defined.
+
+(** ** Retract of the modal fragment of [Prop] in a small type *)
+
+(** The retract is axiomatized using logical equivalence as the
+ equality on propositions. *)
+
+Variable bool : MProp.
+Variable p2b : MProp -> El bool.
+Variable b2p : El bool -> MProp.
+Hypothesis p2p1 : forall A:MProp, El (b2p (p2b A)) -> El A.
+Hypothesis p2p2 : forall A:MProp, El A -> El (b2p (p2b A)).
+
+(** ** Paradox *)
+
+Theorem paradox : forall B:MProp, El B.
Proof.
-exact (lemma2 Omega).
+ intros B.
+ Generic.paradox h.
+ (** Large universe *)
+ + exact MProp.
+ + exact El.
+ + exact (fun _ => Forall).
+ + cbn. exact (fun _ _ f => f).
+ + cbn. exact (fun _ _ f => f).
+ + cbn. easy.
+ + exact Forall.
+ + cbn. exact (fun _ f => f).
+ + cbn. exact (fun _ f => f).
+ + cbn. easy.
+ (** Small universe *)
+ + exact bool.
+ + exact (fun b => El (b2p b)).
+ + cbn. exact (fun _ F => p2b (Forall (fun x => b2p (F x)))).
+ + cbn. auto.
+ + cbn. intros * f.
+ apply p2p1 in f. cbn in f.
+ exact f.
+ + exact (fun _ F => p2b (Forall (fun x => b2p (F x)))).
+ + cbn. auto.
+ + cbn. intros * f.
+ apply p2p1 in f. cbn in f.
+ exact f.
+ + apply p2b.
+ exact B.
+ + cbn in h. auto.
Qed.
End Paradox.
+
+End NoRetractToModalProposition.
+
+(** * The negative fragment of [Prop] is not a retract *)
+
+(** The existence in the pure Calculus of Constructions of a retract
+ from the negative fragment of [Prop] into a negative proposition
+ is inconsistent. This is an instance of the previous result. *)
+
+Module NoRetractToNegativeProp.
+
+(** ** The universe of negative propositions. *)
+
+Definition NProp := { P:Prop | ~~P -> P }.
+Definition El : NProp -> Prop := @proj1_sig _ _.
+
+Section Paradox.
+
+(** ** Retract of the negative fragment of [Prop] in a small type *)
+
+(** The retract is axiomatized using logical equivalence as the
+ equality on propositions. *)
+
+Variable bool : NProp.
+Variable p2b : NProp -> El bool.
+Variable b2p : El bool -> NProp.
+Hypothesis p2p1 : forall A:NProp, El (b2p (p2b A)) -> El A.
+Hypothesis p2p2 : forall A:NProp, El A -> El (b2p (p2b A)).
+
+(** ** Paradox *)
+
+Theorem paradox : forall B:NProp, El B.
+Proof.
+ intros B.
+ refine ((fun h => _) (NoRetractToModalProposition.paradox _ _ _ _ _ _ _ _ _ _));cycle 1.
+ + exact (fun P => ~~P).
+ + cbn. auto.
+ + cbn. auto.
+ + cbn. auto.
+ + exact bool.
+ + exact p2b.
+ + exact b2p.
+ + auto.
+ + auto.
+ + exact B.
+ + exact h.
+Qed.
+
+End Paradox.
+
+End NoRetractToNegativeProp.
+
+(** * Large universes are no retracts of [Prop]. *)
+
+(** The existence in the Calculus of Constructions with universes of a
+ retract from some [Type] universe into [Prop] is inconsistent. *)
+
+(* Note: Assuming the context [down:Type->Prop; up:Prop->Type; forth:
+ forall (A:Type), A -> up (down A); back: forall (A:Type), up
+ (down A) -> A; H: forall (A:Type) (P:A->Type) (a:A),
+ P (back A (forth A a)) -> P a] is probably enough. *)
+
+Module NoRetractFromTypeToProp.
+
+Definition Type2 := Type.
+Definition Type1 := Type : Type2.
+
+Section Paradox.
+
+(** ** Assumption of a retract from Type into Prop *)
+
+Variable down : Type1 -> Prop.
+Variable up : Prop -> Type1.
+Hypothesis up_down : forall (A:Type1), up (down A) = A :> Type1.
+
+(** ** Paradox *)
+
+Theorem paradox : forall P:Prop, P.
+Proof.
+ intros P.
+ Generic.paradox h.
+ (** Large universe. *)
+ + exact Type1.
+ + exact (fun X => X).
+ + cbn. exact (fun u F => forall x, F x).
+ + cbn. exact (fun _ _ x => x).
+ + cbn. exact (fun _ _ x => x).
+ + cbn. easy.
+ + exact (fun F => forall A:Prop, F(up A)).
+ + cbn. exact (fun F f A => f (up A)).
+ + cbn.
+ intros F f A.
+ specialize (f (down A)).
+ rewrite up_down in f.
+ exact f.
+ + cbn.
+ intros F f A.
+ destruct (up_down A). cbn.
+ reflexivity.
+ + exact Prop.
+ + cbn. exact (fun X => X).
+ + cbn. exact (fun A P => forall x:A, P x).
+ + cbn. exact (fun _ _ x => x).
+ + cbn. exact (fun _ _ x => x).
+ + cbn. exact (fun A P => forall x:A, P x).
+ + cbn. exact (fun _ _ x => x).
+ + cbn. exact (fun _ _ x => x).
+ + cbn. exact P.
+ + exact h.
+Qed.
+
+End Paradox.
+
+End NoRetractFromTypeToProp.
+
+(** * [A<>Type] *)
+
+(** No Coq universe can be equal to one of its elements. *)
+
+Module TypeNeqSmallType.
+
+Section Paradox.
+
+(** ** Universe [U] is equal to one of its elements. *)
+
+Let U := Type.
+Variable A:U.
+Hypothesis h : U=A.
+
+(** ** Universe [U] is a retract of [A] *)
+
+(** The following context is actually sufficient for the paradox to
+ hold. The hypothesis [h:U=A] is only used to define [down], [up]
+ and [up_down]. *)
+
+Let down (X:U) : A := @eq_rect _ _ (fun X => X) X _ h.
+Let up (X:A) : U := @eq_rect_r _ _ (fun X => X) X _ h.
+
+Lemma up_down : forall (X:U), up (down X) = X.
+Proof.
+ unfold up,down.
+ rewrite <- h.
+ reflexivity.
+Qed.
+
+
+Theorem paradox : False.
+Proof.
+ Generic.paradox p.
+ (** Large universe *)
+ + exact U.
+ + exact (fun X=>X).
+ + cbn. exact (fun X F => forall x:X, F x).
+ + cbn. exact (fun _ _ x => x).
+ + cbn. exact (fun _ _ x => x).
+ + cbn. easy.
+ + exact (fun F => forall x:A, F (up x)).
+ + cbn. exact (fun _ f => fun x:A => f (up x)).
+ + cbn. intros * f X.
+ specialize (f (down X)).
+ rewrite up_down in f.
+ exact f.
+ + cbn. intros ? f X.
+ destruct (up_down X). cbn.
+ reflexivity.
+ (** Small universe *)
+ + exact A.
+ (** The interpretation of [A] as a universe is [U]. *)
+ + cbn. exact up.
+ + cbn. exact (fun _ F => down (forall x, up (F x))).
+ + cbn. intros ? ? f.
+ rewrite up_down.
+ exact f.
+ + cbn. intros ? ? f.
+ rewrite up_down in f.
+ exact f.
+ + cbn. exact (fun _ F => down (forall x, up (F x))).
+ + cbn. intros ? ? f.
+ rewrite up_down.
+ exact f.
+ + cbn. intros ? ? f.
+ rewrite up_down in f.
+ exact f.
+ + cbn. exact (down False).
+ + rewrite up_down in p.
+ exact p.
+Qed.
+
+End Paradox.
+
+End TypeNeqSmallType.
+
+(** * [Prop<>Type]. *)
+
+(** Special case of [TypeNeqSmallType]. *)
+
+Module PropNeqType.
+
+Theorem paradox : Prop <> Type.
+Proof.
+ intros h.
+ refine (TypeNeqSmallType.paradox _ _).
+ + exact Prop.
+ + easy.
+Qed.
+
+End PropNeqType.
+
+(* end show *)
diff --git a/theories/Logic/IndefiniteDescription.v b/theories/Logic/IndefiniteDescription.v
index 198b7292..9875710e 100644
--- a/theories/Logic/IndefiniteDescription.v
+++ b/theories/Logic/IndefiniteDescription.v
@@ -1,13 +1,13 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
(************************************************************************)
(** This file provides a constructive form of indefinite description that
- allows to build choice functions; this is weaker than Hilbert's
+ allows building choice functions; this is weaker than Hilbert's
epsilon operator (which implies weakly classical properties) but
stronger than the axiom of choice (which cannot be used outside
the context of a theorem proof). *)
diff --git a/theories/Logic/JMeq.v b/theories/Logic/JMeq.v
index 36e2d100..98cddf0a 100644
--- a/theories/Logic/JMeq.v
+++ b/theories/Logic/JMeq.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -28,9 +28,11 @@ Arguments JMeq_refl {A x} , [A] x.
Hint Resolve JMeq_refl.
+Definition JMeq_hom {A : Type} (x y : A) := JMeq x y.
+
Lemma JMeq_sym : forall (A B:Type) (x:A) (y:B), JMeq x y -> JMeq y x.
-Proof.
-destruct 1; trivial.
+Proof.
+intros; destruct H; trivial.
Qed.
Hint Immediate JMeq_sym.
diff --git a/theories/Logic/ProofIrrelevance.v b/theories/Logic/ProofIrrelevance.v
index 5cd58419..eb00dedd 100644
--- a/theories/Logic/ProofIrrelevance.v
+++ b/theories/Logic/ProofIrrelevance.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Logic/ProofIrrelevanceFacts.v b/theories/Logic/ProofIrrelevanceFacts.v
index b80cfe52..6ab6abcf 100644
--- a/theories/Logic/ProofIrrelevanceFacts.v
+++ b/theories/Logic/ProofIrrelevanceFacts.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -40,7 +40,7 @@ Module ProofIrrelevanceTheory (M:ProofIrrelevance).
(** We derive the irrelevance of the membership property for subsets *)
Lemma subset_eq_compat :
- forall (U:Set) (P:U->Prop) (x y:U) (p:P x) (q:P y),
+ forall (U:Type) (P:U->Prop) (x y:U) (p:P x) (q:P y),
x = y -> exist P x p = exist P y q.
Proof.
intros.
diff --git a/theories/Logic/RelationalChoice.v b/theories/Logic/RelationalChoice.v
index 1f700c6c..61598130 100644
--- a/theories/Logic/RelationalChoice.v
+++ b/theories/Logic/RelationalChoice.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Logic/SetIsType.v b/theories/Logic/SetIsType.v
index 412f8956..f110237e 100644
--- a/theories/Logic/SetIsType.v
+++ b/theories/Logic/SetIsType.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -9,7 +9,7 @@
(** * The Set universe seen as a synonym for Type *)
(** After loading this file, Set becomes just another name for Type.
- This allows to easily perform a Set-to-Type migration, or at least
+ This allows easily performing a Set-to-Type migration, or at least
test whether a development relies or not on specific features of
Set: simply insert some Require Export of this file at starting
points of the development and try to recompile... *)
diff --git a/theories/Logic/WKL.v b/theories/Logic/WKL.v
new file mode 100644
index 00000000..408eca4a
--- /dev/null
+++ b/theories/Logic/WKL.v
@@ -0,0 +1,261 @@
+(************************************************************************)
+(* v * The Coq Proof Assistant / The Coq Development Team *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* \VV/ **************************************************************)
+(* // * This file is distributed under the terms of the *)
+(* * GNU Lesser General Public License Version 2.1 *)
+(************************************************************************)
+
+(** A constructive proof of a version of Weak König's Lemma over a
+ decidable predicate in the formulation of which infinite paths are
+ treated as predicates. The representation of paths as relations
+ avoid the need for classical logic and unique choice. The
+ decidability condition is sufficient to ensure that some required
+ instance of double negation for disjunction of finite paths holds.
+
+ The idea of the proof comes from the proof of the weak König's
+ lemma from separation in second-order arithmetic.
+
+ Notice that we do not start from a tree but just from an arbitrary
+ predicate. Original Weak Konig's Lemma is the instantiation of
+ the lemma to a tree *)
+
+Require Import WeakFan List.
+Import ListNotations.
+
+Require Import Omega.
+
+(** [is_path_from P n l] means that there exists a path of length [n]
+ from [l] on which [P] does not hold *)
+
+Inductive is_path_from (P:list bool -> Prop) : nat -> list bool -> Prop :=
+| here l : ~ P l -> is_path_from P 0 l
+| next_left l n : ~ P l -> is_path_from P n (true::l) -> is_path_from P (S n) l
+| next_right l n : ~ P l -> is_path_from P n (false::l) -> is_path_from P (S n) l.
+
+(** We give the characterization of is_path_from in terms of a more common arithmetical formula *)
+
+Proposition is_path_from_characterization P n l :
+ is_path_from P n l <-> exists l', length l' = n /\ forall n', n'<=n -> ~ P (rev (firstn n' l') ++ l).
+Proof.
+intros. split.
+- induction 1 as [|* HP _ (l'&Hl'&HPl')|* HP _ (l'&Hl'&HPl')].
+ + exists []. split. reflexivity. intros n <-/le_n_0_eq. assumption.
+ + exists (true :: l'). split. apply eq_S, Hl'. intros [|] H.
+ * assumption.
+ * simpl. rewrite <- app_assoc. apply HPl', le_S_n, H.
+ + exists (false :: l'). split. apply eq_S, Hl'. intros [|] H.
+ * assumption.
+ * simpl. rewrite <- app_assoc. apply HPl', le_S_n, H.
+- intros (l'& <- &HPl'). induction l' as [|[|]] in l, HPl' |- *.
+ + constructor. apply (HPl' 0). apply le_0_n.
+ + eapply next_left.
+ * apply (HPl' 0), le_0_n.
+ * fold (length l'). apply IHl'. intros n' H/le_n_S. apply HPl' in H. simpl in H. rewrite <- app_assoc in H. assumption.
+ + apply next_right.
+ * apply (HPl' 0), le_0_n.
+ * fold (length l'). apply IHl'. intros n' H/le_n_S. apply HPl' in H. simpl in H. rewrite <- app_assoc in H. assumption.
+Qed.
+
+(** [infinite_from P l] means that we can find arbitrary long paths
+ along which [P] does not hold above [l] *)
+
+Definition infinite_from (P:list bool -> Prop) l := forall n, is_path_from P n l.
+
+(** [has_infinite_path P] means that there is an infinite path
+ (represented as a predicate) along which [P] does not hold at all *)
+
+Definition has_infinite_path (P:list bool -> Prop) :=
+ exists (X:nat -> Prop), forall l, approx X l -> ~ P l.
+
+(** [inductively_barred_at P n l] means that [P] eventually holds above
+ [l] after at most [n] steps upwards *)
+
+Inductive inductively_barred_at (P:list bool -> Prop) : nat -> list bool -> Prop :=
+| now_at l n : P l -> inductively_barred_at P n l
+| propagate_at l n :
+ inductively_barred_at P n (true::l) ->
+ inductively_barred_at P n (false::l) ->
+ inductively_barred_at P (S n) l.
+
+(** The proof proceeds by building a set [Y] of finite paths
+ approximating either the smallest unbarred infinite path in [P], if
+ there is one (taking [true]>[false]), or the path
+ true::true::... if [P] happens to be inductively_barred *)
+
+Fixpoint Y P (l:list bool) :=
+ match l with
+ | [] => True
+ | b::l =>
+ Y P l /\
+ if b then exists n, inductively_barred_at P n (false::l) else infinite_from P (false::l)
+ end.
+
+Require Import Compare_dec Le Lt.
+
+Lemma is_path_from_restrict : forall P n n' l, n <= n' ->
+ is_path_from P n' l -> is_path_from P n l.
+Proof.
+intros * Hle H; induction H in n, Hle, H |- * ; intros.
+- apply le_n_0_eq in Hle as <-. apply here. assumption.
+- destruct n.
+ + apply here. assumption.
+ + apply next_left; auto using le_S_n.
+- destruct n.
+ + apply here. assumption.
+ + apply next_right; auto using le_S_n.
+Qed.
+
+Lemma inductively_barred_at_monotone : forall P l n n', n' <= n ->
+ inductively_barred_at P n' l -> inductively_barred_at P n l.
+Proof.
+intros * Hle Hbar.
+induction Hbar in n, l, Hle, Hbar |- *.
+- apply now_at; auto.
+- destruct n; [apply le_Sn_0 in Hle; contradiction|].
+ apply le_S_n in Hle.
+ apply propagate_at; auto.
+Qed.
+
+Definition demorgan_or (P:list bool -> Prop) l l' := ~ (P l /\ P l') -> ~ P l \/ ~ P l'.
+
+Definition demorgan_inductively_barred_at P :=
+ forall n l, demorgan_or (inductively_barred_at P n) (true::l) (false::l).
+
+Lemma inductively_barred_at_imp_is_path_from :
+ forall P, demorgan_inductively_barred_at P -> forall n l,
+ ~ inductively_barred_at P n l -> is_path_from P n l.
+Proof.
+intros P Hdemorgan; induction n; intros l H.
+- apply here.
+ intro. apply H.
+ apply now_at. auto.
+- assert (H0:~ (inductively_barred_at P n (true::l) /\ inductively_barred_at P n (false::l)))
+ by firstorder using inductively_barred_at.
+ assert (HnP:~ P l) by firstorder using inductively_barred_at.
+ apply Hdemorgan in H0 as [H0|H0]; apply IHn in H0; auto using is_path_from.
+Qed.
+
+Lemma is_path_from_imp_inductively_barred_at : forall P n l,
+ is_path_from P n l -> inductively_barred_at P n l -> False.
+Proof.
+intros P; induction n; intros l H1 H2.
+- inversion_clear H1. inversion_clear H2. auto.
+- inversion_clear H1.
+ + inversion_clear H2.
+ * auto.
+ * apply IHn with (true::l); auto.
+ + inversion_clear H2.
+ * auto.
+ * apply IHn with (false::l); auto.
+Qed.
+
+Lemma find_left_path : forall P l n,
+ is_path_from P (S n) l -> inductively_barred_at P n (false :: l) -> is_path_from P n (true :: l).
+Proof.
+inversion 1; subst; intros.
+- auto.
+- exfalso. eauto using is_path_from_imp_inductively_barred_at.
+Qed.
+
+Lemma Y_unique : forall P, demorgan_inductively_barred_at P ->
+ forall l1 l2, length l1 = length l2 -> Y P l1 -> Y P l2 -> l1 = l2.
+Proof.
+intros * DeMorgan. induction l1, l2.
+- trivial.
+- discriminate.
+- discriminate.
+- intros [= H] (HY1,H1) (HY2,H2).
+ pose proof (IHl1 l2 H HY1 HY2). clear HY1 HY2 H IHl1.
+ subst l1.
+ f_equal.
+ destruct a, b; try reflexivity.
+ + destruct H1 as (n,Hbar).
+ destruct (is_path_from_imp_inductively_barred_at _ _ _ (H2 n) Hbar).
+ + destruct H2 as (n,Hbar).
+ destruct (is_path_from_imp_inductively_barred_at _ _ _ (H1 n) Hbar).
+Qed.
+
+(** [X] is the translation of [Y] as a predicate *)
+
+Definition X P n := exists l, length l = n /\ Y P (true::l).
+
+Lemma Y_approx : forall P, demorgan_inductively_barred_at P ->
+ forall l, approx (X P) l -> Y P l.
+Proof.
+intros P DeMorgan. induction l.
+- trivial.
+- intros (H,Hb). split.
+ + auto.
+ + unfold X in Hb.
+ destruct a.
+ * destruct Hb as (l',(Hl',(HYl',HY))).
+ rewrite <- (Y_unique P DeMorgan l' l Hl'); auto.
+ * intro n. apply inductively_barred_at_imp_is_path_from. assumption.
+ firstorder.
+Qed.
+
+(** Main theorem *)
+
+Theorem PreWeakKonigsLemma : forall P,
+ demorgan_inductively_barred_at P -> infinite_from P [] -> has_infinite_path P.
+Proof.
+intros P DeMorgan Hinf.
+exists (X P). intros l Hl.
+assert (infinite_from P l).
+{ induction l.
+ - assumption.
+ - destruct Hl as (Hl,Ha).
+ intros n.
+ pose proof (IHl Hl) as IHl'. clear IHl.
+ apply Y_approx in Hl; [|assumption].
+ destruct a.
+ + destruct Ha as (l'&Hl'&HY'&n'&Hbar).
+ rewrite (Y_unique _ DeMorgan _ _ Hl' HY' Hl) in Hbar.
+ destruct (le_lt_dec n n') as [Hle|Hlt].
+ * specialize (IHl' (S n')).
+ apply is_path_from_restrict with n'; [assumption|].
+ apply find_left_path; trivial.
+ * specialize (IHl' (S n)).
+ apply inductively_barred_at_monotone with (n:=n) in Hbar; [|apply lt_le_weak, Hlt].
+ apply find_left_path; trivial.
+ + apply inductively_barred_at_imp_is_path_from; firstorder. }
+specialize (H 0). inversion H. assumption.
+Qed.
+
+Lemma inductively_barred_at_decidable :
+ forall P, (forall l, P l \/ ~ P l) -> forall n l, inductively_barred_at P n l \/ ~ inductively_barred_at P n l.
+Proof.
+intros P HP. induction n; intros.
+- destruct (HP l).
+ + left. apply now_at, H.
+ + right. inversion 1. auto.
+- destruct (HP l).
+ + left. apply now_at, H.
+ + destruct (IHn (true::l)).
+ * destruct (IHn (false::l)).
+ { left. apply propagate_at; assumption. }
+ { right. inversion_clear 1; auto. }
+ * right. inversion_clear 1; auto.
+Qed.
+
+Lemma inductively_barred_at_is_path_from_decidable :
+ forall P, (forall l, P l \/ ~ P l) -> demorgan_inductively_barred_at P.
+Proof.
+intros P Hdec n l H.
+destruct (inductively_barred_at_decidable P Hdec n (true::l)).
+- destruct (inductively_barred_at_decidable P Hdec n (false::l)).
+ + auto.
+ + auto.
+- auto.
+Qed.
+
+(** Main corollary *)
+
+Corollary WeakKonigsLemma : forall P, (forall l, P l \/ ~ P l) ->
+ infinite_from P [] -> has_infinite_path P.
+Proof.
+intros P Hdec Hinf.
+apply inductively_barred_at_is_path_from_decidable in Hdec.
+apply PreWeakKonigsLemma; assumption.
+Qed.
diff --git a/theories/Logic/WeakFan.v b/theories/Logic/WeakFan.v
new file mode 100644
index 00000000..49cc12b8
--- /dev/null
+++ b/theories/Logic/WeakFan.v
@@ -0,0 +1,105 @@
+(************************************************************************)
+(* v * The Coq Proof Assistant / The Coq Development Team *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* \VV/ **************************************************************)
+(* // * This file is distributed under the terms of the *)
+(* * GNU Lesser General Public License Version 2.1 *)
+(************************************************************************)
+
+(** A constructive proof of a non-standard version of the weak Fan Theorem
+ in the formulation of which infinite paths are treated as
+ predicates. The representation of paths as relations avoid the
+ need for classical logic and unique choice. The idea of the proof
+ comes from the proof of the weak König's lemma from separation in
+ second-order arithmetic [[Simpson99]].
+
+ [[Simpson99]] Stephen G. Simpson. Subsystems of second order
+ arithmetic, Cambridge University Press, 1999 *)
+
+Require Import List.
+Import ListNotations.
+
+(** [inductively_barred P l] means that P eventually holds above l *)
+
+Inductive inductively_barred P : list bool -> Prop :=
+| now l : P l -> inductively_barred P l
+| propagate l :
+ inductively_barred P (true::l) ->
+ inductively_barred P (false::l) ->
+ inductively_barred P l.
+
+(** [approx X l] says that [l] is a boolean representation of a prefix of [X] *)
+
+Fixpoint approx X (l:list bool) :=
+ match l with
+ | [] => True
+ | b::l => approx X l /\ (if b then X (length l) else ~ X (length l))
+ end.
+
+(** [barred P] means that for any infinite path represented as a predicate,
+ the property [P] holds for some prefix of the path *)
+
+Definition barred P :=
+ forall (X:nat -> Prop), exists l, approx X l /\ P l.
+
+(** The proof proceeds by building a set [Y] of finite paths
+ approximating either the smallest unbarred infinite path in [P], if
+ there is one (taking [true]>[false]), or the path [true::true::...]
+ if [P] happens to be inductively_barred *)
+
+Fixpoint Y P (l:list bool) :=
+ match l with
+ | [] => True
+ | b::l =>
+ Y P l /\
+ if b then inductively_barred P (false::l) else ~ inductively_barred P (false::l)
+ end.
+
+Lemma Y_unique : forall P l1 l2, length l1 = length l2 -> Y P l1 -> Y P l2 -> l1 = l2.
+Proof.
+induction l1, l2.
+- trivial.
+- discriminate.
+- discriminate.
+- intros H (HY1,H1) (HY2,H2).
+ injection H as H.
+ pose proof (IHl1 l2 H HY1 HY2). clear HY1 HY2 H IHl1.
+ subst l1.
+ f_equal.
+ destruct a, b; firstorder.
+Qed.
+
+(** [X] is the translation of [Y] as a predicate *)
+
+Definition X P n := exists l, length l = n /\ Y P (true::l).
+
+Lemma Y_approx : forall P l, approx (X P) l -> Y P l.
+Proof.
+induction l.
+- trivial.
+- intros (H,Hb). split.
+ + auto.
+ + unfold X in Hb.
+ destruct a.
+ * destruct Hb as (l',(Hl',(HYl',HY))).
+ rewrite <- (Y_unique P l' l Hl'); auto.
+ * firstorder.
+Qed.
+
+Theorem WeakFanTheorem : forall P, barred P -> inductively_barred P [].
+Proof.
+intros P Hbar.
+destruct (Hbar (X P)) as (l,(Hd,HP)).
+assert (inductively_barred P l) by (apply (now P l), HP).
+clear Hbar HP.
+induction l.
+- assumption.
+- destruct Hd as (Hd,HX).
+ apply (IHl Hd). clear IHl.
+ destruct a; unfold X in HX; simpl in HX.
+ + apply propagate.
+ * apply H.
+ * destruct HX as (l',(Hl,(HY,Ht))); firstorder.
+ apply Y_approx in Hd. rewrite <- (Y_unique P l' l Hl); trivial.
+ + destruct HX. exists l. split; auto using Y_approx.
+Qed.
diff --git a/theories/Logic/vo.itarget b/theories/Logic/vo.itarget
index 46046897..32359739 100644
--- a/theories/Logic/vo.itarget
+++ b/theories/Logic/vo.itarget
@@ -4,10 +4,8 @@ ClassicalChoice.vo
ClassicalDescription.vo
ClassicalEpsilon.vo
ClassicalFacts.vo
-Classical_Pred_Set.vo
Classical_Pred_Type.vo
Classical_Prop.vo
-Classical_Type.vo
ClassicalUniqueChoice.vo
Classical.vo
ConstructiveEpsilon.vo
@@ -18,7 +16,10 @@ Epsilon.vo
Eqdep_dec.vo
EqdepFacts.vo
Eqdep.vo
+WeakFan.vo
+WKL.vo
FunctionalExtensionality.vo
+ExtensionalityFacts.vo
Hurkens.vo
IndefiniteDescription.vo
JMeq.vo
@@ -26,3 +27,4 @@ ProofIrrelevanceFacts.vo
ProofIrrelevance.vo
RelationalChoice.vo
SetIsType.vo
+FinFun.vo \ No newline at end of file
diff --git a/theories/MSets/MSetAVL.v b/theories/MSets/MSetAVL.v
index db12ee31..e1fc454a 100644
--- a/theories/MSets/MSetAVL.v
+++ b/theories/MSets/MSetAVL.v
@@ -38,7 +38,6 @@ Unset Strict Implicit.
(* for nicer extraction, we create inductive principles
only when needed *)
Local Unset Elimination Schemes.
-Local Unset Case Analysis Schemes.
(** * Ops : the pure functions *)
@@ -307,13 +306,13 @@ Include MSetGenTree.Props X I.
Local Hint Immediate MX.eq_sym.
Local Hint Unfold In lt_tree gt_tree Ok.
Local Hint Constructors InT bst.
-Local Hint Resolve MX.eq_refl MX.eq_trans MX.lt_trans @ok.
+Local Hint Resolve MX.eq_refl MX.eq_trans MX.lt_trans ok.
Local Hint Resolve lt_leaf gt_leaf lt_tree_node gt_tree_node.
Local Hint Resolve lt_tree_not_in lt_tree_trans gt_tree_not_in gt_tree_trans.
Local Hint Resolve elements_spec2.
(* Sometimes functional induction will expose too much of
- a tree structure. The following tactic allows to factor back
+ a tree structure. The following tactic allows factoring back
a Node whose internal parts occurs nowhere else. *)
(* TODO: why Ltac instead of Tactic Notation don't work ? why clear ? *)
diff --git a/theories/MSets/MSetDecide.v b/theories/MSets/MSetDecide.v
index eefd2951..f2555791 100644
--- a/theories/MSets/MSetDecide.v
+++ b/theories/MSets/MSetDecide.v
@@ -15,7 +15,7 @@
(** This file implements a decision procedure for a certain
class of propositions involving finite sets. *)
-Require Import Decidable DecidableTypeEx MSetFacts.
+Require Import Decidable Setoid DecidableTypeEx MSetFacts.
(** First, a version for Weak Sets in functorial presentation *)
@@ -115,8 +115,8 @@ the above form:
not affect the namespace if you import the enclosing
module [Decide]. *)
Module MSetLogicalFacts.
- Require Export Decidable.
- Require Export Setoid.
+ Export Decidable.
+ Export Setoid.
(** ** Lemmas and Tactics About Decidable Propositions *)
diff --git a/theories/MSets/MSetEqProperties.v b/theories/MSets/MSetEqProperties.v
index 4f0d93fb..ae20edc8 100644
--- a/theories/MSets/MSetEqProperties.v
+++ b/theories/MSets/MSetEqProperties.v
@@ -819,8 +819,7 @@ Proof.
intros.
rewrite for_all_exists in H; auto.
rewrite negb_true_iff in H.
-elim (@for_all_mem_4 (fun x =>negb (f x)) Comp' s);intros;auto.
-elim p;intros.
+destruct (@for_all_mem_4 (fun x =>negb (f x)) Comp' s) as (x,[]); auto.
exists x;split;auto.
rewrite <-negb_false_iff; auto.
Qed.
@@ -856,7 +855,7 @@ intros.
rewrite <- (fold_equal _ _ _ _ fc ft 0 _ _ H).
rewrite <- (fold_equal _ _ _ _ gc gt 0 _ _ H).
rewrite <- (fold_equal _ _ _ _ fgc fgt 0 _ _ H); auto.
-intros; do 3 (rewrite fold_add; auto with *).
+intros. do 3 (rewrite fold_add; auto with *).
do 3 rewrite fold_empty;auto.
Qed.
diff --git a/theories/MSets/MSetGenTree.v b/theories/MSets/MSetGenTree.v
index 704ff31b..154c2384 100644
--- a/theories/MSets/MSetGenTree.v
+++ b/theories/MSets/MSetGenTree.v
@@ -27,14 +27,13 @@
- min_elt max_elt choose
*)
-Require Import Orders OrdersFacts MSetInterface NPeano.
+Require Import Orders OrdersFacts MSetInterface PeanoNat.
Local Open Scope list_scope.
Local Open Scope lazy_bool_scope.
(* For nicer extraction, we create induction principles
only when needed *)
Local Unset Elimination Schemes.
-Local Unset Case Analysis Schemes.
Module Type InfoTyp.
Parameter t : Set.
@@ -341,7 +340,7 @@ Module Import MX := OrderedTypeFacts X.
Scheme tree_ind := Induction for tree Sort Prop.
Scheme bst_ind := Induction for bst Sort Prop.
-Local Hint Resolve MX.eq_refl MX.eq_trans MX.lt_trans @ok.
+Local Hint Resolve MX.eq_refl MX.eq_trans MX.lt_trans ok.
Local Hint Immediate MX.eq_sym.
Local Hint Unfold In lt_tree gt_tree.
Local Hint Constructors InT bst.
@@ -378,7 +377,7 @@ Ltac invtree f :=
Ltac inv := inv_ok; invtree InT.
-Ltac intuition_in := repeat progress (intuition; inv).
+Ltac intuition_in := repeat (intuition; inv).
(** Helper tactic concerning order of elements. *)
@@ -963,13 +962,16 @@ Proof. firstorder. Qed.
Lemma eq_Leq : forall s s', eq s s' <-> L.eq (elements s) (elements s').
Proof.
unfold eq, Equal, L.eq; intros.
- setoid_rewrite elements_spec1; firstorder.
+ setoid_rewrite elements_spec1.
+ firstorder.
Qed.
Definition lt (s1 s2 : tree) : Prop :=
exists s1' s2', Ok s1' /\ Ok s2' /\ eq s1 s1' /\ eq s2 s2'
/\ L.lt (elements s1') (elements s2').
+Declare Equivalent Keys L.eq equivlistA.
+
Instance lt_strorder : StrictOrder lt.
Proof.
split.
@@ -1017,7 +1019,7 @@ Lemma flatten_e_elements :
forall l x r c e,
elements l ++ flatten_e (More x r e) = elements (Node c l x r) ++ flatten_e e.
Proof.
- intros; simpl. now rewrite elements_node, app_ass.
+ intros. now rewrite elements_node, app_ass.
Qed.
Lemma cons_1 : forall s e,
@@ -1051,7 +1053,7 @@ Lemma compare_cont_Cmp : forall s1 cont e2 l,
(forall e, Cmp (cont e) l (flatten_e e)) ->
Cmp (compare_cont s1 cont e2) (elements s1 ++ l) (flatten_e e2).
Proof.
- induction s1 as [|c1 l1 Hl1 x1 r1 Hr1]; simpl; intros; auto.
+ induction s1 as [|c1 l1 Hl1 x1 r1 Hr1]; intros; auto.
rewrite elements_node, app_ass; simpl.
apply Hl1; auto. clear e2. intros [|x2 r2 e2].
simpl; auto.
@@ -1063,9 +1065,9 @@ Lemma compare_Cmp : forall s1 s2,
Cmp (compare s1 s2) (elements s1) (elements s2).
Proof.
intros; unfold compare.
- rewrite (app_nil_end (elements s1)).
+ rewrite <- (app_nil_r (elements s1)).
replace (elements s2) with (flatten_e (cons s2 End)) by
- (rewrite cons_1; simpl; rewrite <- app_nil_end; auto).
+ (rewrite cons_1; simpl; rewrite app_nil_r; auto).
apply compare_cont_Cmp; auto.
intros.
apply compare_end_Cmp; auto.
@@ -1129,14 +1131,14 @@ Proof.
Qed.
Lemma maxdepth_log_cardinal s : s <> Leaf ->
- log2 (cardinal s) < maxdepth s.
+ Nat.log2 (cardinal s) < maxdepth s.
Proof.
intros H.
apply Nat.log2_lt_pow2. destruct s; simpl; intuition.
apply maxdepth_cardinal.
Qed.
-Lemma mindepth_log_cardinal s : mindepth s <= log2 (S (cardinal s)).
+Lemma mindepth_log_cardinal s : mindepth s <= Nat.log2 (S (cardinal s)).
Proof.
apply Nat.log2_le_pow2. auto with arith.
apply mindepth_cardinal.
diff --git a/theories/MSets/MSetInterface.v b/theories/MSets/MSetInterface.v
index 6778deff..bd881168 100644
--- a/theories/MSets/MSetInterface.v
+++ b/theories/MSets/MSetInterface.v
@@ -431,7 +431,6 @@ Module WRaw2SetsOn (E:DecidableType)(M:WRawSets E) <: WSetsOn E.
(** We avoid creating induction principles for the Record *)
Local Unset Elimination Schemes.
- Local Unset Case Analysis Schemes.
Definition elt := E.t.
diff --git a/theories/MSets/MSetList.v b/theories/MSets/MSetList.v
index d9b1fd9b..fb0d1ad9 100644
--- a/theories/MSets/MSetList.v
+++ b/theories/MSets/MSetList.v
@@ -56,7 +56,7 @@ Module Ops (X:OrderedType) <: WOps X.
Definition singleton (x : elt) := x :: nil.
- Fixpoint remove x s :=
+ Fixpoint remove x s : t :=
match s with
| nil => nil
| y :: l =>
@@ -228,16 +228,14 @@ Module MakeRaw (X: OrderedType) <: RawSets X.
Notation Inf := (lelistA X.lt).
Notation In := (InA X.eq).
- (* TODO: modify proofs in order to avoid these hints *)
- Hint Resolve (@Equivalence_Reflexive _ _ X.eq_equiv).
- Hint Immediate (@Equivalence_Symmetric _ _ X.eq_equiv).
- Hint Resolve (@Equivalence_Transitive _ _ X.eq_equiv).
+ Existing Instance X.eq_equiv.
+ Hint Extern 20 => solve [order].
Definition IsOk s := Sort s.
Class Ok (s:t) : Prop := ok : Sort s.
- Hint Resolve @ok.
+ Hint Resolve ok.
Hint Unfold Ok.
Instance Sort_Ok s `(Hs : Sort s) : Ok s := { ok := Hs }.
@@ -343,7 +341,6 @@ Module MakeRaw (X: OrderedType) <: RawSets X.
induction s; simpl; intros.
intuition. inv; auto.
elim_compare x a; inv; rewrite !InA_cons, ?IHs; intuition.
- left; order.
Qed.
Lemma remove_inf :
@@ -402,8 +399,8 @@ Module MakeRaw (X: OrderedType) <: RawSets X.
Global Instance union_ok s s' : forall `(Ok s, Ok s'), Ok (union s s').
Proof.
repeat rewrite <- isok_iff; revert s s'.
- induction2; constructors; try apply @ok; auto.
- apply Inf_eq with x'; auto; apply union_inf; auto; apply Inf_eq with x; auto.
+ induction2; constructors; try apply @ok; auto.
+ apply Inf_eq with x'; auto; apply union_inf; auto; apply Inf_eq with x; auto; order.
change (Inf x' (union (x :: l) l')); auto.
Qed.
@@ -412,7 +409,6 @@ Module MakeRaw (X: OrderedType) <: RawSets X.
In x (union s s') <-> In x s \/ In x s'.
Proof.
induction2; try rewrite ?InA_cons, ?Hrec, ?Hrec'; intuition; inv; auto.
- left; order.
Qed.
Lemma inter_inf :
@@ -440,7 +436,6 @@ Module MakeRaw (X: OrderedType) <: RawSets X.
Proof.
induction2; try rewrite ?InA_cons, ?Hrec, ?Hrec'; intuition; inv; auto;
try sort_inf_in; try order.
- left; order.
Qed.
Lemma diff_inf :
@@ -477,7 +472,7 @@ Module MakeRaw (X: OrderedType) <: RawSets X.
equal s s' = true <-> Equal s s'.
Proof.
induction s as [ | x s IH]; intros [ | x' s'] Hs Hs'; simpl.
- intuition.
+ intuition reflexivity.
split; intros H. discriminate. assert (In x' nil) by (rewrite H; auto). inv.
split; intros H. discriminate. assert (In x nil) by (rewrite <-H; auto). inv.
inv.
@@ -825,7 +820,7 @@ Module MakeRaw (X: OrderedType) <: RawSets X.
Lemma compare_spec_aux : forall s s', CompSpec eq L.lt s s' (compare s s').
Proof.
- induction s as [|x s IH]; intros [|x' s']; simpl; intuition.
+ induction s as [|x s IH]; intros [|x' s']; simpl; intuition.
elim_compare x x'; auto.
Qed.
diff --git a/theories/MSets/MSetPositive.v b/theories/MSets/MSetPositive.v
index e500602f..25a8c162 100644
--- a/theories/MSets/MSetPositive.v
+++ b/theories/MSets/MSetPositive.v
@@ -19,14 +19,9 @@
Require Import Bool BinPos Orders MSetInterface.
Set Implicit Arguments.
-
Local Open Scope lazy_bool_scope.
Local Open Scope positive_scope.
-
Local Unset Elimination Schemes.
-Local Unset Case Analysis Schemes.
-Local Unset Boolean Equality Schemes.
-
(** Even if [positive] can be seen as an ordered type with respect to the
usual order (see above), we can also use a lexicographic order over bits
@@ -98,7 +93,7 @@ Module PositiveSet <: S with Module E:=PositiveOrderedTypeBits.
Module E:=PositiveOrderedTypeBits.
- Definition elt := positive.
+ Definition elt := positive : Type.
Inductive tree :=
| Leaf : tree
@@ -106,9 +101,9 @@ Module PositiveSet <: S with Module E:=PositiveOrderedTypeBits.
Scheme tree_ind := Induction for tree Sort Prop.
- Definition t := tree.
+ Definition t := tree : Type.
- Definition empty := Leaf.
+ Definition empty : t := Leaf.
Fixpoint is_empty (m : t) : bool :=
match m with
@@ -116,7 +111,7 @@ Module PositiveSet <: S with Module E:=PositiveOrderedTypeBits.
| Node l b r => negb b &&& is_empty l &&& is_empty r
end.
- Fixpoint mem (i : positive) (m : t) : bool :=
+ Fixpoint mem (i : positive) (m : t) {struct m} : bool :=
match m with
| Leaf => false
| Node l o r =>
@@ -147,13 +142,13 @@ Module PositiveSet <: S with Module E:=PositiveOrderedTypeBits.
(** helper function to avoid creating empty trees that are not leaves *)
- Definition node l (b: bool) r :=
+ Definition node (l : t) (b: bool) (r : t) : t :=
if b then Node l b r else
match l,r with
| Leaf,Leaf => Leaf
| _,_ => Node l false r end.
- Fixpoint remove (i : positive) (m : t) : t :=
+ Fixpoint remove (i : positive) (m : t) {struct m} : t :=
match m with
| Leaf => Leaf
| Node l o r =>
@@ -164,7 +159,7 @@ Module PositiveSet <: S with Module E:=PositiveOrderedTypeBits.
end
end.
- Fixpoint union (m m': t) :=
+ Fixpoint union (m m': t) : t :=
match m with
| Leaf => m'
| Node l o r =>
@@ -174,7 +169,7 @@ Module PositiveSet <: S with Module E:=PositiveOrderedTypeBits.
end
end.
- Fixpoint inter (m m': t) :=
+ Fixpoint inter (m m': t) : t :=
match m with
| Leaf => Leaf
| Node l o r =>
@@ -184,7 +179,7 @@ Module PositiveSet <: S with Module E:=PositiveOrderedTypeBits.
end
end.
- Fixpoint diff (m m': t) :=
+ Fixpoint diff (m m': t) : t :=
match m with
| Leaf => Leaf
| Node l o r =>
@@ -216,7 +211,7 @@ Module PositiveSet <: S with Module E:=PositiveOrderedTypeBits.
(** reverses [y] and concatenate it with [x] *)
- Fixpoint rev_append y x :=
+ Fixpoint rev_append (y x : elt) : elt :=
match y with
| 1 => x
| y~1 => rev_append y x~1
@@ -267,14 +262,14 @@ Module PositiveSet <: S with Module E:=PositiveOrderedTypeBits.
end.
Definition exists_ m := xexists m 1.
- Fixpoint xfilter (m : t) (i : positive) :=
+ Fixpoint xfilter (m : t) (i : positive) : t :=
match m with
| Leaf => Leaf
| Node l o r => node (xfilter l i~0) (o &&& f (rev i)) (xfilter r i~1)
end.
Definition filter m := xfilter m 1.
- Fixpoint xpartition (m : t) (i : positive) :=
+ Fixpoint xpartition (m : t) (i : positive) : t * t :=
match m with
| Leaf => (Leaf,Leaf)
| Node l o r =>
@@ -316,7 +311,7 @@ Module PositiveSet <: S with Module E:=PositiveOrderedTypeBits.
(** would it be more efficient to use a path like in the above functions ? *)
- Fixpoint choose (m: t) :=
+ Fixpoint choose (m: t) : option elt :=
match m with
| Leaf => None
| Node l o r => if o then Some 1 else
@@ -326,7 +321,7 @@ Module PositiveSet <: S with Module E:=PositiveOrderedTypeBits.
end
end.
- Fixpoint min_elt (m: t) :=
+ Fixpoint min_elt (m: t) : option elt :=
match m with
| Leaf => None
| Node l o r =>
@@ -336,7 +331,7 @@ Module PositiveSet <: S with Module E:=PositiveOrderedTypeBits.
end
end.
- Fixpoint max_elt (m: t) :=
+ Fixpoint max_elt (m: t) : option elt :=
match m with
| Leaf => None
| Node l o r =>
@@ -414,10 +409,7 @@ Module PositiveSet <: S with Module E:=PositiveOrderedTypeBits.
case o; trivial.
destruct l; trivial.
destruct r; trivial.
- symmetry. destruct x.
- apply mem_Leaf.
- apply mem_Leaf.
- reflexivity.
+ destruct x; reflexivity.
Qed.
Local Opaque node.
@@ -427,7 +419,7 @@ Module PositiveSet <: S with Module E:=PositiveOrderedTypeBits.
Proof.
unfold Empty, In.
induction s as [|l IHl o r IHr]; simpl.
- setoid_rewrite mem_Leaf. firstorder.
+ firstorder.
rewrite <- 2andb_lazy_alt, 2andb_true_iff, IHl, IHr. clear IHl IHr.
destruct o; simpl; split.
intuition discriminate.
@@ -813,7 +805,7 @@ Module PositiveSet <: S with Module E:=PositiveOrderedTypeBits.
rewrite <- andb_lazy_alt. apply andb_true_iff.
Qed.
- Lemma filter_spec: forall s x f, compat_bool E.eq f ->
+ Lemma filter_spec: forall s x f, @compat_bool elt E.eq f ->
(In x (filter f s) <-> In x s /\ f x = true).
Proof. intros. apply xfilter_spec. Qed.
@@ -824,7 +816,7 @@ Module PositiveSet <: S with Module E:=PositiveOrderedTypeBits.
Proof.
unfold For_all, In. intro f.
induction s as [|l IHl o r IHr]; intros i; simpl.
- setoid_rewrite mem_Leaf. intuition discriminate.
+ intuition discriminate.
rewrite <- 2andb_lazy_alt, <- orb_lazy_alt, 2 andb_true_iff.
rewrite IHl, IHr. clear IHl IHr.
split.
@@ -838,7 +830,7 @@ Module PositiveSet <: S with Module E:=PositiveOrderedTypeBits.
apply H. assumption.
Qed.
- Lemma for_all_spec: forall s f, compat_bool E.eq f ->
+ Lemma for_all_spec: forall s f, @compat_bool elt E.eq f ->
(for_all f s = true <-> For_all (fun x => f x = true) s).
Proof. intros. apply xforall_spec. Qed.
@@ -849,7 +841,7 @@ Module PositiveSet <: S with Module E:=PositiveOrderedTypeBits.
Proof.
unfold Exists, In. intro f.
induction s as [|l IHl o r IHr]; intros i; simpl.
- setoid_rewrite mem_Leaf. firstorder.
+ firstorder.
rewrite <- 2orb_lazy_alt, 2orb_true_iff, <- andb_lazy_alt, andb_true_iff.
rewrite IHl, IHr. clear IHl IHr.
split.
@@ -860,7 +852,7 @@ Module PositiveSet <: S with Module E:=PositiveOrderedTypeBits.
intros [[x|x|] H]; eauto.
Qed.
- Lemma exists_spec : forall s f, compat_bool E.eq f ->
+ Lemma exists_spec : forall s f, @compat_bool elt E.eq f ->
(exists_ f s = true <-> Exists (fun x => f x = true) s).
Proof. intros. apply xexists_spec. Qed.
@@ -876,11 +868,11 @@ Module PositiveSet <: S with Module E:=PositiveOrderedTypeBits.
destruct o; simpl; rewrite IHl, IHr; reflexivity.
Qed.
- Lemma partition_spec1 : forall s f, compat_bool E.eq f ->
+ Lemma partition_spec1 : forall s f, @compat_bool elt E.eq f ->
Equal (fst (partition f s)) (filter f s).
Proof. intros. rewrite partition_filter. reflexivity. Qed.
- Lemma partition_spec2 : forall s f, compat_bool E.eq f ->
+ Lemma partition_spec2 : forall s f, @compat_bool elt E.eq f ->
Equal (snd (partition f s)) (filter (fun x => negb (f x)) s).
Proof. intros. rewrite partition_filter. reflexivity. Qed.
@@ -897,7 +889,7 @@ Module PositiveSet <: S with Module E:=PositiveOrderedTypeBits.
induction s as [|l IHl o r IHr]; simpl.
intros. split; intro H.
left. assumption.
- destruct H as [H|[x [Hx Hx']]]. assumption. elim (empty_spec Hx').
+ destruct H as [H|[x [Hx Hx']]]. assumption. discriminate.
intros j acc y. case o.
rewrite IHl. rewrite InA_cons. rewrite IHr. clear IHl IHr. split.
@@ -1087,7 +1079,7 @@ Module PositiveSet <: S with Module E:=PositiveOrderedTypeBits.
destruct (min_elt r).
injection H. intros <-. clear H.
destruct y as [z|z|].
- apply (IHr p z); trivial.
+ apply (IHr e z); trivial.
elim (Hp _ H').
discriminate.
discriminate.
@@ -1141,7 +1133,7 @@ Module PositiveSet <: S with Module E:=PositiveOrderedTypeBits.
injection H. intros <-. clear H.
destruct y as [z|z|].
elim (Hp _ H').
- apply (IHl p z); trivial.
+ apply (IHl e z); trivial.
discriminate.
discriminate.
Qed.
diff --git a/theories/MSets/MSetRBT.v b/theories/MSets/MSetRBT.v
index b838495f..751d4f35 100644
--- a/theories/MSets/MSetRBT.v
+++ b/theories/MSets/MSetRBT.v
@@ -31,13 +31,12 @@ Additional suggested reading:
*)
Require MSetGenTree.
-Require Import Bool List BinPos Pnat Setoid SetoidList NPeano.
+Require Import Bool List BinPos Pnat Setoid SetoidList PeanoNat.
Local Open Scope list_scope.
(* For nicer extraction, we create induction principles
only when needed *)
Local Unset Elimination Schemes.
-Local Unset Case Analysis Schemes.
(** An extra function not (yet?) in MSetInterface.S *)
@@ -399,7 +398,7 @@ Definition skip_black t :=
Fixpoint compare_height (s1x s1 s2 s2x: tree) : comparison :=
match skip_red s1x, skip_red s1, skip_red s2, skip_red s2x with
| Node _ s1x' _ _, Node _ s1' _ _, Node _ s2' _ _, Node _ s2x' _ _ =>
- compare_height (skip_black s2x') s1' s2' (skip_black s2x')
+ compare_height (skip_black s1x') s1' s2' (skip_black s2x')
| _, Leaf, _, Node _ _ _ _ => Lt
| Node _ _ _ _, _, Leaf, _ => Gt
| Node _ s1x' _ _, Node _ s1' _ _, Node _ s2' _ _, Leaf =>
@@ -452,7 +451,7 @@ Local Notation Bk := (Node Black).
Local Hint Immediate MX.eq_sym.
Local Hint Unfold In lt_tree gt_tree Ok.
Local Hint Constructors InT bst.
-Local Hint Resolve MX.eq_refl MX.eq_trans MX.lt_trans @ok.
+Local Hint Resolve MX.eq_refl MX.eq_trans MX.lt_trans ok.
Local Hint Resolve lt_leaf gt_leaf lt_tree_node gt_tree_node.
Local Hint Resolve lt_tree_not_in lt_tree_trans gt_tree_not_in gt_tree_trans.
Local Hint Resolve elements_spec2.
@@ -980,7 +979,7 @@ Proof.
{ transitivity size; trivial. subst. auto with arith. }
destruct acc1 as [|x acc1].
{ exfalso. revert LE. apply Nat.lt_nge. subst.
- rewrite <- app_nil_end, <- elements_cardinal; auto with arith. }
+ rewrite app_nil_r, <- elements_cardinal; auto with arith. }
specialize (Hg acc1).
destruct (g acc1) as (t2,acc2).
destruct Hg as (Hg1,Hg2).
@@ -988,7 +987,7 @@ Proof.
rewrite app_length, <- elements_cardinal. simpl.
rewrite Nat.add_succ_r, <- Nat.succ_le_mono.
apply Nat.add_le_mono_l. }
- simpl. rewrite elements_node, app_ass. now subst.
+ rewrite elements_node, app_ass. now subst.
Qed.
Lemma treeify_aux_spec n (p:bool) :
@@ -1013,7 +1012,7 @@ Qed.
Lemma plength_aux_spec l p :
Pos.to_nat (plength_aux l p) = length l + Pos.to_nat p.
Proof.
- revert p. induction l; simpl; trivial.
+ revert p. induction l; trivial. simpl plength_aux.
intros. now rewrite IHl, Pos2Nat.inj_succ, Nat.add_succ_r.
Qed.
@@ -1059,7 +1058,7 @@ Lemma filter_aux_elements s f acc :
filter_aux f s acc = List.filter f (elements s) ++ acc.
Proof.
revert acc.
- induction s as [|c l IHl x r IHr]; simpl; trivial.
+ induction s as [|c l IHl x r IHr]; trivial.
intros acc.
rewrite elements_node, filter_app. simpl.
destruct (f x); now rewrite IHl, IHr, app_ass.
@@ -1197,7 +1196,7 @@ Lemma INV_rev l1 l2 acc :
Proof.
intros. rewrite rev_append_rev.
apply SortA_app with X.eq; eauto with *.
- intros x y. inA. eapply l1_lt_acc; eauto.
+ intros x y. inA. eapply @l1_lt_acc; eauto.
Qed.
(** ** union *)
@@ -1567,7 +1566,7 @@ Proof.
Qed.
Lemma maxdepth_upperbound s : Rbt s ->
- maxdepth s <= 2 * log2 (S (cardinal s)).
+ maxdepth s <= 2 * Nat.log2 (S (cardinal s)).
Proof.
intros (n,H).
eapply Nat.le_trans; [eapply rb_maxdepth; eauto|].
@@ -1582,7 +1581,7 @@ Proof.
Qed.
Lemma maxdepth_lowerbound s : s<>Leaf ->
- log2 (cardinal s) < maxdepth s.
+ Nat.log2 (cardinal s) < maxdepth s.
Proof.
apply maxdepth_log_cardinal.
Qed.
diff --git a/theories/MSets/MSetWeakList.v b/theories/MSets/MSetWeakList.v
index fd4114cd..372acd56 100644
--- a/theories/MSets/MSetWeakList.v
+++ b/theories/MSets/MSetWeakList.v
@@ -56,8 +56,8 @@ Module Ops (X: DecidableType) <: WOps X.
if X.eq_dec x y then l else y :: remove x l
end.
- Definition fold (B : Type) (f : elt -> B -> B) (s : t) (i : B) : B :=
- fold_left (flip f) s i.
+ Definition fold (B : Type) (f : elt -> B -> B) : t -> B -> B :=
+ fold_left (flip f).
Definition union (s : t) : t -> t := fold add s.
@@ -118,16 +118,18 @@ Module MakeRaw (X:DecidableType) <: WRawSets X.
Notation In := (InA X.eq).
(* TODO: modify proofs in order to avoid these hints *)
- Hint Resolve (@Equivalence_Reflexive _ _ X.eq_equiv).
- Hint Immediate (@Equivalence_Symmetric _ _ X.eq_equiv).
- Hint Resolve (@Equivalence_Transitive _ _ X.eq_equiv).
+ Let eqr:= (@Equivalence_Reflexive _ _ X.eq_equiv).
+ Let eqsym:= (@Equivalence_Symmetric _ _ X.eq_equiv).
+ Let eqtrans:= (@Equivalence_Transitive _ _ X.eq_equiv).
+ Hint Resolve eqr eqtrans.
+ Hint Immediate eqsym.
Definition IsOk := NoDup.
Class Ok (s:t) : Prop := ok : NoDup s.
Hint Unfold Ok.
- Hint Resolve @ok.
+ Hint Resolve ok.
Instance NoDup_Ok s (nd : NoDup s) : Ok s := { ok := nd }.
@@ -215,10 +217,10 @@ Module MakeRaw (X:DecidableType) <: WRawSets X.
Proof.
induction s; simpl; intros.
intuition; inv; auto.
- destruct X.eq_dec; inv; rewrite !InA_cons, ?IHs; intuition.
+ destruct X.eq_dec as [|Hnot]; inv; rewrite !InA_cons, ?IHs; intuition.
elim H. setoid_replace a with y; eauto.
elim H3. setoid_replace x with y; eauto.
- elim n. eauto.
+ elim Hnot. eauto.
Qed.
Global Instance remove_ok s x `(Ok s) : Ok (remove x s).
diff --git a/theories/NArith/BinNat.v b/theories/NArith/BinNat.v
index 1023924e..641ec02f 100644
--- a/theories/NArith/BinNat.v
+++ b/theories/NArith/BinNat.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -8,7 +8,7 @@
Require Export BinNums.
Require Import BinPos RelationClasses Morphisms Setoid
- Equalities OrdersFacts GenericMinMax Bool NAxioms NProperties.
+ Equalities OrdersFacts GenericMinMax Bool NAxioms NMaxMin NProperties.
Require BinNatDef.
(**********************************************************************)
@@ -66,6 +66,20 @@ Notation "( p | q )" := (divide p q) (at level 0) : N_scope.
Definition Even n := exists m, n = 2*m.
Definition Odd n := exists m, n = 2*m+1.
+(** Proofs of morphisms, obvious since eq is Leibniz *)
+
+Local Obligation Tactic := simpl_relation.
+Program Definition succ_wd : Proper (eq==>eq) succ := _.
+Program Definition pred_wd : Proper (eq==>eq) pred := _.
+Program Definition add_wd : Proper (eq==>eq==>eq) add := _.
+Program Definition sub_wd : Proper (eq==>eq==>eq) sub := _.
+Program Definition mul_wd : Proper (eq==>eq==>eq) mul := _.
+Program Definition lt_wd : Proper (eq==>eq==>iff) lt := _.
+Program Definition div_wd : Proper (eq==>eq==>eq) div := _.
+Program Definition mod_wd : Proper (eq==>eq==>eq) modulo := _.
+Program Definition pow_wd : Proper (eq==>eq==>eq) pow := _.
+Program Definition testbit_wd : Proper (eq==>eq==>Logic.eq) testbit := _.
+
(** Decidability of equality. *)
Definition eq_dec : forall n m : N, { n = m } + { n <> m }.
@@ -138,6 +152,50 @@ Proof.
apply peano_rect_succ.
Qed.
+(** Generic induction / recursion *)
+
+Theorem bi_induction :
+ forall A : N -> Prop, Proper (Logic.eq==>iff) A ->
+ A 0 -> (forall n, A n <-> A (succ n)) -> forall n : N, A n.
+Proof.
+intros A A_wd A0 AS. apply peano_rect. assumption. intros; now apply -> AS.
+Qed.
+
+Definition recursion {A} : A -> (N -> A -> A) -> N -> A :=
+ peano_rect (fun _ => A).
+
+Instance recursion_wd {A} (Aeq : relation A) :
+ Proper (Aeq==>(Logic.eq==>Aeq==>Aeq)==>Logic.eq==>Aeq) recursion.
+Proof.
+intros a a' Ea f f' Ef x x' Ex. subst x'.
+induction x using peano_ind.
+trivial.
+unfold recursion in *. rewrite 2 peano_rect_succ. now apply Ef.
+Qed.
+
+Theorem recursion_0 {A} (a:A) (f:N->A->A) : recursion a f 0 = a.
+Proof. reflexivity. Qed.
+
+Theorem recursion_succ {A} (Aeq : relation A) (a : A) (f : N -> A -> A):
+ Aeq a a -> Proper (Logic.eq==>Aeq==>Aeq) f ->
+ forall n : N, Aeq (recursion a f (succ n)) (f n (recursion a f n)).
+Proof.
+unfold recursion; intros a_wd f_wd n. induction n using peano_ind.
+rewrite peano_rect_succ. now apply f_wd.
+rewrite !peano_rect_succ in *. now apply f_wd.
+Qed.
+
+(** Specification of constants *)
+
+Lemma one_succ : 1 = succ 0.
+Proof. reflexivity. Qed.
+
+Lemma two_succ : 2 = succ 1.
+Proof. reflexivity. Qed.
+
+Definition pred_0 : pred 0 = 0.
+Proof. reflexivity. Qed.
+
(** Properties of mixed successor and predecessor. *)
Lemma pos_pred_spec p : Pos.pred_N p = pred (pos p).
@@ -262,69 +320,30 @@ Qed.
Include BoolOrderFacts.
-(** We regroup here some results used for proving the correctness
- of more advanced functions. These results will also be provided
- by the generic functor of properties about natural numbers
- instantiated at the end of the file. *)
-
-Module Import Private_BootStrap.
-
-Theorem add_0_r n : n + 0 = n.
-Proof.
-now destruct n.
-Qed.
-
-Theorem add_comm n m : n + m = m + n.
-Proof.
-destruct n, m; simpl; try reflexivity. simpl. f_equal. apply Pos.add_comm.
-Qed.
-
-Theorem add_assoc n m p : n + (m + p) = n + m + p.
-Proof.
-destruct n; try reflexivity.
-destruct m; try reflexivity.
-destruct p; try reflexivity.
-simpl. f_equal. apply Pos.add_assoc.
-Qed.
-
-Lemma sub_add n m : n <= m -> m - n + n = m.
-Proof.
- destruct n as [|p], m as [|q]; simpl; try easy'. intros H.
- case Pos.sub_mask_spec; intros; simpl; subst; trivial.
- now rewrite Pos.add_comm.
- apply Pos.le_nlt in H. elim H. apply Pos.lt_add_r.
-Qed.
+(** Specification of minimum and maximum *)
-Theorem mul_comm n m : n * m = m * n.
+Theorem min_l n m : n <= m -> min n m = n.
Proof.
-destruct n, m; simpl; trivial. f_equal. apply Pos.mul_comm.
+unfold min, le. case compare; trivial. now destruct 1.
Qed.
-Lemma le_0_l n : 0<=n.
+Theorem min_r n m : m <= n -> min n m = m.
Proof.
-now destruct n.
+unfold min, le. rewrite compare_antisym.
+case compare_spec; trivial. now destruct 2.
Qed.
-Lemma leb_spec n m : BoolSpec (n<=m) (m<n) (n <=? m).
+Theorem max_l n m : m <= n -> max n m = n.
Proof.
- unfold le, lt, leb. rewrite (compare_antisym n m).
- case compare; now constructor.
+unfold max, le. rewrite compare_antisym.
+case compare_spec; auto. now destruct 2.
Qed.
-Lemma add_lt_cancel_l n m p : p+n < p+m -> n<m.
+Theorem max_r n m : n <= m -> max n m = m.
Proof.
- intro H. destruct p. simpl; auto.
- destruct n; destruct m.
- elim (Pos.lt_irrefl _ H).
- red; auto.
- rewrite add_0_r in H. simpl in H.
- red in H. simpl in H.
- elim (Pos.lt_not_add_l _ _ H).
- now apply (Pos.add_lt_mono_l p).
+unfold max, le. case compare; trivial. now destruct 1.
Qed.
-End Private_BootStrap.
-
(** Specification of lt and le. *)
Lemma lt_succ_r n m : n < succ m <-> n<=m.
@@ -334,6 +353,13 @@ split. now destruct p. now destruct 1.
apply Pos.lt_succ_r.
Qed.
+(** We can now derive all properties of basic functions and orders,
+ and use these properties for proving the specs of more advanced
+ functions. *)
+
+Include NBasicProp <+ UsualMinMaxLogicalProperties <+ UsualMinMaxDecProperties.
+
+
(** Properties of [double] and [succ_double] *)
Lemma double_spec n : double n = 2 * n.
@@ -395,30 +421,6 @@ Proof.
Qed.
-(** Specification of minimum and maximum *)
-
-Theorem min_l n m : n <= m -> min n m = n.
-Proof.
-unfold min, le. case compare; trivial. now destruct 1.
-Qed.
-
-Theorem min_r n m : m <= n -> min n m = m.
-Proof.
-unfold min, le. rewrite compare_antisym.
-case compare_spec; trivial. now destruct 2.
-Qed.
-
-Theorem max_l n m : m <= n -> max n m = n.
-Proof.
-unfold max, le. rewrite compare_antisym.
-case compare_spec; auto. now destruct 2.
-Qed.
-
-Theorem max_r n m : n <= m -> max n m = m.
-Proof.
-unfold max, le. case compare; trivial. now destruct 1.
-Qed.
-
(** 0 is the least natural number *)
Theorem compare_0_r n : (n ?= 0) <> Lt.
@@ -560,13 +562,13 @@ Proof.
(* a~1 *)
destruct pos_div_eucl as (q,r); simpl in *.
case leb_spec; intros H; simpl; trivial.
- apply add_lt_cancel_l with b. rewrite add_comm, sub_add by trivial.
+ apply add_lt_mono_l with b. rewrite add_comm, sub_add by trivial.
destruct b as [|b]; [now destruct Hb| simpl; rewrite Pos.add_diag ].
apply (succ_double_lt _ _ IHa).
(* a~0 *)
destruct pos_div_eucl as (q,r); simpl in *.
case leb_spec; intros H; simpl; trivial.
- apply add_lt_cancel_l with b. rewrite add_comm, sub_add by trivial.
+ apply add_lt_mono_l with b. rewrite add_comm, sub_add by trivial.
destruct b as [|b]; [now destruct Hb| simpl; rewrite Pos.add_diag ].
now destruct r.
(* 1 *)
@@ -754,7 +756,7 @@ Proof.
destruct m. now destruct (shiftl a n).
rewrite <- (succ_pos_pred p), testbit_succ_r_div2, div2_double by apply le_0_l.
apply IHn.
- apply add_lt_cancel_l with 1. rewrite 2 (add_succ_l 0). simpl.
+ apply add_lt_mono_l with 1. rewrite 2 (add_succ_l 0). simpl.
now rewrite succ_pos_pred.
Qed.
@@ -833,71 +835,10 @@ Proof.
apply pos_ldiff_spec.
Qed.
-(** Specification of constants *)
-
-Lemma one_succ : 1 = succ 0.
-Proof. reflexivity. Qed.
-
-Lemma two_succ : 2 = succ 1.
-Proof. reflexivity. Qed.
-
-Definition pred_0 : pred 0 = 0.
-Proof. reflexivity. Qed.
-
-(** Proofs of morphisms, obvious since eq is Leibniz *)
-
-Local Obligation Tactic := simpl_relation.
-Program Definition succ_wd : Proper (eq==>eq) succ := _.
-Program Definition pred_wd : Proper (eq==>eq) pred := _.
-Program Definition add_wd : Proper (eq==>eq==>eq) add := _.
-Program Definition sub_wd : Proper (eq==>eq==>eq) sub := _.
-Program Definition mul_wd : Proper (eq==>eq==>eq) mul := _.
-Program Definition lt_wd : Proper (eq==>eq==>iff) lt := _.
-Program Definition div_wd : Proper (eq==>eq==>eq) div := _.
-Program Definition mod_wd : Proper (eq==>eq==>eq) modulo := _.
-Program Definition pow_wd : Proper (eq==>eq==>eq) pow := _.
-Program Definition testbit_wd : Proper (eq==>eq==>Logic.eq) testbit := _.
-
-(** Generic induction / recursion *)
-
-Theorem bi_induction :
- forall A : N -> Prop, Proper (Logic.eq==>iff) A ->
- A 0 -> (forall n, A n <-> A (succ n)) -> forall n : N, A n.
-Proof.
-intros A A_wd A0 AS. apply peano_rect. assumption. intros; now apply -> AS.
-Qed.
-
-Definition recursion {A} : A -> (N -> A -> A) -> N -> A :=
- peano_rect (fun _ => A).
+(** Instantiation of generic properties of advanced functions
+ (pow, sqrt, log2, div, gcd, ...) *)
-Instance recursion_wd {A} (Aeq : relation A) :
- Proper (Aeq==>(Logic.eq==>Aeq==>Aeq)==>Logic.eq==>Aeq) recursion.
-Proof.
-intros a a' Ea f f' Ef x x' Ex. subst x'.
-induction x using peano_ind.
-trivial.
-unfold recursion in *. rewrite 2 peano_rect_succ. now apply Ef.
-Qed.
-
-Theorem recursion_0 {A} (a:A) (f:N->A->A) : recursion a f 0 = a.
-Proof. reflexivity. Qed.
-
-Theorem recursion_succ {A} (Aeq : relation A) (a : A) (f : N -> A -> A):
- Aeq a a -> Proper (Logic.eq==>Aeq==>Aeq) f ->
- forall n : N, Aeq (recursion a f (succ n)) (f n (recursion a f n)).
-Proof.
-unfold recursion; intros a_wd f_wd n. induction n using peano_ind.
-rewrite peano_rect_succ. now apply f_wd.
-rewrite !peano_rect_succ in *. now apply f_wd.
-Qed.
-
-(** Instantiation of generic properties of natural numbers *)
-
-(** The Bind Scope prevents N to stay associated with abstract_scope.
- (TODO FIX) *)
-
-Include NProp. Bind Scope N_scope with N.
-Include UsualMinMaxLogicalProperties <+ UsualMinMaxDecProperties.
+Include NExtraProp.
(** In generic statements, the predicates [lt] and [le] have been
favored, whereas [gt] and [ge] don't even exist in the abstract
@@ -946,7 +887,7 @@ Proof.
destruct n as [|n]; simpl in *.
destruct m. now destruct p. elim (Pos.nlt_1_r _ H).
rewrite Pos.iter_succ. simpl.
- set (u:=Pos.iter n xO p) in *; clearbody u.
+ set (u:=Pos.iter xO p n) in *; clearbody u.
destruct m as [|m]. now destruct u.
rewrite <- (IHn (Pos.pred_N m)).
rewrite <- (testbit_odd_succ _ (Pos.pred_N m)).
@@ -970,7 +911,7 @@ Proof.
rewrite <- IHn.
rewrite testbit_succ_r_div2 by apply le_0_l.
f_equal. simpl. rewrite Pos.iter_succ.
- now destruct (Pos.iter n xO p).
+ now destruct (Pos.iter xO p n).
apply succ_le_mono. now rewrite succ_pos_pred.
Qed.
@@ -983,6 +924,8 @@ Qed.
End N.
+Bind Scope N_scope with N.t N.
+
(** Exportation of notations *)
Infix "+" := N.add : N_scope.
diff --git a/theories/NArith/BinNatDef.v b/theories/NArith/BinNatDef.v
index 9abf4955..9de2e7e1 100644
--- a/theories/NArith/BinNatDef.v
+++ b/theories/NArith/BinNatDef.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -325,8 +325,8 @@ Definition lxor n m :=
(** Shifts *)
-Definition shiftl_nat (a:N)(n:nat) := nat_iter n double a.
-Definition shiftr_nat (a:N)(n:nat) := nat_iter n div2 a.
+Definition shiftl_nat (a:N) := nat_rect _ a (fun _ => double).
+Definition shiftr_nat (a:N) := nat_rect _ a (fun _ => div2).
Definition shiftl a n :=
match a with
@@ -337,7 +337,7 @@ Definition shiftl a n :=
Definition shiftr a n :=
match n with
| 0 => a
- | pos p => Pos.iter p div2 a
+ | pos p => Pos.iter div2 a p
end.
(** Checking whether a particular bit is set or not *)
@@ -375,7 +375,7 @@ Definition of_nat (n:nat) :=
Definition iter (n:N) {A} (f:A->A) (x:A) : A :=
match n with
| 0 => x
- | pos p => Pos.iter p f x
+ | pos p => Pos.iter f x p
end.
End N. \ No newline at end of file
diff --git a/theories/NArith/NArith.v b/theories/NArith/NArith.v
index ff0be4a3..43614543 100644
--- a/theories/NArith/NArith.v
+++ b/theories/NArith/NArith.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/NArith/Ndec.v b/theories/NArith/Ndec.v
index e38ce5ba..5b1815bd 100644
--- a/theories/NArith/Ndec.v
+++ b/theories/NArith/Ndec.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -119,11 +119,11 @@ Lemma Nneq_elim a a' :
N.odd a = negb (N.odd a') \/
N.eqb (N.div2 a) (N.div2 a') = false.
Proof.
- intros. cut (N.odd a = N.odd a' \/ N.odd a = negb (N.odd a')).
- intros. elim H0. intro. right. apply Ndiv2_bit_neq. assumption.
- assumption.
- intro. left. assumption.
- case (N.odd a), (N.odd a'); auto.
+ intros.
+ enough (N.odd a = N.odd a' \/ N.odd a = negb (N.odd a')) as [].
+ - right. apply Ndiv2_bit_neq; assumption.
+ - left. assumption.
+ - case (N.odd a), (N.odd a'); auto.
Qed.
Lemma Ndouble_or_double_plus_un a :
diff --git a/theories/NArith/Ndigits.v b/theories/NArith/Ndigits.v
index 764ecc12..55ef451e 100644
--- a/theories/NArith/Ndigits.v
+++ b/theories/NArith/Ndigits.v
@@ -1,13 +1,12 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
(************************************************************************)
-Require Import Bool Morphisms Setoid Bvector BinPos BinNat Wf_nat
- Pnat Nnat Compare_dec Lt Minus.
+Require Import Bool Morphisms Setoid Bvector BinPos BinNat PeanoNat Pnat Nnat.
Local Open Scope N_scope.
@@ -86,7 +85,7 @@ Lemma Nshiftl_nat_equiv :
forall a n, N.shiftl_nat a (N.to_nat n) = N.shiftl a n.
Proof.
intros [|a] [|n]; simpl; unfold N.shiftl_nat; trivial.
- apply nat_iter_invariant; intros; now subst.
+ induction (Pos.to_nat n) as [|? H]; simpl; now try rewrite H.
rewrite <- Pos2Nat.inj_iter. symmetry. now apply Pos.iter_swap_gen.
Qed.
@@ -103,7 +102,7 @@ Lemma Nshiftr_nat_spec : forall a n m,
Proof.
induction n; intros m.
now rewrite <- plus_n_O.
- simpl. rewrite <- plus_n_Sm, <- plus_Sn_m, <- IHn, Nshiftr_nat_S.
+ simpl. rewrite <- plus_n_Sm, <- plus_Sn_m, <- IHn.
destruct (N.shiftr_nat a n) as [|[p|p|]]; simpl; trivial.
Qed.
@@ -111,10 +110,12 @@ Lemma Nshiftl_nat_spec_high : forall a n m, (n<=m)%nat ->
N.testbit_nat (N.shiftl_nat a n) m = N.testbit_nat a (m-n).
Proof.
induction n; intros m H.
- now rewrite <- minus_n_O.
- destruct m. inversion H. apply le_S_n in H.
- simpl. rewrite <- IHn, Nshiftl_nat_S; trivial.
- destruct (N.shiftl_nat a n) as [|[p|p|]]; simpl; trivial.
+ - now rewrite Nat.sub_0_r.
+ - destruct m.
+ + inversion H.
+ + apply le_S_n in H.
+ simpl. rewrite <- IHn; trivial.
+ destruct (N.shiftl_nat a n) as [|[p|p|]]; simpl; trivial.
Qed.
Lemma Nshiftl_nat_spec_low : forall a n m, (m<n)%nat ->
@@ -123,9 +124,10 @@ Proof.
induction n; intros m H. inversion H.
rewrite Nshiftl_nat_S.
destruct m.
- destruct (N.shiftl_nat a n); trivial.
- specialize (IHn m (lt_S_n _ _ H)).
- destruct (N.shiftl_nat a n); trivial.
+ - destruct (N.shiftl_nat a n); trivial.
+ - apply Lt.lt_S_n in H.
+ specialize (IHn m H).
+ destruct (N.shiftl_nat a n); trivial.
Qed.
(** A left shift for positive numbers (used in BigN) *)
@@ -148,7 +150,7 @@ Lemma Pshiftl_nat_plus : forall n m p,
Pos.shiftl_nat p (m + n) = Pos.shiftl_nat (Pos.shiftl_nat p n) m.
Proof.
induction m; simpl; intros. reflexivity.
- rewrite 2 Pshiftl_nat_S. now f_equal.
+ now f_equal.
Qed.
(** Semantics of bitwise operations with respect to [N.testbit_nat] *)
@@ -446,49 +448,52 @@ Lemma Nless_trans :
Nless a a' = true -> Nless a' a'' = true -> Nless a a'' = true.
Proof.
induction a as [|a IHa|a IHa] using N.binary_ind; intros a' a'' H H0.
- case_eq (Nless N0 a'') ; intros Heqn. trivial.
- rewrite (N0_less_2 a'' Heqn), (Nless_z a') in H0. discriminate H0.
- induction a' as [|a' _|a' _] using N.binary_ind.
- rewrite (Nless_z (N.double a)) in H. discriminate H.
- rewrite (Nless_def_1 a a') in H.
- induction a'' using N.binary_ind.
- rewrite (Nless_z (N.double a')) in H0. discriminate H0.
- rewrite (Nless_def_1 a' a'') in H0. rewrite (Nless_def_1 a a'').
- exact (IHa _ _ H H0).
- apply Nless_def_3.
- induction a'' as [|a'' _|a'' _] using N.binary_ind.
- rewrite (Nless_z (N.succ_double a')) in H0. discriminate H0.
- rewrite (Nless_def_4 a' a'') in H0. discriminate H0.
- apply Nless_def_3.
- induction a' as [|a' _|a' _] using N.binary_ind.
- rewrite (Nless_z (N.succ_double a)) in H. discriminate H.
- rewrite (Nless_def_4 a a') in H. discriminate H.
+ - case_eq (Nless N0 a'') ; intros Heqn.
+ + trivial.
+ + rewrite (N0_less_2 a'' Heqn), (Nless_z a') in H0. discriminate H0.
+ - induction a' as [|a' _|a' _] using N.binary_ind.
+ + rewrite (Nless_z (N.double a)) in H. discriminate H.
+ + rewrite (Nless_def_1 a a') in H.
induction a'' using N.binary_ind.
- rewrite (Nless_z (N.succ_double a')) in H0. discriminate H0.
- rewrite (Nless_def_4 a' a'') in H0. discriminate H0.
- rewrite (Nless_def_2 a' a'') in H0. rewrite (Nless_def_2 a a') in H.
- rewrite (Nless_def_2 a a''). exact (IHa _ _ H H0).
+ * rewrite (Nless_z (N.double a')) in H0. discriminate H0.
+ * rewrite (Nless_def_1 a' a'') in H0. rewrite (Nless_def_1 a a'').
+ exact (IHa _ _ H H0).
+ * apply Nless_def_3.
+ + induction a'' as [|a'' _|a'' _] using N.binary_ind.
+ * rewrite (Nless_z (N.succ_double a')) in H0. discriminate H0.
+ * rewrite (Nless_def_4 a' a'') in H0. discriminate H0.
+ * apply Nless_def_3.
+ - induction a' as [|a' _|a' _] using N.binary_ind.
+ + rewrite (Nless_z (N.succ_double a)) in H. discriminate H.
+ + rewrite (Nless_def_4 a a') in H. discriminate H.
+ + induction a'' using N.binary_ind.
+ * rewrite (Nless_z (N.succ_double a')) in H0. discriminate H0.
+ * rewrite (Nless_def_4 a' a'') in H0. discriminate H0.
+ * rewrite (Nless_def_2 a' a'') in H0. rewrite (Nless_def_2 a a') in H.
+ rewrite (Nless_def_2 a a''). exact (IHa _ _ H H0).
Qed.
Lemma Nless_total :
forall a a', {Nless a a' = true} + {Nless a' a = true} + {a = a'}.
Proof.
induction a using N.binary_rec; intro a'.
- case_eq (Nless N0 a') ; intros Heqb. left. left. auto.
- right. rewrite (N0_less_2 a' Heqb). reflexivity.
- induction a' as [|a' _|a' _] using N.binary_rec.
- case_eq (Nless N0 (N.double a)) ; intros Heqb. left. right. auto.
- right. exact (N0_less_2 _ Heqb).
- rewrite 2!Nless_def_1. destruct (IHa a') as [ | ->].
- left. assumption.
- right. reflexivity.
- left. left. apply Nless_def_3.
- induction a' as [|a' _|a' _] using N.binary_rec.
- left. right. destruct a; reflexivity.
- left. right. apply Nless_def_3.
- rewrite 2!Nless_def_2. destruct (IHa a') as [ | ->].
- left. assumption.
- right. reflexivity.
+ - case_eq (Nless N0 a') ; intros Heqb.
+ + left. left. auto.
+ + right. rewrite (N0_less_2 a' Heqb). reflexivity.
+ - induction a' as [|a' _|a' _] using N.binary_rec.
+ + case_eq (Nless N0 (N.double a)) ; intros Heqb.
+ * left. right. auto.
+ * right. exact (N0_less_2 _ Heqb).
+ + rewrite 2!Nless_def_1. destruct (IHa a') as [ | ->].
+ * left. assumption.
+ * right. reflexivity.
+ + left. left. apply Nless_def_3.
+ - induction a' as [|a' _|a' _] using N.binary_rec.
+ + left. right. destruct a; reflexivity.
+ + left. right. apply Nless_def_3.
+ + rewrite 2!Nless_def_2. destruct (IHa a') as [ | ->].
+ * left. assumption.
+ * right. reflexivity.
Qed.
(** Number of digits in a number *)
@@ -512,9 +517,9 @@ Definition N2Bv (n:N) : Bvector (N.size_nat n) :=
Fixpoint Bv2N (n:nat)(bv:Bvector n) : N :=
match bv with
- | Vector.nil => N0
- | Vector.cons false n bv => N.double (Bv2N n bv)
- | Vector.cons true n bv => N.succ_double (Bv2N n bv)
+ | Vector.nil _ => N0
+ | Vector.cons _ false n bv => N.double (Bv2N n bv)
+ | Vector.cons _ true n bv => N.succ_double (Bv2N n bv)
end.
Lemma Bv2N_N2Bv : forall n, Bv2N _ (N2Bv n) = n.
@@ -622,7 +627,7 @@ induction bv; intros.
inversion H.
destruct p ; simpl.
destruct (Bv2N n bv); destruct h; simpl in *; auto.
- specialize IHbv with p (lt_S_n _ _ H).
+ specialize IHbv with p (Lt.lt_S_n _ _ H).
simpl in * ; destruct (Bv2N n bv); destruct h; simpl in *; auto.
Qed.
@@ -641,7 +646,7 @@ Proof.
destruct n as [|n].
inversion H.
induction n ; destruct p ; unfold Vector.nth_order in *; simpl in * ; auto.
-intros H ; destruct (lt_n_O _ (lt_S_n _ _ H)).
+intros H ; destruct (Lt.lt_n_O _ (Lt.lt_S_n _ _ H)).
Qed.
(** Binary bitwise operations are the same in the two worlds. *)
diff --git a/theories/NArith/Ndist.v b/theories/NArith/Ndist.v
index 0bff1a96..5467f9cb 100644
--- a/theories/NArith/Ndist.v
+++ b/theories/NArith/Ndist.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -71,7 +71,7 @@ Proof.
auto with bool arith.
intros. generalize H0 H1. case n. intros. simpl in H3. discriminate H3.
intros. simpl. unfold Nplength in H.
- cut (ni (Pplength p0) = ni n0). intro. inversion H4. reflexivity.
+ enough (ni (Pplength p0) = ni n0) by (inversion H4; reflexivity).
apply H. intros. change (N.testbit_nat (Npos (xO p0)) (S k) = false). apply H2. apply lt_n_S. exact H4.
exact H3.
intro. case n. trivial.
@@ -104,10 +104,9 @@ Lemma ni_min_comm : forall d d':natinf, ni_min d d' = ni_min d' d.
Proof.
simple induction d. simple induction d'; trivial.
simple induction d'; trivial. elim n. simple induction n0; trivial.
- intros. elim n1; trivial. intros. unfold ni_min in H. cut (min n0 n2 = min n2 n0).
- intro. unfold ni_min. simpl. rewrite H1. reflexivity.
- cut (ni (min n0 n2) = ni (min n2 n0)). intros.
- inversion H1; trivial.
+ intros. elim n1; trivial. intros. unfold ni_min in H.
+ enough (min n0 n2 = min n2 n0) by (unfold ni_min; simpl; rewrite H1; reflexivity).
+ enough (ni (min n0 n2) = ni (min n2 n0)) by (inversion H1; trivial).
exact (H n2).
Qed.
@@ -116,10 +115,10 @@ Lemma ni_min_assoc :
Proof.
simple induction d; trivial. simple induction d'; trivial.
simple induction d''; trivial.
- unfold ni_min. intro. cut (min (min n n0) n1 = min n (min n0 n1)).
- intro. rewrite H. reflexivity.
- generalize n0 n1. elim n; trivial.
- simple induction n3; trivial. simple induction n5; trivial.
+ unfold ni_min. intro.
+ enough (min (min n n0) n1 = min n (min n0 n1)) by (rewrite H; reflexivity).
+ induction n in n0, n1 |- *; trivial.
+ destruct n0; trivial. destruct n1; trivial.
intros. simpl. auto.
Qed.
@@ -174,15 +173,13 @@ Qed.
Lemma ni_min_case : forall d d':natinf, ni_min d d' = d \/ ni_min d d' = d'.
Proof.
- simple induction d. intro. right. exact (ni_min_inf_l d').
- simple induction d'. left. exact (ni_min_inf_r (ni n)).
- unfold ni_min. cut (forall n0:nat, min n n0 = n \/ min n n0 = n0).
- intros. case (H n0). intro. left. rewrite H0. reflexivity.
- intro. right. rewrite H0. reflexivity.
- elim n. intro. left. reflexivity.
- simple induction n1. right. reflexivity.
- intros. case (H n2). intro. left. simpl. rewrite H1. reflexivity.
- intro. right. simpl. rewrite H1. reflexivity.
+ destruct d. right. exact (ni_min_inf_l d').
+ destruct d'. left. exact (ni_min_inf_r (ni n)).
+ unfold ni_min.
+ enough (min n n0 = n \/ min n n0 = n0) as [-> | ->].
+ left. reflexivity.
+ right. reflexivity.
+ destruct (Nat.min_dec n n0); [left|right]; assumption.
Qed.
Lemma ni_le_total : forall d d':natinf, ni_le d d' \/ ni_le d' d.
@@ -208,11 +205,7 @@ Qed.
Lemma le_ni_le : forall m n:nat, m <= n -> ni_le (ni m) (ni n).
Proof.
- cut (forall m n:nat, m <= n -> min m n = m).
- intros. unfold ni_le, ni_min. rewrite (H m n H0). reflexivity.
- simple induction m. trivial.
- simple induction n0. intro. inversion H0.
- intros. simpl. rewrite (H n1 (le_S_n n n1 H1)). reflexivity.
+ intros * H. unfold ni_le, ni_min. rewrite (Peano.min_l m n H). reflexivity.
Qed.
Lemma ni_le_le : forall m n:nat, ni_le (ni m) (ni n) -> m <= n.
@@ -298,30 +291,28 @@ Proof.
rewrite (ni_min_inf_l (Nplength a')) in H.
rewrite (Nplength_infty a' H). simpl. apply ni_le_refl.
intros. unfold Nplength at 1. apply Nplength_lb. intros.
- cut (forall a'':N, N.lxor (Npos p) a' = a'' -> N.testbit_nat a'' k = false).
- intros. apply H1. reflexivity.
+ enough (forall a'':N, N.lxor (Npos p) a' = a'' -> N.testbit_nat a'' k = false).
+ { apply H1. reflexivity. }
intro a''. case a''. intro. reflexivity.
intros. rewrite <- H1. rewrite (Nxor_semantics (Npos p) a' k).
rewrite
(Nplength_zeros (Npos p) (Pplength p)
(eq_refl (Nplength (Npos p))) k H0).
- generalize H. case a'. trivial.
- intros. cut (N.testbit_nat (Npos p1) k = false). intros. rewrite H3. reflexivity.
+ destruct a'. trivial.
+ enough (N.testbit_nat (Npos p1) k = false) as -> by reflexivity.
apply Nplength_zeros with (n := Pplength p1). reflexivity.
apply (lt_le_trans k (Pplength p) (Pplength p1)). exact H0.
- apply ni_le_le. exact H2.
+ apply ni_le_le. exact H.
Qed.
Lemma Nplength_ultra :
forall a a':N,
ni_le (ni_min (Nplength a) (Nplength a')) (Nplength (N.lxor a a')).
Proof.
- intros. case (ni_le_total (Nplength a) (Nplength a')). intro.
- cut (ni_min (Nplength a) (Nplength a') = Nplength a).
- intro. rewrite H0. apply Nplength_ultra_1. exact H.
+ intros. destruct (ni_le_total (Nplength a) (Nplength a')).
+ enough (ni_min (Nplength a) (Nplength a') = Nplength a) as -> by (apply Nplength_ultra_1; exact H).
exact H.
- intro. cut (ni_min (Nplength a) (Nplength a') = Nplength a').
- intro. rewrite H0. rewrite N.lxor_comm. apply Nplength_ultra_1. exact H.
+ enough (ni_min (Nplength a) (Nplength a') = Nplength a') as -> by (rewrite N.lxor_comm; apply Nplength_ultra_1; exact H).
rewrite ni_min_comm. exact H.
Qed.
diff --git a/theories/NArith/Ndiv_def.v b/theories/NArith/Ndiv_def.v
index d21361cd..5ae388e3 100644
--- a/theories/NArith/Ndiv_def.v
+++ b/theories/NArith/Ndiv_def.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/NArith/Ngcd_def.v b/theories/NArith/Ngcd_def.v
index 9faddddb..1750ffeb 100644
--- a/theories/NArith/Ngcd_def.v
+++ b/theories/NArith/Ngcd_def.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/NArith/Nnat.v b/theories/NArith/Nnat.v
index 64c9a48e..0dcaa71d 100644
--- a/theories/NArith/Nnat.v
+++ b/theories/NArith/Nnat.v
@@ -1,13 +1,12 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
(************************************************************************)
-Require Import Arith_base Compare_dec Sumbool Div2 Min Max.
-Require Import BinPos BinNat Pnat.
+Require Import BinPos BinNat PeanoNat Pnat.
(** * Conversions from [N] to [nat] *)
@@ -68,52 +67,58 @@ Qed.
Lemma inj_sub a a' :
N.to_nat (a - a') = N.to_nat a - N.to_nat a'.
Proof.
- destruct a as [|a], a' as [|a']; simpl; auto with arith.
+ destruct a as [|a], a' as [|a']; simpl; rewrite ?Nat.sub_0_r; trivial.
destruct (Pos.compare_spec a a').
- subst. now rewrite Pos.sub_mask_diag, <- minus_n_n.
- rewrite Pos.sub_mask_neg; trivial. apply Pos2Nat.inj_lt in H.
- simpl; symmetry; apply not_le_minus_0; auto with arith.
- destruct (Pos.sub_mask_pos' _ _ H) as (q & -> & Hq).
- simpl. apply plus_minus. now rewrite <- Hq, Pos2Nat.inj_add.
+ - subst. now rewrite Pos.sub_mask_diag, Nat.sub_diag.
+ - rewrite Pos.sub_mask_neg; trivial. apply Pos2Nat.inj_lt in H.
+ simpl; symmetry; apply Nat.sub_0_le. now apply Nat.lt_le_incl.
+ - destruct (Pos.sub_mask_pos' _ _ H) as (q & -> & Hq).
+ simpl; symmetry; apply Nat.add_sub_eq_l. now rewrite <- Hq, Pos2Nat.inj_add.
Qed.
-Lemma inj_pred a : N.to_nat (N.pred a) = pred (N.to_nat a).
+Lemma inj_pred a : N.to_nat (N.pred a) = Nat.pred (N.to_nat a).
Proof.
- intros. rewrite pred_of_minus, N.pred_sub. apply inj_sub.
+ rewrite <- Nat.sub_1_r, N.pred_sub. apply inj_sub.
Qed.
-Lemma inj_div2 a : N.to_nat (N.div2 a) = div2 (N.to_nat a).
+Lemma inj_div2 a : N.to_nat (N.div2 a) = Nat.div2 (N.to_nat a).
Proof.
destruct a as [|[p|p| ]]; trivial.
- simpl N.to_nat. now rewrite Pos2Nat.inj_xI, div2_double_plus_one.
- simpl N.to_nat. now rewrite Pos2Nat.inj_xO, div2_double.
+ - unfold N.div2, N.to_nat. now rewrite Pos2Nat.inj_xI, Nat.div2_succ_double.
+ - unfold N.div2, N.to_nat. now rewrite Pos2Nat.inj_xO, Nat.div2_double.
Qed.
Lemma inj_compare a a' :
- (a ?= a')%N = nat_compare (N.to_nat a) (N.to_nat a').
+ (a ?= a')%N = (N.to_nat a ?= N.to_nat a').
Proof.
destruct a, a'; simpl; trivial.
- now destruct (Pos2Nat.is_succ p) as (n,->).
- now destruct (Pos2Nat.is_succ p) as (n,->).
- apply Pos2Nat.inj_compare.
+ - now destruct (Pos2Nat.is_succ p) as (n,->).
+ - now destruct (Pos2Nat.is_succ p) as (n,->).
+ - apply Pos2Nat.inj_compare.
Qed.
Lemma inj_max a a' :
- N.to_nat (N.max a a') = max (N.to_nat a) (N.to_nat a').
+ N.to_nat (N.max a a') = Nat.max (N.to_nat a) (N.to_nat a').
Proof.
unfold N.max. rewrite inj_compare; symmetry.
- case nat_compare_spec; intros H; try rewrite H; auto with arith.
+ case Nat.compare_spec; intros.
+ - now apply Nat.max_r, Nat.eq_le_incl.
+ - now apply Nat.max_r, Nat.lt_le_incl.
+ - now apply Nat.max_l, Nat.lt_le_incl.
Qed.
Lemma inj_min a a' :
- N.to_nat (N.min a a') = min (N.to_nat a) (N.to_nat a').
+ N.to_nat (N.min a a') = Nat.min (N.to_nat a) (N.to_nat a').
Proof.
unfold N.min; rewrite inj_compare. symmetry.
- case nat_compare_spec; intros H; try rewrite H; auto with arith.
+ case Nat.compare_spec; intros.
+ - now apply Nat.min_l, Nat.eq_le_incl.
+ - now apply Nat.min_l, Nat.lt_le_incl.
+ - now apply Nat.min_r, Nat.lt_le_incl.
Qed.
Lemma inj_iter a {A} (f:A->A) (x:A) :
- N.iter a f x = nat_iter (N.to_nat a) f x.
+ N.iter a f x = Nat.iter (N.to_nat a) f x.
Proof.
destruct a as [|a]. trivial. apply Pos2Nat.inj_iter.
Qed.
@@ -166,7 +171,7 @@ Proof. nat2N. Qed.
Lemma inj_succ n : N.of_nat (S n) = N.succ (N.of_nat n).
Proof. nat2N. Qed.
-Lemma inj_pred n : N.of_nat (pred n) = N.pred (N.of_nat n).
+Lemma inj_pred n : N.of_nat (Nat.pred n) = N.pred (N.of_nat n).
Proof. nat2N. Qed.
Lemma inj_add n n' : N.of_nat (n+n') = (N.of_nat n + N.of_nat n')%N.
@@ -178,23 +183,23 @@ Proof. nat2N. Qed.
Lemma inj_mul n n' : N.of_nat (n*n') = (N.of_nat n * N.of_nat n')%N.
Proof. nat2N. Qed.
-Lemma inj_div2 n : N.of_nat (div2 n) = N.div2 (N.of_nat n).
+Lemma inj_div2 n : N.of_nat (Nat.div2 n) = N.div2 (N.of_nat n).
Proof. nat2N. Qed.
Lemma inj_compare n n' :
- nat_compare n n' = (N.of_nat n ?= N.of_nat n')%N.
+ (n ?= n') = (N.of_nat n ?= N.of_nat n')%N.
Proof. now rewrite N2Nat.inj_compare, !id. Qed.
Lemma inj_min n n' :
- N.of_nat (min n n') = N.min (N.of_nat n) (N.of_nat n').
+ N.of_nat (Nat.min n n') = N.min (N.of_nat n) (N.of_nat n').
Proof. nat2N. Qed.
Lemma inj_max n n' :
- N.of_nat (max n n') = N.max (N.of_nat n) (N.of_nat n').
+ N.of_nat (Nat.max n n') = N.max (N.of_nat n) (N.of_nat n').
Proof. nat2N. Qed.
Lemma inj_iter n {A} (f:A->A) (x:A) :
- nat_iter n f x = N.iter (N.of_nat n) f x.
+ Nat.iter n f x = N.iter (N.of_nat n) f x.
Proof. now rewrite N2Nat.inj_iter, !id. Qed.
End Nat2N.
diff --git a/theories/NArith/Nsqrt_def.v b/theories/NArith/Nsqrt_def.v
index d43c752d..da7829a9 100644
--- a/theories/NArith/Nsqrt_def.v
+++ b/theories/NArith/Nsqrt_def.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Numbers/BigNumPrelude.v b/theories/Numbers/BigNumPrelude.v
index 71bd4d50..6817947c 100644
--- a/theories/Numbers/BigNumPrelude.v
+++ b/theories/Numbers/BigNumPrelude.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Numbers/BinNums.v b/theories/Numbers/BinNums.v
index b9c37c72..1dd5d82a 100644
--- a/theories/Numbers/BinNums.v
+++ b/theories/Numbers/BinNums.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -9,8 +9,6 @@
(** * Binary Numerical Datatypes *)
Set Implicit Arguments.
-(* For compatibility, we will not use generic equality functions *)
-Local Unset Boolean Equality Schemes.
Declare ML Module "z_syntax_plugin".
diff --git a/theories/Numbers/Cyclic/Abstract/CyclicAxioms.v b/theories/Numbers/Cyclic/Abstract/CyclicAxioms.v
index 622ef225..8b84a484 100644
--- a/theories/Numbers/Cyclic/Abstract/CyclicAxioms.v
+++ b/theories/Numbers/Cyclic/Abstract/CyclicAxioms.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -88,8 +88,12 @@ Module ZnZ.
is_even : t -> bool;
(* square root *)
sqrt2 : t -> t -> t * carry t;
- sqrt : t -> t }.
-
+ sqrt : t -> t;
+ (* bitwise operations *)
+ lor : t -> t -> t;
+ land : t -> t -> t;
+ lxor : t -> t -> t }.
+
Section Specs.
Context {t : Type}{ops : Ops t}.
@@ -98,10 +102,10 @@ Module ZnZ.
Let wB := base digits.
Notation "[+| c |]" :=
- (interp_carry 1 wB to_Z c) (at level 0, x at level 99).
+ (interp_carry 1 wB to_Z c) (at level 0, c at level 99).
Notation "[-| c |]" :=
- (interp_carry (-1) wB to_Z c) (at level 0, x at level 99).
+ (interp_carry (-1) wB to_Z c) (at level 0, c at level 99).
Notation "[|| x ||]" :=
(zn2z_to_Z wB to_Z x) (at level 0, x at level 99).
@@ -199,7 +203,10 @@ Module ZnZ.
[||WW x y||] = [|s|] ^ 2 + [+|r|] /\
[+|r|] <= 2 * [|s|];
spec_sqrt : forall x,
- [|sqrt x|] ^ 2 <= [|x|] < ([|sqrt x|] + 1) ^ 2
+ [|sqrt x|] ^ 2 <= [|x|] < ([|sqrt x|] + 1) ^ 2;
+ spec_lor : forall x y, [|lor x y|] = Z.lor [|x|] [|y|];
+ spec_land : forall x y, [|land x y|] = Z.land [|x|] [|y|];
+ spec_lxor : forall x y, [|lxor x y|] = Z.lxor [|x|] [|y|]
}.
End Specs.
@@ -283,7 +290,7 @@ Module ZnZ.
intros p Hp.
generalize (spec_of_pos p).
case (of_pos p); intros n w1; simpl.
- case n; simpl Npos; auto with zarith.
+ case n; auto with zarith.
intros p1 Hp1; contradict Hp; apply Z.le_ngt.
replace (base digits) with (1 * base digits + 0) by ring.
rewrite Hp1.
diff --git a/theories/Numbers/Cyclic/Abstract/NZCyclic.v b/theories/Numbers/Cyclic/Abstract/NZCyclic.v
index d9089e18..8adeda37 100644
--- a/theories/Numbers/Cyclic/Abstract/NZCyclic.v
+++ b/theories/Numbers/Cyclic/Abstract/NZCyclic.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -106,7 +106,7 @@ Qed.
Theorem one_succ : one == succ zero.
Proof.
-zify; simpl. now rewrite one_mod_wB.
+zify; simpl Z.add. now rewrite one_mod_wB.
Qed.
Theorem two_succ : two == succ one.
@@ -126,9 +126,7 @@ Let B (n : Z) := A (ZnZ.of_Z n).
Lemma B0 : B 0.
Proof.
-unfold B.
-setoid_replace (ZnZ.of_Z 0) with zero. assumption.
-red; zify. apply ZnZ.of_Z_correct. auto using gt_wB_0 with zarith.
+unfold B. apply A0.
Qed.
Lemma BS : forall n : Z, 0 <= n -> n < wB - 1 -> B n -> B (n + 1).
diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleAdd.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleAdd.v
index 1b035948..a7c28862 100644
--- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleAdd.v
+++ b/theories/Numbers/Cyclic/DoubleCyclic/DoubleAdd.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -150,17 +150,17 @@ Section DoubleAdd.
Notation wwB := (base (ww_digits w_digits)).
Notation "[| x |]" := (w_to_Z x) (at level 0, x at level 99).
Notation "[+| c |]" :=
- (interp_carry 1 wB w_to_Z c) (at level 0, x at level 99).
+ (interp_carry 1 wB w_to_Z c) (at level 0, c at level 99).
Notation "[-| c |]" :=
- (interp_carry (-1) wB w_to_Z c) (at level 0, x at level 99).
+ (interp_carry (-1) wB w_to_Z c) (at level 0, c at level 99).
Notation "[[ x ]]" := (ww_to_Z w_digits w_to_Z x)(at level 0, x at level 99).
Notation "[+[ c ]]" :=
(interp_carry 1 wwB (ww_to_Z w_digits w_to_Z) c)
- (at level 0, x at level 99).
+ (at level 0, c at level 99).
Notation "[-[ c ]]" :=
(interp_carry (-1) wwB (ww_to_Z w_digits w_to_Z) c)
- (at level 0, x at level 99).
+ (at level 0, c at level 99).
Variable spec_w_0 : [|w_0|] = 0.
Variable spec_w_1 : [|w_1|] = 1.
@@ -194,9 +194,9 @@ Section DoubleAdd.
Lemma spec_ww_add_c : forall x y, [+[ww_add_c x y]] = [[x]] + [[y]].
Proof.
- destruct x as [ |xh xl];simpl;trivial.
- destruct y as [ |yh yl];simpl. rewrite Z.add_0_r;trivial.
- replace ([|xh|] * wB + [|xl|] + ([|yh|] * wB + [|yl|]))
+ destruct x as [ |xh xl];trivial.
+ destruct y as [ |yh yl]. rewrite Z.add_0_r;trivial.
+ simpl. replace ([|xh|] * wB + [|xl|] + ([|yh|] * wB + [|yl|]))
with (([|xh|]+[|yh|])*wB + ([|xl|]+[|yl|])). 2:ring.
generalize (spec_w_add_c xl yl);destruct (w_add_c xl yl) as [l|l];
intros H;unfold interp_carry in H;rewrite <- H.
@@ -218,10 +218,11 @@ Section DoubleAdd.
Lemma spec_ww_add_c_cont : P x y (ww_add_c_cont x y).
Proof.
- destruct x as [ |xh xl];simpl;trivial.
+ destruct x as [ |xh xl];trivial.
apply spec_f0;trivial.
- destruct y as [ |yh yl];simpl.
- apply spec_f0;simpl;rewrite Z.add_0_r;trivial.
+ destruct y as [ |yh yl].
+ apply spec_f0;rewrite Z.add_0_r;trivial.
+ simpl.
generalize (spec_w_add_c xl yl);destruct (w_add_c xl yl) as [l|l];
intros H;unfold interp_carry in H.
generalize (spec_w_add_c xh yh);destruct (w_add_c xh yh) as [h|h];
@@ -234,10 +235,10 @@ Section DoubleAdd.
as [h|h]; intros H1;unfold interp_carry in *.
apply spec_f0;simpl;rewrite H1. rewrite Z.mul_add_distr_r.
rewrite <- Z.add_assoc;rewrite H;ring.
- apply spec_f1. simpl;rewrite spec_w_WW;rewrite wwB_wBwB.
+ apply spec_f1. rewrite spec_w_WW;rewrite wwB_wBwB.
rewrite Z.add_assoc; rewrite Z.pow_2_r; rewrite <- Z.mul_add_distr_r.
rewrite Z.mul_1_l in H1;rewrite H1. rewrite Z.mul_add_distr_r.
- rewrite <- Z.add_assoc;rewrite H;ring.
+ rewrite <- Z.add_assoc;rewrite H; simpl; ring.
Qed.
End Cont.
@@ -245,11 +246,11 @@ Section DoubleAdd.
Lemma spec_ww_add_carry_c :
forall x y, [+[ww_add_carry_c x y]] = [[x]] + [[y]] + 1.
Proof.
- destruct x as [ |xh xl];intro y;simpl.
+ destruct x as [ |xh xl];intro y.
exact (spec_ww_succ_c y).
- destruct y as [ |yh yl];simpl.
+ destruct y as [ |yh yl].
rewrite Z.add_0_r;exact (spec_ww_succ_c (WW xh xl)).
- replace ([|xh|] * wB + [|xl|] + ([|yh|] * wB + [|yl|]) + 1)
+ simpl; replace ([|xh|] * wB + [|xl|] + ([|yh|] * wB + [|yl|]) + 1)
with (([|xh|]+[|yh|])*wB + ([|xl|]+[|yl|]+1)). 2:ring.
generalize (spec_w_add_carry_c xl yl);destruct (w_add_carry_c xl yl)
as [l|l];intros H;unfold interp_carry in H;rewrite <- H.
@@ -281,7 +282,7 @@ Section DoubleAdd.
Lemma spec_ww_add : forall x y, [[ww_add x y]] = ([[x]] + [[y]]) mod wwB.
Proof.
- destruct x as [ |xh xl];intros y;simpl.
+ destruct x as [ |xh xl];intros y.
rewrite Zmod_small;trivial. apply spec_ww_to_Z;trivial.
destruct y as [ |yh yl].
change [[W0]] with 0;rewrite Z.add_0_r.
@@ -299,7 +300,7 @@ Section DoubleAdd.
Lemma spec_ww_add_carry :
forall x y, [[ww_add_carry x y]] = ([[x]] + [[y]] + 1) mod wwB.
Proof.
- destruct x as [ |xh xl];intros y;simpl.
+ destruct x as [ |xh xl];intros y.
exact (spec_ww_succ y).
destruct y as [ |yh yl].
change [[W0]] with 0;rewrite Z.add_0_r. exact (spec_ww_succ (WW xh xl)).
diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleBase.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleBase.v
index 41a1d8ba..e68cd033 100644
--- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleBase.v
+++ b/theories/Numbers/Cyclic/DoubleCyclic/DoubleBase.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -149,9 +149,9 @@ Section DoubleBase.
Notation "[| x |]" := (w_to_Z x) (at level 0, x at level 99).
Notation "[[ x ]]" := (ww_to_Z x) (at level 0, x at level 99).
Notation "[+[ c ]]" :=
- (interp_carry 1 wwB ww_to_Z c) (at level 0, x at level 99).
+ (interp_carry 1 wwB ww_to_Z c) (at level 0, c at level 99).
Notation "[-[ c ]]" :=
- (interp_carry (-1) wwB ww_to_Z c) (at level 0, x at level 99).
+ (interp_carry (-1) wwB ww_to_Z c) (at level 0, c at level 99).
Notation "[! n | x !]" := (double_to_Z n x) (at level 0, x at level 99).
Variable spec_w_0 : [|w_0|] = 0.
@@ -287,7 +287,7 @@ Section DoubleBase.
Lemma double_wB_wwB : forall n, double_wB n * double_wB n = double_wB (S n).
Proof.
intros n;unfold double_wB;simpl.
- unfold base. rewrite Pshiftl_nat_S, (Pos2Z.inj_xO (_ << _)).
+ unfold base. rewrite (Pos2Z.inj_xO (_ << _)).
replace (2 * Zpos (w_digits << n)) with
(Zpos (w_digits << n) + Zpos (w_digits << n)) by ring.
symmetry; apply Zpower_exp;intro;discriminate.
diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleCyclic.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleCyclic.v
index e207d7eb..e137349e 100644
--- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleCyclic.v
+++ b/theories/Numbers/Cyclic/DoubleCyclic/DoubleCyclic.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -283,6 +283,27 @@ Section Z_2nZ.
Eval lazy beta delta [ww_gcd] in
ww_gcd compare w_0 w_eq0 w_gcd_gt _ww_digits gcd_gt_fix gcd_cont.
+ Definition lor (x y : zn2z t) :=
+ match x, y with
+ | W0, _ => y
+ | _, W0 => x
+ | WW hx lx, WW hy ly => WW (ZnZ.lor hx hy) (ZnZ.lor lx ly)
+ end.
+
+ Definition land (x y : zn2z t) :=
+ match x, y with
+ | W0, _ => W0
+ | _, W0 => W0
+ | WW hx lx, WW hy ly => WW (ZnZ.land hx hy) (ZnZ.land lx ly)
+ end.
+
+ Definition lxor (x y : zn2z t) :=
+ match x, y with
+ | W0, _ => y
+ | _, W0 => x
+ | WW hx lx, WW hy ly => WW (ZnZ.lxor hx hy) (ZnZ.lxor lx ly)
+ end.
+
(* ** Record of operators on 2 words *)
Global Instance mk_zn2z_ops : ZnZ.Ops (zn2z t) | 1 :=
@@ -303,7 +324,10 @@ Section Z_2nZ.
pos_mod
is_even
sqrt2
- sqrt.
+ sqrt
+ lor
+ land
+ lxor.
Global Instance mk_zn2z_ops_karatsuba : ZnZ.Ops (zn2z t) | 2 :=
ZnZ.MkOps _ww_digits _ww_zdigits
@@ -323,10 +347,15 @@ Section Z_2nZ.
pos_mod
is_even
sqrt2
- sqrt.
+ sqrt
+ lor
+ land
+ lxor.
(* Proof *)
Context {specs : ZnZ.Specs ops}.
+
+ Create HintDb ZnZ.
Hint Resolve
ZnZ.spec_to_Z
@@ -370,24 +399,24 @@ Section Z_2nZ.
ZnZ.spec_sqrt
ZnZ.spec_WO
ZnZ.spec_OW
- ZnZ.spec_WW.
-
- Ltac wwauto := unfold ww_to_Z; auto.
+ ZnZ.spec_WW : ZnZ.
+
+ Ltac wwauto := unfold ww_to_Z; eauto with ZnZ.
Let wwB := base _ww_digits.
Notation "[| x |]" := (to_Z x) (at level 0, x at level 99).
Notation "[+| c |]" :=
- (interp_carry 1 wwB to_Z c) (at level 0, x at level 99).
+ (interp_carry 1 wwB to_Z c) (at level 0, c at level 99).
Notation "[-| c |]" :=
- (interp_carry (-1) wwB to_Z c) (at level 0, x at level 99).
+ (interp_carry (-1) wwB to_Z c) (at level 0, c at level 99).
Notation "[[ x ]]" := (zn2z_to_Z wwB to_Z x) (at level 0, x at level 99).
Let spec_ww_to_Z : forall x, 0 <= [| x |] < wwB.
- Proof. refine (spec_ww_to_Z w_digits w_to_Z _);auto. Qed.
+ Proof. refine (spec_ww_to_Z w_digits w_to_Z _); wwauto. Qed.
Let spec_ww_of_pos : forall p,
Zpos p = (Z.of_N (fst (ww_of_pos p)))*wwB + [|(snd (ww_of_pos p))|].
@@ -411,15 +440,15 @@ Section Z_2nZ.
Proof. reflexivity. Qed.
Let spec_ww_1 : [|ww_1|] = 1.
- Proof. refine (spec_ww_1 w_0 w_1 w_digits w_to_Z _ _);auto. Qed.
+ Proof. refine (spec_ww_1 w_0 w_1 w_digits w_to_Z _ _);wwauto. Qed.
Let spec_ww_Bm1 : [|ww_Bm1|] = wwB - 1.
- Proof. refine (spec_ww_Bm1 w_Bm1 w_digits w_to_Z _);auto. Qed.
+ Proof. refine (spec_ww_Bm1 w_Bm1 w_digits w_to_Z _);wwauto. Qed.
Let spec_ww_compare :
forall x y, compare x y = Z.compare [|x|] [|y|].
Proof.
- refine (spec_ww_compare w_0 w_digits w_to_Z w_compare _ _ _);auto.
+ refine (spec_ww_compare w_0 w_digits w_to_Z w_compare _ _ _);wwauto.
Qed.
Let spec_ww_eq0 : forall x, eq0 x = true -> [|x|] = 0.
@@ -428,14 +457,14 @@ Section Z_2nZ.
Let spec_ww_opp_c : forall x, [-|opp_c x|] = -[|x|].
Proof.
refine(spec_ww_opp_c w_0 w_0 W0 w_opp_c w_opp_carry w_digits w_to_Z _ _ _ _);
- auto.
+ wwauto.
Qed.
Let spec_ww_opp : forall x, [|opp x|] = (-[|x|]) mod wwB.
Proof.
refine(spec_ww_opp w_0 w_0 W0 w_opp_c w_opp_carry w_opp
w_digits w_to_Z _ _ _ _ _);
- auto.
+ wwauto.
Qed.
Let spec_ww_opp_carry : forall x, [|opp_carry x|] = wwB - [|x|] - 1.
@@ -446,7 +475,7 @@ Section Z_2nZ.
Let spec_ww_succ_c : forall x, [+|succ_c x|] = [|x|] + 1.
Proof.
- refine (spec_ww_succ_c w_0 w_0 ww_1 w_succ_c w_digits w_to_Z _ _ _ _);auto.
+ refine (spec_ww_succ_c w_0 w_0 ww_1 w_succ_c w_digits w_to_Z _ _ _ _);wwauto.
Qed.
Let spec_ww_add_c : forall x y, [+|add_c x y|] = [|x|] + [|y|].
@@ -468,7 +497,7 @@ Section Z_2nZ.
Let spec_ww_add : forall x y, [|add x y|] = ([|x|] + [|y|]) mod wwB.
Proof.
- refine (spec_ww_add w_add_c w_add w_add_carry w_digits w_to_Z _ _ _ _);auto.
+ refine (spec_ww_add w_add_c w_add w_add_carry w_digits w_to_Z _ _ _ _);wwauto.
Qed.
Let spec_ww_add_carry : forall x y, [|add_carry x y|]=([|x|]+[|y|]+1)mod wwB.
@@ -565,7 +594,7 @@ Section Z_2nZ.
0 <= [|r|] < [|b|].
Proof.
refine (spec_ww_div21 w_0 w_0W div32 ww_1 compare sub w_digits w_to_Z
- _ _ _ _ _ _ _);wwauto.
+ _ _ _ _ _ _ _);wwauto.
Qed.
Let spec_add2: forall x y,
@@ -581,13 +610,14 @@ Section Z_2nZ.
Qed.
Let spec_low: forall x,
- w_to_Z (low x) = [|x|] mod wB.
+ w_to_Z (low x) = [|x|] mod wB.
intros x; case x; simpl low.
- unfold ww_to_Z, w_to_Z, w_0; rewrite ZnZ.spec_0; simpl; auto.
+ unfold ww_to_Z, w_to_Z, w_0; rewrite ZnZ.spec_0; simpl; wwauto.
intros xh xl; simpl.
rewrite Z.add_comm; rewrite Z_mod_plus; auto with zarith.
rewrite Zmod_small; auto with zarith.
- unfold wB, base; auto with zarith.
+ unfold wB, base; eauto with ZnZ zarith.
+ unfold wB, base; eauto with ZnZ zarith.
Qed.
Let spec_ww_digits:
@@ -605,7 +635,7 @@ Section Z_2nZ.
Proof.
refine (spec_ww_head00 w_0 w_0W
w_compare w_head0 w_add2 w_zdigits _ww_zdigits
- w_to_Z _ _ _ (eq_refl _ww_digits) _ _ _ _); auto.
+ w_to_Z _ _ _ (eq_refl _ww_digits) _ _ _ _); wwauto.
exact ZnZ.spec_head00.
exact ZnZ.spec_zdigits.
Qed.
@@ -688,7 +718,7 @@ refine
[|a|] = [|q|] * [|b|] + [|r|] /\
0 <= [|r|] < [|b|].
Proof.
- refine (spec_ww_div w_digits ww_1 compare div_gt w_to_Z _ _ _ _);auto.
+ refine (spec_ww_div w_digits ww_1 compare div_gt w_to_Z _ _ _ _);wwauto.
Qed.
Let spec_ww_mod_gt : forall a b,
@@ -708,7 +738,7 @@ refine
Let spec_ww_mod : forall a b, 0 < [|b|] -> [|mod_ a b|] = [|a|] mod [|b|].
Proof.
- refine (spec_ww_mod w_digits W0 compare mod_gt w_to_Z _ _ _);auto.
+ refine (spec_ww_mod w_digits W0 compare mod_gt w_to_Z _ _ _);wwauto.
Qed.
Let spec_ww_gcd_gt : forall a b, [|a|] > [|b|] ->
@@ -716,7 +746,7 @@ refine
Proof.
refine (@spec_ww_gcd_gt t w_digits W0 w_to_Z _
w_0 w_0 w_eq0 w_gcd_gt _ww_digits
- _ gcd_gt_fix _ _ _ _ gcd_cont _);auto.
+ _ gcd_gt_fix _ _ _ _ gcd_cont _);wwauto.
refine (@spec_ww_gcd_gt_aux t w_digits w_0 w_WW w_0W w_compare w_opp_c w_opp
w_opp_carry w_sub_c w_sub w_sub_carry w_gcd_gt w_add_mul_div w_head0
w_div21 div32 _ww_zdigits ww_1 add_mul_div w_zdigits w_to_Z
@@ -725,13 +755,13 @@ refine
exact ZnZ.spec_zdigits.
exact spec_ww_add_mul_div.
refine (@spec_gcd_cont t w_digits ww_1 w_to_Z _ _ w_0 w_1 w_compare
- _ _);auto.
+ _ _);wwauto.
Qed.
Let spec_ww_gcd : forall a b, Zis_gcd [|a|] [|b|] [|gcd a b|].
Proof.
refine (@spec_ww_gcd t w_digits W0 compare w_to_Z _ _ w_0 w_0 w_eq0 w_gcd_gt
- _ww_digits _ gcd_gt_fix _ _ _ _ gcd_cont _);auto.
+ _ww_digits _ gcd_gt_fix _ _ _ _ gcd_cont _);wwauto.
refine (@spec_ww_gcd_gt_aux t w_digits w_0 w_WW w_0W w_compare w_opp_c w_opp
w_opp_carry w_sub_c w_sub w_sub_carry w_gcd_gt w_add_mul_div w_head0
w_div21 div32 _ww_zdigits ww_1 add_mul_div w_zdigits w_to_Z
@@ -740,7 +770,7 @@ refine
exact ZnZ.spec_zdigits.
exact spec_ww_add_mul_div.
refine (@spec_gcd_cont t w_digits ww_1 w_to_Z _ _ w_0 w_1 w_compare
- _ _);auto.
+ _ _);wwauto.
Qed.
Let spec_ww_is_even : forall x,
@@ -779,7 +809,7 @@ refine
refine (@spec_ww_sqrt t w_is_even w_0 w_1 w_Bm1
w_sub w_add_mul_div w_digits w_zdigits _ww_zdigits
w_sqrt2 pred add_mul_div head0 compare
- _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _); wwauto.
+ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _); wwauto.
exact ZnZ.spec_zdigits.
exact ZnZ.spec_more_than_1_digit.
exact ZnZ.spec_is_even.
@@ -787,6 +817,83 @@ refine
exact ZnZ.spec_sqrt2.
Qed.
+ Let wB_pos : 0 < wB.
+ Proof.
+ unfold wB, base; apply Z.pow_pos_nonneg; auto with zarith.
+ Qed.
+
+ Hint Transparent ww_to_Z.
+
+ Let ww_testbit_high n x y : Z.pos w_digits <= n ->
+ Z.testbit [|WW x y|] n =
+ Z.testbit (ZnZ.to_Z x) (n - Z.pos w_digits).
+ Proof.
+ intros Hn.
+ assert (E : ZnZ.to_Z x = [|WW x y|] / wB).
+ { simpl.
+ rewrite Z.div_add_l; eauto with ZnZ zarith.
+ now rewrite Z.div_small, Z.add_0_r; wwauto. }
+ rewrite E.
+ unfold wB, base. rewrite Z.div_pow2_bits.
+ - f_equal; auto with zarith.
+ - easy.
+ - auto with zarith.
+ Qed.
+
+ Let ww_testbit_low n x y : 0 <= n < Z.pos w_digits ->
+ Z.testbit [|WW x y|] n = Z.testbit (ZnZ.to_Z y) n.
+ Proof.
+ intros (Hn,Hn').
+ assert (E : ZnZ.to_Z y = [|WW x y|] mod wB).
+ { simpl; symmetry.
+ rewrite Z.add_comm, Z.mod_add; auto with zarith nocore.
+ apply Z.mod_small; eauto with ZnZ zarith. }
+ rewrite E.
+ unfold wB, base. symmetry. apply Z.mod_pow2_bits_low; auto.
+ Qed.
+
+ Let spec_lor x y : [|lor x y|] = Z.lor [|x|] [|y|].
+ Proof.
+ destruct x as [ |hx lx]. trivial.
+ destruct y as [ |hy ly]. now rewrite Z.lor_comm.
+ change ([|WW (ZnZ.lor hx hy) (ZnZ.lor lx ly)|] =
+ Z.lor [|WW hx lx|] [|WW hy ly|]).
+ apply Z.bits_inj'; intros n Hn.
+ rewrite Z.lor_spec.
+ destruct (Z.le_gt_cases (Z.pos w_digits) n) as [LE|GT].
+ - now rewrite !ww_testbit_high, ZnZ.spec_lor, Z.lor_spec.
+ - rewrite !ww_testbit_low; auto.
+ now rewrite ZnZ.spec_lor, Z.lor_spec.
+ Qed.
+
+ Let spec_land x y : [|land x y|] = Z.land [|x|] [|y|].
+ Proof.
+ destruct x as [ |hx lx]. trivial.
+ destruct y as [ |hy ly]. now rewrite Z.land_comm.
+ change ([|WW (ZnZ.land hx hy) (ZnZ.land lx ly)|] =
+ Z.land [|WW hx lx|] [|WW hy ly|]).
+ apply Z.bits_inj'; intros n Hn.
+ rewrite Z.land_spec.
+ destruct (Z.le_gt_cases (Z.pos w_digits) n) as [LE|GT].
+ - now rewrite !ww_testbit_high, ZnZ.spec_land, Z.land_spec.
+ - rewrite !ww_testbit_low; auto.
+ now rewrite ZnZ.spec_land, Z.land_spec.
+ Qed.
+
+ Let spec_lxor x y : [|lxor x y|] = Z.lxor [|x|] [|y|].
+ Proof.
+ destruct x as [ |hx lx]. trivial.
+ destruct y as [ |hy ly]. now rewrite Z.lxor_comm.
+ change ([|WW (ZnZ.lxor hx hy) (ZnZ.lxor lx ly)|] =
+ Z.lxor [|WW hx lx|] [|WW hy ly|]).
+ apply Z.bits_inj'; intros n Hn.
+ rewrite Z.lxor_spec.
+ destruct (Z.le_gt_cases (Z.pos w_digits) n) as [LE|GT].
+ - now rewrite !ww_testbit_high, ZnZ.spec_lxor, Z.lxor_spec.
+ - rewrite !ww_testbit_low; auto.
+ now rewrite ZnZ.spec_lxor, Z.lxor_spec.
+ Qed.
+
Global Instance mk_zn2z_specs : ZnZ.Specs mk_zn2z_ops.
Proof.
apply ZnZ.MkSpecs; auto.
@@ -816,6 +923,7 @@ refine
End Z_2nZ.
+
Section MulAdd.
Context {t : Type}{ops : ZnZ.Ops t}{specs : ZnZ.Specs ops}.
diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleDiv.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleDiv.v
index 08f05bbf..cd55f9d8 100644
--- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleDiv.v
+++ b/theories/Numbers/Cyclic/DoubleCyclic/DoubleDiv.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -97,8 +97,7 @@ Section POS_MOD.
assert (HHHHH:= lt_0_wB w_digits).
assert (F0: forall x y, x - y + y = x); auto with zarith.
intros w1 p; case (spec_to_w_Z p); intros HH1 HH2.
- unfold ww_pos_mod; case w1.
- simpl; rewrite Zmod_small; split; auto with zarith.
+ unfold ww_pos_mod; case w1. reflexivity.
intros xh xl; rewrite spec_ww_compare.
case Z.compare_spec;
rewrite spec_w_0W; rewrite spec_zdigits; fold wB;
@@ -211,8 +210,7 @@ Section DoubleDiv32.
Variable w_div21 : w -> w -> w -> w*w.
Variable ww_sub_c : zn2z w -> zn2z w -> carry (zn2z w).
- Definition w_div32 a1 a2 a3 b1 b2 :=
- Eval lazy beta iota delta [ww_add_c_cont ww_add] in
+ Definition w_div32_body a1 a2 a3 b1 b2 :=
match w_compare a1 b1 with
| Lt =>
let (q,r) := w_div21 a1 a2 b1 in
@@ -233,6 +231,10 @@ Section DoubleDiv32.
| Gt => (w_0, W0) (* cas absurde *)
end.
+ Definition w_div32 a1 a2 a3 b1 b2 :=
+ Eval lazy beta iota delta [ww_add_c_cont ww_add w_div32_body] in
+ w_div32_body a1 a2 a3 b1 b2.
+
(* Proof *)
Variable w_digits : positive.
@@ -242,14 +244,14 @@ Section DoubleDiv32.
Notation wwB := (base (ww_digits w_digits)).
Notation "[| x |]" := (w_to_Z x) (at level 0, x at level 99).
Notation "[+| c |]" :=
- (interp_carry 1 wB w_to_Z c) (at level 0, x at level 99).
+ (interp_carry 1 wB w_to_Z c) (at level 0, c at level 99).
Notation "[-| c |]" :=
- (interp_carry (-1) wB w_to_Z c) (at level 0, x at level 99).
+ (interp_carry (-1) wB w_to_Z c) (at level 0, c at level 99).
Notation "[[ x ]]" := (ww_to_Z w_digits w_to_Z x)(at level 0, x at level 99).
Notation "[-[ c ]]" :=
(interp_carry (-1) wwB (ww_to_Z w_digits w_to_Z) c)
- (at level 0, x at level 99).
+ (at level 0, c at level 99).
Variable spec_w_0 : [|w_0|] = 0.
@@ -312,26 +314,8 @@ Section DoubleDiv32.
assert (U:= lt_0_wB w_digits); assert (U1:= lt_0_wwB w_digits).
Spec_w_to_Z a1;Spec_w_to_Z a2;Spec_w_to_Z a3;Spec_w_to_Z b1;Spec_w_to_Z b2.
rewrite wwB_wBwB; rewrite Z.pow_2_r; rewrite Z.mul_assoc;rewrite <- Z.mul_add_distr_r.
- change (w_div32 a1 a2 a3 b1 b2) with
- match w_compare a1 b1 with
- | Lt =>
- let (q,r) := w_div21 a1 a2 b1 in
- match ww_sub_c (w_WW r a3) (w_mul_c q b2) with
- | C0 r1 => (q,r1)
- | C1 r1 =>
- let q := w_pred q in
- ww_add_c_cont w_WW w_add_c w_add_carry_c
- (fun r2=>(w_pred q, ww_add w_add_c w_add w_add_carry r2 (WW b1 b2)))
- (fun r2 => (q,r2))
- r1 (WW b1 b2)
- end
- | Eq =>
- ww_add_c_cont w_WW w_add_c w_add_carry_c
- (fun r => (w_Bm2, ww_add w_add_c w_add w_add_carry r (WW b1 b2)))
- (fun r => (w_Bm1,r))
- (WW (w_sub a2 b2) a3) (WW b1 b2)
- | Gt => (w_0, W0) (* cas absurde *)
- end.
+ change (w_div32 a1 a2 a3 b1 b2) with (w_div32_body a1 a2 a3 b1 b2).
+ unfold w_div32_body.
rewrite spec_compare. case Z.compare_spec; intro Hcmp.
simpl in Hlt.
rewrite Hcmp in Hlt;assert ([|a2|] < [|b2|]). omega.
@@ -520,7 +504,7 @@ Section DoubleDiv21.
Notation "[[ x ]]" := (ww_to_Z w_digits w_to_Z x)(at level 0, x at level 99).
Notation "[-[ c ]]" :=
(interp_carry (-1) wwB (ww_to_Z w_digits w_to_Z) c)
- (at level 0, x at level 99).
+ (at level 0, c at level 99).
Variable spec_w_0 : [|w_0|] = 0.
Variable spec_to_Z : forall x, 0 <= [|x|] < wB.
@@ -782,7 +766,7 @@ Section DoubleDivGt.
Notation wwB := (base (ww_digits w_digits)).
Notation "[| x |]" := (w_to_Z x) (at level 0, x at level 99).
Notation "[-| c |]" :=
- (interp_carry (-1) wB w_to_Z c) (at level 0, x at level 99).
+ (interp_carry (-1) wB w_to_Z c) (at level 0, c at level 99).
Notation "[[ x ]]" := (ww_to_Z w_digits w_to_Z x)(at level 0, x at level 99).
diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleDivn1.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleDivn1.v
index 8e179ef6..6a1d741e 100644
--- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleDivn1.v
+++ b/theories/Numbers/Cyclic/DoubleCyclic/DoubleDivn1.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -160,7 +160,7 @@ Section GENDIVN1.
Lemma p_lt_double_digits : forall n, [|p|] <= Zpos (w_digits << n).
Proof.
induction n;simpl. trivial.
- case (spec_to_Z p); rewrite Pshiftl_nat_S, Pos2Z.inj_xO;auto with zarith.
+ case (spec_to_Z p); rewrite Pos2Z.inj_xO;auto with zarith.
Qed.
Lemma spec_double_divn1_p : forall n r h l,
@@ -305,7 +305,6 @@ Section GENDIVN1.
Lemma spec_double_digits:forall n, Zpos w_digits <= Zpos (w_digits << n).
Proof.
induction n;simpl;auto with zarith.
- rewrite Pshiftl_nat_S.
change (Zpos (xO (w_digits << n))) with
(2*Zpos (w_digits << n)).
assert (0 < Zpos w_digits) by reflexivity.
diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleLift.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleLift.v
index 2d0cc0fb..ff9f50a5 100644
--- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleLift.v
+++ b/theories/Numbers/Cyclic/DoubleCyclic/DoubleLift.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleMul.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleMul.v
index 1c0fc68a..537f557d 100644
--- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleMul.v
+++ b/theories/Numbers/Cyclic/DoubleCyclic/DoubleMul.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -218,17 +218,17 @@ Section DoubleMul.
Notation wwB := (base (ww_digits w_digits)).
Notation "[| x |]" := (w_to_Z x) (at level 0, x at level 99).
Notation "[+| c |]" :=
- (interp_carry 1 wB w_to_Z c) (at level 0, x at level 99).
+ (interp_carry 1 wB w_to_Z c) (at level 0, c at level 99).
Notation "[-| c |]" :=
- (interp_carry (-1) wB w_to_Z c) (at level 0, x at level 99).
+ (interp_carry (-1) wB w_to_Z c) (at level 0, c at level 99).
Notation "[[ x ]]" := (ww_to_Z w_digits w_to_Z x)(at level 0, x at level 99).
Notation "[+[ c ]]" :=
(interp_carry 1 wwB (ww_to_Z w_digits w_to_Z) c)
- (at level 0, x at level 99).
+ (at level 0, c at level 99).
Notation "[-[ c ]]" :=
(interp_carry (-1) wwB (ww_to_Z w_digits w_to_Z) c)
- (at level 0, x at level 99).
+ (at level 0, c at level 99).
Notation "[|| x ||]" :=
(zn2z_to_Z wwB (ww_to_Z w_digits w_to_Z) x) (at level 0, x at level 99).
@@ -328,7 +328,7 @@ Section DoubleMul.
rewrite <- (Z.add_0_r ([|wc|]*wB));rewrite H;apply mult_add_ineq3;zarith.
simpl ww_to_Z in H1. assert (U:=spec_to_Z cch).
assert ([|wc|]*wB + [|cch|] <= 2*wB - 3).
- destruct (Z_le_gt_dec ([|wc|]*wB + [|cch|]) (2*wB - 3));trivial.
+ destruct (Z_le_gt_dec ([|wc|]*wB + [|cch|]) (2*wB - 3)) as [Hle|Hgt];trivial.
assert ([|xh|] * [|yl|] + [|xl|] * [|yh|] <= (2*wB - 4)*wB + 2).
ring_simplify ((2*wB - 4)*wB + 2).
assert (H4 := Zmult_lt_b _ _ _ (spec_to_Z xh) (spec_to_Z yl)).
diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleSqrt.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleSqrt.v
index 149682f8..ab8c8617 100644
--- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleSqrt.v
+++ b/theories/Numbers/Cyclic/DoubleCyclic/DoubleSqrt.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -185,17 +185,17 @@ Section DoubleSqrt.
Notation wwB := (base (ww_digits w_digits)).
Notation "[| x |]" := (w_to_Z x) (at level 0, x at level 99).
Notation "[+| c |]" :=
- (interp_carry 1 wB w_to_Z c) (at level 0, x at level 99).
+ (interp_carry 1 wB w_to_Z c) (at level 0, c at level 99).
Notation "[-| c |]" :=
- (interp_carry (-1) wB w_to_Z c) (at level 0, x at level 99).
+ (interp_carry (-1) wB w_to_Z c) (at level 0, c at level 99).
Notation "[[ x ]]" := (ww_to_Z w_digits w_to_Z x)(at level 0, x at level 99).
Notation "[+[ c ]]" :=
(interp_carry 1 wwB (ww_to_Z w_digits w_to_Z) c)
- (at level 0, x at level 99).
+ (at level 0, c at level 99).
Notation "[-[ c ]]" :=
(interp_carry (-1) wwB (ww_to_Z w_digits w_to_Z) c)
- (at level 0, x at level 99).
+ (at level 0, c at level 99).
Notation "[|| x ||]" :=
(zn2z_to_Z wwB (ww_to_Z w_digits w_to_Z) x) (at level 0, x at level 99).
@@ -266,8 +266,8 @@ Section DoubleSqrt.
if ww_is_even x then [[x]] mod 2 = 0 else [[x]] mod 2 = 1.
clear spec_more_than_1_digit.
intros x; case x; simpl ww_is_even.
+ reflexivity.
simpl.
- rewrite Zmod_small; auto with zarith.
intros w1 w2; simpl.
unfold base.
rewrite Zplus_mod; auto with zarith.
@@ -692,7 +692,7 @@ intros x; case x; simpl ww_is_even.
intros x y H; unfold ww_sqrt2.
repeat match goal with |- context[split ?x] =>
generalize (spec_split x); case (split x)
- end; simpl fst; simpl snd.
+ end; simpl @fst; simpl @snd.
intros w0 w1 Hw0 w2 w3 Hw1.
assert (U: wB/4 <= [|w2|]).
case (Z.le_gt_cases (wB / 4) [|w2|]); auto; intros H1.
@@ -761,7 +761,7 @@ intros x; case x; simpl ww_is_even.
auto.
split.
unfold zn2z_to_Z; rewrite <- Hw1.
- unfold ww_to_Z, zn2z_to_Z in H1; rewrite H1.
+ unfold ww_to_Z, zn2z_to_Z in H1. rewrite H1.
rewrite <- Hw0.
match goal with |- (?X ^2 + ?Y) * wwB + (?Z * wB + ?T) = ?U =>
transitivity ((X * wB) ^ 2 + (Y * wB + Z) * wB + T)
@@ -1193,7 +1193,7 @@ Qed.
rewrite <- wwB_4_wB_4; auto.
generalize (@spec_w_sqrt2 w0 w1 V);auto with zarith.
case (w_sqrt2 w0 w1); intros w2 c.
- simpl ww_to_Z; simpl fst.
+ simpl ww_to_Z; simpl @fst.
case c; unfold interp_carry; autorewrite with rm10.
intros w3 (H6, H7); rewrite H6.
assert (V1 := spec_to_Z w3);auto with zarith.
@@ -1256,7 +1256,7 @@ Qed.
generalize (@spec_w_sqrt2 w0 w1 V);auto with zarith.
case (w_sqrt2 w0 w1); intros w2 c.
case (spec_to_Z w2); intros HH1 HH2.
- simpl ww_to_Z; simpl fst.
+ simpl ww_to_Z; simpl @fst.
assert (Hv3: [[ww_pred ww_zdigits]]
= Zpos (xO w_digits) - 1).
rewrite spec_ww_pred; rewrite spec_ww_zdigits.
diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleSub.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleSub.v
index aaa93a21..a2df2600 100644
--- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleSub.v
+++ b/theories/Numbers/Cyclic/DoubleCyclic/DoubleSub.v
@@ -1,6 +1,7 @@
+
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <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 *)
@@ -159,17 +160,17 @@ Section DoubleSub.
Notation wwB := (base (ww_digits w_digits)).
Notation "[| x |]" := (w_to_Z x) (at level 0, x at level 99).
Notation "[+| c |]" :=
- (interp_carry 1 wB w_to_Z c) (at level 0, x at level 99).
+ (interp_carry 1 wB w_to_Z c) (at level 0, c at level 99).
Notation "[-| c |]" :=
- (interp_carry (-1) wB w_to_Z c) (at level 0, x at level 99).
+ (interp_carry (-1) wB w_to_Z c) (at level 0, c at level 99).
Notation "[[ x ]]" := (ww_to_Z w_digits w_to_Z x)(at level 0, x at level 99).
Notation "[+[ c ]]" :=
(interp_carry 1 wwB (ww_to_Z w_digits w_to_Z) c)
- (at level 0, x at level 99).
+ (at level 0, c at level 99).
Notation "[-[ c ]]" :=
(interp_carry (-1) wwB (ww_to_Z w_digits w_to_Z) c)
- (at level 0, x at level 99).
+ (at level 0, c at level 99).
Variable spec_w_0 : [|w_0|] = 0.
Variable spec_w_Bm1 : [|w_Bm1|] = wB - 1.
diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleType.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleType.v
index 1ab75307..c1f314e9 100644
--- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleType.v
+++ b/theories/Numbers/Cyclic/DoubleCyclic/DoubleType.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -14,6 +14,7 @@ Require Import ZArith.
Local Open Scope Z_scope.
Definition base digits := Z.pow 2 (Zpos digits).
+Arguments base digits: simpl never.
Section Carry.
@@ -53,7 +54,7 @@ Section Zn2Z.
End Zn2Z.
-Arguments W0 [znz].
+Arguments W0 {znz}.
(** From a cyclic representation [w], we iterate the [zn2z] construct
[n] times, gaining the type of binary trees of depth at most [n],
diff --git a/theories/Numbers/Cyclic/Int31/Cyclic31.v b/theories/Numbers/Cyclic/Int31/Cyclic31.v
index cef3ecae..aca57216 100644
--- a/theories/Numbers/Cyclic/Int31/Cyclic31.v
+++ b/theories/Numbers/Cyclic/Int31/Cyclic31.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -75,88 +75,87 @@ Section Basics.
(** * Iterated shift to the right *)
- Definition nshiftr n x := iter_nat n _ shiftr x.
+ Definition nshiftr x := nat_rect _ x (fun _ => shiftr).
Lemma nshiftr_S :
- forall n x, nshiftr (S n) x = shiftr (nshiftr n x).
+ forall n x, nshiftr x (S n) = shiftr (nshiftr x n).
Proof.
reflexivity.
Qed.
Lemma nshiftr_S_tail :
- forall n x, nshiftr (S n) x = nshiftr n (shiftr x).
+ forall n x, nshiftr x (S n) = nshiftr (shiftr x) n.
Proof.
- induction n; simpl; auto.
- intros; rewrite nshiftr_S, IHn, nshiftr_S; auto.
+ intros n; elim n; simpl; auto.
+ intros; now f_equal.
Qed.
- Lemma nshiftr_n_0 : forall n, nshiftr n 0 = 0.
+ Lemma nshiftr_n_0 : forall n, nshiftr 0 n = 0.
Proof.
induction n; simpl; auto.
- rewrite nshiftr_S, IHn; auto.
+ rewrite IHn; auto.
Qed.
- Lemma nshiftr_size : forall x, nshiftr size x = 0.
+ Lemma nshiftr_size : forall x, nshiftr x size = 0.
Proof.
destruct x; simpl; auto.
Qed.
Lemma nshiftr_above_size : forall k x, size<=k ->
- nshiftr k x = 0.
+ nshiftr x k = 0.
Proof.
intros.
replace k with ((k-size)+size)%nat by omega.
induction (k-size)%nat; auto.
rewrite nshiftr_size; auto.
- simpl; rewrite nshiftr_S, IHn; auto.
+ simpl; rewrite IHn; auto.
Qed.
(** * Iterated shift to the left *)
- Definition nshiftl n x := iter_nat n _ shiftl x.
+ Definition nshiftl x := nat_rect _ x (fun _ => shiftl).
Lemma nshiftl_S :
- forall n x, nshiftl (S n) x = shiftl (nshiftl n x).
+ forall n x, nshiftl x (S n) = shiftl (nshiftl x n).
Proof.
reflexivity.
Qed.
Lemma nshiftl_S_tail :
- forall n x, nshiftl (S n) x = nshiftl n (shiftl x).
- Proof.
- induction n; simpl; auto.
- intros; rewrite nshiftl_S, IHn, nshiftl_S; auto.
+ forall n x, nshiftl x (S n) = nshiftl (shiftl x) n.
+ Proof.
+ intros n; elim n; simpl; intros; now f_equal.
Qed.
- Lemma nshiftl_n_0 : forall n, nshiftl n 0 = 0.
+ Lemma nshiftl_n_0 : forall n, nshiftl 0 n = 0.
Proof.
induction n; simpl; auto.
- rewrite nshiftl_S, IHn; auto.
+ rewrite IHn; auto.
Qed.
- Lemma nshiftl_size : forall x, nshiftl size x = 0.
+ Lemma nshiftl_size : forall x, nshiftl x size = 0.
Proof.
destruct x; simpl; auto.
Qed.
Lemma nshiftl_above_size : forall k x, size<=k ->
- nshiftl k x = 0.
+ nshiftl x k = 0.
Proof.
intros.
replace k with ((k-size)+size)%nat by omega.
induction (k-size)%nat; auto.
rewrite nshiftl_size; auto.
- simpl; rewrite nshiftl_S, IHn; auto.
+ simpl; rewrite IHn; auto.
Qed.
Lemma firstr_firstl :
- forall x, firstr x = firstl (nshiftl (pred size) x).
+ forall x, firstr x = firstl (nshiftl x (pred size)).
Proof.
destruct x; simpl; auto.
Qed.
Lemma firstl_firstr :
- forall x, firstl x = firstr (nshiftr (pred size) x).
+ forall x, firstl x = firstr (nshiftr x (pred size)).
Proof.
destruct x; simpl; auto.
Qed.
@@ -164,23 +163,23 @@ Section Basics.
(** More advanced results about [nshiftr] *)
Lemma nshiftr_predsize_0_firstl : forall x,
- nshiftr (pred size) x = 0 -> firstl x = D0.
+ nshiftr x (pred size) = 0 -> firstl x = D0.
Proof.
destruct x; compute; intros H; injection H; intros; subst; auto.
Qed.
Lemma nshiftr_0_propagates : forall n p x, n <= p ->
- nshiftr n x = 0 -> nshiftr p x = 0.
+ nshiftr x n = 0 -> nshiftr x p = 0.
Proof.
intros.
replace p with ((p-n)+n)%nat by omega.
induction (p-n)%nat.
simpl; auto.
- simpl; rewrite nshiftr_S; rewrite IHn0; auto.
+ simpl; rewrite IHn0; auto.
Qed.
Lemma nshiftr_0_firstl : forall n x, n < size ->
- nshiftr n x = 0 -> firstl x = D0.
+ nshiftr x n = 0 -> firstl x = D0.
Proof.
intros.
apply nshiftr_predsize_0_firstl.
@@ -197,15 +196,15 @@ Section Basics.
forall x, P x.
Proof.
intros.
- assert (forall n, n<=size -> P (nshiftr (size - n) x)).
+ assert (forall n, n<=size -> P (nshiftr x (size - n))).
induction n; intros.
rewrite nshiftr_size; auto.
rewrite sneakl_shiftr.
apply H0.
- change (P (nshiftr (S (size - S n)) x)).
+ change (P (nshiftr x (S (size - S n)))).
replace (S (size - S n))%nat with (size - n)%nat by omega.
apply IHn; omega.
- change x with (nshiftr (size-size) x); auto.
+ change x with (nshiftr x (size-size)); auto.
Qed.
Lemma int31_ind_twice : forall P : int31->Prop,
@@ -236,19 +235,19 @@ Section Basics.
Lemma recr_aux_converges :
forall n p x, n <= size -> n <= p ->
- recr_aux n A case0 caserec (nshiftr (size - n) x) =
- recr_aux p A case0 caserec (nshiftr (size - n) x).
+ recr_aux n A case0 caserec (nshiftr x (size - n)) =
+ recr_aux p A case0 caserec (nshiftr x (size - n)).
Proof.
induction n.
- simpl; intros.
+ simpl minus; intros.
rewrite nshiftr_size; destruct p; simpl; auto.
intros.
destruct p.
inversion H0.
unfold recr_aux; fold recr_aux.
- destruct (iszero (nshiftr (size - S n) x)); auto.
+ destruct (iszero (nshiftr x (size - S n))); auto.
f_equal.
- change (shiftr (nshiftr (size - S n) x)) with (nshiftr (S (size - S n)) x).
+ change (shiftr (nshiftr x (size - S n))) with (nshiftr x (S (size - S n))).
replace (S (size - S n))%nat with (size - n)%nat by omega.
apply IHn; auto with arith.
Qed.
@@ -259,7 +258,7 @@ Section Basics.
Proof.
intros.
unfold recr.
- change x with (nshiftr (size - size) x).
+ change x with (nshiftr x (size - size)).
rewrite (recr_aux_converges size (S size)); auto with arith.
rewrite recr_aux_eqn; auto.
Qed.
@@ -436,22 +435,22 @@ Section Basics.
Lemma phibis_aux_bounded :
forall n x, n <= size ->
- (phibis_aux n (nshiftr (size-n) x) < 2 ^ (Z.of_nat n))%Z.
+ (phibis_aux n (nshiftr x (size-n)) < 2 ^ (Z.of_nat n))%Z.
Proof.
induction n.
- simpl; unfold phibis_aux; simpl; auto with zarith.
+ simpl minus; unfold phibis_aux; simpl; auto with zarith.
intros.
unfold phibis_aux, recrbis_aux; fold recrbis_aux;
- fold (phibis_aux n (shiftr (nshiftr (size - S n) x))).
- assert (shiftr (nshiftr (size - S n) x) = nshiftr (size-n) x).
+ fold (phibis_aux n (shiftr (nshiftr x (size - S n)))).
+ assert (shiftr (nshiftr x (size - S n)) = nshiftr x (size-n)).
replace (size - n)%nat with (S (size - (S n))) by omega.
simpl; auto.
rewrite H0.
assert (H1 : n <= size) by omega.
specialize (IHn x H1).
- set (y:=phibis_aux n (nshiftr (size - n) x)) in *.
+ set (y:=phibis_aux n (nshiftr x (size - n))) in *.
rewrite Nat2Z.inj_succ, Z.pow_succ_r; auto with zarith.
- case_eq (firstr (nshiftr (size - S n) x)); intros.
+ case_eq (firstr (nshiftr x (size - S n))); intros.
rewrite Z.double_spec; auto with zarith.
rewrite Z.succ_double_spec; auto with zarith.
Qed.
@@ -462,12 +461,12 @@ Section Basics.
rewrite <- phibis_aux_equiv.
split.
apply phibis_aux_pos.
- change x with (nshiftr (size-size) x).
+ change x with (nshiftr x (size-size)).
apply phibis_aux_bounded; auto.
Qed.
Lemma phibis_aux_lowerbound :
- forall n x, firstr (nshiftr n x) = D1 ->
+ forall n x, firstr (nshiftr x n) = D1 ->
(2 ^ Z.of_nat n <= phibis_aux (S n) x)%Z.
Proof.
induction n.
@@ -509,7 +508,7 @@ Section Basics.
(** After killing [n] bits at the left, are the numbers equal ?*)
Definition EqShiftL n x y :=
- nshiftl n x = nshiftl n y.
+ nshiftl x n = nshiftl y n.
Lemma EqShiftL_zero : forall x y, EqShiftL O x y <-> x = y.
Proof.
@@ -529,7 +528,7 @@ Section Basics.
remember (k'-k)%nat as n.
clear Heqn H k'.
induction n; simpl; auto.
- rewrite 2 nshiftl_S; f_equal; auto.
+ f_equal; auto.
Qed.
Lemma EqShiftL_firstr : forall k x y, k < size ->
@@ -601,7 +600,7 @@ Section Basics.
end.
Lemma i2l_nshiftl : forall n x, n<=size ->
- i2l (nshiftl n x) = cstlist _ D0 n ++ firstn (size-n) (i2l x).
+ i2l (nshiftl x n) = cstlist _ D0 n ++ firstn (size-n) (i2l x).
Proof.
induction n.
intros.
@@ -618,13 +617,13 @@ Section Basics.
rewrite <- app_comm_cons; f_equal.
rewrite IHn; [ | omega].
rewrite removelast_app.
- f_equal.
+ apply f_equal.
replace (size-n)%nat with (S (size - S n))%nat by omega.
rewrite removelast_firstn; auto.
rewrite i2l_length; omega.
generalize (firstn_length (size-n) (i2l x)).
rewrite i2l_length.
- intros H0 H1; rewrite H1 in H0.
+ intros H0 H1. rewrite H1 in H0.
rewrite min_l in H0 by omega.
simpl length in H0.
omega.
@@ -636,7 +635,7 @@ Section Basics.
EqShiftL k x y <-> firstn (size-k) (i2l x) = firstn (size-k) (i2l y).
Proof.
intros.
- destruct (le_lt_dec size k).
+ destruct (le_lt_dec size k) as [Hle|Hlt].
split; intros.
replace (size-k)%nat with O by omega.
unfold firstn; auto.
@@ -645,24 +644,24 @@ Section Basics.
unfold EqShiftL.
assert (k <= size) by omega.
split; intros.
- assert (i2l (nshiftl k x) = i2l (nshiftl k y)) by (f_equal; auto).
+ assert (i2l (nshiftl x k) = i2l (nshiftl y k)) by (f_equal; auto).
rewrite 2 i2l_nshiftl in H1; auto.
eapply app_inv_head; eauto.
- assert (i2l (nshiftl k x) = i2l (nshiftl k y)).
+ assert (i2l (nshiftl x k) = i2l (nshiftl y k)).
rewrite 2 i2l_nshiftl; auto.
f_equal; auto.
- rewrite <- (l2i_i2l (nshiftl k x)), <- (l2i_i2l (nshiftl k y)).
+ rewrite <- (l2i_i2l (nshiftl x k)), <- (l2i_i2l (nshiftl y k)).
f_equal; auto.
Qed.
- (** This equivalence allows to prove easily the following delicate
+ (** This equivalence allows proving easily the following delicate
result *)
Lemma EqShiftL_twice_plus_one : forall k x y,
EqShiftL k (twice_plus_one x) (twice_plus_one y) <-> EqShiftL (S k) x y.
Proof.
intros.
- destruct (le_lt_dec size k).
+ destruct (le_lt_dec size k) as [Hle|Hlt].
split; intros; apply EqShiftL_size; auto.
rewrite 2 EqShiftL_i2l.
@@ -685,7 +684,7 @@ Section Basics.
EqShiftL (S k) (shiftr x) (shiftr y).
Proof.
intros.
- destruct (le_lt_dec size (S k)).
+ destruct (le_lt_dec size (S k)) as [Hle|Hlt].
apply EqShiftL_size; auto.
case_eq (firstr x); intros.
rewrite <- EqShiftL_twice.
@@ -819,30 +818,30 @@ Section Basics.
Lemma phi_inv_phi_aux :
forall n x, n <= size ->
- phi_inv (phibis_aux n (nshiftr (size-n) x)) =
- nshiftr (size-n) x.
+ phi_inv (phibis_aux n (nshiftr x (size-n))) =
+ nshiftr x (size-n).
Proof.
induction n.
- intros; simpl.
+ intros; simpl minus.
rewrite nshiftr_size; auto.
intros.
unfold phibis_aux, recrbis_aux; fold recrbis_aux;
- fold (phibis_aux n (shiftr (nshiftr (size-S n) x))).
- assert (shiftr (nshiftr (size - S n) x) = nshiftr (size-n) x).
+ fold (phibis_aux n (shiftr (nshiftr x (size-S n)))).
+ assert (shiftr (nshiftr x (size - S n)) = nshiftr x (size-n)).
replace (size - n)%nat with (S (size - (S n))); auto; omega.
rewrite H0.
- case_eq (firstr (nshiftr (size - S n) x)); intros.
+ case_eq (firstr (nshiftr x (size - S n))); intros.
rewrite phi_inv_double.
rewrite IHn by omega.
rewrite <- H0.
- remember (nshiftr (size - S n) x) as y.
+ remember (nshiftr x (size - S n)) as y.
destruct y; simpl in H1; rewrite H1; auto.
rewrite phi_inv_double_plus_one.
rewrite IHn by omega.
rewrite <- H0.
- remember (nshiftr (size - S n) x) as y.
+ remember (nshiftr x (size - S n)) as y.
destruct y; simpl in H1; rewrite H1; auto.
Qed.
@@ -850,7 +849,7 @@ Section Basics.
Proof.
intros.
rewrite <- phibis_aux_equiv.
- replace x with (nshiftr (size - size) x) by auto.
+ replace x with (nshiftr x (size - size)) by auto.
apply phi_inv_phi_aux; auto.
Qed.
@@ -875,28 +874,28 @@ Section Basics.
end.
Lemma p2ibis_bounded : forall n p,
- nshiftr n (snd (p2ibis n p)) = 0.
+ nshiftr (snd (p2ibis n p)) n = 0.
Proof.
induction n.
simpl; intros; auto.
- simpl; intros.
- destruct p; simpl.
+ simpl p2ibis; intros.
+ destruct p; simpl snd.
specialize IHn with p.
- destruct (p2ibis n p); simpl in *.
+ destruct (p2ibis n p). simpl @snd in *.
rewrite nshiftr_S_tail.
- destruct (le_lt_dec size n).
+ destruct (le_lt_dec size n) as [Hle|Hlt].
rewrite nshiftr_above_size; auto.
- assert (H:=nshiftr_0_firstl _ _ l IHn).
+ assert (H:=nshiftr_0_firstl _ _ Hlt IHn).
replace (shiftr (twice_plus_one i)) with i; auto.
- destruct i; simpl in *; rewrite H; auto.
+ destruct i; simpl in *. rewrite H; auto.
specialize IHn with p.
- destruct (p2ibis n p); simpl in *.
+ destruct (p2ibis n p); simpl @snd in *.
rewrite nshiftr_S_tail.
- destruct (le_lt_dec size n).
+ destruct (le_lt_dec size n) as [Hle|Hlt].
rewrite nshiftr_above_size; auto.
- assert (H:=nshiftr_0_firstl _ _ l IHn).
+ assert (H:=nshiftr_0_firstl _ _ Hlt IHn).
replace (shiftr (twice i)) with i; auto.
destruct i; simpl in *; rewrite H; auto.
@@ -946,7 +945,7 @@ Section Basics.
intros.
simpl p2ibis; destruct p; [ | | red; auto];
specialize IHn with p;
- destruct (p2ibis n p); simpl snd in *; simpl phi_inv_positive;
+ destruct (p2ibis n p); simpl @snd in *; simpl phi_inv_positive;
rewrite ?EqShiftL_twice_plus_one, ?EqShiftL_twice;
replace (S (size - S n))%nat with (size - n)%nat by omega;
apply IHn; omega.
@@ -1158,7 +1157,10 @@ Instance int31_ops : ZnZ.Ops int31 :=
fun i => let (_,r) := i/2 in
match r ?= 0 with Eq => true | _ => false end;
sqrt2 := sqrt312;
- sqrt := sqrt31
+ sqrt := sqrt31;
+ lor := lor31;
+ land := land31;
+ lxor := lxor31
}.
Section Int31_Specs.
@@ -1175,10 +1177,10 @@ Section Int31_Specs.
Qed.
Notation "[+| c |]" :=
- (interp_carry 1 wB phi c) (at level 0, x at level 99).
+ (interp_carry 1 wB phi c) (at level 0, c at level 99).
Notation "[-| c |]" :=
- (interp_carry (-1) wB phi c) (at level 0, x at level 99).
+ (interp_carry (-1) wB phi c) (at level 0, c at level 99).
Notation "[|| x ||]" :=
(zn2z_to_Z wB phi x) (at level 0, x at level 99).
@@ -1412,7 +1414,7 @@ Section Int31_Specs.
generalize (phi_bounded a1)(phi_bounded a2)(phi_bounded b); intros.
assert ([|b|]>0) by (auto with zarith).
generalize (Z_div_mod (phi2 a1 a2) [|b|] H4) (Z_div_pos (phi2 a1 a2) [|b|] H4).
- unfold Z.div; destruct (Z.div_eucl (phi2 a1 a2) [|b|]); simpl.
+ unfold Z.div; destruct (Z.div_eucl (phi2 a1 a2) [|b|]).
rewrite ?phi_phi_inv.
destruct 1; intros.
unfold phi2 in *.
@@ -1442,7 +1444,7 @@ Section Int31_Specs.
unfold div31; intros.
assert ([|b|]>0) by (auto with zarith).
generalize (Z_div_mod [|a|] [|b|] H0) (Z_div_pos [|a|] [|b|] H0).
- unfold Z.div; destruct (Z.div_eucl [|a|] [|b|]); simpl.
+ unfold Z.div; destruct (Z.div_eucl [|a|] [|b|]).
rewrite ?phi_phi_inv.
destruct 1; intros.
rewrite H1, Z.mul_comm.
@@ -1465,7 +1467,7 @@ Section Int31_Specs.
assert ([|b|]>0) by (auto with zarith).
unfold Z.modulo.
generalize (Z_div_mod [|a|] [|b|] H0).
- destruct (Z.div_eucl [|a|] [|b|]); simpl.
+ destruct (Z.div_eucl [|a|] [|b|]).
rewrite ?phi_phi_inv.
destruct 1; intros.
generalize (phi_bounded b); intros.
@@ -1478,15 +1480,14 @@ Section Int31_Specs.
unfold gcd31.
induction (2*size)%nat; intros.
reflexivity.
- simpl.
+ simpl euler.
unfold compare31.
change [|On|] with 0.
generalize (phi_bounded j)(phi_bounded i); intros.
case_eq [|j|]; intros.
simpl; intros.
generalize (Zabs_spec [|i|]); omega.
- simpl.
- rewrite IHn, H1; f_equal.
+ simpl. rewrite IHn, H1; f_equal.
rewrite spec_mod, H1; auto.
rewrite H1; compute; auto.
rewrite H1 in H; destruct H as [H _]; compute in H; elim H; auto.
@@ -1519,17 +1520,17 @@ Section Int31_Specs.
simpl; auto.
simpl; intros.
case_eq (firstr i); intros H; rewrite 2 IHn;
- unfold phibis_aux; simpl; rewrite H; fold (phibis_aux n (shiftr i));
+ unfold phibis_aux; simpl; rewrite ?H; fold (phibis_aux n (shiftr i));
generalize (phibis_aux_pos n (shiftr i)); intros;
set (z := phibis_aux n (shiftr i)) in *; clearbody z;
- rewrite <- iter_nat_plus.
+ rewrite <- nat_rect_plus.
f_equal.
rewrite Z.double_spec, <- Z.add_diag.
symmetry; apply Zabs2Nat.inj_add; auto with zarith.
- change (iter_nat (S (Z.abs_nat z + Z.abs_nat z)) A f a =
- iter_nat (Z.abs_nat (Z.succ_double z)) A f a); f_equal.
+ change (iter_nat (S (Z.abs_nat z) + (Z.abs_nat z))%nat A f a =
+ iter_nat (Z.abs_nat (Z.succ_double z)) A f a); f_equal.
rewrite Z.succ_double_spec, <- Z.add_diag.
rewrite Zabs2Nat.inj_add; auto with zarith.
rewrite Zabs2Nat.inj_add; auto with zarith.
@@ -1554,7 +1555,7 @@ Section Int31_Specs.
intros.
simpl addmuldiv31_alt.
replace (S n) with (n+1)%nat by (rewrite plus_comm; auto).
- rewrite iter_nat_plus; simpl; auto.
+ rewrite nat_rect_plus; simpl; auto.
Qed.
Lemma spec_add_mul_div : forall x y p, [|p|] <= Zpos 31 ->
@@ -1573,10 +1574,9 @@ Section Int31_Specs.
clear p H; revert x y.
induction n.
- simpl; intros.
- change (Z.pow_pos 2 31) with (2^31).
+ simpl Z.of_nat; intros.
rewrite Z.mul_1_r.
- replace ([|y|] / 2^31) with 0.
+ replace ([|y|] / 2^(31-0)) with 0.
rewrite Z.add_0_r.
symmetry; apply Zmod_small; apply phi_bounded.
symmetry; apply Zdiv_small; apply phi_bounded.
@@ -1627,7 +1627,7 @@ Section Int31_Specs.
Lemma spec_pos_mod : forall w p,
[|ZnZ.pos_mod p w|] = [|w|] mod (2 ^ [|p|]).
Proof.
- unfold ZnZ.pos_mod, int31_ops, compare31.
+ unfold int31_ops, ZnZ.pos_mod, compare31.
change [|31|] with 31%Z.
assert (forall w p, 31<=p -> [|w|] = [|w|] mod 2^p).
intros.
@@ -1664,7 +1664,7 @@ Section Int31_Specs.
Proof.
intros.
generalize (phi_inv_phi x).
- rewrite H; simpl.
+ rewrite H; simpl phi_inv.
intros H'; rewrite <- H'.
simpl; auto.
Qed.
@@ -1739,7 +1739,7 @@ Section Int31_Specs.
Proof.
intros.
rewrite head031_equiv.
- assert (nshiftl size x = 0%int31).
+ assert (nshiftl x size = 0%int31).
apply nshiftl_size.
revert x H H0.
unfold size at 2 5.
@@ -1772,7 +1772,7 @@ Section Int31_Specs.
Proof.
intros.
generalize (phi_inv_phi x).
- rewrite H; simpl.
+ rewrite H; simpl phi_inv.
intros H'; rewrite <- H'.
simpl; auto.
Qed.
@@ -1837,7 +1837,7 @@ Section Int31_Specs.
Proof.
intros.
rewrite tail031_equiv.
- assert (nshiftr size x = 0%int31).
+ assert (nshiftr x size = 0%int31).
apply nshiftr_size.
revert x H H0.
induction size.
@@ -1957,7 +1957,7 @@ Section Int31_Specs.
Lemma div31_phi i j: 0 < [|j|] -> [|fst (i/j)%int31|] = [|i|]/[|j|].
intros Hj; generalize (spec_div i j Hj).
- case div31; intros q r; simpl fst.
+ case div31; intros q r; simpl @fst.
intros (H1,H2); apply Zdiv_unique with [|r|]; auto with zarith.
rewrite H1; ring.
Qed.
@@ -2092,7 +2092,7 @@ Section Int31_Specs.
generalize (spec_div21 ih il j Hj Hj1).
case div3121; intros q r (Hq, Hr).
apply Zdiv_unique with (phi r); auto with zarith.
- simpl fst; apply eq_trans with (1 := Hq); ring.
+ simpl @fst; apply eq_trans with (1 := Hq); ring.
Qed.
Lemma sqrt312_step_correct rec ih il j:
@@ -2119,7 +2119,7 @@ Section Int31_Specs.
unfold phi2; rewrite Hc1.
assert (0 <= [|il|]/[|j|]) by (apply Z_div_pos; auto with zarith).
rewrite Z.mul_comm, Z_div_plus_full_l; unfold base; auto with zarith.
- unfold Z.pow, Z.pow_pos in Hj1; simpl in Hj1; auto with zarith.
+ simpl wB in Hj1. unfold Z.pow_pos in Hj1. simpl in Hj1. auto with zarith.
case (Z.le_gt_cases (2 ^ 30) [|j|]); intros Hjj.
rewrite spec_compare; case Z.compare_spec;
rewrite div312_phi; auto; intros Hc;
@@ -2213,6 +2213,9 @@ Section Int31_Specs.
apply Nat2Z.is_nonneg.
Qed.
+ (* Avoid expanding [iter312_sqrt] before variables in the context. *)
+ Strategy 1 [iter312_sqrt].
+
Lemma spec_sqrt2 : forall x y,
wB/ 4 <= [|x|] ->
let (s,r) := sqrt312 x y in
@@ -2230,7 +2233,7 @@ Section Int31_Specs.
2: simpl; unfold Z.pow_pos; simpl; auto with zarith.
case (phi_bounded ih); case (phi_bounded il); intros H1 H2 H3 H4.
unfold base, Z.pow, Z.pow_pos in H2,H4; simpl in H2,H4.
- unfold phi2,Z.pow, Z.pow_pos. simpl Pos.iter; auto with zarith. }
+ unfold phi2. cbn [Z.pow Z.pow_pos Pos.iter]. auto with zarith. }
case (iter312_sqrt_correct 31 (fun _ _ j => j) ih il Tn); auto with zarith.
change [|Tn|] with 2147483647; auto with zarith.
intros j1 _ HH; contradict HH.
@@ -2255,9 +2258,8 @@ Section Int31_Specs.
intros Hihl1.
generalize (spec_sub_c il il1).
case sub31c; intros il2 Hil2.
- simpl interp_carry in Hil2.
rewrite spec_compare; case Z.compare_spec.
- unfold interp_carry.
+ unfold interp_carry in *.
intros H1; split.
rewrite Z.pow_2_r, <- Hihl1.
unfold phi2; ring[Hil2 H1].
@@ -2274,7 +2276,7 @@ Section Int31_Specs.
rewrite Z.mul_add_distr_r, Z.add_0_r; auto with zarith.
case (phi_bounded il1); intros H3 _.
apply Z.add_le_mono; auto with zarith.
- unfold interp_carry; change (1 * 2 ^ Z.of_nat size) with base.
+ unfold interp_carry in *; change (1 * 2 ^ Z.of_nat size) with base.
rewrite Z.pow_2_r, <- Hihl1, Hil2.
intros H1.
rewrite <- Z.le_succ_l, <- Z.add_1_r in H1.
@@ -2378,8 +2380,8 @@ Qed.
Lemma spec_eq0 : forall x, ZnZ.eq0 x = true -> [|x|] = 0.
Proof.
- clear; unfold ZnZ.eq0; simpl.
- unfold compare31; simpl; intros.
+ clear; unfold ZnZ.eq0, int31_ops.
+ unfold compare31; intros.
change [|0|] with 0 in H.
apply Z.compare_eq.
now destruct ([|x|] ?= 0).
@@ -2390,7 +2392,7 @@ Qed.
Lemma spec_is_even : forall x,
if ZnZ.is_even x then [|x|] mod 2 = 0 else [|x|] mod 2 = 1.
Proof.
- unfold ZnZ.is_even; simpl; intros.
+ unfold ZnZ.is_even, int31_ops; intros.
generalize (spec_div x 2).
destruct (x/2)%int31 as (q,r); intros.
unfold compare31.
@@ -2403,6 +2405,51 @@ Qed.
apply Zmod_unique with [|q|]; auto with zarith.
Qed.
+ (* Bitwise *)
+
+ Lemma log2_phi_bounded x : Z.log2 [|x|] < Z.of_nat size.
+ Proof.
+ destruct (phi_bounded x) as (H,H').
+ Z.le_elim H.
+ - now apply Z.log2_lt_pow2.
+ - now rewrite <- H.
+ Qed.
+
+ Lemma spec_lor x y : [| ZnZ.lor x y |] = Z.lor [|x|] [|y|].
+ Proof.
+ unfold ZnZ.lor,int31_ops. unfold lor31.
+ rewrite phi_phi_inv.
+ apply Z.mod_small; split; trivial.
+ - apply Z.lor_nonneg; split; apply phi_bounded.
+ - apply Z.log2_lt_cancel. rewrite Z.log2_pow2 by easy.
+ rewrite Z.log2_lor; try apply phi_bounded.
+ apply Z.max_lub_lt; apply log2_phi_bounded.
+ Qed.
+
+ Lemma spec_land x y : [| ZnZ.land x y |] = Z.land [|x|] [|y|].
+ Proof.
+ unfold ZnZ.land, int31_ops. unfold land31.
+ rewrite phi_phi_inv.
+ apply Z.mod_small; split; trivial.
+ - apply Z.land_nonneg; left; apply phi_bounded.
+ - apply Z.log2_lt_cancel. rewrite Z.log2_pow2 by easy.
+ eapply Z.le_lt_trans.
+ apply Z.log2_land; try apply phi_bounded.
+ apply Z.min_lt_iff; left; apply log2_phi_bounded.
+ Qed.
+
+ Lemma spec_lxor x y : [| ZnZ.lxor x y |] = Z.lxor [|x|] [|y|].
+ Proof.
+ unfold ZnZ.lxor, int31_ops. unfold lxor31.
+ rewrite phi_phi_inv.
+ apply Z.mod_small; split; trivial.
+ - apply Z.lxor_nonneg; split; intros; apply phi_bounded.
+ - apply Z.log2_lt_cancel. rewrite Z.log2_pow2 by easy.
+ eapply Z.le_lt_trans.
+ apply Z.log2_lxor; try apply phi_bounded.
+ apply Z.max_lub_lt; apply log2_phi_bounded.
+ Qed.
+
Global Instance int31_specs : ZnZ.Specs int31_ops := {
spec_to_Z := phi_bounded;
spec_of_pos := positive_to_int31_spec;
@@ -2446,7 +2493,10 @@ Qed.
spec_pos_mod := spec_pos_mod;
spec_is_even := spec_is_even;
spec_sqrt2 := spec_sqrt2;
- spec_sqrt := spec_sqrt }.
+ spec_sqrt := spec_sqrt;
+ spec_lor := spec_lor;
+ spec_land := spec_land;
+ spec_lxor := spec_lxor }.
End Int31_Specs.
diff --git a/theories/Numbers/Cyclic/Int31/Int31.v b/theories/Numbers/Cyclic/Int31/Int31.v
index 73f2816a..4e28b5b9 100644
--- a/theories/Numbers/Cyclic/Int31/Int31.v
+++ b/theories/Numbers/Cyclic/Int31/Int31.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -335,6 +335,11 @@ Definition addmuldiv31 p i j :=
in
res.
+(** Bitwise operations *)
+
+Definition lor31 n m := phi_inv (Z.lor (phi n) (phi m)).
+Definition land31 n m := phi_inv (Z.land (phi n) (phi m)).
+Definition lxor31 n m := phi_inv (Z.lxor (phi n) (phi m)).
Register add31 as int31 plus in "coq_int31" by True.
Register add31c as int31 plusc in "coq_int31" by True.
@@ -345,9 +350,15 @@ Register sub31carryc as int31 minuscarryc in "coq_int31" by True.
Register mul31 as int31 times in "coq_int31" by True.
Register mul31c as int31 timesc in "coq_int31" by True.
Register div3121 as int31 div21 in "coq_int31" by True.
-Register div31 as int31 div in "coq_int31" by True.
+Register div31 as int31 diveucl in "coq_int31" by True.
Register compare31 as int31 compare in "coq_int31" by True.
Register addmuldiv31 as int31 addmuldiv in "coq_int31" by True.
+Register lor31 as int31 lor in "coq_int31" by True.
+Register land31 as int31 land in "coq_int31" by True.
+Register lxor31 as int31 lxor in "coq_int31" by True.
+
+Definition lnot31 n := lxor31 Tn n.
+Definition ldiff31 n m := land31 n (lnot31 m).
Fixpoint euler (guard:nat) (i j:int31) {struct guard} :=
match guard with
diff --git a/theories/Numbers/Cyclic/Int31/Ring31.v b/theories/Numbers/Cyclic/Int31/Ring31.v
index b2857256..4fde3f53 100644
--- a/theories/Numbers/Cyclic/Int31/Ring31.v
+++ b/theories/Numbers/Cyclic/Int31/Ring31.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Numbers/Cyclic/ZModulo/ZModulo.v b/theories/Numbers/Cyclic/ZModulo/ZModulo.v
index 673e4b1c..b93b4eb3 100644
--- a/theories/Numbers/Cyclic/ZModulo/ZModulo.v
+++ b/theories/Numbers/Cyclic/ZModulo/ZModulo.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -38,10 +38,10 @@ Section ZModulo.
Notation "[| x |]" := (to_Z x) (at level 0, x at level 99).
Notation "[+| c |]" :=
- (interp_carry 1 wB to_Z c) (at level 0, x at level 99).
+ (interp_carry 1 wB to_Z c) (at level 0, c at level 99).
Notation "[-| c |]" :=
- (interp_carry (-1) wB to_Z c) (at level 0, x at level 99).
+ (interp_carry (-1) wB to_Z c) (at level 0, c at level 99).
Notation "[|| x ||]" :=
(zn2z_to_Z wB to_Z x) (at level 0, x at level 99).
@@ -466,8 +466,8 @@ Section ZModulo.
generalize (Zgcd_is_gcd a b); inversion_clear 1.
destruct H2 as (q,H2); destruct H3 as (q',H3); clear H4.
assert (H4:=Z.gcd_nonneg a b).
- destruct (Z.eq_dec (Z.gcd a b) 0).
- rewrite e; generalize (Zmax_spec a b); omega.
+ destruct (Z.eq_dec (Z.gcd a b) 0) as [->|Hneq].
+ generalize (Zmax_spec a b); omega.
assert (0 <= q).
apply Z.mul_le_mono_pos_r with (Z.gcd a b); auto with zarith.
destruct (Z.eq_dec q 0).
@@ -796,6 +796,40 @@ Section ZModulo.
exists 0; simpl; auto with zarith.
Qed.
+ Definition lor := Z.lor.
+ Definition land := Z.land.
+ Definition lxor := Z.lxor.
+
+ Lemma spec_lor x y : [|lor x y|] = Z.lor [|x|] [|y|].
+ Proof.
+ unfold lor, to_Z.
+ apply Z.bits_inj'; intros n Hn. rewrite Z.lor_spec.
+ unfold wB, base.
+ destruct (Z.le_gt_cases (Z.pos digits) n).
+ - rewrite !Z.mod_pow2_bits_high; auto with zarith.
+ - rewrite !Z.mod_pow2_bits_low, Z.lor_spec; auto with zarith.
+ Qed.
+
+ Lemma spec_land x y : [|land x y|] = Z.land [|x|] [|y|].
+ Proof.
+ unfold land, to_Z.
+ apply Z.bits_inj'; intros n Hn. rewrite Z.land_spec.
+ unfold wB, base.
+ destruct (Z.le_gt_cases (Z.pos digits) n).
+ - rewrite !Z.mod_pow2_bits_high; auto with zarith.
+ - rewrite !Z.mod_pow2_bits_low, Z.land_spec; auto with zarith.
+ Qed.
+
+ Lemma spec_lxor x y : [|lxor x y|] = Z.lxor [|x|] [|y|].
+ Proof.
+ unfold lxor, to_Z.
+ apply Z.bits_inj'; intros n Hn. rewrite Z.lxor_spec.
+ unfold wB, base.
+ destruct (Z.le_gt_cases (Z.pos digits) n).
+ - rewrite !Z.mod_pow2_bits_high; auto with zarith.
+ - rewrite !Z.mod_pow2_bits_low, Z.lxor_spec; auto with zarith.
+ Qed.
+
(** Let's now group everything in two records *)
Instance zmod_ops : ZnZ.Ops Z := ZnZ.MkOps
@@ -849,7 +883,10 @@ Section ZModulo.
(is_even : t -> bool)
(sqrt2 : t -> t -> t * carry t)
- (sqrt : t -> t).
+ (sqrt : t -> t)
+ (lor : t -> t -> t)
+ (land : t -> t -> t)
+ (lxor : t -> t -> t).
Instance zmod_specs : ZnZ.Specs zmod_ops := ZnZ.MkSpecs
spec_to_Z
@@ -906,7 +943,10 @@ Section ZModulo.
spec_is_even
spec_sqrt2
- spec_sqrt.
+ spec_sqrt
+ spec_lor
+ spec_land
+ spec_lxor.
End ZModulo.
@@ -922,4 +962,3 @@ Module ZModuloCyclicType (P:PositiveNotOne) <: CyclicType.
Instance ops : ZnZ.Ops t := zmod_ops P.p.
Instance specs : ZnZ.Specs ops := zmod_specs P.not_one.
End ZModuloCyclicType.
-
diff --git a/theories/Numbers/Integer/Abstract/ZAdd.v b/theories/Numbers/Integer/Abstract/ZAdd.v
index e109948d..ec8801c4 100644
--- a/theories/Numbers/Integer/Abstract/ZAdd.v
+++ b/theories/Numbers/Integer/Abstract/ZAdd.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Numbers/Integer/Abstract/ZAddOrder.v b/theories/Numbers/Integer/Abstract/ZAddOrder.v
index a5023310..e341ea8a 100644
--- a/theories/Numbers/Integer/Abstract/ZAddOrder.v
+++ b/theories/Numbers/Integer/Abstract/ZAddOrder.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Numbers/Integer/Abstract/ZAxioms.v b/theories/Numbers/Integer/Abstract/ZAxioms.v
index d6a9a6b3..2a9fa539 100644
--- a/theories/Numbers/Integer/Abstract/ZAxioms.v
+++ b/theories/Numbers/Integer/Abstract/ZAxioms.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Numbers/Integer/Abstract/ZBase.v b/theories/Numbers/Integer/Abstract/ZBase.v
index cb3c965b..6634eab1 100644
--- a/theories/Numbers/Integer/Abstract/ZBase.v
+++ b/theories/Numbers/Integer/Abstract/ZBase.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Numbers/Integer/Abstract/ZBits.v b/theories/Numbers/Integer/Abstract/ZBits.v
index f986b64b..9dd0ec0e 100644
--- a/theories/Numbers/Integer/Abstract/ZBits.v
+++ b/theories/Numbers/Integer/Abstract/ZBits.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Numbers/Integer/Abstract/ZDivEucl.v b/theories/Numbers/Integer/Abstract/ZDivEucl.v
index 06f6c903..d0df8fb4 100644
--- a/theories/Numbers/Integer/Abstract/ZDivEucl.v
+++ b/theories/Numbers/Integer/Abstract/ZDivEucl.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Numbers/Integer/Abstract/ZDivFloor.v b/theories/Numbers/Integer/Abstract/ZDivFloor.v
index d38b2199..d5f3f4ad 100644
--- a/theories/Numbers/Integer/Abstract/ZDivFloor.v
+++ b/theories/Numbers/Integer/Abstract/ZDivFloor.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Numbers/Integer/Abstract/ZDivTrunc.v b/theories/Numbers/Integer/Abstract/ZDivTrunc.v
index fb4646f9..de2e99ec 100644
--- a/theories/Numbers/Integer/Abstract/ZDivTrunc.v
+++ b/theories/Numbers/Integer/Abstract/ZDivTrunc.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Numbers/Integer/Abstract/ZGcd.v b/theories/Numbers/Integer/Abstract/ZGcd.v
index 6759662c..cf6ff79e 100644
--- a/theories/Numbers/Integer/Abstract/ZGcd.v
+++ b/theories/Numbers/Integer/Abstract/ZGcd.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Numbers/Integer/Abstract/ZLcm.v b/theories/Numbers/Integer/Abstract/ZLcm.v
index 8616343e..9a1768eb 100644
--- a/theories/Numbers/Integer/Abstract/ZLcm.v
+++ b/theories/Numbers/Integer/Abstract/ZLcm.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Numbers/Integer/Abstract/ZLt.v b/theories/Numbers/Integer/Abstract/ZLt.v
index f59b545f..6d0cdb01 100644
--- a/theories/Numbers/Integer/Abstract/ZLt.v
+++ b/theories/Numbers/Integer/Abstract/ZLt.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Numbers/Integer/Abstract/ZMaxMin.v b/theories/Numbers/Integer/Abstract/ZMaxMin.v
index 97bb074a..07c78ead 100644
--- a/theories/Numbers/Integer/Abstract/ZMaxMin.v
+++ b/theories/Numbers/Integer/Abstract/ZMaxMin.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Numbers/Integer/Abstract/ZMul.v b/theories/Numbers/Integer/Abstract/ZMul.v
index d45fc2f5..2d78d8f3 100644
--- a/theories/Numbers/Integer/Abstract/ZMul.v
+++ b/theories/Numbers/Integer/Abstract/ZMul.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Numbers/Integer/Abstract/ZMulOrder.v b/theories/Numbers/Integer/Abstract/ZMulOrder.v
index 750c6ad3..487aaae1 100644
--- a/theories/Numbers/Integer/Abstract/ZMulOrder.v
+++ b/theories/Numbers/Integer/Abstract/ZMulOrder.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Numbers/Integer/Abstract/ZParity.v b/theories/Numbers/Integer/Abstract/ZParity.v
index 79ed9e4a..195a0277 100644
--- a/theories/Numbers/Integer/Abstract/ZParity.v
+++ b/theories/Numbers/Integer/Abstract/ZParity.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Numbers/Integer/Abstract/ZPow.v b/theories/Numbers/Integer/Abstract/ZPow.v
index d5a0a1a4..87de2c78 100644
--- a/theories/Numbers/Integer/Abstract/ZPow.v
+++ b/theories/Numbers/Integer/Abstract/ZPow.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Numbers/Integer/Abstract/ZProperties.v b/theories/Numbers/Integer/Abstract/ZProperties.v
index d278275a..5cfeeb21 100644
--- a/theories/Numbers/Integer/Abstract/ZProperties.v
+++ b/theories/Numbers/Integer/Abstract/ZProperties.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -9,11 +9,22 @@
Require Export ZAxioms ZMaxMin ZSgnAbs ZParity ZPow ZDivTrunc ZDivFloor
ZGcd ZLcm NZLog NZSqrt ZBits.
-(** This functor summarizes all known facts about Z. *)
+(** The two following functors summarize all known facts about N.
-Module Type ZProp (Z:ZAxiomsSig) :=
- ZMaxMinProp Z <+ ZSgnAbsProp Z <+ ZParityProp Z <+ ZPowProp Z
- <+ NZSqrtProp Z Z <+ NZSqrtUpProp Z Z
- <+ NZLog2Prop Z Z Z <+ NZLog2UpProp Z Z Z
- <+ ZDivProp Z <+ ZQuotProp Z <+ ZGcdProp Z <+ ZLcmProp Z
- <+ ZBitsProp Z.
+ - [ZBasicProp] provides properties of basic functions:
+ + - * min max <= <
+
+ - [ZExtraProp] provides properties of advanced functions:
+ pow, sqrt, log2, div, gcd, and bitwise functions.
+
+ If necessary, the earlier all-in-one functor [ZProp]
+ could be re-obtained via [ZBasicProp <+ ZExtraProp] *)
+
+Module Type ZBasicProp (Z:ZAxiomsMiniSig) := ZMaxMinProp Z.
+
+Module Type ZExtraProp (Z:ZAxiomsSig)(P:ZBasicProp Z) :=
+ ZSgnAbsProp Z P <+ ZParityProp Z P <+ ZPowProp Z P
+ <+ NZSqrtProp Z Z P <+ NZSqrtUpProp Z Z P
+ <+ NZLog2Prop Z Z Z P <+ NZLog2UpProp Z Z Z P
+ <+ ZDivProp Z P <+ ZQuotProp Z P <+ ZGcdProp Z P <+ ZLcmProp Z P
+ <+ ZBitsProp Z P.
diff --git a/theories/Numbers/Integer/Abstract/ZSgnAbs.v b/theories/Numbers/Integer/Abstract/ZSgnAbs.v
index c708e883..b379853e 100644
--- a/theories/Numbers/Integer/Abstract/ZSgnAbs.v
+++ b/theories/Numbers/Integer/Abstract/ZSgnAbs.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Numbers/Integer/BigZ/BigZ.v b/theories/Numbers/Integer/BigZ/BigZ.v
index 1e0cfa17..b28bc40f 100644
--- a/theories/Numbers/Integer/BigZ/BigZ.v
+++ b/theories/Numbers/Integer/BigZ/BigZ.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -26,15 +26,13 @@ Require Import ZProperties ZDivFloor ZSig ZSigZAxioms ZMake.
Delimit Scope bigZ_scope with bigZ.
-Module BigZ <: ZType <: OrderedTypeFull <: TotalOrder.
- Include ZMake.Make BigN [scope abstract_scope to bigZ_scope].
- Bind Scope bigZ_scope with t t_.
- Include ZTypeIsZAxioms
- <+ ZProp [no inline]
+Module BigZ <: ZType <: OrderedTypeFull <: TotalOrder :=
+ ZMake.Make BigN
+ <+ ZTypeIsZAxioms
+ <+ ZBasicProp [no inline] <+ ZExtraProp [no inline]
<+ HasEqBool2Dec [no inline]
<+ MinMaxLogicalProperties [no inline]
<+ MinMaxDecProperties [no inline].
-End BigZ.
(** For precision concerning the above scope handling, see comment in BigN *)
diff --git a/theories/Numbers/Integer/BigZ/ZMake.v b/theories/Numbers/Integer/BigZ/ZMake.v
index b1f84393..af4f1d93 100644
--- a/theories/Numbers/Integer/BigZ/ZMake.v
+++ b/theories/Numbers/Integer/BigZ/ZMake.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -29,8 +29,6 @@ Module Make (NN:NType) <: ZType.
Definition t := t_.
- Bind Scope abstract_scope with t t_.
-
Definition zero := Pos NN.zero.
Definition one := Pos NN.one.
Definition two := Pos NN.two.
diff --git a/theories/Numbers/Integer/Binary/ZBinary.v b/theories/Numbers/Integer/Binary/ZBinary.v
index a70a72ea..04208106 100644
--- a/theories/Numbers/Integer/Binary/ZBinary.v
+++ b/theories/Numbers/Integer/Binary/ZBinary.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Numbers/Integer/NatPairs/ZNatPairs.v b/theories/Numbers/Integer/NatPairs/ZNatPairs.v
index 1f7d8dbc..02f02fbc 100644
--- a/theories/Numbers/Integer/NatPairs/ZNatPairs.v
+++ b/theories/Numbers/Integer/NatPairs/ZNatPairs.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -332,9 +332,9 @@ and get their properties *)
(* The following lines increase the compilation time at least twice *)
(*
-Require Import NPeano.
+Require PeanoNat.
-Module Export ZPairsPeanoAxiomsMod := ZPairsAxiomsMod NPeanoAxiomsMod.
+Module Export ZPairsPeanoAxiomsMod := ZPairsAxiomsMod PeanoNat.Nat.
Module Export ZPairsPropMod := ZPropFunct ZPairsPeanoAxiomsMod.
Eval compute in (3, 5) * (4, 6).
diff --git a/theories/Numbers/Integer/SpecViaZ/ZSig.v b/theories/Numbers/Integer/SpecViaZ/ZSig.v
index eaa181a6..30ac32b5 100644
--- a/theories/Numbers/Integer/SpecViaZ/ZSig.v
+++ b/theories/Numbers/Integer/SpecViaZ/ZSig.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Numbers/Integer/SpecViaZ/ZSigZAxioms.v b/theories/Numbers/Integer/SpecViaZ/ZSigZAxioms.v
index 933b53e4..c9dc687c 100644
--- a/theories/Numbers/Integer/SpecViaZ/ZSigZAxioms.v
+++ b/theories/Numbers/Integer/SpecViaZ/ZSigZAxioms.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Numbers/NaryFunctions.v b/theories/Numbers/NaryFunctions.v
index 54542f64..6fdf0a2a 100644
--- a/theories/Numbers/NaryFunctions.v
+++ b/theories/Numbers/NaryFunctions.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Numbers/NatInt/NZAdd.v b/theories/Numbers/NatInt/NZAdd.v
index 2cef31ae..501583ae 100644
--- a/theories/Numbers/NatInt/NZAdd.v
+++ b/theories/Numbers/NatInt/NZAdd.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Numbers/NatInt/NZAddOrder.v b/theories/Numbers/NatInt/NZAddOrder.v
index c9bc8824..619a6634 100644
--- a/theories/Numbers/NatInt/NZAddOrder.v
+++ b/theories/Numbers/NatInt/NZAddOrder.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Numbers/NatInt/NZAxioms.v b/theories/Numbers/NatInt/NZAxioms.v
index e8f7def7..c88341fa 100644
--- a/theories/Numbers/NatInt/NZAxioms.v
+++ b/theories/Numbers/NatInt/NZAxioms.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -19,7 +19,8 @@ Require Export Equalities Orders NumPrelude GenericMinMax.
Module Type ZeroSuccPred (Import T:Typ).
Parameter Inline(20) zero : t.
- Parameters Inline succ pred : t -> t.
+ Parameter Inline(50) succ : t -> t.
+ Parameter Inline pred : t -> t.
End ZeroSuccPred.
Module Type ZeroSuccPredNotation (T:Typ)(Import NZ:ZeroSuccPred T).
diff --git a/theories/Numbers/NatInt/NZBase.v b/theories/Numbers/NatInt/NZBase.v
index 56c999d4..c0afa098 100644
--- a/theories/Numbers/NatInt/NZBase.v
+++ b/theories/Numbers/NatInt/NZBase.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -12,11 +12,6 @@ Require Import NZAxioms.
Module Type NZBaseProp (Import NZ : NZDomainSig').
-(** An artificial scope meant to be substituted later *)
-
-Delimit Scope abstract_scope with abstract.
-Bind Scope abstract_scope with t.
-
Include BackportEq NZ NZ. (** eq_refl, eq_sym, eq_trans *)
Lemma eq_sym_iff : forall x y, x==y <-> y==x.
diff --git a/theories/Numbers/NatInt/NZBits.v b/theories/Numbers/NatInt/NZBits.v
index 31e99340..1c118597 100644
--- a/theories/Numbers/NatInt/NZBits.v
+++ b/theories/Numbers/NatInt/NZBits.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Numbers/NatInt/NZDiv.v b/theories/Numbers/NatInt/NZDiv.v
index 339563c0..4a127216 100644
--- a/theories/Numbers/NatInt/NZDiv.v
+++ b/theories/Numbers/NatInt/NZDiv.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Numbers/NatInt/NZDomain.v b/theories/Numbers/NatInt/NZDomain.v
index c9001db2..ffb04f08 100644
--- a/theories/Numbers/NatInt/NZDomain.v
+++ b/theories/Numbers/NatInt/NZDomain.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -14,14 +14,12 @@ Require Import NZBase NZOrder NZAddOrder Plus Minus.
translation from Peano numbers [nat] into NZ.
*)
-(** First, some complements about [nat_iter] *)
+Local Notation "f ^ n" := (fun x => nat_rect _ x (fun _ => f) n).
-Local Notation "f ^ n" := (nat_iter n f).
-
-Instance nat_iter_wd n {A} (R:relation A) :
- Proper ((R==>R)==>R==>R) (nat_iter n).
+Instance nat_rect_wd n {A} (R:relation A) :
+ Proper (R==>(R==>R)==>R) (fun x f => nat_rect (fun _ => _) x (fun _ => f) n).
Proof.
-intros f f' Hf. induction n; simpl; red; auto.
+intros x y eq_xy f g eq_fg; induction n; [assumption | now apply eq_fg].
Qed.
Module NZDomainProp (Import NZ:NZDomainSig').
@@ -33,17 +31,24 @@ Include NZBaseProp NZ.
Lemma itersucc_or_itersucc n m : exists k, n == (S^k) m \/ m == (S^k) n.
Proof.
-nzinduct n m.
+revert n.
+apply central_induction with (z:=m).
+ { intros x y eq_xy; apply ex_iff_morphism.
+ intros n; apply or_iff_morphism.
+ + split; intros; etransitivity; try eassumption; now symmetry.
+ + split; intros; (etransitivity; [eassumption|]); [|symmetry];
+ (eapply nat_rect_wd; [eassumption|apply succ_wd]).
+ }
exists 0%nat. now left.
intros n. split; intros [k [L|R]].
exists (Datatypes.S k). left. now apply succ_wd.
destruct k as [|k].
simpl in R. exists 1%nat. left. now apply succ_wd.
-rewrite nat_iter_succ_r in R. exists k. now right.
+rewrite nat_rect_succ_r in R. exists k. now right.
destruct k as [|k]; simpl in L.
exists 1%nat. now right.
apply succ_inj in L. exists k. now left.
-exists (Datatypes.S k). right. now rewrite nat_iter_succ_r.
+exists (Datatypes.S k). right. now rewrite nat_rect_succ_r.
Qed.
(** Generalized version of [pred_succ] when iterating *)
@@ -53,7 +58,7 @@ Proof.
induction k.
simpl; auto with *.
simpl; intros. apply pred_wd in H. rewrite pred_succ in H. apply IHk in H; auto.
-rewrite <- nat_iter_succ_r in H; auto.
+rewrite <- nat_rect_succ_r in H; auto.
Qed.
(** From a given point, all others are iterated successors
@@ -319,7 +324,7 @@ Lemma ofnat_add : forall n m, [n+m] == [n]+[m].
Proof.
intros. rewrite ofnat_add_l.
induction n; simpl. reflexivity.
- rewrite ofnat_succ. now f_equiv.
+ now f_equiv.
Qed.
Lemma ofnat_mul : forall n m, [n*m] == [n]*[m].
@@ -327,15 +332,15 @@ Proof.
induction n; simpl; intros.
symmetry. apply mul_0_l.
rewrite plus_comm.
- rewrite ofnat_succ, ofnat_add, mul_succ_l.
+ rewrite ofnat_add, mul_succ_l.
now f_equiv.
Qed.
Lemma ofnat_sub_r : forall n m, n-[m] == (P^m) n.
Proof.
induction m; simpl; intros.
- rewrite ofnat_zero. apply sub_0_r.
- rewrite ofnat_succ, sub_succ_r. now f_equiv.
+ apply sub_0_r.
+ rewrite sub_succ_r. now f_equiv.
Qed.
Lemma ofnat_sub : forall n m, m<=n -> [n-m] == [n]-[m].
@@ -346,9 +351,10 @@ Proof.
intros.
destruct n.
inversion H.
- rewrite nat_iter_succ_r.
+ rewrite nat_rect_succ_r.
simpl.
- rewrite ofnat_succ, pred_succ; auto with arith.
+ etransitivity. apply IHm. auto with arith.
+ eapply nat_rect_wd; [symmetry;apply pred_succ|apply pred_wd].
Qed.
End NZOfNatOps.
diff --git a/theories/Numbers/NatInt/NZGcd.v b/theories/Numbers/NatInt/NZGcd.v
index 0fd543c0..42bee315 100644
--- a/theories/Numbers/NatInt/NZGcd.v
+++ b/theories/Numbers/NatInt/NZGcd.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -107,8 +107,8 @@ Proof.
now rewrite Hr, Hq, mul_assoc.
Qed.
-Instance divide_reflexive : Reflexive divide := divide_refl.
-Instance divide_transitive : Transitive divide := divide_trans.
+Instance divide_reflexive : Reflexive divide | 5 := divide_refl.
+Instance divide_transitive : Transitive divide | 5 := divide_trans.
(** Due to sign, no general antisymmetry result *)
diff --git a/theories/Numbers/NatInt/NZLog.v b/theories/Numbers/NatInt/NZLog.v
index 72f5e516..9cd1f877 100644
--- a/theories/Numbers/NatInt/NZLog.v
+++ b/theories/Numbers/NatInt/NZLog.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Numbers/NatInt/NZMul.v b/theories/Numbers/NatInt/NZMul.v
index a3419383..89ace4de 100644
--- a/theories/Numbers/NatInt/NZMul.v
+++ b/theories/Numbers/NatInt/NZMul.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Numbers/NatInt/NZMulOrder.v b/theories/Numbers/NatInt/NZMulOrder.v
index ef5250fa..e79e50a9 100644
--- a/theories/Numbers/NatInt/NZMulOrder.v
+++ b/theories/Numbers/NatInt/NZMulOrder.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Numbers/NatInt/NZOrder.v b/theories/Numbers/NatInt/NZOrder.v
index 0f7be085..c1e83529 100644
--- a/theories/Numbers/NatInt/NZOrder.v
+++ b/theories/Numbers/NatInt/NZOrder.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -644,6 +644,8 @@ End NZOrderProp.
(** If we have moreover a [compare] function, we can build
an [OrderedType] structure. *)
+(* Temporary workaround for bug #2949: remove this problematic + unused functor
Module NZOrderedType (NZ : NZDecOrdSig')
<: DecidableTypeFull <: OrderedTypeFull
- := NZ <+ NZBaseProp <+ NZOrderProp NZ <+ Compare2EqBool <+ HasEqBool2Dec.
+ := NZ <+ NZBaseProp <+ NZOrderProp <+ Compare2EqBool <+ HasEqBool2Dec.
+*)
diff --git a/theories/Numbers/NatInt/NZParity.v b/theories/Numbers/NatInt/NZParity.v
index 074fbfdd..6b9a680a 100644
--- a/theories/Numbers/NatInt/NZParity.v
+++ b/theories/Numbers/NatInt/NZParity.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -95,7 +95,7 @@ Proof.
intros.
generalize (Even_or_Odd n) (Even_Odd_False n).
rewrite <- even_spec, <- odd_spec.
- destruct (odd n), (even n); simpl; intuition.
+ destruct (odd n), (even n) ; simpl; intuition.
Qed.
Lemma negb_even : forall n, negb (even n) = odd n.
diff --git a/theories/Numbers/NatInt/NZPow.v b/theories/Numbers/NatInt/NZPow.v
index d2d34190..38452119 100644
--- a/theories/Numbers/NatInt/NZPow.v
+++ b/theories/Numbers/NatInt/NZPow.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -30,7 +30,7 @@ Module Type NZPowSpec (Import A : NZOrdAxiomsSig')(Import B : Pow' A).
End NZPowSpec.
(** The above [pow_neg_r] specification is useless (and trivially
- provable) for N. Having it here allows to already derive
+ provable) for N. Having it here already allows deriving
some slightly more general statements. *)
Module Type NZPow (A : NZOrdAxiomsSig) := Pow A <+ NZPowSpec A.
diff --git a/theories/Numbers/NatInt/NZProperties.v b/theories/Numbers/NatInt/NZProperties.v
index f44f23e9..0f3a5caf 100644
--- a/theories/Numbers/NatInt/NZProperties.v
+++ b/theories/Numbers/NatInt/NZProperties.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Numbers/NatInt/NZSqrt.v b/theories/Numbers/NatInt/NZSqrt.v
index 304a84a8..894c0806 100644
--- a/theories/Numbers/NatInt/NZSqrt.v
+++ b/theories/Numbers/NatInt/NZSqrt.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -66,7 +66,7 @@ Qed.
Lemma sqrt_unique : forall a b, b² <= a < (S b)² -> √a == b.
Proof.
intros a b (LEb,LTb).
- assert (Ha : 0<=a) by (transitivity b²; trivial using square_nonneg).
+ assert (Ha : 0<=a) by (transitivity (b²); trivial using square_nonneg).
assert (Hb : 0<=b) by (apply sqrt_spec_nonneg; order).
assert (Ha': 0<=√a) by now apply sqrt_nonneg.
destruct (sqrt_spec a Ha) as (LEa,LTa).
@@ -438,7 +438,7 @@ Instance sqrt_up_wd : Proper (eq==>eq) sqrt_up.
Proof.
assert (Proper (eq==>eq==>Logic.eq) compare).
intros x x' Hx y y' Hy. do 2 case compare_spec; trivial; order.
- intros x x' Hx. unfold sqrt_up. rewrite Hx. case compare; now rewrite ?Hx.
+ intros x x' Hx; unfold sqrt_up; rewrite Hx; case compare; now rewrite ?Hx.
Qed.
(** The spec of [sqrt_up] indeed determines it *)
diff --git a/theories/Numbers/Natural/Abstract/NAdd.v b/theories/Numbers/Natural/Abstract/NAdd.v
index e2dabf0e..638cfc7e 100644
--- a/theories/Numbers/Natural/Abstract/NAdd.v
+++ b/theories/Numbers/Natural/Abstract/NAdd.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Numbers/Natural/Abstract/NAddOrder.v b/theories/Numbers/Natural/Abstract/NAddOrder.v
index 94dc9e79..144bce72 100644
--- a/theories/Numbers/Natural/Abstract/NAddOrder.v
+++ b/theories/Numbers/Natural/Abstract/NAddOrder.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Numbers/Natural/Abstract/NAxioms.v b/theories/Numbers/Natural/Abstract/NAxioms.v
index c783478d..d300f857 100644
--- a/theories/Numbers/Natural/Abstract/NAxioms.v
+++ b/theories/Numbers/Natural/Abstract/NAxioms.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Numbers/Natural/Abstract/NBase.v b/theories/Numbers/Natural/Abstract/NBase.v
index a2bf4109..40453214 100644
--- a/theories/Numbers/Natural/Abstract/NBase.v
+++ b/theories/Numbers/Natural/Abstract/NBase.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Numbers/Natural/Abstract/NBits.v b/theories/Numbers/Natural/Abstract/NBits.v
index d368cc4e..6f8a8fe5 100644
--- a/theories/Numbers/Natural/Abstract/NBits.v
+++ b/theories/Numbers/Natural/Abstract/NBits.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Numbers/Natural/Abstract/NDefOps.v b/theories/Numbers/Natural/Abstract/NDefOps.v
index 882bb850..892b9266 100644
--- a/theories/Numbers/Natural/Abstract/NDefOps.v
+++ b/theories/Numbers/Natural/Abstract/NDefOps.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -133,7 +133,6 @@ Proof.
intros m n; unfold ltb at 1.
f_equiv.
rewrite recursion_succ; f_equiv'.
-reflexivity.
Qed.
(* Above, we rewrite applications of function. Is it possible to rewrite
diff --git a/theories/Numbers/Natural/Abstract/NDiv.v b/theories/Numbers/Natural/Abstract/NDiv.v
index 90a4e9e8..fb68c139 100644
--- a/theories/Numbers/Natural/Abstract/NDiv.v
+++ b/theories/Numbers/Natural/Abstract/NDiv.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Numbers/Natural/Abstract/NGcd.v b/theories/Numbers/Natural/Abstract/NGcd.v
index ff38b364..a1f4ddf8 100644
--- a/theories/Numbers/Natural/Abstract/NGcd.v
+++ b/theories/Numbers/Natural/Abstract/NGcd.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Numbers/Natural/Abstract/NIso.v b/theories/Numbers/Natural/Abstract/NIso.v
index 00f91311..c296315d 100644
--- a/theories/Numbers/Natural/Abstract/NIso.v
+++ b/theories/Numbers/Natural/Abstract/NIso.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Numbers/Natural/Abstract/NLcm.v b/theories/Numbers/Natural/Abstract/NLcm.v
index 6236360b..0fe8e105 100644
--- a/theories/Numbers/Natural/Abstract/NLcm.v
+++ b/theories/Numbers/Natural/Abstract/NLcm.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Numbers/Natural/Abstract/NLog.v b/theories/Numbers/Natural/Abstract/NLog.v
index f3418ef8..605c0aad 100644
--- a/theories/Numbers/Natural/Abstract/NLog.v
+++ b/theories/Numbers/Natural/Abstract/NLog.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Numbers/Natural/Abstract/NMaxMin.v b/theories/Numbers/Natural/Abstract/NMaxMin.v
index 9fa4114b..e0710561 100644
--- a/theories/Numbers/Natural/Abstract/NMaxMin.v
+++ b/theories/Numbers/Natural/Abstract/NMaxMin.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Numbers/Natural/Abstract/NMulOrder.v b/theories/Numbers/Natural/Abstract/NMulOrder.v
index 2aaf20ef..c41275d2 100644
--- a/theories/Numbers/Natural/Abstract/NMulOrder.v
+++ b/theories/Numbers/Natural/Abstract/NMulOrder.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Numbers/Natural/Abstract/NOrder.v b/theories/Numbers/Natural/Abstract/NOrder.v
index a46207ec..90053a73 100644
--- a/theories/Numbers/Natural/Abstract/NOrder.v
+++ b/theories/Numbers/Natural/Abstract/NOrder.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Numbers/Natural/Abstract/NParity.v b/theories/Numbers/Natural/Abstract/NParity.v
index 62d71eae..b3526c9a 100644
--- a/theories/Numbers/Natural/Abstract/NParity.v
+++ b/theories/Numbers/Natural/Abstract/NParity.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Numbers/Natural/Abstract/NPow.v b/theories/Numbers/Natural/Abstract/NPow.v
index c35757af..9cc23004 100644
--- a/theories/Numbers/Natural/Abstract/NPow.v
+++ b/theories/Numbers/Natural/Abstract/NPow.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Numbers/Natural/Abstract/NProperties.v b/theories/Numbers/Natural/Abstract/NProperties.v
index 575ede4f..cb3501d4 100644
--- a/theories/Numbers/Natural/Abstract/NProperties.v
+++ b/theories/Numbers/Natural/Abstract/NProperties.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -9,9 +9,20 @@
Require Export NAxioms.
Require Import NMaxMin NParity NPow NSqrt NLog NDiv NGcd NLcm NBits.
-(** This functor summarizes all known facts about N. *)
+(** The two following functors summarize all known facts about N.
-Module Type NProp (N:NAxiomsSig) :=
- NMaxMinProp N <+ NParityProp N <+ NPowProp N <+ NSqrtProp N
- <+ NLog2Prop N <+ NDivProp N <+ NGcdProp N <+ NLcmProp N
- <+ NBitsProp N.
+ - [NBasicProp] provides properties of basic functions:
+ + - * min max <= <
+
+ - [NExtraProp] provides properties of advanced functions:
+ pow, sqrt, log2, div, gcd, and bitwise functions.
+
+ If necessary, the earlier all-in-one functor [NProp]
+ could be re-obtained via [NBasicProp <+ NExtraProp] *)
+
+Module Type NBasicProp (N:NAxiomsMiniSig) := NMaxMinProp N.
+
+Module Type NExtraProp (N:NAxiomsSig)(P:NBasicProp N) :=
+ NParityProp N P <+ NPowProp N P <+ NSqrtProp N P
+ <+ NLog2Prop N P <+ NDivProp N P <+ NGcdProp N P <+ NLcmProp N P
+ <+ NBitsProp N P.
diff --git a/theories/Numbers/Natural/Abstract/NSqrt.v b/theories/Numbers/Natural/Abstract/NSqrt.v
index bc989a81..8dc66884 100644
--- a/theories/Numbers/Natural/Abstract/NSqrt.v
+++ b/theories/Numbers/Natural/Abstract/NSqrt.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Numbers/Natural/Abstract/NStrongRec.v b/theories/Numbers/Natural/Abstract/NStrongRec.v
index 7ec44dec..896ffc18 100644
--- a/theories/Numbers/Natural/Abstract/NStrongRec.v
+++ b/theories/Numbers/Natural/Abstract/NStrongRec.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -13,7 +13,7 @@ and proves its properties *)
Require Export NSub.
-Ltac f_equiv' := repeat progress (f_equiv; try intros ? ? ?; auto).
+Ltac f_equiv' := repeat (repeat f_equiv; try intros ? ? ?; auto).
Module NStrongRecProp (Import N : NAxiomsRecSig').
Include NSubProp N.
@@ -24,7 +24,7 @@ Variable A : Type.
Variable Aeq : relation A.
Variable Aeq_equiv : Equivalence Aeq.
-(** [strong_rec] allows to define a recursive function [phi] given by
+(** [strong_rec] allows defining a recursive function [phi] given by
an equation [phi(n) = F(phi)(n)] where recursive calls to [phi]
in [F] are made on strictly lower numbers than [n].
@@ -82,7 +82,6 @@ Proof.
intros. unfold strong_rec0.
f_equiv.
rewrite recursion_succ; f_equiv'.
-reflexivity.
Qed.
Lemma strong_rec_0 : forall a,
diff --git a/theories/Numbers/Natural/Abstract/NSub.v b/theories/Numbers/Natural/Abstract/NSub.v
index db61dd9b..18ebe77b 100644
--- a/theories/Numbers/Natural/Abstract/NSub.v
+++ b/theories/Numbers/Natural/Abstract/NSub.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Numbers/Natural/BigN/BigN.v b/theories/Numbers/Natural/BigN/BigN.v
index 89b65617..f7f4347b 100644
--- a/theories/Numbers/Natural/BigN/BigN.v
+++ b/theories/Numbers/Natural/BigN/BigN.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -28,23 +28,13 @@ Require Import CyclicAxioms Cyclic31 Ring31 NSig NSigNAxioms NMake
Delimit Scope bigN_scope with bigN.
-Module BigN <: NType <: OrderedTypeFull <: TotalOrder.
- Include NMake.Make Int31Cyclic [scope abstract_scope to bigN_scope].
- Bind Scope bigN_scope with t t'.
- Include NTypeIsNAxioms
- <+ NProp [no inline]
+Module BigN <: NType <: OrderedTypeFull <: TotalOrder :=
+ NMake.Make Int31Cyclic
+ <+ NTypeIsNAxioms
+ <+ NBasicProp [no inline] <+ NExtraProp [no inline]
<+ HasEqBool2Dec [no inline]
<+ MinMaxLogicalProperties [no inline]
<+ MinMaxDecProperties [no inline].
-End BigN.
-
-(** Nota concerning scopes : for the first Include, we cannot bind
- the scope bigN_scope to a type that doesn't exists yet.
- We hence need to explicitely declare the scope substitution.
- For the next Include, the abstract type t (in scope abstract_scope)
- gets substituted to concrete BigN.t (in scope bigN_scope),
- and the corresponding argument scope are fixed automatically.
-*)
(** Notations about [BigN] *)
diff --git a/theories/Numbers/Natural/BigN/NMake.v b/theories/Numbers/Natural/BigN/NMake.v
index d280a04b..bdcdd5ca 100644
--- a/theories/Numbers/Natural/BigN/NMake.v
+++ b/theories/Numbers/Natural/BigN/NMake.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -146,7 +146,7 @@ Module Make (W0:CyclicType) <: NType.
Theorem spec_add: forall x y, [add x y] = [x] + [y].
Proof.
intros x y. rewrite add_fold. apply spec_same_level; clear x y.
- intros n x y. simpl.
+ intros n x y. cbv beta iota zeta.
generalize (ZnZ.spec_add_c x y); case ZnZ.add_c; intros z H.
rewrite spec_mk_t. assumption.
rewrite spec_mk_t_S. unfold interp_carry in H.
@@ -242,8 +242,8 @@ Module Make (W0:CyclicType) <: NType.
Definition comparen_m n :
forall m, word (dom_t n) (S m) -> dom_t n -> comparison :=
let op := dom_op n in
- let zero := @ZnZ.zero _ op in
- let compare := @ZnZ.compare _ op in
+ let zero := ZnZ.zero (Ops:=op) in
+ let compare := ZnZ.compare (Ops:=op) in
let compare0 := compare zero in
fun m => compare_mn_1 (dom_t n) (dom_t n) zero compare compare0 compare (S m).
@@ -273,7 +273,7 @@ Module Make (W0:CyclicType) <: NType.
Local Notation compare_folded :=
(iter_sym _
- (fun n => @ZnZ.compare _ (dom_op n))
+ (fun n => ZnZ.compare (Ops:=dom_op n))
comparen_m
comparenm
CompOpp).
@@ -358,13 +358,13 @@ Module Make (W0:CyclicType) <: NType.
Definition wn_mul n : forall m, word (dom_t n) (S m) -> dom_t n -> t :=
let op := dom_op n in
- let zero := @ZnZ.zero _ op in
- let succ := @ZnZ.succ _ op in
- let add_c := @ZnZ.add_c _ op in
- let mul_c := @ZnZ.mul_c _ op in
+ let zero := ZnZ.zero in
+ let succ := ZnZ.succ (Ops:=op) in
+ let add_c := ZnZ.add_c (Ops:=op) in
+ let mul_c := ZnZ.mul_c (Ops:=op) in
let ww := @ZnZ.WW _ op in
let ow := @ZnZ.OW _ op in
- let eq0 := @ZnZ.eq0 _ op in
+ let eq0 := ZnZ.eq0 in
let mul_add := @DoubleMul.w_mul_add _ zero succ add_c mul_c in
let mul_add_n1 := @DoubleMul.double_mul_add_n1 _ zero ww ow mul_add in
fun m x y =>
@@ -464,18 +464,18 @@ Module Make (W0:CyclicType) <: NType.
Definition wn_divn1 n :=
let op := dom_op n in
let zd := ZnZ.zdigits op in
- let zero := @ZnZ.zero _ op in
- let ww := @ZnZ.WW _ op in
- let head0 := @ZnZ.head0 _ op in
- let add_mul_div := @ZnZ.add_mul_div _ op in
- let div21 := @ZnZ.div21 _ op in
- let compare := @ZnZ.compare _ op in
- let sub := @ZnZ.sub _ op in
+ let zero := ZnZ.zero in
+ let ww := ZnZ.WW in
+ let head0 := ZnZ.head0 in
+ let add_mul_div := ZnZ.add_mul_div in
+ let div21 := ZnZ.div21 in
+ let compare := ZnZ.compare in
+ let sub := ZnZ.sub in
let ddivn1 :=
DoubleDivn1.double_divn1 zd zero ww head0 add_mul_div div21 compare sub in
fun m x y => let (u,v) := ddivn1 (S m) x y in (mk_t_w' n m u, mk_t n v).
- Let div_gtnm n m wx wy :=
+ Definition div_gtnm n m wx wy :=
let mn := Max.max n m in
let d := diff n m in
let op := make_op mn in
@@ -522,7 +522,7 @@ Module Make (W0:CyclicType) <: NType.
case (ZnZ.spec_to_Z y); auto.
Qed.
- Let spec_divn1 n :=
+ Definition spec_divn1 n :=
DoubleDivn1.spec_double_divn1
(ZnZ.zdigits (dom_op n)) (ZnZ.zero:dom_t n)
ZnZ.WW ZnZ.head0
@@ -633,17 +633,17 @@ Module Make (W0:CyclicType) <: NType.
Definition wn_modn1 n :=
let op := dom_op n in
let zd := ZnZ.zdigits op in
- let zero := @ZnZ.zero _ op in
- let head0 := @ZnZ.head0 _ op in
- let add_mul_div := @ZnZ.add_mul_div _ op in
- let div21 := @ZnZ.div21 _ op in
- let compare := @ZnZ.compare _ op in
- let sub := @ZnZ.sub _ op in
+ let zero := ZnZ.zero in
+ let head0 := ZnZ.head0 in
+ let add_mul_div := ZnZ.add_mul_div in
+ let div21 := ZnZ.div21 in
+ let compare := ZnZ.compare in
+ let sub := ZnZ.sub in
let dmodn1 :=
DoubleDivn1.double_modn1 zd zero head0 add_mul_div div21 compare sub in
fun m x y => reduce n (dmodn1 (S m) x y).
- Let mod_gtnm n m wx wy :=
+ Definition mod_gtnm n m wx wy :=
let mn := Max.max n m in
let d := diff n m in
let op := make_op mn in
@@ -671,7 +671,7 @@ Module Make (W0:CyclicType) <: NType.
reflexivity.
Qed.
- Let spec_modn1 n :=
+ Definition spec_modn1 n :=
DoubleDivn1.spec_double_modn1
(ZnZ.zdigits (dom_op n)) (ZnZ.zero:dom_t n)
ZnZ.WW ZnZ.head0
@@ -1617,40 +1617,90 @@ Module Make (W0:CyclicType) <: NType.
rewrite spec_shiftr, spec_1. apply Z.div2_spec.
Qed.
- (** TODO : provide efficient versions instead of just converting
- from/to N (see with Laurent) *)
+ Local Notation lorn := (fun n =>
+ let op := dom_op n in
+ let lor := ZnZ.lor in
+ fun x y => reduce n (lor x y)).
+
+ Definition lor : t -> t -> t := Eval red_t in same_level lorn.
- Definition lor x y := of_N (N.lor (to_N x) (to_N y)).
- Definition land x y := of_N (N.land (to_N x) (to_N y)).
- Definition ldiff x y := of_N (N.ldiff (to_N x) (to_N y)).
- Definition lxor x y := of_N (N.lxor (to_N x) (to_N y)).
+ Lemma lor_fold : lor = same_level lorn.
+ Proof. red_t; reflexivity. Qed.
- Lemma spec_land: forall x y, [land x y] = Z.land [x] [y].
+ Theorem spec_lor x y : [lor x y] = Z.lor [x] [y].
Proof.
- intros x y. unfold land. rewrite spec_of_N. unfold to_N.
- generalize (spec_pos x), (spec_pos y).
- destruct [x], [y]; trivial; (now destruct 1) || (now destruct 2).
+ rewrite lor_fold. apply spec_same_level; clear x y.
+ intros n x y. simpl. rewrite spec_reduce. apply ZnZ.spec_lor.
Qed.
- Lemma spec_lor: forall x y, [lor x y] = Z.lor [x] [y].
+ Local Notation landn := (fun n =>
+ let op := dom_op n in
+ let land := ZnZ.land in
+ fun x y => reduce n (land x y)).
+
+ Definition land : t -> t -> t := Eval red_t in same_level landn.
+
+ Lemma land_fold : land = same_level landn.
+ Proof. red_t; reflexivity. Qed.
+
+ Theorem spec_land x y : [land x y] = Z.land [x] [y].
Proof.
- intros x y. unfold lor. rewrite spec_of_N. unfold to_N.
- generalize (spec_pos x), (spec_pos y).
- destruct [x], [y]; trivial; (now destruct 1) || (now destruct 2).
+ rewrite land_fold. apply spec_same_level; clear x y.
+ intros n x y. simpl. rewrite spec_reduce. apply ZnZ.spec_land.
Qed.
- Lemma spec_ldiff: forall x y, [ldiff x y] = Z.ldiff [x] [y].
+ Local Notation lxorn := (fun n =>
+ let op := dom_op n in
+ let lxor := ZnZ.lxor in
+ fun x y => reduce n (lxor x y)).
+
+ Definition lxor : t -> t -> t := Eval red_t in same_level lxorn.
+
+ Lemma lxor_fold : lxor = same_level lxorn.
+ Proof. red_t; reflexivity. Qed.
+
+ Theorem spec_lxor x y : [lxor x y] = Z.lxor [x] [y].
Proof.
- intros x y. unfold ldiff. rewrite spec_of_N. unfold to_N.
- generalize (spec_pos x), (spec_pos y).
- destruct [x], [y]; trivial; (now destruct 1) || (now destruct 2).
+ rewrite lxor_fold. apply spec_same_level; clear x y.
+ intros n x y. simpl. rewrite spec_reduce. apply ZnZ.spec_lxor.
Qed.
- Lemma spec_lxor: forall x y, [lxor x y] = Z.lxor [x] [y].
- Proof.
- intros x y. unfold lxor. rewrite spec_of_N. unfold to_N.
- generalize (spec_pos x), (spec_pos y).
- destruct [x], [y]; trivial; (now destruct 1) || (now destruct 2).
+ Local Notation ldiffn := (fun n =>
+ let op := dom_op n in
+ let lxor := ZnZ.lxor in
+ let land := ZnZ.land in
+ let m1 := ZnZ.minus_one in
+ fun x y => reduce n (land x (lxor y m1))).
+
+ Definition ldiff : t -> t -> t := Eval red_t in same_level ldiffn.
+
+ Lemma ldiff_fold : ldiff = same_level ldiffn.
+ Proof. red_t; reflexivity. Qed.
+
+ Lemma ldiff_alt x y p :
+ 0 <= x < 2^p -> 0 <= y < 2^p ->
+ Z.ldiff x y = Z.land x (Z.lxor y (2^p - 1)).
+ Proof.
+ intros (Hx,Hx') (Hy,Hy').
+ destruct p as [|p|p].
+ - simpl in *; replace x with 0; replace y with 0; auto with zarith.
+ - rewrite <- Z.shiftl_1_l. change (_ - 1) with (Z.ones (Z.pos p)).
+ rewrite <- Z.ldiff_ones_l_low; trivial.
+ rewrite !Z.ldiff_land, Z.land_assoc. f_equal.
+ rewrite Z.land_ones; try easy.
+ symmetry. apply Z.mod_small; now split.
+ Z.le_elim Hy.
+ + now apply Z.log2_lt_pow2.
+ + now subst.
+ - simpl in *; omega.
+ Qed.
+
+ Theorem spec_ldiff x y : [ldiff x y] = Z.ldiff [x] [y].
+ Proof.
+ rewrite ldiff_fold. apply spec_same_level; clear x y.
+ intros n x y. simpl. rewrite spec_reduce.
+ rewrite ZnZ.spec_land, ZnZ.spec_lxor, ZnZ.spec_m1.
+ symmetry. apply ldiff_alt; apply ZnZ.spec_to_Z.
Qed.
End Make.
diff --git a/theories/Numbers/Natural/BigN/NMake_gen.ml b/theories/Numbers/Natural/BigN/NMake_gen.ml
index 9e4e88c5..6de77e0a 100644
--- a/theories/Numbers/Natural/BigN/NMake_gen.ml
+++ b/theories/Numbers/Natural/BigN/NMake_gen.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -138,8 +138,6 @@ pr
pr "";
pr " Definition t := t'.";
pr "";
- pr " Bind Scope abstract_scope with t t'.";
- pr "";
pr " (** * A generic toolbox for building and deconstructing [t] *)";
pr "";
@@ -234,7 +232,7 @@ pr
| S n1 => mk_zn2z_ops (nmake_op ww ww_op n1)
end.
- Let eval n m := ZnZ.to_Z (Ops:=nmake_op _ (dom_op n) m).
+ Definition eval n m := ZnZ.to_Z (Ops:=nmake_op _ (dom_op n) m).
Theorem nmake_op_S: forall ww (w_op: ZnZ.Ops ww) x,
nmake_op _ w_op (S x) = mk_zn2z_ops (nmake_op _ w_op x).
@@ -326,8 +324,13 @@ pr "
Lemma spec_zeron : forall n, ZnZ.to_Z (zeron n) = 0%%Z.
Proof.
- do_size (destruct n; [exact ZnZ.spec_0|]).
- destruct n; auto. simpl. rewrite make_op_S. exact ZnZ.spec_0.
+ do_size (destruct n;
+ [match goal with
+ |- @eq Z (_ (zeron ?n)) _ =>
+ apply (ZnZ.spec_0 (Specs:=dom_spec n))
+ end|]).
+ destruct n; auto. simpl. rewrite make_op_S. fold word.
+ apply (ZnZ.spec_0 (Specs:=wn_spec (SizePlus 0))).
Qed.
(** * Digits *)
@@ -533,7 +536,7 @@ pr "
for i = 0 to size-1 do
let pattern = (iter_str (size+1-i) "(S ") ^ "_" ^ (iter_str (size+1-i) ")") in
pr
-" Let mk_t_%iw m := Eval cbv beta zeta iota delta [ mk_t plus ] in
+" Definition mk_t_%iw m := Eval cbv beta zeta iota delta [ mk_t plus ] in
match m return word w%i (S m) -> t with
| %s as p => mk_t_w %i (S p)
| p => mk_t (%i+p)
@@ -542,7 +545,7 @@ pr
done;
pr
-" Let mk_t_w' n : forall m, word (dom_t n) (S m) -> t :=
+" Definition mk_t_w' n : forall m, word (dom_t n) (S m) -> t :=
match n return (forall m, word (dom_t n) (S m) -> t) with";
for i = 0 to size-1 do pr " | %i => mk_t_%iw" i i done;
pr
@@ -958,6 +961,11 @@ pr " end.";
pr "";
pr " Ltac unfold_red := unfold reduce, %s." (iter_name 1 size "reduce_" ",");
+pr "";
+for i = 0 to size do
+pr " Declare Equivalent Keys reduce reduce_%i." i;
+done;
+pr " Declare Equivalent Keys reduce_n reduce_%i." (size + 1);
pr "
Ltac solve_red :=
diff --git a/theories/Numbers/Natural/BigN/Nbasic.v b/theories/Numbers/Natural/BigN/Nbasic.v
index e545508d..8fe9ea92 100644
--- a/theories/Numbers/Natural/BigN/Nbasic.v
+++ b/theories/Numbers/Natural/BigN/Nbasic.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -320,6 +320,7 @@ Section CompareRec.
Let double_to_Z_pos: forall n x, 0 <= double_to_Z n x < double_wB n :=
(spec_double_to_Z wm_base wm_to_Z wm_to_Z_pos).
+ Declare Equivalent Keys compare0_mn compare0_m.
Lemma spec_compare0_mn: forall n x,
compare0_mn n x = (0 ?= double_to_Z n x).
@@ -371,7 +372,7 @@ Section CompareRec.
intros n (H0, H); split; auto.
apply Z.lt_le_trans with (1:= H).
unfold double_wB, DoubleBase.double_wB; simpl.
- rewrite Pshiftl_nat_S, base_xO.
+ rewrite base_xO.
set (u := base (Pos.shiftl_nat wm_base n)).
assert (0 < u).
unfold u, base; auto with zarith.
diff --git a/theories/Numbers/Natural/Binary/NBinary.v b/theories/Numbers/Natural/Binary/NBinary.v
index f95167ad..d54bedd1 100644
--- a/theories/Numbers/Natural/Binary/NBinary.v
+++ b/theories/Numbers/Natural/Binary/NBinary.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Numbers/Natural/Peano/NPeano.v b/theories/Numbers/Natural/Peano/NPeano.v
index f438df40..96eb7b35 100644
--- a/theories/Numbers/Natural/Peano/NPeano.v
+++ b/theories/Numbers/Natural/Peano/NPeano.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -8,806 +8,8 @@
(* Evgeny Makarov, INRIA, 2007 *)
(************************************************************************)
-Require Import
- Bool Peano Peano_dec Compare_dec Plus Mult Minus Le Lt EqNat Div2 Wf_nat
- NAxioms NProperties.
+Require Import PeanoNat NAxioms.
-(** Functions not already defined *)
+(** * [PeanoNat.Nat] already implements [NAxiomSig] *)
-Fixpoint leb n m :=
- match n, m with
- | O, _ => true
- | _, O => false
- | S n', S m' => leb n' m'
- end.
-
-Definition ltb n m := leb (S n) m.
-
-Infix "<=?" := leb (at level 70) : nat_scope.
-Infix "<?" := ltb (at level 70) : nat_scope.
-
-Lemma leb_le n m : (n <=? m) = true <-> n <= m.
-Proof.
- revert m.
- induction n. split; auto with arith.
- destruct m; simpl. now split.
- rewrite IHn. split; auto with arith.
-Qed.
-
-Lemma ltb_lt n m : (n <? m) = true <-> n < m.
-Proof.
- unfold ltb, lt. apply leb_le.
-Qed.
-
-Fixpoint pow n m :=
- match m with
- | O => 1
- | S m => n * (pow n m)
- end.
-
-Infix "^" := pow : nat_scope.
-
-Lemma pow_0_r : forall a, a^0 = 1.
-Proof. reflexivity. Qed.
-
-Lemma pow_succ_r : forall a b, 0<=b -> a^(S b) = a * a^b.
-Proof. reflexivity. Qed.
-
-Definition square n := n * n.
-
-Lemma square_spec n : square n = n * n.
-Proof. reflexivity. Qed.
-
-Definition Even n := exists m, n = 2*m.
-Definition Odd n := exists m, n = 2*m+1.
-
-Fixpoint even n :=
- match n with
- | O => true
- | 1 => false
- | S (S n') => even n'
- end.
-
-Definition odd n := negb (even n).
-
-Lemma even_spec : forall n, even n = true <-> Even n.
-Proof.
- fix 1.
- destruct n as [|[|n]]; simpl; try rewrite even_spec; split.
- now exists 0.
- trivial.
- discriminate.
- intros (m,H). destruct m. discriminate.
- simpl in H. rewrite <- plus_n_Sm in H. discriminate.
- intros (m,H). exists (S m). rewrite H. simpl. now rewrite plus_n_Sm.
- intros (m,H). destruct m. discriminate. exists m.
- simpl in H. rewrite <- plus_n_Sm in H. inversion H. reflexivity.
-Qed.
-
-Lemma odd_spec : forall n, odd n = true <-> Odd n.
-Proof.
- unfold odd.
- fix 1.
- destruct n as [|[|n]]; simpl; try rewrite odd_spec; split.
- discriminate.
- intros (m,H). rewrite <- plus_n_Sm in H; discriminate.
- now exists 0.
- trivial.
- intros (m,H). exists (S m). rewrite H. simpl. now rewrite <- (plus_n_Sm m).
- intros (m,H). destruct m. discriminate. exists m.
- simpl in H. rewrite <- plus_n_Sm in H. inversion H. simpl.
- now rewrite <- !plus_n_Sm, <- !plus_n_O.
-Qed.
-
-Lemma Even_equiv : forall n, Even n <-> Even.even n.
-Proof.
- split. intros (p,->). apply Even.even_mult_l. do 3 constructor.
- intros H. destruct (even_2n n H) as (p,->).
- exists p. unfold double. simpl. now rewrite <- plus_n_O.
-Qed.
-
-Lemma Odd_equiv : forall n, Odd n <-> Even.odd n.
-Proof.
- split. intros (p,->). rewrite <- plus_n_Sm, <- plus_n_O.
- apply Even.odd_S. apply Even.even_mult_l. do 3 constructor.
- intros H. destruct (odd_S2n n H) as (p,->).
- exists p. unfold double. simpl. now rewrite <- plus_n_Sm, <- !plus_n_O.
-Qed.
-
-(* A linear, tail-recursive, division for nat.
-
- In [divmod], [y] is the predecessor of the actual divisor,
- and [u] is [y] minus the real remainder
-*)
-
-Fixpoint divmod x y q u :=
- match x with
- | 0 => (q,u)
- | S x' => match u with
- | 0 => divmod x' y (S q) y
- | S u' => divmod x' y q u'
- end
- end.
-
-Definition div x y :=
- match y with
- | 0 => y
- | S y' => fst (divmod x y' 0 y')
- end.
-
-Definition modulo x y :=
- match y with
- | 0 => y
- | S y' => y' - snd (divmod x y' 0 y')
- end.
-
-Infix "/" := div : nat_scope.
-Infix "mod" := modulo (at level 40, no associativity) : nat_scope.
-
-Lemma divmod_spec : forall x y q u, u <= y ->
- let (q',u') := divmod x y q u in
- x + (S y)*q + (y-u) = (S y)*q' + (y-u') /\ u' <= y.
-Proof.
- induction x. simpl. intuition.
- intros y q u H. destruct u; simpl divmod.
- generalize (IHx y (S q) y (le_n y)). destruct divmod as (q',u').
- intros (EQ,LE); split; trivial.
- rewrite <- EQ, <- minus_n_O, minus_diag, <- plus_n_O.
- now rewrite !plus_Sn_m, plus_n_Sm, <- plus_assoc, mult_n_Sm.
- generalize (IHx y q u (le_Sn_le _ _ H)). destruct divmod as (q',u').
- intros (EQ,LE); split; trivial.
- rewrite <- EQ.
- rewrite !plus_Sn_m, plus_n_Sm. f_equal. now apply minus_Sn_m.
-Qed.
-
-Lemma div_mod : forall x y, y<>0 -> x = y*(x/y) + x mod y.
-Proof.
- intros x y Hy.
- destruct y; [ now elim Hy | clear Hy ].
- unfold div, modulo.
- generalize (divmod_spec x y 0 y (le_n y)).
- destruct divmod as (q,u).
- intros (U,V).
- simpl in *.
- now rewrite <- mult_n_O, minus_diag, <- !plus_n_O in U.
-Qed.
-
-Lemma mod_bound_pos : forall x y, 0<=x -> 0<y -> 0 <= x mod y < y.
-Proof.
- intros x y Hx Hy. split. auto with arith.
- destruct y; [ now elim Hy | clear Hy ].
- unfold modulo.
- apply le_n_S, le_minus.
-Qed.
-
-(** Square root *)
-
-(** The following square root function is linear (and tail-recursive).
- With Peano representation, we can't do better. For faster algorithm,
- see Psqrt/Zsqrt/Nsqrt...
-
- We search the square root of n = k + p^2 + (q - r)
- with q = 2p and 0<=r<=q. We start with p=q=r=0, hence
- looking for the square root of n = k. Then we progressively
- decrease k and r. When k = S k' and r=0, it means we can use (S p)
- as new sqrt candidate, since (S k')+p^2+2p = k'+(S p)^2.
- When k reaches 0, we have found the biggest p^2 square contained
- in n, hence the square root of n is p.
-*)
-
-Fixpoint sqrt_iter k p q r :=
- match k with
- | O => p
- | S k' => match r with
- | O => sqrt_iter k' (S p) (S (S q)) (S (S q))
- | S r' => sqrt_iter k' p q r'
- end
- end.
-
-Definition sqrt n := sqrt_iter n 0 0 0.
-
-Lemma sqrt_iter_spec : forall k p q r,
- q = p+p -> r<=q ->
- let s := sqrt_iter k p q r in
- s*s <= k + p*p + (q - r) < (S s)*(S s).
-Proof.
- induction k.
- (* k = 0 *)
- simpl; intros p q r Hq Hr.
- split.
- apply le_plus_l.
- apply le_lt_n_Sm.
- rewrite <- mult_n_Sm.
- rewrite plus_assoc, (plus_comm p), <- plus_assoc.
- apply plus_le_compat; trivial.
- rewrite <- Hq. apply le_minus.
- (* k = S k' *)
- destruct r.
- (* r = 0 *)
- intros Hq _.
- replace (S k + p*p + (q-0)) with (k + (S p)*(S p) + (S (S q) - S (S q))).
- apply IHk.
- simpl. rewrite <- plus_n_Sm. congruence.
- auto with arith.
- rewrite minus_diag, <- minus_n_O, <- plus_n_O. simpl.
- rewrite <- plus_n_Sm; f_equal. rewrite <- plus_assoc; f_equal.
- rewrite <- mult_n_Sm, (plus_comm p), <- plus_assoc. congruence.
- (* r = S r' *)
- intros Hq Hr.
- replace (S k + p*p + (q-S r)) with (k + p*p + (q - r)).
- apply IHk; auto with arith.
- simpl. rewrite plus_n_Sm. f_equal. rewrite minus_Sn_m; auto.
-Qed.
-
-Lemma sqrt_spec : forall n,
- (sqrt n)*(sqrt n) <= n < S (sqrt n) * S (sqrt n).
-Proof.
- intros.
- set (s:=sqrt n).
- replace n with (n + 0*0 + (0-0)).
- apply sqrt_iter_spec; auto.
- simpl. now rewrite <- 2 plus_n_O.
-Qed.
-
-(** A linear tail-recursive base-2 logarithm
-
- In [log2_iter], we maintain the logarithm [p] of the counter [q],
- while [r] is the distance between [q] and the next power of 2,
- more precisely [q + S r = 2^(S p)] and [r<2^p]. At each
- recursive call, [q] goes up while [r] goes down. When [r]
- is 0, we know that [q] has almost reached a power of 2,
- and we increase [p] at the next call, while resetting [r]
- to [q].
-
- Graphically (numbers are [q], stars are [r]) :
-
-<<
- 10
- 9
- 8
- 7 *
- 6 *
- 5 ...
- 4
- 3 *
- 2 *
- 1 * *
-0 * * *
->>
-
- We stop when [k], the global downward counter reaches 0.
- At that moment, [q] is the number we're considering (since
- [k+q] is invariant), and [p] its logarithm.
-*)
-
-Fixpoint log2_iter k p q r :=
- match k with
- | O => p
- | S k' => match r with
- | O => log2_iter k' (S p) (S q) q
- | S r' => log2_iter k' p (S q) r'
- end
- end.
-
-Definition log2 n := log2_iter (pred n) 0 1 0.
-
-Lemma log2_iter_spec : forall k p q r,
- 2^(S p) = q + S r -> r < 2^p ->
- let s := log2_iter k p q r in
- 2^s <= k + q < 2^(S s).
-Proof.
- induction k.
- (* k = 0 *)
- intros p q r EQ LT. simpl log2_iter. cbv zeta.
- split.
- rewrite plus_O_n.
- apply plus_le_reg_l with (2^p).
- simpl pow in EQ. rewrite <- plus_n_O in EQ. rewrite EQ.
- rewrite plus_comm. apply plus_le_compat_r. now apply lt_le_S.
- rewrite EQ, plus_comm. apply plus_lt_compat_l. apply lt_0_Sn.
- (* k = S k' *)
- intros p q r EQ LT. destruct r.
- (* r = 0 *)
- rewrite <- plus_n_Sm, <- plus_n_O in EQ.
- rewrite plus_Sn_m, plus_n_Sm. apply IHk.
- rewrite <- EQ. remember (S p) as p'; simpl. now rewrite <- plus_n_O.
- unfold lt. now rewrite EQ.
- (* r = S r' *)
- rewrite plus_Sn_m, plus_n_Sm. apply IHk.
- now rewrite plus_Sn_m, plus_n_Sm.
- unfold lt.
- now apply lt_le_weak.
-Qed.
-
-Lemma log2_spec : forall n, 0<n ->
- 2^(log2 n) <= n < 2^(S (log2 n)).
-Proof.
- intros.
- set (s:=log2 n).
- replace n with (pred n + 1).
- apply log2_iter_spec; auto.
- rewrite <- plus_n_Sm, <- plus_n_O.
- symmetry. now apply S_pred with 0.
-Qed.
-
-Lemma log2_nonpos : forall n, n<=0 -> log2 n = 0.
-Proof.
- inversion 1; now subst.
-Qed.
-
-(** * Gcd *)
-
-(** We use Euclid algorithm, which is normally not structural,
- but Coq is now clever enough to accept this (behind modulo
- there is a subtraction, which now preserves being a subterm)
-*)
-
-Fixpoint gcd a b :=
- match a with
- | O => b
- | S a' => gcd (b mod (S a')) (S a')
- end.
-
-Definition divide x y := exists z, y=z*x.
-Notation "( x | y )" := (divide x y) (at level 0) : nat_scope.
-
-Lemma gcd_divide : forall a b, (gcd a b | a) /\ (gcd a b | b).
-Proof.
- fix 1.
- intros [|a] b; simpl.
- split.
- now exists 0.
- exists 1. simpl. now rewrite <- plus_n_O.
- fold (b mod (S a)).
- destruct (gcd_divide (b mod (S a)) (S a)) as (H,H').
- set (a':=S a) in *.
- split; auto.
- rewrite (div_mod b a') at 2 by discriminate.
- destruct H as (u,Hu), H' as (v,Hv).
- rewrite mult_comm.
- exists ((b/a')*v + u).
- rewrite mult_plus_distr_r.
- now rewrite <- mult_assoc, <- Hv, <- Hu.
-Qed.
-
-Lemma gcd_divide_l : forall a b, (gcd a b | a).
-Proof.
- intros. apply gcd_divide.
-Qed.
-
-Lemma gcd_divide_r : forall a b, (gcd a b | b).
-Proof.
- intros. apply gcd_divide.
-Qed.
-
-Lemma gcd_greatest : forall a b c, (c|a) -> (c|b) -> (c|gcd a b).
-Proof.
- fix 1.
- intros [|a] b; simpl; auto.
- fold (b mod (S a)).
- intros c H H'. apply gcd_greatest; auto.
- set (a':=S a) in *.
- rewrite (div_mod b a') in H' by discriminate.
- destruct H as (u,Hu), H' as (v,Hv).
- exists (v - (b/a')*u).
- rewrite mult_comm in Hv.
- now rewrite mult_minus_distr_r, <- Hv, <-mult_assoc, <-Hu, minus_plus.
-Qed.
-
-(** * Bitwise operations *)
-
-(** We provide here some bitwise operations for unary numbers.
- Some might be really naive, they are just there for fullfiling
- the same interface as other for natural representations. As
- soon as binary representations such as NArith are available,
- it is clearly better to convert to/from them and use their ops.
-*)
-
-Fixpoint testbit a n :=
- match n with
- | O => odd a
- | S n => testbit (div2 a) n
- end.
-
-Definition shiftl a n := iter_nat n _ double a.
-Definition shiftr a n := iter_nat n _ div2 a.
-
-Fixpoint bitwise (op:bool->bool->bool) n a b :=
- match n with
- | O => O
- | S n' =>
- (if op (odd a) (odd b) then 1 else 0) +
- 2*(bitwise op n' (div2 a) (div2 b))
- end.
-
-Definition land a b := bitwise andb a a b.
-Definition lor a b := bitwise orb (max a b) a b.
-Definition ldiff a b := bitwise (fun b b' => b && negb b') a a b.
-Definition lxor a b := bitwise xorb (max a b) a b.
-
-Lemma double_twice : forall n, double n = 2*n.
-Proof.
- simpl; intros. now rewrite <- plus_n_O.
-Qed.
-
-Lemma testbit_0_l : forall n, testbit 0 n = false.
-Proof.
- now induction n.
-Qed.
-
-Lemma testbit_odd_0 a : testbit (2*a+1) 0 = true.
-Proof.
- unfold testbit. rewrite odd_spec. now exists a.
-Qed.
-
-Lemma testbit_even_0 a : testbit (2*a) 0 = false.
-Proof.
- unfold testbit, odd. rewrite (proj2 (even_spec _)); trivial.
- now exists a.
-Qed.
-
-Lemma testbit_odd_succ a n : testbit (2*a+1) (S n) = testbit a n.
-Proof.
- unfold testbit; fold testbit.
- rewrite <- plus_n_Sm, <- plus_n_O. f_equal.
- apply div2_double_plus_one.
-Qed.
-
-Lemma testbit_even_succ a n : testbit (2*a) (S n) = testbit a n.
-Proof.
- unfold testbit; fold testbit. f_equal. apply div2_double.
-Qed.
-
-Lemma shiftr_spec : forall a n m,
- testbit (shiftr a n) m = testbit a (m+n).
-Proof.
- induction n; intros m. trivial.
- now rewrite <- plus_n_O.
- now rewrite <- plus_n_Sm, <- plus_Sn_m, <- IHn.
-Qed.
-
-Lemma shiftl_spec_high : forall a n m, n<=m ->
- testbit (shiftl a n) m = testbit a (m-n).
-Proof.
- induction n; intros m H. trivial.
- now rewrite <- minus_n_O.
- destruct m. inversion H.
- simpl. apply le_S_n in H.
- change (shiftl a (S n)) with (double (shiftl a n)).
- rewrite double_twice, div2_double. now apply IHn.
-Qed.
-
-Lemma shiftl_spec_low : forall a n m, m<n ->
- testbit (shiftl a n) m = false.
-Proof.
- induction n; intros m H. inversion H.
- change (shiftl a (S n)) with (double (shiftl a n)).
- destruct m; simpl.
- unfold odd. apply negb_false_iff.
- apply even_spec. exists (shiftl a n). apply double_twice.
- rewrite double_twice, div2_double. apply IHn.
- now apply lt_S_n.
-Qed.
-
-Lemma div2_bitwise : forall op n a b,
- div2 (bitwise op (S n) a b) = bitwise op n (div2 a) (div2 b).
-Proof.
- intros. unfold bitwise; fold bitwise.
- destruct (op (odd a) (odd b)).
- now rewrite div2_double_plus_one.
- now rewrite plus_O_n, div2_double.
-Qed.
-
-Lemma odd_bitwise : forall op n a b,
- odd (bitwise op (S n) a b) = op (odd a) (odd b).
-Proof.
- intros. unfold bitwise; fold bitwise.
- destruct (op (odd a) (odd b)).
- apply odd_spec. rewrite plus_comm. eexists; eauto.
- unfold odd. apply negb_false_iff. apply even_spec.
- rewrite plus_O_n; eexists; eauto.
-Qed.
-
-Lemma div2_decr : forall a n, a <= S n -> div2 a <= n.
-Proof.
- destruct a; intros. apply le_0_n.
- apply le_trans with a.
- apply lt_n_Sm_le, lt_div2, lt_0_Sn. now apply le_S_n.
-Qed.
-
-Lemma testbit_bitwise_1 : forall op, (forall b, op false b = false) ->
- forall n m a b, a<=n ->
- testbit (bitwise op n a b) m = op (testbit a m) (testbit b m).
-Proof.
- intros op Hop.
- induction n; intros m a b Ha.
- simpl. inversion Ha; subst. now rewrite testbit_0_l.
- destruct m.
- apply odd_bitwise.
- unfold testbit; fold testbit. rewrite div2_bitwise.
- apply IHn; now apply div2_decr.
-Qed.
-
-Lemma testbit_bitwise_2 : forall op, op false false = false ->
- forall n m a b, a<=n -> b<=n ->
- testbit (bitwise op n a b) m = op (testbit a m) (testbit b m).
-Proof.
- intros op Hop.
- induction n; intros m a b Ha Hb.
- simpl. inversion Ha; inversion Hb; subst. now rewrite testbit_0_l.
- destruct m.
- apply odd_bitwise.
- unfold testbit; fold testbit. rewrite div2_bitwise.
- apply IHn; now apply div2_decr.
-Qed.
-
-Lemma land_spec : forall a b n,
- testbit (land a b) n = testbit a n && testbit b n.
-Proof.
- intros. unfold land. apply testbit_bitwise_1; trivial.
-Qed.
-
-Lemma ldiff_spec : forall a b n,
- testbit (ldiff a b) n = testbit a n && negb (testbit b n).
-Proof.
- intros. unfold ldiff. apply testbit_bitwise_1; trivial.
-Qed.
-
-Lemma lor_spec : forall a b n,
- testbit (lor a b) n = testbit a n || testbit b n.
-Proof.
- intros. unfold lor. apply testbit_bitwise_2. trivial.
- destruct (le_ge_dec a b). now rewrite max_r. now rewrite max_l.
- destruct (le_ge_dec a b). now rewrite max_r. now rewrite max_l.
-Qed.
-
-Lemma lxor_spec : forall a b n,
- testbit (lxor a b) n = xorb (testbit a n) (testbit b n).
-Proof.
- intros. unfold lxor. apply testbit_bitwise_2. trivial.
- destruct (le_ge_dec a b). now rewrite max_r. now rewrite max_l.
- destruct (le_ge_dec a b). now rewrite max_r. now rewrite max_l.
-Qed.
-
-(** * Implementation of [NAxiomsSig] by [nat] *)
-
-Module Nat
- <: NAxiomsSig <: UsualDecidableTypeFull <: OrderedTypeFull <: TotalOrder.
-
-(** Bi-directional induction. *)
-
-Theorem bi_induction :
- forall A : nat -> Prop, Proper (eq==>iff) A ->
- A 0 -> (forall n : nat, A n <-> A (S n)) -> forall n : nat, A n.
-Proof.
-intros A A_wd A0 AS. apply nat_ind. assumption. intros; now apply -> AS.
-Qed.
-
-(** Basic operations. *)
-
-Definition eq_equiv : Equivalence (@eq nat) := eq_equivalence.
-Local Obligation Tactic := simpl_relation.
-Program Instance succ_wd : Proper (eq==>eq) S.
-Program Instance pred_wd : Proper (eq==>eq) pred.
-Program Instance add_wd : Proper (eq==>eq==>eq) plus.
-Program Instance sub_wd : Proper (eq==>eq==>eq) minus.
-Program Instance mul_wd : Proper (eq==>eq==>eq) mult.
-
-Theorem pred_succ : forall n : nat, pred (S n) = n.
-Proof.
-reflexivity.
-Qed.
-
-Theorem one_succ : 1 = S 0.
-Proof.
-reflexivity.
-Qed.
-
-Theorem two_succ : 2 = S 1.
-Proof.
-reflexivity.
-Qed.
-
-Theorem add_0_l : forall n : nat, 0 + n = n.
-Proof.
-reflexivity.
-Qed.
-
-Theorem add_succ_l : forall n m : nat, (S n) + m = S (n + m).
-Proof.
-reflexivity.
-Qed.
-
-Theorem sub_0_r : forall n : nat, n - 0 = n.
-Proof.
-intro n; now destruct n.
-Qed.
-
-Theorem sub_succ_r : forall n m : nat, n - (S m) = pred (n - m).
-Proof.
-induction n; destruct m; simpl; auto. apply sub_0_r.
-Qed.
-
-Theorem mul_0_l : forall n : nat, 0 * n = 0.
-Proof.
-reflexivity.
-Qed.
-
-Theorem mul_succ_l : forall n m : nat, S n * m = n * m + m.
-Proof.
-assert (add_S_r : forall n m, n+S m = S(n+m)) by (induction n; auto).
-assert (add_comm : forall n m, n+m = m+n).
- induction n; simpl; auto. intros; rewrite add_S_r; auto.
-intros n m; now rewrite add_comm.
-Qed.
-
-(** Order on natural numbers *)
-
-Program Instance lt_wd : Proper (eq==>eq==>iff) lt.
-
-Theorem lt_succ_r : forall n m : nat, n < S m <-> n <= m.
-Proof.
-unfold lt; split. apply le_S_n. induction 1; auto.
-Qed.
-
-
-Theorem lt_eq_cases : forall n m : nat, n <= m <-> n < m \/ n = m.
-Proof.
-split.
-inversion 1; auto. rewrite lt_succ_r; auto.
-destruct 1; [|subst; auto]. rewrite <- lt_succ_r; auto.
-Qed.
-
-Theorem lt_irrefl : forall n : nat, ~ (n < n).
-Proof.
-induction n. intro H; inversion H. rewrite lt_succ_r; auto.
-Qed.
-
-(** Facts specific to natural numbers, not integers. *)
-
-Theorem pred_0 : pred 0 = 0.
-Proof.
-reflexivity.
-Qed.
-
-(** Recursion fonction *)
-
-Definition recursion {A} : A -> (nat -> A -> A) -> nat -> A :=
- nat_rect (fun _ => A).
-
-Instance recursion_wd {A} (Aeq : relation A) :
- Proper (Aeq ==> (eq==>Aeq==>Aeq) ==> eq ==> Aeq) recursion.
-Proof.
-intros a a' Ha f f' Hf n n' Hn. subst n'.
-induction n; simpl; auto. apply Hf; auto.
-Qed.
-
-Theorem recursion_0 :
- forall {A} (a : A) (f : nat -> A -> A), recursion a f 0 = a.
-Proof.
-reflexivity.
-Qed.
-
-Theorem recursion_succ :
- forall {A} (Aeq : relation A) (a : A) (f : nat -> A -> A),
- Aeq a a -> Proper (eq==>Aeq==>Aeq) f ->
- forall n : nat, Aeq (recursion a f (S n)) (f n (recursion a f n)).
-Proof.
-unfold Proper, respectful in *; induction n; simpl; auto.
-Qed.
-
-(** The instantiation of operations.
- Placing them at the very end avoids having indirections in above lemmas. *)
-
-Definition t := nat.
-Definition eq := @eq nat.
-Definition eqb := beq_nat.
-Definition compare := nat_compare.
-Definition zero := 0.
-Definition one := 1.
-Definition two := 2.
-Definition succ := S.
-Definition pred := pred.
-Definition add := plus.
-Definition sub := minus.
-Definition mul := mult.
-Definition lt := lt.
-Definition le := le.
-Definition ltb := ltb.
-Definition leb := leb.
-
-Definition min := min.
-Definition max := max.
-Definition max_l := max_l.
-Definition max_r := max_r.
-Definition min_l := min_l.
-Definition min_r := min_r.
-
-Definition eqb_eq := beq_nat_true_iff.
-Definition compare_spec := nat_compare_spec.
-Definition eq_dec := eq_nat_dec.
-Definition leb_le := leb_le.
-Definition ltb_lt := ltb_lt.
-
-Definition Even := Even.
-Definition Odd := Odd.
-Definition even := even.
-Definition odd := odd.
-Definition even_spec := even_spec.
-Definition odd_spec := odd_spec.
-
-Program Instance pow_wd : Proper (eq==>eq==>eq) pow.
-Definition pow_0_r := pow_0_r.
-Definition pow_succ_r := pow_succ_r.
-Lemma pow_neg_r : forall a b, b<0 -> a^b = 0. inversion 1. Qed.
-Definition pow := pow.
-
-Definition square := square.
-Definition square_spec := square_spec.
-
-Definition log2_spec := log2_spec.
-Definition log2_nonpos := log2_nonpos.
-Definition log2 := log2.
-
-Definition sqrt_spec a (Ha:0<=a) := sqrt_spec a.
-Lemma sqrt_neg : forall a, a<0 -> sqrt a = 0. inversion 1. Qed.
-Definition sqrt := sqrt.
-
-Definition div := div.
-Definition modulo := modulo.
-Program Instance div_wd : Proper (eq==>eq==>eq) div.
-Program Instance mod_wd : Proper (eq==>eq==>eq) modulo.
-Definition div_mod := div_mod.
-Definition mod_bound_pos := mod_bound_pos.
-
-Definition divide := divide.
-Definition gcd := gcd.
-Definition gcd_divide_l := gcd_divide_l.
-Definition gcd_divide_r := gcd_divide_r.
-Definition gcd_greatest := gcd_greatest.
-Lemma gcd_nonneg : forall a b, 0<=gcd a b.
-Proof. intros. apply le_O_n. Qed.
-
-Definition testbit := testbit.
-Definition shiftl := shiftl.
-Definition shiftr := shiftr.
-Definition lxor := lxor.
-Definition land := land.
-Definition lor := lor.
-Definition ldiff := ldiff.
-Definition div2 := div2.
-
-Program Instance testbit_wd : Proper (eq==>eq==>Logic.eq) testbit.
-Definition testbit_odd_0 := testbit_odd_0.
-Definition testbit_even_0 := testbit_even_0.
-Definition testbit_odd_succ a n (_:0<=n) := testbit_odd_succ a n.
-Definition testbit_even_succ a n (_:0<=n) := testbit_even_succ a n.
-Lemma testbit_neg_r a n (H:n<0) : testbit a n = false.
-Proof. inversion H. Qed.
-Definition shiftl_spec_low := shiftl_spec_low.
-Definition shiftl_spec_high a n m (_:0<=m) := shiftl_spec_high a n m.
-Definition shiftr_spec a n m (_:0<=m) := shiftr_spec a n m.
-Definition lxor_spec := lxor_spec.
-Definition land_spec := land_spec.
-Definition lor_spec := lor_spec.
-Definition ldiff_spec := ldiff_spec.
-Definition div2_spec a : div2 a = shiftr a 1 := eq_refl _.
-
-(** Generic Properties *)
-
-Include NProp
- <+ UsualMinMaxLogicalProperties <+ UsualMinMaxDecProperties.
-
-End Nat.
-
-(** [Nat] contains an [order] tactic for natural numbers *)
-
-(** Note that [Nat.order] is domain-agnostic: it will not prove
- [1<=2] or [x<=x+x], but rather things like [x<=y -> y<=x -> x=y]. *)
-
-Section TestOrder.
- Let test : forall x y, x<=y -> y<=x -> x=y.
- Proof.
- Nat.order.
- Qed.
-End TestOrder.
+Module Nat <: NAxiomsSig := Nat.
diff --git a/theories/Numbers/Natural/SpecViaZ/NSig.v b/theories/Numbers/Natural/SpecViaZ/NSig.v
index 2b52bffe..1049c156 100644
--- a/theories/Numbers/Natural/SpecViaZ/NSig.v
+++ b/theories/Numbers/Natural/SpecViaZ/NSig.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Numbers/Natural/SpecViaZ/NSigNAxioms.v b/theories/Numbers/Natural/SpecViaZ/NSigNAxioms.v
index e22627e8..11569b3f 100644
--- a/theories/Numbers/Natural/SpecViaZ/NSigNAxioms.v
+++ b/theories/Numbers/Natural/SpecViaZ/NSigNAxioms.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Numbers/NumPrelude.v b/theories/Numbers/NumPrelude.v
index eb5f4055..f67e0e96 100644
--- a/theories/Numbers/NumPrelude.v
+++ b/theories/Numbers/NumPrelude.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Numbers/Rational/BigQ/BigQ.v b/theories/Numbers/Rational/BigQ/BigQ.v
index 8a90cacd..b64cfb64 100644
--- a/theories/Numbers/Rational/BigQ/BigQ.v
+++ b/theories/Numbers/Rational/BigQ/BigQ.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -33,14 +33,13 @@ Module BigN_BigZ <: NType_ZType BigN.BigN BigZ.
Qed.
End BigN_BigZ.
-(** This allows to build [BigQ] out of [BigN] and [BigQ] via [QMake] *)
+(** This allows building [BigQ] out of [BigN] and [BigQ] via [QMake] *)
Delimit Scope bigQ_scope with bigQ.
Module BigQ <: QType <: OrderedTypeFull <: TotalOrder.
- Include QMake.Make BigN BigZ BigN_BigZ [scope abstract_scope to bigQ_scope].
- Bind Scope bigQ_scope with t t_.
- Include !QProperties <+ HasEqBool2Dec
+ Include QMake.Make BigN BigZ BigN_BigZ
+ <+ !QProperties <+ HasEqBool2Dec
<+ !MinMaxLogicalProperties <+ !MinMaxDecProperties.
Ltac order := Private_Tac.order.
End BigQ.
@@ -89,6 +88,8 @@ exact BigQ.add_opp_diag_r. exact BigQ.neq_1_0.
exact BigQ.div_mul_inv. exact BigQ.mul_inv_diag_l.
Qed.
+Declare Equivalent Keys pow_N pow_pos.
+
Lemma BigQpowerth :
power_theory 1 BigQ.mul BigQ.eq Z.of_N BigQ.power.
Proof.
diff --git a/theories/Numbers/Rational/BigQ/QMake.v b/theories/Numbers/Rational/BigQ/QMake.v
index e2f53e12..c11e07fa 100644
--- a/theories/Numbers/Rational/BigQ/QMake.v
+++ b/theories/Numbers/Rational/BigQ/QMake.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -39,8 +39,6 @@ Module Make (NN:NType)(ZZ:ZType)(Import NZ:NType_ZType NN ZZ) <: QType.
Definition t := t_.
- Bind Scope abstract_scope with t t_.
-
(** Specification with respect to [QArith] *)
Local Open Scope Q_scope.
@@ -629,7 +627,7 @@ Module Make (NN:NType)(ZZ:ZType)(Import NZ:NType_ZType NN ZZ) <: QType.
assert (Hz := spec_irred_zero nx dy).
assert (Hz':= spec_irred_zero ny dx).
destruct irred as (n1,d1); destruct irred as (n2,d2).
- simpl snd in *; destruct Hg as [Hg1 Hg2]; destruct Hg' as [Hg1' Hg2'].
+ simpl @snd in *; destruct Hg as [Hg1 Hg2]; destruct Hg' as [Hg1' Hg2'].
rewrite spec_norm_denum.
qsimpl.
@@ -667,7 +665,7 @@ Module Make (NN:NType)(ZZ:ZType)(Import NZ:NType_ZType NN ZZ) <: QType.
assert (Hgc := strong_spec_irred nx dy).
assert (Hgc' := strong_spec_irred ny dx).
destruct irred as (n1,d1); destruct irred as (n2,d2).
- simpl snd in *; destruct Hg as [Hg1 Hg2]; destruct Hg' as [Hg1' Hg2'].
+ simpl @snd in *; destruct Hg as [Hg1 Hg2]; destruct Hg' as [Hg1' Hg2'].
unfold norm_denum; qsimpl.
@@ -1033,7 +1031,7 @@ Module Make (NN:NType)(ZZ:ZType)(Import NZ:NType_ZType NN ZZ) <: QType.
Definition of_Qc q := of_Q (this q).
- Definition to_Qc q := !! [q].
+ Definition to_Qc q := Q2Qc [q].
Notation "[[ x ]]" := (to_Qc x).
@@ -1085,7 +1083,7 @@ Module Make (NN:NType)(ZZ:ZType)(Import NZ:NType_ZType NN ZZ) <: QType.
[[add x y]] = [[x]] + [[y]].
Proof.
unfold to_Qc.
- transitivity (!! ([x] + [y])).
+ transitivity (Q2Qc ([x] + [y])).
unfold Q2Qc.
apply Qc_decomp; intros _ _; unfold this.
apply Qred_complete; apply spec_add; auto.
@@ -1099,7 +1097,7 @@ Module Make (NN:NType)(ZZ:ZType)(Import NZ:NType_ZType NN ZZ) <: QType.
[[add_norm x y]] = [[x]] + [[y]].
Proof.
unfold to_Qc.
- transitivity (!! ([x] + [y])).
+ transitivity (Q2Qc ([x] + [y])).
unfold Q2Qc.
apply Qc_decomp; intros _ _; unfold this.
apply Qred_complete; apply spec_add_norm; auto.
@@ -1147,7 +1145,7 @@ Module Make (NN:NType)(ZZ:ZType)(Import NZ:NType_ZType NN ZZ) <: QType.
[[mul x y]] = [[x]] * [[y]].
Proof.
unfold to_Qc.
- transitivity (!! ([x] * [y])).
+ transitivity (Q2Qc ([x] * [y])).
unfold Q2Qc.
apply Qc_decomp; intros _ _; unfold this.
apply Qred_complete; apply spec_mul; auto.
@@ -1161,7 +1159,7 @@ Module Make (NN:NType)(ZZ:ZType)(Import NZ:NType_ZType NN ZZ) <: QType.
[[mul_norm x y]] = [[x]] * [[y]].
Proof.
unfold to_Qc.
- transitivity (!! ([x] * [y])).
+ transitivity (Q2Qc ([x] * [y])).
unfold Q2Qc.
apply Qc_decomp; intros _ _; unfold this.
apply Qred_complete; apply spec_mul_norm; auto.
@@ -1185,7 +1183,7 @@ Module Make (NN:NType)(ZZ:ZType)(Import NZ:NType_ZType NN ZZ) <: QType.
[[inv x]] = /[[x]].
Proof.
unfold to_Qc.
- transitivity (!! (/[x])).
+ transitivity (Q2Qc (/[x])).
unfold Q2Qc.
apply Qc_decomp; intros _ _; unfold this.
apply Qred_complete; apply spec_inv; auto.
@@ -1199,7 +1197,7 @@ Module Make (NN:NType)(ZZ:ZType)(Import NZ:NType_ZType NN ZZ) <: QType.
[[inv_norm x]] = /[[x]].
Proof.
unfold to_Qc.
- transitivity (!! (/[x])).
+ transitivity (Q2Qc (/[x])).
unfold Q2Qc.
apply Qc_decomp; intros _ _; unfold this.
apply Qred_complete; apply spec_inv_norm; auto.
@@ -1247,12 +1245,12 @@ Module Make (NN:NType)(ZZ:ZType)(Import NZ:NType_ZType NN ZZ) <: QType.
Theorem spec_squarec x: [[square x]] = [[x]]^2.
Proof.
unfold to_Qc.
- transitivity (!! ([x]^2)).
+ transitivity (Q2Qc ([x]^2)).
unfold Q2Qc.
apply Qc_decomp; intros _ _; unfold this.
apply Qred_complete; apply spec_square; auto.
simpl Qcpower.
- replace (!! [x] * 1) with (!![x]); try ring.
+ replace (Q2Qc [x] * 1) with (Q2Qc [x]); try ring.
simpl.
unfold Qcmult, Q2Qc.
apply Qc_decomp; intros _ _; unfold this.
@@ -1264,7 +1262,7 @@ Module Make (NN:NType)(ZZ:ZType)(Import NZ:NType_ZType NN ZZ) <: QType.
[[power_pos x p]] = [[x]] ^ Pos.to_nat p.
Proof.
unfold to_Qc.
- transitivity (!! ([x]^Zpos p)).
+ transitivity (Q2Qc ([x]^Zpos p)).
unfold Q2Qc.
apply Qc_decomp; intros _ _; unfold this.
apply Qred_complete; apply spec_power_pos; auto.
diff --git a/theories/Numbers/Rational/SpecViaQ/QSig.v b/theories/Numbers/Rational/SpecViaQ/QSig.v
index 67a5f673..5f831bfc 100644
--- a/theories/Numbers/Rational/SpecViaQ/QSig.v
+++ b/theories/Numbers/Rational/SpecViaQ/QSig.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -104,7 +104,7 @@ Ltac qify := unfold eq, lt, le in *; autorewrite with qsimpl;
try rewrite spec_0 in *; try rewrite spec_1 in *; try rewrite spec_m1 in *.
(** NB: do not add [spec_0] in the autorewrite database. Otherwise,
- after instanciation in BigQ, this lemma become convertible to 0=0,
+ after instantiation in BigQ, this lemma become convertible to 0=0,
and autorewrite loops. Idem for [spec_1] and [spec_m1] *)
(** Morphisms *)
diff --git a/theories/PArith/BinPos.v b/theories/PArith/BinPos.v
index 5129a3ca..921e2d67 100644
--- a/theories/PArith/BinPos.v
+++ b/theories/PArith/BinPos.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-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -23,8 +23,6 @@ Require Export BinPosDef.
are now defined in [BinNums.v] *)
Local Open Scope positive_scope.
-Local Unset Boolean Equality Schemes.
-Local Unset Case Analysis Schemes.
(** Every definitions and early properties about positive numbers
are placed in a module [Pos] for qualification purpose. *)
@@ -578,21 +576,21 @@ Qed.
Lemma iter_swap_gen : forall A B (f:A->B)(g:A->A)(h:B->B),
(forall a, f (g a) = h (f a)) -> forall p a,
- f (iter p g a) = iter p h (f a).
+ f (iter g a p) = iter h (f a) p.
Proof.
induction p; simpl; intros; now rewrite ?H, ?IHp.
Qed.
Theorem iter_swap :
forall p (A:Type) (f:A -> A) (x:A),
- iter p f (f x) = f (iter p f x).
+ iter f (f x) p = f (iter f x p).
Proof.
intros. symmetry. now apply iter_swap_gen.
Qed.
Theorem iter_succ :
forall p (A:Type) (f:A -> A) (x:A),
- iter (succ p) f x = f (iter p f x).
+ iter f x (succ p) = f (iter f x p).
Proof.
induction p as [p IHp|p IHp|]; intros; simpl; trivial.
now rewrite !IHp, iter_swap.
@@ -600,7 +598,7 @@ Qed.
Theorem iter_add :
forall p q (A:Type) (f:A -> A) (x:A),
- iter (p+q) f x = iter p f (iter q f x).
+ iter f x (p+q) = iter f (iter f x q) p.
Proof.
induction p using peano_ind; intros.
now rewrite add_1_l, iter_succ.
@@ -610,7 +608,7 @@ Qed.
Theorem iter_invariant :
forall (p:positive) (A:Type) (f:A -> A) (Inv:A -> Prop),
(forall x:A, Inv x -> Inv (f x)) ->
- forall x:A, Inv x -> Inv (iter p f x).
+ forall x:A, Inv x -> Inv (iter f x p).
Proof.
induction p as [p IHp|p IHp|]; simpl; trivial.
intros A f Inv H x H0. apply H, IHp, IHp; trivial.
@@ -651,7 +649,7 @@ Theorem sub_mask_carry_spec p q :
sub_mask_carry p q = pred_mask (sub_mask p q).
Proof.
revert q. induction p as [p IHp|p IHp| ]; destruct q; simpl;
- try reflexivity; try rewrite IHp;
+ try reflexivity; rewrite ?IHp;
destruct (sub_mask p q) as [|[r|r| ]|] || destruct p; auto.
Qed.
@@ -768,15 +766,15 @@ Definition switch_Eq c c' :=
end.
Lemma compare_cont_spec p q c :
- compare_cont p q c = switch_Eq c (p ?= q).
+ compare_cont c p q = switch_Eq c (p ?= q).
Proof.
unfold compare.
revert q c.
induction p; destruct q; simpl; trivial.
intros c.
- rewrite 2 IHp. now destruct (compare_cont p q Eq).
+ rewrite 2 IHp. now destruct (compare_cont Eq p q).
intros c.
- rewrite 2 IHp. now destruct (compare_cont p q Eq).
+ rewrite 2 IHp. now destruct (compare_cont Eq p q).
Qed.
(** From this general result, we now describe particular cases
@@ -787,31 +785,31 @@ Qed.
*)
Theorem compare_cont_Eq p q c :
- compare_cont p q c = Eq -> c = Eq.
+ compare_cont c p q = Eq -> c = Eq.
Proof.
rewrite compare_cont_spec. now destruct (p ?= q).
Qed.
Lemma compare_cont_Lt_Gt p q :
- compare_cont p q Lt = Gt <-> p > q.
+ compare_cont Lt p q = Gt <-> p > q.
Proof.
rewrite compare_cont_spec. unfold gt. destruct (p ?= q); now split.
Qed.
Lemma compare_cont_Lt_Lt p q :
- compare_cont p q Lt = Lt <-> p <= q.
+ compare_cont Lt p q = Lt <-> p <= q.
Proof.
rewrite compare_cont_spec. unfold le. destruct (p ?= q); easy'.
Qed.
Lemma compare_cont_Gt_Lt p q :
- compare_cont p q Gt = Lt <-> p < q.
+ compare_cont Gt p q = Lt <-> p < q.
Proof.
rewrite compare_cont_spec. unfold lt. destruct (p ?= q); now split.
Qed.
Lemma compare_cont_Gt_Gt p q :
- compare_cont p q Gt = Gt <-> p >= q.
+ compare_cont Gt p q = Gt <-> p >= q.
Proof.
rewrite compare_cont_spec. unfold ge. destruct (p ?= q); easy'.
Qed.
@@ -876,13 +874,13 @@ Qed.
(** Basic facts about [compare_cont] *)
Theorem compare_cont_refl p c :
- compare_cont p p c = c.
+ compare_cont c p p = c.
Proof.
now induction p.
Qed.
Lemma compare_cont_antisym p q c :
- CompOpp (compare_cont p q c) = compare_cont q p (CompOpp c).
+ CompOpp (compare_cont c p q) = compare_cont (CompOpp c) q p.
Proof.
revert q c.
induction p as [p IHp|p IHp| ]; intros [q|q| ] c; simpl;
@@ -1840,6 +1838,8 @@ Qed.
End Pos.
+Bind Scope positive_scope with Pos.t positive.
+
(** Exportation of notations *)
Infix "+" := Pos.add : positive_scope.
@@ -1903,7 +1903,7 @@ Notation Pdiv2 := Pos.div2 (compat "8.3").
Notation Pdiv2_up := Pos.div2_up (compat "8.3").
Notation Psize := Pos.size_nat (compat "8.3").
Notation Psize_pos := Pos.size (compat "8.3").
-Notation Pcompare := Pos.compare_cont (compat "8.3").
+Notation Pcompare x y m := (Pos.compare_cont m x y) (compat "8.3").
Notation Plt := Pos.lt (compat "8.3").
Notation Pgt := Pos.gt (compat "8.3").
Notation Ple := Pos.le (compat "8.3").
@@ -2062,11 +2062,11 @@ Lemma Pplus_one_succ_r p : Pos.succ p = p + 1.
Proof (eq_sym (Pos.add_1_r p)).
Lemma Pplus_one_succ_l p : Pos.succ p = 1 + p.
Proof (eq_sym (Pos.add_1_l p)).
-Lemma Pcompare_refl p : Pos.compare_cont p p Eq = Eq.
+Lemma Pcompare_refl p : Pos.compare_cont Eq p p = Eq.
Proof (Pos.compare_cont_refl p Eq).
-Lemma Pcompare_Eq_eq : forall p q, Pos.compare_cont p q Eq = Eq -> p = q.
+Lemma Pcompare_Eq_eq : forall p q, Pos.compare_cont Eq p q = Eq -> p = q.
Proof Pos.compare_eq.
-Lemma ZC4 p q : Pos.compare_cont p q Eq = CompOpp (Pos.compare_cont q p Eq).
+Lemma ZC4 p q : Pos.compare_cont Eq p q = CompOpp (Pos.compare_cont Eq q p).
Proof (Pos.compare_antisym q p).
Lemma Ppred_minus p : Pos.pred p = p - 1.
Proof (eq_sym (Pos.sub_1_r p)).
diff --git a/theories/PArith/BinPosDef.v b/theories/PArith/BinPosDef.v
index 77239660..fefd1d76 100644
--- a/theories/PArith/BinPosDef.v
+++ b/theories/PArith/BinPosDef.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-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -18,7 +18,7 @@
Require Export BinNums.
-(** Postfix notation for positive numbers, allowing to mimic
+(** Postfix notation for positive numbers, which allows mimicking
the position of bits in a big-endian representation.
For instance, we can write [1~1~0] instead of [(xO (xI xH))]
for the number 6 (which is 110 in binary notation).
@@ -30,8 +30,6 @@ Notation "p ~ 0" := (xO p)
(at level 7, left associativity, format "p '~' '0'") : positive_scope.
Local Open Scope positive_scope.
-Local Unset Boolean Equality Schemes.
-Local Unset Case Analysis Schemes.
Module Pos.
@@ -197,16 +195,16 @@ Infix "*" := mul : positive_scope.
(** ** Iteration over a positive number *)
-Fixpoint iter (n:positive) {A} (f:A -> A) (x:A) : A :=
- match n with
+Definition iter {A} (f:A -> A) : A -> positive -> A :=
+ fix iter_fix x n := match n with
| xH => f x
- | xO n' => iter n' f (iter n' f x)
- | xI n' => f (iter n' f (iter n' f x))
+ | xO n' => iter_fix (iter_fix x n') n'
+ | xI n' => f (iter_fix (iter_fix x n') n')
end.
(** ** Power *)
-Definition pow (x y:positive) := iter y (mul x) 1.
+Definition pow (x:positive) := iter (mul x) 1.
Infix "^" := pow : positive_scope.
@@ -257,20 +255,20 @@ Fixpoint size p :=
(** ** Comparison on binary positive numbers *)
-Fixpoint compare_cont (x y:positive) (r:comparison) {struct y} : comparison :=
+Fixpoint compare_cont (r:comparison) (x y:positive) {struct y} : comparison :=
match x, y with
- | p~1, q~1 => compare_cont p q r
- | p~1, q~0 => compare_cont p q Gt
+ | p~1, q~1 => compare_cont r p q
+ | p~1, q~0 => compare_cont Gt p q
| p~1, 1 => Gt
- | p~0, q~1 => compare_cont p q Lt
- | p~0, q~0 => compare_cont p q r
+ | p~0, q~1 => compare_cont Lt p q
+ | p~0, q~0 => compare_cont r p q
| p~0, 1 => Gt
| 1, q~1 => Lt
| 1, q~0 => Lt
| 1, 1 => r
end.
-Definition compare x y := compare_cont x y Eq.
+Definition compare := compare_cont Eq.
Infix "?=" := compare (at level 70, no associativity) : positive_scope.
@@ -377,7 +375,7 @@ Fixpoint gcdn (n : nat) (a b : positive) : positive :=
Definition gcd (a b : positive) := gcdn (size_nat a + size_nat b)%nat a b.
(** Generalized Gcd, also computing the division of a and b by the gcd *)
-
+Set Printing Universes.
Fixpoint ggcdn (n : nat) (a b : positive) : (positive*(positive*positive)) :=
match n with
| O => (1,(a,b))
@@ -484,19 +482,19 @@ Fixpoint lxor (p q:positive) : N :=
(** Shifts. NB: right shift of 1 stays at 1. *)
-Definition shiftl_nat (p:positive)(n:nat) := nat_iter n xO p.
-Definition shiftr_nat (p:positive)(n:nat) := nat_iter n div2 p.
+Definition shiftl_nat (p:positive) := nat_rect _ p (fun _ => xO).
+Definition shiftr_nat (p:positive) := nat_rect _ p (fun _ => div2).
Definition shiftl (p:positive)(n:N) :=
match n with
| N0 => p
- | Npos n => iter n xO p
+ | Npos n => iter xO p n
end.
Definition shiftr (p:positive)(n:N) :=
match n with
| N0 => p
- | Npos n => iter n div2 p
+ | Npos n => iter div2 p n
end.
(** Checking whether a particular bit is set or not *)
@@ -539,7 +537,7 @@ Definition iter_op {A}(op:A->A->A) :=
end.
Definition to_nat (x:positive) : nat := iter_op plus x (S O).
-
+Arguments to_nat x: simpl never.
(** ** From Peano natural numbers to binary positive numbers *)
(** A version preserving positive numbers, and sending 0 to 1. *)
@@ -559,4 +557,4 @@ Fixpoint of_succ_nat (n:nat) : positive :=
| S x => succ (of_succ_nat x)
end.
-End Pos. \ No newline at end of file
+End Pos.
diff --git a/theories/PArith/PArith.v b/theories/PArith/PArith.v
index eac2b99b..93352c6b 100644
--- a/theories/PArith/PArith.v
+++ b/theories/PArith/PArith.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/PArith/POrderedType.v b/theories/PArith/POrderedType.v
index e672ccff..92483ac8 100644
--- a/theories/PArith/POrderedType.v
+++ b/theories/PArith/POrderedType.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/PArith/Pnat.v b/theories/PArith/Pnat.v
index 449a6700..e529a8c4 100644
--- a/theories/PArith/Pnat.v
+++ b/theories/PArith/Pnat.v
@@ -1,13 +1,13 @@
(* -*- coding: utf-8 -*- *)
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
(************************************************************************)
-Require Import BinPos Le Lt Gt Plus Mult Minus Compare_dec.
+Require Import BinPos PeanoNat.
(** Properties of the injection from binary positive numbers
to Peano natural numbers *)
@@ -25,7 +25,7 @@ Module Pos2Nat.
Lemma inj_succ p : to_nat (succ p) = S (to_nat p).
Proof.
unfold to_nat. rewrite iter_op_succ. trivial.
- apply plus_assoc.
+ apply Nat.add_assoc.
Qed.
Theorem inj_add p q : to_nat (p + q) = to_nat p + to_nat q.
@@ -99,38 +99,38 @@ Qed.
(** [Pos.to_nat] is a morphism for comparison *)
-Lemma inj_compare p q : (p ?= q) = nat_compare (to_nat p) (to_nat q).
+Lemma inj_compare p q : (p ?= q)%positive = (to_nat p ?= to_nat q).
Proof.
revert q. induction p as [ |p IH] using peano_ind; intros q.
- destruct (succ_pred_or q) as [Hq|Hq]; [now subst|].
- rewrite <- Hq, lt_1_succ, inj_succ, inj_1, nat_compare_S.
- symmetry. apply nat_compare_lt, is_pos.
- destruct (succ_pred_or q) as [Hq|Hq]; [subst|].
- rewrite compare_antisym, lt_1_succ, inj_succ. simpl.
- symmetry. apply nat_compare_gt, is_pos.
- now rewrite <- Hq, 2 inj_succ, compare_succ_succ, IH.
+ - destruct (succ_pred_or q) as [Hq|Hq]; [now subst|].
+ rewrite <- Hq, lt_1_succ, inj_succ, inj_1, Nat.compare_succ.
+ symmetry. apply Nat.compare_lt_iff, is_pos.
+ - destruct (succ_pred_or q) as [Hq|Hq]; [subst|].
+ rewrite compare_antisym, lt_1_succ, inj_succ. simpl.
+ symmetry. apply Nat.compare_gt_iff, is_pos.
+ now rewrite <- Hq, 2 inj_succ, compare_succ_succ, IH.
Qed.
(** [Pos.to_nat] is a morphism for [lt], [le], etc *)
Lemma inj_lt p q : (p < q)%positive <-> to_nat p < to_nat q.
Proof.
- unfold lt. now rewrite inj_compare, nat_compare_lt.
+ unfold lt. now rewrite inj_compare, Nat.compare_lt_iff.
Qed.
Lemma inj_le p q : (p <= q)%positive <-> to_nat p <= to_nat q.
Proof.
- unfold le. now rewrite inj_compare, nat_compare_le.
+ unfold le. now rewrite inj_compare, Nat.compare_le_iff.
Qed.
Lemma inj_gt p q : (p > q)%positive <-> to_nat p > to_nat q.
Proof.
- unfold gt. now rewrite inj_compare, nat_compare_gt.
+ unfold gt. now rewrite inj_compare, Nat.compare_gt_iff.
Qed.
Lemma inj_ge p q : (p >= q)%positive <-> to_nat p >= to_nat q.
Proof.
- unfold ge. now rewrite inj_compare, nat_compare_ge.
+ unfold ge. now rewrite inj_compare, Nat.compare_ge_iff.
Qed.
(** [Pos.to_nat] is a morphism for subtraction *)
@@ -138,64 +138,66 @@ Qed.
Theorem inj_sub p q : (q < p)%positive ->
to_nat (p - q) = to_nat p - to_nat q.
Proof.
- intro H; apply plus_reg_l with (to_nat q); rewrite le_plus_minus_r.
- now rewrite <- inj_add, add_comm, sub_add.
- now apply lt_le_weak, inj_lt.
+ intro H. apply Nat.add_cancel_r with (to_nat q).
+ rewrite Nat.sub_add.
+ now rewrite <- inj_add, sub_add.
+ now apply Nat.lt_le_incl, inj_lt.
Qed.
Theorem inj_sub_max p q :
- to_nat (p - q) = Peano.max 1 (to_nat p - to_nat q).
+ to_nat (p - q) = Nat.max 1 (to_nat p - to_nat q).
Proof.
destruct (ltb_spec q p).
- rewrite <- inj_sub by trivial.
- now destruct (is_succ (p - q)) as (m,->).
- rewrite sub_le by trivial.
- replace (to_nat p - to_nat q) with 0; trivial.
- apply le_n_0_eq.
- rewrite <- (minus_diag (to_nat p)).
- now apply minus_le_compat_l, inj_le.
+ - (* q < p *)
+ rewrite <- inj_sub by trivial.
+ now destruct (is_succ (p - q)) as (m,->).
+ - (* p <= q *)
+ rewrite sub_le by trivial.
+ apply inj_le, Nat.sub_0_le in H. now rewrite H.
Qed.
Theorem inj_pred p : (1 < p)%positive ->
- to_nat (pred p) = Peano.pred (to_nat p).
+ to_nat (pred p) = Nat.pred (to_nat p).
Proof.
- intros H. now rewrite <- Pos.sub_1_r, inj_sub, pred_of_minus.
+ intros. now rewrite <- Pos.sub_1_r, inj_sub, Nat.sub_1_r.
Qed.
Theorem inj_pred_max p :
- to_nat (pred p) = Peano.max 1 (Peano.pred (to_nat p)).
+ to_nat (pred p) = Nat.max 1 (Peano.pred (to_nat p)).
Proof.
- rewrite <- Pos.sub_1_r, pred_of_minus. apply inj_sub_max.
+ rewrite <- Pos.sub_1_r, <- Nat.sub_1_r. apply inj_sub_max.
Qed.
(** [Pos.to_nat] and other operations *)
Lemma inj_min p q :
- to_nat (min p q) = Peano.min (to_nat p) (to_nat q).
+ to_nat (min p q) = Nat.min (to_nat p) (to_nat q).
Proof.
unfold min. rewrite inj_compare.
- case nat_compare_spec; intros H; symmetry.
- apply Peano.min_l. now rewrite H.
- now apply Peano.min_l, lt_le_weak.
- now apply Peano.min_r, lt_le_weak.
+ case Nat.compare_spec; intros H; symmetry.
+ - apply Nat.min_l. now rewrite H.
+ - now apply Nat.min_l, Nat.lt_le_incl.
+ - now apply Nat.min_r, Nat.lt_le_incl.
Qed.
Lemma inj_max p q :
- to_nat (max p q) = Peano.max (to_nat p) (to_nat q).
+ to_nat (max p q) = Nat.max (to_nat p) (to_nat q).
Proof.
unfold max. rewrite inj_compare.
- case nat_compare_spec; intros H; symmetry.
- apply Peano.max_r. now rewrite H.
- now apply Peano.max_r, lt_le_weak.
- now apply Peano.max_l, lt_le_weak.
+ case Nat.compare_spec; intros H; symmetry.
+ - apply Nat.max_r. now rewrite H.
+ - now apply Nat.max_r, Nat.lt_le_incl.
+ - now apply Nat.max_l, Nat.lt_le_incl.
Qed.
Theorem inj_iter :
forall p {A} (f:A->A) (x:A),
- Pos.iter p f x = nat_iter (to_nat p) f x.
+ Pos.iter f x p = nat_rect _ x (fun _ => f) (to_nat p).
Proof.
- induction p using peano_ind. trivial.
- intros. rewrite inj_succ, iter_succ. simpl. now f_equal.
+ induction p using peano_ind.
+ - trivial.
+ - intros. rewrite inj_succ, iter_succ.
+ simpl. f_equal. apply IHp.
Qed.
End Pos2Nat.
@@ -209,7 +211,7 @@ Module Nat2Pos.
Theorem id (n:nat) : n<>0 -> Pos.to_nat (Pos.of_nat n) = n.
Proof.
induction n as [|n H]; trivial. now destruct 1.
- intros _. simpl. destruct n. trivial.
+ intros _. simpl Pos.of_nat. destruct n. trivial.
rewrite Pos2Nat.inj_succ. f_equal. now apply H.
Qed.
@@ -257,11 +259,11 @@ Lemma inj_mul (n m : nat) : n<>0 -> m<>0 ->
Proof.
intros Hn Hm. apply Pos2Nat.inj.
rewrite Pos2Nat.inj_mul, !id; trivial.
-intros H. apply mult_is_O in H. destruct H. now elim Hn. now elim Hm.
+intros H. apply Nat.mul_eq_0 in H. destruct H. now elim Hn. now elim Hm.
Qed.
Lemma inj_compare (n m : nat) : n<>0 -> m<>0 ->
- nat_compare n m = (Pos.of_nat n ?= Pos.of_nat m).
+ (n ?= m) = (Pos.of_nat n ?= Pos.of_nat m)%positive.
Proof.
intros Hn Hm. rewrite Pos2Nat.inj_compare, !id; trivial.
Qed.
@@ -282,8 +284,9 @@ Proof.
destruct n as [|n]. simpl. symmetry. apply Pos.min_l, Pos.le_1_l.
destruct m as [|m]. simpl. symmetry. apply Pos.min_r, Pos.le_1_l.
unfold Pos.min. rewrite <- inj_compare by easy.
- case nat_compare_spec; intros H; f_equal; apply min_l || apply min_r.
- rewrite H; auto. now apply lt_le_weak. now apply lt_le_weak.
+ case Nat.compare_spec; intros H; f_equal;
+ apply Nat.min_l || apply Nat.min_r.
+ rewrite H; auto. now apply Nat.lt_le_incl. now apply Nat.lt_le_incl.
Qed.
Lemma inj_max (n m : nat) :
@@ -292,8 +295,9 @@ Proof.
destruct n as [|n]. simpl. symmetry. apply Pos.max_r, Pos.le_1_l.
destruct m as [|m]. simpl. symmetry. apply Pos.max_l, Pos.le_1_l.
unfold Pos.max. rewrite <- inj_compare by easy.
- case nat_compare_spec; intros H; f_equal; apply max_l || apply max_r.
- rewrite H; auto. now apply lt_le_weak. now apply lt_le_weak.
+ case Nat.compare_spec; intros H; f_equal;
+ apply Nat.max_l || apply Nat.max_r.
+ rewrite H; auto. now apply Nat.lt_le_incl. now apply Nat.lt_le_incl.
Qed.
End Nat2Pos.
@@ -365,7 +369,7 @@ apply Pos2Nat.inj. now rewrite Pos2Nat.inj_succ, !id_succ.
Qed.
Lemma inj_compare n m :
- nat_compare n m = (Pos.of_succ_nat n ?= Pos.of_succ_nat m).
+ (n ?= m) = (Pos.of_succ_nat n ?= Pos.of_succ_nat m)%positive.
Proof.
rewrite Pos2Nat.inj_compare, !id_succ; trivial.
Qed.
@@ -410,24 +414,24 @@ Notation P_of_succ_nat_o_nat_of_P_eq_succ := Pos2SuccNat.id_succ (compat "8.3").
Notation pred_o_P_of_succ_nat_o_nat_of_P_eq_id := Pos2SuccNat.pred_id (compat "8.3").
Lemma nat_of_P_minus_morphism p q :
- Pos.compare_cont p q Eq = Gt ->
+ Pos.compare_cont Eq p q = Gt ->
Pos.to_nat (p - q) = Pos.to_nat p - Pos.to_nat q.
Proof (fun H => Pos2Nat.inj_sub p q (Pos.gt_lt _ _ H)).
Lemma nat_of_P_lt_Lt_compare_morphism p q :
- Pos.compare_cont p q Eq = Lt -> Pos.to_nat p < Pos.to_nat q.
+ Pos.compare_cont Eq p q = Lt -> Pos.to_nat p < Pos.to_nat q.
Proof (proj1 (Pos2Nat.inj_lt p q)).
Lemma nat_of_P_gt_Gt_compare_morphism p q :
- Pos.compare_cont p q Eq = Gt -> Pos.to_nat p > Pos.to_nat q.
+ Pos.compare_cont Eq p q = Gt -> Pos.to_nat p > Pos.to_nat q.
Proof (proj1 (Pos2Nat.inj_gt p q)).
Lemma nat_of_P_lt_Lt_compare_complement_morphism p q :
- Pos.to_nat p < Pos.to_nat q -> Pos.compare_cont p q Eq = Lt.
+ Pos.to_nat p < Pos.to_nat q -> Pos.compare_cont Eq p q = Lt.
Proof (proj2 (Pos2Nat.inj_lt p q)).
Definition nat_of_P_gt_Gt_compare_complement_morphism p q :
- Pos.to_nat p > Pos.to_nat q -> Pos.compare_cont p q Eq = Gt.
+ Pos.to_nat p > Pos.to_nat q -> Pos.compare_cont Eq p q = Gt.
Proof (proj2 (Pos2Nat.inj_gt p q)).
(** Old intermediate results about [Pmult_nat] *)
@@ -438,11 +442,11 @@ Lemma Pmult_nat_mult : forall p n,
Pmult_nat p n = Pos.to_nat p * n.
Proof.
induction p; intros n; unfold Pos.to_nat; simpl.
- f_equal. rewrite 2 IHp. rewrite <- mult_assoc.
- f_equal. simpl. now rewrite <- plus_n_O.
- rewrite 2 IHp. rewrite <- mult_assoc.
- f_equal. simpl. now rewrite <- plus_n_O.
- simpl. now rewrite <- plus_n_O.
+ f_equal. rewrite 2 IHp. rewrite <- Nat.mul_assoc.
+ f_equal. simpl. now rewrite Nat.add_0_r.
+ rewrite 2 IHp. rewrite <- Nat.mul_assoc.
+ f_equal. simpl. now rewrite Nat.add_0_r.
+ simpl. now rewrite Nat.add_0_r.
Qed.
Lemma Pmult_nat_succ_morphism :
@@ -454,7 +458,7 @@ Qed.
Theorem Pmult_nat_l_plus_morphism :
forall p q n, Pmult_nat (p + q) n = Pmult_nat p n + Pmult_nat q n.
Proof.
- intros. rewrite !Pmult_nat_mult, Pos2Nat.inj_add. apply mult_plus_distr_r.
+ intros. rewrite !Pmult_nat_mult, Pos2Nat.inj_add. apply Nat.mul_add_distr_r.
Qed.
Theorem Pmult_nat_plus_carry_morphism :
@@ -466,19 +470,19 @@ Qed.
Lemma Pmult_nat_r_plus_morphism :
forall p n, Pmult_nat p (n + n) = Pmult_nat p n + Pmult_nat p n.
Proof.
- intros. rewrite !Pmult_nat_mult. apply mult_plus_distr_l.
+ intros. rewrite !Pmult_nat_mult. apply Nat.mul_add_distr_l.
Qed.
Lemma ZL6 : forall p, Pmult_nat p 2 = Pos.to_nat p + Pos.to_nat p.
Proof.
- intros. rewrite Pmult_nat_mult, mult_comm. simpl. now rewrite <- plus_n_O.
+ intros. rewrite Pmult_nat_mult, Nat.mul_comm. simpl. now rewrite Nat.add_0_r.
Qed.
Lemma le_Pmult_nat : forall p n, n <= Pmult_nat p n.
Proof.
intros. rewrite Pmult_nat_mult.
- apply le_trans with (1*n). now rewrite mult_1_l.
- apply mult_le_compat_r. apply Pos2Nat.is_pos.
+ apply Nat.le_trans with (1*n). now rewrite Nat.mul_1_l.
+ apply Nat.mul_le_mono_r. apply Pos2Nat.is_pos.
Qed.
End ObsoletePmultNat.
diff --git a/theories/Program/Basics.v b/theories/Program/Basics.v
index 2c0f62ad..e5be0ca9 100644
--- a/theories/Program/Basics.v
+++ b/theories/Program/Basics.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-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Program/Combinators.v b/theories/Program/Combinators.v
index 4d631e78..e246041b 100644
--- a/theories/Program/Combinators.v
+++ b/theories/Program/Combinators.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-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Program/Equality.v b/theories/Program/Equality.v
index 04701ff5..a9aa30df 100644
--- a/theories/Program/Equality.v
+++ b/theories/Program/Equality.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -263,7 +263,7 @@ Class DependentEliminationPackage (A : Type) :=
Ltac elim_tac tac p :=
let ty := type of p in
- let eliminator := eval simpl in (elim (A:=ty)) in
+ let eliminator := eval simpl in (@elim (_ : DependentEliminationPackage ty)) in
tac p eliminator.
(** Specialization to do case analysis or induction.
diff --git a/theories/Program/Program.v b/theories/Program/Program.v
index 38f11231..5af6f4d7 100644
--- a/theories/Program/Program.v
+++ b/theories/Program/Program.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Program/Subset.v b/theories/Program/Subset.v
index 269556c2..50b89b5c 100644
--- a/theories/Program/Subset.v
+++ b/theories/Program/Subset.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -61,12 +61,12 @@ Ltac pi_subset_proofs := repeat pi_subset_proof.
Ltac clear_subset_proofs :=
abstract_subset_proofs ; simpl in * |- ; pi_subset_proofs ; clear_dups.
-Ltac pi := repeat progress f_equal ; apply proof_irrelevance.
+Ltac pi := repeat f_equal ; apply proof_irrelevance.
Lemma subset_eq : forall A (P : A -> Prop) (n m : sig P), n = m <-> `n = `m.
Proof.
- induction n.
- induction m.
+ destruct n as (x,p).
+ destruct m as (x',p').
simpl.
split ; intros ; subst.
@@ -79,14 +79,14 @@ Qed.
(* Somewhat trivial definition, but not unfolded automatically hence we can match on [match_eq ?A ?B ?x ?f]
in tactics. *)
-Definition match_eq (A B : Type) (x : A) (fn : forall (y : A | y = x), B) : B :=
+Definition match_eq (A B : Type) (x : A) (fn : {y : A | y = x} -> B) : B :=
fn (exist _ x eq_refl).
(* This is what we want to be able to do: replace the originaly matched object by a new,
propositionally equal one. If [fn] works on [x] it should work on any [y | y = x]. *)
-Lemma match_eq_rewrite : forall (A B : Type) (x : A) (fn : forall (y : A | y = x), B)
- (y : A | y = x),
+Lemma match_eq_rewrite : forall (A B : Type) (x : A) (fn : {y : A | y = x} -> B)
+ (y : {y:A | y = x}),
match_eq A B x fn = fn y.
Proof.
intros.
diff --git a/theories/Program/Syntax.v b/theories/Program/Syntax.v
index 269748b5..67e9a20c 100644
--- a/theories/Program/Syntax.v
+++ b/theories/Program/Syntax.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Program/Tactics.v b/theories/Program/Tactics.v
index fd55a553..0cf8d733 100644
--- a/theories/Program/Tactics.v
+++ b/theories/Program/Tactics.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Program/Utils.v b/theories/Program/Utils.v
index de2a76ab..e39128cb 100644
--- a/theories/Program/Utils.v
+++ b/theories/Program/Utils.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Program/Wf.v b/theories/Program/Wf.v
index 2a7a5e17..d89919b0 100644
--- a/theories/Program/Wf.v
+++ b/theories/Program/Wf.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -11,6 +11,7 @@
Require Import Coq.Init.Wf.
Require Import Coq.Program.Utils.
Require Import ProofIrrelevance.
+Require Import FunctionalExtensionality.
Local Open Scope program_scope.
@@ -32,14 +33,13 @@ Section Well_founded.
(* Notation Fix_F := (Fix_F_sub P F_sub) (only parsing). (* alias *) *)
(* Definition Fix (x:A) := Fix_F_sub P F_sub x (Rwf x). *)
- Hypothesis
- F_ext :
+ Hypothesis F_ext :
forall (x:A) (f g:forall y:{y:A | R y x}, P (`y)),
- (forall (y : A | R y x), f y = g y) -> F_sub x f = F_sub x g.
+ (forall y:{y : A | R y x}, f y = g y) -> F_sub x f = F_sub x g.
Lemma Fix_F_eq :
forall (x:A) (r:Acc R x),
- F_sub x (fun (y:A|R y x) => Fix_F_sub (`y) (Acc_inv r (proj2_sig y))) = Fix_F_sub x r.
+ F_sub x (fun y:{y:A | R y x} => Fix_F_sub (`y) (Acc_inv r (proj2_sig y))) = Fix_F_sub x r.
Proof.
destruct r using Acc_inv_dep; auto.
Qed.
@@ -50,7 +50,7 @@ Section Well_founded.
rewrite (proof_irrelevance (Acc R x) r s) ; auto.
Qed.
- Lemma Fix_eq : forall x:A, Fix_sub x = F_sub x (fun (y:A|R y x) => Fix_sub (proj1_sig y)).
+ Lemma Fix_eq : forall x:A, Fix_sub x = F_sub x (fun y:{ y:A | R y x} => Fix_sub (proj1_sig y)).
Proof.
intro x; unfold Fix_sub.
rewrite <- (Fix_F_eq ).
@@ -62,7 +62,8 @@ Section Well_founded.
forall x : A,
Fix_sub x =
let f_sub := F_sub in
- f_sub x (fun (y : A | R y x) => Fix_sub (`y)).
+ f_sub x (fun y: {y : A | R y x} => Fix_sub (`y)).
+ Proof.
exact Fix_eq.
Qed.
@@ -153,7 +154,7 @@ Section Fix_rects.
Hypothesis equiv_lowers:
forall x0 (g h: forall x: {y: A | R y x0}, P (proj1_sig x)),
- (forall x p p', g (exist (fun y: A => R y x0) x p) = h (exist _ x p')) ->
+ (forall x p p', g (exist (fun y: A => R y x0) x p) = h (exist (*FIXME shouldn't be needed *) (fun y => R y x0) x p')) ->
f g = f h.
(* From equiv_lowers, it follows that
@@ -221,8 +222,6 @@ Ltac fold_sub f :=
Module WfExtensionality.
- Require Import FunctionalExtensionality.
-
(** The two following lemmas allow to unfold a well-founded fixpoint definition without
restriction using the functional extensionality axiom. *)
@@ -231,10 +230,10 @@ Module WfExtensionality.
Program Lemma fix_sub_eq_ext :
forall (A : Type) (R : A -> A -> Prop) (Rwf : well_founded R)
(P : A -> Type)
- (F_sub : forall x : A, (forall (y : A | R y x), P y) -> P x),
+ (F_sub : forall x : A, (forall y:{y : A | R y x}, P (` y)) -> P x),
forall x : A,
Fix_sub A R Rwf P F_sub x =
- F_sub x (fun (y : A | R y x) => Fix_sub A R Rwf P F_sub y).
+ F_sub x (fun y:{y : A | R y x} => Fix_sub A R Rwf P F_sub (` y)).
Proof.
intros ; apply Fix_eq ; auto.
intros.
diff --git a/theories/QArith/QArith.v b/theories/QArith/QArith.v
index 1a76d7e1..c32fb950 100644
--- a/theories/QArith/QArith.v
+++ b/theories/QArith/QArith.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/QArith/QArith_base.v b/theories/QArith/QArith_base.v
index 080d00d4..7f19b4ce 100644
--- a/theories/QArith/QArith_base.v
+++ b/theories/QArith/QArith_base.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -925,8 +925,8 @@ Qed.
(** * Rational to the n-th power *)
-Definition Qpower_positive (q:Q)(p:positive) : Q :=
- pow_pos Qmult q p.
+Definition Qpower_positive : Q -> positive -> Q :=
+ pow_pos Qmult.
Instance Qpower_positive_comp : Proper (Qeq==>eq==>Qeq) Qpower_positive.
Proof.
diff --git a/theories/QArith/QOrderedType.v b/theories/QArith/QOrderedType.v
index dc820e75..fa0b9209 100644
--- a/theories/QArith/QOrderedType.v
+++ b/theories/QArith/QOrderedType.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/QArith/Qabs.v b/theories/QArith/Qabs.v
index 9b607f1b..f77f409e 100644
--- a/theories/QArith/Qabs.v
+++ b/theories/QArith/Qabs.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/QArith/Qcanon.v b/theories/QArith/Qcanon.v
index a865a6cf..f7f83bf0 100644
--- a/theories/QArith/Qcanon.v
+++ b/theories/QArith/Qcanon.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -70,7 +70,6 @@ Qed.
Definition Q2Qc (q:Q) : Qc := Qcmake (Qred q) (Qred_involutive q).
Arguments Q2Qc q%Q.
-Notation " !! " := Q2Qc : Qc_scope.
Lemma Qc_is_canon : forall q q' : Qc, q == q' -> q = q'.
Proof.
@@ -87,8 +86,8 @@ Proof.
Qed.
Hint Resolve Qc_is_canon.
-Notation " 0 " := (!!0) : Qc_scope.
-Notation " 1 " := (!!1) : Qc_scope.
+Notation " 0 " := (Q2Qc 0) : Qc_scope.
+Notation " 1 " := (Q2Qc 1) : Qc_scope.
Definition Qcle (x y : Qc) := (x <= y)%Q.
Definition Qclt (x y : Qc) := (x < y)%Q.
@@ -144,15 +143,15 @@ Defined.
(** The addition, multiplication and opposite are defined
in the straightforward way: *)
-Definition Qcplus (x y : Qc) := !!(x+y).
+Definition Qcplus (x y : Qc) := Q2Qc (x+y).
Infix "+" := Qcplus : Qc_scope.
-Definition Qcmult (x y : Qc) := !!(x*y).
+Definition Qcmult (x y : Qc) := Q2Qc (x*y).
Infix "*" := Qcmult : Qc_scope.
-Definition Qcopp (x : Qc) := !!(-x).
+Definition Qcopp (x : Qc) := Q2Qc (-x).
Notation "- x" := (Qcopp x) : Qc_scope.
Definition Qcminus (x y : Qc) := x+-y.
Infix "-" := Qcminus : Qc_scope.
-Definition Qcinv (x : Qc) := !!(/x).
+Definition Qcinv (x : Qc) := Q2Qc (/x).
Notation "/ x" := (Qcinv x) : Qc_scope.
Definition Qcdiv (x y : Qc) := x*/y.
Infix "/" := Qcdiv : Qc_scope.
@@ -434,14 +433,14 @@ Qed.
Lemma Qcmult_lt_0_le_reg_r : forall x y z, 0 < z -> x*z <= y*z -> x <= y.
Proof.
unfold Qcmult, Qcle, Qclt; intros; simpl in *.
- repeat progress rewrite Qred_correct in * |-.
+ rewrite !Qred_correct in * |-.
eapply Qmult_lt_0_le_reg_r; eauto.
Qed.
Lemma Qcmult_lt_compat_r : forall x y z, 0 < z -> x < y -> x*z < y*z.
Proof.
unfold Qcmult, Qclt; intros; simpl in *.
- repeat progress rewrite Qred_correct in *.
+ rewrite !Qred_correct in *.
eapply Qmult_lt_compat_r; eauto.
Qed.
@@ -460,13 +459,13 @@ Proof.
induction n; simpl; auto with qarith.
rewrite IHn; auto with qarith.
Qed.
-
+Transparent Qred.
Lemma Qcpower_0 : forall n, n<>O -> 0^n = 0.
Proof.
destruct n; simpl.
destruct 1; auto.
intros.
- now apply Qc_is_canon.
+ now apply Qc_is_canon.
Qed.
Lemma Qcpower_pos : forall p n, 0 <= p -> 0 <= p^n.
@@ -521,6 +520,7 @@ Add Field Qcfield : Qcft.
(** A field tactic for rational numbers *)
Example test_field : (forall x y : Qc, y<>0 -> (x/y)*y = x)%Qc.
+Proof.
intros.
field.
auto.
diff --git a/theories/QArith/Qfield.v b/theories/QArith/Qfield.v
index a1028ad9..083e40ae 100644
--- a/theories/QArith/Qfield.v
+++ b/theories/QArith/Qfield.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/QArith/Qminmax.v b/theories/QArith/Qminmax.v
index 9a5a1cb1..0fd05325 100644
--- a/theories/QArith/Qminmax.v
+++ b/theories/QArith/Qminmax.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/QArith/Qpower.v b/theories/QArith/Qpower.v
index 112b3738..8bd643aa 100644
--- a/theories/QArith/Qpower.v
+++ b/theories/QArith/Qpower.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -41,6 +41,7 @@ try destruct (Qmult_integral _ _ H0); auto.
Qed.
Lemma Qpower_pos_positive : forall p n, 0 <= p -> 0 <= Qpower_positive p n.
+Proof.
intros p n Hp.
induction n; simpl; repeat apply Qmult_le_0_compat;assumption.
Qed.
diff --git a/theories/QArith/Qreals.v b/theories/QArith/Qreals.v
index 029ae8e3..add43b96 100644
--- a/theories/QArith/Qreals.v
+++ b/theories/QArith/Qreals.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -14,6 +14,7 @@ Require Export QArith_base.
Definition Q2R (x : Q) : R := (IZR (Qnum x) * / IZR (QDen x))%R.
Lemma IZR_nz : forall p : positive, IZR (Zpos p) <> 0%R.
+Proof.
intros; apply not_O_IZR; auto with qarith.
Qed.
@@ -162,19 +163,19 @@ field; auto.
Qed.
Lemma Q2R_minus : forall x y : Q, Q2R (x-y) = (Q2R x - Q2R y)%R.
+Proof.
unfold Qminus; intros; rewrite Q2R_plus; rewrite Q2R_opp; auto.
Qed.
Lemma Q2R_inv : forall x : Q, ~ x==0 -> Q2R (/x) = (/ Q2R x)%R.
Proof.
-unfold Qinv, Q2R, Qeq; intros (x1, x2); unfold Qden, Qnum.
-case x1.
+unfold Qinv, Q2R, Qeq; intros (x1, x2). case x1; unfold Qnum, Qden.
simpl; intros; elim H; trivial.
-intros; field; auto.
+intros; field; auto.
intros;
change (IZR (Zneg x2)) with (- IZR (' x2))%R;
change (IZR (Zneg p)) with (- IZR (' p))%R;
- field; (*auto 8 with real.*)
+ simpl; field; (*auto 8 with real.*)
repeat split; auto; auto with real.
Qed.
@@ -187,25 +188,3 @@ rewrite Q2R_inv; auto.
Qed.
Hint Rewrite Q2R_plus Q2R_mult Q2R_opp Q2R_minus Q2R_inv Q2R_div : q2r_simpl.
-
-Section LegacyQField.
-
-(** In the past, the field tactic was not able to deal with setoid datatypes,
- so translating from Q to R and applying field on reals was a workaround.
- See now Qfield for a direct field tactic on Q. *)
-
-Ltac QField := apply eqR_Qeq; autorewrite with q2r_simpl; try field; auto.
-
-(** Examples of use: *)
-
-Let ex1 : forall x y z : Q, (x+y)*z == (x*z)+(y*z).
-intros; QField.
-Qed.
-
-Let ex2 : forall x y : Q, ~ y==0 -> (x/y)*y == x.
-intros; QField.
-intro; apply H; apply eqR_Qeq.
-rewrite H0; unfold Q2R; simpl; field; auto with real.
-Qed.
-
-End LegacyQField.
diff --git a/theories/QArith/Qreduction.v b/theories/QArith/Qreduction.v
index e8ccdee0..1d304964 100644
--- a/theories/QArith/Qreduction.v
+++ b/theories/QArith/Qreduction.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -126,11 +126,13 @@ Proof.
Qed.
Add Morphism Qmult' : Qmult'_comp.
+Proof.
intros; unfold Qmult'.
rewrite H, H0; auto with qarith.
Qed.
Add Morphism Qminus' : Qminus'_comp.
+Proof.
intros; unfold Qminus'.
rewrite H, H0; auto with qarith.
Qed.
diff --git a/theories/QArith/Qring.v b/theories/QArith/Qring.v
index 9a76bed7..78c464ae 100644
--- a/theories/QArith/Qring.v
+++ b/theories/QArith/Qring.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/QArith/Qround.v b/theories/QArith/Qround.v
index ed3d38b1..964a4bae 100644
--- a/theories/QArith/Qround.v
+++ b/theories/QArith/Qround.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Reals/Alembert.v b/theories/Reals/Alembert.v
index a8548eb7..e848e4df 100644
--- a/theories/Reals/Alembert.v
+++ b/theories/Reals/Alembert.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -35,10 +35,8 @@ Proof.
[ intro | apply Rinv_0_lt_compat; prove_sup0 ].
elim (H0 (/ 2) H1); intros.
exists (sum_f_R0 An x + 2 * An (S x)).
- unfold is_upper_bound; intros; unfold EUn in H3; elim H3; intros.
- rewrite H4; assert (H5 := lt_eq_lt_dec x1 x).
- elim H5; intros.
- elim a; intro.
+ unfold is_upper_bound; intros; unfold EUn in H3; destruct H3 as (x1,->).
+ destruct (lt_eq_lt_dec x1 x) as [[| -> ]|].
replace (sum_f_R0 An x) with
(sum_f_R0 An x1 + sum_f_R0 (fun i:nat => An (S x1 + i)%nat) (x - S x1)).
pattern (sum_f_R0 An x1) at 1; rewrite <- Rplus_0_r;
@@ -47,7 +45,7 @@ Proof.
apply tech1; intros; apply H.
apply Rmult_lt_0_compat; [ prove_sup0 | apply H ].
symmetry ; apply tech2; assumption.
- rewrite b; pattern (sum_f_R0 An x) at 1; rewrite <- Rplus_0_r;
+ pattern (sum_f_R0 An x) at 1; rewrite <- Rplus_0_r;
apply Rplus_le_compat_l.
left; apply Rmult_lt_0_compat; [ prove_sup0 | apply H ].
replace (sum_f_R0 An x1) with
@@ -68,7 +66,7 @@ Proof.
pattern 2 at 3; rewrite <- Rmult_1_r; rewrite <- (Rmult_comm 2);
apply Rmult_le_compat_l.
left; prove_sup0.
- left; apply Rplus_lt_reg_r with ((/ 2) ^ S (x1 - S x)).
+ left; apply Rplus_lt_reg_l with ((/ 2) ^ S (x1 - S x)).
replace ((/ 2) ^ S (x1 - S x) + (1 - (/ 2) ^ S (x1 - S x))) with 1;
[ idtac | ring ].
rewrite <- (Rplus_comm 1); pattern 1 at 1; rewrite <- Rplus_0_r;
@@ -86,8 +84,8 @@ Proof.
apply (tech6 (fun i:nat => An (S x + i)%nat) (/ 2)).
left; apply Rinv_0_lt_compat; prove_sup0.
intro; cut (forall n:nat, (n >= x)%nat -> An (S n) < / 2 * An n).
- intro; replace (S x + S i)%nat with (S (S x + i)).
- apply H6; unfold ge; apply tech8.
+ intro H4; replace (S x + S i)%nat with (S (S x + i)).
+ apply H4; unfold ge; apply tech8.
apply INR_eq; rewrite S_INR; do 2 rewrite plus_INR; do 2 rewrite S_INR; ring.
intros; unfold R_dist in H2; apply Rmult_lt_reg_l with (/ An n).
apply Rinv_0_lt_compat; apply H.
@@ -101,17 +99,17 @@ Proof.
unfold Rdiv; reflexivity.
left; unfold Rdiv; change (0 < An (S n) * / An n);
apply Rmult_lt_0_compat; [ apply H | apply Rinv_0_lt_compat; apply H ].
- red; intro; assert (H8 := H n); rewrite H7 in H8;
+ intro H5; assert (H8 := H n); rewrite H5 in H8;
elim (Rlt_irrefl _ H8).
replace (S x + 0)%nat with (S x); [ reflexivity | ring ].
symmetry ; apply tech2; assumption.
exists (sum_f_R0 An 0); unfold EUn; exists 0%nat; reflexivity.
- intro X; elim X; intros.
+ intros (x,H1).
exists x; apply Un_cv_crit_lub;
[ unfold Un_growing; intro; rewrite tech5;
pattern (sum_f_R0 An n) at 1; rewrite <- Rplus_0_r;
apply Rplus_le_compat_l; left; apply H
- | apply p ].
+ | apply H1 ].
Defined.
Lemma Alembert_C2 :
@@ -127,14 +125,12 @@ Proof.
intro; cut (forall n:nat, 0 < Wn n).
intro; cut (Un_cv (fun n:nat => Rabs (Vn (S n) / Vn n)) 0).
intro; cut (Un_cv (fun n:nat => Rabs (Wn (S n) / Wn n)) 0).
- intro; assert (H5 := Alembert_C1 Vn H1 H3).
- assert (H6 := Alembert_C1 Wn H2 H4).
- elim H5; intros.
- elim H6; intros.
+ intro; pose proof (Alembert_C1 Vn H1 H3) as (x,p).
+ pose proof (Alembert_C1 Wn H2 H4) as (x0,p0).
exists (x - x0); unfold Un_cv; unfold Un_cv in p;
unfold Un_cv in p0; intros; cut (0 < eps / 2).
- intro; elim (p (eps / 2) H8); clear p; intros.
- elim (p0 (eps / 2) H8); clear p0; intros.
+ intro H6; destruct (p (eps / 2) H6) as (x1,H8). clear p.
+ destruct (p0 (eps / 2) H6) as (x2,H9). clear p0.
set (N := max x1 x2).
exists N; intros;
replace (sum_f_R0 An n) with (sum_f_R0 Vn n - sum_f_R0 Wn n).
@@ -146,9 +142,9 @@ Proof.
apply Rabs_triang.
rewrite Rabs_Ropp; apply Rlt_le_trans with (eps / 2 + eps / 2).
apply Rplus_lt_compat.
- unfold R_dist in H9; apply H9; unfold ge; apply le_trans with N;
+ unfold R_dist in H8; apply H8; unfold ge; apply le_trans with N;
[ unfold N; apply le_max_l | assumption ].
- unfold R_dist in H10; apply H10; unfold ge; apply le_trans with N;
+ unfold R_dist in H9; apply H9; unfold ge; apply le_trans with N;
[ unfold N; apply le_max_r | assumption ].
right; symmetry ; apply double_var.
symmetry ; apply tech11; intro; unfold Vn, Wn;
@@ -315,7 +311,7 @@ Proof.
intro; unfold Wn; unfold Rdiv; rewrite <- (Rmult_0_r (/ 2));
rewrite <- (Rmult_comm (/ 2)); apply Rmult_lt_compat_l.
apply Rinv_0_lt_compat; prove_sup0.
- apply Rplus_lt_reg_r with (An n); rewrite Rplus_0_r; unfold Rminus;
+ apply Rplus_lt_reg_l with (An n); rewrite Rplus_0_r; unfold Rminus;
rewrite (Rplus_comm (An n)); rewrite Rplus_assoc;
rewrite Rplus_opp_l; rewrite Rplus_0_r;
apply Rle_lt_trans with (Rabs (An n)).
@@ -325,7 +321,7 @@ Proof.
intro; unfold Vn; unfold Rdiv; rewrite <- (Rmult_0_r (/ 2));
rewrite <- (Rmult_comm (/ 2)); apply Rmult_lt_compat_l.
apply Rinv_0_lt_compat; prove_sup0.
- apply Rplus_lt_reg_r with (- An n); rewrite Rplus_0_r; unfold Rminus;
+ apply Rplus_lt_reg_l with (- An n); rewrite Rplus_0_r; unfold Rminus;
rewrite (Rplus_comm (- An n)); rewrite Rplus_assoc;
rewrite Rplus_opp_r; rewrite Rplus_0_r;
apply Rle_lt_trans with (Rabs (An n)).
@@ -344,9 +340,8 @@ Proof.
intros; set (Bn := fun i:nat => An i * x ^ i).
cut (forall n:nat, Bn n <> 0).
intro; cut (Un_cv (fun n:nat => Rabs (Bn (S n) / Bn n)) 0).
- intro; assert (H4 := Alembert_C2 Bn H2 H3).
- elim H4; intros.
- exists x0; unfold Bn in p; apply tech12; assumption.
+ intro; destruct (Alembert_C2 Bn H2 H3) as (x0,H4).
+ exists x0; unfold Bn in H4; apply tech12; assumption.
unfold Un_cv; intros; unfold Un_cv in H1; cut (0 < eps / Rabs x).
intro; elim (H1 (eps / Rabs x) H4); intros.
exists x0; intros; unfold R_dist; unfold Rminus;
@@ -400,15 +395,14 @@ Theorem Alembert_C3 :
Un_cv (fun n:nat => Rabs (An (S n) / An n)) 0 ->
{ l:R | Pser An x l }.
Proof.
- intros; case (total_order_T x 0); intro.
- elim s; intro.
+ intros; destruct (total_order_T x 0) as [[Hlt|Heq]|Hgt].
cut (x <> 0).
intro; apply AlembertC3_step1; assumption.
- red; intro; rewrite H1 in a; elim (Rlt_irrefl _ a).
+ red; intro; rewrite H1 in Hlt; elim (Rlt_irrefl _ Hlt).
apply AlembertC3_step2; assumption.
cut (x <> 0).
intro; apply AlembertC3_step1; assumption.
- red; intro; rewrite H1 in r; elim (Rlt_irrefl _ r).
+ red; intro; rewrite H1 in Hgt; elim (Rlt_irrefl _ Hgt).
Defined.
Lemma Alembert_C4 :
@@ -432,9 +426,7 @@ Proof.
unfold is_upper_bound; intros; unfold EUn in H6.
elim H6; intros.
rewrite H7.
- assert (H8 := lt_eq_lt_dec x2 x0).
- elim H8; intros.
- elim a; intro.
+ destruct (lt_eq_lt_dec x2 x0) as [[| -> ]|].
replace (sum_f_R0 An x0) with
(sum_f_R0 An x2 + sum_f_R0 (fun i:nat => An (S x2 + i)%nat) (x0 - S x2)).
pattern (sum_f_R0 An x2) at 1; rewrite <- Rplus_0_r.
@@ -443,14 +435,14 @@ Proof.
apply tech1.
intros; apply H.
apply Rmult_lt_0_compat.
- apply Rinv_0_lt_compat; apply Rplus_lt_reg_r with x; rewrite Rplus_0_r;
+ apply Rinv_0_lt_compat; apply Rplus_lt_reg_l with x; rewrite Rplus_0_r;
replace (x + (1 - x)) with 1; [ elim H3; intros; assumption | ring ].
apply H.
symmetry ; apply tech2; assumption.
- rewrite b; pattern (sum_f_R0 An x0) at 1; rewrite <- Rplus_0_r;
+ pattern (sum_f_R0 An x0) at 1; rewrite <- Rplus_0_r;
apply Rplus_le_compat_l.
left; apply Rmult_lt_0_compat.
- apply Rinv_0_lt_compat; apply Rplus_lt_reg_r with x; rewrite Rplus_0_r;
+ apply Rinv_0_lt_compat; apply Rplus_lt_reg_l with x; rewrite Rplus_0_r;
replace (x + (1 - x)) with 1; [ elim H3; intros; assumption | ring ].
apply H.
replace (sum_f_R0 An x2) with
@@ -466,7 +458,7 @@ Proof.
left; apply H.
rewrite tech3.
unfold Rdiv; apply Rmult_le_reg_l with (1 - x).
- apply Rplus_lt_reg_r with x; rewrite Rplus_0_r.
+ apply Rplus_lt_reg_l with x; rewrite Rplus_0_r.
replace (x + (1 - x)) with 1; [ elim H3; intros; assumption | ring ].
do 2 rewrite (Rmult_comm (1 - x)).
rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
@@ -480,11 +472,11 @@ Proof.
elim Hyp; intros; assumption.
elim H3; intros; assumption.
apply Rminus_eq_contra.
- red; intro.
- elim H3; intros.
+ red; intro H10.
+ elim H3; intros H11 H12.
rewrite H10 in H12; elim (Rlt_irrefl _ H12).
- red; intro.
- elim H3; intros.
+ red; intro H10.
+ elim H3; intros H11 H12.
rewrite H10 in H12; elim (Rlt_irrefl _ H12).
replace (An (S x0)) with (An (S x0 + 0)%nat).
apply (tech6 (fun i:nat => An (S x0 + i)%nat) x).
@@ -493,7 +485,7 @@ Proof.
elim H3; intros; assumption.
intro.
cut (forall n:nat, (n >= x0)%nat -> An (S n) < x * An n).
- intro.
+ intro H9.
replace (S x0 + S i)%nat with (S (S x0 + i)).
apply H9.
unfold ge.
@@ -515,18 +507,18 @@ Proof.
apply Rmult_lt_0_compat.
apply H.
apply Rinv_0_lt_compat; apply H.
- red; intro.
+ red; intro H10.
assert (H11 := H n).
rewrite H10 in H11; elim (Rlt_irrefl _ H11).
replace (S x0 + 0)%nat with (S x0); [ reflexivity | ring ].
symmetry ; apply tech2; assumption.
exists (sum_f_R0 An 0); unfold EUn; exists 0%nat; reflexivity.
- intro X; elim X; intros.
+ intros (x,H1).
exists x; apply Un_cv_crit_lub;
[ unfold Un_growing; intro; rewrite tech5;
pattern (sum_f_R0 An n) at 1; rewrite <- Rplus_0_r;
apply Rplus_le_compat_l; left; apply H
- | apply p ].
+ | apply H1].
Qed.
Lemma Alembert_C5 :
@@ -586,14 +578,13 @@ Lemma Alembert_C6 :
elim X; intros.
exists x0.
apply tech12; assumption.
- case (total_order_T x 0); intro.
- elim s; intro.
+ destruct (total_order_T x 0) as [[Hlt|Heq]|Hgt].
eapply Alembert_C5 with (k * Rabs x).
split.
unfold Rdiv; apply Rmult_le_pos.
left; assumption.
left; apply Rabs_pos_lt.
- red; intro; rewrite H3 in a; elim (Rlt_irrefl _ a).
+ red; intro; rewrite H3 in Hlt; elim (Rlt_irrefl _ Hlt).
apply Rmult_lt_reg_l with (/ k).
apply Rinv_0_lt_compat; assumption.
rewrite <- Rmult_assoc.
@@ -604,7 +595,7 @@ Lemma Alembert_C6 :
intro; apply prod_neq_R0.
apply H0.
apply pow_nonzero.
- red; intro; rewrite H3 in a; elim (Rlt_irrefl _ a).
+ red; intro; rewrite H3 in Hlt; elim (Rlt_irrefl _ Hlt).
unfold Un_cv; unfold Un_cv in H1.
intros.
cut (0 < eps / Rabs x).
@@ -621,7 +612,7 @@ Lemma Alembert_C6 :
rewrite Rabs_Rabsolu.
apply Rmult_lt_reg_l with (/ Rabs x).
apply Rinv_0_lt_compat; apply Rabs_pos_lt.
- red; intro; rewrite H7 in a; elim (Rlt_irrefl _ a).
+ red; intro; rewrite H7 in Hlt; elim (Rlt_irrefl _ Hlt).
rewrite <- Rmult_assoc.
rewrite <- Rinv_l_sym.
rewrite Rmult_1_l.
@@ -629,7 +620,7 @@ Lemma Alembert_C6 :
unfold R_dist in H5.
unfold Rdiv; unfold Rdiv in H5; apply H5; assumption.
apply Rabs_no_R0.
- red; intro; rewrite H7 in a; elim (Rlt_irrefl _ a).
+ red; intro; rewrite H7 in Hlt; elim (Rlt_irrefl _ Hlt).
unfold Rdiv; replace (S n) with (n + 1)%nat; [ idtac | ring ].
rewrite pow_add.
simpl.
@@ -641,14 +632,14 @@ Lemma Alembert_C6 :
rewrite <- Rinv_r_sym.
rewrite Rmult_1_r; reflexivity.
apply pow_nonzero.
- red; intro; rewrite H7 in a; elim (Rlt_irrefl _ a).
+ red; intro; rewrite H7 in Hlt; elim (Rlt_irrefl _ Hlt).
apply H0.
apply pow_nonzero.
- red; intro; rewrite H7 in a; elim (Rlt_irrefl _ a).
+ red; intro; rewrite H7 in Hlt; elim (Rlt_irrefl _ Hlt).
unfold Rdiv; apply Rmult_lt_0_compat.
assumption.
apply Rinv_0_lt_compat; apply Rabs_pos_lt.
- red; intro H7; rewrite H7 in a; elim (Rlt_irrefl _ a).
+ red; intro H7; rewrite H7 in Hlt; elim (Rlt_irrefl _ Hlt).
exists (An 0%nat).
unfold Un_cv.
intros.
@@ -661,14 +652,14 @@ Lemma Alembert_C6 :
simpl; ring.
rewrite tech5.
rewrite <- Hrecn.
- rewrite b; simpl; ring.
+ rewrite Heq; simpl; ring.
unfold ge; apply le_O_n.
eapply Alembert_C5 with (k * Rabs x).
split.
unfold Rdiv; apply Rmult_le_pos.
left; assumption.
left; apply Rabs_pos_lt.
- red; intro; rewrite H3 in r; elim (Rlt_irrefl _ r).
+ red; intro; rewrite H3 in Hgt; elim (Rlt_irrefl _ Hgt).
apply Rmult_lt_reg_l with (/ k).
apply Rinv_0_lt_compat; assumption.
rewrite <- Rmult_assoc.
@@ -679,7 +670,7 @@ Lemma Alembert_C6 :
intro; apply prod_neq_R0.
apply H0.
apply pow_nonzero.
- red; intro; rewrite H3 in r; elim (Rlt_irrefl _ r).
+ red; intro; rewrite H3 in Hgt; elim (Rlt_irrefl _ Hgt).
unfold Un_cv; unfold Un_cv in H1.
intros.
cut (0 < eps / Rabs x).
@@ -696,7 +687,7 @@ Lemma Alembert_C6 :
rewrite Rabs_Rabsolu.
apply Rmult_lt_reg_l with (/ Rabs x).
apply Rinv_0_lt_compat; apply Rabs_pos_lt.
- red; intro; rewrite H7 in r; elim (Rlt_irrefl _ r).
+ red; intro; rewrite H7 in Hgt; elim (Rlt_irrefl _ Hgt).
rewrite <- Rmult_assoc.
rewrite <- Rinv_l_sym.
rewrite Rmult_1_l.
@@ -704,7 +695,7 @@ Lemma Alembert_C6 :
unfold R_dist in H5.
unfold Rdiv; unfold Rdiv in H5; apply H5; assumption.
apply Rabs_no_R0.
- red; intro; rewrite H7 in r; elim (Rlt_irrefl _ r).
+ red; intro; rewrite H7 in Hgt; elim (Rlt_irrefl _ Hgt).
unfold Rdiv; replace (S n) with (n + 1)%nat; [ idtac | ring ].
rewrite pow_add.
simpl.
@@ -716,12 +707,12 @@ Lemma Alembert_C6 :
rewrite <- Rinv_r_sym.
rewrite Rmult_1_r; reflexivity.
apply pow_nonzero.
- red; intro; rewrite H7 in r; elim (Rlt_irrefl _ r).
+ red; intro; rewrite H7 in Hgt; elim (Rlt_irrefl _ Hgt).
apply H0.
apply pow_nonzero.
- red; intro; rewrite H7 in r; elim (Rlt_irrefl _ r).
+ red; intro; rewrite H7 in Hgt; elim (Rlt_irrefl _ Hgt).
unfold Rdiv; apply Rmult_lt_0_compat.
assumption.
apply Rinv_0_lt_compat; apply Rabs_pos_lt.
- red; intro H7; rewrite H7 in r; elim (Rlt_irrefl _ r).
+ red; intro H7; rewrite H7 in Hgt; elim (Rlt_irrefl _ Hgt).
Qed.
diff --git a/theories/Reals/AltSeries.v b/theories/Reals/AltSeries.v
index 6d54b791..3e99c989 100644
--- a/theories/Reals/AltSeries.v
+++ b/theories/Reals/AltSeries.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -156,8 +156,7 @@ Proof.
intros.
assert (H2 := CV_ALT_step0 _ H).
assert (H3 := CV_ALT_step4 _ H H0).
- assert (X := growing_cv _ H2 H3).
- elim X; intros.
+ destruct (growing_cv _ H2 H3) as (x,p).
exists x.
unfold Un_cv; unfold R_dist; unfold Un_cv in H1;
unfold R_dist in H1; unfold Un_cv in p; unfold R_dist in p.
@@ -388,16 +387,13 @@ Proof.
apply Rle_ge; apply PI_tg_pos.
apply lt_le_trans with N; assumption.
elim H1; intros H5 _.
- assert (H6 := lt_eq_lt_dec 0 N).
- elim H6; intro.
- elim a; intro.
+ destruct (lt_eq_lt_dec 0 N) as [[| <- ]|H6].
assumption.
- rewrite <- b in H4.
rewrite H4 in H5.
simpl in H5.
cut (0 < / (2 * eps)); [ intro | apply Rinv_0_lt_compat; assumption ].
- elim (Rlt_irrefl _ (Rlt_trans _ _ _ H7 H5)).
- elim (lt_n_O _ b).
+ elim (Rlt_irrefl _ (Rlt_trans _ _ _ H6 H5)).
+ elim (lt_n_O _ H6).
apply le_IZR.
simpl.
left; apply Rlt_trans with (/ (2 * eps)).
@@ -442,7 +438,7 @@ Proof.
unfold Rdiv in H;
apply Rlt_le_trans with (sum_f_R0 (tg_alt PI_tg) (S (2 * 0))).
simpl; unfold tg_alt; simpl; rewrite Rmult_1_l;
- rewrite Rmult_1_r; apply Rplus_lt_reg_r with (PI_tg 1).
+ rewrite Rmult_1_r; apply Rplus_lt_reg_l with (PI_tg 1).
rewrite Rplus_0_r;
replace (PI_tg 1 + (PI_tg 0 + -1 * PI_tg 1)) with (PI_tg 0);
[ unfold PI_tg | ring ].
diff --git a/theories/Reals/ArithProp.v b/theories/Reals/ArithProp.v
index cfc74fc4..c4e410ed 100644
--- a/theories/Reals/ArithProp.v
+++ b/theories/Reals/ArithProp.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -105,14 +105,14 @@ Proof.
exists (x - IZR k0 * y).
split.
ring.
- unfold k0; case (Rcase_abs y); intro.
+ unfold k0; case (Rcase_abs y) as [Hlt|Hge].
assert (H0 := archimed (x / - y)); rewrite <- Z_R_minus; simpl;
unfold Rminus.
replace (- ((1 + - IZR (up (x / - y))) * y)) with
((IZR (up (x / - y)) - 1) * y); [ idtac | ring ].
split.
apply Rmult_le_reg_l with (/ - y).
- apply Rinv_0_lt_compat; apply Ropp_0_gt_lt_contravar; exact r.
+ apply Rinv_0_lt_compat; apply Ropp_0_gt_lt_contravar; exact Hlt.
rewrite Rmult_0_r; rewrite (Rmult_comm (/ - y)); rewrite Rmult_plus_distr_r;
rewrite <- Ropp_inv_permute; [ idtac | assumption ].
rewrite Rmult_assoc; repeat rewrite Ropp_mult_distr_r_reverse;
@@ -125,14 +125,14 @@ Proof.
(- (x * / y) + - (IZR (up (x * / - y)) - 1))) with 1;
[ idtac | ring ].
elim H0; intros _ H1; unfold Rdiv in H1; exact H1.
- rewrite (Rabs_left _ r); apply Rmult_lt_reg_l with (/ - y).
- apply Rinv_0_lt_compat; apply Ropp_0_gt_lt_contravar; exact r.
+ rewrite (Rabs_left _ Hlt); apply Rmult_lt_reg_l with (/ - y).
+ apply Rinv_0_lt_compat; apply Ropp_0_gt_lt_contravar; exact Hlt.
rewrite <- Rinv_l_sym.
rewrite (Rmult_comm (/ - y)); rewrite Rmult_plus_distr_r;
rewrite <- Ropp_inv_permute; [ idtac | assumption ].
rewrite Rmult_assoc; repeat rewrite Ropp_mult_distr_r_reverse;
rewrite <- Rinv_r_sym; [ rewrite Rmult_1_r | assumption ];
- apply Rplus_lt_reg_r with (IZR (up (x / - y)) - 1).
+ apply Rplus_lt_reg_l with (IZR (up (x / - y)) - 1).
replace (IZR (up (x / - y)) - 1 + 1) with (IZR (up (x / - y)));
[ idtac | ring ].
replace (IZR (up (x / - y)) - 1 + (- (x * / y) + - (IZR (up (x / - y)) - 1)))
@@ -157,22 +157,21 @@ Proof.
(IZR (up (x * / y)) - x * / y + (x * / y + (1 - IZR (up (x * / y))))) with
1; [ idtac | ring ]; elim H0; intros _ H2; unfold Rdiv in H2;
exact H2.
- rewrite (Rabs_right _ r); apply Rmult_lt_reg_l with (/ y).
+ rewrite (Rabs_right _ Hge); apply Rmult_lt_reg_l with (/ y).
apply Rinv_0_lt_compat; assumption.
rewrite <- (Rinv_l_sym _ H); rewrite (Rmult_comm (/ y));
rewrite Rmult_plus_distr_r; rewrite Rmult_assoc; rewrite <- Rinv_r_sym;
[ rewrite Rmult_1_r | assumption ];
- apply Rplus_lt_reg_r with (IZR (up (x / y)) - 1);
+ apply Rplus_lt_reg_l with (IZR (up (x / y)) - 1);
replace (IZR (up (x / y)) - 1 + 1) with (IZR (up (x / y)));
[ idtac | ring ];
replace (IZR (up (x / y)) - 1 + (x * / y + (1 - IZR (up (x / y))))) with
(x * / y); [ idtac | ring ]; elim H0; unfold Rdiv;
intros H2 _; exact H2.
- case (total_order_T 0 y); intro.
- elim s; intro.
+ destruct (total_order_T 0 y) as [[Hlt|Heq]|Hgt].
assumption.
- elim H; symmetry ; exact b.
- assert (H1 := Rge_le _ _ r); elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H1 r0)).
+ elim H; symmetry ; exact Heq.
+ apply Rge_le in Hge; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ Hge Hgt)).
Qed.
Lemma tech8 : forall n i:nat, (n <= S n + i)%nat.
diff --git a/theories/Reals/Binomial.v b/theories/Reals/Binomial.v
index 3d6121b7..d48f42fc 100644
--- a/theories/Reals/Binomial.v
+++ b/theories/Reals/Binomial.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -172,13 +172,12 @@ Proof.
apply sum_eq.
intros; apply H1.
unfold N; apply le_lt_trans with n; [ assumption | apply lt_n_Sn ].
- intros; unfold Bn, Cn.
- replace (S N - S i)%nat with (N - i)%nat; reflexivity.
+ reflexivity.
unfold An; fold N; rewrite <- minus_n_n; rewrite H0;
simpl; ring.
apply sum_eq.
- intros; unfold An, Bn; replace (S N - S i)%nat with (N - i)%nat;
- [ idtac | reflexivity ].
+ intros; unfold An, Bn.
+ change (S N - S i)%nat with (N - i)%nat.
rewrite <- pascal;
[ ring
| apply le_lt_trans with n; [ assumption | unfold N; apply lt_n_Sn ] ].
diff --git a/theories/Reals/Cauchy_prod.v b/theories/Reals/Cauchy_prod.v
index 34567cae..28de1186 100644
--- a/theories/Reals/Cauchy_prod.v
+++ b/theories/Reals/Cauchy_prod.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Reals/Cos_plus.v b/theories/Reals/Cos_plus.v
index 71e8d024..49ba9a6e 100644
--- a/theories/Reals/Cos_plus.v
+++ b/theories/Reals/Cos_plus.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -12,6 +12,7 @@ Require Import SeqSeries.
Require Import Rtrigo_def.
Require Import Cos_rel.
Require Import Max.
+Require Import Omega.
Local Open Scope nat_scope.
Local Open Scope R_scope.
diff --git a/theories/Reals/Cos_rel.v b/theories/Reals/Cos_rel.v
index 63ab24fe..f5b34de9 100644
--- a/theories/Reals/Cos_rel.v
+++ b/theories/Reals/Cos_rel.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -10,6 +10,7 @@ Require Import Rbase.
Require Import Rfunctions.
Require Import SeqSeries.
Require Import Rtrigo_def.
+Require Import Omega.
Local Open Scope R_scope.
Definition A1 (x:R) (N:nat) : R :=
@@ -257,49 +258,30 @@ Qed.
Lemma A1_cvg : forall x:R, Un_cv (A1 x) (cos x).
intro.
-assert (H := exist_cos (x * x)).
-elim H; intros.
-assert (p_i := p).
-unfold cos_in in p.
-unfold cos_n, infinite_sum in p.
-unfold R_dist in p.
-cut (cos x = x0).
-intro.
-rewrite H0.
-unfold Un_cv; unfold R_dist; intros.
-elim (p eps H1); intros.
+unfold cos; destruct (exist_cos (Rsqr x)) as (x0,p).
+unfold cos_in, cos_n, infinite_sum, R_dist in p.
+unfold Un_cv, R_dist; intros.
+destruct (p eps H) as (x1,H0).
exists x1; intros.
unfold A1.
replace
(sum_f_R0 (fun k:nat => (-1) ^ k / INR (fact (2 * k)) * x ^ (2 * k)) n) with
(sum_f_R0 (fun i:nat => (-1) ^ i / INR (fact (2 * i)) * (x * x) ^ i) n).
-apply H2; assumption.
+apply H0; assumption.
apply sum_eq.
intros.
replace ((x * x) ^ i) with (x ^ (2 * i)).
reflexivity.
apply pow_sqr.
-unfold cos.
-case (exist_cos (Rsqr x)).
-unfold Rsqr; intros.
-unfold cos_in in p_i.
-unfold cos_in in c.
-apply uniqueness_sum with (fun i:nat => cos_n i * (x * x) ^ i); assumption.
Qed.
Lemma C1_cvg : forall x y:R, Un_cv (C1 x y) (cos (x + y)).
intros.
-assert (H := exist_cos ((x + y) * (x + y))).
-elim H; intros.
-assert (p_i := p).
-unfold cos_in in p.
-unfold cos_n, infinite_sum in p.
-unfold R_dist in p.
-cut (cos (x + y) = x0).
-intro.
-rewrite H0.
-unfold Un_cv; unfold R_dist; intros.
-elim (p eps H1); intros.
+unfold cos.
+destruct (exist_cos (Rsqr (x + y))) as (x0,p).
+unfold cos_in, cos_n, infinite_sum, R_dist in p.
+unfold Un_cv, R_dist; intros.
+destruct (p eps H) as (x1,H0).
exists x1; intros.
unfold C1.
replace
@@ -307,19 +289,12 @@ replace
with
(sum_f_R0
(fun i:nat => (-1) ^ i / INR (fact (2 * i)) * ((x + y) * (x + y)) ^ i) n).
-apply H2; assumption.
+apply H0; assumption.
apply sum_eq.
intros.
replace (((x + y) * (x + y)) ^ i) with ((x + y) ^ (2 * i)).
reflexivity.
apply pow_sqr.
-unfold cos.
-case (exist_cos (Rsqr (x + y))).
-unfold Rsqr; intros.
-unfold cos_in in p_i.
-unfold cos_in in c.
-apply uniqueness_sum with (fun i:nat => cos_n i * ((x + y) * (x + y)) ^ i);
- assumption.
Qed.
Lemma B1_cvg : forall x:R, Un_cv (B1 x) (sin x).
@@ -338,21 +313,14 @@ simpl; ring.
rewrite tech5; rewrite <- Hrecn.
simpl; ring.
unfold ge; apply le_O_n.
-assert (H0 := exist_sin (x * x)).
-elim H0; intros.
-assert (p_i := p).
-unfold sin_in in p.
-unfold sin_n, infinite_sum in p.
-unfold R_dist in p.
-cut (sin x = x * x0).
-intro.
-rewrite H1.
-unfold Un_cv; unfold R_dist; intros.
+unfold sin. destruct (exist_sin (Rsqr x)) as (x0,p).
+unfold sin_in, sin_n, infinite_sum, R_dist in p.
+unfold Un_cv, R_dist; intros.
cut (0 < eps / Rabs x);
[ intro
| unfold Rdiv; apply Rmult_lt_0_compat;
[ assumption | apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption ] ].
-elim (p (eps / Rabs x) H3); intros.
+destruct (p (eps / Rabs x) H1) as (x1,H2).
exists x1; intros.
unfold B1.
replace
@@ -370,9 +338,7 @@ replace
rewrite Rabs_mult.
apply Rmult_lt_reg_l with (/ Rabs x).
apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption.
-rewrite <- Rmult_assoc.
-rewrite <- Rinv_l_sym.
-rewrite Rmult_1_l; rewrite <- (Rmult_comm eps); unfold Rdiv in H4; apply H4;
+rewrite <- Rmult_assoc, <- Rinv_l_sym, Rmult_1_l, <- (Rmult_comm eps). apply H2;
assumption.
apply Rabs_no_R0; assumption.
rewrite scal_sum.
@@ -382,12 +348,4 @@ rewrite pow_add.
rewrite pow_sqr.
simpl.
ring.
-unfold sin.
-case (exist_sin (Rsqr x)).
-unfold Rsqr; intros.
-unfold sin_in in p_i.
-unfold sin_in in s.
-assert
- (H1 := uniqueness_sum (fun i:nat => sin_n i * (x * x) ^ i) x0 x1 p_i s).
-rewrite H1; reflexivity.
Qed.
diff --git a/theories/Reals/DiscrR.v b/theories/Reals/DiscrR.v
index 3a2d51f9..75fd4c0a 100644
--- a/theories/Reals/DiscrR.v
+++ b/theories/Reals/DiscrR.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -11,16 +11,19 @@ Require Import Omega.
Local Open Scope R_scope.
Lemma Rlt_R0_R2 : 0 < 2.
+Proof.
change 2 with (INR 2); apply lt_INR_0; apply lt_O_Sn.
Qed.
Notation Rplus_lt_pos := Rplus_lt_0_compat (only parsing).
Lemma IZR_eq : forall z1 z2:Z, z1 = z2 -> IZR z1 = IZR z2.
+Proof.
intros; rewrite H; reflexivity.
Qed.
Lemma IZR_neq : forall z1 z2:Z, z1 <> z2 -> IZR z1 <> IZR z2.
+Proof.
intros; red; intro; elim H; apply eq_IZR; assumption.
Qed.
diff --git a/theories/Reals/Exp_prop.v b/theories/Reals/Exp_prop.v
index 0d418bc3..be96b94e 100644
--- a/theories/Reals/Exp_prop.v
+++ b/theories/Reals/Exp_prop.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -15,6 +15,7 @@ Require Import PSeries_reg.
Require Import Div2.
Require Import Even.
Require Import Max.
+Require Import Omega.
Local Open Scope nat_scope.
Local Open Scope R_scope.
@@ -85,18 +86,17 @@ Qed.
Lemma div2_not_R0 : forall N:nat, (1 < N)%nat -> (0 < div2 N)%nat.
Proof.
- intros; induction N as [| N HrecN].
- elim (lt_n_O _ H).
- cut ((1 < N)%nat \/ N = 1%nat).
- intro; elim H0; intro.
- assert (H2 := even_odd_dec N).
- elim H2; intro.
- rewrite <- (even_div2 _ a); apply HrecN; assumption.
- rewrite <- (odd_div2 _ b); apply lt_O_Sn.
- rewrite H1; simpl; apply lt_O_Sn.
- inversion H.
- right; reflexivity.
- left; apply lt_le_trans with 2%nat; [ apply lt_n_Sn | apply H1 ].
+ intros; induction N as [| N HrecN].
+ - elim (lt_n_O _ H).
+ - cut ((1 < N)%nat \/ N = 1%nat).
+ { intro; elim H0; intro.
+ + destruct (even_odd_dec N) as [Heq|Heq].
+ * rewrite <- (even_div2 _ Heq); apply HrecN; assumption.
+ * rewrite <- (odd_div2 _ Heq); apply lt_O_Sn.
+ + rewrite H1; simpl; apply lt_O_Sn. }
+ inversion H.
+ right; reflexivity.
+ left; apply lt_le_trans with 2%nat; [ apply lt_n_Sn | apply H1 ].
Qed.
Lemma Reste_E_maj :
@@ -173,8 +173,7 @@ Proof.
apply pow_le; apply Rabs_pos.
rewrite (Rmult_comm (/ INR (fact (S n0)))); apply Rmult_le_compat_l.
apply pow_le; apply Rabs_pos.
- apply Rle_Rinv.
- apply INR_fact_lt_0.
+ apply Rinv_le_contravar.
apply INR_fact_lt_0.
apply le_INR; apply fact_le; apply le_n_S.
apply le_plus_l.
@@ -254,8 +253,7 @@ Proof.
do 2 rewrite <- (Rmult_comm (/ INR (fact (N - n0)))).
apply Rmult_le_compat_l.
left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
- apply Rle_Rinv.
- apply INR_fact_lt_0.
+ apply Rinv_le_contravar.
apply INR_fact_lt_0.
apply le_INR.
apply fact_le.
@@ -724,15 +722,14 @@ Qed.
(**********)
Lemma exp_pos : forall x:R, 0 < exp x.
Proof.
- intro; case (total_order_T 0 x); intro.
- elim s; intro.
- apply (exp_pos_pos _ a).
- rewrite <- b; rewrite exp_0; apply Rlt_0_1.
+ intro; destruct (total_order_T 0 x) as [[Hlt|<-]|Hgt].
+ apply (exp_pos_pos _ Hlt).
+ rewrite exp_0; apply Rlt_0_1.
replace (exp x) with (1 / exp (- x)).
unfold Rdiv; apply Rmult_lt_0_compat.
apply Rlt_0_1.
apply Rinv_0_lt_compat; apply exp_pos_pos.
- apply (Ropp_0_gt_lt_contravar _ r).
+ apply (Ropp_0_gt_lt_contravar _ Hgt).
cut (exp (- x) <> 0).
intro; unfold Rdiv; apply Rmult_eq_reg_l with (exp (- x)).
rewrite Rmult_1_l; rewrite <- Rinv_r_sym.
@@ -773,10 +770,10 @@ Proof.
apply (not_eq_sym H6).
rewrite Rminus_0_r; apply H7.
unfold SFL.
- case (cv 0); intros.
+ case (cv 0) as (x,Hu).
eapply UL_sequence.
- apply u.
- unfold Un_cv, SP.
+ apply Hu.
+ unfold Un_cv, SP in |- *.
intros; exists 1%nat; intros.
unfold R_dist; rewrite decomp_sum.
rewrite (Rplus_comm (fn 0%nat 0)).
@@ -793,14 +790,13 @@ Proof.
unfold Rdiv; rewrite Rinv_1; rewrite Rmult_1_r; reflexivity.
apply lt_le_trans with 1%nat; [ apply lt_n_Sn | apply H9 ].
unfold SFL, exp.
- case (cv h); case (exist_exp h); simpl; intros.
+ case (cv h) as (x0,Hu); case (exist_exp h) as (x,Hexp); simpl.
eapply UL_sequence.
- apply u.
+ apply Hu.
unfold Un_cv; intros.
- unfold exp_in in e.
- unfold infinite_sum in e.
+ unfold exp_in, infinite_sum in Hexp.
cut (0 < eps0 * Rabs h).
- intro; elim (e _ H9); intros N0 H10.
+ intro; elim (Hexp _ H9); intros N0 H10.
exists N0; intros.
unfold R_dist.
apply Rmult_lt_reg_l with (Rabs h).
@@ -860,8 +856,7 @@ Proof.
Un_cv
(fun n:nat =>
sum_f_R0 (fun k:nat => Rabs (r ^ k / INR (fact (S k)))) n) l }.
- intro X.
- elim X; intros.
+ intros (x,p).
exists x; intros.
split.
apply p.
diff --git a/theories/Reals/Integration.v b/theories/Reals/Integration.v
index 50b57374..222d106f 100644
--- a/theories/Reals/Integration.v
+++ b/theories/Reals/Integration.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Reals/LegacyRfield.v b/theories/Reals/LegacyRfield.v
deleted file mode 100644
index cc8a8f7c..00000000
--- a/theories/Reals/LegacyRfield.v
+++ /dev/null
@@ -1,38 +0,0 @@
-(************************************************************************)
-(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
-(* \VV/ **************************************************************)
-(* // * This file is distributed under the terms of the *)
-(* * GNU Lesser General Public License Version 2.1 *)
-(************************************************************************)
-
-Require Export Raxioms.
-Require Export LegacyField.
-Import LegacyRing_theory.
-
-Section LegacyRfield.
-
-Open Scope R_scope.
-
-Lemma RLegacyTheory : Ring_Theory Rplus Rmult 1 0 Ropp (fun x y:R => false).
- split.
- exact Rplus_comm.
- symmetry ; apply Rplus_assoc.
- exact Rmult_comm.
- symmetry ; apply Rmult_assoc.
- intro; apply Rplus_0_l.
- intro; apply Rmult_1_l.
- exact Rplus_opp_r.
- intros.
- rewrite Rmult_comm.
- rewrite (Rmult_comm n p).
- rewrite (Rmult_comm m p).
- apply Rmult_plus_distr_l.
- intros; contradiction.
-Defined.
-
-End LegacyRfield.
-
-Add Legacy Field
-R Rplus Rmult 1%R 0%R Ropp (fun x y:R => false) Rinv RLegacyTheory Rinv_l
- with minus := Rminus div := Rdiv.
diff --git a/theories/Reals/MVT.v b/theories/Reals/MVT.v
index d3970069..59976957 100644
--- a/theories/Reals/MVT.v
+++ b/theories/Reals/MVT.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -151,14 +151,14 @@ Proof.
cut (forall c:R, a <= c <= b -> continuity_pt id c);
[ intro | intros; apply derivable_continuous_pt; apply derivable_id ].
assert (H2 := MVT f id a b X X0 H H0 H1).
- elim H2; intros c H3; elim H3; intros.
+ destruct H2 as (c & P & H4).
exists c; split.
- cut (derive_pt id c (X0 c x) = derive_pt id c (derivable_pt_id c));
- [ intro | apply pr_nu ].
+ cut (derive_pt id c (X0 c P) = derive_pt id c (derivable_pt_id c));
+ [ intro H5 | apply pr_nu ].
rewrite H5 in H4; rewrite (derive_pt_id c) in H4; rewrite Rmult_1_r in H4;
- rewrite <- H4; replace (derive_pt f c (X c x)) with (derive_pt f c (pr c));
+ rewrite <- H4; replace (derive_pt f c (X c P)) with (derive_pt f c (pr c));
[ idtac | apply pr_nu ]; apply Rmult_comm.
- apply x.
+ apply P.
Qed.
Theorem MVT_cor2 :
@@ -173,14 +173,14 @@ Proof.
intro; cut (forall c:R, a <= c <= b -> derivable_pt id c).
intro X1; cut (forall c:R, a < c < b -> derivable_pt id c).
intro X2; cut (forall c:R, a <= c <= b -> continuity_pt id c).
- intro; elim (MVT f id a b X0 X2 H H1 H2); intros; elim H3; clear H3; intros;
- exists x; split.
- cut (derive_pt id x (X2 x x0) = 1).
- cut (derive_pt f x (X0 x x0) = f' x).
+ intro; elim (MVT f id a b X0 X2 H H1 H2); intros x (P,H3).
+ exists x; split.
+ cut (derive_pt id x (X2 x P) = 1).
+ cut (derive_pt f x (X0 x P) = f' x).
intros; rewrite H4 in H3; rewrite H5 in H3; unfold id in H3;
rewrite Rmult_1_r in H3; rewrite Rmult_comm; symmetry ;
assumption.
- apply derive_pt_eq_0; apply H0; elim x0; intros; split; left; assumption.
+ apply derive_pt_eq_0; apply H0; elim P; intros; split; left; assumption.
apply derive_pt_eq_0; apply derivable_pt_lim_id.
assumption.
intros; apply derivable_continuous_pt; apply X1; assumption.
@@ -217,12 +217,12 @@ Proof.
assert (H3 := MVT f id a b pr H2 H0 H);
assert (H4 : forall x:R, a <= x <= b -> continuity_pt id x).
intros; apply derivable_continuous; apply derivable_id.
- elim (H3 H4); intros; elim H5; intros; exists x; exists x0; rewrite H1 in H6;
- unfold id in H6; unfold Rminus in H6; rewrite Rplus_opp_r in H6;
- rewrite Rmult_0_l in H6; apply Rmult_eq_reg_l with (b - a);
- [ rewrite Rmult_0_r; apply H6
- | apply Rminus_eq_contra; red; intro; rewrite H7 in H0;
- elim (Rlt_irrefl _ H0) ].
+ destruct (H3 H4) as (c & P & H6). exists c; exists P; rewrite H1 in H6.
+ unfold id in H6; unfold Rminus in H6; rewrite Rplus_opp_r in H6.
+ rewrite Rmult_0_l in H6; apply Rmult_eq_reg_l with (b - a);
+ [ rewrite Rmult_0_r; apply H6
+ | apply Rminus_eq_contra; red; intro H7; rewrite H7 in H0;
+ elim (Rlt_irrefl _ H0) ].
Qed.
(**********)
@@ -233,21 +233,18 @@ Proof.
intros.
unfold increasing.
intros.
- case (total_order_T x y); intro.
- elim s; intro.
+ destruct (total_order_T x y) as [[H1| ->]|H1].
apply Rplus_le_reg_l with (- f x).
rewrite Rplus_opp_l; rewrite Rplus_comm.
- assert (H1 := MVT_cor1 f _ _ pr a).
- elim H1; intros.
- elim H2; intros.
+ pose proof (MVT_cor1 f _ _ pr H1) as (c & H3 & H4).
unfold Rminus in H3.
rewrite H3.
apply Rmult_le_pos.
apply H.
apply Rplus_le_reg_l with x.
rewrite Rplus_0_r; replace (x + (y + - x)) with y; [ assumption | ring ].
- rewrite b; right; reflexivity.
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 r)).
+ right; reflexivity.
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 H1)).
Qed.
(**********)
@@ -269,7 +266,7 @@ Proof.
cut ((f (x + delta / 2) - f x) / (delta / 2) <= 0).
intro; cut (0 < - ((f (x + delta / 2) - f x) / (delta / 2) - l)).
intro; unfold Rabs;
- case (Rcase_abs ((f (x + delta / 2) - f x) / (delta / 2) - l)).
+ case (Rcase_abs ((f (x + delta / 2) - f x) / (delta / 2) - l)) as [Hlt|Hge].
intros;
generalize
(Rplus_lt_compat_r (- l) (- ((f (x + delta / 2) - f x) / (delta / 2) - l))
@@ -294,7 +291,7 @@ Proof.
ring.
intros.
generalize
- (Ropp_ge_le_contravar ((f (x + delta / 2) - f x) / (delta / 2) - l) 0 r).
+ (Ropp_ge_le_contravar ((f (x + delta / 2) - f x) / (delta / 2) - l) _ Hge).
rewrite Ropp_0.
intro.
elim
@@ -412,7 +409,7 @@ Proof.
intros.
unfold strict_increasing.
intros.
- apply Rplus_lt_reg_r with (- f x).
+ apply Rplus_lt_reg_l with (- f x).
rewrite Rplus_opp_l; rewrite Rplus_comm.
assert (H1 := MVT_cor1 f _ _ pr H0).
elim H1; intros.
@@ -421,7 +418,7 @@ Proof.
rewrite H3.
apply Rmult_lt_0_compat.
apply H.
- apply Rplus_lt_reg_r with x.
+ apply Rplus_lt_reg_l with x.
rewrite Rplus_0_r; replace (x + (y + - x)) with y; [ assumption | ring ].
Qed.
@@ -517,7 +514,7 @@ Lemma derive_increasing_interv_ax :
Proof.
intros.
split; intros.
- apply Rplus_lt_reg_r with (- f x).
+ apply Rplus_lt_reg_l with (- f x).
rewrite Rplus_opp_l; rewrite Rplus_comm.
assert (H4 := MVT_cor1 f _ _ pr H3).
elim H4; intros.
@@ -532,7 +529,7 @@ Proof.
apply Rle_lt_trans with x; assumption.
elim H2; intros.
apply Rlt_le_trans with y; assumption.
- apply Rplus_lt_reg_r with x.
+ apply Rplus_lt_reg_l with x.
rewrite Rplus_0_r; replace (x + (y + - x)) with y; [ assumption | ring ].
apply Rplus_le_reg_l with (- f x).
rewrite Rplus_opp_l; rewrite Rplus_comm.
@@ -587,12 +584,8 @@ Theorem IAF :
f b - f a <= k * (b - a).
Proof.
intros.
- case (total_order_T a b); intro.
- elim s; intro.
- assert (H1 := MVT_cor1 f _ _ pr a0).
- elim H1; intros.
- elim H2; intros.
- rewrite H3.
+ destruct (total_order_T a b) as [[H1| -> ]|H1].
+ pose proof (MVT_cor1 f _ _ pr H1) as (c & -> & H4).
do 2 rewrite <- (Rmult_comm (b - a)).
apply Rmult_le_compat_l.
apply Rplus_le_reg_l with a; rewrite Rplus_0_r.
@@ -600,10 +593,9 @@ Proof.
apply H0.
elim H4; intros.
split; left; assumption.
- rewrite b0.
unfold Rminus; do 2 rewrite Rplus_opp_r.
rewrite Rmult_0_r; right; reflexivity.
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)).
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H H1)).
Qed.
Lemma IAF_var :
@@ -648,8 +640,7 @@ Lemma null_derivative_loc :
(forall (x:R) (P:a < x < b), derive_pt f x (pr x P) = 0) ->
constant_D_eq f (fun x:R => a <= x <= b) (f a).
Proof.
- intros; unfold constant_D_eq; intros; case (total_order_T a b); intro.
- elim s; intro.
+ intros; unfold constant_D_eq; intros; destruct (total_order_T a b) as [[Hlt|Heq]|Hgt].
assert (H2 : forall y:R, a < y < x -> derivable_pt id y).
intros; apply derivable_pt_id.
assert (H3 : forall y:R, a <= y <= x -> continuity_pt id y).
@@ -664,24 +655,25 @@ Proof.
elim H1; intros; apply Rle_trans with x; assumption.
elim H1; clear H1; intros; elim H1; clear H1; intro.
assert (H7 := MVT f id a x H4 H2 H1 H5 H3).
- elim H7; intros; elim H8; intros; assert (H10 : a < x0 < b).
- elim x1; intros; split.
- assumption.
- apply Rlt_le_trans with x; assumption.
- assert (H11 : derive_pt f x0 (H4 x0 x1) = 0).
- replace (derive_pt f x0 (H4 x0 x1)) with (derive_pt f x0 (pr x0 H10));
+ destruct H7 as (c & P & H9).
+ assert (H10 : a < c < b).
+ split.
+ apply P.
+ apply Rlt_le_trans with x; [apply P|assumption].
+ assert (H11 : derive_pt f c (H4 c P) = 0).
+ replace (derive_pt f c (H4 c P)) with (derive_pt f c (pr c H10));
[ apply H0 | apply pr_nu ].
- assert (H12 : derive_pt id x0 (H2 x0 x1) = 1).
+ assert (H12 : derive_pt id c (H2 c P) = 1).
apply derive_pt_eq_0; apply derivable_pt_lim_id.
rewrite H11 in H9; rewrite H12 in H9; rewrite Rmult_0_r in H9;
rewrite Rmult_1_r in H9; apply Rminus_diag_uniq; symmetry ;
assumption.
rewrite H1; reflexivity.
assert (H2 : x = a).
- rewrite <- b0 in H1; elim H1; intros; apply Rle_antisym; assumption.
+ rewrite <- Heq in H1; elim H1; intros; apply Rle_antisym; assumption.
rewrite H2; reflexivity.
elim H1; intros;
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ (Rle_trans _ _ _ H2 H3) r)).
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ (Rle_trans _ _ _ H2 H3) Hgt)).
Qed.
(* Unicity of the antiderivative *)
@@ -718,3 +710,32 @@ Proof.
unfold constant_D_eq in H8; assert (H9 := H8 _ H2);
unfold minus_fct in H9; rewrite <- H9; ring.
Qed.
+
+(* A variant of MVT using absolute values. *)
+Lemma MVT_abs :
+ forall (f f' : R -> R) (a b : R),
+ (forall c : R, Rmin a b <= c <= Rmax a b ->
+ derivable_pt_lim f c (f' c)) ->
+ exists c : R, Rabs (f b - f a) = Rabs (f' c) * Rabs (b - a) /\
+ Rmin a b <= c <= Rmax a b.
+Proof.
+intros f f' a b.
+destruct (Rle_dec a b) as [aleb | blta].
+ destruct (Req_dec a b) as [ab | anb].
+ unfold Rminus; intros _; exists a; split.
+ now rewrite <- ab, !Rplus_opp_r, Rabs_R0, Rmult_0_r.
+ split;[apply Rmin_l | apply Rmax_l].
+ rewrite Rmax_right, Rmin_left; auto; intros derv.
+ destruct (MVT_cor2 f f' a b) as [c [hc intc]];
+ [destruct aleb;[assumption | contradiction] | apply derv | ].
+ exists c; rewrite hc, Rabs_mult;split;
+ [reflexivity | unfold Rle; tauto].
+assert (b < a) by (apply Rnot_le_gt; assumption).
+assert (b <= a) by (apply Rlt_le; assumption).
+rewrite Rmax_left, Rmin_right; try assumption; intros derv.
+destruct (MVT_cor2 f f' b a) as [c [hc intc]];
+ [assumption | apply derv | ].
+exists c; rewrite <- Rabs_Ropp, Ropp_minus_distr, hc, Rabs_mult.
+split;[now rewrite <- (Rabs_Ropp (b - a)), Ropp_minus_distr| unfold Rle; tauto].
+Qed.
+
diff --git a/theories/Reals/Machin.v b/theories/Reals/Machin.v
index 40a857e3..1a94f6a8 100644
--- a/theories/Reals/Machin.v
+++ b/theories/Reals/Machin.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -16,6 +16,7 @@ Require Import Rseries.
Require Import SeqProp.
Require Import PartSum.
Require Import Ratan.
+Require Import Omega.
Local Open Scope R_scope.
@@ -27,6 +28,7 @@ Lemma atan_sub_correct :
forall u v, 1 + u * v <> 0 -> -PI/2 < atan u - atan v < PI/2 ->
-PI/2 < atan (atan_sub u v) < PI/2 ->
atan u = atan v + atan (atan_sub u v).
+Proof.
intros u v pn0 uvint aint.
assert (cos (atan u) <> 0).
destruct (atan_bound u); apply Rgt_not_eq, cos_gt_0; auto.
@@ -44,6 +46,7 @@ Qed.
Lemma tech : forall x y , -1 <= x <= 1 -> -1 < y < 1 ->
-PI/2 < atan x - atan y < PI/2.
+Proof.
assert (ut := PI_RGT_0).
intros x y [xm1 x1] [ym1 y1].
assert (-(PI/4) <= atan x).
@@ -67,6 +70,7 @@ Qed.
(* A simple formula, reasonably efficient. *)
Lemma Machin_2_3 : PI/4 = atan(/2) + atan(/3).
+Proof.
assert (utility : 0 < PI/2) by (apply PI2_RGT_0).
rewrite <- atan_1.
rewrite (atan_sub_correct 1 (/2)).
@@ -77,6 +81,7 @@ apply atan_bound.
Qed.
Lemma Machin_4_5_239 : PI/4 = 4 * atan (/5) - atan(/239).
+Proof.
rewrite <- atan_1.
rewrite (atan_sub_correct 1 (/5));
[ | apply Rgt_not_eq; fourier | apply tech; try split; fourier |
@@ -105,6 +110,7 @@ unfold atan_sub; field.
Qed.
Lemma Machin_2_3_7 : PI/4 = 2 * atan(/3) + (atan (/7)).
+Proof.
rewrite <- atan_1.
rewrite (atan_sub_correct 1 (/3));
[ | apply Rgt_not_eq; fourier | apply tech; try split; fourier |
diff --git a/theories/Reals/NewtonInt.v b/theories/Reals/NewtonInt.v
index 8faf3b41..832e7adc 100644
--- a/theories/Reals/NewtonInt.v
+++ b/theories/Reals/NewtonInt.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -63,14 +63,16 @@ Proof.
[ apply derivable_pt_lim_const | apply derivable_pt_lim_id ]
| unfold id, fct_cte; rewrite H2; ring ].
right; reflexivity.
-Defined.
+Qed.
(* $\int_a^a f = 0$ *)
Lemma NewtonInt_P2 :
forall (f:R -> R) (a:R), NewtonInt f a a (NewtonInt_P1 f a) = 0.
Proof.
intros; unfold NewtonInt; simpl;
- unfold mult_fct, fct_cte, id; ring.
+ unfold mult_fct, fct_cte, id.
+ destruct NewtonInt_P1 as [g _].
+ now apply Rminus_diag_eq.
Qed.
(* If $\int_a^b f$ exists, then $\int_b^a f$ exists too *)
@@ -87,42 +89,7 @@ Lemma NewtonInt_P4 :
forall (f:R -> R) (a b:R) (pr:Newton_integrable f a b),
NewtonInt f a b pr = - NewtonInt f b a (NewtonInt_P3 f a b pr).
Proof.
- intros; unfold Newton_integrable in pr; elim pr; intros; elim p; intro.
- unfold NewtonInt;
- case
- (NewtonInt_P3 f a b
- (exist
- (fun g:R -> R => antiderivative f g a b \/ antiderivative f g b a) x
- p)).
- intros; elim o; intro.
- unfold antiderivative in H0; elim H0; intros; elim H2; intro.
- unfold antiderivative in H; elim H; intros;
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H5 H3)).
- rewrite H3; ring.
- assert (H1 := antiderivative_Ucte f x x0 a b H H0); elim H1; intros;
- unfold antiderivative in H0; elim H0; clear H0; intros _ H0.
- assert (H3 : a <= a <= b).
- split; [ right; reflexivity | assumption ].
- assert (H4 : a <= b <= b).
- split; [ assumption | right; reflexivity ].
- assert (H5 := H2 _ H3); assert (H6 := H2 _ H4); rewrite H5; rewrite H6; ring.
- unfold NewtonInt;
- case
- (NewtonInt_P3 f a b
- (exist
- (fun g:R -> R => antiderivative f g a b \/ antiderivative f g b a) x
- p)); intros; elim o; intro.
- assert (H1 := antiderivative_Ucte f x x0 b a H H0); elim H1; intros;
- unfold antiderivative in H0; elim H0; clear H0; intros _ H0.
- assert (H3 : b <= a <= a).
- split; [ assumption | right; reflexivity ].
- assert (H4 : b <= b <= a).
- split; [ right; reflexivity | assumption ].
- assert (H5 := H2 _ H3); assert (H6 := H2 _ H4); rewrite H5; rewrite H6; ring.
- unfold antiderivative in H0; elim H0; intros; elim H2; intro.
- unfold antiderivative in H; elim H; intros;
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H5 H3)).
- rewrite H3; ring.
+ intros f a b (x,H). unfold NewtonInt, NewtonInt_P3; simpl; ring.
Qed.
(* The set of Newton integrable functions is a vectorial space *)
@@ -133,7 +100,7 @@ Lemma NewtonInt_P5 :
Newton_integrable (fun x:R => l * f x + g x) a b.
Proof.
unfold Newton_integrable; intros f g l a b X X0;
- elim X; intros; elim X0; intros;
+ elim X; intros x p; elim X0; intros x0 p0;
exists (fun y:R => l * x y + x0 y).
elim p; intro.
elim p0; intro.
@@ -227,10 +194,8 @@ Lemma NewtonInt_P6 :
l * NewtonInt f a b pr1 + NewtonInt g a b pr2.
Proof.
intros f g l a b pr1 pr2; unfold NewtonInt;
- case (NewtonInt_P5 f g l a b pr1 pr2); intros; case pr1;
- intros; case pr2; intros; case (total_order_T a b);
- intro.
- elim s; intro.
+ destruct (NewtonInt_P5 f g l a b pr1 pr2) as (x,o); destruct pr1 as (x0,o0);
+ destruct pr2 as (x1,o1); destruct (total_order_T a b) as [[Hlt|Heq]|Hgt].
elim o; intro.
elim o0; intro.
elim o1; intro.
@@ -242,21 +207,21 @@ Proof.
split; [ left; assumption | right; reflexivity ].
assert (H7 := H4 _ H5); assert (H8 := H4 _ H6); rewrite H7; rewrite H8; ring.
unfold antiderivative in H1; elim H1; intros;
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H3 a0)).
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H3 Hlt)).
unfold antiderivative in H0; elim H0; intros;
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 a0)).
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 Hlt)).
unfold antiderivative in H; elim H; intros;
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H1 a0)).
- rewrite b0; ring.
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H1 Hlt)).
+ rewrite Heq; ring.
elim o; intro.
unfold antiderivative in H; elim H; intros;
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H1 r)).
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H1 Hgt)).
elim o0; intro.
unfold antiderivative in H0; elim H0; intros;
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 r)).
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 Hgt)).
elim o1; intro.
unfold antiderivative in H1; elim H1; intros;
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H3 r)).
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H3 Hgt)).
assert (H2 := antiderivative_P1 f g x0 x1 l b a H0 H1);
assert (H3 := antiderivative_Ucte _ _ _ _ _ H H2);
elim H3; intros; assert (H5 : b <= a <= a).
@@ -277,14 +242,12 @@ Lemma antiderivative_P2 :
| right _ => F1 x + (F0 b - F1 b)
end) a c.
Proof.
- unfold antiderivative; intros; elim H; clear H; intros; elim H0;
- clear H0; intros; split.
+ intros; destruct H as (H,H1), H0 as (H0,H2); split.
2: apply Rle_trans with b; assumption.
- intros; elim H3; clear H3; intros; case (total_order_T x b); intro.
- elim s; intro.
+ intros x (H3,H4); destruct (total_order_T x b) as [[Hlt|Heq]|Hgt].
assert (H5 : a <= x <= b).
split; [ assumption | left; assumption ].
- assert (H6 := H _ H5); elim H6; clear H6; intros;
+ destruct (H _ H5) as (x0,H6).
assert
(H7 :
derivable_pt_lim
@@ -293,27 +256,26 @@ Proof.
| left _ => F0 x
| right _ => F1 x + (F0 b - F1 b)
end) x (f x)).
- unfold derivable_pt_lim; assert (H7 : derive_pt F0 x x0 = f x).
- symmetry ; assumption.
- assert (H8 := derive_pt_eq_1 F0 x (f x) x0 H7); unfold derivable_pt_lim in H8;
- intros; elim (H8 _ H9); intros; set (D := Rmin x1 (b - x)).
+ unfold derivable_pt_lim. intros eps H9.
+ assert (H7 : derive_pt F0 x x0 = f x) by (symmetry; assumption).
+ destruct (derive_pt_eq_1 F0 x (f x) x0 H7 _ H9) as (x1,H10); set (D := Rmin x1 (b - x)).
assert (H11 : 0 < D).
- unfold D; unfold Rmin; case (Rle_dec x1 (b - x)); intro.
+ unfold D, Rmin; case (Rle_dec x1 (b - x)); intro.
apply (cond_pos x1).
apply Rlt_Rminus; assumption.
- exists (mkposreal _ H11); intros; case (Rle_dec x b); intro.
- case (Rle_dec (x + h) b); intro.
+ exists (mkposreal _ H11); intros h H12 H13. case (Rle_dec x b) as [|[]].
+ case (Rle_dec (x + h) b) as [|[]].
apply H10.
assumption.
apply Rlt_le_trans with D; [ assumption | unfold D; apply Rmin_l ].
- elim n; left; apply Rlt_le_trans with (x + D).
+ left; apply Rlt_le_trans with (x + D).
apply Rplus_lt_compat_l; apply Rle_lt_trans with (Rabs h).
apply RRle_abs.
apply H13.
apply Rplus_le_reg_l with (- x); rewrite <- Rplus_assoc; rewrite Rplus_opp_l;
rewrite Rplus_0_l; rewrite Rplus_comm; unfold D;
apply Rmin_r.
- elim n; left; assumption.
+ left; assumption.
assert
(H8 :
derivable_pt
@@ -348,7 +310,7 @@ Proof.
unfold D; unfold Rmin; case (Rle_dec x2 x3); intro.
apply (cond_pos x2).
apply (cond_pos x3).
- exists (mkposreal _ H16); intros; case (Rle_dec x b); intro.
+ exists (mkposreal _ H16); intros; case (Rle_dec x b) as [|[]].
case (Rle_dec (x + h) b); intro.
apply H15.
assumption.
@@ -357,8 +319,8 @@ Proof.
apply H14.
assumption.
apply Rlt_le_trans with D; [ assumption | unfold D; apply Rmin_l ].
- rewrite b0; ring.
- elim n; right; assumption.
+ rewrite Heq; ring.
+ right; assumption.
assert
(H14 :
derivable_pt
@@ -388,12 +350,12 @@ Proof.
unfold D; unfold Rmin; case (Rle_dec x1 (x - b)); intro.
apply (cond_pos x1).
apply Rlt_Rminus; assumption.
- exists (mkposreal _ H11); intros; case (Rle_dec x b); intro.
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r0 r)).
- case (Rle_dec (x + h) b); intro.
+ exists (mkposreal _ H11); intros; destruct (Rle_dec x b) as [Hle|Hnle].
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ Hle Hgt)).
+ destruct (Rle_dec (x + h) b) as [Hle'|Hnle'].
cut (b < x + h).
- intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r0 H14)).
- apply Rplus_lt_reg_r with (- h - b); replace (- h - b + b) with (- h);
+ intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ Hle' H14)).
+ apply Rplus_lt_reg_l with (- h - b); replace (- h - b + b) with (- h);
[ idtac | ring ]; replace (- h - b + (x + h)) with (x - b);
[ idtac | ring ]; apply Rle_lt_trans with (Rabs h).
rewrite <- Rabs_Ropp; apply RRle_abs.
@@ -425,8 +387,7 @@ Lemma antiderivative_P3 :
antiderivative f F1 c a \/ antiderivative f F0 a c.
Proof.
intros; unfold antiderivative in H, H0; elim H; clear H; elim H0; clear H0;
- intros; case (total_order_T a c); intro.
- elim s; intro.
+ intros; destruct (total_order_T a c) as [[Hle|Heq]|Hgt].
right; unfold antiderivative; split.
intros; apply H1; elim H3; intros; split;
[ assumption | apply Rle_trans with c; assumption ].
@@ -448,8 +409,7 @@ Lemma antiderivative_P4 :
antiderivative f F1 b c \/ antiderivative f F0 c b.
Proof.
intros; unfold antiderivative in H, H0; elim H; clear H; elim H0; clear H0;
- intros; case (total_order_T c b); intro.
- elim s; intro.
+ intros; destruct (total_order_T c b) as [[Hlt|Heq]|Hgt].
right; unfold antiderivative; split.
intros; apply H1; elim H3; intros; split;
[ apply Rle_trans with c; assumption | assumption ].
@@ -499,10 +459,8 @@ Proof.
intros.
elim X; intros F0 H0.
elim X0; intros F1 H1.
- case (total_order_T a b); intro.
- elim s; intro.
- case (total_order_T b c); intro.
- elim s0; intro.
+ destruct (total_order_T a b) as [[Hlt|Heq]|Hgt].
+ destruct (total_order_T b c) as [[Hlt'|Heq']|Hgt'].
(* a<b & b<c *)
unfold Newton_integrable;
exists
@@ -515,84 +473,81 @@ Proof.
elim H1; intro.
left; apply antiderivative_P2; assumption.
unfold antiderivative in H2; elim H2; clear H2; intros _ H2.
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 a1)).
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 Hlt')).
unfold antiderivative in H; elim H; clear H; intros _ H.
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H a0)).
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H Hlt)).
(* a<b & b=c *)
- rewrite b0 in X; apply X.
+ rewrite Heq' in X; apply X.
(* a<b & b>c *)
- case (total_order_T a c); intro.
- elim s0; intro.
+ destruct (total_order_T a c) as [[Hlt''|Heq'']|Hgt''].
unfold Newton_integrable; exists F0.
left.
elim H1; intro.
unfold antiderivative in H; elim H; clear H; intros _ H.
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)).
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H Hgt')).
elim H0; intro.
assert (H3 := antiderivative_P3 f F0 F1 a b c H2 H).
elim H3; intro.
unfold antiderivative in H4; elim H4; clear H4; intros _ H4.
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H4 a1)).
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H4 Hlt'')).
assumption.
unfold antiderivative in H2; elim H2; clear H2; intros _ H2.
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 a0)).
- rewrite b0; apply NewtonInt_P1.
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 Hlt)).
+ rewrite Heq''; apply NewtonInt_P1.
unfold Newton_integrable; exists F1.
right.
elim H1; intro.
unfold antiderivative in H; elim H; clear H; intros _ H.
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)).
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H Hgt')).
elim H0; intro.
assert (H3 := antiderivative_P3 f F0 F1 a b c H2 H).
elim H3; intro.
assumption.
unfold antiderivative in H4; elim H4; clear H4; intros _ H4.
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H4 r0)).
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H4 Hgt'')).
unfold antiderivative in H2; elim H2; clear H2; intros _ H2.
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 a0)).
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 Hlt)).
(* a=b *)
- rewrite b0; apply X0.
- case (total_order_T b c); intro.
- elim s; intro.
+ rewrite Heq; apply X0.
+ destruct (total_order_T b c) as [[Hlt'|Heq']|Hgt'].
(* a>b & b<c *)
- case (total_order_T a c); intro.
- elim s0; intro.
+ destruct (total_order_T a c) as [[Hlt''|Heq'']|Hgt''].
unfold Newton_integrable; exists F1.
left.
elim H1; intro.
(*****************)
elim H0; intro.
unfold antiderivative in H2; elim H2; clear H2; intros _ H2.
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 r)).
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 Hgt)).
assert (H3 := antiderivative_P4 f F0 F1 b a c H2 H).
elim H3; intro.
assumption.
unfold antiderivative in H4; elim H4; clear H4; intros _ H4.
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H4 a1)).
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H4 Hlt'')).
unfold antiderivative in H; elim H; clear H; intros _ H.
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H a0)).
- rewrite b0; apply NewtonInt_P1.
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H Hlt')).
+ rewrite Heq''; apply NewtonInt_P1.
unfold Newton_integrable; exists F0.
right.
elim H0; intro.
unfold antiderivative in H; elim H; clear H; intros _ H.
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)).
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H Hgt)).
elim H1; intro.
assert (H3 := antiderivative_P4 f F0 F1 b a c H H2).
elim H3; intro.
unfold antiderivative in H4; elim H4; clear H4; intros _ H4.
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H4 r0)).
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H4 Hgt'')).
assumption.
unfold antiderivative in H2; elim H2; clear H2; intros _ H2.
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 a0)).
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 Hlt')).
(* a>b & b=c *)
- rewrite b0 in X; apply X.
+ rewrite Heq' in X; apply X.
(* a>b & b>c *)
assert (X1 := NewtonInt_P3 f a b X).
assert (X2 := NewtonInt_P3 f b c X0).
apply NewtonInt_P3.
apply NewtonInt_P7 with b; assumption.
-Defined.
+Qed.
(* Chasles' relation *)
Lemma NewtonInt_P9 :
@@ -602,17 +557,15 @@ Lemma NewtonInt_P9 :
NewtonInt f a b pr1 + NewtonInt f b c pr2.
Proof.
intros; unfold NewtonInt.
- case (NewtonInt_P8 f a b c pr1 pr2); intros.
- case pr1; intros.
- case pr2; intros.
- case (total_order_T a b); intro.
- elim s; intro.
- case (total_order_T b c); intro.
- elim s0; intro.
+ case (NewtonInt_P8 f a b c pr1 pr2) as (x,Hor).
+ case pr1 as (x0,Hor0).
+ case pr2 as (x1,Hor1).
+ destruct (total_order_T a b) as [[Hlt|Heq]|Hgt].
+ destruct (total_order_T b c) as [[Hlt'|Heq']|Hgt'].
(* a<b & b<c *)
- elim o0; intro.
- elim o1; intro.
- elim o; intro.
+ case Hor0; intro.
+ case Hor1; intro.
+ case Hor; intro.
assert (H2 := antiderivative_P2 f x0 x1 a b c H H0).
assert
(H3 :=
@@ -628,23 +581,23 @@ Proof.
assert (H6 : a <= c <= c).
split; [ left; apply Rlt_trans with b; assumption | right; reflexivity ].
rewrite (H4 _ H5); rewrite (H4 _ H6).
- case (Rle_dec a b); intro.
- case (Rle_dec c b); intro.
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r0 a1)).
+ destruct (Rle_dec a b) as [Hlea|Hnlea].
+ destruct (Rle_dec c b) as [Hlec|Hnlec].
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ Hlec Hlt')).
ring.
- elim n; left; assumption.
+ elim Hnlea; left; assumption.
unfold antiderivative in H1; elim H1; clear H1; intros _ H1.
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H1 (Rlt_trans _ _ _ a0 a1))).
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H1 (Rlt_trans _ _ _ Hlt Hlt'))).
unfold antiderivative in H0; elim H0; clear H0; intros _ H0.
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 a1)).
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 Hlt')).
unfold antiderivative in H; elim H; clear H; intros _ H.
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H a0)).
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H Hlt)).
(* a<b & b=c *)
- rewrite <- b0.
+ rewrite <- Heq'.
unfold Rminus; rewrite Rplus_opp_r; rewrite Rplus_0_r.
- rewrite <- b0 in o.
- elim o0; intro.
- elim o; intro.
+ rewrite <- Heq' in Hor.
+ elim Hor0; intro.
+ elim Hor; intro.
assert (H1 := antiderivative_Ucte f x x0 a b H0 H).
elim H1; intros.
rewrite (H2 b).
@@ -653,25 +606,25 @@ Proof.
split; [ right; reflexivity | left; assumption ].
split; [ left; assumption | right; reflexivity ].
unfold antiderivative in H0; elim H0; clear H0; intros _ H0.
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 a0)).
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 Hlt)).
unfold antiderivative in H; elim H; clear H; intros _ H.
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H a0)).
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H Hlt)).
(* a<b & b>c *)
- elim o1; intro.
+ elim Hor1; intro.
unfold antiderivative in H; elim H; clear H; intros _ H.
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)).
- elim o0; intro.
- elim o; intro.
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H Hgt')).
+ elim Hor0; intro.
+ elim Hor; intro.
assert (H2 := antiderivative_P2 f x x1 a c b H1 H).
assert (H3 := antiderivative_Ucte _ _ _ a b H0 H2).
elim H3; intros.
rewrite (H4 a).
rewrite (H4 b).
- case (Rle_dec b c); intro.
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r0 r)).
- case (Rle_dec a c); intro.
+ destruct (Rle_dec b c) as [Hle|Hnle].
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ Hle Hgt')).
+ destruct (Rle_dec a c) as [Hle'|Hnle'].
ring.
- elim n0; unfold antiderivative in H1; elim H1; intros; assumption.
+ elim Hnle'; unfold antiderivative in H1; elim H1; intros; assumption.
split; [ left; assumption | right; reflexivity ].
split; [ right; reflexivity | left; assumption ].
assert (H2 := antiderivative_P2 _ _ _ _ _ _ H1 H0).
@@ -679,19 +632,19 @@ Proof.
elim H3; intros.
rewrite (H4 c).
rewrite (H4 b).
- case (Rle_dec b a); intro.
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r0 a0)).
- case (Rle_dec c a); intro.
+ destruct (Rle_dec b a) as [Hle|Hnle].
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ Hle Hlt)).
+ destruct (Rle_dec c a) as [Hle'|[]].
ring.
- elim n0; unfold antiderivative in H1; elim H1; intros; assumption.
+ unfold antiderivative in H1; elim H1; intros; assumption.
split; [ left; assumption | right; reflexivity ].
split; [ right; reflexivity | left; assumption ].
unfold antiderivative in H0; elim H0; clear H0; intros _ H0.
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 a0)).
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 Hlt)).
(* a=b *)
- rewrite b0 in o; rewrite b0.
- elim o; intro.
- elim o1; intro.
+ rewrite Heq in Hor |- *.
+ elim Hor; intro.
+ elim Hor1; intro.
assert (H1 := antiderivative_Ucte _ _ _ b c H H0).
elim H1; intros.
assert (H3 : b <= c).
@@ -705,7 +658,7 @@ Proof.
unfold antiderivative in H, H0; elim H; elim H0; intros; apply Rle_antisym;
assumption.
rewrite H1; ring.
- elim o1; intro.
+ elim Hor1; intro.
assert (H1 : b = c).
unfold antiderivative in H, H0; elim H; elim H0; intros; apply Rle_antisym;
assumption.
@@ -720,25 +673,24 @@ Proof.
split; [ assumption | right; reflexivity ].
split; [ right; reflexivity | assumption ].
(* a>b & b<c *)
- case (total_order_T b c); intro.
- elim s; intro.
- elim o0; intro.
+ destruct (total_order_T b c) as [[Hlt'|Heq']|Hgt'].
+ elim Hor0; intro.
unfold antiderivative in H; elim H; clear H; intros _ H.
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)).
- elim o1; intro.
- elim o; intro.
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H Hgt)).
+ elim Hor1; intro.
+ elim Hor; intro.
assert (H2 := antiderivative_P2 _ _ _ _ _ _ H H1).
assert (H3 := antiderivative_Ucte _ _ _ b c H0 H2).
elim H3; intros.
rewrite (H4 b).
rewrite (H4 c).
- case (Rle_dec b a); intro.
- case (Rle_dec c a); intro.
+ case (Rle_dec b a) as [|[]].
+ case (Rle_dec c a) as [|].
assert (H5 : a = c).
unfold antiderivative in H1; elim H1; intros; apply Rle_antisym; assumption.
rewrite H5; ring.
ring.
- elim n; left; assumption.
+ left; assumption.
split; [ left; assumption | right; reflexivity ].
split; [ right; reflexivity | left; assumption ].
assert (H2 := antiderivative_P2 _ _ _ _ _ _ H0 H1).
@@ -746,27 +698,27 @@ Proof.
elim H3; intros.
rewrite (H4 a).
rewrite (H4 b).
- case (Rle_dec b c); intro.
- case (Rle_dec a c); intro.
+ case (Rle_dec b c) as [|[]].
+ case (Rle_dec a c) as [|].
assert (H5 : a = c).
unfold antiderivative in H1; elim H1; intros; apply Rle_antisym; assumption.
rewrite H5; ring.
ring.
- elim n; left; assumption.
+ left; assumption.
split; [ right; reflexivity | left; assumption ].
split; [ left; assumption | right; reflexivity ].
unfold antiderivative in H0; elim H0; clear H0; intros _ H0.
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 a0)).
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 Hlt')).
(* a>b & b=c *)
- rewrite <- b0.
+ rewrite <- Heq'.
unfold Rminus; rewrite Rplus_opp_r; rewrite Rplus_0_r.
- rewrite <- b0 in o.
- elim o0; intro.
+ rewrite <- Heq' in Hor.
+ elim Hor0; intro.
unfold antiderivative in H; elim H; clear H; intros _ H.
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)).
- elim o; intro.
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H Hgt)).
+ elim Hor; intro.
unfold antiderivative in H0; elim H0; clear H0; intros _ H0.
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 r)).
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 Hgt)).
assert (H1 := antiderivative_Ucte f x x0 b a H0 H).
elim H1; intros.
rewrite (H2 b).
@@ -775,15 +727,15 @@ Proof.
split; [ left; assumption | right; reflexivity ].
split; [ right; reflexivity | left; assumption ].
(* a>b & b>c *)
- elim o0; intro.
+ elim Hor0; intro.
unfold antiderivative in H; elim H; clear H; intros _ H.
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)).
- elim o1; intro.
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H Hgt)).
+ elim Hor1; intro.
unfold antiderivative in H0; elim H0; clear H0; intros _ H0.
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 r0)).
- elim o; intro.
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 Hgt')).
+ elim Hor; intro.
unfold antiderivative in H1; elim H1; clear H1; intros _ H1.
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H1 (Rlt_trans _ _ _ r0 r))).
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H1 (Rlt_trans _ _ _ Hgt' Hgt))).
assert (H2 := antiderivative_P2 _ _ _ _ _ _ H0 H).
assert (H3 := antiderivative_Ucte _ _ _ c a H1 H2).
elim H3; intros.
@@ -791,11 +743,11 @@ Proof.
unfold antiderivative in H1; elim H1; intros; assumption.
rewrite (H4 c).
rewrite (H4 a).
- case (Rle_dec a b); intro.
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r1 r)).
- case (Rle_dec c b); intro.
+ destruct (Rle_dec a b) as [Hle|Hnle].
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ Hle Hgt)).
+ destruct (Rle_dec c b) as [|[]].
ring.
- elim n0; left; assumption.
+ left; assumption.
split; [ assumption | right; reflexivity ].
split; [ right; reflexivity | assumption ].
Qed.
diff --git a/theories/Reals/PSeries_reg.v b/theories/Reals/PSeries_reg.v
index 199c2014..30a26f77 100644
--- a/theories/Reals/PSeries_reg.v
+++ b/theories/Reals/PSeries_reg.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -10,12 +10,116 @@ Require Import Rbase.
Require Import Rfunctions.
Require Import SeqSeries.
Require Import Ranalysis1.
+Require Import MVT.
Require Import Max.
Require Import Even.
+Require Import Fourier.
Local Open Scope R_scope.
+(* Boule is French for Ball *)
+
Definition Boule (x:R) (r:posreal) (y:R) : Prop := Rabs (y - x) < r.
+(* General properties of balls. *)
+
+Lemma Boule_convex : forall c d x y z,
+ Boule c d x -> Boule c d y -> x <= z <= y -> Boule c d z.
+intros c d x y z bx b_y intz.
+unfold Boule in bx, b_y; apply Rabs_def2 in bx;
+apply Rabs_def2 in b_y; apply Rabs_def1;
+ [apply Rle_lt_trans with (y - c);[apply Rplus_le_compat_r|]|
+ apply Rlt_le_trans with (x - c);[|apply Rplus_le_compat_r]];tauto.
+Qed.
+
+Definition boule_of_interval x y (h : x < y) :
+ {c :R & {r : posreal | c - r = x /\ c + r = y}}.
+exists ((x + y)/2).
+assert (radius : 0 < (y - x)/2).
+ unfold Rdiv; apply Rmult_lt_0_compat.
+ apply Rlt_Rminus; assumption.
+ now apply Rinv_0_lt_compat, Rlt_0_2.
+ exists (mkposreal _ radius).
+ simpl; split; unfold Rdiv; field.
+Qed.
+
+Definition boule_in_interval x y z (h : x < z < y) :
+ {c : R & {r | Boule c r z /\ x < c - r /\ c + r < y}}.
+Proof.
+assert (cmp : x * /2 + z * /2 < z * /2 + y * /2).
+destruct h as [h1 h2].
+rewrite Rplus_comm; apply Rplus_lt_compat_l, Rmult_lt_compat_r.
+ apply Rinv_0_lt_compat, Rlt_0_2.
+apply Rlt_trans with z; assumption.
+destruct (boule_of_interval _ _ cmp) as [c [r [P1 P2]]].
+assert (0 < /2) by (apply Rinv_0_lt_compat, Rlt_0_2).
+exists c, r; split.
+ destruct h; unfold Boule; simpl; apply Rabs_def1.
+ apply Rplus_lt_reg_l with c; rewrite P2;
+ replace (c + (z - c)) with (z * / 2 + z * / 2) by field.
+ apply Rplus_lt_compat_l, Rmult_lt_compat_r;assumption.
+ apply Rplus_lt_reg_l with c; change (c + - r) with (c - r);
+ rewrite P1;
+ replace (c + (z - c)) with (z * / 2 + z * / 2) by field.
+ apply Rplus_lt_compat_r, Rmult_lt_compat_r;assumption.
+destruct h; split.
+ replace x with (x * / 2 + x * / 2) by field; rewrite P1.
+ apply Rplus_lt_compat_l, Rmult_lt_compat_r;assumption.
+replace y with (y * / 2 + y * /2) by field; rewrite P2.
+apply Rplus_lt_compat_r, Rmult_lt_compat_r;assumption.
+Qed.
+
+Lemma Ball_in_inter : forall c1 c2 r1 r2 x,
+ Boule c1 r1 x -> Boule c2 r2 x ->
+ {r3 : posreal | forall y, Boule x r3 y -> Boule c1 r1 y /\ Boule c2 r2 y}.
+intros c1 c2 [r1 r1p] [r2 r2p] x; unfold Boule; simpl; intros in1 in2.
+assert (Rmax (c1 - r1)(c2 - r2) < x).
+ apply Rmax_lub_lt;[revert in1 | revert in2]; intros h;
+ apply Rabs_def2 in h; destruct h as [_ u];
+ apply (fun h => Rplus_lt_reg_r _ _ _ (Rle_lt_trans _ _ _ h u)), Req_le; ring.
+assert (x < Rmin (c1 + r1) (c2 + r2)).
+ apply Rmin_glb_lt;[revert in1 | revert in2]; intros h;
+ apply Rabs_def2 in h; destruct h as [u _];
+ apply (fun h => Rplus_lt_reg_r _ _ _ (Rlt_le_trans _ _ _ u h)), Req_le; ring.
+assert (t: 0 < Rmin (x - Rmax (c1 - r1) (c2 - r2))
+ (Rmin (c1 + r1) (c2 + r2) - x)).
+ apply Rmin_glb_lt; apply Rlt_Rminus; assumption.
+exists (mkposreal _ t).
+apply Rabs_def2 in in1; destruct in1.
+apply Rabs_def2 in in2; destruct in2.
+assert (c1 - r1 <= Rmax (c1 - r1) (c2 - r2)) by apply Rmax_l.
+assert (c2 - r2 <= Rmax (c1 - r1) (c2 - r2)) by apply Rmax_r.
+assert (Rmin (c1 + r1) (c2 + r2) <= c1 + r1) by apply Rmin_l.
+assert (Rmin (c1 + r1) (c2 + r2) <= c2 + r2) by apply Rmin_r.
+assert (Rmin (x - Rmax (c1 - r1) (c2 - r2))
+ (Rmin (c1 + r1) (c2 + r2) - x) <= x - Rmax (c1 - r1) (c2 - r2))
+ by apply Rmin_l.
+assert (Rmin (x - Rmax (c1 - r1) (c2 - r2))
+ (Rmin (c1 + r1) (c2 + r2) - x) <= Rmin (c1 + r1) (c2 + r2) - x)
+ by apply Rmin_r.
+simpl.
+intros y h; apply Rabs_def2 in h; destruct h as [h h'].
+apply Rmin_Rgt in h; destruct h as [cmp1 cmp2].
+apply Rplus_lt_reg_r in cmp2; apply Rmin_Rgt in cmp2.
+rewrite Ropp_Rmin, Ropp_minus_distr in h'.
+apply Rmax_Rlt in h'; destruct h' as [cmp3 cmp4];
+apply Rplus_lt_reg_r in cmp3; apply Rmax_Rlt in cmp3;
+split; apply Rabs_def1.
+apply (fun h => Rplus_lt_reg_l _ _ _ (Rle_lt_trans _ _ _ h (proj1 cmp2))), Req_le;
+ ring.
+apply (fun h => Rplus_lt_reg_l _ _ _ (Rlt_le_trans _ _ _ (proj1 cmp3) h)), Req_le;
+ ring.
+apply (fun h => Rplus_lt_reg_l _ _ _ (Rle_lt_trans _ _ _ h (proj2 cmp2))), Req_le;
+ ring.
+apply (fun h => Rplus_lt_reg_l _ _ _ (Rlt_le_trans _ _ _ (proj2 cmp3) h)), Req_le;
+ ring.
+Qed.
+
+Lemma Boule_center : forall x r, Boule x r x.
+Proof.
+intros x [r rpos]; unfold Boule, Rminus; simpl; rewrite Rplus_opp_r.
+rewrite Rabs_pos_eq;[assumption | apply Rle_refl].
+Qed.
+
(** Uniform convergence *)
Definition CVU (fn:nat -> R -> R) (f:R -> R) (x:R)
(r:posreal) : Prop :=
@@ -153,7 +257,7 @@ Proof.
unfold Boule; replace (y + h - x) with (h + (y - x));
[ idtac | ring ]; apply Rle_lt_trans with (Rabs h + Rabs (y - x)).
apply Rabs_triang.
- apply Rplus_lt_reg_r with (- Rabs (x - y)).
+ apply Rplus_lt_reg_l with (- Rabs (x - y)).
rewrite <- (Rabs_Ropp (y - x)); rewrite Ropp_minus_distr'.
replace (- Rabs (x - y) + r) with (r - Rabs (x - y)).
replace (- Rabs (x - y) + (Rabs h + Rabs (x - y))) with (Rabs h).
@@ -161,7 +265,7 @@ Proof.
ring.
ring.
unfold Boule in H1; rewrite <- (Rabs_Ropp (x - y)); rewrite Ropp_minus_distr';
- apply Rplus_lt_reg_r with (Rabs (y - x)).
+ apply Rplus_lt_reg_l with (Rabs (y - x)).
rewrite Rplus_0_r; replace (Rabs (y - x) + (r - Rabs (y - x))) with (pos r);
[ apply H1 | ring ].
Qed.
@@ -258,3 +362,242 @@ Proof.
rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; apply Rlt_0_1.
apply Rplus_le_lt_0_compat; [ apply Rabs_pos | apply Rlt_0_1 ].
Qed.
+
+(* Uniform convergence implies pointwise simple convergence *)
+Lemma CVU_cv : forall f g c d, CVU f g c d ->
+ forall x, Boule c d x -> Un_cv (fun n => f n x) (g x).
+intros f g c d cvu x bx eps ep; destruct (cvu eps ep) as [N Pn].
+ exists N; intros n nN; rewrite R_dist_sym; apply Pn; assumption.
+Qed.
+
+(* convergence is preserved through extensional equality *)
+Lemma CVU_ext_lim :
+ forall f g1 g2 c d, CVU f g1 c d -> (forall x, Boule c d x -> g1 x = g2 x) ->
+ CVU f g2 c d.
+intros f g1 g2 c d cvu q eps ep; destruct (cvu _ ep) as [N Pn].
+exists N; intros; rewrite <- q; auto.
+Qed.
+
+(* When a sequence of derivable functions converge pointwise towards
+ a function g, with the derivatives converging uniformly towards
+ a function g', then the function g' is the derivative of g. *)
+
+Lemma CVU_derivable :
+ forall f f' g g' c d,
+ CVU f' g' c d ->
+ (forall x, Boule c d x -> Un_cv (fun n => f n x) (g x)) ->
+ (forall n x, Boule c d x -> derivable_pt_lim (f n) x (f' n x)) ->
+ forall x, Boule c d x -> derivable_pt_lim g x (g' x).
+intros f f' g g' c d cvu cvp dff' x bx.
+set (rho_ :=
+ fun n y =>
+ if Req_EM_T y x then
+ f' n x
+ else ((f n y - f n x)/ (y - x))).
+set (rho := fun y =>
+ if Req_EM_T y x then
+ g' x
+ else (g y - g x)/(y - x)).
+assert (ctrho : forall n z, Boule c d z -> continuity_pt (rho_ n) z).
+ intros n z bz.
+ destruct (Req_EM_T x z) as [xz | xnz].
+ rewrite <- xz.
+ intros eps' ep'.
+ destruct (dff' n x bx eps' ep') as [alp Pa].
+ exists (pos alp);split;[apply cond_pos | ].
+ intros z'; unfold rho_, D_x, dist, R_met; simpl; intros [[_ xnz'] dxz'].
+ destruct (Req_EM_T z' x) as [abs | _].
+ case xnz'; symmetry; exact abs.
+ destruct (Req_EM_T x x) as [_ | abs];[ | case abs; reflexivity].
+ pattern z' at 1; replace z' with (x + (z' - x)) by ring.
+ apply Pa;[intros h; case xnz';
+ replace z' with (z' - x + x) by ring; rewrite h, Rplus_0_l;
+ reflexivity | exact dxz'].
+ destruct (Ball_in_inter c c d d z bz bz) as [delta Pd].
+ assert (dz : 0 < Rmin delta (Rabs (z - x))).
+ now apply Rmin_glb_lt;[apply cond_pos | apply Rabs_pos_lt; intros zx0; case xnz;
+ replace z with (z - x + x) by ring; rewrite zx0, Rplus_0_l].
+ assert (t' : forall y : R,
+ R_dist y z < Rmin delta (Rabs (z - x)) ->
+ (fun z : R => (f n z - f n x) / (z - x)) y = rho_ n y).
+ intros y dyz; unfold rho_; destruct (Req_EM_T y x) as [xy | xny].
+ rewrite xy in dyz.
+ destruct (Rle_dec delta (Rabs (z - x))).
+ rewrite Rmin_left, R_dist_sym in dyz; unfold R_dist in dyz; fourier.
+ rewrite Rmin_right, R_dist_sym in dyz; unfold R_dist in dyz;
+ [case (Rlt_irrefl _ dyz) |apply Rlt_le, Rnot_le_gt; assumption].
+ reflexivity.
+ apply (continuity_pt_locally_ext (fun z => (f n z - f n x)/(z - x))
+ (rho_ n) _ z dz t'); clear t'.
+ apply continuity_pt_div.
+ apply continuity_pt_minus.
+ apply derivable_continuous_pt; eapply exist; apply dff'; assumption.
+ apply continuity_pt_const; intro; intro; reflexivity.
+ apply continuity_pt_minus;
+ [apply derivable_continuous_pt; exists 1; apply derivable_pt_lim_id
+ | apply continuity_pt_const; intro; reflexivity].
+ intros zx0; case xnz; replace z with (z - x + x) by ring.
+ rewrite zx0, Rplus_0_l; reflexivity.
+assert (CVU rho_ rho c d ).
+ intros eps ep.
+ assert (ep8 : 0 < eps/8).
+ fourier.
+ destruct (cvu _ ep8) as [N Pn1].
+ assert (cauchy1 : forall n p, (N <= n)%nat -> (N <= p)%nat ->
+ forall z, Boule c d z -> Rabs (f' n z - f' p z) < eps/4).
+ intros n p nN pN z bz; replace (eps/4) with (eps/8 + eps/8) by field.
+ rewrite <- Rabs_Ropp.
+ replace (-(f' n z - f' p z)) with (g' z - f' n z - (g' z - f' p z)) by ring.
+ apply Rle_lt_trans with (1 := Rabs_triang _ _); rewrite Rabs_Ropp.
+ apply Rplus_lt_compat; apply Pn1; assumption.
+ assert (step_2 : forall n p, (N <= n)%nat -> (N <= p)%nat ->
+ forall y, Boule c d y -> x <> y ->
+ Rabs ((f n y - f n x)/(y - x) - (f p y - f p x)/(y - x)) < eps/4).
+ intros n p nN pN y b_y xny.
+ assert (mm0 : (Rmin x y = x /\ Rmax x y = y) \/
+ (Rmin x y = y /\ Rmax x y = x)).
+ destruct (Rle_dec x y) as [H | H].
+ rewrite Rmin_left, Rmax_right.
+ left; split; reflexivity.
+ assumption.
+ assumption.
+ rewrite Rmin_right, Rmax_left.
+ right; split; reflexivity.
+ apply Rlt_le, Rnot_le_gt; assumption.
+ apply Rlt_le, Rnot_le_gt; assumption.
+ assert (mm : Rmin x y < Rmax x y).
+ destruct mm0 as [[q1 q2] | [q1 q2]]; generalize (Rminmax x y); rewrite q1, q2.
+ intros h; destruct h;[ assumption| contradiction].
+ intros h; destruct h as [h | h];[assumption | rewrite h in xny; case xny; reflexivity].
+ assert (dm : forall z, Rmin x y <= z <= Rmax x y ->
+ derivable_pt_lim (fun x => f n x - f p x) z (f' n z - f' p z)).
+ intros z intz; apply derivable_pt_lim_minus.
+ apply dff'; apply Boule_convex with (Rmin x y) (Rmax x y);
+ destruct mm0 as [[q1 q2] | [q1 q2]]; revert intz; rewrite ?q1, ?q2; intros;
+ try assumption.
+ apply dff'; apply Boule_convex with (Rmin x y) (Rmax x y);
+ destruct mm0 as [[q1 q2] | [q1 q2]]; revert intz; rewrite ?q1, ?q2; intros;
+ try assumption.
+
+ replace ((f n y - f n x) / (y - x) - (f p y - f p x) / (y - x))
+ with (((f n y - f p y) - (f n x - f p x))/(y - x)) by
+ (field; intros yx0; case xny; replace y with (y - x + x) by ring;
+ rewrite yx0, Rplus_0_l; reflexivity).
+ destruct (MVT_cor2 (fun x => f n x - f p x) (fun x => f' n x - f' p x)
+ (Rmin x y) (Rmax x y) mm dm) as [z [Pz inz]].
+ destruct mm0 as [[q1 q2] | [q1 q2]].
+ replace ((f n y - f p y - (f n x - f p x))/(y - x)) with
+ ((f n (Rmax x y) - f p (Rmax x y) - (f n (Rmin x y) - f p (Rmin x y)))/
+ (Rmax x y - Rmin x y)) by (rewrite q1, q2; reflexivity).
+ unfold Rdiv; rewrite Pz, Rmult_assoc, Rinv_r, Rmult_1_r.
+ apply cauchy1; auto.
+ apply Boule_convex with (Rmin x y) (Rmax x y);
+ revert inz; rewrite ?q1, ?q2; intros;
+ try assumption.
+ split; apply Rlt_le; tauto.
+ rewrite q1, q2; apply Rminus_eq_contra, not_eq_sym; assumption.
+ replace ((f n y - f p y - (f n x - f p x))/(y - x)) with
+ ((f n (Rmax x y) - f p (Rmax x y) - (f n (Rmin x y) - f p (Rmin x y)))/
+ (Rmax x y - Rmin x y)).
+ unfold Rdiv; rewrite Pz, Rmult_assoc, Rinv_r, Rmult_1_r.
+ apply cauchy1; auto.
+ apply Boule_convex with (Rmin x y) (Rmax x y);
+ revert inz; rewrite ?q1, ?q2; intros;
+ try assumption; split; apply Rlt_le; tauto.
+ rewrite q1, q2; apply Rminus_eq_contra; assumption.
+ rewrite q1, q2; field; split;
+ apply Rminus_eq_contra;[apply not_eq_sym |]; assumption.
+ assert (unif_ac :
+ forall n p, (N <= n)%nat -> (N <= p)%nat ->
+ forall y, Boule c d y ->
+ Rabs (rho_ n y - rho_ p y) <= eps/2).
+ intros n p nN pN y b_y.
+ destruct (Req_dec x y) as [xy | xny].
+ destruct (Ball_in_inter c c d d x bx bx) as [delta Pdelta].
+ destruct (ctrho n y b_y _ ep8) as [d' [dp Pd]].
+ destruct (ctrho p y b_y _ ep8) as [d2 [dp2 Pd2]].
+ assert (mmpos : 0 < (Rmin (Rmin d' d2) delta)/2).
+ apply Rmult_lt_0_compat; repeat apply Rmin_glb_lt; try assumption.
+ apply cond_pos.
+ apply Rinv_0_lt_compat, Rlt_0_2.
+ apply Rle_trans with (1 := R_dist_tri _ _ (rho_ n (y + Rmin (Rmin d' d2) delta/2))).
+ replace (eps/2) with (eps/8 + (eps/4 + eps/8)) by field.
+ apply Rplus_le_compat.
+ rewrite R_dist_sym; apply Rlt_le, Pd;split;[split;[exact I | ] | ].
+ apply Rminus_not_eq_right; rewrite Rplus_comm; unfold Rminus;
+ rewrite Rplus_assoc, Rplus_opp_r, Rplus_0_r; apply Rgt_not_eq; assumption.
+ simpl; unfold R_dist.
+ unfold Rminus; rewrite (Rplus_comm y), Rplus_assoc, Rplus_opp_r, Rplus_0_r.
+ rewrite Rabs_pos_eq;[ |apply Rlt_le; assumption ].
+ apply Rlt_le_trans with (Rmin (Rmin d' d2) delta);[fourier | ].
+ apply Rle_trans with (Rmin d' d2); apply Rmin_l.
+ apply Rle_trans with (1 := R_dist_tri _ _ (rho_ p (y + Rmin (Rmin d' d2) delta/2))).
+ apply Rplus_le_compat.
+ apply Rlt_le.
+ replace (rho_ n (y + Rmin (Rmin d' d2) delta / 2)) with
+ ((f n (y + Rmin (Rmin d' d2) delta / 2) - f n x)/
+ ((y + Rmin (Rmin d' d2) delta / 2) - x)).
+ replace (rho_ p (y + Rmin (Rmin d' d2) delta / 2)) with
+ ((f p (y + Rmin (Rmin d' d2) delta / 2) - f p x)/
+ ((y + Rmin (Rmin d' d2) delta / 2) - x)).
+ apply step_2; auto; try fourier.
+ assert (0 < pos delta) by (apply cond_pos).
+ apply Boule_convex with y (y + delta/2).
+ assumption.
+ destruct (Pdelta (y + delta/2)); auto.
+ rewrite xy; unfold Boule; rewrite Rabs_pos_eq; try fourier; auto.
+ split; try fourier.
+ apply Rplus_le_compat_l, Rmult_le_compat_r;[ | apply Rmin_r].
+ now apply Rlt_le, Rinv_0_lt_compat, Rlt_0_2.
+ apply Rminus_not_eq_right; rewrite xy; apply Rgt_not_eq; fourier.
+ unfold rho_.
+ destruct (Req_EM_T (y + Rmin (Rmin d' d2) delta/2) x) as [ymx | ymnx].
+ case (RIneq.Rle_not_lt _ _ (Req_le _ _ ymx)); fourier.
+ reflexivity.
+ unfold rho_.
+ destruct (Req_EM_T (y + Rmin (Rmin d' d2) delta / 2) x) as [ymx | ymnx].
+ case (RIneq.Rle_not_lt _ _ (Req_le _ _ ymx)); fourier.
+ reflexivity.
+ apply Rlt_le, Pd2; split;[split;[exact I | apply Rlt_not_eq; fourier] | ].
+ simpl; unfold R_dist.
+ unfold Rminus; rewrite (Rplus_comm y), Rplus_assoc, Rplus_opp_r, Rplus_0_r.
+ rewrite Rabs_pos_eq;[ | fourier].
+ apply Rlt_le_trans with (Rmin (Rmin d' d2) delta); [fourier |].
+ apply Rle_trans with (Rmin d' d2).
+ solve[apply Rmin_l].
+ solve[apply Rmin_r].
+ apply Rlt_le, Rlt_le_trans with (eps/4);[ | fourier].
+ unfold rho_; destruct (Req_EM_T y x); solve[auto].
+ assert (unif_ac' : forall p, (N <= p)%nat ->
+ forall y, Boule c d y -> Rabs (rho y - rho_ p y) < eps).
+ assert (cvrho : forall y, Boule c d y -> Un_cv (fun n => rho_ n y) (rho y)).
+ intros y b_y; unfold rho_, rho; destruct (Req_EM_T y x).
+ intros eps' ep'; destruct (cvu eps' ep') as [N2 Pn2].
+ exists N2; intros n nN2; rewrite R_dist_sym; apply Pn2; assumption.
+ apply CV_mult.
+ apply CV_minus.
+ apply cvp; assumption.
+ apply cvp; assumption.
+ intros eps' ep'; simpl; exists 0%nat; intros; rewrite R_dist_eq; assumption.
+ intros p pN y b_y.
+ replace eps with (eps/2 + eps/2) by field.
+ assert (ep2 : 0 < eps/2) by fourier.
+ destruct (cvrho y b_y _ ep2) as [N2 Pn2].
+ apply Rle_lt_trans with (1 := R_dist_tri _ _ (rho_ (max N N2) y)).
+ apply Rplus_lt_le_compat.
+ solve[rewrite R_dist_sym; apply Pn2, Max.le_max_r].
+ apply unif_ac; auto; solve [apply Max.le_max_l].
+ exists N; intros; apply unif_ac'; solve[auto].
+intros eps ep.
+destruct (CVU_continuity _ _ _ _ H ctrho x bx eps ep) as [delta [dp Pd]].
+exists (mkposreal _ dp); intros h hn0 dh.
+replace ((g (x + h) - g x) / h) with (rho (x + h)).
+ replace (g' x) with (rho x).
+ apply Pd; unfold D_x, no_cond;split;[split;[solve[auto] | ] | ].
+ intros xxh; case hn0; replace h with (x + h - x) by ring; rewrite <- xxh; ring.
+ simpl; unfold R_dist; replace (x + h - x) with h by ring; exact dh.
+ unfold rho; destruct (Req_EM_T x x) as [ _ | abs];[ | case abs]; reflexivity.
+unfold rho; destruct (Req_EM_T (x + h) x) as [abs | _];[ | ].
+ case hn0; replace h with (x + h - x) by ring; rewrite abs; ring.
+replace (x + h - x) with h by ring; reflexivity.
+Qed.
diff --git a/theories/Reals/PartSum.v b/theories/Reals/PartSum.v
index 364d72cb..b710c75c 100644
--- a/theories/Reals/PartSum.v
+++ b/theories/Reals/PartSum.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -180,12 +180,9 @@ Proof.
replace (S (S (pred N))) with (S N).
rewrite (HrecN H1); ring.
rewrite H2; simpl; reflexivity.
- assert (H2 := O_or_S N).
- elim H2; intros.
- elim a; intros.
- rewrite <- p.
+ destruct (O_or_S N) as [(m,<-)|<-].
simpl; reflexivity.
- rewrite <- b in H1; elim (lt_irrefl _ H1).
+ elim (lt_irrefl _ H1).
rewrite H1; simpl; reflexivity.
inversion H.
right; reflexivity.
@@ -395,9 +392,7 @@ Proof.
(sum_f_R0 (fun i:nat => Rabs (An i)) m)).
assumption.
apply H1; assumption.
- assert (H4 := lt_eq_lt_dec n m).
- elim H4; intro.
- elim a; intro.
+ destruct (lt_eq_lt_dec n m) as [[ | -> ]|].
rewrite (tech2 An n m); [ idtac | assumption ].
rewrite (tech2 (fun i:nat => Rabs (An i)) n m); [ idtac | assumption ].
unfold R_dist.
@@ -418,7 +413,6 @@ Proof.
apply Rle_ge.
apply cond_pos_sum.
intro; apply Rabs_pos.
- rewrite b.
unfold R_dist.
unfold Rminus; do 2 rewrite Rplus_opp_r.
rewrite Rabs_R0; right; reflexivity.
@@ -451,8 +445,7 @@ Lemma cv_cauchy_1 :
{ l:R | Un_cv (fun N:nat => sum_f_R0 An N) l } ->
Cauchy_crit_series An.
Proof.
- intros An X.
- elim X; intros.
+ intros An (x,p).
unfold Un_cv in p.
unfold Cauchy_crit_series; unfold Cauchy_crit.
intros.
@@ -508,12 +501,11 @@ Lemma sum_incr :
Un_cv (fun n:nat => sum_f_R0 An n) l ->
(forall n:nat, 0 <= An n) -> sum_f_R0 An N <= l.
Proof.
- intros; case (total_order_T (sum_f_R0 An N) l); intro.
- elim s; intro.
- left; apply a.
- right; apply b.
+ intros; destruct (total_order_T (sum_f_R0 An N) l) as [[Hlt|Heq]|Hgt].
+ left; apply Hlt.
+ right; apply Heq.
cut (Un_growing (fun n:nat => sum_f_R0 An n)).
- intro; set (l1 := sum_f_R0 An N) in r.
+ intro; set (l1 := sum_f_R0 An N) in Hgt.
unfold Un_cv in H; cut (0 < l1 - l).
intro; elim (H _ H2); intros.
set (N0 := max x N); cut (N0 >= x)%nat.
@@ -522,21 +514,21 @@ Proof.
intro; unfold R_dist in H5; rewrite Rabs_right in H5.
cut (sum_f_R0 An N0 < l1).
intro; elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H7 H6)).
- apply Rplus_lt_reg_r with (- l).
+ apply Rplus_lt_reg_l with (- l).
do 2 rewrite (Rplus_comm (- l)).
apply H5.
apply Rle_ge; apply Rplus_le_reg_l with l.
rewrite Rplus_0_r; replace (l + (sum_f_R0 An N0 - l)) with (sum_f_R0 An N0);
[ idtac | ring ]; apply Rle_trans with l1.
- left; apply r.
+ left; apply Hgt.
apply H6.
unfold l1; apply Rge_le;
apply (growing_prop (fun k:nat => sum_f_R0 An k)).
apply H1.
unfold ge, N0; apply le_max_r.
unfold ge, N0; apply le_max_l.
- apply Rplus_lt_reg_r with l; rewrite Rplus_0_r;
- replace (l + (l1 - l)) with l1; [ apply r | ring ].
+ apply Rplus_lt_reg_l with l; rewrite Rplus_0_r;
+ replace (l + (l1 - l)) with l1; [ apply Hgt | ring ].
unfold Un_growing; intro; simpl;
pattern (sum_f_R0 An n) at 1; rewrite <- Rplus_0_r;
apply Rplus_le_compat_l; apply H0.
@@ -549,10 +541,9 @@ Lemma sum_cv_maj :
Un_cv (fun n:nat => sum_f_R0 An n) l2 ->
(forall n:nat, Rabs (fn n x) <= An n) -> Rabs l1 <= l2.
Proof.
- intros; case (total_order_T (Rabs l1) l2); intro.
- elim s; intro.
- left; apply a.
- right; apply b.
+ intros; destruct (total_order_T (Rabs l1) l2) as [[Hlt|Heq]|Hgt].
+ left; apply Hlt.
+ right; apply Heq.
cut (forall n0:nat, Rabs (SP fn n0 x) <= sum_f_R0 An n0).
intro; cut (0 < (Rabs l1 - l2) / 2).
intro; unfold Un_cv in H, H0.
@@ -568,17 +559,17 @@ Proof.
intro; assert (H11 := H2 N).
elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H11 H10)).
apply Rlt_trans with ((Rabs l1 + l2) / 2); assumption.
- case (Rcase_abs (Rabs l1 - Rabs (SP fn N x))); intro.
+ destruct (Rcase_abs (Rabs l1 - Rabs (SP fn N x))) as [Hlt|Hge].
apply Rlt_trans with (Rabs l1).
apply Rmult_lt_reg_l with 2.
prove_sup0.
unfold Rdiv; rewrite (Rmult_comm 2); rewrite Rmult_assoc;
rewrite <- Rinv_l_sym.
- rewrite Rmult_1_r; rewrite double; apply Rplus_lt_compat_l; apply r.
+ rewrite Rmult_1_r; rewrite double; apply Rplus_lt_compat_l; apply Hgt.
discrR.
- apply (Rminus_lt _ _ r0).
- rewrite (Rabs_right _ r0) in H7.
- apply Rplus_lt_reg_r with ((Rabs l1 - l2) / 2 - Rabs (SP fn N x)).
+ apply (Rminus_lt _ _ Hlt).
+ rewrite (Rabs_right _ Hge) in H7.
+ apply Rplus_lt_reg_l with ((Rabs l1 - l2) / 2 - Rabs (SP fn N x)).
replace ((Rabs l1 - l2) / 2 - Rabs (SP fn N x) + (Rabs l1 + l2) / 2) with
(Rabs l1 - Rabs (SP fn N x)).
unfold Rminus; rewrite Rplus_assoc; rewrite Rplus_opp_l;
@@ -586,18 +577,18 @@ Proof.
unfold Rdiv; rewrite Rmult_plus_distr_r;
rewrite <- (Rmult_comm (/ 2)); rewrite Rmult_minus_distr_l;
repeat rewrite (Rmult_comm (/ 2)); pattern (Rabs l1) at 1;
- rewrite double_var; unfold Rdiv; ring.
- case (Rcase_abs (sum_f_R0 An N - l2)); intro.
+ rewrite double_var; unfold Rdiv in |- *; ring.
+ destruct (Rcase_abs (sum_f_R0 An N - l2)) as [Hlt|Hge].
apply Rlt_trans with l2.
- apply (Rminus_lt _ _ r0).
+ apply (Rminus_lt _ _ Hlt).
apply Rmult_lt_reg_l with 2.
prove_sup0.
rewrite (double l2); unfold Rdiv; rewrite (Rmult_comm 2);
rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
rewrite Rmult_1_r; rewrite (Rplus_comm (Rabs l1)); apply Rplus_lt_compat_l;
- apply r.
+ apply Hgt.
discrR.
- rewrite (Rabs_right _ r0) in H6; apply Rplus_lt_reg_r with (- l2).
+ rewrite (Rabs_right _ Hge) in H6; apply Rplus_lt_reg_l with (- l2).
replace (- l2 + (Rabs l1 + l2) / 2) with ((Rabs l1 - l2) / 2).
rewrite Rplus_comm; apply H6.
unfold Rdiv; rewrite <- (Rmult_comm (/ 2));
@@ -610,9 +601,9 @@ Proof.
apply H4; unfold ge, N; apply le_max_l.
apply H5; unfold ge, N; apply le_max_r.
unfold Rdiv; apply Rmult_lt_0_compat.
- apply Rplus_lt_reg_r with l2.
+ apply Rplus_lt_reg_l with l2.
rewrite Rplus_0_r; replace (l2 + (Rabs l1 - l2)) with (Rabs l1);
- [ apply r | ring ].
+ [ apply Hgt | ring ].
apply Rinv_0_lt_compat; prove_sup0.
intros; induction n0 as [| n0 Hrecn0].
unfold SP; simpl; apply H1.
diff --git a/theories/Reals/RIneq.v b/theories/Reals/RIneq.v
index b881250f..8dca0197 100644
--- a/theories/Reals/RIneq.v
+++ b/theories/Reals/RIneq.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-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -43,7 +43,7 @@ Hint Immediate Rge_refl: rorders.
Lemma Rlt_irrefl : forall r, ~ r < r.
Proof.
- generalize Rlt_asym. intuition eauto.
+ intros r H; eapply Rlt_asym; eauto.
Qed.
Hint Resolve Rlt_irrefl: real.
@@ -64,7 +64,9 @@ Qed.
(**********)
Lemma Rlt_dichotomy_converse : forall r1 r2, r1 < r2 \/ r1 > r2 -> r1 <> r2.
Proof.
- generalize Rlt_not_eq Rgt_not_eq. intuition eauto.
+ intuition.
+ - apply Rlt_not_eq in H1. eauto.
+ - apply Rgt_not_eq in H1. eauto.
Qed.
Hint Resolve Rlt_dichotomy_converse: real.
@@ -74,7 +76,7 @@ Hint Resolve Rlt_dichotomy_converse: real.
Lemma Req_dec : forall r1 r2, r1 = r2 \/ r1 <> r2.
Proof.
intros; generalize (total_order_T r1 r2) Rlt_dichotomy_converse;
- intuition eauto 3.
+ unfold not; intuition eauto 3.
Qed.
Hint Resolve Req_dec: real.
@@ -175,7 +177,7 @@ Proof. eauto using Rnot_gt_ge with rorders. Qed.
Lemma Rlt_not_le : forall r1 r2, r2 < r1 -> ~ r1 <= r2.
Proof.
generalize Rlt_asym Rlt_dichotomy_converse; unfold Rle.
- intuition eauto 3.
+ unfold not; intuition eauto 3.
Qed.
Hint Immediate Rlt_not_le: real.
@@ -407,11 +409,20 @@ Proof.
rewrite Rplus_assoc; rewrite H; ring.
Qed.
-Hint Resolve (f_equal (A:=R)): real.
+Definition f_equal_R := (f_equal (A:=R)).
+
+Hint Resolve f_equal_R : real.
Lemma Rplus_eq_compat_l : forall r r1 r2, r1 = r2 -> r + r1 = r + r2.
Proof.
- auto with real.
+ intros r r1 r2.
+ apply f_equal.
+Qed.
+
+Lemma Rplus_eq_compat_r : forall r r1 r2, r1 = r2 -> r1 + r = r2 + r.
+Proof.
+ intros r r1 r2.
+ apply (f_equal (fun v => v + r)).
Qed.
(*i Old i*)Hint Resolve Rplus_eq_compat_l: v62.
@@ -427,6 +438,13 @@ Proof.
Qed.
Hint Resolve Rplus_eq_reg_l: real.
+Lemma Rplus_eq_reg_r : forall r r1 r2, r1 + r = r2 + r -> r1 = r2.
+Proof.
+ intros r r1 r2 H.
+ apply Rplus_eq_reg_l with r.
+ now rewrite 2!(Rplus_comm r).
+Qed.
+
(**********)
Lemma Rplus_0_r_uniq : forall r r1, r + r1 = r -> r1 = 0.
Proof.
@@ -664,6 +682,11 @@ Hint Resolve Ropp_plus_distr: real.
(** ** Opposite and multiplication *)
(*********************************************************)
+Lemma Ropp_mult_distr_l : forall r1 r2, - (r1 * r2) = - r1 * r2.
+Proof.
+ intros; ring.
+Qed.
+
Lemma Ropp_mult_distr_l_reverse : forall r1 r2, - r1 * r2 = - (r1 * r2).
Proof.
intros; ring.
@@ -677,13 +700,18 @@ Proof.
Qed.
Hint Resolve Rmult_opp_opp: real.
+Lemma Ropp_mult_distr_r : forall r1 r2, - (r1 * r2) = r1 * - r2.
+Proof.
+ intros; ring.
+Qed.
+
Lemma Ropp_mult_distr_r_reverse : forall r1 r2, r1 * - r2 = - (r1 * r2).
Proof.
intros; ring.
Qed.
(*********************************************************)
-(** ** Substraction *)
+(** ** Subtraction *)
(*********************************************************)
Lemma Rminus_0_r : forall r, r - 0 = r.
@@ -794,7 +822,7 @@ Hint Resolve Rinv_involutive: real.
Lemma Rinv_mult_distr :
forall r1 r2, r1 <> 0 -> r2 <> 0 -> / (r1 * r2) = / r1 * / r2.
Proof.
- intros; field; auto.
+ intros; field; auto.
Qed.
(*********)
@@ -969,7 +997,7 @@ Qed.
(** *** Cancellation *)
-Lemma Rplus_lt_reg_r : forall r r1 r2, r + r1 < r + r2 -> r1 < r2.
+Lemma Rplus_lt_reg_l : forall r r1 r2, r + r1 < r + r2 -> r1 < r2.
Proof.
intros; cut (- r + r + r1 < - r + r + r2).
rewrite Rplus_opp_l.
@@ -979,10 +1007,17 @@ Proof.
apply (Rplus_lt_compat_l (- r) (r + r1) (r + r2) H).
Qed.
+Lemma Rplus_lt_reg_r : forall r r1 r2, r1 + r < r2 + r -> r1 < r2.
+Proof.
+ intros.
+ apply (Rplus_lt_reg_l r).
+ now rewrite 2!(Rplus_comm r).
+Qed.
+
Lemma Rplus_le_reg_l : forall r r1 r2, r + r1 <= r + r2 -> r1 <= r2.
Proof.
unfold Rle; intros; elim H; intro.
- left; apply (Rplus_lt_reg_r r r1 r2 H0).
+ left; apply (Rplus_lt_reg_l r r1 r2 H0).
right; apply (Rplus_eq_reg_l r r1 r2 H0).
Qed.
@@ -995,7 +1030,7 @@ Qed.
Lemma Rplus_gt_reg_l : forall r r1 r2, r + r1 > r + r2 -> r1 > r2.
Proof.
- unfold Rgt; intros; apply (Rplus_lt_reg_r r r2 r1 H).
+ unfold Rgt; intros; apply (Rplus_lt_reg_l r r2 r1 H).
Qed.
Lemma Rplus_ge_reg_l : forall r r1 r2, r + r1 >= r + r2 -> r1 >= r2.
@@ -1047,12 +1082,10 @@ Qed.
Lemma Ropp_gt_lt_contravar : forall r1 r2, r1 > r2 -> - r1 < - r2.
Proof.
unfold Rgt; intros.
- apply (Rplus_lt_reg_r (r2 + r1)).
- replace (r2 + r1 + - r1) with r2.
- replace (r2 + r1 + - r2) with r1.
- trivial.
- ring.
- ring.
+ apply (Rplus_lt_reg_l (r2 + r1)).
+ replace (r2 + r1 + - r1) with r2 by ring.
+ replace (r2 + r1 + - r2) with r1 by ring.
+ exact H.
Qed.
Hint Resolve Ropp_gt_lt_contravar.
@@ -1324,19 +1357,22 @@ Qed.
Lemma Rlt_minus : forall r1 r2, r1 < r2 -> r1 - r2 < 0.
Proof.
- intros; apply (Rplus_lt_reg_r r2).
- replace (r2 + (r1 - r2)) with r1.
- replace (r2 + 0) with r2; auto with real.
- ring.
+ intros; apply (Rplus_lt_reg_l r2).
+ replace (r2 + (r1 - r2)) with r1 by ring.
+ now rewrite Rplus_0_r.
Qed.
Hint Resolve Rlt_minus: real.
Lemma Rgt_minus : forall r1 r2, r1 > r2 -> r1 - r2 > 0.
Proof.
- intros; apply (Rplus_lt_reg_r r2).
- replace (r2 + (r1 - r2)) with r1.
- replace (r2 + 0) with r2; auto with real.
- ring.
+ intros; apply (Rplus_lt_reg_l r2).
+ replace (r2 + (r1 - r2)) with r1 by ring.
+ now rewrite Rplus_0_r.
+Qed.
+
+Lemma Rlt_Rminus : forall a b:R, a < b -> 0 < b - a.
+Proof.
+ intros a b; apply Rgt_minus.
Qed.
(**********)
@@ -1368,6 +1404,9 @@ Proof.
ring.
Qed.
+Lemma Rminus_gt_0_lt : forall a b, 0 < b - a -> a < b.
+Proof. intro; intro; apply Rminus_gt. Qed.
+
(**********)
Lemma Rminus_le : forall r1 r2, r1 - r2 <= 0 -> r1 <= r2.
Proof.
@@ -1625,7 +1664,7 @@ Proof.
apply (Rlt_irrefl 0); auto.
do 2 rewrite S_INR in H1; cut (INR n1 < INR n0).
intro H2; generalize (H0 n0 H2); intro; auto with arith.
- apply (Rplus_lt_reg_r 1 (INR n1) (INR n0)).
+ apply (Rplus_lt_reg_l 1 (INR n1) (INR n0)).
rewrite Rplus_comm; rewrite (Rplus_comm 1 (INR n0)); trivial.
Qed.
Hint Resolve INR_lt: real.
@@ -1931,18 +1970,26 @@ Proof.
apply (Rmult_le_compat_l x 0 y H H0).
Qed.
+Lemma Rinv_le_contravar :
+ forall x y, 0 < x -> x <= y -> / y <= / x.
+Proof.
+ intros x y H1 [H2|H2].
+ apply Rlt_le.
+ apply Rinv_lt_contravar with (2 := H2).
+ apply Rmult_lt_0_compat with (1 := H1).
+ now apply Rlt_trans with x.
+ rewrite H2.
+ apply Rle_refl.
+Qed.
+
Lemma Rle_Rinv : forall x y:R, 0 < x -> 0 < y -> x <= y -> / y <= / x.
Proof.
- intros; apply Rmult_le_reg_l with x.
- apply H.
- rewrite <- Rinv_r_sym.
- apply Rmult_le_reg_l with y.
- apply H0.
- rewrite Rmult_1_r; rewrite Rmult_comm; rewrite Rmult_assoc;
- rewrite <- Rinv_l_sym.
- rewrite Rmult_1_r; apply H1.
- red; intro; rewrite H2 in H0; elim (Rlt_irrefl _ H0).
- red; intro; rewrite H2 in H; elim (Rlt_irrefl _ H).
+ intros x y H _.
+ apply Rinv_le_contravar with (1 := H).
+Qed.
+
+Lemma Ropp_div : forall x y, -x/y = - (x / y).
+intros x y; unfold Rdiv; ring.
Qed.
Lemma double : forall r1, 2 * r1 = r1 + r1.
@@ -2018,6 +2065,29 @@ Proof.
intros; elim (completeness E H H0); intros; split with x; assumption.
Qed.
+Lemma Rdiv_lt_0_compat : forall a b, 0 < a -> 0 < b -> 0 < a/b.
+Proof.
+intros; apply Rmult_lt_0_compat;[|apply Rinv_0_lt_compat]; assumption.
+Qed.
+
+Lemma Rdiv_plus_distr : forall a b c, (a + b)/c = a/c + b/c.
+intros a b c; apply Rmult_plus_distr_r.
+Qed.
+
+Lemma Rdiv_minus_distr : forall a b c, (a - b)/c = a/c - b/c.
+intros a b c; unfold Rminus, Rdiv; rewrite Rmult_plus_distr_r; ring.
+Qed.
+
+(* A test for equality function. *)
+Lemma Req_EM_T : forall r1 r2:R, {r1 = r2} + {r1 <> r2}.
+Proof.
+ intros; destruct (total_order_T r1 r2) as [[H|]|H].
+ - right; red; intros ->; elim (Rlt_irrefl r2 H).
+ - left; assumption.
+ - right; red; intros ->; elim (Rlt_irrefl r2 H).
+Qed.
+
+
(*********************************************************)
(** * Definitions of new types *)
(*********************************************************)
@@ -2035,6 +2105,7 @@ Record negreal : Type := mknegreal {neg :> R; cond_neg : neg < 0}.
Record nonzeroreal : Type := mknonzeroreal
{nonzero :> R; cond_nonzero : nonzero <> 0}.
+
(** Compatibility *)
Notation prod_neq_R0 := Rmult_integral_contrapositive_currified (only parsing).
diff --git a/theories/Reals/RList.v b/theories/Reals/RList.v
index ad3002b4..abf8a99d 100644
--- a/theories/Reals/RList.v
+++ b/theories/Reals/RList.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -181,13 +181,13 @@ Proof.
elim Hrecl; intros; assert (H3 := H1 H0); elim H3; intros; elim H4; intros;
exists (S x0); split;
[ simpl; apply lt_n_S; assumption | simpl; assumption ].
- elim H; intros; elim H0; intros; elim (zerop x0); intro.
- rewrite a in H2; simpl in H2; left; assumption.
- right; elim Hrecl; intros; apply H4; assert (H5 : S (pred x0) = x0).
+ elim H; intros; elim H0; intros; destruct (zerop x0) as [->|].
+ simpl in H2; left; assumption.
+ right; elim Hrecl; intros H4 H5; apply H5; assert (H6 : S (pred x0) = x0).
symmetry ; apply S_pred with 0%nat; assumption.
exists (pred x0); split;
- [ simpl in H1; apply lt_S_n; rewrite H5; assumption
- | rewrite <- H5 in H2; simpl in H2; assumption ].
+ [ simpl in H1; apply lt_S_n; rewrite H6; assumption
+ | rewrite <- H6 in H2; simpl in H2; assumption ].
Qed.
Lemma Rlist_P1 :
@@ -208,11 +208,11 @@ Proof.
assert (H3 := Hrecl H2); elim H1; intros; elim H3; intros; exists (cons x x0);
intros; elim H5; clear H5; intros; split.
simpl; rewrite H5; reflexivity.
- intros; elim (zerop i); intro.
- rewrite a; simpl; assumption.
- assert (H8 : i = S (pred i)).
+ intros; destruct (zerop i) as [->|].
+ simpl; assumption.
+ assert (H9 : i = S (pred i)).
apply S_pred with 0%nat; assumption.
- rewrite H8; simpl; apply H6; simpl in H7; apply lt_S_n; rewrite <- H8;
+ rewrite H9; simpl; apply H6; simpl in H7; apply lt_S_n; rewrite <- H9;
assumption.
Qed.
diff --git a/theories/Reals/ROrderedType.v b/theories/Reals/ROrderedType.v
index 1e92edd6..0531bd0a 100644
--- a/theories/Reals/ROrderedType.v
+++ b/theories/Reals/ROrderedType.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -15,7 +15,7 @@ Local Open Scope R_scope.
Lemma Req_dec : forall r1 r2:R, {r1 = r2} + {r1 <> r2}.
Proof.
intros; generalize (total_order_T r1 r2) Rlt_dichotomy_converse;
- intuition eauto 3.
+ intuition eauto.
Qed.
Definition Reqb r1 r2 := if Req_dec r1 r2 then true else false.
diff --git a/theories/Reals/R_Ifp.v b/theories/Reals/R_Ifp.v
index 4f4293f3..57ee1d9a 100644
--- a/theories/Reals/R_Ifp.v
+++ b/theories/Reals/R_Ifp.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Reals/R_sqr.v b/theories/Reals/R_sqr.v
index 5900a147..f1e2d6fa 100644
--- a/theories/Reals/R_sqr.v
+++ b/theories/Reals/R_sqr.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -97,7 +97,7 @@ Qed.
Lemma Rsqr_incr_0 :
forall x y:R, Rsqr x <= Rsqr y -> 0 <= x -> 0 <= y -> x <= y.
Proof.
- intros; case (Rle_dec x y); intro;
+ intros; destruct (Rle_dec x y) as [Hle|Hnle];
[ assumption
| cut (y < x);
[ intro; unfold Rsqr in H;
@@ -109,7 +109,7 @@ Qed.
Lemma Rsqr_incr_0_var : forall x y:R, Rsqr x <= Rsqr y -> 0 <= y -> x <= y.
Proof.
- intros; case (Rle_dec x y); intro;
+ intros; destruct (Rle_dec x y) as [Hle|Hnle];
[ assumption
| cut (y < x);
[ intro; unfold Rsqr in H;
@@ -146,8 +146,8 @@ Qed.
Lemma Rsqr_neg_pos_le_0 :
forall x y:R, Rsqr x <= Rsqr y -> 0 <= y -> - y <= x.
Proof.
- intros; case (Rcase_abs x); intro.
- generalize (Ropp_lt_gt_contravar x 0 r); rewrite Ropp_0; intro;
+ intros; destruct (Rcase_abs x) as [Hlt|Hle].
+ generalize (Ropp_lt_gt_contravar x 0 Hlt); rewrite Ropp_0; intro;
generalize (Rlt_le 0 (- x) H1); intro; rewrite (Rsqr_neg x) in H;
generalize (Rsqr_incr_0 (- x) y H H2 H0); intro;
rewrite <- (Ropp_involutive x); apply Ropp_ge_le_contravar;
@@ -160,25 +160,23 @@ Qed.
Lemma Rsqr_neg_pos_le_1 :
forall x y:R, - y <= x -> x <= y -> 0 <= y -> Rsqr x <= Rsqr y.
Proof.
- intros; case (Rcase_abs x); intro.
- generalize (Ropp_lt_gt_contravar x 0 r); rewrite Ropp_0; intro;
- generalize (Rlt_le 0 (- x) H2); intro;
- generalize (Ropp_le_ge_contravar (- y) x H); rewrite Ropp_involutive;
- intro; generalize (Rge_le y (- x) H4); intro; rewrite (Rsqr_neg x);
- apply Rsqr_incr_1; assumption.
- generalize (Rge_le x 0 r); intro; apply Rsqr_incr_1; assumption.
+ intros x y H H0 H1; destruct (Rcase_abs x) as [Hlt|Hle].
+ apply Ropp_lt_gt_contravar, Rlt_le in Hlt; rewrite Ropp_0 in Hlt;
+ apply Ropp_le_ge_contravar, Rge_le in H; rewrite Ropp_involutive in H;
+ rewrite (Rsqr_neg x); apply Rsqr_incr_1; assumption.
+ apply Rge_le in Hle; apply Rsqr_incr_1; assumption.
Qed.
Lemma neg_pos_Rsqr_le : forall x y:R, - y <= x -> x <= y -> Rsqr x <= Rsqr y.
Proof.
- intros; case (Rcase_abs x); intro.
- generalize (Ropp_lt_gt_contravar x 0 r); rewrite Ropp_0; intro;
- generalize (Ropp_le_ge_contravar (- y) x H); rewrite Ropp_involutive;
- intro; generalize (Rge_le y (- x) H2); intro; generalize (Rlt_le 0 (- x) H1);
- intro; generalize (Rle_trans 0 (- x) y H4 H3); intro;
- rewrite (Rsqr_neg x); apply Rsqr_incr_1; assumption.
- generalize (Rge_le x 0 r); intro; generalize (Rle_trans 0 x y H1 H0); intro;
- apply Rsqr_incr_1; assumption.
+ intros x y H H0; destruct (Rcase_abs x) as [Hlt|Hle].
+ apply Ropp_lt_gt_contravar, Rlt_le in Hlt; rewrite Ropp_0 in Hlt;
+ apply Ropp_le_ge_contravar, Rge_le in H; rewrite Ropp_involutive in H.
+ assert (0 <= y) by (apply Rle_trans with (-x); assumption).
+ rewrite (Rsqr_neg x); apply Rsqr_incr_1; assumption.
+ apply Rge_le in Hle;
+ assert (0 <= y) by (apply Rle_trans with x; assumption).
+ apply Rsqr_incr_1; assumption.
Qed.
Lemma Rsqr_abs : forall x:R, Rsqr x = Rsqr (Rabs x).
@@ -220,22 +218,22 @@ Qed.
Lemma Rsqr_eq_abs_0 : forall x y:R, Rsqr x = Rsqr y -> Rabs x = Rabs y.
Proof.
- intros; unfold Rabs; case (Rcase_abs x); case (Rcase_abs y); intros.
- rewrite (Rsqr_neg x) in H; rewrite (Rsqr_neg y) in H;
- generalize (Ropp_lt_gt_contravar y 0 r);
- generalize (Ropp_lt_gt_contravar x 0 r0); rewrite Ropp_0;
+ intros; unfold Rabs; case (Rcase_abs x) as [Hltx|Hgex];
+ case (Rcase_abs y) as [Hlty|Hgey].
+ rewrite (Rsqr_neg x), (Rsqr_neg y) in H;
+ generalize (Ropp_lt_gt_contravar y 0 Hlty);
+ generalize (Ropp_lt_gt_contravar x 0 Hltx); rewrite Ropp_0;
intros; generalize (Rlt_le 0 (- x) H0); generalize (Rlt_le 0 (- y) H1);
intros; apply Rsqr_inj; assumption.
- rewrite (Rsqr_neg x) in H; generalize (Rge_le y 0 r); intro;
- generalize (Ropp_lt_gt_contravar x 0 r0); rewrite Ropp_0;
+ rewrite (Rsqr_neg x) in H; generalize (Rge_le y 0 Hgey); intro;
+ generalize (Ropp_lt_gt_contravar x 0 Hltx); rewrite Ropp_0;
intro; generalize (Rlt_le 0 (- x) H1); intro; apply Rsqr_inj;
assumption.
- rewrite (Rsqr_neg y) in H; generalize (Rge_le x 0 r0); intro;
- generalize (Ropp_lt_gt_contravar y 0 r); rewrite Ropp_0;
+ rewrite (Rsqr_neg y) in H; generalize (Rge_le x 0 Hgex); intro;
+ generalize (Ropp_lt_gt_contravar y 0 Hlty); rewrite Ropp_0;
intro; generalize (Rlt_le 0 (- y) H1); intro; apply Rsqr_inj;
assumption.
- generalize (Rge_le x 0 r0); generalize (Rge_le y 0 r); intros; apply Rsqr_inj;
- assumption.
+ apply Rsqr_inj; auto using Rge_le.
Qed.
Lemma Rsqr_eq_asb_1 : forall x y:R, Rabs x = Rabs y -> Rsqr x = Rsqr y.
diff --git a/theories/Reals/R_sqrt.v b/theories/Reals/R_sqrt.v
index 38a38400..20319a2b 100644
--- a/theories/Reals/R_sqrt.v
+++ b/theories/Reals/R_sqrt.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -37,8 +37,8 @@ Lemma sqrt_sqrt : forall x:R, 0 <= x -> sqrt x * sqrt x = x.
Proof.
intros.
unfold sqrt.
- case (Rcase_abs x); intro.
- elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ r H)).
+ case (Rcase_abs x) as [Hlt|Hge].
+ elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ Hlt H)).
rewrite Rsqrt_Rsqrt; reflexivity.
Qed.
@@ -94,6 +94,10 @@ Proof.
intros; unfold Rsqr; apply sqrt_square; assumption.
Qed.
+Lemma sqrt_pow2 : forall x, 0 <= x -> sqrt (x ^ 2) = x.
+intros; simpl; rewrite Rmult_1_r, sqrt_square; auto.
+Qed.
+
Lemma sqrt_Rsqr_abs : forall x:R, sqrt (Rsqr x) = Rabs x.
Proof.
intro x; rewrite Rsqr_abs; apply sqrt_Rsqr; apply Rabs_pos.
@@ -517,3 +521,4 @@ Proof.
reflexivity.
reflexivity.
Qed.
+
diff --git a/theories/Reals/Ranalysis.v b/theories/Reals/Ranalysis.v
index d656817e..3cda675a 100644
--- a/theories/Reals/Ranalysis.v
+++ b/theories/Reals/Ranalysis.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Reals/Ranalysis1.v b/theories/Reals/Ranalysis1.v
index 2f39c00b..875eebbb 100644
--- a/theories/Reals/Ranalysis1.v
+++ b/theories/Reals/Ranalysis1.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -77,6 +77,23 @@ Definition continuity f : Prop := forall x:R, continuity_pt f x.
Arguments continuity_pt f%F x0%R.
Arguments continuity f%F.
+Lemma continuity_pt_locally_ext :
+ forall f g a x, 0 < a -> (forall y, R_dist y x < a -> f y = g y) ->
+ continuity_pt f x -> continuity_pt g x.
+intros f g a x a0 q cf eps ep.
+destruct (cf eps ep) as [a' [a'p Pa']].
+exists (Rmin a a'); split.
+ unfold Rmin; destruct (Rle_dec a a').
+ assumption.
+ assumption.
+intros y cy; rewrite <- !q.
+ apply Pa'.
+ split;[| apply Rlt_le_trans with (Rmin a a');[ | apply Rmin_r]];tauto.
+ rewrite R_dist_eq; assumption.
+apply Rlt_le_trans with (Rmin a a');[ | apply Rmin_l]; tauto.
+Qed.
+
+
(**********)
Lemma continuity_pt_plus :
forall f1 f2 (x0:R),
@@ -477,6 +494,47 @@ Proof.
auto with real.
Qed.
+(* Extensionally equal functions have the same derivative. *)
+
+Lemma derivable_pt_lim_ext : forall f g x l, (forall z, f z = g z) ->
+ derivable_pt_lim f x l -> derivable_pt_lim g x l.
+intros f g x l fg df e ep; destruct (df e ep) as [d pd]; exists d; intros h;
+rewrite <- !fg; apply pd.
+Qed.
+
+(* extensionally equal functions have the same derivative, locally. *)
+
+Lemma derivable_pt_lim_locally_ext : forall f g x a b l,
+ a < x < b ->
+ (forall z, a < z < b -> f z = g z) ->
+ derivable_pt_lim f x l -> derivable_pt_lim g x l.
+intros f g x a b l axb fg df e ep.
+destruct (df e ep) as [d pd].
+assert (d'h : 0 < Rmin d (Rmin (b - x) (x - a))).
+ apply Rmin_pos;[apply cond_pos | apply Rmin_pos; apply Rlt_Rminus; tauto].
+exists (mkposreal _ d'h); simpl; intros h hn0 cmp.
+rewrite <- !fg;[ |assumption | ].
+ apply pd;[assumption |].
+ apply Rlt_le_trans with (1 := cmp), Rmin_l.
+assert (-h < x - a).
+ apply Rle_lt_trans with (1 := Rle_abs _).
+ rewrite Rabs_Ropp; apply Rlt_le_trans with (1 := cmp).
+ rewrite Rmin_assoc; apply Rmin_r.
+assert (h < b - x).
+ apply Rle_lt_trans with (1 := Rle_abs _).
+ apply Rlt_le_trans with (1 := cmp).
+ rewrite Rmin_comm, <- Rmin_assoc; apply Rmin_l.
+split.
+ apply (Rplus_lt_reg_l (- h)).
+ replace ((-h) + (x + h)) with x by ring.
+ apply (Rplus_lt_reg_r (- a)).
+ replace (((-h) + a) + - a) with (-h) by ring.
+ assumption.
+apply (Rplus_lt_reg_r (- x)).
+replace (x + h + - x) with h by ring.
+assumption.
+Qed.
+
(***********************************)
(** * derivability -> continuity *)
@@ -639,6 +697,24 @@ Proof.
unfold mult_real_fct, mult_fct, fct_cte; reflexivity.
Qed.
+Lemma derivable_pt_lim_div_scal :
+ forall f x l a, derivable_pt_lim f x l ->
+ derivable_pt_lim (fun y => f y / a) x (l / a).
+intros f x l a df;
+ apply (derivable_pt_lim_ext (fun y => /a * f y)).
+ intros z; rewrite Rmult_comm; reflexivity.
+unfold Rdiv; rewrite Rmult_comm; apply derivable_pt_lim_scal; assumption.
+Qed.
+
+Lemma derivable_pt_lim_scal_right :
+ forall f x l a, derivable_pt_lim f x l ->
+ derivable_pt_lim (fun y => f y * a) x (l * a).
+intros f x l a df;
+ apply (derivable_pt_lim_ext (fun y => a * f y)).
+ intros z; rewrite Rmult_comm; reflexivity.
+unfold Rdiv; rewrite Rmult_comm; apply derivable_pt_lim_scal; assumption.
+Qed.
+
Lemma derivable_pt_lim_id : forall x:R, derivable_pt_lim id x 1.
Proof.
intro; unfold derivable_pt_lim.
@@ -1066,15 +1142,8 @@ Lemma pr_nu :
forall f (x:R) (pr1 pr2:derivable_pt f x),
derive_pt f x pr1 = derive_pt f x pr2.
Proof.
- intros.
- unfold derivable_pt in pr1.
- unfold derivable_pt in pr2.
- elim pr1; intros.
- elim pr2; intros.
- unfold derivable_pt_abs in p.
- unfold derivable_pt_abs in p0.
- simpl.
- apply (uniqueness_limite f x x0 x1 p p0).
+ intros f x (x0,H0) (x1,H1).
+ apply (uniqueness_limite f x x0 x1 H0 H1).
Qed.
@@ -1123,7 +1192,7 @@ Proof.
case
(Rcase_abs
((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) /
- Rmin (delta / 2) ((b + - c) / 2) + - l)); intro.
+ Rmin (delta / 2) ((b + - c) / 2) + - l)) as [Hlt|Hge].
replace
(-
((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) /
@@ -1165,7 +1234,7 @@ Proof.
(H20 :=
Rge_le
((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) /
- Rmin (delta / 2) ((b + - c) / 2) + - l) 0 r).
+ Rmin (delta / 2) ((b + - c) / 2) + - l) 0 Hge).
elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H20 H18)).
assumption.
rewrite <- Ropp_0;
@@ -1242,17 +1311,16 @@ Proof.
(mkposreal ((b - c) / 2) H8)).
unfold Rdiv; apply Rmult_lt_0_compat;
[ apply (cond_pos delta) | apply Rinv_0_lt_compat; prove_sup0 ].
- unfold Rabs; case (Rcase_abs (Rmin (delta / 2) ((b - c) / 2))).
- intro.
+ unfold Rabs; case (Rcase_abs (Rmin (delta / 2) ((b - c) / 2))) as [Hlt|Hge].
cut (0 < delta / 2).
intro.
generalize
(Rmin_stable_in_posreal (mkposreal (delta / 2) H10)
(mkposreal ((b - c) / 2) H8)); simpl; intro;
- elim (Rlt_irrefl 0 (Rlt_trans 0 (Rmin (delta / 2) ((b - c) / 2)) 0 H11 r)).
+ elim (Rlt_irrefl 0 (Rlt_trans 0 (Rmin (delta / 2) ((b - c) / 2)) 0 H11 Hlt)).
unfold Rdiv; apply Rmult_lt_0_compat;
[ apply (cond_pos delta) | apply Rinv_0_lt_compat; prove_sup0 ].
- intro; apply Rle_lt_trans with (delta / 2).
+ apply Rle_lt_trans with (delta / 2).
apply Rmin_l.
unfold Rdiv; apply Rmult_lt_reg_l with 2.
prove_sup0.
@@ -1311,13 +1379,12 @@ Proof.
case
(Rcase_abs
((f (c + Rmax (- (delta / 2)) ((a + - c) / 2)) + - f c) /
- Rmax (- (delta / 2)) ((a + - c) / 2) + - l)).
- intro;
- elim
+ Rmax (- (delta / 2)) ((a + - c) / 2) + - l)) as [Hlt|Hge].
+ elim
(Rlt_irrefl 0
(Rlt_trans 0
((f (c + Rmax (- (delta / 2)) ((a + - c) / 2)) + - f c) /
- Rmax (- (delta / 2)) ((a + - c) / 2) + - l) 0 H19 r)).
+ Rmax (- (delta / 2)) ((a + - c) / 2) + - l) 0 H19 Hlt)).
intros;
generalize
(Rplus_lt_compat_r l
@@ -1380,8 +1447,8 @@ Proof.
apply Rplus_lt_compat_l; assumption.
field; discrR.
assumption.
- unfold Rabs; case (Rcase_abs (Rmax (- (delta / 2)) ((a - c) / 2))).
- intro; generalize (RmaxLess1 (- (delta / 2)) ((a - c) / 2)); intro;
+ unfold Rabs; case (Rcase_abs (Rmax (- (delta / 2)) ((a - c) / 2))) as [Hlt|Hge].
+ generalize (RmaxLess1 (- (delta / 2)) ((a - c) / 2)); intro;
generalize
(Ropp_le_ge_contravar (- (delta / 2)) (Rmax (- (delta / 2)) ((a - c) / 2))
H12); rewrite Ropp_involutive; intro;
@@ -1402,7 +1469,7 @@ Proof.
generalize
(Rmax_stable_in_negreal (mknegreal (- (delta / 2)) H13)
(mknegreal ((a - c) / 2) H12)); simpl;
- intro; generalize (Rge_le (Rmax (- (delta / 2)) ((a - c) / 2)) 0 r);
+ intro; generalize (Rge_le (Rmax (- (delta / 2)) ((a - c) / 2)) 0 Hge);
intro;
elim
(Rlt_irrefl 0
@@ -1494,11 +1561,10 @@ Proof.
cut (0 <= (f (x + delta / 2) - f x) / (delta / 2)).
intro; cut (0 <= (f (x + delta / 2) - f x) / (delta / 2) - l).
intro; unfold Rabs;
- case (Rcase_abs ((f (x + delta / 2) - f x) / (delta / 2) - l)).
- intro;
- elim
+ case (Rcase_abs ((f (x + delta / 2) - f x) / (delta / 2) - l)) as [Hlt|Hge].
+ elim
(Rlt_irrefl 0
- (Rle_lt_trans 0 ((f (x + delta / 2) - f x) / (delta / 2) - l) 0 H12 r)).
+ (Rle_lt_trans 0 ((f (x + delta / 2) - f x) / (delta / 2) - l) 0 H12 Hlt)).
intros;
generalize
(Rplus_lt_compat_r l ((f (x + delta / 2) - f x) / (delta / 2) - l)
@@ -1555,7 +1621,7 @@ Proof.
[ apply (cond_pos delta) | apply Rinv_0_lt_compat; prove_sup0 ].
unfold Rdiv; rewrite <- Ropp_mult_distr_l_reverse;
apply Rmult_lt_0_compat.
- apply Rplus_lt_reg_r with l.
+ apply Rplus_lt_reg_l with l.
unfold Rminus; rewrite Rplus_opp_r; rewrite Rplus_0_r; assumption.
apply Rinv_0_lt_compat; prove_sup0.
Qed.
diff --git a/theories/Reals/Ranalysis2.v b/theories/Reals/Ranalysis2.v
index b070cdaa..eb646913 100644
--- a/theories/Reals/Ranalysis2.v
+++ b/theories/Reals/Ranalysis2.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -9,6 +9,7 @@
Require Import Rbase.
Require Import Rfunctions.
Require Import Ranalysis1.
+Require Import Omega.
Local Open Scope R_scope.
(**********)
@@ -432,17 +433,17 @@ Proof.
unfold IZR; unfold INR, Pos.to_nat; simpl; intro;
elim (Rlt_irrefl 1 (Rlt_trans _ _ _ H13 H12)).
apply IZR_lt; omega.
- unfold Rabs; case (Rcase_abs (/ 2)); intro.
+ unfold Rabs; case (Rcase_abs (/ 2)) as [Hlt|Hge].
assert (Hyp : 0 < 2).
prove_sup0.
- assert (H11 := Rmult_lt_compat_l 2 _ _ Hyp r); rewrite Rmult_0_r in H11;
+ assert (H11 := Rmult_lt_compat_l 2 _ _ Hyp Hlt); rewrite Rmult_0_r in H11;
rewrite <- Rinv_r_sym in H11; [ idtac | discrR ].
elim (Rlt_irrefl 0 (Rlt_trans _ _ _ Rlt_0_1 H11)).
reflexivity.
apply (Rabs_pos_lt _ H0).
ring.
assert (H6 := Req_dec x0 (x0 + h)); elim H6; intro.
- intro; rewrite <- H7; unfold dist, R_met; unfold R_dist;
+ intro; rewrite <- H7. unfold R_met, dist; unfold R_dist;
unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0;
apply Rabs_pos_lt.
unfold Rdiv; apply prod_neq_R0;
diff --git a/theories/Reals/Ranalysis3.v b/theories/Reals/Ranalysis3.v
index 614f12bd..407f6410 100644
--- a/theories/Reals/Ranalysis3.v
+++ b/theories/Reals/Ranalysis3.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -731,7 +731,7 @@ Proof.
rewrite <- (Rabs_Ropp (f2 a - f2 x)) in H6.
rewrite Ropp_minus_distr in H6.
assert (H7 := Rle_lt_trans _ _ _ (Rabs_triang_inv _ _) H6).
- apply Rplus_lt_reg_r with (- Rabs (f2 a) + Rabs (f2 x) / 2).
+ apply Rplus_lt_reg_l with (- Rabs (f2 a) + Rabs (f2 x) / 2).
rewrite Rplus_assoc.
rewrite <- double_var.
do 2 rewrite (Rplus_comm (- Rabs (f2 a))).
diff --git a/theories/Reals/Ranalysis4.v b/theories/Reals/Ranalysis4.v
index 2fa17e20..ae2013f0 100644
--- a/theories/Reals/Ranalysis4.v
+++ b/theories/Reals/Ranalysis4.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -13,6 +13,7 @@ Require Import Rtrigo1.
Require Import Ranalysis1.
Require Import Ranalysis3.
Require Import Exp_prop.
+Require Import MVT.
Local Open Scope R_scope.
(**********)
@@ -26,7 +27,7 @@ Proof.
apply derivable_pt_const.
assumption.
assumption.
- unfold div_fct, inv_fct, fct_cte; intro X0; elim X0; intros;
+ unfold div_fct, inv_fct, fct_cte; intros (x0,p);
unfold derivable_pt; exists x0;
unfold derivable_pt_abs; unfold derivable_pt_lim;
unfold derivable_pt_abs in p; unfold derivable_pt_lim in p;
@@ -41,11 +42,7 @@ Lemma pr_nu_var :
forall (f g:R -> R) (x:R) (pr1:derivable_pt f x) (pr2:derivable_pt g x),
f = g -> derive_pt f x pr1 = derive_pt g x pr2.
Proof.
- unfold derivable_pt, derive_pt; intros.
- elim pr1; intros.
- elim pr2; intros.
- simpl.
- rewrite H in p.
+ unfold derivable_pt, derive_pt; intros f g x (x0,p0) (x1,p1) ->.
apply uniqueness_limite with g x; assumption.
Qed.
@@ -54,14 +51,11 @@ Lemma pr_nu_var2 :
forall (f g:R -> R) (x:R) (pr1:derivable_pt f x) (pr2:derivable_pt g x),
(forall h:R, f h = g h) -> derive_pt f x pr1 = derive_pt g x pr2.
Proof.
- unfold derivable_pt, derive_pt; intros.
- elim pr1; intros.
- elim pr2; intros.
- simpl.
- assert (H0 := uniqueness_step2 _ _ _ p).
- assert (H1 := uniqueness_step2 _ _ _ p0).
+ unfold derivable_pt, derive_pt; intros f g x (x0,p0) (x1,p1) H.
+ assert (H0 := uniqueness_step2 _ _ _ p0).
+ assert (H1 := uniqueness_step2 _ _ _ p1).
cut (limit1_in (fun h:R => (f (x + h) - f x) / h) (fun h:R => h <> 0) x1 0).
- intro; assert (H3 := uniqueness_step1 _ _ _ _ H0 H2).
+ intro H2; assert (H3 := uniqueness_step1 _ _ _ _ H0 H2).
assumption.
unfold limit1_in; unfold limit_in; unfold dist;
simpl; unfold R_dist; unfold limit1_in in H1;
@@ -117,14 +111,14 @@ Proof.
rewrite Rplus_opp_r; rewrite Rabs_R0; apply H0.
apply H1.
apply Rle_ge.
- case (Rcase_abs h); intro.
- rewrite (Rabs_left h r) in H2.
- left; rewrite Rplus_comm; apply Rplus_lt_reg_r with (- h); rewrite Rplus_0_r;
+ destruct (Rcase_abs h) as [Hlt|Hgt].
+ rewrite (Rabs_left h Hlt) in H2.
+ left; rewrite Rplus_comm; apply Rplus_lt_reg_l with (- h); rewrite Rplus_0_r;
rewrite <- Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_l;
apply H2.
apply Rplus_le_le_0_compat.
left; apply H.
- apply Rge_le; apply r.
+ apply Rge_le; apply Hgt.
left; apply H.
Qed.
@@ -145,13 +139,13 @@ Proof.
rewrite <- Rinv_r_sym.
rewrite Ropp_involutive; rewrite Rplus_opp_l; rewrite Rabs_R0; apply H0.
apply H2.
- case (Rcase_abs h); intro.
+ destruct (Rcase_abs h) as [Hlt|Hgt].
apply Ropp_lt_cancel.
rewrite Ropp_0; rewrite Ropp_plus_distr; apply Rplus_lt_0_compat.
apply H1.
- apply Ropp_0_gt_lt_contravar; apply r.
- rewrite (Rabs_right h r) in H3.
- apply Rplus_lt_reg_r with (- x); rewrite Rplus_0_r; rewrite <- Rplus_assoc;
+ apply Ropp_0_gt_lt_contravar; apply Hlt.
+ rewrite (Rabs_right h Hgt) in H3.
+ apply Rplus_lt_reg_l with (- x); rewrite Rplus_0_r; rewrite <- Rplus_assoc;
rewrite Rplus_opp_l; rewrite Rplus_0_l; apply H3.
apply H.
apply Ropp_0_gt_lt_contravar; apply H.
@@ -161,13 +155,12 @@ Qed.
Lemma Rderivable_pt_abs : forall x:R, x <> 0 -> derivable_pt Rabs x.
Proof.
intros.
- case (total_order_T x 0); intro.
- elim s; intro.
+ destruct (total_order_T x 0) as [[Hlt|Heq]|Hgt].
unfold derivable_pt; exists (-1).
- apply (Rabs_derive_2 x a).
- elim H; exact b.
+ apply (Rabs_derive_2 x Hlt).
+ elim H; exact Heq.
unfold derivable_pt; exists 1.
- apply (Rabs_derive_1 x r).
+ apply (Rabs_derive_1 x Hgt).
Qed.
(** Rabsolu is continuous for all x *)
@@ -406,3 +399,14 @@ Proof.
intro; apply derive_pt_eq_0.
apply derivable_pt_lim_sinh.
Qed.
+
+Lemma sinh_lt : forall x y, x < y -> sinh x < sinh y.
+intros x y xy; destruct (MVT_cor2 sinh cosh x y xy) as [c [Pc _]].
+ intros; apply derivable_pt_lim_sinh.
+apply Rplus_lt_reg_l with (Ropp (sinh x)); rewrite Rplus_opp_l, Rplus_comm.
+unfold Rminus at 1 in Pc; rewrite Pc; apply Rmult_lt_0_compat;[ | ].
+ unfold cosh; apply Rmult_lt_0_compat;[|apply Rinv_0_lt_compat, Rlt_0_2].
+ now apply Rplus_lt_0_compat; apply exp_pos.
+now apply Rlt_Rminus; assumption.
+Qed.
+
diff --git a/theories/Reals/Ranalysis5.v b/theories/Reals/Ranalysis5.v
index 5c3b03fa..27615c59 100644
--- a/theories/Reals/Ranalysis5.v
+++ b/theories/Reals/Ranalysis5.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -14,6 +14,7 @@ Require Import Fourier.
Require Import RiemannInt.
Require Import SeqProp.
Require Import Max.
+Require Import Omega.
Local Open Scope R_scope.
(** * Preliminaries lemmas *)
@@ -164,8 +165,8 @@ assert (forall x l, lb < x < ub -> (derivable_pt_abs f x l <-> derivable_pt_abs
apply Rlt_le_trans with (r2:=Rmin delta (Rmin (ub - a) (a - lb))) ; [| apply Rmin_r] ; assumption.
unfold derivable_pt in Prf.
unfold derivable_pt in Prg.
- elim Prf; intros.
- elim Prg; intros.
+ elim Prf; intros x0 p.
+ elim Prg; intros x1 p0.
assert (Temp := p); rewrite H in Temp.
unfold derivable_pt_abs in p.
unfold derivable_pt_abs in p0.
@@ -294,8 +295,8 @@ intros. (* f x y f_cont_interv x_lt_y fx_neg fy_pos.*)
generalize (dicho_lb_cv x y (fun z:R => cond_positivity (f z)) H3).
generalize (dicho_up_cv x y (fun z:R => cond_positivity (f z)) H3).
intros X X0.
- elim X; intros.
- elim X0; intros.
+ elim X; intros x0 p.
+ elim X0; intros x1 p0.
assert (H4 := cv_dicho _ _ _ _ _ H3 p0 p).
rewrite H4 in p0.
exists x0.
@@ -337,14 +338,14 @@ intros. (* f x y f_cont_interv x_lt_y fx_neg fy_pos.*)
left; assumption.
intro.
unfold cond_positivity in |- *.
- case (Rle_dec 0 z); intro.
+ destruct (Rle_dec 0 z) as [|Hnotle].
split.
intro; assumption.
intro; reflexivity.
split.
intro feqt;discriminate feqt.
intro.
- elim n0; assumption.
+ elim Hnotle; assumption.
unfold Vn in |- *.
cut (forall z:R, cond_positivity z = false <-> z < 0).
intros.
@@ -358,10 +359,10 @@ intros. (* f x y f_cont_interv x_lt_y fx_neg fy_pos.*)
assumption.
intro.
unfold cond_positivity in |- *.
- case (Rle_dec 0 z); intro.
+ destruct (Rle_dec 0 z) as [Hle|].
split.
intro feqt; discriminate feqt.
- intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H7)).
+ intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ Hle H7)).
split.
intro; auto with real.
intro; reflexivity.
@@ -370,10 +371,9 @@ intros. (* f x y f_cont_interv x_lt_y fx_neg fy_pos.*)
assert (Temp : x <= x0 <= y).
apply IVT_interv_prelim1 with (D:=(fun z : R => cond_positivity (f z))) ; assumption.
assert (H7 := continuity_seq f Wn x0 (H x0 Temp) H5).
- case (total_order_T 0 (f x0)); intro.
- elim s; intro.
+ destruct (total_order_T 0 (f x0)) as [[Hlt|<-]|Hgt].
left; assumption.
- rewrite <- b; right; reflexivity.
+ right; reflexivity.
unfold Un_cv in H7; unfold R_dist in H7.
cut (0 < - f x0).
intro.
@@ -383,7 +383,7 @@ intros. (* f x y f_cont_interv x_lt_y fx_neg fy_pos.*)
rewrite Rabs_right in H11.
pattern (- f x0) at 1 in H11; rewrite <- Rplus_0_r in H11.
unfold Rminus in H11; rewrite (Rplus_comm (f (Wn x2))) in H11.
- assert (H12 := Rplus_lt_reg_r _ _ _ H11).
+ assert (H12 := Rplus_lt_reg_l _ _ _ H11).
assert (H13 := H6 x2).
elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H13 H12)).
apply Rle_ge; left; unfold Rminus in |- *; apply Rplus_le_lt_0_compat.
@@ -396,29 +396,28 @@ intros. (* f x y f_cont_interv x_lt_y fx_neg fy_pos.*)
assert (Temp : x <= x0 <= y).
apply IVT_interv_prelim1 with (D:=(fun z : R => cond_positivity (f z))) ; assumption.
assert (H7 := continuity_seq f Vn x0 (H x0 Temp) H5).
- case (total_order_T 0 (f x0)); intro.
- elim s; intro.
+ destruct (total_order_T 0 (f x0)) as [[Hlt|Heq]|].
unfold Un_cv in H7; unfold R_dist in H7.
- elim (H7 (f x0) a); intros.
- cut (x2 >= x2)%nat; [ intro | unfold ge in |- *; apply le_n ].
+ elim (H7 (f x0) Hlt); intros.
+ cut (x2 >= x2)%nat; [ intro | unfold ge; apply le_n ].
assert (H10 := H8 x2 H9).
rewrite Rabs_left in H10.
pattern (f x0) at 2 in H10; rewrite <- Rplus_0_r in H10.
rewrite Ropp_minus_distr' in H10.
unfold Rminus in H10.
- assert (H11 := Rplus_lt_reg_r _ _ _ H10).
+ assert (H11 := Rplus_lt_reg_l _ _ _ H10).
assert (H12 := H6 x2).
cut (0 < f (Vn x2)).
intro.
elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H13 H12)).
rewrite <- (Ropp_involutive (f (Vn x2))).
apply Ropp_0_gt_lt_contravar; assumption.
- apply Rplus_lt_reg_r with (f x0 - f (Vn x2)).
+ apply Rplus_lt_reg_l with (f x0 - f (Vn x2)).
rewrite Rplus_0_r; replace (f x0 - f (Vn x2) + (f (Vn x2) - f x0)) with 0;
[ unfold Rminus in |- *; apply Rplus_lt_le_0_compat | ring ].
assumption.
apply Ropp_0_ge_le_contravar; apply Rle_ge; apply H6.
- right; rewrite <- b; reflexivity.
+ right; rewrite <- Heq; reflexivity.
left; assumption.
unfold Vn in |- *; assumption.
Qed.
@@ -695,7 +694,7 @@ intros f g lb ub x Prf g_cont_pur lb_lt_ub x_encad Prg_incr f_eq_g df_neq.
exists deltatemp ; exact Htemp.
elim (Hf_deriv eps eps_pos).
intros deltatemp Htemp.
- red in Hlinv ; red in Hlinv ; simpl dist in Hlinv ; unfold R_dist in Hlinv.
+ red in Hlinv ; red in Hlinv ; unfold dist in Hlinv ; unfold R_dist in Hlinv.
assert (Hlinv' := Hlinv (fun h => (f (y+h) - f y)/h) (fun h => h <>0) l 0).
unfold limit1_in, limit_in, dist in Hlinv' ; simpl in Hlinv'. unfold R_dist in Hlinv'.
assert (Premisse : (forall eps : R,
@@ -1038,62 +1037,6 @@ Definition mkposreal_lb_ub (x lb ub:R) (lb_lt_x:lb<x) (x_lt_ub:x<ub) : posreal.
Defined.
(* end hide *)
-Definition boule_of_interval x y (h : x < y) :
- {c :R & {r : posreal | c - r = x /\ c + r = y}}.
-exists ((x + y)/2).
-assert (radius : 0 < (y - x)/2).
- unfold Rdiv; apply Rmult_lt_0_compat; fourier.
- exists (mkposreal _ radius).
- simpl; split; unfold Rdiv; field.
-Qed.
-
-Definition boule_in_interval x y z (h : x < z < y) :
- {c : R & {r | Boule c r z /\ x < c - r /\ c + r < y}}.
-Proof.
-assert (cmp : x * /2 + z * /2 < z * /2 + y * /2).
-destruct h as [h1 h2]; fourier.
-destruct (boule_of_interval _ _ cmp) as [c [r [P1 P2]]].
-exists c, r; split.
- destruct h; unfold Boule; simpl; apply Rabs_def1; fourier.
-destruct h; split; fourier.
-Qed.
-
-Lemma Ball_in_inter : forall c1 c2 r1 r2 x,
- Boule c1 r1 x -> Boule c2 r2 x ->
- {r3 : posreal | forall y, Boule x r3 y -> Boule c1 r1 y /\ Boule c2 r2 y}.
-intros c1 c2 [r1 r1p] [r2 r2p] x; unfold Boule; simpl; intros in1 in2.
-assert (Rmax (c1 - r1)(c2 - r2) < x).
- apply Rmax_lub_lt;[revert in1 | revert in2]; intros h;
- apply Rabs_def2 in h; destruct h; fourier.
-assert (x < Rmin (c1 + r1) (c2 + r2)).
- apply Rmin_glb_lt;[revert in1 | revert in2]; intros h;
- apply Rabs_def2 in h; destruct h; fourier.
-assert (t: 0 < Rmin (x - Rmax (c1 - r1) (c2 - r2))
- (Rmin (c1 + r1) (c2 + r2) - x)).
- apply Rmin_glb_lt; fourier.
-exists (mkposreal _ t).
-apply Rabs_def2 in in1; destruct in1.
-apply Rabs_def2 in in2; destruct in2.
-assert (c1 - r1 <= Rmax (c1 - r1) (c2 - r2)) by apply Rmax_l.
-assert (c2 - r2 <= Rmax (c1 - r1) (c2 - r2)) by apply Rmax_r.
-assert (Rmin (c1 + r1) (c2 + r2) <= c1 + r1) by apply Rmin_l.
-assert (Rmin (c1 + r1) (c2 + r2) <= c2 + r2) by apply Rmin_r.
-assert (Rmin (x - Rmax (c1 - r1) (c2 - r2))
- (Rmin (c1 + r1) (c2 + r2) - x) <= x - Rmax (c1 - r1) (c2 - r2))
- by apply Rmin_l.
-assert (Rmin (x - Rmax (c1 - r1) (c2 - r2))
- (Rmin (c1 + r1) (c2 + r2) - x) <= Rmin (c1 + r1) (c2 + r2) - x)
- by apply Rmin_r.
-simpl.
-intros y h; apply Rabs_def2 in h; destruct h;split; apply Rabs_def1; fourier.
-Qed.
-
-Lemma Boule_center : forall x r, Boule x r x.
-Proof.
-intros x [r rpos]; unfold Boule, Rminus; simpl; rewrite Rplus_opp_r.
-rewrite Rabs_pos_eq;[assumption | apply Rle_refl].
-Qed.
-
Lemma derivable_pt_lim_CVU : forall (fn fn':nat -> R -> R) (f g:R->R)
(x:R) c r, Boule c r x ->
(forall y n, Boule c r y -> derivable_pt_lim (fn n) y (fn' n y)) ->
diff --git a/theories/Reals/Ranalysis_reg.v b/theories/Reals/Ranalysis_reg.v
index ea3899fc..4cf90886 100644
--- a/theories/Reals/Ranalysis_reg.v
+++ b/theories/Reals/Ranalysis_reg.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -28,7 +28,10 @@ Require Export Ranalysis4.
Require Export Rpower.
Local Open Scope R_scope.
-Axiom AppVar : R.
+Definition AppVar : R.
+Proof.
+exact R0.
+Qed.
(**********)
Ltac intro_hyp_glob trm :=
diff --git a/theories/Reals/Ratan.v b/theories/Reals/Ratan.v
index 096c75fe..68718db0 100644
--- a/theories/Reals/Ratan.v
+++ b/theories/Reals/Ratan.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -18,6 +18,7 @@ Require Import SeqProp.
Require Import Ranalysis5.
Require Import SeqSeries.
Require Import PartSum.
+Require Import Omega.
Local Open Scope R_scope.
@@ -449,9 +450,9 @@ fourier.
Qed.
Definition frame_tan y : {x | 0 < x < PI/2 /\ Rabs y < tan x}.
-destruct (total_order_T (Rabs y) 1).
- assert (yle1 : Rabs y <= 1) by (destruct s; fourier).
- clear s; exists 1; split;[split; [exact Rlt_0_1 | exact PI2_1] | ].
+destruct (total_order_T (Rabs y) 1) as [Hs|Hgt].
+ assert (yle1 : Rabs y <= 1) by (destruct Hs; fourier).
+ clear Hs; exists 1; split;[split; [exact Rlt_0_1 | exact PI2_1] | ].
apply Rle_lt_trans with (1 := yle1); exact tan_1_gt_1.
assert (0 < / (Rabs y + 1)).
apply Rinv_0_lt_compat; fourier.
@@ -529,7 +530,7 @@ split.
assumption.
replace (/(Rabs y + 1)) with (2 * u).
fourier.
- unfold u; field; apply Rgt_not_eq; clear -r; fourier.
+ unfold u; field; apply Rgt_not_eq; clear -Hgt; fourier.
solve[discrR].
apply Rgt_not_eq; assumption.
unfold tan.
@@ -735,6 +736,16 @@ replace (Rsqr x) with (x ^ 2) by (unfold Rsqr; ring).
reflexivity.
Qed.
+Lemma derivable_pt_lim_atan :
+ forall x, derivable_pt_lim atan x (/(1 + x^2)).
+Proof.
+intros x.
+apply derive_pt_eq_1 with (derivable_pt_atan x).
+replace (x ^ 2) with (x * x) by ring.
+rewrite <- (Rmult_1_l (Rinv _)).
+apply derive_pt_atan.
+Qed.
+
(** * Definition of the arctangent function as the sum of the arctan power series *)
(* Proof taken from Guillaume Melquiond's interval package for Coq *)
@@ -818,13 +829,11 @@ intros x Hx eps Heps.
apply Rle_lt_trans with (/ INR (2 * N + 1))%R.
unfold Rdiv.
rewrite Rmult_1_l.
- apply Rle_Rinv.
+ apply Rinv_le_contravar.
apply lt_INR_0.
omega.
- replace 0 with (INR 0) by intuition.
- apply lt_INR.
+ apply le_INR.
omega.
- intuition.
rewrite <- (Rinv_involutive eps).
apply Rinv_lt_contravar.
apply Rmult_lt_0_compat.
diff --git a/theories/Reals/Raxioms.v b/theories/Reals/Raxioms.v
index cf6fdbfd..f545d3a0 100644
--- a/theories/Reals/Raxioms.v
+++ b/theories/Reals/Raxioms.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Reals/Rbase.v b/theories/Reals/Rbase.v
index 5541a0f9..7a879f45 100644
--- a/theories/Reals/Rbase.v
+++ b/theories/Reals/Rbase.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Reals/Rbasic_fun.v b/theories/Reals/Rbasic_fun.v
index 225186a6..bb30c0ef 100644
--- a/theories/Reals/Rbasic_fun.v
+++ b/theories/Reals/Rbasic_fun.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -45,12 +45,12 @@ Qed.
(*********)
Lemma Rmin_Rgt_l : forall r1 r2 r, Rmin r1 r2 > r -> r1 > r /\ r2 > r.
Proof.
- intros r1 r2 r; unfold Rmin; case (Rle_dec r1 r2); intros.
+ intros r1 r2 r; unfold Rmin; case (Rle_dec r1 r2) as [Hle|Hnle]; intros.
split.
assumption.
- unfold Rgt; unfold Rgt in H; exact (Rlt_le_trans r r1 r2 H r0).
+ unfold Rgt; exact (Rlt_le_trans r r1 r2 H Hle).
split.
- generalize (Rnot_le_lt r1 r2 n); intro; exact (Rgt_trans r1 r2 r H0 H).
+ generalize (Rnot_le_lt r1 r2 Hnle); intro; exact (Rgt_trans r1 r2 r H0 H).
assumption.
Qed.
@@ -168,10 +168,10 @@ Lemma Rmax_Rle : forall r1 r2 r, r <= Rmax r1 r2 <-> r <= r1 \/ r <= r2.
Proof.
intros; split.
unfold Rmax; case (Rle_dec r1 r2); intros; auto.
- intro; unfold Rmax; case (Rle_dec r1 r2); elim H; clear H; intros;
+ intro; unfold Rmax; case (Rle_dec r1 r2) as [|Hnle]; elim H; clear H; intros;
auto.
apply (Rle_trans r r1 r2); auto.
- generalize (Rnot_le_lt r1 r2 n); clear n; intro; unfold Rgt in H0;
+ generalize (Rnot_le_lt r1 r2 Hnle); clear Hnle; intro; unfold Rgt in H0;
apply (Rlt_le r r1 (Rle_lt_trans r r2 r1 H H0)).
Qed.
@@ -262,6 +262,16 @@ Proof.
intros; unfold Rmax; case (Rle_dec x y); intro; assumption.
Qed.
+Lemma Rmax_Rlt : forall x y z,
+ Rmax x y < z <-> x < z /\ y < z.
+Proof.
+intros x y z; split.
+ unfold Rmax; case (Rle_dec x y).
+ intros xy yz; split;[apply Rle_lt_trans with y|]; assumption.
+ intros xz xy; split;[|apply Rlt_trans with x;[apply Rnot_le_gt|]];assumption.
+ intros [h h']; apply Rmax_lub_lt; assumption.
+Qed.
+
(*********)
Lemma Rmax_neg : forall x y:R, x < 0 -> y < 0 -> Rmax x y < 0.
Proof.
@@ -276,9 +286,9 @@ Qed.
(*********)
Lemma Rcase_abs : forall r, {r < 0} + {r >= 0}.
Proof.
- intro; generalize (Rle_dec 0 r); intro X; elim X; intro; clear X.
- right; apply (Rle_ge 0 r a).
- left; fold (0 > r); apply (Rnot_le_lt 0 r b).
+ intro; generalize (Rle_dec 0 r); intro X; elim X; intro H; clear X.
+ right; apply (Rle_ge 0 r H).
+ left; fold (0 > r); apply (Rnot_le_lt 0 r H).
Qed.
(*********)
@@ -320,9 +330,9 @@ Qed.
(*********)
Lemma Rabs_right : forall r, r >= 0 -> Rabs r = r.
Proof.
- intros; unfold Rabs; case (Rcase_abs r); intro.
+ intros; unfold Rabs; case (Rcase_abs r) as [Hlt|Hge].
absurd (r >= 0).
- exact (Rlt_not_ge r 0 r0).
+ exact (Rlt_not_ge r 0 Hlt).
assumption.
trivial.
Qed.
@@ -337,9 +347,9 @@ Qed.
(*********)
Lemma Rabs_pos : forall x:R, 0 <= Rabs x.
Proof.
- intros; unfold Rabs; case (Rcase_abs x); intro.
- generalize (Ropp_lt_gt_contravar x 0 r); intro; unfold Rgt in H;
- rewrite Ropp_0 in H; unfold Rle; left; assumption.
+ intros; unfold Rabs; case (Rcase_abs x) as [Hlt|Hge].
+ generalize (Ropp_lt_gt_contravar x 0 Hlt); intro; unfold Rgt in H;
+ rewrite Ropp_0 in H; left; assumption.
apply Rge_le; assumption.
Qed.
@@ -350,11 +360,18 @@ Qed.
Definition RRle_abs := Rle_abs.
+Lemma Rabs_le : forall a b, -b <= a <= b -> Rabs a <= b.
+Proof.
+intros a b; unfold Rabs; case Rcase_abs.
+ intros _ [it _]; apply Ropp_le_cancel; rewrite Ropp_involutive; exact it.
+intros _ [_ it]; exact it.
+Qed.
+
(*********)
Lemma Rabs_pos_eq : forall x:R, 0 <= x -> Rabs x = x.
Proof.
- intros; unfold Rabs; case (Rcase_abs x); intro;
- [ generalize (Rgt_not_le 0 x r); intro; exfalso; auto | trivial ].
+ intros; unfold Rabs; case (Rcase_abs x) as [Hlt|Hge];
+ [ generalize (Rgt_not_le 0 x Hlt); intro; exfalso; auto | trivial ].
Qed.
(*********)
@@ -366,100 +383,70 @@ Qed.
(*********)
Lemma Rabs_pos_lt : forall x:R, x <> 0 -> 0 < Rabs x.
Proof.
- intros; generalize (Rabs_pos x); intro; unfold Rle in H0; elim H0; intro;
- auto.
- exfalso; clear H0; elim H; clear H; generalize H1; unfold Rabs;
- case (Rcase_abs x); intros; auto.
- clear r H1; generalize (Rplus_eq_compat_l x 0 (- x) H0);
- rewrite (let (H1, H2) := Rplus_ne x in H1); rewrite (Rplus_opp_r x);
- trivial.
+ intros; destruct (Rabs_pos x) as [|Heq]; auto.
+ apply Rabs_no_R0 in H; symmetry in Heq; contradiction.
Qed.
(*********)
Lemma Rabs_minus_sym : forall x y:R, Rabs (x - y) = Rabs (y - x).
Proof.
- intros; unfold Rabs; case (Rcase_abs (x - y));
- case (Rcase_abs (y - x)); intros.
- generalize (Rminus_lt y x r); generalize (Rminus_lt x y r0); intros;
- generalize (Rlt_asym x y H); intro; exfalso;
- auto.
+ intros; unfold Rabs; case (Rcase_abs (x - y)) as [Hlt|Hge];
+ case (Rcase_abs (y - x)) as [Hlt'|Hge'].
+ apply Rminus_lt, Rlt_asym in Hlt; apply Rminus_lt in Hlt'; contradiction.
rewrite (Ropp_minus_distr x y); trivial.
rewrite (Ropp_minus_distr y x); trivial.
- unfold Rge in r, r0; elim r; elim r0; intros; clear r r0.
- generalize (Ropp_lt_gt_0_contravar (x - y) H); rewrite (Ropp_minus_distr x y);
- intro; unfold Rgt in H0; generalize (Rlt_asym 0 (y - x) H0);
- intro; exfalso; auto.
- rewrite (Rminus_diag_uniq x y H); trivial.
- rewrite (Rminus_diag_uniq y x H0); trivial.
- rewrite (Rminus_diag_uniq y x H0); trivial.
+ destruct Hge; destruct Hge'.
+ apply Ropp_lt_gt_0_contravar in H; rewrite (Ropp_minus_distr x y) in H;
+ apply Rlt_asym in H0; contradiction.
+ apply Rminus_diag_uniq in H0 as ->; trivial.
+ apply Rminus_diag_uniq in H as ->; trivial.
+ apply Rminus_diag_uniq in H0 as ->; trivial.
Qed.
(*********)
Lemma Rabs_mult : forall x y:R, Rabs (x * y) = Rabs x * Rabs y.
Proof.
- intros; unfold Rabs; case (Rcase_abs (x * y)); case (Rcase_abs x);
- case (Rcase_abs y); intros; auto.
- generalize (Rmult_lt_gt_compat_neg_l y x 0 r r0); intro;
- rewrite (Rmult_0_r y) in H; generalize (Rlt_asym (x * y) 0 r1);
- intro; unfold Rgt in H; exfalso; rewrite (Rmult_comm y x) in H;
- auto.
+ intros; unfold Rabs; case (Rcase_abs (x * y)) as [Hlt|Hge];
+ case (Rcase_abs x) as [Hltx|Hgex];
+ case (Rcase_abs y) as [Hlty|Hgey]; auto.
+ apply Rmult_lt_gt_compat_neg_l with (r:=x), Rlt_asym in Hlty; trivial.
+ rewrite Rmult_0_r in Hlty; contradiction.
rewrite (Ropp_mult_distr_l_reverse x y); trivial.
rewrite (Rmult_comm x (- y)); rewrite (Ropp_mult_distr_l_reverse y x);
rewrite (Rmult_comm x y); trivial.
- unfold Rge in r, r0; elim r; elim r0; clear r r0; intros; unfold Rgt in H, H0.
- generalize (Rmult_lt_compat_l x 0 y H H0); intro; rewrite (Rmult_0_r x) in H1;
- generalize (Rlt_asym (x * y) 0 r1); intro; exfalso;
- auto.
- rewrite H in r1; rewrite (Rmult_0_l y) in r1; generalize (Rlt_irrefl 0);
- intro; exfalso; auto.
- rewrite H0 in r1; rewrite (Rmult_0_r x) in r1; generalize (Rlt_irrefl 0);
- intro; exfalso; auto.
- rewrite H0 in r1; rewrite (Rmult_0_r x) in r1; generalize (Rlt_irrefl 0);
- intro; exfalso; auto.
+ destruct Hgex as [| ->], Hgey as [| ->].
+ apply Rmult_lt_compat_l with (r:=x), Rlt_asym in H0; trivial.
+ rewrite Rmult_0_r in H0; contradiction.
+ rewrite Rmult_0_r in Hlt; contradiction (Rlt_irrefl 0).
+ rewrite Rmult_0_l in Hlt; contradiction (Rlt_irrefl 0).
+ rewrite Rmult_0_l in Hlt; contradiction (Rlt_irrefl 0).
rewrite (Rmult_opp_opp x y); trivial.
- unfold Rge in r, r1; elim r; elim r1; clear r r1; intros; unfold Rgt in H0, H.
- generalize (Rmult_lt_compat_l y x 0 H0 r0); intro;
- rewrite (Rmult_0_r y) in H1; rewrite (Rmult_comm y x) in H1;
- generalize (Rlt_asym (x * y) 0 H1); intro; exfalso;
- auto.
- generalize (Rlt_dichotomy_converse x 0 (or_introl (x > 0) r0));
- generalize (Rlt_dichotomy_converse y 0 (or_intror (y < 0) H0));
- intros; generalize (Rmult_integral x y H); intro;
- elim H3; intro; exfalso; auto.
- rewrite H0 in H; rewrite (Rmult_0_r x) in H; unfold Rgt in H;
- generalize (Rlt_irrefl 0); intro; exfalso;
- auto.
- rewrite H0; rewrite (Rmult_0_r x); rewrite (Rmult_0_r (- x)); trivial.
- unfold Rge in r0, r1; elim r0; elim r1; clear r0 r1; intros;
- unfold Rgt in H0, H.
- generalize (Rmult_lt_compat_l x y 0 H0 r); intro; rewrite (Rmult_0_r x) in H1;
- generalize (Rlt_asym (x * y) 0 H1); intro; exfalso;
- auto.
- generalize (Rlt_dichotomy_converse y 0 (or_introl (y > 0) r));
- generalize (Rlt_dichotomy_converse 0 x (or_introl (0 > x) H0));
- intros; generalize (Rmult_integral x y H); intro;
- elim H3; intro; exfalso; auto.
- rewrite H0 in H; rewrite (Rmult_0_l y) in H; unfold Rgt in H;
- generalize (Rlt_irrefl 0); intro; exfalso;
- auto.
- rewrite H0; rewrite (Rmult_0_l y); rewrite (Rmult_0_l (- y)); trivial.
+ destruct Hge. destruct Hgey.
+ apply Rmult_lt_compat_r with (r:=y), Rlt_asym in Hltx; trivial.
+ rewrite Rmult_0_l in Hltx; contradiction.
+ rewrite H0, Rmult_0_r in H; contradiction (Rlt_irrefl 0).
+ rewrite <- Ropp_mult_distr_l, H, Ropp_0; trivial.
+ destruct Hge. destruct Hgex.
+ apply Rmult_lt_compat_l with (r:=x), Rlt_asym in Hlty; trivial.
+ rewrite Rmult_0_r in Hlty; contradiction.
+ rewrite H0, 2!Rmult_0_l; trivial.
+ rewrite <- Ropp_mult_distr_r, H, Ropp_0; trivial.
Qed.
(*********)
Lemma Rabs_Rinv : forall r, r <> 0 -> Rabs (/ r) = / Rabs r.
Proof.
- intro; unfold Rabs; case (Rcase_abs r); case (Rcase_abs (/ r)); auto;
+ intro; unfold Rabs; case (Rcase_abs r) as [Hlt|Hge];
+ case (Rcase_abs (/ r)) as [Hlt'|Hge']; auto;
intros.
apply Ropp_inv_permute; auto.
- generalize (Rinv_lt_0_compat r r1); intro; unfold Rge in r0; elim r0; intros.
- unfold Rgt in H1; generalize (Rlt_asym 0 (/ r) H1); intro; exfalso;
- auto.
- generalize (Rlt_dichotomy_converse (/ r) 0 (or_introl (/ r > 0) H0)); intro;
- exfalso; auto.
- unfold Rge in r1; elim r1; clear r1; intro.
- unfold Rgt in H0; generalize (Rlt_asym 0 (/ r) (Rinv_0_lt_compat r H0));
- intro; exfalso; auto.
- exfalso; auto.
+ rewrite <- Ropp_inv_permute; trivial.
+ destruct Hge' as [| ->].
+ apply Rinv_lt_0_compat, Rlt_asym in Hlt; contradiction.
+ rewrite Ropp_0; trivial.
+ destruct Hge as [| ->].
+ apply Rinv_0_lt_compat, Rlt_asym in H0; contradiction.
+ contradiction (refl_equal 0).
Qed.
Lemma Rabs_Ropp : forall x:R, Rabs (- x) = Rabs x.
@@ -483,13 +470,14 @@ Qed.
(*********)
Lemma Rabs_triang : forall a b:R, Rabs (a + b) <= Rabs a + Rabs b.
Proof.
- intros a b; unfold Rabs; case (Rcase_abs (a + b)); case (Rcase_abs a);
- case (Rcase_abs b); intros.
+ intros a b; unfold Rabs; case (Rcase_abs (a + b)) as [Hlt|Hge];
+ case (Rcase_abs a) as [Hlta|Hgea];
+ case (Rcase_abs b) as [Hltb|Hgeb].
apply (Req_le (- (a + b)) (- a + - b)); rewrite (Ropp_plus_distr a b);
reflexivity.
(**)
rewrite (Ropp_plus_distr a b); apply (Rplus_le_compat_l (- a) (- b) b);
- unfold Rle; unfold Rge in r; elim r; intro.
+ unfold Rle; elim Hgeb; intro.
left; unfold Rgt in H; generalize (Rplus_lt_compat_l (- b) 0 b H); intro;
elim (Rplus_ne (- b)); intros v w; rewrite v in H0;
clear v w; rewrite (Rplus_opp_l b) in H0; apply (Rlt_trans (- b) 0 b H0 H).
@@ -497,24 +485,24 @@ Proof.
(**)
rewrite (Ropp_plus_distr a b); rewrite (Rplus_comm (- a) (- b));
rewrite (Rplus_comm a (- b)); apply (Rplus_le_compat_l (- b) (- a) a);
- unfold Rle; unfold Rge in r0; elim r0; intro.
+ unfold Rle; elim Hgea; intro.
left; unfold Rgt in H; generalize (Rplus_lt_compat_l (- a) 0 a H); intro;
elim (Rplus_ne (- a)); intros v w; rewrite v in H0;
clear v w; rewrite (Rplus_opp_l a) in H0; apply (Rlt_trans (- a) 0 a H0 H).
right; rewrite H; apply Ropp_0.
(**)
- exfalso; generalize (Rplus_ge_compat_l a b 0 r); intro;
+ exfalso; generalize (Rplus_ge_compat_l a b 0 Hgeb); intro;
elim (Rplus_ne a); intros v w; rewrite v in H; clear v w;
- generalize (Rge_trans (a + b) a 0 H r0); intro; clear H;
+ generalize (Rge_trans (a + b) a 0 H Hgea); intro; clear H;
unfold Rge in H0; elim H0; intro; clear H0.
- unfold Rgt in H; generalize (Rlt_asym (a + b) 0 r1); intro; auto.
+ unfold Rgt in H; generalize (Rlt_asym (a + b) 0 Hlt); intro; auto.
absurd (a + b = 0); auto.
apply (Rlt_dichotomy_converse (a + b) 0); left; assumption.
(**)
- exfalso; generalize (Rplus_lt_compat_l a b 0 r); intro;
+ exfalso; generalize (Rplus_lt_compat_l a b 0 Hltb); intro;
elim (Rplus_ne a); intros v w; rewrite v in H; clear v w;
- generalize (Rlt_trans (a + b) a 0 H r0); intro; clear H;
- unfold Rge in r1; elim r1; clear r1; intro.
+ generalize (Rlt_trans (a + b) a 0 H Hlta); intro; clear H;
+ destruct Hge.
unfold Rgt in H; generalize (Rlt_trans (a + b) 0 (a + b) H0 H); intro;
apply (Rlt_irrefl (a + b)); assumption.
rewrite H in H0; apply (Rlt_irrefl 0); assumption.
@@ -522,16 +510,16 @@ Proof.
rewrite (Rplus_comm a b); rewrite (Rplus_comm (- a) b);
apply (Rplus_le_compat_l b a (- a)); apply (Rminus_le a (- a));
unfold Rminus; rewrite (Ropp_involutive a);
- generalize (Rplus_lt_compat_l a a 0 r0); clear r r1;
+ generalize (Rplus_lt_compat_l a a 0 Hlta); clear Hge Hgeb;
intro; elim (Rplus_ne a); intros v w; rewrite v in H;
- clear v w; generalize (Rlt_trans (a + a) a 0 H r0);
+ clear v w; generalize (Rlt_trans (a + a) a 0 H Hlta);
intro; apply (Rlt_le (a + a) 0 H0).
(**)
apply (Rplus_le_compat_l a b (- b)); apply (Rminus_le b (- b));
unfold Rminus; rewrite (Ropp_involutive b);
- generalize (Rplus_lt_compat_l b b 0 r); clear r0 r1;
+ generalize (Rplus_lt_compat_l b b 0 Hltb); clear Hge Hgea;
intro; elim (Rplus_ne b); intros v w; rewrite v in H;
- clear v w; generalize (Rlt_trans (b + b) b 0 H r);
+ clear v w; generalize (Rlt_trans (b + b) b 0 H Hltb);
intro; apply (Rlt_le (b + b) 0 H0).
(**)
unfold Rle; right; reflexivity.
@@ -585,15 +573,15 @@ Qed.
(*********)
Lemma Rabs_def2 : forall x a:R, Rabs x < a -> x < a /\ - a < x.
Proof.
- unfold Rabs; intro x; case (Rcase_abs x); intros.
- generalize (Ropp_gt_lt_0_contravar x r); unfold Rgt; intro;
+ unfold Rabs; intro x; case (Rcase_abs x) as [Hlt|Hge]; intros.
+ generalize (Ropp_gt_lt_0_contravar x Hlt); unfold Rgt; intro;
generalize (Rlt_trans 0 (- x) a H0 H); intro; split.
- apply (Rlt_trans x 0 a r H1).
+ apply (Rlt_trans x 0 a Hlt H1).
generalize (Ropp_lt_gt_contravar (- x) a H); rewrite (Ropp_involutive x);
unfold Rgt; trivial.
- fold (a > x) in H; generalize (Rgt_ge_trans a x 0 H r); intro;
+ fold (a > x) in H; generalize (Rgt_ge_trans a x 0 H Hge); intro;
generalize (Ropp_lt_gt_0_contravar a H0); intro; fold (0 > - a);
- generalize (Rge_gt_trans x 0 (- a) r H1); unfold Rgt;
+ generalize (Rge_gt_trans x 0 (- a) Hge H1); unfold Rgt;
intro; split; assumption.
Qed.
@@ -637,3 +625,51 @@ Proof.
intros.
now rewrite Rabs_Zabs.
Qed.
+
+Lemma Ropp_Rmax : forall x y, - Rmax x y = Rmin (-x) (-y).
+intros x y; apply Rmax_case_strong.
+ now intros w; rewrite Rmin_left;[ | apply Rge_le, Ropp_le_ge_contravar].
+now intros w; rewrite Rmin_right; [ | apply Rge_le, Ropp_le_ge_contravar].
+Qed.
+
+Lemma Ropp_Rmin : forall x y, - Rmin x y = Rmax (-x) (-y).
+intros x y; apply Rmin_case_strong.
+ now intros w; rewrite Rmax_left;[ | apply Rge_le, Ropp_le_ge_contravar].
+now intros w; rewrite Rmax_right; [ | apply Rge_le, Ropp_le_ge_contravar].
+Qed.
+
+Lemma Rmax_assoc : forall a b c, Rmax a (Rmax b c) = Rmax (Rmax a b) c.
+Proof.
+intros a b c.
+unfold Rmax; destruct (Rle_dec b c); destruct (Rle_dec a b);
+ destruct (Rle_dec a c); destruct (Rle_dec b c); auto with real;
+ match goal with
+ | id : ~ ?x <= ?y, id2 : ?x <= ?z |- _ =>
+ case id; apply Rle_trans with z; auto with real
+ | id : ~ ?x <= ?y, id2 : ~ ?z <= ?x |- _ =>
+ case id; apply Rle_trans with z; auto with real
+ end.
+Qed.
+
+Lemma Rminmax : forall a b, Rmin a b <= Rmax a b.
+Proof.
+intros a b; destruct (Rle_dec a b).
+ rewrite Rmin_left, Rmax_right; assumption.
+now rewrite Rmin_right, Rmax_left; assumption ||
+ apply Rlt_le, Rnot_le_gt.
+Qed.
+
+Lemma Rmin_assoc : forall x y z, Rmin x (Rmin y z) =
+ Rmin (Rmin x y) z.
+Proof.
+intros a b c.
+unfold Rmin; destruct (Rle_dec b c); destruct (Rle_dec a b);
+ destruct (Rle_dec a c); destruct (Rle_dec b c); auto with real;
+ match goal with
+ | id : ~ ?x <= ?y, id2 : ?x <= ?z |- _ =>
+ case id; apply Rle_trans with z; auto with real
+ | id : ~ ?x <= ?y, id2 : ~ ?z <= ?x |- _ =>
+ case id; apply Rle_trans with z; auto with real
+ end.
+Qed.
+
diff --git a/theories/Reals/Rcomplete.v b/theories/Reals/Rcomplete.v
index 9b896bdd..1766f377 100644
--- a/theories/Reals/Rcomplete.v
+++ b/theories/Reals/Rcomplete.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -27,21 +27,19 @@ Proof.
intros.
set (Vn := sequence_minorant Un (cauchy_min Un H)).
set (Wn := sequence_majorant Un (cauchy_maj Un H)).
- assert (H0 := maj_cv Un H).
- fold Wn in H0.
- assert (H1 := min_cv Un H).
- fold Vn in H1.
- elim H0; intros.
- elim H1; intros.
+ pose proof (maj_cv Un H) as (x,p).
+ fold Wn in p.
+ pose proof (min_cv Un H) as (x0,p0).
+ fold Vn in p0.
cut (x = x0).
- intros.
+ intros H2.
exists x.
rewrite <- H2 in p0.
unfold Un_cv.
intros.
unfold Un_cv in p; unfold Un_cv in p0.
cut (0 < eps / 3).
- intro.
+ intro H4.
elim (p (eps / 3) H4); intros.
elim (p0 (eps / 3) H4); intros.
exists (max x1 x2).
@@ -83,20 +81,20 @@ Proof.
[ apply Rabs_triang | ring ].
apply Rlt_le_trans with (eps / 3 + eps / 3 + eps / 3).
repeat apply Rplus_lt_compat.
- unfold R_dist in H5.
- apply H5.
+ unfold R_dist in H1.
+ apply H1.
unfold ge; apply le_trans with (max x1 x2).
apply le_max_l.
assumption.
rewrite <- Rabs_Ropp.
replace (- (x - Vn n)) with (Vn n - x); [ idtac | ring ].
- unfold R_dist in H6.
- apply H6.
+ unfold R_dist in H3.
+ apply H3.
unfold ge; apply le_trans with (max x1 x2).
apply le_max_r.
assumption.
- unfold R_dist in H6.
- apply H6.
+ unfold R_dist in H3.
+ apply H3.
unfold ge; apply le_trans with (max x1 x2).
apply le_max_r.
assumption.
@@ -112,11 +110,11 @@ Proof.
intro.
unfold Un_cv in p; unfold Un_cv in p0.
unfold R_dist in p; unfold R_dist in p0.
- elim (p (eps / 5) H3); intros N1 H4.
- elim (p0 (eps / 5) H3); intros N2 H5.
+ elim (p (eps / 5) H1); intros N1 H4.
+ elim (p0 (eps / 5) H1); intros N2 H5.
unfold Cauchy_crit in H.
unfold R_dist in H.
- elim (H (eps / 5) H3); intros N3 H6.
+ elim (H (eps / 5) H1); intros N3 H6.
set (N := max (max N1 N2) N3).
apply Rle_lt_trans with (Rabs (x - Wn N) + Rabs (Wn N - x0)).
replace (x - x0) with (x - Wn N + (Wn N - x0)); [ apply Rabs_triang | ring ].
@@ -146,12 +144,11 @@ Proof.
cut
(Vn N =
minorant (fun k:nat => Un (N + k)%nat) (min_ss Un N (cauchy_min Un H))).
- intros.
- rewrite <- H9; rewrite <- H10.
- rewrite <- H9 in H8.
- rewrite <- H10 in H7.
- elim (H7 (eps / 5) H3); intros k2 H11.
- elim (H8 (eps / 5) H3); intros k1 H12.
+ intros H9 H10.
+ rewrite <- H9 in H8 |- *.
+ rewrite <- H10 in H7 |- *.
+ elim (H7 (eps / 5) H1); intros k2 H11.
+ elim (H8 (eps / 5) H1); intros k1 H12.
apply Rle_lt_trans with
(Rabs (Wn N - Un (N + k2)%nat) + Rabs (Un (N + k2)%nat - Vn N)).
replace (Wn N - Vn N) with
diff --git a/theories/Reals/Rdefinitions.v b/theories/Reals/Rdefinitions.v
index 19cc2166..50eb59b2 100644
--- a/theories/Reals/Rdefinitions.v
+++ b/theories/Reals/Rdefinitions.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Reals/Rderiv.v b/theories/Reals/Rderiv.v
index 64b1b0d4..3a332d21 100644
--- a/theories/Reals/Rderiv.v
+++ b/theories/Reals/Rderiv.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -162,9 +162,9 @@ Proof.
(Rplus_lt_compat (Rabs (d x0 * (x1 - x0))) (eps * / 2)
(Rabs (x1 - x0) * eps) (eps * / 2) H5 H3); intro;
rewrite eps2 in H10; assumption.
- unfold Rabs; case (Rcase_abs 2); auto.
- intro; cut (0 < 2).
- intro ; elim (Rlt_asym 0 2 H7 r).
+ unfold Rabs; destruct (Rcase_abs 2) as [Hlt|Hge]; auto.
+ cut (0 < 2).
+ intro H7; elim (Rlt_asym 0 2 H7 Hlt).
fourier.
apply Rabs_no_R0.
discrR.
@@ -193,11 +193,11 @@ Proof.
unfold limit_in; intros; simpl; split with eps;
split; auto.
intros; elim H0; clear H0; intros; unfold D_x in H0; elim H0; intros;
- rewrite (Rinv_r (x - x0) (Rminus_eq_contra x x0 (not_eq_sym H3)));
- unfold R_dist; rewrite (Rminus_diag_eq 1 1 (eq_refl 1));
- unfold Rabs; case (Rcase_abs 0); intro.
+ rewrite (Rinv_r (x - x0) (Rminus_eq_contra x x0 (sym_not_eq H3)));
+ unfold R_dist; rewrite (Rminus_diag_eq 1 1 (refl_equal 1));
+ unfold Rabs; case (Rcase_abs 0) as [Hlt|Hge].
absurd (0 < 0); auto.
- red; intro; apply (Rlt_irrefl 0 r).
+ red in |- *; intro; apply (Rlt_irrefl 0 Hlt).
unfold Rgt in H; assumption.
Qed.
diff --git a/theories/Reals/Reals.v b/theories/Reals/Reals.v
index 8faa4e25..9cb8a10b 100644
--- a/theories/Reals/Reals.v
+++ b/theories/Reals/Reals.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Reals/Rfunctions.v b/theories/Reals/Rfunctions.v
index ee8988d8..1c353803 100644
--- a/theories/Reals/Rfunctions.v
+++ b/theories/Reals/Rfunctions.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -489,16 +489,16 @@ Lemma pow_Rabs : forall (x:R) (n:nat), x ^ n <= Rabs x ^ n.
Proof.
intros; induction n as [| n Hrecn].
right; reflexivity.
- simpl; case (Rcase_abs x); intro.
+ simpl; destruct (Rcase_abs x) as [Hlt|Hle].
apply Rle_trans with (Rabs (x * x ^ n)).
apply RRle_abs.
rewrite Rabs_mult.
apply Rmult_le_compat_l.
apply Rabs_pos.
- right; symmetry ; apply RPow_abs.
- pattern (Rabs x) at 1; rewrite (Rabs_right x r);
+ right; symmetry; apply RPow_abs.
+ pattern (Rabs x) at 1; rewrite (Rabs_right x Hle);
apply Rmult_le_compat_l.
- apply Rge_le; exact r.
+ apply Rge_le; exact Hle.
apply Hrecn.
Qed.
@@ -520,14 +520,17 @@ Proof.
apply Rle_trans with (Rabs y); [ apply Rabs_pos | exact H ].
Qed.
+Lemma Rsqr_pow2 : forall x, Rsqr x = x ^ 2.
+Proof.
+intros; unfold Rsqr; simpl; rewrite Rmult_1_r; reflexivity.
+Qed.
+
+
(*******************************)
(** * PowerRZ *)
(*******************************)
(*i Due to L.Thery i*)
-Ltac case_eq name :=
- generalize (eq_refl name); pattern name at -1; case name.
-
Definition powerRZ (x:R) (n:Z) :=
match n with
| Z0 => 1
@@ -744,10 +747,10 @@ Qed.
Lemma R_dist_sym : forall x y:R, R_dist x y = R_dist y x.
Proof.
unfold R_dist; intros; split_Rabs; try ring.
- generalize (Ropp_gt_lt_0_contravar (y - x) r); intro;
- rewrite (Ropp_minus_distr y x) in H; generalize (Rlt_asym (x - y) 0 r0);
+ generalize (Ropp_gt_lt_0_contravar (y - x) Hlt0); intro;
+ rewrite (Ropp_minus_distr y x) in H; generalize (Rlt_asym (x - y) 0 Hlt);
intro; unfold Rgt in H; exfalso; auto.
- generalize (minus_Rge y x r); intro; generalize (minus_Rge x y r0); intro;
+ generalize (minus_Rge y x Hge0); intro; generalize (minus_Rge x y Hge); intro;
generalize (Rge_antisym x y H0 H); intro; rewrite H1;
ring.
Qed.
@@ -786,6 +789,13 @@ Proof.
ring.
Qed.
+Lemma R_dist_mult_l : forall a b c,
+ R_dist (a * b) (a * c) = Rabs a * R_dist b c.
+Proof.
+unfold R_dist.
+intros a b c; rewrite <- Rmult_minus_distr_l, Rabs_mult; reflexivity.
+Qed.
+
(*******************************)
(** * Infinite Sum *)
(*******************************)
diff --git a/theories/Reals/Rgeom.v b/theories/Reals/Rgeom.v
index afdf148e..d930c5aa 100644
--- a/theories/Reals/Rgeom.v
+++ b/theories/Reals/Rgeom.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Reals/RiemannInt.v b/theories/Reals/RiemannInt.v
index ce37fcba..856fff80 100644
--- a/theories/Reals/RiemannInt.v
+++ b/theories/Reals/RiemannInt.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-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -12,8 +12,6 @@ Require Import SeqSeries.
Require Import Ranalysis_reg.
Require Import Rbase.
Require Import RiemannInt_SF.
-Require Import Classical_Prop.
-Require Import Classical_Pred_Type.
Require Import Max.
Local Open Scope R_scope.
@@ -51,8 +49,8 @@ Lemma RiemannInt_P1 :
forall (f:R -> R) (a b:R),
Riemann_integrable f a b -> Riemann_integrable f b a.
Proof.
- unfold Riemann_integrable; intros; elim (X eps); clear X; intros;
- elim p; clear p; intros; exists (mkStepFun (StepFun_P6 (pre x)));
+ unfold Riemann_integrable; intros; elim (X eps); clear X; intros.
+ elim p; clear p; intros x0 p; exists (mkStepFun (StepFun_P6 (pre x)));
exists (mkStepFun (StepFun_P6 (pre x0)));
elim p; clear p; intros; split.
intros; apply (H t); elim H1; clear H1; intros; split;
@@ -110,12 +108,10 @@ Proof.
replace (vn n x + -1 * vn m x) with (vn n x - f x + (f x - vn m x));
[ apply Rabs_triang | ring ].
assert (H12 : Rmin a b = a).
- unfold Rmin; case (Rle_dec a b); intro;
- [ reflexivity | elim n0; assumption ].
+ unfold Rmin; decide (Rle_dec a b) with H0; reflexivity.
assert (H13 : Rmax a b = b).
- unfold Rmax; case (Rle_dec a b); intro;
- [ reflexivity | elim n0; assumption ].
- rewrite <- H12 in H11; pattern b at 2 in H11; rewrite <- H13 in H11;
+ unfold Rmax; decide (Rle_dec a b) with H0; reflexivity.
+ rewrite <- H12 in H11; rewrite <- H13 in H11 at 2;
rewrite Rmult_1_l; apply Rplus_le_compat.
rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H9.
elim H11; intros; split; left; assumption.
@@ -142,7 +138,7 @@ Lemma RiemannInt_P3 :
Rabs (RiemannInt_SF (wn n)) < un n) ->
{ l:R | Un_cv (fun N:nat => RiemannInt_SF (vn N)) l }.
Proof.
- intros; case (Rle_dec a b); intro.
+ intros; destruct (Rle_dec a b) as [Hle|Hnle].
apply RiemannInt_P2 with f un wn; assumption.
assert (H1 : b <= a); auto with real.
set (vn' := fun n:nat => mkStepFun (StepFun_P6 (pre (vn n))));
@@ -153,49 +149,48 @@ Proof.
(forall t:R,
Rmin b a <= t <= Rmax b a -> Rabs (f t - vn' n t) <= wn' n t) /\
Rabs (RiemannInt_SF (wn' n)) < un n).
- intro; elim (H0 n0); intros; split.
- intros; apply (H2 t); elim H4; clear H4; intros; split;
+ intro; elim (H0 n); intros; split.
+ intros t (H4,H5); apply (H2 t); split;
[ apply Rle_trans with (Rmin b a); try assumption; right;
unfold Rmin
| apply Rle_trans with (Rmax b a); try assumption; right;
unfold Rmax ];
- (case (Rle_dec a b); case (Rle_dec b a); intros;
- try reflexivity || apply Rle_antisym;
- [ assumption | assumption | auto with real | auto with real ]).
- generalize H3; unfold RiemannInt_SF; case (Rle_dec a b);
- case (Rle_dec b a); unfold wn'; intros;
+ decide (Rle_dec a b) with Hnle; decide (Rle_dec b a) with H1; reflexivity.
+ generalize H3; unfold RiemannInt_SF; destruct (Rle_dec a b) as [Hleab|Hnleab];
+ destruct (Rle_dec b a) as [Hle'|Hnle']; unfold wn'; intros;
(replace
- (Int_SF (subdivision_val (mkStepFun (StepFun_P6 (pre (wn n0)))))
- (subdivision (mkStepFun (StepFun_P6 (pre (wn n0)))))) with
- (Int_SF (subdivision_val (wn n0)) (subdivision (wn n0)));
+ (Int_SF (subdivision_val (mkStepFun (StepFun_P6 (pre (wn n)))))
+ (subdivision (mkStepFun (StepFun_P6 (pre (wn n)))))) with
+ (Int_SF (subdivision_val (wn n)) (subdivision (wn n)));
[ idtac
- | apply StepFun_P17 with (fe (wn n0)) a b;
+ | apply StepFun_P17 with (fe (wn n)) a b;
[ apply StepFun_P1
| apply StepFun_P2;
- apply (StepFun_P1 (mkStepFun (StepFun_P6 (pre (wn n0))))) ] ]).
+ apply (StepFun_P1 (mkStepFun (StepFun_P6 (pre (wn n))))) ] ]).
apply H4.
rewrite Rabs_Ropp; apply H4.
rewrite Rabs_Ropp in H4; apply H4.
apply H4.
- assert (H3 := RiemannInt_P2 _ _ _ _ H H1 H2); elim H3; intros;
+ assert (H3 := RiemannInt_P2 _ _ _ _ H H1 H2); elim H3; intros x p;
exists (- x); unfold Un_cv; unfold Un_cv in p;
intros; elim (p _ H4); intros; exists x0; intros;
generalize (H5 _ H6); unfold R_dist, RiemannInt_SF;
- case (Rle_dec b a); case (Rle_dec a b); intros.
- elim n; assumption.
+ destruct (Rle_dec b a) as [Hle'|Hnle']; destruct (Rle_dec a b) as [Hle''|Hnle''];
+ intros.
+ elim Hnle; assumption.
unfold vn' in H7;
- replace (Int_SF (subdivision_val (vn n0)) (subdivision (vn n0))) with
- (Int_SF (subdivision_val (mkStepFun (StepFun_P6 (pre (vn n0)))))
- (subdivision (mkStepFun (StepFun_P6 (pre (vn n0))))));
+ replace (Int_SF (subdivision_val (vn n)) (subdivision (vn n))) with
+ (Int_SF (subdivision_val (mkStepFun (StepFun_P6 (pre (vn n)))))
+ (subdivision (mkStepFun (StepFun_P6 (pre (vn n))))));
[ unfold Rminus; rewrite Ropp_involutive; rewrite <- Rabs_Ropp;
rewrite Ropp_plus_distr; rewrite Ropp_involutive;
apply H7
- | symmetry ; apply StepFun_P17 with (fe (vn n0)) a b;
+ | symmetry ; apply StepFun_P17 with (fe (vn n)) a b;
[ apply StepFun_P1
| apply StepFun_P2;
- apply (StepFun_P1 (mkStepFun (StepFun_P6 (pre (vn n0))))) ] ].
- elim n1; assumption.
- elim n2; assumption.
+ apply (StepFun_P1 (mkStepFun (StepFun_P6 (pre (vn n))))) ] ].
+ elim Hnle'; assumption.
+ elim Hnle'; assumption.
Qed.
Lemma RiemannInt_exists :
@@ -244,7 +239,7 @@ Proof.
(RiemannInt_SF (phi_sequence vn pr2 n) +
-1 * RiemannInt_SF (phi_sequence un pr1 n)); [ idtac | ring ];
rewrite <- StepFun_P30.
- case (Rle_dec a b); intro.
+ destruct (Rle_dec a b) as [Hle|Hnle].
apply Rle_lt_trans with
(RiemannInt_SF
(mkStepFun
@@ -263,13 +258,11 @@ Proof.
(phi_sequence vn pr2 n x - f x + (f x - phi_sequence un pr1 n x));
[ apply Rabs_triang | ring ].
assert (H10 : Rmin a b = a).
- unfold Rmin; case (Rle_dec a b); intro;
- [ reflexivity | elim n0; assumption ].
+ unfold Rmin; decide (Rle_dec a b) with Hle; reflexivity.
assert (H11 : Rmax a b = b).
- unfold Rmax; case (Rle_dec a b); intro;
- [ reflexivity | elim n0; assumption ].
+ unfold Rmax; decide (Rle_dec a b) with Hle; reflexivity.
rewrite (Rplus_comm (psi_un x)); apply Rplus_le_compat.
- rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; elim H5; intros; apply H8.
+ rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; destruct H5 as (H8,H9); apply H8.
rewrite H10; rewrite H11; elim H7; intros; split; left; assumption.
elim H6; intros; apply H8.
rewrite H10; rewrite H11; elim H7; intros; split; left; assumption.
@@ -319,11 +312,9 @@ Proof.
(phi_sequence vn pr2 n x - f x + (f x - phi_sequence un pr1 n x));
[ apply Rabs_triang | ring ].
assert (H10 : Rmin a b = b).
- unfold Rmin; case (Rle_dec a b); intro;
- [ elim n0; assumption | reflexivity ].
+ unfold Rmin; decide (Rle_dec a b) with Hnle; reflexivity.
assert (H11 : Rmax a b = a).
- unfold Rmax; case (Rle_dec a b); intro;
- [ elim n0; assumption | reflexivity ].
+ unfold Rmax; decide (Rle_dec a b) with Hnle; reflexivity.
apply Rplus_le_compat.
rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; elim H5; intros; apply H8.
rewrite H10; rewrite H11; elim H7; intros; split; left; assumption.
@@ -388,11 +379,9 @@ Proof.
[ idtac
| left; change (0 < / (INR n + 1)); apply Rinv_0_lt_compat;
assumption ]; apply Rle_lt_trans with (/ (INR x + 1)).
- apply Rle_Rinv.
+ apply Rinv_le_contravar.
apply Rplus_le_lt_0_compat; [ apply pos_INR | apply Rlt_0_1 ].
- assumption.
- do 2 rewrite <- (Rplus_comm 1); apply Rplus_le_compat_l; apply le_INR;
- apply H4.
+ apply Rplus_le_compat_r; apply le_INR; apply H4.
rewrite <- (Rinv_involutive eps).
apply Rinv_lt_contravar.
apply Rmult_lt_0_compat.
@@ -405,6 +394,15 @@ Proof.
red; intro; rewrite H6 in H; elim (Rlt_irrefl _ H).
Qed.
+Lemma Riemann_integrable_ext :
+ forall f g a b,
+ (forall x, Rmin a b <= x <= Rmax a b -> f x = g x) ->
+ Riemann_integrable f a b -> Riemann_integrable g a b.
+intros f g a b fg rif eps; destruct (rif eps) as [phi [psi [P1 P2]]].
+exists phi; exists psi;split;[ | assumption ].
+intros t intt; rewrite <- fg;[ | assumption].
+apply P1; assumption.
+Qed.
(**********)
Definition RiemannInt (f:R -> R) (a b:R) (pr:Riemann_integrable f a b) : R :=
let (a,_) := RiemannInt_exists pr RinvN RinvN_cv in a.
@@ -414,10 +412,10 @@ Lemma RiemannInt_P5 :
RiemannInt pr1 = RiemannInt pr2.
Proof.
intros; unfold RiemannInt;
- case (RiemannInt_exists pr1 RinvN RinvN_cv);
- case (RiemannInt_exists pr2 RinvN RinvN_cv); intros;
+ case (RiemannInt_exists pr1 RinvN RinvN_cv) as (x,HUn);
+ case (RiemannInt_exists pr2 RinvN RinvN_cv) as (x0,HUn0);
eapply UL_sequence;
- [ apply u0
+ [ apply HUn
| apply RiemannInt_P4 with pr2 RinvN; apply RinvN_cv || assumption ].
Qed.
@@ -434,14 +432,13 @@ Proof.
exists 0%nat; unfold I; rewrite Rmult_0_l; rewrite Rplus_0_r;
assumption.
cut (Nbound I).
- intro; assert (H2 := Nzorn H0 H1); elim H2; intros; exists x; elim p; intros;
+ intro; assert (H2 := Nzorn H0 H1); elim H2; intros x p; exists x; elim p; intros;
split.
apply H3.
- case (total_order_T (a + INR (S x) * del) b); intro.
- elim s; intro.
- assert (H5 := H4 (S x) a0); elim (le_Sn_n _ H5).
+ destruct (total_order_T (a + INR (S x) * del) b) as [[Hlt|Heq]|Hgt].
+ assert (H5 := H4 (S x) Hlt); elim (le_Sn_n _ H5).
right; symmetry ; assumption.
- left; apply r.
+ left; apply Hgt.
assert (H1 : 0 <= (b - a) / del).
unfold Rdiv; apply Rmult_le_pos;
[ apply Rge_le; apply Rge_minus; apply Rle_ge; left; apply H
@@ -509,22 +506,24 @@ Proof.
| apply Rmin_r ]
| intros; apply H3; try assumption; apply Rlt_le_trans with (Rmin x (b - a));
[ assumption | apply Rmin_l ] ].
- assert (H3 := completeness E H1 H2); elim H3; intros; cut (0 < x <= b - a).
+ assert (H3 := completeness E H1 H2); elim H3; intros x p; cut (0 < x <= b - a).
intro; elim H4; clear H4; intros; exists (mkposreal _ H4); split.
apply H5.
unfold is_lub in p; elim p; intros; unfold is_upper_bound in H6;
- set (D := Rabs (x0 - y)); elim (classic (exists y : R, D < y /\ E y));
- intro.
+ set (D := Rabs (x0 - y)).
+ assert (H11: ((exists y : R, D < y /\ E y) \/ (forall y : R, not (D < y /\ E y)) -> False) -> False).
+ clear; intros H; apply H.
+ right; intros y0 H0; apply H.
+ left; now exists y0.
+ apply Rnot_le_lt; intros H30.
+ apply H11; clear H11; intros H11.
+ revert H30; apply Rlt_not_le.
+ destruct H11 as [H11|H12].
elim H11; intros; elim H12; clear H12; intros; unfold E in H13; elim H13;
intros; apply H15; assumption.
- assert (H12 := not_ex_all_not _ (fun y:R => D < y /\ E y) H11);
- assert (H13 : is_upper_bound E D).
+ assert (H13 : is_upper_bound E D).
unfold is_upper_bound; intros; assert (H14 := H12 x1);
- elim (not_and_or (D < x1) (E x1) H14); intro.
- case (Rle_dec x1 D); intro.
- assumption.
- elim H15; auto with real.
- elim H15; assumption.
+ apply Rnot_lt_le; contradict H14; now split.
assert (H14 := H7 _ H13); elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H14 H10)).
unfold is_lub in p; unfold is_upper_bound in p; elim p; clear p; intros;
split.
@@ -544,17 +543,16 @@ Lemma Heine_cor2 :
a <= x <= b ->
a <= y <= b -> Rabs (x - y) < delta -> Rabs (f x - f y) < eps }.
Proof.
- intro f; intros; case (total_order_T a b); intro.
- elim s; intro.
- assert (H0 := Heine_cor1 a0 H eps); elim H0; intros; exists x;
+ intro f; intros; destruct (total_order_T a b) as [[Hlt|Heq]|Hgt].
+ assert (H0 := Heine_cor1 Hlt H eps); elim H0; intros x p; exists x;
elim p; intros; apply H2; assumption.
exists (mkposreal _ Rlt_0_1); intros; assert (H3 : x = y);
- [ elim H0; elim H1; intros; rewrite b0 in H3; rewrite b0 in H5;
+ [ elim H0; elim H1; intros; rewrite Heq in H3, H5;
apply Rle_antisym; apply Rle_trans with b; assumption
| rewrite H3; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0;
apply (cond_pos eps) ].
exists (mkposreal _ Rlt_0_1); intros; elim H0; intros;
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ (Rle_trans _ _ _ H3 H4) r)).
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ (Rle_trans _ _ _ H3 H4) Hgt)).
Qed.
Lemma SubEqui_P1 :
@@ -567,7 +565,7 @@ Lemma SubEqui_P2 :
forall (a b:R) (del:posreal) (h:a < b),
pos_Rl (SubEqui del h) (pred (Rlength (SubEqui del h))) = b.
Proof.
- intros; unfold SubEqui; case (maxN del h); intros; clear a0;
+ intros; unfold SubEqui; destruct (maxN del h)as (x,_).
cut
(forall (x:nat) (a:R) (del:posreal),
pos_Rl (SubEquiN (S x) a b del)
@@ -623,8 +621,8 @@ Proof.
simpl in H; inversion H.
rewrite (SubEqui_P6 del h (i:=(max_N del h))).
replace (S (max_N del h)) with (pred (Rlength (SubEqui del h))).
- rewrite SubEqui_P2; unfold max_N; case (maxN del h); intros; left;
- elim a0; intros; assumption.
+ rewrite SubEqui_P2; unfold max_N; case (maxN del h) as (?&?&?); left;
+ assumption.
rewrite SubEqui_P5; reflexivity.
apply lt_n_Sn.
repeat rewrite SubEqui_P6.
@@ -678,11 +676,11 @@ Proof.
| apply Rinv_0_lt_compat; apply Rmult_lt_0_compat;
[ prove_sup0 | apply Rlt_Rminus; assumption ] ].
assert (H2 : Rmin a b = a).
- unfold Rmin; case (Rle_dec a b); intro;
- [ reflexivity | elim n; left; assumption ].
+ apply Rlt_le in H.
+ unfold Rmin; decide (Rle_dec a b) with H; reflexivity.
assert (H3 : Rmax a b = b).
- unfold Rmax; case (Rle_dec a b); intro;
- [ reflexivity | elim n; left; assumption ].
+ apply Rlt_le in H.
+ unfold Rmax; decide (Rle_dec a b) with H; reflexivity.
elim (Heine_cor2 H0 (mkposreal _ H1)); intros del H4;
elim (SubEqui_P9 del f H); intros phi [H5 H6]; split with phi;
split with (mkStepFun (StepFun_P4 a b (eps / (2 * (b - a)))));
@@ -727,7 +725,7 @@ Proof.
elim (lt_n_O _ H9).
unfold co_interval in H10; elim H10; clear H10; intros; rewrite Rabs_right.
rewrite SubEqui_P5 in H9; simpl in H9; inversion H9.
- apply Rplus_lt_reg_r with (pos_Rl (SubEqui del H) (max_N del H)).
+ apply Rplus_lt_reg_l with (pos_Rl (SubEqui del H) (max_N del H)).
replace
(pos_Rl (SubEqui del H) (max_N del H) +
(t - pos_Rl (SubEqui del H) (max_N del H))) with t;
@@ -738,10 +736,10 @@ Proof.
rewrite H13 in H12; rewrite SubEqui_P2 in H12; apply H12.
rewrite SubEqui_P6.
2: apply lt_n_Sn.
- unfold max_N; case (maxN del H); intros; elim a0; clear a0;
- intros _ H13; replace (a + INR x * del + del) with (a + INR (S x) * del);
+ unfold max_N; destruct (maxN del H) as (?&?&H13);
+ replace (a + INR x * del + del) with (a + INR (S x) * del);
[ assumption | rewrite S_INR; ring ].
- apply Rplus_lt_reg_r with (pos_Rl (SubEqui del H) I);
+ apply Rplus_lt_reg_l with (pos_Rl (SubEqui del H) I);
replace (pos_Rl (SubEqui del H) I + (t - pos_Rl (SubEqui del H) I)) with t;
[ idtac | ring ];
replace (pos_Rl (SubEqui del H) I + del) with (pos_Rl (SubEqui del H) (S I)).
@@ -759,7 +757,7 @@ Proof.
intros; assumption.
assert (H4 : Nbound I).
unfold Nbound; exists (S (max_N del H)); intros; unfold max_N;
- case (maxN del H); intros; elim a0; clear a0; intros _ H5;
+ destruct (maxN del H) as (?&_&H5);
apply INR_le; apply Rmult_le_reg_l with (pos del).
apply (cond_pos del).
apply Rplus_le_reg_l with a; do 2 rewrite (Rmult_comm del);
@@ -767,12 +765,12 @@ Proof.
apply Rle_trans with b; try assumption; elim H8; intros;
assumption.
elim (Nzorn H1 H4); intros N [H5 H6]; assert (H7 : (N < S (max_N del H))%nat).
- unfold max_N; case (maxN del H); intros; apply INR_lt;
+ unfold max_N; case (maxN del H) as (?&?&?); apply INR_lt;
apply Rmult_lt_reg_l with (pos del).
apply (cond_pos del).
- apply Rplus_lt_reg_r with a; do 2 rewrite (Rmult_comm del);
+ apply Rplus_lt_reg_l with a; do 2 rewrite (Rmult_comm del);
apply Rle_lt_trans with t0; unfold I in H5; try assumption;
- elim a0; intros; apply Rlt_le_trans with b; try assumption;
+ apply Rlt_le_trans with b; try assumption;
elim H8; intros.
elim H11; intro.
assumption.
@@ -791,8 +789,8 @@ Proof.
elim H0; assumption.
rewrite SubEqui_P5; reflexivity.
rewrite SubEqui_P6.
- case (Rle_dec (a + INR (S N) * del) t0); intro.
- assert (H11 := H6 (S N) r); elim (le_Sn_n _ H11).
+ destruct (Rle_dec (a + INR (S N) * del) t0) as [Hle|Hnle].
+ assert (H11 := H6 (S N) Hle); elim (le_Sn_n _ H11).
auto with real.
apply le_lt_n_Sm; assumption.
Qed.
@@ -805,8 +803,8 @@ Proof.
intros; simpl; unfold fct_cte; replace t with a.
unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; right;
reflexivity.
- generalize H; unfold Rmin, Rmax; case (Rle_dec a a); intros; elim H0;
- intros; apply Rle_antisym; assumption.
+ generalize H; unfold Rmin, Rmax; decide (Rle_dec a a) with (Rle_refl a).
+ intros (?,?); apply Rle_antisym; assumption.
rewrite StepFun_P18; rewrite Rmult_0_l; rewrite Rabs_R0; apply (cond_pos eps).
Qed.
@@ -815,10 +813,9 @@ Lemma continuity_implies_RiemannInt :
a <= b ->
(forall x:R, a <= x <= b -> continuity_pt f x) -> Riemann_integrable f a b.
Proof.
- intros; case (total_order_T a b); intro;
- [ elim s; intro;
- [ apply RiemannInt_P6; assumption | rewrite b0; apply RiemannInt_P7 ]
- | elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)) ].
+ intros; destruct (total_order_T a b) as [[Hlt| -> ]|Hgt];
+ [ apply RiemannInt_P6; assumption | apply RiemannInt_P7
+ | elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H Hgt)) ].
Qed.
Lemma RiemannInt_P8 :
@@ -826,9 +823,9 @@ Lemma RiemannInt_P8 :
(pr2:Riemann_integrable f b a), RiemannInt pr1 = - RiemannInt pr2.
Proof.
intro f; intros; eapply UL_sequence.
- unfold RiemannInt; case (RiemannInt_exists pr1 RinvN RinvN_cv);
- intros; apply u.
- unfold RiemannInt; case (RiemannInt_exists pr2 RinvN RinvN_cv);
+ unfold RiemannInt; destruct (RiemannInt_exists pr1 RinvN RinvN_cv) as (?,HUn);
+ apply HUn.
+ unfold RiemannInt; destruct (RiemannInt_exists pr2 RinvN RinvN_cv) as (?,HUn);
intros;
cut
(exists psi1 : nat -> StepFun a b,
@@ -857,7 +854,7 @@ Proof.
[ assumption
| unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right;
left; apply (cond_pos (RinvN n)) ].
- clear H1; unfold Un_cv in u; elim (u _ H3); clear u; intros N1 H1;
+ clear H1; destruct (HUn _ H3) as (N1,H1);
exists (max N0 N1); intros; unfold R_dist;
apply Rle_lt_trans with
(Rabs
@@ -881,7 +878,7 @@ Proof.
-1 *
RiemannInt_SF (mkStepFun (StepFun_P6 (pre (phi_sequence RinvN pr2 n)))));
[ idtac | ring ]; rewrite <- StepFun_P30.
- case (Rle_dec a b); intro.
+ destruct (Rle_dec a b) as [Hle|Hnle].
apply Rle_lt_trans with
(RiemannInt_SF
(mkStepFun
@@ -903,11 +900,9 @@ Proof.
(phi_sequence RinvN pr1 n x0 - f x0 + (f x0 - phi_sequence RinvN pr2 n x0));
[ apply Rabs_triang | ring ].
assert (H7 : Rmin a b = a).
- unfold Rmin; case (Rle_dec a b); intro;
- [ reflexivity | elim n0; assumption ].
+ unfold Rmin; decide (Rle_dec a b) with Hle; reflexivity.
assert (H8 : Rmax a b = b).
- unfold Rmax; case (Rle_dec a b); intro;
- [ reflexivity | elim n0; assumption ].
+ unfold Rmax; decide (Rle_dec a b) with Hle; reflexivity.
apply Rplus_le_compat.
elim (H0 n); intros; rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H9;
rewrite H7; rewrite H8.
@@ -956,11 +951,9 @@ Proof.
(phi_sequence RinvN pr1 n x0 - f x0 + (f x0 - phi_sequence RinvN pr2 n x0));
[ apply Rabs_triang | ring ].
assert (H7 : Rmin a b = b).
- unfold Rmin; case (Rle_dec a b); intro;
- [ elim n0; assumption | reflexivity ].
+ unfold Rmin; decide (Rle_dec a b) with Hnle; reflexivity.
assert (H8 : Rmax a b = a).
- unfold Rmax; case (Rle_dec a b); intro;
- [ elim n0; assumption | reflexivity ].
+ unfold Rmax; decide (Rle_dec a b) with Hnle; reflexivity.
apply Rplus_le_compat.
elim (H0 n); intros; rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H9;
rewrite H7; rewrite H8.
@@ -1007,15 +1000,6 @@ Proof.
| discrR ].
Qed.
-Lemma Req_EM_T : forall r1 r2:R, {r1 = r2} + {r1 <> r2}.
-Proof.
- intros; elim (total_order_T r1 r2); intros;
- [ elim a; intro;
- [ right; red; intro; rewrite H in a0; elim (Rlt_irrefl r2 a0)
- | left; assumption ]
- | right; red; intro; rewrite H in b; elim (Rlt_irrefl r2 b) ].
-Qed.
-
(* L1([a,b]) is a vectorial space *)
Lemma RiemannInt_P10 :
forall (f g:R -> R) (a b l:R),
@@ -1023,10 +1007,9 @@ Lemma RiemannInt_P10 :
Riemann_integrable g a b ->
Riemann_integrable (fun x:R => f x + l * g x) a b.
Proof.
- unfold Riemann_integrable; intros f g; intros; case (Req_EM_T l 0);
- intro.
- elim (X eps); intros; split with x; elim p; intros; split with x0; elim p0;
- intros; split; try assumption; rewrite e; intros;
+ unfold Riemann_integrable; intros f g; intros; destruct (Req_EM_T l 0) as [Heq|Hneq].
+ elim (X eps); intros x p; split with x; elim p; intros x0 p0; split with x0; elim p0;
+ intros; split; try assumption; rewrite Heq; intros;
rewrite Rmult_0_l; rewrite Rplus_0_r; apply H; assumption.
assert (H : 0 < eps / 2).
unfold Rdiv; apply Rmult_lt_0_compat;
@@ -1036,9 +1019,9 @@ Proof.
[ apply (cond_pos eps)
| apply Rinv_0_lt_compat; apply Rmult_lt_0_compat;
[ prove_sup0 | apply Rabs_pos_lt; assumption ] ].
- elim (X (mkposreal _ H)); intros; elim (X0 (mkposreal _ H0)); intros;
+ elim (X (mkposreal _ H)); intros x p; elim (X0 (mkposreal _ H0)); intros x0 p0;
split with (mkStepFun (StepFun_P28 l x x0)); elim p0;
- elim p; intros; split with (mkStepFun (StepFun_P28 (Rabs l) x1 x2));
+ elim p; intros x1 p1 x2 p2. split with (mkStepFun (StepFun_P28 (Rabs l) x1 x2));
elim p1; elim p2; clear p1 p2 p0 p X X0; intros; split.
intros; simpl;
apply Rle_trans with (Rabs (f t - x t) + Rabs (l * (g t - x0 t))).
@@ -1113,18 +1096,14 @@ Proof.
rewrite (Rplus_comm (psi1 n x)); apply Rplus_le_compat.
rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; elim (H1 n); intros; apply H7.
assert (H10 : Rmin a b = a).
- unfold Rmin; case (Rle_dec a b); intro;
- [ reflexivity | elim n0; assumption ].
+ unfold Rmin; decide (Rle_dec a b) with Hyp; reflexivity.
assert (H11 : Rmax a b = b).
- unfold Rmax; case (Rle_dec a b); intro;
- [ reflexivity | elim n0; assumption ].
+ unfold Rmax; decide (Rle_dec a b) with Hyp; reflexivity.
rewrite H10; rewrite H11; elim H6; intros; split; left; assumption.
elim (H0 n); intros; apply H7; assert (H10 : Rmin a b = a).
- unfold Rmin; case (Rle_dec a b); intro;
- [ reflexivity | elim n0; assumption ].
+ unfold Rmin; decide (Rle_dec a b) with Hyp; reflexivity.
assert (H11 : Rmax a b = b).
- unfold Rmax; case (Rle_dec a b); intro;
- [ reflexivity | elim n0; assumption ].
+ unfold Rmax; decide (Rle_dec a b) with Hyp; reflexivity.
rewrite H10; rewrite H11; elim H6; intros; split; left; assumption.
rewrite StepFun_P30; rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat.
apply Rlt_trans with (pos (un n)).
@@ -1256,10 +1235,10 @@ Lemma RiemannInt_P12 :
Proof.
intro f; intros; case (Req_dec l 0); intro.
pattern l at 2; rewrite H0; rewrite Rmult_0_l; rewrite Rplus_0_r;
- unfold RiemannInt; case (RiemannInt_exists pr3 RinvN RinvN_cv);
- case (RiemannInt_exists pr1 RinvN RinvN_cv); intros;
+ unfold RiemannInt; destruct (RiemannInt_exists pr3 RinvN RinvN_cv) as (?,HUn_cv);
+ destruct (RiemannInt_exists pr1 RinvN RinvN_cv) as (?,HUn_cv0); intros.
eapply UL_sequence;
- [ apply u0
+ [ apply HUn_cv
| set (psi1 := fun n:nat => proj1_sig (phi_sequence_prop RinvN pr1 n));
set (psi2 := fun n:nat => proj1_sig (phi_sequence_prop RinvN pr3 n));
apply RiemannInt_P11 with f RinvN (phi_sequence RinvN pr1) psi1 psi2;
@@ -1278,22 +1257,22 @@ Proof.
[ apply H2; assumption | rewrite H0; ring ] ]
| assumption ] ].
eapply UL_sequence.
- unfold RiemannInt; case (RiemannInt_exists pr3 RinvN RinvN_cv);
- intros; apply u.
+ unfold RiemannInt; destruct (RiemannInt_exists pr3 RinvN RinvN_cv) as (?,HUn_cv);
+ intros; apply HUn_cv.
unfold Un_cv; intros; unfold RiemannInt;
- case (RiemannInt_exists pr1 RinvN RinvN_cv);
- case (RiemannInt_exists pr2 RinvN RinvN_cv); unfold Un_cv;
+ case (RiemannInt_exists pr1 RinvN RinvN_cv) as (x0,HUn_cv0);
+ case (RiemannInt_exists pr2 RinvN RinvN_cv) as (x,HUn_cv); unfold Un_cv;
intros; assert (H2 : 0 < eps / 5).
unfold Rdiv; apply Rmult_lt_0_compat;
[ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
- elim (u0 _ H2); clear u0; intros N0 H3; assert (H4 := RinvN_cv);
+ elim (HUn_cv0 _ H2); clear HUn_cv0; intros N0 H3; assert (H4 := RinvN_cv);
unfold Un_cv in H4; elim (H4 _ H2); clear H4 H2; intros N1 H4;
assert (H5 : 0 < eps / (5 * Rabs l)).
unfold Rdiv; apply Rmult_lt_0_compat;
[ assumption
| apply Rinv_0_lt_compat; apply Rmult_lt_0_compat;
[ prove_sup0 | apply Rabs_pos_lt; assumption ] ].
- elim (u _ H5); clear u; intros N2 H6; assert (H7 := RinvN_cv);
+ elim (HUn_cv _ H5); clear HUn_cv; intros N2 H6; assert (H7 := RinvN_cv);
unfold Un_cv in H7; elim (H7 _ H5); clear H7 H5; intros N3 H5;
unfold R_dist in H3, H4, H5, H6; set (N := max (max N0 N1) (max N2 N3)).
assert (H7 : forall n:nat, (n >= N1)%nat -> RinvN n < eps / 5).
@@ -1381,11 +1360,9 @@ Proof.
(RiemannInt_SF (phi_sequence RinvN pr1 n) +
l * RiemannInt_SF (phi_sequence RinvN pr2 n)));
[ idtac | ring ]; do 2 rewrite <- StepFun_P30; assert (H10 : Rmin a b = a).
- unfold Rmin; case (Rle_dec a b); intro;
- [ reflexivity | elim n0; assumption ].
+ unfold Rmin; decide (Rle_dec a b) with H; reflexivity.
assert (H11 : Rmax a b = b).
- unfold Rmax; case (Rle_dec a b); intro;
- [ reflexivity | elim n0; assumption ].
+ unfold Rmax; decide (Rle_dec a b) with H; reflexivity.
rewrite H10 in H7; rewrite H10 in H8; rewrite H10 in H9; rewrite H11 in H7;
rewrite H11 in H8; rewrite H11 in H9;
apply Rle_lt_trans with
@@ -1495,7 +1472,7 @@ Lemma RiemannInt_P13 :
(pr3:Riemann_integrable (fun x:R => f x + l * g x) a b),
RiemannInt pr3 = RiemannInt pr1 + l * RiemannInt pr2.
Proof.
- intros; case (Rle_dec a b); intro;
+ intros; destruct (Rle_dec a b) as [Hle|Hnle];
[ apply RiemannInt_P12; assumption
| assert (H : b <= a);
[ auto with real
@@ -1526,9 +1503,9 @@ Lemma RiemannInt_P15 :
forall (a b c:R) (pr:Riemann_integrable (fct_cte c) a b),
RiemannInt pr = c * (b - a).
Proof.
- intros; unfold RiemannInt; case (RiemannInt_exists pr RinvN RinvN_cv);
+ intros; unfold RiemannInt; destruct (RiemannInt_exists pr RinvN RinvN_cv) as (?,HUn_cv);
intros; eapply UL_sequence.
- apply u.
+ apply HUn_cv.
set (phi1 := fun N:nat => phi_sequence RinvN pr N);
change (Un_cv (fun N:nat => RiemannInt_SF (phi1 N)) (c * (b - a)));
set (f := fct_cte c);
@@ -1574,18 +1551,18 @@ Lemma Rle_cv_lim :
forall (Un Vn:nat -> R) (l1 l2:R),
(forall n:nat, Un n <= Vn n) -> Un_cv Un l1 -> Un_cv Vn l2 -> l1 <= l2.
Proof.
- intros; case (Rle_dec l1 l2); intro.
+ intros; destruct (Rle_dec l1 l2) as [Hle|Hnle].
assumption.
assert (H2 : l2 < l1).
auto with real.
- clear n; assert (H3 : 0 < (l1 - l2) / 2).
+ assert (H3 : 0 < (l1 - l2) / 2).
unfold Rdiv; apply Rmult_lt_0_compat;
[ apply Rlt_Rminus; assumption | apply Rinv_0_lt_compat; prove_sup0 ].
elim (H1 _ H3); elim (H0 _ H3); clear H0 H1; unfold R_dist; intros;
set (N := max x x0); cut (Vn N < Un N).
intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ (H N) H4)).
apply Rlt_trans with ((l1 + l2) / 2).
- apply Rplus_lt_reg_r with (- l2);
+ apply Rplus_lt_reg_l with (- l2);
replace (- l2 + (l1 + l2) / 2) with ((l1 - l2) / 2).
rewrite Rplus_comm; apply Rle_lt_trans with (Rabs (Vn N - l2)).
apply RRle_abs.
@@ -1596,7 +1573,7 @@ Proof.
repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym;
[ ring | discrR ]
| discrR ].
- apply Ropp_lt_cancel; apply Rplus_lt_reg_r with l1;
+ apply Ropp_lt_cancel; apply Rplus_lt_reg_l with l1;
replace (l1 + - ((l1 + l2) / 2)) with ((l1 - l2) / 2).
apply Rle_lt_trans with (Rabs (Un N - l1)).
rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply RRle_abs.
@@ -1615,9 +1592,9 @@ Lemma RiemannInt_P17 :
a <= b -> Rabs (RiemannInt pr1) <= RiemannInt pr2.
Proof.
intro f; intros; unfold RiemannInt;
- case (RiemannInt_exists pr1 RinvN RinvN_cv);
- case (RiemannInt_exists pr2 RinvN RinvN_cv); intros;
- set (phi1 := phi_sequence RinvN pr1) in u0;
+ case (RiemannInt_exists pr1 RinvN RinvN_cv) as (x0,HUn_cv0);
+ case (RiemannInt_exists pr2 RinvN RinvN_cv) as (x,HUn_cv);
+ set (phi1 := phi_sequence RinvN pr1) in HUn_cv0;
set (phi2 := fun N:nat => mkStepFun (StepFun_P32 (phi1 N)));
apply Rle_cv_lim with
(fun N:nat => Rabs (RiemannInt_SF (phi1 N)))
@@ -1672,10 +1649,10 @@ Lemma RiemannInt_P18 :
(forall x:R, a < x < b -> f x = g x) -> RiemannInt pr1 = RiemannInt pr2.
Proof.
intro f; intros; unfold RiemannInt;
- case (RiemannInt_exists pr1 RinvN RinvN_cv);
- case (RiemannInt_exists pr2 RinvN RinvN_cv); intros;
+ case (RiemannInt_exists pr1 RinvN RinvN_cv) as (x0,HUn_cv0);
+ case (RiemannInt_exists pr2 RinvN RinvN_cv) as (x,HUn_cv);
eapply UL_sequence.
- apply u0.
+ apply HUn_cv0.
set (phi1 := fun N:nat => phi_sequence RinvN pr1 N);
change (Un_cv (fun N:nat => RiemannInt_SF (phi1 N)) x);
assert
@@ -1718,48 +1695,48 @@ Proof.
apply RinvN_cv.
intro; elim (H2 n); intros; split; try assumption.
intros; unfold phi2_m; simpl; unfold phi2_aux;
- case (Req_EM_T t a); case (Req_EM_T t b); intros.
- rewrite e0; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0;
+ destruct (Req_EM_T t a) as [Heqa|Hneqa]; destruct (Req_EM_T t b) as [Heqb|Hneqb].
+ rewrite Heqa; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0;
apply Rle_trans with (Rabs (g t - phi2 n t)).
apply Rabs_pos.
- pattern a at 3; rewrite <- e0; apply H3; assumption.
- rewrite e; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0;
+ pattern a at 3; rewrite <- Heqa; apply H3; assumption.
+ rewrite Heqa; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0;
apply Rle_trans with (Rabs (g t - phi2 n t)).
apply Rabs_pos.
- pattern a at 3; rewrite <- e; apply H3; assumption.
- rewrite e; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0;
+ pattern a at 3; rewrite <- Heqa; apply H3; assumption.
+ rewrite Heqb; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0;
apply Rle_trans with (Rabs (g t - phi2 n t)).
apply Rabs_pos.
- pattern b at 3; rewrite <- e; apply H3; assumption.
+ pattern b at 3; rewrite <- Heqb; apply H3; assumption.
replace (f t) with (g t).
apply H3; assumption.
symmetry ; apply H0; elim H5; clear H5; intros.
assert (H7 : Rmin a b = a).
- unfold Rmin; case (Rle_dec a b); intro;
- [ reflexivity | elim n2; assumption ].
+ unfold Rmin; destruct (Rle_dec a b) as [Heqab|Hneqab];
+ [ reflexivity | elim Hneqab; assumption ].
assert (H8 : Rmax a b = b).
- unfold Rmax; case (Rle_dec a b); intro;
- [ reflexivity | elim n2; assumption ].
+ unfold Rmax; destruct (Rle_dec a b) as [Heqab|Hneqab];
+ [ reflexivity | elim Hneqab; assumption ].
rewrite H7 in H5; rewrite H8 in H6; split.
- elim H5; intro; [ assumption | elim n1; symmetry ; assumption ].
- elim H6; intro; [ assumption | elim n0; assumption ].
+ elim H5; intro; [ assumption | elim Hneqa; symmetry ; assumption ].
+ elim H6; intro; [ assumption | elim Hneqb; assumption ].
cut (forall N:nat, RiemannInt_SF (phi2_m N) = RiemannInt_SF (phi2 N)).
- intro; unfold Un_cv; intros; elim (u _ H4); intros; exists x1; intros;
+ intro; unfold Un_cv; intros; elim (HUn_cv _ H4); intros; exists x1; intros;
rewrite (H3 n); apply H5; assumption.
intro; apply Rle_antisym.
apply StepFun_P37; try assumption.
intros; unfold phi2_m; simpl; unfold phi2_aux;
- case (Req_EM_T x1 a); case (Req_EM_T x1 b); intros.
- elim H3; intros; rewrite e0 in H4; elim (Rlt_irrefl _ H4).
- elim H3; intros; rewrite e in H4; elim (Rlt_irrefl _ H4).
- elim H3; intros; rewrite e in H5; elim (Rlt_irrefl _ H5).
+ destruct (Req_EM_T x1 a) as [Heqa|Hneqa]; destruct (Req_EM_T x1 b) as [Heqb|Hneqb].
+ elim H3; intros; rewrite Heqa in H4; elim (Rlt_irrefl _ H4).
+ elim H3; intros; rewrite Heqa in H4; elim (Rlt_irrefl _ H4).
+ elim H3; intros; rewrite Heqb in H5; elim (Rlt_irrefl _ H5).
right; reflexivity.
apply StepFun_P37; try assumption.
intros; unfold phi2_m; simpl; unfold phi2_aux;
- case (Req_EM_T x1 a); case (Req_EM_T x1 b); intros.
- elim H3; intros; rewrite e0 in H4; elim (Rlt_irrefl _ H4).
- elim H3; intros; rewrite e in H4; elim (Rlt_irrefl _ H4).
- elim H3; intros; rewrite e in H5; elim (Rlt_irrefl _ H5).
+ destruct (Req_EM_T x1 a) as [ -> |Hneqa].
+ elim H3; intros; elim (Rlt_irrefl _ H4).
+ destruct (Req_EM_T x1 b) as [ -> |Hneqb].
+ elim H3; intros; elim (Rlt_irrefl _ H5).
right; reflexivity.
intro; assert (H2 := pre (phi2 N)); unfold IsStepFun in H2;
unfold is_subdivision in H2; elim H2; clear H2; intros l [lf H2];
@@ -1775,21 +1752,19 @@ Proof.
apply le_O_n.
apply lt_trans with (pred (Rlength l)); [ assumption | apply lt_pred_n_n ].
apply neq_O_lt; intro; rewrite <- H12 in H6; discriminate.
- unfold Rmin; case (Rle_dec a b); intro;
- [ reflexivity | elim n; assumption ].
+ unfold Rmin; decide (Rle_dec a b) with H; reflexivity.
assert (H11 : pos_Rl l (S i) <= b).
replace b with (Rmax a b).
rewrite <- H4; elim (RList_P6 l); intros; apply H11.
assumption.
apply lt_le_S; assumption.
apply lt_pred_n_n; apply neq_O_lt; intro; rewrite <- H13 in H6; discriminate.
- unfold Rmax; case (Rle_dec a b); intro;
- [ reflexivity | elim n; assumption ].
- elim H7; clear H7; intros; unfold phi2_aux; case (Req_EM_T x1 a);
- case (Req_EM_T x1 b); intros.
- rewrite e in H12; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H11 H12)).
- rewrite e in H7; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H10 H7)).
- rewrite e in H12; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H11 H12)).
+ unfold Rmax; decide (Rle_dec a b) with H; reflexivity.
+ elim H7; clear H7; intros; unfold phi2_aux; destruct (Req_EM_T x1 a) as [Heq|Hneq];
+ destruct (Req_EM_T x1 b) as [Heq'|Hneq'].
+ rewrite Heq' in H12; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H11 H12)).
+ rewrite Heq in H7; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H10 H7)).
+ rewrite Heq' in H12; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H11 H12)).
reflexivity.
Qed.
@@ -1852,17 +1827,17 @@ Proof.
intros; replace (primitive h pr a) with 0.
replace (RiemannInt pr0) with (primitive h pr b).
ring.
- unfold primitive; case (Rle_dec a b); case (Rle_dec b b); intros;
+ unfold primitive; destruct (Rle_dec a b) as [Hle|[]]; destruct (Rle_dec b b) as [Hle'|Hnle'];
[ apply RiemannInt_P5
- | elim n; right; reflexivity
- | elim n; assumption
- | elim n0; assumption ].
- symmetry ; unfold primitive; case (Rle_dec a a);
- case (Rle_dec a b); intros;
+ | destruct Hnle'; right; reflexivity
+ | assumption
+ | assumption].
+ symmetry ; unfold primitive; destruct (Rle_dec a a) as [Hle|[]];
+ destruct (Rle_dec a b) as [Hle'|Hnle'];
[ apply RiemannInt_P9
- | elim n; assumption
- | elim n; right; reflexivity
- | elim n0; right; reflexivity ].
+ | elim Hnle'; assumption
+ | right; reflexivity
+ | right; reflexivity ].
Qed.
Lemma RiemannInt_P21 :
@@ -1906,34 +1881,29 @@ Proof.
intro; cut (IsStepFun psi3 a c).
intro; split with (mkStepFun X); split with (mkStepFun X2); simpl;
split.
- intros; unfold phi3, psi3; case (Rle_dec t b); case (Rle_dec a t);
- intros.
+ intros; unfold phi3, psi3; case (Rle_dec t b) as [|Hnle]; case (Rle_dec a t) as [|Hnle'].
elim H1; intros; apply H3.
replace (Rmin a b) with a.
replace (Rmax a b) with b.
split; assumption.
- unfold Rmax; case (Rle_dec a b); intro;
- [ reflexivity | elim n; assumption ].
- unfold Rmin; case (Rle_dec a b); intro;
- [ reflexivity | elim n; assumption ].
- elim n; replace a with (Rmin a c).
+ unfold Rmax; decide (Rle_dec a b) with Hyp1; reflexivity.
+ unfold Rmin; decide (Rle_dec a b) with Hyp1; reflexivity.
+ elim Hnle'; replace a with (Rmin a c).
elim H0; intros; assumption.
- unfold Rmin; case (Rle_dec a c); intro;
- [ reflexivity | elim n0; apply Rle_trans with b; assumption ].
+ unfold Rmin; case (Rle_dec a c) as [|[]];
+ [ reflexivity | apply Rle_trans with b; assumption ].
elim H2; intros; apply H3.
replace (Rmax b c) with (Rmax a c).
elim H0; intros; split; try assumption.
replace (Rmin b c) with b.
auto with real.
- unfold Rmin; case (Rle_dec b c); intro;
- [ reflexivity | elim n0; assumption ].
- unfold Rmax; case (Rle_dec a c); case (Rle_dec b c); intros;
- try (elim n0; assumption || elim n0; apply Rle_trans with b; assumption).
- reflexivity.
- elim n; replace a with (Rmin a c).
+ unfold Rmin; decide (Rle_dec b c) with Hyp2; reflexivity.
+ unfold Rmax; decide (Rle_dec b c) with Hyp2; case (Rle_dec a c) as [|[]];
+ [ reflexivity | apply Rle_trans with b; assumption ].
+ elim Hnle'; replace a with (Rmin a c).
elim H0; intros; assumption.
- unfold Rmin; case (Rle_dec a c); intro;
- [ reflexivity | elim n1; apply Rle_trans with b; assumption ].
+ unfold Rmin; case (Rle_dec a c) as [|[]];
+ [ reflexivity | apply Rle_trans with b; assumption ].
rewrite <- (StepFun_P43 X0 X1 X2).
apply Rle_lt_trans with
(Rabs (RiemannInt_SF (mkStepFun X0)) + Rabs (RiemannInt_SF (mkStepFun X1))).
@@ -1947,33 +1917,33 @@ Proof.
apply Rle_antisym.
apply StepFun_P37; try assumption.
simpl; intros; unfold psi3; elim H0; clear H0; intros;
- case (Rle_dec a x); case (Rle_dec x b); intros;
- [ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H0))
+ destruct (Rle_dec a x) as [Hle|Hnle]; destruct (Rle_dec x b) as [Hle'|Hnle'];
+ [ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ Hle' H0))
| right; reflexivity
- | elim n; apply Rle_trans with b; [ assumption | left; assumption ]
- | elim n0; apply Rle_trans with b; [ assumption | left; assumption ] ].
+ | elim Hnle; apply Rle_trans with b; [ assumption | left; assumption ]
+ | elim Hnle; apply Rle_trans with b; [ assumption | left; assumption ] ].
apply StepFun_P37; try assumption.
simpl; intros; unfold psi3; elim H0; clear H0; intros;
- case (Rle_dec a x); case (Rle_dec x b); intros;
- [ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H0))
+ destruct (Rle_dec a x) as [Hle|Hnle]; destruct (Rle_dec x b) as [Hle'|Hnle'];
+ [ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ Hle' H0))
| right; reflexivity
- | elim n; apply Rle_trans with b; [ assumption | left; assumption ]
- | elim n0; apply Rle_trans with b; [ assumption | left; assumption ] ].
+ | elim Hnle; apply Rle_trans with b; [ assumption | left; assumption ]
+ | elim Hnle; apply Rle_trans with b; [ assumption | left; assumption ] ].
apply Rle_antisym.
apply StepFun_P37; try assumption.
simpl; intros; unfold psi3; elim H0; clear H0; intros;
- case (Rle_dec a x); case (Rle_dec x b); intros;
+ destruct (Rle_dec a x) as [Hle|Hnle]; destruct (Rle_dec x b) as [Hle'|Hnle'];
[ right; reflexivity
- | elim n; left; assumption
- | elim n; left; assumption
- | elim n0; left; assumption ].
+ | elim Hnle'; left; assumption
+ | elim Hnle; left; assumption
+ | elim Hnle; left; assumption ].
apply StepFun_P37; try assumption.
simpl; intros; unfold psi3; elim H0; clear H0; intros;
- case (Rle_dec a x); case (Rle_dec x b); intros;
+ destruct (Rle_dec a x) as [Hle|Hnle]; destruct (Rle_dec x b) as [Hle'|Hnle'];
[ right; reflexivity
- | elim n; left; assumption
- | elim n; left; assumption
- | elim n0; left; assumption ].
+ | elim Hnle'; left; assumption
+ | elim Hnle; left; assumption
+ | elim Hnle; left; assumption ].
apply StepFun_P46 with b; assumption.
assert (H3 := pre psi2); unfold IsStepFun in H3; unfold is_subdivision in H3;
elim H3; clear H3; intros l1 [lf1 H3]; split with l1;
@@ -1990,14 +1960,14 @@ Proof.
apply lt_trans with (pred (Rlength l1)); try assumption; apply lt_pred_n_n;
apply neq_O_lt; red; intro; rewrite <- H12 in H6;
discriminate.
- unfold Rmin; case (Rle_dec b c); intro;
- [ reflexivity | elim n; assumption ].
+ unfold Rmin; decide (Rle_dec b c) with Hyp2;
+ reflexivity.
elim H7; intros; assumption.
- case (Rle_dec a x); case (Rle_dec x b); intros;
- [ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H10))
+ destruct (Rle_dec a x) as [Hle|Hnle]; destruct (Rle_dec x b) as [Hle'|Hnle'];
+ [ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ Hle' H10))
| reflexivity
- | elim n; apply Rle_trans with b; [ assumption | left; assumption ]
- | elim n0; apply Rle_trans with b; [ assumption | left; assumption ] ].
+ | elim Hnle; apply Rle_trans with b; [ assumption | left; assumption ]
+ | elim Hnle; apply Rle_trans with b; [ assumption | left; assumption ] ].
assert (H3 := pre psi1); unfold IsStepFun in H3; unfold is_subdivision in H3;
elim H3; clear H3; intros l1 [lf1 H3]; split with l1;
split with lf1; unfold adapted_couple in H3; decompose [and] H3;
@@ -2012,8 +1982,7 @@ Proof.
rewrite <- H4; elim (RList_P6 l1); intros; apply H10; try assumption.
apply lt_pred_n_n; apply neq_O_lt; red; intro; rewrite <- H12 in H6;
discriminate.
- unfold Rmax; case (Rle_dec a b); intro;
- [ reflexivity | elim n; assumption ].
+ unfold Rmax; decide (Rle_dec a b) with Hyp1; reflexivity.
assert (H11 : a <= x).
apply Rle_trans with (pos_Rl l1 i).
replace a with (Rmin a b).
@@ -2022,11 +1991,9 @@ Proof.
apply lt_trans with (pred (Rlength l1)); try assumption; apply lt_pred_n_n;
apply neq_O_lt; red; intro; rewrite <- H13 in H6;
discriminate.
- unfold Rmin; case (Rle_dec a b); intro;
- [ reflexivity | elim n; assumption ].
+ unfold Rmin; decide (Rle_dec a b) with Hyp1; reflexivity.
left; elim H7; intros; assumption.
- case (Rle_dec a x); case (Rle_dec x b); intros; reflexivity || elim n;
- assumption.
+ decide (Rle_dec a x) with H11; decide (Rle_dec x b) with H10; reflexivity.
apply StepFun_P46 with b.
assert (H3 := pre phi1); unfold IsStepFun in H3; unfold is_subdivision in H3;
elim H3; clear H3; intros l1 [lf1 H3]; split with l1;
@@ -2042,8 +2009,7 @@ Proof.
rewrite <- H4; elim (RList_P6 l1); intros; apply H10; try assumption.
apply lt_pred_n_n; apply neq_O_lt; red; intro; rewrite <- H12 in H6;
discriminate.
- unfold Rmax; case (Rle_dec a b); intro;
- [ reflexivity | elim n; assumption ].
+ unfold Rmax; decide (Rle_dec a b) with Hyp1; reflexivity.
assert (H11 : a <= x).
apply Rle_trans with (pos_Rl l1 i).
replace a with (Rmin a b).
@@ -2052,10 +2018,9 @@ Proof.
apply lt_trans with (pred (Rlength l1)); try assumption; apply lt_pred_n_n;
apply neq_O_lt; red; intro; rewrite <- H13 in H6;
discriminate.
- unfold Rmin; case (Rle_dec a b); intro;
- [ reflexivity | elim n; assumption ].
+ unfold Rmin; decide (Rle_dec a b) with Hyp1; reflexivity.
left; elim H7; intros; assumption.
- unfold phi3; case (Rle_dec a x); case (Rle_dec x b); intros;
+ unfold phi3; decide (Rle_dec a x) with H11; decide (Rle_dec x b) with H10;
reflexivity || elim n; assumption.
assert (H3 := pre phi2); unfold IsStepFun in H3; unfold is_subdivision in H3;
elim H3; clear H3; intros l1 [lf1 H3]; split with l1;
@@ -2072,14 +2037,13 @@ Proof.
apply lt_trans with (pred (Rlength l1)); try assumption; apply lt_pred_n_n;
apply neq_O_lt; red; intro; rewrite <- H12 in H6;
discriminate.
- unfold Rmin; case (Rle_dec b c); intro;
- [ reflexivity | elim n; assumption ].
+ unfold Rmin; decide (Rle_dec b c) with Hyp2; reflexivity.
elim H7; intros; assumption.
- unfold phi3; case (Rle_dec a x); case (Rle_dec x b); intros;
- [ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H10))
+ unfold phi3; destruct (Rle_dec a x) as [Hle|Hnle]; destruct (Rle_dec x b) as [Hle'|Hnle']; intros;
+ [ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ Hle' H10))
| reflexivity
- | elim n; apply Rle_trans with b; [ assumption | left; assumption ]
- | elim n0; apply Rle_trans with b; [ assumption | left; assumption ] ].
+ | elim Hnle; apply Rle_trans with b; [ assumption | left; assumption ]
+ | elim Hnle; apply Rle_trans with b; [ assumption | left; assumption ] ].
Qed.
Lemma RiemannInt_P22 :
@@ -2098,21 +2062,10 @@ Proof.
split; assumption.
split with (mkStepFun H3); split with (mkStepFun H4); split.
simpl; intros; apply H.
- replace (Rmin a b) with (Rmin a c).
- elim H5; intros; split; try assumption.
+ replace (Rmin a b) with (Rmin a c) by (rewrite 2!Rmin_left; eauto using Rle_trans).
+ destruct H5; split; try assumption.
apply Rle_trans with (Rmax a c); try assumption.
- replace (Rmax a b) with b.
- replace (Rmax a c) with c.
- assumption.
- unfold Rmax; case (Rle_dec a c); intro;
- [ reflexivity | elim n; assumption ].
- unfold Rmax; case (Rle_dec a b); intro;
- [ reflexivity | elim n; apply Rle_trans with c; assumption ].
- unfold Rmin; case (Rle_dec a c); case (Rle_dec a b); intros;
- [ reflexivity
- | elim n; apply Rle_trans with c; assumption
- | elim n; assumption
- | elim n0; assumption ].
+ apply Rle_max_compat_l; assumption.
rewrite Rabs_right.
assert (H5 : IsStepFun psi c b).
apply StepFun_P46 with a.
@@ -2130,15 +2083,11 @@ Proof.
apply Rle_trans with (Rabs (f x - phi x)).
apply Rabs_pos.
apply H.
- replace (Rmin a b) with a.
- replace (Rmax a b) with b.
- elim H6; intros; split; left.
+ rewrite Rmin_left; eauto using Rle_trans.
+ rewrite Rmax_right; eauto using Rle_trans.
+ destruct H6; split; left.
apply Rle_lt_trans with c; assumption.
assumption.
- unfold Rmax; case (Rle_dec a b); intro;
- [ reflexivity | elim n; apply Rle_trans with c; assumption ].
- unfold Rmin; case (Rle_dec a b); intro;
- [ reflexivity | elim n; apply Rle_trans with c; assumption ].
rewrite StepFun_P18; ring.
apply Rle_lt_trans with (Rabs (RiemannInt_SF psi)).
apply RRle_abs.
@@ -2160,15 +2109,11 @@ Proof.
apply Rle_trans with (Rabs (f x - phi x)).
apply Rabs_pos.
apply H.
- replace (Rmin a b) with a.
- replace (Rmax a b) with b.
- elim H5; intros; split; left.
+ rewrite Rmin_left; eauto using Rle_trans.
+ rewrite Rmax_right; eauto using Rle_trans.
+ destruct H5; split; left.
assumption.
apply Rlt_le_trans with c; assumption.
- unfold Rmax; case (Rle_dec a b); intro;
- [ reflexivity | elim n; apply Rle_trans with c; assumption ].
- unfold Rmin; case (Rle_dec a b); intro;
- [ reflexivity | elim n; apply Rle_trans with c; assumption ].
rewrite StepFun_P18; ring.
Qed.
@@ -2191,18 +2136,10 @@ Proof.
replace (Rmax a b) with (Rmax c b).
elim H5; intros; split; try assumption.
apply Rle_trans with (Rmin c b); try assumption.
- replace (Rmin a b) with a.
- replace (Rmin c b) with c.
- assumption.
- unfold Rmin; case (Rle_dec c b); intro;
- [ reflexivity | elim n; assumption ].
- unfold Rmin; case (Rle_dec a b); intro;
- [ reflexivity | elim n; apply Rle_trans with c; assumption ].
- unfold Rmax; case (Rle_dec c b); case (Rle_dec a b); intros;
- [ reflexivity
- | elim n; apply Rle_trans with c; assumption
- | elim n; assumption
- | elim n0; assumption ].
+ rewrite Rmin_left; eauto using Rle_trans.
+ rewrite Rmin_left; eauto using Rle_trans.
+ rewrite Rmax_right; eauto using Rle_trans.
+ rewrite Rmax_right; eauto using Rle_trans.
rewrite Rabs_right.
assert (H5 : IsStepFun psi a c).
apply StepFun_P46 with b.
@@ -2220,15 +2157,11 @@ Proof.
apply Rle_trans with (Rabs (f x - phi x)).
apply Rabs_pos.
apply H.
- replace (Rmin a b) with a.
- replace (Rmax a b) with b.
- elim H6; intros; split; left.
+ rewrite Rmin_left; eauto using Rle_trans.
+ rewrite Rmax_right; eauto using Rle_trans.
+ destruct H6; split; left.
assumption.
apply Rlt_le_trans with c; assumption.
- unfold Rmax; case (Rle_dec a b); intro;
- [ reflexivity | elim n; apply Rle_trans with c; assumption ].
- unfold Rmin; case (Rle_dec a b); intro;
- [ reflexivity | elim n; apply Rle_trans with c; assumption ].
rewrite StepFun_P18; ring.
apply Rle_lt_trans with (Rabs (RiemannInt_SF psi)).
apply RRle_abs.
@@ -2250,15 +2183,11 @@ Proof.
apply Rle_trans with (Rabs (f x - phi x)).
apply Rabs_pos.
apply H.
- replace (Rmin a b) with a.
- replace (Rmax a b) with b.
- elim H5; intros; split; left.
+ rewrite Rmin_left; eauto using Rle_trans.
+ rewrite Rmax_right; eauto using Rle_trans.
+ destruct H5; split; left.
apply Rle_lt_trans with c; assumption.
assumption.
- unfold Rmax; case (Rle_dec a b); intro;
- [ reflexivity | elim n; apply Rle_trans with c; assumption ].
- unfold Rmin; case (Rle_dec a b); intro;
- [ reflexivity | elim n; apply Rle_trans with c; assumption ].
rewrite StepFun_P18; ring.
Qed.
@@ -2291,16 +2220,15 @@ Lemma RiemannInt_P25 :
a <= b -> b <= c -> RiemannInt pr1 + RiemannInt pr2 = RiemannInt pr3.
Proof.
intros f a b c pr1 pr2 pr3 Hyp1 Hyp2; unfold RiemannInt;
- case (RiemannInt_exists pr1 RinvN RinvN_cv);
- case (RiemannInt_exists pr2 RinvN RinvN_cv);
- case (RiemannInt_exists pr3 RinvN RinvN_cv); intros;
+ case (RiemannInt_exists pr1 RinvN RinvN_cv) as (x1,HUn_cv1);
+ case (RiemannInt_exists pr2 RinvN RinvN_cv) as (x0,HUn_cv0);
+ case (RiemannInt_exists pr3 RinvN RinvN_cv) as (x,HUn_cv);
symmetry ; eapply UL_sequence.
- apply u.
+ apply HUn_cv.
unfold Un_cv; intros; assert (H0 : 0 < eps / 3).
unfold Rdiv; apply Rmult_lt_0_compat;
[ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
- elim (u1 _ H0); clear u1; intros N1 H1; elim (u0 _ H0); clear u0;
- intros N2 H2;
+ destruct (HUn_cv1 _ H0) as (N1,H1); clear HUn_cv1; destruct (HUn_cv0 _ H0) as (N2,H2); clear HUn_cv0;
cut
(Un_cv
(fun n:nat =>
@@ -2357,7 +2285,7 @@ Proof.
do 2 rewrite (Rmult_comm 3); repeat rewrite Rmult_assoc;
rewrite <- Rinv_l_sym; [ ring | discrR ]
| discrR ].
- clear x u x0 x1 eps H H0 N1 H1 N2 H2;
+ clear x HUn_cv x0 x1 eps H H0 N1 H1 N2 H2;
assert
(H1 :
exists psi1 : nat -> StepFun a b,
@@ -2477,25 +2405,17 @@ Proof.
apply Rplus_le_compat.
apply H1.
elim H14; intros; split.
- replace (Rmin a c) with a.
+ rewrite Rmin_left; eauto using Rle_trans.
apply Rle_trans with b; try assumption.
left; assumption.
- unfold Rmin; case (Rle_dec a c); intro;
- [ reflexivity | elim n0; apply Rle_trans with b; assumption ].
- replace (Rmax a c) with c.
+ rewrite Rmax_right; eauto using Rle_trans.
left; assumption.
- unfold Rmax; case (Rle_dec a c); intro;
- [ reflexivity | elim n0; apply Rle_trans with b; assumption ].
apply H3.
elim H14; intros; split.
- replace (Rmin b c) with b.
+ rewrite Rmin_left; eauto using Rle_trans.
left; assumption.
- unfold Rmin; case (Rle_dec b c); intro;
- [ reflexivity | elim n0; assumption ].
- replace (Rmax b c) with c.
+ rewrite Rmax_right; eauto using Rle_trans.
left; assumption.
- unfold Rmax; case (Rle_dec b c); intro;
- [ reflexivity | elim n0; assumption ].
do 2
rewrite <-
(Rplus_comm
@@ -2509,26 +2429,18 @@ Proof.
apply Rplus_le_compat.
apply H1.
elim H14; intros; split.
- replace (Rmin a c) with a.
+ rewrite Rmin_left; eauto using Rle_trans.
left; assumption.
- unfold Rmin; case (Rle_dec a c); intro;
- [ reflexivity | elim n0; apply Rle_trans with b; assumption ].
- replace (Rmax a c) with c.
+ rewrite Rmax_right; eauto using Rle_trans.
apply Rle_trans with b.
left; assumption.
assumption.
- unfold Rmax; case (Rle_dec a c); intro;
- [ reflexivity | elim n0; apply Rle_trans with b; assumption ].
apply H8.
elim H14; intros; split.
- replace (Rmin a b) with a.
+ rewrite Rmin_left; trivial.
left; assumption.
- unfold Rmin; case (Rle_dec a b); intro;
- [ reflexivity | elim n0; assumption ].
- replace (Rmax a b) with b.
+ rewrite Rmax_right; trivial.
left; assumption.
- unfold Rmax; case (Rle_dec a b); intro;
- [ reflexivity | elim n0; assumption ].
do 2 rewrite StepFun_P30.
do 2 rewrite Rmult_1_l;
replace
@@ -2571,27 +2483,27 @@ Lemma RiemannInt_P26 :
(pr2:Riemann_integrable f b c) (pr3:Riemann_integrable f a c),
RiemannInt pr1 + RiemannInt pr2 = RiemannInt pr3.
Proof.
- intros; case (Rle_dec a b); case (Rle_dec b c); intros.
+ intros; destruct (Rle_dec a b) as [Hle|Hnle]; destruct (Rle_dec b c) as [Hle'|Hnle'].
apply RiemannInt_P25; assumption.
- case (Rle_dec a c); intro.
+ destruct (Rle_dec a c) as [Hle''|Hnle''].
assert (H : c <= b).
auto with real.
- rewrite <- (RiemannInt_P25 pr3 (RiemannInt_P1 pr2) pr1 r0 H);
+ rewrite <- (RiemannInt_P25 pr3 (RiemannInt_P1 pr2) pr1 Hle'' H);
rewrite (RiemannInt_P8 pr2 (RiemannInt_P1 pr2)); ring.
assert (H : c <= a).
auto with real.
rewrite (RiemannInt_P8 pr2 (RiemannInt_P1 pr2));
- rewrite <- (RiemannInt_P25 (RiemannInt_P1 pr3) pr1 (RiemannInt_P1 pr2) H r);
+ rewrite <- (RiemannInt_P25 (RiemannInt_P1 pr3) pr1 (RiemannInt_P1 pr2) H Hle);
rewrite (RiemannInt_P8 pr3 (RiemannInt_P1 pr3)); ring.
assert (H : b <= a).
auto with real.
- case (Rle_dec a c); intro.
- rewrite <- (RiemannInt_P25 (RiemannInt_P1 pr1) pr3 pr2 H r0);
+ destruct (Rle_dec a c) as [Hle''|Hnle''].
+ rewrite <- (RiemannInt_P25 (RiemannInt_P1 pr1) pr3 pr2 H Hle'');
rewrite (RiemannInt_P8 pr1 (RiemannInt_P1 pr1)); ring.
assert (H0 : c <= a).
auto with real.
rewrite (RiemannInt_P8 pr1 (RiemannInt_P1 pr1));
- rewrite <- (RiemannInt_P25 pr2 (RiemannInt_P1 pr3) (RiemannInt_P1 pr1) r H0);
+ rewrite <- (RiemannInt_P25 pr2 (RiemannInt_P1 pr3) (RiemannInt_P1 pr1) Hle' H0);
rewrite (RiemannInt_P8 pr3 (RiemannInt_P1 pr3)); ring.
rewrite (RiemannInt_P8 pr1 (RiemannInt_P1 pr1));
rewrite (RiemannInt_P8 pr2 (RiemannInt_P1 pr2));
@@ -2616,13 +2528,13 @@ Proof.
assert (H4 : 0 < del).
unfold del; unfold Rmin; case (Rle_dec (b - x) (x - a));
intro.
- case (Rle_dec x0 (b - x)); intro;
+ destruct (Rle_dec x0 (b - x)) as [Hle|Hnle];
[ elim H3; intros; assumption | apply Rlt_Rminus; assumption ].
- case (Rle_dec x0 (x - a)); intro;
+ destruct (Rle_dec x0 (x - a)) as [Hle'|Hnle'];
[ elim H3; intros; assumption | apply Rlt_Rminus; assumption ].
split with (mkposreal _ H4); intros;
assert (H7 : Riemann_integrable f x (x + h0)).
- case (Rle_dec x (x + h0)); intro.
+ destruct (Rle_dec x (x + h0)) as [Hle''|Hnle''].
apply continuity_implies_RiemannInt; try assumption.
intros; apply C0; elim H7; intros; split.
apply Rle_trans with x; [ left; assumption | assumption ].
@@ -2659,7 +2571,7 @@ Proof.
with ((RiemannInt H7 - RiemannInt (RiemannInt_P14 x (x + h0) (f x))) / h0).
replace (RiemannInt H7 - RiemannInt (RiemannInt_P14 x (x + h0) (f x))) with
(RiemannInt (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x)))).
- unfold Rdiv; rewrite Rabs_mult; case (Rle_dec x (x + h0)); intro.
+ unfold Rdiv; rewrite Rabs_mult; destruct (Rle_dec x (x + h0)) as [Hle|Hnle].
apply Rle_lt_trans with
(RiemannInt
(RiemannInt_P16
@@ -2678,14 +2590,14 @@ Proof.
apply Rabs_pos.
apply RiemannInt_P19; try assumption.
intros; replace (f x1 + -1 * fct_cte (f x) x1) with (f x1 - f x).
- unfold fct_cte; case (Req_dec x x1); intro.
+ unfold fct_cte; destruct (Req_dec x x1) as [H9|H9].
rewrite H9; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; left;
assumption.
- elim H3; intros; left; apply H11.
+ elim H3; intros; left; apply H11.
repeat split.
assumption.
rewrite Rabs_right.
- apply Rplus_lt_reg_r with x; replace (x + (x1 - x)) with x1; [ idtac | ring ].
+ apply Rplus_lt_reg_l with x; replace (x + (x1 - x)) with x1; [ idtac | ring ].
apply Rlt_le_trans with (x + h0).
elim H8; intros; assumption.
apply Rplus_le_compat_l; apply Rle_trans with del.
@@ -2707,8 +2619,8 @@ Proof.
apply Rinv_r_sym.
assumption.
apply Rle_ge; left; apply Rinv_0_lt_compat.
- elim r; intro.
- apply Rplus_lt_reg_r with x; rewrite Rplus_0_r; assumption.
+ elim Hle; intro.
+ apply Rplus_lt_reg_l with x; rewrite Rplus_0_r; assumption.
elim H5; symmetry ; apply Rplus_eq_reg_l with x; rewrite Rplus_0_r;
assumption.
apply Rle_lt_trans with
@@ -2748,7 +2660,7 @@ Proof.
repeat split.
assumption.
rewrite Rabs_left.
- apply Rplus_lt_reg_r with (x1 - x0); replace (x1 - x0 + x0) with x1;
+ apply Rplus_lt_reg_l with (x1 - x0); replace (x1 - x0 + x0) with x1;
[ idtac | ring ].
replace (x1 - x0 + - (x1 - x)) with (x - x0); [ idtac | ring ].
apply Rle_lt_trans with (x + h0).
@@ -2758,7 +2670,7 @@ Proof.
apply Rle_trans with del;
[ left; assumption | unfold del; apply Rmin_l ].
elim H8; intros; assumption.
- apply Rplus_lt_reg_r with x; rewrite Rplus_0_r;
+ apply Rplus_lt_reg_l with x; rewrite Rplus_0_r;
replace (x + (x1 - x)) with x1; [ elim H8; intros; assumption | ring ].
unfold fct_cte; ring.
rewrite RiemannInt_P15.
@@ -2778,7 +2690,7 @@ Proof.
apply Rinv_lt_0_compat.
assert (H8 : x + h0 < x).
auto with real.
- apply Rplus_lt_reg_r with x; rewrite Rplus_0_r; assumption.
+ apply Rplus_lt_reg_l with x; rewrite Rplus_0_r; assumption.
rewrite
(RiemannInt_P13 H7 (RiemannInt_P14 x (x + h0) (f x))
(RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x))))
@@ -2792,9 +2704,11 @@ Proof.
cut (a <= x + h0).
cut (x + h0 <= b).
intros; unfold primitive.
- case (Rle_dec a (x + h0)); case (Rle_dec (x + h0) b); case (Rle_dec a x);
- case (Rle_dec x b); intros; try (elim n; assumption || left; assumption).
- rewrite <- (RiemannInt_P26 (FTC_P1 h C0 r0 r) H7 (FTC_P1 h C0 r2 r1)); ring.
+ assert (H10: a <= x) by (left; assumption).
+ assert (H11: x <= b) by (left; assumption).
+ decide (Rle_dec a (x + h0)) with H9; decide (Rle_dec (x + h0) b) with H8;
+ decide (Rle_dec a x) with H10; decide (Rle_dec x b) with H11.
+ rewrite <- (RiemannInt_P26 (FTC_P1 h C0 H10 H11) H7 (FTC_P1 h C0 H9 H8)); ring.
apply Rplus_le_reg_l with (- x); replace (- x + (x + h0)) with h0;
[ idtac | ring ].
rewrite Rplus_comm; apply Rle_trans with (Rabs h0).
@@ -2854,11 +2768,11 @@ Proof.
unfold R_dist; intros; set (del := Rmin x0 (Rmin x1 (b - a)));
assert (H10 : 0 < del).
unfold del; unfold Rmin; case (Rle_dec x1 (b - a)); intros.
- case (Rle_dec x0 x1); intro;
+ destruct (Rle_dec x0 x1) as [Hle|Hnle];
[ apply (cond_pos x0) | elim H9; intros; assumption ].
- case (Rle_dec x0 (b - a)); intro;
+ destruct (Rle_dec x0 (b - a)) as [Hle'|Hnle'];
[ apply (cond_pos x0) | apply Rlt_Rminus; assumption ].
- split with (mkposreal _ H10); intros; case (Rcase_abs h0); intro.
+ split with (mkposreal _ H10); intros; destruct (Rcase_abs h0) as [Hle|Hnle].
assert (H14 : b + h0 < b).
pattern b at 2; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l;
assumption.
@@ -2914,7 +2828,7 @@ Proof.
repeat split.
assumption.
rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; rewrite Rabs_right.
- apply Rplus_lt_reg_r with (x2 - x1);
+ apply Rplus_lt_reg_l with (x2 - x1);
replace (x2 - x1 + (b - x2)) with (b - x1); [ idtac | ring ].
replace (x2 - x1 + x1) with x2; [ idtac | ring ].
apply Rlt_le_trans with (b + h0).
@@ -2957,11 +2871,11 @@ Proof.
| assumption ].
cut (a <= b + h0).
cut (b + h0 <= b).
- intros; unfold primitive; case (Rle_dec a (b + h0));
- case (Rle_dec (b + h0) b); case (Rle_dec a b); case (Rle_dec b b);
- intros; try (elim n; right; reflexivity) || (elim n; left; assumption).
- rewrite <- (RiemannInt_P26 (FTC_P1 h C0 r3 r2) H13 (FTC_P1 h C0 r1 r0)); ring.
- elim n; assumption.
+ intros; unfold primitive; destruct (Rle_dec a (b + h0)) as [Hle'|Hnle'];
+ destruct (Rle_dec (b + h0) b) as [Hle''|[]]; destruct (Rle_dec a b) as [Hleab|[]]; destruct (Rle_dec b b) as [Hlebb|[]];
+ assumption || (right; reflexivity) || (try (left; assumption)).
+ rewrite <- (RiemannInt_P26 (FTC_P1 h C0 Hle' Hle'') H13 (FTC_P1 h C0 Hleab Hlebb)); ring.
+ elim Hnle'; assumption.
left; assumption.
apply Rplus_le_reg_l with (- a - h0).
replace (- a - h0 + a) with (- h0); [ idtac | ring ].
@@ -2979,22 +2893,22 @@ Proof.
[ assumption | unfold del; apply Rmin_l ].
assert (H14 : b < b + h0).
pattern b at 1; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l.
- assert (H14 := Rge_le _ _ r); elim H14; intro.
+ assert (H14 := Rge_le _ _ Hnle); elim H14; intro.
assumption.
elim H11; symmetry ; assumption.
- unfold primitive; case (Rle_dec a (b + h0));
- case (Rle_dec (b + h0) b); intros;
- [ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r0 H14))
+ unfold primitive; destruct (Rle_dec a (b + h0)) as [Hle|[]];
+ destruct (Rle_dec (b + h0) b) as [Hle'|Hnle'];
+ [ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ Hle' H14))
| unfold f_b; reflexivity
- | elim n; left; apply Rlt_trans with b; assumption
- | elim n0; left; apply Rlt_trans with b; assumption ].
+ | left; apply Rlt_trans with b; assumption
+ | left; apply Rlt_trans with b; assumption ].
unfold f_b; unfold Rminus; rewrite Rplus_opp_r;
rewrite Rmult_0_r; rewrite Rplus_0_l; unfold primitive;
- case (Rle_dec a b); case (Rle_dec b b); intros;
+ destruct (Rle_dec a b) as [Hle'|Hnle']; destruct (Rle_dec b b) as [Hle''|[]];
[ apply RiemannInt_P5
- | elim n; right; reflexivity
- | elim n; left; assumption
- | elim n; right; reflexivity ].
+ | right; reflexivity
+ | elim Hnle'; left; assumption
+ | right; reflexivity ].
(*****)
set (f_a := fun x:R => f a * (x - a)); rewrite <- H2;
assert (H3 : derivable_pt_lim f_a a (f a)).
@@ -3028,16 +2942,18 @@ Proof.
apply (cond_pos x0).
apply Rlt_Rminus; assumption.
split with (mkposreal _ H9).
- intros; case (Rcase_abs h0); intro.
+ intros; destruct (Rcase_abs h0) as [Hle|Hnle].
assert (H12 : a + h0 < a).
pattern a at 2; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l;
assumption.
unfold primitive.
- case (Rle_dec a (a + h0)); case (Rle_dec (a + h0) b); case (Rle_dec a a);
- case (Rle_dec a b); intros;
- try (elim n; left; assumption) || (elim n; right; reflexivity).
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r3 H12)).
- elim n; left; apply Rlt_trans with a; assumption.
+ destruct (Rle_dec a (a + h0)) as [Hle'|Hnle'];
+ destruct (Rle_dec (a + h0) b) as [Hle''|Hnle''];
+ destruct (Rle_dec a a) as [Hleaa|[]];
+ destruct (Rle_dec a b) as [Hleab|[]];
+ try (left; assumption) || (right; reflexivity).
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ Hle' H12)).
+ elim Hnle''; left; apply Rlt_trans with a; assumption.
rewrite RiemannInt_P9; replace 0 with (f_a a).
replace (f a * (a + h0 - a)) with (f_a (a + h0)).
apply H5; try assumption.
@@ -3045,10 +2961,10 @@ Proof.
[ assumption | unfold del; apply Rmin_l ].
unfold f_a; ring.
unfold f_a; ring.
- elim n; left; apply Rlt_trans with a; assumption.
+ elim Hnle''; left; apply Rlt_trans with a; assumption.
assert (H12 : a < a + h0).
pattern a at 1; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l.
- assert (H12 := Rge_le _ _ r); elim H12; intro.
+ assert (H12 := Rge_le _ _ Hnle); elim H12; intro.
assumption.
elim H10; symmetry ; assumption.
assert (H13 : Riemann_integrable f a (a + h0)).
@@ -3097,7 +3013,7 @@ Proof.
elim H8; intros; left; apply H17; repeat split.
assumption.
rewrite Rabs_right.
- apply Rplus_lt_reg_r with a; replace (a + (x2 - a)) with x2; [ idtac | ring ].
+ apply Rplus_lt_reg_l with a; replace (a + (x2 - a)) with x2; [ idtac | ring ].
apply Rlt_le_trans with (a + h0).
elim H14; intros; assumption.
apply Rplus_le_compat_l; left; apply Rle_lt_trans with (Rabs h0).
@@ -3121,7 +3037,7 @@ Proof.
rewrite Rplus_comm; unfold Rminus; rewrite Rplus_assoc;
rewrite Rplus_opp_r; rewrite Rplus_0_r; rewrite <- Rinv_r_sym;
[ reflexivity | assumption ].
- apply Rle_ge; left; apply Rinv_0_lt_compat; assert (H14 := Rge_le _ _ r);
+ apply Rle_ge; left; apply Rinv_0_lt_compat; assert (H14 := Rge_le _ _ Hnle);
elim H14; intro.
assumption.
elim H10; symmetry ; assumption.
@@ -3136,13 +3052,13 @@ Proof.
rewrite Rmult_assoc; rewrite <- Rinv_r_sym; [ ring | assumption ].
cut (a <= a + h0).
cut (a + h0 <= b).
- intros; unfold primitive; case (Rle_dec a (a + h0));
- case (Rle_dec (a + h0) b); case (Rle_dec a a); case (Rle_dec a b);
- intros; try (elim n; right; reflexivity) || (elim n; left; assumption).
+ intros; unfold primitive.
+ decide (Rle_dec (a+h0) b) with H14.
+ decide (Rle_dec a a) with (Rle_refl a).
+ decide (Rle_dec a (a+h0)) with H15.
+ decide (Rle_dec a b) with h.
rewrite RiemannInt_P9; unfold Rminus; rewrite Ropp_0;
rewrite Rplus_0_r; apply RiemannInt_P5.
- elim n; assumption.
- elim n; assumption.
2: left; assumption.
apply Rplus_le_reg_l with (- a); replace (- a + (a + h0)) with h0;
[ idtac | ring ].
@@ -3189,18 +3105,18 @@ Proof.
unfold derivable_pt_lim; intros; elim (H2 _ H4); intros;
elim (H3 _ H4); intros; set (del := Rmin x0 x1).
assert (H7 : 0 < del).
- unfold del; unfold Rmin; case (Rle_dec x0 x1); intro.
+ unfold del; unfold Rmin; destruct (Rle_dec x0 x1) as [Hle|Hnle].
apply (cond_pos x0).
apply (cond_pos x1).
- split with (mkposreal _ H7); intros; case (Rcase_abs h0); intro.
+ split with (mkposreal _ H7); intros; destruct (Rcase_abs h0) as [Hle|Hnle].
assert (H10 : a + h0 < a).
pattern a at 2; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l;
assumption.
- rewrite H1; unfold primitive; case (Rle_dec a (a + h0));
- case (Rle_dec (a + h0) b); case (Rle_dec a a); case (Rle_dec a b);
- intros; try (elim n; right; assumption || reflexivity).
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r3 H10)).
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r2 H10)).
+ rewrite H1; unfold primitive.
+ apply (decide_left (Rle_dec a b) h); intro h'.
+ assert (H11:~ a<=a+h0) by auto using Rlt_not_le.
+ decide (Rle_dec a (a+h0)) with H11.
+ decide (Rle_dec a a) with (Rle_refl a).
rewrite RiemannInt_P9; replace 0 with (f_a a).
replace (f a * (a + h0 - a)) with (f_a (a + h0)).
apply H5; try assumption.
@@ -3208,27 +3124,26 @@ Proof.
unfold del; apply Rmin_l.
unfold f_a; ring.
unfold f_a; ring.
- elim n; rewrite <- H0; left; assumption.
assert (H10 : a < a + h0).
pattern a at 1; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l.
- assert (H10 := Rge_le _ _ r); elim H10; intro.
+ assert (H10 := Rge_le _ _ Hnle); elim H10; intro.
assumption.
elim H8; symmetry ; assumption.
- rewrite H0 in H1; rewrite H1; unfold primitive;
- case (Rle_dec a (b + h0)); case (Rle_dec (b + h0) b);
- case (Rle_dec a b); case (Rle_dec b b); intros;
- try (elim n; right; assumption || reflexivity).
- rewrite H0 in H10; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r2 H10)).
- repeat rewrite RiemannInt_P9.
- replace (RiemannInt (FTC_P1 h C0 r1 r0)) with (f_b b).
+ rewrite H0 in H1; rewrite H1; unfold primitive.
+ decide (Rle_dec a b) with h.
+ decide (Rle_dec b b) with (Rle_refl b).
+ assert (H12 : a<=b+h0) by (eauto using Rlt_le_trans with real).
+ decide (Rle_dec a (b+h0)) with H12.
+ rewrite H0 in H10.
+ assert (H13 : ~b+h0<=b) by (auto using Rlt_not_le).
+ decide (Rle_dec (b+h0) b) with H13.
+ replace (RiemannInt (FTC_P1 h C0 hbis H11)) with (f_b b).
fold (f_b (b + h0)).
apply H6; try assumption.
apply Rlt_le_trans with del; try assumption.
unfold del; apply Rmin_r.
unfold f_b; unfold Rminus; rewrite Rplus_opp_r;
rewrite Rmult_0_r; rewrite Rplus_0_l; apply RiemannInt_P5.
- elim n; rewrite <- H0; left; assumption.
- elim n0; rewrite <- H0; left; assumption.
Qed.
Lemma RiemannInt_P29 :
@@ -3266,7 +3181,7 @@ Qed.
Lemma RiemannInt_P32 :
forall (f:C1_fun) (a b:R), Riemann_integrable (derive f (diff0 f)) a b.
Proof.
- intro f; intros; case (Rle_dec a b); intro;
+ intro f; intros; destruct (Rle_dec a b) as [Hle|Hnle];
[ apply continuity_implies_RiemannInt; try assumption; intros;
apply (cont1 f)
| assert (H : b <= a);
@@ -3296,10 +3211,45 @@ Lemma FTC_Riemann :
forall (f:C1_fun) (a b:R) (pr:Riemann_integrable (derive f (diff0 f)) a b),
RiemannInt pr = f b - f a.
Proof.
- intro f; intros; case (Rle_dec a b); intro;
+ intro f; intros; destruct (Rle_dec a b) as [Hle|Hnle];
[ apply RiemannInt_P33; assumption
| assert (H : b <= a);
[ auto with real
| assert (H0 := RiemannInt_P1 pr); rewrite (RiemannInt_P8 pr H0);
rewrite (RiemannInt_P33 _ H0 H); ring ] ].
Qed.
+
+(* RiemannInt *)
+Lemma RiemannInt_const_bound :
+ forall f a b l u (h : Riemann_integrable f a b), a <= b ->
+ (forall x, a < x < b -> l <= f x <= u) ->
+ l * (b - a) <= RiemannInt h <= u * (b - a).
+intros f a b l u ri ab intf.
+rewrite <- !(fun l => RiemannInt_P15 (RiemannInt_P14 a b l)).
+split; apply RiemannInt_P19; try assumption;
+ intros x intx; unfold fct_cte; destruct (intf x intx); assumption.
+Qed.
+
+Lemma Riemann_integrable_scal :
+ forall f a b k,
+ Riemann_integrable f a b ->
+ Riemann_integrable (fun x => k * f x) a b.
+intros f a b k ri.
+apply Riemann_integrable_ext with
+ (f := fun x => 0 + k * f x).
+ intros; ring.
+apply (RiemannInt_P10 _ (RiemannInt_P14 _ _ 0) ri).
+Qed.
+
+Arguments Riemann_integrable_scal [f a b] k _ eps.
+
+Lemma Riemann_integrable_Ropp :
+ forall f a b, Riemann_integrable f a b ->
+ Riemann_integrable (fun x => - f x) a b.
+intros ff a b h.
+apply Riemann_integrable_ext with (f := fun x => (-1) * ff x).
+intros; ring.
+apply Riemann_integrable_scal; assumption.
+Qed.
+
+Arguments Riemann_integrable_Ropp [f a b] _ eps.
diff --git a/theories/Reals/RiemannInt_SF.v b/theories/Reals/RiemannInt_SF.v
index 8eb49bf3..1484ab2a 100644
--- a/theories/Reals/RiemannInt_SF.v
+++ b/theories/Reals/RiemannInt_SF.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -40,26 +40,25 @@ Proof.
assert (H2 : exists x : R, E x).
elim H; intros; exists (INR x); unfold E; exists x; split;
[ assumption | reflexivity ].
- assert (H3 := completeness E H1 H2); elim H3; intros; unfold is_lub in p;
- elim p; clear p; intros; unfold is_upper_bound in H4, H5;
+ destruct (completeness E H1 H2) as (x,(H4,H5)); unfold is_upper_bound in H4, H5;
assert (H6 : 0 <= x).
- elim H2; intros; unfold E in H6; elim H6; intros; elim H7; intros;
+ destruct H2 as (x0,H6). remember H6 as H7. destruct H7 as (x1,(H8,H9)).
apply Rle_trans with x0;
[ rewrite <- H9; change (INR 0 <= INR x1); apply le_INR;
apply le_O_n
| apply H4; assumption ].
assert (H7 := archimed x); elim H7; clear H7; intros;
assert (H9 : x <= IZR (up x) - 1).
- apply H5; intros; assert (H10 := H4 _ H9); unfold E in H9; elim H9; intros;
- elim H11; intros; rewrite <- H13; apply Rplus_le_reg_l with 1;
+ apply H5; intros x0 H9. assert (H10 := H4 _ H9); unfold E in H9; elim H9; intros x1 (H12,<-).
+ apply Rplus_le_reg_l with 1;
replace (1 + (IZR (up x) - 1)) with (IZR (up x));
[ idtac | ring ]; replace (1 + INR x1) with (INR (S x1));
[ idtac | rewrite S_INR; ring ].
assert (H14 : (0 <= up x)%Z).
apply le_IZR; apply Rle_trans with x; [ apply H6 | left; assumption ].
- assert (H15 := IZN _ H14); elim H15; clear H15; intros; rewrite H15;
- rewrite <- INR_IZR_INZ; apply le_INR; apply lt_le_S;
- apply INR_lt; rewrite H13; apply Rle_lt_trans with x;
+ destruct (IZN _ H14) as (x2,H15).
+ rewrite H15, <- INR_IZR_INZ; apply le_INR; apply lt_le_S.
+ apply INR_lt; apply Rle_lt_trans with x;
[ assumption | rewrite INR_IZR_INZ; rewrite <- H15; assumption ].
assert (H10 : x = IZR (up x) - 1).
apply Rle_antisym;
@@ -70,32 +69,32 @@ Proof.
[ assumption | ring ] ].
assert (H11 : (0 <= up x)%Z).
apply le_IZR; apply Rle_trans with x; [ apply H6 | left; assumption ].
- assert (H12 := IZN_var H11); elim H12; clear H12; intros; assert (H13 : E x).
+ assert (H12 := IZN_var H11); elim H12; clear H12; intros x0 H8; assert (H13 : E x).
elim (classic (E x)); intro; try assumption.
cut (forall y:R, E y -> y <= x - 1).
- intro; assert (H14 := H5 _ H13); cut (x - 1 < x).
- intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H14 H15)).
+ intro H13; assert (H14 := H5 _ H13); cut (x - 1 < x).
+ intro H15; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H14 H15)).
apply Rminus_lt; replace (x - 1 - x) with (-1); [ idtac | ring ];
rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; apply Rlt_0_1.
- intros; assert (H14 := H4 _ H13); elim H14; intro; unfold E in H13; elim H13;
- intros; elim H16; intros; apply Rplus_le_reg_l with 1.
+ intros y H13; assert (H14 := H4 _ H13); elim H14; intro H15; unfold E in H13; elim H13;
+ intros x1 H16; elim H16; intros H17 H18; apply Rplus_le_reg_l with 1.
replace (1 + (x - 1)) with x; [ idtac | ring ]; rewrite <- H18;
replace (1 + INR x1) with (INR (S x1)); [ idtac | rewrite S_INR; ring ].
cut (x = INR (pred x0)).
- intro; rewrite H19; apply le_INR; apply lt_le_S; apply INR_lt; rewrite H18;
+ intro H19; rewrite H19; apply le_INR; apply lt_le_S; apply INR_lt; rewrite H18;
rewrite <- H19; assumption.
- rewrite H10; rewrite p; rewrite <- INR_IZR_INZ; replace 1 with (INR 1);
+ rewrite H10; rewrite H8; rewrite <- INR_IZR_INZ; replace 1 with (INR 1);
[ idtac | reflexivity ]; rewrite <- minus_INR.
replace (x0 - 1)%nat with (pred x0);
[ reflexivity
| case x0; [ reflexivity | intro; simpl; apply minus_n_O ] ].
- induction x0 as [| x0 Hrecx0];
- [ rewrite p in H7; rewrite <- INR_IZR_INZ in H7; simpl in H7;
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H6 H7))
- | apply le_n_S; apply le_O_n ].
- rewrite H15 in H13; elim H12; assumption.
+ induction x0 as [|x0 Hrecx0].
+ rewrite H8 in H3. rewrite <- INR_IZR_INZ in H3; simpl in H3.
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H6 H3)).
+ apply le_n_S; apply le_O_n.
+ rewrite H15 in H13; elim H12; assumption.
split with (pred x0); unfold E in H13; elim H13; intros; elim H12; intros;
- rewrite H10 in H15; rewrite p in H15; rewrite <- INR_IZR_INZ in H15;
+ rewrite H10 in H15; rewrite H8 in H15; rewrite <- INR_IZR_INZ in H15;
assert (H16 : INR x0 = INR x1 + 1).
rewrite H15; ring.
rewrite <- S_INR in H16; assert (H17 := INR_eq _ _ H16); rewrite H17;
@@ -144,7 +143,7 @@ Definition subdivision (a b:R) (f:StepFun a b) : Rlist := projT1 (pre f).
Definition subdivision_val (a b:R) (f:StepFun a b) : Rlist :=
match projT2 (pre f) with
- | existT a b => a
+ | existT _ a b => a
end.
Fixpoint Int_SF (l k:Rlist) : R :=
@@ -173,8 +172,8 @@ Lemma StepFun_P1 :
forall (a b:R) (f:StepFun a b),
adapted_couple f a b (subdivision f) (subdivision_val f).
Proof.
- intros a b f; unfold subdivision_val; case (projT2 (pre f)); intros;
- apply a0.
+ intros a b f; unfold subdivision_val; case (projT2 (pre f)) as (x,H);
+ apply H.
Qed.
Lemma StepFun_P2 :
@@ -201,19 +200,17 @@ Proof.
intros; unfold adapted_couple; repeat split.
unfold ordered_Rlist; intros; simpl in H0; inversion H0;
[ simpl; assumption | elim (le_Sn_O _ H2) ].
- simpl; unfold Rmin; case (Rle_dec a b); intro;
- [ reflexivity | elim n; assumption ].
- simpl; unfold Rmax; case (Rle_dec a b); intro;
- [ reflexivity | elim n; assumption ].
+ simpl; unfold Rmin; decide (Rle_dec a b) with H; reflexivity.
+ simpl; unfold Rmax; decide (Rle_dec a b) with H; reflexivity.
unfold constant_D_eq, open_interval; intros; simpl in H0;
inversion H0; [ reflexivity | elim (le_Sn_O _ H3) ].
Qed.
Lemma StepFun_P4 : forall a b c:R, IsStepFun (fct_cte c) a b.
Proof.
- intros; unfold IsStepFun; case (Rle_dec a b); intro.
+ intros; unfold IsStepFun; destruct (Rle_dec a b) as [Hle|Hnle].
apply existT with (cons a (cons b nil)); unfold is_subdivision;
- apply existT with (cons c nil); apply (StepFun_P3 c r).
+ apply existT with (cons c nil); apply (StepFun_P3 c Hle).
apply existT with (cons b (cons a nil)); unfold is_subdivision;
apply existT with (cons c nil); apply StepFun_P2;
apply StepFun_P3; auto with real.
@@ -244,17 +241,15 @@ Lemma StepFun_P7 :
Proof.
unfold adapted_couple; intros; decompose [and] H0; clear H0;
assert (H5 : Rmax a b = b).
- unfold Rmax; case (Rle_dec a b); intro;
- [ reflexivity | elim n; assumption ].
+ unfold Rmax; decide (Rle_dec a b) with H; reflexivity.
assert (H7 : r2 <= b).
rewrite H5 in H2; rewrite <- H2; apply RList_P7;
[ assumption | simpl; right; left; reflexivity ].
repeat split.
apply RList_P4 with r1; assumption.
- rewrite H5 in H2; unfold Rmin; case (Rle_dec r2 b); intro;
- [ reflexivity | elim n; assumption ].
- unfold Rmax; case (Rle_dec r2 b); intro;
- [ rewrite H5 in H2; rewrite <- H2; reflexivity | elim n; assumption ].
+ rewrite H5 in H2; unfold Rmin; decide (Rle_dec r2 b) with H7; reflexivity.
+ unfold Rmax; decide (Rle_dec r2 b) with H7.
+ rewrite H5 in H2; rewrite <- H2; reflexivity.
simpl in H4; simpl; apply INR_eq; apply Rplus_eq_reg_l with 1;
do 2 rewrite (Rplus_comm 1); do 2 rewrite <- S_INR;
rewrite H4; reflexivity.
@@ -340,33 +335,28 @@ Proof.
apply H6.
rewrite <- Hyp_eq; rewrite H3 in H1; unfold adapted_couple in H1;
decompose [and] H1; clear H1; simpl in H9; rewrite H9;
- unfold Rmin; case (Rle_dec a b); intro;
- [ reflexivity | elim n; assumption ].
+ unfold Rmin; decide (Rle_dec a b) with H0; reflexivity.
elim H6; clear H6; intros l' [lf' H6]; case (Req_dec t2 b); intro.
exists (cons a (cons b nil)); exists (cons r1 nil);
unfold adapted_couple_opt; unfold adapted_couple;
repeat split.
unfold ordered_Rlist; intros; simpl in H8; inversion H8;
[ simpl; assumption | elim (le_Sn_O _ H10) ].
- simpl; unfold Rmin; case (Rle_dec a b); intro;
- [ reflexivity | elim n; assumption ].
- simpl; unfold Rmax; case (Rle_dec a b); intro;
- [ reflexivity | elim n; assumption ].
+ simpl; unfold Rmin; decide (Rle_dec a b) with H0; reflexivity.
+ simpl; unfold Rmax; decide (Rle_dec a b) with H0; reflexivity.
intros; simpl in H8; inversion H8.
unfold constant_D_eq, open_interval; intros; simpl;
simpl in H9; rewrite H3 in H1; unfold adapted_couple in H1;
decompose [and] H1; apply (H16 0%nat).
simpl; apply lt_O_Sn.
unfold open_interval; simpl; rewrite H7; simpl in H13;
- rewrite H13; unfold Rmin; case (Rle_dec a b);
- intro; [ assumption | elim n; assumption ].
+ rewrite H13; unfold Rmin; decide (Rle_dec a b) with H0; assumption.
elim (le_Sn_O _ H10).
intros; simpl in H8; elim (lt_n_O _ H8).
intros; simpl in H8; inversion H8;
[ simpl; assumption | elim (le_Sn_O _ H10) ].
assert (Hyp_min : Rmin t2 b = t2).
- unfold Rmin; case (Rle_dec t2 b); intro;
- [ reflexivity | elim n; assumption ].
+ unfold Rmin; decide (Rle_dec t2 b) with H5; reflexivity.
unfold adapted_couple in H6; elim H6; clear H6; intros;
elim (RList_P20 _ (StepFun_P9 H6 H7)); intros s1 [s2 [s3 H9]];
induction lf' as [| r2 lf' Hreclf'].
@@ -391,18 +381,16 @@ Proof.
apply (H16 (S i)); simpl; assumption.
simpl; simpl in H14; rewrite H14; reflexivity.
simpl; simpl in H18; rewrite H18; unfold Rmax;
- case (Rle_dec a b); case (Rle_dec t2 b); intros; reflexivity || elim n;
- assumption.
+ decide (Rle_dec a b) with H0; decide (Rle_dec t2 b) with H5; reflexivity.
simpl; simpl in H20; apply H20.
intros; simpl in H1; unfold constant_D_eq, open_interval; intros;
induction i as [| i Hreci].
- simpl; simpl in H6; case (total_order_T x t2); intro.
- elim s; intro.
+ simpl; simpl in H6; destruct (total_order_T x t2) as [[Hlt|Heq]|Hgt].
apply (H17 0%nat);
[ simpl; apply lt_O_Sn
| unfold open_interval; simpl; elim H6; intros; split;
assumption ].
- rewrite b0; assumption.
+ rewrite Heq; assumption.
rewrite H10; apply (H22 0%nat);
[ simpl; apply lt_O_Sn
| unfold open_interval; simpl; replace s1 with t2;
@@ -440,8 +428,7 @@ Proof.
assumption.
simpl; simpl in H19; apply H19.
rewrite H9; simpl; simpl in H13; rewrite H13; unfold Rmax;
- case (Rle_dec t2 b); case (Rle_dec a b); intros; reflexivity || elim n;
- assumption.
+ decide (Rle_dec t2 b) with H5; decide (Rle_dec a b) with H0; reflexivity.
rewrite H9; simpl; simpl in H15; rewrite H15; reflexivity.
intros; simpl in H1; unfold constant_D_eq, open_interval; intros;
induction i as [| i Hreci].
@@ -483,8 +470,7 @@ Proof.
assumption.
simpl; simpl in H18; apply H18.
rewrite H9; simpl; simpl in H12; rewrite H12; unfold Rmax;
- case (Rle_dec t2 b); case (Rle_dec a b); intros; reflexivity || elim n;
- assumption.
+ decide (Rle_dec t2 b) with H5; decide (Rle_dec a b) with H0; reflexivity.
rewrite H9; simpl; simpl in H14; rewrite H14; reflexivity.
intros; simpl in H1; unfold constant_D_eq, open_interval; intros;
induction i as [| i Hreci].
@@ -511,8 +497,7 @@ Proof.
clear H1; clear H H7 H9; cut (Rmax a b = b);
[ intro; rewrite H in H5; rewrite <- H5; apply RList_P7;
[ assumption | simpl; right; left; reflexivity ]
- | unfold Rmax; case (Rle_dec a b); intro;
- [ reflexivity | elim n; assumption ] ].
+ | unfold Rmax; decide (Rle_dec a b) with H0; reflexivity ].
Qed.
Lemma StepFun_P11 :
@@ -528,7 +513,7 @@ Proof.
simpl in H10; simpl in H5; rewrite H10; rewrite H5; reflexivity.
assert (H14 := H3 0%nat (lt_O_Sn _)); simpl in H14; elim H14; intro.
assert (H15 := H7 0%nat (lt_O_Sn _)); simpl in H15; elim H15; intro.
- rewrite <- H12 in H1; case (Rle_dec r1 s2); intro; try assumption.
+ rewrite <- H12 in H1; destruct (Rle_dec r1 s2) as [Hle|Hnle]; try assumption.
assert (H16 : s2 < r1); auto with real.
induction s3 as [| r0 s3 Hrecs3].
simpl in H9; rewrite H9 in H16; cut (r1 <= Rmax a b).
@@ -662,12 +647,11 @@ Lemma StepFun_P13 :
adapted_couple f a b (cons r (cons r1 r2)) (cons r3 lf1) ->
adapted_couple_opt f a b (cons s1 (cons s2 s3)) (cons r4 lf2) -> r1 <= s2.
Proof.
- intros; case (total_order_T a b); intro.
- elim s; intro.
- eapply StepFun_P11; [ apply a0 | apply H0 | apply H1 ].
+ intros; destruct (total_order_T a b) as [[Hlt|Heq]|Hgt].
+ eapply StepFun_P11; [ apply Hlt | apply H0 | apply H1 ].
elim H; assumption.
eapply StepFun_P11;
- [ apply r0 | apply StepFun_P2; apply H0 | apply StepFun_P12; apply H1 ].
+ [ apply Hgt | apply StepFun_P2; apply H0 | apply StepFun_P12; apply H1 ].
Qed.
Lemma StepFun_P14 :
@@ -689,11 +673,9 @@ Proof.
case (Req_dec a b); intro.
rewrite (StepFun_P8 H2 H4); rewrite (StepFun_P8 H H4); reflexivity.
assert (Hyp_min : Rmin a b = a).
- unfold Rmin; case (Rle_dec a b); intro;
- [ reflexivity | elim n; assumption ].
+ unfold Rmin; decide (Rle_dec a b) with H1; reflexivity.
assert (Hyp_max : Rmax a b = b).
- unfold Rmax; case (Rle_dec a b); intro;
- [ reflexivity | elim n; assumption ].
+ unfold Rmax; decide (Rle_dec a b) with H1; reflexivity.
elim (RList_P20 _ (StepFun_P9 H H4)); intros s1 [s2 [s3 H5]]; rewrite H5 in H;
rewrite H5; induction lf1 as [| r3 lf1 Hreclf1].
unfold adapted_couple in H2; decompose [and] H2;
@@ -883,8 +865,8 @@ Lemma StepFun_P15 :
adapted_couple f a b l1 lf1 ->
adapted_couple_opt f a b l2 lf2 -> Int_SF lf1 l1 = Int_SF lf2 l2.
Proof.
- intros; case (Rle_dec a b); intro;
- [ apply (StepFun_P14 r H H0)
+ intros; destruct (Rle_dec a b) as [Hle|Hnle];
+ [ apply (StepFun_P14 Hle H H0)
| assert (H1 : b <= a);
[ auto with real
| eapply StepFun_P14;
@@ -897,8 +879,8 @@ Lemma StepFun_P16 :
exists l' : Rlist,
(exists lf' : Rlist, adapted_couple_opt f a b l' lf').
Proof.
- intros; case (Rle_dec a b); intro;
- [ apply (StepFun_P10 r H)
+ intros; destruct (Rle_dec a b) as [Hle|Hnle];
+ [ apply (StepFun_P10 Hle H)
| assert (H1 : b <= a);
[ auto with real
| assert (H2 := StepFun_P10 H1 (StepFun_P2 H)); elim H2;
@@ -961,9 +943,8 @@ Lemma StepFun_P21 :
forall (a b:R) (f:R -> R) (l:Rlist),
is_subdivision f a b l -> adapted_couple f a b l (FF l f).
Proof.
- intros; unfold adapted_couple; unfold is_subdivision in X;
- unfold adapted_couple in X; elim X; clear X; intros;
- decompose [and] p; clear p; repeat split; try assumption.
+ intros * (x & H & H1 & H0 & H2 & H4).
+ repeat split; try assumption.
apply StepFun_P20; rewrite H2; apply lt_O_Sn.
intros; assert (H5 := H4 _ H3); unfold constant_D_eq, open_interval in H5;
unfold constant_D_eq, open_interval; intros;
@@ -1003,11 +984,9 @@ Lemma StepFun_P22 :
Proof.
unfold is_subdivision; intros a b f g lf lg Hyp X X0; elim X; elim X0;
clear X X0; intros lg0 p lf0 p0; assert (Hyp_min : Rmin a b = a).
- unfold Rmin; case (Rle_dec a b); intro;
- [ reflexivity | elim n; assumption ].
+ unfold Rmin; decide (Rle_dec a b) with Hyp; reflexivity.
assert (Hyp_max : Rmax a b = b).
- unfold Rmax; case (Rle_dec a b); intro;
- [ reflexivity | elim n; assumption ].
+ unfold Rmax; decide (Rle_dec a b) with Hyp; reflexivity.
apply existT with (FF (cons_ORlist lf lg) f); unfold adapted_couple in p, p0;
decompose [and] p; decompose [and] p0; clear p p0;
rewrite Hyp_min in H6; rewrite Hyp_min in H1; rewrite Hyp_max in H0;
@@ -1221,13 +1200,13 @@ Proof.
[ apply lt_n_S; assumption
| symmetry ; apply S_pred with 0%nat; apply neq_O_lt; red;
intro; rewrite <- H22 in H21; elim (lt_n_O _ H21) ].
- elim (Rle_dec (pos_Rl lf (S x0)) (pos_Rl (cons_ORlist lf lg) i)); intro.
+ elim (Rle_dec (pos_Rl lf (S x0)) (pos_Rl (cons_ORlist lf lg) i)); intro a0.
assert (H23 : (S x0 <= x0)%nat).
apply H20; unfold I; split; assumption.
elim (le_Sn_n _ H23).
assert (H23 : pos_Rl (cons_ORlist lf lg) i < pos_Rl lf (S x0)).
auto with real.
- clear b0; apply RList_P17; try assumption.
+ clear a0; apply RList_P17; try assumption.
apply RList_P2; assumption.
elim (RList_P9 lf lg (pos_Rl lf (S x0))); intros; apply H25; left;
elim (RList_P3 lf (pos_Rl lf (S x0))); intros; apply H27;
@@ -1255,11 +1234,9 @@ Lemma StepFun_P24 :
Proof.
unfold is_subdivision; intros a b f g lf lg Hyp X X0; elim X; elim X0;
clear X X0; intros lg0 p lf0 p0; assert (Hyp_min : Rmin a b = a).
- unfold Rmin; case (Rle_dec a b); intro;
- [ reflexivity | elim n; assumption ].
+ unfold Rmin; decide (Rle_dec a b) with Hyp; reflexivity.
assert (Hyp_max : Rmax a b = b).
- unfold Rmax; case (Rle_dec a b); intro;
- [ reflexivity | elim n; assumption ].
+ unfold Rmax; decide (Rle_dec a b) with Hyp; reflexivity.
apply existT with (FF (cons_ORlist lf lg) g); unfold adapted_couple in p, p0;
decompose [and] p; decompose [and] p0; clear p p0;
rewrite Hyp_min in H1; rewrite Hyp_min in H6; rewrite Hyp_max in H0;
@@ -1471,12 +1448,12 @@ Proof.
apply lt_n_S; assumption.
symmetry ; apply S_pred with 0%nat; apply neq_O_lt; red;
intro; rewrite <- H22 in H21; elim (lt_n_O _ H21).
- elim (Rle_dec (pos_Rl lg (S x0)) (pos_Rl (cons_ORlist lf lg) i)); intro.
+ elim (Rle_dec (pos_Rl lg (S x0)) (pos_Rl (cons_ORlist lf lg) i)); intro a0.
assert (H23 : (S x0 <= x0)%nat);
[ apply H20; unfold I; split; assumption | elim (le_Sn_n _ H23) ].
assert (H23 : pos_Rl (cons_ORlist lf lg) i < pos_Rl lg (S x0)).
auto with real.
- clear b0; apply RList_P17; try assumption;
+ clear a0; apply RList_P17; try assumption;
[ apply RList_P2; assumption
| elim (RList_P9 lf lg (pos_Rl lg (S x0))); intros; apply H25; right;
elim (RList_P3 lg (pos_Rl lg (S x0))); intros;
@@ -1652,7 +1629,7 @@ Lemma StepFun_P34 :
a <= b ->
Rabs (RiemannInt_SF f) <= RiemannInt_SF (mkStepFun (StepFun_P32 f)).
Proof.
- intros; unfold RiemannInt_SF; case (Rle_dec a b); intro.
+ intros; unfold RiemannInt_SF; decide (Rle_dec a b) with H.
replace
(Int_SF (subdivision_val (mkStepFun (StepFun_P32 f)))
(subdivision (mkStepFun (StepFun_P32 f)))) with
@@ -1663,7 +1640,6 @@ Proof.
apply StepFun_P17 with (fun x:R => Rabs (f x)) a b;
[ apply StepFun_P31; apply StepFun_P1
| apply (StepFun_P1 (mkStepFun (StepFun_P32 f))) ].
- elim n; assumption.
Qed.
Lemma StepFun_P35 :
@@ -1741,24 +1717,21 @@ Lemma StepFun_P36 :
(forall x:R, a < x < b -> f x <= g x) ->
RiemannInt_SF f <= RiemannInt_SF g.
Proof.
- intros; unfold RiemannInt_SF; case (Rle_dec a b); intro.
+ intros; unfold RiemannInt_SF; decide (Rle_dec a b) with H.
replace (Int_SF (subdivision_val f) (subdivision f)) with (Int_SF (FF l f) l).
replace (Int_SF (subdivision_val g) (subdivision g)) with (Int_SF (FF l g) l).
unfold is_subdivision in X; elim X; clear X; intros;
unfold adapted_couple in p; decompose [and] p; clear p;
assert (H5 : Rmin a b = a);
- [ unfold Rmin; case (Rle_dec a b); intro;
- [ reflexivity | elim n; assumption ]
+ [ unfold Rmin; decide (Rle_dec a b) with H; reflexivity
| assert (H7 : Rmax a b = b);
- [ unfold Rmax; case (Rle_dec a b); intro;
- [ reflexivity | elim n; assumption ]
+ [ unfold Rmax; decide (Rle_dec a b) with H; reflexivity
| rewrite H5 in H3; rewrite H7 in H2; eapply StepFun_P35 with a b;
assumption ] ].
apply StepFun_P17 with (fe g) a b;
[ apply StepFun_P21; assumption | apply StepFun_P1 ].
apply StepFun_P17 with (fe f) a b;
[ apply StepFun_P21; assumption | apply StepFun_P1 ].
- elim n; assumption.
Qed.
Lemma StepFun_P37 :
@@ -1819,8 +1792,7 @@ Proof.
induction i as [| i Hreci].
simpl; rewrite H12; replace (Rmin r1 b) with r1.
simpl in H0; rewrite <- H0; apply (H 0%nat); simpl; apply lt_O_Sn.
- unfold Rmin; case (Rle_dec r1 b); intro;
- [ reflexivity | elim n; assumption ].
+ unfold Rmin; decide (Rle_dec r1 b) with H7; reflexivity.
apply (H10 i); apply lt_S_n.
replace (S (pred (Rlength lg))) with (Rlength lg).
apply H9.
@@ -1829,8 +1801,7 @@ Proof.
simpl; assert (H14 : a <= b).
rewrite <- H1; simpl in H0; rewrite <- H0; apply RList_P7;
[ assumption | left; reflexivity ].
- unfold Rmin; case (Rle_dec a b); intro;
- [ reflexivity | elim n; assumption ].
+ unfold Rmin; decide (Rle_dec a b) with H14; reflexivity.
assert (H14 : a <= b).
rewrite <- H1; simpl in H0; rewrite <- H0; apply RList_P7;
[ assumption | left; reflexivity ].
@@ -1838,14 +1809,13 @@ Proof.
rewrite <- H11; induction lg as [| r0 lg Hreclg].
simpl in H13; discriminate.
reflexivity.
- unfold Rmax; case (Rle_dec a b); case (Rle_dec r1 b); intros;
- reflexivity || elim n; assumption.
+ unfold Rmax; decide (Rle_dec a b) with H14; decide (Rle_dec r1 b) with H7;
+ reflexivity.
simpl; rewrite H13; reflexivity.
intros; simpl in H9; induction i as [| i Hreci].
unfold constant_D_eq, open_interval; simpl; intros;
assert (H16 : Rmin r1 b = r1).
- unfold Rmin; case (Rle_dec r1 b); intro;
- [ reflexivity | elim n; assumption ].
+ unfold Rmin; decide (Rle_dec r1 b) with H7; reflexivity.
rewrite H16 in H12; rewrite H12 in H14; elim H14; clear H14; intros _ H14;
unfold g'; case (Rle_dec r1 x); intro r3.
elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r3 H14)).
@@ -1862,9 +1832,9 @@ Proof.
assert (H18 := H16 H17); unfold constant_D_eq, open_interval in H18;
unfold constant_D_eq, open_interval; intros;
assert (H19 := H18 _ H14); rewrite <- H19; unfold g';
- case (Rle_dec r1 x); intro.
+ case (Rle_dec r1 x) as [|[]].
reflexivity.
- elim n; replace r1 with (Rmin r1 b).
+ replace r1 with (Rmin r1 b).
rewrite <- H12; elim H14; clear H14; intros H14 _; left;
apply Rle_lt_trans with (pos_Rl lg i); try assumption.
apply RList_P5.
@@ -1874,12 +1844,9 @@ Proof.
apply lt_trans with (pred (Rlength lg)); try assumption.
apply lt_pred_n_n; apply neq_O_lt; red; intro; rewrite <- H22 in H17;
elim (lt_n_O _ H17).
- unfold Rmin; case (Rle_dec r1 b); intro;
- [ reflexivity | elim n0; assumption ].
+ unfold Rmin; decide (Rle_dec r1 b) with H7; reflexivity.
exists (mkStepFun H8); split.
- simpl; unfold g'; case (Rle_dec r1 b); intro.
- assumption.
- elim n; assumption.
+ simpl; unfold g'; decide (Rle_dec r1 b) with H7; assumption.
intros; simpl in H9; induction i as [| i Hreci].
unfold constant_D_eq, co_interval; simpl; intros; simpl in H0;
rewrite H0; elim H10; clear H10; intros; unfold g';
@@ -1896,9 +1863,9 @@ Proof.
assert (H12 := H10 H11); unfold constant_D_eq, co_interval in H12;
unfold constant_D_eq, co_interval; intros;
rewrite <- (H12 _ H13); simpl; unfold g';
- case (Rle_dec r1 x); intro.
+ case (Rle_dec r1 x) as [|[]].
reflexivity.
- elim n; elim H13; clear H13; intros;
+ elim H13; clear H13; intros;
apply Rle_trans with (pos_Rl (cons r1 l) i); try assumption;
change (pos_Rl (cons r1 l) 0 <= pos_Rl (cons r1 l) i);
elim (RList_P6 (cons r1 l)); intros; apply H15;
@@ -1954,24 +1921,22 @@ Proof.
unfold adapted_couple; decompose [and] H1;
decompose [and] H2; clear H1 H2; repeat split.
apply RList_P25; try assumption.
- rewrite H10; rewrite H4; unfold Rmin, Rmax; case (Rle_dec a b);
- case (Rle_dec b c); intros;
- (right; reflexivity) || (elim n; left; assumption).
+ rewrite H10; rewrite H4; unfold Rmin, Rmax; case (Rle_dec a b) as [|[]];
+ case (Rle_dec b c) as [|[]];
+ (right; reflexivity) || (left; assumption).
rewrite RList_P22.
- rewrite H5; unfold Rmin, Rmax; case (Rle_dec a b); case (Rle_dec a c);
- intros;
+ rewrite H5; unfold Rmin, Rmax; case (Rle_dec a c) as [|[]]; case (Rle_dec a b) as [|[]];
[ reflexivity
- | elim n; apply Rle_trans with b; left; assumption
- | elim n; left; assumption
- | elim n0; left; assumption ].
+ | left; assumption
+ | apply Rle_trans with b; left; assumption
+ | left; assumption ].
red; intro; rewrite H1 in H6; discriminate.
rewrite RList_P24.
- rewrite H9; unfold Rmin, Rmax; case (Rle_dec b c); case (Rle_dec a c);
- intros;
+ rewrite H9; unfold Rmin, Rmax; case (Rle_dec a c) as [|[]]; case (Rle_dec b c) as [|[]];
[ reflexivity
- | elim n; apply Rle_trans with b; left; assumption
- | elim n; left; assumption
- | elim n0; left; assumption ].
+ | left; assumption
+ | apply Rle_trans with b; left; assumption
+ | left; assumption ].
red; intro; rewrite H1 in H11; discriminate.
apply StepFun_P20.
rewrite RList_P23; apply neq_O_lt; red; intro.
@@ -2061,7 +2026,7 @@ Proof.
assert (H16 : pos_Rl (cons_Rlist l1 l2) (S i) = b).
rewrite RList_P29.
rewrite H15; rewrite <- minus_n_n; rewrite H10; unfold Rmin;
- case (Rle_dec b c); intro; [ reflexivity | elim n; left; assumption ].
+ case (Rle_dec b c) as [|[]]; [ reflexivity | left; assumption ].
rewrite H15; apply le_n.
induction l1 as [| r l1 Hrecl1].
simpl in H15; discriminate.
@@ -2069,8 +2034,8 @@ Proof.
assert (H17 : pos_Rl (cons_Rlist l1 l2) i = b).
rewrite RList_P26.
replace i with (pred (Rlength l1));
- [ rewrite H4; unfold Rmax; case (Rle_dec a b); intro;
- [ reflexivity | elim n; left; assumption ]
+ [ rewrite H4; unfold Rmax; case (Rle_dec a b) as [|[]];
+ [ reflexivity | left; assumption ]
| rewrite H15; reflexivity ].
rewrite H15; apply lt_n_Sn.
rewrite H16 in H2; rewrite H17 in H2; elim H2; intros;
@@ -2095,8 +2060,8 @@ Proof.
discriminate.
clear Hrecl1; induction l1 as [| r0 l1 Hrecl1].
simpl in H5; simpl in H4; assert (H0 : Rmin a b < Rmax a b).
- unfold Rmin, Rmax; case (Rle_dec a b); intro;
- [ assumption | elim n; left; assumption ].
+ unfold Rmin, Rmax; case (Rle_dec a b) as [|[]];
+ [ assumption | left; assumption ].
rewrite <- H5 in H0; rewrite <- H4 in H0; elim (Rlt_irrefl _ H0).
clear Hrecl1; simpl; repeat apply le_n_S; apply le_O_n.
elim (RList_P20 _ H18); intros r1 [r2 [r3 H19]]; rewrite H19;
@@ -2222,9 +2187,9 @@ Proof.
| left _ => Int_SF lf3 l3
| right _ => - Int_SF lf3 l3
end.
- case (Rle_dec a b); case (Rle_dec b c); case (Rle_dec a c); intros.
- elim r1; intro.
- elim r0; intro.
+ case (Rle_dec a b) as [Hle|Hnle]; case (Rle_dec b c) as [Hle'|Hnle']; case (Rle_dec a c) as [Hle''|Hnle''].
+ elim Hle; intro.
+ elim Hle'; intro.
replace (Int_SF lf3 l3) with
(Int_SF (FF (cons_Rlist l1 l2) f) (cons_Rlist l1 l2)).
replace (Int_SF lf1 l1) with (Int_SF (FF l1 f) l1).
@@ -2232,8 +2197,7 @@ Proof.
symmetry ; apply StepFun_P42.
unfold adapted_couple in H1, H2; decompose [and] H1; decompose [and] H2;
clear H1 H2; rewrite H11; rewrite H5; unfold Rmax, Rmin;
- case (Rle_dec a b); case (Rle_dec b c); intros; reflexivity || elim n;
- assumption.
+ decide (Rle_dec a b) with Hle; decide (Rle_dec b c) with Hle'; reflexivity.
eapply StepFun_P17;
[ apply StepFun_P21; unfold is_subdivision; split with lf2; apply H2;
assumption
@@ -2250,13 +2214,13 @@ Proof.
rewrite Rplus_0_l; eapply StepFun_P17;
[ apply H2 | rewrite H in H3; apply H3 ].
symmetry ; eapply StepFun_P8; [ apply H1 | assumption ].
- elim n; apply Rle_trans with b; assumption.
+ elim Hnle''; apply Rle_trans with b; assumption.
apply Rplus_eq_reg_l with (Int_SF lf2 l2);
replace (Int_SF lf2 l2 + (Int_SF lf1 l1 + - Int_SF lf2 l2)) with
(Int_SF lf1 l1); [ idtac | ring ].
assert (H : c < b).
auto with real.
- elim r; intro.
+ elim Hle''; intro.
rewrite Rplus_comm;
replace (Int_SF lf1 l1) with
(Int_SF (FF (cons_Rlist l3 l2) f) (cons_Rlist l3 l2)).
@@ -2264,12 +2228,9 @@ Proof.
replace (Int_SF lf2 l2) with (Int_SF (FF l2 f) l2).
apply StepFun_P42.
unfold adapted_couple in H2, H3; decompose [and] H2; decompose [and] H3;
- clear H3 H2; rewrite H10; rewrite H6; unfold Rmax, Rmin;
- case (Rle_dec a c); case (Rle_dec b c); intros;
- [ elim n; assumption
- | reflexivity
- | elim n0; assumption
- | elim n1; assumption ].
+ clear H3 H2; rewrite H10; rewrite H6; unfold Rmax, Rmin.
+ decide (Rle_dec a c) with Hle''; decide (Rle_dec b c) with Hnle';
+ reflexivity.
eapply StepFun_P17;
[ apply StepFun_P21; unfold is_subdivision; split with lf2; apply H2
| assumption ].
@@ -2284,7 +2245,7 @@ Proof.
symmetry ; eapply StepFun_P8; [ apply H3 | assumption ].
replace (Int_SF lf2 l2) with (Int_SF lf3 l3 + Int_SF lf1 l1).
ring.
- elim r; intro.
+ elim Hle; intro.
replace (Int_SF lf2 l2) with
(Int_SF (FF (cons_Rlist l3 l1) f) (cons_Rlist l3 l1)).
replace (Int_SF lf3 l3) with (Int_SF (FF l3 f) l3).
@@ -2292,11 +2253,7 @@ Proof.
symmetry ; apply StepFun_P42.
unfold adapted_couple in H1, H3; decompose [and] H1; decompose [and] H3;
clear H3 H1; rewrite H9; rewrite H5; unfold Rmax, Rmin;
- case (Rle_dec a c); case (Rle_dec a b); intros;
- [ elim n; assumption
- | elim n1; assumption
- | reflexivity
- | elim n1; assumption ].
+ decide (Rle_dec a c) with Hnle''; decide (Rle_dec a b) with Hle; reflexivity.
eapply StepFun_P17;
[ apply StepFun_P21; unfold is_subdivision; split with lf1; apply H1
| assumption ].
@@ -2316,7 +2273,7 @@ Proof.
auto with real.
replace (Int_SF lf2 l2) with (Int_SF lf3 l3 + Int_SF lf1 l1).
ring.
- rewrite Rplus_comm; elim r; intro.
+ rewrite Rplus_comm; elim Hle''; intro.
replace (Int_SF lf2 l2) with
(Int_SF (FF (cons_Rlist l1 l3) f) (cons_Rlist l1 l3)).
replace (Int_SF lf3 l3) with (Int_SF (FF l3 f) l3).
@@ -2324,11 +2281,8 @@ Proof.
symmetry ; apply StepFun_P42.
unfold adapted_couple in H1, H3; decompose [and] H1; decompose [and] H3;
clear H3 H1; rewrite H11; rewrite H5; unfold Rmax, Rmin;
- case (Rle_dec a c); case (Rle_dec a b); intros;
- [ elim n; assumption
- | reflexivity
- | elim n0; assumption
- | elim n1; assumption ].
+ decide (Rle_dec a c) with Hle''; decide (Rle_dec a b) with Hnle;
+ reflexivity.
eapply StepFun_P17;
[ apply StepFun_P21; unfold is_subdivision; split with lf1; apply H1
| assumption ].
@@ -2346,7 +2300,7 @@ Proof.
auto with real.
replace (Int_SF lf1 l1) with (Int_SF lf2 l2 + Int_SF lf3 l3).
ring.
- elim r; intro.
+ elim Hle'; intro.
replace (Int_SF lf1 l1) with
(Int_SF (FF (cons_Rlist l2 l3) f) (cons_Rlist l2 l3)).
replace (Int_SF lf3 l3) with (Int_SF (FF l3 f) l3).
@@ -2354,11 +2308,8 @@ Proof.
symmetry ; apply StepFun_P42.
unfold adapted_couple in H2, H3; decompose [and] H2; decompose [and] H3;
clear H3 H2; rewrite H11; rewrite H5; unfold Rmax, Rmin;
- case (Rle_dec a c); case (Rle_dec b c); intros;
- [ elim n; assumption
- | elim n1; assumption
- | reflexivity
- | elim n1; assumption ].
+ decide (Rle_dec a c) with Hnle''; decide (Rle_dec b c) with Hle';
+ reflexivity.
eapply StepFun_P17;
[ apply StepFun_P21; unfold is_subdivision; split with lf2; apply H2
| assumption ].
@@ -2371,8 +2322,8 @@ Proof.
replace (Int_SF lf2 l2) with 0.
rewrite Rplus_0_l; eapply StepFun_P17;
[ apply H3 | rewrite H0 in H1; apply H1 ].
- symmetry ; eapply StepFun_P8; [ apply H2 | assumption ].
- elim n; apply Rle_trans with a; try assumption.
+ symmetry; eapply StepFun_P8; [ apply H2 | assumption ].
+ elim Hnle'; apply Rle_trans with a; try assumption.
auto with real.
assert (H : c < b).
auto with real.
@@ -2387,11 +2338,8 @@ Proof.
symmetry ; apply StepFun_P42.
unfold adapted_couple in H2, H1; decompose [and] H2; decompose [and] H1;
clear H1 H2; rewrite H11; rewrite H5; unfold Rmax, Rmin;
- case (Rle_dec a b); case (Rle_dec b c); intros;
- [ elim n1; assumption
- | elim n1; assumption
- | elim n0; assumption
- | reflexivity ].
+ decide (Rle_dec a b) with Hnle; decide (Rle_dec b c) with Hnle';
+ reflexivity.
eapply StepFun_P17;
[ apply StepFun_P21; unfold is_subdivision; split with lf2; apply H2
| assumption ].
@@ -2463,10 +2411,8 @@ Proof.
replace a with (Rmin a b).
pattern b at 2; replace b with (Rmax a b).
rewrite <- H2; rewrite H3; reflexivity.
- unfold Rmax; case (Rle_dec a b); intro;
- [ reflexivity | elim n; assumption ].
- unfold Rmin; case (Rle_dec a b); intro;
- [ reflexivity | elim n; assumption ].
+ unfold Rmax; decide (Rle_dec a b) with H7; reflexivity.
+ unfold Rmin; decide (Rle_dec a b) with H7; reflexivity.
split with (cons r nil); split with lf1; assert (H2 : c = b).
rewrite H1 in H0; elim H0; intros; apply Rle_antisym; assumption.
rewrite H2; assumption.
@@ -2475,20 +2421,18 @@ Proof.
discriminate.
clear Hreclf1; assert (H1 : {c <= r1} + {r1 < c}).
case (Rle_dec c r1); intro; [ left; assumption | right; auto with real ].
- elim H1; intro.
+ elim H1; intro a0.
split with (cons r (cons c nil)); split with (cons r3 nil);
unfold adapted_couple in H; decompose [and] H; clear H;
assert (H6 : r = a).
- simpl in H4; rewrite H4; unfold Rmin; case (Rle_dec a b); intro;
+ simpl in H4; rewrite H4; unfold Rmin; case (Rle_dec a b) as [|[]];
[ reflexivity
- | elim n; elim H0; intros; apply Rle_trans with c; assumption ].
+ | elim H0; intros; apply Rle_trans with c; assumption ].
elim H0; clear H0; intros; unfold adapted_couple; repeat split.
rewrite H6; unfold ordered_Rlist; intros; simpl in H8; inversion H8;
[ simpl; assumption | elim (le_Sn_O _ H10) ].
- simpl; unfold Rmin; case (Rle_dec a c); intro;
- [ assumption | elim n; assumption ].
- simpl; unfold Rmax; case (Rle_dec a c); intro;
- [ reflexivity | elim n; assumption ].
+ simpl; unfold Rmin; decide (Rle_dec a c) with H; assumption.
+ simpl; unfold Rmax; decide (Rle_dec a c) with H; reflexivity.
unfold constant_D_eq, open_interval; intros; simpl in H8;
inversion H8.
simpl; assert (H10 := H7 0%nat);
@@ -2508,8 +2452,8 @@ Proof.
assert (H14 : a <= b).
elim H0; intros; apply Rle_trans with c; assumption.
assert (H16 : r = a).
- simpl in H7; rewrite H7; unfold Rmin; case (Rle_dec a b); intro;
- [ reflexivity | elim n; assumption ].
+ simpl in H7; rewrite H7; unfold Rmin; decide (Rle_dec a b) with H14;
+ reflexivity.
induction l1' as [| r4 l1' Hrecl1'].
simpl in H13; discriminate.
clear Hrecl1'; unfold adapted_couple; repeat split.
@@ -2517,18 +2461,18 @@ Proof.
simpl; replace r4 with r1.
apply (H5 0%nat).
simpl; apply lt_O_Sn.
- simpl in H12; rewrite H12; unfold Rmin; case (Rle_dec r1 c); intro;
- [ reflexivity | elim n; left; assumption ].
+ simpl in H12; rewrite H12; unfold Rmin; case (Rle_dec r1 c) as [|[]];
+ [ reflexivity | left; assumption ].
apply (H9 i); simpl; apply lt_S_n; assumption.
- simpl; unfold Rmin; case (Rle_dec a c); intro;
- [ assumption | elim n; elim H0; intros; assumption ].
+ simpl; unfold Rmin; case (Rle_dec a c) as [|[]];
+ [ assumption | elim H0; intros; assumption ].
replace (Rmax a c) with (Rmax r1 c).
rewrite <- H11; reflexivity.
- unfold Rmax; case (Rle_dec r1 c); case (Rle_dec a c); intros;
- [ reflexivity
- | elim n; elim H0; intros; assumption
- | elim n; left; assumption
- | elim n0; left; assumption ].
+ unfold Rmax; case (Rle_dec a c) as [|[]]; case (Rle_dec r1 c) as [|[]];
+ [ reflexivity
+ | left; assumption
+ | elim H0; intros; assumption
+ | left; assumption ].
simpl; simpl in H13; rewrite H13; reflexivity.
intros; simpl in H; unfold constant_D_eq, open_interval; intros;
induction i as [| i Hreci].
@@ -2539,8 +2483,8 @@ Proof.
elim H4; clear H4; intros; split; try assumption;
replace r1 with r4.
assumption.
- simpl in H12; rewrite H12; unfold Rmin; case (Rle_dec r1 c); intro;
- [ reflexivity | elim n; left; assumption ].
+ simpl in H12; rewrite H12; unfold Rmin; case (Rle_dec r1 c) as [|[]];
+ [ reflexivity | left; assumption ].
clear Hreci; simpl; apply H15.
simpl; apply lt_S_n; assumption.
unfold open_interval; apply H4.
@@ -2578,10 +2522,8 @@ Proof.
replace a with (Rmin a b).
pattern b at 2; replace b with (Rmax a b).
rewrite <- H2; rewrite H3; reflexivity.
- unfold Rmax; case (Rle_dec a b); intro;
- [ reflexivity | elim n; assumption ].
- unfold Rmin; case (Rle_dec a b); intro;
- [ reflexivity | elim n; assumption ].
+ unfold Rmax; decide (Rle_dec a b) with H7; reflexivity.
+ unfold Rmin; decide (Rle_dec a b) with H7; reflexivity.
split with (cons r nil); split with lf1; assert (H2 : c = b).
rewrite H1 in H0; elim H0; intros; apply Rle_antisym; assumption.
rewrite <- H2 in H1; rewrite <- H1; assumption.
@@ -2590,22 +2532,22 @@ Proof.
discriminate.
clear Hreclf1; assert (H1 : {c <= r1} + {r1 < c}).
case (Rle_dec c r1); intro; [ left; assumption | right; auto with real ].
- elim H1; intro.
+ elim H1; intro a0.
split with (cons c (cons r1 r2)); split with (cons r3 lf1);
unfold adapted_couple in H; decompose [and] H; clear H;
unfold adapted_couple; repeat split.
unfold ordered_Rlist; intros; simpl in H; induction i as [| i Hreci].
simpl; assumption.
clear Hreci; apply (H2 (S i)); simpl; assumption.
- simpl; unfold Rmin; case (Rle_dec c b); intro;
- [ reflexivity | elim n; elim H0; intros; assumption ].
+ simpl; unfold Rmin; case (Rle_dec c b) as [|[]];
+ [ reflexivity | elim H0; intros; assumption ].
replace (Rmax c b) with (Rmax a b).
rewrite <- H3; reflexivity.
- unfold Rmax; case (Rle_dec a b); case (Rle_dec c b); intros;
+ unfold Rmax; case (Rle_dec c b) as [|[]]; case (Rle_dec a b) as [|[]];
[ reflexivity
- | elim n; elim H0; intros; assumption
- | elim n; elim H0; intros; apply Rle_trans with c; assumption
- | elim n0; elim H0; intros; apply Rle_trans with c; assumption ].
+ | elim H0; intros; apply Rle_trans with c; assumption
+ | elim H0; intros; assumption
+ | elim H0; intros; apply Rle_trans with c; assumption ].
simpl; simpl in H5; apply H5.
intros; simpl in H; induction i as [| i Hreci].
unfold constant_D_eq, open_interval; intros; simpl;
@@ -2615,9 +2557,9 @@ Proof.
intros; split; try assumption; apply Rle_lt_trans with c;
try assumption; replace r with a.
elim H0; intros; assumption.
- simpl in H4; rewrite H4; unfold Rmin; case (Rle_dec a b); intros;
+ simpl in H4; rewrite H4; unfold Rmin; case (Rle_dec a b) as [|[]];
[ reflexivity
- | elim n; elim H0; intros; apply Rle_trans with c; assumption ].
+ | elim H0; intros; apply Rle_trans with c; assumption ].
clear Hreci; apply (H7 (S i)); simpl; assumption.
cut (adapted_couple f r1 b (cons r1 r2) lf1).
cut (r1 <= c <= b).
diff --git a/theories/Reals/Rlimit.v b/theories/Reals/Rlimit.v
index c3020611..c8887dfb 100644
--- a/theories/Reals/Rlimit.v
+++ b/theories/Reals/Rlimit.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -164,7 +164,7 @@ Definition limit_in (X X':Metric_Space) (f:Base X -> Base X')
eps > 0 ->
exists alp : R,
alp > 0 /\
- (forall x:Base X, D x /\ dist X x x0 < alp -> dist X' (f x) l < eps).
+ (forall x:Base X, D x /\ X.(dist) x x0 < alp -> X'.(dist) (f x) l < eps).
(*******************************)
(** ** R is a metric space *)
@@ -174,6 +174,8 @@ Definition limit_in (X X':Metric_Space) (f:Base X -> Base X')
Definition R_met : Metric_Space :=
Build_Metric_Space R R_dist R_dist_pos R_dist_sym R_dist_refl R_dist_tri.
+Declare Equivalent Keys dist R_dist.
+
(*******************************)
(** * Limit 1 arg *)
(*******************************)
@@ -191,9 +193,9 @@ Lemma tech_limit :
Proof.
intros f D l x0 H H0.
case (Rabs_pos (f x0 - l)); intros H1.
- absurd (dist R_met (f x0) l < dist R_met (f x0) l).
+ absurd (R_met.(@dist) (f x0) l < R_met.(@dist) (f x0) l).
apply Rlt_irrefl.
- case (H0 (dist R_met (f x0) l)); auto.
+ case (H0 (R_met.(@dist) (f x0) l)); auto.
intros alpha1 [H2 H3]; apply H3; auto; split; auto.
case (dist_refl R_met x0 x0); intros Hr1 Hr2; rewrite Hr2; auto.
case (dist_refl R_met (f x0) l); intros Hr1 Hr2; symmetry; auto.
@@ -312,7 +314,7 @@ Proof.
rewrite (Rplus_comm 1 (Rabs l)); unfold Rgt; apply Rle_lt_0_plus_1;
exact (Rabs_pos l).
unfold R_dist in H9;
- apply (Rplus_lt_reg_r (- Rabs l) (Rabs (f x2)) (1 + Rabs l)).
+ apply (Rplus_lt_reg_l (- Rabs l) (Rabs (f x2)) (1 + Rabs l)).
rewrite <- (Rplus_assoc (- Rabs l) 1 (Rabs l));
rewrite (Rplus_comm (- Rabs l) 1);
rewrite (Rplus_assoc 1 (- Rabs l) (Rabs l)); rewrite (Rplus_opp_l (Rabs l));
@@ -345,18 +347,19 @@ Lemma single_limit :
adhDa D x0 -> limit1_in f D l x0 -> limit1_in f D l' x0 -> l = l'.
Proof.
unfold limit1_in; unfold limit_in; intros.
+ simpl in *.
cut (forall eps:R, eps > 0 -> dist R_met l l' < 2 * eps).
- clear H0 H1; unfold dist; unfold R_met; unfold R_dist;
- unfold Rabs; case (Rcase_abs (l - l')); intros.
+ clear H0 H1; unfold dist in |- *; unfold R_met; unfold R_dist in |- *;
+ unfold Rabs; case (Rcase_abs (l - l')) as [Hlt|Hge]; intros.
cut (forall eps:R, eps > 0 -> - (l - l') < eps).
intro; generalize (prop_eps (- (l - l')) H1); intro;
- generalize (Ropp_gt_lt_0_contravar (l - l') r); intro;
+ generalize (Ropp_gt_lt_0_contravar (l - l') Hlt); intro;
unfold Rgt in H3; generalize (Rgt_not_le (- (l - l')) 0 H3);
intro; exfalso; auto.
intros; cut (eps * / 2 > 0).
intro; generalize (H0 (eps * / 2) H2); rewrite (Rmult_comm eps (/ 2));
rewrite <- (Rmult_assoc 2 (/ 2) eps); rewrite (Rinv_r 2).
- elim (Rmult_ne eps); intros a b; rewrite b; clear a b; trivial.
+ elim (Rmult_ne eps); intros a b; rewrite b; clear a b; trivial.
apply (Rlt_dichotomy_converse 2 0); right; generalize Rlt_0_1; intro;
unfold Rgt; generalize (Rplus_lt_compat_l 1 0 1 H3);
intro; elim (Rplus_ne 1); intros a b; rewrite a in H4;
@@ -374,7 +377,7 @@ Proof.
intros a b; clear b; apply (Rminus_diag_uniq l l');
apply a; split.
assumption.
- apply (Rge_le (l - l') 0 r).
+ apply (Rge_le (l - l') 0 Hge).
intros; cut (eps * / 2 > 0).
intro; generalize (H0 (eps * / 2) H2); rewrite (Rmult_comm eps (/ 2));
rewrite <- (Rmult_assoc 2 (/ 2) eps); rewrite (Rinv_r 2).
diff --git a/theories/Reals/Rlogic.v b/theories/Reals/Rlogic.v
index 14dea1c6..07792942 100644
--- a/theories/Reals/Rlogic.v
+++ b/theories/Reals/Rlogic.v
@@ -1,261 +1,137 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
(************************************************************************)
-(** * This module proves some logical properties of the axiomatics of Reals
+(** This module proves some logical properties of the axiomatic of Reals.
-1. Decidablity of arithmetical statements from
- the axiom that the order of the real numbers is decidable.
-
-2. Derivability of the archimedean "axiom"
+- Decidability of arithmetical statements.
+- Derivability of the Archimedean "axiom".
+- Decidability of negated formulas.
*)
-(** 1- Proof of the decidablity of arithmetical statements from
-excluded middle and the axiom that the order of the real numbers is
-decidable. *)
+Require Import RIneq.
-(** Assuming a decidable predicate [P n], A series is constructed whose
-[n]th term is 1/2^n if [P n] holds and 0 otherwise. This sum reaches 2
-only if [P n] holds for all [n], otherwise the sum is less than 2.
-Comparing the sum to 2 decides if [forall n, P n] or [~forall n, P n] *)
+(** * Decidability of arithmetical statements *)
(** One can iterate this lemma and use classical logic to decide any
statement in the arithmetical hierarchy. *)
-(** Contributed by Cezary Kaliszyk and Russell O'Connor *)
-
-Require Import ConstructiveEpsilon.
-Require Import Rfunctions.
-Require Import PartSum.
-Require Import SeqSeries.
-Require Import RiemannInt.
-Require Import Fourier.
-
Section Arithmetical_dec.
Variable P : nat -> Prop.
Hypothesis HP : forall n, {P n} + {~P n}.
-Let ge_fun_sums_ge_lemma : (forall (m n : nat) (f : nat -> R), (lt m n) -> (forall i : nat, 0 <= f i) -> sum_f_R0 f m <= sum_f_R0 f n).
-Proof.
-intros m n f mn fpos.
-replace (sum_f_R0 f m) with (sum_f_R0 f m + 0) by ring.
-rewrite (tech2 f m n mn).
-apply Rplus_le_compat_l.
- induction (n - S m)%nat; simpl in *.
- apply fpos.
-replace 0 with (0 + 0) by ring.
-apply (Rplus_le_compat _ _ _ _ IHn0 (fpos (S (m + S n0)%nat))).
-Qed.
-
-Let ge_fun_sums_ge : (forall (m n : nat) (f : nat -> R), (le m n) -> (forall i : nat, 0 <= f i) -> sum_f_R0 f m <= sum_f_R0 f n).
-Proof.
-intros m n f mn pos.
- elim (le_lt_or_eq _ _ mn).
- intro; apply ge_fun_sums_ge_lemma; assumption.
-intro H; rewrite H; auto with *.
-Qed.
-
-Let f:=fun n => (if HP n then (1/2)^n else 0)%R.
-
-Lemma cauchy_crit_geometric_dec_fun : Cauchy_crit_series f.
+Lemma sig_forall_dec : {n | ~P n} + {forall n, P n}.
Proof.
-intros e He.
-assert (X:(Pser (fun n:nat => 1) (1/2) (/ (1 - (1/2))))%R).
- apply GP_infinite.
- apply Rabs_def1; fourier.
-assert (He':e/2 > 0) by fourier.
-destruct (X _ He') as [N HN].
-clear X.
-exists N.
-intros n m Hn Hm.
-replace e with (e/2 + e/2)%R by field.
-set (g:=(fun n0 : nat => 1 * (1 / 2) ^ n0)) in *.
-assert (R_dist (sum_f_R0 g n) (sum_f_R0 g m) < e / 2 + e / 2).
- apply Rle_lt_trans with (R_dist (sum_f_R0 g n) 2+R_dist 2 (sum_f_R0 g m))%R.
- apply R_dist_tri.
- replace (/(1 - 1/2)) with 2 in HN by field.
- cut (forall n, (n >= N)%nat -> R_dist (sum_f_R0 g n) 2 < e/2)%R.
- intros Z.
- apply Rplus_lt_compat.
- apply Z; assumption.
- rewrite R_dist_sym.
- apply Z; assumption.
- clear - HN He.
- intros n Hn.
- apply HN.
- auto.
-eapply Rle_lt_trans;[|apply H].
-clear -ge_fun_sums_ge n.
-cut (forall n m, (m <= n)%nat -> R_dist (sum_f_R0 f n) (sum_f_R0 f m) <= R_dist (sum_f_R0 g n) (sum_f_R0 g m)).
- intros H.
- destruct (le_lt_dec m n).
- apply H; assumption.
- rewrite R_dist_sym.
- rewrite (R_dist_sym (sum_f_R0 g n)).
- apply H; auto with *.
-clear n m.
-intros n m Hnm.
-unfold R_dist.
-cut (forall i : nat, (1 / 2) ^ i >= 0). intro RPosPow.
-rewrite Rabs_pos_eq.
- rewrite Rabs_pos_eq.
- cut (sum_f_R0 g m - sum_f_R0 f m <= sum_f_R0 g n - sum_f_R0 f n).
- intros; fourier.
- do 2 rewrite <- minus_sum.
- apply (ge_fun_sums_ge m n (fun i : nat => g i - f i) Hnm).
- intro i.
- unfold f, g.
- elim (HP i); intro; ring_simplify; auto with *.
- cut (sum_f_R0 g m <= sum_f_R0 g n).
- intro; fourier.
- apply (ge_fun_sums_ge m n g Hnm).
- intro. unfold g.
- ring_simplify.
- apply Rge_le.
- apply RPosPow.
- cut (sum_f_R0 f m <= sum_f_R0 f n).
- intro; fourier.
- apply (ge_fun_sums_ge m n f Hnm).
- intro; unfold f.
- elim (HP i); intro; simpl.
- apply Rge_le.
- apply RPosPow.
- auto with *.
-intro i.
-apply Rle_ge.
-apply pow_le.
-fourier.
-Qed.
-
-Lemma forall_dec : {forall n, P n} + {~forall n, P n}.
-Proof.
-destruct (cv_cauchy_2 _ cauchy_crit_geometric_dec_fun).
- cut (2 <= x <-> forall n : nat, P n).
- intro H.
- elim (Rle_dec 2 x); intro X.
- left; tauto.
- right; tauto.
-assert (A:Rabs(1/2) < 1) by (apply Rabs_def1; fourier).
-assert (A0:=(GP_infinite (1/2) A)).
-symmetry.
- split; intro.
- replace 2 with (/ (1 - (1 / 2))) by field.
- unfold Pser, infinite_sum in A0.
- eapply Rle_cv_lim;[|unfold Un_cv; apply A0 |apply u].
- intros n.
- clear -n H.
- induction n; unfold f;simpl.
- destruct (HP 0); auto with *.
- elim n; auto.
- apply Rplus_le_compat; auto.
- destruct (HP (S n)); auto with *.
- elim n0; auto.
-intros n.
-destruct (HP n); auto.
-elim (RIneq.Rle_not_lt _ _ H).
-assert (B:0< (1/2)^n).
- apply pow_lt.
- fourier.
-apply Rle_lt_trans with (2-(1/2)^n);[|fourier].
-replace (/(1-1/2))%R with 2 in A0 by field.
-set (g:= fun m => if (eq_nat_dec m n) then (1/2)^n else 0).
-assert (Z: Un_cv (fun N : nat => sum_f_R0 g N) ((1/2)^n)).
- intros e He.
- exists n.
- intros a Ha.
- replace (sum_f_R0 g a) with ((1/2)^n).
- rewrite (R_dist_eq); assumption.
- symmetry.
- cut (forall a : nat, ((a >= n)%nat -> sum_f_R0 g a = (1 / 2) ^ n) /\ ((a < n)%nat -> sum_f_R0 g a = 0))%R.
- intros H0.
- destruct (H0 a).
- auto.
- clear - g.
- induction a.
- split;
- intros H;
- simpl; unfold g;
- destruct (eq_nat_dec 0 n) as [t|f]; try reflexivity.
- elim f; auto with *.
- exfalso; omega.
- destruct IHa as [IHa0 IHa1].
- split;
- intros H;
- simpl; unfold g at 2;
- destruct (eq_nat_dec (S a) n).
- rewrite IHa1.
- ring.
- omega.
- ring_simplify.
- apply IHa0.
- omega.
- exfalso; omega.
- ring_simplify.
- apply IHa1.
- omega.
-assert (C:=CV_minus _ _ _ _ A0 Z).
-eapply Rle_cv_lim;[|apply u |apply C].
-clear - n0 B.
-intros m.
-simpl.
-induction m.
- simpl.
- unfold f, g.
- destruct (eq_nat_dec 0 n).
- destruct (HP 0).
- elim n0.
- congruence.
- clear -n.
- induction n; simpl; fourier.
- destruct (HP); simpl; fourier.
-cut (f (S m) <= 1 * ((1 / 2) ^ (S m)) - g (S m)).
- intros L.
- eapply Rle_trans.
+assert (Hi: (forall n, 0 < INR n + 1)%R).
+ intros n.
+ apply Rle_lt_0_plus_1, pos_INR.
+set (u n := (if HP n then 0 else / (INR n + 1))%R).
+assert (Bu: forall n, (u n <= 1)%R).
+ intros n.
+ unfold u.
+ case HP ; intros _.
+ apply Rle_0_1.
+ rewrite <- S_INR, <- Rinv_1.
+ apply Rinv_le_contravar with (1 := Rlt_0_1).
+ apply (le_INR 1), le_n_S, le_0_n.
+set (E y := exists n, y = u n).
+destruct (completeness E) as [l [ub lub]].
+ exists R1.
+ intros y [n ->].
+ apply Bu.
+ exists (u O).
+ now exists O.
+assert (Hnp: forall n, not (P n) -> ((/ (INR n + 1) <= l)%R)).
+ intros n Hp.
+ apply ub.
+ exists n.
+ unfold u.
+ now destruct (HP n).
+destruct (Rle_lt_dec l 0) as [Hl|Hl].
+ right.
+ intros n.
+ destruct (HP n) as [H|H].
+ exact H.
+ exfalso.
+ apply Rle_not_lt with (1 := Hl).
+ apply Rlt_le_trans with (/ (INR n + 1))%R.
+ now apply Rinv_0_lt_compat.
+ now apply Hnp.
+left.
+set (N := Zabs_nat (up (/l) - 2)).
+assert (H1l: (1 <= /l)%R).
+ rewrite <- Rinv_1.
+ apply Rinv_le_contravar with (1 := Hl).
+ apply lub.
+ now intros y [m ->].
+assert (HN: (INR N + 1 = IZR (up (/ l)) - 1)%R).
+ unfold N.
+ rewrite INR_IZR_INZ.
+ rewrite inj_Zabs_nat.
+ replace (IZR (up (/ l)) - 1)%R with (IZR (up (/ l) - 2) + 1)%R.
+ apply (f_equal (fun v => IZR v + 1)%R).
+ apply Zabs_eq.
+ apply Zle_minus_le_0.
+ apply (Zlt_le_succ 1).
+ apply lt_IZR.
+ apply Rle_lt_trans with (1 := H1l).
+ apply archimed.
+ rewrite minus_IZR.
simpl.
- apply Rplus_le_compat.
- apply IHm.
- apply L.
- simpl; fourier.
-unfold f, g.
-destruct (eq_nat_dec (S m) n).
- destruct (HP (S m)).
- elim n0.
- congruence.
- rewrite e.
- fourier.
-destruct (HP (S m)).
- fourier.
+ ring.
+assert (Hl': (/ (INR (S N) + 1) < l)%R).
+ rewrite <- (Rinv_involutive l) by now apply Rgt_not_eq.
+ apply Rinv_1_lt_contravar with (1 := H1l).
+ rewrite S_INR.
+ rewrite HN.
+ ring_simplify.
+ apply archimed.
+exists N.
+intros H.
+apply Rle_not_lt with (2 := Hl').
+apply lub.
+intros y [n ->].
+unfold u.
+destruct (HP n) as [_|Hp].
+ apply Rlt_le.
+ now apply Rinv_0_lt_compat.
+apply Rinv_le_contravar.
+apply Hi.
+apply Rplus_le_compat_r.
+apply le_INR.
+destruct (le_or_lt n N) as [Hn|Hn].
+ 2: now apply lt_le_S.
+exfalso.
+destruct (le_lt_or_eq _ _ Hn) as [Hn'| ->].
+2: now apply Hp.
+apply Rlt_not_le with (2 := Hnp _ Hp).
+rewrite <- (Rinv_involutive l) by now apply Rgt_not_eq.
+apply Rinv_1_lt_contravar.
+rewrite <- S_INR.
+apply (le_INR 1), le_n_S, le_0_n.
+apply Rlt_le_trans with (INR N + 1)%R.
+apply Rplus_lt_compat_r.
+now apply lt_INR.
+rewrite HN.
+apply Rplus_le_reg_r with (-/l + 1)%R.
ring_simplify.
-apply pow_le.
-fourier.
-Qed.
-
-Lemma sig_forall_dec : {n | ~P n}+{forall n, P n}.
-Proof.
-destruct forall_dec.
- right; assumption.
-left.
-apply constructive_indefinite_ground_description_nat; auto.
- clear - HP.
- firstorder.
-apply Classical_Pred_Type.not_all_ex_not.
-assumption.
+apply archimed.
Qed.
End Arithmetical_dec.
-(** 2- Derivability of the Archimedean axiom *)
+(** * Derivability of the Archimedean axiom *)
-(* This is a standard proof (it has been taken from PlanetMath). It is
+(** This is a standard proof (it has been taken from PlanetMath). It is
formulated negatively so as to avoid the need for classical
-logic. Using a proof of {n | ~P n}+{forall n, P n} (the one above or a
-variant of it that does not need classical axioms) , we can in
-principle also derive [up] and its [specification] *)
+logic. Using a proof of [{n | ~P n}+{forall n, P n}], we can in
+principle also derive [up] and its specification. The proof above
+cannot be used for that purpose, since it relies on the [archimed] axiom. *)
Theorem not_not_archimedean :
forall r : R, ~ (forall n : nat, (INR n <= r)%R).
@@ -296,3 +172,33 @@ rewrite (Rplus_comm (INR n) 0) in H6.
rewrite Rplus_0_l in H6.
assumption.
Qed.
+
+(** * Decidability of negated formulas *)
+
+Lemma sig_not_dec : forall P : Prop, {not (not P)} + {not P}.
+Proof.
+intros P.
+set (E := fun x => x = R0 \/ (x = R1 /\ P)).
+destruct (completeness E) as [x H].
+ exists R1.
+ intros x [->|[-> _]].
+ apply Rle_0_1.
+ apply Rle_refl.
+ exists R0.
+ now left.
+destruct (Rle_lt_dec 1 x) as [H'|H'].
+- left.
+ intros HP.
+ elim Rle_not_lt with (1 := H').
+ apply Rle_lt_trans with (2 := Rlt_0_1).
+ apply H.
+ intros y [->|[_ Hy]].
+ apply Rle_refl.
+ now elim HP.
+- right.
+ intros HP.
+ apply Rlt_not_le with (1 := H').
+ apply H.
+ right.
+ now split.
+Qed.
diff --git a/theories/Reals/Rminmax.v b/theories/Reals/Rminmax.v
index 9121ccc2..ba1fe90f 100644
--- a/theories/Reals/Rminmax.v
+++ b/theories/Reals/Rminmax.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Reals/Rpow_def.v b/theories/Reals/Rpow_def.v
index 0116e29a..1d697f3c 100644
--- a/theories/Reals/Rpow_def.v
+++ b/theories/Reals/Rpow_def.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Reals/Rpower.v b/theories/Reals/Rpower.v
index 014d7025..e30ea334 100644
--- a/theories/Reals/Rpower.v
+++ b/theories/Reals/Rpower.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -20,8 +20,10 @@ Require Import Ranalysis1.
Require Import Exp_prop.
Require Import Rsqrt_def.
Require Import R_sqrt.
+Require Import Sqrt_reg.
Require Import MVT.
Require Import Ranalysis4.
+Require Import Fourier.
Local Open Scope R_scope.
Lemma P_Rmin : forall (P:R -> Prop) (x y:R), P x -> P y -> P (Rmin x y).
@@ -43,7 +45,7 @@ Proof.
rewrite Rmult_1_r; rewrite <- (Rmult_comm 3); rewrite <- Rmult_assoc;
rewrite <- Rinv_l_sym.
rewrite Rmult_1_l; replace (/ exp 1) with (exp (-1)).
- unfold exp; case (exist_exp (-1)); intros; simpl;
+ unfold exp; case (exist_exp (-1)) as (?,e); simpl in |- *;
unfold exp_in in e;
assert (H := alternated_series_ineq (fun i:nat => / INR (fact i)) x 1).
cut
@@ -137,7 +139,7 @@ Qed.
Lemma exp_ineq1 : forall x:R, 0 < x -> 1 + x < exp x.
Proof.
- intros; apply Rplus_lt_reg_r with (- exp 0); rewrite <- (Rplus_comm (exp x));
+ intros; apply Rplus_lt_reg_l with (- exp 0); rewrite <- (Rplus_comm (exp x));
assert (H0 := MVT_cor1 exp 0 x derivable_exp H); elim H0;
intros; elim H1; intros; unfold Rminus in H2; rewrite H2;
rewrite Ropp_0; rewrite Rplus_0_r;
@@ -178,13 +180,13 @@ Qed.
(**********)
Lemma ln_exists : forall y:R, 0 < y -> { z:R | y = exp z }.
Proof.
- intros; case (Rle_dec 1 y); intro.
- apply (ln_exists1 _ r).
+ intros; destruct (Rle_dec 1 y) as [Hle|Hnle].
+ apply (ln_exists1 _ Hle).
assert (H0 : 1 <= / y).
apply Rmult_le_reg_l with y.
apply H.
rewrite <- Rinv_r_sym.
- rewrite Rmult_1_r; left; apply (Rnot_le_lt _ _ n).
+ rewrite Rmult_1_r; left; apply (Rnot_le_lt _ _ Hnle).
red; intro; rewrite H0 in H; elim (Rlt_irrefl _ H).
destruct (ln_exists1 _ H0) as (x,p); exists (- x);
apply Rmult_eq_reg_l with (exp x / y).
@@ -213,12 +215,10 @@ Definition ln (x:R) : R :=
Lemma exp_ln : forall x:R, 0 < x -> exp (ln x) = x.
Proof.
- intros; unfold ln; case (Rlt_dec 0 x); intro.
+ intros; unfold ln; decide (Rlt_dec 0 x) with H.
unfold Rln;
- case (ln_exists (mkposreal x r) (cond_pos (mkposreal x r)));
- intros.
- simpl in e; symmetry ; apply e.
- elim n; apply H.
+ case (ln_exists (mkposreal x H) (cond_pos (mkposreal x H))) as (?,Hex).
+ symmetry; apply Hex.
Qed.
Theorem exp_inv : forall x y:R, exp x = exp y -> x = y.
@@ -313,12 +313,12 @@ Proof.
red; apply P_Rmin.
apply Rmult_lt_0_compat.
assumption.
- apply Rplus_lt_reg_r with 1.
+ apply Rplus_lt_reg_l with 1.
rewrite Rplus_0_r; replace (1 + (exp eps - 1)) with (exp eps);
[ apply H1 | ring ].
apply Rmult_lt_0_compat.
assumption.
- apply Rplus_lt_reg_r with (exp (- eps)).
+ apply Rplus_lt_reg_l with (exp (- eps)).
rewrite Rplus_0_r; replace (exp (- eps) + (1 - exp (- eps))) with 1;
[ apply H2 | ring ].
unfold dist, R_met, R_dist; simpl.
@@ -335,7 +335,7 @@ Proof.
apply H.
rewrite Hxyy.
apply Ropp_lt_cancel.
- apply Rplus_lt_reg_r with (r := y).
+ apply Rplus_lt_reg_l with (r := y).
replace (y + - (y * exp (- eps))) with (y * (1 - exp (- eps)));
[ idtac | ring ].
replace (y + - x) with (Rabs (x - y)).
@@ -358,7 +358,7 @@ Proof.
apply Rmult_lt_reg_l with (r := y).
apply H.
rewrite Hxyy.
- apply Rplus_lt_reg_r with (r := - y).
+ apply Rplus_lt_reg_l with (r := - y).
replace (- y + y * exp eps) with (y * (exp eps - 1)); [ idtac | ring ].
replace (- y + x) with (Rabs (x - y)).
apply Rlt_le_trans with (1 := H5); apply Rmin_l.
@@ -610,7 +610,7 @@ Proof.
replace h with (x + h - x); [ idtac | ring ].
apply H3; split.
unfold D_x; split.
- case (Rcase_abs h); intro.
+ destruct (Rcase_abs h) as [Hlt|Hgt].
assert (H7 : Rabs h < x / 2).
apply Rlt_le_trans with alp.
apply H6.
@@ -619,13 +619,13 @@ Proof.
unfold Rdiv; apply Rmult_lt_0_compat;
[ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
rewrite Rabs_left in H7.
- apply Rplus_lt_reg_r with (- h - x / 2).
+ apply Rplus_lt_reg_l with (- h - x / 2).
replace (- h - x / 2 + x / 2) with (- h); [ idtac | ring ].
pattern x at 2; rewrite double_var.
replace (- h - x / 2 + (x / 2 + x / 2 + h)) with (x / 2); [ apply H7 | ring ].
- apply r.
- apply Rplus_lt_le_0_compat; [ assumption | apply Rge_le; apply r ].
- apply (not_eq_sym (A:=R)); apply Rminus_not_eq; replace (x + h - x) with h;
+ apply Hlt.
+ apply Rplus_lt_le_0_compat; [ assumption | apply Rge_le; apply Hgt ].
+ apply (sym_not_eq (A:=R)); apply Rminus_not_eq; replace (x + h - x) with h;
[ apply H5 | ring ].
replace (x + h - x) with h;
[ apply Rlt_le_trans with alp;
@@ -703,3 +703,128 @@ Proof.
ring.
apply derivable_pt_lim_exp.
Qed.
+
+(* added later. *)
+
+Lemma Rpower_mult_distr :
+ forall x y z, 0 < x -> 0 < y ->
+ Rpower x z * Rpower y z = Rpower (x * y) z.
+intros x y z x0 y0; unfold Rpower.
+rewrite <- exp_plus, ln_mult, Rmult_plus_distr_l; auto.
+Qed.
+
+Lemma Rle_Rpower_l a b c: 0 <= c -> 0 < a <= b -> Rpower a c <= Rpower b c.
+Proof.
+intros [c0 | c0];
+ [ | intros; rewrite <- c0, !Rpower_O; [apply Rle_refl | |] ].
+ intros [a0 [ab|ab]].
+ left; apply exp_increasing.
+ now apply Rmult_lt_compat_l; auto; apply ln_increasing; fourier.
+ rewrite ab; apply Rle_refl.
+ apply Rlt_le_trans with a; tauto.
+tauto.
+Qed.
+
+(* arcsinh function *)
+
+Definition arcsinh x := ln (x + sqrt (x ^ 2 + 1)).
+
+Lemma arcsinh_sinh : forall x, arcsinh (sinh x) = x.
+intros x; unfold sinh, arcsinh.
+assert (Rminus_eq_0 : forall r, r - r = 0) by (intros; ring).
+pattern 1 at 5; rewrite <- exp_0, <- (Rminus_eq_0 x); unfold Rminus.
+rewrite exp_plus.
+match goal with |- context[sqrt ?a] =>
+ replace a with (((exp x + exp(-x))/2)^2) by field
+end.
+rewrite sqrt_pow2;
+ [|apply Rlt_le, Rmult_lt_0_compat;[apply Rplus_lt_0_compat; apply exp_pos |
+ apply Rinv_0_lt_compat, Rlt_0_2]].
+match goal with |- context[ln ?a] => replace a with (exp x) by field end.
+rewrite ln_exp; reflexivity.
+Qed.
+
+Lemma sinh_arcsinh x : sinh (arcsinh x) = x.
+unfold sinh, arcsinh.
+assert (cmp : 0 < x + sqrt (x ^ 2 + 1)).
+ destruct (Rle_dec x 0).
+ replace (x ^ 2) with ((-x) ^ 2) by ring.
+ assert (sqrt ((- x) ^ 2) < sqrt ((-x)^2+1)).
+ apply sqrt_lt_1_alt.
+ split;[apply pow_le | ]; fourier.
+ pattern x at 1; replace x with (- (sqrt ((- x) ^ 2))).
+ assert (t:= sqrt_pos ((-x)^2)); fourier.
+ simpl; rewrite Rmult_1_r, sqrt_square, Ropp_involutive;[reflexivity | fourier].
+ apply Rplus_lt_le_0_compat;[apply Rnot_le_gt; assumption | apply sqrt_pos].
+rewrite exp_ln;[ | assumption].
+rewrite exp_Ropp, exp_ln;[ | assumption].
+assert (Rmult_minus_distr_r :
+ forall x y z, (x - y) * z = x * z - y * z) by (intros; ring).
+apply Rminus_diag_uniq; unfold Rdiv; rewrite Rmult_minus_distr_r.
+assert (t: forall x y z, x - z = y -> x - y - z = 0);[ | apply t; clear t].
+ intros a b c H; rewrite <- H; ring.
+apply Rmult_eq_reg_l with (2 * (x + sqrt (x ^ 2 + 1)));[ |
+ apply Rgt_not_eq, Rmult_lt_0_compat;[apply Rlt_0_2 | assumption]].
+assert (pow2_sqrt : forall x, 0 <= x -> sqrt x ^ 2 = x) by
+ (intros; simpl; rewrite Rmult_1_r, sqrt_sqrt; auto).
+field_simplify;[rewrite pow2_sqrt;[field | ] | apply Rgt_not_eq; fourier].
+apply Rplus_le_le_0_compat;[simpl; rewrite Rmult_1_r; apply (Rle_0_sqr x)|apply Rlt_le, Rlt_0_1].
+Qed.
+
+Lemma derivable_pt_lim_arcsinh :
+ forall x, derivable_pt_lim arcsinh x (/sqrt (x ^ 2 + 1)).
+intros x; unfold arcsinh.
+assert (0 < x + sqrt (x ^ 2 + 1)).
+ destruct (Rle_dec x 0);
+ [ | assert (0 < x) by (apply Rnot_le_gt; assumption);
+ apply Rplus_lt_le_0_compat; auto; apply sqrt_pos].
+ replace (x ^ 2) with ((-x) ^ 2) by ring.
+ assert (sqrt ((- x) ^ 2) < sqrt ((-x)^2+1)).
+ apply sqrt_lt_1_alt.
+ split;[apply pow_le|]; fourier.
+ pattern x at 1; replace x with (- (sqrt ((- x) ^ 2))).
+ assert (t:= sqrt_pos ((-x)^2)); fourier.
+ simpl; rewrite Rmult_1_r, sqrt_square, Ropp_involutive; auto; fourier.
+assert (0 < x ^ 2 + 1).
+ apply Rplus_le_lt_0_compat;[simpl; rewrite Rmult_1_r; apply Rle_0_sqr|fourier].
+replace (/sqrt (x ^ 2 + 1)) with
+ (/(x + sqrt (x ^ 2 + 1)) *
+ (1 + (/(2 * sqrt (x ^ 2 + 1)) * (INR 2 * x ^ 1 + 0)))).
+apply (derivable_pt_lim_comp (fun x => x + sqrt (x ^ 2 + 1)) ln).
+ apply (derivable_pt_lim_plus).
+ apply derivable_pt_lim_id.
+ apply (derivable_pt_lim_comp (fun x => x ^ 2 + 1) sqrt x).
+ apply derivable_pt_lim_plus.
+ apply derivable_pt_lim_pow.
+ apply derivable_pt_lim_const.
+ apply derivable_pt_lim_sqrt; assumption.
+ apply derivable_pt_lim_ln; assumption.
+ replace (INR 2 * x ^ 1 + 0) with (2 * x) by (simpl; ring).
+replace (1 + / (2 * sqrt (x ^ 2 + 1)) * (2 * x)) with
+ (((sqrt (x ^ 2 + 1) + x))/sqrt (x ^ 2 + 1));
+ [ | field; apply Rgt_not_eq, sqrt_lt_R0; assumption].
+apply Rmult_eq_reg_l with (x + sqrt (x ^ 2 + 1));
+ [ | apply Rgt_not_eq; assumption].
+rewrite <- Rmult_assoc, Rinv_r;[field | ]; apply Rgt_not_eq; auto;
+ apply sqrt_lt_R0; assumption.
+Qed.
+
+Lemma arcsinh_lt : forall x y, x < y -> arcsinh x < arcsinh y.
+intros x y xy.
+case (Rle_dec (arcsinh y) (arcsinh x));[ | apply Rnot_le_lt ].
+intros abs; case (Rlt_not_le _ _ xy).
+rewrite <- (sinh_arcsinh y), <- (sinh_arcsinh x).
+destruct abs as [lt | q];[| rewrite q; fourier].
+apply Rlt_le, sinh_lt; assumption.
+Qed.
+
+Lemma arcsinh_le : forall x y, x <= y -> arcsinh x <= arcsinh y.
+intros x y [xy | xqy].
+ apply Rlt_le, arcsinh_lt; assumption.
+rewrite xqy; apply Rle_refl.
+Qed.
+
+Lemma arcsinh_0 : arcsinh 0 = 0.
+ unfold arcsinh; rewrite pow_ne_zero, !Rplus_0_l, sqrt_1, ln_1;
+ [reflexivity | discriminate].
+Qed.
diff --git a/theories/Reals/Rprod.v b/theories/Reals/Rprod.v
index 341ec8fd..1ee9410f 100644
--- a/theories/Reals/Rprod.v
+++ b/theories/Reals/Rprod.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -12,6 +12,7 @@ Require Import Rfunctions.
Require Import Rseries.
Require Import PartSum.
Require Import Binomial.
+Require Import Omega.
Local Open Scope R_scope.
(** TT Ak; 0<=k<=N *)
diff --git a/theories/Reals/Rseries.v b/theories/Reals/Rseries.v
index c540a931..fd16ea61 100644
--- a/theories/Reals/Rseries.v
+++ b/theories/Reals/Rseries.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -108,7 +108,7 @@ Section sequence.
intros n H4.
unfold R_dist.
rewrite Rabs_left1, Ropp_minus_distr.
- apply Rplus_lt_reg_r with (Un n - eps).
+ apply Rplus_lt_reg_l with (Un n - eps).
apply Rlt_le_trans with (Un N).
now replace (Un n - eps + (l - Un n)) with (l - eps) by ring.
replace (Un n - eps + eps) with (Un n) by ring.
@@ -171,7 +171,7 @@ Section sequence.
rewrite H1.
apply Rle_trans with (1 := proj2 (Hsum n)).
apply Rlt_le.
- apply Rplus_lt_reg_r with ((/2)^n - 1).
+ apply Rplus_lt_reg_l with ((/2)^n - 1).
now ring_simplify.
exists 0. now exists O.
@@ -202,7 +202,7 @@ Section sequence.
refine (False_ind _ (Rle_not_lt _ _ (H (l - eps) _) _)).
intros x (n, H1).
now rewrite H1.
- apply Rplus_lt_reg_r with (eps - l).
+ apply Rplus_lt_reg_l with (eps - l).
now ring_simplify.
assert (Rabs (/2) < 1).
@@ -237,9 +237,9 @@ Section sequence.
apply le_n_Sn.
rewrite (IHN H6), Rplus_0_l.
unfold test.
- destruct Rle_lt_dec.
+ destruct Rle_lt_dec as [Hle|Hlt].
apply eq_refl.
- now elim Rlt_not_le with (1 := r).
+ now elim Rlt_not_le with (1 := Hlt).
destruct (le_or_lt N n) as [Hn|Hn].
rewrite le_plus_minus with (1 := Hn).
@@ -247,7 +247,7 @@ Section sequence.
rewrite Hs, Rplus_0_l.
set (k := (N + (n - N))%nat).
apply Rlt_le.
- apply Rplus_lt_reg_r with ((/2)^k - (/2)^N).
+ apply Rplus_lt_reg_l with ((/2)^k - (/2)^N).
now ring_simplify.
apply Rle_trans with (sum N).
rewrite le_plus_minus with (1 := Hn).
@@ -261,7 +261,7 @@ Section sequence.
Lemma Un_cv_crit : Un_growing -> bound EUn -> exists l : R, Un_cv l.
Proof.
intros Hug Heub.
- exists (projT1 (completeness EUn Heub EUn_noempty)).
+ exists (proj1_sig (completeness EUn Heub EUn_noempty)).
destruct (completeness EUn Heub EUn_noempty) as (l, H).
now apply Un_cv_crit_lub.
Qed.
@@ -404,3 +404,26 @@ Proof.
apply Rinv_neq_0_compat.
assumption.
Qed.
+
+(* Convergence is preserved after shifting the indices. *)
+Lemma CV_shift :
+ forall f k l, Un_cv (fun n => f (n + k)%nat) l -> Un_cv f l.
+intros f' k l cvfk eps ep; destruct (cvfk eps ep) as [N Pn].
+exists (N + k)%nat; intros n nN; assert (tmp: (n = (n - k) + k)%nat).
+ rewrite Nat.sub_add;[ | apply le_trans with (N + k)%nat]; auto with arith.
+rewrite tmp; apply Pn; apply Nat.le_add_le_sub_r; assumption.
+Qed.
+
+Lemma CV_shift' :
+ forall f k l, Un_cv f l -> Un_cv (fun n => f (n + k)%nat) l.
+intros f' k l cvf eps ep; destruct (cvf eps ep) as [N Pn].
+exists N; intros n nN; apply Pn; auto with arith.
+Qed.
+
+(* Growing property is preserved after shifting the indices (one way only) *)
+
+Lemma Un_growing_shift :
+ forall k un, Un_growing un -> Un_growing (fun n => un (n + k)%nat).
+Proof.
+intros k un P n; apply P.
+Qed.
diff --git a/theories/Reals/Rsigma.v b/theories/Reals/Rsigma.v
index 0dcb4b25..458d1f8c 100644
--- a/theories/Reals/Rsigma.v
+++ b/theories/Reals/Rsigma.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -10,6 +10,7 @@ Require Import Rbase.
Require Import Rfunctions.
Require Import Rseries.
Require Import PartSum.
+Require Import Omega.
Local Open Scope R_scope.
Set Implicit Arguments.
diff --git a/theories/Reals/Rsqrt_def.v b/theories/Reals/Rsqrt_def.v
index 307035ab..b8ec8d3c 100644
--- a/theories/Reals/Rsqrt_def.v
+++ b/theories/Reals/Rsqrt_def.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -276,8 +276,7 @@ Proof.
intros.
unfold cv_infty.
intro.
- case (total_order_T 0 M); intro.
- elim s; intro.
+ destruct (total_order_T 0 M) as [[Hlt|<-]|Hgt].
set (N := up M).
cut (0 <= N)%Z.
intro.
@@ -302,7 +301,6 @@ Proof.
assert (H0 := archimed M); elim H0; intros.
left; apply Rlt_trans with M; assumption.
exists 0%nat; intros.
- rewrite <- b.
unfold pow_2_n; apply pow_lt; prove_sup0.
exists 0%nat; intros.
apply Rlt_trans with 0.
@@ -342,8 +340,7 @@ Proof.
unfold Un_cv; unfold R_dist.
intros.
assert (H4 := cv_infty_cv_R0 pow_2_n pow_2_n_neq_R0 pow_2_n_infty).
- case (total_order_T x y); intro.
- elim s; intro.
+ destruct (total_order_T x y) as [[ Hlt | -> ]|Hgt].
unfold Un_cv in H4; unfold R_dist in H4.
cut (0 < y - x).
intro Hyp.
@@ -373,19 +370,18 @@ Proof.
assumption.
unfold Rdiv; apply Rmult_lt_0_compat;
[ assumption | apply Rinv_0_lt_compat; assumption ].
- apply Rplus_lt_reg_r with x; rewrite Rplus_0_r.
+ apply Rplus_lt_reg_l with x; rewrite Rplus_0_r.
replace (x + (y - x)) with y; [ assumption | ring ].
exists 0%nat; intros.
- replace (dicho_lb x y P n - dicho_up x y P n - 0) with
- (dicho_lb x y P n - dicho_up x y P n); [ idtac | ring ].
+ replace (dicho_lb y y P n - dicho_up y y P n - 0) with
+ (dicho_lb y y P n - dicho_up y y P n); [ idtac | ring ].
rewrite <- Rabs_Ropp.
rewrite Ropp_minus_distr'.
rewrite dicho_lb_dicho_up.
- rewrite b.
unfold Rminus, Rdiv; rewrite Rplus_opp_r; rewrite Rmult_0_l;
rewrite Rabs_R0; assumption.
assumption.
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)).
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H Hgt)).
Qed.
Definition cond_positivity (x:R) : bool :=
@@ -427,18 +423,15 @@ Lemma dicho_lb_car :
P x = false -> P (dicho_lb x y P n) = false.
Proof.
intros.
- induction n as [| n Hrecn].
- simpl.
- assumption.
- simpl.
- assert
- (X :=
- sumbool_of_bool (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2))).
- elim X; intro.
- rewrite a.
- unfold dicho_lb in Hrecn; assumption.
- rewrite b.
- assumption.
+ induction n as [| n Hrecn].
+ - assumption.
+ - simpl.
+ destruct
+ (sumbool_of_bool (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2))) as [Heq|Heq].
+ + rewrite Heq.
+ unfold dicho_lb in Hrecn; assumption.
+ + rewrite Heq.
+ assumption.
Qed.
Lemma dicho_up_car :
@@ -446,18 +439,23 @@ Lemma dicho_up_car :
P y = true -> P (dicho_up x y P n) = true.
Proof.
intros.
- induction n as [| n Hrecn].
- simpl.
- assumption.
- simpl.
- assert
- (X :=
- sumbool_of_bool (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2))).
- elim X; intro.
- rewrite a.
- unfold dicho_lb in Hrecn; assumption.
- rewrite b.
- assumption.
+ induction n as [| n Hrecn].
+ - assumption.
+ - simpl.
+ destruct
+ (sumbool_of_bool (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2))) as [Heq|Heq].
+ + rewrite Heq.
+ unfold dicho_lb in Hrecn; assumption.
+ + rewrite Heq.
+ assumption.
+Qed.
+
+(* A general purpose corollary. *)
+Lemma cv_pow_half : forall a, Un_cv (fun n => a/2^n) 0.
+intros a; unfold Rdiv; replace 0 with (a * 0) by ring.
+apply CV_mult.
+ intros eps ep; exists 0%nat; rewrite R_dist_eq; intros n _; assumption.
+exact (cv_infty_cv_R0 pow_2_n pow_2_n_neq_R0 pow_2_n_infty).
Qed.
(** Intermediate Value Theorem *)
@@ -467,13 +465,9 @@ Lemma IVT :
x < y -> f x < 0 -> 0 < f y -> { z:R | x <= z <= y /\ f z = 0 }.
Proof.
intros.
- cut (x <= y).
- intro.
- generalize (dicho_lb_cv x y (fun z:R => cond_positivity (f z)) H3).
- generalize (dicho_up_cv x y (fun z:R => cond_positivity (f z)) H3).
- intros X X0.
- elim X; intros.
- elim X0; intros.
+ assert (x <= y) by (left; assumption).
+ destruct (dicho_lb_cv x y (fun z:R => cond_positivity (f z)) H3) as (x1,p0).
+ destruct (dicho_up_cv x y (fun z:R => cond_positivity (f z)) H3) as (x0,p).
assert (H4 := cv_dicho _ _ _ _ _ H3 p0 p).
rewrite H4 in p0.
exists x0.
@@ -490,7 +484,6 @@ Proof.
apply dicho_up_decreasing; assumption.
assumption.
right; reflexivity.
- 2: left; assumption.
set (Vn := fun n:nat => dicho_lb x y (fun z:R => cond_positivity (f z)) n).
set (Wn := fun n:nat => dicho_up x y (fun z:R => cond_positivity (f z)) n).
cut ((forall n:nat, f (Vn n) <= 0) -> f x0 <= 0).
@@ -515,14 +508,14 @@ Proof.
left; assumption.
intro.
unfold cond_positivity.
- case (Rle_dec 0 z); intro.
+ case (Rle_dec 0 z) as [Hle|Hnle].
split.
intro; assumption.
intro; reflexivity.
split.
intro feqt;discriminate feqt.
intro.
- elim n0; assumption.
+ contradiction.
unfold Vn.
cut (forall z:R, cond_positivity z = false <-> z < 0).
intros.
@@ -536,20 +529,19 @@ Proof.
assumption.
intro.
unfold cond_positivity.
- case (Rle_dec 0 z); intro.
+ case (Rle_dec 0 z) as [Hle|Hnle].
split.
intro feqt; discriminate feqt.
- intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H7)).
+ intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ Hle H7)).
split.
intro; auto with real.
intro; reflexivity.
cut (Un_cv Wn x0).
intros.
assert (H7 := continuity_seq f Wn x0 (H x0) H5).
- case (total_order_T 0 (f x0)); intro.
- elim s; intro.
+ destruct (total_order_T 0 (f x0)) as [[Hlt|<-]|Hgt].
left; assumption.
- rewrite <- b; right; reflexivity.
+ right; reflexivity.
unfold Un_cv in H7; unfold R_dist in H7.
cut (0 < - f x0).
intro.
@@ -559,7 +551,7 @@ Proof.
rewrite Rabs_right in H11.
pattern (- f x0) at 1 in H11; rewrite <- Rplus_0_r in H11.
unfold Rminus in H11; rewrite (Rplus_comm (f (Wn x2))) in H11.
- assert (H12 := Rplus_lt_reg_r _ _ _ H11).
+ assert (H12 := Rplus_lt_reg_l _ _ _ H11).
assert (H13 := H6 x2).
elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H13 H12)).
apply Rle_ge; left; unfold Rminus; apply Rplus_le_lt_0_compat.
@@ -570,29 +562,28 @@ Proof.
cut (Un_cv Vn x0).
intros.
assert (H7 := continuity_seq f Vn x0 (H x0) H5).
- case (total_order_T 0 (f x0)); intro.
- elim s; intro.
+ destruct (total_order_T 0 (f x0)) as [[Hlt|<-]|Hgt].
unfold Un_cv in H7; unfold R_dist in H7.
- elim (H7 (f x0) a); intros.
+ elim (H7 (f x0) Hlt); intros.
cut (x2 >= x2)%nat; [ intro | unfold ge; apply le_n ].
assert (H10 := H8 x2 H9).
rewrite Rabs_left in H10.
pattern (f x0) at 2 in H10; rewrite <- Rplus_0_r in H10.
rewrite Ropp_minus_distr' in H10.
unfold Rminus in H10.
- assert (H11 := Rplus_lt_reg_r _ _ _ H10).
+ assert (H11 := Rplus_lt_reg_l _ _ _ H10).
assert (H12 := H6 x2).
cut (0 < f (Vn x2)).
intro.
elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H13 H12)).
rewrite <- (Ropp_involutive (f (Vn x2))).
apply Ropp_0_gt_lt_contravar; assumption.
- apply Rplus_lt_reg_r with (f x0 - f (Vn x2)).
+ apply Rplus_lt_reg_l with (f x0 - f (Vn x2)).
rewrite Rplus_0_r; replace (f x0 - f (Vn x2) + (f (Vn x2) - f x0)) with 0;
[ unfold Rminus; apply Rplus_lt_le_0_compat | ring ].
assumption.
apply Ropp_0_ge_le_contravar; apply Rle_ge; apply H6.
- right; rewrite <- b; reflexivity.
+ right; reflexivity.
left; assumption.
unfold Vn; assumption.
Qed.
@@ -603,31 +594,23 @@ Lemma IVT_cor :
x <= y -> f x * f y <= 0 -> { z:R | x <= z <= y /\ f z = 0 }.
Proof.
intros.
- case (total_order_T 0 (f x)); intro.
- case (total_order_T 0 (f y)); intro.
- elim s; intro.
- elim s0; intro.
+ destruct (total_order_T 0 (f x)) as [[Hltx|Heqx]|Hgtx].
+ destruct (total_order_T 0 (f y)) as [[Hlty|Heqy]|Hgty].
cut (0 < f x * f y);
[ intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H1 H2))
| apply Rmult_lt_0_compat; assumption ].
exists y.
split.
split; [ assumption | right; reflexivity ].
- symmetry ; exact b.
- exists x.
- split.
- split; [ right; reflexivity | assumption ].
- symmetry ; exact b.
- elim s; intro.
+ symmetry ; exact Heqy.
cut (x < y).
intro.
assert (H3 := IVT (- f)%F x y (continuity_opp f H) H2).
cut ((- f)%F x < 0).
cut (0 < (- f)%F y).
intros.
- elim (H3 H5 H4); intros.
+ destruct (H3 H5 H4) as (x0,[]).
exists x0.
- elim p; intros.
split.
assumption.
unfold opp_fct in H7.
@@ -635,25 +618,24 @@ Proof.
apply Ropp_eq_0_compat; assumption.
unfold opp_fct; apply Ropp_0_gt_lt_contravar; assumption.
unfold opp_fct.
- apply Rplus_lt_reg_r with (f x); rewrite Rplus_opp_r; rewrite Rplus_0_r;
+ apply Rplus_lt_reg_l with (f x); rewrite Rplus_opp_r; rewrite Rplus_0_r;
assumption.
inversion H0.
assumption.
- rewrite H2 in a.
- elim (Rlt_irrefl _ (Rlt_trans _ _ _ r a)).
+ rewrite H2 in Hltx.
+ elim (Rlt_irrefl _ (Rlt_trans _ _ _ Hgty Hltx)).
exists x.
split.
split; [ right; reflexivity | assumption ].
symmetry ; assumption.
- case (total_order_T 0 (f y)); intro.
- elim s; intro.
+ destruct (total_order_T 0 (f y)) as [[Hlty|Heqy]|Hgty].
cut (x < y).
intro.
apply IVT; assumption.
inversion H0.
assumption.
- rewrite H2 in r.
- elim (Rlt_irrefl _ (Rlt_trans _ _ _ r a)).
+ rewrite H2 in Hgtx.
+ elim (Rlt_irrefl _ (Rlt_trans _ _ _ Hlty Hgtx)).
exists y.
split.
split; [ assumption | right; reflexivity ].
@@ -676,8 +658,7 @@ Proof.
intro.
cut (continuity f).
intro.
- case (total_order_T y 1); intro.
- elim s; intro.
+ destruct (total_order_T y 1) as [[Hlt| -> ]|Hgt].
cut (0 <= f 1).
intro.
cut (f 0 * f 1 <= 0).
@@ -701,7 +682,7 @@ Proof.
exists 1.
split.
left; apply Rlt_0_1.
- rewrite b; symmetry ; apply Rsqr_1.
+ symmetry; apply Rsqr_1.
cut (0 <= f y).
intro.
cut (f 0 * f y <= 0).
@@ -723,7 +704,7 @@ Proof.
pattern y at 1; rewrite <- Rmult_1_r.
unfold Rsqr; apply Rmult_le_compat_l.
assumption.
- left; exact r.
+ left; exact Hgt.
replace f with (Rsqr - fct_cte y)%F.
apply continuity_minus.
apply derivable_continuous; apply derivable_Rsqr.
@@ -743,39 +724,31 @@ Definition Rsqrt (y:nonnegreal) : R :=
Lemma Rsqrt_positivity : forall x:nonnegreal, 0 <= Rsqrt x.
Proof.
intro.
- assert (X := Rsqrt_exists (nonneg x) (cond_nonneg x)).
- elim X; intros.
+ destruct (Rsqrt_exists (nonneg x) (cond_nonneg x)) as (x0 & H1 & H2).
cut (x0 = Rsqrt x).
intros.
- elim p; intros.
- rewrite H in H0; assumption.
+ rewrite <- H; assumption.
unfold Rsqrt.
- case (Rsqrt_exists x (cond_nonneg x)).
- intros.
- elim p; elim a; intros.
+ case (Rsqrt_exists x (cond_nonneg x)) as (?,[]).
apply Rsqr_inj.
assumption.
assumption.
- rewrite <- H0; rewrite <- H2; reflexivity.
+ rewrite <- H0, <- H2; reflexivity.
Qed.
(**********)
Lemma Rsqrt_Rsqrt : forall x:nonnegreal, Rsqrt x * Rsqrt x = x.
Proof.
intros.
- assert (X := Rsqrt_exists (nonneg x) (cond_nonneg x)).
- elim X; intros.
+ destruct (Rsqrt_exists (nonneg x) (cond_nonneg x)) as (x0 & H1 & H2).
cut (x0 = Rsqrt x).
intros.
rewrite <- H.
- elim p; intros.
- rewrite H1; reflexivity.
+ rewrite H2; reflexivity.
unfold Rsqrt.
- case (Rsqrt_exists x (cond_nonneg x)).
- intros.
- elim p; elim a; intros.
+ case (Rsqrt_exists x (cond_nonneg x)) as (x1 & ? & ?).
apply Rsqr_inj.
assumption.
assumption.
- rewrite <- H0; rewrite <- H2; reflexivity.
+ rewrite <- H0, <- H2; reflexivity.
Qed.
diff --git a/theories/Reals/Rtopology.v b/theories/Reals/Rtopology.v
index 9a345153..72e4142b 100644
--- a/theories/Reals/Rtopology.v
+++ b/theories/Reals/Rtopology.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -84,7 +84,7 @@ Proof.
apply H4.
unfold del; rewrite <- (Rabs_Ropp (x - x1)); rewrite Ropp_minus_distr;
ring.
- unfold del; apply Rplus_lt_reg_r with (Rabs (x - x1));
+ unfold del; apply Rplus_lt_reg_l with (Rabs (x - x1));
rewrite Rplus_0_r;
replace (Rabs (x - x1) + (x0 - Rabs (x - x1))) with (pos x0);
[ idtac | ring ].
@@ -139,7 +139,7 @@ Proof.
apply H10.
unfold del; simpl; rewrite <- (Rabs_Ropp (x - x1));
rewrite Ropp_minus_distr; ring.
- apply Rplus_lt_reg_r with (Rabs (x - x1)); rewrite Rplus_0_r;
+ apply Rplus_lt_reg_l with (Rabs (x - x1)); rewrite Rplus_0_r;
replace (Rabs (x - x1) + (x0 - Rabs (x - x1))) with (pos x0);
[ rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H6 | ring ].
Qed.
@@ -254,7 +254,7 @@ Proof.
apply H4.
unfold del2; simpl; rewrite <- (Rabs_Ropp (x - x0));
rewrite Ropp_minus_distr; ring.
- apply Rplus_lt_reg_r with (Rabs (x - x0)); rewrite Rplus_0_r;
+ apply Rplus_lt_reg_l with (Rabs (x - x0)); rewrite Rplus_0_r;
replace (Rabs (x - x0) + (del - Rabs (x - x0))) with (pos del);
[ rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H2 | ring ].
apply interior_P1.
@@ -623,87 +623,79 @@ Qed.
(** Borel-Lebesgue's lemma *)
Lemma compact_P3 : forall a b:R, compact (fun c:R => a <= c <= b).
Proof.
- intros; case (Rle_dec a b); intro.
- unfold compact; intros;
+ intros a b; destruct (Rle_dec a b) as [Hle|Hnle].
+ unfold compact; intros f0 (H,H5);
set
(A :=
fun x:R =>
a <= x <= b /\
(exists D : R -> Prop,
- covering_finite (fun c:R => a <= c <= x) (subfamily f0 D)));
- cut (A a).
- intro; cut (bound A).
- intro; cut (exists a0 : R, A a0).
- intro; assert (H3 := completeness A H1 H2); elim H3; clear H3; intros m H3;
- unfold is_lub in H3; cut (a <= m <= b).
- intro; unfold covering_open_set in H; elim H; clear H; intros;
- unfold covering in H; assert (H6 := H m H4); elim H6;
- clear H6; intros y0 H6; unfold family_open_set in H5;
- assert (H7 := H5 y0); unfold open_set in H7; assert (H8 := H7 m H6);
- unfold neighbourhood in H8; elim H8; clear H8; intros eps H8;
- cut (exists x : R, A x /\ m - eps < x <= m).
- intro; elim H9; clear H9; intros x H9; elim H9; clear H9; intros;
- case (Req_dec m b); intro.
- rewrite H11 in H10; rewrite H11 in H8; unfold A in H9; elim H9; clear H9;
- intros; elim H12; clear H12; intros Dx H12;
- set (Db := fun x:R => Dx x \/ x = y0); exists Db;
- unfold covering_finite; split.
- unfold covering; unfold covering_finite in H12; elim H12; clear H12;
- intros; unfold covering in H12; case (Rle_dec x0 x);
- intro.
- cut (a <= x0 <= x).
- intro; assert (H16 := H12 x0 H15); elim H16; clear H16; intros; exists x1;
- simpl in H16; simpl; unfold Db; elim H16;
- clear H16; intros; split; [ apply H16 | left; apply H17 ].
- split.
- elim H14; intros; assumption.
- assumption.
+ covering_finite (fun c:R => a <= c <= x) (subfamily f0 D))).
+ cut (A a); [intro H0|].
+ cut (bound A); [intro H1|].
+ cut (exists a0 : R, A a0); [intro H2|].
+ pose proof (completeness A H1 H2) as (m,H3); unfold is_lub in H3.
+ cut (a <= m <= b); [intro H4|].
+ unfold covering in H; pose proof (H m H4) as (y0,H6).
+ unfold family_open_set in H5; pose proof (H5 y0 m H6) as (eps,H8).
+ cut (exists x : R, A x /\ m - eps < x <= m);
+ [intros (x,((H9 & Dx & H12 & H13),(Hltx,_)))|].
+ destruct (Req_dec m b) as [->|H11].
+ set (Db := fun x:R => Dx x \/ x = y0); exists Db;
+ unfold covering_finite; split.
+ unfold covering; intros x0 (H14,H18);
+ unfold covering in H12; destruct (Rle_dec x0 x) as [Hle'|Hnle'].
+ cut (a <= x0 <= x); [intro H15|].
+ pose proof (H12 x0 H15) as (x1 & H16 & H17); exists x1;
+ simpl; unfold Db; split; [ apply H16 | left; apply H17 ].
+ split; assumption.
exists y0; simpl; split.
- apply H8; unfold disc; rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr;
- rewrite Rabs_right.
+ apply H8; unfold disc;
+ rewrite <- Rabs_Ropp, Ropp_minus_distr, Rabs_right.
apply Rlt_trans with (b - x).
- unfold Rminus; apply Rplus_lt_compat_l; apply Ropp_lt_gt_contravar;
+ unfold Rminus; apply Rplus_lt_compat_l, Ropp_lt_gt_contravar;
auto with real.
- elim H10; intros H15 _; apply Rplus_lt_reg_r with (x - eps);
+ apply Rplus_lt_reg_l with (x - eps);
replace (x - eps + (b - x)) with (b - eps);
- [ replace (x - eps + eps) with x; [ apply H15 | ring ] | ring ].
- apply Rge_minus; apply Rle_ge; elim H14; intros _ H15; apply H15.
+ [ replace (x - eps + eps) with x; [ apply Hltx | ring ] | ring ].
+ apply Rge_minus, Rle_ge, H18.
unfold Db; right; reflexivity.
- unfold family_finite; unfold domain_finite;
- unfold covering_finite in H12; elim H12; clear H12;
+ unfold family_finite, domain_finite.
intros; unfold family_finite in H13; unfold domain_finite in H13;
- elim H13; clear H13; intros l H13; exists (cons y0 l);
+ destruct H13 as (l,H13); exists (cons y0 l);
intro; split.
- intro; simpl in H14; unfold intersection_domain in H14; elim (H13 x0);
- clear H13; intros; case (Req_dec x0 y0); intro.
+ intro H14; simpl in H14; unfold intersection_domain in H14;
+ specialize H13 with x0; destruct H13 as (H13,H15);
+ destruct (Req_dec x0 y0) as [H16|H16].
simpl; left; apply H16.
simpl; right; apply H13.
simpl; unfold intersection_domain; unfold Db in H14;
decompose [and or] H14.
split; assumption.
elim H16; assumption.
- intro; simpl in H14; elim H14; intro; simpl;
+ intro H14; simpl in H14; destruct H14 as [H15|H15]; simpl;
unfold intersection_domain.
split.
- apply (cond_fam f0); rewrite H15; exists m; apply H6.
+ apply (cond_fam f0); rewrite H15; exists b; apply H6.
unfold Db; right; assumption.
simpl; unfold intersection_domain; elim (H13 x0).
intros _ H16; assert (H17 := H16 H15); simpl in H17;
unfold intersection_domain in H17; split.
elim H17; intros; assumption.
unfold Db; left; elim H17; intros; assumption.
- set (m' := Rmin (m + eps / 2) b); cut (A m').
- intro; elim H3; intros; unfold is_upper_bound in H13;
- assert (H15 := H13 m' H12); cut (m < m').
- intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H15 H16)).
- unfold m'; unfold Rmin; case (Rle_dec (m + eps / 2) b); intro.
- pattern m at 1; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l;
- unfold Rdiv; apply Rmult_lt_0_compat;
- [ apply (cond_pos eps) | apply Rinv_0_lt_compat; prove_sup0 ].
- elim H4; intros.
- elim H17; intro.
- assumption.
- elim H11; assumption.
+ set (m' := Rmin (m + eps / 2) b).
+ cut (A m'); [intro H7|].
+ destruct H3 as (H14,H15); unfold is_upper_bound in H14.
+ assert (H16 := H14 m' H7).
+ cut (m < m'); [intro H17|].
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H16 H17))...
+ unfold m', Rmin; destruct (Rle_dec (m + eps / 2) b) as [Hle'|Hnle'].
+ pattern m at 1; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l;
+ unfold Rdiv; apply Rmult_lt_0_compat;
+ [ apply (cond_pos eps) | apply Rinv_0_lt_compat; prove_sup0 ].
+ destruct H4 as (_,[]).
+ assumption.
+ elim H11; assumption.
unfold A; split.
split.
apply Rle_trans with m.
@@ -712,38 +704,32 @@ Proof.
pattern m at 1; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left;
unfold Rdiv; apply Rmult_lt_0_compat;
[ apply (cond_pos eps) | apply Rinv_0_lt_compat; prove_sup0 ].
- elim H4; intros.
- elim H13; intro.
+ destruct H4.
assumption.
- elim H11; assumption.
unfold m'; apply Rmin_r.
- unfold A in H9; elim H9; clear H9; intros; elim H12; clear H12; intros Dx H12;
- set (Db := fun x:R => Dx x \/ x = y0); exists Db;
- unfold covering_finite; split.
- unfold covering; unfold covering_finite in H12; elim H12; clear H12;
- intros; unfold covering in H12; case (Rle_dec x0 x);
- intro.
- cut (a <= x0 <= x).
- intro; assert (H16 := H12 x0 H15); elim H16; clear H16; intros; exists x1;
- simpl in H16; simpl; unfold Db.
- elim H16; clear H16; intros; split; [ apply H16 | left; apply H17 ].
- elim H14; intros; split; assumption.
+ set (Db := fun x:R => Dx x \/ x = y0); exists Db;
+ unfold covering_finite; split.
+ unfold covering; intros x0 (H14,H18);
+ unfold covering in H12; destruct (Rle_dec x0 x) as [Hle'|Hnle'].
+ cut (a <= x0 <= x); [intro H15|].
+ pose proof (H12 x0 H15) as (x1 & H16 & H17); exists x1;
+ simpl; unfold Db; split; [ apply H16 | left; apply H17 ].
+ split; assumption.
exists y0; simpl; split.
- apply H8; unfold disc; unfold Rabs; case (Rcase_abs (x0 - m));
- intro.
+ apply H8; unfold disc, Rabs; destruct (Rcase_abs (x0 - m)) as [Hlt|Hge].
rewrite Ropp_minus_distr; apply Rlt_trans with (m - x).
unfold Rminus; apply Rplus_lt_compat_l; apply Ropp_lt_gt_contravar;
auto with real.
- apply Rplus_lt_reg_r with (x - eps);
+ apply Rplus_lt_reg_l with (x - eps);
replace (x - eps + (m - x)) with (m - eps).
replace (x - eps + eps) with x.
- elim H10; intros; assumption.
+ assumption.
ring.
ring.
apply Rle_lt_trans with (m' - m).
unfold Rminus; do 2 rewrite <- (Rplus_comm (- m));
apply Rplus_le_compat_l; elim H14; intros; assumption.
- apply Rplus_lt_reg_r with m; replace (m + (m' - m)) with m'.
+ apply Rplus_lt_reg_l with m; replace (m + (m' - m)) with m'.
apply Rle_lt_trans with (m + eps / 2).
unfold m'; apply Rmin_l.
apply Rplus_lt_compat_l; apply Rmult_lt_reg_l with 2.
@@ -755,22 +741,20 @@ Proof.
discrR.
ring.
unfold Db; right; reflexivity.
- unfold family_finite; unfold domain_finite;
- unfold covering_finite in H12; elim H12; clear H12;
- intros; unfold family_finite in H13; unfold domain_finite in H13;
- elim H13; clear H13; intros l H13; exists (cons y0 l);
+ unfold family_finite, domain_finite;
+ unfold family_finite, domain_finite in H13;
+ destruct H13 as (l,H13); exists (cons y0 l);
intro; split.
- intro; simpl in H14; unfold intersection_domain in H14; elim (H13 x0);
- clear H13; intros; case (Req_dec x0 y0); intro.
- simpl; left; apply H16.
+ intro H14; simpl in H14; unfold intersection_domain in H14;
+ specialize (H13 x0); destruct H13 as (H13,H15);
+ destruct (Req_dec x0 y0) as [Heq|Hneq].
+ simpl; left; apply Heq.
simpl; right; apply H13; simpl;
unfold intersection_domain; unfold Db in H14;
decompose [and or] H14.
split; assumption.
- elim H16; assumption.
- intro; simpl in H14; elim H14; intro; simpl;
- unfold intersection_domain.
- split.
+ elim Hneq; assumption.
+ intros [H15|H15]. split.
apply (cond_fam f0); rewrite H15; exists m; apply H6.
unfold Db; right; assumption.
elim (H13 x0); intros _ H16.
@@ -780,22 +764,22 @@ Proof.
split.
elim H17; intros; assumption.
unfold Db; left; elim H17; intros; assumption.
- elim (classic (exists x : R, A x /\ m - eps < x <= m)); intro.
+ elim (classic (exists x : R, A x /\ m - eps < x <= m)); intro H9.
assumption.
- elim H3; intros; cut (is_upper_bound A (m - eps)).
- intro; assert (H13 := H11 _ H12); cut (m - eps < m).
- intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H13 H14)).
+ elim H3; intros H10 H11; cut (is_upper_bound A (m - eps)).
+ intro H12; assert (H13 := H11 _ H12); cut (m - eps < m).
+ intro H14; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H13 H14)).
pattern m at 2; rewrite <- Rplus_0_r; unfold Rminus;
apply Rplus_lt_compat_l; apply Ropp_lt_cancel; rewrite Ropp_involutive;
rewrite Ropp_0; apply (cond_pos eps).
set (P := fun n:R => A n /\ m - eps < n <= m);
assert (H12 := not_ex_all_not _ P H9); unfold P in H12;
- unfold is_upper_bound; intros;
+ unfold is_upper_bound; intros x H13;
assert (H14 := not_and_or _ _ (H12 x)); elim H14;
- intro.
+ intro H15.
elim H15; apply H13.
- elim (not_and_or _ _ H15); intro.
- case (Rle_dec x (m - eps)); intro.
+ destruct (not_and_or _ _ H15) as [H16|H16].
+ destruct (Rle_dec x (m - eps)) as [H17|H17].
assumption.
elim H16; auto with real.
unfold is_upper_bound in H10; assert (H17 := H10 x H13); elim H16; apply H17.
@@ -803,7 +787,8 @@ Proof.
unfold is_upper_bound in H3.
split.
apply (H3 _ H0).
- apply (H4 b); unfold is_upper_bound; intros; unfold A in H5; elim H5;
+ clear H5.
+ apply (H4 b); unfold is_upper_bound; intros x H5; unfold A in H5; elim H5;
clear H5; intros H5 _; elim H5; clear H5; intros _ H5;
apply H5.
exists a; apply H0.
@@ -811,30 +796,28 @@ Proof.
unfold A in H1; elim H1; clear H1; intros H1 _; elim H1;
clear H1; intros _ H1; apply H1.
unfold A; split.
- split; [ right; reflexivity | apply r ].
- unfold covering_open_set in H; elim H; clear H; intros; unfold covering in H;
- cut (a <= a <= b).
- intro; elim (H _ H1); intros y0 H2; set (D' := fun x:R => x = y0); exists D';
+ split; [ right; reflexivity | apply Hle ].
+ unfold covering in H; cut (a <= a <= b).
+ intro H1; elim (H _ H1); intros y0 H2; set (D' := fun x:R => x = y0); exists D';
unfold covering_finite; split.
- unfold covering; simpl; intros; cut (x = a).
- intro; exists y0; split.
+ unfold covering; simpl; intros x H3; cut (x = a).
+ intro H4; exists y0; split.
rewrite H4; apply H2.
unfold D'; reflexivity.
elim H3; intros; apply Rle_antisym; assumption.
unfold family_finite; unfold domain_finite;
exists (cons y0 nil); intro; split.
- simpl; unfold intersection_domain; intro; elim H3; clear H3;
- intros; unfold D' in H4; left; apply H4.
- simpl; unfold intersection_domain; intro; elim H3; intro.
+ simpl; unfold intersection_domain; intros (H3,H4).
+ unfold D' in H4; left; apply H4.
+ simpl; unfold intersection_domain; intros [H4|[]].
split; [ rewrite H4; apply (cond_fam f0); exists a; apply H2 | apply H4 ].
- elim H4.
- split; [ right; reflexivity | apply r ].
+ split; [ right; reflexivity | apply Hle ].
apply compact_eqDom with (fun c:R => False).
apply compact_EMP.
unfold eq_Dom; split.
unfold included; intros; elim H.
unfold included; intros; elim H; clear H; intros;
- assert (H1 := Rle_trans _ _ _ H H0); elim n; apply H1.
+ assert (H1 := Rle_trans _ _ _ H H0); elim Hnle; apply H1.
Qed.
Lemma compact_P4 :
@@ -982,12 +965,6 @@ Proof.
intros; exists (f0 x0); apply H4.
Qed.
-Lemma Rlt_Rminus : forall a b:R, a < b -> 0 < b - a.
-Proof.
- intros; apply Rplus_lt_reg_r with a; rewrite Rplus_0_r;
- replace (a + (b - a)) with b; [ assumption | ring ].
-Qed.
-
Lemma prolongement_C0 :
forall (f:R -> R) (a b:R),
a <= b ->
@@ -1017,14 +994,14 @@ Proof.
split.
change (0 < a - x); apply Rlt_Rminus; assumption.
intros; elim H5; clear H5; intros _ H5; unfold h.
- case (Rle_dec x a); intro.
- case (Rle_dec x0 a); intro.
- unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption.
- elim n; left; apply Rplus_lt_reg_r with (- x);
+ case (Rle_dec x a) as [|[]].
+ case (Rle_dec x0 a) as [|[]].
+ unfold Rminus; rewrite Rplus_opp_r, Rabs_R0; assumption.
+ left; apply Rplus_lt_reg_l with (- x);
do 2 rewrite (Rplus_comm (- x)); apply Rle_lt_trans with (Rabs (x0 - x)).
apply RRle_abs.
assumption.
- elim n; left; assumption.
+ left; assumption.
elim H3; intro.
assert (H5 : a <= a <= b).
split; [ right; reflexivity | left; assumption ].
@@ -1039,20 +1016,20 @@ Proof.
elim H8; intros; assumption.
change (0 < b - a); apply Rlt_Rminus; assumption.
intros; elim H9; clear H9; intros _ H9; cut (x1 < b).
- intro; unfold h; case (Rle_dec x a); intro.
- case (Rle_dec x1 a); intro.
+ intro; unfold h; case (Rle_dec x a) as [|[]].
+ case (Rle_dec x1 a) as [Hlta|Hnlea].
unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption.
- case (Rle_dec x1 b); intro.
+ case (Rle_dec x1 b) as [Hleb|[]].
elim H8; intros; apply H12; split.
unfold D_x, no_cond; split.
trivial.
- red; intro; elim n; right; symmetry ; assumption.
+ red; intro; elim Hnlea; right; symmetry ; assumption.
apply Rlt_le_trans with (Rmin x0 (b - a)).
rewrite H4 in H9; apply H9.
apply Rmin_l.
- elim n0; left; assumption.
- elim n; right; assumption.
- apply Rplus_lt_reg_r with (- a); do 2 rewrite (Rplus_comm (- a));
+ left; assumption.
+ right; assumption.
+ apply Rplus_lt_reg_l with (- a); do 2 rewrite (Rplus_comm (- a));
rewrite H4 in H9; apply Rle_lt_trans with (Rabs (x1 - a)).
apply RRle_abs.
apply Rlt_le_trans with (Rmin x0 (b - a)).
@@ -1073,30 +1050,29 @@ Proof.
assert (H12 : 0 < b - x).
apply Rlt_Rminus; assumption.
exists (Rmin x0 (Rmin (x - a) (b - x))); split.
- unfold Rmin; case (Rle_dec (x - a) (b - x)); intro.
- case (Rle_dec x0 (x - a)); intro.
+ unfold Rmin; case (Rle_dec (x - a) (b - x)) as [Hle|Hnle].
+ case (Rle_dec x0 (x - a)) as [Hlea|Hnlea].
assumption.
assumption.
- case (Rle_dec x0 (b - x)); intro.
+ case (Rle_dec x0 (b - x)) as [Hleb|Hnleb].
assumption.
assumption.
- intros; elim H13; clear H13; intros; cut (a < x1 < b).
- intro; elim H15; clear H15; intros; unfold h; case (Rle_dec x a);
- intro.
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H4)).
- case (Rle_dec x b); intro.
- case (Rle_dec x1 a); intro.
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r0 H15)).
- case (Rle_dec x1 b); intro.
+ intros x1 (H13,H14); cut (a < x1 < b).
+ intro; elim H15; clear H15; intros; unfold h; case (Rle_dec x a) as [Hle|Hnle].
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ Hle H4)).
+ case (Rle_dec x b) as [|[]].
+ case (Rle_dec x1 a) as [Hle0|].
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ Hle0 H15)).
+ case (Rle_dec x1 b) as [|[]].
apply H10; split.
assumption.
apply Rlt_le_trans with (Rmin x0 (Rmin (x - a) (b - x))).
assumption.
apply Rmin_l.
- elim n1; left; assumption.
- elim n0; left; assumption.
+ left; assumption.
+ left; assumption.
split.
- apply Ropp_lt_cancel; apply Rplus_lt_reg_r with x;
+ apply Ropp_lt_cancel; apply Rplus_lt_reg_l with x;
apply Rle_lt_trans with (Rabs (x1 - x)).
rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply RRle_abs.
apply Rlt_le_trans with (Rmin x0 (Rmin (x - a) (b - x))).
@@ -1104,7 +1080,7 @@ Proof.
apply Rle_trans with (Rmin (x - a) (b - x)).
apply Rmin_r.
apply Rmin_l.
- apply Rplus_lt_reg_r with (- x); do 2 rewrite (Rplus_comm (- x));
+ apply Rplus_lt_reg_l with (- x); do 2 rewrite (Rplus_comm (- x));
apply Rle_lt_trans with (Rabs (x1 - x)).
apply RRle_abs.
apply Rlt_le_trans with (Rmin x0 (Rmin (x - a) (b - x))).
@@ -1124,13 +1100,13 @@ Proof.
elim H10; intros; assumption.
change (0 < b - a); apply Rlt_Rminus; assumption.
intros; elim H11; clear H11; intros _ H11; cut (a < x1).
- intro; unfold h; case (Rle_dec x a); intro.
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H4)).
- case (Rle_dec x1 a); intro.
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H12)).
- case (Rle_dec x b); intro.
- case (Rle_dec x1 b); intro.
- rewrite H6; elim H10; intros; elim r0; intro.
+ intro; unfold h; case (Rle_dec x a) as [Hlea|Hnlea].
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ Hlea H4)).
+ case (Rle_dec x1 a) as [Hlea'|Hnlea'].
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ Hlea' H12)).
+ case (Rle_dec x b) as [Hleb|Hnleb].
+ case (Rle_dec x1 b) as [Hleb'|Hnleb'].
+ rewrite H6; elim H10; intros; destruct Hleb'.
apply H14; split.
unfold D_x, no_cond; split.
trivial.
@@ -1142,8 +1118,8 @@ Proof.
assumption.
rewrite H6; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0;
assumption.
- elim n1; right; assumption.
- rewrite H6 in H11; apply Ropp_lt_cancel; apply Rplus_lt_reg_r with b;
+ elim Hnleb; right; assumption.
+ rewrite H6 in H11; apply Ropp_lt_cancel; apply Rplus_lt_reg_l with b;
apply Rle_lt_trans with (Rabs (x1 - b)).
rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply RRle_abs.
apply Rlt_le_trans with (Rmin x0 (b - a)).
@@ -1156,26 +1132,25 @@ Proof.
change (0 < x - b); apply Rlt_Rminus; assumption.
intros; elim H8; clear H8; intros.
assert (H10 : b < x0).
- apply Ropp_lt_cancel; apply Rplus_lt_reg_r with x;
+ apply Ropp_lt_cancel; apply Rplus_lt_reg_l with x;
apply Rle_lt_trans with (Rabs (x0 - x)).
rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply RRle_abs.
assumption.
- unfold h; case (Rle_dec x a); intro.
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H4)).
- case (Rle_dec x b); intro.
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H6)).
- case (Rle_dec x0 a); intro.
- elim (Rlt_irrefl _ (Rlt_trans _ _ _ H1 (Rlt_le_trans _ _ _ H10 r))).
- case (Rle_dec x0 b); intro.
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H10)).
+ unfold h; case (Rle_dec x a) as [Hle|Hnle].
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ Hle H4)).
+ case (Rle_dec x b) as [Hleb|Hnleb].
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ Hleb H6)).
+ case (Rle_dec x0 a) as [Hlea'|Hnlea'].
+ elim (Rlt_irrefl _ (Rlt_trans _ _ _ H1 (Rlt_le_trans _ _ _ H10 Hlea'))).
+ case (Rle_dec x0 b) as [Hleb'|Hnleb'].
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ Hleb' H10)).
unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption.
- intros; elim H3; intros; unfold h; case (Rle_dec c a); intro.
- elim r; intro.
+ intros; elim H3; intros; unfold h; case (Rle_dec c a) as [[|]|].
elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H4 H6)).
rewrite H6; reflexivity.
- case (Rle_dec c b); intro.
+ case (Rle_dec c b) as [|[]].
reflexivity.
- elim n0; assumption.
+ assumption.
exists (fun _:R => f0 a); split.
apply derivable_continuous; apply (derivable_const (f0 a)).
intros; elim H2; intros; rewrite H1 in H3; cut (b = c).
@@ -1229,11 +1204,11 @@ Proof.
apply Rplus_lt_compat_l; apply Ropp_lt_cancel; rewrite Ropp_0;
rewrite Ropp_involutive; apply (cond_pos eps).
unfold is_upper_bound, image_dir; intros; cut (x <= M).
- intro; case (Rle_dec x (M - eps)); intro.
- apply r.
+ intro; destruct (Rle_dec x (M - eps)) as [H13|].
+ apply H13.
elim (H9 x); unfold intersection_domain, disc, image_dir; split.
rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; rewrite Rabs_right.
- apply Rplus_lt_reg_r with (x - eps);
+ apply Rplus_lt_reg_l with (x - eps);
replace (x - eps + (M - x)) with (M - eps).
replace (x - eps + eps) with x.
auto with real.
@@ -1615,13 +1590,12 @@ Proof.
apply H3.
elim Hyp; intros; elim H4; intros; decompose [and] H5;
assert (H10 := H3 _ H6); assert (H11 := H3 _ H8);
- elim H10; intros; elim H11; intros; case (total_order_T x x0);
- intro.
- elim s; intro.
+ elim H10; intros; elim H11; intros;
+ destruct (total_order_T x x0) as [[|H15]|H15].
assumption.
- rewrite b in H13; rewrite b in H7; elim H9; apply Rle_antisym;
+ rewrite H15 in H13, H7; elim H9; apply Rle_antisym;
apply Rle_trans with x0; assumption.
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ (Rle_trans _ _ _ H13 H14) r)).
+ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ (Rle_trans _ _ _ H13 H14) H15)).
elim X_enc; clear X_enc; intros m X_enc; elim X_enc; clear X_enc;
intros M X_enc; elim X_enc; clear X_enc Hyp; intros X_enc Hyp;
unfold uniform_continuity; intro;
@@ -1675,9 +1649,9 @@ Proof.
apply H7; split.
unfold D_x, no_cond; split; [ trivial | assumption ].
apply Rlt_le_trans with (Rmin x0 (M - m)); [ apply H8 | apply Rmin_l ].
- assert (H8 := completeness _ H6 H7); elim H8; clear H8; intros;
+ destruct (completeness _ H6 H7) as (x1,p).
cut (0 < x1 <= M - m).
- intro; elim H8; clear H8; intros; exists (mkposreal _ H8); split.
+ intros (H8,H9); exists (mkposreal _ H8); split.
intros; cut (exists alp : R, Rabs (z - x) < alp <= x1 /\ E alp).
intros; elim H11; intros; elim H12; clear H12; intros; unfold E in H13;
elim H13; intros; apply H15.
@@ -1831,7 +1805,7 @@ Proof.
apply H14; split;
[ unfold D_x, no_cond; split; [ trivial | assumption ]
| apply Rlt_le_trans with (Rmin x0 (M - m)); [ apply H15 | apply Rmin_l ] ].
- assert (H13 := completeness _ H11 H12); elim H13; clear H13; intros;
+ destruct (completeness _ H11 H12) as (x0,p).
cut (0 < x0 <= M - m).
intro; elim H13; clear H13; intros; exists x0; split.
assumption.
diff --git a/theories/Reals/Rtrigo.v b/theories/Reals/Rtrigo.v
index 6818e9a1..44058358 100644
--- a/theories/Reals/Rtrigo.v
+++ b/theories/Reals/Rtrigo.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -16,11 +16,10 @@ Require Export Cos_rel.
Require Export Cos_plus.
Require Import ZArith_base.
Require Import Zcomplements.
-Require Import Classical_Prop.
Require Import Fourier.
Require Import Ranalysis1.
Require Import Rsqrt_def.
Require Import PSeries_reg.
Require Export Rtrigo1.
Require Export Ratan.
-Require Export Machin. \ No newline at end of file
+Require Export Machin.
diff --git a/theories/Reals/Rtrigo1.v b/theories/Reals/Rtrigo1.v
index b940455f..9e485ec5 100644
--- a/theories/Reals/Rtrigo1.v
+++ b/theories/Reals/Rtrigo1.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -16,7 +16,6 @@ Require Export Cos_rel.
Require Export Cos_plus.
Require Import ZArith_base.
Require Import Zcomplements.
-Require Import Classical_Prop.
Require Import Fourier.
Require Import Ranalysis1.
Require Import Rsqrt_def.
@@ -40,7 +39,7 @@ Proof.
(fun n:nat =>
sum_f_R0 (fun k:nat => Rabs (/ INR (fact (2 * k)) * r ^ (2 * k)))
n) l }.
- intro X; elim X; intros.
+ intros (x,p).
exists x.
split.
apply p.
@@ -148,11 +147,11 @@ Proof.
apply H4.
intros; rewrite (H0 x); rewrite (H0 x1); apply H5; apply H6.
intro; unfold cos, SFL in |- *.
- case (cv x); case (exist_cos (Rsqr x)); intros.
- symmetry in |- *; eapply UL_sequence.
- apply u.
- unfold cos_in in c; unfold infinite_sum in c; unfold Un_cv in |- *; intros.
- elim (c _ H0); intros N0 H1.
+ case (cv x) as (x1,HUn); case (exist_cos (Rsqr x)) as (x0,Hcos); intros.
+ symmetry; eapply UL_sequence.
+ apply HUn.
+ unfold cos_in, infinite_sum in Hcos; unfold Un_cv in |- *; intros.
+ elim (Hcos _ H0); intros N0 H1.
exists N0; intros.
unfold R_dist in H1; unfold R_dist, SP in |- *.
replace (sum_f_R0 (fun k:nat => fn k x) n) with
@@ -586,8 +585,8 @@ Qed.
Lemma SIN_bound : forall x:R, -1 <= sin x <= 1.
Proof.
- intro; case (Rle_dec (-1) (sin x)); intro.
- case (Rle_dec (sin x) 1); intro.
+ intro; destruct (Rle_dec (-1) (sin x)) as [Hle|Hnle].
+ destruct (Rle_dec (sin x) 1) as [Hle'|Hnle'].
split; assumption.
cut (1 < sin x).
intro;
@@ -670,11 +669,11 @@ Proof.
replace (Un 0%nat + - Un 1%nat + Un 2%nat + - Un 3%nat) with
(Un 0%nat - Un 1%nat + (Un 2%nat - Un 3%nat)); [ idtac | ring ].
apply Rplus_lt_0_compat.
- unfold Rminus in |- *; apply Rplus_lt_reg_r with (Un 1%nat);
+ unfold Rminus in |- *; apply Rplus_lt_reg_l with (Un 1%nat);
rewrite Rplus_0_r; rewrite (Rplus_comm (Un 1%nat));
rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r;
apply H1.
- unfold Rminus in |- *; apply Rplus_lt_reg_r with (Un 3%nat);
+ unfold Rminus in |- *; apply Rplus_lt_reg_l with (Un 3%nat);
rewrite Rplus_0_r; rewrite (Rplus_comm (Un 3%nat));
rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r;
apply H1.
@@ -722,7 +721,7 @@ Proof.
unfold INR in |- *.
replace ((2 * x + 1 + 1 + 1) * (2 * x + 1 + 1)) with (4 * x * x + 10 * x + 6);
[ idtac | ring ].
- apply Rplus_lt_reg_r with (-4); rewrite Rplus_opp_l;
+ apply Rplus_lt_reg_l with (-4); rewrite Rplus_opp_l;
replace (-4 + (4 * x * x + 10 * x + 6)) with (4 * x * x + 10 * x + 2);
[ idtac | ring ].
apply Rplus_le_lt_0_compat.
@@ -1201,7 +1200,7 @@ Proof.
replace (- (PI - x)) with (x - PI).
replace (- (PI - y)) with (y - PI).
intros; change (sin (y - PI) < sin (x - PI)) in H8;
- apply Rplus_lt_reg_r with (- PI); rewrite Rplus_comm;
+ apply Rplus_lt_reg_l with (- PI); rewrite Rplus_comm;
replace (y + - PI) with (y - PI).
rewrite Rplus_comm; replace (x + - PI) with (x - PI).
apply (sin_increasing_0 (y - PI) (x - PI) H4 H5 H6 H7 H8).
@@ -1273,7 +1272,7 @@ Proof.
replace (-3 * (PI / 2) + 2 * PI) with (PI / 2).
replace (-3 * (PI / 2) + PI) with (- (PI / 2)).
clear H1 H2 H3 H4; intros H1 H2 H3 H4;
- apply Rplus_lt_reg_r with (-3 * (PI / 2));
+ apply Rplus_lt_reg_l with (-3 * (PI / 2));
replace (-3 * (PI / 2) + x) with (x - 3 * (PI / 2)).
replace (-3 * (PI / 2) + y) with (y - 3 * (PI / 2)).
apply (sin_increasing_0 (x - 3 * (PI / 2)) (y - 3 * (PI / 2)) H4 H3 H2 H1 H5).
@@ -1352,7 +1351,7 @@ Proof.
generalize (Rplus_le_compat_l PI 0 y H1);
generalize (Rplus_le_compat_l PI y PI H2); rewrite Rplus_0_r.
rewrite <- double.
- clear H H0 H1 H2 H3; intros; apply Rplus_lt_reg_r with PI;
+ clear H H0 H1 H2 H3; intros; apply Rplus_lt_reg_l with PI;
apply (cos_increasing_0 (PI + y) (PI + x) H0 H H2 H1 H4).
Qed.
@@ -1919,7 +1918,7 @@ Proof.
apply (Rmult_lt_reg_r PI); [apply PI_RGT_0|rewrite Rmult_1_l].
replace (3*(PI/2)) with (PI/2 + PI) in GT by field.
rewrite Rplus_comm in GT.
- now apply Rplus_lt_reg_r in GT. }
+ now apply Rplus_lt_reg_l in GT. }
omega.
Qed.
diff --git a/theories/Reals/Rtrigo_alt.v b/theories/Reals/Rtrigo_alt.v
index cdc96f98..3d36cb34 100644
--- a/theories/Reals/Rtrigo_alt.v
+++ b/theories/Reals/Rtrigo_alt.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -134,13 +134,13 @@ Proof.
apply (fun m n p:nat => mult_le_compat_l p n m); apply le_n_S; assumption.
apply le_n_Sn.
ring.
- assert (X := exist_sin (Rsqr a)); elim X; intros.
- cut (x = sin a / a).
- intro; rewrite H3 in p; unfold sin_in in p; unfold infinite_sum in p;
- unfold R_dist in p; unfold Un_cv; unfold R_dist;
+ unfold sin.
+ destruct (exist_sin (Rsqr a)) as (x,p).
+ unfold sin_in, infinite_sum, R_dist in p;
+ unfold Un_cv, R_dist;
intros.
cut (0 < eps / Rabs a).
- intro; elim (p _ H5); intros N H6.
+ intro H4; destruct (p _ H4) as (N,H6).
exists N; intros.
replace (sum_f_R0 (tg_alt Un) n0) with
(a * (1 - sum_f_R0 (fun i:nat => sin_n i * Rsqr a ^ i) (S n0))).
@@ -151,12 +151,12 @@ Proof.
rewrite Rplus_opp_l; rewrite Rplus_0_r; apply Rmult_lt_reg_l with (/ Rabs a).
apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption.
pattern (/ Rabs a) at 1; rewrite <- (Rabs_Rinv a Hyp_a).
- rewrite <- Rabs_mult; rewrite Rmult_plus_distr_l; rewrite <- Rmult_assoc;
- rewrite <- Rinv_l_sym; [ rewrite Rmult_1_l | assumption ];
- rewrite (Rmult_comm (/ a)); rewrite (Rmult_comm (/ Rabs a));
- rewrite <- Rabs_Ropp; rewrite Ropp_plus_distr; rewrite Ropp_involutive;
- unfold Rminus, Rdiv in H6; apply H6; unfold ge;
- apply le_trans with n0; [ exact H7 | apply le_n_Sn ].
+ rewrite <- Rabs_mult, Rmult_plus_distr_l, <- 2!Rmult_assoc, <- Rinv_l_sym;
+ [ rewrite Rmult_1_l | assumption ];
+ rewrite (Rmult_comm (/ Rabs a)),
+ <- Rabs_Ropp, Ropp_plus_distr, Ropp_involutive, Rmult_1_l.
+ unfold Rminus, Rdiv in H6. apply H6; unfold ge;
+ apply le_trans with n0; [ exact H5 | apply le_n_Sn ].
rewrite (decomp_sum (fun i:nat => sin_n i * Rsqr a ^ i) (S n0)).
replace (sin_n 0) with 1.
simpl; rewrite Rmult_1_r; unfold Rminus;
@@ -176,13 +176,6 @@ Proof.
unfold Rdiv; apply Rmult_lt_0_compat.
assumption.
apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption.
- unfold sin; case (exist_sin (Rsqr a)).
- intros; cut (x = x0).
- intro; rewrite H3; unfold Rdiv.
- symmetry ; apply Rinv_r_simpl_m; assumption.
- unfold sin_in in p; unfold sin_in in s; eapply uniqueness_sum.
- apply p.
- apply s.
intros; elim H2; intros.
replace (sin a - a) with (- (a - sin a)); [ idtac | ring ].
split; apply Ropp_le_contravar; assumption.
@@ -318,12 +311,10 @@ Proof.
apply le_n_2n.
apply (fun m n p:nat => mult_le_compat_l p n m); apply le_n_Sn.
apply (fun m n p:nat => mult_le_compat_l p n m); apply le_n_S; assumption.
- assert (X := exist_cos (Rsqr a0)); elim X; intros.
- cut (x = cos a0).
- intro; rewrite H4 in p; unfold cos_in in p; unfold infinite_sum in p;
- unfold R_dist in p; unfold Un_cv; unfold R_dist;
- intros.
- elim (p _ H5); intros N H6.
+ unfold cos. destruct (exist_cos (Rsqr a0)) as (x,p).
+ unfold cos_in, infinite_sum, R_dist in p;
+ unfold Un_cv, R_dist; intros.
+ destruct (p _ H4) as (N,H6).
exists N; intros.
replace (sum_f_R0 (tg_alt Un) n1) with
(1 - sum_f_R0 (fun i:nat => cos_n i * Rsqr a0 ^ i) (S n1)).
@@ -334,7 +325,7 @@ Proof.
rewrite Ropp_plus_distr; rewrite Ropp_involutive;
unfold Rminus in H6; apply H6.
unfold ge; apply le_trans with n1.
- exact H7.
+ exact H5.
apply le_n_Sn.
rewrite (decomp_sum (fun i:nat => cos_n i * Rsqr a0 ^ i) (S n1)).
replace (cos_n 0) with 1.
@@ -354,10 +345,6 @@ Proof.
unfold cos_n; unfold Rdiv; simpl; rewrite Rinv_1;
rewrite Rmult_1_r; reflexivity.
apply lt_O_Sn.
- unfold cos; case (exist_cos (Rsqr a0)); intros; unfold cos_in in p;
- unfold cos_in in c; eapply uniqueness_sum.
- apply p.
- apply c.
intros; elim H3; intros; replace (cos a0 - 1) with (- (1 - cos a0));
[ idtac | ring ].
split; apply Ropp_le_contravar; assumption.
@@ -394,8 +381,7 @@ Proof.
replace (2 * n0 + 1)%nat with (S (2 * n0)).
apply lt_O_Sn.
ring.
- intros; case (total_order_T 0 a); intro.
- elim s; intro.
+ intros; destruct (total_order_T 0 a) as [[Hlt|Heq]|Hgt].
apply H; [ left; assumption | assumption ].
apply H; [ right; assumption | assumption ].
cut (0 < - a).
diff --git a/theories/Reals/Rtrigo_calc.v b/theories/Reals/Rtrigo_calc.v
index 2ad65a92..281c152b 100644
--- a/theories/Reals/Rtrigo_calc.v
+++ b/theories/Reals/Rtrigo_calc.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Reals/Rtrigo_def.v b/theories/Reals/Rtrigo_def.v
index 60df6f78..ef3e31f1 100644
--- a/theories/Reals/Rtrigo_def.v
+++ b/theories/Reals/Rtrigo_def.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -221,6 +221,7 @@ Proof.
Qed.
Lemma cosn_no_R0 : forall n:nat, cos_n n <> 0.
+Proof.
intro; unfold cos_n; unfold Rdiv; apply prod_neq_R0.
apply pow_nonzero; discrR.
apply Rinv_neq_0_compat.
@@ -233,6 +234,7 @@ Definition cos_in (x l:R) : Prop :=
(**********)
Lemma exist_cos : forall x:R, { l:R | cos_in x l }.
+Proof.
intro; generalize (Alembert_C3 cos_n x cosn_no_R0 Alembert_cos).
unfold Pser, cos_in; trivial.
Qed.
@@ -338,7 +340,7 @@ Proof.
apply INR_eq; repeat rewrite S_INR; rewrite plus_INR; repeat rewrite mult_INR;
rewrite plus_INR; rewrite mult_INR; repeat rewrite S_INR;
replace (INR 0) with 0; [ ring | reflexivity ].
-Defined.
+Qed.
Lemma sin_no_R0 : forall n:nat, sin_n n <> 0.
Proof.
diff --git a/theories/Reals/Rtrigo_fun.v b/theories/Reals/Rtrigo_fun.v
index bc2f62a8..b921ee7b 100644
--- a/theories/Reals/Rtrigo_fun.v
+++ b/theories/Reals/Rtrigo_fun.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -20,80 +20,79 @@ Local Open Scope R_scope.
Lemma Alembert_exp :
Un_cv (fun n:nat => Rabs (/ INR (fact (S n)) * / / INR (fact n))) 0.
Proof.
- unfold Un_cv; intros; elim (Rgt_dec eps 1); intro.
- split with 0%nat; intros; rewrite (simpl_fact n); unfold R_dist;
- rewrite (Rminus_0_r (Rabs (/ INR (S n))));
- rewrite (Rabs_Rabsolu (/ INR (S n))); cut (/ INR (S n) > 0).
- intro; rewrite (Rabs_pos_eq (/ INR (S n))).
- cut (/ eps - 1 < 0).
- intro; generalize (Rlt_le_trans (/ eps - 1) 0 (INR n) H2 (pos_INR n));
- clear H2; intro; unfold Rminus in H2;
- generalize (Rplus_lt_compat_l 1 (/ eps + -1) (INR n) H2);
- replace (1 + (/ eps + -1)) with (/ eps); [ clear H2; intro | ring ].
- rewrite (Rplus_comm 1 (INR n)) in H2; rewrite <- (S_INR n) in H2;
- generalize (Rmult_gt_0_compat (/ INR (S n)) eps H1 H);
- intro; unfold Rgt in H3;
- generalize (Rmult_lt_compat_l (/ INR (S n) * eps) (/ eps) (INR (S n)) H3 H2);
- intro; rewrite (Rmult_assoc (/ INR (S n)) eps (/ eps)) in H4;
- rewrite (Rinv_r eps (Rlt_dichotomy_converse eps 0 (or_intror (eps < 0) H)))
- in H4; rewrite (let (H1, H2) := Rmult_ne (/ INR (S n)) in H1) in H4;
- rewrite (Rmult_comm (/ INR (S n))) in H4;
- rewrite (Rmult_assoc eps (/ INR (S n)) (INR (S n))) in H4;
- rewrite (Rinv_l (INR (S n)) (not_O_INR (S n) (not_eq_sym (O_S n)))) in H4;
- rewrite (let (H1, H2) := Rmult_ne eps in H1) in H4;
- assumption.
- apply Rlt_minus; unfold Rgt in a; rewrite <- Rinv_1;
- apply (Rinv_lt_contravar 1 eps); auto;
- rewrite (let (H1, H2) := Rmult_ne eps in H2); unfold Rgt in H;
- assumption.
- unfold Rgt in H1; apply Rlt_le; assumption.
- unfold Rgt; apply Rinv_0_lt_compat; apply lt_INR_0; apply lt_O_Sn.
-(**)
- cut (0 <= up (/ eps - 1))%Z.
- intro; elim (IZN (up (/ eps - 1)) H0); intros; split with x; intros;
- rewrite (simpl_fact n); unfold R_dist;
+ unfold Un_cv; intros; destruct (Rgt_dec eps 1) as [Hgt|Hnotgt].
+ - split with 0%nat; intros; rewrite (simpl_fact n); unfold R_dist;
rewrite (Rminus_0_r (Rabs (/ INR (S n))));
rewrite (Rabs_Rabsolu (/ INR (S n))); cut (/ INR (S n) > 0).
- intro; rewrite (Rabs_pos_eq (/ INR (S n))).
- cut (/ eps - 1 < INR x).
- intro ;
- generalize
- (Rlt_le_trans (/ eps - 1) (INR x) (INR n) H4
- (le_INR x n H2));
- clear H4; intro; unfold Rminus in H4;
- generalize (Rplus_lt_compat_l 1 (/ eps + -1) (INR n) H4);
- replace (1 + (/ eps + -1)) with (/ eps); [ clear H4; intro | ring ].
- rewrite (Rplus_comm 1 (INR n)) in H4; rewrite <- (S_INR n) in H4;
- generalize (Rmult_gt_0_compat (/ INR (S n)) eps H3 H);
- intro; unfold Rgt in H5;
- generalize (Rmult_lt_compat_l (/ INR (S n) * eps) (/ eps) (INR (S n)) H5 H4);
- intro; rewrite (Rmult_assoc (/ INR (S n)) eps (/ eps)) in H6;
- rewrite (Rinv_r eps (Rlt_dichotomy_converse eps 0 (or_intror (eps < 0) H)))
- in H6; rewrite (let (H1, H2) := Rmult_ne (/ INR (S n)) in H1) in H6;
- rewrite (Rmult_comm (/ INR (S n))) in H6;
- rewrite (Rmult_assoc eps (/ INR (S n)) (INR (S n))) in H6;
- rewrite (Rinv_l (INR (S n)) (not_O_INR (S n) (not_eq_sym (O_S n)))) in H6;
- rewrite (let (H1, H2) := Rmult_ne eps in H1) in H6;
- assumption.
- cut (IZR (up (/ eps - 1)) = IZR (Z.of_nat x));
- [ intro | rewrite H1; trivial ].
- elim (archimed (/ eps - 1)); intros; clear H6; unfold Rgt in H5;
- rewrite H4 in H5; rewrite INR_IZR_INZ; assumption.
- unfold Rgt in H1; apply Rlt_le; assumption.
- unfold Rgt; apply Rinv_0_lt_compat; apply lt_INR_0; apply lt_O_Sn.
- apply (le_O_IZR (up (/ eps - 1)));
- apply (Rle_trans 0 (/ eps - 1) (IZR (up (/ eps - 1)))).
- generalize (Rnot_gt_le eps 1 b); clear b; unfold Rle; intro; elim H0;
- clear H0; intro.
- left; unfold Rgt in H;
- generalize (Rmult_lt_compat_l (/ eps) eps 1 (Rinv_0_lt_compat eps H) H0);
- rewrite
- (Rinv_l eps
- (not_eq_sym (Rlt_dichotomy_converse 0 eps (or_introl (0 > eps) H))))
- ; rewrite (let (H1, H2) := Rmult_ne (/ eps) in H1);
- intro; fold (/ eps - 1 > 0); apply Rgt_minus;
- unfold Rgt; assumption.
- right; rewrite H0; rewrite Rinv_1; symmetry; apply Rminus_diag_eq; auto.
- elim (archimed (/ eps - 1)); intros; clear H1; unfold Rgt in H0; apply Rlt_le;
- assumption.
+ intro; rewrite (Rabs_pos_eq (/ INR (S n))).
+ cut (/ eps - 1 < 0).
+ intro H2; generalize (Rlt_le_trans (/ eps - 1) 0 (INR n) H2 (pos_INR n));
+ clear H2; intro; unfold Rminus in H2;
+ generalize (Rplus_lt_compat_l 1 (/ eps + -1) (INR n) H2);
+ replace (1 + (/ eps + -1)) with (/ eps); [ clear H2; intro | ring ].
+ rewrite (Rplus_comm 1 (INR n)) in H2; rewrite <- (S_INR n) in H2;
+ generalize (Rmult_gt_0_compat (/ INR (S n)) eps H1 H);
+ intro; unfold Rgt in H3;
+ generalize (Rmult_lt_compat_l (/ INR (S n) * eps) (/ eps) (INR (S n)) H3 H2);
+ intro; rewrite (Rmult_assoc (/ INR (S n)) eps (/ eps)) in H4;
+ rewrite (Rinv_r eps (Rlt_dichotomy_converse eps 0 (or_intror (eps < 0) H)))
+ in H4; rewrite (let (H1, H2) := Rmult_ne (/ INR (S n)) in H1) in H4;
+ rewrite (Rmult_comm (/ INR (S n))) in H4;
+ rewrite (Rmult_assoc eps (/ INR (S n)) (INR (S n))) in H4;
+ rewrite (Rinv_l (INR (S n)) (not_O_INR (S n) (not_eq_sym (O_S n)))) in H4;
+ rewrite (let (H1, H2) := Rmult_ne eps in H1) in H4;
+ assumption.
+ apply Rlt_minus; unfold Rgt in Hgt; rewrite <- Rinv_1;
+ apply (Rinv_lt_contravar 1 eps); auto;
+ rewrite (let (H1, H2) := Rmult_ne eps in H2); unfold Rgt in H;
+ assumption.
+ unfold Rgt in H1; apply Rlt_le; assumption.
+ unfold Rgt; apply Rinv_0_lt_compat; apply lt_INR_0; apply lt_O_Sn.
+ - cut (0 <= up (/ eps - 1))%Z.
+ intro; elim (IZN (up (/ eps - 1)) H0); intros; split with x; intros;
+ rewrite (simpl_fact n); unfold R_dist;
+ rewrite (Rminus_0_r (Rabs (/ INR (S n))));
+ rewrite (Rabs_Rabsolu (/ INR (S n))); cut (/ INR (S n) > 0).
+ intro; rewrite (Rabs_pos_eq (/ INR (S n))).
+ cut (/ eps - 1 < INR x).
+ intro ;
+ generalize
+ (Rlt_le_trans (/ eps - 1) (INR x) (INR n) H4
+ (le_INR x n H2));
+ clear H4; intro; unfold Rminus in H4;
+ generalize (Rplus_lt_compat_l 1 (/ eps + -1) (INR n) H4);
+ replace (1 + (/ eps + -1)) with (/ eps); [ clear H4; intro | ring ].
+ rewrite (Rplus_comm 1 (INR n)) in H4; rewrite <- (S_INR n) in H4;
+ generalize (Rmult_gt_0_compat (/ INR (S n)) eps H3 H);
+ intro; unfold Rgt in H5;
+ generalize (Rmult_lt_compat_l (/ INR (S n) * eps) (/ eps) (INR (S n)) H5 H4);
+ intro; rewrite (Rmult_assoc (/ INR (S n)) eps (/ eps)) in H6;
+ rewrite (Rinv_r eps (Rlt_dichotomy_converse eps 0 (or_intror (eps < 0) H)))
+ in H6; rewrite (let (H1, H2) := Rmult_ne (/ INR (S n)) in H1) in H6;
+ rewrite (Rmult_comm (/ INR (S n))) in H6;
+ rewrite (Rmult_assoc eps (/ INR (S n)) (INR (S n))) in H6;
+ rewrite (Rinv_l (INR (S n)) (not_O_INR (S n) (not_eq_sym (O_S n)))) in H6;
+ rewrite (let (H1, H2) := Rmult_ne eps in H1) in H6;
+ assumption.
+ cut (IZR (up (/ eps - 1)) = IZR (Z.of_nat x));
+ [ intro | rewrite H1; trivial ].
+ elim (archimed (/ eps - 1)); intros; clear H6; unfold Rgt in H5;
+ rewrite H4 in H5; rewrite INR_IZR_INZ; assumption.
+ unfold Rgt in H1; apply Rlt_le; assumption.
+ unfold Rgt; apply Rinv_0_lt_compat; apply lt_INR_0; apply lt_O_Sn.
+ apply (le_O_IZR (up (/ eps - 1)));
+ apply (Rle_trans 0 (/ eps - 1) (IZR (up (/ eps - 1)))).
+ generalize (Rnot_gt_le eps 1 Hnotgt); clear Hnotgt; unfold Rle; intro; elim H0;
+ clear H0; intro.
+ left; unfold Rgt in H;
+ generalize (Rmult_lt_compat_l (/ eps) eps 1 (Rinv_0_lt_compat eps H) H0);
+ rewrite
+ (Rinv_l eps
+ (not_eq_sym (Rlt_dichotomy_converse 0 eps (or_introl (0 > eps) H))))
+ ; rewrite (let (H1, H2) := Rmult_ne (/ eps) in H1);
+ intro; fold (/ eps - 1 > 0); apply Rgt_minus;
+ unfold Rgt; assumption.
+ right; rewrite H0; rewrite Rinv_1; symmetry; apply Rminus_diag_eq; auto.
+ elim (archimed (/ eps - 1)); intros; clear H1; unfold Rgt in H0; apply Rlt_le;
+ assumption.
Qed.
diff --git a/theories/Reals/Rtrigo_reg.v b/theories/Reals/Rtrigo_reg.v
index 4e3d41e3..7845e6c4 100644
--- a/theories/Reals/Rtrigo_reg.v
+++ b/theories/Reals/Rtrigo_reg.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -59,7 +59,7 @@ Proof.
sum_f_R0
(fun k:nat => Rabs (/ INR (fact (2 * k + 1)) * r ^ (2 * k))) n)
l }.
- intro X; elim X; intros.
+ intros (x,p).
exists x.
split.
apply p.
@@ -176,14 +176,14 @@ Proof.
intro; rewrite H9 in H8; rewrite H10 in H8.
apply H8.
unfold SFL, sin.
- case (cv h); intros.
- case (exist_sin (Rsqr h)); intros.
+ case (cv h) as (x,HUn).
+ case (exist_sin (Rsqr h)) as (x0,Hsin).
unfold Rdiv; rewrite (Rinv_r_simpl_m h x0 H6).
eapply UL_sequence.
- apply u.
- unfold sin_in in s; unfold sin_n, infinite_sum in s;
+ apply HUn.
+ unfold sin_in in Hsin; unfold sin_n, infinite_sum in Hsin;
unfold SP, fn, Un_cv; intros.
- elim (s _ H10); intros N0 H11.
+ elim (Hsin _ H10); intros N0 H11.
exists N0; intros.
unfold R_dist; unfold R_dist in H11.
replace
@@ -194,9 +194,9 @@ Proof.
apply sum_eq; intros; apply Rmult_eq_compat_l; unfold Rsqr;
rewrite pow_sqr; reflexivity.
unfold SFL, sin.
- case (cv 0); intros.
+ case (cv 0) as (?,HUn).
eapply UL_sequence.
- apply u.
+ apply HUn.
unfold SP, fn; unfold Un_cv; intros; exists 1%nat; intros.
unfold R_dist;
replace
diff --git a/theories/Reals/SeqProp.v b/theories/Reals/SeqProp.v
index fb2eacee..9a6fb945 100644
--- a/theories/Reals/SeqProp.v
+++ b/theories/Reals/SeqProp.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -10,6 +10,7 @@ Require Import Rbase.
Require Import Rfunctions.
Require Import Rseries.
Require Import Max.
+Require Import Omega.
Local Open Scope R_scope.
(*****************************************************************)
@@ -27,7 +28,7 @@ Lemma growing_cv :
forall Un:nat -> R, Un_growing Un -> has_ub Un -> { l:R | Un_cv Un l }.
Proof.
intros Un Hug Heub.
- exists (projT1 (completeness (EUn Un) Heub (EUn_noempty Un))).
+ exists (proj1_sig (completeness (EUn Un) Heub (EUn_noempty Un))).
destruct (completeness _ Heub (EUn_noempty Un)) as (l, H).
now apply Un_cv_crit_lub.
Qed.
@@ -52,8 +53,7 @@ Proof.
apply growing_cv.
apply decreasing_growing; assumption.
exact H0.
- intro X.
- elim X; intros.
+ intros (x,p).
exists (- x).
unfold Un_cv in p.
unfold R_dist in p.
@@ -150,7 +150,7 @@ Definition sequence_lb (Un:nat -> R) (pr:has_lb Un)
(* Compatibility *)
Notation sequence_majorant := sequence_ub (only parsing).
Notation sequence_minorant := sequence_lb (only parsing).
-
+Unset Standard Proposition Elimination Names.
Lemma Wn_decreasing :
forall (Un:nat -> R) (pr:has_ub Un), Un_decreasing (sequence_ub Un pr).
Proof.
@@ -158,21 +158,15 @@ Proof.
unfold Un_decreasing.
intro.
unfold sequence_ub.
- assert (H := ub_to_lub (fun k:nat => Un (S n + k)%nat) (maj_ss Un (S n) pr)).
- assert (H0 := ub_to_lub (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr)).
- elim H; intros.
- elim H0; intros.
+ pose proof (ub_to_lub (fun k:nat => Un (S n + k)%nat) (maj_ss Un (S n) pr)) as (x,(H1,H2)).
+ pose proof (ub_to_lub (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr)) as (x0,(H3,H4)).
cut (lub (fun k:nat => Un (S n + k)%nat) (maj_ss Un (S n) pr) = x);
[ intro Maj1; rewrite Maj1 | idtac ].
cut (lub (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr) = x0);
[ intro Maj2; rewrite Maj2 | idtac ].
- unfold is_lub in p.
- unfold is_lub in p0.
- elim p; intros.
apply H2.
- elim p0; intros.
unfold is_upper_bound.
- intros.
+ intros x1 H5.
unfold is_upper_bound in H3.
apply H3.
elim H5; intros.
@@ -183,12 +177,10 @@ Proof.
cut
(is_lub (EUn (fun k:nat => Un (n + k)%nat))
(lub (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr))).
- intro.
- unfold is_lub in p0; unfold is_lub in H1.
- elim p0; intros; elim H1; intros.
- assert (H6 := H5 x0 H2).
+ intros (H5,H6).
+ assert (H7 := H6 x0 H3).
assert
- (H7 := H3 (lub (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr)) H4).
+ (H8 := H4 (lub (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr)) H5).
apply Rle_antisym; assumption.
unfold lub.
case (ub_to_lub (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr)).
@@ -196,13 +188,11 @@ Proof.
cut
(is_lub (EUn (fun k:nat => Un (S n + k)%nat))
(lub (fun k:nat => Un (S n + k)%nat) (maj_ss Un (S n) pr))).
- intro.
- unfold is_lub in p; unfold is_lub in H1.
- elim p; intros; elim H1; intros.
- assert (H6 := H5 x H2).
+ intros (H5,H6).
+ assert (H7 := H6 x H1).
assert
- (H7 :=
- H3 (lub (fun k:nat => Un (S n + k)%nat) (maj_ss Un (S n) pr)) H4).
+ (H8 :=
+ H2 (lub (fun k:nat => Un (S n + k)%nat) (maj_ss Un (S n) pr)) H5).
apply Rle_antisym; assumption.
unfold lub.
case (ub_to_lub (fun k:nat => Un (S n + k)%nat) (maj_ss Un (S n) pr)).
@@ -460,8 +450,7 @@ Lemma cond_eq :
forall x y:R, (forall eps:R, 0 < eps -> Rabs (x - y) < eps) -> x = y.
Proof.
intros.
- case (total_order_T x y); intro.
- elim s; intro.
+ destruct (total_order_T x y) as [[Hlt|Heq]|Hgt].
cut (0 < y - x).
intro.
assert (H1 := H (y - x) H0).
@@ -470,7 +459,7 @@ Proof.
rewrite Rabs_right in H1.
elim (Rlt_irrefl _ H1).
left; assumption.
- apply Rplus_lt_reg_r with x.
+ apply Rplus_lt_reg_l with x.
rewrite Rplus_0_r; replace (x + (y - x)) with y; [ assumption | ring ].
assumption.
cut (0 < x - y).
@@ -479,7 +468,7 @@ Proof.
rewrite Rabs_right in H1.
elim (Rlt_irrefl _ H1).
left; assumption.
- apply Rplus_lt_reg_r with y.
+ apply Rplus_lt_reg_l with y.
rewrite Rplus_0_r; replace (y + (x - y)) with x; [ assumption | ring ].
Qed.
@@ -860,7 +849,7 @@ Proof.
split.
pattern k at 1; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l.
unfold Rdiv; apply Rmult_lt_0_compat.
- apply Rplus_lt_reg_r with k; rewrite Rplus_0_r; replace (k + (1 - k)) with 1;
+ apply Rplus_lt_reg_l with k; rewrite Rplus_0_r; replace (k + (1 - k)) with 1;
[ elim H; intros; assumption | ring ].
apply Rinv_0_lt_compat; prove_sup0.
apply Rmult_lt_reg_l with 2.
@@ -881,12 +870,12 @@ Proof.
apply Rle_lt_trans with (Rabs (Rabs (An (S n) / An n) - k) + Rabs k).
apply Rabs_triang.
rewrite (Rabs_right k).
- apply Rplus_lt_reg_r with (- k); rewrite <- (Rplus_comm k);
+ apply Rplus_lt_reg_l with (- k); rewrite <- (Rplus_comm k);
repeat rewrite <- Rplus_assoc; rewrite Rplus_opp_l;
repeat rewrite Rplus_0_l; apply H4.
apply Rle_ge; elim H; intros; assumption.
unfold Rdiv; apply Rmult_lt_0_compat.
- apply Rplus_lt_reg_r with k; rewrite Rplus_0_r; elim H; intros;
+ apply Rplus_lt_reg_l with k; rewrite Rplus_0_r; elim H; intros;
replace (k + (1 - k)) with 1; [ assumption | ring ].
apply Rinv_0_lt_compat; prove_sup0.
Qed.
@@ -896,8 +885,7 @@ Lemma growing_ineq :
forall (Un:nat -> R) (l:R),
Un_growing Un -> Un_cv Un l -> forall n:nat, Un n <= l.
Proof.
- intros; case (total_order_T (Un n) l); intro.
- elim s; intro.
+ intros; destruct (total_order_T (Un n) l) as [[Hlt|Heq]|Hgt].
left; assumption.
right; assumption.
cut (0 < Un n - l).
@@ -916,7 +904,7 @@ Proof.
apply tech9.
assumption.
unfold N; apply le_max_l.
- apply Rplus_lt_reg_r with l.
+ apply Rplus_lt_reg_l with l.
rewrite Rplus_0_r.
replace (l + (Un n - l)) with (Un n); [ assumption | ring ].
Qed.
@@ -1102,11 +1090,11 @@ Proof.
apply (cv_infty_cv_R0 (fun n:nat => INR (S n))).
intro; apply not_O_INR; discriminate.
assumption.
- unfold cv_infty; intro; case (total_order_T M0 0); intro.
- elim s; intro.
+ unfold cv_infty; intro;
+ destruct (total_order_T M0 0) as [[Hlt|Heq]|Hgt].
exists 0%nat; intros.
apply Rlt_trans with 0; [ assumption | apply lt_INR_0; apply lt_O_Sn ].
- exists 0%nat; intros; rewrite b; apply lt_INR_0; apply lt_O_Sn.
+ exists 0%nat; intros; rewrite Heq; apply lt_INR_0; apply lt_O_Sn.
set (M0_z := up M0).
assert (H10 := archimed M0).
cut (0 <= M0_z)%Z.
diff --git a/theories/Reals/SeqSeries.v b/theories/Reals/SeqSeries.v
index 5f2173c7..25fe4848 100644
--- a/theories/Reals/SeqSeries.v
+++ b/theories/Reals/SeqSeries.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -222,39 +222,37 @@ Proof.
intro; apply Rle_lt_trans with (R_dist (sum_f_R0 Bn n) (sum_f_R0 Bn m)).
assumption.
apply H2; assumption.
- assert (H5 := lt_eq_lt_dec n m).
- elim H5; intro.
- elim a; intro.
- rewrite (tech2 An n m); [ idtac | assumption ].
- rewrite (tech2 Bn n m); [ idtac | assumption ].
- unfold R_dist; unfold Rminus; do 2 rewrite Ropp_plus_distr;
- do 2 rewrite <- Rplus_assoc; do 2 rewrite Rplus_opp_r;
- do 2 rewrite Rplus_0_l; do 2 rewrite Rabs_Ropp; repeat rewrite Rabs_right.
- apply sum_Rle; intros.
- elim (H (S n + n0)%nat); intros.
- apply H8.
- apply Rle_ge; apply cond_pos_sum; intro.
- elim (H (S n + n0)%nat); intros.
- apply Rle_trans with (An (S n + n0)%nat); assumption.
- apply Rle_ge; apply cond_pos_sum; intro.
- elim (H (S n + n0)%nat); intros; assumption.
- rewrite b; unfold R_dist; unfold Rminus;
+ destruct (lt_eq_lt_dec n m) as [[| -> ]|].
+ - rewrite (tech2 An n m); [ idtac | assumption ].
+ rewrite (tech2 Bn n m); [ idtac | assumption ].
+ unfold R_dist; unfold Rminus; do 2 rewrite Ropp_plus_distr;
+ do 2 rewrite <- Rplus_assoc; do 2 rewrite Rplus_opp_r;
+ do 2 rewrite Rplus_0_l; do 2 rewrite Rabs_Ropp; repeat rewrite Rabs_right.
+ apply sum_Rle; intros.
+ elim (H (S n + n0)%nat); intros H7 H8.
+ apply H8.
+ apply Rle_ge; apply cond_pos_sum; intro.
+ elim (H (S n + n0)%nat); intros.
+ apply Rle_trans with (An (S n + n0)%nat); assumption.
+ apply Rle_ge; apply cond_pos_sum; intro.
+ elim (H (S n + n0)%nat); intros; assumption.
+ - unfold R_dist; unfold Rminus;
do 2 rewrite Rplus_opp_r; rewrite Rabs_R0; right;
reflexivity.
- rewrite (tech2 An m n); [ idtac | assumption ].
- rewrite (tech2 Bn m n); [ idtac | assumption ].
- unfold R_dist; unfold Rminus; do 2 rewrite Rplus_assoc;
- rewrite (Rplus_comm (sum_f_R0 An m)); rewrite (Rplus_comm (sum_f_R0 Bn m));
- do 2 rewrite Rplus_assoc; do 2 rewrite Rplus_opp_l;
- do 2 rewrite Rplus_0_r; repeat rewrite Rabs_right.
- apply sum_Rle; intros.
- elim (H (S m + n0)%nat); intros; apply H8.
- apply Rle_ge; apply cond_pos_sum; intro.
- elim (H (S m + n0)%nat); intros.
- apply Rle_trans with (An (S m + n0)%nat); assumption.
- apply Rle_ge.
- apply cond_pos_sum; intro.
- elim (H (S m + n0)%nat); intros; assumption.
+ - rewrite (tech2 An m n); [ idtac | assumption ].
+ rewrite (tech2 Bn m n); [ idtac | assumption ].
+ unfold R_dist; unfold Rminus; do 2 rewrite Rplus_assoc;
+ rewrite (Rplus_comm (sum_f_R0 An m)); rewrite (Rplus_comm (sum_f_R0 Bn m));
+ do 2 rewrite Rplus_assoc; do 2 rewrite Rplus_opp_l;
+ do 2 rewrite Rplus_0_r; repeat rewrite Rabs_right.
+ apply sum_Rle; intros.
+ elim (H (S m + n0)%nat); intros H7 H8; apply H8.
+ apply Rle_ge; apply cond_pos_sum; intro.
+ elim (H (S m + n0)%nat); intros.
+ apply Rle_trans with (An (S m + n0)%nat); assumption.
+ apply Rle_ge.
+ apply cond_pos_sum; intro.
+ elim (H (S m + n0)%nat); intros; assumption.
Qed.
(** Cesaro's theorem *)
@@ -361,7 +359,7 @@ Proof with trivial.
replace (sum_f_R0 (fun k:nat => An k * (Bn k - l)) n) with
(sum_f_R0 (fun k:nat => An k * Bn k) n +
sum_f_R0 (fun k:nat => An k * - l) n)...
- rewrite <- (scal_sum An n (- l)); field...
+ rewrite <- (scal_sum An n (- l)); field...
rewrite <- plus_sum; apply sum_eq; intros; ring...
Qed.
@@ -375,11 +373,11 @@ Proof with trivial.
assert (H1 : forall n:nat, 0 < sum_f_R0 An n)...
intro; apply tech1...
assert (H2 : cv_infty (fun n:nat => sum_f_R0 An n))...
- unfold cv_infty; intro; case (Rle_dec M 0); intro...
+ unfold cv_infty; intro; destruct (Rle_dec M 0) as [Hle|Hnle]...
exists 0%nat; intros; apply Rle_lt_trans with 0...
assert (H2 : 0 < M)...
auto with real...
- clear n; set (m := up M); elim (archimed M); intros;
+ clear Hnle; set (m := up M); elim (archimed M); intros;
assert (H5 : (0 <= m)%Z)...
apply le_IZR; unfold m; simpl; left; apply Rlt_trans with M...
elim (IZN _ H5); intros; exists x; intros; unfold An; rewrite sum_cte;
diff --git a/theories/Reals/SplitAbsolu.v b/theories/Reals/SplitAbsolu.v
index 3557e2e9..64f4f1c9 100644
--- a/theories/Reals/SplitAbsolu.v
+++ b/theories/Reals/SplitAbsolu.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -11,7 +11,7 @@ Require Import Rbasic_fun.
Ltac split_case_Rabs :=
match goal with
| |- context [(Rcase_abs ?X1)] =>
- case (Rcase_abs X1); try split_case_Rabs
+ destruct (Rcase_abs X1) as [?Hlt|?Hge]; try split_case_Rabs
end.
diff --git a/theories/Reals/SplitRmult.v b/theories/Reals/SplitRmult.v
index 7380f8ad..fec28518 100644
--- a/theories/Reals/SplitRmult.v
+++ b/theories/Reals/SplitRmult.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Reals/Sqrt_reg.v b/theories/Reals/Sqrt_reg.v
index a74aeef2..dd8738e1 100644
--- a/theories/Reals/Sqrt_reg.v
+++ b/theories/Reals/Sqrt_reg.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -18,8 +18,7 @@ Lemma sqrt_var_maj :
Proof.
intros; cut (0 <= 1 + h).
intro; apply Rle_trans with (Rabs (sqrt (Rsqr (1 + h)) - 1)).
- case (total_order_T h 0); intro.
- elim s; intro.
+ destruct (total_order_T h 0) as [[Hlt|Heq]|Hgt].
repeat rewrite Rabs_left.
unfold Rminus; do 2 rewrite <- (Rplus_comm (-1)).
do 2 rewrite Ropp_plus_distr; rewrite Ropp_involutive;
@@ -32,7 +31,7 @@ Proof.
apply H0.
pattern 1 at 2; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left;
assumption.
- apply Rplus_lt_reg_r with 1; rewrite Rplus_0_r; rewrite Rplus_comm;
+ apply Rplus_lt_reg_l with 1; rewrite Rplus_0_r; rewrite Rplus_comm;
unfold Rminus; rewrite Rplus_assoc; rewrite Rplus_opp_l;
rewrite Rplus_0_r.
pattern 1 at 2; rewrite <- sqrt_1; apply sqrt_lt_1.
@@ -43,7 +42,7 @@ Proof.
assumption.
apply H0.
left; apply Rlt_0_1.
- apply Rplus_lt_reg_r with 1; rewrite Rplus_0_r; rewrite Rplus_comm;
+ apply Rplus_lt_reg_l with 1; rewrite Rplus_0_r; rewrite Rplus_comm;
unfold Rminus; rewrite Rplus_assoc; rewrite Rplus_opp_l;
rewrite Rplus_0_r.
pattern 1 at 2; rewrite <- sqrt_1; apply sqrt_lt_1.
@@ -51,7 +50,7 @@ Proof.
left; apply Rlt_0_1.
pattern 1 at 2; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l;
assumption.
- rewrite b; rewrite Rplus_0_r; rewrite Rsqr_1; rewrite sqrt_1; right;
+ rewrite Heq; rewrite Rplus_0_r; rewrite Rsqr_1; rewrite sqrt_1; right;
reflexivity.
repeat rewrite Rabs_right.
unfold Rminus; do 2 rewrite <- (Rplus_comm (-1));
@@ -75,7 +74,7 @@ Proof.
assumption.
left; apply Rlt_0_1.
apply H0.
- apply Rle_ge; left; apply Rplus_lt_reg_r with 1.
+ apply Rle_ge; left; apply Rplus_lt_reg_l with 1.
rewrite Rplus_0_r; rewrite Rplus_comm; unfold Rminus;
rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r.
pattern 1 at 1; rewrite <- sqrt_1; apply sqrt_lt_1.
@@ -86,16 +85,15 @@ Proof.
rewrite sqrt_Rsqr.
replace (1 + h - 1) with h; [ right; reflexivity | ring ].
apply H0.
- case (total_order_T h 0); intro.
- elim s; intro.
- rewrite (Rabs_left h a) in H.
+ destruct (total_order_T h 0) as [[Hlt|Heq]|Hgt].
+ rewrite (Rabs_left h Hlt) in H.
apply Rplus_le_reg_l with (- h).
rewrite Rplus_0_r; rewrite Rplus_comm; rewrite Rplus_assoc;
rewrite Rplus_opp_r; rewrite Rplus_0_r; exact H.
- left; rewrite b; rewrite Rplus_0_r; apply Rlt_0_1.
+ left; rewrite Heq; rewrite Rplus_0_r; apply Rlt_0_1.
left; apply Rplus_lt_0_compat.
apply Rlt_0_1.
- apply r.
+ apply Hgt.
Qed.
(** sqrt is continuous in 1 *)
@@ -203,8 +201,8 @@ Proof.
left; apply Rlt_0_1.
left; apply H.
elim H6; intros.
- case (Rcase_abs (x0 - x)); intro.
- rewrite (Rabs_left (x0 - x) r) in H8.
+ destruct (Rcase_abs (x0 - x)) as [Hlt|Hgt].
+ rewrite (Rabs_left (x0 - x) Hlt) in H8.
rewrite Rplus_comm.
apply Rplus_le_reg_l with (- ((x0 - x) / x)).
rewrite Rplus_0_r; rewrite <- Rplus_assoc; rewrite Rplus_opp_l;
@@ -220,7 +218,7 @@ Proof.
apply Rplus_le_le_0_compat.
left; apply Rlt_0_1.
unfold Rdiv; apply Rmult_le_pos.
- apply Rge_le; exact r.
+ apply Rge_le; exact Hgt.
left; apply Rinv_0_lt_compat; apply H.
unfold Rdiv; apply Rmult_lt_0_compat.
apply H1.
@@ -273,8 +271,8 @@ Proof.
apply Rplus_lt_le_0_compat.
apply sqrt_lt_R0; apply H.
apply sqrt_positivity; apply H10.
- case (Rcase_abs h); intro.
- rewrite (Rabs_left h r) in H9.
+ destruct (Rcase_abs h) as [Hlt|Hgt].
+ rewrite (Rabs_left h Hlt) in H9.
apply Rplus_le_reg_l with (- h).
rewrite Rplus_0_r; rewrite Rplus_comm; rewrite Rplus_assoc;
rewrite Rplus_opp_r; rewrite Rplus_0_r; left; apply Rlt_le_trans with alpha1.
@@ -282,7 +280,7 @@ Proof.
unfold alpha1; apply Rmin_r.
apply Rplus_le_le_0_compat.
left; assumption.
- apply Rge_le; apply r.
+ apply Rge_le; apply Hgt.
unfold alpha1; unfold Rmin; case (Rle_dec alpha x); intro.
apply H5.
apply H.
@@ -341,17 +339,16 @@ Proof.
rewrite <- H1; rewrite sqrt_0; unfold Rminus; rewrite Ropp_0;
rewrite Rplus_0_r; rewrite <- H1 in H5; unfold Rminus in H5;
rewrite Ropp_0 in H5; rewrite Rplus_0_r in H5.
- case (Rcase_abs x0); intro.
- unfold sqrt; case (Rcase_abs x0); intro.
+ destruct (Rcase_abs x0) as [Hlt|Hgt]_eqn:Heqs.
+ unfold sqrt. rewrite Heqs.
rewrite Rabs_R0; apply H2.
- assert (H6 := Rge_le _ _ r0); elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H6 r)).
rewrite Rabs_right.
apply Rsqr_incrst_0.
rewrite Rsqr_sqrt.
- rewrite (Rabs_right x0 r) in H5; apply H5.
- apply Rge_le; exact r.
- apply sqrt_positivity; apply Rge_le; exact r.
+ rewrite (Rabs_right x0 Hgt) in H5; apply H5.
+ apply Rge_le; exact Hgt.
+ apply sqrt_positivity; apply Rge_le; exact Hgt.
left; exact H2.
- apply Rle_ge; apply sqrt_positivity; apply Rge_le; exact r.
+ apply Rle_ge; apply sqrt_positivity; apply Rge_le; exact Hgt.
elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H1 H)).
Qed.
diff --git a/theories/Reals/vo.itarget b/theories/Reals/vo.itarget
index 36dd0f56..0c8f0b97 100644
--- a/theories/Reals/vo.itarget
+++ b/theories/Reals/vo.itarget
@@ -8,7 +8,6 @@ Cos_rel.vo
DiscrR.vo
Exp_prop.vo
Integration.vo
-LegacyRfield.vo
Machin.vo
MVT.vo
NewtonInt.vo
diff --git a/theories/Relations/Operators_Properties.v b/theories/Relations/Operators_Properties.v
index 4efc528e..95d9cfa9 100644
--- a/theories/Relations/Operators_Properties.v
+++ b/theories/Relations/Operators_Properties.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -17,6 +17,7 @@ Require Import Relation_Operators.
Section Properties.
+ Arguments clos_refl [A] R x _.
Arguments clos_refl_trans [A] R x _.
Arguments clos_refl_trans_1n [A] R x _.
Arguments clos_refl_trans_n1 [A] R x _.
@@ -34,7 +35,8 @@ Section Properties.
Section Clos_Refl_Trans.
- Local Notation "R *" := (clos_refl_trans R) (at level 8, left associativity).
+ Local Notation "R *" := (clos_refl_trans R)
+ (at level 8, left associativity, format "R *").
(** Correctness of the reflexive-transitive closure operator *)
@@ -71,6 +73,26 @@ Section Properties.
apply rst_trans with y; auto with sets.
Qed.
+ (** Reflexive closure is included in the
+ reflexive-transitive closure *)
+
+ Lemma clos_r_clos_rt :
+ inclusion (clos_refl R) (clos_refl_trans R).
+ Proof.
+ induction 1 as [? ?| ].
+ constructor; auto.
+ constructor 2.
+ Qed.
+
+ Lemma clos_rt_t : forall x y z,
+ clos_refl_trans R x y -> clos_trans R y z ->
+ clos_trans R x z.
+ Proof.
+ induction 1 as [b d H1|b|a b d H1 H2 IH1 IH2]; auto.
+ intro H. apply t_trans with (y:=d); auto.
+ constructor. auto.
+ Qed.
+
(** Correctness of the reflexive-symmetric-transitive closure *)
Lemma clos_rst_is_equiv : equivalence A (clos_refl_sym_trans R).
@@ -382,6 +404,13 @@ Section Properties.
End Equivalences.
+ Lemma clos_trans_transp_permute : forall x y,
+ transp _ (clos_trans R) x y <-> clos_trans (transp _ R) x y.
+ Proof.
+ split; induction 1;
+ (apply t_step; assumption) || eapply t_trans; eassumption.
+ Qed.
+
End Properties.
(* begin hide *)
diff --git a/theories/Relations/Relation_Definitions.v b/theories/Relations/Relation_Definitions.v
index 390d38b5..a187f955 100644
--- a/theories/Relations/Relation_Definitions.v
+++ b/theories/Relations/Relation_Definitions.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Relations/Relation_Operators.v b/theories/Relations/Relation_Operators.v
index 701bc073..4e52017e 100644
--- a/theories/Relations/Relation_Operators.v
+++ b/theories/Relations/Relation_Operators.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -46,6 +46,20 @@ Section Transitive_Closure.
End Transitive_Closure.
+(** ** Reflexive closure *)
+
+Section Reflexive_Closure.
+ Variable A : Type.
+ Variable R : relation A.
+
+ (** Definition by direct transitive closure *)
+
+ Inductive clos_refl (x: A) : A -> Prop :=
+ | r_step (y:A) : R x y -> clos_refl x y
+ | r_refl : clos_refl x x.
+
+End Reflexive_Closure.
+
(** ** Reflexive-transitive closure *)
Section Reflexive_Transitive_Closure.
@@ -204,7 +218,7 @@ Section Lexicographic_Exponentiation.
| d_nil : Desc Nil
| d_one (x:A) : Desc (x :: Nil)
| d_conc (x y:A) (l:List) :
- leA x y -> Desc (l ++ y :: Nil) -> Desc ((l ++ y :: Nil) ++ x :: Nil).
+ clos_refl A leA x y -> Desc (l ++ y :: Nil) -> Desc ((l ++ y :: Nil) ++ x :: Nil).
Definition Pow : Set := sig Desc.
diff --git a/theories/Relations/Relations.v b/theories/Relations/Relations.v
index 6e634db3..ce849a16 100644
--- a/theories/Relations/Relations.v
+++ b/theories/Relations/Relations.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Setoids/Setoid.v b/theories/Setoids/Setoid.v
index ccecb9a4..75cffa7f 100644
--- a/theories/Setoids/Setoid.v
+++ b/theories/Setoids/Setoid.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -16,14 +16,17 @@ Definition Setoid_Theory := @Equivalence.
Definition Build_Setoid_Theory := @Build_Equivalence.
Definition Seq_refl A Aeq (s : Setoid_Theory A Aeq) : forall x:A, Aeq x x.
+Proof.
unfold Setoid_Theory in s. intros ; reflexivity.
Defined.
Definition Seq_sym A Aeq (s : Setoid_Theory A Aeq) : forall x y:A, Aeq x y -> Aeq y x.
+Proof.
unfold Setoid_Theory in s. intros ; symmetry ; assumption.
Defined.
Definition Seq_trans A Aeq (s : Setoid_Theory A Aeq) : forall x y z:A, Aeq x y -> Aeq y z -> Aeq x z.
+Proof.
unfold Setoid_Theory in s. intros ; transitivity y ; assumption.
Defined.
diff --git a/theories/Sets/Classical_sets.v b/theories/Sets/Classical_sets.v
index 44af113e..aa2c144b 100644
--- a/theories/Sets/Classical_sets.v
+++ b/theories/Sets/Classical_sets.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -26,7 +26,7 @@
Require Export Ensembles.
Require Export Constructive_sets.
-Require Export Classical_Type.
+Require Export Classical.
Section Ensembles_classical.
Variable U : Type.
diff --git a/theories/Sets/Constructive_sets.v b/theories/Sets/Constructive_sets.v
index 49f0ead1..193bec78 100644
--- a/theories/Sets/Constructive_sets.v
+++ b/theories/Sets/Constructive_sets.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Sets/Cpo.v b/theories/Sets/Cpo.v
index bfd0cf5a..f2fac097 100644
--- a/theories/Sets/Cpo.v
+++ b/theories/Sets/Cpo.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -32,9 +32,9 @@ Section Bounds.
Variable U : Type.
Variable D : PO U.
- Let C := Carrier_of U D.
+ Let C := @Carrier_of U D.
- Let R := Rel_of U D.
+ Let R := @Rel_of U D.
Inductive Upper_Bound (B:Ensemble U) (x:U) : Prop :=
Upper_Bound_definition :
@@ -103,6 +103,6 @@ Section Specific_orders.
Record Chain : Type := Definition_of_chain
{PO_of_chain : PO U;
- Chain_cond : Totally_ordered U PO_of_chain (Carrier_of U PO_of_chain)}.
+ Chain_cond : Totally_ordered U PO_of_chain (@Carrier_of _ PO_of_chain)}.
End Specific_orders.
diff --git a/theories/Sets/Ensembles.v b/theories/Sets/Ensembles.v
index 4730d029..c0cddbe1 100644
--- a/theories/Sets/Ensembles.v
+++ b/theories/Sets/Ensembles.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Sets/Finite_sets.v b/theories/Sets/Finite_sets.v
index 34775862..22cb3dae 100644
--- a/theories/Sets/Finite_sets.v
+++ b/theories/Sets/Finite_sets.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Sets/Finite_sets_facts.v b/theories/Sets/Finite_sets_facts.v
index c0305e91..b1c12c7f 100644
--- a/theories/Sets/Finite_sets_facts.v
+++ b/theories/Sets/Finite_sets_facts.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -26,7 +26,7 @@
Require Export Finite_sets.
Require Export Constructive_sets.
-Require Export Classical_Type.
+Require Export Classical.
Require Export Classical_sets.
Require Export Powerset.
Require Export Powerset_facts.
diff --git a/theories/Sets/Image.v b/theories/Sets/Image.v
index b5ca19a8..6cf4d250 100644
--- a/theories/Sets/Image.v
+++ b/theories/Sets/Image.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -26,7 +26,7 @@
Require Export Finite_sets.
Require Export Constructive_sets.
-Require Export Classical_Type.
+Require Export Classical.
Require Export Classical_sets.
Require Export Powerset.
Require Export Powerset_facts.
diff --git a/theories/Sets/Infinite_sets.v b/theories/Sets/Infinite_sets.v
index 3b7b129e..5860f960 100644
--- a/theories/Sets/Infinite_sets.v
+++ b/theories/Sets/Infinite_sets.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -26,7 +26,7 @@
Require Export Finite_sets.
Require Export Constructive_sets.
-Require Export Classical_Type.
+Require Export Classical.
Require Export Classical_sets.
Require Export Powerset.
Require Export Powerset_facts.
diff --git a/theories/Sets/Integers.v b/theories/Sets/Integers.v
index 1e6430e4..944e0dd1 100644
--- a/theories/Sets/Integers.v
+++ b/theories/Sets/Integers.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -26,7 +26,7 @@
Require Export Finite_sets.
Require Export Constructive_sets.
-Require Export Classical_Type.
+Require Export Classical.
Require Export Classical_sets.
Require Export Powerset.
Require Export Powerset_facts.
diff --git a/theories/Sets/Multiset.v b/theories/Sets/Multiset.v
index f6ebe42f..46dbe994 100644
--- a/theories/Sets/Multiset.v
+++ b/theories/Sets/Multiset.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Sets/Partial_Order.v b/theories/Sets/Partial_Order.v
index 909cd69b..35d5f91a 100644
--- a/theories/Sets/Partial_Order.v
+++ b/theories/Sets/Partial_Order.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -61,7 +61,7 @@ Section Partial_order_facts.
Lemma Strict_Rel_Transitive_with_Rel :
forall x y z:U,
- Strict_Rel_of U D x y -> Rel_of U D y z -> Strict_Rel_of U D x z.
+ Strict_Rel_of U D x y -> @Rel_of U D y z -> Strict_Rel_of U D x z.
Proof.
unfold Strict_Rel_of at 1.
red.
@@ -77,7 +77,7 @@ Section Partial_order_facts.
Lemma Strict_Rel_Transitive_with_Rel_left :
forall x y z:U,
- Rel_of U D x y -> Strict_Rel_of U D y z -> Strict_Rel_of U D x z.
+ @Rel_of U D x y -> Strict_Rel_of U D y z -> Strict_Rel_of U D x z.
Proof.
unfold Strict_Rel_of at 1.
red.
diff --git a/theories/Sets/Permut.v b/theories/Sets/Permut.v
index 93d96ef3..c9c1e5b7 100644
--- a/theories/Sets/Permut.v
+++ b/theories/Sets/Permut.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Sets/Powerset.v b/theories/Sets/Powerset.v
index b761c972..587d48ab 100644
--- a/theories/Sets/Powerset.v
+++ b/theories/Sets/Powerset.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Sets/Powerset_Classical_facts.v b/theories/Sets/Powerset_Classical_facts.v
index 1071f2ce..40fd5e67 100644
--- a/theories/Sets/Powerset_Classical_facts.v
+++ b/theories/Sets/Powerset_Classical_facts.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -32,7 +32,7 @@ Require Export Partial_Order.
Require Export Cpo.
Require Export Powerset.
Require Export Powerset_facts.
-Require Export Classical_Type.
+Require Export Classical.
Require Export Classical_sets.
Section Sets_as_an_algebra.
diff --git a/theories/Sets/Powerset_facts.v b/theories/Sets/Powerset_facts.v
index 4cbb1d7c..e9347ce3 100644
--- a/theories/Sets/Powerset_facts.v
+++ b/theories/Sets/Powerset_facts.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Sets/Relations_1.v b/theories/Sets/Relations_1.v
index 8effeb95..c9148e00 100644
--- a/theories/Sets/Relations_1.v
+++ b/theories/Sets/Relations_1.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Sets/Relations_1_facts.v b/theories/Sets/Relations_1_facts.v
index ce6df104..f650a50c 100644
--- a/theories/Sets/Relations_1_facts.v
+++ b/theories/Sets/Relations_1_facts.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Sets/Relations_2.v b/theories/Sets/Relations_2.v
index 7ff57572..ea48fd91 100644
--- a/theories/Sets/Relations_2.v
+++ b/theories/Sets/Relations_2.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Sets/Relations_2_facts.v b/theories/Sets/Relations_2_facts.v
index 460255ab..e0543501 100644
--- a/theories/Sets/Relations_2_facts.v
+++ b/theories/Sets/Relations_2_facts.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Sets/Relations_3.v b/theories/Sets/Relations_3.v
index 2f6ef730..de6770ee 100644
--- a/theories/Sets/Relations_3.v
+++ b/theories/Sets/Relations_3.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Sets/Relations_3_facts.v b/theories/Sets/Relations_3_facts.v
index 8111afd9..0180c7d4 100644
--- a/theories/Sets/Relations_3_facts.v
+++ b/theories/Sets/Relations_3_facts.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Sets/Uniset.v b/theories/Sets/Uniset.v
index ce2f4004..86ba903f 100644
--- a/theories/Sets/Uniset.v
+++ b/theories/Sets/Uniset.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Sorting/Heap.v b/theories/Sorting/Heap.v
index 1cff280a..6313dbf6 100644
--- a/theories/Sorting/Heap.v
+++ b/theories/Sorting/Heap.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -152,23 +152,23 @@ Section defs.
revert l2 H0. fix 1. intros.
destruct l2 as [|a0 l0].
apply merge_exist with (a :: l); simpl; auto with datatypes.
- elim (leA_dec a a0); intros.
+ induction (leA_dec a a0) as [Hle|Hle].
(* 1 (leA a a0) *)
apply Sorted_inv in H. destruct H.
- destruct (merge l H (a0 :: l0) H0).
+ destruct (merge l H (a0 :: l0) H0) as [l1 H2 H3 H4].
apply merge_exist with (a :: l1). clear merge merge0.
auto using cons_sort, cons_leA with datatypes.
- simpl. rewrite m. now rewrite munion_ass.
+ simpl. rewrite H3. now rewrite munion_ass.
intros. apply cons_leA.
apply (@HdRel_inv _ leA) with l; trivial with datatypes.
(* 2 (leA a0 a) *)
apply Sorted_inv in H0. destruct H0.
- destruct (merge0 l0 H0). clear merge merge0.
+ destruct (merge0 l0 H0) as [l1 H2 H3 H4]. clear merge merge0.
apply merge_exist with (a0 :: l1);
auto using cons_sort, cons_leA with datatypes.
- simpl; rewrite m. simpl. setoid_rewrite munion_ass at 1. rewrite munion_comm.
+ simpl; rewrite H3. simpl. setoid_rewrite munion_ass at 1. rewrite munion_comm.
repeat rewrite munion_ass. setoid_rewrite munion_comm at 3. reflexivity.
intros. apply cons_leA.
apply (@HdRel_inv _ leA) with l0; trivial with datatypes.
diff --git a/theories/Sorting/Mergesort.v b/theories/Sorting/Mergesort.v
index b08e1e1e..593b2e9b 100644
--- a/theories/Sorting/Mergesort.v
+++ b/theories/Sorting/Mergesort.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Sorting/PermutEq.v b/theories/Sorting/PermutEq.v
index 6579fcdb..9bae43c2 100644
--- a/theories/Sorting/PermutEq.v
+++ b/theories/Sorting/PermutEq.v
@@ -1,19 +1,19 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
(************************************************************************)
-Require Import Relations Setoid SetoidList List Multiset PermutSetoid Permutation.
+Require Import Relations Setoid SetoidList List Multiset PermutSetoid Permutation Omega.
Set Implicit Arguments.
(** This file is similar to [PermutSetoid], except that the equality used here
is Coq usual one instead of a setoid equality. In particular, we can then
- prove the equivalence between [List.Permutation] and
- [Permutation.permutation].
+ prove the equivalence between [Permutation.Permutation] and
+ [PermutSetoid.permutation].
*)
Section Perm.
diff --git a/theories/Sorting/PermutSetoid.v b/theories/Sorting/PermutSetoid.v
index 681e8824..64dda448 100644
--- a/theories/Sorting/PermutSetoid.v
+++ b/theories/Sorting/PermutSetoid.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -19,7 +19,7 @@ Require Import Omega Relations Multiset SetoidList.
The relation between the two relations are in lemma
[permutation_Permutation].
- File [PermutEq] concerns Leibniz equality : it shows in particular
+ File [Permutation] concerns Leibniz equality : it shows in particular
that [List.Permutation] and [permutation] are equivalent in this context.
*)
@@ -179,7 +179,7 @@ Proof.
simpl; trivial using permut_refl.
simpl.
apply permut_add_cons_inside.
- rewrite <- app_nil_end. trivial.
+ rewrite app_nil_r. trivial.
Qed.
(** * Some inversion results. *)
diff --git a/theories/Sorting/Permutation.v b/theories/Sorting/Permutation.v
index 803e1083..fcb4e787 100644
--- a/theories/Sorting/Permutation.v
+++ b/theories/Sorting/Permutation.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -13,12 +13,10 @@
(* Adapted in May 2006 by Jean-Marc Notin from initial contents by
Laurent Théry (Huffmann contribution, October 2003) *)
-Require Import List Setoid.
-
+Require Import List Setoid Compare_dec Morphisms FinFun.
+Import ListNotations. (* For notations [] and [a;b;c] *)
Set Implicit Arguments.
-
-Local Notation "[ ]" := nil.
-Local Notation "[ a ; .. ; b ]" := (a :: .. (b :: []) ..).
+(* Set Universe Polymorphism. *)
Section Permutation.
@@ -28,7 +26,8 @@ Inductive Permutation : list A -> list A -> Prop :=
| perm_nil: Permutation [] []
| perm_skip x l l' : Permutation l l' -> Permutation (x::l) (x::l')
| perm_swap x y l : Permutation (y::x::l) (x::y::l)
-| perm_trans l l' l'' : Permutation l l' -> Permutation l' l'' -> Permutation l l''.
+| perm_trans l l' l'' :
+ Permutation l l' -> Permutation l' l'' -> Permutation l l''.
Local Hint Constructors Permutation.
@@ -41,7 +40,8 @@ Proof.
induction HF; discriminate || auto.
Qed.
-Theorem Permutation_nil_cons : forall (l : list A) (x : A), ~ Permutation nil (x::l).
+Theorem Permutation_nil_cons : forall (l : list A) (x : A),
+ ~ Permutation nil (x::l).
Proof.
intros l x HF.
apply Permutation_nil in HF; discriminate.
@@ -54,13 +54,15 @@ Proof.
induction l; constructor. exact IHl.
Qed.
-Theorem Permutation_sym : forall l l' : list A, Permutation l l' -> Permutation l' l.
+Theorem Permutation_sym : forall l l' : list A,
+ Permutation l l' -> Permutation l' l.
Proof.
intros l l' Hperm; induction Hperm; auto.
apply perm_trans with (l':=l'); assumption.
Qed.
-Theorem Permutation_trans : forall l l' l'' : list A, Permutation l l' -> Permutation l' l'' -> Permutation l l''.
+Theorem Permutation_trans : forall l l' l'' : list A,
+ Permutation l l' -> Permutation l' l'' -> Permutation l l''.
Proof.
exact perm_trans.
Qed.
@@ -83,11 +85,10 @@ Instance Permutation_Equivalence A : Equivalence (@Permutation A) | 10 := {
Equivalence_Symmetric := @Permutation_sym A ;
Equivalence_Transitive := @Permutation_trans A }.
-Add Parametric Morphism A (a:A) : (cons a)
- with signature @Permutation A ==> @Permutation A
- as Permutation_cons.
+Instance Permutation_cons A :
+ Proper (Logic.eq ==> @Permutation A ==> @Permutation A) (@cons A) | 10.
Proof.
- auto using perm_skip.
+ repeat intro; subst; auto using perm_skip.
Qed.
Section Permutation_properties.
@@ -99,35 +100,48 @@ Implicit Types l m : list A.
(** Compatibility with others operations on lists *)
-Theorem Permutation_in : forall (l l' : list A) (x : A), Permutation l l' -> In x l -> In x l'.
+Theorem Permutation_in : forall (l l' : list A) (x : A),
+ Permutation l l' -> In x l -> In x l'.
Proof.
intros l l' x Hperm; induction Hperm; simpl; tauto.
Qed.
-Lemma Permutation_app_tail : forall (l l' tl : list A), Permutation l l' -> Permutation (l++tl) (l'++tl).
+Global Instance Permutation_in' :
+ Proper (Logic.eq ==> @Permutation A ==> iff) (@In A) | 10.
+Proof.
+ repeat red; intros; subst; eauto using Permutation_in.
+Qed.
+
+Lemma Permutation_app_tail : forall (l l' tl : list A),
+ Permutation l l' -> Permutation (l++tl) (l'++tl).
Proof.
intros l l' tl Hperm; induction Hperm as [|x l l'|x y l|l l' l'']; simpl; auto.
eapply Permutation_trans with (l':=l'++tl); trivial.
Qed.
-Lemma Permutation_app_head : forall (l tl tl' : list A), Permutation tl tl' -> Permutation (l++tl) (l++tl').
+Lemma Permutation_app_head : forall (l tl tl' : list A),
+ Permutation tl tl' -> Permutation (l++tl) (l++tl').
Proof.
- intros l tl tl' Hperm; induction l; [trivial | repeat rewrite <- app_comm_cons; constructor; assumption].
+ intros l tl tl' Hperm; induction l;
+ [trivial | repeat rewrite <- app_comm_cons; constructor; assumption].
Qed.
-Theorem Permutation_app : forall (l m l' m' : list A), Permutation l l' -> Permutation m m' -> Permutation (l++m) (l'++m').
+Theorem Permutation_app : forall (l m l' m' : list A),
+ Permutation l l' -> Permutation m m' -> Permutation (l++m) (l'++m').
Proof.
- intros l m l' m' Hpermll' Hpermmm'; induction Hpermll' as [|x l l'|x y l|l l' l'']; repeat rewrite <- app_comm_cons; auto.
+ intros l m l' m' Hpermll' Hpermmm';
+ induction Hpermll' as [|x l l'|x y l|l l' l''];
+ repeat rewrite <- app_comm_cons; auto.
apply Permutation_trans with (l' := (x :: y :: l ++ m));
- [idtac | repeat rewrite app_comm_cons; apply Permutation_app_head]; trivial.
+ [idtac | repeat rewrite app_comm_cons; apply Permutation_app_head]; trivial.
apply Permutation_trans with (l' := (l' ++ m')); try assumption.
apply Permutation_app_tail; assumption.
Qed.
-Add Parametric Morphism : (@app A)
- with signature @Permutation A ==> @Permutation A ==> @Permutation A
- as Permutation_app'.
- auto using Permutation_app.
+Global Instance Permutation_app' :
+ Proper (@Permutation A ==> @Permutation A ==> @Permutation A) (@app A) | 10.
+Proof.
+ repeat intro; now apply Permutation_app.
Qed.
Lemma Permutation_add_inside : forall a (l l' tl tl' : list A),
@@ -146,20 +160,27 @@ Theorem Permutation_app_comm : forall (l l' : list A),
Permutation (l ++ l') (l' ++ l).
Proof.
induction l as [|x l]; simpl; intro l'.
- rewrite app_nil_r; trivial. rewrite IHl.
- rewrite app_comm_cons, Permutation_cons_append.
- now rewrite <- app_assoc.
+ rewrite app_nil_r; trivial. rewrite IHl.
+ rewrite app_comm_cons, Permutation_cons_append.
+ now rewrite <- app_assoc.
Qed.
Local Hint Resolve Permutation_app_comm.
Theorem Permutation_cons_app : forall (l l1 l2:list A) a,
Permutation l (l1 ++ l2) -> Permutation (a :: l) (l1 ++ a :: l2).
-Proof. intros l l1 l2 a H. rewrite H.
- rewrite app_comm_cons, Permutation_cons_append.
- now rewrite <- app_assoc.
+Proof.
+ intros l l1 l2 a H. rewrite H.
+ rewrite app_comm_cons, Permutation_cons_append.
+ now rewrite <- app_assoc.
Qed.
Local Hint Resolve Permutation_cons_app.
+Lemma Permutation_Add a l l' : Add a l l' -> Permutation (a::l) l'.
+Proof.
+ induction 1; simpl; trivial.
+ rewrite perm_swap. now apply perm_skip.
+Qed.
+
Theorem Permutation_middle : forall (l1 l2:list A) a,
Permutation (a :: l1 ++ l2) (l1 ++ a :: l2).
Proof.
@@ -169,18 +190,27 @@ Local Hint Resolve Permutation_middle.
Theorem Permutation_rev : forall (l : list A), Permutation l (rev l).
Proof.
- induction l as [| x l]; simpl; trivial. now rewrite IHl at 1.
+ induction l as [| x l]; simpl; trivial. now rewrite IHl at 1.
Qed.
-Add Parametric Morphism : (@rev A)
- with signature @Permutation A ==> @Permutation A as Permutation_rev'.
-Proof. intros. now do 2 rewrite <- Permutation_rev. Qed.
+Global Instance Permutation_rev' :
+ Proper (@Permutation A ==> @Permutation A) (@rev A) | 10.
+Proof.
+ repeat intro; now rewrite <- 2 Permutation_rev.
+Qed.
-Theorem Permutation_length : forall (l l' : list A), Permutation l l' -> length l = length l'.
+Theorem Permutation_length : forall (l l' : list A),
+ Permutation l l' -> length l = length l'.
Proof.
intros l l' Hperm; induction Hperm; simpl; auto. now transitivity (length l').
Qed.
+Global Instance Permutation_length' :
+ Proper (@Permutation A ==> Logic.eq) (@length A) | 10.
+Proof.
+ exact Permutation_length.
+Qed.
+
Theorem Permutation_ind_bis :
forall P : list A -> list A -> Prop,
P [] [] ->
@@ -200,73 +230,62 @@ Proof.
eauto.
Qed.
-Ltac break_list l x l' H :=
- destruct l as [|x l']; simpl in *;
- injection H; intros; subst; clear H.
-
-Theorem Permutation_nil_app_cons : forall (l l' : list A) (x : A), ~ Permutation nil (l++x::l').
+Theorem Permutation_nil_app_cons : forall (l l' : list A) (x : A),
+ ~ Permutation nil (l++x::l').
Proof.
- intros l l' x HF.
+ intros l l' x HF.
apply Permutation_nil in HF. destruct l; discriminate.
Qed.
-Theorem Permutation_app_inv : forall (l1 l2 l3 l4:list A) a,
+Ltac InvAdd := repeat (match goal with
+ | H: Add ?x _ (_ :: _) |- _ => inversion H; clear H; subst
+ end).
+
+Ltac finish_basic_perms H :=
+ try constructor; try rewrite perm_swap; try constructor; trivial;
+ (rewrite <- H; now apply Permutation_Add) ||
+ (rewrite H; symmetry; now apply Permutation_Add).
+
+Theorem Permutation_Add_inv a l1 l2 :
+ Permutation l1 l2 -> forall l1' l2', Add a l1' l1 -> Add a l2' l2 ->
+ Permutation l1' l2'.
+Proof.
+ revert l1 l2. refine (Permutation_ind_bis _ _ _ _ _).
+ - (* nil *)
+ inversion_clear 1.
+ - (* skip *)
+ intros x l1 l2 PE IH. intros. InvAdd; try finish_basic_perms PE.
+ constructor. now apply IH.
+ - (* swap *)
+ intros x y l1 l2 PE IH. intros. InvAdd; try finish_basic_perms PE.
+ rewrite perm_swap; do 2 constructor. now apply IH.
+ - (* trans *)
+ intros l1 l l2 PE IH PE' IH' l1' l2' AD1 AD2.
+ assert (Ha : In a l). { rewrite <- PE. rewrite (Add_in AD1). simpl; auto. }
+ destruct (Add_inv _ _ Ha) as (l',AD).
+ transitivity l'; auto.
+Qed.
+
+Theorem Permutation_app_inv (l1 l2 l3 l4:list A) a :
Permutation (l1++a::l2) (l3++a::l4) -> Permutation (l1++l2) (l3 ++ l4).
Proof.
- set (P l l' :=
- forall a l1 l2 l3 l4, l=l1++a::l2 -> l'=l3++a::l4 -> Permutation (l1++l2) (l3++l4)).
- cut (forall l l', Permutation l l' -> P l l').
- intros; apply (H _ _ H0 a); auto.
- intros; apply (Permutation_ind_bis P); unfold P; clear P; try clear H l l'; simpl; auto.
-(* nil *)
- intros; destruct l1; simpl in *; discriminate.
- (* skip *)
- intros x l l' H IH; intros.
- break_list l1 b l1' H0; break_list l3 c l3' H1.
- auto.
- now rewrite H.
- now rewrite <- H.
- now rewrite (IH a _ _ _ _ eq_refl eq_refl).
- (* contradict *)
- intros x y l l' Hp IH; intros.
- break_list l1 b l1' H; break_list l3 c l3' H0.
- auto.
- break_list l3' b l3'' H.
- auto.
- rewrite <- Permutation_middle in Hp. now rewrite Hp.
- break_list l1' c l1'' H1.
- auto.
- rewrite <- Permutation_middle in Hp. now rewrite Hp.
- break_list l3' d l3'' H; break_list l1' e l1'' H1.
- auto.
- rewrite <- Permutation_middle in Hp. rewrite perm_swap. auto.
- rewrite perm_swap, Permutation_middle. auto.
- now rewrite perm_swap, (IH a _ _ _ _ eq_refl eq_refl).
- (*trans*)
- intros.
- destruct (In_split a l') as (l'1,(l'2,H6)).
- apply (Permutation_in a H).
- subst l.
- apply in_or_app; right; red; auto.
- apply perm_trans with (l'1++l'2).
- apply (H0 _ _ _ _ _ H3 H6).
- apply (H2 _ _ _ _ _ H6 H4).
+ intros. eapply Permutation_Add_inv; eauto using Add_app.
Qed.
-Theorem Permutation_cons_inv :
- forall l l' a, Permutation (a::l) (a::l') -> Permutation l l'.
+Theorem Permutation_cons_inv l l' a :
+ Permutation (a::l) (a::l') -> Permutation l l'.
Proof.
- intros; exact (Permutation_app_inv [] l [] l' a H).
+ intro. eapply Permutation_Add_inv; eauto using Add_head.
Qed.
-Theorem Permutation_cons_app_inv :
- forall l l1 l2 a, Permutation (a :: l) (l1 ++ a :: l2) -> Permutation l (l1 ++ l2).
+Theorem Permutation_cons_app_inv l l1 l2 a :
+ Permutation (a :: l) (l1 ++ a :: l2) -> Permutation l (l1 ++ l2).
Proof.
- intros; exact (Permutation_app_inv [] l l1 l2 a H).
+ intro. eapply Permutation_Add_inv; eauto using Add_head, Add_app.
Qed.
-Theorem Permutation_app_inv_l :
- forall l l1 l2, Permutation (l ++ l1) (l ++ l2) -> Permutation l1 l2.
+Theorem Permutation_app_inv_l : forall l l1 l2,
+ Permutation (l ++ l1) (l ++ l2) -> Permutation l1 l2.
Proof.
induction l; simpl; auto.
intros.
@@ -274,20 +293,16 @@ Proof.
apply Permutation_cons_inv with a; auto.
Qed.
-Theorem Permutation_app_inv_r :
- forall l l1 l2, Permutation (l1 ++ l) (l2 ++ l) -> Permutation l1 l2.
+Theorem Permutation_app_inv_r l l1 l2 :
+ Permutation (l1 ++ l) (l2 ++ l) -> Permutation l1 l2.
Proof.
- induction l.
- intros l1 l2; do 2 rewrite app_nil_r; auto.
- intros.
- apply IHl.
- apply Permutation_app_inv with a; auto.
+ rewrite 2 (Permutation_app_comm _ l). apply Permutation_app_inv_l.
Qed.
Lemma Permutation_length_1_inv: forall a l, Permutation [a] l -> l = [a].
Proof.
intros a l H; remember [a] as m in H.
- induction H; try (injection Heqm as -> ->; clear Heqm);
+ induction H; try (injection Heqm as -> ->);
discriminate || auto.
apply Permutation_nil in H as ->; trivial.
Qed.
@@ -318,32 +333,47 @@ Proof.
apply Permutation_length_2_inv in H as [H|H]; injection H as -> ->; auto.
Qed.
-Lemma NoDup_Permutation : forall l l',
- NoDup l -> NoDup l' -> (forall x:A, In x l <-> In x l') -> Permutation l l'.
+Lemma NoDup_Permutation l l' : NoDup l -> NoDup l' ->
+ (forall x:A, In x l <-> In x l') -> Permutation l l'.
Proof.
- induction l.
- destruct l'; simpl; intros.
- apply perm_nil.
- destruct (H1 a) as (_,H2); destruct H2; auto.
- intros.
- destruct (In_split a l') as (l'1,(l'2,H2)).
- destruct (H1 a) as (H2,H3); simpl in *; auto.
- subst l'.
- apply Permutation_cons_app.
- inversion_clear H.
- apply IHl; auto.
- apply NoDup_remove_1 with a; auto.
- intro x; split; intros.
- assert (In x (l'1++a::l'2)).
- destruct (H1 x); simpl in *; auto.
- apply in_or_app; destruct (in_app_or _ _ _ H4); auto.
- destruct H5; auto.
- subst x; destruct H2; auto.
- assert (In x (l'1++a::l'2)).
- apply in_or_app; destruct (in_app_or _ _ _ H); simpl; auto.
- destruct (H1 x) as (_,H5); destruct H5; auto.
- subst x.
- destruct (NoDup_remove_2 _ _ _ H0 H).
+ intros N. revert l'. induction N as [|a l Hal Hl IH].
+ - destruct l'; simpl; auto.
+ intros Hl' H. exfalso. rewrite (H a); auto.
+ - intros l' Hl' H.
+ assert (Ha : In a l') by (apply H; simpl; auto).
+ destruct (Add_inv _ _ Ha) as (l'' & AD).
+ rewrite <- (Permutation_Add AD).
+ apply perm_skip.
+ apply IH; clear IH.
+ * now apply (NoDup_Add AD).
+ * split.
+ + apply incl_Add_inv with a l'; trivial. intro. apply H.
+ + intro Hx.
+ assert (Hx' : In x (a::l)).
+ { apply H. rewrite (Add_in AD). now right. }
+ destruct Hx'; simpl; trivial. subst.
+ rewrite (NoDup_Add AD) in Hl'. tauto.
+Qed.
+
+Lemma NoDup_Permutation_bis l l' : NoDup l -> NoDup l' ->
+ length l' <= length l -> incl l l' -> Permutation l l'.
+Proof.
+ intros. apply NoDup_Permutation; auto.
+ split; auto. apply NoDup_length_incl; trivial.
+Qed.
+
+Lemma Permutation_NoDup l l' : Permutation l l' -> NoDup l -> NoDup l'.
+Proof.
+ induction 1; auto.
+ * inversion_clear 1; constructor; eauto using Permutation_in.
+ * inversion_clear 1 as [|? ? H1 H2]. inversion_clear H2; simpl in *.
+ constructor. simpl; intuition. constructor; intuition.
+Qed.
+
+Global Instance Permutation_NoDup' :
+ Proper (@Permutation A ==> iff) (@NoDup A) | 10.
+Proof.
+ repeat red; eauto using Permutation_NoDup.
Qed.
End Permutation_properties.
@@ -353,20 +383,194 @@ Section Permutation_map.
Variable A B : Type.
Variable f : A -> B.
-Add Parametric Morphism : (map f)
- with signature (@Permutation A) ==> (@Permutation B) as Permutation_map_aux.
+Lemma Permutation_map l l' :
+ Permutation l l' -> Permutation (map f l) (map f l').
Proof.
- induction 1; simpl; eauto using Permutation.
+ induction 1; simpl; eauto.
Qed.
-Lemma Permutation_map :
- forall l l', Permutation l l' -> Permutation (map f l) (map f l').
+Global Instance Permutation_map' :
+ Proper (@Permutation A ==> @Permutation B) (map f) | 10.
Proof.
- exact Permutation_map_aux_Proper.
+ exact Permutation_map.
Qed.
End Permutation_map.
+Lemma nat_bijection_Permutation n f :
+ bFun n f ->
+ Injective f ->
+ let l := seq 0 n in Permutation (map f l) l.
+Proof.
+ intros Hf BD.
+ apply NoDup_Permutation_bis; auto using Injective_map_NoDup, seq_NoDup.
+ * now rewrite map_length.
+ * intros x. rewrite in_map_iff. intros (y & <- & Hy').
+ rewrite in_seq in *. simpl in *.
+ destruct Hy' as (_,Hy'). auto with arith.
+Qed.
+
+Section Permutation_alt.
+Variable A:Type.
+Implicit Type a : A.
+Implicit Type l : list A.
+
+(** Alternative characterization of permutation
+ via [nth_error] and [nth] *)
+
+Let adapt f n :=
+ let m := f (S n) in if le_lt_dec m (f 0) then m else pred m.
+
+Let adapt_injective f : Injective f -> Injective (adapt f).
+Proof.
+ unfold adapt. intros Hf x y EQ.
+ destruct le_lt_dec as [LE|LT]; destruct le_lt_dec as [LE'|LT'].
+ - now apply eq_add_S, Hf.
+ - apply Lt.le_lt_or_eq in LE.
+ destruct LE as [LT|EQ']; [|now apply Hf in EQ'].
+ unfold lt in LT. rewrite EQ in LT.
+ rewrite <- (Lt.S_pred _ _ LT') in LT.
+ elim (Lt.lt_not_le _ _ LT' LT).
+ - apply Lt.le_lt_or_eq in LE'.
+ destruct LE' as [LT'|EQ']; [|now apply Hf in EQ'].
+ unfold lt in LT'. rewrite <- EQ in LT'.
+ rewrite <- (Lt.S_pred _ _ LT) in LT'.
+ elim (Lt.lt_not_le _ _ LT LT').
+ - apply eq_add_S, Hf.
+ now rewrite (Lt.S_pred _ _ LT), (Lt.S_pred _ _ LT'), EQ.
+Qed.
+
+Let adapt_ok a l1 l2 f : Injective f -> length l1 = f 0 ->
+ forall n, nth_error (l1++a::l2) (f (S n)) = nth_error (l1++l2) (adapt f n).
+Proof.
+ unfold adapt. intros Hf E n.
+ destruct le_lt_dec as [LE|LT].
+ - apply Lt.le_lt_or_eq in LE.
+ destruct LE as [LT|EQ]; [|now apply Hf in EQ].
+ rewrite <- E in LT.
+ rewrite 2 nth_error_app1; auto.
+ - rewrite (Lt.S_pred _ _ LT) at 1.
+ rewrite <- E, (Lt.S_pred _ _ LT) in LT.
+ rewrite 2 nth_error_app2; auto with arith.
+ rewrite <- Minus.minus_Sn_m; auto with arith.
+Qed.
+
+Lemma Permutation_nth_error l l' :
+ Permutation l l' <->
+ (length l = length l' /\
+ exists f:nat->nat,
+ Injective f /\ forall n, nth_error l' n = nth_error l (f n)).
+Proof.
+ split.
+ { intros P.
+ split; [now apply Permutation_length|].
+ induction P.
+ - exists (fun n => n).
+ split; try red; auto.
+ - destruct IHP as (f & Hf & Hf').
+ exists (fun n => match n with O => O | S n => S (f n) end).
+ split; try red.
+ * intros [|y] [|z]; simpl; now auto.
+ * intros [|n]; simpl; auto.
+ - exists (fun n => match n with 0 => 1 | 1 => 0 | n => n end).
+ split; try red.
+ * intros [|[|z]] [|[|t]]; simpl; now auto.
+ * intros [|[|n]]; simpl; auto.
+ - destruct IHP1 as (f & Hf & Hf').
+ destruct IHP2 as (g & Hg & Hg').
+ exists (fun n => f (g n)).
+ split; try red.
+ * auto.
+ * intros n. rewrite <- Hf'; auto. }
+ { revert l. induction l'.
+ - intros [|l] (E & _); now auto.
+ - intros l (E & f & Hf & Hf').
+ simpl in E.
+ assert (Ha : nth_error l (f 0) = Some a)
+ by (symmetry; apply (Hf' 0)).
+ destruct (nth_error_split l (f 0) Ha) as (l1 & l2 & L12 & L1).
+ rewrite L12. rewrite <- Permutation_middle. constructor.
+ apply IHl'; split; [|exists (adapt f); split].
+ * revert E. rewrite L12, !app_length. simpl.
+ rewrite <- plus_n_Sm. now injection 1.
+ * now apply adapt_injective.
+ * intro n. rewrite <- (adapt_ok a), <- L12; auto.
+ apply (Hf' (S n)). }
+Qed.
+
+Lemma Permutation_nth_error_bis l l' :
+ Permutation l l' <->
+ exists f:nat->nat,
+ Injective f /\
+ bFun (length l) f /\
+ (forall n, nth_error l' n = nth_error l (f n)).
+Proof.
+ rewrite Permutation_nth_error; split.
+ - intros (E & f & Hf & Hf').
+ exists f. do 2 (split; trivial).
+ intros n Hn.
+ destruct (Lt.le_or_lt (length l) (f n)) as [LE|LT]; trivial.
+ rewrite <- nth_error_None, <- Hf', nth_error_None, <- E in LE.
+ elim (Lt.lt_not_le _ _ Hn LE).
+ - intros (f & Hf & Hf2 & Hf3); split; [|exists f; auto].
+ assert (H : length l' <= length l') by auto with arith.
+ rewrite <- nth_error_None, Hf3, nth_error_None in H.
+ destruct (Lt.le_or_lt (length l) (length l')) as [LE|LT];
+ [|apply Hf2 in LT; elim (Lt.lt_not_le _ _ LT H)].
+ apply Lt.le_lt_or_eq in LE. destruct LE as [LT|EQ]; trivial.
+ rewrite <- nth_error_Some, Hf3, nth_error_Some in LT.
+ assert (Hf' : bInjective (length l) f).
+ { intros x y _ _ E. now apply Hf. }
+ rewrite (bInjective_bSurjective Hf2) in Hf'.
+ destruct (Hf' _ LT) as (y & Hy & Hy').
+ apply Hf in Hy'. subst y. elim (Lt.lt_irrefl _ Hy).
+Qed.
+
+Lemma Permutation_nth l l' d :
+ Permutation l l' <->
+ (let n := length l in
+ length l' = n /\
+ exists f:nat->nat,
+ bFun n f /\
+ bInjective n f /\
+ (forall x, x < n -> nth x l' d = nth (f x) l d)).
+Proof.
+ split.
+ - intros H.
+ assert (E := Permutation_length H).
+ split; auto.
+ apply Permutation_nth_error_bis in H.
+ destruct H as (f & Hf & Hf2 & Hf3).
+ exists f. split; [|split]; auto.
+ intros x y _ _ Hxy. now apply Hf.
+ intros n Hn. rewrite <- 2 nth_default_eq. unfold nth_default.
+ now rewrite Hf3.
+ - intros (E & f & Hf1 & Hf2 & Hf3).
+ rewrite Permutation_nth_error.
+ split; auto.
+ exists (fun n => if le_lt_dec (length l) n then n else f n).
+ split.
+ * intros x y.
+ destruct le_lt_dec as [LE|LT];
+ destruct le_lt_dec as [LE'|LT']; auto.
+ + apply Hf1 in LT'. intros ->.
+ elim (Lt.lt_irrefl (f y)). eapply Lt.lt_le_trans; eauto.
+ + apply Hf1 in LT. intros <-.
+ elim (Lt.lt_irrefl (f x)). eapply Lt.lt_le_trans; eauto.
+ * intros n.
+ destruct le_lt_dec as [LE|LT].
+ + assert (LE' : length l' <= n) by (now rewrite E).
+ rewrite <- nth_error_None in LE, LE'. congruence.
+ + assert (LT' : n < length l') by (now rewrite E).
+ specialize (Hf3 n LT). rewrite <- 2 nth_default_eq in Hf3.
+ unfold nth_default in Hf3.
+ apply Hf1 in LT.
+ rewrite <- nth_error_Some in LT, LT'.
+ do 2 destruct nth_error; congruence.
+Qed.
+
+End Permutation_alt.
+
(* begin hide *)
Notation Permutation_app_swap := Permutation_app_comm (only parsing).
-(* end hide *) \ No newline at end of file
+(* end hide *)
diff --git a/theories/Sorting/Sorted.v b/theories/Sorting/Sorted.v
index fde796af..dc4a1e0a 100644
--- a/theories/Sorting/Sorted.v
+++ b/theories/Sorting/Sorted.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -20,6 +20,8 @@
Require Import List Relations Relations_1.
+(* Set Universe Polymorphism. *)
+
(** Preambule *)
Set Implicit Arguments.
@@ -67,7 +69,7 @@ Section defs.
(forall a l, Sorted l -> P l -> HdRel a l -> P (a :: l)) ->
forall l:list A, Sorted l -> P l.
Proof.
- induction l; firstorder using Sorted_inv.
+ induction l. firstorder using Sorted_inv. firstorder using Sorted_inv.
Qed.
Lemma Sorted_LocallySorted_iff : forall l, Sorted l <-> LocallySorted l.
diff --git a/theories/Sorting/Sorting.v b/theories/Sorting/Sorting.v
index 6a9105ab..712b8fd6 100644
--- a/theories/Sorting/Sorting.v
+++ b/theories/Sorting/Sorting.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Strings/Ascii.v b/theories/Strings/Ascii.v
index c2e88251..3dbd9cb4 100644
--- a/theories/Strings/Ascii.v
+++ b/theories/Strings/Ascii.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-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -10,7 +10,7 @@
(** Contributed by Laurent Théry (INRIA);
Adapted to Coq V8 by the Coq Development Team *)
-Require Import Bool BinPos BinNat Nnat.
+Require Import Bool BinPos BinNat PeanoNat Nnat.
Declare ML Module "ascii_syntax_plugin".
(** * Definition of ascii characters *)
@@ -34,6 +34,7 @@ Definition shift (c : bool) (a : ascii) :=
(** Definition of a decidable function that is effective *)
Definition ascii_dec : forall a b : ascii, {a = b} + {a <> b}.
+Proof.
decide equality; apply bool_dec.
Defined.
@@ -115,7 +116,7 @@ Proof.
unfold N.lt.
change 256%N with (N.of_nat 256).
rewrite <- Nat2N.inj_compare.
- rewrite <- Compare_dec.nat_compare_lt. auto.
+ now apply Nat.compare_lt_iff.
Qed.
diff --git a/theories/Strings/String.v b/theories/Strings/String.v
index 34adf332..ac1f158a 100644
--- a/theories/Strings/String.v
+++ b/theories/Strings/String.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-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -29,6 +29,7 @@ Local Open Scope string_scope.
(** Equality is decidable *)
Definition string_dec : forall s1 s2 : string, {s1 = s2} + {s1 <> s2}.
+Proof.
decide equality; apply ascii_dec.
Defined.
@@ -41,7 +42,6 @@ Fixpoint append (s1 s2 : string) : string :=
| EmptyString => s2
| String c s1' => String c (s1' ++ s2)
end
-
where "s1 ++ s2" := (append s1 s2) : string_scope.
(******************************)
@@ -379,7 +379,7 @@ Definition findex n s1 s2 :=
(**
The concrete syntax for strings in scope string_scope follows the
Coq convention for strings: all ascii characters of code less than
- 128 are litteral to the exception of the character `double quote'
+ 128 are literals to the exception of the character `double quote'
which must be doubled.
Strings that involve ascii characters of code >= 128 which are not
diff --git a/theories/Structures/DecidableType.v b/theories/Structures/DecidableType.v
index 79e81771..f85222df 100644
--- a/theories/Structures/DecidableType.v
+++ b/theories/Structures/DecidableType.v
@@ -80,13 +80,13 @@ Module KeyDecidableType(D:DecidableType).
Lemma InA_eqke_eqk :
forall x m, InA eqke x m -> InA eqk x m.
Proof.
- unfold eqke; induction 1; intuition.
+ unfold eqke; induction 1; intuition.
Qed.
Hint Resolve InA_eqke_eqk.
Lemma InA_eqk : forall p q m, eqk p q -> InA eqk p m -> InA eqk q m.
Proof.
- intros; apply InA_eqA with p; auto with *.
+ intros; apply InA_eqA with p; auto with *.
Qed.
Definition MapsTo (k:key)(e:elt):= InA eqke (k,e).
diff --git a/theories/Structures/DecidableTypeEx.v b/theories/Structures/DecidableTypeEx.v
index 971fcd7f..163a40f2 100644
--- a/theories/Structures/DecidableTypeEx.v
+++ b/theories/Structures/DecidableTypeEx.v
@@ -88,7 +88,7 @@ Module PairUsualDecidableType(D1 D2:UsualDecidableType) <: UsualDecidableType.
destruct (D1.eq_dec x1 y1); destruct (D2.eq_dec x2 y2);
unfold eq, D1.eq, D2.eq in *; simpl;
(left; f_equal; auto; fail) ||
- (right; intro H; injection H; auto).
+ (right; injection; auto).
Defined.
End PairUsualDecidableType.
diff --git a/theories/Structures/Equalities.v b/theories/Structures/Equalities.v
index eb537385..747d03f8 100644
--- a/theories/Structures/Equalities.v
+++ b/theories/Structures/Equalities.v
@@ -126,14 +126,14 @@ Module Type DecidableTypeFull' := DecidableTypeFull <+ EqNotation.
[EqualityType] and [DecidableType] *)
Module BackportEq (E:Eq)(F:IsEq E) <: IsEqOrig E.
- Definition eq_refl := @Equivalence_Reflexive _ _ F.eq_equiv.
- Definition eq_sym := @Equivalence_Symmetric _ _ F.eq_equiv.
- Definition eq_trans := @Equivalence_Transitive _ _ F.eq_equiv.
+ Definition eq_refl := F.eq_equiv.(@Equivalence_Reflexive _ _).
+ Definition eq_sym := F.eq_equiv.(@Equivalence_Symmetric _ _).
+ Definition eq_trans := F.eq_equiv.(@Equivalence_Transitive _ _).
End BackportEq.
Module UpdateEq (E:Eq)(F:IsEqOrig E) <: IsEq E.
Instance eq_equiv : Equivalence E.eq.
- Proof. exact (Build_Equivalence _ _ F.eq_refl F.eq_sym F.eq_trans). Qed.
+ Proof. exact (Build_Equivalence _ F.eq_refl F.eq_sym F.eq_trans). Qed.
End UpdateEq.
Module Backport_ET (E:EqualityType) <: EqualityTypeBoth
diff --git a/theories/Structures/EqualitiesFacts.v b/theories/Structures/EqualitiesFacts.v
index c69885b4..11d94c11 100644
--- a/theories/Structures/EqualitiesFacts.v
+++ b/theories/Structures/EqualitiesFacts.v
@@ -166,7 +166,7 @@ Module PairUsualDecidableType(D1 D2:UsualDecidableType) <: UsualDecidableType.
destruct (D1.eq_dec x1 y1); destruct (D2.eq_dec x2 y2);
unfold eq, D1.eq, D2.eq in *; simpl;
(left; f_equal; auto; fail) ||
- (right; intro H; injection H; auto).
+ (right; intros [=]; auto).
Defined.
End PairUsualDecidableType.
diff --git a/theories/Structures/GenericMinMax.v b/theories/Structures/GenericMinMax.v
index ffd0649a..ac52d1bb 100644
--- a/theories/Structures/GenericMinMax.v
+++ b/theories/Structures/GenericMinMax.v
@@ -110,7 +110,7 @@ Proof.
intros x x' Hx y y' Hy.
assert (H1 := max_spec x y). assert (H2 := max_spec x' y').
set (m := max x y) in *; set (m' := max x' y') in *; clearbody m m'.
- rewrite <- Hx, <- Hy in *.
+ rewrite <- Hx, <- Hy in *.
destruct (lt_total x y); intuition order.
Qed.
@@ -440,7 +440,7 @@ Qed.
Lemma max_min_antimono f :
Proper (eq==>eq) f ->
- Proper (le==>inverse le) f ->
+ Proper (le==>flip le) f ->
forall x y, max (f x) (f y) == f (min x y).
Proof.
intros Eqf Lef x y.
@@ -452,7 +452,7 @@ Qed.
Lemma min_max_antimono f :
Proper (eq==>eq) f ->
- Proper (le==>inverse le) f ->
+ Proper (le==>flip le) f ->
forall x y, min (f x) (f y) == f (max x y).
Proof.
intros Eqf Lef x y.
@@ -557,11 +557,11 @@ Module UsualMinMaxLogicalProperties
forall x y, min (f x) (f y) = f (min x y).
Proof. intros; apply min_mono; auto. congruence. Qed.
- Lemma min_max_antimonotone f : Proper (le ==> inverse le) f ->
+ Lemma min_max_antimonotone f : Proper (le ==> flip le) f ->
forall x y, min (f x) (f y) = f (max x y).
Proof. intros; apply min_max_antimono; auto. congruence. Qed.
- Lemma max_min_antimonotone f : Proper (le ==> inverse le) f ->
+ Lemma max_min_antimonotone f : Proper (le ==> flip le) f ->
forall x y, max (f x) (f y) = f (min x y).
Proof. intros; apply max_min_antimono; auto. congruence. Qed.
diff --git a/theories/Structures/OrderedType.v b/theories/Structures/OrderedType.v
index 75578195..cc8c2261 100644
--- a/theories/Structures/OrderedType.v
+++ b/theories/Structures/OrderedType.v
@@ -49,7 +49,7 @@ Module Type OrderedType.
Include MiniOrderedType.
(** A [eq_dec] can be deduced from [compare] below. But adding this
- redundant field allows to see an OrderedType as a DecidableType. *)
+ redundant field allows seeing an OrderedType as a DecidableType. *)
Parameter eq_dec : forall x y, { eq x y } + { ~ eq x y }.
End OrderedType.
@@ -85,16 +85,16 @@ Module OrderedTypeFacts (Import O: OrderedType).
Lemma lt_eq : forall x y z, lt x y -> eq y z -> lt x z.
Proof.
- intros; destruct (compare x z); auto.
+ intros; destruct (compare x z) as [Hlt|Heq|Hlt]; auto.
elim (lt_not_eq H); apply eq_trans with z; auto.
- elim (lt_not_eq (lt_trans l H)); auto.
+ elim (lt_not_eq (lt_trans Hlt H)); auto.
Qed.
Lemma eq_lt : forall x y z, eq x y -> lt y z -> lt x z.
Proof.
- intros; destruct (compare x z); auto.
+ intros; destruct (compare x z) as [Hlt|Heq|Hlt]; auto.
elim (lt_not_eq H0); apply eq_trans with x; auto.
- elim (lt_not_eq (lt_trans H0 l)); auto.
+ elim (lt_not_eq (lt_trans H0 Hlt)); auto.
Qed.
Instance lt_compat : Proper (eq==>eq==>iff) lt.
@@ -225,7 +225,7 @@ Lemma Inf_lt : forall l x y, lt x y -> Inf y l -> Inf x l.
Proof. exact (InfA_ltA lt_strorder). Qed.
Lemma Inf_eq : forall l x y, eq x y -> Inf y l -> Inf x l.
-Proof. exact (InfA_eqA eq_equiv lt_strorder lt_compat). Qed.
+Proof. exact (InfA_eqA eq_equiv lt_compat). Qed.
Lemma Sort_Inf_In : forall l x a, Sort l -> Inf a l -> In x l -> lt a x.
Proof. exact (SortA_InfA_InA eq_equiv lt_strorder lt_compat). Qed.
@@ -398,7 +398,7 @@ Module KeyOrderedType(O:OrderedType).
Qed.
Lemma Inf_eq : forall l x x', eqk x x' -> Inf x' l -> Inf x l.
- Proof. exact (InfA_eqA eqk_equiv ltk_strorder ltk_compat). Qed.
+ Proof. exact (InfA_eqA eqk_equiv ltk_compat). Qed.
Lemma Inf_lt : forall l x x', ltk x x' -> Inf x' l -> Inf x l.
Proof. exact (InfA_ltA ltk_strorder). Qed.
diff --git a/theories/Structures/OrderedTypeEx.v b/theories/Structures/OrderedTypeEx.v
index 83130deb..3c6afc7b 100644
--- a/theories/Structures/OrderedTypeEx.v
+++ b/theories/Structures/OrderedTypeEx.v
@@ -279,7 +279,7 @@ Module PositiveOrderedTypeBits <: UsualOrderedType.
Proof.
induction x; destruct y.
- (* I I *)
- destruct (IHx y).
+ destruct (IHx y) as [l|e|g].
apply LT; auto.
apply EQ; rewrite e; red; auto.
apply GT; auto.
@@ -290,7 +290,7 @@ Module PositiveOrderedTypeBits <: UsualOrderedType.
- (* O I *)
apply LT; simpl; auto.
- (* O O *)
- destruct (IHx y).
+ destruct (IHx y) as [l|e|g].
apply LT; auto.
apply EQ; rewrite e; red; auto.
apply GT; auto.
diff --git a/theories/Structures/Orders.v b/theories/Structures/Orders.v
index 1d025439..724690b4 100644
--- a/theories/Structures/Orders.v
+++ b/theories/Structures/Orders.v
@@ -15,11 +15,11 @@ Unset Strict Implicit.
(** First, signatures with only the order relations *)
Module Type HasLt (Import T:Typ).
- Parameter Inline lt : t -> t -> Prop.
+ Parameter Inline(40) lt : t -> t -> Prop.
End HasLt.
Module Type HasLe (Import T:Typ).
- Parameter Inline le : t -> t -> Prop.
+ Parameter Inline(40) le : t -> t -> Prop.
End HasLe.
Module Type EqLt := Typ <+ HasEq <+ HasLt.
@@ -95,7 +95,7 @@ Module Type OrderedTypeFull' :=
OrderedTypeFull <+ EqLtLeNotation <+ CmpNotation.
(** NB: in [OrderedType], an [eq_dec] could be deduced from [compare].
- But adding this redundant field allows to see an [OrderedType] as a
+ But adding this redundant field allows seeing an [OrderedType] as a
[DecidableType]. *)
(** * Versions with [eq] being the usual Leibniz equality of Coq *)
diff --git a/theories/Structures/OrdersEx.v b/theories/Structures/OrdersEx.v
index e071d053..acc7c767 100644
--- a/theories/Structures/OrdersEx.v
+++ b/theories/Structures/OrdersEx.v
@@ -11,16 +11,16 @@
* Institution: LRI, CNRS UMR 8623 - Université Paris Sud
* 91405 Orsay, France *)
-Require Import Orders NPeano POrderedType NArith
- ZArith RelationPairs EqualitiesFacts.
+Require Import Orders PeanoNat POrderedType BinNat BinInt
+ RelationPairs EqualitiesFacts.
(** * Examples of Ordered Type structures. *)
(** Ordered Type for [nat], [Positive], [N], [Z] with the usual order. *)
-Module Nat_as_OT := NPeano.Nat.
-Module Positive_as_OT := POrderedType.Positive_as_OT.
+Module Nat_as_OT := PeanoNat.Nat.
+Module Positive_as_OT := BinPos.Pos.
Module N_as_OT := BinNat.N.
Module Z_as_OT := BinInt.Z.
diff --git a/theories/Structures/OrdersFacts.v b/theories/Structures/OrdersFacts.v
index 2e9c0cf5..88fbd8c1 100644
--- a/theories/Structures/OrdersFacts.v
+++ b/theories/Structures/OrdersFacts.v
@@ -31,7 +31,7 @@ Module Type CompareFacts (Import O:DecStrOrder').
Lemma compare_lt_iff x y : (x ?= y) = Lt <-> x<y.
Proof.
- case compare_spec; intro H; split; try easy; intro LT;
+ case compare_spec; intro H; split; try easy; intro LT;
contradict LT; rewrite H; apply irreflexivity.
Qed.
@@ -90,7 +90,7 @@ Module Type OrderedTypeFullFacts (Import O:OrderedTypeFull').
Instance le_order : PartialOrder eq le.
Proof. compute; iorder. Qed.
- Instance le_antisym : Antisymmetric _ eq le.
+ Instance le_antisym : Antisymmetric eq le.
Proof. apply partial_order_antisym; auto with *. Qed.
Lemma le_not_gt_iff : forall x y, x<=y <-> ~y<x.
diff --git a/theories/Structures/OrdersLists.v b/theories/Structures/OrdersLists.v
index f83b6377..059992f5 100644
--- a/theories/Structures/OrdersLists.v
+++ b/theories/Structures/OrdersLists.v
@@ -32,7 +32,7 @@ Lemma Inf_lt : forall l x y, lt x y -> Inf y l -> Inf x l.
Proof. exact (InfA_ltA lt_strorder). Qed.
Lemma Inf_eq : forall l x y, eq x y -> Inf y l -> Inf x l.
-Proof. exact (InfA_eqA eq_equiv lt_strorder lt_compat). Qed.
+Proof. exact (InfA_eqA eq_equiv lt_compat). Qed.
Lemma Sort_Inf_In : forall l x a, Sort l -> Inf a l -> In x l -> lt a x.
Proof. exact (SortA_InfA_InA eq_equiv lt_strorder lt_compat). Qed.
diff --git a/theories/Structures/OrdersTac.v b/theories/Structures/OrdersTac.v
index 68ffc379..475a25a4 100644
--- a/theories/Structures/OrdersTac.v
+++ b/theories/Structures/OrdersTac.v
@@ -29,7 +29,7 @@ Set Implicit Arguments.
[le x y -> le y z -> le x z].
*)
-Inductive ord := OEQ | OLT | OLE.
+Inductive ord : Set := OEQ | OLT | OLE.
Definition trans_ord o o' :=
match o, o' with
| OEQ, _ => o'
@@ -70,7 +70,7 @@ Lemma le_refl : forall x, x<=x.
Proof. intros; rewrite P.le_lteq; right; reflexivity. Qed.
Lemma lt_irrefl : forall x, ~ x<x.
-Proof. intros; apply StrictOrder_Irreflexive. Qed.
+Proof. intros. apply StrictOrder_Irreflexive. Qed.
(** Symmetry rules *)
@@ -100,8 +100,9 @@ Local Notation "#" := interp_ord.
Lemma trans : forall o o' x y z, #o x y -> #o' y z -> #(o+o') x z.
Proof.
-destruct o, o'; simpl; intros x y z; rewrite ?P.le_lteq; intuition;
- subst_eqns; eauto using (StrictOrder_Transitive x y z) with *.
+destruct o, o'; simpl; intros x y z;
+rewrite ?P.le_lteq; intuition auto;
+subst_eqns; eauto using (StrictOrder_Transitive x y z) with *.
Qed.
Definition eq_trans x y z : x==y -> y==z -> x==z := @trans OEQ OEQ x y z.
diff --git a/theories/Unicode/Utf8.v b/theories/Unicode/Utf8.v
index f9041aad..3b4beda9 100644
--- a/theories/Unicode/Utf8.v
+++ b/theories/Unicode/Utf8.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-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Unicode/Utf8_core.v b/theories/Unicode/Utf8_core.v
index 43ac9976..fe13f0ef 100644
--- a/theories/Unicode/Utf8_core.v
+++ b/theories/Unicode/Utf8_core.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-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -18,7 +18,7 @@ Notation "∃ x .. y , P" := (exists x, .. (exists y, P) ..)
Notation "x ∨ y" := (x \/ y) (at level 85, right associativity) : type_scope.
Notation "x ∧ y" := (x /\ y) (at level 80, right associativity) : type_scope.
Notation "x → y" := (x -> y)
- (at level 90, y at level 200, right associativity): type_scope.
+ (at level 99, y at level 200, right associativity): type_scope.
Notation "x ↔ y" := (x <-> y) (at level 95, no associativity): type_scope.
Notation "¬ x" := (~x) (at level 75, right associativity) : type_scope.
diff --git a/theories/Vectors/Fin.v b/theories/Vectors/Fin.v
index a5e37f34..b9bf6c7f 100644
--- a/theories/Vectors/Fin.v
+++ b/theories/Vectors/Fin.v
@@ -8,13 +8,14 @@
Require Arith_base.
-(** [fin n] is a convinient way to represent \[1 .. n\]
+(** [fin n] is a convenient way to represent \[1 .. n\]
-[fin n] can be seen as a n-uplet of unit where [F1] is the first element of
-the n-uplet and [FS] set (n-1)-uplet of all the element but the first.
+[fin n] can be seen as a n-uplet of unit. [F1] is the first element of
+the n-uplet. If [f] is the k-th element of the (n-1)-uplet, [FS f] is the
+(k+1)-th element of the n-uplet.
Author: Pierre Boutillier
- Institution: PPS, INRIA 12/2010-01/2012
+ Institution: PPS, INRIA 12/2010-01/2012-07/2012
*)
Inductive t : nat -> Set :=
@@ -23,76 +24,68 @@ Inductive t : nat -> Set :=
Section SCHEMES.
Definition case0 P (p: t 0): P p :=
- match p as p' in t n return
- match n as n' return t n' -> Type
- with |0 => fun f0 => P f0 |S _ => fun _ => @ID end p'
- with |F1 _ => @id |FS _ _ => @id end.
+ match p with | F1 | FS _ => fun devil => False_rect (@IDProp) devil (* subterm !!! *) end.
-Definition caseS (P: forall {n}, t (S n) -> Type)
- (P1: forall n, @P n F1) (PS : forall {n} (p: t n), P (FS p))
- {n} (p: t (S n)): P p :=
+Definition caseS' {n : nat} (p : t (S n)) : forall (P : t (S n) -> Type)
+ (P1 : P F1) (PS : forall (p : t n), P (FS p)), P p :=
match p with
- |F1 k => P1 k
- |FS k pp => PS pp
+ | @F1 k => fun P P1 PS => P1
+ | FS pp => fun P P1 PS => PS pp
end.
+Definition caseS (P: forall {n}, t (S n) -> Type)
+ (P1: forall n, @P n F1) (PS : forall {n} (p: t n), P (FS p))
+ {n} (p: t (S n)) : P p := caseS' p P (P1 n) PS.
+
Definition rectS (P: forall {n}, t (S n) -> Type)
(P1: forall n, @P n F1) (PS : forall {n} (p: t (S n)), P p -> P (FS p)):
forall {n} (p: t (S n)), P p :=
fix rectS_fix {n} (p: t (S n)): P p:=
match p with
- |F1 k => P1 k
- |FS 0 pp => case0 (fun f => P (FS f)) pp
- |FS (S k) pp => PS pp (rectS_fix pp)
+ | @F1 k => P1 k
+ | @FS 0 pp => case0 (fun f => P (FS f)) pp
+ | @FS (S k) pp => PS pp (rectS_fix pp)
end.
-Definition rect2 (P: forall {n} (a b: t n), Type)
- (H0: forall n, @P (S n) F1 F1)
- (H1: forall {n} (f: t n), P F1 (FS f))
- (H2: forall {n} (f: t n), P (FS f) F1)
- (HS: forall {n} (f g : t n), P f g -> P (FS f) (FS g)):
- forall {n} (a b: t n), P a b :=
-fix rect2_fix {n} (a: t n): forall (b: t n), P a b :=
-match a with
- |F1 m => fun (b: t (S m)) => match b as b' in t n'
- return match n',b' with
- |0,_ => @ID
- |S n0,b0 => P F1 b0
- end with
- |F1 m' => H0 m'
- |FS m' b' => H1 b'
- end
- |FS m a' => fun (b: t (S m)) => match b with
- |F1 m' => fun aa: t m' => H2 aa
- |FS m' b' => fun aa: t m' => HS aa b' (rect2_fix aa b')
- end a'
-end.
+Definition rect2 (P : forall {n} (a b : t n), Type)
+ (H0 : forall n, @P (S n) F1 F1)
+ (H1 : forall {n} (f : t n), P F1 (FS f))
+ (H2 : forall {n} (f : t n), P (FS f) F1)
+ (HS : forall {n} (f g : t n), P f g -> P (FS f) (FS g)) :
+ forall {n} (a b : t n), P a b :=
+ fix rect2_fix {n} (a : t n) {struct a} : forall (b : t n), P a b :=
+ match a with
+ | @F1 m => fun (b : t (S m)) => caseS' b (P F1) (H0 _) H1
+ | @FS m a' => fun (b : t (S m)) =>
+ caseS' b (fun b => P (@FS m a') b) (H2 a') (fun b' => HS _ _ (rect2_fix a' b'))
+ end.
+
End SCHEMES.
Definition FS_inj {n} (x y: t n) (eq: FS x = FS y): x = y :=
match eq in _ = a return
match a as a' in t m return match m with |0 => Prop |S n' => t n' -> Prop end
- with @F1 _ => fun _ => True |@FS _ y => fun x' => x' = y end x with
+ with F1 => fun _ => True |FS y => fun x' => x' = y end x with
eq_refl => eq_refl
end.
(** [to_nat f] = p iff [f] is the p{^ th} element of [fin m]. *)
Fixpoint to_nat {m} (n : t m) : {i | i < m} :=
- match n in t k return {i | i< k} with
- |F1 j => exist (fun i => i< S j) 0 (Lt.lt_0_Sn j)
- |FS _ p => match to_nat p with |exist i P => exist _ (S i) (Lt.lt_n_S _ _ P) end
+ match n with
+ |@F1 j => exist _ 0 (Lt.lt_0_Sn j)
+ |FS p => match to_nat p with |exist _ i P => exist _ (S i) (Lt.lt_n_S _ _ P) end
end.
(** [of_nat p n] answers the p{^ th} element of [fin n] if p < n or a proof of
p >= n else *)
Fixpoint of_nat (p n : nat) : (t n) + { exists m, p = n + m } :=
match n with
- |0 => inright _ (ex_intro (fun x => p = 0 + x) p (@eq_refl _ p))
+ |0 => inright _ (ex_intro _ p eq_refl)
|S n' => match p with
|0 => inleft _ (F1)
|S p' => match of_nat p' n' with
|inleft f => inleft _ (FS f)
- |inright arg => inright _ (match arg with |ex_intro m e =>
+ |inright arg => inright _ (match arg with |ex_intro _ m e =>
ex_intro (fun x => S p' = S n' + x) m (f_equal S e) end)
end
end
@@ -109,13 +102,35 @@ Fixpoint of_nat_lt {p n : nat} : p < n -> t n :=
end
end.
+Lemma of_nat_ext {p}{n} (h h' : p < n) : of_nat_lt h = of_nat_lt h'.
+Proof.
+ now rewrite (Peano_dec.le_unique _ _ h h').
+Qed.
+
Lemma of_nat_to_nat_inv {m} (p : t m) : of_nat_lt (proj2_sig (to_nat p)) = p.
Proof.
-induction p.
- reflexivity.
- simpl; destruct (to_nat p). simpl. subst p; repeat f_equal. apply Peano_dec.le_unique.
+induction p; simpl.
+- reflexivity.
+- destruct (to_nat p); simpl in *. f_equal. subst p. apply of_nat_ext.
+Qed.
+
+Lemma to_nat_of_nat {p}{n} (h : p < n) : to_nat (of_nat_lt h) = exist _ p h.
+Proof.
+ revert n h.
+ induction p; (destruct n ; intros h; [ destruct (Lt.lt_n_O _ h) | cbn]);
+ [ | rewrite (IHp _ (Lt.lt_S_n p n h))]; f_equal; apply Peano_dec.le_unique.
+Qed.
+
+Lemma to_nat_inj {n} (p q : t n) :
+ proj1_sig (to_nat p) = proj1_sig (to_nat q) -> p = q.
+Proof.
+ intro H.
+ rewrite <- (of_nat_to_nat_inv p), <- (of_nat_to_nat_inv q).
+ destruct (to_nat p) as (np,hp), (to_nat q) as (nq,hq); simpl in *.
+ revert hp hq. rewrite H. apply of_nat_ext.
Qed.
+
(** [weak p f] answers a function witch is the identity for the p{^ th} first
element of [fin (p + m)] and [FS (FS .. (FS (f k)))] for [FS (FS .. (FS k))]
with p FSs *)
@@ -124,15 +139,15 @@ Fixpoint weak {m}{n} p (f : t m -> t n) :
match p as p' return t (p' + m) -> t (p' + n) with
|0 => f
|S p' => fun x => match x with
- |F1 n' => fun eq : n' = p' + m => F1
- |FS n' y => fun eq : n' = p' + m => FS (weak p' f (eq_rect _ t y _ eq))
+ |@F1 n' => fun eq : n' = p' + m => F1
+ |@FS n' y => fun eq : n' = p' + m => FS (weak p' f (eq_rect _ t y _ eq))
end (eq_refl _)
end.
(** The p{^ th} element of [fin m] viewed as the p{^ th} element of
[fin (m + n)] *)
Fixpoint L {m} n (p : t m) : t (m + n) :=
- match p with |F1 _ => F1 |FS _ p' => FS (L n p') end.
+ match p with |F1 => F1 |FS p' => FS (L n p') end.
Lemma L_sanity {m} n (p : t m) : proj1_sig (to_nat (L n p)) = proj1_sig (to_nat p).
Proof.
@@ -145,12 +160,13 @@ Qed.
[fin (n + m)]
Really really ineficient !!! *)
Definition L_R {m} n (p : t m) : t (n + m).
+Proof.
induction n.
exact p.
exact ((fix LS k (p: t k) :=
match p with
- |F1 k' => @F1 (S k')
- |FS _ p' => FS (LS _ p')
+ |@F1 k' => @F1 (S k')
+ |FS p' => FS (LS _ p')
end) _ IHn).
Defined.
@@ -168,8 +184,8 @@ Qed.
Fixpoint depair {m n} (o : t m) (p : t n) : t (m * n) :=
match o with
- |F1 m' => L (m' * n) p
- |FS m' o' => R n (depair o' p)
+ |@F1 m' => L (m' * n) p
+ |FS o' => R n (depair o' p)
end.
Lemma depair_sanity {m n} (o : t m) (p : t n) :
@@ -182,3 +198,55 @@ induction o ; simpl.
rewrite Plus.plus_assoc. destruct (to_nat o); simpl; rewrite Mult.mult_succ_r.
now rewrite (Plus.plus_comm n).
Qed.
+
+Fixpoint eqb {m n} (p : t m) (q : t n) :=
+match p, q with
+| @F1 m', @F1 n' => EqNat.beq_nat m' n'
+| FS _, F1 => false
+| F1, FS _ => false
+| FS p', FS q' => eqb p' q'
+end.
+
+Lemma eqb_nat_eq : forall m n (p : t m) (q : t n), eqb p q = true -> m = n.
+Proof.
+intros m n p; revert n; induction p; destruct q; simpl; intros; f_equal.
++ now apply EqNat.beq_nat_true.
++ easy.
++ easy.
++ eapply IHp. eassumption.
+Qed.
+
+Lemma eqb_eq : forall n (p q : t n), eqb p q = true <-> p = q.
+Proof.
+apply rect2; simpl; intros.
+- split; intros ; [ reflexivity | now apply EqNat.beq_nat_true_iff ].
+- now split.
+- now split.
+- eapply iff_trans.
+ + eassumption.
+ + split.
+ * intros; now f_equal.
+ * apply FS_inj.
+Qed.
+
+Lemma eq_dec {n} (x y : t n): {x = y} + {x <> y}.
+Proof.
+ case_eq (eqb x y); intros.
+ + left; now apply eqb_eq.
+ + right. intros Heq. apply <- eqb_eq in Heq. congruence.
+Defined.
+
+Definition cast: forall {m} (v: t m) {n}, m = n -> t n.
+Proof.
+refine (fix cast {m} (v: t m) {struct v} :=
+ match v in t m' return forall n, m' = n -> t n with
+ |F1 => fun n => match n with
+ | 0 => fun H => False_rect _ _
+ | S n' => fun H => F1
+ end
+ |FS f => fun n => match n with
+ | 0 => fun H => False_rect _ _
+ | S n' => fun H => FS (cast f n' (f_equal pred H))
+ end
+end); discriminate.
+Defined.
diff --git a/theories/Vectors/Vector.v b/theories/Vectors/Vector.v
index f3e5e338..672858fa 100644
--- a/theories/Vectors/Vector.v
+++ b/theories/Vectors/Vector.v
@@ -18,5 +18,7 @@ Based on contents from Util/VecUtil of the CoLoR contribution *)
Require Fin.
Require VectorDef.
Require VectorSpec.
+Require VectorEq.
Include VectorDef.
Include VectorSpec.
+Include VectorEq. \ No newline at end of file
diff --git a/theories/Vectors/VectorDef.v b/theories/Vectors/VectorDef.v
index 32ffcb3d..45c13e5c 100644
--- a/theories/Vectors/VectorDef.v
+++ b/theories/Vectors/VectorDef.v
@@ -21,6 +21,8 @@ Require Vectors.Fin.
Import EqNotations.
Local Open Scope nat_scope.
+(* Set Universe Polymorphism. *)
+
(**
A vector is a list of size n whose elements belong to a set A. *)
@@ -40,72 +42,61 @@ Definition rectS {A} (P:forall {n}, t A (S n) -> Type)
(rect: forall a {n} (v: t A (S n)), P v -> P (a :: v)) :=
fix rectS_fix {n} (v: t A (S n)) : P v :=
match v with
- |nil => fun devil => False_rect (@ID) devil
- |cons a 0 v =>
- match v as vnn in t _ nn
- return
- match nn,vnn with
- |0,vm => P (a :: vm)
- |S _,_ => _
- end
- with
- |nil => bas a
- |_ :: _ => fun devil => False_rect (@ID) devil
- end
- |cons a (S nn') v => rect a v (rectS_fix v)
+ |@cons _ a 0 v =>
+ match v with
+ |nil _ => bas a
+ |_ => fun devil => False_ind (@IDProp) devil (* subterm !!! *)
+ end
+ |@cons _ a (S nn') v => rect a v (rectS_fix v)
+ |_ => fun devil => False_ind (@IDProp) devil (* subterm !!! *)
end.
-(** An induction scheme for 2 vectors of same length *)
-Definition rect2 {A B} (P:forall {n}, t A n -> t B n -> Type)
- (bas : P [] []) (rect : forall {n v1 v2}, P v1 v2 ->
- forall a b, P (a :: v1) (b :: v2)) :=
-fix rect2_fix {n} (v1:t A n):
- forall v2 : t B n, P v1 v2 :=
-match v1 as v1' in t _ n1
- return forall v2 : t B n1, P v1' v2 with
- |[] => fun v2 =>
- match v2 with
- |[] => bas
- |_ :: _ => fun devil => False_rect (@ID) devil
- end
- |h1 :: t1 => fun v2 =>
- match v2 with
- |[] => fun devil => False_rect (@ID) devil
- |h2 :: t2 => fun t1' =>
- rect (rect2_fix t1' t2) h1 h2
- end t1
-end.
-
(** A vector of length [0] is [nil] *)
Definition case0 {A} (P:t A 0 -> Type) (H:P (nil A)) v:P v :=
match v with
|[] => H
+ |_ => fun devil => False_ind (@IDProp) devil (* subterm !!! *)
end.
(** A vector of length [S _] is [cons] *)
Definition caseS {A} (P : forall {n}, t A (S n) -> Type)
(H : forall h {n} t, @P n (h :: t)) {n} (v: t A (S n)) : P v :=
-match v as v' in t _ m return match m, v' with |0, _ => False -> True |S _, v0 => P v' end with
- |[] => fun devil => False_rect _ devil (* subterm !!! *)
+match v with
|h :: t => H h t
+ |_ => fun devil => False_ind (@IDProp) devil (* subterm !!! *)
end.
+
+Definition caseS' {A} {n : nat} (v : t A (S n)) : forall (P : t A (S n) -> Type)
+ (H : forall h t, P (h :: t)), P v :=
+ match v with
+ | h :: t => fun P H => H h t
+ | _ => fun devil => False_rect (@IDProp) devil
+ end.
+
+(** An induction scheme for 2 vectors of same length *)
+Definition rect2 {A B} (P:forall {n}, t A n -> t B n -> Type)
+ (bas : P [] []) (rect : forall {n v1 v2}, P v1 v2 ->
+ forall a b, P (a :: v1) (b :: v2)) :=
+ fix rect2_fix {n} (v1 : t A n) : forall v2 : t B n, P v1 v2 :=
+ match v1 with
+ | [] => fun v2 => case0 _ bas v2
+ | @cons _ h1 n' t1 => fun v2 =>
+ caseS' v2 (fun v2' => P (h1::t1) v2') (fun h2 t2 => rect (rect2_fix t1 t2) h1 h2)
+ end.
+
End SCHEMES.
Section BASES.
(** The first element of a non empty vector *)
-Definition hd {A} {n} (v:t A (S n)) := Eval cbv delta beta in
-(caseS (fun n v => A) (fun h n t => h) v).
+Definition hd {A} := @caseS _ (fun n v => A) (fun h n t => h).
+Global Arguments hd {A} {n} v.
(** The last element of an non empty vector *)
-Definition last {A} {n} (v : t A (S n)) := Eval cbv delta in
-(rectS (fun _ _ => A) (fun a => a) (fun _ _ _ H => H) v).
+Definition last {A} := @rectS _ (fun _ _ => A) (fun a => a) (fun _ _ _ H => H).
+Global Arguments last {A} {n} v.
(** Build a vector of n{^ th} [a] *)
-Fixpoint const {A} (a:A) (n:nat) :=
- match n return t A n with
- | O => nil A
- | S n => a :: (const a n)
- end.
+Definition const {A} (a:A) := nat_rect _ [] (fun n x => cons _ a n x).
(** The [p]{^ th} element of a vector of length [m].
@@ -114,8 +105,8 @@ ocaml function. *)
Definition nth {A} :=
fix nth_fix {m} (v' : t A m) (p : Fin.t m) {struct v'} : A :=
match p in Fin.t m' return t A m' -> A with
- |Fin.F1 q => fun v => caseS (fun n v' => A) (fun h n t => h) v
- |Fin.FS q p' => fun v => (caseS (fun n v' => Fin.t n -> A)
+ |Fin.F1 => caseS (fun n v' => A) (fun h n t => h)
+ |Fin.FS p' => fun v => (caseS (fun n v' => Fin.t n -> A)
(fun h n t p0 => nth_fix t p0) v) p'
end v'.
@@ -126,9 +117,9 @@ Definition nth_order {A} {n} (v: t A n) {p} (H: p < n) :=
(** Put [a] at the p{^ th} place of [v] *)
Fixpoint replace {A n} (v : t A n) (p: Fin.t n) (a : A) {struct p}: t A n :=
match p with
- |Fin.F1 k => fun v': t A (S k) => caseS (fun n _ => t A (S n)) (fun h _ t => a :: t) v'
- |Fin.FS k p' => fun v' =>
- (caseS (fun n _ => Fin.t n -> t A (S n)) (fun h _ t p2 => h :: (replace t p2 a)) v') p'
+ | @Fin.F1 k => fun v': t A (S k) => caseS' v' _ (fun h t => a :: t)
+ | @Fin.FS k p' => fun v' : t A (S k) =>
+ (caseS' v' (fun _ => t A (S k)) (fun h t => h :: (replace t p' a)))
end v.
(** Version of replace with [lt] *)
@@ -136,13 +127,13 @@ Definition replace_order {A n} (v: t A n) {p} (H: p < n) :=
replace v (Fin.of_nat_lt H).
(** Remove the first element of a non empty vector *)
-Definition tl {A} {n} (v:t A (S n)) := Eval cbv delta beta in
-(caseS (fun n v => t A n) (fun h n t => t) v).
+Definition tl {A} := @caseS _ (fun n v => t A n) (fun h n t => t).
+Global Arguments tl {A} {n} v.
(** Remove last element of a non-empty vector *)
-Definition shiftout {A} {n:nat} (v:t A (S n)) : t A n :=
-Eval cbv delta beta in (rectS (fun n _ => t A n) (fun a => [])
- (fun h _ _ H => h :: H) v).
+Definition shiftout {A} := @rectS _ (fun n _ => t A n) (fun a => [])
+ (fun h _ _ H => h :: H).
+Global Arguments shiftout {A} {n} v.
(** Add an element at the end of a vector *)
Fixpoint shiftin {A} {n:nat} (a : A) (v:t A n) : t A (S n) :=
@@ -152,9 +143,9 @@ match v with
end.
(** Copy last element of a vector *)
-Definition shiftrepeat {A} {n} (v:t A (S n)) : t A (S (S n)) :=
-Eval cbv delta beta in (rectS (fun n _ => t A (S (S n)))
- (fun h => h :: h :: []) (fun h _ _ H => h :: H) v).
+Definition shiftrepeat {A} := @rectS _ (fun n _ => t A (S (S n)))
+ (fun h => h :: h :: []) (fun h _ _ H => h :: H).
+Global Arguments shiftrepeat {A} {n} v.
(** Remove [p] last elements of a vector *)
Lemma trunc : forall {A} {n} (p:nat), n > p -> t A n
@@ -221,10 +212,10 @@ Definition map {A} {B} (f : A -> B) : forall {n} (v:t A n), t B n :=
end.
(** map2 g [x1 .. xn] [y1 .. yn] = [(g x1 y1) .. (g xn yn)] *)
-Definition map2 {A B C} (g:A -> B -> C) {n} (v1:t A n) (v2:t B n)
- : t C n :=
-Eval cbv delta beta in rect2 (fun n _ _ => t C n) (nil C)
- (fun _ _ _ H a b => (g a b) :: H) v1 v2.
+Definition map2 {A B C} (g:A -> B -> C) :
+ forall (n : nat), t A n -> t B n -> t C n :=
+@rect2 _ _ (fun n _ _ => t C n) (nil C) (fun _ _ _ H a b => (g a b) :: H).
+Global Arguments map2 {A B C} g {n} v1 v2.
(** fold_left f b [x1 .. xn] = f .. (f (f b x1) x2) .. xn *)
Definition fold_left {A B:Type} (f:B->A->B): forall (b:B) {n} (v:t A n), B :=
@@ -242,24 +233,19 @@ Definition fold_right {A B : Type} (f : A->B->B) :=
| a :: w => f a (fold_right_fix w b)
end.
-(** fold_right2 g [x1 .. xn] [y1 .. yn] c = g x1 y1 (g x2 y2 .. (g xn yn c) .. ) *)
-Definition fold_right2 {A B C} (g:A -> B -> C -> C) {n} (v:t A n)
- (w : t B n) (c:C) : C :=
-Eval cbv delta beta in rect2 (fun _ _ _ => C) c
- (fun _ _ _ H a b => g a b H) v w.
+(** fold_right2 g c [x1 .. xn] [y1 .. yn] = g x1 y1 (g x2 y2 .. (g xn yn c) .. )
+ c is before the vectors to be compliant with "refolding". *)
+Definition fold_right2 {A B C} (g:A -> B -> C -> C) (c: C) :=
+@rect2 _ _ (fun _ _ _ => C) c (fun _ _ _ H a b => g a b H).
+
(** fold_left2 f b [x1 .. xn] [y1 .. yn] = g .. (g (g a x1 y1) x2 y2) .. xn yn *)
Definition fold_left2 {A B C: Type} (f : A -> B -> C -> A) :=
fix fold_left2_fix (a : A) {n} (v : t B n) : t C n -> A :=
match v in t _ n0 return t C n0 -> A with
- |[] => fun w => match w in t _ n1
- return match n1 with |0 => A |S _ => @ID end with
- |[] => a
- |_ :: _ => @id end
- |cons vh vn vt => fun w => match w in t _ n1
- return match n1 with |0 => @ID |S n => t B n -> A end with
- |[] => @id
- |wh :: wt => fun vt' => fold_left2_fix (f a vh wh) vt' wt end vt
+ |[] => fun w => case0 (fun _ => A) a w
+ |@cons _ vh vn vt => fun w =>
+ caseS' w (fun _ => A) (fun wh wt => fold_left2_fix (f a vh wh) vt wt)
end.
End ITERATORS.
diff --git a/theories/Vectors/VectorEq.v b/theories/Vectors/VectorEq.v
new file mode 100644
index 00000000..04c57073
--- /dev/null
+++ b/theories/Vectors/VectorEq.v
@@ -0,0 +1,80 @@
+(************************************************************************)
+(* v * The Coq Proof Assistant / The Coq Development Team *)
+(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
+(* \VV/ **************************************************************)
+(* // * This file is distributed under the terms of the *)
+(* * GNU Lesser General Public License Version 2.1 *)
+(************************************************************************)
+
+(** Equalities and Vector relations
+
+ Author: Pierre Boutillier
+ Institution: PPS, INRIA 07/2012
+*)
+
+Require Import VectorDef.
+Require Import VectorSpec.
+Import VectorNotations.
+
+Section BEQ.
+
+ Variables (A: Type) (A_beq: A -> A -> bool).
+ Hypothesis A_eqb_eq: forall x y, A_beq x y = true <-> x = y.
+
+ Definition eqb:
+ forall {m n} (v1: t A m) (v2: t A n), bool :=
+ fix fix_beq {m n} v1 v2 :=
+ match v1, v2 with
+ |[], [] => true
+ |_ :: _, [] |[], _ :: _ => false
+ |h1 :: t1, h2 :: t2 => A_beq h1 h2 && fix_beq t1 t2
+ end%bool.
+
+ Lemma eqb_nat_eq: forall m n (v1: t A m) (v2: t A n)
+ (Hbeq: eqb v1 v2 = true), m = n.
+ Proof.
+ intros m n v1; revert n.
+ induction v1; destruct v2;
+ [now constructor | discriminate | discriminate | simpl].
+ intros Hbeq; apply andb_prop in Hbeq; destruct Hbeq.
+ f_equal; eauto.
+ Qed.
+
+ Lemma eqb_eq: forall n (v1: t A n) (v2: t A n),
+ eqb v1 v2 = true <-> v1 = v2.
+ Proof.
+ refine (@rect2 _ _ _ _ _); [now constructor | simpl].
+ intros ? ? ? Hrec h1 h2; destruct Hrec; destruct (A_eqb_eq h1 h2); split.
+ + intros Hbeq. apply andb_prop in Hbeq; destruct Hbeq.
+ f_equal; now auto.
+ + intros Heq. destruct (cons_inj Heq). apply andb_true_intro.
+ split; now auto.
+ Qed.
+
+ Definition eq_dec n (v1 v2: t A n): {v1 = v2} + {v1 <> v2}.
+ Proof.
+ case_eq (eqb v1 v2); intros.
+ + left; now apply eqb_eq.
+ + right. intros Heq. apply <- eqb_eq in Heq. congruence.
+ Defined.
+
+End BEQ.
+
+Section CAST.
+
+ Definition cast: forall {A m} (v: t A m) {n}, m = n -> t A n.
+ Proof.
+ refine (fix cast {A m} (v: t A m) {struct v} :=
+ match v in t _ m' return forall n, m' = n -> t A n with
+ |[] => fun n => match n with
+ | 0 => fun _ => []
+ | S _ => fun H => False_rect _ _
+ end
+ |h :: w => fun n => match n with
+ | 0 => fun H => False_rect _ _
+ | S n' => fun H => h :: (cast w n' (f_equal pred H))
+ end
+ end); discriminate.
+ Defined.
+
+End CAST.
diff --git a/theories/Vectors/VectorSpec.v b/theories/Vectors/VectorSpec.v
index 2f4086e5..7f4228dd 100644
--- a/theories/Vectors/VectorSpec.v
+++ b/theories/Vectors/VectorSpec.v
@@ -16,7 +16,7 @@ Require Fin.
Require Import VectorDef.
Import VectorNotations.
-Definition cons_inj A a1 a2 n (v1 v2 : t A n)
+Definition cons_inj {A} {a1 a2} {n} {v1 v2 : t A n}
(eq : a1 :: v1 = a2 :: v2) : a1 = a2 /\ v1 = v2 :=
match eq in _ = x return caseS _ (fun a2' _ v2' => fun v1' => a1 = a2' /\ v1' = v2') x v1
with | eq_refl => conj eq_refl eq_refl
@@ -59,15 +59,15 @@ Qed.
Lemma shiftrepeat_nth A: forall n k (v: t A (S n)),
nth (shiftrepeat v) (Fin.L_R 1 k) = nth v k.
Proof.
-refine (@Fin.rectS _ _ _); intros.
+refine (@Fin.rectS _ _ _); lazy beta; [ intros n v | intros n p H v ].
revert n v; refine (@caseS _ _ _); simpl; intros. now destruct t.
revert p H.
- refine (match v as v' in t _ m return match m as m' return t A m' -> Type with
+ refine (match v as v' in t _ m return match m as m' return t A m' -> Prop with
|S (S n) => fun v => forall p : Fin.t (S n),
(forall v0 : t A (S n), (shiftrepeat v0) [@ Fin.L_R 1 p ] = v0 [@p]) ->
(shiftrepeat v) [@Fin.L_R 1 (Fin.FS p)] = v [@Fin.FS p]
- |_ => fun _ => @ID end v' with
- |[] => @id |h :: t => _ end). destruct n0. exact @id. now simpl.
+ |_ => fun _ => True end v' with
+ |[] => I |h :: t => _ end). destruct n0. exact I. now simpl.
Qed.
Lemma shiftrepeat_last A: forall n (v: t A (S n)), last (shiftrepeat v) = last v.
@@ -105,7 +105,7 @@ Proof.
assert (forall n h (v: t B n) a, fold_left f (f a h) v = f (fold_left f a v) h).
induction v0.
now simpl.
- intros; simpl. rewrite<- IHv0. now f_equal.
+ intros; simpl. rewrite<- IHv0, assoc. now f_equal.
induction v.
reflexivity.
simpl. intros; now rewrite<- (IHv).
diff --git a/theories/Vectors/vo.itarget b/theories/Vectors/vo.itarget
index 7f00d016..779b1821 100644
--- a/theories/Vectors/vo.itarget
+++ b/theories/Vectors/vo.itarget
@@ -1,4 +1,5 @@
Fin.vo
VectorDef.vo
VectorSpec.vo
+VectorEq.vo
Vector.vo
diff --git a/theories/Wellfounded/Disjoint_Union.v b/theories/Wellfounded/Disjoint_Union.v
index c1a5f1b2..ee4329bd 100644
--- a/theories/Wellfounded/Disjoint_Union.v
+++ b/theories/Wellfounded/Disjoint_Union.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Wellfounded/Inclusion.v b/theories/Wellfounded/Inclusion.v
index 2250aec1..d09c4112 100644
--- a/theories/Wellfounded/Inclusion.v
+++ b/theories/Wellfounded/Inclusion.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Wellfounded/Inverse_Image.v b/theories/Wellfounded/Inverse_Image.v
index 551dd110..aa6fa6ee 100644
--- a/theories/Wellfounded/Inverse_Image.v
+++ b/theories/Wellfounded/Inverse_Image.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Wellfounded/Lexicographic_Exponentiation.v b/theories/Wellfounded/Lexicographic_Exponentiation.v
index fb3ef1be..dd9e4c98 100644
--- a/theories/Wellfounded/Lexicographic_Exponentiation.v
+++ b/theories/Wellfounded/Lexicographic_Exponentiation.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -13,8 +13,11 @@
Require Import List.
Require Import Relation_Operators.
+Require Import Operators_Properties.
Require Import Transitive_Closure.
+Import ListNotations.
+
Section Wf_Lexicographic_Exponentiation.
Variable A : Set.
Variable leA : A -> A -> Prop.
@@ -25,14 +28,11 @@ Section Wf_Lexicographic_Exponentiation.
Notation Descl := (Desc A leA).
Notation List := (list A).
- Notation Nil := (nil (A:=A)).
- (* useless but symmetric *)
- Notation Cons := (cons (A:=A)).
Notation "<< x , y >>" := (exist Descl x y) (at level 0, x, y at level 100).
(* Hint Resolve d_one d_nil t_step. *)
- Lemma left_prefix : forall x y z:List, ltl (x ++ y) z -> ltl x z.
+ Lemma left_prefix : forall x y z : List, ltl (x ++ y) z -> ltl x z.
Proof.
simple induction x.
simple induction z.
@@ -50,8 +50,9 @@ Section Wf_Lexicographic_Exponentiation.
Lemma right_prefix :
- forall x y z:List,
- ltl x (y ++ z) -> ltl x y \/ (exists y' : List, x = y ++ y' /\ ltl y' z).
+ forall x y z : List,
+ ltl x (y ++ z) ->
+ ltl x y \/ (exists y' : List, x = y ++ y' /\ ltl y' z).
Proof.
intros x y; generalize x.
elim y; simpl.
@@ -70,172 +71,98 @@ Section Wf_Lexicographic_Exponentiation.
right; exists x2; auto with sets.
Qed.
- Lemma desc_prefix : forall (x:List) (a:A), Descl (x ++ Cons a Nil) -> Descl x.
+ Lemma desc_prefix : forall (x : List) (a : A), Descl (x ++ [a]) -> Descl x.
Proof.
intros.
inversion H.
- generalize (app_cons_not_nil _ _ _ H1); simple induction 1.
- cut (x ++ Cons a Nil = Cons x0 Nil); auto with sets.
- intro.
- generalize (app_eq_unit _ _ H0).
- simple induction 1; simple induction 1; intros.
- rewrite H4; auto using d_nil with sets.
- discriminate H5.
- generalize (app_inj_tail _ _ _ _ H0).
- simple induction 1; intros.
- rewrite <- H4; auto with sets.
+ - apply app_cons_not_nil in H1 as ().
+ - assert (x ++ [a] = [x0]) by auto with sets.
+ apply app_eq_unit in H0 as [(->, _)| (_, [=])].
+ auto using d_nil.
+ - apply app_inj_tail in H0 as (<-, _).
+ assumption.
Qed.
Lemma desc_tail :
- forall (x:List) (a b:A),
- Descl (Cons b (x ++ Cons a Nil)) -> clos_trans A leA a b.
+ forall (x : List) (a b : A),
+ Descl (b :: x ++ [a]) -> clos_refl_trans A leA a b.
Proof.
intro.
apply rev_ind with
- (A := A)
- (P := fun x:List =>
- forall a b:A,
- Descl (Cons b (x ++ Cons a Nil)) -> clos_trans A leA a b).
- intros.
-
- inversion H.
- cut (Cons b (Cons a Nil) = (Nil ++ Cons b Nil) ++ Cons a Nil);
- auto with sets; intro.
- generalize H0.
- intro.
- generalize (app_inj_tail (l ++ Cons y Nil) (Nil ++ Cons b Nil) _ _ H4);
- simple induction 1.
- intros.
-
- generalize (app_inj_tail _ _ _ _ H6); simple induction 1; intros.
- generalize H1.
- rewrite <- H10; rewrite <- H7; intro.
- apply (t_step A leA); auto with sets.
-
- intros.
- inversion H0.
- generalize (app_cons_not_nil _ _ _ H3); intro.
- elim H1.
-
- generalize H0.
- generalize (app_comm_cons (l ++ Cons x0 Nil) (Cons a Nil) b);
- simple induction 1.
- intro.
- generalize (desc_prefix (Cons b (l ++ Cons x0 Nil)) a H5); intro.
- generalize (H x0 b H6).
- intro.
- apply t_trans with (A := A) (y := x0); auto with sets.
-
- apply t_step.
- generalize H1.
- rewrite H4; intro.
-
- generalize (app_inj_tail _ _ _ _ H8); simple induction 1.
- intros.
- generalize H2; generalize (app_comm_cons l (Cons x0 Nil) b).
- intro.
- generalize H10.
- rewrite H12; intro.
- generalize (app_inj_tail _ _ _ _ H13); simple induction 1.
- intros.
- rewrite <- H11; rewrite <- H16; auto with sets.
+ (P :=
+ fun x : List =>
+ forall a b : A, Descl (b :: x ++ [a]) -> clos_refl_trans A leA a b);
+ intros.
+ - inversion H.
+ assert ([b; a] = ([] ++ [b]) ++ [a]) by auto with sets.
+ destruct (app_inj_tail (l ++ [y]) ([] ++ [b]) _ _ H0) as ((?, <-)/app_inj_tail, <-).
+ inversion H1; subst; [ apply rt_step; assumption | apply rt_refl ].
+ - inversion H0.
+ + apply app_cons_not_nil in H3 as ().
+ + rewrite app_comm_cons in H0, H1. apply desc_prefix in H0.
+ pose proof (H x0 b H0).
+ apply rt_trans with (y := x0); auto with sets.
+ enough (H5 : clos_refl A leA a x0)
+ by (inversion H5; subst; [ apply rt_step | apply rt_refl ];
+ assumption).
+ apply app_inj_tail in H1 as (H1, ->).
+ rewrite app_comm_cons in H1.
+ apply app_inj_tail in H1 as (_, <-).
+ assumption.
Qed.
Lemma dist_aux :
- forall z:List, Descl z -> forall x y:List, z = x ++ y -> Descl x /\ Descl y.
+ forall z : List,
+ Descl z -> forall x y : List, z = x ++ y -> Descl x /\ Descl y.
Proof.
intros z D.
- elim D.
- intros.
- cut (x ++ y = Nil); auto with sets; intro.
- generalize (app_eq_nil _ _ H0); simple induction 1.
- intros.
- rewrite H2; rewrite H3; split; apply d_nil.
-
- intros.
- cut (x0 ++ y = Cons x Nil); auto with sets.
- intros E.
- generalize (app_eq_unit _ _ E); simple induction 1.
- simple induction 1; intros.
- rewrite H2; rewrite H3; split.
- apply d_nil.
-
- apply d_one.
-
- simple induction 1; intros.
- rewrite H2; rewrite H3; split.
- apply d_one.
-
- apply d_nil.
-
- do 5 intro.
- intros Hind.
- do 2 intro.
- generalize x0.
- apply rev_ind with
- (A := A)
- (P := fun y0:List =>
- forall x0:List,
- (l ++ Cons y Nil) ++ Cons x Nil = x0 ++ y0 ->
- Descl x0 /\ Descl y0).
-
- intro.
- generalize (app_nil_end x1); simple induction 1; simple induction 1.
- split. apply d_conc; auto with sets.
-
- apply d_nil.
-
- do 3 intro.
- generalize x1.
- apply rev_ind with
- (A := A)
- (P := fun l0:List =>
- forall (x1:A) (x0:List),
- (l ++ Cons y Nil) ++ Cons x Nil = x0 ++ l0 ++ Cons x1 Nil ->
- Descl x0 /\ Descl (l0 ++ Cons x1 Nil)).
-
-
- simpl.
- split.
- generalize (app_inj_tail _ _ _ _ H2); simple induction 1.
- simple induction 1; auto with sets.
-
- apply d_one.
- do 5 intro.
- generalize (app_ass x4 (l1 ++ Cons x2 Nil) (Cons x3 Nil)).
- simple induction 1.
- generalize (app_ass x4 l1 (Cons x2 Nil)); simple induction 1.
- intro E.
- generalize (app_inj_tail _ _ _ _ E).
- simple induction 1; intros.
- generalize (app_inj_tail _ _ _ _ H6); simple induction 1; intros.
- rewrite <- H7; rewrite <- H10; generalize H6.
- generalize (app_ass x4 l1 (Cons x2 Nil)); intro E1.
- rewrite E1.
- intro.
- generalize (Hind x4 (l1 ++ Cons x2 Nil) H11).
- simple induction 1; split.
- auto with sets.
-
- generalize H14.
- rewrite <- H10; intro.
- apply d_conc; auto with sets.
+ induction D as [| | * H D Hind]; intros.
+ - assert (H0 : x ++ y = []) by auto with sets.
+ apply app_eq_nil in H0 as (->, ->).
+ split; apply d_nil.
+ - assert (E : x0 ++ y = [x]) by auto with sets.
+ apply app_eq_unit in E as [(->, ->)| (->, ->)].
+ + split.
+ apply d_nil.
+ apply d_one.
+ + split.
+ apply d_one.
+ apply d_nil.
+ - induction y0 using rev_ind in x0, H0 |- *.
+ + rewrite <- app_nil_end in H0.
+ rewrite <- H0.
+ split.
+ apply d_conc; auto with sets.
+ apply d_nil.
+ + induction y0 using rev_ind in x1, x0, H0 |- *.
+ * simpl.
+ split.
+ apply app_inj_tail in H0 as (<-, _). assumption.
+ apply d_one.
+ * rewrite <- 2!app_assoc_reverse in H0.
+ apply app_inj_tail in H0 as (H0, <-).
+ pose proof H0 as H0'.
+ apply app_inj_tail in H0' as (_, ->).
+ rewrite app_assoc_reverse in H0.
+ apply Hind in H0 as ().
+ split.
+ assumption.
+ apply d_conc; auto with sets.
Qed.
Lemma dist_Desc_concat :
- forall x y:List, Descl (x ++ y) -> Descl x /\ Descl y.
+ forall x y : List, Descl (x ++ y) -> Descl x /\ Descl y.
Proof.
intros.
apply (dist_aux (x ++ y) H x y); auto with sets.
Qed.
Lemma desc_end :
- forall (a b:A) (x:List),
- Descl (x ++ Cons a Nil) /\ ltl (x ++ Cons a Nil) (Cons b Nil) ->
- clos_trans A leA a b.
+ forall (a b : A) (x : List),
+ Descl (x ++ [a]) /\ ltl (x ++ [a]) [b] -> clos_trans A leA a b.
Proof.
intros a b x.
case x.
@@ -246,11 +173,11 @@ Section Wf_Lexicographic_Exponentiation.
inversion H3.
simple induction 1.
- generalize (app_comm_cons l (Cons a Nil) a0).
+ generalize (app_comm_cons l [a] a0).
intros E; rewrite <- E; intros.
generalize (desc_tail l a a0 H0); intro.
inversion H1.
- apply t_trans with (y := a0); auto with sets.
+ eapply clos_rt_t; [ eassumption | apply t_step; assumption ].
inversion H4.
Qed.
@@ -259,9 +186,8 @@ Section Wf_Lexicographic_Exponentiation.
Lemma ltl_unit :
- forall (x:List) (a b:A),
- Descl (x ++ Cons a Nil) ->
- ltl (x ++ Cons a Nil) (Cons b Nil) -> ltl x (Cons b Nil).
+ forall (x : List) (a b : A),
+ Descl (x ++ [a]) -> ltl (x ++ [a]) [b] -> ltl x [b].
Proof.
intro.
case x.
@@ -276,9 +202,10 @@ Section Wf_Lexicographic_Exponentiation.
Lemma acc_app :
- forall (x1 x2:List) (y1:Descl (x1 ++ x2)),
+ forall (x1 x2 : List) (y1 : Descl (x1 ++ x2)),
Acc Lex_Exp << x1 ++ x2, y1 >> ->
- forall (x:List) (y:Descl x), ltl x (x1 ++ x2) -> Acc Lex_Exp << x, y >>.
+ forall (x : List) (y : Descl x),
+ ltl x (x1 ++ x2) -> Acc Lex_Exp << x, y >>.
Proof.
intros.
apply (Acc_inv (R:=Lex_Exp) (x:=<< x1 ++ x2, y1 >>)).
@@ -297,8 +224,10 @@ Section Wf_Lexicographic_Exponentiation.
unfold lex_exp at 1; simpl.
apply rev_ind with
(A := A)
- (P := fun x:List =>
- forall (x0:List) (y:Descl x0), ltl x0 x -> Acc Lex_Exp << x0, y >>).
+ (P :=
+ fun x : List =>
+ forall (x0 : List) (y : Descl x0),
+ ltl x0 x -> Acc Lex_Exp << x0, y >>).
intros.
inversion_clear H0.
@@ -306,14 +235,15 @@ Section Wf_Lexicographic_Exponentiation.
generalize (well_founded_ind (wf_clos_trans A leA H)).
intros GR.
apply GR with
- (P := fun x0:A =>
- forall l:List,
- (forall (x1:List) (y:Descl x1),
- ltl x1 l -> Acc Lex_Exp << x1, y >>) ->
- forall (x1:List) (y:Descl x1),
- ltl x1 (l ++ Cons x0 Nil) -> Acc Lex_Exp << x1, y >>).
+ (P :=
+ fun x0 : A =>
+ forall l : List,
+ (forall (x1 : List) (y : Descl x1),
+ ltl x1 l -> Acc Lex_Exp << x1, y >>) ->
+ forall (x1 : List) (y : Descl x1),
+ ltl x1 (l ++ [x0]) -> Acc Lex_Exp << x1, y >>).
intro; intros HInd; intros.
- generalize (right_prefix x2 l (Cons x1 Nil) H1).
+ generalize (right_prefix x2 l [x1] H1).
simple induction 1.
intro; apply (H0 x2 y1 H3).
@@ -324,9 +254,10 @@ Section Wf_Lexicographic_Exponentiation.
rewrite H2.
apply rev_ind with
(A := A)
- (P := fun x3:List =>
- forall y1:Descl (l ++ x3),
- ltl x3 (Cons x1 Nil) -> Acc Lex_Exp << l ++ x3, y1 >>).
+ (P :=
+ fun x3 : List =>
+ forall y1 : Descl (l ++ x3),
+ ltl x3 [x1] -> Acc Lex_Exp << l ++ x3, y1 >>).
intros.
generalize (app_nil_end l); intros Heq.
generalize y1.
@@ -340,15 +271,15 @@ Section Wf_Lexicographic_Exponentiation.
apply (H0 x4 y3); auto with sets.
intros.
- generalize (dist_Desc_concat l (l0 ++ Cons x4 Nil) y1).
+ generalize (dist_Desc_concat l (l0 ++ [x4]) y1).
simple induction 1.
intros.
generalize (desc_end x4 x1 l0 (conj H8 H5)); intros.
generalize y1.
- rewrite <- (app_ass l l0 (Cons x4 Nil)); intro.
+ rewrite <- (app_assoc_reverse l l0 [x4]); intro.
generalize (HInd x4 H9 (l ++ l0)); intros HInd2.
generalize (ltl_unit l0 x4 x1 H8 H5); intro.
- generalize (dist_Desc_concat (l ++ l0) (Cons x4 Nil) y2).
+ generalize (dist_Desc_concat (l ++ l0) [x4] y2).
simple induction 1; intros.
generalize (H4 H12 H10); intro.
generalize (Acc_inv H14).
diff --git a/theories/Wellfounded/Lexicographic_Product.v b/theories/Wellfounded/Lexicographic_Product.v
index 7e3035d0..0d8ed8dd 100644
--- a/theories/Wellfounded/Lexicographic_Product.v
+++ b/theories/Wellfounded/Lexicographic_Product.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Wellfounded/Transitive_Closure.v b/theories/Wellfounded/Transitive_Closure.v
index 9e0b22f2..b76e9661 100644
--- a/theories/Wellfounded/Transitive_Closure.v
+++ b/theories/Wellfounded/Transitive_Closure.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Wellfounded/Union.v b/theories/Wellfounded/Union.v
index c5b2d53e..b2e8ea92 100644
--- a/theories/Wellfounded/Union.v
+++ b/theories/Wellfounded/Union.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Wellfounded/Well_Ordering.v b/theories/Wellfounded/Well_Ordering.v
index 56b8f985..f8a17b56 100644
--- a/theories/Wellfounded/Well_Ordering.v
+++ b/theories/Wellfounded/Well_Ordering.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/Wellfounded/Wellfounded.v b/theories/Wellfounded/Wellfounded.v
index 971c589e..a76d5e95 100644
--- a/theories/Wellfounded/Wellfounded.v
+++ b/theories/Wellfounded/Wellfounded.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/ZArith/BinInt.v b/theories/ZArith/BinInt.v
index f238ef6e..cb0c6880 100644
--- a/theories/ZArith/BinInt.v
+++ b/theories/ZArith/BinInt.v
@@ -1,14 +1,14 @@
(* -*- coding: utf-8 -*- *)
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
(************************************************************************)
Require Export BinNums BinPos Pnat.
-Require Import BinNat Bool Plus Mult Equalities GenericMinMax
+Require Import BinNat Bool Equalities GenericMinMax
OrdersFacts ZAxioms ZProperties.
Require BinIntDef.
@@ -73,6 +73,23 @@ Proof.
decide equality; apply Pos.eq_dec.
Defined.
+(** * Proofs of morphisms, obvious since eq is Leibniz *)
+
+Local Obligation Tactic := simpl_relation.
+Program Definition succ_wd : Proper (eq==>eq) succ := _.
+Program Definition pred_wd : Proper (eq==>eq) pred := _.
+Program Definition opp_wd : Proper (eq==>eq) opp := _.
+Program Definition add_wd : Proper (eq==>eq==>eq) add := _.
+Program Definition sub_wd : Proper (eq==>eq==>eq) sub := _.
+Program Definition mul_wd : Proper (eq==>eq==>eq) mul := _.
+Program Definition lt_wd : Proper (eq==>eq==>iff) lt := _.
+Program Definition div_wd : Proper (eq==>eq==>eq) div := _.
+Program Definition mod_wd : Proper (eq==>eq==>eq) modulo := _.
+Program Definition quot_wd : Proper (eq==>eq==>eq) quot := _.
+Program Definition rem_wd : Proper (eq==>eq==>eq) rem := _.
+Program Definition pow_wd : Proper (eq==>eq==>eq) pow := _.
+Program Definition testbit_wd : Proper (eq==>eq==>Logic.eq) testbit := _.
+
(** * Properties of [pos_sub] *)
(** [pos_sub] can be written in term of positive comparison
@@ -138,15 +155,23 @@ Qed.
Module Import Private_BootStrap.
-(** * Properties of addition *)
-
-(** ** Zero is neutral for addition *)
+(** ** Operations and constants *)
Lemma add_0_r n : n + 0 = n.
Proof.
now destruct n.
Qed.
+Lemma mul_0_r n : n * 0 = 0.
+Proof.
+ now destruct n.
+Qed.
+
+Lemma mul_1_l n : 1 * n = n.
+Proof.
+ now destruct n.
+Qed.
+
(** ** Addition is commutative *)
Lemma add_comm n m : n + m = m + n.
@@ -196,28 +221,25 @@ Proof.
symmetry. now apply Pos.add_sub_assoc.
Qed.
-Lemma add_assoc n m p : n + (m + p) = n + m + p.
+Local Arguments add !x !y.
+
+Lemma add_assoc_pos p n m : pos p + (n + m) = pos p + n + m.
Proof.
- assert (AUX : forall x y z, pos x + (y + z) = pos x + y + z).
- { intros x [|y|y] [|z|z]; rewrite ?add_0_r; trivial.
- - simpl. now rewrite Pos.add_assoc.
- - simpl (_ + neg _). symmetry. apply pos_sub_add.
- - simpl (neg _ + _); simpl (_ + neg _).
- now rewrite (add_comm _ (pos _)), <- 2 pos_sub_add, Pos.add_comm.
- - apply opp_inj. rewrite !opp_add_distr. simpl opp.
- simpl (neg _ + _); simpl (_ + neg _).
- rewrite add_comm, Pos.add_comm. apply pos_sub_add. }
- destruct n.
- - trivial.
- - apply AUX.
- - apply opp_inj. rewrite !opp_add_distr. simpl opp. apply AUX.
+ destruct n as [|n|n], m as [|m|m]; simpl; trivial.
+ - now rewrite Pos.add_assoc.
+ - symmetry. apply pos_sub_add.
+ - symmetry. apply add_0_r.
+ - now rewrite <- pos_sub_add, add_comm, <- pos_sub_add, Pos.add_comm.
+ - apply opp_inj. rewrite !opp_add_distr, !pos_sub_opp.
+ rewrite add_comm, Pos.add_comm. apply pos_sub_add.
Qed.
-(** ** Subtraction and successor *)
-
-Lemma sub_succ_l n m : succ n - m = succ (n - m).
+Lemma add_assoc n m p : n + (m + p) = n + m + p.
Proof.
- unfold sub, succ. now rewrite <- 2 add_assoc, (add_comm 1).
+ destruct n.
+ - trivial.
+ - apply add_assoc_pos.
+ - apply opp_inj. rewrite !opp_add_distr. simpl. apply add_assoc_pos.
Qed.
(** ** Opposite is inverse for addition *)
@@ -227,132 +249,34 @@ Proof.
destruct n; simpl; trivial; now rewrite pos_sub_diag.
Qed.
-Lemma add_opp_diag_l n : - n + n = 0.
-Proof.
- rewrite add_comm. apply add_opp_diag_r.
-Qed.
-
-(** ** Commutativity of multiplication *)
-
-Lemma mul_comm n m : n * m = m * n.
-Proof.
- destruct n, m; simpl; trivial; f_equal; apply Pos.mul_comm.
-Qed.
-
-(** ** Associativity of multiplication *)
-
-Lemma mul_assoc n m p : n * (m * p) = n * m * p.
-Proof.
- destruct n, m, p; simpl; trivial; f_equal; apply Pos.mul_assoc.
-Qed.
-
-(** Multiplication and constants *)
-
-Lemma mul_1_l n : 1 * n = n.
-Proof.
- now destruct n.
-Qed.
-
-Lemma mul_1_r n : n * 1 = n.
-Proof.
- destruct n; simpl; now rewrite ?Pos.mul_1_r.
-Qed.
-
(** ** Multiplication and Opposite *)
-Lemma mul_opp_l n m : - n * m = - (n * m).
-Proof.
- now destruct n, m.
-Qed.
-
Lemma mul_opp_r n m : n * - m = - (n * m).
Proof.
now destruct n, m.
Qed.
-Lemma mul_opp_opp n m : - n * - m = n * m.
-Proof.
- now destruct n, m.
-Qed.
-
-Lemma mul_opp_comm n m : - n * m = n * - m.
-Proof.
- now destruct n, m.
-Qed.
-
(** ** Distributivity of multiplication over addition *)
Lemma mul_add_distr_pos (p:positive) n m :
- pos p * (n + m) = pos p * n + pos p * m.
-Proof.
- destruct n as [|n|n], m as [|m|m]; simpl; trivial;
- rewrite ?pos_sub_spec, ?Pos.mul_compare_mono_l; try case Pos.compare_spec;
- intros; now rewrite ?Pos.mul_add_distr_l, ?Pos.mul_sub_distr_l.
-Qed.
-
-Lemma mul_add_distr_l n m p : n * (m + p) = n * m + n * p.
+ (n + m) * pos p = n * pos p + m * pos p.
Proof.
- destruct n as [|n|n]. trivial.
- apply mul_add_distr_pos.
- change (neg n) with (- pos n).
- rewrite !mul_opp_l, <- opp_add_distr. f_equal.
- apply mul_add_distr_pos.
+ destruct n as [|n|n], m as [|m|m]; simpl; trivial.
+ - now rewrite Pos.mul_add_distr_r.
+ - rewrite ?pos_sub_spec, ?Pos.mul_compare_mono_r; case Pos.compare_spec;
+ simpl; trivial; intros; now rewrite Pos.mul_sub_distr_r.
+ - rewrite ?pos_sub_spec, ?Pos.mul_compare_mono_r; case Pos.compare_spec;
+ simpl; trivial; intros; now rewrite Pos.mul_sub_distr_r.
+ - now rewrite Pos.mul_add_distr_r.
Qed.
Lemma mul_add_distr_r n m p : (n + m) * p = n * p + m * p.
Proof.
- rewrite !(mul_comm _ p). apply mul_add_distr_l.
-Qed.
-
-(** ** Basic properties of divisibility *)
-
-Lemma divide_Zpos p q : (pos p|pos q) <-> (p|q)%positive.
-Proof.
- split.
- intros ([ |r|r],H); simpl in *; destr_eq H. exists r; auto.
- intros (r,H). exists (pos r); simpl; now f_equal.
-Qed.
-
-Lemma divide_Zpos_Zneg_r n p : (n|pos p) <-> (n|neg p).
-Proof.
- split; intros (m,H); exists (-m); now rewrite mul_opp_l, <- H.
-Qed.
-
-Lemma divide_Zpos_Zneg_l n p : (pos p|n) <-> (neg p|n).
-Proof.
- split; intros (m,H); exists (-m); now rewrite mul_opp_l, <- mul_opp_r.
-Qed.
-
-(** ** Conversions between [Z.testbit] and [N.testbit] *)
-
-Lemma testbit_of_N a n :
- testbit (of_N a) (of_N n) = N.testbit a n.
-Proof.
- destruct a as [|a], n; simpl; trivial. now destruct a.
-Qed.
-
-Lemma testbit_of_N' a n : 0<=n ->
- testbit (of_N a) n = N.testbit a (to_N n).
-Proof.
- intro Hn. rewrite <- testbit_of_N. f_equal.
- destruct n; trivial; now destruct Hn.
-Qed.
-
-Lemma testbit_Zpos a n : 0<=n ->
- testbit (pos a) n = N.testbit (N.pos a) (to_N n).
-Proof.
- intro Hn. now rewrite <- testbit_of_N'.
-Qed.
-
-Lemma testbit_Zneg a n : 0<=n ->
- testbit (neg a) n = negb (N.testbit (Pos.pred_N a) (to_N n)).
-Proof.
- intro Hn.
- rewrite <- testbit_of_N' by trivial.
- destruct n as [ |n|n];
- [ | simpl; now destruct (Pos.pred_N a) | now destruct Hn].
- unfold testbit.
- now destruct a as [|[ | | ]| ].
+ destruct p as [|p|p].
+ - now rewrite !mul_0_r.
+ - apply mul_add_distr_pos.
+ - apply opp_inj. rewrite opp_add_distr, <- !mul_opp_r.
+ apply mul_add_distr_pos.
Qed.
End Private_BootStrap.
@@ -397,6 +321,8 @@ Qed.
(** ** Specification of successor and predecessor *)
+Local Arguments pos_sub : simpl nomatch.
+
Lemma succ_pred n : succ (pred n) = n.
Proof.
unfold succ, pred. now rewrite <- add_assoc, add_opp_diag_r, add_0_r.
@@ -511,6 +437,45 @@ Proof.
rewrite (compare_antisym n m). case compare_spec; intuition.
Qed.
+(** ** Induction principles based on successor / predecessor *)
+
+Lemma peano_ind (P : Z -> Prop) :
+ P 0 ->
+ (forall x, P x -> P (succ x)) ->
+ (forall x, P x -> P (pred x)) ->
+ forall z, P z.
+Proof.
+ intros H0 Hs Hp z; destruct z.
+ assumption.
+ induction p using Pos.peano_ind.
+ now apply (Hs 0).
+ rewrite <- Pos.add_1_r.
+ now apply (Hs (pos p)).
+ induction p using Pos.peano_ind.
+ now apply (Hp 0).
+ rewrite <- Pos.add_1_r.
+ now apply (Hp (neg p)).
+Qed.
+
+Lemma bi_induction (P : Z -> Prop) :
+ Proper (eq ==> iff) P ->
+ P 0 ->
+ (forall x, P x <-> P (succ x)) ->
+ forall z, P z.
+Proof.
+ intros _ H0 Hs. induction z using peano_ind.
+ assumption.
+ now apply -> Hs.
+ apply Hs. now rewrite succ_pred.
+Qed.
+
+(** We can now derive all properties of basic functions and orders,
+ and use these properties for proving the specs of more advanced
+ functions. *)
+
+Include ZBasicProp <+ UsualMinMaxLogicalProperties <+ UsualMinMaxDecProperties.
+
+
(** ** Specification of absolute value *)
Lemma abs_eq n : 0 <= n -> abs n = n.
@@ -693,7 +658,7 @@ Lemma div_eucl_eq a b : b<>0 ->
Proof.
destruct a as [ |a|a], b as [ |b|b]; unfold div_eucl; trivial;
(now destruct 1) || intros _;
- generalize (pos_div_eucl_eq a (pos b) (eq_refl _));
+ generalize (pos_div_eucl_eq a (pos b) Logic.eq_refl);
destruct pos_div_eucl as (q,r); rewrite mul_comm.
- (* pos pos *)
trivial.
@@ -756,7 +721,7 @@ Proof.
destruct a as [|a|a]; unfold modulo, div_eucl.
now split.
now apply pos_div_eucl_bound.
- generalize (pos_div_eucl_bound a (pos b) (eq_refl _)).
+ generalize (pos_div_eucl_bound a (pos b) Logic.eq_refl).
destruct pos_div_eucl as (q,r); unfold snd; intros (Hr,Hr').
destruct r as [|r|r]; (now destruct Hr) || clear Hr.
now split.
@@ -773,7 +738,7 @@ Proof.
destruct b as [|b|b]; try easy; intros _.
destruct a as [|a|a]; unfold modulo, div_eucl.
now split.
- generalize (pos_div_eucl_bound a (pos b) (eq_refl _)).
+ generalize (pos_div_eucl_bound a (pos b) Logic.eq_refl).
destruct pos_div_eucl as (q,r); unfold snd; intros (Hr,Hr').
destruct r as [|r|r]; (now destruct Hr) || clear Hr.
now split.
@@ -783,7 +748,7 @@ Proof.
change (neg b - neg r <= 0). unfold le, lt in *.
rewrite <- compare_sub. simpl in *.
now rewrite <- Pos.compare_antisym, Hr'.
- generalize (pos_div_eucl_bound a (pos b) (eq_refl _)).
+ generalize (pos_div_eucl_bound a (pos b) Logic.eq_refl).
destruct pos_div_eucl as (q,r); unfold snd; intros (Hr,Hr').
split; destruct r; try easy.
red; simpl; now rewrite <- Pos.compare_antisym.
@@ -839,6 +804,25 @@ Proof. intros _. apply rem_opp_l'. Qed.
Lemma rem_opp_r a b : b<>0 -> rem a (-b) = rem a b.
Proof. intros _. apply rem_opp_r'. Qed.
+(** ** Extra properties about [divide] *)
+
+Lemma divide_Zpos p q : (pos p|pos q) <-> (p|q)%positive.
+Proof.
+ split.
+ intros ([ |r|r],H); simpl in *; destr_eq H. exists r; auto.
+ intros (r,H). exists (pos r); simpl; now f_equal.
+Qed.
+
+Lemma divide_Zpos_Zneg_r n p : (n|pos p) <-> (n|neg p).
+Proof.
+ split; intros (m,H); exists (-m); now rewrite mul_opp_l, <- H.
+Qed.
+
+Lemma divide_Zpos_Zneg_l n p : (pos p|n) <-> (neg p|n).
+Proof.
+ split; intros (m,H); exists (-m); now rewrite mul_opp_l, <- mul_opp_r.
+Qed.
+
(** ** Correctness proofs for gcd *)
Lemma ggcd_gcd a b : fst (ggcd a b) = gcd a b.
@@ -898,6 +882,38 @@ Proof.
destruct (Pos.ggcd a b) as (g,(aa,bb)); auto.
Qed.
+(** ** Extra properties about [testbit] *)
+
+Lemma testbit_of_N a n :
+ testbit (of_N a) (of_N n) = N.testbit a n.
+Proof.
+ destruct a as [|a], n; simpl; trivial. now destruct a.
+Qed.
+
+Lemma testbit_of_N' a n : 0<=n ->
+ testbit (of_N a) n = N.testbit a (to_N n).
+Proof.
+ intro Hn. rewrite <- testbit_of_N. f_equal.
+ destruct n; trivial; now destruct Hn.
+Qed.
+
+Lemma testbit_Zpos a n : 0<=n ->
+ testbit (pos a) n = N.testbit (N.pos a) (to_N n).
+Proof.
+ intro Hn. now rewrite <- testbit_of_N'.
+Qed.
+
+Lemma testbit_Zneg a n : 0<=n ->
+ testbit (neg a) n = negb (N.testbit (Pos.pred_N a) (to_N n)).
+Proof.
+ intro Hn.
+ rewrite <- testbit_of_N' by trivial.
+ destruct n as [ |n|n];
+ [ | simpl; now destruct (Pos.pred_N a) | now destruct Hn].
+ unfold testbit.
+ now destruct a as [|[ | | ]| ].
+Qed.
+
(** ** Proofs of specifications for bitwise operations *)
Lemma div2_spec a : div2 a = shiftr a 1.
@@ -959,7 +975,7 @@ Proof.
destruct m; easy || now destruct Hm.
destruct a as [ |a|a].
(* a = 0 *)
- replace (Pos.iter n div2 0) with 0
+ replace (Pos.iter div2 0 n) with 0
by (apply Pos.iter_invariant; intros; subst; trivial).
now rewrite 2 testbit_0_l.
(* a > 0 *)
@@ -982,7 +998,7 @@ Proof.
rewrite ?Pos.iter_succ; apply testbit_even_0.
destruct a as [ |a|a].
(* a = 0 *)
- replace (Pos.iter n (mul 2) 0) with 0
+ replace (Pos.iter (mul 2) 0 n) with 0
by (apply Pos.iter_invariant; intros; subst; trivial).
apply testbit_0_l.
(* a > 0 *)
@@ -1013,7 +1029,7 @@ Proof.
f_equal. now rewrite Pos.add_comm, Pos.add_sub.
destruct a; unfold shiftl.
(* ... a = 0 *)
- replace (Pos.iter n (mul 2) 0) with 0
+ replace (Pos.iter (mul 2) 0 n) with 0
by (apply Pos.iter_invariant; intros; subst; trivial).
now rewrite 2 testbit_0_l.
(* ... a > 0 *)
@@ -1103,61 +1119,10 @@ Proof.
now rewrite N.lxor_spec, xorb_negb_negb.
Qed.
-(** ** Induction principles based on successor / predecessor *)
-Lemma peano_ind (P : Z -> Prop) :
- P 0 ->
- (forall x, P x -> P (succ x)) ->
- (forall x, P x -> P (pred x)) ->
- forall z, P z.
-Proof.
- intros H0 Hs Hp z; destruct z.
- assumption.
- induction p using Pos.peano_ind.
- now apply (Hs 0).
- rewrite <- Pos.add_1_r.
- now apply (Hs (pos p)).
- induction p using Pos.peano_ind.
- now apply (Hp 0).
- rewrite <- Pos.add_1_r.
- now apply (Hp (neg p)).
-Qed.
+(** Generic properties of advanced functions. *)
-Lemma bi_induction (P : Z -> Prop) :
- Proper (eq ==> iff) P ->
- P 0 ->
- (forall x, P x <-> P (succ x)) ->
- forall z, P z.
-Proof.
- intros _ H0 Hs. induction z using peano_ind.
- assumption.
- now apply -> Hs.
- apply Hs. now rewrite succ_pred.
-Qed.
-
-
-(** * Proofs of morphisms, obvious since eq is Leibniz *)
-
-Local Obligation Tactic := simpl_relation.
-Program Definition succ_wd : Proper (eq==>eq) succ := _.
-Program Definition pred_wd : Proper (eq==>eq) pred := _.
-Program Definition opp_wd : Proper (eq==>eq) opp := _.
-Program Definition add_wd : Proper (eq==>eq==>eq) add := _.
-Program Definition sub_wd : Proper (eq==>eq==>eq) sub := _.
-Program Definition mul_wd : Proper (eq==>eq==>eq) mul := _.
-Program Definition lt_wd : Proper (eq==>eq==>iff) lt := _.
-Program Definition div_wd : Proper (eq==>eq==>eq) div := _.
-Program Definition mod_wd : Proper (eq==>eq==>eq) modulo := _.
-Program Definition quot_wd : Proper (eq==>eq==>eq) quot := _.
-Program Definition rem_wd : Proper (eq==>eq==>eq) rem := _.
-Program Definition pow_wd : Proper (eq==>eq==>eq) pow := _.
-Program Definition testbit_wd : Proper (eq==>eq==>Logic.eq) testbit := _.
-
-(** The Bind Scope prevents Z to stay associated with abstract_scope.
- (TODO FIX) *)
-
-Include ZProp. Bind Scope Z_scope with Z.
-Include UsualMinMaxLogicalProperties <+ UsualMinMaxDecProperties.
+Include ZExtraProp.
(** In generic statements, the predicates [lt] and [le] have been
favored, whereas [gt] and [ge] don't even exist in the abstract
@@ -1277,6 +1242,8 @@ Qed.
End Z.
+Bind Scope Z_scope with Z.t Z.
+
(** Re-export Notations *)
Infix "+" := Z.add : Z_scope.
@@ -1394,11 +1361,11 @@ Lemma inj_gcd p q : Z.pos (Pos.gcd p q) = Z.gcd (Z.pos p) (Z.pos q).
Proof. reflexivity. Qed.
Definition inj_divide p q : (Z.pos p|Z.pos q) <-> (p|q)%positive.
-Proof. apply Z.Private_BootStrap.divide_Zpos. Qed.
+Proof. apply Z.divide_Zpos. Qed.
Lemma inj_testbit a n : 0<=n ->
Z.testbit (Z.pos a) n = N.testbit (N.pos a) (Z.to_N n).
-Proof. apply Z.Private_BootStrap.testbit_Zpos. Qed.
+Proof. apply Z.testbit_Zpos. Qed.
(** Some results concerning Z.neg *)
@@ -1436,14 +1403,14 @@ Lemma add_neg_pos p q : Z.neg p + Z.pos q = Z.pos_sub q p.
Proof. reflexivity. Qed.
Lemma divide_pos_neg_r n p : (n|Z.pos p) <-> (n|Z.neg p).
-Proof. apply Z.Private_BootStrap.divide_Zpos_Zneg_r. Qed.
+Proof. apply Z.divide_Zpos_Zneg_r. Qed.
Lemma divide_pos_neg_l n p : (Z.pos p|n) <-> (Z.neg p|n).
-Proof. apply Z.Private_BootStrap.divide_Zpos_Zneg_l. Qed.
+Proof. apply Z.divide_Zpos_Zneg_l. Qed.
Lemma testbit_neg a n : 0<=n ->
Z.testbit (Z.neg a) n = negb (N.testbit (Pos.pred_N a) (Z.to_N n)).
-Proof. apply Z.Private_BootStrap.testbit_Zneg. Qed.
+Proof. apply Z.testbit_Zneg. Qed.
End Pos2Z.
diff --git a/theories/ZArith/BinIntDef.v b/theories/ZArith/BinIntDef.v
index 00387eec..9bb86fd5 100644
--- a/theories/ZArith/BinIntDef.v
+++ b/theories/ZArith/BinIntDef.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-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -126,7 +126,7 @@ Infix "*" := mul : Z_scope.
(** ** Power function *)
-Definition pow_pos (z:Z) (n:positive) := Pos.iter n (mul z) 1.
+Definition pow_pos (z:Z) := Pos.iter (mul z) 1.
Definition pow x y :=
match y with
@@ -306,7 +306,7 @@ Definition to_pos (z:Z) : positive :=
Definition iter (n:Z) {A} (f:A -> A) (x:A) :=
match n with
- | pos p => Pos.iter p f x
+ | pos p => Pos.iter f x p
| _ => x
end.
@@ -568,8 +568,8 @@ Definition testbit a n :=
Definition shiftl a n :=
match n with
| 0 => a
- | pos p => Pos.iter p (mul 2) a
- | neg p => Pos.iter p div2 a
+ | pos p => Pos.iter (mul 2) a p
+ | neg p => Pos.iter div2 a p
end.
Definition shiftr a n := shiftl a (-n).
diff --git a/theories/ZArith/Wf_Z.v b/theories/ZArith/Wf_Z.v
index 5350f86d..09909bdb 100644
--- a/theories/ZArith/Wf_Z.v
+++ b/theories/ZArith/Wf_Z.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -151,9 +151,7 @@ Section Efficient_Rec.
forall P:Z -> Prop,
(forall x:Z, (forall y:Z, 0 <= y < x -> P y) -> 0 <= x -> P x) ->
forall x:Z, 0 <= x -> P x.
- Proof.
- exact Zlt_0_rec.
- Qed.
+ Proof. intros; now apply Zlt_0_rec. Qed.
(** Obsolete version of [Z.lt] induction principle on non-negative numbers *)
@@ -170,7 +168,7 @@ Section Efficient_Rec.
(forall x:Z, (forall y:Z, 0 <= y < x -> P y) -> P x) ->
forall x:Z, 0 <= x -> P x.
Proof.
- exact Z_lt_rec.
+ intros; now apply Z_lt_rec.
Qed.
(** An even more general induction principle using [Z.lt]. *)
@@ -196,7 +194,7 @@ Section Efficient_Rec.
(forall x:Z, (forall y:Z, z <= y < x -> P y) -> z <= x -> P x) ->
forall x:Z, z <= x -> P x.
Proof.
- exact Zlt_lower_bound_rec.
+ intros; now apply Zlt_lower_bound_rec with z.
Qed.
End Efficient_Rec.
diff --git a/theories/ZArith/ZArith.v b/theories/ZArith/ZArith.v
index e9cac8e1..04cccd04 100644
--- a/theories/ZArith/ZArith.v
+++ b/theories/ZArith/ZArith.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/ZArith/ZArith_base.v b/theories/ZArith/ZArith_base.v
index 0891c60a..4c93173b 100644
--- a/theories/ZArith/ZArith_base.v
+++ b/theories/ZArith/ZArith_base.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/ZArith/ZArith_dec.v b/theories/ZArith/ZArith_dec.v
index e392c8b3..ac69cebd 100644
--- a/theories/ZArith/ZArith_dec.v
+++ b/theories/ZArith/ZArith_dec.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/ZArith/ZOdiv.v b/theories/ZArith/ZOdiv.v
deleted file mode 100644
index 9fe3a365..00000000
--- a/theories/ZArith/ZOdiv.v
+++ /dev/null
@@ -1,88 +0,0 @@
-(************************************************************************)
-(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
-(* \VV/ **************************************************************)
-(* // * This file is distributed under the terms of the *)
-(* * GNU Lesser General Public License Version 2.1 *)
-(************************************************************************)
-
-Require Export ZOdiv_def.
-Require Import BinInt Zquot.
-
-Notation ZO_div_mod_eq := Z.quot_rem' (only parsing).
-Notation ZOmod_lt := Zrem_lt (only parsing).
-Notation ZOmod_sgn := Zrem_sgn (only parsing).
-Notation ZOmod_sgn2 := Zrem_sgn2 (only parsing).
-Notation ZOmod_lt_pos := Zrem_lt_pos (only parsing).
-Notation ZOmod_lt_neg := Zrem_lt_neg (only parsing).
-Notation ZOmod_lt_pos_pos := Zrem_lt_pos_pos (only parsing).
-Notation ZOmod_lt_pos_neg := Zrem_lt_pos_neg (only parsing).
-Notation ZOmod_lt_neg_pos := Zrem_lt_neg_pos (only parsing).
-Notation ZOmod_lt_neg_neg := Zrem_lt_neg_neg (only parsing).
-
-Notation ZOdiv_opp_l := Zquot_opp_l (only parsing).
-Notation ZOdiv_opp_r := Zquot_opp_r (only parsing).
-Notation ZOmod_opp_l := Zrem_opp_l (only parsing).
-Notation ZOmod_opp_r := Zrem_opp_r (only parsing).
-Notation ZOdiv_opp_opp := Zquot_opp_opp (only parsing).
-Notation ZOmod_opp_opp := Zrem_opp_opp (only parsing).
-
-Notation Remainder := Remainder (only parsing).
-Notation Remainder_alt := Remainder_alt (only parsing).
-Notation Remainder_equiv := Remainder_equiv (only parsing).
-Notation ZOdiv_mod_unique_full := Zquot_mod_unique_full (only parsing).
-Notation ZOdiv_unique_full := Zquot_unique_full (only parsing).
-Notation ZOdiv_unique := Zquot_unique (only parsing).
-Notation ZOmod_unique_full := Zrem_unique_full (only parsing).
-Notation ZOmod_unique := Zrem_unique (only parsing).
-
-Notation ZOmod_0_l := Zrem_0_l (only parsing).
-Notation ZOmod_0_r := Zrem_0_r (only parsing).
-Notation ZOdiv_0_l := Zquot_0_l (only parsing).
-Notation ZOdiv_0_r := Zquot_0_r (only parsing).
-Notation ZOmod_1_r := Zrem_1_r (only parsing).
-Notation ZOdiv_1_r := Zquot_1_r (only parsing).
-Notation ZOdiv_1_l := Zquot_1_l (only parsing).
-Notation ZOmod_1_l := Zrem_1_l (only parsing).
-Notation ZO_div_same := Z_quot_same (only parsing).
-Notation ZO_mod_same := Z_rem_same (only parsing).
-Notation ZO_mod_mult := Z_rem_mult (only parsing).
-Notation ZO_div_mult := Z_quot_mult (only parsing).
-
-Notation ZO_div_pos := Z_quot_pos (only parsing).
-Notation ZO_div_lt := Z_quot_lt (only parsing).
-Notation ZOdiv_small := Zquot_small (only parsing).
-Notation ZOmod_small := Zrem_small (only parsing).
-Notation ZO_div_monotone := Z_quot_monotone (only parsing).
-Notation ZO_mult_div_le := Z_mult_quot_le (only parsing).
-Notation ZO_mult_div_ge := Z_mult_quot_ge (only parsing).
-Definition ZO_div_exact_full_1 a b := proj1 (Z_quot_exact_full a b).
-Definition ZO_div_exact_full_2 a b := proj2 (Z_quot_exact_full a b).
-Notation ZOmod_le := Zrem_le (only parsing).
-Notation ZOdiv_le_upper_bound := Zquot_le_upper_bound (only parsing).
-Notation ZOdiv_lt_upper_bound := Zquot_lt_upper_bound (only parsing).
-Notation ZOdiv_le_lower_bound := Zquot_le_lower_bound (only parsing).
-Notation ZOdiv_sgn := Zquot_sgn (only parsing).
-
-Notation ZO_mod_plus := Z_rem_plus (only parsing).
-Notation ZO_div_plus := Z_quot_plus (only parsing).
-Notation ZO_div_plus_l := Z_quot_plus_l (only parsing).
-Notation ZOdiv_mult_cancel_r := Zquot_mult_cancel_r (only parsing).
-Notation ZOdiv_mult_cancel_l := Zquot_mult_cancel_l (only parsing).
-Notation ZOmult_mod_distr_l := Zmult_rem_distr_l (only parsing).
-Notation ZOmult_mod_distr_r := Zmult_rem_distr_r (only parsing).
-Notation ZOmod_mod := Zrem_rem (only parsing).
-Notation ZOmult_mod := Zmult_rem (only parsing).
-Notation ZOplus_mod := Zplus_rem (only parsing).
-Notation ZOplus_mod_idemp_l := Zplus_rem_idemp_l (only parsing).
-Notation ZOplus_mod_idemp_r := Zplus_rem_idemp_r (only parsing).
-Notation ZOmult_mod_idemp_l := Zmult_rem_idemp_l (only parsing).
-Notation ZOmult_mod_idemp_r := Zmult_rem_idemp_r (only parsing).
-Notation ZOdiv_ZOdiv := Zquot_Zquot (only parsing).
-Notation ZOdiv_mult_le := Zquot_mult_le (only parsing).
-Notation ZOmod_divides := Zrem_divides (only parsing).
-
-Notation ZOdiv_eucl_Zdiv_eucl_pos := Zquotrem_Zdiv_eucl_pos (only parsing).
-Notation ZOdiv_Zdiv_pos := Zquot_Zdiv_pos (only parsing).
-Notation ZOmod_Zmod_pos := Zrem_Zmod_pos (only parsing).
-Notation ZOmod_Zmod_zero := Zrem_Zmod_zero (only parsing).
diff --git a/theories/ZArith/ZOdiv_def.v b/theories/ZArith/ZOdiv_def.v
deleted file mode 100644
index 8b823d9f..00000000
--- a/theories/ZArith/ZOdiv_def.v
+++ /dev/null
@@ -1,15 +0,0 @@
-(************************************************************************)
-(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
-(* \VV/ **************************************************************)
-(* // * This file is distributed under the terms of the *)
-(* * GNU Lesser General Public License Version 2.1 *)
-(************************************************************************)
-
-Require Import BinInt.
-
-Notation ZOdiv_eucl := Z.quotrem (only parsing).
-Notation ZOdiv := Z.quot (only parsing).
-Notation ZOmod := Z.rem (only parsing).
-
-Notation ZOdiv_eucl_correct := Z.quotrem_eq.
diff --git a/theories/ZArith/Zabs.v b/theories/ZArith/Zabs.v
index aa3d1188..146009bc 100644
--- a/theories/ZArith/Zabs.v
+++ b/theories/ZArith/Zabs.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-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/ZArith/Zbool.v b/theories/ZArith/Zbool.v
index 81e52728..61eb2a34 100644
--- a/theories/ZArith/Zbool.v
+++ b/theories/ZArith/Zbool.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/ZArith/Zcompare.v b/theories/ZArith/Zcompare.v
index 6aa26d19..d4ac72e9 100644
--- a/theories/ZArith/Zcompare.v
+++ b/theories/ZArith/Zcompare.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-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/ZArith/Zcomplements.v b/theories/ZArith/Zcomplements.v
index dceac4f2..9604a06e 100644
--- a/theories/ZArith/Zcomplements.v
+++ b/theories/ZArith/Zcomplements.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -53,17 +53,18 @@ Theorem Z_lt_abs_rec :
forall n:Z, P n.
Proof.
intros P HP p.
- set (Q := fun z => 0 <= z -> P z * P (- z)) in *.
- cut (Q (Z.abs p)); [ intros | apply (Z_lt_rec Q); auto with zarith ].
- elim (Zabs_dec p); intro eq; rewrite eq; elim H; auto with zarith.
- unfold Q; clear Q; intros.
+ set (Q := fun z => 0 <= z -> P z * P (- z)).
+ enough (H:Q (Z.abs p)) by
+ (destruct (Zabs_dec p) as [-> | ->]; elim H; auto with zarith).
+ apply (Z_lt_rec Q); auto with zarith.
+ subst Q; intros x H.
split; apply HP.
- rewrite Z.abs_eq; auto; intros.
- elim (H (Z.abs m)); intros; auto with zarith.
- elim (Zabs_dec m); intro eq; rewrite eq; trivial.
- rewrite Z.abs_neq, Z.opp_involutive; auto with zarith; intros.
- elim (H (Z.abs m)); intros; auto with zarith.
- elim (Zabs_dec m); intro eq; rewrite eq; trivial.
+ - rewrite Z.abs_eq; auto; intros.
+ destruct (H (Z.abs m)); auto with zarith.
+ destruct (Zabs_dec m) as [-> | ->]; trivial.
+ - rewrite Z.abs_neq, Z.opp_involutive; auto with zarith; intros.
+ destruct (H (Z.abs m)); auto with zarith.
+ destruct (Zabs_dec m) as [-> | ->]; trivial.
Qed.
Theorem Z_lt_abs_induction :
@@ -73,16 +74,17 @@ Theorem Z_lt_abs_induction :
Proof.
intros P HP p.
set (Q := fun z => 0 <= z -> P z /\ P (- z)) in *.
- cut (Q (Z.abs p)); [ intros | apply (Z_lt_induction Q); auto with zarith ].
- elim (Zabs_dec p); intro eq; rewrite eq; elim H; auto with zarith.
- unfold Q; clear Q; intros.
+ enough (Q (Z.abs p)) by
+ (destruct (Zabs_dec p) as [-> | ->]; elim H; auto with zarith).
+ apply (Z_lt_induction Q); auto with zarith.
+ subst Q; intros.
split; apply HP.
- rewrite Z.abs_eq; auto; intros.
- elim (H (Z.abs m)); intros; auto with zarith.
- elim (Zabs_dec m); intro eq; rewrite eq; trivial.
- rewrite Z.abs_neq, Z.opp_involutive; auto with zarith; intros.
- elim (H (Z.abs m)); intros; auto with zarith.
- elim (Zabs_dec m); intro eq; rewrite eq; trivial.
+ - rewrite Z.abs_eq; auto; intros.
+ elim (H (Z.abs m)); intros; auto with zarith.
+ elim (Zabs_dec m); intro eq; rewrite eq; trivial.
+ - rewrite Z.abs_neq, Z.opp_involutive; auto with zarith; intros.
+ destruct (H (Z.abs m)); auto with zarith.
+ destruct (Zabs_dec m) as [-> | ->]; trivial.
Qed.
(** To do case analysis over the sign of [z] *)
diff --git a/theories/ZArith/Zdigits.v b/theories/ZArith/Zdigits.v
index bf19c8ec..b5d04719 100644
--- a/theories/ZArith/Zdigits.v
+++ b/theories/ZArith/Zdigits.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-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -41,7 +41,7 @@ Section VALUE_OF_BOOLEAN_VECTORS.
Lemma binary_value : forall n:nat, Bvector n -> Z.
Proof.
- simple induction n; intros.
+ refine (nat_rect _ _ _); intros.
exact 0%Z.
inversion H0.
@@ -152,7 +152,7 @@ Section Z_BRIC_A_BRAC.
Lemma binary_value_pos :
forall (n:nat) (bv:Bvector n), (binary_value n bv >= 0)%Z.
Proof.
- induction bv as [| a n v IHbv]; simpl.
+ induction bv as [| a n v IHbv]; cbn.
omega.
destruct a; destruct (binary_value n v); simpl; auto.
@@ -212,14 +212,11 @@ Section Z_BRIC_A_BRAC.
(z < two_power_nat (S n))%Z -> (Z.div2 z < two_power_nat n)%Z.
Proof.
intros.
- cut (2 * Z.div2 z < 2 * two_power_nat n)%Z; intros.
- omega.
-
+ enough (2 * Z.div2 z < 2 * two_power_nat n)%Z by omega.
rewrite <- two_power_nat_S.
- destruct (Zeven.Zeven_odd_dec z); intros.
+ destruct (Zeven.Zeven_odd_dec z) as [Heven|Hodd]; intros.
rewrite <- Zeven.Zeven_div2; auto.
-
- generalize (Zeven.Zodd_div2 z z0); omega.
+ generalize (Zeven.Zodd_div2 z Hodd); omega.
Qed.
Lemma Z_to_two_compl_Sn_z :
diff --git a/theories/ZArith/Zdiv.v b/theories/ZArith/Zdiv.v
index 2e3a2280..d0d10891 100644
--- a/theories/ZArith/Zdiv.v
+++ b/theories/ZArith/Zdiv.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-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -666,24 +666,22 @@ Theorem Zdiv_eucl_extended :
{qr : Z * Z | let (q, r) := qr in a = b * q + r /\ 0 <= r < Z.abs b}.
Proof.
intros b Hb a.
- elim (Z_le_gt_dec 0 b); intro Hb'.
- cut (b > 0); [ intro Hb'' | omega ].
- rewrite Z.abs_eq; [ apply Zdiv_eucl_exist; assumption | assumption ].
- cut (- b > 0); [ intro Hb'' | omega ].
- elim (Zdiv_eucl_exist Hb'' a); intros qr.
- elim qr; intros q r Hqr.
- exists (- q, r).
- elim Hqr; intros.
- split.
- rewrite <- Z.mul_opp_comm; assumption.
- rewrite Z.abs_neq; [ assumption | omega ].
+ destruct (Z_le_gt_dec 0 b) as [Hb'|Hb'].
+ - assert (Hb'' : b > 0) by omega.
+ rewrite Z.abs_eq; [ apply Zdiv_eucl_exist; assumption | assumption ].
+ - assert (Hb'' : - b > 0) by omega.
+ destruct (Zdiv_eucl_exist Hb'' a) as ((q,r),[]).
+ exists (- q, r).
+ split.
+ + rewrite <- Z.mul_opp_comm; assumption.
+ + rewrite Z.abs_neq; [ assumption | omega ].
Qed.
Arguments Zdiv_eucl_extended : default implicits.
(** * Division and modulo in Z agree with same in nat: *)
-Require Import NPeano.
+Require Import PeanoNat.
Lemma div_Zdiv (n m: nat): m <> O ->
Z.of_nat (n / m) = Z.of_nat n / Z.of_nat m.
diff --git a/theories/ZArith/Zeuclid.v b/theories/ZArith/Zeuclid.v
index 39e846a0..f5cacc7e 100644
--- a/theories/ZArith/Zeuclid.v
+++ b/theories/ZArith/Zeuclid.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/ZArith/Zeven.v b/theories/ZArith/Zeven.v
index c83a863f..d88bf7a9 100644
--- a/theories/ZArith/Zeven.v
+++ b/theories/ZArith/Zeven.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -197,12 +197,14 @@ Qed.
Lemma Zquot2_quot n : Z.quot2 n = n ÷ 2.
Proof.
assert (AUX : forall m, 0 < m -> Z.quot2 m = m ÷ 2).
- { intros m Hm.
+ {
+ intros m Hm.
apply Z.quot_unique with (if Z.odd m then Z.sgn m else 0).
now apply Z.lt_le_incl.
rewrite Z.sgn_pos by trivial.
destruct (Z.odd m); now split.
- apply Zquot2_odd_eqn. }
+ apply Zquot2_odd_eqn.
+ }
destruct (Z.lt_trichotomy 0 n) as [POS|[NUL|NEG]].
- now apply AUX.
- now subst.
diff --git a/theories/ZArith/Zgcd_alt.v b/theories/ZArith/Zgcd_alt.v
index 1e19479e..14286bde 100644
--- a/theories/ZArith/Zgcd_alt.v
+++ b/theories/ZArith/Zgcd_alt.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -23,6 +23,7 @@ Require Import ZArith_base.
Require Import ZArithRing.
Require Import Zdiv.
Require Import Znumtheory.
+Require Import Omega.
Open Scope Z_scope.
@@ -104,8 +105,7 @@ Open Scope Z_scope.
Lemma fibonacci_pos : forall n, 0 <= fibonacci n.
Proof.
- cut (forall N n, (n<N)%nat -> 0<=fibonacci n).
- eauto.
+ enough (forall N n, (n<N)%nat -> 0<=fibonacci n) by eauto.
induction N.
inversion 1.
intros.
diff --git a/theories/ZArith/Zhints.v b/theories/ZArith/Zhints.v
index 411fec67..1942c2ab 100644
--- a/theories/ZArith/Zhints.v
+++ b/theories/ZArith/Zhints.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/ZArith/Zlogarithm.v b/theories/ZArith/Zlogarithm.v
index 59c16469..6e349569 100644
--- a/theories/ZArith/Zlogarithm.v
+++ b/theories/ZArith/Zlogarithm.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -59,7 +59,7 @@ Section Log_pos. (* Log of positive integers *)
Lemma Zlog2_up_log_sup : forall p, Z.log2_up (Zpos p) = log_sup p.
Proof.
- induction p; simpl.
+ induction p; simpl log_sup.
- change (Zpos p~1) with (2*(Zpos p)+1).
rewrite Z.log2_up_succ_double, Zlog2_log_inf; try easy.
unfold Z.succ. now rewrite !(Z.add_comm _ 1), Z.add_assoc.
diff --git a/theories/ZArith/Zmax.v b/theories/ZArith/Zmax.v
index 78091794..c436b3ad 100644
--- a/theories/ZArith/Zmax.v
+++ b/theories/ZArith/Zmax.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/ZArith/Zmin.v b/theories/ZArith/Zmin.v
index 98282b38..1cfa2e03 100644
--- a/theories/ZArith/Zmin.v
+++ b/theories/ZArith/Zmin.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/ZArith/Zminmax.v b/theories/ZArith/Zminmax.v
index d3376a0e..05a94a8e 100644
--- a/theories/ZArith/Zminmax.v
+++ b/theories/ZArith/Zminmax.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/ZArith/Zmisc.v b/theories/ZArith/Zmisc.v
index 203f9766..b401e6b6 100644
--- a/theories/ZArith/Zmisc.v
+++ b/theories/ZArith/Zmisc.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/ZArith/Znat.v b/theories/ZArith/Znat.v
index 8031b357..20e7c2e8 100644
--- a/theories/ZArith/Znat.v
+++ b/theories/ZArith/Znat.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-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -271,7 +271,7 @@ Qed.
Lemma inj_testbit a n :
Z.testbit (Z.of_N a) (Z.of_N n) = N.testbit a n.
-Proof. apply Z.Private_BootStrap.testbit_of_N. Qed.
+Proof. apply Z.testbit_of_N. Qed.
End N2Z.
@@ -426,7 +426,7 @@ Qed.
Lemma inj_testbit a n : 0<=n ->
Z.testbit (Z.of_N a) n = N.testbit a (Z.to_N n).
-Proof. apply Z.Private_BootStrap.testbit_of_N'. Qed.
+Proof. apply Z.testbit_of_N'. Qed.
End Z2N.
@@ -637,7 +637,7 @@ Qed.
(** [Z.of_nat] and usual operations *)
-Lemma inj_compare n m : (Z.of_nat n ?= Z.of_nat m) = nat_compare n m.
+Lemma inj_compare n m : (Z.of_nat n ?= Z.of_nat m) = (n ?= m)%nat.
Proof.
now rewrite <-!nat_N_Z, N2Z.inj_compare, <- Nat2N.inj_compare.
Qed.
@@ -690,23 +690,23 @@ Proof.
now rewrite <- !nat_N_Z, Nat2N.inj_sub, N2Z.inj_sub.
Qed.
-Lemma inj_pred_max n : Z.of_nat (pred n) = Z.max 0 (Z.pred (Z.of_nat n)).
+Lemma inj_pred_max n : Z.of_nat (Nat.pred n) = Z.max 0 (Z.pred (Z.of_nat n)).
Proof.
now rewrite <- !nat_N_Z, Nat2N.inj_pred, N2Z.inj_pred_max.
Qed.
-Lemma inj_pred n : (0<n)%nat -> Z.of_nat (pred n) = Z.pred (Z.of_nat n).
+Lemma inj_pred n : (0<n)%nat -> Z.of_nat (Nat.pred n) = Z.pred (Z.of_nat n).
Proof.
rewrite nat_compare_lt, Nat2N.inj_compare. intros.
now rewrite <- !nat_N_Z, Nat2N.inj_pred, N2Z.inj_pred.
Qed.
-Lemma inj_min n m : Z.of_nat (min n m) = Z.min (Z.of_nat n) (Z.of_nat m).
+Lemma inj_min n m : Z.of_nat (Nat.min n m) = Z.min (Z.of_nat n) (Z.of_nat m).
Proof.
now rewrite <- !nat_N_Z, Nat2N.inj_min, N2Z.inj_min.
Qed.
-Lemma inj_max n m : Z.of_nat (max n m) = Z.max (Z.of_nat n) (Z.of_nat m).
+Lemma inj_max n m : Z.of_nat (Nat.max n m) = Z.max (Z.of_nat n) (Z.of_nat m).
Proof.
now rewrite <- !nat_N_Z, Nat2N.inj_max, N2Z.inj_max.
Qed.
@@ -777,13 +777,13 @@ Proof.
intros. now rewrite <- !Z_N_nat, Z2N.inj_sub, N2Nat.inj_sub.
Qed.
-Lemma inj_pred n : Z.to_nat (Z.pred n) = pred (Z.to_nat n).
+Lemma inj_pred n : Z.to_nat (Z.pred n) = Nat.pred (Z.to_nat n).
Proof.
now rewrite <- !Z_N_nat, Z2N.inj_pred, N2Nat.inj_pred.
Qed.
Lemma inj_compare n m : 0<=n -> 0<=m ->
- nat_compare (Z.to_nat n) (Z.to_nat m) = (n ?= m).
+ (Z.to_nat n ?= Z.to_nat m)%nat = (n ?= m).
Proof.
intros Hn Hm. now rewrite <- Nat2Z.inj_compare, !id.
Qed.
@@ -798,12 +798,12 @@ Proof.
intros Hn Hm. unfold Z.lt. now rewrite nat_compare_lt, inj_compare.
Qed.
-Lemma inj_min n m : Z.to_nat (Z.min n m) = min (Z.to_nat n) (Z.to_nat m).
+Lemma inj_min n m : Z.to_nat (Z.min n m) = Nat.min (Z.to_nat n) (Z.to_nat m).
Proof.
now rewrite <- !Z_N_nat, Z2N.inj_min, N2Nat.inj_min.
Qed.
-Lemma inj_max n m : Z.to_nat (Z.max n m) = max (Z.to_nat n) (Z.to_nat m).
+Lemma inj_max n m : Z.to_nat (Z.max n m) = Nat.max (Z.to_nat n) (Z.to_nat m).
Proof.
now rewrite <- !Z_N_nat, Z2N.inj_max, N2Nat.inj_max.
Qed.
@@ -876,13 +876,13 @@ Proof.
intros. now rewrite <- !Zabs_N_nat, Zabs2N.inj_sub, N2Nat.inj_sub.
Qed.
-Lemma inj_pred n : 0<n -> Z.abs_nat (Z.pred n) = pred (Z.abs_nat n).
+Lemma inj_pred n : 0<n -> Z.abs_nat (Z.pred n) = Nat.pred (Z.abs_nat n).
Proof.
intros. now rewrite <- !Zabs_N_nat, Zabs2N.inj_pred, N2Nat.inj_pred.
Qed.
Lemma inj_compare n m : 0<=n -> 0<=m ->
- nat_compare (Z.abs_nat n) (Z.abs_nat m) = (n ?= m).
+ (Z.abs_nat n ?= Z.abs_nat m)%nat = (n ?= m).
Proof.
intros. now rewrite <- !Zabs_N_nat, <- N2Nat.inj_compare, Zabs2N.inj_compare.
Qed.
@@ -898,13 +898,13 @@ Proof.
Qed.
Lemma inj_min n m : 0<=n -> 0<=m ->
- Z.abs_nat (Z.min n m) = min (Z.abs_nat n) (Z.abs_nat m).
+ Z.abs_nat (Z.min n m) = Nat.min (Z.abs_nat n) (Z.abs_nat m).
Proof.
intros. now rewrite <- !Zabs_N_nat, Zabs2N.inj_min, N2Nat.inj_min.
Qed.
Lemma inj_max n m : 0<=n -> 0<=m ->
- Z.abs_nat (Z.max n m) = max (Z.abs_nat n) (Z.abs_nat m).
+ Z.abs_nat (Z.max n m) = Nat.max (Z.abs_nat n) (Z.abs_nat m).
Proof.
intros. now rewrite <- !Zabs_N_nat, Zabs2N.inj_max, N2Nat.inj_max.
Qed.
diff --git a/theories/ZArith/Znumtheory.v b/theories/ZArith/Znumtheory.v
index 0f58f524..f69cf315 100644
--- a/theories/ZArith/Znumtheory.v
+++ b/theories/ZArith/Znumtheory.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -308,11 +308,11 @@ Section extended_euclid_algorithm.
intros v3 Hv3; generalize Hv3; pattern v3.
apply Zlt_0_rec.
clear v3 Hv3; intros.
- elim (Z_zerop x); intro.
+ destruct (Z_zerop x) as [Heq|Hneq].
apply Euclid_intro with (u := u1) (v := u2) (d := u3).
assumption.
apply H3.
- rewrite a0; auto with zarith.
+ rewrite Heq; auto with zarith.
set (q := u3 / x) in *.
assert (Hq : 0 <= u3 - q * x < x).
replace (u3 - q * x) with (u3 mod x).
@@ -605,11 +605,10 @@ Qed.
Lemma prime_rel_prime :
forall p:Z, prime p -> forall a:Z, ~ (p | a) -> rel_prime p a.
Proof.
- simple induction 1; intros.
- constructor; intuition.
- elim (prime_divisors p H x H3); intuition; subst; auto with zarith.
- absurd (p | a); auto with zarith.
- absurd (p | a); intuition.
+ intros; constructor; intros; auto with zarith.
+ apply prime_divisors in H1; intuition; subst; auto with zarith.
+ - absurd (p | a); auto with zarith.
+ - absurd (p | a); intuition.
Qed.
Hint Resolve prime_rel_prime: zarith.
diff --git a/theories/ZArith/Zorder.v b/theories/ZArith/Zorder.v
index 39cf87fa..e090302e 100644
--- a/theories/ZArith/Zorder.v
+++ b/theories/ZArith/Zorder.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-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/ZArith/Zpow_alt.v b/theories/ZArith/Zpow_alt.v
index a35dcb68..8f661a9c 100644
--- a/theories/ZArith/Zpow_alt.v
+++ b/theories/ZArith/Zpow_alt.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -30,12 +30,12 @@ Infix "^^" := Zpower_alt (at level 30, right associativity) : Z_scope.
Lemma Piter_mul_acc : forall f,
(forall x y:Z, (f x)*y = f (x*y)) ->
- forall p k, Pos.iter p f k = (Pos.iter p f 1)*k.
+ forall p k, Pos.iter f k p = (Pos.iter f 1 p)*k.
Proof.
intros f Hf.
induction p; simpl; intros.
- - set (g := Pos.iter p f 1) in *. now rewrite !IHp, Hf, Z.mul_assoc.
- - set (g := Pos.iter p f 1) in *. now rewrite !IHp, Z.mul_assoc.
+ - set (g := Pos.iter f 1 p) in *. now rewrite !IHp, Hf, Z.mul_assoc.
+ - set (g := Pos.iter f 1 p) in *. now rewrite !IHp, Z.mul_assoc.
- now rewrite Hf, Z.mul_1_l.
Qed.
diff --git a/theories/ZArith/Zpow_def.v b/theories/ZArith/Zpow_def.v
index 2fbb70ba..740c45fd 100644
--- a/theories/ZArith/Zpow_def.v
+++ b/theories/ZArith/Zpow_def.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/ZArith/Zpow_facts.v b/theories/ZArith/Zpow_facts.v
index 86dfce16..ac41a98f 100644
--- a/theories/ZArith/Zpow_facts.v
+++ b/theories/ZArith/Zpow_facts.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -152,10 +152,8 @@ Qed.
Theorem Zpow_mod_correct a m n :
n <> 0 -> Zpow_mod a m n = (a ^ m) mod n.
Proof.
- intros Hn. destruct m; simpl.
- - trivial.
+ intros Hn. destruct m; simpl; trivial.
- apply Zpow_mod_pos_correct; auto with zarith.
- - rewrite Z.mod_0_l; auto with zarith.
Qed.
(* Complements about power and number theory. *)
diff --git a/theories/ZArith/Zpower.v b/theories/ZArith/Zpower.v
index 27f0cfd2..747bd4fd 100644
--- a/theories/ZArith/Zpower.v
+++ b/theories/ZArith/Zpower.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -25,7 +25,7 @@ Local Open Scope Z_scope.
(** [Zpower_nat z n] is the n-th power of [z] when [n] is an unary
integer (type [nat]) and [z] a signed integer (type [Z]) *)
-Definition Zpower_nat (z:Z) (n:nat) := nat_iter n (Z.mul z) 1.
+Definition Zpower_nat (z:Z) := nat_rect _ 1 (fun _ => Z.mul z).
Lemma Zpower_nat_0_r z : Zpower_nat z 0 = 1.
Proof. reflexivity. Qed.
@@ -42,7 +42,7 @@ Lemma Zpower_nat_is_exp :
Proof.
induction n.
- intros. now rewrite Zpower_nat_0_r, Z.mul_1_l.
- - intros. simpl. now rewrite 2 Zpower_nat_succ_r, IHn, Z.mul_assoc.
+ - intros. simpl. now rewrite IHn, Z.mul_assoc.
Qed.
(** Conversions between powers of unary and binary integers *)
@@ -94,12 +94,12 @@ Section Powers_of_2.
calculus is possible. [shift n m] computes [2^n * m], i.e.
[m] shifted by [n] positions *)
- Definition shift_nat (n:nat) (z:positive) := nat_iter n xO z.
- Definition shift_pos (n z:positive) := Pos.iter n xO z.
+ Definition shift_nat (n:nat) (z:positive) := nat_rect _ z (fun _ => xO) n.
+ Definition shift_pos (n z:positive) := Pos.iter xO z n.
Definition shift (n:Z) (z:positive) :=
match n with
| Z0 => z
- | Zpos p => Pos.iter p xO z
+ | Zpos p => Pos.iter xO z p
| Zneg p => z
end.
@@ -154,7 +154,7 @@ Section Powers_of_2.
Lemma shift_nat_plus n m x :
shift_nat (n + m) x = shift_nat n (shift_nat m x).
Proof.
- apply iter_nat_plus.
+ induction n; simpl; now f_equal.
Qed.
Theorem shift_nat_correct n x :
@@ -247,20 +247,20 @@ Section power_div_with_rest.
end, 2 * d).
Definition Zdiv_rest (x:Z) (p:positive) :=
- let (qr, d) := Pos.iter p Zdiv_rest_aux (x, 0, 1) in qr.
+ let (qr, d) := Pos.iter Zdiv_rest_aux (x, 0, 1) p in qr.
Lemma Zdiv_rest_correct1 (x:Z) (p:positive) :
- let (_, d) := Pos.iter p Zdiv_rest_aux (x, 0, 1) in
+ let (_, d) := Pos.iter Zdiv_rest_aux (x, 0, 1) p in
d = two_power_pos p.
Proof.
rewrite Pos2Nat.inj_iter, two_power_pos_nat.
induction (Pos.to_nat p); simpl; trivial.
- destruct (nat_iter n Zdiv_rest_aux (x,0,1)) as ((q,r),d).
+ destruct (nat_rect _ _ _ _) as ((q,r),d).
unfold Zdiv_rest_aux. rewrite two_power_nat_S; now f_equal.
Qed.
Lemma Zdiv_rest_correct2 (x:Z) (p:positive) :
- let '(q,r,d) := Pos.iter p Zdiv_rest_aux (x, 0, 1) in
+ let '(q,r,d) := Pos.iter Zdiv_rest_aux (x, 0, 1) p in
x = q * d + r /\ 0 <= r < d.
Proof.
apply Pos.iter_invariant; [|omega].
@@ -287,7 +287,7 @@ Section power_div_with_rest.
Lemma Zdiv_rest_correct (x:Z) (p:positive) : Zdiv_rest_proofs x p.
Proof.
generalize (Zdiv_rest_correct1 x p); generalize (Zdiv_rest_correct2 x p).
- destruct (Pos.iter p Zdiv_rest_aux (x, 0, 1)) as ((q,r),d).
+ destruct (Pos.iter Zdiv_rest_aux (x, 0, 1) p) as ((q,r),d).
intros (H1,(H2,H3)) ->. now exists q r.
Qed.
@@ -299,7 +299,7 @@ Section power_div_with_rest.
Proof.
unfold Zdiv_rest.
generalize (Zdiv_rest_correct1 x p); generalize (Zdiv_rest_correct2 x p).
- destruct (Pos.iter p Zdiv_rest_aux (x, 0, 1)) as ((q,r),d).
+ destruct (Pos.iter Zdiv_rest_aux (x, 0, 1) p) as ((q,r),d).
intros H ->. now rewrite two_power_pos_equiv in H.
Qed.
diff --git a/theories/ZArith/Zquot.v b/theories/ZArith/Zquot.v
index 7f064c2b..3ef11189 100644
--- a/theories/ZArith/Zquot.v
+++ b/theories/ZArith/Zquot.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/ZArith/Zsqrt_compat.v b/theories/ZArith/Zsqrt_compat.v
index 24f3715e..65959a69 100644
--- a/theories/ZArith/Zsqrt_compat.v
+++ b/theories/ZArith/Zsqrt_compat.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -53,7 +53,7 @@ Definition sqrtrempos : forall p:positive, sqrt_data (Zpos p).
| xI xH => c_sqrt 3 1 2 _ _
| xO (xO p') =>
match sqrtrempos p' with
- | c_sqrt s' r' Heq Hint =>
+ | c_sqrt _ s' r' Heq Hint =>
match Z_le_gt_dec (4 * s' + 1) (4 * r') with
| left Hle =>
c_sqrt (Zpos (xO (xO p'))) (2 * s' + 1)
@@ -63,7 +63,7 @@ Definition sqrtrempos : forall p:positive, sqrt_data (Zpos p).
end
| xO (xI p') =>
match sqrtrempos p' with
- | c_sqrt s' r' Heq Hint =>
+ | c_sqrt _ s' r' Heq Hint =>
match Z_le_gt_dec (4 * s' + 1) (4 * r' + 2) with
| left Hle =>
c_sqrt (Zpos (xO (xI p'))) (2 * s' + 1)
@@ -74,7 +74,7 @@ Definition sqrtrempos : forall p:positive, sqrt_data (Zpos p).
end
| xI (xO p') =>
match sqrtrempos p' with
- | c_sqrt s' r' Heq Hint =>
+ | c_sqrt _ s' r' Heq Hint =>
match Z_le_gt_dec (4 * s' + 1) (4 * r' + 1) with
| left Hle =>
c_sqrt (Zpos (xI (xO p'))) (2 * s' + 1)
@@ -85,7 +85,7 @@ Definition sqrtrempos : forall p:positive, sqrt_data (Zpos p).
end
| xI (xI p') =>
match sqrtrempos p' with
- | c_sqrt s' r' Heq Hint =>
+ | c_sqrt _ s' r' Heq Hint =>
match Z_le_gt_dec (4 * s' + 1) (4 * r' + 3) with
| left Hle =>
c_sqrt (Zpos (xI (xI p'))) (2 * s' + 1)
@@ -114,7 +114,7 @@ Definition Zsqrt :
| Zpos p =>
fun h =>
match sqrtrempos p with
- | c_sqrt s r Heq Hint =>
+ | c_sqrt _ s r Heq Hint =>
existT
(fun s:Z =>
{r : Z |
@@ -150,7 +150,7 @@ Definition Zsqrt_plain (x:Z) : Z :=
match x with
| Zpos p =>
match Zsqrt (Zpos p) (Pos2Z.is_nonneg p) with
- | existT s _ => s
+ | existT _ s _ => s
end
| Zneg p => 0
| Z0 => 0
diff --git a/theories/ZArith/Zwf.v b/theories/ZArith/Zwf.v
index 9d2e9cab..cba709e8 100644
--- a/theories/ZArith/Zwf.v
+++ b/theories/ZArith/Zwf.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/ZArith/auxiliary.v b/theories/ZArith/auxiliary.v
index 929aedc9..25ef852a 100644
--- a/theories/ZArith/auxiliary.v
+++ b/theories/ZArith/auxiliary.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-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/theories/ZArith/vo.itarget b/theories/ZArith/vo.itarget
index 88751cc0..178111cd 100644
--- a/theories/ZArith/vo.itarget
+++ b/theories/ZArith/vo.itarget
@@ -23,8 +23,6 @@ Zmin.vo
Zmisc.vo
Znat.vo
Znumtheory.vo
-ZOdiv_def.vo
-ZOdiv.vo
Zquot.vo
Zorder.vo
Zpow_def.vo