merged, resolving trivial conflict;
authorwenzelm
Mon Mar 26 10:56:56 2012 +0200 (2012-03-26)
changeset 47110f067afe98049
parent 47089 29e92b644d6c
parent 47109 db5026631799
child 47112 8493d5d0e9b6
merged, resolving trivial conflict;
src/HOL/Tools/Quotient/quotient_info.ML
src/HOL/Tools/numeral_syntax.ML
src/HOL/ex/Efficient_Nat_examples.thy
     1.1 --- a/Admin/isatest/isatest-settings	Fri Mar 23 20:32:43 2012 +0100
     1.2 +++ b/Admin/isatest/isatest-settings	Mon Mar 26 10:56:56 2012 +0200
     1.3 @@ -22,7 +22,8 @@
     1.4  bulwahn@in.tum.de \
     1.5  hoelzl@in.tum.de \
     1.6  krauss@in.tum.de \
     1.7 -noschinl@in.tum.de"
     1.8 +noschinl@in.tum.de \
     1.9 +kuncar@in.tum.de"
    1.10  
    1.11  LOGPREFIX=$HOME/log
    1.12  MASTERLOG=$LOGPREFIX/isatest.log
     2.1 --- a/Admin/isatest/pmail	Fri Mar 23 20:32:43 2012 +0100
     2.2 +++ b/Admin/isatest/pmail	Mon Mar 26 10:56:56 2012 +0200
     2.3 @@ -95,7 +95,7 @@
     2.4  
     2.5  case `uname` in
     2.6  	Linux)  for F in $@; do ATTACH="$ATTACH -a $F"; done
     2.7 -		cat "$BODY" | mail -s "$SUBJECT" $ATTACH "$TO"
     2.8 +		cat "$BODY" | mail -Ssmtp=mailbroy.informatik.tu-muenchen.de -s "$SUBJECT" $ATTACH "$TO"
     2.9  		;;
    2.10  	SunOS)
    2.11  		print_body "$SUBJECT" "$BODY" $@ | mail -t "$TO"
     3.1 --- a/NEWS	Fri Mar 23 20:32:43 2012 +0100
     3.2 +++ b/NEWS	Mon Mar 26 10:56:56 2012 +0200
     3.3 @@ -90,6 +90,30 @@
     3.4  
     3.5  *** HOL ***
     3.6  
     3.7 +* The representation of numerals has changed. We now have a datatype
     3.8 +"num" representing strictly positive binary numerals, along with
     3.9 +functions "numeral :: num => 'a" and "neg_numeral :: num => 'a" to
    3.10 +represent positive and negated numeric literals, respectively. (See
    3.11 +definitions in Num.thy.) Potential INCOMPATIBILITY; some user theories
    3.12 +may require adaptations:
    3.13 +
    3.14 +  - Theorems with number_ring or number_semiring constraints: These
    3.15 +    classes are gone; use comm_ring_1 or comm_semiring_1 instead.
    3.16 +
    3.17 +  - Theories defining numeric types: Remove number, number_semiring,
    3.18 +    and number_ring instances. Defer all theorems about numerals until
    3.19 +    after classes one and semigroup_add have been instantiated.
    3.20 +
    3.21 +  - Numeral-only simp rules: Replace each rule having a "number_of v"
    3.22 +    pattern with two copies, one for numeral and one for neg_numeral.
    3.23 +
    3.24 +  - Theorems about subclasses of semiring_1 or ring_1: These classes
    3.25 +    automatically support numerals now, so more simp rules and
    3.26 +    simprocs may now apply within the proof.
    3.27 +
    3.28 +  - Definitions and theorems using old constructors Pls/Min/Bit0/Bit1:
    3.29 +    Redefine using other integer operations.
    3.30 +
    3.31  * Type 'a set is now a proper type constructor (just as before
    3.32  Isabelle2008).  Definitions mem_def and Collect_def have disappeared.
    3.33  Non-trivial INCOMPATIBILITY.  For developments keeping predicates and
     4.1 --- a/etc/isar-keywords.el	Fri Mar 23 20:32:43 2012 +0100
     4.2 +++ b/etc/isar-keywords.el	Mon Mar 26 10:56:56 2012 +0200
     4.3 @@ -221,6 +221,7 @@
     4.4      "sect"
     4.5      "section"
     4.6      "setup"
     4.7 +    "setup_lifting"
     4.8      "show"
     4.9      "simproc_setup"
    4.10      "sledgehammer"
    4.11 @@ -518,13 +519,13 @@
    4.12      "print_translation"
    4.13      "quickcheck_generator"
    4.14      "quickcheck_params"
    4.15 -    "quotient_definition"
    4.16      "realizability"
    4.17      "realizers"
    4.18      "recdef"
    4.19      "record"
    4.20      "refute_params"
    4.21      "setup"
    4.22 +    "setup_lifting"
    4.23      "simproc_setup"
    4.24      "sledgehammer_params"
    4.25      "spark_end"
    4.26 @@ -563,6 +564,7 @@
    4.27      "nominal_inductive2"
    4.28      "nominal_primrec"
    4.29      "pcpodef"
    4.30 +    "quotient_definition"
    4.31      "quotient_type"
    4.32      "recdef_tc"
    4.33      "rep_datatype"
     5.1 --- a/src/HOL/Algebra/Group.thy	Fri Mar 23 20:32:43 2012 +0100
     5.2 +++ b/src/HOL/Algebra/Group.thy	Mon Mar 26 10:56:56 2012 +0200
     5.3 @@ -30,7 +30,7 @@
     5.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>)}"
     5.5  
     5.6  consts
     5.7 -  pow :: "[('a, 'm) monoid_scheme, 'a, 'b::number] => 'a"  (infixr "'(^')\<index>" 75)
     5.8 +  pow :: "[('a, 'm) monoid_scheme, 'a, 'b::semiring_1] => 'a"  (infixr "'(^')\<index>" 75)
     5.9  
    5.10  overloading nat_pow == "pow :: [_, 'a, nat] => 'a"
    5.11  begin
     6.1 --- a/src/HOL/Archimedean_Field.thy	Fri Mar 23 20:32:43 2012 +0100
     6.2 +++ b/src/HOL/Archimedean_Field.thy	Mon Mar 26 10:56:56 2012 +0200
     6.3 @@ -12,7 +12,7 @@
     6.4  
     6.5  text {* Archimedean fields have no infinite elements. *}
     6.6  
     6.7 -class archimedean_field = linordered_field + number_ring +
     6.8 +class archimedean_field = linordered_field +
     6.9    assumes ex_le_of_int: "\<exists>z. x \<le> of_int z"
    6.10  
    6.11  lemma ex_less_of_int:
    6.12 @@ -202,8 +202,11 @@
    6.13  lemma floor_one [simp]: "floor 1 = 1"
    6.14    using floor_of_int [of 1] by simp
    6.15  
    6.16 -lemma floor_number_of [simp]: "floor (number_of v) = number_of v"
    6.17 -  using floor_of_int [of "number_of v"] by simp
    6.18 +lemma floor_numeral [simp]: "floor (numeral v) = numeral v"
    6.19 +  using floor_of_int [of "numeral v"] by simp
    6.20 +
    6.21 +lemma floor_neg_numeral [simp]: "floor (neg_numeral v) = neg_numeral v"
    6.22 +  using floor_of_int [of "neg_numeral v"] by simp
    6.23  
    6.24  lemma zero_le_floor [simp]: "0 \<le> floor x \<longleftrightarrow> 0 \<le> x"
    6.25    by (simp add: le_floor_iff)
    6.26 @@ -211,7 +214,12 @@
    6.27  lemma one_le_floor [simp]: "1 \<le> floor x \<longleftrightarrow> 1 \<le> x"
    6.28    by (simp add: le_floor_iff)
    6.29  
    6.30 -lemma number_of_le_floor [simp]: "number_of v \<le> floor x \<longleftrightarrow> number_of v \<le> x"
    6.31 +lemma numeral_le_floor [simp]:
    6.32 +  "numeral v \<le> floor x \<longleftrightarrow> numeral v \<le> x"
    6.33 +  by (simp add: le_floor_iff)
    6.34 +
    6.35 +lemma neg_numeral_le_floor [simp]:
    6.36 +  "neg_numeral v \<le> floor x \<longleftrightarrow> neg_numeral v \<le> x"
    6.37    by (simp add: le_floor_iff)
    6.38  
    6.39  lemma zero_less_floor [simp]: "0 < floor x \<longleftrightarrow> 1 \<le> x"
    6.40 @@ -220,8 +228,12 @@
    6.41  lemma one_less_floor [simp]: "1 < floor x \<longleftrightarrow> 2 \<le> x"
    6.42    by (simp add: less_floor_iff)
    6.43  
    6.44 -lemma number_of_less_floor [simp]:
    6.45 -  "number_of v < floor x \<longleftrightarrow> number_of v + 1 \<le> x"
    6.46 +lemma numeral_less_floor [simp]:
    6.47 +  "numeral v < floor x \<longleftrightarrow> numeral v + 1 \<le> x"
    6.48 +  by (simp add: less_floor_iff)
    6.49 +
    6.50 +lemma neg_numeral_less_floor [simp]:
    6.51 +  "neg_numeral v < floor x \<longleftrightarrow> neg_numeral v + 1 \<le> x"
    6.52    by (simp add: less_floor_iff)
    6.53  
    6.54  lemma floor_le_zero [simp]: "floor x \<le> 0 \<longleftrightarrow> x < 1"
    6.55 @@ -230,8 +242,12 @@
    6.56  lemma floor_le_one [simp]: "floor x \<le> 1 \<longleftrightarrow> x < 2"
    6.57    by (simp add: floor_le_iff)
    6.58  
    6.59 -lemma floor_le_number_of [simp]:
    6.60 -  "floor x \<le> number_of v \<longleftrightarrow> x < number_of v + 1"
    6.61 +lemma floor_le_numeral [simp]:
    6.62 +  "floor x \<le> numeral v \<longleftrightarrow> x < numeral v + 1"
    6.63 +  by (simp add: floor_le_iff)
    6.64 +
    6.65 +lemma floor_le_neg_numeral [simp]:
    6.66 +  "floor x \<le> neg_numeral v \<longleftrightarrow> x < neg_numeral v + 1"
    6.67    by (simp add: floor_le_iff)
    6.68  
    6.69  lemma floor_less_zero [simp]: "floor x < 0 \<longleftrightarrow> x < 0"
    6.70 @@ -240,8 +256,12 @@
    6.71  lemma floor_less_one [simp]: "floor x < 1 \<longleftrightarrow> x < 1"
    6.72    by (simp add: floor_less_iff)
    6.73  
    6.74 -lemma floor_less_number_of [simp]:
    6.75 -  "floor x < number_of v \<longleftrightarrow> x < number_of v"
    6.76 +lemma floor_less_numeral [simp]:
    6.77 +  "floor x < numeral v \<longleftrightarrow> x < numeral v"
    6.78 +  by (simp add: floor_less_iff)
    6.79 +
    6.80 +lemma floor_less_neg_numeral [simp]:
    6.81 +  "floor x < neg_numeral v \<longleftrightarrow> x < neg_numeral v"
    6.82    by (simp add: floor_less_iff)
    6.83  
    6.84  text {* Addition and subtraction of integers *}
    6.85 @@ -249,9 +269,13 @@
    6.86  lemma floor_add_of_int [simp]: "floor (x + of_int z) = floor x + z"
    6.87    using floor_correct [of x] by (simp add: floor_unique)
    6.88  
    6.89 -lemma floor_add_number_of [simp]:
    6.90 -    "floor (x + number_of v) = floor x + number_of v"
    6.91 -  using floor_add_of_int [of x "number_of v"] by simp
    6.92 +lemma floor_add_numeral [simp]:
    6.93 +    "floor (x + numeral v) = floor x + numeral v"
    6.94 +  using floor_add_of_int [of x "numeral v"] by simp
    6.95 +
    6.96 +lemma floor_add_neg_numeral [simp]:
    6.97 +    "floor (x + neg_numeral v) = floor x + neg_numeral v"
    6.98 +  using floor_add_of_int [of x "neg_numeral v"] by simp
    6.99  
   6.100  lemma floor_add_one [simp]: "floor (x + 1) = floor x + 1"
   6.101    using floor_add_of_int [of x 1] by simp
   6.102 @@ -259,9 +283,13 @@
   6.103  lemma floor_diff_of_int [simp]: "floor (x - of_int z) = floor x - z"
   6.104    using floor_add_of_int [of x "- z"] by (simp add: algebra_simps)
   6.105  
   6.106 -lemma floor_diff_number_of [simp]:
   6.107 -  "floor (x - number_of v) = floor x - number_of v"
   6.108 -  using floor_diff_of_int [of x "number_of v"] by simp
   6.109 +lemma floor_diff_numeral [simp]:
   6.110 +  "floor (x - numeral v) = floor x - numeral v"
   6.111 +  using floor_diff_of_int [of x "numeral v"] by simp
   6.112 +
   6.113 +lemma floor_diff_neg_numeral [simp]:
   6.114 +  "floor (x - neg_numeral v) = floor x - neg_numeral v"
   6.115 +  using floor_diff_of_int [of x "neg_numeral v"] by simp
   6.116  
   6.117  lemma floor_diff_one [simp]: "floor (x - 1) = floor x - 1"
   6.118    using floor_diff_of_int [of x 1] by simp
   6.119 @@ -320,8 +348,11 @@
   6.120  lemma ceiling_one [simp]: "ceiling 1 = 1"
   6.121    using ceiling_of_int [of 1] by simp
   6.122  
   6.123 -lemma ceiling_number_of [simp]: "ceiling (number_of v) = number_of v"
   6.124 -  using ceiling_of_int [of "number_of v"] by simp
   6.125 +lemma ceiling_numeral [simp]: "ceiling (numeral v) = numeral v"
   6.126 +  using ceiling_of_int [of "numeral v"] by simp
   6.127 +
   6.128 +lemma ceiling_neg_numeral [simp]: "ceiling (neg_numeral v) = neg_numeral v"
   6.129 +  using ceiling_of_int [of "neg_numeral v"] by simp
   6.130  
   6.131  lemma ceiling_le_zero [simp]: "ceiling x \<le> 0 \<longleftrightarrow> x \<le> 0"
   6.132    by (simp add: ceiling_le_iff)
   6.133 @@ -329,8 +360,12 @@
   6.134  lemma ceiling_le_one [simp]: "ceiling x \<le> 1 \<longleftrightarrow> x \<le> 1"
   6.135    by (simp add: ceiling_le_iff)
   6.136  
   6.137 -lemma ceiling_le_number_of [simp]:
   6.138 -  "ceiling x \<le> number_of v \<longleftrightarrow> x \<le> number_of v"
   6.139 +lemma ceiling_le_numeral [simp]:
   6.140 +  "ceiling x \<le> numeral v \<longleftrightarrow> x \<le> numeral v"
   6.141 +  by (simp add: ceiling_le_iff)
   6.142 +
   6.143 +lemma ceiling_le_neg_numeral [simp]:
   6.144 +  "ceiling x \<le> neg_numeral v \<longleftrightarrow> x \<le> neg_numeral v"
   6.145    by (simp add: ceiling_le_iff)
   6.146  
   6.147  lemma ceiling_less_zero [simp]: "ceiling x < 0 \<longleftrightarrow> x \<le> -1"
   6.148 @@ -339,8 +374,12 @@
   6.149  lemma ceiling_less_one [simp]: "ceiling x < 1 \<longleftrightarrow> x \<le> 0"
   6.150    by (simp add: ceiling_less_iff)
   6.151  
   6.152 -lemma ceiling_less_number_of [simp]:
   6.153 -  "ceiling x < number_of v \<longleftrightarrow> x \<le> number_of v - 1"
   6.154 +lemma ceiling_less_numeral [simp]:
   6.155 +  "ceiling x < numeral v \<longleftrightarrow> x \<le> numeral v - 1"
   6.156 +  by (simp add: ceiling_less_iff)
   6.157 +
   6.158 +lemma ceiling_less_neg_numeral [simp]:
   6.159 +  "ceiling x < neg_numeral v \<longleftrightarrow> x \<le> neg_numeral v - 1"
   6.160    by (simp add: ceiling_less_iff)
   6.161  
   6.162  lemma zero_le_ceiling [simp]: "0 \<le> ceiling x \<longleftrightarrow> -1 < x"
   6.163 @@ -349,8 +388,12 @@
   6.164  lemma one_le_ceiling [simp]: "1 \<le> ceiling x \<longleftrightarrow> 0 < x"
   6.165    by (simp add: le_ceiling_iff)
   6.166  
   6.167 -lemma number_of_le_ceiling [simp]:
   6.168 -  "number_of v \<le> ceiling x\<longleftrightarrow> number_of v - 1 < x"
   6.169 +lemma numeral_le_ceiling [simp]:
   6.170 +  "numeral v \<le> ceiling x \<longleftrightarrow> numeral v - 1 < x"
   6.171 +  by (simp add: le_ceiling_iff)
   6.172 +
   6.173 +lemma neg_numeral_le_ceiling [simp]:
   6.174 +  "neg_numeral v \<le> ceiling x \<longleftrightarrow> neg_numeral v - 1 < x"
   6.175    by (simp add: le_ceiling_iff)
   6.176  
   6.177  lemma zero_less_ceiling [simp]: "0 < ceiling x \<longleftrightarrow> 0 < x"
   6.178 @@ -359,8 +402,12 @@
   6.179  lemma one_less_ceiling [simp]: "1 < ceiling x \<longleftrightarrow> 1 < x"
   6.180    by (simp add: less_ceiling_iff)
   6.181  
   6.182 -lemma number_of_less_ceiling [simp]:
   6.183 -  "number_of v < ceiling x \<longleftrightarrow> number_of v < x"
   6.184 +lemma numeral_less_ceiling [simp]:
   6.185 +  "numeral v < ceiling x \<longleftrightarrow> numeral v < x"
   6.186 +  by (simp add: less_ceiling_iff)
   6.187 +
   6.188 +lemma neg_numeral_less_ceiling [simp]:
   6.189 +  "neg_numeral v < ceiling x \<longleftrightarrow> neg_numeral v < x"
   6.190    by (simp add: less_ceiling_iff)
   6.191  
   6.192  text {* Addition and subtraction of integers *}
   6.193 @@ -368,9 +415,13 @@
   6.194  lemma ceiling_add_of_int [simp]: "ceiling (x + of_int z) = ceiling x + z"
   6.195    using ceiling_correct [of x] by (simp add: ceiling_unique)
   6.196  
   6.197 -lemma ceiling_add_number_of [simp]:
   6.198 -    "ceiling (x + number_of v) = ceiling x + number_of v"
   6.199 -  using ceiling_add_of_int [of x "number_of v"] by simp
   6.200 +lemma ceiling_add_numeral [simp]:
   6.201 +    "ceiling (x + numeral v) = ceiling x + numeral v"
   6.202 +  using ceiling_add_of_int [of x "numeral v"] by simp
   6.203 +
   6.204 +lemma ceiling_add_neg_numeral [simp]:
   6.205 +    "ceiling (x + neg_numeral v) = ceiling x + neg_numeral v"
   6.206 +  using ceiling_add_of_int [of x "neg_numeral v"] by simp
   6.207  
   6.208  lemma ceiling_add_one [simp]: "ceiling (x + 1) = ceiling x + 1"
   6.209    using ceiling_add_of_int [of x 1] by simp
   6.210 @@ -378,9 +429,13 @@
   6.211  lemma ceiling_diff_of_int [simp]: "ceiling (x - of_int z) = ceiling x - z"
   6.212    using ceiling_add_of_int [of x "- z"] by (simp add: algebra_simps)
   6.213  
   6.214 -lemma ceiling_diff_number_of [simp]:
   6.215 -  "ceiling (x - number_of v) = ceiling x - number_of v"
   6.216 -  using ceiling_diff_of_int [of x "number_of v"] by simp
   6.217 +lemma ceiling_diff_numeral [simp]:
   6.218 +  "ceiling (x - numeral v) = ceiling x - numeral v"
   6.219 +  using ceiling_diff_of_int [of x "numeral v"] by simp
   6.220 +
   6.221 +lemma ceiling_diff_neg_numeral [simp]:
   6.222 +  "ceiling (x - neg_numeral v) = ceiling x - neg_numeral v"
   6.223 +  using ceiling_diff_of_int [of x "neg_numeral v"] by simp
   6.224  
   6.225  lemma ceiling_diff_one [simp]: "ceiling (x - 1) = ceiling x - 1"
   6.226    using ceiling_diff_of_int [of x 1] by simp
     7.1 --- a/src/HOL/Code_Evaluation.thy	Fri Mar 23 20:32:43 2012 +0100
     7.2 +++ b/src/HOL/Code_Evaluation.thy	Mon Mar 26 10:56:56 2012 +0200
     7.3 @@ -146,33 +146,29 @@
     7.4    "term_of_num_semiring two = (\<lambda>_. dummy_term)"
     7.5  
     7.6  lemma (in term_syntax) term_of_num_semiring_code [code]:
     7.7 -  "term_of_num_semiring two k = (if k = 0 then termify Int.Pls
     7.8 +  "term_of_num_semiring two k = (
     7.9 +    if k = 1 then termify Num.One
    7.10      else (if k mod two = 0
    7.11 -      then termify Int.Bit0 <\<cdot>> term_of_num_semiring two (k div two)
    7.12 -      else termify Int.Bit1 <\<cdot>> term_of_num_semiring two (k div two)))"
    7.13 -  by (auto simp add: term_of_anything Const_def App_def term_of_num_semiring_def Let_def)
    7.14 +      then termify Num.Bit0 <\<cdot>> term_of_num_semiring two (k div two)
    7.15 +      else termify Num.Bit1 <\<cdot>> term_of_num_semiring two (k div two)))"
    7.16 +  by (auto simp add: term_of_anything Const_def App_def term_of_num_semiring_def)
    7.17  
    7.18  lemma (in term_syntax) term_of_nat_code [code]:
    7.19 -  "term_of (n::nat) = termify (number_of :: int \<Rightarrow> nat) <\<cdot>> term_of_num_semiring (2::nat) n"
    7.20 +  "term_of (n::nat) = (
    7.21 +    if n = 0 then termify (0 :: nat)
    7.22 +    else termify (numeral :: num \<Rightarrow> nat) <\<cdot>> term_of_num_semiring (2::nat) n)"
    7.23    by (simp only: term_of_anything)
    7.24  
    7.25  lemma (in term_syntax) term_of_code_numeral_code [code]:
    7.26 -  "term_of (k::code_numeral) = termify (number_of :: int \<Rightarrow> code_numeral) <\<cdot>> term_of_num_semiring (2::code_numeral) k"
    7.27 +  "term_of (k::code_numeral) = (
    7.28 +    if k = 0 then termify (0 :: code_numeral)
    7.29 +    else termify (numeral :: num \<Rightarrow> code_numeral) <\<cdot>> term_of_num_semiring (2::code_numeral) k)"
    7.30    by (simp only: term_of_anything)
    7.31  
    7.32 -definition term_of_num_ring :: "'a\<Colon>ring_div \<Rightarrow> 'a \<Rightarrow> term" where
    7.33 -  "term_of_num_ring two = (\<lambda>_. dummy_term)"
    7.34 -
    7.35 -lemma (in term_syntax) term_of_num_ring_code [code]:
    7.36 -  "term_of_num_ring two k = (if k = 0 then termify Int.Pls
    7.37 -    else if k = -1 then termify Int.Min
    7.38 -    else if k mod two = 0 then termify Int.Bit0 <\<cdot>> term_of_num_ring two (k div two)
    7.39 -    else termify Int.Bit1 <\<cdot>> term_of_num_ring two (k div two))"
    7.40 -  by (auto simp add: term_of_anything Const_def App_def term_of_num_ring_def Let_def)
    7.41 -
    7.42  lemma (in term_syntax) term_of_int_code [code]:
    7.43    "term_of (k::int) = (if k = 0 then termify (0 :: int)
    7.44 -    else termify (number_of :: int \<Rightarrow> int) <\<cdot>> term_of_num_ring (2::int) k)"
    7.45 +    else if k < 0 then termify (neg_numeral :: num \<Rightarrow> int) <\<cdot>> term_of_num_semiring (2::int) (- k)
    7.46 +    else termify (numeral :: num \<Rightarrow> int) <\<cdot>> term_of_num_semiring (2::int) k)"
    7.47    by (simp only: term_of_anything)
    7.48  
    7.49  
    7.50 @@ -201,6 +197,6 @@
    7.51  
    7.52  
    7.53  hide_const dummy_term valapp
    7.54 -hide_const (open) Const App Abs Free termify valtermify term_of term_of_num_semiring term_of_num_ring tracing
    7.55 +hide_const (open) Const App Abs Free termify valtermify term_of term_of_num_semiring tracing
    7.56  
    7.57  end
     8.1 --- a/src/HOL/Code_Numeral.thy	Fri Mar 23 20:32:43 2012 +0100
     8.2 +++ b/src/HOL/Code_Numeral.thy	Mon Mar 26 10:56:56 2012 +0200
     8.3 @@ -123,25 +123,6 @@
     8.4    by (rule equal_refl)
     8.5  
     8.6  
     8.7 -subsection {* Code numerals as datatype of ints *}
     8.8 -
     8.9 -instantiation code_numeral :: number
    8.10 -begin
    8.11 -
    8.12 -definition
    8.13 -  "number_of = of_nat o nat"
    8.14 -
    8.15 -instance ..
    8.16 -
    8.17 -end
    8.18 -
    8.19 -lemma nat_of_number [simp]:
    8.20 -  "nat_of (number_of k) = number_of k"
    8.21 -  by (simp add: number_of_code_numeral_def nat_number_of_def number_of_is_id)
    8.22 -
    8.23 -code_datatype "number_of \<Colon> int \<Rightarrow> code_numeral"
    8.24 -
    8.25 -
    8.26  subsection {* Basic arithmetic *}
    8.27  
    8.28  instantiation code_numeral :: "{minus, linordered_semidom, semiring_div, linorder}"
    8.29 @@ -176,16 +157,17 @@
    8.30  
    8.31  end
    8.32  
    8.33 -lemma zero_code_numeral_code [code]:
    8.34 -  "(0\<Colon>code_numeral) = Numeral0"
    8.35 -  by (simp add: number_of_code_numeral_def Pls_def)
    8.36 +lemma nat_of_numeral [simp]: "nat_of (numeral k) = numeral k"
    8.37 +  by (induct k rule: num_induct) (simp_all add: numeral_inc)
    8.38  
    8.39 -lemma [code_abbrev]: "Numeral0 = (0\<Colon>code_numeral)"
    8.40 -  using zero_code_numeral_code ..
    8.41 +definition Num :: "num \<Rightarrow> code_numeral"
    8.42 +  where [simp, code_abbrev]: "Num = numeral"
    8.43 +
    8.44 +code_datatype "0::code_numeral" Num
    8.45  
    8.46  lemma one_code_numeral_code [code]:
    8.47    "(1\<Colon>code_numeral) = Numeral1"
    8.48 -  by (simp add: number_of_code_numeral_def Pls_def Bit1_def)
    8.49 +  by simp
    8.50  
    8.51  lemma [code_abbrev]: "Numeral1 = (1\<Colon>code_numeral)"
    8.52    using one_code_numeral_code ..
    8.53 @@ -194,15 +176,8 @@
    8.54    "of_nat n + of_nat m = of_nat (n + m)"
    8.55    by simp
    8.56  
    8.57 -definition subtract :: "code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral" where
    8.58 -  [simp]: "subtract = minus"
    8.59 -
    8.60 -lemma subtract_code [code nbe]:
    8.61 -  "subtract (of_nat n) (of_nat m) = of_nat (n - m)"
    8.62 -  by simp
    8.63 -
    8.64 -lemma minus_code_numeral_code [code]:
    8.65 -  "minus = subtract"
    8.66 +lemma minus_code_numeral_code [code nbe]:
    8.67 +  "of_nat n - of_nat m = of_nat (n - m)"
    8.68    by simp
    8.69  
    8.70  lemma times_code_numeral_code [code nbe]:
    8.71 @@ -281,7 +256,7 @@
    8.72  qed
    8.73  
    8.74  
    8.75 -hide_const (open) of_nat nat_of Suc subtract int_of
    8.76 +hide_const (open) of_nat nat_of Suc int_of
    8.77  
    8.78  
    8.79  subsection {* Code generator setup *}
    8.80 @@ -298,15 +273,21 @@
    8.81    (Haskell -)
    8.82  
    8.83  setup {*
    8.84 -  Numeral.add_code @{const_name number_code_numeral_inst.number_of_code_numeral}
    8.85 +  Numeral.add_code @{const_name Num}
    8.86      false Code_Printer.literal_naive_numeral "SML"
    8.87 -  #> fold (Numeral.add_code @{const_name number_code_numeral_inst.number_of_code_numeral}
    8.88 +  #> fold (Numeral.add_code @{const_name Num}
    8.89      false Code_Printer.literal_numeral) ["OCaml", "Haskell", "Scala"]
    8.90  *}
    8.91  
    8.92  code_reserved SML Int int
    8.93  code_reserved Eval Integer
    8.94  
    8.95 +code_const "0::code_numeral"
    8.96 +  (SML "0")
    8.97 +  (OCaml "Big'_int.zero'_big'_int")
    8.98 +  (Haskell "0")
    8.99 +  (Scala "BigInt(0)")
   8.100 +
   8.101  code_const "plus \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral"
   8.102    (SML "Int.+/ ((_),/ (_))")
   8.103    (OCaml "Big'_int.add'_big'_int")
   8.104 @@ -314,12 +295,12 @@
   8.105    (Scala infixl 7 "+")
   8.106    (Eval infixl 8 "+")
   8.107  
   8.108 -code_const "Code_Numeral.subtract \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral"
   8.109 -  (SML "Int.max/ (_/ -/ _,/ 0 : int)")
   8.110 -  (OCaml "Big'_int.max'_big'_int/ (Big'_int.sub'_big'_int/ _/ _)/ Big'_int.zero'_big'_int")
   8.111 -  (Haskell "max/ (_/ -/ _)/ (0 :: Integer)")
   8.112 +code_const "minus \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral"
   8.113 +  (SML "Int.max/ (0 : int,/ Int.-/ ((_),/ (_)))")
   8.114 +  (OCaml "Big'_int.max'_big'_int/ Big'_int.zero'_big'_int/ (Big'_int.sub'_big'_int/ _/ _)")
   8.115 +  (Haskell "max/ (0 :: Integer)/ (_/ -/ _)")
   8.116    (Scala "!(_/ -/ _).max(0)")
   8.117 -  (Eval "Integer.max/ (_/ -/ _)/ 0")
   8.118 +  (Eval "Integer.max/ 0/ (_/ -/ _)")
   8.119  
   8.120  code_const "times \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral"
   8.121    (SML "Int.*/ ((_),/ (_))")
     9.1 --- a/src/HOL/Codegenerator_Test/Generate_Pretty.thy	Fri Mar 23 20:32:43 2012 +0100
     9.2 +++ b/src/HOL/Codegenerator_Test/Generate_Pretty.thy	Mon Mar 26 10:56:56 2012 +0200
     9.3 @@ -10,9 +10,8 @@
     9.4  lemma [code, code del]: "nat_of_char = nat_of_char" ..
     9.5  lemma [code, code del]: "char_of_nat = char_of_nat" ..
     9.6  
     9.7 -declare Quickcheck_Narrowing.zero_code_int_code[code del]
     9.8 -declare Quickcheck_Narrowing.one_code_int_code[code del]
     9.9 -declare Quickcheck_Narrowing.int_of_code[code del]
    9.10 +declare Quickcheck_Narrowing.one_code_int_code [code del]
    9.11 +declare Quickcheck_Narrowing.int_of_code [code del]
    9.12  
    9.13  subsection {* Check whether generated code compiles *}
    9.14  
    10.1 --- a/src/HOL/Complex.thy	Fri Mar 23 20:32:43 2012 +0100
    10.2 +++ b/src/HOL/Complex.thy	Mon Mar 26 10:56:56 2012 +0200
    10.3 @@ -151,17 +151,6 @@
    10.4  
    10.5  subsection {* Numerals and Arithmetic *}
    10.6  
    10.7 -instantiation complex :: number_ring
    10.8 -begin
    10.9 -
   10.10 -definition complex_number_of_def:
   10.11 -  "number_of w = (of_int w \<Colon> complex)"
   10.12 -
   10.13 -instance
   10.14 -  by intro_classes (simp only: complex_number_of_def)
   10.15 -
   10.16 -end
   10.17 -
   10.18  lemma complex_Re_of_nat [simp]: "Re (of_nat n) = of_nat n"
   10.19    by (induct n) simp_all
   10.20  
   10.21 @@ -174,14 +163,24 @@
   10.22  lemma complex_Im_of_int [simp]: "Im (of_int z) = 0"
   10.23    by (cases z rule: int_diff_cases) simp
   10.24  
   10.25 -lemma complex_Re_number_of [simp]: "Re (number_of v) = number_of v"
   10.26 -  unfolding number_of_eq by (rule complex_Re_of_int)
   10.27 +lemma complex_Re_numeral [simp]: "Re (numeral v) = numeral v"
   10.28 +  using complex_Re_of_int [of "numeral v"] by simp
   10.29 +
   10.30 +lemma complex_Re_neg_numeral [simp]: "Re (neg_numeral v) = neg_numeral v"
   10.31 +  using complex_Re_of_int [of "neg_numeral v"] by simp
   10.32 +
   10.33 +lemma complex_Im_numeral [simp]: "Im (numeral v) = 0"
   10.34 +  using complex_Im_of_int [of "numeral v"] by simp
   10.35  
   10.36 -lemma complex_Im_number_of [simp]: "Im (number_of v) = 0"
   10.37 -  unfolding number_of_eq by (rule complex_Im_of_int)
   10.38 +lemma complex_Im_neg_numeral [simp]: "Im (neg_numeral v) = 0"
   10.39 +  using complex_Im_of_int [of "neg_numeral v"] by simp
   10.40  
   10.41 -lemma Complex_eq_number_of [simp]:
   10.42 -  "(Complex a b = number_of w) = (a = number_of w \<and> b = 0)"
   10.43 +lemma Complex_eq_numeral [simp]:
   10.44 +  "(Complex a b = numeral w) = (a = numeral w \<and> b = 0)"
   10.45 +  by (simp add: complex_eq_iff)
   10.46 +
   10.47 +lemma Complex_eq_neg_numeral [simp]:
   10.48 +  "(Complex a b = neg_numeral w) = (a = neg_numeral w \<and> b = 0)"
   10.49    by (simp add: complex_eq_iff)
   10.50  
   10.51  
   10.52 @@ -421,7 +420,10 @@
   10.53  lemma complex_i_not_one [simp]: "ii \<noteq> 1"
   10.54    by (simp add: complex_eq_iff)
   10.55  
   10.56 -lemma complex_i_not_number_of [simp]: "ii \<noteq> number_of w"
   10.57 +lemma complex_i_not_numeral [simp]: "ii \<noteq> numeral w"
   10.58 +  by (simp add: complex_eq_iff)
   10.59 +
   10.60 +lemma complex_i_not_neg_numeral [simp]: "ii \<noteq> neg_numeral w"
   10.61    by (simp add: complex_eq_iff)
   10.62  
   10.63  lemma i_mult_Complex [simp]: "ii * Complex a b = Complex (- b) a"
   10.64 @@ -505,7 +507,10 @@
   10.65  lemma complex_cnj_of_int [simp]: "cnj (of_int z) = of_int z"
   10.66    by (simp add: complex_eq_iff)
   10.67  
   10.68 -lemma complex_cnj_number_of [simp]: "cnj (number_of w) = number_of w"
   10.69 +lemma complex_cnj_numeral [simp]: "cnj (numeral w) = numeral w"
   10.70 +  by (simp add: complex_eq_iff)
   10.71 +
   10.72 +lemma complex_cnj_neg_numeral [simp]: "cnj (neg_numeral w) = neg_numeral w"
   10.73    by (simp add: complex_eq_iff)
   10.74  
   10.75  lemma complex_cnj_scaleR: "cnj (scaleR r x) = scaleR r (cnj x)"
   10.76 @@ -686,10 +691,10 @@
   10.77    "(of_nat n :: 'a::linordered_idom) < of_int x \<longleftrightarrow> int n < x"
   10.78    by (metis of_int_of_nat_eq of_int_less_iff)
   10.79  
   10.80 -lemma real_of_nat_less_number_of_iff [simp]: (* TODO: move *)
   10.81 -  "real (n::nat) < number_of w \<longleftrightarrow> n < number_of w"
   10.82 -  unfolding real_of_nat_def nat_number_of_def number_of_eq
   10.83 -  by (simp add: of_nat_less_of_int_iff zless_nat_eq_int_zless)
   10.84 +lemma real_of_nat_less_numeral_iff [simp]: (* TODO: move *)
   10.85 +  "real (n::nat) < numeral w \<longleftrightarrow> n < numeral w"
   10.86 +  using of_nat_less_of_int_iff [of n "numeral w", where 'a=real]
   10.87 +  by (simp add: real_of_nat_def zless_nat_eq_int_zless [symmetric])
   10.88  
   10.89  lemma arg_unique:
   10.90    assumes "sgn z = cis x" and "-pi < x" and "x \<le> pi"
    11.1 --- a/src/HOL/Decision_Procs/Approximation.thy	Fri Mar 23 20:32:43 2012 +0100
    11.2 +++ b/src/HOL/Decision_Procs/Approximation.thy	Mon Mar 26 10:56:56 2012 +0200
    11.3 @@ -1350,7 +1350,7 @@
    11.4        also have "\<dots> \<le> cos ((?ux - 2 * ?lpi))"
    11.5          using cos_monotone_minus_pi_0'[OF pi_x x_le_ux ux_0]
    11.6          by (simp only: real_of_float_minus real_of_int_minus real_of_one
    11.7 -            number_of_Min diff_minus mult_minus_left mult_1_left)
    11.8 +            minus_one [symmetric] diff_minus mult_minus_left mult_1_left)
    11.9        also have "\<dots> = cos ((- (?ux - 2 * ?lpi)))"
   11.10          unfolding real_of_float_minus cos_minus ..
   11.11        also have "\<dots> \<le> (ub_cos prec (- (?ux - 2 * ?lpi)))"
   11.12 @@ -1394,7 +1394,7 @@
   11.13        also have "\<dots> \<le> cos ((?lx + 2 * ?lpi))"
   11.14          using cos_monotone_0_pi'[OF lx_0 lx_le_x pi_x]
   11.15          by (simp only: real_of_float_minus real_of_int_minus real_of_one
   11.16 -          number_of_Min diff_minus mult_minus_left mult_1_left)
   11.17 +          minus_one [symmetric] diff_minus mult_minus_left mult_1_left)
   11.18        also have "\<dots> \<le> (ub_cos prec (?lx + 2 * ?lpi))"
   11.19          using lb_cos[OF lx_0 pi_lx] by simp
   11.20        finally show ?thesis unfolding u by (simp add: real_of_float_max)
   11.21 @@ -2117,7 +2117,8 @@
   11.22  lemma interpret_floatarith_num:
   11.23    shows "interpret_floatarith (Num (Float 0 0)) vs = 0"
   11.24    and "interpret_floatarith (Num (Float 1 0)) vs = 1"
   11.25 -  and "interpret_floatarith (Num (Float (number_of a) 0)) vs = number_of a" by auto
   11.26 +  and "interpret_floatarith (Num (Float (numeral a) 0)) vs = numeral a"
   11.27 +  and "interpret_floatarith (Num (Float (neg_numeral a) 0)) vs = neg_numeral a" by auto
   11.28  
   11.29  subsection "Implement approximation function"
   11.30  
    12.1 --- a/src/HOL/Decision_Procs/Cooper.thy	Fri Mar 23 20:32:43 2012 +0100
    12.2 +++ b/src/HOL/Decision_Procs/Cooper.thy	Mon Mar 26 10:56:56 2012 +0200
    12.3 @@ -1883,7 +1883,8 @@
    12.4        | SOME n => @{code Bound} n)
    12.5    | num_of_term vs @{term "0::int"} = @{code C} 0
    12.6    | num_of_term vs @{term "1::int"} = @{code C} 1
    12.7 -  | num_of_term vs (@{term "number_of :: int \<Rightarrow> int"} $ t) = @{code C} (HOLogic.dest_numeral t)
    12.8 +  | num_of_term vs (@{term "numeral :: _ \<Rightarrow> int"} $ t) = @{code C} (HOLogic.dest_num t)
    12.9 +  | num_of_term vs (@{term "neg_numeral :: _ \<Rightarrow> int"} $ t) = @{code C} (~(HOLogic.dest_num t))
   12.10    | num_of_term vs (Bound i) = @{code Bound} i
   12.11    | num_of_term vs (@{term "uminus :: int \<Rightarrow> int"} $ t') = @{code Neg} (num_of_term vs t')
   12.12    | num_of_term vs (@{term "op + :: int \<Rightarrow> int \<Rightarrow> int"} $ t1 $ t2) =
    13.1 --- a/src/HOL/Decision_Procs/Dense_Linear_Order.thy	Fri Mar 23 20:32:43 2012 +0100
    13.2 +++ b/src/HOL/Decision_Procs/Dense_Linear_Order.thy	Mon Mar 26 10:56:56 2012 +0200
    13.3 @@ -636,14 +636,8 @@
    13.4  
    13.5  interpretation class_dense_linordered_field: constr_dense_linorder
    13.6   "op <=" "op <"
    13.7 -   "\<lambda> x y. 1/2 * ((x::'a::{linordered_field,number_ring}) + y)"
    13.8 -proof (unfold_locales, dlo, dlo, auto)
    13.9 -  fix x y::'a assume lt: "x < y"
   13.10 -  from  less_half_sum[OF lt] show "x < (x + y) /2" by simp
   13.11 -next
   13.12 -  fix x y::'a assume lt: "x < y"
   13.13 -  from  gt_half_sum[OF lt] show "(x + y) /2 < y" by simp
   13.14 -qed
   13.15 +   "\<lambda> x y. 1/2 * ((x::'a::{linordered_field}) + y)"
   13.16 +by (unfold_locales, dlo, dlo, auto)
   13.17  
   13.18  declaration{*
   13.19  let
    14.1 --- a/src/HOL/Decision_Procs/Ferrack.thy	Fri Mar 23 20:32:43 2012 +0100
    14.2 +++ b/src/HOL/Decision_Procs/Ferrack.thy	Mon Mar 26 10:56:56 2012 +0200
    14.3 @@ -1732,7 +1732,7 @@
    14.4           (set U \<times> set U)"using mnz nnz th  
    14.5      apply (auto simp add: th add_divide_distrib algebra_simps split_def image_def)
    14.6      by (rule_tac x="(s,m)" in bexI,simp_all) 
    14.7 -  (rule_tac x="(t,n)" in bexI,simp_all)
    14.8 +  (rule_tac x="(t,n)" in bexI,simp_all add: mult_commute)
    14.9  next
   14.10    fix t n s m
   14.11    assume tnU: "(t,n) \<in> set U" and smU:"(s,m) \<in> set U" 
   14.12 @@ -1937,11 +1937,12 @@
   14.13    | num_of_term vs (@{term "op * :: real \<Rightarrow> real \<Rightarrow> real"} $ t1 $ t2) = (case num_of_term vs t1
   14.14       of @{code C} i => @{code Mul} (i, num_of_term vs t2)
   14.15        | _ => error "num_of_term: unsupported multiplication")
   14.16 -  | num_of_term vs (@{term "real :: int \<Rightarrow> real"} $ (@{term "number_of :: int \<Rightarrow> int"} $ t')) =
   14.17 -     @{code C} (HOLogic.dest_numeral t')
   14.18 -  | num_of_term vs (@{term "number_of :: int \<Rightarrow> real"} $ t') =
   14.19 -     @{code C} (HOLogic.dest_numeral t')
   14.20 -  | num_of_term vs t = error ("num_of_term: unknown term");
   14.21 +  | num_of_term vs (@{term "real :: int \<Rightarrow> real"} $ t') =
   14.22 +     (@{code C} (snd (HOLogic.dest_number t'))
   14.23 +       handle TERM _ => error ("num_of_term: unknown term"))
   14.24 +  | num_of_term vs t' =
   14.25 +     (@{code C} (snd (HOLogic.dest_number t'))
   14.26 +       handle TERM _ => error ("num_of_term: unknown term"));
   14.27  
   14.28  fun fm_of_term vs @{term True} = @{code T}
   14.29    | fm_of_term vs @{term False} = @{code F}
    15.1 --- a/src/HOL/Decision_Procs/MIR.thy	Fri Mar 23 20:32:43 2012 +0100
    15.2 +++ b/src/HOL/Decision_Procs/MIR.thy	Mon Mar 26 10:56:56 2012 +0200
    15.3 @@ -4901,7 +4901,7 @@
    15.4           (set U \<times> set U)"using mnz nnz th  
    15.5      apply (auto simp add: th add_divide_distrib algebra_simps split_def image_def)
    15.6      by (rule_tac x="(s,m)" in bexI,simp_all) 
    15.7 -  (rule_tac x="(t,n)" in bexI,simp_all)
    15.8 +  (rule_tac x="(t,n)" in bexI,simp_all add: mult_commute)
    15.9  next
   15.10    fix t n s m
   15.11    assume tnU: "(t,n) \<in> set U" and smU:"(s,m) \<in> set U" 
   15.12 @@ -5536,14 +5536,18 @@
   15.13        (case (num_of_term vs t1)
   15.14         of @{code C} i => @{code Mul} (i, num_of_term vs t2)
   15.15          | _ => error "num_of_term: unsupported Multiplication")
   15.16 -  | num_of_term vs (@{term "real :: int \<Rightarrow> real"} $ (@{term "number_of :: int \<Rightarrow> int"} $ t')) =
   15.17 -      @{code C} (HOLogic.dest_numeral t')
   15.18 +  | num_of_term vs (@{term "real :: int \<Rightarrow> real"} $ (@{term "numeral :: _ \<Rightarrow> int"} $ t')) =
   15.19 +      @{code C} (HOLogic.dest_num t')
   15.20 +  | num_of_term vs (@{term "real :: int \<Rightarrow> real"} $ (@{term "neg_numeral :: _ \<Rightarrow> int"} $ t')) =
   15.21 +      @{code C} (~ (HOLogic.dest_num t'))
   15.22    | num_of_term vs (@{term "real :: int \<Rightarrow> real"} $ (@{term "floor :: real \<Rightarrow> int"} $ t')) =
   15.23        @{code Floor} (num_of_term vs t')
   15.24    | num_of_term vs (@{term "real :: int \<Rightarrow> real"} $ (@{term "ceiling :: real \<Rightarrow> int"} $ t')) =
   15.25        @{code Neg} (@{code Floor} (@{code Neg} (num_of_term vs t')))
   15.26 -  | num_of_term vs (@{term "number_of :: int \<Rightarrow> real"} $ t') =
   15.27 -      @{code C} (HOLogic.dest_numeral t')
   15.28 +  | num_of_term vs (@{term "numeral :: _ \<Rightarrow> real"} $ t') =
   15.29 +      @{code C} (HOLogic.dest_num t')
   15.30 +  | num_of_term vs (@{term "neg_numeral :: _ \<Rightarrow> real"} $ t') =
   15.31 +      @{code C} (~ (HOLogic.dest_num t'))
   15.32    | num_of_term vs t = error ("num_of_term: unknown term " ^ Syntax.string_of_term @{context} t);
   15.33  
   15.34  fun fm_of_term vs @{term True} = @{code T}
   15.35 @@ -5554,8 +5558,10 @@
   15.36        @{code Le} (@{code Sub} (num_of_term vs t1, num_of_term vs t2))
   15.37    | fm_of_term vs (@{term "op = :: real \<Rightarrow> real \<Rightarrow> bool"} $ t1 $ t2) =
   15.38        @{code Eq} (@{code Sub} (num_of_term vs t1, num_of_term vs t2)) 
   15.39 -  | fm_of_term vs (@{term "op rdvd"} $ (@{term "real :: int \<Rightarrow> real"} $ (@{term "number_of :: int \<Rightarrow> int"} $ t1)) $ t2) =
   15.40 -      @{code Dvd} (HOLogic.dest_numeral t1, num_of_term vs t2)
   15.41 +  | fm_of_term vs (@{term "op rdvd"} $ (@{term "real :: int \<Rightarrow> real"} $ (@{term "numeral :: _ \<Rightarrow> int"} $ t1)) $ t2) =
   15.42 +      @{code Dvd} (HOLogic.dest_num t1, num_of_term vs t2)
   15.43 +  | fm_of_term vs (@{term "op rdvd"} $ (@{term "real :: int \<Rightarrow> real"} $ (@{term "neg_numeral :: _ \<Rightarrow> int"} $ t1)) $ t2) =
   15.44 +      @{code Dvd} (~ (HOLogic.dest_num t1), num_of_term vs t2)
   15.45    | fm_of_term vs (@{term "op = :: bool \<Rightarrow> bool \<Rightarrow> bool"} $ t1 $ t2) =
   15.46        @{code Iff} (fm_of_term vs t1, fm_of_term vs t2)
   15.47    | fm_of_term vs (@{term HOL.conj} $ t1 $ t2) =
    16.1 --- a/src/HOL/Decision_Procs/Parametric_Ferrante_Rackoff.thy	Fri Mar 23 20:32:43 2012 +0100
    16.2 +++ b/src/HOL/Decision_Procs/Parametric_Ferrante_Rackoff.thy	Mon Mar 26 10:56:56 2012 +0200
    16.3 @@ -25,7 +25,7 @@
    16.4  | "tmsize (CNP n c a) = 3 + polysize c + tmsize a "
    16.5  
    16.6    (* Semantics of terms tm *)
    16.7 -primrec Itm :: "'a::{field_char_0, field_inverse_zero, number_ring} list \<Rightarrow> 'a list \<Rightarrow> tm \<Rightarrow> 'a" where
    16.8 +primrec Itm :: "'a::{field_char_0, field_inverse_zero} list \<Rightarrow> 'a list \<Rightarrow> tm \<Rightarrow> 'a" where
    16.9    "Itm vs bs (CP c) = (Ipoly vs c)"
   16.10  | "Itm vs bs (Bound n) = bs!n"
   16.11  | "Itm vs bs (Neg a) = -(Itm vs bs a)"
   16.12 @@ -430,7 +430,7 @@
   16.13  by (induct p rule: fmsize.induct) simp_all
   16.14  
   16.15    (* Semantics of formulae (fm) *)
   16.16 -primrec Ifm ::"'a::{linordered_field_inverse_zero, number_ring} list \<Rightarrow> 'a list \<Rightarrow> fm \<Rightarrow> bool" where
   16.17 +primrec Ifm ::"'a::{linordered_field_inverse_zero} list \<Rightarrow> 'a list \<Rightarrow> fm \<Rightarrow> bool" where
   16.18    "Ifm vs bs T = True"
   16.19  | "Ifm vs bs F = False"
   16.20  | "Ifm vs bs (Lt a) = (Itm vs bs a < 0)"
   16.21 @@ -1937,7 +1937,7 @@
   16.22      
   16.23      also have "\<dots> \<longleftrightarrow> - (?a * ?s) + 2*?d*?r = 0" using d by simp 
   16.24      finally have ?thesis using c d 
   16.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)
   16.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)
   16.27    }
   16.28    moreover
   16.29    {assume c: "?c \<noteq> 0" and d: "?d=0"
   16.30 @@ -1950,7 +1950,7 @@
   16.31        by (simp add: field_simps right_distrib[of "2*?c"] del: right_distrib)
   16.32      also have "\<dots> \<longleftrightarrow> - (?a * ?t) + 2*?c*?r = 0" using c by simp 
   16.33      finally have ?thesis using c d 
   16.34 -      by (simp add: r[of "- (?t/ (2*?c))"] msubsteq_def Let_def evaldjf_ex del: one_add_one_is_two)
   16.35 +      by (simp add: r[of "- (?t/ (2*?c))"] msubsteq_def Let_def evaldjf_ex)
   16.36    }
   16.37    moreover
   16.38    {assume c: "?c \<noteq> 0" and d: "?d\<noteq>0" hence dc: "?c * ?d *2 \<noteq> 0" by simp
   16.39 @@ -2019,7 +2019,7 @@
   16.40      
   16.41      also have "\<dots> \<longleftrightarrow> - (?a * ?s) + 2*?d*?r \<noteq> 0" using d by simp 
   16.42      finally have ?thesis using c d 
   16.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)
   16.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)
   16.45    }
   16.46    moreover
   16.47    {assume c: "?c \<noteq> 0" and d: "?d=0"
   16.48 @@ -2032,7 +2032,7 @@
   16.49        by (simp add: field_simps right_distrib[of "2*?c"] del: right_distrib)
   16.50      also have "\<dots> \<longleftrightarrow> - (?a * ?t) + 2*?c*?r \<noteq> 0" using c by simp 
   16.51      finally have ?thesis using c d 
   16.52 -      by (simp add: r[of "- (?t/ (2*?c))"] msubstneq_def Let_def evaldjf_ex del: one_add_one_is_two)
   16.53 +      by (simp add: r[of "- (?t/ (2*?c))"] msubstneq_def Let_def evaldjf_ex)
   16.54    }
   16.55    moreover
   16.56    {assume c: "?c \<noteq> 0" and d: "?d\<noteq>0" hence dc: "?c * ?d *2 \<noteq> 0" by simp
   16.57 @@ -2616,10 +2616,10 @@
   16.58  using lp tnb
   16.59  by (simp add: msubst2_def msubstneg_nb msubstpos_nb conj_nb disj_nb lt_nb simpfm_bound0)
   16.60  
   16.61 -lemma mult_minus2_left: "-2 * (x::'a::number_ring) = - (2 * x)"
   16.62 +lemma mult_minus2_left: "-2 * (x::'a::comm_ring_1) = - (2 * x)"
   16.63    by simp
   16.64  
   16.65 -lemma mult_minus2_right: "(x::'a::number_ring) * -2 = - (x * 2)"
   16.66 +lemma mult_minus2_right: "(x::'a::comm_ring_1) * -2 = - (x * 2)"
   16.67    by simp
   16.68  
   16.69  lemma islin_qf: "islin p \<Longrightarrow> qfree p"
   16.70 @@ -3005,11 +3005,11 @@
   16.71  *} "parametric QE for linear Arithmetic over fields, Version 2"
   16.72  
   16.73  
   16.74 -lemma "\<exists>(x::'a::{linordered_field_inverse_zero, number_ring}). y \<noteq> -1 \<longrightarrow> (y + 1)*x < 0"
   16.75 -  apply (frpar type: "'a::{linordered_field_inverse_zero, number_ring}" pars: "y::'a::{linordered_field_inverse_zero, number_ring}")
   16.76 +lemma "\<exists>(x::'a::{linordered_field_inverse_zero}). y \<noteq> -1 \<longrightarrow> (y + 1)*x < 0"
   16.77 +  apply (frpar type: "'a::{linordered_field_inverse_zero}" pars: "y::'a::{linordered_field_inverse_zero}")
   16.78    apply (simp add: field_simps)
   16.79    apply (rule spec[where x=y])
   16.80 -  apply (frpar type: "'a::{linordered_field_inverse_zero, number_ring}" pars: "z::'a::{linordered_field_inverse_zero, number_ring}")
   16.81 +  apply (frpar type: "'a::{linordered_field_inverse_zero}" pars: "z::'a::{linordered_field_inverse_zero}")
   16.82    by simp
   16.83  
   16.84  text{* Collins/Jones Problem *}
   16.85 @@ -3030,11 +3030,11 @@
   16.86  oops
   16.87  *)
   16.88  
   16.89 -lemma "\<exists>(x::'a::{linordered_field_inverse_zero, number_ring}). y \<noteq> -1 \<longrightarrow> (y + 1)*x < 0"
   16.90 -  apply (frpar2 type: "'a::{linordered_field_inverse_zero, number_ring}" pars: "y::'a::{linordered_field_inverse_zero, number_ring}")
   16.91 +lemma "\<exists>(x::'a::{linordered_field_inverse_zero}). y \<noteq> -1 \<longrightarrow> (y + 1)*x < 0"
   16.92 +  apply (frpar2 type: "'a::{linordered_field_inverse_zero}" pars: "y::'a::{linordered_field_inverse_zero}")
   16.93    apply (simp add: field_simps)
   16.94    apply (rule spec[where x=y])
   16.95 -  apply (frpar2 type: "'a::{linordered_field_inverse_zero, number_ring}" pars: "z::'a::{linordered_field_inverse_zero, number_ring}")
   16.96 +  apply (frpar2 type: "'a::{linordered_field_inverse_zero}" pars: "z::'a::{linordered_field_inverse_zero}")
   16.97    by simp
   16.98  
   16.99  text{* Collins/Jones Problem *}
    17.1 --- a/src/HOL/Decision_Procs/cooper_tac.ML	Fri Mar 23 20:32:43 2012 +0100
    17.2 +++ b/src/HOL/Decision_Procs/cooper_tac.ML	Mon Mar 26 10:56:56 2012 +0200
    17.3 @@ -18,15 +18,12 @@
    17.4  val cooper_ss = @{simpset};
    17.5  
    17.6  val nT = HOLogic.natT;
    17.7 -val binarith = @{thms normalize_bin_simps};
    17.8 -val comp_arith = binarith @ @{thms simp_thms};
    17.9 +val comp_arith = @{thms simp_thms}
   17.10  
   17.11  val zdvd_int = @{thm zdvd_int};
   17.12  val zdiff_int_split = @{thm zdiff_int_split};
   17.13  val all_nat = @{thm all_nat};
   17.14  val ex_nat = @{thm ex_nat};
   17.15 -val number_of1 = @{thm number_of1};
   17.16 -val number_of2 = @{thm number_of2};
   17.17  val split_zdiv = @{thm split_zdiv};
   17.18  val split_zmod = @{thm split_zmod};
   17.19  val mod_div_equality' = @{thm mod_div_equality'};
   17.20 @@ -90,14 +87,13 @@
   17.21            [split_zdiv, split_zmod, split_div', @{thm "split_min"}, @{thm "split_max"}]
   17.22      (* Simp rules for changing (n::int) to int n *)
   17.23      val simpset1 = HOL_basic_ss
   17.24 -      addsimps [@{thm nat_number_of_def}, zdvd_int] @ map (fn r => r RS sym)
   17.25 -        [@{thm int_int_eq}, @{thm zle_int}, @{thm zless_int}, @{thm zadd_int}, @{thm zmult_int}]
   17.26 +      addsimps [zdvd_int] @ map (fn r => r RS sym)
   17.27 +        [@{thm int_numeral}, @{thm int_int_eq}, @{thm zle_int}, @{thm zless_int}, @{thm zadd_int}, @{thm zmult_int}]
   17.28        |> Splitter.add_split zdiff_int_split
   17.29      (*simp rules for elimination of int n*)
   17.30  
   17.31      val simpset2 = HOL_basic_ss
   17.32 -      addsimps [@{thm nat_0_le}, @{thm all_nat}, @{thm ex_nat},
   17.33 -        @{thm number_of1}, @{thm number_of2}, @{thm int_0}, @{thm int_1}]
   17.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}]
   17.35        |> fold Simplifier.add_cong [@{thm conj_le_cong}, @{thm imp_le_cong}]
   17.36      (* simp rules for elimination of abs *)
   17.37      val simpset3 = HOL_basic_ss |> Splitter.add_split @{thm abs_split}
    18.1 --- a/src/HOL/Decision_Procs/ex/Dense_Linear_Order_Ex.thy	Fri Mar 23 20:32:43 2012 +0100
    18.2 +++ b/src/HOL/Decision_Procs/ex/Dense_Linear_Order_Ex.thy	Mon Mar 26 10:56:56 2012 +0200
    18.3 @@ -7,147 +7,147 @@
    18.4  begin
    18.5  
    18.6  lemma
    18.7 -  "\<exists>(y::'a::{linordered_field_inverse_zero, number_ring}) <2. x + 3* y < 0 \<and> x - y >0"
    18.8 +  "\<exists>(y::'a::{linordered_field_inverse_zero}) <2. x + 3* y < 0 \<and> x - y >0"
    18.9    by ferrack
   18.10  
   18.11 -lemma "~ (ALL x (y::'a::{linordered_field_inverse_zero, number_ring}). x < y --> 10*x < 11*y)"
   18.12 +lemma "~ (ALL x (y::'a::{linordered_field_inverse_zero}). x < y --> 10*x < 11*y)"
   18.13    by ferrack
   18.14  
   18.15 -lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}) y. x < y --> (10*(x + 5*y + -1) < 60*y)"
   18.16 +lemma "ALL (x::'a::{linordered_field_inverse_zero}) y. x < y --> (10*(x + 5*y + -1) < 60*y)"
   18.17    by ferrack
   18.18  
   18.19 -lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring}) y. x ~= y --> x < y"
   18.20 +lemma "EX (x::'a::{linordered_field_inverse_zero}) y. x ~= y --> x < y"
   18.21    by ferrack
   18.22  
   18.23 -lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring}) y. (x ~= y & 10*x ~= 9*y & 10*x < y) --> x < y"
   18.24 +lemma "EX (x::'a::{linordered_field_inverse_zero}) y. (x ~= y & 10*x ~= 9*y & 10*x < y) --> x < y"
   18.25    by ferrack
   18.26  
   18.27 -lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}) y. (x ~= y & 5*x <= y) --> 500*x <= 100*y"
   18.28 +lemma "ALL (x::'a::{linordered_field_inverse_zero}) y. (x ~= y & 5*x <= y) --> 500*x <= 100*y"
   18.29    by ferrack
   18.30  
   18.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)"
   18.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)"
   18.33    by ferrack
   18.34  
   18.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)"
   18.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)"
   18.37    by ferrack
   18.38  
   18.39 -lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring}). (0 < x & x < 1) --> (ALL y > 1. x + y ~= 1)"
   18.40 +lemma "EX (x::'a::{linordered_field_inverse_zero}). (0 < x & x < 1) --> (ALL y > 1. x + y ~= 1)"
   18.41    by ferrack
   18.42  
   18.43 -lemma "EX x. (ALL (y::'a::{linordered_field_inverse_zero, number_ring}). y < 2 -->  2*(y - x) \<le> 0 )"
   18.44 +lemma "EX x. (ALL (y::'a::{linordered_field_inverse_zero}). y < 2 -->  2*(y - x) \<le> 0 )"
   18.45    by ferrack
   18.46  
   18.47 -lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}). x < 10 | x > 20 | (EX y. y>= 0 & y <= 10 & x+y = 20)"
   18.48 +lemma "ALL (x::'a::{linordered_field_inverse_zero}). x < 10 | x > 20 | (EX y. y>= 0 & y <= 10 & x+y = 20)"
   18.49    by ferrack
   18.50  
   18.51 -lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}) y z. x + y < z --> y >= z --> x < 0"
   18.52 +lemma "ALL (x::'a::{linordered_field_inverse_zero}) y z. x + y < z --> y >= z --> x < 0"
   18.53    by ferrack
   18.54  
   18.55 -lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring}) y z. x + 7*y < 5* z & 5*y >= 7*z & x < 0"
   18.56 +lemma "EX (x::'a::{linordered_field_inverse_zero}) y z. x + 7*y < 5* z & 5*y >= 7*z & x < 0"
   18.57    by ferrack
   18.58  
   18.59 -lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}) y z. abs (x + y) <= z --> (abs z = z)"
   18.60 +lemma "ALL (x::'a::{linordered_field_inverse_zero}) y z. abs (x + y) <= z --> (abs z = z)"
   18.61    by ferrack
   18.62  
   18.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"
   18.64 +lemma "EX (x::'a::{linordered_field_inverse_zero}) y z. x + 7*y - 5* z < 0 & 5*y + 7*z + 3*x < 0"
   18.65    by ferrack
   18.66  
   18.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))"
   18.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))"
   18.69    by ferrack
   18.70  
   18.71 -lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}) y. x < y --> (EX z>0. x+z = y)"
   18.72 +lemma "ALL (x::'a::{linordered_field_inverse_zero}) y. x < y --> (EX z>0. x+z = y)"
   18.73    by ferrack
   18.74  
   18.75 -lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}) y. x < y --> (EX z>0. x+z = y)"
   18.76 +lemma "ALL (x::'a::{linordered_field_inverse_zero}) y. x < y --> (EX z>0. x+z = y)"
   18.77    by ferrack
   18.78  
   18.79 -lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}) y. (EX z>0. abs (x - y) <= z )"
   18.80 +lemma "ALL (x::'a::{linordered_field_inverse_zero}) y. (EX z>0. abs (x - y) <= z )"
   18.81    by ferrack
   18.82  
   18.83 -lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring}) y. (ALL z<0. (z < x --> z <= y) & (z > y --> z >= x))"
   18.84 +lemma "EX (x::'a::{linordered_field_inverse_zero}) y. (ALL z<0. (z < x --> z <= y) & (z > y --> z >= x))"
   18.85    by ferrack
   18.86  
   18.87 -lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring}) y. (ALL z>=0. abs (3*x+7*y) <= 2*z + 1)"
   18.88 +lemma "EX (x::'a::{linordered_field_inverse_zero}) y. (ALL z>=0. abs (3*x+7*y) <= 2*z + 1)"
   18.89    by ferrack
   18.90  
   18.91 -lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring}) y. (ALL z<0. (z < x --> z <= y) & (z > y --> z >= x))"
   18.92 +lemma "EX (x::'a::{linordered_field_inverse_zero}) y. (ALL z<0. (z < x --> z <= y) & (z > y --> z >= x))"
   18.93    by ferrack
   18.94  
   18.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))"
   18.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))"
   18.97    by ferrack
   18.98  
   18.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))"
  18.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))"
  18.101    by ferrack
  18.102  
  18.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))"
  18.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))"
  18.105    by ferrack
  18.106  
  18.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) ))"
  18.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) ))"
  18.109    by ferrack
  18.110  
  18.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))"
  18.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))"
  18.113    by ferrack
  18.114  
  18.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"
  18.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"
  18.117    by ferrack
  18.118  
  18.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"
  18.120 +lemma "EX (x::'a::{linordered_field_inverse_zero}) y z w. 5*x + 3*z - 17*w + abs (y - 8*x + z) <= 89"
  18.121    by ferrack
  18.122  
  18.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)"
  18.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)"
  18.125    by ferrack
  18.126  
  18.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)"
  18.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)"
  18.129    by ferrack
  18.130  
  18.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)"
  18.132 +lemma "ALL (x::'a::{linordered_field_inverse_zero}) y z. (EX w >= (x+y+z). w <= abs x + abs y + abs z)"
  18.133    by ferrack
  18.134  
  18.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))"
  18.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))"
  18.137    by ferrack
  18.138  
  18.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)"
  18.140 +lemma "ALL (x::'a::{linordered_field_inverse_zero}) y. (EX z w. abs (x-y) = (z-w) & z*1234 < 233*x & w ~= y)"
  18.141    by ferrack
  18.142  
  18.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))"
  18.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))"
  18.145    by ferrack
  18.146  
  18.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)"
  18.148 +lemma "EX (x::'a::{linordered_field_inverse_zero}) y z. (ALL w >= abs (x+y+z). w >= abs x + abs y + abs z)"
  18.149    by ferrack
  18.150  
  18.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))"
  18.152 +lemma "EX z. (ALL (x::'a::{linordered_field_inverse_zero}) y. (EX w >= (x+y+z). w <= abs x + abs y + abs z))"
  18.153    by ferrack
  18.154  
  18.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))"
  18.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))"
  18.157    by ferrack
  18.158  
  18.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))"
  18.160 +lemma "ALL (x::'a::{linordered_field_inverse_zero}) y. (EX z. (ALL w. abs (x-y) = abs (z-w) --> z < x & w ~= y))"
  18.161    by ferrack
  18.162  
  18.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)))"
  18.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)))"
  18.165    by ferrack
  18.166  
  18.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))"
  18.168 +lemma "EX (x::'a::{linordered_field_inverse_zero}) z. (ALL w >= 13*x - 4*z. (EX y. w >= abs x + abs y + z))"
  18.169    by ferrack
  18.170  
  18.171 -lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring}). (ALL y < x. (EX z > (x+y).
  18.172 +lemma "EX (x::'a::{linordered_field_inverse_zero}). (ALL y < x. (EX z > (x+y).
  18.173    (ALL w. 5*w + 10*x - z >= y --> w + 7*x + 3*z >= 2*y)))"
  18.174    by ferrack
  18.175  
  18.176 -lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring}). (ALL y. (EX z > y.
  18.177 +lemma "EX (x::'a::{linordered_field_inverse_zero}). (ALL y. (EX z > y.
  18.178    (ALL w . w < 13 --> w + 10*x - z >= y --> 5*w + 7*x + 13*z >= 2*y)))"
  18.179    by ferrack
  18.180  
  18.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)"
  18.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)"
  18.183    by ferrack
  18.184  
  18.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)))"
  18.186 +lemma "ALL (x::'a::{linordered_field_inverse_zero}). (EX y. (ALL z>19. y <= x + z & (EX w. abs (y - x) < w)))"
  18.187    by ferrack
  18.188  
  18.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)))"
  18.190 +lemma "ALL (x::'a::{linordered_field_inverse_zero}). (EX y. (ALL z>19. y <= x + z & (EX w. abs (x + z) < w - y)))"
  18.191    by ferrack
  18.192  
  18.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)))"
  18.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)))"
  18.195    by ferrack
  18.196  
  18.197  end
    19.1 --- a/src/HOL/Decision_Procs/ferrack_tac.ML	Fri Mar 23 20:32:43 2012 +0100
    19.2 +++ b/src/HOL/Decision_Procs/ferrack_tac.ML	Mon Mar 26 10:56:56 2012 +0200
    19.3 @@ -20,17 +20,13 @@
    19.4               in @{simpset} delsimps ths addsimps (map (fn th => th RS sym) ths)
    19.5               end;
    19.6  
    19.7 -val binarith =
    19.8 -  @{thms normalize_bin_simps} @ @{thms pred_bin_simps} @ @{thms succ_bin_simps} @
    19.9 -  @{thms add_bin_simps} @ @{thms minus_bin_simps} @  @{thms mult_bin_simps};
   19.10 -val comp_arith = binarith @ @{thms simp_thms};
   19.11 +val binarith = @{thms arith_simps}
   19.12 +val comp_arith = binarith @ @{thms simp_thms}
   19.13  
   19.14  val zdvd_int = @{thm zdvd_int};
   19.15  val zdiff_int_split = @{thm zdiff_int_split};
   19.16  val all_nat = @{thm all_nat};
   19.17  val ex_nat = @{thm ex_nat};
   19.18 -val number_of1 = @{thm number_of1};
   19.19 -val number_of2 = @{thm number_of2};
   19.20  val split_zdiv = @{thm split_zdiv};
   19.21  val split_zmod = @{thm split_zmod};
   19.22  val mod_div_equality' = @{thm mod_div_equality'};
    20.1 --- a/src/HOL/Decision_Procs/mir_tac.ML	Fri Mar 23 20:32:43 2012 +0100
    20.2 +++ b/src/HOL/Decision_Procs/mir_tac.ML	Mon Mar 26 10:56:56 2012 +0200
    20.3 @@ -21,16 +21,15 @@
    20.4  end;
    20.5  
    20.6  val nT = HOLogic.natT;
    20.7 -  val nat_arith = [@{thm "add_nat_number_of"}, @{thm "diff_nat_number_of"},
    20.8 -                       @{thm "mult_nat_number_of"}, @{thm "eq_nat_number_of"}, @{thm "less_nat_number_of"}];
    20.9 +  val nat_arith = [@{thm diff_nat_numeral}];
   20.10  
   20.11    val comp_arith = [@{thm "Let_def"}, @{thm "if_False"}, @{thm "if_True"}, @{thm "add_0"},
   20.12 -                 @{thm "add_Suc"}, @{thm "add_number_of_left"}, @{thm "mult_number_of_left"},
   20.13 +                 @{thm "add_Suc"}, @{thm add_numeral_left}, @{thm mult_numeral_left(1)},
   20.14                   @{thm "Suc_eq_plus1"}] @
   20.15 -                 (map (fn th => th RS sym) [@{thm "numeral_1_eq_1"}, @{thm "numeral_0_eq_0"}])
   20.16 +                 (map (fn th => th RS sym) [@{thm "numeral_1_eq_1"}])
   20.17                   @ @{thms arith_simps} @ nat_arith @ @{thms rel_simps} 
   20.18    val ths = [@{thm "mult_numeral_1"}, @{thm "mult_numeral_1_right"}, 
   20.19 -             @{thm "real_of_nat_number_of"},
   20.20 +             @{thm real_of_nat_numeral},
   20.21               @{thm "real_of_nat_Suc"}, @{thm "real_of_nat_one"}, @{thm "real_of_one"},
   20.22               @{thm "real_of_int_zero"}, @{thm "real_of_nat_zero"},
   20.23               @{thm "divide_zero"}, 
   20.24 @@ -44,8 +43,6 @@
   20.25  val zdiff_int_split = @{thm "zdiff_int_split"};
   20.26  val all_nat = @{thm "all_nat"};
   20.27  val ex_nat = @{thm "ex_nat"};
   20.28 -val number_of1 = @{thm "number_of1"};
   20.29 -val number_of2 = @{thm "number_of2"};
   20.30  val split_zdiv = @{thm "split_zdiv"};
   20.31  val split_zmod = @{thm "split_zmod"};
   20.32  val mod_div_equality' = @{thm "mod_div_equality'"};
   20.33 @@ -113,15 +110,15 @@
   20.34              @{thm "split_min"}, @{thm "split_max"}]
   20.35      (* Simp rules for changing (n::int) to int n *)
   20.36      val simpset1 = HOL_basic_ss
   20.37 -      addsimps [@{thm "nat_number_of_def"}, @{thm "zdvd_int"}] @ map (fn r => r RS sym)
   20.38 +      addsimps [@{thm "zdvd_int"}] @ map (fn r => r RS sym)
   20.39          [@{thm "int_int_eq"}, @{thm "zle_int"}, @{thm "zless_int"}, @{thm "zadd_int"}, 
   20.40 -         @{thm "zmult_int"}]
   20.41 +         @{thm nat_numeral}, @{thm "zmult_int"}]
   20.42        |> Splitter.add_split @{thm "zdiff_int_split"}
   20.43      (*simp rules for elimination of int n*)
   20.44  
   20.45      val simpset2 = HOL_basic_ss
   20.46 -      addsimps [@{thm "nat_0_le"}, @{thm "all_nat"}, @{thm "ex_nat"}, @{thm "number_of1"}, 
   20.47 -                @{thm "number_of2"}, @{thm "int_0"}, @{thm "int_1"}]
   20.48 +      addsimps [@{thm "nat_0_le"}, @{thm "all_nat"}, @{thm "ex_nat"}, @{thm zero_le_numeral}, 
   20.49 +                @{thm "int_0"}, @{thm "int_1"}]
   20.50        |> fold Simplifier.add_cong [@{thm "conj_le_cong"}, @{thm "imp_le_cong"}]
   20.51      (* simp rules for elimination of abs *)
   20.52      val ct = cterm_of thy (HOLogic.mk_Trueprop t)
    21.1 --- a/src/HOL/Deriv.thy	Fri Mar 23 20:32:43 2012 +0100
    21.2 +++ b/src/HOL/Deriv.thy	Mon Mar 26 10:56:56 2012 +0200
    21.3 @@ -186,7 +186,6 @@
    21.4  apply (erule DERIV_mult')
    21.5  apply (erule (1) DERIV_inverse')
    21.6  apply (simp add: ring_distribs nonzero_inverse_mult_distrib)
    21.7 -apply (simp add: mult_ac)
    21.8  done
    21.9  
   21.10  lemma DERIV_power_Suc:
    22.1 --- a/src/HOL/Divides.thy	Fri Mar 23 20:32:43 2012 +0100
    22.2 +++ b/src/HOL/Divides.thy	Mon Mar 26 10:56:56 2012 +0200
    22.3 @@ -1138,8 +1138,8 @@
    22.4  lemma Suc_mod_eq_add3_mod: "(Suc (Suc (Suc m))) mod n = (3+m) mod n"
    22.5  by (simp add: Suc3_eq_add_3)
    22.6  
    22.7 -lemmas Suc_div_eq_add3_div_number_of [simp] = Suc_div_eq_add3_div [of _ "number_of v"] for v
    22.8 -lemmas Suc_mod_eq_add3_mod_number_of [simp] = Suc_mod_eq_add3_mod [of _ "number_of v"] for v
    22.9 +lemmas Suc_div_eq_add3_div_numeral [simp] = Suc_div_eq_add3_div [of _ "numeral v"] for v
   22.10 +lemmas Suc_mod_eq_add3_mod_numeral [simp] = Suc_mod_eq_add3_mod [of _ "numeral v"] for v
   22.11  
   22.12  
   22.13  lemma Suc_times_mod_eq: "1<k ==> Suc (k * m) mod k = 1" 
   22.14 @@ -1147,7 +1147,7 @@
   22.15  apply (simp_all add: mod_Suc)
   22.16  done
   22.17  
   22.18 -declare Suc_times_mod_eq [of "number_of w", simp] for w
   22.19 +declare Suc_times_mod_eq [of "numeral w", simp] for w
   22.20  
   22.21  lemma [simp]: "n div k \<le> (Suc n) div k"
   22.22  by (simp add: div_le_mono) 
   22.23 @@ -1177,17 +1177,22 @@
   22.24  apply (subst mod_Suc [of "m mod n"], simp) 
   22.25  done
   22.26  
   22.27 +lemma mod_2_not_eq_zero_eq_one_nat:
   22.28 +  fixes n :: nat
   22.29 +  shows "n mod 2 \<noteq> 0 \<longleftrightarrow> n mod 2 = 1"
   22.30 +  by simp
   22.31 +
   22.32  
   22.33  subsection {* Division on @{typ int} *}
   22.34  
   22.35  definition divmod_int_rel :: "int \<Rightarrow> int \<Rightarrow> int \<times> int \<Rightarrow> bool" where
   22.36      --{*definition of quotient and remainder*}
   22.37 -    [code]: "divmod_int_rel a b = (\<lambda>(q, r). a = b * q + r \<and>
   22.38 +    "divmod_int_rel a b = (\<lambda>(q, r). a = b * q + r \<and>
   22.39                 (if 0 < b then 0 \<le> r \<and> r < b else b < r \<and> r \<le> 0))"
   22.40  
   22.41  definition adjust :: "int \<Rightarrow> int \<times> int \<Rightarrow> int \<times> int" where
   22.42      --{*for the division algorithm*}
   22.43 -    [code]: "adjust b = (\<lambda>(q, r). if 0 \<le> r - b then (2 * q + 1, r - b)
   22.44 +    "adjust b = (\<lambda>(q, r). if 0 \<le> r - b then (2 * q + 1, r - b)
   22.45                           else (2 * q, r))"
   22.46  
   22.47  text{*algorithm for the case @{text "a\<ge>0, b>0"}*}
   22.48 @@ -1318,11 +1323,11 @@
   22.49  text{*And positive divisors*}
   22.50  
   22.51  lemma adjust_eq [simp]:
   22.52 -     "adjust b (q,r) = 
   22.53 -      (let diff = r-b in  
   22.54 -        if 0 \<le> diff then (2*q + 1, diff)   
   22.55 +     "adjust b (q, r) = 
   22.56 +      (let diff = r - b in  
   22.57 +        if 0 \<le> diff then (2 * q + 1, diff)   
   22.58                       else (2*q, r))"
   22.59 -by (simp add: Let_def adjust_def)
   22.60 +  by (simp add: Let_def adjust_def)
   22.61  
   22.62  declare posDivAlg.simps [simp del]
   22.63  
   22.64 @@ -1420,6 +1425,9 @@
   22.65  
   22.66  text {* Tool setup *}
   22.67  
   22.68 +(* FIXME: Theorem list add_0s doesn't exist, because Numeral0 has gone. *)
   22.69 +lemmas add_0s = add_0_left add_0_right
   22.70 +
   22.71  ML {*
   22.72  structure Cancel_Div_Mod_Int = Cancel_Div_Mod
   22.73  (
   22.74 @@ -1674,16 +1682,6 @@
   22.75    by (rule divmod_int_rel_mod [of a b q r],
   22.76      simp add: divmod_int_rel_def)
   22.77  
   22.78 -lemmas arithmetic_simps =
   22.79 -  arith_simps
   22.80 -  add_special
   22.81 -  add_0_left
   22.82 -  add_0_right
   22.83 -  mult_zero_left
   22.84 -  mult_zero_right
   22.85 -  mult_1_left
   22.86 -  mult_1_right
   22.87 -
   22.88  (* simprocs adapted from HOL/ex/Binary.thy *)
   22.89  ML {*
   22.90  local
   22.91 @@ -1694,7 +1692,7 @@
   22.92    val less = @{term "op < :: int \<Rightarrow> int \<Rightarrow> bool"}
   22.93    val le = @{term "op \<le> :: int \<Rightarrow> int \<Rightarrow> bool"}
   22.94    val simps = @{thms arith_simps} @ @{thms rel_simps} @
   22.95 -    map (fn th => th RS sym) [@{thm numeral_0_eq_0}, @{thm numeral_1_eq_1}]
   22.96 +    map (fn th => th RS sym) [@{thm numeral_1_eq_1}]
   22.97    fun prove ctxt goal = Goal.prove ctxt [] [] (HOLogic.mk_Trueprop goal)
   22.98      (K (ALLGOALS (full_simp_tac (HOL_basic_ss addsimps simps))));
   22.99    fun binary_proc proc ss ct =
  22.100 @@ -1717,14 +1715,25 @@
  22.101  end
  22.102  *}
  22.103  
  22.104 -simproc_setup binary_int_div ("number_of m div number_of n :: int") =
  22.105 +simproc_setup binary_int_div
  22.106 +  ("numeral m div numeral n :: int" |
  22.107 +   "numeral m div neg_numeral n :: int" |
  22.108 +   "neg_numeral m div numeral n :: int" |
  22.109 +   "neg_numeral m div neg_numeral n :: int") =
  22.110    {* K (divmod_proc @{thm int_div_pos_eq} @{thm int_div_neg_eq}) *}
  22.111  
  22.112 -simproc_setup binary_int_mod ("number_of m mod number_of n :: int") =
  22.113 +simproc_setup binary_int_mod
  22.114 +  ("numeral m mod numeral n :: int" |
  22.115 +   "numeral m mod neg_numeral n :: int" |
  22.116 +   "neg_numeral m mod numeral n :: int" |
  22.117 +   "neg_numeral m mod neg_numeral n :: int") =
  22.118    {* K (divmod_proc @{thm int_mod_pos_eq} @{thm int_mod_neg_eq}) *}
  22.119  
  22.120 -lemmas posDivAlg_eqn_number_of [simp] = posDivAlg_eqn [of "number_of v" "number_of w"] for v w
  22.121 -lemmas negDivAlg_eqn_number_of [simp] = negDivAlg_eqn [of "number_of v" "number_of w"] for v w
  22.122 +lemmas posDivAlg_eqn_numeral [simp] =
  22.123 +    posDivAlg_eqn [of "numeral v" "numeral w", OF zero_less_numeral] for v w
  22.124 +
  22.125 +lemmas negDivAlg_eqn_numeral [simp] =
  22.126 +    negDivAlg_eqn [of "numeral v" "neg_numeral w", OF zero_less_numeral] for v w
  22.127  
  22.128  
  22.129  text{*Special-case simplification *}
  22.130 @@ -1741,12 +1750,25 @@
  22.131  (** The last remaining special cases for constant arithmetic:
  22.132      1 div z and 1 mod z **)
  22.133  
  22.134 -lemmas div_pos_pos_1_number_of [simp] = div_pos_pos [OF zero_less_one, of "number_of w"] for w
  22.135 -lemmas div_pos_neg_1_number_of [simp] = div_pos_neg [OF zero_less_one, of "number_of w"] for w
  22.136 -lemmas mod_pos_pos_1_number_of [simp] = mod_pos_pos [OF zero_less_one, of "number_of w"] for w
  22.137 -lemmas mod_pos_neg_1_number_of [simp] = mod_pos_neg [OF zero_less_one, of "number_of w"] for w
  22.138 -lemmas posDivAlg_eqn_1_number_of [simp] = posDivAlg_eqn [of concl: 1 "number_of w"] for w
  22.139 -lemmas negDivAlg_eqn_1_number_of [simp] = negDivAlg_eqn [of concl: 1 "number_of w"] for w
  22.140 +lemmas div_pos_pos_1_numeral [simp] =
  22.141 +  div_pos_pos [OF zero_less_one, of "numeral w", OF zero_le_numeral] for w
  22.142 +
  22.143 +lemmas div_pos_neg_1_numeral [simp] =
  22.144 +  div_pos_neg [OF zero_less_one, of "neg_numeral w",
  22.145 +  OF neg_numeral_less_zero] for w
  22.146 +
  22.147 +lemmas mod_pos_pos_1_numeral [simp] =
  22.148 +  mod_pos_pos [OF zero_less_one, of "numeral w", OF zero_le_numeral] for w
  22.149 +
  22.150 +lemmas mod_pos_neg_1_numeral [simp] =
  22.151 +  mod_pos_neg [OF zero_less_one, of "neg_numeral w",
  22.152 +  OF neg_numeral_less_zero] for w
  22.153 +
  22.154 +lemmas posDivAlg_eqn_1_numeral [simp] =
  22.155 +    posDivAlg_eqn [of concl: 1 "numeral w", OF zero_less_numeral] for w
  22.156 +
  22.157 +lemmas negDivAlg_eqn_1_numeral [simp] =
  22.158 +    negDivAlg_eqn [of concl: 1 "numeral w", OF zero_less_numeral] for w
  22.159  
  22.160  
  22.161  subsubsection {* Monotonicity in the First Argument (Dividend) *}
  22.162 @@ -1928,6 +1950,11 @@
  22.163  (* REVISIT: should this be generalized to all semiring_div types? *)
  22.164  lemmas zmod_eq_0D [dest!] = zmod_eq_0_iff [THEN iffD1]
  22.165  
  22.166 +lemma zmod_zdiv_equality':
  22.167 +  "(m\<Colon>int) mod n = m - (m div n) * n"
  22.168 +  by (rule_tac P="%x. m mod n = x - (m div n) * n" in subst [OF mod_div_equality [of _ n]])
  22.169 +    arith
  22.170 +
  22.171  
  22.172  subsubsection {* Proving  @{term "a div (b*c) = (a div b) div c"} *}
  22.173  
  22.174 @@ -1989,6 +2016,26 @@
  22.175  apply (force simp add: divmod_int_rel_div_mod [THEN zmult2_lemma, THEN divmod_int_rel_mod])
  22.176  done
  22.177  
  22.178 +lemma div_pos_geq:
  22.179 +  fixes k l :: int
  22.180 +  assumes "0 < l" and "l \<le> k"
  22.181 +  shows "k div l = (k - l) div l + 1"
  22.182 +proof -
  22.183 +  have "k = (k - l) + l" by simp
  22.184 +  then obtain j where k: "k = j + l" ..
  22.185 +  with assms show ?thesis by simp
  22.186 +qed
  22.187 +
  22.188 +lemma mod_pos_geq:
  22.189 +  fixes k l :: int
  22.190 +  assumes "0 < l" and "l \<le> k"
  22.191 +  shows "k mod l = (k - l) mod l"
  22.192 +proof -
  22.193 +  have "k = (k - l) + l" by simp
  22.194 +  then obtain j where k: "k = j + l" ..
  22.195 +  with assms show ?thesis by simp
  22.196 +qed
  22.197 +
  22.198  
  22.199  subsubsection {* Splitting Rules for div and mod *}
  22.200  
  22.201 @@ -2046,9 +2093,9 @@
  22.202  
  22.203  text {* Enable (lin)arith to deal with @{const div} and @{const mod}
  22.204    when these are applied to some constant that is of the form
  22.205 -  @{term "number_of k"}: *}
  22.206 -declare split_zdiv [of _ _ "number_of k", arith_split] for k
  22.207 -declare split_zmod [of _ _ "number_of k", arith_split] for k
  22.208 +  @{term "numeral k"}: *}
  22.209 +declare split_zdiv [of _ _ "numeral k", arith_split] for k
  22.210 +declare split_zmod [of _ _ "numeral k", arith_split] for k
  22.211  
  22.212  
  22.213  subsubsection {* Speeding up the Division Algorithm with Shifting *}
  22.214 @@ -2090,19 +2137,19 @@
  22.215        minus_add_distrib [symmetric] mult_minus_right)
  22.216  qed
  22.217  
  22.218 -lemma zdiv_number_of_Bit0 [simp]:
  22.219 -     "number_of (Int.Bit0 v) div number_of (Int.Bit0 w) =  
  22.220 -          number_of v div (number_of w :: int)"
  22.221 -by (simp only: number_of_eq numeral_simps) (simp add: mult_2 [symmetric])
  22.222 -
  22.223 -lemma zdiv_number_of_Bit1 [simp]:
  22.224 -     "number_of (Int.Bit1 v) div number_of (Int.Bit0 w) =  
  22.225 -          (if (0::int) \<le> number_of w                    
  22.226 -           then number_of v div (number_of w)     
  22.227 -           else (number_of v + (1::int)) div (number_of w))"
  22.228 -apply (simp only: number_of_eq numeral_simps UNIV_I split: split_if) 
  22.229 -apply (simp add: pos_zdiv_mult_2 neg_zdiv_mult_2 add_ac mult_2 [symmetric])
  22.230 -done
  22.231 +(* FIXME: add rules for negative numerals *)
  22.232 +lemma zdiv_numeral_Bit0 [simp]:
  22.233 +  "numeral (Num.Bit0 v) div numeral (Num.Bit0 w) =
  22.234 +    numeral v div (numeral w :: int)"
  22.235 +  unfolding numeral.simps unfolding mult_2 [symmetric]
  22.236 +  by (rule div_mult_mult1, simp)
  22.237 +
  22.238 +lemma zdiv_numeral_Bit1 [simp]:
  22.239 +  "numeral (Num.Bit1 v) div numeral (Num.Bit0 w) =  
  22.240 +    (numeral v div (numeral w :: int))"
  22.241 +  unfolding numeral.simps
  22.242 +  unfolding mult_2 [symmetric] add_commute [of _ 1]
  22.243 +  by (rule pos_zdiv_mult_2, simp)
  22.244  
  22.245  
  22.246  subsubsection {* Computing mod by Shifting (proofs resemble those for div) *}
  22.247 @@ -2138,24 +2185,19 @@
  22.248       (simp add: diff_minus add_ac)
  22.249  qed
  22.250  
  22.251 -lemma zmod_number_of_Bit0 [simp]:
  22.252 -     "number_of (Int.Bit0 v) mod number_of (Int.Bit0 w) =  
  22.253 -      (2::int) * (number_of v mod number_of w)"
  22.254 -apply (simp only: number_of_eq numeral_simps) 
  22.255 -apply (simp add: mod_mult_mult1 pos_zmod_mult_2 
  22.256 -                 neg_zmod_mult_2 add_ac mult_2 [symmetric])
  22.257 -done
  22.258 -
  22.259 -lemma zmod_number_of_Bit1 [simp]:
  22.260 -     "number_of (Int.Bit1 v) mod number_of (Int.Bit0 w) =  
  22.261 -      (if (0::int) \<le> number_of w  
  22.262 -                then 2 * (number_of v mod number_of w) + 1     
  22.263 -                else 2 * ((number_of v + (1::int)) mod number_of w) - 1)"
  22.264 -apply (simp only: number_of_eq numeral_simps) 
  22.265 -apply (simp add: mod_mult_mult1 pos_zmod_mult_2 
  22.266 -                 neg_zmod_mult_2 add_ac mult_2 [symmetric])
  22.267 -done
  22.268 -
  22.269 +(* FIXME: add rules for negative numerals *)
  22.270 +lemma zmod_numeral_Bit0 [simp]:
  22.271 +  "numeral (Num.Bit0 v) mod numeral (Num.Bit0 w) =  
  22.272 +    (2::int) * (numeral v mod numeral w)"
  22.273 +  unfolding numeral_Bit0 [of v] numeral_Bit0 [of w]
  22.274 +  unfolding mult_2 [symmetric] by (rule mod_mult_mult1)
  22.275 +
  22.276 +lemma zmod_numeral_Bit1 [simp]:
  22.277 +  "numeral (Num.Bit1 v) mod numeral (Num.Bit0 w) =
  22.278 +    2 * (numeral v mod numeral w) + (1::int)"
  22.279 +  unfolding numeral_Bit1 [of v] numeral_Bit0 [of w]
  22.280 +  unfolding mult_2 [symmetric] add_commute [of _ 1]
  22.281 +  by (rule pos_zmod_mult_2, simp)
  22.282  
  22.283  lemma zdiv_eq_0_iff:
  22.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")
  22.285 @@ -2233,8 +2275,11 @@
  22.286  
  22.287  subsubsection {* The Divides Relation *}
  22.288  
  22.289 -lemmas zdvd_iff_zmod_eq_0_number_of [simp] =
  22.290 -  dvd_eq_mod_eq_0 [of "number_of x" "number_of y"] for x y :: int
  22.291 +lemmas zdvd_iff_zmod_eq_0_numeral [simp] =
  22.292 +  dvd_eq_mod_eq_0 [of "numeral x::int" "numeral y::int"]
  22.293 +  dvd_eq_mod_eq_0 [of "numeral x::int" "neg_numeral y::int"]
  22.294 +  dvd_eq_mod_eq_0 [of "neg_numeral x::int" "numeral y::int"]
  22.295 +  dvd_eq_mod_eq_0 [of "neg_numeral x::int" "neg_numeral y::int"] for x y
  22.296  
  22.297  lemma zdvd_zmod: "f dvd m ==> f dvd (n::int) ==> f dvd m mod n"
  22.298    by (rule dvd_mod) (* TODO: remove *)
  22.299 @@ -2242,6 +2287,12 @@
  22.300  lemma zdvd_zmod_imp_zdvd: "k dvd m mod n ==> k dvd n ==> k dvd (m::int)"
  22.301    by (rule dvd_mod_imp_dvd) (* TODO: remove *)
  22.302  
  22.303 +lemmas dvd_eq_mod_eq_0_numeral [simp] =
  22.304 +  dvd_eq_mod_eq_0 [of "numeral x" "numeral y"] for x y
  22.305 +
  22.306 +
  22.307 +subsubsection {* Further properties *}
  22.308 +
  22.309  lemma zmult_div_cancel: "(n::int) * (m div n) = m - (m mod n)"
  22.310    using zmod_zdiv_equality[where a="m" and b="n"]
  22.311    by (simp add: algebra_simps)
  22.312 @@ -2408,42 +2459,31 @@
  22.313    thus  ?lhs by simp
  22.314  qed
  22.315  
  22.316 -lemma div_nat_number_of [simp]:
  22.317 -     "(number_of v :: nat)  div  number_of v' =  
  22.318 -          (if neg (number_of v :: int) then 0  
  22.319 -           else nat (number_of v div number_of v'))"
  22.320 -  unfolding nat_number_of_def number_of_is_id neg_def
  22.321 +lemma div_nat_numeral [simp]:
  22.322 +  "(numeral v :: nat) div numeral v' = nat (numeral v div numeral v')"
  22.323    by (simp add: nat_div_distrib)
  22.324  
  22.325 -lemma one_div_nat_number_of [simp]:
  22.326 -     "Suc 0 div number_of v' = nat (1 div number_of v')" 
  22.327 -  by (simp del: semiring_numeral_1_eq_1 add: numeral_1_eq_Suc_0 [symmetric] semiring_numeral_1_eq_1 [symmetric]) 
  22.328 -
  22.329 -lemma mod_nat_number_of [simp]:
  22.330 -     "(number_of v :: nat)  mod  number_of v' =  
  22.331 -        (if neg (number_of v :: int) then 0  
  22.332 -         else if neg (number_of v' :: int) then number_of v  
  22.333 -         else nat (number_of v mod number_of v'))"
  22.334 -  unfolding nat_number_of_def number_of_is_id neg_def
  22.335 +lemma one_div_nat_numeral [simp]:
  22.336 +  "Suc 0 div numeral v' = nat (1 div numeral v')"
  22.337 +  by (subst nat_div_distrib, simp_all)
  22.338 +
  22.339 +lemma mod_nat_numeral [simp]:
  22.340 +  "(numeral v :: nat) mod numeral v' = nat (numeral v mod numeral v')"
  22.341    by (simp add: nat_mod_distrib)
  22.342  
  22.343 -lemma one_mod_nat_number_of [simp]:
  22.344 -     "Suc 0 mod number_of v' =  
  22.345 -        (if neg (number_of v' :: int) then Suc 0
  22.346 -         else nat (1 mod number_of v'))"
  22.347 -by (simp del: semiring_numeral_1_eq_1 add: numeral_1_eq_Suc_0 [symmetric] semiring_numeral_1_eq_1 [symmetric]) 
  22.348 -
  22.349 -lemmas dvd_eq_mod_eq_0_number_of [simp] =
  22.350 -  dvd_eq_mod_eq_0 [of "number_of x" "number_of y"] for x y
  22.351 -
  22.352 -
  22.353 -subsubsection {* Nitpick *}
  22.354 -
  22.355 -lemma zmod_zdiv_equality':
  22.356 -"(m\<Colon>int) mod n = m - (m div n) * n"
  22.357 -by (rule_tac P="%x. m mod n = x - (m div n) * n"
  22.358 -    in subst [OF mod_div_equality [of _ n]])
  22.359 -   arith
  22.360 +lemma one_mod_nat_numeral [simp]:
  22.361 +  "Suc 0 mod numeral v' = nat (1 mod numeral v')"
  22.362 +  by (subst nat_mod_distrib) simp_all
  22.363 +
  22.364 +lemma mod_2_not_eq_zero_eq_one_int:
  22.365 +  fixes k :: int
  22.366 +  shows "k mod 2 \<noteq> 0 \<longleftrightarrow> k mod 2 = 1"
  22.367 +  by auto
  22.368 +
  22.369 +
  22.370 +subsubsection {* Tools setup *}
  22.371 +
  22.372 +text {* Nitpick *}
  22.373  
  22.374  lemmas [nitpick_unfold] = dvd_eq_mod_eq_0 mod_div_equality' zmod_zdiv_equality'
  22.375  
  22.376 @@ -2461,7 +2501,7 @@
  22.377    apsnd ((op *) (sgn l)) (if 0 < l \<and> 0 \<le> k \<or> l < 0 \<and> k < 0
  22.378      then pdivmod k l
  22.379      else (let (r, s) = pdivmod k l in
  22.380 -      if s = 0 then (- r, 0) else (- r - 1, \<bar>l\<bar> - s))))"
  22.381 +       if s = 0 then (- r, 0) else (- r - 1, \<bar>l\<bar> - s))))"
  22.382  proof -
  22.383    have aux: "\<And>q::int. - k = l * q \<longleftrightarrow> k = l * - q" by auto
  22.384    show ?thesis
  22.385 @@ -2481,45 +2521,6 @@
  22.386    then show ?thesis by (simp add: divmod_int_pdivmod)
  22.387  qed
  22.388  
  22.389 -context ring_1
  22.390 -begin
  22.391 -
  22.392 -lemma of_int_num [code]:
  22.393 -  "of_int k = (if k = 0 then 0 else if k < 0 then
  22.394 -     - of_int (- k) else let
  22.395 -       (l, m) = divmod_int k 2;
  22.396 -       l' = of_int l
  22.397 -     in if m = 0 then l' + l' else l' + l' + 1)"
  22.398 -proof -
  22.399 -  have aux1: "k mod (2\<Colon>int) \<noteq> (0\<Colon>int) \<Longrightarrow> 
  22.400 -    of_int k = of_int (k div 2 * 2 + 1)"
  22.401 -  proof -
  22.402 -    have "k mod 2 < 2" by (auto intro: pos_mod_bound)
  22.403 -    moreover have "0 \<le> k mod 2" by (auto intro: pos_mod_sign)
  22.404 -    moreover assume "k mod 2 \<noteq> 0"
  22.405 -    ultimately have "k mod 2 = 1" by arith
  22.406 -    moreover have "of_int k = of_int (k div 2 * 2 + k mod 2)" by simp
  22.407 -    ultimately show ?thesis by auto
  22.408 -  qed
  22.409 -  have aux2: "\<And>x. of_int 2 * x = x + x"
  22.410 -  proof -
  22.411 -    fix x
  22.412 -    have int2: "(2::int) = 1 + 1" by arith
  22.413 -    show "of_int 2 * x = x + x"
  22.414 -    unfolding int2 of_int_add left_distrib by simp
  22.415 -  qed
  22.416 -  have aux3: "\<And>x. x * of_int 2 = x + x"
  22.417 -  proof -
  22.418 -    fix x
  22.419 -    have int2: "(2::int) = 1 + 1" by arith
  22.420 -    show "x * of_int 2 = x + x" 
  22.421 -    unfolding int2 of_int_add right_distrib by simp
  22.422 -  qed
  22.423 -  from aux1 show ?thesis by (auto simp add: divmod_int_mod_div Let_def aux2 aux3)
  22.424 -qed
  22.425 -
  22.426 -end
  22.427 -
  22.428  code_modulename SML
  22.429    Divides Arith
  22.430  
    23.1 --- a/src/HOL/Imperative_HOL/ex/Imperative_Quicksort.thy	Fri Mar 23 20:32:43 2012 +0100
    23.2 +++ b/src/HOL/Imperative_HOL/ex/Imperative_Quicksort.thy	Mon Mar 26 10:56:56 2012 +0200
    23.3 @@ -6,7 +6,7 @@
    23.4  
    23.5  theory Imperative_Quicksort
    23.6  imports
    23.7 -  Imperative_HOL
    23.8 +  "~~/src/HOL/Imperative_HOL/Imperative_HOL"
    23.9    Subarray
   23.10    "~~/src/HOL/Library/Multiset"
   23.11    "~~/src/HOL/Library/Efficient_Nat"
   23.12 @@ -593,8 +593,8 @@
   23.13  proof (induct a l r p arbitrary: h rule: part1.induct)
   23.14    case (1 a l r p)
   23.15    thus ?case unfolding part1.simps [of a l r]
   23.16 -  apply (auto intro!: success_intros del: success_ifI simp add: not_le)
   23.17 -  apply (auto intro!: effect_intros effect_swapI)
   23.18 +  apply (auto intro!: success_intros simp add: not_le)
   23.19 +  apply (auto intro!: effect_intros)
   23.20    done
   23.21  qed
   23.22  
    24.1 --- a/src/HOL/Imperative_HOL/ex/Imperative_Reverse.thy	Fri Mar 23 20:32:43 2012 +0100
    24.2 +++ b/src/HOL/Imperative_HOL/ex/Imperative_Reverse.thy	Mon Mar 26 10:56:56 2012 +0200
    24.3 @@ -5,7 +5,7 @@
    24.4  header {* An imperative in-place reversal on arrays *}
    24.5  
    24.6  theory Imperative_Reverse
    24.7 -imports Subarray Imperative_HOL
    24.8 +imports Subarray "~~/src/HOL/Imperative_HOL/Imperative_HOL"
    24.9  begin
   24.10  
   24.11  fun swap :: "'a\<Colon>heap array \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> unit Heap" where
   24.12 @@ -107,7 +107,7 @@
   24.13    shows "Array.get h' a = List.rev (Array.get h a)"
   24.14    using rev2_rev'[OF assms] rev_length[OF assms] assms
   24.15      by (cases "Array.length h a = 0", auto simp add: Array.length_def
   24.16 -      subarray_def sublist'_all rev.simps[where j=0] elim!: effect_elims)
   24.17 +      subarray_def rev.simps[where j=0] elim!: effect_elims)
   24.18    (drule sym[of "List.length (Array.get h a)"], simp)
   24.19  
   24.20  definition "example = (Array.make 10 id \<guillemotright>= (\<lambda>a. rev a 0 9))"
   24.21 @@ -115,3 +115,4 @@
   24.22  export_code example checking SML SML_imp OCaml? OCaml_imp? Haskell? Scala? Scala_imp?
   24.23  
   24.24  end
   24.25 +
    25.1 --- a/src/HOL/Imperative_HOL/ex/SatChecker.thy	Fri Mar 23 20:32:43 2012 +0100
    25.2 +++ b/src/HOL/Imperative_HOL/ex/SatChecker.thy	Mon Mar 26 10:56:56 2012 +0200
    25.3 @@ -702,15 +702,7 @@
    25.4                  else raise(''No empty clause''))
    25.5    }"
    25.6  
    25.7 -section {* Code generation setup *}
    25.8 -
    25.9 -code_type ProofStep
   25.10 -  (SML "MinisatProofStep.ProofStep")
   25.11 -
   25.12 -code_const ProofDone and Root and Conflict and Delete and Xstep
   25.13 -  (SML "MinisatProofStep.ProofDone" and "MinisatProofStep.Root ((_),/ (_))" and "MinisatProofStep.Conflict ((_),/ (_))" and "MinisatProofStep.Delete" and "MinisatProofStep.Xstep ((_),/ (_))")
   25.14 -
   25.15 -export_code checker tchecker lchecker in SML
   25.16 +export_code checker tchecker lchecker checking SML
   25.17  
   25.18  end
   25.19  
    26.1 --- a/src/HOL/Imperative_HOL/ex/Subarray.thy	Fri Mar 23 20:32:43 2012 +0100
    26.2 +++ b/src/HOL/Imperative_HOL/ex/Subarray.thy	Mon Mar 26 10:56:56 2012 +0200
    26.3 @@ -5,7 +5,7 @@
    26.4  header {* Theorems about sub arrays *}
    26.5  
    26.6  theory Subarray
    26.7 -imports Array Sublist
    26.8 +imports "~~/src/HOL/Imperative_HOL/Array" Sublist
    26.9  begin
   26.10  
   26.11  definition subarray :: "nat \<Rightarrow> nat \<Rightarrow> ('a::heap) array \<Rightarrow> heap \<Rightarrow> 'a list" where
    27.1 --- a/src/HOL/Import/HOL_Light/HOLLightInt.thy	Fri Mar 23 20:32:43 2012 +0100
    27.2 +++ b/src/HOL/Import/HOL_Light/HOLLightInt.thy	Mon Mar 26 10:56:56 2012 +0200
    27.3 @@ -40,7 +40,7 @@
    27.4  
    27.5  lemma DEF_int_mul:
    27.6    "op * = (\<lambda>u ua. floor (real u * real ua))"
    27.7 -  by (metis floor_number_of number_of_is_id number_of_real_def real_eq_of_int real_of_int_mult)
    27.8 +  by (metis floor_real_of_int real_of_int_mult)
    27.9  
   27.10  lemma DEF_int_abs:
   27.11    "abs = (\<lambda>u. floor (abs (real u)))"
   27.12 @@ -72,7 +72,7 @@
   27.13  
   27.14  lemma INT_IMAGE:
   27.15    "(\<exists>n. x = int n) \<or> (\<exists>n. x = - int n)"
   27.16 -  by (metis number_of_eq number_of_is_id of_int_of_nat)
   27.17 +  by (metis of_int_eq_id id_def of_int_of_nat)
   27.18  
   27.19  lemma DEF_int_pow:
   27.20    "op ^ = (\<lambda>u ua. floor (real u ^ ua))"
    28.1 --- a/src/HOL/Int.thy	Fri Mar 23 20:32:43 2012 +0100
    28.2 +++ b/src/HOL/Int.thy	Mon Mar 26 10:56:56 2012 +0200
    28.3 @@ -6,10 +6,9 @@
    28.4  header {* The Integers as Equivalence Classes over Pairs of Natural Numbers *} 
    28.5  
    28.6  theory Int
    28.7 -imports Equiv_Relations Nat Wellfounded
    28.8 +imports Equiv_Relations Wellfounded
    28.9  uses
   28.10    ("Tools/numeral.ML")
   28.11 -  ("Tools/numeral_syntax.ML")
   28.12    ("Tools/int_arith.ML")
   28.13  begin
   28.14  
   28.15 @@ -323,15 +322,20 @@
   28.16  lemma of_int_of_nat_eq [simp]: "of_int (int n) = of_nat n"
   28.17  by (induct n) auto
   28.18  
   28.19 +lemma of_int_numeral [simp, code_post]: "of_int (numeral k) = numeral k"
   28.20 +  by (simp add: of_nat_numeral [symmetric] of_int_of_nat_eq [symmetric])
   28.21 +
   28.22 +lemma of_int_neg_numeral [simp, code_post]: "of_int (neg_numeral k) = neg_numeral k"
   28.23 +  unfolding neg_numeral_def neg_numeral_class.neg_numeral_def
   28.24 +  by (simp only: of_int_minus of_int_numeral)
   28.25 +
   28.26  lemma of_int_power:
   28.27    "of_int (z ^ n) = of_int z ^ n"
   28.28    by (induct n) simp_all
   28.29  
   28.30  end
   28.31  
   28.32 -text{*Class for unital rings with characteristic zero.
   28.33 - Includes non-ordered rings like the complex numbers.*}
   28.34 -class ring_char_0 = ring_1 + semiring_char_0
   28.35 +context ring_char_0
   28.36  begin
   28.37  
   28.38  lemma of_int_eq_iff [simp]:
   28.39 @@ -579,230 +583,27 @@
   28.40  apply (simp add: int_def minus add diff_minus)
   28.41  done
   28.42  
   28.43 -
   28.44 -subsection {* Binary representation *}
   28.45 -
   28.46 -text {*
   28.47 -  This formalization defines binary arithmetic in terms of the integers
   28.48 -  rather than using a datatype. This avoids multiple representations (leading
   28.49 -  zeroes, etc.)  See @{text "ZF/Tools/twos-compl.ML"}, function @{text
   28.50 -  int_of_binary}, for the numerical interpretation.
   28.51 -
   28.52 -  The representation expects that @{text "(m mod 2)"} is 0 or 1,
   28.53 -  even if m is negative;
   28.54 -  For instance, @{text "-5 div 2 = -3"} and @{text "-5 mod 2 = 1"}; thus
   28.55 -  @{text "-5 = (-3)*2 + 1"}.
   28.56 -  
   28.57 -  This two's complement binary representation derives from the paper 
   28.58 -  "An Efficient Representation of Arithmetic for Term Rewriting" by
   28.59 -  Dave Cohen and Phil Watson, Rewriting Techniques and Applications,
   28.60 -  Springer LNCS 488 (240-251), 1991.
   28.61 -*}
   28.62 -
   28.63 -subsubsection {* The constructors @{term Bit0}, @{term Bit1}, @{term Pls} and @{term Min} *}
   28.64 -
   28.65 -definition Pls :: int where
   28.66 -  "Pls = 0"
   28.67 +lemma Let_numeral [simp]: "Let (numeral v) f = f (numeral v)"
   28.68 +  -- {* Unfold all @{text let}s involving constants *}
   28.69 +  unfolding Let_def ..
   28.70  
   28.71 -definition Min :: int where
   28.72 -  "Min = - 1"
   28.73 -
   28.74 -definition Bit0 :: "int \<Rightarrow> int" where
   28.75 -  "Bit0 k = k + k"
   28.76 -
   28.77 -definition Bit1 :: "int \<Rightarrow> int" where
   28.78 -  "Bit1 k = 1 + k + k"
   28.79 -
   28.80 -class number = -- {* for numeric types: nat, int, real, \dots *}
   28.81 -  fixes number_of :: "int \<Rightarrow> 'a"
   28.82 -
   28.83 -use "Tools/numeral.ML"
   28.84 -
   28.85 -syntax
   28.86 -  "_Numeral" :: "num_const \<Rightarrow> 'a"    ("_")
   28.87 -
   28.88 -use "Tools/numeral_syntax.ML"
   28.89 -setup Numeral_Syntax.setup
   28.90 -
   28.91 -abbreviation
   28.92 -  "Numeral0 \<equiv> number_of Pls"
   28.93 -
   28.94 -abbreviation
   28.95 -  "Numeral1 \<equiv> number_of (Bit1 Pls)"
   28.96 -
   28.97 -lemma Let_number_of [simp]: "Let (number_of v) f = f (number_of v)"
   28.98 +lemma Let_neg_numeral [simp]: "Let (neg_numeral v) f = f (neg_numeral v)"
   28.99    -- {* Unfold all @{text let}s involving constants *}
  28.100    unfolding Let_def ..
  28.101  
  28.102 -definition succ :: "int \<Rightarrow> int" where
  28.103 -  "succ k = k + 1"
  28.104 -
  28.105 -definition pred :: "int \<Rightarrow> int" where
  28.106 -  "pred k = k - 1"
  28.107 -
  28.108 -lemmas max_number_of [simp] = max_def [of "number_of u" "number_of v"]
  28.109 -  and min_number_of [simp] = min_def [of "number_of u" "number_of v"]
  28.110 -  for u v
  28.111 -  -- {* unfolding @{text minx} and @{text max} on numerals *}
  28.112 -
  28.113 -lemmas numeral_simps = 
  28.114 -  succ_def pred_def Pls_def Min_def Bit0_def Bit1_def
  28.115 -
  28.116 -text {* Removal of leading zeroes *}
  28.117 -
  28.118 -lemma Bit0_Pls [simp, code_post]:
  28.119 -  "Bit0 Pls = Pls"
  28.120 -  unfolding numeral_simps by simp
  28.121 -
  28.122 -lemma Bit1_Min [simp, code_post]:
  28.123 -  "Bit1 Min = Min"
  28.124 -  unfolding numeral_simps by simp
  28.125 -
  28.126 -lemmas normalize_bin_simps =
  28.127 -  Bit0_Pls Bit1_Min
  28.128 -
  28.129 -
  28.130 -subsubsection {* Successor and predecessor functions *}
  28.131 -
  28.132 -text {* Successor *}
  28.133 -
  28.134 -lemma succ_Pls:
  28.135 -  "succ Pls = Bit1 Pls"
  28.136 -  unfolding numeral_simps by simp
  28.137 -
  28.138 -lemma succ_Min:
  28.139 -  "succ Min = Pls"
  28.140 -  unfolding numeral_simps by simp
  28.141 -
  28.142 -lemma succ_Bit0:
  28.143 -  "succ (Bit0 k) = Bit1 k"
  28.144 -  unfolding numeral_simps by simp
  28.145 -
  28.146 -lemma succ_Bit1:
  28.147 -  "succ (Bit1 k) = Bit0 (succ k)"
  28.148 -  unfolding numeral_simps by simp
  28.149 -
  28.150 -lemmas succ_bin_simps [simp] =
  28.151 -  succ_Pls succ_Min succ_Bit0 succ_Bit1
  28.152 -
  28.153 -text {* Predecessor *}
  28.154 -
  28.155 -lemma pred_Pls:
  28.156 -  "pred Pls = Min"
  28.157 -  unfolding numeral_simps by simp
  28.158 -
  28.159 -lemma pred_Min:
  28.160 -  "pred Min = Bit0 Min"
  28.161 -  unfolding numeral_simps by simp
  28.162 -
  28.163 -lemma pred_Bit0:
  28.164 -  "pred (Bit0 k) = Bit1 (pred k)"
  28.165 -  unfolding numeral_simps by simp 
  28.166 -
  28.167 -lemma pred_Bit1:
  28.168 -  "pred (Bit1 k) = Bit0 k"
  28.169 -  unfolding numeral_simps by simp
  28.170 -
  28.171 -lemmas pred_bin_simps [simp] =
  28.172 -  pred_Pls pred_Min pred_Bit0 pred_Bit1
  28.173 -
  28.174 -
  28.175 -subsubsection {* Binary arithmetic *}
  28.176 -
  28.177 -text {* Addition *}
  28.178 -
  28.179 -lemma add_Pls:
  28.180 -  "Pls + k = k"
  28.181 -  unfolding numeral_simps by simp
  28.182 -
  28.183 -lemma add_Min:
  28.184 -  "Min + k = pred k"
  28.185 -  unfolding numeral_simps by simp
  28.186 +text {* Unfold @{text min} and @{text max} on numerals. *}
  28.187  
  28.188 -lemma add_Bit0_Bit0:
  28.189 -  "(Bit0 k) + (Bit0 l) = Bit0 (k + l)"
  28.190 -  unfolding numeral_simps by simp
  28.191 -
  28.192 -lemma add_Bit0_Bit1:
  28.193 -  "(Bit0 k) + (Bit1 l) = Bit1 (k + l)"
  28.194 -  unfolding numeral_simps by simp
  28.195 -
  28.196 -lemma add_Bit1_Bit0:
  28.197 -  "(Bit1 k) + (Bit0 l) = Bit1 (k + l)"
  28.198 -  unfolding numeral_simps by simp
  28.199 -
  28.200 -lemma add_Bit1_Bit1:
  28.201 -  "(Bit1 k) + (Bit1 l) = Bit0 (k + succ l)"
  28.202 -  unfolding numeral_simps by simp
  28.203 -
  28.204 -lemma add_Pls_right:
  28.205 -  "k + Pls = k"
  28.206 -  unfolding numeral_simps by simp
  28.207 -
  28.208 -lemma add_Min_right:
  28.209 -  "k + Min = pred k"
  28.210 -  unfolding numeral_simps by simp
  28.211 -
  28.212 -lemmas add_bin_simps [simp] =
  28.213 -  add_Pls add_Min add_Pls_right add_Min_right
  28.214 -  add_Bit0_Bit0 add_Bit0_Bit1 add_Bit1_Bit0 add_Bit1_Bit1
  28.215 -
  28.216 -text {* Negation *}
  28.217 -
  28.218 -lemma minus_Pls:
  28.219 -  "- Pls = Pls"
  28.220 -  unfolding numeral_simps by simp
  28.221 -
  28.222 -lemma minus_Min:
  28.223 -  "- Min = Bit1 Pls"
  28.224 -  unfolding numeral_simps by simp
  28.225 -
  28.226 -lemma minus_Bit0:
  28.227 -  "- (Bit0 k) = Bit0 (- k)"
  28.228 -  unfolding numeral_simps by simp
  28.229 +lemmas max_number_of [simp] =
  28.230 +  max_def [of "numeral u" "numeral v"]
  28.231 +  max_def [of "numeral u" "neg_numeral v"]
  28.232 +  max_def [of "neg_numeral u" "numeral v"]
  28.233 +  max_def [of "neg_numeral u" "neg_numeral v"] for u v
  28.234  
  28.235 -lemma minus_Bit1:
  28.236 -  "- (Bit1 k) = Bit1 (pred (- k))"
  28.237 -  unfolding numeral_simps by simp
  28.238 -
  28.239 -lemmas minus_bin_simps [simp] =
  28.240 -  minus_Pls minus_Min minus_Bit0 minus_Bit1
  28.241 -
  28.242 -text {* Subtraction *}
  28.243 -
  28.244 -lemma diff_bin_simps [simp]:
  28.245 -  "k - Pls = k"
  28.246 -  "k - Min = succ k"
  28.247 -  "Pls - (Bit0 l) = Bit0 (Pls - l)"
  28.248 -  "Pls - (Bit1 l) = Bit1 (Min - l)"
  28.249 -  "Min - (Bit0 l) = Bit1 (Min - l)"
  28.250 -  "Min - (Bit1 l) = Bit0 (Min - l)"
  28.251 -  "(Bit0 k) - (Bit0 l) = Bit0 (k - l)"
  28.252 -  "(Bit0 k) - (Bit1 l) = Bit1 (pred k - l)"
  28.253 -  "(Bit1 k) - (Bit0 l) = Bit1 (k - l)"
  28.254 -  "(Bit1 k) - (Bit1 l) = Bit0 (k - l)"
  28.255 -  unfolding numeral_simps by simp_all
  28.256 -
  28.257 -text {* Multiplication *}
  28.258 -
  28.259 -lemma mult_Pls:
  28.260 -  "Pls * w = Pls"
  28.261 -  unfolding numeral_simps by simp
  28.262 -
  28.263 -lemma mult_Min:
  28.264 -  "Min * k = - k"
  28.265 -  unfolding numeral_simps by simp
  28.266 -
  28.267 -lemma mult_Bit0:
  28.268 -  "(Bit0 k) * l = Bit0 (k * l)"
  28.269 -  unfolding numeral_simps int_distrib by simp
  28.270 -
  28.271 -lemma mult_Bit1:
  28.272 -  "(Bit1 k) * l = (Bit0 (k * l)) + l"
  28.273 -  unfolding numeral_simps int_distrib by simp
  28.274 -
  28.275 -lemmas mult_bin_simps [simp] =
  28.276 -  mult_Pls mult_Min mult_Bit0 mult_Bit1
  28.277 +lemmas min_number_of [simp] =
  28.278 +  min_def [of "numeral u" "numeral v"]
  28.279 +  min_def [of "numeral u" "neg_numeral v"]
  28.280 +  min_def [of "neg_numeral u" "numeral v"]
  28.281 +  min_def [of "neg_numeral u" "neg_numeral v"] for u v
  28.282  
  28.283  
  28.284  subsubsection {* Binary comparisons *}
  28.285 @@ -812,7 +613,7 @@
  28.286  lemma even_less_0_iff:
  28.287    "a + a < 0 \<longleftrightarrow> a < (0::'a::linordered_idom)"
  28.288  proof -
  28.289 -  have "a + a < 0 \<longleftrightarrow> (1+1)*a < 0" by (simp add: left_distrib)
  28.290 +  have "a + a < 0 \<longleftrightarrow> (1+1)*a < 0" by (simp add: left_distrib del: one_add_one)
  28.291    also have "(1+1)*a < 0 \<longleftrightarrow> a < 0"
  28.292      by (simp add: mult_less_0_iff zero_less_two 
  28.293                    order_less_not_sym [OF zero_less_two])
  28.294 @@ -824,7 +625,7 @@
  28.295    shows "(0::int) < 1 + z"
  28.296  proof -
  28.297    have "0 \<le> z" by fact
  28.298 -  also have "... < z + 1" by (rule less_add_one) 
  28.299 +  also have "... < z + 1" by (rule less_add_one)
  28.300    also have "... = 1 + z" by (simp add: add_ac)
  28.301    finally show "0 < 1 + z" .
  28.302  qed
  28.303 @@ -841,276 +642,6 @@
  28.304      add: algebra_simps of_nat_1 [where 'a=int, symmetric] of_nat_add [symmetric])
  28.305  qed
  28.306  
  28.307 -lemma bin_less_0_simps:
  28.308 -  "Pls < 0 \<longleftrightarrow> False"
  28.309 -  "Min < 0 \<longleftrightarrow> True"
  28.310 -  "Bit0 w < 0 \<longleftrightarrow> w < 0"
  28.311 -  "Bit1 w < 0 \<longleftrightarrow> w < 0"
  28.312 -  unfolding numeral_simps
  28.313 -  by (simp_all add: even_less_0_iff odd_less_0_iff)
  28.314 -
  28.315 -lemma less_bin_lemma: "k < l \<longleftrightarrow> k - l < (0::int)"
  28.316 -  by simp
  28.317 -
  28.318 -lemma le_iff_pred_less: "k \<le> l \<longleftrightarrow> pred k < l"
  28.319 -  unfolding numeral_simps
  28.320 -  proof
  28.321 -    have "k - 1 < k" by simp
  28.322 -    also assume "k \<le> l"
  28.323 -    finally show "k - 1 < l" .
  28.324 -  next
  28.325 -    assume "k - 1 < l"
  28.326 -    hence "(k - 1) + 1 \<le> l" by (rule zless_imp_add1_zle)
  28.327 -    thus "k \<le> l" by simp
  28.328 -  qed
  28.329 -
  28.330 -lemma succ_pred: "succ (pred x) = x"
  28.331 -  unfolding numeral_simps by simp
  28.332 -
  28.333 -text {* Less-than *}
  28.334 -
  28.335 -lemma less_bin_simps [simp]:
  28.336 -  "Pls < Pls \<longleftrightarrow> False"
  28.337 -  "Pls < Min \<longleftrightarrow> False"
  28.338 -  "Pls < Bit0 k \<longleftrightarrow> Pls < k"
  28.339 -  "Pls < Bit1 k \<longleftrightarrow> Pls \<le> k"
  28.340 -  "Min < Pls \<longleftrightarrow> True"
  28.341 -  "Min < Min \<longleftrightarrow> False"
  28.342 -  "Min < Bit0 k \<longleftrightarrow> Min < k"
  28.343 -  "Min < Bit1 k \<longleftrightarrow> Min < k"
  28.344 -  "Bit0 k < Pls \<longleftrightarrow> k < Pls"
  28.345 -  "Bit0 k < Min \<longleftrightarrow> k \<le> Min"
  28.346 -  "Bit1 k < Pls \<longleftrightarrow> k < Pls"
  28.347 -  "Bit1 k < Min \<longleftrightarrow> k < Min"
  28.348 -  "Bit0 k < Bit0 l \<longleftrightarrow> k < l"
  28.349 -  "Bit0 k < Bit1 l \<longleftrightarrow> k \<le> l"
  28.350 -  "Bit1 k < Bit0 l \<longleftrightarrow> k < l"
  28.351 -  "Bit1 k < Bit1 l \<longleftrightarrow> k < l"
  28.352 -  unfolding le_iff_pred_less
  28.353 -    less_bin_lemma [of Pls]
  28.354 -    less_bin_lemma [of Min]
  28.355 -    less_bin_lemma [of "k"]
  28.356 -    less_bin_lemma [of "Bit0 k"]
  28.357 -    less_bin_lemma [of "Bit1 k"]
  28.358 -    less_bin_lemma [of "pred Pls"]
  28.359 -    less_bin_lemma [of "pred k"]
  28.360 -  by (simp_all add: bin_less_0_simps succ_pred)
  28.361 -
  28.362 -text {* Less-than-or-equal *}
  28.363 -
  28.364 -lemma le_bin_simps [simp]:
  28.365 -  "Pls \<le> Pls \<longleftrightarrow> True"
  28.366 -  "Pls \<le> Min \<longleftrightarrow> False"
  28.367 -  "Pls \<le> Bit0 k \<longleftrightarrow> Pls \<le> k"
  28.368 -  "Pls \<le> Bit1 k \<longleftrightarrow> Pls \<le> k"
  28.369 -  "Min \<le> Pls \<longleftrightarrow> True"
  28.370 -  "Min \<le> Min \<longleftrightarrow> True"
  28.371 -  "Min \<le> Bit0 k \<longleftrightarrow> Min < k"
  28.372 -  "Min \<le> Bit1 k \<longleftrightarrow> Min \<le> k"
  28.373 -  "Bit0 k \<le> Pls \<longleftrightarrow> k \<le> Pls"
  28.374 -  "Bit0 k \<le> Min \<longleftrightarrow> k \<le> Min"
  28.375 -  "Bit1 k \<le> Pls \<longleftrightarrow> k < Pls"
  28.376 -  "Bit1 k \<le> Min \<longleftrightarrow> k \<le> Min"
  28.377 -  "Bit0 k \<le> Bit0 l \<longleftrightarrow> k \<le> l"
  28.378 -  "Bit0 k \<le> Bit1 l \<longleftrightarrow> k \<le> l"
  28.379 -  "Bit1 k \<le> Bit0 l \<longleftrightarrow> k < l"
  28.380 -  "Bit1 k \<le> Bit1 l \<longleftrightarrow> k \<le> l"
  28.381 -  unfolding not_less [symmetric]
  28.382 -  by (simp_all add: not_le)
  28.383 -
  28.384 -text {* Equality *}
  28.385 -
  28.386 -lemma eq_bin_simps [simp]:
  28.387 -  "Pls = Pls \<longleftrightarrow> True"
  28.388 -  "Pls = Min \<longleftrightarrow> False"
  28.389 -  "Pls = Bit0 l \<longleftrightarrow> Pls = l"
  28.390 -  "Pls = Bit1 l \<longleftrightarrow> False"
  28.391 -  "Min = Pls \<longleftrightarrow> False"
  28.392 -  "Min = Min \<longleftrightarrow> True"
  28.393 -  "Min = Bit0 l \<longleftrightarrow> False"
  28.394 -  "Min = Bit1 l \<longleftrightarrow> Min = l"
  28.395 -  "Bit0 k = Pls \<longleftrightarrow> k = Pls"
  28.396 -  "Bit0 k = Min \<longleftrightarrow> False"
  28.397 -  "Bit1 k = Pls \<longleftrightarrow> False"
  28.398 -  "Bit1 k = Min \<longleftrightarrow> k = Min"
  28.399 -  "Bit0 k = Bit0 l \<longleftrightarrow> k = l"
  28.400 -  "Bit0 k = Bit1 l \<longleftrightarrow> False"
  28.401 -  "Bit1 k = Bit0 l \<longleftrightarrow> False"
  28.402 -  "Bit1 k = Bit1 l \<longleftrightarrow> k = l"
  28.403 -  unfolding order_eq_iff [where 'a=int]
  28.404 -  by (simp_all add: not_less)
  28.405 -
  28.406 -
  28.407 -subsection {* Converting Numerals to Rings: @{term number_of} *}
  28.408 -
  28.409 -class number_ring = number + comm_ring_1 +
  28.410 -  assumes number_of_eq: "number_of k = of_int k"
  28.411 -
  28.412 -class number_semiring = number + comm_semiring_1 +
  28.413 -  assumes number_of_int: "number_of (int n) = of_nat n"
  28.414 -
  28.415 -instance number_ring \<subseteq> number_semiring
  28.416 -proof
  28.417 -  fix n show "number_of (int n) = (of_nat n :: 'a)"
  28.418 -    unfolding number_of_eq by (rule of_int_of_nat_eq)
  28.419 -qed
  28.420 -
  28.421 -text {* self-embedding of the integers *}
  28.422 -
  28.423 -instantiation int :: number_ring
  28.424 -begin
  28.425 -
  28.426 -definition
  28.427 -  int_number_of_def: "number_of w = (of_int w \<Colon> int)"
  28.428 -
  28.429 -instance proof
  28.430 -qed (simp only: int_number_of_def)
  28.431 -
  28.432 -end
  28.433 -
  28.434 -lemma number_of_is_id:
  28.435 -  "number_of (k::int) = k"
  28.436 -  unfolding int_number_of_def by simp
  28.437 -
  28.438 -lemma number_of_succ:
  28.439 -  "number_of (succ k) = (1 + number_of k ::'a::number_ring)"
  28.440 -  unfolding number_of_eq numeral_simps by simp
  28.441 -
  28.442 -lemma number_of_pred:
  28.443 -  "number_of (pred w) = (- 1 + number_of w ::'a::number_ring)"
  28.444 -  unfolding number_of_eq numeral_simps by simp
  28.445 -
  28.446 -lemma number_of_minus:
  28.447 -  "number_of (uminus w) = (- (number_of w)::'a::number_ring)"
  28.448 -  unfolding number_of_eq by (rule of_int_minus)
  28.449 -
  28.450 -lemma number_of_add:
  28.451 -  "number_of (v + w) = (number_of v + number_of w::'a::number_ring)"
  28.452 -  unfolding number_of_eq by (rule of_int_add)
  28.453 -
  28.454 -lemma number_of_diff:
  28.455 -  "number_of (v - w) = (number_of v - number_of w::'a::number_ring)"
  28.456 -  unfolding number_of_eq by (rule of_int_diff)
  28.457 -
  28.458 -lemma number_of_mult:
  28.459 -  "number_of (v * w) = (number_of v * number_of w::'a::number_ring)"
  28.460 -  unfolding number_of_eq by (rule of_int_mult)
  28.461 -
  28.462 -text {*
  28.463 -  The correctness of shifting.
  28.464 -  But it doesn't seem to give a measurable speed-up.
  28.465 -*}
  28.466 -
  28.467 -lemma double_number_of_Bit0:
  28.468 -  "(1 + 1) * number_of w = (number_of (Bit0 w) ::'a::number_ring)"
  28.469 -  unfolding number_of_eq numeral_simps left_distrib by simp
  28.470 -
  28.471 -text {*
  28.472 -  Converting numerals 0 and 1 to their abstract versions.
  28.473 -*}
  28.474 -
  28.475 -lemma semiring_numeral_0_eq_0 [simp, code_post]:
  28.476 -  "Numeral0 = (0::'a::number_semiring)"
  28.477 -  using number_of_int [where 'a='a and n=0]
  28.478 -  unfolding numeral_simps by simp
  28.479 -
  28.480 -lemma semiring_numeral_1_eq_1 [simp, code_post]:
  28.481 -  "Numeral1 = (1::'a::number_semiring)"
  28.482 -  using number_of_int [where 'a='a and n=1]
  28.483 -  unfolding numeral_simps by simp
  28.484 -
  28.485 -lemma numeral_0_eq_0: (* FIXME delete candidate *)
  28.486 -  "Numeral0 = (0::'a::number_ring)"
  28.487 -  by (rule semiring_numeral_0_eq_0)
  28.488 -
  28.489 -lemma numeral_1_eq_1: (* FIXME delete candidate *)
  28.490 -  "Numeral1 = (1::'a::number_ring)"
  28.491 -  by (rule semiring_numeral_1_eq_1)
  28.492 -
  28.493 -text {*
  28.494 -  Special-case simplification for small constants.
  28.495 -*}
  28.496 -
  28.497 -text{*
  28.498 -  Unary minus for the abstract constant 1. Cannot be inserted
  28.499 -  as a simprule until later: it is @{text number_of_Min} re-oriented!
  28.500 -*}
  28.501 -
  28.502 -lemma numeral_m1_eq_minus_1:
  28.503 -  "(-1::'a::number_ring) = - 1"
  28.504 -  unfolding number_of_eq numeral_simps by simp
  28.505 -
  28.506 -lemma mult_minus1 [simp]:
  28.507 -  "-1 * z = -(z::'a::number_ring)"
  28.508 -  unfolding number_of_eq numeral_simps by simp
  28.509 -
  28.510 -lemma mult_minus1_right [simp]:
  28.511 -  "z * -1 = -(z::'a::number_ring)"
  28.512 -  unfolding number_of_eq numeral_simps by simp
  28.513 -
  28.514 -(*Negation of a coefficient*)
  28.515 -lemma minus_number_of_mult [simp]:
  28.516 -   "- (number_of w) * z = number_of (uminus w) * (z::'a::number_ring)"
  28.517 -   unfolding number_of_eq by simp
  28.518 -
  28.519 -text {* Subtraction *}
  28.520 -
  28.521 -lemma diff_number_of_eq:
  28.522 -  "number_of v - number_of w =
  28.523 -    (number_of (v + uminus w)::'a::number_ring)"
  28.524 -  unfolding number_of_eq by simp
  28.525 -
  28.526 -lemma number_of_Pls:
  28.527 -  "number_of Pls = (0::'a::number_ring)"
  28.528 -  unfolding number_of_eq numeral_simps by simp
  28.529 -
  28.530 -lemma number_of_Min:
  28.531 -  "number_of Min = (- 1::'a::number_ring)"
  28.532 -  unfolding number_of_eq numeral_simps by simp
  28.533 -
  28.534 -lemma number_of_Bit0:
  28.535 -  "number_of (Bit0 w) = (0::'a::number_ring) + (number_of w) + (number_of w)"
  28.536 -  unfolding number_of_eq numeral_simps by simp
  28.537 -
  28.538 -lemma number_of_Bit1:
  28.539 -  "number_of (Bit1 w) = (1::'a::number_ring) + (number_of w) + (number_of w)"
  28.540 -  unfolding number_of_eq numeral_simps by simp
  28.541 -
  28.542 -
  28.543 -subsubsection {* Equality of Binary Numbers *}
  28.544 -
  28.545 -text {* First version by Norbert Voelker *}
  28.546 -
  28.547 -definition (*for simplifying equalities*) iszero :: "'a\<Colon>semiring_1 \<Rightarrow> bool" where
  28.548 -  "iszero z \<longleftrightarrow> z = 0"
  28.549 -
  28.550 -lemma iszero_0: "iszero 0"
  28.551 -  by (simp add: iszero_def)
  28.552 -
  28.553 -lemma iszero_Numeral0: "iszero (Numeral0 :: 'a::number_ring)"
  28.554 -  by (simp add: iszero_0)
  28.555 -
  28.556 -lemma not_iszero_1: "\<not> iszero 1"
  28.557 -  by (simp add: iszero_def)
  28.558 -
  28.559 -lemma not_iszero_Numeral1: "\<not> iszero (Numeral1 :: 'a::number_ring)"
  28.560 -  by (simp add: not_iszero_1)
  28.561 -
  28.562 -lemma eq_number_of_eq [simp]:
  28.563 -  "((number_of x::'a::number_ring) = number_of y) =
  28.564 -     iszero (number_of (x + uminus y) :: 'a)"
  28.565 -unfolding iszero_def number_of_add number_of_minus
  28.566 -by (simp add: algebra_simps)
  28.567 -
  28.568 -lemma iszero_number_of_Pls:
  28.569 -  "iszero ((number_of Pls)::'a::number_ring)"
  28.570 -unfolding iszero_def numeral_0_eq_0 ..
  28.571 -
  28.572 -lemma nonzero_number_of_Min:
  28.573 -  "~ iszero ((number_of Min)::'a::number_ring)"
  28.574 -unfolding iszero_def numeral_m1_eq_minus_1 by simp
  28.575 -
  28.576 -
  28.577  subsubsection {* Comparisons, for Ordered Rings *}
  28.578  
  28.579  lemmas double_eq_0_iff = double_zero
  28.580 @@ -1137,129 +668,6 @@
  28.581    qed
  28.582  qed
  28.583  
  28.584 -lemma iszero_number_of_Bit0:
  28.585 -  "iszero (number_of (Bit0 w)::'a) = 
  28.586 -   iszero (number_of w::'a::{ring_char_0,number_ring})"
  28.587 -proof -
  28.588 -  have "(of_int w + of_int w = (0::'a)) \<Longrightarrow> (w = 0)"
  28.589 -  proof -
  28.590 -    assume eq: "of_int w + of_int w = (0::'a)"
  28.591 -    then have "of_int (w + w) = (of_int 0 :: 'a)" by simp
  28.592 -    then have "w + w = 0" by (simp only: of_int_eq_iff)
  28.593 -    then show "w = 0" by (simp only: double_eq_0_iff)
  28.594 -  qed
  28.595 -  thus ?thesis
  28.596 -    by (auto simp add: iszero_def number_of_eq numeral_simps)
  28.597 -qed
  28.598 -
  28.599 -lemma iszero_number_of_Bit1:
  28.600 -  "~ iszero (number_of (Bit1 w)::'a::{ring_char_0,number_ring})"
  28.601 -proof -
  28.602 -  have "1 + of_int w + of_int w \<noteq> (0::'a)"
  28.603 -  proof
  28.604 -    assume eq: "1 + of_int w + of_int w = (0::'a)"
  28.605 -    hence "of_int (1 + w + w) = (of_int 0 :: 'a)" by simp 
  28.606 -    hence "1 + w + w = 0" by (simp only: of_int_eq_iff)
  28.607 -    with odd_nonzero show False by blast
  28.608 -  qed
  28.609 -  thus ?thesis
  28.610 -    by (auto simp add: iszero_def number_of_eq numeral_simps)
  28.611 -qed
  28.612 -
  28.613 -lemmas iszero_simps [simp] =
  28.614 -  iszero_0 not_iszero_1
  28.615 -  iszero_number_of_Pls nonzero_number_of_Min
  28.616 -  iszero_number_of_Bit0 iszero_number_of_Bit1
  28.617 -(* iszero_number_of_Pls would never normally be used
  28.618 -   because its lhs simplifies to "iszero 0" *)
  28.619 -
  28.620 -text {* Less-Than or Equals *}
  28.621 -
  28.622 -text {* Reduces @{term "a\<le>b"} to @{term "~ (b<a)"} for ALL numerals. *}
  28.623 -
  28.624 -lemmas le_number_of_eq_not_less =
  28.625 -  linorder_not_less [of "number_of w" "number_of v", symmetric] for w v
  28.626 -
  28.627 -
  28.628 -text {* Absolute value (@{term abs}) *}
  28.629 -
  28.630 -lemma abs_number_of:
  28.631 -  "abs(number_of x::'a::{linordered_idom,number_ring}) =
  28.632 -   (if number_of x < (0::'a) then -number_of x else number_of x)"
  28.633 -  by (simp add: abs_if)
  28.634 -
  28.635 -
  28.636 -text {* Re-orientation of the equation nnn=x *}
  28.637 -
  28.638 -lemma number_of_reorient:
  28.639 -  "(number_of w = x) = (x = number_of w)"
  28.640 -  by auto
  28.641 -
  28.642 -
  28.643 -subsubsection {* Simplification of arithmetic operations on integer constants. *}
  28.644 -
  28.645 -lemmas arith_extra_simps [simp] =
  28.646 -  number_of_add [symmetric]
  28.647 -  number_of_minus [symmetric]
  28.648 -  numeral_m1_eq_minus_1 [symmetric]
  28.649 -  number_of_mult [symmetric]
  28.650 -  diff_number_of_eq abs_number_of
  28.651 -
  28.652 -text {*
  28.653 -  For making a minimal simpset, one must include these default simprules.
  28.654 -  Also include @{text simp_thms}.
  28.655 -*}
  28.656 -
  28.657 -lemmas arith_simps = 
  28.658 -  normalize_bin_simps pred_bin_simps succ_bin_simps
  28.659 -  add_bin_simps minus_bin_simps mult_bin_simps
  28.660 -  abs_zero abs_one arith_extra_simps
  28.661 -
  28.662 -text {* Simplification of relational operations *}
  28.663 -
  28.664 -lemma less_number_of [simp]:
  28.665 -  "(number_of x::'a::{linordered_idom,number_ring}) < number_of y \<longleftrightarrow> x < y"
  28.666 -  unfolding number_of_eq by (rule of_int_less_iff)
  28.667 -
  28.668 -lemma le_number_of [simp]:
  28.669 -  "(number_of x::'a::{linordered_idom,number_ring}) \<le> number_of y \<longleftrightarrow> x \<le> y"
  28.670 -  unfolding number_of_eq by (rule of_int_le_iff)
  28.671 -
  28.672 -lemma eq_number_of [simp]:
  28.673 -  "(number_of x::'a::{ring_char_0,number_ring}) = number_of y \<longleftrightarrow> x = y"
  28.674 -  unfolding number_of_eq by (rule of_int_eq_iff)
  28.675 -
  28.676 -lemmas rel_simps =
  28.677 -  less_number_of less_bin_simps
  28.678 -  le_number_of le_bin_simps
  28.679 -  eq_number_of_eq eq_bin_simps
  28.680 -  iszero_simps
  28.681 -
  28.682 -
  28.683 -subsubsection {* Simplification of arithmetic when nested to the right. *}
  28.684 -
  28.685 -lemma add_number_of_left [simp]:
  28.686 -  "number_of v + (number_of w + z) =
  28.687 -   (number_of(v + w) + z::'a::number_ring)"
  28.688 -  by (simp add: add_assoc [symmetric])
  28.689 -
  28.690 -lemma mult_number_of_left [simp]:
  28.691 -  "number_of v * (number_of w * z) =
  28.692 -   (number_of(v * w) * z::'a::number_ring)"
  28.693 -  by (simp add: mult_assoc [symmetric])
  28.694 -
  28.695 -lemma add_number_of_diff1:
  28.696 -  "number_of v + (number_of w - c) = 
  28.697 -  number_of(v + w) - (c::'a::number_ring)"
  28.698 -  by (simp add: diff_minus)
  28.699 -
  28.700 -lemma add_number_of_diff2 [simp]:
  28.701 -  "number_of v + (c - number_of w) =
  28.702 -   number_of (v + uminus w) + (c::'a::number_ring)"
  28.703 -by (simp add: algebra_simps diff_number_of_eq [symmetric])
  28.704 -
  28.705 -
  28.706 -
  28.707  
  28.708  subsection {* The Set of Integers *}
  28.709  
  28.710 @@ -1363,14 +771,8 @@
  28.711    qed
  28.712  qed 
  28.713  
  28.714 -lemma Ints_number_of [simp]:
  28.715 -  "(number_of w :: 'a::number_ring) \<in> Ints"
  28.716 -  unfolding number_of_eq Ints_def by simp
  28.717 -
  28.718 -lemma Nats_number_of [simp]:
  28.719 -  "Int.Pls \<le> w \<Longrightarrow> (number_of w :: 'a::number_ring) \<in> Nats"
  28.720 -unfolding Int.Pls_def number_of_eq
  28.721 -by (simp only: of_nat_nat [symmetric] of_nat_in_Nats)
  28.722 +lemma Nats_numeral [simp]: "numeral w \<in> Nats"
  28.723 +  using of_nat_in_Nats [of "numeral w"] by simp
  28.724  
  28.725  lemma Ints_odd_less_0: 
  28.726    assumes in_Ints: "a \<in> Ints"
  28.727 @@ -1412,100 +814,16 @@
  28.728  lemmas int_setprod = of_nat_setprod [where 'a=int]
  28.729  
  28.730  
  28.731 -subsection{*Inequality Reasoning for the Arithmetic Simproc*}
  28.732 -
  28.733 -lemma add_numeral_0: "Numeral0 + a = (a::'a::number_ring)"
  28.734 -by simp 
  28.735 -
  28.736 -lemma add_numeral_0_right: "a + Numeral0 = (a::'a::number_ring)"
  28.737 -by simp
  28.738 -
  28.739 -lemma mult_numeral_1: "Numeral1 * a = (a::'a::number_ring)"
  28.740 -by simp 
  28.741 -
  28.742 -lemma mult_numeral_1_right: "a * Numeral1 = (a::'a::number_ring)"
  28.743 -by simp
  28.744 -
  28.745 -lemma divide_numeral_1: "a / Numeral1 = (a::'a::{number_ring,field})"
  28.746 -by simp
  28.747 -
  28.748 -lemma inverse_numeral_1:
  28.749 -  "inverse Numeral1 = (Numeral1::'a::{number_ring,field})"
  28.750 -by simp
  28.751 -
  28.752 -text{*Theorem lists for the cancellation simprocs. The use of binary numerals
  28.753 -for 0 and 1 reduces the number of special cases.*}
  28.754 -
  28.755 -lemmas add_0s = add_numeral_0 add_numeral_0_right
  28.756 -lemmas mult_1s = mult_numeral_1 mult_numeral_1_right 
  28.757 -                 mult_minus1 mult_minus1_right
  28.758 -
  28.759 -
  28.760 -subsection{*Special Arithmetic Rules for Abstract 0 and 1*}
  28.761 -
  28.762 -text{*Arithmetic computations are defined for binary literals, which leaves 0
  28.763 -and 1 as special cases. Addition already has rules for 0, but not 1.
  28.764 -Multiplication and unary minus already have rules for both 0 and 1.*}
  28.765 -
  28.766 -
  28.767 -lemma binop_eq: "[|f x y = g x y; x = x'; y = y'|] ==> f x' y' = g x' y'"
  28.768 -by simp
  28.769 -
  28.770 -
  28.771 -lemmas add_number_of_eq = number_of_add [symmetric]
  28.772 -
  28.773 -text{*Allow 1 on either or both sides*}
  28.774 -lemma semiring_one_add_one_is_two: "1 + 1 = (2::'a::number_semiring)"
  28.775 -  using number_of_int [where 'a='a and n="Suc (Suc 0)"]
  28.776 -  by (simp add: numeral_simps)
  28.777 -
  28.778 -lemma one_add_one_is_two: "1 + 1 = (2::'a::number_ring)"
  28.779 -by (rule semiring_one_add_one_is_two)
  28.780 -
  28.781 -lemmas add_special =
  28.782 -    one_add_one_is_two
  28.783 -    binop_eq [of "op +", OF add_number_of_eq numeral_1_eq_1 refl]
  28.784 -    binop_eq [of "op +", OF add_number_of_eq refl numeral_1_eq_1]
  28.785 -
  28.786 -text{*Allow 1 on either or both sides (1-1 already simplifies to 0)*}
  28.787 -lemmas diff_special =
  28.788 -    binop_eq [of "op -", OF diff_number_of_eq numeral_1_eq_1 refl]
  28.789 -    binop_eq [of "op -", OF diff_number_of_eq refl numeral_1_eq_1]
  28.790 -
  28.791 -text{*Allow 0 or 1 on either side with a binary numeral on the other*}
  28.792 -lemmas eq_special =
  28.793 -    binop_eq [of "op =", OF eq_number_of_eq numeral_0_eq_0 refl]
  28.794 -    binop_eq [of "op =", OF eq_number_of_eq numeral_1_eq_1 refl]
  28.795 -    binop_eq [of "op =", OF eq_number_of_eq refl numeral_0_eq_0]
  28.796 -    binop_eq [of "op =", OF eq_number_of_eq refl numeral_1_eq_1]
  28.797 -
  28.798 -text{*Allow 0 or 1 on either side with a binary numeral on the other*}
  28.799 -lemmas less_special =
  28.800 -  binop_eq [of "op <", OF less_number_of numeral_0_eq_0 refl]
  28.801 -  binop_eq [of "op <", OF less_number_of numeral_1_eq_1 refl]
  28.802 -  binop_eq [of "op <", OF less_number_of refl numeral_0_eq_0]
  28.803 -  binop_eq [of "op <", OF less_number_of refl numeral_1_eq_1]
  28.804 -
  28.805 -text{*Allow 0 or 1 on either side with a binary numeral on the other*}
  28.806 -lemmas le_special =
  28.807 -    binop_eq [of "op \<le>", OF le_number_of numeral_0_eq_0 refl]
  28.808 -    binop_eq [of "op \<le>", OF le_number_of numeral_1_eq_1 refl]
  28.809 -    binop_eq [of "op \<le>", OF le_number_of refl numeral_0_eq_0]
  28.810 -    binop_eq [of "op \<le>", OF le_number_of refl numeral_1_eq_1]
  28.811 -
  28.812 -lemmas arith_special[simp] = 
  28.813 -       add_special diff_special eq_special less_special le_special
  28.814 -
  28.815 -
  28.816  text {* Legacy theorems *}
  28.817  
  28.818  lemmas zle_int = of_nat_le_iff [where 'a=int]
  28.819  lemmas int_int_eq = of_nat_eq_iff [where 'a=int]
  28.820 +lemmas numeral_1_eq_1 = numeral_One
  28.821  
  28.822  subsection {* Setting up simplification procedures *}
  28.823  
  28.824  lemmas int_arith_rules =
  28.825 -  neg_le_iff_le numeral_0_eq_0 numeral_1_eq_1
  28.826 +  neg_le_iff_le numeral_One
  28.827    minus_zero diff_minus left_minus right_minus
  28.828    mult_zero_left mult_zero_right mult_1_left mult_1_right
  28.829    mult_minus_left mult_minus_right
  28.830 @@ -1513,56 +831,39 @@
  28.831    of_nat_0 of_nat_1 of_nat_Suc of_nat_add of_nat_mult
  28.832    of_int_0 of_int_1 of_int_add of_int_mult
  28.833  
  28.834 +use "Tools/numeral.ML"
  28.835  use "Tools/int_arith.ML"
  28.836  declaration {* K Int_Arith.setup *}
  28.837  
  28.838 -simproc_setup fast_arith ("(m::'a::{linordered_idom,number_ring}) < n" |
  28.839 -  "(m::'a::{linordered_idom,number_ring}) <= n" |
  28.840 -  "(m::'a::{linordered_idom,number_ring}) = n") =
  28.841 +simproc_setup fast_arith ("(m::'a::linordered_idom) < n" |
  28.842 +  "(m::'a::linordered_idom) <= n" |
  28.843 +  "(m::'a::linordered_idom) = n") =
  28.844    {* fn _ => fn ss => fn ct => Lin_Arith.simproc ss (term_of ct) *}
  28.845  
  28.846  setup {*
  28.847    Reorient_Proc.add
  28.848 -    (fn Const (@{const_name number_of}, _) $ _ => true | _ => false)
  28.849 +    (fn Const (@{const_name numeral}, _) $ _ => true
  28.850 +    | Const (@{const_name neg_numeral}, _) $ _ => true
  28.851 +    | _ => false)
  28.852  *}
  28.853  
  28.854 -simproc_setup reorient_numeral ("number_of w = x") = Reorient_Proc.proc
  28.855 +simproc_setup reorient_numeral
  28.856 +  ("numeral w = x" | "neg_numeral w = y") = Reorient_Proc.proc
  28.857  
  28.858  
  28.859  subsection{*Lemmas About Small Numerals*}
  28.860  
  28.861 -lemma of_int_m1 [simp]: "of_int -1 = (-1 :: 'a :: number_ring)"
  28.862 -proof -
  28.863 -  have "(of_int -1 :: 'a) = of_int (- 1)" by simp
  28.864 -  also have "... = - of_int 1" by (simp only: of_int_minus)
  28.865 -  also have "... = -1" by simp
  28.866 -  finally show ?thesis .
  28.867 -qed
  28.868 -
  28.869 -lemma abs_minus_one [simp]: "abs (-1) = (1::'a::{linordered_idom,number_ring})"
  28.870 -by (simp add: abs_if)
  28.871 -
  28.872  lemma abs_power_minus_one [simp]:
  28.873 -  "abs(-1 ^ n) = (1::'a::{linordered_idom,number_ring})"
  28.874 +  "abs(-1 ^ n) = (1::'a::linordered_idom)"
  28.875  by (simp add: power_abs)
  28.876  
  28.877 -lemma of_int_number_of_eq [simp]:
  28.878 -     "of_int (number_of v) = (number_of v :: 'a :: number_ring)"
  28.879 -by (simp add: number_of_eq) 
  28.880 -
  28.881  text{*Lemmas for specialist use, NOT as default simprules*}
  28.882  (* TODO: see if semiring duplication can be removed without breaking proofs *)
  28.883 -lemma semiring_mult_2: "2 * z = (z+z::'a::number_semiring)"
  28.884 -unfolding semiring_one_add_one_is_two [symmetric] left_distrib by simp
  28.885 -
  28.886 -lemma semiring_mult_2_right: "z * 2 = (z+z::'a::number_semiring)"
  28.887 -by (subst mult_commute, rule semiring_mult_2)
  28.888 +lemma mult_2: "2 * z = (z+z::'a::semiring_1)"
  28.889 +unfolding one_add_one [symmetric] left_distrib by simp
  28.890  
  28.891 -lemma mult_2: "2 * z = (z+z::'a::number_ring)"
  28.892 -by (rule semiring_mult_2)
  28.893 -
  28.894 -lemma mult_2_right: "z * 2 = (z+z::'a::number_ring)"
  28.895 -by (rule semiring_mult_2_right)
  28.896 +lemma mult_2_right: "z * 2 = (z+z::'a::semiring_1)"
  28.897 +unfolding one_add_one [symmetric] right_distrib by simp
  28.898  
  28.899  
  28.900  subsection{*More Inequality Reasoning*}
  28.901 @@ -1608,7 +909,7 @@
  28.902  
  28.903  text{*This simplifies expressions of the form @{term "int n = z"} where
  28.904        z is an integer literal.*}
  28.905 -lemmas int_eq_iff_number_of [simp] = int_eq_iff [of _ "number_of v"] for v
  28.906 +lemmas int_eq_iff_numeral [simp] = int_eq_iff [of _ "numeral v"] for v
  28.907  
  28.908  lemma split_nat [arith_split]:
  28.909    "P(nat(i::int)) = ((\<forall>n. i = int n \<longrightarrow> P n) & (i < 0 \<longrightarrow> P 0))"
  28.910 @@ -1853,12 +1154,14 @@
  28.911        by (simp add: mn)
  28.912      finally have "2*\<bar>n\<bar> \<le> 1" .
  28.913      thus "False" using 0
  28.914 -      by auto
  28.915 +      by arith
  28.916    qed
  28.917    thus ?thesis using 0
  28.918      by auto
  28.919  qed
  28.920  
  28.921 +ML_val {* @{const_name neg_numeral} *}
  28.922 +
  28.923  lemma pos_zmult_eq_1_iff_lemma: "(m * n = 1) ==> m = (1::int) | m = -1"
  28.924  by (insert abs_zmult_eq_1 [of m n], arith)
  28.925  
  28.926 @@ -1894,125 +1197,170 @@
  28.927  
  28.928  text{*These distributive laws move literals inside sums and differences.*}
  28.929  
  28.930 -lemmas left_distrib_number_of [simp] = left_distrib [of _ _ "number_of v"] for v
  28.931 -lemmas right_distrib_number_of [simp] = right_distrib [of "number_of v"] for v
  28.932 -lemmas left_diff_distrib_number_of [simp] = left_diff_distrib [of _ _ "number_of v"] for v
  28.933 -lemmas right_diff_distrib_number_of [simp] = right_diff_distrib [of "number_of v"] for v
  28.934 +lemmas left_distrib_numeral [simp] = left_distrib [of _ _ "numeral v"] for v
  28.935 +lemmas right_distrib_numeral [simp] = right_distrib [of "numeral v"] for v
  28.936 +lemmas left_diff_distrib_numeral [simp] = left_diff_distrib [of _ _ "numeral v"] for v
  28.937 +lemmas right_diff_distrib_numeral [simp] = right_diff_distrib [of "numeral v"] for v
  28.938  
  28.939  text{*These are actually for fields, like real: but where else to put them?*}
  28.940  
  28.941 -lemmas zero_less_divide_iff_number_of [simp, no_atp] = zero_less_divide_iff [of "number_of w"] for w
  28.942 -lemmas divide_less_0_iff_number_of [simp, no_atp] = divide_less_0_iff [of "number_of w"] for w
  28.943 -lemmas zero_le_divide_iff_number_of [simp, no_atp] = zero_le_divide_iff [of "number_of w"] for w
  28.944 -lemmas divide_le_0_iff_number_of [simp, no_atp] = divide_le_0_iff [of "number_of w"] for w
  28.945 +lemmas zero_less_divide_iff_numeral [simp, no_atp] = zero_less_divide_iff [of "numeral w"] for w
  28.946 +lemmas divide_less_0_iff_numeral [simp, no_atp] = divide_less_0_iff [of "numeral w"] for w
  28.947 +lemmas zero_le_divide_iff_numeral [simp, no_atp] = zero_le_divide_iff [of "numeral w"] for w
  28.948 +lemmas divide_le_0_iff_numeral [simp, no_atp] = divide_le_0_iff [of "numeral w"] for w
  28.949  
  28.950  
  28.951  text {*Replaces @{text "inverse #nn"} by @{text "1/#nn"}.  It looks
  28.952    strange, but then other simprocs simplify the quotient.*}
  28.953  
  28.954 -lemmas inverse_eq_divide_number_of [simp] = inverse_eq_divide [of "number_of w"] for w
  28.955 +lemmas inverse_eq_divide_numeral [simp] =
  28.956 +  inverse_eq_divide [of "numeral w"] for w
  28.957 +
  28.958 +lemmas inverse_eq_divide_neg_numeral [simp] =
  28.959 +  inverse_eq_divide [of "neg_numeral w"] for w
  28.960  
  28.961  text {*These laws simplify inequalities, moving unary minus from a term
  28.962  into the literal.*}
  28.963  
  28.964 -lemmas less_minus_iff_number_of [simp, no_atp] = less_minus_iff [of "number_of v"] for v
  28.965 -lemmas le_minus_iff_number_of [simp, no_atp] = le_minus_iff [of "number_of v"] for v
  28.966 -lemmas equation_minus_iff_number_of [simp, no_atp] = equation_minus_iff [of "number_of v"] for v
  28.967 -lemmas minus_less_iff_number_of [simp, no_atp] = minus_less_iff [of _ "number_of v"] for v
  28.968 -lemmas minus_le_iff_number_of [simp, no_atp] = minus_le_iff [of _ "number_of v"] for v
  28.969 -lemmas minus_equation_iff_number_of [simp, no_atp] = minus_equation_iff [of _ "number_of v"] for v
  28.970 +lemmas le_minus_iff_numeral [simp, no_atp] =
  28.971 +  le_minus_iff [of "numeral v"]
  28.972 +  le_minus_iff [of "neg_numeral v"] for v
  28.973 +
  28.974 +lemmas equation_minus_iff_numeral [simp, no_atp] =
  28.975 +  equation_minus_iff [of "numeral v"]
  28.976 +  equation_minus_iff [of "neg_numeral v"] for v
  28.977 +
  28.978 +lemmas minus_less_iff_numeral [simp, no_atp] =
  28.979 +  minus_less_iff [of _ "numeral v"]
  28.980 +  minus_less_iff [of _ "neg_numeral v"] for v
  28.981 +
  28.982 +lemmas minus_le_iff_numeral [simp, no_atp] =
  28.983 +  minus_le_iff [of _ "numeral v"]
  28.984 +  minus_le_iff [of _ "neg_numeral v"] for v
  28.985 +
  28.986 +lemmas minus_equation_iff_numeral [simp, no_atp] =
  28.987 +  minus_equation_iff [of _ "numeral v"]
  28.988 +  minus_equation_iff [of _ "neg_numeral v"] for v
  28.989  
  28.990  text{*To Simplify Inequalities Where One Side is the Constant 1*}
  28.991  
  28.992  lemma less_minus_iff_1 [simp,no_atp]:
  28.993 -  fixes b::"'b::{linordered_idom,number_ring}"
  28.994 +  fixes b::"'b::linordered_idom"
  28.995    shows "(1 < - b) = (b < -1)"
  28.996  by auto
  28.997  
  28.998  lemma le_minus_iff_1 [simp,no_atp]:
  28.999 -  fixes b::"'b::{linordered_idom,number_ring}"
 28.1000 +  fixes b::"'b::linordered_idom"
 28.1001    shows "(1 \<le> - b) = (b \<le> -1)"
 28.1002  by auto
 28.1003  
 28.1004  lemma equation_minus_iff_1 [simp,no_atp]:
 28.1005 -  fixes b::"'b::number_ring"
 28.1006 +  fixes b::"'b::ring_1"
 28.1007    shows "(1 = - b) = (b = -1)"
 28.1008  by (subst equation_minus_iff, auto)
 28.1009  
 28.1010  lemma minus_less_iff_1 [simp,no_atp]:
 28.1011 -  fixes a::"'b::{linordered_idom,number_ring}"
 28.1012 +  fixes a::"'b::linordered_idom"
 28.1013    shows "(- a < 1) = (-1 < a)"
 28.1014  by auto
 28.1015  
 28.1016  lemma minus_le_iff_1 [simp,no_atp]:
 28.1017 -  fixes a::"'b::{linordered_idom,number_ring}"
 28.1018 +  fixes a::"'b::linordered_idom"
 28.1019    shows "(- a \<le> 1) = (-1 \<le> a)"
 28.1020  by auto
 28.1021  
 28.1022  lemma minus_equation_iff_1 [simp,no_atp]:
 28.1023 -  fixes a::"'b::number_ring"
 28.1024 +  fixes a::"'b::ring_1"
 28.1025    shows "(- a = 1) = (a = -1)"
 28.1026  by (subst minus_equation_iff, auto)
 28.1027  
 28.1028  
 28.1029  text {*Cancellation of constant factors in comparisons (@{text "<"} and @{text "\<le>"}) *}
 28.1030  
 28.1031 -lemmas mult_less_cancel_left_number_of [simp, no_atp] = mult_less_cancel_left [of "number_of v"] for v
 28.1032 -lemmas mult_less_cancel_right_number_of [simp, no_atp] = mult_less_cancel_right [of _ "number_of v"] for v
 28.1033 -lemmas mult_le_cancel_left_number_of [simp, no_atp] = mult_le_cancel_left [of "number_of v"] for v
 28.1034 -lemmas mult_le_cancel_right_number_of [simp, no_atp] = mult_le_cancel_right [of _ "number_of v"] for v
 28.1035 +lemmas mult_less_cancel_left_numeral [simp, no_atp] = mult_less_cancel_left [of "numeral v"] for v
 28.1036 +lemmas mult_less_cancel_right_numeral [simp, no_atp] = mult_less_cancel_right [of _ "numeral v"] for v
 28.1037 +lemmas mult_le_cancel_left_numeral [simp, no_atp] = mult_le_cancel_left [of "numeral v"] for v
 28.1038 +lemmas mult_le_cancel_right_numeral [simp, no_atp] = mult_le_cancel_right [of _ "numeral v"] for v
 28.1039  
 28.1040  
 28.1041  text {*Multiplying out constant divisors in comparisons (@{text "<"}, @{text "\<le>"} and @{text "="}) *}
 28.1042  
 28.1043 -lemmas le_divide_eq_number_of1 [simp] = le_divide_eq [of _ _ "number_of w"] for w
 28.1044 -lemmas divide_le_eq_number_of1 [simp] = divide_le_eq [of _ "number_of w"] for w
 28.1045 -lemmas less_divide_eq_number_of1 [simp] = less_divide_eq [of _ _ "number_of w"] for w
 28.1046 -lemmas divide_less_eq_number_of1 [simp] = divide_less_eq [of _ "number_of w"] for w
 28.1047 -lemmas eq_divide_eq_number_of1 [simp] = eq_divide_eq [of _ _ "number_of w"] for w
 28.1048 -lemmas divide_eq_eq_number_of1 [simp] = divide_eq_eq [of _ "number_of w"] for w
 28.1049 +lemmas le_divide_eq_numeral1 [simp] =
 28.1050 +  pos_le_divide_eq [of "numeral w", OF zero_less_numeral]
 28.1051 +  neg_le_divide_eq [of "neg_numeral w", OF neg_numeral_less_zero] for w
 28.1052 +
 28.1053 +lemmas divide_le_eq_numeral1 [simp] =
 28.1054 +  pos_divide_le_eq [of "numeral w", OF zero_less_numeral]
 28.1055 +  neg_divide_le_eq [of "neg_numeral w", OF neg_numeral_less_zero] for w
 28.1056 +
 28.1057 +lemmas less_divide_eq_numeral1 [simp] =
 28.1058 +  pos_less_divide_eq [of "numeral w", OF zero_less_numeral]
 28.1059 +  neg_less_divide_eq [of "neg_numeral w", OF neg_numeral_less_zero] for w
 28.1060  
 28.1061 +lemmas divide_less_eq_numeral1 [simp] =
 28.1062 +  pos_divide_less_eq [of "numeral w", OF zero_less_numeral]
 28.1063 +  neg_divide_less_eq [of "neg_numeral w", OF neg_numeral_less_zero] for w
 28.1064 +
 28.1065 +lemmas eq_divide_eq_numeral1 [simp] =
 28.1066 +  eq_divide_eq [of _ _ "numeral w"]
 28.1067 +  eq_divide_eq [of _ _ "neg_numeral w"] for w
 28.1068 +
 28.1069 +lemmas divide_eq_eq_numeral1 [simp] =
 28.1070 +  divide_eq_eq [of _ "numeral w"]
 28.1071 +  divide_eq_eq [of _ "neg_numeral w"] for w
 28.1072  
 28.1073  subsubsection{*Optional Simplification Rules Involving Constants*}
 28.1074  
 28.1075  text{*Simplify quotients that are compared with a literal constant.*}
 28.1076  
 28.1077 -lemmas le_divide_eq_number_of = le_divide_eq [of "number_of w"] for w
 28.1078 -lemmas divide_le_eq_number_of = divide_le_eq [of _ _ "number_of w"] for w
 28.1079 -lemmas less_divide_eq_number_of = less_divide_eq [of "number_of w"] for w
 28.1080 -lemmas divide_less_eq_number_of = divide_less_eq [of _ _ "number_of w"] for w
 28.1081 -lemmas eq_divide_eq_number_of = eq_divide_eq [of "number_of w"] for w
 28.1082 -lemmas divide_eq_eq_number_of = divide_eq_eq [of _ _ "number_of w"] for w
 28.1083 +lemmas le_divide_eq_numeral =
 28.1084 +  le_divide_eq [of "numeral w"]
 28.1085 +  le_divide_eq [of "neg_numeral w"] for w
 28.1086 +
 28.1087 +lemmas divide_le_eq_numeral =
 28.1088 +  divide_le_eq [of _ _ "numeral w"]
 28.1089 +  divide_le_eq [of _ _ "neg_numeral w"] for w
 28.1090 +
 28.1091 +lemmas less_divide_eq_numeral =
 28.1092 +  less_divide_eq [of "numeral w"]
 28.1093 +  less_divide_eq [of "neg_numeral w"] for w
 28.1094 +
 28.1095 +lemmas divide_less_eq_numeral =
 28.1096 +  divide_less_eq [of _ _ "numeral w"]
 28.1097 +  divide_less_eq [of _ _ "neg_numeral w"] for w
 28.1098 +
 28.1099 +lemmas eq_divide_eq_numeral =
 28.1100 +  eq_divide_eq [of "numeral w"]
 28.1101 +  eq_divide_eq [of "neg_numeral w"] for w
 28.1102 +
 28.1103 +lemmas divide_eq_eq_numeral =
 28.1104 +  divide_eq_eq [of _ _ "numeral w"]
 28.1105 +  divide_eq_eq [of _ _ "neg_numeral w"] for w
 28.1106  
 28.1107  
 28.1108  text{*Not good as automatic simprules because they cause case splits.*}
 28.1109  lemmas divide_const_simps =
 28.1110 -  le_divide_eq_number_of divide_le_eq_number_of less_divide_eq_number_of
 28.1111 -  divide_less_eq_number_of eq_divide_eq_number_of divide_eq_eq_number_of
 28.1112 +  le_divide_eq_numeral divide_le_eq_numeral less_divide_eq_numeral
 28.1113 +  divide_less_eq_numeral eq_divide_eq_numeral divide_eq_eq_numeral
 28.1114    le_divide_eq_1 divide_le_eq_1 less_divide_eq_1 divide_less_eq_1
 28.1115  
 28.1116  text{*Division By @{text "-1"}*}
 28.1117  
 28.1118 -lemma divide_minus1 [simp]:
 28.1119 -     "x/-1 = -(x::'a::{field_inverse_zero, number_ring})"
 28.1120 -by simp
 28.1121 +lemma divide_minus1 [simp]: "(x::'a::field) / -1 = - x"
 28.1122 +  unfolding minus_one [symmetric]
 28.1123 +  unfolding nonzero_minus_divide_right [OF one_neq_zero, symmetric]
 28.1124 +  by simp
 28.1125  
 28.1126 -lemma minus1_divide [simp]:
 28.1127 -     "-1 / (x::'a::{field_inverse_zero, number_ring}) = - (1/x)"
 28.1128 -by (simp add: divide_inverse)
 28.1129 +lemma minus1_divide [simp]: "-1 / (x::'a::field) = - (1 / x)"
 28.1130 +  unfolding minus_one [symmetric] by (rule divide_minus_left)
 28.1131  
 28.1132  lemma half_gt_zero_iff:
 28.1133 -     "(0 < r/2) = (0 < (r::'a::{linordered_field_inverse_zero,number_ring}))"
 28.1134 +     "(0 < r/2) = (0 < (r::'a::linordered_field_inverse_zero))"
 28.1135  by auto
 28.1136  
 28.1137  lemmas half_gt_zero [simp] = half_gt_zero_iff [THEN iffD2]
 28.1138  
 28.1139 -lemma divide_Numeral1:
 28.1140 -  "(x::'a::{field, number_ring}) / Numeral1 = x"
 28.1141 -  by simp
 28.1142 -
 28.1143 -lemma divide_Numeral0:
 28.1144 -  "(x::'a::{field_inverse_zero, number_ring}) / Numeral0 = 0"
 28.1145 +lemma divide_Numeral1: "(x::'a::field) / Numeral1 = x"
 28.1146    by simp
 28.1147  
 28.1148  
 28.1149 @@ -2211,128 +1559,154 @@
 28.1150  
 28.1151  subsection {* Configuration of the code generator *}
 28.1152  
 28.1153 -code_datatype Pls Min Bit0 Bit1 "number_of \<Colon> int \<Rightarrow> int"
 28.1154 +text {* Constructors *}
 28.1155 +
 28.1156 +definition Pos :: "num \<Rightarrow> int" where
 28.1157 +  [simp, code_abbrev]: "Pos = numeral"
 28.1158 +
 28.1159 +definition Neg :: "num \<Rightarrow> int" where
 28.1160 +  [simp, code_abbrev]: "Neg = neg_numeral"
 28.1161 +
 28.1162 +code_datatype "0::int" Pos Neg
 28.1163 +
 28.1164 +
 28.1165 +text {* Auxiliary operations *}
 28.1166 +
 28.1167 +definition dup :: "int \<Rightarrow> int" where
 28.1168 +  [simp]: "dup k = k + k"
 28.1169  
 28.1170 -lemmas pred_succ_numeral_code [code] =
 28.1171 -  pred_bin_simps succ_bin_simps
 28.1172 +lemma dup_code [code]:
 28.1173 +  "dup 0 = 0"
 28.1174 +  "dup (Pos n) = Pos (Num.Bit0 n)"
 28.1175 +  "dup (Neg n) = Neg (Num.Bit0 n)"
 28.1176 +  unfolding Pos_def Neg_def neg_numeral_def
 28.1177 +  by (simp_all add: numeral_Bit0)
 28.1178 +
 28.1179 +definition sub :: "num \<Rightarrow> num \<Rightarrow> int" where
 28.1180 +  [simp]: "sub m n = numeral m - numeral n"
 28.1181  
 28.1182 -lemmas plus_numeral_code [code] =
 28.1183 -  add_bin_simps
 28.1184 -  arith_extra_simps(1) [where 'a = int]
 28.1185 +lemma sub_code [code]:
 28.1186 +  "sub Num.One Num.One = 0"
 28.1187 +  "sub (Num.Bit0 m) Num.One = Pos (Num.BitM m)"
 28.1188 +  "sub (Num.Bit1 m) Num.One = Pos (Num.Bit0 m)"
 28.1189 +  "sub Num.One (Num.Bit0 n) = Neg (Num.BitM n)"
 28.1190 +  "sub Num.One (Num.Bit1 n) = Neg (Num.Bit0 n)"
 28.1191 +  "sub (Num.Bit0 m) (Num.Bit0 n) = dup (sub m n)"
 28.1192 +  "sub (Num.Bit1 m) (Num.Bit1 n) = dup (sub m n)"
 28.1193 +  "sub (Num.Bit1 m) (Num.Bit0 n) = dup (sub m n) + 1"
 28.1194 +  "sub (Num.Bit0 m) (Num.Bit1 n) = dup (sub m n) - 1"
 28.1195 +  unfolding sub_def dup_def numeral.simps Pos_def Neg_def
 28.1196 +    neg_numeral_def numeral_BitM
 28.1197 +  by (simp_all only: algebra_simps)
 28.1198  
 28.1199 -lemmas minus_numeral_code [code] =
 28.1200 -  minus_bin_simps
 28.1201 -  arith_extra_simps(2) [where 'a = int]
 28.1202 -  arith_extra_simps(5) [where 'a = int]
 28.1203 +
 28.1204 +text {* Implementations *}
 28.1205 +
 28.1206 +lemma one_int_code [code, code_unfold]:
 28.1207 +  "1 = Pos Num.One"
 28.1208 +  by simp
 28.1209 +
 28.1210 +lemma plus_int_code [code]:
 28.1211 +  "k + 0 = (k::int)"
 28.1212 +  "0 + l = (l::int)"
 28.1213 +  "Pos m + Pos n = Pos (m + n)"
 28.1214 +  "Pos m + Neg n = sub m n"
 28.1215 +  "Neg m + Pos n = sub n m"
 28.1216 +  "Neg m + Neg n = Neg (m + n)"
 28.1217 +  by simp_all
 28.1218  
 28.1219 -lemmas times_numeral_code [code] =
 28.1220 -  mult_bin_simps
 28.1221 -  arith_extra_simps(4) [where 'a = int]
 28.1222 +lemma uminus_int_code [code]:
 28.1223 +  "uminus 0 = (0::int)"
 28.1224 +  "uminus (Pos m) = Neg m"
 28.1225 +  "uminus (Neg m) = Pos m"
 28.1226 +  by simp_all
 28.1227 +
 28.1228 +lemma minus_int_code [code]:
 28.1229 +  "k - 0 = (k::int)"
 28.1230 +  "0 - l = uminus (l::int)"
 28.1231 +  "Pos m - Pos n = sub m n"
 28.1232 +  "Pos m - Neg n = Pos (m + n)"
 28.1233 +  "Neg m - Pos n = Neg (m + n)"
 28.1234 +  "Neg m - Neg n = sub n m"
 28.1235 +  by simp_all
 28.1236 +
 28.1237 +lemma times_int_code [code]:
 28.1238 +  "k * 0 = (0::int)"
 28.1239 +  "0 * l = (0::int)"
 28.1240 +  "Pos m * Pos n = Pos (m * n)"
 28.1241 +  "Pos m * Neg n = Neg (m * n)"
 28.1242 +  "Neg m * Pos n = Neg (m * n)"
 28.1243 +  "Neg m * Neg n = Pos (m * n)"
 28.1244 +  by simp_all
 28.1245  
 28.1246  instantiation int :: equal
 28.1247  begin
 28.1248  
 28.1249  definition
 28.1250 -  "HOL.equal k l \<longleftrightarrow> k - l = (0\<Colon>int)"
 28.1251 +  "HOL.equal k l \<longleftrightarrow> k = (l::int)"
 28.1252  
 28.1253 -instance by default (simp add: equal_int_def)
 28.1254 +instance by default (rule equal_int_def)
 28.1255  
 28.1256  end
 28.1257  
 28.1258 -lemma eq_number_of_int_code [code]:
 28.1259 -  "HOL.equal (number_of k \<Colon> int) (number_of l) \<longleftrightarrow> HOL.equal k l"
 28.1260 -  unfolding equal_int_def number_of_is_id ..
 28.1261 +lemma equal_int_code [code]:
 28.1262 +  "HOL.equal 0 (0::int) \<longleftrightarrow> True"
 28.1263 +  "HOL.equal 0 (Pos l) \<longleftrightarrow> False"
 28.1264 +  "HOL.equal 0 (Neg l) \<longleftrightarrow> False"
 28.1265 +  "HOL.equal (Pos k) 0 \<longleftrightarrow> False"
 28.1266 +  "HOL.equal (Pos k) (Pos l) \<longleftrightarrow> HOL.equal k l"
 28.1267 +  "HOL.equal (Pos k) (Neg l) \<longleftrightarrow> False"
 28.1268 +  "HOL.equal (Neg k) 0 \<longleftrightarrow> False"
 28.1269 +  "HOL.equal (Neg k) (Pos l) \<longleftrightarrow> False"
 28.1270 +  "HOL.equal (Neg k) (Neg l) \<longleftrightarrow> HOL.equal k l"
 28.1271 +  by (auto simp add: equal)
 28.1272  
 28.1273 -lemma eq_int_code [code]:
 28.1274 -  "HOL.equal Int.Pls Int.Pls \<longleftrightarrow> True"
 28.1275 -  "HOL.equal Int.Pls Int.Min \<longleftrightarrow> False"
 28.1276 -  "HOL.equal Int.Pls (Int.Bit0 k2) \<longleftrightarrow> HOL.equal Int.Pls k2"
 28.1277 -  "HOL.equal Int.Pls (Int.Bit1 k2) \<longleftrightarrow> False"
 28.1278 -  "HOL.equal Int.Min Int.Pls \<longleftrightarrow> False"
 28.1279 -  "HOL.equal Int.Min Int.Min \<longleftrightarrow> True"
 28.1280 -  "HOL.equal Int.Min (Int.Bit0 k2) \<longleftrightarrow> False"
 28.1281 -  "HOL.equal Int.Min (Int.Bit1 k2) \<longleftrightarrow> HOL.equal Int.Min k2"
 28.1282 -  "HOL.equal (Int.Bit0 k1) Int.Pls \<longleftrightarrow> HOL.equal k1 Int.Pls"
 28.1283 -  "HOL.equal (Int.Bit1 k1) Int.Pls \<longleftrightarrow> False"
 28.1284 -  "HOL.equal (Int.Bit0 k1) Int.Min \<longleftrightarrow> False"
 28.1285 -  "HOL.equal (Int.Bit1 k1) Int.Min \<longleftrightarrow> HOL.equal k1 Int.Min"
 28.1286 -  "HOL.equal (Int.Bit0 k1) (Int.Bit0 k2) \<longleftrightarrow> HOL.equal k1 k2"
 28.1287 -  "HOL.equal (Int.Bit0 k1) (Int.Bit1 k2) \<longleftrightarrow> False"
 28.1288 -  "HOL.equal (Int.Bit1 k1) (Int.Bit0 k2) \<longleftrightarrow> False"
 28.1289 -  "HOL.equal (Int.Bit1 k1) (Int.Bit1 k2) \<longleftrightarrow> HOL.equal k1 k2"
 28.1290 -  unfolding equal_eq by simp_all
 28.1291 -
 28.1292 -lemma eq_int_refl [code nbe]:
 28.1293 +lemma equal_int_refl [code nbe]:
 28.1294    "HOL.equal (k::int) k \<longleftrightarrow> True"
 28.1295 -  by (rule equal_refl)
 28.1296 -
 28.1297 -lemma less_eq_number_of_int_code [code]:
 28.1298 -  "(number_of k \<Colon> int) \<le> number_of l \<longleftrightarrow> k \<le> l"
 28.1299 -  unfolding number_of_is_id ..
 28.1300 +  by (fact equal_refl)
 28.1301  
 28.1302  lemma less_eq_int_code [code]:
 28.1303 -  "Int.Pls \<le> Int.Pls \<longleftrightarrow> True"
 28.1304 -  "Int.Pls \<le> Int.Min \<longleftrightarrow> False"
 28.1305 -  "Int.Pls \<le> Int.Bit0 k \<longleftrightarrow> Int.Pls \<le> k"
 28.1306 -  "Int.Pls \<le> Int.Bit1 k \<longleftrightarrow> Int.Pls \<le> k"
 28.1307 -  "Int.Min \<le> Int.Pls \<longleftrightarrow> True"
 28.1308 -  "Int.Min \<le> Int.Min \<longleftrightarrow> True"
 28.1309 -  "Int.Min \<le> Int.Bit0 k \<longleftrightarrow> Int.Min < k"
 28.1310 -  "Int.Min \<le> Int.Bit1 k \<longleftrightarrow> Int.Min \<le> k"
 28.1311 -  "Int.Bit0 k \<le> Int.Pls \<longleftrightarrow> k \<le> Int.Pls"
 28.1312 -  "Int.Bit1 k \<le> Int.Pls \<longleftrightarrow> k < Int.Pls"
 28.1313 -  "Int.Bit0 k \<le> Int.Min \<longleftrightarrow> k \<le> Int.Min"
 28.1314 -  "Int.Bit1 k \<le> Int.Min \<longleftrightarrow> k \<le> Int.Min"
 28.1315 -  "Int.Bit0 k1 \<le> Int.Bit0 k2 \<longleftrightarrow> k1 \<le> k2"
 28.1316 -  "Int.Bit0 k1 \<le> Int.Bit1 k2 \<longleftrightarrow> k1 \<le> k2"
 28.1317 -  "Int.Bit1 k1 \<le> Int.Bit0 k2 \<longleftrightarrow> k1 < k2"
 28.1318 -  "Int.Bit1 k1 \<le> Int.Bit1 k2 \<longleftrightarrow> k1 \<le> k2"
 28.1319 +  "0 \<le> (0::int) \<longleftrightarrow> True"
 28.1320 +  "0 \<le> Pos l \<longleftrightarrow> True"
 28.1321 +  "0 \<le> Neg l \<longleftrightarrow> False"
 28.1322 +  "Pos k \<le> 0 \<longleftrightarrow> False"
 28.1323 +  "Pos k \<le> Pos l \<longleftrightarrow> k \<le> l"
 28.1324 +  "Pos k \<le> Neg l \<longleftrightarrow> False"
 28.1325 +  "Neg k \<le> 0 \<longleftrightarrow> True"
 28.1326 +  "Neg k \<le> Pos l \<longleftrightarrow> True"
 28.1327 +  "Neg k \<le> Neg l \<longleftrightarrow> l \<le> k"
 28.1328    by simp_all
 28.1329  
 28.1330 -lemma less_number_of_int_code [code]:
 28.1331 -  "(number_of k \<Colon> int) < number_of l \<longleftrightarrow> k < l"
 28.1332 -  unfolding number_of_is_id ..
 28.1333 -
 28.1334  lemma less_int_code [code]:
 28.1335 -  "Int.Pls < Int.Pls \<longleftrightarrow> False"
 28.1336 -  "Int.Pls < Int.Min \<longleftrightarrow> False"
 28.1337 -  "Int.Pls < Int.Bit0 k \<longleftrightarrow> Int.Pls < k"
 28.1338 -  "Int.Pls < Int.Bit1 k \<longleftrightarrow> Int.Pls \<le> k"
 28.1339 -  "Int.Min < Int.Pls \<longleftrightarrow> True"
 28.1340 -  "Int.Min < Int.Min \<longleftrightarrow> False"
 28.1341 -  "Int.Min < Int.Bit0 k \<longleftrightarrow> Int.Min < k"
 28.1342 -  "Int.Min < Int.Bit1 k \<longleftrightarrow> Int.Min < k"
 28.1343 -  "Int.Bit0 k < Int.Pls \<longleftrightarrow> k < Int.Pls"
 28.1344 -  "Int.Bit1 k < Int.Pls \<longleftrightarrow> k < Int.Pls"
 28.1345 -  "Int.Bit0 k < Int.Min \<longleftrightarrow> k \<le> Int.Min"
 28.1346 -  "Int.Bit1 k < Int.Min \<longleftrightarrow> k < Int.Min"
 28.1347 -  "Int.Bit0 k1 < Int.Bit0 k2 \<longleftrightarrow> k1 < k2"
 28.1348 -  "Int.Bit0 k1 < Int.Bit1 k2 \<longleftrightarrow> k1 \<le> k2"
 28.1349 -  "Int.Bit1 k1 < Int.Bit0 k2 \<longleftrightarrow> k1 < k2"
 28.1350 -  "Int.Bit1 k1 < Int.Bit1 k2 \<longleftrightarrow> k1 < k2"
 28.1351 +  "0 < (0::int) \<longleftrightarrow> False"
 28.1352 +  "0 < Pos l \<longleftrightarrow> True"
 28.1353 +  "0 < Neg l \<longleftrightarrow> False"
 28.1354 +  "Pos k < 0 \<longleftrightarrow> False"
 28.1355 +  "Pos k < Pos l \<longleftrightarrow> k < l"
 28.1356 +  "Pos k < Neg l \<longleftrightarrow> False"
 28.1357 +  "Neg k < 0 \<longleftrightarrow> True"
 28.1358 +  "Neg k < Pos l \<longleftrightarrow> True"
 28.1359 +  "Neg k < Neg l \<longleftrightarrow> l < k"
 28.1360    by simp_all
 28.1361  
 28.1362 -definition
 28.1363 -  nat_aux :: "int \<Rightarrow> nat \<Rightarrow> nat" where
 28.1364 -  "nat_aux i n = nat i + n"
 28.1365 -
 28.1366 -lemma [code]:
 28.1367 -  "nat_aux i n = (if i \<le> 0 then n else nat_aux (i - 1) (Suc n))"  -- {* tail recursive *}
 28.1368 -  by (auto simp add: nat_aux_def nat_eq_iff linorder_not_le order_less_imp_le
 28.1369 -    dest: zless_imp_add1_zle)
 28.1370 +lemma nat_numeral [simp, code_abbrev]:
 28.1371 +  "nat (numeral k) = numeral k"
 28.1372 +  by (simp add: nat_eq_iff)
 28.1373  
 28.1374 -lemma [code]: "nat i = nat_aux i 0"
 28.1375 -  by (simp add: nat_aux_def)
 28.1376 -
 28.1377 -hide_const (open) nat_aux
 28.1378 +lemma nat_code [code]:
 28.1379 +  "nat (Int.Neg k) = 0"
 28.1380 +  "nat 0 = 0"
 28.1381 +  "nat (Int.Pos k) = nat_of_num k"
 28.1382 +  by (simp_all add: nat_of_num_numeral nat_numeral)
 28.1383  
 28.1384 -lemma zero_is_num_zero [code, code_unfold]:
 28.1385 -  "(0\<Colon>int) = Numeral0" 
 28.1386 -  by simp
 28.1387 +lemma (in ring_1) of_int_code [code]:
 28.1388 +  "of_int (Int.Neg k) = neg_numeral k"
 28.1389 +  "of_int 0 = 0"
 28.1390 +  "of_int (Int.Pos k) = numeral k"
 28.1391 +  by simp_all
 28.1392  
 28.1393 -lemma one_is_num_one [code, code_unfold]:
 28.1394 -  "(1\<Colon>int) = Numeral1" 
 28.1395 -  by simp
 28.1396 +
 28.1397 +text {* Serializer setup *}
 28.1398  
 28.1399  code_modulename SML
 28.1400    Int Arith
 28.1401 @@ -2345,7 +1719,7 @@
 28.1402  
 28.1403  quickcheck_params [default_type = int]
 28.1404  
 28.1405 -hide_const (open) Pls Min Bit0 Bit1 succ pred
 28.1406 +hide_const (open) Pos Neg sub dup
 28.1407  
 28.1408  
 28.1409  subsection {* Legacy theorems *}
 28.1410 @@ -2378,3 +1752,4 @@
 28.1411  lemmas zpower_int = int_power [symmetric]
 28.1412  
 28.1413  end
 28.1414 +
    29.1 --- a/src/HOL/IsaMakefile	Fri Mar 23 20:32:43 2012 +0100
    29.2 +++ b/src/HOL/IsaMakefile	Mon Mar 26 10:56:56 2012 +0200
    29.3 @@ -195,6 +195,7 @@
    29.4    Meson.thy \
    29.5    Metis.thy \
    29.6    Nat.thy \
    29.7 +  Num.thy \
    29.8    Option.thy \
    29.9    Orderings.thy \
   29.10    Partial_Function.thy \
   29.11 @@ -341,7 +342,6 @@
   29.12    Tools/Nitpick/nitpick_util.ML \
   29.13    Tools/numeral.ML \
   29.14    Tools/numeral_simprocs.ML \
   29.15 -  Tools/numeral_syntax.ML \
   29.16    Tools/Predicate_Compile/core_data.ML \
   29.17    Tools/Predicate_Compile/mode_inference.ML \
   29.18    Tools/Predicate_Compile/predicate_compile_aux.ML \
   29.19 @@ -444,24 +444,25 @@
   29.20    Library/Bit.thy Library/Boolean_Algebra.thy Library/Cardinality.thy	\
   29.21    Library/Char_nat.thy Library/Code_Char.thy Library/Code_Char_chr.thy	\
   29.22    Library/Code_Char_ord.thy Library/Code_Integer.thy			\
   29.23 -  Library/Code_Natural.thy Library/Code_Prolog.thy			\
   29.24 +  Library/Code_Nat.thy Library/Code_Natural.thy				\
   29.25 +  Library/Efficient_Nat.thy Library/Code_Prolog.thy			\
   29.26    Library/Code_Real_Approx_By_Float.thy					\
   29.27    Tools/Predicate_Compile/code_prolog.ML Library/ContNotDenum.thy	\
   29.28    Library/Cset.thy Library/Cset_Monad.thy Library/Continuity.thy	\
   29.29    Library/Convex.thy Library/Countable.thy				\
   29.30 +  Library/Dlist.thy Library/Dlist_Cset.thy Library/Eval_Witness.thy	\
   29.31    Library/DAList.thy Library/Dlist.thy Library/Dlist_Cset.thy 		\
   29.32 -  Library/Efficient_Nat.thy Library/Eval_Witness.thy			\
   29.33 +  Library/Eval_Witness.thy						\
   29.34    Library/Extended_Real.thy Library/Extended_Nat.thy Library/Float.thy	\
   29.35    Library/Formal_Power_Series.thy Library/Fraction_Field.thy		\
   29.36    Library/FrechetDeriv.thy Library/Cset.thy Library/FuncSet.thy		\
   29.37 -  Library/Function_Algebras.thy						\
   29.38 -  Library/Fundamental_Theorem_Algebra.thy Library/Glbs.thy		\
   29.39 -  Library/Indicator_Function.thy Library/Infinite_Set.thy		\
   29.40 -  Library/Inner_Product.thy Library/Kleene_Algebra.thy			\
   29.41 -  Library/LaTeXsugar.thy Library/Lattice_Algebras.thy			\
   29.42 -  Library/Lattice_Syntax.thy Library/Library.thy Library/List_Cset.thy	\
   29.43 -  Library/List_Prefix.thy Library/List_lexord.thy Library/Mapping.thy	\
   29.44 -  Library/Monad_Syntax.thy						\
   29.45 +  Library/Function_Algebras.thy Library/Fundamental_Theorem_Algebra.thy	\
   29.46 +  Library/Glbs.thy Library/Indicator_Function.thy			\
   29.47 +  Library/Infinite_Set.thy Library/Inner_Product.thy			\
   29.48 +  Library/Kleene_Algebra.thy Library/LaTeXsugar.thy			\
   29.49 +  Library/Lattice_Algebras.thy Library/Lattice_Syntax.thy		\
   29.50 +  Library/Library.thy Library/List_Cset.thy Library/List_Prefix.thy	\
   29.51 +  Library/List_lexord.thy Library/Mapping.thy Library/Monad_Syntax.thy	\
   29.52    Library/Multiset.thy Library/Nat_Bijection.thy			\
   29.53    Library/Numeral_Type.thy Library/Old_Recdef.thy			\
   29.54    Library/OptionalSugar.thy Library/Order_Relation.thy			\
   29.55 @@ -479,7 +480,7 @@
   29.56    Library/State_Monad.thy Library/Ramsey.thy				\
   29.57    Library/Reflection.thy Library/Sublist_Order.thy			\
   29.58    Library/Sum_of_Squares.thy Library/Sum_of_Squares/sos_wrapper.ML	\
   29.59 -  Library/Sum_of_Squares/sum_of_squares.ML				\
   29.60 +  Library/Sum_of_Squares/sum_of_squares.ML Library/Target_Numeral.thy	\
   29.61    Library/Transitive_Closure_Table.thy Library/Univ_Poly.thy		\
   29.62    Library/Wfrec.thy Library/While_Combinator.thy Library/Zorn.thy	\
   29.63    $(SRC)/Tools/adhoc_overloading.ML Library/positivstellensatz.ML	\
   29.64 @@ -758,11 +759,11 @@
   29.65  
   29.66  HOL-Library-Codegenerator_Test: HOL-Library $(LOG)/HOL-Library-Codegenerator_Test.gz
   29.67  
   29.68 -$(LOG)/HOL-Library-Codegenerator_Test.gz: $(OUT)/HOL-Library		\
   29.69 -  Codegenerator_Test/ROOT.ML 						\
   29.70 -  Codegenerator_Test/Candidates.thy					\
   29.71 -  Codegenerator_Test/Candidates_Pretty.thy				\
   29.72 -  Codegenerator_Test/Generate.thy					\
   29.73 +$(LOG)/HOL-Library-Codegenerator_Test.gz: $(OUT)/HOL-Library \
   29.74 +  Codegenerator_Test/ROOT.ML \
   29.75 +  Codegenerator_Test/Candidates.thy \
   29.76 +  Codegenerator_Test/Candidates_Pretty.thy \
   29.77 +  Codegenerator_Test/Generate.thy \
   29.78    Codegenerator_Test/Generate_Pretty.thy
   29.79  	@$(ISABELLE_TOOL) usedir -d false -g false -i false $(OUT)/HOL-Library Codegenerator_Test
   29.80  
   29.81 @@ -920,6 +921,10 @@
   29.82  HOL-Imperative_HOL: HOL $(LOG)/HOL-Imperative_HOL.gz
   29.83  
   29.84  $(LOG)/HOL-Imperative_HOL.gz: $(OUT)/HOL \
   29.85 +  Library/Code_Integer.thy \
   29.86 +  Library/Code_Nat.thy \
   29.87 +  Library/Code_Natural.thy \
   29.88 +  Library/Efficient_Nat.thy \
   29.89    Imperative_HOL/Array.thy \
   29.90    Imperative_HOL/Heap.thy \
   29.91    Imperative_HOL/Heap_Monad.thy \
   29.92 @@ -943,6 +948,10 @@
   29.93  HOL-Decision_Procs: HOL $(LOG)/HOL-Decision_Procs.gz
   29.94  
   29.95  $(LOG)/HOL-Decision_Procs.gz: $(OUT)/HOL \
   29.96 +  Library/Code_Integer.thy \
   29.97 +  Library/Code_Nat.thy \
   29.98 +  Library/Code_Natural.thy \
   29.99 +  Library/Efficient_Nat.thy \
  29.100    Decision_Procs/Approximation.thy \
  29.101    Decision_Procs/Commutative_Ring.thy \
  29.102    Decision_Procs/Commutative_Ring_Complete.thy \
  29.103 @@ -991,9 +1000,12 @@
  29.104  HOL-Proofs-Extraction: HOL-Proofs $(LOG)/HOL-Proofs-Extraction.gz
  29.105  
  29.106  $(LOG)/HOL-Proofs-Extraction.gz: $(OUT)/HOL-Proofs		\
  29.107 -  Library/Efficient_Nat.thy Proofs/Extraction/Euclid.thy	\
  29.108 +  Library/Code_Integer.thy Library/Code_Nat.thy			\
  29.109 +  Library/Code_Natural.thy Library/Efficient_Nat.thy		\
  29.110 +  Proofs/Extraction/Euclid.thy					\
  29.111    Proofs/Extraction/Greatest_Common_Divisor.thy			\
  29.112 -  Proofs/Extraction/Higman.thy Proofs/Extraction/Higman_Extraction.thy	\
  29.113 +  Proofs/Extraction/Higman.thy					\
  29.114 +  Proofs/Extraction/Higman_Extraction.thy			\
  29.115    Proofs/Extraction/Pigeonhole.thy				\
  29.116    Proofs/Extraction/QuotRem.thy Proofs/Extraction/ROOT.ML	\
  29.117    Proofs/Extraction/Util.thy Proofs/Extraction/Warshall.thy	\
  29.118 @@ -1113,15 +1125,17 @@
  29.119  HOL-ex: HOL $(LOG)/HOL-ex.gz
  29.120  
  29.121  $(LOG)/HOL-ex.gz: $(OUT)/HOL Decision_Procs/Commutative_Ring.thy	\
  29.122 +  Library/Code_Integer.thy Library/Code_Nat.thy				\
  29.123 +  Library/Code_Natural.thy Library/Efficient_Nat.thy			\
  29.124    Number_Theory/Primes.thy ex/Abstract_NAT.thy ex/Antiquote.thy		\
  29.125    ex/Arith_Examples.thy ex/Arithmetic_Series_Complex.thy ex/BT.thy	\
  29.126    ex/BinEx.thy ex/Binary.thy ex/Birthday_Paradox.thy ex/CTL.thy		\
  29.127    ex/Case_Product.thy ex/Chinese.thy ex/Classical.thy			\
  29.128 -  ex/Coercion_Examples.thy ex/Coherent.thy				\
  29.129 -  ex/Dedekind_Real.thy ex/Efficient_Nat_examples.thy			\
  29.130 +  ex/Code_Nat_examples.thy						\
  29.131 +  ex/Coercion_Examples.thy ex/Coherent.thy ex/Dedekind_Real.thy		\
  29.132    ex/Eval_Examples.thy ex/Executable_Relation.thy ex/Fundefs.thy	\
  29.133    ex/Gauge_Integration.thy ex/Groebner_Examples.thy ex/Guess.thy	\
  29.134 -  ex/HarmonicSeries.thy ex/Hebrew.thy ex/Hex_Bin_Examples.thy 		\
  29.135 +  ex/HarmonicSeries.thy ex/Hebrew.thy ex/Hex_Bin_Examples.thy		\
  29.136    ex/Higher_Order_Logic.thy ex/Iff_Oracle.thy ex/Induction_Schema.thy	\
  29.137    ex/Interpretation_with_Defs.thy ex/Intuitionistic.thy			\
  29.138    ex/Lagrange.thy ex/List_to_Set_Comprehension_Examples.thy		\
    30.1 --- a/src/HOL/Library/BigO.thy	Fri Mar 23 20:32:43 2012 +0100
    30.2 +++ b/src/HOL/Library/BigO.thy	Mon Mar 26 10:56:56 2012 +0200
    30.3 @@ -132,7 +132,6 @@
    30.4    apply (simp add: abs_triangle_ineq)
    30.5    apply (simp add: order_less_le)
    30.6    apply (rule mult_nonneg_nonneg)
    30.7 -  apply (rule add_nonneg_nonneg)
    30.8    apply auto
    30.9    apply (rule_tac x = "%n. if (abs (f n)) <  abs (g n) then x n else 0" 
   30.10       in exI)
   30.11 @@ -150,11 +149,8 @@
   30.12    apply (rule abs_triangle_ineq)
   30.13    apply (simp add: order_less_le)
   30.14    apply (rule mult_nonneg_nonneg)
   30.15 -  apply (rule add_nonneg_nonneg)
   30.16 -  apply (erule order_less_imp_le)+
   30.17 +  apply (erule order_less_imp_le)
   30.18    apply simp
   30.19 -  apply (rule ext)
   30.20 -  apply (auto simp add: if_splits linorder_not_le)
   30.21    done
   30.22  
   30.23  lemma bigo_plus_subset2 [intro]: "A <= O(f) ==> B <= O(f) ==> A \<oplus> B <= O(f)"
    31.1 --- a/src/HOL/Library/Binomial.thy	Fri Mar 23 20:32:43 2012 +0100
    31.2 +++ b/src/HOL/Library/Binomial.thy	Mon Mar 26 10:56:56 2012 +0200
    31.3 @@ -350,7 +350,7 @@
    31.4      have eq: "(- (1\<Colon>'a)) ^ n = setprod (\<lambda>i. - 1) {0 .. n - 1}"
    31.5        by auto
    31.6      from n0 have ?thesis 
    31.7 -      by (simp add: pochhammer_def gbinomial_def field_simps eq setprod_timesf[symmetric])}
    31.8 +      by (simp add: pochhammer_def gbinomial_def field_simps eq setprod_timesf[symmetric] del: minus_one) (* FIXME: del: minus_one *)}
    31.9    ultimately show ?thesis by blast
   31.10  qed
   31.11  
   31.12 @@ -417,8 +417,8 @@
   31.13      from eq[symmetric]
   31.14      have ?thesis using kn
   31.15        apply (simp add: binomial_fact[OF kn, where ?'a = 'a] 
   31.16 -        gbinomial_pochhammer field_simps pochhammer_Suc_setprod)
   31.17 -      apply (simp add: pochhammer_Suc_setprod fact_altdef_nat h of_nat_setprod setprod_timesf[symmetric] eq' del: One_nat_def power_Suc)
   31.18 +        gbinomial_pochhammer field_simps pochhammer_Suc_setprod del: minus_one)
   31.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)
   31.20        unfolding setprod_Un_disjoint[OF th0, unfolded eq3, of "of_nat:: nat \<Rightarrow> 'a"] eq[unfolded h]
   31.21        unfolding mult_assoc[symmetric] 
   31.22        unfolding setprod_timesf[symmetric]
    32.1 --- a/src/HOL/Library/Bit.thy	Fri Mar 23 20:32:43 2012 +0100
    32.2 +++ b/src/HOL/Library/Bit.thy	Mon Mar 26 10:56:56 2012 +0200
    32.3 @@ -96,27 +96,18 @@
    32.4  
    32.5  subsection {* Numerals at type @{typ bit} *}
    32.6  
    32.7 -instantiation bit :: number_ring
    32.8 -begin
    32.9 -
   32.10 -definition number_of_bit_def:
   32.11 -  "(number_of w :: bit) = of_int w"
   32.12 -
   32.13 -instance proof
   32.14 -qed (rule number_of_bit_def)
   32.15 -
   32.16 -end
   32.17 -
   32.18  text {* All numerals reduce to either 0 or 1. *}
   32.19  
   32.20  lemma bit_minus1 [simp]: "-1 = (1 :: bit)"
   32.21 -  by (simp only: number_of_Min uminus_bit_def)
   32.22 +  by (simp only: minus_one [symmetric] uminus_bit_def)
   32.23 +
   32.24 +lemma bit_neg_numeral [simp]: "(neg_numeral w :: bit) = numeral w"
   32.25 +  by (simp only: neg_numeral_def uminus_bit_def)
   32.26  
   32.27 -lemma bit_number_of_even [simp]: "number_of (Int.Bit0 w) = (0 :: bit)"
   32.28 -  by (simp only: number_of_Bit0 add_0_left bit_add_self)
   32.29 +lemma bit_numeral_even [simp]: "numeral (Num.Bit0 w) = (0 :: bit)"
   32.30 +  by (simp only: numeral_Bit0 bit_add_self)
   32.31  
   32.32 -lemma bit_number_of_odd [simp]: "number_of (Int.Bit1 w) = (1 :: bit)"
   32.33 -  by (simp only: number_of_Bit1 add_assoc bit_add_self
   32.34 -                 monoid_add_class.add_0_right)
   32.35 +lemma bit_numeral_odd [simp]: "numeral (Num.Bit1 w) = (1 :: bit)"
   32.36 +  by (simp only: numeral_Bit1 bit_add_self add_0_left)
   32.37  
   32.38  end
    33.1 --- a/src/HOL/Library/Cardinality.thy	Fri Mar 23 20:32:43 2012 +0100
    33.2 +++ b/src/HOL/Library/Cardinality.thy	Mon Mar 26 10:56:56 2012 +0200
    33.3 @@ -5,7 +5,7 @@
    33.4  header {* Cardinality of types *}
    33.5  
    33.6  theory Cardinality
    33.7 -imports Main
    33.8 +imports "~~/src/HOL/Main"
    33.9  begin
   33.10  
   33.11  subsection {* Preliminary lemmas *}
    34.1 --- a/src/HOL/Library/Code_Integer.thy	Fri Mar 23 20:32:43 2012 +0100
    34.2 +++ b/src/HOL/Library/Code_Integer.thy	Mon Mar 26 10:56:56 2012 +0200
    34.3 @@ -9,6 +9,43 @@
    34.4  begin
    34.5  
    34.6  text {*
    34.7 +  Representation-ignorant code equations for conversions.
    34.8 +*}
    34.9 +
   34.10 +lemma nat_code [code]:
   34.11 +  "nat k = (if k \<le> 0 then 0 else
   34.12 +     let
   34.13 +       (l, j) = divmod_int k 2;
   34.14 +       l' = 2 * nat l
   34.15 +     in if j = 0 then l' else Suc l')"
   34.16 +proof -
   34.17 +  have "2 = nat 2" by simp
   34.18 +  show ?thesis
   34.19 +    apply (auto simp add: Let_def divmod_int_mod_div not_le
   34.20 +     nat_div_distrib nat_mult_distrib mult_div_cancel mod_2_not_eq_zero_eq_one_int)
   34.21 +    apply (unfold `2 = nat 2`)
   34.22 +    apply (subst nat_mod_distrib [symmetric])
   34.23 +    apply simp_all
   34.24 +  done
   34.25 +qed
   34.26 +
   34.27 +lemma (in ring_1) of_int_code:
   34.28 +  "of_int k = (if k = 0 then 0
   34.29 +     else if k < 0 then - of_int (- k)
   34.30 +     else let
   34.31 +       (l, j) = divmod_int k 2;
   34.32 +       l' = 2 * of_int l
   34.33 +     in if j = 0 then l' else l' + 1)"
   34.34 +proof -
   34.35 +  from mod_div_equality have *: "of_int k = of_int (k div 2 * 2 + k mod 2)" by simp
   34.36 +  show ?thesis
   34.37 +    by (simp add: Let_def divmod_int_mod_div mod_2_not_eq_zero_eq_one_int
   34.38 +      of_int_add [symmetric]) (simp add: * mult_commute)
   34.39 +qed
   34.40 +
   34.41 +declare of_int_code [code]
   34.42 +
   34.43 +text {*
   34.44    HOL numeral expressions are mapped to integer literals
   34.45    in target languages, using predefined target language
   34.46    operations for abstract integer operations.
   34.47 @@ -24,42 +61,21 @@
   34.48  code_instance int :: equal
   34.49    (Haskell -)
   34.50  
   34.51 +code_const "0::int"
   34.52 +  (SML "0")
   34.53 +  (OCaml "Big'_int.zero'_big'_int")
   34.54 +  (Haskell "0")
   34.55 +  (Scala "BigInt(0)")
   34.56 +
   34.57  setup {*
   34.58 -  fold (Numeral.add_code @{const_name number_int_inst.number_of_int}
   34.59 -    true Code_Printer.literal_numeral) ["SML", "OCaml", "Haskell", "Scala"]
   34.60 +  fold (Numeral.add_code @{const_name Int.Pos}
   34.61 +    false Code_Printer.literal_numeral) ["SML", "OCaml", "Haskell", "Scala"]
   34.62  *}
   34.63  
   34.64 -code_const "Int.Pls" and "Int.Min" and "Int.Bit0" and "Int.Bit1"
   34.65 -  (SML "raise/ Fail/ \"Pls\""
   34.66 -     and "raise/ Fail/ \"Min\""
   34.67 -     and "!((_);/ raise/ Fail/ \"Bit0\")"
   34.68 -     and "!((_);/ raise/ Fail/ \"Bit1\")")
   34.69 -  (OCaml "failwith/ \"Pls\""
   34.70 -     and "failwith/ \"Min\""
   34.71 -     and "!((_);/ failwith/ \"Bit0\")"
   34.72 -     and "!((_);/ failwith/ \"Bit1\")")
   34.73 -  (Haskell "error/ \"Pls\""
   34.74 -     and "error/ \"Min\""
   34.75 -     and "error/ \"Bit0\""
   34.76 -     and "error/ \"Bit1\"")
   34.77 -  (Scala "!error(\"Pls\")"
   34.78 -     and "!error(\"Min\")"
   34.79 -     and "!error(\"Bit0\")"
   34.80 -     and "!error(\"Bit1\")")
   34.81 -
   34.82 -code_const Int.pred
   34.83 -  (SML "IntInf.- ((_), 1)")
   34.84 -  (OCaml "Big'_int.pred'_big'_int")
   34.85 -  (Haskell "!(_/ -/ 1)")
   34.86 -  (Scala "!(_ -/ 1)")
   34.87 -  (Eval "!(_/ -/ 1)")
   34.88 -
   34.89 -code_const Int.succ
   34.90 -  (SML "IntInf.+ ((_), 1)")
   34.91 -  (OCaml "Big'_int.succ'_big'_int")
   34.92 -  (Haskell "!(_/ +/ 1)")
   34.93 -  (Scala "!(_ +/ 1)")
   34.94 -  (Eval "!(_/ +/ 1)")
   34.95 +setup {*
   34.96 +  fold (Numeral.add_code @{const_name Int.Neg}
   34.97 +    true Code_Printer.literal_numeral) ["SML", "OCaml", "Haskell", "Scala"]
   34.98 +*}
   34.99  
  34.100  code_const "op + \<Colon> int \<Rightarrow> int \<Rightarrow> int"
  34.101    (SML "IntInf.+ ((_), (_))")
  34.102 @@ -82,6 +98,19 @@
  34.103    (Scala infixl 7 "-")
  34.104    (Eval infixl 8 "-")
  34.105  
  34.106 +code_const Int.dup
  34.107 +  (SML "IntInf.*/ (2,/ (_))")
  34.108 +  (OCaml "Big'_int.mult'_big'_int/ 2")
  34.109 +  (Haskell "!(2 * _)")
  34.110 +  (Scala "!(2 * _)")
  34.111 +  (Eval "!(2 * _)")
  34.112 +
  34.113 +code_const Int.sub
  34.114 +  (SML "!(raise/ Fail/ \"sub\")")
  34.115 +  (OCaml "failwith/ \"sub\"")
  34.116 +  (Haskell "error/ \"sub\"")
  34.117 +  (Scala "!error(\"sub\")")
  34.118 +
  34.119  code_const "op * \<Colon> int \<Rightarrow> int \<Rightarrow> int"
  34.120    (SML "IntInf.* ((_), (_))")
  34.121    (OCaml "Big'_int.mult'_big'_int")
  34.122 @@ -124,9 +153,7 @@
  34.123    (Scala "!_.as'_BigInt")
  34.124    (Eval "_")
  34.125  
  34.126 -text {* Evaluation *}
  34.127 -
  34.128  code_const "Code_Evaluation.term_of \<Colon> int \<Rightarrow> term"
  34.129    (Eval "HOLogic.mk'_number/ HOLogic.intT")
  34.130  
  34.131 -end
  34.132 \ No newline at end of file
  34.133 +end
    35.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    35.2 +++ b/src/HOL/Library/Code_Nat.thy	Mon Mar 26 10:56:56 2012 +0200
    35.3 @@ -0,0 +1,258 @@
    35.4 +(*  Title:      HOL/Library/Code_Nat.thy
    35.5 +    Author:     Stefan Berghofer, Florian Haftmann, TU Muenchen
    35.6 +*)
    35.7 +
    35.8 +header {* Implementation of natural numbers as binary numerals *}
    35.9 +
   35.10 +theory Code_Nat
   35.11 +imports Main
   35.12 +begin
   35.13 +
   35.14 +text {*
   35.15 +  When generating code for functions on natural numbers, the
   35.16 +  canonical representation using @{term "0::nat"} and
   35.17 +  @{term Suc} is unsuitable for computations involving large
   35.18 +  numbers.  This theory refines the representation of
   35.19 +  natural numbers for code generation to use binary
   35.20 +  numerals, which do not grow linear in size but logarithmic.
   35.21 +*}
   35.22 +
   35.23 +subsection {* Representation *}
   35.24 +
   35.25 +lemma [code_abbrev]:
   35.26 +  "nat_of_num = numeral"
   35.27 +  by (fact nat_of_num_numeral)
   35.28 +
   35.29 +code_datatype "0::nat" nat_of_num
   35.30 +
   35.31 +lemma [code]:
   35.32 +  "num_of_nat 0 = Num.One"
   35.33 +  "num_of_nat (nat_of_num k) = k"
   35.34 +  by (simp_all add: nat_of_num_inverse)
   35.35 +
   35.36 +lemma [code]:
   35.37 +  "(1\<Colon>nat) = Numeral1"
   35.38 +  by simp
   35.39 +
   35.40 +lemma [code_abbrev]: "Numeral1 = (1\<Colon>nat)"
   35.41 +  by simp
   35.42 +
   35.43 +lemma [code]:
   35.44 +  "Suc n = n + 1"
   35.45 +  by simp
   35.46 +
   35.47 +
   35.48 +subsection {* Basic arithmetic *}
   35.49 +
   35.50 +lemma [code, code del]:
   35.51 +  "(plus :: nat \<Rightarrow> _) = plus" ..
   35.52 +
   35.53 +lemma plus_nat_code [code]:
   35.54 +  "nat_of_num k + nat_of_num l = nat_of_num (k + l)"
   35.55 +  "m + 0 = (m::nat)"
   35.56 +  "0 + n = (n::nat)"
   35.57 +  by (simp_all add: nat_of_num_numeral)
   35.58 +
   35.59 +text {* Bounded subtraction needs some auxiliary *}
   35.60 +
   35.61 +definition dup :: "nat \<Rightarrow> nat" where
   35.62 +  "dup n = n + n"
   35.63 +
   35.64 +lemma dup_code [code]:
   35.65 +  "dup 0 = 0"
   35.66 +  "dup (nat_of_num k) = nat_of_num (Num.Bit0 k)"
   35.67 +  unfolding Num_def by (simp_all add: dup_def numeral_Bit0)
   35.68 +
   35.69 +definition sub :: "num \<Rightarrow> num \<Rightarrow> nat option" where
   35.70 +  "sub k l = (if k \<ge> l then Some (numeral k - numeral l) else None)"
   35.71 +
   35.72 +lemma sub_code [code]:
   35.73 +  "sub Num.One Num.One = Some 0"
   35.74 +  "sub (Num.Bit0 m) Num.One = Some (nat_of_num (Num.BitM m))"
   35.75 +  "sub (Num.Bit1 m) Num.One = Some (nat_of_num (Num.Bit0 m))"
   35.76 +  "sub Num.One (Num.Bit0 n) = None"
   35.77 +  "sub Num.One (Num.Bit1 n) = None"
   35.78 +  "sub (Num.Bit0 m) (Num.Bit0 n) = Option.map dup (sub m n)"
   35.79 +  "sub (Num.Bit1 m) (Num.Bit1 n) = Option.map dup (sub m n)"
   35.80 +  "sub (Num.Bit1 m) (Num.Bit0 n) = Option.map (\<lambda>q. dup q + 1) (sub m n)"
   35.81 +  "sub (Num.Bit0 m) (Num.Bit1 n) = (case sub m n of None \<Rightarrow> None
   35.82 +     | Some q \<Rightarrow> if q = 0 then None else Some (dup q - 1))"
   35.83 +  apply (auto simp add: nat_of_num_numeral
   35.84 +    Num.dbl_def Num.dbl_inc_def Num.dbl_dec_def
   35.85 +    Let_def le_imp_diff_is_add BitM_plus_one sub_def dup_def)
   35.86 +  apply (simp_all add: sub_non_positive)
   35.87 +  apply (simp_all add: sub_non_negative [symmetric, where ?'a = int])
   35.88 +  done
   35.89 +
   35.90 +lemma [code, code del]:
   35.91 +  "(minus :: nat \<Rightarrow> _) = minus" ..
   35.92 +
   35.93 +lemma minus_nat_code [code]:
   35.94 +  "nat_of_num k - nat_of_num l = (case sub k l of None \<Rightarrow> 0 | Some j \<Rightarrow> j)"
   35.95 +  "m - 0 = (m::nat)"
   35.96 +  "0 - n = (0::nat)"
   35.97 +  by (simp_all add: nat_of_num_numeral sub_non_positive sub_def)
   35.98 +
   35.99 +lemma [code, code del]:
  35.100 +  "(times :: nat \<Rightarrow> _) = times" ..
  35.101 +
  35.102 +lemma times_nat_code [code]:
  35.103 +  "nat_of_num k * nat_of_num l = nat_of_num (k * l)"
  35.104 +  "m * 0 = (0::nat)"
  35.105 +  "0 * n = (0::nat)"
  35.106 +  by (simp_all add: nat_of_num_numeral)
  35.107 +
  35.108 +lemma [code, code del]:
  35.109 +  "(HOL.equal :: nat \<Rightarrow> _) = HOL.equal" ..
  35.110 +
  35.111 +lemma equal_nat_code [code]:
  35.112 +  "HOL.equal 0 (0::nat) \<longleftrightarrow> True"
  35.113 +  "HOL.equal 0 (nat_of_num l) \<longleftrightarrow> False"
  35.114 +  "HOL.equal (nat_of_num k) 0 \<longleftrightarrow> False"
  35.115 +  "HOL.equal (nat_of_num k) (nat_of_num l) \<longleftrightarrow> HOL.equal k l"
  35.116 +  by (simp_all add: nat_of_num_numeral equal)
  35.117 +
  35.118 +lemma equal_nat_refl [code nbe]:
  35.119 +  "HOL.equal (n::nat) n \<longleftrightarrow> True"
  35.120 +  by (rule equal_refl)
  35.121 +
  35.122 +lemma [code, code del]:
  35.123 +  "(less_eq :: nat \<Rightarrow> _) = less_eq" ..
  35.124 +
  35.125 +lemma less_eq_nat_code [code]:
  35.126 +  "0 \<le> (n::nat) \<longleftrightarrow> True"
  35.127 +  "nat_of_num k \<le> 0 \<longleftrightarrow> False"
  35.128 +  "nat_of_num k \<le> nat_of_num l \<longleftrightarrow> k \<le> l"
  35.129 +  by (simp_all add: nat_of_num_numeral)
  35.130 +
  35.131 +lemma [code, code del]:
  35.132 +  "(less :: nat \<Rightarrow> _) = less" ..
  35.133 +
  35.134 +lemma less_nat_code [code]:
  35.135 +  "(m::nat) < 0 \<longleftrightarrow> False"
  35.136 +  "0 < nat_of_num l \<longleftrightarrow> True"
  35.137 +  "nat_of_num k < nat_of_num l \<longleftrightarrow> k < l"
  35.138 +  by (simp_all add: nat_of_num_numeral)
  35.139 +
  35.140 +
  35.141 +subsection {* Conversions *}
  35.142 +
  35.143 +lemma [code, code del]:
  35.144 +  "of_nat = of_nat" ..
  35.145 +
  35.146 +lemma of_nat_code [code]:
  35.147 +  "of_nat 0 = 0"
  35.148 +  "of_nat (nat_of_num k) = numeral k"
  35.149 +  by (simp_all add: nat_of_num_numeral)
  35.150 +
  35.151 +
  35.152 +subsection {* Case analysis *}
  35.153 +
  35.154 +text {*
  35.155 +  Case analysis on natural numbers is rephrased using a conditional
  35.156 +  expression:
  35.157 +*}
  35.158 +
  35.159 +lemma [code, code_unfold]:
  35.160 +  "nat_case = (\<lambda>f g n. if n = 0 then f else g (n - 1))"
  35.161 +  by (auto simp add: fun_eq_iff dest!: gr0_implies_Suc)
  35.162 +
  35.163 +
  35.164 +subsection {* Preprocessors *}
  35.165 +
  35.166 +text {*
  35.167 +  The term @{term "Suc n"} is no longer a valid pattern.
  35.168 +  Therefore, all occurrences of this term in a position
  35.169 +  where a pattern is expected (i.e.~on the left-hand side of a recursion
  35.170 +  equation) must be eliminated.
  35.171 +  This can be accomplished by applying the following transformation rules:
  35.172 +*}
  35.173 +
  35.174 +lemma Suc_if_eq: "(\<And>n. f (Suc n) \<equiv> h n) \<Longrightarrow> f 0 \<equiv> g \<Longrightarrow>
  35.175 +  f n \<equiv> if n = 0 then g else h (n - 1)"
  35.176 +  by (rule eq_reflection) (cases n, simp_all)
  35.177 +
  35.178 +text {*
  35.179 +  The rules above are built into a preprocessor that is plugged into
  35.180 +  the code generator. Since the preprocessor for introduction rules
  35.181 +  does not know anything about modes, some of the modes that worked
  35.182 +  for the canonical representation of natural numbers may no longer work.
  35.183 +*}
  35.184 +
  35.185 +(*<*)
  35.186 +setup {*
  35.187 +let
  35.188 +
  35.189 +fun remove_suc thy thms =
  35.190 +  let
  35.191 +    val vname = singleton (Name.variant_list (map fst
  35.192 +      (fold (Term.add_var_names o Thm.full_prop_of) thms []))) "n";
  35.193 +    val cv = cterm_of thy (Var ((vname, 0), HOLogic.natT));
  35.194 +    fun lhs_of th = snd (Thm.dest_comb
  35.195 +      (fst (Thm.dest_comb (cprop_of th))));
  35.196 +    fun rhs_of th = snd (Thm.dest_comb (cprop_of th));
  35.197 +    fun find_vars ct = (case term_of ct of
  35.198 +        (Const (@{const_name Suc}, _) $ Var _) => [(cv, snd (Thm.dest_comb ct))]
  35.199 +      | _ $ _ =>
  35.200 +        let val (ct1, ct2) = Thm.dest_comb ct
  35.201 +        in 
  35.202 +          map (apfst (fn ct => Thm.apply ct ct2)) (find_vars ct1) @
  35.203 +          map (apfst (Thm.apply ct1)) (find_vars ct2)
  35.204 +        end
  35.205 +      | _ => []);
  35.206 +    val eqs = maps
  35.207 +      (fn th => map (pair th) (find_vars (lhs_of th))) thms;
  35.208 +    fun mk_thms (th, (ct, cv')) =
  35.209 +      let
  35.210 +        val th' =
  35.211 +          Thm.implies_elim
  35.212 +           (Conv.fconv_rule (Thm.beta_conversion true)
  35.213 +             (Drule.instantiate'
  35.214 +               [SOME (ctyp_of_term ct)] [SOME (Thm.lambda cv ct),
  35.215 +                 SOME (Thm.lambda cv' (rhs_of th)), NONE, SOME cv']
  35.216 +               @{thm Suc_if_eq})) (Thm.forall_intr cv' th)
  35.217 +      in
  35.218 +        case map_filter (fn th'' =>
  35.219 +            SOME (th'', singleton
  35.220 +              (Variable.trade (K (fn [th'''] => [th''' RS th']))
  35.221 +                (Variable.global_thm_context th'')) th'')
  35.222 +          handle THM _ => NONE) thms of
  35.223 +            [] => NONE
  35.224 +          | thps =>
  35.225 +              let val (ths1, ths2) = split_list thps
  35.226 +              in SOME (subtract Thm.eq_thm (th :: ths1) thms @ ths2) end
  35.227 +      end
  35.228 +  in get_first mk_thms eqs end;
  35.229 +
  35.230 +fun eqn_suc_base_preproc thy thms =
  35.231 +  let
  35.232 +    val dest = fst o Logic.dest_equals o prop_of;
  35.233 +    val contains_suc = exists_Const (fn (c, _) => c = @{const_name Suc});
  35.234 +  in
  35.235 +    if forall (can dest) thms andalso exists (contains_suc o dest) thms
  35.236 +      then thms |> perhaps_loop (remove_suc thy) |> (Option.map o map) Drule.zero_var_indexes
  35.237 +       else NONE
  35.238 +  end;
  35.239 +
  35.240 +val eqn_suc_preproc = Code_Preproc.simple_functrans eqn_suc_base_preproc;
  35.241 +
  35.242 +in
  35.243 +
  35.244 +  Code_Preproc.add_functrans ("eqn_Suc", eqn_suc_preproc)
  35.245 +
  35.246 +end;
  35.247 +*}
  35.248 +(*>*)
  35.249 +
  35.250 +code_modulename SML
  35.251 +  Code_Nat Arith
  35.252 +
  35.253 +code_modulename OCaml
  35.254 +  Code_Nat Arith
  35.255 +
  35.256 +code_modulename Haskell
  35.257 +  Code_Nat Arith
  35.258 +
  35.259 +hide_const (open) dup sub
  35.260 +
  35.261 +end
    36.1 --- a/src/HOL/Library/Code_Natural.thy	Fri Mar 23 20:32:43 2012 +0100
    36.2 +++ b/src/HOL/Library/Code_Natural.thy	Mon Mar 26 10:56:56 2012 +0200
    36.3 @@ -106,22 +106,26 @@
    36.4    (Scala "Natural")
    36.5  
    36.6  setup {*
    36.7 -  fold (Numeral.add_code @{const_name number_code_numeral_inst.number_of_code_numeral}
    36.8 +  fold (Numeral.add_code @{const_name Code_Numeral.Num}
    36.9      false Code_Printer.literal_alternative_numeral) ["Haskell", "Scala"]
   36.10  *}
   36.11  
   36.12  code_instance code_numeral :: equal
   36.13    (Haskell -)
   36.14  
   36.15 -code_const "op + \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral"
   36.16 +code_const "0::code_numeral"
   36.17 +  (Haskell "0")
   36.18 +  (Scala "Natural(0)")
   36.19 +
   36.20 +code_const "plus \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral"
   36.21    (Haskell infixl 6 "+")
   36.22    (Scala infixl 7 "+")
   36.23  
   36.24 -code_const "op - \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral"
   36.25 +code_const "minus \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral"
   36.26    (Haskell infixl 6 "-")
   36.27    (Scala infixl 7 "-")
   36.28  
   36.29 -code_const "op * \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral"
   36.30 +code_const "times \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral"
   36.31    (Haskell infixl 7 "*")
   36.32    (Scala infixl 8 "*")
   36.33  
   36.34 @@ -133,11 +137,11 @@
   36.35    (Haskell infix 4 "==")
   36.36    (Scala infixl 5 "==")
   36.37  
   36.38 -code_const "op \<le> \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> bool"
   36.39 +code_const "less_eq \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> bool"
   36.40    (Haskell infix 4 "<=")
   36.41    (Scala infixl 4 "<=")
   36.42  
   36.43 -code_const "op < \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> bool"
   36.44 +code_const "less \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> bool"
   36.45    (Haskell infix 4 "<")
   36.46    (Scala infixl 4 "<")
   36.47  
    37.1 --- a/src/HOL/Library/Code_Prolog.thy	Fri Mar 23 20:32:43 2012 +0100
    37.2 +++ b/src/HOL/Library/Code_Prolog.thy	Mon Mar 26 10:56:56 2012 +0200
    37.3 @@ -11,8 +11,10 @@
    37.4  
    37.5  section {* Setup for Numerals *}
    37.6  
    37.7 -setup {* Predicate_Compile_Data.ignore_consts [@{const_name number_of}] *}
    37.8 -setup {* Predicate_Compile_Data.keep_functions [@{const_name number_of}] *}
    37.9 +setup {* Predicate_Compile_Data.ignore_consts
   37.10 +  [@{const_name numeral}, @{const_name neg_numeral}] *}
   37.11 +
   37.12 +setup {* Predicate_Compile_Data.keep_functions
   37.13 +  [@{const_name numeral}, @{const_name neg_numeral}] *}
   37.14  
   37.15  end
   37.16 -
    38.1 --- a/src/HOL/Library/Code_Real_Approx_By_Float.thy	Fri Mar 23 20:32:43 2012 +0100
    38.2 +++ b/src/HOL/Library/Code_Real_Approx_By_Float.thy	Mon Mar 26 10:56:56 2012 +0200
    38.3 @@ -129,9 +129,23 @@
    38.4  lemma of_int_eq_real_of_int[code_unfold]: "of_int = real_of_int"
    38.5    unfolding real_of_int_def ..
    38.6  
    38.7 -hide_const (open) real_of_int
    38.8 +lemma [code_unfold del]:
    38.9 +  "0 \<equiv> (of_rat 0 :: real)"
   38.10 +  by simp
   38.11 +
   38.12 +lemma [code_unfold del]:
   38.13 +  "1 \<equiv> (of_rat 1 :: real)"
   38.14 +  by simp
   38.15  
   38.16 -declare number_of_real_code [code_unfold del]
   38.17 +lemma [code_unfold del]:
   38.18 +  "numeral k \<equiv> (of_rat (numeral k) :: real)"
   38.19 +  by simp
   38.20 +
   38.21 +lemma [code_unfold del]:
   38.22 +  "neg_numeral k \<equiv> (of_rat (neg_numeral k) :: real)"
   38.23 +  by simp
   38.24 +
   38.25 +hide_const (open) real_of_int
   38.26  
   38.27  notepad
   38.28  begin
    39.1 --- a/src/HOL/Library/Efficient_Nat.thy	Fri Mar 23 20:32:43 2012 +0100
    39.2 +++ b/src/HOL/Library/Efficient_Nat.thy	Mon Mar 26 10:56:56 2012 +0200
    39.3 @@ -5,175 +5,16 @@
    39.4  header {* Implementation of natural numbers by target-language integers *}
    39.5  
    39.6  theory Efficient_Nat
    39.7 -imports Code_Integer Main
    39.8 +imports Code_Nat Code_Integer Main
    39.9  begin
   39.10  
   39.11  text {*
   39.12 -  When generating code for functions on natural numbers, the
   39.13 -  canonical representation using @{term "0::nat"} and
   39.14 -  @{term Suc} is unsuitable for computations involving large
   39.15 -  numbers.  The efficiency of the generated code can be improved
   39.16 +  The efficiency of the generated code for natural numbers can be improved
   39.17    drastically by implementing natural numbers by target-language
   39.18    integers.  To do this, just include this theory.
   39.19  *}
   39.20  
   39.21 -subsection {* Basic arithmetic *}
   39.22 -
   39.23 -text {*
   39.24 -  Most standard arithmetic functions on natural numbers are implemented
   39.25 -  using their counterparts on the integers:
   39.26 -*}
   39.27 -
   39.28 -code_datatype number_nat_inst.number_of_nat
   39.29 -
   39.30 -lemma zero_nat_code [code, code_unfold]:
   39.31 -  "0 = (Numeral0 :: nat)"
   39.32 -  by simp
   39.33 -
   39.34 -lemma one_nat_code [code, code_unfold]:
   39.35 -  "1 = (Numeral1 :: nat)"
   39.36 -  by simp
   39.37 -
   39.38 -lemma Suc_code [code]:
   39.39 -  "Suc n = n + 1"
   39.40 -  by simp
   39.41 -
   39.42 -lemma plus_nat_code [code]:
   39.43 -  "n + m = nat (of_nat n + of_nat m)"
   39.44 -  by simp
   39.45 -
   39.46 -lemma minus_nat_code [code]:
   39.47 -  "n - m = nat (of_nat n - of_nat m)"
   39.48 -  by simp
   39.49 -
   39.50 -lemma times_nat_code [code]:
   39.51 -  "n * m = nat (of_nat n * of_nat m)"
   39.52 -  unfolding of_nat_mult [symmetric] by simp
   39.53 -
   39.54 -lemma divmod_nat_code [code]:
   39.55 -  "divmod_nat n m = map_pair nat nat (pdivmod (of_nat n) (of_nat m))"
   39.56 -  by (simp add: map_pair_def split_def pdivmod_def nat_div_distrib nat_mod_distrib divmod_nat_div_mod)
   39.57 -
   39.58 -lemma eq_nat_code [code]:
   39.59 -  "HOL.equal n m \<longleftrightarrow> HOL.equal (of_nat n \<Colon> int) (of_nat m)"
   39.60 -  by (simp add: equal)
   39.61 -
   39.62 -lemma eq_nat_refl [code nbe]:
   39.63 -  "HOL.equal (n::nat) n \<longleftrightarrow> True"
   39.64 -  by (rule equal_refl)
   39.65 -
   39.66 -lemma less_eq_nat_code [code]:
   39.67 -  "n \<le> m \<longleftrightarrow> (of_nat n \<Colon> int) \<le> of_nat m"
   39.68 -  by simp
   39.69 -
   39.70 -lemma less_nat_code [code]:
   39.71 -  "n < m \<longleftrightarrow> (of_nat n \<Colon> int) < of_nat m"
   39.72 -  by simp
   39.73 -
   39.74 -subsection {* Case analysis *}
   39.75 -
   39.76 -text {*
   39.77 -  Case analysis on natural numbers is rephrased using a conditional
   39.78 -  expression:
   39.79 -*}
   39.80 -
   39.81 -lemma [code, code_unfold]:
   39.82 -  "nat_case = (\<lambda>f g n. if n = 0 then f else g (n - 1))"
   39.83 -  by (auto simp add: fun_eq_iff dest!: gr0_implies_Suc)
   39.84 -
   39.85 -
   39.86 -subsection {* Preprocessors *}
   39.87 -
   39.88 -text {*
   39.89 -  In contrast to @{term "Suc n"}, the term @{term "n + (1::nat)"} is no longer
   39.90 -  a constructor term. Therefore, all occurrences of this term in a position
   39.91 -  where a pattern is expected (i.e.\ on the left-hand side of a recursion
   39.92 -  equation or in the arguments of an inductive relation in an introduction
   39.93 -  rule) must be eliminated.
   39.94 -  This can be accomplished by applying the following transformation rules:
   39.95 -*}
   39.96 -
   39.97 -lemma Suc_if_eq: "(\<And>n. f (Suc n) \<equiv> h n) \<Longrightarrow> f 0 \<equiv> g \<Longrightarrow>
   39.98 -  f n \<equiv> if n = 0 then g else h (n - 1)"
   39.99 -  by (rule eq_reflection) (cases n, simp_all)
  39.100 -
  39.101 -lemma Suc_clause: "(\<And>n. P n (Suc n)) \<Longrightarrow> n \<noteq> 0 \<Longrightarrow> P (n - 1) n"
  39.102 -  by (cases n) simp_all
  39.103 -
  39.104 -text {*
  39.105 -  The rules above are built into a preprocessor that is plugged into
  39.106 -  the code generator. Since the preprocessor for introduction rules
  39.107 -  does not know anything about modes, some of the modes that worked
  39.108 -  for the canonical representation of natural numbers may no longer work.
  39.109 -*}
  39.110 -
  39.111 -(*<*)
  39.112 -setup {*
  39.113 -let
  39.114 -
  39.115 -fun remove_suc thy thms =
  39.116 -  let
  39.117 -    val vname = singleton (Name.variant_list (map fst
  39.118 -      (fold (Term.add_var_names o Thm.full_prop_of) thms []))) "n";
  39.119 -    val cv = cterm_of thy (Var ((vname, 0), HOLogic.natT));
  39.120 -    fun lhs_of th = snd (Thm.dest_comb
  39.121 -      (fst (Thm.dest_comb (cprop_of th))));
  39.122 -    fun rhs_of th = snd (Thm.dest_comb (cprop_of th));
  39.123 -    fun find_vars ct = (case term_of ct of
  39.124 -        (Const (@{const_name Suc}, _) $ Var _) => [(cv, snd (Thm.dest_comb ct))]
  39.125 -      | _ $ _ =>
  39.126 -        let val (ct1, ct2) = Thm.dest_comb ct
  39.127 -        in 
  39.128 -          map (apfst (fn ct => Thm.apply ct ct2)) (find_vars ct1) @
  39.129 -          map (apfst (Thm.apply ct1)) (find_vars ct2)
  39.130 -        end
  39.131 -      | _ => []);
  39.132 -    val eqs = maps
  39.133 -      (fn th => map (pair th) (find_vars (lhs_of th))) thms;
  39.134 -    fun mk_thms (th, (ct, cv')) =
  39.135 -      let
  39.136 -        val th' =
  39.137 -          Thm.implies_elim
  39.138 -           (Conv.fconv_rule (Thm.beta_conversion true)
  39.139 -             (Drule.instantiate'
  39.140 -               [SOME (ctyp_of_term ct)] [SOME (Thm.lambda cv ct),
  39.141 -                 SOME (Thm.lambda cv' (rhs_of th)), NONE, SOME cv']
  39.142 -               @{thm Suc_if_eq})) (Thm.forall_intr cv' th)
  39.143 -      in
  39.144 -        case map_filter (fn th'' =>
  39.145 -            SOME (th'', singleton
  39.146 -              (Variable.trade (K (fn [th'''] => [th''' RS th']))
  39.147 -                (Variable.global_thm_context th'')) th'')
  39.148 -          handle THM _ => NONE) thms of
  39.149 -            [] => NONE
  39.150 -          | thps =>
  39.151 -              let val (ths1, ths2) = split_list thps
  39.152 -              in SOME (subtract Thm.eq_thm (th :: ths1) thms @ ths2) end
  39.153 -      end
  39.154 -  in get_first mk_thms eqs end;
  39.155 -
  39.156 -fun eqn_suc_base_preproc thy thms =
  39.157 -  let
  39.158 -    val dest = fst o Logic.dest_equals o prop_of;
  39.159 -    val contains_suc = exists_Const (fn (c, _) => c = @{const_name Suc});
  39.160 -  in
  39.161 -    if forall (can dest) thms andalso exists (contains_suc o dest) thms
  39.162 -      then thms |> perhaps_loop (remove_suc thy) |> (Option.map o map) Drule.zero_var_indexes
  39.163 -       else NONE
  39.164 -  end;
  39.165 -
  39.166 -val eqn_suc_preproc = Code_Preproc.simple_functrans eqn_suc_base_preproc;
  39.167 -
  39.168 -in
  39.169 -
  39.170 -  Code_Preproc.add_functrans ("eqn_Suc", eqn_suc_preproc)
  39.171 -
  39.172 -end;
  39.173 -*}
  39.174 -(*>*)
  39.175 -
  39.176 -
  39.177 -subsection {* Target language setup *}
  39.178 +subsection {* Target language fundamentals *}
  39.179  
  39.180  text {*
  39.181    For ML, we map @{typ nat} to target language integers, where we
  39.182 @@ -282,47 +123,32 @@
  39.183  code_instance nat :: equal
  39.184    (Haskell -)
  39.185  
  39.186 -text {*
  39.187 -  Natural numerals.
  39.188 -*}
  39.189 -
  39.190 -lemma [code_abbrev]:
  39.191 -  "number_nat_inst.number_of_nat i = nat (number_of i)"
  39.192 -  -- {* this interacts as desired with @{thm nat_number_of_def} *}
  39.193 -  by (simp add: number_nat_inst.number_of_nat)
  39.194 -
  39.195  setup {*
  39.196 -  fold (Numeral.add_code @{const_name number_nat_inst.number_of_nat}
  39.197 +  fold (Numeral.add_code @{const_name nat_of_num}
  39.198      false Code_Printer.literal_positive_numeral) ["SML", "OCaml", "Haskell", "Scala"]
  39.199  *}
  39.200  
  39.201 +code_const "0::nat"
  39.202 +  (SML "0")
  39.203 +  (OCaml "Big'_int.zero'_big'_int")
  39.204 +  (Haskell "0")
  39.205 +  (Scala "Nat(0)")
  39.206 +
  39.207 +
  39.208 +subsection {* Conversions *}
  39.209 +
  39.210  text {*
  39.211    Since natural numbers are implemented
  39.212 -  using integers in ML, the coercion function @{const "of_nat"} of type
  39.213 +  using integers in ML, the coercion function @{term "int"} of type
  39.214    @{typ "nat \<Rightarrow> int"} is simply implemented by the identity function.
  39.215    For the @{const nat} function for converting an integer to a natural
  39.216 -  number, we give a specific implementation using an ML function that
  39.217 +  number, we give a specific implementation using an ML expression that
  39.218    returns its input value, provided that it is non-negative, and otherwise
  39.219    returns @{text "0"}.
  39.220  *}
  39.221  
  39.222  definition int :: "nat \<Rightarrow> int" where
  39.223 -  [code del, code_abbrev]: "int = of_nat"
  39.224 -
  39.225 -lemma int_code' [code]:
  39.226 -  "int (number_of l) = (if neg (number_of l \<Colon> int) then 0 else number_of l)"
  39.227 -  unfolding int_nat_number_of [folded int_def] ..
  39.228 -
  39.229 -lemma nat_code' [code]:
  39.230 -  "nat (number_of l) = (if neg (number_of l \<Colon> int) then 0 else number_of l)"
  39.231 -  unfolding nat_number_of_def number_of_is_id neg_def by simp
  39.232 -
  39.233 -lemma of_nat_int: (* FIXME delete candidate *)
  39.234 -  "of_nat = int" by (simp add: int_def)
  39.235 -
  39.236 -lemma of_nat_aux_int [code_unfold]:
  39.237 -  "of_nat_aux (\<lambda>i. i + 1) k 0 = int k"
  39.238 -  by (simp add: int_def Nat.of_nat_code)
  39.239 +  [code_abbrev]: "int = of_nat"
  39.240  
  39.241  code_const int
  39.242    (SML "_")
  39.243 @@ -331,7 +157,7 @@
  39.244  code_const nat
  39.245    (SML "IntInf.max/ (0,/ _)")
  39.246    (OCaml "Big'_int.max'_big'_int/ Big'_int.zero'_big'_int")
  39.247 -  (Eval "Integer.max/ _/ 0")
  39.248 +  (Eval "Integer.max/ 0")
  39.249  
  39.250  text {* For Haskell and Scala, things are slightly different again. *}
  39.251  
  39.252 @@ -339,7 +165,26 @@
  39.253    (Haskell "toInteger" and "fromInteger")
  39.254    (Scala "!_.as'_BigInt" and "Nat")
  39.255  
  39.256 -text {* Conversion from and to code numerals. *}
  39.257 +text {* Alternativ implementation for @{const of_nat} *}
  39.258 +
  39.259 +lemma [code]:
  39.260 +  "of_nat n = (if n = 0 then 0 else
  39.261 +     let
  39.262 +       (q, m) = divmod_nat n 2;
  39.263 +       q' = 2 * of_nat q
  39.264 +     in if m = 0 then q' else q' + 1)"
  39.265 +proof -
  39.266 +  from mod_div_equality have *: "of_nat n = of_nat (n div 2 * 2 + n mod 2)" by simp
  39.267 +  show ?thesis
  39.268 +    apply (simp add: Let_def divmod_nat_div_mod mod_2_not_eq_zero_eq_one_nat
  39.269 +      of_nat_mult
  39.270 +      of_nat_add [symmetric])
  39.271 +    apply (auto simp add: of_nat_mult)
  39.272 +    apply (simp add: * of_nat_mult add_commute mult_commute)
  39.273 +    done
  39.274 +qed
  39.275 +
  39.276 +text {* Conversion from and to code numerals *}
  39.277  
  39.278  code_const Code_Numeral.of_nat
  39.279    (SML "IntInf.toInt")
  39.280 @@ -355,21 +200,38 @@
  39.281    (Scala "!Nat(_.as'_BigInt)")
  39.282    (Eval "_")
  39.283  
  39.284 -text {* Using target language arithmetic operations whenever appropriate *}
  39.285 +
  39.286 +subsection {* Target language arithmetic *}
  39.287  
  39.288 -code_const "op + \<Colon> nat \<Rightarrow> nat \<Rightarrow> nat"
  39.289 -  (SML "IntInf.+ ((_), (_))")
  39.290 +code_const "plus \<Colon> nat \<Rightarrow> nat \<Rightarrow> nat"
  39.291 +  (SML "IntInf.+/ ((_),/ (_))")
  39.292    (OCaml "Big'_int.add'_big'_int")
  39.293    (Haskell infixl 6 "+")
  39.294    (Scala infixl 7 "+")
  39.295    (Eval infixl 8 "+")
  39.296  
  39.297 -code_const "op - \<Colon> nat \<Rightarrow> nat \<Rightarrow> nat"
  39.298 +code_const "minus \<Colon> nat \<Rightarrow> nat \<Rightarrow> nat"
  39.299 +  (SML "IntInf.max/ (0, IntInf.-/ ((_),/ (_)))")
  39.300 +  (OCaml "Big'_int.max'_big'_int/ Big'_int.zero'_big'_int/ (Big'_int.sub'_big'_int/ _/ _)")
  39.301    (Haskell infixl 6 "-")
  39.302    (Scala infixl 7 "-")
  39.303 +  (Eval "Integer.max/ 0/ (_ -/ _)")
  39.304  
  39.305 -code_const "op * \<Colon> nat \<Rightarrow> nat \<Rightarrow> nat"
  39.306 -  (SML "IntInf.* ((_), (_))")
  39.307 +code_const Code_Nat.dup
  39.308 +  (SML "IntInf.*/ (2,/ (_))")
  39.309 +  (OCaml "Big'_int.mult'_big'_int/ 2")
  39.310 +  (Haskell "!(2 * _)")
  39.311 +  (Scala "!(2 * _)")
  39.312 +  (Eval "!(2 * _)")
  39.313 +
  39.314 +code_const Code_Nat.sub
  39.315 +  (SML "!(raise/ Fail/ \"sub\")")
  39.316 +  (OCaml "failwith/ \"sub\"")
  39.317 +  (Haskell "error/ \"sub\"")
  39.318 +  (Scala "!error(\"sub\")")
  39.319 +
  39.320 +code_const "times \<Colon> nat \<Rightarrow> nat \<Rightarrow> nat"
  39.321 +  (SML "IntInf.*/ ((_),/ (_))")
  39.322    (OCaml "Big'_int.mult'_big'_int")
  39.323    (Haskell infixl 7 "*")
  39.324    (Scala infixl 8 "*")
  39.325 @@ -389,22 +251,28 @@
  39.326    (Scala infixl 5 "==")
  39.327    (Eval infixl 6 "=")
  39.328  
  39.329 -code_const "op \<le> \<Colon> nat \<Rightarrow> nat \<Rightarrow> bool"
  39.330 -  (SML "IntInf.<= ((_), (_))")
  39.331 +code_const "less_eq \<Colon> nat \<Rightarrow> nat \<Rightarrow> bool"
  39.332 +  (SML "IntInf.<=/ ((_),/ (_))")
  39.333    (OCaml "Big'_int.le'_big'_int")
  39.334    (Haskell infix 4 "<=")
  39.335    (Scala infixl 4 "<=")
  39.336    (Eval infixl 6 "<=")
  39.337  
  39.338 -code_const "op < \<Colon> nat \<Rightarrow> nat \<Rightarrow> bool"
  39.339 -  (SML "IntInf.< ((_), (_))")
  39.340 +code_const "less \<Colon> nat \<Rightarrow> nat \<Rightarrow> bool"
  39.341 +  (SML "IntInf.</ ((_),/ (_))")
  39.342    (OCaml "Big'_int.lt'_big'_int")
  39.343    (Haskell infix 4 "<")
  39.344    (Scala infixl 4 "<")
  39.345    (Eval infixl 6 "<")
  39.346  
  39.347 +code_const Num.num_of_nat
  39.348 +  (SML "!(raise/ Fail/ \"num'_of'_nat\")")
  39.349 +  (OCaml "failwith/ \"num'_of'_nat\"")
  39.350 +  (Haskell "error/ \"num'_of'_nat\"")
  39.351 +  (Scala "!error(\"num'_of'_nat\")")
  39.352  
  39.353 -text {* Evaluation *}
  39.354 +
  39.355 +subsection {* Evaluation *}
  39.356  
  39.357  lemma [code, code del]:
  39.358    "(Code_Evaluation.term_of \<Colon> nat \<Rightarrow> term) = Code_Evaluation.term_of" ..
  39.359 @@ -412,14 +280,14 @@
  39.360  code_const "Code_Evaluation.term_of \<Colon> nat \<Rightarrow> term"
  39.361    (SML "HOLogic.mk'_number/ HOLogic.natT")
  39.362  
  39.363 -text {* Evaluation with @{text "Quickcheck_Narrowing"} does not work, as
  39.364 +text {*
  39.365 +  FIXME -- Evaluation with @{text "Quickcheck_Narrowing"} does not work, as
  39.366    @{text "code_module"} is very aggressive leading to bad Haskell code.
  39.367    Therefore, we simply deactivate the narrowing-based quickcheck from here on.
  39.368  *}
  39.369  
  39.370  declare [[quickcheck_narrowing_active = false]] 
  39.371  
  39.372 -text {* Module names *}
  39.373  
  39.374  code_modulename SML
  39.375    Efficient_Nat Arith
  39.376 @@ -430,6 +298,6 @@
  39.377  code_modulename Haskell
  39.378    Efficient_Nat Arith
  39.379  
  39.380 -hide_const int
  39.381 +hide_const (open) int
  39.382  
  39.383  end
    40.1 --- a/src/HOL/Library/Extended_Nat.thy	Fri Mar 23 20:32:43 2012 +0100
    40.2 +++ b/src/HOL/Library/Extended_Nat.thy	Mon Mar 26 10:56:56 2012 +0200
    40.3 @@ -61,19 +61,17 @@
    40.4  primrec the_enat :: "enat \<Rightarrow> nat"
    40.5    where "the_enat (enat n) = n"
    40.6  
    40.7 +
    40.8  subsection {* Constructors and numbers *}
    40.9  
   40.10 -instantiation enat :: "{zero, one, number}"
   40.11 +instantiation enat :: "{zero, one}"
   40.12  begin
   40.13  
   40.14  definition
   40.15    "0 = enat 0"
   40.16  
   40.17  definition
   40.18 -  [code_unfold]: "1 = enat 1"
   40.19 -
   40.20 -definition
   40.21 -  [code_unfold, code del]: "number_of k = enat (number_of k)"
   40.22 +  "1 = enat 1"
   40.23  
   40.24  instance ..
   40.25  
   40.26 @@ -82,15 +80,12 @@
   40.27  definition eSuc :: "enat \<Rightarrow> enat" where
   40.28    "eSuc i = (case i of enat n \<Rightarrow> enat (Suc n) | \<infinity> \<Rightarrow> \<infinity>)"
   40.29  
   40.30 -lemma enat_0: "enat 0 = 0"
   40.31 +lemma enat_0 [code_post]: "enat 0 = 0"
   40.32    by (simp add: zero_enat_def)
   40.33  
   40.34 -lemma enat_1: "enat 1 = 1"
   40.35 +lemma enat_1 [code_post]: "enat 1 = 1"
   40.36    by (simp add: one_enat_def)
   40.37  
   40.38 -lemma enat_number: "enat (number_of k) = number_of k"
   40.39 -  by (simp add: number_of_enat_def)
   40.40 -
   40.41  lemma one_eSuc: "1 = eSuc 0"
   40.42    by (simp add: zero_enat_def one_enat_def eSuc_def)
   40.43  
   40.44 @@ -100,16 +95,6 @@
   40.45  lemma i0_ne_infinity [simp]: "0 \<noteq> (\<infinity>::enat)"
   40.46    by (simp add: zero_enat_def)
   40.47  
   40.48 -lemma zero_enat_eq [simp]:
   40.49 -  "number_of k = (0\<Colon>enat) \<longleftrightarrow> number_of k = (0\<Colon>nat)"
   40.50 -  "(0\<Colon>enat) = number_of k \<longleftrightarrow> number_of k = (0\<Colon>nat)"
   40.51 -  unfolding zero_enat_def number_of_enat_def by simp_all
   40.52 -
   40.53 -lemma one_enat_eq [simp]:
   40.54 -  "number_of k = (1\<Colon>enat) \<longleftrightarrow> number_of k = (1\<Colon>nat)"
   40.55 -  "(1\<Colon>enat) = number_of k \<longleftrightarrow> number_of k = (1\<Colon>nat)"
   40.56 -  unfolding one_enat_def number_of_enat_def by simp_all
   40.57 -
   40.58  lemma zero_one_enat_neq [simp]:
   40.59    "\<not> 0 = (1\<Colon>enat)"
   40.60    "\<not> 1 = (0\<Colon>enat)"
   40.61 @@ -121,18 +106,9 @@
   40.62  lemma i1_ne_infinity [simp]: "1 \<noteq> (\<infinity>::enat)"
   40.63    by (simp add: one_enat_def)
   40.64  
   40.65 -lemma infinity_ne_number [simp]: "(\<infinity>::enat) \<noteq> number_of k"
   40.66 -  by (simp add: number_of_enat_def)
   40.67 -
   40.68 -lemma number_ne_infinity [simp]: "number_of k \<noteq> (\<infinity>::enat)"
   40.69 -  by (simp add: number_of_enat_def)
   40.70 -
   40.71  lemma eSuc_enat: "eSuc (enat n) = enat (Suc n)"
   40.72    by (simp add: eSuc_def)
   40.73  
   40.74 -lemma eSuc_number_of: "eSuc (number_of k) = enat (Suc (number_of k))"
   40.75 -  by (simp add: eSuc_enat number_of_enat_def)
   40.76 -
   40.77  lemma eSuc_infinity [simp]: "eSuc \<infinity> = \<infinity>"
   40.78    by (simp add: eSuc_def)
   40.79  
   40.80 @@ -145,11 +121,6 @@
   40.81  lemma eSuc_inject [simp]: "eSuc m = eSuc n \<longleftrightarrow> m = n"
   40.82    by (simp add: eSuc_def split: enat.splits)
   40.83  
   40.84 -lemma number_of_enat_inject [simp]:
   40.85 -  "(number_of k \<Colon> enat) = number_of l \<longleftrightarrow> (number_of k \<Colon> nat) = number_of l"
   40.86 -  by (simp add: number_of_enat_def)
   40.87 -
   40.88 -
   40.89  subsection {* Addition *}
   40.90  
   40.91  instantiation enat :: comm_monoid_add
   40.92 @@ -177,16 +148,6 @@
   40.93  
   40.94  end
   40.95  
   40.96 -lemma plus_enat_number [simp]:
   40.97 -  "(number_of k \<Colon> enat) + number_of l = (if k < Int.Pls then number_of l
   40.98 -    else if l < Int.Pls then number_of k else number_of (k + l))"
   40.99 -  unfolding number_of_enat_def plus_enat_simps nat_arith(1) if_distrib [symmetric, of _ enat] ..
  40.100 -
  40.101 -lemma eSuc_number [simp]:
  40.102 -  "eSuc (number_of k) = (if neg (number_of k \<Colon> int) then 1 else number_of (Int.succ k))"
  40.103 -  unfolding eSuc_number_of
  40.104 -  unfolding one_enat_def number_of_enat_def Suc_nat_number_of if_distrib [symmetric] ..
  40.105 -
  40.106  lemma eSuc_plus_1:
  40.107    "eSuc n = n + 1"
  40.108    by (cases n) (simp_all add: eSuc_enat one_enat_def)
  40.109 @@ -261,12 +222,6 @@
  40.110    apply (simp add: plus_1_eSuc eSuc_enat)
  40.111    done
  40.112  
  40.113 -instance enat :: number_semiring
  40.114 -proof
  40.115 -  fix n show "number_of (int n) = (of_nat n :: enat)"
  40.116 -    unfolding number_of_enat_def number_of_int of_nat_id of_nat_eq_enat ..
  40.117 -qed
  40.118 -
  40.119  instance enat :: semiring_char_0 proof
  40.120    have "inj enat" by (rule injI) simp
  40.121    then show "inj (\<lambda>n. of_nat n :: enat)" by (simp add: of_nat_eq_enat)
  40.122 @@ -279,6 +234,25 @@
  40.123    by (auto simp add: times_enat_def zero_enat_def split: enat.split)
  40.124  
  40.125  
  40.126 +subsection {* Numerals *}
  40.127 +
  40.128 +lemma numeral_eq_enat:
  40.129 +  "numeral k = enat (numeral k)"
  40.130 +  using of_nat_eq_enat [of "numeral k"] by simp
  40.131 +
  40.132 +lemma enat_numeral [code_abbrev]:
  40.133 +  "enat (numeral k) = numeral k"
  40.134 +  using numeral_eq_enat ..
  40.135 +
  40.136 +lemma infinity_ne_numeral [simp]: "(\<infinity>::enat) \<noteq> numeral k"
  40.137 +  by (simp add: numeral_eq_enat)
  40.138 +
  40.139 +lemma numeral_ne_infinity [simp]: "numeral k \<noteq> (\<infinity>::enat)"
  40.140 +  by (simp add: numeral_eq_enat)
  40.141 +
  40.142 +lemma eSuc_numeral [simp]: "eSuc (numeral k) = numeral (k + Num.One)"
  40.143 +  by (simp only: eSuc_plus_1 numeral_plus_one)
  40.144 +
  40.145  subsection {* Subtraction *}
  40.146  
  40.147  instantiation enat :: minus
  40.148 @@ -292,13 +266,13 @@
  40.149  
  40.150  end
  40.151  
  40.152 -lemma idiff_enat_enat [simp,code]: "enat a - enat b = enat (a - b)"
  40.153 +lemma idiff_enat_enat [simp, code]: "enat a - enat b = enat (a - b)"
  40.154    by (simp add: diff_enat_def)
  40.155  
  40.156 -lemma idiff_infinity [simp,code]: "\<infinity> - n = (\<infinity>::enat)"
  40.157 +lemma idiff_infinity [simp, code]: "\<infinity> - n = (\<infinity>::enat)"
  40.158    by (simp add: diff_enat_def)
  40.159  
  40.160 -lemma idiff_infinity_right [simp,code]: "enat a - \<infinity> = 0"
  40.161 +lemma idiff_infinity_right [simp, code]: "enat a - \<infinity> = 0"
  40.162    by (simp add: diff_enat_def)
  40.163  
  40.164  lemma idiff_0 [simp]: "(0::enat) - n = 0"
  40.165 @@ -344,13 +318,13 @@
  40.166    "(\<infinity>::enat) < q \<longleftrightarrow> False"
  40.167    by (simp_all add: less_eq_enat_def less_enat_def split: enat.splits)
  40.168  
  40.169 -lemma number_of_le_enat_iff[simp]:
  40.170 -  shows "number_of m \<le> enat n \<longleftrightarrow> number_of m \<le> n"
  40.171 -by (auto simp: number_of_enat_def)
  40.172 +lemma numeral_le_enat_iff[simp]:
  40.173 +  shows "numeral m \<le> enat n \<longleftrightarrow> numeral m \<le> n"
  40.174 +by (auto simp: numeral_eq_enat)
  40.175  
  40.176 -lemma number_of_less_enat_iff[simp]:
  40.177 -  shows "number_of m < enat n \<longleftrightarrow> number_of m < n"
  40.178 -by (auto simp: number_of_enat_def)
  40.179 +lemma numeral_less_enat_iff[simp]:
  40.180 +  shows "numeral m < enat n \<longleftrightarrow> numeral m < n"
  40.181 +by (auto simp: numeral_eq_enat)
  40.182  
  40.183  lemma enat_ord_code [code]:
  40.184    "enat m \<le> enat n \<longleftrightarrow> m \<le> n"
  40.185 @@ -375,10 +349,15 @@
  40.186      by (simp split: enat.splits)
  40.187  qed
  40.188  
  40.189 +(* BH: These equations are already proven generally for any type in
  40.190 +class linordered_semidom. However, enat is not in that class because
  40.191 +it does not have the cancellation property. Would it be worthwhile to
  40.192 +a generalize linordered_semidom to a new class that includes enat? *)
  40.193 +
  40.194  lemma enat_ord_number [simp]:
  40.195 -  "(number_of m \<Colon> enat) \<le> number_of n \<longleftrightarrow> (number_of m \<Colon> nat) \<le> number_of n"
  40.196 -  "(number_of m \<Colon> enat) < number_of n \<longleftrightarrow> (number_of m \<Colon> nat) < number_of n"
  40.197 -  by (simp_all add: number_of_enat_def)
  40.198 +  "(numeral m \<Colon> enat) \<le> numeral n \<longleftrightarrow> (numeral m \<Colon> nat) \<le> numeral n"
  40.199 +  "(numeral m \<Colon> enat) < numeral n \<longleftrightarrow> (numeral m \<Colon> nat) < numeral n"
  40.200 +  by (simp_all add: numeral_eq_enat)
  40.201  
  40.202  lemma i0_lb [simp]: "(0\<Colon>enat) \<le> n"
  40.203    by (simp add: zero_enat_def less_eq_enat_def split: enat.splits)
  40.204 @@ -525,10 +504,10 @@
  40.205    val find_first = find_first_t []
  40.206    val trans_tac = Numeral_Simprocs.trans_tac
  40.207    val norm_ss = HOL_basic_ss addsimps
  40.208 -    @{thms add_ac semiring_numeral_0_eq_0 add_0_left add_0_right}
  40.209 +    @{thms add_ac add_0_left add_0_right}
  40.210    fun norm_tac ss = ALLGOALS (simp_tac (Simplifier.inherit_context ss norm_ss))
  40.211    fun simplify_meta_eq ss cancel_th th =
  40.212 -    Arith_Data.simplify_meta_eq @{thms semiring_numeral_0_eq_0} ss
  40.213 +    Arith_Data.simplify_meta_eq [] ss
  40.214        ([th, cancel_th] MRS trans)
  40.215    fun mk_eq (a, b) = HOLogic.mk_Trueprop (HOLogic.mk_eq (a, b))
  40.216  end
  40.217 @@ -646,7 +625,7 @@
  40.218  
  40.219  subsection {* Traditional theorem names *}
  40.220  
  40.221 -lemmas enat_defs = zero_enat_def one_enat_def number_of_enat_def eSuc_def
  40.222 +lemmas enat_defs = zero_enat_def one_enat_def eSuc_def
  40.223    plus_enat_def less_eq_enat_def less_enat_def
  40.224  
  40.225  end
    41.1 --- a/src/HOL/Library/Extended_Real.thy	Fri Mar 23 20:32:43 2012 +0100
    41.2 +++ b/src/HOL/Library/Extended_Real.thy	Mon Mar 26 10:56:56 2012 +0200
    41.3 @@ -124,11 +124,6 @@
    41.4    fix x :: ereal show "x \<in> range uminus" by (intro image_eqI[of _ _ "-x"]) auto
    41.5  qed auto
    41.6  
    41.7 -instantiation ereal :: number
    41.8 -begin
    41.9 -definition [simp]: "number_of x = ereal (number_of x)"
   41.10 -instance ..
   41.11 -end
   41.12  
   41.13  instantiation ereal :: abs
   41.14  begin
   41.15 @@ -671,6 +666,14 @@
   41.16    using assms
   41.17    by (cases rule: ereal3_cases[of a b c]) (simp_all add: field_simps)
   41.18  
   41.19 +instance ereal :: numeral ..
   41.20 +
   41.21 +lemma numeral_eq_ereal [simp]: "numeral w = ereal (numeral w)"
   41.22 +  apply (induct w rule: num_induct)
   41.23 +  apply (simp only: numeral_One one_ereal_def)
   41.24 +  apply (simp only: numeral_inc ereal_plus_1)
   41.25 +  done
   41.26 +
   41.27  lemma ereal_le_epsilon:
   41.28    fixes x y :: ereal
   41.29    assumes "ALL e. 0 < e --> x <= y + e"
   41.30 @@ -781,8 +784,8 @@
   41.31    shows "(- x) ^ n = (if even n then x ^ n else - (x^n))"
   41.32    by (induct n) (auto simp: one_ereal_def)
   41.33  
   41.34 -lemma ereal_power_number_of[simp]:
   41.35 -  "(number_of num :: ereal) ^ n = ereal (number_of num ^ n)"
   41.36 +lemma ereal_power_numeral[simp]:
   41.37 +  "(numeral num :: ereal) ^ n = ereal (numeral num ^ n)"
   41.38    by (induct n) (auto simp: one_ereal_def)
   41.39  
   41.40  lemma zero_le_power_ereal[simp]:
   41.41 @@ -1730,8 +1733,8 @@
   41.42    "ereal_of_enat m \<le> ereal_of_enat n \<longleftrightarrow> m \<le> n"
   41.43  by (cases m n rule: enat2_cases) auto
   41.44  
   41.45 -lemma number_of_le_ereal_of_enat_iff[simp]:
   41.46 -  shows "number_of m \<le> ereal_of_enat n \<longleftrightarrow> number_of m \<le> n"
   41.47 +lemma numeral_le_ereal_of_enat_iff[simp]:
   41.48 +  shows "numeral m \<le> ereal_of_enat n \<longleftrightarrow> numeral m \<le> n"
   41.49  by (cases n) (auto dest: natceiling_le intro: natceiling_le_eq[THEN iffD1])
   41.50  
   41.51  lemma ereal_of_enat_ge_zero_cancel_iff[simp]:
    42.1 --- a/src/HOL/Library/Float.thy	Fri Mar 23 20:32:43 2012 +0100
    42.2 +++ b/src/HOL/Library/Float.thy	Mon Mar 26 10:56:56 2012 +0200
    42.3 @@ -41,18 +41,6 @@
    42.4  instance ..
    42.5  end
    42.6  
    42.7 -instantiation float :: number
    42.8 -begin
    42.9 -definition number_of_float where "number_of n = Float n 0"
   42.10 -instance ..
   42.11 -end
   42.12 -
   42.13 -lemma number_of_float_Float:
   42.14 -  "number_of k = Float (number_of k) 0"
   42.15 -  by (simp add: number_of_float_def number_of_is_id)
   42.16 -
   42.17 -declare number_of_float_Float [symmetric, code_abbrev]
   42.18 -
   42.19  lemma real_of_float_simp[simp]: "real (Float a b) = real a * pow2 b"
   42.20    unfolding real_of_float_def using of_float.simps .
   42.21  
   42.22 @@ -63,12 +51,9 @@
   42.23  lemma Float_num[simp]: shows
   42.24     "real (Float 1 0) = 1" and "real (Float 1 1) = 2" and "real (Float 1 2) = 4" and
   42.25     "real (Float 1 -1) = 1/2" and "real (Float 1 -2) = 1/4" and "real (Float 1 -3) = 1/8" and
   42.26 -   "real (Float -1 0) = -1" and "real (Float (number_of n) 0) = number_of n"
   42.27 +   "real (Float -1 0) = -1" and "real (Float (numeral n) 0) = numeral n"
   42.28    by auto
   42.29  
   42.30 -lemma float_number_of[simp]: "real (number_of x :: float) = number_of x"
   42.31 -  by (simp only:number_of_float_def Float_num[unfolded number_of_is_id])
   42.32 -
   42.33  lemma float_number_of_int[simp]: "real (Float n 0) = real n"
   42.34    by simp
   42.35  
   42.36 @@ -349,6 +334,21 @@
   42.37      by (cases a, cases b) (simp add: plus_float.simps)
   42.38  qed
   42.39  
   42.40 +instance float :: numeral ..
   42.41 +
   42.42 +lemma Float_add_same_scale: "Float x e + Float y e = Float (x + y) e"
   42.43 +  by (simp add: plus_float.simps)
   42.44 +
   42.45 +(* FIXME: define other constant for code_unfold_post *)
   42.46 +lemma numeral_float_Float (*[code_unfold_post]*):
   42.47 +  "numeral k = Float (numeral k) 0"
   42.48 +  by (induct k, simp_all only: numeral.simps one_float_def
   42.49 +    Float_add_same_scale)
   42.50 +
   42.51 +lemma float_number_of[simp]: "real (numeral x :: float) = numeral x"
   42.52 +  by (simp only: numeral_float_Float Float_num)
   42.53 +
   42.54 +
   42.55  instance float :: comm_monoid_mult
   42.56  proof (intro_classes)
   42.57    fix a b c :: float
   42.58 @@ -555,6 +555,7 @@
   42.59    show ?thesis unfolding real_of_float_nge0_exp[OF P] divide_inverse by auto
   42.60  qed
   42.61  
   42.62 +(* BROKEN
   42.63  lemma bitlen_Pls: "bitlen (Int.Pls) = Int.Pls" by (subst Pls_def, subst Pls_def, simp)
   42.64  
   42.65  lemma bitlen_Min: "bitlen (Int.Min) = Int.Bit1 Int.Pls" by (subst Min_def, simp add: Bit1_def) 
   42.66 @@ -588,6 +589,7 @@
   42.67  
   42.68  lemma bitlen_number_of: "bitlen (number_of w) = number_of (bitlen w)"
   42.69    by (simp add: number_of_is_id)
   42.70 +BH *)
   42.71  
   42.72  lemma [code]: "bitlen x = 
   42.73       (if x = 0  then 0 
   42.74 @@ -722,12 +724,12 @@
   42.75      hence "real x / real y < 1" using `0 < y` and `0 \<le> x` by auto
   42.76  
   42.77      from real_of_int_div4[of "?X" y]
   42.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 .
   42.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 .
   42.80      also have "\<dots> < 1 * 2^?l" using `real x / real y < 1` by (rule mult_strict_right_mono, auto)
   42.81      finally have "?X div y < 2^?l" unfolding real_of_int_less_iff[of _ "2^?l", symmetric] by auto
   42.82      hence "?X div y + 1 \<le> 2^?l" by auto
   42.83      hence "real (?X div y + 1) * inverse (2^?l) \<le> 2^?l * inverse (2^?l)"
   42.84 -      unfolding real_of_int_le_iff[of _ "2^?l", symmetric] real_of_int_power real_number_of
   42.85 +      unfolding real_of_int_le_iff[of _ "2^?l", symmetric] real_of_int_power real_numeral
   42.86        by (rule mult_right_mono, auto)
   42.87      hence "real (?X div y + 1) * inverse (2^?l) \<le> 1" by auto
   42.88      thus ?thesis unfolding rapprox_posrat_def Let_def normfloat real_of_float_simp if_not_P[OF False]
   42.89 @@ -796,12 +798,12 @@
   42.90      qed
   42.91  
   42.92      from real_of_int_div4[of "?X" y]
   42.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 .
   42.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 .
   42.95      also have "\<dots> < 1/2 * 2^?l" using `real x / real y < 1/2` by (rule mult_strict_right_mono, auto)
   42.96      finally have "?X div y * 2 < 2^?l" unfolding real_of_int_less_iff[of _ "2^?l", symmetric] by auto
   42.97      hence "?X div y + 1 < 2^?l" using `0 < ?X div y` by auto
   42.98      hence "real (?X div y + 1) * inverse (2^?l) < 2^?l * inverse (2^?l)"
   42.99 -      unfolding real_of_int_less_iff[of _ "2^?l", symmetric] real_of_int_power real_number_of
  42.100 +      unfolding real_of_int_less_iff[of _ "2^?l", symmetric] real_of_int_power real_numeral
  42.101        by (rule mult_strict_right_mono, auto)
  42.102      hence "real (?X div y + 1) * inverse (2^?l) < 1" by auto
  42.103      thus ?thesis unfolding rapprox_posrat_def Let_def normfloat real_of_float_simp if_not_P[OF False]
  42.104 @@ -1195,7 +1197,7 @@
  42.105      case True
  42.106      have "real (m div 2^(nat ?l)) * pow2 ?l \<le> real m"
  42.107      proof -
  42.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] 
  42.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] 
  42.110          using `?l > 0` by auto
  42.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
  42.112        also have "\<dots> = real m" unfolding zmod_zdiv_equality[symmetric] ..
  42.113 @@ -1262,7 +1264,7 @@
  42.114      hence me_eq: "pow2 (-e) = pow2 (int (nat (-e)))" by auto
  42.115      have "real (Float (m div (2 ^ (nat (-e)))) 0) = real (m div 2 ^ (nat (-e)))" unfolding real_of_float_simp by auto
  42.116      also have "\<dots> \<le> real m / real ((2::int) ^ (nat (-e)))" using real_of_int_div4 .
  42.117 -    also have "\<dots> = real m * inverse (2 ^ (nat (-e)))" unfolding real_of_int_power real_number_of divide_inverse ..
  42.118 +    also have "\<dots> = real m * inverse (2 ^ (nat (-e)))" unfolding real_of_int_power real_numeral divide_inverse ..
  42.119      also have "\<dots> = real (Float m e)" unfolding real_of_float_simp me_eq pow2_int pow2_neg[of e] ..
  42.120      finally show ?thesis unfolding Float floor_fl.simps if_not_P[OF `\<not> 0 \<le> e`] .
  42.121    next
  42.122 @@ -1290,7 +1292,7 @@
  42.123      case False
  42.124      hence me_eq: "pow2 (-e) = pow2 (int (nat (-e)))" by auto
  42.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] ..
  42.126 -    also have "\<dots> = real m / real ((2::int) ^ (nat (-e)))" unfolding real_of_int_power real_number_of divide_inverse ..
  42.127 +    also have "\<dots> = real m / real ((2::int) ^ (nat (-e)))" unfolding real_of_int_power real_numeral divide_inverse ..
  42.128      also have "\<dots> \<le> 1 + real (m div 2 ^ (nat (-e)))" using real_of_int_div3[unfolded diff_le_eq] .
  42.129      also have "\<dots> = real (Float (m div (2 ^ (nat (-e))) + 1) 0)" unfolding real_of_float_simp by auto
  42.130      finally show ?thesis unfolding Float ceiling_fl.simps if_not_P[OF `\<not> 0 \<le> e`] .
    43.1 --- a/src/HOL/Library/Formal_Power_Series.thy	Fri Mar 23 20:32:43 2012 +0100
    43.2 +++ b/src/HOL/Library/Formal_Power_Series.thy	Mon Mar 26 10:56:56 2012 +0200
    43.3 @@ -392,25 +392,13 @@
    43.4  
    43.5  instance fps :: (idom) idom ..
    43.6  
    43.7 -instantiation fps :: (comm_ring_1) number_ring
    43.8 -begin
    43.9 -definition number_of_fps_def: "(number_of k::'a fps) = of_int k"
   43.10 -
   43.11 -instance proof
   43.12 -qed (rule number_of_fps_def)
   43.13 -end
   43.14 -
   43.15 -lemma number_of_fps_const: "(number_of k::('a::comm_ring_1) fps) = fps_const (of_int k)"
   43.16 -  
   43.17 -proof(induct k rule: int_induct [where k=0])
   43.18 -  case base thus ?case unfolding number_of_fps_def of_int_0 by simp
   43.19 -next
   43.20 -  case (step1 i) thus ?case unfolding number_of_fps_def 
   43.21 -    by (simp add: fps_const_add[symmetric] del: fps_const_add)
   43.22 -next
   43.23 -  case (step2 i) thus ?case unfolding number_of_fps_def 
   43.24 -    by (simp add: fps_const_sub[symmetric] del: fps_const_sub)
   43.25 -qed
   43.26 +lemma numeral_fps_const: "numeral k = fps_const (numeral k)"
   43.27 +  by (induct k, simp_all only: numeral.simps fps_const_1_eq_1
   43.28 +    fps_const_add [symmetric])
   43.29 +
   43.30 +lemma neg_numeral_fps_const: "neg_numeral k = fps_const (neg_numeral k)"
   43.31 +  by (simp only: neg_numeral_def numeral_fps_const fps_const_neg)
   43.32 +
   43.33  subsection{* The eXtractor series X*}
   43.34  
   43.35  lemma minus_one_power_iff: "(- (1::'a :: {comm_ring_1})) ^ n = (if even n then 1 else - 1)"
   43.36 @@ -1119,7 +1107,7 @@
   43.37    have eq: "(1 + X) * ?r = 1"
   43.38      unfolding minus_one_power_iff
   43.39      by (auto simp add: field_simps fps_eq_iff)
   43.40 -  show ?thesis by (auto simp add: eq intro: fps_inverse_unique)
   43.41 +  show ?thesis by (auto simp add: eq intro: fps_inverse_unique simp del: minus_one)
   43.42  qed
   43.43  
   43.44  
   43.45 @@ -1157,8 +1145,11 @@
   43.46    "fps_const (a::'a::{comm_ring_1}) oo b = fps_const (a)"
   43.47    by (simp add: fps_eq_iff fps_compose_nth mult_delta_left setsum_delta)
   43.48  
   43.49 -lemma number_of_compose[simp]: "(number_of k::('a::{comm_ring_1}) fps) oo b = number_of k"
   43.50 -  unfolding number_of_fps_const by simp
   43.51 +lemma numeral_compose[simp]: "(numeral k::('a::{comm_ring_1}) fps) oo b = numeral k"
   43.52 +  unfolding numeral_fps_const by simp
   43.53 +
   43.54 +lemma neg_numeral_compose[simp]: "(neg_numeral k::('a::{comm_ring_1}) fps) oo b = neg_numeral k"
   43.55 +  unfolding neg_numeral_fps_const by simp
   43.56  
   43.57  lemma X_fps_compose_startby0[simp]: "a$0 = 0 \<Longrightarrow> X oo a = (a :: ('a :: comm_ring_1) fps)"
   43.58    by (simp add: fps_eq_iff fps_compose_def mult_delta_left setsum_delta
   43.59 @@ -2568,7 +2559,7 @@
   43.60    (is "inverse ?l = ?r")
   43.61  proof-
   43.62    have th: "?l * ?r = 1"
   43.63 -    by (auto simp add: field_simps fps_eq_iff minus_one_power_iff)
   43.64 +    by (auto simp add: field_simps fps_eq_iff minus_one_power_iff simp del: minus_one)
   43.65    have th': "?l $ 0 \<noteq> 0" by (simp add: )
   43.66    from fps_inverse_unique[OF th' th] show ?thesis .
   43.67  qed
   43.68 @@ -2765,7 +2756,7 @@
   43.69  proof-
   43.70    have th: "?r$0 \<noteq> 0" by simp
   43.71    have th': "fps_deriv (inverse ?r) = fps_const (- 1) * inverse ?r / (1 + X)"
   43.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)
   43.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)
   43.74    have eq: "inverse ?r $ 0 = 1"
   43.75      by (simp add: fps_inverse_def)
   43.76    from iffD1[OF fps_binomial_ODE_unique[of "inverse (1 + X)" "- 1"] th'] eq
   43.77 @@ -2855,7 +2846,7 @@
   43.78            unfolding m1nk 
   43.79            
   43.80            unfolding m h pochhammer_Suc_setprod
   43.81 -          apply (simp add: field_simps del: fact_Suc id_def)
   43.82 +          apply (simp add: field_simps del: fact_Suc id_def minus_one)
   43.83            unfolding fact_altdef_nat id_def
   43.84            unfolding of_nat_setprod
   43.85            unfolding setprod_timesf[symmetric]
   43.86 @@ -3162,28 +3153,25 @@
   43.87  lemma fps_const_minus: "fps_const (c::'a::group_add) - fps_const d = fps_const (c - d)"
   43.88    by (simp add: fps_eq_iff fps_const_def)
   43.89  
   43.90 -lemma fps_number_of_fps_const: "number_of i = fps_const (number_of i :: 'a:: {comm_ring_1, number_ring})"
   43.91 -  apply (subst (2) number_of_eq)
   43.92 -apply(rule int_induct [of _ 0])
   43.93 -apply (simp_all add: number_of_fps_def)
   43.94 -by (simp_all add: fps_const_add[symmetric] fps_const_minus[symmetric])
   43.95 +lemma fps_numeral_fps_const: "numeral i = fps_const (numeral i :: 'a:: {comm_ring_1})"
   43.96 +  by (fact numeral_fps_const) (* FIXME: duplicate *)
   43.97  
   43.98  lemma fps_cos_Eii:
   43.99    "fps_cos c = (E (ii * c) + E (- ii * c)) / fps_const 2"
  43.100  proof-
  43.101    have th: "fps_cos c + fps_cos c = fps_cos c * fps_const 2" 
  43.102 -    by (simp add: fps_eq_iff fps_number_of_fps_const complex_number_of_def[symmetric])
  43.103 +    by (simp add: numeral_fps_const)
  43.104    show ?thesis
  43.105    unfolding Eii_sin_cos minus_mult_commute
  43.106 -  by (simp add: fps_sin_even fps_cos_odd fps_number_of_fps_const
  43.107 -    fps_divide_def fps_const_inverse th complex_number_of_def[symmetric])
  43.108 +  by (simp add: fps_sin_even fps_cos_odd numeral_fps_const
  43.109 +    fps_divide_def fps_const_inverse th)
  43.110  qed
  43.111  
  43.112  lemma fps_sin_Eii:
  43.113    "fps_sin c = (E (ii * c) - E (- ii * c)) / fps_const (2*ii)"
  43.114  proof-
  43.115    have th: "fps_const \<i> * fps_sin c + fps_const \<i> * fps_sin c = fps_sin c * fps_const (2 * ii)" 
  43.116 -    by (simp add: fps_eq_iff fps_number_of_fps_const complex_number_of_def[symmetric])
  43.117 +    by (simp add: fps_eq_iff numeral_fps_const)
  43.118    show ?thesis
  43.119    unfolding Eii_sin_cos minus_mult_commute
  43.120    by (simp add: fps_sin_even fps_cos_odd fps_divide_def fps_const_inverse th)
    44.1 --- a/src/HOL/Library/Numeral_Type.thy	Fri Mar 23 20:32:43 2012 +0100
    44.2 +++ b/src/HOL/Library/Numeral_Type.thy	Mon Mar 26 10:56:56 2012 +0200
    44.3 @@ -66,7 +66,6 @@
    44.4      by simp
    44.5  qed
    44.6  
    44.7 -
    44.8  subsection {* Locales for for modular arithmetic subtypes *}
    44.9  
   44.10  locale mod_type =
   44.11 @@ -137,8 +136,8 @@
   44.12  
   44.13  locale mod_ring = mod_type n Rep Abs
   44.14    for n :: int
   44.15 -  and Rep :: "'a::{number_ring} \<Rightarrow> int"
   44.16 -  and Abs :: "int \<Rightarrow> 'a::{number_ring}"
   44.17 +  and Rep :: "'a::{comm_ring_1} \<Rightarrow> int"
   44.18 +  and Abs :: "int \<Rightarrow> 'a::{comm_ring_1}"
   44.19  begin
   44.20  
   44.21  lemma of_nat_eq: "of_nat k = Abs (int k mod n)"
   44.22 @@ -152,13 +151,14 @@
   44.23  apply (simp add: Rep_simps of_nat_eq diff_def zmod_simps)
   44.24  done
   44.25  
   44.26 -lemma Rep_number_of:
   44.27 -  "Rep (number_of w) = number_of w mod n"
   44.28 -by (simp add: number_of_eq of_int_eq Rep_Abs_mod)
   44.29 +lemma Rep_numeral:
   44.30 +  "Rep (numeral w) = numeral w mod n"
   44.31 +using of_int_eq [of "numeral w"]
   44.32 +by (simp add: Rep_inject_sym Rep_Abs_mod)
   44.33  
   44.34 -lemma iszero_number_of:
   44.35 -  "iszero (number_of w::'a) \<longleftrightarrow> number_of w mod n = 0"
   44.36 -by (simp add: Rep_simps number_of_eq of_int_eq iszero_def zero_def)
   44.37 +lemma iszero_numeral:
   44.38 +  "iszero (numeral w::'a) \<longleftrightarrow> numeral w mod n = 0"
   44.39 +by (simp add: Rep_inject_sym Rep_numeral Rep_0 iszero_def)
   44.40  
   44.41  lemma cases:
   44.42    assumes 1: "\<And>z. \<lbrakk>(x::'a) = of_int z; 0 \<le> z; z < n\<rbrakk> \<Longrightarrow> P"
   44.43 @@ -175,14 +175,14 @@
   44.44  end
   44.45  
   44.46  
   44.47 -subsection {* Number ring instances *}
   44.48 +subsection {* Ring class instances *}
   44.49  
   44.50  text {*
   44.51 -  Unfortunately a number ring instance is not possible for
   44.52 +  Unfortunately @{text ring_1} instance is not possible for
   44.53    @{typ num1}, since 0 and 1 are not distinct.
   44.54  *}
   44.55  
   44.56 -instantiation num1 :: "{comm_ring,comm_monoid_mult,number}"
   44.57 +instantiation num1 :: "{comm_ring,comm_monoid_mult,numeral}"
   44.58  begin
   44.59  
   44.60  lemma num1_eq_iff: "(x::num1) = (y::num1) \<longleftrightarrow> True"
   44.61 @@ -252,22 +252,10 @@
   44.62  done
   44.63  
   44.64  instance bit0 :: (finite) comm_ring_1
   44.65 -  by (rule bit0.comm_ring_1)+
   44.66 +  by (rule bit0.comm_ring_1)
   44.67  
   44.68  instance bit1 :: (finite) comm_ring_1
   44.69 -  by (rule bit1.comm_ring_1)+
   44.70 -
   44.71 -instantiation bit0 and bit1 :: (finite) number_ring
   44.72 -begin
   44.73 -
   44.74 -definition "(number_of w :: _ bit0) = of_int w"
   44.75 -
   44.76 -definition "(number_of w :: _ bit1) = of_int w"
   44.77 -
   44.78 -instance proof
   44.79 -qed (rule number_of_bit0_def number_of_bit1_def)+
   44.80 -
   44.81 -end
   44.82 +  by (rule bit1.comm_ring_1)
   44.83  
   44.84  interpretation bit0:
   44.85    mod_ring "int CARD('a::finite bit0)"
   44.86 @@ -289,9 +277,11 @@
   44.87  lemmas bit0_induct [case_names of_int, induct type: bit0] = bit0.induct
   44.88  lemmas bit1_induct [case_names of_int, induct type: bit1] = bit1.induct
   44.89  
   44.90 -lemmas bit0_iszero_number_of [simp] = bit0.iszero_number_of
   44.91 -lemmas bit1_iszero_number_of [simp] = bit1.iszero_number_of
   44.92 +lemmas bit0_iszero_numeral [simp] = bit0.iszero_numeral
   44.93 +lemmas bit1_iszero_numeral [simp] = bit1.iszero_numeral
   44.94  
   44.95 +declare eq_numeral_iff_iszero [where 'a="('a::finite) bit0", standard, simp]
   44.96 +declare eq_numeral_iff_iszero [where 'a="('a::finite) bit1", standard, simp]
   44.97  
   44.98  subsection {* Syntax *}
   44.99  
    45.1 --- a/src/HOL/Library/Poly_Deriv.thy	Fri Mar 23 20:32:43 2012 +0100
    45.2 +++ b/src/HOL/Library/Poly_Deriv.thy	Mon Mar 26 10:56:56 2012 +0200
    45.3 @@ -71,7 +71,8 @@
    45.4  apply (subst power_Suc)
    45.5  apply (subst pderiv_mult)
    45.6  apply (erule ssubst)
    45.7 -apply (simp add: smult_add_left algebra_simps)
    45.8 +apply (simp only: of_nat_Suc smult_add_left smult_1_left)
    45.9 +apply (simp add: algebra_simps) (* FIXME *)
   45.10  done
   45.11  
   45.12  lemma DERIV_cmult2: "DERIV f x :> D ==> DERIV (%x. (f x) * c :: real) x :> D * c"
    46.1 --- a/src/HOL/Library/Polynomial.thy	Fri Mar 23 20:32:43 2012 +0100
    46.2 +++ b/src/HOL/Library/Polynomial.thy	Mon Mar 26 10:56:56 2012 +0200
    46.3 @@ -662,17 +662,6 @@
    46.4  
    46.5  instance poly :: (comm_ring_1) comm_ring_1 ..
    46.6  
    46.7 -instantiation poly :: (comm_ring_1) number_ring
    46.8 -begin
    46.9 -
   46.10 -definition
   46.11 -  "number_of k = (of_int k :: 'a poly)"
   46.12 -
   46.13 -instance
   46.14 -  by default (rule number_of_poly_def)
   46.15 -
   46.16 -end
   46.17 -
   46.18  
   46.19  subsection {* Polynomials form an integral domain *}
   46.20  
   46.21 @@ -1052,12 +1041,12 @@
   46.22  lemma poly_div_minus_left [simp]:
   46.23    fixes x y :: "'a::field poly"
   46.24    shows "(- x) div y = - (x div y)"
   46.25 -  using div_smult_left [of "- 1::'a"] by simp
   46.26 +  using div_smult_left [of "- 1::'a"] by (simp del: minus_one) (* FIXME *)
   46.27  
   46.28  lemma poly_mod_minus_left [simp]:
   46.29    fixes x y :: "'a::field poly"
   46.30    shows "(- x) mod y = - (x mod y)"
   46.31 -  using mod_smult_left [of "- 1::'a"] by simp
   46.32 +  using mod_smult_left [of "- 1::'a"] by (simp del: minus_one) (* FIXME *)
   46.33  
   46.34  lemma pdivmod_rel_smult_right:
   46.35    "\<lbrakk>a \<noteq> 0; pdivmod_rel x y q r\<rbrakk>
   46.36 @@ -1075,12 +1064,12 @@
   46.37    fixes x y :: "'a::field poly"
   46.38    shows "x div (- y) = - (x div y)"
   46.39    using div_smult_right [of "- 1::'a"]
   46.40 -  by (simp add: nonzero_inverse_minus_eq)
   46.41 +  by (simp add: nonzero_inverse_minus_eq del: minus_one) (* FIXME *)
   46.42  
   46.43  lemma poly_mod_minus_right [simp]:
   46.44    fixes x y :: "'a::field poly"
   46.45    shows "x mod (- y) = x mod y"
   46.46 -  using mod_smult_right [of "- 1::'a"] by simp
   46.47 +  using mod_smult_right [of "- 1::'a"] by (simp del: minus_one) (* FIXME *)
   46.48  
   46.49  lemma pdivmod_rel_mult:
   46.50    "\<lbrakk>pdivmod_rel x y q r; pdivmod_rel q z q' r'\<rbrakk>
    47.1 --- a/src/HOL/Library/Predicate_Compile_Alternative_Defs.thy	Fri Mar 23 20:32:43 2012 +0100
    47.2 +++ b/src/HOL/Library/Predicate_Compile_Alternative_Defs.thy	Mon Mar 26 10:56:56 2012 +0200
    47.3 @@ -54,8 +54,8 @@
    47.4  
    47.5  section {* Setup for Numerals *}
    47.6  
    47.7 -setup {* Predicate_Compile_Data.ignore_consts [@{const_name number_of}] *}
    47.8 -setup {* Predicate_Compile_Data.keep_functions [@{const_name number_of}] *}
    47.9 +setup {* Predicate_Compile_Data.ignore_consts [@{const_name numeral}, @{const_name neg_numeral}] *}
   47.10 +setup {* Predicate_Compile_Data.keep_functions [@{const_name numeral}, @{const_name neg_numeral}] *}
   47.11  
   47.12  setup {* Predicate_Compile_Data.ignore_consts [@{const_name div}, @{const_name mod}, @{const_name times}] *}
   47.13  
    48.1 --- a/src/HOL/Library/Quotient_List.thy	Fri Mar 23 20:32:43 2012 +0100
    48.2 +++ b/src/HOL/Library/Quotient_List.thy	Mon Mar 26 10:56:56 2012 +0200
    48.3 @@ -8,8 +8,6 @@
    48.4  imports Main Quotient_Syntax
    48.5  begin
    48.6  
    48.7 -declare [[map list = list_all2]]
    48.8 -
    48.9  lemma map_id [id_simps]:
   48.10    "map id = id"
   48.11    by (fact List.map.id)
   48.12 @@ -75,6 +73,8 @@
   48.13      by (induct xs ys rule: list_induct2') auto
   48.14  qed
   48.15  
   48.16 +declare [[map list = (list_all2, list_quotient)]]
   48.17 +
   48.18  lemma cons_prs [quot_preserve]:
   48.19    assumes q: "Quotient R Abs Rep"
   48.20    shows "(Rep ---> (map Rep) ---> (map Abs)) (op #) = (op #)"
    49.1 --- a/src/HOL/Library/Quotient_Option.thy	Fri Mar 23 20:32:43 2012 +0100
    49.2 +++ b/src/HOL/Library/Quotient_Option.thy	Mon Mar 26 10:56:56 2012 +0200
    49.3 @@ -16,8 +16,6 @@
    49.4  | "option_rel R None (Some x) = False"
    49.5  | "option_rel R (Some x) (Some y) = R x y"
    49.6  
    49.7 -declare [[map option = option_rel]]
    49.8 -
    49.9  lemma option_rel_unfold:
   49.10    "option_rel R x y = (case (x, y) of (None, None) \<Rightarrow> True
   49.11      | (Some x, Some y) \<Rightarrow> R x y
   49.12 @@ -65,6 +63,8 @@
   49.13    apply (simp add: option_rel_unfold split: option.split)
   49.14    done
   49.15  
   49.16 +declare [[map option = (option_rel, option_quotient)]]
   49.17 +
   49.18  lemma option_None_rsp [quot_respect]:
   49.19    assumes q: "Quotient R Abs Rep"
   49.20    shows "option_rel R None None"
    50.1 --- a/src/HOL/Library/Quotient_Product.thy	Fri Mar 23 20:32:43 2012 +0100
    50.2 +++ b/src/HOL/Library/Quotient_Product.thy	Mon Mar 26 10:56:56 2012 +0200
    50.3 @@ -13,8 +13,6 @@
    50.4  where
    50.5    "prod_rel R1 R2 = (\<lambda>(a, b) (c, d). R1 a c \<and> R2 b d)"
    50.6  
    50.7 -declare [[map prod = prod_rel]]
    50.8 -
    50.9  lemma prod_rel_apply [simp]:
   50.10    "prod_rel R1 R2 (a, b) (c, d) \<longleftrightarrow> R1 a c \<and> R2 b d"
   50.11    by (simp add: prod_rel_def)
   50.12 @@ -45,6 +43,8 @@
   50.13    apply (auto simp add: split_paired_all)
   50.14    done
   50.15  
   50.16 +declare [[map prod = (prod_rel, prod_quotient)]]
   50.17 +
   50.18  lemma Pair_rsp [quot_respect]:
   50.19    assumes q1: "Quotient R1 Abs1 Rep1"
   50.20    assumes q2: "Quotient R2 Abs2 Rep2"
    51.1 --- a/src/HOL/Library/Quotient_Set.thy	Fri Mar 23 20:32:43 2012 +0100
    51.2 +++ b/src/HOL/Library/Quotient_Set.thy	Mon Mar 26 10:56:56 2012 +0200
    51.3 @@ -26,6 +26,8 @@
    51.4      by auto (metis rep_abs_rsp[OF assms] assms[simplified Quotient_def])+
    51.5  qed
    51.6  
    51.7 +declare [[map set = (set_rel, set_quotient)]]
    51.8 +
    51.9  lemma empty_set_rsp[quot_respect]:
   51.10    "set_rel R {} {}"
   51.11    unfolding set_rel_def by simp
    52.1 --- a/src/HOL/Library/Quotient_Sum.thy	Fri Mar 23 20:32:43 2012 +0100
    52.2 +++ b/src/HOL/Library/Quotient_Sum.thy	Mon Mar 26 10:56:56 2012 +0200
    52.3 @@ -16,8 +16,6 @@
    52.4  | "sum_rel R1 R2 (Inr a2) (Inl b1) = False"
    52.5  | "sum_rel R1 R2 (Inr a2) (Inr b2) = R2 a2 b2"
    52.6  
    52.7 -declare [[map sum = sum_rel]]
    52.8 -
    52.9  lemma sum_rel_unfold:
   52.10    "sum_rel R1 R2 x y = (case (x, y) of (Inl x, Inl y) \<Rightarrow> R1 x y
   52.11      | (Inr x, Inr y) \<Rightarrow> R2 x y
   52.12 @@ -67,6 +65,8 @@
   52.13    apply (simp add: sum_rel_unfold comp_def split: sum.split)
   52.14    done
   52.15  
   52.16 +declare [[map sum = (sum_rel, sum_quotient)]]
   52.17 +
   52.18  lemma sum_Inl_rsp [quot_respect]:
   52.19    assumes q1: "Quotient R1 Abs1 Rep1"
   52.20    assumes q2: "Quotient R2 Abs2 Rep2"
    53.1 --- a/src/HOL/Library/ROOT.ML	Fri Mar 23 20:32:43 2012 +0100
    53.2 +++ b/src/HOL/Library/ROOT.ML	Mon Mar 26 10:56:56 2012 +0200
    53.3 @@ -4,4 +4,4 @@
    53.4  use_thys ["Library", "List_Cset", "List_Prefix", "List_lexord", "Sublist_Order",
    53.5    "Product_Lattice",
    53.6    "Code_Char_chr", "Code_Char_ord", "Code_Integer", "Efficient_Nat"(*, "Code_Prolog"*),
    53.7 -  "Code_Real_Approx_By_Float" ];
    53.8 +  "Code_Real_Approx_By_Float", "Target_Numeral"];
    54.1 --- a/src/HOL/Library/Saturated.thy	Fri Mar 23 20:32:43 2012 +0100
    54.2 +++ b/src/HOL/Library/Saturated.thy	Mon Mar 26 10:56:56 2012 +0200
    54.3 @@ -157,20 +157,16 @@
    54.4    "nat_of (Sat n :: ('a::len) sat) = min (len_of TYPE('a)) n"
    54.5    by (rule nat_of_Abs_sat' [unfolded Abs_sat'_eq_of_nat])
    54.6  
    54.7 -instantiation sat :: (len) number_semiring
    54.8 -begin
    54.9 +lemma [code_abbrev]:
   54.10 +  "of_nat (numeral k) = (numeral k :: 'a::len sat)"
   54.11 +  by simp
   54.12  
   54.13 -definition
   54.14 -  number_of_sat_def [code del]: "number_of = Sat \<circ> nat"
   54.15 -
   54.16 -instance
   54.17 -  by default (simp add: number_of_sat_def)
   54.18 -
   54.19 -end
   54.20 +definition sat_of_nat :: "nat \<Rightarrow> ('a::len) sat"
   54.21 +  where [code_abbrev]: "sat_of_nat = of_nat"
   54.22  
   54.23  lemma [code abstract]:
   54.24 -  "nat_of (number_of n :: ('a::len) sat) = min (nat n) (len_of TYPE('a))"
   54.25 -  unfolding number_of_sat_def by simp
   54.26 +  "nat_of (sat_of_nat n :: ('a::len) sat) = min (len_of TYPE('a)) n"
   54.27 +  by (simp add: sat_of_nat_def)
   54.28  
   54.29  instance sat :: (len) finite
   54.30  proof
   54.31 @@ -252,4 +248,6 @@
   54.32  
   54.33  end
   54.34  
   54.35 +hide_const (open) sat_of_nat
   54.36 +
   54.37  end
    55.1 --- a/src/HOL/Library/Sum_of_Squares/sum_of_squares.ML	Fri Mar 23 20:32:43 2012 +0100
    55.2 +++ b/src/HOL/Library/Sum_of_Squares/sum_of_squares.ML	Mon Mar 26 10:56:56 2012 +0200
    55.3 @@ -866,10 +866,11 @@
    55.4     @{term "op / :: real => _"}, @{term "inverse :: real => _"},
    55.5     @{term "op ^ :: real => _"}, @{term "abs :: real => _"},
    55.6     @{term "min :: real => _"}, @{term "max :: real => _"},
    55.7 -   @{term "0::real"}, @{term "1::real"}, @{term "number_of :: int => real"},
    55.8 -   @{term "number_of :: int => nat"},
    55.9 -   @{term "Int.Bit0"}, @{term "Int.Bit1"},
   55.10 -   @{term "Int.Pls"}, @{term "Int.Min"}];
   55.11 +   @{term "0::real"}, @{term "1::real"},
   55.12 +   @{term "numeral :: num => nat"},
   55.13 +   @{term "numeral :: num => real"},
   55.14 +   @{term "neg_numeral :: num => real"},
   55.15 +   @{term "Num.Bit0"}, @{term "Num.Bit1"}, @{term "Num.One"}];
   55.16  
   55.17  fun check_sos kcts ct =
   55.18   let
    56.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    56.2 +++ b/src/HOL/Library/Target_Numeral.thy	Mon Mar 26 10:56:56 2012 +0200
    56.3 @@ -0,0 +1,726 @@
    56.4 +theory Target_Numeral
    56.5 +imports Main Code_Nat
    56.6 +begin
    56.7 +
    56.8 +subsection {* Type of target language numerals *}
    56.9 +
   56.10 +typedef (open) int = "UNIV \<Colon> int set"
   56.11 +  morphisms int_of of_int ..
   56.12 +
   56.13 +hide_type (open) int
   56.14 +hide_const (open) of_int
   56.15 +
   56.16 +lemma int_eq_iff:
   56.17 +  "k = l \<longleftrightarrow> int_of k = int_of l"
   56.18 +  using int_of_inject [of k l] ..
   56.19 +
   56.20 +lemma int_eqI:
   56.21 +  "int_of k = int_of l \<Longrightarrow> k = l"
   56.22 +  using int_eq_iff [of k l] by simp
   56.23 +
   56.24 +lemma int_of_int [simp]:
   56.25 +  "int_of (Target_Numeral.of_int k) = k"
   56.26 +  using of_int_inverse [of k] by simp
   56.27 +
   56.28 +lemma of_int_of [simp]:
   56.29 +  "Target_Numeral.of_int (int_of k) = k"
   56.30 +  using int_of_inverse [of k] by simp
   56.31 +
   56.32 +hide_fact (open) int_eq_iff int_eqI
   56.33 +
   56.34 +instantiation Target_Numeral.int :: ring_1
   56.35 +begin
   56.36 +
   56.37 +definition
   56.38 +  "0 = Target_Numeral.of_int 0"
   56.39 +
   56.40 +lemma int_of_zero [simp]:
   56.41 +  "int_of 0 = 0"
   56.42 +  by (simp add: zero_int_def)
   56.43 +
   56.44 +definition
   56.45 +  "1 = Target_Numeral.of_int 1"
   56.46 +
   56.47 +lemma int_of_one [simp]:
   56.48 +  "int_of 1 = 1"
   56.49 +  by (simp add: one_int_def)
   56.50 +
   56.51 +definition
   56.52 +  "k + l = Target_Numeral.of_int (int_of k + int_of l)"
   56.53 +
   56.54 +lemma int_of_plus [simp]:
   56.55 +  "int_of (k + l) = int_of k + int_of l"
   56.56 +  by (simp add: plus_int_def)
   56.57 +
   56.58 +definition
   56.59 +  "- k = Target_Numeral.of_int (- int_of k)"
   56.60 +
   56.61 +lemma int_of_uminus [simp]:
   56.62 +  "int_of (- k) = - int_of k"
   56.63 +  by (simp add: uminus_int_def)
   56.64 +
   56.65 +definition
   56.66 +  "k - l = Target_Numeral.of_int (int_of k - int_of l)"
   56.67 +
   56.68 +lemma int_of_minus [simp]:
   56.69 +  "int_of (k - l) = int_of k - int_of l"
   56.70 +  by (simp add: minus_int_def)
   56.71 +
   56.72 +definition
   56.73 +  "k * l = Target_Numeral.of_int (int_of k * int_of l)"
   56.74 +
   56.75 +lemma int_of_times [simp]:
   56.76 +  "int_of (k * l) = int_of k * int_of l"
   56.77 +  by (simp add: times_int_def)
   56.78 +
   56.79 +instance proof
   56.80 +qed (auto simp add: Target_Numeral.int_eq_iff algebra_simps)
   56.81 +
   56.82 +end
   56.83 +
   56.84 +lemma int_of_of_nat [simp]:
   56.85 +  "int_of (of_nat n) = of_nat n"
   56.86 +  by (induct n) simp_all
   56.87 +
   56.88 +definition nat_of :: "Target_Numeral.int \<Rightarrow> nat" where
   56.89 +  "nat_of k = Int.nat (int_of k)"
   56.90 +
   56.91 +lemma nat_of_of_nat [simp]:
   56.92 +  "nat_of (of_nat n) = n"
   56.93 +  by (simp add: nat_of_def)
   56.94 +
   56.95 +lemma int_of_of_int [simp]:
   56.96 +  "int_of (of_int k) = k"
   56.97 +  by (induct k) (simp_all, simp only: neg_numeral_def numeral_One int_of_uminus int_of_one)
   56.98 +
   56.99 +lemma of_int_of_int [simp, code_abbrev]:
  56.100 +  "Target_Numeral.of_int = of_int"
  56.101 +  by rule (simp add: Target_Numeral.int_eq_iff)
  56.102 +
  56.103 +lemma int_of_numeral [simp]:
  56.104 +  "int_of (numeral k) = numeral k"
  56.105 +  using int_of_of_int [of "numeral k"] by simp
  56.106 +
  56.107 +lemma int_of_neg_numeral [simp]:
  56.108 +  "int_of (neg_numeral k) = neg_numeral k"
  56.109 +  by (simp only: neg_numeral_def int_of_uminus) simp
  56.110 +
  56.111 +lemma int_of_sub [simp]:
  56.112 +  "int_of (Num.sub k l) = Num.sub k l"
  56.113 +  by (simp only: Num.sub_def int_of_minus int_of_numeral)
  56.114 +
  56.115 +instantiation Target_Numeral.int :: "{ring_div, equal, linordered_idom}"
  56.116 +begin
  56.117 +
  56.118 +definition
  56.119 +  "k div l = of_int (int_of k div int_of l)"
  56.120 +
  56.121 +lemma int_of_div [simp]:
  56.122 +  "int_of (k div l) = int_of k div int_of l"
  56.123 +  by (simp add: div_int_def)
  56.124 +
  56.125 +definition
  56.126 +  "k mod l = of_int (int_of k mod int_of l)"
  56.127 +
  56.128 +lemma int_of_mod [simp]:
  56.129 +  "int_of (k mod l) = int_of k mod int_of l"
  56.130 +  by (simp add: mod_int_def)
  56.131 +
  56.132 +definition
  56.133 +  "\<bar>k\<bar> = of_int \<bar>int_of k\<bar>"
  56.134 +
  56.135 +lemma int_of_abs [simp]:
  56.136 +  "int_of \<bar>k\<bar> = \<bar>int_of k\<bar>"
  56.137 +  by (simp add: abs_int_def)
  56.138 +
  56.139 +definition
  56.140 +  "sgn k = of_int (sgn (int_of k))"
  56.141 +
  56.142 +lemma int_of_sgn [simp]:
  56.143 +  "int_of (sgn k) = sgn (int_of k)"
  56.144 +  by (simp add: sgn_int_def)
  56.145 +
  56.146 +definition
  56.147 +  "k \<le> l \<longleftrightarrow> int_of k \<le> int_of l"
  56.148 +
  56.149 +definition
  56.150 +  "k < l \<longleftrightarrow> int_of k < int_of l"
  56.151 +
  56.152 +definition
  56.153 +  "HOL.equal k l \<longleftrightarrow> HOL.equal (int_of k) (int_of l)"
  56.154 +
  56.155 +instance proof
  56.156 +qed (auto simp add: Target_Numeral.int_eq_iff algebra_simps
  56.157 +  less_eq_int_def less_int_def equal_int_def equal)
  56.158 +
  56.159 +end
  56.160 +
  56.161 +lemma int_of_min [simp]:
  56.162 +  "int_of (min k l) = min (int_of k) (int_of l)"
  56.163 +  by (simp add: min_def less_eq_int_def)
  56.164 +
  56.165 +lemma int_of_max [simp]:
  56.166 +  "int_of (max k l) = max (int_of k) (int_of l)"
  56.167 +  by (simp add: max_def less_eq_int_def)
  56.168 +
  56.169 +
  56.170 +subsection {* Code theorems for target language numerals *}
  56.171 +
  56.172 +text {* Constructors *}
  56.173 +
  56.174 +definition Pos :: "num \<Rightarrow> Target_Numeral.int" where
  56.175 +  [simp, code_abbrev]: "Pos = numeral"
  56.176 +
  56.177 +definition Neg :: "num \<Rightarrow> Target_Numeral.int" where
  56.178 +  [simp, code_abbrev]: "Neg = neg_numeral"
  56.179 +
  56.180 +code_datatype "0::Target_Numeral.int" Pos Neg
  56.181 +
  56.182 +
  56.183 +text {* Auxiliary operations *}
  56.184 +
  56.185 +definition dup :: "Target_Numeral.int \<Rightarrow> Target_Numeral.int" where
  56.186 +  [simp]: "dup k = k + k"
  56.187 +
  56.188 +lemma dup_code [code]:
  56.189 +  "dup 0 = 0"
  56.190 +  "dup (Pos n) = Pos (Num.Bit0 n)"
  56.191 +  "dup (Neg n) = Neg (Num.Bit0 n)"
  56.192 +  unfolding Pos_def Neg_def neg_numeral_def
  56.193 +  by (simp_all add: numeral_Bit0)
  56.194 +
  56.195 +definition sub :: "num \<Rightarrow> num \<Rightarrow> Target_Numeral.int" where
  56.196 +  [simp]: "sub m n = numeral m - numeral n"
  56.197 +
  56.198 +lemma sub_code [code]:
  56.199 +  "sub Num.One Num.One = 0"
  56.200 +  "sub (Num.Bit0 m) Num.One = Pos (Num.BitM m)"
  56.201 +  "sub (Num.Bit1 m) Num.One = Pos (Num.Bit0 m)"
  56.202 +  "sub Num.One (Num.Bit0 n) = Neg (Num.BitM n)"
  56.203 +  "sub Num.One (Num.Bit1 n) = Neg (Num.Bit0 n)"
  56.204 +  "sub (Num.Bit0 m) (Num.Bit0 n) = dup (sub m n)"
  56.205 +  "sub (Num.Bit1 m) (Num.Bit1 n) = dup (sub m n)"
  56.206 +  "sub (Num.Bit1 m) (Num.Bit0 n) = dup (sub m n) + 1"
  56.207 +  "sub (Num.Bit0 m) (Num.Bit1 n) = dup (sub m n) - 1"
  56.208 +  unfolding sub_def dup_def numeral.simps Pos_def Neg_def
  56.209 +    neg_numeral_def numeral_BitM
  56.210 +  by (simp_all only: algebra_simps add.comm_neutral)
  56.211 +
  56.212 +
  56.213 +text {* Implementations *}
  56.214 +
  56.215 +lemma one_int_code [code, code_unfold]:
  56.216 +  "1 = Pos Num.One"
  56.217 +  by simp
  56.218 +
  56.219 +lemma plus_int_code [code]:
  56.220 +  "k + 0 = (k::Target_Numeral.int)"
  56.221 +  "0 + l = (l::Target_Numeral.int)"
  56.222 +  "Pos m + Pos n = Pos (m + n)"
  56.223 +  "Pos m + Neg n = sub m n"
  56.224 +  "Neg m + Pos n = sub n m"
  56.225 +  "Neg m + Neg n = Neg (m + n)"
  56.226 +  by simp_all
  56.227 +
  56.228 +lemma uminus_int_code [code]:
  56.229 +  "uminus 0 = (0::Target_Numeral.int)"
  56.230 +  "uminus (Pos m) = Neg m"
  56.231 +  "uminus (Neg m) = Pos m"
  56.232 +  by simp_all
  56.233 +
  56.234 +lemma minus_int_code [code]:
  56.235 +  "k - 0 = (k::Target_Numeral.int)"
  56.236 +  "0 - l = uminus (l::Target_Numeral.int)"
  56.237 +  "Pos m - Pos n = sub m n"
  56.238 +  "Pos m - Neg n = Pos (m + n)"
  56.239 +  "Neg m - Pos n = Neg (m + n)"
  56.240 +  "Neg m - Neg n = sub n m"
  56.241 +  by simp_all
  56.242 +
  56.243 +lemma times_int_code [code]:
  56.244 +  "k * 0 = (0::Target_Numeral.int)"
  56.245 +  "0 * l = (0::Target_Numeral.int)"
  56.246 +  "Pos m * Pos n = Pos (m * n)"
  56.247 +  "Pos m * Neg n = Neg (m * n)"
  56.248 +  "Neg m * Pos n = Neg (m * n)"
  56.249 +  "Neg m * Neg n = Pos (m * n)"
  56.250 +  by simp_all
  56.251 +
  56.252 +definition divmod :: "Target_Numeral.int \<Rightarrow> Target_Numeral.int \<Rightarrow> Target_Numeral.int \<times> Target_Numeral.int" where
  56.253 +  "divmod k l = (k div l, k mod l)"
  56.254 +
  56.255 +lemma fst_divmod [simp]:
  56.256 +  "fst (divmod k l) = k div l"
  56.257 +  by (simp add: divmod_def)
  56.258 +
  56.259 +lemma snd_divmod [simp]:
  56.260 +  "snd (divmod k l) = k mod l"
  56.261 +  by (simp add: divmod_def)
  56.262 +
  56.263 +definition divmod_abs :: "Target_Numeral.int \<Rightarrow> Target_Numeral.int \<Rightarrow> Target_Numeral.int \<times> Target_Numeral.int" where
  56.264 +  "divmod_abs k l = (\<bar>k\<bar> div \<bar>l\<bar>, \<bar>k\<bar> mod \<bar>l\<bar>)"
  56.265 +
  56.266 +lemma fst_divmod_abs [simp]:
  56.267 +  "fst (divmod_abs k l) = \<bar>k\<bar> div \<bar>l\<bar>"
  56.268 +  by (simp add: divmod_abs_def)
  56.269 +
  56.270 +lemma snd_divmod_abs [simp]:
  56.271 +  "snd (divmod_abs k l) = \<bar>k\<bar> mod \<bar>l\<bar>"
  56.272 +  by (simp add: divmod_abs_def)
  56.273 +
  56.274 +lemma divmod_abs_terminate_code [code]:
  56.275 +  "divmod_abs (Neg k) (Neg l) = divmod_abs (Pos k) (Pos l)"
  56.276 +  "divmod_abs (Neg k) (Pos l) = divmod_abs (Pos k) (Pos l)"
  56.277 +  "divmod_abs (Pos k) (Neg l) = divmod_abs (Pos k) (Pos l)"
  56.278 +  "divmod_abs j 0 = (0, \<bar>j\<bar>)"
  56.279 +  "divmod_abs 0 j = (0, 0)"
  56.280 +  by (simp_all add: prod_eq_iff)
  56.281 +
  56.282 +lemma divmod_abs_rec_code [code]:
  56.283 +  "divmod_abs (Pos k) (Pos l) =
  56.284 +    (let j = sub k l in
  56.285 +       if j < 0 then (0, Pos k)
  56.286 +       else let (q, r) = divmod_abs j (Pos l) in (q + 1, r))"
  56.287 +  by (auto simp add: prod_eq_iff Target_Numeral.int_eq_iff Let_def prod_case_beta
  56.288 +    sub_non_negative sub_negative div_pos_pos_trivial mod_pos_pos_trivial div_pos_geq mod_pos_geq)
  56.289 +
  56.290 +lemma divmod_code [code]: "divmod k l =
  56.291 +  (if k = 0 then (0, 0) else if l = 0 then (0, k) else
  56.292 +  (apsnd \<circ> times \<circ> sgn) l (if sgn k = sgn l
  56.293 +    then divmod_abs k l
  56.294 +    else (let (r, s) = divmod_abs k l in
  56.295 +      if s = 0 then (- r, 0) else (- r - 1, \<bar>l\<bar> - s))))"
  56.296 +proof -
  56.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"
  56.298 +    by (auto simp add: sgn_if)
  56.299 +  have aux2: "\<And>q::int. - int_of k = int_of l * q \<longleftrightarrow> int_of k = int_of l * - q" by auto
  56.300 +  show ?thesis
  56.301 +    by (simp add: prod_eq_iff Target_Numeral.int_eq_iff prod_case_beta aux1)
  56.302 +      (auto simp add: zdiv_zminus1_eq_if zmod_zminus1_eq_if zdiv_zminus2 zmod_zminus2 aux2)
  56.303 +qed
  56.304 +
  56.305 +lemma div_int_code [code]:
  56.306 +  "k div l = fst (divmod k l)"
  56.307 +  by simp
  56.308 +
  56.309 +lemma div_mod_code [code]:
  56.310 +  "k mod l = snd (divmod k l)"
  56.311 +  by simp
  56.312 +
  56.313 +lemma equal_int_code [code]:
  56.314 +  "HOL.equal 0 (0::Target_Numeral.int) \<longleftrightarrow> True"
  56.315 +  "HOL.equal 0 (Pos l) \<longleftrightarrow> False"
  56.316 +  "HOL.equal 0 (Neg l) \<longleftrightarrow> False"
  56.317 +  "HOL.equal (Pos k) 0 \<longleftrightarrow> False"
  56.318 +  "HOL.equal (Pos k) (Pos l) \<longleftrightarrow> HOL.equal k l"
  56.319 +  "HOL.equal (Pos k) (Neg l) \<longleftrightarrow> False"
  56.320 +  "HOL.equal (Neg k) 0 \<longleftrightarrow> False"
  56.321 +  "HOL.equal (Neg k) (Pos l) \<longleftrightarrow> False"
  56.322 +  "HOL.equal (Neg k) (Neg l) \<longleftrightarrow> HOL.equal k l"
  56.323 +  by (simp_all add: equal Target_Numeral.int_eq_iff)
  56.324 +
  56.325 +lemma equal_int_refl [code nbe]:
  56.326 +  "HOL.equal (k::Target_Numeral.int) k \<longleftrightarrow> True"
  56.327 +  by (fact equal_refl)
  56.328 +
  56.329 +lemma less_eq_int_code [code]:
  56.330 +  "0 \<le> (0::Target_Numeral.int) \<longleftrightarrow> True"
  56.331 +  "0 \<le> Pos l \<longleftrightarrow> True"
  56.332 +  "0 \<le> Neg l \<longleftrightarrow> False"
  56.333 +  "Pos k \<le> 0 \<longleftrightarrow> False"
  56.334 +  "Pos k \<le> Pos l \<longleftrightarrow> k \<le> l"
  56.335 +  "Pos k \<le> Neg l \<longleftrightarrow> False"
  56.336 +  "Neg k \<le> 0 \<longleftrightarrow> True"
  56.337 +  "Neg k \<le> Pos l \<longleftrightarrow> True"
  56.338 +  "Neg k \<le> Neg l \<longleftrightarrow> l \<le> k"
  56.339 +  by (simp_all add: less_eq_int_def)
  56.340 +
  56.341 +lemma less_int_code [code]:
  56.342 +  "0 < (0::Target_Numeral.int) \<longleftrightarrow> False"
  56.343 +  "0 < Pos l \<longleftrightarrow> True"
  56.344 +  "0 < Neg l \<longleftrightarrow> False"
  56.345 +  "Pos k < 0 \<longleftrightarrow> False"
  56.346 +  "Pos k < Pos l \<longleftrightarrow> k < l"
  56.347 +  "Pos k < Neg l \<longleftrightarrow> False"
  56.348 +  "Neg k < 0 \<longleftrightarrow> True"
  56.349 +  "Neg k < Pos l \<longleftrightarrow> True"
  56.350 +  "Neg k < Neg l \<longleftrightarrow> l < k"
  56.351 +  by (simp_all add: less_int_def)
  56.352 +
  56.353 +lemma nat_of_code [code]:
  56.354 +  "nat_of (Neg k) = 0"
  56.355 +  "nat_of 0 = 0"
  56.356 +  "nat_of (Pos k) = nat_of_num k"
  56.357 +  by (simp_all add: nat_of_def nat_of_num_numeral)
  56.358 +
  56.359 +lemma int_of_code [code]:
  56.360 +  "int_of (Neg k) = neg_numeral k"
  56.361 +  "int_of 0 = 0"
  56.362 +  "int_of (Pos k) = numeral k"
  56.363 +  by simp_all
  56.364 +
  56.365 +lemma of_int_code [code]:
  56.366 +  "Target_Numeral.of_int (Int.Neg k) = neg_numeral k"
  56.367 +  "Target_Numeral.of_int 0 = 0"
  56.368 +  "Target_Numeral.of_int (Int.Pos k) = numeral k"
  56.369 +  by simp_all
  56.370 +
  56.371 +definition num_of_int :: "Target_Numeral.int \<Rightarrow> num" where
  56.372 +  "num_of_int = num_of_nat \<circ> nat_of"
  56.373 +
  56.374 +lemma num_of_int_code [code]:
  56.375 +  "num_of_int k = (if k \<le> 1 then Num.One
  56.376 +     else let
  56.377 +       (l, j) = divmod k 2;
  56.378 +       l' = num_of_int l + num_of_int l
  56.379 +     in if j = 0 then l' else l' + Num.One)"
  56.380 +proof -
  56.381 +  {
  56.382 +    assume "int_of k mod 2 = 1"
  56.383 +    then have "nat (int_of k mod 2) = nat 1" by simp
  56.384 +    moreover assume *: "1 < int_of k"
  56.385 +    ultimately have **: "nat (int_of k) mod 2 = 1" by (simp add: nat_mod_distrib)
  56.386 +    have "num_of_nat (nat (int_of k)) =
  56.387 +      num_of_nat (2 * (nat (int_of k) div 2) + nat (int_of k) mod 2)"
  56.388 +      by simp
  56.389 +    then have "num_of_nat (nat (int_of k)) =
  56.390 +      num_of_nat (nat (int_of k) div 2 + nat (int_of k) div 2 + nat (int_of k) mod 2)"
  56.391 +      by (simp add: nat_mult_2)
  56.392 +    with ** have "num_of_nat (nat (int_of k)) =
  56.393 +      num_of_nat (nat (int_of k) div 2 + nat (int_of k) div 2 + 1)"
  56.394 +      by simp
  56.395 +  }
  56.396 +  note aux = this
  56.397 +  show ?thesis
  56.398 +    by (auto simp add: num_of_int_def nat_of_def Let_def prod_case_beta
  56.399 +      not_le Target_Numeral.int_eq_iff less_eq_int_def
  56.400 +      nat_mult_distrib nat_div_distrib num_of_nat_One num_of_nat_plus_distrib
  56.401 +       nat_mult_2 aux add_One)
  56.402 +qed
  56.403 +
  56.404 +hide_const (open) int_of nat_of Pos Neg sub dup divmod_abs num_of_int
  56.405 +
  56.406 +
  56.407 +subsection {* Serializer setup for target language numerals *}
  56.408 +
  56.409 +code_type Target_Numeral.int
  56.410 +  (SML "IntInf.int")
  56.411 +  (OCaml "Big'_int.big'_int")
  56.412 +  (Haskell "Integer")
  56.413 +  (Scala "BigInt")
  56.414 +  (Eval "int")
  56.415 +
  56.416 +code_instance Target_Numeral.int :: equal
  56.417 +  (Haskell -)
  56.418 +
  56.419 +code_const "0::Target_Numeral.int"
  56.420 +  (SML "0")
  56.421 +  (OCaml "Big'_int.zero'_big'_int")
  56.422 +  (Haskell "0")
  56.423 +  (Scala "BigInt(0)")
  56.424 +
  56.425 +setup {*
  56.426 +  fold (Numeral.add_code @{const_name Target_Numeral.Pos}
  56.427 +    false Code_Printer.literal_numeral) ["SML", "OCaml", "Haskell", "Scala"]
  56.428 +*}
  56.429 +
  56.430 +setup {*
  56.431 +  fold (Numeral.add_code @{const_name Target_Numeral.Neg}
  56.432 +    true Code_Printer.literal_numeral) ["SML", "OCaml", "Haskell", "Scala"]
  56.433 +*}
  56.434 +
  56.435 +code_const "plus :: Target_Numeral.int \<Rightarrow> _ \<Rightarrow> _"
  56.436 +  (SML "IntInf.+ ((_), (_))")
  56.437 +  (OCaml "Big'_int.add'_big'_int")
  56.438 +  (Haskell infixl 6 "+")
  56.439 +  (Scala infixl 7 "+")
  56.440 +  (Eval infixl 8 "+")
  56.441 +
  56.442 +code_const "uminus :: Target_Numeral.int \<Rightarrow> _"
  56.443 +  (SML "IntInf.~")
  56.444 +  (OCaml "Big'_int.minus'_big'_int")
  56.445 +  (Haskell "negate")
  56.446 +  (Scala "!(- _)")
  56.447 +  (Eval "~/ _")
  56.448 +
  56.449 +code_const "minus :: Target_Numeral.int \<Rightarrow> _"
  56.450 +  (SML "IntInf.- ((_), (_))")
  56.451 +  (OCaml "Big'_int.sub'_big'_int")
  56.452 +  (Haskell infixl 6 "-")
  56.453 +  (Scala infixl 7 "-")
  56.454 +  (Eval infixl 8 "-")
  56.455 +
  56.456 +code_const Target_Numeral.dup
  56.457 +  (SML "IntInf.*/ (2,/ (_))")
  56.458 +  (OCaml "Big'_int.mult'_big'_int/ 2")
  56.459 +  (Haskell "!(2 * _)")
  56.460 +  (Scala "!(2 * _)")
  56.461 +  (Eval "!(2 * _)")
  56.462 +
  56.463 +code_const Target_Numeral.sub
  56.464 +  (SML "!(raise/ Fail/ \"sub\")")
  56.465 +  (OCaml "failwith/ \"sub\"")
  56.466 +  (Haskell "error/ \"sub\"")
  56.467 +  (Scala "!error(\"sub\")")
  56.468 +
  56.469 +code_const "times :: Target_Numeral.int \<Rightarrow> _ \<Rightarrow> _"
  56.470 +  (SML "IntInf.* ((_), (_))")
  56.471 +  (OCaml "Big'_int.mult'_big'_int")
  56.472 +  (Haskell infixl 7 "*")
  56.473 +  (Scala infixl 8 "*")
  56.474 +  (Eval infixl 9 "*")
  56.475 +
  56.476 +code_const Target_Numeral.divmod_abs
  56.477 +  (SML "IntInf.divMod/ (IntInf.abs _,/ IntInf.abs _)")
  56.478 +  (OCaml "Big'_int.quomod'_big'_int/ (Big'_int.abs'_big'_int _)/ (Big'_int.abs'_big'_int _)")
  56.479 +  (Haskell "divMod/ (abs _)/ (abs _)")
  56.480 +  (Scala "!((k: BigInt) => (l: BigInt) =>/ if (l == 0)/ (BigInt(0), k) else/ (k.abs '/% l.abs))")
  56.481 +  (Eval "Integer.div'_mod/ (abs _)/ (abs _)")
  56.482 +
  56.483 +code_const "HOL.equal :: Target_Numeral.int \<Rightarrow> _ \<Rightarrow> bool"
  56.484 +  (SML "!((_ : IntInf.int) = _)")
  56.485 +  (OCaml "Big'_int.eq'_big'_int")
  56.486 +  (Haskell infix 4 "==")
  56.487 +  (Scala infixl 5 "==")
  56.488 +  (Eval infixl 6 "=")
  56.489 +
  56.490 +code_const "less_eq :: Target_Numeral.int \<Rightarrow> _ \<Rightarrow> bool"
  56.491 +  (SML "IntInf.<= ((_), (_))")
  56.492 +  (OCaml "Big'_int.le'_big'_int")
  56.493 +  (Haskell infix 4 "<=")
  56.494 +  (Scala infixl 4 "<=")
  56.495 +  (Eval infixl 6 "<=")
  56.496 +
  56.497 +code_const "less :: Target_Numeral.int \<Rightarrow> _ \<Rightarrow> bool"
  56.498 +  (SML "IntInf.< ((_), (_))")
  56.499 +  (OCaml "Big'_int.lt'_big'_int")
  56.500 +  (Haskell infix 4 "<")
  56.501 +  (Scala infixl 4 "<")
  56.502 +  (Eval infixl 6 "<")
  56.503 +
  56.504 +ML {*
  56.505 +structure Target_Numeral =
  56.506 +struct
  56.507 +
  56.508 +val T = @{typ "Target_Numeral.int"};
  56.509 +
  56.510 +end;
  56.511 +*}
  56.512 +
  56.513 +code_reserved Eval Target_Numeral
  56.514 +
  56.515 +code_const "Code_Evaluation.term_of \<Colon> Target_Numeral.int \<Rightarrow> term"
  56.516 +  (Eval "HOLogic.mk'_number/ Target'_Numeral.T")
  56.517 +
  56.518 +code_modulename SML
  56.519 +  Target_Numeral Arith
  56.520 +
  56.521 +code_modulename OCaml
  56.522 +  Target_Numeral Arith
  56.523 +
  56.524 +code_modulename Haskell
  56.525 +  Target_Numeral Arith
  56.526 +
  56.527 +
  56.528 +subsection {* Implementation for @{typ int} *}
  56.529 +
  56.530 +code_datatype Target_Numeral.int_of
  56.531 +
  56.532 +lemma [code, code del]:
  56.533 +  "Target_Numeral.of_int = Target_Numeral.of_int" ..
  56.534 +
  56.535 +lemma [code]:
  56.536 +  "Target_Numeral.of_int (Target_Numeral.int_of k) = k"
  56.537 +  by (simp add: Target_Numeral.int_eq_iff)
  56.538 +
  56.539 +declare Int.Pos_def [code]
  56.540 +
  56.541 +lemma [code_abbrev]:
  56.542 +  "Target_Numeral.int_of (Target_Numeral.Pos k) = Int.Pos k"
  56.543 +  by simp
  56.544 +
  56.545 +declare Int.Neg_def [code]
  56.546 +
  56.547 +lemma [code_abbrev]:
  56.548 +  "Target_Numeral.int_of (Target_Numeral.Neg k) = Int.Neg k"
  56.549 +  by simp
  56.550 +
  56.551 +lemma [code]:
  56.552 +  "0 = Target_Numeral.int_of 0"
  56.553 +  by simp
  56.554 +
  56.555 +lemma [code]:
  56.556 +  "1 = Target_Numeral.int_of 1"
  56.557 +  by simp
  56.558 +
  56.559 +lemma [code]:
  56.560 +  "k + l = Target_Numeral.int_of (of_int k + of_int l)"
  56.561 +  by simp
  56.562 +
  56.563 +lemma [code]:
  56.564 +  "- k = Target_Numeral.int_of (- of_int k)"
  56.565 +  by simp
  56.566 +
  56.567 +lemma [code]:
  56.568 +  "k - l = Target_Numeral.int_of (of_int k - of_int l)"
  56.569 +  by simp
  56.570 +
  56.571 +lemma [code]:
  56.572 +  "Int.dup k = Target_Numeral.int_of (Target_Numeral.dup (of_int k))"
  56.573 +  by simp
  56.574 +
  56.575 +lemma [code, code del]:
  56.576 +  "Int.sub = Int.sub" ..
  56.577 +
  56.578 +lemma [code]:
  56.579 +  "k * l = Target_Numeral.int_of (of_int k * of_int l)"
  56.580 +  by simp
  56.581 +
  56.582 +lemma [code]:
  56.583 +  "pdivmod k l = map_pair Target_Numeral.int_of Target_Numeral.int_of
  56.584 +    (Target_Numeral.divmod_abs (of_int k) (of_int l))"
  56.585 +  by (simp add: prod_eq_iff pdivmod_def)
  56.586 +
  56.587 +lemma [code]:
  56.588 +  "k div l = Target_Numeral.int_of (of_int k div of_int l)"
  56.589 +  by simp
  56.590 +
  56.591 +lemma [code]:
  56.592 +  "k mod l = Target_Numeral.int_of (of_int k mod of_int l)"
  56.593 +  by simp
  56.594 +
  56.595 +lemma [code]:
  56.596 +  "HOL.equal k l = HOL.equal (of_int k :: Target_Numeral.int) (of_int l)"
  56.597 +  by (simp add: equal Target_Numeral.int_eq_iff)
  56.598 +
  56.599 +lemma [code]:
  56.600 +  "k \<le> l \<longleftrightarrow> (of_int k :: Target_Numeral.int) \<le> of_int l"
  56.601 +  by (simp add: less_eq_int_def)
  56.602 +
  56.603 +lemma [code]:
  56.604 +  "k < l \<longleftrightarrow> (of_int k :: Target_Numeral.int) < of_int l"
  56.605 +  by (simp add: less_int_def)
  56.606 +
  56.607 +lemma (in ring_1) of_int_code:
  56.608 +  "of_int k = (if k = 0 then 0
  56.609 +     else if k < 0 then - of_int (- k)
  56.610 +     else let
  56.611 +       (l, j) = divmod_int k 2;
  56.612 +       l' = 2 * of_int l
  56.613 +     in if j = 0 then l' else l' + 1)"
  56.614 +proof -
  56.615 +  from mod_div_equality have *: "of_int k = of_int (k div 2 * 2 + k mod 2)" by simp
  56.616 +  show ?thesis
  56.617 +    by (simp add: Let_def divmod_int_mod_div mod_2_not_eq_zero_eq_one_int
  56.618 +      of_int_add [symmetric]) (simp add: * mult_commute)
  56.619 +qed
  56.620 +
  56.621 +declare of_int_code [code]
  56.622 +
  56.623 +
  56.624 +subsection {* Implementation for @{typ nat} *}
  56.625 +
  56.626 +definition of_nat :: "nat \<Rightarrow> Target_Numeral.int" where
  56.627 +  [code_abbrev]: "of_nat = Nat.of_nat"
  56.628 +
  56.629 +hide_const (open) of_nat
  56.630 +
  56.631 +lemma int_of_nat [simp]:
  56.632 +  "Target_Numeral.int_of (Target_Numeral.of_nat n) = of_nat n"
  56.633 +  by (simp add: of_nat_def)
  56.634 +
  56.635 +lemma [code abstype]:
  56.636 +  "Target_Numeral.nat_of (Target_Numeral.of_nat n) = n"
  56.637 +  by (simp add: nat_of_def)
  56.638 +
  56.639 +lemma [code_abbrev]:
  56.640 +  "nat (Int.Pos k) = nat_of_num k"
  56.641 +  by (simp add: nat_of_num_numeral)
  56.642 +
  56.643 +lemma [code abstract]:
  56.644 +  "Target_Numeral.of_nat 0 = 0"
  56.645 +  by (simp add: Target_Numeral.int_eq_iff)
  56.646 +
  56.647 +lemma [code abstract]:
  56.648 +  "Target_Numeral.of_nat 1 = 1"
  56.649 +  by (simp add: Target_Numeral.int_eq_iff)
  56.650 +
  56.651 +lemma [code abstract]:
  56.652 +  "Target_Numeral.of_nat (m + n) = of_nat m + of_nat n"
  56.653 +  by (simp add: Target_Numeral.int_eq_iff)
  56.654 +
  56.655 +lemma [code abstract]:
  56.656 +  "Target_Numeral.of_nat (Code_Nat.dup n) = Target_Numeral.dup (of_nat n)"
  56.657 +  by (simp add: Target_Numeral.int_eq_iff Code_Nat.dup_def)
  56.658 +
  56.659 +lemma [code, code del]:
  56.660 +  "Code_Nat.sub = Code_Nat.sub" ..
  56.661 +
  56.662 +lemma [code abstract]:
  56.663 +  "Target_Numeral.of_nat (m - n) = max 0 (of_nat m - of_nat n)"
  56.664 +  by (simp add: Target_Numeral.int_eq_iff)
  56.665 +
  56.666 +lemma [code abstract]:
  56.667 +  "Target_Numeral.of_nat (m * n) = of_nat m * of_nat n"
  56.668 +  by (simp add: Target_Numeral.int_eq_iff of_nat_mult)
  56.669 +
  56.670 +lemma [code abstract]:
  56.671 +  "Target_Numeral.of_nat (m div n) = of_nat m div of_nat n"
  56.672 +  by (simp add: Target_Numeral.int_eq_iff zdiv_int)
  56.673 +
  56.674 +lemma [code abstract]:
  56.675 +  "Target_Numeral.of_nat (m mod n) = of_nat m mod of_nat n"
  56.676 +  by (simp add: Target_Numeral.int_eq_iff zmod_int)
  56.677 +
  56.678 +lemma [code]:
  56.679 +  "Divides.divmod_nat m n = (m div n, m mod n)"
  56.680 +  by (simp add: prod_eq_iff)
  56.681 +
  56.682 +lemma [code]:
  56.683 +  "HOL.equal m n = HOL.equal (of_nat m :: Target_Numeral.int) (of_nat n)"
  56.684 +  by (simp add: equal Target_Numeral.int_eq_iff)
  56.685 +
  56.686 +lemma [code]:
  56.687 +  "m \<le> n \<longleftrightarrow> (of_nat m :: Target_Numeral.int) \<le> of_nat n"
  56.688 +  by (simp add: less_eq_int_def)
  56.689 +
  56.690 +lemma [code]:
  56.691 +  "m < n \<longleftrightarrow> (of_nat m :: Target_Numeral.int) < of_nat n"
  56.692 +  by (simp add: less_int_def)
  56.693 +
  56.694 +lemma num_of_nat_code [code]:
  56.695 +  "num_of_nat = Target_Numeral.num_of_int \<circ> Target_Numeral.of_nat"
  56.696 +  by (simp add: fun_eq_iff num_of_int_def of_nat_def)
  56.697 +
  56.698 +lemma (in semiring_1) of_nat_code:
  56.699 +  "of_nat n = (if n = 0 then 0
  56.700 +     else let
  56.701 +       (m, q) = divmod_nat n 2;
  56.702 +       m' = 2 * of_nat m
  56.703 +     in if q = 0 then m' else m' + 1)"
  56.704 +proof -
  56.705 +  from mod_div_equality have *: "of_nat n = of_nat (n div 2 * 2 + n mod 2)" by simp
  56.706 +  show ?thesis
  56.707 +    by (simp add: Let_def divmod_nat_div_mod mod_2_not_eq_zero_eq_one_nat
  56.708 +      of_nat_add [symmetric])
  56.709 +      (simp add: * mult_commute of_nat_mult add_commute)
  56.710 +qed
  56.711 +
  56.712 +declare of_nat_code [code]
  56.713 +
  56.714 +text {* Conversions between @{typ nat} and @{typ int} *}
  56.715 +
  56.716 +definition int :: "nat \<Rightarrow> int" where
  56.717 +  [code_abbrev]: "int = of_nat"
  56.718 +
  56.719 +hide_const (open) int
  56.720 +
  56.721 +lemma [code]:
  56.722 +  "Target_Numeral.int n = Target_Numeral.int_of (of_nat n)"
  56.723 +  by (simp add: int_def)
  56.724 +
  56.725 +lemma [code abstract]:
  56.726 +  "Target_Numeral.of_nat (nat k) = max 0 (Target_Numeral.of_int k)"
  56.727 +  by (simp add: of_nat_def of_int_of_nat max_def)
  56.728 +
  56.729 +end
    57.1 --- a/src/HOL/List.thy	Fri Mar 23 20:32:43 2012 +0100
    57.2 +++ b/src/HOL/List.thy	Mon Mar 26 10:56:56 2012 +0200
    57.3 @@ -2676,7 +2676,7 @@
    57.4  -- {* simp does not terminate! *}
    57.5  by (induct j) auto
    57.6  
    57.7 -lemmas upt_rec_number_of[simp] = upt_rec[of "number_of m" "number_of n"] for m n
    57.8 +lemmas upt_rec_numeral[simp] = upt_rec[of "numeral m" "numeral n"] for m n
    57.9  
   57.10  lemma upt_conv_Nil [simp]: "j <= i ==> [i..<j] = []"
   57.11  by (subst upt_rec) simp
   57.12 @@ -2791,13 +2791,17 @@
   57.13  lemma nth_Cons': "(x # xs)!n = (if n = 0 then x else xs!(n - 1))"
   57.14  by (cases n) simp_all
   57.15  
   57.16 -lemmas take_Cons_number_of = take_Cons'[of "number_of v"] for v
   57.17 -lemmas drop_Cons_number_of = drop_Cons'[of "number_of v"] for v
   57.18 -lemmas nth_Cons_number_of = nth_Cons'[of _ _ "number_of v"] for v
   57.19 -
   57.20 -declare take_Cons_number_of [simp] 
   57.21 -        drop_Cons_number_of [simp] 
   57.22 -        nth_Cons_number_of [simp] 
   57.23 +lemma take_Cons_numeral [simp]:
   57.24 +  "take (numeral v) (x # xs) = x # take (numeral v - 1) xs"
   57.25 +by (simp add: take_Cons')
   57.26 +
   57.27 +lemma drop_Cons_numeral [simp]:
   57.28 +  "drop (numeral v) (x # xs) = drop (numeral v - 1) xs"
   57.29 +by (simp add: drop_Cons')
   57.30 +
   57.31 +lemma nth_Cons_numeral [simp]:
   57.32 +  "(x # xs) ! numeral v = xs ! (numeral v - 1)"
   57.33 +by (simp add: nth_Cons')
   57.34  
   57.35  
   57.36  subsubsection {* @{text upto}: interval-list on @{typ int} *}
   57.37 @@ -2812,7 +2816,11 @@
   57.38  
   57.39  declare upto.simps[code, simp del]
   57.40  
   57.41 -lemmas upto_rec_number_of[simp] = upto.simps[of "number_of m" "number_of n"] for m n
   57.42 +lemmas upto_rec_numeral [simp] =
   57.43 +  upto.simps[of "numeral m" "numeral n"]
   57.44 +  upto.simps[of "numeral m" "neg_numeral n"]
   57.45 +  upto.simps[of "neg_numeral m" "numeral n"]
   57.46 +  upto.simps[of "neg_numeral m" "neg_numeral n"] for m n
   57.47  
   57.48  lemma upto_empty[simp]: "j < i \<Longrightarrow> [i..j] = []"
   57.49  by(simp add: upto.simps)
    58.1 --- a/src/HOL/Matrix_LP/ComputeFloat.thy	Fri Mar 23 20:32:43 2012 +0100
    58.2 +++ b/src/HOL/Matrix_LP/ComputeFloat.thy	Mon Mar 26 10:56:56 2012 +0200
    58.3 @@ -75,8 +75,11 @@
    58.4    ultimately show ?thesis by auto
    58.5  qed
    58.6  
    58.7 -lemma real_is_int_number_of[simp]: "real_is_int ((number_of \<Colon> int \<Rightarrow> real) x)"
    58.8 -  by (auto simp: real_is_int_def intro!: exI[of _ "number_of x"])
    58.9 +lemma real_is_int_numeral[simp]: "real_is_int (numeral x)"
   58.10 +  by (auto simp: real_is_int_def intro!: exI[of _ "numeral x"])
   58.11 +
   58.12 +lemma real_is_int_neg_numeral[simp]: "real_is_int (neg_numeral x)"
   58.13 +  by (auto simp: real_is_int_def intro!: exI[of _ "neg_numeral x"])
   58.14  
   58.15  lemma int_of_real_0[simp]: "int_of_real (0::real) = (0::int)"
   58.16  by (simp add: int_of_real_def)
   58.17 @@ -87,7 +90,12 @@
   58.18    show ?thesis by (simp only: 1 int_of_real_real)
   58.19  qed
   58.20  
   58.21 -lemma int_of_real_number_of[simp]: "int_of_real (number_of b) = number_of b"
   58.22 +lemma int_of_real_numeral[simp]: "int_of_real (numeral b) = numeral b"
   58.23 +  unfolding int_of_real_def
   58.24 +  by (intro some_equality)
   58.25 +     (auto simp add: real_of_int_inject[symmetric] simp del: real_of_int_inject)
   58.26 +
   58.27 +lemma int_of_real_neg_numeral[simp]: "int_of_real (neg_numeral b) = neg_numeral b"
   58.28    unfolding int_of_real_def
   58.29    by (intro some_equality)
   58.30       (auto simp add: real_of_int_inject[symmetric] simp del: real_of_int_inject)
   58.31 @@ -101,7 +109,7 @@
   58.32  lemma abs_div_2_less: "a \<noteq> 0 \<Longrightarrow> a \<noteq> -1 \<Longrightarrow> abs((a::int) div 2) < abs a"
   58.33  by arith
   58.34  
   58.35 -lemma norm_0_1: "(0::_::number_ring) = Numeral0 & (1::_::number_ring) = Numeral1"
   58.36 +lemma norm_0_1: "(1::_::numeral) = Numeral1"
   58.37    by auto
   58.38  
   58.39  lemma add_left_zero: "0 + a = (a::'a::comm_monoid_add)"
   58.40 @@ -116,34 +124,21 @@
   58.41  lemma mult_right_one: "a * 1 = (a::'a::semiring_1)"
   58.42    by simp
   58.43  
   58.44 -lemma int_pow_0: "(a::int)^(Numeral0) = 1"
   58.45 +lemma int_pow_0: "(a::int)^0 = 1"
   58.46    by simp
   58.47  
   58.48  lemma int_pow_1: "(a::int)^(Numeral1) = a"
   58.49    by simp
   58.50  
   58.51 -lemma zero_eq_Numeral0_nring: "(0::'a::number_ring) = Numeral0"
   58.52 -  by simp
   58.53 -
   58.54 -lemma one_eq_Numeral1_nring: "(1::'a::number_ring) = Numeral1"
   58.55 -  by simp
   58.56 -
   58.57 -lemma zero_eq_Numeral0_nat: "(0::nat) = Numeral0"
   58.58 +lemma one_eq_Numeral1_nring: "(1::'a::numeral) = Numeral1"
   58.59    by simp
   58.60  
   58.61  lemma one_eq_Numeral1_nat: "(1::nat) = Numeral1"
   58.62    by simp
   58.63  
   58.64 -lemma zpower_Pls: "(z::int)^Numeral0 = Numeral1"
   58.65 +lemma zpower_Pls: "(z::int)^0 = Numeral1"
   58.66    by simp
   58.67  
   58.68 -lemma zpower_Min: "(z::int)^((-1)::nat) = Numeral1"
   58.69 -proof -
   58.70 -  have 1:"((-1)::nat) = 0"
   58.71 -    by simp
   58.72 -  show ?thesis by (simp add: 1)
   58.73 -qed
   58.74 -
   58.75  lemma fst_cong: "a=a' \<Longrightarrow> fst (a,b) = fst (a',b)"
   58.76    by simp
   58.77  
   58.78 @@ -160,70 +155,8 @@
   58.79  
   58.80  lemma not_true_eq_false: "(~ True) = False" by simp
   58.81  
   58.82 -lemmas binarith =
   58.83 -  normalize_bin_simps
   58.84 -  pred_bin_simps succ_bin_simps
   58.85 -  add_bin_simps minus_bin_simps mult_bin_simps
   58.86 -
   58.87 -lemma int_eq_number_of_eq:
   58.88 -  "(((number_of v)::int)=(number_of w)) = iszero ((number_of (v + uminus w))::int)"
   58.89 -  by (rule eq_number_of_eq)
   58.90 -
   58.91 -lemma int_iszero_number_of_Pls: "iszero (Numeral0::int)"
   58.92 -  by (simp only: iszero_number_of_Pls)
   58.93 -
   58.94 -lemma int_nonzero_number_of_Min: "~(iszero ((-1)::int))"
   58.95 -  by simp
   58.96 -
   58.97 -lemma int_iszero_number_of_Bit0: "iszero ((number_of (Int.Bit0 w))::int) = iszero ((number_of w)::int)"
   58.98 -  by simp
   58.99 -
  58.100 -lemma int_iszero_number_of_Bit1: "\<not> iszero ((number_of (Int.Bit1 w))::int)"
  58.101 -  by simp
  58.102 -
  58.103 -lemma int_less_number_of_eq_neg: "(((number_of x)::int) < number_of y) = neg ((number_of (x + (uminus y)))::int)"
  58.104 -  unfolding neg_def number_of_is_id by simp
  58.105 -
  58.106 -lemma int_not_neg_number_of_Pls: "\<not> (neg (Numeral0::int))"
  58.107 -  by simp
  58.108 -
  58.109 -lemma int_neg_number_of_Min: "neg (-1::int)"
  58.110 -  by simp
  58.111 -
  58.112 -lemma int_neg_number_of_Bit0: "neg ((number_of (Int.Bit0 w))::int) = neg ((number_of w)::int)"
  58.113 -  by simp
  58.114 -
  58.115 -lemma int_neg_number_of_Bit1: "neg ((number_of (Int.Bit1 w))::int) = neg ((number_of w)::int)"
  58.116 -  by simp
  58.117 -
  58.118 -lemma int_le_number_of_eq: "(((number_of x)::int) \<le> number_of y) = (\<not> neg ((number_of (y + (uminus x)))::int))"
  58.119 -  unfolding neg_def number_of_is_id by (simp add: not_less)
  58.120 -
  58.121 -lemmas intarithrel =
  58.122 -  int_eq_number_of_eq
  58.123 -  lift_bool[OF int_iszero_number_of_Pls] nlift_bool[OF int_nonzero_number_of_Min] int_iszero_number_of_Bit0
  58.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]
  58.125 -  int_neg_number_of_Bit0 int_neg_number_of_Bit1 int_le_number_of_eq
  58.126 -
  58.127 -lemma int_number_of_add_sym: "((number_of v)::int) + number_of w = number_of (v + w)"
  58.128 -  by simp
  58.129 -
  58.130 -lemma int_number_of_diff_sym: "((number_of v)::int) - number_of w = number_of (v + (uminus w))"
  58.131 -  by simp
  58.132 -
  58.133 -lemma int_number_of_mult_sym: "((number_of v)::int) * number_of w = number_of (v * w)"
  58.134 -  by simp
  58.135 -
  58.136 -lemma int_number_of_minus_sym: "- ((number_of v)::int) = number_of (uminus v)"
  58.137 -  by simp
  58.138 -
  58.139 -lemmas intarith = int_number_of_add_sym int_number_of_minus_sym int_number_of_diff_sym int_number_of_mult_sym
  58.140 -
  58.141 -lemmas natarith = add_nat_number_of diff_nat_number_of mult_nat_number_of eq_nat_number_of less_nat_number_of
  58.142 -
  58.143 -lemmas powerarith = nat_number_of zpower_number_of_even
  58.144 -  zpower_number_of_odd[simplified zero_eq_Numeral0_nring one_eq_Numeral1_nring]
  58.145 -  zpower_Pls zpower_Min
  58.146 +lemmas powerarith = nat_numeral zpower_numeral_even
  58.147 +  zpower_numeral_odd zpower_Pls
  58.148  
  58.149  definition float :: "(int \<times> int) \<Rightarrow> real" where
  58.150    "float = (\<lambda>(a, b). real a * 2 powr real b)"
  58.151 @@ -302,7 +235,8 @@
  58.152            float_minus float_abs zero_le_float float_pprt float_nprt pprt_lbound nprt_ubound
  58.153  
  58.154  (* for use with the compute oracle *)
  58.155 -lemmas arith = binarith intarith intarithrel natarith powerarith floatarith not_false_eq_true not_true_eq_false
  58.156 +lemmas arith = arith_simps rel_simps diff_nat_numeral nat_0
  58.157 +  nat_neg_numeral powerarith floatarith not_false_eq_true not_true_eq_false
  58.158  
  58.159  use "~~/src/HOL/Tools/float_arith.ML"
  58.160  
    59.1 --- a/src/HOL/Matrix_LP/ComputeNumeral.thy	Fri Mar 23 20:32:43 2012 +0100
    59.2 +++ b/src/HOL/Matrix_LP/ComputeNumeral.thy	Mon Mar 26 10:56:56 2012 +0200
    59.3 @@ -2,145 +2,47 @@
    59.4  imports ComputeHOL ComputeFloat
    59.5  begin
    59.6  
    59.7 -(* normalization of bit strings *)
    59.8 -lemmas bitnorm = normalize_bin_simps
    59.9 -
   59.10 -(* neg for bit strings *)
   59.11 -lemma neg1: "neg Int.Pls = False" by (simp add: Int.Pls_def)
   59.12 -lemma neg2: "neg Int.Min = True" apply (subst Int.Min_def) by auto
   59.13 -lemma neg3: "neg (Int.Bit0 x) = neg x" apply (simp add: neg_def) apply (subst Bit0_def) by auto
   59.14 -lemma neg4: "neg (Int.Bit1 x) = neg x" apply (simp add: neg_def) apply (subst Bit1_def) by auto  
   59.15 -lemmas bitneg = neg1 neg2 neg3 neg4
   59.16 -
   59.17 -(* iszero for bit strings *)
   59.18 -lemma iszero1: "iszero Int.Pls = True" by (simp add: Int.Pls_def iszero_def)
   59.19 -lemma iszero2: "iszero Int.Min = False" apply (subst Int.Min_def) apply (subst iszero_def) by simp
   59.20 -lemma iszero3: "iszero (Int.Bit0 x) = iszero x" apply (subst Int.Bit0_def) apply (subst iszero_def)+ by auto
   59.21 -lemma iszero4: "iszero (Int.Bit1 x) = False" apply (subst Int.Bit1_def) apply (subst iszero_def)+  apply simp by arith
   59.22 -lemmas bitiszero = iszero1 iszero2 iszero3 iszero4
   59.23 -
   59.24 -(* lezero for bit strings *)
   59.25 -definition "lezero x \<longleftrightarrow> x \<le> 0"
   59.26 -lemma lezero1: "lezero Int.Pls = True" unfolding Int.Pls_def lezero_def by auto
   59.27 -lemma lezero2: "lezero Int.Min = True" unfolding Int.Min_def lezero_def by auto
   59.28 -lemma lezero3: "lezero (Int.Bit0 x) = lezero x" unfolding Int.Bit0_def lezero_def by auto
   59.29 -lemma lezero4: "lezero (Int.Bit1 x) = neg x" unfolding Int.Bit1_def lezero_def neg_def by auto
   59.30 -lemmas bitlezero = lezero1 lezero2 lezero3 lezero4
   59.31 -
   59.32  (* equality for bit strings *)
   59.33 -lemmas biteq = eq_bin_simps
   59.34 +lemmas biteq = eq_num_simps
   59.35  
   59.36  (* x < y for bit strings *)
   59.37 -lemmas bitless = less_bin_simps
   59.38 +lemmas bitless = less_num_simps
   59.39  
   59.40  (* x \<le> y for bit strings *)
   59.41 -lemmas bitle = le_bin_simps
   59.42 -
   59.43 -(* succ for bit strings *)
   59.44 -lemmas bitsucc = succ_bin_simps
   59.45 -
   59.46 -(* pred for bit strings *)
   59.47 -lemmas bitpred = pred_bin_simps
   59.48 -
   59.49 -(* unary minus for bit strings *)
   59.50 -lemmas bituminus = minus_bin_simps
   59.51 +lemmas bitle = le_num_simps
   59.52  
   59.53  (* addition for bit strings *)
   59.54 -lemmas bitadd = add_bin_simps
   59.55 +lemmas bitadd = add_num_simps
   59.56  
   59.57  (* multiplication for bit strings *) 
   59.58 -lemma mult_Pls_right: "x * Int.Pls = Int.Pls" by (simp add: Pls_def)
   59.59 -lemma mult_Min_right: "x * Int.Min = - x" by (subst mult_commute) simp 
   59.60 -lemma multb0x: "(Int.Bit0 x) * y = Int.Bit0 (x * y)" by (rule mult_Bit0)
   59.61 -lemma multxb0: "x * (Int.Bit0 y) = Int.Bit0 (x * y)" unfolding Bit0_def by simp
   59.62 -lemma multb1: "(Int.Bit1 x) * (Int.Bit1 y) = Int.Bit1 (Int.Bit0 (x * y) + x + y)"
   59.63 -  unfolding Bit0_def Bit1_def by (simp add: algebra_simps)
   59.64 -lemmas bitmul = mult_Pls mult_Min mult_Pls_right mult_Min_right multb0x multxb0 multb1
   59.65 +lemmas bitmul = mult_num_simps
   59.66  
   59.67 -lemmas bitarith = bitnorm bitiszero bitneg bitlezero biteq bitless bitle bitsucc bitpred bituminus bitadd bitmul 
   59.68 -
   59.69 -definition "nat_norm_number_of (x::nat) = x"
   59.70 -
   59.71 -lemma nat_norm_number_of: "nat_norm_number_of (number_of w) = (if lezero w then 0 else number_of w)"
   59.72 -  apply (simp add: nat_norm_number_of_def)
   59.73 -  unfolding lezero_def iszero_def neg_def
   59.74 -  apply (simp add: numeral_simps)
   59.75 -  done
   59.76 +lemmas bitarith = arith_simps
   59.77  
   59.78  (* Normalization of nat literals *)
   59.79 -lemma natnorm0: "(0::nat) = number_of (Int.Pls)" by auto
   59.80 -lemma natnorm1: "(1 :: nat) = number_of (Int.Bit1 Int.Pls)"  by auto 
   59.81 -lemmas natnorm = natnorm0 natnorm1 nat_norm_number_of
   59.82 -
   59.83 -(* Suc *)
   59.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)
   59.85 -
   59.86 -(* Addition for nat *)
   59.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))))"
   59.88 -  unfolding nat_number_of_def number_of_is_id neg_def
   59.89 -  by auto
   59.90 -
   59.91 -(* Subtraction for nat *)
   59.92 -lemma natsub: "(number_of x) - ((number_of y)::nat) = 
   59.93 -  (if neg x then 0 else (if neg y then number_of x else (nat_norm_number_of (number_of (x + (- y))))))"
   59.94 -  unfolding nat_norm_number_of
   59.95 -  by (auto simp add: number_of_is_id neg_def lezero_def iszero_def Let_def nat_number_of_def)
   59.96 -
   59.97 -(* Multiplication for nat *)
   59.98 -lemma natmul: "(number_of x) * ((number_of y)::nat) = 
   59.99 -  (if neg x then 0 else (if neg y then 0 else number_of (x * y)))"
  59.100 -  unfolding nat_number_of_def number_of_is_id neg_def
  59.101 -  by (simp add: nat_mult_distrib)
  59.102 -
  59.103 -lemma nateq: "(((number_of x)::nat) = (number_of y)) = ((lezero x \<and> lezero y) \<or> (x = y))"
  59.104 -  by (auto simp add: iszero_def lezero_def neg_def number_of_is_id)
  59.105 -
  59.106 -lemma natless: "(((number_of x)::nat) < (number_of y)) = ((x < y) \<and> (\<not> (lezero y)))"
  59.107 -  by (simp add: lezero_def numeral_simps not_le)
  59.108 -
  59.109 -lemma natle: "(((number_of x)::nat) \<le> (number_of y)) = (y < x \<longrightarrow> lezero x)"
  59.110 -  by (auto simp add: number_of_is_id lezero_def nat_number_of_def)
  59.111 +lemmas natnorm = one_eq_Numeral1_nat
  59.112  
  59.113  fun natfac :: "nat \<Rightarrow> nat"
  59.114    where "natfac n = (if n = 0 then 1 else n * (natfac (n - 1)))"
  59.115  
  59.116 -lemmas compute_natarith = bitarith natnorm natsuc natadd natsub natmul nateq natless natle natfac.simps
  59.117 -
  59.118 -lemma number_eq: "(((number_of x)::'a::{number_ring, linordered_idom}) = (number_of y)) = (x = y)"
  59.119 -  unfolding number_of_eq
  59.120 -  apply simp
  59.121 -  done
  59.122 +lemmas compute_natarith =
  59.123 +  arith_simps rel_simps
  59.124 +  diff_nat_numeral nat_numeral nat_0 nat_neg_numeral
  59.125 +  numeral_1_eq_1 [symmetric]
  59.126 +  numeral_1_eq_Suc_0 [symmetric]
  59.127 +  Suc_numeral natfac.simps
  59.128  
  59.129 -lemma number_le: "(((number_of x)::'a::{number_ring, linordered_idom}) \<le>  (number_of y)) = (x \<le> y)"
  59.130 -  unfolding number_of_eq
  59.131 -  apply simp
  59.132 -  done
  59.133 -
  59.134 -lemma number_less: "(((number_of x)::'a::{number_ring, linordered_idom}) <  (number_of y)) = (x < y)"
  59.135 -  unfolding number_of_eq 
  59.136 -  apply simp
  59.137 -  done
  59.138 +lemmas number_norm = numeral_1_eq_1[symmetric]
  59.139  
  59.140 -lemma number_diff: "((number_of x)::'a::{number_ring, linordered_idom}) - number_of y = number_of (x + (- y))"
  59.141 -  apply (subst diff_number_of_eq)
  59.142 -  apply simp
  59.143 -  done
  59.144 -
  59.145 -lemmas number_norm = number_of_Pls[symmetric] numeral_1_eq_1[symmetric]
  59.146 -
  59.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
  59.148 +lemmas compute_numberarith =
  59.149 +  arith_simps rel_simps number_norm
  59.150  
  59.151 -lemma compute_real_of_nat_number_of: "real ((number_of v)::nat) = (if neg v then 0 else number_of v)"
  59.152 -  by (simp only: real_of_nat_number_of number_of_is_id)
  59.153 -
  59.154 -lemma compute_nat_of_int_number_of: "nat ((number_of v)::int) = (number_of v)"
  59.155 -  by simp
  59.156 +lemmas compute_num_conversions =
  59.157 +  real_of_nat_numeral real_of_nat_zero
  59.158 +  nat_numeral nat_0 nat_neg_numeral
  59.159 +  real_numeral real_of_int_zero
  59.160  
  59.161 -lemmas compute_num_conversions = compute_real_of_nat_number_of compute_nat_of_int_number_of real_number_of
  59.162 -
  59.163 -lemmas zpowerarith = zpower_number_of_even
  59.164 -  zpower_number_of_odd[simplified zero_eq_Numeral0_nring one_eq_Numeral1_nring]
  59.165 -  zpower_Pls zpower_Min
  59.166 +lemmas zpowerarith = zpower_numeral_even zpower_numeral_odd zpower_Pls int_pow_1
  59.167  
  59.168  (* div, mod *)
  59.169  
  59.170 @@ -162,26 +64,19 @@
  59.171  
  59.172  (* collecting all the theorems *)
  59.173  
  59.174 -lemma even_Pls: "even (Int.Pls) = True"
  59.175 -  apply (unfold Pls_def even_def)
  59.176 +lemma even_0_int: "even (0::int) = True"
  59.177    by simp
  59.178  
  59.179 -lemma even_Min: "even (Int.Min) = False"
  59.180 -  apply (unfold Min_def even_def)
  59.181 +lemma even_One_int: "even (numeral Num.One :: int) = False"
  59.182    by simp
  59.183  
  59.184 -lemma even_B0: "even (Int.Bit0 x) = True"
  59.185 -  apply (unfold Bit0_def)
  59.186 +lemma even_Bit0_int: "even (numeral (Num.Bit0 x) :: int) = True"
  59.187    by simp
  59.188  
  59.189 -lemma even_B1: "even (Int.Bit1 x) = False"
  59.190 -  apply (unfold Bit1_def)
  59.191 +lemma even_Bit1_int: "even (numeral (Num.Bit1 x) :: int) = False"
  59.192    by simp
  59.193  
  59.194 -lemma even_number_of: "even ((number_of w)::int) = even w"
  59.195 -  by (simp only: number_of_is_id)
  59.196 -
  59.197 -lemmas compute_even = even_Pls even_Min even_B0 even_B1 even_number_of
  59.198 +lemmas compute_even = even_0_int even_One_int even_Bit0_int even_Bit1_int
  59.199  
  59.200  lemmas compute_numeral = compute_if compute_let compute_pair compute_bool 
  59.201                           compute_natarith compute_numberarith max_def min_def compute_num_conversions zpowerarith compute_div_mod compute_even
    60.1 --- a/src/HOL/Matrix_LP/SparseMatrix.thy	Fri Mar 23 20:32:43 2012 +0100
    60.2 +++ b/src/HOL/Matrix_LP/SparseMatrix.thy	Mon Mar 26 10:56:56 2012 +0200
    60.3 @@ -1029,9 +1029,7 @@
    60.4    sparse_row_matrix_pprt sorted_spvec_pprt_spmat sorted_spmat_pprt_spmat
    60.5    sparse_row_matrix_nprt sorted_spvec_nprt_spmat sorted_spmat_nprt_spmat
    60.6  
    60.7 -lemma zero_eq_Numeral0: "(0::_::number_ring) = Numeral0" by simp
    60.8 -
    60.9 -lemmas sparse_row_matrix_arith_simps[simplified zero_eq_Numeral0] = 
   60.10 +lemmas sparse_row_matrix_arith_simps = 
   60.11    mult_spmat.simps mult_spvec_spmat.simps 
   60.12    addmult_spvec.simps 
   60.13    smult_spvec_empty smult_spvec_cons
    61.1 --- a/src/HOL/Metis_Examples/Big_O.thy	Fri Mar 23 20:32:43 2012 +0100
    61.2 +++ b/src/HOL/Metis_Examples/Big_O.thy	Mon Mar 26 10:56:56 2012 +0200
    61.3 @@ -16,7 +16,7 @@
    61.4  
    61.5  subsection {* Definitions *}
    61.6  
    61.7 -definition bigo :: "('a => 'b\<Colon>{linordered_idom,number_ring}) => ('a => 'b) set" ("(1O'(_'))") where
    61.8 +definition bigo :: "('a => 'b\<Colon>linordered_idom) => ('a => 'b) set" ("(1O'(_'))") where
    61.9    "O(f\<Colon>('a => 'b)) == {h. \<exists>c. \<forall>x. abs (h x) <= c * abs (f x)}"
   61.10  
   61.11  lemma bigo_pos_const:
   61.12 @@ -180,7 +180,7 @@
   61.13   apply (rule_tac x = "c + c" in exI)
   61.14   apply auto
   61.15   apply (subgoal_tac "c * abs (f xa + g xa) <= (c + c) * abs (g xa)")
   61.16 -  apply (metis order_trans semiring_mult_2)
   61.17 +  apply (metis order_trans mult_2)
   61.18   apply (subgoal_tac "c * abs (f xa + g xa) <= c * (abs (f xa) + abs (g xa))")
   61.19    apply (erule order_trans)
   61.20    apply (simp add: ring_distribs)
   61.21 @@ -325,7 +325,7 @@
   61.22  by (metis bigo_mult2 set_plus_mono_b set_times_intro2 set_times_plus_distrib)
   61.23  
   61.24  lemma bigo_mult5: "\<forall>x. f x ~= 0 \<Longrightarrow>
   61.25 -    O(f * g) <= (f\<Colon>'a => ('b\<Colon>{linordered_field,number_ring})) *o O(g)"
   61.26 +    O(f * g) <= (f\<Colon>'a => ('b\<Colon>linordered_field)) *o O(g)"
   61.27  proof -
   61.28    assume a: "\<forall>x. f x ~= 0"
   61.29    show "O(f * g) <= f *o O(g)"
   61.30 @@ -351,21 +351,21 @@
   61.31  qed
   61.32  
   61.33  lemma bigo_mult6:
   61.34 -"\<forall>x. f x \<noteq> 0 \<Longrightarrow> O(f * g) = (f\<Colon>'a \<Rightarrow> ('b\<Colon>{linordered_field,number_ring})) *o O(g)"
   61.35 +"\<forall>x. f x \<noteq> 0 \<Longrightarrow> O(f * g) = (f\<Colon>'a \<Rightarrow> ('b\<Colon>linordered_field)) *o O(g)"
   61.36  by (metis bigo_mult2 bigo_mult5 order_antisym)
   61.37  
   61.38  (*proof requires relaxing relevance: 2007-01-25*)
   61.39  declare bigo_mult6 [simp]
   61.40  
   61.41  lemma bigo_mult7:
   61.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)"
   61.43 +"\<forall>x. f x \<noteq> 0 \<Longrightarrow> O(f * g) \<le> O(f\<Colon>'a \<Rightarrow> ('b\<Colon>linordered_field)) \<otimes> O(g)"
   61.44  by (metis bigo_refl bigo_mult6 set_times_mono3)
   61.45  
   61.46  declare bigo_mult6 [simp del]
   61.47  declare bigo_mult7 [intro!]
   61.48  
   61.49  lemma bigo_mult8:
   61.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)"
   61.51 +"\<forall>x. f x \<noteq> 0 \<Longrightarrow> O(f * g) = O(f\<Colon>'a \<Rightarrow> ('b\<Colon>linordered_field)) \<otimes> O(g)"
   61.52  by (metis bigo_mult bigo_mult7 order_antisym_conv)
   61.53  
   61.54  lemma bigo_minus [intro]: "f : O(g) \<Longrightarrow> - f : O(g)"
   61.55 @@ -405,14 +405,14 @@
   61.56  lemma bigo_const2 [intro]: "O(\<lambda>x. c) \<le> O(\<lambda>x. 1)"
   61.57  by (metis bigo_const1 bigo_elt_subset)
   61.58  
   61.59 -lemma bigo_const3: "(c\<Colon>'a\<Colon>{linordered_field,number_ring}) ~= 0 \<Longrightarrow> (\<lambda>x. 1) : O(\<lambda>x. c)"
   61.60 +lemma bigo_const3: "(c\<Colon>'a\<Colon>linordered_field) ~= 0 \<Longrightarrow> (\<lambda>x. 1) : O(\<lambda>x. c)"
   61.61  apply (simp add: bigo_def)
   61.62  by (metis abs_eq_0 left_inverse order_refl)
   61.63  
   61.64 -lemma bigo_const4: "(c\<Colon>'a\<Colon>{linordered_field,number_ring}) ~= 0 \<Longrightarrow> O(\<lambda>x. 1) <= O(\<lambda>x. c)"
   61.65 +lemma bigo_const4: "(c\<Colon>'a\<Colon>linordered_field) ~= 0 \<Longrightarrow> O(\<lambda>x. 1) <= O(\<lambda>x. c)"
   61.66  by (metis bigo_elt_subset bigo_const3)
   61.67  
   61.68 -lemma bigo_const [simp]: "(c\<Colon>'a\<Colon>{linordered_field,number_ring}) ~= 0 \<Longrightarrow>
   61.69 +lemma bigo_const [simp]: "(c\<Colon>'a\<Colon>linordered_field) ~= 0 \<Longrightarrow>
   61.70      O(\<lambda>x. c) = O(\<lambda>x. 1)"
   61.71  by (metis bigo_const2 bigo_const4 equalityI)
   61.72  
   61.73 @@ -423,19 +423,19 @@
   61.74  lemma bigo_const_mult2: "O(\<lambda>x. c * f x) \<le> O(f)"
   61.75  by (rule bigo_elt_subset, rule bigo_const_mult1)
   61.76  
   61.77 -lemma bigo_const_mult3: "(c\<Colon>'a\<Colon>{linordered_field,number_ring}) ~= 0 \<Longrightarrow> f : O(\<lambda>x. c * f x)"
   61.78 +lemma bigo_const_mult3: "(c\<Colon>'a\<Colon>linordered_field) ~= 0 \<Longrightarrow> f : O(\<lambda>x. c * f x)"
   61.79  apply (simp add: bigo_def)
   61.80  by (metis (no_types) abs_mult mult_assoc mult_1 order_refl left_inverse)
   61.81  
   61.82  lemma bigo_const_mult4:
   61.83 -"(c\<Colon>'a\<Colon>{linordered_field,number_ring}) \<noteq> 0 \<Longrightarrow> O(f) \<le> O(\<lambda>x. c * f x)"
   61.84 +"(c\<Colon>'a\<Colon>linordered_field) \<noteq> 0 \<Longrightarrow> O(f) \<le> O(\<lambda>x. c * f x)"
   61.85  by (metis bigo_elt_subset bigo_const_mult3)
   61.86  
   61.87 -lemma bigo_const_mult [simp]: "(c\<Colon>'a\<Colon>{linordered_field,number_ring}) ~= 0 \<Longrightarrow>
   61.88 +lemma bigo_const_mult [simp]: "(c\<Colon>'a\<Colon>linordered_field) ~= 0 \<Longrightarrow>
   61.89      O(\<lambda>x. c * f x) = O(f)"
   61.90  by (metis equalityI bigo_const_mult2 bigo_const_mult4)
   61.91  
   61.92 -lemma bigo_const_mult5 [simp]: "(c\<Colon>'a\<Colon>{linordered_field,number_ring}) ~= 0 \<Longrightarrow>
   61.93 +lemma bigo_const_mult5 [simp]: "(c\<Colon>'a\<Colon>linordered_field) ~= 0 \<Longrightarrow>
   61.94      (\<lambda>x. c) *o O(f) = O(f)"
   61.95    apply (auto del: subsetI)
   61.96    apply (rule order_trans)
   61.97 @@ -587,7 +587,7 @@
   61.98    apply assumption+
   61.99  done
  61.100  
  61.101 -lemma bigo_useful_const_mult: "(c\<Colon>'a\<Colon>{linordered_field,number_ring}) ~= 0 \<Longrightarrow>
  61.102 +lemma bigo_useful_const_mult: "(c\<Colon>'a\<Colon>linordered_field) ~= 0 \<Longrightarrow>
  61.103      (\<lambda>x. c) * f =o O(h) \<Longrightarrow> f =o O(h)"
  61.104    apply (rule subsetD)
  61.105    apply (subgoal_tac "(\<lambda>x. 1 / c) *o O(h) <= O(h)")
  61.106 @@ -696,7 +696,7 @@
  61.107  by (metis abs_ge_zero linorder_linear min_max.sup_absorb1 min_max.sup_commute)
  61.108  
  61.109  lemma bigo_lesso4:
  61.110 -  "f <o g =o O(k\<Colon>'a=>'b\<Colon>{linordered_field,number_ring}) \<Longrightarrow>
  61.111 +  "f <o g =o O(k\<Colon>'a=>'b\<Colon>{linordered_field}) \<Longrightarrow>
  61.112     g =o h +o O(k) \<Longrightarrow> f <o h =o O(k)"
  61.113  apply (unfold lesso_def)
  61.114  apply (drule set_plus_imp_minus)
    62.1 --- a/src/HOL/Multivariate_Analysis/Cartesian_Euclidean_Space.thy	Fri Mar 23 20:32:43 2012 +0100
    62.2 +++ b/src/HOL/Multivariate_Analysis/Cartesian_Euclidean_Space.thy	Mon Mar 26 10:56:56 2012 +0200
    62.3 @@ -207,6 +207,15 @@
    62.4      by (auto intro!: injI simp add: vec_eq_iff of_nat_index)
    62.5  qed
    62.6  
    62.7 +instance vec :: (numeral, finite) numeral ..
    62.8 +instance vec :: (semiring_numeral, finite) semiring_numeral ..
    62.9 +
   62.10 +lemma numeral_index [simp]: "numeral w $ i = numeral w"
   62.11 +  by (induct w, simp_all only: numeral.simps vector_add_component one_index)
   62.12 +
   62.13 +lemma neg_numeral_index [simp]: "neg_numeral w $ i = neg_numeral w"
   62.14 +  by (simp only: neg_numeral_def vector_uminus_component numeral_index)
   62.15 +
   62.16  instance vec :: (comm_ring_1, finite) comm_ring_1 ..
   62.17  instance vec :: (ring_char_0, finite) ring_char_0 ..
   62.18  
   62.19 @@ -222,7 +231,7 @@
   62.20    by (vector field_simps)
   62.21  lemma vector_smult_rneg: "(c::'a::ring) *s -x = -(c *s x)" by vector
   62.22  lemma vector_smult_lneg: "- (c::'a::ring) *s x = -(c *s x)" by vector
   62.23 -lemma vector_sneg_minus1: "-x = (- (1::'a::ring_1)) *s x" by vector
   62.24 +lemma vector_sneg_minus1: "-x = (-1::'a::ring_1) *s x" by vector
   62.25  lemma vector_smult_rzero[simp]: "c *s 0 = (0::'a::mult_zero ^ 'n)" by vector
   62.26  lemma vector_sub_rdistrib: "((a::'a::ring) - b) *s x = a *s x - b *s x"
   62.27    by (vector field_simps)
    63.1 --- a/src/HOL/Multivariate_Analysis/Convex_Euclidean_Space.thy	Fri Mar 23 20:32:43 2012 +0100
    63.2 +++ b/src/HOL/Multivariate_Analysis/Convex_Euclidean_Space.thy	Mon Mar 26 10:56:56 2012 +0200
    63.3 @@ -281,7 +281,7 @@
    63.4  lemma scaleR_2:
    63.5    fixes x :: "'a::real_vector"
    63.6    shows "scaleR 2 x = x + x"
    63.7 -unfolding one_add_one_is_two [symmetric] scaleR_left_distrib by simp
    63.8 +unfolding one_add_one [symmetric] scaleR_left_distrib by simp
    63.9  
   63.10  lemma vector_choose_size: "0 <= c ==> \<exists>(x::'a::euclidean_space). norm x = c"
   63.11    apply (rule exI[where x="c *\<^sub>R basis 0 ::'a"]) using DIM_positive[where 'a='a] by auto
    64.1 --- a/src/HOL/Multivariate_Analysis/Determinants.thy	Fri Mar 23 20:32:43 2012 +0100
    64.2 +++ b/src/HOL/Multivariate_Analysis/Determinants.thy	Mon Mar 26 10:56:56 2012 +0200
    64.3 @@ -286,7 +286,7 @@
    64.4  proof-
    64.5    have tha: "\<And>(a::'a) b. a = b ==> b = - a ==> a = 0"
    64.6      by simp
    64.7 -  have th1: "of_int (-1) = - 1" by (metis of_int_1 of_int_minus number_of_Min)
    64.8 +  have th1: "of_int (-1) = - 1" by simp
    64.9    let ?p = "Fun.swap i j id"
   64.10    let ?A = "\<chi> i. A $ ?p i"
   64.11    from r have "A = ?A" by (simp add: vec_eq_iff row_def swap_def)
   64.12 @@ -1058,8 +1058,7 @@
   64.13    unfolding det_def UNIV_2
   64.14    unfolding setsum_over_permutations_insert[OF f12]
   64.15    unfolding permutes_sing
   64.16 -  apply (simp add: sign_swap_id sign_id swap_id_eq)
   64.17 -  by (simp add: arith_simps(31)[symmetric] del: arith_simps(31))
   64.18 +  by (simp add: sign_swap_id sign_id swap_id_eq)
   64.19  qed
   64.20  
   64.21  lemma det_3: "det (A::'a::comm_ring_1^3^3) =
   64.22 @@ -1079,9 +1078,7 @@
   64.23    unfolding setsum_over_permutations_insert[OF f23]
   64.24  
   64.25    unfolding permutes_sing
   64.26 -  apply (simp add: sign_swap_id permutation_swap_id sign_compose sign_id swap_id_eq)
   64.27 -  apply (simp add: arith_simps(31)[symmetric] del: arith_simps(31))
   64.28 -  by (simp add: field_simps)
   64.29 +  by (simp add: sign_swap_id permutation_swap_id sign_compose sign_id swap_id_eq)
   64.30  qed
   64.31  
   64.32  end
    65.1 --- a/src/HOL/Multivariate_Analysis/Norm_Arith.thy	Fri Mar 23 20:32:43 2012 +0100
    65.2 +++ b/src/HOL/Multivariate_Analysis/Norm_Arith.thy	Mon Mar 26 10:56:56 2012 +0200
    65.3 @@ -104,6 +104,17 @@
    65.4    "x \<noteq> y \<longleftrightarrow> \<not> (norm (x - y) \<le> 0)"
    65.5    using norm_ge_zero[of "x - y"] by auto
    65.6  
    65.7 +lemmas arithmetic_simps =
    65.8 +  arith_simps
    65.9 +  add_numeral_special
   65.10 +  add_neg_numeral_special
   65.11 +  add_0_left
   65.12 +  add_0_right
   65.13 +  mult_zero_left
   65.14 +  mult_zero_right
   65.15 +  mult_1_left
   65.16 +  mult_1_right
   65.17 +
   65.18  use "normarith.ML"
   65.19  
   65.20  method_setup norm = {* Scan.succeed (SIMPLE_METHOD' o NormArith.norm_arith_tac)
    66.1 --- a/src/HOL/Multivariate_Analysis/Topology_Euclidean_Space.thy	Fri Mar 23 20:32:43 2012 +0100
    66.2 +++ b/src/HOL/Multivariate_Analysis/Topology_Euclidean_Space.thy	Mon Mar 26 10:56:56 2012 +0200
    66.3 @@ -5786,7 +5786,7 @@
    66.4      { assume as:"dist a b > dist (f n x) (f n y)"
    66.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"
    66.6          and "\<forall>m\<ge>Nb. dist (f (r m) y) b < (dist a b - dist (f n x) (f n y)) / 2"
    66.7 -        using lima limb unfolding h_def LIMSEQ_def by (fastforce simp del: less_divide_eq_number_of1)
    66.8 +        using lima limb unfolding h_def LIMSEQ_def by (fastforce simp del: less_divide_eq_numeral1)
    66.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)"
   66.10          apply(erule_tac x="Na+Nb+n" in allE)
   66.11          apply(erule_tac x="Na+Nb+n" in allE) apply simp
    67.1 --- a/src/HOL/Mutabelle/mutabelle_extra.ML	Fri Mar 23 20:32:43 2012 +0100
    67.2 +++ b/src/HOL/Mutabelle/mutabelle_extra.ML	Mon Mar 26 10:56:56 2012 +0200
    67.3 @@ -271,7 +271,7 @@
    67.4   @{const_name enum_prod_inst.enum_ex_prod},
    67.5   @{const_name Quickcheck.catch_match},
    67.6   @{const_name Quickcheck_Exhaustive.unknown},
    67.7 - @{const_name Int.Bit0}, @{const_name Int.Bit1}
    67.8 + @{const_name Num.Bit0}, @{const_name Num.Bit1}
    67.9   (*@{const_name "==>"}, @{const_name "=="}*)]
   67.10  
   67.11  val forbidden_mutant_consts =
    68.1 --- a/src/HOL/NSA/HyperDef.thy	Fri Mar 23 20:32:43 2012 +0100
    68.2 +++ b/src/HOL/NSA/HyperDef.thy	Mon Mar 26 10:56:56 2012 +0200
    68.3 @@ -346,8 +346,8 @@
    68.4    K (Lin_Arith.add_inj_thms [@{thm star_of_le} RS iffD2,
    68.5      @{thm star_of_less} RS iffD2, @{thm star_of_eq} RS iffD2]
    68.6    #> Lin_Arith.add_simps [@{thm star_of_zero}, @{thm star_of_one},
    68.7 -      @{thm star_of_number_of}, @{thm star_of_add}, @{thm star_of_minus},
    68.8 -      @{thm star_of_diff}, @{thm star_of_mult}]
    68.9 +      @{thm star_of_numeral}, @{thm star_of_neg_numeral}, @{thm star_of_add},
   68.10 +      @{thm star_of_minus}, @{thm star_of_diff}, @{thm star_of_mult}]
   68.11    #> Lin_Arith.add_inj_const (@{const_name "StarDef.star_of"}, @{typ "real \<Rightarrow> hypreal"}))
   68.12  *}
   68.13  
   68.14 @@ -419,10 +419,15 @@
   68.15        x ^ Suc (Suc 0) + y ^ Suc (Suc 0) + (hypreal_of_nat (Suc (Suc 0)))*x*y"
   68.16  by (simp add: right_distrib left_distrib)
   68.17  
   68.18 -lemma power_hypreal_of_real_number_of:
   68.19 -     "(number_of v :: hypreal) ^ n = hypreal_of_real ((number_of v) ^ n)"
   68.20 +lemma power_hypreal_of_real_numeral:
   68.21 +     "(numeral v :: hypreal) ^ n = hypreal_of_real ((numeral v) ^ n)"
   68.22  by simp
   68.23 -declare power_hypreal_of_real_number_of [of _ "number_of w", simp] for w
   68.24 +declare power_hypreal_of_real_numeral [of _ "numeral w", simp] for w
   68.25 +
   68.26 +lemma power_hypreal_of_real_neg_numeral:
   68.27 +     "(neg_numeral v :: hypreal) ^ n = hypreal_of_real ((neg_numeral v) ^ n)"
   68.28 +by simp
   68.29 +declare power_hypreal_of_real_neg_numeral [of _ "numeral w", simp] for w
   68.30  (*
   68.31  lemma hrealpow_HFinite:
   68.32    fixes x :: "'a::{real_normed_algebra,power} star"
   68.33 @@ -492,7 +497,7 @@
   68.34  by transfer (rule power_one)
   68.35  
   68.36  lemma hrabs_hyperpow_minus_one [simp]:
   68.37 -  "\<And>n. abs(-1 pow n) = (1::'a::{number_ring,linordered_idom} star)"
   68.38 +  "\<And>n. abs(-1 pow n) = (1::'a::{linordered_idom} star)"
   68.39  by transfer (rule abs_power_minus_one)
   68.40  
   68.41  lemma hyperpow_mult:
    69.1 --- a/src/HOL/NSA/NSA.thy	Fri Mar 23 20:32:43 2012 +0100
    69.2 +++ b/src/HOL/NSA/NSA.thy	Mon Mar 26 10:56:56 2012 +0200
    69.3 @@ -190,7 +190,7 @@
    69.4  lemma SReal_hypreal_of_real [simp]: "hypreal_of_real x \<in> Reals"
    69.5  by (simp add: Reals_eq_Standard)
    69.6  
    69.7 -lemma SReal_divide_number_of: "r \<in> Reals ==> r/(number_of w::hypreal) \<in> Reals"
    69.8 +lemma SReal_divide_numeral: "r \<in> Reals ==> r/(numeral w::hypreal) \<in> Reals"
    69.9  by simp
   69.10  
   69.11  text{*epsilon is not in Reals because it is an infinitesimal*}
   69.12 @@ -290,8 +290,8 @@
   69.13    "(hnorm (x::hypreal) \<in> HFinite) = (x \<in> HFinite)"
   69.14  by (simp add: HFinite_def)
   69.15  
   69.16 -lemma HFinite_number_of [simp]: "number_of w \<in> HFinite"
   69.17 -unfolding star_number_def by (rule HFinite_star_of)
   69.18 +lemma HFinite_numeral [simp]: "numeral w \<in> HFinite"
   69.19 +unfolding star_numeral_def by (rule HFinite_star_of)
   69.20  
   69.21  (** As always with numerals, 0 and 1 are special cases **)
   69.22  
   69.23 @@ -347,7 +347,7 @@
   69.24  apply (rule InfinitesimalI)
   69.25  apply (rule hypreal_sum_of_halves [THEN subst])
   69.26  apply (drule half_gt_zero)
   69.27 -apply (blast intro: hnorm_add_less SReal_divide_number_of dest: InfinitesimalD)
   69.28 +apply (blast intro: hnorm_add_less SReal_divide_numeral dest: InfinitesimalD)
   69.29  done
   69.30  
   69.31  lemma Infinitesimal_minus_iff [simp]: "(-x:Infinitesimal) = (x:Infinitesimal)"
   69.32 @@ -652,7 +652,7 @@
   69.33  (*reorientation simplification procedure: reorients (polymorphic)
   69.34    0 = x, 1 = x, nnn = x provided x isn't 0, 1 or a numeral.*)
   69.35  simproc_setup approx_reorient_simproc
   69.36 -  ("0 @= x" | "1 @= y" | "number_of w @= z") =
   69.37 +  ("0 @= x" | "1 @= y" | "numeral w @= z" | "neg_numeral w @= r") =
   69.38  {*
   69.39    let val rule = @{thm approx_reorient} RS eq_reflection
   69.40        fun proc phi ss ct = case term_of ct of
   69.41 @@ -957,9 +957,9 @@
   69.42       "x \<noteq> 0 ==> star_of x \<in> HFinite - Infinitesimal"
   69.43  by simp
   69.44  
   69.45 -lemma number_of_not_Infinitesimal [simp]:
   69.46 -     "number_of w \<noteq> (0::hypreal) ==> (number_of w :: hypreal) \<notin> Infinitesimal"
   69.47 -by (fast dest: Reals_number_of [THEN SReal_Infinitesimal_zero])
   69.48 +lemma numeral_not_Infinitesimal [simp]:
   69.49 +     "numeral w \<noteq> (0::hypreal) ==> (numeral w :: hypreal) \<notin> Infinitesimal"
   69.50 +by (fast dest: Reals_numeral [THEN SReal_Infinitesimal_zero])
   69.51  
   69.52  (*again: 1 is a special case, but not 0 this time*)
   69.53  lemma one_not_Infinitesimal [simp]:
   69.54 @@ -1024,31 +1024,31 @@
   69.55  apply simp
   69.56  done
   69.57  
   69.58 -lemma number_of_approx_iff [simp]:
   69.59 -     "(number_of v @= (number_of w :: 'a::{number,real_normed_vector} star)) =
   69.60 -      (number_of v = (number_of w :: 'a))"
   69.61 -apply (unfold star_number_def)
   69.62 +lemma numeral_approx_iff [simp]:
   69.63 +     "(numeral v @= (numeral w :: 'a::{numeral,real_normed_vector} star)) =
   69.64 +      (numeral v = (numeral w :: 'a))"
   69.65 +apply (unfold star_numeral_def)
   69.66  apply (rule star_of_approx_iff)
   69.67  done
   69.68  
   69.69  (*And also for 0 @= #nn and 1 @= #nn, #nn @= 0 and #nn @= 1.*)
   69.70  lemma [simp]:
   69.71 -  "(number_of w @= (0::'a::{number,real_normed_vector} star)) =
   69.72 -   (number_of w = (0::'a))"
   69.73 -  "((0::'a::{number,real_normed_vector} star) @= number_of w) =
   69.74 -   (number_of w = (0::'a))"
   69.75 -  "(number_of w @= (1::'b::{number,one,real_normed_vector} star)) =
   69.76 -   (number_of w = (1::'b))"
   69.77 -  "((1::'b::{number,one,real_normed_vector} star) @= number_of w) =
   69.78 -   (number_of w = (1::'b))"
   69.79 +  "(numeral w @= (0::'a::{numeral,real_normed_vector} star)) =
   69.80 +   (numeral w = (0::'a))"
   69.81 +  "((0::'a::{numeral,real_normed_vector} star) @= numeral w) =
   69.82 +   (numeral w = (0::'a))"
   69.83 +  "(numeral w @= (1::'b::{numeral,one,real_normed_vector} star)) =
   69.84 +   (numeral w = (1::'b))"
   69.85 +  "((1::'b::{numeral,one,real_normed_vector} star) @= numeral w) =
   69.86 +   (numeral w = (1::'b))"
   69.87    "~ (0 @= (1::'c::{zero_neq_one,real_normed_vector} star))"
   69.88    "~ (1 @= (0::'c::{zero_neq_one,real_normed_vector} star))"
   69.89 -apply (unfold star_number_def star_zero_def star_one_def)
   69.90 +apply (unfold star_numeral_def star_zero_def star_one_def)
   69.91  apply (unfold star_of_approx_iff)
   69.92  by (auto intro: sym)
   69.93  
   69.94 -lemma star_of_approx_number_of_iff [simp]:
   69.95 -     "(star_of k @= number_of w) = (k = number_of w)"
   69.96 +lemma star_of_approx_numeral_iff [simp]:
   69.97 +     "(star_of k @= numeral w) = (k = numeral w)"
   69.98  by (subst star_of_approx_iff [symmetric], auto)
   69.99  
  69.100  lemma star_of_approx_zero_iff [simp]: "(star_of k @= 0) = (k = 0)"
  69.101 @@ -1843,8 +1843,11 @@
  69.102  lemma st_add: "\<lbrakk>x \<in> HFinite; y \<in> HFinite\<rbrakk> \<Longrightarrow> st (x + y) = st x + st y"
  69.103  by (simp add: st_unique st_SReal st_approx_self approx_add)
  69.104  
  69.105 -lemma st_number_of [simp]: "st (number_of w) = number_of w"
  69.106 -by (rule Reals_number_of [THEN st_SReal_eq])
  69.107 +lemma st_numeral [simp]: "st (numeral w) = numeral w"
  69.108 +by (rule Reals_numeral [THEN st_SReal_eq])
  69.109 +
  69.110 +lemma st_neg_numeral [simp]: "st (neg_numeral w) = neg_numeral w"
  69.111 +by (rule Reals_neg_numeral [THEN st_SReal_eq])
  69.112  
  69.113  lemma st_0 [simp]: "st 0 = 0"
  69.114  by (simp add: st_SReal_eq)
    70.1 --- a/src/HOL/NSA/NSCA.thy	Fri Mar 23 20:32:43 2012 +0100
    70.2 +++ b/src/HOL/NSA/NSCA.thy	Mon Mar 26 10:56:56 2012 +0200
    70.3 @@ -32,14 +32,14 @@
    70.4       "hcmod (hcomplex_of_complex r) \<in> Reals"
    70.5  by (simp add: Reals_eq_Standard)
    70.6  
    70.7 -lemma SReal_hcmod_number_of [simp]: "hcmod (number_of w ::hcomplex) \<in> Reals"
    70.8 +lemma SReal_hcmod_numeral [simp]: "hcmod (numeral w ::hcomplex) \<in> Reals"
    70.9  by (simp add: Reals_eq_Standard)
   70.10  
   70.11  lemma SReal_hcmod_SComplex: "x \<in> SComplex ==> hcmod x \<in> Reals"
   70.12  by (simp add: Reals_eq_Standard)
   70.13  
   70.14 -lemma SComplex_divide_number_of:
   70.15 -     "r \<in> SComplex ==> r/(number_of w::hcomplex) \<in> SComplex"
   70.16 +lemma SComplex_divide_numeral:
   70.17 +     "r \<in> SComplex ==> r/(numeral w::hcomplex) \<in> SComplex"
   70.18  by simp
   70.19  
   70.20  lemma SComplex_UNIV_complex:
   70.21 @@ -211,9 +211,9 @@
   70.22        ==> hcomplex_of_complex x \<in> HFinite - Infinitesimal"
   70.23  by (rule SComplex_HFinite_diff_Infinitesimal, auto)
   70.24  
   70.25 -lemma number_of_not_Infinitesimal [simp]:
   70.26 -     "number_of w \<noteq> (0::hcomplex) ==> (number_of w::hcomplex) \<notin> Infinitesimal"
   70.27 -by (fast dest: Standard_number_of [THEN SComplex_Infinitesimal_zero])
   70.28 +lemma numeral_not_Infinitesimal [simp]:
   70.29 +     "numeral w \<noteq> (0::hcomplex) ==> (numeral w::hcomplex) \<notin> Infinitesimal"
   70.30 +by (fast dest: Standard_numeral [THEN SComplex_Infinitesimal_zero])
   70.31  
   70.32  lemma approx_SComplex_not_zero:
   70.33       "[| y \<in> SComplex; x @= y; y\<noteq> 0 |] ==> x \<noteq> 0"
   70.34 @@ -223,11 +223,11 @@
   70.35       "[|x \<in> SComplex; y \<in> SComplex|] ==> (x @= y) = (x = y)"
   70.36  by (auto simp add: Standard_def)
   70.37  
   70.38 -lemma number_of_Infinitesimal_iff [simp]:
   70.39 -     "((number_of w :: hcomplex) \<in> Infinitesimal) =
   70.40 -      (number_of w = (0::hcomplex))"
   70.41 +lemma numeral_Infinitesimal_iff [simp]:
   70.42 +     "((numeral w :: hcomplex) \<in> Infinitesimal) =
   70.43 +      (numeral w = (0::hcomplex))"
   70.44  apply (rule iffI)
   70.45 -apply (fast dest: Standard_number_of [THEN SComplex_Infinitesimal_zero])
   70.46 +apply (fast dest: Standard_numeral [THEN SComplex_Infinitesimal_zero])
   70.47  apply (simp (no_asm_simp))
   70.48  done
   70.49  
   70.50 @@ -441,8 +441,8 @@
   70.51       "[| x \<in> HFinite; y \<in> HFinite |] ==> stc (x + y) = stc(x) + stc(y)"
   70.52  by (simp add: stc_unique stc_SComplex stc_approx_self approx_add)
   70.53  
   70.54 -lemma stc_number_of [simp]: "stc (number_of w) = number_of w"
   70.55 -by (rule Standard_number_of [THEN stc_SComplex_eq])
   70.56 +lemma stc_numeral [simp]: "stc (numeral w) = numeral w"
   70.57 +by (rule Standard_numeral [THEN stc_SComplex_eq])
   70.58  
   70.59  lemma stc_zero [simp]: "stc 0 = 0"
   70.60  by simp
    71.1 --- a/src/HOL/NSA/NSComplex.thy	Fri Mar 23 20:32:43 2012 +0100
    71.2 +++ b/src/HOL/NSA/NSComplex.thy	Mon Mar 26 10:56:56 2012 +0200
    71.3 @@ -626,32 +626,38 @@
    71.4  
    71.5  subsection{*Numerals and Arithmetic*}
    71.6  
    71.7 -lemma hcomplex_number_of_def: "(number_of w :: hcomplex) == of_int w"
    71.8 -by transfer (rule number_of_eq [THEN eq_reflection])
    71.9 -
   71.10  lemma hcomplex_of_hypreal_eq_hcomplex_of_complex: 
   71.11       "hcomplex_of_hypreal (hypreal_of_real x) =  
   71.12        hcomplex_of_complex (complex_of_real x)"
   71.13  by transfer (rule refl)
   71.14  
   71.15 -lemma hcomplex_hypreal_number_of: 
   71.16 -  "hcomplex_of_complex (number_of w) = hcomplex_of_hypreal(number_of w)"
   71.17 -by transfer (rule of_real_number_of_eq [symmetric])
   71.18 +lemma hcomplex_hypreal_numeral:
   71.19 +  "hcomplex_of_complex (numeral w) = hcomplex_of_hypreal(numeral w)"
   71.20 +by transfer (rule of_real_numeral [symmetric])
   71.21  
   71.22 -lemma hcomplex_number_of_hcnj [simp]:
   71.23 -     "hcnj (number_of v :: hcomplex) = number_of v"
   71.24 -by transfer (rule complex_cnj_number_of)
   71.25 +lemma hcomplex_hypreal_neg_numeral:
   71.26 +  "hcomplex_of_complex (neg_numeral w) = hcomplex_of_hypreal(neg_numeral w)"
   71.27 +by transfer (rule of_real_neg_numeral [symmetric])
   71.28 +
   71.29 +lemma hcomplex_numeral_hcnj [simp]:
   71.30 +     "hcnj (numeral v :: hcomplex) = numeral v"
   71.31 +by transfer (rule complex_cnj_numeral)
   71.32  
   71.33 -lemma hcomplex_number_of_hcmod [simp]: 
   71.34 -      "hcmod(number_of v :: hcomplex) = abs (number_of v :: hypreal)"
   71.35 -by transfer (rule norm_number_of)
   71.36 +lemma hcomplex_numeral_hcmod [simp]:
   71.37 +      "hcmod(numeral v :: hcomplex) = (numeral v :: hypreal)"
   71.38 +by transfer (rule norm_numeral)
   71.39 +
   71.40 +lemma hcomplex_neg_numeral_hcmod [simp]: 
   71.41 +      "hcmod(neg_numeral v :: hcomplex) = (numeral v :: hypreal)"
   71.42 +by transfer (rule norm_neg_numeral)
   71.43  
   71.44 -lemma hcomplex_number_of_hRe [simp]: 
   71.45 -      "hRe(number_of v :: hcomplex) = number_of v"
   71.46 -by transfer (rule complex_Re_number_of)
   71.47 +lemma hcomplex_numeral_hRe [simp]: 
   71.48 +      "hRe(numeral v :: hcomplex) = numeral v"
   71.49 +by transfer (rule complex_Re_numeral)
   71.50  
   71.51 -lemma hcomplex_number_of_hIm [simp]: 
   71.52 -      "hIm(number_of v :: hcomplex) = 0"
   71.53 -by transfer (rule complex_Im_number_of)
   71.54 +lemma hcomplex_numeral_hIm [simp]: 
   71.55 +      "hIm(numeral v :: hcomplex) = 0"
   71.56 +by transfer (rule complex_Im_numeral)
   71.57  
   71.58 +(* TODO: add neg_numeral rules above *)
   71.59  end
    72.1 --- a/src/HOL/NSA/StarDef.thy	Fri Mar 23 20:32:43 2012 +0100
    72.2 +++ b/src/HOL/NSA/StarDef.thy	Mon Mar 26 10:56:56 2012 +0200
    72.3 @@ -522,16 +522,6 @@
    72.4  
    72.5  end
    72.6  
    72.7 -instantiation star :: (number) number
    72.8 -begin
    72.9 -
   72.10 -definition
   72.11 -  star_number_def:  "number_of b \<equiv> star_of (number_of b)"
   72.12 -
   72.13 -instance ..
   72.14 -
   72.15 -end
   72.16 -
   72.17  instance star :: (Rings.dvd) Rings.dvd ..
   72.18  
   72.19  instantiation star :: (Divides.div) Divides.div
   72.20 @@ -561,7 +551,7 @@
   72.21  end
   72.22  
   72.23  lemmas star_class_defs [transfer_unfold] =
   72.24 -  star_zero_def     star_one_def      star_number_def
   72.25 +  star_zero_def     star_one_def
   72.26    star_add_def      star_diff_def     star_minus_def
   72.27    star_mult_def     star_divide_def   star_inverse_def
   72.28    star_le_def       star_less_def     star_abs_def       star_sgn_def
   72.29 @@ -575,9 +565,6 @@
   72.30  lemma Standard_one: "1 \<in> Standard"
   72.31  by (simp add: star_one_def)
   72.32  
   72.33 -lemma Standard_number_of: "number_of b \<in> Standard"
   72.34 -by (simp add: star_number_def)
   72.35 -
   72.36  lemma Standard_add: "\<lbrakk>x \<in> Standard; y \<in> Standard\<rbrakk> \<Longrightarrow> x + y \<in> Standard"
   72.37  by (simp add: star_add_def)
   72.38  
   72.39 @@ -606,7 +593,7 @@
   72.40  by (simp add: star_mod_def)
   72.41  
   72.42  lemmas Standard_simps [simp] =
   72.43 -  Standard_zero  Standard_one  Standard_number_of
   72.44 +  Standard_zero  Standard_one
   72.45    Standard_add  Standard_diff  Standard_minus
   72.46    Standard_mult  Standard_divide  Standard_inverse
   72.47    Standard_abs  Standard_div  Standard_mod
   72.48 @@ -648,9 +635,6 @@
   72.49  lemma star_of_one: "star_of 1 = 1"
   72.50  by transfer (rule refl)
   72.51  
   72.52 -lemma star_of_number_of: "star_of (number_of x) = number_of x"
   72.53 -by transfer (rule refl)
   72.54 -
   72.55  text {* @{term star_of} preserves orderings *}
   72.56  
   72.57  lemma star_of_less: "(star_of x < star_of y) = (x < y)"
   72.58 @@ -682,34 +666,16 @@
   72.59  lemmas star_of_le_1   = star_of_le   [of _ 1, simplified star_of_one]
   72.60  lemmas star_of_eq_1   = star_of_eq   [of _ 1, simplified star_of_one]
   72.61  
   72.62 -text{*As above, for numerals*}
   72.63 -
   72.64 -lemmas star_of_number_less =
   72.65 -  star_of_less [of "number_of w", simplified star_of_number_of] for w
   72.66 -lemmas star_of_number_le   =
   72.67 -  star_of_le   [of "number_of w", simplified star_of_number_of] for w
   72.68 -lemmas star_of_number_eq   =
   72.69 -  star_of_eq   [of "number_of w", simplified star_of_number_of] for w
   72.70 -
   72.71 -lemmas star_of_less_number =
   72.72 -  star_of_less [of _ "number_of w", simplified star_of_number_of] for w
   72.73 -lemmas star_of_le_number   =
   72.74 -  star_of_le   [of _ "number_of w", simplified star_of_number_of] for w
   72.75 -lemmas star_of_eq_number   =
   72.76 -  star_of_eq   [of _ "number_of w", simplified star_of_number_of] for w
   72.77 -
   72.78  lemmas star_of_simps [simp] =
   72.79    star_of_add     star_of_diff    star_of_minus
   72.80    star_of_mult    star_of_divide  star_of_inverse
   72.81    star_of_div     star_of_mod     star_of_abs
   72.82 -  star_of_zero    star_of_one     star_of_number_of
   72.83 +  star_of_zero    star_of_one
   72.84    star_of_less    star_of_le      star_of_eq
   72.85    star_of_0_less  star_of_0_le    star_of_0_eq
   72.86    star_of_less_0  star_of_le_0    star_of_eq_0
   72.87    star_of_1_less  star_of_1_le    star_of_1_eq
   72.88    star_of_less_1  star_of_le_1    star_of_eq_1
   72.89 -  star_of_number_less star_of_number_le star_of_number_eq
   72.90 -  star_of_less_number star_of_le_number star_of_eq_number
   72.91  
   72.92  subsection {* Ordering and lattice classes *}
   72.93  
   72.94 @@ -984,9 +950,45 @@
   72.95  
   72.96  subsection {* Number classes *}
   72.97  
   72.98 +instance star :: (numeral) numeral ..
   72.99 +
  72.100 +lemma star_numeral_def [transfer_unfold]:
  72.101 +  "numeral k = star_of (numeral k)"
  72.102 +by (induct k, simp_all only: numeral.simps star_of_one star_of_add)
  72.103 +
  72.104 +lemma Standard_numeral [simp]: "numeral k \<in> Standard"
  72.105 +by (simp add: star_numeral_def)
  72.106 +
  72.107 +lemma star_of_numeral [simp]: "star_of (numeral k) = numeral k"
  72.108 +by transfer (rule refl)
  72.109 +
  72.110 +lemma star_neg_numeral_def [transfer_unfold]:
  72.111 +  "neg_numeral k = star_of (neg_numeral k)"
  72.112 +by (simp only: neg_numeral_def star_of_minus star_of_numeral)
  72.113 +
  72.114 +lemma Standard_neg_numeral [simp]: "neg_numeral k \<in> Standard"
  72.115 +by (simp add: star_neg_numeral_def)
  72.116 +
  72.117 +lemma star_of_neg_numeral [simp]: "star_of (neg_numeral k) = neg_numeral k"
  72.118 +by transfer (rule refl)
  72.119 +
  72.120  lemma star_of_nat_def [transfer_unfold]: "of_nat n = star_of (of_nat n)"
  72.121  by (induct n, simp_all)
  72.122  
  72.123 +lemmas star_of_compare_numeral [simp] =
  72.124 +  star_of_less [of "numeral k", simplified star_of_numeral]
  72.125 +  star_of_le   [of "numeral k", simplified star_of_numeral]
  72.126 +  star_of_eq   [of "numeral k", simplified star_of_numeral]
  72.127 +  star_of_less [of _ "numeral k", simplified star_of_numeral]
  72.128 +  star_of_le   [of _ "numeral k", simplified star_of_numeral]
  72.129 +  star_of_eq   [of _ "numeral k", simplified star_of_numeral]
  72.130 +  star_of_less [of "neg_numeral k", simplified star_of_numeral]
  72.131 +  star_of_le   [of "neg_numeral k", simplified star_of_numeral]
  72.132 +  star_of_eq   [of "neg_numeral k", simplified star_of_numeral]
  72.133 +  star_of_less [of _ "neg_numeral k", simplified star_of_numeral]
  72.134 +  star_of_le   [of _ "neg_numeral k", simplified star_of_numeral]
  72.135 +  star_of_eq   [of _ "neg_numeral k", simplified star_of_numeral] for k
  72.136 +
  72.137  lemma Standard_of_nat [simp]: "of_nat n \<in> Standard"
  72.138  by (simp add: star_of_nat_def)
  72.139  
  72.140 @@ -1010,11 +1012,6 @@
  72.141  
  72.142  instance star :: (ring_char_0) ring_char_0 ..
  72.143  
  72.144 -instance star :: (number_semiring) number_semiring
  72.145 -by (intro_classes, simp only: star_number_def star_of_nat_def number_of_int)
  72.146 -
  72.147 -instance star :: (number_ring) number_ring
  72.148 -by (intro_classes, simp only: star_number_def star_of_int_def number_of_eq)
  72.149  
  72.150  subsection {* Finite class *}
  72.151  
    73.1 --- a/src/HOL/Nat.thy	Fri Mar 23 20:32:43 2012 +0100
    73.2 +++ b/src/HOL/Nat.thy	Mon Mar 26 10:56:56 2012 +0200
    73.3 @@ -181,7 +181,7 @@
    73.4  begin
    73.5  
    73.6  definition
    73.7 -  One_nat_def [simp, code_post]: "1 = Suc 0"
    73.8 +  One_nat_def [simp]: "1 = Suc 0"
    73.9  
   73.10  primrec times_nat where
   73.11    mult_0:     "0 * n = (0\<Colon>nat)"
   73.12 @@ -1782,4 +1782,6 @@
   73.13  code_modulename Haskell
   73.14    Nat Arith
   73.15  
   73.16 +hide_const (open) of_nat_aux
   73.17 +
   73.18  end
    74.1 --- a/src/HOL/Nat_Numeral.thy	Fri Mar 23 20:32:43 2012 +0100
    74.2 +++ b/src/HOL/Nat_Numeral.thy	Mon Mar 26 10:56:56 2012 +0200
    74.3 @@ -15,31 +15,13 @@
    74.4    Arithmetic for naturals is reduced to that for the non-negative integers.
    74.5  *}
    74.6  
    74.7 -instantiation nat :: number_semiring
    74.8 -begin
    74.9 -
   74.10 -definition
   74.11 -  nat_number_of_def [code_unfold, code del]: "number_of v = nat (number_of v)"
   74.12 -
   74.13 -instance proof
   74.14 -  fix n show "number_of (int n) = (of_nat n :: nat)"
   74.15 -    unfolding nat_number_of_def number_of_eq by simp
   74.16 -qed
   74.17 - 
   74.18 -end
   74.19 -
   74.20 -lemma [code_post]:
   74.21 -  "nat (number_of v) = number_of v"
   74.22 -  unfolding nat_number_of_def ..
   74.23 -
   74.24 -
   74.25  subsection {* Special case: squares and cubes *}
   74.26  
   74.27  lemma numeral_2_eq_2: "2 = Suc (Suc 0)"
   74.28 -  by (simp add: nat_number_of_def)
   74.29 +  by (simp add: nat_number(2-4))
   74.30  
   74.31  lemma numeral_3_eq_3: "3 = Suc (Suc (Suc 0))"
   74.32 -  by (simp add: nat_number_of_def)
   74.33 +  by (simp add: nat_number(2-4))
   74.34  
   74.35  context power
   74.36  begin
   74.37 @@ -93,26 +75,21 @@
   74.38    "(- a)\<twosuperior> = a\<twosuperior>"
   74.39    by (simp add: power2_eq_square)
   74.40  
   74.41 -text{*
   74.42 -  We cannot prove general results about the numeral @{term "-1"},
   74.43 -  so we have to use @{term "- 1"} instead.
   74.44 -*}
   74.45 -
   74.46  lemma power_minus1_even [simp]:
   74.47 -  "(- 1) ^ (2*n) = 1"
   74.48 +  "-1 ^ (2*n) = 1"
   74.49  proof (induct n)
   74.50    case 0 show ?case by simp
   74.51  next
   74.52 -  case (Suc n) then show ?case by (simp add: power_add)
   74.53 +  case (Suc n) then show ?case by (simp add: power_add power2_eq_square)
   74.54  qed
   74.55  
   74.56  lemma power_minus1_odd:
   74.57 -  "(- 1) ^ Suc (2*n) = - 1"
   74.58 +  "-1 ^ Suc (2*n) = -1"
   74.59    by simp
   74.60  
   74.61  lemma power_minus_even [simp]:
   74.62    "(-a) ^ (2*n) = a ^ (2*n)"
   74.63 -  by (simp add: power_minus [of a]) 
   74.64 +  by (simp add: power_minus [of a])
   74.65  
   74.66  end
   74.67  
   74.68 @@ -261,100 +238,31 @@
   74.69  end
   74.70  
   74.71  lemma power2_sum:
   74.72 -  fixes x y :: "'a::number_semiring"
   74.73 +  fixes x y :: "'a::comm_semiring_1"
   74.74    shows "(x + y)\<twosuperior> = x\<twosuperior> + y\<twosuperior> + 2 * x * y"
   74.75 -  by (simp add: algebra_simps power2_eq_square semiring_mult_2_right)
   74.76 +  by (simp add: algebra_simps power2_eq_square mult_2_right)
   74.77  
   74.78  lemma power2_diff:
   74.79 -  fixes x y :: "'a::number_ring"
   74.80 +  fixes x y :: "'a::comm_ring_1"
   74.81    shows "(x - y)\<twosuperior> = x\<twosuperior> + y\<twosuperior> - 2 * x * y"
   74.82    by (simp add: ring_distribs power2_eq_square mult_2) (rule mult_commute)
   74.83  
   74.84  
   74.85 -subsection {* Predicate for negative binary numbers *}
   74.86 -
   74.87 -definition neg  :: "int \<Rightarrow> bool" where
   74.88 -  "neg Z \<longleftrightarrow> Z < 0"
   74.89 -
   74.90 -lemma not_neg_int [simp]: "~ neg (of_nat n)"
   74.91 -by (simp add: neg_def)
   74.92 -
   74.93 -lemma neg_zminus_int [simp]: "neg (- (of_nat (Suc n)))"
   74.94 -by (simp add: neg_def del: of_nat_Suc)
   74.95 -
   74.96 -lemmas neg_eq_less_0 = neg_def
   74.97 -
   74.98 -lemma not_neg_eq_ge_0: "(~neg x) = (0 \<le> x)"
   74.99 -by (simp add: neg_def linorder_not_less)
  74.100 -
  74.101 -text{*To simplify inequalities when Numeral1 can get simplified to 1*}
  74.102 -
  74.103 -lemma not_neg_0: "~ neg 0"
  74.104 -by (simp add: One_int_def neg_def)
  74.105 -
  74.106 -lemma not_neg_1: "~ neg 1"
  74.107 -by (simp add: neg_def linorder_not_less)
  74.108 -
  74.109 -lemma neg_nat: "neg z ==> nat z = 0"
  74.110 -by (simp add: neg_def order_less_imp_le) 
  74.111 -
  74.112 -lemma not_neg_nat: "~ neg z ==> of_nat (nat z) = z"
  74.113 -by (simp add: linorder_not_less neg_def)
  74.114 -
  74.115 -text {*
  74.116 -  If @{term Numeral0} is rewritten to 0 then this rule can't be applied:
  74.117 -  @{term Numeral0} IS @{term "number_of Pls"}
  74.118 -*}
  74.119 -
  74.120 -lemma not_neg_number_of_Pls: "~ neg (number_of Int.Pls)"
  74.121 -  by (simp add: neg_def)
  74.122 -
  74.123 -lemma neg_number_of_Min: "neg (number_of Int.Min)"
  74.124 -  by (simp add: neg_def)
  74.125 -
  74.126 -lemma neg_number_of_Bit0:
  74.127 -  "neg (number_of (Int.Bit0 w)) = neg (number_of w)"
  74.128 -  by (simp add: neg_def)
  74.129 -
  74.130 -lemma neg_number_of_Bit1:
  74.131 -  "neg (number_of (Int.Bit1 w)) = neg (number_of w)"
  74.132 -  by (simp add: neg_def)
  74.133 -
  74.134 -lemmas neg_simps [simp] =
  74.135 -  not_neg_0 not_neg_1
  74.136 -  not_neg_number_of_Pls neg_number_of_Min
  74.137 -  neg_number_of_Bit0 neg_number_of_Bit1
  74.138 -
  74.139 -
  74.140  subsection{*Function @{term nat}: Coercion from Type @{typ int} to @{typ nat}*}
  74.141  
  74.142  declare nat_1 [simp]
  74.143  
  74.144 -lemma nat_number_of [simp]: "nat (number_of w) = number_of w"
  74.145 -  by (simp add: nat_number_of_def)
  74.146 -
  74.147 -lemma nat_numeral_0_eq_0: "Numeral0 = (0::nat)" (* FIXME delete candidate *)
  74.148 -  by (fact semiring_numeral_0_eq_0)
  74.149 -
  74.150 -lemma nat_numeral_1_eq_1: "Numeral1 = (1::nat)" (* FIXME delete candidate *)
  74.151 -  by (fact semiring_numeral_1_eq_1)
  74.152 -
  74.153 -lemma Numeral1_eq1_nat:
  74.154 -  "(1::nat) = Numeral1"
  74.155 +lemma nat_neg_numeral [simp]: "nat (neg_numeral w) = 0"
  74.156    by simp
  74.157  
  74.158  lemma numeral_1_eq_Suc_0: "Numeral1 = Suc 0"
  74.159 -  by (simp only: nat_numeral_1_eq_1 One_nat_def)
  74.160 +  by simp
  74.161  
  74.162  
  74.163  subsection{*Function @{term int}: Coercion from Type @{typ nat} to @{typ int}*}
  74.164  
  74.165 -lemma int_nat_number_of [simp]:
  74.166 -     "int (number_of v) =  
  74.167 -         (if neg (number_of v :: int) then 0  
  74.168 -          else (number_of v :: int))"
  74.169 -  unfolding nat_number_of_def number_of_is_id neg_def
  74.170 -  by simp (* FIXME: redundant with of_nat_number_of_eq *)
  74.171 +lemma int_numeral: "int (numeral v) = numeral v"
  74.172 +  by (rule of_nat_numeral) (* already simp *)
  74.173  
  74.174  lemma nonneg_int_cases:
  74.175    fixes k :: int assumes "0 \<le> k" obtains n where "k = of_nat n"
  74.176 @@ -368,149 +276,51 @@
  74.177  done
  74.178  
  74.179  lemma Suc_nat_number_of_add:
  74.180 -     "Suc (number_of v + n) =  
  74.181 -        (if neg (number_of v :: int) then 1+n else number_of (Int.succ v) + n)"
  74.182 -  unfolding nat_number_of_def number_of_is_id neg_def numeral_simps
  74.183 -  by (simp add: Suc_nat_eq_nat_zadd1 add_ac)
  74.184 -
  74.185 -lemma Suc_nat_number_of [simp]:
  74.186 -     "Suc (number_of v) =  
  74.187 -        (if neg (number_of v :: int) then 1 else number_of (Int.succ v))"
  74.188 -apply (cut_tac n = 0 in Suc_nat_number_of_add)
  74.189 -apply (simp cong del: if_weak_cong)
  74.190 -done
  74.191 -
  74.192 -
  74.193 -subsubsection{*Addition *}
  74.194 -
  74.195 -lemma add_nat_number_of [simp]:
  74.196 -     "(number_of v :: nat) + number_of v' =  
  74.197 -         (if v < Int.Pls then number_of v'  
  74.198 -          else if v' < Int.Pls then number_of v  
  74.199 -          else number_of (v + v'))"
  74.200 -  unfolding nat_number_of_def number_of_is_id numeral_simps
  74.201 -  by (simp add: nat_add_distrib)
  74.202 -
  74.203 -lemma nat_number_of_add_1 [simp]:
  74.204 -  "number_of v + (1::nat) =
  74.205 -    (if v < Int.Pls then 1 else number_of (Int.succ v))"
  74.206 -  unfolding nat_number_of_def number_of_is_id numeral_simps
  74.207 -  by (simp add: nat_add_distrib)
  74.208 +  "Suc (numeral v + n) = numeral (v + Num.One) + n"
  74.209 +  by simp
  74.210  
  74.211 -lemma nat_1_add_number_of [simp]:
  74.212 -  "(1::nat) + number_of v =
  74.213 -    (if v < Int.Pls then 1 else number_of (Int.succ v))"
  74.214 -  unfolding nat_number_of_def number_of_is_id numeral_simps
  74.215 -  by (simp add: nat_add_distrib)
  74.216 -
  74.217 -lemma nat_1_add_1 [simp]: "1 + 1 = (2::nat)"
  74.218 -  by (rule semiring_one_add_one_is_two)
  74.219 -
  74.220 -text {* TODO: replace simp rules above with these generic ones: *}
  74.221 -
  74.222 -lemma semiring_add_number_of:
  74.223 -  "\<lbrakk>Int.Pls \<le> v; Int.Pls \<le> v'\<rbrakk> \<Longrightarrow>
  74.224 -    (number_of v :: 'a::number_semiring) + number_of v' = number_of (v + v')"
  74.225 -  unfolding Int.Pls_def
  74.226 -  by (elim nonneg_int_cases,
  74.227 -    simp only: number_of_int of_nat_add [symmetric])
  74.228 -
  74.229 -lemma semiring_number_of_add_1:
  74.230 -  "Int.Pls \<le> v \<Longrightarrow>
  74.231 -    number_of v + (1::'a::number_semiring) = number_of (Int.succ v)"
  74.232 -  unfolding Int.Pls_def Int.succ_def
  74.233 -  by (elim nonneg_int_cases,
  74.234 -    simp only: number_of_int add_commute [where b=1] of_nat_Suc [symmetric])
  74.235 -
  74.236 -lemma semiring_1_add_number_of:
  74.237 -  "Int.Pls \<le> v \<Longrightarrow>
  74.238 -    (1::'a::number_semiring) + number_of v = number_of (Int.succ v)"
  74.239 -  unfolding Int.Pls_def Int.succ_def
  74.240 -  by (elim nonneg_int_cases,
  74.241 -    simp only: number_of_int add_commute [where b=1] of_nat_Suc [symmetric])
  74.242 +lemma Suc_numeral [simp]:
  74.243 +  "Suc (numeral v) = numeral (v + Num.One)"
  74.244 +  by simp
  74.245  
  74.246  
  74.247  subsubsection{*Subtraction *}
  74.248  
  74.249  lemma diff_nat_eq_if:
  74.250       "nat z - nat z' =  
  74.251 -        (if neg z' then nat z   
  74.252 +        (if z' < 0 then nat z   
  74.253           else let d = z-z' in     
  74.254 -              if neg d then 0 else nat d)"
  74.255 -by (simp add: Let_def nat_diff_distrib [symmetric] neg_eq_less_0 not_neg_eq_ge_0)
  74.256 -
  74.257 -
  74.258 -lemma diff_nat_number_of [simp]: 
  74.259 -     "(number_of v :: nat) - number_of v' =  
  74.260 -        (if v' < Int.Pls then number_of v  
  74.261 -         else let d = number_of (v + uminus v') in     
  74.262 -              if neg d then 0 else nat d)"
  74.263 -  unfolding nat_number_of_def number_of_is_id numeral_simps neg_def
  74.264 -  by auto
  74.265 +              if d < 0 then 0 else nat d)"
  74.266 +by (simp add: Let_def nat_diff_distrib [symmetric])
  74.267  
  74.268 -lemma nat_number_of_diff_1 [simp]:
  74.269 -  "number_of v - (1::nat) =
  74.270 -    (if v \<le> Int.Pls then 0 else number_of (Int.pred v))"
  74.271 -  unfolding nat_number_of_def number_of_is_id numeral_simps
  74.272 -  by auto
  74.273 -
  74.274 -
  74.275 -subsubsection{*Multiplication *}
  74.276 +(* Int.nat_diff_distrib has too-strong premises *)
  74.277 +lemma nat_diff_distrib': "\<lbrakk>0 \<le> x; 0 \<le> y\<rbrakk> \<Longrightarrow> nat (x - y) = nat x - nat y"
  74.278 +apply (rule int_int_eq [THEN iffD1], clarsimp)
  74.279 +apply (subst zdiff_int [symmetric])
  74.280 +apply (rule nat_mono, simp_all)
  74.281 +done
  74.282  
  74.283 -lemma mult_nat_number_of [simp]:
  74.284 -     "(number_of v :: nat) * number_of v' =  
  74.285 -       (if v < Int.Pls then 0 else number_of (v * v'))"
  74.286 -  unfolding nat_number_of_def number_of_is_id numeral_simps
  74.287 -  by (simp add: nat_mult_distrib)
  74.288 +lemma diff_nat_numeral [simp]: 
  74.289 +  "(numeral v :: nat) - numeral v' = nat (numeral v - numeral v')"
  74.290 +  by (simp only: nat_diff_distrib' zero_le_numeral nat_numeral)
  74.291  
  74.292 -(* TODO: replace mult_nat_number_of with this next rule *)
  74.293 -lemma semiring_mult_number_of:
  74.294 -  "\<lbrakk>Int.Pls \<le> v; Int.Pls \<le> v'\<rbrakk> \<Longrightarrow>
  74.295 -    (number_of v :: 'a::number_semiring) * number_of v' = number_of (v * v')"
  74.296 -  unfolding Int.Pls_def
  74.297 -  by (elim nonneg_int_cases,
  74.298 -    simp only: number_of_int of_nat_mult [symmetric])
  74.299 +lemma nat_numeral_diff_1 [simp]:
  74.300 +  "numeral v - (1::nat) = nat (numeral v - 1)"
  74.301 +  using diff_nat_numeral [of v Num.One] by simp
  74.302  
  74.303  
  74.304  subsection{*Comparisons*}
  74.305  
  74.306 -subsubsection{*Equals (=) *}
  74.307 -
  74.308 -lemma eq_nat_number_of [simp]:
  74.309 -     "((number_of v :: nat) = number_of v') =  
  74.310 -      (if neg (number_of v :: int) then (number_of v' :: int) \<le> 0
  74.311 -       else if neg (number_of v' :: int) then (number_of v :: int) = 0
  74.312 -       else v = v')"
  74.313 -  unfolding nat_number_of_def number_of_is_id neg_def
  74.314 -  by auto
  74.315 -
  74.316 -
  74.317 -subsubsection{*Less-than (<) *}
  74.318 -
  74.319 -lemma less_nat_number_of [simp]:
  74.320 -  "(number_of v :: nat) < number_of v' \<longleftrightarrow>
  74.321 -    (if v < v' then Int.Pls < v' else False)"
  74.322 -  unfolding nat_number_of_def number_of_is_id numeral_simps
  74.323 -  by auto
  74.324 -
  74.325 -
  74.326 -subsubsection{*Less-than-or-equal *}
  74.327 -
  74.328 -lemma le_nat_number_of [simp]:
  74.329 -  "(number_of v :: nat) \<le> number_of v' \<longleftrightarrow>
  74.330 -    (if v \<le> v' then True else v \<le> Int.Pls)"
  74.331 -  unfolding nat_number_of_def number_of_is_id numeral_simps
  74.332 -  by auto
  74.333 -
  74.334 -(*Maps #n to n for n = 0, 1, 2*)
  74.335 -lemmas numerals = nat_numeral_0_eq_0 nat_numeral_1_eq_1 numeral_2_eq_2
  74.336 +(*Maps #n to n for n = 1, 2*)
  74.337 +lemmas numerals = numeral_1_eq_1 [where 'a=nat] numeral_2_eq_2
  74.338  
  74.339  
  74.340  subsection{*Powers with Numeric Exponents*}
  74.341  
  74.342  text{*Squares of literal numerals will be evaluated.*}
  74.343 -lemmas power2_eq_square_number_of [simp] =
  74.344 -  power2_eq_square [of "number_of w"] for w
  74.345 +(* FIXME: replace with more general rules for powers of numerals *)
  74.346 +lemmas power2_eq_square_numeral [simp] =
  74.347 +    power2_eq_square [of "numeral w"] for w
  74.348  
  74.349  
  74.350  text{*Simprules for comparisons where common factors can be cancelled.*}
  74.351 @@ -528,8 +338,8 @@
  74.352  by simp
  74.353  
  74.354  (*Expresses a natural number constant as the Suc of another one.
  74.355 -  NOT suitable for rewriting because n recurs in the condition.*)
  74.356 -lemmas expand_Suc = Suc_pred' [of "number_of v"] for v
  74.357 +  NOT suitable for rewriting because n recurs on the right-hand side.*)
  74.358 +lemmas expand_Suc = Suc_pred' [of "numeral v", OF zero_less_numeral] for v
  74.359  
  74.360  subsubsection{*Arith *}
  74.361  
  74.362 @@ -539,7 +349,7 @@
  74.363  lemma Suc_eq_plus1_left: "Suc n = 1 + n"
  74.364    unfolding One_nat_def by simp
  74.365  
  74.366 -(* These two can be useful when m = number_of... *)
  74.367 +(* These two can be useful when m = numeral... *)
  74.368  
  74.369  lemma add_eq_if: "(m::nat) + n = (if m=0 then n else Suc ((m - 1) + n))"
  74.370    unfolding One_nat_def by (cases m) simp_all
  74.371 @@ -551,231 +361,108 @@
  74.372    unfolding One_nat_def by (cases m) simp_all
  74.373  
  74.374  
  74.375 -subsection{*Comparisons involving (0::nat) *}
  74.376 -
  74.377 -text{*Simplification already does @{term "n<0"}, @{term "n\<le>0"} and @{term "0\<le>n"}.*}
  74.378 -
  74.379 -lemma eq_number_of_0 [simp]:
  74.380 -  "number_of v = (0::nat) \<longleftrightarrow> v \<le> Int.Pls"
  74.381 -  unfolding nat_number_of_def number_of_is_id numeral_simps
  74.382 -  by auto
  74.383 -
  74.384 -lemma eq_0_number_of [simp]:
  74.385 -  "(0::nat) = number_of v \<longleftrightarrow> v \<le> Int.Pls"
  74.386 -by (rule trans [OF eq_sym_conv eq_number_of_0])
  74.387 -
  74.388 -lemma less_0_number_of [simp]:
  74.389 -   "(0::nat) < number_of v \<longleftrightarrow> Int.Pls < v"
  74.390 -  unfolding nat_number_of_def number_of_is_id numeral_simps
  74.391 -  by simp
  74.392 -
  74.393 -lemma neg_imp_number_of_eq_0: "neg (number_of v :: int) ==> number_of v = (0::nat)"
  74.394 -  by (simp del: semiring_numeral_0_eq_0 add: nat_numeral_0_eq_0 [symmetric])
  74.395 -
  74.396 -
  74.397  subsection{*Comparisons involving  @{term Suc} *}
  74.398  
  74.399 -lemma eq_number_of_Suc [simp]:
  74.400 -     "(number_of v = Suc n) =  
  74.401 -        (let pv = number_of (Int.pred v) in  
  74.402 -         if neg pv then False else nat pv = n)"
  74.403 -apply (simp only: simp_thms Let_def neg_eq_less_0 linorder_not_less 
  74.404 -                  number_of_pred nat_number_of_def 
  74.405 -            split add: split_if)
  74.406 -apply (rule_tac x = "number_of v" in spec)
  74.407 -apply (auto simp add: nat_eq_iff)
  74.408 -done
  74.409 +lemma eq_numeral_Suc [simp]: "numeral v = Suc n \<longleftrightarrow> nat (numeral v - 1) = n"
  74.410 +  by (subst expand_Suc, simp only: nat.inject nat_numeral_diff_1)
  74.411  
  74.412 -lemma Suc_eq_number_of [simp]:
  74.413 -     "(Suc n = number_of v) =  
  74.414 -        (let pv = number_of (Int.pred v) in  
  74.415 -         if neg pv then False else nat pv = n)"
  74.416 -by (rule trans [OF eq_sym_conv eq_number_of_Suc])
  74.417 +lemma Suc_eq_numeral [simp]: "Suc n = numeral v \<longleftrightarrow> n = nat (numeral v - 1)"
  74.418 +  by (subst expand_Suc, simp only: nat.inject nat_numeral_diff_1)
  74.419  
  74.420 -lemma less_number_of_Suc [simp]:
  74.421 -     "(number_of v < Suc n) =  
  74.422 -        (let pv = number_of (Int.pred v) in  
  74.423 -         if neg pv then True else nat pv < n)"
  74.424 -apply (simp only: simp_thms Let_def neg_eq_less_0 linorder_not_less 
  74.425 -                  number_of_pred nat_number_of_def  
  74.426 -            split add: split_if)
  74.427 -apply (rule_tac x = "number_of v" in spec)
  74.428 -apply (auto simp add: nat_less_iff)
  74.429 -done
  74.430 +lemma less_numeral_Suc [simp]: "numeral v < Suc n \<longleftrightarrow> nat (numeral v - 1) < n"
  74.431 +  by (subst expand_Suc, simp only: Suc_less_eq nat_numeral_diff_1)
  74.432  
  74.433 -lemma less_Suc_number_of [simp]:
  74.434 -     "(Suc n < number_of v) =  
  74.435 -        (let pv = number_of (Int.pred v) in  
  74.436 -         if neg pv then False else n < nat pv)"
  74.437 -apply (simp only: simp_thms Let_def neg_eq_less_0 linorder_not_less 
  74.438 -                  number_of_pred nat_number_of_def
  74.439 -            split add: split_if)
  74.440 -apply (rule_tac x = "number_of v" in spec)
  74.441 -apply (auto simp add: zless_nat_eq_int_zless)
  74.442 -done
  74.443 +lemma less_Suc_numeral [simp]: "Suc n < numeral v \<longleftrightarrow> n < nat (numeral v - 1)"
  74.444 +  by (subst expand_Suc, simp only: Suc_less_eq nat_numeral_diff_1)
  74.445  
  74.446 -lemma le_number_of_Suc [simp]:
  74.447 -     "(number_of v <= Suc n) =  
  74.448 -        (let pv = number_of (Int.pred v) in  
  74.449 -         if neg pv then True else nat pv <= n)"
  74.450 -by (simp add: Let_def linorder_not_less [symmetric])
  74.451 +lemma le_numeral_Suc [simp]: "numeral v \<le> Suc n \<longleftrightarrow> nat (numeral v - 1) \<le> n"
  74.452 +  by (subst expand_Suc, simp only: Suc_le_mono nat_numeral_diff_1)
  74.453  
  74.454 -lemma le_Suc_number_of [simp]:
  74.455 -     "(Suc n <= number_of v) =  
  74.456 -        (let pv = number_of (Int.pred v) in  
  74.457 -         if neg pv then False else n <= nat pv)"
  74.458 -by (simp add: Let_def linorder_not_less [symmetric])
  74.459 -
  74.460 -
  74.461 -lemma eq_number_of_Pls_Min: "(Numeral0 ::int) ~= number_of Int.Min"
  74.462 -by auto
  74.463 -
  74.464 +lemma le_Suc_numeral [simp]: "Suc n \<le> numeral v \<longleftrightarrow> n \<le> nat (numeral v - 1)"
  74.465 +  by (subst expand_Suc, simp only: Suc_le_mono nat_numeral_diff_1)
  74.466  
  74.467  
  74.468  subsection{*Max and Min Combined with @{term Suc} *}
  74.469  
  74.470 -lemma max_number_of_Suc [simp]:
  74.471 -     "max (Suc n) (number_of v) =  
  74.472 -        (let pv = number_of (Int.pred v) in  
  74.473 -         if neg pv then Suc n else Suc(max n (nat pv)))"
  74.474 -apply (simp only: Let_def neg_eq_less_0 number_of_pred nat_number_of_def 
  74.475 -            split add: split_if nat.split)
  74.476 -apply (rule_tac x = "number_of v" in spec) 
  74.477 -apply auto
  74.478 -done
  74.479 - 
  74.480 -lemma max_Suc_number_of [simp]:
  74.481 -     "max (number_of v) (Suc n) =  
  74.482 -        (let pv = number_of (Int.pred v) in  
  74.483 -         if neg pv then Suc n else Suc(max (nat pv) n))"
  74.484 -apply (simp only: Let_def neg_eq_less_0 number_of_pred nat_number_of_def 
  74.485 -            split add: split_if nat.split)
  74.486 -apply (rule_tac x = "number_of v" in spec) 
  74.487 -apply auto
  74.488 -done
  74.489 - 
  74.490 -lemma min_number_of_Suc [simp]:
  74.491 -     "min (Suc n) (number_of v) =  
  74.492 -        (let pv = number_of (Int.pred v) in  
  74.493 -         if neg pv then 0 else Suc(min n (nat pv)))"
  74.494 -apply (simp only: Let_def neg_eq_less_0 number_of_pred nat_number_of_def 
  74.495 -            split add: split_if nat.split)
  74.496 -apply (rule_tac x = "number_of v" in spec) 
  74.497 -apply auto
  74.498 -done
  74.499 - 
  74.500 -lemma min_Suc_number_of [simp]:
  74.501 -     "min (number_of v) (Suc n) =  
  74.502 -        (let pv = number_of (Int.pred v) in  
  74.503 -         if neg pv then 0 else Suc(min (nat pv) n))"
  74.504 -apply (simp only: Let_def neg_eq_less_0 number_of_pred nat_number_of_def 
  74.505 -            split add: split_if nat.split)
  74.506 -apply (rule_tac x = "number_of v" in spec) 
  74.507 -apply auto
  74.508 -done
  74.509 +lemma max_Suc_numeral [simp]:
  74.510 +  "max (Suc n) (numeral v) = Suc (max n (nat (numeral v - 1)))"
  74.511 +  by (subst expand_Suc, simp only: max_Suc_Suc nat_numeral_diff_1)
  74.512 +
  74.513 +lemma max_numeral_Suc [simp]:
  74.514 +  "max (numeral v) (Suc n) = Suc (max (nat (numeral v - 1)) n)"
  74.515 +  by (subst expand_Suc, simp only: max_Suc_Suc nat_numeral_diff_1)
  74.516 +
  74.517 +lemma min_Suc_numeral [simp]:
  74.518 +  "min (Suc n) (numeral v) = Suc (min n (nat (numeral v - 1)))"
  74.519 +  by (subst expand_Suc, simp only: min_Suc_Suc nat_numeral_diff_1)
  74.520 +
  74.521 +lemma min_numeral_Suc [simp]:
  74.522 +  "min (numeral v) (Suc n) = Suc (min (nat (numeral v - 1)) n)"
  74.523 +  by (subst expand_Suc, simp only: min_Suc_Suc nat_numeral_diff_1)
  74.524   
  74.525  subsection{*Literal arithmetic involving powers*}
  74.526  
  74.527 -lemma power_nat_number_of:
  74.528 -     "(number_of v :: nat) ^ n =  
  74.529 -       (if neg (number_of v :: int) then 0^n else nat ((number_of v :: int) ^ n))"
  74.530 -by (simp only: simp_thms neg_nat not_neg_eq_ge_0 nat_number_of_def nat_power_eq
  74.531 -         split add: split_if cong: imp_cong)
  74.532 +(* TODO: replace with more generic rule for powers of numerals *)
  74.533 +lemma power_nat_numeral:
  74.534 +  "(numeral v :: nat) ^ n = nat ((numeral v :: int) ^ n)"
  74.535 +  by (simp only: nat_power_eq zero_le_numeral nat_numeral)
  74.536  
  74.537 -
  74.538 -lemmas power_nat_number_of_number_of = power_nat_number_of [of _ "number_of w"] for w
  74.539 -declare power_nat_number_of_number_of [simp]
  74.540 -
  74.541 +lemmas power_nat_numeral_numeral = power_nat_numeral [of _ "numeral w"] for w
  74.542 +declare power_nat_numeral_numeral [simp]
  74.543  
  74.544  
  74.545  text{*For arbitrary rings*}
  74.546  
  74.547 -lemma power_number_of_even:
  74.548 +lemma power_numeral_even:
  74.549    fixes z :: "'a::monoid_mult"
  74.550 -  shows "z ^ number_of (Int.Bit0 w) = (let w = z ^ (number_of w) in w * w)"
  74.551 -by (cases "w \<ge> 0") (auto simp add: Let_def Bit0_def nat_number_of_def number_of_is_id
  74.552 -  nat_add_distrib power_add simp del: nat_number_of)
  74.553 +  shows "z ^ numeral (Num.Bit0 w) = (let w = z ^ (numeral w) in w * w)"
  74.554 +  unfolding numeral_Bit0 power_add Let_def ..
  74.555  
  74.556 -lemma power_number_of_odd:
  74.557 +lemma power_numeral_odd:
  74.558    fixes z :: "'a::monoid_mult"
  74.559 -  shows "z ^ number_of (Int.Bit1 w) = (if (0::int) <= number_of w
  74.560 -     then (let w = z ^ (number_of w) in z * w * w) else 1)"
  74.561 -unfolding Let_def Bit1_def nat_number_of_def number_of_is_id
  74.562 -apply (cases "0 <= w")
  74.563 -apply (simp only: mult_assoc nat_add_distrib power_add, simp)
  74.564 -apply (simp add: not_le mult_2 [symmetric] add_assoc)
  74.565 -done
  74.566 +  shows "z ^ numeral (Num.Bit1 w) = (let w = z ^ (numeral w) in z * w * w)"
  74.567 +  unfolding numeral_Bit1 One_nat_def add_Suc_right add_0_right
  74.568 +  unfolding power_Suc power_add Let_def mult_assoc ..
  74.569  
  74.570 -lemmas zpower_number_of_even = power_number_of_even [where 'a=int]
  74.571 -lemmas zpower_number_of_odd = power_number_of_odd [where 'a=int]
  74.572 -
  74.573 -lemmas power_number_of_even_number_of [simp] =
  74.574 -    power_number_of_even [of "number_of v"] for v
  74.575 +lemmas zpower_numeral_even = power_numeral_even [where 'a=int]
  74.576 +lemmas zpower_numeral_odd = power_numeral_odd [where 'a=int]
  74.577  
  74.578 -lemmas power_number_of_odd_number_of [simp] =
  74.579 -    power_number_of_odd [of "number_of v"] for v
  74.580 +lemmas power_numeral_even_numeral [simp] =
  74.581 +    power_numeral_even [of "numeral v"] for v
  74.582  
  74.583 -lemma nat_number_of_Pls: "Numeral0 = (0::nat)"
  74.584 -  by (simp add: nat_number_of_def)
  74.585 -
  74.586 -lemma nat_number_of_Min [no_atp]: "number_of Int.Min = (0::nat)"
  74.587 -  apply (simp only: number_of_Min nat_number_of_def nat_zminus_int)
  74.588 -  done
  74.589 +lemmas power_numeral_odd_numeral [simp] =
  74.590 +    power_numeral_odd [of "numeral v"] for v
  74.591  
  74.592 -lemma nat_number_of_Bit0:
  74.593 -    "number_of (Int.Bit0 w) = (let n::nat = number_of w in n + n)"
  74.594 -by (cases "w \<ge> 0") (auto simp add: Let_def Bit0_def nat_number_of_def number_of_is_id
  74.595 -  nat_add_distrib simp del: nat_number_of)
  74.596 +lemma nat_numeral_Bit0:
  74.597 +  "numeral (Num.Bit0 w) = (let n::nat = numeral w in n + n)"
  74.598 +  unfolding numeral_Bit0 Let_def ..
  74.599  
  74.600 -lemma nat_number_of_Bit1:
  74.601 -  "number_of (Int.Bit1 w) =
  74.602 -    (if neg (number_of w :: int) then 0
  74.603 -     else let n = number_of w in Suc (n + n))"
  74.604 -unfolding Let_def Bit1_def nat_number_of_def number_of_is_id neg_def
  74.605 -apply (cases "w < 0")
  74.606 -apply (simp add: mult_2 [symmetric] add_assoc)
  74.607 -apply (simp only: nat_add_distrib, simp)
  74.608 -done
  74.609 +lemma nat_numeral_Bit1:
  74.610 +  "numeral (Num.Bit1 w) = (let n = numeral w in Suc (n + n))"
  74.611 +  unfolding numeral_Bit1 Let_def by simp
  74.612  
  74.613  lemmas eval_nat_numeral =
  74.614 -  nat_number_of_Bit0 nat_number_of_Bit1
  74.615 +  nat_numeral_Bit0 nat_numeral_Bit1
  74.616  
  74.617  lemmas nat_arith =
  74.618 -  add_nat_number_of
  74.619 -  diff_nat_number_of
  74.620 -  mult_nat_number_of
  74.621 -  eq_nat_number_of
  74.622 -  less_nat_number_of
  74.623 +  diff_nat_numeral
  74.624  
  74.625  lemmas semiring_norm =
  74.626 -  Let_def arith_simps nat_arith rel_simps neg_simps if_False
  74.627 -  if_True add_0 add_Suc add_number_of_left mult_number_of_left
  74.628 +  Let_def arith_simps nat_arith rel_simps
  74.629 +  if_False if_True
  74.630 +  add_0 add_Suc add_numeral_left
  74.631 +  add_neg_numeral_left mult_numeral_left
  74.632    numeral_1_eq_1 [symmetric] Suc_eq_plus1
  74.633 -  numeral_0_eq_0 [symmetric] numerals [symmetric]
  74.634 -  not_iszero_Numeral1
  74.635 +  eq_numeral_iff_iszero not_iszero_Numeral1
  74.636  
  74.637  lemma Let_Suc [simp]: "Let (Suc n) f == f (Suc n)"
  74.638    by (fact Let_def)
  74.639  
  74.640 -lemma power_m1_even: "(-1) ^ (2*n) = (1::'a::{number_ring})"
  74.641 -  by (simp only: number_of_Min power_minus1_even)
  74.642 -
  74.643 -lemma power_m1_odd: "(-1) ^ Suc(2*n) = (-1::'a::{number_ring})"
  74.644 -  by (simp only: number_of_Min power_minus1_odd)
  74.645 +lemma power_m1_even: "(-1) ^ (2*n) = (1::'a::ring_1)"
  74.646 +  by (fact power_minus1_even) (* FIXME: duplicate *)
  74.647  
  74.648 -lemma nat_number_of_add_left:
  74.649 -     "number_of v + (number_of v' + (k::nat)) =  
  74.650 -         (if neg (number_of v :: int) then number_of v' + k  
  74.651 -          else if neg (number_of v' :: int) then number_of v + k  
  74.652 -          else number_of (v + v') + k)"
  74.653 -by (auto simp add: neg_def)
  74.654 -
  74.655 -lemma nat_number_of_mult_left:
  74.656 -     "number_of v * (number_of v' * (k::nat)) =  
  74.657 -         (if v < Int.Pls then 0
  74.658 -          else number_of (v * v') * k)"
  74.659 -by (auto simp add: not_less Pls_def nat_number_of_def number_of_is_id
  74.660 -  nat_mult_distrib simp del: nat_number_of)
  74.661 +lemma power_m1_odd: "(-1) ^ Suc(2*n) = (-1::'a::ring_1)"
  74.662 +  by (fact power_minus1_odd) (* FIXME: duplicate *)
  74.663  
  74.664  
  74.665  subsection{*Literal arithmetic and @{term of_nat}*}
  74.666 @@ -784,52 +471,18 @@
  74.667       "0 \<le> x ==> of_nat (nat (2 * x)) = of_nat (nat x) + of_nat (nat x)"
  74.668  by (simp only: mult_2 nat_add_distrib of_nat_add) 
  74.669  
  74.670 -lemma nat_numeral_m1_eq_0: "-1 = (0::nat)"
  74.671 -by (simp only: nat_number_of_def)
  74.672 -
  74.673 -lemma of_nat_number_of_lemma:
  74.674 -     "of_nat (number_of v :: nat) =  
  74.675 -         (if 0 \<le> (number_of v :: int) 
  74.676 -          then (number_of v :: 'a :: number_semiring)
  74.677 -          else 0)"
  74.678 -  by (auto simp add: int_number_of_def nat_number_of_def number_of_int
  74.679 -    elim!: nonneg_int_cases)
  74.680 -
  74.681 -lemma of_nat_number_of_eq [simp]:
  74.682 -     "of_nat (number_of v :: nat) =  
  74.683 -         (if neg (number_of v :: int) then 0  
  74.684 -          else (number_of v :: 'a :: number_semiring))"
  74.685 -  by (simp only: of_nat_number_of_lemma neg_def, simp)
  74.686 -
  74.687  
  74.688  subsubsection{*For simplifying @{term "Suc m - K"} and  @{term "K - Suc m"}*}
  74.689  
  74.690  text{*Where K above is a literal*}
  74.691  
  74.692 -lemma Suc_diff_eq_diff_pred: "Numeral0 < n ==> Suc m - n = m - (n - Numeral1)"
  74.693 +lemma Suc_diff_eq_diff_pred: "0 < n ==> Suc m - n = m - (n - Numeral1)"
  74.694  by (simp split: nat_diff_split)
  74.695  
  74.696 -text {*Now just instantiating @{text n} to @{text "number_of v"} does
  74.697 -  the right simplification, but with some redundant inequality
  74.698 -  tests.*}
  74.699 -lemma neg_number_of_pred_iff_0:
  74.700 -  "neg (number_of (Int.pred v)::int) = (number_of v = (0::nat))"
  74.701 -apply (subgoal_tac "neg (number_of (Int.pred v)) = (number_of v < Suc 0) ")
  74.702 -apply (simp only: less_Suc_eq_le le_0_eq)
  74.703 -apply (subst less_number_of_Suc, simp)
  74.704 -done
  74.705 -
  74.706  text{*No longer required as a simprule because of the @{text inverse_fold}
  74.707     simproc*}
  74.708 -lemma Suc_diff_number_of:
  74.709 -     "Int.Pls < v ==>
  74.710 -      Suc m - (number_of v) = m - (number_of (Int.pred v))"
  74.711 -apply (subst Suc_diff_eq_diff_pred)
  74.712 -apply simp
  74.713 -apply (simp del: semiring_numeral_1_eq_1)
  74.714 -apply (auto simp only: diff_nat_number_of less_0_number_of [symmetric]
  74.715 -                        neg_number_of_pred_iff_0)
  74.716 -done
  74.717 +lemma Suc_diff_numeral: "Suc m - (numeral v) = m - (numeral v - 1)"
  74.718 +  by (subst expand_Suc, simp only: diff_Suc_Suc)
  74.719  
  74.720  lemma diff_Suc_eq_diff_pred: "m - Suc n = (m - 1) - n"
  74.721  by (simp split: nat_diff_split)
  74.722 @@ -837,45 +490,22 @@
  74.723  
  74.724  subsubsection{*For @{term nat_case} and @{term nat_rec}*}
  74.725  
  74.726 -lemma nat_case_number_of [simp]:
  74.727 -     "nat_case a f (number_of v) =
  74.728 -        (let pv = number_of (Int.pred v) in
  74.729 -         if neg pv then a else f (nat pv))"
  74.730 -by (simp split add: nat.split add: Let_def neg_number_of_pred_iff_0)
  74.731 +lemma nat_case_numeral [simp]:
  74.732 +  "nat_case a f (numeral v) = (let pv = nat (numeral v - 1) in f pv)"
  74.733 +  by (subst expand_Suc, simp only: nat.cases nat_numeral_diff_1 Let_def)
  74.734  
  74.735  lemma nat_case_add_eq_if [simp]:
  74.736 -     "nat_case a f ((number_of v) + n) =
  74.737 -       (let pv = number_of (Int.pred v) in
  74.738 -         if neg pv then nat_case a f n else f (nat pv + n))"
  74.739 -apply (subst add_eq_if)
  74.740 -apply (simp split add: nat.split
  74.741 -            del: semiring_numeral_1_eq_1
  74.742 -            add: semiring_numeral_1_eq_1 [symmetric]
  74.743 -                 numeral_1_eq_Suc_0 [symmetric]
  74.744 -                 neg_number_of_pred_iff_0)
  74.745 -done
  74.746 +  "nat_case a f ((numeral v) + n) = (let pv = nat (numeral v - 1) in f (pv + n))"
  74.747 +  by (subst expand_Suc, simp only: nat.cases nat_numeral_diff_1 Let_def add_Suc)
  74.748  
  74.749 -lemma nat_rec_number_of [simp]:
  74.750 -     "nat_rec a f (number_of v) =
  74.751 -        (let pv = number_of (Int.pred v) in
  74.752 -         if neg pv then a else f (nat pv) (nat_rec a f (nat pv)))"
  74.753 -apply (case_tac " (number_of v) ::nat")
  74.754 -apply (simp_all (no_asm_simp) add: Let_def neg_number_of_pred_iff_0)
  74.755 -apply (simp split add: split_if_asm)
  74.756 -done
  74.757 +lemma nat_rec_numeral [simp]:
  74.758 +  "nat_rec a f (numeral v) = (let pv = nat (numeral v - 1) in f pv (nat_rec a f pv))"
  74.759 +  by (subst expand_Suc, simp only: nat_rec_Suc nat_numeral_diff_1 Let_def)
  74.760  
  74.761  lemma nat_rec_add_eq_if [simp]:
  74.762 -     "nat_rec a f (number_of v + n) =
  74.763 -        (let pv = number_of (Int.pred v) in
  74.764 -         if neg pv then nat_rec a f n
  74.765 -                   else f (nat pv + n) (nat_rec a f (nat pv + n)))"
  74.766 -apply (subst add_eq_if)
  74.767 -apply (simp split add: nat.split
  74.768 -            del: semiring_numeral_1_eq_1
  74.769 -            add: semiring_numeral_1_eq_1 [symmetric]
  74.770 -                 numeral_1_eq_Suc_0 [symmetric]
  74.771 -                 neg_number_of_pred_iff_0)
  74.772 -done
  74.773 +  "nat_rec a f (numeral v + n) =
  74.774 +    (let pv = nat (numeral v - 1) in f (pv + n) (nat_rec a f (pv + n)))"
  74.775 +  by (subst expand_Suc, simp only: nat_rec_Suc nat_numeral_diff_1 Let_def add_Suc)
  74.776  
  74.777  
  74.778  subsubsection{*Various Other Lemmas*}
  74.779 @@ -887,14 +517,14 @@
  74.780  
  74.781  text{*Lemmas for specialist use, NOT as default simprules*}
  74.782  lemma nat_mult_2: "2 * z = (z+z::nat)"
  74.783 -by (rule semiring_mult_2)
  74.784 +by (rule mult_2) (* FIXME: duplicate *)
  74.785  
  74.786  lemma nat_mult_2_right: "z * 2 = (z+z::nat)"
  74.787 -by (rule semiring_mult_2_right)
  74.788 +by (rule mult_2_right) (* FIXME: duplicate *)
  74.789  
  74.790  text{*Case analysis on @{term "n<2"}*}
  74.791  lemma less_2_cases: "(n::nat) < 2 ==> n = 0 | n = Suc 0"
  74.792 -by (auto simp add: nat_1_add_1 [symmetric])
  74.793 +by (auto simp add: numeral_2_eq_2)
  74.794  
  74.795  text{*Removal of Small Numerals: 0, 1 and (in additive positions) 2*}
  74.796  
  74.797 @@ -908,4 +538,8 @@
  74.798  lemma Suc3_eq_add_3: "Suc (Suc (Suc n)) = 3 + n"
  74.799  by simp
  74.800  
  74.801 +text{*Legacy theorems*}
  74.802 +
  74.803 +lemmas nat_1_add_1 = one_add_one [where 'a=nat]
  74.804 +
  74.805  end
    76.1 --- a/src/HOL/Nitpick_Examples/Manual_Nits.thy	Fri Mar 23 20:32:43 2012 +0100
    76.2 +++ b/src/HOL/Nitpick_Examples/Manual_Nits.thy	Mon Mar 26 10:56:56 2012 +0200
    76.3 @@ -115,6 +115,7 @@
    76.4  "add_raw \<equiv> \<lambda>(x, y) (u, v). (x + (u\<Colon>nat), y + (v\<Colon>nat))"
    76.5  
    76.6  quotient_definition "add\<Colon>my_int \<Rightarrow> my_int \<Rightarrow> my_int" is add_raw
    76.7 +unfolding add_raw_def by auto
    76.8  
    76.9  lemma "add x y = add x x"
   76.10  nitpick [show_datatypes, expect = genuine]
    77.1 --- a/src/HOL/Nominal/Nominal.thy	Fri Mar 23 20:32:43 2012 +0100
    77.2 +++ b/src/HOL/Nominal/Nominal.thy	Mon Mar 26 10:56:56 2012 +0200
    77.3 @@ -3481,7 +3481,7 @@
    77.4  by (auto simp add: perm_nat_def)
    77.5  
    77.6  lemma numeral_nat_eqvt: 
    77.7 - shows "pi\<bullet>((number_of n)::nat) = number_of n" 
    77.8 + shows "pi\<bullet>((numeral n)::nat) = numeral n" 
    77.9  by (simp add: perm_nat_def perm_int_def)
   77.10  
   77.11  lemma max_nat_eqvt:
   77.12 @@ -3523,7 +3523,11 @@
   77.13  by (simp add: perm_int_def)
   77.14  
   77.15  lemma numeral_int_eqvt: 
   77.16 - shows "pi\<bullet>((number_of n)::int) = number_of n" 
   77.17 + shows "pi\<bullet>((numeral n)::int) = numeral n" 
   77.18 +by (simp add: perm_int_def perm_int_def)
   77.19 +
   77.20 +lemma neg_numeral_int_eqvt:
   77.21 + shows "pi\<bullet>((neg_numeral n)::int) = neg_numeral n"
   77.22  by (simp add: perm_int_def perm_int_def)
   77.23  
   77.24  lemma max_int_eqvt:
   77.25 @@ -3589,7 +3593,7 @@
   77.26  (* the lemmas numeral_nat_eqvt numeral_int_eqvt do not conform with the *)
   77.27  (* usual form of an eqvt-lemma, but they are needed for analysing       *)
   77.28  (* permutations on nats and ints *)
   77.29 -lemmas [eqvt_force] = numeral_nat_eqvt numeral_int_eqvt
   77.30 +lemmas [eqvt_force] = numeral_nat_eqvt numeral_int_eqvt neg_numeral_int_eqvt
   77.31  
   77.32  (***************************************)
   77.33  (* setup for the individial atom-kinds *)
    78.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    78.2 +++ b/src/HOL/Num.thy	Mon Mar 26 10:56:56 2012 +0200
    78.3 @@ -0,0 +1,1021 @@
    78.4 +(*  Title:      HOL/Num.thy
    78.5 +    Author:     Florian Haftmann
    78.6 +    Author:     Brian Huffman
    78.7 +*)
    78.8 +
    78.9 +header {* Binary Numerals *}
   78.10 +
   78.11 +theory Num
   78.12 +imports Datatype Power
   78.13 +begin
   78.14 +
   78.15 +subsection {* The @{text num} type *}
   78.16 +
   78.17 +datatype num = One | Bit0 num | Bit1 num
   78.18 +
   78.19 +text {* Increment function for type @{typ num} *}
   78.20 +
   78.21 +primrec inc :: "num \<Rightarrow> num" where
   78.22 +  "inc One = Bit0 One" |
   78.23 +  "inc (Bit0 x) = Bit1 x" |
   78.24 +  "inc (Bit1 x) = Bit0 (inc x)"
   78.25 +
   78.26 +text {* Converting between type @{typ num} and type @{typ nat} *}
   78.27 +
   78.28 +primrec nat_of_num :: "num \<Rightarrow> nat" where
   78.29 +  "nat_of_num One = Suc 0" |
   78.30 +  "nat_of_num (Bit0 x) = nat_of_num x + nat_of_num x" |
   78.31 +  "nat_of_num (Bit1 x) = Suc (nat_of_num x + nat_of_num x)"
   78.32 +
   78.33 +primrec num_of_nat :: "nat \<Rightarrow> num" where
   78.34 +  "num_of_nat 0 = One" |
   78.35 +  "num_of_nat (Suc n) = (if 0 < n then inc (num_of_nat n) else One)"
   78.36 +
   78.37 +lemma nat_of_num_pos: "0 < nat_of_num x"
   78.38 +  by (induct x) simp_all
   78.39 +
   78.40 +lemma nat_of_num_neq_0: " nat_of_num x \<noteq> 0"
   78.41 +  by (induct x) simp_all
   78.42 +
   78.43 +lemma nat_of_num_inc: "nat_of_num (inc x) = Suc (nat_of_num x)"
   78.44 +  by (induct x) simp_all
   78.45 +
   78.46 +lemma num_of_nat_double:
   78.47 +  "0 < n \<Longrightarrow> num_of_nat (n + n) = Bit0 (num_of_nat n)"
   78.48 +  by (induct n) simp_all
   78.49 +
   78.50 +text {*
   78.51 +  Type @{typ num} is isomorphic to the strictly positive
   78.52 +  natural numbers.
   78.53 +*}
   78.54 +
   78.55 +lemma nat_of_num_inverse: "num_of_nat (nat_of_num x) = x"
   78.56 +  by (induct x) (simp_all add: num_of_nat_double nat_of_num_pos)
   78.57 +
   78.58 +lemma num_of_nat_inverse: "0 < n \<Longrightarrow> nat_of_num (num_of_nat n) = n"
   78.59 +  by (induct n) (simp_all add: nat_of_num_inc)
   78.60 +
   78.61 +lemma num_eq_iff: "x = y \<longleftrightarrow> nat_of_num x = nat_of_num y"
   78.62 +  apply safe
   78.63 +  apply (drule arg_cong [where f=num_of_nat])
   78.64 +  apply (simp add: nat_of_num_inverse)
   78.65 +  done
   78.66 +
   78.67 +lemma num_induct [case_names One inc]:
   78.68 +  fixes P :: "num \<Rightarrow> bool"
   78.69 +  assumes One: "P One"
   78.70 +    and inc: "\<And>x. P x \<Longrightarrow> P (inc x)"
   78.71 +  shows "P x"
   78.72 +proof -
   78.73 +  obtain n where n: "Suc n = nat_of_num x"
   78.74 +    by (cases "nat_of_num x", simp_all add: nat_of_num_neq_0)
   78.75 +  have "P (num_of_nat (Suc n))"
   78.76 +  proof (induct n)
   78.77 +    case 0 show ?case using One by simp
   78.78 +  next
   78.79 +    case (Suc n)
   78.80 +    then have "P (inc (num_of_nat (Suc n)))" by (rule inc)
   78.81 +    then show "P (num_of_nat (Suc (Suc n)))" by simp
   78.82 +  qed
   78.83 +  with n show "P x"
   78.84 +    by (simp add: nat_of_num_inverse)
   78.85 +qed
   78.86 +
   78.87 +text {*
   78.88 +  From now on, there are two possible models for @{typ num}:
   78.89 +  as positive naturals (rule @{text "num_induct"})
   78.90 +  and as digit representation (rules @{text "num.induct"}, @{text "num.cases"}).
   78.91 +*}
   78.92 +
   78.93 +
   78.94 +subsection {* Numeral operations *}
   78.95 +
   78.96 +instantiation num :: "{plus,times,linorder}"
   78.97 +begin
   78.98 +
   78.99 +definition [code del]:
  78.100 +  "m + n = num_of_nat (nat_of_num m + nat_of_num n)"
  78.101 +
  78.102 +definition [code del]:
  78.103 +  "m * n = num_of_nat (nat_of_num m * nat_of_num n)"
  78.104 +
  78.105 +definition [code del]:
  78.106 +  "m \<le> n \<longleftrightarrow> nat_of_num m \<le> nat_of_num n"
  78.107 +
  78.108 +definition [code del]:
  78.109 +  "m < n \<longleftrightarrow> nat_of_num m < nat_of_num n"
  78.110 +
  78.111 +instance
  78.112 +  by (default, auto simp add: less_num_def less_eq_num_def num_eq_iff)
  78.113 +
  78.114 +end
  78.115 +
  78.116 +lemma nat_of_num_add: "nat_of_num (x + y) = nat_of_num x + nat_of_num y"
  78.117 +  unfolding plus_num_def
  78.118 +  by (intro num_of_nat_inverse add_pos_pos nat_of_num_pos)
  78.119 +
  78.120 +lemma nat_of_num_mult: "nat_of_num (x * y) = nat_of_num x * nat_of_num y"
  78.121 +  unfolding times_num_def
  78.122 +  by (intro num_of_nat_inverse mult_pos_pos nat_of_num_pos)
  78.123 +
  78.124 +lemma add_num_simps [simp, code]:
  78.125 +  "One + One = Bit0 One"
  78.126 +  "One + Bit0 n = Bit1 n"
  78.127 +  "One + Bit1 n = Bit0 (n + One)"
  78.128 +  "Bit0 m + One = Bit1 m"
  78.129 +  "Bit0 m + Bit0 n = Bit0 (m + n)"
  78.130 +  "Bit0 m + Bit1 n = Bit1 (m + n)"
  78.131 +  "Bit1 m + One = Bit0 (m + One)"
  78.132 +  "Bit1 m + Bit0 n = Bit1 (m + n)"
  78.133 +  "Bit1 m + Bit1 n = Bit0 (m + n + One)"
  78.134 +  by (simp_all add: num_eq_iff nat_of_num_add)
  78.135 +
  78.136 +lemma mult_num_simps [simp, code]:
  78.137 +  "m * One = m"
  78.138 +  "One * n = n"
  78.139 +  "Bit0 m * Bit0 n = Bit0 (Bit0 (m * n))"
  78.140 +  "Bit0 m * Bit1 n = Bit0 (m * Bit1 n)"
  78.141 +  "Bit1 m * Bit0 n = Bit0 (Bit1 m * n)"
  78.142 +  "Bit1 m * Bit1 n = Bit1 (m + n + Bit0 (m * n))"
  78.143 +  by (simp_all add: num_eq_iff nat_of_num_add
  78.144 +    nat_of_num_mult left_distrib right_distrib)
  78.145 +
  78.146 +lemma eq_num_simps:
  78.147 +  "One = One \<longleftrightarrow> True"
  78.148 +  "One = Bit0 n \<longleftrightarrow> False"
  78.149 +  "One = Bit1 n \<longleftrightarrow> False"
  78.150 +  "Bit0 m = One \<longleftrightarrow> False"
  78.151 +  "Bit1 m = One \<longleftrightarrow> False"
  78.152 +  "Bit0 m = Bit0 n \<longleftrightarrow> m = n"
  78.153 +  "Bit0 m = Bit1 n \<longleftrightarrow> False"
  78.154 +  "Bit1 m = Bit0 n \<longleftrightarrow> False"
  78.155 +  "Bit1 m = Bit1 n \<longleftrightarrow> m = n"
  78.156 +  by simp_all
  78.157 +
  78.158 +lemma le_num_simps [simp, code]:
  78.159 +  "One \<le> n \<longleftrightarrow> True"
  78.160 +  "Bit0 m \<le> One \<longleftrightarrow> False"
  78.161 +  "Bit1 m \<le> One \<longleftrightarrow> False"
  78.162 +  "Bit0 m \<le> Bit0 n \<longleftrightarrow> m \<le> n"
  78.163 +  "Bit0 m \<le> Bit1 n \<longleftrightarrow> m \<le> n"
  78.164 +  "Bit1 m \<le> Bit1 n \<longleftrightarrow> m \<le> n"
  78.165 +  "Bit1 m \<le> Bit0 n \<longleftrightarrow> m < n"
  78.166 +  using nat_of_num_pos [of n] nat_of_num_pos [of m]
  78.167 +  by (auto simp add: less_eq_num_def less_num_def)
  78.168 +
  78.169 +lemma less_num_simps [simp, code]:
  78.170 +  "m < One \<longleftrightarrow> False"
  78.171 +  "One < Bit0 n \<longleftrightarrow> True"
  78.172 +  "One < Bit1 n \<longleftrightarrow> True"
  78.173 +  "Bit0 m < Bit0 n \<longleftrightarrow> m < n"
  78.174 +  "Bit0 m < Bit1 n \<longleftrightarrow> m \<le> n"
  78.175 +  "Bit1 m < Bit1 n \<longleftrightarrow> m < n"
  78.176 +  "Bit1 m < Bit0 n \<longleftrightarrow> m < n"
  78.177 +  using nat_of_num_pos [of n] nat_of_num_pos [of m]
  78.178 +  by (auto simp add: less_eq_num_def less_num_def)
  78.179 +
  78.180 +text {* Rules using @{text One} and @{text inc} as constructors *}
  78.181 +
  78.182 +lemma add_One: "x + One = inc x"
  78.183 +  by (simp add: num_eq_iff nat_of_num_add nat_of_num_inc)
  78.184 +
  78.185 +lemma add_One_commute: "One + n = n + One"
  78.186 +  by (induct n) simp_all
  78.187 +
  78.188 +lemma add_inc: "x + inc y = inc (x + y)"
  78.189 +  by (simp add: num_eq_iff nat_of_num_add nat_of_num_inc)
  78.190 +
  78.191 +lemma mult_inc: "x * inc y = x * y + x"
  78.192 +  by (simp add: num_eq_iff nat_of_num_mult nat_of_num_add nat_of_num_inc)
  78.193 +
  78.194 +text {* The @{const num_of_nat} conversion *}
  78.195 +
  78.196 +lemma num_of_nat_One:
  78.197 +  "n \<le> 1 \<Longrightarrow> num_of_nat n = Num.One"
  78.198 +  by (cases n) simp_all
  78.199 +
  78.200 +lemma num_of_nat_plus_distrib:
  78.201 +  "0 < m \<Longrightarrow> 0 < n \<Longrightarrow> num_of_nat (m + n) = num_of_nat m + num_of_nat n"
  78.202 +  by (induct n) (auto simp add: add_One add_One_commute add_inc)
  78.203 +
  78.204 +text {* A double-and-decrement function *}
  78.205 +
  78.206 +primrec BitM :: "num \<Rightarrow> num" where
  78.207 +  "BitM One = One" |
  78.208 +  "BitM (Bit0 n) = Bit1 (BitM n)" |
  78.209 +  "BitM (Bit1 n) = Bit1 (Bit0 n)"
  78.210 +
  78.211 +lemma BitM_plus_one: "BitM n + One = Bit0 n"
  78.212 +  by (induct n) simp_all
  78.213 +
  78.214 +lemma one_plus_BitM: "One + BitM n = Bit0 n"
  78.215 +  unfolding add_One_commute BitM_plus_one ..
  78.216 +
  78.217 +text {* Squaring and exponentiation *}
  78.218 +
  78.219 +primrec sqr :: "num \<Rightarrow> num" where
  78.220 +  "sqr One = One" |
  78.221 +  "sqr (Bit0 n) = Bit0 (Bit0 (sqr n))" |
  78.222 +  "sqr (Bit1 n) = Bit1 (Bit0 (sqr n + n))"
  78.223 +
  78.224 +primrec pow :: "num \<Rightarrow> num \<Rightarrow> num" where
  78.225 +  "pow x One = x" |
  78.226 +  "pow x (Bit0 y) = sqr (pow x y)" |
  78.227 +  "pow x (Bit1 y) = x * sqr (pow x y)"
  78.228 +
  78.229 +lemma nat_of_num_sqr: "nat_of_num (sqr x) = nat_of_num x * nat_of_num x"
  78.230 +  by (induct x, simp_all add: algebra_simps nat_of_num_add)
  78.231 +
  78.232 +lemma sqr_conv_mult: "sqr x = x * x"
  78.233 +  by (simp add: num_eq_iff nat_of_num_sqr nat_of_num_mult)
  78.234 +
  78.235 +
  78.236 +subsection {* Numary numerals *}
  78.237 +
  78.238 +text {*
  78.239 +  We embed numary representations into a generic algebraic
  78.240 +  structure using @{text numeral}.
  78.241 +*}
  78.242 +
  78.243 +class numeral = one + semigroup_add
  78.244 +begin
  78.245 +
  78.246 +primrec numeral :: "num \<Rightarrow> 'a" where
  78.247 +  numeral_One: "numeral One = 1" |
  78.248 +  numeral_Bit0: "numeral (Bit0 n) = numeral n + numeral n" |
  78.249 +  numeral_Bit1: "numeral (Bit1 n) = numeral n + numeral n + 1"
  78.250 +
  78.251 +lemma one_plus_numeral_commute: "1 + numeral x = numeral x + 1"
  78.252 +  apply (induct x)
  78.253 +  apply simp
  78.254 +  apply (simp add: add_assoc [symmetric], simp add: add_assoc)
  78.255 +  apply (simp add: add_assoc [symmetric], simp add: add_assoc)
  78.256 +  done
  78.257 +
  78.258 +lemma numeral_inc: "numeral (inc x) = numeral x + 1"
  78.259 +proof (induct x)
  78.260 +  case (Bit1 x)
  78.261 +  have "numeral x + (1 + numeral x) + 1 = numeral x + (numeral x + 1) + 1"
  78.262 +    by (simp only: one_plus_numeral_commute)
  78.263 +  with Bit1 show ?case
  78.264 +    by (simp add: add_assoc)
  78.265 +qed simp_all
  78.266 +
  78.267 +declare numeral.simps [simp del]
  78.268 +
  78.269 +abbreviation "Numeral1 \<equiv> numeral One"
  78.270 +
  78.271 +declare numeral_One [code_post]
  78.272 +
  78.273 +end
  78.274 +
  78.275 +text {* Negative numerals. *}
  78.276 +
  78.277 +class neg_numeral = numeral + group_add
  78.278 +begin
  78.279 +
  78.280 +definition neg_numeral :: "num \<Rightarrow> 'a" where
  78.281 +  "neg_numeral k = - numeral k"
  78.282 +
  78.283 +end
  78.284 +
  78.285 +text {* Numeral syntax. *}
  78.286 +
  78.287 +syntax
  78.288 +  "_Numeral" :: "num_const \<Rightarrow> 'a"    ("_")
  78.289 +
  78.290 +parse_translation {*
  78.291 +let
  78.292 +  fun num_of_int n = if n > 0 then case IntInf.quotRem (n, 2)