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_Im_number_of [simp]: "Im (number_of v) = 0"
12.31 - unfolding number_of_eq by (rule complex_Im_of_int)
12.32 +lemma complex_Re_neg_numeral [simp]: "Re (neg_numeral v) = neg_numeral v"
12.33 + using complex_Re_of_int [of "neg_numeral v"] by simp
12.34
12.35 -lemma Complex_eq_number_of [simp]:
12.36 - "(Complex a b = number_of w) = (a = number_of w \<and> b = 0)"
12.37 +lemma complex_Im_numeral [simp]: "Im (numeral v) = 0"
12.38 + using complex_Im_of_int [of "numeral v"] by simp
12.39 +
12.40 +lemma complex_Im_neg_numeral [simp]: "Im (neg_numeral v) = 0"
12.41 + using complex_Im_of_int [of "neg_numeral v"] by simp
12.42 +
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 -
31.68 -definition Min :: int where
31.69 - "Min = - 1"
31.70 -
31.71 -definition Bit0 :: "int \<Rightarrow> int" where
31.72 - "Bit0 k = k + k"
31.73 -
31.74 -definition Bit1 :: "int \<Rightarrow> int" where
31.75 - "Bit1 k = 1 + k + k"
31.76 -
31.77 -class number = -- {* for numeric types: nat, int, real, \dots *}
31.78 - fixes number_of :: "int \<Rightarrow> 'a"
31.79 -
31.80 -use "Tools/numeral.ML"
31.81 -
31.82 -syntax
31.83 - "_Numeral" :: "num_const \<Rightarrow> 'a" ("_")
31.84 -
31.85 -use "Tools/numeral_syntax.ML"
31.86 -setup Numeral_Syntax.setup
31.87 -
31.88 -abbreviation
31.89 - "Numeral0 \<equiv> number_of Pls"
31.90 -
31.91 -abbreviation
31.92 - "Numeral1 \<equiv> number_of (Bit1 Pls)"
31.93 -
31.94 -lemma Let_number_of [simp]: "Let (number_of v) f = f (number_of v)"
31.95 +lemma Let_numeral [simp]: "Let (numeral v) f = f (numeral v)"
31.96 -- {* Unfold all @{text let}s involving constants *}
31.97 unfolding Let_def ..
31.98
31.99 -definition succ :: "int \<Rightarrow> int" where
31.100 - "succ k = k + 1"
31.101 +lemma Let_neg_numeral [simp]: "Let (neg_numeral v) f = f (neg_numeral v)"
31.102 + -- {* Unfold all @{text let}s involving constants *}
31.103 + unfolding Let_def ..
31.104
31.105 -definition pred :: "int \<Rightarrow> int" where
31.106 - "pred k = k - 1"
31.107 +text {* Unfold @{text min} and @{text max} on numerals. *}
31.108
31.109 -lemmas max_number_of [simp] = max_def [of "number_of u" "number_of v"]
31.110 - and min_number_of [simp] = min_def [of "number_of u" "number_of v"]
31.111 - for u v
31.112 - -- {* unfolding @{text minx} and @{text max} on numerals *}
31.113 +lemmas max_number_of [simp] =
31.114 + max_def [of "numeral u" "numeral v"]
31.115 + max_def [of "numeral u" "neg_numeral v"]
31.116 + max_def [of "neg_numeral u" "numeral v"]
31.117 + max_def [of "neg_numeral u" "neg_numeral v"] for u v
31.118
31.119 -lemmas numeral_simps =
31.120 - succ_def pred_def Pls_def Min_def Bit0_def Bit1_def
31.121 -
31.122 -text {* Removal of leading zeroes *}
31.123 -
31.124 -lemma Bit0_Pls [simp, code_post]:
31.125 - "Bit0 Pls = Pls"
31.126 - unfolding numeral_simps by simp
31.127 -
31.128 -lemma Bit1_Min [simp, code_post]:
31.129 - "Bit1 Min = Min"
31.130 - unfolding numeral_simps by simp
31.131 -
31.132 -lemmas normalize_bin_simps =
31.133 - Bit0_Pls Bit1_Min
31.134 -
31.135 -
31.136 -subsubsection {* Successor and predecessor functions *}
31.137 -
31.138 -text {* Successor *}
31.139 -
31.140 -lemma succ_Pls:
31.141 - "succ Pls = Bit1 Pls"
31.142 - unfolding numeral_simps by simp
31.143 -
31.144 -lemma succ_Min:
31.145 - "succ Min = Pls"
31.146 - unfolding numeral_simps by simp
31.147 -
31.148 -lemma succ_Bit0:
31.149 - "succ (Bit0 k) = Bit1 k"
31.150 - unfolding numeral_simps by simp
31.151 -
31.152 -lemma succ_Bit1:
31.153 - "succ (Bit1 k) = Bit0 (succ k)"
31.154 - unfolding numeral_simps by simp
31.155 -
31.156 -lemmas succ_bin_simps [simp] =
31.157 - succ_Pls succ_Min succ_Bit0 succ_Bit1
31.158 -
31.159 -text {* Predecessor *}
31.160 -
31.161 -lemma pred_Pls:
31.162 - "pred Pls = Min"
31.163 - unfolding numeral_simps by simp
31.164 -
31.165 -lemma pred_Min:
31.166 - "pred Min = Bit0 Min"
31.167 - unfolding numeral_simps by simp
31.168 -
31.169 -lemma pred_Bit0:
31.170 - "pred (Bit0 k) = Bit1 (pred k)"
31.171 - unfolding numeral_simps by simp
31.172 -
31.173 -lemma pred_Bit1:
31.174 - "pred (Bit1 k) = Bit0 k"
31.175 - unfolding numeral_simps by simp
31.176 -
31.177 -lemmas pred_bin_simps [simp] =
31.178 - pred_Pls pred_Min pred_Bit0 pred_Bit1
31.179 -
31.180 -
31.181 -subsubsection {* Binary arithmetic *}
31.182 -
31.183 -text {* Addition *}
31.184 -
31.185 -lemma add_Pls:
31.186 - "Pls + k = k"
31.187 - unfolding numeral_simps by simp
31.188 -
31.189 -lemma add_Min:
31.190 - "Min + k = pred k"
31.191 - unfolding numeral_simps by simp
31.192 -
31.193 -lemma add_Bit0_Bit0:
31.194 - "(Bit0 k) + (Bit0 l) = Bit0 (k + l)"
31.195 - unfolding numeral_simps by simp
31.196 -
31.197 -lemma add_Bit0_Bit1:
31.198 - "(Bit0 k) + (Bit1 l) = Bit1 (k + l)"
31.199 - unfolding numeral_simps by simp
31.200 -
31.201 -lemma add_Bit1_Bit0:
31.202 - "(Bit1 k) + (Bit0 l) = Bit1 (k + l)"
31.203 - unfolding numeral_simps by simp
31.204 -
31.205 -lemma add_Bit1_Bit1:
31.206 - "(Bit1 k) + (Bit1 l) = Bit0 (k + succ l)"
31.207 - unfolding numeral_simps by simp
31.208 -
31.209 -lemma add_Pls_right:
31.210 - "k + Pls = k"
31.211 - unfolding numeral_simps by simp
31.212 -
31.213 -lemma add_Min_right:
31.214 - "k + Min = pred k"
31.215 - unfolding numeral_simps by simp
31.216 -
31.217 -lemmas add_bin_simps [simp] =
31.218 - add_Pls add_Min add_Pls_right add_Min_right
31.219 - add_Bit0_Bit0 add_Bit0_Bit1 add_Bit1_Bit0 add_Bit1_Bit1
31.220 -
31.221 -text {* Negation *}
31.222 -
31.223 -lemma minus_Pls:
31.224 - "- Pls = Pls"
31.225 - unfolding numeral_simps by simp
31.226 -
31.227 -lemma minus_Min:
31.228 - "- Min = Bit1 Pls"
31.229 - unfolding numeral_simps by simp
31.230 -
31.231 -lemma minus_Bit0:
31.232 - "- (Bit0 k) = Bit0 (- k)"
31.233 - unfolding numeral_simps by simp
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 +lemma mult_2: "2 * z = (z+z::'a::semiring_1)"
31.886 +unfolding one_add_one [symmetric] left_distrib by simp
31.887
31.888 -lemma semiring_mult_2_right: "z * 2 = (z+z::'a::number_semiring)"
31.889 -by (subst mult_commute, rule semiring_mult_2)
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 -lemmas pred_succ_numeral_code [code] =
31.1157 - pred_bin_simps succ_bin_simps
31.1158 +definition Pos :: "num \<Rightarrow> int" where
31.1159 + [simp, code_abbrev]: "Pos = numeral"
31.1160
31.1161 -lemmas plus_numeral_code [code] =
31.1162 - add_bin_simps
31.1163 - arith_extra_simps(1) [where 'a = int]
31.1164 +definition Neg :: "num \<Rightarrow> int" where
31.1165 + [simp, code_abbrev]: "Neg = neg_numeral"
31.1166
31.1167 -lemmas minus_numeral_code [code] =
31.1168 - minus_bin_simps
31.1169 - arith_extra_simps(2) [where 'a = int]
31.1170 - arith_extra_simps(5) [where 'a = int]
31.1171 +code_datatype "0::int" Pos Neg
31.1172
31.1173 -lemmas times_numeral_code [code] =
31.1174 - mult_bin_simps
31.1175 - arith_extra_simps(4) [where 'a = int]
31.1176 +
31.1177 +text {* Auxiliary operations *}
31.1178 +
31.1179 +definition dup :: "int \<Rightarrow> int" where
31.1180 + [simp]: "dup k = k + k"
31.1181 +
31.1182 +lemma dup_code [code]:
31.1183 + "dup 0 = 0"
31.1184 + "dup (Pos n) = Pos (Num.Bit0 n)"
31.1185 + "dup (Neg n) = Neg (Num.Bit0 n)"
31.1186 + unfolding Pos_def Neg_def neg_numeral_def
31.1187 + by (simp_all add: numeral_Bit0)
31.1188 +
31.1189 +definition sub :: "num \<Rightarrow> num \<Rightarrow> int" where
31.1190 + [simp]: "sub m n = numeral m - numeral n"
31.1191 +
31.1192 +lemma sub_code [code]:
31.1193 + "sub Num.One Num.One = 0"
31.1194 + "sub (Num.Bit0 m) Num.One = Pos (Num.BitM m)"
31.1195 + "sub (Num.Bit1 m) Num.One = Pos (Num.Bit0 m)"
31.1196 + "sub Num.One (Num.Bit0 n) = Neg (Num.BitM n)"
31.1197 + "sub Num.One (Num.Bit1 n) = Neg (Num.Bit0 n)"
31.1198 + "sub (Num.Bit0 m) (Num.Bit0 n) = dup (sub m n)"
31.1199 + "sub (Num.Bit1 m) (Num.Bit1 n) = dup (sub m n)"
31.1200 + "sub (Num.Bit1 m) (Num.Bit0 n) = dup (sub m n) + 1"
31.1201 + "sub (Num.Bit0 m) (Num.Bit1 n) = dup (sub m n) - 1"
31.1202 + unfolding sub_def dup_def numeral.simps Pos_def Neg_def
31.1203 + neg_numeral_def numeral_BitM
31.1204 + by (simp_all only: algebra_simps)
31.1205 +
31.1206 +
31.1207 +text {* Implementations *}
31.1208 +
31.1209 +lemma one_int_code [code, code_unfold]:
31.1210 + "1 = Pos Num.One"
31.1211 + by simp
31.1212 +
31.1213 +lemma plus_int_code [code]:
31.1214 + "k + 0 = (k::int)"
31.1215 + "0 + l = (l::int)"
31.1216 + "Pos m + Pos n = Pos (m + n)"
31.1217 + "Pos m + Neg n = sub m n"
31.1218 + "Neg m + Pos n = sub n m"
31.1219 + "Neg m + Neg n = Neg (m + n)"
31.1220 + by simp_all
31.1221 +
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 +lemma nat_numeral [simp, code_abbrev]:
31.1366 + "nat (numeral k) = numeral k"
31.1367 + by (simp add: nat_eq_iff)
31.1368
31.1369 -lemma [code]:
31.1370 - "nat_aux i n = (if i \<le> 0 then n else nat_aux (i - 1) (Suc n))" -- {* tail recursive *}
31.1371 - by (auto simp add: nat_aux_def nat_eq_iff linorder_not_le order_less_imp_le
31.1372 - dest: zless_imp_add1_zle)
31.1373 +lemma nat_code [code]:
31.1374 + "nat (Int.Neg k) = 0"
31.1375 + "nat 0 = 0"
31.1376 + "nat (Int.Pos k) = nat_of_num k"
31.1377 + by (simp_all add: nat_of_num_numeral nat_numeral)
31.1378
31.1379 -lemma [code]: "nat i = nat_aux i 0"
31.1380 - by (simp add: nat_aux_def)
31.1381 +lemma (in ring_1) of_int_code [code]:
31.1382 + "of_int (Int.Neg k) = neg_numeral k"
31.1383 + "of_int 0 = 0"
31.1384 + "of_int (Int.Pos k) = numeral k"
31.1385 + by simp_all
31.1386
31.1387 -hide_const (open) nat_aux
31.1388
31.1389 -lemma zero_is_num_zero [code, code_unfold]:
31.1390 - "(0\<Colon>int) = Numeral0"
31.1391 - by simp
31.1392 -
31.1393 -lemma one_is_num_one [code, code_unfold]:
31.1394 - "(1\<Colon>int) = Numeral1"
31.1395 - by simp
31.1396 +text {* Serializer setup *}
31.1397
31.1398 code_modulename SML
31.1399 Int Arith
31.1400 @@ -2345,7 +1719,7 @@
31.1401
31.1402 quickcheck_params [default_type = int]
31.1403
31.1404 -hide_const (open) Pls Min Bit0 Bit1 succ pred
31.1405 +hide_const (open) Pos Neg sub dup
31.1406
31.1407
31.1408 subsection {* Legacy theorems *}
31.1409 @@ -2378,3 +1752,4 @@
31.1410 lemmas zpower_int = int_power [symmetric]
31.1411
31.1412 end
31.1413 +
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_number_of_even [simp]: "number_of (Int.Bit0 w) = (0 :: bit)"
35.25 - by (simp only: number_of_Bit0 add_0_left bit_add_self)
35.26 +lemma bit_neg_numeral [simp]: "(neg_numeral w :: bit) = numeral w"
35.27 + by (simp only: neg_numeral_def uminus_bit_def)
35.28
35.29 -lemma bit_number_of_odd [simp]: "number_of (Int.Bit1 w) = (1 :: bit)"
35.30 - by (simp only: number_of_Bit1 add_assoc bit_add_self
35.31 - monoid_add_class.add_0_right)
35.32 +lemma bit_numeral_even [simp]: "numeral (Num.Bit0 w) = (0 :: bit)"
35.33 + by (simp only: numeral_Bit0 bit_add_self)
35.34 +
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,43 +61,22 @@
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 + fold (Numeral.add_code @{const_name Int.Pos}
37.60 + false Code_Printer.literal_numeral) ["SML", "OCaml", "Haskell", "Scala"]
37.61 +*}
37.62 +
37.63 +setup {*
37.64 + fold (Numeral.add_code @{const_name Int.Neg}
37.65 true Code_Printer.literal_numeral) ["SML", "OCaml", "Haskell", "Scala"]
37.66 *}
37.67
37.68 -code_const "Int.Pls" and "Int.Min" and "Int.Bit0" and "Int.Bit1"
37.69 - (SML "raise/ Fail/ \"Pls\""
37.70 - and "raise/ Fail/ \"Min\""
37.71 - and "!((_);/ raise/ Fail/ \"Bit0\")"
37.72 - and "!((_);/ raise/ Fail/ \"Bit1\")")
37.73 - (OCaml "failwith/ \"Pls\""
37.74 - and "failwith/ \"Min\""
37.75 - and "!((_);/ failwith/ \"Bit0\")"
37.76 - and "!((_);/ failwith/ \"Bit1\")")
37.77 - (Haskell "error/ \"Pls\""
37.78 - and "error/ \"Min\""
37.79 - and "error/ \"Bit0\""
37.80 - and "error/ \"Bit1\"")
37.81 - (Scala "!error(\"Pls\")"
37.82 - and "!error(\"Min\")"
37.83 - and "!error(\"Bit0\")"
37.84 - and "!error(\"Bit1\")")
37.85 -
37.86 -code_const Int.pred
37.87 - (SML "IntInf.- ((_), 1)")
37.88 - (OCaml "Big'_int.pred'_big'_int")
37.89 - (Haskell "!(_/ -/ 1)")
37.90 - (Scala "!(_ -/ 1)")
37.91 - (Eval "!(_/ -/ 1)")
37.92 -
37.93 -code_const Int.succ
37.94 - (SML "IntInf.+ ((_), 1)")
37.95 - (OCaml "Big'_int.succ'_big'_int")
37.96 - (Haskell "!(_/ +/ 1)")
37.97 - (Scala "!(_ +/ 1)")
37.98 - (Eval "!(_/ +/ 1)")
37.99 -
37.100 code_const "op + \<Colon> int \<Rightarrow> int \<Rightarrow> int"
37.101 (SML "IntInf.+ ((_), (_))")
37.102 (OCaml "Big'_int.add'_big'_int")
37.103 @@ -82,6 +98,19 @@
37.104 (Scala infixl 7 "-")
37.105 (Eval infixl 8 "-")
37.106
37.107 +code_const Int.dup
37.108 + (SML "IntInf.*/ (2,/ (_))")
37.109 + (OCaml "Big'_int.mult'_big'_int/ 2")
37.110 + (Haskell "!(2 * _)")
37.111 + (Scala "!(2 * _)")
37.112 + (Eval "!(2 * _)")
37.113 +
37.114 +code_const Int.sub
37.115 + (SML "!(raise/ Fail/ \"sub\")")
37.116 + (OCaml "failwith/ \"sub\"")
37.117 + (Haskell "error/ \"sub\"")
37.118 + (Scala "!error(\"sub\")")
37.119 +
37.120 code_const "op * \<Colon> int \<Rightarrow> int \<Rightarrow> int"
37.121 (SML "IntInf.* ((_), (_))")
37.122 (OCaml "Big'_int.mult'_big'_int")
37.123 @@ -124,9 +153,7 @@
37.124 (Scala "!_.as'_BigInt")
37.125 (Eval "_")
37.126
37.127 -text {* Evaluation *}
37.128 -
37.129 code_const "Code_Evaluation.term_of \<Colon> int \<Rightarrow> term"
37.130 (Eval "HOLogic.mk'_number/ HOLogic.intT")
37.131
37.132 -end
37.133 \ No newline at end of file
37.134 +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,10 +129,24 @@
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 +lemma [code_unfold del]:
41.8 + "0 \<equiv> (of_rat 0 :: real)"
41.9 + by simp
41.10 +
41.11 +lemma [code_unfold del]:
41.12 + "1 \<equiv> (of_rat 1 :: real)"
41.13 + by simp
41.14 +
41.15 +lemma [code_unfold del]:
41.16 + "numeral k \<equiv> (of_rat (numeral k) :: real)"
41.17 + by simp
41.18 +
41.19 +lemma [code_unfold del]:
41.20 + "neg_numeral k \<equiv> (of_rat (neg_numeral k) :: real)"
41.21 + by simp
41.22 +
41.23 hide_const (open) real_of_int
41.24
41.25 -declare number_of_real_code [code_unfold del]
41.26 -
41.27 notepad
41.28 begin
41.29 have "cos (pi/2) = 0" by (rule cos_pi_half)
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 -code_const "op + \<Colon> nat \<Rightarrow> nat \<Rightarrow> nat"
42.287 - (SML "IntInf.+ ((_), (_))")
42.288 +subsection {* Target language arithmetic *}
42.289 +
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 +lemmas compute_natarith =
57.118 + arith_simps rel_simps
57.119 + diff_nat_numeral nat_numeral nat_0 nat_neg_numeral
57.120 + numeral_1_eq_1 [symmetric]
57.121 + numeral_1_eq_Suc_0 [symmetric]
57.122 + Suc_numeral natfac.simps
57.123
57.124 -lemma number_eq: "(((number_of x)::'a::{number_ring, linordered_idom}) = (number_of y)) = (x = y)"
57.125 - unfolding number_of_eq
57.126 - apply simp
57.127 - done
57.128 +lemmas number_norm = numeral_1_eq_1[symmetric]
57.129
57.130 -lemma number_le: "(((number_of x)::'a::{number_ring, linordered_idom}) \<le> (number_of y)) = (x \<le> y)"
57.131 - unfolding number_of_eq
57.132 - apply simp
57.133 - done
57.134 +lemmas compute_numberarith =
57.135 + arith_simps rel_simps number_norm
57.136
57.137 -lemma number_less: "(((number_of x)::'a::{number_ring, linordered_idom}) < (number_of y)) = (x < y)"
57.138 - unfolding number_of_eq
57.139 - apply simp
57.140 - done
57.141 +lemmas compute_num_conversions =
57.142 + real_of_nat_numeral real_of_nat_zero
57.143 + nat_numeral nat_0 nat_neg_numeral
57.144 + real_numeral real_of_int_zero
57.145
57.146 -lemma number_diff: "((number_of x)::'a::{number_ring, linordered_idom}) - number_of y = number_of (x + (- y))"
57.147 - apply (subst diff_number_of_eq)
57.148 - apply simp
57.149 - done
57.150 -
57.151 -lemmas number_norm = number_of_Pls[symmetric] numeral_1_eq_1[symmetric]
57.152 -
57.153 -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.154 -
57.155 -lemma compute_real_of_nat_number_of: "real ((number_of v)::nat) = (if neg v then 0 else number_of v)"
57.156 - by (simp only: real_of_nat_number_of number_of_is_id)
57.157 -
57.158 -lemma compute_nat_of_int_number_of: "nat ((number_of v)::int) = (number_of v)"
57.159 - by simp
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_number_of_hcmod [simp]:
69.30 - "hcmod(number_of v :: hcomplex) = abs (number_of v :: hypreal)"
69.31 -by transfer (rule norm_number_of)
69.32 +lemma hcomplex_numeral_hcnj [simp]:
69.33 + "hcnj (numeral v :: hcomplex) = numeral v"
69.34 +by transfer (rule complex_cnj_numeral)
69.35
69.36 -lemma hcomplex_number_of_hRe [simp]:
69.37 - "hRe(number_of v :: hcomplex) = number_of v"
69.38 -by transfer (rule complex_Re_number_of)
69.39 +lemma hcomplex_numeral_hcmod [simp]:
69.40 + "hcmod(numeral v :: hcomplex) = (numeral v :: hypreal)"
69.41 +by transfer (rule norm_numeral)
69.42
69.43 -lemma hcomplex_number_of_hIm [simp]:
69.44 - "hIm(number_of v :: hcomplex) = 0"
69.45 -by transfer (rule complex_Im_number_of)
69.46 +lemma hcomplex_neg_numeral_hcmod [simp]:
69.47 + "hcmod(neg_numeral v :: hcomplex) = (numeral v :: hypreal)"
69.48 +by transfer (rule norm_neg_numeral)
69.49
69.50 +lemma hcomplex_numeral_hRe [simp]:
69.51 + "hRe(numeral v :: hcomplex) = numeral v"
69.52 +by transfer (rule complex_Re_numeral)
69.53 +
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 + "Suc (numeral v + n) = numeral (v + Num.One) + n"
72.185 + by simp
72.186
72.187 -lemma Suc_nat_number_of [simp]:
72.188 - "Suc (number_of v) =
72.189 - (if neg (number_of v :: int) then 1 else number_of (Int.succ v))"
72.190 -apply (cut_tac n = 0 in Suc_nat_number_of_add)
72.191 -apply (simp cong del: if_weak_cong)
72.192 -done
72.193 -
72.194 -
72.195 -subsubsection{*Addition *}
72.196 -
72.197 -lemma add_nat_number_of [simp]:
72.198 - "(number_of v :: nat) + number_of v' =
72.199 - (if v < Int.Pls then number_of v'
72.200 - else if v' < Int.Pls then number_of v
72.201 - else number_of (v + v'))"
72.202 - unfolding nat_number_of_def number_of_is_id numeral_simps
72.203 - by (simp add: nat_add_distrib)
72.204 -
72.205 -lemma nat_number_of_add_1 [simp]:
72.206 - "number_of v + (1::nat) =
72.207 - (if v < Int.Pls then 1 else number_of (Int.succ v))"
72.208 - unfolding nat_number_of_def number_of_is_id numeral_simps
72.209 - by (simp add: nat_add_distrib)
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 + if d < 0 then 0 else nat d)"
72.257 +by (simp add: Let_def nat_diff_distrib [symmetric])
72.258
72.259 +(* Int.nat_diff_distrib has too-strong premises *)
72.260 +lemma nat_diff_distrib': "\<lbrakk>0 \<le> x; 0 \<le> y\<rbrakk> \<Longrightarrow> nat (x - y) = nat x - nat y"
72.261 +apply (rule int_int_eq [THEN iffD1], clarsimp)
72.262 +apply (subst zdiff_int [symmetric])
72.263 +apply (rule nat_mono, simp_all)
72.264 +done
72.265
72.266 -lemma diff_nat_number_of [simp]:
72.267 - "(number_of v :: nat) - number_of v' =
72.268 - (if v' < Int.Pls then number_of v
72.269 - else let d = number_of (v + uminus v') in
72.270 - if neg d then 0 else nat d)"
72.271 - unfolding nat_number_of_def number_of_is_id numeral_simps neg_def
72.272 - by auto
72.273 +lemma diff_nat_numeral [simp]:
72.274 + "(numeral v :: nat) - numeral v' = nat (numeral v - numeral v')"
72.275 + by (simp only: nat_diff_distrib' zero_le_numeral nat_numeral)
72.276
72.277 -lemma nat_number_of_diff_1 [simp]:
72.278 - "number_of v - (1::nat) =
72.279 - (if v \<le> Int.Pls then 0 else number_of (Int.pred v))"
72.280 - unfolding nat_number_of_def number_of_is_id numeral_simps
72.281 - by auto
72.282 -
72.283 -
72.284 -subsubsection{*Multiplication *}
72.285 -
72.286 -lemma mult_nat_number_of [simp]:
72.287 - "(number_of v :: nat) * number_of v' =
72.288 - (if v < Int.Pls then 0 else number_of (v * v'))"
72.289 - unfolding nat_number_of_def number_of_is_id numeral_simps
72.290 - by (simp add: nat_mult_distrib)
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 +lemmas zpower_numeral_even = power_numeral_even [where 'a=int]
72.573 +lemmas zpower_numeral_odd = power_numeral_odd [where 'a=int]
72.574
72.575 -lemmas power_number_of_even_number_of [simp] =
72.576 - power_number_of_even [of "number_of v"] for v
72.577 +lemmas power_numeral_even_numeral [simp] =
72.578 + power_numeral_even [of "numeral v"] for v
72.579
72.580 -lemmas power_number_of_odd_number_of [simp] =
72.581 - power_number_of_odd [of "number_of v"] for v
72.582 +lemmas power_numeral_odd_numeral [simp] =
72.583 + power_numeral_odd [of "numeral v"] for v
72.584
72.585 -lemma nat_number_of_Pls: "Numeral0 = (0::nat)"
72.586 - by (simp add: nat_number_of_def)
72.587 +lemma nat_numeral_Bit0:
72.588 + "numeral (Num.Bit0 w) = (let n::nat = numeral w in n + n)"
72.589 + unfolding numeral_Bit0 Let_def ..
72.590
72.591 -lemma nat_number_of_Min [no_atp]: "number_of Int.Min = (0::nat)"
72.592 - apply (simp only: number_of_Min nat_number_of_def nat_zminus_int)
72.593 - done
72.594 -
72.595 -lemma nat_number_of_Bit0:
72.596 - "number_of (Int.Bit0 w) = (let n::nat = number_of w in n + n)"
72.597 -by (cases "w \<ge> 0") (auto simp add: Let_def Bit0_def nat_number_of_def number_of_is_id
72.598 - nat_add_distrib simp del: nat_number_of)
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 +lemma power_m1_even: "(-1) ^ (2*n) = (1::'a::ring_1)"
72.643 + by (fact power_minus1_even) (* FIXME: duplicate *)
72.644
72.645 -lemma power_m1_odd: "(-1) ^ Suc(2*n) = (-1::'a::{number_ring})"
72.646 - by (simp only: number_of_Min power_minus1_odd)
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
73.1 --- a/src/HOL/Nominal/Nominal.thy Mon Mar 26 15:32:54 2012 +0200
73.2 +++ b/src/HOL/Nominal/Nominal.thy Mon Mar 26 15:33:28 2012 +0200
73.3 @@ -3481,7 +3481,7 @@
73.4 by (auto simp add: perm_nat_def)
73.5
73.6 lemma numeral_nat_eqvt:
73.7 - shows "pi\<bullet>((number_of n)::nat) = number_of n"
73.8 + shows "pi\<bullet>((numeral n)::nat) = numeral n"
73.9 by (simp add: perm_nat_def perm_int_def)
73.10
73.11 lemma max_nat_eqvt:
73.12 @@ -3523,7 +3523,11 @@
73.13 by (simp add: perm_int_def)
73.14
73.15 lemma numeral_int_eqvt:
73.16 - shows "pi\<bullet>((number_of n)::int) = number_of n"
73.17 + shows "pi\<bullet>((numeral n)::int) = numeral n"
73.18 +by (simp add: perm_int_def perm_int_def)
73.19 +
73.20 +lemma neg_numeral_int_eqvt:
73.21 + shows "pi\<bullet>((neg_numeral n)::int) = neg_numeral n"
73.22 by (simp add: perm_int_def perm_int_def)
73.23
73.24 lemma max_int_eqvt:
73.25 @@ -3589,7 +3593,7 @@
73.26 (* the lemmas numeral_nat_eqvt numeral_int_eqvt do not conform with the *)
73.27 (* usual form of an eqvt-lemma, but they are needed for analysing *)
73.28 (* permutations on nats and ints *)
73.29 -lemmas [eqvt_force] = numeral_nat_eqvt numeral_int_eqvt
73.30 +lemmas [eqvt_force] = numeral_nat_eqvt numeral_int_eqvt neg_numeral_int_eqvt
73.31
73.32 (***************************************)
73.33 (* setup for the individial atom-kinds *)
74.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
74.2 +++ b/src/HOL/Num.thy Mon Mar 26 15:33:28 2012 +0200
74.3 @@ -0,0 +1,1021 @@
74.4 +(* Title: HOL/Num.thy
74.5 + Author: Florian Haftmann
74.6 + Author: Brian Huffman
74.7 +*)
74.8 +
74.9 +header {* Binary Numerals *}
74.10 +
74.11 +theory Num
74.12 +imports Datatype Power
74.13 +begin
74.14 +
74.15 +subsection {* The @{text num} type *}
74.16 +
74.17 +datatype num = One | Bit0 num | Bit1 num
74.18 +
74.19 +text {* Increment function for type @{typ num} *}
74.20 +
74.21 +primrec inc :: "num \<Rightarrow> num" where
74.22 + "inc One = Bit0 One" |
74.23 + "inc (Bit0 x) = Bit1 x" |
74.24 + "inc (Bit1 x) = Bit0 (inc x)"
74.25 +
74.26 +text {* Converting between type @{typ num} and type @{typ nat} *}
74.27 +
74.28 +primrec nat_of_num :: "num \<Rightarrow> nat" where
74.29 + "nat_of_num One = Suc 0" |
74.30 + "nat_of_num (Bit0 x) = nat_of_num x + nat_of_num x" |
74.31 + "nat_of_num (Bit1 x) = Suc (nat_of_num x + nat_of_num x)"
74.32 +
74.33 +primrec num_of_nat :: "nat \<Rightarrow> num" where
74.34 + "num_of_nat 0 = One" |
74.35 + "num_of_nat (Suc n) = (if 0 < n then inc (num_of_nat n) else One)"
74.36 +
74.37 +lemma nat_of_num_pos: "0 < nat_of_num x"
74.38 + by (induct x) simp_all
74.39 +
74.40 +lemma nat_of_num_neq_0: " nat_of_num x \<noteq> 0"
74.41 + by (induct x) simp_all
74.42 +
74.43 +lemma nat_of_num_inc: "nat_of_num (inc x) = Suc (nat_of_num x)"
74.44 + by (induct x) simp_all
74.45 +
74.46 +lemma num_of_nat_double:
74.47 + "0 < n \<Longrightarrow> num_of_nat (n + n) = Bit0 (num_of_nat n)"
74.48 + by (induct n) simp_all
74.49 +
74.50 +text {*
74.51 + Type @{typ num} is isomorphic to the strictly positive
74.52 + natural numbers.
74.53 +*}
74.54 +
74.55 +lemma nat_of_num_inverse: "num_of_nat (nat_of_num x) = x"
74.56 + by (induct x) (simp_all add: num_of_nat_double nat_of_num_pos)
74.57 +
74.58 +lemma num_of_nat_inverse: "0 < n \<Longrightarrow> nat_of_num (num_of_nat n) = n"
74.59 + by (induct n) (simp_all add: nat_of_num_inc)
74.60 +
74.61 +lemma num_eq_iff: "x = y \<longleftrightarrow> nat_of_num x = nat_of_num y"
74.62 + apply safe
74.63 + apply (drule arg_cong [where f=num_of_nat])
74.64 + apply (simp add: nat_of_num_inverse)
74.65 + done
74.66 +
74.67 +lemma num_induct [case_names One inc]:
74.68 + fixes P :: "num \<Rightarrow> bool"
74.69 + assumes One: "P One"
74.70 + and inc: "\<And>x. P x \<Longrightarrow> P (inc x)"
74.71 + shows "P x"
74.72 +proof -
74.73 + obtain n where n: "Suc n = nat_of_num x"
74.74 + by (cases "nat_of_num x", simp_all add: nat_of_num_neq_0)
74.75 + have "P (num_of_nat (Suc n))"
74.76 + proof (induct n)
74.77 + case 0 show ?case using One by simp
74.78 + next
74.79 + case (Suc n)
74.80 + then have "P (inc (num_of_nat (Suc n)))" by (rule inc)
74.81 + then show "P (num_of_nat (Suc (Suc n)))" by simp
74.82 + qed
74.83 + with n show "P x"
74.84 + by (simp add: nat_of_num_inverse)
74.85 +qed
74.86 +
74.87 +text {*
74.88 + From now on, there are two possible models for @{typ num}:
74.89 + as positive naturals (rule @{text "num_induct"})
74.90 + and as digit representation (rules @{text "num.induct"}, @{text "num.cases"}).
74.91 +*}
74.92 +
74.93 +
74.94 +subsection {* Numeral operations *}
74.95 +
74.96 +instantiation num :: "{plus,times,linorder}"
74.97 +begin
74.98 +
74.99 +definition [code del]:
74.100 + "m + n = num_of_nat (nat_of_num m + nat_of_num n)"
74.101 +
74.102 +definition [code del]:
74.103 + "m * n = num_of_nat (nat_of_num m * nat_of_num n)"
74.104 +
74.105 +definition [code del]:
74.106 + "m \<le> n \<longleftrightarrow> nat_of_num m \<le> nat_of_num n"
74.107 +
74.108 +definition [code del]:
74.109 + "m < n \<longleftrightarrow> nat_of_num m < nat_of_num n"
74.110 +
74.111 +instance
74.112 + by (default, auto simp add: less_num_def less_eq_num_def num_eq_iff)
74.113 +
74.114 +end
74.115 +
74.116 +lemma nat_of_num_add: "nat_of_num (x + y) = nat_of_num x + nat_of_num y"
74.117 + unfolding plus_num_def
74.118 + by (intro num_of_nat_inverse add_pos_pos nat_of_num_pos)
74.119 +
74.120 +lemma nat_of_num_mult: "nat_of_num (x * y) = nat_of_num x * nat_of_num y"
74.121 + unfolding times_num_def
74.122 + by (intro num_of_nat_inverse mult_pos_pos nat_of_num_pos)
74.123 +
74.124 +lemma add_num_simps [simp, code]:
74.125 + "One + One = Bit0 One"
74.126 + "One + Bit0 n = Bit1 n"
74.127 + "One + Bit1 n = Bit0 (n + One)"
74.128 + "Bit0 m + One = Bit1 m"
74.129 + "Bit0 m + Bit0 n = Bit0 (m + n)"
74.130 + "Bit0 m + Bit1 n = Bit1 (m + n)"
74.131 + "Bit1 m + One = Bit0 (m + One)"
74.132 + "Bit1 m + Bit0 n = Bit1 (m + n)"
74.133 + "Bit1 m + Bit1 n = Bit0 (m + n + One)"
74.134 + by (simp_all add: num_eq_iff nat_of_num_add)
74.135 +
74.136 +lemma mult_num_simps [simp, code]:
74.137 + "m * One = m"
74.138 + "One * n = n"
74.139 + "Bit0 m * Bit0 n = Bit0 (Bit0 (m * n))"
74.140 + "Bit0 m * Bit1 n = Bit0 (m * Bit1 n)"
74.141 + "Bit1 m * Bit0 n = Bit0 (Bit1 m * n)"
74.142 + "Bit1 m * Bit1 n = Bit1 (m + n + Bit0 (m * n))"
74.143 + by (simp_all add: num_eq_iff nat_of_num_add
74.144 + nat_of_num_mult left_distrib right_distrib)
74.145 +
74.146 +lemma eq_num_simps:
74.147 + "One = One \<longleftrightarrow> True"
74.148 + "One = Bit0 n \<longleftrightarrow> False"
74.149 + "One = Bit1 n \<longleftrightarrow> False"
74.150 + "Bit0 m = One \<longleftrightarrow> False"
74.151 + "Bit1 m = One \<longleftrightarrow> False"
74.152 + "Bit0 m = Bit0 n \<longleftrightarrow> m = n"
74.153 + "Bit0 m = Bit1 n \<longleftrightarrow> False"
74.154 + "Bit1 m = Bit0 n \<longleftrightarrow> False"
74.155 + "Bit1 m = Bit1 n \<longleftrightarrow> m = n"
74.156 + by simp_all
74.157 +
74.158 +lemma le_num_simps [simp, code]:
74.159 + "One \<le> n \<longleftrightarrow> True"
74.160 + "Bit0 m \<le> One \<longleftrightarrow> False"
74.161 + "Bit1 m \<le> One \<longleftrightarrow> False"
74.162 + "Bit0 m \<le> Bit0 n \<longleftrightarrow> m \<le> n"
74.163 + "Bit0 m \<le> Bit1 n \<longleftrightarrow> m \<le> n"
74.164 + "Bit1 m \<le> Bit1 n \<longleftrightarrow> m \<le> n"
74.165 + "Bit1 m \<le> Bit0 n \<longleftrightarrow> m < n"
74.166 + using nat_of_num_pos [of n] nat_of_num_pos [of m]
74.167 + by (auto simp add: less_eq_num_def less_num_def)
74.168 +
74.169 +lemma less_num_simps [simp, code]:
74.170 + "m < One \<longleftrightarrow> False"
74.171 + "One < Bit0 n \<longleftrightarrow> True"
74.172 + "One < Bit1 n \<longleftrightarrow> True"
74.173 + "Bit0 m < Bit0 n \<longleftrightarrow> m < n"
74.174 + "Bit0 m < Bit1 n \<longleftrightarrow> m \<le> n"
74.175 + "Bit1 m < Bit1 n \<longleftrightarrow> m < n"
74.176 + "Bit1 m < Bit0 n \<longleftrightarrow> m < n"
74.177 + using nat_of_num_pos [of n] nat_of_num_pos [of m]
74.178 + by (auto simp add: less_eq_num_def less_num_def)
74.179 +
74.180 +text {* Rules using @{text One} and @{text inc} as constructors *}
74.181 +
74.182 +lemma add_One: "x + One = inc x"
74.183 + by (simp add: num_eq_iff nat_of_num_add nat_of_num_inc)
74.184 +
74.185 +lemma add_One_commute: "One + n = n + One"
74.186 + by (induct n) simp_all
74.187 +
74.188 +lemma add_inc: "x + inc y = inc (x + y)"
74.189 + by (simp add: num_eq_iff nat_of_num_add nat_of_num_inc)
74.190 +
74.191 +lemma mult_inc: "x * inc y = x * y + x"
74.192 + by (simp add: num_eq_iff nat_of_num_mult nat_of_num_add nat_of_num_inc)
74.193 +
74.194 +text {* The @{const num_of_nat} conversion *}
74.195 +
74.196 +lemma num_of_nat_One:
74.197 + "n \<le> 1 \<Longrightarrow> num_of_nat n = Num.One"
74.198 + by (cases n) simp_all
74.199 +
74.200 +lemma num_of_nat_plus_distrib:
74.201 + "0 < m \<Longrightarrow> 0 < n \<Longrightarrow> num_of_nat (m + n) = num_of_nat m + num_of_nat n"
74.202 + by (induct n) (auto simp add: add_One add_One_commute add_inc)
74.203 +
74.204 +text {* A double-and-decrement function *}
74.205 +
74.206 +primrec BitM :: "num \<Rightarrow> num" where
74.207 + "BitM One = One" |
74.208 + "BitM (Bit0 n) = Bit1 (BitM n)" |
74.209 + "BitM (Bit1 n) = Bit1 (Bit0 n)"
74.210 +
74.211 +lemma BitM_plus_one: "BitM n + One = Bit0 n"
74.212 + by (induct n) simp_all
74.213 +
74.214 +lemma one_plus_BitM: "One + BitM n = Bit0 n"
74.215 + unfolding add_One_commute BitM_plus_one ..
74.216 +
74.217 +text {* Squaring and exponentiation *}
74.218 +
74.219 +primrec sqr :: "num \<Rightarrow> num" where
74.220 + "sqr One = One" |
74.221 + "sqr (Bit0 n) = Bit0 (Bit0 (sqr n))" |
74.222 + "sqr (Bit1 n) = Bit1 (Bit0 (sqr n + n))"
74.223 +
74.224 +primrec pow :: "num \<Rightarrow> num \<Rightarrow> num" where
74.225 + "pow x One = x" |
74.226 + "pow x (Bit0 y) = sqr (pow x y)" |
74.227 + "pow x (Bit1 y) = x * sqr (pow x y)"
74.228 +
74.229 +lemma nat_of_num_sqr: "nat_of_num (sqr x) = nat_of_num x * nat_of_num x"
74.230 + by (induct x, simp_all add: algebra_simps nat_of_num_add)
74.231 +
74.232 +lemma sqr_conv_mult: "sqr x = x * x"
74.233 + by (simp add: num_eq_iff nat_of_num_sqr nat_of_num_mult)
74.234 +
74.235 +
74.236 +subsection {* Numary numerals *}
74.237 +
74.238 +text {*
74.239 + We embed numary representations into a generic algebraic
74.240 + structure using @{text numeral}.
74.241 +*}
74.242 +
74.243 +class numeral = one + semigroup_add
74.244 +begin
74.245 +
74.246 +primrec numeral :: "num \<Rightarrow> 'a" where
74.247 + numeral_One: "numeral One = 1" |
74.248 + numeral_Bit0: "numeral (Bit0 n) = numeral n + numeral n" |
74.249 + numeral_Bit1: "numeral (Bit1 n) = numeral n + numeral n + 1"
74.250 +
74.251 +lemma one_plus_numeral_commute: "1 + numeral x = numeral x + 1"
74.252 + apply (induct x)
74.253 + apply simp
74.254 + apply (simp add: add_assoc [symmetric], simp add: add_assoc)
74.255 + apply (simp add: add_assoc [symmetric], simp add: add_assoc)
74.256 + done
74.257 +
74.258 +lemma numeral_inc: "numeral (inc x) = numeral x + 1"
74.259 +proof (induct x)
74.260 + case (Bit1 x)
74.261 + have "numeral x + (1 + numeral x) + 1 = numeral x + (numeral x + 1) + 1"
74.262 + by (simp only: one_plus_numeral_commute)
74.263 + with Bit1 show ?case
74.264 + by (simp add: add_assoc)
74.265 +qed simp_all
74.266 +
74.267 +declare numeral.simps [simp del]
74.268 +
74.269 +abbreviation "Numeral1 \<equiv> numeral One"
74.270 +
74.271 +declare numeral_One [code_post]
74.272 +
74.273 +end
74.274 +
74.275 +text {* Negative numerals. *}
74.276 +
74.277 +class neg_numeral = numeral + group_add
74.278 +begin
74.279 +
74.280 +definition neg_numeral :: "num \<Rightarrow> 'a" where
74.281 + "neg_numeral k = - numeral k"
74.282 +
74.283 +end
74.284 +
74.285 +text {* Numeral syntax. *}
74.286 +
74.287 +syntax
74.288 + "_Numeral" :: "num_const \<Rightarrow> 'a" ("_")
74.289 +
74.290 +parse_translation {*
74.291 +let
74.292 + fun num_of_int n = if n > 0 then case IntInf.quotRem (n, 2)
74.293 + of (0, 1) => Syntax.const @{const_name One}
74.294 + | (n, 0) => Syntax.const @{const_name Bit0} $ num_of_int n
74.295 + | (n, 1) => Syntax.const @{const_name Bit1} $ num_of_int n
74.296 + else raise Match;
74.297 + val pos = Syntax.const @{const_name numeral}
74.298 + val neg = Syntax.const @{const_name neg_numeral}
74.299 + val one = Syntax.const @{const_name Groups.one}
74.300 + val zero = Syntax.const @{const_name Groups.zero}
74.301 + fun numeral_tr [(c as Const (@{syntax_const "_constrain"}, _)) $ t $ u] =
74.302 + c $ numeral_tr [t] $ u
74.303 + | numeral_tr [Const (num, _)] =
74.304 + let
74.305 + val {value, ...} = Lexicon.read_xnum num;
74.306 + in
74.307 + if value = 0 then zero else
74.308 + if value > 0
74.309 + then pos $ num_of_int value
74.310 + else neg $ num_of_int (~value)
74.311 + end
74.312 + | numeral_tr ts = raise TERM ("numeral_tr", ts);
74.313 +in [("_Numeral", numeral_tr)] end
74.314 +*}
74.315 +
74.316 +typed_print_translation (advanced) {*
74.317 +let
74.318 + fun dest_num (Const (@{const_syntax Bit0}, _) $ n) = 2 * dest_num n
74.319 + | dest_num (Const (@{const_syntax Bit1}, _) $ n) = 2 * dest_num n + 1
74.320 + | dest_num (Const (@{const_syntax One}, _)) = 1;
74.321 + fun num_tr' sign ctxt T [n] =
74.322 + let
74.323 + val k = dest_num n;
74.324 + val t' = Syntax.const @{syntax_const "_Numeral"} $
74.325 + Syntax.free (sign ^ string_of_int k);
74.326 + in
74.327 + case T of
74.328 + Type (@{type_name fun}, [_, T']) =>
74.329 + if not (Config.get ctxt show_types) andalso can Term.dest_Type T' then t'
74.330 + else Syntax.const @{syntax_const "_constrain"} $ t' $ Syntax_Phases.term_of_typ ctxt T'
74.331 + | T' => if T' = dummyT then t' else raise Match
74.332 + end;
74.333 +in [(@{const_syntax numeral}, num_tr' ""),
74.334 + (@{const_syntax neg_numeral}, num_tr' "-")] end
74.335 +*}
74.336 +
74.337 +subsection {* Class-specific numeral rules *}
74.338 +
74.339 +text {*
74.340 + @{const numeral} is a morphism.
74.341 +*}
74.342 +
74.343 +subsubsection {* Structures with addition: class @{text numeral} *}
74.344 +
74.345 +context numeral
74.346 +begin
74.347 +
74.348 +lemma numeral_add: "numeral (m + n) = numeral m + numeral n"
74.349 + by (induct n rule: num_induct)
74.350 + (simp_all only: numeral_One add_One add_inc numeral_inc add_assoc)
74.351 +
74.352 +lemma numeral_plus_numeral: "numeral m + numeral n = numeral (m + n)"
74.353 + by (rule numeral_add [symmetric])
74.354 +
74.355 +lemma numeral_plus_one: "numeral n + 1 = numeral (n + One)"
74.356 + using numeral_add [of n One] by (simp add: numeral_One)
74.357 +
74.358 +lemma one_plus_numeral: "1 + numeral n = numeral (One + n)"
74.359 + using numeral_add [of One n] by (simp add: numeral_One)
74.360 +
74.361 +lemma one_add_one: "1 + 1 = 2"
74.362 + using numeral_add [of One One] by (simp add: numeral_One)
74.363 +
74.364 +lemmas add_numeral_special =
74.365 + numeral_plus_one one_plus_numeral one_add_one
74.366 +
74.367 +end
74.368 +
74.369 +subsubsection {*
74.370 + Structures with negation: class @{text neg_numeral}
74.371 +*}
74.372 +
74.373 +context neg_numeral
74.374 +begin
74.375 +
74.376 +text {* Numerals form an abelian subgroup. *}
74.377 +
74.378 +inductive is_num :: "'a \<Rightarrow> bool" where
74.379 + "is_num 1" |
74.380 + "is_num x \<Longrightarrow> is_num (- x)" |
74.381 + "\<lbrakk>is_num x; is_num y\<rbrakk> \<Longrightarrow> is_num (x + y)"
74.382 +
74.383 +lemma is_num_numeral: "is_num (numeral k)"
74.384 + by (induct k, simp_all add: numeral.simps is_num.intros)
74.385 +
74.386 +lemma is_num_add_commute:
74.387 + "\<lbrakk>is_num x; is_num y\<rbrakk> \<Longrightarrow> x + y = y + x"
74.388 + apply (induct x rule: is_num.induct)
74.389 + apply (induct y rule: is_num.induct)
74.390 + apply simp
74.391 + apply (rule_tac a=x in add_left_imp_eq)
74.392 + apply (rule_tac a=x in add_right_imp_eq)
74.393 + apply (simp add: add_assoc minus_add_cancel)
74.394 + apply (simp add: add_assoc [symmetric], simp add: add_assoc)
74.395 + apply (rule_tac a=x in add_left_imp_eq)
74.396 + apply (rule_tac a=x in add_right_imp_eq)
74.397 + apply (simp add: add_assoc minus_add_cancel add_minus_cancel)
74.398 + apply (simp add: add_assoc, simp add: add_assoc [symmetric])
74.399 + done
74.400 +
74.401 +lemma is_num_add_left_commute:
74.402 + "\<lbrakk>is_num x; is_num y\<rbrakk> \<Longrightarrow> x + (y + z) = y + (x + z)"
74.403 + by (simp only: add_assoc [symmetric] is_num_add_commute)
74.404 +
74.405 +lemmas is_num_normalize =
74.406 + add_assoc is_num_add_commute is_num_add_left_commute
74.407 + is_num.intros is_num_numeral
74.408 + diff_minus minus_add add_minus_cancel minus_add_cancel
74.409 +
74.410 +definition dbl :: "'a \<Rightarrow> 'a" where "dbl x = x + x"
74.411 +definition dbl_inc :: "'a \<Rightarrow> 'a" where "dbl_inc x = x + x + 1"
74.412 +definition dbl_dec :: "'a \<Rightarrow> 'a" where "dbl_dec x = x + x - 1"
74.413 +
74.414 +definition sub :: "num \<Rightarrow> num \<Rightarrow> 'a" where
74.415 + "sub k l = numeral k - numeral l"
74.416 +
74.417 +lemma numeral_BitM: "numeral (BitM n) = numeral (Bit0 n) - 1"
74.418 + by (simp only: BitM_plus_one [symmetric] numeral_add numeral_One eq_diff_eq)
74.419 +
74.420 +lemma dbl_simps [simp]:
74.421 + "dbl (neg_numeral k) = neg_numeral (Bit0 k)"
74.422 + "dbl 0 = 0"
74.423 + "dbl 1 = 2"
74.424 + "dbl (numeral k) = numeral (Bit0 k)"
74.425 + unfolding dbl_def neg_numeral_def numeral.simps
74.426 + by (simp_all add: minus_add)
74.427 +
74.428 +lemma dbl_inc_simps [simp]:
74.429 + "dbl_inc (neg_numeral k) = neg_numeral (BitM k)"
74.430 + "dbl_inc 0 = 1"
74.431 + "dbl_inc 1 = 3"
74.432 + "dbl_inc (numeral k) = numeral (Bit1 k)"
74.433 + unfolding dbl_inc_def neg_numeral_def numeral.simps numeral_BitM
74.434 + by (simp_all add: is_num_normalize)
74.435 +
74.436 +lemma dbl_dec_simps [simp]:
74.437 + "dbl_dec (neg_numeral k) = neg_numeral (Bit1 k)"
74.438 + "dbl_dec 0 = -1"
74.439 + "dbl_dec 1 = 1"
74.440 + "dbl_dec (numeral k) = numeral (BitM k)"
74.441 + unfolding dbl_dec_def neg_numeral_def numeral.simps numeral_BitM
74.442 + by (simp_all add: is_num_normalize)
74.443 +
74.444 +lemma sub_num_simps [simp]:
74.445 + "sub One One = 0"
74.446 + "sub One (Bit0 l) = neg_numeral (BitM l)"
74.447 + "sub One (Bit1 l) = neg_numeral (Bit0 l)"
74.448 + "sub (Bit0 k) One = numeral (BitM k)"
74.449 + "sub (Bit1 k) One = numeral (Bit0 k)"
74.450 + "sub (Bit0 k) (Bit0 l) = dbl (sub k l)"
74.451 + "sub (Bit0 k) (Bit1 l) = dbl_dec (sub k l)"
74.452 + "sub (Bit1 k) (Bit0 l) = dbl_inc (sub k l)"
74.453 + "sub (Bit1 k) (Bit1 l) = dbl (sub k l)"
74.454 + unfolding dbl_def dbl_dec_def dbl_inc_def sub_def
74.455 + unfolding neg_numeral_def numeral.simps numeral_BitM
74.456 + by (simp_all add: is_num_normalize)
74.457 +
74.458 +lemma add_neg_numeral_simps:
74.459 + "numeral m + neg_numeral n = sub m n"
74.460 + "neg_numeral m + numeral n = sub n m"
74.461 + "neg_numeral m + neg_numeral n = neg_numeral (m + n)"
74.462 + unfolding sub_def diff_minus neg_numeral_def numeral_add numeral.simps
74.463 + by (simp_all add: is_num_normalize)
74.464 +
74.465 +lemma add_neg_numeral_special:
74.466 + "1 + neg_numeral m = sub One m"
74.467 + "neg_numeral m + 1 = sub One m"
74.468 + unfolding sub_def diff_minus neg_numeral_def numeral_add numeral.simps
74.469 + by (simp_all add: is_num_normalize)
74.470 +
74.471 +lemma diff_numeral_simps:
74.472 + "numeral m - numeral n = sub m n"
74.473 + "numeral m - neg_numeral n = numeral (m + n)"
74.474 + "neg_numeral m - numeral n = neg_numeral (m + n)"
74.475 + "neg_numeral m - neg_numeral n = sub n m"
74.476 + unfolding neg_numeral_def sub_def diff_minus numeral_add numeral.simps
74.477 + by (simp_all add: is_num_normalize)
74.478 +
74.479 +lemma diff_numeral_special:
74.480 + "1 - numeral n = sub One n"
74.481 + "1 - neg_numeral n = numeral (One + n)"
74.482 + "numeral m - 1 = sub m One"
74.483 + "neg_numeral m - 1 = neg_numeral (m + One)"
74.484 + unfolding neg_numeral_def sub_def diff_minus numeral_add numeral.simps
74.485 + by (simp_all add: is_num_normalize)
74.486 +
74.487 +lemma minus_one: "- 1 = -1"
74.488 + unfolding neg_numeral_def numeral.simps ..
74.489 +
74.490 +lemma minus_numeral: "- numeral n = neg_numeral n"
74.491 + unfolding neg_numeral_def ..
74.492 +
74.493 +lemma minus_neg_numeral: "- neg_numeral n = numeral n"
74.494 + unfolding neg_numeral_def by simp
74.495 +
74.496 +lemmas minus_numeral_simps [simp] =
74.497 + minus_one minus_numeral minus_neg_numeral
74.498 +
74.499 +end
74.500 +
74.501 +subsubsection {*
74.502 + Structures with multiplication: class @{text semiring_numeral}
74.503 +*}
74.504 +
74.505 +class semiring_numeral = semiring + monoid_mult
74.506 +begin
74.507 +
74.508 +subclass numeral ..
74.509 +
74.510 +lemma numeral_mult: "numeral (m * n) = numeral m * numeral n"
74.511 + apply (induct n rule: num_induct)
74.512 + apply (simp add: numeral_One)
74.513 + apply (simp add: mult_inc numeral_inc numeral_add numeral_inc right_distrib)
74.514 + done
74.515 +
74.516 +lemma numeral_times_numeral: "numeral m * numeral n = numeral (m * n)"
74.517 + by (rule numeral_mult [symmetric])
74.518 +
74.519 +end
74.520 +
74.521 +subsubsection {*
74.522 + Structures with a zero: class @{text semiring_1}
74.523 +*}
74.524 +
74.525 +context semiring_1
74.526 +begin
74.527 +
74.528 +subclass semiring_numeral ..
74.529 +
74.530 +lemma of_nat_numeral [simp]: "of_nat (numeral n) = numeral n"
74.531 + by (induct n,
74.532 + simp_all only: numeral.simps numeral_class.numeral.simps of_nat_add of_nat_1)
74.533 +
74.534 +end
74.535 +
74.536 +lemma nat_of_num_numeral: "nat_of_num = numeral"
74.537 +proof
74.538 + fix n
74.539 + have "numeral n = nat_of_num n"
74.540 + by (induct n) (simp_all add: numeral.simps)
74.541 + then show "nat_of_num n = numeral n" by simp
74.542 +qed
74.543 +
74.544 +subsubsection {*
74.545 + Equality: class @{text semiring_char_0}
74.546 +*}
74.547 +
74.548 +context semiring_char_0
74.549 +begin
74.550 +
74.551 +lemma numeral_eq_iff: "numeral m = numeral n \<longleftrightarrow> m = n"
74.552 + unfolding of_nat_numeral [symmetric] nat_of_num_numeral [symmetric]
74.553 + of_nat_eq_iff num_eq_iff ..
74.554 +
74.555 +lemma numeral_eq_one_iff: "numeral n = 1 \<longleftrightarrow> n = One"
74.556 + by (rule numeral_eq_iff [of n One, unfolded numeral_One])
74.557 +
74.558 +lemma one_eq_numeral_iff: "1 = numeral n \<longleftrightarrow> One = n"
74.559 + by (rule numeral_eq_iff [of One n, unfolded numeral_One])
74.560 +
74.561 +lemma numeral_neq_zero: "numeral n \<noteq> 0"
74.562 + unfolding of_nat_numeral [symmetric] nat_of_num_numeral [symmetric]
74.563 + by (simp add: nat_of_num_pos)
74.564 +
74.565 +lemma zero_neq_numeral: "0 \<noteq> numeral n"
74.566 + unfolding eq_commute [of 0] by (rule numeral_neq_zero)
74.567 +
74.568 +lemmas eq_numeral_simps [simp] =
74.569 + numeral_eq_iff
74.570 + numeral_eq_one_iff
74.571 + one_eq_numeral_iff
74.572 + numeral_neq_zero
74.573 + zero_neq_numeral
74.574 +
74.575 +end
74.576 +
74.577 +subsubsection {*
74.578 + Comparisons: class @{text linordered_semidom}
74.579 +*}
74.580 +
74.581 +text {* Could be perhaps more general than here. *}
74.582 +
74.583 +context linordered_semidom
74.584 +begin
74.585 +
74.586 +lemma numeral_le_iff: "numeral m \<le> numeral n \<longleftrightarrow> m \<le> n"
74.587 +proof -
74.588 + have "of_nat (numeral m) \<le> of_nat (numeral n) \<longleftrightarrow> m \<le> n"
74.589 + unfolding less_eq_num_def nat_of_num_numeral of_nat_le_iff ..
74.590 + then show ?thesis by simp
74.591 +qed
74.592 +
74.593 +lemma one_le_numeral: "1 \<le> numeral n"
74.594 +using numeral_le_iff [of One n] by (simp add: numeral_One)
74.595 +
74.596 +lemma numeral_le_one_iff: "numeral n \<le> 1 \<longleftrightarrow> n \<le> One"
74.597 +using numeral_le_iff [of n One] by (simp add: numeral_One)
74.598 +
74.599 +lemma numeral_less_iff: "numeral m < numeral n \<longleftrightarrow> m < n"
74.600 +proof -
74.601 + have "of_nat (numeral m) < of_nat (numeral n) \<longleftrightarrow> m < n"
74.602 + unfolding less_num_def nat_of_num_numeral of_nat_less_iff ..
74.603 + then show ?thesis by simp
74.604 +qed
74.605 +
74.606 +lemma not_numeral_less_one: "\<not> numeral n < 1"
74.607 + using numeral_less_iff [of n One] by (simp add: numeral_One)
74.608 +
74.609 +lemma one_less_numeral_iff: "1 < numeral n \<longleftrightarrow> One < n"
74.610 + using numeral_less_iff [of One n] by (simp add: numeral_One)
74.611 +
74.612 +lemma zero_le_numeral: "0 \<le> numeral n"
74.613 + by (induct n) (simp_all add: numeral.simps)
74.614 +
74.615 +lemma zero_less_numeral: "0 < numeral n"
74.616 + by (induct n) (simp_all add: numeral.simps add_pos_pos)
74.617 +
74.618 +lemma not_numeral_le_zero: "\<not> numeral n \<le> 0"
74.619 + by (simp add: not_le zero_less_numeral)
74.620 +
74.621 +lemma not_numeral_less_zero: "\<not> numeral n < 0"
74.622 + by (simp add: not_less zero_le_numeral)
74.623 +
74.624 +lemmas le_numeral_extra =
74.625 + zero_le_one not_one_le_zero
74.626 + order_refl [of 0] order_refl [of 1]
74.627 +
74.628 +lemmas less_numeral_extra =
74.629 + zero_less_one not_one_less_zero
74.630 + less_irrefl [of 0] less_irrefl [of 1]
74.631 +
74.632 +lemmas le_numeral_simps [simp] =
74.633 + numeral_le_iff
74.634 + one_le_numeral
74.635 + numeral_le_one_iff
74.636 + zero_le_numeral
74.637 + not_numeral_le_zero
74.638 +
74.639 +lemmas less_numeral_simps [simp] =
74.640 + numeral_less_iff
74.641 + one_less_numeral_iff
74.642 + not_numeral_less_one
74.643 + zero_less_numeral
74.644 + not_numeral_less_zero
74.645 +
74.646 +end
74.647 +
74.648 +subsubsection {*
74.649 + Multiplication and negation: class @{text ring_1}
74.650 +*}
74.651 +
74.652 +context ring_1
74.653 +begin
74.654 +
74.655 +subclass neg_numeral ..
74.656 +
74.657 +lemma mult_neg_numeral_simps:
74.658 + "neg_numeral m * neg_numeral n = numeral (m * n)"
74.659 + "neg_numeral m * numeral n = neg_numeral (m * n)"
74.660 + "numeral m * neg_numeral n = neg_numeral (m * n)"
74.661 + unfolding neg_numeral_def mult_minus_left mult_minus_right
74.662 + by (simp_all only: minus_minus numeral_mult)
74.663 +
74.664 +lemma mult_minus1 [simp]: "-1 * z = - z"
74.665 + unfolding neg_numeral_def numeral.simps mult_minus_left by simp
74.666 +
74.667 +lemma mult_minus1_right [simp]: "z * -1 = - z"
74.668 + unfolding neg_numeral_def numeral.simps mult_minus_right by simp
74.669 +
74.670 +end
74.671 +
74.672 +subsubsection {*
74.673 + Equality using @{text iszero} for rings with non-zero characteristic
74.674 +*}
74.675 +
74.676 +context ring_1
74.677 +begin
74.678 +
74.679 +definition iszero :: "'a \<Rightarrow> bool"
74.680 + where "iszero z \<longleftrightarrow> z = 0"
74.681 +
74.682 +lemma iszero_0 [simp]: "iszero 0"
74.683 + by (simp add: iszero_def)
74.684 +
74.685 +lemma not_iszero_1 [simp]: "\<not> iszero 1"
74.686 + by (simp add: iszero_def)
74.687 +
74.688 +lemma not_iszero_Numeral1: "\<not> iszero Numeral1"
74.689 + by (simp add: numeral_One)
74.690 +
74.691 +lemma iszero_neg_numeral [simp]:
74.692 + "iszero (neg_numeral w) \<longleftrightarrow> iszero (numeral w)"
74.693 + unfolding iszero_def neg_numeral_def
74.694 + by (rule neg_equal_0_iff_equal)
74.695 +
74.696 +lemma eq_iff_iszero_diff: "x = y \<longleftrightarrow> iszero (x - y)"
74.697 + unfolding iszero_def by (rule eq_iff_diff_eq_0)
74.698 +
74.699 +text {* The @{text "eq_numeral_iff_iszero"} lemmas are not declared
74.700 +@{text "[simp]"} by default, because for rings of characteristic zero,
74.701 +better simp rules are possible. For a type like integers mod @{text
74.702 +"n"}, type-instantiated versions of these rules should be added to the
74.703 +simplifier, along with a type-specific rule for deciding propositions
74.704 +of the form @{text "iszero (numeral w)"}.
74.705 +
74.706 +bh: Maybe it would not be so bad to just declare these as simp
74.707 +rules anyway? I should test whether these rules take precedence over
74.708 +the @{text "ring_char_0"} rules in the simplifier.
74.709 +*}
74.710 +
74.711 +lemma eq_numeral_iff_iszero:
74.712 + "numeral x = numeral y \<longleftrightarrow> iszero (sub x y)"
74.713 + "numeral x = neg_numeral y \<longleftrightarrow> iszero (numeral (x + y))"
74.714 + "neg_numeral x = numeral y \<longleftrightarrow> iszero (numeral (x + y))"
74.715 + "neg_numeral x = neg_numeral y \<longleftrightarrow> iszero (sub y x)"
74.716 + "numeral x = 1 \<longleftrightarrow> iszero (sub x One)"
74.717 + "1 = numeral y \<longleftrightarrow> iszero (sub One y)"
74.718 + "neg_numeral x = 1 \<longleftrightarrow> iszero (numeral (x + One))"
74.719 + "1 = neg_numeral y \<longleftrightarrow> iszero (numeral (One + y))"
74.720 + "numeral x = 0 \<longleftrightarrow> iszero (numeral x)"
74.721 + "0 = numeral y \<longleftrightarrow> iszero (numeral y)"
74.722 + "neg_numeral x = 0 \<longleftrightarrow> iszero (numeral x)"
74.723 + "0 = neg_numeral y \<longleftrightarrow> iszero (numeral y)"
74.724 + unfolding eq_iff_iszero_diff diff_numeral_simps diff_numeral_special
74.725 + by simp_all
74.726 +
74.727 +end
74.728 +
74.729 +subsubsection {*
74.730 + Equality and negation: class @{text ring_char_0}
74.731 +*}
74.732 +
74.733 +class ring_char_0 = ring_1 + semiring_char_0
74.734 +begin
74.735 +
74.736 +lemma not_iszero_numeral [simp]: "\<not> iszero (numeral w)"
74.737 + by (simp add: iszero_def)
74.738 +
74.739 +lemma neg_numeral_eq_iff: "neg_numeral m = neg_numeral n \<longleftrightarrow> m = n"
74.740 + by (simp only: neg_numeral_def neg_equal_iff_equal numeral_eq_iff)
74.741 +
74.742 +lemma numeral_neq_neg_numeral: "numeral m \<noteq> neg_numeral n"
74.743 + unfolding neg_numeral_def eq_neg_iff_add_eq_0
74.744 + by (simp add: numeral_plus_numeral)
74.745 +
74.746 +lemma neg_numeral_neq_numeral: "neg_numeral m \<noteq> numeral n"
74.747 + by (rule numeral_neq_neg_numeral [symmetric])
74.748 +
74.749 +lemma zero_neq_neg_numeral: "0 \<noteq> neg_numeral n"
74.750 + unfolding neg_numeral_def neg_0_equal_iff_equal by simp
74.751 +
74.752 +lemma neg_numeral_neq_zero: "neg_numeral n \<noteq> 0"
74.753 + unfolding neg_numeral_def neg_equal_0_iff_equal by simp
74.754 +
74.755 +lemma one_neq_neg_numeral: "1 \<noteq> neg_numeral n"
74.756 + using numeral_neq_neg_numeral [of One n] by (simp add: numeral_One)
74.757 +
74.758 +lemma neg_numeral_neq_one: "neg_numeral n \<noteq> 1"
74.759 + using neg_numeral_neq_numeral [of n One] by (simp add: numeral_One)
74.760 +
74.761 +lemmas eq_neg_numeral_simps [simp] =
74.762 + neg_numeral_eq_iff
74.763 + numeral_neq_neg_numeral neg_numeral_neq_numeral
74.764 + one_neq_neg_numeral neg_numeral_neq_one
74.765 + zero_neq_neg_numeral neg_numeral_neq_zero
74.766 +
74.767 +end
74.768 +
74.769 +subsubsection {*
74.770 + Structures with negation and order: class @{text linordered_idom}
74.771 +*}
74.772 +
74.773 +context linordered_idom
74.774 +begin
74.775 +
74.776 +subclass ring_char_0 ..
74.777 +
74.778 +lemma neg_numeral_le_iff: "neg_numeral m \<le> neg_numeral n \<longleftrightarrow> n \<le> m"
74.779 + by (simp only: neg_numeral_def neg_le_iff_le numeral_le_iff)
74.780 +
74.781 +lemma neg_numeral_less_iff: "neg_numeral m < neg_numeral n \<longleftrightarrow> n < m"
74.782 + by (simp only: neg_numeral_def neg_less_iff_less numeral_less_iff)
74.783 +
74.784 +lemma neg_numeral_less_zero: "neg_numeral n < 0"
74.785 + by (simp only: neg_numeral_def neg_less_0_iff_less zero_less_numeral)
74.786 +
74.787 +lemma neg_numeral_le_zero: "neg_numeral n \<le> 0"
74.788 + by (simp only: neg_numeral_def neg_le_0_iff_le zero_le_numeral)
74.789 +
74.790 +lemma not_zero_less_neg_numeral: "\<not> 0 < neg_numeral n"
74.791 + by (simp only: not_less neg_numeral_le_zero)
74.792 +
74.793 +lemma not_zero_le_neg_numeral: "\<not> 0 \<le> neg_numeral n"
74.794 + by (simp only: not_le neg_numeral_less_zero)
74.795 +
74.796 +lemma neg_numeral_less_numeral: "neg_numeral m < numeral n"
74.797 + using neg_numeral_less_zero zero_less_numeral by (rule less_trans)
74.798 +
74.799 +lemma neg_numeral_le_numeral: "neg_numeral m \<le> numeral n"
74.800 + by (simp only: less_imp_le neg_numeral_less_numeral)
74.801 +
74.802 +lemma not_numeral_less_neg_numeral: "\<not> numeral m < neg_numeral n"
74.803 + by (simp only: not_less neg_numeral_le_numeral)
74.804 +
74.805 +lemma not_numeral_le_neg_numeral: "\<not> numeral m \<le> neg_numeral n"
74.806 + by (simp only: not_le neg_numeral_less_numeral)
74.807 +
74.808 +lemma neg_numeral_less_one: "neg_numeral m < 1"
74.809 + by (rule neg_numeral_less_numeral [of m One, unfolded numeral_One])
74.810 +
74.811 +lemma neg_numeral_le_one: "neg_numeral m \<le> 1"
74.812 + by (rule neg_numeral_le_numeral [of m One, unfolded numeral_One])
74.813 +
74.814 +lemma not_one_less_neg_numeral: "\<not> 1 < neg_numeral m"
74.815 + by (simp only: not_less neg_numeral_le_one)
74.816 +
74.817 +lemma not_one_le_neg_numeral: "\<not> 1 \<le> neg_numeral m"
74.818 + by (simp only: not_le neg_numeral_less_one)
74.819 +
74.820 +lemma sub_non_negative:
74.821 + "sub n m \<ge> 0 \<longleftrightarrow> n \<ge> m"
74.822 + by (simp only: sub_def le_diff_eq) simp
74.823 +
74.824 +lemma sub_positive:
74.825 + "sub n m > 0 \<longleftrightarrow> n > m"
74.826 + by (simp only: sub_def less_diff_eq) simp
74.827 +
74.828 +lemma sub_non_positive:
74.829 + "sub n m \<le> 0 \<longleftrightarrow> n \<le> m"
74.830 + by (simp only: sub_def diff_le_eq) simp
74.831 +
74.832 +lemma sub_negative:
74.833 + "sub n m < 0 \<longleftrightarrow> n < m"
74.834 + by (simp only: sub_def diff_less_eq) simp
74.835 +
74.836 +lemmas le_neg_numeral_simps [simp] =
74.837 + neg_numeral_le_iff
74.838 + neg_numeral_le_numeral not_numeral_le_neg_numeral
74.839 + neg_numeral_le_zero not_zero_le_neg_numeral
74.840 + neg_numeral_le_one not_one_le_neg_numeral
74.841 +
74.842 +lemmas less_neg_numeral_simps [simp] =
74.843 + neg_numeral_less_iff
74.844 + neg_numeral_less_numeral not_numeral_less_neg_numeral
74.845 + neg_numeral_less_zero not_zero_less_neg_numeral
74.846 + neg_numeral_less_one not_one_less_neg_numeral
74.847 +
74.848 +lemma abs_numeral [simp]: "abs (numeral n) = numeral n"
74.849 + by simp
74.850 +
74.851 +lemma abs_neg_numeral [simp]: "abs (neg_numeral n) = numeral n"
74.852 + by (simp only: neg_numeral_def abs_minus_cancel abs_numeral)
74.853 +
74.854 +end
74.855 +
74.856 +subsubsection {*
74.857 + Natural numbers
74.858 +*}
74.859 +
74.860 +lemma Suc_numeral [simp]: "Suc (numeral n) = numeral (n + One)"
74.861 + unfolding numeral_plus_one [symmetric] by simp
74.862 +
74.863 +lemma nat_number:
74.864 + "1 = Suc 0"
74.865 + "numeral One = Suc 0"
74.866 + "numeral (Bit0 n) = Suc (numeral (BitM n))"
74.867 + "numeral (Bit1 n) = Suc (numeral (Bit0 n))"
74.868 + by (simp_all add: numeral.simps BitM_plus_one)
74.869 +
74.870 +subsubsection {*
74.871 + Structures with exponentiation
74.872 +*}
74.873 +
74.874 +context semiring_numeral
74.875 +begin
74.876 +
74.877 +lemma numeral_sqr: "numeral (sqr n) = numeral n * numeral n"
74.878 + by (simp add: sqr_conv_mult numeral_mult)
74.879 +
74.880 +lemma numeral_pow: "numeral (pow m n) = numeral m ^ numeral n"
74.881 + by (induct n, simp_all add: numeral_class.numeral.simps
74.882 + power_add numeral_sqr numeral_mult)
74.883 +
74.884 +lemma power_numeral [simp]: "numeral m ^ numeral n = numeral (pow m n)"
74.885 + by (rule numeral_pow [symmetric])
74.886 +
74.887 +end
74.888 +
74.889 +context semiring_1
74.890 +begin
74.891 +
74.892 +lemma power_zero_numeral [simp]: "(0::'a) ^ numeral n = 0"
74.893 + by (induct n, simp_all add: numeral_class.numeral.simps power_add)
74.894 +
74.895 +end
74.896 +
74.897 +context ring_1
74.898 +begin
74.899 +
74.900 +lemma power_minus_Bit0: "(- x) ^ numeral (Bit0 n) = x ^ numeral (Bit0 n)"
74.901 + by (induct n, simp_all add: numeral_class.numeral.simps power_add)
74.902 +
74.903 +lemma power_minus_Bit1: "(- x) ^ numeral (Bit1 n) = - (x ^ numeral (Bit1 n))"
74.904 + by (simp only: nat_number(4) power_Suc power_minus_Bit0 mult_minus_left)
74.905 +
74.906 +lemma power_neg_numeral_Bit0 [simp]:
74.907 + "neg_numeral m ^ numeral (Bit0 n) = numeral (pow m (Bit0 n))"
74.908 + by (simp only: neg_numeral_def power_minus_Bit0 power_numeral)
74.909 +
74.910 +lemma power_neg_numeral_Bit1 [simp]:
74.911 + "neg_numeral m ^ numeral (Bit1 n) = neg_numeral (pow m (Bit1 n))"
74.912 + by (simp only: neg_numeral_def power_minus_Bit1 power_numeral pow.simps)
74.913 +
74.914 +end
74.915 +
74.916 +subsection {* Numeral equations as default simplification rules *}
74.917 +
74.918 +declare (in numeral) numeral_One [simp]
74.919 +declare (in numeral) numeral_plus_numeral [simp]
74.920 +declare (in numeral) add_numeral_special [simp]
74.921 +declare (in neg_numeral) add_neg_numeral_simps [simp]
74.922 +declare (in neg_numeral) add_neg_numeral_special [simp]
74.923 +declare (in neg_numeral) diff_numeral_simps [simp]
74.924 +declare (in neg_numeral) diff_numeral_special [simp]
74.925 +declare (in semiring_numeral) numeral_times_numeral [simp]
74.926 +declare (in ring_1) mult_neg_numeral_simps [simp]
74.927 +
74.928 +subsection {* Setting up simprocs *}
74.929 +
74.930 +lemma numeral_reorient:
74.931 + "(numeral w = x) = (x = numeral w)"
74.932 + by auto
74.933 +
74.934 +lemma mult_numeral_1: "Numeral1 * a = (a::'a::semiring_numeral)"
74.935 + by simp
74.936 +
74.937 +lemma mult_numeral_1_right: "a * Numeral1 = (a::'a::semiring_numeral)"
74.938 + by simp
74.939 +
74.940 +lemma divide_numeral_1: "a / Numeral1 = (a::'a::field)"
74.941 + by simp
74.942 +
74.943 +lemma inverse_numeral_1:
74.944 + "inverse Numeral1 = (Numeral1::'a::division_ring)"
74.945 + by simp
74.946 +
74.947 +text{*Theorem lists for the cancellation simprocs. The use of a numary
74.948 +numeral for 1 reduces the number of special cases.*}
74.949 +
74.950 +lemmas mult_1s =
74.951 + mult_numeral_1 mult_numeral_1_right
74.952 + mult_minus1 mult_minus1_right
74.953 +
74.954 +
74.955 +subsubsection {* Simplification of arithmetic operations on integer constants. *}
74.956 +
74.957 +lemmas arith_special = (* already declared simp above *)
74.958 + add_numeral_special add_neg_numeral_special
74.959 + diff_numeral_special minus_one
74.960 +
74.961 +(* rules already in simpset *)
74.962 +lemmas arith_extra_simps =
74.963 + numeral_plus_numeral add_neg_numeral_simps add_0_left add_0_right
74.964 + minus_numeral minus_neg_numeral minus_zero minus_one
74.965 + diff_numeral_simps diff_0 diff_0_right
74.966 + numeral_times_numeral mult_neg_numeral_simps
74.967 + mult_zero_left mult_zero_right
74.968 + abs_numeral abs_neg_numeral
74.969 +
74.970 +text {*
74.971 + For making a minimal simpset, one must include these default simprules.
74.972 + Also include @{text simp_thms}.
74.973 +*}
74.974 +
74.975 +lemmas arith_simps =
74.976 + add_num_simps mult_num_simps sub_num_simps
74.977 + BitM.simps dbl_simps dbl_inc_simps dbl_dec_simps
74.978 + abs_zero abs_one arith_extra_simps
74.979 +
74.980 +text {* Simplification of relational operations *}
74.981 +
74.982 +lemmas eq_numeral_extra =
74.983 + zero_neq_one one_neq_zero
74.984 +
74.985 +lemmas rel_simps =
74.986 + le_num_simps less_num_simps eq_num_simps
74.987 + le_numeral_simps le_neg_numeral_simps le_numeral_extra
74.988 + less_numeral_simps less_neg_numeral_simps less_numeral_extra
74.989 + eq_numeral_simps eq_neg_numeral_simps eq_numeral_extra
74.990 +
74.991 +
74.992 +subsubsection {* Simplification of arithmetic when nested to the right. *}
74.993 +
74.994 +lemma add_numeral_left [simp]:
74.995 + "numeral v + (numeral w + z) = (numeral(v + w) + z)"
74.996 + by (simp_all add: add_assoc [symmetric])
74.997 +
74.998 +lemma add_neg_numeral_left [simp]:
74.999 + "numeral v + (neg_numeral w + y) = (sub v w + y)"
74.1000 + "neg_numeral v + (numeral w + y) = (sub w v + y)"
74.1001 + "neg_numeral v + (neg_numeral w + y) = (neg_numeral(v + w) + y)"
74.1002 + by (simp_all add: add_assoc [symmetric])
74.1003 +
74.1004 +lemma mult_numeral_left [simp]:
74.1005 + "numeral v * (numeral w * z) = (numeral(v * w) * z :: 'a::semiring_numeral)"
74.1006 + "neg_numeral v * (numeral w * y) = (neg_numeral(v * w) * y :: 'b::ring_1)"
74.1007 + "numeral v * (neg_numeral w * y) = (neg_numeral(v * w) * y :: 'b::ring_1)"
74.1008 + "neg_numeral v * (neg_numeral w * y) = (numeral(v * w) * y :: 'b::ring_1)"
74.1009 + by (simp_all add: mult_assoc [symmetric])
74.1010 +
74.1011 +hide_const (open) One Bit0 Bit1 BitM inc pow sqr sub dbl dbl_inc dbl_dec
74.1012 +
74.1013 +subsection {* code module namespace *}
74.1014 +
74.1015 +code_modulename SML
74.1016 + Numeral Arith
74.1017 +
74.1018 +code_modulename OCaml
74.1019 + Numeral Arith
74.1020 +
74.1021 +code_modulename Haskell
74.1022 + Numeral Arith
74.1023 +
74.1024 +end
75.1 --- a/src/HOL/Number_Theory/Primes.thy Mon Mar 26 15:32:54 2012 +0200
75.2 +++ b/src/HOL/Number_Theory/Primes.thy Mon Mar 26 15:33:28 2012 +0200
75.3 @@ -206,7 +206,7 @@
75.4 "prime (p::nat) \<longleftrightarrow> p > 1 \<and> (\<forall>n \<in> set [2..<p]. \<not> n dvd p)"
75.5 by (auto simp add: prime_nat_code)
75.6
75.7 -lemmas prime_nat_simp_number_of [simp] = prime_nat_simp [of "number_of m"] for m
75.8 +lemmas prime_nat_simp_numeral [simp] = prime_nat_simp [of "numeral m"] for m
75.9
75.10 lemma prime_int_code [code]:
75.11 "prime (p::int) \<longleftrightarrow> p > 1 \<and> (\<forall>n \<in> {1<..<p}. ~ n dvd p)" (is "?L = ?R")
75.12 @@ -222,7 +222,7 @@
75.13 lemma prime_int_simp: "prime (p::int) \<longleftrightarrow> p > 1 \<and> (\<forall>n \<in> set [2..p - 1]. ~ n dvd p)"
75.14 by (auto simp add: prime_int_code)
75.15
75.16 -lemmas prime_int_simp_number_of [simp] = prime_int_simp [of "number_of m"] for m
75.17 +lemmas prime_int_simp_numeral [simp] = prime_int_simp [of "numeral m"] for m
75.18
75.19 lemma two_is_prime_nat [simp]: "prime (2::nat)"
75.20 by simp
76.1 --- a/src/HOL/Numeral_Simprocs.thy Mon Mar 26 15:32:54 2012 +0200
76.2 +++ b/src/HOL/Numeral_Simprocs.thy Mon Mar 26 15:33:28 2012 +0200
76.3 @@ -14,8 +14,8 @@
76.4 ("Tools/nat_numeral_simprocs.ML")
76.5 begin
76.6
76.7 -declare split_div [of _ _ "number_of k", arith_split] for k
76.8 -declare split_mod [of _ _ "number_of k", arith_split] for k
76.9 +declare split_div [of _ _ "numeral k", arith_split] for k
76.10 +declare split_mod [of _ _ "numeral k", arith_split] for k
76.11
76.12 text {* For @{text combine_numerals} *}
76.13
76.14 @@ -98,72 +98,74 @@
76.15 ("(a::'a::comm_semiring_1_cancel) * b") =
76.16 {* fn phi => Numeral_Simprocs.assoc_fold *}
76.17
76.18 +(* TODO: see whether the type class can be generalized further *)
76.19 simproc_setup int_combine_numerals
76.20 - ("(i::'a::number_ring) + j" | "(i::'a::number_ring) - j") =
76.21 + ("(i::'a::comm_ring_1) + j" | "(i::'a::comm_ring_1) - j") =
76.22 {* fn phi => Numeral_Simprocs.combine_numerals *}
76.23
76.24 simproc_setup field_combine_numerals
76.25 - ("(i::'a::{field_inverse_zero,ring_char_0,number_ring}) + j"
76.26 - |"(i::'a::{field_inverse_zero,ring_char_0,number_ring}) - j") =
76.27 + ("(i::'a::{field_inverse_zero,ring_char_0}) + j"
76.28 + |"(i::'a::{field_inverse_zero,ring_char_0}) - j") =
76.29 {* fn phi => Numeral_Simprocs.field_combine_numerals *}
76.30
76.31 simproc_setup inteq_cancel_numerals
76.32 - ("(l::'a::number_ring) + m = n"
76.33 - |"(l::'a::number_ring) = m + n"
76.34 - |"(l::'a::number_ring) - m = n"
76.35 - |"(l::'a::number_ring) = m - n"
76.36 - |"(l::'a::number_ring) * m = n"
76.37 - |"(l::'a::number_ring) = m * n"
76.38 - |"- (l::'a::number_ring) = m"
76.39 - |"(l::'a::number_ring) = - m") =
76.40 + ("(l::'a::comm_ring_1) + m = n"
76.41 + |"(l::'a::comm_ring_1) = m + n"
76.42 + |"(l::'a::comm_ring_1) - m = n"
76.43 + |"(l::'a::comm_ring_1) = m - n"
76.44 + |"(l::'a::comm_ring_1) * m = n"
76.45 + |"(l::'a::comm_ring_1) = m * n"
76.46 + |"- (l::'a::comm_ring_1) = m"
76.47 + |"(l::'a::comm_ring_1) = - m") =
76.48 {* fn phi => Numeral_Simprocs.eq_cancel_numerals *}
76.49
76.50 simproc_setup intless_cancel_numerals
76.51 - ("(l::'a::{linordered_idom,number_ring}) + m < n"
76.52 - |"(l::'a::{linordered_idom,number_ring}) < m + n"
76.53 - |"(l::'a::{linordered_idom,number_ring}) - m < n"
76.54 - |"(l::'a::{linordered_idom,number_ring}) < m - n"
76.55 - |"(l::'a::{linordered_idom,number_ring}) * m < n"
76.56 - |"(l::'a::{linordered_idom,number_ring}) < m * n"
76.57 - |"- (l::'a::{linordered_idom,number_ring}) < m"
76.58 - |"(l::'a::{linordered_idom,number_ring}) < - m") =
76.59 + ("(l::'a::linordered_idom) + m < n"
76.60 + |"(l::'a::linordered_idom) < m + n"
76.61 + |"(l::'a::linordered_idom) - m < n"
76.62 + |"(l::'a::linordered_idom) < m - n"
76.63 + |"(l::'a::linordered_idom) * m < n"
76.64 + |"(l::'a::linordered_idom) < m * n"
76.65 + |"- (l::'a::linordered_idom) < m"
76.66 + |"(l::'a::linordered_idom) < - m") =
76.67 {* fn phi => Numeral_Simprocs.less_cancel_numerals *}
76.68
76.69 simproc_setup intle_cancel_numerals
76.70 - ("(l::'a::{linordered_idom,number_ring}) + m \<le> n"
76.71 - |"(l::'a::{linordered_idom,number_ring}) \<le> m + n"
76.72 - |"(l::'a::{linordered_idom,number_ring}) - m \<le> n"
76.73 - |"(l::'a::{linordered_idom,number_ring}) \<le> m - n"
76.74 - |"(l::'a::{linordered_idom,number_ring}) * m \<le> n"
76.75 - |"(l::'a::{linordered_idom,number_ring}) \<le> m * n"
76.76 - |"- (l::'a::{linordered_idom,number_ring}) \<le> m"
76.77 - |"(l::'a::{linordered_idom,number_ring}) \<le> - m") =
76.78 + ("(l::'a::linordered_idom) + m \<le> n"
76.79 + |"(l::'a::linordered_idom) \<le> m + n"
76.80 + |"(l::'a::linordered_idom) - m \<le> n"
76.81 + |"(l::'a::linordered_idom) \<le> m - n"
76.82 + |"(l::'a::linordered_idom) * m \<le> n"
76.83 + |"(l::'a::linordered_idom) \<le> m * n"
76.84 + |"- (l::'a::linordered_idom) \<le> m"
76.85 + |"(l::'a::linordered_idom) \<le> - m") =
76.86 {* fn phi => Numeral_Simprocs.le_cancel_numerals *}
76.87
76.88 simproc_setup ring_eq_cancel_numeral_factor
76.89 - ("(l::'a::{idom,ring_char_0,number_ring}) * m = n"
76.90 - |"(l::'a::{idom,ring_char_0,number_ring}) = m * n") =
76.91 + ("(l::'a::{idom,ring_char_0}) * m = n"
76.92 + |"(l::'a::{idom,ring_char_0}) = m * n") =
76.93 {* fn phi => Numeral_Simprocs.eq_cancel_numeral_factor *}
76.94
76.95 simproc_setup ring_less_cancel_numeral_factor
76.96 - ("(l::'a::{linordered_idom,number_ring}) * m < n"
76.97 - |"(l::'a::{linordered_idom,number_ring}) < m * n") =
76.98 + ("(l::'a::linordered_idom) * m < n"
76.99 + |"(l::'a::linordered_idom) < m * n") =
76.100 {* fn phi => Numeral_Simprocs.less_cancel_numeral_factor *}
76.101
76.102 simproc_setup ring_le_cancel_numeral_factor
76.103 - ("(l::'a::{linordered_idom,number_ring}) * m <= n"
76.104 - |"(l::'a::{linordered_idom,number_ring}) <= m * n") =
76.105 + ("(l::'a::linordered_idom) * m <= n"
76.106 + |"(l::'a::linordered_idom) <= m * n") =
76.107 {* fn phi => Numeral_Simprocs.le_cancel_numeral_factor *}
76.108
76.109 +(* TODO: remove comm_ring_1 constraint if possible *)
76.110 simproc_setup int_div_cancel_numeral_factors
76.111 - ("((l::'a::{semiring_div,ring_char_0,number_ring}) * m) div n"
76.112 - |"(l::'a::{semiring_div,ring_char_0,number_ring}) div (m * n)") =
76.113 + ("((l::'a::{semiring_div,comm_ring_1,ring_char_0}) * m) div n"
76.114 + |"(l::'a::{semiring_div,comm_ring_1,ring_char_0}) div (m * n)") =
76.115 {* fn phi => Numeral_Simprocs.div_cancel_numeral_factor *}
76.116
76.117 simproc_setup divide_cancel_numeral_factor
76.118 - ("((l::'a::{field_inverse_zero,ring_char_0,number_ring}) * m) / n"
76.119 - |"(l::'a::{field_inverse_zero,ring_char_0,number_ring}) / (m * n)"
76.120 - |"((number_of v)::'a::{field_inverse_zero,ring_char_0,number_ring}) / (number_of w)") =
76.121 + ("((l::'a::{field_inverse_zero,ring_char_0}) * m) / n"
76.122 + |"(l::'a::{field_inverse_zero,ring_char_0}) / (m * n)"
76.123 + |"((numeral v)::'a::{field_inverse_zero,ring_char_0}) / (numeral w)") =
76.124 {* fn phi => Numeral_Simprocs.divide_cancel_numeral_factor *}
76.125
76.126 simproc_setup ring_eq_cancel_factor
76.127 @@ -270,19 +272,25 @@
76.128 ("((l::nat) * m) dvd n" | "(l::nat) dvd (m * n)") =
76.129 {* fn phi => Nat_Numeral_Simprocs.dvd_cancel_factor *}
76.130
76.131 +(* FIXME: duplicate rule warnings for:
76.132 + ring_distribs
76.133 + numeral_plus_numeral numeral_times_numeral
76.134 + numeral_eq_iff numeral_less_iff numeral_le_iff
76.135 + numeral_neq_zero zero_neq_numeral zero_less_numeral
76.136 + if_True if_False *)
76.137 declaration {*
76.138 - K (Lin_Arith.add_simps (@{thms neg_simps} @ [@{thm Suc_nat_number_of}, @{thm int_nat_number_of}])
76.139 - #> Lin_Arith.add_simps (@{thms ring_distribs} @ [@{thm Let_number_of}, @{thm Let_0}, @{thm Let_1},
76.140 + K (Lin_Arith.add_simps ([@{thm Suc_numeral}, @{thm int_numeral}])
76.141 + #> Lin_Arith.add_simps (@{thms ring_distribs} @ [@{thm Let_numeral}, @{thm Let_neg_numeral}, @{thm Let_0}, @{thm Let_1},
76.142 @{thm nat_0}, @{thm nat_1},
76.143 - @{thm add_nat_number_of}, @{thm diff_nat_number_of}, @{thm mult_nat_number_of},
76.144 - @{thm eq_nat_number_of}, @{thm less_nat_number_of}, @{thm le_number_of_eq_not_less},
76.145 - @{thm le_Suc_number_of}, @{thm le_number_of_Suc},
76.146 - @{thm less_Suc_number_of}, @{thm less_number_of_Suc},
76.147 - @{thm Suc_eq_number_of}, @{thm eq_number_of_Suc},
76.148 + @{thm numeral_plus_numeral}, @{thm diff_nat_numeral}, @{thm numeral_times_numeral},
76.149 + @{thm numeral_eq_iff}, @{thm numeral_less_iff}, @{thm numeral_le_iff},
76.150 + @{thm le_Suc_numeral}, @{thm le_numeral_Suc},
76.151 + @{thm less_Suc_numeral}, @{thm less_numeral_Suc},
76.152 + @{thm Suc_eq_numeral}, @{thm eq_numeral_Suc},
76.153 @{thm mult_Suc}, @{thm mult_Suc_right},
76.154 @{thm add_Suc}, @{thm add_Suc_right},
76.155 - @{thm eq_number_of_0}, @{thm eq_0_number_of}, @{thm less_0_number_of},
76.156 - @{thm of_int_number_of_eq}, @{thm of_nat_number_of_eq}, @{thm nat_number_of},
76.157 + @{thm numeral_neq_zero}, @{thm zero_neq_numeral}, @{thm zero_less_numeral},
76.158 + @{thm of_int_numeral}, @{thm of_nat_numeral}, @{thm nat_numeral},
76.159 @{thm if_True}, @{thm if_False}])
76.160 #> Lin_Arith.add_simprocs
76.161 [@{simproc semiring_assoc_fold},
77.1 --- a/src/HOL/Parity.thy Mon Mar 26 15:32:54 2012 +0200
77.2 +++ b/src/HOL/Parity.thy Mon Mar 26 15:33:28 2012 +0200
77.3 @@ -45,9 +45,11 @@
77.4
77.5 lemma odd_1_nat [simp]: "odd (1::nat)" by presburger
77.6
77.7 -declare even_def[of "number_of v", simp] for v
77.8 +(* TODO: proper simp rules for Num.Bit0, Num.Bit1 *)
77.9 +declare even_def[of "numeral v", simp] for v
77.10 +declare even_def[of "neg_numeral v", simp] for v
77.11
77.12 -declare even_nat_def[of "number_of v", simp] for v
77.13 +declare even_nat_def[of "numeral v", simp] for v
77.14
77.15 subsection {* Even and odd are mutually exclusive *}
77.16
77.17 @@ -197,18 +199,18 @@
77.18 using minus_one_even_odd_power by blast
77.19
77.20 lemma neg_one_even_odd_power:
77.21 - "(even x --> (-1::'a::{number_ring})^x = 1) &
77.22 + "(even x --> (-1::'a::{comm_ring_1})^x = 1) &
77.23 (odd x --> (-1::'a)^x = -1)"
77.24 apply (induct x)
77.25 apply (simp, simp)
77.26 done
77.27
77.28 lemma neg_one_even_power [simp]:
77.29 - "even x ==> (-1::'a::{number_ring})^x = 1"
77.30 + "even x ==> (-1::'a::{comm_ring_1})^x = 1"
77.31 using neg_one_even_odd_power by blast
77.32
77.33 lemma neg_one_odd_power [simp]:
77.34 - "odd x ==> (-1::'a::{number_ring})^x = -1"
77.35 + "odd x ==> (-1::'a::{comm_ring_1})^x = -1"
77.36 using neg_one_even_odd_power by blast
77.37
77.38 lemma neg_power_if:
77.39 @@ -347,27 +349,28 @@
77.40
77.41 text {* Simplify, when the exponent is a numeral *}
77.42
77.43 -lemmas power_0_left_number_of = power_0_left [of "number_of w"] for w
77.44 -declare power_0_left_number_of [simp]
77.45 +lemma power_0_left_numeral [simp]:
77.46 + "0 ^ numeral w = (0::'a::{power,semiring_0})"
77.47 +by (simp add: power_0_left)
77.48
77.49 -lemmas zero_le_power_eq_number_of [simp] =
77.50 - zero_le_power_eq [of _ "number_of w"] for w
77.51 +lemmas zero_le_power_eq_numeral [simp] =
77.52 + zero_le_power_eq [of _ "numeral w"] for w
77.53
77.54 -lemmas zero_less_power_eq_number_of [simp] =
77.55 - zero_less_power_eq [of _ "number_of w"] for w
77.56 +lemmas zero_less_power_eq_numeral [simp] =
77.57 + zero_less_power_eq [of _ "numeral w"] for w
77.58
77.59 -lemmas power_le_zero_eq_number_of [simp] =
77.60 - power_le_zero_eq [of _ "number_of w"] for w
77.61 +lemmas power_le_zero_eq_numeral [simp] =
77.62 + power_le_zero_eq [of _ "numeral w"] for w
77.63
77.64 -lemmas power_less_zero_eq_number_of [simp] =
77.65 - power_less_zero_eq [of _ "number_of w"] for w
77.66 +lemmas power_less_zero_eq_numeral [simp] =
77.67 + power_less_zero_eq [of _ "numeral w"] for w
77.68
77.69 -lemmas zero_less_power_nat_eq_number_of [simp] =
77.70 - zero_less_power_nat_eq [of _ "number_of w"] for w
77.71 +lemmas zero_less_power_nat_eq_numeral [simp] =
77.72 + zero_less_power_nat_eq [of _ "numeral w"] for w
77.73
77.74 -lemmas power_eq_0_iff_number_of [simp] = power_eq_0_iff [of _ "number_of w"] for w
77.75 +lemmas power_eq_0_iff_numeral [simp] = power_eq_0_iff [of _ "numeral w"] for w
77.76
77.77 -lemmas power_even_abs_number_of [simp] = power_even_abs [of "number_of w" _] for w
77.78 +lemmas power_even_abs_numeral [simp] = power_even_abs [of "numeral w" _] for w
77.79
77.80
77.81 subsection {* An Equivalence for @{term [source] "0 \<le> a^n"} *}
78.1 --- a/src/HOL/Plain.thy Mon Mar 26 15:32:54 2012 +0200
78.2 +++ b/src/HOL/Plain.thy Mon Mar 26 15:33:28 2012 +0200
78.3 @@ -1,7 +1,7 @@
78.4 header {* Plain HOL *}
78.5
78.6 theory Plain
78.7 -imports Datatype FunDef Extraction Metis
78.8 +imports Datatype FunDef Extraction Metis Num
78.9 begin
78.10
78.11 text {*
79.1 --- a/src/HOL/Predicate_Compile_Examples/Predicate_Compile_Tests.thy Mon Mar 26 15:32:54 2012 +0200
79.2 +++ b/src/HOL/Predicate_Compile_Examples/Predicate_Compile_Tests.thy Mon Mar 26 15:33:28 2012 +0200
79.3 @@ -334,7 +334,7 @@
79.4 code_pred [dseq] one_or_two .
79.5 code_pred [random_dseq] one_or_two .
79.6 thm one_or_two.dseq_equation
79.7 -values [expected "{Suc 0::nat, 2::nat}"] "{x. one_or_two x}"
79.8 +values [expected "{1::nat, 2::nat}"] "{x. one_or_two x}"
79.9 values [random_dseq 0,0,10] 3 "{x. one_or_two x}"
79.10
79.11 inductive one_or_two' :: "nat => bool"
79.12 @@ -442,7 +442,7 @@
79.13 values "{ys. append [0, Suc 0, 2] ys [0, Suc 0, 2, 17, 0, 5]}"
79.14
79.15 values [expected "{}" dseq 0] 10 "{(xs, ys). append xs ys [1, 2, 3, 4, (5::nat)]}"
79.16 -values [expected "{(([]::nat list), [Suc 0, 2, 3, 4, (5::nat)])}" dseq 1] 10 "{(xs, ys). append xs ys [1, 2, 3, 4, (5::nat)]}"
79.17 +values [expected "{(([]::nat list), [1, 2, 3, 4, (5::nat)])}" dseq 1] 10 "{(xs, ys). append xs ys [1, 2, 3, 4, (5::nat)]}"
79.18 values [dseq 4] 10 "{(xs, ys). append xs ys [1, 2, 3, 4, (5::nat)]}"
79.19 values [dseq 6] 10 "{(xs, ys). append xs ys [1, 2, 3, 4, (5::nat)]}"
79.20 values [random_dseq 1, 1, 4] 10 "{(xs, ys). append xs ys [1, 2, 3, 4, (5::nat)]}"
79.21 @@ -1241,8 +1241,8 @@
79.22 values [expected "{2::nat}"] "{x. plus_nat_test x 7 9}"
79.23 values [expected "{}"] "{x. plus_nat_test x 9 7}"
79.24 values [expected "{(0::nat,0::nat)}"] "{(x, y). plus_nat_test x y 0}"
79.25 -values [expected "{(0, Suc 0), (Suc 0, 0)}"] "{(x, y). plus_nat_test x y 1}"
79.26 -values [expected "{(0, 5), (4, Suc 0), (3, 2), (2, 3), (Suc 0, 4), (5, 0)}"]
79.27 +values [expected "{(0::nat, 1::nat), (1, 0)}"] "{(x, y). plus_nat_test x y 1}"
79.28 +values [expected "{(0::nat, 5::nat), (4, 1), (3, 2), (2, 3), (1, 4), (5, 0)}"]
79.29 "{(x, y). plus_nat_test x y 5}"
79.30
79.31 inductive minus_nat_test :: "nat => nat => nat => bool"
79.32 @@ -1259,7 +1259,7 @@
79.33 values [expected "{5::nat}"] "{z. minus_nat_test 7 2 z}"
79.34 values [expected "{16::nat}"] "{x. minus_nat_test x 7 9}"
79.35 values [expected "{16::nat}"] "{x. minus_nat_test x 9 7}"
79.36 -values [expected "{0, Suc 0, 2, 3}"] "{x. minus_nat_test x 3 0}"
79.37 +values [expected "{0::nat, 1, 2, 3}"] "{x. minus_nat_test x 3 0}"
79.38 values [expected "{0::nat}"] "{x. minus_nat_test x 0 0}"
79.39
79.40 subsection {* Examples on int *}
80.1 --- a/src/HOL/Presburger.thy Mon Mar 26 15:32:54 2012 +0200
80.2 +++ b/src/HOL/Presburger.thy Mon Mar 26 15:33:28 2012 +0200
80.3 @@ -374,18 +374,16 @@
80.4 ((y \<le> x \<longrightarrow> P (int x - int y)) \<and> (x < y \<longrightarrow> P 0))"
80.5 by (cases "y \<le> x") (simp_all add: zdiff_int)
80.6
80.7 -lemma number_of1: "(0::int) <= number_of n \<Longrightarrow> (0::int) <= number_of (Int.Bit0 n) \<and> (0::int) <= number_of (Int.Bit1 n)"
80.8 -by simp
80.9 -
80.10 -lemma number_of2: "(0::int) <= Numeral0" by simp
80.11 -
80.12 text {*
80.13 \medskip Specific instances of congruence rules, to prevent
80.14 simplifier from looping. *}
80.15
80.16 -theorem imp_le_cong: "(0 <= x \<Longrightarrow> P = P') \<Longrightarrow> (0 <= (x::int) \<longrightarrow> P) = (0 <= x \<longrightarrow> P')" by simp
80.17 +theorem imp_le_cong:
80.18 + "\<lbrakk>x = x'; 0 \<le> x' \<Longrightarrow> P = P'\<rbrakk> \<Longrightarrow> (0 \<le> (x::int) \<longrightarrow> P) = (0 \<le> x' \<longrightarrow> P')"
80.19 + by simp
80.20
80.21 -theorem conj_le_cong: "(0 <= x \<Longrightarrow> P = P') \<Longrightarrow> (0 <= (x::int) \<and> P) = (0 <= x \<and> P')"
80.22 +theorem conj_le_cong:
80.23 + "\<lbrakk>x = x'; 0 \<le> x' \<Longrightarrow> P = P'\<rbrakk> \<Longrightarrow> (0 \<le> (x::int) \<and> P) = (0 \<le> x' \<and> P')"
80.24 by (simp cong: conj_cong)
80.25
80.26 use "Tools/Qelim/cooper.ML"
81.1 --- a/src/HOL/Quickcheck_Examples/Quickcheck_Narrowing_Examples.thy Mon Mar 26 15:32:54 2012 +0200
81.2 +++ b/src/HOL/Quickcheck_Examples/Quickcheck_Narrowing_Examples.thy Mon Mar 26 15:33:28 2012 +0200
81.3 @@ -79,15 +79,14 @@
81.4 quickcheck[tester = narrowing, finite_types = false, default_type = nat, expect = counterexample]
81.5 oops
81.6
81.7 -(* FIXME: integer has strange representation! *)
81.8 lemma "rev xs = xs"
81.9 quickcheck[tester = narrowing, finite_types = false, default_type = int, expect = counterexample]
81.10 oops
81.11 -(*
81.12 +
81.13 lemma "rev xs = xs"
81.14 quickcheck[tester = narrowing, finite_types = true, expect = counterexample]
81.15 oops
81.16 -*)
81.17 +
81.18 subsection {* Simple examples with functions *}
81.19
81.20 lemma "map f xs = map g xs"
82.1 --- a/src/HOL/Quickcheck_Narrowing.thy Mon Mar 26 15:32:54 2012 +0200
82.2 +++ b/src/HOL/Quickcheck_Narrowing.thy Mon Mar 26 15:33:28 2012 +0200
82.3 @@ -70,34 +70,15 @@
82.4 "HOL.equal k l \<longleftrightarrow> HOL.equal (int_of k) (int_of l)"
82.5
82.6 instance proof
82.7 -qed (auto simp add: equal_code_int_def equal_int_def eq_int_refl)
82.8 +qed (auto simp add: equal_code_int_def equal_int_def equal_int_refl)
82.9
82.10 end
82.11
82.12 -instantiation code_int :: number
82.13 -begin
82.14 -
82.15 -definition
82.16 - "number_of = of_int"
82.17 -
82.18 -instance ..
82.19 -
82.20 -end
82.21 -
82.22 -lemma int_of_number [simp]:
82.23 - "int_of (number_of k) = number_of k"
82.24 - by (simp add: number_of_code_int_def number_of_is_id)
82.25 -
82.26 -
82.27 definition nat_of :: "code_int => nat"
82.28 where
82.29 "nat_of i = nat (int_of i)"
82.30 -
82.31 -
82.32 -code_datatype "number_of \<Colon> int \<Rightarrow> code_int"
82.33
82.34 -
82.35 -instantiation code_int :: "{minus, linordered_semidom, semiring_div, linorder}"
82.36 +instantiation code_int :: "{minus, linordered_semidom, semiring_div, neg_numeral, linorder}"
82.37 begin
82.38
82.39 definition [simp, code del]:
82.40 @@ -110,6 +91,9 @@
82.41 "n + m = of_int (int_of n + int_of m)"
82.42
82.43 definition [simp, code del]:
82.44 + "- n = of_int (- int_of n)"
82.45 +
82.46 +definition [simp, code del]:
82.47 "n - m = of_int (int_of n - int_of m)"
82.48
82.49 definition [simp, code del]:
82.50 @@ -127,34 +111,43 @@
82.51 definition [simp, code del]:
82.52 "n < m \<longleftrightarrow> int_of n < int_of m"
82.53
82.54 -
82.55 instance proof
82.56 qed (auto simp add: code_int left_distrib zmult_zless_mono2)
82.57
82.58 end
82.59
82.60 -lemma zero_code_int_code [code, code_unfold]:
82.61 - "(0\<Colon>code_int) = Numeral0"
82.62 - by (simp add: number_of_code_int_def Pls_def)
82.63 +lemma int_of_numeral [simp]:
82.64 + "int_of (numeral k) = numeral k"
82.65 + by (induct k) (simp_all only: numeral.simps plus_code_int_def
82.66 + one_code_int_def of_int_inverse UNIV_I)
82.67 +
82.68 +definition Num :: "num \<Rightarrow> code_int"
82.69 + where [code_abbrev]: "Num = numeral"
82.70 +
82.71 +lemma [code_abbrev]:
82.72 + "- numeral k = (neg_numeral k :: code_int)"
82.73 + by (unfold neg_numeral_def) simp
82.74 +
82.75 +code_datatype "0::code_int" Num
82.76
82.77 lemma one_code_int_code [code, code_unfold]:
82.78 "(1\<Colon>code_int) = Numeral1"
82.79 - by (simp add: number_of_code_int_def Pls_def Bit1_def)
82.80 + by (simp only: numeral.simps)
82.81
82.82 -definition div_mod_code_int :: "code_int \<Rightarrow> code_int \<Rightarrow> code_int \<times> code_int" where
82.83 - [code del]: "div_mod_code_int n m = (n div m, n mod m)"
82.84 +definition div_mod :: "code_int \<Rightarrow> code_int \<Rightarrow> code_int \<times> code_int" where
82.85 + [code del]: "div_mod n m = (n div m, n mod m)"
82.86
82.87 lemma [code]:
82.88 - "div_mod_code_int n m = (if m = 0 then (0, n) else (n div m, n mod m))"
82.89 - unfolding div_mod_code_int_def by auto
82.90 + "div_mod n m = (if m = 0 then (0, n) else (n div m, n mod m))"
82.91 + unfolding div_mod_def by auto
82.92
82.93 lemma [code]:
82.94 - "n div m = fst (div_mod_code_int n m)"
82.95 - unfolding div_mod_code_int_def by simp
82.96 + "n div m = fst (div_mod n m)"
82.97 + unfolding div_mod_def by simp
82.98
82.99 lemma [code]:
82.100 - "n mod m = snd (div_mod_code_int n m)"
82.101 - unfolding div_mod_code_int_def by simp
82.102 + "n mod m = snd (div_mod n m)"
82.103 + unfolding div_mod_def by simp
82.104
82.105 lemma int_of_code [code]:
82.106 "int_of k = (if k = 0 then 0
82.107 @@ -172,9 +165,12 @@
82.108 code_instance code_numeral :: equal
82.109 (Haskell_Quickcheck -)
82.110
82.111 -setup {* fold (Numeral.add_code @{const_name number_code_int_inst.number_of_code_int}
82.112 +setup {* fold (Numeral.add_code @{const_name Num}
82.113 false Code_Printer.literal_numeral) ["Haskell_Quickcheck"] *}
82.114
82.115 +code_type code_int
82.116 + (Haskell_Quickcheck "Int")
82.117 +
82.118 code_const "0 \<Colon> code_int"
82.119 (Haskell_Quickcheck "0")
82.120
82.121 @@ -182,24 +178,23 @@
82.122 (Haskell_Quickcheck "1")
82.123
82.124 code_const "minus \<Colon> code_int \<Rightarrow> code_int \<Rightarrow> code_int"
82.125 - (Haskell_Quickcheck "(_/ -/ _)")
82.126 + (Haskell_Quickcheck infixl 6 "-")
82.127
82.128 -code_const div_mod_code_int
82.129 +code_const div_mod
82.130 (Haskell_Quickcheck "divMod")
82.131
82.132 code_const "HOL.equal \<Colon> code_int \<Rightarrow> code_int \<Rightarrow> bool"
82.133 (Haskell_Quickcheck infix 4 "==")
82.134
82.135 -code_const "op \<le> \<Colon> code_int \<Rightarrow> code_int \<Rightarrow> bool"
82.136 +code_const "less_eq \<Colon> code_int \<Rightarrow> code_int \<Rightarrow> bool"
82.137 (Haskell_Quickcheck infix 4 "<=")
82.138
82.139 -code_const "op < \<Colon> code_int \<Rightarrow> code_int \<Rightarrow> bool"
82.140 +code_const "less \<Colon> code_int \<Rightarrow> code_int \<Rightarrow> bool"
82.141 (Haskell_Quickcheck infix 4 "<")
82.142
82.143 -code_type code_int
82.144 - (Haskell_Quickcheck "Int")
82.145 +code_abort of_int
82.146
82.147 -code_abort of_int
82.148 +hide_const (open) Num div_mod
82.149
82.150 subsubsection {* Narrowing's deep representation of types and terms *}
82.151
83.1 --- a/src/HOL/Quotient_Examples/Quotient_Rat.thy Mon Mar 26 15:32:54 2012 +0200
83.2 +++ b/src/HOL/Quotient_Examples/Quotient_Rat.thy Mon Mar 26 15:33:28 2012 +0200
83.3 @@ -159,17 +159,6 @@
83.4 apply auto
83.5 done
83.6
83.7 -instantiation rat :: number_ring
83.8 -begin
83.9 -
83.10 -definition
83.11 - rat_number_of_def: "number_of w = Fract w 1"
83.12 -
83.13 -instance apply default
83.14 - unfolding rat_number_of_def of_int_rat ..
83.15 -
83.16 -end
83.17 -
83.18 instantiation rat :: field_inverse_zero begin
83.19
83.20 fun rat_inverse_raw where
84.1 --- a/src/HOL/RComplete.thy Mon Mar 26 15:32:54 2012 +0200
84.2 +++ b/src/HOL/RComplete.thy Mon Mar 26 15:33:28 2012 +0200
84.3 @@ -129,26 +129,27 @@
84.4
84.5 subsection{*Floor and Ceiling Functions from the Reals to the Integers*}
84.6
84.7 -lemma number_of_less_real_of_int_iff [simp]:
84.8 - "((number_of n) < real (m::int)) = (number_of n < m)"
84.9 +(* FIXME: theorems for negative numerals *)
84.10 +lemma numeral_less_real_of_int_iff [simp]:
84.11 + "((numeral n) < real (m::int)) = (numeral n < m)"
84.12 apply auto
84.13 apply (rule real_of_int_less_iff [THEN iffD1])
84.14 apply (drule_tac [2] real_of_int_less_iff [THEN iffD2], auto)
84.15 done
84.16
84.17 -lemma number_of_less_real_of_int_iff2 [simp]:
84.18 - "(real (m::int) < (number_of n)) = (m < number_of n)"
84.19 +lemma numeral_less_real_of_int_iff2 [simp]:
84.20 + "(real (m::int) < (numeral n)) = (m < numeral n)"
84.21 apply auto
84.22 apply (rule real_of_int_less_iff [THEN iffD1])
84.23 apply (drule_tac [2] real_of_int_less_iff [THEN iffD2], auto)
84.24 done
84.25
84.26 -lemma number_of_le_real_of_int_iff [simp]:
84.27 - "((number_of n) \<le> real (m::int)) = (number_of n \<le> m)"
84.28 +lemma numeral_le_real_of_int_iff [simp]:
84.29 + "((numeral n) \<le> real (m::int)) = (numeral n \<le> m)"
84.30 by (simp add: linorder_not_less [symmetric])
84.31
84.32 -lemma number_of_le_real_of_int_iff2 [simp]:
84.33 - "(real (m::int) \<le> (number_of n)) = (m \<le> number_of n)"
84.34 +lemma numeral_le_real_of_int_iff2 [simp]:
84.35 + "(real (m::int) \<le> (numeral n)) = (m \<le> numeral n)"
84.36 by (simp add: linorder_not_less [symmetric])
84.37
84.38 lemma floor_real_of_nat [simp]: "floor (real (n::nat)) = int n"
84.39 @@ -323,7 +324,7 @@
84.40 lemma zero_le_natfloor [simp]: "0 <= natfloor x"
84.41 by (unfold natfloor_def, simp)
84.42
84.43 -lemma natfloor_number_of_eq [simp]: "natfloor (number_of n) = number_of n"
84.44 +lemma natfloor_numeral_eq [simp]: "natfloor (numeral n) = numeral n"
84.45 by (unfold natfloor_def, simp)
84.46
84.47 lemma natfloor_real_of_nat [simp]: "natfloor(real n) = n"
84.48 @@ -365,9 +366,9 @@
84.49 apply (erule le_natfloor)
84.50 done
84.51
84.52 -lemma le_natfloor_eq_number_of [simp]:
84.53 - "~ neg((number_of n)::int) ==> 0 <= x ==>
84.54 - (number_of n <= natfloor x) = (number_of n <= x)"
84.55 +lemma le_natfloor_eq_numeral [simp]:
84.56 + "~ neg((numeral n)::int) ==> 0 <= x ==>
84.57 + (numeral n <= natfloor x) = (numeral n <= x)"
84.58 apply (subst le_natfloor_eq, assumption)
84.59 apply simp
84.60 done
84.61 @@ -407,9 +408,9 @@
84.62 unfolding real_of_int_of_nat_eq [symmetric] floor_add
84.63 by (simp add: nat_add_distrib)
84.64
84.65 -lemma natfloor_add_number_of [simp]:
84.66 - "~neg ((number_of n)::int) ==> 0 <= x ==>
84.67 - natfloor (x + number_of n) = natfloor x + number_of n"
84.68 +lemma natfloor_add_numeral [simp]:
84.69 + "~neg ((numeral n)::int) ==> 0 <= x ==>
84.70 + natfloor (x + numeral n) = natfloor x + numeral n"
84.71 by (simp add: natfloor_add [symmetric])
84.72
84.73 lemma natfloor_add_one: "0 <= x ==> natfloor(x + 1) = natfloor x + 1"
84.74 @@ -453,7 +454,7 @@
84.75 lemma zero_le_natceiling [simp]: "0 <= natceiling x"
84.76 by (unfold natceiling_def, simp)
84.77
84.78 -lemma natceiling_number_of_eq [simp]: "natceiling (number_of n) = number_of n"
84.79 +lemma natceiling_numeral_eq [simp]: "natceiling (numeral n) = numeral n"
84.80 by (unfold natceiling_def, simp)
84.81
84.82 lemma natceiling_real_of_nat [simp]: "natceiling(real n) = n"
84.83 @@ -476,9 +477,9 @@
84.84 unfolding natceiling_def real_of_nat_def
84.85 by (simp add: nat_le_iff ceiling_le_iff)
84.86
84.87 -lemma natceiling_le_eq_number_of [simp]:
84.88 - "~ neg((number_of n)::int) ==>
84.89 - (natceiling x <= number_of n) = (x <= number_of n)"
84.90 +lemma natceiling_le_eq_numeral [simp]:
84.91 + "~ neg((numeral n)::int) ==>
84.92 + (natceiling x <= numeral n) = (x <= numeral n)"
84.93 by (simp add: natceiling_le_eq)
84.94
84.95 lemma natceiling_le_eq_one: "(natceiling x <= 1) = (x <= 1)"
84.96 @@ -495,9 +496,9 @@
84.97 unfolding real_of_int_of_nat_eq [symmetric] ceiling_add
84.98 by (simp add: nat_add_distrib)
84.99
84.100 -lemma natceiling_add_number_of [simp]:
84.101 - "~ neg ((number_of n)::int) ==> 0 <= x ==>
84.102 - natceiling (x + number_of n) = natceiling x + number_of n"
84.103 +lemma natceiling_add_numeral [simp]:
84.104 + "~ neg ((numeral n)::int) ==> 0 <= x ==>
84.105 + natceiling (x + numeral n) = natceiling x + numeral n"
84.106 by (simp add: natceiling_add [symmetric])
84.107
84.108 lemma natceiling_add_one: "0 <= x ==> natceiling(x + 1) = natceiling x + 1"
85.1 --- a/src/HOL/Rat.thy Mon Mar 26 15:32:54 2012 +0200
85.2 +++ b/src/HOL/Rat.thy Mon Mar 26 15:33:28 2012 +0200
85.3 @@ -230,35 +230,23 @@
85.4 lemma Fract_of_int_eq: "Fract k 1 = of_int k"
85.5 by (rule of_int_rat [symmetric])
85.6
85.7 -instantiation rat :: number_ring
85.8 -begin
85.9 -
85.10 -definition
85.11 - rat_number_of_def: "number_of w = Fract w 1"
85.12 -
85.13 -instance proof
85.14 -qed (simp add: rat_number_of_def of_int_rat)
85.15 -
85.16 -end
85.17 -
85.18 lemma rat_number_collapse:
85.19 "Fract 0 k = 0"
85.20 "Fract 1 1 = 1"
85.21 - "Fract (number_of k) 1 = number_of k"
85.22 + "Fract (numeral w) 1 = numeral w"
85.23 + "Fract (neg_numeral w) 1 = neg_numeral w"
85.24 "Fract k 0 = 0"
85.25 - by (cases "k = 0")
85.26 - (simp_all add: Zero_rat_def One_rat_def number_of_is_id number_of_eq of_int_rat eq_rat Fract_def)
85.27 + using Fract_of_int_eq [of "numeral w"]
85.28 + using Fract_of_int_eq [of "neg_numeral w"]
85.29 + by (simp_all add: Zero_rat_def One_rat_def eq_rat)
85.30
85.31 -lemma rat_number_expand [code_unfold]:
85.32 +lemma rat_number_expand:
85.33 "0 = Fract 0 1"
85.34 "1 = Fract 1 1"
85.35 - "number_of k = Fract (number_of k) 1"
85.36 + "numeral k = Fract (numeral k) 1"
85.37 + "neg_numeral k = Fract (neg_numeral k) 1"
85.38 by (simp_all add: rat_number_collapse)
85.39
85.40 -lemma iszero_rat [simp]:
85.41 - "iszero (number_of k :: rat) \<longleftrightarrow> iszero (number_of k :: int)"
85.42 - by (simp add: iszero_def rat_number_expand number_of_is_id eq_rat)
85.43 -
85.44 lemma Rat_cases_nonzero [case_names Fract 0]:
85.45 assumes Fract: "\<And>a b. q = Fract a b \<Longrightarrow> b > 0 \<Longrightarrow> a \<noteq> 0 \<Longrightarrow> coprime a b \<Longrightarrow> C"
85.46 assumes 0: "q = 0 \<Longrightarrow> C"
85.47 @@ -386,7 +374,8 @@
85.48 lemma quotient_of_number [simp]:
85.49 "quotient_of 0 = (0, 1)"
85.50 "quotient_of 1 = (1, 1)"
85.51 - "quotient_of (number_of k) = (number_of k, 1)"
85.52 + "quotient_of (numeral k) = (numeral k, 1)"
85.53 + "quotient_of (neg_numeral k) = (neg_numeral k, 1)"
85.54 by (simp_all add: rat_number_expand quotient_of_Fract)
85.55
85.56 lemma quotient_of_eq: "quotient_of (Fract a b) = (p, q) \<Longrightarrow> Fract p q = Fract a b"
85.57 @@ -453,19 +442,12 @@
85.58
85.59 subsubsection {* Various *}
85.60
85.61 +lemma Fract_of_int_quotient: "Fract k l = of_int k / of_int l"
85.62 + by (simp add: Fract_of_int_eq [symmetric])
85.63 +
85.64 lemma Fract_add_one: "n \<noteq> 0 ==> Fract (m + n) n = Fract m n + 1"
85.65 by (simp add: rat_number_expand)
85.66
85.67 -lemma Fract_of_int_quotient: "Fract k l = of_int k / of_int l"
85.68 - by (simp add: Fract_of_int_eq [symmetric])
85.69 -
85.70 -lemma Fract_number_of_quotient:
85.71 - "Fract (number_of k) (number_of l) = number_of k / number_of l"
85.72 - unfolding Fract_of_int_quotient number_of_is_id number_of_eq ..
85.73 -
85.74 -lemma Fract_1_number_of:
85.75 - "Fract 1 (number_of k) = 1 / number_of k"
85.76 - unfolding Fract_of_int_quotient number_of_eq by simp
85.77
85.78 subsubsection {* The ordered field of rational numbers *}
85.79
85.80 @@ -771,7 +753,8 @@
85.81 (* not needed because x < (y::int) can be rewritten as x + 1 <= y: of_int_less_iff RS iffD2 *)
85.82 #> Lin_Arith.add_simps [@{thm neg_less_iff_less},
85.83 @{thm True_implies_equals},
85.84 - read_instantiate @{context} [(("a", 0), "(number_of ?v)")] @{thm right_distrib},
85.85 + read_instantiate @{context} [(("a", 0), "(numeral ?v)")] @{thm right_distrib},
85.86 + read_instantiate @{context} [(("a", 0), "(neg_numeral ?v)")] @{thm right_distrib},
85.87 @{thm divide_1}, @{thm divide_zero_left},
85.88 @{thm times_divide_eq_right}, @{thm times_divide_eq_left},
85.89 @{thm minus_divide_left} RS sym, @{thm minus_divide_right} RS sym,
85.90 @@ -895,9 +878,13 @@
85.91 lemma of_rat_of_int_eq [simp]: "of_rat (of_int z) = of_int z"
85.92 by (cases z rule: int_diff_cases) (simp add: of_rat_diff)
85.93
85.94 -lemma of_rat_number_of_eq [simp]:
85.95 - "of_rat (number_of w) = (number_of w :: 'a::{number_ring,field_char_0})"
85.96 -by (simp add: number_of_eq)
85.97 +lemma of_rat_numeral_eq [simp]:
85.98 + "of_rat (numeral w) = numeral w"
85.99 +using of_rat_of_int_eq [of "numeral w"] by simp
85.100 +
85.101 +lemma of_rat_neg_numeral_eq [simp]:
85.102 + "of_rat (neg_numeral w) = neg_numeral w"
85.103 +using of_rat_of_int_eq [of "neg_numeral w"] by simp
85.104
85.105 lemmas zero_rat = Zero_rat_def
85.106 lemmas one_rat = One_rat_def
85.107 @@ -935,9 +922,11 @@
85.108 lemma Rats_of_nat [simp]: "of_nat n \<in> Rats"
85.109 by (subst of_rat_of_nat_eq [symmetric], rule Rats_of_rat)
85.110
85.111 -lemma Rats_number_of [simp]:
85.112 - "(number_of w::'a::{number_ring,field_char_0}) \<in> Rats"
85.113 -by (subst of_rat_number_of_eq [symmetric], rule Rats_of_rat)
85.114 +lemma Rats_number_of [simp]: "numeral w \<in> Rats"
85.115 +by (subst of_rat_numeral_eq [symmetric], rule Rats_of_rat)
85.116 +
85.117 +lemma Rats_neg_number_of [simp]: "neg_numeral w \<in> Rats"
85.118 +by (subst of_rat_neg_numeral_eq [symmetric], rule Rats_of_rat)
85.119
85.120 lemma Rats_0 [simp]: "0 \<in> Rats"
85.121 apply (unfold Rats_def)
85.122 @@ -1032,6 +1021,8 @@
85.123
85.124 subsection {* Implementation of rational numbers as pairs of integers *}
85.125
85.126 +text {* Formal constructor *}
85.127 +
85.128 definition Frct :: "int \<times> int \<Rightarrow> rat" where
85.129 [simp]: "Frct p = Fract (fst p) (snd p)"
85.130
85.131 @@ -1039,17 +1030,45 @@
85.132 "Frct (quotient_of q) = q"
85.133 by (cases q) (auto intro: quotient_of_eq)
85.134
85.135 -lemma Frct_code_post [code_post]:
85.136 - "Frct (0, k) = 0"
85.137 - "Frct (k, 0) = 0"
85.138 - "Frct (1, 1) = 1"
85.139 - "Frct (number_of k, 1) = number_of k"
85.140 - "Frct (1, number_of k) = 1 / number_of k"
85.141 - "Frct (number_of k, number_of l) = number_of k / number_of l"
85.142 - by (simp_all add: rat_number_collapse Fract_number_of_quotient Fract_1_number_of)
85.143 +
85.144 +text {* Numerals *}
85.145
85.146 declare quotient_of_Fract [code abstract]
85.147
85.148 +definition of_int :: "int \<Rightarrow> rat"
85.149 +where
85.150 + [code_abbrev]: "of_int = Int.of_int"
85.151 +hide_const (open) of_int
85.152 +
85.153 +lemma quotient_of_int [code abstract]:
85.154 + "quotient_of (Rat.of_int a) = (a, 1)"
85.155 + by (simp add: of_int_def of_int_rat quotient_of_Fract)
85.156 +
85.157 +lemma [code_unfold]:
85.158 + "numeral k = Rat.of_int (numeral k)"
85.159 + by (simp add: Rat.of_int_def)
85.160 +
85.161 +lemma [code_unfold]:
85.162 + "neg_numeral k = Rat.of_int (neg_numeral k)"
85.163 + by (simp add: Rat.of_int_def)
85.164 +
85.165 +lemma Frct_code_post [code_post]:
85.166 + "Frct (0, a) = 0"
85.167 + "Frct (a, 0) = 0"
85.168 + "Frct (1, 1) = 1"
85.169 + "Frct (numeral k, 1) = numeral k"
85.170 + "Frct (neg_numeral k, 1) = neg_numeral k"
85.171 + "Frct (1, numeral k) = 1 / numeral k"
85.172 + "Frct (1, neg_numeral k) = 1 / neg_numeral k"
85.173 + "Frct (numeral k, numeral l) = numeral k / numeral l"
85.174 + "Frct (numeral k, neg_numeral l) = numeral k / neg_numeral l"
85.175 + "Frct (neg_numeral k, numeral l) = neg_numeral k / numeral l"
85.176 + "Frct (neg_numeral k, neg_numeral l) = neg_numeral k / neg_numeral l"
85.177 + by (simp_all add: Fract_of_int_quotient)
85.178 +
85.179 +
85.180 +text {* Operations *}
85.181 +
85.182 lemma rat_zero_code [code abstract]:
85.183 "quotient_of 0 = (0, 1)"
85.184 by (simp add: Zero_rat_def quotient_of_Fract normalize_def)
85.185 @@ -1132,6 +1151,9 @@
85.186 "of_rat p = (let (a, b) = quotient_of p in of_int a / of_int b)"
85.187 by (cases p) (simp add: quotient_of_Fract of_rat_rat)
85.188
85.189 +
85.190 +text {* Quickcheck *}
85.191 +
85.192 definition (in term_syntax)
85.193 valterm_fract :: "int \<times> (unit \<Rightarrow> Code_Evaluation.term) \<Rightarrow> int \<times> (unit \<Rightarrow> Code_Evaluation.term) \<Rightarrow> rat \<times> (unit \<Rightarrow> Code_Evaluation.term)" where
85.194 [code_unfold]: "valterm_fract k l = Code_Evaluation.valtermify Fract {\<cdot>} k {\<cdot>} l"
85.195 @@ -1212,7 +1234,6 @@
85.196 (@{const_name plus_rat_inst.plus_rat}, @{const_name Nitpick.plus_frac}),
85.197 (@{const_name times_rat_inst.times_rat}, @{const_name Nitpick.times_frac}),
85.198 (@{const_name uminus_rat_inst.uminus_rat}, @{const_name Nitpick.uminus_frac}),
85.199 - (@{const_name number_rat_inst.number_of_rat}, @{const_name Nitpick.number_of_frac}),
85.200 (@{const_name inverse_rat_inst.inverse_rat}, @{const_name Nitpick.inverse_frac}),
85.201 (@{const_name ord_rat_inst.less_rat}, @{const_name Nitpick.less_frac}),
85.202 (@{const_name ord_rat_inst.less_eq_rat}, @{const_name Nitpick.less_eq_frac}),
85.203 @@ -1220,7 +1241,7 @@
85.204 *}
85.205
85.206 lemmas [nitpick_unfold] = inverse_rat_inst.inverse_rat
85.207 - number_rat_inst.number_of_rat one_rat_inst.one_rat ord_rat_inst.less_rat
85.208 + one_rat_inst.one_rat ord_rat_inst.less_rat
85.209 ord_rat_inst.less_eq_rat plus_rat_inst.plus_rat times_rat_inst.times_rat
85.210 uminus_rat_inst.uminus_rat zero_rat_inst.zero_rat
85.211
86.1 --- a/src/HOL/RealDef.thy Mon Mar 26 15:32:54 2012 +0200
86.2 +++ b/src/HOL/RealDef.thy Mon Mar 26 15:33:28 2012 +0200
86.3 @@ -720,7 +720,9 @@
86.4 unfolding less_eq_real_def less_real_def
86.5 by (auto, drule (1) positive_add, simp add: positive_zero)
86.6 show "a \<le> b \<Longrightarrow> c + a \<le> c + b"
86.7 - unfolding less_eq_real_def less_real_def by auto
86.8 + unfolding less_eq_real_def less_real_def by (auto simp: diff_minus) (* by auto *)
86.9 + (* FIXME: Procedure int_combine_numerals: c + b - (c + a) \<equiv> b + - a *)
86.10 + (* Should produce c + b - (c + a) \<equiv> b - a *)
86.11 show "sgn a = (if a = 0 then 0 else if 0 < a then 1 else - 1)"
86.12 by (rule sgn_real_def)
86.13 show "a \<le> b \<or> b \<le> a"
86.14 @@ -747,17 +749,6 @@
86.15
86.16 end
86.17
86.18 -instantiation real :: number_ring
86.19 -begin
86.20 -
86.21 -definition
86.22 - "(number_of x :: real) = of_int x"
86.23 -
86.24 -instance proof
86.25 -qed (rule number_of_real_def)
86.26 -
86.27 -end
86.28 -
86.29 lemma of_nat_Real: "of_nat x = Real (\<lambda>n. of_nat x)"
86.30 apply (induct x)
86.31 apply (simp add: zero_real_def)
86.32 @@ -877,7 +868,7 @@
86.33 by (erule contrapos_pp, simp add: not_less, erule Real_leI [OF Y])
86.34
86.35 lemma of_nat_less_two_power:
86.36 - "of_nat n < (2::'a::{linordered_idom,number_ring}) ^ n"
86.37 + "of_nat n < (2::'a::linordered_idom) ^ n"
86.38 apply (induct n)
86.39 apply simp
86.40 apply (subgoal_tac "(1::'a) \<le> 2 ^ n")
86.41 @@ -1469,18 +1460,19 @@
86.42 subsection{*Numerals and Arithmetic*}
86.43
86.44 lemma [code_abbrev]:
86.45 - "real_of_int (number_of k) = number_of k"
86.46 - unfolding number_of_is_id number_of_real_def ..
86.47 + "real_of_int (numeral k) = numeral k"
86.48 + "real_of_int (neg_numeral k) = neg_numeral k"
86.49 + by simp_all
86.50
86.51 text{*Collapse applications of @{term real} to @{term number_of}*}
86.52 -lemma real_number_of [simp]: "real (number_of v :: int) = number_of v"
86.53 -by (simp add: real_of_int_def)
86.54 +lemma real_numeral [simp]:
86.55 + "real (numeral v :: int) = numeral v"
86.56 + "real (neg_numeral v :: int) = neg_numeral v"
86.57 +by (simp_all add: real_of_int_def)
86.58
86.59 -lemma real_of_nat_number_of [simp]:
86.60 - "real (number_of v :: nat) =
86.61 - (if neg (number_of v :: int) then 0
86.62 - else (number_of v :: real))"
86.63 -by (simp add: real_of_int_of_nat_eq [symmetric])
86.64 +lemma real_of_nat_numeral [simp]:
86.65 + "real (numeral v :: nat) = numeral v"
86.66 +by (simp add: real_of_nat_def)
86.67
86.68 declaration {*
86.69 K (Lin_Arith.add_inj_thms [@{thm real_of_nat_le_iff} RS iffD2, @{thm real_of_nat_inject} RS iffD2]
86.70 @@ -1491,7 +1483,7 @@
86.71 @{thm real_of_nat_mult}, @{thm real_of_int_zero}, @{thm real_of_one},
86.72 @{thm real_of_int_add}, @{thm real_of_int_minus}, @{thm real_of_int_diff},
86.73 @{thm real_of_int_mult}, @{thm real_of_int_of_nat_eq},
86.74 - @{thm real_of_nat_number_of}, @{thm real_number_of}]
86.75 + @{thm real_of_nat_numeral}, @{thm real_numeral(1)}, @{thm real_numeral(2)}]
86.76 #> Lin_Arith.add_inj_const (@{const_name real}, @{typ "nat \<Rightarrow> real"})
86.77 #> Lin_Arith.add_inj_const (@{const_name real}, @{typ "int \<Rightarrow> real"}))
86.78 *}
86.79 @@ -1605,37 +1597,61 @@
86.80
86.81 subsection {* Implementation of rational real numbers *}
86.82
86.83 +text {* Formal constructor *}
86.84 +
86.85 definition Ratreal :: "rat \<Rightarrow> real" where
86.86 - [simp]: "Ratreal = of_rat"
86.87 + [code_abbrev, simp]: "Ratreal = of_rat"
86.88
86.89 code_datatype Ratreal
86.90
86.91 -lemma Ratreal_number_collapse [code_post]:
86.92 - "Ratreal 0 = 0"
86.93 - "Ratreal 1 = 1"
86.94 - "Ratreal (number_of k) = number_of k"
86.95 -by simp_all
86.96
86.97 -lemma zero_real_code [code, code_unfold]:
86.98 +text {* Numerals *}
86.99 +
86.100 +lemma [code_abbrev]:
86.101 + "(of_rat (of_int a) :: real) = of_int a"
86.102 + by simp
86.103 +
86.104 +lemma [code_abbrev]:
86.105 + "(of_rat 0 :: real) = 0"
86.106 + by simp
86.107 +
86.108 +lemma [code_abbrev]:
86.109 + "(of_rat 1 :: real) = 1"
86.110 + by simp
86.111 +
86.112 +lemma [code_abbrev]:
86.113 + "(of_rat (numeral k) :: real) = numeral k"
86.114 + by simp
86.115 +
86.116 +lemma [code_abbrev]:
86.117 + "(of_rat (neg_numeral k) :: real) = neg_numeral k"
86.118 + by simp
86.119 +
86.120 +lemma [code_post]:
86.121 + "(of_rat (0 / r) :: real) = 0"
86.122 + "(of_rat (r / 0) :: real) = 0"
86.123 + "(of_rat (1 / 1) :: real) = 1"
86.124 + "(of_rat (numeral k / 1) :: real) = numeral k"
86.125 + "(of_rat (neg_numeral k / 1) :: real) = neg_numeral k"
86.126 + "(of_rat (1 / numeral k) :: real) = 1 / numeral k"
86.127 + "(of_rat (1 / neg_numeral k) :: real) = 1 / neg_numeral k"
86.128 + "(of_rat (numeral k / numeral l) :: real) = numeral k / numeral l"
86.129 + "(of_rat (numeral k / neg_numeral l) :: real) = numeral k / neg_numeral l"
86.130 + "(of_rat (neg_numeral k / numeral l) :: real) = neg_numeral k / numeral l"
86.131 + "(of_rat (neg_numeral k / neg_numeral l) :: real) = neg_numeral k / neg_numeral l"
86.132 + by (simp_all add: of_rat_divide)
86.133 +
86.134 +
86.135 +text {* Operations *}
86.136 +
86.137 +lemma zero_real_code [code]:
86.138 "0 = Ratreal 0"
86.139 by simp
86.140
86.141 -lemma one_real_code [code, code_unfold]:
86.142 +lemma one_real_code [code]:
86.143 "1 = Ratreal 1"
86.144 by simp
86.145
86.146 -lemma number_of_real_code [code_unfold]:
86.147 - "number_of k = Ratreal (number_of k)"
86.148 -by simp
86.149 -
86.150 -lemma Ratreal_number_of_quotient [code_post]:
86.151 - "Ratreal (number_of r) / Ratreal (number_of s) = number_of r / number_of s"
86.152 -by simp
86.153 -
86.154 -lemma Ratreal_number_of_quotient2 [code_post]:
86.155 - "Ratreal (number_of r / number_of s) = number_of r / number_of s"
86.156 -unfolding Ratreal_number_of_quotient [symmetric] Ratreal_def of_rat_divide ..
86.157 -
86.158 instantiation real :: equal
86.159 begin
86.160
86.161 @@ -1681,6 +1697,9 @@
86.162 lemma real_floor_code [code]: "floor (Ratreal x) = floor x"
86.163 by (metis Ratreal_def floor_le_iff floor_unique le_floor_iff of_int_floor_le of_rat_of_int_eq real_less_eq_code)
86.164
86.165 +
86.166 +text {* Quickcheck *}
86.167 +
86.168 definition (in term_syntax)
86.169 valterm_ratreal :: "rat \<times> (unit \<Rightarrow> Code_Evaluation.term) \<Rightarrow> real \<times> (unit \<Rightarrow> Code_Evaluation.term)" where
86.170 [code_unfold]: "valterm_ratreal k = Code_Evaluation.valtermify Ratreal {\<cdot>} k"
86.171 @@ -1741,14 +1760,12 @@
86.172 (@{const_name plus_real_inst.plus_real}, @{const_name Nitpick.plus_frac}),
86.173 (@{const_name times_real_inst.times_real}, @{const_name Nitpick.times_frac}),
86.174 (@{const_name uminus_real_inst.uminus_real}, @{const_name Nitpick.uminus_frac}),
86.175 - (@{const_name number_real_inst.number_of_real}, @{const_name Nitpick.number_of_frac}),
86.176 (@{const_name inverse_real_inst.inverse_real}, @{const_name Nitpick.inverse_frac}),
86.177 (@{const_name ord_real_inst.less_real}, @{const_name Nitpick.less_frac}),
86.178 (@{const_name ord_real_inst.less_eq_real}, @{const_name Nitpick.less_eq_frac})]
86.179 *}
86.180
86.181 -lemmas [nitpick_unfold] = inverse_real_inst.inverse_real
86.182 - number_real_inst.number_of_real one_real_inst.one_real
86.183 +lemmas [nitpick_unfold] = inverse_real_inst.inverse_real one_real_inst.one_real
86.184 ord_real_inst.less_real ord_real_inst.less_eq_real plus_real_inst.plus_real
86.185 times_real_inst.times_real uminus_real_inst.uminus_real
86.186 zero_real_inst.zero_real
87.1 --- a/src/HOL/RealVector.thy Mon Mar 26 15:32:54 2012 +0200
87.2 +++ b/src/HOL/RealVector.thy Mon Mar 26 15:33:28 2012 +0200
87.3 @@ -303,9 +303,11 @@
87.4 lemma of_real_of_int_eq [simp]: "of_real (of_int z) = of_int z"
87.5 by (cases z rule: int_diff_cases, simp)
87.6
87.7 -lemma of_real_number_of_eq:
87.8 - "of_real (number_of w) = (number_of w :: 'a::{number_ring,real_algebra_1})"
87.9 -by (simp add: number_of_eq)
87.10 +lemma of_real_numeral: "of_real (numeral w) = numeral w"
87.11 +using of_real_of_int_eq [of "numeral w"] by simp
87.12 +
87.13 +lemma of_real_neg_numeral: "of_real (neg_numeral w) = neg_numeral w"
87.14 +using of_real_of_int_eq [of "neg_numeral w"] by simp
87.15
87.16 text{*Every real algebra has characteristic zero*}
87.17
87.18 @@ -335,9 +337,11 @@
87.19 lemma Reals_of_nat [simp]: "of_nat n \<in> Reals"
87.20 by (subst of_real_of_nat_eq [symmetric], rule Reals_of_real)
87.21
87.22 -lemma Reals_number_of [simp]:
87.23 - "(number_of w::'a::{number_ring,real_algebra_1}) \<in> Reals"
87.24 -by (subst of_real_number_of_eq [symmetric], rule Reals_of_real)
87.25 +lemma Reals_numeral [simp]: "numeral w \<in> Reals"
87.26 +by (subst of_real_numeral [symmetric], rule Reals_of_real)
87.27 +
87.28 +lemma Reals_neg_numeral [simp]: "neg_numeral w \<in> Reals"
87.29 +by (subst of_real_neg_numeral [symmetric], rule Reals_of_real)
87.30
87.31 lemma Reals_0 [simp]: "0 \<in> Reals"
87.32 apply (unfold Reals_def)
87.33 @@ -752,10 +756,13 @@
87.34 "norm (of_real r :: 'a::real_normed_algebra_1) = \<bar>r\<bar>"
87.35 unfolding of_real_def by simp
87.36
87.37 -lemma norm_number_of [simp]:
87.38 - "norm (number_of w::'a::{number_ring,real_normed_algebra_1})
87.39 - = \<bar>number_of w\<bar>"
87.40 -by (subst of_real_number_of_eq [symmetric], rule norm_of_real)
87.41 +lemma norm_numeral [simp]:
87.42 + "norm (numeral w::'a::real_normed_algebra_1) = numeral w"
87.43 +by (subst of_real_numeral [symmetric], subst norm_of_real, simp)
87.44 +
87.45 +lemma norm_neg_numeral [simp]:
87.46 + "norm (neg_numeral w::'a::real_normed_algebra_1) = numeral w"
87.47 +by (subst of_real_neg_numeral [symmetric], subst norm_of_real, simp)
87.48
87.49 lemma norm_of_int [simp]:
87.50 "norm (of_int z::'a::real_normed_algebra_1) = \<bar>of_int z\<bar>"
88.1 --- a/src/HOL/SMT_Examples/SMT_Examples.certs Mon Mar 26 15:32:54 2012 +0200
88.2 +++ b/src/HOL/SMT_Examples/SMT_Examples.certs Mon Mar 26 15:33:28 2012 +0200
88.3 @@ -12775,3 +12775,110 @@
88.4 #247 := [asserted]: #123
88.5 [unit-resolution #247 #633]: false
88.6 unsat
88.7 +477e29453df08396d997096a4fc4a8771c735880 106 0
88.8 +#2 := false
88.9 +decl f7 :: S3
88.10 +#19 := f7
88.11 +decl f5 :: (-> S4 S3 S3)
88.12 +decl f6 :: S4
88.13 +#14 := f6
88.14 +#20 := (f5 f6 f7)
88.15 +#21 := (= #20 f7)
88.16 +#74 := (not #21)
88.17 +decl f1 :: S1
88.18 +#3 := f1
88.19 +decl f3 :: (-> S2 S1 S1)
88.20 +decl f4 :: S2
88.21 +#7 := f4
88.22 +#22 := (f3 f4 f1)
88.23 +#23 := (= #22 f1)
88.24 +#75 := (not #23)
88.25 +#558 := [hypothesis]: #75
88.26 +#8 := (:var 0 S1)
88.27 +#9 := (f3 f4 #8)
88.28 +#562 := (pattern #9)
88.29 +#11 := (= #8 f1)
88.30 +#10 := (= #9 f1)
88.31 +#12 := (iff #10 #11)
88.32 +#563 := (forall (vars (?v0 S1)) (:pat #562) #12)
88.33 +#13 := (forall (vars (?v0 S1)) #12)
88.34 +#566 := (iff #13 #563)
88.35 +#564 := (iff #12 #12)
88.36 +#565 := [refl]: #564
88.37 +#567 := [quant-intro #565]: #566
88.38 +#70 := (~ #13 #13)
88.39 +#68 := (~ #12 #12)
88.40 +#69 := [refl]: #68
88.41 +#71 := [nnf-pos #69]: #70
88.42 +#47 := [asserted]: #13
88.43 +#59 := [mp~ #47 #71]: #13
88.44 +#568 := [mp #59 #567]: #563
88.45 +#239 := (not #563)
88.46 +#218 := (or #239 #23)
88.47 +#146 := (= f1 f1)
88.48 +#147 := (iff #23 #146)
88.49 +#554 := (or #239 #147)
88.50 +#212 := (iff #554 #218)
88.51 +#550 := (iff #218 #218)
88.52 +#223 := [rewrite]: #550
88.53 +#238 := (iff #147 #23)
88.54 +#1 := true
88.55 +#24 := (iff #23 true)
88.56 +#50 := (iff #24 #23)
88.57 +#51 := [rewrite]: #50
88.58 +#236 := (iff #147 #24)
88.59 +#232 := (iff #146 true)
88.60 +#225 := [rewrite]: #232
88.61 +#237 := [monotonicity #225]: #236
88.62 +#235 := [trans #237 #51]: #238
88.63 +#343 := [monotonicity #235]: #212
88.64 +#224 := [trans #343 #223]: #212
88.65 +#556 := [quant-inst #3]: #554
88.66 +#557 := [mp #556 #224]: #218
88.67 +#559 := [unit-resolution #557 #568 #558]: false
88.68 +#560 := [lemma #559]: #23
88.69 +#64 := (or #74 #75)
88.70 +#52 := (and #21 #23)
88.71 +#55 := (not #52)
88.72 +#81 := (iff #55 #64)
88.73 +#65 := (not #64)
88.74 +#76 := (not #65)
88.75 +#79 := (iff #76 #64)
88.76 +#80 := [rewrite]: #79
88.77 +#77 := (iff #55 #76)
88.78 +#66 := (iff #52 #65)
88.79 +#67 := [rewrite]: #66
88.80 +#78 := [monotonicity #67]: #77
88.81 +#82 := [trans #78 #80]: #81
88.82 +#25 := (and #21 #24)
88.83 +#26 := (not #25)
88.84 +#56 := (iff #26 #55)
88.85 +#53 := (iff #25 #52)
88.86 +#54 := [monotonicity #51]: #53
88.87 +#57 := [monotonicity #54]: #56
88.88 +#49 := [asserted]: #26
88.89 +#60 := [mp #49 #57]: #55
88.90 +#83 := [mp #60 #82]: #64
88.91 +#555 := [unit-resolution #83 #560]: #74
88.92 +#15 := (:var 0 S3)
88.93 +#16 := (f5 f6 #15)
88.94 +#569 := (pattern #16)
88.95 +#17 := (= #16 #15)
88.96 +#570 := (forall (vars (?v0 S3)) (:pat #569) #17)
88.97 +#18 := (forall (vars (?v0 S3)) #17)
88.98 +#573 := (iff #18 #570)
88.99 +#571 := (iff #17 #17)
88.100 +#572 := [refl]: #571
88.101 +#574 := [quant-intro #572]: #573
88.102 +#62 := (~ #18 #18)
88.103 +#61 := (~ #17 #17)
88.104 +#72 := [refl]: #61
88.105 +#63 := [nnf-pos #72]: #62
88.106 +#48 := [asserted]: #18
88.107 +#73 := [mp~ #48 #63]: #18
88.108 +#575 := [mp #73 #574]: #570
88.109 +#551 := (not #570)
88.110 +#210 := (or #551 #21)
88.111 +#215 := [quant-inst #19]: #210
88.112 +[unit-resolution #215 #575 #555]: false
88.113 +unsat
89.1 --- a/src/HOL/SMT_Examples/SMT_Examples.thy Mon Mar 26 15:32:54 2012 +0200
89.2 +++ b/src/HOL/SMT_Examples/SMT_Examples.thy Mon Mar 26 15:33:28 2012 +0200
89.3 @@ -467,7 +467,7 @@
89.4 lemma "(f g (x::'a::type) = (g x \<and> True)) \<or> (f g x = True) \<or> (g x = True)"
89.5 by smt
89.6
89.7 -lemma "id 3 = 3 \<and> id True = True" by (smt id_def)
89.8 +lemma "id x = x \<and> id True = True" by (smt id_def)
89.9
89.10 lemma "i \<noteq> i1 \<and> i \<noteq> i2 \<Longrightarrow> ((f (i1 := v1)) (i2 := v2)) i = f i"
89.11 using fun_upd_same fun_upd_apply
90.1 --- a/src/HOL/SMT_Examples/SMT_Tests.certs Mon Mar 26 15:32:54 2012 +0200
90.2 +++ b/src/HOL/SMT_Examples/SMT_Tests.certs Mon Mar 26 15:33:28 2012 +0200
90.3 @@ -67155,3 +67155,80 @@
90.4 #139 := [asserted]: #53
90.5 [mp #139 #149]: false
90.6 unsat
90.7 +f09576464eb9a729afbe3fe966b57e4354456502 30 0
90.8 +#2 := false
90.9 +decl f4 :: (-> S3 S4)
90.10 +decl f6 :: S3
90.11 +#16 := f6
90.12 +#17 := (f4 f6)
90.13 +decl f3 :: (-> S2 S4)
90.14 +decl f5 :: S2
90.15 +#14 := f5
90.16 +#15 := (f3 f5)
90.17 +#18 := (= #15 #17)
90.18 +#19 := (not #18)
90.19 +#41 := [asserted]: #19
90.20 +#9 := (:var 0 S3)
90.21 +#10 := (f4 #9)
90.22 +#7 := (:var 1 S2)
90.23 +#8 := (f3 #7)
90.24 +#11 := (pattern #8 #10)
90.25 +#12 := (= #8 #10)
90.26 +#13 := (forall (vars (?v0 S2) (?v1 S3)) (:pat #11) #12)
90.27 +#51 := (~ #13 #13)
90.28 +#49 := (~ #12 #12)
90.29 +#50 := [refl]: #49
90.30 +#52 := [nnf-pos #50]: #51
90.31 +#40 := [asserted]: #13
90.32 +#43 := [mp~ #40 #52]: #13
90.33 +#111 := (not #13)
90.34 +#197 := (or #111 #18)
90.35 +#112 := [quant-inst #14 #16]: #197
90.36 +[unit-resolution #112 #43 #41]: false
90.37 +unsat
90.38 +5a4509215da405eb20d4081e74524f90aaca407d 1 0
90.39 +unsat
90.40 +ec561a73aaf24cad28c298d64ff90ab9419e03b9 1 0
90.41 +unsat
90.42 +99895ba337908a50454cc51cd8d58f8c9973a5d8 1 0
90.43 +unsat
90.44 +f66af12ea27f7d59df586df568e3d48733d0c2ad 1 0
90.45 +unsat
90.46 +98a1d35ce489ce400102751e60b482d34ba4c100 1 0
90.47 +unsat
90.48 +997d0c877f7a6af3978a25e9a11fe86be44aa3d7 1 0
90.49 +unsat
90.50 +dec47d92e2bc6704596ff538272e4aa7dad033f8 1 0
90.51 +unsat
90.52 +79ff64606be9eaf1430551196cf6a56b904cd2f0 1 0
90.53 +unsat
90.54 +9ddb2d0aa5571f810dbdcf99f2a9c0dd91892822 1 0
90.55 +unsat
90.56 +383af2a9be136c8b9da304961ed7781d6d8b67da 1 0
90.57 +unsat
90.58 +8a45fca8152b4b73650f0bdadc7b4837d03b0e4f 1 0
90.59 +unsat
90.60 +028cbfc14838b1039241d56404b98b994249bd70 1 0
90.61 +unsat
90.62 +0c3c93869b86cd3cceaa64f6505c6b53e5a0d5f5 1 0
90.63 +unsat
90.64 +da5a18ce51a6fcaf95a5da1f3cf6ec44d50d2911 1 0
90.65 +unsat
90.66 +b326e9b62ea312d34250c299905421b42e169a3d 1 0
90.67 +unsat
90.68 +2df9f9573f4c3d690e8e9d39a01fbee0d0dabfca 1 0
90.69 +unsat
90.70 +64fe45c879d2ce11b605b7ccbadec44b7474cdb3 1 0
90.71 +unsat
90.72 +27388d866d376a195719342119d2c39bddbbda5e 1 0
90.73 +unsat
90.74 +4fdb33415d645476800f24bc2645077ed20fbcc7 1 0
90.75 +unsat
90.76 +34954aeef00ac521d8d6983ea46bbdde741af613 1 0
90.77 +unsat
90.78 +c975ecb6377964929f32ae1b30fbd693a2969c6a 1 0
90.79 +unsat
90.80 +5c9a9ffe9941b81f90170c912034e8b681bc281f 1 0
90.81 +unsat
90.82 +26a6ebeac1bb75693d61408e7c0984072dfbd2df 1 0
90.83 +unsat
91.1 --- a/src/HOL/SMT_Examples/SMT_Tests.thy Mon Mar 26 15:32:54 2012 +0200
91.2 +++ b/src/HOL/SMT_Examples/SMT_Tests.thy Mon Mar 26 15:33:28 2012 +0200
91.3 @@ -211,7 +211,7 @@
91.4
91.5 lemma
91.6 assumes "\<forall>x y. SMT.trigger [[SMT.pat (f x), SMT.pat (g y)]] (f x = g y)"
91.7 - shows "f 1 = g 2"
91.8 + shows "f a = g b"
91.9 using assms by smt
91.10
91.11 lemma
92.1 --- a/src/HOL/SPARK/SPARK.thy Mon Mar 26 15:32:54 2012 +0200
92.2 +++ b/src/HOL/SPARK/SPARK.thy Mon Mar 26 15:33:28 2012 +0200
92.3 @@ -145,7 +145,7 @@
92.4 then have "bin = 0" "bit = 0"
92.5 by (auto simp add: Bit_def bitval_def split add: bit.split_asm) arith
92.6 then show ?thesis using 0 1 `y < 2 ^ n`
92.7 - by simp (simp add: Bit0_def int_or_Pls [unfolded Pls_def])
92.8 + by simp
92.9 next
92.10 case (Suc m)
92.11 from 3 have "0 \<le> bin"
92.12 @@ -188,7 +188,7 @@
92.13 then have "bin = 0" "bit = 0"
92.14 by (auto simp add: Bit_def bitval_def split add: bit.split_asm) arith
92.15 then show ?thesis using 0 1 `y < 2 ^ n`
92.16 - by simp (simp add: Bit0_def int_xor_Pls [unfolded Pls_def])
92.17 + by simp
92.18 next
92.19 case (Suc m)
92.20 from 3 have "0 \<le> bin"
92.21 @@ -257,17 +257,17 @@
92.22 proof (induct x arbitrary: n rule: bin_induct)
92.23 case 1
92.24 then show ?case
92.25 - by simp (simp add: Pls_def)
92.26 + by simp
92.27 next
92.28 case 2
92.29 then show ?case
92.30 - by (simp, simp only: Min_def, simp add: m1mod2k)
92.31 + by (simp, simp add: m1mod2k)
92.32 next
92.33 case (3 bin bit)
92.34 show ?case
92.35 proof (cases n)
92.36 case 0
92.37 - then show ?thesis by (simp add: int_and_extra_simps [unfolded Pls_def])
92.38 + then show ?thesis by (simp add: int_and_extra_simps)
92.39 next
92.40 case (Suc m)
92.41 with 3 show ?thesis
93.1 --- a/src/HOL/Semiring_Normalization.thy Mon Mar 26 15:32:54 2012 +0200
93.2 +++ b/src/HOL/Semiring_Normalization.thy Mon Mar 26 15:33:28 2012 +0200
93.3 @@ -116,7 +116,8 @@
93.4 "x ^ (Suc q) = x * (x ^ q)"
93.5 "x ^ (2*n) = (x ^ n) * (x ^ n)"
93.6 "x ^ (Suc (2*n)) = x * ((x ^ n) * (x ^ n))"
93.7 - by (simp_all add: algebra_simps power_add power2_eq_square power_mult_distrib power_mult)
93.8 + by (simp_all add: algebra_simps power_add power2_eq_square
93.9 + power_mult_distrib power_mult del: one_add_one)
93.10
93.11 lemmas normalizing_comm_semiring_1_axioms =
93.12 comm_semiring_1_axioms [normalizer
93.13 @@ -218,4 +219,13 @@
93.14
93.15 hide_fact (open) normalizing_field_axioms normalizing_field_ops normalizing_field_rules
93.16
93.17 +code_modulename SML
93.18 + Semiring_Normalization Arith
93.19 +
93.20 +code_modulename OCaml
93.21 + Semiring_Normalization Arith
93.22 +
93.23 +code_modulename Haskell
93.24 + Semiring_Normalization Arith
93.25 +
93.26 end
94.1 --- a/src/HOL/Series.thy Mon Mar 26 15:32:54 2012 +0200
94.2 +++ b/src/HOL/Series.thy Mon Mar 26 15:33:28 2012 +0200
94.3 @@ -417,8 +417,8 @@
94.4 shows "norm x < 1 \<Longrightarrow> summable (\<lambda>n. x ^ n)"
94.5 by (rule geometric_sums [THEN sums_summable])
94.6
94.7 -lemma half: "0 < 1 / (2::'a::{number_ring,linordered_field_inverse_zero})"
94.8 - by arith
94.9 +lemma half: "0 < 1 / (2::'a::linordered_field)"
94.10 + by simp
94.11
94.12 lemma power_half_series: "(\<lambda>n. (1/2::real)^Suc n) sums 1"
94.13 proof -
95.1 --- a/src/HOL/SetInterval.thy Mon Mar 26 15:32:54 2012 +0200
95.2 +++ b/src/HOL/SetInterval.thy Mon Mar 26 15:33:28 2012 +0200
95.3 @@ -1282,7 +1282,7 @@
95.4
95.5 subsection {* The formula for arithmetic sums *}
95.6
95.7 -lemma gauss_sum:
95.8 +lemma gauss_sum: (* FIXME: rephrase in terms of "2" *)
95.9 "((1::'a::comm_semiring_1) + 1)*(\<Sum>i\<in>{1..n}. of_nat i) =
95.10 of_nat n*((of_nat n)+1)"
95.11 proof (induct n)
95.12 @@ -1290,7 +1290,7 @@
95.13 show ?case by simp
95.14 next
95.15 case (Suc n)
95.16 - then show ?case by (simp add: algebra_simps)
95.17 + then show ?case by (simp add: algebra_simps del: one_add_one) (* FIXME *)
95.18 qed
95.19
95.20 theorem arith_series_general:
95.21 @@ -1308,18 +1308,18 @@
95.22 unfolding One_nat_def
95.23 by (simp add: setsum_right_distrib atLeast0LessThan[symmetric] setsum_shift_lb_Suc0_0_upt mult_ac)
95.24 also have "(1+1)*\<dots> = (1+1)*?n*a + d*(1+1)*(\<Sum>i\<in>{1..<n}. ?I i)"
95.25 - by (simp add: left_distrib right_distrib)
95.26 + by (simp add: left_distrib right_distrib del: one_add_one)
95.27 also from ngt1 have "{1..<n} = {1..n - 1}"
95.28 by (cases n) (auto simp: atLeastLessThanSuc_atLeastAtMost)
95.29 also from ngt1
95.30 have "(1+1)*?n*a + d*(1+1)*(\<Sum>i\<in>{1..n - 1}. ?I i) = ((1+1)*?n*a + d*?I (n - 1)*?I n)"
95.31 by (simp only: mult_ac gauss_sum [of "n - 1"], unfold One_nat_def)
95.32 (simp add: mult_ac trans [OF add_commute of_nat_Suc [symmetric]])
95.33 - finally show ?thesis by (simp add: algebra_simps)
95.34 + finally show ?thesis by (simp add: algebra_simps del: one_add_one)
95.35 next
95.36 assume "\<not>(n > 1)"
95.37 hence "n = 1 \<or> n = 0" by auto
95.38 - thus ?thesis by (auto simp: algebra_simps)
95.39 + thus ?thesis by (auto simp: algebra_simps mult_2_right)
95.40 qed
95.41
95.42 lemma arith_series_nat:
96.1 --- a/src/HOL/Tools/Nitpick/nitpick.ML Mon Mar 26 15:32:54 2012 +0200
96.2 +++ b/src/HOL/Tools/Nitpick/nitpick.ML Mon Mar 26 15:33:28 2012 +0200
96.3 @@ -206,7 +206,7 @@
96.4
96.5 val syntactic_sorts =
96.6 @{sort "{default,zero,one,plus,minus,uminus,times,inverse,abs,sgn,ord,equal}"} @
96.7 - @{sort number}
96.8 + @{sort numeral}
96.9 fun has_tfree_syntactic_sort (TFree (_, S as _ :: _)) =
96.10 subset (op =) (S, syntactic_sorts)
96.11 | has_tfree_syntactic_sort _ = false
97.1 --- a/src/HOL/Tools/Nitpick/nitpick_hol.ML Mon Mar 26 15:32:54 2012 +0200
97.2 +++ b/src/HOL/Tools/Nitpick/nitpick_hol.ML Mon Mar 26 15:33:28 2012 +0200
97.3 @@ -1636,30 +1636,32 @@
97.4 (hol_ctxt as {thy, ctxt, stds, whacks, total_consts, case_names,
97.5 def_tables, ground_thm_table, ersatz_table, ...}) =
97.6 let
97.7 - fun do_term depth Ts t =
97.8 + fun do_numeral depth Ts mult T t0 t1 =
97.9 + (if is_number_type ctxt T then
97.10 + let
97.11 + val j = mult * (HOLogic.dest_num t1)
97.12 + |> T = nat_T ? Integer.max 0
97.13 + val s = numeral_prefix ^ signed_string_of_int j
97.14 + in
97.15 + if is_integer_like_type T then
97.16 + if is_standard_datatype thy stds T then Const (s, T)
97.17 + else funpow j (curry (op $) (suc_const T)) (zero_const T)
97.18 + else
97.19 + do_term depth Ts (Const (@{const_name of_int}, int_T --> T)
97.20 + $ Const (s, int_T))
97.21 + end
97.22 + handle TERM _ => raise SAME ()
97.23 + else
97.24 + raise SAME ())
97.25 + handle SAME () => s_betapply [] (do_term depth Ts t0, do_term depth Ts t1)
97.26 + and do_term depth Ts t =
97.27 case t of
97.28 - (t0 as Const (@{const_name Int.number_class.number_of},
97.29 + (t0 as Const (@{const_name Num.neg_numeral_class.neg_numeral},
97.30 Type (@{type_name fun}, [_, ran_T]))) $ t1 =>
97.31 - ((if is_number_type ctxt ran_T then
97.32 - let
97.33 - val j = t1 |> HOLogic.dest_numeral
97.34 - |> ran_T = nat_T ? Integer.max 0
97.35 - val s = numeral_prefix ^ signed_string_of_int j
97.36 - in
97.37 - if is_integer_like_type ran_T then
97.38 - if is_standard_datatype thy stds ran_T then
97.39 - Const (s, ran_T)
97.40 - else
97.41 - funpow j (curry (op $) (suc_const ran_T)) (zero_const ran_T)
97.42 - else
97.43 - do_term depth Ts (Const (@{const_name of_int}, int_T --> ran_T)
97.44 - $ Const (s, int_T))
97.45 - end
97.46 - handle TERM _ => raise SAME ()
97.47 - else
97.48 - raise SAME ())
97.49 - handle SAME () =>
97.50 - s_betapply [] (do_term depth Ts t0, do_term depth Ts t1))
97.51 + do_numeral depth Ts ~1 ran_T t0 t1
97.52 + | (t0 as Const (@{const_name Num.numeral_class.numeral},
97.53 + Type (@{type_name fun}, [_, ran_T]))) $ t1 =>
97.54 + do_numeral depth Ts 1 ran_T t0 t1
97.55 | Const (@{const_name refl_on}, T) $ Const (@{const_name top}, _) $ t2 =>
97.56 do_const depth Ts t (@{const_name refl'}, range_type T) [t2]
97.57 | (t0 as Const (@{const_name Sigma}, Type (_, [T1, Type (_, [T2, T3])])))
98.1 --- a/src/HOL/Tools/Predicate_Compile/predicate_compile_data.ML Mon Mar 26 15:32:54 2012 +0200
98.2 +++ b/src/HOL/Tools/Predicate_Compile/predicate_compile_data.ML Mon Mar 26 15:33:28 2012 +0200
98.3 @@ -240,10 +240,12 @@
98.4 @{const_name Groups.one}, @{const_name Groups.plus},
98.5 @{const_name Nat.ord_nat_inst.less_eq_nat},
98.6 @{const_name Nat.ord_nat_inst.less_nat},
98.7 +(* FIXME
98.8 @{const_name number_nat_inst.number_of_nat},
98.9 - @{const_name Int.Bit0},
98.10 - @{const_name Int.Bit1},
98.11 - @{const_name Int.Pls},
98.12 +*)
98.13 + @{const_name Num.Bit0},
98.14 + @{const_name Num.Bit1},
98.15 + @{const_name Num.One},
98.16 @{const_name Int.zero_int_inst.zero_int},
98.17 @{const_name List.filter},
98.18 @{const_name HOL.If},
99.1 --- a/src/HOL/Tools/Qelim/cooper.ML Mon Mar 26 15:32:54 2012 +0200
99.2 +++ b/src/HOL/Tools/Qelim/cooper.ML Mon Mar 26 15:33:28 2012 +0200
99.3 @@ -41,9 +41,9 @@
99.4 @{term "Ex :: (int => _) => _"}, @{term "Ex :: (nat => _) => _"},
99.5 @{term "All :: (int => _) => _"}, @{term "All :: (nat => _) => _"},
99.6 @{term "nat"}, @{term "int"},
99.7 - @{term "Int.Bit0"}, @{term "Int.Bit1"},
99.8 - @{term "Int.Pls"}, @{term "Int.Min"},
99.9 - @{term "Int.number_of :: int => int"}, @{term "Int.number_of :: int => nat"},
99.10 + @{term "Num.One"}, @{term "Num.Bit0"}, @{term "Num.Bit1"},
99.11 + @{term "Num.numeral :: num => int"}, @{term "Num.numeral :: num => nat"},
99.12 + @{term "Num.neg_numeral :: num => int"},
99.13 @{term "0::int"}, @{term "1::int"}, @{term "0::nat"}, @{term "1::nat"},
99.14 @{term "True"}, @{term "False"}];
99.15
99.16 @@ -595,8 +595,10 @@
99.17 | num_of_term vs (Term.Bound i) = Proc.Bound i
99.18 | num_of_term vs @{term "0::int"} = Proc.C 0
99.19 | num_of_term vs @{term "1::int"} = Proc.C 1
99.20 - | num_of_term vs (t as Const (@{const_name number_of}, _) $ _) =
99.21 + | num_of_term vs (t as Const (@{const_name numeral}, _) $ _) =
99.22 Proc.C (dest_number t)
99.23 + | num_of_term vs (t as Const (@{const_name neg_numeral}, _) $ _) =
99.24 + Proc.Neg (Proc.C (dest_number t))
99.25 | num_of_term vs (Const (@{const_name Groups.uminus}, _) $ t') =
99.26 Proc.Neg (num_of_term vs t')
99.27 | num_of_term vs (Const (@{const_name Groups.plus}, _) $ t1 $ t2) =
99.28 @@ -784,16 +786,16 @@
99.29
99.30 local
99.31 val ss1 = comp_ss
99.32 - addsimps @{thms simp_thms} @ [@{thm "nat_number_of_def"}, @{thm "zdvd_int"}]
99.33 - @ map (fn r => r RS sym)
99.34 + addsimps @{thms simp_thms} @ [@{thm "nat_numeral"} RS sym, @{thm "zdvd_int"}]
99.35 + @ map (fn r => r RS sym)
99.36 [@{thm "int_int_eq"}, @{thm "zle_int"}, @{thm "zless_int"}, @{thm "zadd_int"},
99.37 @{thm "zmult_int"}]
99.38 |> Splitter.add_split @{thm "zdiff_int_split"}
99.39
99.40 val ss2 = HOL_basic_ss
99.41 - addsimps [@{thm "nat_0_le"}, @{thm "int_nat_number_of"},
99.42 - @{thm "all_nat"}, @{thm "ex_nat"}, @{thm "number_of1"},
99.43 - @{thm "number_of2"}, @{thm "int_0"}, @{thm "int_1"}, @{thm "Suc_eq_plus1"}]
99.44 + addsimps [@{thm "nat_0_le"}, @{thm "int_numeral"},
99.45 + @{thm "all_nat"}, @{thm "ex_nat"}, @{thm "zero_le_numeral"},
99.46 + @{thm "le_numeral_extra"(3)}, @{thm "int_0"}, @{thm "int_1"}, @{thm "Suc_eq_plus1"}]
99.47 |> fold Simplifier.add_cong [@{thm "conj_le_cong"}, @{thm "imp_le_cong"}]
99.48 val div_mod_ss = HOL_basic_ss addsimps @{thms simp_thms}
99.49 @ map (Thm.symmetric o mk_meta_eq)
100.1 --- a/src/HOL/Tools/Quotient/quotient_info.ML Mon Mar 26 15:32:54 2012 +0200
100.2 +++ b/src/HOL/Tools/Quotient/quotient_info.ML Mon Mar 26 15:33:28 2012 +0200
100.3 @@ -71,9 +71,9 @@
100.4
100.5 val quotmaps_attribute_setup =
100.6 Attrib.setup @{binding map}
100.7 - ((Args.type_name true --| Scan.lift (@{keyword "="})) --
100.8 - (Scan.lift (@{keyword "("}) |-- Args.const_proper true --| Scan.lift (@{keyword ","}) --
100.9 - Attrib.thm --| Scan.lift (@{keyword ")"})) >>
100.10 + ((Args.type_name true --| Scan.lift @{keyword "="}) --
100.11 + (Scan.lift @{keyword "("} |-- Args.const_proper true --| Scan.lift @{keyword ","} --
100.12 + Attrib.thm --| Scan.lift @{keyword ")"}) >>
100.13 (fn (tyname, (relname, qthm)) =>
100.14 let val minfo = {relmap = relname, quot_thm = qthm}
100.15 in Thm.declaration_attribute (fn _ => Quotmaps.map (Symtab.update (tyname, minfo))) end))
101.1 --- a/src/HOL/Tools/SMT/smt_normalize.ML Mon Mar 26 15:32:54 2012 +0200
101.2 +++ b/src/HOL/Tools/SMT/smt_normalize.ML Mon Mar 26 15:33:28 2012 +0200
101.3 @@ -451,7 +451,7 @@
101.4
101.5 val nat_ops = simple_nat_ops @ mult_nat_ops
101.6
101.7 - val nat_consts = nat_ops @ [@{const number_of (nat)},
101.8 + val nat_consts = nat_ops @ [@{const numeral (nat)},
101.9 @{const zero_class.zero (nat)}, @{const one_class.one (nat)}]
101.10
101.11 val nat_int_coercions = [@{const of_nat (int)}, @{const nat}]
101.12 @@ -466,7 +466,7 @@
101.13 val expands = map mk_meta_eq @{lemma
101.14 "0 = nat 0"
101.15 "1 = nat 1"
101.16 - "(number_of :: int => nat) = (%i. nat (number_of i))"
101.17 + "(numeral :: num => nat) = (%i. nat (numeral i))"
101.18 "op < = (%a b. int a < int b)"
101.19 "op <= = (%a b. int a <= int b)"
101.20 "Suc = (%a. nat (int a + 1))"
101.21 @@ -493,8 +493,7 @@
101.22 let
101.23 val eq = SMT_Utils.mk_cequals lhs (Numeral.mk_cnumber @{ctyp int} i)
101.24 val ss = HOL_ss
101.25 - addsimps [@{thm Nat_Numeral.int_nat_number_of}]
101.26 - addsimps @{thms neg_simps}
101.27 + addsimps [@{thm Nat_Numeral.int_numeral}]
101.28 fun tac _ = Simplifier.simp_tac (Simplifier.context ctxt ss) 1
101.29 in Goal.norm_result (Goal.prove_internal [] eq tac) end
101.30
101.31 @@ -507,7 +506,7 @@
101.32
101.33 fun int_conv ctxt ct =
101.34 (case Thm.term_of ct of
101.35 - @{const of_nat (int)} $ (n as (@{const number_of (nat)} $ _)) =>
101.36 + @{const of_nat (int)} $ (n as (@{const numeral (nat)} $ _)) =>
101.37 Conv.rewr_conv (mk_number_eq ctxt (snd (HOLogic.dest_number n)) ct)
101.38 | @{const of_nat (int)} $ _ =>
101.39 (Conv.rewrs_conv ints then_conv Conv.sub_conv ints_conv ctxt) else_conv
101.40 @@ -549,23 +548,15 @@
101.41 rewrite Numeral1 into 1
101.42 *)
101.43
101.44 - fun is_strange_number ctxt (t as Const (@{const_name number_of}, _) $ _) =
101.45 + fun is_strange_number ctxt (t as Const (@{const_name neg_numeral}, _) $ _) =
101.46 (case try HOLogic.dest_number t of
101.47 SOME (_, i) => SMT_Builtin.is_builtin_num ctxt t andalso i < 2
101.48 | NONE => false)
101.49 | is_strange_number _ _ = false
101.50
101.51 val pos_num_ss = HOL_ss
101.52 - addsimps [@{thm Int.number_of_minus}, @{thm Int.number_of_Min}]
101.53 - addsimps [@{thm Int.number_of_Pls}, @{thm Int.numeral_1_eq_1}]
101.54 - addsimps @{thms Int.pred_bin_simps}
101.55 - addsimps @{thms Int.normalize_bin_simps}
101.56 - addsimps @{lemma
101.57 - "Int.Min = - Int.Bit1 Int.Pls"
101.58 - "Int.Bit0 (- Int.Pls) = - Int.Pls"
101.59 - "Int.Bit0 (- k) = - Int.Bit0 k"
101.60 - "Int.Bit1 (- k) = - Int.Bit1 (Int.pred k)"
101.61 - by simp_all (simp add: pred_def)}
101.62 + addsimps [@{thm Num.numeral_One}]
101.63 + addsimps [@{thm Num.neg_numeral_def}]
101.64
101.65 fun norm_num_conv ctxt =
101.66 SMT_Utils.if_conv (is_strange_number ctxt)
102.1 --- a/src/HOL/Tools/SMT/z3_proof_tools.ML Mon Mar 26 15:32:54 2012 +0200
102.2 +++ b/src/HOL/Tools/SMT/z3_proof_tools.ML Mon Mar 26 15:33:28 2012 +0200
102.3 @@ -334,14 +334,12 @@
102.4
102.5 val basic_simpset = HOL_ss addsimps @{thms field_simps}
102.6 addsimps [@{thm times_divide_eq_right}, @{thm times_divide_eq_left}]
102.7 - addsimps @{thms arith_special} addsimps @{thms less_bin_simps}
102.8 - addsimps @{thms le_bin_simps} addsimps @{thms eq_bin_simps}
102.9 - addsimps @{thms add_bin_simps} addsimps @{thms succ_bin_simps}
102.10 - addsimps @{thms minus_bin_simps} addsimps @{thms pred_bin_simps}
102.11 - addsimps @{thms mult_bin_simps} addsimps @{thms iszero_simps}
102.12 + addsimps @{thms arith_special} addsimps @{thms arith_simps}
102.13 + addsimps @{thms rel_simps}
102.14 addsimps @{thms array_rules}
102.15 addsimps @{thms term_true_def} addsimps @{thms term_false_def}
102.16 addsimps @{thms z3div_def} addsimps @{thms z3mod_def}
102.17 + addsimprocs [@{simproc binary_int_div}, @{simproc binary_int_mod}]
102.18 addsimprocs [
102.19 Simplifier.simproc_global @{theory} "fast_int_arith" [
102.20 "(m::int) < n", "(m::int) <= n", "(m::int) = n"] (K Lin_Arith.simproc),
103.1 --- a/src/HOL/Tools/arith_data.ML Mon Mar 26 15:32:54 2012 +0200
103.2 +++ b/src/HOL/Tools/arith_data.ML Mon Mar 26 15:33:28 2012 +0200
103.3 @@ -68,7 +68,8 @@
103.4
103.5 (* some specialized syntactic operations *)
103.6
103.7 -fun mk_number T n = HOLogic.number_of_const T $ HOLogic.mk_numeral n;
103.8 +fun mk_number T 1 = HOLogic.numeral_const T $ HOLogic.one_const
103.9 + | mk_number T n = HOLogic.mk_number T n;
103.10
103.11 val mk_plus = HOLogic.mk_binop @{const_name Groups.plus};
103.12
104.1 --- a/src/HOL/Tools/float_syntax.ML Mon Mar 26 15:32:54 2012 +0200
104.2 +++ b/src/HOL/Tools/float_syntax.ML Mon Mar 26 15:33:28 2012 +0200
104.3 @@ -18,12 +18,15 @@
104.4
104.5 fun mk_number i =
104.6 let
104.7 - fun mk 0 = Syntax.const @{const_syntax Int.Pls}
104.8 - | mk ~1 = Syntax.const @{const_syntax Int.Min}
104.9 + fun mk 1 = Syntax.const @{const_syntax Num.One}
104.10 | mk i =
104.11 let val (q, r) = Integer.div_mod i 2
104.12 in HOLogic.mk_bit r $ (mk q) end;
104.13 - in Syntax.const @{const_syntax Int.number_of} $ mk i end;
104.14 + in
104.15 + if i = 0 then Syntax.const @{const_syntax Groups.zero}
104.16 + else if i > 0 then Syntax.const @{const_syntax Num.numeral} $ mk i
104.17 + else Syntax.const @{const_syntax Num.neg_numeral} $ mk (~i)
104.18 + end;
104.19
104.20 fun mk_frac str =
104.21 let
105.1 --- a/src/HOL/Tools/hologic.ML Mon Mar 26 15:32:54 2012 +0200
105.2 +++ b/src/HOL/Tools/hologic.ML Mon Mar 26 15:33:28 2012 +0200
105.3 @@ -93,15 +93,15 @@
105.4 val size_const: typ -> term
105.5 val code_numeralT: typ
105.6 val intT: typ
105.7 - val pls_const: term
105.8 - val min_const: term
105.9 + val one_const: term
105.10 val bit0_const: term
105.11 val bit1_const: term
105.12 val mk_bit: int -> term
105.13 val dest_bit: term -> int
105.14 val mk_numeral: int -> term
105.15 - val dest_numeral: term -> int
105.16 - val number_of_const: typ -> term
105.17 + val dest_num: term -> int
105.18 + val numeral_const: typ -> term
105.19 + val neg_numeral_const: typ -> term
105.20 val add_numerals: term -> (term * typ) list -> (term * typ) list
105.21 val mk_number: typ -> int -> term
105.22 val dest_number: term -> typ * int
105.23 @@ -492,50 +492,54 @@
105.24 val code_numeralT = Type ("Code_Numeral.code_numeral", []);
105.25
105.26
105.27 -(* binary numerals and int -- non-unique representation due to leading zeros/ones! *)
105.28 +(* binary numerals and int *)
105.29
105.30 +val numT = Type ("Num.num", []);
105.31 val intT = Type ("Int.int", []);
105.32
105.33 -val pls_const = Const ("Int.Pls", intT)
105.34 -and min_const = Const ("Int.Min", intT)
105.35 -and bit0_const = Const ("Int.Bit0", intT --> intT)
105.36 -and bit1_const = Const ("Int.Bit1", intT --> intT);
105.37 +val one_const = Const ("Num.num.One", numT)
105.38 +and bit0_const = Const ("Num.num.Bit0", numT --> numT)
105.39 +and bit1_const = Const ("Num.num.Bit1", numT --> numT);
105.40
105.41 fun mk_bit 0 = bit0_const
105.42 | mk_bit 1 = bit1_const
105.43 | mk_bit _ = raise TERM ("mk_bit", []);
105.44
105.45 -fun dest_bit (Const ("Int.Bit0", _)) = 0
105.46 - | dest_bit (Const ("Int.Bit1", _)) = 1
105.47 +fun dest_bit (Const ("Num.num.Bit0", _)) = 0
105.48 + | dest_bit (Const ("Num.num.Bit1", _)) = 1
105.49 | dest_bit t = raise TERM ("dest_bit", [t]);
105.50
105.51 -fun mk_numeral 0 = pls_const
105.52 - | mk_numeral ~1 = min_const
105.53 - | mk_numeral i =
105.54 - let val (q, r) = Integer.div_mod i 2;
105.55 - in mk_bit r $ mk_numeral q end;
105.56 +fun mk_numeral i =
105.57 + let fun mk 1 = one_const
105.58 + | mk i = let val (q, r) = Integer.div_mod i 2 in mk_bit r $ mk q end
105.59 + in if i > 0 then mk i else raise TERM ("mk_numeral: " ^ string_of_int i, [])
105.60 + end
105.61
105.62 -fun dest_numeral (Const ("Int.Pls", _)) = 0
105.63 - | dest_numeral (Const ("Int.Min", _)) = ~1
105.64 - | dest_numeral (Const ("Int.Bit0", _) $ bs) = 2 * dest_numeral bs
105.65 - | dest_numeral (Const ("Int.Bit1", _) $ bs) = 2 * dest_numeral bs + 1
105.66 - | dest_numeral t = raise TERM ("dest_numeral", [t]);
105.67 +fun dest_num (Const ("Num.num.One", _)) = 1
105.68 + | dest_num (Const ("Num.num.Bit0", _) $ bs) = 2 * dest_num bs
105.69 + | dest_num (Const ("Num.num.Bit1", _) $ bs) = 2 * dest_num bs + 1
105.70 + | dest_num t = raise TERM ("dest_num", [t]);
105.71
105.72 -fun number_of_const T = Const ("Int.number_class.number_of", intT --> T);
105.73 +fun numeral_const T = Const ("Num.numeral_class.numeral", numT --> T);
105.74 +fun neg_numeral_const T = Const ("Num.neg_numeral_class.neg_numeral", numT --> T);
105.75
105.76 -fun add_numerals (Const ("Int.number_class.number_of", Type (_, [_, T])) $ t) = cons (t, T)
105.77 +fun add_numerals (Const ("Num.numeral_class.numeral", Type (_, [_, T])) $ t) = cons (t, T)
105.78 | add_numerals (t $ u) = add_numerals t #> add_numerals u
105.79 | add_numerals (Abs (_, _, t)) = add_numerals t
105.80 | add_numerals _ = I;
105.81
105.82 fun mk_number T 0 = Const ("Groups.zero_class.zero", T)
105.83 | mk_number T 1 = Const ("Groups.one_class.one", T)
105.84 - | mk_number T i = number_of_const T $ mk_numeral i;
105.85 + | mk_number T i =
105.86 + if i > 0 then numeral_const T $ mk_numeral i
105.87 + else neg_numeral_const T $ mk_numeral (~ i);
105.88
105.89 fun dest_number (Const ("Groups.zero_class.zero", T)) = (T, 0)
105.90 | dest_number (Const ("Groups.one_class.one", T)) = (T, 1)
105.91 - | dest_number (Const ("Int.number_class.number_of", Type ("fun", [_, T])) $ t) =
105.92 - (T, dest_numeral t)
105.93 + | dest_number (Const ("Num.numeral_class.numeral", Type ("fun", [_, T])) $ t) =
105.94 + (T, dest_num t)
105.95 + | dest_number (Const ("Num.neg_numeral_class.neg_numeral", Type ("fun", [_, T])) $ t) =
105.96 + (T, ~ (dest_num t))
105.97 | dest_number t = raise TERM ("dest_number", [t]);
105.98
105.99
106.1 --- a/src/HOL/Tools/int_arith.ML Mon Mar 26 15:32:54 2012 +0200
106.2 +++ b/src/HOL/Tools/int_arith.ML Mon Mar 26 15:33:28 2012 +0200
106.3 @@ -78,7 +78,7 @@
106.4 proc = sproc, identifier = []}
106.5
106.6 fun number_of thy T n =
106.7 - if not (Sign.of_sort thy (T, @{sort number}))
106.8 + if not (Sign.of_sort thy (T, @{sort numeral}))
106.9 then raise CTERM ("number_of", [])
106.10 else Numeral.mk_cnumber (Thm.ctyp_of thy T) n;
106.11
107.1 --- a/src/HOL/Tools/lin_arith.ML Mon Mar 26 15:32:54 2012 +0200
107.2 +++ b/src/HOL/Tools/lin_arith.ML Mon Mar 26 15:33:28 2012 +0200
107.3 @@ -174,14 +174,17 @@
107.4 | (NONE, m') => apsnd (Rat.mult (Rat.inv m')) (demult (s, m)))
107.5 (* terms that evaluate to numeric constants *)
107.6 | demult (Const (@{const_name Groups.uminus}, _) $ t, m) = demult (t, Rat.neg m)
107.7 - | demult (Const (@{const_name Groups.zero}, _), m) = (NONE, Rat.zero)
107.8 + | demult (Const (@{const_name Groups.zero}, _), _) = (NONE, Rat.zero)
107.9 | demult (Const (@{const_name Groups.one}, _), m) = (NONE, m)
107.10 - (*Warning: in rare cases number_of encloses a non-numeral,
107.11 - in which case dest_numeral raises TERM; hence all the handles below.
107.12 + (*Warning: in rare cases (neg_)numeral encloses a non-numeral,
107.13 + in which case dest_num raises TERM; hence all the handles below.
107.14 Same for Suc-terms that turn out not to be numerals -
107.15 although the simplifier should eliminate those anyway ...*)
107.16 - | demult (t as Const ("Int.number_class.number_of", _) $ n, m) =
107.17 - ((NONE, Rat.mult m (Rat.rat_of_int (HOLogic.dest_numeral n)))
107.18 + | demult (t as Const ("Num.numeral_class.numeral", _) $ n, m) =
107.19 + ((NONE, Rat.mult m (Rat.rat_of_int (HOLogic.dest_num n)))
107.20 + handle TERM _ => (SOME t, m))
107.21 + | demult (t as Const ("Num.neg_numeral_class.neg_numeral", _) $ n, m) =
107.22 + ((NONE, Rat.mult m (Rat.rat_of_int (~ (HOLogic.dest_num n))))
107.23 handle TERM _ => (SOME t, m))
107.24 | demult (t as Const (@{const_name Suc}, _) $ _, m) =
107.25 ((NONE, Rat.mult m (Rat.rat_of_int (HOLogic.dest_nat t)))
107.26 @@ -219,10 +222,13 @@
107.27 (case demult inj_consts (all, m) of
107.28 (NONE, m') => (p, Rat.add i m')
107.29 | (SOME u, m') => add_atom u m' pi)
107.30 - | poly (all as Const ("Int.number_class.number_of", Type(_,[_,T])) $ t, m, pi as (p, i)) =
107.31 - (let val k = HOLogic.dest_numeral t
107.32 - val k2 = if k < 0 andalso T = HOLogic.natT then 0 else k
107.33 - in (p, Rat.add i (Rat.mult m (Rat.rat_of_int k2))) end
107.34 + | poly (all as Const ("Num.numeral_class.numeral", Type(_,[_,_])) $ t, m, pi as (p, i)) =
107.35 + (let val k = HOLogic.dest_num t
107.36 + in (p, Rat.add i (Rat.mult m (Rat.rat_of_int k))) end
107.37 + handle TERM _ => add_atom all m pi)
107.38 + | poly (all as Const ("Num.neg_numeral_class.neg_numeral", Type(_,[_,_])) $ t, m, pi as (p, i)) =
107.39 + (let val k = HOLogic.dest_num t
107.40 + in (p, Rat.add i (Rat.mult m (Rat.rat_of_int (~ k)))) end
107.41 handle TERM _ => add_atom all m pi)
107.42 | poly (all as Const f $ x, m, pi) =
107.43 if member (op =) inj_consts f then poly (x, m, pi) else add_atom all m pi
107.44 @@ -464,9 +470,9 @@
107.45 in
107.46 SOME [(HOLogic.natT :: Ts, subgoal1), (Ts, subgoal2)]
107.47 end
107.48 - (* ?P ((?n::nat) mod (number_of ?k)) =
107.49 - ((number_of ?k = 0 --> ?P ?n) & (~ (number_of ?k = 0) -->
107.50 - (ALL i j. j < number_of ?k --> ?n = number_of ?k * i + j --> ?P j))) *)
107.51 + (* ?P ((?n::nat) mod (numeral ?k)) =
107.52 + ((numeral ?k = 0 --> ?P ?n) & (~ (numeral ?k = 0) -->
107.53 + (ALL i j. j < numeral ?k --> ?n = numeral ?k * i + j --> ?P j))) *)
107.54 | (Const ("Divides.div_class.mod", Type ("fun", [@{typ nat}, _])), [t1, t2]) =>
107.55 let
107.56 val rev_terms = rev terms
107.57 @@ -496,9 +502,9 @@
107.58 in
107.59 SOME [(Ts, subgoal1), (split_type :: split_type :: Ts, subgoal2)]
107.60 end
107.61 - (* ?P ((?n::nat) div (number_of ?k)) =
107.62 - ((number_of ?k = 0 --> ?P 0) & (~ (number_of ?k = 0) -->
107.63 - (ALL i j. j < number_of ?k --> ?n = number_of ?k * i + j --> ?P i))) *)
107.64 + (* ?P ((?n::nat) div (numeral ?k)) =
107.65 + ((numeral ?k = 0 --> ?P 0) & (~ (numeral ?k = 0) -->
107.66 + (ALL i j. j < numeral ?k --> ?n = numeral ?k * i + j --> ?P i))) *)
107.67 | (Const ("Divides.div_class.div", Type ("fun", [@{typ nat}, _])), [t1, t2]) =>
107.68 let
107.69 val rev_terms = rev terms
107.70 @@ -528,14 +534,14 @@
107.71 in
107.72 SOME [(Ts, subgoal1), (split_type :: split_type :: Ts, subgoal2)]
107.73 end
107.74 - (* ?P ((?n::int) mod (number_of ?k)) =
107.75 - ((number_of ?k = 0 --> ?P ?n) &
107.76 - (0 < number_of ?k -->
107.77 + (* ?P ((?n::int) mod (numeral ?k)) =
107.78 + ((numeral ?k = 0 --> ?P ?n) &
107.79 + (0 < numeral ?k -->
107.80 (ALL i j.
107.81 - 0 <= j & j < number_of ?k & ?n = number_of ?k * i + j --> ?P j)) &
107.82 - (number_of ?k < 0 -->
107.83 + 0 <= j & j < numeral ?k & ?n = numeral ?k * i + j --> ?P j)) &
107.84 + (numeral ?k < 0 -->
107.85 (ALL i j.
107.86 - number_of ?k < j & j <= 0 & ?n = number_of ?k * i + j --> ?P j))) *)
107.87 + numeral ?k < j & j <= 0 & ?n = numeral ?k * i + j --> ?P j))) *)
107.88 | (Const ("Divides.div_class.mod",
107.89 Type ("fun", [Type ("Int.int", []), _])), [t1, t2]) =>
107.90 let
107.91 @@ -582,14 +588,14 @@
107.92 in
107.93 SOME [(Ts, subgoal1), (Ts', subgoal2), (Ts', subgoal3)]
107.94 end
107.95 - (* ?P ((?n::int) div (number_of ?k)) =
107.96 - ((number_of ?k = 0 --> ?P 0) &
107.97 - (0 < number_of ?k -->
107.98 + (* ?P ((?n::int) div (numeral ?k)) =
107.99 + ((numeral ?k = 0 --> ?P 0) &
107.100 + (0 < numeral ?k -->
107.101 (ALL i j.
107.102 - 0 <= j & j < number_of ?k & ?n = number_of ?k * i + j --> ?P i)) &
107.103 - (number_of ?k < 0 -->
107.104 + 0 <= j & j < numeral ?k & ?n = numeral ?k * i + j --> ?P i)) &
107.105 + (numeral ?k < 0 -->
107.106 (ALL i j.
107.107 - number_of ?k < j & j <= 0 & ?n = number_of ?k * i + j --> ?P i))) *)
107.108 + numeral ?k < j & j <= 0 & ?n = numeral ?k * i + j --> ?P i))) *)
107.109 | (Const ("Divides.div_class.div",
107.110 Type ("fun", [Type ("Int.int", []), _])), [t1, t2]) =>
107.111 let
108.1 --- a/src/HOL/Tools/nat_numeral_simprocs.ML Mon Mar 26 15:32:54 2012 +0200
108.2 +++ b/src/HOL/Tools/nat_numeral_simprocs.ML Mon Mar 26 15:33:28 2012 +0200
108.3 @@ -25,15 +25,16 @@
108.4 structure Nat_Numeral_Simprocs : NAT_NUMERAL_SIMPROCS =
108.5 struct
108.6
108.7 -(*Maps n to #n for n = 0, 1, 2*)
108.8 -val numeral_syms = [@{thm nat_numeral_0_eq_0} RS sym, @{thm nat_numeral_1_eq_1} RS sym, @{thm numeral_2_eq_2} RS sym];
108.9 +(*Maps n to #n for n = 1, 2*)
108.10 +val numeral_syms = [@{thm numeral_1_eq_1} RS sym, @{thm numeral_2_eq_2} RS sym];
108.11 val numeral_sym_ss = HOL_basic_ss addsimps numeral_syms;
108.12
108.13 val rename_numerals = simplify numeral_sym_ss o Thm.transfer @{theory};
108.14
108.15 (*Utilities*)
108.16
108.17 -fun mk_number n = HOLogic.number_of_const HOLogic.natT $ HOLogic.mk_numeral n;
108.18 +fun mk_number 1 = HOLogic.numeral_const HOLogic.natT $ HOLogic.one_const
108.19 + | mk_number n = HOLogic.mk_number HOLogic.natT n;
108.20 fun dest_number t = Int.max (0, snd (HOLogic.dest_number t));
108.21
108.22 fun find_first_numeral past (t::terms) =
108.23 @@ -59,14 +60,13 @@
108.24 (** Other simproc items **)
108.25
108.26 val bin_simps =
108.27 - [@{thm nat_numeral_0_eq_0} RS sym, @{thm nat_numeral_1_eq_1} RS sym,
108.28 - @{thm add_nat_number_of}, @{thm nat_number_of_add_left},
108.29 - @{thm diff_nat_number_of}, @{thm le_number_of_eq_not_less},
108.30 - @{thm mult_nat_number_of}, @{thm nat_number_of_mult_left},
108.31 - @{thm less_nat_number_of},
108.32 + [@{thm numeral_1_eq_1} RS sym,
108.33 + @{thm numeral_plus_numeral}, @{thm add_numeral_left},
108.34 + @{thm diff_nat_numeral}, @{thm diff_0_eq_0}, @{thm diff_0},
108.35 + @{thm numeral_times_numeral}, @{thm mult_numeral_left(1)},
108.36 @{thm if_True}, @{thm if_False}, @{thm not_False_eq_True},
108.37 - @{thm Let_number_of}, @{thm nat_number_of}] @
108.38 - @{thms arith_simps} @ @{thms rel_simps} @ @{thms neg_simps};
108.39 + @{thm nat_0}, @{thm nat_numeral}, @{thm nat_neg_numeral}] @
108.40 + @{thms arith_simps} @ @{thms rel_simps};
108.41
108.42
108.43 (*** CancelNumerals simprocs ***)
108.44 @@ -115,7 +115,7 @@
108.45 handle TERM _ => (k, t::ts);
108.46
108.47 (*Code for testing whether numerals are already used in the goal*)
108.48 -fun is_numeral (Const(@{const_name Int.number_of}, _) $ w) = true
108.49 +fun is_numeral (Const(@{const_name Num.numeral}, _) $ w) = true
108.50 | is_numeral _ = false;
108.51
108.52 fun prod_has_numeral t = exists is_numeral (dest_prod t);
108.53 @@ -147,7 +147,7 @@
108.54
108.55 val simplify_meta_eq =
108.56 Arith_Data.simplify_meta_eq
108.57 - ([@{thm nat_numeral_0_eq_0}, @{thm numeral_1_eq_Suc_0}, @{thm Nat.add_0}, @{thm Nat.add_0_right},
108.58 + ([@{thm numeral_1_eq_Suc_0}, @{thm Nat.add_0}, @{thm Nat.add_0_right},
108.59 @{thm mult_0}, @{thm mult_0_right}, @{thm mult_1}, @{thm mult_1_right}] @ contra_rules);
108.60
108.61
109.1 --- a/src/HOL/Tools/numeral.ML Mon Mar 26 15:32:54 2012 +0200
109.2 +++ b/src/HOL/Tools/numeral.ML Mon Mar 26 15:33:28 2012 +0200
109.3 @@ -16,16 +16,20 @@
109.4
109.5 (* numeral *)
109.6
109.7 -fun mk_cbit 0 = @{cterm "Int.Bit0"}
109.8 - | mk_cbit 1 = @{cterm "Int.Bit1"}
109.9 +fun mk_cbit 0 = @{cterm "Num.Bit0"}
109.10 + | mk_cbit 1 = @{cterm "Num.Bit1"}
109.11 | mk_cbit _ = raise CTERM ("mk_cbit", []);
109.12
109.13 -fun mk_cnumeral 0 = @{cterm "Int.Pls"}
109.14 - | mk_cnumeral ~1 = @{cterm "Int.Min"}
109.15 - | mk_cnumeral i =
109.16 +fun mk_cnumeral i =
109.17 + let
109.18 + fun mk 1 = @{cterm "Num.One"}
109.19 + | mk i =
109.20 let val (q, r) = Integer.div_mod i 2 in
109.21 - Thm.apply (mk_cbit r) (mk_cnumeral q)
109.22 - end;
109.23 + Thm.apply (mk_cbit r) (mk q)
109.24 + end
109.25 + in
109.26 + if i > 0 then mk i else raise CTERM ("mk_cnumeral: negative input", [])
109.27 + end
109.28
109.29
109.30 (* number *)
109.31 @@ -38,8 +42,11 @@
109.32 val one = @{cpat "1"};
109.33 val oneT = Thm.ctyp_of_term one;
109.34
109.35 -val number_of = @{cpat "number_of"};
109.36 -val numberT = Thm.ctyp_of @{theory} (Term.range_type (Thm.typ_of (Thm.ctyp_of_term number_of)));
109.37 +val numeral = @{cpat "numeral"};
109.38 +val numeralT = Thm.ctyp_of @{theory} (Term.range_type (Thm.typ_of (Thm.ctyp_of_term numeral)));
109.39 +
109.40 +val neg_numeral = @{cpat "neg_numeral"};
109.41 +val neg_numeralT = Thm.ctyp_of @{theory} (Term.range_type (Thm.typ_of (Thm.ctyp_of_term neg_numeral)));
109.42
109.43 fun instT T V = Thm.instantiate_cterm ([(V, T)], []);
109.44
109.45 @@ -47,7 +54,9 @@
109.46
109.47 fun mk_cnumber T 0 = instT T zeroT zero
109.48 | mk_cnumber T 1 = instT T oneT one
109.49 - | mk_cnumber T i = Thm.apply (instT T numberT number_of) (mk_cnumeral i);
109.50 + | mk_cnumber T i =
109.51 + if i > 0 then Thm.apply (instT T numeralT numeral) (mk_cnumeral i)
109.52 + else Thm.apply (instT T neg_numeralT neg_numeral) (mk_cnumeral (~i));
109.53
109.54 end;
109.55
109.56 @@ -58,27 +67,23 @@
109.57
109.58 fun add_code number_of negative print target thy =
109.59 let
109.60 - fun dest_numeral pls' min' bit0' bit1' thm =
109.61 + fun dest_numeral one' bit0' bit1' thm t =
109.62 let
109.63 fun dest_bit (IConst (c, _)) = if c = bit0' then 0
109.64 else if c = bit1' then 1
109.65 else Code_Printer.eqn_error thm "Illegal numeral expression: illegal bit"
109.66 | dest_bit _ = Code_Printer.eqn_error thm "Illegal numeral expression: illegal bit";
109.67 - fun dest_num (IConst (c, _)) = if c = pls' then SOME 0
109.68 - else if c = min' then
109.69 - if negative then SOME ~1 else NONE
109.70 + fun dest_num (IConst (c, _)) = if c = one' then 1
109.71 else Code_Printer.eqn_error thm "Illegal numeral expression: illegal leading digit"
109.72 - | dest_num (t1 `$ t2) =
109.73 - let val (n, b) = (dest_num t2, dest_bit t1)
109.74 - in case n of SOME n => SOME (2 * n + b) | NONE => NONE end
109.75 + | dest_num (t1 `$ t2) = 2 * dest_num t2 + dest_bit t1
109.76 | dest_num _ = Code_Printer.eqn_error thm "Illegal numeral expression: illegal term";
109.77 - in dest_num end;
109.78 - fun pretty literals [pls', min', bit0', bit1'] _ thm _ _ [(t, _)] =
109.79 - (Code_Printer.str o print literals o the_default 0 o dest_numeral pls' min' bit0' bit1' thm) t;
109.80 + in if negative then ~ (dest_num t) else dest_num t end;
109.81 + fun pretty literals [one', bit0', bit1'] _ thm _ _ [(t, _)] =
109.82 + (Code_Printer.str o print literals o dest_numeral one' bit0' bit1' thm) t;
109.83 in
109.84 thy |> Code_Target.add_const_syntax target number_of
109.85 - (SOME (Code_Printer.complex_const_syntax (1, ([@{const_name Int.Pls}, @{const_name Int.Min},
109.86 - @{const_name Int.Bit0}, @{const_name Int.Bit1}], pretty))))
109.87 + (SOME (Code_Printer.complex_const_syntax (1, ([@{const_name Num.One},
109.88 + @{const_name Num.Bit0}, @{const_name Num.Bit1}], pretty))))
109.89 end;
109.90
109.91 end; (*local*)
110.1 --- a/src/HOL/Tools/numeral_simprocs.ML Mon Mar 26 15:32:54 2012 +0200
110.2 +++ b/src/HOL/Tools/numeral_simprocs.ML Mon Mar 26 15:33:28 2012 +0200
110.3 @@ -66,6 +66,7 @@
110.4 (* build product with trailing 1 rather than Numeral 1 in order to avoid the
110.5 unnecessary restriction to type class number_ring
110.6 which is not required for cancellation of common factors in divisions.
110.7 + UPDATE: this reasoning no longer applies (number_ring is gone)
110.8 *)
110.9 fun mk_prod T =
110.10 let val one = one_of T
110.11 @@ -148,22 +149,24 @@
110.12
110.13 (*This resembles Term_Ord.term_ord, but it puts binary numerals before other
110.14 non-atomic terms.*)
110.15 -local open Term
110.16 -in
110.17 -fun numterm_ord (Abs (_, T, t), Abs(_, U, u)) =
110.18 - (case numterm_ord (t, u) of EQUAL => Term_Ord.typ_ord (T, U) | ord => ord)
110.19 - | numterm_ord
110.20 - (Const(@{const_name Int.number_of}, _) $ v, Const(@{const_name Int.number_of}, _) $ w) =
110.21 - num_ord (HOLogic.dest_numeral v, HOLogic.dest_numeral w)
110.22 - | numterm_ord (Const(@{const_name Int.number_of}, _) $ _, _) = LESS
110.23 - | numterm_ord (_, Const(@{const_name Int.number_of}, _) $ _) = GREATER
110.24 - | numterm_ord (t, u) =
110.25 - (case int_ord (size_of_term t, size_of_term u) of
110.26 - EQUAL =>
110.27 +local open Term
110.28 +in
110.29 +fun numterm_ord (t, u) =
110.30 + case (try HOLogic.dest_number t, try HOLogic.dest_number u) of
110.31 + (SOME (_, i), SOME (_, j)) => num_ord (i, j)
110.32 + | (SOME _, NONE) => LESS
110.33 + | (NONE, SOME _) => GREATER
110.34 + | _ => (
110.35 + case (t, u) of
110.36 + (Abs (_, T, t), Abs(_, U, u)) =>
110.37 + (prod_ord numterm_ord Term_Ord.typ_ord ((t, T), (u, U)))
110.38 + | _ => (
110.39 + case int_ord (size_of_term t, size_of_term u) of
110.40 + EQUAL =>
110.41 let val (f, ts) = strip_comb t and (g, us) = strip_comb u in
110.42 - (case Term_Ord.hd_ord (f, g) of EQUAL => numterms_ord (ts, us) | ord => ord)
110.43 + (prod_ord Term_Ord.hd_ord numterms_ord ((f, ts), (g, us)))
110.44 end
110.45 - | ord => ord)
110.46 + | ord => ord))
110.47 and numterms_ord (ts, us) = list_ord numterm_ord (ts, us)
110.48 end;
110.49
110.50 @@ -171,16 +174,16 @@
110.51
110.52 val num_ss = HOL_basic_ss |> Simplifier.set_termless numtermless;
110.53
110.54 -(*Maps 0 to Numeral0 and 1 to Numeral1 so that arithmetic isn't complicated by the abstract 0 and 1.*)
110.55 -val numeral_syms = [@{thm numeral_0_eq_0} RS sym, @{thm numeral_1_eq_1} RS sym];
110.56 +(*Maps 1 to Numeral1 so that arithmetic isn't complicated by the abstract 1.*)
110.57 +val numeral_syms = [@{thm numeral_1_eq_1} RS sym];
110.58
110.59 -(*Simplify Numeral0+n, n+Numeral0, Numeral1*n, n*Numeral1, 1*x, x*1, x/1 *)
110.60 +(*Simplify 0+n, n+0, Numeral1*n, n*Numeral1, 1*x, x*1, x/1 *)
110.61 val add_0s = @{thms add_0s};
110.62 val mult_1s = @{thms mult_1s mult_1_left mult_1_right divide_1};
110.63
110.64 (* For post-simplification of the rhs of simproc-generated rules *)
110.65 val post_simps =
110.66 - [@{thm numeral_0_eq_0}, @{thm numeral_1_eq_1},
110.67 + [@{thm numeral_1_eq_1},
110.68 @{thm add_0_left}, @{thm add_0_right},
110.69 @{thm mult_zero_left}, @{thm mult_zero_right},
110.70 @{thm mult_1_left}, @{thm mult_1_right},
110.71 @@ -195,18 +198,24 @@
110.72
110.73 (*To perform binary arithmetic. The "left" rewriting handles patterns
110.74 created by the Numeral_Simprocs, such as 3 * (5 * x). *)
110.75 -val simps = [@{thm numeral_0_eq_0} RS sym, @{thm numeral_1_eq_1} RS sym,
110.76 - @{thm add_number_of_left}, @{thm mult_number_of_left}] @
110.77 - @{thms arith_simps} @ @{thms rel_simps};
110.78 -
110.79 +val simps =
110.80 + [@{thm numeral_1_eq_1} RS sym] @
110.81 + @{thms add_numeral_left} @
110.82 + @{thms add_neg_numeral_left} @
110.83 + @{thms mult_numeral_left} @
110.84 + @{thms arith_simps} @ @{thms rel_simps};
110.85 +
110.86 (*Binary arithmetic BUT NOT ADDITION since it may collapse adjacent terms
110.87 during re-arrangement*)
110.88 val non_add_simps =
110.89 - subtract Thm.eq_thm [@{thm add_number_of_left}, @{thm number_of_add} RS sym] simps;
110.90 + subtract Thm.eq_thm
110.91 + (@{thms add_numeral_left} @
110.92 + @{thms add_neg_numeral_left} @
110.93 + @{thms numeral_plus_numeral} @
110.94 + @{thms add_neg_numeral_simps}) simps;
110.95
110.96 (*To evaluate binary negations of coefficients*)
110.97 -val minus_simps = [@{thm numeral_m1_eq_minus_1} RS sym, @{thm number_of_minus} RS sym] @
110.98 - @{thms minus_bin_simps} @ @{thms pred_bin_simps};
110.99 +val minus_simps = [@{thm minus_zero}, @{thm minus_one}, @{thm minus_numeral}, @{thm minus_neg_numeral}];
110.100
110.101 (*To let us treat subtraction as addition*)
110.102 val diff_simps = [@{thm diff_minus}, @{thm minus_add_distrib}, @{thm minus_minus}];
110.103 @@ -365,9 +374,7 @@
110.104
110.105 (* simp_thms are necessary because some of the cancellation rules below
110.106 (e.g. mult_less_cancel_left) introduce various logical connectives *)
110.107 - val numeral_simp_ss = HOL_basic_ss addsimps
110.108 - [@{thm eq_number_of_eq}, @{thm less_number_of}, @{thm le_number_of}] @ simps
110.109 - @ @{thms simp_thms}
110.110 + val numeral_simp_ss = HOL_basic_ss addsimps simps @ @{thms simp_thms}
110.111 fun numeral_simp_tac ss = ALLGOALS (simp_tac (Simplifier.inherit_context ss numeral_simp_ss))
110.112 val simplify_meta_eq = Arith_Data.simplify_meta_eq
110.113 ([@{thm Nat.add_0}, @{thm Nat.add_0_right}] @ post_simps)
110.114 @@ -425,13 +432,16 @@
110.115 val field_cancel_numeral_factors =
110.116 map (prep_simproc @{theory})
110.117 [("field_eq_cancel_numeral_factor",
110.118 - ["(l::'a::{field,number_ring}) * m = n",
110.119 - "(l::'a::{field,number_ring}) = m * n"],
110.120 + ["(l::'a::field) * m = n",
110.121 + "(l::'a::field) = m * n"],
110.122 K EqCancelNumeralFactor.proc),
110.123 ("field_cancel_numeral_factor",
110.124 - ["((l::'a::{field_inverse_zero,number_ring}) * m) / n",
110.125 - "(l::'a::{field_inverse_zero,number_ring}) / (m * n)",
110.126 - "((number_of v)::'a::{field_inverse_zero,number_ring}) / (number_of w)"],
110.127 + ["((l::'a::field_inverse_zero) * m) / n",
110.128 + "(l::'a::field_inverse_zero) / (m * n)",
110.129 + "((numeral v)::'a::field_inverse_zero) / (numeral w)",
110.130 + "((numeral v)::'a::field_inverse_zero) / (neg_numeral w)",
110.131 + "((neg_numeral v)::'a::field_inverse_zero) / (numeral w)",
110.132 + "((neg_numeral v)::'a::field_inverse_zero) / (neg_numeral w)"],
110.133 K DivideCancelNumeralFactor.proc)]
110.134
110.135
110.136 @@ -678,13 +688,13 @@
110.137
110.138 val ths = [@{thm "mult_numeral_1"}, @{thm "mult_numeral_1_right"},
110.139 @{thm "divide_Numeral1"},
110.140 - @{thm "divide_zero"}, @{thm "divide_Numeral0"},
110.141 + @{thm "divide_zero"}, @{thm divide_zero_left},
110.142 @{thm "divide_divide_eq_left"},
110.143 @{thm "times_divide_eq_left"}, @{thm "times_divide_eq_right"},
110.144 @{thm "times_divide_times_eq"},
110.145 @{thm "divide_divide_eq_right"},
110.146 @{thm "diff_minus"}, @{thm "minus_divide_left"},
110.147 - @{thm "Numeral1_eq1_nat"}, @{thm "add_divide_distrib"} RS sym,
110.148 + @{thm "add_divide_distrib"} RS sym,
110.149 @{thm field_divide_inverse} RS sym, @{thm inverse_divide},
110.150 Conv.fconv_rule (Conv.arg_conv (Conv.arg1_conv (Conv.rewr_conv (mk_meta_eq @{thm mult_commute}))))
110.151 (@{thm field_divide_inverse} RS sym)]
110.152 @@ -699,8 +709,7 @@
110.153 addsimprocs [add_frac_frac_simproc, add_frac_num_simproc, ord_frac_simproc]
110.154 |> Simplifier.add_cong @{thm "if_weak_cong"})
110.155 then_conv
110.156 - Simplifier.rewrite (HOL_basic_ss addsimps
110.157 - [@{thm numeral_1_eq_1},@{thm numeral_0_eq_0}] @ @{thms numerals(1-2)})
110.158 + Simplifier.rewrite (HOL_basic_ss addsimps [@{thm numeral_1_eq_1}])
110.159
110.160 end
110.161
111.1 --- a/src/HOL/Tools/numeral_syntax.ML Mon Mar 26 15:32:54 2012 +0200
111.2 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000
111.3 @@ -1,93 +0,0 @@
111.4 -(* Title: HOL/Tools/numeral_syntax.ML
111.5 - Authors: Markus Wenzel, TU Muenchen
111.6 -
111.7 -Concrete syntax for generic numerals -- preserves leading zeros/ones.
111.8 -*)
111.9 -
111.10 -signature NUMERAL_SYNTAX =
111.11 -sig
111.12 - val setup: theory -> theory
111.13 -end;
111.14 -
111.15 -structure Numeral_Syntax: NUMERAL_SYNTAX =
111.16 -struct
111.17 -
111.18 -(* parse translation *)
111.19 -
111.20 -local
111.21 -
111.22 -fun mk_bin num =
111.23 - let
111.24 - fun bit b bs = HOLogic.mk_bit b $ bs;
111.25 - fun mk 0 = Syntax.const @{const_name Int.Pls}
111.26 - | mk ~1 = Syntax.const @{const_name Int.Min}
111.27 - | mk i = let val (q, r) = Integer.div_mod i 2 in bit r (mk q) end;
111.28 - in mk (#value (Lexicon.read_xnum num)) end;
111.29 -
111.30 -in
111.31 -
111.32 -fun numeral_tr [(c as Const (@{syntax_const "_constrain"}, _)) $ t $ u] = c $ numeral_tr [t] $ u
111.33 - | numeral_tr [t as Const (num, _)] = Syntax.const @{const_syntax Int.number_of} $ mk_bin num
111.34 - | numeral_tr ts = raise TERM ("numeral_tr", ts);
111.35 -
111.36 -end;
111.37 -
111.38 -
111.39 -(* print translation *)
111.40 -
111.41 -local
111.42 -
111.43 -fun dest_bin (Const (@{const_syntax Int.Pls}, _)) = []
111.44 - | dest_bin (Const (@{const_syntax Int.Min}, _)) = [~1]
111.45 - | dest_bin (Const (@{const_syntax Int.Bit0}, _) $ bs) = 0 :: dest_bin bs
111.46 - | dest_bin (Const (@{const_syntax Int.Bit1}, _) $ bs) = 1 :: dest_bin bs
111.47 - | dest_bin _ = raise Match;
111.48 -
111.49 -fun leading _ [] = 0
111.50 - | leading (i: int) (j :: js) = if i = j then 1 + leading i js else 0;
111.51 -
111.52 -fun int_of [] = 0
111.53 - | int_of (b :: bs) = b + 2 * int_of bs;
111.54 -
111.55 -fun dest_bin_str tm =
111.56 - let
111.57 - val rev_digs = dest_bin tm;
111.58 - val (sign, z) =
111.59 - (case rev rev_digs of
111.60 - ~1 :: bs => ("-", leading 1 bs)
111.61 - | bs => ("", leading 0 bs));
111.62 - val i = int_of rev_digs;
111.63 - val num = string_of_int (abs i);
111.64 - in
111.65 - if (i = 0 orelse i = 1) andalso z = 0 then raise Match
111.66 - else sign ^ implode (replicate z "0") ^ num
111.67 - end;
111.68 -
111.69 -fun syntax_numeral t =
111.70 - Syntax.const @{syntax_const "_Numeral"} $
111.71 - (Syntax.const @{syntax_const "_numeral"} $ Syntax.free (dest_bin_str t));
111.72 -
111.73 -in
111.74 -
111.75 -fun numeral_tr' ctxt (Type (@{type_name fun}, [_, T])) (t :: ts) =
111.76 - let val t' =
111.77 - if not (Config.get ctxt show_types) andalso can Term.dest_Type T then syntax_numeral t
111.78 - else
111.79 - Syntax.const @{syntax_const "_constrain"} $ syntax_numeral t $
111.80 - Syntax_Phases.term_of_typ ctxt T
111.81 - in list_comb (t', ts) end
111.82 - | numeral_tr' _ T (t :: ts) =
111.83 - if T = dummyT then list_comb (syntax_numeral t, ts)
111.84 - else raise Match
111.85 - | numeral_tr' _ _ _ = raise Match;
111.86 -
111.87 -end;
111.88 -
111.89 -
111.90 -(* theory setup *)
111.91 -
111.92 -val setup =
111.93 - Sign.add_trfuns ([], [(@{syntax_const "_Numeral"}, numeral_tr)], [], []) #>
111.94 - Sign.add_advanced_trfunsT [(@{const_syntax Int.number_of}, numeral_tr')];
111.95 -
111.96 -end;
112.1 --- a/src/HOL/Tools/semiring_normalizer.ML Mon Mar 26 15:32:54 2012 +0200
112.2 +++ b/src/HOL/Tools/semiring_normalizer.ML Mon Mar 26 15:33:28 2012 +0200
112.3 @@ -179,7 +179,7 @@
112.4 (case Rat.quotient_of_rat x of (i, 1) => i | _ => error "int_of_rat: bad int"),
112.5 conv = fn phi => fn _ => Simplifier.rewrite (HOL_basic_ss addsimps @{thms semiring_norm})
112.6 then_conv Simplifier.rewrite (HOL_basic_ss addsimps
112.7 - (@{thms numeral_1_eq_1} @ @{thms numeral_0_eq_0} @ @{thms numerals(1-2)}))};
112.8 + @{thms numeral_1_eq_1})};
112.9
112.10 fun field_funs key =
112.11 let
112.12 @@ -237,13 +237,13 @@
112.13 val is_numeral = can dest_numeral;
112.14
112.15 val numeral01_conv = Simplifier.rewrite
112.16 - (HOL_basic_ss addsimps [@{thm numeral_1_eq_1}, @{thm numeral_0_eq_0}]);
112.17 + (HOL_basic_ss addsimps [@{thm numeral_1_eq_1}]);
112.18 val zero1_numeral_conv =
112.19 - Simplifier.rewrite (HOL_basic_ss addsimps [@{thm numeral_1_eq_1} RS sym, @{thm numeral_0_eq_0} RS sym]);
112.20 + Simplifier.rewrite (HOL_basic_ss addsimps [@{thm numeral_1_eq_1} RS sym]);
112.21 fun zerone_conv cv = zero1_numeral_conv then_conv cv then_conv numeral01_conv;
112.22 -val natarith = [@{thm "add_nat_number_of"}, @{thm "diff_nat_number_of"},
112.23 - @{thm "mult_nat_number_of"}, @{thm "eq_nat_number_of"},
112.24 - @{thm "less_nat_number_of"}];
112.25 +val natarith = [@{thm "numeral_plus_numeral"}, @{thm "diff_nat_numeral"},
112.26 + @{thm "numeral_times_numeral"}, @{thm "numeral_eq_iff"},
112.27 + @{thm "numeral_less_iff"}];
112.28
112.29 val nat_add_conv =
112.30 zerone_conv
112.31 @@ -251,7 +251,7 @@
112.32 (HOL_basic_ss
112.33 addsimps @{thms arith_simps} @ natarith @ @{thms rel_simps}
112.34 @ [@{thm if_False}, @{thm if_True}, @{thm Nat.add_0}, @{thm add_Suc},
112.35 - @{thm add_number_of_left}, @{thm Suc_eq_plus1}]
112.36 + @{thm add_numeral_left}, @{thm Suc_eq_plus1}]
112.37 @ map (fn th => th RS sym) @{thms numerals}));
112.38
112.39 val zeron_tm = @{cterm "0::nat"};
113.1 --- a/src/HOL/Transcendental.thy Mon Mar 26 15:32:54 2012 +0200
113.2 +++ b/src/HOL/Transcendental.thy Mon Mar 26 15:33:28 2012 +0200
113.3 @@ -2044,8 +2044,8 @@
113.4 finally show ?thesis by auto
113.5 qed
113.6
113.7 -lemma tan_periodic_n[simp]: "tan (x + number_of n * pi) = tan x"
113.8 - using tan_periodic_int[of _ "number_of n" ] unfolding real_number_of .
113.9 +lemma tan_periodic_n[simp]: "tan (x + numeral n * pi) = tan x"
113.10 + using tan_periodic_int[of _ "numeral n" ] unfolding real_numeral .
113.11
113.12 subsection {* Inverse Trigonometric Functions *}
113.13
114.1 --- a/src/HOL/Word/Bit_Int.thy Mon Mar 26 15:32:54 2012 +0200
114.2 +++ b/src/HOL/Word/Bit_Int.thy Mon Mar 26 15:33:28 2012 +0200
114.3 @@ -50,11 +50,13 @@
114.4 unfolding int_not_def Bit_def by (cases b, simp_all)
114.5
114.6 lemma int_not_simps [simp]:
114.7 - "NOT Int.Pls = Int.Min"
114.8 - "NOT Int.Min = Int.Pls"
114.9 - "NOT (Int.Bit0 w) = Int.Bit1 (NOT w)"
114.10 - "NOT (Int.Bit1 w) = Int.Bit0 (NOT w)"
114.11 - unfolding int_not_def Pls_def Min_def Bit0_def Bit1_def by simp_all
114.12 + "NOT (0::int) = -1"
114.13 + "NOT (1::int) = -2"
114.14 + "NOT (-1::int) = 0"
114.15 + "NOT (numeral w::int) = neg_numeral (w + Num.One)"
114.16 + "NOT (neg_numeral (Num.Bit0 w)::int) = numeral (Num.BitM w)"
114.17 + "NOT (neg_numeral (Num.Bit1 w)::int) = numeral (Num.Bit0 w)"
114.18 + unfolding int_not_def by simp_all
114.19
114.20 lemma int_not_not [simp]: "NOT (NOT (x::int)) = x"
114.21 unfolding int_not_def by simp
114.22 @@ -65,12 +67,6 @@
114.23 lemma int_and_m1 [simp]: "(-1::int) AND x = x"
114.24 by (simp add: bitAND_int.simps)
114.25
114.26 -lemma int_and_Pls [simp]: "Int.Pls AND x = Int.Pls"
114.27 - unfolding Pls_def by simp
114.28 -
114.29 -lemma int_and_Min [simp]: "Int.Min AND x = x"
114.30 - unfolding Min_def by simp
114.31 -
114.32 lemma Bit_eq_0_iff: "w BIT b = 0 \<longleftrightarrow> w = 0 \<and> b = 0"
114.33 by (subst BIT_eq_iff [symmetric], simp)
114.34
114.35 @@ -81,17 +77,10 @@
114.36 "(x BIT b) AND (y BIT c) = (x AND y) BIT (b AND c)"
114.37 by (subst bitAND_int.simps, simp add: Bit_eq_0_iff Bit_eq_m1_iff)
114.38
114.39 -lemma int_and_Bits2 [simp]:
114.40 - "(Int.Bit0 x) AND (Int.Bit0 y) = Int.Bit0 (x AND y)"
114.41 - "(Int.Bit0 x) AND (Int.Bit1 y) = Int.Bit0 (x AND y)"
114.42 - "(Int.Bit1 x) AND (Int.Bit0 y) = Int.Bit0 (x AND y)"
114.43 - "(Int.Bit1 x) AND (Int.Bit1 y) = Int.Bit1 (x AND y)"
114.44 - unfolding BIT_simps [symmetric] int_and_Bits by simp_all
114.45 -
114.46 -lemma int_or_Pls [simp]: "Int.Pls OR x = x"
114.47 +lemma int_or_zero [simp]: "(0::int) OR x = x"
114.48 unfolding int_or_def by simp
114.49
114.50 -lemma int_or_Min [simp]: "Int.Min OR x = Int.Min"
114.51 +lemma int_or_minus1 [simp]: "(-1::int) OR x = -1"
114.52 unfolding int_or_def by simp
114.53
114.54 lemma bit_or_def: "(b::bit) OR c = NOT (NOT b AND NOT c)"
114.55 @@ -101,14 +90,7 @@
114.56 "(x BIT b) OR (y BIT c) = (x OR y) BIT (b OR c)"
114.57 unfolding int_or_def bit_or_def by simp
114.58
114.59 -lemma int_or_Bits2 [simp]:
114.60 - "(Int.Bit0 x) OR (Int.Bit0 y) = Int.Bit0 (x OR y)"
114.61 - "(Int.Bit0 x) OR (Int.Bit1 y) = Int.Bit1 (x OR y)"
114.62 - "(Int.Bit1 x) OR (Int.Bit0 y) = Int.Bit1 (x OR y)"
114.63 - "(Int.Bit1 x) OR (Int.Bit1 y) = Int.Bit1 (x OR y)"
114.64 - unfolding int_or_def by simp_all
114.65 -
114.66 -lemma int_xor_Pls [simp]: "Int.Pls XOR x = x"
114.67 +lemma int_xor_zero [simp]: "(0::int) XOR x = x"
114.68 unfolding int_xor_def by simp
114.69
114.70 lemma bit_xor_def: "(b::bit) XOR c = (b AND NOT c) OR (NOT b AND c)"
114.71 @@ -118,13 +100,6 @@
114.72 "(x BIT b) XOR (y BIT c) = (x XOR y) BIT (b XOR c)"
114.73 unfolding int_xor_def bit_xor_def by simp
114.74
114.75 -lemma int_xor_Bits2 [simp]:
114.76 - "(Int.Bit0 x) XOR (Int.Bit0 y) = Int.Bit0 (x XOR y)"
114.77 - "(Int.Bit0 x) XOR (Int.Bit1 y) = Int.Bit1 (x XOR y)"
114.78 - "(Int.Bit1 x) XOR (Int.Bit0 y) = Int.Bit1 (x XOR y)"
114.79 - "(Int.Bit1 x) XOR (Int.Bit1 y) = Int.Bit0 (x XOR y)"
114.80 - unfolding BIT_simps [symmetric] int_xor_Bits by simp_all
114.81 -
114.82 subsubsection {* Binary destructors *}
114.83
114.84 lemma bin_rest_NOT [simp]: "bin_rest (NOT x) = NOT (bin_rest x)"
114.85 @@ -166,22 +141,22 @@
114.86
114.87 subsubsection {* Derived properties *}
114.88
114.89 -lemma int_xor_Min [simp]: "Int.Min XOR x = NOT x"
114.90 +lemma int_xor_minus1 [simp]: "(-1::int) XOR x = NOT x"
114.91 by (auto simp add: bin_eq_iff bin_nth_ops)
114.92
114.93 lemma int_xor_extra_simps [simp]:
114.94 - "w XOR Int.Pls = w"
114.95 - "w XOR Int.Min = NOT w"
114.96 + "w XOR (0::int) = w"
114.97 + "w XOR (-1::int) = NOT w"
114.98 by (auto simp add: bin_eq_iff bin_nth_ops)
114.99
114.100 lemma int_or_extra_simps [simp]:
114.101 - "w OR Int.Pls = w"
114.102 - "w OR Int.Min = Int.Min"
114.103 + "w OR (0::int) = w"
114.104 + "w OR (-1::int) = -1"
114.105 by (auto simp add: bin_eq_iff bin_nth_ops)
114.106
114.107 lemma int_and_extra_simps [simp]:
114.108 - "w AND Int.Pls = Int.Pls"
114.109 - "w AND Int.Min = w"
114.110 + "w AND (0::int) = 0"
114.111 + "w AND (-1::int) = w"
114.112 by (auto simp add: bin_eq_iff bin_nth_ops)
114.113
114.114 (* commutativity of the above *)
114.115 @@ -195,12 +170,12 @@
114.116 lemma bin_ops_same [simp]:
114.117 "(x::int) AND x = x"
114.118 "(x::int) OR x = x"
114.119 - "(x::int) XOR x = Int.Pls"
114.120 + "(x::int) XOR x = 0"
114.121 by (auto simp add: bin_eq_iff bin_nth_ops)
114.122
114.123 lemmas bin_log_esimps =
114.124 int_and_extra_simps int_or_extra_simps int_xor_extra_simps
114.125 - int_and_Pls int_and_Min int_or_Pls int_or_Min int_xor_Pls int_xor_Min
114.126 + int_and_0 int_and_m1 int_or_zero int_or_minus1 int_xor_zero int_xor_minus1
114.127
114.128 (* basic properties of logical (bit-wise) operations *)
114.129
114.130 @@ -262,6 +237,106 @@
114.131 declare bin_ops_comm [simp] bbw_assocs [simp]
114.132 *)
114.133
114.134 +subsubsection {* Simplification with numerals *}
114.135 +
114.136 +text {* Cases for @{text "0"} and @{text "-1"} are already covered by
114.137 + other simp rules. *}
114.138 +
114.139 +lemma bin_rl_eqI: "\<lbrakk>bin_rest x = bin_rest y; bin_last x = bin_last y\<rbrakk> \<Longrightarrow> x = y"
114.140 + by (metis bin_rl_simp)
114.141 +
114.142 +lemma bin_rest_neg_numeral_BitM [simp]:
114.143 + "bin_rest (neg_numeral (Num.BitM w)) = neg_numeral w"
114.144 + by (simp only: BIT_bin_simps [symmetric] bin_rest_BIT)
114.145 +
114.146 +lemma bin_last_neg_numeral_BitM [simp]:
114.147 + "bin_last (neg_numeral (Num.BitM w)) = 1"
114.148 + by (simp only: BIT_bin_simps [symmetric] bin_last_BIT)
114.149 +
114.150 +text {* FIXME: The rule sets below are very large (24 rules for each
114.151 + operator). Is there a simpler way to do this? *}
114.152 +
114.153 +lemma int_and_numerals [simp]:
114.154 + "numeral (Num.Bit0 x) AND numeral (Num.Bit0 y) = (numeral x AND numeral y) BIT 0"
114.155 + "numeral (Num.Bit0 x) AND numeral (Num.Bit1 y) = (numeral x AND numeral y) BIT 0"
114.156 + "numeral (Num.Bit1 x) AND numeral (Num.Bit0 y) = (numeral x AND numeral y) BIT 0"
114.157 + "numeral (Num.Bit1 x) AND numeral (Num.Bit1 y) = (numeral x AND numeral y) BIT 1"
114.158 + "numeral (Num.Bit0 x) AND neg_numeral (Num.Bit0 y) = (numeral x AND neg_numeral y) BIT 0"
114.159 + "numeral (Num.Bit0 x) AND neg_numeral (Num.Bit1 y) = (numeral x AND neg_numeral (y + Num.One)) BIT 0"
114.160 + "numeral (Num.Bit1 x) AND neg_numeral (Num.Bit0 y) = (numeral x AND neg_numeral y) BIT 0"
114.161 + "numeral (Num.Bit1 x) AND neg_numeral (Num.Bit1 y) = (numeral x AND neg_numeral (y + Num.One)) BIT 1"
114.162 + "neg_numeral (Num.Bit0 x) AND numeral (Num.Bit0 y) = (neg_numeral x AND numeral y) BIT 0"
114.163 + "neg_numeral (Num.Bit0 x) AND numeral (Num.Bit1 y) = (neg_numeral x AND numeral y) BIT 0"
114.164 + "neg_numeral (Num.Bit1 x) AND numeral (Num.Bit0 y) = (neg_numeral (x + Num.One) AND numeral y) BIT 0"
114.165 + "neg_numeral (Num.Bit1 x) AND numeral (Num.Bit1 y) = (neg_numeral (x + Num.One) AND numeral y) BIT 1"
114.166 + "neg_numeral (Num.Bit0 x) AND neg_numeral (Num.Bit0 y) = (neg_numeral x AND neg_numeral y) BIT 0"
114.167 + "neg_numeral (Num.Bit0 x) AND neg_numeral (Num.Bit1 y) = (neg_numeral x AND neg_numeral (y + Num.One)) BIT 0"
114.168 + "neg_numeral (Num.Bit1 x) AND neg_numeral (Num.Bit0 y) = (neg_numeral (x + Num.One) AND neg_numeral y) BIT 0"
114.169 + "neg_numeral (Num.Bit1 x) AND neg_numeral (Num.Bit1 y) = (neg_numeral (x + Num.One) AND neg_numeral (y + Num.One)) BIT 1"
114.170 + "(1::int) AND numeral (Num.Bit0 y) = 0"
114.171 + "(1::int) AND numeral (Num.Bit1 y) = 1"
114.172 + "(1::int) AND neg_numeral (Num.Bit0 y) = 0"
114.173 + "(1::int) AND neg_numeral (Num.Bit1 y) = 1"
114.174 + "numeral (Num.Bit0 x) AND (1::int) = 0"
114.175 + "numeral (Num.Bit1 x) AND (1::int) = 1"
114.176 + "neg_numeral (Num.Bit0 x) AND (1::int) = 0"
114.177 + "neg_numeral (Num.Bit1 x) AND (1::int) = 1"
114.178 + by (rule bin_rl_eqI, simp, simp)+
114.179 +
114.180 +lemma int_or_numerals [simp]:
114.181 + "numeral (Num.Bit0 x) OR numeral (Num.Bit0 y) = (numeral x OR numeral y) BIT 0"
114.182 + "numeral (Num.Bit0 x) OR numeral (Num.Bit1 y) = (numeral x OR numeral y) BIT 1"
114.183 + "numeral (Num.Bit1 x) OR numeral (Num.Bit0 y) = (numeral x OR numeral y) BIT 1"
114.184 + "numeral (Num.Bit1 x) OR numeral (Num.Bit1 y) = (numeral x OR numeral y) BIT 1"
114.185 + "numeral (Num.Bit0 x) OR neg_numeral (Num.Bit0 y) = (numeral x OR neg_numeral y) BIT 0"
114.186 + "numeral (Num.Bit0 x) OR neg_numeral (Num.Bit1 y) = (numeral x OR neg_numeral (y + Num.One)) BIT 1"
114.187 + "numeral (Num.Bit1 x) OR neg_numeral (Num.Bit0 y) = (numeral x OR neg_numeral y) BIT 1"
114.188 + "numeral (Num.Bit1 x) OR neg_numeral (Num.Bit1 y) = (numeral x OR neg_numeral (y + Num.One)) BIT 1"
114.189 + "neg_numeral (Num.Bit0 x) OR numeral (Num.Bit0 y) = (neg_numeral x OR numeral y) BIT 0"
114.190 + "neg_numeral (Num.Bit0 x) OR numeral (Num.Bit1 y) = (neg_numeral x OR numeral y) BIT 1"
114.191 + "neg_numeral (Num.Bit1 x) OR numeral (Num.Bit0 y) = (neg_numeral (x + Num.One) OR numeral y) BIT 1"
114.192 + "neg_numeral (Num.Bit1 x) OR numeral (Num.Bit1 y) = (neg_numeral (x + Num.One) OR numeral y) BIT 1"
114.193 + "neg_numeral (Num.Bit0 x) OR neg_numeral (Num.Bit0 y) = (neg_numeral x OR neg_numeral y) BIT 0"
114.194 + "neg_numeral (Num.Bit0 x) OR neg_numeral (Num.Bit1 y) = (neg_numeral x OR neg_numeral (y + Num.One)) BIT 1"
114.195 + "neg_numeral (Num.Bit1 x) OR neg_numeral (Num.Bit0 y) = (neg_numeral (x + Num.One) OR neg_numeral y) BIT 1"
114.196 + "neg_numeral (Num.Bit1 x) OR neg_numeral (Num.Bit1 y) = (neg_numeral (x + Num.One) OR neg_numeral (y + Num.One)) BIT 1"
114.197 + "(1::int) OR numeral (Num.Bit0 y) = numeral (Num.Bit1 y)"
114.198 + "(1::int) OR numeral (Num.Bit1 y) = numeral (Num.Bit1 y)"
114.199 + "(1::int) OR neg_numeral (Num.Bit0 y) = neg_numeral (Num.BitM y)"
114.200 + "(1::int) OR neg_numeral (Num.Bit1 y) = neg_numeral (Num.Bit1 y)"
114.201 + "numeral (Num.Bit0 x) OR (1::int) = numeral (Num.Bit1 x)"
114.202 + "numeral (Num.Bit1 x) OR (1::int) = numeral (Num.Bit1 x)"
114.203 + "neg_numeral (Num.Bit0 x) OR (1::int) = neg_numeral (Num.BitM x)"
114.204 + "neg_numeral (Num.Bit1 x) OR (1::int) = neg_numeral (Num.Bit1 x)"
114.205 + by (rule bin_rl_eqI, simp, simp)+
114.206 +
114.207 +lemma int_xor_numerals [simp]:
114.208 + "numeral (Num.Bit0 x) XOR numeral (Num.Bit0 y) = (numeral x XOR numeral y) BIT 0"
114.209 + "numeral (Num.Bit0 x) XOR numeral (Num.Bit1 y) = (numeral x XOR numeral y) BIT 1"
114.210 + "numeral (Num.Bit1 x) XOR numeral (Num.Bit0 y) = (numeral x XOR numeral y) BIT 1"
114.211 + "numeral (Num.Bit1 x) XOR numeral (Num.Bit1 y) = (numeral x XOR numeral y) BIT 0"
114.212 + "numeral (Num.Bit0 x) XOR neg_numeral (Num.Bit0 y) = (numeral x XOR neg_numeral y) BIT 0"
114.213 + "numeral (Num.Bit0 x) XOR neg_numeral (Num.Bit1 y) = (numeral x XOR neg_numeral (y + Num.One)) BIT 1"
114.214 + "numeral (Num.Bit1 x) XOR neg_numeral (Num.Bit0 y) = (numeral x XOR neg_numeral y) BIT 1"
114.215 + "numeral (Num.Bit1 x) XOR neg_numeral (Num.Bit1 y) = (numeral x XOR neg_numeral (y + Num.One)) BIT 0"
114.216 + "neg_numeral (Num.Bit0 x) XOR numeral (Num.Bit0 y) = (neg_numeral x XOR numeral y) BIT 0"
114.217 + "neg_numeral (Num.Bit0 x) XOR numeral (Num.Bit1 y) = (neg_numeral x XOR numeral y) BIT 1"
114.218 + "neg_numeral (Num.Bit1 x) XOR numeral (Num.Bit0 y) = (neg_numeral (x + Num.One) XOR numeral y) BIT 1"
114.219 + "neg_numeral (Num.Bit1 x) XOR numeral (Num.Bit1 y) = (neg_numeral (x + Num.One) XOR numeral y) BIT 0"
114.220 + "neg_numeral (Num.Bit0 x) XOR neg_numeral (Num.Bit0 y) = (neg_numeral x XOR neg_numeral y) BIT 0"
114.221 + "neg_numeral (Num.Bit0 x) XOR neg_numeral (Num.Bit1 y) = (neg_numeral x XOR neg_numeral (y + Num.One)) BIT 1"
114.222 + "neg_numeral (Num.Bit1 x) XOR neg_numeral (Num.Bit0 y) = (neg_numeral (x + Num.One) XOR neg_numeral y) BIT 1"
114.223 + "neg_numeral (Num.Bit1 x) XOR neg_numeral (Num.Bit1 y) = (neg_numeral (x + Num.One) XOR neg_numeral (y + Num.One)) BIT 0"
114.224 + "(1::int) XOR numeral (Num.Bit0 y) = numeral (Num.Bit1 y)"
114.225 + "(1::int) XOR numeral (Num.Bit1 y) = numeral (Num.Bit0 y)"
114.226 + "(1::int) XOR neg_numeral (Num.Bit0 y) = neg_numeral (Num.BitM y)"
114.227 + "(1::int) XOR neg_numeral (Num.Bit1 y) = neg_numeral (Num.Bit0 (y + Num.One))"
114.228 + "numeral (Num.Bit0 x) XOR (1::int) = numeral (Num.Bit1 x)"
114.229 + "numeral (Num.Bit1 x) XOR (1::int) = numeral (Num.Bit0 x)"
114.230 + "neg_numeral (Num.Bit0 x) XOR (1::int) = neg_numeral (Num.BitM x)"
114.231 + "neg_numeral (Num.Bit1 x) XOR (1::int) = neg_numeral (Num.Bit0 (x + Num.One))"
114.232 + by (rule bin_rl_eqI, simp, simp)+
114.233 +
114.234 subsubsection {* Interactions with arithmetic *}
114.235
114.236 lemma plus_and_or [rule_format]:
114.237 @@ -282,7 +357,6 @@
114.238 "bin_sign (y::int) = 0 ==> x <= x OR y"
114.239 apply (induct y arbitrary: x rule: bin_induct)
114.240 apply clarsimp
114.241 - apply (simp only: Min_def)
114.242 apply clarsimp
114.243 apply (case_tac x rule: bin_exhaust)
114.244 apply (case_tac b)
114.245 @@ -293,13 +367,20 @@
114.246 lemmas int_and_le =
114.247 xtr3 [OF bbw_ao_absorbs (2) [THEN conjunct2, symmetric] le_int_or]
114.248
114.249 +lemma add_BIT_simps [simp]: (* FIXME: move *)
114.250 + "x BIT 0 + y BIT 0 = (x + y) BIT 0"
114.251 + "x BIT 0 + y BIT 1 = (x + y) BIT 1"
114.252 + "x BIT 1 + y BIT 0 = (x + y) BIT 1"
114.253 + "x BIT 1 + y BIT 1 = (x + y + 1) BIT 0"
114.254 + by (simp_all add: Bit_B0_2t Bit_B1_2t)
114.255 +
114.256 (* interaction between bit-wise and arithmetic *)
114.257 (* good example of bin_induction *)
114.258 -lemma bin_add_not: "x + NOT x = Int.Min"
114.259 +lemma bin_add_not: "x + NOT x = (-1::int)"
114.260 apply (induct x rule: bin_induct)
114.261 apply clarsimp
114.262 apply clarsimp
114.263 - apply (case_tac bit, auto simp: BIT_simps)
114.264 + apply (case_tac bit, auto)
114.265 done
114.266
114.267 subsubsection {* Truncating results of bit-wise operations *}
114.268 @@ -418,8 +499,10 @@
114.269 lemmas bin_sc_Suc_minus =
114.270 trans [OF bin_sc_minus [symmetric] bin_sc.Suc]
114.271
114.272 -lemmas bin_sc_Suc_pred [simp] =
114.273 - bin_sc_Suc_minus [of "number_of bin", simplified nobm1] for bin
114.274 +lemma bin_sc_numeral [simp]:
114.275 + "bin_sc (numeral k) b w =
114.276 + bin_sc (numeral k - 1) b (bin_rest w) BIT bin_last w"
114.277 + by (subst expand_Suc, rule bin_sc.Suc)
114.278
114.279
114.280 subsection {* Splitting and concatenation *}
115.1 --- a/src/HOL/Word/Bit_Representation.thy Mon Mar 26 15:32:54 2012 +0200
115.2 +++ b/src/HOL/Word/Bit_Representation.thy Mon Mar 26 15:33:28 2012 +0200
115.3 @@ -47,41 +47,49 @@
115.4 by (metis bin_rest_BIT bin_last_BIT)
115.5
115.6 lemma BIT_bin_simps [simp]:
115.7 - "number_of w BIT 0 = number_of (Int.Bit0 w)"
115.8 - "number_of w BIT 1 = number_of (Int.Bit1 w)"
115.9 - unfolding Bit_def number_of_is_id numeral_simps by simp_all
115.10 + "numeral k BIT 0 = numeral (Num.Bit0 k)"
115.11 + "numeral k BIT 1 = numeral (Num.Bit1 k)"
115.12 + "neg_numeral k BIT 0 = neg_numeral (Num.Bit0 k)"
115.13 + "neg_numeral k BIT 1 = neg_numeral (Num.BitM k)"
115.14 + unfolding neg_numeral_def numeral.simps numeral_BitM
115.15 + unfolding Bit_def bitval_simps
115.16 + by (simp_all del: arith_simps add_numeral_special diff_numeral_special)
115.17
115.18 lemma BIT_special_simps [simp]:
115.19 shows "0 BIT 0 = 0" and "0 BIT 1 = 1" and "1 BIT 0 = 2" and "1 BIT 1 = 3"
115.20 unfolding Bit_def by simp_all
115.21
115.22 +lemma BitM_inc: "Num.BitM (Num.inc w) = Num.Bit1 w"
115.23 + by (induct w, simp_all)
115.24 +
115.25 +lemma expand_BIT:
115.26 + "numeral (Num.Bit0 w) = numeral w BIT 0"
115.27 + "numeral (Num.Bit1 w) = numeral w BIT 1"
115.28 + "neg_numeral (Num.Bit0 w) = neg_numeral w BIT 0"
115.29 + "neg_numeral (Num.Bit1 w) = neg_numeral (w + Num.One) BIT 1"
115.30 + unfolding add_One by (simp_all add: BitM_inc)
115.31 +
115.32 lemma bin_last_numeral_simps [simp]:
115.33 "bin_last 0 = 0"
115.34 "bin_last 1 = 1"
115.35 "bin_last -1 = 1"
115.36 - "bin_last (number_of (Int.Bit0 w)) = 0"
115.37 - "bin_last (number_of (Int.Bit1 w)) = 1"
115.38 - unfolding bin_last_def by simp_all
115.39 + "bin_last Numeral1 = 1"
115.40 + "bin_last (numeral (Num.Bit0 w)) = 0"
115.41 + "bin_last (numeral (Num.Bit1 w)) = 1"
115.42 + "bin_last (neg_numeral (Num.Bit0 w)) = 0"
115.43 + "bin_last (neg_numeral (Num.Bit1 w)) = 1"
115.44 + unfolding expand_BIT bin_last_BIT by (simp_all add: bin_last_def)
115.45
115.46 lemma bin_rest_numeral_simps [simp]:
115.47 "bin_rest 0 = 0"
115.48 "bin_rest 1 = 0"
115.49 "bin_rest -1 = -1"
115.50 - "bin_rest (number_of (Int.Bit0 w)) = number_of w"
115.51 - "bin_rest (number_of (Int.Bit1 w)) = number_of w"
115.52 - unfolding bin_rest_def by simp_all
115.53 -
115.54 -lemma BIT_B0_eq_Bit0: "w BIT 0 = Int.Bit0 w"
115.55 - unfolding Bit_def Bit0_def by simp
115.56 -
115.57 -lemma BIT_B1_eq_Bit1: "w BIT 1 = Int.Bit1 w"
115.58 - unfolding Bit_def Bit1_def by simp
115.59 -
115.60 -lemmas BIT_simps = BIT_B0_eq_Bit0 BIT_B1_eq_Bit1
115.61 -
115.62 -lemma number_of_False_cong:
115.63 - "False \<Longrightarrow> number_of x = number_of y"
115.64 - by (rule FalseE)
115.65 + "bin_rest Numeral1 = 0"
115.66 + "bin_rest (numeral (Num.Bit0 w)) = numeral w"
115.67 + "bin_rest (numeral (Num.Bit1 w)) = numeral w"
115.68 + "bin_rest (neg_numeral (Num.Bit0 w)) = neg_numeral w"
115.69 + "bin_rest (neg_numeral (Num.Bit1 w)) = neg_numeral (w + Num.One)"
115.70 + unfolding expand_BIT bin_rest_BIT by (simp_all add: bin_rest_def)
115.71
115.72 lemma less_Bits:
115.73 "(v BIT b < w BIT c) = (v < w | v <= w & b = (0::bit) & c = (1::bit))"
115.74 @@ -121,11 +129,7 @@
115.75 done
115.76
115.77 lemma bin_ex_rl: "EX w b. w BIT b = bin"
115.78 - apply (unfold Bit_def)
115.79 - apply (cases "even bin")
115.80 - apply (clarsimp simp: even_equiv_def)
115.81 - apply (auto simp: odd_equiv_def bitval_def split: bit.split)
115.82 - done
115.83 + by (metis bin_rl_simp)
115.84
115.85 lemma bin_exhaust:
115.86 assumes Q: "\<And>x b. bin = x BIT b \<Longrightarrow> Q"
115.87 @@ -144,18 +148,18 @@
115.88 | Suc: "bin_nth w (Suc n) = bin_nth (bin_rest w) n"
115.89
115.90 lemma bin_abs_lem:
115.91 - "bin = (w BIT b) ==> ~ bin = Int.Min --> ~ bin = Int.Pls -->
115.92 + "bin = (w BIT b) ==> bin ~= -1 --> bin ~= 0 -->
115.93 nat (abs w) < nat (abs bin)"
115.94 apply clarsimp
115.95 - apply (unfold Pls_def Min_def Bit_def)
115.96 + apply (unfold Bit_def)
115.97 apply (cases b)
115.98 apply (clarsimp, arith)
115.99 apply (clarsimp, arith)
115.100 done
115.101
115.102 lemma bin_induct:
115.103 - assumes PPls: "P Int.Pls"
115.104 - and PMin: "P Int.Min"
115.105 + assumes PPls: "P 0"
115.106 + and PMin: "P -1"
115.107 and PBit: "!!bin bit. P bin ==> P (bin BIT bit)"
115.108 shows "P bin"
115.109 apply (rule_tac P=P and a=bin and f1="nat o abs"
115.110 @@ -166,54 +170,22 @@
115.111 apply (auto simp add : PPls PMin PBit)
115.112 done
115.113
115.114 -lemma numeral_induct:
115.115 - assumes Pls: "P Int.Pls"
115.116 - assumes Min: "P Int.Min"
115.117 - assumes Bit0: "\<And>w. \<lbrakk>P w; w \<noteq> Int.Pls\<rbrakk> \<Longrightarrow> P (Int.Bit0 w)"
115.118 - assumes Bit1: "\<And>w. \<lbrakk>P w; w \<noteq> Int.Min\<rbrakk> \<Longrightarrow> P (Int.Bit1 w)"
115.119 - shows "P x"
115.120 - apply (induct x rule: bin_induct)
115.121 - apply (rule Pls)
115.122 - apply (rule Min)
115.123 - apply (case_tac bit)
115.124 - apply (case_tac "bin = Int.Pls")
115.125 - apply (simp add: BIT_simps)
115.126 - apply (simp add: Bit0 BIT_simps)
115.127 - apply (case_tac "bin = Int.Min")
115.128 - apply (simp add: BIT_simps)
115.129 - apply (simp add: Bit1 BIT_simps)
115.130 - done
115.131 -
115.132 -lemma bin_rest_simps [simp]:
115.133 - "bin_rest Int.Pls = Int.Pls"
115.134 - "bin_rest Int.Min = Int.Min"
115.135 - "bin_rest (Int.Bit0 w) = w"
115.136 - "bin_rest (Int.Bit1 w) = w"
115.137 - unfolding numeral_simps by (auto simp: bin_rest_def)
115.138 -
115.139 -lemma bin_last_simps [simp]:
115.140 - "bin_last Int.Pls = (0::bit)"
115.141 - "bin_last Int.Min = (1::bit)"
115.142 - "bin_last (Int.Bit0 w) = (0::bit)"
115.143 - "bin_last (Int.Bit1 w) = (1::bit)"
115.144 - unfolding numeral_simps by (auto simp: bin_last_def z1pmod2)
115.145 -
115.146 lemma Bit_div2 [simp]: "(w BIT b) div 2 = w"
115.147 unfolding bin_rest_def [symmetric] by (rule bin_rest_BIT)
115.148
115.149 lemma bin_nth_lem [rule_format]:
115.150 "ALL y. bin_nth x = bin_nth y --> x = y"
115.151 - apply (induct x rule: bin_induct [unfolded Pls_def Min_def])
115.152 + apply (induct x rule: bin_induct)
115.153 apply safe
115.154 apply (erule rev_mp)
115.155 - apply (induct_tac y rule: bin_induct [unfolded Pls_def Min_def])
115.156 + apply (induct_tac y rule: bin_induct)
115.157 apply safe
115.158 apply (drule_tac x=0 in fun_cong, force)
115.159 apply (erule notE, rule ext,
115.160 drule_tac x="Suc x" in fun_cong, force)
115.161 apply (drule_tac x=0 in fun_cong, force)
115.162 apply (erule rev_mp)
115.163 - apply (induct_tac y rule: bin_induct [unfolded Pls_def Min_def])
115.164 + apply (induct_tac y rule: bin_induct)
115.165 apply safe
115.166 apply (drule_tac x=0 in fun_cong, force)
115.167 apply (erule notE, rule ext,
115.168 @@ -244,15 +216,9 @@
115.169 lemma bin_nth_1 [simp]: "bin_nth 1 n \<longleftrightarrow> n = 0"
115.170 by (cases n) simp_all
115.171
115.172 -lemma bin_nth_Pls [simp]: "~ bin_nth Int.Pls n"
115.173 - by (induct n) auto (* FIXME: delete *)
115.174 -
115.175 lemma bin_nth_minus1 [simp]: "bin_nth -1 n"
115.176 by (induct n) auto
115.177
115.178 -lemma bin_nth_Min [simp]: "bin_nth Int.Min n"
115.179 - by (induct n) auto (* FIXME: delete *)
115.180 -
115.181 lemma bin_nth_0_BIT: "bin_nth (w BIT b) 0 = (b = (1::bit))"
115.182 by auto
115.183
115.184 @@ -262,20 +228,20 @@
115.185 lemma bin_nth_minus [simp]: "0 < n ==> bin_nth (w BIT b) n = bin_nth w (n - 1)"
115.186 by (cases n) auto
115.187
115.188 -lemma bin_nth_minus_Bit0 [simp]:
115.189 - "0 < n ==> bin_nth (number_of (Int.Bit0 w)) n = bin_nth (number_of w) (n - 1)"
115.190 - using bin_nth_minus [where w="number_of w" and b="(0::bit)"] by simp
115.191 +lemma bin_nth_numeral:
115.192 + "bin_rest x = y \<Longrightarrow> bin_nth x (numeral n) = bin_nth y (numeral n - 1)"
115.193 + by (subst expand_Suc, simp only: bin_nth.simps)
115.194
115.195 -lemma bin_nth_minus_Bit1 [simp]:
115.196 - "0 < n ==> bin_nth (number_of (Int.Bit1 w)) n = bin_nth (number_of w) (n - 1)"
115.197 - using bin_nth_minus [where w="number_of w" and b="(1::bit)"] by simp
115.198 -
115.199 -lemmas bin_nth_0 = bin_nth.simps(1)
115.200 -lemmas bin_nth_Suc = bin_nth.simps(2)
115.201 +lemmas bin_nth_numeral_simps [simp] =
115.202 + bin_nth_numeral [OF bin_rest_numeral_simps(2)]
115.203 + bin_nth_numeral [OF bin_rest_numeral_simps(5)]
115.204 + bin_nth_numeral [OF bin_rest_numeral_simps(6)]
115.205 + bin_nth_numeral [OF bin_rest_numeral_simps(7)]
115.206 + bin_nth_numeral [OF bin_rest_numeral_simps(8)]
115.207
115.208 lemmas bin_nth_simps =
115.209 - bin_nth_0 bin_nth_Suc bin_nth_zero bin_nth_minus1 bin_nth_minus
115.210 - bin_nth_minus_Bit0 bin_nth_minus_Bit1
115.211 + bin_nth.Z bin_nth.Suc bin_nth_zero bin_nth_minus1
115.212 + bin_nth_numeral_simps
115.213
115.214
115.215 subsection {* Truncating binary integers *}
115.216 @@ -286,9 +252,8 @@
115.217 lemma bin_sign_simps [simp]:
115.218 "bin_sign 0 = 0"
115.219 "bin_sign 1 = 0"
115.220 - "bin_sign -1 = -1"
115.221 - "bin_sign (number_of (Int.Bit0 w)) = bin_sign (number_of w)"
115.222 - "bin_sign (number_of (Int.Bit1 w)) = bin_sign (number_of w)"
115.223 + "bin_sign (numeral k) = 0"
115.224 + "bin_sign (neg_numeral k) = -1"
115.225 "bin_sign (w BIT b) = bin_sign w"
115.226 unfolding bin_sign_def Bit_def bitval_def
115.227 by (simp_all split: bit.split)
115.228 @@ -309,17 +274,15 @@
115.229 by (induct n arbitrary: w) auto
115.230
115.231 lemma bintrunc_mod2p: "bintrunc n w = (w mod 2 ^ n)"
115.232 - apply (induct n arbitrary: w)
115.233 - apply simp
115.234 + apply (induct n arbitrary: w, clarsimp)
115.235 apply (simp add: bin_last_def bin_rest_def Bit_def zmod_zmult2_eq)
115.236 done
115.237
115.238 lemma sbintrunc_mod2p: "sbintrunc n w = (w + 2 ^ n) mod 2 ^ (Suc n) - 2 ^ n"
115.239 apply (induct n arbitrary: w)
115.240 - apply clarsimp
115.241 + apply simp
115.242 apply (subst mod_add_left_eq)
115.243 apply (simp add: bin_last_def)
115.244 - apply simp
115.245 apply (simp add: bin_last_def bin_rest_def Bit_def)
115.246 apply (clarsimp simp: mod_mult_mult1 [symmetric]
115.247 zmod_zdiv_equality [THEN diff_eq_eq [THEN iffD2 [THEN sym]]])
115.248 @@ -342,20 +305,32 @@
115.249 lemma bintrunc_Suc_numeral:
115.250 "bintrunc (Suc n) 1 = 1"
115.251 "bintrunc (Suc n) -1 = bintrunc n -1 BIT 1"
115.252 - "bintrunc (Suc n) (number_of (Int.Bit0 w)) = bintrunc n (number_of w) BIT 0"
115.253 - "bintrunc (Suc n) (number_of (Int.Bit1 w)) = bintrunc n (number_of w) BIT 1"
115.254 + "bintrunc (Suc n) (numeral (Num.Bit0 w)) = bintrunc n (numeral w) BIT 0"
115.255 + "bintrunc (Suc n) (numeral (Num.Bit1 w)) = bintrunc n (numeral w) BIT 1"
115.256 + "bintrunc (Suc n) (neg_numeral (Num.Bit0 w)) =
115.257 + bintrunc n (neg_numeral w) BIT 0"
115.258 + "bintrunc (Suc n) (neg_numeral (Num.Bit1 w)) =
115.259 + bintrunc n (neg_numeral (w + Num.One)) BIT 1"
115.260 by simp_all
115.261
115.262 lemma sbintrunc_0_numeral [simp]:
115.263 "sbintrunc 0 1 = -1"
115.264 - "sbintrunc 0 (number_of (Int.Bit0 w)) = 0"
115.265 - "sbintrunc 0 (number_of (Int.Bit1 w)) = -1"
115.266 + "sbintrunc 0 (numeral (Num.Bit0 w)) = 0"
115.267 + "sbintrunc 0 (numeral (Num.Bit1 w)) = -1"
115.268 + "sbintrunc 0 (neg_numeral (Num.Bit0 w)) = 0"
115.269 + "sbintrunc 0 (neg_numeral (Num.Bit1 w)) = -1"
115.270 by simp_all
115.271
115.272 lemma sbintrunc_Suc_numeral:
115.273 "sbintrunc (Suc n) 1 = 1"
115.274 - "sbintrunc (Suc n) (number_of (Int.Bit0 w)) = sbintrunc n (number_of w) BIT 0"
115.275 - "sbintrunc (Suc n) (number_of (Int.Bit1 w)) = sbintrunc n (number_of w) BIT 1"
115.276 + "sbintrunc (Suc n) (numeral (Num.Bit0 w)) =
115.277 + sbintrunc n (numeral w) BIT 0"
115.278 + "sbintrunc (Suc n) (numeral (Num.Bit1 w)) =
115.279 + sbintrunc n (numeral w) BIT 1"
115.280 + "sbintrunc (Suc n) (neg_numeral (Num.Bit0 w)) =
115.281 + sbintrunc n (neg_numeral w) BIT 0"
115.282 + "sbintrunc (Suc n) (neg_numeral (Num.Bit1 w)) =
115.283 + sbintrunc n (neg_numeral (w + Num.One)) BIT 1"
115.284 by simp_all
115.285
115.286 lemma bit_bool:
115.287 @@ -366,7 +341,7 @@
115.288
115.289 lemma bin_sign_lem: "(bin_sign (sbintrunc n bin) = -1) = bin_nth bin n"
115.290 apply (induct n arbitrary: bin)
115.291 - apply (case_tac bin rule: bin_exhaust, case_tac b, auto)+
115.292 + apply (case_tac bin rule: bin_exhaust, case_tac b, auto)
115.293 done
115.294
115.295 lemma nth_bintr: "bin_nth (bintrunc m w) n = (n < m & bin_nth w n)"
115.296 @@ -388,14 +363,14 @@
115.297 by (cases n) auto
115.298
115.299 lemma bin_nth_Bit0:
115.300 - "bin_nth (number_of (Int.Bit0 w)) n \<longleftrightarrow>
115.301 - (\<exists>m. n = Suc m \<and> bin_nth (number_of w) m)"
115.302 - using bin_nth_Bit [where w="number_of w" and b="(0::bit)"] by simp
115.303 + "bin_nth (numeral (Num.Bit0 w)) n \<longleftrightarrow>
115.304 + (\<exists>m. n = Suc m \<and> bin_nth (numeral w) m)"
115.305 + using bin_nth_Bit [where w="numeral w" and b="(0::bit)"] by simp
115.306
115.307 lemma bin_nth_Bit1:
115.308 - "bin_nth (number_of (Int.Bit1 w)) n \<longleftrightarrow>
115.309 - n = 0 \<or> (\<exists>m. n = Suc m \<and> bin_nth (number_of w) m)"
115.310 - using bin_nth_Bit [where w="number_of w" and b="(1::bit)"] by simp
115.311 + "bin_nth (numeral (Num.Bit1 w)) n \<longleftrightarrow>
115.312 + n = 0 \<or> (\<exists>m. n = Suc m \<and> bin_nth (numeral w) m)"
115.313 + using bin_nth_Bit [where w="numeral w" and b="(1::bit)"] by simp
115.314
115.315 lemma bintrunc_bintrunc_l:
115.316 "n <= m ==> (bintrunc m (bintrunc n w) = bintrunc n w)"
115.317 @@ -422,72 +397,47 @@
115.318 done
115.319
115.320 lemmas bintrunc_Pls =
115.321 - bintrunc.Suc [where bin="Int.Pls", simplified bin_last_simps bin_rest_simps]
115.322 + bintrunc.Suc [where bin="0", simplified bin_last_numeral_simps bin_rest_numeral_simps]
115.323
115.324 lemmas bintrunc_Min [simp] =
115.325 - bintrunc.Suc [where bin="Int.Min", simplified bin_last_simps bin_rest_simps]
115.326 + bintrunc.Suc [where bin="-1", simplified bin_last_numeral_simps bin_rest_numeral_simps]
115.327
115.328 lemmas bintrunc_BIT [simp] =
115.329 bintrunc.Suc [where bin="w BIT b", simplified bin_last_BIT bin_rest_BIT] for w b
115.330
115.331 -lemma bintrunc_Bit0 [simp]:
115.332 - "bintrunc (Suc n) (Int.Bit0 w) = Int.Bit0 (bintrunc n w)"
115.333 - using bintrunc_BIT [where b="(0::bit)"] by (simp add: BIT_simps)
115.334 -
115.335 -lemma bintrunc_Bit1 [simp]:
115.336 - "bintrunc (Suc n) (Int.Bit1 w) = Int.Bit1 (bintrunc n w)"
115.337 - using bintrunc_BIT [where b="(1::bit)"] by (simp add: BIT_simps)
115.338 -
115.339 lemmas bintrunc_Sucs = bintrunc_Pls bintrunc_Min bintrunc_BIT
115.340 - bintrunc_Bit0 bintrunc_Bit1
115.341 bintrunc_Suc_numeral
115.342
115.343 lemmas sbintrunc_Suc_Pls =
115.344 - sbintrunc.Suc [where bin="Int.Pls", simplified bin_last_simps bin_rest_simps]
115.345 + sbintrunc.Suc [where bin="0", simplified bin_last_numeral_simps bin_rest_numeral_simps]
115.346
115.347 lemmas sbintrunc_Suc_Min =
115.348 - sbintrunc.Suc [where bin="Int.Min", simplified bin_last_simps bin_rest_simps]
115.349 + sbintrunc.Suc [where bin="-1", simplified bin_last_numeral_simps bin_rest_numeral_simps]
115.350
115.351 lemmas sbintrunc_Suc_BIT [simp] =
115.352 sbintrunc.Suc [where bin="w BIT b", simplified bin_last_BIT bin_rest_BIT] for w b
115.353
115.354 -lemma sbintrunc_Suc_Bit0 [simp]:
115.355 - "sbintrunc (Suc n) (Int.Bit0 w) = Int.Bit0 (sbintrunc n w)"
115.356 - using sbintrunc_Suc_BIT [where b="(0::bit)"] by (simp add: BIT_simps)
115.357 -
115.358 -lemma sbintrunc_Suc_Bit1 [simp]:
115.359 - "sbintrunc (Suc n) (Int.Bit1 w) = Int.Bit1 (sbintrunc n w)"
115.360 - using sbintrunc_Suc_BIT [where b="(1::bit)"] by (simp add: BIT_simps)
115.361 -
115.362 lemmas sbintrunc_Sucs = sbintrunc_Suc_Pls sbintrunc_Suc_Min sbintrunc_Suc_BIT
115.363 - sbintrunc_Suc_Bit0 sbintrunc_Suc_Bit1
115.364 sbintrunc_Suc_numeral
115.365
115.366 lemmas sbintrunc_Pls =
115.367 - sbintrunc.Z [where bin="Int.Pls",
115.368 - simplified bin_last_simps bin_rest_simps bit.simps]
115.369 + sbintrunc.Z [where bin="0",
115.370 + simplified bin_last_numeral_simps bin_rest_numeral_simps bit.simps]
115.371
115.372 lemmas sbintrunc_Min =
115.373 - sbintrunc.Z [where bin="Int.Min",
115.374 - simplified bin_last_simps bin_rest_simps bit.simps]
115.375 + sbintrunc.Z [where bin="-1",
115.376 + simplified bin_last_numeral_simps bin_rest_numeral_simps bit.simps]
115.377
115.378 lemmas sbintrunc_0_BIT_B0 [simp] =
115.379 sbintrunc.Z [where bin="w BIT (0::bit)",
115.380 - simplified bin_last_simps bin_rest_simps bit.simps] for w
115.381 + simplified bin_last_numeral_simps bin_rest_numeral_simps bit.simps] for w
115.382
115.383 lemmas sbintrunc_0_BIT_B1 [simp] =
115.384 sbintrunc.Z [where bin="w BIT (1::bit)",
115.385 - simplified bin_last_simps bin_rest_simps bit.simps] for w
115.386 -
115.387 -lemma sbintrunc_0_Bit0 [simp]: "sbintrunc 0 (Int.Bit0 w) = 0"
115.388 - using sbintrunc_0_BIT_B0 by simp
115.389 -
115.390 -lemma sbintrunc_0_Bit1 [simp]: "sbintrunc 0 (Int.Bit1 w) = -1"
115.391 - using sbintrunc_0_BIT_B1 by simp
115.392 + simplified bin_last_BIT bin_rest_numeral_simps bit.simps] for w
115.393
115.394 lemmas sbintrunc_0_simps =
115.395 sbintrunc_Pls sbintrunc_Min sbintrunc_0_BIT_B0 sbintrunc_0_BIT_B1
115.396 - sbintrunc_0_Bit0 sbintrunc_0_Bit1
115.397
115.398 lemmas bintrunc_simps = bintrunc.Z bintrunc_Sucs
115.399 lemmas sbintrunc_simps = sbintrunc_0_simps sbintrunc_Sucs
115.400 @@ -505,15 +455,6 @@
115.401 lemmas sbintrunc_minus_simps =
115.402 sbintrunc_Sucs [THEN [2] sbintrunc_minus [symmetric, THEN trans]]
115.403
115.404 -lemma bintrunc_n_Pls [simp]:
115.405 - "bintrunc n Int.Pls = Int.Pls"
115.406 - unfolding Pls_def by simp
115.407 -
115.408 -lemma sbintrunc_n_PM [simp]:
115.409 - "sbintrunc n Int.Pls = Int.Pls"
115.410 - "sbintrunc n Int.Min = Int.Min"
115.411 - unfolding Pls_def Min_def by simp_all
115.412 -
115.413 lemmas thobini1 = arg_cong [where f = "%w. w BIT b"] for b
115.414
115.415 lemmas bintrunc_BIT_I = trans [OF bintrunc_BIT thobini1]
115.416 @@ -600,15 +541,39 @@
115.417 lemmas nat_non0_gr =
115.418 trans [OF iszero_def [THEN Not_eq_iff [THEN iffD2]] refl]
115.419
115.420 -lemmas bintrunc_pred_simps [simp] =
115.421 - bintrunc_minus_simps [of "number_of bin", simplified nobm1] for bin
115.422 +lemma bintrunc_numeral:
115.423 + "bintrunc (numeral k) x =
115.424 + bintrunc (numeral k - 1) (bin_rest x) BIT bin_last x"
115.425 + by (subst expand_Suc, rule bintrunc.simps)
115.426
115.427 -lemmas sbintrunc_pred_simps [simp] =
115.428 - sbintrunc_minus_simps [of "number_of bin", simplified nobm1] for bin
115.429 +lemma sbintrunc_numeral:
115.430 + "sbintrunc (numeral k) x =
115.431 + sbintrunc (numeral k - 1) (bin_rest x) BIT bin_last x"
115.432 + by (subst expand_Suc, rule sbintrunc.simps)
115.433
115.434 -lemma no_bintr_alt:
115.435 - "number_of (bintrunc n w) = w mod 2 ^ n"
115.436 - by (simp add: number_of_eq bintrunc_mod2p)
115.437 +lemma bintrunc_numeral_simps [simp]:
115.438 + "bintrunc (numeral k) (numeral (Num.Bit0 w)) =
115.439 + bintrunc (numeral k - 1) (numeral w) BIT 0"
115.440 + "bintrunc (numeral k) (numeral (Num.Bit1 w)) =
115.441 + bintrunc (numeral k - 1) (numeral w) BIT 1"
115.442 + "bintrunc (numeral k) (neg_numeral (Num.Bit0 w)) =
115.443 + bintrunc (numeral k - 1) (neg_numeral w) BIT 0"
115.444 + "bintrunc (numeral k) (neg_numeral (Num.Bit1 w)) =
115.445 + bintrunc (numeral k - 1) (neg_numeral (w + Num.One)) BIT 1"
115.446 + "bintrunc (numeral k) 1 = 1"
115.447 + by (simp_all add: bintrunc_numeral)
115.448 +
115.449 +lemma sbintrunc_numeral_simps [simp]:
115.450 + "sbintrunc (numeral k) (numeral (Num.Bit0 w)) =
115.451 + sbintrunc (numeral k - 1) (numeral w) BIT 0"
115.452 + "sbintrunc (numeral k) (numeral (Num.Bit1 w)) =
115.453 + sbintrunc (numeral k - 1) (numeral w) BIT 1"
115.454 + "sbintrunc (numeral k) (neg_numeral (Num.Bit0 w)) =
115.455 + sbintrunc (numeral k - 1) (neg_numeral w) BIT 0"
115.456 + "sbintrunc (numeral k) (neg_numeral (Num.Bit1 w)) =
115.457 + sbintrunc (numeral k - 1) (neg_numeral (w + Num.One)) BIT 1"
115.458 + "sbintrunc (numeral k) 1 = 1"
115.459 + by (simp_all add: sbintrunc_numeral)
115.460
115.461 lemma no_bintr_alt1: "bintrunc n = (%w. w mod 2 ^ n :: int)"
115.462 by (rule ext) (rule bintrunc_mod2p)
115.463 @@ -620,19 +585,10 @@
115.464 apply (auto intro: int_mod_lem [THEN iffD1, symmetric])
115.465 done
115.466
115.467 -lemma no_bintr:
115.468 - "number_of (bintrunc n w) = (number_of w mod 2 ^ n :: int)"
115.469 - by (simp add : bintrunc_mod2p number_of_eq)
115.470 -
115.471 lemma no_sbintr_alt2:
115.472 "sbintrunc n = (%w. (w + 2 ^ n) mod 2 ^ Suc n - 2 ^ n :: int)"
115.473 by (rule ext) (simp add : sbintrunc_mod2p)
115.474
115.475 -lemma no_sbintr:
115.476 - "number_of (sbintrunc n w) =
115.477 - ((number_of w + 2 ^ n) mod 2 ^ Suc n - 2 ^ n :: int)"
115.478 - by (simp add : no_sbintr_alt2 number_of_eq)
115.479 -
115.480 lemma range_sbintrunc:
115.481 "range (sbintrunc n) = {i. - (2 ^ n) <= i & i < 2 ^ n}"
115.482 apply (unfold no_sbintr_alt2)
115.483 @@ -692,21 +648,20 @@
115.484
115.485 lemmas m2pths = pos_mod_sign pos_mod_bound [OF zless2p]
115.486
115.487 -lemma bintr_ge0: "(0 :: int) <= number_of (bintrunc n w)"
115.488 - by (simp add : no_bintr m2pths)
115.489 +lemma bintr_ge0: "0 \<le> bintrunc n w"
115.490 + by (simp add: bintrunc_mod2p)
115.491
115.492 -lemma bintr_lt2p: "number_of (bintrunc n w) < (2 ^ n :: int)"
115.493 - by (simp add : no_bintr m2pths)
115.494 +lemma bintr_lt2p: "bintrunc n w < 2 ^ n"
115.495 + by (simp add: bintrunc_mod2p)
115.496
115.497 -lemma bintr_Min:
115.498 - "number_of (bintrunc n Int.Min) = (2 ^ n :: int) - 1"
115.499 - by (simp add : no_bintr m1mod2k)
115.500 +lemma bintr_Min: "bintrunc n -1 = 2 ^ n - 1"
115.501 + by (simp add: bintrunc_mod2p m1mod2k)
115.502
115.503 -lemma sbintr_ge: "(- (2 ^ n) :: int) <= number_of (sbintrunc n w)"
115.504 - by (simp add : no_sbintr m2pths)
115.505 +lemma sbintr_ge: "- (2 ^ n) \<le> sbintrunc n w"
115.506 + by (simp add: sbintrunc_mod2p)
115.507
115.508 -lemma sbintr_lt: "number_of (sbintrunc n w) < (2 ^ n :: int)"
115.509 - by (simp add : no_sbintr m2pths)
115.510 +lemma sbintr_lt: "sbintrunc n w < 2 ^ n"
115.511 + by (simp add: sbintrunc_mod2p)
115.512
115.513 lemma sign_Pls_ge_0:
115.514 "(bin_sign bin = 0) = (bin >= (0 :: int))"
115.515 @@ -716,8 +671,6 @@
115.516 "(bin_sign bin = -1) = (bin < (0 :: int))"
115.517 unfolding bin_sign_def by simp
115.518
115.519 -lemmas sign_Min_neg = trans [OF sign_Min_lt_0 neg_def [symmetric]]
115.520 -
115.521 lemma bin_rest_trunc:
115.522 "(bin_rest (bintrunc n bin)) = bintrunc (n - 1) (bin_rest bin)"
115.523 by (induct n arbitrary: bin) auto
115.524 @@ -789,7 +742,7 @@
115.525 lemma [code]:
115.526 "bin_split (Suc n) w = (let (w1, w2) = bin_split n (bin_rest w) in (w1, w2 BIT bin_last w))"
115.527 "bin_split 0 w = (w, 0)"
115.528 - by (simp_all add: Pls_def)
115.529 + by simp_all
115.530
115.531 primrec bin_cat :: "int \<Rightarrow> nat \<Rightarrow> int \<Rightarrow> int" where
115.532 Z: "bin_cat w 0 v = w"
115.533 @@ -801,24 +754,17 @@
115.534 "0 < n \<Longrightarrow> f ^^ n = f \<circ> f ^^ (n - 1)"
115.535 by (cases n) simp_all
115.536
115.537 -lemmas funpow_pred_simp [simp] =
115.538 - funpow_minus_simp [of "number_of bin", simplified nobm1] for bin
115.539 +lemma funpow_numeral [simp]:
115.540 + "f ^^ numeral k = f \<circ> f ^^ (numeral k - 1)"
115.541 + by (subst expand_Suc, rule funpow.simps)
115.542
115.543 -lemmas replicate_minus_simp =
115.544 - trans [OF gen_minus [where f = "%n. replicate n x"] replicate.replicate_Suc] for x
115.545 -
115.546 -lemmas replicate_pred_simp [simp] =
115.547 - replicate_minus_simp [of "number_of bin", simplified nobm1] for bin
115.548 -
115.549 -lemmas power_Suc_no [simp] = power_Suc [of "number_of a"] for a
115.550 +lemma replicate_numeral [simp]: (* TODO: move to List.thy *)
115.551 + "replicate (numeral k) x = x # replicate (numeral k - 1) x"
115.552 + by (subst expand_Suc, rule replicate_Suc)
115.553
115.554 lemmas power_minus_simp =
115.555 trans [OF gen_minus [where f = "power f"] power_Suc] for f
115.556
115.557 -lemmas power_pred_simp =
115.558 - power_minus_simp [of "number_of bin", simplified nobm1] for bin
115.559 -lemmas power_pred_simp_no [simp] = power_pred_simp [where f= "number_of f"] for f
115.560 -
115.561 lemma list_exhaust_size_gt0:
115.562 assumes y: "\<And>a list. y = a # list \<Longrightarrow> P"
115.563 shows "0 < length y \<Longrightarrow> P"
115.564 @@ -839,11 +785,6 @@
115.565 "y = xa # list ==> size y = Suc k ==> size list = k"
115.566 by auto
115.567
115.568 -lemma size_Cons_lem_eq_bin:
115.569 - "y = xa # list ==> size y = number_of (Int.succ k) ==>
115.570 - size list = number_of k"
115.571 - by (auto simp: pred_def succ_def split add : split_if_asm)
115.572 -
115.573 lemmas ls_splits = prod.split prod.split_asm split_if_asm
115.574
115.575 lemma not_B1_is_B0: "y \<noteq> (1::bit) \<Longrightarrow> y = (0::bit)"
116.1 --- a/src/HOL/Word/Bool_List_Representation.thy Mon Mar 26 15:32:54 2012 +0200
116.2 +++ b/src/HOL/Word/Bool_List_Representation.thy Mon Mar 26 15:33:28 2012 +0200
116.3 @@ -106,13 +106,13 @@
116.4 by (cases n) auto
116.5
116.6 lemma bin_to_bl_aux_Bit0_minus_simp [simp]:
116.7 - "0 < n ==> bin_to_bl_aux n (number_of (Int.Bit0 w)) bl =
116.8 - bin_to_bl_aux (n - 1) (number_of w) (False # bl)"
116.9 + "0 < n ==> bin_to_bl_aux n (numeral (Num.Bit0 w)) bl =
116.10 + bin_to_bl_aux (n - 1) (numeral w) (False # bl)"
116.11 by (cases n) auto
116.12
116.13 lemma bin_to_bl_aux_Bit1_minus_simp [simp]:
116.14 - "0 < n ==> bin_to_bl_aux n (number_of (Int.Bit1 w)) bl =
116.15 - bin_to_bl_aux (n - 1) (number_of w) (True # bl)"
116.16 + "0 < n ==> bin_to_bl_aux n (numeral (Num.Bit1 w)) bl =
116.17 + bin_to_bl_aux (n - 1) (numeral w) (True # bl)"
116.18 by (cases n) auto
116.19
116.20 text {* Link between bin and bool list. *}
116.21 @@ -632,8 +632,13 @@
116.22 lemmas takefill_minus_simps = takefill_Suc_cases [THEN [2]
116.23 takefill_minus [symmetric, THEN trans]]
116.24
116.25 -lemmas takefill_pred_simps [simp] =
116.26 - takefill_minus_simps [where n="number_of bin", simplified nobm1] for bin
116.27 +lemma takefill_numeral_Nil [simp]:
116.28 + "takefill fill (numeral k) [] = fill # takefill fill (numeral k - 1) []"
116.29 + by (subst expand_Suc, rule takefill_Suc_Nil)
116.30 +
116.31 +lemma takefill_numeral_Cons [simp]:
116.32 + "takefill fill (numeral k) (x # xs) = x # takefill fill (numeral k - 1) xs"
116.33 + by (subst expand_Suc, rule takefill_Suc_Cons)
116.34
116.35 (* links with function bl_to_bin *)
116.36
116.37 @@ -1031,11 +1036,11 @@
116.38 bin_split.Suc [THEN [2] bin_split_minus [symmetric, THEN trans]]
116.39
116.40 lemma bin_split_pred_simp [simp]:
116.41 - "(0::nat) < number_of bin \<Longrightarrow>
116.42 - bin_split (number_of bin) w =
116.43 - (let (w1, w2) = bin_split (number_of (Int.pred bin)) (bin_rest w)
116.44 + "(0::nat) < numeral bin \<Longrightarrow>
116.45 + bin_split (numeral bin) w =
116.46 + (let (w1, w2) = bin_split (numeral bin - 1) (bin_rest w)
116.47 in (w1, w2 BIT bin_last w))"
116.48 - by (simp only: nobm1 bin_split_minus_simp)
116.49 + by (simp only: bin_split_minus_simp)
116.50
116.51 lemma bin_rsplit_aux_simp_alt:
116.52 "bin_rsplit_aux n m c bs =
117.1 --- a/src/HOL/Word/Misc_Numeric.thy Mon Mar 26 15:32:54 2012 +0200
117.2 +++ b/src/HOL/Word/Misc_Numeric.thy Mon Mar 26 15:33:28 2012 +0200
117.3 @@ -5,7 +5,7 @@
117.4 header {* Useful Numerical Lemmas *}
117.5
117.6 theory Misc_Numeric
117.7 -imports Main Parity
117.8 +imports "~~/src/HOL/Main" "~~/src/HOL/Parity"
117.9 begin
117.10
117.11 lemma the_elemI: "y = {x} ==> the_elem y = x"
117.12 @@ -31,13 +31,6 @@
117.13
117.14 lemma sum_imp_diff: "j = k + i ==> j - i = (k :: nat)" by arith
117.15
117.16 -lemma nobm1:
117.17 - "0 < (number_of w :: nat) ==>
117.18 - number_of w - (1 :: nat) = number_of (Int.pred w)"
117.19 - apply (unfold nat_number_of_def One_nat_def nat_1 [symmetric] pred_def)
117.20 - apply (simp add: number_of_eq nat_diff_distrib [symmetric])
117.21 - done
117.22 -
117.23 lemma zless2: "0 < (2 :: int)" by arith
117.24
117.25 lemmas zless2p [simp] = zless2 [THEN zero_less_power]
117.26 @@ -46,7 +39,6 @@
117.27 lemmas pos_mod_sign2 = zless2 [THEN pos_mod_sign [where b = "2::int"]]
117.28 lemmas pos_mod_bound2 = zless2 [THEN pos_mod_bound [where b = "2::int"]]
117.29
117.30 --- "the inverse(s) of @{text number_of}"
117.31 lemma nmod2: "n mod (2::int) = 0 | n mod 2 = 1" by arith
117.32
117.33 lemma emep1:
117.34 @@ -283,15 +275,6 @@
117.35
117.36 lemmas min_minus' [simp] = trans [OF min_max.inf_commute min_minus]
117.37
117.38 -lemma nat_no_eq_iff:
117.39 - "(number_of b :: int) >= 0 ==> (number_of c :: int) >= 0 ==>
117.40 - (number_of b = (number_of c :: nat)) = (b = c)"
117.41 - apply (unfold nat_number_of_def)
117.42 - apply safe
117.43 - apply (drule (2) eq_nat_nat_iff [THEN iffD1])
117.44 - apply (simp add: number_of_eq)
117.45 - done
117.46 -
117.47 lemmas dme = box_equals [OF div_mod_equality add_0_right add_0_right]
117.48 lemmas dtle = xtr3 [OF dme [symmetric] le_add1]
117.49 lemmas th2 = order_trans [OF order_refl [THEN [2] mult_le_mono] dtle]
118.1 --- a/src/HOL/Word/Word.thy Mon Mar 26 15:32:54 2012 +0200
118.2 +++ b/src/HOL/Word/Word.thy Mon Mar 26 15:33:28 2012 +0200
118.3 @@ -20,17 +20,64 @@
118.4 typedef (open) 'a word = "{(0::int) ..< 2^len_of TYPE('a::len0)}"
118.5 morphisms uint Abs_word by auto
118.6
118.7 +lemma uint_nonnegative:
118.8 + "0 \<le> uint w"
118.9 + using word.uint [of w] by simp
118.10 +
118.11 +lemma uint_bounded:
118.12 + fixes w :: "'a::len0 word"
118.13 + shows "uint w < 2 ^ len_of TYPE('a)"
118.14 + using word.uint [of w] by simp
118.15 +
118.16 +lemma uint_idem:
118.17 + fixes w :: "'a::len0 word"
118.18 + shows "uint w mod 2 ^ len_of TYPE('a) = uint w"
118.19 + using uint_nonnegative uint_bounded by (rule mod_pos_pos_trivial)
118.20 +
118.21 definition word_of_int :: "int \<Rightarrow> 'a\<Colon>len0 word" where
118.22 -- {* representation of words using unsigned or signed bins,
118.23 only difference in these is the type class *}
118.24 - "word_of_int w = Abs_word (bintrunc (len_of TYPE ('a)) w)"
118.25 -
118.26 -lemma uint_word_of_int [code]: "uint (word_of_int w \<Colon> 'a\<Colon>len0 word) = w mod 2 ^ len_of TYPE('a)"
118.27 - by (auto simp add: word_of_int_def bintrunc_mod2p intro: Abs_word_inverse)
118.28 -
118.29 -code_datatype word_of_int
118.30 -
118.31 -subsection {* Random instance *}
118.32 + "word_of_int k = Abs_word (k mod 2 ^ len_of TYPE('a))"
118.33 +
118.34 +lemma uint_word_of_int:
118.35 + "uint (word_of_int k :: 'a::len0 word) = k mod 2 ^ len_of TYPE('a)"
118.36 + by (auto simp add: word_of_int_def intro: Abs_word_inverse)
118.37 +
118.38 +lemma word_of_int_uint:
118.39 + "word_of_int (uint w) = w"
118.40 + by (simp add: word_of_int_def uint_idem uint_inverse)
118.41 +
118.42 +lemma word_uint_eq_iff:
118.43 + "a = b \<longleftrightarrow> uint a = uint b"
118.44 + by (simp add: uint_inject)
118.45 +
118.46 +lemma word_uint_eqI:
118.47 + "uint a = uint b \<Longrightarrow> a = b"
118.48 + by (simp add: word_uint_eq_iff)
118.49 +
118.50 +
118.51 +subsection {* Basic code generation setup *}
118.52 +
118.53 +definition Word :: "int \<Rightarrow> 'a::len0 word"
118.54 +where
118.55 + [code_post]: "Word = word_of_int"
118.56 +
118.57 +lemma [code abstype]:
118.58 + "Word (uint w) = w"
118.59 + by (simp add: Word_def word_of_int_uint)
118.60 +
118.61 +declare uint_word_of_int [code abstract]
118.62 +
118.63 +instantiation word :: (len0) equal
118.64 +begin
118.65 +
118.66 +definition equal_word :: "'a word \<Rightarrow> 'a word \<Rightarrow> bool" where
118.67 + "equal_word k l \<longleftrightarrow> HOL.equal (uint k) (uint l)"
118.68 +
118.69 +instance proof
118.70 +qed (simp add: equal equal_word_def word_uint_eq_iff)
118.71 +
118.72 +end
118.73
118.74 notation fcomp (infixl "\<circ>>" 60)
118.75 notation scomp (infixl "\<circ>\<rightarrow>" 60)
118.76 @@ -39,7 +86,7 @@
118.77 begin
118.78
118.79 definition
118.80 - "random_word i = Random.range (max i (2 ^ len_of TYPE('a))) \<circ>\<rightarrow> (\<lambda>k. Pair (
118.81 + "random_word i = Random.range i \<circ>\<rightarrow> (\<lambda>k. Pair (
118.82 let j = word_of_int (Code_Numeral.int_of k) :: 'a word
118.83 in (j, \<lambda>_::unit. Code_Evaluation.term_of j)))"
118.84
118.85 @@ -193,7 +240,7 @@
118.86 where
118.87 "word_pred a = word_of_int (uint a - 1)"
118.88
118.89 -instantiation word :: (len0) "{number, Divides.div, comm_monoid_mult, comm_ring}"
118.90 +instantiation word :: (len0) "{neg_numeral, Divides.div, comm_monoid_mult, comm_ring}"
118.91 begin
118.92
118.93 definition
118.94 @@ -220,9 +267,6 @@
118.95 definition
118.96 word_mod_def: "a mod b = word_of_int (uint a mod uint b)"
118.97
118.98 -definition
118.99 - word_number_of_def: "number_of w = word_of_int w"
118.100 -
118.101 lemmas word_arith_wis =
118.102 word_add_def word_sub_wi word_mult_def word_minus_def
118.103 word_succ_def word_pred_def word_0_wi word_1_wi
118.104 @@ -268,9 +312,6 @@
118.105 apply (simp add: word_of_nat wi_hom_sub)
118.106 done
118.107
118.108 -instance word :: (len) number_ring
118.109 - by (default, simp add: word_number_of_def word_of_int)
118.110 -
118.111 definition udvd :: "'a::len word => 'a::len word => bool" (infixl "udvd" 50) where
118.112 "a udvd b = (EX n>=0. uint b = n * uint a)"
118.113
118.114 @@ -284,7 +325,7 @@
118.115 word_le_def: "a \<le> b \<longleftrightarrow> uint a \<le> uint b"
118.116
118.117 definition
118.118 - word_less_def: "x < y \<longleftrightarrow> x \<le> y \<and> x \<noteq> (y \<Colon> 'a word)"
118.119 + word_less_def: "a < b \<longleftrightarrow> uint a < uint b"
118.120
118.121 instance
118.122 by default (auto simp: word_less_def word_le_def)
118.123 @@ -504,40 +545,55 @@
118.124
118.125 lemmas td_sint = word_sint.td
118.126
118.127 -lemma word_number_of_alt:
118.128 - "number_of b = word_of_int (number_of b)"
118.129 - by (simp add: number_of_eq word_number_of_def)
118.130 -
118.131 -declare word_number_of_alt [symmetric, code_abbrev]
118.132 -
118.133 -lemma word_no_wi: "number_of = word_of_int"
118.134 - by (auto simp: word_number_of_def)
118.135 -
118.136 lemma to_bl_def':
118.137 "(to_bl :: 'a :: len0 word => bool list) =
118.138 bin_to_bl (len_of TYPE('a)) o uint"
118.139 by (auto simp: to_bl_def)
118.140
118.141 -lemmas word_reverse_no_def [simp] = word_reverse_def [of "number_of w"] for w
118.142 +lemmas word_reverse_no_def [simp] = word_reverse_def [of "numeral w"] for w
118.143
118.144 lemma uints_mod: "uints n = range (\<lambda>w. w mod 2 ^ n)"
118.145 by (fact uints_def [unfolded no_bintr_alt1])
118.146
118.147 +lemma word_numeral_alt:
118.148 + "numeral b = word_of_int (numeral b)"
118.149 + by (induct b, simp_all only: numeral.simps word_of_int_homs)
118.150 +
118.151 +declare word_numeral_alt [symmetric, code_abbrev]
118.152 +
118.153 +lemma word_neg_numeral_alt:
118.154 + "neg_numeral b = word_of_int (neg_numeral b)"
118.155 + by (simp only: neg_numeral_def word_numeral_alt wi_hom_neg)
118.156 +
118.157 +declare word_neg_numeral_alt [symmetric, code_abbrev]
118.158 +
118.159 lemma uint_bintrunc [simp]:
118.160 - "uint (number_of bin :: 'a word) =
118.161 - bintrunc (len_of TYPE ('a :: len0)) (number_of bin)"
118.162 - unfolding word_number_of_alt by (rule word_ubin.eq_norm)
118.163 + "uint (numeral bin :: 'a word) =
118.164 + bintrunc (len_of TYPE ('a :: len0)) (numeral bin)"
118.165 + unfolding word_numeral_alt by (rule word_ubin.eq_norm)
118.166 +
118.167 +lemma uint_bintrunc_neg [simp]: "uint (neg_numeral bin :: 'a word) =
118.168 + bintrunc (len_of TYPE ('a :: len0)) (neg_numeral bin)"
118.169 + by (simp only: word_neg_numeral_alt word_ubin.eq_norm)
118.170
118.171 lemma sint_sbintrunc [simp]:
118.172 - "sint (number_of bin :: 'a word) =
118.173 - sbintrunc (len_of TYPE ('a :: len) - 1) (number_of bin)"
118.174 - unfolding word_number_of_alt by (rule word_sbin.eq_norm)
118.175 + "sint (numeral bin :: 'a word) =
118.176 + sbintrunc (len_of TYPE ('a :: len) - 1) (numeral bin)"
118.177 + by (simp only: word_numeral_alt word_sbin.eq_norm)
118.178 +
118.179 +lemma sint_sbintrunc_neg [simp]: "sint (neg_numeral bin :: 'a word) =
118.180 + sbintrunc (len_of TYPE ('a :: len) - 1) (neg_numeral bin)"
118.181 + by (simp only: word_neg_numeral_alt word_sbin.eq_norm)
118.182
118.183 lemma unat_bintrunc [simp]:
118.184 - "unat (number_of bin :: 'a :: len0 word) =
118.185 - nat (bintrunc (len_of TYPE('a)) (number_of bin))"
118.186 - unfolding unat_def nat_number_of_def
118.187 - by (simp only: uint_bintrunc)
118.188 + "unat (numeral bin :: 'a :: len0 word) =
118.189 + nat (bintrunc (len_of TYPE('a)) (numeral bin))"
118.190 + by (simp only: unat_def uint_bintrunc)
118.191 +
118.192 +lemma unat_bintrunc_neg [simp]:
118.193 + "unat (neg_numeral bin :: 'a :: len0 word) =
118.194 + nat (bintrunc (len_of TYPE('a)) (neg_numeral bin))"
118.195 + by (simp only: unat_def uint_bintrunc_neg)
118.196
118.197 lemma size_0_eq: "size (w :: 'a :: len0 word) = 0 \<Longrightarrow> v = w"
118.198 apply (unfold word_size)
118.199 @@ -562,7 +618,7 @@
118.200
118.201 lemma sign_uint_Pls [simp]:
118.202 "bin_sign (uint x) = 0"
118.203 - by (simp add: sign_Pls_ge_0 number_of_eq)
118.204 + by (simp add: sign_Pls_ge_0)
118.205
118.206 lemma uint_m2p_neg: "uint (x::'a::len0 word) - 2 ^ len_of TYPE('a) < 0"
118.207 by (simp only: diff_less_0_iff_less uint_lt2p)
118.208 @@ -581,35 +637,43 @@
118.209 lemma uint_nat: "uint w = int (unat w)"
118.210 unfolding unat_def by auto
118.211
118.212 -lemma uint_number_of:
118.213 - "uint (number_of b :: 'a :: len0 word) = number_of b mod 2 ^ len_of TYPE('a)"
118.214 - unfolding word_number_of_alt
118.215 +lemma uint_numeral:
118.216 + "uint (numeral b :: 'a :: len0 word) = numeral b mod 2 ^ len_of TYPE('a)"
118.217 + unfolding word_numeral_alt
118.218 by (simp only: int_word_uint)
118.219
118.220 -lemma unat_number_of:
118.221 - "bin_sign (number_of b) = 0 \<Longrightarrow>
118.222 - unat (number_of b::'a::len0 word) = number_of b mod 2 ^ len_of TYPE ('a)"
118.223 +lemma uint_neg_numeral:
118.224 + "uint (neg_numeral b :: 'a :: len0 word) = neg_numeral b mod 2 ^ len_of TYPE('a)"
118.225 + unfolding word_neg_numeral_alt
118.226 + by (simp only: int_word_uint)
118.227 +
118.228 +lemma unat_numeral:
118.229 + "unat (numeral b::'a::len0 word) = numeral b mod 2 ^ len_of TYPE ('a)"
118.230 apply (unfold unat_def)
118.231 - apply (clarsimp simp only: uint_number_of)
118.232 + apply (clarsimp simp only: uint_numeral)
118.233 apply (rule nat_mod_distrib [THEN trans])
118.234 - apply (erule sign_Pls_ge_0 [THEN iffD1])
118.235 + apply (rule zero_le_numeral)
118.236 apply (simp_all add: nat_power_eq)
118.237 done
118.238
118.239 -lemma sint_number_of: "sint (number_of b :: 'a :: len word) = (number_of b +
118.240 +lemma sint_numeral: "sint (numeral b :: 'a :: len word) = (numeral b +
118.241 2 ^ (len_of TYPE('a) - 1)) mod 2 ^ len_of TYPE('a) -
118.242 2 ^ (len_of TYPE('a) - 1)"
118.243 - unfolding word_number_of_alt by (rule int_word_sint)
118.244 -
118.245 -lemma word_of_int_0 [simp]: "word_of_int 0 = 0"
118.246 + unfolding word_numeral_alt by (rule int_word_sint)
118.247 +
118.248 +lemma word_of_int_0 [simp, code_post]: "word_of_int 0 = 0"
118.249 unfolding word_0_wi ..
118.250
118.251 -lemma word_of_int_1 [simp]: "word_of_int 1 = 1"
118.252 +lemma word_of_int_1 [simp, code_post]: "word_of_int 1 = 1"
118.253 unfolding word_1_wi ..
118.254
118.255 -lemma word_of_int_bin [simp] :
118.256 - "(word_of_int (number_of bin) :: 'a :: len0 word) = (number_of bin)"
118.257 - unfolding word_number_of_alt ..
118.258 +lemma word_of_int_numeral [simp] :
118.259 + "(word_of_int (numeral bin) :: 'a :: len0 word) = (numeral bin)"
118.260 + unfolding word_numeral_alt ..
118.261 +
118.262 +lemma word_of_int_neg_numeral [simp]:
118.263 + "(word_of_int (neg_numeral bin) :: 'a :: len0 word) = (neg_numeral bin)"
118.264 + unfolding neg_numeral_def word_numeral_alt wi_hom_syms ..
118.265
118.266 lemma word_int_case_wi:
118.267 "word_int_case f (word_of_int i :: 'b word) =
118.268 @@ -728,7 +792,7 @@
118.269 unfolding word_reverse_def by (simp add : word_bl.Abs_inverse)
118.270
118.271 lemma word_rev_gal: "word_reverse w = u \<Longrightarrow> word_reverse u = w"
118.272 - by auto
118.273 + by (metis word_rev_rev)
118.274
118.275 lemma word_rev_gal': "u = word_reverse w \<Longrightarrow> w = word_reverse u"
118.276 by simp
118.277 @@ -762,8 +826,8 @@
118.278 done
118.279
118.280 lemma no_of_bl:
118.281 - "(number_of bin ::'a::len0 word) = of_bl (bin_to_bl (len_of TYPE ('a)) bin)"
118.282 - unfolding word_size of_bl_def by (simp add: word_number_of_def)
118.283 + "(numeral bin ::'a::len0 word) = of_bl (bin_to_bl (len_of TYPE ('a)) (numeral bin))"
118.284 + unfolding of_bl_def by simp
118.285
118.286 lemma uint_bl: "to_bl w = bin_to_bl (size w) (uint w)"
118.287 unfolding word_size to_bl_def by auto
118.288 @@ -775,9 +839,15 @@
118.289 "to_bl (word_of_int bin::'a::len0 word) = bin_to_bl (len_of TYPE('a)) bin"
118.290 unfolding uint_bl by (clarsimp simp add: word_ubin.eq_norm word_size)
118.291
118.292 -lemma to_bl_no_bin [simp]:
118.293 - "to_bl (number_of bin::'a::len0 word) = bin_to_bl (len_of TYPE('a)) (number_of bin)"
118.294 - unfolding word_number_of_alt by (rule to_bl_of_bin)
118.295 +lemma to_bl_numeral [simp]:
118.296 + "to_bl (numeral bin::'a::len0 word) =
118.297 + bin_to_bl (len_of TYPE('a)) (numeral bin)"
118.298 + unfolding word_numeral_alt by (rule to_bl_of_bin)
118.299 +
118.300 +lemma to_bl_neg_numeral [simp]:
118.301 + "to_bl (neg_numeral bin::'a::len0 word) =
118.302 + bin_to_bl (len_of TYPE('a)) (neg_numeral bin)"
118.303 + unfolding word_neg_numeral_alt by (rule to_bl_of_bin)
118.304
118.305 lemma to_bl_to_bin [simp] : "bl_to_bin (to_bl w) = uint w"
118.306 unfolding uint_bl by (simp add : word_size)
118.307 @@ -803,35 +873,29 @@
118.308 by (auto simp add : uints_unats image_iff)
118.309
118.310 lemmas bintr_num = word_ubin.norm_eq_iff
118.311 - [of "number_of a" "number_of b", symmetric, folded word_number_of_alt] for a b
118.312 + [of "numeral a" "numeral b", symmetric, folded word_numeral_alt] for a b
118.313 lemmas sbintr_num = word_sbin.norm_eq_iff
118.314 - [of "number_of a" "number_of b", symmetric, folded word_number_of_alt] for a b
118.315 -
118.316 -lemmas num_of_bintr = word_ubin.Abs_norm [folded word_number_of_def]
118.317 -lemmas num_of_sbintr = word_sbin.Abs_norm [folded word_number_of_def]
118.318 -
118.319 -(* don't add these to simpset, since may want bintrunc n w to be simplified;
118.320 - may want these in reverse, but loop as simp rules, so use following *)
118.321 + [of "numeral a" "numeral b", symmetric, folded word_numeral_alt] for a b
118.322
118.323 lemma num_of_bintr':
118.324 - "bintrunc (len_of TYPE('a :: len0)) (number_of a) = (number_of b) \<Longrightarrow>
118.325 - number_of a = (number_of b :: 'a word)"
118.326 + "bintrunc (len_of TYPE('a :: len0)) (numeral a) = (numeral b) \<Longrightarrow>
118.327 + numeral a = (numeral b :: 'a word)"
118.328 unfolding bintr_num by (erule subst, simp)
118.329
118.330 lemma num_of_sbintr':
118.331 - "sbintrunc (len_of TYPE('a :: len) - 1) (number_of a) = (number_of b) \<Longrightarrow>
118.332 - number_of a = (number_of b :: 'a word)"
118.333 + "sbintrunc (len_of TYPE('a :: len) - 1) (numeral a) = (numeral b) \<Longrightarrow>
118.334 + numeral a = (numeral b :: 'a word)"
118.335 unfolding sbintr_num by (erule subst, simp)
118.336
118.337 lemma num_abs_bintr:
118.338 - "(number_of x :: 'a word) =
118.339 - word_of_int (bintrunc (len_of TYPE('a::len0)) (number_of x))"
118.340 - by (simp only: word_ubin.Abs_norm word_number_of_alt)
118.341 + "(numeral x :: 'a word) =
118.342 + word_of_int (bintrunc (len_of TYPE('a::len0)) (numeral x))"
118.343 + by (simp only: word_ubin.Abs_norm word_numeral_alt)
118.344
118.345 lemma num_abs_sbintr:
118.346 - "(number_of x :: 'a word) =
118.347 - word_of_int (sbintrunc (len_of TYPE('a::len) - 1) (number_of x))"
118.348 - by (simp only: word_sbin.Abs_norm word_number_of_alt)
118.349 + "(numeral x :: 'a word) =
118.350 + word_of_int (sbintrunc (len_of TYPE('a::len) - 1) (numeral x))"
118.351 + by (simp only: word_sbin.Abs_norm word_numeral_alt)
118.352
118.353 (** cast - note, no arg for new length, as it's determined by type of result,
118.354 thus in "cast w = w, the type means cast to length of w! **)
118.355 @@ -856,13 +920,14 @@
118.356 (* for literal u(s)cast *)
118.357
118.358 lemma ucast_bintr [simp]:
118.359 - "ucast (number_of w ::'a::len0 word) =
118.360 - word_of_int (bintrunc (len_of TYPE('a)) (number_of w))"
118.361 + "ucast (numeral w ::'a::len0 word) =
118.362 + word_of_int (bintrunc (len_of TYPE('a)) (numeral w))"
118.363 unfolding ucast_def by simp
118.364 +(* TODO: neg_numeral *)
118.365
118.366 lemma scast_sbintr [simp]:
118.367 - "scast (number_of w ::'a::len word) =
118.368 - word_of_int (sbintrunc (len_of TYPE('a) - Suc 0) (number_of w))"
118.369 + "scast (numeral w ::'a::len word) =
118.370 + word_of_int (sbintrunc (len_of TYPE('a) - Suc 0) (numeral w))"
118.371 unfolding scast_def by simp
118.372
118.373 lemma source_size: "source_size (c::'a::len0 word \<Rightarrow> _) = len_of TYPE('a)"
118.374 @@ -1016,8 +1081,8 @@
118.375 done
118.376
118.377 lemma ucast_down_no [OF refl]:
118.378 - "uc = ucast \<Longrightarrow> is_down uc \<Longrightarrow> uc (number_of bin) = number_of bin"
118.379 - unfolding word_number_of_alt by clarify (rule ucast_down_wi)
118.380 + "uc = ucast \<Longrightarrow> is_down uc \<Longrightarrow> uc (numeral bin) = numeral bin"
118.381 + unfolding word_numeral_alt by clarify (rule ucast_down_wi)
118.382
118.383 lemma ucast_down_bl [OF refl]:
118.384 "uc = ucast \<Longrightarrow> is_down uc \<Longrightarrow> uc (of_bl bl) = of_bl bl"
118.385 @@ -1028,19 +1093,6 @@
118.386
118.387 lemmas word_log_defs = word_and_def word_or_def word_xor_def word_not_def
118.388
118.389 -text {* Executable equality *}
118.390 -
118.391 -instantiation word :: (len0) equal
118.392 -begin
118.393 -
118.394 -definition equal_word :: "'a word \<Rightarrow> 'a word \<Rightarrow> bool" where
118.395 - "equal_word k l \<longleftrightarrow> HOL.equal (uint k) (uint l)"
118.396 -
118.397 -instance proof
118.398 -qed (simp add: equal equal_word_def)
118.399 -
118.400 -end
118.401 -
118.402
118.403 subsection {* Word Arithmetic *}
118.404
118.405 @@ -1057,33 +1109,23 @@
118.406 "0 \<le> n \<Longrightarrow> uint b = n * uint a \<Longrightarrow> a udvd b"
118.407 by (auto simp: udvd_def)
118.408
118.409 -lemmas word_div_no [simp] = word_div_def [of "number_of a" "number_of b"] for a b
118.410 -
118.411 -lemmas word_mod_no [simp] = word_mod_def [of "number_of a" "number_of b"] for a b
118.412 -
118.413 -lemmas word_less_no [simp] = word_less_def [of "number_of a" "number_of b"] for a b
118.414 -
118.415 -lemmas word_le_no [simp] = word_le_def [of "number_of a" "number_of b"] for a b
118.416 -
118.417 -lemmas word_sless_no [simp] = word_sless_def [of "number_of a" "number_of b"] for a b
118.418 -
118.419 -lemmas word_sle_no [simp] = word_sle_def [of "number_of a" "number_of b"] for a b
118.420 -
118.421 -(* following two are available in class number_ring,
118.422 - but convenient to have them here here;
118.423 - note - the number_ring versions, numeral_0_eq_0 and numeral_1_eq_1
118.424 - are in the default simpset, so to use the automatic simplifications for
118.425 - (eg) sint (number_of bin) on sint 1, must do
118.426 - (simp add: word_1_no del: numeral_1_eq_1)
118.427 - *)
118.428 -lemma word_0_no: "(0::'a::len0 word) = Numeral0"
118.429 - by (simp add: word_number_of_alt)
118.430 +lemmas word_div_no [simp] = word_div_def [of "numeral a" "numeral b"] for a b
118.431 +
118.432 +lemmas word_mod_no [simp] = word_mod_def [of "numeral a" "numeral b"] for a b
118.433 +
118.434 +lemmas word_less_no [simp] = word_less_def [of "numeral a" "numeral b"] for a b
118.435 +
118.436 +lemmas word_le_no [simp] = word_le_def [of "numeral a" "numeral b"] for a b
118.437 +
118.438 +lemmas word_sless_no [simp] = word_sless_def [of "numeral a" "numeral b"] for a b
118.439 +
118.440 +lemmas word_sle_no [simp] = word_sle_def [of "numeral a" "numeral b"] for a b
118.441
118.442 lemma word_1_no: "(1::'a::len0 word) = Numeral1"
118.443 - by (simp add: word_number_of_alt)
118.444 + by (simp add: word_numeral_alt)
118.445
118.446 lemma word_m1_wi: "-1 = word_of_int -1"
118.447 - by (rule word_number_of_alt)
118.448 + by (rule word_neg_numeral_alt)
118.449
118.450 lemma word_0_bl [simp]: "of_bl [] = 0"
118.451 unfolding of_bl_def by simp
118.452 @@ -1195,17 +1237,18 @@
118.453 lemmas uint_mod_alt = word_mod_def [THEN trans [OF uint_cong int_word_uint]]
118.454
118.455 lemma word_pred_0_n1: "word_pred 0 = word_of_int -1"
118.456 - unfolding word_pred_def uint_eq_0 pred_def by simp
118.457 + unfolding word_pred_def uint_eq_0 by simp
118.458
118.459 lemma succ_pred_no [simp]:
118.460 - "word_succ (number_of bin) = number_of (Int.succ bin) &
118.461 - word_pred (number_of bin) = number_of (Int.pred bin)"
118.462 - unfolding word_number_of_def Int.succ_def Int.pred_def
118.463 - by (simp add: word_of_int_homs)
118.464 + "word_succ (numeral w) = numeral w + 1"
118.465 + "word_pred (numeral w) = numeral w - 1"
118.466 + "word_succ (neg_numeral w) = neg_numeral w + 1"
118.467 + "word_pred (neg_numeral w) = neg_numeral w - 1"
118.468 + unfolding word_succ_p1 word_pred_m1 by simp_all
118.469
118.470 lemma word_sp_01 [simp] :
118.471 "word_succ -1 = 0 & word_succ 0 = 1 & word_pred 0 = -1 & word_pred 1 = 0"
118.472 - unfolding word_0_no word_1_no by simp
118.473 + unfolding word_succ_p1 word_pred_m1 by simp_all
118.474
118.475 (* alternative approach to lifting arithmetic equalities *)
118.476 lemma word_of_int_Ex:
118.477 @@ -1230,10 +1273,10 @@
118.478 lemmas word_not_simps [simp] =
118.479 word_zero_le [THEN leD] word_m1_ge [THEN leD] word_n1_ge [THEN leD]
118.480
118.481 -lemma word_gt_0: "0 < y = (0 ~= (y :: 'a :: len0 word))"
118.482 - unfolding word_less_def by auto
118.483 -
118.484 -lemmas word_gt_0_no [simp] = word_gt_0 [of "number_of y"] for y
118.485 +lemma word_gt_0: "0 < y \<longleftrightarrow> 0 \<noteq> (y :: 'a :: len0 word)"
118.486 + by (simp add: less_le)
118.487 +
118.488 +lemmas word_gt_0_no [simp] = word_gt_0 [of "numeral y"] for y
118.489
118.490 lemma word_sless_alt: "(a <s b) = (sint a < sint b)"
118.491 unfolding word_sle_def word_sless_def
118.492 @@ -1647,10 +1690,15 @@
118.493 (* note that iszero_def is only for class comm_semiring_1_cancel,
118.494 which requires word length >= 1, ie 'a :: len word *)
118.495 lemma iszero_word_no [simp]:
118.496 - "iszero (number_of bin :: 'a :: len word) =
118.497 - iszero (bintrunc (len_of TYPE('a)) (number_of bin))"
118.498 - using word_ubin.norm_eq_iff [where 'a='a, of "number_of bin" 0]
118.499 + "iszero (numeral bin :: 'a :: len word) =
118.500 + iszero (bintrunc (len_of TYPE('a)) (numeral bin))"
118.501 + using word_ubin.norm_eq_iff [where 'a='a, of "numeral bin" 0]
118.502 by (simp add: iszero_def [symmetric])
118.503 +
118.504 +text {* Use @{text iszero} to simplify equalities between word numerals. *}
118.505 +
118.506 +lemmas word_eq_numeral_iff_iszero [simp] =
118.507 + eq_numeral_iff_iszero [where 'a="'a::len word"]
118.508
118.509
118.510 subsection "Word and nat"
118.511 @@ -2023,10 +2071,10 @@
118.512
118.513 lemma of_bl_length_less:
118.514 "length x = k \<Longrightarrow> k < len_of TYPE('a) \<Longrightarrow> (of_bl x :: 'a :: len word) < 2 ^ k"
118.515 - apply (unfold of_bl_def word_less_alt word_number_of_alt)
118.516 + apply (unfold of_bl_def word_less_alt word_numeral_alt)
118.517 apply safe
118.518 apply (simp (no_asm) add: word_of_int_power_hom word_uint.eq_norm
118.519 - del: word_of_int_bin)
118.520 + del: word_of_int_numeral)
118.521 apply (simp add: mod_pos_pos_trivial)
118.522 apply (subst mod_pos_pos_trivial)
118.523 apply (rule bl_to_bin_ge0)
118.524 @@ -2073,22 +2121,38 @@
118.525 unfolding word_log_defs wils1 by simp_all
118.526
118.527 lemma word_no_log_defs [simp]:
118.528 - "NOT number_of a = (number_of (NOT a) :: 'a::len0 word)"
118.529 - "number_of a AND number_of b = (number_of (a AND b) :: 'a word)"
118.530 - "number_of a OR number_of b = (number_of (a OR b) :: 'a word)"
118.531 - "number_of a XOR number_of b = (number_of (a XOR b) :: 'a word)"
118.532 - unfolding word_no_wi word_wi_log_defs by simp_all
118.533 + "NOT (numeral a) = word_of_int (NOT (numeral a))"
118.534 + "NOT (neg_numeral a) = word_of_int (NOT (neg_numeral a))"
118.535 + "numeral a AND numeral b = word_of_int (numeral a AND numeral b)"
118.536 + "numeral a AND neg_numeral b = word_of_int (numeral a AND neg_numeral b)"
118.537 + "neg_numeral a AND numeral b = word_of_int (neg_numeral a AND numeral b)"
118.538 + "neg_numeral a AND neg_numeral b = word_of_int (neg_numeral a AND neg_numeral b)"
118.539 + "numeral a OR numeral b = word_of_int (numeral a OR numeral b)"
118.540 + "numeral a OR neg_numeral b = word_of_int (numeral a OR neg_numeral b)"
118.541 + "neg_numeral a OR numeral b = word_of_int (neg_numeral a OR numeral b)"
118.542 + "neg_numeral a OR neg_numeral b = word_of_int (neg_numeral a OR neg_numeral b)"
118.543 + "numeral a XOR numeral b = word_of_int (numeral a XOR numeral b)"
118.544 + "numeral a XOR neg_numeral b = word_of_int (numeral a XOR neg_numeral b)"
118.545 + "neg_numeral a XOR numeral b = word_of_int (neg_numeral a XOR numeral b)"
118.546 + "neg_numeral a XOR neg_numeral b = word_of_int (neg_numeral a XOR neg_numeral b)"
118.547 + unfolding word_numeral_alt word_neg_numeral_alt word_wi_log_defs by simp_all
118.548
118.549 text {* Special cases for when one of the arguments equals 1. *}
118.550
118.551 lemma word_bitwise_1_simps [simp]:
118.552 "NOT (1::'a::len0 word) = -2"
118.553 - "(1::'a word) AND number_of b = number_of (Int.Bit1 Int.Pls AND b)"
118.554 - "number_of a AND (1::'a word) = number_of (a AND Int.Bit1 Int.Pls)"
118.555 - "(1::'a word) OR number_of b = number_of (Int.Bit1 Int.Pls OR b)"
118.556 - "number_of a OR (1::'a word) = number_of (a OR Int.Bit1 Int.Pls)"
118.557 - "(1::'a word) XOR number_of b = number_of (Int.Bit1 Int.Pls XOR b)"
118.558 - "number_of a XOR (1::'a word) = number_of (a XOR Int.Bit1 Int.Pls)"
118.559 + "1 AND numeral b = word_of_int (1 AND numeral b)"
118.560 + "1 AND neg_numeral b = word_of_int (1 AND neg_numeral b)"
118.561 + "numeral a AND 1 = word_of_int (numeral a AND 1)"
118.562 + "neg_numeral a AND 1 = word_of_int (neg_numeral a AND 1)"
118.563 + "1 OR numeral b = word_of_int (1 OR numeral b)"
118.564 + "1 OR neg_numeral b = word_of_int (1 OR neg_numeral b)"
118.565 + "numeral a OR 1 = word_of_int (numeral a OR 1)"
118.566 + "neg_numeral a OR 1 = word_of_int (neg_numeral a OR 1)"
118.567 + "1 XOR numeral b = word_of_int (1 XOR numeral b)"
118.568 + "1 XOR neg_numeral b = word_of_int (1 XOR neg_numeral b)"
118.569 + "numeral a XOR 1 = word_of_int (numeral a XOR 1)"
118.570 + "neg_numeral a XOR 1 = word_of_int (neg_numeral a XOR 1)"
118.571 unfolding word_1_no word_no_log_defs by simp_all
118.572
118.573 lemma uint_or: "uint (x OR y) = (uint x) OR (uint y)"
118.574 @@ -2123,10 +2187,15 @@
118.575 unfolding word_test_bit_def
118.576 by (simp add: nth_bintr [symmetric] word_ubin.eq_norm)
118.577
118.578 -lemma test_bit_no [simp]:
118.579 - "(number_of w :: 'a::len0 word) !! n \<longleftrightarrow>
118.580 - n < len_of TYPE('a) \<and> bin_nth (number_of w) n"
118.581 - unfolding word_number_of_alt test_bit_wi ..
118.582 +lemma test_bit_numeral [simp]:
118.583 + "(numeral w :: 'a::len0 word) !! n \<longleftrightarrow>
118.584 + n < len_of TYPE('a) \<and> bin_nth (numeral w) n"
118.585 + unfolding word_numeral_alt test_bit_wi ..
118.586 +
118.587 +lemma test_bit_neg_numeral [simp]:
118.588 + "(neg_numeral w :: 'a::len0 word) !! n \<longleftrightarrow>
118.589 + n < len_of TYPE('a) \<and> bin_nth (neg_numeral w) n"
118.590 + unfolding word_neg_numeral_alt test_bit_wi ..
118.591
118.592 lemma test_bit_1 [simp]: "(1::'a::len word) !! n \<longleftrightarrow> n = 0"
118.593 unfolding word_1_wi test_bit_wi by auto
118.594 @@ -2134,6 +2203,9 @@
118.595 lemma nth_0 [simp]: "~ (0::'a::len0 word) !! n"
118.596 unfolding word_test_bit_def by simp
118.597
118.598 +lemma nth_minus1 [simp]: "(-1::'a::len0 word) !! n \<longleftrightarrow> n < len_of TYPE('a)"
118.599 + unfolding word_test_bit_def by (simp add: nth_bintr)
118.600 +
118.601 (* get from commutativity, associativity etc of int_and etc
118.602 to same for word_and etc *)
118.603
118.604 @@ -2294,9 +2366,13 @@
118.605 "msb (word_of_int x::'a::len word) = bin_nth x (len_of TYPE('a) - 1)"
118.606 unfolding word_msb_def by (simp add: word_sbin.eq_norm bin_sign_lem)
118.607
118.608 -lemma word_msb_no [simp]:
118.609 - "msb (number_of w::'a::len word) = bin_nth (number_of w) (len_of TYPE('a) - 1)"
118.610 - unfolding word_number_of_alt by (rule msb_word_of_int)
118.611 +lemma word_msb_numeral [simp]:
118.612 + "msb (numeral w::'a::len word) = bin_nth (numeral w) (len_of TYPE('a) - 1)"
118.613 + unfolding word_numeral_alt by (rule msb_word_of_int)
118.614 +
118.615 +lemma word_msb_neg_numeral [simp]:
118.616 + "msb (neg_numeral w::'a::len word) = bin_nth (neg_numeral w) (len_of TYPE('a) - 1)"
118.617 + unfolding word_neg_numeral_alt by (rule msb_word_of_int)
118.618
118.619 lemma word_msb_0 [simp]: "\<not> msb (0::'a::len word)"
118.620 unfolding word_msb_def by simp
118.621 @@ -2420,9 +2496,13 @@
118.622 unfolding sint_uint l_def
118.623 by (clarsimp simp add: nth_sbintr word_test_bit_def [symmetric])
118.624
118.625 -lemma word_lsb_no [simp]:
118.626 - "lsb (number_of bin :: 'a :: len word) = (bin_last (number_of bin) = 1)"
118.627 - unfolding word_lsb_alt test_bit_no by auto
118.628 +lemma word_lsb_numeral [simp]:
118.629 + "lsb (numeral bin :: 'a :: len word) = (bin_last (numeral bin) = 1)"
118.630 + unfolding word_lsb_alt test_bit_numeral by simp
118.631 +
118.632 +lemma word_lsb_neg_numeral [simp]:
118.633 + "lsb (neg_numeral bin :: 'a :: len word) = (bin_last (neg_numeral bin) = 1)"
118.634 + unfolding word_lsb_alt test_bit_neg_numeral by simp
118.635
118.636 lemma set_bit_word_of_int:
118.637 "set_bit (word_of_int x) n b = word_of_int (bin_sc n (if b then 1 else 0) x)"
118.638 @@ -2431,10 +2511,15 @@
118.639 apply (simp add: word_size bin_nth_sc_gen word_ubin.eq_norm nth_bintr)
118.640 done
118.641
118.642 -lemma word_set_no [simp]:
118.643 - "set_bit (number_of bin::'a::len0 word) n b =
118.644 - word_of_int (bin_sc n (if b then 1 else 0) (number_of bin))"
118.645 - unfolding word_number_of_alt by (rule set_bit_word_of_int)
118.646 +lemma word_set_numeral [simp]:
118.647 + "set_bit (numeral bin::'a::len0 word) n b =
118.648 + word_of_int (bin_sc n (if b then 1 else 0) (numeral bin))"
118.649 + unfolding word_numeral_alt by (rule set_bit_word_of_int)
118.650 +
118.651 +lemma word_set_neg_numeral [simp]:
118.652 + "set_bit (neg_numeral bin::'a::len0 word) n b =
118.653 + word_of_int (bin_sc n (if b then 1 else 0) (neg_numeral bin))"
118.654 + unfolding word_neg_numeral_alt by (rule set_bit_word_of_int)
118.655
118.656 lemma word_set_bit_0 [simp]:
118.657 "set_bit 0 n b = word_of_int (bin_sc n (if b then 1 else 0) 0)"
118.658 @@ -2445,11 +2530,11 @@
118.659 unfolding word_1_wi by (rule set_bit_word_of_int)
118.660
118.661 lemma setBit_no [simp]:
118.662 - "setBit (number_of bin) n = word_of_int (bin_sc n 1 (number_of bin))"
118.663 + "setBit (numeral bin) n = word_of_int (bin_sc n 1 (numeral bin))"
118.664 by (simp add: setBit_def)
118.665
118.666 lemma clearBit_no [simp]:
118.667 - "clearBit (number_of bin) n = word_of_int (bin_sc n 0 (number_of bin))"
118.668 + "clearBit (numeral bin) n = word_of_int (bin_sc n 0 (numeral bin))"
118.669 by (simp add: clearBit_def)
118.670
118.671 lemma to_bl_n1:
118.672 @@ -2512,7 +2597,7 @@
118.673 apply (rule word_ubin.norm_eq_iff [THEN iffD1])
118.674 apply (rule box_equals)
118.675 apply (rule_tac [2] bintr_ariths (1))+
118.676 - apply (clarsimp simp add : number_of_is_id)
118.677 + apply simp
118.678 apply simp
118.679 done
118.680
118.681 @@ -2547,15 +2632,19 @@
118.682
118.683 lemma shiftl1_wi [simp]: "shiftl1 (word_of_int w) = word_of_int (w BIT 0)"
118.684 unfolding shiftl1_def
118.685 - apply (simp only: word_ubin.norm_eq_iff [symmetric] word_ubin.eq_norm)
118.686 + apply (simp add: word_ubin.norm_eq_iff [symmetric] word_ubin.eq_norm)
118.687 apply (subst refl [THEN bintrunc_BIT_I, symmetric])
118.688 apply (subst bintrunc_bintrunc_min)
118.689 apply simp
118.690 done
118.691
118.692 -lemma shiftl1_number [simp] :
118.693 - "shiftl1 (number_of w) = number_of (Int.Bit0 w)"
118.694 - unfolding word_number_of_alt shiftl1_wi by simp
118.695 +lemma shiftl1_numeral [simp]:
118.696 + "shiftl1 (numeral w) = numeral (Num.Bit0 w)"
118.697 + unfolding word_numeral_alt shiftl1_wi by simp
118.698 +
118.699 +lemma shiftl1_neg_numeral [simp]:
118.700 + "shiftl1 (neg_numeral w) = neg_numeral (Num.Bit0 w)"
118.701 + unfolding word_neg_numeral_alt shiftl1_wi by simp
118.702
118.703 lemma shiftl1_0 [simp] : "shiftl1 0 = 0"
118.704 unfolding shiftl1_def by simp
118.705 @@ -2704,8 +2793,8 @@
118.706
118.707 subsubsection "shift functions in terms of lists of bools"
118.708
118.709 -lemmas bshiftr1_no_bin [simp] =
118.710 - bshiftr1_def [where w="number_of w", unfolded to_bl_no_bin] for w
118.711 +lemmas bshiftr1_numeral [simp] =
118.712 + bshiftr1_def [where w="numeral w", unfolded to_bl_numeral] for w
118.713
118.714 lemma bshiftr1_bl: "to_bl (bshiftr1 b w) = b # butlast (to_bl w)"
118.715 unfolding bshiftr1_def by (rule word_bl.Abs_inverse) simp
118.716 @@ -2858,7 +2947,7 @@
118.717 finally show ?thesis .
118.718 qed
118.719
118.720 -lemmas shiftl_number [simp] = shiftl_def [where w="number_of w"] for w
118.721 +lemmas shiftl_numeral [simp] = shiftl_def [where w="numeral w"] for w
118.722
118.723 lemma bl_shiftl:
118.724 "to_bl (w << n) = drop n (to_bl w) @ replicate (min (size w) n) False"
118.725 @@ -2885,27 +2974,29 @@
118.726 by (induct n) (auto simp: shiftl1_2t)
118.727
118.728 lemma shiftr1_bintr [simp]:
118.729 - "(shiftr1 (number_of w) :: 'a :: len0 word) =
118.730 - word_of_int (bin_rest (bintrunc (len_of TYPE ('a)) (number_of w)))"
118.731 - unfolding shiftr1_def word_number_of_alt
118.732 + "(shiftr1 (numeral w) :: 'a :: len0 word) =
118.733 + word_of_int (bin_rest (bintrunc (len_of TYPE ('a)) (numeral w)))"
118.734 + unfolding shiftr1_def word_numeral_alt
118.735 by (simp add: word_ubin.eq_norm)
118.736
118.737 lemma sshiftr1_sbintr [simp]:
118.738 - "(sshiftr1 (number_of w) :: 'a :: len word) =
118.739 - word_of_int (bin_rest (sbintrunc (len_of TYPE ('a) - 1) (number_of w)))"
118.740 - unfolding sshiftr1_def word_number_of_alt
118.741 + "(sshiftr1 (numeral w) :: 'a :: len word) =
118.742 + word_of_int (bin_rest (sbintrunc (len_of TYPE ('a) - 1) (numeral w)))"
118.743 + unfolding sshiftr1_def word_numeral_alt
118.744 by (simp add: word_sbin.eq_norm)
118.745
118.746 lemma shiftr_no [simp]:
118.747 - "(number_of w::'a::len0 word) >> n = word_of_int
118.748 - ((bin_rest ^^ n) (bintrunc (len_of TYPE('a)) (number_of w)))"
118.749 + (* FIXME: neg_numeral *)
118.750 + "(numeral w::'a::len0 word) >> n = word_of_int
118.751 + ((bin_rest ^^ n) (bintrunc (len_of TYPE('a)) (numeral w)))"
118.752 apply (rule word_eqI)
118.753 apply (auto simp: nth_shiftr nth_rest_power_bin nth_bintr word_size)
118.754 done
118.755
118.756 lemma sshiftr_no [simp]:
118.757 - "(number_of w::'a::len word) >>> n = word_of_int
118.758 - ((bin_rest ^^ n) (sbintrunc (len_of TYPE('a) - 1) (number_of w)))"
118.759 + (* FIXME: neg_numeral *)
118.760 + "(numeral w::'a::len word) >>> n = word_of_int
118.761 + ((bin_rest ^^ n) (sbintrunc (len_of TYPE('a) - 1) (numeral w)))"
118.762 apply (rule word_eqI)
118.763 apply (auto simp: nth_sshiftr nth_rest_power_bin nth_sbintr word_size)
118.764 apply (subgoal_tac "na + n = len_of TYPE('a) - Suc 0", simp, simp)+
118.765 @@ -3016,8 +3107,8 @@
118.766 lemma and_mask_wi: "word_of_int i AND mask n = word_of_int (bintrunc n i)"
118.767 by (auto simp add: nth_bintr word_size word_ops_nth_size word_eq_iff)
118.768
118.769 -lemma and_mask_no: "number_of i AND mask n = word_of_int (bintrunc n (number_of i))"
118.770 - unfolding word_number_of_alt by (rule and_mask_wi)
118.771 +lemma and_mask_no: "numeral i AND mask n = word_of_int (bintrunc n (numeral i))"
118.772 + unfolding word_numeral_alt by (rule and_mask_wi)
118.773
118.774 lemma bl_and_mask':
118.775 "to_bl (w AND mask n :: 'a :: len word) =
118.776 @@ -3046,7 +3137,7 @@
118.777 by (simp add: int_mod_lem eq_sym_conv)
118.778
118.779 lemma mask_eq_iff: "(w AND mask n) = w <-> uint w < 2 ^ n"
118.780 - apply (simp add: and_mask_bintr word_number_of_def)
118.781 + apply (simp add: and_mask_bintr)
118.782 apply (simp add: word_ubin.inverse_norm)
118.783 apply (simp add: eq_mod_iff bintrunc_mod2p min_def)
118.784 apply (fast intro!: lt2p_lem)
118.785 @@ -3073,17 +3164,17 @@
118.786
118.787 lemma word_2p_lem:
118.788 "n < size w \<Longrightarrow> w < 2 ^ n = (uint (w :: 'a :: len word) < 2 ^ n)"
118.789 - apply (unfold word_size word_less_alt word_number_of_alt)
118.790 + apply (unfold word_size word_less_alt word_numeral_alt)
118.791 apply (clarsimp simp add: word_of_int_power_hom word_uint.eq_norm
118.792 int_mod_eq'
118.793 - simp del: word_of_int_bin)
118.794 + simp del: word_of_int_numeral)
118.795 done
118.796
118.797 lemma less_mask_eq: "x < 2 ^ n \<Longrightarrow> x AND mask n = (x :: 'a :: len word)"
118.798 - apply (unfold word_less_alt word_number_of_alt)
118.799 + apply (unfold word_less_alt word_numeral_alt)
118.800 apply (clarsimp simp add: and_mask_mod_2p word_of_int_power_hom
118.801 word_uint.eq_norm
118.802 - simp del: word_of_int_bin)
118.803 + simp del: word_of_int_numeral)
118.804 apply (drule xtr8 [rotated])
118.805 apply (rule int_mod_le)
118.806 apply (auto simp add : mod_pos_pos_trivial)
118.807 @@ -3126,7 +3217,7 @@
118.808
118.809 lemmas revcast_def' = revcast_def [simplified]
118.810 lemmas revcast_def'' = revcast_def' [simplified word_size]
118.811 -lemmas revcast_no_def [simp] = revcast_def' [where w="number_of w", unfolded word_size] for w
118.812 +lemmas revcast_no_def [simp] = revcast_def' [where w="numeral w", unfolded word_size] for w
118.813
118.814 lemma to_bl_revcast:
118.815 "to_bl (revcast w :: 'a :: len0 word) =
118.816 @@ -3240,13 +3331,13 @@
118.817 subsubsection "Slices"
118.818
118.819 lemma slice1_no_bin [simp]:
118.820 - "slice1 n (number_of w :: 'b word) = of_bl (takefill False n (bin_to_bl (len_of TYPE('b :: len0)) (number_of w)))"
118.821 - by (simp add: slice1_def)
118.822 + "slice1 n (numeral w :: 'b word) = of_bl (takefill False n (bin_to_bl (len_of TYPE('b :: len0)) (numeral w)))"
118.823 + by (simp add: slice1_def) (* TODO: neg_numeral *)
118.824
118.825 lemma slice_no_bin [simp]:
118.826 - "slice n (number_of w :: 'b word) = of_bl (takefill False (len_of TYPE('b :: len0) - n)
118.827 - (bin_to_bl (len_of TYPE('b :: len0)) (number_of w)))"
118.828 - by (simp add: slice_def word_size)
118.829 + "slice n (numeral w :: 'b word) = of_bl (takefill False (len_of TYPE('b :: len0) - n)
118.830 + (bin_to_bl (len_of TYPE('b :: len0)) (numeral w)))"
118.831 + by (simp add: slice_def word_size) (* TODO: neg_numeral *)
118.832
118.833 lemma slice1_0 [simp] : "slice1 n 0 = 0"
118.834 unfolding slice1_def by simp
118.835 @@ -3383,9 +3474,9 @@
118.836 lemmas word_cat_bin' = word_cat_def
118.837
118.838 lemma word_rsplit_no:
118.839 - "(word_rsplit (number_of bin :: 'b :: len0 word) :: 'a word list) =
118.840 + "(word_rsplit (numeral bin :: 'b :: len0 word) :: 'a word list) =
118.841 map word_of_int (bin_rsplit (len_of TYPE('a :: len))
118.842 - (len_of TYPE('b), bintrunc (len_of TYPE('b)) (number_of bin)))"
118.843 + (len_of TYPE('b), bintrunc (len_of TYPE('b)) (numeral bin)))"
118.844 unfolding word_rsplit_def by (simp add: word_ubin.eq_norm)
118.845
118.846 lemmas word_rsplit_no_cl [simp] = word_rsplit_no
118.847 @@ -3580,15 +3671,14 @@
118.848 done
118.849
118.850 lemmas word_cat_bl_no_bin [simp] =
118.851 - word_cat_bl [where a="number_of a"
118.852 - and b="number_of b",
118.853 - unfolded to_bl_no_bin]
118.854 - for a b
118.855 + word_cat_bl [where a="numeral a" and b="numeral b",
118.856 + unfolded to_bl_numeral]
118.857 + for a b (* FIXME: negative numerals, 0 and 1 *)
118.858
118.859 lemmas word_split_bl_no_bin [simp] =
118.860 - word_split_bl_eq [where c="number_of c", unfolded to_bl_no_bin] for c
118.861 -
118.862 --- {* this odd result arises from the fact that the statement of the
118.863 + word_split_bl_eq [where c="numeral c", unfolded to_bl_numeral] for c
118.864 +
118.865 +text {* this odd result arises from the fact that the statement of the
118.866 result implies that the decoded words are of the same type,
118.867 and therefore of the same length, as the original word *}
118.868
118.869 @@ -3962,7 +4052,7 @@
118.870
118.871 lemma word_rotr_rev:
118.872 "word_rotr n w = word_reverse (word_rotl n (word_reverse w))"
118.873 - by (simp add: word_bl.Rep_inject [symmetric] to_bl_word_rev
118.874 + by (simp only: word_bl.Rep_inject [symmetric] to_bl_word_rev
118.875 to_bl_rotr to_bl_rotl rotater_rev)
118.876
118.877 lemma word_roti_0 [simp]: "word_roti 0 w = w"
118.878 @@ -4093,10 +4183,12 @@
118.879 unfolding word_roti_def by auto
118.880
118.881 lemmas word_rotr_dt_no_bin' [simp] =
118.882 - word_rotr_dt [where w="number_of w", unfolded to_bl_no_bin] for w
118.883 + word_rotr_dt [where w="numeral w", unfolded to_bl_numeral] for w
118.884 + (* FIXME: negative numerals, 0 and 1 *)
118.885
118.886 lemmas word_rotl_dt_no_bin' [simp] =
118.887 - word_rotl_dt [where w="number_of w", unfolded to_bl_no_bin] for w
118.888 + word_rotl_dt [where w="numeral w", unfolded to_bl_numeral] for w
118.889 + (* FIXME: negative numerals, 0 and 1 *)
118.890
118.891 declare word_roti_def [simp]
118.892
118.893 @@ -4119,8 +4211,7 @@
118.894 (simp add: max_word_def word_le_def int_word_uint int_mod_eq')
118.895
118.896 lemma word_of_int_2p_len: "word_of_int (2 ^ len_of TYPE('a)) = (0::'a::len0 word)"
118.897 - by (subst word_uint.Abs_norm [symmetric])
118.898 - (simp add: word_of_int_hom_syms)
118.899 + by (subst word_uint.Abs_norm [symmetric]) simp
118.900
118.901 lemma word_pow_0:
118.902 "(2::'a::len word) ^ len_of TYPE('a) = 0"
118.903 @@ -4304,10 +4395,7 @@
118.904 lemma word_neq_0_conv:
118.905 fixes w :: "'a :: len word"
118.906 shows "(w \<noteq> 0) = (0 < w)"
118.907 -proof -
118.908 - have "0 \<le> w" by (rule word_zero_le)
118.909 - thus ?thesis by (auto simp add: word_less_def)
118.910 -qed
118.911 + unfolding word_gt_0 by simp
118.912
118.913 lemma max_lt:
118.914 "unat (max a b div c) = unat (max a b) div unat (c:: 'a :: len word)"
118.915 @@ -4335,8 +4423,8 @@
118.916 "b <= a \<Longrightarrow> unat (a - b) = unat a - unat b"
118.917 by (simp add: unat_def uint_sub_if_size word_le_def nat_diff_distrib)
118.918
118.919 -lemmas word_less_sub1_numberof [simp] = word_less_sub1 [of "number_of w"] for w
118.920 -lemmas word_le_sub1_numberof [simp] = word_le_sub1 [of "number_of w"] for w
118.921 +lemmas word_less_sub1_numberof [simp] = word_less_sub1 [of "numeral w"] for w
118.922 +lemmas word_le_sub1_numberof [simp] = word_le_sub1 [of "numeral w"] for w
118.923
118.924 lemma word_of_int_minus:
118.925 "word_of_int (2^len_of TYPE('a) - i) = (word_of_int (-i)::'a::len word)"
118.926 @@ -4354,7 +4442,7 @@
118.927
118.928 lemma word_le_less_eq:
118.929 "(x ::'z::len word) \<le> y = (x = y \<or> x < y)"
118.930 - by (auto simp add: word_less_def)
118.931 + by (auto simp add: order_class.le_less)
118.932
118.933 lemma mod_plus_cong:
118.934 assumes 1: "(b::int) = b'"
118.935 @@ -4523,17 +4611,15 @@
118.936 "1 + n \<noteq> (0::'a::len word) \<Longrightarrow> unat (1 + n) = Suc (unat n)"
118.937 by unat_arith
118.938
118.939 -
118.940 lemma word_no_1 [simp]: "(Numeral1::'a::len0 word) = 1"
118.941 by (fact word_1_no [symmetric])
118.942
118.943 -lemma word_no_0 [simp]: "(Numeral0::'a::len0 word) = 0"
118.944 - by (fact word_0_no [symmetric])
118.945 -
118.946 declare bin_to_bl_def [simp]
118.947
118.948
118.949 use "~~/src/HOL/Word/Tools/smt_word.ML"
118.950 setup {* SMT_Word.setup *}
118.951
118.952 +hide_const (open) Word
118.953 +
118.954 end
119.1 --- a/src/HOL/ex/Arith_Examples.thy Mon Mar 26 15:32:54 2012 +0200
119.2 +++ b/src/HOL/ex/Arith_Examples.thy Mon Mar 26 15:33:28 2012 +0200
119.3 @@ -218,10 +218,10 @@
119.4 lemma "(0::int) < 1"
119.5 by linarith
119.6
119.7 -lemma "(47::nat) + 11 < 08 * 15"
119.8 +lemma "(47::nat) + 11 < 8 * 15"
119.9 by linarith
119.10
119.11 -lemma "(47::int) + 11 < 08 * 15"
119.12 +lemma "(47::int) + 11 < 8 * 15"
119.13 by linarith
119.14
119.15 text {* Splitting of inequalities of different type. *}
120.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
120.2 +++ b/src/HOL/ex/Code_Nat_examples.thy Mon Mar 26 15:33:28 2012 +0200
120.3 @@ -0,0 +1,57 @@
120.4 +(* Title: HOL/ex/Code_Nat_examples.thy
120.5 + Author: Florian Haftmann, TU Muenchen
120.6 +*)
120.7 +
120.8 +header {* Simple examples for Code\_Numeral\_Nat theory. *}
120.9 +
120.10 +theory Code_Nat_examples
120.11 +imports Complex_Main "~~/src/HOL/Library/Efficient_Nat"
120.12 +begin
120.13 +
120.14 +fun to_n :: "nat \<Rightarrow> nat list"
120.15 +where
120.16 + "to_n 0 = []"
120.17 +| "to_n (Suc 0) = []"
120.18 +| "to_n (Suc (Suc 0)) = []"
120.19 +| "to_n (Suc n) = n # to_n n"
120.20 +
120.21 +definition naive_prime :: "nat \<Rightarrow> bool"
120.22 +where
120.23 + "naive_prime n \<longleftrightarrow> n \<ge> 2 \<and> filter (\<lambda>m. n mod m = 0) (to_n n) = []"
120.24 +
120.25 +primrec fac :: "nat \<Rightarrow> nat"
120.26 +where
120.27 + "fac 0 = 1"
120.28 +| "fac (Suc n) = Suc n * fac n"
120.29 +
120.30 +primrec harmonic :: "nat \<Rightarrow> rat"
120.31 +where
120.32 + "harmonic 0 = 0"
120.33 +| "harmonic (Suc n) = 1 / of_nat (Suc n) + harmonic n"
120.34 +
120.35 +lemma "harmonic 200 \<ge> 5"
120.36 + by eval
120.37 +
120.38 +lemma "(let (q, r) = quotient_of (harmonic 8) in q div r) \<ge> 2"
120.39 + by normalization
120.40 +
120.41 +lemma "naive_prime 89"
120.42 + by eval
120.43 +
120.44 +lemma "naive_prime 89"
120.45 + by normalization
120.46 +
120.47 +lemma "\<not> naive_prime 87"
120.48 + by eval
120.49 +
120.50 +lemma "\<not> naive_prime 87"
120.51 + by normalization
120.52 +
120.53 +lemma "fac 10 > 3000000"
120.54 + by eval
120.55 +
120.56 +lemma "fac 10 > 3000000"
120.57 + by normalization
120.58 +
120.59 +end
120.60 +
121.1 --- a/src/HOL/ex/Dedekind_Real.thy Mon Mar 26 15:32:54 2012 +0200
121.2 +++ b/src/HOL/ex/Dedekind_Real.thy Mon Mar 26 15:33:28 2012 +0200
121.3 @@ -1658,19 +1658,6 @@
121.4 by (blast intro!: real_less_all_preal linorder_not_less [THEN iffD1])
121.5
121.6
121.7 -subsection{*Numerals and Arithmetic*}
121.8 -
121.9 -instantiation real :: number_ring
121.10 -begin
121.11 -
121.12 -definition
121.13 - real_number_of_def: "(number_of w :: real) = of_int w"
121.14 -
121.15 -instance
121.16 - by intro_classes (simp add: real_number_of_def)
121.17 -
121.18 -end
121.19 -
121.20 subsection {* Completeness of Positive Reals *}
121.21
121.22 text {*
122.1 --- a/src/HOL/ex/Efficient_Nat_examples.thy Mon Mar 26 15:32:54 2012 +0200
122.2 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000
122.3 @@ -1,56 +0,0 @@
122.4 -(* Title: HOL/ex/Efficient_Nat_examples.thy
122.5 - Author: Florian Haftmann, TU Muenchen
122.6 -*)
122.7 -
122.8 -header {* Simple examples for Efficient\_Nat theory. *}
122.9 -
122.10 -theory Efficient_Nat_examples
122.11 -imports Complex_Main "~~/src/HOL/Library/Efficient_Nat"
122.12 -begin
122.13 -
122.14 -fun to_n :: "nat \<Rightarrow> nat list" where
122.15 - "to_n 0 = []"
122.16 - | "to_n (Suc 0) = []"
122.17 - | "to_n (Suc (Suc 0)) = []"
122.18 - | "to_n (Suc n) = n # to_n n"
122.19 -
122.20 -definition naive_prime :: "nat \<Rightarrow> bool" where
122.21 - "naive_prime n \<longleftrightarrow> n \<ge> 2 \<and> filter (\<lambda>m. n mod m = 0) (to_n n) = []"
122.22 -
122.23 -primrec fac :: "nat \<Rightarrow> nat" where
122.24 - "fac 0 = 1"
122.25 - | "fac (Suc n) = Suc n * fac n"
122.26 -
122.27 -primrec rat_of_nat :: "nat \<Rightarrow> rat" where
122.28 - "rat_of_nat 0 = 0"
122.29 - | "rat_of_nat (Suc n) = rat_of_nat n + 1"
122.30 -
122.31 -primrec harmonic :: "nat \<Rightarrow> rat" where
122.32 - "harmonic 0 = 0"
122.33 - | "harmonic (Suc n) = 1 / rat_of_nat (Suc n) + harmonic n"
122.34 -
122.35 -lemma "harmonic 200 \<ge> 5"
122.36 - by eval
122.37 -
122.38 -lemma "harmonic 20 \<ge> 3"
122.39 - by normalization
122.40 -
122.41 -lemma "naive_prime 89"
122.42 - by eval
122.43 -
122.44 -lemma "naive_prime 89"
122.45 - by normalization
122.46 -
122.47 -lemma "\<not> naive_prime 87"
122.48 - by eval
122.49 -
122.50 -lemma "\<not> naive_prime 87"
122.51 - by normalization
122.52 -
122.53 -lemma "fac 10 > 3000000"
122.54 - by eval
122.55 -
122.56 -lemma "fac 10 > 3000000"
122.57 - by normalization
122.58 -
122.59 -end
123.1 --- a/src/HOL/ex/Groebner_Examples.thy Mon Mar 26 15:32:54 2012 +0200
123.2 +++ b/src/HOL/ex/Groebner_Examples.thy Mon Mar 26 15:33:28 2012 +0200
123.3 @@ -31,7 +31,7 @@
123.4 (Conv.arg_conv (Conv.arg1_conv (Semiring_Normalizer.semiring_normalize_conv @{context})))) *})
123.5 by (rule refl)
123.6
123.7 -lemma "((-3) ^ (Suc (Suc (Suc 0)))) == (X::'a::{number_ring})"
123.8 +lemma "((-3) ^ (Suc (Suc (Suc 0)))) == (X::'a::{comm_ring_1})"
123.9 apply (simp only: power_Suc power_0)
123.10 apply (simp only: semiring_norm)
123.11 oops
123.12 @@ -58,7 +58,7 @@
123.13 by algebra
123.14
123.15 lemma
123.16 - fixes x::"'a::{idom,number_ring}"
123.17 + fixes x::"'a::{idom}"
123.18 shows "x^2*y = x^2 & x*y^2 = y^2 \<longleftrightarrow> x=1 & y=1 | x=0 & y=0"
123.19 by algebra
123.20
123.21 @@ -69,7 +69,7 @@
123.22 "sq x == x*x"
123.23
123.24 lemma
123.25 - fixes x1 :: "'a::{idom,number_ring}"
123.26 + fixes x1 :: "'a::{idom}"
123.27 shows
123.28 "(sq x1 + sq x2 + sq x3 + sq x4) * (sq y1 + sq y2 + sq y3 + sq y4) =
123.29 sq (x1*y1 - x2*y2 - x3*y3 - x4*y4) +
123.30 @@ -79,7 +79,7 @@
123.31 by (algebra add: sq_def)
123.32
123.33 lemma
123.34 - fixes p1 :: "'a::{idom,number_ring}"
123.35 + fixes p1 :: "'a::{idom}"
123.36 shows
123.37 "(sq p1 + sq q1 + sq r1 + sq s1 + sq t1 + sq u1 + sq v1 + sq w1) *
123.38 (sq p2 + sq q2 + sq r2 + sq s2 + sq t2 + sq u2 + sq v2 + sq w2)
124.1 --- a/src/HOL/ex/Numeral_Representation.thy Mon Mar 26 15:32:54 2012 +0200
124.2 +++ b/src/HOL/ex/Numeral_Representation.thy Mon Mar 26 15:33:28 2012 +0200
124.3 @@ -2,7 +2,7 @@
124.4 Author: Florian Haftmann
124.5 *)
124.6
124.7 -header {* An experimental alternative numeral representation. *}
124.8 +header {* First experiments for a numeral representation (now obsolete). *}
124.9
124.10 theory Numeral_Representation
124.11 imports Main
124.12 @@ -498,7 +498,7 @@
124.13 by (simp add: less_imp_le minus_of_num_less_one_iff)
124.14
124.15 lemma minus_one_le_of_num_iff: "- 1 \<le> of_num n"
124.16 - by (simp add: less_imp_le minus_one_less_of_num_iff)
124.17 + by (simp only: less_imp_le minus_one_less_of_num_iff)
124.18
124.19 lemma minus_one_le_one_iff: "- 1 \<le> 1"
124.20 by (simp add: less_imp_le minus_one_less_one_iff)
124.21 @@ -510,7 +510,7 @@
124.22 by (simp add: not_le minus_of_num_less_one_iff)
124.23
124.24 lemma of_num_le_minus_one_iff: "\<not> of_num n \<le> - 1"
124.25 - by (simp add: not_le minus_one_less_of_num_iff)
124.26 + by (simp only: not_le minus_one_less_of_num_iff)
124.27
124.28 lemma one_le_minus_one_iff: "\<not> 1 \<le> - 1"
124.29 by (simp add: not_le minus_one_less_one_iff)
124.30 @@ -522,10 +522,10 @@
124.31 by (simp add: not_less minus_of_num_le_one_iff)
124.32
124.33 lemma of_num_less_minus_one_iff: "\<not> of_num n < - 1"
124.34 - by (simp add: not_less minus_one_le_of_num_iff)
124.35 + by (simp only: not_less minus_one_le_of_num_iff)
124.36
124.37 lemma one_less_minus_one_iff: "\<not> 1 < - 1"
124.38 - by (simp add: not_less minus_one_le_one_iff)
124.39 + by (simp only: not_less minus_one_le_one_iff)
124.40
124.41 lemmas le_signed_numeral_special [numeral] =
124.42 minus_of_num_le_of_num_iff
124.43 @@ -835,10 +835,7 @@
124.44
124.45 text {* Reversing standard setup *}
124.46
124.47 -lemma [code_unfold del]: "(0::int) \<equiv> Numeral0" by simp
124.48 lemma [code_unfold del]: "(1::int) \<equiv> Numeral1" by simp
124.49 -declare zero_is_num_zero [code_unfold del]
124.50 -declare one_is_num_one [code_unfold del]
124.51
124.52 lemma [code, code del]:
124.53 "(1 :: int) = 1"
124.54 @@ -970,147 +967,5 @@
124.55
124.56 hide_const (open) sub dup
124.57
124.58 -text {* Pretty literals *}
124.59 +end
124.60
124.61 -ML {*
124.62 -local open Code_Thingol in
124.63 -
124.64 -fun add_code print target =
124.65 - let
124.66 - fun dest_num one' dig0' dig1' thm =
124.67 - let
124.68 - fun dest_dig (IConst (c, _)) = if c = dig0' then 0
124.69 - else if c = dig1' then 1
124.70 - else Code_Printer.eqn_error thm "Illegal numeral expression: illegal dig"
124.71 - | dest_dig _ = Code_Printer.eqn_error thm "Illegal numeral expression: illegal digit";
124.72 - fun dest_num (IConst (c, _)) = if c = one' then 1
124.73 - else Code_Printer.eqn_error thm "Illegal numeral expression: illegal leading digit"
124.74 - | dest_num (t1 `$ t2) = 2 * dest_num t2 + dest_dig t1
124.75 - | dest_num _ = Code_Printer.eqn_error thm "Illegal numeral expression: illegal term";
124.76 - in dest_num end;
124.77 - fun pretty sgn literals [one', dig0', dig1'] _ thm _ _ [(t, _)] =
124.78 - (Code_Printer.str o print literals o sgn o dest_num one' dig0' dig1' thm) t
124.79 - fun add_syntax (c, sgn) = Code_Target.add_const_syntax target c
124.80 - (SOME (Code_Printer.complex_const_syntax
124.81 - (1, ([@{const_name One}, @{const_name Dig0}, @{const_name Dig1}],
124.82 - pretty sgn))));
124.83 - in
124.84 - add_syntax (@{const_name Pls}, I)
124.85 - #> add_syntax (@{const_name Mns}, (fn k => ~ k))
124.86 - end;
124.87 -
124.88 -end
124.89 -*}
124.90 -
124.91 -hide_const (open) One Dig0 Dig1
124.92 -
124.93 -
124.94 -subsection {* Toy examples *}
124.95 -
124.96 -definition "foo \<longleftrightarrow> #4 * #2 + #7 = (#8 :: nat)"
124.97 -definition "bar \<longleftrightarrow> #4 * #2 + #7 \<ge> (#8 :: int) - #3"
124.98 -
124.99 -code_thms foo bar
124.100 -export_code foo bar checking SML OCaml? Haskell? Scala?
124.101 -
124.102 -text {* This is an ad-hoc @{text Code_Integer} setup. *}
124.103 -
124.104 -setup {*
124.105 - fold (add_code Code_Printer.literal_numeral)
124.106 - [Code_ML.target_SML, Code_ML.target_OCaml, Code_Haskell.target, Code_Scala.target]
124.107 -*}
124.108 -
124.109 -code_type int
124.110 - (SML "IntInf.int")
124.111 - (OCaml "Big'_int.big'_int")
124.112 - (Haskell "Integer")
124.113 - (Scala "BigInt")
124.114 - (Eval "int")
124.115 -
124.116 -code_const "0::int"
124.117 - (SML "0/ :/ IntInf.int")
124.118 - (OCaml "Big'_int.zero")
124.119 - (Haskell "0")
124.120 - (Scala "BigInt(0)")
124.121 - (Eval "0/ :/ int")
124.122 -
124.123 -code_const Int.pred
124.124 - (SML "IntInf.- ((_), 1)")
124.125 - (OCaml "Big'_int.pred'_big'_int")
124.126 - (Haskell "!(_/ -/ 1)")
124.127 - (Scala "!(_ -/ 1)")
124.128 - (Eval "!(_/ -/ 1)")
124.129 -
124.130 -code_const Int.succ
124.131 - (SML "IntInf.+ ((_), 1)")
124.132 - (OCaml "Big'_int.succ'_big'_int")
124.133 - (Haskell "!(_/ +/ 1)")
124.134 - (Scala "!(_ +/ 1)")
124.135 - (Eval "!(_/ +/ 1)")
124.136 -
124.137 -code_const "op + \<Colon> int \<Rightarrow> int \<Rightarrow> int"
124.138 - (SML "IntInf.+ ((_), (_))")
124.139 - (OCaml "Big'_int.add'_big'_int")
124.140 - (Haskell infixl 6 "+")
124.141 - (Scala infixl 7 "+")
124.142 - (Eval infixl 8 "+")
124.143 -
124.144 -code_const "uminus \<Colon> int \<Rightarrow> int"
124.145 - (SML "IntInf.~")
124.146 - (OCaml "Big'_int.minus'_big'_int")
124.147 - (Haskell "negate")
124.148 - (Scala "!(- _)")
124.149 - (Eval "~/ _")
124.150 -
124.151 -code_const "op - \<Colon> int \<Rightarrow> int \<Rightarrow> int"
124.152 - (SML "IntInf.- ((_), (_))")
124.153 - (OCaml "Big'_int.sub'_big'_int")
124.154 - (Haskell infixl 6 "-")
124.155 - (Scala infixl 7 "-")
124.156 - (Eval infixl 8 "-")
124.157 -
124.158 -code_const "op * \<Colon> int \<Rightarrow> int \<Rightarrow> int"
124.159 - (SML "IntInf.* ((_), (_))")
124.160 - (OCaml "Big'_int.mult'_big'_int")
124.161 - (Haskell infixl 7 "*")
124.162 - (Scala infixl 8 "*")
124.163 - (Eval infixl 9 "*")
124.164 -
124.165 -code_const pdivmod
124.166 - (SML "IntInf.divMod/ (IntInf.abs _,/ IntInf.abs _)")
124.167 - (OCaml "Big'_int.quomod'_big'_int/ (Big'_int.abs'_big'_int _)/ (Big'_int.abs'_big'_int _)")
124.168 - (Haskell "divMod/ (abs _)/ (abs _)")
124.169 - (Scala "!((k: BigInt) => (l: BigInt) =>/ if (l == 0)/ (BigInt(0), k) else/ (k.abs '/% l.abs))")
124.170 - (Eval "Integer.div'_mod/ (abs _)/ (abs _)")
124.171 -
124.172 -code_const "HOL.equal \<Colon> int \<Rightarrow> int \<Rightarrow> bool"
124.173 - (SML "!((_ : IntInf.int) = _)")
124.174 - (OCaml "Big'_int.eq'_big'_int")
124.175 - (Haskell infix 4 "==")
124.176 - (Scala infixl 5 "==")
124.177 - (Eval infixl 6 "=")
124.178 -
124.179 -code_const "op \<le> \<Colon> int \<Rightarrow> int \<Rightarrow> bool"
124.180 - (SML "IntInf.<= ((_), (_))")
124.181 - (OCaml "Big'_int.le'_big'_int")
124.182 - (Haskell infix 4 "<=")
124.183 - (Scala infixl 4 "<=")
124.184 - (Eval infixl 6 "<=")
124.185 -
124.186 -code_const "op < \<Colon> int \<Rightarrow> int \<Rightarrow> bool"
124.187 - (SML "IntInf.< ((_), (_))")
124.188 - (OCaml "Big'_int.lt'_big'_int")
124.189 - (Haskell infix 4 "<")
124.190 - (Scala infixl 4 "<")
124.191 - (Eval infixl 6 "<")
124.192 -
124.193 -code_const Code_Numeral.int_of
124.194 - (SML "IntInf.fromInt")
124.195 - (OCaml "_")
124.196 - (Haskell "toInteger")
124.197 - (Scala "!_.as'_BigInt")
124.198 - (Eval "_")
124.199 -
124.200 -export_code foo bar checking SML OCaml? Haskell? Scala?
124.201 -
124.202 -end
125.1 --- a/src/HOL/ex/ROOT.ML Mon Mar 26 15:32:54 2012 +0200
125.2 +++ b/src/HOL/ex/ROOT.ML Mon Mar 26 15:33:28 2012 +0200
125.3 @@ -5,7 +5,7 @@
125.4
125.5 no_document use_thys [
125.6 "~~/src/HOL/Library/State_Monad",
125.7 - "Efficient_Nat_examples",
125.8 + "Code_Nat_examples",
125.9 "~~/src/HOL/Library/FuncSet",
125.10 "Eval_Examples",
125.11 "Normalization_by_Evaluation",
126.1 --- a/src/HOL/ex/ReflectionEx.thy Mon Mar 26 15:32:54 2012 +0200
126.2 +++ b/src/HOL/ex/ReflectionEx.thy Mon Mar 26 15:33:28 2012 +0200
126.3 @@ -143,7 +143,7 @@
126.4 oops
126.5 text{* Hmmm let's specialize @{text Inum_C} with numerals.*}
126.6
126.7 -lemma Inum_number: "Inum (C (number_of t)) vs = number_of t" by simp
126.8 +lemma Inum_number: "Inum (C (numeral t)) vs = numeral t" by simp
126.9 lemmas Inum_eqs = Inum_Var Inum_Add Inum_Mul Inum_CN Inum_number
126.10
126.11 text{* Second attempt *}
126.12 @@ -155,7 +155,7 @@
126.13 lemma "1 * (2* x + (y::nat) + 0 + 1) \<noteq> 0"
126.14 apply (reify Inum_eqs ("1 * (2*x + (y::nat) + 0 + 1)"))
126.15 oops
126.16 - text{* Oh!! 0 is not a variable \dots\ Oh! 0 is not a @{text "number_of"} \dots\ thing. The same for 1. So let's add those equations too *}
126.17 + text{* Oh!! 0 is not a variable \dots\ Oh! 0 is not a @{text "numeral"} \dots\ thing. The same for 1. So let's add those equations too *}
126.18
126.19 lemma Inum_01: "Inum (C 0) vs = 0" "Inum (C 1) vs = 1" "Inum (C(Suc n)) vs = Suc n"
126.20 by simp+
126.21 @@ -312,9 +312,9 @@
126.22 by simp
126.23 lemma Irint_C1: "Irint (IC 1) vs = 1"
126.24 by simp
126.25 -lemma Irint_Cnumberof: "Irint (IC (number_of x)) vs = number_of x"
126.26 +lemma Irint_Cnumeral: "Irint (IC (numeral x)) vs = numeral x"
126.27 by simp
126.28 -lemmas Irint_simps = Irint_Var Irint_Neg Irint_Add Irint_Sub Irint_Mult Irint_C0 Irint_C1 Irint_Cnumberof
126.29 +lemmas Irint_simps = Irint_Var Irint_Neg Irint_Add Irint_Sub Irint_Mult Irint_C0 Irint_C1 Irint_Cnumeral
126.30 lemma "(3::int) * x + y*y - 9 + (- z) = 0"
126.31 apply (reify Irint_simps ("(3::int) * x + y*y - 9 + (- z)"))
126.32 oops
126.33 @@ -348,10 +348,10 @@
126.34 by simp
126.35 lemma Irnat_C1: "Irnat (NC 1) is ls vs = 1"
126.36 by simp
126.37 -lemma Irnat_Cnumberof: "Irnat (NC (number_of x)) is ls vs = number_of x"
126.38 +lemma Irnat_Cnumeral: "Irnat (NC (numeral x)) is ls vs = numeral x"
126.39 by simp
126.40 lemmas Irnat_simps = Irnat_Suc Irnat_Var Irnat_Neg Irnat_Add Irnat_Sub Irnat_Mult Irnat_lgth
126.41 - Irnat_C0 Irnat_C1 Irnat_Cnumberof
126.42 + Irnat_C0 Irnat_C1 Irnat_Cnumeral
126.43 lemma "(Suc n) * length (([(3::int) * x + y*y - 9 + (- z)] @ []) @ xs) = length xs"
126.44 apply (reify Irnat_simps Irlist.simps Irint_simps ("(Suc n) *length (([(3::int) * x + y*y - 9 + (- z)] @ []) @ xs)"))
126.45 oops
127.1 --- a/src/HOL/ex/Simproc_Tests.thy Mon Mar 26 15:32:54 2012 +0200
127.2 +++ b/src/HOL/ex/Simproc_Tests.thy Mon Mar 26 15:33:28 2012 +0200
127.3 @@ -5,7 +5,7 @@
127.4 header {* Testing of arithmetic simprocs *}
127.5
127.6 theory Simproc_Tests
127.7 -imports Main
127.8 +imports (*Main*) "../Numeral_Simprocs"
127.9 begin
127.10
127.11 text {*
127.12 @@ -43,7 +43,7 @@
127.13 possible. *)
127.14
127.15 notepad begin
127.16 - fix a b c d oo uu i j k l u v w x y z :: "'a::number_ring"
127.17 + fix a b c d oo uu i j k l u v w x y z :: "'a::comm_ring_1"
127.18 {
127.19 assume "a + - b = u" have "(a + c) - (b + c) = u"
127.20 by (tactic {* test [@{simproc int_combine_numerals}] *}) fact
127.21 @@ -107,7 +107,7 @@
127.22 subsection {* @{text inteq_cancel_numerals} *}
127.23
127.24 notepad begin
127.25 - fix i j k u vv w y z w' y' z' :: "'a::number_ring"
127.26 + fix i j k u vv w y z w' y' z' :: "'a::comm_ring_1"
127.27 {
127.28 assume "u = 0" have "2*u = u"
127.29 by (tactic {* test [@{simproc inteq_cancel_numerals}] *}) fact
127.30 @@ -130,7 +130,7 @@
127.31 subsection {* @{text intless_cancel_numerals} *}
127.32
127.33 notepad begin
127.34 - fix b c i j k u y :: "'a::{linordered_idom,number_ring}"
127.35 + fix b c i j k u y :: "'a::linordered_idom"
127.36 {
127.37 assume "y < 2 * b" have "y - b < b"
127.38 by (tactic {* test [@{simproc intless_cancel_numerals}] *}) fact
127.39 @@ -151,7 +151,7 @@
127.40 subsection {* @{text ring_eq_cancel_numeral_factor} *}
127.41
127.42 notepad begin
127.43 - fix x y :: "'a::{idom,ring_char_0,number_ring}"
127.44 + fix x y :: "'a::{idom,ring_char_0}"
127.45 {
127.46 assume "3*x = 4*y" have "9*x = 12 * y"
127.47 by (tactic {* test [@{simproc ring_eq_cancel_numeral_factor}] *}) fact
127.48 @@ -176,7 +176,7 @@
127.49 subsection {* @{text int_div_cancel_numeral_factors} *}
127.50
127.51 notepad begin
127.52 - fix x y z :: "'a::{semiring_div,ring_char_0,number_ring}"
127.53 + fix x y z :: "'a::{semiring_div,comm_ring_1,ring_char_0}"
127.54 {
127.55 assume "(3*x) div (4*y) = z" have "(9*x) div (12*y) = z"
127.56 by (tactic {* test [@{simproc int_div_cancel_numeral_factors}] *}) fact
127.57 @@ -199,7 +199,7 @@
127.58 subsection {* @{text ring_less_cancel_numeral_factor} *}
127.59
127.60 notepad begin
127.61 - fix x y :: "'a::{linordered_idom,number_ring}"
127.62 + fix x y :: "'a::linordered_idom"
127.63 {
127.64 assume "3*x < 4*y" have "9*x < 12 * y"
127.65 by (tactic {* test [@{simproc ring_less_cancel_numeral_factor}] *}) fact
127.66 @@ -224,7 +224,7 @@
127.67 subsection {* @{text ring_le_cancel_numeral_factor} *}
127.68
127.69 notepad begin
127.70 - fix x y :: "'a::{linordered_idom,number_ring}"
127.71 + fix x y :: "'a::linordered_idom"
127.72 {
127.73 assume "3*x \<le> 4*y" have "9*x \<le> 12 * y"
127.74 by (tactic {* test [@{simproc ring_le_cancel_numeral_factor}] *}) fact
127.75 @@ -255,7 +255,7 @@
127.76 subsection {* @{text divide_cancel_numeral_factor} *}
127.77
127.78 notepad begin
127.79 - fix x y z :: "'a::{field_inverse_zero,ring_char_0,number_ring}"
127.80 + fix x y z :: "'a::{field_inverse_zero,ring_char_0}"
127.81 {
127.82 assume "(3*x) / (4*y) = z" have "(9*x) / (12 * y) = z"
127.83 by (tactic {* test [@{simproc divide_cancel_numeral_factor}] *}) fact
127.84 @@ -322,6 +322,9 @@
127.85 }
127.86 end
127.87
127.88 +lemma shows "a*(b*c)/(y*z) = d*(b::'a::linordered_field_inverse_zero)*(x*a)/z"
127.89 +oops -- "FIXME: need simproc to cover this case"
127.90 +
127.91 subsection {* @{text divide_cancel_factor} *}
127.92
127.93 notepad begin
127.94 @@ -393,7 +396,7 @@
127.95 subsection {* @{text field_combine_numerals} *}
127.96
127.97 notepad begin
127.98 - fix x y z uu :: "'a::{field_inverse_zero,ring_char_0,number_ring}"
127.99 + fix x y z uu :: "'a::{field_inverse_zero,ring_char_0}"
127.100 {
127.101 assume "5 / 6 * x = uu" have "x / 2 + x / 3 = uu"
127.102 by (tactic {* test [@{simproc field_combine_numerals}] *}) fact
127.103 @@ -415,7 +418,7 @@
127.104 end
127.105
127.106 lemma
127.107 - fixes x :: "'a::{linordered_field_inverse_zero,number_ring}"
127.108 + fixes x :: "'a::{linordered_field_inverse_zero}"
127.109 shows "2/3 * x + x / 3 = uu"
127.110 apply (tactic {* test [@{simproc field_combine_numerals}] *})?
127.111 oops -- "FIXME: test fails"
127.112 @@ -448,17 +451,12 @@
127.113 }
127.114 end
127.115
127.116 -(*negative numerals: FAIL*)
127.117 -lemma "Suc (i + j + -3 + k) = u"
127.118 -apply (tactic {* test [@{simproc nat_combine_numerals}] *})?
127.119 -oops
127.120 -
127.121 subsection {* @{text nateq_cancel_numerals} *}
127.122
127.123 notepad begin
127.124 fix i j k l oo u uu vv w y z w' y' z' :: "nat"
127.125 {
127.126 - assume "Suc 0 * u = 0" have "2*u = u"
127.127 + assume "Suc 0 * u = 0" have "2*u = (u::nat)"
127.128 by (tactic {* test [@{simproc nateq_cancel_numerals}] *}) fact
127.129 next
127.130 assume "Suc 0 * u = Suc 0" have "2*u = Suc (u)"
127.131 @@ -504,7 +502,7 @@
127.132
127.133 notepad begin
127.134 fix length :: "'a \<Rightarrow> nat" and l1 l2 xs :: "'a" and f :: "nat \<Rightarrow> 'a"
127.135 - fix c i j k l oo u uu vv w y z w' y' z' :: "nat"
127.136 + fix c i j k l m oo u uu vv w y z w' y' z' :: "nat"
127.137 {
127.138 assume "0 < j" have "(2*length xs < 2*length xs + j)"
127.139 by (tactic {* test [@{simproc natless_cancel_numerals}] *}) fact
127.140 @@ -518,14 +516,6 @@
127.141 next
127.142 assume "0 < Suc 0 * (m * n) + u" have "(2*n*m) < (3*(m*n)) + u"
127.143 by (tactic {* test [@{simproc natless_cancel_numerals}] *}) fact
127.144 - next
127.145 - (* FIXME: negative numerals fail
127.146 - have "(i + j + -23 + (k::nat)) < u + 15 + y"
127.147 - apply (tactic {* test [@{simproc natless_cancel_numerals}] *})?
127.148 - sorry
127.149 - have "(i + j + 3 + (k::nat)) < u + -15 + y"
127.150 - apply (tactic {* test [@{simproc natless_cancel_numerals}] *})?
127.151 - sorry*)
127.152 }
127.153 end
127.154
127.155 @@ -611,17 +601,6 @@
127.156 next
127.157 assume "u + y - 0 = v" have "Suc (Suc (Suc (Suc (Suc (u + y))))) - 5 = v"
127.158 by (tactic {* test [@{simproc natdiff_cancel_numerals}] *}) fact
127.159 - next
127.160 - (* FIXME: negative numerals fail
127.161 - have "(i + j + -12 + k) - 15 = y"
127.162 - apply (tactic {* test [@{simproc natdiff_cancel_numerals}] *})?
127.163 - sorry
127.164 - have "(i + j + 12 + k) - -15 = y"
127.165 - apply (tactic {* test [@{simproc natdiff_cancel_numerals}] *})?
127.166 - sorry
127.167 - have "(i + j + -12 + k) - -15 = y"
127.168 - apply (tactic {* test [@{simproc natdiff_cancel_numerals}] *})?
127.169 - sorry*)
127.170 }
127.171 end
127.172
128.1 --- a/src/Pure/System/gui_setup.scala Mon Mar 26 15:32:54 2012 +0200
128.2 +++ b/src/Pure/System/gui_setup.scala Mon Mar 26 15:33:28 2012 +0200
128.3 @@ -43,6 +43,7 @@
128.4 text.append("Cygwin root: " + Cygwin.check_root() + "\n")
128.5 text.append("JVM name: " + Platform.jvm_name + "\n")
128.6 text.append("JVM platform: " + Platform.jvm_platform + "\n")
128.7 + text.append("JVM home: " + java.lang.System.getProperty("java.home") + "\n")
128.8 try {
128.9 Isabelle_System.init()
128.10 text.append("ML platform: " + Isabelle_System.getenv("ML_PLATFORM") + "\n")
128.11 @@ -50,7 +51,7 @@
128.12 val platform64 = Isabelle_System.getenv("ISABELLE_PLATFORM64")
128.13 if (platform64 != "") text.append("Isabelle platform (64 bit): " + platform64 + "\n")
128.14 text.append("Isabelle home: " + Isabelle_System.getenv("ISABELLE_HOME") + "\n")
128.15 - text.append("Isabelle java: " + Isabelle_System.getenv("THIS_JAVA") + "\n")
128.16 + text.append("Isabelle jdk home: " + Isabelle_System.getenv("ISABELLE_JDK_HOME") + "\n")
128.17 }
128.18 catch { case ERROR(msg) => text.append(msg + "\n") }
128.19
129.1 --- a/src/Pure/System/isabelle_system.scala Mon Mar 26 15:32:54 2012 +0200
129.2 +++ b/src/Pure/System/isabelle_system.scala Mon Mar 26 15:33:28 2012 +0200
129.3 @@ -51,7 +51,7 @@
129.4 val settings =
129.5 {
129.6 val env = Map(System.getenv.toList: _*) +
129.7 - ("THIS_JAVA" -> standard_system.this_java())
129.8 + ("ISABELLE_JDK_HOME" -> standard_system.this_jdk_home())
129.9
129.10 val isabelle_home =
129.11 if (this_isabelle_home != null) this_isabelle_home
130.1 --- a/src/Pure/System/standard_system.scala Mon Mar 26 15:32:54 2012 +0200
130.2 +++ b/src/Pure/System/standard_system.scala Mon Mar 26 15:33:28 2012 +0200
130.3 @@ -333,15 +333,17 @@
130.4 else jvm_path
130.5
130.6
130.7 - /* this_java executable */
130.8 + /* JDK home of running JVM */
130.9
130.10 - def this_java(): String =
130.11 + def this_jdk_home(): String =
130.12 {
130.13 val java_home = System.getProperty("java.home")
130.14 - val java_exe =
130.15 - if (Platform.is_windows) new File(java_home + "\\bin\\java.exe")
130.16 - else new File(java_home + "/bin/java")
130.17 - if (!java_exe.isFile) error("Expected this Java executable: " + java_exe.toString)
130.18 - posix_path(java_exe.getAbsolutePath)
130.19 + val home = new File(java_home)
130.20 + val parent = home.getParent
130.21 + val jdk_home =
130.22 + if (home.getName == "jre" && parent != null &&
130.23 + (new File(new File(parent, "bin"), "javac")).exists) parent
130.24 + else java_home
130.25 + posix_path(jdk_home)
130.26 }
130.27 }
131.1 --- a/src/Pure/build-jars Mon Mar 26 15:32:54 2012 +0200
131.2 +++ b/src/Pure/build-jars Mon Mar 26 15:33:28 2012 +0200
131.3 @@ -186,7 +186,7 @@
131.4 mkdir -p "$(dirname "$CHARSET_SERVICE")"
131.5 echo isabelle.Isabelle_Charset_Provider > "$CHARSET_SERVICE"
131.6
131.7 - jar cfe "$(jvmpath "$TARGET")" isabelle.GUI_Setup META-INF isabelle || \
131.8 + "$ISABELLE_JDK_HOME/bin/jar" cfe "$(jvmpath "$TARGET")" isabelle.GUI_Setup META-INF isabelle || \
131.9 fail "Failed to produce $TARGET"
131.10
131.11 cp "$SCALA_HOME/lib/scala-swing.jar" "$SCALA_HOME/lib/scala-library.jar" "$TARGET_DIR/ext"
132.1 --- a/src/Tools/Code/code_target.ML Mon Mar 26 15:32:54 2012 +0200
132.2 +++ b/src/Tools/Code/code_target.ML Mon Mar 26 15:33:28 2012 +0200
132.3 @@ -639,7 +639,7 @@
132.4 fun process_multi_syntax parse_thing parse_syntax change =
132.5 (Parse.and_list1 parse_thing
132.6 :|-- (fn things => Scan.repeat1 (@{keyword "("} |-- Parse.name --
132.7 - (zip_list things parse_syntax (@{keyword "and"})) --| @{keyword ")"})))
132.8 + (zip_list things parse_syntax @{keyword "and"}) --| @{keyword ")"})))
132.9 >> (Toplevel.theory oo fold)
132.10 (fn (target, syns) => fold (fn (raw_x, syn) => change target raw_x syn) syns);
132.11
133.1 --- a/src/Tools/JVM/java_ext_dirs Mon Mar 26 15:32:54 2012 +0200
133.2 +++ b/src/Tools/JVM/java_ext_dirs Mon Mar 26 15:33:28 2012 +0200
133.3 @@ -17,7 +17,7 @@
133.4
133.5 ## main
133.6
133.7 -JAVA_EXE="${THIS_JAVA:-$ISABELLE_JAVA}"
133.8 -exec "$JAVA_EXE" -classpath "$(jvmpath "$ISABELLE_HOME/src/Tools/JVM/java_ext_dirs.jar")" \
133.9 +exec "$ISABELLE_JDK_HOME/bin/java" \
133.10 + -classpath "$(jvmpath "$ISABELLE_HOME/src/Tools/JVM/java_ext_dirs.jar")" \
133.11 isabelle.Java_Ext_Dirs "$(jvmpath "$ISABELLE_HOME/lib/classes/ext")"
133.12
134.1 --- a/src/Tools/jEdit/lib/Tools/jedit Mon Mar 26 15:32:54 2012 +0200
134.2 +++ b/src/Tools/jEdit/lib/Tools/jedit Mon Mar 26 15:33:28 2012 +0200
134.3 @@ -248,7 +248,7 @@
134.4 ) || fail "Failed to compile sources"
134.5
134.6 cd dist/classes
134.7 - jar cf "../jars/Isabelle-jEdit.jar" * || failed
134.8 + "$ISABELLE_JDK_HOME/bin/jar" cf "../jars/Isabelle-jEdit.jar" * || failed
134.9 cd ../..
134.10 rm -rf dist/classes
134.11 fi