merged fork with new numeral representation (see NEWS)
authorhuffman
Sun Mar 25 20:15:39 2012 +0200 (2012-03-25)
changeset 471082a1953f0d20d
parent 47107 35807a5d8dc2
child 47109 db5026631799
merged fork with new numeral representation (see NEWS)
NEWS
src/HOL/Algebra/Group.thy
src/HOL/Archimedean_Field.thy
src/HOL/Code_Evaluation.thy
src/HOL/Code_Numeral.thy
src/HOL/Codegenerator_Test/Generate_Pretty.thy
src/HOL/Complex.thy
src/HOL/Decision_Procs/Approximation.thy
src/HOL/Decision_Procs/Cooper.thy
src/HOL/Decision_Procs/Dense_Linear_Order.thy
src/HOL/Decision_Procs/Ferrack.thy
src/HOL/Decision_Procs/MIR.thy
src/HOL/Decision_Procs/Parametric_Ferrante_Rackoff.thy
src/HOL/Decision_Procs/cooper_tac.ML
src/HOL/Decision_Procs/ex/Dense_Linear_Order_Ex.thy
src/HOL/Decision_Procs/ferrack_tac.ML
src/HOL/Decision_Procs/mir_tac.ML
src/HOL/Deriv.thy
src/HOL/Divides.thy
src/HOL/Imperative_HOL/ex/Imperative_Quicksort.thy
src/HOL/Imperative_HOL/ex/Imperative_Reverse.thy
src/HOL/Imperative_HOL/ex/SatChecker.thy
src/HOL/Imperative_HOL/ex/Subarray.thy
src/HOL/Import/HOL_Light/HOLLightInt.thy
src/HOL/Int.thy
src/HOL/IsaMakefile
src/HOL/Library/BigO.thy
src/HOL/Library/Binomial.thy
src/HOL/Library/Bit.thy
src/HOL/Library/Cardinality.thy
src/HOL/Library/Code_Integer.thy
src/HOL/Library/Code_Nat.thy
src/HOL/Library/Code_Natural.thy
src/HOL/Library/Code_Prolog.thy
src/HOL/Library/Code_Real_Approx_By_Float.thy
src/HOL/Library/Efficient_Nat.thy
src/HOL/Library/Extended_Nat.thy
src/HOL/Library/Extended_Real.thy
src/HOL/Library/Float.thy
src/HOL/Library/Formal_Power_Series.thy
src/HOL/Library/Numeral_Type.thy
src/HOL/Library/Poly_Deriv.thy
src/HOL/Library/Polynomial.thy
src/HOL/Library/Predicate_Compile_Alternative_Defs.thy
src/HOL/Library/ROOT.ML
src/HOL/Library/Saturated.thy
src/HOL/Library/Sum_of_Squares/sum_of_squares.ML
src/HOL/Library/Target_Numeral.thy
src/HOL/List.thy
src/HOL/Matrix_LP/ComputeFloat.thy
src/HOL/Matrix_LP/ComputeNumeral.thy
src/HOL/Matrix_LP/SparseMatrix.thy
src/HOL/Metis_Examples/Big_O.thy
src/HOL/Multivariate_Analysis/Cartesian_Euclidean_Space.thy
src/HOL/Multivariate_Analysis/Convex_Euclidean_Space.thy
src/HOL/Multivariate_Analysis/Determinants.thy
src/HOL/Multivariate_Analysis/Norm_Arith.thy
src/HOL/Multivariate_Analysis/Topology_Euclidean_Space.thy
src/HOL/Mutabelle/mutabelle_extra.ML
src/HOL/NSA/HyperDef.thy
src/HOL/NSA/NSA.thy
src/HOL/NSA/NSCA.thy
src/HOL/NSA/NSComplex.thy
src/HOL/NSA/StarDef.thy
src/HOL/Nat.thy
src/HOL/Nat_Numeral.thy
src/HOL/Nitpick_Examples/Integer_Nits.thy
src/HOL/Nominal/Nominal.thy
src/HOL/Num.thy
src/HOL/Number_Theory/Primes.thy
src/HOL/Numeral_Simprocs.thy
src/HOL/Parity.thy
src/HOL/Plain.thy
src/HOL/Predicate_Compile_Examples/Predicate_Compile_Tests.thy
src/HOL/Presburger.thy
src/HOL/Quickcheck_Examples/Quickcheck_Narrowing_Examples.thy
src/HOL/Quickcheck_Narrowing.thy
src/HOL/Quotient_Examples/Quotient_Rat.thy
src/HOL/RComplete.thy
src/HOL/Rat.thy
src/HOL/RealDef.thy
src/HOL/RealVector.thy
src/HOL/SMT_Examples/SMT_Examples.thy
src/HOL/SMT_Examples/SMT_Tests.thy
src/HOL/SPARK/SPARK.thy
src/HOL/Semiring_Normalization.thy
src/HOL/Series.thy
src/HOL/SetInterval.thy
src/HOL/Tools/Nitpick/nitpick.ML
src/HOL/Tools/Nitpick/nitpick_hol.ML
src/HOL/Tools/Predicate_Compile/predicate_compile_data.ML
src/HOL/Tools/Qelim/cooper.ML
src/HOL/Tools/SMT/smt_normalize.ML
src/HOL/Tools/SMT/z3_proof_tools.ML
src/HOL/Tools/arith_data.ML
src/HOL/Tools/float_syntax.ML
src/HOL/Tools/hologic.ML
src/HOL/Tools/int_arith.ML
src/HOL/Tools/lin_arith.ML
src/HOL/Tools/nat_numeral_simprocs.ML
src/HOL/Tools/numeral.ML
src/HOL/Tools/numeral_simprocs.ML
src/HOL/Tools/numeral_syntax.ML
src/HOL/Tools/semiring_normalizer.ML
src/HOL/Transcendental.thy
src/HOL/Word/Bit_Int.thy
src/HOL/Word/Bit_Representation.thy
src/HOL/Word/Bool_List_Representation.thy
src/HOL/Word/Misc_Numeric.thy
src/HOL/Word/Word.thy
src/HOL/ex/Arith_Examples.thy
src/HOL/ex/Code_Nat_examples.thy
src/HOL/ex/Dedekind_Real.thy
src/HOL/ex/Efficient_Nat_examples.thy
src/HOL/ex/Groebner_Examples.thy
src/HOL/ex/Numeral_Representation.thy
src/HOL/ex/ROOT.ML
src/HOL/ex/ReflectionEx.thy
src/HOL/ex/Simproc_Tests.thy
     1.1 --- a/NEWS	Sat Mar 24 16:27:04 2012 +0100
     1.2 +++ b/NEWS	Sun Mar 25 20:15:39 2012 +0200
     1.3 @@ -90,6 +90,30 @@
     1.4  
     1.5  *** HOL ***
     1.6  
     1.7 +* The representation of numerals has changed. We now have a datatype
     1.8 +"num" representing strictly positive binary numerals, along with
     1.9 +functions "numeral :: num => 'a" and "neg_numeral :: num => 'a" to
    1.10 +represent positive and negated numeric literals, respectively. (See
    1.11 +definitions in Num.thy.) Potential INCOMPATIBILITY; some user theories
    1.12 +may require adaptations:
    1.13 +
    1.14 +  - Theorems with number_ring or number_semiring constraints: These
    1.15 +    classes are gone; use comm_ring_1 or comm_semiring_1 instead.
    1.16 +
    1.17 +  - Theories defining numeric types: Remove number, number_semiring,
    1.18 +    and number_ring instances. Defer all theorems about numerals until
    1.19 +    after classes one and semigroup_add have been instantiated.
    1.20 +
    1.21 +  - Numeral-only simp rules: Replace each rule having a "number_of v"
    1.22 +    pattern with two copies, one for numeral and one for neg_numeral.
    1.23 +
    1.24 +  - Theorems about subclasses of semiring_1 or ring_1: These classes
    1.25 +    automatically support numerals now, so more simp rules and
    1.26 +    simprocs may now apply within the proof.
    1.27 +
    1.28 +  - Definitions and theorems using old constructors Pls/Min/Bit0/Bit1:
    1.29 +    Redefine using other integer operations.
    1.30 +
    1.31  * Type 'a set is now a proper type constructor (just as before
    1.32  Isabelle2008).  Definitions mem_def and Collect_def have disappeared.
    1.33  Non-trivial INCOMPATIBILITY.  For developments keeping predicates and
     2.1 --- a/src/HOL/Algebra/Group.thy	Sat Mar 24 16:27:04 2012 +0100
     2.2 +++ b/src/HOL/Algebra/Group.thy	Sun Mar 25 20:15:39 2012 +0200
     2.3 @@ -30,7 +30,7 @@
     2.4    where "Units G = {y. y \<in> carrier G & (\<exists>x \<in> carrier G. x \<otimes>\<^bsub>G\<^esub> y = \<one>\<^bsub>G\<^esub> & y \<otimes>\<^bsub>G\<^esub> x = \<one>\<^bsub>G\<^esub>)}"
     2.5  
     2.6  consts
     2.7 -  pow :: "[('a, 'm) monoid_scheme, 'a, 'b::number] => 'a"  (infixr "'(^')\<index>" 75)
     2.8 +  pow :: "[('a, 'm) monoid_scheme, 'a, 'b::semiring_1] => 'a"  (infixr "'(^')\<index>" 75)
     2.9  
    2.10  overloading nat_pow == "pow :: [_, 'a, nat] => 'a"
    2.11  begin
     3.1 --- a/src/HOL/Archimedean_Field.thy	Sat Mar 24 16:27:04 2012 +0100
     3.2 +++ b/src/HOL/Archimedean_Field.thy	Sun Mar 25 20:15:39 2012 +0200
     3.3 @@ -12,7 +12,7 @@
     3.4  
     3.5  text {* Archimedean fields have no infinite elements. *}
     3.6  
     3.7 -class archimedean_field = linordered_field + number_ring +
     3.8 +class archimedean_field = linordered_field +
     3.9    assumes ex_le_of_int: "\<exists>z. x \<le> of_int z"
    3.10  
    3.11  lemma ex_less_of_int:
    3.12 @@ -202,8 +202,11 @@
    3.13  lemma floor_one [simp]: "floor 1 = 1"
    3.14    using floor_of_int [of 1] by simp
    3.15  
    3.16 -lemma floor_number_of [simp]: "floor (number_of v) = number_of v"
    3.17 -  using floor_of_int [of "number_of v"] by simp
    3.18 +lemma floor_numeral [simp]: "floor (numeral v) = numeral v"
    3.19 +  using floor_of_int [of "numeral v"] by simp
    3.20 +
    3.21 +lemma floor_neg_numeral [simp]: "floor (neg_numeral v) = neg_numeral v"
    3.22 +  using floor_of_int [of "neg_numeral v"] by simp
    3.23  
    3.24  lemma zero_le_floor [simp]: "0 \<le> floor x \<longleftrightarrow> 0 \<le> x"
    3.25    by (simp add: le_floor_iff)
    3.26 @@ -211,7 +214,12 @@
    3.27  lemma one_le_floor [simp]: "1 \<le> floor x \<longleftrightarrow> 1 \<le> x"
    3.28    by (simp add: le_floor_iff)
    3.29  
    3.30 -lemma number_of_le_floor [simp]: "number_of v \<le> floor x \<longleftrightarrow> number_of v \<le> x"
    3.31 +lemma numeral_le_floor [simp]:
    3.32 +  "numeral v \<le> floor x \<longleftrightarrow> numeral v \<le> x"
    3.33 +  by (simp add: le_floor_iff)
    3.34 +
    3.35 +lemma neg_numeral_le_floor [simp]:
    3.36 +  "neg_numeral v \<le> floor x \<longleftrightarrow> neg_numeral v \<le> x"
    3.37    by (simp add: le_floor_iff)
    3.38  
    3.39  lemma zero_less_floor [simp]: "0 < floor x \<longleftrightarrow> 1 \<le> x"
    3.40 @@ -220,8 +228,12 @@
    3.41  lemma one_less_floor [simp]: "1 < floor x \<longleftrightarrow> 2 \<le> x"
    3.42    by (simp add: less_floor_iff)
    3.43  
    3.44 -lemma number_of_less_floor [simp]:
    3.45 -  "number_of v < floor x \<longleftrightarrow> number_of v + 1 \<le> x"
    3.46 +lemma numeral_less_floor [simp]:
    3.47 +  "numeral v < floor x \<longleftrightarrow> numeral v + 1 \<le> x"
    3.48 +  by (simp add: less_floor_iff)
    3.49 +
    3.50 +lemma neg_numeral_less_floor [simp]:
    3.51 +  "neg_numeral v < floor x \<longleftrightarrow> neg_numeral v + 1 \<le> x"
    3.52    by (simp add: less_floor_iff)
    3.53  
    3.54  lemma floor_le_zero [simp]: "floor x \<le> 0 \<longleftrightarrow> x < 1"
    3.55 @@ -230,8 +242,12 @@
    3.56  lemma floor_le_one [simp]: "floor x \<le> 1 \<longleftrightarrow> x < 2"
    3.57    by (simp add: floor_le_iff)
    3.58  
    3.59 -lemma floor_le_number_of [simp]:
    3.60 -  "floor x \<le> number_of v \<longleftrightarrow> x < number_of v + 1"
    3.61 +lemma floor_le_numeral [simp]:
    3.62 +  "floor x \<le> numeral v \<longleftrightarrow> x < numeral v + 1"
    3.63 +  by (simp add: floor_le_iff)
    3.64 +
    3.65 +lemma floor_le_neg_numeral [simp]:
    3.66 +  "floor x \<le> neg_numeral v \<longleftrightarrow> x < neg_numeral v + 1"
    3.67    by (simp add: floor_le_iff)
    3.68  
    3.69  lemma floor_less_zero [simp]: "floor x < 0 \<longleftrightarrow> x < 0"
    3.70 @@ -240,8 +256,12 @@
    3.71  lemma floor_less_one [simp]: "floor x < 1 \<longleftrightarrow> x < 1"
    3.72    by (simp add: floor_less_iff)
    3.73  
    3.74 -lemma floor_less_number_of [simp]:
    3.75 -  "floor x < number_of v \<longleftrightarrow> x < number_of v"
    3.76 +lemma floor_less_numeral [simp]:
    3.77 +  "floor x < numeral v \<longleftrightarrow> x < numeral v"
    3.78 +  by (simp add: floor_less_iff)
    3.79 +
    3.80 +lemma floor_less_neg_numeral [simp]:
    3.81 +  "floor x < neg_numeral v \<longleftrightarrow> x < neg_numeral v"
    3.82    by (simp add: floor_less_iff)
    3.83  
    3.84  text {* Addition and subtraction of integers *}
    3.85 @@ -249,9 +269,13 @@
    3.86  lemma floor_add_of_int [simp]: "floor (x + of_int z) = floor x + z"
    3.87    using floor_correct [of x] by (simp add: floor_unique)
    3.88  
    3.89 -lemma floor_add_number_of [simp]:
    3.90 -    "floor (x + number_of v) = floor x + number_of v"
    3.91 -  using floor_add_of_int [of x "number_of v"] by simp
    3.92 +lemma floor_add_numeral [simp]:
    3.93 +    "floor (x + numeral v) = floor x + numeral v"
    3.94 +  using floor_add_of_int [of x "numeral v"] by simp
    3.95 +
    3.96 +lemma floor_add_neg_numeral [simp]:
    3.97 +    "floor (x + neg_numeral v) = floor x + neg_numeral v"
    3.98 +  using floor_add_of_int [of x "neg_numeral v"] by simp
    3.99  
   3.100  lemma floor_add_one [simp]: "floor (x + 1) = floor x + 1"
   3.101    using floor_add_of_int [of x 1] by simp
   3.102 @@ -259,9 +283,13 @@
   3.103  lemma floor_diff_of_int [simp]: "floor (x - of_int z) = floor x - z"
   3.104    using floor_add_of_int [of x "- z"] by (simp add: algebra_simps)
   3.105  
   3.106 -lemma floor_diff_number_of [simp]:
   3.107 -  "floor (x - number_of v) = floor x - number_of v"
   3.108 -  using floor_diff_of_int [of x "number_of v"] by simp
   3.109 +lemma floor_diff_numeral [simp]:
   3.110 +  "floor (x - numeral v) = floor x - numeral v"
   3.111 +  using floor_diff_of_int [of x "numeral v"] by simp
   3.112 +
   3.113 +lemma floor_diff_neg_numeral [simp]:
   3.114 +  "floor (x - neg_numeral v) = floor x - neg_numeral v"
   3.115 +  using floor_diff_of_int [of x "neg_numeral v"] by simp
   3.116  
   3.117  lemma floor_diff_one [simp]: "floor (x - 1) = floor x - 1"
   3.118    using floor_diff_of_int [of x 1] by simp
   3.119 @@ -320,8 +348,11 @@
   3.120  lemma ceiling_one [simp]: "ceiling 1 = 1"
   3.121    using ceiling_of_int [of 1] by simp
   3.122  
   3.123 -lemma ceiling_number_of [simp]: "ceiling (number_of v) = number_of v"
   3.124 -  using ceiling_of_int [of "number_of v"] by simp
   3.125 +lemma ceiling_numeral [simp]: "ceiling (numeral v) = numeral v"
   3.126 +  using ceiling_of_int [of "numeral v"] by simp
   3.127 +
   3.128 +lemma ceiling_neg_numeral [simp]: "ceiling (neg_numeral v) = neg_numeral v"
   3.129 +  using ceiling_of_int [of "neg_numeral v"] by simp
   3.130  
   3.131  lemma ceiling_le_zero [simp]: "ceiling x \<le> 0 \<longleftrightarrow> x \<le> 0"
   3.132    by (simp add: ceiling_le_iff)
   3.133 @@ -329,8 +360,12 @@
   3.134  lemma ceiling_le_one [simp]: "ceiling x \<le> 1 \<longleftrightarrow> x \<le> 1"
   3.135    by (simp add: ceiling_le_iff)
   3.136  
   3.137 -lemma ceiling_le_number_of [simp]:
   3.138 -  "ceiling x \<le> number_of v \<longleftrightarrow> x \<le> number_of v"
   3.139 +lemma ceiling_le_numeral [simp]:
   3.140 +  "ceiling x \<le> numeral v \<longleftrightarrow> x \<le> numeral v"
   3.141 +  by (simp add: ceiling_le_iff)
   3.142 +
   3.143 +lemma ceiling_le_neg_numeral [simp]:
   3.144 +  "ceiling x \<le> neg_numeral v \<longleftrightarrow> x \<le> neg_numeral v"
   3.145    by (simp add: ceiling_le_iff)
   3.146  
   3.147  lemma ceiling_less_zero [simp]: "ceiling x < 0 \<longleftrightarrow> x \<le> -1"
   3.148 @@ -339,8 +374,12 @@
   3.149  lemma ceiling_less_one [simp]: "ceiling x < 1 \<longleftrightarrow> x \<le> 0"
   3.150    by (simp add: ceiling_less_iff)
   3.151  
   3.152 -lemma ceiling_less_number_of [simp]:
   3.153 -  "ceiling x < number_of v \<longleftrightarrow> x \<le> number_of v - 1"
   3.154 +lemma ceiling_less_numeral [simp]:
   3.155 +  "ceiling x < numeral v \<longleftrightarrow> x \<le> numeral v - 1"
   3.156 +  by (simp add: ceiling_less_iff)
   3.157 +
   3.158 +lemma ceiling_less_neg_numeral [simp]:
   3.159 +  "ceiling x < neg_numeral v \<longleftrightarrow> x \<le> neg_numeral v - 1"
   3.160    by (simp add: ceiling_less_iff)
   3.161  
   3.162  lemma zero_le_ceiling [simp]: "0 \<le> ceiling x \<longleftrightarrow> -1 < x"
   3.163 @@ -349,8 +388,12 @@
   3.164  lemma one_le_ceiling [simp]: "1 \<le> ceiling x \<longleftrightarrow> 0 < x"
   3.165    by (simp add: le_ceiling_iff)
   3.166  
   3.167 -lemma number_of_le_ceiling [simp]:
   3.168 -  "number_of v \<le> ceiling x\<longleftrightarrow> number_of v - 1 < x"
   3.169 +lemma numeral_le_ceiling [simp]:
   3.170 +  "numeral v \<le> ceiling x \<longleftrightarrow> numeral v - 1 < x"
   3.171 +  by (simp add: le_ceiling_iff)
   3.172 +
   3.173 +lemma neg_numeral_le_ceiling [simp]:
   3.174 +  "neg_numeral v \<le> ceiling x \<longleftrightarrow> neg_numeral v - 1 < x"
   3.175    by (simp add: le_ceiling_iff)
   3.176  
   3.177  lemma zero_less_ceiling [simp]: "0 < ceiling x \<longleftrightarrow> 0 < x"
   3.178 @@ -359,8 +402,12 @@
   3.179  lemma one_less_ceiling [simp]: "1 < ceiling x \<longleftrightarrow> 1 < x"
   3.180    by (simp add: less_ceiling_iff)
   3.181  
   3.182 -lemma number_of_less_ceiling [simp]:
   3.183 -  "number_of v < ceiling x \<longleftrightarrow> number_of v < x"
   3.184 +lemma numeral_less_ceiling [simp]:
   3.185 +  "numeral v < ceiling x \<longleftrightarrow> numeral v < x"
   3.186 +  by (simp add: less_ceiling_iff)
   3.187 +
   3.188 +lemma neg_numeral_less_ceiling [simp]:
   3.189 +  "neg_numeral v < ceiling x \<longleftrightarrow> neg_numeral v < x"
   3.190    by (simp add: less_ceiling_iff)
   3.191  
   3.192  text {* Addition and subtraction of integers *}
   3.193 @@ -368,9 +415,13 @@
   3.194  lemma ceiling_add_of_int [simp]: "ceiling (x + of_int z) = ceiling x + z"
   3.195    using ceiling_correct [of x] by (simp add: ceiling_unique)
   3.196  
   3.197 -lemma ceiling_add_number_of [simp]:
   3.198 -    "ceiling (x + number_of v) = ceiling x + number_of v"
   3.199 -  using ceiling_add_of_int [of x "number_of v"] by simp
   3.200 +lemma ceiling_add_numeral [simp]:
   3.201 +    "ceiling (x + numeral v) = ceiling x + numeral v"
   3.202 +  using ceiling_add_of_int [of x "numeral v"] by simp
   3.203 +
   3.204 +lemma ceiling_add_neg_numeral [simp]:
   3.205 +    "ceiling (x + neg_numeral v) = ceiling x + neg_numeral v"
   3.206 +  using ceiling_add_of_int [of x "neg_numeral v"] by simp
   3.207  
   3.208  lemma ceiling_add_one [simp]: "ceiling (x + 1) = ceiling x + 1"
   3.209    using ceiling_add_of_int [of x 1] by simp
   3.210 @@ -378,9 +429,13 @@
   3.211  lemma ceiling_diff_of_int [simp]: "ceiling (x - of_int z) = ceiling x - z"
   3.212    using ceiling_add_of_int [of x "- z"] by (simp add: algebra_simps)
   3.213  
   3.214 -lemma ceiling_diff_number_of [simp]:
   3.215 -  "ceiling (x - number_of v) = ceiling x - number_of v"
   3.216 -  using ceiling_diff_of_int [of x "number_of v"] by simp
   3.217 +lemma ceiling_diff_numeral [simp]:
   3.218 +  "ceiling (x - numeral v) = ceiling x - numeral v"
   3.219 +  using ceiling_diff_of_int [of x "numeral v"] by simp
   3.220 +
   3.221 +lemma ceiling_diff_neg_numeral [simp]:
   3.222 +  "ceiling (x - neg_numeral v) = ceiling x - neg_numeral v"
   3.223 +  using ceiling_diff_of_int [of x "neg_numeral v"] by simp
   3.224  
   3.225  lemma ceiling_diff_one [simp]: "ceiling (x - 1) = ceiling x - 1"
   3.226    using ceiling_diff_of_int [of x 1] by simp
     4.1 --- a/src/HOL/Code_Evaluation.thy	Sat Mar 24 16:27:04 2012 +0100
     4.2 +++ b/src/HOL/Code_Evaluation.thy	Sun Mar 25 20:15:39 2012 +0200
     4.3 @@ -146,33 +146,29 @@
     4.4    "term_of_num_semiring two = (\<lambda>_. dummy_term)"
     4.5  
     4.6  lemma (in term_syntax) term_of_num_semiring_code [code]:
     4.7 -  "term_of_num_semiring two k = (if k = 0 then termify Int.Pls
     4.8 +  "term_of_num_semiring two k = (
     4.9 +    if k = 1 then termify Num.One
    4.10      else (if k mod two = 0
    4.11 -      then termify Int.Bit0 <\<cdot>> term_of_num_semiring two (k div two)
    4.12 -      else termify Int.Bit1 <\<cdot>> term_of_num_semiring two (k div two)))"
    4.13 -  by (auto simp add: term_of_anything Const_def App_def term_of_num_semiring_def Let_def)
    4.14 +      then termify Num.Bit0 <\<cdot>> term_of_num_semiring two (k div two)
    4.15 +      else termify Num.Bit1 <\<cdot>> term_of_num_semiring two (k div two)))"
    4.16 +  by (auto simp add: term_of_anything Const_def App_def term_of_num_semiring_def)
    4.17  
    4.18  lemma (in term_syntax) term_of_nat_code [code]:
    4.19 -  "term_of (n::nat) = termify (number_of :: int \<Rightarrow> nat) <\<cdot>> term_of_num_semiring (2::nat) n"
    4.20 +  "term_of (n::nat) = (
    4.21 +    if n = 0 then termify (0 :: nat)
    4.22 +    else termify (numeral :: num \<Rightarrow> nat) <\<cdot>> term_of_num_semiring (2::nat) n)"
    4.23    by (simp only: term_of_anything)
    4.24  
    4.25  lemma (in term_syntax) term_of_code_numeral_code [code]:
    4.26 -  "term_of (k::code_numeral) = termify (number_of :: int \<Rightarrow> code_numeral) <\<cdot>> term_of_num_semiring (2::code_numeral) k"
    4.27 +  "term_of (k::code_numeral) = (
    4.28 +    if k = 0 then termify (0 :: code_numeral)
    4.29 +    else termify (numeral :: num \<Rightarrow> code_numeral) <\<cdot>> term_of_num_semiring (2::code_numeral) k)"
    4.30    by (simp only: term_of_anything)
    4.31  
    4.32 -definition term_of_num_ring :: "'a\<Colon>ring_div \<Rightarrow> 'a \<Rightarrow> term" where
    4.33 -  "term_of_num_ring two = (\<lambda>_. dummy_term)"
    4.34 -
    4.35 -lemma (in term_syntax) term_of_num_ring_code [code]:
    4.36 -  "term_of_num_ring two k = (if k = 0 then termify Int.Pls
    4.37 -    else if k = -1 then termify Int.Min
    4.38 -    else if k mod two = 0 then termify Int.Bit0 <\<cdot>> term_of_num_ring two (k div two)
    4.39 -    else termify Int.Bit1 <\<cdot>> term_of_num_ring two (k div two))"
    4.40 -  by (auto simp add: term_of_anything Const_def App_def term_of_num_ring_def Let_def)
    4.41 -
    4.42  lemma (in term_syntax) term_of_int_code [code]:
    4.43    "term_of (k::int) = (if k = 0 then termify (0 :: int)
    4.44 -    else termify (number_of :: int \<Rightarrow> int) <\<cdot>> term_of_num_ring (2::int) k)"
    4.45 +    else if k < 0 then termify (neg_numeral :: num \<Rightarrow> int) <\<cdot>> term_of_num_semiring (2::int) (- k)
    4.46 +    else termify (numeral :: num \<Rightarrow> int) <\<cdot>> term_of_num_semiring (2::int) k)"
    4.47    by (simp only: term_of_anything)
    4.48  
    4.49  
    4.50 @@ -201,6 +197,6 @@
    4.51  
    4.52  
    4.53  hide_const dummy_term valapp
    4.54 -hide_const (open) Const App Abs Free termify valtermify term_of term_of_num_semiring term_of_num_ring tracing
    4.55 +hide_const (open) Const App Abs Free termify valtermify term_of term_of_num_semiring tracing
    4.56  
    4.57  end
     5.1 --- a/src/HOL/Code_Numeral.thy	Sat Mar 24 16:27:04 2012 +0100
     5.2 +++ b/src/HOL/Code_Numeral.thy	Sun Mar 25 20:15:39 2012 +0200
     5.3 @@ -123,25 +123,6 @@
     5.4    by (rule equal_refl)
     5.5  
     5.6  
     5.7 -subsection {* Code numerals as datatype of ints *}
     5.8 -
     5.9 -instantiation code_numeral :: number
    5.10 -begin
    5.11 -
    5.12 -definition
    5.13 -  "number_of = of_nat o nat"
    5.14 -
    5.15 -instance ..
    5.16 -
    5.17 -end
    5.18 -
    5.19 -lemma nat_of_number [simp]:
    5.20 -  "nat_of (number_of k) = number_of k"
    5.21 -  by (simp add: number_of_code_numeral_def nat_number_of_def number_of_is_id)
    5.22 -
    5.23 -code_datatype "number_of \<Colon> int \<Rightarrow> code_numeral"
    5.24 -
    5.25 -
    5.26  subsection {* Basic arithmetic *}
    5.27  
    5.28  instantiation code_numeral :: "{minus, linordered_semidom, semiring_div, linorder}"
    5.29 @@ -176,16 +157,17 @@
    5.30  
    5.31  end
    5.32  
    5.33 -lemma zero_code_numeral_code [code]:
    5.34 -  "(0\<Colon>code_numeral) = Numeral0"
    5.35 -  by (simp add: number_of_code_numeral_def Pls_def)
    5.36 +lemma nat_of_numeral [simp]: "nat_of (numeral k) = numeral k"
    5.37 +  by (induct k rule: num_induct) (simp_all add: numeral_inc)
    5.38  
    5.39 -lemma [code_abbrev]: "Numeral0 = (0\<Colon>code_numeral)"
    5.40 -  using zero_code_numeral_code ..
    5.41 +definition Num :: "num \<Rightarrow> code_numeral"
    5.42 +  where [simp, code_abbrev]: "Num = numeral"
    5.43 +
    5.44 +code_datatype "0::code_numeral" Num
    5.45  
    5.46  lemma one_code_numeral_code [code]:
    5.47    "(1\<Colon>code_numeral) = Numeral1"
    5.48 -  by (simp add: number_of_code_numeral_def Pls_def Bit1_def)
    5.49 +  by simp
    5.50  
    5.51  lemma [code_abbrev]: "Numeral1 = (1\<Colon>code_numeral)"
    5.52    using one_code_numeral_code ..
    5.53 @@ -194,15 +176,8 @@
    5.54    "of_nat n + of_nat m = of_nat (n + m)"
    5.55    by simp
    5.56  
    5.57 -definition subtract :: "code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral" where
    5.58 -  [simp]: "subtract = minus"
    5.59 -
    5.60 -lemma subtract_code [code nbe]:
    5.61 -  "subtract (of_nat n) (of_nat m) = of_nat (n - m)"
    5.62 -  by simp
    5.63 -
    5.64 -lemma minus_code_numeral_code [code]:
    5.65 -  "minus = subtract"
    5.66 +lemma minus_code_numeral_code [code nbe]:
    5.67 +  "of_nat n - of_nat m = of_nat (n - m)"
    5.68    by simp
    5.69  
    5.70  lemma times_code_numeral_code [code nbe]:
    5.71 @@ -281,7 +256,7 @@
    5.72  qed
    5.73  
    5.74  
    5.75 -hide_const (open) of_nat nat_of Suc subtract int_of
    5.76 +hide_const (open) of_nat nat_of Suc int_of
    5.77  
    5.78  
    5.79  subsection {* Code generator setup *}
    5.80 @@ -298,15 +273,21 @@
    5.81    (Haskell -)
    5.82  
    5.83  setup {*
    5.84 -  Numeral.add_code @{const_name number_code_numeral_inst.number_of_code_numeral}
    5.85 +  Numeral.add_code @{const_name Num}
    5.86      false Code_Printer.literal_naive_numeral "SML"
    5.87 -  #> fold (Numeral.add_code @{const_name number_code_numeral_inst.number_of_code_numeral}
    5.88 +  #> fold (Numeral.add_code @{const_name Num}
    5.89      false Code_Printer.literal_numeral) ["OCaml", "Haskell", "Scala"]
    5.90  *}
    5.91  
    5.92  code_reserved SML Int int
    5.93  code_reserved Eval Integer
    5.94  
    5.95 +code_const "0::code_numeral"
    5.96 +  (SML "0")
    5.97 +  (OCaml "Big'_int.zero'_big'_int")
    5.98 +  (Haskell "0")
    5.99 +  (Scala "BigInt(0)")
   5.100 +
   5.101  code_const "plus \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral"
   5.102    (SML "Int.+/ ((_),/ (_))")
   5.103    (OCaml "Big'_int.add'_big'_int")
   5.104 @@ -314,12 +295,12 @@
   5.105    (Scala infixl 7 "+")
   5.106    (Eval infixl 8 "+")
   5.107  
   5.108 -code_const "Code_Numeral.subtract \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral"
   5.109 -  (SML "Int.max/ (_/ -/ _,/ 0 : int)")
   5.110 -  (OCaml "Big'_int.max'_big'_int/ (Big'_int.sub'_big'_int/ _/ _)/ Big'_int.zero'_big'_int")
   5.111 -  (Haskell "max/ (_/ -/ _)/ (0 :: Integer)")
   5.112 +code_const "minus \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral"
   5.113 +  (SML "Int.max/ (0 : int,/ Int.-/ ((_),/ (_)))")
   5.114 +  (OCaml "Big'_int.max'_big'_int/ Big'_int.zero'_big'_int/ (Big'_int.sub'_big'_int/ _/ _)")
   5.115 +  (Haskell "max/ (0 :: Integer)/ (_/ -/ _)")
   5.116    (Scala "!(_/ -/ _).max(0)")
   5.117 -  (Eval "Integer.max/ (_/ -/ _)/ 0")
   5.118 +  (Eval "Integer.max/ 0/ (_/ -/ _)")
   5.119  
   5.120  code_const "times \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral"
   5.121    (SML "Int.*/ ((_),/ (_))")
     6.1 --- a/src/HOL/Codegenerator_Test/Generate_Pretty.thy	Sat Mar 24 16:27:04 2012 +0100
     6.2 +++ b/src/HOL/Codegenerator_Test/Generate_Pretty.thy	Sun Mar 25 20:15:39 2012 +0200
     6.3 @@ -10,9 +10,8 @@
     6.4  lemma [code, code del]: "nat_of_char = nat_of_char" ..
     6.5  lemma [code, code del]: "char_of_nat = char_of_nat" ..
     6.6  
     6.7 -declare Quickcheck_Narrowing.zero_code_int_code[code del]
     6.8 -declare Quickcheck_Narrowing.one_code_int_code[code del]
     6.9 -declare Quickcheck_Narrowing.int_of_code[code del]
    6.10 +declare Quickcheck_Narrowing.one_code_int_code [code del]
    6.11 +declare Quickcheck_Narrowing.int_of_code [code del]
    6.12  
    6.13  subsection {* Check whether generated code compiles *}
    6.14  
     7.1 --- a/src/HOL/Complex.thy	Sat Mar 24 16:27:04 2012 +0100
     7.2 +++ b/src/HOL/Complex.thy	Sun Mar 25 20:15:39 2012 +0200
     7.3 @@ -151,17 +151,6 @@
     7.4  
     7.5  subsection {* Numerals and Arithmetic *}
     7.6  
     7.7 -instantiation complex :: number_ring
     7.8 -begin
     7.9 -
    7.10 -definition complex_number_of_def:
    7.11 -  "number_of w = (of_int w \<Colon> complex)"
    7.12 -
    7.13 -instance
    7.14 -  by intro_classes (simp only: complex_number_of_def)
    7.15 -
    7.16 -end
    7.17 -
    7.18  lemma complex_Re_of_nat [simp]: "Re (of_nat n) = of_nat n"
    7.19    by (induct n) simp_all
    7.20  
    7.21 @@ -174,14 +163,24 @@
    7.22  lemma complex_Im_of_int [simp]: "Im (of_int z) = 0"
    7.23    by (cases z rule: int_diff_cases) simp
    7.24  
    7.25 -lemma complex_Re_number_of [simp]: "Re (number_of v) = number_of v"
    7.26 -  unfolding number_of_eq by (rule complex_Re_of_int)
    7.27 +lemma complex_Re_numeral [simp]: "Re (numeral v) = numeral v"
    7.28 +  using complex_Re_of_int [of "numeral v"] by simp
    7.29 +
    7.30 +lemma complex_Re_neg_numeral [simp]: "Re (neg_numeral v) = neg_numeral v"
    7.31 +  using complex_Re_of_int [of "neg_numeral v"] by simp
    7.32 +
    7.33 +lemma complex_Im_numeral [simp]: "Im (numeral v) = 0"
    7.34 +  using complex_Im_of_int [of "numeral v"] by simp
    7.35  
    7.36 -lemma complex_Im_number_of [simp]: "Im (number_of v) = 0"
    7.37 -  unfolding number_of_eq by (rule complex_Im_of_int)
    7.38 +lemma complex_Im_neg_numeral [simp]: "Im (neg_numeral v) = 0"
    7.39 +  using complex_Im_of_int [of "neg_numeral v"] by simp
    7.40  
    7.41 -lemma Complex_eq_number_of [simp]:
    7.42 -  "(Complex a b = number_of w) = (a = number_of w \<and> b = 0)"
    7.43 +lemma Complex_eq_numeral [simp]:
    7.44 +  "(Complex a b = numeral w) = (a = numeral w \<and> b = 0)"
    7.45 +  by (simp add: complex_eq_iff)
    7.46 +
    7.47 +lemma Complex_eq_neg_numeral [simp]:
    7.48 +  "(Complex a b = neg_numeral w) = (a = neg_numeral w \<and> b = 0)"
    7.49    by (simp add: complex_eq_iff)
    7.50  
    7.51  
    7.52 @@ -421,7 +420,10 @@
    7.53  lemma complex_i_not_one [simp]: "ii \<noteq> 1"
    7.54    by (simp add: complex_eq_iff)
    7.55  
    7.56 -lemma complex_i_not_number_of [simp]: "ii \<noteq> number_of w"
    7.57 +lemma complex_i_not_numeral [simp]: "ii \<noteq> numeral w"
    7.58 +  by (simp add: complex_eq_iff)
    7.59 +
    7.60 +lemma complex_i_not_neg_numeral [simp]: "ii \<noteq> neg_numeral w"
    7.61    by (simp add: complex_eq_iff)
    7.62  
    7.63  lemma i_mult_Complex [simp]: "ii * Complex a b = Complex (- b) a"
    7.64 @@ -505,7 +507,10 @@
    7.65  lemma complex_cnj_of_int [simp]: "cnj (of_int z) = of_int z"
    7.66    by (simp add: complex_eq_iff)
    7.67  
    7.68 -lemma complex_cnj_number_of [simp]: "cnj (number_of w) = number_of w"
    7.69 +lemma complex_cnj_numeral [simp]: "cnj (numeral w) = numeral w"
    7.70 +  by (simp add: complex_eq_iff)
    7.71 +
    7.72 +lemma complex_cnj_neg_numeral [simp]: "cnj (neg_numeral w) = neg_numeral w"
    7.73    by (simp add: complex_eq_iff)
    7.74  
    7.75  lemma complex_cnj_scaleR: "cnj (scaleR r x) = scaleR r (cnj x)"
    7.76 @@ -686,10 +691,10 @@
    7.77    "(of_nat n :: 'a::linordered_idom) < of_int x \<longleftrightarrow> int n < x"
    7.78    by (metis of_int_of_nat_eq of_int_less_iff)
    7.79  
    7.80 -lemma real_of_nat_less_number_of_iff [simp]: (* TODO: move *)
    7.81 -  "real (n::nat) < number_of w \<longleftrightarrow> n < number_of w"
    7.82 -  unfolding real_of_nat_def nat_number_of_def number_of_eq
    7.83 -  by (simp add: of_nat_less_of_int_iff zless_nat_eq_int_zless)
    7.84 +lemma real_of_nat_less_numeral_iff [simp]: (* TODO: move *)
    7.85 +  "real (n::nat) < numeral w \<longleftrightarrow> n < numeral w"
    7.86 +  using of_nat_less_of_int_iff [of n "numeral w", where 'a=real]
    7.87 +  by (simp add: real_of_nat_def zless_nat_eq_int_zless [symmetric])
    7.88  
    7.89  lemma arg_unique:
    7.90    assumes "sgn z = cis x" and "-pi < x" and "x \<le> pi"
     8.1 --- a/src/HOL/Decision_Procs/Approximation.thy	Sat Mar 24 16:27:04 2012 +0100
     8.2 +++ b/src/HOL/Decision_Procs/Approximation.thy	Sun Mar 25 20:15:39 2012 +0200
     8.3 @@ -1350,7 +1350,7 @@
     8.4        also have "\<dots> \<le> cos ((?ux - 2 * ?lpi))"
     8.5          using cos_monotone_minus_pi_0'[OF pi_x x_le_ux ux_0]
     8.6          by (simp only: real_of_float_minus real_of_int_minus real_of_one
     8.7 -            number_of_Min diff_minus mult_minus_left mult_1_left)
     8.8 +            minus_one [symmetric] diff_minus mult_minus_left mult_1_left)
     8.9        also have "\<dots> = cos ((- (?ux - 2 * ?lpi)))"
    8.10          unfolding real_of_float_minus cos_minus ..
    8.11        also have "\<dots> \<le> (ub_cos prec (- (?ux - 2 * ?lpi)))"
    8.12 @@ -1394,7 +1394,7 @@
    8.13        also have "\<dots> \<le> cos ((?lx + 2 * ?lpi))"
    8.14          using cos_monotone_0_pi'[OF lx_0 lx_le_x pi_x]
    8.15          by (simp only: real_of_float_minus real_of_int_minus real_of_one
    8.16 -          number_of_Min diff_minus mult_minus_left mult_1_left)
    8.17 +          minus_one [symmetric] diff_minus mult_minus_left mult_1_left)
    8.18        also have "\<dots> \<le> (ub_cos prec (?lx + 2 * ?lpi))"
    8.19          using lb_cos[OF lx_0 pi_lx] by simp
    8.20        finally show ?thesis unfolding u by (simp add: real_of_float_max)
    8.21 @@ -2117,7 +2117,8 @@
    8.22  lemma interpret_floatarith_num:
    8.23    shows "interpret_floatarith (Num (Float 0 0)) vs = 0"
    8.24    and "interpret_floatarith (Num (Float 1 0)) vs = 1"
    8.25 -  and "interpret_floatarith (Num (Float (number_of a) 0)) vs = number_of a" by auto
    8.26 +  and "interpret_floatarith (Num (Float (numeral a) 0)) vs = numeral a"
    8.27 +  and "interpret_floatarith (Num (Float (neg_numeral a) 0)) vs = neg_numeral a" by auto
    8.28  
    8.29  subsection "Implement approximation function"
    8.30  
     9.1 --- a/src/HOL/Decision_Procs/Cooper.thy	Sat Mar 24 16:27:04 2012 +0100
     9.2 +++ b/src/HOL/Decision_Procs/Cooper.thy	Sun Mar 25 20:15:39 2012 +0200
     9.3 @@ -1883,7 +1883,8 @@
     9.4        | SOME n => @{code Bound} n)
     9.5    | num_of_term vs @{term "0::int"} = @{code C} 0
     9.6    | num_of_term vs @{term "1::int"} = @{code C} 1
     9.7 -  | num_of_term vs (@{term "number_of :: int \<Rightarrow> int"} $ t) = @{code C} (HOLogic.dest_numeral t)
     9.8 +  | num_of_term vs (@{term "numeral :: _ \<Rightarrow> int"} $ t) = @{code C} (HOLogic.dest_num t)
     9.9 +  | num_of_term vs (@{term "neg_numeral :: _ \<Rightarrow> int"} $ t) = @{code C} (~(HOLogic.dest_num t))
    9.10    | num_of_term vs (Bound i) = @{code Bound} i
    9.11    | num_of_term vs (@{term "uminus :: int \<Rightarrow> int"} $ t') = @{code Neg} (num_of_term vs t')
    9.12    | num_of_term vs (@{term "op + :: int \<Rightarrow> int \<Rightarrow> int"} $ t1 $ t2) =
    10.1 --- a/src/HOL/Decision_Procs/Dense_Linear_Order.thy	Sat Mar 24 16:27:04 2012 +0100
    10.2 +++ b/src/HOL/Decision_Procs/Dense_Linear_Order.thy	Sun Mar 25 20:15:39 2012 +0200
    10.3 @@ -636,14 +636,8 @@
    10.4  
    10.5  interpretation class_dense_linordered_field: constr_dense_linorder
    10.6   "op <=" "op <"
    10.7 -   "\<lambda> x y. 1/2 * ((x::'a::{linordered_field,number_ring}) + y)"
    10.8 -proof (unfold_locales, dlo, dlo, auto)
    10.9 -  fix x y::'a assume lt: "x < y"
   10.10 -  from  less_half_sum[OF lt] show "x < (x + y) /2" by simp
   10.11 -next
   10.12 -  fix x y::'a assume lt: "x < y"
   10.13 -  from  gt_half_sum[OF lt] show "(x + y) /2 < y" by simp
   10.14 -qed
   10.15 +   "\<lambda> x y. 1/2 * ((x::'a::{linordered_field}) + y)"
   10.16 +by (unfold_locales, dlo, dlo, auto)
   10.17  
   10.18  declaration{*
   10.19  let
    11.1 --- a/src/HOL/Decision_Procs/Ferrack.thy	Sat Mar 24 16:27:04 2012 +0100
    11.2 +++ b/src/HOL/Decision_Procs/Ferrack.thy	Sun Mar 25 20:15:39 2012 +0200
    11.3 @@ -1732,7 +1732,7 @@
    11.4           (set U \<times> set U)"using mnz nnz th  
    11.5      apply (auto simp add: th add_divide_distrib algebra_simps split_def image_def)
    11.6      by (rule_tac x="(s,m)" in bexI,simp_all) 
    11.7 -  (rule_tac x="(t,n)" in bexI,simp_all)
    11.8 +  (rule_tac x="(t,n)" in bexI,simp_all add: mult_commute)
    11.9  next
   11.10    fix t n s m
   11.11    assume tnU: "(t,n) \<in> set U" and smU:"(s,m) \<in> set U" 
   11.12 @@ -1937,11 +1937,12 @@
   11.13    | num_of_term vs (@{term "op * :: real \<Rightarrow> real \<Rightarrow> real"} $ t1 $ t2) = (case num_of_term vs t1
   11.14       of @{code C} i => @{code Mul} (i, num_of_term vs t2)
   11.15        | _ => error "num_of_term: unsupported multiplication")
   11.16 -  | num_of_term vs (@{term "real :: int \<Rightarrow> real"} $ (@{term "number_of :: int \<Rightarrow> int"} $ t')) =
   11.17 -     @{code C} (HOLogic.dest_numeral t')
   11.18 -  | num_of_term vs (@{term "number_of :: int \<Rightarrow> real"} $ t') =
   11.19 -     @{code C} (HOLogic.dest_numeral t')
   11.20 -  | num_of_term vs t = error ("num_of_term: unknown term");
   11.21 +  | num_of_term vs (@{term "real :: int \<Rightarrow> real"} $ t') =
   11.22 +     (@{code C} (snd (HOLogic.dest_number t'))
   11.23 +       handle TERM _ => error ("num_of_term: unknown term"))
   11.24 +  | num_of_term vs t' =
   11.25 +     (@{code C} (snd (HOLogic.dest_number t'))
   11.26 +       handle TERM _ => error ("num_of_term: unknown term"));
   11.27  
   11.28  fun fm_of_term vs @{term True} = @{code T}
   11.29    | fm_of_term vs @{term False} = @{code F}
    12.1 --- a/src/HOL/Decision_Procs/MIR.thy	Sat Mar 24 16:27:04 2012 +0100
    12.2 +++ b/src/HOL/Decision_Procs/MIR.thy	Sun Mar 25 20:15:39 2012 +0200
    12.3 @@ -4901,7 +4901,7 @@
    12.4           (set U \<times> set U)"using mnz nnz th  
    12.5      apply (auto simp add: th add_divide_distrib algebra_simps split_def image_def)
    12.6      by (rule_tac x="(s,m)" in bexI,simp_all) 
    12.7 -  (rule_tac x="(t,n)" in bexI,simp_all)
    12.8 +  (rule_tac x="(t,n)" in bexI,simp_all add: mult_commute)
    12.9  next
   12.10    fix t n s m
   12.11    assume tnU: "(t,n) \<in> set U" and smU:"(s,m) \<in> set U" 
   12.12 @@ -5536,14 +5536,18 @@
   12.13        (case (num_of_term vs t1)
   12.14         of @{code C} i => @{code Mul} (i, num_of_term vs t2)
   12.15          | _ => error "num_of_term: unsupported Multiplication")
   12.16 -  | num_of_term vs (@{term "real :: int \<Rightarrow> real"} $ (@{term "number_of :: int \<Rightarrow> int"} $ t')) =
   12.17 -      @{code C} (HOLogic.dest_numeral t')
   12.18 +  | num_of_term vs (@{term "real :: int \<Rightarrow> real"} $ (@{term "numeral :: _ \<Rightarrow> int"} $ t')) =
   12.19 +      @{code C} (HOLogic.dest_num t')
   12.20 +  | num_of_term vs (@{term "real :: int \<Rightarrow> real"} $ (@{term "neg_numeral :: _ \<Rightarrow> int"} $ t')) =
   12.21 +      @{code C} (~ (HOLogic.dest_num t'))
   12.22    | num_of_term vs (@{term "real :: int \<Rightarrow> real"} $ (@{term "floor :: real \<Rightarrow> int"} $ t')) =
   12.23        @{code Floor} (num_of_term vs t')
   12.24    | num_of_term vs (@{term "real :: int \<Rightarrow> real"} $ (@{term "ceiling :: real \<Rightarrow> int"} $ t')) =
   12.25        @{code Neg} (@{code Floor} (@{code Neg} (num_of_term vs t')))
   12.26 -  | num_of_term vs (@{term "number_of :: int \<Rightarrow> real"} $ t') =
   12.27 -      @{code C} (HOLogic.dest_numeral t')
   12.28 +  | num_of_term vs (@{term "numeral :: _ \<Rightarrow> real"} $ t') =
   12.29 +      @{code C} (HOLogic.dest_num t')
   12.30 +  | num_of_term vs (@{term "neg_numeral :: _ \<Rightarrow> real"} $ t') =
   12.31 +      @{code C} (~ (HOLogic.dest_num t'))
   12.32    | num_of_term vs t = error ("num_of_term: unknown term " ^ Syntax.string_of_term @{context} t);
   12.33  
   12.34  fun fm_of_term vs @{term True} = @{code T}
   12.35 @@ -5554,8 +5558,10 @@
   12.36        @{code Le} (@{code Sub} (num_of_term vs t1, num_of_term vs t2))
   12.37    | fm_of_term vs (@{term "op = :: real \<Rightarrow> real \<Rightarrow> bool"} $ t1 $ t2) =
   12.38        @{code Eq} (@{code Sub} (num_of_term vs t1, num_of_term vs t2)) 
   12.39 -  | fm_of_term vs (@{term "op rdvd"} $ (@{term "real :: int \<Rightarrow> real"} $ (@{term "number_of :: int \<Rightarrow> int"} $ t1)) $ t2) =
   12.40 -      @{code Dvd} (HOLogic.dest_numeral t1, num_of_term vs t2)
   12.41 +  | fm_of_term vs (@{term "op rdvd"} $ (@{term "real :: int \<Rightarrow> real"} $ (@{term "numeral :: _ \<Rightarrow> int"} $ t1)) $ t2) =
   12.42 +      @{code Dvd} (HOLogic.dest_num t1, num_of_term vs t2)
   12.43 +  | fm_of_term vs (@{term "op rdvd"} $ (@{term "real :: int \<Rightarrow> real"} $ (@{term "neg_numeral :: _ \<Rightarrow> int"} $ t1)) $ t2) =
   12.44 +      @{code Dvd} (~ (HOLogic.dest_num t1), num_of_term vs t2)
   12.45    | fm_of_term vs (@{term "op = :: bool \<Rightarrow> bool \<Rightarrow> bool"} $ t1 $ t2) =
   12.46        @{code Iff} (fm_of_term vs t1, fm_of_term vs t2)
   12.47    | fm_of_term vs (@{term HOL.conj} $ t1 $ t2) =
    13.1 --- a/src/HOL/Decision_Procs/Parametric_Ferrante_Rackoff.thy	Sat Mar 24 16:27:04 2012 +0100
    13.2 +++ b/src/HOL/Decision_Procs/Parametric_Ferrante_Rackoff.thy	Sun Mar 25 20:15:39 2012 +0200
    13.3 @@ -25,7 +25,7 @@
    13.4  | "tmsize (CNP n c a) = 3 + polysize c + tmsize a "
    13.5  
    13.6    (* Semantics of terms tm *)
    13.7 -primrec Itm :: "'a::{field_char_0, field_inverse_zero, number_ring} list \<Rightarrow> 'a list \<Rightarrow> tm \<Rightarrow> 'a" where
    13.8 +primrec Itm :: "'a::{field_char_0, field_inverse_zero} list \<Rightarrow> 'a list \<Rightarrow> tm \<Rightarrow> 'a" where
    13.9    "Itm vs bs (CP c) = (Ipoly vs c)"
   13.10  | "Itm vs bs (Bound n) = bs!n"
   13.11  | "Itm vs bs (Neg a) = -(Itm vs bs a)"
   13.12 @@ -430,7 +430,7 @@
   13.13  by (induct p rule: fmsize.induct) simp_all
   13.14  
   13.15    (* Semantics of formulae (fm) *)
   13.16 -primrec Ifm ::"'a::{linordered_field_inverse_zero, number_ring} list \<Rightarrow> 'a list \<Rightarrow> fm \<Rightarrow> bool" where
   13.17 +primrec Ifm ::"'a::{linordered_field_inverse_zero} list \<Rightarrow> 'a list \<Rightarrow> fm \<Rightarrow> bool" where
   13.18    "Ifm vs bs T = True"
   13.19  | "Ifm vs bs F = False"
   13.20  | "Ifm vs bs (Lt a) = (Itm vs bs a < 0)"
   13.21 @@ -1937,7 +1937,7 @@
   13.22      
   13.23      also have "\<dots> \<longleftrightarrow> - (?a * ?s) + 2*?d*?r = 0" using d by simp 
   13.24      finally have ?thesis using c d 
   13.25 -      by (simp add: r[of "- (Itm vs (x # bs) s / (2 * \<lparr>d\<rparr>\<^sub>p\<^bsup>vs\<^esup>))"] msubsteq_def Let_def evaldjf_ex del: one_add_one_is_two)
   13.26 +      by (simp add: r[of "- (Itm vs (x # bs) s / (2 * \<lparr>d\<rparr>\<^sub>p\<^bsup>vs\<^esup>))"] msubsteq_def Let_def evaldjf_ex)
   13.27    }
   13.28    moreover
   13.29    {assume c: "?c \<noteq> 0" and d: "?d=0"
   13.30 @@ -1950,7 +1950,7 @@
   13.31        by (simp add: field_simps right_distrib[of "2*?c"] del: right_distrib)
   13.32      also have "\<dots> \<longleftrightarrow> - (?a * ?t) + 2*?c*?r = 0" using c by simp 
   13.33      finally have ?thesis using c d 
   13.34 -      by (simp add: r[of "- (?t/ (2*?c))"] msubsteq_def Let_def evaldjf_ex del: one_add_one_is_two)
   13.35 +      by (simp add: r[of "- (?t/ (2*?c))"] msubsteq_def Let_def evaldjf_ex)
   13.36    }
   13.37    moreover
   13.38    {assume c: "?c \<noteq> 0" and d: "?d\<noteq>0" hence dc: "?c * ?d *2 \<noteq> 0" by simp
   13.39 @@ -2019,7 +2019,7 @@
   13.40      
   13.41      also have "\<dots> \<longleftrightarrow> - (?a * ?s) + 2*?d*?r \<noteq> 0" using d by simp 
   13.42      finally have ?thesis using c d 
   13.43 -      by (simp add: r[of "- (Itm vs (x # bs) s / (2 * \<lparr>d\<rparr>\<^sub>p\<^bsup>vs\<^esup>))"] msubstneq_def Let_def evaldjf_ex del: one_add_one_is_two)
   13.44 +      by (simp add: r[of "- (Itm vs (x # bs) s / (2 * \<lparr>d\<rparr>\<^sub>p\<^bsup>vs\<^esup>))"] msubstneq_def Let_def evaldjf_ex)
   13.45    }
   13.46    moreover
   13.47    {assume c: "?c \<noteq> 0" and d: "?d=0"
   13.48 @@ -2032,7 +2032,7 @@
   13.49        by (simp add: field_simps right_distrib[of "2*?c"] del: right_distrib)
   13.50      also have "\<dots> \<longleftrightarrow> - (?a * ?t) + 2*?c*?r \<noteq> 0" using c by simp 
   13.51      finally have ?thesis using c d 
   13.52 -      by (simp add: r[of "- (?t/ (2*?c))"] msubstneq_def Let_def evaldjf_ex del: one_add_one_is_two)
   13.53 +      by (simp add: r[of "- (?t/ (2*?c))"] msubstneq_def Let_def evaldjf_ex)
   13.54    }
   13.55    moreover
   13.56    {assume c: "?c \<noteq> 0" and d: "?d\<noteq>0" hence dc: "?c * ?d *2 \<noteq> 0" by simp
   13.57 @@ -2616,10 +2616,10 @@
   13.58  using lp tnb
   13.59  by (simp add: msubst2_def msubstneg_nb msubstpos_nb conj_nb disj_nb lt_nb simpfm_bound0)
   13.60  
   13.61 -lemma mult_minus2_left: "-2 * (x::'a::number_ring) = - (2 * x)"
   13.62 +lemma mult_minus2_left: "-2 * (x::'a::comm_ring_1) = - (2 * x)"
   13.63    by simp
   13.64  
   13.65 -lemma mult_minus2_right: "(x::'a::number_ring) * -2 = - (x * 2)"
   13.66 +lemma mult_minus2_right: "(x::'a::comm_ring_1) * -2 = - (x * 2)"
   13.67    by simp
   13.68  
   13.69  lemma islin_qf: "islin p \<Longrightarrow> qfree p"
   13.70 @@ -3005,11 +3005,11 @@
   13.71  *} "parametric QE for linear Arithmetic over fields, Version 2"
   13.72  
   13.73  
   13.74 -lemma "\<exists>(x::'a::{linordered_field_inverse_zero, number_ring}). y \<noteq> -1 \<longrightarrow> (y + 1)*x < 0"
   13.75 -  apply (frpar type: "'a::{linordered_field_inverse_zero, number_ring}" pars: "y::'a::{linordered_field_inverse_zero, number_ring}")
   13.76 +lemma "\<exists>(x::'a::{linordered_field_inverse_zero}). y \<noteq> -1 \<longrightarrow> (y + 1)*x < 0"
   13.77 +  apply (frpar type: "'a::{linordered_field_inverse_zero}" pars: "y::'a::{linordered_field_inverse_zero}")
   13.78    apply (simp add: field_simps)
   13.79    apply (rule spec[where x=y])
   13.80 -  apply (frpar type: "'a::{linordered_field_inverse_zero, number_ring}" pars: "z::'a::{linordered_field_inverse_zero, number_ring}")
   13.81 +  apply (frpar type: "'a::{linordered_field_inverse_zero}" pars: "z::'a::{linordered_field_inverse_zero}")
   13.82    by simp
   13.83  
   13.84  text{* Collins/Jones Problem *}
   13.85 @@ -3030,11 +3030,11 @@
   13.86  oops
   13.87  *)
   13.88  
   13.89 -lemma "\<exists>(x::'a::{linordered_field_inverse_zero, number_ring}). y \<noteq> -1 \<longrightarrow> (y + 1)*x < 0"
   13.90 -  apply (frpar2 type: "'a::{linordered_field_inverse_zero, number_ring}" pars: "y::'a::{linordered_field_inverse_zero, number_ring}")
   13.91 +lemma "\<exists>(x::'a::{linordered_field_inverse_zero}). y \<noteq> -1 \<longrightarrow> (y + 1)*x < 0"
   13.92 +  apply (frpar2 type: "'a::{linordered_field_inverse_zero}" pars: "y::'a::{linordered_field_inverse_zero}")
   13.93    apply (simp add: field_simps)
   13.94    apply (rule spec[where x=y])
   13.95 -  apply (frpar2 type: "'a::{linordered_field_inverse_zero, number_ring}" pars: "z::'a::{linordered_field_inverse_zero, number_ring}")
   13.96 +  apply (frpar2 type: "'a::{linordered_field_inverse_zero}" pars: "z::'a::{linordered_field_inverse_zero}")
   13.97    by simp
   13.98  
   13.99  text{* Collins/Jones Problem *}
    14.1 --- a/src/HOL/Decision_Procs/cooper_tac.ML	Sat Mar 24 16:27:04 2012 +0100
    14.2 +++ b/src/HOL/Decision_Procs/cooper_tac.ML	Sun Mar 25 20:15:39 2012 +0200
    14.3 @@ -18,15 +18,12 @@
    14.4  val cooper_ss = @{simpset};
    14.5  
    14.6  val nT = HOLogic.natT;
    14.7 -val binarith = @{thms normalize_bin_simps};
    14.8 -val comp_arith = binarith @ @{thms simp_thms};
    14.9 +val comp_arith = @{thms simp_thms}
   14.10  
   14.11  val zdvd_int = @{thm zdvd_int};
   14.12  val zdiff_int_split = @{thm zdiff_int_split};
   14.13  val all_nat = @{thm all_nat};
   14.14  val ex_nat = @{thm ex_nat};
   14.15 -val number_of1 = @{thm number_of1};
   14.16 -val number_of2 = @{thm number_of2};
   14.17  val split_zdiv = @{thm split_zdiv};
   14.18  val split_zmod = @{thm split_zmod};
   14.19  val mod_div_equality' = @{thm mod_div_equality'};
   14.20 @@ -90,14 +87,13 @@
   14.21            [split_zdiv, split_zmod, split_div', @{thm "split_min"}, @{thm "split_max"}]
   14.22      (* Simp rules for changing (n::int) to int n *)
   14.23      val simpset1 = HOL_basic_ss
   14.24 -      addsimps [@{thm nat_number_of_def}, zdvd_int] @ map (fn r => r RS sym)
   14.25 -        [@{thm int_int_eq}, @{thm zle_int}, @{thm zless_int}, @{thm zadd_int}, @{thm zmult_int}]
   14.26 +      addsimps [zdvd_int] @ map (fn r => r RS sym)
   14.27 +        [@{thm int_numeral}, @{thm int_int_eq}, @{thm zle_int}, @{thm zless_int}, @{thm zadd_int}, @{thm zmult_int}]
   14.28        |> Splitter.add_split zdiff_int_split
   14.29      (*simp rules for elimination of int n*)
   14.30  
   14.31      val simpset2 = HOL_basic_ss
   14.32 -      addsimps [@{thm nat_0_le}, @{thm all_nat}, @{thm ex_nat},
   14.33 -        @{thm number_of1}, @{thm number_of2}, @{thm int_0}, @{thm int_1}]
   14.34 +      addsimps [@{thm nat_0_le}, @{thm all_nat}, @{thm ex_nat}, @{thm zero_le_numeral}, @{thm order_refl}(* FIXME: necessary? *), @{thm int_0}, @{thm int_1}]
   14.35        |> fold Simplifier.add_cong [@{thm conj_le_cong}, @{thm imp_le_cong}]
   14.36      (* simp rules for elimination of abs *)
   14.37      val simpset3 = HOL_basic_ss |> Splitter.add_split @{thm abs_split}
    15.1 --- a/src/HOL/Decision_Procs/ex/Dense_Linear_Order_Ex.thy	Sat Mar 24 16:27:04 2012 +0100
    15.2 +++ b/src/HOL/Decision_Procs/ex/Dense_Linear_Order_Ex.thy	Sun Mar 25 20:15:39 2012 +0200
    15.3 @@ -7,147 +7,147 @@
    15.4  begin
    15.5  
    15.6  lemma
    15.7 -  "\<exists>(y::'a::{linordered_field_inverse_zero, number_ring}) <2. x + 3* y < 0 \<and> x - y >0"
    15.8 +  "\<exists>(y::'a::{linordered_field_inverse_zero}) <2. x + 3* y < 0 \<and> x - y >0"
    15.9    by ferrack
   15.10  
   15.11 -lemma "~ (ALL x (y::'a::{linordered_field_inverse_zero, number_ring}). x < y --> 10*x < 11*y)"
   15.12 +lemma "~ (ALL x (y::'a::{linordered_field_inverse_zero}). x < y --> 10*x < 11*y)"
   15.13    by ferrack
   15.14  
   15.15 -lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}) y. x < y --> (10*(x + 5*y + -1) < 60*y)"
   15.16 +lemma "ALL (x::'a::{linordered_field_inverse_zero}) y. x < y --> (10*(x + 5*y + -1) < 60*y)"
   15.17    by ferrack
   15.18  
   15.19 -lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring}) y. x ~= y --> x < y"
   15.20 +lemma "EX (x::'a::{linordered_field_inverse_zero}) y. x ~= y --> x < y"
   15.21    by ferrack
   15.22  
   15.23 -lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring}) y. (x ~= y & 10*x ~= 9*y & 10*x < y) --> x < y"
   15.24 +lemma "EX (x::'a::{linordered_field_inverse_zero}) y. (x ~= y & 10*x ~= 9*y & 10*x < y) --> x < y"
   15.25    by ferrack
   15.26  
   15.27 -lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}) y. (x ~= y & 5*x <= y) --> 500*x <= 100*y"
   15.28 +lemma "ALL (x::'a::{linordered_field_inverse_zero}) y. (x ~= y & 5*x <= y) --> 500*x <= 100*y"
   15.29    by ferrack
   15.30  
   15.31 -lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}). (EX (y::'a::{linordered_field_inverse_zero, number_ring}). 4*x + 3*y <= 0 & 4*x + 3*y >= -1)"
   15.32 +lemma "ALL (x::'a::{linordered_field_inverse_zero}). (EX (y::'a::{linordered_field_inverse_zero}). 4*x + 3*y <= 0 & 4*x + 3*y >= -1)"
   15.33    by ferrack
   15.34  
   15.35 -lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}) < 0. (EX (y::'a::{linordered_field_inverse_zero, number_ring}) > 0. 7*x + y > 0 & x - y <= 9)"
   15.36 +lemma "ALL (x::'a::{linordered_field_inverse_zero}) < 0. (EX (y::'a::{linordered_field_inverse_zero}) > 0. 7*x + y > 0 & x - y <= 9)"
   15.37    by ferrack
   15.38  
   15.39 -lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring}). (0 < x & x < 1) --> (ALL y > 1. x + y ~= 1)"
   15.40 +lemma "EX (x::'a::{linordered_field_inverse_zero}). (0 < x & x < 1) --> (ALL y > 1. x + y ~= 1)"
   15.41    by ferrack
   15.42  
   15.43 -lemma "EX x. (ALL (y::'a::{linordered_field_inverse_zero, number_ring}). y < 2 -->  2*(y - x) \<le> 0 )"
   15.44 +lemma "EX x. (ALL (y::'a::{linordered_field_inverse_zero}). y < 2 -->  2*(y - x) \<le> 0 )"
   15.45    by ferrack
   15.46  
   15.47 -lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}). x < 10 | x > 20 | (EX y. y>= 0 & y <= 10 & x+y = 20)"
   15.48 +lemma "ALL (x::'a::{linordered_field_inverse_zero}). x < 10 | x > 20 | (EX y. y>= 0 & y <= 10 & x+y = 20)"
   15.49    by ferrack
   15.50  
   15.51 -lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}) y z. x + y < z --> y >= z --> x < 0"
   15.52 +lemma "ALL (x::'a::{linordered_field_inverse_zero}) y z. x + y < z --> y >= z --> x < 0"
   15.53    by ferrack
   15.54  
   15.55 -lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring}) y z. x + 7*y < 5* z & 5*y >= 7*z & x < 0"
   15.56 +lemma "EX (x::'a::{linordered_field_inverse_zero}) y z. x + 7*y < 5* z & 5*y >= 7*z & x < 0"
   15.57    by ferrack
   15.58  
   15.59 -lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}) y z. abs (x + y) <= z --> (abs z = z)"
   15.60 +lemma "ALL (x::'a::{linordered_field_inverse_zero}) y z. abs (x + y) <= z --> (abs z = z)"
   15.61    by ferrack
   15.62  
   15.63 -lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring}) y z. x + 7*y - 5* z < 0 & 5*y + 7*z + 3*x < 0"
   15.64 +lemma "EX (x::'a::{linordered_field_inverse_zero}) y z. x + 7*y - 5* z < 0 & 5*y + 7*z + 3*x < 0"
   15.65    by ferrack
   15.66  
   15.67 -lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}) y z. (abs (5*x+3*y+z) <= 5*x+3*y+z & abs (5*x+3*y+z) >= - (5*x+3*y+z)) | (abs (5*x+3*y+z) >= 5*x+3*y+z & abs (5*x+3*y+z) <= - (5*x+3*y+z))"
   15.68 +lemma "ALL (x::'a::{linordered_field_inverse_zero}) y z. (abs (5*x+3*y+z) <= 5*x+3*y+z & abs (5*x+3*y+z) >= - (5*x+3*y+z)) | (abs (5*x+3*y+z) >= 5*x+3*y+z & abs (5*x+3*y+z) <= - (5*x+3*y+z))"
   15.69    by ferrack
   15.70  
   15.71 -lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}) y. x < y --> (EX z>0. x+z = y)"
   15.72 +lemma "ALL (x::'a::{linordered_field_inverse_zero}) y. x < y --> (EX z>0. x+z = y)"
   15.73    by ferrack
   15.74  
   15.75 -lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}) y. x < y --> (EX z>0. x+z = y)"
   15.76 +lemma "ALL (x::'a::{linordered_field_inverse_zero}) y. x < y --> (EX z>0. x+z = y)"
   15.77    by ferrack
   15.78  
   15.79 -lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}) y. (EX z>0. abs (x - y) <= z )"
   15.80 +lemma "ALL (x::'a::{linordered_field_inverse_zero}) y. (EX z>0. abs (x - y) <= z )"
   15.81    by ferrack
   15.82  
   15.83 -lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring}) y. (ALL z<0. (z < x --> z <= y) & (z > y --> z >= x))"
   15.84 +lemma "EX (x::'a::{linordered_field_inverse_zero}) y. (ALL z<0. (z < x --> z <= y) & (z > y --> z >= x))"
   15.85    by ferrack
   15.86  
   15.87 -lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring}) y. (ALL z>=0. abs (3*x+7*y) <= 2*z + 1)"
   15.88 +lemma "EX (x::'a::{linordered_field_inverse_zero}) y. (ALL z>=0. abs (3*x+7*y) <= 2*z + 1)"
   15.89    by ferrack
   15.90  
   15.91 -lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring}) y. (ALL z<0. (z < x --> z <= y) & (z > y --> z >= x))"
   15.92 +lemma "EX (x::'a::{linordered_field_inverse_zero}) y. (ALL z<0. (z < x --> z <= y) & (z > y --> z >= x))"
   15.93    by ferrack
   15.94  
   15.95 -lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring})>0. (ALL y. (EX z. 13* abs z \<noteq> abs (12*y - x) & 5*x - 3*(abs y) <= 7*z))"
   15.96 +lemma "EX (x::'a::{linordered_field_inverse_zero})>0. (ALL y. (EX z. 13* abs z \<noteq> abs (12*y - x) & 5*x - 3*(abs y) <= 7*z))"
   15.97    by ferrack
   15.98  
   15.99 -lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring}). abs (4*x + 17) < 4 & (ALL y . abs (x*34 - 34*y - 9) \<noteq> 0 \<longrightarrow> (EX z. 5*x - 3*abs y <= 7*z))"
  15.100 +lemma "EX (x::'a::{linordered_field_inverse_zero}). abs (4*x + 17) < 4 & (ALL y . abs (x*34 - 34*y - 9) \<noteq> 0 \<longrightarrow> (EX z. 5*x - 3*abs y <= 7*z))"
  15.101    by ferrack
  15.102  
  15.103 -lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}). (EX y > abs (23*x - 9). (ALL z > abs (3*y - 19* abs x). x+z > 2*y))"
  15.104 +lemma "ALL (x::'a::{linordered_field_inverse_zero}). (EX y > abs (23*x - 9). (ALL z > abs (3*y - 19* abs x). x+z > 2*y))"
  15.105    by ferrack
  15.106  
  15.107 -lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}). (EX y< abs (3*x - 1). (ALL z >= (3*abs x - 1). abs (12*x - 13*y + 19*z) > abs (23*x) ))"
  15.108 +lemma "ALL (x::'a::{linordered_field_inverse_zero}). (EX y< abs (3*x - 1). (ALL z >= (3*abs x - 1). abs (12*x - 13*y + 19*z) > abs (23*x) ))"
  15.109    by ferrack
  15.110  
  15.111 -lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring}). abs x < 100 & (ALL y > x. (EX z<2*y - x. 5*x - 3*y <= 7*z))"
  15.112 +lemma "EX (x::'a::{linordered_field_inverse_zero}). abs x < 100 & (ALL y > x. (EX z<2*y - x. 5*x - 3*y <= 7*z))"
  15.113    by ferrack
  15.114  
  15.115 -lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}) y z w. 7*x<3*y --> 5*y < 7*z --> z < 2*w --> 7*(2*w-x) > 2*y"
  15.116 +lemma "ALL (x::'a::{linordered_field_inverse_zero}) y z w. 7*x<3*y --> 5*y < 7*z --> z < 2*w --> 7*(2*w-x) > 2*y"
  15.117    by ferrack
  15.118  
  15.119 -lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring}) y z w. 5*x + 3*z - 17*w + abs (y - 8*x + z) <= 89"
  15.120 +lemma "EX (x::'a::{linordered_field_inverse_zero}) y z w. 5*x + 3*z - 17*w + abs (y - 8*x + z) <= 89"
  15.121    by ferrack
  15.122  
  15.123 -lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring}) y z w. 5*x + 3*z - 17*w + 7* (y - 8*x + z) <= max y (7*z - x + w)"
  15.124 +lemma "EX (x::'a::{linordered_field_inverse_zero}) y z w. 5*x + 3*z - 17*w + 7* (y - 8*x + z) <= max y (7*z - x + w)"
  15.125    by ferrack
  15.126  
  15.127 -lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring}) y z w. min (5*x + 3*z) (17*w) + 5* abs (y - 8*x + z) <= max y (7*z - x + w)"
  15.128 +lemma "EX (x::'a::{linordered_field_inverse_zero}) y z w. min (5*x + 3*z) (17*w) + 5* abs (y - 8*x + z) <= max y (7*z - x + w)"
  15.129    by ferrack
  15.130  
  15.131 -lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}) y z. (EX w >= (x+y+z). w <= abs x + abs y + abs z)"
  15.132 +lemma "ALL (x::'a::{linordered_field_inverse_zero}) y z. (EX w >= (x+y+z). w <= abs x + abs y + abs z)"
  15.133    by ferrack
  15.134  
  15.135 -lemma "~(ALL (x::'a::{linordered_field_inverse_zero, number_ring}). (EX y z w. 3* x + z*4 = 3*y & x + y < z & x> w & 3*x < w + y))"
  15.136 +lemma "~(ALL (x::'a::{linordered_field_inverse_zero}). (EX y z w. 3* x + z*4 = 3*y & x + y < z & x> w & 3*x < w + y))"
  15.137    by ferrack
  15.138  
  15.139 -lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}) y. (EX z w. abs (x-y) = (z-w) & z*1234 < 233*x & w ~= y)"
  15.140 +lemma "ALL (x::'a::{linordered_field_inverse_zero}) y. (EX z w. abs (x-y) = (z-w) & z*1234 < 233*x & w ~= y)"
  15.141    by ferrack
  15.142  
  15.143 -lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}). (EX y z w. min (5*x + 3*z) (17*w) + 5* abs (y - 8*x + z) <= max y (7*z - x + w))"
  15.144 +lemma "ALL (x::'a::{linordered_field_inverse_zero}). (EX y z w. min (5*x + 3*z) (17*w) + 5* abs (y - 8*x + z) <= max y (7*z - x + w))"
  15.145    by ferrack
  15.146  
  15.147 -lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring}) y z. (ALL w >= abs (x+y+z). w >= abs x + abs y + abs z)"
  15.148 +lemma "EX (x::'a::{linordered_field_inverse_zero}) y z. (ALL w >= abs (x+y+z). w >= abs x + abs y + abs z)"
  15.149    by ferrack
  15.150  
  15.151 -lemma "EX z. (ALL (x::'a::{linordered_field_inverse_zero, number_ring}) y. (EX w >= (x+y+z). w <= abs x + abs y + abs z))"
  15.152 +lemma "EX z. (ALL (x::'a::{linordered_field_inverse_zero}) y. (EX w >= (x+y+z). w <= abs x + abs y + abs z))"
  15.153    by ferrack
  15.154  
  15.155 -lemma "EX z. (ALL (x::'a::{linordered_field_inverse_zero, number_ring}) < abs z. (EX y w. x< y & x < z & x> w & 3*x < w + y))"
  15.156 +lemma "EX z. (ALL (x::'a::{linordered_field_inverse_zero}) < abs z. (EX y w. x< y & x < z & x> w & 3*x < w + y))"
  15.157    by ferrack
  15.158  
  15.159 -lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}) y. (EX z. (ALL w. abs (x-y) = abs (z-w) --> z < x & w ~= y))"
  15.160 +lemma "ALL (x::'a::{linordered_field_inverse_zero}) y. (EX z. (ALL w. abs (x-y) = abs (z-w) --> z < x & w ~= y))"
  15.161    by ferrack
  15.162  
  15.163 -lemma "EX y. (ALL (x::'a::{linordered_field_inverse_zero, number_ring}). (EX z w. min (5*x + 3*z) (17*w) + 5* abs (y - 8*x + z) <= max y (7*z - x + w)))"
  15.164 +lemma "EX y. (ALL (x::'a::{linordered_field_inverse_zero}). (EX z w. min (5*x + 3*z) (17*w) + 5* abs (y - 8*x + z) <= max y (7*z - x + w)))"
  15.165    by ferrack
  15.166  
  15.167 -lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring}) z. (ALL w >= 13*x - 4*z. (EX y. w >= abs x + abs y + z))"
  15.168 +lemma "EX (x::'a::{linordered_field_inverse_zero}) z. (ALL w >= 13*x - 4*z. (EX y. w >= abs x + abs y + z))"
  15.169    by ferrack
  15.170  
  15.171 -lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring}). (ALL y < x. (EX z > (x+y).
  15.172 +lemma "EX (x::'a::{linordered_field_inverse_zero}). (ALL y < x. (EX z > (x+y).
  15.173    (ALL w. 5*w + 10*x - z >= y --> w + 7*x + 3*z >= 2*y)))"
  15.174    by ferrack
  15.175  
  15.176 -lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring}). (ALL y. (EX z > y.
  15.177 +lemma "EX (x::'a::{linordered_field_inverse_zero}). (ALL y. (EX z > y.
  15.178    (ALL w . w < 13 --> w + 10*x - z >= y --> 5*w + 7*x + 13*z >= 2*y)))"
  15.179    by ferrack
  15.180  
  15.181 -lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring}) y z w. min (5*x + 3*z) (17*w) + 5* abs (y - 8*x + z) <= max y (7*z - x + w)"
  15.182 +lemma "EX (x::'a::{linordered_field_inverse_zero}) y z w. min (5*x + 3*z) (17*w) + 5* abs (y - 8*x + z) <= max y (7*z - x + w)"
  15.183    by ferrack
  15.184  
  15.185 -lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}). (EX y. (ALL z>19. y <= x + z & (EX w. abs (y - x) < w)))"
  15.186 +lemma "ALL (x::'a::{linordered_field_inverse_zero}). (EX y. (ALL z>19. y <= x + z & (EX w. abs (y - x) < w)))"
  15.187    by ferrack
  15.188  
  15.189 -lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}). (EX y. (ALL z>19. y <= x + z & (EX w. abs (x + z) < w - y)))"
  15.190 +lemma "ALL (x::'a::{linordered_field_inverse_zero}). (EX y. (ALL z>19. y <= x + z & (EX w. abs (x + z) < w - y)))"
  15.191    by ferrack
  15.192  
  15.193 -lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}). (EX y. abs y ~= abs x & (ALL z> max x y. (EX w. w ~= y & w ~= z & 3*w - z >= x + y)))"
  15.194 +lemma "ALL (x::'a::{linordered_field_inverse_zero}). (EX y. abs y ~= abs x & (ALL z> max x y. (EX w. w ~= y & w ~= z & 3*w - z >= x + y)))"
  15.195    by ferrack
  15.196  
  15.197  end
    16.1 --- a/src/HOL/Decision_Procs/ferrack_tac.ML	Sat Mar 24 16:27:04 2012 +0100
    16.2 +++ b/src/HOL/Decision_Procs/ferrack_tac.ML	Sun Mar 25 20:15:39 2012 +0200
    16.3 @@ -20,17 +20,13 @@
    16.4               in @{simpset} delsimps ths addsimps (map (fn th => th RS sym) ths)
    16.5               end;
    16.6  
    16.7 -val binarith =
    16.8 -  @{thms normalize_bin_simps} @ @{thms pred_bin_simps} @ @{thms succ_bin_simps} @
    16.9 -  @{thms add_bin_simps} @ @{thms minus_bin_simps} @  @{thms mult_bin_simps};
   16.10 -val comp_arith = binarith @ @{thms simp_thms};
   16.11 +val binarith = @{thms arith_simps}
   16.12 +val comp_arith = binarith @ @{thms simp_thms}
   16.13  
   16.14  val zdvd_int = @{thm zdvd_int};
   16.15  val zdiff_int_split = @{thm zdiff_int_split};
   16.16  val all_nat = @{thm all_nat};
   16.17  val ex_nat = @{thm ex_nat};
   16.18 -val number_of1 = @{thm number_of1};
   16.19 -val number_of2 = @{thm number_of2};
   16.20  val split_zdiv = @{thm split_zdiv};
   16.21  val split_zmod = @{thm split_zmod};
   16.22  val mod_div_equality' = @{thm mod_div_equality'};
    17.1 --- a/src/HOL/Decision_Procs/mir_tac.ML	Sat Mar 24 16:27:04 2012 +0100
    17.2 +++ b/src/HOL/Decision_Procs/mir_tac.ML	Sun Mar 25 20:15:39 2012 +0200
    17.3 @@ -21,16 +21,15 @@
    17.4  end;
    17.5  
    17.6  val nT = HOLogic.natT;
    17.7 -  val nat_arith = [@{thm "add_nat_number_of"}, @{thm "diff_nat_number_of"},
    17.8 -                       @{thm "mult_nat_number_of"}, @{thm "eq_nat_number_of"}, @{thm "less_nat_number_of"}];
    17.9 +  val nat_arith = [@{thm diff_nat_numeral}];
   17.10  
   17.11    val comp_arith = [@{thm "Let_def"}, @{thm "if_False"}, @{thm "if_True"}, @{thm "add_0"},
   17.12 -                 @{thm "add_Suc"}, @{thm "add_number_of_left"}, @{thm "mult_number_of_left"},
   17.13 +                 @{thm "add_Suc"}, @{thm add_numeral_left}, @{thm mult_numeral_left(1)},
   17.14                   @{thm "Suc_eq_plus1"}] @
   17.15 -                 (map (fn th => th RS sym) [@{thm "numeral_1_eq_1"}, @{thm "numeral_0_eq_0"}])
   17.16 +                 (map (fn th => th RS sym) [@{thm "numeral_1_eq_1"}])
   17.17                   @ @{thms arith_simps} @ nat_arith @ @{thms rel_simps} 
   17.18    val ths = [@{thm "mult_numeral_1"}, @{thm "mult_numeral_1_right"}, 
   17.19 -             @{thm "real_of_nat_number_of"},
   17.20 +             @{thm real_of_nat_numeral},
   17.21               @{thm "real_of_nat_Suc"}, @{thm "real_of_nat_one"}, @{thm "real_of_one"},
   17.22               @{thm "real_of_int_zero"}, @{thm "real_of_nat_zero"},
   17.23               @{thm "divide_zero"}, 
   17.24 @@ -44,8 +43,6 @@
   17.25  val zdiff_int_split = @{thm "zdiff_int_split"};
   17.26  val all_nat = @{thm "all_nat"};
   17.27  val ex_nat = @{thm "ex_nat"};
   17.28 -val number_of1 = @{thm "number_of1"};
   17.29 -val number_of2 = @{thm "number_of2"};
   17.30  val split_zdiv = @{thm "split_zdiv"};
   17.31  val split_zmod = @{thm "split_zmod"};
   17.32  val mod_div_equality' = @{thm "mod_div_equality'"};
   17.33 @@ -113,15 +110,15 @@
   17.34              @{thm "split_min"}, @{thm "split_max"}]
   17.35      (* Simp rules for changing (n::int) to int n *)
   17.36      val simpset1 = HOL_basic_ss
   17.37 -      addsimps [@{thm "nat_number_of_def"}, @{thm "zdvd_int"}] @ map (fn r => r RS sym)
   17.38 +      addsimps [@{thm "zdvd_int"}] @ map (fn r => r RS sym)
   17.39          [@{thm "int_int_eq"}, @{thm "zle_int"}, @{thm "zless_int"}, @{thm "zadd_int"}, 
   17.40 -         @{thm "zmult_int"}]
   17.41 +         @{thm nat_numeral}, @{thm "zmult_int"}]
   17.42        |> Splitter.add_split @{thm "zdiff_int_split"}
   17.43      (*simp rules for elimination of int n*)
   17.44  
   17.45      val simpset2 = HOL_basic_ss
   17.46 -      addsimps [@{thm "nat_0_le"}, @{thm "all_nat"}, @{thm "ex_nat"}, @{thm "number_of1"}, 
   17.47 -                @{thm "number_of2"}, @{thm "int_0"}, @{thm "int_1"}]
   17.48 +      addsimps [@{thm "nat_0_le"}, @{thm "all_nat"}, @{thm "ex_nat"}, @{thm zero_le_numeral}, 
   17.49 +                @{thm "int_0"}, @{thm "int_1"}]
   17.50        |> fold Simplifier.add_cong [@{thm "conj_le_cong"}, @{thm "imp_le_cong"}]
   17.51      (* simp rules for elimination of abs *)
   17.52      val ct = cterm_of thy (HOLogic.mk_Trueprop t)
    18.1 --- a/src/HOL/Deriv.thy	Sat Mar 24 16:27:04 2012 +0100
    18.2 +++ b/src/HOL/Deriv.thy	Sun Mar 25 20:15:39 2012 +0200
    18.3 @@ -186,7 +186,6 @@
    18.4  apply (erule DERIV_mult')
    18.5  apply (erule (1) DERIV_inverse')
    18.6  apply (simp add: ring_distribs nonzero_inverse_mult_distrib)
    18.7 -apply (simp add: mult_ac)
    18.8  done
    18.9  
   18.10  lemma DERIV_power_Suc:
    19.1 --- a/src/HOL/Divides.thy	Sat Mar 24 16:27:04 2012 +0100
    19.2 +++ b/src/HOL/Divides.thy	Sun Mar 25 20:15:39 2012 +0200
    19.3 @@ -1138,8 +1138,8 @@
    19.4  lemma Suc_mod_eq_add3_mod: "(Suc (Suc (Suc m))) mod n = (3+m) mod n"
    19.5  by (simp add: Suc3_eq_add_3)
    19.6  
    19.7 -lemmas Suc_div_eq_add3_div_number_of [simp] = Suc_div_eq_add3_div [of _ "number_of v"] for v
    19.8 -lemmas Suc_mod_eq_add3_mod_number_of [simp] = Suc_mod_eq_add3_mod [of _ "number_of v"] for v
    19.9 +lemmas Suc_div_eq_add3_div_numeral [simp] = Suc_div_eq_add3_div [of _ "numeral v"] for v
   19.10 +lemmas Suc_mod_eq_add3_mod_numeral [simp] = Suc_mod_eq_add3_mod [of _ "numeral v"] for v
   19.11  
   19.12  
   19.13  lemma Suc_times_mod_eq: "1<k ==> Suc (k * m) mod k = 1" 
   19.14 @@ -1147,7 +1147,7 @@
   19.15  apply (simp_all add: mod_Suc)
   19.16  done
   19.17  
   19.18 -declare Suc_times_mod_eq [of "number_of w", simp] for w
   19.19 +declare Suc_times_mod_eq [of "numeral w", simp] for w
   19.20  
   19.21  lemma [simp]: "n div k \<le> (Suc n) div k"
   19.22  by (simp add: div_le_mono) 
   19.23 @@ -1177,17 +1177,22 @@
   19.24  apply (subst mod_Suc [of "m mod n"], simp) 
   19.25  done
   19.26  
   19.27 +lemma mod_2_not_eq_zero_eq_one_nat:
   19.28 +  fixes n :: nat
   19.29 +  shows "n mod 2 \<noteq> 0 \<longleftrightarrow> n mod 2 = 1"
   19.30 +  by simp
   19.31 +
   19.32  
   19.33  subsection {* Division on @{typ int} *}
   19.34  
   19.35  definition divmod_int_rel :: "int \<Rightarrow> int \<Rightarrow> int \<times> int \<Rightarrow> bool" where
   19.36      --{*definition of quotient and remainder*}
   19.37 -    [code]: "divmod_int_rel a b = (\<lambda>(q, r). a = b * q + r \<and>
   19.38 +    "divmod_int_rel a b = (\<lambda>(q, r). a = b * q + r \<and>
   19.39                 (if 0 < b then 0 \<le> r \<and> r < b else b < r \<and> r \<le> 0))"
   19.40  
   19.41  definition adjust :: "int \<Rightarrow> int \<times> int \<Rightarrow> int \<times> int" where
   19.42      --{*for the division algorithm*}
   19.43 -    [code]: "adjust b = (\<lambda>(q, r). if 0 \<le> r - b then (2 * q + 1, r - b)
   19.44 +    "adjust b = (\<lambda>(q, r). if 0 \<le> r - b then (2 * q + 1, r - b)
   19.45                           else (2 * q, r))"
   19.46  
   19.47  text{*algorithm for the case @{text "a\<ge>0, b>0"}*}
   19.48 @@ -1318,11 +1323,11 @@
   19.49  text{*And positive divisors*}
   19.50  
   19.51  lemma adjust_eq [simp]:
   19.52 -     "adjust b (q,r) = 
   19.53 -      (let diff = r-b in  
   19.54 -        if 0 \<le> diff then (2*q + 1, diff)   
   19.55 +     "adjust b (q, r) = 
   19.56 +      (let diff = r - b in  
   19.57 +        if 0 \<le> diff then (2 * q + 1, diff)   
   19.58                       else (2*q, r))"
   19.59 -by (simp add: Let_def adjust_def)
   19.60 +  by (simp add: Let_def adjust_def)
   19.61  
   19.62  declare posDivAlg.simps [simp del]
   19.63  
   19.64 @@ -1420,6 +1425,9 @@
   19.65  
   19.66  text {* Tool setup *}
   19.67  
   19.68 +(* FIXME: Theorem list add_0s doesn't exist, because Numeral0 has gone. *)
   19.69 +lemmas add_0s = add_0_left add_0_right
   19.70 +
   19.71  ML {*
   19.72  structure Cancel_Div_Mod_Int = Cancel_Div_Mod
   19.73  (
   19.74 @@ -1674,16 +1682,6 @@
   19.75    by (rule divmod_int_rel_mod [of a b q r],
   19.76      simp add: divmod_int_rel_def)
   19.77  
   19.78 -lemmas arithmetic_simps =
   19.79 -  arith_simps
   19.80 -  add_special
   19.81 -  add_0_left
   19.82 -  add_0_right
   19.83 -  mult_zero_left
   19.84 -  mult_zero_right
   19.85 -  mult_1_left
   19.86 -  mult_1_right
   19.87 -
   19.88  (* simprocs adapted from HOL/ex/Binary.thy *)
   19.89  ML {*
   19.90  local
   19.91 @@ -1694,7 +1692,7 @@
   19.92    val less = @{term "op < :: int \<Rightarrow> int \<Rightarrow> bool"}
   19.93    val le = @{term "op \<le> :: int \<Rightarrow> int \<Rightarrow> bool"}
   19.94    val simps = @{thms arith_simps} @ @{thms rel_simps} @
   19.95 -    map (fn th => th RS sym) [@{thm numeral_0_eq_0}, @{thm numeral_1_eq_1}]
   19.96 +    map (fn th => th RS sym) [@{thm numeral_1_eq_1}]
   19.97    fun prove ctxt goal = Goal.prove ctxt [] [] (HOLogic.mk_Trueprop goal)
   19.98      (K (ALLGOALS (full_simp_tac (HOL_basic_ss addsimps simps))));
   19.99    fun binary_proc proc ss ct =
  19.100 @@ -1717,14 +1715,25 @@
  19.101  end
  19.102  *}
  19.103  
  19.104 -simproc_setup binary_int_div ("number_of m div number_of n :: int") =
  19.105 +simproc_setup binary_int_div
  19.106 +  ("numeral m div numeral n :: int" |
  19.107 +   "numeral m div neg_numeral n :: int" |
  19.108 +   "neg_numeral m div numeral n :: int" |
  19.109 +   "neg_numeral m div neg_numeral n :: int") =
  19.110    {* K (divmod_proc @{thm int_div_pos_eq} @{thm int_div_neg_eq}) *}
  19.111  
  19.112 -simproc_setup binary_int_mod ("number_of m mod number_of n :: int") =
  19.113 +simproc_setup binary_int_mod
  19.114 +  ("numeral m mod numeral n :: int" |
  19.115 +   "numeral m mod neg_numeral n :: int" |
  19.116 +   "neg_numeral m mod numeral n :: int" |
  19.117 +   "neg_numeral m mod neg_numeral n :: int") =
  19.118    {* K (divmod_proc @{thm int_mod_pos_eq} @{thm int_mod_neg_eq}) *}
  19.119  
  19.120 -lemmas posDivAlg_eqn_number_of [simp] = posDivAlg_eqn [of "number_of v" "number_of w"] for v w
  19.121 -lemmas negDivAlg_eqn_number_of [simp] = negDivAlg_eqn [of "number_of v" "number_of w"] for v w
  19.122 +lemmas posDivAlg_eqn_numeral [simp] =
  19.123 +    posDivAlg_eqn [of "numeral v" "numeral w", OF zero_less_numeral] for v w
  19.124 +
  19.125 +lemmas negDivAlg_eqn_numeral [simp] =
  19.126 +    negDivAlg_eqn [of "numeral v" "neg_numeral w", OF zero_less_numeral] for v w
  19.127  
  19.128  
  19.129  text{*Special-case simplification *}
  19.130 @@ -1741,12 +1750,25 @@
  19.131  (** The last remaining special cases for constant arithmetic:
  19.132      1 div z and 1 mod z **)
  19.133  
  19.134 -lemmas div_pos_pos_1_number_of [simp] = div_pos_pos [OF zero_less_one, of "number_of w"] for w
  19.135 -lemmas div_pos_neg_1_number_of [simp] = div_pos_neg [OF zero_less_one, of "number_of w"] for w
  19.136 -lemmas mod_pos_pos_1_number_of [simp] = mod_pos_pos [OF zero_less_one, of "number_of w"] for w
  19.137 -lemmas mod_pos_neg_1_number_of [simp] = mod_pos_neg [OF zero_less_one, of "number_of w"] for w
  19.138 -lemmas posDivAlg_eqn_1_number_of [simp] = posDivAlg_eqn [of concl: 1 "number_of w"] for w
  19.139 -lemmas negDivAlg_eqn_1_number_of [simp] = negDivAlg_eqn [of concl: 1 "number_of w"] for w
  19.140 +lemmas div_pos_pos_1_numeral [simp] =
  19.141 +  div_pos_pos [OF zero_less_one, of "numeral w", OF zero_le_numeral] for w
  19.142 +
  19.143 +lemmas div_pos_neg_1_numeral [simp] =
  19.144 +  div_pos_neg [OF zero_less_one, of "neg_numeral w",
  19.145 +  OF neg_numeral_less_zero] for w
  19.146 +
  19.147 +lemmas mod_pos_pos_1_numeral [simp] =
  19.148 +  mod_pos_pos [OF zero_less_one, of "numeral w", OF zero_le_numeral] for w
  19.149 +
  19.150 +lemmas mod_pos_neg_1_numeral [simp] =
  19.151 +  mod_pos_neg [OF zero_less_one, of "neg_numeral w",
  19.152 +  OF neg_numeral_less_zero] for w
  19.153 +
  19.154 +lemmas posDivAlg_eqn_1_numeral [simp] =
  19.155 +    posDivAlg_eqn [of concl: 1 "numeral w", OF zero_less_numeral] for w
  19.156 +
  19.157 +lemmas negDivAlg_eqn_1_numeral [simp] =
  19.158 +    negDivAlg_eqn [of concl: 1 "numeral w", OF zero_less_numeral] for w
  19.159  
  19.160  
  19.161  subsubsection {* Monotonicity in the First Argument (Dividend) *}
  19.162 @@ -1928,6 +1950,11 @@
  19.163  (* REVISIT: should this be generalized to all semiring_div types? *)
  19.164  lemmas zmod_eq_0D [dest!] = zmod_eq_0_iff [THEN iffD1]
  19.165  
  19.166 +lemma zmod_zdiv_equality':
  19.167 +  "(m\<Colon>int) mod n = m - (m div n) * n"
  19.168 +  by (rule_tac P="%x. m mod n = x - (m div n) * n" in subst [OF mod_div_equality [of _ n]])
  19.169 +    arith
  19.170 +
  19.171  
  19.172  subsubsection {* Proving  @{term "a div (b*c) = (a div b) div c"} *}
  19.173  
  19.174 @@ -1989,6 +2016,26 @@
  19.175  apply (force simp add: divmod_int_rel_div_mod [THEN zmult2_lemma, THEN divmod_int_rel_mod])
  19.176  done
  19.177  
  19.178 +lemma div_pos_geq:
  19.179 +  fixes k l :: int
  19.180 +  assumes "0 < l" and "l \<le> k"
  19.181 +  shows "k div l = (k - l) div l + 1"
  19.182 +proof -
  19.183 +  have "k = (k - l) + l" by simp
  19.184 +  then obtain j where k: "k = j + l" ..
  19.185 +  with assms show ?thesis by simp
  19.186 +qed
  19.187 +
  19.188 +lemma mod_pos_geq:
  19.189 +  fixes k l :: int
  19.190 +  assumes "0 < l" and "l \<le> k"
  19.191 +  shows "k mod l = (k - l) mod l"
  19.192 +proof -
  19.193 +  have "k = (k - l) + l" by simp
  19.194 +  then obtain j where k: "k = j + l" ..
  19.195 +  with assms show ?thesis by simp
  19.196 +qed
  19.197 +
  19.198  
  19.199  subsubsection {* Splitting Rules for div and mod *}
  19.200  
  19.201 @@ -2046,9 +2093,9 @@
  19.202  
  19.203  text {* Enable (lin)arith to deal with @{const div} and @{const mod}
  19.204    when these are applied to some constant that is of the form
  19.205 -  @{term "number_of k"}: *}
  19.206 -declare split_zdiv [of _ _ "number_of k", arith_split] for k
  19.207 -declare split_zmod [of _ _ "number_of k", arith_split] for k
  19.208 +  @{term "numeral k"}: *}
  19.209 +declare split_zdiv [of _ _ "numeral k", arith_split] for k
  19.210 +declare split_zmod [of _ _ "numeral k", arith_split] for k
  19.211  
  19.212  
  19.213  subsubsection {* Speeding up the Division Algorithm with Shifting *}
  19.214 @@ -2090,19 +2137,19 @@
  19.215        minus_add_distrib [symmetric] mult_minus_right)
  19.216  qed
  19.217  
  19.218 -lemma zdiv_number_of_Bit0 [simp]:
  19.219 -     "number_of (Int.Bit0 v) div number_of (Int.Bit0 w) =  
  19.220 -          number_of v div (number_of w :: int)"
  19.221 -by (simp only: number_of_eq numeral_simps) (simp add: mult_2 [symmetric])
  19.222 -
  19.223 -lemma zdiv_number_of_Bit1 [simp]:
  19.224 -     "number_of (Int.Bit1 v) div number_of (Int.Bit0 w) =  
  19.225 -          (if (0::int) \<le> number_of w                    
  19.226 -           then number_of v div (number_of w)     
  19.227 -           else (number_of v + (1::int)) div (number_of w))"
  19.228 -apply (simp only: number_of_eq numeral_simps UNIV_I split: split_if) 
  19.229 -apply (simp add: pos_zdiv_mult_2 neg_zdiv_mult_2 add_ac mult_2 [symmetric])
  19.230 -done
  19.231 +(* FIXME: add rules for negative numerals *)
  19.232 +lemma zdiv_numeral_Bit0 [simp]:
  19.233 +  "numeral (Num.Bit0 v) div numeral (Num.Bit0 w) =
  19.234 +    numeral v div (numeral w :: int)"
  19.235 +  unfolding numeral.simps unfolding mult_2 [symmetric]
  19.236 +  by (rule div_mult_mult1, simp)
  19.237 +
  19.238 +lemma zdiv_numeral_Bit1 [simp]:
  19.239 +  "numeral (Num.Bit1 v) div numeral (Num.Bit0 w) =  
  19.240 +    (numeral v div (numeral w :: int))"
  19.241 +  unfolding numeral.simps
  19.242 +  unfolding mult_2 [symmetric] add_commute [of _ 1]
  19.243 +  by (rule pos_zdiv_mult_2, simp)
  19.244  
  19.245  
  19.246  subsubsection {* Computing mod by Shifting (proofs resemble those for div) *}
  19.247 @@ -2138,24 +2185,19 @@
  19.248       (simp add: diff_minus add_ac)
  19.249  qed
  19.250  
  19.251 -lemma zmod_number_of_Bit0 [simp]:
  19.252 -     "number_of (Int.Bit0 v) mod number_of (Int.Bit0 w) =  
  19.253 -      (2::int) * (number_of v mod number_of w)"
  19.254 -apply (simp only: number_of_eq numeral_simps) 
  19.255 -apply (simp add: mod_mult_mult1 pos_zmod_mult_2 
  19.256 -                 neg_zmod_mult_2 add_ac mult_2 [symmetric])
  19.257 -done
  19.258 -
  19.259 -lemma zmod_number_of_Bit1 [simp]:
  19.260 -     "number_of (Int.Bit1 v) mod number_of (Int.Bit0 w) =  
  19.261 -      (if (0::int) \<le> number_of w  
  19.262 -                then 2 * (number_of v mod number_of w) + 1     
  19.263 -                else 2 * ((number_of v + (1::int)) mod number_of w) - 1)"
  19.264 -apply (simp only: number_of_eq numeral_simps) 
  19.265 -apply (simp add: mod_mult_mult1 pos_zmod_mult_2 
  19.266 -                 neg_zmod_mult_2 add_ac mult_2 [symmetric])
  19.267 -done
  19.268 -
  19.269 +(* FIXME: add rules for negative numerals *)
  19.270 +lemma zmod_numeral_Bit0 [simp]:
  19.271 +  "numeral (Num.Bit0 v) mod numeral (Num.Bit0 w) =  
  19.272 +    (2::int) * (numeral v mod numeral w)"
  19.273 +  unfolding numeral_Bit0 [of v] numeral_Bit0 [of w]
  19.274 +  unfolding mult_2 [symmetric] by (rule mod_mult_mult1)
  19.275 +
  19.276 +lemma zmod_numeral_Bit1 [simp]:
  19.277 +  "numeral (Num.Bit1 v) mod numeral (Num.Bit0 w) =
  19.278 +    2 * (numeral v mod numeral w) + (1::int)"
  19.279 +  unfolding numeral_Bit1 [of v] numeral_Bit0 [of w]
  19.280 +  unfolding mult_2 [symmetric] add_commute [of _ 1]
  19.281 +  by (rule pos_zmod_mult_2, simp)
  19.282  
  19.283  lemma zdiv_eq_0_iff:
  19.284   "(i::int) div k = 0 \<longleftrightarrow> k=0 \<or> 0\<le>i \<and> i<k \<or> i\<le>0 \<and> k<i" (is "?L = ?R")
  19.285 @@ -2233,8 +2275,11 @@
  19.286  
  19.287  subsubsection {* The Divides Relation *}
  19.288  
  19.289 -lemmas zdvd_iff_zmod_eq_0_number_of [simp] =
  19.290 -  dvd_eq_mod_eq_0 [of "number_of x" "number_of y"] for x y :: int
  19.291 +lemmas zdvd_iff_zmod_eq_0_numeral [simp] =
  19.292 +  dvd_eq_mod_eq_0 [of "numeral x::int" "numeral y::int"]
  19.293 +  dvd_eq_mod_eq_0 [of "numeral x::int" "neg_numeral y::int"]
  19.294 +  dvd_eq_mod_eq_0 [of "neg_numeral x::int" "numeral y::int"]
  19.295 +  dvd_eq_mod_eq_0 [of "neg_numeral x::int" "neg_numeral y::int"] for x y
  19.296  
  19.297  lemma zdvd_zmod: "f dvd m ==> f dvd (n::int) ==> f dvd m mod n"
  19.298    by (rule dvd_mod) (* TODO: remove *)
  19.299 @@ -2242,6 +2287,12 @@
  19.300  lemma zdvd_zmod_imp_zdvd: "k dvd m mod n ==> k dvd n ==> k dvd (m::int)"
  19.301    by (rule dvd_mod_imp_dvd) (* TODO: remove *)
  19.302  
  19.303 +lemmas dvd_eq_mod_eq_0_numeral [simp] =
  19.304 +  dvd_eq_mod_eq_0 [of "numeral x" "numeral y"] for x y
  19.305 +
  19.306 +
  19.307 +subsubsection {* Further properties *}
  19.308 +
  19.309  lemma zmult_div_cancel: "(n::int) * (m div n) = m - (m mod n)"
  19.310    using zmod_zdiv_equality[where a="m" and b="n"]
  19.311    by (simp add: algebra_simps)
  19.312 @@ -2408,42 +2459,31 @@
  19.313    thus  ?lhs by simp
  19.314  qed
  19.315  
  19.316 -lemma div_nat_number_of [simp]:
  19.317 -     "(number_of v :: nat)  div  number_of v' =  
  19.318 -          (if neg (number_of v :: int) then 0  
  19.319 -           else nat (number_of v div number_of v'))"
  19.320 -  unfolding nat_number_of_def number_of_is_id neg_def
  19.321 +lemma div_nat_numeral [simp]:
  19.322 +  "(numeral v :: nat) div numeral v' = nat (numeral v div numeral v')"
  19.323    by (simp add: nat_div_distrib)
  19.324  
  19.325 -lemma one_div_nat_number_of [simp]:
  19.326 -     "Suc 0 div number_of v' = nat (1 div number_of v')" 
  19.327 -  by (simp del: semiring_numeral_1_eq_1 add: numeral_1_eq_Suc_0 [symmetric] semiring_numeral_1_eq_1 [symmetric]) 
  19.328 -
  19.329 -lemma mod_nat_number_of [simp]:
  19.330 -     "(number_of v :: nat)  mod  number_of v' =  
  19.331 -        (if neg (number_of v :: int) then 0  
  19.332 -         else if neg (number_of v' :: int) then number_of v  
  19.333 -         else nat (number_of v mod number_of v'))"
  19.334 -  unfolding nat_number_of_def number_of_is_id neg_def
  19.335 +lemma one_div_nat_numeral [simp]:
  19.336 +  "Suc 0 div numeral v' = nat (1 div numeral v')"
  19.337 +  by (subst nat_div_distrib, simp_all)
  19.338 +
  19.339 +lemma mod_nat_numeral [simp]:
  19.340 +  "(numeral v :: nat) mod numeral v' = nat (numeral v mod numeral v')"
  19.341    by (simp add: nat_mod_distrib)
  19.342  
  19.343 -lemma one_mod_nat_number_of [simp]:
  19.344 -     "Suc 0 mod number_of v' =  
  19.345 -        (if neg (number_of v' :: int) then Suc 0
  19.346 -         else nat (1 mod number_of v'))"
  19.347 -by (simp del: semiring_numeral_1_eq_1 add: numeral_1_eq_Suc_0 [symmetric] semiring_numeral_1_eq_1 [symmetric]) 
  19.348 -
  19.349 -lemmas dvd_eq_mod_eq_0_number_of [simp] =
  19.350 -  dvd_eq_mod_eq_0 [of "number_of x" "number_of y"] for x y
  19.351 -
  19.352 -
  19.353 -subsubsection {* Nitpick *}
  19.354 -
  19.355 -lemma zmod_zdiv_equality':
  19.356 -"(m\<Colon>int) mod n = m - (m div n) * n"
  19.357 -by (rule_tac P="%x. m mod n = x - (m div n) * n"
  19.358 -    in subst [OF mod_div_equality [of _ n]])
  19.359 -   arith
  19.360 +lemma one_mod_nat_numeral [simp]:
  19.361 +  "Suc 0 mod numeral v' = nat (1 mod numeral v')"
  19.362 +  by (subst nat_mod_distrib) simp_all
  19.363 +
  19.364 +lemma mod_2_not_eq_zero_eq_one_int:
  19.365 +  fixes k :: int
  19.366 +  shows "k mod 2 \<noteq> 0 \<longleftrightarrow> k mod 2 = 1"
  19.367 +  by auto
  19.368 +
  19.369 +
  19.370 +subsubsection {* Tools setup *}
  19.371 +
  19.372 +text {* Nitpick *}
  19.373  
  19.374  lemmas [nitpick_unfold] = dvd_eq_mod_eq_0 mod_div_equality' zmod_zdiv_equality'
  19.375  
  19.376 @@ -2461,7 +2501,7 @@
  19.377    apsnd ((op *) (sgn l)) (if 0 < l \<and> 0 \<le> k \<or> l < 0 \<and> k < 0
  19.378      then pdivmod k l
  19.379      else (let (r, s) = pdivmod k l in
  19.380 -      if s = 0 then (- r, 0) else (- r - 1, \<bar>l\<bar> - s))))"
  19.381 +       if s = 0 then (- r, 0) else (- r - 1, \<bar>l\<bar> - s))))"
  19.382  proof -
  19.383    have aux: "\<And>q::int. - k = l * q \<longleftrightarrow> k = l * - q" by auto
  19.384    show ?thesis
  19.385 @@ -2481,45 +2521,6 @@
  19.386    then show ?thesis by (simp add: divmod_int_pdivmod)
  19.387  qed
  19.388  
  19.389 -context ring_1
  19.390 -begin
  19.391 -
  19.392 -lemma of_int_num [code]:
  19.393 -  "of_int k = (if k = 0 then 0 else if k < 0 then
  19.394 -     - of_int (- k) else let
  19.395 -       (l, m) = divmod_int k 2;
  19.396 -       l' = of_int l
  19.397 -     in if m = 0 then l' + l' else l' + l' + 1)"
  19.398 -proof -
  19.399 -  have aux1: "k mod (2\<Colon>int) \<noteq> (0\<Colon>int) \<Longrightarrow> 
  19.400 -    of_int k = of_int (k div 2 * 2 + 1)"
  19.401 -  proof -
  19.402 -    have "k mod 2 < 2" by (auto intro: pos_mod_bound)
  19.403 -    moreover have "0 \<le> k mod 2" by (auto intro: pos_mod_sign)
  19.404 -    moreover assume "k mod 2 \<noteq> 0"
  19.405 -    ultimately have "k mod 2 = 1" by arith
  19.406 -    moreover have "of_int k = of_int (k div 2 * 2 + k mod 2)" by simp
  19.407 -    ultimately show ?thesis by auto
  19.408 -  qed
  19.409 -  have aux2: "\<And>x. of_int 2 * x = x + x"
  19.410 -  proof -
  19.411 -    fix x
  19.412 -    have int2: "(2::int) = 1 + 1" by arith
  19.413 -    show "of_int 2 * x = x + x"
  19.414 -    unfolding int2 of_int_add left_distrib by simp
  19.415 -  qed
  19.416 -  have aux3: "\<And>x. x * of_int 2 = x + x"
  19.417 -  proof -
  19.418 -    fix x
  19.419 -    have int2: "(2::int) = 1 + 1" by arith
  19.420 -    show "x * of_int 2 = x + x" 
  19.421 -    unfolding int2 of_int_add right_distrib by simp
  19.422 -  qed
  19.423 -  from aux1 show ?thesis by (auto simp add: divmod_int_mod_div Let_def aux2 aux3)
  19.424 -qed
  19.425 -
  19.426 -end
  19.427 -
  19.428  code_modulename SML
  19.429    Divides Arith
  19.430  
    20.1 --- a/src/HOL/Imperative_HOL/ex/Imperative_Quicksort.thy	Sat Mar 24 16:27:04 2012 +0100
    20.2 +++ b/src/HOL/Imperative_HOL/ex/Imperative_Quicksort.thy	Sun Mar 25 20:15:39 2012 +0200
    20.3 @@ -6,7 +6,7 @@
    20.4  
    20.5  theory Imperative_Quicksort
    20.6  imports
    20.7 -  Imperative_HOL
    20.8 +  "~~/src/HOL/Imperative_HOL/Imperative_HOL"
    20.9    Subarray
   20.10    "~~/src/HOL/Library/Multiset"
   20.11    "~~/src/HOL/Library/Efficient_Nat"
   20.12 @@ -593,8 +593,8 @@
   20.13  proof (induct a l r p arbitrary: h rule: part1.induct)
   20.14    case (1 a l r p)
   20.15    thus ?case unfolding part1.simps [of a l r]
   20.16 -  apply (auto intro!: success_intros del: success_ifI simp add: not_le)
   20.17 -  apply (auto intro!: effect_intros effect_swapI)
   20.18 +  apply (auto intro!: success_intros simp add: not_le)
   20.19 +  apply (auto intro!: effect_intros)
   20.20    done
   20.21  qed
   20.22  
    21.1 --- a/src/HOL/Imperative_HOL/ex/Imperative_Reverse.thy	Sat Mar 24 16:27:04 2012 +0100
    21.2 +++ b/src/HOL/Imperative_HOL/ex/Imperative_Reverse.thy	Sun Mar 25 20:15:39 2012 +0200
    21.3 @@ -5,7 +5,7 @@
    21.4  header {* An imperative in-place reversal on arrays *}
    21.5  
    21.6  theory Imperative_Reverse
    21.7 -imports Subarray Imperative_HOL
    21.8 +imports Subarray "~~/src/HOL/Imperative_HOL/Imperative_HOL"
    21.9  begin
   21.10  
   21.11  fun swap :: "'a\<Colon>heap array \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> unit Heap" where
   21.12 @@ -107,7 +107,7 @@
   21.13    shows "Array.get h' a = List.rev (Array.get h a)"
   21.14    using rev2_rev'[OF assms] rev_length[OF assms] assms
   21.15      by (cases "Array.length h a = 0", auto simp add: Array.length_def
   21.16 -      subarray_def sublist'_all rev.simps[where j=0] elim!: effect_elims)
   21.17 +      subarray_def rev.simps[where j=0] elim!: effect_elims)
   21.18    (drule sym[of "List.length (Array.get h a)"], simp)
   21.19  
   21.20  definition "example = (Array.make 10 id \<guillemotright>= (\<lambda>a. rev a 0 9))"
   21.21 @@ -115,3 +115,4 @@
   21.22  export_code example checking SML SML_imp OCaml? OCaml_imp? Haskell? Scala? Scala_imp?
   21.23  
   21.24  end
   21.25 +
    22.1 --- a/src/HOL/Imperative_HOL/ex/SatChecker.thy	Sat Mar 24 16:27:04 2012 +0100
    22.2 +++ b/src/HOL/Imperative_HOL/ex/SatChecker.thy	Sun Mar 25 20:15:39 2012 +0200
    22.3 @@ -702,15 +702,7 @@
    22.4                  else raise(''No empty clause''))
    22.5    }"
    22.6  
    22.7 -section {* Code generation setup *}
    22.8 -
    22.9 -code_type ProofStep
   22.10 -  (SML "MinisatProofStep.ProofStep")
   22.11 -
   22.12 -code_const ProofDone and Root and Conflict and Delete and Xstep
   22.13 -  (SML "MinisatProofStep.ProofDone" and "MinisatProofStep.Root ((_),/ (_))" and "MinisatProofStep.Conflict ((_),/ (_))" and "MinisatProofStep.Delete" and "MinisatProofStep.Xstep ((_),/ (_))")
   22.14 -
   22.15 -export_code checker tchecker lchecker in SML
   22.16 +export_code checker tchecker lchecker checking SML
   22.17  
   22.18  end
   22.19  
    23.1 --- a/src/HOL/Imperative_HOL/ex/Subarray.thy	Sat Mar 24 16:27:04 2012 +0100
    23.2 +++ b/src/HOL/Imperative_HOL/ex/Subarray.thy	Sun Mar 25 20:15:39 2012 +0200
    23.3 @@ -5,7 +5,7 @@
    23.4  header {* Theorems about sub arrays *}
    23.5  
    23.6  theory Subarray
    23.7 -imports Array Sublist
    23.8 +imports "~~/src/HOL/Imperative_HOL/Array" Sublist
    23.9  begin
   23.10  
   23.11  definition subarray :: "nat \<Rightarrow> nat \<Rightarrow> ('a::heap) array \<Rightarrow> heap \<Rightarrow> 'a list" where
    24.1 --- a/src/HOL/Import/HOL_Light/HOLLightInt.thy	Sat Mar 24 16:27:04 2012 +0100
    24.2 +++ b/src/HOL/Import/HOL_Light/HOLLightInt.thy	Sun Mar 25 20:15:39 2012 +0200
    24.3 @@ -40,7 +40,7 @@
    24.4  
    24.5  lemma DEF_int_mul:
    24.6    "op * = (\<lambda>u ua. floor (real u * real ua))"
    24.7 -  by (metis floor_number_of number_of_is_id number_of_real_def real_eq_of_int real_of_int_mult)
    24.8 +  by (metis floor_real_of_int real_of_int_mult)
    24.9  
   24.10  lemma DEF_int_abs:
   24.11    "abs = (\<lambda>u. floor (abs (real u)))"
   24.12 @@ -72,7 +72,7 @@
   24.13  
   24.14  lemma INT_IMAGE:
   24.15    "(\<exists>n. x = int n) \<or> (\<exists>n. x = - int n)"
   24.16 -  by (metis number_of_eq number_of_is_id of_int_of_nat)
   24.17 +  by (metis of_int_eq_id id_def of_int_of_nat)
   24.18  
   24.19  lemma DEF_int_pow:
   24.20    "op ^ = (\<lambda>u ua. floor (real u ^ ua))"
    25.1 --- a/src/HOL/Int.thy	Sat Mar 24 16:27:04 2012 +0100
    25.2 +++ b/src/HOL/Int.thy	Sun Mar 25 20:15:39 2012 +0200
    25.3 @@ -6,10 +6,9 @@
    25.4  header {* The Integers as Equivalence Classes over Pairs of Natural Numbers *} 
    25.5  
    25.6  theory Int
    25.7 -imports Equiv_Relations Nat Wellfounded
    25.8 +imports Equiv_Relations Wellfounded
    25.9  uses
   25.10    ("Tools/numeral.ML")
   25.11 -  ("Tools/numeral_syntax.ML")
   25.12    ("Tools/int_arith.ML")
   25.13  begin
   25.14  
   25.15 @@ -323,15 +322,20 @@
   25.16  lemma of_int_of_nat_eq [simp]: "of_int (int n) = of_nat n"
   25.17  by (induct n) auto
   25.18  
   25.19 +lemma of_int_numeral [simp, code_post]: "of_int (numeral k) = numeral k"
   25.20 +  by (simp add: of_nat_numeral [symmetric] of_int_of_nat_eq [symmetric])
   25.21 +
   25.22 +lemma of_int_neg_numeral [simp, code_post]: "of_int (neg_numeral k) = neg_numeral k"
   25.23 +  unfolding neg_numeral_def neg_numeral_class.neg_numeral_def
   25.24 +  by (simp only: of_int_minus of_int_numeral)
   25.25 +
   25.26  lemma of_int_power:
   25.27    "of_int (z ^ n) = of_int z ^ n"
   25.28    by (induct n) simp_all
   25.29  
   25.30  end
   25.31  
   25.32 -text{*Class for unital rings with characteristic zero.
   25.33 - Includes non-ordered rings like the complex numbers.*}
   25.34 -class ring_char_0 = ring_1 + semiring_char_0
   25.35 +context ring_char_0
   25.36  begin
   25.37  
   25.38  lemma of_int_eq_iff [simp]:
   25.39 @@ -579,230 +583,27 @@
   25.40  apply (simp add: int_def minus add diff_minus)
   25.41  done
   25.42  
   25.43 -
   25.44 -subsection {* Binary representation *}
   25.45 -
   25.46 -text {*
   25.47 -  This formalization defines binary arithmetic in terms of the integers
   25.48 -  rather than using a datatype. This avoids multiple representations (leading
   25.49 -  zeroes, etc.)  See @{text "ZF/Tools/twos-compl.ML"}, function @{text
   25.50 -  int_of_binary}, for the numerical interpretation.
   25.51 -
   25.52 -  The representation expects that @{text "(m mod 2)"} is 0 or 1,
   25.53 -  even if m is negative;
   25.54 -  For instance, @{text "-5 div 2 = -3"} and @{text "-5 mod 2 = 1"}; thus
   25.55 -  @{text "-5 = (-3)*2 + 1"}.
   25.56 -  
   25.57 -  This two's complement binary representation derives from the paper 
   25.58 -  "An Efficient Representation of Arithmetic for Term Rewriting" by
   25.59 -  Dave Cohen and Phil Watson, Rewriting Techniques and Applications,
   25.60 -  Springer LNCS 488 (240-251), 1991.
   25.61 -*}
   25.62 -
   25.63 -subsubsection {* The constructors @{term Bit0}, @{term Bit1}, @{term Pls} and @{term Min} *}
   25.64 -
   25.65 -definition Pls :: int where
   25.66 -  "Pls = 0"
   25.67 +lemma Let_numeral [simp]: "Let (numeral v) f = f (numeral v)"
   25.68 +  -- {* Unfold all @{text let}s involving constants *}
   25.69 +  unfolding Let_def ..
   25.70  
   25.71 -definition Min :: int where
   25.72 -  "Min = - 1"
   25.73 -
   25.74 -definition Bit0 :: "int \<Rightarrow> int" where
   25.75 -  "Bit0 k = k + k"
   25.76 -
   25.77 -definition Bit1 :: "int \<Rightarrow> int" where
   25.78 -  "Bit1 k = 1 + k + k"
   25.79 -
   25.80 -class number = -- {* for numeric types: nat, int, real, \dots *}
   25.81 -  fixes number_of :: "int \<Rightarrow> 'a"
   25.82 -
   25.83 -use "Tools/numeral.ML"
   25.84 -
   25.85 -syntax
   25.86 -  "_Numeral" :: "num_const \<Rightarrow> 'a"    ("_")
   25.87 -
   25.88 -use "Tools/numeral_syntax.ML"
   25.89 -setup Numeral_Syntax.setup
   25.90 -
   25.91 -abbreviation
   25.92 -  "Numeral0 \<equiv> number_of Pls"
   25.93 -
   25.94 -abbreviation
   25.95 -  "Numeral1 \<equiv> number_of (Bit1 Pls)"
   25.96 -
   25.97 -lemma Let_number_of [simp]: "Let (number_of v) f = f (number_of v)"
   25.98 +lemma Let_neg_numeral [simp]: "Let (neg_numeral v) f = f (neg_numeral v)"
   25.99    -- {* Unfold all @{text let}s involving constants *}
  25.100    unfolding Let_def ..
  25.101  
  25.102 -definition succ :: "int \<Rightarrow> int" where
  25.103 -  "succ k = k + 1"
  25.104 -
  25.105 -definition pred :: "int \<Rightarrow> int" where
  25.106 -  "pred k = k - 1"
  25.107 -
  25.108 -lemmas max_number_of [simp] = max_def [of "number_of u" "number_of v"]
  25.109 -  and min_number_of [simp] = min_def [of "number_of u" "number_of v"]
  25.110 -  for u v
  25.111 -  -- {* unfolding @{text minx} and @{text max} on numerals *}
  25.112 -
  25.113 -lemmas numeral_simps = 
  25.114 -  succ_def pred_def Pls_def Min_def Bit0_def Bit1_def
  25.115 -
  25.116 -text {* Removal of leading zeroes *}
  25.117 -
  25.118 -lemma Bit0_Pls [simp, code_post]:
  25.119 -  "Bit0 Pls = Pls"
  25.120 -  unfolding numeral_simps by simp
  25.121 -
  25.122 -lemma Bit1_Min [simp, code_post]:
  25.123 -  "Bit1 Min = Min"
  25.124 -  unfolding numeral_simps by simp
  25.125 -
  25.126 -lemmas normalize_bin_simps =
  25.127 -  Bit0_Pls Bit1_Min
  25.128 -
  25.129 -
  25.130 -subsubsection {* Successor and predecessor functions *}
  25.131 -
  25.132 -text {* Successor *}
  25.133 -
  25.134 -lemma succ_Pls:
  25.135 -  "succ Pls = Bit1 Pls"
  25.136 -  unfolding numeral_simps by simp
  25.137 -
  25.138 -lemma succ_Min:
  25.139 -  "succ Min = Pls"
  25.140 -  unfolding numeral_simps by simp
  25.141 -
  25.142 -lemma succ_Bit0:
  25.143 -  "succ (Bit0 k) = Bit1 k"
  25.144 -  unfolding numeral_simps by simp
  25.145 -
  25.146 -lemma succ_Bit1:
  25.147 -  "succ (Bit1 k) = Bit0 (succ k)"
  25.148 -  unfolding numeral_simps by simp
  25.149 -
  25.150 -lemmas succ_bin_simps [simp] =
  25.151 -  succ_Pls succ_Min succ_Bit0 succ_Bit1
  25.152 -
  25.153 -text {* Predecessor *}
  25.154 -
  25.155 -lemma pred_Pls:
  25.156 -  "pred Pls = Min"
  25.157 -  unfolding numeral_simps by simp
  25.158 -
  25.159 -lemma pred_Min:
  25.160 -  "pred Min = Bit0 Min"
  25.161 -  unfolding numeral_simps by simp
  25.162 -
  25.163 -lemma pred_Bit0:
  25.164 -  "pred (Bit0 k) = Bit1 (pred k)"
  25.165 -  unfolding numeral_simps by simp 
  25.166 -
  25.167 -lemma pred_Bit1:
  25.168 -  "pred (Bit1 k) = Bit0 k"
  25.169 -  unfolding numeral_simps by simp
  25.170 -
  25.171 -lemmas pred_bin_simps [simp] =
  25.172 -  pred_Pls pred_Min pred_Bit0 pred_Bit1
  25.173 -
  25.174 -
  25.175 -subsubsection {* Binary arithmetic *}
  25.176 -
  25.177 -text {* Addition *}
  25.178 -
  25.179 -lemma add_Pls:
  25.180 -  "Pls + k = k"
  25.181 -  unfolding numeral_simps by simp
  25.182 -
  25.183 -lemma add_Min:
  25.184 -  "Min + k = pred k"
  25.185 -  unfolding numeral_simps by simp
  25.186 +text {* Unfold @{text min} and @{text max} on numerals. *}
  25.187  
  25.188 -lemma add_Bit0_Bit0:
  25.189 -  "(Bit0 k) + (Bit0 l) = Bit0 (k + l)"
  25.190 -  unfolding numeral_simps by simp
  25.191 -
  25.192 -lemma add_Bit0_Bit1:
  25.193 -  "(Bit0 k) + (Bit1 l) = Bit1 (k + l)"
  25.194 -  unfolding numeral_simps by simp
  25.195 -
  25.196 -lemma add_Bit1_Bit0:
  25.197 -  "(Bit1 k) + (Bit0 l) = Bit1 (k + l)"
  25.198 -  unfolding numeral_simps by simp
  25.199 -
  25.200 -lemma add_Bit1_Bit1:
  25.201 -  "(Bit1 k) + (Bit1 l) = Bit0 (k + succ l)"
  25.202 -  unfolding numeral_simps by simp
  25.203 -
  25.204 -lemma add_Pls_right:
  25.205 -  "k + Pls = k"
  25.206 -  unfolding numeral_simps by simp
  25.207 -
  25.208 -lemma add_Min_right:
  25.209 -  "k + Min = pred k"
  25.210 -  unfolding numeral_simps by simp
  25.211 -
  25.212 -lemmas add_bin_simps [simp] =
  25.213 -  add_Pls add_Min add_Pls_right add_Min_right
  25.214 -  add_Bit0_Bit0 add_Bit0_Bit1 add_Bit1_Bit0 add_Bit1_Bit1
  25.215 -
  25.216 -text {* Negation *}
  25.217 -
  25.218 -lemma minus_Pls:
  25.219 -  "- Pls = Pls"
  25.220 -  unfolding numeral_simps by simp
  25.221 -
  25.222 -lemma minus_Min:
  25.223 -  "- Min = Bit1 Pls"
  25.224 -  unfolding numeral_simps by simp
  25.225 -
  25.226 -lemma minus_Bit0:
  25.227 -  "- (Bit0 k) = Bit0 (- k)"
  25.228 -  unfolding numeral_simps by simp
  25.229 +lemmas max_number_of [simp] =
  25.230 +  max_def [of "numeral u" "numeral v"]
  25.231 +  max_def [of "numeral u" "neg_numeral v"]
  25.232 +  max_def [of "neg_numeral u" "numeral v"]
  25.233 +  max_def [of "neg_numeral u" "neg_numeral v"] for u v
  25.234  
  25.235 -lemma minus_Bit1:
  25.236 -  "- (Bit1 k) = Bit1 (pred (- k))"
  25.237 -  unfolding numeral_simps by simp
  25.238 -
  25.239 -lemmas minus_bin_simps [simp] =
  25.240 -  minus_Pls minus_Min minus_Bit0 minus_Bit1
  25.241 -
  25.242 -text {* Subtraction *}
  25.243 -
  25.244 -lemma diff_bin_simps [simp]:
  25.245 -  "k - Pls = k"
  25.246 -  "k - Min = succ k"
  25.247 -  "Pls - (Bit0 l) = Bit0 (Pls - l)"
  25.248 -  "Pls - (Bit1 l) = Bit1 (Min - l)"
  25.249 -  "Min - (Bit0 l) = Bit1 (Min - l)"
  25.250 -  "Min - (Bit1 l) = Bit0 (Min - l)"
  25.251 -  "(Bit0 k) - (Bit0 l) = Bit0 (k - l)"
  25.252 -  "(Bit0 k) - (Bit1 l) = Bit1 (pred k - l)"
  25.253 -  "(Bit1 k) - (Bit0 l) = Bit1 (k - l)"
  25.254 -  "(Bit1 k) - (Bit1 l) = Bit0 (k - l)"
  25.255 -  unfolding numeral_simps by simp_all
  25.256 -
  25.257 -text {* Multiplication *}
  25.258 -
  25.259 -lemma mult_Pls:
  25.260 -  "Pls * w = Pls"
  25.261 -  unfolding numeral_simps by simp
  25.262 -
  25.263 -lemma mult_Min:
  25.264 -  "Min * k = - k"
  25.265 -  unfolding numeral_simps by simp
  25.266 -
  25.267 -lemma mult_Bit0:
  25.268 -  "(Bit0 k) * l = Bit0 (k * l)"
  25.269 -  unfolding numeral_simps int_distrib by simp
  25.270 -
  25.271 -lemma mult_Bit1:
  25.272 -  "(Bit1 k) * l = (Bit0 (k * l)) + l"
  25.273 -  unfolding numeral_simps int_distrib by simp
  25.274 -
  25.275 -lemmas mult_bin_simps [simp] =
  25.276 -  mult_Pls mult_Min mult_Bit0 mult_Bit1
  25.277 +lemmas min_number_of [simp] =
  25.278 +  min_def [of "numeral u" "numeral v"]
  25.279 +  min_def [of "numeral u" "neg_numeral v"]
  25.280 +  min_def [of "neg_numeral u" "numeral v"]
  25.281 +  min_def [of "neg_numeral u" "neg_numeral v"] for u v
  25.282  
  25.283  
  25.284  subsubsection {* Binary comparisons *}
  25.285 @@ -812,7 +613,7 @@
  25.286  lemma even_less_0_iff:
  25.287    "a + a < 0 \<longleftrightarrow> a < (0::'a::linordered_idom)"
  25.288  proof -
  25.289 -  have "a + a < 0 \<longleftrightarrow> (1+1)*a < 0" by (simp add: left_distrib)
  25.290 +  have "a + a < 0 \<longleftrightarrow> (1+1)*a < 0" by (simp add: left_distrib del: one_add_one)
  25.291    also have "(1+1)*a < 0 \<longleftrightarrow> a < 0"
  25.292      by (simp add: mult_less_0_iff zero_less_two 
  25.293                    order_less_not_sym [OF zero_less_two])
  25.294 @@ -824,7 +625,7 @@
  25.295    shows "(0::int) < 1 + z"
  25.296  proof -
  25.297    have "0 \<le> z" by fact
  25.298 -  also have "... < z + 1" by (rule less_add_one) 
  25.299 +  also have "... < z + 1" by (rule less_add_one)
  25.300    also have "... = 1 + z" by (simp add: add_ac)
  25.301    finally show "0 < 1 + z" .
  25.302  qed
  25.303 @@ -841,276 +642,6 @@
  25.304      add: algebra_simps of_nat_1 [where 'a=int, symmetric] of_nat_add [symmetric])
  25.305  qed
  25.306  
  25.307 -lemma bin_less_0_simps:
  25.308 -  "Pls < 0 \<longleftrightarrow> False"
  25.309 -  "Min < 0 \<longleftrightarrow> True"
  25.310 -  "Bit0 w < 0 \<longleftrightarrow> w < 0"
  25.311 -  "Bit1 w < 0 \<longleftrightarrow> w < 0"
  25.312 -  unfolding numeral_simps
  25.313 -  by (simp_all add: even_less_0_iff odd_less_0_iff)
  25.314 -
  25.315 -lemma less_bin_lemma: "k < l \<longleftrightarrow> k - l < (0::int)"
  25.316 -  by simp
  25.317 -
  25.318 -lemma le_iff_pred_less: "k \<le> l \<longleftrightarrow> pred k < l"
  25.319 -  unfolding numeral_simps
  25.320 -  proof
  25.321 -    have "k - 1 < k" by simp
  25.322 -    also assume "k \<le> l"
  25.323 -    finally show "k - 1 < l" .
  25.324 -  next
  25.325 -    assume "k - 1 < l"
  25.326 -    hence "(k - 1) + 1 \<le> l" by (rule zless_imp_add1_zle)
  25.327 -    thus "k \<le> l" by simp
  25.328 -  qed
  25.329 -
  25.330 -lemma succ_pred: "succ (pred x) = x"
  25.331 -  unfolding numeral_simps by simp
  25.332 -
  25.333 -text {* Less-than *}
  25.334 -
  25.335 -lemma less_bin_simps [simp]:
  25.336 -  "Pls < Pls \<longleftrightarrow> False"
  25.337 -  "Pls < Min \<longleftrightarrow> False"
  25.338 -  "Pls < Bit0 k \<longleftrightarrow> Pls < k"
  25.339 -  "Pls < Bit1 k \<longleftrightarrow> Pls \<le> k"
  25.340 -  "Min < Pls \<longleftrightarrow> True"
  25.341 -  "Min < Min \<longleftrightarrow> False"
  25.342 -  "Min < Bit0 k \<longleftrightarrow> Min < k"
  25.343 -  "Min < Bit1 k \<longleftrightarrow> Min < k"
  25.344 -  "Bit0 k < Pls \<longleftrightarrow> k < Pls"
  25.345 -  "Bit0 k < Min \<longleftrightarrow> k \<le> Min"
  25.346 -  "Bit1 k < Pls \<longleftrightarrow> k < Pls"
  25.347 -  "Bit1 k < Min \<longleftrightarrow> k < Min"
  25.348 -  "Bit0 k < Bit0 l \<longleftrightarrow> k < l"
  25.349 -  "Bit0 k < Bit1 l \<longleftrightarrow> k \<le> l"
  25.350 -  "Bit1 k < Bit0 l \<longleftrightarrow> k < l"
  25.351 -  "Bit1 k < Bit1 l \<longleftrightarrow> k < l"
  25.352 -  unfolding le_iff_pred_less
  25.353 -    less_bin_lemma [of Pls]
  25.354 -    less_bin_lemma [of Min]
  25.355 -    less_bin_lemma [of "k"]
  25.356 -    less_bin_lemma [of "Bit0 k"]
  25.357 -    less_bin_lemma [of "Bit1 k"]
  25.358 -    less_bin_lemma [of "pred Pls"]
  25.359 -    less_bin_lemma [of "pred k"]
  25.360 -  by (simp_all add: bin_less_0_simps succ_pred)
  25.361 -
  25.362 -text {* Less-than-or-equal *}
  25.363 -
  25.364 -lemma le_bin_simps [simp]:
  25.365 -  "Pls \<le> Pls \<longleftrightarrow> True"
  25.366 -  "Pls \<le> Min \<longleftrightarrow> False"
  25.367 -  "Pls \<le> Bit0 k \<longleftrightarrow> Pls \<le> k"
  25.368 -  "Pls \<le> Bit1 k \<longleftrightarrow> Pls \<le> k"
  25.369 -  "Min \<le> Pls \<longleftrightarrow> True"
  25.370 -  "Min \<le> Min \<longleftrightarrow> True"
  25.371 -  "Min \<le> Bit0 k \<longleftrightarrow> Min < k"
  25.372 -  "Min \<le> Bit1 k \<longleftrightarrow> Min \<le> k"
  25.373 -  "Bit0 k \<le> Pls \<longleftrightarrow> k \<le> Pls"
  25.374 -  "Bit0 k \<le> Min \<longleftrightarrow> k \<le> Min"
  25.375 -  "Bit1 k \<le> Pls \<longleftrightarrow> k < Pls"
  25.376 -  "Bit1 k \<le> Min \<longleftrightarrow> k \<le> Min"
  25.377 -  "Bit0 k \<le> Bit0 l \<longleftrightarrow> k \<le> l"
  25.378 -  "Bit0 k \<le> Bit1 l \<longleftrightarrow> k \<le> l"
  25.379 -  "Bit1 k \<le> Bit0 l \<longleftrightarrow> k < l"
  25.380 -  "Bit1 k \<le> Bit1 l \<longleftrightarrow> k \<le> l"
  25.381 -  unfolding not_less [symmetric]
  25.382 -  by (simp_all add: not_le)
  25.383 -
  25.384 -text {* Equality *}
  25.385 -
  25.386 -lemma eq_bin_simps [simp]:
  25.387 -  "Pls = Pls \<longleftrightarrow> True"
  25.388 -  "Pls = Min \<longleftrightarrow> False"
  25.389 -  "Pls = Bit0 l \<longleftrightarrow> Pls = l"
  25.390 -  "Pls = Bit1 l \<longleftrightarrow> False"
  25.391 -  "Min = Pls \<longleftrightarrow> False"
  25.392 -  "Min = Min \<longleftrightarrow> True"
  25.393 -  "Min = Bit0 l \<longleftrightarrow> False"
  25.394 -  "Min = Bit1 l \<longleftrightarrow> Min = l"
  25.395 -  "Bit0 k = Pls \<longleftrightarrow> k = Pls"
  25.396 -  "Bit0 k = Min \<longleftrightarrow> False"
  25.397 -  "Bit1 k = Pls \<longleftrightarrow> False"
  25.398 -  "Bit1 k = Min \<longleftrightarrow> k = Min"
  25.399 -  "Bit0 k = Bit0 l \<longleftrightarrow> k = l"
  25.400 -  "Bit0 k = Bit1 l \<longleftrightarrow> False"
  25.401 -  "Bit1 k = Bit0 l \<longleftrightarrow> False"
  25.402 -  "Bit1 k = Bit1 l \<longleftrightarrow> k = l"
  25.403 -  unfolding order_eq_iff [where 'a=int]
  25.404 -  by (simp_all add: not_less)
  25.405 -
  25.406 -
  25.407 -subsection {* Converting Numerals to Rings: @{term number_of} *}
  25.408 -
  25.409 -class number_ring = number + comm_ring_1 +
  25.410 -  assumes number_of_eq: "number_of k = of_int k"
  25.411 -
  25.412 -class number_semiring = number + comm_semiring_1 +
  25.413 -  assumes number_of_int: "number_of (int n) = of_nat n"
  25.414 -
  25.415 -instance number_ring \<subseteq> number_semiring
  25.416 -proof
  25.417 -  fix n show "number_of (int n) = (of_nat n :: 'a)"
  25.418 -    unfolding number_of_eq by (rule of_int_of_nat_eq)
  25.419 -qed
  25.420 -
  25.421 -text {* self-embedding of the integers *}
  25.422 -
  25.423 -instantiation int :: number_ring
  25.424 -begin
  25.425 -
  25.426 -definition
  25.427 -  int_number_of_def: "number_of w = (of_int w \<Colon> int)"
  25.428 -
  25.429 -instance proof
  25.430 -qed (simp only: int_number_of_def)
  25.431 -
  25.432 -end
  25.433 -
  25.434 -lemma number_of_is_id:
  25.435 -  "number_of (k::int) = k"
  25.436 -  unfolding int_number_of_def by simp
  25.437 -
  25.438 -lemma number_of_succ:
  25.439 -  "number_of (succ k) = (1 + number_of k ::'a::number_ring)"
  25.440 -  unfolding number_of_eq numeral_simps by simp
  25.441 -
  25.442 -lemma number_of_pred:
  25.443 -  "number_of (pred w) = (- 1 + number_of w ::'a::number_ring)"
  25.444 -  unfolding number_of_eq numeral_simps by simp
  25.445 -
  25.446 -lemma number_of_minus:
  25.447 -  "number_of (uminus w) = (- (number_of w)::'a::number_ring)"
  25.448 -  unfolding number_of_eq by (rule of_int_minus)
  25.449 -
  25.450 -lemma number_of_add:
  25.451 -  "number_of (v + w) = (number_of v + number_of w::'a::number_ring)"
  25.452 -  unfolding number_of_eq by (rule of_int_add)
  25.453 -
  25.454 -lemma number_of_diff:
  25.455 -  "number_of (v - w) = (number_of v - number_of w::'a::number_ring)"
  25.456 -  unfolding number_of_eq by (rule of_int_diff)
  25.457 -
  25.458 -lemma number_of_mult:
  25.459 -  "number_of (v * w) = (number_of v * number_of w::'a::number_ring)"
  25.460 -  unfolding number_of_eq by (rule of_int_mult)
  25.461 -
  25.462 -text {*
  25.463 -  The correctness of shifting.
  25.464 -  But it doesn't seem to give a measurable speed-up.
  25.465 -*}
  25.466 -
  25.467 -lemma double_number_of_Bit0:
  25.468 -  "(1 + 1) * number_of w = (number_of (Bit0 w) ::'a::number_ring)"
  25.469 -  unfolding number_of_eq numeral_simps left_distrib by simp
  25.470 -
  25.471 -text {*
  25.472 -  Converting numerals 0 and 1 to their abstract versions.
  25.473 -*}
  25.474 -
  25.475 -lemma semiring_numeral_0_eq_0 [simp, code_post]:
  25.476 -  "Numeral0 = (0::'a::number_semiring)"
  25.477 -  using number_of_int [where 'a='a and n=0]
  25.478 -  unfolding numeral_simps by simp
  25.479 -
  25.480 -lemma semiring_numeral_1_eq_1 [simp, code_post]:
  25.481 -  "Numeral1 = (1::'a::number_semiring)"
  25.482 -  using number_of_int [where 'a='a and n=1]
  25.483 -  unfolding numeral_simps by simp
  25.484 -
  25.485 -lemma numeral_0_eq_0: (* FIXME delete candidate *)
  25.486 -  "Numeral0 = (0::'a::number_ring)"
  25.487 -  by (rule semiring_numeral_0_eq_0)
  25.488 -
  25.489 -lemma numeral_1_eq_1: (* FIXME delete candidate *)
  25.490 -  "Numeral1 = (1::'a::number_ring)"
  25.491 -  by (rule semiring_numeral_1_eq_1)
  25.492 -
  25.493 -text {*
  25.494 -  Special-case simplification for small constants.
  25.495 -*}
  25.496 -
  25.497 -text{*
  25.498 -  Unary minus for the abstract constant 1. Cannot be inserted
  25.499 -  as a simprule until later: it is @{text number_of_Min} re-oriented!
  25.500 -*}
  25.501 -
  25.502 -lemma numeral_m1_eq_minus_1:
  25.503 -  "(-1::'a::number_ring) = - 1"
  25.504 -  unfolding number_of_eq numeral_simps by simp
  25.505 -
  25.506 -lemma mult_minus1 [simp]:
  25.507 -  "-1 * z = -(z::'a::number_ring)"
  25.508 -  unfolding number_of_eq numeral_simps by simp
  25.509 -
  25.510 -lemma mult_minus1_right [simp]:
  25.511 -  "z * -1 = -(z::'a::number_ring)"
  25.512 -  unfolding number_of_eq numeral_simps by simp
  25.513 -
  25.514 -(*Negation of a coefficient*)
  25.515 -lemma minus_number_of_mult [simp]:
  25.516 -   "- (number_of w) * z = number_of (uminus w) * (z::'a::number_ring)"
  25.517 -   unfolding number_of_eq by simp
  25.518 -
  25.519 -text {* Subtraction *}
  25.520 -
  25.521 -lemma diff_number_of_eq:
  25.522 -  "number_of v - number_of w =
  25.523 -    (number_of (v + uminus w)::'a::number_ring)"
  25.524 -  unfolding number_of_eq by simp
  25.525 -
  25.526 -lemma number_of_Pls:
  25.527 -  "number_of Pls = (0::'a::number_ring)"
  25.528 -  unfolding number_of_eq numeral_simps by simp
  25.529 -
  25.530 -lemma number_of_Min:
  25.531 -  "number_of Min = (- 1::'a::number_ring)"
  25.532 -  unfolding number_of_eq numeral_simps by simp
  25.533 -
  25.534 -lemma number_of_Bit0:
  25.535 -  "number_of (Bit0 w) = (0::'a::number_ring) + (number_of w) + (number_of w)"
  25.536 -  unfolding number_of_eq numeral_simps by simp
  25.537 -
  25.538 -lemma number_of_Bit1:
  25.539 -  "number_of (Bit1 w) = (1::'a::number_ring) + (number_of w) + (number_of w)"
  25.540 -  unfolding number_of_eq numeral_simps by simp
  25.541 -
  25.542 -
  25.543 -subsubsection {* Equality of Binary Numbers *}
  25.544 -
  25.545 -text {* First version by Norbert Voelker *}
  25.546 -
  25.547 -definition (*for simplifying equalities*) iszero :: "'a\<Colon>semiring_1 \<Rightarrow> bool" where
  25.548 -  "iszero z \<longleftrightarrow> z = 0"
  25.549 -
  25.550 -lemma iszero_0: "iszero 0"
  25.551 -  by (simp add: iszero_def)
  25.552 -
  25.553 -lemma iszero_Numeral0: "iszero (Numeral0 :: 'a::number_ring)"
  25.554 -  by (simp add: iszero_0)
  25.555 -
  25.556 -lemma not_iszero_1: "\<not> iszero 1"
  25.557 -  by (simp add: iszero_def)
  25.558 -
  25.559 -lemma not_iszero_Numeral1: "\<not> iszero (Numeral1 :: 'a::number_ring)"
  25.560 -  by (simp add: not_iszero_1)
  25.561 -
  25.562 -lemma eq_number_of_eq [simp]:
  25.563 -  "((number_of x::'a::number_ring) = number_of y) =
  25.564 -     iszero (number_of (x + uminus y) :: 'a)"
  25.565 -unfolding iszero_def number_of_add number_of_minus
  25.566 -by (simp add: algebra_simps)
  25.567 -
  25.568 -lemma iszero_number_of_Pls:
  25.569 -  "iszero ((number_of Pls)::'a::number_ring)"
  25.570 -unfolding iszero_def numeral_0_eq_0 ..
  25.571 -
  25.572 -lemma nonzero_number_of_Min:
  25.573 -  "~ iszero ((number_of Min)::'a::number_ring)"
  25.574 -unfolding iszero_def numeral_m1_eq_minus_1 by simp
  25.575 -
  25.576 -
  25.577  subsubsection {* Comparisons, for Ordered Rings *}
  25.578  
  25.579  lemmas double_eq_0_iff = double_zero
  25.580 @@ -1137,129 +668,6 @@
  25.581    qed
  25.582  qed
  25.583  
  25.584 -lemma iszero_number_of_Bit0:
  25.585 -  "iszero (number_of (Bit0 w)::'a) = 
  25.586 -   iszero (number_of w::'a::{ring_char_0,number_ring})"
  25.587 -proof -
  25.588 -  have "(of_int w + of_int w = (0::'a)) \<Longrightarrow> (w = 0)"
  25.589 -  proof -
  25.590 -    assume eq: "of_int w + of_int w = (0::'a)"
  25.591 -    then have "of_int (w + w) = (of_int 0 :: 'a)" by simp
  25.592 -    then have "w + w = 0" by (simp only: of_int_eq_iff)
  25.593 -    then show "w = 0" by (simp only: double_eq_0_iff)
  25.594 -  qed
  25.595 -  thus ?thesis
  25.596 -    by (auto simp add: iszero_def number_of_eq numeral_simps)
  25.597 -qed
  25.598 -
  25.599 -lemma iszero_number_of_Bit1:
  25.600 -  "~ iszero (number_of (Bit1 w)::'a::{ring_char_0,number_ring})"
  25.601 -proof -
  25.602 -  have "1 + of_int w + of_int w \<noteq> (0::'a)"
  25.603 -  proof
  25.604 -    assume eq: "1 + of_int w + of_int w = (0::'a)"
  25.605 -    hence "of_int (1 + w + w) = (of_int 0 :: 'a)" by simp 
  25.606 -    hence "1 + w + w = 0" by (simp only: of_int_eq_iff)
  25.607 -    with odd_nonzero show False by blast
  25.608 -  qed
  25.609 -  thus ?thesis
  25.610 -    by (auto simp add: iszero_def number_of_eq numeral_simps)
  25.611 -qed
  25.612 -
  25.613 -lemmas iszero_simps [simp] =
  25.614 -  iszero_0 not_iszero_1
  25.615 -  iszero_number_of_Pls nonzero_number_of_Min
  25.616 -  iszero_number_of_Bit0 iszero_number_of_Bit1
  25.617 -(* iszero_number_of_Pls would never normally be used
  25.618 -   because its lhs simplifies to "iszero 0" *)
  25.619 -
  25.620 -text {* Less-Than or Equals *}
  25.621 -
  25.622 -text {* Reduces @{term "a\<le>b"} to @{term "~ (b<a)"} for ALL numerals. *}
  25.623 -
  25.624 -lemmas le_number_of_eq_not_less =
  25.625 -  linorder_not_less [of "number_of w" "number_of v", symmetric] for w v
  25.626 -
  25.627 -
  25.628 -text {* Absolute value (@{term abs}) *}
  25.629 -
  25.630 -lemma abs_number_of:
  25.631 -  "abs(number_of x::'a::{linordered_idom,number_ring}) =
  25.632 -   (if number_of x < (0::'a) then -number_of x else number_of x)"
  25.633 -  by (simp add: abs_if)
  25.634 -
  25.635 -
  25.636 -text {* Re-orientation of the equation nnn=x *}
  25.637 -
  25.638 -lemma number_of_reorient:
  25.639 -  "(number_of w = x) = (x = number_of w)"
  25.640 -  by auto
  25.641 -
  25.642 -
  25.643 -subsubsection {* Simplification of arithmetic operations on integer constants. *}
  25.644 -
  25.645 -lemmas arith_extra_simps [simp] =
  25.646 -  number_of_add [symmetric]
  25.647 -  number_of_minus [symmetric]
  25.648 -  numeral_m1_eq_minus_1 [symmetric]
  25.649 -  number_of_mult [symmetric]
  25.650 -  diff_number_of_eq abs_number_of
  25.651 -
  25.652 -text {*
  25.653 -  For making a minimal simpset, one must include these default simprules.
  25.654 -  Also include @{text simp_thms}.
  25.655 -*}
  25.656 -
  25.657 -lemmas arith_simps = 
  25.658 -  normalize_bin_simps pred_bin_simps succ_bin_simps
  25.659 -  add_bin_simps minus_bin_simps mult_bin_simps
  25.660 -  abs_zero abs_one arith_extra_simps
  25.661 -
  25.662 -text {* Simplification of relational operations *}
  25.663 -
  25.664 -lemma less_number_of [simp]:
  25.665 -  "(number_of x::'a::{linordered_idom,number_ring}) < number_of y \<longleftrightarrow> x < y"
  25.666 -  unfolding number_of_eq by (rule of_int_less_iff)
  25.667 -
  25.668 -lemma le_number_of [simp]:
  25.669 -  "(number_of x::'a::{linordered_idom,number_ring}) \<le> number_of y \<longleftrightarrow> x \<le> y"
  25.670 -  unfolding number_of_eq by (rule of_int_le_iff)
  25.671 -
  25.672 -lemma eq_number_of [simp]:
  25.673 -  "(number_of x::'a::{ring_char_0,number_ring}) = number_of y \<longleftrightarrow> x = y"
  25.674 -  unfolding number_of_eq by (rule of_int_eq_iff)
  25.675 -
  25.676 -lemmas rel_simps =
  25.677 -  less_number_of less_bin_simps
  25.678 -  le_number_of le_bin_simps
  25.679 -  eq_number_of_eq eq_bin_simps
  25.680 -  iszero_simps
  25.681 -
  25.682 -
  25.683 -subsubsection {* Simplification of arithmetic when nested to the right. *}
  25.684 -
  25.685 -lemma add_number_of_left [simp]:
  25.686 -  "number_of v + (number_of w + z) =
  25.687 -   (number_of(v + w) + z::'a::number_ring)"
  25.688 -  by (simp add: add_assoc [symmetric])
  25.689 -
  25.690 -lemma mult_number_of_left [simp]:
  25.691 -  "number_of v * (number_of w * z) =
  25.692 -   (number_of(v * w) * z::'a::number_ring)"
  25.693 -  by (simp add: mult_assoc [symmetric])
  25.694 -
  25.695 -lemma add_number_of_diff1:
  25.696 -  "number_of v + (number_of w - c) = 
  25.697 -  number_of(v + w) - (c::'a::number_ring)"
  25.698 -  by (simp add: diff_minus)
  25.699 -
  25.700 -lemma add_number_of_diff2 [simp]:
  25.701 -  "number_of v + (c - number_of w) =
  25.702 -   number_of (v + uminus w) + (c::'a::number_ring)"
  25.703 -by (simp add: algebra_simps diff_number_of_eq [symmetric])
  25.704 -
  25.705 -
  25.706 -
  25.707  
  25.708  subsection {* The Set of Integers *}
  25.709  
  25.710 @@ -1363,14 +771,8 @@
  25.711    qed
  25.712  qed 
  25.713  
  25.714 -lemma Ints_number_of [simp]:
  25.715 -  "(number_of w :: 'a::number_ring) \<in> Ints"
  25.716 -  unfolding number_of_eq Ints_def by simp
  25.717 -
  25.718 -lemma Nats_number_of [simp]:
  25.719 -  "Int.Pls \<le> w \<Longrightarrow> (number_of w :: 'a::number_ring) \<in> Nats"
  25.720 -unfolding Int.Pls_def number_of_eq
  25.721 -by (simp only: of_nat_nat [symmetric] of_nat_in_Nats)
  25.722 +lemma Nats_numeral [simp]: "numeral w \<in> Nats"
  25.723 +  using of_nat_in_Nats [of "numeral w"] by simp
  25.724  
  25.725  lemma Ints_odd_less_0: 
  25.726    assumes in_Ints: "a \<in> Ints"
  25.727 @@ -1412,100 +814,16 @@
  25.728  lemmas int_setprod = of_nat_setprod [where 'a=int]
  25.729  
  25.730  
  25.731 -subsection{*Inequality Reasoning for the Arithmetic Simproc*}
  25.732 -
  25.733 -lemma add_numeral_0: "Numeral0 + a = (a::'a::number_ring)"
  25.734 -by simp 
  25.735 -
  25.736 -lemma add_numeral_0_right: "a + Numeral0 = (a::'a::number_ring)"
  25.737 -by simp
  25.738 -
  25.739 -lemma mult_numeral_1: "Numeral1 * a = (a::'a::number_ring)"
  25.740 -by simp 
  25.741 -
  25.742 -lemma mult_numeral_1_right: "a * Numeral1 = (a::'a::number_ring)"
  25.743 -by simp
  25.744 -
  25.745 -lemma divide_numeral_1: "a / Numeral1 = (a::'a::{number_ring,field})"
  25.746 -by simp
  25.747 -
  25.748 -lemma inverse_numeral_1:
  25.749 -  "inverse Numeral1 = (Numeral1::'a::{number_ring,field})"
  25.750 -by simp
  25.751 -
  25.752 -text{*Theorem lists for the cancellation simprocs. The use of binary numerals
  25.753 -for 0 and 1 reduces the number of special cases.*}
  25.754 -
  25.755 -lemmas add_0s = add_numeral_0 add_numeral_0_right
  25.756 -lemmas mult_1s = mult_numeral_1 mult_numeral_1_right 
  25.757 -                 mult_minus1 mult_minus1_right
  25.758 -
  25.759 -
  25.760 -subsection{*Special Arithmetic Rules for Abstract 0 and 1*}
  25.761 -
  25.762 -text{*Arithmetic computations are defined for binary literals, which leaves 0
  25.763 -and 1 as special cases. Addition already has rules for 0, but not 1.
  25.764 -Multiplication and unary minus already have rules for both 0 and 1.*}
  25.765 -
  25.766 -
  25.767 -lemma binop_eq: "[|f x y = g x y; x = x'; y = y'|] ==> f x' y' = g x' y'"
  25.768 -by simp
  25.769 -
  25.770 -
  25.771 -lemmas add_number_of_eq = number_of_add [symmetric]
  25.772 -
  25.773 -text{*Allow 1 on either or both sides*}
  25.774 -lemma semiring_one_add_one_is_two: "1 + 1 = (2::'a::number_semiring)"
  25.775 -  using number_of_int [where 'a='a and n="Suc (Suc 0)"]
  25.776 -  by (simp add: numeral_simps)
  25.777 -
  25.778 -lemma one_add_one_is_two: "1 + 1 = (2::'a::number_ring)"
  25.779 -by (rule semiring_one_add_one_is_two)
  25.780 -
  25.781 -lemmas add_special =
  25.782 -    one_add_one_is_two
  25.783 -    binop_eq [of "op +", OF add_number_of_eq numeral_1_eq_1 refl]
  25.784 -    binop_eq [of "op +", OF add_number_of_eq refl numeral_1_eq_1]
  25.785 -
  25.786 -text{*Allow 1 on either or both sides (1-1 already simplifies to 0)*}
  25.787 -lemmas diff_special =
  25.788 -    binop_eq [of "op -", OF diff_number_of_eq numeral_1_eq_1 refl]
  25.789 -    binop_eq [of "op -", OF diff_number_of_eq refl numeral_1_eq_1]
  25.790 -
  25.791 -text{*Allow 0 or 1 on either side with a binary numeral on the other*}
  25.792 -lemmas eq_special =
  25.793 -    binop_eq [of "op =", OF eq_number_of_eq numeral_0_eq_0 refl]
  25.794 -    binop_eq [of "op =", OF eq_number_of_eq numeral_1_eq_1 refl]
  25.795 -    binop_eq [of "op =", OF eq_number_of_eq refl numeral_0_eq_0]
  25.796 -    binop_eq [of "op =", OF eq_number_of_eq refl numeral_1_eq_1]
  25.797 -
  25.798 -text{*Allow 0 or 1 on either side with a binary numeral on the other*}
  25.799 -lemmas less_special =
  25.800 -  binop_eq [of "op <", OF less_number_of numeral_0_eq_0 refl]
  25.801 -  binop_eq [of "op <", OF less_number_of numeral_1_eq_1 refl]
  25.802 -  binop_eq [of "op <", OF less_number_of refl numeral_0_eq_0]
  25.803 -  binop_eq [of "op <", OF less_number_of refl numeral_1_eq_1]
  25.804 -
  25.805 -text{*Allow 0 or 1 on either side with a binary numeral on the other*}
  25.806 -lemmas le_special =
  25.807 -    binop_eq [of "op \<le>", OF le_number_of numeral_0_eq_0 refl]
  25.808 -    binop_eq [of "op \<le>", OF le_number_of numeral_1_eq_1 refl]
  25.809 -    binop_eq [of "op \<le>", OF le_number_of refl numeral_0_eq_0]
  25.810 -    binop_eq [of "op \<le>", OF le_number_of refl numeral_1_eq_1]
  25.811 -
  25.812 -lemmas arith_special[simp] = 
  25.813 -       add_special diff_special eq_special less_special le_special
  25.814 -
  25.815 -
  25.816  text {* Legacy theorems *}
  25.817  
  25.818  lemmas zle_int = of_nat_le_iff [where 'a=int]
  25.819  lemmas int_int_eq = of_nat_eq_iff [where 'a=int]
  25.820 +lemmas numeral_1_eq_1 = numeral_One
  25.821  
  25.822  subsection {* Setting up simplification procedures *}
  25.823  
  25.824  lemmas int_arith_rules =
  25.825 -  neg_le_iff_le numeral_0_eq_0 numeral_1_eq_1
  25.826 +  neg_le_iff_le numeral_One
  25.827    minus_zero diff_minus left_minus right_minus
  25.828    mult_zero_left mult_zero_right mult_1_left mult_1_right
  25.829    mult_minus_left mult_minus_right
  25.830 @@ -1513,56 +831,39 @@
  25.831    of_nat_0 of_nat_1 of_nat_Suc of_nat_add of_nat_mult
  25.832    of_int_0 of_int_1 of_int_add of_int_mult
  25.833  
  25.834 +use "Tools/numeral.ML"
  25.835  use "Tools/int_arith.ML"
  25.836  declaration {* K Int_Arith.setup *}
  25.837  
  25.838 -simproc_setup fast_arith ("(m::'a::{linordered_idom,number_ring}) < n" |
  25.839 -  "(m::'a::{linordered_idom,number_ring}) <= n" |
  25.840 -  "(m::'a::{linordered_idom,number_ring}) = n") =
  25.841 +simproc_setup fast_arith ("(m::'a::linordered_idom) < n" |
  25.842 +  "(m::'a::linordered_idom) <= n" |
  25.843 +  "(m::'a::linordered_idom) = n") =
  25.844    {* fn _ => fn ss => fn ct => Lin_Arith.simproc ss (term_of ct) *}
  25.845  
  25.846  setup {*
  25.847    Reorient_Proc.add
  25.848 -    (fn Const (@{const_name number_of}, _) $ _ => true | _ => false)
  25.849 +    (fn Const (@{const_name numeral}, _) $ _ => true
  25.850 +    | Const (@{const_name neg_numeral}, _) $ _ => true
  25.851 +    | _ => false)
  25.852  *}
  25.853  
  25.854 -simproc_setup reorient_numeral ("number_of w = x") = Reorient_Proc.proc
  25.855 +simproc_setup reorient_numeral
  25.856 +  ("numeral w = x" | "neg_numeral w = y") = Reorient_Proc.proc
  25.857  
  25.858  
  25.859  subsection{*Lemmas About Small Numerals*}
  25.860  
  25.861 -lemma of_int_m1 [simp]: "of_int -1 = (-1 :: 'a :: number_ring)"
  25.862 -proof -
  25.863 -  have "(of_int -1 :: 'a) = of_int (- 1)" by simp
  25.864 -  also have "... = - of_int 1" by (simp only: of_int_minus)
  25.865 -  also have "... = -1" by simp
  25.866 -  finally show ?thesis .
  25.867 -qed
  25.868 -
  25.869 -lemma abs_minus_one [simp]: "abs (-1) = (1::'a::{linordered_idom,number_ring})"
  25.870 -by (simp add: abs_if)
  25.871 -
  25.872  lemma abs_power_minus_one [simp]:
  25.873 -  "abs(-1 ^ n) = (1::'a::{linordered_idom,number_ring})"
  25.874 +  "abs(-1 ^ n) = (1::'a::linordered_idom)"
  25.875  by (simp add: power_abs)
  25.876  
  25.877 -lemma of_int_number_of_eq [simp]:
  25.878 -     "of_int (number_of v) = (number_of v :: 'a :: number_ring)"
  25.879 -by (simp add: number_of_eq) 
  25.880 -
  25.881  text{*Lemmas for specialist use, NOT as default simprules*}
  25.882  (* TODO: see if semiring duplication can be removed without breaking proofs *)
  25.883 -lemma semiring_mult_2: "2 * z = (z+z::'a::number_semiring)"
  25.884 -unfolding semiring_one_add_one_is_two [symmetric] left_distrib by simp
  25.885 -
  25.886 -lemma semiring_mult_2_right: "z * 2 = (z+z::'a::number_semiring)"
  25.887 -by (subst mult_commute, rule semiring_mult_2)
  25.888 +lemma mult_2: "2 * z = (z+z::'a::semiring_1)"
  25.889 +unfolding one_add_one [symmetric] left_distrib by simp
  25.890  
  25.891 -lemma mult_2: "2 * z = (z+z::'a::number_ring)"
  25.892 -by (rule semiring_mult_2)
  25.893 -
  25.894 -lemma mult_2_right: "z * 2 = (z+z::'a::number_ring)"
  25.895 -by (rule semiring_mult_2_right)
  25.896 +lemma mult_2_right: "z * 2 = (z+z::'a::semiring_1)"
  25.897 +unfolding one_add_one [symmetric] right_distrib by simp
  25.898  
  25.899  
  25.900  subsection{*More Inequality Reasoning*}
  25.901 @@ -1608,7 +909,7 @@
  25.902  
  25.903  text{*This simplifies expressions of the form @{term "int n = z"} where
  25.904        z is an integer literal.*}
  25.905 -lemmas int_eq_iff_number_of [simp] = int_eq_iff [of _ "number_of v"] for v
  25.906 +lemmas int_eq_iff_numeral [simp] = int_eq_iff [of _ "numeral v"] for v
  25.907  
  25.908  lemma split_nat [arith_split]:
  25.909    "P(nat(i::int)) = ((\<forall>n. i = int n \<longrightarrow> P n) & (i < 0 \<longrightarrow> P 0))"
  25.910 @@ -1853,12 +1154,14 @@
  25.911        by (simp add: mn)
  25.912      finally have "2*\<bar>n\<bar> \<le> 1" .
  25.913      thus "False" using 0
  25.914 -      by auto
  25.915 +      by arith
  25.916    qed
  25.917    thus ?thesis using 0
  25.918      by auto
  25.919  qed
  25.920  
  25.921 +ML_val {* @{const_name neg_numeral} *}
  25.922 +
  25.923  lemma pos_zmult_eq_1_iff_lemma: "(m * n = 1) ==> m = (1::int) | m = -1"
  25.924  by (insert abs_zmult_eq_1 [of m n], arith)
  25.925  
  25.926 @@ -1894,125 +1197,170 @@
  25.927  
  25.928  text{*These distributive laws move literals inside sums and differences.*}
  25.929  
  25.930 -lemmas left_distrib_number_of [simp] = left_distrib [of _ _ "number_of v"] for v
  25.931 -lemmas right_distrib_number_of [simp] = right_distrib [of "number_of v"] for v
  25.932 -lemmas left_diff_distrib_number_of [simp] = left_diff_distrib [of _ _ "number_of v"] for v
  25.933 -lemmas right_diff_distrib_number_of [simp] = right_diff_distrib [of "number_of v"] for v
  25.934 +lemmas left_distrib_numeral [simp] = left_distrib [of _ _ "numeral v"] for v
  25.935 +lemmas right_distrib_numeral [simp] = right_distrib [of "numeral v"] for v
  25.936 +lemmas left_diff_distrib_numeral [simp] = left_diff_distrib [of _ _ "numeral v"] for v
  25.937 +lemmas right_diff_distrib_numeral [simp] = right_diff_distrib [of "numeral v"] for v
  25.938  
  25.939  text{*These are actually for fields, like real: but where else to put them?*}
  25.940  
  25.941 -lemmas zero_less_divide_iff_number_of [simp, no_atp] = zero_less_divide_iff [of "number_of w"] for w
  25.942 -lemmas divide_less_0_iff_number_of [simp, no_atp] = divide_less_0_iff [of "number_of w"] for w
  25.943 -lemmas zero_le_divide_iff_number_of [simp, no_atp] = zero_le_divide_iff [of "number_of w"] for w
  25.944 -lemmas divide_le_0_iff_number_of [simp, no_atp] = divide_le_0_iff [of "number_of w"] for w
  25.945 +lemmas zero_less_divide_iff_numeral [simp, no_atp] = zero_less_divide_iff [of "numeral w"] for w
  25.946 +lemmas divide_less_0_iff_numeral [simp, no_atp] = divide_less_0_iff [of "numeral w"] for w
  25.947 +lemmas zero_le_divide_iff_numeral [simp, no_atp] = zero_le_divide_iff [of "numeral w"] for w
  25.948 +lemmas divide_le_0_iff_numeral [simp, no_atp] = divide_le_0_iff [of "numeral w"] for w
  25.949  
  25.950  
  25.951  text {*Replaces @{text "inverse #nn"} by @{text "1/#nn"}.  It looks
  25.952    strange, but then other simprocs simplify the quotient.*}
  25.953  
  25.954 -lemmas inverse_eq_divide_number_of [simp] = inverse_eq_divide [of "number_of w"] for w
  25.955 +lemmas inverse_eq_divide_numeral [simp] =
  25.956 +  inverse_eq_divide [of "numeral w"] for w
  25.957 +
  25.958 +lemmas inverse_eq_divide_neg_numeral [simp] =
  25.959 +  inverse_eq_divide [of "neg_numeral w"] for w
  25.960  
  25.961  text {*These laws simplify inequalities, moving unary minus from a term
  25.962  into the literal.*}
  25.963  
  25.964 -lemmas less_minus_iff_number_of [simp, no_atp] = less_minus_iff [of "number_of v"] for v
  25.965 -lemmas le_minus_iff_number_of [simp, no_atp] = le_minus_iff [of "number_of v"] for v
  25.966 -lemmas equation_minus_iff_number_of [simp, no_atp] = equation_minus_iff [of "number_of v"] for v
  25.967 -lemmas minus_less_iff_number_of [simp, no_atp] = minus_less_iff [of _ "number_of v"] for v
  25.968 -lemmas minus_le_iff_number_of [simp, no_atp] = minus_le_iff [of _ "number_of v"] for v
  25.969 -lemmas minus_equation_iff_number_of [simp, no_atp] = minus_equation_iff [of _ "number_of v"] for v
  25.970 +lemmas le_minus_iff_numeral [simp, no_atp] =
  25.971 +  le_minus_iff [of "numeral v"]
  25.972 +  le_minus_iff [of "neg_numeral v"] for v
  25.973 +
  25.974 +lemmas equation_minus_iff_numeral [simp, no_atp] =
  25.975 +  equation_minus_iff [of "numeral v"]
  25.976 +  equation_minus_iff [of "neg_numeral v"] for v
  25.977 +
  25.978 +lemmas minus_less_iff_numeral [simp, no_atp] =
  25.979 +  minus_less_iff [of _ "numeral v"]
  25.980 +  minus_less_iff [of _ "neg_numeral v"] for v
  25.981 +
  25.982 +lemmas minus_le_iff_numeral [simp, no_atp] =
  25.983 +  minus_le_iff [of _ "numeral v"]
  25.984 +  minus_le_iff [of _ "neg_numeral v"] for v
  25.985 +
  25.986 +lemmas minus_equation_iff_numeral [simp, no_atp] =
  25.987 +  minus_equation_iff [of _ "numeral v"]
  25.988 +  minus_equation_iff [of _ "neg_numeral v"] for v
  25.989  
  25.990  text{*To Simplify Inequalities Where One Side is the Constant 1*}
  25.991  
  25.992  lemma less_minus_iff_1 [simp,no_atp]:
  25.993 -  fixes b::"'b::{linordered_idom,number_ring}"
  25.994 +  fixes b::"'b::linordered_idom"
  25.995    shows "(1 < - b) = (b < -1)"
  25.996  by auto
  25.997  
  25.998  lemma le_minus_iff_1 [simp,no_atp]:
  25.999 -  fixes b::"'b::{linordered_idom,number_ring}"
 25.1000 +  fixes b::"'b::linordered_idom"
 25.1001    shows "(1 \<le> - b) = (b \<le> -1)"
 25.1002  by auto
 25.1003  
 25.1004  lemma equation_minus_iff_1 [simp,no_atp]:
 25.1005 -  fixes b::"'b::number_ring"
 25.1006 +  fixes b::"'b::ring_1"
 25.1007    shows "(1 = - b) = (b = -1)"
 25.1008  by (subst equation_minus_iff, auto)
 25.1009  
 25.1010  lemma minus_less_iff_1 [simp,no_atp]:
 25.1011 -  fixes a::"'b::{linordered_idom,number_ring}"
 25.1012 +  fixes a::"'b::linordered_idom"
 25.1013    shows "(- a < 1) = (-1 < a)"
 25.1014  by auto
 25.1015  
 25.1016  lemma minus_le_iff_1 [simp,no_atp]:
 25.1017 -  fixes a::"'b::{linordered_idom,number_ring}"
 25.1018 +  fixes a::"'b::linordered_idom"
 25.1019    shows "(- a \<le> 1) = (-1 \<le> a)"
 25.1020  by auto
 25.1021  
 25.1022  lemma minus_equation_iff_1 [simp,no_atp]:
 25.1023 -  fixes a::"'b::number_ring"
 25.1024 +  fixes a::"'b::ring_1"
 25.1025    shows "(- a = 1) = (a = -1)"
 25.1026  by (subst minus_equation_iff, auto)
 25.1027  
 25.1028  
 25.1029  text {*Cancellation of constant factors in comparisons (@{text "<"} and @{text "\<le>"}) *}
 25.1030  
 25.1031 -lemmas mult_less_cancel_left_number_of [simp, no_atp] = mult_less_cancel_left [of "number_of v"] for v
 25.1032 -lemmas mult_less_cancel_right_number_of [simp, no_atp] = mult_less_cancel_right [of _ "number_of v"] for v
 25.1033 -lemmas mult_le_cancel_left_number_of [simp, no_atp] = mult_le_cancel_left [of "number_of v"] for v
 25.1034 -lemmas mult_le_cancel_right_number_of [simp, no_atp] = mult_le_cancel_right [of _ "number_of v"] for v
 25.1035 +lemmas mult_less_cancel_left_numeral [simp, no_atp] = mult_less_cancel_left [of "numeral v"] for v
 25.1036 +lemmas mult_less_cancel_right_numeral [simp, no_atp] = mult_less_cancel_right [of _ "numeral v"] for v
 25.1037 +lemmas mult_le_cancel_left_numeral [simp, no_atp] = mult_le_cancel_left [of "numeral v"] for v
 25.1038 +lemmas mult_le_cancel_right_numeral [simp, no_atp] = mult_le_cancel_right [of _ "numeral v"] for v
 25.1039  
 25.1040  
 25.1041  text {*Multiplying out constant divisors in comparisons (@{text "<"}, @{text "\<le>"} and @{text "="}) *}
 25.1042  
 25.1043 -lemmas le_divide_eq_number_of1 [simp] = le_divide_eq [of _ _ "number_of w"] for w
 25.1044 -lemmas divide_le_eq_number_of1 [simp] = divide_le_eq [of _ "number_of w"] for w
 25.1045 -lemmas less_divide_eq_number_of1 [simp] = less_divide_eq [of _ _ "number_of w"] for w
 25.1046 -lemmas divide_less_eq_number_of1 [simp] = divide_less_eq [of _ "number_of w"] for w
 25.1047 -lemmas eq_divide_eq_number_of1 [simp] = eq_divide_eq [of _ _ "number_of w"] for w
 25.1048 -lemmas divide_eq_eq_number_of1 [simp] = divide_eq_eq [of _ "number_of w"] for w
 25.1049 +lemmas le_divide_eq_numeral1 [simp] =
 25.1050 +  pos_le_divide_eq [of "numeral w", OF zero_less_numeral]
 25.1051 +  neg_le_divide_eq [of "neg_numeral w", OF neg_numeral_less_zero] for w
 25.1052 +
 25.1053 +lemmas divide_le_eq_numeral1 [simp] =
 25.1054 +  pos_divide_le_eq [of "numeral w", OF zero_less_numeral]
 25.1055 +  neg_divide_le_eq [of "neg_numeral w", OF neg_numeral_less_zero] for w
 25.1056 +
 25.1057 +lemmas less_divide_eq_numeral1 [simp] =
 25.1058 +  pos_less_divide_eq [of "numeral w", OF zero_less_numeral]
 25.1059 +  neg_less_divide_eq [of "neg_numeral w", OF neg_numeral_less_zero] for w
 25.1060  
 25.1061 +lemmas divide_less_eq_numeral1 [simp] =
 25.1062 +  pos_divide_less_eq [of "numeral w", OF zero_less_numeral]
 25.1063 +  neg_divide_less_eq [of "neg_numeral w", OF neg_numeral_less_zero] for w
 25.1064 +
 25.1065 +lemmas eq_divide_eq_numeral1 [simp] =
 25.1066 +  eq_divide_eq [of _ _ "numeral w"]
 25.1067 +  eq_divide_eq [of _ _ "neg_numeral w"] for w
 25.1068 +
 25.1069 +lemmas divide_eq_eq_numeral1 [simp] =
 25.1070 +  divide_eq_eq [of _ "numeral w"]
 25.1071 +  divide_eq_eq [of _ "neg_numeral w"] for w
 25.1072  
 25.1073  subsubsection{*Optional Simplification Rules Involving Constants*}
 25.1074  
 25.1075  text{*Simplify quotients that are compared with a literal constant.*}
 25.1076  
 25.1077 -lemmas le_divide_eq_number_of = le_divide_eq [of "number_of w"] for w
 25.1078 -lemmas divide_le_eq_number_of = divide_le_eq [of _ _ "number_of w"] for w
 25.1079 -lemmas less_divide_eq_number_of = less_divide_eq [of "number_of w"] for w
 25.1080 -lemmas divide_less_eq_number_of = divide_less_eq [of _ _ "number_of w"] for w
 25.1081 -lemmas eq_divide_eq_number_of = eq_divide_eq [of "number_of w"] for w
 25.1082 -lemmas divide_eq_eq_number_of = divide_eq_eq [of _ _ "number_of w"] for w
 25.1083 +lemmas le_divide_eq_numeral =
 25.1084 +  le_divide_eq [of "numeral w"]
 25.1085 +  le_divide_eq [of "neg_numeral w"] for w
 25.1086 +
 25.1087 +lemmas divide_le_eq_numeral =
 25.1088 +  divide_le_eq [of _ _ "numeral w"]
 25.1089 +  divide_le_eq [of _ _ "neg_numeral w"] for w
 25.1090 +
 25.1091 +lemmas less_divide_eq_numeral =
 25.1092 +  less_divide_eq [of "numeral w"]
 25.1093 +  less_divide_eq [of "neg_numeral w"] for w
 25.1094 +
 25.1095 +lemmas divide_less_eq_numeral =
 25.1096 +  divide_less_eq [of _ _ "numeral w"]
 25.1097 +  divide_less_eq [of _ _ "neg_numeral w"] for w
 25.1098 +
 25.1099 +lemmas eq_divide_eq_numeral =
 25.1100 +  eq_divide_eq [of "numeral w"]
 25.1101 +  eq_divide_eq [of "neg_numeral w"] for w
 25.1102 +
 25.1103 +lemmas divide_eq_eq_numeral =
 25.1104 +  divide_eq_eq [of _ _ "numeral w"]
 25.1105 +  divide_eq_eq [of _ _ "neg_numeral w"] for w
 25.1106  
 25.1107  
 25.1108  text{*Not good as automatic simprules because they cause case splits.*}
 25.1109  lemmas divide_const_simps =
 25.1110 -  le_divide_eq_number_of divide_le_eq_number_of less_divide_eq_number_of
 25.1111 -  divide_less_eq_number_of eq_divide_eq_number_of divide_eq_eq_number_of
 25.1112 +  le_divide_eq_numeral divide_le_eq_numeral less_divide_eq_numeral
 25.1113 +  divide_less_eq_numeral eq_divide_eq_numeral divide_eq_eq_numeral
 25.1114    le_divide_eq_1 divide_le_eq_1 less_divide_eq_1 divide_less_eq_1
 25.1115  
 25.1116  text{*Division By @{text "-1"}*}
 25.1117  
 25.1118 -lemma divide_minus1 [simp]:
 25.1119 -     "x/-1 = -(x::'a::{field_inverse_zero, number_ring})"
 25.1120 -by simp
 25.1121 +lemma divide_minus1 [simp]: "(x::'a::field) / -1 = - x"
 25.1122 +  unfolding minus_one [symmetric]
 25.1123 +  unfolding nonzero_minus_divide_right [OF one_neq_zero, symmetric]
 25.1124 +  by simp
 25.1125  
 25.1126 -lemma minus1_divide [simp]:
 25.1127 -     "-1 / (x::'a::{field_inverse_zero, number_ring}) = - (1/x)"
 25.1128 -by (simp add: divide_inverse)
 25.1129 +lemma minus1_divide [simp]: "-1 / (x::'a::field) = - (1 / x)"
 25.1130 +  unfolding minus_one [symmetric] by (rule divide_minus_left)
 25.1131  
 25.1132  lemma half_gt_zero_iff:
 25.1133 -     "(0 < r/2) = (0 < (r::'a::{linordered_field_inverse_zero,number_ring}))"
 25.1134 +     "(0 < r/2) = (0 < (r::'a::linordered_field_inverse_zero))"
 25.1135  by auto
 25.1136  
 25.1137  lemmas half_gt_zero [simp] = half_gt_zero_iff [THEN iffD2]
 25.1138  
 25.1139 -lemma divide_Numeral1:
 25.1140 -  "(x::'a::{field, number_ring}) / Numeral1 = x"
 25.1141 -  by simp
 25.1142 -
 25.1143 -lemma divide_Numeral0:
 25.1144 -  "(x::'a::{field_inverse_zero, number_ring}) / Numeral0 = 0"
 25.1145 +lemma divide_Numeral1: "(x::'a::field) / Numeral1 = x"
 25.1146    by simp
 25.1147  
 25.1148  
 25.1149 @@ -2211,128 +1559,154 @@
 25.1150  
 25.1151  subsection {* Configuration of the code generator *}
 25.1152  
 25.1153 -code_datatype Pls Min Bit0 Bit1 "number_of \<Colon> int \<Rightarrow> int"
 25.1154 +text {* Constructors *}
 25.1155 +
 25.1156 +definition Pos :: "num \<Rightarrow> int" where
 25.1157 +  [simp, code_abbrev]: "Pos = numeral"
 25.1158 +
 25.1159 +definition Neg :: "num \<Rightarrow> int" where
 25.1160 +  [simp, code_abbrev]: "Neg = neg_numeral"
 25.1161 +
 25.1162 +code_datatype "0::int" Pos Neg
 25.1163 +
 25.1164 +
 25.1165 +text {* Auxiliary operations *}
 25.1166 +
 25.1167 +definition dup :: "int \<Rightarrow> int" where
 25.1168 +  [simp]: "dup k = k + k"
 25.1169  
 25.1170 -lemmas pred_succ_numeral_code [code] =
 25.1171 -  pred_bin_simps succ_bin_simps
 25.1172 +lemma dup_code [code]:
 25.1173 +  "dup 0 = 0"
 25.1174 +  "dup (Pos n) = Pos (Num.Bit0 n)"
 25.1175 +  "dup (Neg n) = Neg (Num.Bit0 n)"
 25.1176 +  unfolding Pos_def Neg_def neg_numeral_def
 25.1177 +  by (simp_all add: numeral_Bit0)
 25.1178 +
 25.1179 +definition sub :: "num \<Rightarrow> num \<Rightarrow> int" where
 25.1180 +  [simp]: "sub m n = numeral m - numeral n"
 25.1181  
 25.1182 -lemmas plus_numeral_code [code] =
 25.1183 -  add_bin_simps
 25.1184 -  arith_extra_simps(1) [where 'a = int]
 25.1185 +lemma sub_code [code]:
 25.1186 +  "sub Num.One Num.One = 0"
 25.1187 +  "sub (Num.Bit0 m) Num.One = Pos (Num.BitM m)"
 25.1188 +  "sub (Num.Bit1 m) Num.One = Pos (Num.Bit0 m)"
 25.1189 +  "sub Num.One (Num.Bit0 n) = Neg (Num.BitM n)"
 25.1190 +  "sub Num.One (Num.Bit1 n) = Neg (Num.Bit0 n)"
 25.1191 +  "sub (Num.Bit0 m) (Num.Bit0 n) = dup (sub m n)"
 25.1192 +  "sub (Num.Bit1 m) (Num.Bit1 n) = dup (sub m n)"
 25.1193 +  "sub (Num.Bit1 m) (Num.Bit0 n) = dup (sub m n) + 1"
 25.1194 +  "sub (Num.Bit0 m) (Num.Bit1 n) = dup (sub m n) - 1"
 25.1195 +  unfolding sub_def dup_def numeral.simps Pos_def Neg_def
 25.1196 +    neg_numeral_def numeral_BitM
 25.1197 +  by (simp_all only: algebra_simps)
 25.1198  
 25.1199 -lemmas minus_numeral_code [code] =
 25.1200 -  minus_bin_simps
 25.1201 -  arith_extra_simps(2) [where 'a = int]
 25.1202 -  arith_extra_simps(5) [where 'a = int]
 25.1203 +
 25.1204 +text {* Implementations *}
 25.1205 +
 25.1206 +lemma one_int_code [code, code_unfold]:
 25.1207 +  "1 = Pos Num.One"
 25.1208 +  by simp
 25.1209 +
 25.1210 +lemma plus_int_code [code]:
 25.1211 +  "k + 0 = (k::int)"
 25.1212 +  "0 + l = (l::int)"
 25.1213 +  "Pos m + Pos n = Pos (m + n)"
 25.1214 +  "Pos m + Neg n = sub m n"
 25.1215 +  "Neg m + Pos n = sub n m"
 25.1216 +  "Neg m + Neg n = Neg (m + n)"
 25.1217 +  by simp_all
 25.1218  
 25.1219 -lemmas times_numeral_code [code] =
 25.1220 -  mult_bin_simps
 25.1221 -  arith_extra_simps(4) [where 'a = int]
 25.1222 +lemma uminus_int_code [code]:
 25.1223 +  "uminus 0 = (0::int)"
 25.1224 +  "uminus (Pos m) = Neg m"
 25.1225 +  "uminus (Neg m) = Pos m"
 25.1226 +  by simp_all
 25.1227 +
 25.1228 +lemma minus_int_code [code]:
 25.1229 +  "k - 0 = (k::int)"
 25.1230 +  "0 - l = uminus (l::int)"
 25.1231 +  "Pos m - Pos n = sub m n"
 25.1232 +  "Pos m - Neg n = Pos (m + n)"
 25.1233 +  "Neg m - Pos n = Neg (m + n)"
 25.1234 +  "Neg m - Neg n = sub n m"
 25.1235 +  by simp_all
 25.1236 +
 25.1237 +lemma times_int_code [code]:
 25.1238 +  "k * 0 = (0::int)"
 25.1239 +  "0 * l = (0::int)"
 25.1240 +  "Pos m * Pos n = Pos (m * n)"
 25.1241 +  "Pos m * Neg n = Neg (m * n)"
 25.1242 +  "Neg m * Pos n = Neg (m * n)"
 25.1243 +  "Neg m * Neg n = Pos (m * n)"
 25.1244 +  by simp_all
 25.1245  
 25.1246  instantiation int :: equal
 25.1247  begin
 25.1248  
 25.1249  definition
 25.1250 -  "HOL.equal k l \<longleftrightarrow> k - l = (0\<Colon>int)"
 25.1251 +  "HOL.equal k l \<longleftrightarrow> k = (l::int)"
 25.1252  
 25.1253 -instance by default (simp add: equal_int_def)
 25.1254 +instance by default (rule equal_int_def)
 25.1255  
 25.1256  end
 25.1257  
 25.1258 -lemma eq_number_of_int_code [code]:
 25.1259 -  "HOL.equal (number_of k \<Colon> int) (number_of l) \<longleftrightarrow> HOL.equal k l"
 25.1260 -  unfolding equal_int_def number_of_is_id ..
 25.1261 +lemma equal_int_code [code]:
 25.1262 +  "HOL.equal 0 (0::int) \<longleftrightarrow> True"
 25.1263 +  "HOL.equal 0 (Pos l) \<longleftrightarrow> False"
 25.1264 +  "HOL.equal 0 (Neg l) \<longleftrightarrow> False"
 25.1265 +  "HOL.equal (Pos k) 0 \<longleftrightarrow> False"
 25.1266 +  "HOL.equal (Pos k) (Pos l) \<longleftrightarrow> HOL.equal k l"
 25.1267 +  "HOL.equal (Pos k) (Neg l) \<longleftrightarrow> False"
 25.1268 +  "HOL.equal (Neg k) 0 \<longleftrightarrow> False"
 25.1269 +  "HOL.equal (Neg k) (Pos l) \<longleftrightarrow> False"
 25.1270 +  "HOL.equal (Neg k) (Neg l) \<longleftrightarrow> HOL.equal k l"
 25.1271 +  by (auto simp add: equal)
 25.1272  
 25.1273 -lemma eq_int_code [code]:
 25.1274 -  "HOL.equal Int.Pls Int.Pls \<longleftrightarrow> True"
 25.1275 -  "HOL.equal Int.Pls Int.Min \<longleftrightarrow> False"
 25.1276 -  "HOL.equal Int.Pls (Int.Bit0 k2) \<longleftrightarrow> HOL.equal Int.Pls k2"
 25.1277 -  "HOL.equal Int.Pls (Int.Bit1 k2) \<longleftrightarrow> False"
 25.1278 -  "HOL.equal Int.Min Int.Pls \<longleftrightarrow> False"
 25.1279 -  "HOL.equal Int.Min Int.Min \<longleftrightarrow> True"
 25.1280 -  "HOL.equal Int.Min (Int.Bit0 k2) \<longleftrightarrow> False"
 25.1281 -  "HOL.equal Int.Min (Int.Bit1 k2) \<longleftrightarrow> HOL.equal Int.Min k2"
 25.1282 -  "HOL.equal (Int.Bit0 k1) Int.Pls \<longleftrightarrow> HOL.equal k1 Int.Pls"
 25.1283 -  "HOL.equal (Int.Bit1 k1) Int.Pls \<longleftrightarrow> False"
 25.1284 -  "HOL.equal (Int.Bit0 k1) Int.Min \<longleftrightarrow> False"
 25.1285 -  "HOL.equal (Int.Bit1 k1) Int.Min \<longleftrightarrow> HOL.equal k1 Int.Min"
 25.1286 -  "HOL.equal (Int.Bit0 k1) (Int.Bit0 k2) \<longleftrightarrow> HOL.equal k1 k2"
 25.1287 -  "HOL.equal (Int.Bit0 k1) (Int.Bit1 k2) \<longleftrightarrow> False"
 25.1288 -  "HOL.equal (Int.Bit1 k1) (Int.Bit0 k2) \<longleftrightarrow> False"
 25.1289 -  "HOL.equal (Int.Bit1 k1) (Int.Bit1 k2) \<longleftrightarrow> HOL.equal k1 k2"
 25.1290 -  unfolding equal_eq by simp_all
 25.1291 -
 25.1292 -lemma eq_int_refl [code nbe]:
 25.1293 +lemma equal_int_refl [code nbe]:
 25.1294    "HOL.equal (k::int) k \<longleftrightarrow> True"
 25.1295 -  by (rule equal_refl)
 25.1296 -
 25.1297 -lemma less_eq_number_of_int_code [code]:
 25.1298 -  "(number_of k \<Colon> int) \<le> number_of l \<longleftrightarrow> k \<le> l"
 25.1299 -  unfolding number_of_is_id ..
 25.1300 +  by (fact equal_refl)
 25.1301  
 25.1302  lemma less_eq_int_code [code]:
 25.1303 -  "Int.Pls \<le> Int.Pls \<longleftrightarrow> True"
 25.1304 -  "Int.Pls \<le> Int.Min \<longleftrightarrow> False"
 25.1305 -  "Int.Pls \<le> Int.Bit0 k \<longleftrightarrow> Int.Pls \<le> k"
 25.1306 -  "Int.Pls \<le> Int.Bit1 k \<longleftrightarrow> Int.Pls \<le> k"
 25.1307 -  "Int.Min \<le> Int.Pls \<longleftrightarrow> True"
 25.1308 -  "Int.Min \<le> Int.Min \<longleftrightarrow> True"
 25.1309 -  "Int.Min \<le> Int.Bit0 k \<longleftrightarrow> Int.Min < k"
 25.1310 -  "Int.Min \<le> Int.Bit1 k \<longleftrightarrow> Int.Min \<le> k"
 25.1311 -  "Int.Bit0 k \<le> Int.Pls \<longleftrightarrow> k \<le> Int.Pls"
 25.1312 -  "Int.Bit1 k \<le> Int.Pls \<longleftrightarrow> k < Int.Pls"
 25.1313 -  "Int.Bit0 k \<le> Int.Min \<longleftrightarrow> k \<le> Int.Min"
 25.1314 -  "Int.Bit1 k \<le> Int.Min \<longleftrightarrow> k \<le> Int.Min"
 25.1315 -  "Int.Bit0 k1 \<le> Int.Bit0 k2 \<longleftrightarrow> k1 \<le> k2"
 25.1316 -  "Int.Bit0 k1 \<le> Int.Bit1 k2 \<longleftrightarrow> k1 \<le> k2"
 25.1317 -  "Int.Bit1 k1 \<le> Int.Bit0 k2 \<longleftrightarrow> k1 < k2"
 25.1318 -  "Int.Bit1 k1 \<le> Int.Bit1 k2 \<longleftrightarrow> k1 \<le> k2"
 25.1319 +  "0 \<le> (0::int) \<longleftrightarrow> True"
 25.1320 +  "0 \<le> Pos l \<longleftrightarrow> True"
 25.1321 +  "0 \<le> Neg l \<longleftrightarrow> False"
 25.1322 +  "Pos k \<le> 0 \<longleftrightarrow> False"
 25.1323 +  "Pos k \<le> Pos l \<longleftrightarrow> k \<le> l"
 25.1324 +  "Pos k \<le> Neg l \<longleftrightarrow> False"
 25.1325 +  "Neg k \<le> 0 \<longleftrightarrow> True"
 25.1326 +  "Neg k \<le> Pos l \<longleftrightarrow> True"
 25.1327 +  "Neg k \<le> Neg l \<longleftrightarrow> l \<le> k"
 25.1328    by simp_all
 25.1329  
 25.1330 -lemma less_number_of_int_code [code]:
 25.1331 -  "(number_of k \<Colon> int) < number_of l \<longleftrightarrow> k < l"
 25.1332 -  unfolding number_of_is_id ..
 25.1333 -
 25.1334  lemma less_int_code [code]:
 25.1335 -  "Int.Pls < Int.Pls \<longleftrightarrow> False"
 25.1336 -  "Int.Pls < Int.Min \<longleftrightarrow> False"
 25.1337 -  "Int.Pls < Int.Bit0 k \<longleftrightarrow> Int.Pls < k"
 25.1338 -  "Int.Pls < Int.Bit1 k \<longleftrightarrow> Int.Pls \<le> k"
 25.1339 -  "Int.Min < Int.Pls \<longleftrightarrow> True"
 25.1340 -  "Int.Min < Int.Min \<longleftrightarrow> False"
 25.1341 -  "Int.Min < Int.Bit0 k \<longleftrightarrow> Int.Min < k"
 25.1342 -  "Int.Min < Int.Bit1 k \<longleftrightarrow> Int.Min < k"
 25.1343 -  "Int.Bit0 k < Int.Pls \<longleftrightarrow> k < Int.Pls"
 25.1344 -  "Int.Bit1 k < Int.Pls \<longleftrightarrow> k < Int.Pls"
 25.1345 -  "Int.Bit0 k < Int.Min \<longleftrightarrow> k \<le> Int.Min"
 25.1346 -  "Int.Bit1 k < Int.Min \<longleftrightarrow> k < Int.Min"
 25.1347 -  "Int.Bit0 k1 < Int.Bit0 k2 \<longleftrightarrow> k1 < k2"
 25.1348 -  "Int.Bit0 k1 < Int.Bit1 k2 \<longleftrightarrow> k1 \<le> k2"
 25.1349 -  "Int.Bit1 k1 < Int.Bit0 k2 \<longleftrightarrow> k1 < k2"
 25.1350 -  "Int.Bit1 k1 < Int.Bit1 k2 \<longleftrightarrow> k1 < k2"
 25.1351 +  "0 < (0::int) \<longleftrightarrow> False"
 25.1352 +  "0 < Pos l \<longleftrightarrow> True"
 25.1353 +  "0 < Neg l \<longleftrightarrow> False"
 25.1354 +  "Pos k < 0 \<longleftrightarrow> False"
 25.1355 +  "Pos k < Pos l \<longleftrightarrow> k < l"
 25.1356 +  "Pos k < Neg l \<longleftrightarrow> False"
 25.1357 +  "Neg k < 0 \<longleftrightarrow> True"
 25.1358 +  "Neg k < Pos l \<longleftrightarrow> True"
 25.1359 +  "Neg k < Neg l \<longleftrightarrow> l < k"
 25.1360    by simp_all
 25.1361  
 25.1362 -definition
 25.1363 -  nat_aux :: "int \<Rightarrow> nat \<Rightarrow> nat" where
 25.1364 -  "nat_aux i n = nat i + n"
 25.1365 -
 25.1366 -lemma [code]:
 25.1367 -  "nat_aux i n = (if i \<le> 0 then n else nat_aux (i - 1) (Suc n))"  -- {* tail recursive *}
 25.1368 -  by (auto simp add: nat_aux_def nat_eq_iff linorder_not_le order_less_imp_le
 25.1369 -    dest: zless_imp_add1_zle)
 25.1370 +lemma nat_numeral [simp, code_abbrev]:
 25.1371 +  "nat (numeral k) = numeral k"
 25.1372 +  by (simp add: nat_eq_iff)
 25.1373  
 25.1374 -lemma [code]: "nat i = nat_aux i 0"
 25.1375 -  by (simp add: nat_aux_def)
 25.1376 -
 25.1377 -hide_const (open) nat_aux
 25.1378 +lemma nat_code [code]:
 25.1379 +  "nat (Int.Neg k) = 0"
 25.1380 +  "nat 0 = 0"
 25.1381 +  "nat (Int.Pos k) = nat_of_num k"
 25.1382 +  by (simp_all add: nat_of_num_numeral nat_numeral)
 25.1383  
 25.1384 -lemma zero_is_num_zero [code, code_unfold]:
 25.1385 -  "(0\<Colon>int) = Numeral0" 
 25.1386 -  by simp
 25.1387 +lemma (in ring_1) of_int_code [code]:
 25.1388 +  "of_int (Int.Neg k) = neg_numeral k"
 25.1389 +  "of_int 0 = 0"
 25.1390 +  "of_int (Int.Pos k) = numeral k"
 25.1391 +  by simp_all
 25.1392  
 25.1393 -lemma one_is_num_one [code, code_unfold]:
 25.1394 -  "(1\<Colon>int) = Numeral1" 
 25.1395 -  by simp
 25.1396 +
 25.1397 +text {* Serializer setup *}
 25.1398  
 25.1399  code_modulename SML
 25.1400    Int Arith
 25.1401 @@ -2345,7 +1719,7 @@
 25.1402  
 25.1403  quickcheck_params [default_type = int]
 25.1404  
 25.1405 -hide_const (open) Pls Min Bit0 Bit1 succ pred
 25.1406 +hide_const (open) Pos Neg sub dup
 25.1407  
 25.1408  
 25.1409  subsection {* Legacy theorems *}
 25.1410 @@ -2378,3 +1752,4 @@
 25.1411  lemmas zpower_int = int_power [symmetric]
 25.1412  
 25.1413  end
 25.1414 +
    26.1 --- a/src/HOL/IsaMakefile	Sat Mar 24 16:27:04 2012 +0100
    26.2 +++ b/src/HOL/IsaMakefile	Sun Mar 25 20:15:39 2012 +0200
    26.3 @@ -195,6 +195,7 @@
    26.4    Meson.thy \
    26.5    Metis.thy \
    26.6    Nat.thy \
    26.7 +  Num.thy \
    26.8    Option.thy \
    26.9    Orderings.thy \
   26.10    Partial_Function.thy \
   26.11 @@ -341,7 +342,6 @@
   26.12    Tools/Nitpick/nitpick_util.ML \
   26.13    Tools/numeral.ML \
   26.14    Tools/numeral_simprocs.ML \
   26.15 -  Tools/numeral_syntax.ML \
   26.16    Tools/Predicate_Compile/core_data.ML \
   26.17    Tools/Predicate_Compile/mode_inference.ML \
   26.18    Tools/Predicate_Compile/predicate_compile_aux.ML \
   26.19 @@ -444,24 +444,25 @@
   26.20    Library/Bit.thy Library/Boolean_Algebra.thy Library/Cardinality.thy	\
   26.21    Library/Char_nat.thy Library/Code_Char.thy Library/Code_Char_chr.thy	\
   26.22    Library/Code_Char_ord.thy Library/Code_Integer.thy			\
   26.23 -  Library/Code_Natural.thy Library/Code_Prolog.thy			\
   26.24 +  Library/Code_Nat.thy Library/Code_Natural.thy				\
   26.25 +  Library/Efficient_Nat.thy Library/Code_Prolog.thy			\
   26.26    Library/Code_Real_Approx_By_Float.thy					\
   26.27    Tools/Predicate_Compile/code_prolog.ML Library/ContNotDenum.thy	\
   26.28    Library/Cset.thy Library/Cset_Monad.thy Library/Continuity.thy	\
   26.29    Library/Convex.thy Library/Countable.thy				\
   26.30 +  Library/Dlist.thy Library/Dlist_Cset.thy Library/Eval_Witness.thy	\
   26.31    Library/DAList.thy Library/Dlist.thy Library/Dlist_Cset.thy 		\
   26.32 -  Library/Efficient_Nat.thy Library/Eval_Witness.thy			\
   26.33 +  Library/Eval_Witness.thy						\
   26.34    Library/Extended_Real.thy Library/Extended_Nat.thy Library/Float.thy	\
   26.35    Library/Formal_Power_Series.thy Library/Fraction_Field.thy		\
   26.36    Library/FrechetDeriv.thy Library/Cset.thy Library/FuncSet.thy		\
   26.37 -  Library/Function_Algebras.thy						\
   26.38 -  Library/Fundamental_Theorem_Algebra.thy Library/Glbs.thy		\
   26.39 -  Library/Indicator_Function.thy Library/Infinite_Set.thy		\
   26.40 -  Library/Inner_Product.thy Library/Kleene_Algebra.thy			\
   26.41 -  Library/LaTeXsugar.thy Library/Lattice_Algebras.thy			\
   26.42 -  Library/Lattice_Syntax.thy Library/Library.thy Library/List_Cset.thy	\
   26.43 -  Library/List_Prefix.thy Library/List_lexord.thy Library/Mapping.thy	\
   26.44 -  Library/Monad_Syntax.thy						\
   26.45 +  Library/Function_Algebras.thy Library/Fundamental_Theorem_Algebra.thy	\
   26.46 +  Library/Glbs.thy Library/Indicator_Function.thy			\
   26.47 +  Library/Infinite_Set.thy Library/Inner_Product.thy			\
   26.48 +  Library/Kleene_Algebra.thy Library/LaTeXsugar.thy			\
   26.49 +  Library/Lattice_Algebras.thy Library/Lattice_Syntax.thy		\
   26.50 +  Library/Library.thy Library/List_Cset.thy Library/List_Prefix.thy	\
   26.51 +  Library/List_lexord.thy Library/Mapping.thy Library/Monad_Syntax.thy	\
   26.52    Library/Multiset.thy Library/Nat_Bijection.thy			\
   26.53    Library/Numeral_Type.thy Library/Old_Recdef.thy			\
   26.54    Library/OptionalSugar.thy Library/Order_Relation.thy			\
   26.55 @@ -479,7 +480,7 @@
   26.56    Library/State_Monad.thy Library/Ramsey.thy				\
   26.57    Library/Reflection.thy Library/Sublist_Order.thy			\
   26.58    Library/Sum_of_Squares.thy Library/Sum_of_Squares/sos_wrapper.ML	\
   26.59 -  Library/Sum_of_Squares/sum_of_squares.ML				\
   26.60 +  Library/Sum_of_Squares/sum_of_squares.ML Library/Target_Numeral.thy	\
   26.61    Library/Transitive_Closure_Table.thy Library/Univ_Poly.thy		\
   26.62    Library/Wfrec.thy Library/While_Combinator.thy Library/Zorn.thy	\
   26.63    $(SRC)/Tools/adhoc_overloading.ML Library/positivstellensatz.ML	\
   26.64 @@ -758,11 +759,11 @@
   26.65  
   26.66  HOL-Library-Codegenerator_Test: HOL-Library $(LOG)/HOL-Library-Codegenerator_Test.gz
   26.67  
   26.68 -$(LOG)/HOL-Library-Codegenerator_Test.gz: $(OUT)/HOL-Library		\
   26.69 -  Codegenerator_Test/ROOT.ML 						\
   26.70 -  Codegenerator_Test/Candidates.thy					\
   26.71 -  Codegenerator_Test/Candidates_Pretty.thy				\
   26.72 -  Codegenerator_Test/Generate.thy					\
   26.73 +$(LOG)/HOL-Library-Codegenerator_Test.gz: $(OUT)/HOL-Library \
   26.74 +  Codegenerator_Test/ROOT.ML \
   26.75 +  Codegenerator_Test/Candidates.thy \
   26.76 +  Codegenerator_Test/Candidates_Pretty.thy \
   26.77 +  Codegenerator_Test/Generate.thy \
   26.78    Codegenerator_Test/Generate_Pretty.thy
   26.79  	@$(ISABELLE_TOOL) usedir -d false -g false -i false $(OUT)/HOL-Library Codegenerator_Test
   26.80  
   26.81 @@ -920,6 +921,10 @@
   26.82  HOL-Imperative_HOL: HOL $(LOG)/HOL-Imperative_HOL.gz
   26.83  
   26.84  $(LOG)/HOL-Imperative_HOL.gz: $(OUT)/HOL \
   26.85 +  Library/Code_Integer.thy \
   26.86 +  Library/Code_Nat.thy \
   26.87 +  Library/Code_Natural.thy \
   26.88 +  Library/Efficient_Nat.thy \
   26.89    Imperative_HOL/Array.thy \
   26.90    Imperative_HOL/Heap.thy \
   26.91    Imperative_HOL/Heap_Monad.thy \
   26.92 @@ -943,6 +948,10 @@
   26.93  HOL-Decision_Procs: HOL $(LOG)/HOL-Decision_Procs.gz
   26.94  
   26.95  $(LOG)/HOL-Decision_Procs.gz: $(OUT)/HOL \
   26.96 +  Library/Code_Integer.thy \
   26.97 +  Library/Code_Nat.thy \
   26.98 +  Library/Code_Natural.thy \
   26.99 +  Library/Efficient_Nat.thy \
  26.100    Decision_Procs/Approximation.thy \
  26.101    Decision_Procs/Commutative_Ring.thy \
  26.102    Decision_Procs/Commutative_Ring_Complete.thy \
  26.103 @@ -991,9 +1000,12 @@
  26.104  HOL-Proofs-Extraction: HOL-Proofs $(LOG)/HOL-Proofs-Extraction.gz
  26.105  
  26.106  $(LOG)/HOL-Proofs-Extraction.gz: $(OUT)/HOL-Proofs		\
  26.107 -  Library/Efficient_Nat.thy Proofs/Extraction/Euclid.thy	\
  26.108 +  Library/Code_Integer.thy Library/Code_Nat.thy			\
  26.109 +  Library/Code_Natural.thy Library/Efficient_Nat.thy		\
  26.110 +  Proofs/Extraction/Euclid.thy					\
  26.111    Proofs/Extraction/Greatest_Common_Divisor.thy			\
  26.112 -  Proofs/Extraction/Higman.thy Proofs/Extraction/Higman_Extraction.thy	\
  26.113 +  Proofs/Extraction/Higman.thy					\
  26.114 +  Proofs/Extraction/Higman_Extraction.thy			\
  26.115    Proofs/Extraction/Pigeonhole.thy				\
  26.116    Proofs/Extraction/QuotRem.thy Proofs/Extraction/ROOT.ML	\
  26.117    Proofs/Extraction/Util.thy Proofs/Extraction/Warshall.thy	\
  26.118 @@ -1113,15 +1125,17 @@
  26.119  HOL-ex: HOL $(LOG)/HOL-ex.gz
  26.120  
  26.121  $(LOG)/HOL-ex.gz: $(OUT)/HOL Decision_Procs/Commutative_Ring.thy	\
  26.122 +  Library/Code_Integer.thy Library/Code_Nat.thy				\
  26.123 +  Library/Code_Natural.thy Library/Efficient_Nat.thy			\
  26.124    Number_Theory/Primes.thy ex/Abstract_NAT.thy ex/Antiquote.thy		\
  26.125    ex/Arith_Examples.thy ex/Arithmetic_Series_Complex.thy ex/BT.thy	\
  26.126    ex/BinEx.thy ex/Binary.thy ex/Birthday_Paradox.thy ex/CTL.thy		\
  26.127    ex/Case_Product.thy ex/Chinese.thy ex/Classical.thy			\
  26.128 -  ex/Coercion_Examples.thy ex/Coherent.thy				\
  26.129 -  ex/Dedekind_Real.thy ex/Efficient_Nat_examples.thy			\
  26.130 +  ex/Code_Nat_examples.thy						\
  26.131 +  ex/Coercion_Examples.thy ex/Coherent.thy ex/Dedekind_Real.thy		\
  26.132    ex/Eval_Examples.thy ex/Executable_Relation.thy ex/Fundefs.thy	\
  26.133    ex/Gauge_Integration.thy ex/Groebner_Examples.thy ex/Guess.thy	\
  26.134 -  ex/HarmonicSeries.thy ex/Hebrew.thy ex/Hex_Bin_Examples.thy 		\
  26.135 +  ex/HarmonicSeries.thy ex/Hebrew.thy ex/Hex_Bin_Examples.thy		\
  26.136    ex/Higher_Order_Logic.thy ex/Iff_Oracle.thy ex/Induction_Schema.thy	\
  26.137    ex/Interpretation_with_Defs.thy ex/Intuitionistic.thy			\
  26.138    ex/Lagrange.thy ex/List_to_Set_Comprehension_Examples.thy		\
    27.1 --- a/src/HOL/Library/BigO.thy	Sat Mar 24 16:27:04 2012 +0100
    27.2 +++ b/src/HOL/Library/BigO.thy	Sun Mar 25 20:15:39 2012 +0200
    27.3 @@ -132,7 +132,6 @@
    27.4    apply (simp add: abs_triangle_ineq)
    27.5    apply (simp add: order_less_le)
    27.6    apply (rule mult_nonneg_nonneg)
    27.7 -  apply (rule add_nonneg_nonneg)
    27.8    apply auto
    27.9    apply (rule_tac x = "%n. if (abs (f n)) <  abs (g n) then x n else 0" 
   27.10       in exI)
   27.11 @@ -150,11 +149,8 @@
   27.12    apply (rule abs_triangle_ineq)
   27.13    apply (simp add: order_less_le)
   27.14    apply (rule mult_nonneg_nonneg)
   27.15 -  apply (rule add_nonneg_nonneg)
   27.16 -  apply (erule order_less_imp_le)+
   27.17 +  apply (erule order_less_imp_le)
   27.18    apply simp
   27.19 -  apply (rule ext)
   27.20 -  apply (auto simp add: if_splits linorder_not_le)
   27.21    done
   27.22  
   27.23  lemma bigo_plus_subset2 [intro]: "A <= O(f) ==> B <= O(f) ==> A \<oplus> B <= O(f)"
    28.1 --- a/src/HOL/Library/Binomial.thy	Sat Mar 24 16:27:04 2012 +0100
    28.2 +++ b/src/HOL/Library/Binomial.thy	Sun Mar 25 20:15:39 2012 +0200
    28.3 @@ -350,7 +350,7 @@
    28.4      have eq: "(- (1\<Colon>'a)) ^ n = setprod (\<lambda>i. - 1) {0 .. n - 1}"
    28.5        by auto
    28.6      from n0 have ?thesis 
    28.7 -      by (simp add: pochhammer_def gbinomial_def field_simps eq setprod_timesf[symmetric])}
    28.8 +      by (simp add: pochhammer_def gbinomial_def field_simps eq setprod_timesf[symmetric] del: minus_one) (* FIXME: del: minus_one *)}
    28.9    ultimately show ?thesis by blast
   28.10  qed
   28.11  
   28.12 @@ -417,8 +417,8 @@
   28.13      from eq[symmetric]
   28.14      have ?thesis using kn
   28.15        apply (simp add: binomial_fact[OF kn, where ?'a = 'a] 
   28.16 -        gbinomial_pochhammer field_simps pochhammer_Suc_setprod)
   28.17 -      apply (simp add: pochhammer_Suc_setprod fact_altdef_nat h of_nat_setprod setprod_timesf[symmetric] eq' del: One_nat_def power_Suc)
   28.18 +        gbinomial_pochhammer field_simps pochhammer_Suc_setprod del: minus_one)
   28.19 +      apply (simp add: pochhammer_Suc_setprod fact_altdef_nat h of_nat_setprod setprod_timesf[symmetric] eq' del: One_nat_def power_Suc del: minus_one)
   28.20        unfolding setprod_Un_disjoint[OF th0, unfolded eq3, of "of_nat:: nat \<Rightarrow> 'a"] eq[unfolded h]
   28.21        unfolding mult_assoc[symmetric] 
   28.22        unfolding setprod_timesf[symmetric]
    29.1 --- a/src/HOL/Library/Bit.thy	Sat Mar 24 16:27:04 2012 +0100
    29.2 +++ b/src/HOL/Library/Bit.thy	Sun Mar 25 20:15:39 2012 +0200
    29.3 @@ -96,27 +96,18 @@
    29.4  
    29.5  subsection {* Numerals at type @{typ bit} *}
    29.6  
    29.7 -instantiation bit :: number_ring
    29.8 -begin
    29.9 -
   29.10 -definition number_of_bit_def:
   29.11 -  "(number_of w :: bit) = of_int w"
   29.12 -
   29.13 -instance proof
   29.14 -qed (rule number_of_bit_def)
   29.15 -
   29.16 -end
   29.17 -
   29.18  text {* All numerals reduce to either 0 or 1. *}
   29.19  
   29.20  lemma bit_minus1 [simp]: "-1 = (1 :: bit)"
   29.21 -  by (simp only: number_of_Min uminus_bit_def)
   29.22 +  by (simp only: minus_one [symmetric] uminus_bit_def)
   29.23 +
   29.24 +lemma bit_neg_numeral [simp]: "(neg_numeral w :: bit) = numeral w"
   29.25 +  by (simp only: neg_numeral_def uminus_bit_def)
   29.26  
   29.27 -lemma bit_number_of_even [simp]: "number_of (Int.Bit0 w) = (0 :: bit)"
   29.28 -  by (simp only: number_of_Bit0 add_0_left bit_add_self)
   29.29 +lemma bit_numeral_even [simp]: "numeral (Num.Bit0 w) = (0 :: bit)"
   29.30 +  by (simp only: numeral_Bit0 bit_add_self)
   29.31  
   29.32 -lemma bit_number_of_odd [simp]: "number_of (Int.Bit1 w) = (1 :: bit)"
   29.33 -  by (simp only: number_of_Bit1 add_assoc bit_add_self
   29.34 -                 monoid_add_class.add_0_right)
   29.35 +lemma bit_numeral_odd [simp]: "numeral (Num.Bit1 w) = (1 :: bit)"
   29.36 +  by (simp only: numeral_Bit1 bit_add_self add_0_left)
   29.37  
   29.38  end
    30.1 --- a/src/HOL/Library/Cardinality.thy	Sat Mar 24 16:27:04 2012 +0100
    30.2 +++ b/src/HOL/Library/Cardinality.thy	Sun Mar 25 20:15:39 2012 +0200
    30.3 @@ -5,7 +5,7 @@
    30.4  header {* Cardinality of types *}
    30.5  
    30.6  theory Cardinality
    30.7 -imports Main
    30.8 +imports "~~/src/HOL/Main"
    30.9  begin
   30.10  
   30.11  subsection {* Preliminary lemmas *}
    31.1 --- a/src/HOL/Library/Code_Integer.thy	Sat Mar 24 16:27:04 2012 +0100
    31.2 +++ b/src/HOL/Library/Code_Integer.thy	Sun Mar 25 20:15:39 2012 +0200
    31.3 @@ -9,6 +9,43 @@
    31.4  begin
    31.5  
    31.6  text {*
    31.7 +  Representation-ignorant code equations for conversions.
    31.8 +*}
    31.9 +
   31.10 +lemma nat_code [code]:
   31.11 +  "nat k = (if k \<le> 0 then 0 else
   31.12 +     let
   31.13 +       (l, j) = divmod_int k 2;
   31.14 +       l' = 2 * nat l
   31.15 +     in if j = 0 then l' else Suc l')"
   31.16 +proof -
   31.17 +  have "2 = nat 2" by simp
   31.18 +  show ?thesis
   31.19 +    apply (auto simp add: Let_def divmod_int_mod_div not_le
   31.20 +     nat_div_distrib nat_mult_distrib mult_div_cancel mod_2_not_eq_zero_eq_one_int)
   31.21 +    apply (unfold `2 = nat 2`)
   31.22 +    apply (subst nat_mod_distrib [symmetric])
   31.23 +    apply simp_all
   31.24 +  done
   31.25 +qed
   31.26 +
   31.27 +lemma (in ring_1) of_int_code:
   31.28 +  "of_int k = (if k = 0 then 0
   31.29 +     else if k < 0 then - of_int (- k)
   31.30 +     else let
   31.31 +       (l, j) = divmod_int k 2;
   31.32 +       l' = 2 * of_int l
   31.33 +     in if j = 0 then l' else l' + 1)"
   31.34 +proof -
   31.35 +  from mod_div_equality have *: "of_int k = of_int (k div 2 * 2 + k mod 2)" by simp
   31.36 +  show ?thesis
   31.37 +    by (simp add: Let_def divmod_int_mod_div mod_2_not_eq_zero_eq_one_int
   31.38 +      of_int_add [symmetric]) (simp add: * mult_commute)
   31.39 +qed
   31.40 +
   31.41 +declare of_int_code [code]
   31.42 +
   31.43 +text {*
   31.44    HOL numeral expressions are mapped to integer literals
   31.45    in target languages, using predefined target language
   31.46    operations for abstract integer operations.
   31.47 @@ -24,42 +61,21 @@
   31.48  code_instance int :: equal
   31.49    (Haskell -)
   31.50  
   31.51 +code_const "0::int"
   31.52 +  (SML "0")
   31.53 +  (OCaml "Big'_int.zero'_big'_int")
   31.54 +  (Haskell "0")
   31.55 +  (Scala "BigInt(0)")
   31.56 +
   31.57  setup {*
   31.58 -  fold (Numeral.add_code @{const_name number_int_inst.number_of_int}
   31.59 -    true Code_Printer.literal_numeral) ["SML", "OCaml", "Haskell", "Scala"]
   31.60 +  fold (Numeral.add_code @{const_name Int.Pos}
   31.61 +    false Code_Printer.literal_numeral) ["SML", "OCaml", "Haskell", "Scala"]
   31.62  *}
   31.63  
   31.64 -code_const "Int.Pls" and "Int.Min" and "Int.Bit0" and "Int.Bit1"
   31.65 -  (SML "raise/ Fail/ \"Pls\""
   31.66 -     and "raise/ Fail/ \"Min\""
   31.67 -     and "!((_);/ raise/ Fail/ \"Bit0\")"
   31.68 -     and "!((_);/ raise/ Fail/ \"Bit1\")")
   31.69 -  (OCaml "failwith/ \"Pls\""
   31.70 -     and "failwith/ \"Min\""
   31.71 -     and "!((_);/ failwith/ \"Bit0\")"
   31.72 -     and "!((_);/ failwith/ \"Bit1\")")
   31.73 -  (Haskell "error/ \"Pls\""
   31.74 -     and "error/ \"Min\""
   31.75 -     and "error/ \"Bit0\""
   31.76 -     and "error/ \"Bit1\"")
   31.77 -  (Scala "!error(\"Pls\")"
   31.78 -     and "!error(\"Min\")"
   31.79 -     and "!error(\"Bit0\")"
   31.80 -     and "!error(\"Bit1\")")
   31.81 -
   31.82 -code_const Int.pred
   31.83 -  (SML "IntInf.- ((_), 1)")
   31.84 -  (OCaml "Big'_int.pred'_big'_int")
   31.85 -  (Haskell "!(_/ -/ 1)")
   31.86 -  (Scala "!(_ -/ 1)")
   31.87 -  (Eval "!(_/ -/ 1)")
   31.88 -
   31.89 -code_const Int.succ
   31.90 -  (SML "IntInf.+ ((_), 1)")
   31.91 -  (OCaml "Big'_int.succ'_big'_int")
   31.92 -  (Haskell "!(_/ +/ 1)")
   31.93 -  (Scala "!(_ +/ 1)")
   31.94 -  (Eval "!(_/ +/ 1)")
   31.95 +setup {*
   31.96 +  fold (Numeral.add_code @{const_name Int.Neg}
   31.97 +    true Code_Printer.literal_numeral) ["SML", "OCaml", "Haskell", "Scala"]
   31.98 +*}
   31.99  
  31.100  code_const "op + \<Colon> int \<Rightarrow> int \<Rightarrow> int"
  31.101    (SML "IntInf.+ ((_), (_))")
  31.102 @@ -82,6 +98,19 @@
  31.103    (Scala infixl 7 "-")
  31.104    (Eval infixl 8 "-")
  31.105  
  31.106 +code_const Int.dup
  31.107 +  (SML "IntInf.*/ (2,/ (_))")
  31.108 +  (OCaml "Big'_int.mult'_big'_int/ 2")
  31.109 +  (Haskell "!(2 * _)")
  31.110 +  (Scala "!(2 * _)")
  31.111 +  (Eval "!(2 * _)")
  31.112 +
  31.113 +code_const Int.sub
  31.114 +  (SML "!(raise/ Fail/ \"sub\")")
  31.115 +  (OCaml "failwith/ \"sub\"")
  31.116 +  (Haskell "error/ \"sub\"")
  31.117 +  (Scala "!error(\"sub\")")
  31.118 +
  31.119  code_const "op * \<Colon> int \<Rightarrow> int \<Rightarrow> int"
  31.120    (SML "IntInf.* ((_), (_))")
  31.121    (OCaml "Big'_int.mult'_big'_int")
  31.122 @@ -124,9 +153,7 @@
  31.123    (Scala "!_.as'_BigInt")
  31.124    (Eval "_")
  31.125  
  31.126 -text {* Evaluation *}
  31.127 -
  31.128  code_const "Code_Evaluation.term_of \<Colon> int \<Rightarrow> term"
  31.129    (Eval "HOLogic.mk'_number/ HOLogic.intT")
  31.130  
  31.131 -end
  31.132 \ No newline at end of file
  31.133 +end
    32.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    32.2 +++ b/src/HOL/Library/Code_Nat.thy	Sun Mar 25 20:15:39 2012 +0200
    32.3 @@ -0,0 +1,258 @@
    32.4 +(*  Title:      HOL/Library/Code_Nat.thy
    32.5 +    Author:     Stefan Berghofer, Florian Haftmann, TU Muenchen
    32.6 +*)
    32.7 +
    32.8 +header {* Implementation of natural numbers as binary numerals *}
    32.9 +
   32.10 +theory Code_Nat
   32.11 +imports Main
   32.12 +begin
   32.13 +
   32.14 +text {*
   32.15 +  When generating code for functions on natural numbers, the
   32.16 +  canonical representation using @{term "0::nat"} and
   32.17 +  @{term Suc} is unsuitable for computations involving large
   32.18 +  numbers.  This theory refines the representation of
   32.19 +  natural numbers for code generation to use binary
   32.20 +  numerals, which do not grow linear in size but logarithmic.
   32.21 +*}
   32.22 +
   32.23 +subsection {* Representation *}
   32.24 +
   32.25 +lemma [code_abbrev]:
   32.26 +  "nat_of_num = numeral"
   32.27 +  by (fact nat_of_num_numeral)
   32.28 +
   32.29 +code_datatype "0::nat" nat_of_num
   32.30 +
   32.31 +lemma [code]:
   32.32 +  "num_of_nat 0 = Num.One"
   32.33 +  "num_of_nat (nat_of_num k) = k"
   32.34 +  by (simp_all add: nat_of_num_inverse)
   32.35 +
   32.36 +lemma [code]:
   32.37 +  "(1\<Colon>nat) = Numeral1"
   32.38 +  by simp
   32.39 +
   32.40 +lemma [code_abbrev]: "Numeral1 = (1\<Colon>nat)"
   32.41 +  by simp
   32.42 +
   32.43 +lemma [code]:
   32.44 +  "Suc n = n + 1"
   32.45 +  by simp
   32.46 +
   32.47 +
   32.48 +subsection {* Basic arithmetic *}
   32.49 +
   32.50 +lemma [code, code del]:
   32.51 +  "(plus :: nat \<Rightarrow> _) = plus" ..
   32.52 +
   32.53 +lemma plus_nat_code [code]:
   32.54 +  "nat_of_num k + nat_of_num l = nat_of_num (k + l)"
   32.55 +  "m + 0 = (m::nat)"
   32.56 +  "0 + n = (n::nat)"
   32.57 +  by (simp_all add: nat_of_num_numeral)
   32.58 +
   32.59 +text {* Bounded subtraction needs some auxiliary *}
   32.60 +
   32.61 +definition dup :: "nat \<Rightarrow> nat" where
   32.62 +  "dup n = n + n"
   32.63 +
   32.64 +lemma dup_code [code]:
   32.65 +  "dup 0 = 0"
   32.66 +  "dup (nat_of_num k) = nat_of_num (Num.Bit0 k)"
   32.67 +  unfolding Num_def by (simp_all add: dup_def numeral_Bit0)
   32.68 +
   32.69 +definition sub :: "num \<Rightarrow> num \<Rightarrow> nat option" where
   32.70 +  "sub k l = (if k \<ge> l then Some (numeral k - numeral l) else None)"
   32.71 +
   32.72 +lemma sub_code [code]:
   32.73 +  "sub Num.One Num.One = Some 0"
   32.74 +  "sub (Num.Bit0 m) Num.One = Some (nat_of_num (Num.BitM m))"
   32.75 +  "sub (Num.Bit1 m) Num.One = Some (nat_of_num (Num.Bit0 m))"
   32.76 +  "sub Num.One (Num.Bit0 n) = None"
   32.77 +  "sub Num.One (Num.Bit1 n) = None"
   32.78 +  "sub (Num.Bit0 m) (Num.Bit0 n) = Option.map dup (sub m n)"
   32.79 +  "sub (Num.Bit1 m) (Num.Bit1 n) = Option.map dup (sub m n)"
   32.80 +  "sub (Num.Bit1 m) (Num.Bit0 n) = Option.map (\<lambda>q. dup q + 1) (sub m n)"
   32.81 +  "sub (Num.Bit0 m) (Num.Bit1 n) = (case sub m n of None \<Rightarrow> None
   32.82 +     | Some q \<Rightarrow> if q = 0 then None else Some (dup q - 1))"
   32.83 +  apply (auto simp add: nat_of_num_numeral
   32.84 +    Num.dbl_def Num.dbl_inc_def Num.dbl_dec_def
   32.85 +    Let_def le_imp_diff_is_add BitM_plus_one sub_def dup_def)
   32.86 +  apply (simp_all add: sub_non_positive)
   32.87 +  apply (simp_all add: sub_non_negative [symmetric, where ?'a = int])
   32.88 +  done
   32.89 +
   32.90 +lemma [code, code del]:
   32.91 +  "(minus :: nat \<Rightarrow> _) = minus" ..
   32.92 +
   32.93 +lemma minus_nat_code [code]:
   32.94 +  "nat_of_num k - nat_of_num l = (case sub k l of None \<Rightarrow> 0 | Some j \<Rightarrow> j)"
   32.95 +  "m - 0 = (m::nat)"
   32.96 +  "0 - n = (0::nat)"
   32.97 +  by (simp_all add: nat_of_num_numeral sub_non_positive sub_def)
   32.98 +
   32.99 +lemma [code, code del]:
  32.100 +  "(times :: nat \<Rightarrow> _) = times" ..
  32.101 +
  32.102 +lemma times_nat_code [code]:
  32.103 +  "nat_of_num k * nat_of_num l = nat_of_num (k * l)"
  32.104 +  "m * 0 = (0::nat)"
  32.105 +  "0 * n = (0::nat)"
  32.106 +  by (simp_all add: nat_of_num_numeral)
  32.107 +
  32.108 +lemma [code, code del]:
  32.109 +  "(HOL.equal :: nat \<Rightarrow> _) = HOL.equal" ..
  32.110 +
  32.111 +lemma equal_nat_code [code]:
  32.112 +  "HOL.equal 0 (0::nat) \<longleftrightarrow> True"
  32.113 +  "HOL.equal 0 (nat_of_num l) \<longleftrightarrow> False"
  32.114 +  "HOL.equal (nat_of_num k) 0 \<longleftrightarrow> False"
  32.115 +  "HOL.equal (nat_of_num k) (nat_of_num l) \<longleftrightarrow> HOL.equal k l"
  32.116 +  by (simp_all add: nat_of_num_numeral equal)
  32.117 +
  32.118 +lemma equal_nat_refl [code nbe]:
  32.119 +  "HOL.equal (n::nat) n \<longleftrightarrow> True"
  32.120 +  by (rule equal_refl)
  32.121 +
  32.122 +lemma [code, code del]:
  32.123 +  "(less_eq :: nat \<Rightarrow> _) = less_eq" ..
  32.124 +
  32.125 +lemma less_eq_nat_code [code]:
  32.126 +  "0 \<le> (n::nat) \<longleftrightarrow> True"
  32.127 +  "nat_of_num k \<le> 0 \<longleftrightarrow> False"
  32.128 +  "nat_of_num k \<le> nat_of_num l \<longleftrightarrow> k \<le> l"
  32.129 +  by (simp_all add: nat_of_num_numeral)
  32.130 +
  32.131 +lemma [code, code del]:
  32.132 +  "(less :: nat \<Rightarrow> _) = less" ..
  32.133 +
  32.134 +lemma less_nat_code [code]:
  32.135 +  "(m::nat) < 0 \<longleftrightarrow> False"
  32.136 +  "0 < nat_of_num l \<longleftrightarrow> True"
  32.137 +  "nat_of_num k < nat_of_num l \<longleftrightarrow> k < l"
  32.138 +  by (simp_all add: nat_of_num_numeral)
  32.139 +
  32.140 +
  32.141 +subsection {* Conversions *}
  32.142 +
  32.143 +lemma [code, code del]:
  32.144 +  "of_nat = of_nat" ..
  32.145 +
  32.146 +lemma of_nat_code [code]:
  32.147 +  "of_nat 0 = 0"
  32.148 +  "of_nat (nat_of_num k) = numeral k"
  32.149 +  by (simp_all add: nat_of_num_numeral)
  32.150 +
  32.151 +
  32.152 +subsection {* Case analysis *}
  32.153 +
  32.154 +text {*
  32.155 +  Case analysis on natural numbers is rephrased using a conditional
  32.156 +  expression:
  32.157 +*}
  32.158 +
  32.159 +lemma [code, code_unfold]:
  32.160 +  "nat_case = (\<lambda>f g n. if n = 0 then f else g (n - 1))"
  32.161 +  by (auto simp add: fun_eq_iff dest!: gr0_implies_Suc)
  32.162 +
  32.163 +
  32.164 +subsection {* Preprocessors *}
  32.165 +
  32.166 +text {*
  32.167 +  The term @{term "Suc n"} is no longer a valid pattern.
  32.168 +  Therefore, all occurrences of this term in a position
  32.169 +  where a pattern is expected (i.e.~on the left-hand side of a recursion
  32.170 +  equation) must be eliminated.
  32.171 +  This can be accomplished by applying the following transformation rules:
  32.172 +*}
  32.173 +
  32.174 +lemma Suc_if_eq: "(\<And>n. f (Suc n) \<equiv> h n) \<Longrightarrow> f 0 \<equiv> g \<Longrightarrow>
  32.175 +  f n \<equiv> if n = 0 then g else h (n - 1)"
  32.176 +  by (rule eq_reflection) (cases n, simp_all)
  32.177 +
  32.178 +text {*
  32.179 +  The rules above are built into a preprocessor that is plugged into
  32.180 +  the code generator. Since the preprocessor for introduction rules
  32.181 +  does not know anything about modes, some of the modes that worked
  32.182 +  for the canonical representation of natural numbers may no longer work.
  32.183 +*}
  32.184 +
  32.185 +(*<*)
  32.186 +setup {*
  32.187 +let
  32.188 +
  32.189 +fun remove_suc thy thms =
  32.190 +  let
  32.191 +    val vname = singleton (Name.variant_list (map fst
  32.192 +      (fold (Term.add_var_names o Thm.full_prop_of) thms []))) "n";
  32.193 +    val cv = cterm_of thy (Var ((vname, 0), HOLogic.natT));
  32.194 +    fun lhs_of th = snd (Thm.dest_comb
  32.195 +      (fst (Thm.dest_comb (cprop_of th))));
  32.196 +    fun rhs_of th = snd (Thm.dest_comb (cprop_of th));
  32.197 +    fun find_vars ct = (case term_of ct of
  32.198 +        (Const (@{const_name Suc}, _) $ Var _) => [(cv, snd (Thm.dest_comb ct))]
  32.199 +      | _ $ _ =>
  32.200 +        let val (ct1, ct2) = Thm.dest_comb ct
  32.201 +        in 
  32.202 +          map (apfst (fn ct => Thm.apply ct ct2)) (find_vars ct1) @
  32.203 +          map (apfst (Thm.apply ct1)) (find_vars ct2)
  32.204 +        end
  32.205 +      | _ => []);
  32.206 +    val eqs = maps
  32.207 +      (fn th => map (pair th) (find_vars (lhs_of th))) thms;
  32.208 +    fun mk_thms (th, (ct, cv')) =
  32.209 +      let
  32.210 +        val th' =
  32.211 +          Thm.implies_elim
  32.212 +           (Conv.fconv_rule (Thm.beta_conversion true)
  32.213 +             (Drule.instantiate'
  32.214 +               [SOME (ctyp_of_term ct)] [SOME (Thm.lambda cv ct),
  32.215 +                 SOME (Thm.lambda cv' (rhs_of th)), NONE, SOME cv']
  32.216 +               @{thm Suc_if_eq})) (Thm.forall_intr cv' th)
  32.217 +      in
  32.218 +        case map_filter (fn th'' =>
  32.219 +            SOME (th'', singleton
  32.220 +              (Variable.trade (K (fn [th'''] => [th''' RS th']))
  32.221 +                (Variable.global_thm_context th'')) th'')
  32.222 +          handle THM _ => NONE) thms of
  32.223 +            [] => NONE
  32.224 +          | thps =>
  32.225 +              let val (ths1, ths2) = split_list thps
  32.226 +              in SOME (subtract Thm.eq_thm (th :: ths1) thms @ ths2) end
  32.227 +      end
  32.228 +  in get_first mk_thms eqs end;
  32.229 +
  32.230 +fun eqn_suc_base_preproc thy thms =
  32.231 +  let
  32.232 +    val dest = fst o Logic.dest_equals o prop_of;
  32.233 +    val contains_suc = exists_Const (fn (c, _) => c = @{const_name Suc});
  32.234 +  in
  32.235 +    if forall (can dest) thms andalso exists (contains_suc o dest) thms
  32.236 +      then thms |> perhaps_loop (remove_suc thy) |> (Option.map o map) Drule.zero_var_indexes
  32.237 +       else NONE
  32.238 +  end;
  32.239 +
  32.240 +val eqn_suc_preproc = Code_Preproc.simple_functrans eqn_suc_base_preproc;
  32.241 +
  32.242 +in
  32.243 +
  32.244 +  Code_Preproc.add_functrans ("eqn_Suc", eqn_suc_preproc)
  32.245 +
  32.246 +end;
  32.247 +*}
  32.248 +(*>*)
  32.249 +
  32.250 +code_modulename SML
  32.251 +  Code_Nat Arith
  32.252 +
  32.253 +code_modulename OCaml
  32.254 +  Code_Nat Arith
  32.255 +
  32.256 +code_modulename Haskell
  32.257 +  Code_Nat Arith
  32.258 +
  32.259 +hide_const (open) dup sub
  32.260 +
  32.261 +end
    33.1 --- a/src/HOL/Library/Code_Natural.thy	Sat Mar 24 16:27:04 2012 +0100
    33.2 +++ b/src/HOL/Library/Code_Natural.thy	Sun Mar 25 20:15:39 2012 +0200
    33.3 @@ -106,22 +106,26 @@
    33.4    (Scala "Natural")
    33.5  
    33.6  setup {*
    33.7 -  fold (Numeral.add_code @{const_name number_code_numeral_inst.number_of_code_numeral}
    33.8 +  fold (Numeral.add_code @{const_name Code_Numeral.Num}
    33.9      false Code_Printer.literal_alternative_numeral) ["Haskell", "Scala"]
   33.10  *}
   33.11  
   33.12  code_instance code_numeral :: equal
   33.13    (Haskell -)
   33.14  
   33.15 -code_const "op + \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral"
   33.16 +code_const "0::code_numeral"
   33.17 +  (Haskell "0")
   33.18 +  (Scala "Natural(0)")
   33.19 +
   33.20 +code_const "plus \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral"
   33.21    (Haskell infixl 6 "+")
   33.22    (Scala infixl 7 "+")
   33.23  
   33.24 -code_const "op - \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral"
   33.25 +code_const "minus \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral"
   33.26    (Haskell infixl 6 "-")
   33.27    (Scala infixl 7 "-")
   33.28  
   33.29 -code_const "op * \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral"
   33.30 +code_const "times \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral"
   33.31    (Haskell infixl 7 "*")
   33.32    (Scala infixl 8 "*")
   33.33  
   33.34 @@ -133,11 +137,11 @@
   33.35    (Haskell infix 4 "==")
   33.36    (Scala infixl 5 "==")
   33.37  
   33.38 -code_const "op \<le> \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> bool"
   33.39 +code_const "less_eq \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> bool"
   33.40    (Haskell infix 4 "<=")
   33.41    (Scala infixl 4 "<=")
   33.42  
   33.43 -code_const "op < \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> bool"
   33.44 +code_const "less \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> bool"
   33.45    (Haskell infix 4 "<")
   33.46    (Scala infixl 4 "<")
   33.47  
    34.1 --- a/src/HOL/Library/Code_Prolog.thy	Sat Mar 24 16:27:04 2012 +0100
    34.2 +++ b/src/HOL/Library/Code_Prolog.thy	Sun Mar 25 20:15:39 2012 +0200
    34.3 @@ -11,8 +11,10 @@
    34.4  
    34.5  section {* Setup for Numerals *}
    34.6  
    34.7 -setup {* Predicate_Compile_Data.ignore_consts [@{const_name number_of}] *}
    34.8 -setup {* Predicate_Compile_Data.keep_functions [@{const_name number_of}] *}
    34.9 +setup {* Predicate_Compile_Data.ignore_consts
   34.10 +  [@{const_name numeral}, @{const_name neg_numeral}] *}
   34.11 +
   34.12 +setup {* Predicate_Compile_Data.keep_functions
   34.13 +  [@{const_name numeral}, @{const_name neg_numeral}] *}
   34.14  
   34.15  end
   34.16 -
    35.1 --- a/src/HOL/Library/Code_Real_Approx_By_Float.thy	Sat Mar 24 16:27:04 2012 +0100
    35.2 +++ b/src/HOL/Library/Code_Real_Approx_By_Float.thy	Sun Mar 25 20:15:39 2012 +0200
    35.3 @@ -129,9 +129,23 @@
    35.4  lemma of_int_eq_real_of_int[code_unfold]: "of_int = real_of_int"
    35.5    unfolding real_of_int_def ..
    35.6  
    35.7 -hide_const (open) real_of_int
    35.8 +lemma [code_unfold del]:
    35.9 +  "0 \<equiv> (of_rat 0 :: real)"
   35.10 +  by simp
   35.11 +
   35.12 +lemma [code_unfold del]:
   35.13 +  "1 \<equiv> (of_rat 1 :: real)"
   35.14 +  by simp
   35.15  
   35.16 -declare number_of_real_code [code_unfold del]
   35.17 +lemma [code_unfold del]:
   35.18 +  "numeral k \<equiv> (of_rat (numeral k) :: real)"
   35.19 +  by simp
   35.20 +
   35.21 +lemma [code_unfold del]:
   35.22 +  "neg_numeral k \<equiv> (of_rat (neg_numeral k) :: real)"
   35.23 +  by simp
   35.24 +
   35.25 +hide_const (open) real_of_int
   35.26  
   35.27  notepad
   35.28  begin
    36.1 --- a/src/HOL/Library/Efficient_Nat.thy	Sat Mar 24 16:27:04 2012 +0100
    36.2 +++ b/src/HOL/Library/Efficient_Nat.thy	Sun Mar 25 20:15:39 2012 +0200
    36.3 @@ -5,175 +5,16 @@
    36.4  header {* Implementation of natural numbers by target-language integers *}
    36.5  
    36.6  theory Efficient_Nat
    36.7 -imports Code_Integer Main
    36.8 +imports Code_Nat Code_Integer Main
    36.9  begin
   36.10  
   36.11  text {*
   36.12 -  When generating code for functions on natural numbers, the
   36.13 -  canonical representation using @{term "0::nat"} and
   36.14 -  @{term Suc} is unsuitable for computations involving large
   36.15 -  numbers.  The efficiency of the generated code can be improved
   36.16 +  The efficiency of the generated code for natural numbers can be improved
   36.17    drastically by implementing natural numbers by target-language
   36.18    integers.  To do this, just include this theory.
   36.19  *}
   36.20  
   36.21 -subsection {* Basic arithmetic *}
   36.22 -
   36.23 -text {*
   36.24 -  Most standard arithmetic functions on natural numbers are implemented
   36.25 -  using their counterparts on the integers:
   36.26 -*}
   36.27 -
   36.28 -code_datatype number_nat_inst.number_of_nat
   36.29 -
   36.30 -lemma zero_nat_code [code, code_unfold]:
   36.31 -  "0 = (Numeral0 :: nat)"
   36.32 -  by simp
   36.33 -
   36.34 -lemma one_nat_code [code, code_unfold]:
   36.35 -  "1 = (Numeral1 :: nat)"
   36.36 -  by simp
   36.37 -
   36.38 -lemma Suc_code [code]:
   36.39 -  "Suc n = n + 1"
   36.40 -  by simp
   36.41 -
   36.42 -lemma plus_nat_code [code]:
   36.43 -  "n + m = nat (of_nat n + of_nat m)"
   36.44 -  by simp
   36.45 -
   36.46 -lemma minus_nat_code [code]:
   36.47 -  "n - m = nat (of_nat n - of_nat m)"
   36.48 -  by simp
   36.49 -
   36.50 -lemma times_nat_code [code]:
   36.51 -  "n * m = nat (of_nat n * of_nat m)"
   36.52 -  unfolding of_nat_mult [symmetric] by simp
   36.53 -
   36.54 -lemma divmod_nat_code [code]:
   36.55 -  "divmod_nat n m = map_pair nat nat (pdivmod (of_nat n) (of_nat m))"
   36.56 -  by (simp add: map_pair_def split_def pdivmod_def nat_div_distrib nat_mod_distrib divmod_nat_div_mod)
   36.57 -
   36.58 -lemma eq_nat_code [code]:
   36.59 -  "HOL.equal n m \<longleftrightarrow> HOL.equal (of_nat n \<Colon> int) (of_nat m)"
   36.60 -  by (simp add: equal)
   36.61 -
   36.62 -lemma eq_nat_refl [code nbe]:
   36.63 -  "HOL.equal (n::nat) n \<longleftrightarrow> True"
   36.64 -  by (rule equal_refl)
   36.65 -
   36.66 -lemma less_eq_nat_code [code]:
   36.67 -  "n \<le> m \<longleftrightarrow> (of_nat n \<Colon> int) \<le> of_nat m"
   36.68 -  by simp
   36.69 -
   36.70 -lemma less_nat_code [code]:
   36.71 -  "n < m \<longleftrightarrow> (of_nat n \<Colon> int) < of_nat m"
   36.72 -  by simp
   36.73 -
   36.74 -subsection {* Case analysis *}
   36.75 -
   36.76 -text {*
   36.77 -  Case analysis on natural numbers is rephrased using a conditional
   36.78 -  expression:
   36.79 -*}
   36.80 -
   36.81 -lemma [code, code_unfold]:
   36.82 -  "nat_case = (\<lambda>f g n. if n = 0 then f else g (n - 1))"
   36.83 -  by (auto simp add: fun_eq_iff dest!: gr0_implies_Suc)
   36.84 -
   36.85 -
   36.86 -subsection {* Preprocessors *}
   36.87 -
   36.88 -text {*
   36.89 -  In contrast to @{term "Suc n"}, the term @{term "n + (1::nat)"} is no longer
   36.90 -  a constructor term. Therefore, all occurrences of this term in a position
   36.91 -  where a pattern is expected (i.e.\ on the left-hand side of a recursion
   36.92 -  equation or in the arguments of an inductive relation in an introduction
   36.93 -  rule) must be eliminated.
   36.94 -  This can be accomplished by applying the following transformation rules:
   36.95 -*}
   36.96 -
   36.97 -lemma Suc_if_eq: "(\<And>n. f (Suc n) \<equiv> h n) \<Longrightarrow> f 0 \<equiv> g \<Longrightarrow>
   36.98 -  f n \<equiv> if n = 0 then g else h (n - 1)"
   36.99 -  by (rule eq_reflection) (cases n, simp_all)
  36.100 -
  36.101 -lemma Suc_clause: "(\<And>n. P n (Suc n)) \<Longrightarrow> n \<noteq> 0 \<Longrightarrow> P (n - 1) n"
  36.102 -  by (cases n) simp_all
  36.103 -
  36.104 -text {*
  36.105 -  The rules above are built into a preprocessor that is plugged into
  36.106 -  the code generator. Since the preprocessor for introduction rules
  36.107 -  does not know anything about modes, some of the modes that worked
  36.108 -  for the canonical representation of natural numbers may no longer work.
  36.109 -*}
  36.110 -
  36.111 -(*<*)
  36.112 -setup {*
  36.113 -let
  36.114 -
  36.115 -fun remove_suc thy thms =
  36.116 -  let
  36.117 -    val vname = singleton (Name.variant_list (map fst
  36.118 -      (fold (Term.add_var_names o Thm.full_prop_of) thms []))) "n";
  36.119 -    val cv = cterm_of thy (Var ((vname, 0), HOLogic.natT));
  36.120 -    fun lhs_of th = snd (Thm.dest_comb
  36.121 -      (fst (Thm.dest_comb (cprop_of th))));
  36.122 -    fun rhs_of th = snd (Thm.dest_comb (cprop_of th));
  36.123 -    fun find_vars ct = (case term_of ct of
  36.124 -        (Const (@{const_name Suc}, _) $ Var _) => [(cv, snd (Thm.dest_comb ct))]
  36.125 -      | _ $ _ =>
  36.126 -        let val (ct1, ct2) = Thm.dest_comb ct
  36.127 -        in 
  36.128 -          map (apfst (fn ct => Thm.apply ct ct2)) (find_vars ct1) @
  36.129 -          map (apfst (Thm.apply ct1)) (find_vars ct2)
  36.130 -        end
  36.131 -      | _ => []);
  36.132 -    val eqs = maps
  36.133 -      (fn th => map (pair th) (find_vars (lhs_of th))) thms;
  36.134 -    fun mk_thms (th, (ct, cv')) =
  36.135 -      let
  36.136 -        val th' =
  36.137 -          Thm.implies_elim
  36.138 -           (Conv.fconv_rule (Thm.beta_conversion true)
  36.139 -             (Drule.instantiate'
  36.140 -               [SOME (ctyp_of_term ct)] [SOME (Thm.lambda cv ct),
  36.141 -                 SOME (Thm.lambda cv' (rhs_of th)), NONE, SOME cv']
  36.142 -               @{thm Suc_if_eq})) (Thm.forall_intr cv' th)
  36.143 -      in
  36.144 -        case map_filter (fn th'' =>
  36.145 -            SOME (th'', singleton
  36.146 -              (Variable.trade (K (fn [th'''] => [th''' RS th']))
  36.147 -                (Variable.global_thm_context th'')) th'')
  36.148 -          handle THM _ => NONE) thms of
  36.149 -            [] => NONE
  36.150 -          | thps =>
  36.151 -              let val (ths1, ths2) = split_list thps
  36.152 -              in SOME (subtract Thm.eq_thm (th :: ths1) thms @ ths2) end
  36.153 -      end
  36.154 -  in get_first mk_thms eqs end;
  36.155 -
  36.156 -fun eqn_suc_base_preproc thy thms =
  36.157 -  let
  36.158 -    val dest = fst o Logic.dest_equals o prop_of;
  36.159 -    val contains_suc = exists_Const (fn (c, _) => c = @{const_name Suc});
  36.160 -  in
  36.161 -    if forall (can dest) thms andalso exists (contains_suc o dest) thms
  36.162 -      then thms |> perhaps_loop (remove_suc thy) |> (Option.map o map) Drule.zero_var_indexes
  36.163 -       else NONE
  36.164 -  end;
  36.165 -
  36.166 -val eqn_suc_preproc = Code_Preproc.simple_functrans eqn_suc_base_preproc;
  36.167 -
  36.168 -in
  36.169 -
  36.170 -  Code_Preproc.add_functrans ("eqn_Suc", eqn_suc_preproc)
  36.171 -
  36.172 -end;
  36.173 -*}
  36.174 -(*>*)
  36.175 -
  36.176 -
  36.177 -subsection {* Target language setup *}
  36.178 +subsection {* Target language fundamentals *}
  36.179  
  36.180  text {*
  36.181    For ML, we map @{typ nat} to target language integers, where we
  36.182 @@ -282,47 +123,32 @@
  36.183  code_instance nat :: equal
  36.184    (Haskell -)
  36.185  
  36.186 -text {*
  36.187 -  Natural numerals.
  36.188 -*}
  36.189 -
  36.190 -lemma [code_abbrev]:
  36.191 -  "number_nat_inst.number_of_nat i = nat (number_of i)"
  36.192 -  -- {* this interacts as desired with @{thm nat_number_of_def} *}
  36.193 -  by (simp add: number_nat_inst.number_of_nat)
  36.194 -
  36.195  setup {*
  36.196 -  fold (Numeral.add_code @{const_name number_nat_inst.number_of_nat}
  36.197 +  fold (Numeral.add_code @{const_name nat_of_num}
  36.198      false Code_Printer.literal_positive_numeral) ["SML", "OCaml", "Haskell", "Scala"]
  36.199  *}
  36.200  
  36.201 +code_const "0::nat"
  36.202 +  (SML "0")
  36.203 +  (OCaml "Big'_int.zero'_big'_int")
  36.204 +  (Haskell "0")
  36.205 +  (Scala "Nat(0)")
  36.206 +
  36.207 +
  36.208 +subsection {* Conversions *}
  36.209 +
  36.210  text {*
  36.211    Since natural numbers are implemented
  36.212 -  using integers in ML, the coercion function @{const "of_nat"} of type
  36.213 +  using integers in ML, the coercion function @{term "int"} of type
  36.214    @{typ "nat \<Rightarrow> int"} is simply implemented by the identity function.
  36.215    For the @{const nat} function for converting an integer to a natural
  36.216 -  number, we give a specific implementation using an ML function that
  36.217 +  number, we give a specific implementation using an ML expression that
  36.218    returns its input value, provided that it is non-negative, and otherwise
  36.219    returns @{text "0"}.
  36.220  *}
  36.221  
  36.222  definition int :: "nat \<Rightarrow> int" where
  36.223 -  [code del, code_abbrev]: "int = of_nat"
  36.224 -
  36.225 -lemma int_code' [code]:
  36.226 -  "int (number_of l) = (if neg (number_of l \<Colon> int) then 0 else number_of l)"
  36.227 -  unfolding int_nat_number_of [folded int_def] ..
  36.228 -
  36.229 -lemma nat_code' [code]:
  36.230 -  "nat (number_of l) = (if neg (number_of l \<Colon> int) then 0 else number_of l)"
  36.231 -  unfolding nat_number_of_def number_of_is_id neg_def by simp
  36.232 -
  36.233 -lemma of_nat_int: (* FIXME delete candidate *)
  36.234 -  "of_nat = int" by (simp add: int_def)
  36.235 -
  36.236 -lemma of_nat_aux_int [code_unfold]:
  36.237 -  "of_nat_aux (\<lambda>i. i + 1) k 0 = int k"
  36.238 -  by (simp add: int_def Nat.of_nat_code)
  36.239 +  [code_abbrev]: "int = of_nat"
  36.240  
  36.241  code_const int
  36.242    (SML "_")
  36.243 @@ -331,7 +157,7 @@
  36.244  code_const nat
  36.245    (SML "IntInf.max/ (0,/ _)")
  36.246    (OCaml "Big'_int.max'_big'_int/ Big'_int.zero'_big'_int")
  36.247 -  (Eval "Integer.max/ _/ 0")
  36.248 +  (Eval "Integer.max/ 0")
  36.249  
  36.250  text {* For Haskell and Scala, things are slightly different again. *}
  36.251  
  36.252 @@ -339,7 +165,26 @@
  36.253    (Haskell "toInteger" and "fromInteger")
  36.254    (Scala "!_.as'_BigInt" and "Nat")
  36.255  
  36.256 -text {* Conversion from and to code numerals. *}
  36.257 +text {* Alternativ implementation for @{const of_nat} *}
  36.258 +
  36.259 +lemma [code]:
  36.260 +  "of_nat n = (if n = 0 then 0 else
  36.261 +     let
  36.262 +       (q, m) = divmod_nat n 2;
  36.263 +       q' = 2 * of_nat q
  36.264 +     in if m = 0 then q' else q' + 1)"
  36.265 +proof -
  36.266 +  from mod_div_equality have *: "of_nat n = of_nat (n div 2 * 2 + n mod 2)" by simp
  36.267 +  show ?thesis
  36.268 +    apply (simp add: Let_def divmod_nat_div_mod mod_2_not_eq_zero_eq_one_nat
  36.269 +      of_nat_mult
  36.270 +      of_nat_add [symmetric])
  36.271 +    apply (auto simp add: of_nat_mult)
  36.272 +    apply (simp add: * of_nat_mult add_commute mult_commute)
  36.273 +    done
  36.274 +qed
  36.275 +
  36.276 +text {* Conversion from and to code numerals *}
  36.277  
  36.278  code_const Code_Numeral.of_nat
  36.279    (SML "IntInf.toInt")
  36.280 @@ -355,21 +200,38 @@
  36.281    (Scala "!Nat(_.as'_BigInt)")
  36.282    (Eval "_")
  36.283  
  36.284 -text {* Using target language arithmetic operations whenever appropriate *}
  36.285 +
  36.286 +subsection {* Target language arithmetic *}
  36.287  
  36.288 -code_const "op + \<Colon> nat \<Rightarrow> nat \<Rightarrow> nat"
  36.289 -  (SML "IntInf.+ ((_), (_))")
  36.290 +code_const "plus \<Colon> nat \<Rightarrow> nat \<Rightarrow> nat"
  36.291 +  (SML "IntInf.+/ ((_),/ (_))")
  36.292    (OCaml "Big'_int.add'_big'_int")
  36.293    (Haskell infixl 6 "+")
  36.294    (Scala infixl 7 "+")
  36.295    (Eval infixl 8 "+")
  36.296  
  36.297 -code_const "op - \<Colon> nat \<Rightarrow> nat \<Rightarrow> nat"
  36.298 +code_const "minus \<Colon> nat \<Rightarrow> nat \<Rightarrow> nat"
  36.299 +  (SML "IntInf.max/ (0, IntInf.-/ ((_),/ (_)))")
  36.300 +  (OCaml "Big'_int.max'_big'_int/ Big'_int.zero'_big'_int/ (Big'_int.sub'_big'_int/ _/ _)")
  36.301    (Haskell infixl 6 "-")
  36.302    (Scala infixl 7 "-")
  36.303 +  (Eval "Integer.max/ 0/ (_ -/ _)")
  36.304  
  36.305 -code_const "op * \<Colon> nat \<Rightarrow> nat \<Rightarrow> nat"
  36.306 -  (SML "IntInf.* ((_), (_))")
  36.307 +code_const Code_Nat.dup
  36.308 +  (SML "IntInf.*/ (2,/ (_))")
  36.309 +  (OCaml "Big'_int.mult'_big'_int/ 2")
  36.310 +  (Haskell "!(2 * _)")
  36.311 +  (Scala "!(2 * _)")
  36.312 +  (Eval "!(2 * _)")
  36.313 +
  36.314 +code_const Code_Nat.sub
  36.315 +  (SML "!(raise/ Fail/ \"sub\")")
  36.316 +  (OCaml "failwith/ \"sub\"")
  36.317 +  (Haskell "error/ \"sub\"")
  36.318 +  (Scala "!error(\"sub\")")
  36.319 +
  36.320 +code_const "times \<Colon> nat \<Rightarrow> nat \<Rightarrow> nat"
  36.321 +  (SML "IntInf.*/ ((_),/ (_))")
  36.322    (OCaml "Big'_int.mult'_big'_int")
  36.323    (Haskell infixl 7 "*")
  36.324    (Scala infixl 8 "*")
  36.325 @@ -389,22 +251,28 @@
  36.326    (Scala infixl 5 "==")
  36.327    (Eval infixl 6 "=")
  36.328  
  36.329 -code_const "op \<le> \<Colon> nat \<Rightarrow> nat \<Rightarrow> bool"
  36.330 -  (SML "IntInf.<= ((_), (_))")
  36.331 +code_const "less_eq \<Colon> nat \<Rightarrow> nat \<Rightarrow> bool"
  36.332 +  (SML "IntInf.<=/ ((_),/ (_))")
  36.333    (OCaml "Big'_int.le'_big'_int")
  36.334    (Haskell infix 4 "<=")
  36.335    (Scala infixl 4 "<=")
  36.336    (Eval infixl 6 "<=")
  36.337  
  36.338 -code_const "op < \<Colon> nat \<Rightarrow> nat \<Rightarrow> bool"
  36.339 -  (SML "IntInf.< ((_), (_))")
  36.340 +code_const "less \<Colon> nat \<Rightarrow> nat \<Rightarrow> bool"
  36.341 +  (SML "IntInf.</ ((_),/ (_))")
  36.342    (OCaml "Big'_int.lt'_big'_int")
  36.343    (Haskell infix 4 "<")
  36.344    (Scala infixl 4 "<")
  36.345    (Eval infixl 6 "<")
  36.346  
  36.347 +code_const Num.num_of_nat
  36.348 +  (SML "!(raise/ Fail/ \"num'_of'_nat\")")
  36.349 +  (OCaml "failwith/ \"num'_of'_nat\"")
  36.350 +  (Haskell "error/ \"num'_of'_nat\"")
  36.351 +  (Scala "!error(\"num'_of'_nat\")")
  36.352  
  36.353 -text {* Evaluation *}
  36.354 +
  36.355 +subsection {* Evaluation *}
  36.356  
  36.357  lemma [code, code del]:
  36.358    "(Code_Evaluation.term_of \<Colon> nat \<Rightarrow> term) = Code_Evaluation.term_of" ..
  36.359 @@ -412,14 +280,14 @@
  36.360  code_const "Code_Evaluation.term_of \<Colon> nat \<Rightarrow> term"
  36.361    (SML "HOLogic.mk'_number/ HOLogic.natT")
  36.362  
  36.363 -text {* Evaluation with @{text "Quickcheck_Narrowing"} does not work, as
  36.364 +text {*
  36.365 +  FIXME -- Evaluation with @{text "Quickcheck_Narrowing"} does not work, as
  36.366    @{text "code_module"} is very aggressive leading to bad Haskell code.
  36.367    Therefore, we simply deactivate the narrowing-based quickcheck from here on.
  36.368  *}
  36.369  
  36.370  declare [[quickcheck_narrowing_active = false]] 
  36.371  
  36.372 -text {* Module names *}
  36.373  
  36.374  code_modulename SML
  36.375    Efficient_Nat Arith
  36.376 @@ -430,6 +298,6 @@
  36.377  code_modulename Haskell
  36.378    Efficient_Nat Arith
  36.379  
  36.380 -hide_const int
  36.381 +hide_const (open) int
  36.382  
  36.383  end
    37.1 --- a/src/HOL/Library/Extended_Nat.thy	Sat Mar 24 16:27:04 2012 +0100
    37.2 +++ b/src/HOL/Library/Extended_Nat.thy	Sun Mar 25 20:15:39 2012 +0200
    37.3 @@ -61,19 +61,17 @@
    37.4  primrec the_enat :: "enat \<Rightarrow> nat"
    37.5    where "the_enat (enat n) = n"
    37.6  
    37.7 +
    37.8  subsection {* Constructors and numbers *}
    37.9  
   37.10 -instantiation enat :: "{zero, one, number}"
   37.11 +instantiation enat :: "{zero, one}"
   37.12  begin
   37.13  
   37.14  definition
   37.15    "0 = enat 0"
   37.16  
   37.17  definition
   37.18 -  [code_unfold]: "1 = enat 1"
   37.19 -
   37.20 -definition
   37.21 -  [code_unfold, code del]: "number_of k = enat (number_of k)"
   37.22 +  "1 = enat 1"
   37.23  
   37.24  instance ..
   37.25  
   37.26 @@ -82,15 +80,12 @@
   37.27  definition eSuc :: "enat \<Rightarrow> enat" where
   37.28    "eSuc i = (case i of enat n \<Rightarrow> enat (Suc n) | \<infinity> \<Rightarrow> \<infinity>)"
   37.29  
   37.30 -lemma enat_0: "enat 0 = 0"
   37.31 +lemma enat_0 [code_post]: "enat 0 = 0"
   37.32    by (simp add: zero_enat_def)
   37.33  
   37.34 -lemma enat_1: "enat 1 = 1"
   37.35 +lemma enat_1 [code_post]: "enat 1 = 1"
   37.36    by (simp add: one_enat_def)
   37.37  
   37.38 -lemma enat_number: "enat (number_of k) = number_of k"
   37.39 -  by (simp add: number_of_enat_def)
   37.40 -
   37.41  lemma one_eSuc: "1 = eSuc 0"
   37.42    by (simp add: zero_enat_def one_enat_def eSuc_def)
   37.43  
   37.44 @@ -100,16 +95,6 @@
   37.45  lemma i0_ne_infinity [simp]: "0 \<noteq> (\<infinity>::enat)"
   37.46    by (simp add: zero_enat_def)
   37.47  
   37.48 -lemma zero_enat_eq [simp]:
   37.49 -  "number_of k = (0\<Colon>enat) \<longleftrightarrow> number_of k = (0\<Colon>nat)"
   37.50 -  "(0\<Colon>enat) = number_of k \<longleftrightarrow> number_of k = (0\<Colon>nat)"
   37.51 -  unfolding zero_enat_def number_of_enat_def by simp_all
   37.52 -
   37.53 -lemma one_enat_eq [simp]:
   37.54 -  "number_of k = (1\<Colon>enat) \<longleftrightarrow> number_of k = (1\<Colon>nat)"
   37.55 -  "(1\<Colon>enat) = number_of k \<longleftrightarrow> number_of k = (1\<Colon>nat)"
   37.56 -  unfolding one_enat_def number_of_enat_def by simp_all
   37.57 -
   37.58  lemma zero_one_enat_neq [simp]:
   37.59    "\<not> 0 = (1\<Colon>enat)"
   37.60    "\<not> 1 = (0\<Colon>enat)"
   37.61 @@ -121,18 +106,9 @@
   37.62  lemma i1_ne_infinity [simp]: "1 \<noteq> (\<infinity>::enat)"
   37.63    by (simp add: one_enat_def)
   37.64  
   37.65 -lemma infinity_ne_number [simp]: "(\<infinity>::enat) \<noteq> number_of k"
   37.66 -  by (simp add: number_of_enat_def)
   37.67 -
   37.68 -lemma number_ne_infinity [simp]: "number_of k \<noteq> (\<infinity>::enat)"
   37.69 -  by (simp add: number_of_enat_def)
   37.70 -
   37.71  lemma eSuc_enat: "eSuc (enat n) = enat (Suc n)"
   37.72    by (simp add: eSuc_def)
   37.73  
   37.74 -lemma eSuc_number_of: "eSuc (number_of k) = enat (Suc (number_of k))"
   37.75 -  by (simp add: eSuc_enat number_of_enat_def)
   37.76 -
   37.77  lemma eSuc_infinity [simp]: "eSuc \<infinity> = \<infinity>"
   37.78    by (simp add: eSuc_def)
   37.79  
   37.80 @@ -145,11 +121,6 @@
   37.81  lemma eSuc_inject [simp]: "eSuc m = eSuc n \<longleftrightarrow> m = n"
   37.82    by (simp add: eSuc_def split: enat.splits)
   37.83  
   37.84 -lemma number_of_enat_inject [simp]:
   37.85 -  "(number_of k \<Colon> enat) = number_of l \<longleftrightarrow> (number_of k \<Colon> nat) = number_of l"
   37.86 -  by (simp add: number_of_enat_def)
   37.87 -
   37.88 -
   37.89  subsection {* Addition *}
   37.90  
   37.91  instantiation enat :: comm_monoid_add
   37.92 @@ -177,16 +148,6 @@
   37.93  
   37.94  end
   37.95  
   37.96 -lemma plus_enat_number [simp]:
   37.97 -  "(number_of k \<Colon> enat) + number_of l = (if k < Int.Pls then number_of l
   37.98 -    else if l < Int.Pls then number_of k else number_of (k + l))"
   37.99 -  unfolding number_of_enat_def plus_enat_simps nat_arith(1) if_distrib [symmetric, of _ enat] ..
  37.100 -
  37.101 -lemma eSuc_number [simp]:
  37.102 -  "eSuc (number_of k) = (if neg (number_of k \<Colon> int) then 1 else number_of (Int.succ k))"
  37.103 -  unfolding eSuc_number_of
  37.104 -  unfolding one_enat_def number_of_enat_def Suc_nat_number_of if_distrib [symmetric] ..
  37.105 -
  37.106  lemma eSuc_plus_1:
  37.107    "eSuc n = n + 1"
  37.108    by (cases n) (simp_all add: eSuc_enat one_enat_def)
  37.109 @@ -261,12 +222,6 @@
  37.110    apply (simp add: plus_1_eSuc eSuc_enat)
  37.111    done
  37.112  
  37.113 -instance enat :: number_semiring
  37.114 -proof
  37.115 -  fix n show "number_of (int n) = (of_nat n :: enat)"
  37.116 -    unfolding number_of_enat_def number_of_int of_nat_id of_nat_eq_enat ..
  37.117 -qed
  37.118 -
  37.119  instance enat :: semiring_char_0 proof
  37.120    have "inj enat" by (rule injI) simp
  37.121    then show "inj (\<lambda>n. of_nat n :: enat)" by (simp add: of_nat_eq_enat)
  37.122 @@ -279,6 +234,25 @@
  37.123    by (auto simp add: times_enat_def zero_enat_def split: enat.split)
  37.124  
  37.125  
  37.126 +subsection {* Numerals *}
  37.127 +
  37.128 +lemma numeral_eq_enat:
  37.129 +  "numeral k = enat (numeral k)"
  37.130 +  using of_nat_eq_enat [of "numeral k"] by simp
  37.131 +
  37.132 +lemma enat_numeral [code_abbrev]:
  37.133 +  "enat (numeral k) = numeral k"
  37.134 +  using numeral_eq_enat ..
  37.135 +
  37.136 +lemma infinity_ne_numeral [simp]: "(\<infinity>::enat) \<noteq> numeral k"
  37.137 +  by (simp add: numeral_eq_enat)
  37.138 +
  37.139 +lemma numeral_ne_infinity [simp]: "numeral k \<noteq> (\<infinity>::enat)"
  37.140 +  by (simp add: numeral_eq_enat)
  37.141 +
  37.142 +lemma eSuc_numeral [simp]: "eSuc (numeral k) = numeral (k + Num.One)"
  37.143 +  by (simp only: eSuc_plus_1 numeral_plus_one)
  37.144 +
  37.145  subsection {* Subtraction *}
  37.146  
  37.147  instantiation enat :: minus
  37.148 @@ -292,13 +266,13 @@
  37.149  
  37.150  end
  37.151  
  37.152 -lemma idiff_enat_enat [simp,code]: "enat a - enat b = enat (a - b)"
  37.153 +lemma idiff_enat_enat [simp, code]: "enat a - enat b = enat (a - b)"
  37.154    by (simp add: diff_enat_def)
  37.155  
  37.156 -lemma idiff_infinity [simp,code]: "\<infinity> - n = (\<infinity>::enat)"
  37.157 +lemma idiff_infinity [simp, code]: "\<infinity> - n = (\<infinity>::enat)"
  37.158    by (simp add: diff_enat_def)
  37.159  
  37.160 -lemma idiff_infinity_right [simp,code]: "enat a - \<infinity> = 0"
  37.161 +lemma idiff_infinity_right [simp, code]: "enat a - \<infinity> = 0"
  37.162    by (simp add: diff_enat_def)
  37.163  
  37.164  lemma idiff_0 [simp]: "(0::enat) - n = 0"
  37.165 @@ -344,13 +318,13 @@
  37.166    "(\<infinity>::enat) < q \<longleftrightarrow> False"
  37.167    by (simp_all add: less_eq_enat_def less_enat_def split: enat.splits)
  37.168  
  37.169 -lemma number_of_le_enat_iff[simp]:
  37.170 -  shows "number_of m \<le> enat n \<longleftrightarrow> number_of m \<le> n"
  37.171 -by (auto simp: number_of_enat_def)
  37.172 +lemma numeral_le_enat_iff[simp]:
  37.173 +  shows "numeral m \<le> enat n \<longleftrightarrow> numeral m \<le> n"
  37.174 +by (auto simp: numeral_eq_enat)
  37.175  
  37.176 -lemma number_of_less_enat_iff[simp]:
  37.177 -  shows "number_of m < enat n \<longleftrightarrow> number_of m < n"
  37.178 -by (auto simp: number_of_enat_def)
  37.179 +lemma numeral_less_enat_iff[simp]:
  37.180 +  shows "numeral m < enat n \<longleftrightarrow> numeral m < n"
  37.181 +by (auto simp: numeral_eq_enat)
  37.182  
  37.183  lemma enat_ord_code [code]:
  37.184    "enat m \<le> enat n \<longleftrightarrow> m \<le> n"
  37.185 @@ -375,10 +349,15 @@
  37.186      by (simp split: enat.splits)
  37.187  qed
  37.188  
  37.189 +(* BH: These equations are already proven generally for any type in
  37.190 +class linordered_semidom. However, enat is not in that class because
  37.191 +it does not have the cancellation property. Would it be worthwhile to
  37.192 +a generalize linordered_semidom to a new class that includes enat? *)
  37.193 +
  37.194  lemma enat_ord_number [simp]:
  37.195 -  "(number_of m \<Colon> enat) \<le> number_of n \<longleftrightarrow> (number_of m \<Colon> nat) \<le> number_of n"
  37.196 -  "(number_of m \<Colon> enat) < number_of n \<longleftrightarrow> (number_of m \<Colon> nat) < number_of n"
  37.197 -  by (simp_all add: number_of_enat_def)
  37.198 +  "(numeral m \<Colon> enat) \<le> numeral n \<longleftrightarrow> (numeral m \<Colon> nat) \<le> numeral n"
  37.199 +  "(numeral m \<Colon> enat) < numeral n \<longleftrightarrow> (numeral m \<Colon> nat) < numeral n"
  37.200 +  by (simp_all add: numeral_eq_enat)
  37.201  
  37.202  lemma i0_lb [simp]: "(0\<Colon>enat) \<le> n"
  37.203    by (simp add: zero_enat_def less_eq_enat_def split: enat.splits)
  37.204 @@ -525,10 +504,10 @@
  37.205    val find_first = find_first_t []
  37.206    val trans_tac = Numeral_Simprocs.trans_tac
  37.207    val norm_ss = HOL_basic_ss addsimps
  37.208 -    @{thms add_ac semiring_numeral_0_eq_0 add_0_left add_0_right}
  37.209 +    @{thms add_ac add_0_left add_0_right}
  37.210    fun norm_tac ss = ALLGOALS (simp_tac (Simplifier.inherit_context ss norm_ss))
  37.211    fun simplify_meta_eq ss cancel_th th =
  37.212 -    Arith_Data.simplify_meta_eq @{thms semiring_numeral_0_eq_0} ss
  37.213 +    Arith_Data.simplify_meta_eq [] ss
  37.214        ([th, cancel_th] MRS trans)
  37.215    fun mk_eq (a, b) = HOLogic.mk_Trueprop (HOLogic.mk_eq (a, b))
  37.216  end
  37.217 @@ -646,7 +625,7 @@
  37.218  
  37.219  subsection {* Traditional theorem names *}
  37.220  
  37.221 -lemmas enat_defs = zero_enat_def one_enat_def number_of_enat_def eSuc_def
  37.222 +lemmas enat_defs = zero_enat_def one_enat_def eSuc_def
  37.223    plus_enat_def less_eq_enat_def less_enat_def
  37.224  
  37.225  end
    38.1 --- a/src/HOL/Library/Extended_Real.thy	Sat Mar 24 16:27:04 2012 +0100
    38.2 +++ b/src/HOL/Library/Extended_Real.thy	Sun Mar 25 20:15:39 2012 +0200
    38.3 @@ -124,11 +124,6 @@
    38.4    fix x :: ereal show "x \<in> range uminus" by (intro image_eqI[of _ _ "-x"]) auto
    38.5  qed auto
    38.6  
    38.7 -instantiation ereal :: number
    38.8 -begin
    38.9 -definition [simp]: "number_of x = ereal (number_of x)"
   38.10 -instance ..
   38.11 -end
   38.12  
   38.13  instantiation ereal :: abs
   38.14  begin
   38.15 @@ -671,6 +666,14 @@
   38.16    using assms
   38.17    by (cases rule: ereal3_cases[of a b c]) (simp_all add: field_simps)
   38.18  
   38.19 +instance ereal :: numeral ..
   38.20 +
   38.21 +lemma numeral_eq_ereal [simp]: "numeral w = ereal (numeral w)"
   38.22 +  apply (induct w rule: num_induct)
   38.23 +  apply (simp only: numeral_One one_ereal_def)
   38.24 +  apply (simp only: numeral_inc ereal_plus_1)
   38.25 +  done
   38.26 +
   38.27  lemma ereal_le_epsilon:
   38.28    fixes x y :: ereal
   38.29    assumes "ALL e. 0 < e --> x <= y + e"
   38.30 @@ -781,8 +784,8 @@
   38.31    shows "(- x) ^ n = (if even n then x ^ n else - (x^n))"
   38.32    by (induct n) (auto simp: one_ereal_def)
   38.33  
   38.34 -lemma ereal_power_number_of[simp]:
   38.35 -  "(number_of num :: ereal) ^ n = ereal (number_of num ^ n)"
   38.36 +lemma ereal_power_numeral[simp]:
   38.37 +  "(numeral num :: ereal) ^ n = ereal (numeral num ^ n)"
   38.38    by (induct n) (auto simp: one_ereal_def)
   38.39  
   38.40  lemma zero_le_power_ereal[simp]:
   38.41 @@ -1730,8 +1733,8 @@
   38.42    "ereal_of_enat m \<le> ereal_of_enat n \<longleftrightarrow> m \<le> n"
   38.43  by (cases m n rule: enat2_cases) auto
   38.44  
   38.45 -lemma number_of_le_ereal_of_enat_iff[simp]:
   38.46 -  shows "number_of m \<le> ereal_of_enat n \<longleftrightarrow> number_of m \<le> n"
   38.47 +lemma numeral_le_ereal_of_enat_iff[simp]:
   38.48 +  shows "numeral m \<le> ereal_of_enat n \<longleftrightarrow> numeral m \<le> n"
   38.49  by (cases n) (auto dest: natceiling_le intro: natceiling_le_eq[THEN iffD1])
   38.50  
   38.51  lemma ereal_of_enat_ge_zero_cancel_iff[simp]:
    39.1 --- a/src/HOL/Library/Float.thy	Sat Mar 24 16:27:04 2012 +0100
    39.2 +++ b/src/HOL/Library/Float.thy	Sun Mar 25 20:15:39 2012 +0200
    39.3 @@ -41,18 +41,6 @@
    39.4  instance ..
    39.5  end
    39.6  
    39.7 -instantiation float :: number
    39.8 -begin
    39.9 -definition number_of_float where "number_of n = Float n 0"
   39.10 -instance ..
   39.11 -end
   39.12 -
   39.13 -lemma number_of_float_Float:
   39.14 -  "number_of k = Float (number_of k) 0"
   39.15 -  by (simp add: number_of_float_def number_of_is_id)
   39.16 -
   39.17 -declare number_of_float_Float [symmetric, code_abbrev]
   39.18 -
   39.19  lemma real_of_float_simp[simp]: "real (Float a b) = real a * pow2 b"
   39.20    unfolding real_of_float_def using of_float.simps .
   39.21  
   39.22 @@ -63,12 +51,9 @@
   39.23  lemma Float_num[simp]: shows
   39.24     "real (Float 1 0) = 1" and "real (Float 1 1) = 2" and "real (Float 1 2) = 4" and
   39.25     "real (Float 1 -1) = 1/2" and "real (Float 1 -2) = 1/4" and "real (Float 1 -3) = 1/8" and
   39.26 -   "real (Float -1 0) = -1" and "real (Float (number_of n) 0) = number_of n"
   39.27 +   "real (Float -1 0) = -1" and "real (Float (numeral n) 0) = numeral n"
   39.28    by auto
   39.29  
   39.30 -lemma float_number_of[simp]: "real (number_of x :: float) = number_of x"
   39.31 -  by (simp only:number_of_float_def Float_num[unfolded number_of_is_id])
   39.32 -
   39.33  lemma float_number_of_int[simp]: "real (Float n 0) = real n"
   39.34    by simp
   39.35  
   39.36 @@ -349,6 +334,21 @@
   39.37      by (cases a, cases b) (simp add: plus_float.simps)
   39.38  qed
   39.39  
   39.40 +instance float :: numeral ..
   39.41 +
   39.42 +lemma Float_add_same_scale: "Float x e + Float y e = Float (x + y) e"
   39.43 +  by (simp add: plus_float.simps)
   39.44 +
   39.45 +(* FIXME: define other constant for code_unfold_post *)
   39.46 +lemma numeral_float_Float (*[code_unfold_post]*):
   39.47 +  "numeral k = Float (numeral k) 0"
   39.48 +  by (induct k, simp_all only: numeral.simps one_float_def
   39.49 +    Float_add_same_scale)
   39.50 +
   39.51 +lemma float_number_of[simp]: "real (numeral x :: float) = numeral x"
   39.52 +  by (simp only: numeral_float_Float Float_num)
   39.53 +
   39.54 +
   39.55  instance float :: comm_monoid_mult
   39.56  proof (intro_classes)
   39.57    fix a b c :: float
   39.58 @@ -555,6 +555,7 @@
   39.59    show ?thesis unfolding real_of_float_nge0_exp[OF P] divide_inverse by auto
   39.60  qed
   39.61  
   39.62 +(* BROKEN
   39.63  lemma bitlen_Pls: "bitlen (Int.Pls) = Int.Pls" by (subst Pls_def, subst Pls_def, simp)
   39.64  
   39.65  lemma bitlen_Min: "bitlen (Int.Min) = Int.Bit1 Int.Pls" by (subst Min_def, simp add: Bit1_def) 
   39.66 @@ -588,6 +589,7 @@
   39.67  
   39.68  lemma bitlen_number_of: "bitlen (number_of w) = number_of (bitlen w)"
   39.69    by (simp add: number_of_is_id)
   39.70 +BH *)
   39.71  
   39.72  lemma [code]: "bitlen x = 
   39.73       (if x = 0  then 0 
   39.74 @@ -722,12 +724,12 @@
   39.75      hence "real x / real y < 1" using `0 < y` and `0 \<le> x` by auto
   39.76  
   39.77      from real_of_int_div4[of "?X" y]
   39.78 -    have "real (?X div y) \<le> (real x / real y) * 2^?l" unfolding real_of_int_mult times_divide_eq_left real_of_int_power real_number_of .
   39.79 +    have "real (?X div y) \<le> (real x / real y) * 2^?l" unfolding real_of_int_mult times_divide_eq_left real_of_int_power real_numeral .
   39.80      also have "\<dots> < 1 * 2^?l" using `real x / real y < 1` by (rule mult_strict_right_mono, auto)
   39.81      finally have "?X div y < 2^?l" unfolding real_of_int_less_iff[of _ "2^?l", symmetric] by auto
   39.82      hence "?X div y + 1 \<le> 2^?l" by auto
   39.83      hence "real (?X div y + 1) * inverse (2^?l) \<le> 2^?l * inverse (2^?l)"
   39.84 -      unfolding real_of_int_le_iff[of _ "2^?l", symmetric] real_of_int_power real_number_of
   39.85 +      unfolding real_of_int_le_iff[of _ "2^?l", symmetric] real_of_int_power real_numeral
   39.86        by (rule mult_right_mono, auto)
   39.87      hence "real (?X div y + 1) * inverse (2^?l) \<le> 1" by auto
   39.88      thus ?thesis unfolding rapprox_posrat_def Let_def normfloat real_of_float_simp if_not_P[OF False]
   39.89 @@ -796,12 +798,12 @@
   39.90      qed
   39.91  
   39.92      from real_of_int_div4[of "?X" y]
   39.93 -    have "real (?X div y) \<le> (real x / real y) * 2^?l" unfolding real_of_int_mult times_divide_eq_left real_of_int_power real_number_of .
   39.94 +    have "real (?X div y) \<le> (real x / real y) * 2^?l" unfolding real_of_int_mult times_divide_eq_left real_of_int_power real_numeral .
   39.95      also have "\<dots> < 1/2 * 2^?l" using `real x / real y < 1/2` by (rule mult_strict_right_mono, auto)
   39.96      finally have "?X div y * 2 < 2^?l" unfolding real_of_int_less_iff[of _ "2^?l", symmetric] by auto
   39.97      hence "?X div y + 1 < 2^?l" using `0 < ?X div y` by auto
   39.98      hence "real (?X div y + 1) * inverse (2^?l) < 2^?l * inverse (2^?l)"
   39.99 -      unfolding real_of_int_less_iff[of _ "2^?l", symmetric] real_of_int_power real_number_of
  39.100 +      unfolding real_of_int_less_iff[of _ "2^?l", symmetric] real_of_int_power real_numeral
  39.101        by (rule mult_strict_right_mono, auto)
  39.102      hence "real (?X div y + 1) * inverse (2^?l) < 1" by auto
  39.103      thus ?thesis unfolding rapprox_posrat_def Let_def normfloat real_of_float_simp if_not_P[OF False]
  39.104 @@ -1195,7 +1197,7 @@
  39.105      case True
  39.106      have "real (m div 2^(nat ?l)) * pow2 ?l \<le> real m"
  39.107      proof -
  39.108 -      have "real (m div 2^(nat ?l)) * pow2 ?l = real (2^(nat ?l) * (m div 2^(nat ?l)))" unfolding real_of_int_mult real_of_int_power real_number_of unfolding pow2_int[symmetric] 
  39.109 +      have "real (m div 2^(nat ?l)) * pow2 ?l = real (2^(nat ?l) * (m div 2^(nat ?l)))" unfolding real_of_int_mult real_of_int_power real_numeral unfolding pow2_int[symmetric] 
  39.110          using `?l > 0` by auto
  39.111        also have "\<dots> \<le> real (2^(nat ?l) * (m div 2^(nat ?l)) + m mod 2^(nat ?l))" unfolding real_of_int_add by auto
  39.112        also have "\<dots> = real m" unfolding zmod_zdiv_equality[symmetric] ..
  39.113 @@ -1262,7 +1264,7 @@
  39.114      hence me_eq: "pow2 (-e) = pow2 (int (nat (-e)))" by auto
  39.115      have "real (Float (m div (2 ^ (nat (-e)))) 0) = real (m div 2 ^ (nat (-e)))" unfolding real_of_float_simp by auto
  39.116      also have "\<dots> \<le> real m / real ((2::int) ^ (nat (-e)))" using real_of_int_div4 .
  39.117 -    also have "\<dots> = real m * inverse (2 ^ (nat (-e)))" unfolding real_of_int_power real_number_of divide_inverse ..
  39.118 +    also have "\<dots> = real m * inverse (2 ^ (nat (-e)))" unfolding real_of_int_power real_numeral divide_inverse ..
  39.119      also have "\<dots> = real (Float m e)" unfolding real_of_float_simp me_eq pow2_int pow2_neg[of e] ..
  39.120      finally show ?thesis unfolding Float floor_fl.simps if_not_P[OF `\<not> 0 \<le> e`] .
  39.121    next
  39.122 @@ -1290,7 +1292,7 @@
  39.123      case False
  39.124      hence me_eq: "pow2 (-e) = pow2 (int (nat (-e)))" by auto
  39.125      have "real (Float m e) = real m * inverse (2 ^ (nat (-e)))" unfolding real_of_float_simp me_eq pow2_int pow2_neg[of e] ..
  39.126 -    also have "\<dots> = real m / real ((2::int) ^ (nat (-e)))" unfolding real_of_int_power real_number_of divide_inverse ..
  39.127 +    also have "\<dots> = real m / real ((2::int) ^ (nat (-e)))" unfolding real_of_int_power real_numeral divide_inverse ..
  39.128      also have "\<dots> \<le> 1 + real (m div 2 ^ (nat (-e)))" using real_of_int_div3[unfolded diff_le_eq] .
  39.129      also have "\<dots> = real (Float (m div (2 ^ (nat (-e))) + 1) 0)" unfolding real_of_float_simp by auto
  39.130      finally show ?thesis unfolding Float ceiling_fl.simps if_not_P[OF `\<not> 0 \<le> e`] .
    40.1 --- a/src/HOL/Library/Formal_Power_Series.thy	Sat Mar 24 16:27:04 2012 +0100
    40.2 +++ b/src/HOL/Library/Formal_Power_Series.thy	Sun Mar 25 20:15:39 2012 +0200
    40.3 @@ -392,25 +392,13 @@
    40.4  
    40.5  instance fps :: (idom) idom ..
    40.6  
    40.7 -instantiation fps :: (comm_ring_1) number_ring
    40.8 -begin
    40.9 -definition number_of_fps_def: "(number_of k::'a fps) = of_int k"
   40.10 -
   40.11 -instance proof
   40.12 -qed (rule number_of_fps_def)
   40.13 -end
   40.14 -
   40.15 -lemma number_of_fps_const: "(number_of k::('a::comm_ring_1) fps) = fps_const (of_int k)"
   40.16 -  
   40.17 -proof(induct k rule: int_induct [where k=0])
   40.18 -  case base thus ?case unfolding number_of_fps_def of_int_0 by simp
   40.19 -next
   40.20 -  case (step1 i) thus ?case unfolding number_of_fps_def 
   40.21 -    by (simp add: fps_const_add[symmetric] del: fps_const_add)
   40.22 -next
   40.23 -  case (step2 i) thus ?case unfolding number_of_fps_def 
   40.24 -    by (simp add: fps_const_sub[symmetric] del: fps_const_sub)
   40.25 -qed
   40.26 +lemma numeral_fps_const: "numeral k = fps_const (numeral k)"
   40.27 +  by (induct k, simp_all only: numeral.simps fps_const_1_eq_1
   40.28 +    fps_const_add [symmetric])
   40.29 +
   40.30 +lemma neg_numeral_fps_const: "neg_numeral k = fps_const (neg_numeral k)"
   40.31 +  by (simp only: neg_numeral_def numeral_fps_const fps_const_neg)
   40.32 +
   40.33  subsection{* The eXtractor series X*}
   40.34  
   40.35  lemma minus_one_power_iff: "(- (1::'a :: {comm_ring_1})) ^ n = (if even n then 1 else - 1)"
   40.36 @@ -1119,7 +1107,7 @@
   40.37    have eq: "(1 + X) * ?r = 1"
   40.38      unfolding minus_one_power_iff
   40.39      by (auto simp add: field_simps fps_eq_iff)
   40.40 -  show ?thesis by (auto simp add: eq intro: fps_inverse_unique)
   40.41 +  show ?thesis by (auto simp add: eq intro: fps_inverse_unique simp del: minus_one)
   40.42  qed
   40.43  
   40.44  
   40.45 @@ -1157,8 +1145,11 @@
   40.46    "fps_const (a::'a::{comm_ring_1}) oo b = fps_const (a)"
   40.47    by (simp add: fps_eq_iff fps_compose_nth mult_delta_left setsum_delta)
   40.48  
   40.49 -lemma number_of_compose[simp]: "(number_of k::('a::{comm_ring_1}) fps) oo b = number_of k"
   40.50 -  unfolding number_of_fps_const by simp
   40.51 +lemma numeral_compose[simp]: "(numeral k::('a::{comm_ring_1}) fps) oo b = numeral k"
   40.52 +  unfolding numeral_fps_const by simp
   40.53 +
   40.54 +lemma neg_numeral_compose[simp]: "(neg_numeral k::('a::{comm_ring_1}) fps) oo b = neg_numeral k"
   40.55 +  unfolding neg_numeral_fps_const by simp
   40.56  
   40.57  lemma X_fps_compose_startby0[simp]: "a$0 = 0 \<Longrightarrow> X oo a = (a :: ('a :: comm_ring_1) fps)"
   40.58    by (simp add: fps_eq_iff fps_compose_def mult_delta_left setsum_delta
   40.59 @@ -2568,7 +2559,7 @@
   40.60    (is "inverse ?l = ?r")
   40.61  proof-
   40.62    have th: "?l * ?r = 1"
   40.63 -    by (auto simp add: field_simps fps_eq_iff minus_one_power_iff)
   40.64 +    by (auto simp add: field_simps fps_eq_iff minus_one_power_iff simp del: minus_one)
   40.65    have th': "?l $ 0 \<noteq> 0" by (simp add: )
   40.66    from fps_inverse_unique[OF th' th] show ?thesis .
   40.67  qed
   40.68 @@ -2765,7 +2756,7 @@
   40.69  proof-
   40.70    have th: "?r$0 \<noteq> 0" by simp
   40.71    have th': "fps_deriv (inverse ?r) = fps_const (- 1) * inverse ?r / (1 + X)"
   40.72 -    by (simp add: fps_inverse_deriv[OF th] fps_divide_def power2_eq_square mult_commute fps_const_neg[symmetric] del: fps_const_neg)
   40.73 +    by (simp add: fps_inverse_deriv[OF th] fps_divide_def power2_eq_square mult_commute fps_const_neg[symmetric] del: fps_const_neg minus_one)
   40.74    have eq: "inverse ?r $ 0 = 1"
   40.75      by (simp add: fps_inverse_def)
   40.76    from iffD1[OF fps_binomial_ODE_unique[of "inverse (1 + X)" "- 1"] th'] eq
   40.77 @@ -2855,7 +2846,7 @@
   40.78            unfolding m1nk 
   40.79            
   40.80            unfolding m h pochhammer_Suc_setprod
   40.81 -          apply (simp add: field_simps del: fact_Suc id_def)
   40.82 +          apply (simp add: field_simps del: fact_Suc id_def minus_one)
   40.83            unfolding fact_altdef_nat id_def
   40.84            unfolding of_nat_setprod
   40.85            unfolding setprod_timesf[symmetric]
   40.86 @@ -3162,28 +3153,25 @@
   40.87  lemma fps_const_minus: "fps_const (c::'a::group_add) - fps_const d = fps_const (c - d)"
   40.88    by (simp add: fps_eq_iff fps_const_def)
   40.89  
   40.90 -lemma fps_number_of_fps_const: "number_of i = fps_const (number_of i :: 'a:: {comm_ring_1, number_ring})"
   40.91 -  apply (subst (2) number_of_eq)
   40.92 -apply(rule int_induct [of _ 0])
   40.93 -apply (simp_all add: number_of_fps_def)
   40.94 -by (simp_all add: fps_const_add[symmetric] fps_const_minus[symmetric])
   40.95 +lemma fps_numeral_fps_const: "numeral i = fps_const (numeral i :: 'a:: {comm_ring_1})"
   40.96 +  by (fact numeral_fps_const) (* FIXME: duplicate *)
   40.97  
   40.98  lemma fps_cos_Eii:
   40.99    "fps_cos c = (E (ii * c) + E (- ii * c)) / fps_const 2"
  40.100  proof-
  40.101    have th: "fps_cos c + fps_cos c = fps_cos c * fps_const 2" 
  40.102 -    by (simp add: fps_eq_iff fps_number_of_fps_const complex_number_of_def[symmetric])
  40.103 +    by (simp add: numeral_fps_const)
  40.104    show ?thesis
  40.105    unfolding Eii_sin_cos minus_mult_commute
  40.106 -  by (simp add: fps_sin_even fps_cos_odd fps_number_of_fps_const
  40.107 -    fps_divide_def fps_const_inverse th complex_number_of_def[symmetric])
  40.108 +  by (simp add: fps_sin_even fps_cos_odd numeral_fps_const
  40.109 +    fps_divide_def fps_const_inverse th)
  40.110  qed
  40.111  
  40.112  lemma fps_sin_Eii:
  40.113    "fps_sin c = (E (ii * c) - E (- ii * c)) / fps_const (2*ii)"
  40.114  proof-
  40.115    have th: "fps_const \<i> * fps_sin c + fps_const \<i> * fps_sin c = fps_sin c * fps_const (2 * ii)" 
  40.116 -    by (simp add: fps_eq_iff fps_number_of_fps_const complex_number_of_def[symmetric])
  40.117 +    by (simp add: fps_eq_iff numeral_fps_const)
  40.118    show ?thesis
  40.119    unfolding Eii_sin_cos minus_mult_commute
  40.120    by (simp add: fps_sin_even fps_cos_odd fps_divide_def fps_const_inverse th)
    41.1 --- a/src/HOL/Library/Numeral_Type.thy	Sat Mar 24 16:27:04 2012 +0100
    41.2 +++ b/src/HOL/Library/Numeral_Type.thy	Sun Mar 25 20:15:39 2012 +0200
    41.3 @@ -66,7 +66,6 @@
    41.4      by simp
    41.5  qed
    41.6  
    41.7 -
    41.8  subsection {* Locales for for modular arithmetic subtypes *}
    41.9  
   41.10  locale mod_type =
   41.11 @@ -137,8 +136,8 @@
   41.12  
   41.13  locale mod_ring = mod_type n Rep Abs
   41.14    for n :: int
   41.15 -  and Rep :: "'a::{number_ring} \<Rightarrow> int"
   41.16 -  and Abs :: "int \<Rightarrow> 'a::{number_ring}"
   41.17 +  and Rep :: "'a::{comm_ring_1} \<Rightarrow> int"
   41.18 +  and Abs :: "int \<Rightarrow> 'a::{comm_ring_1}"
   41.19  begin
   41.20  
   41.21  lemma of_nat_eq: "of_nat k = Abs (int k mod n)"
   41.22 @@ -152,13 +151,14 @@
   41.23  apply (simp add: Rep_simps of_nat_eq diff_def zmod_simps)
   41.24  done
   41.25  
   41.26 -lemma Rep_number_of:
   41.27 -  "Rep (number_of w) = number_of w mod n"
   41.28 -by (simp add: number_of_eq of_int_eq Rep_Abs_mod)
   41.29 +lemma Rep_numeral:
   41.30 +  "Rep (numeral w) = numeral w mod n"
   41.31 +using of_int_eq [of "numeral w"]
   41.32 +by (simp add: Rep_inject_sym Rep_Abs_mod)
   41.33  
   41.34 -lemma iszero_number_of:
   41.35 -  "iszero (number_of w::'a) \<longleftrightarrow> number_of w mod n = 0"
   41.36 -by (simp add: Rep_simps number_of_eq of_int_eq iszero_def zero_def)
   41.37 +lemma iszero_numeral:
   41.38 +  "iszero (numeral w::'a) \<longleftrightarrow> numeral w mod n = 0"
   41.39 +by (simp add: Rep_inject_sym Rep_numeral Rep_0 iszero_def)
   41.40  
   41.41  lemma cases:
   41.42    assumes 1: "\<And>z. \<lbrakk>(x::'a) = of_int z; 0 \<le> z; z < n\<rbrakk> \<Longrightarrow> P"
   41.43 @@ -175,14 +175,14 @@
   41.44  end
   41.45  
   41.46  
   41.47 -subsection {* Number ring instances *}
   41.48 +subsection {* Ring class instances *}
   41.49  
   41.50  text {*
   41.51 -  Unfortunately a number ring instance is not possible for
   41.52 +  Unfortunately @{text ring_1} instance is not possible for
   41.53    @{typ num1}, since 0 and 1 are not distinct.
   41.54  *}
   41.55  
   41.56 -instantiation num1 :: "{comm_ring,comm_monoid_mult,number}"
   41.57 +instantiation num1 :: "{comm_ring,comm_monoid_mult,numeral}"
   41.58  begin
   41.59  
   41.60  lemma num1_eq_iff: "(x::num1) = (y::num1) \<longleftrightarrow> True"
   41.61 @@ -252,22 +252,10 @@
   41.62  done
   41.63  
   41.64  instance bit0 :: (finite) comm_ring_1
   41.65 -  by (rule bit0.comm_ring_1)+
   41.66 +  by (rule bit0.comm_ring_1)
   41.67  
   41.68  instance bit1 :: (finite) comm_ring_1
   41.69 -  by (rule bit1.comm_ring_1)+
   41.70 -
   41.71 -instantiation bit0 and bit1 :: (finite) number_ring
   41.72 -begin
   41.73 -
   41.74 -definition "(number_of w :: _ bit0) = of_int w"
   41.75 -
   41.76 -definition "(number_of w :: _ bit1) = of_int w"
   41.77 -
   41.78 -instance proof
   41.79 -qed (rule number_of_bit0_def number_of_bit1_def)+
   41.80 -
   41.81 -end
   41.82 +  by (rule bit1.comm_ring_1)
   41.83  
   41.84  interpretation bit0:
   41.85    mod_ring "int CARD('a::finite bit0)"
   41.86 @@ -289,9 +277,11 @@
   41.87  lemmas bit0_induct [case_names of_int, induct type: bit0] = bit0.induct
   41.88  lemmas bit1_induct [case_names of_int, induct type: bit1] = bit1.induct
   41.89  
   41.90 -lemmas bit0_iszero_number_of [simp] = bit0.iszero_number_of
   41.91 -lemmas bit1_iszero_number_of [simp] = bit1.iszero_number_of
   41.92 +lemmas bit0_iszero_numeral [simp] = bit0.iszero_numeral
   41.93 +lemmas bit1_iszero_numeral [simp] = bit1.iszero_numeral
   41.94  
   41.95 +declare eq_numeral_iff_iszero [where 'a="('a::finite) bit0", standard, simp]
   41.96 +declare eq_numeral_iff_iszero [where 'a="('a::finite) bit1", standard, simp]
   41.97  
   41.98  subsection {* Syntax *}
   41.99  
    42.1 --- a/src/HOL/Library/Poly_Deriv.thy	Sat Mar 24 16:27:04 2012 +0100
    42.2 +++ b/src/HOL/Library/Poly_Deriv.thy	Sun Mar 25 20:15:39 2012 +0200
    42.3 @@ -71,7 +71,8 @@
    42.4  apply (subst power_Suc)
    42.5  apply (subst pderiv_mult)
    42.6  apply (erule ssubst)
    42.7 -apply (simp add: smult_add_left algebra_simps)
    42.8 +apply (simp only: of_nat_Suc smult_add_left smult_1_left)
    42.9 +apply (simp add: algebra_simps) (* FIXME *)
   42.10  done
   42.11  
   42.12  lemma DERIV_cmult2: "DERIV f x :> D ==> DERIV (%x. (f x) * c :: real) x :> D * c"
    43.1 --- a/src/HOL/Library/Polynomial.thy	Sat Mar 24 16:27:04 2012 +0100
    43.2 +++ b/src/HOL/Library/Polynomial.thy	Sun Mar 25 20:15:39 2012 +0200
    43.3 @@ -662,17 +662,6 @@
    43.4  
    43.5  instance poly :: (comm_ring_1) comm_ring_1 ..
    43.6  
    43.7 -instantiation poly :: (comm_ring_1) number_ring
    43.8 -begin
    43.9 -
   43.10 -definition
   43.11 -  "number_of k = (of_int k :: 'a poly)"
   43.12 -
   43.13 -instance
   43.14 -  by default (rule number_of_poly_def)
   43.15 -
   43.16 -end
   43.17 -
   43.18  
   43.19  subsection {* Polynomials form an integral domain *}
   43.20  
   43.21 @@ -1052,12 +1041,12 @@
   43.22  lemma poly_div_minus_left [simp]:
   43.23    fixes x y :: "'a::field poly"
   43.24    shows "(- x) div y = - (x div y)"
   43.25 -  using div_smult_left [of "- 1::'a"] by simp
   43.26 +  using div_smult_left [of "- 1::'a"] by (simp del: minus_one) (* FIXME *)
   43.27  
   43.28  lemma poly_mod_minus_left [simp]:
   43.29    fixes x y :: "'a::field poly"
   43.30    shows "(- x) mod y = - (x mod y)"
   43.31 -  using mod_smult_left [of "- 1::'a"] by simp
   43.32 +  using mod_smult_left [of "- 1::'a"] by (simp del: minus_one) (* FIXME *)
   43.33  
   43.34  lemma pdivmod_rel_smult_right:
   43.35    "\<lbrakk>a \<noteq> 0; pdivmod_rel x y q r\<rbrakk>
   43.36 @@ -1075,12 +1064,12 @@
   43.37    fixes x y :: "'a::field poly"
   43.38    shows "x div (- y) = - (x div y)"
   43.39    using div_smult_right [of "- 1::'a"]
   43.40 -  by (simp add: nonzero_inverse_minus_eq)
   43.41 +  by (simp add: nonzero_inverse_minus_eq del: minus_one) (* FIXME *)
   43.42  
   43.43  lemma poly_mod_minus_right [simp]:
   43.44    fixes x y :: "'a::field poly"
   43.45    shows "x mod (- y) = x mod y"
   43.46 -  using mod_smult_right [of "- 1::'a"] by simp
   43.47 +  using mod_smult_right [of "- 1::'a"] by (simp del: minus_one) (* FIXME *)
   43.48  
   43.49  lemma pdivmod_rel_mult:
   43.50    "\<lbrakk>pdivmod_rel x y q r; pdivmod_rel q z q' r'\<rbrakk>
    44.1 --- a/src/HOL/Library/Predicate_Compile_Alternative_Defs.thy	Sat Mar 24 16:27:04 2012 +0100
    44.2 +++ b/src/HOL/Library/Predicate_Compile_Alternative_Defs.thy	Sun Mar 25 20:15:39 2012 +0200
    44.3 @@ -54,8 +54,8 @@
    44.4  
    44.5  section {* Setup for Numerals *}
    44.6  
    44.7 -setup {* Predicate_Compile_Data.ignore_consts [@{const_name number_of}] *}
    44.8 -setup {* Predicate_Compile_Data.keep_functions [@{const_name number_of}] *}
    44.9 +setup {* Predicate_Compile_Data.ignore_consts [@{const_name numeral}, @{const_name neg_numeral}] *}
   44.10 +setup {* Predicate_Compile_Data.keep_functions [@{const_name numeral}, @{const_name neg_numeral}] *}
   44.11  
   44.12  setup {* Predicate_Compile_Data.ignore_consts [@{const_name div}, @{const_name mod}, @{const_name times}] *}
   44.13  
    45.1 --- a/src/HOL/Library/ROOT.ML	Sat Mar 24 16:27:04 2012 +0100
    45.2 +++ b/src/HOL/Library/ROOT.ML	Sun Mar 25 20:15:39 2012 +0200
    45.3 @@ -4,4 +4,4 @@
    45.4  use_thys ["Library", "List_Cset", "List_Prefix", "List_lexord", "Sublist_Order",
    45.5    "Product_Lattice",
    45.6    "Code_Char_chr", "Code_Char_ord", "Code_Integer", "Efficient_Nat"(*, "Code_Prolog"*),
    45.7 -  "Code_Real_Approx_By_Float" ];
    45.8 +  "Code_Real_Approx_By_Float", "Target_Numeral"];
    46.1 --- a/src/HOL/Library/Saturated.thy	Sat Mar 24 16:27:04 2012 +0100
    46.2 +++ b/src/HOL/Library/Saturated.thy	Sun Mar 25 20:15:39 2012 +0200
    46.3 @@ -157,20 +157,16 @@
    46.4    "nat_of (Sat n :: ('a::len) sat) = min (len_of TYPE('a)) n"
    46.5    by (rule nat_of_Abs_sat' [unfolded Abs_sat'_eq_of_nat])
    46.6  
    46.7 -instantiation sat :: (len) number_semiring
    46.8 -begin
    46.9 +lemma [code_abbrev]:
   46.10 +  "of_nat (numeral k) = (numeral k :: 'a::len sat)"
   46.11 +  by simp
   46.12  
   46.13 -definition
   46.14 -  number_of_sat_def [code del]: "number_of = Sat \<circ> nat"
   46.15 -
   46.16 -instance
   46.17 -  by default (simp add: number_of_sat_def)
   46.18 -
   46.19 -end
   46.20 +definition sat_of_nat :: "nat \<Rightarrow> ('a::len) sat"
   46.21 +  where [code_abbrev]: "sat_of_nat = of_nat"
   46.22  
   46.23  lemma [code abstract]:
   46.24 -  "nat_of (number_of n :: ('a::len) sat) = min (nat n) (len_of TYPE('a))"
   46.25 -  unfolding number_of_sat_def by simp
   46.26 +  "nat_of (sat_of_nat n :: ('a::len) sat) = min (len_of TYPE('a)) n"
   46.27 +  by (simp add: sat_of_nat_def)
   46.28  
   46.29  instance sat :: (len) finite
   46.30  proof
   46.31 @@ -252,4 +248,6 @@
   46.32  
   46.33  end
   46.34  
   46.35 +hide_const (open) sat_of_nat
   46.36 +
   46.37  end
    47.1 --- a/src/HOL/Library/Sum_of_Squares/sum_of_squares.ML	Sat Mar 24 16:27:04 2012 +0100
    47.2 +++ b/src/HOL/Library/Sum_of_Squares/sum_of_squares.ML	Sun Mar 25 20:15:39 2012 +0200
    47.3 @@ -866,10 +866,11 @@
    47.4     @{term "op / :: real => _"}, @{term "inverse :: real => _"},
    47.5     @{term "op ^ :: real => _"}, @{term "abs :: real => _"},
    47.6     @{term "min :: real => _"}, @{term "max :: real => _"},
    47.7 -   @{term "0::real"}, @{term "1::real"}, @{term "number_of :: int => real"},
    47.8 -   @{term "number_of :: int => nat"},
    47.9 -   @{term "Int.Bit0"}, @{term "Int.Bit1"},
   47.10 -   @{term "Int.Pls"}, @{term "Int.Min"}];
   47.11 +   @{term "0::real"}, @{term "1::real"},
   47.12 +   @{term "numeral :: num => nat"},
   47.13 +   @{term "numeral :: num => real"},
   47.14 +   @{term "neg_numeral :: num => real"},
   47.15 +   @{term "Num.Bit0"}, @{term "Num.Bit1"}, @{term "Num.One"}];
   47.16  
   47.17  fun check_sos kcts ct =
   47.18   let
    48.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    48.2 +++ b/src/HOL/Library/Target_Numeral.thy	Sun Mar 25 20:15:39 2012 +0200
    48.3 @@ -0,0 +1,726 @@
    48.4 +theory Target_Numeral
    48.5 +imports Main Code_Nat
    48.6 +begin
    48.7 +
    48.8 +subsection {* Type of target language numerals *}
    48.9 +
   48.10 +typedef (open) int = "UNIV \<Colon> int set"
   48.11 +  morphisms int_of of_int ..
   48.12 +
   48.13 +hide_type (open) int
   48.14 +hide_const (open) of_int
   48.15 +
   48.16 +lemma int_eq_iff:
   48.17 +  "k = l \<longleftrightarrow> int_of k = int_of l"
   48.18 +  using int_of_inject [of k l] ..
   48.19 +
   48.20 +lemma int_eqI:
   48.21 +  "int_of k = int_of l \<Longrightarrow> k = l"
   48.22 +  using int_eq_iff [of k l] by simp
   48.23 +
   48.24 +lemma int_of_int [simp]:
   48.25 +  "int_of (Target_Numeral.of_int k) = k"
   48.26 +  using of_int_inverse [of k] by simp
   48.27 +
   48.28 +lemma of_int_of [simp]:
   48.29 +  "Target_Numeral.of_int (int_of k) = k"
   48.30 +  using int_of_inverse [of k] by simp
   48.31 +
   48.32 +hide_fact (open) int_eq_iff int_eqI
   48.33 +
   48.34 +instantiation Target_Numeral.int :: ring_1
   48.35 +begin
   48.36 +
   48.37 +definition
   48.38 +  "0 = Target_Numeral.of_int 0"
   48.39 +
   48.40 +lemma int_of_zero [simp]:
   48.41 +  "int_of 0 = 0"
   48.42 +  by (simp add: zero_int_def)
   48.43 +
   48.44 +definition
   48.45 +  "1 = Target_Numeral.of_int 1"
   48.46 +
   48.47 +lemma int_of_one [simp]:
   48.48 +  "int_of 1 = 1"
   48.49 +  by (simp add: one_int_def)
   48.50 +
   48.51 +definition
   48.52 +  "k + l = Target_Numeral.of_int (int_of k + int_of l)"
   48.53 +
   48.54 +lemma int_of_plus [simp]:
   48.55 +  "int_of (k + l) = int_of k + int_of l"
   48.56 +  by (simp add: plus_int_def)
   48.57 +
   48.58 +definition
   48.59 +  "- k = Target_Numeral.of_int (- int_of k)"
   48.60 +
   48.61 +lemma int_of_uminus [simp]:
   48.62 +  "int_of (- k) = - int_of k"
   48.63 +  by (simp add: uminus_int_def)
   48.64 +
   48.65 +definition
   48.66 +  "k - l = Target_Numeral.of_int (int_of k - int_of l)"
   48.67 +
   48.68 +lemma int_of_minus [simp]:
   48.69 +  "int_of (k - l) = int_of k - int_of l"
   48.70 +  by (simp add: minus_int_def)
   48.71 +
   48.72 +definition
   48.73 +  "k * l = Target_Numeral.of_int (int_of k * int_of l)"
   48.74 +
   48.75 +lemma int_of_times [simp]:
   48.76 +  "int_of (k * l) = int_of k * int_of l"
   48.77 +  by (simp add: times_int_def)
   48.78 +
   48.79 +instance proof
   48.80 +qed (auto simp add: Target_Numeral.int_eq_iff algebra_simps)
   48.81 +
   48.82 +end
   48.83 +
   48.84 +lemma int_of_of_nat [simp]:
   48.85 +  "int_of (of_nat n) = of_nat n"
   48.86 +  by (induct n) simp_all
   48.87 +
   48.88 +definition nat_of :: "Target_Numeral.int \<Rightarrow> nat" where
   48.89 +  "nat_of k = Int.nat (int_of k)"
   48.90 +
   48.91 +lemma nat_of_of_nat [simp]:
   48.92 +  "nat_of (of_nat n) = n"
   48.93 +  by (simp add: nat_of_def)
   48.94 +
   48.95 +lemma int_of_of_int [simp]:
   48.96 +  "int_of (of_int k) = k"
   48.97 +  by (induct k) (simp_all, simp only: neg_numeral_def numeral_One int_of_uminus int_of_one)
   48.98 +
   48.99 +lemma of_int_of_int [simp, code_abbrev]:
  48.100 +  "Target_Numeral.of_int = of_int"
  48.101 +  by rule (simp add: Target_Numeral.int_eq_iff)
  48.102 +
  48.103 +lemma int_of_numeral [simp]:
  48.104 +  "int_of (numeral k) = numeral k"
  48.105 +  using int_of_of_int [of "numeral k"] by simp
  48.106 +
  48.107 +lemma int_of_neg_numeral [simp]:
  48.108 +  "int_of (neg_numeral k) = neg_numeral k"
  48.109 +  by (simp only: neg_numeral_def int_of_uminus) simp
  48.110 +
  48.111 +lemma int_of_sub [simp]:
  48.112 +  "int_of (Num.sub k l) = Num.sub k l"
  48.113 +  by (simp only: Num.sub_def int_of_minus int_of_numeral)
  48.114 +
  48.115 +instantiation Target_Numeral.int :: "{ring_div, equal, linordered_idom}"
  48.116 +begin
  48.117 +
  48.118 +definition
  48.119 +  "k div l = of_int (int_of k div int_of l)"
  48.120 +
  48.121 +lemma int_of_div [simp]:
  48.122 +  "int_of (k div l) = int_of k div int_of l"
  48.123 +  by (simp add: div_int_def)
  48.124 +
  48.125 +definition
  48.126 +  "k mod l = of_int (int_of k mod int_of l)"
  48.127 +
  48.128 +lemma int_of_mod [simp]:
  48.129 +  "int_of (k mod l) = int_of k mod int_of l"
  48.130 +  by (simp add: mod_int_def)
  48.131 +
  48.132 +definition
  48.133 +  "\<bar>k\<bar> = of_int \<bar>int_of k\<bar>"
  48.134 +
  48.135 +lemma int_of_abs [simp]:
  48.136 +  "int_of \<bar>k\<bar> = \<bar>int_of k\<bar>"
  48.137 +  by (simp add: abs_int_def)
  48.138 +
  48.139 +definition
  48.140 +  "sgn k = of_int (sgn (int_of k))"
  48.141 +
  48.142 +lemma int_of_sgn [simp]:
  48.143 +  "int_of (sgn k) = sgn (int_of k)"
  48.144 +  by (simp add: sgn_int_def)
  48.145 +
  48.146 +definition
  48.147 +  "k \<le> l \<longleftrightarrow> int_of k \<le> int_of l"
  48.148 +
  48.149 +definition
  48.150 +  "k < l \<longleftrightarrow> int_of k < int_of l"
  48.151 +
  48.152 +definition
  48.153 +  "HOL.equal k l \<longleftrightarrow> HOL.equal (int_of k) (int_of l)"
  48.154 +
  48.155 +instance proof
  48.156 +qed (auto simp add: Target_Numeral.int_eq_iff algebra_simps
  48.157 +  less_eq_int_def less_int_def equal_int_def equal)
  48.158 +
  48.159 +end
  48.160 +
  48.161 +lemma int_of_min [simp]:
  48.162 +  "int_of (min k l) = min (int_of k) (int_of l)"
  48.163 +  by (simp add: min_def less_eq_int_def)
  48.164 +
  48.165 +lemma int_of_max [simp]:
  48.166 +  "int_of (max k l) = max (int_of k) (int_of l)"
  48.167 +  by (simp add: max_def less_eq_int_def)
  48.168 +
  48.169 +
  48.170 +subsection {* Code theorems for target language numerals *}
  48.171 +
  48.172 +text {* Constructors *}
  48.173 +
  48.174 +definition Pos :: "num \<Rightarrow> Target_Numeral.int" where
  48.175 +  [simp, code_abbrev]: "Pos = numeral"
  48.176 +
  48.177 +definition Neg :: "num \<Rightarrow> Target_Numeral.int" where
  48.178 +  [simp, code_abbrev]: "Neg = neg_numeral"
  48.179 +
  48.180 +code_datatype "0::Target_Numeral.int" Pos Neg
  48.181 +
  48.182 +
  48.183 +text {* Auxiliary operations *}
  48.184 +
  48.185 +definition dup :: "Target_Numeral.int \<Rightarrow> Target_Numeral.int" where
  48.186 +  [simp]: "dup k = k + k"
  48.187 +
  48.188 +lemma dup_code [code]:
  48.189 +  "dup 0 = 0"
  48.190 +  "dup (Pos n) = Pos (Num.Bit0 n)"
  48.191 +  "dup (Neg n) = Neg (Num.Bit0 n)"
  48.192 +  unfolding Pos_def Neg_def neg_numeral_def
  48.193 +  by (simp_all add: numeral_Bit0)
  48.194 +
  48.195 +definition sub :: "num \<Rightarrow> num \<Rightarrow> Target_Numeral.int" where
  48.196 +  [simp]: "sub m n = numeral m - numeral n"
  48.197 +
  48.198 +lemma sub_code [code]:
  48.199 +  "sub Num.One Num.One = 0"
  48.200 +  "sub (Num.Bit0 m) Num.One = Pos (Num.BitM m)"
  48.201 +  "sub (Num.Bit1 m) Num.One = Pos (Num.Bit0 m)"
  48.202 +  "sub Num.One (Num.Bit0 n) = Neg (Num.BitM n)"
  48.203 +  "sub Num.One (Num.Bit1 n) = Neg (Num.Bit0 n)"
  48.204 +  "sub (Num.Bit0 m) (Num.Bit0 n) = dup (sub m n)"
  48.205 +  "sub (Num.Bit1 m) (Num.Bit1 n) = dup (sub m n)"
  48.206 +  "sub (Num.Bit1 m) (Num.Bit0 n) = dup (sub m n) + 1"
  48.207 +  "sub (Num.Bit0 m) (Num.Bit1 n) = dup (sub m n) - 1"
  48.208 +  unfolding sub_def dup_def numeral.simps Pos_def Neg_def
  48.209 +    neg_numeral_def numeral_BitM
  48.210 +  by (simp_all only: algebra_simps add.comm_neutral)
  48.211 +
  48.212 +
  48.213 +text {* Implementations *}
  48.214 +
  48.215 +lemma one_int_code [code, code_unfold]:
  48.216 +  "1 = Pos Num.One"
  48.217 +  by simp
  48.218 +
  48.219 +lemma plus_int_code [code]:
  48.220 +  "k + 0 = (k::Target_Numeral.int)"
  48.221 +  "0 + l = (l::Target_Numeral.int)"
  48.222 +  "Pos m + Pos n = Pos (m + n)"
  48.223 +  "Pos m + Neg n = sub m n"
  48.224 +  "Neg m + Pos n = sub n m"
  48.225 +  "Neg m + Neg n = Neg (m + n)"
  48.226 +  by simp_all
  48.227 +
  48.228 +lemma uminus_int_code [code]:
  48.229 +  "uminus 0 = (0::Target_Numeral.int)"
  48.230 +  "uminus (Pos m) = Neg m"
  48.231 +  "uminus (Neg m) = Pos m"
  48.232 +  by simp_all
  48.233 +
  48.234 +lemma minus_int_code [code]:
  48.235 +  "k - 0 = (k::Target_Numeral.int)"
  48.236 +  "0 - l = uminus (l::Target_Numeral.int)"
  48.237 +  "Pos m - Pos n = sub m n"
  48.238 +  "Pos m - Neg n = Pos (m + n)"
  48.239 +  "Neg m - Pos n = Neg (m + n)"
  48.240 +  "Neg m - Neg n = sub n m"
  48.241 +  by simp_all
  48.242 +
  48.243 +lemma times_int_code [code]:
  48.244 +  "k * 0 = (0::Target_Numeral.int)"
  48.245 +  "0 * l = (0::Target_Numeral.int)"
  48.246 +  "Pos m * Pos n = Pos (m * n)"
  48.247 +  "Pos m * Neg n = Neg (m * n)"
  48.248 +  "Neg m * Pos n = Neg (m * n)"
  48.249 +  "Neg m * Neg n = Pos (m * n)"
  48.250 +  by simp_all
  48.251 +
  48.252 +definition divmod :: "Target_Numeral.int \<Rightarrow> Target_Numeral.int \<Rightarrow> Target_Numeral.int \<times> Target_Numeral.int" where
  48.253 +  "divmod k l = (k div l, k mod l)"
  48.254 +
  48.255 +lemma fst_divmod [simp]:
  48.256 +  "fst (divmod k l) = k div l"
  48.257 +  by (simp add: divmod_def)
  48.258 +
  48.259 +lemma snd_divmod [simp]:
  48.260 +  "snd (divmod k l) = k mod l"
  48.261 +  by (simp add: divmod_def)
  48.262 +
  48.263 +definition divmod_abs :: "Target_Numeral.int \<Rightarrow> Target_Numeral.int \<Rightarrow> Target_Numeral.int \<times> Target_Numeral.int" where
  48.264 +  "divmod_abs k l = (\<bar>k\<bar> div \<bar>l\<bar>, \<bar>k\<bar> mod \<bar>l\<bar>)"
  48.265 +
  48.266 +lemma fst_divmod_abs [simp]:
  48.267 +  "fst (divmod_abs k l) = \<bar>k\<bar> div \<bar>l\<bar>"
  48.268 +  by (simp add: divmod_abs_def)
  48.269 +
  48.270 +lemma snd_divmod_abs [simp]:
  48.271 +  "snd (divmod_abs k l) = \<bar>k\<bar> mod \<bar>l\<bar>"
  48.272 +  by (simp add: divmod_abs_def)
  48.273 +
  48.274 +lemma divmod_abs_terminate_code [code]:
  48.275 +  "divmod_abs (Neg k) (Neg l) = divmod_abs (Pos k) (Pos l)"
  48.276 +  "divmod_abs (Neg k) (Pos l) = divmod_abs (Pos k) (Pos l)"
  48.277 +  "divmod_abs (Pos k) (Neg l) = divmod_abs (Pos k) (Pos l)"
  48.278 +  "divmod_abs j 0 = (0, \<bar>j\<bar>)"
  48.279 +  "divmod_abs 0 j = (0, 0)"
  48.280 +  by (simp_all add: prod_eq_iff)
  48.281 +
  48.282 +lemma divmod_abs_rec_code [code]:
  48.283 +  "divmod_abs (Pos k) (Pos l) =
  48.284 +    (let j = sub k l in
  48.285 +       if j < 0 then (0, Pos k)
  48.286 +       else let (q, r) = divmod_abs j (Pos l) in (q + 1, r))"
  48.287 +  by (auto simp add: prod_eq_iff Target_Numeral.int_eq_iff Let_def prod_case_beta
  48.288 +    sub_non_negative sub_negative div_pos_pos_trivial mod_pos_pos_trivial div_pos_geq mod_pos_geq)
  48.289 +
  48.290 +lemma divmod_code [code]: "divmod k l =
  48.291 +  (if k = 0 then (0, 0) else if l = 0 then (0, k) else
  48.292 +  (apsnd \<circ> times \<circ> sgn) l (if sgn k = sgn l
  48.293 +    then divmod_abs k l
  48.294 +    else (let (r, s) = divmod_abs k l in
  48.295 +      if s = 0 then (- r, 0) else (- r - 1, \<bar>l\<bar> - s))))"
  48.296 +proof -
  48.297 +  have aux1: "\<And>k l::int. sgn k = sgn l \<longleftrightarrow> k = 0 \<and> l = 0 \<or> 0 < l \<and> 0 < k \<or> l < 0 \<and> k < 0"
  48.298 +    by (auto simp add: sgn_if)
  48.299 +  have aux2: "\<And>q::int. - int_of k = int_of l * q \<longleftrightarrow> int_of k = int_of l * - q" by auto
  48.300 +  show ?thesis
  48.301 +    by (simp add: prod_eq_iff Target_Numeral.int_eq_iff prod_case_beta aux1)
  48.302 +      (auto simp add: zdiv_zminus1_eq_if zmod_zminus1_eq_if zdiv_zminus2 zmod_zminus2 aux2)
  48.303 +qed
  48.304 +
  48.305 +lemma div_int_code [code]:
  48.306 +  "k div l = fst (divmod k l)"
  48.307 +  by simp
  48.308 +
  48.309 +lemma div_mod_code [code]:
  48.310 +  "k mod l = snd (divmod k l)"
  48.311 +  by simp
  48.312 +
  48.313 +lemma equal_int_code [code]:
  48.314 +  "HOL.equal 0 (0::Target_Numeral.int) \<longleftrightarrow> True"
  48.315 +  "HOL.equal 0 (Pos l) \<longleftrightarrow> False"
  48.316 +  "HOL.equal 0 (Neg l) \<longleftrightarrow> False"
  48.317 +  "HOL.equal (Pos k) 0 \<longleftrightarrow> False"
  48.318 +  "HOL.equal (Pos k) (Pos l) \<longleftrightarrow> HOL.equal k l"
  48.319 +  "HOL.equal (Pos k) (Neg l) \<longleftrightarrow> False"
  48.320 +  "HOL.equal (Neg k) 0 \<longleftrightarrow> False"
  48.321 +  "HOL.equal (Neg k) (Pos l) \<longleftrightarrow> False"
  48.322 +  "HOL.equal (Neg k) (Neg l) \<longleftrightarrow> HOL.equal k l"
  48.323 +  by (simp_all add: equal Target_Numeral.int_eq_iff)
  48.324 +
  48.325 +lemma equal_int_refl [code nbe]:
  48.326 +  "HOL.equal (k::Target_Numeral.int) k \<longleftrightarrow> True"
  48.327 +  by (fact equal_refl)
  48.328 +
  48.329 +lemma less_eq_int_code [code]:
  48.330 +  "0 \<le> (0::Target_Numeral.int) \<longleftrightarrow> True"
  48.331 +  "0 \<le> Pos l \<longleftrightarrow> True"
  48.332 +  "0 \<le> Neg l \<longleftrightarrow> False"
  48.333 +  "Pos k \<le> 0 \<longleftrightarrow> False"
  48.334 +  "Pos k \<le> Pos l \<longleftrightarrow> k \<le> l"
  48.335 +  "Pos k \<le> Neg l \<longleftrightarrow> False"
  48.336 +  "Neg k \<le> 0 \<longleftrightarrow> True"
  48.337 +  "Neg k \<le> Pos l \<longleftrightarrow> True"
  48.338 +  "Neg k \<le> Neg l \<longleftrightarrow> l \<le> k"
  48.339 +  by (simp_all add: less_eq_int_def)
  48.340 +
  48.341 +lemma less_int_code [code]:
  48.342 +  "0 < (0::Target_Numeral.int) \<longleftrightarrow> False"
  48.343 +  "0 < Pos l \<longleftrightarrow> True"
  48.344 +  "0 < Neg l \<longleftrightarrow> False"
  48.345 +  "Pos k < 0 \<longleftrightarrow> False"
  48.346 +  "Pos k < Pos l \<longleftrightarrow> k < l"
  48.347 +  "Pos k < Neg l \<longleftrightarrow> False"
  48.348 +  "Neg k < 0 \<longleftrightarrow> True"
  48.349 +  "Neg k < Pos l \<longleftrightarrow> True"
  48.350 +  "Neg k < Neg l \<longleftrightarrow> l < k"
  48.351 +  by (simp_all add: less_int_def)
  48.352 +
  48.353 +lemma nat_of_code [code]:
  48.354 +  "nat_of (Neg k) = 0"
  48.355 +  "nat_of 0 = 0"
  48.356 +  "nat_of (Pos k) = nat_of_num k"
  48.357 +  by (simp_all add: nat_of_def nat_of_num_numeral)
  48.358 +
  48.359 +lemma int_of_code [code]:
  48.360 +  "int_of (Neg k) = neg_numeral k"
  48.361 +  "int_of 0 = 0"
  48.362 +  "int_of (Pos k) = numeral k"
  48.363 +  by simp_all
  48.364 +
  48.365 +lemma of_int_code [code]:
  48.366 +  "Target_Numeral.of_int (Int.Neg k) = neg_numeral k"
  48.367 +  "Target_Numeral.of_int 0 = 0"
  48.368 +  "Target_Numeral.of_int (Int.Pos k) = numeral k"
  48.369 +  by simp_all
  48.370 +
  48.371 +definition num_of_int :: "Target_Numeral.int \<Rightarrow> num" where
  48.372 +  "num_of_int = num_of_nat \<circ> nat_of"
  48.373 +
  48.374 +lemma num_of_int_code [code]:
  48.375 +  "num_of_int k = (if k \<le> 1 then Num.One
  48.376 +     else let
  48.377 +       (l, j) = divmod k 2;
  48.378 +       l' = num_of_int l + num_of_int l
  48.379 +     in if j = 0 then l' else l' + Num.One)"
  48.380 +proof -
  48.381 +  {
  48.382 +    assume "int_of k mod 2 = 1"
  48.383 +    then have "nat (int_of k mod 2) = nat 1" by simp
  48.384 +    moreover assume *: "1 < int_of k"
  48.385 +    ultimately have **: "nat (int_of k) mod 2 = 1" by (simp add: nat_mod_distrib)
  48.386 +    have "num_of_nat (nat (int_of k)) =
  48.387 +      num_of_nat (2 * (nat (int_of k) div 2) + nat (int_of k) mod 2)"
  48.388 +      by simp
  48.389 +    then have "num_of_nat (nat (int_of k)) =
  48.390 +      num_of_nat (nat (int_of k) div 2 + nat (int_of k) div 2 + nat (int_of k) mod 2)"
  48.391 +      by (simp add: nat_mult_2)
  48.392 +    with ** have "num_of_nat (nat (int_of k)) =
  48.393 +      num_of_nat (nat (int_of k) div 2 + nat (int_of k) div 2 + 1)"
  48.394 +      by simp
  48.395 +  }
  48.396 +  note aux = this
  48.397 +  show ?thesis
  48.398 +    by (auto simp add: num_of_int_def nat_of_def Let_def prod_case_beta
  48.399 +      not_le Target_Numeral.int_eq_iff less_eq_int_def
  48.400 +      nat_mult_distrib nat_div_distrib num_of_nat_One num_of_nat_plus_distrib
  48.401 +       nat_mult_2 aux add_One)
  48.402 +qed
  48.403 +
  48.404 +hide_const (open) int_of nat_of Pos Neg sub dup divmod_abs num_of_int
  48.405 +
  48.406 +
  48.407 +subsection {* Serializer setup for target language numerals *}
  48.408 +
  48.409 +code_type Target_Numeral.int
  48.410 +  (SML "IntInf.int")
  48.411 +  (OCaml "Big'_int.big'_int")
  48.412 +  (Haskell "Integer")
  48.413 +  (Scala "BigInt")
  48.414 +  (Eval "int")
  48.415 +
  48.416 +code_instance Target_Numeral.int :: equal
  48.417 +  (Haskell -)
  48.418 +
  48.419 +code_const "0::Target_Numeral.int"
  48.420 +  (SML "0")
  48.421 +  (OCaml "Big'_int.zero'_big'_int")
  48.422 +  (Haskell "0")
  48.423 +  (Scala "BigInt(0)")
  48.424 +
  48.425 +setup {*
  48.426 +  fold (Numeral.add_code @{const_name Target_Numeral.Pos}
  48.427 +    false Code_Printer.literal_numeral) ["SML", "OCaml", "Haskell", "Scala"]
  48.428 +*}
  48.429 +
  48.430 +setup {*
  48.431 +  fold (Numeral.add_code @{const_name Target_Numeral.Neg}
  48.432 +    true Code_Printer.literal_numeral) ["SML", "OCaml", "Haskell", "Scala"]
  48.433 +*}
  48.434 +
  48.435 +code_const "plus :: Target_Numeral.int \<Rightarrow> _ \<Rightarrow> _"
  48.436 +  (SML "IntInf.+ ((_), (_))")
  48.437 +  (OCaml "Big'_int.add'_big'_int")
  48.438 +  (Haskell infixl 6 "+")
  48.439 +  (Scala infixl 7 "+")
  48.440 +  (Eval infixl 8 "+")
  48.441 +
  48.442 +code_const "uminus :: Target_Numeral.int \<Rightarrow> _"
  48.443 +  (SML "IntInf.~")
  48.444 +  (OCaml "Big'_int.minus'_big'_int")
  48.445 +  (Haskell "negate")
  48.446 +  (Scala "!(- _)")
  48.447 +  (Eval "~/ _")
  48.448 +
  48.449 +code_const "minus :: Target_Numeral.int \<Rightarrow> _"
  48.450 +  (SML "IntInf.- ((_), (_))")
  48.451 +  (OCaml "Big'_int.sub'_big'_int")
  48.452 +  (Haskell infixl 6 "-")
  48.453 +  (Scala infixl 7 "-")
  48.454 +  (Eval infixl 8 "-")
  48.455 +
  48.456 +code_const Target_Numeral.dup
  48.457 +  (SML "IntInf.*/ (2,/ (_))")
  48.458 +  (OCaml "Big'_int.mult'_big'_int/ 2")
  48.459 +  (Haskell "!(2 * _)")
  48.460 +  (Scala "!(2 * _)")
  48.461 +  (Eval "!(2 * _)")
  48.462 +
  48.463 +code_const Target_Numeral.sub
  48.464 +  (SML "!(raise/ Fail/ \"sub\")")
  48.465 +  (OCaml "failwith/ \"sub\"")
  48.466 +  (Haskell "error/ \"sub\"")
  48.467 +  (Scala "!error(\"sub\")")
  48.468 +
  48.469 +code_const "times :: Target_Numeral.int \<Rightarrow> _ \<Rightarrow> _"
  48.470 +  (SML "IntInf.* ((_), (_))")
  48.471 +  (OCaml "Big'_int.mult'_big'_int")
  48.472 +  (Haskell infixl 7 "*")
  48.473 +  (Scala infixl 8 "*")
  48.474 +  (Eval infixl 9 "*")
  48.475 +
  48.476 +code_const Target_Numeral.divmod_abs
  48.477 +  (SML "IntInf.divMod/ (IntInf.abs _,/ IntInf.abs _)")
  48.478 +  (OCaml "Big'_int.quomod'_big'_int/ (Big'_int.abs'_big'_int _)/ (Big'_int.abs'_big'_int _)")
  48.479 +  (Haskell "divMod/ (abs _)/ (abs _)")
  48.480 +  (Scala "!((k: BigInt) => (l: BigInt) =>/ if (l == 0)/ (BigInt(0), k) else/ (k.abs '/% l.abs))")
  48.481 +  (Eval "Integer.div'_mod/ (abs _)/ (abs _)")
  48.482 +
  48.483 +code_const "HOL.equal :: Target_Numeral.int \<Rightarrow> _ \<Rightarrow> bool"
  48.484 +  (SML "!((_ : IntInf.int) = _)")
  48.485 +  (OCaml "Big'_int.eq'_big'_int")
  48.486 +  (Haskell infix 4 "==")
  48.487 +  (Scala infixl 5 "==")
  48.488 +  (Eval infixl 6 "=")
  48.489 +
  48.490 +code_const "less_eq :: Target_Numeral.int \<Rightarrow> _ \<Rightarrow> bool"
  48.491 +  (SML "IntInf.<= ((_), (_))")
  48.492 +  (OCaml "Big'_int.le'_big'_int")
  48.493 +  (Haskell infix 4 "<=")
  48.494 +  (Scala infixl 4 "<=")
  48.495 +  (Eval infixl 6 "<=")
  48.496 +
  48.497 +code_const "less :: Target_Numeral.int \<Rightarrow> _ \<Rightarrow> bool"
  48.498 +  (SML "IntInf.< ((_), (_))")
  48.499 +  (OCaml "Big'_int.lt'_big'_int")
  48.500 +  (Haskell infix 4 "<")
  48.501 +  (Scala infixl 4 "<")
  48.502 +  (Eval infixl 6 "<")
  48.503 +
  48.504 +ML {*
  48.505 +structure Target_Numeral =
  48.506 +struct
  48.507 +
  48.508 +val T = @{typ "Target_Numeral.int"};
  48.509 +
  48.510 +end;
  48.511 +*}
  48.512 +
  48.513 +code_reserved Eval Target_Numeral
  48.514 +
  48.515 +code_const "Code_Evaluation.term_of \<Colon> Target_Numeral.int \<Rightarrow> term"
  48.516 +  (Eval "HOLogic.mk'_number/ Target'_Numeral.T")
  48.517 +
  48.518 +code_modulename SML
  48.519 +  Target_Numeral Arith
  48.520 +
  48.521 +code_modulename OCaml
  48.522 +  Target_Numeral Arith
  48.523 +
  48.524 +code_modulename Haskell
  48.525 +  Target_Numeral Arith
  48.526 +
  48.527 +
  48.528 +subsection {* Implementation for @{typ int} *}
  48.529 +
  48.530 +code_datatype Target_Numeral.int_of
  48.531 +
  48.532 +lemma [code, code del]:
  48.533 +  "Target_Numeral.of_int = Target_Numeral.of_int" ..
  48.534 +
  48.535 +lemma [code]:
  48.536 +  "Target_Numeral.of_int (Target_Numeral.int_of k) = k"
  48.537 +  by (simp add: Target_Numeral.int_eq_iff)
  48.538 +
  48.539 +declare Int.Pos_def [code]
  48.540 +
  48.541 +lemma [code_abbrev]:
  48.542 +  "Target_Numeral.int_of (Target_Numeral.Pos k) = Int.Pos k"
  48.543 +  by simp
  48.544 +
  48.545 +declare Int.Neg_def [code]
  48.546 +
  48.547 +lemma [code_abbrev]:
  48.548 +  "Target_Numeral.int_of (Target_Numeral.Neg k) = Int.Neg k"
  48.549 +  by simp
  48.550 +
  48.551 +lemma [code]:
  48.552 +  "0 = Target_Numeral.int_of 0"
  48.553 +  by simp
  48.554 +
  48.555 +lemma [code]:
  48.556 +  "1 = Target_Numeral.int_of 1"
  48.557 +  by simp
  48.558 +
  48.559 +lemma [code]:
  48.560 +  "k + l = Target_Numeral.int_of (of_int k + of_int l)"
  48.561 +  by simp
  48.562 +
  48.563 +lemma [code]:
  48.564 +  "- k = Target_Numeral.int_of (- of_int k)"
  48.565 +  by simp
  48.566 +
  48.567 +lemma [code]:
  48.568 +  "k - l = Target_Numeral.int_of (of_int k - of_int l)"
  48.569 +  by simp
  48.570 +
  48.571 +lemma [code]:
  48.572 +  "Int.dup k = Target_Numeral.int_of (Target_Numeral.dup (of_int k))"
  48.573 +  by simp
  48.574 +
  48.575 +lemma [code, code del]:
  48.576 +  "Int.sub = Int.sub" ..
  48.577 +
  48.578 +lemma [code]:
  48.579 +  "k * l = Target_Numeral.int_of (of_int k * of_int l)"
  48.580 +  by simp
  48.581 +
  48.582 +lemma [code]:
  48.583 +  "pdivmod k l = map_pair Target_Numeral.int_of Target_Numeral.int_of
  48.584 +    (Target_Numeral.divmod_abs (of_int k) (of_int l))"
  48.585 +  by (simp add: prod_eq_iff pdivmod_def)
  48.586 +
  48.587 +lemma [code]:
  48.588 +  "k div l = Target_Numeral.int_of (of_int k div of_int l)"
  48.589 +  by simp
  48.590 +
  48.591 +lemma [code]:
  48.592 +  "k mod l = Target_Numeral.int_of (of_int k mod of_int l)"
  48.593 +  by simp
  48.594 +
  48.595 +lemma [code]:
  48.596 +  "HOL.equal k l = HOL.equal (of_int k :: Target_Numeral.int) (of_int l)"
  48.597 +  by (simp add: equal Target_Numeral.int_eq_iff)
  48.598 +
  48.599 +lemma [code]:
  48.600 +  "k \<le> l \<longleftrightarrow> (of_int k :: Target_Numeral.int) \<le> of_int l"
  48.601 +  by (simp add: less_eq_int_def)
  48.602 +
  48.603 +lemma [code]:
  48.604 +  "k < l \<longleftrightarrow> (of_int k :: Target_Numeral.int) < of_int l"
  48.605 +  by (simp add: less_int_def)
  48.606 +
  48.607 +lemma (in ring_1) of_int_code:
  48.608 +  "of_int k = (if k = 0 then 0
  48.609 +     else if k < 0 then - of_int (- k)
  48.610 +     else let
  48.611 +       (l, j) = divmod_int k 2;
  48.612 +       l' = 2 * of_int l
  48.613 +     in if j = 0 then l' else l' + 1)"
  48.614 +proof -
  48.615 +  from mod_div_equality have *: "of_int k = of_int (k div 2 * 2 + k mod 2)" by simp
  48.616 +  show ?thesis
  48.617 +    by (simp add: Let_def divmod_int_mod_div mod_2_not_eq_zero_eq_one_int
  48.618 +      of_int_add [symmetric]) (simp add: * mult_commute)
  48.619 +qed
  48.620 +
  48.621 +declare of_int_code [code]
  48.622 +
  48.623 +
  48.624 +subsection {* Implementation for @{typ nat} *}
  48.625 +
  48.626 +definition of_nat :: "nat \<Rightarrow> Target_Numeral.int" where
  48.627 +  [code_abbrev]: "of_nat = Nat.of_nat"
  48.628 +
  48.629 +hide_const (open) of_nat
  48.630 +
  48.631 +lemma int_of_nat [simp]:
  48.632 +  "Target_Numeral.int_of (Target_Numeral.of_nat n) = of_nat n"
  48.633 +  by (simp add: of_nat_def)
  48.634 +
  48.635 +lemma [code abstype]:
  48.636 +  "Target_Numeral.nat_of (Target_Numeral.of_nat n) = n"
  48.637 +  by (simp add: nat_of_def)
  48.638 +
  48.639 +lemma [code_abbrev]:
  48.640 +  "nat (Int.Pos k) = nat_of_num k"
  48.641 +  by (simp add: nat_of_num_numeral)
  48.642 +
  48.643 +lemma [code abstract]:
  48.644 +  "Target_Numeral.of_nat 0 = 0"
  48.645 +  by (simp add: Target_Numeral.int_eq_iff)
  48.646 +
  48.647 +lemma [code abstract]:
  48.648 +  "Target_Numeral.of_nat 1 = 1"
  48.649 +  by (simp add: Target_Numeral.int_eq_iff)
  48.650 +
  48.651 +lemma [code abstract]:
  48.652 +  "Target_Numeral.of_nat (m + n) = of_nat m + of_nat n"
  48.653 +  by (simp add: Target_Numeral.int_eq_iff)
  48.654 +
  48.655 +lemma [code abstract]:
  48.656 +  "Target_Numeral.of_nat (Code_Nat.dup n) = Target_Numeral.dup (of_nat n)"
  48.657 +  by (simp add: Target_Numeral.int_eq_iff Code_Nat.dup_def)
  48.658 +
  48.659 +lemma [code, code del]:
  48.660 +  "Code_Nat.sub = Code_Nat.sub" ..
  48.661 +
  48.662 +lemma [code abstract]:
  48.663 +  "Target_Numeral.of_nat (m - n) = max 0 (of_nat m - of_nat n)"
  48.664 +  by (simp add: Target_Numeral.int_eq_iff)
  48.665 +
  48.666 +lemma [code abstract]:
  48.667 +  "Target_Numeral.of_nat (m * n) = of_nat m * of_nat n"
  48.668 +  by (simp add: Target_Numeral.int_eq_iff of_nat_mult)
  48.669 +
  48.670 +lemma [code abstract]:
  48.671 +  "Target_Numeral.of_nat (m div n) = of_nat m div of_nat n"
  48.672 +  by (simp add: Target_Numeral.int_eq_iff zdiv_int)
  48.673 +
  48.674 +lemma [code abstract]:
  48.675 +  "Target_Numeral.of_nat (m mod n) = of_nat m mod of_nat n"
  48.676 +  by (simp add: Target_Numeral.int_eq_iff zmod_int)
  48.677 +
  48.678 +lemma [code]:
  48.679 +  "Divides.divmod_nat m n = (m div n, m mod n)"
  48.680 +  by (simp add: prod_eq_iff)
  48.681 +
  48.682 +lemma [code]:
  48.683 +  "HOL.equal m n = HOL.equal (of_nat m :: Target_Numeral.int) (of_nat n)"
  48.684 +  by (simp add: equal Target_Numeral.int_eq_iff)
  48.685 +
  48.686 +lemma [code]:
  48.687 +  "m \<le> n \<longleftrightarrow> (of_nat m :: Target_Numeral.int) \<le> of_nat n"
  48.688 +  by (simp add: less_eq_int_def)
  48.689 +
  48.690 +lemma [code]:
  48.691 +  "m < n \<longleftrightarrow> (of_nat m :: Target_Numeral.int) < of_nat n"
  48.692 +  by (simp add: less_int_def)
  48.693 +
  48.694 +lemma num_of_nat_code [code]:
  48.695 +  "num_of_nat = Target_Numeral.num_of_int \<circ> Target_Numeral.of_nat"
  48.696 +  by (simp add: fun_eq_iff num_of_int_def of_nat_def)
  48.697 +
  48.698 +lemma (in semiring_1) of_nat_code:
  48.699 +  "of_nat n = (if n = 0 then 0
  48.700 +     else let
  48.701 +       (m, q) = divmod_nat n 2;
  48.702 +       m' = 2 * of_nat m
  48.703 +     in if q = 0 then m' else m' + 1)"
  48.704 +proof -
  48.705 +  from mod_div_equality have *: "of_nat n = of_nat (n div 2 * 2 + n mod 2)" by simp
  48.706 +  show ?thesis
  48.707 +    by (simp add: Let_def divmod_nat_div_mod mod_2_not_eq_zero_eq_one_nat
  48.708 +      of_nat_add [symmetric])
  48.709 +      (simp add: * mult_commute of_nat_mult add_commute)
  48.710 +qed
  48.711 +
  48.712 +declare of_nat_code [code]
  48.713 +
  48.714 +text {* Conversions between @{typ nat} and @{typ int} *}
  48.715 +
  48.716 +definition int :: "nat \<Rightarrow> int" where
  48.717 +  [code_abbrev]: "int = of_nat"
  48.718 +
  48.719 +hide_const (open) int
  48.720 +
  48.721 +lemma [code]:
  48.722 +  "Target_Numeral.int n = Target_Numeral.int_of (of_nat n)"
  48.723 +  by (simp add: int_def)
  48.724 +
  48.725 +lemma [code abstract]:
  48.726 +  "Target_Numeral.of_nat (nat k) = max 0 (Target_Numeral.of_int k)"
  48.727 +  by (simp add: of_nat_def of_int_of_nat max_def)
  48.728 +
  48.729 +end
    49.1 --- a/src/HOL/List.thy	Sat Mar 24 16:27:04 2012 +0100
    49.2 +++ b/src/HOL/List.thy	Sun Mar 25 20:15:39 2012 +0200
    49.3 @@ -2676,7 +2676,7 @@
    49.4  -- {* simp does not terminate! *}
    49.5  by (induct j) auto
    49.6  
    49.7 -lemmas upt_rec_number_of[simp] = upt_rec[of "number_of m" "number_of n"] for m n
    49.8 +lemmas upt_rec_numeral[simp] = upt_rec[of "numeral m" "numeral n"] for m n
    49.9  
   49.10  lemma upt_conv_Nil [simp]: "j <= i ==> [i..<j] = []"
   49.11  by (subst upt_rec) simp
   49.12 @@ -2791,13 +2791,17 @@
   49.13  lemma nth_Cons': "(x # xs)!n = (if n = 0 then x else xs!(n - 1))"
   49.14  by (cases n) simp_all
   49.15  
   49.16 -lemmas take_Cons_number_of = take_Cons'[of "number_of v"] for v
   49.17 -lemmas drop_Cons_number_of = drop_Cons'[of "number_of v"] for v
   49.18 -lemmas nth_Cons_number_of = nth_Cons'[of _ _ "number_of v"] for v
   49.19 -
   49.20 -declare take_Cons_number_of [simp] 
   49.21 -        drop_Cons_number_of [simp] 
   49.22 -        nth_Cons_number_of [simp] 
   49.23 +lemma take_Cons_numeral [simp]:
   49.24 +  "take (numeral v) (x # xs) = x # take (numeral v - 1) xs"
   49.25 +by (simp add: take_Cons')
   49.26 +
   49.27 +lemma drop_Cons_numeral [simp]:
   49.28 +  "drop (numeral v) (x # xs) = drop (numeral v - 1) xs"
   49.29 +by (simp add: drop_Cons')
   49.30 +
   49.31 +lemma nth_Cons_numeral [simp]:
   49.32 +  "(x # xs) ! numeral v = xs ! (numeral v - 1)"
   49.33 +by (simp add: nth_Cons')
   49.34  
   49.35  
   49.36  subsubsection {* @{text upto}: interval-list on @{typ int} *}
   49.37 @@ -2812,7 +2816,11 @@
   49.38  
   49.39  declare upto.simps[code, simp del]
   49.40  
   49.41 -lemmas upto_rec_number_of[simp] = upto.simps[of "number_of m" "number_of n"] for m n
   49.42 +lemmas upto_rec_numeral [simp] =
   49.43 +  upto.simps[of "numeral m" "numeral n"]
   49.44 +  upto.simps[of "numeral m" "neg_numeral n"]
   49.45 +  upto.simps[of "neg_numeral m" "numeral n"]
   49.46 +  upto.simps[of "neg_numeral m" "neg_numeral n"] for m n
   49.47  
   49.48  lemma upto_empty[simp]: "j < i \<Longrightarrow> [i..j] = []"
   49.49  by(simp add: upto.simps)
    50.1 --- a/src/HOL/Matrix_LP/ComputeFloat.thy	Sat Mar 24 16:27:04 2012 +0100
    50.2 +++ b/src/HOL/Matrix_LP/ComputeFloat.thy	Sun Mar 25 20:15:39 2012 +0200
    50.3 @@ -75,8 +75,11 @@
    50.4    ultimately show ?thesis by auto
    50.5  qed
    50.6  
    50.7 -lemma real_is_int_number_of[simp]: "real_is_int ((number_of \<Colon> int \<Rightarrow> real) x)"
    50.8 -  by (auto simp: real_is_int_def intro!: exI[of _ "number_of x"])
    50.9 +lemma real_is_int_numeral[simp]: "real_is_int (numeral x)"
   50.10 +  by (auto simp: real_is_int_def intro!: exI[of _ "numeral x"])
   50.11 +
   50.12 +lemma real_is_int_neg_numeral[simp]: "real_is_int (neg_numeral x)"
   50.13 +  by (auto simp: real_is_int_def intro!: exI[of _ "neg_numeral x"])
   50.14  
   50.15  lemma int_of_real_0[simp]: "int_of_real (0::real) = (0::int)"
   50.16  by (simp add: int_of_real_def)
   50.17 @@ -87,7 +90,12 @@
   50.18    show ?thesis by (simp only: 1 int_of_real_real)
   50.19  qed
   50.20  
   50.21 -lemma int_of_real_number_of[simp]: "int_of_real (number_of b) = number_of b"
   50.22 +lemma int_of_real_numeral[simp]: "int_of_real (numeral b) = numeral b"
   50.23 +  unfolding int_of_real_def
   50.24 +  by (intro some_equality)
   50.25 +     (auto simp add: real_of_int_inject[symmetric] simp del: real_of_int_inject)
   50.26 +
   50.27 +lemma int_of_real_neg_numeral[simp]: "int_of_real (neg_numeral b) = neg_numeral b"
   50.28    unfolding int_of_real_def
   50.29    by (intro some_equality)
   50.30       (auto simp add: real_of_int_inject[symmetric] simp del: real_of_int_inject)
   50.31 @@ -101,7 +109,7 @@
   50.32  lemma abs_div_2_less: "a \<noteq> 0 \<Longrightarrow> a \<noteq> -1 \<Longrightarrow> abs((a::int) div 2) < abs a"
   50.33  by arith
   50.34  
   50.35 -lemma norm_0_1: "(0::_::number_ring) = Numeral0 & (1::_::number_ring) = Numeral1"
   50.36 +lemma norm_0_1: "(1::_::numeral) = Numeral1"
   50.37    by auto
   50.38  
   50.39  lemma add_left_zero: "0 + a = (a::'a::comm_monoid_add)"
   50.40 @@ -116,34 +124,21 @@
   50.41  lemma mult_right_one: "a * 1 = (a::'a::semiring_1)"
   50.42    by simp
   50.43  
   50.44 -lemma int_pow_0: "(a::int)^(Numeral0) = 1"
   50.45 +lemma int_pow_0: "(a::int)^0 = 1"
   50.46    by simp
   50.47  
   50.48  lemma int_pow_1: "(a::int)^(Numeral1) = a"
   50.49    by simp
   50.50  
   50.51 -lemma zero_eq_Numeral0_nring: "(0::'a::number_ring) = Numeral0"
   50.52 -  by simp
   50.53 -
   50.54 -lemma one_eq_Numeral1_nring: "(1::'a::number_ring) = Numeral1"
   50.55 -  by simp
   50.56 -
   50.57 -lemma zero_eq_Numeral0_nat: "(0::nat) = Numeral0"
   50.58 +lemma one_eq_Numeral1_nring: "(1::'a::numeral) = Numeral1"
   50.59    by simp
   50.60  
   50.61  lemma one_eq_Numeral1_nat: "(1::nat) = Numeral1"
   50.62    by simp
   50.63  
   50.64 -lemma zpower_Pls: "(z::int)^Numeral0 = Numeral1"
   50.65 +lemma zpower_Pls: "(z::int)^0 = Numeral1"
   50.66    by simp
   50.67  
   50.68 -lemma zpower_Min: "(z::int)^((-1)::nat) = Numeral1"
   50.69 -proof -
   50.70 -  have 1:"((-1)::nat) = 0"
   50.71 -    by simp
   50.72 -  show ?thesis by (simp add: 1)
   50.73 -qed
   50.74 -
   50.75  lemma fst_cong: "a=a' \<Longrightarrow> fst (a,b) = fst (a',b)"
   50.76    by simp
   50.77  
   50.78 @@ -160,70 +155,8 @@
   50.79  
   50.80  lemma not_true_eq_false: "(~ True) = False" by simp
   50.81  
   50.82 -lemmas binarith =
   50.83 -  normalize_bin_simps
   50.84 -  pred_bin_simps succ_bin_simps
   50.85 -  add_bin_simps minus_bin_simps mult_bin_simps
   50.86 -
   50.87 -lemma int_eq_number_of_eq:
   50.88 -  "(((number_of v)::int)=(number_of w)) = iszero ((number_of (v + uminus w))::int)"
   50.89 -  by (rule eq_number_of_eq)
   50.90 -
   50.91 -lemma int_iszero_number_of_Pls: "iszero (Numeral0::int)"
   50.92 -  by (simp only: iszero_number_of_Pls)
   50.93 -
   50.94 -lemma int_nonzero_number_of_Min: "~(iszero ((-1)::int))"
   50.95 -  by simp
   50.96 -
   50.97 -lemma int_iszero_number_of_Bit0: "iszero ((number_of (Int.Bit0 w))::int) = iszero ((number_of w)::int)"
   50.98 -  by simp
   50.99 -
  50.100 -lemma int_iszero_number_of_Bit1: "\<not> iszero ((number_of (Int.Bit1 w))::int)"
  50.101 -  by simp
  50.102 -
  50.103 -lemma int_less_number_of_eq_neg: "(((number_of x)::int) < number_of y) = neg ((number_of (x + (uminus y)))::int)"
  50.104 -  unfolding neg_def number_of_is_id by simp
  50.105 -
  50.106 -lemma int_not_neg_number_of_Pls: "\<not> (neg (Numeral0::int))"
  50.107 -  by simp
  50.108 -
  50.109 -lemma int_neg_number_of_Min: "neg (-1::int)"
  50.110 -  by simp
  50.111 -
  50.112 -lemma int_neg_number_of_Bit0: "neg ((number_of (Int.Bit0 w))::int) = neg ((number_of w)::int)"
  50.113 -  by simp
  50.114 -
  50.115 -lemma int_neg_number_of_Bit1: "neg ((number_of (Int.Bit1 w))::int) = neg ((number_of w)::int)"
  50.116 -  by simp
  50.117 -
  50.118 -lemma int_le_number_of_eq: "(((number_of x)::int) \<le> number_of y) = (\<not> neg ((number_of (y + (uminus x)))::int))"
  50.119 -  unfolding neg_def number_of_is_id by (simp add: not_less)
  50.120 -
  50.121 -lemmas intarithrel =
  50.122 -  int_eq_number_of_eq
  50.123 -  lift_bool[OF int_iszero_number_of_Pls] nlift_bool[OF int_nonzero_number_of_Min] int_iszero_number_of_Bit0
  50.124 -  lift_bool[OF int_iszero_number_of_Bit1] int_less_number_of_eq_neg nlift_bool[OF int_not_neg_number_of_Pls] lift_bool[OF int_neg_number_of_Min]
  50.125 -  int_neg_number_of_Bit0 int_neg_number_of_Bit1 int_le_number_of_eq
  50.126 -
  50.127 -lemma int_number_of_add_sym: "((number_of v)::int) + number_of w = number_of (v + w)"
  50.128 -  by simp
  50.129 -
  50.130 -lemma int_number_of_diff_sym: "((number_of v)::int) - number_of w = number_of (v + (uminus w))"
  50.131 -  by simp
  50.132 -
  50.133 -lemma int_number_of_mult_sym: "((number_of v)::int) * number_of w = number_of (v * w)"
  50.134 -  by simp
  50.135 -
  50.136 -lemma int_number_of_minus_sym: "- ((number_of v)::int) = number_of (uminus v)"
  50.137 -  by simp
  50.138 -
  50.139 -lemmas intarith = int_number_of_add_sym int_number_of_minus_sym int_number_of_diff_sym int_number_of_mult_sym
  50.140 -
  50.141 -lemmas natarith = add_nat_number_of diff_nat_number_of mult_nat_number_of eq_nat_number_of less_nat_number_of
  50.142 -
  50.143 -lemmas powerarith = nat_number_of zpower_number_of_even
  50.144 -  zpower_number_of_odd[simplified zero_eq_Numeral0_nring one_eq_Numeral1_nring]
  50.145 -  zpower_Pls zpower_Min
  50.146 +lemmas powerarith = nat_numeral zpower_numeral_even
  50.147 +  zpower_numeral_odd zpower_Pls
  50.148  
  50.149  definition float :: "(int \<times> int) \<Rightarrow> real" where
  50.150    "float = (\<lambda>(a, b). real a * 2 powr real b)"
  50.151 @@ -302,7 +235,8 @@
  50.152            float_minus float_abs zero_le_float float_pprt float_nprt pprt_lbound nprt_ubound
  50.153  
  50.154  (* for use with the compute oracle *)
  50.155 -lemmas arith = binarith intarith intarithrel natarith powerarith floatarith not_false_eq_true not_true_eq_false
  50.156 +lemmas arith = arith_simps rel_simps diff_nat_numeral nat_0
  50.157 +  nat_neg_numeral powerarith floatarith not_false_eq_true not_true_eq_false
  50.158  
  50.159  use "~~/src/HOL/Tools/float_arith.ML"
  50.160  
    51.1 --- a/src/HOL/Matrix_LP/ComputeNumeral.thy	Sat Mar 24 16:27:04 2012 +0100
    51.2 +++ b/src/HOL/Matrix_LP/ComputeNumeral.thy	Sun Mar 25 20:15:39 2012 +0200
    51.3 @@ -2,145 +2,47 @@
    51.4  imports ComputeHOL ComputeFloat
    51.5  begin
    51.6  
    51.7 -(* normalization of bit strings *)
    51.8 -lemmas bitnorm = normalize_bin_simps
    51.9 -
   51.10 -(* neg for bit strings *)
   51.11 -lemma neg1: "neg Int.Pls = False" by (simp add: Int.Pls_def)
   51.12 -lemma neg2: "neg Int.Min = True" apply (subst Int.Min_def) by auto
   51.13 -lemma neg3: "neg (Int.Bit0 x) = neg x" apply (simp add: neg_def) apply (subst Bit0_def) by auto
   51.14 -lemma neg4: "neg (Int.Bit1 x) = neg x" apply (simp add: neg_def) apply (subst Bit1_def) by auto  
   51.15 -lemmas bitneg = neg1 neg2 neg3 neg4
   51.16 -
   51.17 -(* iszero for bit strings *)
   51.18 -lemma iszero1: "iszero Int.Pls = True" by (simp add: Int.Pls_def iszero_def)
   51.19 -lemma iszero2: "iszero Int.Min = False" apply (subst Int.Min_def) apply (subst iszero_def) by simp
   51.20 -lemma iszero3: "iszero (Int.Bit0 x) = iszero x" apply (subst Int.Bit0_def) apply (subst iszero_def)+ by auto
   51.21 -lemma iszero4: "iszero (Int.Bit1 x) = False" apply (subst Int.Bit1_def) apply (subst iszero_def)+  apply simp by arith
   51.22 -lemmas bitiszero = iszero1 iszero2 iszero3 iszero4
   51.23 -
   51.24 -(* lezero for bit strings *)
   51.25 -definition "lezero x \<longleftrightarrow> x \<le> 0"
   51.26 -lemma lezero1: "lezero Int.Pls = True" unfolding Int.Pls_def lezero_def by auto
   51.27 -lemma lezero2: "lezero Int.Min = True" unfolding Int.Min_def lezero_def by auto
   51.28 -lemma lezero3: "lezero (Int.Bit0 x) = lezero x" unfolding Int.Bit0_def lezero_def by auto
   51.29 -lemma lezero4: "lezero (Int.Bit1 x) = neg x" unfolding Int.Bit1_def lezero_def neg_def by auto
   51.30 -lemmas bitlezero = lezero1 lezero2 lezero3 lezero4
   51.31 -
   51.32  (* equality for bit strings *)
   51.33 -lemmas biteq = eq_bin_simps
   51.34 +lemmas biteq = eq_num_simps
   51.35  
   51.36  (* x < y for bit strings *)
   51.37 -lemmas bitless = less_bin_simps
   51.38 +lemmas bitless = less_num_simps
   51.39  
   51.40  (* x \<le> y for bit strings *)
   51.41 -lemmas bitle = le_bin_simps
   51.42 -
   51.43 -(* succ for bit strings *)
   51.44 -lemmas bitsucc = succ_bin_simps
   51.45 -
   51.46 -(* pred for bit strings *)
   51.47 -lemmas bitpred = pred_bin_simps
   51.48 -
   51.49 -(* unary minus for bit strings *)
   51.50 -lemmas bituminus = minus_bin_simps
   51.51 +lemmas bitle = le_num_simps
   51.52  
   51.53  (* addition for bit strings *)
   51.54 -lemmas bitadd = add_bin_simps
   51.55 +lemmas bitadd = add_num_simps
   51.56  
   51.57  (* multiplication for bit strings *) 
   51.58 -lemma mult_Pls_right: "x * Int.Pls = Int.Pls" by (simp add: Pls_def)
   51.59 -lemma mult_Min_right: "x * Int.Min = - x" by (subst mult_commute) simp 
   51.60 -lemma multb0x: "(Int.Bit0 x) * y = Int.Bit0 (x * y)" by (rule mult_Bit0)
   51.61 -lemma multxb0: "x * (Int.Bit0 y) = Int.Bit0 (x * y)" unfolding Bit0_def by simp
   51.62 -lemma multb1: "(Int.Bit1 x) * (Int.Bit1 y) = Int.Bit1 (Int.Bit0 (x * y) + x + y)"
   51.63 -  unfolding Bit0_def Bit1_def by (simp add: algebra_simps)
   51.64 -lemmas bitmul = mult_Pls mult_Min mult_Pls_right mult_Min_right multb0x multxb0 multb1
   51.65 +lemmas bitmul = mult_num_simps
   51.66  
   51.67 -lemmas bitarith = bitnorm bitiszero bitneg bitlezero biteq bitless bitle bitsucc bitpred bituminus bitadd bitmul 
   51.68 -
   51.69 -definition "nat_norm_number_of (x::nat) = x"
   51.70 -
   51.71 -lemma nat_norm_number_of: "nat_norm_number_of (number_of w) = (if lezero w then 0 else number_of w)"
   51.72 -  apply (simp add: nat_norm_number_of_def)
   51.73 -  unfolding lezero_def iszero_def neg_def
   51.74 -  apply (simp add: numeral_simps)
   51.75 -  done
   51.76 +lemmas bitarith = arith_simps
   51.77  
   51.78  (* Normalization of nat literals *)
   51.79 -lemma natnorm0: "(0::nat) = number_of (Int.Pls)" by auto
   51.80 -lemma natnorm1: "(1 :: nat) = number_of (Int.Bit1 Int.Pls)"  by auto 
   51.81 -lemmas natnorm = natnorm0 natnorm1 nat_norm_number_of
   51.82 -
   51.83 -(* Suc *)
   51.84 -lemma natsuc: "Suc (number_of x) = (if neg x then 1 else number_of (Int.succ x))" by (auto simp add: number_of_is_id)
   51.85 -
   51.86 -(* Addition for nat *)
   51.87 -lemma natadd: "number_of x + ((number_of y)::nat) = (if neg x then (number_of y) else (if neg y then number_of x else (number_of (x + y))))"
   51.88 -  unfolding nat_number_of_def number_of_is_id neg_def
   51.89 -  by auto
   51.90 -
   51.91 -(* Subtraction for nat *)
   51.92 -lemma natsub: "(number_of x) - ((number_of y)::nat) = 
   51.93 -  (if neg x then 0 else (if neg y then number_of x else (nat_norm_number_of (number_of (x + (- y))))))"
   51.94 -  unfolding nat_norm_number_of
   51.95 -  by (auto simp add: number_of_is_id neg_def lezero_def iszero_def Let_def nat_number_of_def)
   51.96 -
   51.97 -(* Multiplication for nat *)
   51.98 -lemma natmul: "(number_of x) * ((number_of y)::nat) = 
   51.99 -  (if neg x then 0 else (if neg y then 0 else number_of (x * y)))"
  51.100 -  unfolding nat_number_of_def number_of_is_id neg_def
  51.101 -  by (simp add: nat_mult_distrib)
  51.102 -
  51.103 -lemma nateq: "(((number_of x)::nat) = (number_of y)) = ((lezero x \<and> lezero y) \<or> (x = y))"
  51.104 -  by (auto simp add: iszero_def lezero_def neg_def number_of_is_id)
  51.105 -
  51.106 -lemma natless: "(((number_of x)::nat) < (number_of y)) = ((x < y) \<and> (\<not> (lezero y)))"
  51.107 -  by (simp add: lezero_def numeral_simps not_le)
  51.108 -
  51.109 -lemma natle: "(((number_of x)::nat) \<le> (number_of y)) = (y < x \<longrightarrow> lezero x)"
  51.110 -  by (auto simp add: number_of_is_id lezero_def nat_number_of_def)
  51.111 +lemmas natnorm = one_eq_Numeral1_nat
  51.112  
  51.113  fun natfac :: "nat \<Rightarrow> nat"
  51.114    where "natfac n = (if n = 0 then 1 else n * (natfac (n - 1)))"
  51.115  
  51.116 -lemmas compute_natarith = bitarith natnorm natsuc natadd natsub natmul nateq natless natle natfac.simps
  51.117 -
  51.118 -lemma number_eq: "(((number_of x)::'a::{number_ring, linordered_idom}) = (number_of y)) = (x = y)"
  51.119 -  unfolding number_of_eq
  51.120 -  apply simp
  51.121 -  done
  51.122 +lemmas compute_natarith =
  51.123 +  arith_simps rel_simps
  51.124 +  diff_nat_numeral nat_numeral nat_0 nat_neg_numeral
  51.125 +  numeral_1_eq_1 [symmetric]
  51.126 +  numeral_1_eq_Suc_0 [symmetric]
  51.127 +  Suc_numeral natfac.simps
  51.128  
  51.129 -lemma number_le: "(((number_of x)::'a::{number_ring, linordered_idom}) \<le>  (number_of y)) = (x \<le> y)"
  51.130 -  unfolding number_of_eq
  51.131 -  apply simp
  51.132 -  done
  51.133 -
  51.134 -lemma number_less: "(((number_of x)::'a::{number_ring, linordered_idom}) <  (number_of y)) = (x < y)"
  51.135 -  unfolding number_of_eq 
  51.136 -  apply simp
  51.137 -  done
  51.138 +lemmas number_norm = numeral_1_eq_1[symmetric]
  51.139  
  51.140 -lemma number_diff: "((number_of x)::'a::{number_ring, linordered_idom}) - number_of y = number_of (x + (- y))"
  51.141 -  apply (subst diff_number_of_eq)
  51.142 -  apply simp
  51.143 -  done
  51.144 -
  51.145 -lemmas number_norm = number_of_Pls[symmetric] numeral_1_eq_1[symmetric]
  51.146 -
  51.147 -lemmas compute_numberarith = number_of_minus[symmetric] number_of_add[symmetric] number_diff number_of_mult[symmetric] number_norm number_eq number_le number_less
  51.148 +lemmas compute_numberarith =
  51.149 +  arith_simps rel_simps number_norm
  51.150  
  51.151 -lemma compute_real_of_nat_number_of: "real ((number_of v)::nat) = (if neg v then 0 else number_of v)"
  51.152 -  by (simp only: real_of_nat_number_of number_of_is_id)
  51.153 -
  51.154 -lemma compute_nat_of_int_number_of: "nat ((number_of v)::int) = (number_of v)"
  51.155 -  by simp
  51.156 +lemmas compute_num_conversions =
  51.157 +  real_of_nat_numeral real_of_nat_zero
  51.158 +  nat_numeral nat_0 nat_neg_numeral
  51.159 +  real_numeral real_of_int_zero
  51.160  
  51.161 -lemmas compute_num_conversions = compute_real_of_nat_number_of compute_nat_of_int_number_of real_number_of
  51.162 -
  51.163 -lemmas zpowerarith = zpower_number_of_even
  51.164 -  zpower_number_of_odd[simplified zero_eq_Numeral0_nring one_eq_Numeral1_nring]
  51.165 -  zpower_Pls zpower_Min
  51.166 +lemmas zpowerarith = zpower_numeral_even zpower_numeral_odd zpower_Pls int_pow_1
  51.167  
  51.168  (* div, mod *)
  51.169  
  51.170 @@ -162,26 +64,19 @@
  51.171  
  51.172  (* collecting all the theorems *)
  51.173  
  51.174 -lemma even_Pls: "even (Int.Pls) = True"
  51.175 -  apply (unfold Pls_def even_def)
  51.176 +lemma even_0_int: "even (0::int) = True"
  51.177    by simp
  51.178  
  51.179 -lemma even_Min: "even (Int.Min) = False"
  51.180 -  apply (unfold Min_def even_def)
  51.181 +lemma even_One_int: "even (numeral Num.One :: int) = False"
  51.182    by simp
  51.183  
  51.184 -lemma even_B0: "even (Int.Bit0 x) = True"
  51.185 -  apply (unfold Bit0_def)
  51.186 +lemma even_Bit0_int: "even (numeral (Num.Bit0 x) :: int) = True"
  51.187    by simp
  51.188  
  51.189 -lemma even_B1: "even (Int.Bit1 x) = False"
  51.190 -  apply (unfold Bit1_def)
  51.191 +lemma even_Bit1_int: "even (numeral (Num.Bit1 x) :: int) = False"
  51.192    by simp
  51.193  
  51.194 -lemma even_number_of: "even ((number_of w)::int) = even w"
  51.195 -  by (simp only: number_of_is_id)
  51.196 -
  51.197 -lemmas compute_even = even_Pls even_Min even_B0 even_B1 even_number_of
  51.198 +lemmas compute_even = even_0_int even_One_int even_Bit0_int even_Bit1_int
  51.199  
  51.200  lemmas compute_numeral = compute_if compute_let compute_pair compute_bool 
  51.201                           compute_natarith compute_numberarith max_def min_def compute_num_conversions zpowerarith compute_div_mod compute_even
    52.1 --- a/src/HOL/Matrix_LP/SparseMatrix.thy	Sat Mar 24 16:27:04 2012 +0100
    52.2 +++ b/src/HOL/Matrix_LP/SparseMatrix.thy	Sun Mar 25 20:15:39 2012 +0200
    52.3 @@ -1029,9 +1029,7 @@
    52.4    sparse_row_matrix_pprt sorted_spvec_pprt_spmat sorted_spmat_pprt_spmat
    52.5    sparse_row_matrix_nprt sorted_spvec_nprt_spmat sorted_spmat_nprt_spmat
    52.6  
    52.7 -lemma zero_eq_Numeral0: "(0::_::number_ring) = Numeral0" by simp
    52.8 -
    52.9 -lemmas sparse_row_matrix_arith_simps[simplified zero_eq_Numeral0] = 
   52.10 +lemmas sparse_row_matrix_arith_simps = 
   52.11    mult_spmat.simps mult_spvec_spmat.simps 
   52.12    addmult_spvec.simps 
   52.13    smult_spvec_empty smult_spvec_cons
    53.1 --- a/src/HOL/Metis_Examples/Big_O.thy	Sat Mar 24 16:27:04 2012 +0100
    53.2 +++ b/src/HOL/Metis_Examples/Big_O.thy	Sun Mar 25 20:15:39 2012 +0200
    53.3 @@ -16,7 +16,7 @@
    53.4  
    53.5  subsection {* Definitions *}
    53.6  
    53.7 -definition bigo :: "('a => 'b\<Colon>{linordered_idom,number_ring}) => ('a => 'b) set" ("(1O'(_'))") where
    53.8 +definition bigo :: "('a => 'b\<Colon>linordered_idom) => ('a => 'b) set" ("(1O'(_'))") where
    53.9    "O(f\<Colon>('a => 'b)) == {h. \<exists>c. \<forall>x. abs (h x) <= c * abs (f x)}"
   53.10  
   53.11  lemma bigo_pos_const:
   53.12 @@ -180,7 +180,7 @@
   53.13   apply (rule_tac x = "c + c" in exI)
   53.14   apply auto
   53.15   apply (subgoal_tac "c * abs (f xa + g xa) <= (c + c) * abs (g xa)")
   53.16 -  apply (metis order_trans semiring_mult_2)
   53.17 +  apply (metis order_trans mult_2)
   53.18   apply (subgoal_tac "c * abs (f xa + g xa) <= c * (abs (f xa) + abs (g xa))")
   53.19    apply (erule order_trans)
   53.20    apply (simp add: ring_distribs)
   53.21 @@ -325,7 +325,7 @@
   53.22  by (metis bigo_mult2 set_plus_mono_b set_times_intro2 set_times_plus_distrib)
   53.23  
   53.24  lemma bigo_mult5: "\<forall>x. f x ~= 0 \<Longrightarrow>
   53.25 -    O(f * g) <= (f\<Colon>'a => ('b\<Colon>{linordered_field,number_ring})) *o O(g)"
   53.26 +    O(f * g) <= (f\<Colon>'a => ('b\<Colon>linordered_field)) *o O(g)"
   53.27  proof -
   53.28    assume a: "\<forall>x. f x ~= 0"
   53.29    show "O(f * g) <= f *o O(g)"
   53.30 @@ -351,21 +351,21 @@
   53.31  qed
   53.32  
   53.33  lemma bigo_mult6:
   53.34 -"\<forall>x. f x \<noteq> 0 \<Longrightarrow> O(f * g) = (f\<Colon>'a \<Rightarrow> ('b\<Colon>{linordered_field,number_ring})) *o O(g)"
   53.35 +"\<forall>x. f x \<noteq> 0 \<Longrightarrow> O(f * g) = (f\<Colon>'a \<Rightarrow> ('b\<Colon>linordered_field)) *o O(g)"
   53.36  by (metis bigo_mult2 bigo_mult5 order_antisym)
   53.37  
   53.38  (*proof requires relaxing relevance: 2007-01-25*)
   53.39  declare bigo_mult6 [simp]
   53.40  
   53.41  lemma bigo_mult7:
   53.42 -"\<forall>x. f x \<noteq> 0 \<Longrightarrow> O(f * g) \<le> O(f\<Colon>'a \<Rightarrow> ('b\<Colon>{linordered_field,number_ring})) \<otimes> O(g)"
   53.43 +"\<forall>x. f x \<noteq> 0 \<Longrightarrow> O(f * g) \<le> O(f\<Colon>'a \<Rightarrow> ('b\<Colon>linordered_field)) \<otimes> O(g)"
   53.44  by (metis bigo_refl bigo_mult6 set_times_mono3)
   53.45  
   53.46  declare bigo_mult6 [simp del]
   53.47  declare bigo_mult7 [intro!]
   53.48  
   53.49  lemma bigo_mult8:
   53.50 -"\<forall>x. f x \<noteq> 0 \<Longrightarrow> O(f * g) = O(f\<Colon>'a \<Rightarrow> ('b\<Colon>{linordered_field,number_ring})) \<otimes> O(g)"
   53.51 +"\<forall>x. f x \<noteq> 0 \<Longrightarrow> O(f * g) = O(f\<Colon>'a \<Rightarrow> ('b\<Colon>linordered_field)) \<otimes> O(g)"
   53.52  by (metis bigo_mult bigo_mult7 order_antisym_conv)
   53.53  
   53.54  lemma bigo_minus [intro]: "f : O(g) \<Longrightarrow> - f : O(g)"
   53.55 @@ -405,14 +405,14 @@
   53.56  lemma bigo_const2 [intro]: "O(\<lambda>x. c) \<le> O(\<lambda>x. 1)"
   53.57  by (metis bigo_const1 bigo_elt_subset)
   53.58  
   53.59 -lemma bigo_const3: "(c\<Colon>'a\<Colon>{linordered_field,number_ring}) ~= 0 \<Longrightarrow> (\<lambda>x. 1) : O(\<lambda>x. c)"
   53.60 +lemma bigo_const3: "(c\<Colon>'a\<Colon>linordered_field) ~= 0 \<Longrightarrow> (\<lambda>x. 1) : O(\<lambda>x. c)"
   53.61  apply (simp add: bigo_def)
   53.62  by (metis abs_eq_0 left_inverse order_refl)
   53.63  
   53.64 -lemma bigo_const4: "(c\<Colon>'a\<Colon>{linordered_field,number_ring}) ~= 0 \<Longrightarrow> O(\<lambda>x. 1) <= O(\<lambda>x. c)"
   53.65 +lemma bigo_const4: "(c\<Colon>'a\<Colon>linordered_field) ~= 0 \<Longrightarrow> O(\<lambda>x. 1) <= O(\<lambda>x. c)"
   53.66  by (metis bigo_elt_subset bigo_const3)
   53.67  
   53.68 -lemma bigo_const [simp]: "(c\<Colon>'a\<Colon>{linordered_field,number_ring}) ~= 0 \<Longrightarrow>
   53.69 +lemma bigo_const [simp]: "(c\<Colon>'a\<Colon>linordered_field) ~= 0 \<Longrightarrow>
   53.70      O(\<lambda>x. c) = O(\<lambda>x. 1)"
   53.71  by (metis bigo_const2 bigo_const4 equalityI)
   53.72  
   53.73 @@ -423,19 +423,19 @@
   53.74  lemma bigo_const_mult2: "O(\<lambda>x. c * f x) \<le> O(f)"
   53.75  by (rule bigo_elt_subset, rule bigo_const_mult1)
   53.76  
   53.77 -lemma bigo_const_mult3: "(c\<Colon>'a\<Colon>{linordered_field,number_ring}) ~= 0 \<Longrightarrow> f : O(\<lambda>x. c * f x)"
   53.78 +lemma bigo_const_mult3: "(c\<Colon>'a\<Colon>linordered_field) ~= 0 \<Longrightarrow> f : O(\<lambda>x. c * f x)"
   53.79  apply (simp add: bigo_def)
   53.80  by (metis (no_types) abs_mult mult_assoc mult_1 order_refl left_inverse)
   53.81  
   53.82  lemma bigo_const_mult4:
   53.83 -"(c\<Colon>'a\<Colon>{linordered_field,number_ring}) \<noteq> 0 \<Longrightarrow> O(f) \<le> O(\<lambda>x. c * f x)"
   53.84 +"(c\<Colon>'a\<Colon>linordered_field) \<noteq> 0 \<Longrightarrow> O(f) \<le> O(\<lambda>x. c * f x)"
   53.85  by (metis bigo_elt_subset bigo_const_mult3)
   53.86  
   53.87 -lemma bigo_const_mult [simp]: "(c\<Colon>'a\<Colon>{linordered_field,number_ring}) ~= 0 \<Longrightarrow>
   53.88 +lemma bigo_const_mult [simp]: "(c\<Colon>'a\<Colon>linordered_field) ~= 0 \<Longrightarrow>
   53.89      O(\<lambda>x. c * f x) = O(f)"
   53.90  by (metis equalityI bigo_const_mult2 bigo_const_mult4)
   53.91  
   53.92 -lemma bigo_const_mult5 [simp]: "(c\<Colon>'a\<Colon>{linordered_field,number_ring}) ~= 0 \<Longrightarrow>
   53.93 +lemma bigo_const_mult5 [simp]: "(c\<Colon>'a\<Colon>linordered_field) ~= 0 \<Longrightarrow>
   53.94      (\<lambda>x. c) *o O(f) = O(f)"
   53.95    apply (auto del: subsetI)
   53.96    apply (rule order_trans)
   53.97 @@ -587,7 +587,7 @@
   53.98    apply assumption+
   53.99  done
  53.100  
  53.101 -lemma bigo_useful_const_mult: "(c\<Colon>'a\<Colon>{linordered_field,number_ring}) ~= 0 \<Longrightarrow>
  53.102 +lemma bigo_useful_const_mult: "(c\<Colon>'a\<Colon>linordered_field) ~= 0 \<Longrightarrow>
  53.103      (\<lambda>x. c) * f =o O(h) \<Longrightarrow> f =o O(h)"
  53.104    apply (rule subsetD)
  53.105    apply (subgoal_tac "(\<lambda>x. 1 / c) *o O(h) <= O(h)")
  53.106 @@ -696,7 +696,7 @@
  53.107  by (metis abs_ge_zero linorder_linear min_max.sup_absorb1 min_max.sup_commute)
  53.108  
  53.109  lemma bigo_lesso4:
  53.110 -  "f <o g =o O(k\<Colon>'a=>'b\<Colon>{linordered_field,number_ring}) \<Longrightarrow>
  53.111 +  "f <o g =o O(k\<Colon>'a=>'b\<Colon>{linordered_field}) \<Longrightarrow>
  53.112     g =o h +o O(k) \<Longrightarrow> f <o h =o O(k)"
  53.113  apply (unfold lesso_def)
  53.114  apply (drule set_plus_imp_minus)
    54.1 --- a/src/HOL/Multivariate_Analysis/Cartesian_Euclidean_Space.thy	Sat Mar 24 16:27:04 2012 +0100
    54.2 +++ b/src/HOL/Multivariate_Analysis/Cartesian_Euclidean_Space.thy	Sun Mar 25 20:15:39 2012 +0200
    54.3 @@ -207,6 +207,15 @@
    54.4      by (auto intro!: injI simp add: vec_eq_iff of_nat_index)
    54.5  qed
    54.6  
    54.7 +instance vec :: (numeral, finite) numeral ..
    54.8 +instance vec :: (semiring_numeral, finite) semiring_numeral ..
    54.9 +
   54.10 +lemma numeral_index [simp]: "numeral w $ i = numeral w"
   54.11 +  by (induct w, simp_all only: numeral.simps vector_add_component one_index)
   54.12 +
   54.13 +lemma neg_numeral_index [simp]: "neg_numeral w $ i = neg_numeral w"
   54.14 +  by (simp only: neg_numeral_def vector_uminus_component numeral_index)
   54.15 +
   54.16  instance vec :: (comm_ring_1, finite) comm_ring_1 ..
   54.17  instance vec :: (ring_char_0, finite) ring_char_0 ..
   54.18  
   54.19 @@ -222,7 +231,7 @@
   54.20    by (vector field_simps)
   54.21  lemma vector_smult_rneg: "(c::'a::ring) *s -x = -(c *s x)" by vector
   54.22  lemma vector_smult_lneg: "- (c::'a::ring) *s x = -(c *s x)" by vector
   54.23 -lemma vector_sneg_minus1: "-x = (- (1::'a::ring_1)) *s x" by vector
   54.24 +lemma vector_sneg_minus1: "-x = (-1::'a::ring_1) *s x" by vector
   54.25  lemma vector_smult_rzero[simp]: "c *s 0 = (0::'a::mult_zero ^ 'n)" by vector
   54.26  lemma vector_sub_rdistrib: "((a::'a::ring) - b) *s x = a *s x - b *s x"
   54.27    by (vector field_simps)
    55.1 --- a/src/HOL/Multivariate_Analysis/Convex_Euclidean_Space.thy	Sat Mar 24 16:27:04 2012 +0100
    55.2 +++ b/src/HOL/Multivariate_Analysis/Convex_Euclidean_Space.thy	Sun Mar 25 20:15:39 2012 +0200
    55.3 @@ -281,7 +281,7 @@
    55.4  lemma scaleR_2:
    55.5    fixes x :: "'a::real_vector"
    55.6    shows "scaleR 2 x = x + x"
    55.7 -unfolding one_add_one_is_two [symmetric] scaleR_left_distrib by simp
    55.8 +unfolding one_add_one [symmetric] scaleR_left_distrib by simp
    55.9  
   55.10  lemma vector_choose_size: "0 <= c ==> \<exists>(x::'a::euclidean_space). norm x = c"
   55.11    apply (rule exI[where x="c *\<^sub>R basis 0 ::'a"]) using DIM_positive[where 'a='a] by auto
    56.1 --- a/src/HOL/Multivariate_Analysis/Determinants.thy	Sat Mar 24 16:27:04 2012 +0100
    56.2 +++ b/src/HOL/Multivariate_Analysis/Determinants.thy	Sun Mar 25 20:15:39 2012 +0200
    56.3 @@ -286,7 +286,7 @@
    56.4  proof-
    56.5    have tha: "\<And>(a::'a) b. a = b ==> b = - a ==> a = 0"
    56.6      by simp
    56.7 -  have th1: "of_int (-1) = - 1" by (metis of_int_1 of_int_minus number_of_Min)
    56.8 +  have th1: "of_int (-1) = - 1" by simp
    56.9    let ?p = "Fun.swap i j id"
   56.10    let ?A = "\<chi> i. A $ ?p i"
   56.11    from r have "A = ?A" by (simp add: vec_eq_iff row_def swap_def)
   56.12 @@ -1058,8 +1058,7 @@
   56.13    unfolding det_def UNIV_2
   56.14    unfolding setsum_over_permutations_insert[OF f12]
   56.15    unfolding permutes_sing
   56.16 -  apply (simp add: sign_swap_id sign_id swap_id_eq)
   56.17 -  by (simp add: arith_simps(31)[symmetric] del: arith_simps(31))
   56.18 +  by (simp add: sign_swap_id sign_id swap_id_eq)
   56.19  qed
   56.20  
   56.21  lemma det_3: "det (A::'a::comm_ring_1^3^3) =
   56.22 @@ -1079,9 +1078,7 @@
   56.23    unfolding setsum_over_permutations_insert[OF f23]
   56.24  
   56.25    unfolding permutes_sing
   56.26 -  apply (simp add: sign_swap_id permutation_swap_id sign_compose sign_id swap_id_eq)
   56.27 -  apply (simp add: arith_simps(31)[symmetric] del: arith_simps(31))
   56.28 -  by (simp add: field_simps)
   56.29 +  by (simp add: sign_swap_id permutation_swap_id sign_compose sign_id swap_id_eq)
   56.30  qed
   56.31  
   56.32  end
    57.1 --- a/src/HOL/Multivariate_Analysis/Norm_Arith.thy	Sat Mar 24 16:27:04 2012 +0100
    57.2 +++ b/src/HOL/Multivariate_Analysis/Norm_Arith.thy	Sun Mar 25 20:15:39 2012 +0200
    57.3 @@ -104,6 +104,17 @@
    57.4    "x \<noteq> y \<longleftrightarrow> \<not> (norm (x - y) \<le> 0)"
    57.5    using norm_ge_zero[of "x - y"] by auto
    57.6  
    57.7 +lemmas arithmetic_simps =
    57.8 +  arith_simps
    57.9 +  add_numeral_special
   57.10 +  add_neg_numeral_special
   57.11 +  add_0_left
   57.12 +  add_0_right
   57.13 +  mult_zero_left
   57.14 +  mult_zero_right
   57.15 +  mult_1_left
   57.16 +  mult_1_right
   57.17 +
   57.18  use "normarith.ML"
   57.19  
   57.20  method_setup norm = {* Scan.succeed (SIMPLE_METHOD' o NormArith.norm_arith_tac)
    58.1 --- a/src/HOL/Multivariate_Analysis/Topology_Euclidean_Space.thy	Sat Mar 24 16:27:04 2012 +0100
    58.2 +++ b/src/HOL/Multivariate_Analysis/Topology_Euclidean_Space.thy	Sun Mar 25 20:15:39 2012 +0200
    58.3 @@ -5786,7 +5786,7 @@
    58.4      { assume as:"dist a b > dist (f n x) (f n y)"
    58.5        then obtain Na Nb where "\<forall>m\<ge>Na. dist (f (r m) x) a < (dist a b - dist (f n x) (f n y)) / 2"
    58.6          and "\<forall>m\<ge>Nb. dist (f (r m) y) b < (dist a b - dist (f n x) (f n y)) / 2"
    58.7 -        using lima limb unfolding h_def LIMSEQ_def by (fastforce simp del: less_divide_eq_number_of1)
    58.8 +        using lima limb unfolding h_def LIMSEQ_def by (fastforce simp del: less_divide_eq_numeral1)
    58.9        hence "dist (f (r (Na + Nb + n)) x - f (r (Na + Nb + n)) y) (a - b) < dist a b - dist (f n x) (f n y)"
   58.10          apply(erule_tac x="Na+Nb+n" in allE)
   58.11          apply(erule_tac x="Na+Nb+n" in allE) apply simp
    59.1 --- a/src/HOL/Mutabelle/mutabelle_extra.ML	Sat Mar 24 16:27:04 2012 +0100
    59.2 +++ b/src/HOL/Mutabelle/mutabelle_extra.ML	Sun Mar 25 20:15:39 2012 +0200
    59.3 @@ -271,7 +271,7 @@
    59.4   @{const_name enum_prod_inst.enum_ex_prod},
    59.5   @{const_name Quickcheck.catch_match},
    59.6   @{const_name Quickcheck_Exhaustive.unknown},
    59.7 - @{const_name Int.Bit0}, @{const_name Int.Bit1}
    59.8 + @{const_name Num.Bit0}, @{const_name Num.Bit1}
    59.9   (*@{const_name "==>"}, @{const_name "=="}*)]
   59.10  
   59.11  val forbidden_mutant_consts =
    60.1 --- a/src/HOL/NSA/HyperDef.thy	Sat Mar 24 16:27:04 2012 +0100
    60.2 +++ b/src/HOL/NSA/HyperDef.thy	Sun Mar 25 20:15:39 2012 +0200
    60.3 @@ -346,8 +346,8 @@
    60.4    K (Lin_Arith.add_inj_thms [@{thm star_of_le} RS iffD2,
    60.5      @{thm star_of_less} RS iffD2, @{thm star_of_eq} RS iffD2]
    60.6    #> Lin_Arith.add_simps [@{thm star_of_zero}, @{thm star_of_one},
    60.7 -      @{thm star_of_number_of}, @{thm star_of_add}, @{thm star_of_minus},
    60.8 -      @{thm star_of_diff}, @{thm star_of_mult}]
    60.9 +      @{thm star_of_numeral}, @{thm star_of_neg_numeral}, @{thm star_of_add},
   60.10 +      @{thm star_of_minus}, @{thm star_of_diff}, @{thm star_of_mult}]
   60.11    #> Lin_Arith.add_inj_const (@{const_name "StarDef.star_of"}, @{typ "real \<Rightarrow> hypreal"}))
   60.12  *}
   60.13  
   60.14 @@ -419,10 +419,15 @@
   60.15        x ^ Suc (Suc 0) + y ^ Suc (Suc 0) + (hypreal_of_nat (Suc (Suc 0)))*x*y"
   60.16  by (simp add: right_distrib left_distrib)
   60.17  
   60.18 -lemma power_hypreal_of_real_number_of:
   60.19 -     "(number_of v :: hypreal) ^ n = hypreal_of_real ((number_of v) ^ n)"
   60.20 +lemma power_hypreal_of_real_numeral:
   60.21 +     "(numeral v :: hypreal) ^ n = hypreal_of_real ((numeral v) ^ n)"
   60.22  by simp
   60.23 -declare power_hypreal_of_real_number_of [of _ "number_of w", simp] for w
   60.24 +declare power_hypreal_of_real_numeral [of _ "numeral w", simp] for w
   60.25 +
   60.26 +lemma power_hypreal_of_real_neg_numeral:
   60.27 +     "(neg_numeral v :: hypreal) ^ n = hypreal_of_real ((neg_numeral v) ^ n)"
   60.28 +by simp
   60.29 +declare power_hypreal_of_real_neg_numeral [of _ "numeral w", simp] for w
   60.30  (*
   60.31  lemma hrealpow_HFinite:
   60.32    fixes x :: "'a::{real_normed_algebra,power} star"
   60.33 @@ -492,7 +497,7 @@
   60.34  by transfer (rule power_one)
   60.35  
   60.36  lemma hrabs_hyperpow_minus_one [simp]:
   60.37 -  "\<And>n. abs(-1 pow n) = (1::'a::{number_ring,linordered_idom} star)"
   60.38 +  "\<And>n. abs(-1 pow n) = (1::'a::{linordered_idom} star)"
   60.39  by transfer (rule abs_power_minus_one)
   60.40  
   60.41  lemma hyperpow_mult:
    61.1 --- a/src/HOL/NSA/NSA.thy	Sat Mar 24 16:27:04 2012 +0100
    61.2 +++ b/src/HOL/NSA/NSA.thy	Sun Mar 25 20:15:39 2012 +0200
    61.3 @@ -190,7 +190,7 @@
    61.4  lemma SReal_hypreal_of_real [simp]: "hypreal_of_real x \<in> Reals"
    61.5  by (simp add: Reals_eq_Standard)
    61.6  
    61.7 -lemma SReal_divide_number_of: "r \<in> Reals ==> r/(number_of w::hypreal) \<in> Reals"
    61.8 +lemma SReal_divide_numeral: "r \<in> Reals ==> r/(numeral w::hypreal) \<in> Reals"
    61.9  by simp
   61.10  
   61.11  text{*epsilon is not in Reals because it is an infinitesimal*}
   61.12 @@ -290,8 +290,8 @@
   61.13    "(hnorm (x::hypreal) \<in> HFinite) = (x \<in> HFinite)"
   61.14  by (simp add: HFinite_def)
   61.15  
   61.16 -lemma HFinite_number_of [simp]: "number_of w \<in> HFinite"
   61.17 -unfolding star_number_def by (rule HFinite_star_of)
   61.18 +lemma HFinite_numeral [simp]: "numeral w \<in> HFinite"
   61.19 +unfolding star_numeral_def by (rule HFinite_star_of)
   61.20  
   61.21  (** As always with numerals, 0 and 1 are special cases **)
   61.22  
   61.23 @@ -347,7 +347,7 @@
   61.24  apply (rule InfinitesimalI)
   61.25  apply (rule hypreal_sum_of_halves [THEN subst])
   61.26  apply (drule half_gt_zero)
   61.27 -apply (blast intro: hnorm_add_less SReal_divide_number_of dest: InfinitesimalD)
   61.28 +apply (blast intro: hnorm_add_less SReal_divide_numeral dest: InfinitesimalD)
   61.29  done
   61.30  
   61.31  lemma Infinitesimal_minus_iff [simp]: "(-x:Infinitesimal) = (x:Infinitesimal)"
   61.32 @@ -652,7 +652,7 @@
   61.33  (*reorientation simplification procedure: reorients (polymorphic)
   61.34    0 = x, 1 = x, nnn = x provided x isn't 0, 1 or a numeral.*)
   61.35  simproc_setup approx_reorient_simproc
   61.36 -  ("0 @= x" | "1 @= y" | "number_of w @= z") =
   61.37 +  ("0 @= x" | "1 @= y" | "numeral w @= z" | "neg_numeral w @= r") =
   61.38  {*
   61.39    let val rule = @{thm approx_reorient} RS eq_reflection
   61.40        fun proc phi ss ct = case term_of ct of
   61.41 @@ -957,9 +957,9 @@
   61.42       "x \<noteq> 0 ==> star_of x \<in> HFinite - Infinitesimal"
   61.43  by simp
   61.44  
   61.45 -lemma number_of_not_Infinitesimal [simp]:
   61.46 -     "number_of w \<noteq> (0::hypreal) ==> (number_of w :: hypreal) \<notin> Infinitesimal"
   61.47 -by (fast dest: Reals_number_of [THEN SReal_Infinitesimal_zero])
   61.48 +lemma numeral_not_Infinitesimal [simp]:
   61.49 +     "numeral w \<noteq> (0::hypreal) ==> (numeral w :: hypreal) \<notin> Infinitesimal"
   61.50 +by (fast dest: Reals_numeral [THEN SReal_Infinitesimal_zero])
   61.51  
   61.52  (*again: 1 is a special case, but not 0 this time*)
   61.53  lemma one_not_Infinitesimal [simp]:
   61.54 @@ -1024,31 +1024,31 @@
   61.55  apply simp
   61.56  done
   61.57  
   61.58 -lemma number_of_approx_iff [simp]:
   61.59 -     "(number_of v @= (number_of w :: 'a::{number,real_normed_vector} star)) =
   61.60 -      (number_of v = (number_of w :: 'a))"
   61.61 -apply (unfold star_number_def)
   61.62 +lemma numeral_approx_iff [simp]:
   61.63 +     "(numeral v @= (numeral w :: 'a::{numeral,real_normed_vector} star)) =
   61.64 +      (numeral v = (numeral w :: 'a))"
   61.65 +apply (unfold star_numeral_def)
   61.66  apply (rule star_of_approx_iff)
   61.67  done
   61.68  
   61.69  (*And also for 0 @= #nn and 1 @= #nn, #nn @= 0 and #nn @= 1.*)
   61.70  lemma [simp]:
   61.71 -  "(number_of w @= (0::'a::{number,real_normed_vector} star)) =
   61.72 -   (number_of w = (0::'a))"
   61.73 -  "((0::'a::{number,real_normed_vector} star) @= number_of w) =
   61.74 -   (number_of w = (0::'a))"
   61.75 -  "(number_of w @= (1::'b::{number,one,real_normed_vector} star)) =
   61.76 -   (number_of w = (1::'b))"
   61.77 -  "((1::'b::{number,one,real_normed_vector} star) @= number_of w) =
   61.78 -   (number_of w = (1::'b))"
   61.79 +  "(numeral w @= (0::'a::{numeral,real_normed_vector} star)) =
   61.80 +   (numeral w = (0::'a))"
   61.81 +  "((0::'a::{numeral,real_normed_vector} star) @= numeral w) =
   61.82 +   (numeral w = (0::'a))"
   61.83 +  "(numeral w @= (1::'b::{numeral,one,real_normed_vector} star)) =
   61.84 +   (numeral w = (1::'b))"
   61.85 +  "((1::'b::{numeral,one,real_normed_vector} star) @= numeral w) =
   61.86 +   (numeral w = (1::'b))"
   61.87    "~ (0 @= (1::'c::{zero_neq_one,real_normed_vector} star))"
   61.88    "~ (1 @= (0::'c::{zero_neq_one,real_normed_vector} star))"
   61.89 -apply (unfold star_number_def star_zero_def star_one_def)
   61.90 +apply (unfold star_numeral_def star_zero_def star_one_def)
   61.91  apply (unfold star_of_approx_iff)
   61.92  by (auto intro: sym)
   61.93  
   61.94 -lemma star_of_approx_number_of_iff [simp]:
   61.95 -     "(star_of k @= number_of w) = (k = number_of w)"
   61.96 +lemma star_of_approx_numeral_iff [simp]:
   61.97 +     "(star_of k @= numeral w) = (k = numeral w)"
   61.98  by (subst star_of_approx_iff [symmetric], auto)
   61.99  
  61.100  lemma star_of_approx_zero_iff [simp]: "(star_of k @= 0) = (k = 0)"
  61.101 @@ -1843,8 +1843,11 @@
  61.102  lemma st_add: "\<lbrakk>x \<in> HFinite; y \<in> HFinite\<rbrakk> \<Longrightarrow> st (x + y) = st x + st y"
  61.103  by (simp add: st_unique st_SReal st_approx_self approx_add)
  61.104  
  61.105 -lemma st_number_of [simp]: "st (number_of w) = number_of w"
  61.106 -by (rule Reals_number_of [THEN st_SReal_eq])
  61.107 +lemma st_numeral [simp]: "st (numeral w) = numeral w"
  61.108 +by (rule Reals_numeral [THEN st_SReal_eq])
  61.109 +
  61.110 +lemma st_neg_numeral [simp]: "st (neg_numeral w) = neg_numeral w"
  61.111 +by (rule Reals_neg_numeral [THEN st_SReal_eq])
  61.112  
  61.113  lemma st_0 [simp]: "st 0 = 0"
  61.114  by (simp add: st_SReal_eq)
    62.1 --- a/src/HOL/NSA/NSCA.thy	Sat Mar 24 16:27:04 2012 +0100
    62.2 +++ b/src/HOL/NSA/NSCA.thy	Sun Mar 25 20:15:39 2012 +0200
    62.3 @@ -32,14 +32,14 @@
    62.4       "hcmod (hcomplex_of_complex r) \<in> Reals"
    62.5  by (simp add: Reals_eq_Standard)
    62.6  
    62.7 -lemma SReal_hcmod_number_of [simp]: "hcmod (number_of w ::hcomplex) \<in> Reals"
    62.8 +lemma SReal_hcmod_numeral [simp]: "hcmod (numeral w ::hcomplex) \<in> Reals"
    62.9  by (simp add: Reals_eq_Standard)
   62.10  
   62.11  lemma SReal_hcmod_SComplex: "x \<in> SComplex ==> hcmod x \<in> Reals"
   62.12  by (simp add: Reals_eq_Standard)
   62.13  
   62.14 -lemma SComplex_divide_number_of:
   62.15 -     "r \<in> SComplex ==> r/(number_of w::hcomplex) \<in> SComplex"
   62.16 +lemma SComplex_divide_numeral:
   62.17 +     "r \<in> SComplex ==> r/(numeral w::hcomplex) \<in> SComplex"
   62.18  by simp
   62.19  
   62.20  lemma SComplex_UNIV_complex:
   62.21 @@ -211,9 +211,9 @@
   62.22        ==> hcomplex_of_complex x \<in> HFinite - Infinitesimal"
   62.23  by (rule SComplex_HFinite_diff_Infinitesimal, auto)
   62.24  
   62.25 -lemma number_of_not_Infinitesimal [simp]:
   62.26 -     "number_of w \<noteq> (0::hcomplex) ==> (number_of w::hcomplex) \<notin> Infinitesimal"
   62.27 -by (fast dest: Standard_number_of [THEN SComplex_Infinitesimal_zero])
   62.28 +lemma numeral_not_Infinitesimal [simp]:
   62.29 +     "numeral w \<noteq> (0::hcomplex) ==> (numeral w::hcomplex) \<notin> Infinitesimal"
   62.30 +by (fast dest: Standard_numeral [THEN SComplex_Infinitesimal_zero])
   62.31  
   62.32  lemma approx_SComplex_not_zero:
   62.33       "[| y \<in> SComplex; x @= y; y\<noteq> 0 |] ==> x \<noteq> 0"
   62.34 @@ -223,11 +223,11 @@
   62.35       "[|x \<in> SComplex; y \<in> SComplex|] ==> (x @= y) = (x = y)"
   62.36  by (auto simp add: Standard_def)
   62.37  
   62.38 -lemma number_of_Infinitesimal_iff [simp]:
   62.39 -     "((number_of w :: hcomplex) \<in> Infinitesimal) =
   62.40 -      (number_of w = (0::hcomplex))"
   62.41 +lemma numeral_Infinitesimal_iff [simp]:
   62.42 +     "((numeral w :: hcomplex) \<in> Infinitesimal) =
   62.43 +      (numeral w = (0::hcomplex))"
   62.44  apply (rule iffI)
   62.45 -apply (fast dest: Standard_number_of [THEN SComplex_Infinitesimal_zero])
   62.46 +apply (fast dest: Standard_numeral [THEN SComplex_Infinitesimal_zero])
   62.47  apply (simp (no_asm_simp))
   62.48  done
   62.49  
   62.50 @@ -441,8 +441,8 @@
   62.51       "[| x \<in> HFinite; y \<in> HFinite |] ==> stc (x + y) = stc(x) + stc(y)"
   62.52  by (simp add: stc_unique stc_SComplex stc_approx_self approx_add)
   62.53  
   62.54 -lemma stc_number_of [simp]: "stc (number_of w) = number_of w"
   62.55 -by (rule Standard_number_of [THEN stc_SComplex_eq])
   62.56 +lemma stc_numeral [simp]: "stc (numeral w) = numeral w"
   62.57 +by (rule Standard_numeral [THEN stc_SComplex_eq])
   62.58  
   62.59  lemma stc_zero [simp]: "stc 0 = 0"
   62.60  by simp
    63.1 --- a/src/HOL/NSA/NSComplex.thy	Sat Mar 24 16:27:04 2012 +0100
    63.2 +++ b/src/HOL/NSA/NSComplex.thy	Sun Mar 25 20:15:39 2012 +0200
    63.3 @@ -626,32 +626,38 @@
    63.4  
    63.5  subsection{*Numerals and Arithmetic*}
    63.6  
    63.7 -lemma hcomplex_number_of_def: "(number_of w :: hcomplex) == of_int w"
    63.8 -by transfer (rule number_of_eq [THEN eq_reflection])
    63.9 -
   63.10  lemma hcomplex_of_hypreal_eq_hcomplex_of_complex: 
   63.11       "hcomplex_of_hypreal (hypreal_of_real x) =  
   63.12        hcomplex_of_complex (complex_of_real x)"
   63.13  by transfer (rule refl)
   63.14  
   63.15 -lemma hcomplex_hypreal_number_of: 
   63.16 -  "hcomplex_of_complex (number_of w) = hcomplex_of_hypreal(number_of w)"
   63.17 -by transfer (rule of_real_number_of_eq [symmetric])
   63.18 +lemma hcomplex_hypreal_numeral:
   63.19 +  "hcomplex_of_complex (numeral w) = hcomplex_of_hypreal(numeral w)"
   63.20 +by transfer (rule of_real_numeral [symmetric])
   63.21  
   63.22 -lemma hcomplex_number_of_hcnj [simp]:
   63.23 -     "hcnj (number_of v :: hcomplex) = number_of v"
   63.24 -by transfer (rule complex_cnj_number_of)
   63.25 +lemma hcomplex_hypreal_neg_numeral:
   63.26 +  "hcomplex_of_complex (neg_numeral w) = hcomplex_of_hypreal(neg_numeral w)"
   63.27 +by transfer (rule of_real_neg_numeral [symmetric])
   63.28 +
   63.29 +lemma hcomplex_numeral_hcnj [simp]:
   63.30 +     "hcnj (numeral v :: hcomplex) = numeral v"
   63.31 +by transfer (rule complex_cnj_numeral)
   63.32  
   63.33 -lemma hcomplex_number_of_hcmod [simp]: 
   63.34 -      "hcmod(number_of v :: hcomplex) = abs (number_of v :: hypreal)"
   63.35 -by transfer (rule norm_number_of)
   63.36 +lemma hcomplex_numeral_hcmod [simp]:
   63.37 +      "hcmod(numeral v :: hcomplex) = (numeral v :: hypreal)"
   63.38 +by transfer (rule norm_numeral)
   63.39 +
   63.40 +lemma hcomplex_neg_numeral_hcmod [simp]: 
   63.41 +      "hcmod(neg_numeral v :: hcomplex) = (numeral v :: hypreal)"
   63.42 +by transfer (rule norm_neg_numeral)
   63.43  
   63.44 -lemma hcomplex_number_of_hRe [simp]: 
   63.45 -      "hRe(number_of v :: hcomplex) = number_of v"
   63.46 -by transfer (rule complex_Re_number_of)
   63.47 +lemma hcomplex_numeral_hRe [simp]: 
   63.48 +      "hRe(numeral v :: hcomplex) = numeral v"
   63.49 +by transfer (rule complex_Re_numeral)
   63.50  
   63.51 -lemma hcomplex_number_of_hIm [simp]: 
   63.52 -      "hIm(number_of v :: hcomplex) = 0"
   63.53 -by transfer (rule complex_Im_number_of)
   63.54 +lemma hcomplex_numeral_hIm [simp]: 
   63.55 +      "hIm(numeral v :: hcomplex) = 0"
   63.56 +by transfer (rule complex_Im_numeral)
   63.57  
   63.58 +(* TODO: add neg_numeral rules above *)
   63.59  end
    64.1 --- a/src/HOL/NSA/StarDef.thy	Sat Mar 24 16:27:04 2012 +0100
    64.2 +++ b/src/HOL/NSA/StarDef.thy	Sun Mar 25 20:15:39 2012 +0200
    64.3 @@ -522,16 +522,6 @@
    64.4  
    64.5  end
    64.6  
    64.7 -instantiation star :: (number) number
    64.8 -begin
    64.9 -
   64.10 -definition
   64.11 -  star_number_def:  "number_of b \<equiv> star_of (number_of b)"
   64.12 -
   64.13 -instance ..
   64.14 -
   64.15 -end
   64.16 -
   64.17  instance star :: (Rings.dvd) Rings.dvd ..
   64.18  
   64.19  instantiation star :: (Divides.div) Divides.div
   64.20 @@ -561,7 +551,7 @@
   64.21  end
   64.22  
   64.23  lemmas star_class_defs [transfer_unfold] =
   64.24 -  star_zero_def     star_one_def      star_number_def
   64.25 +  star_zero_def     star_one_def
   64.26    star_add_def      star_diff_def     star_minus_def
   64.27    star_mult_def     star_divide_def   star_inverse_def
   64.28    star_le_def       star_less_def     star_abs_def       star_sgn_def
   64.29 @@ -575,9 +565,6 @@
   64.30  lemma Standard_one: "1 \<in> Standard"
   64.31  by (simp add: star_one_def)
   64.32  
   64.33 -lemma Standard_number_of: "number_of b \<in> Standard"
   64.34 -by (simp add: star_number_def)
   64.35 -
   64.36  lemma Standard_add: "\<lbrakk>x \<in> Standard; y \<in> Standard\<rbrakk> \<Longrightarrow> x + y \<in> Standard"
   64.37  by (simp add: star_add_def)
   64.38  
   64.39 @@ -606,7 +593,7 @@
   64.40  by (simp add: star_mod_def)
   64.41  
   64.42  lemmas Standard_simps [simp] =
   64.43 -  Standard_zero  Standard_one  Standard_number_of
   64.44 +  Standard_zero  Standard_one
   64.45    Standard_add  Standard_diff  Standard_minus
   64.46    Standard_mult  Standard_divide  Standard_inverse
   64.47    Standard_abs  Standard_div  Standard_mod
   64.48 @@ -648,9 +635,6 @@
   64.49  lemma star_of_one: "star_of 1 = 1"
   64.50  by transfer (rule refl)
   64.51  
   64.52 -lemma star_of_number_of: "star_of (number_of x) = number_of x"
   64.53 -by transfer (rule refl)
   64.54 -
   64.55  text {* @{term star_of} preserves orderings *}
   64.56  
   64.57  lemma star_of_less: "(star_of x < star_of y) = (x < y)"
   64.58 @@ -682,34 +666,16 @@
   64.59  lemmas star_of_le_1   = star_of_le   [of _ 1, simplified star_of_one]
   64.60  lemmas star_of_eq_1   = star_of_eq   [of _ 1, simplified star_of_one]
   64.61  
   64.62 -text{*As above, for numerals*}
   64.63 -
   64.64 -lemmas star_of_number_less =
   64.65 -  star_of_less [of "number_of w", simplified star_of_number_of] for w
   64.66 -lemmas star_of_number_le   =
   64.67 -  star_of_le   [of "number_of w", simplified star_of_number_of] for w
   64.68 -lemmas star_of_number_eq   =
   64.69 -  star_of_eq   [of "number_of w", simplified star_of_number_of] for w
   64.70 -
   64.71 -lemmas star_of_less_number =
   64.72 -  star_of_less [of _ "number_of w", simplified star_of_number_of] for w
   64.73 -lemmas star_of_le_number   =
   64.74 -  star_of_le   [of _ "number_of w", simplified star_of_number_of] for w
   64.75 -lemmas star_of_eq_number   =
   64.76 -  star_of_eq   [of _ "number_of w", simplified star_of_number_of] for w
   64.77 -
   64.78  lemmas star_of_simps [simp] =
   64.79    star_of_add     star_of_diff    star_of_minus
   64.80    star_of_mult    star_of_divide  star_of_inverse
   64.81    star_of_div     star_of_mod     star_of_abs
   64.82 -  star_of_zero    star_of_one     star_of_number_of
   64.83 +  star_of_zero    star_of_one
   64.84    star_of_less    star_of_le      star_of_eq
   64.85    star_of_0_less  star_of_0_le    star_of_0_eq
   64.86    star_of_less_0  star_of_le_0    star_of_eq_0
   64.87    star_of_1_less  star_of_1_le    star_of_1_eq
   64.88    star_of_less_1  star_of_le_1    star_of_eq_1
   64.89 -  star_of_number_less star_of_number_le star_of_number_eq
   64.90 -  star_of_less_number star_of_le_number star_of_eq_number
   64.91  
   64.92  subsection {* Ordering and lattice classes *}
   64.93  
   64.94 @@ -984,9 +950,45 @@
   64.95  
   64.96  subsection {* Number classes *}
   64.97  
   64.98 +instance star :: (numeral) numeral ..
   64.99 +
  64.100 +lemma star_numeral_def [transfer_unfold]:
  64.101 +  "numeral k = star_of (numeral k)"
  64.102 +by (induct k, simp_all only: numeral.simps star_of_one star_of_add)
  64.103 +
  64.104 +lemma Standard_numeral [simp]: "numeral k \<in> Standard"
  64.105 +by (simp add: star_numeral_def)
  64.106 +
  64.107 +lemma star_of_numeral [simp]: "star_of (numeral k) = numeral k"
  64.108 +by transfer (rule refl)
  64.109 +
  64.110 +lemma star_neg_numeral_def [transfer_unfold]:
  64.111 +  "neg_numeral k = star_of (neg_numeral k)"
  64.112 +by (simp only: neg_numeral_def star_of_minus star_of_numeral)
  64.113 +
  64.114 +lemma Standard_neg_numeral [simp]: "neg_numeral k \<in> Standard"
  64.115 +by (simp add: star_neg_numeral_def)
  64.116 +
  64.117 +lemma star_of_neg_numeral [simp]: "star_of (neg_numeral k) = neg_numeral k"
  64.118 +by transfer (rule refl)
  64.119 +
  64.120  lemma star_of_nat_def [transfer_unfold]: "of_nat n = star_of (of_nat n)"
  64.121  by (induct n, simp_all)
  64.122  
  64.123 +lemmas star_of_compare_numeral [simp] =
  64.124 +  star_of_less [of "numeral k", simplified star_of_numeral]
  64.125 +  star_of_le   [of "numeral k", simplified star_of_numeral]
  64.126 +  star_of_eq   [of "numeral k", simplified star_of_numeral]
  64.127 +  star_of_less [of _ "numeral k", simplified star_of_numeral]
  64.128 +  star_of_le   [of _ "numeral k", simplified star_of_numeral]
  64.129 +  star_of_eq   [of _ "numeral k", simplified star_of_numeral]
  64.130 +  star_of_less [of "neg_numeral k", simplified star_of_numeral]
  64.131 +  star_of_le   [of "neg_numeral k", simplified star_of_numeral]
  64.132 +  star_of_eq   [of "neg_numeral k", simplified star_of_numeral]
  64.133 +  star_of_less [of _ "neg_numeral k", simplified star_of_numeral]
  64.134 +  star_of_le   [of _ "neg_numeral k", simplified star_of_numeral]
  64.135 +  star_of_eq   [of _ "neg_numeral k", simplified star_of_numeral] for k
  64.136 +
  64.137  lemma Standard_of_nat [simp]: "of_nat n \<in> Standard"
  64.138  by (simp add: star_of_nat_def)
  64.139  
  64.140 @@ -1010,11 +1012,6 @@
  64.141  
  64.142  instance star :: (ring_char_0) ring_char_0 ..
  64.143  
  64.144 -instance star :: (number_semiring) number_semiring
  64.145 -by (intro_classes, simp only: star_number_def star_of_nat_def number_of_int)
  64.146 -
  64.147 -instance star :: (number_ring) number_ring
  64.148 -by (intro_classes, simp only: star_number_def star_of_int_def number_of_eq)
  64.149  
  64.150  subsection {* Finite class *}
  64.151  
    65.1 --- a/src/HOL/Nat.thy	Sat Mar 24 16:27:04 2012 +0100
    65.2 +++ b/src/HOL/Nat.thy	Sun Mar 25 20:15:39 2012 +0200
    65.3 @@ -181,7 +181,7 @@
    65.4  begin
    65.5  
    65.6  definition
    65.7 -  One_nat_def [simp, code_post]: "1 = Suc 0"
    65.8 +  One_nat_def [simp]: "1 = Suc 0"
    65.9  
   65.10  primrec times_nat where
   65.11    mult_0:     "0 * n = (0\<Colon>nat)"
   65.12 @@ -1782,4 +1782,6 @@
   65.13  code_modulename Haskell
   65.14    Nat Arith
   65.15  
   65.16 +hide_const (open) of_nat_aux
   65.17 +
   65.18  end
    66.1 --- a/src/HOL/Nat_Numeral.thy	Sat Mar 24 16:27:04 2012 +0100
    66.2 +++ b/src/HOL/Nat_Numeral.thy	Sun Mar 25 20:15:39 2012 +0200
    66.3 @@ -15,31 +15,13 @@
    66.4    Arithmetic for naturals is reduced to that for the non-negative integers.
    66.5  *}
    66.6  
    66.7 -instantiation nat :: number_semiring
    66.8 -begin
    66.9 -
   66.10 -definition
   66.11 -  nat_number_of_def [code_unfold, code del]: "number_of v = nat (number_of v)"
   66.12 -
   66.13 -instance proof
   66.14 -  fix n show "number_of (int n) = (of_nat n :: nat)"
   66.15 -    unfolding nat_number_of_def number_of_eq by simp
   66.16 -qed
   66.17 - 
   66.18 -end
   66.19 -
   66.20 -lemma [code_post]:
   66.21 -  "nat (number_of v) = number_of v"
   66.22 -  unfolding nat_number_of_def ..
   66.23 -
   66.24 -
   66.25  subsection {* Special case: squares and cubes *}
   66.26  
   66.27  lemma numeral_2_eq_2: "2 = Suc (Suc 0)"
   66.28 -  by (simp add: nat_number_of_def)
   66.29 +  by (simp add: nat_number(2-4))
   66.30  
   66.31  lemma numeral_3_eq_3: "3 = Suc (Suc (Suc 0))"
   66.32 -  by (simp add: nat_number_of_def)
   66.33 +  by (simp add: nat_number(2-4))
   66.34  
   66.35  context power
   66.36  begin
   66.37 @@ -93,26 +75,21 @@
   66.38    "(- a)\<twosuperior> = a\<twosuperior>"
   66.39    by (simp add: power2_eq_square)
   66.40  
   66.41 -text{*
   66.42 -  We cannot prove general results about the numeral @{term "-1"},
   66.43 -  so we have to use @{term "- 1"} instead.
   66.44 -*}
   66.45 -
   66.46  lemma power_minus1_even [simp]:
   66.47 -  "(- 1) ^ (2*n) = 1"
   66.48 +  "-1 ^ (2*n) = 1"
   66.49  proof (induct n)
   66.50    case 0 show ?case by simp
   66.51  next
   66.52 -  case (Suc n) then show ?case by (simp add: power_add)
   66.53 +  case (Suc n) then show ?case by (simp add: power_add power2_eq_square)
   66.54  qed
   66.55  
   66.56  lemma power_minus1_odd:
   66.57 -  "(- 1) ^ Suc (2*n) = - 1"
   66.58 +  "-1 ^ Suc (2*n) = -1"
   66.59    by simp
   66.60  
   66.61  lemma power_minus_even [simp]:
   66.62    "(-a) ^ (2*n) = a ^ (2*n)"
   66.63 -  by (simp add: power_minus [of a]) 
   66.64 +  by (simp add: power_minus [of a])
   66.65  
   66.66  end
   66.67  
   66.68 @@ -261,100 +238,31 @@
   66.69  end
   66.70  
   66.71  lemma power2_sum:
   66.72 -  fixes x y :: "'a::number_semiring"
   66.73 +  fixes x y :: "'a::comm_semiring_1"
   66.74    shows "(x + y)\<twosuperior> = x\<twosuperior> + y\<twosuperior> + 2 * x * y"
   66.75 -  by (simp add: algebra_simps power2_eq_square semiring_mult_2_right)
   66.76 +  by (simp add: algebra_simps power2_eq_square mult_2_right)
   66.77  
   66.78  lemma power2_diff:
   66.79 -  fixes x y :: "'a::number_ring"
   66.80 +  fixes x y :: "'a::comm_ring_1"
   66.81    shows "(x - y)\<twosuperior> = x\<twosuperior> + y\<twosuperior> - 2 * x * y"
   66.82    by (simp add: ring_distribs power2_eq_square mult_2) (rule mult_commute)
   66.83  
   66.84  
   66.85 -subsection {* Predicate for negative binary numbers *}
   66.86 -
   66.87 -definition neg  :: "int \<Rightarrow> bool" where
   66.88 -  "neg Z \<longleftrightarrow> Z < 0"
   66.89 -
   66.90 -lemma not_neg_int [simp]: "~ neg (of_nat n)"
   66.91 -by (simp add: neg_def)
   66.92 -
   66.93 -lemma neg_zminus_int [simp]: "neg (- (of_nat (Suc n)))"
   66.94 -by (simp add: neg_def del: of_nat_Suc)
   66.95 -
   66.96 -lemmas neg_eq_less_0 = neg_def
   66.97 -
   66.98 -lemma not_neg_eq_ge_0: "(~neg x) = (0 \<le> x)"
   66.99 -by (simp add: neg_def linorder_not_less)
  66.100 -
  66.101 -text{*To simplify inequalities when Numeral1 can get simplified to 1*}
  66.102 -
  66.103 -lemma not_neg_0: "~ neg 0"
  66.104 -by (simp add: One_int_def neg_def)
  66.105 -
  66.106 -lemma not_neg_1: "~ neg 1"
  66.107 -by (simp add: neg_def linorder_not_less)
  66.108 -
  66.109 -lemma neg_nat: "neg z ==> nat z = 0"
  66.110 -by (simp add: neg_def order_less_imp_le) 
  66.111 -
  66.112 -lemma not_neg_nat: "~ neg z ==> of_nat (nat z) = z"
  66.113 -by (simp add: linorder_not_less neg_def)
  66.114 -
  66.115 -text {*
  66.116 -  If @{term Numeral0} is rewritten to 0 then this rule can't be applied:
  66.117 -  @{term Numeral0} IS @{term "number_of Pls"}
  66.118 -*}
  66.119 -
  66.120 -lemma not_neg_number_of_Pls: "~ neg (number_of Int.Pls)"
  66.121 -  by (simp add: neg_def)
  66.122 -
  66.123 -lemma neg_number_of_Min: "neg (number_of Int.Min)"
  66.124 -  by (simp add: neg_def)
  66.125 -
  66.126 -lemma neg_number_of_Bit0:
  66.127 -  "neg (number_of (Int.Bit0 w)) = neg (number_of w)"
  66.128 -  by (simp add: neg_def)
  66.129 -
  66.130 -lemma neg_number_of_Bit1:
  66.131 -  "neg (number_of (Int.Bit1 w)) = neg (number_of w)"
  66.132 -  by (simp add: neg_def)
  66.133 -
  66.134 -lemmas neg_simps [simp] =
  66.135 -  not_neg_0 not_neg_1
  66.136 -  not_neg_number_of_Pls neg_number_of_Min
  66.137 -  neg_number_of_Bit0 neg_number_of_Bit1
  66.138 -
  66.139 -
  66.140  subsection{*Function @{term nat}: Coercion from Type @{typ int} to @{typ nat}*}
  66.141  
  66.142  declare nat_1 [simp]
  66.143  
  66.144 -lemma nat_number_of [simp]: "nat (number_of w) = number_of w"
  66.145 -  by (simp add: nat_number_of_def)
  66.146 -
  66.147 -lemma nat_numeral_0_eq_0: "Numeral0 = (0::nat)" (* FIXME delete candidate *)
  66.148 -  by (fact semiring_numeral_0_eq_0)
  66.149 -
  66.150 -lemma nat_numeral_1_eq_1: "Numeral1 = (1::nat)" (* FIXME delete candidate *)
  66.151 -  by (fact semiring_numeral_1_eq_1)
  66.152 -
  66.153 -lemma Numeral1_eq1_nat:
  66.154 -  "(1::nat) = Numeral1"
  66.155 +lemma nat_neg_numeral [simp]: "nat (neg_numeral w) = 0"
  66.156    by simp
  66.157  
  66.158  lemma numeral_1_eq_Suc_0: "Numeral1 = Suc 0"
  66.159 -  by (simp only: nat_numeral_1_eq_1 One_nat_def)
  66.160 +  by simp
  66.161  
  66.162  
  66.163  subsection{*Function @{term int}: Coercion from Type @{typ nat} to @{typ int}*}
  66.164  
  66.165 -lemma int_nat_number_of [simp]:
  66.166 -     "int (number_of v) =  
  66.167 -         (if neg (number_of v :: int) then 0  
  66.168 -          else (number_of v :: int))"
  66.169 -  unfolding nat_number_of_def number_of_is_id neg_def
  66.170 -  by simp (* FIXME: redundant with of_nat_number_of_eq *)
  66.171 +lemma int_numeral: "int (numeral v) = numeral v"
  66.172 +  by (rule of_nat_numeral) (* already simp *)
  66.173  
  66.174  lemma nonneg_int_cases:
  66.175    fixes k :: int assumes "0 \<le> k" obtains n where "k = of_nat n"
  66.176 @@ -368,149 +276,51 @@
  66.177  done
  66.178  
  66.179  lemma Suc_nat_number_of_add:
  66.180 -     "Suc (number_of v + n) =  
  66.181 -        (if neg (number_of v :: int) then 1+n else number_of (Int.succ v) + n)"
  66.182 -  unfolding nat_number_of_def number_of_is_id neg_def numeral_simps
  66.183 -  by (simp add: Suc_nat_eq_nat_zadd1 add_ac)
  66.184 -
  66.185 -lemma Suc_nat_number_of [simp]:
  66.186 -     "Suc (number_of v) =  
  66.187 -        (if neg (number_of v :: int) then 1 else number_of (Int.succ v))"
  66.188 -apply (cut_tac n = 0 in Suc_nat_number_of_add)
  66.189 -apply (simp cong del: if_weak_cong)
  66.190 -done
  66.191 -
  66.192 -
  66.193 -subsubsection{*Addition *}
  66.194 -
  66.195 -lemma add_nat_number_of [simp]:
  66.196 -     "(number_of v :: nat) + number_of v' =  
  66.197 -         (if v < Int.Pls then number_of v'  
  66.198 -          else if v' < Int.Pls then number_of v  
  66.199 -          else number_of (v + v'))"
  66.200 -  unfolding nat_number_of_def number_of_is_id numeral_simps
  66.201 -  by (simp add: nat_add_distrib)
  66.202 -
  66.203 -lemma nat_number_of_add_1 [simp]:
  66.204 -  "number_of v + (1::nat) =
  66.205 -    (if v < Int.Pls then 1 else number_of (Int.succ v))"
  66.206 -  unfolding nat_number_of_def number_of_is_id numeral_simps
  66.207 -  by (simp add: nat_add_distrib)
  66.208 +  "Suc (numeral v + n) = numeral (v + Num.One) + n"
  66.209 +  by simp
  66.210  
  66.211 -lemma nat_1_add_number_of [simp]:
  66.212 -  "(1::nat) + number_of v =
  66.213 -    (if v < Int.Pls then 1 else number_of (Int.succ v))"
  66.214 -  unfolding nat_number_of_def number_of_is_id numeral_simps
  66.215 -  by (simp add: nat_add_distrib)
  66.216 -
  66.217 -lemma nat_1_add_1 [simp]: "1 + 1 = (2::nat)"
  66.218 -  by (rule semiring_one_add_one_is_two)
  66.219 -
  66.220 -text {* TODO: replace simp rules above with these generic ones: *}
  66.221 -
  66.222 -lemma semiring_add_number_of:
  66.223 -  "\<lbrakk>Int.Pls \<le> v; Int.Pls \<le> v'\<rbrakk> \<Longrightarrow>
  66.224 -    (number_of v :: 'a::number_semiring) + number_of v' = number_of (v + v')"
  66.225 -  unfolding Int.Pls_def
  66.226 -  by (elim nonneg_int_cases,
  66.227 -    simp only: number_of_int of_nat_add [symmetric])
  66.228 -
  66.229 -lemma semiring_number_of_add_1:
  66.230 -  "Int.Pls \<le> v \<Longrightarrow>
  66.231 -    number_of v + (1::'a::number_semiring) = number_of (Int.succ v)"
  66.232 -  unfolding Int.Pls_def Int.succ_def
  66.233 -  by (elim nonneg_int_cases,
  66.234 -    simp only: number_of_int add_commute [where b=1] of_nat_Suc [symmetric])
  66.235 -
  66.236 -lemma semiring_1_add_number_of:
  66.237 -  "Int.Pls \<le> v \<Longrightarrow>
  66.238 -    (1::'a::number_semiring) + number_of v = number_of (Int.succ v)"
  66.239 -  unfolding Int.Pls_def Int.succ_def
  66.240 -  by (elim nonneg_int_cases,
  66.241 -    simp only: number_of_int add_commute [where b=1] of_nat_Suc [symmetric])
  66.242 +lemma Suc_numeral [simp]:
  66.243 +  "Suc (numeral v) = numeral (v + Num.One)"
  66.244 +  by simp
  66.245  
  66.246  
  66.247  subsubsection{*Subtraction *}
  66.248  
  66.249  lemma diff_nat_eq_if:
  66.250       "nat z - nat z' =  
  66.251 -        (if neg z' then nat z   
  66.252 +        (if z' < 0 then nat z   
  66.253           else let d = z-z' in     
  66.254 -              if neg d then 0 else nat d)"
  66.255 -by (simp add: Let_def nat_diff_distrib [symmetric] neg_eq_less_0 not_neg_eq_ge_0)
  66.256 -
  66.257 -
  66.258 -lemma diff_nat_number_of [simp]: 
  66.259 -     "(number_of v :: nat) - number_of v' =  
  66.260 -        (if v' < Int.Pls then number_of v  
  66.261 -         else let d = number_of (v + uminus v') in     
  66.262 -              if neg d then 0 else nat d)"
  66.263 -  unfolding nat_number_of_def number_of_is_id numeral_simps neg_def
  66.264 -  by auto
  66.265 +              if d < 0 then 0 else nat d)"
  66.266 +by (simp add: Let_def nat_diff_distrib [symmetric])
  66.267  
  66.268 -lemma nat_number_of_diff_1 [simp]:
  66.269 -  "number_of v - (1::nat) =
  66.270 -    (if v \<le> Int.Pls then 0 else number_of (Int.pred v))"
  66.271 -  unfolding nat_number_of_def number_of_is_id numeral_simps
  66.272 -  by auto
  66.273 -
  66.274 -
  66.275 -subsubsection{*Multiplication *}
  66.276 +(* Int.nat_diff_distrib has too-strong premises *)
  66.277 +lemma nat_diff_distrib': "\<lbrakk>0 \<le> x; 0 \<le> y\<rbrakk> \<Longrightarrow> nat (x - y) = nat x - nat y"
  66.278 +apply (rule int_int_eq [THEN iffD1], clarsimp)
  66.279 +apply (subst zdiff_int [symmetric])
  66.280 +apply (rule nat_mono, simp_all)
  66.281 +done
  66.282  
  66.283 -lemma mult_nat_number_of [simp]:
  66.284 -     "(number_of v :: nat) * number_of v' =  
  66.285 -       (if v < Int.Pls then 0 else number_of (v * v'))"
  66.286 -  unfolding nat_number_of_def number_of_is_id numeral_simps
  66.287 -  by (simp add: nat_mult_distrib)
  66.288 +lemma diff_nat_numeral [simp]: 
  66.289 +  "(numeral v :: nat) - numeral v' = nat (numeral v - numeral v')"
  66.290 +  by (simp only: nat_diff_distrib' zero_le_numeral nat_numeral)
  66.291  
  66.292 -(* TODO: replace mult_nat_number_of with this next rule *)
  66.293 -lemma semiring_mult_number_of:
  66.294 -  "\<lbrakk>Int.Pls \<le> v; Int.Pls \<le> v'\<rbrakk> \<Longrightarrow>
  66.295 -    (number_of v :: 'a::number_semiring) * number_of v' = number_of (v * v')"
  66.296 -  unfolding Int.Pls_def
  66.297 -  by (elim nonneg_int_cases,
  66.298 -    simp only: number_of_int of_nat_mult [symmetric])
  66.299 +lemma nat_numeral_diff_1 [simp]:
  66.300 +  "numeral v - (1::nat) = nat (numeral v - 1)"
  66.301 +  using diff_nat_numeral [of v Num.One] by simp
  66.302  
  66.303  
  66.304  subsection{*Comparisons*}
  66.305  
  66.306 -subsubsection{*Equals (=) *}
  66.307 -
  66.308 -lemma eq_nat_number_of [simp]:
  66.309 -     "((number_of v :: nat) = number_of v') =  
  66.310 -      (if neg (number_of v :: int) then (number_of v' :: int) \<le> 0
  66.311 -       else if neg (number_of v' :: int) then (number_of v :: int) = 0
  66.312 -       else v = v')"
  66.313 -  unfolding nat_number_of_def number_of_is_id neg_def
  66.314 -  by auto
  66.315 -
  66.316 -
  66.317 -subsubsection{*Less-than (<) *}
  66.318 -
  66.319 -lemma less_nat_number_of [simp]:
  66.320 -  "(number_of v :: nat) < number_of v' \<longleftrightarrow>
  66.321 -    (if v < v' then Int.Pls < v' else False)"
  66.322 -  unfolding nat_number_of_def number_of_is_id numeral_simps
  66.323 -  by auto
  66.324 -
  66.325 -
  66.326 -subsubsection{*Less-than-or-equal *}
  66.327 -
  66.328 -lemma le_nat_number_of [simp]:
  66.329 -  "(number_of v :: nat) \<le> number_of v' \<longleftrightarrow>
  66.330 -    (if v \<le> v' then True else v \<le> Int.Pls)"
  66.331 -  unfolding nat_number_of_def number_of_is_id numeral_simps
  66.332 -  by auto
  66.333 -
  66.334 -(*Maps #n to n for n = 0, 1, 2*)
  66.335 -lemmas numerals = nat_numeral_0_eq_0 nat_numeral_1_eq_1 numeral_2_eq_2
  66.336 +(*Maps #n to n for n = 1, 2*)
  66.337 +lemmas numerals = numeral_1_eq_1 [where 'a=nat] numeral_2_eq_2
  66.338  
  66.339  
  66.340  subsection{*Powers with Numeric Exponents*}
  66.341  
  66.342  text{*Squares of literal numerals will be evaluated.*}
  66.343 -lemmas power2_eq_square_number_of [simp] =
  66.344 -  power2_eq_square [of "number_of w"] for w
  66.345 +(* FIXME: replace with more general rules for powers of numerals *)
  66.346 +lemmas power2_eq_square_numeral [simp] =
  66.347 +    power2_eq_square [of "numeral w"] for w
  66.348  
  66.349  
  66.350  text{*Simprules for comparisons where common factors can be cancelled.*}
  66.351 @@ -528,8 +338,8 @@
  66.352  by simp
  66.353  
  66.354  (*Expresses a natural number constant as the Suc of another one.
  66.355 -  NOT suitable for rewriting because n recurs in the condition.*)
  66.356 -lemmas expand_Suc = Suc_pred' [of "number_of v"] for v
  66.357 +  NOT suitable for rewriting because n recurs on the right-hand side.*)
  66.358 +lemmas expand_Suc = Suc_pred' [of "numeral v", OF zero_less_numeral] for v
  66.359  
  66.360  subsubsection{*Arith *}
  66.361  
  66.362 @@ -539,7 +349,7 @@
  66.363  lemma Suc_eq_plus1_left: "Suc n = 1 + n"
  66.364    unfolding One_nat_def by simp
  66.365  
  66.366 -(* These two can be useful when m = number_of... *)
  66.367 +(* These two can be useful when m = numeral... *)
  66.368  
  66.369  lemma add_eq_if: "(m::nat) + n = (if m=0 then n else Suc ((m - 1) + n))"
  66.370    unfolding One_nat_def by (cases m) simp_all
  66.371 @@ -551,231 +361,108 @@
  66.372    unfolding One_nat_def by (cases m) simp_all
  66.373  
  66.374  
  66.375 -subsection{*Comparisons involving (0::nat) *}
  66.376 -
  66.377 -text{*Simplification already does @{term "n<0"}, @{term "n\<le>0"} and @{term "0\<le>n"}.*}
  66.378 -
  66.379 -lemma eq_number_of_0 [simp]:
  66.380 -  "number_of v = (0::nat) \<longleftrightarrow> v \<le> Int.Pls"
  66.381 -  unfolding nat_number_of_def number_of_is_id numeral_simps
  66.382 -  by auto
  66.383 -
  66.384 -lemma eq_0_number_of [simp]:
  66.385 -  "(0::nat) = number_of v \<longleftrightarrow> v \<le> Int.Pls"
  66.386 -by (rule trans [OF eq_sym_conv eq_number_of_0])
  66.387 -
  66.388 -lemma less_0_number_of [simp]:
  66.389 -   "(0::nat) < number_of v \<longleftrightarrow> Int.Pls < v"
  66.390 -  unfolding nat_number_of_def number_of_is_id numeral_simps
  66.391 -  by simp
  66.392 -
  66.393 -lemma neg_imp_number_of_eq_0: "neg (number_of v :: int) ==> number_of v = (0::nat)"
  66.394 -  by (simp del: semiring_numeral_0_eq_0 add: nat_numeral_0_eq_0 [symmetric])
  66.395 -
  66.396 -
  66.397  subsection{*Comparisons involving  @{term Suc} *}
  66.398  
  66.399 -lemma eq_number_of_Suc [simp]:
  66.400 -     "(number_of v = Suc n) =  
  66.401 -        (let pv = number_of (Int.pred v) in  
  66.402 -         if neg pv then False else nat pv = n)"
  66.403 -apply (simp only: simp_thms Let_def neg_eq_less_0 linorder_not_less 
  66.404 -                  number_of_pred nat_number_of_def 
  66.405 -            split add: split_if)
  66.406 -apply (rule_tac x = "number_of v" in spec)
  66.407 -apply (auto simp add: nat_eq_iff)
  66.408 -done
  66.409 +lemma eq_numeral_Suc [simp]: "numeral v = Suc n \<longleftrightarrow> nat (numeral v - 1) = n"
  66.410 +  by (subst expand_Suc, simp only: nat.inject nat_numeral_diff_1)
  66.411  
  66.412 -lemma Suc_eq_number_of [simp]:
  66.413 -     "(Suc n = number_of v) =  
  66.414 -        (let pv = number_of (Int.pred v) in  
  66.415 -         if neg pv then False else nat pv = n)"
  66.416 -by (rule trans [OF eq_sym_conv eq_number_of_Suc])
  66.417 +lemma Suc_eq_numeral [simp]: "Suc n = numeral v \<longleftrightarrow> n = nat (numeral v - 1)"
  66.418 +  by (subst expand_Suc, simp only: nat.inject nat_numeral_diff_1)
  66.419  
  66.420 -lemma less_number_of_Suc [simp]:
  66.421 -     "(number_of v < Suc n) =  
  66.422 -        (let pv = number_of (Int.pred v) in  
  66.423 -         if neg pv then True else nat pv < n)"
  66.424 -apply (simp only: simp_thms Let_def neg_eq_less_0 linorder_not_less 
  66.425 -                  number_of_pred nat_number_of_def  
  66.426 -            split add: split_if)
  66.427 -apply (rule_tac x = "number_of v" in spec)
  66.428 -apply (auto simp add: nat_less_iff)
  66.429 -done
  66.430 +lemma less_numeral_Suc [simp]: "numeral v < Suc n \<longleftrightarrow> nat (numeral v - 1) < n"
  66.431 +  by (subst expand_Suc, simp only: Suc_less_eq nat_numeral_diff_1)
  66.432  
  66.433 -lemma less_Suc_number_of [simp]:
  66.434 -     "(Suc n < number_of v) =  
  66.435 -        (let pv = number_of (Int.pred v) in  
  66.436 -         if neg pv then False else n < nat pv)"
  66.437 -apply (simp only: simp_thms Let_def neg_eq_less_0 linorder_not_less 
  66.438 -                  number_of_pred nat_number_of_def
  66.439 -            split add: split_if)
  66.440 -apply (rule_tac x = "number_of v" in spec)
  66.441 -apply (auto simp add: zless_nat_eq_int_zless)
  66.442 -done
  66.443 +lemma less_Suc_numeral [simp]: "Suc n < numeral v \<longleftrightarrow> n < nat (numeral v - 1)"
  66.444 +  by (subst expand_Suc, simp only: Suc_less_eq nat_numeral_diff_1)
  66.445  
  66.446 -lemma le_number_of_Suc [simp]:
  66.447 -     "(number_of v <= Suc n) =  
  66.448 -        (let pv = number_of (Int.pred v) in  
  66.449 -         if neg pv then True else nat pv <= n)"
  66.450 -by (simp add: Let_def linorder_not_less [symmetric])
  66.451 +lemma le_numeral_Suc [simp]: "numeral v \<le> Suc n \<longleftrightarrow> nat (numeral v - 1) \<le> n"
  66.452 +  by (subst expand_Suc, simp only: Suc_le_mono nat_numeral_diff_1)
  66.453  
  66.454 -lemma le_Suc_number_of [simp]:
  66.455 -     "(Suc n <= number_of v) =  
  66.456 -        (let pv = number_of (Int.pred v) in  
  66.457 -         if neg pv then False else n <= nat pv)"
  66.458 -by (simp add: Let_def linorder_not_less [symmetric])
  66.459 -
  66.460 -
  66.461 -lemma eq_number_of_Pls_Min: "(Numeral0 ::int) ~= number_of Int.Min"
  66.462 -by auto
  66.463 -
  66.464 +lemma le_Suc_numeral [simp]: "Suc n \<le> numeral v \<longleftrightarrow> n \<le> nat (numeral v - 1)"
  66.465 +  by (subst expand_Suc, simp only: Suc_le_mono nat_numeral_diff_1)
  66.466  
  66.467  
  66.468  subsection{*Max and Min Combined with @{term Suc} *}
  66.469  
  66.470 -lemma max_number_of_Suc [simp]:
  66.471 -     "max (Suc n) (number_of v) =  
  66.472 -        (let pv = number_of (Int.pred v) in  
  66.473 -         if neg pv then Suc n else Suc(max n (nat pv)))"
  66.474 -apply (simp only: Let_def neg_eq_less_0 number_of_pred nat_number_of_def 
  66.475 -            split add: split_if nat.split)
  66.476 -apply (rule_tac x = "number_of v" in spec) 
  66.477 -apply auto
  66.478 -done
  66.479 - 
  66.480 -lemma max_Suc_number_of [simp]:
  66.481 -     "max (number_of v) (Suc n) =  
  66.482 -        (let pv = number_of (Int.pred v) in  
  66.483 -         if neg pv then Suc n else Suc(max (nat pv) n))"
  66.484 -apply (simp only: Let_def neg_eq_less_0 number_of_pred nat_number_of_def 
  66.485 -            split add: split_if nat.split)
  66.486 -apply (rule_tac x = "number_of v" in spec) 
  66.487 -apply auto
  66.488 -done
  66.489 - 
  66.490 -lemma min_number_of_Suc [simp]:
  66.491 -     "min (Suc n) (number_of v) =  
  66.492 -        (let pv = number_of (Int.pred v) in  
  66.493 -         if neg pv then 0 else Suc(min n (nat pv)))"
  66.494 -apply (simp only: Let_def neg_eq_less_0 number_of_pred nat_number_of_def 
  66.495 -            split add: split_if nat.split)
  66.496 -apply (rule_tac x = "number_of v" in spec) 
  66.497 -apply auto
  66.498 -done
  66.499 - 
  66.500 -lemma min_Suc_number_of [simp]:
  66.501 -     "min (number_of v) (Suc n) =  
  66.502 -        (let pv = number_of (Int.pred v) in  
  66.503 -         if neg pv then 0 else Suc(min (nat pv) n))"
  66.504 -apply (simp only: Let_def neg_eq_less_0 number_of_pred nat_number_of_def 
  66.505 -            split add: split_if nat.split)
  66.506 -apply (rule_tac x = "number_of v" in spec) 
  66.507 -apply auto
  66.508 -done
  66.509 +lemma max_Suc_numeral [simp]:
  66.510 +  "max (Suc n) (numeral v) = Suc (max n (nat (numeral v - 1)))"
  66.511 +  by (subst expand_Suc, simp only: max_Suc_Suc nat_numeral_diff_1)
  66.512 +
  66.513 +lemma max_numeral_Suc [simp]:
  66.514 +  "max (numeral v) (Suc n) = Suc (max (nat (numeral v - 1)) n)"
  66.515 +  by (subst expand_Suc, simp only: max_Suc_Suc nat_numeral_diff_1)
  66.516 +
  66.517 +lemma min_Suc_numeral [simp]:
  66.518 +  "min (Suc n) (numeral v) = Suc (min n (nat (numeral v - 1)))"
  66.519 +  by (subst expand_Suc, simp only: min_Suc_Suc nat_numeral_diff_1)
  66.520 +
  66.521 +lemma min_numeral_Suc [simp]:
  66.522 +  "min (numeral v) (Suc n) = Suc (min (nat (numeral v - 1)) n)"
  66.523 +  by (subst expand_Suc, simp only: min_Suc_Suc nat_numeral_diff_1)
  66.524   
  66.525  subsection{*Literal arithmetic involving powers*}
  66.526  
  66.527 -lemma power_nat_number_of:
  66.528 -     "(number_of v :: nat) ^ n =  
  66.529 -       (if neg (number_of v :: int) then 0^n else nat ((number_of v :: int) ^ n))"
  66.530 -by (simp only: simp_thms neg_nat not_neg_eq_ge_0 nat_number_of_def nat_power_eq
  66.531 -         split add: split_if cong: imp_cong)
  66.532 +(* TODO: replace with more generic rule for powers of numerals *)
  66.533 +lemma power_nat_numeral:
  66.534 +  "(numeral v :: nat) ^ n = nat ((numeral v :: int) ^ n)"
  66.535 +  by (simp only: nat_power_eq zero_le_numeral nat_numeral)
  66.536  
  66.537 -
  66.538 -lemmas power_nat_number_of_number_of = power_nat_number_of [of _ "number_of w"] for w
  66.539 -declare power_nat_number_of_number_of [simp]
  66.540 -
  66.541 +lemmas power_nat_numeral_numeral = power_nat_numeral [of _ "numeral w"] for w
  66.542 +declare power_nat_numeral_numeral [simp]
  66.543  
  66.544  
  66.545  text{*For arbitrary rings*}
  66.546  
  66.547 -lemma power_number_of_even:
  66.548 +lemma power_numeral_even:
  66.549    fixes z :: "'a::monoid_mult"
  66.550 -  shows "z ^ number_of (Int.Bit0 w) = (let w = z ^ (number_of w) in w * w)"
  66.551 -by (cases "w \<ge> 0") (auto simp add: Let_def Bit0_def nat_number_of_def number_of_is_id
  66.552 -  nat_add_distrib power_add simp del: nat_number_of)
  66.553 +  shows "z ^ numeral (Num.Bit0 w) = (let w = z ^ (numeral w) in w * w)"
  66.554 +  unfolding numeral_Bit0 power_add Let_def ..
  66.555  
  66.556 -lemma power_number_of_odd:
  66.557 +lemma power_numeral_odd:
  66.558    fixes z :: "'a::monoid_mult"
  66.559 -  shows "z ^ number_of (Int.Bit1 w) = (if (0::int) <= number_of w
  66.560 -     then (let w = z ^ (number_of w) in z * w * w) else 1)"
  66.561 -unfolding Let_def Bit1_def nat_number_of_def number_of_is_id
  66.562 -apply (cases "0 <= w")
  66.563 -apply (simp only: mult_assoc nat_add_distrib power_add, simp)
  66.564 -apply (simp add: not_le mult_2 [symmetric] add_assoc)
  66.565 -done
  66.566 +  shows "z ^ numeral (Num.Bit1 w) = (let w = z ^ (numeral w) in z * w * w)"
  66.567 +  unfolding numeral_Bit1 One_nat_def add_Suc_right add_0_right
  66.568 +  unfolding power_Suc power_add Let_def mult_assoc ..
  66.569  
  66.570 -lemmas zpower_number_of_even = power_number_of_even [where 'a=int]
  66.571 -lemmas zpower_number_of_odd = power_number_of_odd [where 'a=int]
  66.572 -
  66.573 -lemmas power_number_of_even_number_of [simp] =
  66.574 -    power_number_of_even [of "number_of v"] for v
  66.575 +lemmas zpower_numeral_even = power_numeral_even [where 'a=int]
  66.576 +lemmas zpower_numeral_odd = power_numeral_odd [where 'a=int]
  66.577  
  66.578 -lemmas power_number_of_odd_number_of [simp] =
  66.579 -    power_number_of_odd [of "number_of v"] for v
  66.580 +lemmas power_numeral_even_numeral [simp] =
  66.581 +    power_numeral_even [of "numeral v"] for v
  66.582  
  66.583 -lemma nat_number_of_Pls: "Numeral0 = (0::nat)"
  66.584 -  by (simp add: nat_number_of_def)
  66.585 -
  66.586 -lemma nat_number_of_Min [no_atp]: "number_of Int.Min = (0::nat)"
  66.587 -  apply (simp only: number_of_Min nat_number_of_def nat_zminus_int)
  66.588 -  done
  66.589 +lemmas power_numeral_odd_numeral [simp] =
  66.590 +    power_numeral_odd [of "numeral v"] for v
  66.591  
  66.592 -lemma nat_number_of_Bit0:
  66.593 -    "number_of (Int.Bit0 w) = (let n::nat = number_of w in n + n)"
  66.594 -by (cases "w \<ge> 0") (auto simp add: Let_def Bit0_def nat_number_of_def number_of_is_id
  66.595 -  nat_add_distrib simp del: nat_number_of)
  66.596 +lemma nat_numeral_Bit0:
  66.597 +  "numeral (Num.Bit0 w) = (let n::nat = numeral w in n + n)"
  66.598 +  unfolding numeral_Bit0 Let_def ..
  66.599  
  66.600 -lemma nat_number_of_Bit1:
  66.601 -  "number_of (Int.Bit1 w) =
  66.602 -    (if neg (number_of w :: int) then 0
  66.603 -     else let n = number_of w in Suc (n + n))"
  66.604 -unfolding Let_def Bit1_def nat_number_of_def number_of_is_id neg_def
  66.605 -apply (cases "w < 0")
  66.606 -apply (simp add: mult_2 [symmetric] add_assoc)
  66.607 -apply (simp only: nat_add_distrib, simp)
  66.608 -done
  66.609 +lemma nat_numeral_Bit1:
  66.610 +  "numeral (Num.Bit1 w) = (let n = numeral w in Suc (n + n))"
  66.611 +  unfolding numeral_Bit1 Let_def by simp
  66.612  
  66.613  lemmas eval_nat_numeral =
  66.614 -  nat_number_of_Bit0 nat_number_of_Bit1
  66.615 +  nat_numeral_Bit0 nat_numeral_Bit1
  66.616  
  66.617  lemmas nat_arith =
  66.618 -  add_nat_number_of
  66.619 -  diff_nat_number_of
  66.620 -  mult_nat_number_of
  66.621 -  eq_nat_number_of
  66.622 -  less_nat_number_of
  66.623 +  diff_nat_numeral
  66.624  
  66.625  lemmas semiring_norm =
  66.626 -  Let_def arith_simps nat_arith rel_simps neg_simps if_False
  66.627 -  if_True add_0 add_Suc add_number_of_left mult_number_of_left
  66.628 +  Let_def arith_simps nat_arith rel_simps
  66.629 +  if_False if_True
  66.630 +  add_0 add_Suc add_numeral_left
  66.631 +  add_neg_numeral_left mult_numeral_left
  66.632    numeral_1_eq_1 [symmetric] Suc_eq_plus1
  66.633 -  numeral_0_eq_0 [symmetric] numerals [symmetric]
  66.634 -  not_iszero_Numeral1
  66.635 +  eq_numeral_iff_iszero not_iszero_Numeral1
  66.636  
  66.637  lemma Let_Suc [simp]: "Let (Suc n) f == f (Suc n)"
  66.638    by (fact Let_def)
  66.639  
  66.640 -lemma power_m1_even: "(-1) ^ (2*n) = (1::'a::{number_ring})"
  66.641 -  by (simp only: number_of_Min power_minus1_even)
  66.642 -
  66.643 -lemma power_m1_odd: "(-1) ^ Suc(2*n) = (-1::'a::{number_ring})"
  66.644 -  by (simp only: number_of_Min power_minus1_odd)
  66.645 +lemma power_m1_even: "(-1) ^ (2*n) = (1::'a::ring_1)"
  66.646 +  by (fact power_minus1_even) (* FIXME: duplicate *)
  66.647  
  66.648 -lemma nat_number_of_add_left:
  66.649 -     "number_of v + (number_of v' + (k::nat)) =  
  66.650 -         (if neg (number_of v :: int) then number_of v' + k  
  66.651 -          else if neg (number_of v' :: int) then number_of v + k  
  66.652 -          else number_of (v + v') + k)"
  66.653 -by (auto simp add: neg_def)
  66.654 -
  66.655 -lemma nat_number_of_mult_left:
  66.656 -     "number_of v * (number_of v' * (k::nat)) =  
  66.657 -         (if v < Int.Pls then 0
  66.658 -          else number_of (v * v') * k)"
  66.659 -by (auto simp add: not_less Pls_def nat_number_of_def number_of_is_id
  66.660 -  nat_mult_distrib simp del: nat_number_of)
  66.661 +lemma power_m1_odd: "(-1) ^ Suc(2*n) = (-1::'a::ring_1)"
  66.662 +  by (fact power_minus1_odd) (* FIXME: duplicate *)
  66.663  
  66.664  
  66.665  subsection{*Literal arithmetic and @{term of_nat}*}
  66.666 @@ -784,52 +471,18 @@
  66.667       "0 \<le> x ==> of_nat (nat (2 * x)) = of_nat (nat x) + of_nat (nat x)"
  66.668  by (simp only: mult_2 nat_add_distrib of_nat_add) 
  66.669  
  66.670 -lemma nat_numeral_m1_eq_0: "-1 = (0::nat)"
  66.671 -by (simp only: nat_number_of_def)
  66.672 -
  66.673 -lemma of_nat_number_of_lemma:
  66.674 -     "of_nat (number_of v :: nat) =  
  66.675 -         (if 0 \<le> (number_of v :: int) 
  66.676 -          then (number_of v :: 'a :: number_semiring)
  66.677 -          else 0)"
  66.678 -  by (auto simp add: int_number_of_def nat_number_of_def number_of_int
  66.679 -    elim!: nonneg_int_cases)
  66.680 -
  66.681 -lemma of_nat_number_of_eq [simp]:
  66.682 -     "of_nat (number_of v :: nat) =  
  66.683 -         (if neg (number_of v :: int) then 0  
  66.684 -          else (number_of v :: 'a :: number_semiring))"
  66.685 -  by (simp only: of_nat_number_of_lemma neg_def, simp)
  66.686 -
  66.687  
  66.688  subsubsection{*For simplifying @{term "Suc m - K"} and  @{term "K - Suc m"}*}
  66.689  
  66.690  text{*Where K above is a literal*}
  66.691  
  66.692 -lemma Suc_diff_eq_diff_pred: "Numeral0 < n ==> Suc m - n = m - (n - Numeral1)"
  66.693 +lemma Suc_diff_eq_diff_pred: "0 < n ==> Suc m - n = m - (n - Numeral1)"
  66.694  by (simp split: nat_diff_split)
  66.695  
  66.696 -text {*Now just instantiating @{text n} to @{text "number_of v"} does
  66.697 -  the right simplification, but with some redundant inequality
  66.698 -  tests.*}
  66.699 -lemma neg_number_of_pred_iff_0:
  66.700 -  "neg (number_of (Int.pred v)::int) = (number_of v = (0::nat))"
  66.701 -apply (subgoal_tac "neg (number_of (Int.pred v)) = (number_of v < Suc 0) ")
  66.702 -apply (simp only: less_Suc_eq_le le_0_eq)
  66.703 -apply (subst less_number_of_Suc, simp)
  66.704 -done
  66.705 -
  66.706  text{*No longer required as a simprule because of the @{text inverse_fold}
  66.707     simproc*}
  66.708 -lemma Suc_diff_number_of:
  66.709 -     "Int.Pls < v ==>
  66.710 -      Suc m - (number_of v) = m - (number_of (Int.pred v))"
  66.711 -apply (subst Suc_diff_eq_diff_pred)
  66.712 -apply simp
  66.713 -apply (simp del: semiring_numeral_1_eq_1)
  66.714 -apply (auto simp only: diff_nat_number_of less_0_number_of [symmetric]
  66.715 -                        neg_number_of_pred_iff_0)
  66.716 -done
  66.717 +lemma Suc_diff_numeral: "Suc m - (numeral v) = m - (numeral v - 1)"
  66.718 +  by (subst expand_Suc, simp only: diff_Suc_Suc)
  66.719  
  66.720  lemma diff_Suc_eq_diff_pred: "m - Suc n = (m - 1) - n"
  66.721  by (simp split: nat_diff_split)
  66.722 @@ -837,45 +490,22 @@
  66.723  
  66.724  subsubsection{*For @{term nat_case} and @{term nat_rec}*}
  66.725  
  66.726 -lemma nat_case_number_of [simp]:
  66.727 -     "nat_case a f (number_of v) =
  66.728 -        (let pv = number_of (Int.pred v) in
  66.729 -         if neg pv then a else f (nat pv))"
  66.730 -by (simp split add: nat.split add: Let_def neg_number_of_pred_iff_0)
  66.731 +lemma nat_case_numeral [simp]:
  66.732 +  "nat_case a f (numeral v) = (let pv = nat (numeral v - 1) in f pv)"
  66.733 +  by (subst expand_Suc, simp only: nat.cases nat_numeral_diff_1 Let_def)
  66.734  
  66.735  lemma nat_case_add_eq_if [simp]:
  66.736 -     "nat_case a f ((number_of v) + n) =
  66.737 -       (let pv = number_of (Int.pred v) in
  66.738 -         if neg pv then nat_case a f n else f (nat pv + n))"
  66.739 -apply (subst add_eq_if)
  66.740 -apply (simp split add: nat.split
  66.741 -            del: semiring_numeral_1_eq_1
  66.742 -            add: semiring_numeral_1_eq_1 [symmetric]
  66.743 -                 numeral_1_eq_Suc_0 [symmetric]
  66.744 -                 neg_number_of_pred_iff_0)
  66.745 -done
  66.746 +  "nat_case a f ((numeral v) + n) = (let pv = nat (numeral v - 1) in f (pv + n))"
  66.747 +  by (subst expand_Suc, simp only: nat.cases nat_numeral_diff_1 Let_def add_Suc)
  66.748  
  66.749 -lemma nat_rec_number_of [simp]:
  66.750 -     "nat_rec a f (number_of v) =
  66.751 -        (let pv = number_of (Int.pred v) in
  66.752 -         if neg pv then a else f (nat pv) (nat_rec a f (nat pv)))"
  66.753 -apply (case_tac " (number_of v) ::nat")
  66.754 -apply (simp_all (no_asm_simp) add: Let_def neg_number_of_pred_iff_0)
  66.755 -apply (simp split add: split_if_asm)
  66.756 -done
  66.757 +lemma nat_rec_numeral [simp]:
  66.758 +  "nat_rec a f (numeral v) = (let pv = nat (numeral v - 1) in f pv (nat_rec a f pv))"
  66.759 +  by (subst expand_Suc, simp only: nat_rec_Suc nat_numeral_diff_1 Let_def)
  66.760  
  66.761  lemma nat_rec_add_eq_if [simp]:
  66.762 -     "nat_rec a f (number_of v + n) =
  66.763 -        (let pv = number_of (Int.pred v) in
  66.764 -         if neg pv then nat_rec a f n
  66.765 -                   else f (nat pv + n) (nat_rec a f (nat pv + n)))"
  66.766 -apply (subst add_eq_if)
  66.767 -apply (simp split add: nat.split
  66.768 -            del: semiring_numeral_1_eq_1
  66.769 -            add: semiring_numeral_1_eq_1 [symmetric]
  66.770 -                 numeral_1_eq_Suc_0 [symmetric]
  66.771 -