--- a/Admin/java/README Mon Mar 26 15:32:54 2012 +0200
+++ b/Admin/java/README Mon Mar 26 15:33:28 2012 +0200
@@ -1,2 +1,3 @@
-This is JRE 1.6.0_22 for Linux and Linux x86 from
-http://www.java.com/en/download/manual.jsp
+This is JDK 1.7.0_03 for Linux and Linux x86 from
+http://www.oracle.com/technetwork/java/javase/downloads/index.html
+
--- a/Admin/java/etc/settings Mon Mar 26 15:32:54 2012 +0200
+++ b/Admin/java/etc/settings Mon Mar 26 15:33:28 2012 +0200
@@ -1,2 +1,4 @@
-JAVA_HOME="$COMPONENT/${ISABELLE_PLATFORM64:-$ISABELLE_PLATFORM}/jre1.6.0_22"
-ISABELLE_JAVA="$JAVA_HOME/bin/java"
+# -*- shell-script -*- :mode=shellscript:
+
+ISABELLE_JDK_HOME="$COMPONENT/${ISABELLE_PLATFORM64:-$ISABELLE_PLATFORM}/jdk1.7.0_03"
+
--- a/NEWS Mon Mar 26 15:32:54 2012 +0200
+++ b/NEWS Mon Mar 26 15:33:28 2012 +0200
@@ -45,6 +45,10 @@
header -- minor INCOMPATIBILITY for user-defined commands. Allow new
commands to be used in the same theory where defined.
+* ISABELLE_JDK_HOME settings variable points to JDK with javac and jar
+(not just JRE), derived from JAVA_HOME from the shell environment or
+java.home of the running JVM.
+
*** Pure ***
@@ -90,6 +94,30 @@
*** HOL ***
+* The representation of numerals has changed. We now have a datatype
+"num" representing strictly positive binary numerals, along with
+functions "numeral :: num => 'a" and "neg_numeral :: num => 'a" to
+represent positive and negated numeric literals, respectively. (See
+definitions in Num.thy.) Potential INCOMPATIBILITY; some user theories
+may require adaptations:
+
+ - Theorems with number_ring or number_semiring constraints: These
+ classes are gone; use comm_ring_1 or comm_semiring_1 instead.
+
+ - Theories defining numeric types: Remove number, number_semiring,
+ and number_ring instances. Defer all theorems about numerals until
+ after classes one and semigroup_add have been instantiated.
+
+ - Numeral-only simp rules: Replace each rule having a "number_of v"
+ pattern with two copies, one for numeral and one for neg_numeral.
+
+ - Theorems about subclasses of semiring_1 or ring_1: These classes
+ automatically support numerals now, so more simp rules and
+ simprocs may now apply within the proof.
+
+ - Definitions and theorems using old constructors Pls/Min/Bit0/Bit1:
+ Redefine using other integer operations.
+
* Type 'a set is now a proper type constructor (just as before
Isabelle2008). Definitions mem_def and Collect_def have disappeared.
Non-trivial INCOMPATIBILITY. For developments keeping predicates and
--- a/etc/settings Mon Mar 26 15:32:54 2012 +0200
+++ b/etc/settings Mon Mar 26 15:33:28 2012 +0200
@@ -54,10 +54,12 @@
### JVM components (Scala or Java)
###
-if [ -n "$JAVA_HOME" ]; then
- ISABELLE_JAVA="$JAVA_HOME/bin/java"
-else
- ISABELLE_JAVA="java"
+if [ -z "$ISABELLE_JDK_HOME" -a -n "$JAVA_HOME" ]; then
+ if [ "$(basename "$JAVA_HOME")" = jre -a -e "$(dirname "$JAVA_HOME")"/bin/javac ]; then
+ ISABELLE_JDK_HOME="$(dirname "$JAVA_HOME")"
+ else
+ ISABELLE_JDK_HOME="$JAVA_HOME"
+ fi
fi
ISABELLE_SCALA_BUILD_OPTIONS="-nowarn -target:jvm-1.5"
--- a/lib/Tools/java Mon Mar 26 15:32:54 2012 +0200
+++ b/lib/Tools/java Mon Mar 26 15:33:28 2012 +0200
@@ -6,7 +6,7 @@
CLASSPATH="$(jvmpath "$CLASSPATH")"
-JAVA_EXE="${THIS_JAVA:-$ISABELLE_JAVA}"
+JAVA_EXE="$ISABELLE_JDK_HOME/bin/java"
if "$JAVA_EXE" -version >/dev/null 2>/dev/null; then
:
--- a/lib/browser/build Mon Mar 26 15:32:54 2012 +0200
+++ b/lib/browser/build Mon Mar 26 15:33:28 2012 +0200
@@ -65,9 +65,9 @@
rm -rf classes && mkdir classes
- javac -d classes -source 1.4 "${SOURCES[@]}" || \
+ "$ISABELLE_JDK_HOME/bin/javac" -d classes -source 1.4 "${SOURCES[@]}" || \
fail "Failed to compile sources"
- jar cf "$(jvmpath "$TARGET")" -C classes . ||
+ "$ISABELLE_JDK_HOME/bin/jar" cf "$(jvmpath "$TARGET")" -C classes . ||
fail "Failed to produce $TARGET"
rm -rf classes
--- a/src/HOL/Algebra/Group.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Algebra/Group.thy Mon Mar 26 15:33:28 2012 +0200
@@ -30,7 +30,7 @@
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>)}"
consts
- pow :: "[('a, 'm) monoid_scheme, 'a, 'b::number] => 'a" (infixr "'(^')\<index>" 75)
+ pow :: "[('a, 'm) monoid_scheme, 'a, 'b::semiring_1] => 'a" (infixr "'(^')\<index>" 75)
overloading nat_pow == "pow :: [_, 'a, nat] => 'a"
begin
--- a/src/HOL/Archimedean_Field.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Archimedean_Field.thy Mon Mar 26 15:33:28 2012 +0200
@@ -12,7 +12,7 @@
text {* Archimedean fields have no infinite elements. *}
-class archimedean_field = linordered_field + number_ring +
+class archimedean_field = linordered_field +
assumes ex_le_of_int: "\<exists>z. x \<le> of_int z"
lemma ex_less_of_int:
@@ -202,8 +202,11 @@
lemma floor_one [simp]: "floor 1 = 1"
using floor_of_int [of 1] by simp
-lemma floor_number_of [simp]: "floor (number_of v) = number_of v"
- using floor_of_int [of "number_of v"] by simp
+lemma floor_numeral [simp]: "floor (numeral v) = numeral v"
+ using floor_of_int [of "numeral v"] by simp
+
+lemma floor_neg_numeral [simp]: "floor (neg_numeral v) = neg_numeral v"
+ using floor_of_int [of "neg_numeral v"] by simp
lemma zero_le_floor [simp]: "0 \<le> floor x \<longleftrightarrow> 0 \<le> x"
by (simp add: le_floor_iff)
@@ -211,7 +214,12 @@
lemma one_le_floor [simp]: "1 \<le> floor x \<longleftrightarrow> 1 \<le> x"
by (simp add: le_floor_iff)
-lemma number_of_le_floor [simp]: "number_of v \<le> floor x \<longleftrightarrow> number_of v \<le> x"
+lemma numeral_le_floor [simp]:
+ "numeral v \<le> floor x \<longleftrightarrow> numeral v \<le> x"
+ by (simp add: le_floor_iff)
+
+lemma neg_numeral_le_floor [simp]:
+ "neg_numeral v \<le> floor x \<longleftrightarrow> neg_numeral v \<le> x"
by (simp add: le_floor_iff)
lemma zero_less_floor [simp]: "0 < floor x \<longleftrightarrow> 1 \<le> x"
@@ -220,8 +228,12 @@
lemma one_less_floor [simp]: "1 < floor x \<longleftrightarrow> 2 \<le> x"
by (simp add: less_floor_iff)
-lemma number_of_less_floor [simp]:
- "number_of v < floor x \<longleftrightarrow> number_of v + 1 \<le> x"
+lemma numeral_less_floor [simp]:
+ "numeral v < floor x \<longleftrightarrow> numeral v + 1 \<le> x"
+ by (simp add: less_floor_iff)
+
+lemma neg_numeral_less_floor [simp]:
+ "neg_numeral v < floor x \<longleftrightarrow> neg_numeral v + 1 \<le> x"
by (simp add: less_floor_iff)
lemma floor_le_zero [simp]: "floor x \<le> 0 \<longleftrightarrow> x < 1"
@@ -230,8 +242,12 @@
lemma floor_le_one [simp]: "floor x \<le> 1 \<longleftrightarrow> x < 2"
by (simp add: floor_le_iff)
-lemma floor_le_number_of [simp]:
- "floor x \<le> number_of v \<longleftrightarrow> x < number_of v + 1"
+lemma floor_le_numeral [simp]:
+ "floor x \<le> numeral v \<longleftrightarrow> x < numeral v + 1"
+ by (simp add: floor_le_iff)
+
+lemma floor_le_neg_numeral [simp]:
+ "floor x \<le> neg_numeral v \<longleftrightarrow> x < neg_numeral v + 1"
by (simp add: floor_le_iff)
lemma floor_less_zero [simp]: "floor x < 0 \<longleftrightarrow> x < 0"
@@ -240,8 +256,12 @@
lemma floor_less_one [simp]: "floor x < 1 \<longleftrightarrow> x < 1"
by (simp add: floor_less_iff)
-lemma floor_less_number_of [simp]:
- "floor x < number_of v \<longleftrightarrow> x < number_of v"
+lemma floor_less_numeral [simp]:
+ "floor x < numeral v \<longleftrightarrow> x < numeral v"
+ by (simp add: floor_less_iff)
+
+lemma floor_less_neg_numeral [simp]:
+ "floor x < neg_numeral v \<longleftrightarrow> x < neg_numeral v"
by (simp add: floor_less_iff)
text {* Addition and subtraction of integers *}
@@ -249,9 +269,13 @@
lemma floor_add_of_int [simp]: "floor (x + of_int z) = floor x + z"
using floor_correct [of x] by (simp add: floor_unique)
-lemma floor_add_number_of [simp]:
- "floor (x + number_of v) = floor x + number_of v"
- using floor_add_of_int [of x "number_of v"] by simp
+lemma floor_add_numeral [simp]:
+ "floor (x + numeral v) = floor x + numeral v"
+ using floor_add_of_int [of x "numeral v"] by simp
+
+lemma floor_add_neg_numeral [simp]:
+ "floor (x + neg_numeral v) = floor x + neg_numeral v"
+ using floor_add_of_int [of x "neg_numeral v"] by simp
lemma floor_add_one [simp]: "floor (x + 1) = floor x + 1"
using floor_add_of_int [of x 1] by simp
@@ -259,9 +283,13 @@
lemma floor_diff_of_int [simp]: "floor (x - of_int z) = floor x - z"
using floor_add_of_int [of x "- z"] by (simp add: algebra_simps)
-lemma floor_diff_number_of [simp]:
- "floor (x - number_of v) = floor x - number_of v"
- using floor_diff_of_int [of x "number_of v"] by simp
+lemma floor_diff_numeral [simp]:
+ "floor (x - numeral v) = floor x - numeral v"
+ using floor_diff_of_int [of x "numeral v"] by simp
+
+lemma floor_diff_neg_numeral [simp]:
+ "floor (x - neg_numeral v) = floor x - neg_numeral v"
+ using floor_diff_of_int [of x "neg_numeral v"] by simp
lemma floor_diff_one [simp]: "floor (x - 1) = floor x - 1"
using floor_diff_of_int [of x 1] by simp
@@ -320,8 +348,11 @@
lemma ceiling_one [simp]: "ceiling 1 = 1"
using ceiling_of_int [of 1] by simp
-lemma ceiling_number_of [simp]: "ceiling (number_of v) = number_of v"
- using ceiling_of_int [of "number_of v"] by simp
+lemma ceiling_numeral [simp]: "ceiling (numeral v) = numeral v"
+ using ceiling_of_int [of "numeral v"] by simp
+
+lemma ceiling_neg_numeral [simp]: "ceiling (neg_numeral v) = neg_numeral v"
+ using ceiling_of_int [of "neg_numeral v"] by simp
lemma ceiling_le_zero [simp]: "ceiling x \<le> 0 \<longleftrightarrow> x \<le> 0"
by (simp add: ceiling_le_iff)
@@ -329,8 +360,12 @@
lemma ceiling_le_one [simp]: "ceiling x \<le> 1 \<longleftrightarrow> x \<le> 1"
by (simp add: ceiling_le_iff)
-lemma ceiling_le_number_of [simp]:
- "ceiling x \<le> number_of v \<longleftrightarrow> x \<le> number_of v"
+lemma ceiling_le_numeral [simp]:
+ "ceiling x \<le> numeral v \<longleftrightarrow> x \<le> numeral v"
+ by (simp add: ceiling_le_iff)
+
+lemma ceiling_le_neg_numeral [simp]:
+ "ceiling x \<le> neg_numeral v \<longleftrightarrow> x \<le> neg_numeral v"
by (simp add: ceiling_le_iff)
lemma ceiling_less_zero [simp]: "ceiling x < 0 \<longleftrightarrow> x \<le> -1"
@@ -339,8 +374,12 @@
lemma ceiling_less_one [simp]: "ceiling x < 1 \<longleftrightarrow> x \<le> 0"
by (simp add: ceiling_less_iff)
-lemma ceiling_less_number_of [simp]:
- "ceiling x < number_of v \<longleftrightarrow> x \<le> number_of v - 1"
+lemma ceiling_less_numeral [simp]:
+ "ceiling x < numeral v \<longleftrightarrow> x \<le> numeral v - 1"
+ by (simp add: ceiling_less_iff)
+
+lemma ceiling_less_neg_numeral [simp]:
+ "ceiling x < neg_numeral v \<longleftrightarrow> x \<le> neg_numeral v - 1"
by (simp add: ceiling_less_iff)
lemma zero_le_ceiling [simp]: "0 \<le> ceiling x \<longleftrightarrow> -1 < x"
@@ -349,8 +388,12 @@
lemma one_le_ceiling [simp]: "1 \<le> ceiling x \<longleftrightarrow> 0 < x"
by (simp add: le_ceiling_iff)
-lemma number_of_le_ceiling [simp]:
- "number_of v \<le> ceiling x\<longleftrightarrow> number_of v - 1 < x"
+lemma numeral_le_ceiling [simp]:
+ "numeral v \<le> ceiling x \<longleftrightarrow> numeral v - 1 < x"
+ by (simp add: le_ceiling_iff)
+
+lemma neg_numeral_le_ceiling [simp]:
+ "neg_numeral v \<le> ceiling x \<longleftrightarrow> neg_numeral v - 1 < x"
by (simp add: le_ceiling_iff)
lemma zero_less_ceiling [simp]: "0 < ceiling x \<longleftrightarrow> 0 < x"
@@ -359,8 +402,12 @@
lemma one_less_ceiling [simp]: "1 < ceiling x \<longleftrightarrow> 1 < x"
by (simp add: less_ceiling_iff)
-lemma number_of_less_ceiling [simp]:
- "number_of v < ceiling x \<longleftrightarrow> number_of v < x"
+lemma numeral_less_ceiling [simp]:
+ "numeral v < ceiling x \<longleftrightarrow> numeral v < x"
+ by (simp add: less_ceiling_iff)
+
+lemma neg_numeral_less_ceiling [simp]:
+ "neg_numeral v < ceiling x \<longleftrightarrow> neg_numeral v < x"
by (simp add: less_ceiling_iff)
text {* Addition and subtraction of integers *}
@@ -368,9 +415,13 @@
lemma ceiling_add_of_int [simp]: "ceiling (x + of_int z) = ceiling x + z"
using ceiling_correct [of x] by (simp add: ceiling_unique)
-lemma ceiling_add_number_of [simp]:
- "ceiling (x + number_of v) = ceiling x + number_of v"
- using ceiling_add_of_int [of x "number_of v"] by simp
+lemma ceiling_add_numeral [simp]:
+ "ceiling (x + numeral v) = ceiling x + numeral v"
+ using ceiling_add_of_int [of x "numeral v"] by simp
+
+lemma ceiling_add_neg_numeral [simp]:
+ "ceiling (x + neg_numeral v) = ceiling x + neg_numeral v"
+ using ceiling_add_of_int [of x "neg_numeral v"] by simp
lemma ceiling_add_one [simp]: "ceiling (x + 1) = ceiling x + 1"
using ceiling_add_of_int [of x 1] by simp
@@ -378,9 +429,13 @@
lemma ceiling_diff_of_int [simp]: "ceiling (x - of_int z) = ceiling x - z"
using ceiling_add_of_int [of x "- z"] by (simp add: algebra_simps)
-lemma ceiling_diff_number_of [simp]:
- "ceiling (x - number_of v) = ceiling x - number_of v"
- using ceiling_diff_of_int [of x "number_of v"] by simp
+lemma ceiling_diff_numeral [simp]:
+ "ceiling (x - numeral v) = ceiling x - numeral v"
+ using ceiling_diff_of_int [of x "numeral v"] by simp
+
+lemma ceiling_diff_neg_numeral [simp]:
+ "ceiling (x - neg_numeral v) = ceiling x - neg_numeral v"
+ using ceiling_diff_of_int [of x "neg_numeral v"] by simp
lemma ceiling_diff_one [simp]: "ceiling (x - 1) = ceiling x - 1"
using ceiling_diff_of_int [of x 1] by simp
--- a/src/HOL/Code_Evaluation.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Code_Evaluation.thy Mon Mar 26 15:33:28 2012 +0200
@@ -146,33 +146,29 @@
"term_of_num_semiring two = (\<lambda>_. dummy_term)"
lemma (in term_syntax) term_of_num_semiring_code [code]:
- "term_of_num_semiring two k = (if k = 0 then termify Int.Pls
+ "term_of_num_semiring two k = (
+ if k = 1 then termify Num.One
else (if k mod two = 0
- then termify Int.Bit0 <\<cdot>> term_of_num_semiring two (k div two)
- else termify Int.Bit1 <\<cdot>> term_of_num_semiring two (k div two)))"
- by (auto simp add: term_of_anything Const_def App_def term_of_num_semiring_def Let_def)
+ then termify Num.Bit0 <\<cdot>> term_of_num_semiring two (k div two)
+ else termify Num.Bit1 <\<cdot>> term_of_num_semiring two (k div two)))"
+ by (auto simp add: term_of_anything Const_def App_def term_of_num_semiring_def)
lemma (in term_syntax) term_of_nat_code [code]:
- "term_of (n::nat) = termify (number_of :: int \<Rightarrow> nat) <\<cdot>> term_of_num_semiring (2::nat) n"
+ "term_of (n::nat) = (
+ if n = 0 then termify (0 :: nat)
+ else termify (numeral :: num \<Rightarrow> nat) <\<cdot>> term_of_num_semiring (2::nat) n)"
by (simp only: term_of_anything)
lemma (in term_syntax) term_of_code_numeral_code [code]:
- "term_of (k::code_numeral) = termify (number_of :: int \<Rightarrow> code_numeral) <\<cdot>> term_of_num_semiring (2::code_numeral) k"
+ "term_of (k::code_numeral) = (
+ if k = 0 then termify (0 :: code_numeral)
+ else termify (numeral :: num \<Rightarrow> code_numeral) <\<cdot>> term_of_num_semiring (2::code_numeral) k)"
by (simp only: term_of_anything)
-definition term_of_num_ring :: "'a\<Colon>ring_div \<Rightarrow> 'a \<Rightarrow> term" where
- "term_of_num_ring two = (\<lambda>_. dummy_term)"
-
-lemma (in term_syntax) term_of_num_ring_code [code]:
- "term_of_num_ring two k = (if k = 0 then termify Int.Pls
- else if k = -1 then termify Int.Min
- else if k mod two = 0 then termify Int.Bit0 <\<cdot>> term_of_num_ring two (k div two)
- else termify Int.Bit1 <\<cdot>> term_of_num_ring two (k div two))"
- by (auto simp add: term_of_anything Const_def App_def term_of_num_ring_def Let_def)
-
lemma (in term_syntax) term_of_int_code [code]:
"term_of (k::int) = (if k = 0 then termify (0 :: int)
- else termify (number_of :: int \<Rightarrow> int) <\<cdot>> term_of_num_ring (2::int) k)"
+ else if k < 0 then termify (neg_numeral :: num \<Rightarrow> int) <\<cdot>> term_of_num_semiring (2::int) (- k)
+ else termify (numeral :: num \<Rightarrow> int) <\<cdot>> term_of_num_semiring (2::int) k)"
by (simp only: term_of_anything)
@@ -201,6 +197,6 @@
hide_const dummy_term valapp
-hide_const (open) Const App Abs Free termify valtermify term_of term_of_num_semiring term_of_num_ring tracing
+hide_const (open) Const App Abs Free termify valtermify term_of term_of_num_semiring tracing
end
--- a/src/HOL/Code_Numeral.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Code_Numeral.thy Mon Mar 26 15:33:28 2012 +0200
@@ -123,25 +123,6 @@
by (rule equal_refl)
-subsection {* Code numerals as datatype of ints *}
-
-instantiation code_numeral :: number
-begin
-
-definition
- "number_of = of_nat o nat"
-
-instance ..
-
-end
-
-lemma nat_of_number [simp]:
- "nat_of (number_of k) = number_of k"
- by (simp add: number_of_code_numeral_def nat_number_of_def number_of_is_id)
-
-code_datatype "number_of \<Colon> int \<Rightarrow> code_numeral"
-
-
subsection {* Basic arithmetic *}
instantiation code_numeral :: "{minus, linordered_semidom, semiring_div, linorder}"
@@ -176,16 +157,17 @@
end
-lemma zero_code_numeral_code [code]:
- "(0\<Colon>code_numeral) = Numeral0"
- by (simp add: number_of_code_numeral_def Pls_def)
+lemma nat_of_numeral [simp]: "nat_of (numeral k) = numeral k"
+ by (induct k rule: num_induct) (simp_all add: numeral_inc)
-lemma [code_abbrev]: "Numeral0 = (0\<Colon>code_numeral)"
- using zero_code_numeral_code ..
+definition Num :: "num \<Rightarrow> code_numeral"
+ where [simp, code_abbrev]: "Num = numeral"
+
+code_datatype "0::code_numeral" Num
lemma one_code_numeral_code [code]:
"(1\<Colon>code_numeral) = Numeral1"
- by (simp add: number_of_code_numeral_def Pls_def Bit1_def)
+ by simp
lemma [code_abbrev]: "Numeral1 = (1\<Colon>code_numeral)"
using one_code_numeral_code ..
@@ -194,15 +176,8 @@
"of_nat n + of_nat m = of_nat (n + m)"
by simp
-definition subtract :: "code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral" where
- [simp]: "subtract = minus"
-
-lemma subtract_code [code nbe]:
- "subtract (of_nat n) (of_nat m) = of_nat (n - m)"
- by simp
-
-lemma minus_code_numeral_code [code]:
- "minus = subtract"
+lemma minus_code_numeral_code [code nbe]:
+ "of_nat n - of_nat m = of_nat (n - m)"
by simp
lemma times_code_numeral_code [code nbe]:
@@ -281,7 +256,7 @@
qed
-hide_const (open) of_nat nat_of Suc subtract int_of
+hide_const (open) of_nat nat_of Suc int_of
subsection {* Code generator setup *}
@@ -298,15 +273,21 @@
(Haskell -)
setup {*
- Numeral.add_code @{const_name number_code_numeral_inst.number_of_code_numeral}
+ Numeral.add_code @{const_name Num}
false Code_Printer.literal_naive_numeral "SML"
- #> fold (Numeral.add_code @{const_name number_code_numeral_inst.number_of_code_numeral}
+ #> fold (Numeral.add_code @{const_name Num}
false Code_Printer.literal_numeral) ["OCaml", "Haskell", "Scala"]
*}
code_reserved SML Int int
code_reserved Eval Integer
+code_const "0::code_numeral"
+ (SML "0")
+ (OCaml "Big'_int.zero'_big'_int")
+ (Haskell "0")
+ (Scala "BigInt(0)")
+
code_const "plus \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral"
(SML "Int.+/ ((_),/ (_))")
(OCaml "Big'_int.add'_big'_int")
@@ -314,12 +295,12 @@
(Scala infixl 7 "+")
(Eval infixl 8 "+")
-code_const "Code_Numeral.subtract \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral"
- (SML "Int.max/ (_/ -/ _,/ 0 : int)")
- (OCaml "Big'_int.max'_big'_int/ (Big'_int.sub'_big'_int/ _/ _)/ Big'_int.zero'_big'_int")
- (Haskell "max/ (_/ -/ _)/ (0 :: Integer)")
+code_const "minus \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral"
+ (SML "Int.max/ (0 : int,/ Int.-/ ((_),/ (_)))")
+ (OCaml "Big'_int.max'_big'_int/ Big'_int.zero'_big'_int/ (Big'_int.sub'_big'_int/ _/ _)")
+ (Haskell "max/ (0 :: Integer)/ (_/ -/ _)")
(Scala "!(_/ -/ _).max(0)")
- (Eval "Integer.max/ (_/ -/ _)/ 0")
+ (Eval "Integer.max/ 0/ (_/ -/ _)")
code_const "times \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral"
(SML "Int.*/ ((_),/ (_))")
--- a/src/HOL/Codegenerator_Test/Generate_Pretty.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Codegenerator_Test/Generate_Pretty.thy Mon Mar 26 15:33:28 2012 +0200
@@ -10,9 +10,8 @@
lemma [code, code del]: "nat_of_char = nat_of_char" ..
lemma [code, code del]: "char_of_nat = char_of_nat" ..
-declare Quickcheck_Narrowing.zero_code_int_code[code del]
-declare Quickcheck_Narrowing.one_code_int_code[code del]
-declare Quickcheck_Narrowing.int_of_code[code del]
+declare Quickcheck_Narrowing.one_code_int_code [code del]
+declare Quickcheck_Narrowing.int_of_code [code del]
subsection {* Check whether generated code compiles *}
--- a/src/HOL/Complex.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Complex.thy Mon Mar 26 15:33:28 2012 +0200
@@ -151,17 +151,6 @@
subsection {* Numerals and Arithmetic *}
-instantiation complex :: number_ring
-begin
-
-definition complex_number_of_def:
- "number_of w = (of_int w \<Colon> complex)"
-
-instance
- by intro_classes (simp only: complex_number_of_def)
-
-end
-
lemma complex_Re_of_nat [simp]: "Re (of_nat n) = of_nat n"
by (induct n) simp_all
@@ -174,14 +163,24 @@
lemma complex_Im_of_int [simp]: "Im (of_int z) = 0"
by (cases z rule: int_diff_cases) simp
-lemma complex_Re_number_of [simp]: "Re (number_of v) = number_of v"
- unfolding number_of_eq by (rule complex_Re_of_int)
+lemma complex_Re_numeral [simp]: "Re (numeral v) = numeral v"
+ using complex_Re_of_int [of "numeral v"] by simp
+
+lemma complex_Re_neg_numeral [simp]: "Re (neg_numeral v) = neg_numeral v"
+ using complex_Re_of_int [of "neg_numeral v"] by simp
+
+lemma complex_Im_numeral [simp]: "Im (numeral v) = 0"
+ using complex_Im_of_int [of "numeral v"] by simp
-lemma complex_Im_number_of [simp]: "Im (number_of v) = 0"
- unfolding number_of_eq by (rule complex_Im_of_int)
+lemma complex_Im_neg_numeral [simp]: "Im (neg_numeral v) = 0"
+ using complex_Im_of_int [of "neg_numeral v"] by simp
-lemma Complex_eq_number_of [simp]:
- "(Complex a b = number_of w) = (a = number_of w \<and> b = 0)"
+lemma Complex_eq_numeral [simp]:
+ "(Complex a b = numeral w) = (a = numeral w \<and> b = 0)"
+ by (simp add: complex_eq_iff)
+
+lemma Complex_eq_neg_numeral [simp]:
+ "(Complex a b = neg_numeral w) = (a = neg_numeral w \<and> b = 0)"
by (simp add: complex_eq_iff)
@@ -421,7 +420,10 @@
lemma complex_i_not_one [simp]: "ii \<noteq> 1"
by (simp add: complex_eq_iff)
-lemma complex_i_not_number_of [simp]: "ii \<noteq> number_of w"
+lemma complex_i_not_numeral [simp]: "ii \<noteq> numeral w"
+ by (simp add: complex_eq_iff)
+
+lemma complex_i_not_neg_numeral [simp]: "ii \<noteq> neg_numeral w"
by (simp add: complex_eq_iff)
lemma i_mult_Complex [simp]: "ii * Complex a b = Complex (- b) a"
@@ -505,7 +507,10 @@
lemma complex_cnj_of_int [simp]: "cnj (of_int z) = of_int z"
by (simp add: complex_eq_iff)
-lemma complex_cnj_number_of [simp]: "cnj (number_of w) = number_of w"
+lemma complex_cnj_numeral [simp]: "cnj (numeral w) = numeral w"
+ by (simp add: complex_eq_iff)
+
+lemma complex_cnj_neg_numeral [simp]: "cnj (neg_numeral w) = neg_numeral w"
by (simp add: complex_eq_iff)
lemma complex_cnj_scaleR: "cnj (scaleR r x) = scaleR r (cnj x)"
@@ -686,10 +691,10 @@
"(of_nat n :: 'a::linordered_idom) < of_int x \<longleftrightarrow> int n < x"
by (metis of_int_of_nat_eq of_int_less_iff)
-lemma real_of_nat_less_number_of_iff [simp]: (* TODO: move *)
- "real (n::nat) < number_of w \<longleftrightarrow> n < number_of w"
- unfolding real_of_nat_def nat_number_of_def number_of_eq
- by (simp add: of_nat_less_of_int_iff zless_nat_eq_int_zless)
+lemma real_of_nat_less_numeral_iff [simp]: (* TODO: move *)
+ "real (n::nat) < numeral w \<longleftrightarrow> n < numeral w"
+ using of_nat_less_of_int_iff [of n "numeral w", where 'a=real]
+ by (simp add: real_of_nat_def zless_nat_eq_int_zless [symmetric])
lemma arg_unique:
assumes "sgn z = cis x" and "-pi < x" and "x \<le> pi"
--- a/src/HOL/Decision_Procs/Approximation.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Decision_Procs/Approximation.thy Mon Mar 26 15:33:28 2012 +0200
@@ -1350,7 +1350,7 @@
also have "\<dots> \<le> cos ((?ux - 2 * ?lpi))"
using cos_monotone_minus_pi_0'[OF pi_x x_le_ux ux_0]
by (simp only: real_of_float_minus real_of_int_minus real_of_one
- number_of_Min diff_minus mult_minus_left mult_1_left)
+ minus_one [symmetric] diff_minus mult_minus_left mult_1_left)
also have "\<dots> = cos ((- (?ux - 2 * ?lpi)))"
unfolding real_of_float_minus cos_minus ..
also have "\<dots> \<le> (ub_cos prec (- (?ux - 2 * ?lpi)))"
@@ -1394,7 +1394,7 @@
also have "\<dots> \<le> cos ((?lx + 2 * ?lpi))"
using cos_monotone_0_pi'[OF lx_0 lx_le_x pi_x]
by (simp only: real_of_float_minus real_of_int_minus real_of_one
- number_of_Min diff_minus mult_minus_left mult_1_left)
+ minus_one [symmetric] diff_minus mult_minus_left mult_1_left)
also have "\<dots> \<le> (ub_cos prec (?lx + 2 * ?lpi))"
using lb_cos[OF lx_0 pi_lx] by simp
finally show ?thesis unfolding u by (simp add: real_of_float_max)
@@ -2117,7 +2117,8 @@
lemma interpret_floatarith_num:
shows "interpret_floatarith (Num (Float 0 0)) vs = 0"
and "interpret_floatarith (Num (Float 1 0)) vs = 1"
- and "interpret_floatarith (Num (Float (number_of a) 0)) vs = number_of a" by auto
+ and "interpret_floatarith (Num (Float (numeral a) 0)) vs = numeral a"
+ and "interpret_floatarith (Num (Float (neg_numeral a) 0)) vs = neg_numeral a" by auto
subsection "Implement approximation function"
--- a/src/HOL/Decision_Procs/Cooper.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Decision_Procs/Cooper.thy Mon Mar 26 15:33:28 2012 +0200
@@ -1883,7 +1883,8 @@
| SOME n => @{code Bound} n)
| num_of_term vs @{term "0::int"} = @{code C} 0
| num_of_term vs @{term "1::int"} = @{code C} 1
- | num_of_term vs (@{term "number_of :: int \<Rightarrow> int"} $ t) = @{code C} (HOLogic.dest_numeral t)
+ | num_of_term vs (@{term "numeral :: _ \<Rightarrow> int"} $ t) = @{code C} (HOLogic.dest_num t)
+ | num_of_term vs (@{term "neg_numeral :: _ \<Rightarrow> int"} $ t) = @{code C} (~(HOLogic.dest_num t))
| num_of_term vs (Bound i) = @{code Bound} i
| num_of_term vs (@{term "uminus :: int \<Rightarrow> int"} $ t') = @{code Neg} (num_of_term vs t')
| num_of_term vs (@{term "op + :: int \<Rightarrow> int \<Rightarrow> int"} $ t1 $ t2) =
--- a/src/HOL/Decision_Procs/Dense_Linear_Order.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Decision_Procs/Dense_Linear_Order.thy Mon Mar 26 15:33:28 2012 +0200
@@ -636,14 +636,8 @@
interpretation class_dense_linordered_field: constr_dense_linorder
"op <=" "op <"
- "\<lambda> x y. 1/2 * ((x::'a::{linordered_field,number_ring}) + y)"
-proof (unfold_locales, dlo, dlo, auto)
- fix x y::'a assume lt: "x < y"
- from less_half_sum[OF lt] show "x < (x + y) /2" by simp
-next
- fix x y::'a assume lt: "x < y"
- from gt_half_sum[OF lt] show "(x + y) /2 < y" by simp
-qed
+ "\<lambda> x y. 1/2 * ((x::'a::{linordered_field}) + y)"
+by (unfold_locales, dlo, dlo, auto)
declaration{*
let
--- a/src/HOL/Decision_Procs/Ferrack.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Decision_Procs/Ferrack.thy Mon Mar 26 15:33:28 2012 +0200
@@ -1732,7 +1732,7 @@
(set U \<times> set U)"using mnz nnz th
apply (auto simp add: th add_divide_distrib algebra_simps split_def image_def)
by (rule_tac x="(s,m)" in bexI,simp_all)
- (rule_tac x="(t,n)" in bexI,simp_all)
+ (rule_tac x="(t,n)" in bexI,simp_all add: mult_commute)
next
fix t n s m
assume tnU: "(t,n) \<in> set U" and smU:"(s,m) \<in> set U"
@@ -1937,11 +1937,12 @@
| num_of_term vs (@{term "op * :: real \<Rightarrow> real \<Rightarrow> real"} $ t1 $ t2) = (case num_of_term vs t1
of @{code C} i => @{code Mul} (i, num_of_term vs t2)
| _ => error "num_of_term: unsupported multiplication")
- | num_of_term vs (@{term "real :: int \<Rightarrow> real"} $ (@{term "number_of :: int \<Rightarrow> int"} $ t')) =
- @{code C} (HOLogic.dest_numeral t')
- | num_of_term vs (@{term "number_of :: int \<Rightarrow> real"} $ t') =
- @{code C} (HOLogic.dest_numeral t')
- | num_of_term vs t = error ("num_of_term: unknown term");
+ | num_of_term vs (@{term "real :: int \<Rightarrow> real"} $ t') =
+ (@{code C} (snd (HOLogic.dest_number t'))
+ handle TERM _ => error ("num_of_term: unknown term"))
+ | num_of_term vs t' =
+ (@{code C} (snd (HOLogic.dest_number t'))
+ handle TERM _ => error ("num_of_term: unknown term"));
fun fm_of_term vs @{term True} = @{code T}
| fm_of_term vs @{term False} = @{code F}
--- a/src/HOL/Decision_Procs/MIR.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Decision_Procs/MIR.thy Mon Mar 26 15:33:28 2012 +0200
@@ -4901,7 +4901,7 @@
(set U \<times> set U)"using mnz nnz th
apply (auto simp add: th add_divide_distrib algebra_simps split_def image_def)
by (rule_tac x="(s,m)" in bexI,simp_all)
- (rule_tac x="(t,n)" in bexI,simp_all)
+ (rule_tac x="(t,n)" in bexI,simp_all add: mult_commute)
next
fix t n s m
assume tnU: "(t,n) \<in> set U" and smU:"(s,m) \<in> set U"
@@ -5536,14 +5536,18 @@
(case (num_of_term vs t1)
of @{code C} i => @{code Mul} (i, num_of_term vs t2)
| _ => error "num_of_term: unsupported Multiplication")
- | num_of_term vs (@{term "real :: int \<Rightarrow> real"} $ (@{term "number_of :: int \<Rightarrow> int"} $ t')) =
- @{code C} (HOLogic.dest_numeral t')
+ | num_of_term vs (@{term "real :: int \<Rightarrow> real"} $ (@{term "numeral :: _ \<Rightarrow> int"} $ t')) =
+ @{code C} (HOLogic.dest_num t')
+ | num_of_term vs (@{term "real :: int \<Rightarrow> real"} $ (@{term "neg_numeral :: _ \<Rightarrow> int"} $ t')) =
+ @{code C} (~ (HOLogic.dest_num t'))
| num_of_term vs (@{term "real :: int \<Rightarrow> real"} $ (@{term "floor :: real \<Rightarrow> int"} $ t')) =
@{code Floor} (num_of_term vs t')
| num_of_term vs (@{term "real :: int \<Rightarrow> real"} $ (@{term "ceiling :: real \<Rightarrow> int"} $ t')) =
@{code Neg} (@{code Floor} (@{code Neg} (num_of_term vs t')))
- | num_of_term vs (@{term "number_of :: int \<Rightarrow> real"} $ t') =
- @{code C} (HOLogic.dest_numeral t')
+ | num_of_term vs (@{term "numeral :: _ \<Rightarrow> real"} $ t') =
+ @{code C} (HOLogic.dest_num t')
+ | num_of_term vs (@{term "neg_numeral :: _ \<Rightarrow> real"} $ t') =
+ @{code C} (~ (HOLogic.dest_num t'))
| num_of_term vs t = error ("num_of_term: unknown term " ^ Syntax.string_of_term @{context} t);
fun fm_of_term vs @{term True} = @{code T}
@@ -5554,8 +5558,10 @@
@{code Le} (@{code Sub} (num_of_term vs t1, num_of_term vs t2))
| fm_of_term vs (@{term "op = :: real \<Rightarrow> real \<Rightarrow> bool"} $ t1 $ t2) =
@{code Eq} (@{code Sub} (num_of_term vs t1, num_of_term vs t2))
- | fm_of_term vs (@{term "op rdvd"} $ (@{term "real :: int \<Rightarrow> real"} $ (@{term "number_of :: int \<Rightarrow> int"} $ t1)) $ t2) =
- @{code Dvd} (HOLogic.dest_numeral t1, num_of_term vs t2)
+ | fm_of_term vs (@{term "op rdvd"} $ (@{term "real :: int \<Rightarrow> real"} $ (@{term "numeral :: _ \<Rightarrow> int"} $ t1)) $ t2) =
+ @{code Dvd} (HOLogic.dest_num t1, num_of_term vs t2)
+ | fm_of_term vs (@{term "op rdvd"} $ (@{term "real :: int \<Rightarrow> real"} $ (@{term "neg_numeral :: _ \<Rightarrow> int"} $ t1)) $ t2) =
+ @{code Dvd} (~ (HOLogic.dest_num t1), num_of_term vs t2)
| fm_of_term vs (@{term "op = :: bool \<Rightarrow> bool \<Rightarrow> bool"} $ t1 $ t2) =
@{code Iff} (fm_of_term vs t1, fm_of_term vs t2)
| fm_of_term vs (@{term HOL.conj} $ t1 $ t2) =
--- a/src/HOL/Decision_Procs/Parametric_Ferrante_Rackoff.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Decision_Procs/Parametric_Ferrante_Rackoff.thy Mon Mar 26 15:33:28 2012 +0200
@@ -25,7 +25,7 @@
| "tmsize (CNP n c a) = 3 + polysize c + tmsize a "
(* Semantics of terms tm *)
-primrec Itm :: "'a::{field_char_0, field_inverse_zero, number_ring} list \<Rightarrow> 'a list \<Rightarrow> tm \<Rightarrow> 'a" where
+primrec Itm :: "'a::{field_char_0, field_inverse_zero} list \<Rightarrow> 'a list \<Rightarrow> tm \<Rightarrow> 'a" where
"Itm vs bs (CP c) = (Ipoly vs c)"
| "Itm vs bs (Bound n) = bs!n"
| "Itm vs bs (Neg a) = -(Itm vs bs a)"
@@ -430,7 +430,7 @@
by (induct p rule: fmsize.induct) simp_all
(* Semantics of formulae (fm) *)
-primrec Ifm ::"'a::{linordered_field_inverse_zero, number_ring} list \<Rightarrow> 'a list \<Rightarrow> fm \<Rightarrow> bool" where
+primrec Ifm ::"'a::{linordered_field_inverse_zero} list \<Rightarrow> 'a list \<Rightarrow> fm \<Rightarrow> bool" where
"Ifm vs bs T = True"
| "Ifm vs bs F = False"
| "Ifm vs bs (Lt a) = (Itm vs bs a < 0)"
@@ -1937,7 +1937,7 @@
also have "\<dots> \<longleftrightarrow> - (?a * ?s) + 2*?d*?r = 0" using d by simp
finally have ?thesis using c d
- 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)
+ 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)
}
moreover
{assume c: "?c \<noteq> 0" and d: "?d=0"
@@ -1950,7 +1950,7 @@
by (simp add: field_simps right_distrib[of "2*?c"] del: right_distrib)
also have "\<dots> \<longleftrightarrow> - (?a * ?t) + 2*?c*?r = 0" using c by simp
finally have ?thesis using c d
- by (simp add: r[of "- (?t/ (2*?c))"] msubsteq_def Let_def evaldjf_ex del: one_add_one_is_two)
+ by (simp add: r[of "- (?t/ (2*?c))"] msubsteq_def Let_def evaldjf_ex)
}
moreover
{assume c: "?c \<noteq> 0" and d: "?d\<noteq>0" hence dc: "?c * ?d *2 \<noteq> 0" by simp
@@ -2019,7 +2019,7 @@
also have "\<dots> \<longleftrightarrow> - (?a * ?s) + 2*?d*?r \<noteq> 0" using d by simp
finally have ?thesis using c d
- 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)
+ 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)
}
moreover
{assume c: "?c \<noteq> 0" and d: "?d=0"
@@ -2032,7 +2032,7 @@
by (simp add: field_simps right_distrib[of "2*?c"] del: right_distrib)
also have "\<dots> \<longleftrightarrow> - (?a * ?t) + 2*?c*?r \<noteq> 0" using c by simp
finally have ?thesis using c d
- by (simp add: r[of "- (?t/ (2*?c))"] msubstneq_def Let_def evaldjf_ex del: one_add_one_is_two)
+ by (simp add: r[of "- (?t/ (2*?c))"] msubstneq_def Let_def evaldjf_ex)
}
moreover
{assume c: "?c \<noteq> 0" and d: "?d\<noteq>0" hence dc: "?c * ?d *2 \<noteq> 0" by simp
@@ -2616,10 +2616,10 @@
using lp tnb
by (simp add: msubst2_def msubstneg_nb msubstpos_nb conj_nb disj_nb lt_nb simpfm_bound0)
-lemma mult_minus2_left: "-2 * (x::'a::number_ring) = - (2 * x)"
+lemma mult_minus2_left: "-2 * (x::'a::comm_ring_1) = - (2 * x)"
by simp
-lemma mult_minus2_right: "(x::'a::number_ring) * -2 = - (x * 2)"
+lemma mult_minus2_right: "(x::'a::comm_ring_1) * -2 = - (x * 2)"
by simp
lemma islin_qf: "islin p \<Longrightarrow> qfree p"
@@ -3005,11 +3005,11 @@
*} "parametric QE for linear Arithmetic over fields, Version 2"
-lemma "\<exists>(x::'a::{linordered_field_inverse_zero, number_ring}). y \<noteq> -1 \<longrightarrow> (y + 1)*x < 0"
- apply (frpar type: "'a::{linordered_field_inverse_zero, number_ring}" pars: "y::'a::{linordered_field_inverse_zero, number_ring}")
+lemma "\<exists>(x::'a::{linordered_field_inverse_zero}). y \<noteq> -1 \<longrightarrow> (y + 1)*x < 0"
+ apply (frpar type: "'a::{linordered_field_inverse_zero}" pars: "y::'a::{linordered_field_inverse_zero}")
apply (simp add: field_simps)
apply (rule spec[where x=y])
- apply (frpar type: "'a::{linordered_field_inverse_zero, number_ring}" pars: "z::'a::{linordered_field_inverse_zero, number_ring}")
+ apply (frpar type: "'a::{linordered_field_inverse_zero}" pars: "z::'a::{linordered_field_inverse_zero}")
by simp
text{* Collins/Jones Problem *}
@@ -3030,11 +3030,11 @@
oops
*)
-lemma "\<exists>(x::'a::{linordered_field_inverse_zero, number_ring}). y \<noteq> -1 \<longrightarrow> (y + 1)*x < 0"
- apply (frpar2 type: "'a::{linordered_field_inverse_zero, number_ring}" pars: "y::'a::{linordered_field_inverse_zero, number_ring}")
+lemma "\<exists>(x::'a::{linordered_field_inverse_zero}). y \<noteq> -1 \<longrightarrow> (y + 1)*x < 0"
+ apply (frpar2 type: "'a::{linordered_field_inverse_zero}" pars: "y::'a::{linordered_field_inverse_zero}")
apply (simp add: field_simps)
apply (rule spec[where x=y])
- apply (frpar2 type: "'a::{linordered_field_inverse_zero, number_ring}" pars: "z::'a::{linordered_field_inverse_zero, number_ring}")
+ apply (frpar2 type: "'a::{linordered_field_inverse_zero}" pars: "z::'a::{linordered_field_inverse_zero}")
by simp
text{* Collins/Jones Problem *}
--- a/src/HOL/Decision_Procs/cooper_tac.ML Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Decision_Procs/cooper_tac.ML Mon Mar 26 15:33:28 2012 +0200
@@ -18,15 +18,12 @@
val cooper_ss = @{simpset};
val nT = HOLogic.natT;
-val binarith = @{thms normalize_bin_simps};
-val comp_arith = binarith @ @{thms simp_thms};
+val comp_arith = @{thms simp_thms}
val zdvd_int = @{thm zdvd_int};
val zdiff_int_split = @{thm zdiff_int_split};
val all_nat = @{thm all_nat};
val ex_nat = @{thm ex_nat};
-val number_of1 = @{thm number_of1};
-val number_of2 = @{thm number_of2};
val split_zdiv = @{thm split_zdiv};
val split_zmod = @{thm split_zmod};
val mod_div_equality' = @{thm mod_div_equality'};
@@ -90,14 +87,13 @@
[split_zdiv, split_zmod, split_div', @{thm "split_min"}, @{thm "split_max"}]
(* Simp rules for changing (n::int) to int n *)
val simpset1 = HOL_basic_ss
- addsimps [@{thm nat_number_of_def}, zdvd_int] @ map (fn r => r RS sym)
- [@{thm int_int_eq}, @{thm zle_int}, @{thm zless_int}, @{thm zadd_int}, @{thm zmult_int}]
+ addsimps [zdvd_int] @ map (fn r => r RS sym)
+ [@{thm int_numeral}, @{thm int_int_eq}, @{thm zle_int}, @{thm zless_int}, @{thm zadd_int}, @{thm zmult_int}]
|> Splitter.add_split zdiff_int_split
(*simp rules for elimination of int n*)
val simpset2 = HOL_basic_ss
- addsimps [@{thm nat_0_le}, @{thm all_nat}, @{thm ex_nat},
- @{thm number_of1}, @{thm number_of2}, @{thm int_0}, @{thm int_1}]
+ 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}]
|> fold Simplifier.add_cong [@{thm conj_le_cong}, @{thm imp_le_cong}]
(* simp rules for elimination of abs *)
val simpset3 = HOL_basic_ss |> Splitter.add_split @{thm abs_split}
--- a/src/HOL/Decision_Procs/ex/Dense_Linear_Order_Ex.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Decision_Procs/ex/Dense_Linear_Order_Ex.thy Mon Mar 26 15:33:28 2012 +0200
@@ -7,147 +7,147 @@
begin
lemma
- "\<exists>(y::'a::{linordered_field_inverse_zero, number_ring}) <2. x + 3* y < 0 \<and> x - y >0"
+ "\<exists>(y::'a::{linordered_field_inverse_zero}) <2. x + 3* y < 0 \<and> x - y >0"
by ferrack
-lemma "~ (ALL x (y::'a::{linordered_field_inverse_zero, number_ring}). x < y --> 10*x < 11*y)"
+lemma "~ (ALL x (y::'a::{linordered_field_inverse_zero}). x < y --> 10*x < 11*y)"
by ferrack
-lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}) y. x < y --> (10*(x + 5*y + -1) < 60*y)"
+lemma "ALL (x::'a::{linordered_field_inverse_zero}) y. x < y --> (10*(x + 5*y + -1) < 60*y)"
by ferrack
-lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring}) y. x ~= y --> x < y"
+lemma "EX (x::'a::{linordered_field_inverse_zero}) y. x ~= y --> x < y"
by ferrack
-lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring}) y. (x ~= y & 10*x ~= 9*y & 10*x < y) --> x < y"
+lemma "EX (x::'a::{linordered_field_inverse_zero}) y. (x ~= y & 10*x ~= 9*y & 10*x < y) --> x < y"
by ferrack
-lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}) y. (x ~= y & 5*x <= y) --> 500*x <= 100*y"
+lemma "ALL (x::'a::{linordered_field_inverse_zero}) y. (x ~= y & 5*x <= y) --> 500*x <= 100*y"
by ferrack
-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)"
+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)"
by ferrack
-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)"
+lemma "ALL (x::'a::{linordered_field_inverse_zero}) < 0. (EX (y::'a::{linordered_field_inverse_zero}) > 0. 7*x + y > 0 & x - y <= 9)"
by ferrack
-lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring}). (0 < x & x < 1) --> (ALL y > 1. x + y ~= 1)"
+lemma "EX (x::'a::{linordered_field_inverse_zero}). (0 < x & x < 1) --> (ALL y > 1. x + y ~= 1)"
by ferrack
-lemma "EX x. (ALL (y::'a::{linordered_field_inverse_zero, number_ring}). y < 2 --> 2*(y - x) \<le> 0 )"
+lemma "EX x. (ALL (y::'a::{linordered_field_inverse_zero}). y < 2 --> 2*(y - x) \<le> 0 )"
by ferrack
-lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}). x < 10 | x > 20 | (EX y. y>= 0 & y <= 10 & x+y = 20)"
+lemma "ALL (x::'a::{linordered_field_inverse_zero}). x < 10 | x > 20 | (EX y. y>= 0 & y <= 10 & x+y = 20)"
by ferrack
-lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}) y z. x + y < z --> y >= z --> x < 0"
+lemma "ALL (x::'a::{linordered_field_inverse_zero}) y z. x + y < z --> y >= z --> x < 0"
by ferrack
-lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring}) y z. x + 7*y < 5* z & 5*y >= 7*z & x < 0"
+lemma "EX (x::'a::{linordered_field_inverse_zero}) y z. x + 7*y < 5* z & 5*y >= 7*z & x < 0"
by ferrack
-lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}) y z. abs (x + y) <= z --> (abs z = z)"
+lemma "ALL (x::'a::{linordered_field_inverse_zero}) y z. abs (x + y) <= z --> (abs z = z)"
by ferrack
-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"
+lemma "EX (x::'a::{linordered_field_inverse_zero}) y z. x + 7*y - 5* z < 0 & 5*y + 7*z + 3*x < 0"
by ferrack
-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))"
+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))"
by ferrack
-lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}) y. x < y --> (EX z>0. x+z = y)"
+lemma "ALL (x::'a::{linordered_field_inverse_zero}) y. x < y --> (EX z>0. x+z = y)"
by ferrack
-lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}) y. x < y --> (EX z>0. x+z = y)"
+lemma "ALL (x::'a::{linordered_field_inverse_zero}) y. x < y --> (EX z>0. x+z = y)"
by ferrack
-lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}) y. (EX z>0. abs (x - y) <= z )"
+lemma "ALL (x::'a::{linordered_field_inverse_zero}) y. (EX z>0. abs (x - y) <= z )"
by ferrack
-lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring}) y. (ALL z<0. (z < x --> z <= y) & (z > y --> z >= x))"
+lemma "EX (x::'a::{linordered_field_inverse_zero}) y. (ALL z<0. (z < x --> z <= y) & (z > y --> z >= x))"
by ferrack
-lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring}) y. (ALL z>=0. abs (3*x+7*y) <= 2*z + 1)"
+lemma "EX (x::'a::{linordered_field_inverse_zero}) y. (ALL z>=0. abs (3*x+7*y) <= 2*z + 1)"
by ferrack
-lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring}) y. (ALL z<0. (z < x --> z <= y) & (z > y --> z >= x))"
+lemma "EX (x::'a::{linordered_field_inverse_zero}) y. (ALL z<0. (z < x --> z <= y) & (z > y --> z >= x))"
by ferrack
-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))"
+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))"
by ferrack
-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))"
+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))"
by ferrack
-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))"
+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))"
by ferrack
-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) ))"
+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) ))"
by ferrack
-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))"
+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))"
by ferrack
-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"
+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"
by ferrack
-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"
+lemma "EX (x::'a::{linordered_field_inverse_zero}) y z w. 5*x + 3*z - 17*w + abs (y - 8*x + z) <= 89"
by ferrack
-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)"
+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)"
by ferrack
-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)"
+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)"
by ferrack
-lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}) y z. (EX w >= (x+y+z). w <= abs x + abs y + abs z)"
+lemma "ALL (x::'a::{linordered_field_inverse_zero}) y z. (EX w >= (x+y+z). w <= abs x + abs y + abs z)"
by ferrack
-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))"
+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))"
by ferrack
-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)"
+lemma "ALL (x::'a::{linordered_field_inverse_zero}) y. (EX z w. abs (x-y) = (z-w) & z*1234 < 233*x & w ~= y)"
by ferrack
-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))"
+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))"
by ferrack
-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)"
+lemma "EX (x::'a::{linordered_field_inverse_zero}) y z. (ALL w >= abs (x+y+z). w >= abs x + abs y + abs z)"
by ferrack
-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))"
+lemma "EX z. (ALL (x::'a::{linordered_field_inverse_zero}) y. (EX w >= (x+y+z). w <= abs x + abs y + abs z))"
by ferrack
-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))"
+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))"
by ferrack
-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))"
+lemma "ALL (x::'a::{linordered_field_inverse_zero}) y. (EX z. (ALL w. abs (x-y) = abs (z-w) --> z < x & w ~= y))"
by ferrack
-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)))"
+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)))"
by ferrack
-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))"
+lemma "EX (x::'a::{linordered_field_inverse_zero}) z. (ALL w >= 13*x - 4*z. (EX y. w >= abs x + abs y + z))"
by ferrack
-lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring}). (ALL y < x. (EX z > (x+y).
+lemma "EX (x::'a::{linordered_field_inverse_zero}). (ALL y < x. (EX z > (x+y).
(ALL w. 5*w + 10*x - z >= y --> w + 7*x + 3*z >= 2*y)))"
by ferrack
-lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring}). (ALL y. (EX z > y.
+lemma "EX (x::'a::{linordered_field_inverse_zero}). (ALL y. (EX z > y.
(ALL w . w < 13 --> w + 10*x - z >= y --> 5*w + 7*x + 13*z >= 2*y)))"
by ferrack
-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)"
+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)"
by ferrack
-lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}). (EX y. (ALL z>19. y <= x + z & (EX w. abs (y - x) < w)))"
+lemma "ALL (x::'a::{linordered_field_inverse_zero}). (EX y. (ALL z>19. y <= x + z & (EX w. abs (y - x) < w)))"
by ferrack
-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)))"
+lemma "ALL (x::'a::{linordered_field_inverse_zero}). (EX y. (ALL z>19. y <= x + z & (EX w. abs (x + z) < w - y)))"
by ferrack
-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)))"
+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)))"
by ferrack
end
--- a/src/HOL/Decision_Procs/ferrack_tac.ML Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Decision_Procs/ferrack_tac.ML Mon Mar 26 15:33:28 2012 +0200
@@ -20,17 +20,13 @@
in @{simpset} delsimps ths addsimps (map (fn th => th RS sym) ths)
end;
-val binarith =
- @{thms normalize_bin_simps} @ @{thms pred_bin_simps} @ @{thms succ_bin_simps} @
- @{thms add_bin_simps} @ @{thms minus_bin_simps} @ @{thms mult_bin_simps};
-val comp_arith = binarith @ @{thms simp_thms};
+val binarith = @{thms arith_simps}
+val comp_arith = binarith @ @{thms simp_thms}
val zdvd_int = @{thm zdvd_int};
val zdiff_int_split = @{thm zdiff_int_split};
val all_nat = @{thm all_nat};
val ex_nat = @{thm ex_nat};
-val number_of1 = @{thm number_of1};
-val number_of2 = @{thm number_of2};
val split_zdiv = @{thm split_zdiv};
val split_zmod = @{thm split_zmod};
val mod_div_equality' = @{thm mod_div_equality'};
--- a/src/HOL/Decision_Procs/mir_tac.ML Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Decision_Procs/mir_tac.ML Mon Mar 26 15:33:28 2012 +0200
@@ -21,16 +21,15 @@
end;
val nT = HOLogic.natT;
- val nat_arith = [@{thm "add_nat_number_of"}, @{thm "diff_nat_number_of"},
- @{thm "mult_nat_number_of"}, @{thm "eq_nat_number_of"}, @{thm "less_nat_number_of"}];
+ val nat_arith = [@{thm diff_nat_numeral}];
val comp_arith = [@{thm "Let_def"}, @{thm "if_False"}, @{thm "if_True"}, @{thm "add_0"},
- @{thm "add_Suc"}, @{thm "add_number_of_left"}, @{thm "mult_number_of_left"},
+ @{thm "add_Suc"}, @{thm add_numeral_left}, @{thm mult_numeral_left(1)},
@{thm "Suc_eq_plus1"}] @
- (map (fn th => th RS sym) [@{thm "numeral_1_eq_1"}, @{thm "numeral_0_eq_0"}])
+ (map (fn th => th RS sym) [@{thm "numeral_1_eq_1"}])
@ @{thms arith_simps} @ nat_arith @ @{thms rel_simps}
val ths = [@{thm "mult_numeral_1"}, @{thm "mult_numeral_1_right"},
- @{thm "real_of_nat_number_of"},
+ @{thm real_of_nat_numeral},
@{thm "real_of_nat_Suc"}, @{thm "real_of_nat_one"}, @{thm "real_of_one"},
@{thm "real_of_int_zero"}, @{thm "real_of_nat_zero"},
@{thm "divide_zero"},
@@ -44,8 +43,6 @@
val zdiff_int_split = @{thm "zdiff_int_split"};
val all_nat = @{thm "all_nat"};
val ex_nat = @{thm "ex_nat"};
-val number_of1 = @{thm "number_of1"};
-val number_of2 = @{thm "number_of2"};
val split_zdiv = @{thm "split_zdiv"};
val split_zmod = @{thm "split_zmod"};
val mod_div_equality' = @{thm "mod_div_equality'"};
@@ -113,15 +110,15 @@
@{thm "split_min"}, @{thm "split_max"}]
(* Simp rules for changing (n::int) to int n *)
val simpset1 = HOL_basic_ss
- addsimps [@{thm "nat_number_of_def"}, @{thm "zdvd_int"}] @ map (fn r => r RS sym)
+ addsimps [@{thm "zdvd_int"}] @ map (fn r => r RS sym)
[@{thm "int_int_eq"}, @{thm "zle_int"}, @{thm "zless_int"}, @{thm "zadd_int"},
- @{thm "zmult_int"}]
+ @{thm nat_numeral}, @{thm "zmult_int"}]
|> Splitter.add_split @{thm "zdiff_int_split"}
(*simp rules for elimination of int n*)
val simpset2 = HOL_basic_ss
- addsimps [@{thm "nat_0_le"}, @{thm "all_nat"}, @{thm "ex_nat"}, @{thm "number_of1"},
- @{thm "number_of2"}, @{thm "int_0"}, @{thm "int_1"}]
+ addsimps [@{thm "nat_0_le"}, @{thm "all_nat"}, @{thm "ex_nat"}, @{thm zero_le_numeral},
+ @{thm "int_0"}, @{thm "int_1"}]
|> fold Simplifier.add_cong [@{thm "conj_le_cong"}, @{thm "imp_le_cong"}]
(* simp rules for elimination of abs *)
val ct = cterm_of thy (HOLogic.mk_Trueprop t)
--- a/src/HOL/Deriv.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Deriv.thy Mon Mar 26 15:33:28 2012 +0200
@@ -186,7 +186,6 @@
apply (erule DERIV_mult')
apply (erule (1) DERIV_inverse')
apply (simp add: ring_distribs nonzero_inverse_mult_distrib)
-apply (simp add: mult_ac)
done
lemma DERIV_power_Suc:
--- a/src/HOL/Divides.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Divides.thy Mon Mar 26 15:33:28 2012 +0200
@@ -1138,8 +1138,8 @@
lemma Suc_mod_eq_add3_mod: "(Suc (Suc (Suc m))) mod n = (3+m) mod n"
by (simp add: Suc3_eq_add_3)
-lemmas Suc_div_eq_add3_div_number_of [simp] = Suc_div_eq_add3_div [of _ "number_of v"] for v
-lemmas Suc_mod_eq_add3_mod_number_of [simp] = Suc_mod_eq_add3_mod [of _ "number_of v"] for v
+lemmas Suc_div_eq_add3_div_numeral [simp] = Suc_div_eq_add3_div [of _ "numeral v"] for v
+lemmas Suc_mod_eq_add3_mod_numeral [simp] = Suc_mod_eq_add3_mod [of _ "numeral v"] for v
lemma Suc_times_mod_eq: "1<k ==> Suc (k * m) mod k = 1"
@@ -1147,7 +1147,7 @@
apply (simp_all add: mod_Suc)
done
-declare Suc_times_mod_eq [of "number_of w", simp] for w
+declare Suc_times_mod_eq [of "numeral w", simp] for w
lemma [simp]: "n div k \<le> (Suc n) div k"
by (simp add: div_le_mono)
@@ -1177,17 +1177,22 @@
apply (subst mod_Suc [of "m mod n"], simp)
done
+lemma mod_2_not_eq_zero_eq_one_nat:
+ fixes n :: nat
+ shows "n mod 2 \<noteq> 0 \<longleftrightarrow> n mod 2 = 1"
+ by simp
+
subsection {* Division on @{typ int} *}
definition divmod_int_rel :: "int \<Rightarrow> int \<Rightarrow> int \<times> int \<Rightarrow> bool" where
--{*definition of quotient and remainder*}
- [code]: "divmod_int_rel a b = (\<lambda>(q, r). a = b * q + r \<and>
+ "divmod_int_rel a b = (\<lambda>(q, r). a = b * q + r \<and>
(if 0 < b then 0 \<le> r \<and> r < b else b < r \<and> r \<le> 0))"
definition adjust :: "int \<Rightarrow> int \<times> int \<Rightarrow> int \<times> int" where
--{*for the division algorithm*}
- [code]: "adjust b = (\<lambda>(q, r). if 0 \<le> r - b then (2 * q + 1, r - b)
+ "adjust b = (\<lambda>(q, r). if 0 \<le> r - b then (2 * q + 1, r - b)
else (2 * q, r))"
text{*algorithm for the case @{text "a\<ge>0, b>0"}*}
@@ -1318,11 +1323,11 @@
text{*And positive divisors*}
lemma adjust_eq [simp]:
- "adjust b (q,r) =
- (let diff = r-b in
- if 0 \<le> diff then (2*q + 1, diff)
+ "adjust b (q, r) =
+ (let diff = r - b in
+ if 0 \<le> diff then (2 * q + 1, diff)
else (2*q, r))"
-by (simp add: Let_def adjust_def)
+ by (simp add: Let_def adjust_def)
declare posDivAlg.simps [simp del]
@@ -1420,6 +1425,9 @@
text {* Tool setup *}
+(* FIXME: Theorem list add_0s doesn't exist, because Numeral0 has gone. *)
+lemmas add_0s = add_0_left add_0_right
+
ML {*
structure Cancel_Div_Mod_Int = Cancel_Div_Mod
(
@@ -1674,16 +1682,6 @@
by (rule divmod_int_rel_mod [of a b q r],
simp add: divmod_int_rel_def)
-lemmas arithmetic_simps =
- arith_simps
- add_special
- add_0_left
- add_0_right
- mult_zero_left
- mult_zero_right
- mult_1_left
- mult_1_right
-
(* simprocs adapted from HOL/ex/Binary.thy *)
ML {*
local
@@ -1694,7 +1692,7 @@
val less = @{term "op < :: int \<Rightarrow> int \<Rightarrow> bool"}
val le = @{term "op \<le> :: int \<Rightarrow> int \<Rightarrow> bool"}
val simps = @{thms arith_simps} @ @{thms rel_simps} @
- map (fn th => th RS sym) [@{thm numeral_0_eq_0}, @{thm numeral_1_eq_1}]
+ map (fn th => th RS sym) [@{thm numeral_1_eq_1}]
fun prove ctxt goal = Goal.prove ctxt [] [] (HOLogic.mk_Trueprop goal)
(K (ALLGOALS (full_simp_tac (HOL_basic_ss addsimps simps))));
fun binary_proc proc ss ct =
@@ -1717,14 +1715,25 @@
end
*}
-simproc_setup binary_int_div ("number_of m div number_of n :: int") =
+simproc_setup binary_int_div
+ ("numeral m div numeral n :: int" |
+ "numeral m div neg_numeral n :: int" |
+ "neg_numeral m div numeral n :: int" |
+ "neg_numeral m div neg_numeral n :: int") =
{* K (divmod_proc @{thm int_div_pos_eq} @{thm int_div_neg_eq}) *}
-simproc_setup binary_int_mod ("number_of m mod number_of n :: int") =
+simproc_setup binary_int_mod
+ ("numeral m mod numeral n :: int" |
+ "numeral m mod neg_numeral n :: int" |
+ "neg_numeral m mod numeral n :: int" |
+ "neg_numeral m mod neg_numeral n :: int") =
{* K (divmod_proc @{thm int_mod_pos_eq} @{thm int_mod_neg_eq}) *}
-lemmas posDivAlg_eqn_number_of [simp] = posDivAlg_eqn [of "number_of v" "number_of w"] for v w
-lemmas negDivAlg_eqn_number_of [simp] = negDivAlg_eqn [of "number_of v" "number_of w"] for v w
+lemmas posDivAlg_eqn_numeral [simp] =
+ posDivAlg_eqn [of "numeral v" "numeral w", OF zero_less_numeral] for v w
+
+lemmas negDivAlg_eqn_numeral [simp] =
+ negDivAlg_eqn [of "numeral v" "neg_numeral w", OF zero_less_numeral] for v w
text{*Special-case simplification *}
@@ -1741,12 +1750,25 @@
(** The last remaining special cases for constant arithmetic:
1 div z and 1 mod z **)
-lemmas div_pos_pos_1_number_of [simp] = div_pos_pos [OF zero_less_one, of "number_of w"] for w
-lemmas div_pos_neg_1_number_of [simp] = div_pos_neg [OF zero_less_one, of "number_of w"] for w
-lemmas mod_pos_pos_1_number_of [simp] = mod_pos_pos [OF zero_less_one, of "number_of w"] for w
-lemmas mod_pos_neg_1_number_of [simp] = mod_pos_neg [OF zero_less_one, of "number_of w"] for w
-lemmas posDivAlg_eqn_1_number_of [simp] = posDivAlg_eqn [of concl: 1 "number_of w"] for w
-lemmas negDivAlg_eqn_1_number_of [simp] = negDivAlg_eqn [of concl: 1 "number_of w"] for w
+lemmas div_pos_pos_1_numeral [simp] =
+ div_pos_pos [OF zero_less_one, of "numeral w", OF zero_le_numeral] for w
+
+lemmas div_pos_neg_1_numeral [simp] =
+ div_pos_neg [OF zero_less_one, of "neg_numeral w",
+ OF neg_numeral_less_zero] for w
+
+lemmas mod_pos_pos_1_numeral [simp] =
+ mod_pos_pos [OF zero_less_one, of "numeral w", OF zero_le_numeral] for w
+
+lemmas mod_pos_neg_1_numeral [simp] =
+ mod_pos_neg [OF zero_less_one, of "neg_numeral w",
+ OF neg_numeral_less_zero] for w
+
+lemmas posDivAlg_eqn_1_numeral [simp] =
+ posDivAlg_eqn [of concl: 1 "numeral w", OF zero_less_numeral] for w
+
+lemmas negDivAlg_eqn_1_numeral [simp] =
+ negDivAlg_eqn [of concl: 1 "numeral w", OF zero_less_numeral] for w
subsubsection {* Monotonicity in the First Argument (Dividend) *}
@@ -1928,6 +1950,11 @@
(* REVISIT: should this be generalized to all semiring_div types? *)
lemmas zmod_eq_0D [dest!] = zmod_eq_0_iff [THEN iffD1]
+lemma zmod_zdiv_equality':
+ "(m\<Colon>int) mod n = m - (m div n) * n"
+ by (rule_tac P="%x. m mod n = x - (m div n) * n" in subst [OF mod_div_equality [of _ n]])
+ arith
+
subsubsection {* Proving @{term "a div (b*c) = (a div b) div c"} *}
@@ -1989,6 +2016,26 @@
apply (force simp add: divmod_int_rel_div_mod [THEN zmult2_lemma, THEN divmod_int_rel_mod])
done
+lemma div_pos_geq:
+ fixes k l :: int
+ assumes "0 < l" and "l \<le> k"
+ shows "k div l = (k - l) div l + 1"
+proof -
+ have "k = (k - l) + l" by simp
+ then obtain j where k: "k = j + l" ..
+ with assms show ?thesis by simp
+qed
+
+lemma mod_pos_geq:
+ fixes k l :: int
+ assumes "0 < l" and "l \<le> k"
+ shows "k mod l = (k - l) mod l"
+proof -
+ have "k = (k - l) + l" by simp
+ then obtain j where k: "k = j + l" ..
+ with assms show ?thesis by simp
+qed
+
subsubsection {* Splitting Rules for div and mod *}
@@ -2046,9 +2093,9 @@
text {* Enable (lin)arith to deal with @{const div} and @{const mod}
when these are applied to some constant that is of the form
- @{term "number_of k"}: *}
-declare split_zdiv [of _ _ "number_of k", arith_split] for k
-declare split_zmod [of _ _ "number_of k", arith_split] for k
+ @{term "numeral k"}: *}
+declare split_zdiv [of _ _ "numeral k", arith_split] for k
+declare split_zmod [of _ _ "numeral k", arith_split] for k
subsubsection {* Speeding up the Division Algorithm with Shifting *}
@@ -2090,19 +2137,19 @@
minus_add_distrib [symmetric] mult_minus_right)
qed
-lemma zdiv_number_of_Bit0 [simp]:
- "number_of (Int.Bit0 v) div number_of (Int.Bit0 w) =
- number_of v div (number_of w :: int)"
-by (simp only: number_of_eq numeral_simps) (simp add: mult_2 [symmetric])
-
-lemma zdiv_number_of_Bit1 [simp]:
- "number_of (Int.Bit1 v) div number_of (Int.Bit0 w) =
- (if (0::int) \<le> number_of w
- then number_of v div (number_of w)
- else (number_of v + (1::int)) div (number_of w))"
-apply (simp only: number_of_eq numeral_simps UNIV_I split: split_if)
-apply (simp add: pos_zdiv_mult_2 neg_zdiv_mult_2 add_ac mult_2 [symmetric])
-done
+(* FIXME: add rules for negative numerals *)
+lemma zdiv_numeral_Bit0 [simp]:
+ "numeral (Num.Bit0 v) div numeral (Num.Bit0 w) =
+ numeral v div (numeral w :: int)"
+ unfolding numeral.simps unfolding mult_2 [symmetric]
+ by (rule div_mult_mult1, simp)
+
+lemma zdiv_numeral_Bit1 [simp]:
+ "numeral (Num.Bit1 v) div numeral (Num.Bit0 w) =
+ (numeral v div (numeral w :: int))"
+ unfolding numeral.simps
+ unfolding mult_2 [symmetric] add_commute [of _ 1]
+ by (rule pos_zdiv_mult_2, simp)
subsubsection {* Computing mod by Shifting (proofs resemble those for div) *}
@@ -2138,24 +2185,19 @@
(simp add: diff_minus add_ac)
qed
-lemma zmod_number_of_Bit0 [simp]:
- "number_of (Int.Bit0 v) mod number_of (Int.Bit0 w) =
- (2::int) * (number_of v mod number_of w)"
-apply (simp only: number_of_eq numeral_simps)
-apply (simp add: mod_mult_mult1 pos_zmod_mult_2
- neg_zmod_mult_2 add_ac mult_2 [symmetric])
-done
-
-lemma zmod_number_of_Bit1 [simp]:
- "number_of (Int.Bit1 v) mod number_of (Int.Bit0 w) =
- (if (0::int) \<le> number_of w
- then 2 * (number_of v mod number_of w) + 1
- else 2 * ((number_of v + (1::int)) mod number_of w) - 1)"
-apply (simp only: number_of_eq numeral_simps)
-apply (simp add: mod_mult_mult1 pos_zmod_mult_2
- neg_zmod_mult_2 add_ac mult_2 [symmetric])
-done
-
+(* FIXME: add rules for negative numerals *)
+lemma zmod_numeral_Bit0 [simp]:
+ "numeral (Num.Bit0 v) mod numeral (Num.Bit0 w) =
+ (2::int) * (numeral v mod numeral w)"
+ unfolding numeral_Bit0 [of v] numeral_Bit0 [of w]
+ unfolding mult_2 [symmetric] by (rule mod_mult_mult1)
+
+lemma zmod_numeral_Bit1 [simp]:
+ "numeral (Num.Bit1 v) mod numeral (Num.Bit0 w) =
+ 2 * (numeral v mod numeral w) + (1::int)"
+ unfolding numeral_Bit1 [of v] numeral_Bit0 [of w]
+ unfolding mult_2 [symmetric] add_commute [of _ 1]
+ by (rule pos_zmod_mult_2, simp)
lemma zdiv_eq_0_iff:
"(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")
@@ -2233,8 +2275,11 @@
subsubsection {* The Divides Relation *}
-lemmas zdvd_iff_zmod_eq_0_number_of [simp] =
- dvd_eq_mod_eq_0 [of "number_of x" "number_of y"] for x y :: int
+lemmas zdvd_iff_zmod_eq_0_numeral [simp] =
+ dvd_eq_mod_eq_0 [of "numeral x::int" "numeral y::int"]
+ dvd_eq_mod_eq_0 [of "numeral x::int" "neg_numeral y::int"]
+ dvd_eq_mod_eq_0 [of "neg_numeral x::int" "numeral y::int"]
+ dvd_eq_mod_eq_0 [of "neg_numeral x::int" "neg_numeral y::int"] for x y
lemma zdvd_zmod: "f dvd m ==> f dvd (n::int) ==> f dvd m mod n"
by (rule dvd_mod) (* TODO: remove *)
@@ -2242,6 +2287,12 @@
lemma zdvd_zmod_imp_zdvd: "k dvd m mod n ==> k dvd n ==> k dvd (m::int)"
by (rule dvd_mod_imp_dvd) (* TODO: remove *)
+lemmas dvd_eq_mod_eq_0_numeral [simp] =
+ dvd_eq_mod_eq_0 [of "numeral x" "numeral y"] for x y
+
+
+subsubsection {* Further properties *}
+
lemma zmult_div_cancel: "(n::int) * (m div n) = m - (m mod n)"
using zmod_zdiv_equality[where a="m" and b="n"]
by (simp add: algebra_simps)
@@ -2408,42 +2459,31 @@
thus ?lhs by simp
qed
-lemma div_nat_number_of [simp]:
- "(number_of v :: nat) div number_of v' =
- (if neg (number_of v :: int) then 0
- else nat (number_of v div number_of v'))"
- unfolding nat_number_of_def number_of_is_id neg_def
+lemma div_nat_numeral [simp]:
+ "(numeral v :: nat) div numeral v' = nat (numeral v div numeral v')"
by (simp add: nat_div_distrib)
-lemma one_div_nat_number_of [simp]:
- "Suc 0 div number_of v' = nat (1 div number_of v')"
- by (simp del: semiring_numeral_1_eq_1 add: numeral_1_eq_Suc_0 [symmetric] semiring_numeral_1_eq_1 [symmetric])
-
-lemma mod_nat_number_of [simp]:
- "(number_of v :: nat) mod number_of v' =
- (if neg (number_of v :: int) then 0
- else if neg (number_of v' :: int) then number_of v
- else nat (number_of v mod number_of v'))"
- unfolding nat_number_of_def number_of_is_id neg_def
+lemma one_div_nat_numeral [simp]:
+ "Suc 0 div numeral v' = nat (1 div numeral v')"
+ by (subst nat_div_distrib, simp_all)
+
+lemma mod_nat_numeral [simp]:
+ "(numeral v :: nat) mod numeral v' = nat (numeral v mod numeral v')"
by (simp add: nat_mod_distrib)
-lemma one_mod_nat_number_of [simp]:
- "Suc 0 mod number_of v' =
- (if neg (number_of v' :: int) then Suc 0
- else nat (1 mod number_of v'))"
-by (simp del: semiring_numeral_1_eq_1 add: numeral_1_eq_Suc_0 [symmetric] semiring_numeral_1_eq_1 [symmetric])
-
-lemmas dvd_eq_mod_eq_0_number_of [simp] =
- dvd_eq_mod_eq_0 [of "number_of x" "number_of y"] for x y
-
-
-subsubsection {* Nitpick *}
-
-lemma zmod_zdiv_equality':
-"(m\<Colon>int) mod n = m - (m div n) * n"
-by (rule_tac P="%x. m mod n = x - (m div n) * n"
- in subst [OF mod_div_equality [of _ n]])
- arith
+lemma one_mod_nat_numeral [simp]:
+ "Suc 0 mod numeral v' = nat (1 mod numeral v')"
+ by (subst nat_mod_distrib) simp_all
+
+lemma mod_2_not_eq_zero_eq_one_int:
+ fixes k :: int
+ shows "k mod 2 \<noteq> 0 \<longleftrightarrow> k mod 2 = 1"
+ by auto
+
+
+subsubsection {* Tools setup *}
+
+text {* Nitpick *}
lemmas [nitpick_unfold] = dvd_eq_mod_eq_0 mod_div_equality' zmod_zdiv_equality'
@@ -2461,7 +2501,7 @@
apsnd ((op *) (sgn l)) (if 0 < l \<and> 0 \<le> k \<or> l < 0 \<and> k < 0
then pdivmod k l
else (let (r, s) = pdivmod k l in
- if s = 0 then (- r, 0) else (- r - 1, \<bar>l\<bar> - s))))"
+ if s = 0 then (- r, 0) else (- r - 1, \<bar>l\<bar> - s))))"
proof -
have aux: "\<And>q::int. - k = l * q \<longleftrightarrow> k = l * - q" by auto
show ?thesis
@@ -2481,45 +2521,6 @@
then show ?thesis by (simp add: divmod_int_pdivmod)
qed
-context ring_1
-begin
-
-lemma of_int_num [code]:
- "of_int k = (if k = 0 then 0 else if k < 0 then
- - of_int (- k) else let
- (l, m) = divmod_int k 2;
- l' = of_int l
- in if m = 0 then l' + l' else l' + l' + 1)"
-proof -
- have aux1: "k mod (2\<Colon>int) \<noteq> (0\<Colon>int) \<Longrightarrow>
- of_int k = of_int (k div 2 * 2 + 1)"
- proof -
- have "k mod 2 < 2" by (auto intro: pos_mod_bound)
- moreover have "0 \<le> k mod 2" by (auto intro: pos_mod_sign)
- moreover assume "k mod 2 \<noteq> 0"
- ultimately have "k mod 2 = 1" by arith
- moreover have "of_int k = of_int (k div 2 * 2 + k mod 2)" by simp
- ultimately show ?thesis by auto
- qed
- have aux2: "\<And>x. of_int 2 * x = x + x"
- proof -
- fix x
- have int2: "(2::int) = 1 + 1" by arith
- show "of_int 2 * x = x + x"
- unfolding int2 of_int_add left_distrib by simp
- qed
- have aux3: "\<And>x. x * of_int 2 = x + x"
- proof -
- fix x
- have int2: "(2::int) = 1 + 1" by arith
- show "x * of_int 2 = x + x"
- unfolding int2 of_int_add right_distrib by simp
- qed
- from aux1 show ?thesis by (auto simp add: divmod_int_mod_div Let_def aux2 aux3)
-qed
-
-end
-
code_modulename SML
Divides Arith
--- a/src/HOL/HOLCF/Tools/fixrec.ML Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/HOLCF/Tools/fixrec.ML Mon Mar 26 15:33:28 2012 +0200
@@ -399,7 +399,7 @@
val alt_specs' : (bool * (Attrib.binding * string)) list parser =
let val unexpected = Scan.ahead (Parse.name || @{keyword "["} || @{keyword "("})
- in Parse.enum1 "|" (spec' --| Scan.option (unexpected -- Parse.!!! (@{keyword "|"}))) end
+ in Parse.enum1 "|" (spec' --| Scan.option (unexpected -- Parse.!!! @{keyword "|"})) end
val _ =
Outer_Syntax.local_theory @{command_spec "fixrec"} "define recursive functions (HOLCF)"
--- a/src/HOL/Imperative_HOL/ex/Imperative_Quicksort.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Imperative_HOL/ex/Imperative_Quicksort.thy Mon Mar 26 15:33:28 2012 +0200
@@ -6,7 +6,7 @@
theory Imperative_Quicksort
imports
- Imperative_HOL
+ "~~/src/HOL/Imperative_HOL/Imperative_HOL"
Subarray
"~~/src/HOL/Library/Multiset"
"~~/src/HOL/Library/Efficient_Nat"
@@ -593,8 +593,8 @@
proof (induct a l r p arbitrary: h rule: part1.induct)
case (1 a l r p)
thus ?case unfolding part1.simps [of a l r]
- apply (auto intro!: success_intros del: success_ifI simp add: not_le)
- apply (auto intro!: effect_intros effect_swapI)
+ apply (auto intro!: success_intros simp add: not_le)
+ apply (auto intro!: effect_intros)
done
qed
--- a/src/HOL/Imperative_HOL/ex/Imperative_Reverse.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Imperative_HOL/ex/Imperative_Reverse.thy Mon Mar 26 15:33:28 2012 +0200
@@ -5,7 +5,7 @@
header {* An imperative in-place reversal on arrays *}
theory Imperative_Reverse
-imports Subarray Imperative_HOL
+imports Subarray "~~/src/HOL/Imperative_HOL/Imperative_HOL"
begin
fun swap :: "'a\<Colon>heap array \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> unit Heap" where
@@ -107,7 +107,7 @@
shows "Array.get h' a = List.rev (Array.get h a)"
using rev2_rev'[OF assms] rev_length[OF assms] assms
by (cases "Array.length h a = 0", auto simp add: Array.length_def
- subarray_def sublist'_all rev.simps[where j=0] elim!: effect_elims)
+ subarray_def rev.simps[where j=0] elim!: effect_elims)
(drule sym[of "List.length (Array.get h a)"], simp)
definition "example = (Array.make 10 id \<guillemotright>= (\<lambda>a. rev a 0 9))"
@@ -115,3 +115,4 @@
export_code example checking SML SML_imp OCaml? OCaml_imp? Haskell? Scala? Scala_imp?
end
+
--- a/src/HOL/Imperative_HOL/ex/SatChecker.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Imperative_HOL/ex/SatChecker.thy Mon Mar 26 15:33:28 2012 +0200
@@ -702,15 +702,7 @@
else raise(''No empty clause''))
}"
-section {* Code generation setup *}
-
-code_type ProofStep
- (SML "MinisatProofStep.ProofStep")
-
-code_const ProofDone and Root and Conflict and Delete and Xstep
- (SML "MinisatProofStep.ProofDone" and "MinisatProofStep.Root ((_),/ (_))" and "MinisatProofStep.Conflict ((_),/ (_))" and "MinisatProofStep.Delete" and "MinisatProofStep.Xstep ((_),/ (_))")
-
-export_code checker tchecker lchecker in SML
+export_code checker tchecker lchecker checking SML
end
--- a/src/HOL/Imperative_HOL/ex/Subarray.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Imperative_HOL/ex/Subarray.thy Mon Mar 26 15:33:28 2012 +0200
@@ -5,7 +5,7 @@
header {* Theorems about sub arrays *}
theory Subarray
-imports Array Sublist
+imports "~~/src/HOL/Imperative_HOL/Array" Sublist
begin
definition subarray :: "nat \<Rightarrow> nat \<Rightarrow> ('a::heap) array \<Rightarrow> heap \<Rightarrow> 'a list" where
--- a/src/HOL/Import/HOL_Light/HOLLightInt.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Import/HOL_Light/HOLLightInt.thy Mon Mar 26 15:33:28 2012 +0200
@@ -40,7 +40,7 @@
lemma DEF_int_mul:
"op * = (\<lambda>u ua. floor (real u * real ua))"
- by (metis floor_number_of number_of_is_id number_of_real_def real_eq_of_int real_of_int_mult)
+ by (metis floor_real_of_int real_of_int_mult)
lemma DEF_int_abs:
"abs = (\<lambda>u. floor (abs (real u)))"
@@ -72,7 +72,7 @@
lemma INT_IMAGE:
"(\<exists>n. x = int n) \<or> (\<exists>n. x = - int n)"
- by (metis number_of_eq number_of_is_id of_int_of_nat)
+ by (metis of_int_eq_id id_def of_int_of_nat)
lemma DEF_int_pow:
"op ^ = (\<lambda>u ua. floor (real u ^ ua))"
--- a/src/HOL/Int.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Int.thy Mon Mar 26 15:33:28 2012 +0200
@@ -6,10 +6,9 @@
header {* The Integers as Equivalence Classes over Pairs of Natural Numbers *}
theory Int
-imports Equiv_Relations Nat Wellfounded
+imports Equiv_Relations Wellfounded
uses
("Tools/numeral.ML")
- ("Tools/numeral_syntax.ML")
("Tools/int_arith.ML")
begin
@@ -323,15 +322,20 @@
lemma of_int_of_nat_eq [simp]: "of_int (int n) = of_nat n"
by (induct n) auto
+lemma of_int_numeral [simp, code_post]: "of_int (numeral k) = numeral k"
+ by (simp add: of_nat_numeral [symmetric] of_int_of_nat_eq [symmetric])
+
+lemma of_int_neg_numeral [simp, code_post]: "of_int (neg_numeral k) = neg_numeral k"
+ unfolding neg_numeral_def neg_numeral_class.neg_numeral_def
+ by (simp only: of_int_minus of_int_numeral)
+
lemma of_int_power:
"of_int (z ^ n) = of_int z ^ n"
by (induct n) simp_all
end
-text{*Class for unital rings with characteristic zero.
- Includes non-ordered rings like the complex numbers.*}
-class ring_char_0 = ring_1 + semiring_char_0
+context ring_char_0
begin
lemma of_int_eq_iff [simp]:
@@ -579,230 +583,27 @@
apply (simp add: int_def minus add diff_minus)
done
-
-subsection {* Binary representation *}
-
-text {*
- This formalization defines binary arithmetic in terms of the integers
- rather than using a datatype. This avoids multiple representations (leading
- zeroes, etc.) See @{text "ZF/Tools/twos-compl.ML"}, function @{text
- int_of_binary}, for the numerical interpretation.
-
- The representation expects that @{text "(m mod 2)"} is 0 or 1,
- even if m is negative;
- For instance, @{text "-5 div 2 = -3"} and @{text "-5 mod 2 = 1"}; thus
- @{text "-5 = (-3)*2 + 1"}.
-
- This two's complement binary representation derives from the paper
- "An Efficient Representation of Arithmetic for Term Rewriting" by
- Dave Cohen and Phil Watson, Rewriting Techniques and Applications,
- Springer LNCS 488 (240-251), 1991.
-*}
-
-subsubsection {* The constructors @{term Bit0}, @{term Bit1}, @{term Pls} and @{term Min} *}
-
-definition Pls :: int where
- "Pls = 0"
+lemma Let_numeral [simp]: "Let (numeral v) f = f (numeral v)"
+ -- {* Unfold all @{text let}s involving constants *}
+ unfolding Let_def ..
-definition Min :: int where
- "Min = - 1"
-
-definition Bit0 :: "int \<Rightarrow> int" where
- "Bit0 k = k + k"
-
-definition Bit1 :: "int \<Rightarrow> int" where
- "Bit1 k = 1 + k + k"
-
-class number = -- {* for numeric types: nat, int, real, \dots *}
- fixes number_of :: "int \<Rightarrow> 'a"
-
-use "Tools/numeral.ML"
-
-syntax
- "_Numeral" :: "num_const \<Rightarrow> 'a" ("_")
-
-use "Tools/numeral_syntax.ML"
-setup Numeral_Syntax.setup
-
-abbreviation
- "Numeral0 \<equiv> number_of Pls"
-
-abbreviation
- "Numeral1 \<equiv> number_of (Bit1 Pls)"
-
-lemma Let_number_of [simp]: "Let (number_of v) f = f (number_of v)"
+lemma Let_neg_numeral [simp]: "Let (neg_numeral v) f = f (neg_numeral v)"
-- {* Unfold all @{text let}s involving constants *}
unfolding Let_def ..
-definition succ :: "int \<Rightarrow> int" where
- "succ k = k + 1"
-
-definition pred :: "int \<Rightarrow> int" where
- "pred k = k - 1"
-
-lemmas max_number_of [simp] = max_def [of "number_of u" "number_of v"]
- and min_number_of [simp] = min_def [of "number_of u" "number_of v"]
- for u v
- -- {* unfolding @{text minx} and @{text max} on numerals *}
-
-lemmas numeral_simps =
- succ_def pred_def Pls_def Min_def Bit0_def Bit1_def
-
-text {* Removal of leading zeroes *}
-
-lemma Bit0_Pls [simp, code_post]:
- "Bit0 Pls = Pls"
- unfolding numeral_simps by simp
-
-lemma Bit1_Min [simp, code_post]:
- "Bit1 Min = Min"
- unfolding numeral_simps by simp
-
-lemmas normalize_bin_simps =
- Bit0_Pls Bit1_Min
-
-
-subsubsection {* Successor and predecessor functions *}
-
-text {* Successor *}
-
-lemma succ_Pls:
- "succ Pls = Bit1 Pls"
- unfolding numeral_simps by simp
-
-lemma succ_Min:
- "succ Min = Pls"
- unfolding numeral_simps by simp
-
-lemma succ_Bit0:
- "succ (Bit0 k) = Bit1 k"
- unfolding numeral_simps by simp
-
-lemma succ_Bit1:
- "succ (Bit1 k) = Bit0 (succ k)"
- unfolding numeral_simps by simp
-
-lemmas succ_bin_simps [simp] =
- succ_Pls succ_Min succ_Bit0 succ_Bit1
-
-text {* Predecessor *}
-
-lemma pred_Pls:
- "pred Pls = Min"
- unfolding numeral_simps by simp
-
-lemma pred_Min:
- "pred Min = Bit0 Min"
- unfolding numeral_simps by simp
-
-lemma pred_Bit0:
- "pred (Bit0 k) = Bit1 (pred k)"
- unfolding numeral_simps by simp
-
-lemma pred_Bit1:
- "pred (Bit1 k) = Bit0 k"
- unfolding numeral_simps by simp
-
-lemmas pred_bin_simps [simp] =
- pred_Pls pred_Min pred_Bit0 pred_Bit1
-
-
-subsubsection {* Binary arithmetic *}
-
-text {* Addition *}
-
-lemma add_Pls:
- "Pls + k = k"
- unfolding numeral_simps by simp
-
-lemma add_Min:
- "Min + k = pred k"
- unfolding numeral_simps by simp
+text {* Unfold @{text min} and @{text max} on numerals. *}
-lemma add_Bit0_Bit0:
- "(Bit0 k) + (Bit0 l) = Bit0 (k + l)"
- unfolding numeral_simps by simp
-
-lemma add_Bit0_Bit1:
- "(Bit0 k) + (Bit1 l) = Bit1 (k + l)"
- unfolding numeral_simps by simp
-
-lemma add_Bit1_Bit0:
- "(Bit1 k) + (Bit0 l) = Bit1 (k + l)"
- unfolding numeral_simps by simp
-
-lemma add_Bit1_Bit1:
- "(Bit1 k) + (Bit1 l) = Bit0 (k + succ l)"
- unfolding numeral_simps by simp
-
-lemma add_Pls_right:
- "k + Pls = k"
- unfolding numeral_simps by simp
-
-lemma add_Min_right:
- "k + Min = pred k"
- unfolding numeral_simps by simp
-
-lemmas add_bin_simps [simp] =
- add_Pls add_Min add_Pls_right add_Min_right
- add_Bit0_Bit0 add_Bit0_Bit1 add_Bit1_Bit0 add_Bit1_Bit1
-
-text {* Negation *}
-
-lemma minus_Pls:
- "- Pls = Pls"
- unfolding numeral_simps by simp
-
-lemma minus_Min:
- "- Min = Bit1 Pls"
- unfolding numeral_simps by simp
-
-lemma minus_Bit0:
- "- (Bit0 k) = Bit0 (- k)"
- unfolding numeral_simps by simp
+lemmas max_number_of [simp] =
+ max_def [of "numeral u" "numeral v"]
+ max_def [of "numeral u" "neg_numeral v"]
+ max_def [of "neg_numeral u" "numeral v"]
+ max_def [of "neg_numeral u" "neg_numeral v"] for u v
-lemma minus_Bit1:
- "- (Bit1 k) = Bit1 (pred (- k))"
- unfolding numeral_simps by simp
-
-lemmas minus_bin_simps [simp] =
- minus_Pls minus_Min minus_Bit0 minus_Bit1
-
-text {* Subtraction *}
-
-lemma diff_bin_simps [simp]:
- "k - Pls = k"
- "k - Min = succ k"
- "Pls - (Bit0 l) = Bit0 (Pls - l)"
- "Pls - (Bit1 l) = Bit1 (Min - l)"
- "Min - (Bit0 l) = Bit1 (Min - l)"
- "Min - (Bit1 l) = Bit0 (Min - l)"
- "(Bit0 k) - (Bit0 l) = Bit0 (k - l)"
- "(Bit0 k) - (Bit1 l) = Bit1 (pred k - l)"
- "(Bit1 k) - (Bit0 l) = Bit1 (k - l)"
- "(Bit1 k) - (Bit1 l) = Bit0 (k - l)"
- unfolding numeral_simps by simp_all
-
-text {* Multiplication *}
-
-lemma mult_Pls:
- "Pls * w = Pls"
- unfolding numeral_simps by simp
-
-lemma mult_Min:
- "Min * k = - k"
- unfolding numeral_simps by simp
-
-lemma mult_Bit0:
- "(Bit0 k) * l = Bit0 (k * l)"
- unfolding numeral_simps int_distrib by simp
-
-lemma mult_Bit1:
- "(Bit1 k) * l = (Bit0 (k * l)) + l"
- unfolding numeral_simps int_distrib by simp
-
-lemmas mult_bin_simps [simp] =
- mult_Pls mult_Min mult_Bit0 mult_Bit1
+lemmas min_number_of [simp] =
+ min_def [of "numeral u" "numeral v"]
+ min_def [of "numeral u" "neg_numeral v"]
+ min_def [of "neg_numeral u" "numeral v"]
+ min_def [of "neg_numeral u" "neg_numeral v"] for u v
subsubsection {* Binary comparisons *}
@@ -812,7 +613,7 @@
lemma even_less_0_iff:
"a + a < 0 \<longleftrightarrow> a < (0::'a::linordered_idom)"
proof -
- have "a + a < 0 \<longleftrightarrow> (1+1)*a < 0" by (simp add: left_distrib)
+ have "a + a < 0 \<longleftrightarrow> (1+1)*a < 0" by (simp add: left_distrib del: one_add_one)
also have "(1+1)*a < 0 \<longleftrightarrow> a < 0"
by (simp add: mult_less_0_iff zero_less_two
order_less_not_sym [OF zero_less_two])
@@ -824,7 +625,7 @@
shows "(0::int) < 1 + z"
proof -
have "0 \<le> z" by fact
- also have "... < z + 1" by (rule less_add_one)
+ also have "... < z + 1" by (rule less_add_one)
also have "... = 1 + z" by (simp add: add_ac)
finally show "0 < 1 + z" .
qed
@@ -841,276 +642,6 @@
add: algebra_simps of_nat_1 [where 'a=int, symmetric] of_nat_add [symmetric])
qed
-lemma bin_less_0_simps:
- "Pls < 0 \<longleftrightarrow> False"
- "Min < 0 \<longleftrightarrow> True"
- "Bit0 w < 0 \<longleftrightarrow> w < 0"
- "Bit1 w < 0 \<longleftrightarrow> w < 0"
- unfolding numeral_simps
- by (simp_all add: even_less_0_iff odd_less_0_iff)
-
-lemma less_bin_lemma: "k < l \<longleftrightarrow> k - l < (0::int)"
- by simp
-
-lemma le_iff_pred_less: "k \<le> l \<longleftrightarrow> pred k < l"
- unfolding numeral_simps
- proof
- have "k - 1 < k" by simp
- also assume "k \<le> l"
- finally show "k - 1 < l" .
- next
- assume "k - 1 < l"
- hence "(k - 1) + 1 \<le> l" by (rule zless_imp_add1_zle)
- thus "k \<le> l" by simp
- qed
-
-lemma succ_pred: "succ (pred x) = x"
- unfolding numeral_simps by simp
-
-text {* Less-than *}
-
-lemma less_bin_simps [simp]:
- "Pls < Pls \<longleftrightarrow> False"
- "Pls < Min \<longleftrightarrow> False"
- "Pls < Bit0 k \<longleftrightarrow> Pls < k"
- "Pls < Bit1 k \<longleftrightarrow> Pls \<le> k"
- "Min < Pls \<longleftrightarrow> True"
- "Min < Min \<longleftrightarrow> False"
- "Min < Bit0 k \<longleftrightarrow> Min < k"
- "Min < Bit1 k \<longleftrightarrow> Min < k"
- "Bit0 k < Pls \<longleftrightarrow> k < Pls"
- "Bit0 k < Min \<longleftrightarrow> k \<le> Min"
- "Bit1 k < Pls \<longleftrightarrow> k < Pls"
- "Bit1 k < Min \<longleftrightarrow> k < Min"
- "Bit0 k < Bit0 l \<longleftrightarrow> k < l"
- "Bit0 k < Bit1 l \<longleftrightarrow> k \<le> l"
- "Bit1 k < Bit0 l \<longleftrightarrow> k < l"
- "Bit1 k < Bit1 l \<longleftrightarrow> k < l"
- unfolding le_iff_pred_less
- less_bin_lemma [of Pls]
- less_bin_lemma [of Min]
- less_bin_lemma [of "k"]
- less_bin_lemma [of "Bit0 k"]
- less_bin_lemma [of "Bit1 k"]
- less_bin_lemma [of "pred Pls"]
- less_bin_lemma [of "pred k"]
- by (simp_all add: bin_less_0_simps succ_pred)
-
-text {* Less-than-or-equal *}
-
-lemma le_bin_simps [simp]:
- "Pls \<le> Pls \<longleftrightarrow> True"
- "Pls \<le> Min \<longleftrightarrow> False"
- "Pls \<le> Bit0 k \<longleftrightarrow> Pls \<le> k"
- "Pls \<le> Bit1 k \<longleftrightarrow> Pls \<le> k"
- "Min \<le> Pls \<longleftrightarrow> True"
- "Min \<le> Min \<longleftrightarrow> True"
- "Min \<le> Bit0 k \<longleftrightarrow> Min < k"
- "Min \<le> Bit1 k \<longleftrightarrow> Min \<le> k"
- "Bit0 k \<le> Pls \<longleftrightarrow> k \<le> Pls"
- "Bit0 k \<le> Min \<longleftrightarrow> k \<le> Min"
- "Bit1 k \<le> Pls \<longleftrightarrow> k < Pls"
- "Bit1 k \<le> Min \<longleftrightarrow> k \<le> Min"
- "Bit0 k \<le> Bit0 l \<longleftrightarrow> k \<le> l"
- "Bit0 k \<le> Bit1 l \<longleftrightarrow> k \<le> l"
- "Bit1 k \<le> Bit0 l \<longleftrightarrow> k < l"
- "Bit1 k \<le> Bit1 l \<longleftrightarrow> k \<le> l"
- unfolding not_less [symmetric]
- by (simp_all add: not_le)
-
-text {* Equality *}
-
-lemma eq_bin_simps [simp]:
- "Pls = Pls \<longleftrightarrow> True"
- "Pls = Min \<longleftrightarrow> False"
- "Pls = Bit0 l \<longleftrightarrow> Pls = l"
- "Pls = Bit1 l \<longleftrightarrow> False"
- "Min = Pls \<longleftrightarrow> False"
- "Min = Min \<longleftrightarrow> True"
- "Min = Bit0 l \<longleftrightarrow> False"
- "Min = Bit1 l \<longleftrightarrow> Min = l"
- "Bit0 k = Pls \<longleftrightarrow> k = Pls"
- "Bit0 k = Min \<longleftrightarrow> False"
- "Bit1 k = Pls \<longleftrightarrow> False"
- "Bit1 k = Min \<longleftrightarrow> k = Min"
- "Bit0 k = Bit0 l \<longleftrightarrow> k = l"
- "Bit0 k = Bit1 l \<longleftrightarrow> False"
- "Bit1 k = Bit0 l \<longleftrightarrow> False"
- "Bit1 k = Bit1 l \<longleftrightarrow> k = l"
- unfolding order_eq_iff [where 'a=int]
- by (simp_all add: not_less)
-
-
-subsection {* Converting Numerals to Rings: @{term number_of} *}
-
-class number_ring = number + comm_ring_1 +
- assumes number_of_eq: "number_of k = of_int k"
-
-class number_semiring = number + comm_semiring_1 +
- assumes number_of_int: "number_of (int n) = of_nat n"
-
-instance number_ring \<subseteq> number_semiring
-proof
- fix n show "number_of (int n) = (of_nat n :: 'a)"
- unfolding number_of_eq by (rule of_int_of_nat_eq)
-qed
-
-text {* self-embedding of the integers *}
-
-instantiation int :: number_ring
-begin
-
-definition
- int_number_of_def: "number_of w = (of_int w \<Colon> int)"
-
-instance proof
-qed (simp only: int_number_of_def)
-
-end
-
-lemma number_of_is_id:
- "number_of (k::int) = k"
- unfolding int_number_of_def by simp
-
-lemma number_of_succ:
- "number_of (succ k) = (1 + number_of k ::'a::number_ring)"
- unfolding number_of_eq numeral_simps by simp
-
-lemma number_of_pred:
- "number_of (pred w) = (- 1 + number_of w ::'a::number_ring)"
- unfolding number_of_eq numeral_simps by simp
-
-lemma number_of_minus:
- "number_of (uminus w) = (- (number_of w)::'a::number_ring)"
- unfolding number_of_eq by (rule of_int_minus)
-
-lemma number_of_add:
- "number_of (v + w) = (number_of v + number_of w::'a::number_ring)"
- unfolding number_of_eq by (rule of_int_add)
-
-lemma number_of_diff:
- "number_of (v - w) = (number_of v - number_of w::'a::number_ring)"
- unfolding number_of_eq by (rule of_int_diff)
-
-lemma number_of_mult:
- "number_of (v * w) = (number_of v * number_of w::'a::number_ring)"
- unfolding number_of_eq by (rule of_int_mult)
-
-text {*
- The correctness of shifting.
- But it doesn't seem to give a measurable speed-up.
-*}
-
-lemma double_number_of_Bit0:
- "(1 + 1) * number_of w = (number_of (Bit0 w) ::'a::number_ring)"
- unfolding number_of_eq numeral_simps left_distrib by simp
-
-text {*
- Converting numerals 0 and 1 to their abstract versions.
-*}
-
-lemma semiring_numeral_0_eq_0 [simp, code_post]:
- "Numeral0 = (0::'a::number_semiring)"
- using number_of_int [where 'a='a and n=0]
- unfolding numeral_simps by simp
-
-lemma semiring_numeral_1_eq_1 [simp, code_post]:
- "Numeral1 = (1::'a::number_semiring)"
- using number_of_int [where 'a='a and n=1]
- unfolding numeral_simps by simp
-
-lemma numeral_0_eq_0: (* FIXME delete candidate *)
- "Numeral0 = (0::'a::number_ring)"
- by (rule semiring_numeral_0_eq_0)
-
-lemma numeral_1_eq_1: (* FIXME delete candidate *)
- "Numeral1 = (1::'a::number_ring)"
- by (rule semiring_numeral_1_eq_1)
-
-text {*
- Special-case simplification for small constants.
-*}
-
-text{*
- Unary minus for the abstract constant 1. Cannot be inserted
- as a simprule until later: it is @{text number_of_Min} re-oriented!
-*}
-
-lemma numeral_m1_eq_minus_1:
- "(-1::'a::number_ring) = - 1"
- unfolding number_of_eq numeral_simps by simp
-
-lemma mult_minus1 [simp]:
- "-1 * z = -(z::'a::number_ring)"
- unfolding number_of_eq numeral_simps by simp
-
-lemma mult_minus1_right [simp]:
- "z * -1 = -(z::'a::number_ring)"
- unfolding number_of_eq numeral_simps by simp
-
-(*Negation of a coefficient*)
-lemma minus_number_of_mult [simp]:
- "- (number_of w) * z = number_of (uminus w) * (z::'a::number_ring)"
- unfolding number_of_eq by simp
-
-text {* Subtraction *}
-
-lemma diff_number_of_eq:
- "number_of v - number_of w =
- (number_of (v + uminus w)::'a::number_ring)"
- unfolding number_of_eq by simp
-
-lemma number_of_Pls:
- "number_of Pls = (0::'a::number_ring)"
- unfolding number_of_eq numeral_simps by simp
-
-lemma number_of_Min:
- "number_of Min = (- 1::'a::number_ring)"
- unfolding number_of_eq numeral_simps by simp
-
-lemma number_of_Bit0:
- "number_of (Bit0 w) = (0::'a::number_ring) + (number_of w) + (number_of w)"
- unfolding number_of_eq numeral_simps by simp
-
-lemma number_of_Bit1:
- "number_of (Bit1 w) = (1::'a::number_ring) + (number_of w) + (number_of w)"
- unfolding number_of_eq numeral_simps by simp
-
-
-subsubsection {* Equality of Binary Numbers *}
-
-text {* First version by Norbert Voelker *}
-
-definition (*for simplifying equalities*) iszero :: "'a\<Colon>semiring_1 \<Rightarrow> bool" where
- "iszero z \<longleftrightarrow> z = 0"
-
-lemma iszero_0: "iszero 0"
- by (simp add: iszero_def)
-
-lemma iszero_Numeral0: "iszero (Numeral0 :: 'a::number_ring)"
- by (simp add: iszero_0)
-
-lemma not_iszero_1: "\<not> iszero 1"
- by (simp add: iszero_def)
-
-lemma not_iszero_Numeral1: "\<not> iszero (Numeral1 :: 'a::number_ring)"
- by (simp add: not_iszero_1)
-
-lemma eq_number_of_eq [simp]:
- "((number_of x::'a::number_ring) = number_of y) =
- iszero (number_of (x + uminus y) :: 'a)"
-unfolding iszero_def number_of_add number_of_minus
-by (simp add: algebra_simps)
-
-lemma iszero_number_of_Pls:
- "iszero ((number_of Pls)::'a::number_ring)"
-unfolding iszero_def numeral_0_eq_0 ..
-
-lemma nonzero_number_of_Min:
- "~ iszero ((number_of Min)::'a::number_ring)"
-unfolding iszero_def numeral_m1_eq_minus_1 by simp
-
-
subsubsection {* Comparisons, for Ordered Rings *}
lemmas double_eq_0_iff = double_zero
@@ -1137,129 +668,6 @@
qed
qed
-lemma iszero_number_of_Bit0:
- "iszero (number_of (Bit0 w)::'a) =
- iszero (number_of w::'a::{ring_char_0,number_ring})"
-proof -
- have "(of_int w + of_int w = (0::'a)) \<Longrightarrow> (w = 0)"
- proof -
- assume eq: "of_int w + of_int w = (0::'a)"
- then have "of_int (w + w) = (of_int 0 :: 'a)" by simp
- then have "w + w = 0" by (simp only: of_int_eq_iff)
- then show "w = 0" by (simp only: double_eq_0_iff)
- qed
- thus ?thesis
- by (auto simp add: iszero_def number_of_eq numeral_simps)
-qed
-
-lemma iszero_number_of_Bit1:
- "~ iszero (number_of (Bit1 w)::'a::{ring_char_0,number_ring})"
-proof -
- have "1 + of_int w + of_int w \<noteq> (0::'a)"
- proof
- assume eq: "1 + of_int w + of_int w = (0::'a)"
- hence "of_int (1 + w + w) = (of_int 0 :: 'a)" by simp
- hence "1 + w + w = 0" by (simp only: of_int_eq_iff)
- with odd_nonzero show False by blast
- qed
- thus ?thesis
- by (auto simp add: iszero_def number_of_eq numeral_simps)
-qed
-
-lemmas iszero_simps [simp] =
- iszero_0 not_iszero_1
- iszero_number_of_Pls nonzero_number_of_Min
- iszero_number_of_Bit0 iszero_number_of_Bit1
-(* iszero_number_of_Pls would never normally be used
- because its lhs simplifies to "iszero 0" *)
-
-text {* Less-Than or Equals *}
-
-text {* Reduces @{term "a\<le>b"} to @{term "~ (b<a)"} for ALL numerals. *}
-
-lemmas le_number_of_eq_not_less =
- linorder_not_less [of "number_of w" "number_of v", symmetric] for w v
-
-
-text {* Absolute value (@{term abs}) *}
-
-lemma abs_number_of:
- "abs(number_of x::'a::{linordered_idom,number_ring}) =
- (if number_of x < (0::'a) then -number_of x else number_of x)"
- by (simp add: abs_if)
-
-
-text {* Re-orientation of the equation nnn=x *}
-
-lemma number_of_reorient:
- "(number_of w = x) = (x = number_of w)"
- by auto
-
-
-subsubsection {* Simplification of arithmetic operations on integer constants. *}
-
-lemmas arith_extra_simps [simp] =
- number_of_add [symmetric]
- number_of_minus [symmetric]
- numeral_m1_eq_minus_1 [symmetric]
- number_of_mult [symmetric]
- diff_number_of_eq abs_number_of
-
-text {*
- For making a minimal simpset, one must include these default simprules.
- Also include @{text simp_thms}.
-*}
-
-lemmas arith_simps =
- normalize_bin_simps pred_bin_simps succ_bin_simps
- add_bin_simps minus_bin_simps mult_bin_simps
- abs_zero abs_one arith_extra_simps
-
-text {* Simplification of relational operations *}
-
-lemma less_number_of [simp]:
- "(number_of x::'a::{linordered_idom,number_ring}) < number_of y \<longleftrightarrow> x < y"
- unfolding number_of_eq by (rule of_int_less_iff)
-
-lemma le_number_of [simp]:
- "(number_of x::'a::{linordered_idom,number_ring}) \<le> number_of y \<longleftrightarrow> x \<le> y"
- unfolding number_of_eq by (rule of_int_le_iff)
-
-lemma eq_number_of [simp]:
- "(number_of x::'a::{ring_char_0,number_ring}) = number_of y \<longleftrightarrow> x = y"
- unfolding number_of_eq by (rule of_int_eq_iff)
-
-lemmas rel_simps =
- less_number_of less_bin_simps
- le_number_of le_bin_simps
- eq_number_of_eq eq_bin_simps
- iszero_simps
-
-
-subsubsection {* Simplification of arithmetic when nested to the right. *}
-
-lemma add_number_of_left [simp]:
- "number_of v + (number_of w + z) =
- (number_of(v + w) + z::'a::number_ring)"
- by (simp add: add_assoc [symmetric])
-
-lemma mult_number_of_left [simp]:
- "number_of v * (number_of w * z) =
- (number_of(v * w) * z::'a::number_ring)"
- by (simp add: mult_assoc [symmetric])
-
-lemma add_number_of_diff1:
- "number_of v + (number_of w - c) =
- number_of(v + w) - (c::'a::number_ring)"
- by (simp add: diff_minus)
-
-lemma add_number_of_diff2 [simp]:
- "number_of v + (c - number_of w) =
- number_of (v + uminus w) + (c::'a::number_ring)"
-by (simp add: algebra_simps diff_number_of_eq [symmetric])
-
-
-
subsection {* The Set of Integers *}
@@ -1363,14 +771,8 @@
qed
qed
-lemma Ints_number_of [simp]:
- "(number_of w :: 'a::number_ring) \<in> Ints"
- unfolding number_of_eq Ints_def by simp
-
-lemma Nats_number_of [simp]:
- "Int.Pls \<le> w \<Longrightarrow> (number_of w :: 'a::number_ring) \<in> Nats"
-unfolding Int.Pls_def number_of_eq
-by (simp only: of_nat_nat [symmetric] of_nat_in_Nats)
+lemma Nats_numeral [simp]: "numeral w \<in> Nats"
+ using of_nat_in_Nats [of "numeral w"] by simp
lemma Ints_odd_less_0:
assumes in_Ints: "a \<in> Ints"
@@ -1412,100 +814,16 @@
lemmas int_setprod = of_nat_setprod [where 'a=int]
-subsection{*Inequality Reasoning for the Arithmetic Simproc*}
-
-lemma add_numeral_0: "Numeral0 + a = (a::'a::number_ring)"
-by simp
-
-lemma add_numeral_0_right: "a + Numeral0 = (a::'a::number_ring)"
-by simp
-
-lemma mult_numeral_1: "Numeral1 * a = (a::'a::number_ring)"
-by simp
-
-lemma mult_numeral_1_right: "a * Numeral1 = (a::'a::number_ring)"
-by simp
-
-lemma divide_numeral_1: "a / Numeral1 = (a::'a::{number_ring,field})"
-by simp
-
-lemma inverse_numeral_1:
- "inverse Numeral1 = (Numeral1::'a::{number_ring,field})"
-by simp
-
-text{*Theorem lists for the cancellation simprocs. The use of binary numerals
-for 0 and 1 reduces the number of special cases.*}
-
-lemmas add_0s = add_numeral_0 add_numeral_0_right
-lemmas mult_1s = mult_numeral_1 mult_numeral_1_right
- mult_minus1 mult_minus1_right
-
-
-subsection{*Special Arithmetic Rules for Abstract 0 and 1*}
-
-text{*Arithmetic computations are defined for binary literals, which leaves 0
-and 1 as special cases. Addition already has rules for 0, but not 1.
-Multiplication and unary minus already have rules for both 0 and 1.*}
-
-
-lemma binop_eq: "[|f x y = g x y; x = x'; y = y'|] ==> f x' y' = g x' y'"
-by simp
-
-
-lemmas add_number_of_eq = number_of_add [symmetric]
-
-text{*Allow 1 on either or both sides*}
-lemma semiring_one_add_one_is_two: "1 + 1 = (2::'a::number_semiring)"
- using number_of_int [where 'a='a and n="Suc (Suc 0)"]
- by (simp add: numeral_simps)
-
-lemma one_add_one_is_two: "1 + 1 = (2::'a::number_ring)"
-by (rule semiring_one_add_one_is_two)
-
-lemmas add_special =
- one_add_one_is_two
- binop_eq [of "op +", OF add_number_of_eq numeral_1_eq_1 refl]
- binop_eq [of "op +", OF add_number_of_eq refl numeral_1_eq_1]
-
-text{*Allow 1 on either or both sides (1-1 already simplifies to 0)*}
-lemmas diff_special =
- binop_eq [of "op -", OF diff_number_of_eq numeral_1_eq_1 refl]
- binop_eq [of "op -", OF diff_number_of_eq refl numeral_1_eq_1]
-
-text{*Allow 0 or 1 on either side with a binary numeral on the other*}
-lemmas eq_special =
- binop_eq [of "op =", OF eq_number_of_eq numeral_0_eq_0 refl]
- binop_eq [of "op =", OF eq_number_of_eq numeral_1_eq_1 refl]
- binop_eq [of "op =", OF eq_number_of_eq refl numeral_0_eq_0]
- binop_eq [of "op =", OF eq_number_of_eq refl numeral_1_eq_1]
-
-text{*Allow 0 or 1 on either side with a binary numeral on the other*}
-lemmas less_special =
- binop_eq [of "op <", OF less_number_of numeral_0_eq_0 refl]
- binop_eq [of "op <", OF less_number_of numeral_1_eq_1 refl]
- binop_eq [of "op <", OF less_number_of refl numeral_0_eq_0]
- binop_eq [of "op <", OF less_number_of refl numeral_1_eq_1]
-
-text{*Allow 0 or 1 on either side with a binary numeral on the other*}
-lemmas le_special =
- binop_eq [of "op \<le>", OF le_number_of numeral_0_eq_0 refl]
- binop_eq [of "op \<le>", OF le_number_of numeral_1_eq_1 refl]
- binop_eq [of "op \<le>", OF le_number_of refl numeral_0_eq_0]
- binop_eq [of "op \<le>", OF le_number_of refl numeral_1_eq_1]
-
-lemmas arith_special[simp] =
- add_special diff_special eq_special less_special le_special
-
-
text {* Legacy theorems *}
lemmas zle_int = of_nat_le_iff [where 'a=int]
lemmas int_int_eq = of_nat_eq_iff [where 'a=int]
+lemmas numeral_1_eq_1 = numeral_One
subsection {* Setting up simplification procedures *}
lemmas int_arith_rules =
- neg_le_iff_le numeral_0_eq_0 numeral_1_eq_1
+ neg_le_iff_le numeral_One
minus_zero diff_minus left_minus right_minus
mult_zero_left mult_zero_right mult_1_left mult_1_right
mult_minus_left mult_minus_right
@@ -1513,56 +831,39 @@
of_nat_0 of_nat_1 of_nat_Suc of_nat_add of_nat_mult
of_int_0 of_int_1 of_int_add of_int_mult
+use "Tools/numeral.ML"
use "Tools/int_arith.ML"
declaration {* K Int_Arith.setup *}
-simproc_setup fast_arith ("(m::'a::{linordered_idom,number_ring}) < n" |
- "(m::'a::{linordered_idom,number_ring}) <= n" |
- "(m::'a::{linordered_idom,number_ring}) = n") =
+simproc_setup fast_arith ("(m::'a::linordered_idom) < n" |
+ "(m::'a::linordered_idom) <= n" |
+ "(m::'a::linordered_idom) = n") =
{* fn _ => fn ss => fn ct => Lin_Arith.simproc ss (term_of ct) *}
setup {*
Reorient_Proc.add
- (fn Const (@{const_name number_of}, _) $ _ => true | _ => false)
+ (fn Const (@{const_name numeral}, _) $ _ => true
+ | Const (@{const_name neg_numeral}, _) $ _ => true
+ | _ => false)
*}
-simproc_setup reorient_numeral ("number_of w = x") = Reorient_Proc.proc
+simproc_setup reorient_numeral
+ ("numeral w = x" | "neg_numeral w = y") = Reorient_Proc.proc
subsection{*Lemmas About Small Numerals*}
-lemma of_int_m1 [simp]: "of_int -1 = (-1 :: 'a :: number_ring)"
-proof -
- have "(of_int -1 :: 'a) = of_int (- 1)" by simp
- also have "... = - of_int 1" by (simp only: of_int_minus)
- also have "... = -1" by simp
- finally show ?thesis .
-qed
-
-lemma abs_minus_one [simp]: "abs (-1) = (1::'a::{linordered_idom,number_ring})"
-by (simp add: abs_if)
-
lemma abs_power_minus_one [simp]:
- "abs(-1 ^ n) = (1::'a::{linordered_idom,number_ring})"
+ "abs(-1 ^ n) = (1::'a::linordered_idom)"
by (simp add: power_abs)
-lemma of_int_number_of_eq [simp]:
- "of_int (number_of v) = (number_of v :: 'a :: number_ring)"
-by (simp add: number_of_eq)
-
text{*Lemmas for specialist use, NOT as default simprules*}
(* TODO: see if semiring duplication can be removed without breaking proofs *)
-lemma semiring_mult_2: "2 * z = (z+z::'a::number_semiring)"
-unfolding semiring_one_add_one_is_two [symmetric] left_distrib by simp
-
-lemma semiring_mult_2_right: "z * 2 = (z+z::'a::number_semiring)"
-by (subst mult_commute, rule semiring_mult_2)
+lemma mult_2: "2 * z = (z+z::'a::semiring_1)"
+unfolding one_add_one [symmetric] left_distrib by simp
-lemma mult_2: "2 * z = (z+z::'a::number_ring)"
-by (rule semiring_mult_2)
-
-lemma mult_2_right: "z * 2 = (z+z::'a::number_ring)"
-by (rule semiring_mult_2_right)
+lemma mult_2_right: "z * 2 = (z+z::'a::semiring_1)"
+unfolding one_add_one [symmetric] right_distrib by simp
subsection{*More Inequality Reasoning*}
@@ -1608,7 +909,7 @@
text{*This simplifies expressions of the form @{term "int n = z"} where
z is an integer literal.*}
-lemmas int_eq_iff_number_of [simp] = int_eq_iff [of _ "number_of v"] for v
+lemmas int_eq_iff_numeral [simp] = int_eq_iff [of _ "numeral v"] for v
lemma split_nat [arith_split]:
"P(nat(i::int)) = ((\<forall>n. i = int n \<longrightarrow> P n) & (i < 0 \<longrightarrow> P 0))"
@@ -1853,12 +1154,14 @@
by (simp add: mn)
finally have "2*\<bar>n\<bar> \<le> 1" .
thus "False" using 0
- by auto
+ by arith
qed
thus ?thesis using 0
by auto
qed
+ML_val {* @{const_name neg_numeral} *}
+
lemma pos_zmult_eq_1_iff_lemma: "(m * n = 1) ==> m = (1::int) | m = -1"
by (insert abs_zmult_eq_1 [of m n], arith)
@@ -1894,125 +1197,170 @@
text{*These distributive laws move literals inside sums and differences.*}
-lemmas left_distrib_number_of [simp] = left_distrib [of _ _ "number_of v"] for v
-lemmas right_distrib_number_of [simp] = right_distrib [of "number_of v"] for v
-lemmas left_diff_distrib_number_of [simp] = left_diff_distrib [of _ _ "number_of v"] for v
-lemmas right_diff_distrib_number_of [simp] = right_diff_distrib [of "number_of v"] for v
+lemmas left_distrib_numeral [simp] = left_distrib [of _ _ "numeral v"] for v
+lemmas right_distrib_numeral [simp] = right_distrib [of "numeral v"] for v
+lemmas left_diff_distrib_numeral [simp] = left_diff_distrib [of _ _ "numeral v"] for v
+lemmas right_diff_distrib_numeral [simp] = right_diff_distrib [of "numeral v"] for v
text{*These are actually for fields, like real: but where else to put them?*}
-lemmas zero_less_divide_iff_number_of [simp, no_atp] = zero_less_divide_iff [of "number_of w"] for w
-lemmas divide_less_0_iff_number_of [simp, no_atp] = divide_less_0_iff [of "number_of w"] for w
-lemmas zero_le_divide_iff_number_of [simp, no_atp] = zero_le_divide_iff [of "number_of w"] for w
-lemmas divide_le_0_iff_number_of [simp, no_atp] = divide_le_0_iff [of "number_of w"] for w
+lemmas zero_less_divide_iff_numeral [simp, no_atp] = zero_less_divide_iff [of "numeral w"] for w
+lemmas divide_less_0_iff_numeral [simp, no_atp] = divide_less_0_iff [of "numeral w"] for w
+lemmas zero_le_divide_iff_numeral [simp, no_atp] = zero_le_divide_iff [of "numeral w"] for w
+lemmas divide_le_0_iff_numeral [simp, no_atp] = divide_le_0_iff [of "numeral w"] for w
text {*Replaces @{text "inverse #nn"} by @{text "1/#nn"}. It looks
strange, but then other simprocs simplify the quotient.*}
-lemmas inverse_eq_divide_number_of [simp] = inverse_eq_divide [of "number_of w"] for w
+lemmas inverse_eq_divide_numeral [simp] =
+ inverse_eq_divide [of "numeral w"] for w
+
+lemmas inverse_eq_divide_neg_numeral [simp] =
+ inverse_eq_divide [of "neg_numeral w"] for w
text {*These laws simplify inequalities, moving unary minus from a term
into the literal.*}
-lemmas less_minus_iff_number_of [simp, no_atp] = less_minus_iff [of "number_of v"] for v
-lemmas le_minus_iff_number_of [simp, no_atp] = le_minus_iff [of "number_of v"] for v
-lemmas equation_minus_iff_number_of [simp, no_atp] = equation_minus_iff [of "number_of v"] for v
-lemmas minus_less_iff_number_of [simp, no_atp] = minus_less_iff [of _ "number_of v"] for v
-lemmas minus_le_iff_number_of [simp, no_atp] = minus_le_iff [of _ "number_of v"] for v
-lemmas minus_equation_iff_number_of [simp, no_atp] = minus_equation_iff [of _ "number_of v"] for v
+lemmas le_minus_iff_numeral [simp, no_atp] =
+ le_minus_iff [of "numeral v"]
+ le_minus_iff [of "neg_numeral v"] for v
+
+lemmas equation_minus_iff_numeral [simp, no_atp] =
+ equation_minus_iff [of "numeral v"]
+ equation_minus_iff [of "neg_numeral v"] for v
+
+lemmas minus_less_iff_numeral [simp, no_atp] =
+ minus_less_iff [of _ "numeral v"]
+ minus_less_iff [of _ "neg_numeral v"] for v
+
+lemmas minus_le_iff_numeral [simp, no_atp] =
+ minus_le_iff [of _ "numeral v"]
+ minus_le_iff [of _ "neg_numeral v"] for v
+
+lemmas minus_equation_iff_numeral [simp, no_atp] =
+ minus_equation_iff [of _ "numeral v"]
+ minus_equation_iff [of _ "neg_numeral v"] for v
text{*To Simplify Inequalities Where One Side is the Constant 1*}
lemma less_minus_iff_1 [simp,no_atp]:
- fixes b::"'b::{linordered_idom,number_ring}"
+ fixes b::"'b::linordered_idom"
shows "(1 < - b) = (b < -1)"
by auto
lemma le_minus_iff_1 [simp,no_atp]:
- fixes b::"'b::{linordered_idom,number_ring}"
+ fixes b::"'b::linordered_idom"
shows "(1 \<le> - b) = (b \<le> -1)"
by auto
lemma equation_minus_iff_1 [simp,no_atp]:
- fixes b::"'b::number_ring"
+ fixes b::"'b::ring_1"
shows "(1 = - b) = (b = -1)"
by (subst equation_minus_iff, auto)
lemma minus_less_iff_1 [simp,no_atp]:
- fixes a::"'b::{linordered_idom,number_ring}"
+ fixes a::"'b::linordered_idom"
shows "(- a < 1) = (-1 < a)"
by auto
lemma minus_le_iff_1 [simp,no_atp]:
- fixes a::"'b::{linordered_idom,number_ring}"
+ fixes a::"'b::linordered_idom"
shows "(- a \<le> 1) = (-1 \<le> a)"
by auto
lemma minus_equation_iff_1 [simp,no_atp]:
- fixes a::"'b::number_ring"
+ fixes a::"'b::ring_1"
shows "(- a = 1) = (a = -1)"
by (subst minus_equation_iff, auto)
text {*Cancellation of constant factors in comparisons (@{text "<"} and @{text "\<le>"}) *}
-lemmas mult_less_cancel_left_number_of [simp, no_atp] = mult_less_cancel_left [of "number_of v"] for v
-lemmas mult_less_cancel_right_number_of [simp, no_atp] = mult_less_cancel_right [of _ "number_of v"] for v
-lemmas mult_le_cancel_left_number_of [simp, no_atp] = mult_le_cancel_left [of "number_of v"] for v
-lemmas mult_le_cancel_right_number_of [simp, no_atp] = mult_le_cancel_right [of _ "number_of v"] for v
+lemmas mult_less_cancel_left_numeral [simp, no_atp] = mult_less_cancel_left [of "numeral v"] for v
+lemmas mult_less_cancel_right_numeral [simp, no_atp] = mult_less_cancel_right [of _ "numeral v"] for v
+lemmas mult_le_cancel_left_numeral [simp, no_atp] = mult_le_cancel_left [of "numeral v"] for v
+lemmas mult_le_cancel_right_numeral [simp, no_atp] = mult_le_cancel_right [of _ "numeral v"] for v
text {*Multiplying out constant divisors in comparisons (@{text "<"}, @{text "\<le>"} and @{text "="}) *}
-lemmas le_divide_eq_number_of1 [simp] = le_divide_eq [of _ _ "number_of w"] for w
-lemmas divide_le_eq_number_of1 [simp] = divide_le_eq [of _ "number_of w"] for w
-lemmas less_divide_eq_number_of1 [simp] = less_divide_eq [of _ _ "number_of w"] for w
-lemmas divide_less_eq_number_of1 [simp] = divide_less_eq [of _ "number_of w"] for w
-lemmas eq_divide_eq_number_of1 [simp] = eq_divide_eq [of _ _ "number_of w"] for w
-lemmas divide_eq_eq_number_of1 [simp] = divide_eq_eq [of _ "number_of w"] for w
+lemmas le_divide_eq_numeral1 [simp] =
+ pos_le_divide_eq [of "numeral w", OF zero_less_numeral]
+ neg_le_divide_eq [of "neg_numeral w", OF neg_numeral_less_zero] for w
+
+lemmas divide_le_eq_numeral1 [simp] =
+ pos_divide_le_eq [of "numeral w", OF zero_less_numeral]
+ neg_divide_le_eq [of "neg_numeral w", OF neg_numeral_less_zero] for w
+
+lemmas less_divide_eq_numeral1 [simp] =
+ pos_less_divide_eq [of "numeral w", OF zero_less_numeral]
+ neg_less_divide_eq [of "neg_numeral w", OF neg_numeral_less_zero] for w
+lemmas divide_less_eq_numeral1 [simp] =
+ pos_divide_less_eq [of "numeral w", OF zero_less_numeral]
+ neg_divide_less_eq [of "neg_numeral w", OF neg_numeral_less_zero] for w
+
+lemmas eq_divide_eq_numeral1 [simp] =
+ eq_divide_eq [of _ _ "numeral w"]
+ eq_divide_eq [of _ _ "neg_numeral w"] for w
+
+lemmas divide_eq_eq_numeral1 [simp] =
+ divide_eq_eq [of _ "numeral w"]
+ divide_eq_eq [of _ "neg_numeral w"] for w
subsubsection{*Optional Simplification Rules Involving Constants*}
text{*Simplify quotients that are compared with a literal constant.*}
-lemmas le_divide_eq_number_of = le_divide_eq [of "number_of w"] for w
-lemmas divide_le_eq_number_of = divide_le_eq [of _ _ "number_of w"] for w
-lemmas less_divide_eq_number_of = less_divide_eq [of "number_of w"] for w
-lemmas divide_less_eq_number_of = divide_less_eq [of _ _ "number_of w"] for w
-lemmas eq_divide_eq_number_of = eq_divide_eq [of "number_of w"] for w
-lemmas divide_eq_eq_number_of = divide_eq_eq [of _ _ "number_of w"] for w
+lemmas le_divide_eq_numeral =
+ le_divide_eq [of "numeral w"]
+ le_divide_eq [of "neg_numeral w"] for w
+
+lemmas divide_le_eq_numeral =
+ divide_le_eq [of _ _ "numeral w"]
+ divide_le_eq [of _ _ "neg_numeral w"] for w
+
+lemmas less_divide_eq_numeral =
+ less_divide_eq [of "numeral w"]
+ less_divide_eq [of "neg_numeral w"] for w
+
+lemmas divide_less_eq_numeral =
+ divide_less_eq [of _ _ "numeral w"]
+ divide_less_eq [of _ _ "neg_numeral w"] for w
+
+lemmas eq_divide_eq_numeral =
+ eq_divide_eq [of "numeral w"]
+ eq_divide_eq [of "neg_numeral w"] for w
+
+lemmas divide_eq_eq_numeral =
+ divide_eq_eq [of _ _ "numeral w"]
+ divide_eq_eq [of _ _ "neg_numeral w"] for w
text{*Not good as automatic simprules because they cause case splits.*}
lemmas divide_const_simps =
- le_divide_eq_number_of divide_le_eq_number_of less_divide_eq_number_of
- divide_less_eq_number_of eq_divide_eq_number_of divide_eq_eq_number_of
+ le_divide_eq_numeral divide_le_eq_numeral less_divide_eq_numeral
+ divide_less_eq_numeral eq_divide_eq_numeral divide_eq_eq_numeral
le_divide_eq_1 divide_le_eq_1 less_divide_eq_1 divide_less_eq_1
text{*Division By @{text "-1"}*}
-lemma divide_minus1 [simp]:
- "x/-1 = -(x::'a::{field_inverse_zero, number_ring})"
-by simp
+lemma divide_minus1 [simp]: "(x::'a::field) / -1 = - x"
+ unfolding minus_one [symmetric]
+ unfolding nonzero_minus_divide_right [OF one_neq_zero, symmetric]
+ by simp
-lemma minus1_divide [simp]:
- "-1 / (x::'a::{field_inverse_zero, number_ring}) = - (1/x)"
-by (simp add: divide_inverse)
+lemma minus1_divide [simp]: "-1 / (x::'a::field) = - (1 / x)"
+ unfolding minus_one [symmetric] by (rule divide_minus_left)
lemma half_gt_zero_iff:
- "(0 < r/2) = (0 < (r::'a::{linordered_field_inverse_zero,number_ring}))"
+ "(0 < r/2) = (0 < (r::'a::linordered_field_inverse_zero))"
by auto
lemmas half_gt_zero [simp] = half_gt_zero_iff [THEN iffD2]
-lemma divide_Numeral1:
- "(x::'a::{field, number_ring}) / Numeral1 = x"
- by simp
-
-lemma divide_Numeral0:
- "(x::'a::{field_inverse_zero, number_ring}) / Numeral0 = 0"
+lemma divide_Numeral1: "(x::'a::field) / Numeral1 = x"
by simp
@@ -2211,128 +1559,154 @@
subsection {* Configuration of the code generator *}
-code_datatype Pls Min Bit0 Bit1 "number_of \<Colon> int \<Rightarrow> int"
+text {* Constructors *}
+
+definition Pos :: "num \<Rightarrow> int" where
+ [simp, code_abbrev]: "Pos = numeral"
+
+definition Neg :: "num \<Rightarrow> int" where
+ [simp, code_abbrev]: "Neg = neg_numeral"
+
+code_datatype "0::int" Pos Neg
+
+
+text {* Auxiliary operations *}
+
+definition dup :: "int \<Rightarrow> int" where
+ [simp]: "dup k = k + k"
-lemmas pred_succ_numeral_code [code] =
- pred_bin_simps succ_bin_simps
+lemma dup_code [code]:
+ "dup 0 = 0"
+ "dup (Pos n) = Pos (Num.Bit0 n)"
+ "dup (Neg n) = Neg (Num.Bit0 n)"
+ unfolding Pos_def Neg_def neg_numeral_def
+ by (simp_all add: numeral_Bit0)
+
+definition sub :: "num \<Rightarrow> num \<Rightarrow> int" where
+ [simp]: "sub m n = numeral m - numeral n"
-lemmas plus_numeral_code [code] =
- add_bin_simps
- arith_extra_simps(1) [where 'a = int]
+lemma sub_code [code]:
+ "sub Num.One Num.One = 0"
+ "sub (Num.Bit0 m) Num.One = Pos (Num.BitM m)"
+ "sub (Num.Bit1 m) Num.One = Pos (Num.Bit0 m)"
+ "sub Num.One (Num.Bit0 n) = Neg (Num.BitM n)"
+ "sub Num.One (Num.Bit1 n) = Neg (Num.Bit0 n)"
+ "sub (Num.Bit0 m) (Num.Bit0 n) = dup (sub m n)"
+ "sub (Num.Bit1 m) (Num.Bit1 n) = dup (sub m n)"
+ "sub (Num.Bit1 m) (Num.Bit0 n) = dup (sub m n) + 1"
+ "sub (Num.Bit0 m) (Num.Bit1 n) = dup (sub m n) - 1"
+ unfolding sub_def dup_def numeral.simps Pos_def Neg_def
+ neg_numeral_def numeral_BitM
+ by (simp_all only: algebra_simps)
-lemmas minus_numeral_code [code] =
- minus_bin_simps
- arith_extra_simps(2) [where 'a = int]
- arith_extra_simps(5) [where 'a = int]
+
+text {* Implementations *}
+
+lemma one_int_code [code, code_unfold]:
+ "1 = Pos Num.One"
+ by simp
+
+lemma plus_int_code [code]:
+ "k + 0 = (k::int)"
+ "0 + l = (l::int)"
+ "Pos m + Pos n = Pos (m + n)"
+ "Pos m + Neg n = sub m n"
+ "Neg m + Pos n = sub n m"
+ "Neg m + Neg n = Neg (m + n)"
+ by simp_all
-lemmas times_numeral_code [code] =
- mult_bin_simps
- arith_extra_simps(4) [where 'a = int]
+lemma uminus_int_code [code]:
+ "uminus 0 = (0::int)"
+ "uminus (Pos m) = Neg m"
+ "uminus (Neg m) = Pos m"
+ by simp_all
+
+lemma minus_int_code [code]:
+ "k - 0 = (k::int)"
+ "0 - l = uminus (l::int)"
+ "Pos m - Pos n = sub m n"
+ "Pos m - Neg n = Pos (m + n)"
+ "Neg m - Pos n = Neg (m + n)"
+ "Neg m - Neg n = sub n m"
+ by simp_all
+
+lemma times_int_code [code]:
+ "k * 0 = (0::int)"
+ "0 * l = (0::int)"
+ "Pos m * Pos n = Pos (m * n)"
+ "Pos m * Neg n = Neg (m * n)"
+ "Neg m * Pos n = Neg (m * n)"
+ "Neg m * Neg n = Pos (m * n)"
+ by simp_all
instantiation int :: equal
begin
definition
- "HOL.equal k l \<longleftrightarrow> k - l = (0\<Colon>int)"
+ "HOL.equal k l \<longleftrightarrow> k = (l::int)"
-instance by default (simp add: equal_int_def)
+instance by default (rule equal_int_def)
end
-lemma eq_number_of_int_code [code]:
- "HOL.equal (number_of k \<Colon> int) (number_of l) \<longleftrightarrow> HOL.equal k l"
- unfolding equal_int_def number_of_is_id ..
+lemma equal_int_code [code]:
+ "HOL.equal 0 (0::int) \<longleftrightarrow> True"
+ "HOL.equal 0 (Pos l) \<longleftrightarrow> False"
+ "HOL.equal 0 (Neg l) \<longleftrightarrow> False"
+ "HOL.equal (Pos k) 0 \<longleftrightarrow> False"
+ "HOL.equal (Pos k) (Pos l) \<longleftrightarrow> HOL.equal k l"
+ "HOL.equal (Pos k) (Neg l) \<longleftrightarrow> False"
+ "HOL.equal (Neg k) 0 \<longleftrightarrow> False"
+ "HOL.equal (Neg k) (Pos l) \<longleftrightarrow> False"
+ "HOL.equal (Neg k) (Neg l) \<longleftrightarrow> HOL.equal k l"
+ by (auto simp add: equal)
-lemma eq_int_code [code]:
- "HOL.equal Int.Pls Int.Pls \<longleftrightarrow> True"
- "HOL.equal Int.Pls Int.Min \<longleftrightarrow> False"
- "HOL.equal Int.Pls (Int.Bit0 k2) \<longleftrightarrow> HOL.equal Int.Pls k2"
- "HOL.equal Int.Pls (Int.Bit1 k2) \<longleftrightarrow> False"
- "HOL.equal Int.Min Int.Pls \<longleftrightarrow> False"
- "HOL.equal Int.Min Int.Min \<longleftrightarrow> True"
- "HOL.equal Int.Min (Int.Bit0 k2) \<longleftrightarrow> False"
- "HOL.equal Int.Min (Int.Bit1 k2) \<longleftrightarrow> HOL.equal Int.Min k2"
- "HOL.equal (Int.Bit0 k1) Int.Pls \<longleftrightarrow> HOL.equal k1 Int.Pls"
- "HOL.equal (Int.Bit1 k1) Int.Pls \<longleftrightarrow> False"
- "HOL.equal (Int.Bit0 k1) Int.Min \<longleftrightarrow> False"
- "HOL.equal (Int.Bit1 k1) Int.Min \<longleftrightarrow> HOL.equal k1 Int.Min"
- "HOL.equal (Int.Bit0 k1) (Int.Bit0 k2) \<longleftrightarrow> HOL.equal k1 k2"
- "HOL.equal (Int.Bit0 k1) (Int.Bit1 k2) \<longleftrightarrow> False"
- "HOL.equal (Int.Bit1 k1) (Int.Bit0 k2) \<longleftrightarrow> False"
- "HOL.equal (Int.Bit1 k1) (Int.Bit1 k2) \<longleftrightarrow> HOL.equal k1 k2"
- unfolding equal_eq by simp_all
-
-lemma eq_int_refl [code nbe]:
+lemma equal_int_refl [code nbe]:
"HOL.equal (k::int) k \<longleftrightarrow> True"
- by (rule equal_refl)
-
-lemma less_eq_number_of_int_code [code]:
- "(number_of k \<Colon> int) \<le> number_of l \<longleftrightarrow> k \<le> l"
- unfolding number_of_is_id ..
+ by (fact equal_refl)
lemma less_eq_int_code [code]:
- "Int.Pls \<le> Int.Pls \<longleftrightarrow> True"
- "Int.Pls \<le> Int.Min \<longleftrightarrow> False"
- "Int.Pls \<le> Int.Bit0 k \<longleftrightarrow> Int.Pls \<le> k"
- "Int.Pls \<le> Int.Bit1 k \<longleftrightarrow> Int.Pls \<le> k"
- "Int.Min \<le> Int.Pls \<longleftrightarrow> True"
- "Int.Min \<le> Int.Min \<longleftrightarrow> True"
- "Int.Min \<le> Int.Bit0 k \<longleftrightarrow> Int.Min < k"
- "Int.Min \<le> Int.Bit1 k \<longleftrightarrow> Int.Min \<le> k"
- "Int.Bit0 k \<le> Int.Pls \<longleftrightarrow> k \<le> Int.Pls"
- "Int.Bit1 k \<le> Int.Pls \<longleftrightarrow> k < Int.Pls"
- "Int.Bit0 k \<le> Int.Min \<longleftrightarrow> k \<le> Int.Min"
- "Int.Bit1 k \<le> Int.Min \<longleftrightarrow> k \<le> Int.Min"
- "Int.Bit0 k1 \<le> Int.Bit0 k2 \<longleftrightarrow> k1 \<le> k2"
- "Int.Bit0 k1 \<le> Int.Bit1 k2 \<longleftrightarrow> k1 \<le> k2"
- "Int.Bit1 k1 \<le> Int.Bit0 k2 \<longleftrightarrow> k1 < k2"
- "Int.Bit1 k1 \<le> Int.Bit1 k2 \<longleftrightarrow> k1 \<le> k2"
+ "0 \<le> (0::int) \<longleftrightarrow> True"
+ "0 \<le> Pos l \<longleftrightarrow> True"
+ "0 \<le> Neg l \<longleftrightarrow> False"
+ "Pos k \<le> 0 \<longleftrightarrow> False"
+ "Pos k \<le> Pos l \<longleftrightarrow> k \<le> l"
+ "Pos k \<le> Neg l \<longleftrightarrow> False"
+ "Neg k \<le> 0 \<longleftrightarrow> True"
+ "Neg k \<le> Pos l \<longleftrightarrow> True"
+ "Neg k \<le> Neg l \<longleftrightarrow> l \<le> k"
by simp_all
-lemma less_number_of_int_code [code]:
- "(number_of k \<Colon> int) < number_of l \<longleftrightarrow> k < l"
- unfolding number_of_is_id ..
-
lemma less_int_code [code]:
- "Int.Pls < Int.Pls \<longleftrightarrow> False"
- "Int.Pls < Int.Min \<longleftrightarrow> False"
- "Int.Pls < Int.Bit0 k \<longleftrightarrow> Int.Pls < k"
- "Int.Pls < Int.Bit1 k \<longleftrightarrow> Int.Pls \<le> k"
- "Int.Min < Int.Pls \<longleftrightarrow> True"
- "Int.Min < Int.Min \<longleftrightarrow> False"
- "Int.Min < Int.Bit0 k \<longleftrightarrow> Int.Min < k"
- "Int.Min < Int.Bit1 k \<longleftrightarrow> Int.Min < k"
- "Int.Bit0 k < Int.Pls \<longleftrightarrow> k < Int.Pls"
- "Int.Bit1 k < Int.Pls \<longleftrightarrow> k < Int.Pls"
- "Int.Bit0 k < Int.Min \<longleftrightarrow> k \<le> Int.Min"
- "Int.Bit1 k < Int.Min \<longleftrightarrow> k < Int.Min"
- "Int.Bit0 k1 < Int.Bit0 k2 \<longleftrightarrow> k1 < k2"
- "Int.Bit0 k1 < Int.Bit1 k2 \<longleftrightarrow> k1 \<le> k2"
- "Int.Bit1 k1 < Int.Bit0 k2 \<longleftrightarrow> k1 < k2"
- "Int.Bit1 k1 < Int.Bit1 k2 \<longleftrightarrow> k1 < k2"
+ "0 < (0::int) \<longleftrightarrow> False"
+ "0 < Pos l \<longleftrightarrow> True"
+ "0 < Neg l \<longleftrightarrow> False"
+ "Pos k < 0 \<longleftrightarrow> False"
+ "Pos k < Pos l \<longleftrightarrow> k < l"
+ "Pos k < Neg l \<longleftrightarrow> False"
+ "Neg k < 0 \<longleftrightarrow> True"
+ "Neg k < Pos l \<longleftrightarrow> True"
+ "Neg k < Neg l \<longleftrightarrow> l < k"
by simp_all
-definition
- nat_aux :: "int \<Rightarrow> nat \<Rightarrow> nat" where
- "nat_aux i n = nat i + n"
-
-lemma [code]:
- "nat_aux i n = (if i \<le> 0 then n else nat_aux (i - 1) (Suc n))" -- {* tail recursive *}
- by (auto simp add: nat_aux_def nat_eq_iff linorder_not_le order_less_imp_le
- dest: zless_imp_add1_zle)
+lemma nat_numeral [simp, code_abbrev]:
+ "nat (numeral k) = numeral k"
+ by (simp add: nat_eq_iff)
-lemma [code]: "nat i = nat_aux i 0"
- by (simp add: nat_aux_def)
-
-hide_const (open) nat_aux
+lemma nat_code [code]:
+ "nat (Int.Neg k) = 0"
+ "nat 0 = 0"
+ "nat (Int.Pos k) = nat_of_num k"
+ by (simp_all add: nat_of_num_numeral nat_numeral)
-lemma zero_is_num_zero [code, code_unfold]:
- "(0\<Colon>int) = Numeral0"
- by simp
+lemma (in ring_1) of_int_code [code]:
+ "of_int (Int.Neg k) = neg_numeral k"
+ "of_int 0 = 0"
+ "of_int (Int.Pos k) = numeral k"
+ by simp_all
-lemma one_is_num_one [code, code_unfold]:
- "(1\<Colon>int) = Numeral1"
- by simp
+
+text {* Serializer setup *}
code_modulename SML
Int Arith
@@ -2345,7 +1719,7 @@
quickcheck_params [default_type = int]
-hide_const (open) Pls Min Bit0 Bit1 succ pred
+hide_const (open) Pos Neg sub dup
subsection {* Legacy theorems *}
@@ -2378,3 +1752,4 @@
lemmas zpower_int = int_power [symmetric]
end
+
--- a/src/HOL/IsaMakefile Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/IsaMakefile Mon Mar 26 15:33:28 2012 +0200
@@ -195,6 +195,7 @@
Meson.thy \
Metis.thy \
Nat.thy \
+ Num.thy \
Option.thy \
Orderings.thy \
Partial_Function.thy \
@@ -341,7 +342,6 @@
Tools/Nitpick/nitpick_util.ML \
Tools/numeral.ML \
Tools/numeral_simprocs.ML \
- Tools/numeral_syntax.ML \
Tools/Predicate_Compile/core_data.ML \
Tools/Predicate_Compile/mode_inference.ML \
Tools/Predicate_Compile/predicate_compile_aux.ML \
@@ -444,24 +444,25 @@
Library/Bit.thy Library/Boolean_Algebra.thy Library/Cardinality.thy \
Library/Char_nat.thy Library/Code_Char.thy Library/Code_Char_chr.thy \
Library/Code_Char_ord.thy Library/Code_Integer.thy \
- Library/Code_Natural.thy Library/Code_Prolog.thy \
+ Library/Code_Nat.thy Library/Code_Natural.thy \
+ Library/Efficient_Nat.thy Library/Code_Prolog.thy \
Library/Code_Real_Approx_By_Float.thy \
Tools/Predicate_Compile/code_prolog.ML Library/ContNotDenum.thy \
Library/Cset.thy Library/Cset_Monad.thy Library/Continuity.thy \
Library/Convex.thy Library/Countable.thy \
+ Library/Dlist.thy Library/Dlist_Cset.thy Library/Eval_Witness.thy \
Library/DAList.thy Library/Dlist.thy Library/Dlist_Cset.thy \
- Library/Efficient_Nat.thy Library/Eval_Witness.thy \
+ Library/Eval_Witness.thy \
Library/Extended_Real.thy Library/Extended_Nat.thy Library/Float.thy \
Library/Formal_Power_Series.thy Library/Fraction_Field.thy \
Library/FrechetDeriv.thy Library/Cset.thy Library/FuncSet.thy \
- Library/Function_Algebras.thy \
- Library/Fundamental_Theorem_Algebra.thy Library/Glbs.thy \
- Library/Indicator_Function.thy Library/Infinite_Set.thy \
- Library/Inner_Product.thy Library/Kleene_Algebra.thy \
- Library/LaTeXsugar.thy Library/Lattice_Algebras.thy \
- Library/Lattice_Syntax.thy Library/Library.thy Library/List_Cset.thy \
- Library/List_Prefix.thy Library/List_lexord.thy Library/Mapping.thy \
- Library/Monad_Syntax.thy \
+ Library/Function_Algebras.thy Library/Fundamental_Theorem_Algebra.thy \
+ Library/Glbs.thy Library/Indicator_Function.thy \
+ Library/Infinite_Set.thy Library/Inner_Product.thy \
+ Library/Kleene_Algebra.thy Library/LaTeXsugar.thy \
+ Library/Lattice_Algebras.thy Library/Lattice_Syntax.thy \
+ Library/Library.thy Library/List_Cset.thy Library/List_Prefix.thy \
+ Library/List_lexord.thy Library/Mapping.thy Library/Monad_Syntax.thy \
Library/Multiset.thy Library/Nat_Bijection.thy \
Library/Numeral_Type.thy Library/Old_Recdef.thy \
Library/OptionalSugar.thy Library/Order_Relation.thy \
@@ -479,7 +480,7 @@
Library/State_Monad.thy Library/Ramsey.thy \
Library/Reflection.thy Library/Sublist_Order.thy \
Library/Sum_of_Squares.thy Library/Sum_of_Squares/sos_wrapper.ML \
- Library/Sum_of_Squares/sum_of_squares.ML \
+ Library/Sum_of_Squares/sum_of_squares.ML Library/Target_Numeral.thy \
Library/Transitive_Closure_Table.thy Library/Univ_Poly.thy \
Library/Wfrec.thy Library/While_Combinator.thy Library/Zorn.thy \
$(SRC)/Tools/adhoc_overloading.ML Library/positivstellensatz.ML \
@@ -758,11 +759,11 @@
HOL-Library-Codegenerator_Test: HOL-Library $(LOG)/HOL-Library-Codegenerator_Test.gz
-$(LOG)/HOL-Library-Codegenerator_Test.gz: $(OUT)/HOL-Library \
- Codegenerator_Test/ROOT.ML \
- Codegenerator_Test/Candidates.thy \
- Codegenerator_Test/Candidates_Pretty.thy \
- Codegenerator_Test/Generate.thy \
+$(LOG)/HOL-Library-Codegenerator_Test.gz: $(OUT)/HOL-Library \
+ Codegenerator_Test/ROOT.ML \
+ Codegenerator_Test/Candidates.thy \
+ Codegenerator_Test/Candidates_Pretty.thy \
+ Codegenerator_Test/Generate.thy \
Codegenerator_Test/Generate_Pretty.thy
@$(ISABELLE_TOOL) usedir -d false -g false -i false $(OUT)/HOL-Library Codegenerator_Test
@@ -920,6 +921,10 @@
HOL-Imperative_HOL: HOL $(LOG)/HOL-Imperative_HOL.gz
$(LOG)/HOL-Imperative_HOL.gz: $(OUT)/HOL \
+ Library/Code_Integer.thy \
+ Library/Code_Nat.thy \
+ Library/Code_Natural.thy \
+ Library/Efficient_Nat.thy \
Imperative_HOL/Array.thy \
Imperative_HOL/Heap.thy \
Imperative_HOL/Heap_Monad.thy \
@@ -943,6 +948,10 @@
HOL-Decision_Procs: HOL $(LOG)/HOL-Decision_Procs.gz
$(LOG)/HOL-Decision_Procs.gz: $(OUT)/HOL \
+ Library/Code_Integer.thy \
+ Library/Code_Nat.thy \
+ Library/Code_Natural.thy \
+ Library/Efficient_Nat.thy \
Decision_Procs/Approximation.thy \
Decision_Procs/Commutative_Ring.thy \
Decision_Procs/Commutative_Ring_Complete.thy \
@@ -991,9 +1000,12 @@
HOL-Proofs-Extraction: HOL-Proofs $(LOG)/HOL-Proofs-Extraction.gz
$(LOG)/HOL-Proofs-Extraction.gz: $(OUT)/HOL-Proofs \
- Library/Efficient_Nat.thy Proofs/Extraction/Euclid.thy \
+ Library/Code_Integer.thy Library/Code_Nat.thy \
+ Library/Code_Natural.thy Library/Efficient_Nat.thy \
+ Proofs/Extraction/Euclid.thy \
Proofs/Extraction/Greatest_Common_Divisor.thy \
- Proofs/Extraction/Higman.thy Proofs/Extraction/Higman_Extraction.thy \
+ Proofs/Extraction/Higman.thy \
+ Proofs/Extraction/Higman_Extraction.thy \
Proofs/Extraction/Pigeonhole.thy \
Proofs/Extraction/QuotRem.thy Proofs/Extraction/ROOT.ML \
Proofs/Extraction/Util.thy Proofs/Extraction/Warshall.thy \
@@ -1113,15 +1125,17 @@
HOL-ex: HOL $(LOG)/HOL-ex.gz
$(LOG)/HOL-ex.gz: $(OUT)/HOL Decision_Procs/Commutative_Ring.thy \
+ Library/Code_Integer.thy Library/Code_Nat.thy \
+ Library/Code_Natural.thy Library/Efficient_Nat.thy \
Number_Theory/Primes.thy ex/Abstract_NAT.thy ex/Antiquote.thy \
ex/Arith_Examples.thy ex/Arithmetic_Series_Complex.thy ex/BT.thy \
ex/BinEx.thy ex/Binary.thy ex/Birthday_Paradox.thy ex/CTL.thy \
ex/Case_Product.thy ex/Chinese.thy ex/Classical.thy \
- ex/Coercion_Examples.thy ex/Coherent.thy \
- ex/Dedekind_Real.thy ex/Efficient_Nat_examples.thy \
+ ex/Code_Nat_examples.thy \
+ ex/Coercion_Examples.thy ex/Coherent.thy ex/Dedekind_Real.thy \
ex/Eval_Examples.thy ex/Executable_Relation.thy ex/Fundefs.thy \
ex/Gauge_Integration.thy ex/Groebner_Examples.thy ex/Guess.thy \
- ex/HarmonicSeries.thy ex/Hebrew.thy ex/Hex_Bin_Examples.thy \
+ ex/HarmonicSeries.thy ex/Hebrew.thy ex/Hex_Bin_Examples.thy \
ex/Higher_Order_Logic.thy ex/Iff_Oracle.thy ex/Induction_Schema.thy \
ex/Interpretation_with_Defs.thy ex/Intuitionistic.thy \
ex/Lagrange.thy ex/List_to_Set_Comprehension_Examples.thy \
--- a/src/HOL/Library/BigO.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Library/BigO.thy Mon Mar 26 15:33:28 2012 +0200
@@ -132,7 +132,6 @@
apply (simp add: abs_triangle_ineq)
apply (simp add: order_less_le)
apply (rule mult_nonneg_nonneg)
- apply (rule add_nonneg_nonneg)
apply auto
apply (rule_tac x = "%n. if (abs (f n)) < abs (g n) then x n else 0"
in exI)
@@ -150,11 +149,8 @@
apply (rule abs_triangle_ineq)
apply (simp add: order_less_le)
apply (rule mult_nonneg_nonneg)
- apply (rule add_nonneg_nonneg)
- apply (erule order_less_imp_le)+
+ apply (erule order_less_imp_le)
apply simp
- apply (rule ext)
- apply (auto simp add: if_splits linorder_not_le)
done
lemma bigo_plus_subset2 [intro]: "A <= O(f) ==> B <= O(f) ==> A \<oplus> B <= O(f)"
--- a/src/HOL/Library/Binomial.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Library/Binomial.thy Mon Mar 26 15:33:28 2012 +0200
@@ -350,7 +350,7 @@
have eq: "(- (1\<Colon>'a)) ^ n = setprod (\<lambda>i. - 1) {0 .. n - 1}"
by auto
from n0 have ?thesis
- by (simp add: pochhammer_def gbinomial_def field_simps eq setprod_timesf[symmetric])}
+ by (simp add: pochhammer_def gbinomial_def field_simps eq setprod_timesf[symmetric] del: minus_one) (* FIXME: del: minus_one *)}
ultimately show ?thesis by blast
qed
@@ -417,8 +417,8 @@
from eq[symmetric]
have ?thesis using kn
apply (simp add: binomial_fact[OF kn, where ?'a = 'a]
- gbinomial_pochhammer field_simps pochhammer_Suc_setprod)
- apply (simp add: pochhammer_Suc_setprod fact_altdef_nat h of_nat_setprod setprod_timesf[symmetric] eq' del: One_nat_def power_Suc)
+ gbinomial_pochhammer field_simps pochhammer_Suc_setprod del: minus_one)
+ 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)
unfolding setprod_Un_disjoint[OF th0, unfolded eq3, of "of_nat:: nat \<Rightarrow> 'a"] eq[unfolded h]
unfolding mult_assoc[symmetric]
unfolding setprod_timesf[symmetric]
--- a/src/HOL/Library/Bit.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Library/Bit.thy Mon Mar 26 15:33:28 2012 +0200
@@ -96,27 +96,18 @@
subsection {* Numerals at type @{typ bit} *}
-instantiation bit :: number_ring
-begin
-
-definition number_of_bit_def:
- "(number_of w :: bit) = of_int w"
-
-instance proof
-qed (rule number_of_bit_def)
-
-end
-
text {* All numerals reduce to either 0 or 1. *}
lemma bit_minus1 [simp]: "-1 = (1 :: bit)"
- by (simp only: number_of_Min uminus_bit_def)
+ by (simp only: minus_one [symmetric] uminus_bit_def)
+
+lemma bit_neg_numeral [simp]: "(neg_numeral w :: bit) = numeral w"
+ by (simp only: neg_numeral_def uminus_bit_def)
-lemma bit_number_of_even [simp]: "number_of (Int.Bit0 w) = (0 :: bit)"
- by (simp only: number_of_Bit0 add_0_left bit_add_self)
+lemma bit_numeral_even [simp]: "numeral (Num.Bit0 w) = (0 :: bit)"
+ by (simp only: numeral_Bit0 bit_add_self)
-lemma bit_number_of_odd [simp]: "number_of (Int.Bit1 w) = (1 :: bit)"
- by (simp only: number_of_Bit1 add_assoc bit_add_self
- monoid_add_class.add_0_right)
+lemma bit_numeral_odd [simp]: "numeral (Num.Bit1 w) = (1 :: bit)"
+ by (simp only: numeral_Bit1 bit_add_self add_0_left)
end
--- a/src/HOL/Library/Cardinality.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Library/Cardinality.thy Mon Mar 26 15:33:28 2012 +0200
@@ -5,7 +5,7 @@
header {* Cardinality of types *}
theory Cardinality
-imports Main
+imports "~~/src/HOL/Main"
begin
subsection {* Preliminary lemmas *}
--- a/src/HOL/Library/Code_Integer.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Library/Code_Integer.thy Mon Mar 26 15:33:28 2012 +0200
@@ -9,6 +9,43 @@
begin
text {*
+ Representation-ignorant code equations for conversions.
+*}
+
+lemma nat_code [code]:
+ "nat k = (if k \<le> 0 then 0 else
+ let
+ (l, j) = divmod_int k 2;
+ l' = 2 * nat l
+ in if j = 0 then l' else Suc l')"
+proof -
+ have "2 = nat 2" by simp
+ show ?thesis
+ apply (auto simp add: Let_def divmod_int_mod_div not_le
+ nat_div_distrib nat_mult_distrib mult_div_cancel mod_2_not_eq_zero_eq_one_int)
+ apply (unfold `2 = nat 2`)
+ apply (subst nat_mod_distrib [symmetric])
+ apply simp_all
+ done
+qed
+
+lemma (in ring_1) of_int_code:
+ "of_int k = (if k = 0 then 0
+ else if k < 0 then - of_int (- k)
+ else let
+ (l, j) = divmod_int k 2;
+ l' = 2 * of_int l
+ in if j = 0 then l' else l' + 1)"
+proof -
+ from mod_div_equality have *: "of_int k = of_int (k div 2 * 2 + k mod 2)" by simp
+ show ?thesis
+ by (simp add: Let_def divmod_int_mod_div mod_2_not_eq_zero_eq_one_int
+ of_int_add [symmetric]) (simp add: * mult_commute)
+qed
+
+declare of_int_code [code]
+
+text {*
HOL numeral expressions are mapped to integer literals
in target languages, using predefined target language
operations for abstract integer operations.
@@ -24,42 +61,21 @@
code_instance int :: equal
(Haskell -)
+code_const "0::int"
+ (SML "0")
+ (OCaml "Big'_int.zero'_big'_int")
+ (Haskell "0")
+ (Scala "BigInt(0)")
+
setup {*
- fold (Numeral.add_code @{const_name number_int_inst.number_of_int}
- true Code_Printer.literal_numeral) ["SML", "OCaml", "Haskell", "Scala"]
+ fold (Numeral.add_code @{const_name Int.Pos}
+ false Code_Printer.literal_numeral) ["SML", "OCaml", "Haskell", "Scala"]
*}
-code_const "Int.Pls" and "Int.Min" and "Int.Bit0" and "Int.Bit1"
- (SML "raise/ Fail/ \"Pls\""
- and "raise/ Fail/ \"Min\""
- and "!((_);/ raise/ Fail/ \"Bit0\")"
- and "!((_);/ raise/ Fail/ \"Bit1\")")
- (OCaml "failwith/ \"Pls\""
- and "failwith/ \"Min\""
- and "!((_);/ failwith/ \"Bit0\")"
- and "!((_);/ failwith/ \"Bit1\")")
- (Haskell "error/ \"Pls\""
- and "error/ \"Min\""
- and "error/ \"Bit0\""
- and "error/ \"Bit1\"")
- (Scala "!error(\"Pls\")"
- and "!error(\"Min\")"
- and "!error(\"Bit0\")"
- and "!error(\"Bit1\")")
-
-code_const Int.pred
- (SML "IntInf.- ((_), 1)")
- (OCaml "Big'_int.pred'_big'_int")
- (Haskell "!(_/ -/ 1)")
- (Scala "!(_ -/ 1)")
- (Eval "!(_/ -/ 1)")
-
-code_const Int.succ
- (SML "IntInf.+ ((_), 1)")
- (OCaml "Big'_int.succ'_big'_int")
- (Haskell "!(_/ +/ 1)")
- (Scala "!(_ +/ 1)")
- (Eval "!(_/ +/ 1)")
+setup {*
+ fold (Numeral.add_code @{const_name Int.Neg}
+ true Code_Printer.literal_numeral) ["SML", "OCaml", "Haskell", "Scala"]
+*}
code_const "op + \<Colon> int \<Rightarrow> int \<Rightarrow> int"
(SML "IntInf.+ ((_), (_))")
@@ -82,6 +98,19 @@
(Scala infixl 7 "-")
(Eval infixl 8 "-")
+code_const Int.dup
+ (SML "IntInf.*/ (2,/ (_))")
+ (OCaml "Big'_int.mult'_big'_int/ 2")
+ (Haskell "!(2 * _)")
+ (Scala "!(2 * _)")
+ (Eval "!(2 * _)")
+
+code_const Int.sub
+ (SML "!(raise/ Fail/ \"sub\")")
+ (OCaml "failwith/ \"sub\"")
+ (Haskell "error/ \"sub\"")
+ (Scala "!error(\"sub\")")
+
code_const "op * \<Colon> int \<Rightarrow> int \<Rightarrow> int"
(SML "IntInf.* ((_), (_))")
(OCaml "Big'_int.mult'_big'_int")
@@ -124,9 +153,7 @@
(Scala "!_.as'_BigInt")
(Eval "_")
-text {* Evaluation *}
-
code_const "Code_Evaluation.term_of \<Colon> int \<Rightarrow> term"
(Eval "HOLogic.mk'_number/ HOLogic.intT")
-end
\ No newline at end of file
+end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Library/Code_Nat.thy Mon Mar 26 15:33:28 2012 +0200
@@ -0,0 +1,258 @@
+(* Title: HOL/Library/Code_Nat.thy
+ Author: Stefan Berghofer, Florian Haftmann, TU Muenchen
+*)
+
+header {* Implementation of natural numbers as binary numerals *}
+
+theory Code_Nat
+imports Main
+begin
+
+text {*
+ When generating code for functions on natural numbers, the
+ canonical representation using @{term "0::nat"} and
+ @{term Suc} is unsuitable for computations involving large
+ numbers. This theory refines the representation of
+ natural numbers for code generation to use binary
+ numerals, which do not grow linear in size but logarithmic.
+*}
+
+subsection {* Representation *}
+
+lemma [code_abbrev]:
+ "nat_of_num = numeral"
+ by (fact nat_of_num_numeral)
+
+code_datatype "0::nat" nat_of_num
+
+lemma [code]:
+ "num_of_nat 0 = Num.One"
+ "num_of_nat (nat_of_num k) = k"
+ by (simp_all add: nat_of_num_inverse)
+
+lemma [code]:
+ "(1\<Colon>nat) = Numeral1"
+ by simp
+
+lemma [code_abbrev]: "Numeral1 = (1\<Colon>nat)"
+ by simp
+
+lemma [code]:
+ "Suc n = n + 1"
+ by simp
+
+
+subsection {* Basic arithmetic *}
+
+lemma [code, code del]:
+ "(plus :: nat \<Rightarrow> _) = plus" ..
+
+lemma plus_nat_code [code]:
+ "nat_of_num k + nat_of_num l = nat_of_num (k + l)"
+ "m + 0 = (m::nat)"
+ "0 + n = (n::nat)"
+ by (simp_all add: nat_of_num_numeral)
+
+text {* Bounded subtraction needs some auxiliary *}
+
+definition dup :: "nat \<Rightarrow> nat" where
+ "dup n = n + n"
+
+lemma dup_code [code]:
+ "dup 0 = 0"
+ "dup (nat_of_num k) = nat_of_num (Num.Bit0 k)"
+ unfolding Num_def by (simp_all add: dup_def numeral_Bit0)
+
+definition sub :: "num \<Rightarrow> num \<Rightarrow> nat option" where
+ "sub k l = (if k \<ge> l then Some (numeral k - numeral l) else None)"
+
+lemma sub_code [code]:
+ "sub Num.One Num.One = Some 0"
+ "sub (Num.Bit0 m) Num.One = Some (nat_of_num (Num.BitM m))"
+ "sub (Num.Bit1 m) Num.One = Some (nat_of_num (Num.Bit0 m))"
+ "sub Num.One (Num.Bit0 n) = None"
+ "sub Num.One (Num.Bit1 n) = None"
+ "sub (Num.Bit0 m) (Num.Bit0 n) = Option.map dup (sub m n)"
+ "sub (Num.Bit1 m) (Num.Bit1 n) = Option.map dup (sub m n)"
+ "sub (Num.Bit1 m) (Num.Bit0 n) = Option.map (\<lambda>q. dup q + 1) (sub m n)"
+ "sub (Num.Bit0 m) (Num.Bit1 n) = (case sub m n of None \<Rightarrow> None
+ | Some q \<Rightarrow> if q = 0 then None else Some (dup q - 1))"
+ apply (auto simp add: nat_of_num_numeral
+ Num.dbl_def Num.dbl_inc_def Num.dbl_dec_def
+ Let_def le_imp_diff_is_add BitM_plus_one sub_def dup_def)
+ apply (simp_all add: sub_non_positive)
+ apply (simp_all add: sub_non_negative [symmetric, where ?'a = int])
+ done
+
+lemma [code, code del]:
+ "(minus :: nat \<Rightarrow> _) = minus" ..
+
+lemma minus_nat_code [code]:
+ "nat_of_num k - nat_of_num l = (case sub k l of None \<Rightarrow> 0 | Some j \<Rightarrow> j)"
+ "m - 0 = (m::nat)"
+ "0 - n = (0::nat)"
+ by (simp_all add: nat_of_num_numeral sub_non_positive sub_def)
+
+lemma [code, code del]:
+ "(times :: nat \<Rightarrow> _) = times" ..
+
+lemma times_nat_code [code]:
+ "nat_of_num k * nat_of_num l = nat_of_num (k * l)"
+ "m * 0 = (0::nat)"
+ "0 * n = (0::nat)"
+ by (simp_all add: nat_of_num_numeral)
+
+lemma [code, code del]:
+ "(HOL.equal :: nat \<Rightarrow> _) = HOL.equal" ..
+
+lemma equal_nat_code [code]:
+ "HOL.equal 0 (0::nat) \<longleftrightarrow> True"
+ "HOL.equal 0 (nat_of_num l) \<longleftrightarrow> False"
+ "HOL.equal (nat_of_num k) 0 \<longleftrightarrow> False"
+ "HOL.equal (nat_of_num k) (nat_of_num l) \<longleftrightarrow> HOL.equal k l"
+ by (simp_all add: nat_of_num_numeral equal)
+
+lemma equal_nat_refl [code nbe]:
+ "HOL.equal (n::nat) n \<longleftrightarrow> True"
+ by (rule equal_refl)
+
+lemma [code, code del]:
+ "(less_eq :: nat \<Rightarrow> _) = less_eq" ..
+
+lemma less_eq_nat_code [code]:
+ "0 \<le> (n::nat) \<longleftrightarrow> True"
+ "nat_of_num k \<le> 0 \<longleftrightarrow> False"
+ "nat_of_num k \<le> nat_of_num l \<longleftrightarrow> k \<le> l"
+ by (simp_all add: nat_of_num_numeral)
+
+lemma [code, code del]:
+ "(less :: nat \<Rightarrow> _) = less" ..
+
+lemma less_nat_code [code]:
+ "(m::nat) < 0 \<longleftrightarrow> False"
+ "0 < nat_of_num l \<longleftrightarrow> True"
+ "nat_of_num k < nat_of_num l \<longleftrightarrow> k < l"
+ by (simp_all add: nat_of_num_numeral)
+
+
+subsection {* Conversions *}
+
+lemma [code, code del]:
+ "of_nat = of_nat" ..
+
+lemma of_nat_code [code]:
+ "of_nat 0 = 0"
+ "of_nat (nat_of_num k) = numeral k"
+ by (simp_all add: nat_of_num_numeral)
+
+
+subsection {* Case analysis *}
+
+text {*
+ Case analysis on natural numbers is rephrased using a conditional
+ expression:
+*}
+
+lemma [code, code_unfold]:
+ "nat_case = (\<lambda>f g n. if n = 0 then f else g (n - 1))"
+ by (auto simp add: fun_eq_iff dest!: gr0_implies_Suc)
+
+
+subsection {* Preprocessors *}
+
+text {*
+ The term @{term "Suc n"} is no longer a valid pattern.
+ Therefore, all occurrences of this term in a position
+ where a pattern is expected (i.e.~on the left-hand side of a recursion
+ equation) must be eliminated.
+ This can be accomplished by applying the following transformation rules:
+*}
+
+lemma Suc_if_eq: "(\<And>n. f (Suc n) \<equiv> h n) \<Longrightarrow> f 0 \<equiv> g \<Longrightarrow>
+ f n \<equiv> if n = 0 then g else h (n - 1)"
+ by (rule eq_reflection) (cases n, simp_all)
+
+text {*
+ The rules above are built into a preprocessor that is plugged into
+ the code generator. Since the preprocessor for introduction rules
+ does not know anything about modes, some of the modes that worked
+ for the canonical representation of natural numbers may no longer work.
+*}
+
+(*<*)
+setup {*
+let
+
+fun remove_suc thy thms =
+ let
+ val vname = singleton (Name.variant_list (map fst
+ (fold (Term.add_var_names o Thm.full_prop_of) thms []))) "n";
+ val cv = cterm_of thy (Var ((vname, 0), HOLogic.natT));
+ fun lhs_of th = snd (Thm.dest_comb
+ (fst (Thm.dest_comb (cprop_of th))));
+ fun rhs_of th = snd (Thm.dest_comb (cprop_of th));
+ fun find_vars ct = (case term_of ct of
+ (Const (@{const_name Suc}, _) $ Var _) => [(cv, snd (Thm.dest_comb ct))]
+ | _ $ _ =>
+ let val (ct1, ct2) = Thm.dest_comb ct
+ in
+ map (apfst (fn ct => Thm.apply ct ct2)) (find_vars ct1) @
+ map (apfst (Thm.apply ct1)) (find_vars ct2)
+ end
+ | _ => []);
+ val eqs = maps
+ (fn th => map (pair th) (find_vars (lhs_of th))) thms;
+ fun mk_thms (th, (ct, cv')) =
+ let
+ val th' =
+ Thm.implies_elim
+ (Conv.fconv_rule (Thm.beta_conversion true)
+ (Drule.instantiate'
+ [SOME (ctyp_of_term ct)] [SOME (Thm.lambda cv ct),
+ SOME (Thm.lambda cv' (rhs_of th)), NONE, SOME cv']
+ @{thm Suc_if_eq})) (Thm.forall_intr cv' th)
+ in
+ case map_filter (fn th'' =>
+ SOME (th'', singleton
+ (Variable.trade (K (fn [th'''] => [th''' RS th']))
+ (Variable.global_thm_context th'')) th'')
+ handle THM _ => NONE) thms of
+ [] => NONE
+ | thps =>
+ let val (ths1, ths2) = split_list thps
+ in SOME (subtract Thm.eq_thm (th :: ths1) thms @ ths2) end
+ end
+ in get_first mk_thms eqs end;
+
+fun eqn_suc_base_preproc thy thms =
+ let
+ val dest = fst o Logic.dest_equals o prop_of;
+ val contains_suc = exists_Const (fn (c, _) => c = @{const_name Suc});
+ in
+ if forall (can dest) thms andalso exists (contains_suc o dest) thms
+ then thms |> perhaps_loop (remove_suc thy) |> (Option.map o map) Drule.zero_var_indexes
+ else NONE
+ end;
+
+val eqn_suc_preproc = Code_Preproc.simple_functrans eqn_suc_base_preproc;
+
+in
+
+ Code_Preproc.add_functrans ("eqn_Suc", eqn_suc_preproc)
+
+end;
+*}
+(*>*)
+
+code_modulename SML
+ Code_Nat Arith
+
+code_modulename OCaml
+ Code_Nat Arith
+
+code_modulename Haskell
+ Code_Nat Arith
+
+hide_const (open) dup sub
+
+end
--- a/src/HOL/Library/Code_Natural.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Library/Code_Natural.thy Mon Mar 26 15:33:28 2012 +0200
@@ -106,22 +106,26 @@
(Scala "Natural")
setup {*
- fold (Numeral.add_code @{const_name number_code_numeral_inst.number_of_code_numeral}
+ fold (Numeral.add_code @{const_name Code_Numeral.Num}
false Code_Printer.literal_alternative_numeral) ["Haskell", "Scala"]
*}
code_instance code_numeral :: equal
(Haskell -)
-code_const "op + \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral"
+code_const "0::code_numeral"
+ (Haskell "0")
+ (Scala "Natural(0)")
+
+code_const "plus \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral"
(Haskell infixl 6 "+")
(Scala infixl 7 "+")
-code_const "op - \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral"
+code_const "minus \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral"
(Haskell infixl 6 "-")
(Scala infixl 7 "-")
-code_const "op * \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral"
+code_const "times \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral"
(Haskell infixl 7 "*")
(Scala infixl 8 "*")
@@ -133,11 +137,11 @@
(Haskell infix 4 "==")
(Scala infixl 5 "==")
-code_const "op \<le> \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> bool"
+code_const "less_eq \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> bool"
(Haskell infix 4 "<=")
(Scala infixl 4 "<=")
-code_const "op < \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> bool"
+code_const "less \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> bool"
(Haskell infix 4 "<")
(Scala infixl 4 "<")
--- a/src/HOL/Library/Code_Prolog.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Library/Code_Prolog.thy Mon Mar 26 15:33:28 2012 +0200
@@ -11,8 +11,10 @@
section {* Setup for Numerals *}
-setup {* Predicate_Compile_Data.ignore_consts [@{const_name number_of}] *}
-setup {* Predicate_Compile_Data.keep_functions [@{const_name number_of}] *}
+setup {* Predicate_Compile_Data.ignore_consts
+ [@{const_name numeral}, @{const_name neg_numeral}] *}
+
+setup {* Predicate_Compile_Data.keep_functions
+ [@{const_name numeral}, @{const_name neg_numeral}] *}
end
-
--- a/src/HOL/Library/Code_Real_Approx_By_Float.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Library/Code_Real_Approx_By_Float.thy Mon Mar 26 15:33:28 2012 +0200
@@ -129,9 +129,23 @@
lemma of_int_eq_real_of_int[code_unfold]: "of_int = real_of_int"
unfolding real_of_int_def ..
-hide_const (open) real_of_int
+lemma [code_unfold del]:
+ "0 \<equiv> (of_rat 0 :: real)"
+ by simp
+
+lemma [code_unfold del]:
+ "1 \<equiv> (of_rat 1 :: real)"
+ by simp
-declare number_of_real_code [code_unfold del]
+lemma [code_unfold del]:
+ "numeral k \<equiv> (of_rat (numeral k) :: real)"
+ by simp
+
+lemma [code_unfold del]:
+ "neg_numeral k \<equiv> (of_rat (neg_numeral k) :: real)"
+ by simp
+
+hide_const (open) real_of_int
notepad
begin
--- a/src/HOL/Library/Efficient_Nat.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Library/Efficient_Nat.thy Mon Mar 26 15:33:28 2012 +0200
@@ -5,175 +5,16 @@
header {* Implementation of natural numbers by target-language integers *}
theory Efficient_Nat
-imports Code_Integer Main
+imports Code_Nat Code_Integer Main
begin
text {*
- When generating code for functions on natural numbers, the
- canonical representation using @{term "0::nat"} and
- @{term Suc} is unsuitable for computations involving large
- numbers. The efficiency of the generated code can be improved
+ The efficiency of the generated code for natural numbers can be improved
drastically by implementing natural numbers by target-language
integers. To do this, just include this theory.
*}
-subsection {* Basic arithmetic *}
-
-text {*
- Most standard arithmetic functions on natural numbers are implemented
- using their counterparts on the integers:
-*}
-
-code_datatype number_nat_inst.number_of_nat
-
-lemma zero_nat_code [code, code_unfold]:
- "0 = (Numeral0 :: nat)"
- by simp
-
-lemma one_nat_code [code, code_unfold]:
- "1 = (Numeral1 :: nat)"
- by simp
-
-lemma Suc_code [code]:
- "Suc n = n + 1"
- by simp
-
-lemma plus_nat_code [code]:
- "n + m = nat (of_nat n + of_nat m)"
- by simp
-
-lemma minus_nat_code [code]:
- "n - m = nat (of_nat n - of_nat m)"
- by simp
-
-lemma times_nat_code [code]:
- "n * m = nat (of_nat n * of_nat m)"
- unfolding of_nat_mult [symmetric] by simp
-
-lemma divmod_nat_code [code]:
- "divmod_nat n m = map_pair nat nat (pdivmod (of_nat n) (of_nat m))"
- by (simp add: map_pair_def split_def pdivmod_def nat_div_distrib nat_mod_distrib divmod_nat_div_mod)
-
-lemma eq_nat_code [code]:
- "HOL.equal n m \<longleftrightarrow> HOL.equal (of_nat n \<Colon> int) (of_nat m)"
- by (simp add: equal)
-
-lemma eq_nat_refl [code nbe]:
- "HOL.equal (n::nat) n \<longleftrightarrow> True"
- by (rule equal_refl)
-
-lemma less_eq_nat_code [code]:
- "n \<le> m \<longleftrightarrow> (of_nat n \<Colon> int) \<le> of_nat m"
- by simp
-
-lemma less_nat_code [code]:
- "n < m \<longleftrightarrow> (of_nat n \<Colon> int) < of_nat m"
- by simp
-
-subsection {* Case analysis *}
-
-text {*
- Case analysis on natural numbers is rephrased using a conditional
- expression:
-*}
-
-lemma [code, code_unfold]:
- "nat_case = (\<lambda>f g n. if n = 0 then f else g (n - 1))"
- by (auto simp add: fun_eq_iff dest!: gr0_implies_Suc)
-
-
-subsection {* Preprocessors *}
-
-text {*
- In contrast to @{term "Suc n"}, the term @{term "n + (1::nat)"} is no longer
- a constructor term. Therefore, all occurrences of this term in a position
- where a pattern is expected (i.e.\ on the left-hand side of a recursion
- equation or in the arguments of an inductive relation in an introduction
- rule) must be eliminated.
- This can be accomplished by applying the following transformation rules:
-*}
-
-lemma Suc_if_eq: "(\<And>n. f (Suc n) \<equiv> h n) \<Longrightarrow> f 0 \<equiv> g \<Longrightarrow>
- f n \<equiv> if n = 0 then g else h (n - 1)"
- by (rule eq_reflection) (cases n, simp_all)
-
-lemma Suc_clause: "(\<And>n. P n (Suc n)) \<Longrightarrow> n \<noteq> 0 \<Longrightarrow> P (n - 1) n"
- by (cases n) simp_all
-
-text {*
- The rules above are built into a preprocessor that is plugged into
- the code generator. Since the preprocessor for introduction rules
- does not know anything about modes, some of the modes that worked
- for the canonical representation of natural numbers may no longer work.
-*}
-
-(*<*)
-setup {*
-let
-
-fun remove_suc thy thms =
- let
- val vname = singleton (Name.variant_list (map fst
- (fold (Term.add_var_names o Thm.full_prop_of) thms []))) "n";
- val cv = cterm_of thy (Var ((vname, 0), HOLogic.natT));
- fun lhs_of th = snd (Thm.dest_comb
- (fst (Thm.dest_comb (cprop_of th))));
- fun rhs_of th = snd (Thm.dest_comb (cprop_of th));
- fun find_vars ct = (case term_of ct of
- (Const (@{const_name Suc}, _) $ Var _) => [(cv, snd (Thm.dest_comb ct))]
- | _ $ _ =>
- let val (ct1, ct2) = Thm.dest_comb ct
- in
- map (apfst (fn ct => Thm.apply ct ct2)) (find_vars ct1) @
- map (apfst (Thm.apply ct1)) (find_vars ct2)
- end
- | _ => []);
- val eqs = maps
- (fn th => map (pair th) (find_vars (lhs_of th))) thms;
- fun mk_thms (th, (ct, cv')) =
- let
- val th' =
- Thm.implies_elim
- (Conv.fconv_rule (Thm.beta_conversion true)
- (Drule.instantiate'
- [SOME (ctyp_of_term ct)] [SOME (Thm.lambda cv ct),
- SOME (Thm.lambda cv' (rhs_of th)), NONE, SOME cv']
- @{thm Suc_if_eq})) (Thm.forall_intr cv' th)
- in
- case map_filter (fn th'' =>
- SOME (th'', singleton
- (Variable.trade (K (fn [th'''] => [th''' RS th']))
- (Variable.global_thm_context th'')) th'')
- handle THM _ => NONE) thms of
- [] => NONE
- | thps =>
- let val (ths1, ths2) = split_list thps
- in SOME (subtract Thm.eq_thm (th :: ths1) thms @ ths2) end
- end
- in get_first mk_thms eqs end;
-
-fun eqn_suc_base_preproc thy thms =
- let
- val dest = fst o Logic.dest_equals o prop_of;
- val contains_suc = exists_Const (fn (c, _) => c = @{const_name Suc});
- in
- if forall (can dest) thms andalso exists (contains_suc o dest) thms
- then thms |> perhaps_loop (remove_suc thy) |> (Option.map o map) Drule.zero_var_indexes
- else NONE
- end;
-
-val eqn_suc_preproc = Code_Preproc.simple_functrans eqn_suc_base_preproc;
-
-in
-
- Code_Preproc.add_functrans ("eqn_Suc", eqn_suc_preproc)
-
-end;
-*}
-(*>*)
-
-
-subsection {* Target language setup *}
+subsection {* Target language fundamentals *}
text {*
For ML, we map @{typ nat} to target language integers, where we
@@ -282,47 +123,32 @@
code_instance nat :: equal
(Haskell -)
-text {*
- Natural numerals.
-*}
-
-lemma [code_abbrev]:
- "number_nat_inst.number_of_nat i = nat (number_of i)"
- -- {* this interacts as desired with @{thm nat_number_of_def} *}
- by (simp add: number_nat_inst.number_of_nat)
-
setup {*
- fold (Numeral.add_code @{const_name number_nat_inst.number_of_nat}
+ fold (Numeral.add_code @{const_name nat_of_num}
false Code_Printer.literal_positive_numeral) ["SML", "OCaml", "Haskell", "Scala"]
*}
+code_const "0::nat"
+ (SML "0")
+ (OCaml "Big'_int.zero'_big'_int")
+ (Haskell "0")
+ (Scala "Nat(0)")
+
+
+subsection {* Conversions *}
+
text {*
Since natural numbers are implemented
- using integers in ML, the coercion function @{const "of_nat"} of type
+ using integers in ML, the coercion function @{term "int"} of type
@{typ "nat \<Rightarrow> int"} is simply implemented by the identity function.
For the @{const nat} function for converting an integer to a natural
- number, we give a specific implementation using an ML function that
+ number, we give a specific implementation using an ML expression that
returns its input value, provided that it is non-negative, and otherwise
returns @{text "0"}.
*}
definition int :: "nat \<Rightarrow> int" where
- [code del, code_abbrev]: "int = of_nat"
-
-lemma int_code' [code]:
- "int (number_of l) = (if neg (number_of l \<Colon> int) then 0 else number_of l)"
- unfolding int_nat_number_of [folded int_def] ..
-
-lemma nat_code' [code]:
- "nat (number_of l) = (if neg (number_of l \<Colon> int) then 0 else number_of l)"
- unfolding nat_number_of_def number_of_is_id neg_def by simp
-
-lemma of_nat_int: (* FIXME delete candidate *)
- "of_nat = int" by (simp add: int_def)
-
-lemma of_nat_aux_int [code_unfold]:
- "of_nat_aux (\<lambda>i. i + 1) k 0 = int k"
- by (simp add: int_def Nat.of_nat_code)
+ [code_abbrev]: "int = of_nat"
code_const int
(SML "_")
@@ -331,7 +157,7 @@
code_const nat
(SML "IntInf.max/ (0,/ _)")
(OCaml "Big'_int.max'_big'_int/ Big'_int.zero'_big'_int")
- (Eval "Integer.max/ _/ 0")
+ (Eval "Integer.max/ 0")
text {* For Haskell and Scala, things are slightly different again. *}
@@ -339,7 +165,26 @@
(Haskell "toInteger" and "fromInteger")
(Scala "!_.as'_BigInt" and "Nat")
-text {* Conversion from and to code numerals. *}
+text {* Alternativ implementation for @{const of_nat} *}
+
+lemma [code]:
+ "of_nat n = (if n = 0 then 0 else
+ let
+ (q, m) = divmod_nat n 2;
+ q' = 2 * of_nat q
+ in if m = 0 then q' else q' + 1)"
+proof -
+ from mod_div_equality have *: "of_nat n = of_nat (n div 2 * 2 + n mod 2)" by simp
+ show ?thesis
+ apply (simp add: Let_def divmod_nat_div_mod mod_2_not_eq_zero_eq_one_nat
+ of_nat_mult
+ of_nat_add [symmetric])
+ apply (auto simp add: of_nat_mult)
+ apply (simp add: * of_nat_mult add_commute mult_commute)
+ done
+qed
+
+text {* Conversion from and to code numerals *}
code_const Code_Numeral.of_nat
(SML "IntInf.toInt")
@@ -355,21 +200,38 @@
(Scala "!Nat(_.as'_BigInt)")
(Eval "_")
-text {* Using target language arithmetic operations whenever appropriate *}
+
+subsection {* Target language arithmetic *}
-code_const "op + \<Colon> nat \<Rightarrow> nat \<Rightarrow> nat"
- (SML "IntInf.+ ((_), (_))")
+code_const "plus \<Colon> nat \<Rightarrow> nat \<Rightarrow> nat"
+ (SML "IntInf.+/ ((_),/ (_))")
(OCaml "Big'_int.add'_big'_int")
(Haskell infixl 6 "+")
(Scala infixl 7 "+")
(Eval infixl 8 "+")
-code_const "op - \<Colon> nat \<Rightarrow> nat \<Rightarrow> nat"
+code_const "minus \<Colon> nat \<Rightarrow> nat \<Rightarrow> nat"
+ (SML "IntInf.max/ (0, IntInf.-/ ((_),/ (_)))")
+ (OCaml "Big'_int.max'_big'_int/ Big'_int.zero'_big'_int/ (Big'_int.sub'_big'_int/ _/ _)")
(Haskell infixl 6 "-")
(Scala infixl 7 "-")
+ (Eval "Integer.max/ 0/ (_ -/ _)")
-code_const "op * \<Colon> nat \<Rightarrow> nat \<Rightarrow> nat"
- (SML "IntInf.* ((_), (_))")
+code_const Code_Nat.dup
+ (SML "IntInf.*/ (2,/ (_))")
+ (OCaml "Big'_int.mult'_big'_int/ 2")
+ (Haskell "!(2 * _)")
+ (Scala "!(2 * _)")
+ (Eval "!(2 * _)")
+
+code_const Code_Nat.sub
+ (SML "!(raise/ Fail/ \"sub\")")
+ (OCaml "failwith/ \"sub\"")
+ (Haskell "error/ \"sub\"")
+ (Scala "!error(\"sub\")")
+
+code_const "times \<Colon> nat \<Rightarrow> nat \<Rightarrow> nat"
+ (SML "IntInf.*/ ((_),/ (_))")
(OCaml "Big'_int.mult'_big'_int")
(Haskell infixl 7 "*")
(Scala infixl 8 "*")
@@ -389,22 +251,28 @@
(Scala infixl 5 "==")
(Eval infixl 6 "=")
-code_const "op \<le> \<Colon> nat \<Rightarrow> nat \<Rightarrow> bool"
- (SML "IntInf.<= ((_), (_))")
+code_const "less_eq \<Colon> nat \<Rightarrow> nat \<Rightarrow> bool"
+ (SML "IntInf.<=/ ((_),/ (_))")
(OCaml "Big'_int.le'_big'_int")
(Haskell infix 4 "<=")
(Scala infixl 4 "<=")
(Eval infixl 6 "<=")
-code_const "op < \<Colon> nat \<Rightarrow> nat \<Rightarrow> bool"
- (SML "IntInf.< ((_), (_))")
+code_const "less \<Colon> nat \<Rightarrow> nat \<Rightarrow> bool"
+ (SML "IntInf.</ ((_),/ (_))")
(OCaml "Big'_int.lt'_big'_int")
(Haskell infix 4 "<")
(Scala infixl 4 "<")
(Eval infixl 6 "<")
+code_const Num.num_of_nat
+ (SML "!(raise/ Fail/ \"num'_of'_nat\")")
+ (OCaml "failwith/ \"num'_of'_nat\"")
+ (Haskell "error/ \"num'_of'_nat\"")
+ (Scala "!error(\"num'_of'_nat\")")
-text {* Evaluation *}
+
+subsection {* Evaluation *}
lemma [code, code del]:
"(Code_Evaluation.term_of \<Colon> nat \<Rightarrow> term) = Code_Evaluation.term_of" ..
@@ -412,14 +280,14 @@
code_const "Code_Evaluation.term_of \<Colon> nat \<Rightarrow> term"
(SML "HOLogic.mk'_number/ HOLogic.natT")
-text {* Evaluation with @{text "Quickcheck_Narrowing"} does not work, as
+text {*
+ FIXME -- Evaluation with @{text "Quickcheck_Narrowing"} does not work, as
@{text "code_module"} is very aggressive leading to bad Haskell code.
Therefore, we simply deactivate the narrowing-based quickcheck from here on.
*}
declare [[quickcheck_narrowing_active = false]]
-text {* Module names *}
code_modulename SML
Efficient_Nat Arith
@@ -430,6 +298,6 @@
code_modulename Haskell
Efficient_Nat Arith
-hide_const int
+hide_const (open) int
end
--- a/src/HOL/Library/Extended_Nat.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Library/Extended_Nat.thy Mon Mar 26 15:33:28 2012 +0200
@@ -61,19 +61,17 @@
primrec the_enat :: "enat \<Rightarrow> nat"
where "the_enat (enat n) = n"
+
subsection {* Constructors and numbers *}
-instantiation enat :: "{zero, one, number}"
+instantiation enat :: "{zero, one}"
begin
definition
"0 = enat 0"
definition
- [code_unfold]: "1 = enat 1"
-
-definition
- [code_unfold, code del]: "number_of k = enat (number_of k)"
+ "1 = enat 1"
instance ..
@@ -82,15 +80,12 @@
definition eSuc :: "enat \<Rightarrow> enat" where
"eSuc i = (case i of enat n \<Rightarrow> enat (Suc n) | \<infinity> \<Rightarrow> \<infinity>)"
-lemma enat_0: "enat 0 = 0"
+lemma enat_0 [code_post]: "enat 0 = 0"
by (simp add: zero_enat_def)
-lemma enat_1: "enat 1 = 1"
+lemma enat_1 [code_post]: "enat 1 = 1"
by (simp add: one_enat_def)
-lemma enat_number: "enat (number_of k) = number_of k"
- by (simp add: number_of_enat_def)
-
lemma one_eSuc: "1 = eSuc 0"
by (simp add: zero_enat_def one_enat_def eSuc_def)
@@ -100,16 +95,6 @@
lemma i0_ne_infinity [simp]: "0 \<noteq> (\<infinity>::enat)"
by (simp add: zero_enat_def)
-lemma zero_enat_eq [simp]:
- "number_of k = (0\<Colon>enat) \<longleftrightarrow> number_of k = (0\<Colon>nat)"
- "(0\<Colon>enat) = number_of k \<longleftrightarrow> number_of k = (0\<Colon>nat)"
- unfolding zero_enat_def number_of_enat_def by simp_all
-
-lemma one_enat_eq [simp]:
- "number_of k = (1\<Colon>enat) \<longleftrightarrow> number_of k = (1\<Colon>nat)"
- "(1\<Colon>enat) = number_of k \<longleftrightarrow> number_of k = (1\<Colon>nat)"
- unfolding one_enat_def number_of_enat_def by simp_all
-
lemma zero_one_enat_neq [simp]:
"\<not> 0 = (1\<Colon>enat)"
"\<not> 1 = (0\<Colon>enat)"
@@ -121,18 +106,9 @@
lemma i1_ne_infinity [simp]: "1 \<noteq> (\<infinity>::enat)"
by (simp add: one_enat_def)
-lemma infinity_ne_number [simp]: "(\<infinity>::enat) \<noteq> number_of k"
- by (simp add: number_of_enat_def)
-
-lemma number_ne_infinity [simp]: "number_of k \<noteq> (\<infinity>::enat)"
- by (simp add: number_of_enat_def)
-
lemma eSuc_enat: "eSuc (enat n) = enat (Suc n)"
by (simp add: eSuc_def)
-lemma eSuc_number_of: "eSuc (number_of k) = enat (Suc (number_of k))"
- by (simp add: eSuc_enat number_of_enat_def)
-
lemma eSuc_infinity [simp]: "eSuc \<infinity> = \<infinity>"
by (simp add: eSuc_def)
@@ -145,11 +121,6 @@
lemma eSuc_inject [simp]: "eSuc m = eSuc n \<longleftrightarrow> m = n"
by (simp add: eSuc_def split: enat.splits)
-lemma number_of_enat_inject [simp]:
- "(number_of k \<Colon> enat) = number_of l \<longleftrightarrow> (number_of k \<Colon> nat) = number_of l"
- by (simp add: number_of_enat_def)
-
-
subsection {* Addition *}
instantiation enat :: comm_monoid_add
@@ -177,16 +148,6 @@
end
-lemma plus_enat_number [simp]:
- "(number_of k \<Colon> enat) + number_of l = (if k < Int.Pls then number_of l
- else if l < Int.Pls then number_of k else number_of (k + l))"
- unfolding number_of_enat_def plus_enat_simps nat_arith(1) if_distrib [symmetric, of _ enat] ..
-
-lemma eSuc_number [simp]:
- "eSuc (number_of k) = (if neg (number_of k \<Colon> int) then 1 else number_of (Int.succ k))"
- unfolding eSuc_number_of
- unfolding one_enat_def number_of_enat_def Suc_nat_number_of if_distrib [symmetric] ..
-
lemma eSuc_plus_1:
"eSuc n = n + 1"
by (cases n) (simp_all add: eSuc_enat one_enat_def)
@@ -261,12 +222,6 @@
apply (simp add: plus_1_eSuc eSuc_enat)
done
-instance enat :: number_semiring
-proof
- fix n show "number_of (int n) = (of_nat n :: enat)"
- unfolding number_of_enat_def number_of_int of_nat_id of_nat_eq_enat ..
-qed
-
instance enat :: semiring_char_0 proof
have "inj enat" by (rule injI) simp
then show "inj (\<lambda>n. of_nat n :: enat)" by (simp add: of_nat_eq_enat)
@@ -279,6 +234,25 @@
by (auto simp add: times_enat_def zero_enat_def split: enat.split)
+subsection {* Numerals *}
+
+lemma numeral_eq_enat:
+ "numeral k = enat (numeral k)"
+ using of_nat_eq_enat [of "numeral k"] by simp
+
+lemma enat_numeral [code_abbrev]:
+ "enat (numeral k) = numeral k"
+ using numeral_eq_enat ..
+
+lemma infinity_ne_numeral [simp]: "(\<infinity>::enat) \<noteq> numeral k"
+ by (simp add: numeral_eq_enat)
+
+lemma numeral_ne_infinity [simp]: "numeral k \<noteq> (\<infinity>::enat)"
+ by (simp add: numeral_eq_enat)
+
+lemma eSuc_numeral [simp]: "eSuc (numeral k) = numeral (k + Num.One)"
+ by (simp only: eSuc_plus_1 numeral_plus_one)
+
subsection {* Subtraction *}
instantiation enat :: minus
@@ -292,13 +266,13 @@
end
-lemma idiff_enat_enat [simp,code]: "enat a - enat b = enat (a - b)"
+lemma idiff_enat_enat [simp, code]: "enat a - enat b = enat (a - b)"
by (simp add: diff_enat_def)
-lemma idiff_infinity [simp,code]: "\<infinity> - n = (\<infinity>::enat)"
+lemma idiff_infinity [simp, code]: "\<infinity> - n = (\<infinity>::enat)"
by (simp add: diff_enat_def)
-lemma idiff_infinity_right [simp,code]: "enat a - \<infinity> = 0"
+lemma idiff_infinity_right [simp, code]: "enat a - \<infinity> = 0"
by (simp add: diff_enat_def)
lemma idiff_0 [simp]: "(0::enat) - n = 0"
@@ -344,13 +318,13 @@
"(\<infinity>::enat) < q \<longleftrightarrow> False"
by (simp_all add: less_eq_enat_def less_enat_def split: enat.splits)
-lemma number_of_le_enat_iff[simp]:
- shows "number_of m \<le> enat n \<longleftrightarrow> number_of m \<le> n"
-by (auto simp: number_of_enat_def)
+lemma numeral_le_enat_iff[simp]:
+ shows "numeral m \<le> enat n \<longleftrightarrow> numeral m \<le> n"
+by (auto simp: numeral_eq_enat)
-lemma number_of_less_enat_iff[simp]:
- shows "number_of m < enat n \<longleftrightarrow> number_of m < n"
-by (auto simp: number_of_enat_def)
+lemma numeral_less_enat_iff[simp]:
+ shows "numeral m < enat n \<longleftrightarrow> numeral m < n"
+by (auto simp: numeral_eq_enat)
lemma enat_ord_code [code]:
"enat m \<le> enat n \<longleftrightarrow> m \<le> n"
@@ -375,10 +349,15 @@
by (simp split: enat.splits)
qed
+(* BH: These equations are already proven generally for any type in
+class linordered_semidom. However, enat is not in that class because
+it does not have the cancellation property. Would it be worthwhile to
+a generalize linordered_semidom to a new class that includes enat? *)
+
lemma enat_ord_number [simp]:
- "(number_of m \<Colon> enat) \<le> number_of n \<longleftrightarrow> (number_of m \<Colon> nat) \<le> number_of n"
- "(number_of m \<Colon> enat) < number_of n \<longleftrightarrow> (number_of m \<Colon> nat) < number_of n"
- by (simp_all add: number_of_enat_def)
+ "(numeral m \<Colon> enat) \<le> numeral n \<longleftrightarrow> (numeral m \<Colon> nat) \<le> numeral n"
+ "(numeral m \<Colon> enat) < numeral n \<longleftrightarrow> (numeral m \<Colon> nat) < numeral n"
+ by (simp_all add: numeral_eq_enat)
lemma i0_lb [simp]: "(0\<Colon>enat) \<le> n"
by (simp add: zero_enat_def less_eq_enat_def split: enat.splits)
@@ -525,10 +504,10 @@
val find_first = find_first_t []
val trans_tac = Numeral_Simprocs.trans_tac
val norm_ss = HOL_basic_ss addsimps
- @{thms add_ac semiring_numeral_0_eq_0 add_0_left add_0_right}
+ @{thms add_ac add_0_left add_0_right}
fun norm_tac ss = ALLGOALS (simp_tac (Simplifier.inherit_context ss norm_ss))
fun simplify_meta_eq ss cancel_th th =
- Arith_Data.simplify_meta_eq @{thms semiring_numeral_0_eq_0} ss
+ Arith_Data.simplify_meta_eq [] ss
([th, cancel_th] MRS trans)
fun mk_eq (a, b) = HOLogic.mk_Trueprop (HOLogic.mk_eq (a, b))
end
@@ -646,7 +625,7 @@
subsection {* Traditional theorem names *}
-lemmas enat_defs = zero_enat_def one_enat_def number_of_enat_def eSuc_def
+lemmas enat_defs = zero_enat_def one_enat_def eSuc_def
plus_enat_def less_eq_enat_def less_enat_def
end
--- a/src/HOL/Library/Extended_Real.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Library/Extended_Real.thy Mon Mar 26 15:33:28 2012 +0200
@@ -124,11 +124,6 @@
fix x :: ereal show "x \<in> range uminus" by (intro image_eqI[of _ _ "-x"]) auto
qed auto
-instantiation ereal :: number
-begin
-definition [simp]: "number_of x = ereal (number_of x)"
-instance ..
-end
instantiation ereal :: abs
begin
@@ -671,6 +666,14 @@
using assms
by (cases rule: ereal3_cases[of a b c]) (simp_all add: field_simps)
+instance ereal :: numeral ..
+
+lemma numeral_eq_ereal [simp]: "numeral w = ereal (numeral w)"
+ apply (induct w rule: num_induct)
+ apply (simp only: numeral_One one_ereal_def)
+ apply (simp only: numeral_inc ereal_plus_1)
+ done
+
lemma ereal_le_epsilon:
fixes x y :: ereal
assumes "ALL e. 0 < e --> x <= y + e"
@@ -781,8 +784,8 @@
shows "(- x) ^ n = (if even n then x ^ n else - (x^n))"
by (induct n) (auto simp: one_ereal_def)
-lemma ereal_power_number_of[simp]:
- "(number_of num :: ereal) ^ n = ereal (number_of num ^ n)"
+lemma ereal_power_numeral[simp]:
+ "(numeral num :: ereal) ^ n = ereal (numeral num ^ n)"
by (induct n) (auto simp: one_ereal_def)
lemma zero_le_power_ereal[simp]:
@@ -1730,8 +1733,8 @@
"ereal_of_enat m \<le> ereal_of_enat n \<longleftrightarrow> m \<le> n"
by (cases m n rule: enat2_cases) auto
-lemma number_of_le_ereal_of_enat_iff[simp]:
- shows "number_of m \<le> ereal_of_enat n \<longleftrightarrow> number_of m \<le> n"
+lemma numeral_le_ereal_of_enat_iff[simp]:
+ shows "numeral m \<le> ereal_of_enat n \<longleftrightarrow> numeral m \<le> n"
by (cases n) (auto dest: natceiling_le intro: natceiling_le_eq[THEN iffD1])
lemma ereal_of_enat_ge_zero_cancel_iff[simp]:
--- a/src/HOL/Library/Float.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Library/Float.thy Mon Mar 26 15:33:28 2012 +0200
@@ -41,18 +41,6 @@
instance ..
end
-instantiation float :: number
-begin
-definition number_of_float where "number_of n = Float n 0"
-instance ..
-end
-
-lemma number_of_float_Float:
- "number_of k = Float (number_of k) 0"
- by (simp add: number_of_float_def number_of_is_id)
-
-declare number_of_float_Float [symmetric, code_abbrev]
-
lemma real_of_float_simp[simp]: "real (Float a b) = real a * pow2 b"
unfolding real_of_float_def using of_float.simps .
@@ -63,12 +51,9 @@
lemma Float_num[simp]: shows
"real (Float 1 0) = 1" and "real (Float 1 1) = 2" and "real (Float 1 2) = 4" and
"real (Float 1 -1) = 1/2" and "real (Float 1 -2) = 1/4" and "real (Float 1 -3) = 1/8" and
- "real (Float -1 0) = -1" and "real (Float (number_of n) 0) = number_of n"
+ "real (Float -1 0) = -1" and "real (Float (numeral n) 0) = numeral n"
by auto
-lemma float_number_of[simp]: "real (number_of x :: float) = number_of x"
- by (simp only:number_of_float_def Float_num[unfolded number_of_is_id])
-
lemma float_number_of_int[simp]: "real (Float n 0) = real n"
by simp
@@ -349,6 +334,21 @@
by (cases a, cases b) (simp add: plus_float.simps)
qed
+instance float :: numeral ..
+
+lemma Float_add_same_scale: "Float x e + Float y e = Float (x + y) e"
+ by (simp add: plus_float.simps)
+
+(* FIXME: define other constant for code_unfold_post *)
+lemma numeral_float_Float (*[code_unfold_post]*):
+ "numeral k = Float (numeral k) 0"
+ by (induct k, simp_all only: numeral.simps one_float_def
+ Float_add_same_scale)
+
+lemma float_number_of[simp]: "real (numeral x :: float) = numeral x"
+ by (simp only: numeral_float_Float Float_num)
+
+
instance float :: comm_monoid_mult
proof (intro_classes)
fix a b c :: float
@@ -555,6 +555,7 @@
show ?thesis unfolding real_of_float_nge0_exp[OF P] divide_inverse by auto
qed
+(* BROKEN
lemma bitlen_Pls: "bitlen (Int.Pls) = Int.Pls" by (subst Pls_def, subst Pls_def, simp)
lemma bitlen_Min: "bitlen (Int.Min) = Int.Bit1 Int.Pls" by (subst Min_def, simp add: Bit1_def)
@@ -588,6 +589,7 @@
lemma bitlen_number_of: "bitlen (number_of w) = number_of (bitlen w)"
by (simp add: number_of_is_id)
+BH *)
lemma [code]: "bitlen x =
(if x = 0 then 0
@@ -722,12 +724,12 @@
hence "real x / real y < 1" using `0 < y` and `0 \<le> x` by auto
from real_of_int_div4[of "?X" y]
- 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 .
+ 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 .
also have "\<dots> < 1 * 2^?l" using `real x / real y < 1` by (rule mult_strict_right_mono, auto)
finally have "?X div y < 2^?l" unfolding real_of_int_less_iff[of _ "2^?l", symmetric] by auto
hence "?X div y + 1 \<le> 2^?l" by auto
hence "real (?X div y + 1) * inverse (2^?l) \<le> 2^?l * inverse (2^?l)"
- unfolding real_of_int_le_iff[of _ "2^?l", symmetric] real_of_int_power real_number_of
+ unfolding real_of_int_le_iff[of _ "2^?l", symmetric] real_of_int_power real_numeral
by (rule mult_right_mono, auto)
hence "real (?X div y + 1) * inverse (2^?l) \<le> 1" by auto
thus ?thesis unfolding rapprox_posrat_def Let_def normfloat real_of_float_simp if_not_P[OF False]
@@ -796,12 +798,12 @@
qed
from real_of_int_div4[of "?X" y]
- 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 .
+ 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 .
also have "\<dots> < 1/2 * 2^?l" using `real x / real y < 1/2` by (rule mult_strict_right_mono, auto)
finally have "?X div y * 2 < 2^?l" unfolding real_of_int_less_iff[of _ "2^?l", symmetric] by auto
hence "?X div y + 1 < 2^?l" using `0 < ?X div y` by auto
hence "real (?X div y + 1) * inverse (2^?l) < 2^?l * inverse (2^?l)"
- unfolding real_of_int_less_iff[of _ "2^?l", symmetric] real_of_int_power real_number_of
+ unfolding real_of_int_less_iff[of _ "2^?l", symmetric] real_of_int_power real_numeral
by (rule mult_strict_right_mono, auto)
hence "real (?X div y + 1) * inverse (2^?l) < 1" by auto
thus ?thesis unfolding rapprox_posrat_def Let_def normfloat real_of_float_simp if_not_P[OF False]
@@ -1195,7 +1197,7 @@
case True
have "real (m div 2^(nat ?l)) * pow2 ?l \<le> real m"
proof -
- 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]
+ 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]
using `?l > 0` by auto
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
also have "\<dots> = real m" unfolding zmod_zdiv_equality[symmetric] ..
@@ -1262,7 +1264,7 @@
hence me_eq: "pow2 (-e) = pow2 (int (nat (-e)))" by auto
have "real (Float (m div (2 ^ (nat (-e)))) 0) = real (m div 2 ^ (nat (-e)))" unfolding real_of_float_simp by auto
also have "\<dots> \<le> real m / real ((2::int) ^ (nat (-e)))" using real_of_int_div4 .
- also have "\<dots> = real m * inverse (2 ^ (nat (-e)))" unfolding real_of_int_power real_number_of divide_inverse ..
+ also have "\<dots> = real m * inverse (2 ^ (nat (-e)))" unfolding real_of_int_power real_numeral divide_inverse ..
also have "\<dots> = real (Float m e)" unfolding real_of_float_simp me_eq pow2_int pow2_neg[of e] ..
finally show ?thesis unfolding Float floor_fl.simps if_not_P[OF `\<not> 0 \<le> e`] .
next
@@ -1290,7 +1292,7 @@
case False
hence me_eq: "pow2 (-e) = pow2 (int (nat (-e)))" by auto
have "real (Float m e) = real m * inverse (2 ^ (nat (-e)))" unfolding real_of_float_simp me_eq pow2_int pow2_neg[of e] ..
- also have "\<dots> = real m / real ((2::int) ^ (nat (-e)))" unfolding real_of_int_power real_number_of divide_inverse ..
+ also have "\<dots> = real m / real ((2::int) ^ (nat (-e)))" unfolding real_of_int_power real_numeral divide_inverse ..
also have "\<dots> \<le> 1 + real (m div 2 ^ (nat (-e)))" using real_of_int_div3[unfolded diff_le_eq] .
also have "\<dots> = real (Float (m div (2 ^ (nat (-e))) + 1) 0)" unfolding real_of_float_simp by auto
finally show ?thesis unfolding Float ceiling_fl.simps if_not_P[OF `\<not> 0 \<le> e`] .
--- a/src/HOL/Library/Formal_Power_Series.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Library/Formal_Power_Series.thy Mon Mar 26 15:33:28 2012 +0200
@@ -392,25 +392,13 @@
instance fps :: (idom) idom ..
-instantiation fps :: (comm_ring_1) number_ring
-begin
-definition number_of_fps_def: "(number_of k::'a fps) = of_int k"
-
-instance proof
-qed (rule number_of_fps_def)
-end
-
-lemma number_of_fps_const: "(number_of k::('a::comm_ring_1) fps) = fps_const (of_int k)"
-
-proof(induct k rule: int_induct [where k=0])
- case base thus ?case unfolding number_of_fps_def of_int_0 by simp
-next
- case (step1 i) thus ?case unfolding number_of_fps_def
- by (simp add: fps_const_add[symmetric] del: fps_const_add)
-next
- case (step2 i) thus ?case unfolding number_of_fps_def
- by (simp add: fps_const_sub[symmetric] del: fps_const_sub)
-qed
+lemma numeral_fps_const: "numeral k = fps_const (numeral k)"
+ by (induct k, simp_all only: numeral.simps fps_const_1_eq_1
+ fps_const_add [symmetric])
+
+lemma neg_numeral_fps_const: "neg_numeral k = fps_const (neg_numeral k)"
+ by (simp only: neg_numeral_def numeral_fps_const fps_const_neg)
+
subsection{* The eXtractor series X*}
lemma minus_one_power_iff: "(- (1::'a :: {comm_ring_1})) ^ n = (if even n then 1 else - 1)"
@@ -1119,7 +1107,7 @@
have eq: "(1 + X) * ?r = 1"
unfolding minus_one_power_iff
by (auto simp add: field_simps fps_eq_iff)
- show ?thesis by (auto simp add: eq intro: fps_inverse_unique)
+ show ?thesis by (auto simp add: eq intro: fps_inverse_unique simp del: minus_one)
qed
@@ -1157,8 +1145,11 @@
"fps_const (a::'a::{comm_ring_1}) oo b = fps_const (a)"
by (simp add: fps_eq_iff fps_compose_nth mult_delta_left setsum_delta)
-lemma number_of_compose[simp]: "(number_of k::('a::{comm_ring_1}) fps) oo b = number_of k"
- unfolding number_of_fps_const by simp
+lemma numeral_compose[simp]: "(numeral k::('a::{comm_ring_1}) fps) oo b = numeral k"
+ unfolding numeral_fps_const by simp
+
+lemma neg_numeral_compose[simp]: "(neg_numeral k::('a::{comm_ring_1}) fps) oo b = neg_numeral k"
+ unfolding neg_numeral_fps_const by simp
lemma X_fps_compose_startby0[simp]: "a$0 = 0 \<Longrightarrow> X oo a = (a :: ('a :: comm_ring_1) fps)"
by (simp add: fps_eq_iff fps_compose_def mult_delta_left setsum_delta
@@ -2568,7 +2559,7 @@
(is "inverse ?l = ?r")
proof-
have th: "?l * ?r = 1"
- by (auto simp add: field_simps fps_eq_iff minus_one_power_iff)
+ by (auto simp add: field_simps fps_eq_iff minus_one_power_iff simp del: minus_one)
have th': "?l $ 0 \<noteq> 0" by (simp add: )
from fps_inverse_unique[OF th' th] show ?thesis .
qed
@@ -2765,7 +2756,7 @@
proof-
have th: "?r$0 \<noteq> 0" by simp
have th': "fps_deriv (inverse ?r) = fps_const (- 1) * inverse ?r / (1 + X)"
- by (simp add: fps_inverse_deriv[OF th] fps_divide_def power2_eq_square mult_commute fps_const_neg[symmetric] del: fps_const_neg)
+ 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)
have eq: "inverse ?r $ 0 = 1"
by (simp add: fps_inverse_def)
from iffD1[OF fps_binomial_ODE_unique[of "inverse (1 + X)" "- 1"] th'] eq
@@ -2855,7 +2846,7 @@
unfolding m1nk
unfolding m h pochhammer_Suc_setprod
- apply (simp add: field_simps del: fact_Suc id_def)
+ apply (simp add: field_simps del: fact_Suc id_def minus_one)
unfolding fact_altdef_nat id_def
unfolding of_nat_setprod
unfolding setprod_timesf[symmetric]
@@ -3162,28 +3153,25 @@
lemma fps_const_minus: "fps_const (c::'a::group_add) - fps_const d = fps_const (c - d)"
by (simp add: fps_eq_iff fps_const_def)
-lemma fps_number_of_fps_const: "number_of i = fps_const (number_of i :: 'a:: {comm_ring_1, number_ring})"
- apply (subst (2) number_of_eq)
-apply(rule int_induct [of _ 0])
-apply (simp_all add: number_of_fps_def)
-by (simp_all add: fps_const_add[symmetric] fps_const_minus[symmetric])
+lemma fps_numeral_fps_const: "numeral i = fps_const (numeral i :: 'a:: {comm_ring_1})"
+ by (fact numeral_fps_const) (* FIXME: duplicate *)
lemma fps_cos_Eii:
"fps_cos c = (E (ii * c) + E (- ii * c)) / fps_const 2"
proof-
have th: "fps_cos c + fps_cos c = fps_cos c * fps_const 2"
- by (simp add: fps_eq_iff fps_number_of_fps_const complex_number_of_def[symmetric])
+ by (simp add: numeral_fps_const)
show ?thesis
unfolding Eii_sin_cos minus_mult_commute
- by (simp add: fps_sin_even fps_cos_odd fps_number_of_fps_const
- fps_divide_def fps_const_inverse th complex_number_of_def[symmetric])
+ by (simp add: fps_sin_even fps_cos_odd numeral_fps_const
+ fps_divide_def fps_const_inverse th)
qed
lemma fps_sin_Eii:
"fps_sin c = (E (ii * c) - E (- ii * c)) / fps_const (2*ii)"
proof-
have th: "fps_const \<i> * fps_sin c + fps_const \<i> * fps_sin c = fps_sin c * fps_const (2 * ii)"
- by (simp add: fps_eq_iff fps_number_of_fps_const complex_number_of_def[symmetric])
+ by (simp add: fps_eq_iff numeral_fps_const)
show ?thesis
unfolding Eii_sin_cos minus_mult_commute
by (simp add: fps_sin_even fps_cos_odd fps_divide_def fps_const_inverse th)
--- a/src/HOL/Library/Numeral_Type.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Library/Numeral_Type.thy Mon Mar 26 15:33:28 2012 +0200
@@ -66,7 +66,6 @@
by simp
qed
-
subsection {* Locales for for modular arithmetic subtypes *}
locale mod_type =
@@ -137,8 +136,8 @@
locale mod_ring = mod_type n Rep Abs
for n :: int
- and Rep :: "'a::{number_ring} \<Rightarrow> int"
- and Abs :: "int \<Rightarrow> 'a::{number_ring}"
+ and Rep :: "'a::{comm_ring_1} \<Rightarrow> int"
+ and Abs :: "int \<Rightarrow> 'a::{comm_ring_1}"
begin
lemma of_nat_eq: "of_nat k = Abs (int k mod n)"
@@ -152,13 +151,14 @@
apply (simp add: Rep_simps of_nat_eq diff_def zmod_simps)
done
-lemma Rep_number_of:
- "Rep (number_of w) = number_of w mod n"
-by (simp add: number_of_eq of_int_eq Rep_Abs_mod)
+lemma Rep_numeral:
+ "Rep (numeral w) = numeral w mod n"
+using of_int_eq [of "numeral w"]
+by (simp add: Rep_inject_sym Rep_Abs_mod)
-lemma iszero_number_of:
- "iszero (number_of w::'a) \<longleftrightarrow> number_of w mod n = 0"
-by (simp add: Rep_simps number_of_eq of_int_eq iszero_def zero_def)
+lemma iszero_numeral:
+ "iszero (numeral w::'a) \<longleftrightarrow> numeral w mod n = 0"
+by (simp add: Rep_inject_sym Rep_numeral Rep_0 iszero_def)
lemma cases:
assumes 1: "\<And>z. \<lbrakk>(x::'a) = of_int z; 0 \<le> z; z < n\<rbrakk> \<Longrightarrow> P"
@@ -175,14 +175,14 @@
end
-subsection {* Number ring instances *}
+subsection {* Ring class instances *}
text {*
- Unfortunately a number ring instance is not possible for
+ Unfortunately @{text ring_1} instance is not possible for
@{typ num1}, since 0 and 1 are not distinct.
*}
-instantiation num1 :: "{comm_ring,comm_monoid_mult,number}"
+instantiation num1 :: "{comm_ring,comm_monoid_mult,numeral}"
begin
lemma num1_eq_iff: "(x::num1) = (y::num1) \<longleftrightarrow> True"
@@ -252,22 +252,10 @@
done
instance bit0 :: (finite) comm_ring_1
- by (rule bit0.comm_ring_1)+
+ by (rule bit0.comm_ring_1)
instance bit1 :: (finite) comm_ring_1
- by (rule bit1.comm_ring_1)+
-
-instantiation bit0 and bit1 :: (finite) number_ring
-begin
-
-definition "(number_of w :: _ bit0) = of_int w"
-
-definition "(number_of w :: _ bit1) = of_int w"
-
-instance proof
-qed (rule number_of_bit0_def number_of_bit1_def)+
-
-end
+ by (rule bit1.comm_ring_1)
interpretation bit0:
mod_ring "int CARD('a::finite bit0)"
@@ -289,9 +277,11 @@
lemmas bit0_induct [case_names of_int, induct type: bit0] = bit0.induct
lemmas bit1_induct [case_names of_int, induct type: bit1] = bit1.induct
-lemmas bit0_iszero_number_of [simp] = bit0.iszero_number_of
-lemmas bit1_iszero_number_of [simp] = bit1.iszero_number_of
+lemmas bit0_iszero_numeral [simp] = bit0.iszero_numeral
+lemmas bit1_iszero_numeral [simp] = bit1.iszero_numeral
+declare eq_numeral_iff_iszero [where 'a="('a::finite) bit0", standard, simp]
+declare eq_numeral_iff_iszero [where 'a="('a::finite) bit1", standard, simp]
subsection {* Syntax *}
--- a/src/HOL/Library/Poly_Deriv.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Library/Poly_Deriv.thy Mon Mar 26 15:33:28 2012 +0200
@@ -71,7 +71,8 @@
apply (subst power_Suc)
apply (subst pderiv_mult)
apply (erule ssubst)
-apply (simp add: smult_add_left algebra_simps)
+apply (simp only: of_nat_Suc smult_add_left smult_1_left)
+apply (simp add: algebra_simps) (* FIXME *)
done
lemma DERIV_cmult2: "DERIV f x :> D ==> DERIV (%x. (f x) * c :: real) x :> D * c"
--- a/src/HOL/Library/Polynomial.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Library/Polynomial.thy Mon Mar 26 15:33:28 2012 +0200
@@ -662,17 +662,6 @@
instance poly :: (comm_ring_1) comm_ring_1 ..
-instantiation poly :: (comm_ring_1) number_ring
-begin
-
-definition
- "number_of k = (of_int k :: 'a poly)"
-
-instance
- by default (rule number_of_poly_def)
-
-end
-
subsection {* Polynomials form an integral domain *}
@@ -1052,12 +1041,12 @@
lemma poly_div_minus_left [simp]:
fixes x y :: "'a::field poly"
shows "(- x) div y = - (x div y)"
- using div_smult_left [of "- 1::'a"] by simp
+ using div_smult_left [of "- 1::'a"] by (simp del: minus_one) (* FIXME *)
lemma poly_mod_minus_left [simp]:
fixes x y :: "'a::field poly"
shows "(- x) mod y = - (x mod y)"
- using mod_smult_left [of "- 1::'a"] by simp
+ using mod_smult_left [of "- 1::'a"] by (simp del: minus_one) (* FIXME *)
lemma pdivmod_rel_smult_right:
"\<lbrakk>a \<noteq> 0; pdivmod_rel x y q r\<rbrakk>
@@ -1075,12 +1064,12 @@
fixes x y :: "'a::field poly"
shows "x div (- y) = - (x div y)"
using div_smult_right [of "- 1::'a"]
- by (simp add: nonzero_inverse_minus_eq)
+ by (simp add: nonzero_inverse_minus_eq del: minus_one) (* FIXME *)
lemma poly_mod_minus_right [simp]:
fixes x y :: "'a::field poly"
shows "x mod (- y) = x mod y"
- using mod_smult_right [of "- 1::'a"] by simp
+ using mod_smult_right [of "- 1::'a"] by (simp del: minus_one) (* FIXME *)
lemma pdivmod_rel_mult:
"\<lbrakk>pdivmod_rel x y q r; pdivmod_rel q z q' r'\<rbrakk>
--- a/src/HOL/Library/Predicate_Compile_Alternative_Defs.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Library/Predicate_Compile_Alternative_Defs.thy Mon Mar 26 15:33:28 2012 +0200
@@ -54,8 +54,8 @@
section {* Setup for Numerals *}
-setup {* Predicate_Compile_Data.ignore_consts [@{const_name number_of}] *}
-setup {* Predicate_Compile_Data.keep_functions [@{const_name number_of}] *}
+setup {* Predicate_Compile_Data.ignore_consts [@{const_name numeral}, @{const_name neg_numeral}] *}
+setup {* Predicate_Compile_Data.keep_functions [@{const_name numeral}, @{const_name neg_numeral}] *}
setup {* Predicate_Compile_Data.ignore_consts [@{const_name div}, @{const_name mod}, @{const_name times}] *}
--- a/src/HOL/Library/ROOT.ML Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Library/ROOT.ML Mon Mar 26 15:33:28 2012 +0200
@@ -4,4 +4,4 @@
use_thys ["Library", "List_Cset", "List_Prefix", "List_lexord", "Sublist_Order",
"Product_Lattice",
"Code_Char_chr", "Code_Char_ord", "Code_Integer", "Efficient_Nat"(*, "Code_Prolog"*),
- "Code_Real_Approx_By_Float" ];
+ "Code_Real_Approx_By_Float", "Target_Numeral"];
--- a/src/HOL/Library/Saturated.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Library/Saturated.thy Mon Mar 26 15:33:28 2012 +0200
@@ -157,20 +157,16 @@
"nat_of (Sat n :: ('a::len) sat) = min (len_of TYPE('a)) n"
by (rule nat_of_Abs_sat' [unfolded Abs_sat'_eq_of_nat])
-instantiation sat :: (len) number_semiring
-begin
+lemma [code_abbrev]:
+ "of_nat (numeral k) = (numeral k :: 'a::len sat)"
+ by simp
-definition
- number_of_sat_def [code del]: "number_of = Sat \<circ> nat"
-
-instance
- by default (simp add: number_of_sat_def)
-
-end
+definition sat_of_nat :: "nat \<Rightarrow> ('a::len) sat"
+ where [code_abbrev]: "sat_of_nat = of_nat"
lemma [code abstract]:
- "nat_of (number_of n :: ('a::len) sat) = min (nat n) (len_of TYPE('a))"
- unfolding number_of_sat_def by simp
+ "nat_of (sat_of_nat n :: ('a::len) sat) = min (len_of TYPE('a)) n"
+ by (simp add: sat_of_nat_def)
instance sat :: (len) finite
proof
@@ -252,4 +248,6 @@
end
+hide_const (open) sat_of_nat
+
end
--- a/src/HOL/Library/Sum_of_Squares/sum_of_squares.ML Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Library/Sum_of_Squares/sum_of_squares.ML Mon Mar 26 15:33:28 2012 +0200
@@ -866,10 +866,11 @@
@{term "op / :: real => _"}, @{term "inverse :: real => _"},
@{term "op ^ :: real => _"}, @{term "abs :: real => _"},
@{term "min :: real => _"}, @{term "max :: real => _"},
- @{term "0::real"}, @{term "1::real"}, @{term "number_of :: int => real"},
- @{term "number_of :: int => nat"},
- @{term "Int.Bit0"}, @{term "Int.Bit1"},
- @{term "Int.Pls"}, @{term "Int.Min"}];
+ @{term "0::real"}, @{term "1::real"},
+ @{term "numeral :: num => nat"},
+ @{term "numeral :: num => real"},
+ @{term "neg_numeral :: num => real"},
+ @{term "Num.Bit0"}, @{term "Num.Bit1"}, @{term "Num.One"}];
fun check_sos kcts ct =
let
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Library/Target_Numeral.thy Mon Mar 26 15:33:28 2012 +0200
@@ -0,0 +1,726 @@
+theory Target_Numeral
+imports Main Code_Nat
+begin
+
+subsection {* Type of target language numerals *}
+
+typedef (open) int = "UNIV \<Colon> int set"
+ morphisms int_of of_int ..
+
+hide_type (open) int
+hide_const (open) of_int
+
+lemma int_eq_iff:
+ "k = l \<longleftrightarrow> int_of k = int_of l"
+ using int_of_inject [of k l] ..
+
+lemma int_eqI:
+ "int_of k = int_of l \<Longrightarrow> k = l"
+ using int_eq_iff [of k l] by simp
+
+lemma int_of_int [simp]:
+ "int_of (Target_Numeral.of_int k) = k"
+ using of_int_inverse [of k] by simp
+
+lemma of_int_of [simp]:
+ "Target_Numeral.of_int (int_of k) = k"
+ using int_of_inverse [of k] by simp
+
+hide_fact (open) int_eq_iff int_eqI
+
+instantiation Target_Numeral.int :: ring_1
+begin
+
+definition
+ "0 = Target_Numeral.of_int 0"
+
+lemma int_of_zero [simp]:
+ "int_of 0 = 0"
+ by (simp add: zero_int_def)
+
+definition
+ "1 = Target_Numeral.of_int 1"
+
+lemma int_of_one [simp]:
+ "int_of 1 = 1"
+ by (simp add: one_int_def)
+
+definition
+ "k + l = Target_Numeral.of_int (int_of k + int_of l)"
+
+lemma int_of_plus [simp]:
+ "int_of (k + l) = int_of k + int_of l"
+ by (simp add: plus_int_def)
+
+definition
+ "- k = Target_Numeral.of_int (- int_of k)"
+
+lemma int_of_uminus [simp]:
+ "int_of (- k) = - int_of k"
+ by (simp add: uminus_int_def)
+
+definition
+ "k - l = Target_Numeral.of_int (int_of k - int_of l)"
+
+lemma int_of_minus [simp]:
+ "int_of (k - l) = int_of k - int_of l"
+ by (simp add: minus_int_def)
+
+definition
+ "k * l = Target_Numeral.of_int (int_of k * int_of l)"
+
+lemma int_of_times [simp]:
+ "int_of (k * l) = int_of k * int_of l"
+ by (simp add: times_int_def)
+
+instance proof
+qed (auto simp add: Target_Numeral.int_eq_iff algebra_simps)
+
+end
+
+lemma int_of_of_nat [simp]:
+ "int_of (of_nat n) = of_nat n"
+ by (induct n) simp_all
+
+definition nat_of :: "Target_Numeral.int \<Rightarrow> nat" where
+ "nat_of k = Int.nat (int_of k)"
+
+lemma nat_of_of_nat [simp]:
+ "nat_of (of_nat n) = n"
+ by (simp add: nat_of_def)
+
+lemma int_of_of_int [simp]:
+ "int_of (of_int k) = k"
+ by (induct k) (simp_all, simp only: neg_numeral_def numeral_One int_of_uminus int_of_one)
+
+lemma of_int_of_int [simp, code_abbrev]:
+ "Target_Numeral.of_int = of_int"
+ by rule (simp add: Target_Numeral.int_eq_iff)
+
+lemma int_of_numeral [simp]:
+ "int_of (numeral k) = numeral k"
+ using int_of_of_int [of "numeral k"] by simp
+
+lemma int_of_neg_numeral [simp]:
+ "int_of (neg_numeral k) = neg_numeral k"
+ by (simp only: neg_numeral_def int_of_uminus) simp
+
+lemma int_of_sub [simp]:
+ "int_of (Num.sub k l) = Num.sub k l"
+ by (simp only: Num.sub_def int_of_minus int_of_numeral)
+
+instantiation Target_Numeral.int :: "{ring_div, equal, linordered_idom}"
+begin
+
+definition
+ "k div l = of_int (int_of k div int_of l)"
+
+lemma int_of_div [simp]:
+ "int_of (k div l) = int_of k div int_of l"
+ by (simp add: div_int_def)
+
+definition
+ "k mod l = of_int (int_of k mod int_of l)"
+
+lemma int_of_mod [simp]:
+ "int_of (k mod l) = int_of k mod int_of l"
+ by (simp add: mod_int_def)
+
+definition
+ "\<bar>k\<bar> = of_int \<bar>int_of k\<bar>"
+
+lemma int_of_abs [simp]:
+ "int_of \<bar>k\<bar> = \<bar>int_of k\<bar>"
+ by (simp add: abs_int_def)
+
+definition
+ "sgn k = of_int (sgn (int_of k))"
+
+lemma int_of_sgn [simp]:
+ "int_of (sgn k) = sgn (int_of k)"
+ by (simp add: sgn_int_def)
+
+definition
+ "k \<le> l \<longleftrightarrow> int_of k \<le> int_of l"
+
+definition
+ "k < l \<longleftrightarrow> int_of k < int_of l"
+
+definition
+ "HOL.equal k l \<longleftrightarrow> HOL.equal (int_of k) (int_of l)"
+
+instance proof
+qed (auto simp add: Target_Numeral.int_eq_iff algebra_simps
+ less_eq_int_def less_int_def equal_int_def equal)
+
+end
+
+lemma int_of_min [simp]:
+ "int_of (min k l) = min (int_of k) (int_of l)"
+ by (simp add: min_def less_eq_int_def)
+
+lemma int_of_max [simp]:
+ "int_of (max k l) = max (int_of k) (int_of l)"
+ by (simp add: max_def less_eq_int_def)
+
+
+subsection {* Code theorems for target language numerals *}
+
+text {* Constructors *}
+
+definition Pos :: "num \<Rightarrow> Target_Numeral.int" where
+ [simp, code_abbrev]: "Pos = numeral"
+
+definition Neg :: "num \<Rightarrow> Target_Numeral.int" where
+ [simp, code_abbrev]: "Neg = neg_numeral"
+
+code_datatype "0::Target_Numeral.int" Pos Neg
+
+
+text {* Auxiliary operations *}
+
+definition dup :: "Target_Numeral.int \<Rightarrow> Target_Numeral.int" where
+ [simp]: "dup k = k + k"
+
+lemma dup_code [code]:
+ "dup 0 = 0"
+ "dup (Pos n) = Pos (Num.Bit0 n)"
+ "dup (Neg n) = Neg (Num.Bit0 n)"
+ unfolding Pos_def Neg_def neg_numeral_def
+ by (simp_all add: numeral_Bit0)
+
+definition sub :: "num \<Rightarrow> num \<Rightarrow> Target_Numeral.int" where
+ [simp]: "sub m n = numeral m - numeral n"
+
+lemma sub_code [code]:
+ "sub Num.One Num.One = 0"
+ "sub (Num.Bit0 m) Num.One = Pos (Num.BitM m)"
+ "sub (Num.Bit1 m) Num.One = Pos (Num.Bit0 m)"
+ "sub Num.One (Num.Bit0 n) = Neg (Num.BitM n)"
+ "sub Num.One (Num.Bit1 n) = Neg (Num.Bit0 n)"
+ "sub (Num.Bit0 m) (Num.Bit0 n) = dup (sub m n)"
+ "sub (Num.Bit1 m) (Num.Bit1 n) = dup (sub m n)"
+ "sub (Num.Bit1 m) (Num.Bit0 n) = dup (sub m n) + 1"
+ "sub (Num.Bit0 m) (Num.Bit1 n) = dup (sub m n) - 1"
+ unfolding sub_def dup_def numeral.simps Pos_def Neg_def
+ neg_numeral_def numeral_BitM
+ by (simp_all only: algebra_simps add.comm_neutral)
+
+
+text {* Implementations *}
+
+lemma one_int_code [code, code_unfold]:
+ "1 = Pos Num.One"
+ by simp
+
+lemma plus_int_code [code]:
+ "k + 0 = (k::Target_Numeral.int)"
+ "0 + l = (l::Target_Numeral.int)"
+ "Pos m + Pos n = Pos (m + n)"
+ "Pos m + Neg n = sub m n"
+ "Neg m + Pos n = sub n m"
+ "Neg m + Neg n = Neg (m + n)"
+ by simp_all
+
+lemma uminus_int_code [code]:
+ "uminus 0 = (0::Target_Numeral.int)"
+ "uminus (Pos m) = Neg m"
+ "uminus (Neg m) = Pos m"
+ by simp_all
+
+lemma minus_int_code [code]:
+ "k - 0 = (k::Target_Numeral.int)"
+ "0 - l = uminus (l::Target_Numeral.int)"
+ "Pos m - Pos n = sub m n"
+ "Pos m - Neg n = Pos (m + n)"
+ "Neg m - Pos n = Neg (m + n)"
+ "Neg m - Neg n = sub n m"
+ by simp_all
+
+lemma times_int_code [code]:
+ "k * 0 = (0::Target_Numeral.int)"
+ "0 * l = (0::Target_Numeral.int)"
+ "Pos m * Pos n = Pos (m * n)"
+ "Pos m * Neg n = Neg (m * n)"
+ "Neg m * Pos n = Neg (m * n)"
+ "Neg m * Neg n = Pos (m * n)"
+ by simp_all
+
+definition divmod :: "Target_Numeral.int \<Rightarrow> Target_Numeral.int \<Rightarrow> Target_Numeral.int \<times> Target_Numeral.int" where
+ "divmod k l = (k div l, k mod l)"
+
+lemma fst_divmod [simp]:
+ "fst (divmod k l) = k div l"
+ by (simp add: divmod_def)
+
+lemma snd_divmod [simp]:
+ "snd (divmod k l) = k mod l"
+ by (simp add: divmod_def)
+
+definition divmod_abs :: "Target_Numeral.int \<Rightarrow> Target_Numeral.int \<Rightarrow> Target_Numeral.int \<times> Target_Numeral.int" where
+ "divmod_abs k l = (\<bar>k\<bar> div \<bar>l\<bar>, \<bar>k\<bar> mod \<bar>l\<bar>)"
+
+lemma fst_divmod_abs [simp]:
+ "fst (divmod_abs k l) = \<bar>k\<bar> div \<bar>l\<bar>"
+ by (simp add: divmod_abs_def)
+
+lemma snd_divmod_abs [simp]:
+ "snd (divmod_abs k l) = \<bar>k\<bar> mod \<bar>l\<bar>"
+ by (simp add: divmod_abs_def)
+
+lemma divmod_abs_terminate_code [code]:
+ "divmod_abs (Neg k) (Neg l) = divmod_abs (Pos k) (Pos l)"
+ "divmod_abs (Neg k) (Pos l) = divmod_abs (Pos k) (Pos l)"
+ "divmod_abs (Pos k) (Neg l) = divmod_abs (Pos k) (Pos l)"
+ "divmod_abs j 0 = (0, \<bar>j\<bar>)"
+ "divmod_abs 0 j = (0, 0)"
+ by (simp_all add: prod_eq_iff)
+
+lemma divmod_abs_rec_code [code]:
+ "divmod_abs (Pos k) (Pos l) =
+ (let j = sub k l in
+ if j < 0 then (0, Pos k)
+ else let (q, r) = divmod_abs j (Pos l) in (q + 1, r))"
+ by (auto simp add: prod_eq_iff Target_Numeral.int_eq_iff Let_def prod_case_beta
+ sub_non_negative sub_negative div_pos_pos_trivial mod_pos_pos_trivial div_pos_geq mod_pos_geq)
+
+lemma divmod_code [code]: "divmod k l =
+ (if k = 0 then (0, 0) else if l = 0 then (0, k) else
+ (apsnd \<circ> times \<circ> sgn) l (if sgn k = sgn l
+ then divmod_abs k l
+ else (let (r, s) = divmod_abs k l in
+ if s = 0 then (- r, 0) else (- r - 1, \<bar>l\<bar> - s))))"
+proof -
+ 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"
+ by (auto simp add: sgn_if)
+ have aux2: "\<And>q::int. - int_of k = int_of l * q \<longleftrightarrow> int_of k = int_of l * - q" by auto
+ show ?thesis
+ by (simp add: prod_eq_iff Target_Numeral.int_eq_iff prod_case_beta aux1)
+ (auto simp add: zdiv_zminus1_eq_if zmod_zminus1_eq_if zdiv_zminus2 zmod_zminus2 aux2)
+qed
+
+lemma div_int_code [code]:
+ "k div l = fst (divmod k l)"
+ by simp
+
+lemma div_mod_code [code]:
+ "k mod l = snd (divmod k l)"
+ by simp
+
+lemma equal_int_code [code]:
+ "HOL.equal 0 (0::Target_Numeral.int) \<longleftrightarrow> True"
+ "HOL.equal 0 (Pos l) \<longleftrightarrow> False"
+ "HOL.equal 0 (Neg l) \<longleftrightarrow> False"
+ "HOL.equal (Pos k) 0 \<longleftrightarrow> False"
+ "HOL.equal (Pos k) (Pos l) \<longleftrightarrow> HOL.equal k l"
+ "HOL.equal (Pos k) (Neg l) \<longleftrightarrow> False"
+ "HOL.equal (Neg k) 0 \<longleftrightarrow> False"
+ "HOL.equal (Neg k) (Pos l) \<longleftrightarrow> False"
+ "HOL.equal (Neg k) (Neg l) \<longleftrightarrow> HOL.equal k l"
+ by (simp_all add: equal Target_Numeral.int_eq_iff)
+
+lemma equal_int_refl [code nbe]:
+ "HOL.equal (k::Target_Numeral.int) k \<longleftrightarrow> True"
+ by (fact equal_refl)
+
+lemma less_eq_int_code [code]:
+ "0 \<le> (0::Target_Numeral.int) \<longleftrightarrow> True"
+ "0 \<le> Pos l \<longleftrightarrow> True"
+ "0 \<le> Neg l \<longleftrightarrow> False"
+ "Pos k \<le> 0 \<longleftrightarrow> False"
+ "Pos k \<le> Pos l \<longleftrightarrow> k \<le> l"
+ "Pos k \<le> Neg l \<longleftrightarrow> False"
+ "Neg k \<le> 0 \<longleftrightarrow> True"
+ "Neg k \<le> Pos l \<longleftrightarrow> True"
+ "Neg k \<le> Neg l \<longleftrightarrow> l \<le> k"
+ by (simp_all add: less_eq_int_def)
+
+lemma less_int_code [code]:
+ "0 < (0::Target_Numeral.int) \<longleftrightarrow> False"
+ "0 < Pos l \<longleftrightarrow> True"
+ "0 < Neg l \<longleftrightarrow> False"
+ "Pos k < 0 \<longleftrightarrow> False"
+ "Pos k < Pos l \<longleftrightarrow> k < l"
+ "Pos k < Neg l \<longleftrightarrow> False"
+ "Neg k < 0 \<longleftrightarrow> True"
+ "Neg k < Pos l \<longleftrightarrow> True"
+ "Neg k < Neg l \<longleftrightarrow> l < k"
+ by (simp_all add: less_int_def)
+
+lemma nat_of_code [code]:
+ "nat_of (Neg k) = 0"
+ "nat_of 0 = 0"
+ "nat_of (Pos k) = nat_of_num k"
+ by (simp_all add: nat_of_def nat_of_num_numeral)
+
+lemma int_of_code [code]:
+ "int_of (Neg k) = neg_numeral k"
+ "int_of 0 = 0"
+ "int_of (Pos k) = numeral k"
+ by simp_all
+
+lemma of_int_code [code]:
+ "Target_Numeral.of_int (Int.Neg k) = neg_numeral k"
+ "Target_Numeral.of_int 0 = 0"
+ "Target_Numeral.of_int (Int.Pos k) = numeral k"
+ by simp_all
+
+definition num_of_int :: "Target_Numeral.int \<Rightarrow> num" where
+ "num_of_int = num_of_nat \<circ> nat_of"
+
+lemma num_of_int_code [code]:
+ "num_of_int k = (if k \<le> 1 then Num.One
+ else let
+ (l, j) = divmod k 2;
+ l' = num_of_int l + num_of_int l
+ in if j = 0 then l' else l' + Num.One)"
+proof -
+ {
+ assume "int_of k mod 2 = 1"
+ then have "nat (int_of k mod 2) = nat 1" by simp
+ moreover assume *: "1 < int_of k"
+ ultimately have **: "nat (int_of k) mod 2 = 1" by (simp add: nat_mod_distrib)
+ have "num_of_nat (nat (int_of k)) =
+ num_of_nat (2 * (nat (int_of k) div 2) + nat (int_of k) mod 2)"
+ by simp
+ then have "num_of_nat (nat (int_of k)) =
+ num_of_nat (nat (int_of k) div 2 + nat (int_of k) div 2 + nat (int_of k) mod 2)"
+ by (simp add: nat_mult_2)
+ with ** have "num_of_nat (nat (int_of k)) =
+ num_of_nat (nat (int_of k) div 2 + nat (int_of k) div 2 + 1)"
+ by simp
+ }
+ note aux = this
+ show ?thesis
+ by (auto simp add: num_of_int_def nat_of_def Let_def prod_case_beta
+ not_le Target_Numeral.int_eq_iff less_eq_int_def
+ nat_mult_distrib nat_div_distrib num_of_nat_One num_of_nat_plus_distrib
+ nat_mult_2 aux add_One)
+qed
+
+hide_const (open) int_of nat_of Pos Neg sub dup divmod_abs num_of_int
+
+
+subsection {* Serializer setup for target language numerals *}
+
+code_type Target_Numeral.int
+ (SML "IntInf.int")
+ (OCaml "Big'_int.big'_int")
+ (Haskell "Integer")
+ (Scala "BigInt")
+ (Eval "int")
+
+code_instance Target_Numeral.int :: equal
+ (Haskell -)
+
+code_const "0::Target_Numeral.int"
+ (SML "0")
+ (OCaml "Big'_int.zero'_big'_int")
+ (Haskell "0")
+ (Scala "BigInt(0)")
+
+setup {*
+ fold (Numeral.add_code @{const_name Target_Numeral.Pos}
+ false Code_Printer.literal_numeral) ["SML", "OCaml", "Haskell", "Scala"]
+*}
+
+setup {*
+ fold (Numeral.add_code @{const_name Target_Numeral.Neg}
+ true Code_Printer.literal_numeral) ["SML", "OCaml", "Haskell", "Scala"]
+*}
+
+code_const "plus :: Target_Numeral.int \<Rightarrow> _ \<Rightarrow> _"
+ (SML "IntInf.+ ((_), (_))")
+ (OCaml "Big'_int.add'_big'_int")
+ (Haskell infixl 6 "+")
+ (Scala infixl 7 "+")
+ (Eval infixl 8 "+")
+
+code_const "uminus :: Target_Numeral.int \<Rightarrow> _"
+ (SML "IntInf.~")
+ (OCaml "Big'_int.minus'_big'_int")
+ (Haskell "negate")
+ (Scala "!(- _)")
+ (Eval "~/ _")
+
+code_const "minus :: Target_Numeral.int \<Rightarrow> _"
+ (SML "IntInf.- ((_), (_))")
+ (OCaml "Big'_int.sub'_big'_int")
+ (Haskell infixl 6 "-")
+ (Scala infixl 7 "-")
+ (Eval infixl 8 "-")
+
+code_const Target_Numeral.dup
+ (SML "IntInf.*/ (2,/ (_))")
+ (OCaml "Big'_int.mult'_big'_int/ 2")
+ (Haskell "!(2 * _)")
+ (Scala "!(2 * _)")
+ (Eval "!(2 * _)")
+
+code_const Target_Numeral.sub
+ (SML "!(raise/ Fail/ \"sub\")")
+ (OCaml "failwith/ \"sub\"")
+ (Haskell "error/ \"sub\"")
+ (Scala "!error(\"sub\")")
+
+code_const "times :: Target_Numeral.int \<Rightarrow> _ \<Rightarrow> _"
+ (SML "IntInf.* ((_), (_))")
+ (OCaml "Big'_int.mult'_big'_int")
+ (Haskell infixl 7 "*")
+ (Scala infixl 8 "*")
+ (Eval infixl 9 "*")
+
+code_const Target_Numeral.divmod_abs
+ (SML "IntInf.divMod/ (IntInf.abs _,/ IntInf.abs _)")
+ (OCaml "Big'_int.quomod'_big'_int/ (Big'_int.abs'_big'_int _)/ (Big'_int.abs'_big'_int _)")
+ (Haskell "divMod/ (abs _)/ (abs _)")
+ (Scala "!((k: BigInt) => (l: BigInt) =>/ if (l == 0)/ (BigInt(0), k) else/ (k.abs '/% l.abs))")
+ (Eval "Integer.div'_mod/ (abs _)/ (abs _)")
+
+code_const "HOL.equal :: Target_Numeral.int \<Rightarrow> _ \<Rightarrow> bool"
+ (SML "!((_ : IntInf.int) = _)")
+ (OCaml "Big'_int.eq'_big'_int")
+ (Haskell infix 4 "==")
+ (Scala infixl 5 "==")
+ (Eval infixl 6 "=")
+
+code_const "less_eq :: Target_Numeral.int \<Rightarrow> _ \<Rightarrow> bool"
+ (SML "IntInf.<= ((_), (_))")
+ (OCaml "Big'_int.le'_big'_int")
+ (Haskell infix 4 "<=")
+ (Scala infixl 4 "<=")
+ (Eval infixl 6 "<=")
+
+code_const "less :: Target_Numeral.int \<Rightarrow> _ \<Rightarrow> bool"
+ (SML "IntInf.< ((_), (_))")
+ (OCaml "Big'_int.lt'_big'_int")
+ (Haskell infix 4 "<")
+ (Scala infixl 4 "<")
+ (Eval infixl 6 "<")
+
+ML {*
+structure Target_Numeral =
+struct
+
+val T = @{typ "Target_Numeral.int"};
+
+end;
+*}
+
+code_reserved Eval Target_Numeral
+
+code_const "Code_Evaluation.term_of \<Colon> Target_Numeral.int \<Rightarrow> term"
+ (Eval "HOLogic.mk'_number/ Target'_Numeral.T")
+
+code_modulename SML
+ Target_Numeral Arith
+
+code_modulename OCaml
+ Target_Numeral Arith
+
+code_modulename Haskell
+ Target_Numeral Arith
+
+
+subsection {* Implementation for @{typ int} *}
+
+code_datatype Target_Numeral.int_of
+
+lemma [code, code del]:
+ "Target_Numeral.of_int = Target_Numeral.of_int" ..
+
+lemma [code]:
+ "Target_Numeral.of_int (Target_Numeral.int_of k) = k"
+ by (simp add: Target_Numeral.int_eq_iff)
+
+declare Int.Pos_def [code]
+
+lemma [code_abbrev]:
+ "Target_Numeral.int_of (Target_Numeral.Pos k) = Int.Pos k"
+ by simp
+
+declare Int.Neg_def [code]
+
+lemma [code_abbrev]:
+ "Target_Numeral.int_of (Target_Numeral.Neg k) = Int.Neg k"
+ by simp
+
+lemma [code]:
+ "0 = Target_Numeral.int_of 0"
+ by simp
+
+lemma [code]:
+ "1 = Target_Numeral.int_of 1"
+ by simp
+
+lemma [code]:
+ "k + l = Target_Numeral.int_of (of_int k + of_int l)"
+ by simp
+
+lemma [code]:
+ "- k = Target_Numeral.int_of (- of_int k)"
+ by simp
+
+lemma [code]:
+ "k - l = Target_Numeral.int_of (of_int k - of_int l)"
+ by simp
+
+lemma [code]:
+ "Int.dup k = Target_Numeral.int_of (Target_Numeral.dup (of_int k))"
+ by simp
+
+lemma [code, code del]:
+ "Int.sub = Int.sub" ..
+
+lemma [code]:
+ "k * l = Target_Numeral.int_of (of_int k * of_int l)"
+ by simp
+
+lemma [code]:
+ "pdivmod k l = map_pair Target_Numeral.int_of Target_Numeral.int_of
+ (Target_Numeral.divmod_abs (of_int k) (of_int l))"
+ by (simp add: prod_eq_iff pdivmod_def)
+
+lemma [code]:
+ "k div l = Target_Numeral.int_of (of_int k div of_int l)"
+ by simp
+
+lemma [code]:
+ "k mod l = Target_Numeral.int_of (of_int k mod of_int l)"
+ by simp
+
+lemma [code]:
+ "HOL.equal k l = HOL.equal (of_int k :: Target_Numeral.int) (of_int l)"
+ by (simp add: equal Target_Numeral.int_eq_iff)
+
+lemma [code]:
+ "k \<le> l \<longleftrightarrow> (of_int k :: Target_Numeral.int) \<le> of_int l"
+ by (simp add: less_eq_int_def)
+
+lemma [code]:
+ "k < l \<longleftrightarrow> (of_int k :: Target_Numeral.int) < of_int l"
+ by (simp add: less_int_def)
+
+lemma (in ring_1) of_int_code:
+ "of_int k = (if k = 0 then 0
+ else if k < 0 then - of_int (- k)
+ else let
+ (l, j) = divmod_int k 2;
+ l' = 2 * of_int l
+ in if j = 0 then l' else l' + 1)"
+proof -
+ from mod_div_equality have *: "of_int k = of_int (k div 2 * 2 + k mod 2)" by simp
+ show ?thesis
+ by (simp add: Let_def divmod_int_mod_div mod_2_not_eq_zero_eq_one_int
+ of_int_add [symmetric]) (simp add: * mult_commute)
+qed
+
+declare of_int_code [code]
+
+
+subsection {* Implementation for @{typ nat} *}
+
+definition of_nat :: "nat \<Rightarrow> Target_Numeral.int" where
+ [code_abbrev]: "of_nat = Nat.of_nat"
+
+hide_const (open) of_nat
+
+lemma int_of_nat [simp]:
+ "Target_Numeral.int_of (Target_Numeral.of_nat n) = of_nat n"
+ by (simp add: of_nat_def)
+
+lemma [code abstype]:
+ "Target_Numeral.nat_of (Target_Numeral.of_nat n) = n"
+ by (simp add: nat_of_def)
+
+lemma [code_abbrev]:
+ "nat (Int.Pos k) = nat_of_num k"
+ by (simp add: nat_of_num_numeral)
+
+lemma [code abstract]:
+ "Target_Numeral.of_nat 0 = 0"
+ by (simp add: Target_Numeral.int_eq_iff)
+
+lemma [code abstract]:
+ "Target_Numeral.of_nat 1 = 1"
+ by (simp add: Target_Numeral.int_eq_iff)
+
+lemma [code abstract]:
+ "Target_Numeral.of_nat (m + n) = of_nat m + of_nat n"
+ by (simp add: Target_Numeral.int_eq_iff)
+
+lemma [code abstract]:
+ "Target_Numeral.of_nat (Code_Nat.dup n) = Target_Numeral.dup (of_nat n)"
+ by (simp add: Target_Numeral.int_eq_iff Code_Nat.dup_def)
+
+lemma [code, code del]:
+ "Code_Nat.sub = Code_Nat.sub" ..
+
+lemma [code abstract]:
+ "Target_Numeral.of_nat (m - n) = max 0 (of_nat m - of_nat n)"
+ by (simp add: Target_Numeral.int_eq_iff)
+
+lemma [code abstract]:
+ "Target_Numeral.of_nat (m * n) = of_nat m * of_nat n"
+ by (simp add: Target_Numeral.int_eq_iff of_nat_mult)
+
+lemma [code abstract]:
+ "Target_Numeral.of_nat (m div n) = of_nat m div of_nat n"
+ by (simp add: Target_Numeral.int_eq_iff zdiv_int)
+
+lemma [code abstract]:
+ "Target_Numeral.of_nat (m mod n) = of_nat m mod of_nat n"
+ by (simp add: Target_Numeral.int_eq_iff zmod_int)
+
+lemma [code]:
+ "Divides.divmod_nat m n = (m div n, m mod n)"
+ by (simp add: prod_eq_iff)
+
+lemma [code]:
+ "HOL.equal m n = HOL.equal (of_nat m :: Target_Numeral.int) (of_nat n)"
+ by (simp add: equal Target_Numeral.int_eq_iff)
+
+lemma [code]:
+ "m \<le> n \<longleftrightarrow> (of_nat m :: Target_Numeral.int) \<le> of_nat n"
+ by (simp add: less_eq_int_def)
+
+lemma [code]:
+ "m < n \<longleftrightarrow> (of_nat m :: Target_Numeral.int) < of_nat n"
+ by (simp add: less_int_def)
+
+lemma num_of_nat_code [code]:
+ "num_of_nat = Target_Numeral.num_of_int \<circ> Target_Numeral.of_nat"
+ by (simp add: fun_eq_iff num_of_int_def of_nat_def)
+
+lemma (in semiring_1) of_nat_code:
+ "of_nat n = (if n = 0 then 0
+ else let
+ (m, q) = divmod_nat n 2;
+ m' = 2 * of_nat m
+ in if q = 0 then m' else m' + 1)"
+proof -
+ from mod_div_equality have *: "of_nat n = of_nat (n div 2 * 2 + n mod 2)" by simp
+ show ?thesis
+ by (simp add: Let_def divmod_nat_div_mod mod_2_not_eq_zero_eq_one_nat
+ of_nat_add [symmetric])
+ (simp add: * mult_commute of_nat_mult add_commute)
+qed
+
+declare of_nat_code [code]
+
+text {* Conversions between @{typ nat} and @{typ int} *}
+
+definition int :: "nat \<Rightarrow> int" where
+ [code_abbrev]: "int = of_nat"
+
+hide_const (open) int
+
+lemma [code]:
+ "Target_Numeral.int n = Target_Numeral.int_of (of_nat n)"
+ by (simp add: int_def)
+
+lemma [code abstract]:
+ "Target_Numeral.of_nat (nat k) = max 0 (Target_Numeral.of_int k)"
+ by (simp add: of_nat_def of_int_of_nat max_def)
+
+end
--- a/src/HOL/List.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/List.thy Mon Mar 26 15:33:28 2012 +0200
@@ -2676,7 +2676,7 @@
-- {* simp does not terminate! *}
by (induct j) auto
-lemmas upt_rec_number_of[simp] = upt_rec[of "number_of m" "number_of n"] for m n
+lemmas upt_rec_numeral[simp] = upt_rec[of "numeral m" "numeral n"] for m n
lemma upt_conv_Nil [simp]: "j <= i ==> [i..<j] = []"
by (subst upt_rec) simp
@@ -2791,13 +2791,17 @@
lemma nth_Cons': "(x # xs)!n = (if n = 0 then x else xs!(n - 1))"
by (cases n) simp_all
-lemmas take_Cons_number_of = take_Cons'[of "number_of v"] for v
-lemmas drop_Cons_number_of = drop_Cons'[of "number_of v"] for v
-lemmas nth_Cons_number_of = nth_Cons'[of _ _ "number_of v"] for v
-
-declare take_Cons_number_of [simp]
- drop_Cons_number_of [simp]
- nth_Cons_number_of [simp]
+lemma take_Cons_numeral [simp]:
+ "take (numeral v) (x # xs) = x # take (numeral v - 1) xs"
+by (simp add: take_Cons')
+
+lemma drop_Cons_numeral [simp]:
+ "drop (numeral v) (x # xs) = drop (numeral v - 1) xs"
+by (simp add: drop_Cons')
+
+lemma nth_Cons_numeral [simp]:
+ "(x # xs) ! numeral v = xs ! (numeral v - 1)"
+by (simp add: nth_Cons')
subsubsection {* @{text upto}: interval-list on @{typ int} *}
@@ -2812,7 +2816,11 @@
declare upto.simps[code, simp del]
-lemmas upto_rec_number_of[simp] = upto.simps[of "number_of m" "number_of n"] for m n
+lemmas upto_rec_numeral [simp] =
+ upto.simps[of "numeral m" "numeral n"]
+ upto.simps[of "numeral m" "neg_numeral n"]
+ upto.simps[of "neg_numeral m" "numeral n"]
+ upto.simps[of "neg_numeral m" "neg_numeral n"] for m n
lemma upto_empty[simp]: "j < i \<Longrightarrow> [i..j] = []"
by(simp add: upto.simps)
--- a/src/HOL/Matrix_LP/ComputeFloat.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Matrix_LP/ComputeFloat.thy Mon Mar 26 15:33:28 2012 +0200
@@ -75,8 +75,11 @@
ultimately show ?thesis by auto
qed
-lemma real_is_int_number_of[simp]: "real_is_int ((number_of \<Colon> int \<Rightarrow> real) x)"
- by (auto simp: real_is_int_def intro!: exI[of _ "number_of x"])
+lemma real_is_int_numeral[simp]: "real_is_int (numeral x)"
+ by (auto simp: real_is_int_def intro!: exI[of _ "numeral x"])
+
+lemma real_is_int_neg_numeral[simp]: "real_is_int (neg_numeral x)"
+ by (auto simp: real_is_int_def intro!: exI[of _ "neg_numeral x"])
lemma int_of_real_0[simp]: "int_of_real (0::real) = (0::int)"
by (simp add: int_of_real_def)
@@ -87,7 +90,12 @@
show ?thesis by (simp only: 1 int_of_real_real)
qed
-lemma int_of_real_number_of[simp]: "int_of_real (number_of b) = number_of b"
+lemma int_of_real_numeral[simp]: "int_of_real (numeral b) = numeral b"
+ unfolding int_of_real_def
+ by (intro some_equality)
+ (auto simp add: real_of_int_inject[symmetric] simp del: real_of_int_inject)
+
+lemma int_of_real_neg_numeral[simp]: "int_of_real (neg_numeral b) = neg_numeral b"
unfolding int_of_real_def
by (intro some_equality)
(auto simp add: real_of_int_inject[symmetric] simp del: real_of_int_inject)
@@ -101,7 +109,7 @@
lemma abs_div_2_less: "a \<noteq> 0 \<Longrightarrow> a \<noteq> -1 \<Longrightarrow> abs((a::int) div 2) < abs a"
by arith
-lemma norm_0_1: "(0::_::number_ring) = Numeral0 & (1::_::number_ring) = Numeral1"
+lemma norm_0_1: "(1::_::numeral) = Numeral1"
by auto
lemma add_left_zero: "0 + a = (a::'a::comm_monoid_add)"
@@ -116,34 +124,21 @@
lemma mult_right_one: "a * 1 = (a::'a::semiring_1)"
by simp
-lemma int_pow_0: "(a::int)^(Numeral0) = 1"
+lemma int_pow_0: "(a::int)^0 = 1"
by simp
lemma int_pow_1: "(a::int)^(Numeral1) = a"
by simp
-lemma zero_eq_Numeral0_nring: "(0::'a::number_ring) = Numeral0"
- by simp
-
-lemma one_eq_Numeral1_nring: "(1::'a::number_ring) = Numeral1"
- by simp
-
-lemma zero_eq_Numeral0_nat: "(0::nat) = Numeral0"
+lemma one_eq_Numeral1_nring: "(1::'a::numeral) = Numeral1"
by simp
lemma one_eq_Numeral1_nat: "(1::nat) = Numeral1"
by simp
-lemma zpower_Pls: "(z::int)^Numeral0 = Numeral1"
+lemma zpower_Pls: "(z::int)^0 = Numeral1"
by simp
-lemma zpower_Min: "(z::int)^((-1)::nat) = Numeral1"
-proof -
- have 1:"((-1)::nat) = 0"
- by simp
- show ?thesis by (simp add: 1)
-qed
-
lemma fst_cong: "a=a' \<Longrightarrow> fst (a,b) = fst (a',b)"
by simp
@@ -160,70 +155,8 @@
lemma not_true_eq_false: "(~ True) = False" by simp
-lemmas binarith =
- normalize_bin_simps
- pred_bin_simps succ_bin_simps
- add_bin_simps minus_bin_simps mult_bin_simps
-
-lemma int_eq_number_of_eq:
- "(((number_of v)::int)=(number_of w)) = iszero ((number_of (v + uminus w))::int)"
- by (rule eq_number_of_eq)
-
-lemma int_iszero_number_of_Pls: "iszero (Numeral0::int)"
- by (simp only: iszero_number_of_Pls)
-
-lemma int_nonzero_number_of_Min: "~(iszero ((-1)::int))"
- by simp
-
-lemma int_iszero_number_of_Bit0: "iszero ((number_of (Int.Bit0 w))::int) = iszero ((number_of w)::int)"
- by simp
-
-lemma int_iszero_number_of_Bit1: "\<not> iszero ((number_of (Int.Bit1 w))::int)"
- by simp
-
-lemma int_less_number_of_eq_neg: "(((number_of x)::int) < number_of y) = neg ((number_of (x + (uminus y)))::int)"
- unfolding neg_def number_of_is_id by simp
-
-lemma int_not_neg_number_of_Pls: "\<not> (neg (Numeral0::int))"
- by simp
-
-lemma int_neg_number_of_Min: "neg (-1::int)"
- by simp
-
-lemma int_neg_number_of_Bit0: "neg ((number_of (Int.Bit0 w))::int) = neg ((number_of w)::int)"
- by simp
-
-lemma int_neg_number_of_Bit1: "neg ((number_of (Int.Bit1 w))::int) = neg ((number_of w)::int)"
- by simp
-
-lemma int_le_number_of_eq: "(((number_of x)::int) \<le> number_of y) = (\<not> neg ((number_of (y + (uminus x)))::int))"
- unfolding neg_def number_of_is_id by (simp add: not_less)
-
-lemmas intarithrel =
- int_eq_number_of_eq
- lift_bool[OF int_iszero_number_of_Pls] nlift_bool[OF int_nonzero_number_of_Min] int_iszero_number_of_Bit0
- 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]
- int_neg_number_of_Bit0 int_neg_number_of_Bit1 int_le_number_of_eq
-
-lemma int_number_of_add_sym: "((number_of v)::int) + number_of w = number_of (v + w)"
- by simp
-
-lemma int_number_of_diff_sym: "((number_of v)::int) - number_of w = number_of (v + (uminus w))"
- by simp
-
-lemma int_number_of_mult_sym: "((number_of v)::int) * number_of w = number_of (v * w)"
- by simp
-
-lemma int_number_of_minus_sym: "- ((number_of v)::int) = number_of (uminus v)"
- by simp
-
-lemmas intarith = int_number_of_add_sym int_number_of_minus_sym int_number_of_diff_sym int_number_of_mult_sym
-
-lemmas natarith = add_nat_number_of diff_nat_number_of mult_nat_number_of eq_nat_number_of less_nat_number_of
-
-lemmas powerarith = nat_number_of zpower_number_of_even
- zpower_number_of_odd[simplified zero_eq_Numeral0_nring one_eq_Numeral1_nring]
- zpower_Pls zpower_Min
+lemmas powerarith = nat_numeral zpower_numeral_even
+ zpower_numeral_odd zpower_Pls
definition float :: "(int \<times> int) \<Rightarrow> real" where
"float = (\<lambda>(a, b). real a * 2 powr real b)"
@@ -302,7 +235,8 @@
float_minus float_abs zero_le_float float_pprt float_nprt pprt_lbound nprt_ubound
(* for use with the compute oracle *)
-lemmas arith = binarith intarith intarithrel natarith powerarith floatarith not_false_eq_true not_true_eq_false
+lemmas arith = arith_simps rel_simps diff_nat_numeral nat_0
+ nat_neg_numeral powerarith floatarith not_false_eq_true not_true_eq_false
use "~~/src/HOL/Tools/float_arith.ML"
--- a/src/HOL/Matrix_LP/ComputeNumeral.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Matrix_LP/ComputeNumeral.thy Mon Mar 26 15:33:28 2012 +0200
@@ -2,145 +2,47 @@
imports ComputeHOL ComputeFloat
begin
-(* normalization of bit strings *)
-lemmas bitnorm = normalize_bin_simps
-
-(* neg for bit strings *)
-lemma neg1: "neg Int.Pls = False" by (simp add: Int.Pls_def)
-lemma neg2: "neg Int.Min = True" apply (subst Int.Min_def) by auto
-lemma neg3: "neg (Int.Bit0 x) = neg x" apply (simp add: neg_def) apply (subst Bit0_def) by auto
-lemma neg4: "neg (Int.Bit1 x) = neg x" apply (simp add: neg_def) apply (subst Bit1_def) by auto
-lemmas bitneg = neg1 neg2 neg3 neg4
-
-(* iszero for bit strings *)
-lemma iszero1: "iszero Int.Pls = True" by (simp add: Int.Pls_def iszero_def)
-lemma iszero2: "iszero Int.Min = False" apply (subst Int.Min_def) apply (subst iszero_def) by simp
-lemma iszero3: "iszero (Int.Bit0 x) = iszero x" apply (subst Int.Bit0_def) apply (subst iszero_def)+ by auto
-lemma iszero4: "iszero (Int.Bit1 x) = False" apply (subst Int.Bit1_def) apply (subst iszero_def)+ apply simp by arith
-lemmas bitiszero = iszero1 iszero2 iszero3 iszero4
-
-(* lezero for bit strings *)
-definition "lezero x \<longleftrightarrow> x \<le> 0"
-lemma lezero1: "lezero Int.Pls = True" unfolding Int.Pls_def lezero_def by auto
-lemma lezero2: "lezero Int.Min = True" unfolding Int.Min_def lezero_def by auto
-lemma lezero3: "lezero (Int.Bit0 x) = lezero x" unfolding Int.Bit0_def lezero_def by auto
-lemma lezero4: "lezero (Int.Bit1 x) = neg x" unfolding Int.Bit1_def lezero_def neg_def by auto
-lemmas bitlezero = lezero1 lezero2 lezero3 lezero4
-
(* equality for bit strings *)
-lemmas biteq = eq_bin_simps
+lemmas biteq = eq_num_simps
(* x < y for bit strings *)
-lemmas bitless = less_bin_simps
+lemmas bitless = less_num_simps
(* x \<le> y for bit strings *)
-lemmas bitle = le_bin_simps
-
-(* succ for bit strings *)
-lemmas bitsucc = succ_bin_simps
-
-(* pred for bit strings *)
-lemmas bitpred = pred_bin_simps
-
-(* unary minus for bit strings *)
-lemmas bituminus = minus_bin_simps
+lemmas bitle = le_num_simps
(* addition for bit strings *)
-lemmas bitadd = add_bin_simps
+lemmas bitadd = add_num_simps
(* multiplication for bit strings *)
-lemma mult_Pls_right: "x * Int.Pls = Int.Pls" by (simp add: Pls_def)
-lemma mult_Min_right: "x * Int.Min = - x" by (subst mult_commute) simp
-lemma multb0x: "(Int.Bit0 x) * y = Int.Bit0 (x * y)" by (rule mult_Bit0)
-lemma multxb0: "x * (Int.Bit0 y) = Int.Bit0 (x * y)" unfolding Bit0_def by simp
-lemma multb1: "(Int.Bit1 x) * (Int.Bit1 y) = Int.Bit1 (Int.Bit0 (x * y) + x + y)"
- unfolding Bit0_def Bit1_def by (simp add: algebra_simps)
-lemmas bitmul = mult_Pls mult_Min mult_Pls_right mult_Min_right multb0x multxb0 multb1
+lemmas bitmul = mult_num_simps
-lemmas bitarith = bitnorm bitiszero bitneg bitlezero biteq bitless bitle bitsucc bitpred bituminus bitadd bitmul
-
-definition "nat_norm_number_of (x::nat) = x"
-
-lemma nat_norm_number_of: "nat_norm_number_of (number_of w) = (if lezero w then 0 else number_of w)"
- apply (simp add: nat_norm_number_of_def)
- unfolding lezero_def iszero_def neg_def
- apply (simp add: numeral_simps)
- done
+lemmas bitarith = arith_simps
(* Normalization of nat literals *)
-lemma natnorm0: "(0::nat) = number_of (Int.Pls)" by auto
-lemma natnorm1: "(1 :: nat) = number_of (Int.Bit1 Int.Pls)" by auto
-lemmas natnorm = natnorm0 natnorm1 nat_norm_number_of
-
-(* Suc *)
-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)
-
-(* Addition for nat *)
-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))))"
- unfolding nat_number_of_def number_of_is_id neg_def
- by auto
-
-(* Subtraction for nat *)
-lemma natsub: "(number_of x) - ((number_of y)::nat) =
- (if neg x then 0 else (if neg y then number_of x else (nat_norm_number_of (number_of (x + (- y))))))"
- unfolding nat_norm_number_of
- by (auto simp add: number_of_is_id neg_def lezero_def iszero_def Let_def nat_number_of_def)
-
-(* Multiplication for nat *)
-lemma natmul: "(number_of x) * ((number_of y)::nat) =
- (if neg x then 0 else (if neg y then 0 else number_of (x * y)))"
- unfolding nat_number_of_def number_of_is_id neg_def
- by (simp add: nat_mult_distrib)
-
-lemma nateq: "(((number_of x)::nat) = (number_of y)) = ((lezero x \<and> lezero y) \<or> (x = y))"
- by (auto simp add: iszero_def lezero_def neg_def number_of_is_id)
-
-lemma natless: "(((number_of x)::nat) < (number_of y)) = ((x < y) \<and> (\<not> (lezero y)))"
- by (simp add: lezero_def numeral_simps not_le)
-
-lemma natle: "(((number_of x)::nat) \<le> (number_of y)) = (y < x \<longrightarrow> lezero x)"
- by (auto simp add: number_of_is_id lezero_def nat_number_of_def)
+lemmas natnorm = one_eq_Numeral1_nat
fun natfac :: "nat \<Rightarrow> nat"
where "natfac n = (if n = 0 then 1 else n * (natfac (n - 1)))"
-lemmas compute_natarith = bitarith natnorm natsuc natadd natsub natmul nateq natless natle natfac.simps
-
-lemma number_eq: "(((number_of x)::'a::{number_ring, linordered_idom}) = (number_of y)) = (x = y)"
- unfolding number_of_eq
- apply simp
- done
+lemmas compute_natarith =
+ arith_simps rel_simps
+ diff_nat_numeral nat_numeral nat_0 nat_neg_numeral
+ numeral_1_eq_1 [symmetric]
+ numeral_1_eq_Suc_0 [symmetric]
+ Suc_numeral natfac.simps
-lemma number_le: "(((number_of x)::'a::{number_ring, linordered_idom}) \<le> (number_of y)) = (x \<le> y)"
- unfolding number_of_eq
- apply simp
- done
-
-lemma number_less: "(((number_of x)::'a::{number_ring, linordered_idom}) < (number_of y)) = (x < y)"
- unfolding number_of_eq
- apply simp
- done
+lemmas number_norm = numeral_1_eq_1[symmetric]
-lemma number_diff: "((number_of x)::'a::{number_ring, linordered_idom}) - number_of y = number_of (x + (- y))"
- apply (subst diff_number_of_eq)
- apply simp
- done
-
-lemmas number_norm = number_of_Pls[symmetric] numeral_1_eq_1[symmetric]
-
-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
+lemmas compute_numberarith =
+ arith_simps rel_simps number_norm
-lemma compute_real_of_nat_number_of: "real ((number_of v)::nat) = (if neg v then 0 else number_of v)"
- by (simp only: real_of_nat_number_of number_of_is_id)
-
-lemma compute_nat_of_int_number_of: "nat ((number_of v)::int) = (number_of v)"
- by simp
+lemmas compute_num_conversions =
+ real_of_nat_numeral real_of_nat_zero
+ nat_numeral nat_0 nat_neg_numeral
+ real_numeral real_of_int_zero
-lemmas compute_num_conversions = compute_real_of_nat_number_of compute_nat_of_int_number_of real_number_of
-
-lemmas zpowerarith = zpower_number_of_even
- zpower_number_of_odd[simplified zero_eq_Numeral0_nring one_eq_Numeral1_nring]
- zpower_Pls zpower_Min
+lemmas zpowerarith = zpower_numeral_even zpower_numeral_odd zpower_Pls int_pow_1
(* div, mod *)
@@ -162,26 +64,19 @@
(* collecting all the theorems *)
-lemma even_Pls: "even (Int.Pls) = True"
- apply (unfold Pls_def even_def)
+lemma even_0_int: "even (0::int) = True"
by simp
-lemma even_Min: "even (Int.Min) = False"
- apply (unfold Min_def even_def)
+lemma even_One_int: "even (numeral Num.One :: int) = False"
by simp
-lemma even_B0: "even (Int.Bit0 x) = True"
- apply (unfold Bit0_def)
+lemma even_Bit0_int: "even (numeral (Num.Bit0 x) :: int) = True"
by simp
-lemma even_B1: "even (Int.Bit1 x) = False"
- apply (unfold Bit1_def)
+lemma even_Bit1_int: "even (numeral (Num.Bit1 x) :: int) = False"
by simp
-lemma even_number_of: "even ((number_of w)::int) = even w"
- by (simp only: number_of_is_id)
-
-lemmas compute_even = even_Pls even_Min even_B0 even_B1 even_number_of
+lemmas compute_even = even_0_int even_One_int even_Bit0_int even_Bit1_int
lemmas compute_numeral = compute_if compute_let compute_pair compute_bool
compute_natarith compute_numberarith max_def min_def compute_num_conversions zpowerarith compute_div_mod compute_even
--- a/src/HOL/Matrix_LP/SparseMatrix.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Matrix_LP/SparseMatrix.thy Mon Mar 26 15:33:28 2012 +0200
@@ -1029,9 +1029,7 @@
sparse_row_matrix_pprt sorted_spvec_pprt_spmat sorted_spmat_pprt_spmat
sparse_row_matrix_nprt sorted_spvec_nprt_spmat sorted_spmat_nprt_spmat
-lemma zero_eq_Numeral0: "(0::_::number_ring) = Numeral0" by simp
-
-lemmas sparse_row_matrix_arith_simps[simplified zero_eq_Numeral0] =
+lemmas sparse_row_matrix_arith_simps =
mult_spmat.simps mult_spvec_spmat.simps
addmult_spvec.simps
smult_spvec_empty smult_spvec_cons
--- a/src/HOL/Metis_Examples/Big_O.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Metis_Examples/Big_O.thy Mon Mar 26 15:33:28 2012 +0200
@@ -16,7 +16,7 @@
subsection {* Definitions *}
-definition bigo :: "('a => 'b\<Colon>{linordered_idom,number_ring}) => ('a => 'b) set" ("(1O'(_'))") where
+definition bigo :: "('a => 'b\<Colon>linordered_idom) => ('a => 'b) set" ("(1O'(_'))") where
"O(f\<Colon>('a => 'b)) == {h. \<exists>c. \<forall>x. abs (h x) <= c * abs (f x)}"
lemma bigo_pos_const:
@@ -180,7 +180,7 @@
apply (rule_tac x = "c + c" in exI)
apply auto
apply (subgoal_tac "c * abs (f xa + g xa) <= (c + c) * abs (g xa)")
- apply (metis order_trans semiring_mult_2)
+ apply (metis order_trans mult_2)
apply (subgoal_tac "c * abs (f xa + g xa) <= c * (abs (f xa) + abs (g xa))")
apply (erule order_trans)
apply (simp add: ring_distribs)
@@ -325,7 +325,7 @@
by (metis bigo_mult2 set_plus_mono_b set_times_intro2 set_times_plus_distrib)
lemma bigo_mult5: "\<forall>x. f x ~= 0 \<Longrightarrow>
- O(f * g) <= (f\<Colon>'a => ('b\<Colon>{linordered_field,number_ring})) *o O(g)"
+ O(f * g) <= (f\<Colon>'a => ('b\<Colon>linordered_field)) *o O(g)"
proof -
assume a: "\<forall>x. f x ~= 0"
show "O(f * g) <= f *o O(g)"
@@ -351,21 +351,21 @@
qed
lemma bigo_mult6:
-"\<forall>x. f x \<noteq> 0 \<Longrightarrow> O(f * g) = (f\<Colon>'a \<Rightarrow> ('b\<Colon>{linordered_field,number_ring})) *o O(g)"
+"\<forall>x. f x \<noteq> 0 \<Longrightarrow> O(f * g) = (f\<Colon>'a \<Rightarrow> ('b\<Colon>linordered_field)) *o O(g)"
by (metis bigo_mult2 bigo_mult5 order_antisym)
(*proof requires relaxing relevance: 2007-01-25*)
declare bigo_mult6 [simp]
lemma bigo_mult7:
-"\<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)"
+"\<forall>x. f x \<noteq> 0 \<Longrightarrow> O(f * g) \<le> O(f\<Colon>'a \<Rightarrow> ('b\<Colon>linordered_field)) \<otimes> O(g)"
by (metis bigo_refl bigo_mult6 set_times_mono3)
declare bigo_mult6 [simp del]
declare bigo_mult7 [intro!]
lemma bigo_mult8:
-"\<forall>x. f x \<noteq> 0 \<Longrightarrow> O(f * g) = O(f\<Colon>'a \<Rightarrow> ('b\<Colon>{linordered_field,number_ring})) \<otimes> O(g)"
+"\<forall>x. f x \<noteq> 0 \<Longrightarrow> O(f * g) = O(f\<Colon>'a \<Rightarrow> ('b\<Colon>linordered_field)) \<otimes> O(g)"
by (metis bigo_mult bigo_mult7 order_antisym_conv)
lemma bigo_minus [intro]: "f : O(g) \<Longrightarrow> - f : O(g)"
@@ -405,14 +405,14 @@
lemma bigo_const2 [intro]: "O(\<lambda>x. c) \<le> O(\<lambda>x. 1)"
by (metis bigo_const1 bigo_elt_subset)
-lemma bigo_const3: "(c\<Colon>'a\<Colon>{linordered_field,number_ring}) ~= 0 \<Longrightarrow> (\<lambda>x. 1) : O(\<lambda>x. c)"
+lemma bigo_const3: "(c\<Colon>'a\<Colon>linordered_field) ~= 0 \<Longrightarrow> (\<lambda>x. 1) : O(\<lambda>x. c)"
apply (simp add: bigo_def)
by (metis abs_eq_0 left_inverse order_refl)
-lemma bigo_const4: "(c\<Colon>'a\<Colon>{linordered_field,number_ring}) ~= 0 \<Longrightarrow> O(\<lambda>x. 1) <= O(\<lambda>x. c)"
+lemma bigo_const4: "(c\<Colon>'a\<Colon>linordered_field) ~= 0 \<Longrightarrow> O(\<lambda>x. 1) <= O(\<lambda>x. c)"
by (metis bigo_elt_subset bigo_const3)
-lemma bigo_const [simp]: "(c\<Colon>'a\<Colon>{linordered_field,number_ring}) ~= 0 \<Longrightarrow>
+lemma bigo_const [simp]: "(c\<Colon>'a\<Colon>linordered_field) ~= 0 \<Longrightarrow>
O(\<lambda>x. c) = O(\<lambda>x. 1)"
by (metis bigo_const2 bigo_const4 equalityI)
@@ -423,19 +423,19 @@
lemma bigo_const_mult2: "O(\<lambda>x. c * f x) \<le> O(f)"
by (rule bigo_elt_subset, rule bigo_const_mult1)
-lemma bigo_const_mult3: "(c\<Colon>'a\<Colon>{linordered_field,number_ring}) ~= 0 \<Longrightarrow> f : O(\<lambda>x. c * f x)"
+lemma bigo_const_mult3: "(c\<Colon>'a\<Colon>linordered_field) ~= 0 \<Longrightarrow> f : O(\<lambda>x. c * f x)"
apply (simp add: bigo_def)
by (metis (no_types) abs_mult mult_assoc mult_1 order_refl left_inverse)
lemma bigo_const_mult4:
-"(c\<Colon>'a\<Colon>{linordered_field,number_ring}) \<noteq> 0 \<Longrightarrow> O(f) \<le> O(\<lambda>x. c * f x)"
+"(c\<Colon>'a\<Colon>linordered_field) \<noteq> 0 \<Longrightarrow> O(f) \<le> O(\<lambda>x. c * f x)"
by (metis bigo_elt_subset bigo_const_mult3)
-lemma bigo_const_mult [simp]: "(c\<Colon>'a\<Colon>{linordered_field,number_ring}) ~= 0 \<Longrightarrow>
+lemma bigo_const_mult [simp]: "(c\<Colon>'a\<Colon>linordered_field) ~= 0 \<Longrightarrow>
O(\<lambda>x. c * f x) = O(f)"
by (metis equalityI bigo_const_mult2 bigo_const_mult4)
-lemma bigo_const_mult5 [simp]: "(c\<Colon>'a\<Colon>{linordered_field,number_ring}) ~= 0 \<Longrightarrow>
+lemma bigo_const_mult5 [simp]: "(c\<Colon>'a\<Colon>linordered_field) ~= 0 \<Longrightarrow>
(\<lambda>x. c) *o O(f) = O(f)"
apply (auto del: subsetI)
apply (rule order_trans)
@@ -587,7 +587,7 @@
apply assumption+
done
-lemma bigo_useful_const_mult: "(c\<Colon>'a\<Colon>{linordered_field,number_ring}) ~= 0 \<Longrightarrow>
+lemma bigo_useful_const_mult: "(c\<Colon>'a\<Colon>linordered_field) ~= 0 \<Longrightarrow>
(\<lambda>x. c) * f =o O(h) \<Longrightarrow> f =o O(h)"
apply (rule subsetD)
apply (subgoal_tac "(\<lambda>x. 1 / c) *o O(h) <= O(h)")
@@ -696,7 +696,7 @@
by (metis abs_ge_zero linorder_linear min_max.sup_absorb1 min_max.sup_commute)
lemma bigo_lesso4:
- "f <o g =o O(k\<Colon>'a=>'b\<Colon>{linordered_field,number_ring}) \<Longrightarrow>
+ "f <o g =o O(k\<Colon>'a=>'b\<Colon>{linordered_field}) \<Longrightarrow>
g =o h +o O(k) \<Longrightarrow> f <o h =o O(k)"
apply (unfold lesso_def)
apply (drule set_plus_imp_minus)
--- a/src/HOL/Multivariate_Analysis/Cartesian_Euclidean_Space.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Multivariate_Analysis/Cartesian_Euclidean_Space.thy Mon Mar 26 15:33:28 2012 +0200
@@ -207,6 +207,15 @@
by (auto intro!: injI simp add: vec_eq_iff of_nat_index)
qed
+instance vec :: (numeral, finite) numeral ..
+instance vec :: (semiring_numeral, finite) semiring_numeral ..
+
+lemma numeral_index [simp]: "numeral w $ i = numeral w"
+ by (induct w, simp_all only: numeral.simps vector_add_component one_index)
+
+lemma neg_numeral_index [simp]: "neg_numeral w $ i = neg_numeral w"
+ by (simp only: neg_numeral_def vector_uminus_component numeral_index)
+
instance vec :: (comm_ring_1, finite) comm_ring_1 ..
instance vec :: (ring_char_0, finite) ring_char_0 ..
@@ -222,7 +231,7 @@
by (vector field_simps)
lemma vector_smult_rneg: "(c::'a::ring) *s -x = -(c *s x)" by vector
lemma vector_smult_lneg: "- (c::'a::ring) *s x = -(c *s x)" by vector
-lemma vector_sneg_minus1: "-x = (- (1::'a::ring_1)) *s x" by vector
+lemma vector_sneg_minus1: "-x = (-1::'a::ring_1) *s x" by vector
lemma vector_smult_rzero[simp]: "c *s 0 = (0::'a::mult_zero ^ 'n)" by vector
lemma vector_sub_rdistrib: "((a::'a::ring) - b) *s x = a *s x - b *s x"
by (vector field_simps)
--- a/src/HOL/Multivariate_Analysis/Convex_Euclidean_Space.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Multivariate_Analysis/Convex_Euclidean_Space.thy Mon Mar 26 15:33:28 2012 +0200
@@ -281,7 +281,7 @@
lemma scaleR_2:
fixes x :: "'a::real_vector"
shows "scaleR 2 x = x + x"
-unfolding one_add_one_is_two [symmetric] scaleR_left_distrib by simp
+unfolding one_add_one [symmetric] scaleR_left_distrib by simp
lemma vector_choose_size: "0 <= c ==> \<exists>(x::'a::euclidean_space). norm x = c"
apply (rule exI[where x="c *\<^sub>R basis 0 ::'a"]) using DIM_positive[where 'a='a] by auto
--- a/src/HOL/Multivariate_Analysis/Determinants.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Multivariate_Analysis/Determinants.thy Mon Mar 26 15:33:28 2012 +0200
@@ -286,7 +286,7 @@
proof-
have tha: "\<And>(a::'a) b. a = b ==> b = - a ==> a = 0"
by simp
- have th1: "of_int (-1) = - 1" by (metis of_int_1 of_int_minus number_of_Min)
+ have th1: "of_int (-1) = - 1" by simp
let ?p = "Fun.swap i j id"
let ?A = "\<chi> i. A $ ?p i"
from r have "A = ?A" by (simp add: vec_eq_iff row_def swap_def)
@@ -1058,8 +1058,7 @@
unfolding det_def UNIV_2
unfolding setsum_over_permutations_insert[OF f12]
unfolding permutes_sing
- apply (simp add: sign_swap_id sign_id swap_id_eq)
- by (simp add: arith_simps(31)[symmetric] del: arith_simps(31))
+ by (simp add: sign_swap_id sign_id swap_id_eq)
qed
lemma det_3: "det (A::'a::comm_ring_1^3^3) =
@@ -1079,9 +1078,7 @@
unfolding setsum_over_permutations_insert[OF f23]
unfolding permutes_sing
- apply (simp add: sign_swap_id permutation_swap_id sign_compose sign_id swap_id_eq)
- apply (simp add: arith_simps(31)[symmetric] del: arith_simps(31))
- by (simp add: field_simps)
+ by (simp add: sign_swap_id permutation_swap_id sign_compose sign_id swap_id_eq)
qed
end
--- a/src/HOL/Multivariate_Analysis/Norm_Arith.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Multivariate_Analysis/Norm_Arith.thy Mon Mar 26 15:33:28 2012 +0200
@@ -104,6 +104,17 @@
"x \<noteq> y \<longleftrightarrow> \<not> (norm (x - y) \<le> 0)"
using norm_ge_zero[of "x - y"] by auto
+lemmas arithmetic_simps =
+ arith_simps
+ add_numeral_special
+ add_neg_numeral_special
+ add_0_left
+ add_0_right
+ mult_zero_left
+ mult_zero_right
+ mult_1_left
+ mult_1_right
+
use "normarith.ML"
method_setup norm = {* Scan.succeed (SIMPLE_METHOD' o NormArith.norm_arith_tac)
--- a/src/HOL/Multivariate_Analysis/Topology_Euclidean_Space.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Multivariate_Analysis/Topology_Euclidean_Space.thy Mon Mar 26 15:33:28 2012 +0200
@@ -5786,7 +5786,7 @@
{ assume as:"dist a b > dist (f n x) (f n y)"
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"
and "\<forall>m\<ge>Nb. dist (f (r m) y) b < (dist a b - dist (f n x) (f n y)) / 2"
- using lima limb unfolding h_def LIMSEQ_def by (fastforce simp del: less_divide_eq_number_of1)
+ using lima limb unfolding h_def LIMSEQ_def by (fastforce simp del: less_divide_eq_numeral1)
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)"
apply(erule_tac x="Na+Nb+n" in allE)
apply(erule_tac x="Na+Nb+n" in allE) apply simp
--- a/src/HOL/Mutabelle/mutabelle_extra.ML Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Mutabelle/mutabelle_extra.ML Mon Mar 26 15:33:28 2012 +0200
@@ -271,7 +271,7 @@
@{const_name enum_prod_inst.enum_ex_prod},
@{const_name Quickcheck.catch_match},
@{const_name Quickcheck_Exhaustive.unknown},
- @{const_name Int.Bit0}, @{const_name Int.Bit1}
+ @{const_name Num.Bit0}, @{const_name Num.Bit1}
(*@{const_name "==>"}, @{const_name "=="}*)]
val forbidden_mutant_consts =
--- a/src/HOL/NSA/HyperDef.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/NSA/HyperDef.thy Mon Mar 26 15:33:28 2012 +0200
@@ -346,8 +346,8 @@
K (Lin_Arith.add_inj_thms [@{thm star_of_le} RS iffD2,
@{thm star_of_less} RS iffD2, @{thm star_of_eq} RS iffD2]
#> Lin_Arith.add_simps [@{thm star_of_zero}, @{thm star_of_one},
- @{thm star_of_number_of}, @{thm star_of_add}, @{thm star_of_minus},
- @{thm star_of_diff}, @{thm star_of_mult}]
+ @{thm star_of_numeral}, @{thm star_of_neg_numeral}, @{thm star_of_add},
+ @{thm star_of_minus}, @{thm star_of_diff}, @{thm star_of_mult}]
#> Lin_Arith.add_inj_const (@{const_name "StarDef.star_of"}, @{typ "real \<Rightarrow> hypreal"}))
*}
@@ -419,10 +419,15 @@
x ^ Suc (Suc 0) + y ^ Suc (Suc 0) + (hypreal_of_nat (Suc (Suc 0)))*x*y"
by (simp add: right_distrib left_distrib)
-lemma power_hypreal_of_real_number_of:
- "(number_of v :: hypreal) ^ n = hypreal_of_real ((number_of v) ^ n)"
+lemma power_hypreal_of_real_numeral:
+ "(numeral v :: hypreal) ^ n = hypreal_of_real ((numeral v) ^ n)"
by simp
-declare power_hypreal_of_real_number_of [of _ "number_of w", simp] for w
+declare power_hypreal_of_real_numeral [of _ "numeral w", simp] for w
+
+lemma power_hypreal_of_real_neg_numeral:
+ "(neg_numeral v :: hypreal) ^ n = hypreal_of_real ((neg_numeral v) ^ n)"
+by simp
+declare power_hypreal_of_real_neg_numeral [of _ "numeral w", simp] for w
(*
lemma hrealpow_HFinite:
fixes x :: "'a::{real_normed_algebra,power} star"
@@ -492,7 +497,7 @@
by transfer (rule power_one)
lemma hrabs_hyperpow_minus_one [simp]:
- "\<And>n. abs(-1 pow n) = (1::'a::{number_ring,linordered_idom} star)"
+ "\<And>n. abs(-1 pow n) = (1::'a::{linordered_idom} star)"
by transfer (rule abs_power_minus_one)
lemma hyperpow_mult:
--- a/src/HOL/NSA/NSA.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/NSA/NSA.thy Mon Mar 26 15:33:28 2012 +0200
@@ -190,7 +190,7 @@
lemma SReal_hypreal_of_real [simp]: "hypreal_of_real x \<in> Reals"
by (simp add: Reals_eq_Standard)
-lemma SReal_divide_number_of: "r \<in> Reals ==> r/(number_of w::hypreal) \<in> Reals"
+lemma SReal_divide_numeral: "r \<in> Reals ==> r/(numeral w::hypreal) \<in> Reals"
by simp
text{*epsilon is not in Reals because it is an infinitesimal*}
@@ -290,8 +290,8 @@
"(hnorm (x::hypreal) \<in> HFinite) = (x \<in> HFinite)"
by (simp add: HFinite_def)
-lemma HFinite_number_of [simp]: "number_of w \<in> HFinite"
-unfolding star_number_def by (rule HFinite_star_of)
+lemma HFinite_numeral [simp]: "numeral w \<in> HFinite"
+unfolding star_numeral_def by (rule HFinite_star_of)
(** As always with numerals, 0 and 1 are special cases **)
@@ -347,7 +347,7 @@
apply (rule InfinitesimalI)
apply (rule hypreal_sum_of_halves [THEN subst])
apply (drule half_gt_zero)
-apply (blast intro: hnorm_add_less SReal_divide_number_of dest: InfinitesimalD)
+apply (blast intro: hnorm_add_less SReal_divide_numeral dest: InfinitesimalD)
done
lemma Infinitesimal_minus_iff [simp]: "(-x:Infinitesimal) = (x:Infinitesimal)"
@@ -652,7 +652,7 @@
(*reorientation simplification procedure: reorients (polymorphic)
0 = x, 1 = x, nnn = x provided x isn't 0, 1 or a numeral.*)
simproc_setup approx_reorient_simproc
- ("0 @= x" | "1 @= y" | "number_of w @= z") =
+ ("0 @= x" | "1 @= y" | "numeral w @= z" | "neg_numeral w @= r") =
{*
let val rule = @{thm approx_reorient} RS eq_reflection
fun proc phi ss ct = case term_of ct of
@@ -957,9 +957,9 @@
"x \<noteq> 0 ==> star_of x \<in> HFinite - Infinitesimal"
by simp
-lemma number_of_not_Infinitesimal [simp]:
- "number_of w \<noteq> (0::hypreal) ==> (number_of w :: hypreal) \<notin> Infinitesimal"
-by (fast dest: Reals_number_of [THEN SReal_Infinitesimal_zero])
+lemma numeral_not_Infinitesimal [simp]:
+ "numeral w \<noteq> (0::hypreal) ==> (numeral w :: hypreal) \<notin> Infinitesimal"
+by (fast dest: Reals_numeral [THEN SReal_Infinitesimal_zero])
(*again: 1 is a special case, but not 0 this time*)
lemma one_not_Infinitesimal [simp]:
@@ -1024,31 +1024,31 @@
apply simp
done
-lemma number_of_approx_iff [simp]:
- "(number_of v @= (number_of w :: 'a::{number,real_normed_vector} star)) =
- (number_of v = (number_of w :: 'a))"
-apply (unfold star_number_def)
+lemma numeral_approx_iff [simp]:
+ "(numeral v @= (numeral w :: 'a::{numeral,real_normed_vector} star)) =
+ (numeral v = (numeral w :: 'a))"
+apply (unfold star_numeral_def)
apply (rule star_of_approx_iff)
done
(*And also for 0 @= #nn and 1 @= #nn, #nn @= 0 and #nn @= 1.*)
lemma [simp]:
- "(number_of w @= (0::'a::{number,real_normed_vector} star)) =
- (number_of w = (0::'a))"
- "((0::'a::{number,real_normed_vector} star) @= number_of w) =
- (number_of w = (0::'a))"
- "(number_of w @= (1::'b::{number,one,real_normed_vector} star)) =
- (number_of w = (1::'b))"
- "((1::'b::{number,one,real_normed_vector} star) @= number_of w) =
- (number_of w = (1::'b))"
+ "(numeral w @= (0::'a::{numeral,real_normed_vector} star)) =
+ (numeral w = (0::'a))"
+ "((0::'a::{numeral,real_normed_vector} star) @= numeral w) =
+ (numeral w = (0::'a))"
+ "(numeral w @= (1::'b::{numeral,one,real_normed_vector} star)) =
+ (numeral w = (1::'b))"
+ "((1::'b::{numeral,one,real_normed_vector} star) @= numeral w) =
+ (numeral w = (1::'b))"
"~ (0 @= (1::'c::{zero_neq_one,real_normed_vector} star))"
"~ (1 @= (0::'c::{zero_neq_one,real_normed_vector} star))"
-apply (unfold star_number_def star_zero_def star_one_def)
+apply (unfold star_numeral_def star_zero_def star_one_def)
apply (unfold star_of_approx_iff)
by (auto intro: sym)
-lemma star_of_approx_number_of_iff [simp]:
- "(star_of k @= number_of w) = (k = number_of w)"
+lemma star_of_approx_numeral_iff [simp]:
+ "(star_of k @= numeral w) = (k = numeral w)"
by (subst star_of_approx_iff [symmetric], auto)
lemma star_of_approx_zero_iff [simp]: "(star_of k @= 0) = (k = 0)"
@@ -1843,8 +1843,11 @@
lemma st_add: "\<lbrakk>x \<in> HFinite; y \<in> HFinite\<rbrakk> \<Longrightarrow> st (x + y) = st x + st y"
by (simp add: st_unique st_SReal st_approx_self approx_add)
-lemma st_number_of [simp]: "st (number_of w) = number_of w"
-by (rule Reals_number_of [THEN st_SReal_eq])
+lemma st_numeral [simp]: "st (numeral w) = numeral w"
+by (rule Reals_numeral [THEN st_SReal_eq])
+
+lemma st_neg_numeral [simp]: "st (neg_numeral w) = neg_numeral w"
+by (rule Reals_neg_numeral [THEN st_SReal_eq])
lemma st_0 [simp]: "st 0 = 0"
by (simp add: st_SReal_eq)
--- a/src/HOL/NSA/NSCA.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/NSA/NSCA.thy Mon Mar 26 15:33:28 2012 +0200
@@ -32,14 +32,14 @@
"hcmod (hcomplex_of_complex r) \<in> Reals"
by (simp add: Reals_eq_Standard)
-lemma SReal_hcmod_number_of [simp]: "hcmod (number_of w ::hcomplex) \<in> Reals"
+lemma SReal_hcmod_numeral [simp]: "hcmod (numeral w ::hcomplex) \<in> Reals"
by (simp add: Reals_eq_Standard)
lemma SReal_hcmod_SComplex: "x \<in> SComplex ==> hcmod x \<in> Reals"
by (simp add: Reals_eq_Standard)
-lemma SComplex_divide_number_of:
- "r \<in> SComplex ==> r/(number_of w::hcomplex) \<in> SComplex"
+lemma SComplex_divide_numeral:
+ "r \<in> SComplex ==> r/(numeral w::hcomplex) \<in> SComplex"
by simp
lemma SComplex_UNIV_complex:
@@ -211,9 +211,9 @@
==> hcomplex_of_complex x \<in> HFinite - Infinitesimal"
by (rule SComplex_HFinite_diff_Infinitesimal, auto)
-lemma number_of_not_Infinitesimal [simp]:
- "number_of w \<noteq> (0::hcomplex) ==> (number_of w::hcomplex) \<notin> Infinitesimal"
-by (fast dest: Standard_number_of [THEN SComplex_Infinitesimal_zero])
+lemma numeral_not_Infinitesimal [simp]:
+ "numeral w \<noteq> (0::hcomplex) ==> (numeral w::hcomplex) \<notin> Infinitesimal"
+by (fast dest: Standard_numeral [THEN SComplex_Infinitesimal_zero])
lemma approx_SComplex_not_zero:
"[| y \<in> SComplex; x @= y; y\<noteq> 0 |] ==> x \<noteq> 0"
@@ -223,11 +223,11 @@
"[|x \<in> SComplex; y \<in> SComplex|] ==> (x @= y) = (x = y)"
by (auto simp add: Standard_def)
-lemma number_of_Infinitesimal_iff [simp]:
- "((number_of w :: hcomplex) \<in> Infinitesimal) =
- (number_of w = (0::hcomplex))"
+lemma numeral_Infinitesimal_iff [simp]:
+ "((numeral w :: hcomplex) \<in> Infinitesimal) =
+ (numeral w = (0::hcomplex))"
apply (rule iffI)
-apply (fast dest: Standard_number_of [THEN SComplex_Infinitesimal_zero])
+apply (fast dest: Standard_numeral [THEN SComplex_Infinitesimal_zero])
apply (simp (no_asm_simp))
done
@@ -441,8 +441,8 @@
"[| x \<in> HFinite; y \<in> HFinite |] ==> stc (x + y) = stc(x) + stc(y)"
by (simp add: stc_unique stc_SComplex stc_approx_self approx_add)
-lemma stc_number_of [simp]: "stc (number_of w) = number_of w"
-by (rule Standard_number_of [THEN stc_SComplex_eq])
+lemma stc_numeral [simp]: "stc (numeral w) = numeral w"
+by (rule Standard_numeral [THEN stc_SComplex_eq])
lemma stc_zero [simp]: "stc 0 = 0"
by simp
--- a/src/HOL/NSA/NSComplex.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/NSA/NSComplex.thy Mon Mar 26 15:33:28 2012 +0200
@@ -626,32 +626,38 @@
subsection{*Numerals and Arithmetic*}
-lemma hcomplex_number_of_def: "(number_of w :: hcomplex) == of_int w"
-by transfer (rule number_of_eq [THEN eq_reflection])
-
lemma hcomplex_of_hypreal_eq_hcomplex_of_complex:
"hcomplex_of_hypreal (hypreal_of_real x) =
hcomplex_of_complex (complex_of_real x)"
by transfer (rule refl)
-lemma hcomplex_hypreal_number_of:
- "hcomplex_of_complex (number_of w) = hcomplex_of_hypreal(number_of w)"
-by transfer (rule of_real_number_of_eq [symmetric])
+lemma hcomplex_hypreal_numeral:
+ "hcomplex_of_complex (numeral w) = hcomplex_of_hypreal(numeral w)"
+by transfer (rule of_real_numeral [symmetric])
-lemma hcomplex_number_of_hcnj [simp]:
- "hcnj (number_of v :: hcomplex) = number_of v"
-by transfer (rule complex_cnj_number_of)
+lemma hcomplex_hypreal_neg_numeral:
+ "hcomplex_of_complex (neg_numeral w) = hcomplex_of_hypreal(neg_numeral w)"
+by transfer (rule of_real_neg_numeral [symmetric])
+
+lemma hcomplex_numeral_hcnj [simp]:
+ "hcnj (numeral v :: hcomplex) = numeral v"
+by transfer (rule complex_cnj_numeral)
-lemma hcomplex_number_of_hcmod [simp]:
- "hcmod(number_of v :: hcomplex) = abs (number_of v :: hypreal)"
-by transfer (rule norm_number_of)
+lemma hcomplex_numeral_hcmod [simp]:
+ "hcmod(numeral v :: hcomplex) = (numeral v :: hypreal)"
+by transfer (rule norm_numeral)
+
+lemma hcomplex_neg_numeral_hcmod [simp]:
+ "hcmod(neg_numeral v :: hcomplex) = (numeral v :: hypreal)"
+by transfer (rule norm_neg_numeral)
-lemma hcomplex_number_of_hRe [simp]:
- "hRe(number_of v :: hcomplex) = number_of v"
-by transfer (rule complex_Re_number_of)
+lemma hcomplex_numeral_hRe [simp]:
+ "hRe(numeral v :: hcomplex) = numeral v"
+by transfer (rule complex_Re_numeral)
-lemma hcomplex_number_of_hIm [simp]:
- "hIm(number_of v :: hcomplex) = 0"
-by transfer (rule complex_Im_number_of)
+lemma hcomplex_numeral_hIm [simp]:
+ "hIm(numeral v :: hcomplex) = 0"
+by transfer (rule complex_Im_numeral)
+(* TODO: add neg_numeral rules above *)
end
--- a/src/HOL/NSA/StarDef.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/NSA/StarDef.thy Mon Mar 26 15:33:28 2012 +0200
@@ -522,16 +522,6 @@
end
-instantiation star :: (number) number
-begin
-
-definition
- star_number_def: "number_of b \<equiv> star_of (number_of b)"
-
-instance ..
-
-end
-
instance star :: (Rings.dvd) Rings.dvd ..
instantiation star :: (Divides.div) Divides.div
@@ -561,7 +551,7 @@
end
lemmas star_class_defs [transfer_unfold] =
- star_zero_def star_one_def star_number_def
+ star_zero_def star_one_def
star_add_def star_diff_def star_minus_def
star_mult_def star_divide_def star_inverse_def
star_le_def star_less_def star_abs_def star_sgn_def
@@ -575,9 +565,6 @@
lemma Standard_one: "1 \<in> Standard"
by (simp add: star_one_def)
-lemma Standard_number_of: "number_of b \<in> Standard"
-by (simp add: star_number_def)
-
lemma Standard_add: "\<lbrakk>x \<in> Standard; y \<in> Standard\<rbrakk> \<Longrightarrow> x + y \<in> Standard"
by (simp add: star_add_def)
@@ -606,7 +593,7 @@
by (simp add: star_mod_def)
lemmas Standard_simps [simp] =
- Standard_zero Standard_one Standard_number_of
+ Standard_zero Standard_one
Standard_add Standard_diff Standard_minus
Standard_mult Standard_divide Standard_inverse
Standard_abs Standard_div Standard_mod
@@ -648,9 +635,6 @@
lemma star_of_one: "star_of 1 = 1"
by transfer (rule refl)
-lemma star_of_number_of: "star_of (number_of x) = number_of x"
-by transfer (rule refl)
-
text {* @{term star_of} preserves orderings *}
lemma star_of_less: "(star_of x < star_of y) = (x < y)"
@@ -682,34 +666,16 @@
lemmas star_of_le_1 = star_of_le [of _ 1, simplified star_of_one]
lemmas star_of_eq_1 = star_of_eq [of _ 1, simplified star_of_one]
-text{*As above, for numerals*}
-
-lemmas star_of_number_less =
- star_of_less [of "number_of w", simplified star_of_number_of] for w
-lemmas star_of_number_le =
- star_of_le [of "number_of w", simplified star_of_number_of] for w
-lemmas star_of_number_eq =
- star_of_eq [of "number_of w", simplified star_of_number_of] for w
-
-lemmas star_of_less_number =
- star_of_less [of _ "number_of w", simplified star_of_number_of] for w
-lemmas star_of_le_number =
- star_of_le [of _ "number_of w", simplified star_of_number_of] for w
-lemmas star_of_eq_number =
- star_of_eq [of _ "number_of w", simplified star_of_number_of] for w
-
lemmas star_of_simps [simp] =
star_of_add star_of_diff star_of_minus
star_of_mult star_of_divide star_of_inverse
star_of_div star_of_mod star_of_abs
- star_of_zero star_of_one star_of_number_of
+ star_of_zero star_of_one
star_of_less star_of_le star_of_eq
star_of_0_less star_of_0_le star_of_0_eq
star_of_less_0 star_of_le_0 star_of_eq_0
star_of_1_less star_of_1_le star_of_1_eq
star_of_less_1 star_of_le_1 star_of_eq_1
- star_of_number_less star_of_number_le star_of_number_eq
- star_of_less_number star_of_le_number star_of_eq_number
subsection {* Ordering and lattice classes *}
@@ -984,9 +950,45 @@
subsection {* Number classes *}
+instance star :: (numeral) numeral ..
+
+lemma star_numeral_def [transfer_unfold]:
+ "numeral k = star_of (numeral k)"
+by (induct k, simp_all only: numeral.simps star_of_one star_of_add)
+
+lemma Standard_numeral [simp]: "numeral k \<in> Standard"
+by (simp add: star_numeral_def)
+
+lemma star_of_numeral [simp]: "star_of (numeral k) = numeral k"
+by transfer (rule refl)
+
+lemma star_neg_numeral_def [transfer_unfold]:
+ "neg_numeral k = star_of (neg_numeral k)"
+by (simp only: neg_numeral_def star_of_minus star_of_numeral)
+
+lemma Standard_neg_numeral [simp]: "neg_numeral k \<in> Standard"
+by (simp add: star_neg_numeral_def)
+
+lemma star_of_neg_numeral [simp]: "star_of (neg_numeral k) = neg_numeral k"
+by transfer (rule refl)
+
lemma star_of_nat_def [transfer_unfold]: "of_nat n = star_of (of_nat n)"
by (induct n, simp_all)
+lemmas star_of_compare_numeral [simp] =
+ star_of_less [of "numeral k", simplified star_of_numeral]
+ star_of_le [of "numeral k", simplified star_of_numeral]
+ star_of_eq [of "numeral k", simplified star_of_numeral]
+ star_of_less [of _ "numeral k", simplified star_of_numeral]
+ star_of_le [of _ "numeral k", simplified star_of_numeral]
+ star_of_eq [of _ "numeral k", simplified star_of_numeral]
+ star_of_less [of "neg_numeral k", simplified star_of_numeral]
+ star_of_le [of "neg_numeral k", simplified star_of_numeral]
+ star_of_eq [of "neg_numeral k", simplified star_of_numeral]
+ star_of_less [of _ "neg_numeral k", simplified star_of_numeral]
+ star_of_le [of _ "neg_numeral k", simplified star_of_numeral]
+ star_of_eq [of _ "neg_numeral k", simplified star_of_numeral] for k
+
lemma Standard_of_nat [simp]: "of_nat n \<in> Standard"
by (simp add: star_of_nat_def)
@@ -1010,11 +1012,6 @@
instance star :: (ring_char_0) ring_char_0 ..
-instance star :: (number_semiring) number_semiring
-by (intro_classes, simp only: star_number_def star_of_nat_def number_of_int)
-
-instance star :: (number_ring) number_ring
-by (intro_classes, simp only: star_number_def star_of_int_def number_of_eq)
subsection {* Finite class *}
--- a/src/HOL/Nat.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Nat.thy Mon Mar 26 15:33:28 2012 +0200
@@ -181,7 +181,7 @@
begin
definition
- One_nat_def [simp, code_post]: "1 = Suc 0"
+ One_nat_def [simp]: "1 = Suc 0"
primrec times_nat where
mult_0: "0 * n = (0\<Colon>nat)"
@@ -1782,4 +1782,6 @@
code_modulename Haskell
Nat Arith
+hide_const (open) of_nat_aux
+
end
--- a/src/HOL/Nat_Numeral.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Nat_Numeral.thy Mon Mar 26 15:33:28 2012 +0200
@@ -15,31 +15,13 @@
Arithmetic for naturals is reduced to that for the non-negative integers.
*}
-instantiation nat :: number_semiring
-begin
-
-definition
- nat_number_of_def [code_unfold, code del]: "number_of v = nat (number_of v)"
-
-instance proof
- fix n show "number_of (int n) = (of_nat n :: nat)"
- unfolding nat_number_of_def number_of_eq by simp
-qed
-
-end
-
-lemma [code_post]:
- "nat (number_of v) = number_of v"
- unfolding nat_number_of_def ..
-
-
subsection {* Special case: squares and cubes *}
lemma numeral_2_eq_2: "2 = Suc (Suc 0)"
- by (simp add: nat_number_of_def)
+ by (simp add: nat_number(2-4))
lemma numeral_3_eq_3: "3 = Suc (Suc (Suc 0))"
- by (simp add: nat_number_of_def)
+ by (simp add: nat_number(2-4))
context power
begin
@@ -93,26 +75,21 @@
"(- a)\<twosuperior> = a\<twosuperior>"
by (simp add: power2_eq_square)
-text{*
- We cannot prove general results about the numeral @{term "-1"},
- so we have to use @{term "- 1"} instead.
-*}
-
lemma power_minus1_even [simp]:
- "(- 1) ^ (2*n) = 1"
+ "-1 ^ (2*n) = 1"
proof (induct n)
case 0 show ?case by simp
next
- case (Suc n) then show ?case by (simp add: power_add)
+ case (Suc n) then show ?case by (simp add: power_add power2_eq_square)
qed
lemma power_minus1_odd:
- "(- 1) ^ Suc (2*n) = - 1"
+ "-1 ^ Suc (2*n) = -1"
by simp
lemma power_minus_even [simp]:
"(-a) ^ (2*n) = a ^ (2*n)"
- by (simp add: power_minus [of a])
+ by (simp add: power_minus [of a])
end
@@ -261,100 +238,31 @@
end
lemma power2_sum:
- fixes x y :: "'a::number_semiring"
+ fixes x y :: "'a::comm_semiring_1"
shows "(x + y)\<twosuperior> = x\<twosuperior> + y\<twosuperior> + 2 * x * y"
- by (simp add: algebra_simps power2_eq_square semiring_mult_2_right)
+ by (simp add: algebra_simps power2_eq_square mult_2_right)
lemma power2_diff:
- fixes x y :: "'a::number_ring"
+ fixes x y :: "'a::comm_ring_1"
shows "(x - y)\<twosuperior> = x\<twosuperior> + y\<twosuperior> - 2 * x * y"
by (simp add: ring_distribs power2_eq_square mult_2) (rule mult_commute)
-subsection {* Predicate for negative binary numbers *}
-
-definition neg :: "int \<Rightarrow> bool" where
- "neg Z \<longleftrightarrow> Z < 0"
-
-lemma not_neg_int [simp]: "~ neg (of_nat n)"
-by (simp add: neg_def)
-
-lemma neg_zminus_int [simp]: "neg (- (of_nat (Suc n)))"
-by (simp add: neg_def del: of_nat_Suc)
-
-lemmas neg_eq_less_0 = neg_def
-
-lemma not_neg_eq_ge_0: "(~neg x) = (0 \<le> x)"
-by (simp add: neg_def linorder_not_less)
-
-text{*To simplify inequalities when Numeral1 can get simplified to 1*}
-
-lemma not_neg_0: "~ neg 0"
-by (simp add: One_int_def neg_def)
-
-lemma not_neg_1: "~ neg 1"
-by (simp add: neg_def linorder_not_less)
-
-lemma neg_nat: "neg z ==> nat z = 0"
-by (simp add: neg_def order_less_imp_le)
-
-lemma not_neg_nat: "~ neg z ==> of_nat (nat z) = z"
-by (simp add: linorder_not_less neg_def)
-
-text {*
- If @{term Numeral0} is rewritten to 0 then this rule can't be applied:
- @{term Numeral0} IS @{term "number_of Pls"}
-*}
-
-lemma not_neg_number_of_Pls: "~ neg (number_of Int.Pls)"
- by (simp add: neg_def)
-
-lemma neg_number_of_Min: "neg (number_of Int.Min)"
- by (simp add: neg_def)
-
-lemma neg_number_of_Bit0:
- "neg (number_of (Int.Bit0 w)) = neg (number_of w)"
- by (simp add: neg_def)
-
-lemma neg_number_of_Bit1:
- "neg (number_of (Int.Bit1 w)) = neg (number_of w)"
- by (simp add: neg_def)
-
-lemmas neg_simps [simp] =
- not_neg_0 not_neg_1
- not_neg_number_of_Pls neg_number_of_Min
- neg_number_of_Bit0 neg_number_of_Bit1
-
-
subsection{*Function @{term nat}: Coercion from Type @{typ int} to @{typ nat}*}
declare nat_1 [simp]
-lemma nat_number_of [simp]: "nat (number_of w) = number_of w"
- by (simp add: nat_number_of_def)
-
-lemma nat_numeral_0_eq_0: "Numeral0 = (0::nat)" (* FIXME delete candidate *)
- by (fact semiring_numeral_0_eq_0)
-
-lemma nat_numeral_1_eq_1: "Numeral1 = (1::nat)" (* FIXME delete candidate *)
- by (fact semiring_numeral_1_eq_1)
-
-lemma Numeral1_eq1_nat:
- "(1::nat) = Numeral1"
+lemma nat_neg_numeral [simp]: "nat (neg_numeral w) = 0"
by simp
lemma numeral_1_eq_Suc_0: "Numeral1 = Suc 0"
- by (simp only: nat_numeral_1_eq_1 One_nat_def)
+ by simp
subsection{*Function @{term int}: Coercion from Type @{typ nat} to @{typ int}*}
-lemma int_nat_number_of [simp]:
- "int (number_of v) =
- (if neg (number_of v :: int) then 0
- else (number_of v :: int))"
- unfolding nat_number_of_def number_of_is_id neg_def
- by simp (* FIXME: redundant with of_nat_number_of_eq *)
+lemma int_numeral: "int (numeral v) = numeral v"
+ by (rule of_nat_numeral) (* already simp *)
lemma nonneg_int_cases:
fixes k :: int assumes "0 \<le> k" obtains n where "k = of_nat n"
@@ -368,149 +276,51 @@
done
lemma Suc_nat_number_of_add:
- "Suc (number_of v + n) =
- (if neg (number_of v :: int) then 1+n else number_of (Int.succ v) + n)"
- unfolding nat_number_of_def number_of_is_id neg_def numeral_simps
- by (simp add: Suc_nat_eq_nat_zadd1 add_ac)
-
-lemma Suc_nat_number_of [simp]:
- "Suc (number_of v) =
- (if neg (number_of v :: int) then 1 else number_of (Int.succ v))"
-apply (cut_tac n = 0 in Suc_nat_number_of_add)
-apply (simp cong del: if_weak_cong)
-done
-
-
-subsubsection{*Addition *}
-
-lemma add_nat_number_of [simp]:
- "(number_of v :: nat) + number_of v' =
- (if v < Int.Pls then number_of v'
- else if v' < Int.Pls then number_of v
- else number_of (v + v'))"
- unfolding nat_number_of_def number_of_is_id numeral_simps
- by (simp add: nat_add_distrib)
-
-lemma nat_number_of_add_1 [simp]:
- "number_of v + (1::nat) =
- (if v < Int.Pls then 1 else number_of (Int.succ v))"
- unfolding nat_number_of_def number_of_is_id numeral_simps
- by (simp add: nat_add_distrib)
+ "Suc (numeral v + n) = numeral (v + Num.One) + n"
+ by simp
-lemma nat_1_add_number_of [simp]:
- "(1::nat) + number_of v =
- (if v < Int.Pls then 1 else number_of (Int.succ v))"
- unfolding nat_number_of_def number_of_is_id numeral_simps
- by (simp add: nat_add_distrib)
-
-lemma nat_1_add_1 [simp]: "1 + 1 = (2::nat)"
- by (rule semiring_one_add_one_is_two)
-
-text {* TODO: replace simp rules above with these generic ones: *}
-
-lemma semiring_add_number_of:
- "\<lbrakk>Int.Pls \<le> v; Int.Pls \<le> v'\<rbrakk> \<Longrightarrow>
- (number_of v :: 'a::number_semiring) + number_of v' = number_of (v + v')"
- unfolding Int.Pls_def
- by (elim nonneg_int_cases,
- simp only: number_of_int of_nat_add [symmetric])
-
-lemma semiring_number_of_add_1:
- "Int.Pls \<le> v \<Longrightarrow>
- number_of v + (1::'a::number_semiring) = number_of (Int.succ v)"
- unfolding Int.Pls_def Int.succ_def
- by (elim nonneg_int_cases,
- simp only: number_of_int add_commute [where b=1] of_nat_Suc [symmetric])
-
-lemma semiring_1_add_number_of:
- "Int.Pls \<le> v \<Longrightarrow>
- (1::'a::number_semiring) + number_of v = number_of (Int.succ v)"
- unfolding Int.Pls_def Int.succ_def
- by (elim nonneg_int_cases,
- simp only: number_of_int add_commute [where b=1] of_nat_Suc [symmetric])
+lemma Suc_numeral [simp]:
+ "Suc (numeral v) = numeral (v + Num.One)"
+ by simp
subsubsection{*Subtraction *}
lemma diff_nat_eq_if:
"nat z - nat z' =
- (if neg z' then nat z
+ (if z' < 0 then nat z
else let d = z-z' in
- if neg d then 0 else nat d)"
-by (simp add: Let_def nat_diff_distrib [symmetric] neg_eq_less_0 not_neg_eq_ge_0)
-
-
-lemma diff_nat_number_of [simp]:
- "(number_of v :: nat) - number_of v' =
- (if v' < Int.Pls then number_of v
- else let d = number_of (v + uminus v') in
- if neg d then 0 else nat d)"
- unfolding nat_number_of_def number_of_is_id numeral_simps neg_def
- by auto
+ if d < 0 then 0 else nat d)"
+by (simp add: Let_def nat_diff_distrib [symmetric])
-lemma nat_number_of_diff_1 [simp]:
- "number_of v - (1::nat) =
- (if v \<le> Int.Pls then 0 else number_of (Int.pred v))"
- unfolding nat_number_of_def number_of_is_id numeral_simps
- by auto
-
-
-subsubsection{*Multiplication *}
+(* Int.nat_diff_distrib has too-strong premises *)
+lemma nat_diff_distrib': "\<lbrakk>0 \<le> x; 0 \<le> y\<rbrakk> \<Longrightarrow> nat (x - y) = nat x - nat y"
+apply (rule int_int_eq [THEN iffD1], clarsimp)
+apply (subst zdiff_int [symmetric])
+apply (rule nat_mono, simp_all)
+done
-lemma mult_nat_number_of [simp]:
- "(number_of v :: nat) * number_of v' =
- (if v < Int.Pls then 0 else number_of (v * v'))"
- unfolding nat_number_of_def number_of_is_id numeral_simps
- by (simp add: nat_mult_distrib)
+lemma diff_nat_numeral [simp]:
+ "(numeral v :: nat) - numeral v' = nat (numeral v - numeral v')"
+ by (simp only: nat_diff_distrib' zero_le_numeral nat_numeral)
-(* TODO: replace mult_nat_number_of with this next rule *)
-lemma semiring_mult_number_of:
- "\<lbrakk>Int.Pls \<le> v; Int.Pls \<le> v'\<rbrakk> \<Longrightarrow>
- (number_of v :: 'a::number_semiring) * number_of v' = number_of (v * v')"
- unfolding Int.Pls_def
- by (elim nonneg_int_cases,
- simp only: number_of_int of_nat_mult [symmetric])
+lemma nat_numeral_diff_1 [simp]:
+ "numeral v - (1::nat) = nat (numeral v - 1)"
+ using diff_nat_numeral [of v Num.One] by simp
subsection{*Comparisons*}
-subsubsection{*Equals (=) *}
-
-lemma eq_nat_number_of [simp]:
- "((number_of v :: nat) = number_of v') =
- (if neg (number_of v :: int) then (number_of v' :: int) \<le> 0
- else if neg (number_of v' :: int) then (number_of v :: int) = 0
- else v = v')"
- unfolding nat_number_of_def number_of_is_id neg_def
- by auto
-
-
-subsubsection{*Less-than (<) *}
-
-lemma less_nat_number_of [simp]:
- "(number_of v :: nat) < number_of v' \<longleftrightarrow>
- (if v < v' then Int.Pls < v' else False)"
- unfolding nat_number_of_def number_of_is_id numeral_simps
- by auto
-
-
-subsubsection{*Less-than-or-equal *}
-
-lemma le_nat_number_of [simp]:
- "(number_of v :: nat) \<le> number_of v' \<longleftrightarrow>
- (if v \<le> v' then True else v \<le> Int.Pls)"
- unfolding nat_number_of_def number_of_is_id numeral_simps
- by auto
-
-(*Maps #n to n for n = 0, 1, 2*)
-lemmas numerals = nat_numeral_0_eq_0 nat_numeral_1_eq_1 numeral_2_eq_2
+(*Maps #n to n for n = 1, 2*)
+lemmas numerals = numeral_1_eq_1 [where 'a=nat] numeral_2_eq_2
subsection{*Powers with Numeric Exponents*}
text{*Squares of literal numerals will be evaluated.*}
-lemmas power2_eq_square_number_of [simp] =
- power2_eq_square [of "number_of w"] for w
+(* FIXME: replace with more general rules for powers of numerals *)
+lemmas power2_eq_square_numeral [simp] =
+ power2_eq_square [of "numeral w"] for w
text{*Simprules for comparisons where common factors can be cancelled.*}
@@ -528,8 +338,8 @@
by simp
(*Expresses a natural number constant as the Suc of another one.
- NOT suitable for rewriting because n recurs in the condition.*)
-lemmas expand_Suc = Suc_pred' [of "number_of v"] for v
+ NOT suitable for rewriting because n recurs on the right-hand side.*)
+lemmas expand_Suc = Suc_pred' [of "numeral v", OF zero_less_numeral] for v
subsubsection{*Arith *}
@@ -539,7 +349,7 @@
lemma Suc_eq_plus1_left: "Suc n = 1 + n"
unfolding One_nat_def by simp
-(* These two can be useful when m = number_of... *)
+(* These two can be useful when m = numeral... *)
lemma add_eq_if: "(m::nat) + n = (if m=0 then n else Suc ((m - 1) + n))"
unfolding One_nat_def by (cases m) simp_all
@@ -551,231 +361,108 @@
unfolding One_nat_def by (cases m) simp_all
-subsection{*Comparisons involving (0::nat) *}
-
-text{*Simplification already does @{term "n<0"}, @{term "n\<le>0"} and @{term "0\<le>n"}.*}
-
-lemma eq_number_of_0 [simp]:
- "number_of v = (0::nat) \<longleftrightarrow> v \<le> Int.Pls"
- unfolding nat_number_of_def number_of_is_id numeral_simps
- by auto
-
-lemma eq_0_number_of [simp]:
- "(0::nat) = number_of v \<longleftrightarrow> v \<le> Int.Pls"
-by (rule trans [OF eq_sym_conv eq_number_of_0])
-
-lemma less_0_number_of [simp]:
- "(0::nat) < number_of v \<longleftrightarrow> Int.Pls < v"
- unfolding nat_number_of_def number_of_is_id numeral_simps
- by simp
-
-lemma neg_imp_number_of_eq_0: "neg (number_of v :: int) ==> number_of v = (0::nat)"
- by (simp del: semiring_numeral_0_eq_0 add: nat_numeral_0_eq_0 [symmetric])
-
-
subsection{*Comparisons involving @{term Suc} *}
-lemma eq_number_of_Suc [simp]:
- "(number_of v = Suc n) =
- (let pv = number_of (Int.pred v) in
- if neg pv then False else nat pv = n)"
-apply (simp only: simp_thms Let_def neg_eq_less_0 linorder_not_less
- number_of_pred nat_number_of_def
- split add: split_if)
-apply (rule_tac x = "number_of v" in spec)
-apply (auto simp add: nat_eq_iff)
-done
+lemma eq_numeral_Suc [simp]: "numeral v = Suc n \<longleftrightarrow> nat (numeral v - 1) = n"
+ by (subst expand_Suc, simp only: nat.inject nat_numeral_diff_1)
-lemma Suc_eq_number_of [simp]:
- "(Suc n = number_of v) =
- (let pv = number_of (Int.pred v) in
- if neg pv then False else nat pv = n)"
-by (rule trans [OF eq_sym_conv eq_number_of_Suc])
+lemma Suc_eq_numeral [simp]: "Suc n = numeral v \<longleftrightarrow> n = nat (numeral v - 1)"
+ by (subst expand_Suc, simp only: nat.inject nat_numeral_diff_1)
-lemma less_number_of_Suc [simp]:
- "(number_of v < Suc n) =
- (let pv = number_of (Int.pred v) in
- if neg pv then True else nat pv < n)"
-apply (simp only: simp_thms Let_def neg_eq_less_0 linorder_not_less
- number_of_pred nat_number_of_def
- split add: split_if)
-apply (rule_tac x = "number_of v" in spec)
-apply (auto simp add: nat_less_iff)
-done
+lemma less_numeral_Suc [simp]: "numeral v < Suc n \<longleftrightarrow> nat (numeral v - 1) < n"
+ by (subst expand_Suc, simp only: Suc_less_eq nat_numeral_diff_1)
-lemma less_Suc_number_of [simp]:
- "(Suc n < number_of v) =
- (let pv = number_of (Int.pred v) in
- if neg pv then False else n < nat pv)"
-apply (simp only: simp_thms Let_def neg_eq_less_0 linorder_not_less
- number_of_pred nat_number_of_def
- split add: split_if)
-apply (rule_tac x = "number_of v" in spec)
-apply (auto simp add: zless_nat_eq_int_zless)
-done
+lemma less_Suc_numeral [simp]: "Suc n < numeral v \<longleftrightarrow> n < nat (numeral v - 1)"
+ by (subst expand_Suc, simp only: Suc_less_eq nat_numeral_diff_1)
-lemma le_number_of_Suc [simp]:
- "(number_of v <= Suc n) =
- (let pv = number_of (Int.pred v) in
- if neg pv then True else nat pv <= n)"
-by (simp add: Let_def linorder_not_less [symmetric])
+lemma le_numeral_Suc [simp]: "numeral v \<le> Suc n \<longleftrightarrow> nat (numeral v - 1) \<le> n"
+ by (subst expand_Suc, simp only: Suc_le_mono nat_numeral_diff_1)
-lemma le_Suc_number_of [simp]:
- "(Suc n <= number_of v) =
- (let pv = number_of (Int.pred v) in
- if neg pv then False else n <= nat pv)"
-by (simp add: Let_def linorder_not_less [symmetric])
-
-
-lemma eq_number_of_Pls_Min: "(Numeral0 ::int) ~= number_of Int.Min"
-by auto
-
+lemma le_Suc_numeral [simp]: "Suc n \<le> numeral v \<longleftrightarrow> n \<le> nat (numeral v - 1)"
+ by (subst expand_Suc, simp only: Suc_le_mono nat_numeral_diff_1)
subsection{*Max and Min Combined with @{term Suc} *}
-lemma max_number_of_Suc [simp]:
- "max (Suc n) (number_of v) =
- (let pv = number_of (Int.pred v) in
- if neg pv then Suc n else Suc(max n (nat pv)))"
-apply (simp only: Let_def neg_eq_less_0 number_of_pred nat_number_of_def
- split add: split_if nat.split)
-apply (rule_tac x = "number_of v" in spec)
-apply auto
-done
-
-lemma max_Suc_number_of [simp]:
- "max (number_of v) (Suc n) =
- (let pv = number_of (Int.pred v) in
- if neg pv then Suc n else Suc(max (nat pv) n))"
-apply (simp only: Let_def neg_eq_less_0 number_of_pred nat_number_of_def
- split add: split_if nat.split)
-apply (rule_tac x = "number_of v" in spec)
-apply auto
-done
-
-lemma min_number_of_Suc [simp]:
- "min (Suc n) (number_of v) =
- (let pv = number_of (Int.pred v) in
- if neg pv then 0 else Suc(min n (nat pv)))"
-apply (simp only: Let_def neg_eq_less_0 number_of_pred nat_number_of_def
- split add: split_if nat.split)
-apply (rule_tac x = "number_of v" in spec)
-apply auto
-done
-
-lemma min_Suc_number_of [simp]:
- "min (number_of v) (Suc n) =
- (let pv = number_of (Int.pred v) in
- if neg pv then 0 else Suc(min (nat pv) n))"
-apply (simp only: Let_def neg_eq_less_0 number_of_pred nat_number_of_def
- split add: split_if nat.split)
-apply (rule_tac x = "number_of v" in spec)
-apply auto
-done
+lemma max_Suc_numeral [simp]:
+ "max (Suc n) (numeral v) = Suc (max n (nat (numeral v - 1)))"
+ by (subst expand_Suc, simp only: max_Suc_Suc nat_numeral_diff_1)
+
+lemma max_numeral_Suc [simp]:
+ "max (numeral v) (Suc n) = Suc (max (nat (numeral v - 1)) n)"
+ by (subst expand_Suc, simp only: max_Suc_Suc nat_numeral_diff_1)
+
+lemma min_Suc_numeral [simp]:
+ "min (Suc n) (numeral v) = Suc (min n (nat (numeral v - 1)))"
+ by (subst expand_Suc, simp only: min_Suc_Suc nat_numeral_diff_1)
+
+lemma min_numeral_Suc [simp]:
+ "min (numeral v) (Suc n) = Suc (min (nat (numeral v - 1)) n)"
+ by (subst expand_Suc, simp only: min_Suc_Suc nat_numeral_diff_1)
subsection{*Literal arithmetic involving powers*}
-lemma power_nat_number_of:
- "(number_of v :: nat) ^ n =
- (if neg (number_of v :: int) then 0^n else nat ((number_of v :: int) ^ n))"
-by (simp only: simp_thms neg_nat not_neg_eq_ge_0 nat_number_of_def nat_power_eq
- split add: split_if cong: imp_cong)
+(* TODO: replace with more generic rule for powers of numerals *)
+lemma power_nat_numeral:
+ "(numeral v :: nat) ^ n = nat ((numeral v :: int) ^ n)"
+ by (simp only: nat_power_eq zero_le_numeral nat_numeral)
-
-lemmas power_nat_number_of_number_of = power_nat_number_of [of _ "number_of w"] for w
-declare power_nat_number_of_number_of [simp]
-
+lemmas power_nat_numeral_numeral = power_nat_numeral [of _ "numeral w"] for w
+declare power_nat_numeral_numeral [simp]
text{*For arbitrary rings*}
-lemma power_number_of_even:
+lemma power_numeral_even:
fixes z :: "'a::monoid_mult"
- shows "z ^ number_of (Int.Bit0 w) = (let w = z ^ (number_of w) in w * w)"
-by (cases "w \<ge> 0") (auto simp add: Let_def Bit0_def nat_number_of_def number_of_is_id
- nat_add_distrib power_add simp del: nat_number_of)
+ shows "z ^ numeral (Num.Bit0 w) = (let w = z ^ (numeral w) in w * w)"
+ unfolding numeral_Bit0 power_add Let_def ..
-lemma power_number_of_odd:
+lemma power_numeral_odd:
fixes z :: "'a::monoid_mult"
- shows "z ^ number_of (Int.Bit1 w) = (if (0::int) <= number_of w
- then (let w = z ^ (number_of w) in z * w * w) else 1)"
-unfolding Let_def Bit1_def nat_number_of_def number_of_is_id
-apply (cases "0 <= w")
-apply (simp only: mult_assoc nat_add_distrib power_add, simp)
-apply (simp add: not_le mult_2 [symmetric] add_assoc)
-done
+ shows "z ^ numeral (Num.Bit1 w) = (let w = z ^ (numeral w) in z * w * w)"
+ unfolding numeral_Bit1 One_nat_def add_Suc_right add_0_right
+ unfolding power_Suc power_add Let_def mult_assoc ..
-lemmas zpower_number_of_even = power_number_of_even [where 'a=int]
-lemmas zpower_number_of_odd = power_number_of_odd [where 'a=int]
-
-lemmas power_number_of_even_number_of [simp] =
- power_number_of_even [of "number_of v"] for v
+lemmas zpower_numeral_even = power_numeral_even [where 'a=int]
+lemmas zpower_numeral_odd = power_numeral_odd [where 'a=int]
-lemmas power_number_of_odd_number_of [simp] =
- power_number_of_odd [of "number_of v"] for v
+lemmas power_numeral_even_numeral [simp] =
+ power_numeral_even [of "numeral v"] for v
-lemma nat_number_of_Pls: "Numeral0 = (0::nat)"
- by (simp add: nat_number_of_def)
-
-lemma nat_number_of_Min [no_atp]: "number_of Int.Min = (0::nat)"
- apply (simp only: number_of_Min nat_number_of_def nat_zminus_int)
- done
+lemmas power_numeral_odd_numeral [simp] =
+ power_numeral_odd [of "numeral v"] for v
-lemma nat_number_of_Bit0:
- "number_of (Int.Bit0 w) = (let n::nat = number_of w in n + n)"
-by (cases "w \<ge> 0") (auto simp add: Let_def Bit0_def nat_number_of_def number_of_is_id
- nat_add_distrib simp del: nat_number_of)
+lemma nat_numeral_Bit0:
+ "numeral (Num.Bit0 w) = (let n::nat = numeral w in n + n)"
+ unfolding numeral_Bit0 Let_def ..
-lemma nat_number_of_Bit1:
- "number_of (Int.Bit1 w) =
- (if neg (number_of w :: int) then 0
- else let n = number_of w in Suc (n + n))"
-unfolding Let_def Bit1_def nat_number_of_def number_of_is_id neg_def
-apply (cases "w < 0")
-apply (simp add: mult_2 [symmetric] add_assoc)
-apply (simp only: nat_add_distrib, simp)
-done
+lemma nat_numeral_Bit1:
+ "numeral (Num.Bit1 w) = (let n = numeral w in Suc (n + n))"
+ unfolding numeral_Bit1 Let_def by simp
lemmas eval_nat_numeral =
- nat_number_of_Bit0 nat_number_of_Bit1
+ nat_numeral_Bit0 nat_numeral_Bit1
lemmas nat_arith =
- add_nat_number_of
- diff_nat_number_of
- mult_nat_number_of
- eq_nat_number_of
- less_nat_number_of
+ diff_nat_numeral
lemmas semiring_norm =
- Let_def arith_simps nat_arith rel_simps neg_simps if_False
- if_True add_0 add_Suc add_number_of_left mult_number_of_left
+ Let_def arith_simps nat_arith rel_simps
+ if_False if_True
+ add_0 add_Suc add_numeral_left
+ add_neg_numeral_left mult_numeral_left
numeral_1_eq_1 [symmetric] Suc_eq_plus1
- numeral_0_eq_0 [symmetric] numerals [symmetric]
- not_iszero_Numeral1
+ eq_numeral_iff_iszero not_iszero_Numeral1
lemma Let_Suc [simp]: "Let (Suc n) f == f (Suc n)"
by (fact Let_def)
-lemma power_m1_even: "(-1) ^ (2*n) = (1::'a::{number_ring})"
- by (simp only: number_of_Min power_minus1_even)
-
-lemma power_m1_odd: "(-1) ^ Suc(2*n) = (-1::'a::{number_ring})"
- by (simp only: number_of_Min power_minus1_odd)
+lemma power_m1_even: "(-1) ^ (2*n) = (1::'a::ring_1)"
+ by (fact power_minus1_even) (* FIXME: duplicate *)
-lemma nat_number_of_add_left:
- "number_of v + (number_of v' + (k::nat)) =
- (if neg (number_of v :: int) then number_of v' + k
- else if neg (number_of v' :: int) then number_of v + k
- else number_of (v + v') + k)"
-by (auto simp add: neg_def)
-
-lemma nat_number_of_mult_left:
- "number_of v * (number_of v' * (k::nat)) =
- (if v < Int.Pls then 0
- else number_of (v * v') * k)"
-by (auto simp add: not_less Pls_def nat_number_of_def number_of_is_id
- nat_mult_distrib simp del: nat_number_of)
+lemma power_m1_odd: "(-1) ^ Suc(2*n) = (-1::'a::ring_1)"
+ by (fact power_minus1_odd) (* FIXME: duplicate *)
subsection{*Literal arithmetic and @{term of_nat}*}
@@ -784,52 +471,18 @@
"0 \<le> x ==> of_nat (nat (2 * x)) = of_nat (nat x) + of_nat (nat x)"
by (simp only: mult_2 nat_add_distrib of_nat_add)
-lemma nat_numeral_m1_eq_0: "-1 = (0::nat)"
-by (simp only: nat_number_of_def)
-
-lemma of_nat_number_of_lemma:
- "of_nat (number_of v :: nat) =
- (if 0 \<le> (number_of v :: int)
- then (number_of v :: 'a :: number_semiring)
- else 0)"
- by (auto simp add: int_number_of_def nat_number_of_def number_of_int
- elim!: nonneg_int_cases)
-
-lemma of_nat_number_of_eq [simp]:
- "of_nat (number_of v :: nat) =
- (if neg (number_of v :: int) then 0
- else (number_of v :: 'a :: number_semiring))"
- by (simp only: of_nat_number_of_lemma neg_def, simp)
-
subsubsection{*For simplifying @{term "Suc m - K"} and @{term "K - Suc m"}*}
text{*Where K above is a literal*}
-lemma Suc_diff_eq_diff_pred: "Numeral0 < n ==> Suc m - n = m - (n - Numeral1)"
+lemma Suc_diff_eq_diff_pred: "0 < n ==> Suc m - n = m - (n - Numeral1)"
by (simp split: nat_diff_split)
-text {*Now just instantiating @{text n} to @{text "number_of v"} does
- the right simplification, but with some redundant inequality
- tests.*}
-lemma neg_number_of_pred_iff_0:
- "neg (number_of (Int.pred v)::int) = (number_of v = (0::nat))"
-apply (subgoal_tac "neg (number_of (Int.pred v)) = (number_of v < Suc 0) ")
-apply (simp only: less_Suc_eq_le le_0_eq)
-apply (subst less_number_of_Suc, simp)
-done
-
text{*No longer required as a simprule because of the @{text inverse_fold}
simproc*}
-lemma Suc_diff_number_of:
- "Int.Pls < v ==>
- Suc m - (number_of v) = m - (number_of (Int.pred v))"
-apply (subst Suc_diff_eq_diff_pred)
-apply simp
-apply (simp del: semiring_numeral_1_eq_1)
-apply (auto simp only: diff_nat_number_of less_0_number_of [symmetric]
- neg_number_of_pred_iff_0)
-done
+lemma Suc_diff_numeral: "Suc m - (numeral v) = m - (numeral v - 1)"
+ by (subst expand_Suc, simp only: diff_Suc_Suc)
lemma diff_Suc_eq_diff_pred: "m - Suc n = (m - 1) - n"
by (simp split: nat_diff_split)
@@ -837,45 +490,22 @@
subsubsection{*For @{term nat_case} and @{term nat_rec}*}
-lemma nat_case_number_of [simp]:
- "nat_case a f (number_of v) =
- (let pv = number_of (Int.pred v) in
- if neg pv then a else f (nat pv))"
-by (simp split add: nat.split add: Let_def neg_number_of_pred_iff_0)
+lemma nat_case_numeral [simp]:
+ "nat_case a f (numeral v) = (let pv = nat (numeral v - 1) in f pv)"
+ by (subst expand_Suc, simp only: nat.cases nat_numeral_diff_1 Let_def)
lemma nat_case_add_eq_if [simp]:
- "nat_case a f ((number_of v) + n) =
- (let pv = number_of (Int.pred v) in
- if neg pv then nat_case a f n else f (nat pv + n))"
-apply (subst add_eq_if)
-apply (simp split add: nat.split
- del: semiring_numeral_1_eq_1
- add: semiring_numeral_1_eq_1 [symmetric]
- numeral_1_eq_Suc_0 [symmetric]
- neg_number_of_pred_iff_0)
-done
+ "nat_case a f ((numeral v) + n) = (let pv = nat (numeral v - 1) in f (pv + n))"
+ by (subst expand_Suc, simp only: nat.cases nat_numeral_diff_1 Let_def add_Suc)
-lemma nat_rec_number_of [simp]:
- "nat_rec a f (number_of v) =
- (let pv = number_of (Int.pred v) in
- if neg pv then a else f (nat pv) (nat_rec a f (nat pv)))"
-apply (case_tac " (number_of v) ::nat")
-apply (simp_all (no_asm_simp) add: Let_def neg_number_of_pred_iff_0)
-apply (simp split add: split_if_asm)
-done
+lemma nat_rec_numeral [simp]:
+ "nat_rec a f (numeral v) = (let pv = nat (numeral v - 1) in f pv (nat_rec a f pv))"
+ by (subst expand_Suc, simp only: nat_rec_Suc nat_numeral_diff_1 Let_def)
lemma nat_rec_add_eq_if [simp]:
- "nat_rec a f (number_of v + n) =
- (let pv = number_of (Int.pred v) in
- if neg pv then nat_rec a f n
- else f (nat pv + n) (nat_rec a f (nat pv + n)))"
-apply (subst add_eq_if)
-apply (simp split add: nat.split
- del: semiring_numeral_1_eq_1
- add: semiring_numeral_1_eq_1 [symmetric]
- numeral_1_eq_Suc_0 [symmetric]
- neg_number_of_pred_iff_0)
-done
+ "nat_rec a f (numeral v + n) =
+ (let pv = nat (numeral v - 1) in f (pv + n) (nat_rec a f (pv + n)))"
+ by (subst expand_Suc, simp only: nat_rec_Suc nat_numeral_diff_1 Let_def add_Suc)
subsubsection{*Various Other Lemmas*}
@@ -887,14 +517,14 @@
text{*Lemmas for specialist use, NOT as default simprules*}
lemma nat_mult_2: "2 * z = (z+z::nat)"
-by (rule semiring_mult_2)
+by (rule mult_2) (* FIXME: duplicate *)
lemma nat_mult_2_right: "z * 2 = (z+z::nat)"
-by (rule semiring_mult_2_right)
+by (rule mult_2_right) (* FIXME: duplicate *)
text{*Case analysis on @{term "n<2"}*}
lemma less_2_cases: "(n::nat) < 2 ==> n = 0 | n = Suc 0"
-by (auto simp add: nat_1_add_1 [symmetric])
+by (auto simp add: numeral_2_eq_2)
text{*Removal of Small Numerals: 0, 1 and (in additive positions) 2*}
@@ -908,4 +538,8 @@
lemma Suc3_eq_add_3: "Suc (Suc (Suc n)) = 3 + n"
by simp
+text{*Legacy theorems*}
+
+lemmas nat_1_add_1 = one_add_one [where 'a=nat]
+
end
--- a/src/HOL/Nominal/Nominal.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Nominal/Nominal.thy Mon Mar 26 15:33:28 2012 +0200
@@ -3481,7 +3481,7 @@
by (auto simp add: perm_nat_def)
lemma numeral_nat_eqvt:
- shows "pi\<bullet>((number_of n)::nat) = number_of n"
+ shows "pi\<bullet>((numeral n)::nat) = numeral n"
by (simp add: perm_nat_def perm_int_def)
lemma max_nat_eqvt:
@@ -3523,7 +3523,11 @@
by (simp add: perm_int_def)
lemma numeral_int_eqvt:
- shows "pi\<bullet>((number_of n)::int) = number_of n"
+ shows "pi\<bullet>((numeral n)::int) = numeral n"
+by (simp add: perm_int_def perm_int_def)
+
+lemma neg_numeral_int_eqvt:
+ shows "pi\<bullet>((neg_numeral n)::int) = neg_numeral n"
by (simp add: perm_int_def perm_int_def)
lemma max_int_eqvt:
@@ -3589,7 +3593,7 @@
(* the lemmas numeral_nat_eqvt numeral_int_eqvt do not conform with the *)
(* usual form of an eqvt-lemma, but they are needed for analysing *)
(* permutations on nats and ints *)
-lemmas [eqvt_force] = numeral_nat_eqvt numeral_int_eqvt
+lemmas [eqvt_force] = numeral_nat_eqvt numeral_int_eqvt neg_numeral_int_eqvt
(***************************************)
(* setup for the individial atom-kinds *)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Num.thy Mon Mar 26 15:33:28 2012 +0200
@@ -0,0 +1,1021 @@
+(* Title: HOL/Num.thy
+ Author: Florian Haftmann
+ Author: Brian Huffman
+*)
+
+header {* Binary Numerals *}
+
+theory Num
+imports Datatype Power
+begin
+
+subsection {* The @{text num} type *}
+
+datatype num = One | Bit0 num | Bit1 num
+
+text {* Increment function for type @{typ num} *}
+
+primrec inc :: "num \<Rightarrow> num" where
+ "inc One = Bit0 One" |
+ "inc (Bit0 x) = Bit1 x" |
+ "inc (Bit1 x) = Bit0 (inc x)"
+
+text {* Converting between type @{typ num} and type @{typ nat} *}
+
+primrec nat_of_num :: "num \<Rightarrow> nat" where
+ "nat_of_num One = Suc 0" |
+ "nat_of_num (Bit0 x) = nat_of_num x + nat_of_num x" |
+ "nat_of_num (Bit1 x) = Suc (nat_of_num x + nat_of_num x)"
+
+primrec num_of_nat :: "nat \<Rightarrow> num" where
+ "num_of_nat 0 = One" |
+ "num_of_nat (Suc n) = (if 0 < n then inc (num_of_nat n) else One)"
+
+lemma nat_of_num_pos: "0 < nat_of_num x"
+ by (induct x) simp_all
+
+lemma nat_of_num_neq_0: " nat_of_num x \<noteq> 0"
+ by (induct x) simp_all
+
+lemma nat_of_num_inc: "nat_of_num (inc x) = Suc (nat_of_num x)"
+ by (induct x) simp_all
+
+lemma num_of_nat_double:
+ "0 < n \<Longrightarrow> num_of_nat (n + n) = Bit0 (num_of_nat n)"
+ by (induct n) simp_all
+
+text {*
+ Type @{typ num} is isomorphic to the strictly positive
+ natural numbers.
+*}
+
+lemma nat_of_num_inverse: "num_of_nat (nat_of_num x) = x"
+ by (induct x) (simp_all add: num_of_nat_double nat_of_num_pos)
+
+lemma num_of_nat_inverse: "0 < n \<Longrightarrow> nat_of_num (num_of_nat n) = n"
+ by (induct n) (simp_all add: nat_of_num_inc)
+
+lemma num_eq_iff: "x = y \<longleftrightarrow> nat_of_num x = nat_of_num y"
+ apply safe
+ apply (drule arg_cong [where f=num_of_nat])
+ apply (simp add: nat_of_num_inverse)
+ done
+
+lemma num_induct [case_names One inc]:
+ fixes P :: "num \<Rightarrow> bool"
+ assumes One: "P One"
+ and inc: "\<And>x. P x \<Longrightarrow> P (inc x)"
+ shows "P x"
+proof -
+ obtain n where n: "Suc n = nat_of_num x"
+ by (cases "nat_of_num x", simp_all add: nat_of_num_neq_0)
+ have "P (num_of_nat (Suc n))"
+ proof (induct n)
+ case 0 show ?case using One by simp
+ next
+ case (Suc n)
+ then have "P (inc (num_of_nat (Suc n)))" by (rule inc)
+ then show "P (num_of_nat (Suc (Suc n)))" by simp
+ qed
+ with n show "P x"
+ by (simp add: nat_of_num_inverse)
+qed
+
+text {*
+ From now on, there are two possible models for @{typ num}:
+ as positive naturals (rule @{text "num_induct"})
+ and as digit representation (rules @{text "num.induct"}, @{text "num.cases"}).
+*}
+
+
+subsection {* Numeral operations *}
+
+instantiation num :: "{plus,times,linorder}"
+begin
+
+definition [code del]:
+ "m + n = num_of_nat (nat_of_num m + nat_of_num n)"
+
+definition [code del]:
+ "m * n = num_of_nat (nat_of_num m * nat_of_num n)"
+
+definition [code del]:
+ "m \<le> n \<longleftrightarrow> nat_of_num m \<le> nat_of_num n"
+
+definition [code del]:
+ "m < n \<longleftrightarrow> nat_of_num m < nat_of_num n"
+
+instance
+ by (default, auto simp add: less_num_def less_eq_num_def num_eq_iff)
+
+end
+
+lemma nat_of_num_add: "nat_of_num (x + y) = nat_of_num x + nat_of_num y"
+ unfolding plus_num_def
+ by (intro num_of_nat_inverse add_pos_pos nat_of_num_pos)
+
+lemma nat_of_num_mult: "nat_of_num (x * y) = nat_of_num x * nat_of_num y"
+ unfolding times_num_def
+ by (intro num_of_nat_inverse mult_pos_pos nat_of_num_pos)
+
+lemma add_num_simps [simp, code]:
+ "One + One = Bit0 One"
+ "One + Bit0 n = Bit1 n"
+ "One + Bit1 n = Bit0 (n + One)"
+ "Bit0 m + One = Bit1 m"
+ "Bit0 m + Bit0 n = Bit0 (m + n)"
+ "Bit0 m + Bit1 n = Bit1 (m + n)"
+ "Bit1 m + One = Bit0 (m + One)"
+ "Bit1 m + Bit0 n = Bit1 (m + n)"
+ "Bit1 m + Bit1 n = Bit0 (m + n + One)"
+ by (simp_all add: num_eq_iff nat_of_num_add)
+
+lemma mult_num_simps [simp, code]:
+ "m * One = m"
+ "One * n = n"
+ "Bit0 m * Bit0 n = Bit0 (Bit0 (m * n))"
+ "Bit0 m * Bit1 n = Bit0 (m * Bit1 n)"
+ "Bit1 m * Bit0 n = Bit0 (Bit1 m * n)"
+ "Bit1 m * Bit1 n = Bit1 (m + n + Bit0 (m * n))"
+ by (simp_all add: num_eq_iff nat_of_num_add
+ nat_of_num_mult left_distrib right_distrib)
+
+lemma eq_num_simps:
+ "One = One \<longleftrightarrow> True"
+ "One = Bit0 n \<longleftrightarrow> False"
+ "One = Bit1 n \<longleftrightarrow> False"
+ "Bit0 m = One \<longleftrightarrow> False"
+ "Bit1 m = One \<longleftrightarrow> False"
+ "Bit0 m = Bit0 n \<longleftrightarrow> m = n"
+ "Bit0 m = Bit1 n \<longleftrightarrow> False"
+ "Bit1 m = Bit0 n \<longleftrightarrow> False"
+ "Bit1 m = Bit1 n \<longleftrightarrow> m = n"
+ by simp_all
+
+lemma le_num_simps [simp, code]:
+ "One \<le> n \<longleftrightarrow> True"
+ "Bit0 m \<le> One \<longleftrightarrow> False"
+ "Bit1 m \<le> One \<longleftrightarrow> False"
+ "Bit0 m \<le> Bit0 n \<longleftrightarrow> m \<le> n"
+ "Bit0 m \<le> Bit1 n \<longleftrightarrow> m \<le> n"
+ "Bit1 m \<le> Bit1 n \<longleftrightarrow> m \<le> n"
+ "Bit1 m \<le> Bit0 n \<longleftrightarrow> m < n"
+ using nat_of_num_pos [of n] nat_of_num_pos [of m]
+ by (auto simp add: less_eq_num_def less_num_def)
+
+lemma less_num_simps [simp, code]:
+ "m < One \<longleftrightarrow> False"
+ "One < Bit0 n \<longleftrightarrow> True"
+ "One < Bit1 n \<longleftrightarrow> True"
+ "Bit0 m < Bit0 n \<longleftrightarrow> m < n"
+ "Bit0 m < Bit1 n \<longleftrightarrow> m \<le> n"
+ "Bit1 m < Bit1 n \<longleftrightarrow> m < n"
+ "Bit1 m < Bit0 n \<longleftrightarrow> m < n"
+ using nat_of_num_pos [of n] nat_of_num_pos [of m]
+ by (auto simp add: less_eq_num_def less_num_def)
+
+text {* Rules using @{text One} and @{text inc} as constructors *}
+
+lemma add_One: "x + One = inc x"
+ by (simp add: num_eq_iff nat_of_num_add nat_of_num_inc)
+
+lemma add_One_commute: "One + n = n + One"
+ by (induct n) simp_all
+
+lemma add_inc: "x + inc y = inc (x + y)"
+ by (simp add: num_eq_iff nat_of_num_add nat_of_num_inc)
+
+lemma mult_inc: "x * inc y = x * y + x"
+ by (simp add: num_eq_iff nat_of_num_mult nat_of_num_add nat_of_num_inc)
+
+text {* The @{const num_of_nat} conversion *}
+
+lemma num_of_nat_One:
+ "n \<le> 1 \<Longrightarrow> num_of_nat n = Num.One"
+ by (cases n) simp_all
+
+lemma num_of_nat_plus_distrib:
+ "0 < m \<Longrightarrow> 0 < n \<Longrightarrow> num_of_nat (m + n) = num_of_nat m + num_of_nat n"
+ by (induct n) (auto simp add: add_One add_One_commute add_inc)
+
+text {* A double-and-decrement function *}
+
+primrec BitM :: "num \<Rightarrow> num" where
+ "BitM One = One" |
+ "BitM (Bit0 n) = Bit1 (BitM n)" |
+ "BitM (Bit1 n) = Bit1 (Bit0 n)"
+
+lemma BitM_plus_one: "BitM n + One = Bit0 n"
+ by (induct n) simp_all
+
+lemma one_plus_BitM: "One + BitM n = Bit0 n"
+ unfolding add_One_commute BitM_plus_one ..
+
+text {* Squaring and exponentiation *}
+
+primrec sqr :: "num \<Rightarrow> num" where
+ "sqr One = One" |
+ "sqr (Bit0 n) = Bit0 (Bit0 (sqr n))" |
+ "sqr (Bit1 n) = Bit1 (Bit0 (sqr n + n))"
+
+primrec pow :: "num \<Rightarrow> num \<Rightarrow> num" where
+ "pow x One = x" |
+ "pow x (Bit0 y) = sqr (pow x y)" |
+ "pow x (Bit1 y) = x * sqr (pow x y)"
+
+lemma nat_of_num_sqr: "nat_of_num (sqr x) = nat_of_num x * nat_of_num x"
+ by (induct x, simp_all add: algebra_simps nat_of_num_add)
+
+lemma sqr_conv_mult: "sqr x = x * x"
+ by (simp add: num_eq_iff nat_of_num_sqr nat_of_num_mult)
+
+
+subsection {* Numary numerals *}
+
+text {*
+ We embed numary representations into a generic algebraic
+ structure using @{text numeral}.
+*}
+
+class numeral = one + semigroup_add
+begin
+
+primrec numeral :: "num \<Rightarrow> 'a" where
+ numeral_One: "numeral One = 1" |
+ numeral_Bit0: "numeral (Bit0 n) = numeral n + numeral n" |
+ numeral_Bit1: "numeral (Bit1 n) = numeral n + numeral n + 1"
+
+lemma one_plus_numeral_commute: "1 + numeral x = numeral x + 1"
+ apply (induct x)
+ apply simp
+ apply (simp add: add_assoc [symmetric], simp add: add_assoc)
+ apply (simp add: add_assoc [symmetric], simp add: add_assoc)
+ done
+
+lemma numeral_inc: "numeral (inc x) = numeral x + 1"
+proof (induct x)
+ case (Bit1 x)
+ have "numeral x + (1 + numeral x) + 1 = numeral x + (numeral x + 1) + 1"
+ by (simp only: one_plus_numeral_commute)
+ with Bit1 show ?case
+ by (simp add: add_assoc)
+qed simp_all
+
+declare numeral.simps [simp del]
+
+abbreviation "Numeral1 \<equiv> numeral One"
+
+declare numeral_One [code_post]
+
+end
+
+text {* Negative numerals. *}
+
+class neg_numeral = numeral + group_add
+begin
+
+definition neg_numeral :: "num \<Rightarrow> 'a" where
+ "neg_numeral k = - numeral k"
+
+end
+
+text {* Numeral syntax. *}
+
+syntax
+ "_Numeral" :: "num_const \<Rightarrow> 'a" ("_")
+
+parse_translation {*
+let
+ fun num_of_int n = if n > 0 then case IntInf.quotRem (n, 2)
+ of (0, 1) => Syntax.const @{const_name One}
+ | (n, 0) => Syntax.const @{const_name Bit0} $ num_of_int n
+ | (n, 1) => Syntax.const @{const_name Bit1} $ num_of_int n
+ else raise Match;
+ val pos = Syntax.const @{const_name numeral}
+ val neg = Syntax.const @{const_name neg_numeral}
+ val one = Syntax.const @{const_name Groups.one}
+ val zero = Syntax.const @{const_name Groups.zero}
+ fun numeral_tr [(c as Const (@{syntax_const "_constrain"}, _)) $ t $ u] =
+ c $ numeral_tr [t] $ u
+ | numeral_tr [Const (num, _)] =
+ let
+ val {value, ...} = Lexicon.read_xnum num;
+ in
+ if value = 0 then zero else
+ if value > 0
+ then pos $ num_of_int value
+ else neg $ num_of_int (~value)
+ end
+ | numeral_tr ts = raise TERM ("numeral_tr", ts);
+in [("_Numeral", numeral_tr)] end
+*}
+
+typed_print_translation (advanced) {*
+let
+ fun dest_num (Const (@{const_syntax Bit0}, _) $ n) = 2 * dest_num n
+ | dest_num (Const (@{const_syntax Bit1}, _) $ n) = 2 * dest_num n + 1
+ | dest_num (Const (@{const_syntax One}, _)) = 1;
+ fun num_tr' sign ctxt T [n] =
+ let
+ val k = dest_num n;
+ val t' = Syntax.const @{syntax_const "_Numeral"} $
+ Syntax.free (sign ^ string_of_int k);
+ in
+ case T of
+ Type (@{type_name fun}, [_, T']) =>
+ if not (Config.get ctxt show_types) andalso can Term.dest_Type T' then t'
+ else Syntax.const @{syntax_const "_constrain"} $ t' $ Syntax_Phases.term_of_typ ctxt T'
+ | T' => if T' = dummyT then t' else raise Match
+ end;
+in [(@{const_syntax numeral}, num_tr' ""),
+ (@{const_syntax neg_numeral}, num_tr' "-")] end
+*}
+
+subsection {* Class-specific numeral rules *}
+
+text {*
+ @{const numeral} is a morphism.
+*}
+
+subsubsection {* Structures with addition: class @{text numeral} *}
+
+context numeral
+begin
+
+lemma numeral_add: "numeral (m + n) = numeral m + numeral n"
+ by (induct n rule: num_induct)
+ (simp_all only: numeral_One add_One add_inc numeral_inc add_assoc)
+
+lemma numeral_plus_numeral: "numeral m + numeral n = numeral (m + n)"
+ by (rule numeral_add [symmetric])
+
+lemma numeral_plus_one: "numeral n + 1 = numeral (n + One)"
+ using numeral_add [of n One] by (simp add: numeral_One)
+
+lemma one_plus_numeral: "1 + numeral n = numeral (One + n)"
+ using numeral_add [of One n] by (simp add: numeral_One)
+
+lemma one_add_one: "1 + 1 = 2"
+ using numeral_add [of One One] by (simp add: numeral_One)
+
+lemmas add_numeral_special =
+ numeral_plus_one one_plus_numeral one_add_one
+
+end
+
+subsubsection {*
+ Structures with negation: class @{text neg_numeral}
+*}
+
+context neg_numeral
+begin
+
+text {* Numerals form an abelian subgroup. *}
+
+inductive is_num :: "'a \<Rightarrow> bool" where
+ "is_num 1" |
+ "is_num x \<Longrightarrow> is_num (- x)" |
+ "\<lbrakk>is_num x; is_num y\<rbrakk> \<Longrightarrow> is_num (x + y)"
+
+lemma is_num_numeral: "is_num (numeral k)"
+ by (induct k, simp_all add: numeral.simps is_num.intros)
+
+lemma is_num_add_commute:
+ "\<lbrakk>is_num x; is_num y\<rbrakk> \<Longrightarrow> x + y = y + x"
+ apply (induct x rule: is_num.induct)
+ apply (induct y rule: is_num.induct)
+ apply simp
+ apply (rule_tac a=x in add_left_imp_eq)
+ apply (rule_tac a=x in add_right_imp_eq)
+ apply (simp add: add_assoc minus_add_cancel)
+ apply (simp add: add_assoc [symmetric], simp add: add_assoc)
+ apply (rule_tac a=x in add_left_imp_eq)
+ apply (rule_tac a=x in add_right_imp_eq)
+ apply (simp add: add_assoc minus_add_cancel add_minus_cancel)
+ apply (simp add: add_assoc, simp add: add_assoc [symmetric])
+ done
+
+lemma is_num_add_left_commute:
+ "\<lbrakk>is_num x; is_num y\<rbrakk> \<Longrightarrow> x + (y + z) = y + (x + z)"
+ by (simp only: add_assoc [symmetric] is_num_add_commute)
+
+lemmas is_num_normalize =
+ add_assoc is_num_add_commute is_num_add_left_commute
+ is_num.intros is_num_numeral
+ diff_minus minus_add add_minus_cancel minus_add_cancel
+
+definition dbl :: "'a \<Rightarrow> 'a" where "dbl x = x + x"
+definition dbl_inc :: "'a \<Rightarrow> 'a" where "dbl_inc x = x + x + 1"
+definition dbl_dec :: "'a \<Rightarrow> 'a" where "dbl_dec x = x + x - 1"
+
+definition sub :: "num \<Rightarrow> num \<Rightarrow> 'a" where
+ "sub k l = numeral k - numeral l"
+
+lemma numeral_BitM: "numeral (BitM n) = numeral (Bit0 n) - 1"
+ by (simp only: BitM_plus_one [symmetric] numeral_add numeral_One eq_diff_eq)
+
+lemma dbl_simps [simp]:
+ "dbl (neg_numeral k) = neg_numeral (Bit0 k)"
+ "dbl 0 = 0"
+ "dbl 1 = 2"
+ "dbl (numeral k) = numeral (Bit0 k)"
+ unfolding dbl_def neg_numeral_def numeral.simps
+ by (simp_all add: minus_add)
+
+lemma dbl_inc_simps [simp]:
+ "dbl_inc (neg_numeral k) = neg_numeral (BitM k)"
+ "dbl_inc 0 = 1"
+ "dbl_inc 1 = 3"
+ "dbl_inc (numeral k) = numeral (Bit1 k)"
+ unfolding dbl_inc_def neg_numeral_def numeral.simps numeral_BitM
+ by (simp_all add: is_num_normalize)
+
+lemma dbl_dec_simps [simp]:
+ "dbl_dec (neg_numeral k) = neg_numeral (Bit1 k)"
+ "dbl_dec 0 = -1"
+ "dbl_dec 1 = 1"
+ "dbl_dec (numeral k) = numeral (BitM k)"
+ unfolding dbl_dec_def neg_numeral_def numeral.simps numeral_BitM
+ by (simp_all add: is_num_normalize)
+
+lemma sub_num_simps [simp]:
+ "sub One One = 0"
+ "sub One (Bit0 l) = neg_numeral (BitM l)"
+ "sub One (Bit1 l) = neg_numeral (Bit0 l)"
+ "sub (Bit0 k) One = numeral (BitM k)"
+ "sub (Bit1 k) One = numeral (Bit0 k)"
+ "sub (Bit0 k) (Bit0 l) = dbl (sub k l)"
+ "sub (Bit0 k) (Bit1 l) = dbl_dec (sub k l)"
+ "sub (Bit1 k) (Bit0 l) = dbl_inc (sub k l)"
+ "sub (Bit1 k) (Bit1 l) = dbl (sub k l)"
+ unfolding dbl_def dbl_dec_def dbl_inc_def sub_def
+ unfolding neg_numeral_def numeral.simps numeral_BitM
+ by (simp_all add: is_num_normalize)
+
+lemma add_neg_numeral_simps:
+ "numeral m + neg_numeral n = sub m n"
+ "neg_numeral m + numeral n = sub n m"
+ "neg_numeral m + neg_numeral n = neg_numeral (m + n)"
+ unfolding sub_def diff_minus neg_numeral_def numeral_add numeral.simps
+ by (simp_all add: is_num_normalize)
+
+lemma add_neg_numeral_special:
+ "1 + neg_numeral m = sub One m"
+ "neg_numeral m + 1 = sub One m"
+ unfolding sub_def diff_minus neg_numeral_def numeral_add numeral.simps
+ by (simp_all add: is_num_normalize)
+
+lemma diff_numeral_simps:
+ "numeral m - numeral n = sub m n"
+ "numeral m - neg_numeral n = numeral (m + n)"
+ "neg_numeral m - numeral n = neg_numeral (m + n)"
+ "neg_numeral m - neg_numeral n = sub n m"
+ unfolding neg_numeral_def sub_def diff_minus numeral_add numeral.simps
+ by (simp_all add: is_num_normalize)
+
+lemma diff_numeral_special:
+ "1 - numeral n = sub One n"
+ "1 - neg_numeral n = numeral (One + n)"
+ "numeral m - 1 = sub m One"
+ "neg_numeral m - 1 = neg_numeral (m + One)"
+ unfolding neg_numeral_def sub_def diff_minus numeral_add numeral.simps
+ by (simp_all add: is_num_normalize)
+
+lemma minus_one: "- 1 = -1"
+ unfolding neg_numeral_def numeral.simps ..
+
+lemma minus_numeral: "- numeral n = neg_numeral n"
+ unfolding neg_numeral_def ..
+
+lemma minus_neg_numeral: "- neg_numeral n = numeral n"
+ unfolding neg_numeral_def by simp
+
+lemmas minus_numeral_simps [simp] =
+ minus_one minus_numeral minus_neg_numeral
+
+end
+
+subsubsection {*
+ Structures with multiplication: class @{text semiring_numeral}
+*}
+
+class semiring_numeral = semiring + monoid_mult
+begin
+
+subclass numeral ..
+
+lemma numeral_mult: "numeral (m * n) = numeral m * numeral n"
+ apply (induct n rule: num_induct)
+ apply (simp add: numeral_One)
+ apply (simp add: mult_inc numeral_inc numeral_add numeral_inc right_distrib)
+ done
+
+lemma numeral_times_numeral: "numeral m * numeral n = numeral (m * n)"
+ by (rule numeral_mult [symmetric])
+
+end
+
+subsubsection {*
+ Structures with a zero: class @{text semiring_1}
+*}
+
+context semiring_1
+begin
+
+subclass semiring_numeral ..
+
+lemma of_nat_numeral [simp]: "of_nat (numeral n) = numeral n"
+ by (induct n,
+ simp_all only: numeral.simps numeral_class.numeral.simps of_nat_add of_nat_1)
+
+end
+
+lemma nat_of_num_numeral: "nat_of_num = numeral"
+proof
+ fix n
+ have "numeral n = nat_of_num n"
+ by (induct n) (simp_all add: numeral.simps)
+ then show "nat_of_num n = numeral n" by simp
+qed
+
+subsubsection {*
+ Equality: class @{text semiring_char_0}
+*}
+
+context semiring_char_0
+begin
+
+lemma numeral_eq_iff: "numeral m = numeral n \<longleftrightarrow> m = n"
+ unfolding of_nat_numeral [symmetric] nat_of_num_numeral [symmetric]
+ of_nat_eq_iff num_eq_iff ..
+
+lemma numeral_eq_one_iff: "numeral n = 1 \<longleftrightarrow> n = One"
+ by (rule numeral_eq_iff [of n One, unfolded numeral_One])
+
+lemma one_eq_numeral_iff: "1 = numeral n \<longleftrightarrow> One = n"
+ by (rule numeral_eq_iff [of One n, unfolded numeral_One])
+
+lemma numeral_neq_zero: "numeral n \<noteq> 0"
+ unfolding of_nat_numeral [symmetric] nat_of_num_numeral [symmetric]
+ by (simp add: nat_of_num_pos)
+
+lemma zero_neq_numeral: "0 \<noteq> numeral n"
+ unfolding eq_commute [of 0] by (rule numeral_neq_zero)
+
+lemmas eq_numeral_simps [simp] =
+ numeral_eq_iff
+ numeral_eq_one_iff
+ one_eq_numeral_iff
+ numeral_neq_zero
+ zero_neq_numeral
+
+end
+
+subsubsection {*
+ Comparisons: class @{text linordered_semidom}
+*}
+
+text {* Could be perhaps more general than here. *}
+
+context linordered_semidom
+begin
+
+lemma numeral_le_iff: "numeral m \<le> numeral n \<longleftrightarrow> m \<le> n"
+proof -
+ have "of_nat (numeral m) \<le> of_nat (numeral n) \<longleftrightarrow> m \<le> n"
+ unfolding less_eq_num_def nat_of_num_numeral of_nat_le_iff ..
+ then show ?thesis by simp
+qed
+
+lemma one_le_numeral: "1 \<le> numeral n"
+using numeral_le_iff [of One n] by (simp add: numeral_One)
+
+lemma numeral_le_one_iff: "numeral n \<le> 1 \<longleftrightarrow> n \<le> One"
+using numeral_le_iff [of n One] by (simp add: numeral_One)
+
+lemma numeral_less_iff: "numeral m < numeral n \<longleftrightarrow> m < n"
+proof -
+ have "of_nat (numeral m) < of_nat (numeral n) \<longleftrightarrow> m < n"
+ unfolding less_num_def nat_of_num_numeral of_nat_less_iff ..
+ then show ?thesis by simp
+qed
+
+lemma not_numeral_less_one: "\<not> numeral n < 1"
+ using numeral_less_iff [of n One] by (simp add: numeral_One)
+
+lemma one_less_numeral_iff: "1 < numeral n \<longleftrightarrow> One < n"
+ using numeral_less_iff [of One n] by (simp add: numeral_One)
+
+lemma zero_le_numeral: "0 \<le> numeral n"
+ by (induct n) (simp_all add: numeral.simps)
+
+lemma zero_less_numeral: "0 < numeral n"
+ by (induct n) (simp_all add: numeral.simps add_pos_pos)
+
+lemma not_numeral_le_zero: "\<not> numeral n \<le> 0"
+ by (simp add: not_le zero_less_numeral)
+
+lemma not_numeral_less_zero: "\<not> numeral n < 0"
+ by (simp add: not_less zero_le_numeral)
+
+lemmas le_numeral_extra =
+ zero_le_one not_one_le_zero
+ order_refl [of 0] order_refl [of 1]
+
+lemmas less_numeral_extra =
+ zero_less_one not_one_less_zero
+ less_irrefl [of 0] less_irrefl [of 1]
+
+lemmas le_numeral_simps [simp] =
+ numeral_le_iff
+ one_le_numeral
+ numeral_le_one_iff
+ zero_le_numeral
+ not_numeral_le_zero
+
+lemmas less_numeral_simps [simp] =
+ numeral_less_iff
+ one_less_numeral_iff
+ not_numeral_less_one
+ zero_less_numeral
+ not_numeral_less_zero
+
+end
+
+subsubsection {*
+ Multiplication and negation: class @{text ring_1}
+*}
+
+context ring_1
+begin
+
+subclass neg_numeral ..
+
+lemma mult_neg_numeral_simps:
+ "neg_numeral m * neg_numeral n = numeral (m * n)"
+ "neg_numeral m * numeral n = neg_numeral (m * n)"
+ "numeral m * neg_numeral n = neg_numeral (m * n)"
+ unfolding neg_numeral_def mult_minus_left mult_minus_right
+ by (simp_all only: minus_minus numeral_mult)
+
+lemma mult_minus1 [simp]: "-1 * z = - z"
+ unfolding neg_numeral_def numeral.simps mult_minus_left by simp
+
+lemma mult_minus1_right [simp]: "z * -1 = - z"
+ unfolding neg_numeral_def numeral.simps mult_minus_right by simp
+
+end
+
+subsubsection {*
+ Equality using @{text iszero} for rings with non-zero characteristic
+*}
+
+context ring_1
+begin
+
+definition iszero :: "'a \<Rightarrow> bool"
+ where "iszero z \<longleftrightarrow> z = 0"
+
+lemma iszero_0 [simp]: "iszero 0"
+ by (simp add: iszero_def)
+
+lemma not_iszero_1 [simp]: "\<not> iszero 1"
+ by (simp add: iszero_def)
+
+lemma not_iszero_Numeral1: "\<not> iszero Numeral1"
+ by (simp add: numeral_One)
+
+lemma iszero_neg_numeral [simp]:
+ "iszero (neg_numeral w) \<longleftrightarrow> iszero (numeral w)"
+ unfolding iszero_def neg_numeral_def
+ by (rule neg_equal_0_iff_equal)
+
+lemma eq_iff_iszero_diff: "x = y \<longleftrightarrow> iszero (x - y)"
+ unfolding iszero_def by (rule eq_iff_diff_eq_0)
+
+text {* The @{text "eq_numeral_iff_iszero"} lemmas are not declared
+@{text "[simp]"} by default, because for rings of characteristic zero,
+better simp rules are possible. For a type like integers mod @{text
+"n"}, type-instantiated versions of these rules should be added to the
+simplifier, along with a type-specific rule for deciding propositions
+of the form @{text "iszero (numeral w)"}.
+
+bh: Maybe it would not be so bad to just declare these as simp
+rules anyway? I should test whether these rules take precedence over
+the @{text "ring_char_0"} rules in the simplifier.
+*}
+
+lemma eq_numeral_iff_iszero:
+ "numeral x = numeral y \<longleftrightarrow> iszero (sub x y)"
+ "numeral x = neg_numeral y \<longleftrightarrow> iszero (numeral (x + y))"
+ "neg_numeral x = numeral y \<longleftrightarrow> iszero (numeral (x + y))"
+ "neg_numeral x = neg_numeral y \<longleftrightarrow> iszero (sub y x)"
+ "numeral x = 1 \<longleftrightarrow> iszero (sub x One)"
+ "1 = numeral y \<longleftrightarrow> iszero (sub One y)"
+ "neg_numeral x = 1 \<longleftrightarrow> iszero (numeral (x + One))"
+ "1 = neg_numeral y \<longleftrightarrow> iszero (numeral (One + y))"
+ "numeral x = 0 \<longleftrightarrow> iszero (numeral x)"
+ "0 = numeral y \<longleftrightarrow> iszero (numeral y)"
+ "neg_numeral x = 0 \<longleftrightarrow> iszero (numeral x)"
+ "0 = neg_numeral y \<longleftrightarrow> iszero (numeral y)"
+ unfolding eq_iff_iszero_diff diff_numeral_simps diff_numeral_special
+ by simp_all
+
+end
+
+subsubsection {*
+ Equality and negation: class @{text ring_char_0}
+*}
+
+class ring_char_0 = ring_1 + semiring_char_0
+begin
+
+lemma not_iszero_numeral [simp]: "\<not> iszero (numeral w)"
+ by (simp add: iszero_def)
+
+lemma neg_numeral_eq_iff: "neg_numeral m = neg_numeral n \<longleftrightarrow> m = n"
+ by (simp only: neg_numeral_def neg_equal_iff_equal numeral_eq_iff)
+
+lemma numeral_neq_neg_numeral: "numeral m \<noteq> neg_numeral n"
+ unfolding neg_numeral_def eq_neg_iff_add_eq_0
+ by (simp add: numeral_plus_numeral)
+
+lemma neg_numeral_neq_numeral: "neg_numeral m \<noteq> numeral n"
+ by (rule numeral_neq_neg_numeral [symmetric])
+
+lemma zero_neq_neg_numeral: "0 \<noteq> neg_numeral n"
+ unfolding neg_numeral_def neg_0_equal_iff_equal by simp
+
+lemma neg_numeral_neq_zero: "neg_numeral n \<noteq> 0"
+ unfolding neg_numeral_def neg_equal_0_iff_equal by simp
+
+lemma one_neq_neg_numeral: "1 \<noteq> neg_numeral n"
+ using numeral_neq_neg_numeral [of One n] by (simp add: numeral_One)
+
+lemma neg_numeral_neq_one: "neg_numeral n \<noteq> 1"
+ using neg_numeral_neq_numeral [of n One] by (simp add: numeral_One)
+
+lemmas eq_neg_numeral_simps [simp] =
+ neg_numeral_eq_iff
+ numeral_neq_neg_numeral neg_numeral_neq_numeral
+ one_neq_neg_numeral neg_numeral_neq_one
+ zero_neq_neg_numeral neg_numeral_neq_zero
+
+end
+
+subsubsection {*
+ Structures with negation and order: class @{text linordered_idom}
+*}
+
+context linordered_idom
+begin
+
+subclass ring_char_0 ..
+
+lemma neg_numeral_le_iff: "neg_numeral m \<le> neg_numeral n \<longleftrightarrow> n \<le> m"
+ by (simp only: neg_numeral_def neg_le_iff_le numeral_le_iff)
+
+lemma neg_numeral_less_iff: "neg_numeral m < neg_numeral n \<longleftrightarrow> n < m"
+ by (simp only: neg_numeral_def neg_less_iff_less numeral_less_iff)
+
+lemma neg_numeral_less_zero: "neg_numeral n < 0"
+ by (simp only: neg_numeral_def neg_less_0_iff_less zero_less_numeral)
+
+lemma neg_numeral_le_zero: "neg_numeral n \<le> 0"
+ by (simp only: neg_numeral_def neg_le_0_iff_le zero_le_numeral)
+
+lemma not_zero_less_neg_numeral: "\<not> 0 < neg_numeral n"
+ by (simp only: not_less neg_numeral_le_zero)
+
+lemma not_zero_le_neg_numeral: "\<not> 0 \<le> neg_numeral n"
+ by (simp only: not_le neg_numeral_less_zero)
+
+lemma neg_numeral_less_numeral: "neg_numeral m < numeral n"
+ using neg_numeral_less_zero zero_less_numeral by (rule less_trans)
+
+lemma neg_numeral_le_numeral: "neg_numeral m \<le> numeral n"
+ by (simp only: less_imp_le neg_numeral_less_numeral)
+
+lemma not_numeral_less_neg_numeral: "\<not> numeral m < neg_numeral n"
+ by (simp only: not_less neg_numeral_le_numeral)
+
+lemma not_numeral_le_neg_numeral: "\<not> numeral m \<le> neg_numeral n"
+ by (simp only: not_le neg_numeral_less_numeral)
+
+lemma neg_numeral_less_one: "neg_numeral m < 1"
+ by (rule neg_numeral_less_numeral [of m One, unfolded numeral_One])
+
+lemma neg_numeral_le_one: "neg_numeral m \<le> 1"
+ by (rule neg_numeral_le_numeral [of m One, unfolded numeral_One])
+
+lemma not_one_less_neg_numeral: "\<not> 1 < neg_numeral m"
+ by (simp only: not_less neg_numeral_le_one)
+
+lemma not_one_le_neg_numeral: "\<not> 1 \<le> neg_numeral m"
+ by (simp only: not_le neg_numeral_less_one)
+
+lemma sub_non_negative:
+ "sub n m \<ge> 0 \<longleftrightarrow> n \<ge> m"
+ by (simp only: sub_def le_diff_eq) simp
+
+lemma sub_positive:
+ "sub n m > 0 \<longleftrightarrow> n > m"
+ by (simp only: sub_def less_diff_eq) simp
+
+lemma sub_non_positive:
+ "sub n m \<le> 0 \<longleftrightarrow> n \<le> m"
+ by (simp only: sub_def diff_le_eq) simp
+
+lemma sub_negative:
+ "sub n m < 0 \<longleftrightarrow> n < m"
+ by (simp only: sub_def diff_less_eq) simp
+
+lemmas le_neg_numeral_simps [simp] =
+ neg_numeral_le_iff
+ neg_numeral_le_numeral not_numeral_le_neg_numeral
+ neg_numeral_le_zero not_zero_le_neg_numeral
+ neg_numeral_le_one not_one_le_neg_numeral
+
+lemmas less_neg_numeral_simps [simp] =
+ neg_numeral_less_iff
+ neg_numeral_less_numeral not_numeral_less_neg_numeral
+ neg_numeral_less_zero not_zero_less_neg_numeral
+ neg_numeral_less_one not_one_less_neg_numeral
+
+lemma abs_numeral [simp]: "abs (numeral n) = numeral n"
+ by simp
+
+lemma abs_neg_numeral [simp]: "abs (neg_numeral n) = numeral n"
+ by (simp only: neg_numeral_def abs_minus_cancel abs_numeral)
+
+end
+
+subsubsection {*
+ Natural numbers
+*}
+
+lemma Suc_numeral [simp]: "Suc (numeral n) = numeral (n + One)"
+ unfolding numeral_plus_one [symmetric] by simp
+
+lemma nat_number:
+ "1 = Suc 0"
+ "numeral One = Suc 0"
+ "numeral (Bit0 n) = Suc (numeral (BitM n))"
+ "numeral (Bit1 n) = Suc (numeral (Bit0 n))"
+ by (simp_all add: numeral.simps BitM_plus_one)
+
+subsubsection {*
+ Structures with exponentiation
+*}
+
+context semiring_numeral
+begin
+
+lemma numeral_sqr: "numeral (sqr n) = numeral n * numeral n"
+ by (simp add: sqr_conv_mult numeral_mult)
+
+lemma numeral_pow: "numeral (pow m n) = numeral m ^ numeral n"
+ by (induct n, simp_all add: numeral_class.numeral.simps
+ power_add numeral_sqr numeral_mult)
+
+lemma power_numeral [simp]: "numeral m ^ numeral n = numeral (pow m n)"
+ by (rule numeral_pow [symmetric])
+
+end
+
+context semiring_1
+begin
+
+lemma power_zero_numeral [simp]: "(0::'a) ^ numeral n = 0"
+ by (induct n, simp_all add: numeral_class.numeral.simps power_add)
+
+end
+
+context ring_1
+begin
+
+lemma power_minus_Bit0: "(- x) ^ numeral (Bit0 n) = x ^ numeral (Bit0 n)"
+ by (induct n, simp_all add: numeral_class.numeral.simps power_add)
+
+lemma power_minus_Bit1: "(- x) ^ numeral (Bit1 n) = - (x ^ numeral (Bit1 n))"
+ by (simp only: nat_number(4) power_Suc power_minus_Bit0 mult_minus_left)
+
+lemma power_neg_numeral_Bit0 [simp]:
+ "neg_numeral m ^ numeral (Bit0 n) = numeral (pow m (Bit0 n))"
+ by (simp only: neg_numeral_def power_minus_Bit0 power_numeral)
+
+lemma power_neg_numeral_Bit1 [simp]:
+ "neg_numeral m ^ numeral (Bit1 n) = neg_numeral (pow m (Bit1 n))"
+ by (simp only: neg_numeral_def power_minus_Bit1 power_numeral pow.simps)
+
+end
+
+subsection {* Numeral equations as default simplification rules *}
+
+declare (in numeral) numeral_One [simp]
+declare (in numeral) numeral_plus_numeral [simp]
+declare (in numeral) add_numeral_special [simp]
+declare (in neg_numeral) add_neg_numeral_simps [simp]
+declare (in neg_numeral) add_neg_numeral_special [simp]
+declare (in neg_numeral) diff_numeral_simps [simp]
+declare (in neg_numeral) diff_numeral_special [simp]
+declare (in semiring_numeral) numeral_times_numeral [simp]
+declare (in ring_1) mult_neg_numeral_simps [simp]
+
+subsection {* Setting up simprocs *}
+
+lemma numeral_reorient:
+ "(numeral w = x) = (x = numeral w)"
+ by auto
+
+lemma mult_numeral_1: "Numeral1 * a = (a::'a::semiring_numeral)"
+ by simp
+
+lemma mult_numeral_1_right: "a * Numeral1 = (a::'a::semiring_numeral)"
+ by simp
+
+lemma divide_numeral_1: "a / Numeral1 = (a::'a::field)"
+ by simp
+
+lemma inverse_numeral_1:
+ "inverse Numeral1 = (Numeral1::'a::division_ring)"
+ by simp
+
+text{*Theorem lists for the cancellation simprocs. The use of a numary
+numeral for 1 reduces the number of special cases.*}
+
+lemmas mult_1s =
+ mult_numeral_1 mult_numeral_1_right
+ mult_minus1 mult_minus1_right
+
+
+subsubsection {* Simplification of arithmetic operations on integer constants. *}
+
+lemmas arith_special = (* already declared simp above *)
+ add_numeral_special add_neg_numeral_special
+ diff_numeral_special minus_one
+
+(* rules already in simpset *)
+lemmas arith_extra_simps =
+ numeral_plus_numeral add_neg_numeral_simps add_0_left add_0_right
+ minus_numeral minus_neg_numeral minus_zero minus_one
+ diff_numeral_simps diff_0 diff_0_right
+ numeral_times_numeral mult_neg_numeral_simps
+ mult_zero_left mult_zero_right
+ abs_numeral abs_neg_numeral
+
+text {*
+ For making a minimal simpset, one must include these default simprules.
+ Also include @{text simp_thms}.
+*}
+
+lemmas arith_simps =
+ add_num_simps mult_num_simps sub_num_simps
+ BitM.simps dbl_simps dbl_inc_simps dbl_dec_simps
+ abs_zero abs_one arith_extra_simps
+
+text {* Simplification of relational operations *}
+
+lemmas eq_numeral_extra =
+ zero_neq_one one_neq_zero
+
+lemmas rel_simps =
+ le_num_simps less_num_simps eq_num_simps
+ le_numeral_simps le_neg_numeral_simps le_numeral_extra
+ less_numeral_simps less_neg_numeral_simps less_numeral_extra
+ eq_numeral_simps eq_neg_numeral_simps eq_numeral_extra
+
+
+subsubsection {* Simplification of arithmetic when nested to the right. *}
+
+lemma add_numeral_left [simp]:
+ "numeral v + (numeral w + z) = (numeral(v + w) + z)"
+ by (simp_all add: add_assoc [symmetric])
+
+lemma add_neg_numeral_left [simp]:
+ "numeral v + (neg_numeral w + y) = (sub v w + y)"
+ "neg_numeral v + (numeral w + y) = (sub w v + y)"
+ "neg_numeral v + (neg_numeral w + y) = (neg_numeral(v + w) + y)"
+ by (simp_all add: add_assoc [symmetric])
+
+lemma mult_numeral_left [simp]:
+ "numeral v * (numeral w * z) = (numeral(v * w) * z :: 'a::semiring_numeral)"
+ "neg_numeral v * (numeral w * y) = (neg_numeral(v * w) * y :: 'b::ring_1)"
+ "numeral v * (neg_numeral w * y) = (neg_numeral(v * w) * y :: 'b::ring_1)"
+ "neg_numeral v * (neg_numeral w * y) = (numeral(v * w) * y :: 'b::ring_1)"
+ by (simp_all add: mult_assoc [symmetric])
+
+hide_const (open) One Bit0 Bit1 BitM inc pow sqr sub dbl dbl_inc dbl_dec
+
+subsection {* code module namespace *}
+
+code_modulename SML
+ Numeral Arith
+
+code_modulename OCaml
+ Numeral Arith
+
+code_modulename Haskell
+ Numeral Arith
+
+end
--- a/src/HOL/Number_Theory/Primes.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Number_Theory/Primes.thy Mon Mar 26 15:33:28 2012 +0200
@@ -206,7 +206,7 @@
"prime (p::nat) \<longleftrightarrow> p > 1 \<and> (\<forall>n \<in> set [2..<p]. \<not> n dvd p)"
by (auto simp add: prime_nat_code)
-lemmas prime_nat_simp_number_of [simp] = prime_nat_simp [of "number_of m"] for m
+lemmas prime_nat_simp_numeral [simp] = prime_nat_simp [of "numeral m"] for m
lemma prime_int_code [code]:
"prime (p::int) \<longleftrightarrow> p > 1 \<and> (\<forall>n \<in> {1<..<p}. ~ n dvd p)" (is "?L = ?R")
@@ -222,7 +222,7 @@
lemma prime_int_simp: "prime (p::int) \<longleftrightarrow> p > 1 \<and> (\<forall>n \<in> set [2..p - 1]. ~ n dvd p)"
by (auto simp add: prime_int_code)
-lemmas prime_int_simp_number_of [simp] = prime_int_simp [of "number_of m"] for m
+lemmas prime_int_simp_numeral [simp] = prime_int_simp [of "numeral m"] for m
lemma two_is_prime_nat [simp]: "prime (2::nat)"
by simp
--- a/src/HOL/Numeral_Simprocs.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Numeral_Simprocs.thy Mon Mar 26 15:33:28 2012 +0200
@@ -14,8 +14,8 @@
("Tools/nat_numeral_simprocs.ML")
begin
-declare split_div [of _ _ "number_of k", arith_split] for k
-declare split_mod [of _ _ "number_of k", arith_split] for k
+declare split_div [of _ _ "numeral k", arith_split] for k
+declare split_mod [of _ _ "numeral k", arith_split] for k
text {* For @{text combine_numerals} *}
@@ -98,72 +98,74 @@
("(a::'a::comm_semiring_1_cancel) * b") =
{* fn phi => Numeral_Simprocs.assoc_fold *}
+(* TODO: see whether the type class can be generalized further *)
simproc_setup int_combine_numerals
- ("(i::'a::number_ring) + j" | "(i::'a::number_ring) - j") =
+ ("(i::'a::comm_ring_1) + j" | "(i::'a::comm_ring_1) - j") =
{* fn phi => Numeral_Simprocs.combine_numerals *}
simproc_setup field_combine_numerals
- ("(i::'a::{field_inverse_zero,ring_char_0,number_ring}) + j"
- |"(i::'a::{field_inverse_zero,ring_char_0,number_ring}) - j") =
+ ("(i::'a::{field_inverse_zero,ring_char_0}) + j"
+ |"(i::'a::{field_inverse_zero,ring_char_0}) - j") =
{* fn phi => Numeral_Simprocs.field_combine_numerals *}
simproc_setup inteq_cancel_numerals
- ("(l::'a::number_ring) + m = n"
- |"(l::'a::number_ring) = m + n"
- |"(l::'a::number_ring) - m = n"
- |"(l::'a::number_ring) = m - n"
- |"(l::'a::number_ring) * m = n"
- |"(l::'a::number_ring) = m * n"
- |"- (l::'a::number_ring) = m"
- |"(l::'a::number_ring) = - m") =
+ ("(l::'a::comm_ring_1) + m = n"
+ |"(l::'a::comm_ring_1) = m + n"
+ |"(l::'a::comm_ring_1) - m = n"
+ |"(l::'a::comm_ring_1) = m - n"
+ |"(l::'a::comm_ring_1) * m = n"
+ |"(l::'a::comm_ring_1) = m * n"
+ |"- (l::'a::comm_ring_1) = m"
+ |"(l::'a::comm_ring_1) = - m") =
{* fn phi => Numeral_Simprocs.eq_cancel_numerals *}
simproc_setup intless_cancel_numerals
- ("(l::'a::{linordered_idom,number_ring}) + m < n"
- |"(l::'a::{linordered_idom,number_ring}) < m + n"
- |"(l::'a::{linordered_idom,number_ring}) - m < n"
- |"(l::'a::{linordered_idom,number_ring}) < m - n"
- |"(l::'a::{linordered_idom,number_ring}) * m < n"
- |"(l::'a::{linordered_idom,number_ring}) < m * n"
- |"- (l::'a::{linordered_idom,number_ring}) < m"
- |"(l::'a::{linordered_idom,number_ring}) < - m") =
+ ("(l::'a::linordered_idom) + m < n"
+ |"(l::'a::linordered_idom) < m + n"
+ |"(l::'a::linordered_idom) - m < n"
+ |"(l::'a::linordered_idom) < m - n"
+ |"(l::'a::linordered_idom) * m < n"
+ |"(l::'a::linordered_idom) < m * n"
+ |"- (l::'a::linordered_idom) < m"
+ |"(l::'a::linordered_idom) < - m") =
{* fn phi => Numeral_Simprocs.less_cancel_numerals *}
simproc_setup intle_cancel_numerals
- ("(l::'a::{linordered_idom,number_ring}) + m \<le> n"
- |"(l::'a::{linordered_idom,number_ring}) \<le> m + n"
- |"(l::'a::{linordered_idom,number_ring}) - m \<le> n"
- |"(l::'a::{linordered_idom,number_ring}) \<le> m - n"
- |"(l::'a::{linordered_idom,number_ring}) * m \<le> n"
- |"(l::'a::{linordered_idom,number_ring}) \<le> m * n"
- |"- (l::'a::{linordered_idom,number_ring}) \<le> m"
- |"(l::'a::{linordered_idom,number_ring}) \<le> - m") =
+ ("(l::'a::linordered_idom) + m \<le> n"
+ |"(l::'a::linordered_idom) \<le> m + n"
+ |"(l::'a::linordered_idom) - m \<le> n"
+ |"(l::'a::linordered_idom) \<le> m - n"
+ |"(l::'a::linordered_idom) * m \<le> n"
+ |"(l::'a::linordered_idom) \<le> m * n"
+ |"- (l::'a::linordered_idom) \<le> m"
+ |"(l::'a::linordered_idom) \<le> - m") =
{* fn phi => Numeral_Simprocs.le_cancel_numerals *}
simproc_setup ring_eq_cancel_numeral_factor
- ("(l::'a::{idom,ring_char_0,number_ring}) * m = n"
- |"(l::'a::{idom,ring_char_0,number_ring}) = m * n") =
+ ("(l::'a::{idom,ring_char_0}) * m = n"
+ |"(l::'a::{idom,ring_char_0}) = m * n") =
{* fn phi => Numeral_Simprocs.eq_cancel_numeral_factor *}
simproc_setup ring_less_cancel_numeral_factor
- ("(l::'a::{linordered_idom,number_ring}) * m < n"
- |"(l::'a::{linordered_idom,number_ring}) < m * n") =
+ ("(l::'a::linordered_idom) * m < n"
+ |"(l::'a::linordered_idom) < m * n") =
{* fn phi => Numeral_Simprocs.less_cancel_numeral_factor *}
simproc_setup ring_le_cancel_numeral_factor
- ("(l::'a::{linordered_idom,number_ring}) * m <= n"
- |"(l::'a::{linordered_idom,number_ring}) <= m * n") =
+ ("(l::'a::linordered_idom) * m <= n"
+ |"(l::'a::linordered_idom) <= m * n") =
{* fn phi => Numeral_Simprocs.le_cancel_numeral_factor *}
+(* TODO: remove comm_ring_1 constraint if possible *)
simproc_setup int_div_cancel_numeral_factors
- ("((l::'a::{semiring_div,ring_char_0,number_ring}) * m) div n"
- |"(l::'a::{semiring_div,ring_char_0,number_ring}) div (m * n)") =
+ ("((l::'a::{semiring_div,comm_ring_1,ring_char_0}) * m) div n"
+ |"(l::'a::{semiring_div,comm_ring_1,ring_char_0}) div (m * n)") =
{* fn phi => Numeral_Simprocs.div_cancel_numeral_factor *}
simproc_setup divide_cancel_numeral_factor
- ("((l::'a::{field_inverse_zero,ring_char_0,number_ring}) * m) / n"
- |"(l::'a::{field_inverse_zero,ring_char_0,number_ring}) / (m * n)"
- |"((number_of v)::'a::{field_inverse_zero,ring_char_0,number_ring}) / (number_of w)") =
+ ("((l::'a::{field_inverse_zero,ring_char_0}) * m) / n"
+ |"(l::'a::{field_inverse_zero,ring_char_0}) / (m * n)"
+ |"((numeral v)::'a::{field_inverse_zero,ring_char_0}) / (numeral w)") =
{* fn phi => Numeral_Simprocs.divide_cancel_numeral_factor *}
simproc_setup ring_eq_cancel_factor
@@ -270,19 +272,25 @@
("((l::nat) * m) dvd n" | "(l::nat) dvd (m * n)") =
{* fn phi => Nat_Numeral_Simprocs.dvd_cancel_factor *}
+(* FIXME: duplicate rule warnings for:
+ ring_distribs
+ numeral_plus_numeral numeral_times_numeral
+ numeral_eq_iff numeral_less_iff numeral_le_iff
+ numeral_neq_zero zero_neq_numeral zero_less_numeral
+ if_True if_False *)
declaration {*
- K (Lin_Arith.add_simps (@{thms neg_simps} @ [@{thm Suc_nat_number_of}, @{thm int_nat_number_of}])
- #> Lin_Arith.add_simps (@{thms ring_distribs} @ [@{thm Let_number_of}, @{thm Let_0}, @{thm Let_1},
+ K (Lin_Arith.add_simps ([@{thm Suc_numeral}, @{thm int_numeral}])
+ #> Lin_Arith.add_simps (@{thms ring_distribs} @ [@{thm Let_numeral}, @{thm Let_neg_numeral}, @{thm Let_0}, @{thm Let_1},
@{thm nat_0}, @{thm nat_1},
- @{thm add_nat_number_of}, @{thm diff_nat_number_of}, @{thm mult_nat_number_of},
- @{thm eq_nat_number_of}, @{thm less_nat_number_of}, @{thm le_number_of_eq_not_less},
- @{thm le_Suc_number_of}, @{thm le_number_of_Suc},
- @{thm less_Suc_number_of}, @{thm less_number_of_Suc},
- @{thm Suc_eq_number_of}, @{thm eq_number_of_Suc},
+ @{thm numeral_plus_numeral}, @{thm diff_nat_numeral}, @{thm numeral_times_numeral},
+ @{thm numeral_eq_iff}, @{thm numeral_less_iff}, @{thm numeral_le_iff},
+ @{thm le_Suc_numeral}, @{thm le_numeral_Suc},
+ @{thm less_Suc_numeral}, @{thm less_numeral_Suc},
+ @{thm Suc_eq_numeral}, @{thm eq_numeral_Suc},
@{thm mult_Suc}, @{thm mult_Suc_right},
@{thm add_Suc}, @{thm add_Suc_right},
- @{thm eq_number_of_0}, @{thm eq_0_number_of}, @{thm less_0_number_of},
- @{thm of_int_number_of_eq}, @{thm of_nat_number_of_eq}, @{thm nat_number_of},
+ @{thm numeral_neq_zero}, @{thm zero_neq_numeral}, @{thm zero_less_numeral},
+ @{thm of_int_numeral}, @{thm of_nat_numeral}, @{thm nat_numeral},
@{thm if_True}, @{thm if_False}])
#> Lin_Arith.add_simprocs
[@{simproc semiring_assoc_fold},
--- a/src/HOL/Parity.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Parity.thy Mon Mar 26 15:33:28 2012 +0200
@@ -45,9 +45,11 @@
lemma odd_1_nat [simp]: "odd (1::nat)" by presburger
-declare even_def[of "number_of v", simp] for v
+(* TODO: proper simp rules for Num.Bit0, Num.Bit1 *)
+declare even_def[of "numeral v", simp] for v
+declare even_def[of "neg_numeral v", simp] for v
-declare even_nat_def[of "number_of v", simp] for v
+declare even_nat_def[of "numeral v", simp] for v
subsection {* Even and odd are mutually exclusive *}
@@ -197,18 +199,18 @@
using minus_one_even_odd_power by blast
lemma neg_one_even_odd_power:
- "(even x --> (-1::'a::{number_ring})^x = 1) &
+ "(even x --> (-1::'a::{comm_ring_1})^x = 1) &
(odd x --> (-1::'a)^x = -1)"
apply (induct x)
apply (simp, simp)
done
lemma neg_one_even_power [simp]:
- "even x ==> (-1::'a::{number_ring})^x = 1"
+ "even x ==> (-1::'a::{comm_ring_1})^x = 1"
using neg_one_even_odd_power by blast
lemma neg_one_odd_power [simp]:
- "odd x ==> (-1::'a::{number_ring})^x = -1"
+ "odd x ==> (-1::'a::{comm_ring_1})^x = -1"
using neg_one_even_odd_power by blast
lemma neg_power_if:
@@ -347,27 +349,28 @@
text {* Simplify, when the exponent is a numeral *}
-lemmas power_0_left_number_of = power_0_left [of "number_of w"] for w
-declare power_0_left_number_of [simp]
+lemma power_0_left_numeral [simp]:
+ "0 ^ numeral w = (0::'a::{power,semiring_0})"
+by (simp add: power_0_left)
-lemmas zero_le_power_eq_number_of [simp] =
- zero_le_power_eq [of _ "number_of w"] for w
+lemmas zero_le_power_eq_numeral [simp] =
+ zero_le_power_eq [of _ "numeral w"] for w
-lemmas zero_less_power_eq_number_of [simp] =
- zero_less_power_eq [of _ "number_of w"] for w
+lemmas zero_less_power_eq_numeral [simp] =
+ zero_less_power_eq [of _ "numeral w"] for w
-lemmas power_le_zero_eq_number_of [simp] =
- power_le_zero_eq [of _ "number_of w"] for w
+lemmas power_le_zero_eq_numeral [simp] =
+ power_le_zero_eq [of _ "numeral w"] for w
-lemmas power_less_zero_eq_number_of [simp] =
- power_less_zero_eq [of _ "number_of w"] for w
+lemmas power_less_zero_eq_numeral [simp] =
+ power_less_zero_eq [of _ "numeral w"] for w
-lemmas zero_less_power_nat_eq_number_of [simp] =
- zero_less_power_nat_eq [of _ "number_of w"] for w
+lemmas zero_less_power_nat_eq_numeral [simp] =
+ zero_less_power_nat_eq [of _ "numeral w"] for w
-lemmas power_eq_0_iff_number_of [simp] = power_eq_0_iff [of _ "number_of w"] for w
+lemmas power_eq_0_iff_numeral [simp] = power_eq_0_iff [of _ "numeral w"] for w
-lemmas power_even_abs_number_of [simp] = power_even_abs [of "number_of w" _] for w
+lemmas power_even_abs_numeral [simp] = power_even_abs [of "numeral w" _] for w
subsection {* An Equivalence for @{term [source] "0 \<le> a^n"} *}
--- a/src/HOL/Plain.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Plain.thy Mon Mar 26 15:33:28 2012 +0200
@@ -1,7 +1,7 @@
header {* Plain HOL *}
theory Plain
-imports Datatype FunDef Extraction Metis
+imports Datatype FunDef Extraction Metis Num
begin
text {*
--- a/src/HOL/Predicate_Compile_Examples/Predicate_Compile_Tests.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Predicate_Compile_Examples/Predicate_Compile_Tests.thy Mon Mar 26 15:33:28 2012 +0200
@@ -334,7 +334,7 @@
code_pred [dseq] one_or_two .
code_pred [random_dseq] one_or_two .
thm one_or_two.dseq_equation
-values [expected "{Suc 0::nat, 2::nat}"] "{x. one_or_two x}"
+values [expected "{1::nat, 2::nat}"] "{x. one_or_two x}"
values [random_dseq 0,0,10] 3 "{x. one_or_two x}"
inductive one_or_two' :: "nat => bool"
@@ -442,7 +442,7 @@
values "{ys. append [0, Suc 0, 2] ys [0, Suc 0, 2, 17, 0, 5]}"
values [expected "{}" dseq 0] 10 "{(xs, ys). append xs ys [1, 2, 3, 4, (5::nat)]}"
-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)]}"
+values [expected "{(([]::nat list), [1, 2, 3, 4, (5::nat)])}" dseq 1] 10 "{(xs, ys). append xs ys [1, 2, 3, 4, (5::nat)]}"
values [dseq 4] 10 "{(xs, ys). append xs ys [1, 2, 3, 4, (5::nat)]}"
values [dseq 6] 10 "{(xs, ys). append xs ys [1, 2, 3, 4, (5::nat)]}"
values [random_dseq 1, 1, 4] 10 "{(xs, ys). append xs ys [1, 2, 3, 4, (5::nat)]}"
@@ -1241,8 +1241,8 @@
values [expected "{2::nat}"] "{x. plus_nat_test x 7 9}"
values [expected "{}"] "{x. plus_nat_test x 9 7}"
values [expected "{(0::nat,0::nat)}"] "{(x, y). plus_nat_test x y 0}"
-values [expected "{(0, Suc 0), (Suc 0, 0)}"] "{(x, y). plus_nat_test x y 1}"
-values [expected "{(0, 5), (4, Suc 0), (3, 2), (2, 3), (Suc 0, 4), (5, 0)}"]
+values [expected "{(0::nat, 1::nat), (1, 0)}"] "{(x, y). plus_nat_test x y 1}"
+values [expected "{(0::nat, 5::nat), (4, 1), (3, 2), (2, 3), (1, 4), (5, 0)}"]
"{(x, y). plus_nat_test x y 5}"
inductive minus_nat_test :: "nat => nat => nat => bool"
@@ -1259,7 +1259,7 @@
values [expected "{5::nat}"] "{z. minus_nat_test 7 2 z}"
values [expected "{16::nat}"] "{x. minus_nat_test x 7 9}"
values [expected "{16::nat}"] "{x. minus_nat_test x 9 7}"
-values [expected "{0, Suc 0, 2, 3}"] "{x. minus_nat_test x 3 0}"
+values [expected "{0::nat, 1, 2, 3}"] "{x. minus_nat_test x 3 0}"
values [expected "{0::nat}"] "{x. minus_nat_test x 0 0}"
subsection {* Examples on int *}
--- a/src/HOL/Presburger.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Presburger.thy Mon Mar 26 15:33:28 2012 +0200
@@ -374,18 +374,16 @@
((y \<le> x \<longrightarrow> P (int x - int y)) \<and> (x < y \<longrightarrow> P 0))"
by (cases "y \<le> x") (simp_all add: zdiff_int)
-lemma number_of1: "(0::int) <= number_of n \<Longrightarrow> (0::int) <= number_of (Int.Bit0 n) \<and> (0::int) <= number_of (Int.Bit1 n)"
-by simp
-
-lemma number_of2: "(0::int) <= Numeral0" by simp
-
text {*
\medskip Specific instances of congruence rules, to prevent
simplifier from looping. *}
-theorem imp_le_cong: "(0 <= x \<Longrightarrow> P = P') \<Longrightarrow> (0 <= (x::int) \<longrightarrow> P) = (0 <= x \<longrightarrow> P')" by simp
+theorem imp_le_cong:
+ "\<lbrakk>x = x'; 0 \<le> x' \<Longrightarrow> P = P'\<rbrakk> \<Longrightarrow> (0 \<le> (x::int) \<longrightarrow> P) = (0 \<le> x' \<longrightarrow> P')"
+ by simp
-theorem conj_le_cong: "(0 <= x \<Longrightarrow> P = P') \<Longrightarrow> (0 <= (x::int) \<and> P) = (0 <= x \<and> P')"
+theorem conj_le_cong:
+ "\<lbrakk>x = x'; 0 \<le> x' \<Longrightarrow> P = P'\<rbrakk> \<Longrightarrow> (0 \<le> (x::int) \<and> P) = (0 \<le> x' \<and> P')"
by (simp cong: conj_cong)
use "Tools/Qelim/cooper.ML"
--- a/src/HOL/Quickcheck_Examples/Quickcheck_Narrowing_Examples.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Quickcheck_Examples/Quickcheck_Narrowing_Examples.thy Mon Mar 26 15:33:28 2012 +0200
@@ -79,15 +79,14 @@
quickcheck[tester = narrowing, finite_types = false, default_type = nat, expect = counterexample]
oops
-(* FIXME: integer has strange representation! *)
lemma "rev xs = xs"
quickcheck[tester = narrowing, finite_types = false, default_type = int, expect = counterexample]
oops
-(*
+
lemma "rev xs = xs"
quickcheck[tester = narrowing, finite_types = true, expect = counterexample]
oops
-*)
+
subsection {* Simple examples with functions *}
lemma "map f xs = map g xs"
--- a/src/HOL/Quickcheck_Narrowing.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Quickcheck_Narrowing.thy Mon Mar 26 15:33:28 2012 +0200
@@ -70,34 +70,15 @@
"HOL.equal k l \<longleftrightarrow> HOL.equal (int_of k) (int_of l)"
instance proof
-qed (auto simp add: equal_code_int_def equal_int_def eq_int_refl)
+qed (auto simp add: equal_code_int_def equal_int_def equal_int_refl)
end
-instantiation code_int :: number
-begin
-
-definition
- "number_of = of_int"
-
-instance ..
-
-end
-
-lemma int_of_number [simp]:
- "int_of (number_of k) = number_of k"
- by (simp add: number_of_code_int_def number_of_is_id)
-
-
definition nat_of :: "code_int => nat"
where
"nat_of i = nat (int_of i)"
-
-
-code_datatype "number_of \<Colon> int \<Rightarrow> code_int"
-
-instantiation code_int :: "{minus, linordered_semidom, semiring_div, linorder}"
+instantiation code_int :: "{minus, linordered_semidom, semiring_div, neg_numeral, linorder}"
begin
definition [simp, code del]:
@@ -110,6 +91,9 @@
"n + m = of_int (int_of n + int_of m)"
definition [simp, code del]:
+ "- n = of_int (- int_of n)"
+
+definition [simp, code del]:
"n - m = of_int (int_of n - int_of m)"
definition [simp, code del]:
@@ -127,34 +111,43 @@
definition [simp, code del]:
"n < m \<longleftrightarrow> int_of n < int_of m"
-
instance proof
qed (auto simp add: code_int left_distrib zmult_zless_mono2)
end
-lemma zero_code_int_code [code, code_unfold]:
- "(0\<Colon>code_int) = Numeral0"
- by (simp add: number_of_code_int_def Pls_def)
+lemma int_of_numeral [simp]:
+ "int_of (numeral k) = numeral k"
+ by (induct k) (simp_all only: numeral.simps plus_code_int_def
+ one_code_int_def of_int_inverse UNIV_I)
+
+definition Num :: "num \<Rightarrow> code_int"
+ where [code_abbrev]: "Num = numeral"
+
+lemma [code_abbrev]:
+ "- numeral k = (neg_numeral k :: code_int)"
+ by (unfold neg_numeral_def) simp
+
+code_datatype "0::code_int" Num
lemma one_code_int_code [code, code_unfold]:
"(1\<Colon>code_int) = Numeral1"
- by (simp add: number_of_code_int_def Pls_def Bit1_def)
+ by (simp only: numeral.simps)
-definition div_mod_code_int :: "code_int \<Rightarrow> code_int \<Rightarrow> code_int \<times> code_int" where
- [code del]: "div_mod_code_int n m = (n div m, n mod m)"
+definition div_mod :: "code_int \<Rightarrow> code_int \<Rightarrow> code_int \<times> code_int" where
+ [code del]: "div_mod n m = (n div m, n mod m)"
lemma [code]:
- "div_mod_code_int n m = (if m = 0 then (0, n) else (n div m, n mod m))"
- unfolding div_mod_code_int_def by auto
+ "div_mod n m = (if m = 0 then (0, n) else (n div m, n mod m))"
+ unfolding div_mod_def by auto
lemma [code]:
- "n div m = fst (div_mod_code_int n m)"
- unfolding div_mod_code_int_def by simp
+ "n div m = fst (div_mod n m)"
+ unfolding div_mod_def by simp
lemma [code]:
- "n mod m = snd (div_mod_code_int n m)"
- unfolding div_mod_code_int_def by simp
+ "n mod m = snd (div_mod n m)"
+ unfolding div_mod_def by simp
lemma int_of_code [code]:
"int_of k = (if k = 0 then 0
@@ -172,9 +165,12 @@
code_instance code_numeral :: equal
(Haskell_Quickcheck -)
-setup {* fold (Numeral.add_code @{const_name number_code_int_inst.number_of_code_int}
+setup {* fold (Numeral.add_code @{const_name Num}
false Code_Printer.literal_numeral) ["Haskell_Quickcheck"] *}
+code_type code_int
+ (Haskell_Quickcheck "Int")
+
code_const "0 \<Colon> code_int"
(Haskell_Quickcheck "0")
@@ -182,24 +178,23 @@
(Haskell_Quickcheck "1")
code_const "minus \<Colon> code_int \<Rightarrow> code_int \<Rightarrow> code_int"
- (Haskell_Quickcheck "(_/ -/ _)")
+ (Haskell_Quickcheck infixl 6 "-")
-code_const div_mod_code_int
+code_const div_mod
(Haskell_Quickcheck "divMod")
code_const "HOL.equal \<Colon> code_int \<Rightarrow> code_int \<Rightarrow> bool"
(Haskell_Quickcheck infix 4 "==")
-code_const "op \<le> \<Colon> code_int \<Rightarrow> code_int \<Rightarrow> bool"
+code_const "less_eq \<Colon> code_int \<Rightarrow> code_int \<Rightarrow> bool"
(Haskell_Quickcheck infix 4 "<=")
-code_const "op < \<Colon> code_int \<Rightarrow> code_int \<Rightarrow> bool"
+code_const "less \<Colon> code_int \<Rightarrow> code_int \<Rightarrow> bool"
(Haskell_Quickcheck infix 4 "<")
-code_type code_int
- (Haskell_Quickcheck "Int")
+code_abort of_int
-code_abort of_int
+hide_const (open) Num div_mod
subsubsection {* Narrowing's deep representation of types and terms *}
--- a/src/HOL/Quotient_Examples/Quotient_Rat.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Quotient_Examples/Quotient_Rat.thy Mon Mar 26 15:33:28 2012 +0200
@@ -159,17 +159,6 @@
apply auto
done
-instantiation rat :: number_ring
-begin
-
-definition
- rat_number_of_def: "number_of w = Fract w 1"
-
-instance apply default
- unfolding rat_number_of_def of_int_rat ..
-
-end
-
instantiation rat :: field_inverse_zero begin
fun rat_inverse_raw where
--- a/src/HOL/RComplete.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/RComplete.thy Mon Mar 26 15:33:28 2012 +0200
@@ -129,26 +129,27 @@
subsection{*Floor and Ceiling Functions from the Reals to the Integers*}
-lemma number_of_less_real_of_int_iff [simp]:
- "((number_of n) < real (m::int)) = (number_of n < m)"
+(* FIXME: theorems for negative numerals *)
+lemma numeral_less_real_of_int_iff [simp]:
+ "((numeral n) < real (m::int)) = (numeral n < m)"
apply auto
apply (rule real_of_int_less_iff [THEN iffD1])
apply (drule_tac [2] real_of_int_less_iff [THEN iffD2], auto)
done
-lemma number_of_less_real_of_int_iff2 [simp]:
- "(real (m::int) < (number_of n)) = (m < number_of n)"
+lemma numeral_less_real_of_int_iff2 [simp]:
+ "(real (m::int) < (numeral n)) = (m < numeral n)"
apply auto
apply (rule real_of_int_less_iff [THEN iffD1])
apply (drule_tac [2] real_of_int_less_iff [THEN iffD2], auto)
done
-lemma number_of_le_real_of_int_iff [simp]:
- "((number_of n) \<le> real (m::int)) = (number_of n \<le> m)"
+lemma numeral_le_real_of_int_iff [simp]:
+ "((numeral n) \<le> real (m::int)) = (numeral n \<le> m)"
by (simp add: linorder_not_less [symmetric])
-lemma number_of_le_real_of_int_iff2 [simp]:
- "(real (m::int) \<le> (number_of n)) = (m \<le> number_of n)"
+lemma numeral_le_real_of_int_iff2 [simp]:
+ "(real (m::int) \<le> (numeral n)) = (m \<le> numeral n)"
by (simp add: linorder_not_less [symmetric])
lemma floor_real_of_nat [simp]: "floor (real (n::nat)) = int n"
@@ -323,7 +324,7 @@
lemma zero_le_natfloor [simp]: "0 <= natfloor x"
by (unfold natfloor_def, simp)
-lemma natfloor_number_of_eq [simp]: "natfloor (number_of n) = number_of n"
+lemma natfloor_numeral_eq [simp]: "natfloor (numeral n) = numeral n"
by (unfold natfloor_def, simp)
lemma natfloor_real_of_nat [simp]: "natfloor(real n) = n"
@@ -365,9 +366,9 @@
apply (erule le_natfloor)
done
-lemma le_natfloor_eq_number_of [simp]:
- "~ neg((number_of n)::int) ==> 0 <= x ==>
- (number_of n <= natfloor x) = (number_of n <= x)"
+lemma le_natfloor_eq_numeral [simp]:
+ "~ neg((numeral n)::int) ==> 0 <= x ==>
+ (numeral n <= natfloor x) = (numeral n <= x)"
apply (subst le_natfloor_eq, assumption)
apply simp
done
@@ -407,9 +408,9 @@
unfolding real_of_int_of_nat_eq [symmetric] floor_add
by (simp add: nat_add_distrib)
-lemma natfloor_add_number_of [simp]:
- "~neg ((number_of n)::int) ==> 0 <= x ==>
- natfloor (x + number_of n) = natfloor x + number_of n"
+lemma natfloor_add_numeral [simp]:
+ "~neg ((numeral n)::int) ==> 0 <= x ==>
+ natfloor (x + numeral n) = natfloor x + numeral n"
by (simp add: natfloor_add [symmetric])
lemma natfloor_add_one: "0 <= x ==> natfloor(x + 1) = natfloor x + 1"
@@ -453,7 +454,7 @@
lemma zero_le_natceiling [simp]: "0 <= natceiling x"
by (unfold natceiling_def, simp)
-lemma natceiling_number_of_eq [simp]: "natceiling (number_of n) = number_of n"
+lemma natceiling_numeral_eq [simp]: "natceiling (numeral n) = numeral n"
by (unfold natceiling_def, simp)
lemma natceiling_real_of_nat [simp]: "natceiling(real n) = n"
@@ -476,9 +477,9 @@
unfolding natceiling_def real_of_nat_def
by (simp add: nat_le_iff ceiling_le_iff)
-lemma natceiling_le_eq_number_of [simp]:
- "~ neg((number_of n)::int) ==>
- (natceiling x <= number_of n) = (x <= number_of n)"
+lemma natceiling_le_eq_numeral [simp]:
+ "~ neg((numeral n)::int) ==>
+ (natceiling x <= numeral n) = (x <= numeral n)"
by (simp add: natceiling_le_eq)
lemma natceiling_le_eq_one: "(natceiling x <= 1) = (x <= 1)"
@@ -495,9 +496,9 @@
unfolding real_of_int_of_nat_eq [symmetric] ceiling_add
by (simp add: nat_add_distrib)
-lemma natceiling_add_number_of [simp]:
- "~ neg ((number_of n)::int) ==> 0 <= x ==>
- natceiling (x + number_of n) = natceiling x + number_of n"
+lemma natceiling_add_numeral [simp]:
+ "~ neg ((numeral n)::int) ==> 0 <= x ==>
+ natceiling (x + numeral n) = natceiling x + numeral n"
by (simp add: natceiling_add [symmetric])
lemma natceiling_add_one: "0 <= x ==> natceiling(x + 1) = natceiling x + 1"
--- a/src/HOL/Rat.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/Rat.thy Mon Mar 26 15:33:28 2012 +0200
@@ -230,35 +230,23 @@
lemma Fract_of_int_eq: "Fract k 1 = of_int k"
by (rule of_int_rat [symmetric])
-instantiation rat :: number_ring
-begin
-
-definition
- rat_number_of_def: "number_of w = Fract w 1"
-
-instance proof
-qed (simp add: rat_number_of_def of_int_rat)
-
-end
-
lemma rat_number_collapse:
"Fract 0 k = 0"
"Fract 1 1 = 1"
- "Fract (number_of k) 1 = number_of k"
+ "Fract (numeral w) 1 = numeral w"
+ "Fract (neg_numeral w) 1 = neg_numeral w"
"Fract k 0 = 0"
- by (cases "k = 0")
- (simp_all add: Zero_rat_def One_rat_def number_of_is_id number_of_eq of_int_rat eq_rat Fract_def)
+ using Fract_of_int_eq [of "numeral w"]
+ using Fract_of_int_eq [of "neg_numeral w"]
+ by (simp_all add: Zero_rat_def One_rat_def eq_rat)
-lemma rat_number_expand [code_unfold]:
+lemma rat_number_expand:
"0 = Fract 0 1"
"1 = Fract 1 1"
- "number_of k = Fract (number_of k) 1"
+ "numeral k = Fract (numeral k) 1"
+ "neg_numeral k = Fract (neg_numeral k) 1"
by (simp_all add: rat_number_collapse)
-lemma iszero_rat [simp]:
- "iszero (number_of k :: rat) \<longleftrightarrow> iszero (number_of k :: int)"
- by (simp add: iszero_def rat_number_expand number_of_is_id eq_rat)
-
lemma Rat_cases_nonzero [case_names Fract 0]:
assumes Fract: "\<And>a b. q = Fract a b \<Longrightarrow> b > 0 \<Longrightarrow> a \<noteq> 0 \<Longrightarrow> coprime a b \<Longrightarrow> C"
assumes 0: "q = 0 \<Longrightarrow> C"
@@ -386,7 +374,8 @@
lemma quotient_of_number [simp]:
"quotient_of 0 = (0, 1)"
"quotient_of 1 = (1, 1)"
- "quotient_of (number_of k) = (number_of k, 1)"
+ "quotient_of (numeral k) = (numeral k, 1)"
+ "quotient_of (neg_numeral k) = (neg_numeral k, 1)"
by (simp_all add: rat_number_expand quotient_of_Fract)
lemma quotient_of_eq: "quotient_of (Fract a b) = (p, q) \<Longrightarrow> Fract p q = Fract a b"
@@ -453,19 +442,12 @@
subsubsection {* Various *}
-lemma Fract_add_one: "n \<noteq> 0 ==> Fract (m + n) n = Fract m n + 1"
- by (simp add: rat_number_expand)
-
lemma Fract_of_int_quotient: "Fract k l = of_int k / of_int l"
by (simp add: Fract_of_int_eq [symmetric])
-lemma Fract_number_of_quotient:
- "Fract (number_of k) (number_of l) = number_of k / number_of l"
- unfolding Fract_of_int_quotient number_of_is_id number_of_eq ..
+lemma Fract_add_one: "n \<noteq> 0 ==> Fract (m + n) n = Fract m n + 1"
+ by (simp add: rat_number_expand)
-lemma Fract_1_number_of:
- "Fract 1 (number_of k) = 1 / number_of k"
- unfolding Fract_of_int_quotient number_of_eq by simp
subsubsection {* The ordered field of rational numbers *}
@@ -771,7 +753,8 @@
(* not needed because x < (y::int) can be rewritten as x + 1 <= y: of_int_less_iff RS iffD2 *)
#> Lin_Arith.add_simps [@{thm neg_less_iff_less},
@{thm True_implies_equals},
- read_instantiate @{context} [(("a", 0), "(number_of ?v)")] @{thm right_distrib},
+ read_instantiate @{context} [(("a", 0), "(numeral ?v)")] @{thm right_distrib},
+ read_instantiate @{context} [(("a", 0), "(neg_numeral ?v)")] @{thm right_distrib},
@{thm divide_1}, @{thm divide_zero_left},
@{thm times_divide_eq_right}, @{thm times_divide_eq_left},
@{thm minus_divide_left} RS sym, @{thm minus_divide_right} RS sym,
@@ -895,9 +878,13 @@
lemma of_rat_of_int_eq [simp]: "of_rat (of_int z) = of_int z"
by (cases z rule: int_diff_cases) (simp add: of_rat_diff)
-lemma of_rat_number_of_eq [simp]:
- "of_rat (number_of w) = (number_of w :: 'a::{number_ring,field_char_0})"
-by (simp add: number_of_eq)
+lemma of_rat_numeral_eq [simp]:
+ "of_rat (numeral w) = numeral w"
+using of_rat_of_int_eq [of "numeral w"] by simp
+
+lemma of_rat_neg_numeral_eq [simp]:
+ "of_rat (neg_numeral w) = neg_numeral w"
+using of_rat_of_int_eq [of "neg_numeral w"] by simp
lemmas zero_rat = Zero_rat_def
lemmas one_rat = One_rat_def
@@ -935,9 +922,11 @@
lemma Rats_of_nat [simp]: "of_nat n \<in> Rats"
by (subst of_rat_of_nat_eq [symmetric], rule Rats_of_rat)
-lemma Rats_number_of [simp]:
- "(number_of w::'a::{number_ring,field_char_0}) \<in> Rats"
-by (subst of_rat_number_of_eq [symmetric], rule Rats_of_rat)
+lemma Rats_number_of [simp]: "numeral w \<in> Rats"
+by (subst of_rat_numeral_eq [symmetric], rule Rats_of_rat)
+
+lemma Rats_neg_number_of [simp]: "neg_numeral w \<in> Rats"
+by (subst of_rat_neg_numeral_eq [symmetric], rule Rats_of_rat)
lemma Rats_0 [simp]: "0 \<in> Rats"
apply (unfold Rats_def)
@@ -1032,6 +1021,8 @@
subsection {* Implementation of rational numbers as pairs of integers *}
+text {* Formal constructor *}
+
definition Frct :: "int \<times> int \<Rightarrow> rat" where
[simp]: "Frct p = Fract (fst p) (snd p)"
@@ -1039,17 +1030,45 @@
"Frct (quotient_of q) = q"
by (cases q) (auto intro: quotient_of_eq)
-lemma Frct_code_post [code_post]:
- "Frct (0, k) = 0"
- "Frct (k, 0) = 0"
- "Frct (1, 1) = 1"
- "Frct (number_of k, 1) = number_of k"
- "Frct (1, number_of k) = 1 / number_of k"
- "Frct (number_of k, number_of l) = number_of k / number_of l"
- by (simp_all add: rat_number_collapse Fract_number_of_quotient Fract_1_number_of)
+
+text {* Numerals *}
declare quotient_of_Fract [code abstract]
+definition of_int :: "int \<Rightarrow> rat"
+where
+ [code_abbrev]: "of_int = Int.of_int"
+hide_const (open) of_int
+
+lemma quotient_of_int [code abstract]:
+ "quotient_of (Rat.of_int a) = (a, 1)"
+ by (simp add: of_int_def of_int_rat quotient_of_Fract)
+
+lemma [code_unfold]:
+ "numeral k = Rat.of_int (numeral k)"
+ by (simp add: Rat.of_int_def)
+
+lemma [code_unfold]:
+ "neg_numeral k = Rat.of_int (neg_numeral k)"
+ by (simp add: Rat.of_int_def)
+
+lemma Frct_code_post [code_post]:
+ "Frct (0, a) = 0"
+ "Frct (a, 0) = 0"
+ "Frct (1, 1) = 1"
+ "Frct (numeral k, 1) = numeral k"
+ "Frct (neg_numeral k, 1) = neg_numeral k"
+ "Frct (1, numeral k) = 1 / numeral k"
+ "Frct (1, neg_numeral k) = 1 / neg_numeral k"
+ "Frct (numeral k, numeral l) = numeral k / numeral l"
+ "Frct (numeral k, neg_numeral l) = numeral k / neg_numeral l"
+ "Frct (neg_numeral k, numeral l) = neg_numeral k / numeral l"
+ "Frct (neg_numeral k, neg_numeral l) = neg_numeral k / neg_numeral l"
+ by (simp_all add: Fract_of_int_quotient)
+
+
+text {* Operations *}
+
lemma rat_zero_code [code abstract]:
"quotient_of 0 = (0, 1)"
by (simp add: Zero_rat_def quotient_of_Fract normalize_def)
@@ -1132,6 +1151,9 @@
"of_rat p = (let (a, b) = quotient_of p in of_int a / of_int b)"
by (cases p) (simp add: quotient_of_Fract of_rat_rat)
+
+text {* Quickcheck *}
+
definition (in term_syntax)
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
[code_unfold]: "valterm_fract k l = Code_Evaluation.valtermify Fract {\<cdot>} k {\<cdot>} l"
@@ -1212,7 +1234,6 @@
(@{const_name plus_rat_inst.plus_rat}, @{const_name Nitpick.plus_frac}),
(@{const_name times_rat_inst.times_rat}, @{const_name Nitpick.times_frac}),
(@{const_name uminus_rat_inst.uminus_rat}, @{const_name Nitpick.uminus_frac}),
- (@{const_name number_rat_inst.number_of_rat}, @{const_name Nitpick.number_of_frac}),
(@{const_name inverse_rat_inst.inverse_rat}, @{const_name Nitpick.inverse_frac}),
(@{const_name ord_rat_inst.less_rat}, @{const_name Nitpick.less_frac}),
(@{const_name ord_rat_inst.less_eq_rat}, @{const_name Nitpick.less_eq_frac}),
@@ -1220,7 +1241,7 @@
*}
lemmas [nitpick_unfold] = inverse_rat_inst.inverse_rat
- number_rat_inst.number_of_rat one_rat_inst.one_rat ord_rat_inst.less_rat
+ one_rat_inst.one_rat ord_rat_inst.less_rat
ord_rat_inst.less_eq_rat plus_rat_inst.plus_rat times_rat_inst.times_rat
uminus_rat_inst.uminus_rat zero_rat_inst.zero_rat
--- a/src/HOL/RealDef.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/RealDef.thy Mon Mar 26 15:33:28 2012 +0200
@@ -720,7 +720,9 @@
unfolding less_eq_real_def less_real_def
by (auto, drule (1) positive_add, simp add: positive_zero)
show "a \<le> b \<Longrightarrow> c + a \<le> c + b"
- unfolding less_eq_real_def less_real_def by auto
+ unfolding less_eq_real_def less_real_def by (auto simp: diff_minus) (* by auto *)
+ (* FIXME: Procedure int_combine_numerals: c + b - (c + a) \<equiv> b + - a *)
+ (* Should produce c + b - (c + a) \<equiv> b - a *)
show "sgn a = (if a = 0 then 0 else if 0 < a then 1 else - 1)"
by (rule sgn_real_def)
show "a \<le> b \<or> b \<le> a"
@@ -747,17 +749,6 @@
end
-instantiation real :: number_ring
-begin
-
-definition
- "(number_of x :: real) = of_int x"
-
-instance proof
-qed (rule number_of_real_def)
-
-end
-
lemma of_nat_Real: "of_nat x = Real (\<lambda>n. of_nat x)"
apply (induct x)
apply (simp add: zero_real_def)
@@ -877,7 +868,7 @@
by (erule contrapos_pp, simp add: not_less, erule Real_leI [OF Y])
lemma of_nat_less_two_power:
- "of_nat n < (2::'a::{linordered_idom,number_ring}) ^ n"
+ "of_nat n < (2::'a::linordered_idom) ^ n"
apply (induct n)
apply simp
apply (subgoal_tac "(1::'a) \<le> 2 ^ n")
@@ -1469,18 +1460,19 @@
subsection{*Numerals and Arithmetic*}
lemma [code_abbrev]:
- "real_of_int (number_of k) = number_of k"
- unfolding number_of_is_id number_of_real_def ..
+ "real_of_int (numeral k) = numeral k"
+ "real_of_int (neg_numeral k) = neg_numeral k"
+ by simp_all
text{*Collapse applications of @{term real} to @{term number_of}*}
-lemma real_number_of [simp]: "real (number_of v :: int) = number_of v"
-by (simp add: real_of_int_def)
+lemma real_numeral [simp]:
+ "real (numeral v :: int) = numeral v"
+ "real (neg_numeral v :: int) = neg_numeral v"
+by (simp_all add: real_of_int_def)
-lemma real_of_nat_number_of [simp]:
- "real (number_of v :: nat) =
- (if neg (number_of v :: int) then 0
- else (number_of v :: real))"
-by (simp add: real_of_int_of_nat_eq [symmetric])
+lemma real_of_nat_numeral [simp]:
+ "real (numeral v :: nat) = numeral v"
+by (simp add: real_of_nat_def)
declaration {*
K (Lin_Arith.add_inj_thms [@{thm real_of_nat_le_iff} RS iffD2, @{thm real_of_nat_inject} RS iffD2]
@@ -1491,7 +1483,7 @@
@{thm real_of_nat_mult}, @{thm real_of_int_zero}, @{thm real_of_one},
@{thm real_of_int_add}, @{thm real_of_int_minus}, @{thm real_of_int_diff},
@{thm real_of_int_mult}, @{thm real_of_int_of_nat_eq},
- @{thm real_of_nat_number_of}, @{thm real_number_of}]
+ @{thm real_of_nat_numeral}, @{thm real_numeral(1)}, @{thm real_numeral(2)}]
#> Lin_Arith.add_inj_const (@{const_name real}, @{typ "nat \<Rightarrow> real"})
#> Lin_Arith.add_inj_const (@{const_name real}, @{typ "int \<Rightarrow> real"}))
*}
@@ -1605,37 +1597,61 @@
subsection {* Implementation of rational real numbers *}
+text {* Formal constructor *}
+
definition Ratreal :: "rat \<Rightarrow> real" where
- [simp]: "Ratreal = of_rat"
+ [code_abbrev, simp]: "Ratreal = of_rat"
code_datatype Ratreal
-lemma Ratreal_number_collapse [code_post]:
- "Ratreal 0 = 0"
- "Ratreal 1 = 1"
- "Ratreal (number_of k) = number_of k"
-by simp_all
+
+text {* Numerals *}
+
+lemma [code_abbrev]:
+ "(of_rat (of_int a) :: real) = of_int a"
+ by simp
+
+lemma [code_abbrev]:
+ "(of_rat 0 :: real) = 0"
+ by simp
+
+lemma [code_abbrev]:
+ "(of_rat 1 :: real) = 1"
+ by simp
+
+lemma [code_abbrev]:
+ "(of_rat (numeral k) :: real) = numeral k"
+ by simp
-lemma zero_real_code [code, code_unfold]:
+lemma [code_abbrev]:
+ "(of_rat (neg_numeral k) :: real) = neg_numeral k"
+ by simp
+
+lemma [code_post]:
+ "(of_rat (0 / r) :: real) = 0"
+ "(of_rat (r / 0) :: real) = 0"
+ "(of_rat (1 / 1) :: real) = 1"
+ "(of_rat (numeral k / 1) :: real) = numeral k"
+ "(of_rat (neg_numeral k / 1) :: real) = neg_numeral k"
+ "(of_rat (1 / numeral k) :: real) = 1 / numeral k"
+ "(of_rat (1 / neg_numeral k) :: real) = 1 / neg_numeral k"
+ "(of_rat (numeral k / numeral l) :: real) = numeral k / numeral l"
+ "(of_rat (numeral k / neg_numeral l) :: real) = numeral k / neg_numeral l"
+ "(of_rat (neg_numeral k / numeral l) :: real) = neg_numeral k / numeral l"
+ "(of_rat (neg_numeral k / neg_numeral l) :: real) = neg_numeral k / neg_numeral l"
+ by (simp_all add: of_rat_divide)
+
+
+text {* Operations *}
+
+lemma zero_real_code [code]:
"0 = Ratreal 0"
by simp
-lemma one_real_code [code, code_unfold]:
+lemma one_real_code [code]:
"1 = Ratreal 1"
by simp
-lemma number_of_real_code [code_unfold]:
- "number_of k = Ratreal (number_of k)"
-by simp
-
-lemma Ratreal_number_of_quotient [code_post]:
- "Ratreal (number_of r) / Ratreal (number_of s) = number_of r / number_of s"
-by simp
-
-lemma Ratreal_number_of_quotient2 [code_post]:
- "Ratreal (number_of r / number_of s) = number_of r / number_of s"
-unfolding Ratreal_number_of_quotient [symmetric] Ratreal_def of_rat_divide ..
-
instantiation real :: equal
begin
@@ -1681,6 +1697,9 @@
lemma real_floor_code [code]: "floor (Ratreal x) = floor x"
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)
+
+text {* Quickcheck *}
+
definition (in term_syntax)
valterm_ratreal :: "rat \<times> (unit \<Rightarrow> Code_Evaluation.term) \<Rightarrow> real \<times> (unit \<Rightarrow> Code_Evaluation.term)" where
[code_unfold]: "valterm_ratreal k = Code_Evaluation.valtermify Ratreal {\<cdot>} k"
@@ -1741,14 +1760,12 @@
(@{const_name plus_real_inst.plus_real}, @{const_name Nitpick.plus_frac}),
(@{const_name times_real_inst.times_real}, @{const_name Nitpick.times_frac}),
(@{const_name uminus_real_inst.uminus_real}, @{const_name Nitpick.uminus_frac}),
- (@{const_name number_real_inst.number_of_real}, @{const_name Nitpick.number_of_frac}),
(@{const_name inverse_real_inst.inverse_real}, @{const_name Nitpick.inverse_frac}),
(@{const_name ord_real_inst.less_real}, @{const_name Nitpick.less_frac}),
(@{const_name ord_real_inst.less_eq_real}, @{const_name Nitpick.less_eq_frac})]
*}
-lemmas [nitpick_unfold] = inverse_real_inst.inverse_real
- number_real_inst.number_of_real one_real_inst.one_real
+lemmas [nitpick_unfold] = inverse_real_inst.inverse_real one_real_inst.one_real
ord_real_inst.less_real ord_real_inst.less_eq_real plus_real_inst.plus_real
times_real_inst.times_real uminus_real_inst.uminus_real
zero_real_inst.zero_real
--- a/src/HOL/RealVector.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/RealVector.thy Mon Mar 26 15:33:28 2012 +0200
@@ -303,9 +303,11 @@
lemma of_real_of_int_eq [simp]: "of_real (of_int z) = of_int z"
by (cases z rule: int_diff_cases, simp)
-lemma of_real_number_of_eq:
- "of_real (number_of w) = (number_of w :: 'a::{number_ring,real_algebra_1})"
-by (simp add: number_of_eq)
+lemma of_real_numeral: "of_real (numeral w) = numeral w"
+using of_real_of_int_eq [of "numeral w"] by simp
+
+lemma of_real_neg_numeral: "of_real (neg_numeral w) = neg_numeral w"
+using of_real_of_int_eq [of "neg_numeral w"] by simp
text{*Every real algebra has characteristic zero*}
@@ -335,9 +337,11 @@
lemma Reals_of_nat [simp]: "of_nat n \<in> Reals"
by (subst of_real_of_nat_eq [symmetric], rule Reals_of_real)
-lemma Reals_number_of [simp]:
- "(number_of w::'a::{number_ring,real_algebra_1}) \<in> Reals"
-by (subst of_real_number_of_eq [symmetric], rule Reals_of_real)
+lemma Reals_numeral [simp]: "numeral w \<in> Reals"
+by (subst of_real_numeral [symmetric], rule Reals_of_real)
+
+lemma Reals_neg_numeral [simp]: "neg_numeral w \<in> Reals"
+by (subst of_real_neg_numeral [symmetric], rule Reals_of_real)
lemma Reals_0 [simp]: "0 \<in> Reals"
apply (unfold Reals_def)
@@ -752,10 +756,13 @@
"norm (of_real r :: 'a::real_normed_algebra_1) = \<bar>r\<bar>"
unfolding of_real_def by simp
-lemma norm_number_of [simp]:
- "norm (number_of w::'a::{number_ring,real_normed_algebra_1})
- = \<bar>number_of w\<bar>"
-by (subst of_real_number_of_eq [symmetric], rule norm_of_real)
+lemma norm_numeral [simp]:
+ "norm (numeral w::'a::real_normed_algebra_1) = numeral w"
+by (subst of_real_numeral [symmetric], subst norm_of_real, simp)
+
+lemma norm_neg_numeral [simp]:
+ "norm (neg_numeral w::'a::real_normed_algebra_1) = numeral w"
+by (subst of_real_neg_numeral [symmetric], subst norm_of_real, simp)
lemma norm_of_int [simp]:
"norm (of_int z::'a::real_normed_algebra_1) = \<bar>of_int z\<bar>"
--- a/src/HOL/SMT_Examples/SMT_Examples.certs Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/SMT_Examples/SMT_Examples.certs Mon Mar 26 15:33:28 2012 +0200
@@ -12775,3 +12775,110 @@
#247 := [asserted]: #123
[unit-resolution #247 #633]: false
unsat
+477e29453df08396d997096a4fc4a8771c735880 106 0
+#2 := false
+decl f7 :: S3
+#19 := f7
+decl f5 :: (-> S4 S3 S3)
+decl f6 :: S4
+#14 := f6
+#20 := (f5 f6 f7)
+#21 := (= #20 f7)
+#74 := (not #21)
+decl f1 :: S1
+#3 := f1
+decl f3 :: (-> S2 S1 S1)
+decl f4 :: S2
+#7 := f4
+#22 := (f3 f4 f1)
+#23 := (= #22 f1)
+#75 := (not #23)
+#558 := [hypothesis]: #75
+#8 := (:var 0 S1)
+#9 := (f3 f4 #8)
+#562 := (pattern #9)
+#11 := (= #8 f1)
+#10 := (= #9 f1)
+#12 := (iff #10 #11)
+#563 := (forall (vars (?v0 S1)) (:pat #562) #12)
+#13 := (forall (vars (?v0 S1)) #12)
+#566 := (iff #13 #563)
+#564 := (iff #12 #12)
+#565 := [refl]: #564
+#567 := [quant-intro #565]: #566
+#70 := (~ #13 #13)
+#68 := (~ #12 #12)
+#69 := [refl]: #68
+#71 := [nnf-pos #69]: #70
+#47 := [asserted]: #13
+#59 := [mp~ #47 #71]: #13
+#568 := [mp #59 #567]: #563
+#239 := (not #563)
+#218 := (or #239 #23)
+#146 := (= f1 f1)
+#147 := (iff #23 #146)
+#554 := (or #239 #147)
+#212 := (iff #554 #218)
+#550 := (iff #218 #218)
+#223 := [rewrite]: #550
+#238 := (iff #147 #23)
+#1 := true
+#24 := (iff #23 true)
+#50 := (iff #24 #23)
+#51 := [rewrite]: #50
+#236 := (iff #147 #24)
+#232 := (iff #146 true)
+#225 := [rewrite]: #232
+#237 := [monotonicity #225]: #236
+#235 := [trans #237 #51]: #238
+#343 := [monotonicity #235]: #212
+#224 := [trans #343 #223]: #212
+#556 := [quant-inst #3]: #554
+#557 := [mp #556 #224]: #218
+#559 := [unit-resolution #557 #568 #558]: false
+#560 := [lemma #559]: #23
+#64 := (or #74 #75)
+#52 := (and #21 #23)
+#55 := (not #52)
+#81 := (iff #55 #64)
+#65 := (not #64)
+#76 := (not #65)
+#79 := (iff #76 #64)
+#80 := [rewrite]: #79
+#77 := (iff #55 #76)
+#66 := (iff #52 #65)
+#67 := [rewrite]: #66
+#78 := [monotonicity #67]: #77
+#82 := [trans #78 #80]: #81
+#25 := (and #21 #24)
+#26 := (not #25)
+#56 := (iff #26 #55)
+#53 := (iff #25 #52)
+#54 := [monotonicity #51]: #53
+#57 := [monotonicity #54]: #56
+#49 := [asserted]: #26
+#60 := [mp #49 #57]: #55
+#83 := [mp #60 #82]: #64
+#555 := [unit-resolution #83 #560]: #74
+#15 := (:var 0 S3)
+#16 := (f5 f6 #15)
+#569 := (pattern #16)
+#17 := (= #16 #15)
+#570 := (forall (vars (?v0 S3)) (:pat #569) #17)
+#18 := (forall (vars (?v0 S3)) #17)
+#573 := (iff #18 #570)
+#571 := (iff #17 #17)
+#572 := [refl]: #571
+#574 := [quant-intro #572]: #573
+#62 := (~ #18 #18)
+#61 := (~ #17 #17)
+#72 := [refl]: #61
+#63 := [nnf-pos #72]: #62
+#48 := [asserted]: #18
+#73 := [mp~ #48 #63]: #18
+#575 := [mp #73 #574]: #570
+#551 := (not #570)
+#210 := (or #551 #21)
+#215 := [quant-inst #19]: #210
+[unit-resolution #215 #575 #555]: false
+unsat
--- a/src/HOL/SMT_Examples/SMT_Examples.thy Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/SMT_Examples/SMT_Examples.thy Mon Mar 26 15:33:28 2012 +0200
@@ -467,7 +467,7 @@
lemma "(f g (x::'a::type) = (g x \<and> True)) \<or> (f g x = True) \<or> (g x = True)"
by smt
-lemma "id 3 = 3 \<and> id True = True" by (smt id_def)
+lemma "id x = x \<and> id True = True" by (smt id_def)
lemma "i \<noteq> i1 \<and> i \<noteq> i2 \<Longrightarrow> ((f (i1 := v1)) (i2 := v2)) i = f i"
using fun_upd_same fun_upd_apply
--- a/src/HOL/SMT_Examples/SMT_Tests.certs Mon Mar 26 15:32:54 2012 +0200
+++ b/src/HOL/SMT_Examples/SMT_Tests.certs Mon Mar 26 15:33:28 2012 +0200
@@ -67155,3 +67155,80 @@
#139 := [asserted]: #53
[mp #139 #149]: false
unsat
+f09576464eb9a729afbe3fe966b57e4354456502 30 0
+#2 := false
+decl f4 :: (-> S3 S4)
+decl f6 :: S3
+#16 := f6
+#17 := (f4 f6)
+decl f3 :: (-> S2 S4)