merged
authorkuncar
Mon Mar 26 15:33:28 2012 +0200 (2012-03-26)
changeset 471179890d4f0c1db
parent 47116 529d2a949bd4
parent 47113 b5a5662528fb
child 47118 2fe7a42ece1d
merged
src/HOL/Tools/numeral_syntax.ML
src/HOL/ex/Efficient_Nat_examples.thy
     1.1 --- a/Admin/java/README	Mon Mar 26 15:32:54 2012 +0200
     1.2 +++ b/Admin/java/README	Mon Mar 26 15:33:28 2012 +0200
     1.3 @@ -1,2 +1,3 @@
     1.4 -This is JRE 1.6.0_22 for Linux and Linux x86 from
     1.5 -http://www.java.com/en/download/manual.jsp
     1.6 +This is JDK 1.7.0_03 for Linux and Linux x86 from
     1.7 +http://www.oracle.com/technetwork/java/javase/downloads/index.html
     1.8 +
     2.1 --- a/Admin/java/etc/settings	Mon Mar 26 15:32:54 2012 +0200
     2.2 +++ b/Admin/java/etc/settings	Mon Mar 26 15:33:28 2012 +0200
     2.3 @@ -1,2 +1,4 @@
     2.4 -JAVA_HOME="$COMPONENT/${ISABELLE_PLATFORM64:-$ISABELLE_PLATFORM}/jre1.6.0_22"
     2.5 -ISABELLE_JAVA="$JAVA_HOME/bin/java"
     2.6 +# -*- shell-script -*- :mode=shellscript:
     2.7 +
     2.8 +ISABELLE_JDK_HOME="$COMPONENT/${ISABELLE_PLATFORM64:-$ISABELLE_PLATFORM}/jdk1.7.0_03"
     2.9 +
     3.1 --- a/NEWS	Mon Mar 26 15:32:54 2012 +0200
     3.2 +++ b/NEWS	Mon Mar 26 15:33:28 2012 +0200
     3.3 @@ -45,6 +45,10 @@
     3.4  header -- minor INCOMPATIBILITY for user-defined commands.  Allow new
     3.5  commands to be used in the same theory where defined.
     3.6  
     3.7 +* ISABELLE_JDK_HOME settings variable points to JDK with javac and jar
     3.8 +(not just JRE), derived from JAVA_HOME from the shell environment or
     3.9 +java.home of the running JVM.
    3.10 +
    3.11  
    3.12  *** Pure ***
    3.13  
    3.14 @@ -90,6 +94,30 @@
    3.15  
    3.16  *** HOL ***
    3.17  
    3.18 +* The representation of numerals has changed. We now have a datatype
    3.19 +"num" representing strictly positive binary numerals, along with
    3.20 +functions "numeral :: num => 'a" and "neg_numeral :: num => 'a" to
    3.21 +represent positive and negated numeric literals, respectively. (See
    3.22 +definitions in Num.thy.) Potential INCOMPATIBILITY; some user theories
    3.23 +may require adaptations:
    3.24 +
    3.25 +  - Theorems with number_ring or number_semiring constraints: These
    3.26 +    classes are gone; use comm_ring_1 or comm_semiring_1 instead.
    3.27 +
    3.28 +  - Theories defining numeric types: Remove number, number_semiring,
    3.29 +    and number_ring instances. Defer all theorems about numerals until
    3.30 +    after classes one and semigroup_add have been instantiated.
    3.31 +
    3.32 +  - Numeral-only simp rules: Replace each rule having a "number_of v"
    3.33 +    pattern with two copies, one for numeral and one for neg_numeral.
    3.34 +
    3.35 +  - Theorems about subclasses of semiring_1 or ring_1: These classes
    3.36 +    automatically support numerals now, so more simp rules and
    3.37 +    simprocs may now apply within the proof.
    3.38 +
    3.39 +  - Definitions and theorems using old constructors Pls/Min/Bit0/Bit1:
    3.40 +    Redefine using other integer operations.
    3.41 +
    3.42  * Type 'a set is now a proper type constructor (just as before
    3.43  Isabelle2008).  Definitions mem_def and Collect_def have disappeared.
    3.44  Non-trivial INCOMPATIBILITY.  For developments keeping predicates and
     4.1 --- a/etc/settings	Mon Mar 26 15:32:54 2012 +0200
     4.2 +++ b/etc/settings	Mon Mar 26 15:33:28 2012 +0200
     4.3 @@ -54,10 +54,12 @@
     4.4  ### JVM components (Scala or Java)
     4.5  ###
     4.6  
     4.7 -if [ -n "$JAVA_HOME" ]; then
     4.8 -  ISABELLE_JAVA="$JAVA_HOME/bin/java"
     4.9 -else
    4.10 -  ISABELLE_JAVA="java"
    4.11 +if [ -z "$ISABELLE_JDK_HOME" -a -n "$JAVA_HOME" ]; then
    4.12 +  if [ "$(basename "$JAVA_HOME")" = jre -a -e "$(dirname "$JAVA_HOME")"/bin/javac ]; then
    4.13 +    ISABELLE_JDK_HOME="$(dirname "$JAVA_HOME")"
    4.14 +  else
    4.15 +    ISABELLE_JDK_HOME="$JAVA_HOME"
    4.16 +  fi
    4.17  fi
    4.18  
    4.19  ISABELLE_SCALA_BUILD_OPTIONS="-nowarn -target:jvm-1.5"
     5.1 --- a/lib/Tools/java	Mon Mar 26 15:32:54 2012 +0200
     5.2 +++ b/lib/Tools/java	Mon Mar 26 15:33:28 2012 +0200
     5.3 @@ -6,7 +6,7 @@
     5.4  
     5.5  CLASSPATH="$(jvmpath "$CLASSPATH")"
     5.6  
     5.7 -JAVA_EXE="${THIS_JAVA:-$ISABELLE_JAVA}"
     5.8 +JAVA_EXE="$ISABELLE_JDK_HOME/bin/java"
     5.9  
    5.10  if "$JAVA_EXE" -version >/dev/null 2>/dev/null; then
    5.11    :
     6.1 --- a/lib/browser/build	Mon Mar 26 15:32:54 2012 +0200
     6.2 +++ b/lib/browser/build	Mon Mar 26 15:33:28 2012 +0200
     6.3 @@ -65,9 +65,9 @@
     6.4  
     6.5    rm -rf classes && mkdir classes
     6.6  
     6.7 -  javac -d classes -source 1.4 "${SOURCES[@]}" || \
     6.8 +  "$ISABELLE_JDK_HOME/bin/javac" -d classes -source 1.4 "${SOURCES[@]}" || \
     6.9      fail "Failed to compile sources"
    6.10 -  jar cf "$(jvmpath "$TARGET")" -C classes . ||
    6.11 +  "$ISABELLE_JDK_HOME/bin/jar" cf "$(jvmpath "$TARGET")" -C classes . ||
    6.12      fail "Failed to produce $TARGET"
    6.13  
    6.14    rm -rf classes
     7.1 --- a/src/HOL/Algebra/Group.thy	Mon Mar 26 15:32:54 2012 +0200
     7.2 +++ b/src/HOL/Algebra/Group.thy	Mon Mar 26 15:33:28 2012 +0200
     7.3 @@ -30,7 +30,7 @@
     7.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>)}"
     7.5  
     7.6  consts
     7.7 -  pow :: "[('a, 'm) monoid_scheme, 'a, 'b::number] => 'a"  (infixr "'(^')\<index>" 75)
     7.8 +  pow :: "[('a, 'm) monoid_scheme, 'a, 'b::semiring_1] => 'a"  (infixr "'(^')\<index>" 75)
     7.9  
    7.10  overloading nat_pow == "pow :: [_, 'a, nat] => 'a"
    7.11  begin
     8.1 --- a/src/HOL/Archimedean_Field.thy	Mon Mar 26 15:32:54 2012 +0200
     8.2 +++ b/src/HOL/Archimedean_Field.thy	Mon Mar 26 15:33:28 2012 +0200
     8.3 @@ -12,7 +12,7 @@
     8.4  
     8.5  text {* Archimedean fields have no infinite elements. *}
     8.6  
     8.7 -class archimedean_field = linordered_field + number_ring +
     8.8 +class archimedean_field = linordered_field +
     8.9    assumes ex_le_of_int: "\<exists>z. x \<le> of_int z"
    8.10  
    8.11  lemma ex_less_of_int:
    8.12 @@ -202,8 +202,11 @@
    8.13  lemma floor_one [simp]: "floor 1 = 1"
    8.14    using floor_of_int [of 1] by simp
    8.15  
    8.16 -lemma floor_number_of [simp]: "floor (number_of v) = number_of v"
    8.17 -  using floor_of_int [of "number_of v"] by simp
    8.18 +lemma floor_numeral [simp]: "floor (numeral v) = numeral v"
    8.19 +  using floor_of_int [of "numeral v"] by simp
    8.20 +
    8.21 +lemma floor_neg_numeral [simp]: "floor (neg_numeral v) = neg_numeral v"
    8.22 +  using floor_of_int [of "neg_numeral v"] by simp
    8.23  
    8.24  lemma zero_le_floor [simp]: "0 \<le> floor x \<longleftrightarrow> 0 \<le> x"
    8.25    by (simp add: le_floor_iff)
    8.26 @@ -211,7 +214,12 @@
    8.27  lemma one_le_floor [simp]: "1 \<le> floor x \<longleftrightarrow> 1 \<le> x"
    8.28    by (simp add: le_floor_iff)
    8.29  
    8.30 -lemma number_of_le_floor [simp]: "number_of v \<le> floor x \<longleftrightarrow> number_of v \<le> x"
    8.31 +lemma numeral_le_floor [simp]:
    8.32 +  "numeral v \<le> floor x \<longleftrightarrow> numeral v \<le> x"
    8.33 +  by (simp add: le_floor_iff)
    8.34 +
    8.35 +lemma neg_numeral_le_floor [simp]:
    8.36 +  "neg_numeral v \<le> floor x \<longleftrightarrow> neg_numeral v \<le> x"
    8.37    by (simp add: le_floor_iff)
    8.38  
    8.39  lemma zero_less_floor [simp]: "0 < floor x \<longleftrightarrow> 1 \<le> x"
    8.40 @@ -220,8 +228,12 @@
    8.41  lemma one_less_floor [simp]: "1 < floor x \<longleftrightarrow> 2 \<le> x"
    8.42    by (simp add: less_floor_iff)
    8.43  
    8.44 -lemma number_of_less_floor [simp]:
    8.45 -  "number_of v < floor x \<longleftrightarrow> number_of v + 1 \<le> x"
    8.46 +lemma numeral_less_floor [simp]:
    8.47 +  "numeral v < floor x \<longleftrightarrow> numeral v + 1 \<le> x"
    8.48 +  by (simp add: less_floor_iff)
    8.49 +
    8.50 +lemma neg_numeral_less_floor [simp]:
    8.51 +  "neg_numeral v < floor x \<longleftrightarrow> neg_numeral v + 1 \<le> x"
    8.52    by (simp add: less_floor_iff)
    8.53  
    8.54  lemma floor_le_zero [simp]: "floor x \<le> 0 \<longleftrightarrow> x < 1"
    8.55 @@ -230,8 +242,12 @@
    8.56  lemma floor_le_one [simp]: "floor x \<le> 1 \<longleftrightarrow> x < 2"
    8.57    by (simp add: floor_le_iff)
    8.58  
    8.59 -lemma floor_le_number_of [simp]:
    8.60 -  "floor x \<le> number_of v \<longleftrightarrow> x < number_of v + 1"
    8.61 +lemma floor_le_numeral [simp]:
    8.62 +  "floor x \<le> numeral v \<longleftrightarrow> x < numeral v + 1"
    8.63 +  by (simp add: floor_le_iff)
    8.64 +
    8.65 +lemma floor_le_neg_numeral [simp]:
    8.66 +  "floor x \<le> neg_numeral v \<longleftrightarrow> x < neg_numeral v + 1"
    8.67    by (simp add: floor_le_iff)
    8.68  
    8.69  lemma floor_less_zero [simp]: "floor x < 0 \<longleftrightarrow> x < 0"
    8.70 @@ -240,8 +256,12 @@
    8.71  lemma floor_less_one [simp]: "floor x < 1 \<longleftrightarrow> x < 1"
    8.72    by (simp add: floor_less_iff)
    8.73  
    8.74 -lemma floor_less_number_of [simp]:
    8.75 -  "floor x < number_of v \<longleftrightarrow> x < number_of v"
    8.76 +lemma floor_less_numeral [simp]:
    8.77 +  "floor x < numeral v \<longleftrightarrow> x < numeral v"
    8.78 +  by (simp add: floor_less_iff)
    8.79 +
    8.80 +lemma floor_less_neg_numeral [simp]:
    8.81 +  "floor x < neg_numeral v \<longleftrightarrow> x < neg_numeral v"
    8.82    by (simp add: floor_less_iff)
    8.83  
    8.84  text {* Addition and subtraction of integers *}
    8.85 @@ -249,9 +269,13 @@
    8.86  lemma floor_add_of_int [simp]: "floor (x + of_int z) = floor x + z"
    8.87    using floor_correct [of x] by (simp add: floor_unique)
    8.88  
    8.89 -lemma floor_add_number_of [simp]:
    8.90 -    "floor (x + number_of v) = floor x + number_of v"
    8.91 -  using floor_add_of_int [of x "number_of v"] by simp
    8.92 +lemma floor_add_numeral [simp]:
    8.93 +    "floor (x + numeral v) = floor x + numeral v"
    8.94 +  using floor_add_of_int [of x "numeral v"] by simp
    8.95 +
    8.96 +lemma floor_add_neg_numeral [simp]:
    8.97 +    "floor (x + neg_numeral v) = floor x + neg_numeral v"
    8.98 +  using floor_add_of_int [of x "neg_numeral v"] by simp
    8.99  
   8.100  lemma floor_add_one [simp]: "floor (x + 1) = floor x + 1"
   8.101    using floor_add_of_int [of x 1] by simp
   8.102 @@ -259,9 +283,13 @@
   8.103  lemma floor_diff_of_int [simp]: "floor (x - of_int z) = floor x - z"
   8.104    using floor_add_of_int [of x "- z"] by (simp add: algebra_simps)
   8.105  
   8.106 -lemma floor_diff_number_of [simp]:
   8.107 -  "floor (x - number_of v) = floor x - number_of v"
   8.108 -  using floor_diff_of_int [of x "number_of v"] by simp
   8.109 +lemma floor_diff_numeral [simp]:
   8.110 +  "floor (x - numeral v) = floor x - numeral v"
   8.111 +  using floor_diff_of_int [of x "numeral v"] by simp
   8.112 +
   8.113 +lemma floor_diff_neg_numeral [simp]:
   8.114 +  "floor (x - neg_numeral v) = floor x - neg_numeral v"
   8.115 +  using floor_diff_of_int [of x "neg_numeral v"] by simp
   8.116  
   8.117  lemma floor_diff_one [simp]: "floor (x - 1) = floor x - 1"
   8.118    using floor_diff_of_int [of x 1] by simp
   8.119 @@ -320,8 +348,11 @@
   8.120  lemma ceiling_one [simp]: "ceiling 1 = 1"
   8.121    using ceiling_of_int [of 1] by simp
   8.122  
   8.123 -lemma ceiling_number_of [simp]: "ceiling (number_of v) = number_of v"
   8.124 -  using ceiling_of_int [of "number_of v"] by simp
   8.125 +lemma ceiling_numeral [simp]: "ceiling (numeral v) = numeral v"
   8.126 +  using ceiling_of_int [of "numeral v"] by simp
   8.127 +
   8.128 +lemma ceiling_neg_numeral [simp]: "ceiling (neg_numeral v) = neg_numeral v"
   8.129 +  using ceiling_of_int [of "neg_numeral v"] by simp
   8.130  
   8.131  lemma ceiling_le_zero [simp]: "ceiling x \<le> 0 \<longleftrightarrow> x \<le> 0"
   8.132    by (simp add: ceiling_le_iff)
   8.133 @@ -329,8 +360,12 @@
   8.134  lemma ceiling_le_one [simp]: "ceiling x \<le> 1 \<longleftrightarrow> x \<le> 1"
   8.135    by (simp add: ceiling_le_iff)
   8.136  
   8.137 -lemma ceiling_le_number_of [simp]:
   8.138 -  "ceiling x \<le> number_of v \<longleftrightarrow> x \<le> number_of v"
   8.139 +lemma ceiling_le_numeral [simp]:
   8.140 +  "ceiling x \<le> numeral v \<longleftrightarrow> x \<le> numeral v"
   8.141 +  by (simp add: ceiling_le_iff)
   8.142 +
   8.143 +lemma ceiling_le_neg_numeral [simp]:
   8.144 +  "ceiling x \<le> neg_numeral v \<longleftrightarrow> x \<le> neg_numeral v"
   8.145    by (simp add: ceiling_le_iff)
   8.146  
   8.147  lemma ceiling_less_zero [simp]: "ceiling x < 0 \<longleftrightarrow> x \<le> -1"
   8.148 @@ -339,8 +374,12 @@
   8.149  lemma ceiling_less_one [simp]: "ceiling x < 1 \<longleftrightarrow> x \<le> 0"
   8.150    by (simp add: ceiling_less_iff)
   8.151  
   8.152 -lemma ceiling_less_number_of [simp]:
   8.153 -  "ceiling x < number_of v \<longleftrightarrow> x \<le> number_of v - 1"
   8.154 +lemma ceiling_less_numeral [simp]:
   8.155 +  "ceiling x < numeral v \<longleftrightarrow> x \<le> numeral v - 1"
   8.156 +  by (simp add: ceiling_less_iff)
   8.157 +
   8.158 +lemma ceiling_less_neg_numeral [simp]:
   8.159 +  "ceiling x < neg_numeral v \<longleftrightarrow> x \<le> neg_numeral v - 1"
   8.160    by (simp add: ceiling_less_iff)
   8.161  
   8.162  lemma zero_le_ceiling [simp]: "0 \<le> ceiling x \<longleftrightarrow> -1 < x"
   8.163 @@ -349,8 +388,12 @@
   8.164  lemma one_le_ceiling [simp]: "1 \<le> ceiling x \<longleftrightarrow> 0 < x"
   8.165    by (simp add: le_ceiling_iff)
   8.166  
   8.167 -lemma number_of_le_ceiling [simp]:
   8.168 -  "number_of v \<le> ceiling x\<longleftrightarrow> number_of v - 1 < x"
   8.169 +lemma numeral_le_ceiling [simp]:
   8.170 +  "numeral v \<le> ceiling x \<longleftrightarrow> numeral v - 1 < x"
   8.171 +  by (simp add: le_ceiling_iff)
   8.172 +
   8.173 +lemma neg_numeral_le_ceiling [simp]:
   8.174 +  "neg_numeral v \<le> ceiling x \<longleftrightarrow> neg_numeral v - 1 < x"
   8.175    by (simp add: le_ceiling_iff)
   8.176  
   8.177  lemma zero_less_ceiling [simp]: "0 < ceiling x \<longleftrightarrow> 0 < x"
   8.178 @@ -359,8 +402,12 @@
   8.179  lemma one_less_ceiling [simp]: "1 < ceiling x \<longleftrightarrow> 1 < x"
   8.180    by (simp add: less_ceiling_iff)
   8.181  
   8.182 -lemma number_of_less_ceiling [simp]:
   8.183 -  "number_of v < ceiling x \<longleftrightarrow> number_of v < x"
   8.184 +lemma numeral_less_ceiling [simp]:
   8.185 +  "numeral v < ceiling x \<longleftrightarrow> numeral v < x"
   8.186 +  by (simp add: less_ceiling_iff)
   8.187 +
   8.188 +lemma neg_numeral_less_ceiling [simp]:
   8.189 +  "neg_numeral v < ceiling x \<longleftrightarrow> neg_numeral v < x"
   8.190    by (simp add: less_ceiling_iff)
   8.191  
   8.192  text {* Addition and subtraction of integers *}
   8.193 @@ -368,9 +415,13 @@
   8.194  lemma ceiling_add_of_int [simp]: "ceiling (x + of_int z) = ceiling x + z"
   8.195    using ceiling_correct [of x] by (simp add: ceiling_unique)
   8.196  
   8.197 -lemma ceiling_add_number_of [simp]:
   8.198 -    "ceiling (x + number_of v) = ceiling x + number_of v"
   8.199 -  using ceiling_add_of_int [of x "number_of v"] by simp
   8.200 +lemma ceiling_add_numeral [simp]:
   8.201 +    "ceiling (x + numeral v) = ceiling x + numeral v"
   8.202 +  using ceiling_add_of_int [of x "numeral v"] by simp
   8.203 +
   8.204 +lemma ceiling_add_neg_numeral [simp]:
   8.205 +    "ceiling (x + neg_numeral v) = ceiling x + neg_numeral v"
   8.206 +  using ceiling_add_of_int [of x "neg_numeral v"] by simp
   8.207  
   8.208  lemma ceiling_add_one [simp]: "ceiling (x + 1) = ceiling x + 1"
   8.209    using ceiling_add_of_int [of x 1] by simp
   8.210 @@ -378,9 +429,13 @@
   8.211  lemma ceiling_diff_of_int [simp]: "ceiling (x - of_int z) = ceiling x - z"
   8.212    using ceiling_add_of_int [of x "- z"] by (simp add: algebra_simps)
   8.213  
   8.214 -lemma ceiling_diff_number_of [simp]:
   8.215 -  "ceiling (x - number_of v) = ceiling x - number_of v"
   8.216 -  using ceiling_diff_of_int [of x "number_of v"] by simp
   8.217 +lemma ceiling_diff_numeral [simp]:
   8.218 +  "ceiling (x - numeral v) = ceiling x - numeral v"
   8.219 +  using ceiling_diff_of_int [of x "numeral v"] by simp
   8.220 +
   8.221 +lemma ceiling_diff_neg_numeral [simp]:
   8.222 +  "ceiling (x - neg_numeral v) = ceiling x - neg_numeral v"
   8.223 +  using ceiling_diff_of_int [of x "neg_numeral v"] by simp
   8.224  
   8.225  lemma ceiling_diff_one [simp]: "ceiling (x - 1) = ceiling x - 1"
   8.226    using ceiling_diff_of_int [of x 1] by simp
     9.1 --- a/src/HOL/Code_Evaluation.thy	Mon Mar 26 15:32:54 2012 +0200
     9.2 +++ b/src/HOL/Code_Evaluation.thy	Mon Mar 26 15:33:28 2012 +0200
     9.3 @@ -146,33 +146,29 @@
     9.4    "term_of_num_semiring two = (\<lambda>_. dummy_term)"
     9.5  
     9.6  lemma (in term_syntax) term_of_num_semiring_code [code]:
     9.7 -  "term_of_num_semiring two k = (if k = 0 then termify Int.Pls
     9.8 +  "term_of_num_semiring two k = (
     9.9 +    if k = 1 then termify Num.One
    9.10      else (if k mod two = 0
    9.11 -      then termify Int.Bit0 <\<cdot>> term_of_num_semiring two (k div two)
    9.12 -      else termify Int.Bit1 <\<cdot>> term_of_num_semiring two (k div two)))"
    9.13 -  by (auto simp add: term_of_anything Const_def App_def term_of_num_semiring_def Let_def)
    9.14 +      then termify Num.Bit0 <\<cdot>> term_of_num_semiring two (k div two)
    9.15 +      else termify Num.Bit1 <\<cdot>> term_of_num_semiring two (k div two)))"
    9.16 +  by (auto simp add: term_of_anything Const_def App_def term_of_num_semiring_def)
    9.17  
    9.18  lemma (in term_syntax) term_of_nat_code [code]:
    9.19 -  "term_of (n::nat) = termify (number_of :: int \<Rightarrow> nat) <\<cdot>> term_of_num_semiring (2::nat) n"
    9.20 +  "term_of (n::nat) = (
    9.21 +    if n = 0 then termify (0 :: nat)
    9.22 +    else termify (numeral :: num \<Rightarrow> nat) <\<cdot>> term_of_num_semiring (2::nat) n)"
    9.23    by (simp only: term_of_anything)
    9.24  
    9.25  lemma (in term_syntax) term_of_code_numeral_code [code]:
    9.26 -  "term_of (k::code_numeral) = termify (number_of :: int \<Rightarrow> code_numeral) <\<cdot>> term_of_num_semiring (2::code_numeral) k"
    9.27 +  "term_of (k::code_numeral) = (
    9.28 +    if k = 0 then termify (0 :: code_numeral)
    9.29 +    else termify (numeral :: num \<Rightarrow> code_numeral) <\<cdot>> term_of_num_semiring (2::code_numeral) k)"
    9.30    by (simp only: term_of_anything)
    9.31  
    9.32 -definition term_of_num_ring :: "'a\<Colon>ring_div \<Rightarrow> 'a \<Rightarrow> term" where
    9.33 -  "term_of_num_ring two = (\<lambda>_. dummy_term)"
    9.34 -
    9.35 -lemma (in term_syntax) term_of_num_ring_code [code]:
    9.36 -  "term_of_num_ring two k = (if k = 0 then termify Int.Pls
    9.37 -    else if k = -1 then termify Int.Min
    9.38 -    else if k mod two = 0 then termify Int.Bit0 <\<cdot>> term_of_num_ring two (k div two)
    9.39 -    else termify Int.Bit1 <\<cdot>> term_of_num_ring two (k div two))"
    9.40 -  by (auto simp add: term_of_anything Const_def App_def term_of_num_ring_def Let_def)
    9.41 -
    9.42  lemma (in term_syntax) term_of_int_code [code]:
    9.43    "term_of (k::int) = (if k = 0 then termify (0 :: int)
    9.44 -    else termify (number_of :: int \<Rightarrow> int) <\<cdot>> term_of_num_ring (2::int) k)"
    9.45 +    else if k < 0 then termify (neg_numeral :: num \<Rightarrow> int) <\<cdot>> term_of_num_semiring (2::int) (- k)
    9.46 +    else termify (numeral :: num \<Rightarrow> int) <\<cdot>> term_of_num_semiring (2::int) k)"
    9.47    by (simp only: term_of_anything)
    9.48  
    9.49  
    9.50 @@ -201,6 +197,6 @@
    9.51  
    9.52  
    9.53  hide_const dummy_term valapp
    9.54 -hide_const (open) Const App Abs Free termify valtermify term_of term_of_num_semiring term_of_num_ring tracing
    9.55 +hide_const (open) Const App Abs Free termify valtermify term_of term_of_num_semiring tracing
    9.56  
    9.57  end
    10.1 --- a/src/HOL/Code_Numeral.thy	Mon Mar 26 15:32:54 2012 +0200
    10.2 +++ b/src/HOL/Code_Numeral.thy	Mon Mar 26 15:33:28 2012 +0200
    10.3 @@ -123,25 +123,6 @@
    10.4    by (rule equal_refl)
    10.5  
    10.6  
    10.7 -subsection {* Code numerals as datatype of ints *}
    10.8 -
    10.9 -instantiation code_numeral :: number
   10.10 -begin
   10.11 -
   10.12 -definition
   10.13 -  "number_of = of_nat o nat"
   10.14 -
   10.15 -instance ..
   10.16 -
   10.17 -end
   10.18 -
   10.19 -lemma nat_of_number [simp]:
   10.20 -  "nat_of (number_of k) = number_of k"
   10.21 -  by (simp add: number_of_code_numeral_def nat_number_of_def number_of_is_id)
   10.22 -
   10.23 -code_datatype "number_of \<Colon> int \<Rightarrow> code_numeral"
   10.24 -
   10.25 -
   10.26  subsection {* Basic arithmetic *}
   10.27  
   10.28  instantiation code_numeral :: "{minus, linordered_semidom, semiring_div, linorder}"
   10.29 @@ -176,16 +157,17 @@
   10.30  
   10.31  end
   10.32  
   10.33 -lemma zero_code_numeral_code [code]:
   10.34 -  "(0\<Colon>code_numeral) = Numeral0"
   10.35 -  by (simp add: number_of_code_numeral_def Pls_def)
   10.36 +lemma nat_of_numeral [simp]: "nat_of (numeral k) = numeral k"
   10.37 +  by (induct k rule: num_induct) (simp_all add: numeral_inc)
   10.38  
   10.39 -lemma [code_abbrev]: "Numeral0 = (0\<Colon>code_numeral)"
   10.40 -  using zero_code_numeral_code ..
   10.41 +definition Num :: "num \<Rightarrow> code_numeral"
   10.42 +  where [simp, code_abbrev]: "Num = numeral"
   10.43 +
   10.44 +code_datatype "0::code_numeral" Num
   10.45  
   10.46  lemma one_code_numeral_code [code]:
   10.47    "(1\<Colon>code_numeral) = Numeral1"
   10.48 -  by (simp add: number_of_code_numeral_def Pls_def Bit1_def)
   10.49 +  by simp
   10.50  
   10.51  lemma [code_abbrev]: "Numeral1 = (1\<Colon>code_numeral)"
   10.52    using one_code_numeral_code ..
   10.53 @@ -194,15 +176,8 @@
   10.54    "of_nat n + of_nat m = of_nat (n + m)"
   10.55    by simp
   10.56  
   10.57 -definition subtract :: "code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral" where
   10.58 -  [simp]: "subtract = minus"
   10.59 -
   10.60 -lemma subtract_code [code nbe]:
   10.61 -  "subtract (of_nat n) (of_nat m) = of_nat (n - m)"
   10.62 -  by simp
   10.63 -
   10.64 -lemma minus_code_numeral_code [code]:
   10.65 -  "minus = subtract"
   10.66 +lemma minus_code_numeral_code [code nbe]:
   10.67 +  "of_nat n - of_nat m = of_nat (n - m)"
   10.68    by simp
   10.69  
   10.70  lemma times_code_numeral_code [code nbe]:
   10.71 @@ -281,7 +256,7 @@
   10.72  qed
   10.73  
   10.74  
   10.75 -hide_const (open) of_nat nat_of Suc subtract int_of
   10.76 +hide_const (open) of_nat nat_of Suc int_of
   10.77  
   10.78  
   10.79  subsection {* Code generator setup *}
   10.80 @@ -298,15 +273,21 @@
   10.81    (Haskell -)
   10.82  
   10.83  setup {*
   10.84 -  Numeral.add_code @{const_name number_code_numeral_inst.number_of_code_numeral}
   10.85 +  Numeral.add_code @{const_name Num}
   10.86      false Code_Printer.literal_naive_numeral "SML"
   10.87 -  #> fold (Numeral.add_code @{const_name number_code_numeral_inst.number_of_code_numeral}
   10.88 +  #> fold (Numeral.add_code @{const_name Num}
   10.89      false Code_Printer.literal_numeral) ["OCaml", "Haskell", "Scala"]
   10.90  *}
   10.91  
   10.92  code_reserved SML Int int
   10.93  code_reserved Eval Integer
   10.94  
   10.95 +code_const "0::code_numeral"
   10.96 +  (SML "0")
   10.97 +  (OCaml "Big'_int.zero'_big'_int")
   10.98 +  (Haskell "0")
   10.99 +  (Scala "BigInt(0)")
  10.100 +
  10.101  code_const "plus \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral"
  10.102    (SML "Int.+/ ((_),/ (_))")
  10.103    (OCaml "Big'_int.add'_big'_int")
  10.104 @@ -314,12 +295,12 @@
  10.105    (Scala infixl 7 "+")
  10.106    (Eval infixl 8 "+")
  10.107  
  10.108 -code_const "Code_Numeral.subtract \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral"
  10.109 -  (SML "Int.max/ (_/ -/ _,/ 0 : int)")
  10.110 -  (OCaml "Big'_int.max'_big'_int/ (Big'_int.sub'_big'_int/ _/ _)/ Big'_int.zero'_big'_int")
  10.111 -  (Haskell "max/ (_/ -/ _)/ (0 :: Integer)")
  10.112 +code_const "minus \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral"
  10.113 +  (SML "Int.max/ (0 : int,/ Int.-/ ((_),/ (_)))")
  10.114 +  (OCaml "Big'_int.max'_big'_int/ Big'_int.zero'_big'_int/ (Big'_int.sub'_big'_int/ _/ _)")
  10.115 +  (Haskell "max/ (0 :: Integer)/ (_/ -/ _)")
  10.116    (Scala "!(_/ -/ _).max(0)")
  10.117 -  (Eval "Integer.max/ (_/ -/ _)/ 0")
  10.118 +  (Eval "Integer.max/ 0/ (_/ -/ _)")
  10.119  
  10.120  code_const "times \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral"
  10.121    (SML "Int.*/ ((_),/ (_))")
    11.1 --- a/src/HOL/Codegenerator_Test/Generate_Pretty.thy	Mon Mar 26 15:32:54 2012 +0200
    11.2 +++ b/src/HOL/Codegenerator_Test/Generate_Pretty.thy	Mon Mar 26 15:33:28 2012 +0200
    11.3 @@ -10,9 +10,8 @@
    11.4  lemma [code, code del]: "nat_of_char = nat_of_char" ..
    11.5  lemma [code, code del]: "char_of_nat = char_of_nat" ..
    11.6  
    11.7 -declare Quickcheck_Narrowing.zero_code_int_code[code del]
    11.8 -declare Quickcheck_Narrowing.one_code_int_code[code del]
    11.9 -declare Quickcheck_Narrowing.int_of_code[code del]
   11.10 +declare Quickcheck_Narrowing.one_code_int_code [code del]
   11.11 +declare Quickcheck_Narrowing.int_of_code [code del]
   11.12  
   11.13  subsection {* Check whether generated code compiles *}
   11.14  
    12.1 --- a/src/HOL/Complex.thy	Mon Mar 26 15:32:54 2012 +0200
    12.2 +++ b/src/HOL/Complex.thy	Mon Mar 26 15:33:28 2012 +0200
    12.3 @@ -151,17 +151,6 @@
    12.4  
    12.5  subsection {* Numerals and Arithmetic *}
    12.6  
    12.7 -instantiation complex :: number_ring
    12.8 -begin
    12.9 -
   12.10 -definition complex_number_of_def:
   12.11 -  "number_of w = (of_int w \<Colon> complex)"
   12.12 -
   12.13 -instance
   12.14 -  by intro_classes (simp only: complex_number_of_def)
   12.15 -
   12.16 -end
   12.17 -
   12.18  lemma complex_Re_of_nat [simp]: "Re (of_nat n) = of_nat n"
   12.19    by (induct n) simp_all
   12.20  
   12.21 @@ -174,14 +163,24 @@
   12.22  lemma complex_Im_of_int [simp]: "Im (of_int z) = 0"
   12.23    by (cases z rule: int_diff_cases) simp
   12.24  
   12.25 -lemma complex_Re_number_of [simp]: "Re (number_of v) = number_of v"
   12.26 -  unfolding number_of_eq by (rule complex_Re_of_int)
   12.27 +lemma complex_Re_numeral [simp]: "Re (numeral v) = numeral v"
   12.28 +  using complex_Re_of_int [of "numeral v"] by simp
   12.29 +
   12.30 +lemma complex_Re_neg_numeral [simp]: "Re (neg_numeral v) = neg_numeral v"
   12.31 +  using complex_Re_of_int [of "neg_numeral v"] by simp
   12.32 +
   12.33 +lemma complex_Im_numeral [simp]: "Im (numeral v) = 0"
   12.34 +  using complex_Im_of_int [of "numeral v"] by simp
   12.35  
   12.36 -lemma complex_Im_number_of [simp]: "Im (number_of v) = 0"
   12.37 -  unfolding number_of_eq by (rule complex_Im_of_int)
   12.38 +lemma complex_Im_neg_numeral [simp]: "Im (neg_numeral v) = 0"
   12.39 +  using complex_Im_of_int [of "neg_numeral v"] by simp
   12.40  
   12.41 -lemma Complex_eq_number_of [simp]:
   12.42 -  "(Complex a b = number_of w) = (a = number_of w \<and> b = 0)"
   12.43 +lemma Complex_eq_numeral [simp]:
   12.44 +  "(Complex a b = numeral w) = (a = numeral w \<and> b = 0)"
   12.45 +  by (simp add: complex_eq_iff)
   12.46 +
   12.47 +lemma Complex_eq_neg_numeral [simp]:
   12.48 +  "(Complex a b = neg_numeral w) = (a = neg_numeral w \<and> b = 0)"
   12.49    by (simp add: complex_eq_iff)
   12.50  
   12.51  
   12.52 @@ -421,7 +420,10 @@
   12.53  lemma complex_i_not_one [simp]: "ii \<noteq> 1"
   12.54    by (simp add: complex_eq_iff)
   12.55  
   12.56 -lemma complex_i_not_number_of [simp]: "ii \<noteq> number_of w"
   12.57 +lemma complex_i_not_numeral [simp]: "ii \<noteq> numeral w"
   12.58 +  by (simp add: complex_eq_iff)
   12.59 +
   12.60 +lemma complex_i_not_neg_numeral [simp]: "ii \<noteq> neg_numeral w"
   12.61    by (simp add: complex_eq_iff)
   12.62  
   12.63  lemma i_mult_Complex [simp]: "ii * Complex a b = Complex (- b) a"
   12.64 @@ -505,7 +507,10 @@
   12.65  lemma complex_cnj_of_int [simp]: "cnj (of_int z) = of_int z"
   12.66    by (simp add: complex_eq_iff)
   12.67  
   12.68 -lemma complex_cnj_number_of [simp]: "cnj (number_of w) = number_of w"
   12.69 +lemma complex_cnj_numeral [simp]: "cnj (numeral w) = numeral w"
   12.70 +  by (simp add: complex_eq_iff)
   12.71 +
   12.72 +lemma complex_cnj_neg_numeral [simp]: "cnj (neg_numeral w) = neg_numeral w"
   12.73    by (simp add: complex_eq_iff)
   12.74  
   12.75  lemma complex_cnj_scaleR: "cnj (scaleR r x) = scaleR r (cnj x)"
   12.76 @@ -686,10 +691,10 @@
   12.77    "(of_nat n :: 'a::linordered_idom) < of_int x \<longleftrightarrow> int n < x"
   12.78    by (metis of_int_of_nat_eq of_int_less_iff)
   12.79  
   12.80 -lemma real_of_nat_less_number_of_iff [simp]: (* TODO: move *)
   12.81 -  "real (n::nat) < number_of w \<longleftrightarrow> n < number_of w"
   12.82 -  unfolding real_of_nat_def nat_number_of_def number_of_eq
   12.83 -  by (simp add: of_nat_less_of_int_iff zless_nat_eq_int_zless)
   12.84 +lemma real_of_nat_less_numeral_iff [simp]: (* TODO: move *)
   12.85 +  "real (n::nat) < numeral w \<longleftrightarrow> n < numeral w"
   12.86 +  using of_nat_less_of_int_iff [of n "numeral w", where 'a=real]
   12.87 +  by (simp add: real_of_nat_def zless_nat_eq_int_zless [symmetric])
   12.88  
   12.89  lemma arg_unique:
   12.90    assumes "sgn z = cis x" and "-pi < x" and "x \<le> pi"
    13.1 --- a/src/HOL/Decision_Procs/Approximation.thy	Mon Mar 26 15:32:54 2012 +0200
    13.2 +++ b/src/HOL/Decision_Procs/Approximation.thy	Mon Mar 26 15:33:28 2012 +0200
    13.3 @@ -1350,7 +1350,7 @@
    13.4        also have "\<dots> \<le> cos ((?ux - 2 * ?lpi))"
    13.5          using cos_monotone_minus_pi_0'[OF pi_x x_le_ux ux_0]
    13.6          by (simp only: real_of_float_minus real_of_int_minus real_of_one
    13.7 -            number_of_Min diff_minus mult_minus_left mult_1_left)
    13.8 +            minus_one [symmetric] diff_minus mult_minus_left mult_1_left)
    13.9        also have "\<dots> = cos ((- (?ux - 2 * ?lpi)))"
   13.10          unfolding real_of_float_minus cos_minus ..
   13.11        also have "\<dots> \<le> (ub_cos prec (- (?ux - 2 * ?lpi)))"
   13.12 @@ -1394,7 +1394,7 @@
   13.13        also have "\<dots> \<le> cos ((?lx + 2 * ?lpi))"
   13.14          using cos_monotone_0_pi'[OF lx_0 lx_le_x pi_x]
   13.15          by (simp only: real_of_float_minus real_of_int_minus real_of_one
   13.16 -          number_of_Min diff_minus mult_minus_left mult_1_left)
   13.17 +          minus_one [symmetric] diff_minus mult_minus_left mult_1_left)
   13.18        also have "\<dots> \<le> (ub_cos prec (?lx + 2 * ?lpi))"
   13.19          using lb_cos[OF lx_0 pi_lx] by simp
   13.20        finally show ?thesis unfolding u by (simp add: real_of_float_max)
   13.21 @@ -2117,7 +2117,8 @@
   13.22  lemma interpret_floatarith_num:
   13.23    shows "interpret_floatarith (Num (Float 0 0)) vs = 0"
   13.24    and "interpret_floatarith (Num (Float 1 0)) vs = 1"
   13.25 -  and "interpret_floatarith (Num (Float (number_of a) 0)) vs = number_of a" by auto
   13.26 +  and "interpret_floatarith (Num (Float (numeral a) 0)) vs = numeral a"
   13.27 +  and "interpret_floatarith (Num (Float (neg_numeral a) 0)) vs = neg_numeral a" by auto
   13.28  
   13.29  subsection "Implement approximation function"
   13.30  
    14.1 --- a/src/HOL/Decision_Procs/Cooper.thy	Mon Mar 26 15:32:54 2012 +0200
    14.2 +++ b/src/HOL/Decision_Procs/Cooper.thy	Mon Mar 26 15:33:28 2012 +0200
    14.3 @@ -1883,7 +1883,8 @@
    14.4        | SOME n => @{code Bound} n)
    14.5    | num_of_term vs @{term "0::int"} = @{code C} 0
    14.6    | num_of_term vs @{term "1::int"} = @{code C} 1
    14.7 -  | num_of_term vs (@{term "number_of :: int \<Rightarrow> int"} $ t) = @{code C} (HOLogic.dest_numeral t)
    14.8 +  | num_of_term vs (@{term "numeral :: _ \<Rightarrow> int"} $ t) = @{code C} (HOLogic.dest_num t)
    14.9 +  | num_of_term vs (@{term "neg_numeral :: _ \<Rightarrow> int"} $ t) = @{code C} (~(HOLogic.dest_num t))
   14.10    | num_of_term vs (Bound i) = @{code Bound} i
   14.11    | num_of_term vs (@{term "uminus :: int \<Rightarrow> int"} $ t') = @{code Neg} (num_of_term vs t')
   14.12    | num_of_term vs (@{term "op + :: int \<Rightarrow> int \<Rightarrow> int"} $ t1 $ t2) =
    15.1 --- a/src/HOL/Decision_Procs/Dense_Linear_Order.thy	Mon Mar 26 15:32:54 2012 +0200
    15.2 +++ b/src/HOL/Decision_Procs/Dense_Linear_Order.thy	Mon Mar 26 15:33:28 2012 +0200
    15.3 @@ -636,14 +636,8 @@
    15.4  
    15.5  interpretation class_dense_linordered_field: constr_dense_linorder
    15.6   "op <=" "op <"
    15.7 -   "\<lambda> x y. 1/2 * ((x::'a::{linordered_field,number_ring}) + y)"
    15.8 -proof (unfold_locales, dlo, dlo, auto)
    15.9 -  fix x y::'a assume lt: "x < y"
   15.10 -  from  less_half_sum[OF lt] show "x < (x + y) /2" by simp
   15.11 -next
   15.12 -  fix x y::'a assume lt: "x < y"
   15.13 -  from  gt_half_sum[OF lt] show "(x + y) /2 < y" by simp
   15.14 -qed
   15.15 +   "\<lambda> x y. 1/2 * ((x::'a::{linordered_field}) + y)"
   15.16 +by (unfold_locales, dlo, dlo, auto)
   15.17  
   15.18  declaration{*
   15.19  let
    16.1 --- a/src/HOL/Decision_Procs/Ferrack.thy	Mon Mar 26 15:32:54 2012 +0200
    16.2 +++ b/src/HOL/Decision_Procs/Ferrack.thy	Mon Mar 26 15:33:28 2012 +0200
    16.3 @@ -1732,7 +1732,7 @@
    16.4           (set U \<times> set U)"using mnz nnz th  
    16.5      apply (auto simp add: th add_divide_distrib algebra_simps split_def image_def)
    16.6      by (rule_tac x="(s,m)" in bexI,simp_all) 
    16.7 -  (rule_tac x="(t,n)" in bexI,simp_all)
    16.8 +  (rule_tac x="(t,n)" in bexI,simp_all add: mult_commute)
    16.9  next
   16.10    fix t n s m
   16.11    assume tnU: "(t,n) \<in> set U" and smU:"(s,m) \<in> set U" 
   16.12 @@ -1937,11 +1937,12 @@
   16.13    | num_of_term vs (@{term "op * :: real \<Rightarrow> real \<Rightarrow> real"} $ t1 $ t2) = (case num_of_term vs t1
   16.14       of @{code C} i => @{code Mul} (i, num_of_term vs t2)
   16.15        | _ => error "num_of_term: unsupported multiplication")
   16.16 -  | num_of_term vs (@{term "real :: int \<Rightarrow> real"} $ (@{term "number_of :: int \<Rightarrow> int"} $ t')) =
   16.17 -     @{code C} (HOLogic.dest_numeral t')
   16.18 -  | num_of_term vs (@{term "number_of :: int \<Rightarrow> real"} $ t') =
   16.19 -     @{code C} (HOLogic.dest_numeral t')
   16.20 -  | num_of_term vs t = error ("num_of_term: unknown term");
   16.21 +  | num_of_term vs (@{term "real :: int \<Rightarrow> real"} $ t') =
   16.22 +     (@{code C} (snd (HOLogic.dest_number t'))
   16.23 +       handle TERM _ => error ("num_of_term: unknown term"))
   16.24 +  | num_of_term vs t' =
   16.25 +     (@{code C} (snd (HOLogic.dest_number t'))
   16.26 +       handle TERM _ => error ("num_of_term: unknown term"));
   16.27  
   16.28  fun fm_of_term vs @{term True} = @{code T}
   16.29    | fm_of_term vs @{term False} = @{code F}
    17.1 --- a/src/HOL/Decision_Procs/MIR.thy	Mon Mar 26 15:32:54 2012 +0200
    17.2 +++ b/src/HOL/Decision_Procs/MIR.thy	Mon Mar 26 15:33:28 2012 +0200
    17.3 @@ -4901,7 +4901,7 @@
    17.4           (set U \<times> set U)"using mnz nnz th  
    17.5      apply (auto simp add: th add_divide_distrib algebra_simps split_def image_def)
    17.6      by (rule_tac x="(s,m)" in bexI,simp_all) 
    17.7 -  (rule_tac x="(t,n)" in bexI,simp_all)
    17.8 +  (rule_tac x="(t,n)" in bexI,simp_all add: mult_commute)
    17.9  next
   17.10    fix t n s m
   17.11    assume tnU: "(t,n) \<in> set U" and smU:"(s,m) \<in> set U" 
   17.12 @@ -5536,14 +5536,18 @@
   17.13        (case (num_of_term vs t1)
   17.14         of @{code C} i => @{code Mul} (i, num_of_term vs t2)
   17.15          | _ => error "num_of_term: unsupported Multiplication")
   17.16 -  | num_of_term vs (@{term "real :: int \<Rightarrow> real"} $ (@{term "number_of :: int \<Rightarrow> int"} $ t')) =
   17.17 -      @{code C} (HOLogic.dest_numeral t')
   17.18 +  | num_of_term vs (@{term "real :: int \<Rightarrow> real"} $ (@{term "numeral :: _ \<Rightarrow> int"} $ t')) =
   17.19 +      @{code C} (HOLogic.dest_num t')
   17.20 +  | num_of_term vs (@{term "real :: int \<Rightarrow> real"} $ (@{term "neg_numeral :: _ \<Rightarrow> int"} $ t')) =
   17.21 +      @{code C} (~ (HOLogic.dest_num t'))
   17.22    | num_of_term vs (@{term "real :: int \<Rightarrow> real"} $ (@{term "floor :: real \<Rightarrow> int"} $ t')) =
   17.23        @{code Floor} (num_of_term vs t')
   17.24    | num_of_term vs (@{term "real :: int \<Rightarrow> real"} $ (@{term "ceiling :: real \<Rightarrow> int"} $ t')) =
   17.25        @{code Neg} (@{code Floor} (@{code Neg} (num_of_term vs t')))
   17.26 -  | num_of_term vs (@{term "number_of :: int \<Rightarrow> real"} $ t') =
   17.27 -      @{code C} (HOLogic.dest_numeral t')
   17.28 +  | num_of_term vs (@{term "numeral :: _ \<Rightarrow> real"} $ t') =
   17.29 +      @{code C} (HOLogic.dest_num t')
   17.30 +  | num_of_term vs (@{term "neg_numeral :: _ \<Rightarrow> real"} $ t') =
   17.31 +      @{code C} (~ (HOLogic.dest_num t'))
   17.32    | num_of_term vs t = error ("num_of_term: unknown term " ^ Syntax.string_of_term @{context} t);
   17.33  
   17.34  fun fm_of_term vs @{term True} = @{code T}
   17.35 @@ -5554,8 +5558,10 @@
   17.36        @{code Le} (@{code Sub} (num_of_term vs t1, num_of_term vs t2))
   17.37    | fm_of_term vs (@{term "op = :: real \<Rightarrow> real \<Rightarrow> bool"} $ t1 $ t2) =
   17.38        @{code Eq} (@{code Sub} (num_of_term vs t1, num_of_term vs t2)) 
   17.39 -  | fm_of_term vs (@{term "op rdvd"} $ (@{term "real :: int \<Rightarrow> real"} $ (@{term "number_of :: int \<Rightarrow> int"} $ t1)) $ t2) =
   17.40 -      @{code Dvd} (HOLogic.dest_numeral t1, num_of_term vs t2)
   17.41 +  | fm_of_term vs (@{term "op rdvd"} $ (@{term "real :: int \<Rightarrow> real"} $ (@{term "numeral :: _ \<Rightarrow> int"} $ t1)) $ t2) =
   17.42 +      @{code Dvd} (HOLogic.dest_num t1, num_of_term vs t2)
   17.43 +  | fm_of_term vs (@{term "op rdvd"} $ (@{term "real :: int \<Rightarrow> real"} $ (@{term "neg_numeral :: _ \<Rightarrow> int"} $ t1)) $ t2) =
   17.44 +      @{code Dvd} (~ (HOLogic.dest_num t1), num_of_term vs t2)
   17.45    | fm_of_term vs (@{term "op = :: bool \<Rightarrow> bool \<Rightarrow> bool"} $ t1 $ t2) =
   17.46        @{code Iff} (fm_of_term vs t1, fm_of_term vs t2)
   17.47    | fm_of_term vs (@{term HOL.conj} $ t1 $ t2) =
    18.1 --- a/src/HOL/Decision_Procs/Parametric_Ferrante_Rackoff.thy	Mon Mar 26 15:32:54 2012 +0200
    18.2 +++ b/src/HOL/Decision_Procs/Parametric_Ferrante_Rackoff.thy	Mon Mar 26 15:33:28 2012 +0200
    18.3 @@ -25,7 +25,7 @@
    18.4  | "tmsize (CNP n c a) = 3 + polysize c + tmsize a "
    18.5  
    18.6    (* Semantics of terms tm *)
    18.7 -primrec Itm :: "'a::{field_char_0, field_inverse_zero, number_ring} list \<Rightarrow> 'a list \<Rightarrow> tm \<Rightarrow> 'a" where
    18.8 +primrec Itm :: "'a::{field_char_0, field_inverse_zero} list \<Rightarrow> 'a list \<Rightarrow> tm \<Rightarrow> 'a" where
    18.9    "Itm vs bs (CP c) = (Ipoly vs c)"
   18.10  | "Itm vs bs (Bound n) = bs!n"
   18.11  | "Itm vs bs (Neg a) = -(Itm vs bs a)"
   18.12 @@ -430,7 +430,7 @@
   18.13  by (induct p rule: fmsize.induct) simp_all
   18.14  
   18.15    (* Semantics of formulae (fm) *)
   18.16 -primrec Ifm ::"'a::{linordered_field_inverse_zero, number_ring} list \<Rightarrow> 'a list \<Rightarrow> fm \<Rightarrow> bool" where
   18.17 +primrec Ifm ::"'a::{linordered_field_inverse_zero} list \<Rightarrow> 'a list \<Rightarrow> fm \<Rightarrow> bool" where
   18.18    "Ifm vs bs T = True"
   18.19  | "Ifm vs bs F = False"
   18.20  | "Ifm vs bs (Lt a) = (Itm vs bs a < 0)"
   18.21 @@ -1937,7 +1937,7 @@
   18.22      
   18.23      also have "\<dots> \<longleftrightarrow> - (?a * ?s) + 2*?d*?r = 0" using d by simp 
   18.24      finally have ?thesis using c d 
   18.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)
   18.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)
   18.27    }
   18.28    moreover
   18.29    {assume c: "?c \<noteq> 0" and d: "?d=0"
   18.30 @@ -1950,7 +1950,7 @@
   18.31        by (simp add: field_simps right_distrib[of "2*?c"] del: right_distrib)
   18.32      also have "\<dots> \<longleftrightarrow> - (?a * ?t) + 2*?c*?r = 0" using c by simp 
   18.33      finally have ?thesis using c d 
   18.34 -      by (simp add: r[of "- (?t/ (2*?c))"] msubsteq_def Let_def evaldjf_ex del: one_add_one_is_two)
   18.35 +      by (simp add: r[of "- (?t/ (2*?c))"] msubsteq_def Let_def evaldjf_ex)
   18.36    }
   18.37    moreover
   18.38    {assume c: "?c \<noteq> 0" and d: "?d\<noteq>0" hence dc: "?c * ?d *2 \<noteq> 0" by simp
   18.39 @@ -2019,7 +2019,7 @@
   18.40      
   18.41      also have "\<dots> \<longleftrightarrow> - (?a * ?s) + 2*?d*?r \<noteq> 0" using d by simp 
   18.42      finally have ?thesis using c d 
   18.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)
   18.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)
   18.45    }
   18.46    moreover
   18.47    {assume c: "?c \<noteq> 0" and d: "?d=0"
   18.48 @@ -2032,7 +2032,7 @@
   18.49        by (simp add: field_simps right_distrib[of "2*?c"] del: right_distrib)
   18.50      also have "\<dots> \<longleftrightarrow> - (?a * ?t) + 2*?c*?r \<noteq> 0" using c by simp 
   18.51      finally have ?thesis using c d 
   18.52 -      by (simp add: r[of "- (?t/ (2*?c))"] msubstneq_def Let_def evaldjf_ex del: one_add_one_is_two)
   18.53 +      by (simp add: r[of "- (?t/ (2*?c))"] msubstneq_def Let_def evaldjf_ex)
   18.54    }
   18.55    moreover
   18.56    {assume c: "?c \<noteq> 0" and d: "?d\<noteq>0" hence dc: "?c * ?d *2 \<noteq> 0" by simp
   18.57 @@ -2616,10 +2616,10 @@
   18.58  using lp tnb
   18.59  by (simp add: msubst2_def msubstneg_nb msubstpos_nb conj_nb disj_nb lt_nb simpfm_bound0)
   18.60  
   18.61 -lemma mult_minus2_left: "-2 * (x::'a::number_ring) = - (2 * x)"
   18.62 +lemma mult_minus2_left: "-2 * (x::'a::comm_ring_1) = - (2 * x)"
   18.63    by simp
   18.64  
   18.65 -lemma mult_minus2_right: "(x::'a::number_ring) * -2 = - (x * 2)"
   18.66 +lemma mult_minus2_right: "(x::'a::comm_ring_1) * -2 = - (x * 2)"
   18.67    by simp
   18.68  
   18.69  lemma islin_qf: "islin p \<Longrightarrow> qfree p"
   18.70 @@ -3005,11 +3005,11 @@
   18.71  *} "parametric QE for linear Arithmetic over fields, Version 2"
   18.72  
   18.73  
   18.74 -lemma "\<exists>(x::'a::{linordered_field_inverse_zero, number_ring}). y \<noteq> -1 \<longrightarrow> (y + 1)*x < 0"
   18.75 -  apply (frpar type: "'a::{linordered_field_inverse_zero, number_ring}" pars: "y::'a::{linordered_field_inverse_zero, number_ring}")
   18.76 +lemma "\<exists>(x::'a::{linordered_field_inverse_zero}). y \<noteq> -1 \<longrightarrow> (y + 1)*x < 0"
   18.77 +  apply (frpar type: "'a::{linordered_field_inverse_zero}" pars: "y::'a::{linordered_field_inverse_zero}")
   18.78    apply (simp add: field_simps)
   18.79    apply (rule spec[where x=y])
   18.80 -  apply (frpar type: "'a::{linordered_field_inverse_zero, number_ring}" pars: "z::'a::{linordered_field_inverse_zero, number_ring}")
   18.81 +  apply (frpar type: "'a::{linordered_field_inverse_zero}" pars: "z::'a::{linordered_field_inverse_zero}")
   18.82    by simp
   18.83  
   18.84  text{* Collins/Jones Problem *}
   18.85 @@ -3030,11 +3030,11 @@
   18.86  oops
   18.87  *)
   18.88  
   18.89 -lemma "\<exists>(x::'a::{linordered_field_inverse_zero, number_ring}). y \<noteq> -1 \<longrightarrow> (y + 1)*x < 0"
   18.90 -  apply (frpar2 type: "'a::{linordered_field_inverse_zero, number_ring}" pars: "y::'a::{linordered_field_inverse_zero, number_ring}")
   18.91 +lemma "\<exists>(x::'a::{linordered_field_inverse_zero}). y \<noteq> -1 \<longrightarrow> (y + 1)*x < 0"
   18.92 +  apply (frpar2 type: "'a::{linordered_field_inverse_zero}" pars: "y::'a::{linordered_field_inverse_zero}")
   18.93    apply (simp add: field_simps)
   18.94    apply (rule spec[where x=y])
   18.95 -  apply (frpar2 type: "'a::{linordered_field_inverse_zero, number_ring}" pars: "z::'a::{linordered_field_inverse_zero, number_ring}")
   18.96 +  apply (frpar2 type: "'a::{linordered_field_inverse_zero}" pars: "z::'a::{linordered_field_inverse_zero}")
   18.97    by simp
   18.98  
   18.99  text{* Collins/Jones Problem *}
    19.1 --- a/src/HOL/Decision_Procs/cooper_tac.ML	Mon Mar 26 15:32:54 2012 +0200
    19.2 +++ b/src/HOL/Decision_Procs/cooper_tac.ML	Mon Mar 26 15:33:28 2012 +0200
    19.3 @@ -18,15 +18,12 @@
    19.4  val cooper_ss = @{simpset};
    19.5  
    19.6  val nT = HOLogic.natT;
    19.7 -val binarith = @{thms normalize_bin_simps};
    19.8 -val comp_arith = binarith @ @{thms simp_thms};
    19.9 +val comp_arith = @{thms simp_thms}
   19.10  
   19.11  val zdvd_int = @{thm zdvd_int};
   19.12  val zdiff_int_split = @{thm zdiff_int_split};
   19.13  val all_nat = @{thm all_nat};
   19.14  val ex_nat = @{thm ex_nat};
   19.15 -val number_of1 = @{thm number_of1};
   19.16 -val number_of2 = @{thm number_of2};
   19.17  val split_zdiv = @{thm split_zdiv};
   19.18  val split_zmod = @{thm split_zmod};
   19.19  val mod_div_equality' = @{thm mod_div_equality'};
   19.20 @@ -90,14 +87,13 @@
   19.21            [split_zdiv, split_zmod, split_div', @{thm "split_min"}, @{thm "split_max"}]
   19.22      (* Simp rules for changing (n::int) to int n *)
   19.23      val simpset1 = HOL_basic_ss
   19.24 -      addsimps [@{thm nat_number_of_def}, zdvd_int] @ map (fn r => r RS sym)
   19.25 -        [@{thm int_int_eq}, @{thm zle_int}, @{thm zless_int}, @{thm zadd_int}, @{thm zmult_int}]
   19.26 +      addsimps [zdvd_int] @ map (fn r => r RS sym)
   19.27 +        [@{thm int_numeral}, @{thm int_int_eq}, @{thm zle_int}, @{thm zless_int}, @{thm zadd_int}, @{thm zmult_int}]
   19.28        |> Splitter.add_split zdiff_int_split
   19.29      (*simp rules for elimination of int n*)
   19.30  
   19.31      val simpset2 = HOL_basic_ss
   19.32 -      addsimps [@{thm nat_0_le}, @{thm all_nat}, @{thm ex_nat},
   19.33 -        @{thm number_of1}, @{thm number_of2}, @{thm int_0}, @{thm int_1}]
   19.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}]
   19.35        |> fold Simplifier.add_cong [@{thm conj_le_cong}, @{thm imp_le_cong}]
   19.36      (* simp rules for elimination of abs *)
   19.37      val simpset3 = HOL_basic_ss |> Splitter.add_split @{thm abs_split}
    20.1 --- a/src/HOL/Decision_Procs/ex/Dense_Linear_Order_Ex.thy	Mon Mar 26 15:32:54 2012 +0200
    20.2 +++ b/src/HOL/Decision_Procs/ex/Dense_Linear_Order_Ex.thy	Mon Mar 26 15:33:28 2012 +0200
    20.3 @@ -7,147 +7,147 @@
    20.4  begin
    20.5  
    20.6  lemma
    20.7 -  "\<exists>(y::'a::{linordered_field_inverse_zero, number_ring}) <2. x + 3* y < 0 \<and> x - y >0"
    20.8 +  "\<exists>(y::'a::{linordered_field_inverse_zero}) <2. x + 3* y < 0 \<and> x - y >0"
    20.9    by ferrack
   20.10  
   20.11 -lemma "~ (ALL x (y::'a::{linordered_field_inverse_zero, number_ring}). x < y --> 10*x < 11*y)"
   20.12 +lemma "~ (ALL x (y::'a::{linordered_field_inverse_zero}). x < y --> 10*x < 11*y)"
   20.13    by ferrack
   20.14  
   20.15 -lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}) y. x < y --> (10*(x + 5*y + -1) < 60*y)"
   20.16 +lemma "ALL (x::'a::{linordered_field_inverse_zero}) y. x < y --> (10*(x + 5*y + -1) < 60*y)"
   20.17    by ferrack
   20.18  
   20.19 -lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring}) y. x ~= y --> x < y"
   20.20 +lemma "EX (x::'a::{linordered_field_inverse_zero}) y. x ~= y --> x < y"
   20.21    by ferrack
   20.22  
   20.23 -lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring}) y. (x ~= y & 10*x ~= 9*y & 10*x < y) --> x < y"
   20.24 +lemma "EX (x::'a::{linordered_field_inverse_zero}) y. (x ~= y & 10*x ~= 9*y & 10*x < y) --> x < y"
   20.25    by ferrack
   20.26  
   20.27 -lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}) y. (x ~= y & 5*x <= y) --> 500*x <= 100*y"
   20.28 +lemma "ALL (x::'a::{linordered_field_inverse_zero}) y. (x ~= y & 5*x <= y) --> 500*x <= 100*y"
   20.29    by ferrack
   20.30  
   20.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)"
   20.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)"
   20.33    by ferrack
   20.34  
   20.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)"
   20.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)"
   20.37    by ferrack
   20.38  
   20.39 -lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring}). (0 < x & x < 1) --> (ALL y > 1. x + y ~= 1)"
   20.40 +lemma "EX (x::'a::{linordered_field_inverse_zero}). (0 < x & x < 1) --> (ALL y > 1. x + y ~= 1)"
   20.41    by ferrack
   20.42  
   20.43 -lemma "EX x. (ALL (y::'a::{linordered_field_inverse_zero, number_ring}). y < 2 -->  2*(y - x) \<le> 0 )"
   20.44 +lemma "EX x. (ALL (y::'a::{linordered_field_inverse_zero}). y < 2 -->  2*(y - x) \<le> 0 )"
   20.45    by ferrack
   20.46  
   20.47 -lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}). x < 10 | x > 20 | (EX y. y>= 0 & y <= 10 & x+y = 20)"
   20.48 +lemma "ALL (x::'a::{linordered_field_inverse_zero}). x < 10 | x > 20 | (EX y. y>= 0 & y <= 10 & x+y = 20)"
   20.49    by ferrack
   20.50  
   20.51 -lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}) y z. x + y < z --> y >= z --> x < 0"
   20.52 +lemma "ALL (x::'a::{linordered_field_inverse_zero}) y z. x + y < z --> y >= z --> x < 0"
   20.53    by ferrack
   20.54  
   20.55 -lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring}) y z. x + 7*y < 5* z & 5*y >= 7*z & x < 0"
   20.56 +lemma "EX (x::'a::{linordered_field_inverse_zero}) y z. x + 7*y < 5* z & 5*y >= 7*z & x < 0"
   20.57    by ferrack
   20.58  
   20.59 -lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}) y z. abs (x + y) <= z --> (abs z = z)"
   20.60 +lemma "ALL (x::'a::{linordered_field_inverse_zero}) y z. abs (x + y) <= z --> (abs z = z)"
   20.61    by ferrack
   20.62  
   20.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"
   20.64 +lemma "EX (x::'a::{linordered_field_inverse_zero}) y z. x + 7*y - 5* z < 0 & 5*y + 7*z + 3*x < 0"
   20.65    by ferrack
   20.66  
   20.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))"
   20.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))"
   20.69    by ferrack
   20.70  
   20.71 -lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}) y. x < y --> (EX z>0. x+z = y)"
   20.72 +lemma "ALL (x::'a::{linordered_field_inverse_zero}) y. x < y --> (EX z>0. x+z = y)"
   20.73    by ferrack
   20.74  
   20.75 -lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}) y. x < y --> (EX z>0. x+z = y)"
   20.76 +lemma "ALL (x::'a::{linordered_field_inverse_zero}) y. x < y --> (EX z>0. x+z = y)"
   20.77    by ferrack
   20.78  
   20.79 -lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}) y. (EX z>0. abs (x - y) <= z )"
   20.80 +lemma "ALL (x::'a::{linordered_field_inverse_zero}) y. (EX z>0. abs (x - y) <= z )"
   20.81    by ferrack
   20.82  
   20.83 -lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring}) y. (ALL z<0. (z < x --> z <= y) & (z > y --> z >= x))"
   20.84 +lemma "EX (x::'a::{linordered_field_inverse_zero}) y. (ALL z<0. (z < x --> z <= y) & (z > y --> z >= x))"
   20.85    by ferrack
   20.86  
   20.87 -lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring}) y. (ALL z>=0. abs (3*x+7*y) <= 2*z + 1)"
   20.88 +lemma "EX (x::'a::{linordered_field_inverse_zero}) y. (ALL z>=0. abs (3*x+7*y) <= 2*z + 1)"
   20.89    by ferrack
   20.90  
   20.91 -lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring}) y. (ALL z<0. (z < x --> z <= y) & (z > y --> z >= x))"
   20.92 +lemma "EX (x::'a::{linordered_field_inverse_zero}) y. (ALL z<0. (z < x --> z <= y) & (z > y --> z >= x))"
   20.93    by ferrack
   20.94  
   20.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))"
   20.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))"
   20.97    by ferrack
   20.98  
   20.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))"
  20.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))"
  20.101    by ferrack
  20.102  
  20.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))"
  20.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))"
  20.105    by ferrack
  20.106  
  20.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) ))"
  20.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) ))"
  20.109    by ferrack
  20.110  
  20.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))"
  20.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))"
  20.113    by ferrack
  20.114  
  20.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"
  20.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"
  20.117    by ferrack
  20.118  
  20.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"
  20.120 +lemma "EX (x::'a::{linordered_field_inverse_zero}) y z w. 5*x + 3*z - 17*w + abs (y - 8*x + z) <= 89"
  20.121    by ferrack
  20.122  
  20.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)"
  20.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)"
  20.125    by ferrack
  20.126  
  20.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)"
  20.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)"
  20.129    by ferrack
  20.130  
  20.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)"
  20.132 +lemma "ALL (x::'a::{linordered_field_inverse_zero}) y z. (EX w >= (x+y+z). w <= abs x + abs y + abs z)"
  20.133    by ferrack
  20.134  
  20.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))"
  20.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))"
  20.137    by ferrack
  20.138  
  20.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)"
  20.140 +lemma "ALL (x::'a::{linordered_field_inverse_zero}) y. (EX z w. abs (x-y) = (z-w) & z*1234 < 233*x & w ~= y)"
  20.141    by ferrack
  20.142  
  20.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))"
  20.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))"
  20.145    by ferrack
  20.146  
  20.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)"
  20.148 +lemma "EX (x::'a::{linordered_field_inverse_zero}) y z. (ALL w >= abs (x+y+z). w >= abs x + abs y + abs z)"
  20.149    by ferrack
  20.150  
  20.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))"
  20.152 +lemma "EX z. (ALL (x::'a::{linordered_field_inverse_zero}) y. (EX w >= (x+y+z). w <= abs x + abs y + abs z))"
  20.153    by ferrack
  20.154  
  20.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))"
  20.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))"
  20.157    by ferrack
  20.158  
  20.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))"
  20.160 +lemma "ALL (x::'a::{linordered_field_inverse_zero}) y. (EX z. (ALL w. abs (x-y) = abs (z-w) --> z < x & w ~= y))"
  20.161    by ferrack
  20.162  
  20.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)))"
  20.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)))"
  20.165    by ferrack
  20.166  
  20.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))"
  20.168 +lemma "EX (x::'a::{linordered_field_inverse_zero}) z. (ALL w >= 13*x - 4*z. (EX y. w >= abs x + abs y + z))"
  20.169    by ferrack
  20.170  
  20.171 -lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring}). (ALL y < x. (EX z > (x+y).
  20.172 +lemma "EX (x::'a::{linordered_field_inverse_zero}). (ALL y < x. (EX z > (x+y).
  20.173    (ALL w. 5*w + 10*x - z >= y --> w + 7*x + 3*z >= 2*y)))"
  20.174    by ferrack
  20.175  
  20.176 -lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring}). (ALL y. (EX z > y.
  20.177 +lemma "EX (x::'a::{linordered_field_inverse_zero}). (ALL y. (EX z > y.
  20.178    (ALL w . w < 13 --> w + 10*x - z >= y --> 5*w + 7*x + 13*z >= 2*y)))"
  20.179    by ferrack
  20.180  
  20.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)"
  20.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)"
  20.183    by ferrack
  20.184  
  20.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)))"
  20.186 +lemma "ALL (x::'a::{linordered_field_inverse_zero}). (EX y. (ALL z>19. y <= x + z & (EX w. abs (y - x) < w)))"
  20.187    by ferrack
  20.188  
  20.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)))"
  20.190 +lemma "ALL (x::'a::{linordered_field_inverse_zero}). (EX y. (ALL z>19. y <= x + z & (EX w. abs (x + z) < w - y)))"
  20.191    by ferrack
  20.192  
  20.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)))"
  20.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)))"
  20.195    by ferrack
  20.196  
  20.197  end
    21.1 --- a/src/HOL/Decision_Procs/ferrack_tac.ML	Mon Mar 26 15:32:54 2012 +0200
    21.2 +++ b/src/HOL/Decision_Procs/ferrack_tac.ML	Mon Mar 26 15:33:28 2012 +0200
    21.3 @@ -20,17 +20,13 @@
    21.4               in @{simpset} delsimps ths addsimps (map (fn th => th RS sym) ths)
    21.5               end;
    21.6  
    21.7 -val binarith =
    21.8 -  @{thms normalize_bin_simps} @ @{thms pred_bin_simps} @ @{thms succ_bin_simps} @
    21.9 -  @{thms add_bin_simps} @ @{thms minus_bin_simps} @  @{thms mult_bin_simps};
   21.10 -val comp_arith = binarith @ @{thms simp_thms};
   21.11 +val binarith = @{thms arith_simps}
   21.12 +val comp_arith = binarith @ @{thms simp_thms}
   21.13  
   21.14  val zdvd_int = @{thm zdvd_int};
   21.15  val zdiff_int_split = @{thm zdiff_int_split};
   21.16  val all_nat = @{thm all_nat};
   21.17  val ex_nat = @{thm ex_nat};
   21.18 -val number_of1 = @{thm number_of1};
   21.19 -val number_of2 = @{thm number_of2};
   21.20  val split_zdiv = @{thm split_zdiv};
   21.21  val split_zmod = @{thm split_zmod};
   21.22  val mod_div_equality' = @{thm mod_div_equality'};
    22.1 --- a/src/HOL/Decision_Procs/mir_tac.ML	Mon Mar 26 15:32:54 2012 +0200
    22.2 +++ b/src/HOL/Decision_Procs/mir_tac.ML	Mon Mar 26 15:33:28 2012 +0200
    22.3 @@ -21,16 +21,15 @@
    22.4  end;
    22.5  
    22.6  val nT = HOLogic.natT;
    22.7 -  val nat_arith = [@{thm "add_nat_number_of"}, @{thm "diff_nat_number_of"},
    22.8 -                       @{thm "mult_nat_number_of"}, @{thm "eq_nat_number_of"}, @{thm "less_nat_number_of"}];
    22.9 +  val nat_arith = [@{thm diff_nat_numeral}];
   22.10  
   22.11    val comp_arith = [@{thm "Let_def"}, @{thm "if_False"}, @{thm "if_True"}, @{thm "add_0"},
   22.12 -                 @{thm "add_Suc"}, @{thm "add_number_of_left"}, @{thm "mult_number_of_left"},
   22.13 +                 @{thm "add_Suc"}, @{thm add_numeral_left}, @{thm mult_numeral_left(1)},
   22.14                   @{thm "Suc_eq_plus1"}] @
   22.15 -                 (map (fn th => th RS sym) [@{thm "numeral_1_eq_1"}, @{thm "numeral_0_eq_0"}])
   22.16 +                 (map (fn th => th RS sym) [@{thm "numeral_1_eq_1"}])
   22.17                   @ @{thms arith_simps} @ nat_arith @ @{thms rel_simps} 
   22.18    val ths = [@{thm "mult_numeral_1"}, @{thm "mult_numeral_1_right"}, 
   22.19 -             @{thm "real_of_nat_number_of"},
   22.20 +             @{thm real_of_nat_numeral},
   22.21               @{thm "real_of_nat_Suc"}, @{thm "real_of_nat_one"}, @{thm "real_of_one"},
   22.22               @{thm "real_of_int_zero"}, @{thm "real_of_nat_zero"},
   22.23               @{thm "divide_zero"}, 
   22.24 @@ -44,8 +43,6 @@
   22.25  val zdiff_int_split = @{thm "zdiff_int_split"};
   22.26  val all_nat = @{thm "all_nat"};
   22.27  val ex_nat = @{thm "ex_nat"};
   22.28 -val number_of1 = @{thm "number_of1"};
   22.29 -val number_of2 = @{thm "number_of2"};
   22.30  val split_zdiv = @{thm "split_zdiv"};
   22.31  val split_zmod = @{thm "split_zmod"};
   22.32  val mod_div_equality' = @{thm "mod_div_equality'"};
   22.33 @@ -113,15 +110,15 @@
   22.34              @{thm "split_min"}, @{thm "split_max"}]
   22.35      (* Simp rules for changing (n::int) to int n *)
   22.36      val simpset1 = HOL_basic_ss
   22.37 -      addsimps [@{thm "nat_number_of_def"}, @{thm "zdvd_int"}] @ map (fn r => r RS sym)
   22.38 +      addsimps [@{thm "zdvd_int"}] @ map (fn r => r RS sym)
   22.39          [@{thm "int_int_eq"}, @{thm "zle_int"}, @{thm "zless_int"}, @{thm "zadd_int"}, 
   22.40 -         @{thm "zmult_int"}]
   22.41 +         @{thm nat_numeral}, @{thm "zmult_int"}]
   22.42        |> Splitter.add_split @{thm "zdiff_int_split"}
   22.43      (*simp rules for elimination of int n*)
   22.44  
   22.45      val simpset2 = HOL_basic_ss
   22.46 -      addsimps [@{thm "nat_0_le"}, @{thm "all_nat"}, @{thm "ex_nat"}, @{thm "number_of1"}, 
   22.47 -                @{thm "number_of2"}, @{thm "int_0"}, @{thm "int_1"}]
   22.48 +      addsimps [@{thm "nat_0_le"}, @{thm "all_nat"}, @{thm "ex_nat"}, @{thm zero_le_numeral}, 
   22.49 +                @{thm "int_0"}, @{thm "int_1"}]
   22.50        |> fold Simplifier.add_cong [@{thm "conj_le_cong"}, @{thm "imp_le_cong"}]
   22.51      (* simp rules for elimination of abs *)
   22.52      val ct = cterm_of thy (HOLogic.mk_Trueprop t)
    23.1 --- a/src/HOL/Deriv.thy	Mon Mar 26 15:32:54 2012 +0200
    23.2 +++ b/src/HOL/Deriv.thy	Mon Mar 26 15:33:28 2012 +0200
    23.3 @@ -186,7 +186,6 @@
    23.4  apply (erule DERIV_mult')
    23.5  apply (erule (1) DERIV_inverse')
    23.6  apply (simp add: ring_distribs nonzero_inverse_mult_distrib)
    23.7 -apply (simp add: mult_ac)
    23.8  done
    23.9  
   23.10  lemma DERIV_power_Suc:
    24.1 --- a/src/HOL/Divides.thy	Mon Mar 26 15:32:54 2012 +0200
    24.2 +++ b/src/HOL/Divides.thy	Mon Mar 26 15:33:28 2012 +0200
    24.3 @@ -1138,8 +1138,8 @@
    24.4  lemma Suc_mod_eq_add3_mod: "(Suc (Suc (Suc m))) mod n = (3+m) mod n"
    24.5  by (simp add: Suc3_eq_add_3)
    24.6  
    24.7 -lemmas Suc_div_eq_add3_div_number_of [simp] = Suc_div_eq_add3_div [of _ "number_of v"] for v
    24.8 -lemmas Suc_mod_eq_add3_mod_number_of [simp] = Suc_mod_eq_add3_mod [of _ "number_of v"] for v
    24.9 +lemmas Suc_div_eq_add3_div_numeral [simp] = Suc_div_eq_add3_div [of _ "numeral v"] for v
   24.10 +lemmas Suc_mod_eq_add3_mod_numeral [simp] = Suc_mod_eq_add3_mod [of _ "numeral v"] for v
   24.11  
   24.12  
   24.13  lemma Suc_times_mod_eq: "1<k ==> Suc (k * m) mod k = 1" 
   24.14 @@ -1147,7 +1147,7 @@
   24.15  apply (simp_all add: mod_Suc)
   24.16  done
   24.17  
   24.18 -declare Suc_times_mod_eq [of "number_of w", simp] for w
   24.19 +declare Suc_times_mod_eq [of "numeral w", simp] for w
   24.20  
   24.21  lemma [simp]: "n div k \<le> (Suc n) div k"
   24.22  by (simp add: div_le_mono) 
   24.23 @@ -1177,17 +1177,22 @@
   24.24  apply (subst mod_Suc [of "m mod n"], simp) 
   24.25  done
   24.26  
   24.27 +lemma mod_2_not_eq_zero_eq_one_nat:
   24.28 +  fixes n :: nat
   24.29 +  shows "n mod 2 \<noteq> 0 \<longleftrightarrow> n mod 2 = 1"
   24.30 +  by simp
   24.31 +
   24.32  
   24.33  subsection {* Division on @{typ int} *}
   24.34  
   24.35  definition divmod_int_rel :: "int \<Rightarrow> int \<Rightarrow> int \<times> int \<Rightarrow> bool" where
   24.36      --{*definition of quotient and remainder*}
   24.37 -    [code]: "divmod_int_rel a b = (\<lambda>(q, r). a = b * q + r \<and>
   24.38 +    "divmod_int_rel a b = (\<lambda>(q, r). a = b * q + r \<and>
   24.39                 (if 0 < b then 0 \<le> r \<and> r < b else b < r \<and> r \<le> 0))"
   24.40  
   24.41  definition adjust :: "int \<Rightarrow> int \<times> int \<Rightarrow> int \<times> int" where
   24.42      --{*for the division algorithm*}
   24.43 -    [code]: "adjust b = (\<lambda>(q, r). if 0 \<le> r - b then (2 * q + 1, r - b)
   24.44 +    "adjust b = (\<lambda>(q, r). if 0 \<le> r - b then (2 * q + 1, r - b)
   24.45                           else (2 * q, r))"
   24.46  
   24.47  text{*algorithm for the case @{text "a\<ge>0, b>0"}*}
   24.48 @@ -1318,11 +1323,11 @@
   24.49  text{*And positive divisors*}
   24.50  
   24.51  lemma adjust_eq [simp]:
   24.52 -     "adjust b (q,r) = 
   24.53 -      (let diff = r-b in  
   24.54 -        if 0 \<le> diff then (2*q + 1, diff)   
   24.55 +     "adjust b (q, r) = 
   24.56 +      (let diff = r - b in  
   24.57 +        if 0 \<le> diff then (2 * q + 1, diff)   
   24.58                       else (2*q, r))"
   24.59 -by (simp add: Let_def adjust_def)
   24.60 +  by (simp add: Let_def adjust_def)
   24.61  
   24.62  declare posDivAlg.simps [simp del]
   24.63  
   24.64 @@ -1420,6 +1425,9 @@
   24.65  
   24.66  text {* Tool setup *}
   24.67  
   24.68 +(* FIXME: Theorem list add_0s doesn't exist, because Numeral0 has gone. *)
   24.69 +lemmas add_0s = add_0_left add_0_right
   24.70 +
   24.71  ML {*
   24.72  structure Cancel_Div_Mod_Int = Cancel_Div_Mod
   24.73  (
   24.74 @@ -1674,16 +1682,6 @@
   24.75    by (rule divmod_int_rel_mod [of a b q r],
   24.76      simp add: divmod_int_rel_def)
   24.77  
   24.78 -lemmas arithmetic_simps =
   24.79 -  arith_simps
   24.80 -  add_special
   24.81 -  add_0_left
   24.82 -  add_0_right
   24.83 -  mult_zero_left
   24.84 -  mult_zero_right
   24.85 -  mult_1_left
   24.86 -  mult_1_right
   24.87 -
   24.88  (* simprocs adapted from HOL/ex/Binary.thy *)
   24.89  ML {*
   24.90  local
   24.91 @@ -1694,7 +1692,7 @@
   24.92    val less = @{term "op < :: int \<Rightarrow> int \<Rightarrow> bool"}
   24.93    val le = @{term "op \<le> :: int \<Rightarrow> int \<Rightarrow> bool"}
   24.94    val simps = @{thms arith_simps} @ @{thms rel_simps} @
   24.95 -    map (fn th => th RS sym) [@{thm numeral_0_eq_0}, @{thm numeral_1_eq_1}]
   24.96 +    map (fn th => th RS sym) [@{thm numeral_1_eq_1}]
   24.97    fun prove ctxt goal = Goal.prove ctxt [] [] (HOLogic.mk_Trueprop goal)
   24.98      (K (ALLGOALS (full_simp_tac (HOL_basic_ss addsimps simps))));
   24.99    fun binary_proc proc ss ct =
  24.100 @@ -1717,14 +1715,25 @@
  24.101  end
  24.102  *}
  24.103  
  24.104 -simproc_setup binary_int_div ("number_of m div number_of n :: int") =
  24.105 +simproc_setup binary_int_div
  24.106 +  ("numeral m div numeral n :: int" |
  24.107 +   "numeral m div neg_numeral n :: int" |
  24.108 +   "neg_numeral m div numeral n :: int" |
  24.109 +   "neg_numeral m div neg_numeral n :: int") =
  24.110    {* K (divmod_proc @{thm int_div_pos_eq} @{thm int_div_neg_eq}) *}
  24.111  
  24.112 -simproc_setup binary_int_mod ("number_of m mod number_of n :: int") =
  24.113 +simproc_setup binary_int_mod
  24.114 +  ("numeral m mod numeral n :: int" |
  24.115 +   "numeral m mod neg_numeral n :: int" |
  24.116 +   "neg_numeral m mod numeral n :: int" |
  24.117 +   "neg_numeral m mod neg_numeral n :: int") =
  24.118    {* K (divmod_proc @{thm int_mod_pos_eq} @{thm int_mod_neg_eq}) *}
  24.119  
  24.120 -lemmas posDivAlg_eqn_number_of [simp] = posDivAlg_eqn [of "number_of v" "number_of w"] for v w
  24.121 -lemmas negDivAlg_eqn_number_of [simp] = negDivAlg_eqn [of "number_of v" "number_of w"] for v w
  24.122 +lemmas posDivAlg_eqn_numeral [simp] =
  24.123 +    posDivAlg_eqn [of "numeral v" "numeral w", OF zero_less_numeral] for v w
  24.124 +
  24.125 +lemmas negDivAlg_eqn_numeral [simp] =
  24.126 +    negDivAlg_eqn [of "numeral v" "neg_numeral w", OF zero_less_numeral] for v w
  24.127  
  24.128  
  24.129  text{*Special-case simplification *}
  24.130 @@ -1741,12 +1750,25 @@
  24.131  (** The last remaining special cases for constant arithmetic:
  24.132      1 div z and 1 mod z **)
  24.133  
  24.134 -lemmas div_pos_pos_1_number_of [simp] = div_pos_pos [OF zero_less_one, of "number_of w"] for w
  24.135 -lemmas div_pos_neg_1_number_of [simp] = div_pos_neg [OF zero_less_one, of "number_of w"] for w
  24.136 -lemmas mod_pos_pos_1_number_of [simp] = mod_pos_pos [OF zero_less_one, of "number_of w"] for w
  24.137 -lemmas mod_pos_neg_1_number_of [simp] = mod_pos_neg [OF zero_less_one, of "number_of w"] for w
  24.138 -lemmas posDivAlg_eqn_1_number_of [simp] = posDivAlg_eqn [of concl: 1 "number_of w"] for w
  24.139 -lemmas negDivAlg_eqn_1_number_of [simp] = negDivAlg_eqn [of concl: 1 "number_of w"] for w
  24.140 +lemmas div_pos_pos_1_numeral [simp] =
  24.141 +  div_pos_pos [OF zero_less_one, of "numeral w", OF zero_le_numeral] for w
  24.142 +
  24.143 +lemmas div_pos_neg_1_numeral [simp] =
  24.144 +  div_pos_neg [OF zero_less_one, of "neg_numeral w",
  24.145 +  OF neg_numeral_less_zero] for w
  24.146 +
  24.147 +lemmas mod_pos_pos_1_numeral [simp] =
  24.148 +  mod_pos_pos [OF zero_less_one, of "numeral w", OF zero_le_numeral] for w
  24.149 +
  24.150 +lemmas mod_pos_neg_1_numeral [simp] =
  24.151 +  mod_pos_neg [OF zero_less_one, of "neg_numeral w",
  24.152 +  OF neg_numeral_less_zero] for w
  24.153 +
  24.154 +lemmas posDivAlg_eqn_1_numeral [simp] =
  24.155 +    posDivAlg_eqn [of concl: 1 "numeral w", OF zero_less_numeral] for w
  24.156 +
  24.157 +lemmas negDivAlg_eqn_1_numeral [simp] =
  24.158 +    negDivAlg_eqn [of concl: 1 "numeral w", OF zero_less_numeral] for w
  24.159  
  24.160  
  24.161  subsubsection {* Monotonicity in the First Argument (Dividend) *}
  24.162 @@ -1928,6 +1950,11 @@
  24.163  (* REVISIT: should this be generalized to all semiring_div types? *)
  24.164  lemmas zmod_eq_0D [dest!] = zmod_eq_0_iff [THEN iffD1]
  24.165  
  24.166 +lemma zmod_zdiv_equality':
  24.167 +  "(m\<Colon>int) mod n = m - (m div n) * n"
  24.168 +  by (rule_tac P="%x. m mod n = x - (m div n) * n" in subst [OF mod_div_equality [of _ n]])
  24.169 +    arith
  24.170 +
  24.171  
  24.172  subsubsection {* Proving  @{term "a div (b*c) = (a div b) div c"} *}
  24.173  
  24.174 @@ -1989,6 +2016,26 @@
  24.175  apply (force simp add: divmod_int_rel_div_mod [THEN zmult2_lemma, THEN divmod_int_rel_mod])
  24.176  done
  24.177  
  24.178 +lemma div_pos_geq:
  24.179 +  fixes k l :: int
  24.180 +  assumes "0 < l" and "l \<le> k"
  24.181 +  shows "k div l = (k - l) div l + 1"
  24.182 +proof -
  24.183 +  have "k = (k - l) + l" by simp
  24.184 +  then obtain j where k: "k = j + l" ..
  24.185 +  with assms show ?thesis by simp
  24.186 +qed
  24.187 +
  24.188 +lemma mod_pos_geq:
  24.189 +  fixes k l :: int
  24.190 +  assumes "0 < l" and "l \<le> k"
  24.191 +  shows "k mod l = (k - l) mod l"
  24.192 +proof -
  24.193 +  have "k = (k - l) + l" by simp
  24.194 +  then obtain j where k: "k = j + l" ..
  24.195 +  with assms show ?thesis by simp
  24.196 +qed
  24.197 +
  24.198  
  24.199  subsubsection {* Splitting Rules for div and mod *}
  24.200  
  24.201 @@ -2046,9 +2093,9 @@
  24.202  
  24.203  text {* Enable (lin)arith to deal with @{const div} and @{const mod}
  24.204    when these are applied to some constant that is of the form
  24.205 -  @{term "number_of k"}: *}
  24.206 -declare split_zdiv [of _ _ "number_of k", arith_split] for k
  24.207 -declare split_zmod [of _ _ "number_of k", arith_split] for k
  24.208 +  @{term "numeral k"}: *}
  24.209 +declare split_zdiv [of _ _ "numeral k", arith_split] for k
  24.210 +declare split_zmod [of _ _ "numeral k", arith_split] for k
  24.211  
  24.212  
  24.213  subsubsection {* Speeding up the Division Algorithm with Shifting *}
  24.214 @@ -2090,19 +2137,19 @@
  24.215        minus_add_distrib [symmetric] mult_minus_right)
  24.216  qed
  24.217  
  24.218 -lemma zdiv_number_of_Bit0 [simp]:
  24.219 -     "number_of (Int.Bit0 v) div number_of (Int.Bit0 w) =  
  24.220 -          number_of v div (number_of w :: int)"
  24.221 -by (simp only: number_of_eq numeral_simps) (simp add: mult_2 [symmetric])
  24.222 -
  24.223 -lemma zdiv_number_of_Bit1 [simp]:
  24.224 -     "number_of (Int.Bit1 v) div number_of (Int.Bit0 w) =  
  24.225 -          (if (0::int) \<le> number_of w                    
  24.226 -           then number_of v div (number_of w)     
  24.227 -           else (number_of v + (1::int)) div (number_of w))"
  24.228 -apply (simp only: number_of_eq numeral_simps UNIV_I split: split_if) 
  24.229 -apply (simp add: pos_zdiv_mult_2 neg_zdiv_mult_2 add_ac mult_2 [symmetric])
  24.230 -done
  24.231 +(* FIXME: add rules for negative numerals *)
  24.232 +lemma zdiv_numeral_Bit0 [simp]:
  24.233 +  "numeral (Num.Bit0 v) div numeral (Num.Bit0 w) =
  24.234 +    numeral v div (numeral w :: int)"
  24.235 +  unfolding numeral.simps unfolding mult_2 [symmetric]
  24.236 +  by (rule div_mult_mult1, simp)
  24.237 +
  24.238 +lemma zdiv_numeral_Bit1 [simp]:
  24.239 +  "numeral (Num.Bit1 v) div numeral (Num.Bit0 w) =  
  24.240 +    (numeral v div (numeral w :: int))"
  24.241 +  unfolding numeral.simps
  24.242 +  unfolding mult_2 [symmetric] add_commute [of _ 1]
  24.243 +  by (rule pos_zdiv_mult_2, simp)
  24.244  
  24.245  
  24.246  subsubsection {* Computing mod by Shifting (proofs resemble those for div) *}
  24.247 @@ -2138,24 +2185,19 @@
  24.248       (simp add: diff_minus add_ac)
  24.249  qed
  24.250  
  24.251 -lemma zmod_number_of_Bit0 [simp]:
  24.252 -     "number_of (Int.Bit0 v) mod number_of (Int.Bit0 w) =  
  24.253 -      (2::int) * (number_of v mod number_of w)"
  24.254 -apply (simp only: number_of_eq numeral_simps) 
  24.255 -apply (simp add: mod_mult_mult1 pos_zmod_mult_2 
  24.256 -                 neg_zmod_mult_2 add_ac mult_2 [symmetric])
  24.257 -done
  24.258 -
  24.259 -lemma zmod_number_of_Bit1 [simp]:
  24.260 -     "number_of (Int.Bit1 v) mod number_of (Int.Bit0 w) =  
  24.261 -      (if (0::int) \<le> number_of w  
  24.262 -                then 2 * (number_of v mod number_of w) + 1     
  24.263 -                else 2 * ((number_of v + (1::int)) mod number_of w) - 1)"
  24.264 -apply (simp only: number_of_eq numeral_simps) 
  24.265 -apply (simp add: mod_mult_mult1 pos_zmod_mult_2 
  24.266 -                 neg_zmod_mult_2 add_ac mult_2 [symmetric])
  24.267 -done
  24.268 -
  24.269 +(* FIXME: add rules for negative numerals *)
  24.270 +lemma zmod_numeral_Bit0 [simp]:
  24.271 +  "numeral (Num.Bit0 v) mod numeral (Num.Bit0 w) =  
  24.272 +    (2::int) * (numeral v mod numeral w)"
  24.273 +  unfolding numeral_Bit0 [of v] numeral_Bit0 [of w]
  24.274 +  unfolding mult_2 [symmetric] by (rule mod_mult_mult1)
  24.275 +
  24.276 +lemma zmod_numeral_Bit1 [simp]:
  24.277 +  "numeral (Num.Bit1 v) mod numeral (Num.Bit0 w) =
  24.278 +    2 * (numeral v mod numeral w) + (1::int)"
  24.279 +  unfolding numeral_Bit1 [of v] numeral_Bit0 [of w]
  24.280 +  unfolding mult_2 [symmetric] add_commute [of _ 1]
  24.281 +  by (rule pos_zmod_mult_2, simp)
  24.282  
  24.283  lemma zdiv_eq_0_iff:
  24.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")
  24.285 @@ -2233,8 +2275,11 @@
  24.286  
  24.287  subsubsection {* The Divides Relation *}
  24.288  
  24.289 -lemmas zdvd_iff_zmod_eq_0_number_of [simp] =
  24.290 -  dvd_eq_mod_eq_0 [of "number_of x" "number_of y"] for x y :: int
  24.291 +lemmas zdvd_iff_zmod_eq_0_numeral [simp] =
  24.292 +  dvd_eq_mod_eq_0 [of "numeral x::int" "numeral y::int"]
  24.293 +  dvd_eq_mod_eq_0 [of "numeral x::int" "neg_numeral y::int"]
  24.294 +  dvd_eq_mod_eq_0 [of "neg_numeral x::int" "numeral y::int"]
  24.295 +  dvd_eq_mod_eq_0 [of "neg_numeral x::int" "neg_numeral y::int"] for x y
  24.296  
  24.297  lemma zdvd_zmod: "f dvd m ==> f dvd (n::int) ==> f dvd m mod n"
  24.298    by (rule dvd_mod) (* TODO: remove *)
  24.299 @@ -2242,6 +2287,12 @@
  24.300  lemma zdvd_zmod_imp_zdvd: "k dvd m mod n ==> k dvd n ==> k dvd (m::int)"
  24.301    by (rule dvd_mod_imp_dvd) (* TODO: remove *)
  24.302  
  24.303 +lemmas dvd_eq_mod_eq_0_numeral [simp] =
  24.304 +  dvd_eq_mod_eq_0 [of "numeral x" "numeral y"] for x y
  24.305 +
  24.306 +
  24.307 +subsubsection {* Further properties *}
  24.308 +
  24.309  lemma zmult_div_cancel: "(n::int) * (m div n) = m - (m mod n)"
  24.310    using zmod_zdiv_equality[where a="m" and b="n"]
  24.311    by (simp add: algebra_simps)
  24.312 @@ -2408,42 +2459,31 @@
  24.313    thus  ?lhs by simp
  24.314  qed
  24.315  
  24.316 -lemma div_nat_number_of [simp]:
  24.317 -     "(number_of v :: nat)  div  number_of v' =  
  24.318 -          (if neg (number_of v :: int) then 0  
  24.319 -           else nat (number_of v div number_of v'))"
  24.320 -  unfolding nat_number_of_def number_of_is_id neg_def
  24.321 +lemma div_nat_numeral [simp]:
  24.322 +  "(numeral v :: nat) div numeral v' = nat (numeral v div numeral v')"
  24.323    by (simp add: nat_div_distrib)
  24.324  
  24.325 -lemma one_div_nat_number_of [simp]:
  24.326 -     "Suc 0 div number_of v' = nat (1 div number_of v')" 
  24.327 -  by (simp del: semiring_numeral_1_eq_1 add: numeral_1_eq_Suc_0 [symmetric] semiring_numeral_1_eq_1 [symmetric]) 
  24.328 -
  24.329 -lemma mod_nat_number_of [simp]:
  24.330 -     "(number_of v :: nat)  mod  number_of v' =  
  24.331 -        (if neg (number_of v :: int) then 0  
  24.332 -         else if neg (number_of v' :: int) then number_of v  
  24.333 -         else nat (number_of v mod number_of v'))"
  24.334 -  unfolding nat_number_of_def number_of_is_id neg_def
  24.335 +lemma one_div_nat_numeral [simp]:
  24.336 +  "Suc 0 div numeral v' = nat (1 div numeral v')"
  24.337 +  by (subst nat_div_distrib, simp_all)
  24.338 +
  24.339 +lemma mod_nat_numeral [simp]:
  24.340 +  "(numeral v :: nat) mod numeral v' = nat (numeral v mod numeral v')"
  24.341    by (simp add: nat_mod_distrib)
  24.342  
  24.343 -lemma one_mod_nat_number_of [simp]:
  24.344 -     "Suc 0 mod number_of v' =  
  24.345 -        (if neg (number_of v' :: int) then Suc 0
  24.346 -         else nat (1 mod number_of v'))"
  24.347 -by (simp del: semiring_numeral_1_eq_1 add: numeral_1_eq_Suc_0 [symmetric] semiring_numeral_1_eq_1 [symmetric]) 
  24.348 -
  24.349 -lemmas dvd_eq_mod_eq_0_number_of [simp] =
  24.350 -  dvd_eq_mod_eq_0 [of "number_of x" "number_of y"] for x y
  24.351 -
  24.352 -
  24.353 -subsubsection {* Nitpick *}
  24.354 -
  24.355 -lemma zmod_zdiv_equality':
  24.356 -"(m\<Colon>int) mod n = m - (m div n) * n"
  24.357 -by (rule_tac P="%x. m mod n = x - (m div n) * n"
  24.358 -    in subst [OF mod_div_equality [of _ n]])
  24.359 -   arith
  24.360 +lemma one_mod_nat_numeral [simp]:
  24.361 +  "Suc 0 mod numeral v' = nat (1 mod numeral v')"
  24.362 +  by (subst nat_mod_distrib) simp_all
  24.363 +
  24.364 +lemma mod_2_not_eq_zero_eq_one_int:
  24.365 +  fixes k :: int
  24.366 +  shows "k mod 2 \<noteq> 0 \<longleftrightarrow> k mod 2 = 1"
  24.367 +  by auto
  24.368 +
  24.369 +
  24.370 +subsubsection {* Tools setup *}
  24.371 +
  24.372 +text {* Nitpick *}
  24.373  
  24.374  lemmas [nitpick_unfold] = dvd_eq_mod_eq_0 mod_div_equality' zmod_zdiv_equality'
  24.375  
  24.376 @@ -2461,7 +2501,7 @@
  24.377    apsnd ((op *) (sgn l)) (if 0 < l \<and> 0 \<le> k \<or> l < 0 \<and> k < 0
  24.378      then pdivmod k l
  24.379      else (let (r, s) = pdivmod k l in
  24.380 -      if s = 0 then (- r, 0) else (- r - 1, \<bar>l\<bar> - s))))"
  24.381 +       if s = 0 then (- r, 0) else (- r - 1, \<bar>l\<bar> - s))))"
  24.382  proof -
  24.383    have aux: "\<And>q::int. - k = l * q \<longleftrightarrow> k = l * - q" by auto
  24.384    show ?thesis
  24.385 @@ -2481,45 +2521,6 @@
  24.386    then show ?thesis by (simp add: divmod_int_pdivmod)
  24.387  qed
  24.388  
  24.389 -context ring_1
  24.390 -begin
  24.391 -
  24.392 -lemma of_int_num [code]:
  24.393 -  "of_int k = (if k = 0 then 0 else if k < 0 then
  24.394 -     - of_int (- k) else let
  24.395 -       (l, m) = divmod_int k 2;
  24.396 -       l' = of_int l
  24.397 -     in if m = 0 then l' + l' else l' + l' + 1)"
  24.398 -proof -
  24.399 -  have aux1: "k mod (2\<Colon>int) \<noteq> (0\<Colon>int) \<Longrightarrow> 
  24.400 -    of_int k = of_int (k div 2 * 2 + 1)"
  24.401 -  proof -
  24.402 -    have "k mod 2 < 2" by (auto intro: pos_mod_bound)
  24.403 -    moreover have "0 \<le> k mod 2" by (auto intro: pos_mod_sign)
  24.404 -    moreover assume "k mod 2 \<noteq> 0"
  24.405 -    ultimately have "k mod 2 = 1" by arith
  24.406 -    moreover have "of_int k = of_int (k div 2 * 2 + k mod 2)" by simp
  24.407 -    ultimately show ?thesis by auto
  24.408 -  qed
  24.409 -  have aux2: "\<And>x. of_int 2 * x = x + x"
  24.410 -  proof -
  24.411 -    fix x
  24.412 -    have int2: "(2::int) = 1 + 1" by arith
  24.413 -    show "of_int 2 * x = x + x"
  24.414 -    unfolding int2 of_int_add left_distrib by simp
  24.415 -  qed
  24.416 -  have aux3: "\<And>x. x * of_int 2 = x + x"
  24.417 -  proof -
  24.418 -    fix x
  24.419 -    have int2: "(2::int) = 1 + 1" by arith
  24.420 -    show "x * of_int 2 = x + x" 
  24.421 -    unfolding int2 of_int_add right_distrib by simp
  24.422 -  qed
  24.423 -  from aux1 show ?thesis by (auto simp add: divmod_int_mod_div Let_def aux2 aux3)
  24.424 -qed
  24.425 -
  24.426 -end
  24.427 -
  24.428  code_modulename SML
  24.429    Divides Arith
  24.430  
    25.1 --- a/src/HOL/HOLCF/Tools/fixrec.ML	Mon Mar 26 15:32:54 2012 +0200
    25.2 +++ b/src/HOL/HOLCF/Tools/fixrec.ML	Mon Mar 26 15:33:28 2012 +0200
    25.3 @@ -399,7 +399,7 @@
    25.4  
    25.5  val alt_specs' : (bool * (Attrib.binding * string)) list parser =
    25.6    let val unexpected = Scan.ahead (Parse.name || @{keyword "["} || @{keyword "("})
    25.7 -  in Parse.enum1 "|" (spec' --| Scan.option (unexpected -- Parse.!!! (@{keyword "|"}))) end
    25.8 +  in Parse.enum1 "|" (spec' --| Scan.option (unexpected -- Parse.!!! @{keyword "|"})) end
    25.9  
   25.10  val _ =
   25.11    Outer_Syntax.local_theory @{command_spec "fixrec"} "define recursive functions (HOLCF)"
    26.1 --- a/src/HOL/Imperative_HOL/ex/Imperative_Quicksort.thy	Mon Mar 26 15:32:54 2012 +0200
    26.2 +++ b/src/HOL/Imperative_HOL/ex/Imperative_Quicksort.thy	Mon Mar 26 15:33:28 2012 +0200
    26.3 @@ -6,7 +6,7 @@
    26.4  
    26.5  theory Imperative_Quicksort
    26.6  imports
    26.7 -  Imperative_HOL
    26.8 +  "~~/src/HOL/Imperative_HOL/Imperative_HOL"
    26.9    Subarray
   26.10    "~~/src/HOL/Library/Multiset"
   26.11    "~~/src/HOL/Library/Efficient_Nat"
   26.12 @@ -593,8 +593,8 @@
   26.13  proof (induct a l r p arbitrary: h rule: part1.induct)
   26.14    case (1 a l r p)
   26.15    thus ?case unfolding part1.simps [of a l r]
   26.16 -  apply (auto intro!: success_intros del: success_ifI simp add: not_le)
   26.17 -  apply (auto intro!: effect_intros effect_swapI)
   26.18 +  apply (auto intro!: success_intros simp add: not_le)
   26.19 +  apply (auto intro!: effect_intros)
   26.20    done
   26.21  qed
   26.22  
    27.1 --- a/src/HOL/Imperative_HOL/ex/Imperative_Reverse.thy	Mon Mar 26 15:32:54 2012 +0200
    27.2 +++ b/src/HOL/Imperative_HOL/ex/Imperative_Reverse.thy	Mon Mar 26 15:33:28 2012 +0200
    27.3 @@ -5,7 +5,7 @@
    27.4  header {* An imperative in-place reversal on arrays *}
    27.5  
    27.6  theory Imperative_Reverse
    27.7 -imports Subarray Imperative_HOL
    27.8 +imports Subarray "~~/src/HOL/Imperative_HOL/Imperative_HOL"
    27.9  begin
   27.10  
   27.11  fun swap :: "'a\<Colon>heap array \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> unit Heap" where
   27.12 @@ -107,7 +107,7 @@
   27.13    shows "Array.get h' a = List.rev (Array.get h a)"
   27.14    using rev2_rev'[OF assms] rev_length[OF assms] assms
   27.15      by (cases "Array.length h a = 0", auto simp add: Array.length_def
   27.16 -      subarray_def sublist'_all rev.simps[where j=0] elim!: effect_elims)
   27.17 +      subarray_def rev.simps[where j=0] elim!: effect_elims)
   27.18    (drule sym[of "List.length (Array.get h a)"], simp)
   27.19  
   27.20  definition "example = (Array.make 10 id \<guillemotright>= (\<lambda>a. rev a 0 9))"
   27.21 @@ -115,3 +115,4 @@
   27.22  export_code example checking SML SML_imp OCaml? OCaml_imp? Haskell? Scala? Scala_imp?
   27.23  
   27.24  end
   27.25 +
    28.1 --- a/src/HOL/Imperative_HOL/ex/SatChecker.thy	Mon Mar 26 15:32:54 2012 +0200
    28.2 +++ b/src/HOL/Imperative_HOL/ex/SatChecker.thy	Mon Mar 26 15:33:28 2012 +0200
    28.3 @@ -702,15 +702,7 @@
    28.4                  else raise(''No empty clause''))
    28.5    }"
    28.6  
    28.7 -section {* Code generation setup *}
    28.8 -
    28.9 -code_type ProofStep
   28.10 -  (SML "MinisatProofStep.ProofStep")
   28.11 -
   28.12 -code_const ProofDone and Root and Conflict and Delete and Xstep
   28.13 -  (SML "MinisatProofStep.ProofDone" and "MinisatProofStep.Root ((_),/ (_))" and "MinisatProofStep.Conflict ((_),/ (_))" and "MinisatProofStep.Delete" and "MinisatProofStep.Xstep ((_),/ (_))")
   28.14 -
   28.15 -export_code checker tchecker lchecker in SML
   28.16 +export_code checker tchecker lchecker checking SML
   28.17  
   28.18  end
   28.19  
    29.1 --- a/src/HOL/Imperative_HOL/ex/Subarray.thy	Mon Mar 26 15:32:54 2012 +0200
    29.2 +++ b/src/HOL/Imperative_HOL/ex/Subarray.thy	Mon Mar 26 15:33:28 2012 +0200
    29.3 @@ -5,7 +5,7 @@
    29.4  header {* Theorems about sub arrays *}
    29.5  
    29.6  theory Subarray
    29.7 -imports Array Sublist
    29.8 +imports "~~/src/HOL/Imperative_HOL/Array" Sublist
    29.9  begin
   29.10  
   29.11  definition subarray :: "nat \<Rightarrow> nat \<Rightarrow> ('a::heap) array \<Rightarrow> heap \<Rightarrow> 'a list" where
    30.1 --- a/src/HOL/Import/HOL_Light/HOLLightInt.thy	Mon Mar 26 15:32:54 2012 +0200
    30.2 +++ b/src/HOL/Import/HOL_Light/HOLLightInt.thy	Mon Mar 26 15:33:28 2012 +0200
    30.3 @@ -40,7 +40,7 @@
    30.4  
    30.5  lemma DEF_int_mul:
    30.6    "op * = (\<lambda>u ua. floor (real u * real ua))"
    30.7 -  by (metis floor_number_of number_of_is_id number_of_real_def real_eq_of_int real_of_int_mult)
    30.8 +  by (metis floor_real_of_int real_of_int_mult)
    30.9  
   30.10  lemma DEF_int_abs:
   30.11    "abs = (\<lambda>u. floor (abs (real u)))"
   30.12 @@ -72,7 +72,7 @@
   30.13  
   30.14  lemma INT_IMAGE:
   30.15    "(\<exists>n. x = int n) \<or> (\<exists>n. x = - int n)"
   30.16 -  by (metis number_of_eq number_of_is_id of_int_of_nat)
   30.17 +  by (metis of_int_eq_id id_def of_int_of_nat)
   30.18  
   30.19  lemma DEF_int_pow:
   30.20    "op ^ = (\<lambda>u ua. floor (real u ^ ua))"
    31.1 --- a/src/HOL/Int.thy	Mon Mar 26 15:32:54 2012 +0200
    31.2 +++ b/src/HOL/Int.thy	Mon Mar 26 15:33:28 2012 +0200
    31.3 @@ -6,10 +6,9 @@
    31.4  header {* The Integers as Equivalence Classes over Pairs of Natural Numbers *} 
    31.5  
    31.6  theory Int
    31.7 -imports Equiv_Relations Nat Wellfounded
    31.8 +imports Equiv_Relations Wellfounded
    31.9  uses
   31.10    ("Tools/numeral.ML")
   31.11 -  ("Tools/numeral_syntax.ML")
   31.12    ("Tools/int_arith.ML")
   31.13  begin
   31.14  
   31.15 @@ -323,15 +322,20 @@
   31.16  lemma of_int_of_nat_eq [simp]: "of_int (int n) = of_nat n"
   31.17  by (induct n) auto
   31.18  
   31.19 +lemma of_int_numeral [simp, code_post]: "of_int (numeral k) = numeral k"
   31.20 +  by (simp add: of_nat_numeral [symmetric] of_int_of_nat_eq [symmetric])
   31.21 +
   31.22 +lemma of_int_neg_numeral [simp, code_post]: "of_int (neg_numeral k) = neg_numeral k"
   31.23 +  unfolding neg_numeral_def neg_numeral_class.neg_numeral_def
   31.24 +  by (simp only: of_int_minus of_int_numeral)
   31.25 +
   31.26  lemma of_int_power:
   31.27    "of_int (z ^ n) = of_int z ^ n"
   31.28    by (induct n) simp_all
   31.29  
   31.30  end
   31.31  
   31.32 -text{*Class for unital rings with characteristic zero.
   31.33 - Includes non-ordered rings like the complex numbers.*}
   31.34 -class ring_char_0 = ring_1 + semiring_char_0
   31.35 +context ring_char_0
   31.36  begin
   31.37  
   31.38  lemma of_int_eq_iff [simp]:
   31.39 @@ -579,230 +583,27 @@
   31.40  apply (simp add: int_def minus add diff_minus)
   31.41  done
   31.42  
   31.43 -
   31.44 -subsection {* Binary representation *}
   31.45 -
   31.46 -text {*
   31.47 -  This formalization defines binary arithmetic in terms of the integers
   31.48 -  rather than using a datatype. This avoids multiple representations (leading
   31.49 -  zeroes, etc.)  See @{text "ZF/Tools/twos-compl.ML"}, function @{text
   31.50 -  int_of_binary}, for the numerical interpretation.
   31.51 -
   31.52 -  The representation expects that @{text "(m mod 2)"} is 0 or 1,
   31.53 -  even if m is negative;
   31.54 -  For instance, @{text "-5 div 2 = -3"} and @{text "-5 mod 2 = 1"}; thus
   31.55 -  @{text "-5 = (-3)*2 + 1"}.
   31.56 -  
   31.57 -  This two's complement binary representation derives from the paper 
   31.58 -  "An Efficient Representation of Arithmetic for Term Rewriting" by
   31.59 -  Dave Cohen and Phil Watson, Rewriting Techniques and Applications,
   31.60 -  Springer LNCS 488 (240-251), 1991.
   31.61 -*}
   31.62 -
   31.63 -subsubsection {* The constructors @{term Bit0}, @{term Bit1}, @{term Pls} and @{term Min} *}
   31.64 -
   31.65 -definition Pls :: int where
   31.66 -  "Pls = 0"
   31.67 +lemma Let_numeral [simp]: "Let (numeral v) f = f (numeral v)"
   31.68 +  -- {* Unfold all @{text let}s involving constants *}
   31.69 +  unfolding Let_def ..
   31.70  
   31.71 -definition Min :: int where
   31.72 -  "Min = - 1"
   31.73 -
   31.74 -definition Bit0 :: "int \<Rightarrow> int" where
   31.75 -  "Bit0 k = k + k"
   31.76 -
   31.77 -definition Bit1 :: "int \<Rightarrow> int" where
   31.78 -  "Bit1 k = 1 + k + k"
   31.79 -
   31.80 -class number = -- {* for numeric types: nat, int, real, \dots *}
   31.81 -  fixes number_of :: "int \<Rightarrow> 'a"
   31.82 -
   31.83 -use "Tools/numeral.ML"
   31.84 -
   31.85 -syntax
   31.86 -  "_Numeral" :: "num_const \<Rightarrow> 'a"    ("_")
   31.87 -
   31.88 -use "Tools/numeral_syntax.ML"
   31.89 -setup Numeral_Syntax.setup
   31.90 -
   31.91 -abbreviation
   31.92 -  "Numeral0 \<equiv> number_of Pls"
   31.93 -
   31.94 -abbreviation
   31.95 -  "Numeral1 \<equiv> number_of (Bit1 Pls)"
   31.96 -
   31.97 -lemma Let_number_of [simp]: "Let (number_of v) f = f (number_of v)"
   31.98 +lemma Let_neg_numeral [simp]: "Let (neg_numeral v) f = f (neg_numeral v)"
   31.99    -- {* Unfold all @{text let}s involving constants *}
  31.100    unfolding Let_def ..
  31.101  
  31.102 -definition succ :: "int \<Rightarrow> int" where
  31.103 -  "succ k = k + 1"
  31.104 -
  31.105 -definition pred :: "int \<Rightarrow> int" where
  31.106 -  "pred k = k - 1"
  31.107 -
  31.108 -lemmas max_number_of [simp] = max_def [of "number_of u" "number_of v"]
  31.109 -  and min_number_of [simp] = min_def [of "number_of u" "number_of v"]
  31.110 -  for u v
  31.111 -  -- {* unfolding @{text minx} and @{text max} on numerals *}
  31.112 -
  31.113 -lemmas numeral_simps = 
  31.114 -  succ_def pred_def Pls_def Min_def Bit0_def Bit1_def
  31.115 -
  31.116 -text {* Removal of leading zeroes *}
  31.117 -
  31.118 -lemma Bit0_Pls [simp, code_post]:
  31.119 -  "Bit0 Pls = Pls"
  31.120 -  unfolding numeral_simps by simp
  31.121 -
  31.122 -lemma Bit1_Min [simp, code_post]:
  31.123 -  "Bit1 Min = Min"
  31.124 -  unfolding numeral_simps by simp
  31.125 -
  31.126 -lemmas normalize_bin_simps =
  31.127 -  Bit0_Pls Bit1_Min
  31.128 -
  31.129 -
  31.130 -subsubsection {* Successor and predecessor functions *}
  31.131 -
  31.132 -text {* Successor *}
  31.133 -
  31.134 -lemma succ_Pls:
  31.135 -  "succ Pls = Bit1 Pls"
  31.136 -  unfolding numeral_simps by simp
  31.137 -
  31.138 -lemma succ_Min:
  31.139 -  "succ Min = Pls"
  31.140 -  unfolding numeral_simps by simp
  31.141 -
  31.142 -lemma succ_Bit0:
  31.143 -  "succ (Bit0 k) = Bit1 k"
  31.144 -  unfolding numeral_simps by simp
  31.145 -
  31.146 -lemma succ_Bit1:
  31.147 -  "succ (Bit1 k) = Bit0 (succ k)"
  31.148 -  unfolding numeral_simps by simp
  31.149 -
  31.150 -lemmas succ_bin_simps [simp] =
  31.151 -  succ_Pls succ_Min succ_Bit0 succ_Bit1
  31.152 -
  31.153 -text {* Predecessor *}
  31.154 -
  31.155 -lemma pred_Pls:
  31.156 -  "pred Pls = Min"
  31.157 -  unfolding numeral_simps by simp
  31.158 -
  31.159 -lemma pred_Min:
  31.160 -  "pred Min = Bit0 Min"
  31.161 -  unfolding numeral_simps by simp
  31.162 -
  31.163 -lemma pred_Bit0:
  31.164 -  "pred (Bit0 k) = Bit1 (pred k)"
  31.165 -  unfolding numeral_simps by simp 
  31.166 -
  31.167 -lemma pred_Bit1:
  31.168 -  "pred (Bit1 k) = Bit0 k"
  31.169 -  unfolding numeral_simps by simp
  31.170 -
  31.171 -lemmas pred_bin_simps [simp] =
  31.172 -  pred_Pls pred_Min pred_Bit0 pred_Bit1
  31.173 -
  31.174 -
  31.175 -subsubsection {* Binary arithmetic *}
  31.176 -
  31.177 -text {* Addition *}
  31.178 -
  31.179 -lemma add_Pls:
  31.180 -  "Pls + k = k"
  31.181 -  unfolding numeral_simps by simp
  31.182 -
  31.183 -lemma add_Min:
  31.184 -  "Min + k = pred k"
  31.185 -  unfolding numeral_simps by simp
  31.186 +text {* Unfold @{text min} and @{text max} on numerals. *}
  31.187  
  31.188 -lemma add_Bit0_Bit0:
  31.189 -  "(Bit0 k) + (Bit0 l) = Bit0 (k + l)"
  31.190 -  unfolding numeral_simps by simp
  31.191 -
  31.192 -lemma add_Bit0_Bit1:
  31.193 -  "(Bit0 k) + (Bit1 l) = Bit1 (k + l)"
  31.194 -  unfolding numeral_simps by simp
  31.195 -
  31.196 -lemma add_Bit1_Bit0:
  31.197 -  "(Bit1 k) + (Bit0 l) = Bit1 (k + l)"
  31.198 -  unfolding numeral_simps by simp
  31.199 -
  31.200 -lemma add_Bit1_Bit1:
  31.201 -  "(Bit1 k) + (Bit1 l) = Bit0 (k + succ l)"
  31.202 -  unfolding numeral_simps by simp
  31.203 -
  31.204 -lemma add_Pls_right:
  31.205 -  "k + Pls = k"
  31.206 -  unfolding numeral_simps by simp
  31.207 -
  31.208 -lemma add_Min_right:
  31.209 -  "k + Min = pred k"
  31.210 -  unfolding numeral_simps by simp
  31.211 -
  31.212 -lemmas add_bin_simps [simp] =
  31.213 -  add_Pls add_Min add_Pls_right add_Min_right
  31.214 -  add_Bit0_Bit0 add_Bit0_Bit1 add_Bit1_Bit0 add_Bit1_Bit1
  31.215 -
  31.216 -text {* Negation *}
  31.217 -
  31.218 -lemma minus_Pls:
  31.219 -  "- Pls = Pls"
  31.220 -  unfolding numeral_simps by simp
  31.221 -
  31.222 -lemma minus_Min:
  31.223 -  "- Min = Bit1 Pls"
  31.224 -  unfolding numeral_simps by simp
  31.225 -
  31.226 -lemma minus_Bit0:
  31.227 -  "- (Bit0 k) = Bit0 (- k)"
  31.228 -  unfolding numeral_simps by simp
  31.229 +lemmas max_number_of [simp] =
  31.230 +  max_def [of "numeral u" "numeral v"]
  31.231 +  max_def [of "numeral u" "neg_numeral v"]
  31.232 +  max_def [of "neg_numeral u" "numeral v"]
  31.233 +  max_def [of "neg_numeral u" "neg_numeral v"] for u v
  31.234  
  31.235 -lemma minus_Bit1:
  31.236 -  "- (Bit1 k) = Bit1 (pred (- k))"
  31.237 -  unfolding numeral_simps by simp
  31.238 -
  31.239 -lemmas minus_bin_simps [simp] =
  31.240 -  minus_Pls minus_Min minus_Bit0 minus_Bit1
  31.241 -
  31.242 -text {* Subtraction *}
  31.243 -
  31.244 -lemma diff_bin_simps [simp]:
  31.245 -  "k - Pls = k"
  31.246 -  "k - Min = succ k"
  31.247 -  "Pls - (Bit0 l) = Bit0 (Pls - l)"
  31.248 -  "Pls - (Bit1 l) = Bit1 (Min - l)"
  31.249 -  "Min - (Bit0 l) = Bit1 (Min - l)"
  31.250 -  "Min - (Bit1 l) = Bit0 (Min - l)"
  31.251 -  "(Bit0 k) - (Bit0 l) = Bit0 (k - l)"
  31.252 -  "(Bit0 k) - (Bit1 l) = Bit1 (pred k - l)"
  31.253 -  "(Bit1 k) - (Bit0 l) = Bit1 (k - l)"
  31.254 -  "(Bit1 k) - (Bit1 l) = Bit0 (k - l)"
  31.255 -  unfolding numeral_simps by simp_all
  31.256 -
  31.257 -text {* Multiplication *}
  31.258 -
  31.259 -lemma mult_Pls:
  31.260 -  "Pls * w = Pls"
  31.261 -  unfolding numeral_simps by simp
  31.262 -
  31.263 -lemma mult_Min:
  31.264 -  "Min * k = - k"
  31.265 -  unfolding numeral_simps by simp
  31.266 -
  31.267 -lemma mult_Bit0:
  31.268 -  "(Bit0 k) * l = Bit0 (k * l)"
  31.269 -  unfolding numeral_simps int_distrib by simp
  31.270 -
  31.271 -lemma mult_Bit1:
  31.272 -  "(Bit1 k) * l = (Bit0 (k * l)) + l"
  31.273 -  unfolding numeral_simps int_distrib by simp
  31.274 -
  31.275 -lemmas mult_bin_simps [simp] =
  31.276 -  mult_Pls mult_Min mult_Bit0 mult_Bit1
  31.277 +lemmas min_number_of [simp] =
  31.278 +  min_def [of "numeral u" "numeral v"]
  31.279 +  min_def [of "numeral u" "neg_numeral v"]
  31.280 +  min_def [of "neg_numeral u" "numeral v"]
  31.281 +  min_def [of "neg_numeral u" "neg_numeral v"] for u v
  31.282  
  31.283  
  31.284  subsubsection {* Binary comparisons *}
  31.285 @@ -812,7 +613,7 @@
  31.286  lemma even_less_0_iff:
  31.287    "a + a < 0 \<longleftrightarrow> a < (0::'a::linordered_idom)"
  31.288  proof -
  31.289 -  have "a + a < 0 \<longleftrightarrow> (1+1)*a < 0" by (simp add: left_distrib)
  31.290 +  have "a + a < 0 \<longleftrightarrow> (1+1)*a < 0" by (simp add: left_distrib del: one_add_one)
  31.291    also have "(1+1)*a < 0 \<longleftrightarrow> a < 0"
  31.292      by (simp add: mult_less_0_iff zero_less_two 
  31.293                    order_less_not_sym [OF zero_less_two])
  31.294 @@ -824,7 +625,7 @@
  31.295    shows "(0::int) < 1 + z"
  31.296  proof -
  31.297    have "0 \<le> z" by fact
  31.298 -  also have "... < z + 1" by (rule less_add_one) 
  31.299 +  also have "... < z + 1" by (rule less_add_one)
  31.300    also have "... = 1 + z" by (simp add: add_ac)
  31.301    finally show "0 < 1 + z" .
  31.302  qed
  31.303 @@ -841,276 +642,6 @@
  31.304      add: algebra_simps of_nat_1 [where 'a=int, symmetric] of_nat_add [symmetric])
  31.305  qed
  31.306  
  31.307 -lemma bin_less_0_simps:
  31.308 -  "Pls < 0 \<longleftrightarrow> False"
  31.309 -  "Min < 0 \<longleftrightarrow> True"
  31.310 -  "Bit0 w < 0 \<longleftrightarrow> w < 0"
  31.311 -  "Bit1 w < 0 \<longleftrightarrow> w < 0"
  31.312 -  unfolding numeral_simps
  31.313 -  by (simp_all add: even_less_0_iff odd_less_0_iff)
  31.314 -
  31.315 -lemma less_bin_lemma: "k < l \<longleftrightarrow> k - l < (0::int)"
  31.316 -  by simp
  31.317 -
  31.318 -lemma le_iff_pred_less: "k \<le> l \<longleftrightarrow> pred k < l"
  31.319 -  unfolding numeral_simps
  31.320 -  proof
  31.321 -    have "k - 1 < k" by simp
  31.322 -    also assume "k \<le> l"
  31.323 -    finally show "k - 1 < l" .
  31.324 -  next
  31.325 -    assume "k - 1 < l"
  31.326 -    hence "(k - 1) + 1 \<le> l" by (rule zless_imp_add1_zle)
  31.327 -    thus "k \<le> l" by simp
  31.328 -  qed
  31.329 -
  31.330 -lemma succ_pred: "succ (pred x) = x"
  31.331 -  unfolding numeral_simps by simp
  31.332 -
  31.333 -text {* Less-than *}
  31.334 -
  31.335 -lemma less_bin_simps [simp]:
  31.336 -  "Pls < Pls \<longleftrightarrow> False"
  31.337 -  "Pls < Min \<longleftrightarrow> False"
  31.338 -  "Pls < Bit0 k \<longleftrightarrow> Pls < k"
  31.339 -  "Pls < Bit1 k \<longleftrightarrow> Pls \<le> k"
  31.340 -  "Min < Pls \<longleftrightarrow> True"
  31.341 -  "Min < Min \<longleftrightarrow> False"
  31.342 -  "Min < Bit0 k \<longleftrightarrow> Min < k"
  31.343 -  "Min < Bit1 k \<longleftrightarrow> Min < k"
  31.344 -  "Bit0 k < Pls \<longleftrightarrow> k < Pls"
  31.345 -  "Bit0 k < Min \<longleftrightarrow> k \<le> Min"
  31.346 -  "Bit1 k < Pls \<longleftrightarrow> k < Pls"
  31.347 -  "Bit1 k < Min \<longleftrightarrow> k < Min"
  31.348 -  "Bit0 k < Bit0 l \<longleftrightarrow> k < l"
  31.349 -  "Bit0 k < Bit1 l \<longleftrightarrow> k \<le> l"
  31.350 -  "Bit1 k < Bit0 l \<longleftrightarrow> k < l"
  31.351 -  "Bit1 k < Bit1 l \<longleftrightarrow> k < l"
  31.352 -  unfolding le_iff_pred_less
  31.353 -    less_bin_lemma [of Pls]
  31.354 -    less_bin_lemma [of Min]
  31.355 -    less_bin_lemma [of "k"]
  31.356 -    less_bin_lemma [of "Bit0 k"]
  31.357 -    less_bin_lemma [of "Bit1 k"]
  31.358 -    less_bin_lemma [of "pred Pls"]
  31.359 -    less_bin_lemma [of "pred k"]
  31.360 -  by (simp_all add: bin_less_0_simps succ_pred)
  31.361 -
  31.362 -text {* Less-than-or-equal *}
  31.363 -
  31.364 -lemma le_bin_simps [simp]:
  31.365 -  "Pls \<le> Pls \<longleftrightarrow> True"
  31.366 -  "Pls \<le> Min \<longleftrightarrow> False"
  31.367 -  "Pls \<le> Bit0 k \<longleftrightarrow> Pls \<le> k"
  31.368 -  "Pls \<le> Bit1 k \<longleftrightarrow> Pls \<le> k"
  31.369 -  "Min \<le> Pls \<longleftrightarrow> True"
  31.370 -  "Min \<le> Min \<longleftrightarrow> True"
  31.371 -  "Min \<le> Bit0 k \<longleftrightarrow> Min < k"
  31.372 -  "Min \<le> Bit1 k \<longleftrightarrow> Min \<le> k"
  31.373 -  "Bit0 k \<le> Pls \<longleftrightarrow> k \<le> Pls"
  31.374 -  "Bit0 k \<le> Min \<longleftrightarrow> k \<le> Min"
  31.375 -  "Bit1 k \<le> Pls \<longleftrightarrow> k < Pls"
  31.376 -  "Bit1 k \<le> Min \<longleftrightarrow> k \<le> Min"
  31.377 -  "Bit0 k \<le> Bit0 l \<longleftrightarrow> k \<le> l"
  31.378 -  "Bit0 k \<le> Bit1 l \<longleftrightarrow> k \<le> l"
  31.379 -  "Bit1 k \<le> Bit0 l \<longleftrightarrow> k < l"
  31.380 -  "Bit1 k \<le> Bit1 l \<longleftrightarrow> k \<le> l"
  31.381 -  unfolding not_less [symmetric]
  31.382 -  by (simp_all add: not_le)
  31.383 -
  31.384 -text {* Equality *}
  31.385 -
  31.386 -lemma eq_bin_simps [simp]:
  31.387 -  "Pls = Pls \<longleftrightarrow> True"
  31.388 -  "Pls = Min \<longleftrightarrow> False"
  31.389 -  "Pls = Bit0 l \<longleftrightarrow> Pls = l"
  31.390 -  "Pls = Bit1 l \<longleftrightarrow> False"
  31.391 -  "Min = Pls \<longleftrightarrow> False"
  31.392 -  "Min = Min \<longleftrightarrow> True"
  31.393 -  "Min = Bit0 l \<longleftrightarrow> False"
  31.394 -  "Min = Bit1 l \<longleftrightarrow> Min = l"
  31.395 -  "Bit0 k = Pls \<longleftrightarrow> k = Pls"
  31.396 -  "Bit0 k = Min \<longleftrightarrow> False"
  31.397 -  "Bit1 k = Pls \<longleftrightarrow> False"
  31.398 -  "Bit1 k = Min \<longleftrightarrow> k = Min"
  31.399 -  "Bit0 k = Bit0 l \<longleftrightarrow> k = l"
  31.400 -  "Bit0 k = Bit1 l \<longleftrightarrow> False"
  31.401 -  "Bit1 k = Bit0 l \<longleftrightarrow> False"
  31.402 -  "Bit1 k = Bit1 l \<longleftrightarrow> k = l"
  31.403 -  unfolding order_eq_iff [where 'a=int]
  31.404 -  by (simp_all add: not_less)
  31.405 -
  31.406 -
  31.407 -subsection {* Converting Numerals to Rings: @{term number_of} *}
  31.408 -
  31.409 -class number_ring = number + comm_ring_1 +
  31.410 -  assumes number_of_eq: "number_of k = of_int k"
  31.411 -
  31.412 -class number_semiring = number + comm_semiring_1 +
  31.413 -  assumes number_of_int: "number_of (int n) = of_nat n"
  31.414 -
  31.415 -instance number_ring \<subseteq> number_semiring
  31.416 -proof
  31.417 -  fix n show "number_of (int n) = (of_nat n :: 'a)"
  31.418 -    unfolding number_of_eq by (rule of_int_of_nat_eq)
  31.419 -qed
  31.420 -
  31.421 -text {* self-embedding of the integers *}
  31.422 -
  31.423 -instantiation int :: number_ring
  31.424 -begin
  31.425 -
  31.426 -definition
  31.427 -  int_number_of_def: "number_of w = (of_int w \<Colon> int)"
  31.428 -
  31.429 -instance proof
  31.430 -qed (simp only: int_number_of_def)
  31.431 -
  31.432 -end
  31.433 -
  31.434 -lemma number_of_is_id:
  31.435 -  "number_of (k::int) = k"
  31.436 -  unfolding int_number_of_def by simp
  31.437 -
  31.438 -lemma number_of_succ:
  31.439 -  "number_of (succ k) = (1 + number_of k ::'a::number_ring)"
  31.440 -  unfolding number_of_eq numeral_simps by simp
  31.441 -
  31.442 -lemma number_of_pred:
  31.443 -  "number_of (pred w) = (- 1 + number_of w ::'a::number_ring)"
  31.444 -  unfolding number_of_eq numeral_simps by simp
  31.445 -
  31.446 -lemma number_of_minus:
  31.447 -  "number_of (uminus w) = (- (number_of w)::'a::number_ring)"
  31.448 -  unfolding number_of_eq by (rule of_int_minus)
  31.449 -
  31.450 -lemma number_of_add:
  31.451 -  "number_of (v + w) = (number_of v + number_of w::'a::number_ring)"
  31.452 -  unfolding number_of_eq by (rule of_int_add)
  31.453 -
  31.454 -lemma number_of_diff:
  31.455 -  "number_of (v - w) = (number_of v - number_of w::'a::number_ring)"
  31.456 -  unfolding number_of_eq by (rule of_int_diff)
  31.457 -
  31.458 -lemma number_of_mult:
  31.459 -  "number_of (v * w) = (number_of v * number_of w::'a::number_ring)"
  31.460 -  unfolding number_of_eq by (rule of_int_mult)
  31.461 -
  31.462 -text {*
  31.463 -  The correctness of shifting.
  31.464 -  But it doesn't seem to give a measurable speed-up.
  31.465 -*}
  31.466 -
  31.467 -lemma double_number_of_Bit0:
  31.468 -  "(1 + 1) * number_of w = (number_of (Bit0 w) ::'a::number_ring)"
  31.469 -  unfolding number_of_eq numeral_simps left_distrib by simp
  31.470 -
  31.471 -text {*
  31.472 -  Converting numerals 0 and 1 to their abstract versions.
  31.473 -*}
  31.474 -
  31.475 -lemma semiring_numeral_0_eq_0 [simp, code_post]:
  31.476 -  "Numeral0 = (0::'a::number_semiring)"
  31.477 -  using number_of_int [where 'a='a and n=0]
  31.478 -  unfolding numeral_simps by simp
  31.479 -
  31.480 -lemma semiring_numeral_1_eq_1 [simp, code_post]:
  31.481 -  "Numeral1 = (1::'a::number_semiring)"
  31.482 -  using number_of_int [where 'a='a and n=1]
  31.483 -  unfolding numeral_simps by simp
  31.484 -
  31.485 -lemma numeral_0_eq_0: (* FIXME delete candidate *)
  31.486 -  "Numeral0 = (0::'a::number_ring)"
  31.487 -  by (rule semiring_numeral_0_eq_0)
  31.488 -
  31.489 -lemma numeral_1_eq_1: (* FIXME delete candidate *)
  31.490 -  "Numeral1 = (1::'a::number_ring)"
  31.491 -  by (rule semiring_numeral_1_eq_1)
  31.492 -
  31.493 -text {*
  31.494 -  Special-case simplification for small constants.
  31.495 -*}
  31.496 -
  31.497 -text{*
  31.498 -  Unary minus for the abstract constant 1. Cannot be inserted
  31.499 -  as a simprule until later: it is @{text number_of_Min} re-oriented!
  31.500 -*}
  31.501 -
  31.502 -lemma numeral_m1_eq_minus_1:
  31.503 -  "(-1::'a::number_ring) = - 1"
  31.504 -  unfolding number_of_eq numeral_simps by simp
  31.505 -
  31.506 -lemma mult_minus1 [simp]:
  31.507 -  "-1 * z = -(z::'a::number_ring)"
  31.508 -  unfolding number_of_eq numeral_simps by simp
  31.509 -
  31.510 -lemma mult_minus1_right [simp]:
  31.511 -  "z * -1 = -(z::'a::number_ring)"
  31.512 -  unfolding number_of_eq numeral_simps by simp
  31.513 -
  31.514 -(*Negation of a coefficient*)
  31.515 -lemma minus_number_of_mult [simp]:
  31.516 -   "- (number_of w) * z = number_of (uminus w) * (z::'a::number_ring)"
  31.517 -   unfolding number_of_eq by simp
  31.518 -
  31.519 -text {* Subtraction *}
  31.520 -
  31.521 -lemma diff_number_of_eq:
  31.522 -  "number_of v - number_of w =
  31.523 -    (number_of (v + uminus w)::'a::number_ring)"
  31.524 -  unfolding number_of_eq by simp
  31.525 -
  31.526 -lemma number_of_Pls:
  31.527 -  "number_of Pls = (0::'a::number_ring)"
  31.528 -  unfolding number_of_eq numeral_simps by simp
  31.529 -
  31.530 -lemma number_of_Min:
  31.531 -  "number_of Min = (- 1::'a::number_ring)"
  31.532 -  unfolding number_of_eq numeral_simps by simp
  31.533 -
  31.534 -lemma number_of_Bit0:
  31.535 -  "number_of (Bit0 w) = (0::'a::number_ring) + (number_of w) + (number_of w)"
  31.536 -  unfolding number_of_eq numeral_simps by simp
  31.537 -
  31.538 -lemma number_of_Bit1:
  31.539 -  "number_of (Bit1 w) = (1::'a::number_ring) + (number_of w) + (number_of w)"
  31.540 -  unfolding number_of_eq numeral_simps by simp
  31.541 -
  31.542 -
  31.543 -subsubsection {* Equality of Binary Numbers *}
  31.544 -
  31.545 -text {* First version by Norbert Voelker *}
  31.546 -
  31.547 -definition (*for simplifying equalities*) iszero :: "'a\<Colon>semiring_1 \<Rightarrow> bool" where
  31.548 -  "iszero z \<longleftrightarrow> z = 0"
  31.549 -
  31.550 -lemma iszero_0: "iszero 0"
  31.551 -  by (simp add: iszero_def)
  31.552 -
  31.553 -lemma iszero_Numeral0: "iszero (Numeral0 :: 'a::number_ring)"
  31.554 -  by (simp add: iszero_0)
  31.555 -
  31.556 -lemma not_iszero_1: "\<not> iszero 1"
  31.557 -  by (simp add: iszero_def)
  31.558 -
  31.559 -lemma not_iszero_Numeral1: "\<not> iszero (Numeral1 :: 'a::number_ring)"
  31.560 -  by (simp add: not_iszero_1)
  31.561 -
  31.562 -lemma eq_number_of_eq [simp]:
  31.563 -  "((number_of x::'a::number_ring) = number_of y) =
  31.564 -     iszero (number_of (x + uminus y) :: 'a)"
  31.565 -unfolding iszero_def number_of_add number_of_minus
  31.566 -by (simp add: algebra_simps)
  31.567 -
  31.568 -lemma iszero_number_of_Pls:
  31.569 -  "iszero ((number_of Pls)::'a::number_ring)"
  31.570 -unfolding iszero_def numeral_0_eq_0 ..
  31.571 -
  31.572 -lemma nonzero_number_of_Min:
  31.573 -  "~ iszero ((number_of Min)::'a::number_ring)"
  31.574 -unfolding iszero_def numeral_m1_eq_minus_1 by simp
  31.575 -
  31.576 -
  31.577  subsubsection {* Comparisons, for Ordered Rings *}
  31.578  
  31.579  lemmas double_eq_0_iff = double_zero
  31.580 @@ -1137,129 +668,6 @@
  31.581    qed
  31.582  qed
  31.583  
  31.584 -lemma iszero_number_of_Bit0:
  31.585 -  "iszero (number_of (Bit0 w)::'a) = 
  31.586 -   iszero (number_of w::'a::{ring_char_0,number_ring})"
  31.587 -proof -
  31.588 -  have "(of_int w + of_int w = (0::'a)) \<Longrightarrow> (w = 0)"
  31.589 -  proof -
  31.590 -    assume eq: "of_int w + of_int w = (0::'a)"
  31.591 -    then have "of_int (w + w) = (of_int 0 :: 'a)" by simp
  31.592 -    then have "w + w = 0" by (simp only: of_int_eq_iff)
  31.593 -    then show "w = 0" by (simp only: double_eq_0_iff)
  31.594 -  qed
  31.595 -  thus ?thesis
  31.596 -    by (auto simp add: iszero_def number_of_eq numeral_simps)
  31.597 -qed
  31.598 -
  31.599 -lemma iszero_number_of_Bit1:
  31.600 -  "~ iszero (number_of (Bit1 w)::'a::{ring_char_0,number_ring})"
  31.601 -proof -
  31.602 -  have "1 + of_int w + of_int w \<noteq> (0::'a)"
  31.603 -  proof
  31.604 -    assume eq: "1 + of_int w + of_int w = (0::'a)"
  31.605 -    hence "of_int (1 + w + w) = (of_int 0 :: 'a)" by simp 
  31.606 -    hence "1 + w + w = 0" by (simp only: of_int_eq_iff)
  31.607 -    with odd_nonzero show False by blast
  31.608 -  qed
  31.609 -  thus ?thesis
  31.610 -    by (auto simp add: iszero_def number_of_eq numeral_simps)
  31.611 -qed
  31.612 -
  31.613 -lemmas iszero_simps [simp] =
  31.614 -  iszero_0 not_iszero_1
  31.615 -  iszero_number_of_Pls nonzero_number_of_Min
  31.616 -  iszero_number_of_Bit0 iszero_number_of_Bit1
  31.617 -(* iszero_number_of_Pls would never normally be used
  31.618 -   because its lhs simplifies to "iszero 0" *)
  31.619 -
  31.620 -text {* Less-Than or Equals *}
  31.621 -
  31.622 -text {* Reduces @{term "a\<le>b"} to @{term "~ (b<a)"} for ALL numerals. *}
  31.623 -
  31.624 -lemmas le_number_of_eq_not_less =
  31.625 -  linorder_not_less [of "number_of w" "number_of v", symmetric] for w v
  31.626 -
  31.627 -
  31.628 -text {* Absolute value (@{term abs}) *}
  31.629 -
  31.630 -lemma abs_number_of:
  31.631 -  "abs(number_of x::'a::{linordered_idom,number_ring}) =
  31.632 -   (if number_of x < (0::'a) then -number_of x else number_of x)"
  31.633 -  by (simp add: abs_if)
  31.634 -
  31.635 -
  31.636 -text {* Re-orientation of the equation nnn=x *}
  31.637 -
  31.638 -lemma number_of_reorient:
  31.639 -  "(number_of w = x) = (x = number_of w)"
  31.640 -  by auto
  31.641 -
  31.642 -
  31.643 -subsubsection {* Simplification of arithmetic operations on integer constants. *}
  31.644 -
  31.645 -lemmas arith_extra_simps [simp] =
  31.646 -  number_of_add [symmetric]
  31.647 -  number_of_minus [symmetric]
  31.648 -  numeral_m1_eq_minus_1 [symmetric]
  31.649 -  number_of_mult [symmetric]
  31.650 -  diff_number_of_eq abs_number_of
  31.651 -
  31.652 -text {*
  31.653 -  For making a minimal simpset, one must include these default simprules.
  31.654 -  Also include @{text simp_thms}.
  31.655 -*}
  31.656 -
  31.657 -lemmas arith_simps = 
  31.658 -  normalize_bin_simps pred_bin_simps succ_bin_simps
  31.659 -  add_bin_simps minus_bin_simps mult_bin_simps
  31.660 -  abs_zero abs_one arith_extra_simps
  31.661 -
  31.662 -text {* Simplification of relational operations *}
  31.663 -
  31.664 -lemma less_number_of [simp]:
  31.665 -  "(number_of x::'a::{linordered_idom,number_ring}) < number_of y \<longleftrightarrow> x < y"
  31.666 -  unfolding number_of_eq by (rule of_int_less_iff)
  31.667 -
  31.668 -lemma le_number_of [simp]:
  31.669 -  "(number_of x::'a::{linordered_idom,number_ring}) \<le> number_of y \<longleftrightarrow> x \<le> y"
  31.670 -  unfolding number_of_eq by (rule of_int_le_iff)
  31.671 -
  31.672 -lemma eq_number_of [simp]:
  31.673 -  "(number_of x::'a::{ring_char_0,number_ring}) = number_of y \<longleftrightarrow> x = y"
  31.674 -  unfolding number_of_eq by (rule of_int_eq_iff)
  31.675 -
  31.676 -lemmas rel_simps =
  31.677 -  less_number_of less_bin_simps
  31.678 -  le_number_of le_bin_simps
  31.679 -  eq_number_of_eq eq_bin_simps
  31.680 -  iszero_simps
  31.681 -
  31.682 -
  31.683 -subsubsection {* Simplification of arithmetic when nested to the right. *}
  31.684 -
  31.685 -lemma add_number_of_left [simp]:
  31.686 -  "number_of v + (number_of w + z) =
  31.687 -   (number_of(v + w) + z::'a::number_ring)"
  31.688 -  by (simp add: add_assoc [symmetric])
  31.689 -
  31.690 -lemma mult_number_of_left [simp]:
  31.691 -  "number_of v * (number_of w * z) =
  31.692 -   (number_of(v * w) * z::'a::number_ring)"
  31.693 -  by (simp add: mult_assoc [symmetric])
  31.694 -
  31.695 -lemma add_number_of_diff1:
  31.696 -  "number_of v + (number_of w - c) = 
  31.697 -  number_of(v + w) - (c::'a::number_ring)"
  31.698 -  by (simp add: diff_minus)
  31.699 -
  31.700 -lemma add_number_of_diff2 [simp]:
  31.701 -  "number_of v + (c - number_of w) =
  31.702 -   number_of (v + uminus w) + (c::'a::number_ring)"
  31.703 -by (simp add: algebra_simps diff_number_of_eq [symmetric])
  31.704 -
  31.705 -
  31.706 -
  31.707  
  31.708  subsection {* The Set of Integers *}
  31.709  
  31.710 @@ -1363,14 +771,8 @@
  31.711    qed
  31.712  qed 
  31.713  
  31.714 -lemma Ints_number_of [simp]:
  31.715 -  "(number_of w :: 'a::number_ring) \<in> Ints"
  31.716 -  unfolding number_of_eq Ints_def by simp
  31.717 -
  31.718 -lemma Nats_number_of [simp]:
  31.719 -  "Int.Pls \<le> w \<Longrightarrow> (number_of w :: 'a::number_ring) \<in> Nats"
  31.720 -unfolding Int.Pls_def number_of_eq
  31.721 -by (simp only: of_nat_nat [symmetric] of_nat_in_Nats)
  31.722 +lemma Nats_numeral [simp]: "numeral w \<in> Nats"
  31.723 +  using of_nat_in_Nats [of "numeral w"] by simp
  31.724  
  31.725  lemma Ints_odd_less_0: 
  31.726    assumes in_Ints: "a \<in> Ints"
  31.727 @@ -1412,100 +814,16 @@
  31.728  lemmas int_setprod = of_nat_setprod [where 'a=int]
  31.729  
  31.730  
  31.731 -subsection{*Inequality Reasoning for the Arithmetic Simproc*}
  31.732 -
  31.733 -lemma add_numeral_0: "Numeral0 + a = (a::'a::number_ring)"
  31.734 -by simp 
  31.735 -
  31.736 -lemma add_numeral_0_right: "a + Numeral0 = (a::'a::number_ring)"
  31.737 -by simp
  31.738 -
  31.739 -lemma mult_numeral_1: "Numeral1 * a = (a::'a::number_ring)"
  31.740 -by simp 
  31.741 -
  31.742 -lemma mult_numeral_1_right: "a * Numeral1 = (a::'a::number_ring)"
  31.743 -by simp
  31.744 -
  31.745 -lemma divide_numeral_1: "a / Numeral1 = (a::'a::{number_ring,field})"
  31.746 -by simp
  31.747 -
  31.748 -lemma inverse_numeral_1:
  31.749 -  "inverse Numeral1 = (Numeral1::'a::{number_ring,field})"
  31.750 -by simp
  31.751 -
  31.752 -text{*Theorem lists for the cancellation simprocs. The use of binary numerals
  31.753 -for 0 and 1 reduces the number of special cases.*}
  31.754 -
  31.755 -lemmas add_0s = add_numeral_0 add_numeral_0_right
  31.756 -lemmas mult_1s = mult_numeral_1 mult_numeral_1_right 
  31.757 -                 mult_minus1 mult_minus1_right
  31.758 -
  31.759 -
  31.760 -subsection{*Special Arithmetic Rules for Abstract 0 and 1*}
  31.761 -
  31.762 -text{*Arithmetic computations are defined for binary literals, which leaves 0
  31.763 -and 1 as special cases. Addition already has rules for 0, but not 1.
  31.764 -Multiplication and unary minus already have rules for both 0 and 1.*}
  31.765 -
  31.766 -
  31.767 -lemma binop_eq: "[|f x y = g x y; x = x'; y = y'|] ==> f x' y' = g x' y'"
  31.768 -by simp
  31.769 -
  31.770 -
  31.771 -lemmas add_number_of_eq = number_of_add [symmetric]
  31.772 -
  31.773 -text{*Allow 1 on either or both sides*}
  31.774 -lemma semiring_one_add_one_is_two: "1 + 1 = (2::'a::number_semiring)"
  31.775 -  using number_of_int [where 'a='a and n="Suc (Suc 0)"]
  31.776 -  by (simp add: numeral_simps)
  31.777 -
  31.778 -lemma one_add_one_is_two: "1 + 1 = (2::'a::number_ring)"
  31.779 -by (rule semiring_one_add_one_is_two)
  31.780 -
  31.781 -lemmas add_special =
  31.782 -    one_add_one_is_two
  31.783 -    binop_eq [of "op +", OF add_number_of_eq numeral_1_eq_1 refl]
  31.784 -    binop_eq [of "op +", OF add_number_of_eq refl numeral_1_eq_1]
  31.785 -
  31.786 -text{*Allow 1 on either or both sides (1-1 already simplifies to 0)*}
  31.787 -lemmas diff_special =
  31.788 -    binop_eq [of "op -", OF diff_number_of_eq numeral_1_eq_1 refl]
  31.789 -    binop_eq [of "op -", OF diff_number_of_eq refl numeral_1_eq_1]
  31.790 -
  31.791 -text{*Allow 0 or 1 on either side with a binary numeral on the other*}
  31.792 -lemmas eq_special =
  31.793 -    binop_eq [of "op =", OF eq_number_of_eq numeral_0_eq_0 refl]
  31.794 -    binop_eq [of "op =", OF eq_number_of_eq numeral_1_eq_1 refl]
  31.795 -    binop_eq [of "op =", OF eq_number_of_eq refl numeral_0_eq_0]
  31.796 -    binop_eq [of "op =", OF eq_number_of_eq refl numeral_1_eq_1]
  31.797 -
  31.798 -text{*Allow 0 or 1 on either side with a binary numeral on the other*}
  31.799 -lemmas less_special =
  31.800 -  binop_eq [of "op <", OF less_number_of numeral_0_eq_0 refl]
  31.801 -  binop_eq [of "op <", OF less_number_of numeral_1_eq_1 refl]
  31.802 -  binop_eq [of "op <", OF less_number_of refl numeral_0_eq_0]
  31.803 -  binop_eq [of "op <", OF less_number_of refl numeral_1_eq_1]
  31.804 -
  31.805 -text{*Allow 0 or 1 on either side with a binary numeral on the other*}
  31.806 -lemmas le_special =
  31.807 -    binop_eq [of "op \<le>", OF le_number_of numeral_0_eq_0 refl]
  31.808 -    binop_eq [of "op \<le>", OF le_number_of numeral_1_eq_1 refl]
  31.809 -    binop_eq [of "op \<le>", OF le_number_of refl numeral_0_eq_0]
  31.810 -    binop_eq [of "op \<le>", OF le_number_of refl numeral_1_eq_1]
  31.811 -
  31.812 -lemmas arith_special[simp] = 
  31.813 -       add_special diff_special eq_special less_special le_special
  31.814 -
  31.815 -
  31.816  text {* Legacy theorems *}
  31.817  
  31.818  lemmas zle_int = of_nat_le_iff [where 'a=int]
  31.819  lemmas int_int_eq = of_nat_eq_iff [where 'a=int]
  31.820 +lemmas numeral_1_eq_1 = numeral_One
  31.821  
  31.822  subsection {* Setting up simplification procedures *}
  31.823  
  31.824  lemmas int_arith_rules =
  31.825 -  neg_le_iff_le numeral_0_eq_0 numeral_1_eq_1
  31.826 +  neg_le_iff_le numeral_One
  31.827    minus_zero diff_minus left_minus right_minus
  31.828    mult_zero_left mult_zero_right mult_1_left mult_1_right
  31.829    mult_minus_left mult_minus_right
  31.830 @@ -1513,56 +831,39 @@
  31.831    of_nat_0 of_nat_1 of_nat_Suc of_nat_add of_nat_mult
  31.832    of_int_0 of_int_1 of_int_add of_int_mult
  31.833  
  31.834 +use "Tools/numeral.ML"
  31.835  use "Tools/int_arith.ML"
  31.836  declaration {* K Int_Arith.setup *}
  31.837  
  31.838 -simproc_setup fast_arith ("(m::'a::{linordered_idom,number_ring}) < n" |
  31.839 -  "(m::'a::{linordered_idom,number_ring}) <= n" |
  31.840 -  "(m::'a::{linordered_idom,number_ring}) = n") =
  31.841 +simproc_setup fast_arith ("(m::'a::linordered_idom) < n" |
  31.842 +  "(m::'a::linordered_idom) <= n" |
  31.843 +  "(m::'a::linordered_idom) = n") =
  31.844    {* fn _ => fn ss => fn ct => Lin_Arith.simproc ss (term_of ct) *}
  31.845  
  31.846  setup {*
  31.847    Reorient_Proc.add
  31.848 -    (fn Const (@{const_name number_of}, _) $ _ => true | _ => false)
  31.849 +    (fn Const (@{const_name numeral}, _) $ _ => true
  31.850 +    | Const (@{const_name neg_numeral}, _) $ _ => true
  31.851 +    | _ => false)
  31.852  *}
  31.853  
  31.854 -simproc_setup reorient_numeral ("number_of w = x") = Reorient_Proc.proc
  31.855 +simproc_setup reorient_numeral
  31.856 +  ("numeral w = x" | "neg_numeral w = y") = Reorient_Proc.proc
  31.857  
  31.858  
  31.859  subsection{*Lemmas About Small Numerals*}
  31.860  
  31.861 -lemma of_int_m1 [simp]: "of_int -1 = (-1 :: 'a :: number_ring)"
  31.862 -proof -
  31.863 -  have "(of_int -1 :: 'a) = of_int (- 1)" by simp
  31.864 -  also have "... = - of_int 1" by (simp only: of_int_minus)
  31.865 -  also have "... = -1" by simp
  31.866 -  finally show ?thesis .
  31.867 -qed
  31.868 -
  31.869 -lemma abs_minus_one [simp]: "abs (-1) = (1::'a::{linordered_idom,number_ring})"
  31.870 -by (simp add: abs_if)
  31.871 -
  31.872  lemma abs_power_minus_one [simp]:
  31.873 -  "abs(-1 ^ n) = (1::'a::{linordered_idom,number_ring})"
  31.874 +  "abs(-1 ^ n) = (1::'a::linordered_idom)"
  31.875  by (simp add: power_abs)
  31.876  
  31.877 -lemma of_int_number_of_eq [simp]:
  31.878 -     "of_int (number_of v) = (number_of v :: 'a :: number_ring)"
  31.879 -by (simp add: number_of_eq) 
  31.880 -
  31.881  text{*Lemmas for specialist use, NOT as default simprules*}
  31.882  (* TODO: see if semiring duplication can be removed without breaking proofs *)
  31.883 -lemma semiring_mult_2: "2 * z = (z+z::'a::number_semiring)"
  31.884 -unfolding semiring_one_add_one_is_two [symmetric] left_distrib by simp
  31.885 -
  31.886 -lemma semiring_mult_2_right: "z * 2 = (z+z::'a::number_semiring)"
  31.887 -by (subst mult_commute, rule semiring_mult_2)
  31.888 +lemma mult_2: "2 * z = (z+z::'a::semiring_1)"
  31.889 +unfolding one_add_one [symmetric] left_distrib by simp
  31.890  
  31.891 -lemma mult_2: "2 * z = (z+z::'a::number_ring)"
  31.892 -by (rule semiring_mult_2)
  31.893 -
  31.894 -lemma mult_2_right: "z * 2 = (z+z::'a::number_ring)"
  31.895 -by (rule semiring_mult_2_right)
  31.896 +lemma mult_2_right: "z * 2 = (z+z::'a::semiring_1)"
  31.897 +unfolding one_add_one [symmetric] right_distrib by simp
  31.898  
  31.899  
  31.900  subsection{*More Inequality Reasoning*}
  31.901 @@ -1608,7 +909,7 @@
  31.902  
  31.903  text{*This simplifies expressions of the form @{term "int n = z"} where
  31.904        z is an integer literal.*}
  31.905 -lemmas int_eq_iff_number_of [simp] = int_eq_iff [of _ "number_of v"] for v
  31.906 +lemmas int_eq_iff_numeral [simp] = int_eq_iff [of _ "numeral v"] for v
  31.907  
  31.908  lemma split_nat [arith_split]:
  31.909    "P(nat(i::int)) = ((\<forall>n. i = int n \<longrightarrow> P n) & (i < 0 \<longrightarrow> P 0))"
  31.910 @@ -1853,12 +1154,14 @@
  31.911        by (simp add: mn)
  31.912      finally have "2*\<bar>n\<bar> \<le> 1" .
  31.913      thus "False" using 0
  31.914 -      by auto
  31.915 +      by arith
  31.916    qed
  31.917    thus ?thesis using 0
  31.918      by auto
  31.919  qed
  31.920  
  31.921 +ML_val {* @{const_name neg_numeral} *}
  31.922 +
  31.923  lemma pos_zmult_eq_1_iff_lemma: "(m * n = 1) ==> m = (1::int) | m = -1"
  31.924  by (insert abs_zmult_eq_1 [of m n], arith)
  31.925  
  31.926 @@ -1894,125 +1197,170 @@
  31.927  
  31.928  text{*These distributive laws move literals inside sums and differences.*}
  31.929  
  31.930 -lemmas left_distrib_number_of [simp] = left_distrib [of _ _ "number_of v"] for v
  31.931 -lemmas right_distrib_number_of [simp] = right_distrib [of "number_of v"] for v
  31.932 -lemmas left_diff_distrib_number_of [simp] = left_diff_distrib [of _ _ "number_of v"] for v
  31.933 -lemmas right_diff_distrib_number_of [simp] = right_diff_distrib [of "number_of v"] for v
  31.934 +lemmas left_distrib_numeral [simp] = left_distrib [of _ _ "numeral v"] for v
  31.935 +lemmas right_distrib_numeral [simp] = right_distrib [of "numeral v"] for v
  31.936 +lemmas left_diff_distrib_numeral [simp] = left_diff_distrib [of _ _ "numeral v"] for v
  31.937 +lemmas right_diff_distrib_numeral [simp] = right_diff_distrib [of "numeral v"] for v
  31.938  
  31.939  text{*These are actually for fields, like real: but where else to put them?*}
  31.940  
  31.941 -lemmas zero_less_divide_iff_number_of [simp, no_atp] = zero_less_divide_iff [of "number_of w"] for w
  31.942 -lemmas divide_less_0_iff_number_of [simp, no_atp] = divide_less_0_iff [of "number_of w"] for w
  31.943 -lemmas zero_le_divide_iff_number_of [simp, no_atp] = zero_le_divide_iff [of "number_of w"] for w
  31.944 -lemmas divide_le_0_iff_number_of [simp, no_atp] = divide_le_0_iff [of "number_of w"] for w
  31.945 +lemmas zero_less_divide_iff_numeral [simp, no_atp] = zero_less_divide_iff [of "numeral w"] for w
  31.946 +lemmas divide_less_0_iff_numeral [simp, no_atp] = divide_less_0_iff [of "numeral w"] for w
  31.947 +lemmas zero_le_divide_iff_numeral [simp, no_atp] = zero_le_divide_iff [of "numeral w"] for w
  31.948 +lemmas divide_le_0_iff_numeral [simp, no_atp] = divide_le_0_iff [of "numeral w"] for w
  31.949  
  31.950  
  31.951  text {*Replaces @{text "inverse #nn"} by @{text "1/#nn"}.  It looks
  31.952    strange, but then other simprocs simplify the quotient.*}
  31.953  
  31.954 -lemmas inverse_eq_divide_number_of [simp] = inverse_eq_divide [of "number_of w"] for w
  31.955 +lemmas inverse_eq_divide_numeral [simp] =
  31.956 +  inverse_eq_divide [of "numeral w"] for w
  31.957 +
  31.958 +lemmas inverse_eq_divide_neg_numeral [simp] =
  31.959 +  inverse_eq_divide [of "neg_numeral w"] for w
  31.960  
  31.961  text {*These laws simplify inequalities, moving unary minus from a term
  31.962  into the literal.*}
  31.963  
  31.964 -lemmas less_minus_iff_number_of [simp, no_atp] = less_minus_iff [of "number_of v"] for v
  31.965 -lemmas le_minus_iff_number_of [simp, no_atp] = le_minus_iff [of "number_of v"] for v
  31.966 -lemmas equation_minus_iff_number_of [simp, no_atp] = equation_minus_iff [of "number_of v"] for v
  31.967 -lemmas minus_less_iff_number_of [simp, no_atp] = minus_less_iff [of _ "number_of v"] for v
  31.968 -lemmas minus_le_iff_number_of [simp, no_atp] = minus_le_iff [of _ "number_of v"] for v
  31.969 -lemmas minus_equation_iff_number_of [simp, no_atp] = minus_equation_iff [of _ "number_of v"] for v
  31.970 +lemmas le_minus_iff_numeral [simp, no_atp] =
  31.971 +  le_minus_iff [of "numeral v"]
  31.972 +  le_minus_iff [of "neg_numeral v"] for v
  31.973 +
  31.974 +lemmas equation_minus_iff_numeral [simp, no_atp] =
  31.975 +  equation_minus_iff [of "numeral v"]
  31.976 +  equation_minus_iff [of "neg_numeral v"] for v
  31.977 +
  31.978 +lemmas minus_less_iff_numeral [simp, no_atp] =
  31.979 +  minus_less_iff [of _ "numeral v"]
  31.980 +  minus_less_iff [of _ "neg_numeral v"] for v
  31.981 +
  31.982 +lemmas minus_le_iff_numeral [simp, no_atp] =
  31.983 +  minus_le_iff [of _ "numeral v"]
  31.984 +  minus_le_iff [of _ "neg_numeral v"] for v
  31.985 +
  31.986 +lemmas minus_equation_iff_numeral [simp, no_atp] =
  31.987 +  minus_equation_iff [of _ "numeral v"]
  31.988 +  minus_equation_iff [of _ "neg_numeral v"] for v
  31.989  
  31.990  text{*To Simplify Inequalities Where One Side is the Constant 1*}
  31.991  
  31.992  lemma less_minus_iff_1 [simp,no_atp]:
  31.993 -  fixes b::"'b::{linordered_idom,number_ring}"
  31.994 +  fixes b::"'b::linordered_idom"
  31.995    shows "(1 < - b) = (b < -1)"
  31.996  by auto
  31.997  
  31.998  lemma le_minus_iff_1 [simp,no_atp]:
  31.999 -  fixes b::"'b::{linordered_idom,number_ring}"
 31.1000 +  fixes b::"'b::linordered_idom"
 31.1001    shows "(1 \<le> - b) = (b \<le> -1)"
 31.1002  by auto
 31.1003  
 31.1004  lemma equation_minus_iff_1 [simp,no_atp]:
 31.1005 -  fixes b::"'b::number_ring"
 31.1006 +  fixes b::"'b::ring_1"
 31.1007    shows "(1 = - b) = (b = -1)"
 31.1008  by (subst equation_minus_iff, auto)
 31.1009  
 31.1010  lemma minus_less_iff_1 [simp,no_atp]:
 31.1011 -  fixes a::"'b::{linordered_idom,number_ring}"
 31.1012 +  fixes a::"'b::linordered_idom"
 31.1013    shows "(- a < 1) = (-1 < a)"
 31.1014  by auto
 31.1015  
 31.1016  lemma minus_le_iff_1 [simp,no_atp]:
 31.1017 -  fixes a::"'b::{linordered_idom,number_ring}"
 31.1018 +  fixes a::"'b::linordered_idom"
 31.1019    shows "(- a \<le> 1) = (-1 \<le> a)"
 31.1020  by auto
 31.1021  
 31.1022  lemma minus_equation_iff_1 [simp,no_atp]:
 31.1023 -  fixes a::"'b::number_ring"
 31.1024 +  fixes a::"'b::ring_1"
 31.1025    shows "(- a = 1) = (a = -1)"
 31.1026  by (subst minus_equation_iff, auto)
 31.1027  
 31.1028  
 31.1029  text {*Cancellation of constant factors in comparisons (@{text "<"} and @{text "\<le>"}) *}
 31.1030  
 31.1031 -lemmas mult_less_cancel_left_number_of [simp, no_atp] = mult_less_cancel_left [of "number_of v"] for v
 31.1032 -lemmas mult_less_cancel_right_number_of [simp, no_atp] = mult_less_cancel_right [of _ "number_of v"] for v
 31.1033 -lemmas mult_le_cancel_left_number_of [simp, no_atp] = mult_le_cancel_left [of "number_of v"] for v
 31.1034 -lemmas mult_le_cancel_right_number_of [simp, no_atp] = mult_le_cancel_right [of _ "number_of v"] for v
 31.1035 +lemmas mult_less_cancel_left_numeral [simp, no_atp] = mult_less_cancel_left [of "numeral v"] for v
 31.1036 +lemmas mult_less_cancel_right_numeral [simp, no_atp] = mult_less_cancel_right [of _ "numeral v"] for v
 31.1037 +lemmas mult_le_cancel_left_numeral [simp, no_atp] = mult_le_cancel_left [of "numeral v"] for v
 31.1038 +lemmas mult_le_cancel_right_numeral [simp, no_atp] = mult_le_cancel_right [of _ "numeral v"] for v
 31.1039  
 31.1040  
 31.1041  text {*Multiplying out constant divisors in comparisons (@{text "<"}, @{text "\<le>"} and @{text "="}) *}
 31.1042  
 31.1043 -lemmas le_divide_eq_number_of1 [simp] = le_divide_eq [of _ _ "number_of w"] for w
 31.1044 -lemmas divide_le_eq_number_of1 [simp] = divide_le_eq [of _ "number_of w"] for w
 31.1045 -lemmas less_divide_eq_number_of1 [simp] = less_divide_eq [of _ _ "number_of w"] for w
 31.1046 -lemmas divide_less_eq_number_of1 [simp] = divide_less_eq [of _ "number_of w"] for w
 31.1047 -lemmas eq_divide_eq_number_of1 [simp] = eq_divide_eq [of _ _ "number_of w"] for w
 31.1048 -lemmas divide_eq_eq_number_of1 [simp] = divide_eq_eq [of _ "number_of w"] for w
 31.1049 +lemmas le_divide_eq_numeral1 [simp] =
 31.1050 +  pos_le_divide_eq [of "numeral w", OF zero_less_numeral]
 31.1051 +  neg_le_divide_eq [of "neg_numeral w", OF neg_numeral_less_zero] for w
 31.1052 +
 31.1053 +lemmas divide_le_eq_numeral1 [simp] =
 31.1054 +  pos_divide_le_eq [of "numeral w", OF zero_less_numeral]
 31.1055 +  neg_divide_le_eq [of "neg_numeral w", OF neg_numeral_less_zero] for w
 31.1056 +
 31.1057 +lemmas less_divide_eq_numeral1 [simp] =
 31.1058 +  pos_less_divide_eq [of "numeral w", OF zero_less_numeral]
 31.1059 +  neg_less_divide_eq [of "neg_numeral w", OF neg_numeral_less_zero] for w
 31.1060  
 31.1061 +lemmas divide_less_eq_numeral1 [simp] =
 31.1062 +  pos_divide_less_eq [of "numeral w", OF zero_less_numeral]
 31.1063 +  neg_divide_less_eq [of "neg_numeral w", OF neg_numeral_less_zero] for w
 31.1064 +
 31.1065 +lemmas eq_divide_eq_numeral1 [simp] =
 31.1066 +  eq_divide_eq [of _ _ "numeral w"]
 31.1067 +  eq_divide_eq [of _ _ "neg_numeral w"] for w
 31.1068 +
 31.1069 +lemmas divide_eq_eq_numeral1 [simp] =
 31.1070 +  divide_eq_eq [of _ "numeral w"]
 31.1071 +  divide_eq_eq [of _ "neg_numeral w"] for w
 31.1072  
 31.1073  subsubsection{*Optional Simplification Rules Involving Constants*}
 31.1074  
 31.1075  text{*Simplify quotients that are compared with a literal constant.*}
 31.1076  
 31.1077 -lemmas le_divide_eq_number_of = le_divide_eq [of "number_of w"] for w
 31.1078 -lemmas divide_le_eq_number_of = divide_le_eq [of _ _ "number_of w"] for w
 31.1079 -lemmas less_divide_eq_number_of = less_divide_eq [of "number_of w"] for w
 31.1080 -lemmas divide_less_eq_number_of = divide_less_eq [of _ _ "number_of w"] for w
 31.1081 -lemmas eq_divide_eq_number_of = eq_divide_eq [of "number_of w"] for w
 31.1082 -lemmas divide_eq_eq_number_of = divide_eq_eq [of _ _ "number_of w"] for w
 31.1083 +lemmas le_divide_eq_numeral =
 31.1084 +  le_divide_eq [of "numeral w"]
 31.1085 +  le_divide_eq [of "neg_numeral w"] for w
 31.1086 +
 31.1087 +lemmas divide_le_eq_numeral =
 31.1088 +  divide_le_eq [of _ _ "numeral w"]
 31.1089 +  divide_le_eq [of _ _ "neg_numeral w"] for w
 31.1090 +
 31.1091 +lemmas less_divide_eq_numeral =
 31.1092 +  less_divide_eq [of "numeral w"]
 31.1093 +  less_divide_eq [of "neg_numeral w"] for w
 31.1094 +
 31.1095 +lemmas divide_less_eq_numeral =
 31.1096 +  divide_less_eq [of _ _ "numeral w"]
 31.1097 +  divide_less_eq [of _ _ "neg_numeral w"] for w
 31.1098 +
 31.1099 +lemmas eq_divide_eq_numeral =
 31.1100 +  eq_divide_eq [of "numeral w"]
 31.1101 +  eq_divide_eq [of "neg_numeral w"] for w
 31.1102 +
 31.1103 +lemmas divide_eq_eq_numeral =
 31.1104 +  divide_eq_eq [of _ _ "numeral w"]
 31.1105 +  divide_eq_eq [of _ _ "neg_numeral w"] for w
 31.1106  
 31.1107  
 31.1108  text{*Not good as automatic simprules because they cause case splits.*}
 31.1109  lemmas divide_const_simps =
 31.1110 -  le_divide_eq_number_of divide_le_eq_number_of less_divide_eq_number_of
 31.1111 -  divide_less_eq_number_of eq_divide_eq_number_of divide_eq_eq_number_of
 31.1112 +  le_divide_eq_numeral divide_le_eq_numeral less_divide_eq_numeral
 31.1113 +  divide_less_eq_numeral eq_divide_eq_numeral divide_eq_eq_numeral
 31.1114    le_divide_eq_1 divide_le_eq_1 less_divide_eq_1 divide_less_eq_1
 31.1115  
 31.1116  text{*Division By @{text "-1"}*}
 31.1117  
 31.1118 -lemma divide_minus1 [simp]:
 31.1119 -     "x/-1 = -(x::'a::{field_inverse_zero, number_ring})"
 31.1120 -by simp
 31.1121 +lemma divide_minus1 [simp]: "(x::'a::field) / -1 = - x"
 31.1122 +  unfolding minus_one [symmetric]
 31.1123 +  unfolding nonzero_minus_divide_right [OF one_neq_zero, symmetric]
 31.1124 +  by simp
 31.1125  
 31.1126 -lemma minus1_divide [simp]:
 31.1127 -     "-1 / (x::'a::{field_inverse_zero, number_ring}) = - (1/x)"
 31.1128 -by (simp add: divide_inverse)
 31.1129 +lemma minus1_divide [simp]: "-1 / (x::'a::field) = - (1 / x)"
 31.1130 +  unfolding minus_one [symmetric] by (rule divide_minus_left)
 31.1131  
 31.1132  lemma half_gt_zero_iff:
 31.1133 -     "(0 < r/2) = (0 < (r::'a::{linordered_field_inverse_zero,number_ring}))"
 31.1134 +     "(0 < r/2) = (0 < (r::'a::linordered_field_inverse_zero))"
 31.1135  by auto
 31.1136  
 31.1137  lemmas half_gt_zero [simp] = half_gt_zero_iff [THEN iffD2]
 31.1138  
 31.1139 -lemma divide_Numeral1:
 31.1140 -  "(x::'a::{field, number_ring}) / Numeral1 = x"
 31.1141 -  by simp
 31.1142 -
 31.1143 -lemma divide_Numeral0:
 31.1144 -  "(x::'a::{field_inverse_zero, number_ring}) / Numeral0 = 0"
 31.1145 +lemma divide_Numeral1: "(x::'a::field) / Numeral1 = x"
 31.1146    by simp
 31.1147  
 31.1148  
 31.1149 @@ -2211,128 +1559,154 @@
 31.1150  
 31.1151  subsection {* Configuration of the code generator *}
 31.1152  
 31.1153 -code_datatype Pls Min Bit0 Bit1 "number_of \<Colon> int \<Rightarrow> int"
 31.1154 +text {* Constructors *}
 31.1155 +
 31.1156 +definition Pos :: "num \<Rightarrow> int" where
 31.1157 +  [simp, code_abbrev]: "Pos = numeral"
 31.1158 +
 31.1159 +definition Neg :: "num \<Rightarrow> int" where
 31.1160 +  [simp, code_abbrev]: "Neg = neg_numeral"
 31.1161 +
 31.1162 +code_datatype "0::int" Pos Neg
 31.1163 +
 31.1164 +
 31.1165 +text {* Auxiliary operations *}
 31.1166 +
 31.1167 +definition dup :: "int \<Rightarrow> int" where
 31.1168 +  [simp]: "dup k = k + k"
 31.1169  
 31.1170 -lemmas pred_succ_numeral_code [code] =
 31.1171 -  pred_bin_simps succ_bin_simps
 31.1172 +lemma dup_code [code]:
 31.1173 +  "dup 0 = 0"
 31.1174 +  "dup (Pos n) = Pos (Num.Bit0 n)"
 31.1175 +  "dup (Neg n) = Neg (Num.Bit0 n)"
 31.1176 +  unfolding Pos_def Neg_def neg_numeral_def
 31.1177 +  by (simp_all add: numeral_Bit0)
 31.1178 +
 31.1179 +definition sub :: "num \<Rightarrow> num \<Rightarrow> int" where
 31.1180 +  [simp]: "sub m n = numeral m - numeral n"
 31.1181  
 31.1182 -lemmas plus_numeral_code [code] =
 31.1183 -  add_bin_simps
 31.1184 -  arith_extra_simps(1) [where 'a = int]
 31.1185 +lemma sub_code [code]:
 31.1186 +  "sub Num.One Num.One = 0"
 31.1187 +  "sub (Num.Bit0 m) Num.One = Pos (Num.BitM m)"
 31.1188 +  "sub (Num.Bit1 m) Num.One = Pos (Num.Bit0 m)"
 31.1189 +  "sub Num.One (Num.Bit0 n) = Neg (Num.BitM n)"
 31.1190 +  "sub Num.One (Num.Bit1 n) = Neg (Num.Bit0 n)"
 31.1191 +  "sub (Num.Bit0 m) (Num.Bit0 n) = dup (sub m n)"
 31.1192 +  "sub (Num.Bit1 m) (Num.Bit1 n) = dup (sub m n)"
 31.1193 +  "sub (Num.Bit1 m) (Num.Bit0 n) = dup (sub m n) + 1"
 31.1194 +  "sub (Num.Bit0 m) (Num.Bit1 n) = dup (sub m n) - 1"
 31.1195 +  unfolding sub_def dup_def numeral.simps Pos_def Neg_def
 31.1196 +    neg_numeral_def numeral_BitM
 31.1197 +  by (simp_all only: algebra_simps)
 31.1198  
 31.1199 -lemmas minus_numeral_code [code] =
 31.1200 -  minus_bin_simps
 31.1201 -  arith_extra_simps(2) [where 'a = int]
 31.1202 -  arith_extra_simps(5) [where 'a = int]
 31.1203 +
 31.1204 +text {* Implementations *}
 31.1205 +
 31.1206 +lemma one_int_code [code, code_unfold]:
 31.1207 +  "1 = Pos Num.One"
 31.1208 +  by simp
 31.1209 +
 31.1210 +lemma plus_int_code [code]:
 31.1211 +  "k + 0 = (k::int)"
 31.1212 +  "0 + l = (l::int)"
 31.1213 +  "Pos m + Pos n = Pos (m + n)"
 31.1214 +  "Pos m + Neg n = sub m n"
 31.1215 +  "Neg m + Pos n = sub n m"
 31.1216 +  "Neg m + Neg n = Neg (m + n)"
 31.1217 +  by simp_all
 31.1218  
 31.1219 -lemmas times_numeral_code [code] =
 31.1220 -  mult_bin_simps
 31.1221 -  arith_extra_simps(4) [where 'a = int]
 31.1222 +lemma uminus_int_code [code]:
 31.1223 +  "uminus 0 = (0::int)"
 31.1224 +  "uminus (Pos m) = Neg m"
 31.1225 +  "uminus (Neg m) = Pos m"
 31.1226 +  by simp_all
 31.1227 +
 31.1228 +lemma minus_int_code [code]:
 31.1229 +  "k - 0 = (k::int)"
 31.1230 +  "0 - l = uminus (l::int)"
 31.1231 +  "Pos m - Pos n = sub m n"
 31.1232 +  "Pos m - Neg n = Pos (m + n)"
 31.1233 +  "Neg m - Pos n = Neg (m + n)"
 31.1234 +  "Neg m - Neg n = sub n m"
 31.1235 +  by simp_all
 31.1236 +
 31.1237 +lemma times_int_code [code]:
 31.1238 +  "k * 0 = (0::int)"
 31.1239 +  "0 * l = (0::int)"
 31.1240 +  "Pos m * Pos n = Pos (m * n)"
 31.1241 +  "Pos m * Neg n = Neg (m * n)"
 31.1242 +  "Neg m * Pos n = Neg (m * n)"
 31.1243 +  "Neg m * Neg n = Pos (m * n)"
 31.1244 +  by simp_all
 31.1245  
 31.1246  instantiation int :: equal
 31.1247  begin
 31.1248  
 31.1249  definition
 31.1250 -  "HOL.equal k l \<longleftrightarrow> k - l = (0\<Colon>int)"
 31.1251 +  "HOL.equal k l \<longleftrightarrow> k = (l::int)"
 31.1252  
 31.1253 -instance by default (simp add: equal_int_def)
 31.1254 +instance by default (rule equal_int_def)
 31.1255  
 31.1256  end
 31.1257  
 31.1258 -lemma eq_number_of_int_code [code]:
 31.1259 -  "HOL.equal (number_of k \<Colon> int) (number_of l) \<longleftrightarrow> HOL.equal k l"
 31.1260 -  unfolding equal_int_def number_of_is_id ..
 31.1261 +lemma equal_int_code [code]:
 31.1262 +  "HOL.equal 0 (0::int) \<longleftrightarrow> True"
 31.1263 +  "HOL.equal 0 (Pos l) \<longleftrightarrow> False"
 31.1264 +  "HOL.equal 0 (Neg l) \<longleftrightarrow> False"
 31.1265 +  "HOL.equal (Pos k) 0 \<longleftrightarrow> False"
 31.1266 +  "HOL.equal (Pos k) (Pos l) \<longleftrightarrow> HOL.equal k l"
 31.1267 +  "HOL.equal (Pos k) (Neg l) \<longleftrightarrow> False"
 31.1268 +  "HOL.equal (Neg k) 0 \<longleftrightarrow> False"
 31.1269 +  "HOL.equal (Neg k) (Pos l) \<longleftrightarrow> False"
 31.1270 +  "HOL.equal (Neg k) (Neg l) \<longleftrightarrow> HOL.equal k l"
 31.1271 +  by (auto simp add: equal)
 31.1272  
 31.1273 -lemma eq_int_code [code]:
 31.1274 -  "HOL.equal Int.Pls Int.Pls \<longleftrightarrow> True"
 31.1275 -  "HOL.equal Int.Pls Int.Min \<longleftrightarrow> False"
 31.1276 -  "HOL.equal Int.Pls (Int.Bit0 k2) \<longleftrightarrow> HOL.equal Int.Pls k2"
 31.1277 -  "HOL.equal Int.Pls (Int.Bit1 k2) \<longleftrightarrow> False"
 31.1278 -  "HOL.equal Int.Min Int.Pls \<longleftrightarrow> False"
 31.1279 -  "HOL.equal Int.Min Int.Min \<longleftrightarrow> True"
 31.1280 -  "HOL.equal Int.Min (Int.Bit0 k2) \<longleftrightarrow> False"
 31.1281 -  "HOL.equal Int.Min (Int.Bit1 k2) \<longleftrightarrow> HOL.equal Int.Min k2"
 31.1282 -  "HOL.equal (Int.Bit0 k1) Int.Pls \<longleftrightarrow> HOL.equal k1 Int.Pls"
 31.1283 -  "HOL.equal (Int.Bit1 k1) Int.Pls \<longleftrightarrow> False"
 31.1284 -  "HOL.equal (Int.Bit0 k1) Int.Min \<longleftrightarrow> False"
 31.1285 -  "HOL.equal (Int.Bit1 k1) Int.Min \<longleftrightarrow> HOL.equal k1 Int.Min"
 31.1286 -  "HOL.equal (Int.Bit0 k1) (Int.Bit0 k2) \<longleftrightarrow> HOL.equal k1 k2"
 31.1287 -  "HOL.equal (Int.Bit0 k1) (Int.Bit1 k2) \<longleftrightarrow> False"
 31.1288 -  "HOL.equal (Int.Bit1 k1) (Int.Bit0 k2) \<longleftrightarrow> False"
 31.1289 -  "HOL.equal (Int.Bit1 k1) (Int.Bit1 k2) \<longleftrightarrow> HOL.equal k1 k2"
 31.1290 -  unfolding equal_eq by simp_all
 31.1291 -
 31.1292 -lemma eq_int_refl [code nbe]:
 31.1293 +lemma equal_int_refl [code nbe]:
 31.1294    "HOL.equal (k::int) k \<longleftrightarrow> True"
 31.1295 -  by (rule equal_refl)
 31.1296 -
 31.1297 -lemma less_eq_number_of_int_code [code]:
 31.1298 -  "(number_of k \<Colon> int) \<le> number_of l \<longleftrightarrow> k \<le> l"
 31.1299 -  unfolding number_of_is_id ..
 31.1300 +  by (fact equal_refl)
 31.1301  
 31.1302  lemma less_eq_int_code [code]:
 31.1303 -  "Int.Pls \<le> Int.Pls \<longleftrightarrow> True"
 31.1304 -  "Int.Pls \<le> Int.Min \<longleftrightarrow> False"
 31.1305 -  "Int.Pls \<le> Int.Bit0 k \<longleftrightarrow> Int.Pls \<le> k"
 31.1306 -  "Int.Pls \<le> Int.Bit1 k \<longleftrightarrow> Int.Pls \<le> k"
 31.1307 -  "Int.Min \<le> Int.Pls \<longleftrightarrow> True"
 31.1308 -  "Int.Min \<le> Int.Min \<longleftrightarrow> True"
 31.1309 -  "Int.Min \<le> Int.Bit0 k \<longleftrightarrow> Int.Min < k"
 31.1310 -  "Int.Min \<le> Int.Bit1 k \<longleftrightarrow> Int.Min \<le> k"
 31.1311 -  "Int.Bit0 k \<le> Int.Pls \<longleftrightarrow> k \<le> Int.Pls"
 31.1312 -  "Int.Bit1 k \<le> Int.Pls \<longleftrightarrow> k < Int.Pls"
 31.1313 -  "Int.Bit0 k \<le> Int.Min \<longleftrightarrow> k \<le> Int.Min"
 31.1314 -  "Int.Bit1 k \<le> Int.Min \<longleftrightarrow> k \<le> Int.Min"
 31.1315 -  "Int.Bit0 k1 \<le> Int.Bit0 k2 \<longleftrightarrow> k1 \<le> k2"
 31.1316 -  "Int.Bit0 k1 \<le> Int.Bit1 k2 \<longleftrightarrow> k1 \<le> k2"
 31.1317 -  "Int.Bit1 k1 \<le> Int.Bit0 k2 \<longleftrightarrow> k1 < k2"
 31.1318 -  "Int.Bit1 k1 \<le> Int.Bit1 k2 \<longleftrightarrow> k1 \<le> k2"
 31.1319 +  "0 \<le> (0::int) \<longleftrightarrow> True"
 31.1320 +  "0 \<le> Pos l \<longleftrightarrow> True"
 31.1321 +  "0 \<le> Neg l \<longleftrightarrow> False"
 31.1322 +  "Pos k \<le> 0 \<longleftrightarrow> False"
 31.1323 +  "Pos k \<le> Pos l \<longleftrightarrow> k \<le> l"
 31.1324 +  "Pos k \<le> Neg l \<longleftrightarrow> False"
 31.1325 +  "Neg k \<le> 0 \<longleftrightarrow> True"
 31.1326 +  "Neg k \<le> Pos l \<longleftrightarrow> True"
 31.1327 +  "Neg k \<le> Neg l \<longleftrightarrow> l \<le> k"
 31.1328    by simp_all
 31.1329  
 31.1330 -lemma less_number_of_int_code [code]:
 31.1331 -  "(number_of k \<Colon> int) < number_of l \<longleftrightarrow> k < l"
 31.1332 -  unfolding number_of_is_id ..
 31.1333 -
 31.1334  lemma less_int_code [code]:
 31.1335 -  "Int.Pls < Int.Pls \<longleftrightarrow> False"
 31.1336 -  "Int.Pls < Int.Min \<longleftrightarrow> False"
 31.1337 -  "Int.Pls < Int.Bit0 k \<longleftrightarrow> Int.Pls < k"
 31.1338 -  "Int.Pls < Int.Bit1 k \<longleftrightarrow> Int.Pls \<le> k"
 31.1339 -  "Int.Min < Int.Pls \<longleftrightarrow> True"
 31.1340 -  "Int.Min < Int.Min \<longleftrightarrow> False"
 31.1341 -  "Int.Min < Int.Bit0 k \<longleftrightarrow> Int.Min < k"
 31.1342 -  "Int.Min < Int.Bit1 k \<longleftrightarrow> Int.Min < k"
 31.1343 -  "Int.Bit0 k < Int.Pls \<longleftrightarrow> k < Int.Pls"
 31.1344 -  "Int.Bit1 k < Int.Pls \<longleftrightarrow> k < Int.Pls"
 31.1345 -  "Int.Bit0 k < Int.Min \<longleftrightarrow> k \<le> Int.Min"
 31.1346 -  "Int.Bit1 k < Int.Min \<longleftrightarrow> k < Int.Min"
 31.1347 -  "Int.Bit0 k1 < Int.Bit0 k2 \<longleftrightarrow> k1 < k2"
 31.1348 -  "Int.Bit0 k1 < Int.Bit1 k2 \<longleftrightarrow> k1 \<le> k2"
 31.1349 -  "Int.Bit1 k1 < Int.Bit0 k2 \<longleftrightarrow> k1 < k2"
 31.1350 -  "Int.Bit1 k1 < Int.Bit1 k2 \<longleftrightarrow> k1 < k2"
 31.1351 +  "0 < (0::int) \<longleftrightarrow> False"
 31.1352 +  "0 < Pos l \<longleftrightarrow> True"
 31.1353 +  "0 < Neg l \<longleftrightarrow> False"
 31.1354 +  "Pos k < 0 \<longleftrightarrow> False"
 31.1355 +  "Pos k < Pos l \<longleftrightarrow> k < l"
 31.1356 +  "Pos k < Neg l \<longleftrightarrow> False"
 31.1357 +  "Neg k < 0 \<longleftrightarrow> True"
 31.1358 +  "Neg k < Pos l \<longleftrightarrow> True"
 31.1359 +  "Neg k < Neg l \<longleftrightarrow> l < k"
 31.1360    by simp_all
 31.1361  
 31.1362 -definition
 31.1363 -  nat_aux :: "int \<Rightarrow> nat \<Rightarrow> nat" where
 31.1364 -  "nat_aux i n = nat i + n"
 31.1365 -
 31.1366 -lemma [code]:
 31.1367 -  "nat_aux i n = (if i \<le> 0 then n else nat_aux (i - 1) (Suc n))"  -- {* tail recursive *}
 31.1368 -  by (auto simp add: nat_aux_def nat_eq_iff linorder_not_le order_less_imp_le
 31.1369 -    dest: zless_imp_add1_zle)
 31.1370 +lemma nat_numeral [simp, code_abbrev]:
 31.1371 +  "nat (numeral k) = numeral k"
 31.1372 +  by (simp add: nat_eq_iff)
 31.1373  
 31.1374 -lemma [code]: "nat i = nat_aux i 0"
 31.1375 -  by (simp add: nat_aux_def)
 31.1376 -
 31.1377 -hide_const (open) nat_aux
 31.1378 +lemma nat_code [code]:
 31.1379 +  "nat (Int.Neg k) = 0"
 31.1380 +  "nat 0 = 0"
 31.1381 +  "nat (Int.Pos k) = nat_of_num k"
 31.1382 +  by (simp_all add: nat_of_num_numeral nat_numeral)
 31.1383  
 31.1384 -lemma zero_is_num_zero [code, code_unfold]:
 31.1385 -  "(0\<Colon>int) = Numeral0" 
 31.1386 -  by simp
 31.1387 +lemma (in ring_1) of_int_code [code]:
 31.1388 +  "of_int (Int.Neg k) = neg_numeral k"
 31.1389 +  "of_int 0 = 0"
 31.1390 +  "of_int (Int.Pos k) = numeral k"
 31.1391 +  by simp_all
 31.1392  
 31.1393 -lemma one_is_num_one [code, code_unfold]:
 31.1394 -  "(1\<Colon>int) = Numeral1" 
 31.1395 -  by simp
 31.1396 +
 31.1397 +text {* Serializer setup *}
 31.1398  
 31.1399  code_modulename SML
 31.1400    Int Arith
 31.1401 @@ -2345,7 +1719,7 @@
 31.1402  
 31.1403  quickcheck_params [default_type = int]
 31.1404  
 31.1405 -hide_const (open) Pls Min Bit0 Bit1 succ pred
 31.1406 +hide_const (open) Pos Neg sub dup
 31.1407  
 31.1408  
 31.1409  subsection {* Legacy theorems *}
 31.1410 @@ -2378,3 +1752,4 @@
 31.1411  lemmas zpower_int = int_power [symmetric]
 31.1412  
 31.1413  end
 31.1414 +
    32.1 --- a/src/HOL/IsaMakefile	Mon Mar 26 15:32:54 2012 +0200
    32.2 +++ b/src/HOL/IsaMakefile	Mon Mar 26 15:33:28 2012 +0200
    32.3 @@ -195,6 +195,7 @@
    32.4    Meson.thy \
    32.5    Metis.thy \
    32.6    Nat.thy \
    32.7 +  Num.thy \
    32.8    Option.thy \
    32.9    Orderings.thy \
   32.10    Partial_Function.thy \
   32.11 @@ -341,7 +342,6 @@
   32.12    Tools/Nitpick/nitpick_util.ML \
   32.13    Tools/numeral.ML \
   32.14    Tools/numeral_simprocs.ML \
   32.15 -  Tools/numeral_syntax.ML \
   32.16    Tools/Predicate_Compile/core_data.ML \
   32.17    Tools/Predicate_Compile/mode_inference.ML \
   32.18    Tools/Predicate_Compile/predicate_compile_aux.ML \
   32.19 @@ -444,24 +444,25 @@
   32.20    Library/Bit.thy Library/Boolean_Algebra.thy Library/Cardinality.thy	\
   32.21    Library/Char_nat.thy Library/Code_Char.thy Library/Code_Char_chr.thy	\
   32.22    Library/Code_Char_ord.thy Library/Code_Integer.thy			\
   32.23 -  Library/Code_Natural.thy Library/Code_Prolog.thy			\
   32.24 +  Library/Code_Nat.thy Library/Code_Natural.thy				\
   32.25 +  Library/Efficient_Nat.thy Library/Code_Prolog.thy			\
   32.26    Library/Code_Real_Approx_By_Float.thy					\
   32.27    Tools/Predicate_Compile/code_prolog.ML Library/ContNotDenum.thy	\
   32.28    Library/Cset.thy Library/Cset_Monad.thy Library/Continuity.thy	\
   32.29    Library/Convex.thy Library/Countable.thy				\
   32.30 +  Library/Dlist.thy Library/Dlist_Cset.thy Library/Eval_Witness.thy	\
   32.31    Library/DAList.thy Library/Dlist.thy Library/Dlist_Cset.thy 		\
   32.32 -  Library/Efficient_Nat.thy Library/Eval_Witness.thy			\
   32.33 +  Library/Eval_Witness.thy						\
   32.34    Library/Extended_Real.thy Library/Extended_Nat.thy Library/Float.thy	\
   32.35    Library/Formal_Power_Series.thy Library/Fraction_Field.thy		\
   32.36    Library/FrechetDeriv.thy Library/Cset.thy Library/FuncSet.thy		\
   32.37 -  Library/Function_Algebras.thy						\
   32.38 -  Library/Fundamental_Theorem_Algebra.thy Library/Glbs.thy		\
   32.39 -  Library/Indicator_Function.thy Library/Infinite_Set.thy		\
   32.40 -  Library/Inner_Product.thy Library/Kleene_Algebra.thy			\
   32.41 -  Library/LaTeXsugar.thy Library/Lattice_Algebras.thy			\
   32.42 -  Library/Lattice_Syntax.thy Library/Library.thy Library/List_Cset.thy	\
   32.43 -  Library/List_Prefix.thy Library/List_lexord.thy Library/Mapping.thy	\
   32.44 -  Library/Monad_Syntax.thy						\
   32.45 +  Library/Function_Algebras.thy Library/Fundamental_Theorem_Algebra.thy	\
   32.46 +  Library/Glbs.thy Library/Indicator_Function.thy			\
   32.47 +  Library/Infinite_Set.thy Library/Inner_Product.thy			\
   32.48 +  Library/Kleene_Algebra.thy Library/LaTeXsugar.thy			\
   32.49 +  Library/Lattice_Algebras.thy Library/Lattice_Syntax.thy		\
   32.50 +  Library/Library.thy Library/List_Cset.thy Library/List_Prefix.thy	\
   32.51 +  Library/List_lexord.thy Library/Mapping.thy Library/Monad_Syntax.thy	\
   32.52    Library/Multiset.thy Library/Nat_Bijection.thy			\
   32.53    Library/Numeral_Type.thy Library/Old_Recdef.thy			\
   32.54    Library/OptionalSugar.thy Library/Order_Relation.thy			\
   32.55 @@ -479,7 +480,7 @@
   32.56    Library/State_Monad.thy Library/Ramsey.thy				\
   32.57    Library/Reflection.thy Library/Sublist_Order.thy			\
   32.58    Library/Sum_of_Squares.thy Library/Sum_of_Squares/sos_wrapper.ML	\
   32.59 -  Library/Sum_of_Squares/sum_of_squares.ML				\
   32.60 +  Library/Sum_of_Squares/sum_of_squares.ML Library/Target_Numeral.thy	\
   32.61    Library/Transitive_Closure_Table.thy Library/Univ_Poly.thy		\
   32.62    Library/Wfrec.thy Library/While_Combinator.thy Library/Zorn.thy	\
   32.63    $(SRC)/Tools/adhoc_overloading.ML Library/positivstellensatz.ML	\
   32.64 @@ -758,11 +759,11 @@
   32.65  
   32.66  HOL-Library-Codegenerator_Test: HOL-Library $(LOG)/HOL-Library-Codegenerator_Test.gz
   32.67  
   32.68 -$(LOG)/HOL-Library-Codegenerator_Test.gz: $(OUT)/HOL-Library		\
   32.69 -  Codegenerator_Test/ROOT.ML 						\
   32.70 -  Codegenerator_Test/Candidates.thy					\
   32.71 -  Codegenerator_Test/Candidates_Pretty.thy				\
   32.72 -  Codegenerator_Test/Generate.thy					\
   32.73 +$(LOG)/HOL-Library-Codegenerator_Test.gz: $(OUT)/HOL-Library \
   32.74 +  Codegenerator_Test/ROOT.ML \
   32.75 +  Codegenerator_Test/Candidates.thy \
   32.76 +  Codegenerator_Test/Candidates_Pretty.thy \
   32.77 +  Codegenerator_Test/Generate.thy \
   32.78    Codegenerator_Test/Generate_Pretty.thy
   32.79  	@$(ISABELLE_TOOL) usedir -d false -g false -i false $(OUT)/HOL-Library Codegenerator_Test
   32.80  
   32.81 @@ -920,6 +921,10 @@
   32.82  HOL-Imperative_HOL: HOL $(LOG)/HOL-Imperative_HOL.gz
   32.83  
   32.84  $(LOG)/HOL-Imperative_HOL.gz: $(OUT)/HOL \
   32.85 +  Library/Code_Integer.thy \
   32.86 +  Library/Code_Nat.thy \
   32.87 +  Library/Code_Natural.thy \
   32.88 +  Library/Efficient_Nat.thy \
   32.89    Imperative_HOL/Array.thy \
   32.90    Imperative_HOL/Heap.thy \
   32.91    Imperative_HOL/Heap_Monad.thy \
   32.92 @@ -943,6 +948,10 @@
   32.93  HOL-Decision_Procs: HOL $(LOG)/HOL-Decision_Procs.gz
   32.94  
   32.95  $(LOG)/HOL-Decision_Procs.gz: $(OUT)/HOL \
   32.96 +  Library/Code_Integer.thy \
   32.97 +  Library/Code_Nat.thy \
   32.98 +  Library/Code_Natural.thy \
   32.99 +  Library/Efficient_Nat.thy \
  32.100    Decision_Procs/Approximation.thy \
  32.101    Decision_Procs/Commutative_Ring.thy \
  32.102    Decision_Procs/Commutative_Ring_Complete.thy \
  32.103 @@ -991,9 +1000,12 @@
  32.104  HOL-Proofs-Extraction: HOL-Proofs $(LOG)/HOL-Proofs-Extraction.gz
  32.105  
  32.106  $(LOG)/HOL-Proofs-Extraction.gz: $(OUT)/HOL-Proofs		\
  32.107 -  Library/Efficient_Nat.thy Proofs/Extraction/Euclid.thy	\
  32.108 +  Library/Code_Integer.thy Library/Code_Nat.thy			\
  32.109 +  Library/Code_Natural.thy Library/Efficient_Nat.thy		\
  32.110 +  Proofs/Extraction/Euclid.thy					\
  32.111    Proofs/Extraction/Greatest_Common_Divisor.thy			\
  32.112 -  Proofs/Extraction/Higman.thy Proofs/Extraction/Higman_Extraction.thy	\
  32.113 +  Proofs/Extraction/Higman.thy					\
  32.114 +  Proofs/Extraction/Higman_Extraction.thy			\
  32.115    Proofs/Extraction/Pigeonhole.thy				\
  32.116    Proofs/Extraction/QuotRem.thy Proofs/Extraction/ROOT.ML	\
  32.117    Proofs/Extraction/Util.thy Proofs/Extraction/Warshall.thy	\
  32.118 @@ -1113,15 +1125,17 @@
  32.119  HOL-ex: HOL $(LOG)/HOL-ex.gz
  32.120  
  32.121  $(LOG)/HOL-ex.gz: $(OUT)/HOL Decision_Procs/Commutative_Ring.thy	\
  32.122 +  Library/Code_Integer.thy Library/Code_Nat.thy				\
  32.123 +  Library/Code_Natural.thy Library/Efficient_Nat.thy			\
  32.124    Number_Theory/Primes.thy ex/Abstract_NAT.thy ex/Antiquote.thy		\
  32.125    ex/Arith_Examples.thy ex/Arithmetic_Series_Complex.thy ex/BT.thy	\
  32.126    ex/BinEx.thy ex/Binary.thy ex/Birthday_Paradox.thy ex/CTL.thy		\
  32.127    ex/Case_Product.thy ex/Chinese.thy ex/Classical.thy			\
  32.128 -  ex/Coercion_Examples.thy ex/Coherent.thy				\
  32.129 -  ex/Dedekind_Real.thy ex/Efficient_Nat_examples.thy			\
  32.130 +  ex/Code_Nat_examples.thy						\
  32.131 +  ex/Coercion_Examples.thy ex/Coherent.thy ex/Dedekind_Real.thy		\
  32.132    ex/Eval_Examples.thy ex/Executable_Relation.thy ex/Fundefs.thy	\
  32.133    ex/Gauge_Integration.thy ex/Groebner_Examples.thy ex/Guess.thy	\
  32.134 -  ex/HarmonicSeries.thy ex/Hebrew.thy ex/Hex_Bin_Examples.thy 		\
  32.135 +  ex/HarmonicSeries.thy ex/Hebrew.thy ex/Hex_Bin_Examples.thy		\
  32.136    ex/Higher_Order_Logic.thy ex/Iff_Oracle.thy ex/Induction_Schema.thy	\
  32.137    ex/Interpretation_with_Defs.thy ex/Intuitionistic.thy			\
  32.138    ex/Lagrange.thy ex/List_to_Set_Comprehension_Examples.thy		\
    33.1 --- a/src/HOL/Library/BigO.thy	Mon Mar 26 15:32:54 2012 +0200
    33.2 +++ b/src/HOL/Library/BigO.thy	Mon Mar 26 15:33:28 2012 +0200
    33.3 @@ -132,7 +132,6 @@
    33.4    apply (simp add: abs_triangle_ineq)
    33.5    apply (simp add: order_less_le)
    33.6    apply (rule mult_nonneg_nonneg)
    33.7 -  apply (rule add_nonneg_nonneg)
    33.8    apply auto
    33.9    apply (rule_tac x = "%n. if (abs (f n)) <  abs (g n) then x n else 0" 
   33.10       in exI)
   33.11 @@ -150,11 +149,8 @@
   33.12    apply (rule abs_triangle_ineq)
   33.13    apply (simp add: order_less_le)
   33.14    apply (rule mult_nonneg_nonneg)
   33.15 -  apply (rule add_nonneg_nonneg)
   33.16 -  apply (erule order_less_imp_le)+
   33.17 +  apply (erule order_less_imp_le)
   33.18    apply simp
   33.19 -  apply (rule ext)
   33.20 -  apply (auto simp add: if_splits linorder_not_le)
   33.21    done
   33.22  
   33.23  lemma bigo_plus_subset2 [intro]: "A <= O(f) ==> B <= O(f) ==> A \<oplus> B <= O(f)"
    34.1 --- a/src/HOL/Library/Binomial.thy	Mon Mar 26 15:32:54 2012 +0200
    34.2 +++ b/src/HOL/Library/Binomial.thy	Mon Mar 26 15:33:28 2012 +0200
    34.3 @@ -350,7 +350,7 @@
    34.4      have eq: "(- (1\<Colon>'a)) ^ n = setprod (\<lambda>i. - 1) {0 .. n - 1}"
    34.5        by auto
    34.6      from n0 have ?thesis 
    34.7 -      by (simp add: pochhammer_def gbinomial_def field_simps eq setprod_timesf[symmetric])}
    34.8 +      by (simp add: pochhammer_def gbinomial_def field_simps eq setprod_timesf[symmetric] del: minus_one) (* FIXME: del: minus_one *)}
    34.9    ultimately show ?thesis by blast
   34.10  qed
   34.11  
   34.12 @@ -417,8 +417,8 @@
   34.13      from eq[symmetric]
   34.14      have ?thesis using kn
   34.15        apply (simp add: binomial_fact[OF kn, where ?'a = 'a] 
   34.16 -        gbinomial_pochhammer field_simps pochhammer_Suc_setprod)
   34.17 -      apply (simp add: pochhammer_Suc_setprod fact_altdef_nat h of_nat_setprod setprod_timesf[symmetric] eq' del: One_nat_def power_Suc)
   34.18 +        gbinomial_pochhammer field_simps pochhammer_Suc_setprod del: minus_one)
   34.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)
   34.20        unfolding setprod_Un_disjoint[OF th0, unfolded eq3, of "of_nat:: nat \<Rightarrow> 'a"] eq[unfolded h]
   34.21        unfolding mult_assoc[symmetric] 
   34.22        unfolding setprod_timesf[symmetric]
    35.1 --- a/src/HOL/Library/Bit.thy	Mon Mar 26 15:32:54 2012 +0200
    35.2 +++ b/src/HOL/Library/Bit.thy	Mon Mar 26 15:33:28 2012 +0200
    35.3 @@ -96,27 +96,18 @@
    35.4  
    35.5  subsection {* Numerals at type @{typ bit} *}
    35.6  
    35.7 -instantiation bit :: number_ring
    35.8 -begin
    35.9 -
   35.10 -definition number_of_bit_def:
   35.11 -  "(number_of w :: bit) = of_int w"
   35.12 -
   35.13 -instance proof
   35.14 -qed (rule number_of_bit_def)
   35.15 -
   35.16 -end
   35.17 -
   35.18  text {* All numerals reduce to either 0 or 1. *}
   35.19  
   35.20  lemma bit_minus1 [simp]: "-1 = (1 :: bit)"
   35.21 -  by (simp only: number_of_Min uminus_bit_def)
   35.22 +  by (simp only: minus_one [symmetric] uminus_bit_def)
   35.23 +
   35.24 +lemma bit_neg_numeral [simp]: "(neg_numeral w :: bit) = numeral w"
   35.25 +  by (simp only: neg_numeral_def uminus_bit_def)
   35.26  
   35.27 -lemma bit_number_of_even [simp]: "number_of (Int.Bit0 w) = (0 :: bit)"
   35.28 -  by (simp only: number_of_Bit0 add_0_left bit_add_self)
   35.29 +lemma bit_numeral_even [simp]: "numeral (Num.Bit0 w) = (0 :: bit)"
   35.30 +  by (simp only: numeral_Bit0 bit_add_self)
   35.31  
   35.32 -lemma bit_number_of_odd [simp]: "number_of (Int.Bit1 w) = (1 :: bit)"
   35.33 -  by (simp only: number_of_Bit1 add_assoc bit_add_self
   35.34 -                 monoid_add_class.add_0_right)
   35.35 +lemma bit_numeral_odd [simp]: "numeral (Num.Bit1 w) = (1 :: bit)"
   35.36 +  by (simp only: numeral_Bit1 bit_add_self add_0_left)
   35.37  
   35.38  end
    36.1 --- a/src/HOL/Library/Cardinality.thy	Mon Mar 26 15:32:54 2012 +0200
    36.2 +++ b/src/HOL/Library/Cardinality.thy	Mon Mar 26 15:33:28 2012 +0200
    36.3 @@ -5,7 +5,7 @@
    36.4  header {* Cardinality of types *}
    36.5  
    36.6  theory Cardinality
    36.7 -imports Main
    36.8 +imports "~~/src/HOL/Main"
    36.9  begin
   36.10  
   36.11  subsection {* Preliminary lemmas *}
    37.1 --- a/src/HOL/Library/Code_Integer.thy	Mon Mar 26 15:32:54 2012 +0200
    37.2 +++ b/src/HOL/Library/Code_Integer.thy	Mon Mar 26 15:33:28 2012 +0200
    37.3 @@ -9,6 +9,43 @@
    37.4  begin
    37.5  
    37.6  text {*
    37.7 +  Representation-ignorant code equations for conversions.
    37.8 +*}
    37.9 +
   37.10 +lemma nat_code [code]:
   37.11 +  "nat k = (if k \<le> 0 then 0 else
   37.12 +     let
   37.13 +       (l, j) = divmod_int k 2;
   37.14 +       l' = 2 * nat l
   37.15 +     in if j = 0 then l' else Suc l')"
   37.16 +proof -
   37.17 +  have "2 = nat 2" by simp
   37.18 +  show ?thesis
   37.19 +    apply (auto simp add: Let_def divmod_int_mod_div not_le
   37.20 +     nat_div_distrib nat_mult_distrib mult_div_cancel mod_2_not_eq_zero_eq_one_int)
   37.21 +    apply (unfold `2 = nat 2`)
   37.22 +    apply (subst nat_mod_distrib [symmetric])
   37.23 +    apply simp_all
   37.24 +  done
   37.25 +qed
   37.26 +
   37.27 +lemma (in ring_1) of_int_code:
   37.28 +  "of_int k = (if k = 0 then 0
   37.29 +     else if k < 0 then - of_int (- k)
   37.30 +     else let
   37.31 +       (l, j) = divmod_int k 2;
   37.32 +       l' = 2 * of_int l
   37.33 +     in if j = 0 then l' else l' + 1)"
   37.34 +proof -
   37.35 +  from mod_div_equality have *: "of_int k = of_int (k div 2 * 2 + k mod 2)" by simp
   37.36 +  show ?thesis
   37.37 +    by (simp add: Let_def divmod_int_mod_div mod_2_not_eq_zero_eq_one_int
   37.38 +      of_int_add [symmetric]) (simp add: * mult_commute)
   37.39 +qed
   37.40 +
   37.41 +declare of_int_code [code]
   37.42 +
   37.43 +text {*
   37.44    HOL numeral expressions are mapped to integer literals
   37.45    in target languages, using predefined target language
   37.46    operations for abstract integer operations.
   37.47 @@ -24,42 +61,21 @@
   37.48  code_instance int :: equal
   37.49    (Haskell -)
   37.50  
   37.51 +code_const "0::int"
   37.52 +  (SML "0")
   37.53 +  (OCaml "Big'_int.zero'_big'_int")
   37.54 +  (Haskell "0")
   37.55 +  (Scala "BigInt(0)")
   37.56 +
   37.57  setup {*
   37.58 -  fold (Numeral.add_code @{const_name number_int_inst.number_of_int}
   37.59 -    true Code_Printer.literal_numeral) ["SML", "OCaml", "Haskell", "Scala"]
   37.60 +  fold (Numeral.add_code @{const_name Int.Pos}
   37.61 +    false Code_Printer.literal_numeral) ["SML", "OCaml", "Haskell", "Scala"]
   37.62  *}
   37.63  
   37.64 -code_const "Int.Pls" and "Int.Min" and "Int.Bit0" and "Int.Bit1"
   37.65 -  (SML "raise/ Fail/ \"Pls\""
   37.66 -     and "raise/ Fail/ \"Min\""
   37.67 -     and "!((_);/ raise/ Fail/ \"Bit0\")"
   37.68 -     and "!((_);/ raise/ Fail/ \"Bit1\")")
   37.69 -  (OCaml "failwith/ \"Pls\""
   37.70 -     and "failwith/ \"Min\""
   37.71 -     and "!((_);/ failwith/ \"Bit0\")"
   37.72 -     and "!((_);/ failwith/ \"Bit1\")")
   37.73 -  (Haskell "error/ \"Pls\""
   37.74 -     and "error/ \"Min\""
   37.75 -     and "error/ \"Bit0\""
   37.76 -     and "error/ \"Bit1\"")
   37.77 -  (Scala "!error(\"Pls\")"
   37.78 -     and "!error(\"Min\")"
   37.79 -     and "!error(\"Bit0\")"
   37.80 -     and "!error(\"Bit1\")")
   37.81 -
   37.82 -code_const Int.pred
   37.83 -  (SML "IntInf.- ((_), 1)")
   37.84 -  (OCaml "Big'_int.pred'_big'_int")
   37.85 -  (Haskell "!(_/ -/ 1)")
   37.86 -  (Scala "!(_ -/ 1)")
   37.87 -  (Eval "!(_/ -/ 1)")
   37.88 -
   37.89 -code_const Int.succ
   37.90 -  (SML "IntInf.+ ((_), 1)")
   37.91 -  (OCaml "Big'_int.succ'_big'_int")
   37.92 -  (Haskell "!(_/ +/ 1)")
   37.93 -  (Scala "!(_ +/ 1)")
   37.94 -  (Eval "!(_/ +/ 1)")
   37.95 +setup {*
   37.96 +  fold (Numeral.add_code @{const_name Int.Neg}
   37.97 +    true Code_Printer.literal_numeral) ["SML", "OCaml", "Haskell", "Scala"]
   37.98 +*}
   37.99  
  37.100  code_const "op + \<Colon> int \<Rightarrow> int \<Rightarrow> int"
  37.101    (SML "IntInf.+ ((_), (_))")
  37.102 @@ -82,6 +98,19 @@
  37.103    (Scala infixl 7 "-")
  37.104    (Eval infixl 8 "-")
  37.105  
  37.106 +code_const Int.dup
  37.107 +  (SML "IntInf.*/ (2,/ (_))")
  37.108 +  (OCaml "Big'_int.mult'_big'_int/ 2")
  37.109 +  (Haskell "!(2 * _)")
  37.110 +  (Scala "!(2 * _)")
  37.111 +  (Eval "!(2 * _)")
  37.112 +
  37.113 +code_const Int.sub
  37.114 +  (SML "!(raise/ Fail/ \"sub\")")
  37.115 +  (OCaml "failwith/ \"sub\"")
  37.116 +  (Haskell "error/ \"sub\"")
  37.117 +  (Scala "!error(\"sub\")")
  37.118 +
  37.119  code_const "op * \<Colon> int \<Rightarrow> int \<Rightarrow> int"
  37.120    (SML "IntInf.* ((_), (_))")
  37.121    (OCaml "Big'_int.mult'_big'_int")
  37.122 @@ -124,9 +153,7 @@
  37.123    (Scala "!_.as'_BigInt")
  37.124    (Eval "_")
  37.125  
  37.126 -text {* Evaluation *}
  37.127 -
  37.128  code_const "Code_Evaluation.term_of \<Colon> int \<Rightarrow> term"
  37.129    (Eval "HOLogic.mk'_number/ HOLogic.intT")
  37.130  
  37.131 -end
  37.132 \ No newline at end of file
  37.133 +end
    38.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    38.2 +++ b/src/HOL/Library/Code_Nat.thy	Mon Mar 26 15:33:28 2012 +0200
    38.3 @@ -0,0 +1,258 @@
    38.4 +(*  Title:      HOL/Library/Code_Nat.thy
    38.5 +    Author:     Stefan Berghofer, Florian Haftmann, TU Muenchen
    38.6 +*)
    38.7 +
    38.8 +header {* Implementation of natural numbers as binary numerals *}
    38.9 +
   38.10 +theory Code_Nat
   38.11 +imports Main
   38.12 +begin
   38.13 +
   38.14 +text {*
   38.15 +  When generating code for functions on natural numbers, the
   38.16 +  canonical representation using @{term "0::nat"} and
   38.17 +  @{term Suc} is unsuitable for computations involving large
   38.18 +  numbers.  This theory refines the representation of
   38.19 +  natural numbers for code generation to use binary
   38.20 +  numerals, which do not grow linear in size but logarithmic.
   38.21 +*}
   38.22 +
   38.23 +subsection {* Representation *}
   38.24 +
   38.25 +lemma [code_abbrev]:
   38.26 +  "nat_of_num = numeral"
   38.27 +  by (fact nat_of_num_numeral)
   38.28 +
   38.29 +code_datatype "0::nat" nat_of_num
   38.30 +
   38.31 +lemma [code]:
   38.32 +  "num_of_nat 0 = Num.One"
   38.33 +  "num_of_nat (nat_of_num k) = k"
   38.34 +  by (simp_all add: nat_of_num_inverse)
   38.35 +
   38.36 +lemma [code]:
   38.37 +  "(1\<Colon>nat) = Numeral1"
   38.38 +  by simp
   38.39 +
   38.40 +lemma [code_abbrev]: "Numeral1 = (1\<Colon>nat)"
   38.41 +  by simp
   38.42 +
   38.43 +lemma [code]:
   38.44 +  "Suc n = n + 1"
   38.45 +  by simp
   38.46 +
   38.47 +
   38.48 +subsection {* Basic arithmetic *}
   38.49 +
   38.50 +lemma [code, code del]:
   38.51 +  "(plus :: nat \<Rightarrow> _) = plus" ..
   38.52 +
   38.53 +lemma plus_nat_code [code]:
   38.54 +  "nat_of_num k + nat_of_num l = nat_of_num (k + l)"
   38.55 +  "m + 0 = (m::nat)"
   38.56 +  "0 + n = (n::nat)"
   38.57 +  by (simp_all add: nat_of_num_numeral)
   38.58 +
   38.59 +text {* Bounded subtraction needs some auxiliary *}
   38.60 +
   38.61 +definition dup :: "nat \<Rightarrow> nat" where
   38.62 +  "dup n = n + n"
   38.63 +
   38.64 +lemma dup_code [code]:
   38.65 +  "dup 0 = 0"
   38.66 +  "dup (nat_of_num k) = nat_of_num (Num.Bit0 k)"
   38.67 +  unfolding Num_def by (simp_all add: dup_def numeral_Bit0)
   38.68 +
   38.69 +definition sub :: "num \<Rightarrow> num \<Rightarrow> nat option" where
   38.70 +  "sub k l = (if k \<ge> l then Some (numeral k - numeral l) else None)"
   38.71 +
   38.72 +lemma sub_code [code]:
   38.73 +  "sub Num.One Num.One = Some 0"
   38.74 +  "sub (Num.Bit0 m) Num.One = Some (nat_of_num (Num.BitM m))"
   38.75 +  "sub (Num.Bit1 m) Num.One = Some (nat_of_num (Num.Bit0 m))"
   38.76 +  "sub Num.One (Num.Bit0 n) = None"
   38.77 +  "sub Num.One (Num.Bit1 n) = None"
   38.78 +  "sub (Num.Bit0 m) (Num.Bit0 n) = Option.map dup (sub m n)"
   38.79 +  "sub (Num.Bit1 m) (Num.Bit1 n) = Option.map dup (sub m n)"
   38.80 +  "sub (Num.Bit1 m) (Num.Bit0 n) = Option.map (\<lambda>q. dup q + 1) (sub m n)"
   38.81 +  "sub (Num.Bit0 m) (Num.Bit1 n) = (case sub m n of None \<Rightarrow> None
   38.82 +     | Some q \<Rightarrow> if q = 0 then None else Some (dup q - 1))"
   38.83 +  apply (auto simp add: nat_of_num_numeral
   38.84 +    Num.dbl_def Num.dbl_inc_def Num.dbl_dec_def
   38.85 +    Let_def le_imp_diff_is_add BitM_plus_one sub_def dup_def)
   38.86 +  apply (simp_all add: sub_non_positive)
   38.87 +  apply (simp_all add: sub_non_negative [symmetric, where ?'a = int])
   38.88 +  done
   38.89 +
   38.90 +lemma [code, code del]:
   38.91 +  "(minus :: nat \<Rightarrow> _) = minus" ..
   38.92 +
   38.93 +lemma minus_nat_code [code]:
   38.94 +  "nat_of_num k - nat_of_num l = (case sub k l of None \<Rightarrow> 0 | Some j \<Rightarrow> j)"
   38.95 +  "m - 0 = (m::nat)"
   38.96 +  "0 - n = (0::nat)"
   38.97 +  by (simp_all add: nat_of_num_numeral sub_non_positive sub_def)
   38.98 +
   38.99 +lemma [code, code del]:
  38.100 +  "(times :: nat \<Rightarrow> _) = times" ..
  38.101 +
  38.102 +lemma times_nat_code [code]:
  38.103 +  "nat_of_num k * nat_of_num l = nat_of_num (k * l)"
  38.104 +  "m * 0 = (0::nat)"
  38.105 +  "0 * n = (0::nat)"
  38.106 +  by (simp_all add: nat_of_num_numeral)
  38.107 +
  38.108 +lemma [code, code del]:
  38.109 +  "(HOL.equal :: nat \<Rightarrow> _) = HOL.equal" ..
  38.110 +
  38.111 +lemma equal_nat_code [code]:
  38.112 +  "HOL.equal 0 (0::nat) \<longleftrightarrow> True"
  38.113 +  "HOL.equal 0 (nat_of_num l) \<longleftrightarrow> False"
  38.114 +  "HOL.equal (nat_of_num k) 0 \<longleftrightarrow> False"
  38.115 +  "HOL.equal (nat_of_num k) (nat_of_num l) \<longleftrightarrow> HOL.equal k l"
  38.116 +  by (simp_all add: nat_of_num_numeral equal)
  38.117 +
  38.118 +lemma equal_nat_refl [code nbe]:
  38.119 +  "HOL.equal (n::nat) n \<longleftrightarrow> True"
  38.120 +  by (rule equal_refl)
  38.121 +
  38.122 +lemma [code, code del]:
  38.123 +  "(less_eq :: nat \<Rightarrow> _) = less_eq" ..
  38.124 +
  38.125 +lemma less_eq_nat_code [code]:
  38.126 +  "0 \<le> (n::nat) \<longleftrightarrow> True"
  38.127 +  "nat_of_num k \<le> 0 \<longleftrightarrow> False"
  38.128 +  "nat_of_num k \<le> nat_of_num l \<longleftrightarrow> k \<le> l"
  38.129 +  by (simp_all add: nat_of_num_numeral)
  38.130 +
  38.131 +lemma [code, code del]:
  38.132 +  "(less :: nat \<Rightarrow> _) = less" ..
  38.133 +
  38.134 +lemma less_nat_code [code]:
  38.135 +  "(m::nat) < 0 \<longleftrightarrow> False"
  38.136 +  "0 < nat_of_num l \<longleftrightarrow> True"
  38.137 +  "nat_of_num k < nat_of_num l \<longleftrightarrow> k < l"
  38.138 +  by (simp_all add: nat_of_num_numeral)
  38.139 +
  38.140 +
  38.141 +subsection {* Conversions *}
  38.142 +
  38.143 +lemma [code, code del]:
  38.144 +  "of_nat = of_nat" ..
  38.145 +
  38.146 +lemma of_nat_code [code]:
  38.147 +  "of_nat 0 = 0"
  38.148 +  "of_nat (nat_of_num k) = numeral k"
  38.149 +  by (simp_all add: nat_of_num_numeral)
  38.150 +
  38.151 +
  38.152 +subsection {* Case analysis *}
  38.153 +
  38.154 +text {*
  38.155 +  Case analysis on natural numbers is rephrased using a conditional
  38.156 +  expression:
  38.157 +*}
  38.158 +
  38.159 +lemma [code, code_unfold]:
  38.160 +  "nat_case = (\<lambda>f g n. if n = 0 then f else g (n - 1))"
  38.161 +  by (auto simp add: fun_eq_iff dest!: gr0_implies_Suc)
  38.162 +
  38.163 +
  38.164 +subsection {* Preprocessors *}
  38.165 +
  38.166 +text {*
  38.167 +  The term @{term "Suc n"} is no longer a valid pattern.
  38.168 +  Therefore, all occurrences of this term in a position
  38.169 +  where a pattern is expected (i.e.~on the left-hand side of a recursion
  38.170 +  equation) must be eliminated.
  38.171 +  This can be accomplished by applying the following transformation rules:
  38.172 +*}
  38.173 +
  38.174 +lemma Suc_if_eq: "(\<And>n. f (Suc n) \<equiv> h n) \<Longrightarrow> f 0 \<equiv> g \<Longrightarrow>
  38.175 +  f n \<equiv> if n = 0 then g else h (n - 1)"
  38.176 +  by (rule eq_reflection) (cases n, simp_all)
  38.177 +
  38.178 +text {*
  38.179 +  The rules above are built into a preprocessor that is plugged into
  38.180 +  the code generator. Since the preprocessor for introduction rules
  38.181 +  does not know anything about modes, some of the modes that worked
  38.182 +  for the canonical representation of natural numbers may no longer work.
  38.183 +*}
  38.184 +
  38.185 +(*<*)
  38.186 +setup {*
  38.187 +let
  38.188 +
  38.189 +fun remove_suc thy thms =
  38.190 +  let
  38.191 +    val vname = singleton (Name.variant_list (map fst
  38.192 +      (fold (Term.add_var_names o Thm.full_prop_of) thms []))) "n";
  38.193 +    val cv = cterm_of thy (Var ((vname, 0), HOLogic.natT));
  38.194 +    fun lhs_of th = snd (Thm.dest_comb
  38.195 +      (fst (Thm.dest_comb (cprop_of th))));
  38.196 +    fun rhs_of th = snd (Thm.dest_comb (cprop_of th));
  38.197 +    fun find_vars ct = (case term_of ct of
  38.198 +        (Const (@{const_name Suc}, _) $ Var _) => [(cv, snd (Thm.dest_comb ct))]
  38.199 +      | _ $ _ =>
  38.200 +        let val (ct1, ct2) = Thm.dest_comb ct
  38.201 +        in 
  38.202 +          map (apfst (fn ct => Thm.apply ct ct2)) (find_vars ct1) @
  38.203 +          map (apfst (Thm.apply ct1)) (find_vars ct2)
  38.204 +        end
  38.205 +      | _ => []);
  38.206 +    val eqs = maps
  38.207 +      (fn th => map (pair th) (find_vars (lhs_of th))) thms;
  38.208 +    fun mk_thms (th, (ct, cv')) =
  38.209 +      let
  38.210 +        val th' =
  38.211 +          Thm.implies_elim
  38.212 +           (Conv.fconv_rule (Thm.beta_conversion true)
  38.213 +             (Drule.instantiate'
  38.214 +               [SOME (ctyp_of_term ct)] [SOME (Thm.lambda cv ct),
  38.215 +                 SOME (Thm.lambda cv' (rhs_of th)), NONE, SOME cv']
  38.216 +               @{thm Suc_if_eq})) (Thm.forall_intr cv' th)
  38.217 +      in
  38.218 +        case map_filter (fn th'' =>
  38.219 +            SOME (th'', singleton
  38.220 +              (Variable.trade (K (fn [th'''] => [th''' RS th']))
  38.221 +                (Variable.global_thm_context th'')) th'')
  38.222 +          handle THM _ => NONE) thms of
  38.223 +            [] => NONE
  38.224 +          | thps =>
  38.225 +              let val (ths1, ths2) = split_list thps
  38.226 +              in SOME (subtract Thm.eq_thm (th :: ths1) thms @ ths2) end
  38.227 +      end
  38.228 +  in get_first mk_thms eqs end;
  38.229 +
  38.230 +fun eqn_suc_base_preproc thy thms =
  38.231 +  let
  38.232 +    val dest = fst o Logic.dest_equals o prop_of;
  38.233 +    val contains_suc = exists_Const (fn (c, _) => c = @{const_name Suc});
  38.234 +  in
  38.235 +    if forall (can dest) thms andalso exists (contains_suc o dest) thms
  38.236 +      then thms |> perhaps_loop (remove_suc thy) |> (Option.map o map) Drule.zero_var_indexes
  38.237 +       else NONE
  38.238 +  end;
  38.239 +
  38.240 +val eqn_suc_preproc = Code_Preproc.simple_functrans eqn_suc_base_preproc;
  38.241 +
  38.242 +in
  38.243 +
  38.244 +  Code_Preproc.add_functrans ("eqn_Suc", eqn_suc_preproc)
  38.245 +
  38.246 +end;
  38.247 +*}
  38.248 +(*>*)
  38.249 +
  38.250 +code_modulename SML
  38.251 +  Code_Nat Arith
  38.252 +
  38.253 +code_modulename OCaml
  38.254 +  Code_Nat Arith
  38.255 +
  38.256 +code_modulename Haskell
  38.257 +  Code_Nat Arith
  38.258 +
  38.259 +hide_const (open) dup sub
  38.260 +
  38.261 +end
    39.1 --- a/src/HOL/Library/Code_Natural.thy	Mon Mar 26 15:32:54 2012 +0200
    39.2 +++ b/src/HOL/Library/Code_Natural.thy	Mon Mar 26 15:33:28 2012 +0200
    39.3 @@ -106,22 +106,26 @@
    39.4    (Scala "Natural")
    39.5  
    39.6  setup {*
    39.7 -  fold (Numeral.add_code @{const_name number_code_numeral_inst.number_of_code_numeral}
    39.8 +  fold (Numeral.add_code @{const_name Code_Numeral.Num}
    39.9      false Code_Printer.literal_alternative_numeral) ["Haskell", "Scala"]
   39.10  *}
   39.11  
   39.12  code_instance code_numeral :: equal
   39.13    (Haskell -)
   39.14  
   39.15 -code_const "op + \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral"
   39.16 +code_const "0::code_numeral"
   39.17 +  (Haskell "0")
   39.18 +  (Scala "Natural(0)")
   39.19 +
   39.20 +code_const "plus \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral"
   39.21    (Haskell infixl 6 "+")
   39.22    (Scala infixl 7 "+")
   39.23  
   39.24 -code_const "op - \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral"
   39.25 +code_const "minus \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral"
   39.26    (Haskell infixl 6 "-")
   39.27    (Scala infixl 7 "-")
   39.28  
   39.29 -code_const "op * \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral"
   39.30 +code_const "times \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral"
   39.31    (Haskell infixl 7 "*")
   39.32    (Scala infixl 8 "*")
   39.33  
   39.34 @@ -133,11 +137,11 @@
   39.35    (Haskell infix 4 "==")
   39.36    (Scala infixl 5 "==")
   39.37  
   39.38 -code_const "op \<le> \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> bool"
   39.39 +code_const "less_eq \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> bool"
   39.40    (Haskell infix 4 "<=")
   39.41    (Scala infixl 4 "<=")
   39.42  
   39.43 -code_const "op < \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> bool"
   39.44 +code_const "less \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> bool"
   39.45    (Haskell infix 4 "<")
   39.46    (Scala infixl 4 "<")
   39.47  
    40.1 --- a/src/HOL/Library/Code_Prolog.thy	Mon Mar 26 15:32:54 2012 +0200
    40.2 +++ b/src/HOL/Library/Code_Prolog.thy	Mon Mar 26 15:33:28 2012 +0200
    40.3 @@ -11,8 +11,10 @@
    40.4  
    40.5  section {* Setup for Numerals *}
    40.6  
    40.7 -setup {* Predicate_Compile_Data.ignore_consts [@{const_name number_of}] *}
    40.8 -setup {* Predicate_Compile_Data.keep_functions [@{const_name number_of}] *}
    40.9 +setup {* Predicate_Compile_Data.ignore_consts
   40.10 +  [@{const_name numeral}, @{const_name neg_numeral}] *}
   40.11 +
   40.12 +setup {* Predicate_Compile_Data.keep_functions
   40.13 +  [@{const_name numeral}, @{const_name neg_numeral}] *}
   40.14  
   40.15  end
   40.16 -
    41.1 --- a/src/HOL/Library/Code_Real_Approx_By_Float.thy	Mon Mar 26 15:32:54 2012 +0200
    41.2 +++ b/src/HOL/Library/Code_Real_Approx_By_Float.thy	Mon Mar 26 15:33:28 2012 +0200
    41.3 @@ -129,9 +129,23 @@
    41.4  lemma of_int_eq_real_of_int[code_unfold]: "of_int = real_of_int"
    41.5    unfolding real_of_int_def ..
    41.6  
    41.7 -hide_const (open) real_of_int
    41.8 +lemma [code_unfold del]:
    41.9 +  "0 \<equiv> (of_rat 0 :: real)"
   41.10 +  by simp
   41.11 +
   41.12 +lemma [code_unfold del]:
   41.13 +  "1 \<equiv> (of_rat 1 :: real)"
   41.14 +  by simp
   41.15  
   41.16 -declare number_of_real_code [code_unfold del]
   41.17 +lemma [code_unfold del]:
   41.18 +  "numeral k \<equiv> (of_rat (numeral k) :: real)"
   41.19 +  by simp
   41.20 +
   41.21 +lemma [code_unfold del]:
   41.22 +  "neg_numeral k \<equiv> (of_rat (neg_numeral k) :: real)"
   41.23 +  by simp
   41.24 +
   41.25 +hide_const (open) real_of_int
   41.26  
   41.27  notepad
   41.28  begin
    42.1 --- a/src/HOL/Library/Efficient_Nat.thy	Mon Mar 26 15:32:54 2012 +0200
    42.2 +++ b/src/HOL/Library/Efficient_Nat.thy	Mon Mar 26 15:33:28 2012 +0200
    42.3 @@ -5,175 +5,16 @@
    42.4  header {* Implementation of natural numbers by target-language integers *}
    42.5  
    42.6  theory Efficient_Nat
    42.7 -imports Code_Integer Main
    42.8 +imports Code_Nat Code_Integer Main
    42.9  begin
   42.10  
   42.11  text {*
   42.12 -  When generating code for functions on natural numbers, the
   42.13 -  canonical representation using @{term "0::nat"} and
   42.14 -  @{term Suc} is unsuitable for computations involving large
   42.15 -  numbers.  The efficiency of the generated code can be improved
   42.16 +  The efficiency of the generated code for natural numbers can be improved
   42.17    drastically by implementing natural numbers by target-language
   42.18    integers.  To do this, just include this theory.
   42.19  *}
   42.20  
   42.21 -subsection {* Basic arithmetic *}
   42.22 -
   42.23 -text {*
   42.24 -  Most standard arithmetic functions on natural numbers are implemented
   42.25 -  using their counterparts on the integers:
   42.26 -*}
   42.27 -
   42.28 -code_datatype number_nat_inst.number_of_nat
   42.29 -
   42.30 -lemma zero_nat_code [code, code_unfold]:
   42.31 -  "0 = (Numeral0 :: nat)"
   42.32 -  by simp
   42.33 -
   42.34 -lemma one_nat_code [code, code_unfold]:
   42.35 -  "1 = (Numeral1 :: nat)"
   42.36 -  by simp
   42.37 -
   42.38 -lemma Suc_code [code]:
   42.39 -  "Suc n = n + 1"
   42.40 -  by simp
   42.41 -
   42.42 -lemma plus_nat_code [code]:
   42.43 -  "n + m = nat (of_nat n + of_nat m)"
   42.44 -  by simp
   42.45 -
   42.46 -lemma minus_nat_code [code]:
   42.47 -  "n - m = nat (of_nat n - of_nat m)"
   42.48 -  by simp
   42.49 -
   42.50 -lemma times_nat_code [code]:
   42.51 -  "n * m = nat (of_nat n * of_nat m)"
   42.52 -  unfolding of_nat_mult [symmetric] by simp
   42.53 -
   42.54 -lemma divmod_nat_code [code]:
   42.55 -  "divmod_nat n m = map_pair nat nat (pdivmod (of_nat n) (of_nat m))"
   42.56 -  by (simp add: map_pair_def split_def pdivmod_def nat_div_distrib nat_mod_distrib divmod_nat_div_mod)
   42.57 -
   42.58 -lemma eq_nat_code [code]:
   42.59 -  "HOL.equal n m \<longleftrightarrow> HOL.equal (of_nat n \<Colon> int) (of_nat m)"
   42.60 -  by (simp add: equal)
   42.61 -
   42.62 -lemma eq_nat_refl [code nbe]:
   42.63 -  "HOL.equal (n::nat) n \<longleftrightarrow> True"
   42.64 -  by (rule equal_refl)
   42.65 -
   42.66 -lemma less_eq_nat_code [code]:
   42.67 -  "n \<le> m \<longleftrightarrow> (of_nat n \<Colon> int) \<le> of_nat m"
   42.68 -  by simp
   42.69 -
   42.70 -lemma less_nat_code [code]:
   42.71 -  "n < m \<longleftrightarrow> (of_nat n \<Colon> int) < of_nat m"
   42.72 -  by simp
   42.73 -
   42.74 -subsection {* Case analysis *}
   42.75 -
   42.76 -text {*
   42.77 -  Case analysis on natural numbers is rephrased using a conditional
   42.78 -  expression:
   42.79 -*}
   42.80 -
   42.81 -lemma [code, code_unfold]:
   42.82 -  "nat_case = (\<lambda>f g n. if n = 0 then f else g (n - 1))"
   42.83 -  by (auto simp add: fun_eq_iff dest!: gr0_implies_Suc)
   42.84 -
   42.85 -
   42.86 -subsection {* Preprocessors *}
   42.87 -
   42.88 -text {*
   42.89 -  In contrast to @{term "Suc n"}, the term @{term "n + (1::nat)"} is no longer
   42.90 -  a constructor term. Therefore, all occurrences of this term in a position
   42.91 -  where a pattern is expected (i.e.\ on the left-hand side of a recursion
   42.92 -  equation or in the arguments of an inductive relation in an introduction
   42.93 -  rule) must be eliminated.
   42.94 -  This can be accomplished by applying the following transformation rules:
   42.95 -*}
   42.96 -
   42.97 -lemma Suc_if_eq: "(\<And>n. f (Suc n) \<equiv> h n) \<Longrightarrow> f 0 \<equiv> g \<Longrightarrow>
   42.98 -  f n \<equiv> if n = 0 then g else h (n - 1)"
   42.99 -  by (rule eq_reflection) (cases n, simp_all)
  42.100 -
  42.101 -lemma Suc_clause: "(\<And>n. P n (Suc n)) \<Longrightarrow> n \<noteq> 0 \<Longrightarrow> P (n - 1) n"
  42.102 -  by (cases n) simp_all
  42.103 -
  42.104 -text {*
  42.105 -  The rules above are built into a preprocessor that is plugged into
  42.106 -  the code generator. Since the preprocessor for introduction rules
  42.107 -  does not know anything about modes, some of the modes that worked
  42.108 -  for the canonical representation of natural numbers may no longer work.
  42.109 -*}
  42.110 -
  42.111 -(*<*)
  42.112 -setup {*
  42.113 -let
  42.114 -
  42.115 -fun remove_suc thy thms =
  42.116 -  let
  42.117 -    val vname = singleton (Name.variant_list (map fst
  42.118 -      (fold (Term.add_var_names o Thm.full_prop_of) thms []))) "n";
  42.119 -    val cv = cterm_of thy (Var ((vname, 0), HOLogic.natT));
  42.120 -    fun lhs_of th = snd (Thm.dest_comb
  42.121 -      (fst (Thm.dest_comb (cprop_of th))));
  42.122 -    fun rhs_of th = snd (Thm.dest_comb (cprop_of th));
  42.123 -    fun find_vars ct = (case term_of ct of
  42.124 -        (Const (@{const_name Suc}, _) $ Var _) => [(cv, snd (Thm.dest_comb ct))]
  42.125 -      | _ $ _ =>
  42.126 -        let val (ct1, ct2) = Thm.dest_comb ct
  42.127 -        in 
  42.128 -          map (apfst (fn ct => Thm.apply ct ct2)) (find_vars ct1) @
  42.129 -          map (apfst (Thm.apply ct1)) (find_vars ct2)
  42.130 -        end
  42.131 -      | _ => []);
  42.132 -    val eqs = maps
  42.133 -      (fn th => map (pair th) (find_vars (lhs_of th))) thms;
  42.134 -    fun mk_thms (th, (ct, cv')) =
  42.135 -      let
  42.136 -        val th' =
  42.137 -          Thm.implies_elim
  42.138 -           (Conv.fconv_rule (Thm.beta_conversion true)
  42.139 -             (Drule.instantiate'
  42.140 -               [SOME (ctyp_of_term ct)] [SOME (Thm.lambda cv ct),
  42.141 -                 SOME (Thm.lambda cv' (rhs_of th)), NONE, SOME cv']
  42.142 -               @{thm Suc_if_eq})) (Thm.forall_intr cv' th)
  42.143 -      in
  42.144 -        case map_filter (fn th'' =>
  42.145 -            SOME (th'', singleton
  42.146 -              (Variable.trade (K (fn [th'''] => [th''' RS th']))
  42.147 -                (Variable.global_thm_context th'')) th'')
  42.148 -          handle THM _ => NONE) thms of
  42.149 -            [] => NONE
  42.150 -          | thps =>
  42.151 -              let val (ths1, ths2) = split_list thps
  42.152 -              in SOME (subtract Thm.eq_thm (th :: ths1) thms @ ths2) end
  42.153 -      end
  42.154 -  in get_first mk_thms eqs end;
  42.155 -
  42.156 -fun eqn_suc_base_preproc thy thms =
  42.157 -  let
  42.158 -    val dest = fst o Logic.dest_equals o prop_of;
  42.159 -    val contains_suc = exists_Const (fn (c, _) => c = @{const_name Suc});
  42.160 -  in
  42.161 -    if forall (can dest) thms andalso exists (contains_suc o dest) thms
  42.162 -      then thms |> perhaps_loop (remove_suc thy) |> (Option.map o map) Drule.zero_var_indexes
  42.163 -       else NONE
  42.164 -  end;
  42.165 -
  42.166 -val eqn_suc_preproc = Code_Preproc.simple_functrans eqn_suc_base_preproc;
  42.167 -
  42.168 -in
  42.169 -
  42.170 -  Code_Preproc.add_functrans ("eqn_Suc", eqn_suc_preproc)
  42.171 -
  42.172 -end;
  42.173 -*}
  42.174 -(*>*)
  42.175 -
  42.176 -
  42.177 -subsection {* Target language setup *}
  42.178 +subsection {* Target language fundamentals *}
  42.179  
  42.180  text {*
  42.181    For ML, we map @{typ nat} to target language integers, where we
  42.182 @@ -282,47 +123,32 @@
  42.183  code_instance nat :: equal
  42.184    (Haskell -)
  42.185  
  42.186 -text {*
  42.187 -  Natural numerals.
  42.188 -*}
  42.189 -
  42.190 -lemma [code_abbrev]:
  42.191 -  "number_nat_inst.number_of_nat i = nat (number_of i)"
  42.192 -  -- {* this interacts as desired with @{thm nat_number_of_def} *}
  42.193 -  by (simp add: number_nat_inst.number_of_nat)
  42.194 -
  42.195  setup {*
  42.196 -  fold (Numeral.add_code @{const_name number_nat_inst.number_of_nat}
  42.197 +  fold (Numeral.add_code @{const_name nat_of_num}
  42.198      false Code_Printer.literal_positive_numeral) ["SML", "OCaml", "Haskell", "Scala"]
  42.199  *}
  42.200  
  42.201 +code_const "0::nat"
  42.202 +  (SML "0")
  42.203 +  (OCaml "Big'_int.zero'_big'_int")
  42.204 +  (Haskell "0")
  42.205 +  (Scala "Nat(0)")
  42.206 +
  42.207 +
  42.208 +subsection {* Conversions *}
  42.209 +
  42.210  text {*
  42.211    Since natural numbers are implemented
  42.212 -  using integers in ML, the coercion function @{const "of_nat"} of type
  42.213 +  using integers in ML, the coercion function @{term "int"} of type
  42.214    @{typ "nat \<Rightarrow> int"} is simply implemented by the identity function.
  42.215    For the @{const nat} function for converting an integer to a natural
  42.216 -  number, we give a specific implementation using an ML function that
  42.217 +  number, we give a specific implementation using an ML expression that
  42.218    returns its input value, provided that it is non-negative, and otherwise
  42.219    returns @{text "0"}.
  42.220  *}
  42.221  
  42.222  definition int :: "nat \<Rightarrow> int" where
  42.223 -  [code del, code_abbrev]: "int = of_nat"
  42.224 -
  42.225 -lemma int_code' [code]:
  42.226 -  "int (number_of l) = (if neg (number_of l \<Colon> int) then 0 else number_of l)"
  42.227 -  unfolding int_nat_number_of [folded int_def] ..
  42.228 -
  42.229 -lemma nat_code' [code]:
  42.230 -  "nat (number_of l) = (if neg (number_of l \<Colon> int) then 0 else number_of l)"
  42.231 -  unfolding nat_number_of_def number_of_is_id neg_def by simp
  42.232 -
  42.233 -lemma of_nat_int: (* FIXME delete candidate *)
  42.234 -  "of_nat = int" by (simp add: int_def)
  42.235 -
  42.236 -lemma of_nat_aux_int [code_unfold]:
  42.237 -  "of_nat_aux (\<lambda>i. i + 1) k 0 = int k"
  42.238 -  by (simp add: int_def Nat.of_nat_code)
  42.239 +  [code_abbrev]: "int = of_nat"
  42.240  
  42.241  code_const int
  42.242    (SML "_")
  42.243 @@ -331,7 +157,7 @@
  42.244  code_const nat
  42.245    (SML "IntInf.max/ (0,/ _)")
  42.246    (OCaml "Big'_int.max'_big'_int/ Big'_int.zero'_big'_int")
  42.247 -  (Eval "Integer.max/ _/ 0")
  42.248 +  (Eval "Integer.max/ 0")
  42.249  
  42.250  text {* For Haskell and Scala, things are slightly different again. *}
  42.251  
  42.252 @@ -339,7 +165,26 @@
  42.253    (Haskell "toInteger" and "fromInteger")
  42.254    (Scala "!_.as'_BigInt" and "Nat")
  42.255  
  42.256 -text {* Conversion from and to code numerals. *}
  42.257 +text {* Alternativ implementation for @{const of_nat} *}
  42.258 +
  42.259 +lemma [code]:
  42.260 +  "of_nat n = (if n = 0 then 0 else
  42.261 +     let
  42.262 +       (q, m) = divmod_nat n 2;
  42.263 +       q' = 2 * of_nat q
  42.264 +     in if m = 0 then q' else q' + 1)"
  42.265 +proof -
  42.266 +  from mod_div_equality have *: "of_nat n = of_nat (n div 2 * 2 + n mod 2)" by simp
  42.267 +  show ?thesis
  42.268 +    apply (simp add: Let_def divmod_nat_div_mod mod_2_not_eq_zero_eq_one_nat
  42.269 +      of_nat_mult
  42.270 +      of_nat_add [symmetric])
  42.271 +    apply (auto simp add: of_nat_mult)
  42.272 +    apply (simp add: * of_nat_mult add_commute mult_commute)
  42.273 +    done
  42.274 +qed
  42.275 +
  42.276 +text {* Conversion from and to code numerals *}
  42.277  
  42.278  code_const Code_Numeral.of_nat
  42.279    (SML "IntInf.toInt")
  42.280 @@ -355,21 +200,38 @@
  42.281    (Scala "!Nat(_.as'_BigInt)")
  42.282    (Eval "_")
  42.283  
  42.284 -text {* Using target language arithmetic operations whenever appropriate *}
  42.285 +
  42.286 +subsection {* Target language arithmetic *}
  42.287  
  42.288 -code_const "op + \<Colon> nat \<Rightarrow> nat \<Rightarrow> nat"
  42.289 -  (SML "IntInf.+ ((_), (_))")
  42.290 +code_const "plus \<Colon> nat \<Rightarrow> nat \<Rightarrow> nat"
  42.291 +  (SML "IntInf.+/ ((_),/ (_))")
  42.292    (OCaml "Big'_int.add'_big'_int")
  42.293    (Haskell infixl 6 "+")
  42.294    (Scala infixl 7 "+")
  42.295    (Eval infixl 8 "+")
  42.296  
  42.297 -code_const "op - \<Colon> nat \<Rightarrow> nat \<Rightarrow> nat"
  42.298 +code_const "minus \<Colon> nat \<Rightarrow> nat \<Rightarrow> nat"
  42.299 +  (SML "IntInf.max/ (0, IntInf.-/ ((_),/ (_)))")
  42.300 +  (OCaml "Big'_int.max'_big'_int/ Big'_int.zero'_big'_int/ (Big'_int.sub'_big'_int/ _/ _)")
  42.301    (Haskell infixl 6 "-")
  42.302    (Scala infixl 7 "-")
  42.303 +  (Eval "Integer.max/ 0/ (_ -/ _)")
  42.304  
  42.305 -code_const "op * \<Colon> nat \<Rightarrow> nat \<Rightarrow> nat"
  42.306 -  (SML "IntInf.* ((_), (_))")
  42.307 +code_const Code_Nat.dup
  42.308 +  (SML "IntInf.*/ (2,/ (_))")
  42.309 +  (OCaml "Big'_int.mult'_big'_int/ 2")
  42.310 +  (Haskell "!(2 * _)")
  42.311 +  (Scala "!(2 * _)")
  42.312 +  (Eval "!(2 * _)")
  42.313 +
  42.314 +code_const Code_Nat.sub
  42.315 +  (SML "!(raise/ Fail/ \"sub\")")
  42.316 +  (OCaml "failwith/ \"sub\"")
  42.317 +  (Haskell "error/ \"sub\"")
  42.318 +  (Scala "!error(\"sub\")")
  42.319 +
  42.320 +code_const "times \<Colon> nat \<Rightarrow> nat \<Rightarrow> nat"
  42.321 +  (SML "IntInf.*/ ((_),/ (_))")
  42.322    (OCaml "Big'_int.mult'_big'_int")
  42.323    (Haskell infixl 7 "*")
  42.324    (Scala infixl 8 "*")
  42.325 @@ -389,22 +251,28 @@
  42.326    (Scala infixl 5 "==")
  42.327    (Eval infixl 6 "=")
  42.328  
  42.329 -code_const "op \<le> \<Colon> nat \<Rightarrow> nat \<Rightarrow> bool"
  42.330 -  (SML "IntInf.<= ((_), (_))")
  42.331 +code_const "less_eq \<Colon> nat \<Rightarrow> nat \<Rightarrow> bool"
  42.332 +  (SML "IntInf.<=/ ((_),/ (_))")
  42.333    (OCaml "Big'_int.le'_big'_int")
  42.334    (Haskell infix 4 "<=")
  42.335    (Scala infixl 4 "<=")
  42.336    (Eval infixl 6 "<=")
  42.337  
  42.338 -code_const "op < \<Colon> nat \<Rightarrow> nat \<Rightarrow> bool"
  42.339 -  (SML "IntInf.< ((_), (_))")
  42.340 +code_const "less \<Colon> nat \<Rightarrow> nat \<Rightarrow> bool"
  42.341 +  (SML "IntInf.</ ((_),/ (_))")
  42.342    (OCaml "Big'_int.lt'_big'_int")
  42.343    (Haskell infix 4 "<")
  42.344    (Scala infixl 4 "<")
  42.345    (Eval infixl 6 "<")
  42.346  
  42.347 +code_const Num.num_of_nat
  42.348 +  (SML "!(raise/ Fail/ \"num'_of'_nat\")")
  42.349 +  (OCaml "failwith/ \"num'_of'_nat\"")
  42.350 +  (Haskell "error/ \"num'_of'_nat\"")
  42.351 +  (Scala "!error(\"num'_of'_nat\")")
  42.352  
  42.353 -text {* Evaluation *}
  42.354 +
  42.355 +subsection {* Evaluation *}
  42.356  
  42.357  lemma [code, code del]:
  42.358    "(Code_Evaluation.term_of \<Colon> nat \<Rightarrow> term) = Code_Evaluation.term_of" ..
  42.359 @@ -412,14 +280,14 @@
  42.360  code_const "Code_Evaluation.term_of \<Colon> nat \<Rightarrow> term"
  42.361    (SML "HOLogic.mk'_number/ HOLogic.natT")
  42.362  
  42.363 -text {* Evaluation with @{text "Quickcheck_Narrowing"} does not work, as
  42.364 +text {*
  42.365 +  FIXME -- Evaluation with @{text "Quickcheck_Narrowing"} does not work, as
  42.366    @{text "code_module"} is very aggressive leading to bad Haskell code.
  42.367    Therefore, we simply deactivate the narrowing-based quickcheck from here on.
  42.368  *}
  42.369  
  42.370  declare [[quickcheck_narrowing_active = false]] 
  42.371  
  42.372 -text {* Module names *}
  42.373  
  42.374  code_modulename SML
  42.375    Efficient_Nat Arith
  42.376 @@ -430,6 +298,6 @@
  42.377  code_modulename Haskell
  42.378    Efficient_Nat Arith
  42.379  
  42.380 -hide_const int
  42.381 +hide_const (open) int
  42.382  
  42.383  end
    43.1 --- a/src/HOL/Library/Extended_Nat.thy	Mon Mar 26 15:32:54 2012 +0200
    43.2 +++ b/src/HOL/Library/Extended_Nat.thy	Mon Mar 26 15:33:28 2012 +0200
    43.3 @@ -61,19 +61,17 @@
    43.4  primrec the_enat :: "enat \<Rightarrow> nat"
    43.5    where "the_enat (enat n) = n"
    43.6  
    43.7 +
    43.8  subsection {* Constructors and numbers *}
    43.9  
   43.10 -instantiation enat :: "{zero, one, number}"
   43.11 +instantiation enat :: "{zero, one}"
   43.12  begin
   43.13  
   43.14  definition
   43.15    "0 = enat 0"
   43.16  
   43.17  definition
   43.18 -  [code_unfold]: "1 = enat 1"
   43.19 -
   43.20 -definition
   43.21 -  [code_unfold, code del]: "number_of k = enat (number_of k)"
   43.22 +  "1 = enat 1"
   43.23  
   43.24  instance ..
   43.25  
   43.26 @@ -82,15 +80,12 @@
   43.27  definition eSuc :: "enat \<Rightarrow> enat" where
   43.28    "eSuc i = (case i of enat n \<Rightarrow> enat (Suc n) | \<infinity> \<Rightarrow> \<infinity>)"
   43.29  
   43.30 -lemma enat_0: "enat 0 = 0"
   43.31 +lemma enat_0 [code_post]: "enat 0 = 0"
   43.32    by (simp add: zero_enat_def)
   43.33  
   43.34 -lemma enat_1: "enat 1 = 1"
   43.35 +lemma enat_1 [code_post]: "enat 1 = 1"
   43.36    by (simp add: one_enat_def)
   43.37  
   43.38 -lemma enat_number: "enat (number_of k) = number_of k"
   43.39 -  by (simp add: number_of_enat_def)
   43.40 -
   43.41  lemma one_eSuc: "1 = eSuc 0"
   43.42    by (simp add: zero_enat_def one_enat_def eSuc_def)
   43.43  
   43.44 @@ -100,16 +95,6 @@
   43.45  lemma i0_ne_infinity [simp]: "0 \<noteq> (\<infinity>::enat)"
   43.46    by (simp add: zero_enat_def)
   43.47  
   43.48 -lemma zero_enat_eq [simp]:
   43.49 -  "number_of k = (0\<Colon>enat) \<longleftrightarrow> number_of k = (0\<Colon>nat)"
   43.50 -  "(0\<Colon>enat) = number_of k \<longleftrightarrow> number_of k = (0\<Colon>nat)"
   43.51 -  unfolding zero_enat_def number_of_enat_def by simp_all
   43.52 -
   43.53 -lemma one_enat_eq [simp]:
   43.54 -  "number_of k = (1\<Colon>enat) \<longleftrightarrow> number_of k = (1\<Colon>nat)"
   43.55 -  "(1\<Colon>enat) = number_of k \<longleftrightarrow> number_of k = (1\<Colon>nat)"
   43.56 -  unfolding one_enat_def number_of_enat_def by simp_all
   43.57 -
   43.58  lemma zero_one_enat_neq [simp]:
   43.59    "\<not> 0 = (1\<Colon>enat)"
   43.60    "\<not> 1 = (0\<Colon>enat)"
   43.61 @@ -121,18 +106,9 @@
   43.62  lemma i1_ne_infinity [simp]: "1 \<noteq> (\<infinity>::enat)"
   43.63    by (simp add: one_enat_def)
   43.64  
   43.65 -lemma infinity_ne_number [simp]: "(\<infinity>::enat) \<noteq> number_of k"
   43.66 -  by (simp add: number_of_enat_def)
   43.67 -
   43.68 -lemma number_ne_infinity [simp]: "number_of k \<noteq> (\<infinity>::enat)"
   43.69 -  by (simp add: number_of_enat_def)
   43.70 -
   43.71  lemma eSuc_enat: "eSuc (enat n) = enat (Suc n)"
   43.72    by (simp add: eSuc_def)
   43.73  
   43.74 -lemma eSuc_number_of: "eSuc (number_of k) = enat (Suc (number_of k))"
   43.75 -  by (simp add: eSuc_enat number_of_enat_def)
   43.76 -
   43.77  lemma eSuc_infinity [simp]: "eSuc \<infinity> = \<infinity>"
   43.78    by (simp add: eSuc_def)
   43.79  
   43.80 @@ -145,11 +121,6 @@
   43.81  lemma eSuc_inject [simp]: "eSuc m = eSuc n \<longleftrightarrow> m = n"
   43.82    by (simp add: eSuc_def split: enat.splits)
   43.83  
   43.84 -lemma number_of_enat_inject [simp]:
   43.85 -  "(number_of k \<Colon> enat) = number_of l \<longleftrightarrow> (number_of k \<Colon> nat) = number_of l"
   43.86 -  by (simp add: number_of_enat_def)
   43.87 -
   43.88 -
   43.89  subsection {* Addition *}
   43.90  
   43.91  instantiation enat :: comm_monoid_add
   43.92 @@ -177,16 +148,6 @@
   43.93  
   43.94  end
   43.95  
   43.96 -lemma plus_enat_number [simp]:
   43.97 -  "(number_of k \<Colon> enat) + number_of l = (if k < Int.Pls then number_of l
   43.98 -    else if l < Int.Pls then number_of k else number_of (k + l))"
   43.99 -  unfolding number_of_enat_def plus_enat_simps nat_arith(1) if_distrib [symmetric, of _ enat] ..
  43.100 -
  43.101 -lemma eSuc_number [simp]:
  43.102 -  "eSuc (number_of k) = (if neg (number_of k \<Colon> int) then 1 else number_of (Int.succ k))"
  43.103 -  unfolding eSuc_number_of
  43.104 -  unfolding one_enat_def number_of_enat_def Suc_nat_number_of if_distrib [symmetric] ..
  43.105 -
  43.106  lemma eSuc_plus_1:
  43.107    "eSuc n = n + 1"
  43.108    by (cases n) (simp_all add: eSuc_enat one_enat_def)
  43.109 @@ -261,12 +222,6 @@
  43.110    apply (simp add: plus_1_eSuc eSuc_enat)
  43.111    done
  43.112  
  43.113 -instance enat :: number_semiring
  43.114 -proof
  43.115 -  fix n show "number_of (int n) = (of_nat n :: enat)"
  43.116 -    unfolding number_of_enat_def number_of_int of_nat_id of_nat_eq_enat ..
  43.117 -qed
  43.118 -
  43.119  instance enat :: semiring_char_0 proof
  43.120    have "inj enat" by (rule injI) simp
  43.121    then show "inj (\<lambda>n. of_nat n :: enat)" by (simp add: of_nat_eq_enat)
  43.122 @@ -279,6 +234,25 @@
  43.123    by (auto simp add: times_enat_def zero_enat_def split: enat.split)
  43.124  
  43.125  
  43.126 +subsection {* Numerals *}
  43.127 +
  43.128 +lemma numeral_eq_enat:
  43.129 +  "numeral k = enat (numeral k)"
  43.130 +  using of_nat_eq_enat [of "numeral k"] by simp
  43.131 +
  43.132 +lemma enat_numeral [code_abbrev]:
  43.133 +  "enat (numeral k) = numeral k"
  43.134 +  using numeral_eq_enat ..
  43.135 +
  43.136 +lemma infinity_ne_numeral [simp]: "(\<infinity>::enat) \<noteq> numeral k"
  43.137 +  by (simp add: numeral_eq_enat)
  43.138 +
  43.139 +lemma numeral_ne_infinity [simp]: "numeral k \<noteq> (\<infinity>::enat)"
  43.140 +  by (simp add: numeral_eq_enat)
  43.141 +
  43.142 +lemma eSuc_numeral [simp]: "eSuc (numeral k) = numeral (k + Num.One)"
  43.143 +  by (simp only: eSuc_plus_1 numeral_plus_one)
  43.144 +
  43.145  subsection {* Subtraction *}
  43.146  
  43.147  instantiation enat :: minus
  43.148 @@ -292,13 +266,13 @@
  43.149  
  43.150  end
  43.151  
  43.152 -lemma idiff_enat_enat [simp,code]: "enat a - enat b = enat (a - b)"
  43.153 +lemma idiff_enat_enat [simp, code]: "enat a - enat b = enat (a - b)"
  43.154    by (simp add: diff_enat_def)
  43.155  
  43.156 -lemma idiff_infinity [simp,code]: "\<infinity> - n = (\<infinity>::enat)"
  43.157 +lemma idiff_infinity [simp, code]: "\<infinity> - n = (\<infinity>::enat)"
  43.158    by (simp add: diff_enat_def)
  43.159  
  43.160 -lemma idiff_infinity_right [simp,code]: "enat a - \<infinity> = 0"
  43.161 +lemma idiff_infinity_right [simp, code]: "enat a - \<infinity> = 0"
  43.162    by (simp add: diff_enat_def)
  43.163  
  43.164  lemma idiff_0 [simp]: "(0::enat) - n = 0"
  43.165 @@ -344,13 +318,13 @@
  43.166    "(\<infinity>::enat) < q \<longleftrightarrow> False"
  43.167    by (simp_all add: less_eq_enat_def less_enat_def split: enat.splits)
  43.168  
  43.169 -lemma number_of_le_enat_iff[simp]:
  43.170 -  shows "number_of m \<le> enat n \<longleftrightarrow> number_of m \<le> n"
  43.171 -by (auto simp: number_of_enat_def)
  43.172 +lemma numeral_le_enat_iff[simp]:
  43.173 +  shows "numeral m \<le> enat n \<longleftrightarrow> numeral m \<le> n"
  43.174 +by (auto simp: numeral_eq_enat)
  43.175  
  43.176 -lemma number_of_less_enat_iff[simp]:
  43.177 -  shows "number_of m < enat n \<longleftrightarrow> number_of m < n"
  43.178 -by (auto simp: number_of_enat_def)
  43.179 +lemma numeral_less_enat_iff[simp]:
  43.180 +  shows "numeral m < enat n \<longleftrightarrow> numeral m < n"
  43.181 +by (auto simp: numeral_eq_enat)
  43.182  
  43.183  lemma enat_ord_code [code]:
  43.184    "enat m \<le> enat n \<longleftrightarrow> m \<le> n"
  43.185 @@ -375,10 +349,15 @@
  43.186      by (simp split: enat.splits)
  43.187  qed
  43.188  
  43.189 +(* BH: These equations are already proven generally for any type in
  43.190 +class linordered_semidom. However, enat is not in that class because
  43.191 +it does not have the cancellation property. Would it be worthwhile to
  43.192 +a generalize linordered_semidom to a new class that includes enat? *)
  43.193 +
  43.194  lemma enat_ord_number [simp]:
  43.195 -  "(number_of m \<Colon> enat) \<le> number_of n \<longleftrightarrow> (number_of m \<Colon> nat) \<le> number_of n"
  43.196 -  "(number_of m \<Colon> enat) < number_of n \<longleftrightarrow> (number_of m \<Colon> nat) < number_of n"
  43.197 -  by (simp_all add: number_of_enat_def)
  43.198 +  "(numeral m \<Colon> enat) \<le> numeral n \<longleftrightarrow> (numeral m \<Colon> nat) \<le> numeral n"
  43.199 +  "(numeral m \<Colon> enat) < numeral n \<longleftrightarrow> (numeral m \<Colon> nat) < numeral n"
  43.200 +  by (simp_all add: numeral_eq_enat)
  43.201  
  43.202  lemma i0_lb [simp]: "(0\<Colon>enat) \<le> n"
  43.203    by (simp add: zero_enat_def less_eq_enat_def split: enat.splits)
  43.204 @@ -525,10 +504,10 @@
  43.205    val find_first = find_first_t []
  43.206    val trans_tac = Numeral_Simprocs.trans_tac
  43.207    val norm_ss = HOL_basic_ss addsimps
  43.208 -    @{thms add_ac semiring_numeral_0_eq_0 add_0_left add_0_right}
  43.209 +    @{thms add_ac add_0_left add_0_right}
  43.210    fun norm_tac ss = ALLGOALS (simp_tac (Simplifier.inherit_context ss norm_ss))
  43.211    fun simplify_meta_eq ss cancel_th th =
  43.212 -    Arith_Data.simplify_meta_eq @{thms semiring_numeral_0_eq_0} ss
  43.213 +    Arith_Data.simplify_meta_eq [] ss
  43.214        ([th, cancel_th] MRS trans)
  43.215    fun mk_eq (a, b) = HOLogic.mk_Trueprop (HOLogic.mk_eq (a, b))
  43.216  end
  43.217 @@ -646,7 +625,7 @@
  43.218  
  43.219  subsection {* Traditional theorem names *}
  43.220  
  43.221 -lemmas enat_defs = zero_enat_def one_enat_def number_of_enat_def eSuc_def
  43.222 +lemmas enat_defs = zero_enat_def one_enat_def eSuc_def
  43.223    plus_enat_def less_eq_enat_def less_enat_def
  43.224  
  43.225  end
    44.1 --- a/src/HOL/Library/Extended_Real.thy	Mon Mar 26 15:32:54 2012 +0200
    44.2 +++ b/src/HOL/Library/Extended_Real.thy	Mon Mar 26 15:33:28 2012 +0200
    44.3 @@ -124,11 +124,6 @@
    44.4    fix x :: ereal show "x \<in> range uminus" by (intro image_eqI[of _ _ "-x"]) auto
    44.5  qed auto
    44.6  
    44.7 -instantiation ereal :: number
    44.8 -begin
    44.9 -definition [simp]: "number_of x = ereal (number_of x)"
   44.10 -instance ..
   44.11 -end
   44.12  
   44.13  instantiation ereal :: abs
   44.14  begin
   44.15 @@ -671,6 +666,14 @@
   44.16    using assms
   44.17    by (cases rule: ereal3_cases[of a b c]) (simp_all add: field_simps)
   44.18  
   44.19 +instance ereal :: numeral ..
   44.20 +
   44.21 +lemma numeral_eq_ereal [simp]: "numeral w = ereal (numeral w)"
   44.22 +  apply (induct w rule: num_induct)
   44.23 +  apply (simp only: numeral_One one_ereal_def)
   44.24 +  apply (simp only: numeral_inc ereal_plus_1)
   44.25 +  done
   44.26 +
   44.27  lemma ereal_le_epsilon:
   44.28    fixes x y :: ereal
   44.29    assumes "ALL e. 0 < e --> x <= y + e"
   44.30 @@ -781,8 +784,8 @@
   44.31    shows "(- x) ^ n = (if even n then x ^ n else - (x^n))"
   44.32    by (induct n) (auto simp: one_ereal_def)
   44.33  
   44.34 -lemma ereal_power_number_of[simp]:
   44.35 -  "(number_of num :: ereal) ^ n = ereal (number_of num ^ n)"
   44.36 +lemma ereal_power_numeral[simp]:
   44.37 +  "(numeral num :: ereal) ^ n = ereal (numeral num ^ n)"
   44.38    by (induct n) (auto simp: one_ereal_def)
   44.39  
   44.40  lemma zero_le_power_ereal[simp]:
   44.41 @@ -1730,8 +1733,8 @@
   44.42    "ereal_of_enat m \<le> ereal_of_enat n \<longleftrightarrow> m \<le> n"
   44.43  by (cases m n rule: enat2_cases) auto
   44.44  
   44.45 -lemma number_of_le_ereal_of_enat_iff[simp]:
   44.46 -  shows "number_of m \<le> ereal_of_enat n \<longleftrightarrow> number_of m \<le> n"
   44.47 +lemma numeral_le_ereal_of_enat_iff[simp]:
   44.48 +  shows "numeral m \<le> ereal_of_enat n \<longleftrightarrow> numeral m \<le> n"
   44.49  by (cases n) (auto dest: natceiling_le intro: natceiling_le_eq[THEN iffD1])
   44.50  
   44.51  lemma ereal_of_enat_ge_zero_cancel_iff[simp]:
    45.1 --- a/src/HOL/Library/Float.thy	Mon Mar 26 15:32:54 2012 +0200
    45.2 +++ b/src/HOL/Library/Float.thy	Mon Mar 26 15:33:28 2012 +0200
    45.3 @@ -41,18 +41,6 @@
    45.4  instance ..
    45.5  end
    45.6  
    45.7 -instantiation float :: number
    45.8 -begin
    45.9 -definition number_of_float where "number_of n = Float n 0"
   45.10 -instance ..
   45.11 -end
   45.12 -
   45.13 -lemma number_of_float_Float:
   45.14 -  "number_of k = Float (number_of k) 0"
   45.15 -  by (simp add: number_of_float_def number_of_is_id)
   45.16 -
   45.17 -declare number_of_float_Float [symmetric, code_abbrev]
   45.18 -
   45.19  lemma real_of_float_simp[simp]: "real (Float a b) = real a * pow2 b"
   45.20    unfolding real_of_float_def using of_float.simps .
   45.21  
   45.22 @@ -63,12 +51,9 @@
   45.23  lemma Float_num[simp]: shows
   45.24     "real (Float 1 0) = 1" and "real (Float 1 1) = 2" and "real (Float 1 2) = 4" and
   45.25     "real (Float 1 -1) = 1/2" and "real (Float 1 -2) = 1/4" and "real (Float 1 -3) = 1/8" and
   45.26 -   "real (Float -1 0) = -1" and "real (Float (number_of n) 0) = number_of n"
   45.27 +   "real (Float -1 0) = -1" and "real (Float (numeral n) 0) = numeral n"
   45.28    by auto
   45.29  
   45.30 -lemma float_number_of[simp]: "real (number_of x :: float) = number_of x"
   45.31 -  by (simp only:number_of_float_def Float_num[unfolded number_of_is_id])
   45.32 -
   45.33  lemma float_number_of_int[simp]: "real (Float n 0) = real n"
   45.34    by simp
   45.35  
   45.36 @@ -349,6 +334,21 @@
   45.37      by (cases a, cases b) (simp add: plus_float.simps)
   45.38  qed
   45.39  
   45.40 +instance float :: numeral ..
   45.41 +
   45.42 +lemma Float_add_same_scale: "Float x e + Float y e = Float (x + y) e"
   45.43 +  by (simp add: plus_float.simps)
   45.44 +
   45.45 +(* FIXME: define other constant for code_unfold_post *)
   45.46 +lemma numeral_float_Float (*[code_unfold_post]*):
   45.47 +  "numeral k = Float (numeral k) 0"
   45.48 +  by (induct k, simp_all only: numeral.simps one_float_def
   45.49 +    Float_add_same_scale)
   45.50 +
   45.51 +lemma float_number_of[simp]: "real (numeral x :: float) = numeral x"
   45.52 +  by (simp only: numeral_float_Float Float_num)
   45.53 +
   45.54 +
   45.55  instance float :: comm_monoid_mult
   45.56  proof (intro_classes)
   45.57    fix a b c :: float
   45.58 @@ -555,6 +555,7 @@
   45.59    show ?thesis unfolding real_of_float_nge0_exp[OF P] divide_inverse by auto
   45.60  qed
   45.61  
   45.62 +(* BROKEN
   45.63  lemma bitlen_Pls: "bitlen (Int.Pls) = Int.Pls" by (subst Pls_def, subst Pls_def, simp)
   45.64  
   45.65  lemma bitlen_Min: "bitlen (Int.Min) = Int.Bit1 Int.Pls" by (subst Min_def, simp add: Bit1_def) 
   45.66 @@ -588,6 +589,7 @@
   45.67  
   45.68  lemma bitlen_number_of: "bitlen (number_of w) = number_of (bitlen w)"
   45.69    by (simp add: number_of_is_id)
   45.70 +BH *)
   45.71  
   45.72  lemma [code]: "bitlen x = 
   45.73       (if x = 0  then 0 
   45.74 @@ -722,12 +724,12 @@
   45.75      hence "real x / real y < 1" using `0 < y` and `0 \<le> x` by auto
   45.76  
   45.77      from real_of_int_div4[of "?X" y]
   45.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 .
   45.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 .
   45.80      also have "\<dots> < 1 * 2^?l" using `real x / real y < 1` by (rule mult_strict_right_mono, auto)
   45.81      finally have "?X div y < 2^?l" unfolding real_of_int_less_iff[of _ "2^?l", symmetric] by auto
   45.82      hence "?X div y + 1 \<le> 2^?l" by auto
   45.83      hence "real (?X div y + 1) * inverse (2^?l) \<le> 2^?l * inverse (2^?l)"
   45.84 -      unfolding real_of_int_le_iff[of _ "2^?l", symmetric] real_of_int_power real_number_of
   45.85 +      unfolding real_of_int_le_iff[of _ "2^?l", symmetric] real_of_int_power real_numeral
   45.86        by (rule mult_right_mono, auto)
   45.87      hence "real (?X div y + 1) * inverse (2^?l) \<le> 1" by auto
   45.88      thus ?thesis unfolding rapprox_posrat_def Let_def normfloat real_of_float_simp if_not_P[OF False]
   45.89 @@ -796,12 +798,12 @@
   45.90      qed
   45.91  
   45.92      from real_of_int_div4[of "?X" y]
   45.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 .
   45.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 .
   45.95      also have "\<dots> < 1/2 * 2^?l" using `real x / real y < 1/2` by (rule mult_strict_right_mono, auto)
   45.96      finally have "?X div y * 2 < 2^?l" unfolding real_of_int_less_iff[of _ "2^?l", symmetric] by auto
   45.97      hence "?X div y + 1 < 2^?l" using `0 < ?X div y` by auto
   45.98      hence "real (?X div y + 1) * inverse (2^?l) < 2^?l * inverse (2^?l)"
   45.99 -      unfolding real_of_int_less_iff[of _ "2^?l", symmetric] real_of_int_power real_number_of
  45.100 +      unfolding real_of_int_less_iff[of _ "2^?l", symmetric] real_of_int_power real_numeral
  45.101        by (rule mult_strict_right_mono, auto)
  45.102      hence "real (?X div y + 1) * inverse (2^?l) < 1" by auto
  45.103      thus ?thesis unfolding rapprox_posrat_def Let_def normfloat real_of_float_simp if_not_P[OF False]
  45.104 @@ -1195,7 +1197,7 @@
  45.105      case True
  45.106      have "real (m div 2^(nat ?l)) * pow2 ?l \<le> real m"
  45.107      proof -
  45.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] 
  45.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] 
  45.110          using `?l > 0` by auto
  45.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
  45.112        also have "\<dots> = real m" unfolding zmod_zdiv_equality[symmetric] ..
  45.113 @@ -1262,7 +1264,7 @@
  45.114      hence me_eq: "pow2 (-e) = pow2 (int (nat (-e)))" by auto
  45.115      have "real (Float (m div (2 ^ (nat (-e)))) 0) = real (m div 2 ^ (nat (-e)))" unfolding real_of_float_simp by auto
  45.116      also have "\<dots> \<le> real m / real ((2::int) ^ (nat (-e)))" using real_of_int_div4 .
  45.117 -    also have "\<dots> = real m * inverse (2 ^ (nat (-e)))" unfolding real_of_int_power real_number_of divide_inverse ..
  45.118 +    also have "\<dots> = real m * inverse (2 ^ (nat (-e)))" unfolding real_of_int_power real_numeral divide_inverse ..
  45.119      also have "\<dots> = real (Float m e)" unfolding real_of_float_simp me_eq pow2_int pow2_neg[of e] ..
  45.120      finally show ?thesis unfolding Float floor_fl.simps if_not_P[OF `\<not> 0 \<le> e`] .
  45.121    next
  45.122 @@ -1290,7 +1292,7 @@
  45.123      case False
  45.124      hence me_eq: "pow2 (-e) = pow2 (int (nat (-e)))" by auto
  45.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] ..
  45.126 -    also have "\<dots> = real m / real ((2::int) ^ (nat (-e)))" unfolding real_of_int_power real_number_of divide_inverse ..
  45.127 +    also have "\<dots> = real m / real ((2::int) ^ (nat (-e)))" unfolding real_of_int_power real_numeral divide_inverse ..
  45.128      also have "\<dots> \<le> 1 + real (m div 2 ^ (nat (-e)))" using real_of_int_div3[unfolded diff_le_eq] .
  45.129      also have "\<dots> = real (Float (m div (2 ^ (nat (-e))) + 1) 0)" unfolding real_of_float_simp by auto
  45.130      finally show ?thesis unfolding Float ceiling_fl.simps if_not_P[OF `\<not> 0 \<le> e`] .
    46.1 --- a/src/HOL/Library/Formal_Power_Series.thy	Mon Mar 26 15:32:54 2012 +0200
    46.2 +++ b/src/HOL/Library/Formal_Power_Series.thy	Mon Mar 26 15:33:28 2012 +0200
    46.3 @@ -392,25 +392,13 @@
    46.4  
    46.5  instance fps :: (idom) idom ..
    46.6  
    46.7 -instantiation fps :: (comm_ring_1) number_ring
    46.8 -begin
    46.9 -definition number_of_fps_def: "(number_of k::'a fps) = of_int k"
   46.10 -
   46.11 -instance proof
   46.12 -qed (rule number_of_fps_def)
   46.13 -end
   46.14 -
   46.15 -lemma number_of_fps_const: "(number_of k::('a::comm_ring_1) fps) = fps_const (of_int k)"
   46.16 -  
   46.17 -proof(induct k rule: int_induct [where k=0])
   46.18 -  case base thus ?case unfolding number_of_fps_def of_int_0 by simp
   46.19 -next
   46.20 -  case (step1 i) thus ?case unfolding number_of_fps_def 
   46.21 -    by (simp add: fps_const_add[symmetric] del: fps_const_add)
   46.22 -next
   46.23 -  case (step2 i) thus ?case unfolding number_of_fps_def 
   46.24 -    by (simp add: fps_const_sub[symmetric] del: fps_const_sub)
   46.25 -qed
   46.26 +lemma numeral_fps_const: "numeral k = fps_const (numeral k)"
   46.27 +  by (induct k, simp_all only: numeral.simps fps_const_1_eq_1
   46.28 +    fps_const_add [symmetric])
   46.29 +
   46.30 +lemma neg_numeral_fps_const: "neg_numeral k = fps_const (neg_numeral k)"
   46.31 +  by (simp only: neg_numeral_def numeral_fps_const fps_const_neg)
   46.32 +
   46.33  subsection{* The eXtractor series X*}
   46.34  
   46.35  lemma minus_one_power_iff: "(- (1::'a :: {comm_ring_1})) ^ n = (if even n then 1 else - 1)"
   46.36 @@ -1119,7 +1107,7 @@
   46.37    have eq: "(1 + X) * ?r = 1"
   46.38      unfolding minus_one_power_iff
   46.39      by (auto simp add: field_simps fps_eq_iff)
   46.40 -  show ?thesis by (auto simp add: eq intro: fps_inverse_unique)
   46.41 +  show ?thesis by (auto simp add: eq intro: fps_inverse_unique simp del: minus_one)
   46.42  qed
   46.43  
   46.44  
   46.45 @@ -1157,8 +1145,11 @@
   46.46    "fps_const (a::'a::{comm_ring_1}) oo b = fps_const (a)"
   46.47    by (simp add: fps_eq_iff fps_compose_nth mult_delta_left setsum_delta)
   46.48  
   46.49 -lemma number_of_compose[simp]: "(number_of k::('a::{comm_ring_1}) fps) oo b = number_of k"
   46.50 -  unfolding number_of_fps_const by simp
   46.51 +lemma numeral_compose[simp]: "(numeral k::('a::{comm_ring_1}) fps) oo b = numeral k"
   46.52 +  unfolding numeral_fps_const by simp
   46.53 +
   46.54 +lemma neg_numeral_compose[simp]: "(neg_numeral k::('a::{comm_ring_1}) fps) oo b = neg_numeral k"
   46.55 +  unfolding neg_numeral_fps_const by simp
   46.56  
   46.57  lemma X_fps_compose_startby0[simp]: "a$0 = 0 \<Longrightarrow> X oo a = (a :: ('a :: comm_ring_1) fps)"
   46.58    by (simp add: fps_eq_iff fps_compose_def mult_delta_left setsum_delta
   46.59 @@ -2568,7 +2559,7 @@
   46.60    (is "inverse ?l = ?r")
   46.61  proof-
   46.62    have th: "?l * ?r = 1"
   46.63 -    by (auto simp add: field_simps fps_eq_iff minus_one_power_iff)
   46.64 +    by (auto simp add: field_simps fps_eq_iff minus_one_power_iff simp del: minus_one)
   46.65    have th': "?l $ 0 \<noteq> 0" by (simp add: )
   46.66    from fps_inverse_unique[OF th' th] show ?thesis .
   46.67  qed
   46.68 @@ -2765,7 +2756,7 @@
   46.69  proof-
   46.70    have th: "?r$0 \<noteq> 0" by simp
   46.71    have th': "fps_deriv (inverse ?r) = fps_const (- 1) * inverse ?r / (1 + X)"
   46.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)
   46.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)
   46.74    have eq: "inverse ?r $ 0 = 1"
   46.75      by (simp add: fps_inverse_def)
   46.76    from iffD1[OF fps_binomial_ODE_unique[of "inverse (1 + X)" "- 1"] th'] eq
   46.77 @@ -2855,7 +2846,7 @@
   46.78            unfolding m1nk 
   46.79            
   46.80            unfolding m h pochhammer_Suc_setprod
   46.81 -          apply (simp add: field_simps del: fact_Suc id_def)
   46.82 +          apply (simp add: field_simps del: fact_Suc id_def minus_one)
   46.83            unfolding fact_altdef_nat id_def
   46.84            unfolding of_nat_setprod
   46.85            unfolding setprod_timesf[symmetric]
   46.86 @@ -3162,28 +3153,25 @@
   46.87  lemma fps_const_minus: "fps_const (c::'a::group_add) - fps_const d = fps_const (c - d)"
   46.88    by (simp add: fps_eq_iff fps_const_def)
   46.89  
   46.90 -lemma fps_number_of_fps_const: "number_of i = fps_const (number_of i :: 'a:: {comm_ring_1, number_ring})"
   46.91 -  apply (subst (2) number_of_eq)
   46.92 -apply(rule int_induct [of _ 0])
   46.93 -apply (simp_all add: number_of_fps_def)
   46.94 -by (simp_all add: fps_const_add[symmetric] fps_const_minus[symmetric])
   46.95 +lemma fps_numeral_fps_const: "numeral i = fps_const (numeral i :: 'a:: {comm_ring_1})"
   46.96 +  by (fact numeral_fps_const) (* FIXME: duplicate *)
   46.97  
   46.98  lemma fps_cos_Eii:
   46.99    "fps_cos c = (E (ii * c) + E (- ii * c)) / fps_const 2"
  46.100  proof-
  46.101    have th: "fps_cos c + fps_cos c = fps_cos c * fps_const 2" 
  46.102 -    by (simp add: fps_eq_iff fps_number_of_fps_const complex_number_of_def[symmetric])
  46.103 +    by (simp add: numeral_fps_const)
  46.104    show ?thesis
  46.105    unfolding Eii_sin_cos minus_mult_commute
  46.106 -  by (simp add: fps_sin_even fps_cos_odd fps_number_of_fps_const
  46.107 -    fps_divide_def fps_const_inverse th complex_number_of_def[symmetric])
  46.108 +  by (simp add: fps_sin_even fps_cos_odd numeral_fps_const
  46.109 +    fps_divide_def fps_const_inverse th)
  46.110  qed
  46.111  
  46.112  lemma fps_sin_Eii:
  46.113    "fps_sin c = (E (ii * c) - E (- ii * c)) / fps_const (2*ii)"
  46.114  proof-
  46.115    have th: "fps_const \<i> * fps_sin c + fps_const \<i> * fps_sin c = fps_sin c * fps_const (2 * ii)" 
  46.116 -    by (simp add: fps_eq_iff fps_number_of_fps_const complex_number_of_def[symmetric])
  46.117 +    by (simp add: fps_eq_iff numeral_fps_const)
  46.118    show ?thesis
  46.119    unfolding Eii_sin_cos minus_mult_commute
  46.120    by (simp add: fps_sin_even fps_cos_odd fps_divide_def fps_const_inverse th)
    47.1 --- a/src/HOL/Library/Numeral_Type.thy	Mon Mar 26 15:32:54 2012 +0200
    47.2 +++ b/src/HOL/Library/Numeral_Type.thy	Mon Mar 26 15:33:28 2012 +0200
    47.3 @@ -66,7 +66,6 @@
    47.4      by simp
    47.5  qed
    47.6  
    47.7 -
    47.8  subsection {* Locales for for modular arithmetic subtypes *}
    47.9  
   47.10  locale mod_type =
   47.11 @@ -137,8 +136,8 @@
   47.12  
   47.13  locale mod_ring = mod_type n Rep Abs
   47.14    for n :: int
   47.15 -  and Rep :: "'a::{number_ring} \<Rightarrow> int"
   47.16 -  and Abs :: "int \<Rightarrow> 'a::{number_ring}"
   47.17 +  and Rep :: "'a::{comm_ring_1} \<Rightarrow> int"
   47.18 +  and Abs :: "int \<Rightarrow> 'a::{comm_ring_1}"
   47.19  begin
   47.20  
   47.21  lemma of_nat_eq: "of_nat k = Abs (int k mod n)"
   47.22 @@ -152,13 +151,14 @@
   47.23  apply (simp add: Rep_simps of_nat_eq diff_def zmod_simps)
   47.24  done
   47.25  
   47.26 -lemma Rep_number_of:
   47.27 -  "Rep (number_of w) = number_of w mod n"
   47.28 -by (simp add: number_of_eq of_int_eq Rep_Abs_mod)
   47.29 +lemma Rep_numeral:
   47.30 +  "Rep (numeral w) = numeral w mod n"
   47.31 +using of_int_eq [of "numeral w"]
   47.32 +by (simp add: Rep_inject_sym Rep_Abs_mod)
   47.33  
   47.34 -lemma iszero_number_of:
   47.35 -  "iszero (number_of w::'a) \<longleftrightarrow> number_of w mod n = 0"
   47.36 -by (simp add: Rep_simps number_of_eq of_int_eq iszero_def zero_def)
   47.37 +lemma iszero_numeral:
   47.38 +  "iszero (numeral w::'a) \<longleftrightarrow> numeral w mod n = 0"
   47.39 +by (simp add: Rep_inject_sym Rep_numeral Rep_0 iszero_def)
   47.40  
   47.41  lemma cases:
   47.42    assumes 1: "\<And>z. \<lbrakk>(x::'a) = of_int z; 0 \<le> z; z < n\<rbrakk> \<Longrightarrow> P"
   47.43 @@ -175,14 +175,14 @@
   47.44  end
   47.45  
   47.46  
   47.47 -subsection {* Number ring instances *}
   47.48 +subsection {* Ring class instances *}
   47.49  
   47.50  text {*
   47.51 -  Unfortunately a number ring instance is not possible for
   47.52 +  Unfortunately @{text ring_1} instance is not possible for
   47.53    @{typ num1}, since 0 and 1 are not distinct.
   47.54  *}
   47.55  
   47.56 -instantiation num1 :: "{comm_ring,comm_monoid_mult,number}"
   47.57 +instantiation num1 :: "{comm_ring,comm_monoid_mult,numeral}"
   47.58  begin
   47.59  
   47.60  lemma num1_eq_iff: "(x::num1) = (y::num1) \<longleftrightarrow> True"
   47.61 @@ -252,22 +252,10 @@
   47.62  done
   47.63  
   47.64  instance bit0 :: (finite) comm_ring_1
   47.65 -  by (rule bit0.comm_ring_1)+
   47.66 +  by (rule bit0.comm_ring_1)
   47.67  
   47.68  instance bit1 :: (finite) comm_ring_1
   47.69 -  by (rule bit1.comm_ring_1)+
   47.70 -
   47.71 -instantiation bit0 and bit1 :: (finite) number_ring
   47.72 -begin
   47.73 -
   47.74 -definition "(number_of w :: _ bit0) = of_int w"
   47.75 -
   47.76 -definition "(number_of w :: _ bit1) = of_int w"
   47.77 -
   47.78 -instance proof
   47.79 -qed (rule number_of_bit0_def number_of_bit1_def)+
   47.80 -
   47.81 -end
   47.82 +  by (rule bit1.comm_ring_1)
   47.83  
   47.84  interpretation bit0:
   47.85    mod_ring "int CARD('a::finite bit0)"
   47.86 @@ -289,9 +277,11 @@
   47.87  lemmas bit0_induct [case_names of_int, induct type: bit0] = bit0.induct
   47.88  lemmas bit1_induct [case_names of_int, induct type: bit1] = bit1.induct
   47.89  
   47.90 -lemmas bit0_iszero_number_of [simp] = bit0.iszero_number_of
   47.91 -lemmas bit1_iszero_number_of [simp] = bit1.iszero_number_of
   47.92 +lemmas bit0_iszero_numeral [simp] = bit0.iszero_numeral
   47.93 +lemmas bit1_iszero_numeral [simp] = bit1.iszero_numeral
   47.94  
   47.95 +declare eq_numeral_iff_iszero [where 'a="('a::finite) bit0", standard, simp]
   47.96 +declare eq_numeral_iff_iszero [where 'a="('a::finite) bit1", standard, simp]
   47.97  
   47.98  subsection {* Syntax *}
   47.99  
    48.1 --- a/src/HOL/Library/Poly_Deriv.thy	Mon Mar 26 15:32:54 2012 +0200
    48.2 +++ b/src/HOL/Library/Poly_Deriv.thy	Mon Mar 26 15:33:28 2012 +0200
    48.3 @@ -71,7 +71,8 @@
    48.4  apply (subst power_Suc)
    48.5  apply (subst pderiv_mult)
    48.6  apply (erule ssubst)
    48.7 -apply (simp add: smult_add_left algebra_simps)
    48.8 +apply (simp only: of_nat_Suc smult_add_left smult_1_left)
    48.9 +apply (simp add: algebra_simps) (* FIXME *)
   48.10  done
   48.11  
   48.12  lemma DERIV_cmult2: "DERIV f x :> D ==> DERIV (%x. (f x) * c :: real) x :> D * c"
    49.1 --- a/src/HOL/Library/Polynomial.thy	Mon Mar 26 15:32:54 2012 +0200
    49.2 +++ b/src/HOL/Library/Polynomial.thy	Mon Mar 26 15:33:28 2012 +0200
    49.3 @@ -662,17 +662,6 @@
    49.4  
    49.5  instance poly :: (comm_ring_1) comm_ring_1 ..
    49.6  
    49.7 -instantiation poly :: (comm_ring_1) number_ring
    49.8 -begin
    49.9 -
   49.10 -definition
   49.11 -  "number_of k = (of_int k :: 'a poly)"
   49.12 -
   49.13 -instance
   49.14 -  by default (rule number_of_poly_def)
   49.15 -
   49.16 -end
   49.17 -
   49.18  
   49.19  subsection {* Polynomials form an integral domain *}
   49.20  
   49.21 @@ -1052,12 +1041,12 @@
   49.22  lemma poly_div_minus_left [simp]:
   49.23    fixes x y :: "'a::field poly"
   49.24    shows "(- x) div y = - (x div y)"
   49.25 -  using div_smult_left [of "- 1::'a"] by simp
   49.26 +  using div_smult_left [of "- 1::'a"] by (simp del: minus_one) (* FIXME *)
   49.27  
   49.28  lemma poly_mod_minus_left [simp]:
   49.29    fixes x y :: "'a::field poly"
   49.30    shows "(- x) mod y = - (x mod y)"
   49.31 -  using mod_smult_left [of "- 1::'a"] by simp
   49.32 +  using mod_smult_left [of "- 1::'a"] by (simp del: minus_one) (* FIXME *)
   49.33  
   49.34  lemma pdivmod_rel_smult_right:
   49.35    "\<lbrakk>a \<noteq> 0; pdivmod_rel x y q r\<rbrakk>
   49.36 @@ -1075,12 +1064,12 @@
   49.37    fixes x y :: "'a::field poly"
   49.38    shows "x div (- y) = - (x div y)"
   49.39    using div_smult_right [of "- 1::'a"]
   49.40 -  by (simp add: nonzero_inverse_minus_eq)
   49.41 +  by (simp add: nonzero_inverse_minus_eq del: minus_one) (* FIXME *)
   49.42  
   49.43  lemma poly_mod_minus_right [simp]:
   49.44    fixes x y :: "'a::field poly"
   49.45    shows "x mod (- y) = x mod y"
   49.46 -  using mod_smult_right [of "- 1::'a"] by simp
   49.47 +  using mod_smult_right [of "- 1::'a"] by (simp del: minus_one) (* FIXME *)
   49.48  
   49.49  lemma pdivmod_rel_mult:
   49.50    "\<lbrakk>pdivmod_rel x y q r; pdivmod_rel q z q' r'\<rbrakk>
    50.1 --- a/src/HOL/Library/Predicate_Compile_Alternative_Defs.thy	Mon Mar 26 15:32:54 2012 +0200
    50.2 +++ b/src/HOL/Library/Predicate_Compile_Alternative_Defs.thy	Mon Mar 26 15:33:28 2012 +0200
    50.3 @@ -54,8 +54,8 @@
    50.4  
    50.5  section {* Setup for Numerals *}
    50.6  
    50.7 -setup {* Predicate_Compile_Data.ignore_consts [@{const_name number_of}] *}
    50.8 -setup {* Predicate_Compile_Data.keep_functions [@{const_name number_of}] *}
    50.9 +setup {* Predicate_Compile_Data.ignore_consts [@{const_name numeral}, @{const_name neg_numeral}] *}
   50.10 +setup {* Predicate_Compile_Data.keep_functions [@{const_name numeral}, @{const_name neg_numeral}] *}
   50.11  
   50.12  setup {* Predicate_Compile_Data.ignore_consts [@{const_name div}, @{const_name mod}, @{const_name times}] *}
   50.13  
    51.1 --- a/src/HOL/Library/ROOT.ML	Mon Mar 26 15:32:54 2012 +0200
    51.2 +++ b/src/HOL/Library/ROOT.ML	Mon Mar 26 15:33:28 2012 +0200
    51.3 @@ -4,4 +4,4 @@
    51.4  use_thys ["Library", "List_Cset", "List_Prefix", "List_lexord", "Sublist_Order",
    51.5    "Product_Lattice",
    51.6    "Code_Char_chr", "Code_Char_ord", "Code_Integer", "Efficient_Nat"(*, "Code_Prolog"*),
    51.7 -  "Code_Real_Approx_By_Float" ];
    51.8 +  "Code_Real_Approx_By_Float", "Target_Numeral"];
    52.1 --- a/src/HOL/Library/Saturated.thy	Mon Mar 26 15:32:54 2012 +0200
    52.2 +++ b/src/HOL/Library/Saturated.thy	Mon Mar 26 15:33:28 2012 +0200
    52.3 @@ -157,20 +157,16 @@
    52.4    "nat_of (Sat n :: ('a::len) sat) = min (len_of TYPE('a)) n"
    52.5    by (rule nat_of_Abs_sat' [unfolded Abs_sat'_eq_of_nat])
    52.6  
    52.7 -instantiation sat :: (len) number_semiring
    52.8 -begin
    52.9 +lemma [code_abbrev]:
   52.10 +  "of_nat (numeral k) = (numeral k :: 'a::len sat)"
   52.11 +  by simp
   52.12  
   52.13 -definition
   52.14 -  number_of_sat_def [code del]: "number_of = Sat \<circ> nat"
   52.15 -
   52.16 -instance
   52.17 -  by default (simp add: number_of_sat_def)
   52.18 -
   52.19 -end
   52.20 +definition sat_of_nat :: "nat \<Rightarrow> ('a::len) sat"
   52.21 +  where [code_abbrev]: "sat_of_nat = of_nat"
   52.22  
   52.23  lemma [code abstract]:
   52.24 -  "nat_of (number_of n :: ('a::len) sat) = min (nat n) (len_of TYPE('a))"
   52.25 -  unfolding number_of_sat_def by simp
   52.26 +  "nat_of (sat_of_nat n :: ('a::len) sat) = min (len_of TYPE('a)) n"
   52.27 +  by (simp add: sat_of_nat_def)
   52.28  
   52.29  instance sat :: (len) finite
   52.30  proof
   52.31 @@ -252,4 +248,6 @@
   52.32  
   52.33  end
   52.34  
   52.35 +hide_const (open) sat_of_nat
   52.36 +
   52.37  end
    53.1 --- a/src/HOL/Library/Sum_of_Squares/sum_of_squares.ML	Mon Mar 26 15:32:54 2012 +0200
    53.2 +++ b/src/HOL/Library/Sum_of_Squares/sum_of_squares.ML	Mon Mar 26 15:33:28 2012 +0200
    53.3 @@ -866,10 +866,11 @@
    53.4     @{term "op / :: real => _"}, @{term "inverse :: real => _"},
    53.5     @{term "op ^ :: real => _"}, @{term "abs :: real => _"},
    53.6     @{term "min :: real => _"}, @{term "max :: real => _"},
    53.7 -   @{term "0::real"}, @{term "1::real"}, @{term "number_of :: int => real"},
    53.8 -   @{term "number_of :: int => nat"},
    53.9 -   @{term "Int.Bit0"}, @{term "Int.Bit1"},
   53.10 -   @{term "Int.Pls"}, @{term "Int.Min"}];
   53.11 +   @{term "0::real"}, @{term "1::real"},
   53.12 +   @{term "numeral :: num => nat"},
   53.13 +   @{term "numeral :: num => real"},
   53.14 +   @{term "neg_numeral :: num => real"},
   53.15 +   @{term "Num.Bit0"}, @{term "Num.Bit1"}, @{term "Num.One"}];
   53.16  
   53.17  fun check_sos kcts ct =
   53.18   let
    54.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    54.2 +++ b/src/HOL/Library/Target_Numeral.thy	Mon Mar 26 15:33:28 2012 +0200
    54.3 @@ -0,0 +1,726 @@
    54.4 +theory Target_Numeral
    54.5 +imports Main Code_Nat
    54.6 +begin
    54.7 +
    54.8 +subsection {* Type of target language numerals *}
    54.9 +
   54.10 +typedef (open) int = "UNIV \<Colon> int set"
   54.11 +  morphisms int_of of_int ..
   54.12 +
   54.13 +hide_type (open) int
   54.14 +hide_const (open) of_int
   54.15 +
   54.16 +lemma int_eq_iff:
   54.17 +  "k = l \<longleftrightarrow> int_of k = int_of l"
   54.18 +  using int_of_inject [of k l] ..
   54.19 +
   54.20 +lemma int_eqI:
   54.21 +  "int_of k = int_of l \<Longrightarrow> k = l"
   54.22 +  using int_eq_iff [of k l] by simp
   54.23 +
   54.24 +lemma int_of_int [simp]:
   54.25 +  "int_of (Target_Numeral.of_int k) = k"
   54.26 +  using of_int_inverse [of k] by simp
   54.27 +
   54.28 +lemma of_int_of [simp]:
   54.29 +  "Target_Numeral.of_int (int_of k) = k"
   54.30 +  using int_of_inverse [of k] by simp
   54.31 +
   54.32 +hide_fact (open) int_eq_iff int_eqI
   54.33 +
   54.34 +instantiation Target_Numeral.int :: ring_1
   54.35 +begin
   54.36 +
   54.37 +definition
   54.38 +  "0 = Target_Numeral.of_int 0"
   54.39 +
   54.40 +lemma int_of_zero [simp]:
   54.41 +  "int_of 0 = 0"
   54.42 +  by (simp add: zero_int_def)
   54.43 +
   54.44 +definition
   54.45 +  "1 = Target_Numeral.of_int 1"
   54.46 +
   54.47 +lemma int_of_one [simp]:
   54.48 +  "int_of 1 = 1"
   54.49 +  by (simp add: one_int_def)
   54.50 +
   54.51 +definition
   54.52 +  "k + l = Target_Numeral.of_int (int_of k + int_of l)"
   54.53 +
   54.54 +lemma int_of_plus [simp]:
   54.55 +  "int_of (k + l) = int_of k + int_of l"
   54.56 +  by (simp add: plus_int_def)
   54.57 +
   54.58 +definition
   54.59 +  "- k = Target_Numeral.of_int (- int_of k)"
   54.60 +
   54.61 +lemma int_of_uminus [simp]:
   54.62 +  "int_of (- k) = - int_of k"
   54.63 +  by (simp add: uminus_int_def)
   54.64 +
   54.65 +definition
   54.66 +  "k - l = Target_Numeral.of_int (int_of k - int_of l)"
   54.67 +
   54.68 +lemma int_of_minus [simp]:
   54.69 +  "int_of (k - l) = int_of k - int_of l"
   54.70 +  by (simp add: minus_int_def)
   54.71 +
   54.72 +definition
   54.73 +  "k * l = Target_Numeral.of_int (int_of k * int_of l)"
   54.74 +
   54.75 +lemma int_of_times [simp]:
   54.76 +  "int_of (k * l) = int_of k * int_of l"
   54.77 +  by (simp add: times_int_def)
   54.78 +
   54.79 +instance proof
   54.80 +qed (auto simp add: Target_Numeral.int_eq_iff algebra_simps)
   54.81 +
   54.82 +end
   54.83 +
   54.84 +lemma int_of_of_nat [simp]:
   54.85 +  "int_of (of_nat n) = of_nat n"
   54.86 +  by (induct n) simp_all
   54.87 +
   54.88 +definition nat_of :: "Target_Numeral.int \<Rightarrow> nat" where
   54.89 +  "nat_of k = Int.nat (int_of k)"
   54.90 +
   54.91 +lemma nat_of_of_nat [simp]:
   54.92 +  "nat_of (of_nat n) = n"
   54.93 +  by (simp add: nat_of_def)
   54.94 +
   54.95 +lemma int_of_of_int [simp]:
   54.96 +  "int_of (of_int k) = k"
   54.97 +  by (induct k) (simp_all, simp only: neg_numeral_def numeral_One int_of_uminus int_of_one)
   54.98 +
   54.99 +lemma of_int_of_int [simp, code_abbrev]:
  54.100 +  "Target_Numeral.of_int = of_int"
  54.101 +  by rule (simp add: Target_Numeral.int_eq_iff)
  54.102 +
  54.103 +lemma int_of_numeral [simp]:
  54.104 +  "int_of (numeral k) = numeral k"
  54.105 +  using int_of_of_int [of "numeral k"] by simp
  54.106 +
  54.107 +lemma int_of_neg_numeral [simp]:
  54.108 +  "int_of (neg_numeral k) = neg_numeral k"
  54.109 +  by (simp only: neg_numeral_def int_of_uminus) simp
  54.110 +
  54.111 +lemma int_of_sub [simp]:
  54.112 +  "int_of (Num.sub k l) = Num.sub k l"
  54.113 +  by (simp only: Num.sub_def int_of_minus int_of_numeral)
  54.114 +
  54.115 +instantiation Target_Numeral.int :: "{ring_div, equal, linordered_idom}"
  54.116 +begin
  54.117 +
  54.118 +definition
  54.119 +  "k div l = of_int (int_of k div int_of l)"
  54.120 +
  54.121 +lemma int_of_div [simp]:
  54.122 +  "int_of (k div l) = int_of k div int_of l"
  54.123 +  by (simp add: div_int_def)
  54.124 +
  54.125 +definition
  54.126 +  "k mod l = of_int (int_of k mod int_of l)"
  54.127 +
  54.128 +lemma int_of_mod [simp]:
  54.129 +  "int_of (k mod l) = int_of k mod int_of l"
  54.130 +  by (simp add: mod_int_def)
  54.131 +
  54.132 +definition
  54.133 +  "\<bar>k\<bar> = of_int \<bar>int_of k\<bar>"
  54.134 +
  54.135 +lemma int_of_abs [simp]:
  54.136 +  "int_of \<bar>k\<bar> = \<bar>int_of k\<bar>"
  54.137 +  by (simp add: abs_int_def)
  54.138 +
  54.139 +definition
  54.140 +  "sgn k = of_int (sgn (int_of k))"
  54.141 +
  54.142 +lemma int_of_sgn [simp]:
  54.143 +  "int_of (sgn k) = sgn (int_of k)"
  54.144 +  by (simp add: sgn_int_def)
  54.145 +
  54.146 +definition
  54.147 +  "k \<le> l \<longleftrightarrow> int_of k \<le> int_of l"
  54.148 +
  54.149 +definition
  54.150 +  "k < l \<longleftrightarrow> int_of k < int_of l"
  54.151 +
  54.152 +definition
  54.153 +  "HOL.equal k l \<longleftrightarrow> HOL.equal (int_of k) (int_of l)"
  54.154 +
  54.155 +instance proof
  54.156 +qed (auto simp add: Target_Numeral.int_eq_iff algebra_simps
  54.157 +  less_eq_int_def less_int_def equal_int_def equal)
  54.158 +
  54.159 +end
  54.160 +
  54.161 +lemma int_of_min [simp]:
  54.162 +  "int_of (min k l) = min (int_of k) (int_of l)"
  54.163 +  by (simp add: min_def less_eq_int_def)
  54.164 +
  54.165 +lemma int_of_max [simp]:
  54.166 +  "int_of (max k l) = max (int_of k) (int_of l)"
  54.167 +  by (simp add: max_def less_eq_int_def)
  54.168 +
  54.169 +
  54.170 +subsection {* Code theorems for target language numerals *}
  54.171 +
  54.172 +text {* Constructors *}
  54.173 +
  54.174 +definition Pos :: "num \<Rightarrow> Target_Numeral.int" where
  54.175 +  [simp, code_abbrev]: "Pos = numeral"
  54.176 +
  54.177 +definition Neg :: "num \<Rightarrow> Target_Numeral.int" where
  54.178 +  [simp, code_abbrev]: "Neg = neg_numeral"
  54.179 +
  54.180 +code_datatype "0::Target_Numeral.int" Pos Neg
  54.181 +
  54.182 +
  54.183 +text {* Auxiliary operations *}
  54.184 +
  54.185 +definition dup :: "Target_Numeral.int \<Rightarrow> Target_Numeral.int" where
  54.186 +  [simp]: "dup k = k + k"
  54.187 +
  54.188 +lemma dup_code [code]:
  54.189 +  "dup 0 = 0"
  54.190 +  "dup (Pos n) = Pos (Num.Bit0 n)"
  54.191 +  "dup (Neg n) = Neg (Num.Bit0 n)"
  54.192 +  unfolding Pos_def Neg_def neg_numeral_def
  54.193 +  by (simp_all add: numeral_Bit0)
  54.194 +
  54.195 +definition sub :: "num \<Rightarrow> num \<Rightarrow> Target_Numeral.int" where
  54.196 +  [simp]: "sub m n = numeral m - numeral n"
  54.197 +
  54.198 +lemma sub_code [code]:
  54.199 +  "sub Num.One Num.One = 0"
  54.200 +  "sub (Num.Bit0 m) Num.One = Pos (Num.BitM m)"
  54.201 +  "sub (Num.Bit1 m) Num.One = Pos (Num.Bit0 m)"
  54.202 +  "sub Num.One (Num.Bit0 n) = Neg (Num.BitM n)"
  54.203 +  "sub Num.One (Num.Bit1 n) = Neg (Num.Bit0 n)"
  54.204 +  "sub (Num.Bit0 m) (Num.Bit0 n) = dup (sub m n)"
  54.205 +  "sub (Num.Bit1 m) (Num.Bit1 n) = dup (sub m n)"
  54.206 +  "sub (Num.Bit1 m) (Num.Bit0 n) = dup (sub m n) + 1"
  54.207 +  "sub (Num.Bit0 m) (Num.Bit1 n) = dup (sub m n) - 1"
  54.208 +  unfolding sub_def dup_def numeral.simps Pos_def Neg_def
  54.209 +    neg_numeral_def numeral_BitM
  54.210 +  by (simp_all only: algebra_simps add.comm_neutral)
  54.211 +
  54.212 +
  54.213 +text {* Implementations *}
  54.214 +
  54.215 +lemma one_int_code [code, code_unfold]:
  54.216 +  "1 = Pos Num.One"
  54.217 +  by simp
  54.218 +
  54.219 +lemma plus_int_code [code]:
  54.220 +  "k + 0 = (k::Target_Numeral.int)"
  54.221 +  "0 + l = (l::Target_Numeral.int)"
  54.222 +  "Pos m + Pos n = Pos (m + n)"
  54.223 +  "Pos m + Neg n = sub m n"
  54.224 +  "Neg m + Pos n = sub n m"
  54.225 +  "Neg m + Neg n = Neg (m + n)"
  54.226 +  by simp_all
  54.227 +
  54.228 +lemma uminus_int_code [code]:
  54.229 +  "uminus 0 = (0::Target_Numeral.int)"
  54.230 +  "uminus (Pos m) = Neg m"
  54.231 +  "uminus (Neg m) = Pos m"
  54.232 +  by simp_all
  54.233 +
  54.234 +lemma minus_int_code [code]:
  54.235 +  "k - 0 = (k::Target_Numeral.int)"
  54.236 +  "0 - l = uminus (l::Target_Numeral.int)"
  54.237 +  "Pos m - Pos n = sub m n"
  54.238 +  "Pos m - Neg n = Pos (m + n)"
  54.239 +  "Neg m - Pos n = Neg (m + n)"
  54.240 +  "Neg m - Neg n = sub n m"
  54.241 +  by simp_all
  54.242 +
  54.243 +lemma times_int_code [code]:
  54.244 +  "k * 0 = (0::Target_Numeral.int)"
  54.245 +  "0 * l = (0::Target_Numeral.int)"
  54.246 +  "Pos m * Pos n = Pos (m * n)"
  54.247 +  "Pos m * Neg n = Neg (m * n)"
  54.248 +  "Neg m * Pos n = Neg (m * n)"
  54.249 +  "Neg m * Neg n = Pos (m * n)"
  54.250 +  by simp_all
  54.251 +
  54.252 +definition divmod :: "Target_Numeral.int \<Rightarrow> Target_Numeral.int \<Rightarrow> Target_Numeral.int \<times> Target_Numeral.int" where
  54.253 +  "divmod k l = (k div l, k mod l)"
  54.254 +
  54.255 +lemma fst_divmod [simp]:
  54.256 +  "fst (divmod k l) = k div l"
  54.257 +  by (simp add: divmod_def)
  54.258 +
  54.259 +lemma snd_divmod [simp]:
  54.260 +  "snd (divmod k l) = k mod l"
  54.261 +  by (simp add: divmod_def)
  54.262 +
  54.263 +definition divmod_abs :: "Target_Numeral.int \<Rightarrow> Target_Numeral.int \<Rightarrow> Target_Numeral.int \<times> Target_Numeral.int" where
  54.264 +  "divmod_abs k l = (\<bar>k\<bar> div \<bar>l\<bar>, \<bar>k\<bar> mod \<bar>l\<bar>)"
  54.265 +
  54.266 +lemma fst_divmod_abs [simp]:
  54.267 +  "fst (divmod_abs k l) = \<bar>k\<bar> div \<bar>l\<bar>"
  54.268 +  by (simp add: divmod_abs_def)
  54.269 +
  54.270 +lemma snd_divmod_abs [simp]:
  54.271 +  "snd (divmod_abs k l) = \<bar>k\<bar> mod \<bar>l\<bar>"
  54.272 +  by (simp add: divmod_abs_def)
  54.273 +
  54.274 +lemma divmod_abs_terminate_code [code]:
  54.275 +  "divmod_abs (Neg k) (Neg l) = divmod_abs (Pos k) (Pos l)"
  54.276 +  "divmod_abs (Neg k) (Pos l) = divmod_abs (Pos k) (Pos l)"
  54.277 +  "divmod_abs (Pos k) (Neg l) = divmod_abs (Pos k) (Pos l)"
  54.278 +  "divmod_abs j 0 = (0, \<bar>j\<bar>)"
  54.279 +  "divmod_abs 0 j = (0, 0)"
  54.280 +  by (simp_all add: prod_eq_iff)
  54.281 +
  54.282 +lemma divmod_abs_rec_code [code]:
  54.283 +  "divmod_abs (Pos k) (Pos l) =
  54.284 +    (let j = sub k l in
  54.285 +       if j < 0 then (0, Pos k)
  54.286 +       else let (q, r) = divmod_abs j (Pos l) in (q + 1, r))"
  54.287 +  by (auto simp add: prod_eq_iff Target_Numeral.int_eq_iff Let_def prod_case_beta
  54.288 +    sub_non_negative sub_negative div_pos_pos_trivial mod_pos_pos_trivial div_pos_geq mod_pos_geq)
  54.289 +
  54.290 +lemma divmod_code [code]: "divmod k l =
  54.291 +  (if k = 0 then (0, 0) else if l = 0 then (0, k) else
  54.292 +  (apsnd \<circ> times \<circ> sgn) l (if sgn k = sgn l
  54.293 +    then divmod_abs k l
  54.294 +    else (let (r, s) = divmod_abs k l in
  54.295 +      if s = 0 then (- r, 0) else (- r - 1, \<bar>l\<bar> - s))))"
  54.296 +proof -
  54.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"
  54.298 +    by (auto simp add: sgn_if)
  54.299 +  have aux2: "\<And>q::int. - int_of k = int_of l * q \<longleftrightarrow> int_of k = int_of l * - q" by auto
  54.300 +  show ?thesis
  54.301 +    by (simp add: prod_eq_iff Target_Numeral.int_eq_iff prod_case_beta aux1)
  54.302 +      (auto simp add: zdiv_zminus1_eq_if zmod_zminus1_eq_if zdiv_zminus2 zmod_zminus2 aux2)
  54.303 +qed
  54.304 +
  54.305 +lemma div_int_code [code]:
  54.306 +  "k div l = fst (divmod k l)"
  54.307 +  by simp
  54.308 +
  54.309 +lemma div_mod_code [code]:
  54.310 +  "k mod l = snd (divmod k l)"
  54.311 +  by simp
  54.312 +
  54.313 +lemma equal_int_code [code]:
  54.314 +  "HOL.equal 0 (0::Target_Numeral.int) \<longleftrightarrow> True"
  54.315 +  "HOL.equal 0 (Pos l) \<longleftrightarrow> False"
  54.316 +  "HOL.equal 0 (Neg l) \<longleftrightarrow> False"
  54.317 +  "HOL.equal (Pos k) 0 \<longleftrightarrow> False"
  54.318 +  "HOL.equal (Pos k) (Pos l) \<longleftrightarrow> HOL.equal k l"
  54.319 +  "HOL.equal (Pos k) (Neg l) \<longleftrightarrow> False"
  54.320 +  "HOL.equal (Neg k) 0 \<longleftrightarrow> False"
  54.321 +  "HOL.equal (Neg k) (Pos l) \<longleftrightarrow> False"
  54.322 +  "HOL.equal (Neg k) (Neg l) \<longleftrightarrow> HOL.equal k l"
  54.323 +  by (simp_all add: equal Target_Numeral.int_eq_iff)
  54.324 +
  54.325 +lemma equal_int_refl [code nbe]:
  54.326 +  "HOL.equal (k::Target_Numeral.int) k \<longleftrightarrow> True"
  54.327 +  by (fact equal_refl)
  54.328 +
  54.329 +lemma less_eq_int_code [code]:
  54.330 +  "0 \<le> (0::Target_Numeral.int) \<longleftrightarrow> True"
  54.331 +  "0 \<le> Pos l \<longleftrightarrow> True"
  54.332 +  "0 \<le> Neg l \<longleftrightarrow> False"
  54.333 +  "Pos k \<le> 0 \<longleftrightarrow> False"
  54.334 +  "Pos k \<le> Pos l \<longleftrightarrow> k \<le> l"
  54.335 +  "Pos k \<le> Neg l \<longleftrightarrow> False"
  54.336 +  "Neg k \<le> 0 \<longleftrightarrow> True"
  54.337 +  "Neg k \<le> Pos l \<longleftrightarrow> True"
  54.338 +  "Neg k \<le> Neg l \<longleftrightarrow> l \<le> k"
  54.339 +  by (simp_all add: less_eq_int_def)
  54.340 +
  54.341 +lemma less_int_code [code]:
  54.342 +  "0 < (0::Target_Numeral.int) \<longleftrightarrow> False"
  54.343 +  "0 < Pos l \<longleftrightarrow> True"
  54.344 +  "0 < Neg l \<longleftrightarrow> False"
  54.345 +  "Pos k < 0 \<longleftrightarrow> False"
  54.346 +  "Pos k < Pos l \<longleftrightarrow> k < l"
  54.347 +  "Pos k < Neg l \<longleftrightarrow> False"
  54.348 +  "Neg k < 0 \<longleftrightarrow> True"
  54.349 +  "Neg k < Pos l \<longleftrightarrow> True"
  54.350 +  "Neg k < Neg l \<longleftrightarrow> l < k"
  54.351 +  by (simp_all add: less_int_def)
  54.352 +
  54.353 +lemma nat_of_code [code]:
  54.354 +  "nat_of (Neg k) = 0"
  54.355 +  "nat_of 0 = 0"
  54.356 +  "nat_of (Pos k) = nat_of_num k"
  54.357 +  by (simp_all add: nat_of_def nat_of_num_numeral)
  54.358 +
  54.359 +lemma int_of_code [code]:
  54.360 +  "int_of (Neg k) = neg_numeral k"
  54.361 +  "int_of 0 = 0"
  54.362 +  "int_of (Pos k) = numeral k"
  54.363 +  by simp_all
  54.364 +
  54.365 +lemma of_int_code [code]:
  54.366 +  "Target_Numeral.of_int (Int.Neg k) = neg_numeral k"
  54.367 +  "Target_Numeral.of_int 0 = 0"
  54.368 +  "Target_Numeral.of_int (Int.Pos k) = numeral k"
  54.369 +  by simp_all
  54.370 +
  54.371 +definition num_of_int :: "Target_Numeral.int \<Rightarrow> num" where
  54.372 +  "num_of_int = num_of_nat \<circ> nat_of"
  54.373 +
  54.374 +lemma num_of_int_code [code]:
  54.375 +  "num_of_int k = (if k \<le> 1 then Num.One
  54.376 +     else let
  54.377 +       (l, j) = divmod k 2;
  54.378 +       l' = num_of_int l + num_of_int l
  54.379 +     in if j = 0 then l' else l' + Num.One)"
  54.380 +proof -
  54.381 +  {
  54.382 +    assume "int_of k mod 2 = 1"
  54.383 +    then have "nat (int_of k mod 2) = nat 1" by simp
  54.384 +    moreover assume *: "1 < int_of k"
  54.385 +    ultimately have **: "nat (int_of k) mod 2 = 1" by (simp add: nat_mod_distrib)
  54.386 +    have "num_of_nat (nat (int_of k)) =
  54.387 +      num_of_nat (2 * (nat (int_of k) div 2) + nat (int_of k) mod 2)"
  54.388 +      by simp
  54.389 +    then have "num_of_nat (nat (int_of k)) =
  54.390 +      num_of_nat (nat (int_of k) div 2 + nat (int_of k) div 2 + nat (int_of k) mod 2)"
  54.391 +      by (simp add: nat_mult_2)
  54.392 +    with ** have "num_of_nat (nat (int_of k)) =
  54.393 +      num_of_nat (nat (int_of k) div 2 + nat (int_of k) div 2 + 1)"
  54.394 +      by simp
  54.395 +  }
  54.396 +  note aux = this
  54.397 +  show ?thesis
  54.398 +    by (auto simp add: num_of_int_def nat_of_def Let_def prod_case_beta
  54.399 +      not_le Target_Numeral.int_eq_iff less_eq_int_def
  54.400 +      nat_mult_distrib nat_div_distrib num_of_nat_One num_of_nat_plus_distrib
  54.401 +       nat_mult_2 aux add_One)
  54.402 +qed
  54.403 +
  54.404 +hide_const (open) int_of nat_of Pos Neg sub dup divmod_abs num_of_int
  54.405 +
  54.406 +
  54.407 +subsection {* Serializer setup for target language numerals *}
  54.408 +
  54.409 +code_type Target_Numeral.int
  54.410 +  (SML "IntInf.int")
  54.411 +  (OCaml "Big'_int.big'_int")
  54.412 +  (Haskell "Integer")
  54.413 +  (Scala "BigInt")
  54.414 +  (Eval "int")
  54.415 +
  54.416 +code_instance Target_Numeral.int :: equal
  54.417 +  (Haskell -)
  54.418 +
  54.419 +code_const "0::Target_Numeral.int"
  54.420 +  (SML "0")
  54.421 +  (OCaml "Big'_int.zero'_big'_int")
  54.422 +  (Haskell "0")
  54.423 +  (Scala "BigInt(0)")
  54.424 +
  54.425 +setup {*
  54.426 +  fold (Numeral.add_code @{const_name Target_Numeral.Pos}
  54.427 +    false Code_Printer.literal_numeral) ["SML", "OCaml", "Haskell", "Scala"]
  54.428 +*}
  54.429 +
  54.430 +setup {*
  54.431 +  fold (Numeral.add_code @{const_name Target_Numeral.Neg}
  54.432 +    true Code_Printer.literal_numeral) ["SML", "OCaml", "Haskell", "Scala"]
  54.433 +*}
  54.434 +
  54.435 +code_const "plus :: Target_Numeral.int \<Rightarrow> _ \<Rightarrow> _"
  54.436 +  (SML "IntInf.+ ((_), (_))")
  54.437 +  (OCaml "Big'_int.add'_big'_int")
  54.438 +  (Haskell infixl 6 "+")
  54.439 +  (Scala infixl 7 "+")
  54.440 +  (Eval infixl 8 "+")
  54.441 +
  54.442 +code_const "uminus :: Target_Numeral.int \<Rightarrow> _"
  54.443 +  (SML "IntInf.~")
  54.444 +  (OCaml "Big'_int.minus'_big'_int")
  54.445 +  (Haskell "negate")
  54.446 +  (Scala "!(- _)")
  54.447 +  (Eval "~/ _")
  54.448 +
  54.449 +code_const "minus :: Target_Numeral.int \<Rightarrow> _"
  54.450 +  (SML "IntInf.- ((_), (_))")
  54.451 +  (OCaml "Big'_int.sub'_big'_int")
  54.452 +  (Haskell infixl 6 "-")
  54.453 +  (Scala infixl 7 "-")
  54.454 +  (Eval infixl 8 "-")
  54.455 +
  54.456 +code_const Target_Numeral.dup
  54.457 +  (SML "IntInf.*/ (2,/ (_))")
  54.458 +  (OCaml "Big'_int.mult'_big'_int/ 2")
  54.459 +  (Haskell "!(2 * _)")
  54.460 +  (Scala "!(2 * _)")
  54.461 +  (Eval "!(2 * _)")
  54.462 +
  54.463 +code_const Target_Numeral.sub
  54.464 +  (SML "!(raise/ Fail/ \"sub\")")
  54.465 +  (OCaml "failwith/ \"sub\"")
  54.466 +  (Haskell "error/ \"sub\"")
  54.467 +  (Scala "!error(\"sub\")")
  54.468 +
  54.469 +code_const "times :: Target_Numeral.int \<Rightarrow> _ \<Rightarrow> _"
  54.470 +  (SML "IntInf.* ((_), (_))")
  54.471 +  (OCaml "Big'_int.mult'_big'_int")
  54.472 +  (Haskell infixl 7 "*")
  54.473 +  (Scala infixl 8 "*")
  54.474 +  (Eval infixl 9 "*")
  54.475 +
  54.476 +code_const Target_Numeral.divmod_abs
  54.477 +  (SML "IntInf.divMod/ (IntInf.abs _,/ IntInf.abs _)")
  54.478 +  (OCaml "Big'_int.quomod'_big'_int/ (Big'_int.abs'_big'_int _)/ (Big'_int.abs'_big'_int _)")
  54.479 +  (Haskell "divMod/ (abs _)/ (abs _)")
  54.480 +  (Scala "!((k: BigInt) => (l: BigInt) =>/ if (l == 0)/ (BigInt(0), k) else/ (k.abs '/% l.abs))")
  54.481 +  (Eval "Integer.div'_mod/ (abs _)/ (abs _)")
  54.482 +
  54.483 +code_const "HOL.equal :: Target_Numeral.int \<Rightarrow> _ \<Rightarrow> bool"
  54.484 +  (SML "!((_ : IntInf.int) = _)")
  54.485 +  (OCaml "Big'_int.eq'_big'_int")
  54.486 +  (Haskell infix 4 "==")
  54.487 +  (Scala infixl 5 "==")
  54.488 +  (Eval infixl 6 "=")
  54.489 +
  54.490 +code_const "less_eq :: Target_Numeral.int \<Rightarrow> _ \<Rightarrow> bool"
  54.491 +  (SML "IntInf.<= ((_), (_))")
  54.492 +  (OCaml "Big'_int.le'_big'_int")
  54.493 +  (Haskell infix 4 "<=")
  54.494 +  (Scala infixl 4 "<=")
  54.495 +  (Eval infixl 6 "<=")
  54.496 +
  54.497 +code_const "less :: Target_Numeral.int \<Rightarrow> _ \<Rightarrow> bool"
  54.498 +  (SML "IntInf.< ((_), (_))")
  54.499 +  (OCaml "Big'_int.lt'_big'_int")
  54.500 +  (Haskell infix 4 "<")
  54.501 +  (Scala infixl 4 "<")
  54.502 +  (Eval infixl 6 "<")
  54.503 +
  54.504 +ML {*
  54.505 +structure Target_Numeral =
  54.506 +struct
  54.507 +
  54.508 +val T = @{typ "Target_Numeral.int"};
  54.509 +
  54.510 +end;
  54.511 +*}
  54.512 +
  54.513 +code_reserved Eval Target_Numeral
  54.514 +
  54.515 +code_const "Code_Evaluation.term_of \<Colon> Target_Numeral.int \<Rightarrow> term"
  54.516 +  (Eval "HOLogic.mk'_number/ Target'_Numeral.T")
  54.517 +
  54.518 +code_modulename SML
  54.519 +  Target_Numeral Arith
  54.520 +
  54.521 +code_modulename OCaml
  54.522 +  Target_Numeral Arith
  54.523 +
  54.524 +code_modulename Haskell
  54.525 +  Target_Numeral Arith
  54.526 +
  54.527 +
  54.528 +subsection {* Implementation for @{typ int} *}
  54.529 +
  54.530 +code_datatype Target_Numeral.int_of
  54.531 +
  54.532 +lemma [code, code del]:
  54.533 +  "Target_Numeral.of_int = Target_Numeral.of_int" ..
  54.534 +
  54.535 +lemma [code]:
  54.536 +  "Target_Numeral.of_int (Target_Numeral.int_of k) = k"
  54.537 +  by (simp add: Target_Numeral.int_eq_iff)
  54.538 +
  54.539 +declare Int.Pos_def [code]
  54.540 +
  54.541 +lemma [code_abbrev]:
  54.542 +  "Target_Numeral.int_of (Target_Numeral.Pos k) = Int.Pos k"
  54.543 +  by simp
  54.544 +
  54.545 +declare Int.Neg_def [code]
  54.546 +
  54.547 +lemma [code_abbrev]:
  54.548 +  "Target_Numeral.int_of (Target_Numeral.Neg k) = Int.Neg k"
  54.549 +  by simp
  54.550 +
  54.551 +lemma [code]:
  54.552 +  "0 = Target_Numeral.int_of 0"
  54.553 +  by simp
  54.554 +
  54.555 +lemma [code]:
  54.556 +  "1 = Target_Numeral.int_of 1"
  54.557 +  by simp
  54.558 +
  54.559 +lemma [code]:
  54.560 +  "k + l = Target_Numeral.int_of (of_int k + of_int l)"
  54.561 +  by simp
  54.562 +
  54.563 +lemma [code]:
  54.564 +  "- k = Target_Numeral.int_of (- of_int k)"
  54.565 +  by simp
  54.566 +
  54.567 +lemma [code]:
  54.568 +  "k - l = Target_Numeral.int_of (of_int k - of_int l)"
  54.569 +  by simp
  54.570 +
  54.571 +lemma [code]:
  54.572 +  "Int.dup k = Target_Numeral.int_of (Target_Numeral.dup (of_int k))"
  54.573 +  by simp
  54.574 +
  54.575 +lemma [code, code del]:
  54.576 +  "Int.sub = Int.sub" ..
  54.577 +
  54.578 +lemma [code]:
  54.579 +  "k * l = Target_Numeral.int_of (of_int k * of_int l)"
  54.580 +  by simp
  54.581 +
  54.582 +lemma [code]:
  54.583 +  "pdivmod k l = map_pair Target_Numeral.int_of Target_Numeral.int_of
  54.584 +    (Target_Numeral.divmod_abs (of_int k) (of_int l))"
  54.585 +  by (simp add: prod_eq_iff pdivmod_def)
  54.586 +
  54.587 +lemma [code]:
  54.588 +  "k div l = Target_Numeral.int_of (of_int k div of_int l)"
  54.589 +  by simp
  54.590 +
  54.591 +lemma [code]:
  54.592 +  "k mod l = Target_Numeral.int_of (of_int k mod of_int l)"
  54.593 +  by simp
  54.594 +
  54.595 +lemma [code]:
  54.596 +  "HOL.equal k l = HOL.equal (of_int k :: Target_Numeral.int) (of_int l)"
  54.597 +  by (simp add: equal Target_Numeral.int_eq_iff)
  54.598 +
  54.599 +lemma [code]:
  54.600 +  "k \<le> l \<longleftrightarrow> (of_int k :: Target_Numeral.int) \<le> of_int l"
  54.601 +  by (simp add: less_eq_int_def)
  54.602 +
  54.603 +lemma [code]:
  54.604 +  "k < l \<longleftrightarrow> (of_int k :: Target_Numeral.int) < of_int l"
  54.605 +  by (simp add: less_int_def)
  54.606 +
  54.607 +lemma (in ring_1) of_int_code:
  54.608 +  "of_int k = (if k = 0 then 0
  54.609 +     else if k < 0 then - of_int (- k)
  54.610 +     else let
  54.611 +       (l, j) = divmod_int k 2;
  54.612 +       l' = 2 * of_int l
  54.613 +     in if j = 0 then l' else l' + 1)"
  54.614 +proof -
  54.615 +  from mod_div_equality have *: "of_int k = of_int (k div 2 * 2 + k mod 2)" by simp
  54.616 +  show ?thesis
  54.617 +    by (simp add: Let_def divmod_int_mod_div mod_2_not_eq_zero_eq_one_int
  54.618 +      of_int_add [symmetric]) (simp add: * mult_commute)
  54.619 +qed
  54.620 +
  54.621 +declare of_int_code [code]
  54.622 +
  54.623 +
  54.624 +subsection {* Implementation for @{typ nat} *}
  54.625 +
  54.626 +definition of_nat :: "nat \<Rightarrow> Target_Numeral.int" where
  54.627 +  [code_abbrev]: "of_nat = Nat.of_nat"
  54.628 +
  54.629 +hide_const (open) of_nat
  54.630 +
  54.631 +lemma int_of_nat [simp]:
  54.632 +  "Target_Numeral.int_of (Target_Numeral.of_nat n) = of_nat n"
  54.633 +  by (simp add: of_nat_def)
  54.634 +
  54.635 +lemma [code abstype]:
  54.636 +  "Target_Numeral.nat_of (Target_Numeral.of_nat n) = n"
  54.637 +  by (simp add: nat_of_def)
  54.638 +
  54.639 +lemma [code_abbrev]:
  54.640 +  "nat (Int.Pos k) = nat_of_num k"
  54.641 +  by (simp add: nat_of_num_numeral)
  54.642 +
  54.643 +lemma [code abstract]:
  54.644 +  "Target_Numeral.of_nat 0 = 0"
  54.645 +  by (simp add: Target_Numeral.int_eq_iff)
  54.646 +
  54.647 +lemma [code abstract]:
  54.648 +  "Target_Numeral.of_nat 1 = 1"
  54.649 +  by (simp add: Target_Numeral.int_eq_iff)
  54.650 +
  54.651 +lemma [code abstract]:
  54.652 +  "Target_Numeral.of_nat (m + n) = of_nat m + of_nat n"
  54.653 +  by (simp add: Target_Numeral.int_eq_iff)
  54.654 +
  54.655 +lemma [code abstract]:
  54.656 +  "Target_Numeral.of_nat (Code_Nat.dup n) = Target_Numeral.dup (of_nat n)"
  54.657 +  by (simp add: Target_Numeral.int_eq_iff Code_Nat.dup_def)
  54.658 +
  54.659 +lemma [code, code del]:
  54.660 +  "Code_Nat.sub = Code_Nat.sub" ..
  54.661 +
  54.662 +lemma [code abstract]:
  54.663 +  "Target_Numeral.of_nat (m - n) = max 0 (of_nat m - of_nat n)"
  54.664 +  by (simp add: Target_Numeral.int_eq_iff)
  54.665 +
  54.666 +lemma [code abstract]:
  54.667 +  "Target_Numeral.of_nat (m * n) = of_nat m * of_nat n"
  54.668 +  by (simp add: Target_Numeral.int_eq_iff of_nat_mult)
  54.669 +
  54.670 +lemma [code abstract]:
  54.671 +  "Target_Numeral.of_nat (m div n) = of_nat m div of_nat n"
  54.672 +  by (simp add: Target_Numeral.int_eq_iff zdiv_int)
  54.673 +
  54.674 +lemma [code abstract]:
  54.675 +  "Target_Numeral.of_nat (m mod n) = of_nat m mod of_nat n"
  54.676 +  by (simp add: Target_Numeral.int_eq_iff zmod_int)
  54.677 +
  54.678 +lemma [code]:
  54.679 +  "Divides.divmod_nat m n = (m div n, m mod n)"
  54.680 +  by (simp add: prod_eq_iff)
  54.681 +
  54.682 +lemma [code]:
  54.683 +  "HOL.equal m n = HOL.equal (of_nat m :: Target_Numeral.int) (of_nat n)"
  54.684 +  by (simp add: equal Target_Numeral.int_eq_iff)
  54.685 +
  54.686 +lemma [code]:
  54.687 +  "m \<le> n \<longleftrightarrow> (of_nat m :: Target_Numeral.int) \<le> of_nat n"
  54.688 +  by (simp add: less_eq_int_def)
  54.689 +
  54.690 +lemma [code]:
  54.691 +  "m < n \<longleftrightarrow> (of_nat m :: Target_Numeral.int) < of_nat n"
  54.692 +  by (simp add: less_int_def)
  54.693 +
  54.694 +lemma num_of_nat_code [code]:
  54.695 +  "num_of_nat = Target_Numeral.num_of_int \<circ> Target_Numeral.of_nat"
  54.696 +  by (simp add: fun_eq_iff num_of_int_def of_nat_def)
  54.697 +
  54.698 +lemma (in semiring_1) of_nat_code:
  54.699 +  "of_nat n = (if n = 0 then 0
  54.700 +     else let
  54.701 +       (m, q) = divmod_nat n 2;
  54.702 +       m' = 2 * of_nat m
  54.703 +     in if q = 0 then m' else m' + 1)"
  54.704 +proof -
  54.705 +  from mod_div_equality have *: "of_nat n = of_nat (n div 2 * 2 + n mod 2)" by simp
  54.706 +  show ?thesis
  54.707 +    by (simp add: Let_def divmod_nat_div_mod mod_2_not_eq_zero_eq_one_nat
  54.708 +      of_nat_add [symmetric])
  54.709 +      (simp add: * mult_commute of_nat_mult add_commute)
  54.710 +qed
  54.711 +
  54.712 +declare of_nat_code [code]
  54.713 +
  54.714 +text {* Conversions between @{typ nat} and @{typ int} *}
  54.715 +
  54.716 +definition int :: "nat \<Rightarrow> int" where
  54.717 +  [code_abbrev]: "int = of_nat"
  54.718 +
  54.719 +hide_const (open) int
  54.720 +
  54.721 +lemma [code]:
  54.722 +  "Target_Numeral.int n = Target_Numeral.int_of (of_nat n)"
  54.723 +  by (simp add: int_def)
  54.724 +
  54.725 +lemma [code abstract]:
  54.726 +  "Target_Numeral.of_nat (nat k) = max 0 (Target_Numeral.of_int k)"
  54.727 +  by (simp add: of_nat_def of_int_of_nat max_def)
  54.728 +
  54.729 +end
    55.1 --- a/src/HOL/List.thy	Mon Mar 26 15:32:54 2012 +0200
    55.2 +++ b/src/HOL/List.thy	Mon Mar 26 15:33:28 2012 +0200
    55.3 @@ -2676,7 +2676,7 @@
    55.4  -- {* simp does not terminate! *}
    55.5  by (induct j) auto
    55.6  
    55.7 -lemmas upt_rec_number_of[simp] = upt_rec[of "number_of m" "number_of n"] for m n
    55.8 +lemmas upt_rec_numeral[simp] = upt_rec[of "numeral m" "numeral n"] for m n
    55.9  
   55.10  lemma upt_conv_Nil [simp]: "j <= i ==> [i..<j] = []"
   55.11  by (subst upt_rec) simp
   55.12 @@ -2791,13 +2791,17 @@
   55.13  lemma nth_Cons': "(x # xs)!n = (if n = 0 then x else xs!(n - 1))"
   55.14  by (cases n) simp_all
   55.15  
   55.16 -lemmas take_Cons_number_of = take_Cons'[of "number_of v"] for v
   55.17 -lemmas drop_Cons_number_of = drop_Cons'[of "number_of v"] for v
   55.18 -lemmas nth_Cons_number_of = nth_Cons'[of _ _ "number_of v"] for v
   55.19 -
   55.20 -declare take_Cons_number_of [simp] 
   55.21 -        drop_Cons_number_of [simp] 
   55.22 -        nth_Cons_number_of [simp] 
   55.23 +lemma take_Cons_numeral [simp]:
   55.24 +  "take (numeral v) (x # xs) = x # take (numeral v - 1) xs"
   55.25 +by (simp add: take_Cons')
   55.26 +
   55.27 +lemma drop_Cons_numeral [simp]:
   55.28 +  "drop (numeral v) (x # xs) = drop (numeral v - 1) xs"
   55.29 +by (simp add: drop_Cons')
   55.30 +
   55.31 +lemma nth_Cons_numeral [simp]:
   55.32 +  "(x # xs) ! numeral v = xs ! (numeral v - 1)"
   55.33 +by (simp add: nth_Cons')
   55.34  
   55.35  
   55.36  subsubsection {* @{text upto}: interval-list on @{typ int} *}
   55.37 @@ -2812,7 +2816,11 @@
   55.38  
   55.39  declare upto.simps[code, simp del]
   55.40  
   55.41 -lemmas upto_rec_number_of[simp] = upto.simps[of "number_of m" "number_of n"] for m n
   55.42 +lemmas upto_rec_numeral [simp] =
   55.43 +  upto.simps[of "numeral m" "numeral n"]
   55.44 +  upto.simps[of "numeral m" "neg_numeral n"]
   55.45 +  upto.simps[of "neg_numeral m" "numeral n"]
   55.46 +  upto.simps[of "neg_numeral m" "neg_numeral n"] for m n
   55.47  
   55.48  lemma upto_empty[simp]: "j < i \<Longrightarrow> [i..j] = []"
   55.49  by(simp add: upto.simps)
    56.1 --- a/src/HOL/Matrix_LP/ComputeFloat.thy	Mon Mar 26 15:32:54 2012 +0200
    56.2 +++ b/src/HOL/Matrix_LP/ComputeFloat.thy	Mon Mar 26 15:33:28 2012 +0200
    56.3 @@ -75,8 +75,11 @@
    56.4    ultimately show ?thesis by auto
    56.5  qed
    56.6  
    56.7 -lemma real_is_int_number_of[simp]: "real_is_int ((number_of \<Colon> int \<Rightarrow> real) x)"
    56.8 -  by (auto simp: real_is_int_def intro!: exI[of _ "number_of x"])
    56.9 +lemma real_is_int_numeral[simp]: "real_is_int (numeral x)"
   56.10 +  by (auto simp: real_is_int_def intro!: exI[of _ "numeral x"])
   56.11 +
   56.12 +lemma real_is_int_neg_numeral[simp]: "real_is_int (neg_numeral x)"
   56.13 +  by (auto simp: real_is_int_def intro!: exI[of _ "neg_numeral x"])
   56.14  
   56.15  lemma int_of_real_0[simp]: "int_of_real (0::real) = (0::int)"
   56.16  by (simp add: int_of_real_def)
   56.17 @@ -87,7 +90,12 @@
   56.18    show ?thesis by (simp only: 1 int_of_real_real)
   56.19  qed
   56.20  
   56.21 -lemma int_of_real_number_of[simp]: "int_of_real (number_of b) = number_of b"
   56.22 +lemma int_of_real_numeral[simp]: "int_of_real (numeral b) = numeral b"
   56.23 +  unfolding int_of_real_def
   56.24 +  by (intro some_equality)
   56.25 +     (auto simp add: real_of_int_inject[symmetric] simp del: real_of_int_inject)
   56.26 +
   56.27 +lemma int_of_real_neg_numeral[simp]: "int_of_real (neg_numeral b) = neg_numeral b"
   56.28    unfolding int_of_real_def
   56.29    by (intro some_equality)
   56.30       (auto simp add: real_of_int_inject[symmetric] simp del: real_of_int_inject)
   56.31 @@ -101,7 +109,7 @@
   56.32  lemma abs_div_2_less: "a \<noteq> 0 \<Longrightarrow> a \<noteq> -1 \<Longrightarrow> abs((a::int) div 2) < abs a"
   56.33  by arith
   56.34  
   56.35 -lemma norm_0_1: "(0::_::number_ring) = Numeral0 & (1::_::number_ring) = Numeral1"
   56.36 +lemma norm_0_1: "(1::_::numeral) = Numeral1"
   56.37    by auto
   56.38  
   56.39  lemma add_left_zero: "0 + a = (a::'a::comm_monoid_add)"
   56.40 @@ -116,34 +124,21 @@
   56.41  lemma mult_right_one: "a * 1 = (a::'a::semiring_1)"
   56.42    by simp
   56.43  
   56.44 -lemma int_pow_0: "(a::int)^(Numeral0) = 1"
   56.45 +lemma int_pow_0: "(a::int)^0 = 1"
   56.46    by simp
   56.47  
   56.48  lemma int_pow_1: "(a::int)^(Numeral1) = a"
   56.49    by simp
   56.50  
   56.51 -lemma zero_eq_Numeral0_nring: "(0::'a::number_ring) = Numeral0"
   56.52 -  by simp
   56.53 -
   56.54 -lemma one_eq_Numeral1_nring: "(1::'a::number_ring) = Numeral1"
   56.55 -  by simp
   56.56 -
   56.57 -lemma zero_eq_Numeral0_nat: "(0::nat) = Numeral0"
   56.58 +lemma one_eq_Numeral1_nring: "(1::'a::numeral) = Numeral1"
   56.59    by simp
   56.60  
   56.61  lemma one_eq_Numeral1_nat: "(1::nat) = Numeral1"
   56.62    by simp
   56.63  
   56.64 -lemma zpower_Pls: "(z::int)^Numeral0 = Numeral1"
   56.65 +lemma zpower_Pls: "(z::int)^0 = Numeral1"
   56.66    by simp
   56.67  
   56.68 -lemma zpower_Min: "(z::int)^((-1)::nat) = Numeral1"
   56.69 -proof -
   56.70 -  have 1:"((-1)::nat) = 0"
   56.71 -    by simp
   56.72 -  show ?thesis by (simp add: 1)
   56.73 -qed
   56.74 -
   56.75  lemma fst_cong: "a=a' \<Longrightarrow> fst (a,b) = fst (a',b)"
   56.76    by simp
   56.77  
   56.78 @@ -160,70 +155,8 @@
   56.79  
   56.80  lemma not_true_eq_false: "(~ True) = False" by simp
   56.81  
   56.82 -lemmas binarith =
   56.83 -  normalize_bin_simps
   56.84 -  pred_bin_simps succ_bin_simps
   56.85 -  add_bin_simps minus_bin_simps mult_bin_simps
   56.86 -
   56.87 -lemma int_eq_number_of_eq:
   56.88 -  "(((number_of v)::int)=(number_of w)) = iszero ((number_of (v + uminus w))::int)"
   56.89 -  by (rule eq_number_of_eq)
   56.90 -
   56.91 -lemma int_iszero_number_of_Pls: "iszero (Numeral0::int)"
   56.92 -  by (simp only: iszero_number_of_Pls)
   56.93 -
   56.94 -lemma int_nonzero_number_of_Min: "~(iszero ((-1)::int))"
   56.95 -  by simp
   56.96 -
   56.97 -lemma int_iszero_number_of_Bit0: "iszero ((number_of (Int.Bit0 w))::int) = iszero ((number_of w)::int)"
   56.98 -  by simp
   56.99 -
  56.100 -lemma int_iszero_number_of_Bit1: "\<not> iszero ((number_of (Int.Bit1 w))::int)"
  56.101 -  by simp
  56.102 -
  56.103 -lemma int_less_number_of_eq_neg: "(((number_of x)::int) < number_of y) = neg ((number_of (x + (uminus y)))::int)"
  56.104 -  unfolding neg_def number_of_is_id by simp
  56.105 -
  56.106 -lemma int_not_neg_number_of_Pls: "\<not> (neg (Numeral0::int))"
  56.107 -  by simp
  56.108 -
  56.109 -lemma int_neg_number_of_Min: "neg (-1::int)"
  56.110 -  by simp
  56.111 -
  56.112 -lemma int_neg_number_of_Bit0: "neg ((number_of (Int.Bit0 w))::int) = neg ((number_of w)::int)"
  56.113 -  by simp
  56.114 -
  56.115 -lemma int_neg_number_of_Bit1: "neg ((number_of (Int.Bit1 w))::int) = neg ((number_of w)::int)"
  56.116 -  by simp
  56.117 -
  56.118 -lemma int_le_number_of_eq: "(((number_of x)::int) \<le> number_of y) = (\<not> neg ((number_of (y + (uminus x)))::int))"
  56.119 -  unfolding neg_def number_of_is_id by (simp add: not_less)
  56.120 -
  56.121 -lemmas intarithrel =
  56.122 -  int_eq_number_of_eq
  56.123 -  lift_bool[OF int_iszero_number_of_Pls] nlift_bool[OF int_nonzero_number_of_Min] int_iszero_number_of_Bit0
  56.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]
  56.125 -  int_neg_number_of_Bit0 int_neg_number_of_Bit1 int_le_number_of_eq
  56.126 -
  56.127 -lemma int_number_of_add_sym: "((number_of v)::int) + number_of w = number_of (v + w)"
  56.128 -  by simp
  56.129 -
  56.130 -lemma int_number_of_diff_sym: "((number_of v)::int) - number_of w = number_of (v + (uminus w))"
  56.131 -  by simp
  56.132 -
  56.133 -lemma int_number_of_mult_sym: "((number_of v)::int) * number_of w = number_of (v * w)"
  56.134 -  by simp
  56.135 -
  56.136 -lemma int_number_of_minus_sym: "- ((number_of v)::int) = number_of (uminus v)"
  56.137 -  by simp
  56.138 -
  56.139 -lemmas intarith = int_number_of_add_sym int_number_of_minus_sym int_number_of_diff_sym int_number_of_mult_sym
  56.140 -
  56.141 -lemmas natarith = add_nat_number_of diff_nat_number_of mult_nat_number_of eq_nat_number_of less_nat_number_of
  56.142 -
  56.143 -lemmas powerarith = nat_number_of zpower_number_of_even
  56.144 -  zpower_number_of_odd[simplified zero_eq_Numeral0_nring one_eq_Numeral1_nring]
  56.145 -  zpower_Pls zpower_Min
  56.146 +lemmas powerarith = nat_numeral zpower_numeral_even
  56.147 +  zpower_numeral_odd zpower_Pls
  56.148  
  56.149  definition float :: "(int \<times> int) \<Rightarrow> real" where
  56.150    "float = (\<lambda>(a, b). real a * 2 powr real b)"
  56.151 @@ -302,7 +235,8 @@
  56.152            float_minus float_abs zero_le_float float_pprt float_nprt pprt_lbound nprt_ubound
  56.153  
  56.154  (* for use with the compute oracle *)
  56.155 -lemmas arith = binarith intarith intarithrel natarith powerarith floatarith not_false_eq_true not_true_eq_false
  56.156 +lemmas arith = arith_simps rel_simps diff_nat_numeral nat_0
  56.157 +  nat_neg_numeral powerarith floatarith not_false_eq_true not_true_eq_false
  56.158  
  56.159  use "~~/src/HOL/Tools/float_arith.ML"
  56.160  
    57.1 --- a/src/HOL/Matrix_LP/ComputeNumeral.thy	Mon Mar 26 15:32:54 2012 +0200
    57.2 +++ b/src/HOL/Matrix_LP/ComputeNumeral.thy	Mon Mar 26 15:33:28 2012 +0200
    57.3 @@ -2,145 +2,47 @@
    57.4  imports ComputeHOL ComputeFloat
    57.5  begin
    57.6  
    57.7 -(* normalization of bit strings *)
    57.8 -lemmas bitnorm = normalize_bin_simps
    57.9 -
   57.10 -(* neg for bit strings *)
   57.11 -lemma neg1: "neg Int.Pls = False" by (simp add: Int.Pls_def)
   57.12 -lemma neg2: "neg Int.Min = True" apply (subst Int.Min_def) by auto
   57.13 -lemma neg3: "neg (Int.Bit0 x) = neg x" apply (simp add: neg_def) apply (subst Bit0_def) by auto
   57.14 -lemma neg4: "neg (Int.Bit1 x) = neg x" apply (simp add: neg_def) apply (subst Bit1_def) by auto  
   57.15 -lemmas bitneg = neg1 neg2 neg3 neg4
   57.16 -
   57.17 -(* iszero for bit strings *)
   57.18 -lemma iszero1: "iszero Int.Pls = True" by (simp add: Int.Pls_def iszero_def)
   57.19 -lemma iszero2: "iszero Int.Min = False" apply (subst Int.Min_def) apply (subst iszero_def) by simp
   57.20 -lemma iszero3: "iszero (Int.Bit0 x) = iszero x" apply (subst Int.Bit0_def) apply (subst iszero_def)+ by auto
   57.21 -lemma iszero4: "iszero (Int.Bit1 x) = False" apply (subst Int.Bit1_def) apply (subst iszero_def)+  apply simp by arith
   57.22 -lemmas bitiszero = iszero1 iszero2 iszero3 iszero4
   57.23 -
   57.24 -(* lezero for bit strings *)
   57.25 -definition "lezero x \<longleftrightarrow> x \<le> 0"
   57.26 -lemma lezero1: "lezero Int.Pls = True" unfolding Int.Pls_def lezero_def by auto
   57.27 -lemma lezero2: "lezero Int.Min = True" unfolding Int.Min_def lezero_def by auto
   57.28 -lemma lezero3: "lezero (Int.Bit0 x) = lezero x" unfolding Int.Bit0_def lezero_def by auto
   57.29 -lemma lezero4: "lezero (Int.Bit1 x) = neg x" unfolding Int.Bit1_def lezero_def neg_def by auto
   57.30 -lemmas bitlezero = lezero1 lezero2 lezero3 lezero4
   57.31 -
   57.32  (* equality for bit strings *)
   57.33 -lemmas biteq = eq_bin_simps
   57.34 +lemmas biteq = eq_num_simps
   57.35  
   57.36  (* x < y for bit strings *)
   57.37 -lemmas bitless = less_bin_simps
   57.38 +lemmas bitless = less_num_simps
   57.39  
   57.40  (* x \<le> y for bit strings *)
   57.41 -lemmas bitle = le_bin_simps
   57.42 -
   57.43 -(* succ for bit strings *)
   57.44 -lemmas bitsucc = succ_bin_simps
   57.45 -
   57.46 -(* pred for bit strings *)
   57.47 -lemmas bitpred = pred_bin_simps
   57.48 -
   57.49 -(* unary minus for bit strings *)
   57.50 -lemmas bituminus = minus_bin_simps
   57.51 +lemmas bitle = le_num_simps
   57.52  
   57.53  (* addition for bit strings *)
   57.54 -lemmas bitadd = add_bin_simps
   57.55 +lemmas bitadd = add_num_simps
   57.56  
   57.57  (* multiplication for bit strings *) 
   57.58 -lemma mult_Pls_right: "x * Int.Pls = Int.Pls" by (simp add: Pls_def)
   57.59 -lemma mult_Min_right: "x * Int.Min = - x" by (subst mult_commute) simp 
   57.60 -lemma multb0x: "(Int.Bit0 x) * y = Int.Bit0 (x * y)" by (rule mult_Bit0)
   57.61 -lemma multxb0: "x * (Int.Bit0 y) = Int.Bit0 (x * y)" unfolding Bit0_def by simp
   57.62 -lemma multb1: "(Int.Bit1 x) * (Int.Bit1 y) = Int.Bit1 (Int.Bit0 (x * y) + x + y)"
   57.63 -  unfolding Bit0_def Bit1_def by (simp add: algebra_simps)
   57.64 -lemmas bitmul = mult_Pls mult_Min mult_Pls_right mult_Min_right multb0x multxb0 multb1
   57.65 +lemmas bitmul = mult_num_simps
   57.66  
   57.67 -lemmas bitarith = bitnorm bitiszero bitneg bitlezero biteq bitless bitle bitsucc bitpred bituminus bitadd bitmul 
   57.68 -
   57.69 -definition "nat_norm_number_of (x::nat) = x"
   57.70 -
   57.71 -lemma nat_norm_number_of: "nat_norm_number_of (number_of w) = (if lezero w then 0 else number_of w)"
   57.72 -  apply (simp add: nat_norm_number_of_def)
   57.73 -  unfolding lezero_def iszero_def neg_def
   57.74 -  apply (simp add: numeral_simps)
   57.75 -  done
   57.76 +lemmas bitarith = arith_simps
   57.77  
   57.78  (* Normalization of nat literals *)
   57.79 -lemma natnorm0: "(0::nat) = number_of (Int.Pls)" by auto
   57.80 -lemma natnorm1: "(1 :: nat) = number_of (Int.Bit1 Int.Pls)"  by auto 
   57.81 -lemmas natnorm = natnorm0 natnorm1 nat_norm_number_of
   57.82 -
   57.83 -(* Suc *)
   57.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)
   57.85 -
   57.86 -(* Addition for nat *)
   57.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))))"
   57.88 -  unfolding nat_number_of_def number_of_is_id neg_def
   57.89 -  by auto
   57.90 -
   57.91 -(* Subtraction for nat *)
   57.92 -lemma natsub: "(number_of x) - ((number_of y)::nat) = 
   57.93 -  (if neg x then 0 else (if neg y then number_of x else (nat_norm_number_of (number_of (x + (- y))))))"
   57.94 -  unfolding nat_norm_number_of
   57.95 -  by (auto simp add: number_of_is_id neg_def lezero_def iszero_def Let_def nat_number_of_def)
   57.96 -
   57.97 -(* Multiplication for nat *)
   57.98 -lemma natmul: "(number_of x) * ((number_of y)::nat) = 
   57.99 -  (if neg x then 0 else (if neg y then 0 else number_of (x * y)))"
  57.100 -  unfolding nat_number_of_def number_of_is_id neg_def
  57.101 -  by (simp add: nat_mult_distrib)
  57.102 -
  57.103 -lemma nateq: "(((number_of x)::nat) = (number_of y)) = ((lezero x \<and> lezero y) \<or> (x = y))"
  57.104 -  by (auto simp add: iszero_def lezero_def neg_def number_of_is_id)
  57.105 -
  57.106 -lemma natless: "(((number_of x)::nat) < (number_of y)) = ((x < y) \<and> (\<not> (lezero y)))"
  57.107 -  by (simp add: lezero_def numeral_simps not_le)
  57.108 -
  57.109 -lemma natle: "(((number_of x)::nat) \<le> (number_of y)) = (y < x \<longrightarrow> lezero x)"
  57.110 -  by (auto simp add: number_of_is_id lezero_def nat_number_of_def)
  57.111 +lemmas natnorm = one_eq_Numeral1_nat
  57.112  
  57.113  fun natfac :: "nat \<Rightarrow> nat"
  57.114    where "natfac n = (if n = 0 then 1 else n * (natfac (n - 1)))"
  57.115  
  57.116 -lemmas compute_natarith = bitarith natnorm natsuc natadd natsub natmul nateq natless natle natfac.simps
  57.117 -
  57.118 -lemma number_eq: "(((number_of x)::'a::{number_ring, linordered_idom}) = (number_of y)) = (x = y)"
  57.119 -  unfolding number_of_eq
  57.120 -  apply simp
  57.121 -  done
  57.122 +lemmas compute_natarith =
  57.123 +  arith_simps rel_simps
  57.124 +  diff_nat_numeral nat_numeral nat_0 nat_neg_numeral
  57.125 +  numeral_1_eq_1 [symmetric]
  57.126 +  numeral_1_eq_Suc_0 [symmetric]
  57.127 +  Suc_numeral natfac.simps
  57.128  
  57.129 -lemma number_le: "(((number_of x)::'a::{number_ring, linordered_idom}) \<le>  (number_of y)) = (x \<le> y)"
  57.130 -  unfolding number_of_eq
  57.131 -  apply simp
  57.132 -  done
  57.133 -
  57.134 -lemma number_less: "(((number_of x)::'a::{number_ring, linordered_idom}) <  (number_of y)) = (x < y)"
  57.135 -  unfolding number_of_eq 
  57.136 -  apply simp
  57.137 -  done
  57.138 +lemmas number_norm = numeral_1_eq_1[symmetric]
  57.139  
  57.140 -lemma number_diff: "((number_of x)::'a::{number_ring, linordered_idom}) - number_of y = number_of (x + (- y))"
  57.141 -  apply (subst diff_number_of_eq)
  57.142 -  apply simp
  57.143 -  done
  57.144 -
  57.145 -lemmas number_norm = number_of_Pls[symmetric] numeral_1_eq_1[symmetric]
  57.146 -
  57.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
  57.148 +lemmas compute_numberarith =
  57.149 +  arith_simps rel_simps number_norm
  57.150  
  57.151 -lemma compute_real_of_nat_number_of: "real ((number_of v)::nat) = (if neg v then 0 else number_of v)"
  57.152 -  by (simp only: real_of_nat_number_of number_of_is_id)
  57.153 -
  57.154 -lemma compute_nat_of_int_number_of: "nat ((number_of v)::int) = (number_of v)"
  57.155 -  by simp
  57.156 +lemmas compute_num_conversions =
  57.157 +  real_of_nat_numeral real_of_nat_zero
  57.158 +  nat_numeral nat_0 nat_neg_numeral
  57.159 +  real_numeral real_of_int_zero
  57.160  
  57.161 -lemmas compute_num_conversions = compute_real_of_nat_number_of compute_nat_of_int_number_of real_number_of
  57.162 -
  57.163 -lemmas zpowerarith = zpower_number_of_even
  57.164 -  zpower_number_of_odd[simplified zero_eq_Numeral0_nring one_eq_Numeral1_nring]
  57.165 -  zpower_Pls zpower_Min
  57.166 +lemmas zpowerarith = zpower_numeral_even zpower_numeral_odd zpower_Pls int_pow_1
  57.167  
  57.168  (* div, mod *)
  57.169  
  57.170 @@ -162,26 +64,19 @@
  57.171  
  57.172  (* collecting all the theorems *)
  57.173  
  57.174 -lemma even_Pls: "even (Int.Pls) = True"
  57.175 -  apply (unfold Pls_def even_def)
  57.176 +lemma even_0_int: "even (0::int) = True"
  57.177    by simp
  57.178  
  57.179 -lemma even_Min: "even (Int.Min) = False"
  57.180 -  apply (unfold Min_def even_def)
  57.181 +lemma even_One_int: "even (numeral Num.One :: int) = False"
  57.182    by simp
  57.183  
  57.184 -lemma even_B0: "even (Int.Bit0 x) = True"
  57.185 -  apply (unfold Bit0_def)
  57.186 +lemma even_Bit0_int: "even (numeral (Num.Bit0 x) :: int) = True"
  57.187    by simp
  57.188  
  57.189 -lemma even_B1: "even (Int.Bit1 x) = False"
  57.190 -  apply (unfold Bit1_def)
  57.191 +lemma even_Bit1_int: "even (numeral (Num.Bit1 x) :: int) = False"
  57.192    by simp
  57.193  
  57.194 -lemma even_number_of: "even ((number_of w)::int) = even w"
  57.195 -  by (simp only: number_of_is_id)
  57.196 -
  57.197 -lemmas compute_even = even_Pls even_Min even_B0 even_B1 even_number_of
  57.198 +lemmas compute_even = even_0_int even_One_int even_Bit0_int even_Bit1_int
  57.199  
  57.200  lemmas compute_numeral = compute_if compute_let compute_pair compute_bool 
  57.201                           compute_natarith compute_numberarith max_def min_def compute_num_conversions zpowerarith compute_div_mod compute_even
    58.1 --- a/src/HOL/Matrix_LP/SparseMatrix.thy	Mon Mar 26 15:32:54 2012 +0200
    58.2 +++ b/src/HOL/Matrix_LP/SparseMatrix.thy	Mon Mar 26 15:33:28 2012 +0200
    58.3 @@ -1029,9 +1029,7 @@
    58.4    sparse_row_matrix_pprt sorted_spvec_pprt_spmat sorted_spmat_pprt_spmat
    58.5    sparse_row_matrix_nprt sorted_spvec_nprt_spmat sorted_spmat_nprt_spmat
    58.6  
    58.7 -lemma zero_eq_Numeral0: "(0::_::number_ring) = Numeral0" by simp
    58.8 -
    58.9 -lemmas sparse_row_matrix_arith_simps[simplified zero_eq_Numeral0] = 
   58.10 +lemmas sparse_row_matrix_arith_simps = 
   58.11    mult_spmat.simps mult_spvec_spmat.simps 
   58.12    addmult_spvec.simps 
   58.13    smult_spvec_empty smult_spvec_cons
    59.1 --- a/src/HOL/Metis_Examples/Big_O.thy	Mon Mar 26 15:32:54 2012 +0200
    59.2 +++ b/src/HOL/Metis_Examples/Big_O.thy	Mon Mar 26 15:33:28 2012 +0200
    59.3 @@ -16,7 +16,7 @@
    59.4  
    59.5  subsection {* Definitions *}
    59.6  
    59.7 -definition bigo :: "('a => 'b\<Colon>{linordered_idom,number_ring}) => ('a => 'b) set" ("(1O'(_'))") where
    59.8 +definition bigo :: "('a => 'b\<Colon>linordered_idom) => ('a => 'b) set" ("(1O'(_'))") where
    59.9    "O(f\<Colon>('a => 'b)) == {h. \<exists>c. \<forall>x. abs (h x) <= c * abs (f x)}"
   59.10  
   59.11  lemma bigo_pos_const:
   59.12 @@ -180,7 +180,7 @@
   59.13   apply (rule_tac x = "c + c" in exI)
   59.14   apply auto
   59.15   apply (subgoal_tac "c * abs (f xa + g xa) <= (c + c) * abs (g xa)")
   59.16 -  apply (metis order_trans semiring_mult_2)
   59.17 +  apply (metis order_trans mult_2)
   59.18   apply (subgoal_tac "c * abs (f xa + g xa) <= c * (abs (f xa) + abs (g xa))")
   59.19    apply (erule order_trans)
   59.20    apply (simp add: ring_distribs)
   59.21 @@ -325,7 +325,7 @@
   59.22  by (metis bigo_mult2 set_plus_mono_b set_times_intro2 set_times_plus_distrib)
   59.23  
   59.24  lemma bigo_mult5: "\<forall>x. f x ~= 0 \<Longrightarrow>
   59.25 -    O(f * g) <= (f\<Colon>'a => ('b\<Colon>{linordered_field,number_ring})) *o O(g)"
   59.26 +    O(f * g) <= (f\<Colon>'a => ('b\<Colon>linordered_field)) *o O(g)"
   59.27  proof -
   59.28    assume a: "\<forall>x. f x ~= 0"
   59.29    show "O(f * g) <= f *o O(g)"
   59.30 @@ -351,21 +351,21 @@
   59.31  qed
   59.32  
   59.33  lemma bigo_mult6:
   59.34 -"\<forall>x. f x \<noteq> 0 \<Longrightarrow> O(f * g) = (f\<Colon>'a \<Rightarrow> ('b\<Colon>{linordered_field,number_ring})) *o O(g)"
   59.35 +"\<forall>x. f x \<noteq> 0 \<Longrightarrow> O(f * g) = (f\<Colon>'a \<Rightarrow> ('b\<Colon>linordered_field)) *o O(g)"
   59.36  by (metis bigo_mult2 bigo_mult5 order_antisym)
   59.37  
   59.38  (*proof requires relaxing relevance: 2007-01-25*)
   59.39  declare bigo_mult6 [simp]
   59.40  
   59.41  lemma bigo_mult7:
   59.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)"
   59.43 +"\<forall>x. f x \<noteq> 0 \<Longrightarrow> O(f * g) \<le> O(f\<Colon>'a \<Rightarrow> ('b\<Colon>linordered_field)) \<otimes> O(g)"
   59.44  by (metis bigo_refl bigo_mult6 set_times_mono3)
   59.45  
   59.46  declare bigo_mult6 [simp del]
   59.47  declare bigo_mult7 [intro!]
   59.48  
   59.49  lemma bigo_mult8:
   59.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)"
   59.51 +"\<forall>x. f x \<noteq> 0 \<Longrightarrow> O(f * g) = O(f\<Colon>'a \<Rightarrow> ('b\<Colon>linordered_field)) \<otimes> O(g)"
   59.52  by (metis bigo_mult bigo_mult7 order_antisym_conv)
   59.53  
   59.54  lemma bigo_minus [intro]: "f : O(g) \<Longrightarrow> - f : O(g)"
   59.55 @@ -405,14 +405,14 @@
   59.56  lemma bigo_const2 [intro]: "O(\<lambda>x. c) \<le> O(\<lambda>x. 1)"
   59.57  by (metis bigo_const1 bigo_elt_subset)
   59.58  
   59.59 -lemma bigo_const3: "(c\<Colon>'a\<Colon>{linordered_field,number_ring}) ~= 0 \<Longrightarrow> (\<lambda>x. 1) : O(\<lambda>x. c)"
   59.60 +lemma bigo_const3: "(c\<Colon>'a\<Colon>linordered_field) ~= 0 \<Longrightarrow> (\<lambda>x. 1) : O(\<lambda>x. c)"
   59.61  apply (simp add: bigo_def)
   59.62  by (metis abs_eq_0 left_inverse order_refl)
   59.63  
   59.64 -lemma bigo_const4: "(c\<Colon>'a\<Colon>{linordered_field,number_ring}) ~= 0 \<Longrightarrow> O(\<lambda>x. 1) <= O(\<lambda>x. c)"
   59.65 +lemma bigo_const4: "(c\<Colon>'a\<Colon>linordered_field) ~= 0 \<Longrightarrow> O(\<lambda>x. 1) <= O(\<lambda>x. c)"
   59.66  by (metis bigo_elt_subset bigo_const3)
   59.67  
   59.68 -lemma bigo_const [simp]: "(c\<Colon>'a\<Colon>{linordered_field,number_ring}) ~= 0 \<Longrightarrow>
   59.69 +lemma bigo_const [simp]: "(c\<Colon>'a\<Colon>linordered_field) ~= 0 \<Longrightarrow>
   59.70      O(\<lambda>x. c) = O(\<lambda>x. 1)"
   59.71  by (metis bigo_const2 bigo_const4 equalityI)
   59.72  
   59.73 @@ -423,19 +423,19 @@
   59.74  lemma bigo_const_mult2: "O(\<lambda>x. c * f x) \<le> O(f)"
   59.75  by (rule bigo_elt_subset, rule bigo_const_mult1)
   59.76  
   59.77 -lemma bigo_const_mult3: "(c\<Colon>'a\<Colon>{linordered_field,number_ring}) ~= 0 \<Longrightarrow> f : O(\<lambda>x. c * f x)"
   59.78 +lemma bigo_const_mult3: "(c\<Colon>'a\<Colon>linordered_field) ~= 0 \<Longrightarrow> f : O(\<lambda>x. c * f x)"
   59.79  apply (simp add: bigo_def)
   59.80  by (metis (no_types) abs_mult mult_assoc mult_1 order_refl left_inverse)
   59.81  
   59.82  lemma bigo_const_mult4:
   59.83 -"(c\<Colon>'a\<Colon>{linordered_field,number_ring}) \<noteq> 0 \<Longrightarrow> O(f) \<le> O(\<lambda>x. c * f x)"
   59.84 +"(c\<Colon>'a\<Colon>linordered_field) \<noteq> 0 \<Longrightarrow> O(f) \<le> O(\<lambda>x. c * f x)"
   59.85  by (metis bigo_elt_subset bigo_const_mult3)
   59.86  
   59.87 -lemma bigo_const_mult [simp]: "(c\<Colon>'a\<Colon>{linordered_field,number_ring}) ~= 0 \<Longrightarrow>
   59.88 +lemma bigo_const_mult [simp]: "(c\<Colon>'a\<Colon>linordered_field) ~= 0 \<Longrightarrow>
   59.89      O(\<lambda>x. c * f x) = O(f)"
   59.90  by (metis equalityI bigo_const_mult2 bigo_const_mult4)
   59.91  
   59.92 -lemma bigo_const_mult5 [simp]: "(c\<Colon>'a\<Colon>{linordered_field,number_ring}) ~= 0 \<Longrightarrow>
   59.93 +lemma bigo_const_mult5 [simp]: "(c\<Colon>'a\<Colon>linordered_field) ~= 0 \<Longrightarrow>
   59.94      (\<lambda>x. c) *o O(f) = O(f)"
   59.95    apply (auto del: subsetI)
   59.96    apply (rule order_trans)
   59.97 @@ -587,7 +587,7 @@
   59.98    apply assumption+
   59.99  done
  59.100  
  59.101 -lemma bigo_useful_const_mult: "(c\<Colon>'a\<Colon>{linordered_field,number_ring}) ~= 0 \<Longrightarrow>
  59.102 +lemma bigo_useful_const_mult: "(c\<Colon>'a\<Colon>linordered_field) ~= 0 \<Longrightarrow>
  59.103      (\<lambda>x. c) * f =o O(h) \<Longrightarrow> f =o O(h)"
  59.104    apply (rule subsetD)
  59.105    apply (subgoal_tac "(\<lambda>x. 1 / c) *o O(h) <= O(h)")
  59.106 @@ -696,7 +696,7 @@
  59.107  by (metis abs_ge_zero linorder_linear min_max.sup_absorb1 min_max.sup_commute)
  59.108  
  59.109  lemma bigo_lesso4:
  59.110 -  "f <o g =o O(k\<Colon>'a=>'b\<Colon>{linordered_field,number_ring}) \<Longrightarrow>
  59.111 +  "f <o g =o O(k\<Colon>'a=>'b\<Colon>{linordered_field}) \<Longrightarrow>
  59.112     g =o h +o O(k) \<Longrightarrow> f <o h =o O(k)"
  59.113  apply (unfold lesso_def)
  59.114  apply (drule set_plus_imp_minus)
    60.1 --- a/src/HOL/Multivariate_Analysis/Cartesian_Euclidean_Space.thy	Mon Mar 26 15:32:54 2012 +0200
    60.2 +++ b/src/HOL/Multivariate_Analysis/Cartesian_Euclidean_Space.thy	Mon Mar 26 15:33:28 2012 +0200
    60.3 @@ -207,6 +207,15 @@
    60.4      by (auto intro!: injI simp add: vec_eq_iff of_nat_index)
    60.5  qed
    60.6  
    60.7 +instance vec :: (numeral, finite) numeral ..
    60.8 +instance vec :: (semiring_numeral, finite) semiring_numeral ..
    60.9 +
   60.10 +lemma numeral_index [simp]: "numeral w $ i = numeral w"
   60.11 +  by (induct w, simp_all only: numeral.simps vector_add_component one_index)
   60.12 +
   60.13 +lemma neg_numeral_index [simp]: "neg_numeral w $ i = neg_numeral w"
   60.14 +  by (simp only: neg_numeral_def vector_uminus_component numeral_index)
   60.15 +
   60.16  instance vec :: (comm_ring_1, finite) comm_ring_1 ..
   60.17  instance vec :: (ring_char_0, finite) ring_char_0 ..
   60.18  
   60.19 @@ -222,7 +231,7 @@
   60.20    by (vector field_simps)
   60.21  lemma vector_smult_rneg: "(c::'a::ring) *s -x = -(c *s x)" by vector
   60.22  lemma vector_smult_lneg: "- (c::'a::ring) *s x = -(c *s x)" by vector
   60.23 -lemma vector_sneg_minus1: "-x = (- (1::'a::ring_1)) *s x" by vector
   60.24 +lemma vector_sneg_minus1: "-x = (-1::'a::ring_1) *s x" by vector
   60.25  lemma vector_smult_rzero[simp]: "c *s 0 = (0::'a::mult_zero ^ 'n)" by vector
   60.26  lemma vector_sub_rdistrib: "((a::'a::ring) - b) *s x = a *s x - b *s x"
   60.27    by (vector field_simps)
    61.1 --- a/src/HOL/Multivariate_Analysis/Convex_Euclidean_Space.thy	Mon Mar 26 15:32:54 2012 +0200
    61.2 +++ b/src/HOL/Multivariate_Analysis/Convex_Euclidean_Space.thy	Mon Mar 26 15:33:28 2012 +0200
    61.3 @@ -281,7 +281,7 @@
    61.4  lemma scaleR_2:
    61.5    fixes x :: "'a::real_vector"
    61.6    shows "scaleR 2 x = x + x"
    61.7 -unfolding one_add_one_is_two [symmetric] scaleR_left_distrib by simp
    61.8 +unfolding one_add_one [symmetric] scaleR_left_distrib by simp
    61.9  
   61.10  lemma vector_choose_size: "0 <= c ==> \<exists>(x::'a::euclidean_space). norm x = c"
   61.11    apply (rule exI[where x="c *\<^sub>R basis 0 ::'a"]) using DIM_positive[where 'a='a] by auto
    62.1 --- a/src/HOL/Multivariate_Analysis/Determinants.thy	Mon Mar 26 15:32:54 2012 +0200
    62.2 +++ b/src/HOL/Multivariate_Analysis/Determinants.thy	Mon Mar 26 15:33:28 2012 +0200
    62.3 @@ -286,7 +286,7 @@
    62.4  proof-
    62.5    have tha: "\<And>(a::'a) b. a = b ==> b = - a ==> a = 0"
    62.6      by simp
    62.7 -  have th1: "of_int (-1) = - 1" by (metis of_int_1 of_int_minus number_of_Min)
    62.8 +  have th1: "of_int (-1) = - 1" by simp
    62.9    let ?p = "Fun.swap i j id"
   62.10    let ?A = "\<chi> i. A $ ?p i"
   62.11    from r have "A = ?A" by (simp add: vec_eq_iff row_def swap_def)
   62.12 @@ -1058,8 +1058,7 @@
   62.13    unfolding det_def UNIV_2
   62.14    unfolding setsum_over_permutations_insert[OF f12]
   62.15    unfolding permutes_sing
   62.16 -  apply (simp add: sign_swap_id sign_id swap_id_eq)
   62.17 -  by (simp add: arith_simps(31)[symmetric] del: arith_simps(31))
   62.18 +  by (simp add: sign_swap_id sign_id swap_id_eq)
   62.19  qed
   62.20  
   62.21  lemma det_3: "det (A::'a::comm_ring_1^3^3) =
   62.22 @@ -1079,9 +1078,7 @@
   62.23    unfolding setsum_over_permutations_insert[OF f23]
   62.24  
   62.25    unfolding permutes_sing
   62.26 -  apply (simp add: sign_swap_id permutation_swap_id sign_compose sign_id swap_id_eq)
   62.27 -  apply (simp add: arith_simps(31)[symmetric] del: arith_simps(31))
   62.28 -  by (simp add: field_simps)
   62.29 +  by (simp add: sign_swap_id permutation_swap_id sign_compose sign_id swap_id_eq)
   62.30  qed
   62.31  
   62.32  end
    63.1 --- a/src/HOL/Multivariate_Analysis/Norm_Arith.thy	Mon Mar 26 15:32:54 2012 +0200
    63.2 +++ b/src/HOL/Multivariate_Analysis/Norm_Arith.thy	Mon Mar 26 15:33:28 2012 +0200
    63.3 @@ -104,6 +104,17 @@
    63.4    "x \<noteq> y \<longleftrightarrow> \<not> (norm (x - y) \<le> 0)"
    63.5    using norm_ge_zero[of "x - y"] by auto
    63.6  
    63.7 +lemmas arithmetic_simps =
    63.8 +  arith_simps
    63.9 +  add_numeral_special
   63.10 +  add_neg_numeral_special
   63.11 +  add_0_left
   63.12 +  add_0_right
   63.13 +  mult_zero_left
   63.14 +  mult_zero_right
   63.15 +  mult_1_left
   63.16 +  mult_1_right
   63.17 +
   63.18  use "normarith.ML"
   63.19  
   63.20  method_setup norm = {* Scan.succeed (SIMPLE_METHOD' o NormArith.norm_arith_tac)
    64.1 --- a/src/HOL/Multivariate_Analysis/Topology_Euclidean_Space.thy	Mon Mar 26 15:32:54 2012 +0200
    64.2 +++ b/src/HOL/Multivariate_Analysis/Topology_Euclidean_Space.thy	Mon Mar 26 15:33:28 2012 +0200
    64.3 @@ -5786,7 +5786,7 @@
    64.4      { assume as:"dist a b > dist (f n x) (f n y)"
    64.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"
    64.6          and "\<forall>m\<ge>Nb. dist (f (r m) y) b < (dist a b - dist (f n x) (f n y)) / 2"
    64.7 -        using lima limb unfolding h_def LIMSEQ_def by (fastforce simp del: less_divide_eq_number_of1)
    64.8 +        using lima limb unfolding h_def LIMSEQ_def by (fastforce simp del: less_divide_eq_numeral1)
    64.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)"
   64.10          apply(erule_tac x="Na+Nb+n" in allE)
   64.11          apply(erule_tac x="Na+Nb+n" in allE) apply simp
    65.1 --- a/src/HOL/Mutabelle/mutabelle_extra.ML	Mon Mar 26 15:32:54 2012 +0200
    65.2 +++ b/src/HOL/Mutabelle/mutabelle_extra.ML	Mon Mar 26 15:33:28 2012 +0200
    65.3 @@ -271,7 +271,7 @@
    65.4   @{const_name enum_prod_inst.enum_ex_prod},
    65.5   @{const_name Quickcheck.catch_match},
    65.6   @{const_name Quickcheck_Exhaustive.unknown},
    65.7 - @{const_name Int.Bit0}, @{const_name Int.Bit1}
    65.8 + @{const_name Num.Bit0}, @{const_name Num.Bit1}
    65.9   (*@{const_name "==>"}, @{const_name "=="}*)]
   65.10  
   65.11  val forbidden_mutant_consts =
    66.1 --- a/src/HOL/NSA/HyperDef.thy	Mon Mar 26 15:32:54 2012 +0200
    66.2 +++ b/src/HOL/NSA/HyperDef.thy	Mon Mar 26 15:33:28 2012 +0200
    66.3 @@ -346,8 +346,8 @@
    66.4    K (Lin_Arith.add_inj_thms [@{thm star_of_le} RS iffD2,
    66.5      @{thm star_of_less} RS iffD2, @{thm star_of_eq} RS iffD2]
    66.6    #> Lin_Arith.add_simps [@{thm star_of_zero}, @{thm star_of_one},
    66.7 -      @{thm star_of_number_of}, @{thm star_of_add}, @{thm star_of_minus},
    66.8 -      @{thm star_of_diff}, @{thm star_of_mult}]
    66.9 +      @{thm star_of_numeral}, @{thm star_of_neg_numeral}, @{thm star_of_add},
   66.10 +      @{thm star_of_minus}, @{thm star_of_diff}, @{thm star_of_mult}]
   66.11    #> Lin_Arith.add_inj_const (@{const_name "StarDef.star_of"}, @{typ "real \<Rightarrow> hypreal"}))
   66.12  *}
   66.13  
   66.14 @@ -419,10 +419,15 @@
   66.15        x ^ Suc (Suc 0) + y ^ Suc (Suc 0) + (hypreal_of_nat (Suc (Suc 0)))*x*y"
   66.16  by (simp add: right_distrib left_distrib)
   66.17  
   66.18 -lemma power_hypreal_of_real_number_of:
   66.19 -     "(number_of v :: hypreal) ^ n = hypreal_of_real ((number_of v) ^ n)"
   66.20 +lemma power_hypreal_of_real_numeral:
   66.21 +     "(numeral v :: hypreal) ^ n = hypreal_of_real ((numeral v) ^ n)"
   66.22  by simp
   66.23 -declare power_hypreal_of_real_number_of [of _ "number_of w", simp] for w
   66.24 +declare power_hypreal_of_real_numeral [of _ "numeral w", simp] for w
   66.25 +
   66.26 +lemma power_hypreal_of_real_neg_numeral:
   66.27 +     "(neg_numeral v :: hypreal) ^ n = hypreal_of_real ((neg_numeral v) ^ n)"
   66.28 +by simp
   66.29 +declare power_hypreal_of_real_neg_numeral [of _ "numeral w", simp] for w
   66.30  (*
   66.31  lemma hrealpow_HFinite:
   66.32    fixes x :: "'a::{real_normed_algebra,power} star"
   66.33 @@ -492,7 +497,7 @@
   66.34  by transfer (rule power_one)
   66.35  
   66.36  lemma hrabs_hyperpow_minus_one [simp]:
   66.37 -  "\<And>n. abs(-1 pow n) = (1::'a::{number_ring,linordered_idom} star)"
   66.38 +  "\<And>n. abs(-1 pow n) = (1::'a::{linordered_idom} star)"
   66.39  by transfer (rule abs_power_minus_one)
   66.40  
   66.41  lemma hyperpow_mult:
    67.1 --- a/src/HOL/NSA/NSA.thy	Mon Mar 26 15:32:54 2012 +0200
    67.2 +++ b/src/HOL/NSA/NSA.thy	Mon Mar 26 15:33:28 2012 +0200
    67.3 @@ -190,7 +190,7 @@
    67.4  lemma SReal_hypreal_of_real [simp]: "hypreal_of_real x \<in> Reals"
    67.5  by (simp add: Reals_eq_Standard)
    67.6  
    67.7 -lemma SReal_divide_number_of: "r \<in> Reals ==> r/(number_of w::hypreal) \<in> Reals"
    67.8 +lemma SReal_divide_numeral: "r \<in> Reals ==> r/(numeral w::hypreal) \<in> Reals"
    67.9  by simp
   67.10  
   67.11  text{*epsilon is not in Reals because it is an infinitesimal*}
   67.12 @@ -290,8 +290,8 @@
   67.13    "(hnorm (x::hypreal) \<in> HFinite) = (x \<in> HFinite)"
   67.14  by (simp add: HFinite_def)
   67.15  
   67.16 -lemma HFinite_number_of [simp]: "number_of w \<in> HFinite"
   67.17 -unfolding star_number_def by (rule HFinite_star_of)
   67.18 +lemma HFinite_numeral [simp]: "numeral w \<in> HFinite"
   67.19 +unfolding star_numeral_def by (rule HFinite_star_of)
   67.20  
   67.21  (** As always with numerals, 0 and 1 are special cases **)
   67.22  
   67.23 @@ -347,7 +347,7 @@
   67.24  apply (rule InfinitesimalI)
   67.25  apply (rule hypreal_sum_of_halves [THEN subst])
   67.26  apply (drule half_gt_zero)
   67.27 -apply (blast intro: hnorm_add_less SReal_divide_number_of dest: InfinitesimalD)
   67.28 +apply (blast intro: hnorm_add_less SReal_divide_numeral dest: InfinitesimalD)
   67.29  done
   67.30  
   67.31  lemma Infinitesimal_minus_iff [simp]: "(-x:Infinitesimal) = (x:Infinitesimal)"
   67.32 @@ -652,7 +652,7 @@
   67.33  (*reorientation simplification procedure: reorients (polymorphic)
   67.34    0 = x, 1 = x, nnn = x provided x isn't 0, 1 or a numeral.*)
   67.35  simproc_setup approx_reorient_simproc
   67.36 -  ("0 @= x" | "1 @= y" | "number_of w @= z") =
   67.37 +  ("0 @= x" | "1 @= y" | "numeral w @= z" | "neg_numeral w @= r") =
   67.38  {*
   67.39    let val rule = @{thm approx_reorient} RS eq_reflection
   67.40        fun proc phi ss ct = case term_of ct of
   67.41 @@ -957,9 +957,9 @@
   67.42       "x \<noteq> 0 ==> star_of x \<in> HFinite - Infinitesimal"
   67.43  by simp
   67.44  
   67.45 -lemma number_of_not_Infinitesimal [simp]:
   67.46 -     "number_of w \<noteq> (0::hypreal) ==> (number_of w :: hypreal) \<notin> Infinitesimal"
   67.47 -by (fast dest: Reals_number_of [THEN SReal_Infinitesimal_zero])
   67.48 +lemma numeral_not_Infinitesimal [simp]:
   67.49 +     "numeral w \<noteq> (0::hypreal) ==> (numeral w :: hypreal) \<notin> Infinitesimal"
   67.50 +by (fast dest: Reals_numeral [THEN SReal_Infinitesimal_zero])
   67.51  
   67.52  (*again: 1 is a special case, but not 0 this time*)
   67.53  lemma one_not_Infinitesimal [simp]:
   67.54 @@ -1024,31 +1024,31 @@
   67.55  apply simp
   67.56  done
   67.57  
   67.58 -lemma number_of_approx_iff [simp]:
   67.59 -     "(number_of v @= (number_of w :: 'a::{number,real_normed_vector} star)) =
   67.60 -      (number_of v = (number_of w :: 'a))"
   67.61 -apply (unfold star_number_def)
   67.62 +lemma numeral_approx_iff [simp]:
   67.63 +     "(numeral v @= (numeral w :: 'a::{numeral,real_normed_vector} star)) =
   67.64 +      (numeral v = (numeral w :: 'a))"
   67.65 +apply (unfold star_numeral_def)
   67.66  apply (rule star_of_approx_iff)
   67.67  done
   67.68  
   67.69  (*And also for 0 @= #nn and 1 @= #nn, #nn @= 0 and #nn @= 1.*)
   67.70  lemma [simp]:
   67.71 -  "(number_of w @= (0::'a::{number,real_normed_vector} star)) =
   67.72 -   (number_of w = (0::'a))"
   67.73 -  "((0::'a::{number,real_normed_vector} star) @= number_of w) =
   67.74 -   (number_of w = (0::'a))"
   67.75 -  "(number_of w @= (1::'b::{number,one,real_normed_vector} star)) =
   67.76 -   (number_of w = (1::'b))"
   67.77 -  "((1::'b::{number,one,real_normed_vector} star) @= number_of w) =
   67.78 -   (number_of w = (1::'b))"
   67.79 +  "(numeral w @= (0::'a::{numeral,real_normed_vector} star)) =
   67.80 +   (numeral w = (0::'a))"
   67.81 +  "((0::'a::{numeral,real_normed_vector} star) @= numeral w) =
   67.82 +   (numeral w = (0::'a))"
   67.83 +  "(numeral w @= (1::'b::{numeral,one,real_normed_vector} star)) =
   67.84 +   (numeral w = (1::'b))"
   67.85 +  "((1::'b::{numeral,one,real_normed_vector} star) @= numeral w) =
   67.86 +   (numeral w = (1::'b))"
   67.87    "~ (0 @= (1::'c::{zero_neq_one,real_normed_vector} star))"
   67.88    "~ (1 @= (0::'c::{zero_neq_one,real_normed_vector} star))"
   67.89 -apply (unfold star_number_def star_zero_def star_one_def)
   67.90 +apply (unfold star_numeral_def star_zero_def star_one_def)
   67.91  apply (unfold star_of_approx_iff)
   67.92  by (auto intro: sym)
   67.93  
   67.94 -lemma star_of_approx_number_of_iff [simp]:
   67.95 -     "(star_of k @= number_of w) = (k = number_of w)"
   67.96 +lemma star_of_approx_numeral_iff [simp]:
   67.97 +     "(star_of k @= numeral w) = (k = numeral w)"
   67.98  by (subst star_of_approx_iff [symmetric], auto)
   67.99  
  67.100  lemma star_of_approx_zero_iff [simp]: "(star_of k @= 0) = (k = 0)"
  67.101 @@ -1843,8 +1843,11 @@
  67.102  lemma st_add: "\<lbrakk>x \<in> HFinite; y \<in> HFinite\<rbrakk> \<Longrightarrow> st (x + y) = st x + st y"
  67.103  by (simp add: st_unique st_SReal st_approx_self approx_add)
  67.104  
  67.105 -lemma st_number_of [simp]: "st (number_of w) = number_of w"
  67.106 -by (rule Reals_number_of [THEN st_SReal_eq])
  67.107 +lemma st_numeral [simp]: "st (numeral w) = numeral w"
  67.108 +by (rule Reals_numeral [THEN st_SReal_eq])
  67.109 +
  67.110 +lemma st_neg_numeral [simp]: "st (neg_numeral w) = neg_numeral w"
  67.111 +by (rule Reals_neg_numeral [THEN st_SReal_eq])
  67.112  
  67.113  lemma st_0 [simp]: "st 0 = 0"
  67.114  by (simp add: st_SReal_eq)
    68.1 --- a/src/HOL/NSA/NSCA.thy	Mon Mar 26 15:32:54 2012 +0200
    68.2 +++ b/src/HOL/NSA/NSCA.thy	Mon Mar 26 15:33:28 2012 +0200
    68.3 @@ -32,14 +32,14 @@
    68.4       "hcmod (hcomplex_of_complex r) \<in> Reals"
    68.5  by (simp add: Reals_eq_Standard)
    68.6  
    68.7 -lemma SReal_hcmod_number_of [simp]: "hcmod (number_of w ::hcomplex) \<in> Reals"
    68.8 +lemma SReal_hcmod_numeral [simp]: "hcmod (numeral w ::hcomplex) \<in> Reals"
    68.9  by (simp add: Reals_eq_Standard)
   68.10  
   68.11  lemma SReal_hcmod_SComplex: "x \<in> SComplex ==> hcmod x \<in> Reals"
   68.12  by (simp add: Reals_eq_Standard)
   68.13  
   68.14 -lemma SComplex_divide_number_of:
   68.15 -     "r \<in> SComplex ==> r/(number_of w::hcomplex) \<in> SComplex"
   68.16 +lemma SComplex_divide_numeral:
   68.17 +     "r \<in> SComplex ==> r/(numeral w::hcomplex) \<in> SComplex"
   68.18  by simp
   68.19  
   68.20  lemma SComplex_UNIV_complex:
   68.21 @@ -211,9 +211,9 @@
   68.22        ==> hcomplex_of_complex x \<in> HFinite - Infinitesimal"
   68.23  by (rule SComplex_HFinite_diff_Infinitesimal, auto)
   68.24  
   68.25 -lemma number_of_not_Infinitesimal [simp]:
   68.26 -     "number_of w \<noteq> (0::hcomplex) ==> (number_of w::hcomplex) \<notin> Infinitesimal"
   68.27 -by (fast dest: Standard_number_of [THEN SComplex_Infinitesimal_zero])
   68.28 +lemma numeral_not_Infinitesimal [simp]:
   68.29 +     "numeral w \<noteq> (0::hcomplex) ==> (numeral w::hcomplex) \<notin> Infinitesimal"
   68.30 +by (fast dest: Standard_numeral [THEN SComplex_Infinitesimal_zero])
   68.31  
   68.32  lemma approx_SComplex_not_zero:
   68.33       "[| y \<in> SComplex; x @= y; y\<noteq> 0 |] ==> x \<noteq> 0"
   68.34 @@ -223,11 +223,11 @@
   68.35       "[|x \<in> SComplex; y \<in> SComplex|] ==> (x @= y) = (x = y)"
   68.36  by (auto simp add: Standard_def)
   68.37  
   68.38 -lemma number_of_Infinitesimal_iff [simp]:
   68.39 -     "((number_of w :: hcomplex) \<in> Infinitesimal) =
   68.40 -      (number_of w = (0::hcomplex))"
   68.41 +lemma numeral_Infinitesimal_iff [simp]:
   68.42 +     "((numeral w :: hcomplex) \<in> Infinitesimal) =
   68.43 +      (numeral w = (0::hcomplex))"
   68.44  apply (rule iffI)
   68.45 -apply (fast dest: Standard_number_of [THEN SComplex_Infinitesimal_zero])
   68.46 +apply (fast dest: Standard_numeral [THEN SComplex_Infinitesimal_zero])
   68.47  apply (simp (no_asm_simp))
   68.48  done
   68.49  
   68.50 @@ -441,8 +441,8 @@
   68.51       "[| x \<in> HFinite; y \<in> HFinite |] ==> stc (x + y) = stc(x) + stc(y)"
   68.52  by (simp add: stc_unique stc_SComplex stc_approx_self approx_add)
   68.53  
   68.54 -lemma stc_number_of [simp]: "stc (number_of w) = number_of w"
   68.55 -by (rule Standard_number_of [THEN stc_SComplex_eq])
   68.56 +lemma stc_numeral [simp]: "stc (numeral w) = numeral w"
   68.57 +by (rule Standard_numeral [THEN stc_SComplex_eq])
   68.58  
   68.59  lemma stc_zero [simp]: "stc 0 = 0"
   68.60  by simp
    69.1 --- a/src/HOL/NSA/NSComplex.thy	Mon Mar 26 15:32:54 2012 +0200
    69.2 +++ b/src/HOL/NSA/NSComplex.thy	Mon Mar 26 15:33:28 2012 +0200
    69.3 @@ -626,32 +626,38 @@
    69.4  
    69.5  subsection{*Numerals and Arithmetic*}
    69.6  
    69.7 -lemma hcomplex_number_of_def: "(number_of w :: hcomplex) == of_int w"
    69.8 -by transfer (rule number_of_eq [THEN eq_reflection])
    69.9 -
   69.10  lemma hcomplex_of_hypreal_eq_hcomplex_of_complex: 
   69.11       "hcomplex_of_hypreal (hypreal_of_real x) =  
   69.12        hcomplex_of_complex (complex_of_real x)"
   69.13  by transfer (rule refl)
   69.14  
   69.15 -lemma hcomplex_hypreal_number_of: 
   69.16 -  "hcomplex_of_complex (number_of w) = hcomplex_of_hypreal(number_of w)"
   69.17 -by transfer (rule of_real_number_of_eq [symmetric])
   69.18 +lemma hcomplex_hypreal_numeral:
   69.19 +  "hcomplex_of_complex (numeral w) = hcomplex_of_hypreal(numeral w)"
   69.20 +by transfer (rule of_real_numeral [symmetric])
   69.21  
   69.22 -lemma hcomplex_number_of_hcnj [simp]:
   69.23 -     "hcnj (number_of v :: hcomplex) = number_of v"
   69.24 -by transfer (rule complex_cnj_number_of)
   69.25 +lemma hcomplex_hypreal_neg_numeral:
   69.26 +  "hcomplex_of_complex (neg_numeral w) = hcomplex_of_hypreal(neg_numeral w)"
   69.27 +by transfer (rule of_real_neg_numeral [symmetric])
   69.28 +
   69.29 +lemma hcomplex_numeral_hcnj [simp]:
   69.30 +     "hcnj (numeral v :: hcomplex) = numeral v"
   69.31 +by transfer (rule complex_cnj_numeral)
   69.32  
   69.33 -lemma hcomplex_number_of_hcmod [simp]: 
   69.34 -      "hcmod(number_of v :: hcomplex) = abs (number_of v :: hypreal)"
   69.35 -by transfer (rule norm_number_of)
   69.36 +lemma hcomplex_numeral_hcmod [simp]:
   69.37 +      "hcmod(numeral v :: hcomplex) = (numeral v :: hypreal)"
   69.38 +by transfer (rule norm_numeral)
   69.39 +
   69.40 +lemma hcomplex_neg_numeral_hcmod [simp]: 
   69.41 +      "hcmod(neg_numeral v :: hcomplex) = (numeral v :: hypreal)"
   69.42 +by transfer (rule norm_neg_numeral)
   69.43  
   69.44 -lemma hcomplex_number_of_hRe [simp]: 
   69.45 -      "hRe(number_of v :: hcomplex) = number_of v"
   69.46 -by transfer (rule complex_Re_number_of)
   69.47 +lemma hcomplex_numeral_hRe [simp]: 
   69.48 +      "hRe(numeral v :: hcomplex) = numeral v"
   69.49 +by transfer (rule complex_Re_numeral)
   69.50  
   69.51 -lemma hcomplex_number_of_hIm [simp]: 
   69.52 -      "hIm(number_of v :: hcomplex) = 0"
   69.53 -by transfer (rule complex_Im_number_of)
   69.54 +lemma hcomplex_numeral_hIm [simp]: 
   69.55 +      "hIm(numeral v :: hcomplex) = 0"
   69.56 +by transfer (rule complex_Im_numeral)
   69.57  
   69.58 +(* TODO: add neg_numeral rules above *)
   69.59  end
    70.1 --- a/src/HOL/NSA/StarDef.thy	Mon Mar 26 15:32:54 2012 +0200
    70.2 +++ b/src/HOL/NSA/StarDef.thy	Mon Mar 26 15:33:28 2012 +0200
    70.3 @@ -522,16 +522,6 @@
    70.4  
    70.5  end
    70.6  
    70.7 -instantiation star :: (number) number
    70.8 -begin
    70.9 -
   70.10 -definition
   70.11 -  star_number_def:  "number_of b \<equiv> star_of (number_of b)"
   70.12 -
   70.13 -instance ..
   70.14 -
   70.15 -end
   70.16 -
   70.17  instance star :: (Rings.dvd) Rings.dvd ..
   70.18  
   70.19  instantiation star :: (Divides.div) Divides.div
   70.20 @@ -561,7 +551,7 @@
   70.21  end
   70.22  
   70.23  lemmas star_class_defs [transfer_unfold] =
   70.24 -  star_zero_def     star_one_def      star_number_def
   70.25 +  star_zero_def     star_one_def
   70.26    star_add_def      star_diff_def     star_minus_def
   70.27    star_mult_def     star_divide_def   star_inverse_def
   70.28    star_le_def       star_less_def     star_abs_def       star_sgn_def
   70.29 @@ -575,9 +565,6 @@
   70.30  lemma Standard_one: "1 \<in> Standard"
   70.31  by (simp add: star_one_def)
   70.32  
   70.33 -lemma Standard_number_of: "number_of b \<in> Standard"
   70.34 -by (simp add: star_number_def)
   70.35 -
   70.36  lemma Standard_add: "\<lbrakk>x \<in> Standard; y \<in> Standard\<rbrakk> \<Longrightarrow> x + y \<in> Standard"
   70.37  by (simp add: star_add_def)
   70.38  
   70.39 @@ -606,7 +593,7 @@
   70.40  by (simp add: star_mod_def)
   70.41  
   70.42  lemmas Standard_simps [simp] =
   70.43 -  Standard_zero  Standard_one  Standard_number_of
   70.44 +  Standard_zero  Standard_one
   70.45    Standard_add  Standard_diff  Standard_minus
   70.46    Standard_mult  Standard_divide  Standard_inverse
   70.47    Standard_abs  Standard_div  Standard_mod
   70.48 @@ -648,9 +635,6 @@
   70.49  lemma star_of_one: "star_of 1 = 1"
   70.50  by transfer (rule refl)
   70.51  
   70.52 -lemma star_of_number_of: "star_of (number_of x) = number_of x"
   70.53 -by transfer (rule refl)
   70.54 -
   70.55  text {* @{term star_of} preserves orderings *}
   70.56  
   70.57  lemma star_of_less: "(star_of x < star_of y) = (x < y)"
   70.58 @@ -682,34 +666,16 @@
   70.59  lemmas star_of_le_1   = star_of_le   [of _ 1, simplified star_of_one]
   70.60  lemmas star_of_eq_1   = star_of_eq   [of _ 1, simplified star_of_one]
   70.61  
   70.62 -text{*As above, for numerals*}
   70.63 -
   70.64 -lemmas star_of_number_less =
   70.65 -  star_of_less [of "number_of w", simplified star_of_number_of] for w
   70.66 -lemmas star_of_number_le   =
   70.67 -  star_of_le   [of "number_of w", simplified star_of_number_of] for w
   70.68 -lemmas star_of_number_eq   =
   70.69 -  star_of_eq   [of "number_of w", simplified star_of_number_of] for w
   70.70 -
   70.71 -lemmas star_of_less_number =
   70.72 -  star_of_less [of _ "number_of w", simplified star_of_number_of] for w
   70.73 -lemmas star_of_le_number   =
   70.74 -  star_of_le   [of _ "number_of w", simplified star_of_number_of] for w
   70.75 -lemmas star_of_eq_number   =
   70.76 -  star_of_eq   [of _ "number_of w", simplified star_of_number_of] for w
   70.77 -
   70.78  lemmas star_of_simps [simp] =
   70.79    star_of_add     star_of_diff    star_of_minus
   70.80    star_of_mult    star_of_divide  star_of_inverse
   70.81    star_of_div     star_of_mod     star_of_abs
   70.82 -  star_of_zero    star_of_one     star_of_number_of
   70.83 +  star_of_zero    star_of_one
   70.84    star_of_less    star_of_le      star_of_eq
   70.85    star_of_0_less  star_of_0_le    star_of_0_eq
   70.86    star_of_less_0  star_of_le_0    star_of_eq_0
   70.87    star_of_1_less  star_of_1_le    star_of_1_eq
   70.88    star_of_less_1  star_of_le_1    star_of_eq_1
   70.89 -  star_of_number_less star_of_number_le star_of_number_eq
   70.90 -  star_of_less_number star_of_le_number star_of_eq_number
   70.91  
   70.92  subsection {* Ordering and lattice classes *}
   70.93  
   70.94 @@ -984,9 +950,45 @@
   70.95  
   70.96  subsection {* Number classes *}
   70.97  
   70.98 +instance star :: (numeral) numeral ..
   70.99 +
  70.100 +lemma star_numeral_def [transfer_unfold]:
  70.101 +  "numeral k = star_of (numeral k)"
  70.102 +by (induct k, simp_all only: numeral.simps star_of_one star_of_add)
  70.103 +
  70.104 +lemma Standard_numeral [simp]: "numeral k \<in> Standard"
  70.105 +by (simp add: star_numeral_def)
  70.106 +
  70.107 +lemma star_of_numeral [simp]: "star_of (numeral k) = numeral k"
  70.108 +by transfer (rule refl)
  70.109 +
  70.110 +lemma star_neg_numeral_def [transfer_unfold]:
  70.111 +  "neg_numeral k = star_of (neg_numeral k)"
  70.112 +by (simp only: neg_numeral_def star_of_minus star_of_numeral)
  70.113 +
  70.114 +lemma Standard_neg_numeral [simp]: "neg_numeral k \<in> Standard"
  70.115 +by (simp add: star_neg_numeral_def)
  70.116 +
  70.117 +lemma star_of_neg_numeral [simp]: "star_of (neg_numeral k) = neg_numeral k"
  70.118 +by transfer (rule refl)
  70.119 +
  70.120  lemma star_of_nat_def [transfer_unfold]: "of_nat n = star_of (of_nat n)"
  70.121  by (induct n, simp_all)
  70.122  
  70.123 +lemmas star_of_compare_numeral [simp] =
  70.124 +  star_of_less [of "numeral k", simplified star_of_numeral]
  70.125 +  star_of_le   [of "numeral k", simplified star_of_numeral]
  70.126 +  star_of_eq   [of "numeral k", simplified star_of_numeral]
  70.127 +  star_of_less [of _ "numeral k", simplified star_of_numeral]
  70.128 +  star_of_le   [of _ "numeral k", simplified star_of_numeral]
  70.129 +  star_of_eq   [of _ "numeral k", simplified star_of_numeral]
  70.130 +  star_of_less [of "neg_numeral k", simplified star_of_numeral]
  70.131 +  star_of_le   [of "neg_numeral k", simplified star_of_numeral]
  70.132 +  star_of_eq   [of "neg_numeral k", simplified star_of_numeral]
  70.133 +  star_of_less [of _ "neg_numeral k", simplified star_of_numeral]
  70.134 +  star_of_le   [of _ "neg_numeral k", simplified star_of_numeral]
  70.135 +  star_of_eq   [of _ "neg_numeral k", simplified star_of_numeral] for k
  70.136 +
  70.137  lemma Standard_of_nat [simp]: "of_nat n \<in> Standard"
  70.138  by (simp add: star_of_nat_def)
  70.139  
  70.140 @@ -1010,11 +1012,6 @@
  70.141  
  70.142  instance star :: (ring_char_0) ring_char_0 ..
  70.143  
  70.144 -instance star :: (number_semiring) number_semiring
  70.145 -by (intro_classes, simp only: star_number_def star_of_nat_def number_of_int)
  70.146 -
  70.147 -instance star :: (number_ring) number_ring
  70.148 -by (intro_classes, simp only: star_number_def star_of_int_def number_of_eq)
  70.149  
  70.150  subsection {* Finite class *}
  70.151  
    71.1 --- a/src/HOL/Nat.thy	Mon Mar 26 15:32:54 2012 +0200
    71.2 +++ b/src/HOL/Nat.thy	Mon Mar 26 15:33:28 2012 +0200
    71.3 @@ -181,7 +181,7 @@
    71.4  begin
    71.5  
    71.6  definition
    71.7 -  One_nat_def [simp, code_post]: "1 = Suc 0"
    71.8 +  One_nat_def [simp]: "1 = Suc 0"
    71.9  
   71.10  primrec times_nat where
   71.11    mult_0:     "0 * n = (0\<Colon>nat)"
   71.12 @@ -1782,4 +1782,6 @@
   71.13  code_modulename Haskell
   71.14    Nat Arith
   71.15  
   71.16 +hide_const (open) of_nat_aux
   71.17 +
   71.18  end
    72.1 --- a/src/HOL/Nat_Numeral.thy	Mon Mar 26 15:32:54 2012 +0200
    72.2 +++ b/src/HOL/Nat_Numeral.thy	Mon Mar 26 15:33:28 2012 +0200
    72.3 @@ -15,31 +15,13 @@
    72.4    Arithmetic for naturals is reduced to that for the non-negative integers.
    72.5  *}
    72.6  
    72.7 -instantiation nat :: number_semiring
    72.8 -begin
    72.9 -
   72.10 -definition
   72.11 -  nat_number_of_def [code_unfold, code del]: "number_of v = nat (number_of v)"
   72.12 -
   72.13 -instance proof
   72.14 -  fix n show "number_of (int n) = (of_nat n :: nat)"
   72.15 -    unfolding nat_number_of_def number_of_eq by simp
   72.16 -qed
   72.17 - 
   72.18 -end
   72.19 -
   72.20 -lemma [code_post]:
   72.21 -  "nat (number_of v) = number_of v"
   72.22 -  unfolding nat_number_of_def ..
   72.23 -
   72.24 -
   72.25  subsection {* Special case: squares and cubes *}
   72.26  
   72.27  lemma numeral_2_eq_2: "2 = Suc (Suc 0)"
   72.28 -  by (simp add: nat_number_of_def)
   72.29 +  by (simp add: nat_number(2-4))
   72.30  
   72.31  lemma numeral_3_eq_3: "3 = Suc (Suc (Suc 0))"
   72.32 -  by (simp add: nat_number_of_def)
   72.33 +  by (simp add: nat_number(2-4))
   72.34  
   72.35  context power
   72.36  begin
   72.37 @@ -93,26 +75,21 @@
   72.38    "(- a)\<twosuperior> = a\<twosuperior>"
   72.39    by (simp add: power2_eq_square)
   72.40  
   72.41 -text{*
   72.42 -  We cannot prove general results about the numeral @{term "-1"},
   72.43 -  so we have to use @{term "- 1"} instead.
   72.44 -*}
   72.45 -
   72.46  lemma power_minus1_even [simp]:
   72.47 -  "(- 1) ^ (2*n) = 1"
   72.48 +  "-1 ^ (2*n) = 1"
   72.49  proof (induct n)
   72.50    case 0 show ?case by simp
   72.51  next
   72.52 -  case (Suc n) then show ?case by (simp add: power_add)
   72.53 +  case (Suc n) then show ?case by (simp add: power_add power2_eq_square)
   72.54  qed
   72.55  
   72.56  lemma power_minus1_odd:
   72.57 -  "(- 1) ^ Suc (2*n) = - 1"
   72.58 +  "-1 ^ Suc (2*n) = -1"
   72.59    by simp
   72.60  
   72.61  lemma power_minus_even [simp]:
   72.62    "(-a) ^ (2*n) = a ^ (2*n)"
   72.63 -  by (simp add: power_minus [of a]) 
   72.64 +  by (simp add: power_minus [of a])
   72.65  
   72.66  end
   72.67  
   72.68 @@ -261,100 +238,31 @@
   72.69  end
   72.70  
   72.71  lemma power2_sum:
   72.72 -  fixes x y :: "'a::number_semiring"
   72.73 +  fixes x y :: "'a::comm_semiring_1"
   72.74    shows "(x + y)\<twosuperior> = x\<twosuperior> + y\<twosuperior> + 2 * x * y"
   72.75 -  by (simp add: algebra_simps power2_eq_square semiring_mult_2_right)
   72.76 +  by (simp add: algebra_simps power2_eq_square mult_2_right)
   72.77  
   72.78  lemma power2_diff:
   72.79 -  fixes x y :: "'a::number_ring"
   72.80 +  fixes x y :: "'a::comm_ring_1"
   72.81    shows "(x - y)\<twosuperior> = x\<twosuperior> + y\<twosuperior> - 2 * x * y"
   72.82    by (simp add: ring_distribs power2_eq_square mult_2) (rule mult_commute)
   72.83  
   72.84  
   72.85 -subsection {* Predicate for negative binary numbers *}
   72.86 -
   72.87 -definition neg  :: "int \<Rightarrow> bool" where
   72.88 -  "neg Z \<longleftrightarrow> Z < 0"
   72.89 -
   72.90 -lemma not_neg_int [simp]: "~ neg (of_nat n)"
   72.91 -by (simp add: neg_def)
   72.92 -
   72.93 -lemma neg_zminus_int [simp]: "neg (- (of_nat (Suc n)))"
   72.94 -by (simp add: neg_def del: of_nat_Suc)
   72.95 -
   72.96 -lemmas neg_eq_less_0 = neg_def
   72.97 -
   72.98 -lemma not_neg_eq_ge_0: "(~neg x) = (0 \<le> x)"
   72.99 -by (simp add: neg_def linorder_not_less)
  72.100 -
  72.101 -text{*To simplify inequalities when Numeral1 can get simplified to 1*}
  72.102 -
  72.103 -lemma not_neg_0: "~ neg 0"
  72.104 -by (simp add: One_int_def neg_def)
  72.105 -
  72.106 -lemma not_neg_1: "~ neg 1"
  72.107 -by (simp add: neg_def linorder_not_less)
  72.108 -
  72.109 -lemma neg_nat: "neg z ==> nat z = 0"
  72.110 -by (simp add: neg_def order_less_imp_le) 
  72.111 -
  72.112 -lemma not_neg_nat: "~ neg z ==> of_nat (nat z) = z"
  72.113 -by (simp add: linorder_not_less neg_def)
  72.114 -
  72.115 -text {*
  72.116 -  If @{term Numeral0} is rewritten to 0 then this rule can't be applied:
  72.117 -  @{term Numeral0} IS @{term "number_of Pls"}
  72.118 -*}
  72.119 -
  72.120 -lemma not_neg_number_of_Pls: "~ neg (number_of Int.Pls)"
  72.121 -  by (simp add: neg_def)
  72.122 -
  72.123 -lemma neg_number_of_Min: "neg (number_of Int.Min)"
  72.124 -  by (simp add: neg_def)
  72.125 -
  72.126 -lemma neg_number_of_Bit0:
  72.127 -  "neg (number_of (Int.Bit0 w)) = neg (number_of w)"
  72.128 -  by (simp add: neg_def)
  72.129 -
  72.130 -lemma neg_number_of_Bit1:
  72.131 -  "neg (number_of (Int.Bit1 w)) = neg (number_of w)"
  72.132 -  by (simp add: neg_def)
  72.133 -
  72.134 -lemmas neg_simps [simp] =
  72.135 -  not_neg_0 not_neg_1
  72.136 -  not_neg_number_of_Pls neg_number_of_Min
  72.137 -  neg_number_of_Bit0 neg_number_of_Bit1
  72.138 -
  72.139 -
  72.140  subsection{*Function @{term nat}: Coercion from Type @{typ int} to @{typ nat}*}
  72.141  
  72.142  declare nat_1 [simp]
  72.143  
  72.144 -lemma nat_number_of [simp]: "nat (number_of w) = number_of w"
  72.145 -  by (simp add: nat_number_of_def)
  72.146 -
  72.147 -lemma nat_numeral_0_eq_0: "Numeral0 = (0::nat)" (* FIXME delete candidate *)
  72.148 -  by (fact semiring_numeral_0_eq_0)
  72.149 -
  72.150 -lemma nat_numeral_1_eq_1: "Numeral1 = (1::nat)" (* FIXME delete candidate *)
  72.151 -  by (fact semiring_numeral_1_eq_1)
  72.152 -
  72.153 -lemma Numeral1_eq1_nat:
  72.154 -  "(1::nat) = Numeral1"
  72.155 +lemma nat_neg_numeral [simp]: "nat (neg_numeral w) = 0"
  72.156    by simp
  72.157  
  72.158  lemma numeral_1_eq_Suc_0: "Numeral1 = Suc 0"
  72.159 -  by (simp only: nat_numeral_1_eq_1 One_nat_def)
  72.160 +  by simp
  72.161  
  72.162  
  72.163  subsection{*Function @{term int}: Coercion from Type @{typ nat} to @{typ int}*}
  72.164  
  72.165 -lemma int_nat_number_of [simp]:
  72.166 -     "int (number_of v) =  
  72.167 -         (if neg (number_of v :: int) then 0  
  72.168 -          else (number_of v :: int))"
  72.169 -  unfolding nat_number_of_def number_of_is_id neg_def
  72.170 -  by simp (* FIXME: redundant with of_nat_number_of_eq *)
  72.171 +lemma int_numeral: "int (numeral v) = numeral v"
  72.172 +  by (rule of_nat_numeral) (* already simp *)
  72.173  
  72.174  lemma nonneg_int_cases:
  72.175    fixes k :: int assumes "0 \<le> k" obtains n where "k = of_nat n"
  72.176 @@ -368,149 +276,51 @@
  72.177  done
  72.178  
  72.179  lemma Suc_nat_number_of_add:
  72.180 -     "Suc (number_of v + n) =  
  72.181 -        (if neg (number_of v :: int) then 1+n else number_of (Int.succ v) + n)"
  72.182 -  unfolding nat_number_of_def number_of_is_id neg_def numeral_simps
  72.183 -  by (simp add: Suc_nat_eq_nat_zadd1 add_ac)
  72.184 -
  72.185 -lemma Suc_nat_number_of [simp]:
  72.186 -     "Suc (number_of v) =  
  72.187 -        (if neg (number_of v :: int) then 1 else number_of (Int.succ v))"
  72.188 -apply (cut_tac n = 0 in Suc_nat_number_of_add)
  72.189 -apply (simp cong del: if_weak_cong)
  72.190 -done
  72.191 -
  72.192 -
  72.193 -subsubsection{*Addition *}
  72.194 -
  72.195 -lemma add_nat_number_of [simp]:
  72.196 -     "(number_of v :: nat) + number_of v' =  
  72.197 -         (if v < Int.Pls then number_of v'  
  72.198 -          else if v' < Int.Pls then number_of v  
  72.199 -          else number_of (v + v'))"
  72.200 -  unfolding nat_number_of_def number_of_is_id numeral_simps
  72.201 -  by (simp add: nat_add_distrib)
  72.202 -
  72.203 -lemma nat_number_of_add_1 [simp]:
  72.204 -  "number_of v + (1::nat) =
  72.205 -    (if v < Int.Pls then 1 else number_of (Int.succ v))"
  72.206 -  unfolding nat_number_of_def number_of_is_id numeral_simps
  72.207 -  by (simp add: nat_add_distrib)
  72.208 +  "Suc (numeral v + n) = numeral (v + Num.One) + n"
  72.209 +  by simp
  72.210  
  72.211 -lemma nat_1_add_number_of [simp]:
  72.212 -  "(1::nat) + number_of v =
  72.213 -    (if v < Int.Pls then 1 else number_of (Int.succ v))"
  72.214 -  unfolding nat_number_of_def number_of_is_id numeral_simps
  72.215 -  by (simp add: nat_add_distrib)
  72.216 -
  72.217 -lemma nat_1_add_1 [simp]: "1 + 1 = (2::nat)"
  72.218 -  by (rule semiring_one_add_one_is_two)
  72.219 -
  72.220 -text {* TODO: replace simp rules above with these generic ones: *}
  72.221 -
  72.222 -lemma semiring_add_number_of:
  72.223 -  "\<lbrakk>Int.Pls \<le> v; Int.Pls \<le> v'\<rbrakk> \<Longrightarrow>
  72.224 -    (number_of v :: 'a::number_semiring) + number_of v' = number_of (v + v')"
  72.225 -  unfolding Int.Pls_def
  72.226 -  by (elim nonneg_int_cases,
  72.227 -    simp only: number_of_int of_nat_add [symmetric])
  72.228 -
  72.229 -lemma semiring_number_of_add_1:
  72.230 -  "Int.Pls \<le> v \<Longrightarrow>
  72.231 -    number_of v + (1::'a::number_semiring) = number_of (Int.succ v)"
  72.232 -  unfolding Int.Pls_def Int.succ_def
  72.233 -  by (elim nonneg_int_cases,
  72.234 -    simp only: number_of_int add_commute [where b=1] of_nat_Suc [symmetric])
  72.235 -
  72.236 -lemma semiring_1_add_number_of:
  72.237 -  "Int.Pls \<le> v \<Longrightarrow>
  72.238 -    (1::'a::number_semiring) + number_of v = number_of (Int.succ v)"
  72.239 -  unfolding Int.Pls_def Int.succ_def
  72.240 -  by (elim nonneg_int_cases,
  72.241 -    simp only: number_of_int add_commute [where b=1] of_nat_Suc [symmetric])
  72.242 +lemma Suc_numeral [simp]:
  72.243 +  "Suc (numeral v) = numeral (v + Num.One)"
  72.244 +  by simp
  72.245  
  72.246  
  72.247  subsubsection{*Subtraction *}
  72.248  
  72.249  lemma diff_nat_eq_if:
  72.250       "nat z - nat z' =  
  72.251 -        (if neg z' then nat z   
  72.252 +        (if z' < 0 then nat z   
  72.253           else let d = z-z' in     
  72.254 -              if neg d then 0 else nat d)"
  72.255 -by (simp add: Let_def nat_diff_distrib [symmetric] neg_eq_less_0 not_neg_eq_ge_0)
  72.256 -
  72.257 -
  72.258 -lemma diff_nat_number_of [simp]: 
  72.259 -     "(number_of v :: nat) - number_of v' =  
  72.260 -        (if v' < Int.Pls then number_of v  
  72.261 -         else let d = number_of (v + uminus v') in     
  72.262 -              if neg d then 0 else nat d)"
  72.263 -  unfolding nat_number_of_def number_of_is_id numeral_simps neg_def
  72.264 -  by auto
  72.265 +              if d < 0 then 0 else nat d)"
  72.266 +by (simp add: Let_def nat_diff_distrib [symmetric])
  72.267  
  72.268 -lemma nat_number_of_diff_1 [simp]:
  72.269 -  "number_of v - (1::nat) =
  72.270 -    (if v \<le> Int.Pls then 0 else number_of (Int.pred v))"
  72.271 -  unfolding nat_number_of_def number_of_is_id numeral_simps
  72.272 -  by auto
  72.273 -
  72.274 -
  72.275 -subsubsection{*Multiplication *}
  72.276 +(* Int.nat_diff_distrib has too-strong premises *)
  72.277 +lemma nat_diff_distrib': "\<lbrakk>0 \<le> x; 0 \<le> y\<rbrakk> \<Longrightarrow> nat (x - y) = nat x - nat y"
  72.278 +apply (rule int_int_eq [THEN iffD1], clarsimp)
  72.279 +apply (subst zdiff_int [symmetric])
  72.280 +apply (rule nat_mono, simp_all)
  72.281 +done
  72.282  
  72.283 -lemma mult_nat_number_of [simp]:
  72.284 -     "(number_of v :: nat) * number_of v' =  
  72.285 -       (if v < Int.Pls then 0 else number_of (v * v'))"
  72.286 -  unfolding nat_number_of_def number_of_is_id numeral_simps
  72.287 -  by (simp add: nat_mult_distrib)
  72.288 +lemma diff_nat_numeral [simp]: 
  72.289 +  "(numeral v :: nat) - numeral v' = nat (numeral v - numeral v')"
  72.290 +  by (simp only: nat_diff_distrib' zero_le_numeral nat_numeral)
  72.291  
  72.292 -(* TODO: replace mult_nat_number_of with this next rule *)
  72.293 -lemma semiring_mult_number_of:
  72.294 -  "\<lbrakk>Int.Pls \<le> v; Int.Pls \<le> v'\<rbrakk> \<Longrightarrow>
  72.295 -    (number_of v :: 'a::number_semiring) * number_of v' = number_of (v * v')"
  72.296 -  unfolding Int.Pls_def
  72.297 -  by (elim nonneg_int_cases,
  72.298 -    simp only: number_of_int of_nat_mult [symmetric])
  72.299 +lemma nat_numeral_diff_1 [simp]:
  72.300 +  "numeral v - (1::nat) = nat (numeral v - 1)"
  72.301 +  using diff_nat_numeral [of v Num.One] by simp
  72.302  
  72.303  
  72.304  subsection{*Comparisons*}
  72.305  
  72.306 -subsubsection{*Equals (=) *}
  72.307 -
  72.308 -lemma eq_nat_number_of [simp]:
  72.309 -     "((number_of v :: nat) = number_of v') =  
  72.310 -      (if neg (number_of v :: int) then (number_of v' :: int) \<le> 0
  72.311 -       else if neg (number_of v' :: int) then (number_of v :: int) = 0
  72.312 -       else v = v')"
  72.313 -  unfolding nat_number_of_def number_of_is_id neg_def
  72.314 -  by auto
  72.315 -
  72.316 -
  72.317 -subsubsection{*Less-than (<) *}
  72.318 -
  72.319 -lemma less_nat_number_of [simp]:
  72.320 -  "(number_of v :: nat) < number_of v' \<longleftrightarrow>
  72.321 -    (if v < v' then Int.Pls < v' else False)"
  72.322 -  unfolding nat_number_of_def number_of_is_id numeral_simps
  72.323 -  by auto
  72.324 -
  72.325 -
  72.326 -subsubsection{*Less-than-or-equal *}
  72.327 -
  72.328 -lemma le_nat_number_of [simp]:
  72.329 -  "(number_of v :: nat) \<le> number_of v' \<longleftrightarrow>
  72.330 -    (if v \<le> v' then True else v \<le> Int.Pls)"
  72.331 -  unfolding nat_number_of_def number_of_is_id numeral_simps
  72.332 -  by auto
  72.333 -
  72.334 -(*Maps #n to n for n = 0, 1, 2*)
  72.335 -lemmas numerals = nat_numeral_0_eq_0 nat_numeral_1_eq_1 numeral_2_eq_2
  72.336 +(*Maps #n to n for n = 1, 2*)
  72.337 +lemmas numerals = numeral_1_eq_1 [where 'a=nat] numeral_2_eq_2
  72.338  
  72.339  
  72.340  subsection{*Powers with Numeric Exponents*}
  72.341  
  72.342  text{*Squares of literal numerals will be evaluated.*}
  72.343 -lemmas power2_eq_square_number_of [simp] =
  72.344 -  power2_eq_square [of "number_of w"] for w
  72.345 +(* FIXME: replace with more general rules for powers of numerals *)
  72.346 +lemmas power2_eq_square_numeral [simp] =
  72.347 +    power2_eq_square [of "numeral w"] for w
  72.348  
  72.349  
  72.350  text{*Simprules for comparisons where common factors can be cancelled.*}
  72.351 @@ -528,8 +338,8 @@
  72.352  by simp
  72.353  
  72.354  (*Expresses a natural number constant as the Suc of another one.
  72.355 -  NOT suitable for rewriting because n recurs in the condition.*)
  72.356 -lemmas expand_Suc = Suc_pred' [of "number_of v"] for v
  72.357 +  NOT suitable for rewriting because n recurs on the right-hand side.*)
  72.358 +lemmas expand_Suc = Suc_pred' [of "numeral v", OF zero_less_numeral] for v
  72.359  
  72.360  subsubsection{*Arith *}
  72.361  
  72.362 @@ -539,7 +349,7 @@
  72.363  lemma Suc_eq_plus1_left: "Suc n = 1 + n"
  72.364    unfolding One_nat_def by simp
  72.365  
  72.366 -(* These two can be useful when m = number_of... *)
  72.367 +(* These two can be useful when m = numeral... *)
  72.368  
  72.369  lemma add_eq_if: "(m::nat) + n = (if m=0 then n else Suc ((m - 1) + n))"
  72.370    unfolding One_nat_def by (cases m) simp_all
  72.371 @@ -551,231 +361,108 @@
  72.372    unfolding One_nat_def by (cases m) simp_all
  72.373  
  72.374  
  72.375 -subsection{*Comparisons involving (0::nat) *}
  72.376 -
  72.377 -text{*Simplification already does @{term "n<0"}, @{term "n\<le>0"} and @{term "0\<le>n"}.*}
  72.378 -
  72.379 -lemma eq_number_of_0 [simp]:
  72.380 -  "number_of v = (0::nat) \<longleftrightarrow> v \<le> Int.Pls"
  72.381 -  unfolding nat_number_of_def number_of_is_id numeral_simps
  72.382 -  by auto
  72.383 -
  72.384 -lemma eq_0_number_of [simp]:
  72.385 -  "(0::nat) = number_of v \<longleftrightarrow> v \<le> Int.Pls"
  72.386 -by (rule trans [OF eq_sym_conv eq_number_of_0])
  72.387 -
  72.388 -lemma less_0_number_of [simp]:
  72.389 -   "(0::nat) < number_of v \<longleftrightarrow> Int.Pls < v"
  72.390 -  unfolding nat_number_of_def number_of_is_id numeral_simps
  72.391 -  by simp
  72.392 -
  72.393 -lemma neg_imp_number_of_eq_0: "neg (number_of v :: int) ==> number_of v = (0::nat)"
  72.394 -  by (simp del: semiring_numeral_0_eq_0 add: nat_numeral_0_eq_0 [symmetric])
  72.395 -
  72.396 -
  72.397  subsection{*Comparisons involving  @{term Suc} *}
  72.398  
  72.399 -lemma eq_number_of_Suc [simp]:
  72.400 -     "(number_of v = Suc n) =  
  72.401 -        (let pv = number_of (Int.pred v) in  
  72.402 -         if neg pv then False else nat pv = n)"
  72.403 -apply (simp only: simp_thms Let_def neg_eq_less_0 linorder_not_less 
  72.404 -                  number_of_pred nat_number_of_def 
  72.405 -            split add: split_if)
  72.406 -apply (rule_tac x = "number_of v" in spec)
  72.407 -apply (auto simp add: nat_eq_iff)
  72.408 -done
  72.409 +lemma eq_numeral_Suc [simp]: "numeral v = Suc n \<longleftrightarrow> nat (numeral v - 1) = n"
  72.410 +  by (subst expand_Suc, simp only: nat.inject nat_numeral_diff_1)
  72.411  
  72.412 -lemma Suc_eq_number_of [simp]:
  72.413 -     "(Suc n = number_of v) =  
  72.414 -        (let pv = number_of (Int.pred v) in  
  72.415 -         if neg pv then False else nat pv = n)"
  72.416 -by (rule trans [OF eq_sym_conv eq_number_of_Suc])
  72.417 +lemma Suc_eq_numeral [simp]: "Suc n = numeral v \<longleftrightarrow> n = nat (numeral v - 1)"
  72.418 +  by (subst expand_Suc, simp only: nat.inject nat_numeral_diff_1)
  72.419  
  72.420 -lemma less_number_of_Suc [simp]:
  72.421 -     "(number_of v < Suc n) =  
  72.422 -        (let pv = number_of (Int.pred v) in  
  72.423 -         if neg pv then True else nat pv < n)"
  72.424 -apply (simp only: simp_thms Let_def neg_eq_less_0 linorder_not_less 
  72.425 -                  number_of_pred nat_number_of_def  
  72.426 -            split add: split_if)
  72.427 -apply (rule_tac x = "number_of v" in spec)
  72.428 -apply (auto simp add: nat_less_iff)
  72.429 -done
  72.430 +lemma less_numeral_Suc [simp]: "numeral v < Suc n \<longleftrightarrow> nat (numeral v - 1) < n"
  72.431 +  by (subst expand_Suc, simp only: Suc_less_eq nat_numeral_diff_1)
  72.432  
  72.433 -lemma less_Suc_number_of [simp]:
  72.434 -     "(Suc n < number_of v) =  
  72.435 -        (let pv = number_of (Int.pred v) in  
  72.436 -         if neg pv then False else n < nat pv)"
  72.437 -apply (simp only: simp_thms Let_def neg_eq_less_0 linorder_not_less 
  72.438 -                  number_of_pred nat_number_of_def
  72.439 -            split add: split_if)
  72.440 -apply (rule_tac x = "number_of v" in spec)
  72.441 -apply (auto simp add: zless_nat_eq_int_zless)
  72.442 -done
  72.443 +lemma less_Suc_numeral [simp]: "Suc n < numeral v \<longleftrightarrow> n < nat (numeral v - 1)"
  72.444 +  by (subst expand_Suc, simp only: Suc_less_eq nat_numeral_diff_1)
  72.445  
  72.446 -lemma le_number_of_Suc [simp]:
  72.447 -     "(number_of v <= Suc n) =  
  72.448 -        (let pv = number_of (Int.pred v) in  
  72.449 -         if neg pv then True else nat pv <= n)"
  72.450 -by (simp add: Let_def linorder_not_less [symmetric])
  72.451 +lemma le_numeral_Suc [simp]: "numeral v \<le> Suc n \<longleftrightarrow> nat (numeral v - 1) \<le> n"
  72.452 +  by (subst expand_Suc, simp only: Suc_le_mono nat_numeral_diff_1)
  72.453  
  72.454 -lemma le_Suc_number_of [simp]:
  72.455 -     "(Suc n <= number_of v) =  
  72.456 -        (let pv = number_of (Int.pred v) in  
  72.457 -         if neg pv then False else n <= nat pv)"
  72.458 -by (simp add: Let_def linorder_not_less [symmetric])
  72.459 -
  72.460 -
  72.461 -lemma eq_number_of_Pls_Min: "(Numeral0 ::int) ~= number_of Int.Min"
  72.462 -by auto
  72.463 -
  72.464 +lemma le_Suc_numeral [simp]: "Suc n \<le> numeral v \<longleftrightarrow> n \<le> nat (numeral v - 1)"
  72.465 +  by (subst expand_Suc, simp only: Suc_le_mono nat_numeral_diff_1)
  72.466  
  72.467  
  72.468  subsection{*Max and Min Combined with @{term Suc} *}
  72.469  
  72.470 -lemma max_number_of_Suc [simp]:
  72.471 -     "max (Suc n) (number_of v) =  
  72.472 -        (let pv = number_of (Int.pred v) in  
  72.473 -         if neg pv then Suc n else Suc(max n (nat pv)))"
  72.474 -apply (simp only: Let_def neg_eq_less_0 number_of_pred nat_number_of_def 
  72.475 -            split add: split_if nat.split)
  72.476 -apply (rule_tac x = "number_of v" in spec) 
  72.477 -apply auto
  72.478 -done
  72.479 - 
  72.480 -lemma max_Suc_number_of [simp]:
  72.481 -     "max (number_of v) (Suc n) =  
  72.482 -        (let pv = number_of (Int.pred v) in  
  72.483 -         if neg pv then Suc n else Suc(max (nat pv) n))"
  72.484 -apply (simp only: Let_def neg_eq_less_0 number_of_pred nat_number_of_def 
  72.485 -            split add: split_if nat.split)
  72.486 -apply (rule_tac x = "number_of v" in spec) 
  72.487 -apply auto
  72.488 -done
  72.489 - 
  72.490 -lemma min_number_of_Suc [simp]:
  72.491 -     "min (Suc n) (number_of v) =  
  72.492 -        (let pv = number_of (Int.pred v) in  
  72.493 -         if neg pv then 0 else Suc(min n (nat pv)))"
  72.494 -apply (simp only: Let_def neg_eq_less_0 number_of_pred nat_number_of_def 
  72.495 -            split add: split_if nat.split)
  72.496 -apply (rule_tac x = "number_of v" in spec) 
  72.497 -apply auto
  72.498 -done
  72.499 - 
  72.500 -lemma min_Suc_number_of [simp]:
  72.501 -     "min (number_of v) (Suc n) =  
  72.502 -        (let pv = number_of (Int.pred v) in  
  72.503 -         if neg pv then 0 else Suc(min (nat pv) n))"
  72.504 -apply (simp only: Let_def neg_eq_less_0 number_of_pred nat_number_of_def 
  72.505 -            split add: split_if nat.split)
  72.506 -apply (rule_tac x = "number_of v" in spec) 
  72.507 -apply auto
  72.508 -done
  72.509 +lemma max_Suc_numeral [simp]:
  72.510 +  "max (Suc n) (numeral v) = Suc (max n (nat (numeral v - 1)))"
  72.511 +  by (subst expand_Suc, simp only: max_Suc_Suc nat_numeral_diff_1)
  72.512 +
  72.513 +lemma max_numeral_Suc [simp]:
  72.514 +  "max (numeral v) (Suc n) = Suc (max (nat (numeral v - 1)) n)"
  72.515 +  by (subst expand_Suc, simp only: max_Suc_Suc nat_numeral_diff_1)
  72.516 +
  72.517 +lemma min_Suc_numeral [simp]:
  72.518 +  "min (Suc n) (numeral v) = Suc (min n (nat (numeral v - 1)))"
  72.519 +  by (subst expand_Suc, simp only: min_Suc_Suc nat_numeral_diff_1)
  72.520 +
  72.521 +lemma min_numeral_Suc [simp]:
  72.522 +  "min (numeral v) (Suc n) = Suc (min (nat (numeral v - 1)) n)"
  72.523 +  by (subst expand_Suc, simp only: min_Suc_Suc nat_numeral_diff_1)
  72.524   
  72.525  subsection{*Literal arithmetic involving powers*}
  72.526  
  72.527 -lemma power_nat_number_of:
  72.528 -     "(number_of v :: nat) ^ n =  
  72.529 -       (if neg (number_of v :: int) then 0^n else nat ((number_of v :: int) ^ n))"
  72.530 -by (simp only: simp_thms neg_nat not_neg_eq_ge_0 nat_number_of_def nat_power_eq
  72.531 -         split add: split_if cong: imp_cong)
  72.532 +(* TODO: replace with more generic rule for powers of numerals *)
  72.533 +lemma power_nat_numeral:
  72.534 +  "(numeral v :: nat) ^ n = nat ((numeral v :: int) ^ n)"
  72.535 +  by (simp only: nat_power_eq zero_le_numeral nat_numeral)
  72.536  
  72.537 -
  72.538 -lemmas power_nat_number_of_number_of = power_nat_number_of [of _ "number_of w"] for w
  72.539 -declare power_nat_number_of_number_of [simp]
  72.540 -
  72.541 +lemmas power_nat_numeral_numeral = power_nat_numeral [of _ "numeral w"] for w
  72.542 +declare power_nat_numeral_numeral [simp]
  72.543  
  72.544  
  72.545  text{*For arbitrary rings*}
  72.546  
  72.547 -lemma power_number_of_even:
  72.548 +lemma power_numeral_even:
  72.549    fixes z :: "'a::monoid_mult"
  72.550 -  shows "z ^ number_of (Int.Bit0 w) = (let w = z ^ (number_of w) in w * w)"
  72.551 -by (cases "w \<ge> 0") (auto simp add: Let_def Bit0_def nat_number_of_def number_of_is_id
  72.552 -  nat_add_distrib power_add simp del: nat_number_of)
  72.553 +  shows "z ^ numeral (Num.Bit0 w) = (let w = z ^ (numeral w) in w * w)"
  72.554 +  unfolding numeral_Bit0 power_add Let_def ..
  72.555  
  72.556 -lemma power_number_of_odd:
  72.557 +lemma power_numeral_odd:
  72.558    fixes z :: "'a::monoid_mult"
  72.559 -  shows "z ^ number_of (Int.Bit1 w) = (if (0::int) <= number_of w
  72.560 -     then (let w = z ^ (number_of w) in z * w * w) else 1)"
  72.561 -unfolding Let_def Bit1_def nat_number_of_def number_of_is_id
  72.562 -apply (cases "0 <= w")
  72.563 -apply (simp only: mult_assoc nat_add_distrib power_add, simp)
  72.564 -apply (simp add: not_le mult_2 [symmetric] add_assoc)
  72.565 -done
  72.566 +  shows "z ^ numeral (Num.Bit1 w) = (let w = z ^ (numeral w) in z * w * w)"
  72.567 +  unfolding numeral_Bit1 One_nat_def add_Suc_right add_0_right
  72.568 +  unfolding power_Suc power_add Let_def mult_assoc ..
  72.569  
  72.570 -lemmas zpower_number_of_even = power_number_of_even [where 'a=int]
  72.571 -lemmas zpower_number_of_odd = power_number_of_odd [where 'a=int]
  72.572 -
  72.573 -lemmas power_number_of_even_number_of [simp] =
  72.574 -    power_number_of_even [of "number_of v"] for v
  72.575 +lemmas zpower_numeral_even = power_numeral_even [where 'a=int]
  72.576 +lemmas zpower_numeral_odd = power_numeral_odd [where 'a=int]
  72.577  
  72.578 -lemmas power_number_of_odd_number_of [simp] =
  72.579 -    power_number_of_odd [of "number_of v"] for v
  72.580 +lemmas power_numeral_even_numeral [simp] =
  72.581 +    power_numeral_even [of "numeral v"] for v
  72.582  
  72.583 -lemma nat_number_of_Pls: "Numeral0 = (0::nat)"
  72.584 -  by (simp add: nat_number_of_def)
  72.585 -
  72.586 -lemma nat_number_of_Min [no_atp]: "number_of Int.Min = (0::nat)"
  72.587 -  apply (simp only: number_of_Min nat_number_of_def nat_zminus_int)
  72.588 -  done
  72.589 +lemmas power_numeral_odd_numeral [simp] =
  72.590 +    power_numeral_odd [of "numeral v"] for v
  72.591  
  72.592 -lemma nat_number_of_Bit0:
  72.593 -    "number_of (Int.Bit0 w) = (let n::nat = number_of w in n + n)"
  72.594 -by (cases "w \<ge> 0") (auto simp add: Let_def Bit0_def nat_number_of_def number_of_is_id
  72.595 -  nat_add_distrib simp del: nat_number_of)
  72.596 +lemma nat_numeral_Bit0:
  72.597 +  "numeral (Num.Bit0 w) = (let n::nat = numeral w in n + n)"
  72.598 +  unfolding numeral_Bit0 Let_def ..
  72.599  
  72.600 -lemma nat_number_of_Bit1:
  72.601 -  "number_of (Int.Bit1 w) =
  72.602 -    (if neg (number_of w :: int) then 0
  72.603 -     else let n = number_of w in Suc (n + n))"
  72.604 -unfolding Let_def Bit1_def nat_number_of_def number_of_is_id neg_def
  72.605 -apply (cases "w < 0")
  72.606 -apply (simp add: mult_2 [symmetric] add_assoc)
  72.607 -apply (simp only: nat_add_distrib, simp)
  72.608 -done
  72.609 +lemma nat_numeral_Bit1:
  72.610 +  "numeral (Num.Bit1 w) = (let n = numeral w in Suc (n + n))"
  72.611 +  unfolding numeral_Bit1 Let_def by simp
  72.612  
  72.613  lemmas eval_nat_numeral =
  72.614 -  nat_number_of_Bit0 nat_number_of_Bit1
  72.615 +  nat_numeral_Bit0 nat_numeral_Bit1
  72.616  
  72.617  lemmas nat_arith =
  72.618 -  add_nat_number_of
  72.619 -  diff_nat_number_of
  72.620 -  mult_nat_number_of
  72.621 -  eq_nat_number_of
  72.622 -  less_nat_number_of
  72.623 +  diff_nat_numeral
  72.624  
  72.625  lemmas semiring_norm =
  72.626 -  Let_def arith_simps nat_arith rel_simps neg_simps if_False
  72.627 -  if_True add_0 add_Suc add_number_of_left mult_number_of_left
  72.628 +  Let_def arith_simps nat_arith rel_simps
  72.629 +  if_False if_True
  72.630 +  add_0 add_Suc add_numeral_left
  72.631 +  add_neg_numeral_left mult_numeral_left
  72.632    numeral_1_eq_1 [symmetric] Suc_eq_plus1
  72.633 -  numeral_0_eq_0 [symmetric] numerals [symmetric]
  72.634 -  not_iszero_Numeral1
  72.635 +  eq_numeral_iff_iszero not_iszero_Numeral1
  72.636  
  72.637  lemma Let_Suc [simp]: "Let (Suc n) f == f (Suc n)"
  72.638    by (fact Let_def)
  72.639  
  72.640 -lemma power_m1_even: "(-1) ^ (2*n) = (1::'a::{number_ring})"
  72.641 -  by (simp only: number_of_Min power_minus1_even)
  72.642 -
  72.643 -lemma power_m1_odd: "(-1) ^ Suc(2*n) = (-1::'a::{number_ring})"
  72.644 -  by (simp only: number_of_Min power_minus1_odd)
  72.645 +lemma power_m1_even: "(-1) ^ (2*n) = (1::'a::ring_1)"
  72.646 +  by (fact power_minus1_even) (* FIXME: duplicate *)
  72.647  
  72.648 -lemma nat_number_of_add_left:
  72.649 -     "number_of v + (number_of v' + (k::nat)) =  
  72.650 -         (if neg (number_of v :: int) then number_of v' + k  
  72.651 -          else if neg (number_of v' :: int) then number_of v + k  
  72.652 -          else number_of (v + v') + k)"
  72.653 -by (auto simp add: neg_def)
  72.654 -
  72.655 -lemma nat_number_of_mult_left:
  72.656 -     "number_of v * (number_of v' * (k::nat)) =  
  72.657 -         (if v < Int.Pls then 0
  72.658 -          else number_of (v * v') * k)"
  72.659 -by (auto simp add: not_less Pls_def nat_number_of_def number_of_is_id
  72.660 -  nat_mult_distrib simp del: nat_number_of)
  72.661 +lemma power_m1_odd: "(-1) ^ Suc(2*n) = (-1::'a::ring_1)"
  72.662 +  by (fact power_minus1_odd) (* FIXME: duplicate *)
  72.663  
  72.664  
  72.665  subsection{*Literal arithmetic and @{term of_nat}*}
  72.666 @@ -784,52 +471,18 @@
  72.667       "0 \<le> x ==> of_nat (nat (2 * x)) = of_nat (nat x) + of_nat (nat x)"
  72.668  by (simp only: mult_2 nat_add_distrib of_nat_add) 
  72.669  
  72.670 -lemma nat_numeral_m1_eq_0: "-1 = (0::nat)"
  72.671 -by (simp only: nat_number_of_def)
  72.672 -
  72.673 -lemma of_nat_number_of_lemma:
  72.674 -     "of_nat (number_of v :: nat) =  
  72.675 -         (if 0 \<le> (number_of v :: int) 
  72.676 -          then (number_of v :: 'a :: number_semiring)
  72.677 -          else 0)"
  72.678 -  by (auto simp add: int_number_of_def nat_number_of_def number_of_int
  72.679 -    elim!: nonneg_int_cases)
  72.680 -
  72.681 -lemma of_nat_number_of_eq [simp]:
  72.682 -     "of_nat (number_of v :: nat) =  
  72.683 -         (if neg (number_of v :: int) then 0  
  72.684 -          else (number_of v :: 'a :: number_semiring))"
  72.685 -  by (simp only: of_nat_number_of_lemma neg_def, simp)
  72.686 -
  72.687  
  72.688  subsubsection{*For simplifying @{term "Suc m - K"} and  @{term "K - Suc m"}*}
  72.689  
  72.690  text{*Where K above is a literal*}
  72.691  
  72.692 -lemma Suc_diff_eq_diff_pred: "Numeral0 < n ==> Suc m - n = m - (n - Numeral1)"
  72.693 +lemma Suc_diff_eq_diff_pred: "0 < n ==> Suc m - n = m - (n - Numeral1)"
  72.694  by (simp split: nat_diff_split)
  72.695  
  72.696 -text {*Now just instantiating @{text n} to @{text "number_of v"} does
  72.697 -  the right simplification, but with some redundant inequality
  72.698 -  tests.*}
  72.699 -lemma neg_number_of_pred_iff_0:
  72.700 -  "neg (number_of (Int.pred v)::int) = (number_of v = (0::nat))"
  72.701 -apply (subgoal_tac "neg (number_of (Int.pred v)) = (number_of v < Suc 0) ")
  72.702 -apply (simp only: less_Suc_eq_le le_0_eq)
  72.703 -apply (subst less_number_of_Suc, simp)
  72.704 -done
  72.705 -
  72.706  text{*No longer required as a simprule because of the @{text inverse_fold}
  72.707     simproc*}
  72.708 -lemma Suc_diff_number_of:
  72.709 -     "Int.Pls < v ==>
  72.710 -      Suc m - (number_of v) = m - (number_of (Int.pred v))"
  72.711 -apply (subst Suc_diff_eq_diff_pred)
  72.712 -apply simp
  72.713 -apply (simp del: semiring_numeral_1_eq_1)
  72.714 -apply (auto simp only: diff_nat_number_of less_0_number_of [symmetric]
  72.715 -                        neg_number_of_pred_iff_0)
  72.716 -done
  72.717 +lemma Suc_diff_numeral: "Suc m - (numeral v) = m - (numeral v - 1)"
  72.718 +  by (subst expand_Suc, simp only: diff_Suc_Suc)
  72.719  
  72.720  lemma diff_Suc_eq_diff_pred: "m - Suc n = (m - 1) - n"
  72.721  by (simp split: nat_diff_split)
  72.722 @@ -837,45 +490,22 @@
  72.723  
  72.724  subsubsection{*For @{term nat_case} and @{term nat_rec}*}
  72.725  
  72.726 -lemma nat_case_number_of [simp]:
  72.727 -     "nat_case a f (number_of v) =
  72.728 -        (let pv = number_of (Int.pred v) in
  72.729 -         if neg pv then a else f (nat pv))"
  72.730 -by (simp split add: nat.split add: Let_def neg_number_of_pred_iff_0)
  72.731 +lemma nat_case_numeral [simp]:
  72.732 +  "nat_case a f (numeral v) = (let pv = nat (numeral v - 1) in f pv)"
  72.733 +  by (subst expand_Suc, simp only: nat.cases nat_numeral_diff_1 Let_def)
  72.734  
  72.735  lemma nat_case_add_eq_if [simp]:
  72.736 -     "nat_case a f ((number_of v) + n) =
  72.737 -       (let pv = number_of (Int.pred v) in
  72.738 -         if neg pv then nat_case a f n else f (nat pv + n))"
  72.739 -apply (subst add_eq_if)
  72.740 -apply (simp split add: nat.split
  72.741 -            del: semiring_numeral_1_eq_1
  72.742 -            add: semiring_numeral_1_eq_1 [symmetric]
  72.743 -                 numeral_1_eq_Suc_0 [symmetric]
  72.744 -                 neg_number_of_pred_iff_0)
  72.745 -done
  72.746 +  "nat_case a f ((numeral v) + n) = (let pv = nat (numeral v - 1) in f (pv + n))"
  72.747 +  by (subst expand_Suc, simp only: nat.cases nat_numeral_diff_1 Let_def add_Suc)
  72.748  
  72.749 -lemma nat_rec_number_of [simp]:
  72.750 -     "nat_rec a f (number_of v) =
  72.751 -        (let pv = number_of (Int.pred v) in
  72.752 -         if neg pv then a else f (nat pv) (nat_rec a f (nat pv)))"
  72.753 -apply (case_tac " (number_of v) ::nat")
  72.754 -apply (simp_all (no_asm_simp) add: Let_def neg_number_of_pred_iff_0)
  72.755 -apply (simp split add: split_if_asm)
  72.756 -done
  72.757 +lemma nat_rec_numeral [simp]:
  72.758 +  "nat_rec a f (numeral v) = (let pv = nat (numeral v - 1) in f pv (nat_rec a f pv))"
  72.759 +  by (subst expand_Suc, simp only: nat_rec_Suc nat_numeral_diff_1 Let_def)
  72.760  
  72.761  lemma nat_rec_add_eq_if [simp]:
  72.762 -     "nat_rec a f (number_of v + n) =
  72.763 -        (let pv = number_of (Int.pred v) in
  72.764 -         if neg pv then nat_rec a f n
  72.765 -                   else f (nat pv + n) (nat_rec a f (nat pv + n)))"
  72.766 -apply (subst add_eq_if)
  72.767 -apply (simp split add: nat.split
  72.768 -            del: semiring_numeral_1_eq_1
  72.769 -            add: semiring_numeral_1_eq_1 [symmetric]
  72.770 -                 numeral_1_eq_Suc_0 [symmetric]
  72.771 -                 neg_number_of_pred_iff_0)
  72.772 -done
  72.773 +  "nat_rec a f (numeral v + n) =
  72.774 +    (let pv = nat (numeral v - 1) in f (pv + n) (nat_rec a f (pv + n)))"
  72.775 +  by (subst expand_Suc, simp only: nat_rec_Suc nat_numeral_diff_1 Let_def add_Suc)
  72.776  
  72.777  
  72.778  subsubsection{*Various Other Lemmas*}
  72.779 @@ -887,14 +517,14 @@
  72.780  
  72.781  text{*Lemmas for specialist use, NOT as default simprules*}
  72.782  lemma nat_mult_2: "2 * z = (z+z::nat)"
  72.783 -by (rule semiring_mult_2)
  72.784 +by (rule mult_2) (* FIXME: duplicate *)
  72.785  
  72.786  lemma nat_mult_2_right: "z * 2 = (z+z::nat)"
  72.787 -by (rule semiring_mult_2_right)
  72.788 +by (rule mult_2_right) (* FIXME: duplicate *)
  72.789  
  72.790  text{*Case analysis on @{term "n<2"}*}
  72.791  lemma less_2_cases: "(n::nat) < 2 ==> n = 0 | n = Suc 0"
  72.792 -by (auto simp add: nat_1_add_1 [symmetric])
  72.793 +by (auto simp add: numeral_2_eq_2)
  72.794  
  72.795  text{*Removal of Small Numerals: 0, 1 and (in additive positions) 2*}
  72.796  
  72.797 @@ -908,4 +538,8 @@
  72.798  lemma Suc3_eq_add_3: "Suc (Suc (Suc n)) = 3 + n"
  72.799  by simp
  72.800  
  72.801 +text{*Legacy theorems*}
  72.802 +
  72.803 +lemmas nat_1_add_1 = one_add_one [where 'a=nat]
  72.804 +
  72.805  end
    74.1 --- a/src/HOL/Nominal/Nominal.thy	Mon Mar 26 15:32:54 2012 +0200
    74.2 +++ b/src/HOL/Nominal/Nominal.thy	Mon Mar 26 15:33:28 2012 +0200
    74.3 @@ -3481,7 +3481,7 @@
    74.4  by (auto simp add: perm_nat_def)
    74.5  
    74.6  lemma numeral_nat_eqvt: 
    74.7 - shows "pi\<bullet>((number_of n)::nat) = number_of n" 
    74.8 + shows "pi\<bullet>((numeral n)::nat) = numeral n" 
    74.9  by (simp add: perm_nat_def perm_int_def)
   74.10  
   74.11  lemma max_nat_eqvt:
   74.12 @@ -3523,7 +3523,11 @@
   74.13  by (simp add: perm_int_def)
   74.14  
   74.15  lemma numeral_int_eqvt: 
   74.16 - shows "pi\<bullet>((number_of n)::int) = number_of n" 
   74.17 + shows "pi\<bullet>((numeral n)::int) = numeral n" 
   74.18 +by (simp add: perm_int_def perm_int_def)
   74.19 +
   74.20 +lemma neg_numeral_int_eqvt:
   74.21 + shows "pi\<bullet>((neg_numeral n)::int) = neg_numeral n"
   74.22  by (simp add: perm_int_def perm_int_def)
   74.23  
   74.24  lemma max_int_eqvt:
   74.25 @@ -3589,7 +3593,7 @@
   74.26  (* the lemmas numeral_nat_eqvt numeral_int_eqvt do not conform with the *)
   74.27  (* usual form of an eqvt-lemma, but they are needed for analysing       *)
   74.28  (* permutations on nats and ints *)
   74.29 -lemmas [eqvt_force] = numeral_nat_eqvt numeral_int_eqvt
   74.30 +lemmas [eqvt_force] = numeral_nat_eqvt numeral_int_eqvt neg_numeral_int_eqvt
   74.31  
   74.32  (***************************************)
   74.33  (* setup for the individial atom-kinds *)
    75.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    75.2 +++ b/src/HOL/Num.thy	Mon Mar 26 15:33:28 2012 +0200
    75.3 @@ -0,0 +1,1021 @@
    75.4 +(*  Title:      HOL/Num.thy
    75.5 +    Author:     Florian Haftmann
    75.6 +    Author:     Brian Huffman
    75.7 +*)
    75.8 +
    75.9 +header {* Binary Numerals *}
   75.10 +
   75.11 +theory Num
   75.12 +imports Datatype Power
   75.13 +begin
   75.14 +
   75.15 +subsection {* The @{text num} type *}
   75.16 +
   75.17 +datatype num = One | Bit0 num | Bit1 num
   75.18 +
   75.19 +text {* Increment function for type @{typ num} *}
   75.20 +
   75.21 +primrec inc :: "num \<Rightarrow> num" where
   75.22 +  "inc One = Bit0 One" |
   75.23 +  "inc (Bit0 x) = Bit1 x" |
   75.24 +  "inc (Bit1 x) = Bit0 (inc x)"
   75.25 +
   75.26 +text {* Converting between type @{typ num} and type @{typ nat} *}
   75.27 +
   75.28 +primrec nat_of_num :: "num \<Rightarrow> nat" where
   75.29 +  "nat_of_num One = Suc 0" |
   75.30 +  "nat_of_num (Bit0 x) = nat_of_num x + nat_of_num x" |
   75.31 +  "nat_of_num (Bit1 x) = Suc (nat_of_num x + nat_of_num x)"
   75.32 +
   75.33 +primrec num_of_nat :: "nat \<Rightarrow> num" where
   75.34 +  "num_of_nat 0 = One" |
   75.35 +  "num_of_nat (Suc n) = (if 0 < n then inc (num_of_nat n) else One)"
   75.36 +
   75.37 +lemma nat_of_num_pos: "0 < nat_of_num x"
   75.38 +  by (induct x) simp_all
   75.39 +
   75.40 +lemma nat_of_num_neq_0: " nat_of_num x \<noteq> 0"
   75.41 +  by (induct x) simp_all
   75.42 +
   75.43 +lemma nat_of_num_inc: "nat_of_num (inc x) = Suc (nat_of_num x)"
   75.44 +  by (induct x) simp_all
   75.45 +
   75.46 +lemma num_of_nat_double:
   75.47 +  "0 < n \<Longrightarrow> num_of_nat (n + n) = Bit0 (num_of_nat n)"
   75.48 +  by (induct n) simp_all
   75.49 +
   75.50 +text {*
   75.51 +  Type @{typ num} is isomorphic to the strictly positive
   75.52 +  natural numbers.
   75.53 +*}
   75.54 +
   75.55 +lemma nat_of_num_inverse: "num_of_nat (nat_of_num x) = x"
   75.56 +  by (induct x) (simp_all add: num_of_nat_double nat_of_num_pos)
   75.57 +
   75.58 +lemma num_of_nat_inverse: "0 < n \<Longrightarrow> nat_of_num (num_of_nat n) = n"
   75.59 +  by (induct n) (simp_all add: nat_of_num_inc)
   75.60 +
   75.61 +lemma num_eq_iff: "x = y \<longleftrightarrow> nat_of_num x = nat_of_num y"
   75.62 +  apply safe
   75.63 +  apply (drule arg_cong [where f=num_of_nat])
   75.64 +  apply (simp add: nat_of_num_inverse)
   75.65 +  done
   75.66 +
   75.67 +lemma num_induct [case_names One inc]:
   75.68 +  fixes P :: "num \<Rightarrow> bool"
   75.69 +  assumes One: "P One"
   75.70 +    and inc: "\<And>x. P x \<Longrightarrow> P (inc x)"
   75.71 +  shows "P x"
   75.72 +proof -
   75.73 +  obtain n where n: "Suc n = nat_of_num x"
   75.74 +    by (cases "nat_of_num x", simp_all add: nat_of_num_neq_0)
   75.75 +  have "P (num_of_nat (Suc n))"
   75.76 +  proof (induct n)
   75.77 +    case 0 show ?case using One by simp
   75.78 +  next
   75.79 +    case (Suc n)
   75.80 +    then have "P (inc (num_of_nat (Suc n)))" by (rule inc)
   75.81 +    then show "P (num_of_nat (Suc (Suc n)))" by simp
   75.82 +  qed
   75.83 +  with n show "P x"
   75.84 +    by (simp add: nat_of_num_inverse)
   75.85 +qed
   75.86 +
   75.87 +text {*
   75.88 +  From now on, there are two possible models for @{typ num}:
   75.89 +  as positive naturals (rule @{text "num_induct"})
   75.90 +  and as digit representation (rules @{text "num.induct"}, @{text "num.cases"}).
   75.91 +*}
   75.92 +
   75.93 +
   75.94 +subsection {* Numeral operations *}
   75.95 +
   75.96 +instantiation num :: "{plus,times,linorder}"
   75.97 +begin
   75.98 +
   75.99 +definition [code del]:
  75.100 +  "m + n = num_of_nat (nat_of_num m + nat_of_num n)"
  75.101 +
  75.102 +definition [code del]:
  75.103 +  "m * n = num_of_nat (nat_of_num m * nat_of_num n)"
  75.104 +
  75.105 +definition [code del]:
  75.106 +  "m \<le> n \<longleftrightarrow> nat_of_num m \<le> nat_of_num n"
  75.107 +
  75.108 +definition [code del]:
  75.109 +  "m < n \<longleftrightarrow> nat_of_num m < nat_of_num n"
  75.110 +
  75.111 +instance
  75.112 +  by (default, auto simp add: less_num_def less_eq_num_def num_eq_iff)
  75.113 +
  75.114 +end
  75.115 +
  75.116 +lemma nat_of_num_add: "nat_of_num (x + y) = nat_of_num x + nat_of_num y"
  75.117 +  unfolding plus_num_def
  75.118 +  by (intro num_of_nat_inverse add_pos_pos nat_of_num_pos)
  75.119 +
  75.120 +lemma nat_of_num_mult: "nat_of_num (x * y) = nat_of_num x * nat_of_num y"
  75.121 +  unfolding times_num_def
  75.122 +  by (intro num_of_nat_inverse mult_pos_pos nat_of_num_pos)
  75.123 +
  75.124 +lemma add_num_simps [simp, code]:
  75.125 +  "One + One = Bit0 One"
  75.126 +  "One + Bit0 n = Bit1 n"
  75.127 +  "One + Bit1 n = Bit0 (n + One)"
  75.128 +  "Bit0 m + One = Bit1 m"
  75.129 +  "Bit0 m + Bit0 n = Bit0 (m + n)"
  75.130 +  "Bit0 m + Bit1 n = Bit1 (m + n)"
  75.131 +  "Bit1 m + One = Bit0 (m + One)"
  75.132 +  "Bit1 m + Bit0 n = Bit1 (m + n)"
  75.133 +  "Bit1 m + Bit1 n = Bit0 (m + n + One)"
  75.134 +  by (simp_all add: num_eq_iff nat_of_num_add)
  75.135 +
  75.136 +lemma mult_num_simps [simp, code]:
  75.137 +  "m * One = m"
  75.138 +  "One * n = n"
  75.139 +  "Bit0 m * Bit0 n = Bit0 (Bit0 (m * n))"
  75.140 +  "Bit0 m * Bit1 n = Bit0 (m * Bit1 n)"
  75.141 +  "Bit1 m * Bit0 n = Bit0 (Bit1 m * n)"
  75.142 +  "Bit1 m * Bit1 n = Bit1 (m + n + Bit0 (m * n))"
  75.143 +  by (simp_all add: num_eq_iff nat_of_num_add
  75.144 +    nat_of_num_mult left_distrib right_distrib)
  75.145 +
  75.146 +lemma eq_num_simps:
  75.147 +  "One = One \<longleftrightarrow> True"
  75.148 +  "One = Bit0 n \<longleftrightarrow> False"
  75.149 +  "One = Bit1 n \<longleftrightarrow> False"
  75.150 +  "Bit0 m = One \<longleftrightarrow> False"
  75.151 +  "Bit1 m = One \<longleftrightarrow> False"
  75.152 +  "Bit0 m = Bit0 n \<longleftrightarrow> m = n"
  75.153 +  "Bit0 m = Bit1 n \<longleftrightarrow> False"
  75.154 +  "Bit1 m = Bit0 n \<longleftrightarrow> False"
  75.155 +  "Bit1 m = Bit1 n \<longleftrightarrow> m = n"
  75.156 +  by simp_all
  75.157 +
  75.158 +lemma le_num_simps [simp, code]:
  75.159 +  "One \<le> n \<longleftrightarrow> True"
  75.160 +  "Bit0 m \<le> One \<longleftrightarrow> False"
  75.161 +  "Bit1 m \<le> One \<longleftrightarrow> False"
  75.162 +  "Bit0 m \<le> Bit0 n \<longleftrightarrow> m \<le> n"
  75.163 +  "Bit0 m \<le> Bit1 n \<longleftrightarrow> m \<le> n"
  75.164 +  "Bit1 m \<le> Bit1 n \<longleftrightarrow> m \<le> n"
  75.165 +  "Bit1 m \<le> Bit0 n \<longleftrightarrow> m < n"
  75.166 +  using nat_of_num_pos [of n] nat_of_num_pos [of m]
  75.167 +  by (auto simp add: less_eq_num_def less_num_def)
  75.168 +
  75.169 +lemma less_num_simps [simp, code]:
  75.170 +  "m < One \<longleftrightarrow> False"
  75.171 +  "One < Bit0 n \<longleftrightarrow> True"
  75.172 +  "One < Bit1 n \<longleftrightarrow> True"
  75.173 +  "Bit0 m < Bit0 n \<longleftrightarrow> m < n"
  75.174 +  "Bit0 m < Bit1 n \<longleftrightarrow> m \<le> n"
  75.175 +  "Bit1 m < Bit1 n \<longleftrightarrow> m < n"
  75.176 +  "Bit1 m < Bit0 n \<longleftrightarrow> m < n"
  75.177 +  using nat_of_num_pos [of n] nat_of_num_pos [of m]
  75.178 +  by (auto simp add: less_eq_num_def less_num_def)
  75.179 +
  75.180 +text {* Rules using @{text One} and @{text inc} as constructors *}
  75.181 +
  75.182 +lemma add_One: "x + One = inc x"
  75.183 +  by (simp add: num_eq_iff nat_of_num_add nat_of_num_inc)
  75.184 +
  75.185 +lemma add_One_commute: "One + n = n + One"
  75.186 +  by (induct n) simp_all
  75.187 +
  75.188 +lemma add_inc: "x + inc y = inc (x + y)"
  75.189 +  by (simp add: num_eq_iff nat_of_num_add nat_of_num_inc)
  75.190 +
  75.191 +lemma mult_inc: "x * inc y = x * y + x"
  75.192 +  by (simp add: num_eq_iff nat_of_num_mult nat_of_num_add nat_of_num_inc)
  75.193 +
  75.194 +text {* The @{const num_of_nat} conversion *}
  75.195 +
  75.196 +lemma num_of_nat_One:
  75.197 +  "n \<le> 1 \<Longrightarrow> num_of_nat n = Num.One"
  75.198 +  by (cases n) simp_all
  75.199 +
  75.200 +lemma num_of_nat_plus_distrib:
  75.201 +  "0 < m \<Longrightarrow> 0 < n \<Longrightarrow> num_of_nat (m + n) = num_of_nat m + num_of_nat n"
  75.202 +  by (induct n) (auto simp add: add_One add_One_commute add_inc)
  75.203 +
  75.204 +text {* A double-and-decrement function *}
  75.205 +
  75.206 +primrec BitM :: "num \<Rightarrow> num" where
  75.207 +  "BitM One = One" |
  75.208 +  "BitM (Bit0 n) = Bit1 (BitM n)" |
  75.209 +  "BitM (Bit1 n) = Bit1 (Bit0 n)"
  75.210 +
  75.211 +lemma BitM_plus_one: "BitM n + One = Bit0 n"
  75.212 +  by (induct n) simp_all
  75.213 +
  75.214 +lemma one_plus_BitM: "One + BitM n = Bit0 n"
  75.215 +  unfolding add_One_commute BitM_plus_one ..
  75.216 +
  75.217 +text {* Squaring and exponentiation *}
  75.218 +
  75.219 +primrec sqr :: "num \<Rightarrow> num" where
  75.220 +  "sqr One = One" |
  75.221 +  "sqr (Bit0 n) = Bit0 (Bit0 (sqr n))" |
  75.222 +  "sqr (Bit1 n) = Bit1 (Bit0 (sqr n + n))"
  75.223 +
  75.224 +primrec pow :: "num \<Rightarrow> num \<Rightarrow> num" where
  75.225 +  "pow x One = x" |
  75.226 +  "pow x (Bit0 y) = sqr (pow x y)" |
  75.227 +  "pow x (Bit1 y) = x * sqr (pow x y)"
  75.228 +
  75.229 +lemma nat_of_num_sqr: "nat_of_num (sqr x) = nat_of_num x * nat_of_num x"
  75.230 +  by (induct x, simp_all add: algebra_simps nat_of_num_add)
  75.231 +
  75.232 +lemma sqr_conv_mult: "sqr x = x * x"
  75.233 +  by (simp add: num_eq_iff nat_of_num_sqr nat_of_num_mult)
  75.234 +
  75.235 +
  75.236 +subsection {* Numary numerals *}
  75.237 +
  75.238 +text {*
  75.239 +  We embed numary representations into a generic algebraic
  75.240 +  structure using @{text numeral}.
  75.241 +*}
  75.242 +
  75.243 +class numeral = one + semigroup_add
  75.244 +begin
  75.245 +
  75.246 +primrec numeral :: "num \<Rightarrow> 'a" where
  75.247 +  numeral_One: "numeral One = 1" |
  75.248 +  numeral_Bit0: "numeral (Bit0 n) = numeral n + numeral n" |
  75.249 +  numeral_Bit1: "numeral (Bit1 n) = numeral n + numeral n + 1"
  75.250 +
  75.251 +lemma one_plus_numeral_commute: "1 + numeral x = numeral x + 1"
  75.252 +  apply (induct x)
  75.253 +  apply simp
  75.254 +  apply (simp add: add_assoc [symmetric], simp add: add_assoc)
  75.255 +  apply (simp add: add_assoc [symmetric], simp add: add_assoc)
  75.256 +  done
  75.257 +
  75.258 +lemma numeral_inc: "numeral (inc x) = numeral x + 1"
  75.259 +proof (induct x)
  75.260 +  case (Bit1 x)
  75.261 +  have "numeral x + (1 + numeral x) + 1 = numeral x + (numeral x + 1) + 1"
  75.262 +    by (simp only: one_plus_numeral_commute)
  75.263 +  with Bit1 show ?case
  75.264 +    by (simp add: add_assoc)
  75.265 +qed simp_all
  75.266 +
  75.267 +declare numeral.simps [simp del]
  75.268 +
  75.269 +abbreviation "Numeral1 \<equiv> numeral One"
  75.270 +
  75.271 +declare numeral_One [code_post]
  75.272 +
  75.273 +end
  75.274 +
  75.275 +text {* Negative numerals. *}
  75.276 +
  75.277 +class neg_numeral = numeral + group_add
  75.278 +begin
  75.279 +
  75.280 +definition neg_numeral :: "num \<Rightarrow> 'a" where
  75.281 +  "neg_numeral k = - numeral k"
  75.282 +
  75.283 +end
  75.284 +
  75.285 +text {* Numeral syntax. *}
  75.286 +
  75.287 +syntax
  75.288 +  "_Numeral" :: "num_const \<Rightarrow> 'a"    ("_")
  75.289 +
  75.290 +parse_translation {*
  75.291 +let
  75.292 +  fun num_of_int n = if n > 0 then case IntInf.quotRem (n, 2)
  75.293 +     of (0, 1) => Syntax.const @{const_name One}
  75.294 +      | (n, 0) => Syntax.const @{const_name Bit0} $ num_of_int n
  75.295 +      | (n, 1) => Syntax.const @{const_name Bit1} $ num_of_int n
  75.296 +    else raise Match;
  75.297 +  val pos = Syntax.const @{const_name numeral}
  75.298 +  val neg = Syntax.const @{const_name neg_numeral}
  75.299 +  val one = Syntax.const @{const_name Groups.one}
  75.300 +  val zero = Syntax.const @{const_name Groups.zero}
  75.301 +  fun numeral_tr [(c as Const (@{syntax_const "_constrain"}, _)) $ t $ u] =
  75.302 +        c $ numeral_tr [t] $ u
  75.303 +    | numeral_tr [Const (num, _)] =
  75.304 +        let
  75.305 +          val {value, ...} = Lexicon.read_xnum num;
  75.306 +        in
  75.307 +          if value = 0 then zero else
  75.308 +          if value > 0
  75.309 +          then pos $ num_of_int value
  75.310 +          else neg $ num_of_int (~value)
  75.311 +        end
  75.312 +    | numeral_tr ts = raise TERM ("numeral_tr", ts);
  75.313 +in [("_Numeral", numeral_tr)] end
  75.314 +*}
  75.315 +
  75.316 +typed_print_translation (advanced) {*
  75.317 +let
  75.318 +  fun dest_num (Const (@{const_syntax Bit0}, _) $ n) = 2 * dest_num n
  75.319 +    | dest_num (Const (@{const_syntax Bit1}, _) $ n) = 2 * dest_num n + 1
  75.320 +    | dest_num (Const (@{const_syntax One}, _)) = 1;
  75.321 +  fun num_tr' sign ctxt T [n] =
  75.322 +    let
  75.323 +      val k = dest_num n;
  75.324 +      val t' = Syntax.const @{syntax_const "_Numeral"} $
  75.325 +        Syntax.free (sign ^ string_of_int k);
  75.326 +    in
  75.327 +      case T of
  75.328 +        Type (@{type_name fun}, [_, T']) =>
  75.329 +          if not (Config.get ctxt show_types) andalso can Term.dest_Type T' then t'
  75.330 +          else Syntax.const @{syntax_const "_constrain"} $ t' $ Syntax_Phases.term_of_typ ctxt T'
  75.331 +      | T' => if T' = dummyT then t' else raise Match
  75.332 +    end;
  75.333 +in [(@{const_syntax numeral}, num_tr' ""),
  75.334 +    (@{const_syntax neg_numeral}, num_tr' "-")] end
  75.335 +*}
  75.336 +
  75.337 +subsection {* Class-specific numeral rules *}
  75.338 +
  75.339 +text {*
  75.340 +  @{const numeral} is a morphism.
  75.341 +*}
  75.342 +
  75.343 +subsubsection {* Structures with addition: class @{text numeral} *}
  75.344 +
  75.345 +context numeral
  75.346 +begin
  75.347 +
  75.348 +lemma numeral_add: "numeral (m + n) = numeral m + numeral n"
  75.349 +  by (induct n rule: num_induct)
  75.350 +     (simp_all only: numeral_One add_One add_inc numeral_inc add_assoc)
  75.351 +
  75.352 +lemma numeral_plus_numeral: "numeral m + numeral n = numeral (m + n)&quo