--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/IntArith.thy Thu May 31 18:16:52 2007 +0200
@@ -0,0 +1,411 @@
+(* Title: HOL/IntArith.thy
+ ID: $Id$
+ Authors: Larry Paulson and Tobias Nipkow
+*)
+
+header {* Integer arithmetic *}
+
+theory IntArith
+imports Numeral Wellfounded_Relations
+uses "~~/src/Provers/Arith/assoc_fold.ML" ("int_arith1.ML")
+begin
+
+text{*Duplicate: can't understand why it's necessary*}
+declare numeral_0_eq_0 [simp]
+
+
+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 one_add_one_is_two: "1 + 1 = (2::'a::number_ring)"
+by (simp del: numeral_1_eq_1 add: numeral_1_eq_1 [symmetric] add_number_of_eq)
+
+lemmas add_special =
+ one_add_one_is_two
+ binop_eq [of "op +", OF add_number_of_eq numeral_1_eq_1 refl, standard]
+ binop_eq [of "op +", OF add_number_of_eq refl numeral_1_eq_1, standard]
+
+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, standard]
+ binop_eq [of "op -", OF diff_number_of_eq refl numeral_1_eq_1, standard]
+
+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, standard]
+ binop_eq [of "op =", OF eq_number_of_eq numeral_1_eq_1 refl, standard]
+ binop_eq [of "op =", OF eq_number_of_eq refl numeral_0_eq_0, standard]
+ binop_eq [of "op =", OF eq_number_of_eq refl numeral_1_eq_1, standard]
+
+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_eq_neg numeral_0_eq_0 refl, standard]
+ binop_eq [of "op <", OF less_number_of_eq_neg numeral_1_eq_1 refl, standard]
+ binop_eq [of "op <", OF less_number_of_eq_neg refl numeral_0_eq_0, standard]
+ binop_eq [of "op <", OF less_number_of_eq_neg refl numeral_1_eq_1, standard]
+
+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_eq numeral_0_eq_0 refl, standard]
+ binop_eq [of "op \<le>", OF le_number_of_eq numeral_1_eq_1 refl, standard]
+ binop_eq [of "op \<le>", OF le_number_of_eq refl numeral_0_eq_0, standard]
+ binop_eq [of "op \<le>", OF le_number_of_eq refl numeral_1_eq_1, standard]
+
+lemmas arith_special[simp] =
+ add_special diff_special eq_special less_special le_special
+
+
+lemma min_max_01: "min (0::int) 1 = 0 & min (1::int) 0 = 0 &
+ max (0::int) 1 = 1 & max (1::int) 0 = 1"
+by(simp add:min_def max_def)
+
+lemmas min_max_special[simp] =
+ min_max_01
+ max_def[of "0::int" "number_of v", standard, simp]
+ min_def[of "0::int" "number_of v", standard, simp]
+ max_def[of "number_of u" "0::int", standard, simp]
+ min_def[of "number_of u" "0::int", standard, simp]
+ max_def[of "1::int" "number_of v", standard, simp]
+ min_def[of "1::int" "number_of v", standard, simp]
+ max_def[of "number_of u" "1::int", standard, simp]
+ min_def[of "number_of u" "1::int", standard, simp]
+
+use "int_arith1.ML"
+setup int_arith_setup
+
+
+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::{ordered_idom,number_ring})"
+by (simp add: abs_if)
+
+lemma abs_power_minus_one [simp]:
+ "abs(-1 ^ n) = (1::'a::{ordered_idom,number_ring,recpower})"
+by (simp add: power_abs)
+
+lemma of_int_number_of_eq:
+ "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*}
+lemma mult_2: "2 * z = (z+z::'a::number_ring)"
+proof -
+ have "2*z = (1 + 1)*z" by simp
+ also have "... = z+z" by (simp add: left_distrib)
+ finally show ?thesis .
+qed
+
+lemma mult_2_right: "z * 2 = (z+z::'a::number_ring)"
+by (subst mult_commute, rule mult_2)
+
+
+subsection{*More Inequality Reasoning*}
+
+lemma zless_add1_eq: "(w < z + (1::int)) = (w<z | w=z)"
+by arith
+
+lemma add1_zle_eq: "(w + (1::int) \<le> z) = (w<z)"
+by arith
+
+lemma zle_diff1_eq [simp]: "(w \<le> z - (1::int)) = (w<z)"
+by arith
+
+lemma zle_add1_eq_le [simp]: "(w < z + (1::int)) = (w\<le>z)"
+by arith
+
+lemma int_one_le_iff_zero_less: "((1::int) \<le> z) = (0 < z)"
+by arith
+
+
+subsection{*The Functions @{term nat} and @{term int}*}
+
+text{*Simplify the terms @{term "int 0"}, @{term "int(Suc 0)"} and
+ @{term "w + - z"}*}
+declare Zero_int_def [symmetric, simp]
+declare One_int_def [symmetric, simp]
+
+lemmas diff_int_def_symmetric = diff_int_def [symmetric, simp]
+
+lemma nat_0: "nat 0 = 0"
+by (simp add: nat_eq_iff)
+
+lemma nat_1: "nat 1 = Suc 0"
+by (subst nat_eq_iff, simp)
+
+lemma nat_2: "nat 2 = Suc (Suc 0)"
+by (subst nat_eq_iff, simp)
+
+lemma one_less_nat_eq [simp]: "(Suc 0 < nat z) = (1 < z)"
+apply (insert zless_nat_conj [of 1 z])
+apply (auto simp add: nat_1)
+done
+
+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", standard]
+
+
+lemma split_nat [arith_split]:
+ "P(nat(i::int)) = ((\<forall>n. i = int n \<longrightarrow> P n) & (i < 0 \<longrightarrow> P 0))"
+ (is "?P = (?L & ?R)")
+proof (cases "i < 0")
+ case True thus ?thesis by simp
+next
+ case False
+ have "?P = ?L"
+ proof
+ assume ?P thus ?L using False by clarsimp
+ next
+ assume ?L thus ?P using False by simp
+ qed
+ with False show ?thesis by simp
+qed
+
+
+(*Analogous to zadd_int*)
+lemma zdiff_int: "n \<le> m ==> int m - int n = int (m-n)"
+by (induct m n rule: diff_induct, simp_all)
+
+lemma nat_mult_distrib: "(0::int) \<le> z ==> nat (z*z') = nat z * nat z'"
+apply (cases "0 \<le> z'")
+apply (rule inj_int [THEN injD])
+apply (simp add: int_mult zero_le_mult_iff)
+apply (simp add: mult_le_0_iff)
+done
+
+lemma nat_mult_distrib_neg: "z \<le> (0::int) ==> nat(z*z') = nat(-z) * nat(-z')"
+apply (rule trans)
+apply (rule_tac [2] nat_mult_distrib, auto)
+done
+
+lemma nat_abs_mult_distrib: "nat (abs (w * z)) = nat (abs w) * nat (abs z)"
+apply (cases "z=0 | w=0")
+apply (auto simp add: abs_if nat_mult_distrib [symmetric]
+ nat_mult_distrib_neg [symmetric] mult_less_0_iff)
+done
+
+
+subsection "Induction principles for int"
+
+text{*Well-founded segments of the integers*}
+
+definition
+ int_ge_less_than :: "int => (int * int) set"
+where
+ "int_ge_less_than d = {(z',z). d \<le> z' & z' < z}"
+
+theorem wf_int_ge_less_than: "wf (int_ge_less_than d)"
+proof -
+ have "int_ge_less_than d \<subseteq> measure (%z. nat (z-d))"
+ by (auto simp add: int_ge_less_than_def)
+ thus ?thesis
+ by (rule wf_subset [OF wf_measure])
+qed
+
+text{*This variant looks odd, but is typical of the relations suggested
+by RankFinder.*}
+
+definition
+ int_ge_less_than2 :: "int => (int * int) set"
+where
+ "int_ge_less_than2 d = {(z',z). d \<le> z & z' < z}"
+
+theorem wf_int_ge_less_than2: "wf (int_ge_less_than2 d)"
+proof -
+ have "int_ge_less_than2 d \<subseteq> measure (%z. nat (1+z-d))"
+ by (auto simp add: int_ge_less_than2_def)
+ thus ?thesis
+ by (rule wf_subset [OF wf_measure])
+qed
+
+ (* `set:int': dummy construction *)
+theorem int_ge_induct[case_names base step,induct set:int]:
+ assumes ge: "k \<le> (i::int)" and
+ base: "P(k)" and
+ step: "\<And>i. \<lbrakk>k \<le> i; P i\<rbrakk> \<Longrightarrow> P(i+1)"
+ shows "P i"
+proof -
+ { fix n have "\<And>i::int. n = nat(i-k) \<Longrightarrow> k \<le> i \<Longrightarrow> P i"
+ proof (induct n)
+ case 0
+ hence "i = k" by arith
+ thus "P i" using base by simp
+ next
+ case (Suc n)
+ hence "n = nat((i - 1) - k)" by arith
+ moreover
+ have ki1: "k \<le> i - 1" using Suc.prems by arith
+ ultimately
+ have "P(i - 1)" by(rule Suc.hyps)
+ from step[OF ki1 this] show ?case by simp
+ qed
+ }
+ with ge show ?thesis by fast
+qed
+
+ (* `set:int': dummy construction *)
+theorem int_gr_induct[case_names base step,induct set:int]:
+ assumes gr: "k < (i::int)" and
+ base: "P(k+1)" and
+ step: "\<And>i. \<lbrakk>k < i; P i\<rbrakk> \<Longrightarrow> P(i+1)"
+ shows "P i"
+apply(rule int_ge_induct[of "k + 1"])
+ using gr apply arith
+ apply(rule base)
+apply (rule step, simp+)
+done
+
+theorem int_le_induct[consumes 1,case_names base step]:
+ assumes le: "i \<le> (k::int)" and
+ base: "P(k)" and
+ step: "\<And>i. \<lbrakk>i \<le> k; P i\<rbrakk> \<Longrightarrow> P(i - 1)"
+ shows "P i"
+proof -
+ { fix n have "\<And>i::int. n = nat(k-i) \<Longrightarrow> i \<le> k \<Longrightarrow> P i"
+ proof (induct n)
+ case 0
+ hence "i = k" by arith
+ thus "P i" using base by simp
+ next
+ case (Suc n)
+ hence "n = nat(k - (i+1))" by arith
+ moreover
+ have ki1: "i + 1 \<le> k" using Suc.prems by arith
+ ultimately
+ have "P(i+1)" by(rule Suc.hyps)
+ from step[OF ki1 this] show ?case by simp
+ qed
+ }
+ with le show ?thesis by fast
+qed
+
+theorem int_less_induct [consumes 1,case_names base step]:
+ assumes less: "(i::int) < k" and
+ base: "P(k - 1)" and
+ step: "\<And>i. \<lbrakk>i < k; P i\<rbrakk> \<Longrightarrow> P(i - 1)"
+ shows "P i"
+apply(rule int_le_induct[of _ "k - 1"])
+ using less apply arith
+ apply(rule base)
+apply (rule step, simp+)
+done
+
+subsection{*Intermediate value theorems*}
+
+lemma int_val_lemma:
+ "(\<forall>i<n::nat. abs(f(i+1) - f i) \<le> 1) -->
+ f 0 \<le> k --> k \<le> f n --> (\<exists>i \<le> n. f i = (k::int))"
+apply (induct_tac "n", simp)
+apply (intro strip)
+apply (erule impE, simp)
+apply (erule_tac x = n in allE, simp)
+apply (case_tac "k = f (n+1) ")
+ apply force
+apply (erule impE)
+ apply (simp add: abs_if split add: split_if_asm)
+apply (blast intro: le_SucI)
+done
+
+lemmas nat0_intermed_int_val = int_val_lemma [rule_format (no_asm)]
+
+lemma nat_intermed_int_val:
+ "[| \<forall>i. m \<le> i & i < n --> abs(f(i + 1::nat) - f i) \<le> 1; m < n;
+ f m \<le> k; k \<le> f n |] ==> ? i. m \<le> i & i \<le> n & f i = (k::int)"
+apply (cut_tac n = "n-m" and f = "%i. f (i+m) " and k = k
+ in int_val_lemma)
+apply simp
+apply (erule exE)
+apply (rule_tac x = "i+m" in exI, arith)
+done
+
+
+subsection{*Products and 1, by T. M. Rasmussen*}
+
+lemma zabs_less_one_iff [simp]: "(\<bar>z\<bar> < 1) = (z = (0::int))"
+by arith
+
+lemma abs_zmult_eq_1: "(\<bar>m * n\<bar> = 1) ==> \<bar>m\<bar> = (1::int)"
+apply (cases "\<bar>n\<bar>=1")
+apply (simp add: abs_mult)
+apply (rule ccontr)
+apply (auto simp add: linorder_neq_iff abs_mult)
+apply (subgoal_tac "2 \<le> \<bar>m\<bar> & 2 \<le> \<bar>n\<bar>")
+ prefer 2 apply arith
+apply (subgoal_tac "2*2 \<le> \<bar>m\<bar> * \<bar>n\<bar>", simp)
+apply (rule mult_mono, auto)
+done
+
+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)
+
+lemma pos_zmult_eq_1_iff: "0 < (m::int) ==> (m * n = 1) = (m = 1 & n = 1)"
+apply (auto dest: pos_zmult_eq_1_iff_lemma)
+apply (simp add: mult_commute [of m])
+apply (frule pos_zmult_eq_1_iff_lemma, auto)
+done
+
+lemma zmult_eq_1_iff: "(m*n = (1::int)) = ((m = 1 & n = 1) | (m = -1 & n = -1))"
+apply (rule iffI)
+ apply (frule pos_zmult_eq_1_iff_lemma)
+ apply (simp add: mult_commute [of m])
+ apply (frule pos_zmult_eq_1_iff_lemma, auto)
+done
+
+
+subsection {* Legacy ML bindings *}
+
+ML {*
+val of_int_number_of_eq = @{thm of_int_number_of_eq};
+val nat_0 = @{thm nat_0};
+val nat_1 = @{thm nat_1};
+*}
+
+end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/IntDef.thy Thu May 31 18:16:52 2007 +0200
@@ -0,0 +1,890 @@
+(* Title: IntDef.thy
+ ID: $Id$
+ Author: Lawrence C Paulson, Cambridge University Computer Laboratory
+ Copyright 1996 University of Cambridge
+
+*)
+
+header{*The Integers as Equivalence Classes over Pairs of Natural Numbers*}
+
+theory IntDef
+imports Equiv_Relations Nat
+begin
+
+text {* the equivalence relation underlying the integers *}
+
+definition
+ intrel :: "((nat \<times> nat) \<times> (nat \<times> nat)) set"
+where
+ "intrel = {((x, y), (u, v)) | x y u v. x + v = u +y }"
+
+typedef (Integ)
+ int = "UNIV//intrel"
+ by (auto simp add: quotient_def)
+
+definition
+ int :: "nat \<Rightarrow> int"
+where
+ [code func del]: "int m = Abs_Integ (intrel `` {(m, 0)})"
+
+instance int :: zero
+ Zero_int_def: "0 \<equiv> int 0" ..
+
+instance int :: one
+ One_int_def: "1 \<equiv> int 1" ..
+
+instance int :: plus
+ add_int_def: "z + w \<equiv> Abs_Integ
+ (\<Union>(x, y) \<in> Rep_Integ z. \<Union>(u, v) \<in> Rep_Integ w.
+ intrel `` {(x + u, y + v)})" ..
+
+instance int :: minus
+ minus_int_def:
+ "- z \<equiv> Abs_Integ (\<Union>(x, y) \<in> Rep_Integ z. intrel `` {(y, x)})"
+ diff_int_def: "z - w \<equiv> z + (-w)" ..
+
+instance int :: times
+ mult_int_def: "z * w \<equiv> Abs_Integ
+ (\<Union>(x, y) \<in> Rep_Integ z. \<Union>(u,v ) \<in> Rep_Integ w.
+ intrel `` {(x*u + y*v, x*v + y*u)})" ..
+
+instance int :: ord
+ le_int_def:
+ "z \<le> w \<equiv> \<exists>x y u v. x+v \<le> u+y \<and> (x, y) \<in> Rep_Integ z \<and> (u, v) \<in> Rep_Integ w"
+ less_int_def: "z < w \<equiv> z \<le> w \<and> z \<noteq> w" ..
+
+lemmas [code func del] = Zero_int_def One_int_def add_int_def
+ minus_int_def mult_int_def le_int_def less_int_def
+
+
+subsection{*Construction of the Integers*}
+
+subsubsection{*Preliminary Lemmas about the Equivalence Relation*}
+
+lemma intrel_iff [simp]: "(((x,y),(u,v)) \<in> intrel) = (x+v = u+y)"
+by (simp add: intrel_def)
+
+lemma equiv_intrel: "equiv UNIV intrel"
+by (simp add: intrel_def equiv_def refl_def sym_def trans_def)
+
+text{*Reduces equality of equivalence classes to the @{term intrel} relation:
+ @{term "(intrel `` {x} = intrel `` {y}) = ((x,y) \<in> intrel)"} *}
+lemmas equiv_intrel_iff [simp] = eq_equiv_class_iff [OF equiv_intrel UNIV_I UNIV_I]
+
+text{*All equivalence classes belong to set of representatives*}
+lemma [simp]: "intrel``{(x,y)} \<in> Integ"
+by (auto simp add: Integ_def intrel_def quotient_def)
+
+text{*Reduces equality on abstractions to equality on representatives:
+ @{prop "\<lbrakk>x \<in> Integ; y \<in> Integ\<rbrakk> \<Longrightarrow> (Abs_Integ x = Abs_Integ y) = (x=y)"} *}
+declare Abs_Integ_inject [simp] Abs_Integ_inverse [simp]
+
+text{*Case analysis on the representation of an integer as an equivalence
+ class of pairs of naturals.*}
+lemma eq_Abs_Integ [case_names Abs_Integ, cases type: int]:
+ "(!!x y. z = Abs_Integ(intrel``{(x,y)}) ==> P) ==> P"
+apply (rule Abs_Integ_cases [of z])
+apply (auto simp add: Integ_def quotient_def)
+done
+
+
+subsubsection{*@{term int}: Embedding the Naturals into the Integers*}
+
+lemma inj_int: "inj int"
+by (simp add: inj_on_def int_def)
+
+lemma int_int_eq [iff]: "(int m = int n) = (m = n)"
+by (fast elim!: inj_int [THEN injD])
+
+
+subsubsection{*Integer Unary Negation*}
+
+lemma minus: "- Abs_Integ(intrel``{(x,y)}) = Abs_Integ(intrel `` {(y,x)})"
+proof -
+ have "(\<lambda>(x,y). intrel``{(y,x)}) respects intrel"
+ by (simp add: congruent_def)
+ thus ?thesis
+ by (simp add: minus_int_def UN_equiv_class [OF equiv_intrel])
+qed
+
+lemma zminus_zminus: "- (- z) = (z::int)"
+ by (cases z) (simp add: minus)
+
+lemma zminus_0: "- 0 = (0::int)"
+ by (simp add: int_def Zero_int_def minus)
+
+
+subsection{*Integer Addition*}
+
+lemma add:
+ "Abs_Integ (intrel``{(x,y)}) + Abs_Integ (intrel``{(u,v)}) =
+ Abs_Integ (intrel``{(x+u, y+v)})"
+proof -
+ have "(\<lambda>z w. (\<lambda>(x,y). (\<lambda>(u,v). intrel `` {(x+u, y+v)}) w) z)
+ respects2 intrel"
+ by (simp add: congruent2_def)
+ thus ?thesis
+ by (simp add: add_int_def UN_UN_split_split_eq
+ UN_equiv_class2 [OF equiv_intrel equiv_intrel])
+qed
+
+lemma zminus_zadd_distrib: "- (z + w) = (- z) + (- w::int)"
+ by (cases z, cases w) (simp add: minus add)
+
+lemma zadd_commute: "(z::int) + w = w + z"
+ by (cases z, cases w) (simp add: add_ac add)
+
+lemma zadd_assoc: "((z1::int) + z2) + z3 = z1 + (z2 + z3)"
+ by (cases z1, cases z2, cases z3) (simp add: add add_assoc)
+
+(*For AC rewriting*)
+lemma zadd_left_commute: "x + (y + z) = y + ((x + z) ::int)"
+ apply (rule mk_left_commute [of "op +"])
+ apply (rule zadd_assoc)
+ apply (rule zadd_commute)
+ done
+
+lemmas zadd_ac = zadd_assoc zadd_commute zadd_left_commute
+
+lemmas zmult_ac = OrderedGroup.mult_ac
+
+lemma zadd_int: "(int m) + (int n) = int (m + n)"
+ by (simp add: int_def add)
+
+lemma zadd_int_left: "(int m) + (int n + z) = int (m + n) + z"
+ by (simp add: zadd_int zadd_assoc [symmetric])
+
+(*also for the instance declaration int :: comm_monoid_add*)
+lemma zadd_0: "(0::int) + z = z"
+apply (simp add: Zero_int_def int_def)
+apply (cases z, simp add: add)
+done
+
+lemma zadd_0_right: "z + (0::int) = z"
+by (rule trans [OF zadd_commute zadd_0])
+
+lemma zadd_zminus_inverse2: "(- z) + z = (0::int)"
+by (cases z, simp add: int_def Zero_int_def minus add)
+
+
+subsection{*Integer Multiplication*}
+
+text{*Congruence property for multiplication*}
+lemma mult_congruent2:
+ "(%p1 p2. (%(x,y). (%(u,v). intrel``{(x*u + y*v, x*v + y*u)}) p2) p1)
+ respects2 intrel"
+apply (rule equiv_intrel [THEN congruent2_commuteI])
+ apply (force simp add: mult_ac, clarify)
+apply (simp add: congruent_def mult_ac)
+apply (rename_tac u v w x y z)
+apply (subgoal_tac "u*y + x*y = w*y + v*y & u*z + x*z = w*z + v*z")
+apply (simp add: mult_ac)
+apply (simp add: add_mult_distrib [symmetric])
+done
+
+
+lemma mult:
+ "Abs_Integ((intrel``{(x,y)})) * Abs_Integ((intrel``{(u,v)})) =
+ Abs_Integ(intrel `` {(x*u + y*v, x*v + y*u)})"
+by (simp add: mult_int_def UN_UN_split_split_eq mult_congruent2
+ UN_equiv_class2 [OF equiv_intrel equiv_intrel])
+
+lemma zmult_zminus: "(- z) * w = - (z * (w::int))"
+by (cases z, cases w, simp add: minus mult add_ac)
+
+lemma zmult_commute: "(z::int) * w = w * z"
+by (cases z, cases w, simp add: mult add_ac mult_ac)
+
+lemma zmult_assoc: "((z1::int) * z2) * z3 = z1 * (z2 * z3)"
+by (cases z1, cases z2, cases z3, simp add: mult add_mult_distrib2 mult_ac)
+
+lemma zadd_zmult_distrib: "((z1::int) + z2) * w = (z1 * w) + (z2 * w)"
+by (cases z1, cases z2, cases w, simp add: add mult add_mult_distrib2 mult_ac)
+
+lemma zadd_zmult_distrib2: "(w::int) * (z1 + z2) = (w * z1) + (w * z2)"
+by (simp add: zmult_commute [of w] zadd_zmult_distrib)
+
+lemma zdiff_zmult_distrib: "((z1::int) - z2) * w = (z1 * w) - (z2 * w)"
+by (simp add: diff_int_def zadd_zmult_distrib zmult_zminus)
+
+lemma zdiff_zmult_distrib2: "(w::int) * (z1 - z2) = (w * z1) - (w * z2)"
+by (simp add: zmult_commute [of w] zdiff_zmult_distrib)
+
+lemmas int_distrib =
+ zadd_zmult_distrib zadd_zmult_distrib2
+ zdiff_zmult_distrib zdiff_zmult_distrib2
+
+lemma int_mult: "int (m * n) = (int m) * (int n)"
+by (simp add: int_def mult)
+
+text{*Compatibility binding*}
+lemmas zmult_int = int_mult [symmetric]
+
+lemma zmult_1: "(1::int) * z = z"
+by (cases z, simp add: One_int_def int_def mult)
+
+lemma zmult_1_right: "z * (1::int) = z"
+by (rule trans [OF zmult_commute zmult_1])
+
+
+text{*The integers form a @{text comm_ring_1}*}
+instance int :: comm_ring_1
+proof
+ fix i j k :: int
+ show "(i + j) + k = i + (j + k)" by (simp add: zadd_assoc)
+ show "i + j = j + i" by (simp add: zadd_commute)
+ show "0 + i = i" by (rule zadd_0)
+ show "- i + i = 0" by (rule zadd_zminus_inverse2)
+ show "i - j = i + (-j)" by (simp add: diff_int_def)
+ show "(i * j) * k = i * (j * k)" by (rule zmult_assoc)
+ show "i * j = j * i" by (rule zmult_commute)
+ show "1 * i = i" by (rule zmult_1)
+ show "(i + j) * k = i * k + j * k" by (simp add: int_distrib)
+ show "0 \<noteq> (1::int)"
+ by (simp only: Zero_int_def One_int_def One_nat_def int_int_eq)
+qed
+
+
+subsection{*The @{text "\<le>"} Ordering*}
+
+lemma le:
+ "(Abs_Integ(intrel``{(x,y)}) \<le> Abs_Integ(intrel``{(u,v)})) = (x+v \<le> u+y)"
+by (force simp add: le_int_def)
+
+lemma zle_refl: "w \<le> (w::int)"
+by (cases w, simp add: le)
+
+lemma zle_trans: "[| i \<le> j; j \<le> k |] ==> i \<le> (k::int)"
+by (cases i, cases j, cases k, simp add: le)
+
+lemma zle_anti_sym: "[| z \<le> w; w \<le> z |] ==> z = (w::int)"
+by (cases w, cases z, simp add: le)
+
+instance int :: order
+ by intro_classes
+ (assumption |
+ rule zle_refl zle_trans zle_anti_sym less_int_def [THEN meta_eq_to_obj_eq])+
+
+lemma zle_linear: "(z::int) \<le> w \<or> w \<le> z"
+by (cases z, cases w) (simp add: le linorder_linear)
+
+instance int :: linorder
+ by intro_classes (rule zle_linear)
+
+lemmas zless_linear = linorder_less_linear [where 'a = int]
+
+
+lemma int_eq_0_conv [simp]: "(int n = 0) = (n = 0)"
+by (simp add: Zero_int_def)
+
+lemma zless_int [simp]: "(int m < int n) = (m<n)"
+by (simp add: le add int_def linorder_not_le [symmetric])
+
+lemma int_less_0_conv [simp]: "~ (int k < 0)"
+by (simp add: Zero_int_def)
+
+lemma zero_less_int_conv [simp]: "(0 < int n) = (0 < n)"
+by (simp add: Zero_int_def)
+
+lemma int_0_less_1: "0 < (1::int)"
+by (simp only: Zero_int_def One_int_def One_nat_def zless_int)
+
+lemma int_0_neq_1 [simp]: "0 \<noteq> (1::int)"
+by (simp only: Zero_int_def One_int_def One_nat_def int_int_eq)
+
+lemma zle_int [simp]: "(int m \<le> int n) = (m\<le>n)"
+by (simp add: linorder_not_less [symmetric])
+
+lemma zero_zle_int [simp]: "(0 \<le> int n)"
+by (simp add: Zero_int_def)
+
+lemma int_le_0_conv [simp]: "(int n \<le> 0) = (n = 0)"
+by (simp add: Zero_int_def)
+
+lemma int_0 [simp]: "int 0 = (0::int)"
+by (simp add: Zero_int_def)
+
+lemma int_1 [simp]: "int 1 = 1"
+by (simp add: One_int_def)
+
+lemma int_Suc0_eq_1: "int (Suc 0) = 1"
+by (simp add: One_int_def One_nat_def)
+
+lemma int_Suc: "int (Suc m) = 1 + (int m)"
+by (simp add: One_int_def zadd_int)
+
+
+subsection{*Monotonicity results*}
+
+lemma zadd_left_mono: "i \<le> j ==> k + i \<le> k + (j::int)"
+by (cases i, cases j, cases k, simp add: le add)
+
+lemma zadd_strict_right_mono: "i < j ==> i + k < j + (k::int)"
+apply (cases i, cases j, cases k)
+apply (simp add: linorder_not_le [where 'a = int, symmetric]
+ linorder_not_le [where 'a = nat] le add)
+done
+
+lemma zadd_zless_mono: "[| w'<w; z'\<le>z |] ==> w' + z' < w + (z::int)"
+by (rule order_less_le_trans [OF zadd_strict_right_mono zadd_left_mono])
+
+
+subsection{*Strict Monotonicity of Multiplication*}
+
+text{*strict, in 1st argument; proof is by induction on k>0*}
+lemma zmult_zless_mono2_lemma:
+ "i<j ==> 0<k ==> int k * i < int k * j"
+apply (induct "k", simp)
+apply (simp add: int_Suc)
+apply (case_tac "k=0")
+apply (simp_all add: zadd_zmult_distrib int_Suc0_eq_1 order_le_less)
+apply (simp add: zadd_zless_mono int_Suc0_eq_1 order_le_less)
+done
+
+lemma zero_le_imp_eq_int: "0 \<le> k ==> \<exists>n. k = int n"
+apply (cases k)
+apply (auto simp add: le add int_def Zero_int_def)
+apply (rule_tac x="x-y" in exI, simp)
+done
+
+lemma zmult_zless_mono2: "[| i<j; (0::int) < k |] ==> k*i < k*j"
+apply (frule order_less_imp_le [THEN zero_le_imp_eq_int])
+apply (auto simp add: zmult_zless_mono2_lemma)
+done
+
+instance int :: minus
+ zabs_def: "\<bar>i\<Colon>int\<bar> \<equiv> if i < 0 then - i else i" ..
+
+instance int :: distrib_lattice
+ "inf \<equiv> min"
+ "sup \<equiv> max"
+ by intro_classes
+ (auto simp add: inf_int_def sup_int_def min_max.sup_inf_distrib1)
+
+text{*The integers form an ordered @{text comm_ring_1}*}
+instance int :: ordered_idom
+proof
+ fix i j k :: int
+ show "i \<le> j ==> k + i \<le> k + j" by (rule zadd_left_mono)
+ show "i < j ==> 0 < k ==> k * i < k * j" by (rule zmult_zless_mono2)
+ show "\<bar>i\<bar> = (if i < 0 then -i else i)" by (simp only: zabs_def)
+qed
+
+lemma zless_imp_add1_zle: "w<z ==> w + (1::int) \<le> z"
+apply (cases w, cases z)
+apply (simp add: linorder_not_le [symmetric] le int_def add One_int_def)
+done
+
+subsection{*Magnitide of an Integer, as a Natural Number: @{term nat}*}
+
+definition
+ nat :: "int \<Rightarrow> nat"
+where
+ [code func del]: "nat z = contents (\<Union>(x, y) \<in> Rep_Integ z. {x-y})"
+
+lemma nat: "nat (Abs_Integ (intrel``{(x,y)})) = x-y"
+proof -
+ have "(\<lambda>(x,y). {x-y}) respects intrel"
+ by (simp add: congruent_def) arith
+ thus ?thesis
+ by (simp add: nat_def UN_equiv_class [OF equiv_intrel])
+qed
+
+lemma nat_int [simp]: "nat(int n) = n"
+by (simp add: nat int_def)
+
+lemma nat_zero [simp]: "nat 0 = 0"
+by (simp only: Zero_int_def nat_int)
+
+lemma int_nat_eq [simp]: "int (nat z) = (if 0 \<le> z then z else 0)"
+by (cases z, simp add: nat le int_def Zero_int_def)
+
+corollary nat_0_le: "0 \<le> z ==> int (nat z) = z"
+by simp
+
+lemma nat_le_0 [simp]: "z \<le> 0 ==> nat z = 0"
+by (cases z, simp add: nat le int_def Zero_int_def)
+
+lemma nat_le_eq_zle: "0 < w | 0 \<le> z ==> (nat w \<le> nat z) = (w\<le>z)"
+apply (cases w, cases z)
+apply (simp add: nat le linorder_not_le [symmetric] int_def Zero_int_def, arith)
+done
+
+text{*An alternative condition is @{term "0 \<le> w"} *}
+corollary nat_mono_iff: "0 < z ==> (nat w < nat z) = (w < z)"
+by (simp add: nat_le_eq_zle linorder_not_le [symmetric])
+
+corollary nat_less_eq_zless: "0 \<le> w ==> (nat w < nat z) = (w<z)"
+by (simp add: nat_le_eq_zle linorder_not_le [symmetric])
+
+lemma zless_nat_conj: "(nat w < nat z) = (0 < z & w < z)"
+apply (cases w, cases z)
+apply (simp add: nat le int_def Zero_int_def linorder_not_le [symmetric], arith)
+done
+
+lemma nonneg_eq_int: "[| 0 \<le> z; !!m. z = int m ==> P |] ==> P"
+by (blast dest: nat_0_le sym)
+
+lemma nat_eq_iff: "(nat w = m) = (if 0 \<le> w then w = int m else m=0)"
+by (cases w, simp add: nat le int_def Zero_int_def, arith)
+
+corollary nat_eq_iff2: "(m = nat w) = (if 0 \<le> w then w = int m else m=0)"
+by (simp only: eq_commute [of m] nat_eq_iff)
+
+lemma nat_less_iff: "0 \<le> w ==> (nat w < m) = (w < int m)"
+apply (cases w)
+apply (simp add: nat le int_def Zero_int_def linorder_not_le [symmetric], arith)
+done
+
+lemma int_eq_iff: "(int m = z) = (m = nat z & 0 \<le> z)"
+by (auto simp add: nat_eq_iff2)
+
+lemma zero_less_nat_eq [simp]: "(0 < nat z) = (0 < z)"
+by (insert zless_nat_conj [of 0], auto)
+
+lemma nat_add_distrib:
+ "[| (0::int) \<le> z; 0 \<le> z' |] ==> nat (z+z') = nat z + nat z'"
+by (cases z, cases z', simp add: nat add le int_def Zero_int_def)
+
+lemma nat_diff_distrib:
+ "[| (0::int) \<le> z'; z' \<le> z |] ==> nat (z-z') = nat z - nat z'"
+by (cases z, cases z',
+ simp add: nat add minus diff_minus le int_def Zero_int_def)
+
+
+lemma nat_zminus_int [simp]: "nat (- (int n)) = 0"
+by (simp add: int_def minus nat Zero_int_def)
+
+lemma zless_nat_eq_int_zless: "(m < nat z) = (int m < z)"
+by (cases z, simp add: nat le int_def linorder_not_le [symmetric], arith)
+
+
+subsection{*Lemmas about the Function @{term int} and Orderings*}
+
+lemma negative_zless_0: "- (int (Suc n)) < 0"
+by (simp add: order_less_le)
+
+lemma negative_zless [iff]: "- (int (Suc n)) < int m"
+by (rule negative_zless_0 [THEN order_less_le_trans], simp)
+
+lemma negative_zle_0: "- int n \<le> 0"
+by (simp add: minus_le_iff)
+
+lemma negative_zle [iff]: "- int n \<le> int m"
+by (rule order_trans [OF negative_zle_0 zero_zle_int])
+
+lemma not_zle_0_negative [simp]: "~ (0 \<le> - (int (Suc n)))"
+by (subst le_minus_iff, simp)
+
+lemma int_zle_neg: "(int n \<le> - int m) = (n = 0 & m = 0)"
+by (simp add: int_def le minus Zero_int_def)
+
+lemma not_int_zless_negative [simp]: "~ (int n < - int m)"
+by (simp add: linorder_not_less)
+
+lemma negative_eq_positive [simp]: "(- int n = int m) = (n = 0 & m = 0)"
+by (force simp add: order_eq_iff [of "- int n"] int_zle_neg)
+
+lemma zle_iff_zadd: "(w \<le> z) = (\<exists>n. z = w + int n)"
+proof (cases w, cases z, simp add: le add int_def)
+ fix a b c d
+ assume "w = Abs_Integ (intrel `` {(a,b)})" "z = Abs_Integ (intrel `` {(c,d)})"
+ show "(a+d \<le> c+b) = (\<exists>n. c+b = a+n+d)"
+ proof
+ assume "a + d \<le> c + b"
+ thus "\<exists>n. c + b = a + n + d"
+ by (auto intro!: exI [where x="c+b - (a+d)"])
+ next
+ assume "\<exists>n. c + b = a + n + d"
+ then obtain n where "c + b = a + n + d" ..
+ thus "a + d \<le> c + b" by arith
+ qed
+qed
+
+lemma abs_int_eq [simp]: "abs (int m) = int m"
+by (simp add: abs_if)
+
+text{*This version is proved for all ordered rings, not just integers!
+ It is proved here because attribute @{text arith_split} is not available
+ in theory @{text Ring_and_Field}.
+ But is it really better than just rewriting with @{text abs_if}?*}
+lemma abs_split [arith_split]:
+ "P(abs(a::'a::ordered_idom)) = ((0 \<le> a --> P a) & (a < 0 --> P(-a)))"
+by (force dest: order_less_le_trans simp add: abs_if linorder_not_less)
+
+
+subsection {* Constants @{term neg} and @{term iszero} *}
+
+definition
+ neg :: "'a\<Colon>ordered_idom \<Rightarrow> bool"
+where
+ [code inline]: "neg Z \<longleftrightarrow> Z < 0"
+
+definition (*for simplifying equalities*)
+ iszero :: "'a\<Colon>comm_semiring_1_cancel \<Rightarrow> bool"
+where
+ "iszero z \<longleftrightarrow> z = 0"
+
+lemma not_neg_int [simp]: "~ neg(int n)"
+by (simp add: neg_def)
+
+lemma neg_zminus_int [simp]: "neg(- (int (Suc n)))"
+by (simp add: neg_def neg_less_0_iff_less)
+
+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)
+
+
+subsection{*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 zero_le_one)
+
+lemma iszero_0: "iszero 0"
+by (simp add: iszero_def)
+
+lemma not_iszero_1: "~ iszero 1"
+by (simp add: iszero_def eq_commute)
+
+lemma neg_nat: "neg z ==> nat z = 0"
+by (simp add: neg_def order_less_imp_le)
+
+lemma not_neg_nat: "~ neg z ==> int (nat z) = z"
+by (simp add: linorder_not_less neg_def)
+
+
+subsection{*The Set of Natural Numbers*}
+
+constdefs
+ Nats :: "'a::semiring_1_cancel set"
+ "Nats == range of_nat"
+
+notation (xsymbols)
+ Nats ("\<nat>")
+
+lemma of_nat_in_Nats [simp]: "of_nat n \<in> Nats"
+by (simp add: Nats_def)
+
+lemma Nats_0 [simp]: "0 \<in> Nats"
+apply (simp add: Nats_def)
+apply (rule range_eqI)
+apply (rule of_nat_0 [symmetric])
+done
+
+lemma Nats_1 [simp]: "1 \<in> Nats"
+apply (simp add: Nats_def)
+apply (rule range_eqI)
+apply (rule of_nat_1 [symmetric])
+done
+
+lemma Nats_add [simp]: "[|a \<in> Nats; b \<in> Nats|] ==> a+b \<in> Nats"
+apply (auto simp add: Nats_def)
+apply (rule range_eqI)
+apply (rule of_nat_add [symmetric])
+done
+
+lemma Nats_mult [simp]: "[|a \<in> Nats; b \<in> Nats|] ==> a*b \<in> Nats"
+apply (auto simp add: Nats_def)
+apply (rule range_eqI)
+apply (rule of_nat_mult [symmetric])
+done
+
+text{*Agreement with the specific embedding for the integers*}
+lemma int_eq_of_nat: "int = (of_nat :: nat => int)"
+proof
+ fix n
+ show "int n = of_nat n" by (induct n, simp_all add: int_Suc add_ac)
+qed
+
+lemma of_nat_eq_id [simp]: "of_nat = (id :: nat => nat)"
+proof
+ fix n
+ show "of_nat n = id n" by (induct n, simp_all)
+qed
+
+
+subsection{*Embedding of the Integers into any @{text ring_1}:
+@{term of_int}*}
+
+constdefs
+ of_int :: "int => 'a::ring_1"
+ "of_int z == contents (\<Union>(i,j) \<in> Rep_Integ z. { of_nat i - of_nat j })"
+
+
+lemma of_int: "of_int (Abs_Integ (intrel `` {(i,j)})) = of_nat i - of_nat j"
+proof -
+ have "(\<lambda>(i,j). { of_nat i - (of_nat j :: 'a) }) respects intrel"
+ by (simp add: congruent_def compare_rls of_nat_add [symmetric]
+ del: of_nat_add)
+ thus ?thesis
+ by (simp add: of_int_def UN_equiv_class [OF equiv_intrel])
+qed
+
+lemma of_int_0 [simp]: "of_int 0 = 0"
+by (simp add: of_int Zero_int_def int_def)
+
+lemma of_int_1 [simp]: "of_int 1 = 1"
+by (simp add: of_int One_int_def int_def)
+
+lemma of_int_add [simp]: "of_int (w+z) = of_int w + of_int z"
+by (cases w, cases z, simp add: compare_rls of_int add)
+
+lemma of_int_minus [simp]: "of_int (-z) = - (of_int z)"
+by (cases z, simp add: compare_rls of_int minus)
+
+lemma of_int_diff [simp]: "of_int (w-z) = of_int w - of_int z"
+by (simp add: diff_minus)
+
+lemma of_int_mult [simp]: "of_int (w*z) = of_int w * of_int z"
+apply (cases w, cases z)
+apply (simp add: compare_rls of_int left_diff_distrib right_diff_distrib
+ mult add_ac)
+done
+
+lemma of_int_le_iff [simp]:
+ "(of_int w \<le> (of_int z::'a::ordered_idom)) = (w \<le> z)"
+apply (cases w)
+apply (cases z)
+apply (simp add: compare_rls of_int le diff_int_def add minus
+ of_nat_add [symmetric] del: of_nat_add)
+done
+
+text{*Special cases where either operand is zero*}
+lemmas of_int_0_le_iff [simp] = of_int_le_iff [of 0, simplified]
+lemmas of_int_le_0_iff [simp] = of_int_le_iff [of _ 0, simplified]
+
+
+lemma of_int_less_iff [simp]:
+ "(of_int w < (of_int z::'a::ordered_idom)) = (w < z)"
+by (simp add: linorder_not_le [symmetric])
+
+text{*Special cases where either operand is zero*}
+lemmas of_int_0_less_iff [simp] = of_int_less_iff [of 0, simplified]
+lemmas of_int_less_0_iff [simp] = of_int_less_iff [of _ 0, simplified]
+
+text{*Class for unital rings with characteristic zero.
+ Includes non-ordered rings like the complex numbers.*}
+axclass ring_char_0 < ring_1
+ of_int_inject: "of_int w = of_int z ==> w = z"
+
+lemma of_int_eq_iff [simp]:
+ "(of_int w = (of_int z::'a::ring_char_0)) = (w = z)"
+by (safe elim!: of_int_inject)
+
+text{*Every @{text ordered_idom} has characteristic zero.*}
+instance ordered_idom < ring_char_0
+by intro_classes (simp add: order_eq_iff)
+
+text{*Special cases where either operand is zero*}
+lemmas of_int_0_eq_iff [simp] = of_int_eq_iff [of 0, simplified]
+lemmas of_int_eq_0_iff [simp] = of_int_eq_iff [of _ 0, simplified]
+
+lemma of_int_eq_id [simp]: "of_int = (id :: int => int)"
+proof
+ fix z
+ show "of_int z = id z"
+ by (cases z)
+ (simp add: of_int add minus int_eq_of_nat [symmetric] int_def diff_minus)
+qed
+
+
+subsection{*The Set of Integers*}
+
+constdefs
+ Ints :: "'a::ring_1 set"
+ "Ints == range of_int"
+
+notation (xsymbols)
+ Ints ("\<int>")
+
+lemma Ints_0 [simp]: "0 \<in> Ints"
+apply (simp add: Ints_def)
+apply (rule range_eqI)
+apply (rule of_int_0 [symmetric])
+done
+
+lemma Ints_1 [simp]: "1 \<in> Ints"
+apply (simp add: Ints_def)
+apply (rule range_eqI)
+apply (rule of_int_1 [symmetric])
+done
+
+lemma Ints_add [simp]: "[|a \<in> Ints; b \<in> Ints|] ==> a+b \<in> Ints"
+apply (auto simp add: Ints_def)
+apply (rule range_eqI)
+apply (rule of_int_add [symmetric])
+done
+
+lemma Ints_minus [simp]: "a \<in> Ints ==> -a \<in> Ints"
+apply (auto simp add: Ints_def)
+apply (rule range_eqI)
+apply (rule of_int_minus [symmetric])
+done
+
+lemma Ints_diff [simp]: "[|a \<in> Ints; b \<in> Ints|] ==> a-b \<in> Ints"
+apply (auto simp add: Ints_def)
+apply (rule range_eqI)
+apply (rule of_int_diff [symmetric])
+done
+
+lemma Ints_mult [simp]: "[|a \<in> Ints; b \<in> Ints|] ==> a*b \<in> Ints"
+apply (auto simp add: Ints_def)
+apply (rule range_eqI)
+apply (rule of_int_mult [symmetric])
+done
+
+text{*Collapse nested embeddings*}
+lemma of_int_of_nat_eq [simp]: "of_int (of_nat n) = of_nat n"
+by (induct n, auto)
+
+lemma of_int_int_eq [simp]: "of_int (int n) = of_nat n"
+by (simp add: int_eq_of_nat)
+
+lemma Ints_cases [cases set: Ints]:
+ assumes "q \<in> \<int>"
+ obtains (of_int) z where "q = of_int z"
+ unfolding Ints_def
+proof -
+ from `q \<in> \<int>` have "q \<in> range of_int" unfolding Ints_def .
+ then obtain z where "q = of_int z" ..
+ then show thesis ..
+qed
+
+lemma Ints_induct [case_names of_int, induct set: Ints]:
+ "q \<in> \<int> ==> (!!z. P (of_int z)) ==> P q"
+ by (rule Ints_cases) auto
+
+
+(* int (Suc n) = 1 + int n *)
+
+
+
+subsection{*More Properties of @{term setsum} and @{term setprod}*}
+
+text{*By Jeremy Avigad*}
+
+
+lemma of_nat_setsum: "of_nat (setsum f A) = (\<Sum>x\<in>A. of_nat(f x))"
+ apply (cases "finite A")
+ apply (erule finite_induct, auto)
+ done
+
+lemma of_int_setsum: "of_int (setsum f A) = (\<Sum>x\<in>A. of_int(f x))"
+ apply (cases "finite A")
+ apply (erule finite_induct, auto)
+ done
+
+lemma int_setsum: "int (setsum f A) = (\<Sum>x\<in>A. int(f x))"
+ by (simp add: int_eq_of_nat of_nat_setsum)
+
+lemma of_nat_setprod: "of_nat (setprod f A) = (\<Prod>x\<in>A. of_nat(f x))"
+ apply (cases "finite A")
+ apply (erule finite_induct, auto)
+ done
+
+lemma of_int_setprod: "of_int (setprod f A) = (\<Prod>x\<in>A. of_int(f x))"
+ apply (cases "finite A")
+ apply (erule finite_induct, auto)
+ done
+
+lemma int_setprod: "int (setprod f A) = (\<Prod>x\<in>A. int(f x))"
+ by (simp add: int_eq_of_nat of_nat_setprod)
+
+lemma setprod_nonzero_nat:
+ "finite A ==> (\<forall>x \<in> A. f x \<noteq> (0::nat)) ==> setprod f A \<noteq> 0"
+ by (rule setprod_nonzero, auto)
+
+lemma setprod_zero_eq_nat:
+ "finite A ==> (setprod f A = (0::nat)) = (\<exists>x \<in> A. f x = 0)"
+ by (rule setprod_zero_eq, auto)
+
+lemma setprod_nonzero_int:
+ "finite A ==> (\<forall>x \<in> A. f x \<noteq> (0::int)) ==> setprod f A \<noteq> 0"
+ by (rule setprod_nonzero, auto)
+
+lemma setprod_zero_eq_int:
+ "finite A ==> (setprod f A = (0::int)) = (\<exists>x \<in> A. f x = 0)"
+ by (rule setprod_zero_eq, auto)
+
+
+subsection {* Further properties *}
+
+text{*Now we replace the case analysis rule by a more conventional one:
+whether an integer is negative or not.*}
+
+lemma zless_iff_Suc_zadd:
+ "(w < z) = (\<exists>n. z = w + int(Suc n))"
+apply (cases z, cases w)
+apply (auto simp add: le add int_def linorder_not_le [symmetric])
+apply (rename_tac a b c d)
+apply (rule_tac x="a+d - Suc(c+b)" in exI)
+apply arith
+done
+
+lemma negD: "x<0 ==> \<exists>n. x = - (int (Suc n))"
+apply (cases x)
+apply (auto simp add: le minus Zero_int_def int_def order_less_le)
+apply (rule_tac x="y - Suc x" in exI, arith)
+done
+
+theorem int_cases [cases type: int, case_names nonneg neg]:
+ "[|!! n. z = int n ==> P; !! n. z = - (int (Suc n)) ==> P |] ==> P"
+apply (cases "z < 0", blast dest!: negD)
+apply (simp add: linorder_not_less)
+apply (blast dest: nat_0_le [THEN sym])
+done
+
+theorem int_induct [induct type: int, case_names nonneg neg]:
+ "[|!! n. P (int n); !!n. P (- (int (Suc n))) |] ==> P z"
+ by (cases z) auto
+
+text{*Contributed by Brian Huffman*}
+theorem int_diff_cases [case_names diff]:
+assumes prem: "!!m n. z = int m - int n ==> P" shows "P"
+ apply (rule_tac z=z in int_cases)
+ apply (rule_tac m=n and n=0 in prem, simp)
+ apply (rule_tac m=0 and n="Suc n" in prem, simp)
+done
+
+lemma of_nat_nat: "0 \<le> z ==> of_nat (nat z) = of_int z"
+apply (cases z)
+apply (simp_all add: not_zle_0_negative del: int_Suc)
+done
+
+lemmas zless_le = less_int_def [THEN meta_eq_to_obj_eq]
+
+lemmas [simp] = int_Suc
+
+
+subsection {* Legacy ML bindings *}
+
+ML {*
+val of_nat_0 = @{thm of_nat_0};
+val of_nat_1 = @{thm of_nat_1};
+val of_nat_Suc = @{thm of_nat_Suc};
+val of_nat_add = @{thm of_nat_add};
+val of_nat_mult = @{thm of_nat_mult};
+val of_int_0 = @{thm of_int_0};
+val of_int_1 = @{thm of_int_1};
+val of_int_add = @{thm of_int_add};
+val of_int_mult = @{thm of_int_mult};
+val int_eq_of_nat = @{thm int_eq_of_nat};
+val zle_int = @{thm zle_int};
+val int_int_eq = @{thm int_int_eq};
+val diff_int_def = @{thm diff_int_def};
+val zadd_ac = @{thms zadd_ac};
+val zless_int = @{thm zless_int};
+val zadd_int = @{thm zadd_int};
+val zmult_int = @{thm zmult_int};
+val nat_0_le = @{thm nat_0_le};
+val int_0 = @{thm int_0};
+val int_1 = @{thm int_1};
+val abs_split = @{thm abs_split};
+*}
+
+end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/IntDiv.thy Thu May 31 18:16:52 2007 +0200
@@ -0,0 +1,1406 @@
+(* Title: HOL/IntDiv.thy
+ ID: $Id$
+ Author: Lawrence C Paulson, Cambridge University Computer Laboratory
+ Copyright 1999 University of Cambridge
+
+*)
+
+header{*The Division Operators div and mod; the Divides Relation dvd*}
+
+theory IntDiv
+imports IntArith Divides FunDef
+begin
+
+declare zless_nat_conj [simp]
+
+constdefs
+ quorem :: "(int*int) * (int*int) => bool"
+ --{*definition of quotient and remainder*}
+ [code func]: "quorem == %((a,b), (q,r)).
+ a = b*q + r &
+ (if 0 < b then 0\<le>r & r<b else b<r & r \<le> 0)"
+
+ adjust :: "[int, int*int] => int*int"
+ --{*for the division algorithm*}
+ [code func]: "adjust b == %(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"}*}
+function
+ posDivAlg :: "int \<Rightarrow> int \<Rightarrow> int \<times> int"
+where
+ "posDivAlg a b =
+ (if (a<b | b\<le>0) then (0,a)
+ else adjust b (posDivAlg a (2*b)))"
+by auto
+termination by (relation "measure (%(a,b). nat(a - b + 1))") auto
+
+text{*algorithm for the case @{text "a<0, b>0"}*}
+function
+ negDivAlg :: "int \<Rightarrow> int \<Rightarrow> int \<times> int"
+where
+ "negDivAlg a b =
+ (if (0\<le>a+b | b\<le>0) then (-1,a+b)
+ else adjust b (negDivAlg a (2*b)))"
+by auto
+termination by (relation "measure (%(a,b). nat(- a - b))") auto
+
+text{*algorithm for the general case @{term "b\<noteq>0"}*}
+constdefs
+ negateSnd :: "int*int => int*int"
+ [code func]: "negateSnd == %(q,r). (q,-r)"
+
+definition
+ divAlg :: "int \<times> int \<Rightarrow> int \<times> int"
+ --{*The full division algorithm considers all possible signs for a, b
+ including the special case @{text "a=0, b<0"} because
+ @{term negDivAlg} requires @{term "a<0"}.*}
+where
+ "divAlg = (\<lambda>(a, b). (if 0\<le>a then
+ if 0\<le>b then posDivAlg a b
+ else if a=0 then (0, 0)
+ else negateSnd (negDivAlg (-a) (-b))
+ else
+ if 0<b then negDivAlg a b
+ else negateSnd (posDivAlg (-a) (-b))))"
+
+instance int :: Divides.div
+ div_def: "a div b == fst (divAlg (a, b))"
+ mod_def: "a mod b == snd (divAlg (a, b))" ..
+
+lemma divAlg_mod_div:
+ "divAlg (p, q) = (p div q, p mod q)"
+ by (auto simp add: div_def mod_def)
+
+text{*
+Here is the division algorithm in ML:
+
+\begin{verbatim}
+ fun posDivAlg (a,b) =
+ if a<b then (0,a)
+ else let val (q,r) = posDivAlg(a, 2*b)
+ in if 0\<le>r-b then (2*q+1, r-b) else (2*q, r)
+ end
+
+ fun negDivAlg (a,b) =
+ if 0\<le>a+b then (~1,a+b)
+ else let val (q,r) = negDivAlg(a, 2*b)
+ in if 0\<le>r-b then (2*q+1, r-b) else (2*q, r)
+ end;
+
+ fun negateSnd (q,r:int) = (q,~r);
+
+ fun divAlg (a,b) = if 0\<le>a then
+ if b>0 then posDivAlg (a,b)
+ else if a=0 then (0,0)
+ else negateSnd (negDivAlg (~a,~b))
+ else
+ if 0<b then negDivAlg (a,b)
+ else negateSnd (posDivAlg (~a,~b));
+\end{verbatim}
+*}
+
+
+
+subsection{*Uniqueness and Monotonicity of Quotients and Remainders*}
+
+lemma unique_quotient_lemma:
+ "[| b*q' + r' \<le> b*q + r; 0 \<le> r'; r' < b; r < b |]
+ ==> q' \<le> (q::int)"
+apply (subgoal_tac "r' + b * (q'-q) \<le> r")
+ prefer 2 apply (simp add: right_diff_distrib)
+apply (subgoal_tac "0 < b * (1 + q - q') ")
+apply (erule_tac [2] order_le_less_trans)
+ prefer 2 apply (simp add: right_diff_distrib right_distrib)
+apply (subgoal_tac "b * q' < b * (1 + q) ")
+ prefer 2 apply (simp add: right_diff_distrib right_distrib)
+apply (simp add: mult_less_cancel_left)
+done
+
+lemma unique_quotient_lemma_neg:
+ "[| b*q' + r' \<le> b*q + r; r \<le> 0; b < r; b < r' |]
+ ==> q \<le> (q'::int)"
+by (rule_tac b = "-b" and r = "-r'" and r' = "-r" in unique_quotient_lemma,
+ auto)
+
+lemma unique_quotient:
+ "[| quorem ((a,b), (q,r)); quorem ((a,b), (q',r')); b \<noteq> 0 |]
+ ==> q = q'"
+apply (simp add: quorem_def linorder_neq_iff split: split_if_asm)
+apply (blast intro: order_antisym
+ dest: order_eq_refl [THEN unique_quotient_lemma]
+ order_eq_refl [THEN unique_quotient_lemma_neg] sym)+
+done
+
+
+lemma unique_remainder:
+ "[| quorem ((a,b), (q,r)); quorem ((a,b), (q',r')); b \<noteq> 0 |]
+ ==> r = r'"
+apply (subgoal_tac "q = q'")
+ apply (simp add: quorem_def)
+apply (blast intro: unique_quotient)
+done
+
+
+subsection{*Correctness of @{term posDivAlg}, the Algorithm for Non-Negative Dividends*}
+
+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)
+ else (2*q, r))"
+by (simp add: Let_def adjust_def)
+
+declare posDivAlg.simps [simp del]
+
+text{*use with a simproc to avoid repeatedly proving the premise*}
+lemma posDivAlg_eqn:
+ "0 < b ==>
+ posDivAlg a b = (if a<b then (0,a) else adjust b (posDivAlg a (2*b)))"
+by (rule posDivAlg.simps [THEN trans], simp)
+
+text{*Correctness of @{term posDivAlg}: it computes quotients correctly*}
+theorem posDivAlg_correct:
+ assumes "0 \<le> a" and "0 < b"
+ shows "quorem ((a, b), posDivAlg a b)"
+using prems apply (induct a b rule: posDivAlg.induct)
+apply auto
+apply (simp add: quorem_def)
+apply (subst posDivAlg_eqn, simp add: right_distrib)
+apply (case_tac "a < b")
+apply simp_all
+apply (erule splitE)
+apply (auto simp add: right_distrib Let_def)
+done
+
+
+subsection{*Correctness of @{term negDivAlg}, the Algorithm for Negative Dividends*}
+
+text{*And positive divisors*}
+
+declare negDivAlg.simps [simp del]
+
+text{*use with a simproc to avoid repeatedly proving the premise*}
+lemma negDivAlg_eqn:
+ "0 < b ==>
+ negDivAlg a b =
+ (if 0\<le>a+b then (-1,a+b) else adjust b (negDivAlg a (2*b)))"
+by (rule negDivAlg.simps [THEN trans], simp)
+
+(*Correctness of negDivAlg: it computes quotients correctly
+ It doesn't work if a=0 because the 0/b equals 0, not -1*)
+lemma negDivAlg_correct:
+ assumes "a < 0" and "b > 0"
+ shows "quorem ((a, b), negDivAlg a b)"
+using prems apply (induct a b rule: negDivAlg.induct)
+apply (auto simp add: linorder_not_le)
+apply (simp add: quorem_def)
+apply (subst negDivAlg_eqn, assumption)
+apply (case_tac "a + b < (0\<Colon>int)")
+apply simp_all
+apply (erule splitE)
+apply (auto simp add: right_distrib Let_def)
+done
+
+
+subsection{*Existence Shown by Proving the Division Algorithm to be Correct*}
+
+(*the case a=0*)
+lemma quorem_0: "b \<noteq> 0 ==> quorem ((0,b), (0,0))"
+by (auto simp add: quorem_def linorder_neq_iff)
+
+lemma posDivAlg_0 [simp]: "posDivAlg 0 b = (0, 0)"
+by (subst posDivAlg.simps, auto)
+
+lemma negDivAlg_minus1 [simp]: "negDivAlg -1 b = (-1, b - 1)"
+by (subst negDivAlg.simps, auto)
+
+lemma negateSnd_eq [simp]: "negateSnd(q,r) = (q,-r)"
+by (simp add: negateSnd_def)
+
+lemma quorem_neg: "quorem ((-a,-b), qr) ==> quorem ((a,b), negateSnd qr)"
+by (auto simp add: split_ifs quorem_def)
+
+lemma divAlg_correct: "b \<noteq> 0 ==> quorem ((a,b), divAlg (a, b))"
+by (force simp add: linorder_neq_iff quorem_0 divAlg_def quorem_neg
+ posDivAlg_correct negDivAlg_correct)
+
+text{*Arbitrary definitions for division by zero. Useful to simplify
+ certain equations.*}
+
+lemma DIVISION_BY_ZERO [simp]: "a div (0::int) = 0 & a mod (0::int) = a"
+by (simp add: div_def mod_def divAlg_def posDivAlg.simps)
+
+
+text{*Basic laws about division and remainder*}
+
+lemma zmod_zdiv_equality: "(a::int) = b * (a div b) + (a mod b)"
+apply (case_tac "b = 0", simp)
+apply (cut_tac a = a and b = b in divAlg_correct)
+apply (auto simp add: quorem_def div_def mod_def)
+done
+
+lemma zdiv_zmod_equality: "(b * (a div b) + (a mod b)) + k = (a::int)+k"
+by(simp add: zmod_zdiv_equality[symmetric])
+
+lemma zdiv_zmod_equality2: "((a div b) * b + (a mod b)) + k = (a::int)+k"
+by(simp add: mult_commute zmod_zdiv_equality[symmetric])
+
+text {* Tool setup *}
+
+ML_setup {*
+local
+
+structure CancelDivMod = CancelDivModFun(
+struct
+ val div_name = @{const_name Divides.div};
+ val mod_name = @{const_name Divides.mod};
+ val mk_binop = HOLogic.mk_binop;
+ val mk_sum = Int_Numeral_Simprocs.mk_sum HOLogic.intT;
+ val dest_sum = Int_Numeral_Simprocs.dest_sum;
+ val div_mod_eqs =
+ map mk_meta_eq [@{thm zdiv_zmod_equality},
+ @{thm zdiv_zmod_equality2}];
+ val trans = trans;
+ val prove_eq_sums =
+ let
+ val simps = diff_int_def :: Int_Numeral_Simprocs.add_0s @ zadd_ac
+ in NatArithUtils.prove_conv all_tac (NatArithUtils.simp_all_tac simps) end;
+end)
+
+in
+
+val cancel_zdiv_zmod_proc = NatArithUtils.prep_simproc
+ ("cancel_zdiv_zmod", ["(m::int) + n"], K CancelDivMod.proc)
+
+end;
+
+Addsimprocs [cancel_zdiv_zmod_proc]
+*}
+
+lemma pos_mod_conj : "(0::int) < b ==> 0 \<le> a mod b & a mod b < b"
+apply (cut_tac a = a and b = b in divAlg_correct)
+apply (auto simp add: quorem_def mod_def)
+done
+
+lemmas pos_mod_sign [simp] = pos_mod_conj [THEN conjunct1, standard]
+ and pos_mod_bound [simp] = pos_mod_conj [THEN conjunct2, standard]
+
+lemma neg_mod_conj : "b < (0::int) ==> a mod b \<le> 0 & b < a mod b"
+apply (cut_tac a = a and b = b in divAlg_correct)
+apply (auto simp add: quorem_def div_def mod_def)
+done
+
+lemmas neg_mod_sign [simp] = neg_mod_conj [THEN conjunct1, standard]
+ and neg_mod_bound [simp] = neg_mod_conj [THEN conjunct2, standard]
+
+
+
+subsection{*General Properties of div and mod*}
+
+lemma quorem_div_mod: "b \<noteq> 0 ==> quorem ((a, b), (a div b, a mod b))"
+apply (cut_tac a = a and b = b in zmod_zdiv_equality)
+apply (force simp add: quorem_def linorder_neq_iff)
+done
+
+lemma quorem_div: "[| quorem((a,b),(q,r)); b \<noteq> 0 |] ==> a div b = q"
+by (simp add: quorem_div_mod [THEN unique_quotient])
+
+lemma quorem_mod: "[| quorem((a,b),(q,r)); b \<noteq> 0 |] ==> a mod b = r"
+by (simp add: quorem_div_mod [THEN unique_remainder])
+
+lemma div_pos_pos_trivial: "[| (0::int) \<le> a; a < b |] ==> a div b = 0"
+apply (rule quorem_div)
+apply (auto simp add: quorem_def)
+done
+
+lemma div_neg_neg_trivial: "[| a \<le> (0::int); b < a |] ==> a div b = 0"
+apply (rule quorem_div)
+apply (auto simp add: quorem_def)
+done
+
+lemma div_pos_neg_trivial: "[| (0::int) < a; a+b \<le> 0 |] ==> a div b = -1"
+apply (rule quorem_div)
+apply (auto simp add: quorem_def)
+done
+
+(*There is no div_neg_pos_trivial because 0 div b = 0 would supersede it*)
+
+lemma mod_pos_pos_trivial: "[| (0::int) \<le> a; a < b |] ==> a mod b = a"
+apply (rule_tac q = 0 in quorem_mod)
+apply (auto simp add: quorem_def)
+done
+
+lemma mod_neg_neg_trivial: "[| a \<le> (0::int); b < a |] ==> a mod b = a"
+apply (rule_tac q = 0 in quorem_mod)
+apply (auto simp add: quorem_def)
+done
+
+lemma mod_pos_neg_trivial: "[| (0::int) < a; a+b \<le> 0 |] ==> a mod b = a+b"
+apply (rule_tac q = "-1" in quorem_mod)
+apply (auto simp add: quorem_def)
+done
+
+text{*There is no @{text mod_neg_pos_trivial}.*}
+
+
+(*Simpler laws such as -a div b = -(a div b) FAIL, but see just below*)
+lemma zdiv_zminus_zminus [simp]: "(-a) div (-b) = a div (b::int)"
+apply (case_tac "b = 0", simp)
+apply (simp add: quorem_div_mod [THEN quorem_neg, simplified,
+ THEN quorem_div, THEN sym])
+
+done
+
+(*Simpler laws such as -a mod b = -(a mod b) FAIL, but see just below*)
+lemma zmod_zminus_zminus [simp]: "(-a) mod (-b) = - (a mod (b::int))"
+apply (case_tac "b = 0", simp)
+apply (subst quorem_div_mod [THEN quorem_neg, simplified, THEN quorem_mod],
+ auto)
+done
+
+
+subsection{*Laws for div and mod with Unary Minus*}
+
+lemma zminus1_lemma:
+ "quorem((a,b),(q,r))
+ ==> quorem ((-a,b), (if r=0 then -q else -q - 1),
+ (if r=0 then 0 else b-r))"
+by (force simp add: split_ifs quorem_def linorder_neq_iff right_diff_distrib)
+
+
+lemma zdiv_zminus1_eq_if:
+ "b \<noteq> (0::int)
+ ==> (-a) div b =
+ (if a mod b = 0 then - (a div b) else - (a div b) - 1)"
+by (blast intro: quorem_div_mod [THEN zminus1_lemma, THEN quorem_div])
+
+lemma zmod_zminus1_eq_if:
+ "(-a::int) mod b = (if a mod b = 0 then 0 else b - (a mod b))"
+apply (case_tac "b = 0", simp)
+apply (blast intro: quorem_div_mod [THEN zminus1_lemma, THEN quorem_mod])
+done
+
+lemma zdiv_zminus2: "a div (-b) = (-a::int) div b"
+by (cut_tac a = "-a" in zdiv_zminus_zminus, auto)
+
+lemma zmod_zminus2: "a mod (-b) = - ((-a::int) mod b)"
+by (cut_tac a = "-a" and b = b in zmod_zminus_zminus, auto)
+
+lemma zdiv_zminus2_eq_if:
+ "b \<noteq> (0::int)
+ ==> a div (-b) =
+ (if a mod b = 0 then - (a div b) else - (a div b) - 1)"
+by (simp add: zdiv_zminus1_eq_if zdiv_zminus2)
+
+lemma zmod_zminus2_eq_if:
+ "a mod (-b::int) = (if a mod b = 0 then 0 else (a mod b) - b)"
+by (simp add: zmod_zminus1_eq_if zmod_zminus2)
+
+
+subsection{*Division of a Number by Itself*}
+
+lemma self_quotient_aux1: "[| (0::int) < a; a = r + a*q; r < a |] ==> 1 \<le> q"
+apply (subgoal_tac "0 < a*q")
+ apply (simp add: zero_less_mult_iff, arith)
+done
+
+lemma self_quotient_aux2: "[| (0::int) < a; a = r + a*q; 0 \<le> r |] ==> q \<le> 1"
+apply (subgoal_tac "0 \<le> a* (1-q) ")
+ apply (simp add: zero_le_mult_iff)
+apply (simp add: right_diff_distrib)
+done
+
+lemma self_quotient: "[| quorem((a,a),(q,r)); a \<noteq> (0::int) |] ==> q = 1"
+apply (simp add: split_ifs quorem_def linorder_neq_iff)
+apply (rule order_antisym, safe, simp_all)
+apply (rule_tac [3] a = "-a" and r = "-r" in self_quotient_aux1)
+apply (rule_tac a = "-a" and r = "-r" in self_quotient_aux2)
+apply (force intro: self_quotient_aux1 self_quotient_aux2 simp add: add_commute)+
+done
+
+lemma self_remainder: "[| quorem((a,a),(q,r)); a \<noteq> (0::int) |] ==> r = 0"
+apply (frule self_quotient, assumption)
+apply (simp add: quorem_def)
+done
+
+lemma zdiv_self [simp]: "a \<noteq> 0 ==> a div a = (1::int)"
+by (simp add: quorem_div_mod [THEN self_quotient])
+
+(*Here we have 0 mod 0 = 0, also assumed by Knuth (who puts m mod 0 = 0) *)
+lemma zmod_self [simp]: "a mod a = (0::int)"
+apply (case_tac "a = 0", simp)
+apply (simp add: quorem_div_mod [THEN self_remainder])
+done
+
+
+subsection{*Computation of Division and Remainder*}
+
+lemma zdiv_zero [simp]: "(0::int) div b = 0"
+by (simp add: div_def divAlg_def)
+
+lemma div_eq_minus1: "(0::int) < b ==> -1 div b = -1"
+by (simp add: div_def divAlg_def)
+
+lemma zmod_zero [simp]: "(0::int) mod b = 0"
+by (simp add: mod_def divAlg_def)
+
+lemma zdiv_minus1: "(0::int) < b ==> -1 div b = -1"
+by (simp add: div_def divAlg_def)
+
+lemma zmod_minus1: "(0::int) < b ==> -1 mod b = b - 1"
+by (simp add: mod_def divAlg_def)
+
+text{*a positive, b positive *}
+
+lemma div_pos_pos: "[| 0 < a; 0 \<le> b |] ==> a div b = fst (posDivAlg a b)"
+by (simp add: div_def divAlg_def)
+
+lemma mod_pos_pos: "[| 0 < a; 0 \<le> b |] ==> a mod b = snd (posDivAlg a b)"
+by (simp add: mod_def divAlg_def)
+
+text{*a negative, b positive *}
+
+lemma div_neg_pos: "[| a < 0; 0 < b |] ==> a div b = fst (negDivAlg a b)"
+by (simp add: div_def divAlg_def)
+
+lemma mod_neg_pos: "[| a < 0; 0 < b |] ==> a mod b = snd (negDivAlg a b)"
+by (simp add: mod_def divAlg_def)
+
+text{*a positive, b negative *}
+
+lemma div_pos_neg:
+ "[| 0 < a; b < 0 |] ==> a div b = fst (negateSnd (negDivAlg (-a) (-b)))"
+by (simp add: div_def divAlg_def)
+
+lemma mod_pos_neg:
+ "[| 0 < a; b < 0 |] ==> a mod b = snd (negateSnd (negDivAlg (-a) (-b)))"
+by (simp add: mod_def divAlg_def)
+
+text{*a negative, b negative *}
+
+lemma div_neg_neg:
+ "[| a < 0; b \<le> 0 |] ==> a div b = fst (negateSnd (posDivAlg (-a) (-b)))"
+by (simp add: div_def divAlg_def)
+
+lemma mod_neg_neg:
+ "[| a < 0; b \<le> 0 |] ==> a mod b = snd (negateSnd (posDivAlg (-a) (-b)))"
+by (simp add: mod_def divAlg_def)
+
+text {*Simplify expresions in which div and mod combine numerical constants*}
+
+lemmas div_pos_pos_number_of [simp] =
+ div_pos_pos [of "number_of v" "number_of w", standard]
+
+lemmas div_neg_pos_number_of [simp] =
+ div_neg_pos [of "number_of v" "number_of w", standard]
+
+lemmas div_pos_neg_number_of [simp] =
+ div_pos_neg [of "number_of v" "number_of w", standard]
+
+lemmas div_neg_neg_number_of [simp] =
+ div_neg_neg [of "number_of v" "number_of w", standard]
+
+
+lemmas mod_pos_pos_number_of [simp] =
+ mod_pos_pos [of "number_of v" "number_of w", standard]
+
+lemmas mod_neg_pos_number_of [simp] =
+ mod_neg_pos [of "number_of v" "number_of w", standard]
+
+lemmas mod_pos_neg_number_of [simp] =
+ mod_pos_neg [of "number_of v" "number_of w", standard]
+
+lemmas mod_neg_neg_number_of [simp] =
+ mod_neg_neg [of "number_of v" "number_of w", standard]
+
+
+lemmas posDivAlg_eqn_number_of [simp] =
+ posDivAlg_eqn [of "number_of v" "number_of w", standard]
+
+lemmas negDivAlg_eqn_number_of [simp] =
+ negDivAlg_eqn [of "number_of v" "number_of w", standard]
+
+
+text{*Special-case simplification *}
+
+lemma zmod_1 [simp]: "a mod (1::int) = 0"
+apply (cut_tac a = a and b = 1 in pos_mod_sign)
+apply (cut_tac [2] a = a and b = 1 in pos_mod_bound)
+apply (auto simp del:pos_mod_bound pos_mod_sign)
+done
+
+lemma zdiv_1 [simp]: "a div (1::int) = a"
+by (cut_tac a = a and b = 1 in zmod_zdiv_equality, auto)
+
+lemma zmod_minus1_right [simp]: "a mod (-1::int) = 0"
+apply (cut_tac a = a and b = "-1" in neg_mod_sign)
+apply (cut_tac [2] a = a and b = "-1" in neg_mod_bound)
+apply (auto simp del: neg_mod_sign neg_mod_bound)
+done
+
+lemma zdiv_minus1_right [simp]: "a div (-1::int) = -a"
+by (cut_tac a = a and b = "-1" in zmod_zdiv_equality, auto)
+
+(** 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 int_0_less_1, of "number_of w", standard]
+
+lemmas div_pos_neg_1_number_of [simp] =
+ div_pos_neg [OF int_0_less_1, of "number_of w", standard]
+
+lemmas mod_pos_pos_1_number_of [simp] =
+ mod_pos_pos [OF int_0_less_1, of "number_of w", standard]
+
+lemmas mod_pos_neg_1_number_of [simp] =
+ mod_pos_neg [OF int_0_less_1, of "number_of w", standard]
+
+
+lemmas posDivAlg_eqn_1_number_of [simp] =
+ posDivAlg_eqn [of concl: 1 "number_of w", standard]
+
+lemmas negDivAlg_eqn_1_number_of [simp] =
+ negDivAlg_eqn [of concl: 1 "number_of w", standard]
+
+
+
+subsection{*Monotonicity in the First Argument (Dividend)*}
+
+lemma zdiv_mono1: "[| a \<le> a'; 0 < (b::int) |] ==> a div b \<le> a' div b"
+apply (cut_tac a = a and b = b in zmod_zdiv_equality)
+apply (cut_tac a = a' and b = b in zmod_zdiv_equality)
+apply (rule unique_quotient_lemma)
+apply (erule subst)
+apply (erule subst, simp_all)
+done
+
+lemma zdiv_mono1_neg: "[| a \<le> a'; (b::int) < 0 |] ==> a' div b \<le> a div b"
+apply (cut_tac a = a and b = b in zmod_zdiv_equality)
+apply (cut_tac a = a' and b = b in zmod_zdiv_equality)
+apply (rule unique_quotient_lemma_neg)
+apply (erule subst)
+apply (erule subst, simp_all)
+done
+
+
+subsection{*Monotonicity in the Second Argument (Divisor)*}
+
+lemma q_pos_lemma:
+ "[| 0 \<le> b'*q' + r'; r' < b'; 0 < b' |] ==> 0 \<le> (q'::int)"
+apply (subgoal_tac "0 < b'* (q' + 1) ")
+ apply (simp add: zero_less_mult_iff)
+apply (simp add: right_distrib)
+done
+
+lemma zdiv_mono2_lemma:
+ "[| b*q + r = b'*q' + r'; 0 \<le> b'*q' + r';
+ r' < b'; 0 \<le> r; 0 < b'; b' \<le> b |]
+ ==> q \<le> (q'::int)"
+apply (frule q_pos_lemma, assumption+)
+apply (subgoal_tac "b*q < b* (q' + 1) ")
+ apply (simp add: mult_less_cancel_left)
+apply (subgoal_tac "b*q = r' - r + b'*q'")
+ prefer 2 apply simp
+apply (simp (no_asm_simp) add: right_distrib)
+apply (subst add_commute, rule zadd_zless_mono, arith)
+apply (rule mult_right_mono, auto)
+done
+
+lemma zdiv_mono2:
+ "[| (0::int) \<le> a; 0 < b'; b' \<le> b |] ==> a div b \<le> a div b'"
+apply (subgoal_tac "b \<noteq> 0")
+ prefer 2 apply arith
+apply (cut_tac a = a and b = b in zmod_zdiv_equality)
+apply (cut_tac a = a and b = b' in zmod_zdiv_equality)
+apply (rule zdiv_mono2_lemma)
+apply (erule subst)
+apply (erule subst, simp_all)
+done
+
+lemma q_neg_lemma:
+ "[| b'*q' + r' < 0; 0 \<le> r'; 0 < b' |] ==> q' \<le> (0::int)"
+apply (subgoal_tac "b'*q' < 0")
+ apply (simp add: mult_less_0_iff, arith)
+done
+
+lemma zdiv_mono2_neg_lemma:
+ "[| b*q + r = b'*q' + r'; b'*q' + r' < 0;
+ r < b; 0 \<le> r'; 0 < b'; b' \<le> b |]
+ ==> q' \<le> (q::int)"
+apply (frule q_neg_lemma, assumption+)
+apply (subgoal_tac "b*q' < b* (q + 1) ")
+ apply (simp add: mult_less_cancel_left)
+apply (simp add: right_distrib)
+apply (subgoal_tac "b*q' \<le> b'*q'")
+ prefer 2 apply (simp add: mult_right_mono_neg, arith)
+done
+
+lemma zdiv_mono2_neg:
+ "[| a < (0::int); 0 < b'; b' \<le> b |] ==> a div b' \<le> a div b"
+apply (cut_tac a = a and b = b in zmod_zdiv_equality)
+apply (cut_tac a = a and b = b' in zmod_zdiv_equality)
+apply (rule zdiv_mono2_neg_lemma)
+apply (erule subst)
+apply (erule subst, simp_all)
+done
+
+subsection{*More Algebraic Laws for div and mod*}
+
+text{*proving (a*b) div c = a * (b div c) + a * (b mod c) *}
+
+lemma zmult1_lemma:
+ "[| quorem((b,c),(q,r)); c \<noteq> 0 |]
+ ==> quorem ((a*b, c), (a*q + a*r div c, a*r mod c))"
+by (force simp add: split_ifs quorem_def linorder_neq_iff right_distrib)
+
+lemma zdiv_zmult1_eq: "(a*b) div c = a*(b div c) + a*(b mod c) div (c::int)"
+apply (case_tac "c = 0", simp)
+apply (blast intro: quorem_div_mod [THEN zmult1_lemma, THEN quorem_div])
+done
+
+lemma zmod_zmult1_eq: "(a*b) mod c = a*(b mod c) mod (c::int)"
+apply (case_tac "c = 0", simp)
+apply (blast intro: quorem_div_mod [THEN zmult1_lemma, THEN quorem_mod])
+done
+
+lemma zmod_zmult1_eq': "(a*b) mod (c::int) = ((a mod c) * b) mod c"
+apply (rule trans)
+apply (rule_tac s = "b*a mod c" in trans)
+apply (rule_tac [2] zmod_zmult1_eq)
+apply (simp_all add: mult_commute)
+done
+
+lemma zmod_zmult_distrib: "(a*b) mod (c::int) = ((a mod c) * (b mod c)) mod c"
+apply (rule zmod_zmult1_eq' [THEN trans])
+apply (rule zmod_zmult1_eq)
+done
+
+lemma zdiv_zmult_self1 [simp]: "b \<noteq> (0::int) ==> (a*b) div b = a"
+by (simp add: zdiv_zmult1_eq)
+
+lemma zdiv_zmult_self2 [simp]: "b \<noteq> (0::int) ==> (b*a) div b = a"
+by (subst mult_commute, erule zdiv_zmult_self1)
+
+lemma zmod_zmult_self1 [simp]: "(a*b) mod b = (0::int)"
+by (simp add: zmod_zmult1_eq)
+
+lemma zmod_zmult_self2 [simp]: "(b*a) mod b = (0::int)"
+by (simp add: mult_commute zmod_zmult1_eq)
+
+lemma zmod_eq_0_iff: "(m mod d = 0) = (EX q::int. m = d*q)"
+proof
+ assume "m mod d = 0"
+ with zmod_zdiv_equality[of m d] show "EX q::int. m = d*q" by auto
+next
+ assume "EX q::int. m = d*q"
+ thus "m mod d = 0" by auto
+qed
+
+lemmas zmod_eq_0D [dest!] = zmod_eq_0_iff [THEN iffD1]
+
+text{*proving (a+b) div c = a div c + b div c + ((a mod c + b mod c) div c) *}
+
+lemma zadd1_lemma:
+ "[| quorem((a,c),(aq,ar)); quorem((b,c),(bq,br)); c \<noteq> 0 |]
+ ==> quorem ((a+b, c), (aq + bq + (ar+br) div c, (ar+br) mod c))"
+by (force simp add: split_ifs quorem_def linorder_neq_iff right_distrib)
+
+(*NOT suitable for rewriting: the RHS has an instance of the LHS*)
+lemma zdiv_zadd1_eq:
+ "(a+b) div (c::int) = a div c + b div c + ((a mod c + b mod c) div c)"
+apply (case_tac "c = 0", simp)
+apply (blast intro: zadd1_lemma [OF quorem_div_mod quorem_div_mod] quorem_div)
+done
+
+lemma zmod_zadd1_eq: "(a+b) mod (c::int) = (a mod c + b mod c) mod c"
+apply (case_tac "c = 0", simp)
+apply (blast intro: zadd1_lemma [OF quorem_div_mod quorem_div_mod] quorem_mod)
+done
+
+lemma mod_div_trivial [simp]: "(a mod b) div b = (0::int)"
+apply (case_tac "b = 0", simp)
+apply (auto simp add: linorder_neq_iff div_pos_pos_trivial div_neg_neg_trivial)
+done
+
+lemma mod_mod_trivial [simp]: "(a mod b) mod b = a mod (b::int)"
+apply (case_tac "b = 0", simp)
+apply (force simp add: linorder_neq_iff mod_pos_pos_trivial mod_neg_neg_trivial)
+done
+
+lemma zmod_zadd_left_eq: "(a+b) mod (c::int) = ((a mod c) + b) mod c"
+apply (rule trans [symmetric])
+apply (rule zmod_zadd1_eq, simp)
+apply (rule zmod_zadd1_eq [symmetric])
+done
+
+lemma zmod_zadd_right_eq: "(a+b) mod (c::int) = (a + (b mod c)) mod c"
+apply (rule trans [symmetric])
+apply (rule zmod_zadd1_eq, simp)
+apply (rule zmod_zadd1_eq [symmetric])
+done
+
+lemma zdiv_zadd_self1[simp]: "a \<noteq> (0::int) ==> (a+b) div a = b div a + 1"
+by (simp add: zdiv_zadd1_eq)
+
+lemma zdiv_zadd_self2[simp]: "a \<noteq> (0::int) ==> (b+a) div a = b div a + 1"
+by (simp add: zdiv_zadd1_eq)
+
+lemma zmod_zadd_self1[simp]: "(a+b) mod a = b mod (a::int)"
+apply (case_tac "a = 0", simp)
+apply (simp add: zmod_zadd1_eq)
+done
+
+lemma zmod_zadd_self2[simp]: "(b+a) mod a = b mod (a::int)"
+apply (case_tac "a = 0", simp)
+apply (simp add: zmod_zadd1_eq)
+done
+
+
+subsection{*Proving @{term "a div (b*c) = (a div b) div c"} *}
+
+(*The condition c>0 seems necessary. Consider that 7 div ~6 = ~2 but
+ 7 div 2 div ~3 = 3 div ~3 = ~1. The subcase (a div b) mod c = 0 seems
+ to cause particular problems.*)
+
+text{*first, four lemmas to bound the remainder for the cases b<0 and b>0 *}
+
+lemma zmult2_lemma_aux1: "[| (0::int) < c; b < r; r \<le> 0 |] ==> b*c < b*(q mod c) + r"
+apply (subgoal_tac "b * (c - q mod c) < r * 1")
+apply (simp add: right_diff_distrib)
+apply (rule order_le_less_trans)
+apply (erule_tac [2] mult_strict_right_mono)
+apply (rule mult_left_mono_neg)
+apply (auto simp add: compare_rls add_commute [of 1]
+ add1_zle_eq pos_mod_bound)
+done
+
+lemma zmult2_lemma_aux2:
+ "[| (0::int) < c; b < r; r \<le> 0 |] ==> b * (q mod c) + r \<le> 0"
+apply (subgoal_tac "b * (q mod c) \<le> 0")
+ apply arith
+apply (simp add: mult_le_0_iff)
+done
+
+lemma zmult2_lemma_aux3: "[| (0::int) < c; 0 \<le> r; r < b |] ==> 0 \<le> b * (q mod c) + r"
+apply (subgoal_tac "0 \<le> b * (q mod c) ")
+apply arith
+apply (simp add: zero_le_mult_iff)
+done
+
+lemma zmult2_lemma_aux4: "[| (0::int) < c; 0 \<le> r; r < b |] ==> b * (q mod c) + r < b * c"
+apply (subgoal_tac "r * 1 < b * (c - q mod c) ")
+apply (simp add: right_diff_distrib)
+apply (rule order_less_le_trans)
+apply (erule mult_strict_right_mono)
+apply (rule_tac [2] mult_left_mono)
+apply (auto simp add: compare_rls add_commute [of 1]
+ add1_zle_eq pos_mod_bound)
+done
+
+lemma zmult2_lemma: "[| quorem ((a,b), (q,r)); b \<noteq> 0; 0 < c |]
+ ==> quorem ((a, b*c), (q div c, b*(q mod c) + r))"
+by (auto simp add: mult_ac quorem_def linorder_neq_iff
+ zero_less_mult_iff right_distrib [symmetric]
+ zmult2_lemma_aux1 zmult2_lemma_aux2 zmult2_lemma_aux3 zmult2_lemma_aux4)
+
+lemma zdiv_zmult2_eq: "(0::int) < c ==> a div (b*c) = (a div b) div c"
+apply (case_tac "b = 0", simp)
+apply (force simp add: quorem_div_mod [THEN zmult2_lemma, THEN quorem_div])
+done
+
+lemma zmod_zmult2_eq:
+ "(0::int) < c ==> a mod (b*c) = b*(a div b mod c) + a mod b"
+apply (case_tac "b = 0", simp)
+apply (force simp add: quorem_div_mod [THEN zmult2_lemma, THEN quorem_mod])
+done
+
+
+subsection{*Cancellation of Common Factors in div*}
+
+lemma zdiv_zmult_zmult1_aux1:
+ "[| (0::int) < b; c \<noteq> 0 |] ==> (c*a) div (c*b) = a div b"
+by (subst zdiv_zmult2_eq, auto)
+
+lemma zdiv_zmult_zmult1_aux2:
+ "[| b < (0::int); c \<noteq> 0 |] ==> (c*a) div (c*b) = a div b"
+apply (subgoal_tac " (c * (-a)) div (c * (-b)) = (-a) div (-b) ")
+apply (rule_tac [2] zdiv_zmult_zmult1_aux1, auto)
+done
+
+lemma zdiv_zmult_zmult1: "c \<noteq> (0::int) ==> (c*a) div (c*b) = a div b"
+apply (case_tac "b = 0", simp)
+apply (auto simp add: linorder_neq_iff zdiv_zmult_zmult1_aux1 zdiv_zmult_zmult1_aux2)
+done
+
+lemma zdiv_zmult_zmult2: "c \<noteq> (0::int) ==> (a*c) div (b*c) = a div b"
+apply (drule zdiv_zmult_zmult1)
+apply (auto simp add: mult_commute)
+done
+
+
+
+subsection{*Distribution of Factors over mod*}
+
+lemma zmod_zmult_zmult1_aux1:
+ "[| (0::int) < b; c \<noteq> 0 |] ==> (c*a) mod (c*b) = c * (a mod b)"
+by (subst zmod_zmult2_eq, auto)
+
+lemma zmod_zmult_zmult1_aux2:
+ "[| b < (0::int); c \<noteq> 0 |] ==> (c*a) mod (c*b) = c * (a mod b)"
+apply (subgoal_tac " (c * (-a)) mod (c * (-b)) = c * ((-a) mod (-b))")
+apply (rule_tac [2] zmod_zmult_zmult1_aux1, auto)
+done
+
+lemma zmod_zmult_zmult1: "(c*a) mod (c*b) = (c::int) * (a mod b)"
+apply (case_tac "b = 0", simp)
+apply (case_tac "c = 0", simp)
+apply (auto simp add: linorder_neq_iff zmod_zmult_zmult1_aux1 zmod_zmult_zmult1_aux2)
+done
+
+lemma zmod_zmult_zmult2: "(a*c) mod (b*c) = (a mod b) * (c::int)"
+apply (cut_tac c = c in zmod_zmult_zmult1)
+apply (auto simp add: mult_commute)
+done
+
+
+subsection {*Splitting Rules for div and mod*}
+
+text{*The proofs of the two lemmas below are essentially identical*}
+
+lemma split_pos_lemma:
+ "0<k ==>
+ P(n div k :: int)(n mod k) = (\<forall>i j. 0\<le>j & j<k & n = k*i + j --> P i j)"
+apply (rule iffI, clarify)
+ apply (erule_tac P="P ?x ?y" in rev_mp)
+ apply (subst zmod_zadd1_eq)
+ apply (subst zdiv_zadd1_eq)
+ apply (simp add: div_pos_pos_trivial mod_pos_pos_trivial)
+txt{*converse direction*}
+apply (drule_tac x = "n div k" in spec)
+apply (drule_tac x = "n mod k" in spec, simp)
+done
+
+lemma split_neg_lemma:
+ "k<0 ==>
+ P(n div k :: int)(n mod k) = (\<forall>i j. k<j & j\<le>0 & n = k*i + j --> P i j)"
+apply (rule iffI, clarify)
+ apply (erule_tac P="P ?x ?y" in rev_mp)
+ apply (subst zmod_zadd1_eq)
+ apply (subst zdiv_zadd1_eq)
+ apply (simp add: div_neg_neg_trivial mod_neg_neg_trivial)
+txt{*converse direction*}
+apply (drule_tac x = "n div k" in spec)
+apply (drule_tac x = "n mod k" in spec, simp)
+done
+
+lemma split_zdiv:
+ "P(n div k :: int) =
+ ((k = 0 --> P 0) &
+ (0<k --> (\<forall>i j. 0\<le>j & j<k & n = k*i + j --> P i)) &
+ (k<0 --> (\<forall>i j. k<j & j\<le>0 & n = k*i + j --> P i)))"
+apply (case_tac "k=0", simp)
+apply (simp only: linorder_neq_iff)
+apply (erule disjE)
+ apply (simp_all add: split_pos_lemma [of concl: "%x y. P x"]
+ split_neg_lemma [of concl: "%x y. P x"])
+done
+
+lemma split_zmod:
+ "P(n mod k :: int) =
+ ((k = 0 --> P n) &
+ (0<k --> (\<forall>i j. 0\<le>j & j<k & n = k*i + j --> P j)) &
+ (k<0 --> (\<forall>i j. k<j & j\<le>0 & n = k*i + j --> P j)))"
+apply (case_tac "k=0", simp)
+apply (simp only: linorder_neq_iff)
+apply (erule disjE)
+ apply (simp_all add: split_pos_lemma [of concl: "%x y. P y"]
+ split_neg_lemma [of concl: "%x y. P y"])
+done
+
+(* Enable arith to deal with div 2 and mod 2: *)
+declare split_zdiv [of _ _ "number_of k", simplified, standard, arith_split]
+declare split_zmod [of _ _ "number_of k", simplified, standard, arith_split]
+
+
+subsection{*Speeding up the Division Algorithm with Shifting*}
+
+text{*computing div by shifting *}
+
+lemma pos_zdiv_mult_2: "(0::int) \<le> a ==> (1 + 2*b) div (2*a) = b div a"
+proof cases
+ assume "a=0"
+ thus ?thesis by simp
+next
+ assume "a\<noteq>0" and le_a: "0\<le>a"
+ hence a_pos: "1 \<le> a" by arith
+ hence one_less_a2: "1 < 2*a" by arith
+ hence le_2a: "2 * (1 + b mod a) \<le> 2 * a"
+ by (simp add: mult_le_cancel_left add_commute [of 1] add1_zle_eq)
+ with a_pos have "0 \<le> b mod a" by simp
+ hence le_addm: "0 \<le> 1 mod (2*a) + 2*(b mod a)"
+ by (simp add: mod_pos_pos_trivial one_less_a2)
+ with le_2a
+ have "(1 mod (2*a) + 2*(b mod a)) div (2*a) = 0"
+ by (simp add: div_pos_pos_trivial le_addm mod_pos_pos_trivial one_less_a2
+ right_distrib)
+ thus ?thesis
+ by (subst zdiv_zadd1_eq,
+ simp add: zdiv_zmult_zmult1 zmod_zmult_zmult1 one_less_a2
+ div_pos_pos_trivial)
+qed
+
+lemma neg_zdiv_mult_2: "a \<le> (0::int) ==> (1 + 2*b) div (2*a) = (b+1) div a"
+apply (subgoal_tac " (1 + 2* (-b - 1)) div (2 * (-a)) = (-b - 1) div (-a) ")
+apply (rule_tac [2] pos_zdiv_mult_2)
+apply (auto simp add: minus_mult_right [symmetric] right_diff_distrib)
+apply (subgoal_tac " (-1 - (2 * b)) = - (1 + (2 * b))")
+apply (simp only: zdiv_zminus_zminus diff_minus minus_add_distrib [symmetric],
+ simp)
+done
+
+
+(*Not clear why this must be proved separately; probably number_of causes
+ simplification problems*)
+lemma not_0_le_lemma: "~ 0 \<le> x ==> x \<le> (0::int)"
+by auto
+
+lemma zdiv_number_of_BIT[simp]:
+ "number_of (v BIT b) div number_of (w BIT bit.B0) =
+ (if b=bit.B0 | (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: zdiv_zmult_zmult1 pos_zdiv_mult_2 neg_zdiv_mult_2 add_ac
+ split: bit.split)
+done
+
+
+subsection{*Computing mod by Shifting (proofs resemble those for div)*}
+
+lemma pos_zmod_mult_2:
+ "(0::int) \<le> a ==> (1 + 2*b) mod (2*a) = 1 + 2 * (b mod a)"
+apply (case_tac "a = 0", simp)
+apply (subgoal_tac "1 < a * 2")
+ prefer 2 apply arith
+apply (subgoal_tac "2* (1 + b mod a) \<le> 2*a")
+ apply (rule_tac [2] mult_left_mono)
+apply (auto simp add: add_commute [of 1] mult_commute add1_zle_eq
+ pos_mod_bound)
+apply (subst zmod_zadd1_eq)
+apply (simp add: zmod_zmult_zmult2 mod_pos_pos_trivial)
+apply (rule mod_pos_pos_trivial)
+apply (auto simp add: mod_pos_pos_trivial left_distrib)
+apply (subgoal_tac "0 \<le> b mod a", arith, simp)
+done
+
+lemma neg_zmod_mult_2:
+ "a \<le> (0::int) ==> (1 + 2*b) mod (2*a) = 2 * ((b+1) mod a) - 1"
+apply (subgoal_tac "(1 + 2* (-b - 1)) mod (2* (-a)) =
+ 1 + 2* ((-b - 1) mod (-a))")
+apply (rule_tac [2] pos_zmod_mult_2)
+apply (auto simp add: minus_mult_right [symmetric] right_diff_distrib)
+apply (subgoal_tac " (-1 - (2 * b)) = - (1 + (2 * b))")
+ prefer 2 apply simp
+apply (simp only: zmod_zminus_zminus diff_minus minus_add_distrib [symmetric])
+done
+
+lemma zmod_number_of_BIT [simp]:
+ "number_of (v BIT b) mod number_of (w BIT bit.B0) =
+ (case b of
+ bit.B0 => 2 * (number_of v mod number_of w)
+ | bit.B1 => 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 UNIV_I split: bit.split)
+apply (simp add: zmod_zmult_zmult1 pos_zmod_mult_2
+ not_0_le_lemma neg_zmod_mult_2 add_ac)
+done
+
+
+subsection{*Quotients of Signs*}
+
+lemma div_neg_pos_less0: "[| a < (0::int); 0 < b |] ==> a div b < 0"
+apply (subgoal_tac "a div b \<le> -1", force)
+apply (rule order_trans)
+apply (rule_tac a' = "-1" in zdiv_mono1)
+apply (auto simp add: zdiv_minus1)
+done
+
+lemma div_nonneg_neg_le0: "[| (0::int) \<le> a; b < 0 |] ==> a div b \<le> 0"
+by (drule zdiv_mono1_neg, auto)
+
+lemma pos_imp_zdiv_nonneg_iff: "(0::int) < b ==> (0 \<le> a div b) = (0 \<le> a)"
+apply auto
+apply (drule_tac [2] zdiv_mono1)
+apply (auto simp add: linorder_neq_iff)
+apply (simp (no_asm_use) add: linorder_not_less [symmetric])
+apply (blast intro: div_neg_pos_less0)
+done
+
+lemma neg_imp_zdiv_nonneg_iff:
+ "b < (0::int) ==> (0 \<le> a div b) = (a \<le> (0::int))"
+apply (subst zdiv_zminus_zminus [symmetric])
+apply (subst pos_imp_zdiv_nonneg_iff, auto)
+done
+
+(*But not (a div b \<le> 0 iff a\<le>0); consider a=1, b=2 when a div b = 0.*)
+lemma pos_imp_zdiv_neg_iff: "(0::int) < b ==> (a div b < 0) = (a < 0)"
+by (simp add: linorder_not_le [symmetric] pos_imp_zdiv_nonneg_iff)
+
+(*Again the law fails for \<le>: consider a = -1, b = -2 when a div b = 0*)
+lemma neg_imp_zdiv_neg_iff: "b < (0::int) ==> (a div b < 0) = (0 < a)"
+by (simp add: linorder_not_le [symmetric] neg_imp_zdiv_nonneg_iff)
+
+
+subsection {* The Divides Relation *}
+
+lemma zdvd_iff_zmod_eq_0: "(m dvd n) = (n mod m = (0::int))"
+by(simp add:dvd_def zmod_eq_0_iff)
+
+lemmas zdvd_iff_zmod_eq_0_number_of [simp] =
+ zdvd_iff_zmod_eq_0 [of "number_of x" "number_of y", standard]
+
+lemma zdvd_0_right [iff]: "(m::int) dvd 0"
+by (simp add: dvd_def)
+
+lemma zdvd_0_left [iff]: "(0 dvd (m::int)) = (m = 0)"
+ by (simp add: dvd_def)
+
+lemma zdvd_1_left [iff]: "1 dvd (m::int)"
+ by (simp add: dvd_def)
+
+lemma zdvd_refl [simp]: "m dvd (m::int)"
+by (auto simp add: dvd_def intro: zmult_1_right [symmetric])
+
+lemma zdvd_trans: "m dvd n ==> n dvd k ==> m dvd (k::int)"
+by (auto simp add: dvd_def intro: mult_assoc)
+
+lemma zdvd_zminus_iff: "(m dvd -n) = (m dvd (n::int))"
+ apply (simp add: dvd_def, auto)
+ apply (rule_tac [!] x = "-k" in exI, auto)
+ done
+
+lemma zdvd_zminus2_iff: "(-m dvd n) = (m dvd (n::int))"
+ apply (simp add: dvd_def, auto)
+ apply (rule_tac [!] x = "-k" in exI, auto)
+ done
+lemma zdvd_abs1: "( \<bar>i::int\<bar> dvd j) = (i dvd j)"
+ apply (cases "i > 0", simp)
+ apply (simp add: dvd_def)
+ apply (rule iffI)
+ apply (erule exE)
+ apply (rule_tac x="- k" in exI, simp)
+ apply (erule exE)
+ apply (rule_tac x="- k" in exI, simp)
+ done
+lemma zdvd_abs2: "( (i::int) dvd \<bar>j\<bar>) = (i dvd j)"
+ apply (cases "j > 0", simp)
+ apply (simp add: dvd_def)
+ apply (rule iffI)
+ apply (erule exE)
+ apply (rule_tac x="- k" in exI, simp)
+ apply (erule exE)
+ apply (rule_tac x="- k" in exI, simp)
+ done
+
+lemma zdvd_anti_sym:
+ "0 < m ==> 0 < n ==> m dvd n ==> n dvd m ==> m = (n::int)"
+ apply (simp add: dvd_def, auto)
+ apply (simp add: mult_assoc zero_less_mult_iff zmult_eq_1_iff)
+ done
+
+lemma zdvd_zadd: "k dvd m ==> k dvd n ==> k dvd (m + n :: int)"
+ apply (simp add: dvd_def)
+ apply (blast intro: right_distrib [symmetric])
+ done
+
+lemma zdvd_dvd_eq: assumes anz:"a \<noteq> 0" and ab: "(a::int) dvd b" and ba:"b dvd a"
+ shows "\<bar>a\<bar> = \<bar>b\<bar>"
+proof-
+ from ab obtain k where k:"b = a*k" unfolding dvd_def by blast
+ from ba obtain k' where k':"a = b*k'" unfolding dvd_def by blast
+ from k k' have "a = a*k*k'" by simp
+ with mult_cancel_left1[where c="a" and b="k*k'"]
+ have kk':"k*k' = 1" using anz by (simp add: mult_assoc)
+ hence "k = 1 \<and> k' = 1 \<or> k = -1 \<and> k' = -1" by (simp add: zmult_eq_1_iff)
+ thus ?thesis using k k' by auto
+qed
+
+lemma zdvd_zdiff: "k dvd m ==> k dvd n ==> k dvd (m - n :: int)"
+ apply (simp add: dvd_def)
+ apply (blast intro: right_diff_distrib [symmetric])
+ done
+
+lemma zdvd_zdiffD: "k dvd m - n ==> k dvd n ==> k dvd (m::int)"
+ apply (subgoal_tac "m = n + (m - n)")
+ apply (erule ssubst)
+ apply (blast intro: zdvd_zadd, simp)
+ done
+
+lemma zdvd_zmult: "k dvd (n::int) ==> k dvd m * n"
+ apply (simp add: dvd_def)
+ apply (blast intro: mult_left_commute)
+ done
+
+lemma zdvd_zmult2: "k dvd (m::int) ==> k dvd m * n"
+ apply (subst mult_commute)
+ apply (erule zdvd_zmult)
+ done
+
+lemma zdvd_triv_right [iff]: "(k::int) dvd m * k"
+ apply (rule zdvd_zmult)
+ apply (rule zdvd_refl)
+ done
+
+lemma zdvd_triv_left [iff]: "(k::int) dvd k * m"
+ apply (rule zdvd_zmult2)
+ apply (rule zdvd_refl)
+ done
+
+lemma zdvd_zmultD2: "j * k dvd n ==> j dvd (n::int)"
+ apply (simp add: dvd_def)
+ apply (simp add: mult_assoc, blast)
+ done
+
+lemma zdvd_zmultD: "j * k dvd n ==> k dvd (n::int)"
+ apply (rule zdvd_zmultD2)
+ apply (subst mult_commute, assumption)
+ done
+
+lemma zdvd_zmult_mono: "i dvd m ==> j dvd (n::int) ==> i * j dvd m * n"
+ apply (simp add: dvd_def, clarify)
+ apply (rule_tac x = "k * ka" in exI)
+ apply (simp add: mult_ac)
+ done
+
+lemma zdvd_reduce: "(k dvd n + k * m) = (k dvd (n::int))"
+ apply (rule iffI)
+ apply (erule_tac [2] zdvd_zadd)
+ apply (subgoal_tac "n = (n + k * m) - k * m")
+ apply (erule ssubst)
+ apply (erule zdvd_zdiff, simp_all)
+ done
+
+lemma zdvd_zmod: "f dvd m ==> f dvd (n::int) ==> f dvd m mod n"
+ apply (simp add: dvd_def)
+ apply (auto simp add: zmod_zmult_zmult1)
+ done
+
+lemma zdvd_zmod_imp_zdvd: "k dvd m mod n ==> k dvd n ==> k dvd (m::int)"
+ apply (subgoal_tac "k dvd n * (m div n) + m mod n")
+ apply (simp add: zmod_zdiv_equality [symmetric])
+ apply (simp only: zdvd_zadd zdvd_zmult2)
+ done
+
+lemma zdvd_not_zless: "0 < m ==> m < n ==> \<not> n dvd (m::int)"
+ apply (simp add: dvd_def, auto)
+ apply (subgoal_tac "0 < n")
+ prefer 2
+ apply (blast intro: order_less_trans)
+ apply (simp add: zero_less_mult_iff)
+ apply (subgoal_tac "n * k < n * 1")
+ apply (drule mult_less_cancel_left [THEN iffD1], auto)
+ done
+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: ring_eq_simps)
+
+lemma zdvd_mult_div_cancel:"(n::int) dvd m \<Longrightarrow> n * (m div n) = m"
+apply (subgoal_tac "m mod n = 0")
+ apply (simp add: zmult_div_cancel)
+apply (simp only: zdvd_iff_zmod_eq_0)
+done
+
+lemma zdvd_mult_cancel: assumes d:"k * m dvd k * n" and kz:"k \<noteq> (0::int)"
+ shows "m dvd n"
+proof-
+ from d obtain h where h: "k*n = k*m * h" unfolding dvd_def by blast
+ {assume "n \<noteq> m*h" hence "k* n \<noteq> k* (m*h)" using kz by simp
+ with h have False by (simp add: mult_assoc)}
+ hence "n = m * h" by blast
+ thus ?thesis by blast
+qed
+
+theorem ex_nat: "(\<exists>x::nat. P x) = (\<exists>x::int. 0 <= x \<and> P (nat x))"
+ apply (simp split add: split_nat)
+ apply (rule iffI)
+ apply (erule exE)
+ apply (rule_tac x = "int x" in exI)
+ apply simp
+ apply (erule exE)
+ apply (rule_tac x = "nat x" in exI)
+ apply (erule conjE)
+ apply (erule_tac x = "nat x" in allE)
+ apply simp
+ done
+
+theorem zdvd_int: "(x dvd y) = (int x dvd int y)"
+ apply (simp only: dvd_def ex_nat int_int_eq [symmetric] zmult_int [symmetric]
+ nat_0_le cong add: conj_cong)
+ apply (rule iffI)
+ apply iprover
+ apply (erule exE)
+ apply (case_tac "x=0")
+ apply (rule_tac x=0 in exI)
+ apply simp
+ apply (case_tac "0 \<le> k")
+ apply iprover
+ apply (simp add: linorder_not_le)
+ apply (drule mult_strict_left_mono_neg [OF iffD2 [OF zero_less_int_conv]])
+ apply assumption
+ apply (simp add: mult_ac)
+ done
+
+lemma zdvd1_eq[simp]: "(x::int) dvd 1 = ( \<bar>x\<bar> = 1)"
+proof
+ assume d: "x dvd 1" hence "int (nat \<bar>x\<bar>) dvd int (nat 1)" by (simp add: zdvd_abs1)
+ hence "nat \<bar>x\<bar> dvd 1" by (simp add: zdvd_int)
+ hence "nat \<bar>x\<bar> = 1" by simp
+ thus "\<bar>x\<bar> = 1" by (cases "x < 0", auto)
+next
+ assume "\<bar>x\<bar>=1" thus "x dvd 1"
+ by(cases "x < 0",simp_all add: minus_equation_iff zdvd_iff_zmod_eq_0)
+qed
+lemma zdvd_mult_cancel1:
+ assumes mp:"m \<noteq>(0::int)" shows "(m * n dvd m) = (\<bar>n\<bar> = 1)"
+proof
+ assume n1: "\<bar>n\<bar> = 1" thus "m * n dvd m"
+ by (cases "n >0", auto simp add: zdvd_zminus2_iff minus_equation_iff)
+next
+ assume H: "m * n dvd m" hence H2: "m * n dvd m * 1" by simp
+ from zdvd_mult_cancel[OF H2 mp] show "\<bar>n\<bar> = 1" by (simp only: zdvd1_eq)
+qed
+
+lemma int_dvd_iff: "(int m dvd z) = (m dvd nat (abs z))"
+ apply (auto simp add: dvd_def nat_abs_mult_distrib)
+ apply (auto simp add: nat_eq_iff abs_if split add: split_if_asm)
+ apply (rule_tac x = "-(int k)" in exI)
+ apply (auto simp add: int_mult)
+ done
+
+lemma dvd_int_iff: "(z dvd int m) = (nat (abs z) dvd m)"
+ apply (auto simp add: dvd_def abs_if int_mult)
+ apply (rule_tac [3] x = "nat k" in exI)
+ apply (rule_tac [2] x = "-(int k)" in exI)
+ apply (rule_tac x = "nat (-k)" in exI)
+ apply (cut_tac [3] k = m in int_less_0_conv)
+ apply (cut_tac k = m in int_less_0_conv)
+ apply (auto simp add: zero_le_mult_iff mult_less_0_iff
+ nat_mult_distrib [symmetric] nat_eq_iff2)
+ done
+
+lemma nat_dvd_iff: "(nat z dvd m) = (if 0 \<le> z then (z dvd int m) else m = 0)"
+ apply (auto simp add: dvd_def int_mult)
+ apply (rule_tac x = "nat k" in exI)
+ apply (cut_tac k = m in int_less_0_conv)
+ apply (auto simp add: zero_le_mult_iff mult_less_0_iff
+ nat_mult_distrib [symmetric] nat_eq_iff2)
+ done
+
+lemma zminus_dvd_iff [iff]: "(-z dvd w) = (z dvd (w::int))"
+ apply (auto simp add: dvd_def)
+ apply (rule_tac [!] x = "-k" in exI, auto)
+ done
+
+lemma dvd_zminus_iff [iff]: "(z dvd -w) = (z dvd (w::int))"
+ apply (auto simp add: dvd_def)
+ apply (drule minus_equation_iff [THEN iffD1])
+ apply (rule_tac [!] x = "-k" in exI, auto)
+ done
+
+lemma zdvd_imp_le: "[| z dvd n; 0 < n |] ==> z \<le> (n::int)"
+ apply (rule_tac z=n in int_cases)
+ apply (auto simp add: dvd_int_iff)
+ apply (rule_tac z=z in int_cases)
+ apply (auto simp add: dvd_imp_le)
+ done
+
+
+subsection{*Integer Powers*}
+
+instance int :: power ..
+
+primrec
+ "p ^ 0 = 1"
+ "p ^ (Suc n) = (p::int) * (p ^ n)"
+
+
+instance int :: recpower
+proof
+ fix z :: int
+ fix n :: nat
+ show "z^0 = 1" by simp
+ show "z^(Suc n) = z * (z^n)" by simp
+qed
+
+
+lemma zpower_zmod: "((x::int) mod m)^y mod m = x^y mod m"
+apply (induct "y", auto)
+apply (rule zmod_zmult1_eq [THEN trans])
+apply (simp (no_asm_simp))
+apply (rule zmod_zmult_distrib [symmetric])
+done
+
+lemma zpower_zadd_distrib: "x^(y+z) = ((x^y)*(x^z)::int)"
+ by (rule Power.power_add)
+
+lemma zpower_zpower: "(x^y)^z = (x^(y*z)::int)"
+ by (rule Power.power_mult [symmetric])
+
+lemma zero_less_zpower_abs_iff [simp]:
+ "(0 < (abs x)^n) = (x \<noteq> (0::int) | n=0)"
+apply (induct "n")
+apply (auto simp add: zero_less_mult_iff)
+done
+
+lemma zero_le_zpower_abs [simp]: "(0::int) <= (abs x)^n"
+apply (induct "n")
+apply (auto simp add: zero_le_mult_iff)
+done
+
+lemma int_power: "int (m^n) = (int m) ^ n"
+ by (induct n, simp_all add: int_mult)
+
+text{*Compatibility binding*}
+lemmas zpower_int = int_power [symmetric]
+
+lemma zdiv_int: "int (a div b) = (int a) div (int b)"
+apply (subst split_div, auto)
+apply (subst split_zdiv, auto)
+apply (rule_tac a="int (b * i) + int j" and b="int b" and r="int j" and r'=ja in IntDiv.unique_quotient)
+apply (auto simp add: IntDiv.quorem_def int_eq_of_nat)
+done
+
+lemma zmod_int: "int (a mod b) = (int a) mod (int b)"
+apply (subst split_mod, auto)
+apply (subst split_zmod, auto)
+apply (rule_tac a="int (b * i) + int j" and b="int b" and q="int i" and q'=ia
+ in unique_remainder)
+apply (auto simp add: IntDiv.quorem_def int_eq_of_nat)
+done
+
+text{*Suggested by Matthias Daum*}
+lemma int_power_div_base:
+ "\<lbrakk>0 < m; 0 < k\<rbrakk> \<Longrightarrow> k ^ m div k = (k::int) ^ (m - Suc 0)"
+apply (subgoal_tac "k ^ m = k ^ ((m - 1) + 1)")
+ apply (erule ssubst)
+ apply (simp only: power_add)
+ apply simp_all
+done
+
+text {* code serializer setup *}
+
+code_modulename SML
+ IntDiv Integer
+
+code_modulename OCaml
+ IntDiv Integer
+
+code_modulename Haskell
+ IntDiv Divides
+
+end
--- a/src/HOL/Integ/IntArith.thy Thu May 31 18:16:51 2007 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,411 +0,0 @@
-(* Title: HOL/Integ/IntArith.thy
- ID: $Id$
- Authors: Larry Paulson and Tobias Nipkow
-*)
-
-header {* Integer arithmetic *}
-
-theory IntArith
-imports Numeral "../Wellfounded_Relations"
-uses "~~/src/Provers/Arith/assoc_fold.ML" ("int_arith1.ML")
-begin
-
-text{*Duplicate: can't understand why it's necessary*}
-declare numeral_0_eq_0 [simp]
-
-
-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 one_add_one_is_two: "1 + 1 = (2::'a::number_ring)"
-by (simp del: numeral_1_eq_1 add: numeral_1_eq_1 [symmetric] add_number_of_eq)
-
-lemmas add_special =
- one_add_one_is_two
- binop_eq [of "op +", OF add_number_of_eq numeral_1_eq_1 refl, standard]
- binop_eq [of "op +", OF add_number_of_eq refl numeral_1_eq_1, standard]
-
-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, standard]
- binop_eq [of "op -", OF diff_number_of_eq refl numeral_1_eq_1, standard]
-
-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, standard]
- binop_eq [of "op =", OF eq_number_of_eq numeral_1_eq_1 refl, standard]
- binop_eq [of "op =", OF eq_number_of_eq refl numeral_0_eq_0, standard]
- binop_eq [of "op =", OF eq_number_of_eq refl numeral_1_eq_1, standard]
-
-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_eq_neg numeral_0_eq_0 refl, standard]
- binop_eq [of "op <", OF less_number_of_eq_neg numeral_1_eq_1 refl, standard]
- binop_eq [of "op <", OF less_number_of_eq_neg refl numeral_0_eq_0, standard]
- binop_eq [of "op <", OF less_number_of_eq_neg refl numeral_1_eq_1, standard]
-
-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_eq numeral_0_eq_0 refl, standard]
- binop_eq [of "op \<le>", OF le_number_of_eq numeral_1_eq_1 refl, standard]
- binop_eq [of "op \<le>", OF le_number_of_eq refl numeral_0_eq_0, standard]
- binop_eq [of "op \<le>", OF le_number_of_eq refl numeral_1_eq_1, standard]
-
-lemmas arith_special[simp] =
- add_special diff_special eq_special less_special le_special
-
-
-lemma min_max_01: "min (0::int) 1 = 0 & min (1::int) 0 = 0 &
- max (0::int) 1 = 1 & max (1::int) 0 = 1"
-by(simp add:min_def max_def)
-
-lemmas min_max_special[simp] =
- min_max_01
- max_def[of "0::int" "number_of v", standard, simp]
- min_def[of "0::int" "number_of v", standard, simp]
- max_def[of "number_of u" "0::int", standard, simp]
- min_def[of "number_of u" "0::int", standard, simp]
- max_def[of "1::int" "number_of v", standard, simp]
- min_def[of "1::int" "number_of v", standard, simp]
- max_def[of "number_of u" "1::int", standard, simp]
- min_def[of "number_of u" "1::int", standard, simp]
-
-use "int_arith1.ML"
-setup int_arith_setup
-
-
-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::{ordered_idom,number_ring})"
-by (simp add: abs_if)
-
-lemma abs_power_minus_one [simp]:
- "abs(-1 ^ n) = (1::'a::{ordered_idom,number_ring,recpower})"
-by (simp add: power_abs)
-
-lemma of_int_number_of_eq:
- "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*}
-lemma mult_2: "2 * z = (z+z::'a::number_ring)"
-proof -
- have "2*z = (1 + 1)*z" by simp
- also have "... = z+z" by (simp add: left_distrib)
- finally show ?thesis .
-qed
-
-lemma mult_2_right: "z * 2 = (z+z::'a::number_ring)"
-by (subst mult_commute, rule mult_2)
-
-
-subsection{*More Inequality Reasoning*}
-
-lemma zless_add1_eq: "(w < z + (1::int)) = (w<z | w=z)"
-by arith
-
-lemma add1_zle_eq: "(w + (1::int) \<le> z) = (w<z)"
-by arith
-
-lemma zle_diff1_eq [simp]: "(w \<le> z - (1::int)) = (w<z)"
-by arith
-
-lemma zle_add1_eq_le [simp]: "(w < z + (1::int)) = (w\<le>z)"
-by arith
-
-lemma int_one_le_iff_zero_less: "((1::int) \<le> z) = (0 < z)"
-by arith
-
-
-subsection{*The Functions @{term nat} and @{term int}*}
-
-text{*Simplify the terms @{term "int 0"}, @{term "int(Suc 0)"} and
- @{term "w + - z"}*}
-declare Zero_int_def [symmetric, simp]
-declare One_int_def [symmetric, simp]
-
-lemmas diff_int_def_symmetric = diff_int_def [symmetric, simp]
-
-lemma nat_0: "nat 0 = 0"
-by (simp add: nat_eq_iff)
-
-lemma nat_1: "nat 1 = Suc 0"
-by (subst nat_eq_iff, simp)
-
-lemma nat_2: "nat 2 = Suc (Suc 0)"
-by (subst nat_eq_iff, simp)
-
-lemma one_less_nat_eq [simp]: "(Suc 0 < nat z) = (1 < z)"
-apply (insert zless_nat_conj [of 1 z])
-apply (auto simp add: nat_1)
-done
-
-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", standard]
-
-
-lemma split_nat [arith_split]:
- "P(nat(i::int)) = ((\<forall>n. i = int n \<longrightarrow> P n) & (i < 0 \<longrightarrow> P 0))"
- (is "?P = (?L & ?R)")
-proof (cases "i < 0")
- case True thus ?thesis by simp
-next
- case False
- have "?P = ?L"
- proof
- assume ?P thus ?L using False by clarsimp
- next
- assume ?L thus ?P using False by simp
- qed
- with False show ?thesis by simp
-qed
-
-
-(*Analogous to zadd_int*)
-lemma zdiff_int: "n \<le> m ==> int m - int n = int (m-n)"
-by (induct m n rule: diff_induct, simp_all)
-
-lemma nat_mult_distrib: "(0::int) \<le> z ==> nat (z*z') = nat z * nat z'"
-apply (cases "0 \<le> z'")
-apply (rule inj_int [THEN injD])
-apply (simp add: int_mult zero_le_mult_iff)
-apply (simp add: mult_le_0_iff)
-done
-
-lemma nat_mult_distrib_neg: "z \<le> (0::int) ==> nat(z*z') = nat(-z) * nat(-z')"
-apply (rule trans)
-apply (rule_tac [2] nat_mult_distrib, auto)
-done
-
-lemma nat_abs_mult_distrib: "nat (abs (w * z)) = nat (abs w) * nat (abs z)"
-apply (cases "z=0 | w=0")
-apply (auto simp add: abs_if nat_mult_distrib [symmetric]
- nat_mult_distrib_neg [symmetric] mult_less_0_iff)
-done
-
-
-subsection "Induction principles for int"
-
-text{*Well-founded segments of the integers*}
-
-definition
- int_ge_less_than :: "int => (int * int) set"
-where
- "int_ge_less_than d = {(z',z). d \<le> z' & z' < z}"
-
-theorem wf_int_ge_less_than: "wf (int_ge_less_than d)"
-proof -
- have "int_ge_less_than d \<subseteq> measure (%z. nat (z-d))"
- by (auto simp add: int_ge_less_than_def)
- thus ?thesis
- by (rule wf_subset [OF wf_measure])
-qed
-
-text{*This variant looks odd, but is typical of the relations suggested
-by RankFinder.*}
-
-definition
- int_ge_less_than2 :: "int => (int * int) set"
-where
- "int_ge_less_than2 d = {(z',z). d \<le> z & z' < z}"
-
-theorem wf_int_ge_less_than2: "wf (int_ge_less_than2 d)"
-proof -
- have "int_ge_less_than2 d \<subseteq> measure (%z. nat (1+z-d))"
- by (auto simp add: int_ge_less_than2_def)
- thus ?thesis
- by (rule wf_subset [OF wf_measure])
-qed
-
- (* `set:int': dummy construction *)
-theorem int_ge_induct[case_names base step,induct set:int]:
- assumes ge: "k \<le> (i::int)" and
- base: "P(k)" and
- step: "\<And>i. \<lbrakk>k \<le> i; P i\<rbrakk> \<Longrightarrow> P(i+1)"
- shows "P i"
-proof -
- { fix n have "\<And>i::int. n = nat(i-k) \<Longrightarrow> k \<le> i \<Longrightarrow> P i"
- proof (induct n)
- case 0
- hence "i = k" by arith
- thus "P i" using base by simp
- next
- case (Suc n)
- hence "n = nat((i - 1) - k)" by arith
- moreover
- have ki1: "k \<le> i - 1" using Suc.prems by arith
- ultimately
- have "P(i - 1)" by(rule Suc.hyps)
- from step[OF ki1 this] show ?case by simp
- qed
- }
- with ge show ?thesis by fast
-qed
-
- (* `set:int': dummy construction *)
-theorem int_gr_induct[case_names base step,induct set:int]:
- assumes gr: "k < (i::int)" and
- base: "P(k+1)" and
- step: "\<And>i. \<lbrakk>k < i; P i\<rbrakk> \<Longrightarrow> P(i+1)"
- shows "P i"
-apply(rule int_ge_induct[of "k + 1"])
- using gr apply arith
- apply(rule base)
-apply (rule step, simp+)
-done
-
-theorem int_le_induct[consumes 1,case_names base step]:
- assumes le: "i \<le> (k::int)" and
- base: "P(k)" and
- step: "\<And>i. \<lbrakk>i \<le> k; P i\<rbrakk> \<Longrightarrow> P(i - 1)"
- shows "P i"
-proof -
- { fix n have "\<And>i::int. n = nat(k-i) \<Longrightarrow> i \<le> k \<Longrightarrow> P i"
- proof (induct n)
- case 0
- hence "i = k" by arith
- thus "P i" using base by simp
- next
- case (Suc n)
- hence "n = nat(k - (i+1))" by arith
- moreover
- have ki1: "i + 1 \<le> k" using Suc.prems by arith
- ultimately
- have "P(i+1)" by(rule Suc.hyps)
- from step[OF ki1 this] show ?case by simp
- qed
- }
- with le show ?thesis by fast
-qed
-
-theorem int_less_induct [consumes 1,case_names base step]:
- assumes less: "(i::int) < k" and
- base: "P(k - 1)" and
- step: "\<And>i. \<lbrakk>i < k; P i\<rbrakk> \<Longrightarrow> P(i - 1)"
- shows "P i"
-apply(rule int_le_induct[of _ "k - 1"])
- using less apply arith
- apply(rule base)
-apply (rule step, simp+)
-done
-
-subsection{*Intermediate value theorems*}
-
-lemma int_val_lemma:
- "(\<forall>i<n::nat. abs(f(i+1) - f i) \<le> 1) -->
- f 0 \<le> k --> k \<le> f n --> (\<exists>i \<le> n. f i = (k::int))"
-apply (induct_tac "n", simp)
-apply (intro strip)
-apply (erule impE, simp)
-apply (erule_tac x = n in allE, simp)
-apply (case_tac "k = f (n+1) ")
- apply force
-apply (erule impE)
- apply (simp add: abs_if split add: split_if_asm)
-apply (blast intro: le_SucI)
-done
-
-lemmas nat0_intermed_int_val = int_val_lemma [rule_format (no_asm)]
-
-lemma nat_intermed_int_val:
- "[| \<forall>i. m \<le> i & i < n --> abs(f(i + 1::nat) - f i) \<le> 1; m < n;
- f m \<le> k; k \<le> f n |] ==> ? i. m \<le> i & i \<le> n & f i = (k::int)"
-apply (cut_tac n = "n-m" and f = "%i. f (i+m) " and k = k
- in int_val_lemma)
-apply simp
-apply (erule exE)
-apply (rule_tac x = "i+m" in exI, arith)
-done
-
-
-subsection{*Products and 1, by T. M. Rasmussen*}
-
-lemma zabs_less_one_iff [simp]: "(\<bar>z\<bar> < 1) = (z = (0::int))"
-by arith
-
-lemma abs_zmult_eq_1: "(\<bar>m * n\<bar> = 1) ==> \<bar>m\<bar> = (1::int)"
-apply (cases "\<bar>n\<bar>=1")
-apply (simp add: abs_mult)
-apply (rule ccontr)
-apply (auto simp add: linorder_neq_iff abs_mult)
-apply (subgoal_tac "2 \<le> \<bar>m\<bar> & 2 \<le> \<bar>n\<bar>")
- prefer 2 apply arith
-apply (subgoal_tac "2*2 \<le> \<bar>m\<bar> * \<bar>n\<bar>", simp)
-apply (rule mult_mono, auto)
-done
-
-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)
-
-lemma pos_zmult_eq_1_iff: "0 < (m::int) ==> (m * n = 1) = (m = 1 & n = 1)"
-apply (auto dest: pos_zmult_eq_1_iff_lemma)
-apply (simp add: mult_commute [of m])
-apply (frule pos_zmult_eq_1_iff_lemma, auto)
-done
-
-lemma zmult_eq_1_iff: "(m*n = (1::int)) = ((m = 1 & n = 1) | (m = -1 & n = -1))"
-apply (rule iffI)
- apply (frule pos_zmult_eq_1_iff_lemma)
- apply (simp add: mult_commute [of m])
- apply (frule pos_zmult_eq_1_iff_lemma, auto)
-done
-
-
-subsection {* Legacy ML bindings *}
-
-ML {*
-val of_int_number_of_eq = @{thm of_int_number_of_eq};
-val nat_0 = @{thm nat_0};
-val nat_1 = @{thm nat_1};
-*}
-
-end
--- a/src/HOL/Integ/IntDef.thy Thu May 31 18:16:51 2007 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,890 +0,0 @@
-(* Title: IntDef.thy
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1996 University of Cambridge
-
-*)
-
-header{*The Integers as Equivalence Classes over Pairs of Natural Numbers*}
-
-theory IntDef
-imports Equiv_Relations Nat
-begin
-
-text {* the equivalence relation underlying the integers *}
-
-definition
- intrel :: "((nat \<times> nat) \<times> (nat \<times> nat)) set"
-where
- "intrel = {((x, y), (u, v)) | x y u v. x + v = u +y }"
-
-typedef (Integ)
- int = "UNIV//intrel"
- by (auto simp add: quotient_def)
-
-definition
- int :: "nat \<Rightarrow> int"
-where
- [code func del]: "int m = Abs_Integ (intrel `` {(m, 0)})"
-
-instance int :: zero
- Zero_int_def: "0 \<equiv> int 0" ..
-
-instance int :: one
- One_int_def: "1 \<equiv> int 1" ..
-
-instance int :: plus
- add_int_def: "z + w \<equiv> Abs_Integ
- (\<Union>(x, y) \<in> Rep_Integ z. \<Union>(u, v) \<in> Rep_Integ w.
- intrel `` {(x + u, y + v)})" ..
-
-instance int :: minus
- minus_int_def:
- "- z \<equiv> Abs_Integ (\<Union>(x, y) \<in> Rep_Integ z. intrel `` {(y, x)})"
- diff_int_def: "z - w \<equiv> z + (-w)" ..
-
-instance int :: times
- mult_int_def: "z * w \<equiv> Abs_Integ
- (\<Union>(x, y) \<in> Rep_Integ z. \<Union>(u,v ) \<in> Rep_Integ w.
- intrel `` {(x*u + y*v, x*v + y*u)})" ..
-
-instance int :: ord
- le_int_def:
- "z \<le> w \<equiv> \<exists>x y u v. x+v \<le> u+y \<and> (x, y) \<in> Rep_Integ z \<and> (u, v) \<in> Rep_Integ w"
- less_int_def: "z < w \<equiv> z \<le> w \<and> z \<noteq> w" ..
-
-lemmas [code func del] = Zero_int_def One_int_def add_int_def
- minus_int_def mult_int_def le_int_def less_int_def
-
-
-subsection{*Construction of the Integers*}
-
-subsubsection{*Preliminary Lemmas about the Equivalence Relation*}
-
-lemma intrel_iff [simp]: "(((x,y),(u,v)) \<in> intrel) = (x+v = u+y)"
-by (simp add: intrel_def)
-
-lemma equiv_intrel: "equiv UNIV intrel"
-by (simp add: intrel_def equiv_def refl_def sym_def trans_def)
-
-text{*Reduces equality of equivalence classes to the @{term intrel} relation:
- @{term "(intrel `` {x} = intrel `` {y}) = ((x,y) \<in> intrel)"} *}
-lemmas equiv_intrel_iff [simp] = eq_equiv_class_iff [OF equiv_intrel UNIV_I UNIV_I]
-
-text{*All equivalence classes belong to set of representatives*}
-lemma [simp]: "intrel``{(x,y)} \<in> Integ"
-by (auto simp add: Integ_def intrel_def quotient_def)
-
-text{*Reduces equality on abstractions to equality on representatives:
- @{prop "\<lbrakk>x \<in> Integ; y \<in> Integ\<rbrakk> \<Longrightarrow> (Abs_Integ x = Abs_Integ y) = (x=y)"} *}
-declare Abs_Integ_inject [simp] Abs_Integ_inverse [simp]
-
-text{*Case analysis on the representation of an integer as an equivalence
- class of pairs of naturals.*}
-lemma eq_Abs_Integ [case_names Abs_Integ, cases type: int]:
- "(!!x y. z = Abs_Integ(intrel``{(x,y)}) ==> P) ==> P"
-apply (rule Abs_Integ_cases [of z])
-apply (auto simp add: Integ_def quotient_def)
-done
-
-
-subsubsection{*@{term int}: Embedding the Naturals into the Integers*}
-
-lemma inj_int: "inj int"
-by (simp add: inj_on_def int_def)
-
-lemma int_int_eq [iff]: "(int m = int n) = (m = n)"
-by (fast elim!: inj_int [THEN injD])
-
-
-subsubsection{*Integer Unary Negation*}
-
-lemma minus: "- Abs_Integ(intrel``{(x,y)}) = Abs_Integ(intrel `` {(y,x)})"
-proof -
- have "(\<lambda>(x,y). intrel``{(y,x)}) respects intrel"
- by (simp add: congruent_def)
- thus ?thesis
- by (simp add: minus_int_def UN_equiv_class [OF equiv_intrel])
-qed
-
-lemma zminus_zminus: "- (- z) = (z::int)"
- by (cases z) (simp add: minus)
-
-lemma zminus_0: "- 0 = (0::int)"
- by (simp add: int_def Zero_int_def minus)
-
-
-subsection{*Integer Addition*}
-
-lemma add:
- "Abs_Integ (intrel``{(x,y)}) + Abs_Integ (intrel``{(u,v)}) =
- Abs_Integ (intrel``{(x+u, y+v)})"
-proof -
- have "(\<lambda>z w. (\<lambda>(x,y). (\<lambda>(u,v). intrel `` {(x+u, y+v)}) w) z)
- respects2 intrel"
- by (simp add: congruent2_def)
- thus ?thesis
- by (simp add: add_int_def UN_UN_split_split_eq
- UN_equiv_class2 [OF equiv_intrel equiv_intrel])
-qed
-
-lemma zminus_zadd_distrib: "- (z + w) = (- z) + (- w::int)"
- by (cases z, cases w) (simp add: minus add)
-
-lemma zadd_commute: "(z::int) + w = w + z"
- by (cases z, cases w) (simp add: add_ac add)
-
-lemma zadd_assoc: "((z1::int) + z2) + z3 = z1 + (z2 + z3)"
- by (cases z1, cases z2, cases z3) (simp add: add add_assoc)
-
-(*For AC rewriting*)
-lemma zadd_left_commute: "x + (y + z) = y + ((x + z) ::int)"
- apply (rule mk_left_commute [of "op +"])
- apply (rule zadd_assoc)
- apply (rule zadd_commute)
- done
-
-lemmas zadd_ac = zadd_assoc zadd_commute zadd_left_commute
-
-lemmas zmult_ac = OrderedGroup.mult_ac
-
-lemma zadd_int: "(int m) + (int n) = int (m + n)"
- by (simp add: int_def add)
-
-lemma zadd_int_left: "(int m) + (int n + z) = int (m + n) + z"
- by (simp add: zadd_int zadd_assoc [symmetric])
-
-(*also for the instance declaration int :: comm_monoid_add*)
-lemma zadd_0: "(0::int) + z = z"
-apply (simp add: Zero_int_def int_def)
-apply (cases z, simp add: add)
-done
-
-lemma zadd_0_right: "z + (0::int) = z"
-by (rule trans [OF zadd_commute zadd_0])
-
-lemma zadd_zminus_inverse2: "(- z) + z = (0::int)"
-by (cases z, simp add: int_def Zero_int_def minus add)
-
-
-subsection{*Integer Multiplication*}
-
-text{*Congruence property for multiplication*}
-lemma mult_congruent2:
- "(%p1 p2. (%(x,y). (%(u,v). intrel``{(x*u + y*v, x*v + y*u)}) p2) p1)
- respects2 intrel"
-apply (rule equiv_intrel [THEN congruent2_commuteI])
- apply (force simp add: mult_ac, clarify)
-apply (simp add: congruent_def mult_ac)
-apply (rename_tac u v w x y z)
-apply (subgoal_tac "u*y + x*y = w*y + v*y & u*z + x*z = w*z + v*z")
-apply (simp add: mult_ac)
-apply (simp add: add_mult_distrib [symmetric])
-done
-
-
-lemma mult:
- "Abs_Integ((intrel``{(x,y)})) * Abs_Integ((intrel``{(u,v)})) =
- Abs_Integ(intrel `` {(x*u + y*v, x*v + y*u)})"
-by (simp add: mult_int_def UN_UN_split_split_eq mult_congruent2
- UN_equiv_class2 [OF equiv_intrel equiv_intrel])
-
-lemma zmult_zminus: "(- z) * w = - (z * (w::int))"
-by (cases z, cases w, simp add: minus mult add_ac)
-
-lemma zmult_commute: "(z::int) * w = w * z"
-by (cases z, cases w, simp add: mult add_ac mult_ac)
-
-lemma zmult_assoc: "((z1::int) * z2) * z3 = z1 * (z2 * z3)"
-by (cases z1, cases z2, cases z3, simp add: mult add_mult_distrib2 mult_ac)
-
-lemma zadd_zmult_distrib: "((z1::int) + z2) * w = (z1 * w) + (z2 * w)"
-by (cases z1, cases z2, cases w, simp add: add mult add_mult_distrib2 mult_ac)
-
-lemma zadd_zmult_distrib2: "(w::int) * (z1 + z2) = (w * z1) + (w * z2)"
-by (simp add: zmult_commute [of w] zadd_zmult_distrib)
-
-lemma zdiff_zmult_distrib: "((z1::int) - z2) * w = (z1 * w) - (z2 * w)"
-by (simp add: diff_int_def zadd_zmult_distrib zmult_zminus)
-
-lemma zdiff_zmult_distrib2: "(w::int) * (z1 - z2) = (w * z1) - (w * z2)"
-by (simp add: zmult_commute [of w] zdiff_zmult_distrib)
-
-lemmas int_distrib =
- zadd_zmult_distrib zadd_zmult_distrib2
- zdiff_zmult_distrib zdiff_zmult_distrib2
-
-lemma int_mult: "int (m * n) = (int m) * (int n)"
-by (simp add: int_def mult)
-
-text{*Compatibility binding*}
-lemmas zmult_int = int_mult [symmetric]
-
-lemma zmult_1: "(1::int) * z = z"
-by (cases z, simp add: One_int_def int_def mult)
-
-lemma zmult_1_right: "z * (1::int) = z"
-by (rule trans [OF zmult_commute zmult_1])
-
-
-text{*The integers form a @{text comm_ring_1}*}
-instance int :: comm_ring_1
-proof
- fix i j k :: int
- show "(i + j) + k = i + (j + k)" by (simp add: zadd_assoc)
- show "i + j = j + i" by (simp add: zadd_commute)
- show "0 + i = i" by (rule zadd_0)
- show "- i + i = 0" by (rule zadd_zminus_inverse2)
- show "i - j = i + (-j)" by (simp add: diff_int_def)
- show "(i * j) * k = i * (j * k)" by (rule zmult_assoc)
- show "i * j = j * i" by (rule zmult_commute)
- show "1 * i = i" by (rule zmult_1)
- show "(i + j) * k = i * k + j * k" by (simp add: int_distrib)
- show "0 \<noteq> (1::int)"
- by (simp only: Zero_int_def One_int_def One_nat_def int_int_eq)
-qed
-
-
-subsection{*The @{text "\<le>"} Ordering*}
-
-lemma le:
- "(Abs_Integ(intrel``{(x,y)}) \<le> Abs_Integ(intrel``{(u,v)})) = (x+v \<le> u+y)"
-by (force simp add: le_int_def)
-
-lemma zle_refl: "w \<le> (w::int)"
-by (cases w, simp add: le)
-
-lemma zle_trans: "[| i \<le> j; j \<le> k |] ==> i \<le> (k::int)"
-by (cases i, cases j, cases k, simp add: le)
-
-lemma zle_anti_sym: "[| z \<le> w; w \<le> z |] ==> z = (w::int)"
-by (cases w, cases z, simp add: le)
-
-instance int :: order
- by intro_classes
- (assumption |
- rule zle_refl zle_trans zle_anti_sym less_int_def [THEN meta_eq_to_obj_eq])+
-
-lemma zle_linear: "(z::int) \<le> w \<or> w \<le> z"
-by (cases z, cases w) (simp add: le linorder_linear)
-
-instance int :: linorder
- by intro_classes (rule zle_linear)
-
-lemmas zless_linear = linorder_less_linear [where 'a = int]
-
-
-lemma int_eq_0_conv [simp]: "(int n = 0) = (n = 0)"
-by (simp add: Zero_int_def)
-
-lemma zless_int [simp]: "(int m < int n) = (m<n)"
-by (simp add: le add int_def linorder_not_le [symmetric])
-
-lemma int_less_0_conv [simp]: "~ (int k < 0)"
-by (simp add: Zero_int_def)
-
-lemma zero_less_int_conv [simp]: "(0 < int n) = (0 < n)"
-by (simp add: Zero_int_def)
-
-lemma int_0_less_1: "0 < (1::int)"
-by (simp only: Zero_int_def One_int_def One_nat_def zless_int)
-
-lemma int_0_neq_1 [simp]: "0 \<noteq> (1::int)"
-by (simp only: Zero_int_def One_int_def One_nat_def int_int_eq)
-
-lemma zle_int [simp]: "(int m \<le> int n) = (m\<le>n)"
-by (simp add: linorder_not_less [symmetric])
-
-lemma zero_zle_int [simp]: "(0 \<le> int n)"
-by (simp add: Zero_int_def)
-
-lemma int_le_0_conv [simp]: "(int n \<le> 0) = (n = 0)"
-by (simp add: Zero_int_def)
-
-lemma int_0 [simp]: "int 0 = (0::int)"
-by (simp add: Zero_int_def)
-
-lemma int_1 [simp]: "int 1 = 1"
-by (simp add: One_int_def)
-
-lemma int_Suc0_eq_1: "int (Suc 0) = 1"
-by (simp add: One_int_def One_nat_def)
-
-lemma int_Suc: "int (Suc m) = 1 + (int m)"
-by (simp add: One_int_def zadd_int)
-
-
-subsection{*Monotonicity results*}
-
-lemma zadd_left_mono: "i \<le> j ==> k + i \<le> k + (j::int)"
-by (cases i, cases j, cases k, simp add: le add)
-
-lemma zadd_strict_right_mono: "i < j ==> i + k < j + (k::int)"
-apply (cases i, cases j, cases k)
-apply (simp add: linorder_not_le [where 'a = int, symmetric]
- linorder_not_le [where 'a = nat] le add)
-done
-
-lemma zadd_zless_mono: "[| w'<w; z'\<le>z |] ==> w' + z' < w + (z::int)"
-by (rule order_less_le_trans [OF zadd_strict_right_mono zadd_left_mono])
-
-
-subsection{*Strict Monotonicity of Multiplication*}
-
-text{*strict, in 1st argument; proof is by induction on k>0*}
-lemma zmult_zless_mono2_lemma:
- "i<j ==> 0<k ==> int k * i < int k * j"
-apply (induct "k", simp)
-apply (simp add: int_Suc)
-apply (case_tac "k=0")
-apply (simp_all add: zadd_zmult_distrib int_Suc0_eq_1 order_le_less)
-apply (simp add: zadd_zless_mono int_Suc0_eq_1 order_le_less)
-done
-
-lemma zero_le_imp_eq_int: "0 \<le> k ==> \<exists>n. k = int n"
-apply (cases k)
-apply (auto simp add: le add int_def Zero_int_def)
-apply (rule_tac x="x-y" in exI, simp)
-done
-
-lemma zmult_zless_mono2: "[| i<j; (0::int) < k |] ==> k*i < k*j"
-apply (frule order_less_imp_le [THEN zero_le_imp_eq_int])
-apply (auto simp add: zmult_zless_mono2_lemma)
-done
-
-instance int :: minus
- zabs_def: "\<bar>i\<Colon>int\<bar> \<equiv> if i < 0 then - i else i" ..
-
-instance int :: distrib_lattice
- "inf \<equiv> min"
- "sup \<equiv> max"
- by intro_classes
- (auto simp add: inf_int_def sup_int_def min_max.sup_inf_distrib1)
-
-text{*The integers form an ordered @{text comm_ring_1}*}
-instance int :: ordered_idom
-proof
- fix i j k :: int
- show "i \<le> j ==> k + i \<le> k + j" by (rule zadd_left_mono)
- show "i < j ==> 0 < k ==> k * i < k * j" by (rule zmult_zless_mono2)
- show "\<bar>i\<bar> = (if i < 0 then -i else i)" by (simp only: zabs_def)
-qed
-
-lemma zless_imp_add1_zle: "w<z ==> w + (1::int) \<le> z"
-apply (cases w, cases z)
-apply (simp add: linorder_not_le [symmetric] le int_def add One_int_def)
-done
-
-subsection{*Magnitide of an Integer, as a Natural Number: @{term nat}*}
-
-definition
- nat :: "int \<Rightarrow> nat"
-where
- [code func del]: "nat z = contents (\<Union>(x, y) \<in> Rep_Integ z. {x-y})"
-
-lemma nat: "nat (Abs_Integ (intrel``{(x,y)})) = x-y"
-proof -
- have "(\<lambda>(x,y). {x-y}) respects intrel"
- by (simp add: congruent_def) arith
- thus ?thesis
- by (simp add: nat_def UN_equiv_class [OF equiv_intrel])
-qed
-
-lemma nat_int [simp]: "nat(int n) = n"
-by (simp add: nat int_def)
-
-lemma nat_zero [simp]: "nat 0 = 0"
-by (simp only: Zero_int_def nat_int)
-
-lemma int_nat_eq [simp]: "int (nat z) = (if 0 \<le> z then z else 0)"
-by (cases z, simp add: nat le int_def Zero_int_def)
-
-corollary nat_0_le: "0 \<le> z ==> int (nat z) = z"
-by simp
-
-lemma nat_le_0 [simp]: "z \<le> 0 ==> nat z = 0"
-by (cases z, simp add: nat le int_def Zero_int_def)
-
-lemma nat_le_eq_zle: "0 < w | 0 \<le> z ==> (nat w \<le> nat z) = (w\<le>z)"
-apply (cases w, cases z)
-apply (simp add: nat le linorder_not_le [symmetric] int_def Zero_int_def, arith)
-done
-
-text{*An alternative condition is @{term "0 \<le> w"} *}
-corollary nat_mono_iff: "0 < z ==> (nat w < nat z) = (w < z)"
-by (simp add: nat_le_eq_zle linorder_not_le [symmetric])
-
-corollary nat_less_eq_zless: "0 \<le> w ==> (nat w < nat z) = (w<z)"
-by (simp add: nat_le_eq_zle linorder_not_le [symmetric])
-
-lemma zless_nat_conj: "(nat w < nat z) = (0 < z & w < z)"
-apply (cases w, cases z)
-apply (simp add: nat le int_def Zero_int_def linorder_not_le [symmetric], arith)
-done
-
-lemma nonneg_eq_int: "[| 0 \<le> z; !!m. z = int m ==> P |] ==> P"
-by (blast dest: nat_0_le sym)
-
-lemma nat_eq_iff: "(nat w = m) = (if 0 \<le> w then w = int m else m=0)"
-by (cases w, simp add: nat le int_def Zero_int_def, arith)
-
-corollary nat_eq_iff2: "(m = nat w) = (if 0 \<le> w then w = int m else m=0)"
-by (simp only: eq_commute [of m] nat_eq_iff)
-
-lemma nat_less_iff: "0 \<le> w ==> (nat w < m) = (w < int m)"
-apply (cases w)
-apply (simp add: nat le int_def Zero_int_def linorder_not_le [symmetric], arith)
-done
-
-lemma int_eq_iff: "(int m = z) = (m = nat z & 0 \<le> z)"
-by (auto simp add: nat_eq_iff2)
-
-lemma zero_less_nat_eq [simp]: "(0 < nat z) = (0 < z)"
-by (insert zless_nat_conj [of 0], auto)
-
-lemma nat_add_distrib:
- "[| (0::int) \<le> z; 0 \<le> z' |] ==> nat (z+z') = nat z + nat z'"
-by (cases z, cases z', simp add: nat add le int_def Zero_int_def)
-
-lemma nat_diff_distrib:
- "[| (0::int) \<le> z'; z' \<le> z |] ==> nat (z-z') = nat z - nat z'"
-by (cases z, cases z',
- simp add: nat add minus diff_minus le int_def Zero_int_def)
-
-
-lemma nat_zminus_int [simp]: "nat (- (int n)) = 0"
-by (simp add: int_def minus nat Zero_int_def)
-
-lemma zless_nat_eq_int_zless: "(m < nat z) = (int m < z)"
-by (cases z, simp add: nat le int_def linorder_not_le [symmetric], arith)
-
-
-subsection{*Lemmas about the Function @{term int} and Orderings*}
-
-lemma negative_zless_0: "- (int (Suc n)) < 0"
-by (simp add: order_less_le)
-
-lemma negative_zless [iff]: "- (int (Suc n)) < int m"
-by (rule negative_zless_0 [THEN order_less_le_trans], simp)
-
-lemma negative_zle_0: "- int n \<le> 0"
-by (simp add: minus_le_iff)
-
-lemma negative_zle [iff]: "- int n \<le> int m"
-by (rule order_trans [OF negative_zle_0 zero_zle_int])
-
-lemma not_zle_0_negative [simp]: "~ (0 \<le> - (int (Suc n)))"
-by (subst le_minus_iff, simp)
-
-lemma int_zle_neg: "(int n \<le> - int m) = (n = 0 & m = 0)"
-by (simp add: int_def le minus Zero_int_def)
-
-lemma not_int_zless_negative [simp]: "~ (int n < - int m)"
-by (simp add: linorder_not_less)
-
-lemma negative_eq_positive [simp]: "(- int n = int m) = (n = 0 & m = 0)"
-by (force simp add: order_eq_iff [of "- int n"] int_zle_neg)
-
-lemma zle_iff_zadd: "(w \<le> z) = (\<exists>n. z = w + int n)"
-proof (cases w, cases z, simp add: le add int_def)
- fix a b c d
- assume "w = Abs_Integ (intrel `` {(a,b)})" "z = Abs_Integ (intrel `` {(c,d)})"
- show "(a+d \<le> c+b) = (\<exists>n. c+b = a+n+d)"
- proof
- assume "a + d \<le> c + b"
- thus "\<exists>n. c + b = a + n + d"
- by (auto intro!: exI [where x="c+b - (a+d)"])
- next
- assume "\<exists>n. c + b = a + n + d"
- then obtain n where "c + b = a + n + d" ..
- thus "a + d \<le> c + b" by arith
- qed
-qed
-
-lemma abs_int_eq [simp]: "abs (int m) = int m"
-by (simp add: abs_if)
-
-text{*This version is proved for all ordered rings, not just integers!
- It is proved here because attribute @{text arith_split} is not available
- in theory @{text Ring_and_Field}.
- But is it really better than just rewriting with @{text abs_if}?*}
-lemma abs_split [arith_split]:
- "P(abs(a::'a::ordered_idom)) = ((0 \<le> a --> P a) & (a < 0 --> P(-a)))"
-by (force dest: order_less_le_trans simp add: abs_if linorder_not_less)
-
-
-subsection {* Constants @{term neg} and @{term iszero} *}
-
-definition
- neg :: "'a\<Colon>ordered_idom \<Rightarrow> bool"
-where
- [code inline]: "neg Z \<longleftrightarrow> Z < 0"
-
-definition (*for simplifying equalities*)
- iszero :: "'a\<Colon>comm_semiring_1_cancel \<Rightarrow> bool"
-where
- "iszero z \<longleftrightarrow> z = 0"
-
-lemma not_neg_int [simp]: "~ neg(int n)"
-by (simp add: neg_def)
-
-lemma neg_zminus_int [simp]: "neg(- (int (Suc n)))"
-by (simp add: neg_def neg_less_0_iff_less)
-
-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)
-
-
-subsection{*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 zero_le_one)
-
-lemma iszero_0: "iszero 0"
-by (simp add: iszero_def)
-
-lemma not_iszero_1: "~ iszero 1"
-by (simp add: iszero_def eq_commute)
-
-lemma neg_nat: "neg z ==> nat z = 0"
-by (simp add: neg_def order_less_imp_le)
-
-lemma not_neg_nat: "~ neg z ==> int (nat z) = z"
-by (simp add: linorder_not_less neg_def)
-
-
-subsection{*The Set of Natural Numbers*}
-
-constdefs
- Nats :: "'a::semiring_1_cancel set"
- "Nats == range of_nat"
-
-notation (xsymbols)
- Nats ("\<nat>")
-
-lemma of_nat_in_Nats [simp]: "of_nat n \<in> Nats"
-by (simp add: Nats_def)
-
-lemma Nats_0 [simp]: "0 \<in> Nats"
-apply (simp add: Nats_def)
-apply (rule range_eqI)
-apply (rule of_nat_0 [symmetric])
-done
-
-lemma Nats_1 [simp]: "1 \<in> Nats"
-apply (simp add: Nats_def)
-apply (rule range_eqI)
-apply (rule of_nat_1 [symmetric])
-done
-
-lemma Nats_add [simp]: "[|a \<in> Nats; b \<in> Nats|] ==> a+b \<in> Nats"
-apply (auto simp add: Nats_def)
-apply (rule range_eqI)
-apply (rule of_nat_add [symmetric])
-done
-
-lemma Nats_mult [simp]: "[|a \<in> Nats; b \<in> Nats|] ==> a*b \<in> Nats"
-apply (auto simp add: Nats_def)
-apply (rule range_eqI)
-apply (rule of_nat_mult [symmetric])
-done
-
-text{*Agreement with the specific embedding for the integers*}
-lemma int_eq_of_nat: "int = (of_nat :: nat => int)"
-proof
- fix n
- show "int n = of_nat n" by (induct n, simp_all add: int_Suc add_ac)
-qed
-
-lemma of_nat_eq_id [simp]: "of_nat = (id :: nat => nat)"
-proof
- fix n
- show "of_nat n = id n" by (induct n, simp_all)
-qed
-
-
-subsection{*Embedding of the Integers into any @{text ring_1}:
-@{term of_int}*}
-
-constdefs
- of_int :: "int => 'a::ring_1"
- "of_int z == contents (\<Union>(i,j) \<in> Rep_Integ z. { of_nat i - of_nat j })"
-
-
-lemma of_int: "of_int (Abs_Integ (intrel `` {(i,j)})) = of_nat i - of_nat j"
-proof -
- have "(\<lambda>(i,j). { of_nat i - (of_nat j :: 'a) }) respects intrel"
- by (simp add: congruent_def compare_rls of_nat_add [symmetric]
- del: of_nat_add)
- thus ?thesis
- by (simp add: of_int_def UN_equiv_class [OF equiv_intrel])
-qed
-
-lemma of_int_0 [simp]: "of_int 0 = 0"
-by (simp add: of_int Zero_int_def int_def)
-
-lemma of_int_1 [simp]: "of_int 1 = 1"
-by (simp add: of_int One_int_def int_def)
-
-lemma of_int_add [simp]: "of_int (w+z) = of_int w + of_int z"
-by (cases w, cases z, simp add: compare_rls of_int add)
-
-lemma of_int_minus [simp]: "of_int (-z) = - (of_int z)"
-by (cases z, simp add: compare_rls of_int minus)
-
-lemma of_int_diff [simp]: "of_int (w-z) = of_int w - of_int z"
-by (simp add: diff_minus)
-
-lemma of_int_mult [simp]: "of_int (w*z) = of_int w * of_int z"
-apply (cases w, cases z)
-apply (simp add: compare_rls of_int left_diff_distrib right_diff_distrib
- mult add_ac)
-done
-
-lemma of_int_le_iff [simp]:
- "(of_int w \<le> (of_int z::'a::ordered_idom)) = (w \<le> z)"
-apply (cases w)
-apply (cases z)
-apply (simp add: compare_rls of_int le diff_int_def add minus
- of_nat_add [symmetric] del: of_nat_add)
-done
-
-text{*Special cases where either operand is zero*}
-lemmas of_int_0_le_iff [simp] = of_int_le_iff [of 0, simplified]
-lemmas of_int_le_0_iff [simp] = of_int_le_iff [of _ 0, simplified]
-
-
-lemma of_int_less_iff [simp]:
- "(of_int w < (of_int z::'a::ordered_idom)) = (w < z)"
-by (simp add: linorder_not_le [symmetric])
-
-text{*Special cases where either operand is zero*}
-lemmas of_int_0_less_iff [simp] = of_int_less_iff [of 0, simplified]
-lemmas of_int_less_0_iff [simp] = of_int_less_iff [of _ 0, simplified]
-
-text{*Class for unital rings with characteristic zero.
- Includes non-ordered rings like the complex numbers.*}
-axclass ring_char_0 < ring_1
- of_int_inject: "of_int w = of_int z ==> w = z"
-
-lemma of_int_eq_iff [simp]:
- "(of_int w = (of_int z::'a::ring_char_0)) = (w = z)"
-by (safe elim!: of_int_inject)
-
-text{*Every @{text ordered_idom} has characteristic zero.*}
-instance ordered_idom < ring_char_0
-by intro_classes (simp add: order_eq_iff)
-
-text{*Special cases where either operand is zero*}
-lemmas of_int_0_eq_iff [simp] = of_int_eq_iff [of 0, simplified]
-lemmas of_int_eq_0_iff [simp] = of_int_eq_iff [of _ 0, simplified]
-
-lemma of_int_eq_id [simp]: "of_int = (id :: int => int)"
-proof
- fix z
- show "of_int z = id z"
- by (cases z)
- (simp add: of_int add minus int_eq_of_nat [symmetric] int_def diff_minus)
-qed
-
-
-subsection{*The Set of Integers*}
-
-constdefs
- Ints :: "'a::ring_1 set"
- "Ints == range of_int"
-
-notation (xsymbols)
- Ints ("\<int>")
-
-lemma Ints_0 [simp]: "0 \<in> Ints"
-apply (simp add: Ints_def)
-apply (rule range_eqI)
-apply (rule of_int_0 [symmetric])
-done
-
-lemma Ints_1 [simp]: "1 \<in> Ints"
-apply (simp add: Ints_def)
-apply (rule range_eqI)
-apply (rule of_int_1 [symmetric])
-done
-
-lemma Ints_add [simp]: "[|a \<in> Ints; b \<in> Ints|] ==> a+b \<in> Ints"
-apply (auto simp add: Ints_def)
-apply (rule range_eqI)
-apply (rule of_int_add [symmetric])
-done
-
-lemma Ints_minus [simp]: "a \<in> Ints ==> -a \<in> Ints"
-apply (auto simp add: Ints_def)
-apply (rule range_eqI)
-apply (rule of_int_minus [symmetric])
-done
-
-lemma Ints_diff [simp]: "[|a \<in> Ints; b \<in> Ints|] ==> a-b \<in> Ints"
-apply (auto simp add: Ints_def)
-apply (rule range_eqI)
-apply (rule of_int_diff [symmetric])
-done
-
-lemma Ints_mult [simp]: "[|a \<in> Ints; b \<in> Ints|] ==> a*b \<in> Ints"
-apply (auto simp add: Ints_def)
-apply (rule range_eqI)
-apply (rule of_int_mult [symmetric])
-done
-
-text{*Collapse nested embeddings*}
-lemma of_int_of_nat_eq [simp]: "of_int (of_nat n) = of_nat n"
-by (induct n, auto)
-
-lemma of_int_int_eq [simp]: "of_int (int n) = of_nat n"
-by (simp add: int_eq_of_nat)
-
-lemma Ints_cases [cases set: Ints]:
- assumes "q \<in> \<int>"
- obtains (of_int) z where "q = of_int z"
- unfolding Ints_def
-proof -
- from `q \<in> \<int>` have "q \<in> range of_int" unfolding Ints_def .
- then obtain z where "q = of_int z" ..
- then show thesis ..
-qed
-
-lemma Ints_induct [case_names of_int, induct set: Ints]:
- "q \<in> \<int> ==> (!!z. P (of_int z)) ==> P q"
- by (rule Ints_cases) auto
-
-
-(* int (Suc n) = 1 + int n *)
-
-
-
-subsection{*More Properties of @{term setsum} and @{term setprod}*}
-
-text{*By Jeremy Avigad*}
-
-
-lemma of_nat_setsum: "of_nat (setsum f A) = (\<Sum>x\<in>A. of_nat(f x))"
- apply (cases "finite A")
- apply (erule finite_induct, auto)
- done
-
-lemma of_int_setsum: "of_int (setsum f A) = (\<Sum>x\<in>A. of_int(f x))"
- apply (cases "finite A")
- apply (erule finite_induct, auto)
- done
-
-lemma int_setsum: "int (setsum f A) = (\<Sum>x\<in>A. int(f x))"
- by (simp add: int_eq_of_nat of_nat_setsum)
-
-lemma of_nat_setprod: "of_nat (setprod f A) = (\<Prod>x\<in>A. of_nat(f x))"
- apply (cases "finite A")
- apply (erule finite_induct, auto)
- done
-
-lemma of_int_setprod: "of_int (setprod f A) = (\<Prod>x\<in>A. of_int(f x))"
- apply (cases "finite A")
- apply (erule finite_induct, auto)
- done
-
-lemma int_setprod: "int (setprod f A) = (\<Prod>x\<in>A. int(f x))"
- by (simp add: int_eq_of_nat of_nat_setprod)
-
-lemma setprod_nonzero_nat:
- "finite A ==> (\<forall>x \<in> A. f x \<noteq> (0::nat)) ==> setprod f A \<noteq> 0"
- by (rule setprod_nonzero, auto)
-
-lemma setprod_zero_eq_nat:
- "finite A ==> (setprod f A = (0::nat)) = (\<exists>x \<in> A. f x = 0)"
- by (rule setprod_zero_eq, auto)
-
-lemma setprod_nonzero_int:
- "finite A ==> (\<forall>x \<in> A. f x \<noteq> (0::int)) ==> setprod f A \<noteq> 0"
- by (rule setprod_nonzero, auto)
-
-lemma setprod_zero_eq_int:
- "finite A ==> (setprod f A = (0::int)) = (\<exists>x \<in> A. f x = 0)"
- by (rule setprod_zero_eq, auto)
-
-
-subsection {* Further properties *}
-
-text{*Now we replace the case analysis rule by a more conventional one:
-whether an integer is negative or not.*}
-
-lemma zless_iff_Suc_zadd:
- "(w < z) = (\<exists>n. z = w + int(Suc n))"
-apply (cases z, cases w)
-apply (auto simp add: le add int_def linorder_not_le [symmetric])
-apply (rename_tac a b c d)
-apply (rule_tac x="a+d - Suc(c+b)" in exI)
-apply arith
-done
-
-lemma negD: "x<0 ==> \<exists>n. x = - (int (Suc n))"
-apply (cases x)
-apply (auto simp add: le minus Zero_int_def int_def order_less_le)
-apply (rule_tac x="y - Suc x" in exI, arith)
-done
-
-theorem int_cases [cases type: int, case_names nonneg neg]:
- "[|!! n. z = int n ==> P; !! n. z = - (int (Suc n)) ==> P |] ==> P"
-apply (cases "z < 0", blast dest!: negD)
-apply (simp add: linorder_not_less)
-apply (blast dest: nat_0_le [THEN sym])
-done
-
-theorem int_induct [induct type: int, case_names nonneg neg]:
- "[|!! n. P (int n); !!n. P (- (int (Suc n))) |] ==> P z"
- by (cases z) auto
-
-text{*Contributed by Brian Huffman*}
-theorem int_diff_cases [case_names diff]:
-assumes prem: "!!m n. z = int m - int n ==> P" shows "P"
- apply (rule_tac z=z in int_cases)
- apply (rule_tac m=n and n=0 in prem, simp)
- apply (rule_tac m=0 and n="Suc n" in prem, simp)
-done
-
-lemma of_nat_nat: "0 \<le> z ==> of_nat (nat z) = of_int z"
-apply (cases z)
-apply (simp_all add: not_zle_0_negative del: int_Suc)
-done
-
-lemmas zless_le = less_int_def [THEN meta_eq_to_obj_eq]
-
-lemmas [simp] = int_Suc
-
-
-subsection {* Legacy ML bindings *}
-
-ML {*
-val of_nat_0 = @{thm of_nat_0};
-val of_nat_1 = @{thm of_nat_1};
-val of_nat_Suc = @{thm of_nat_Suc};
-val of_nat_add = @{thm of_nat_add};
-val of_nat_mult = @{thm of_nat_mult};
-val of_int_0 = @{thm of_int_0};
-val of_int_1 = @{thm of_int_1};
-val of_int_add = @{thm of_int_add};
-val of_int_mult = @{thm of_int_mult};
-val int_eq_of_nat = @{thm int_eq_of_nat};
-val zle_int = @{thm zle_int};
-val int_int_eq = @{thm int_int_eq};
-val diff_int_def = @{thm diff_int_def};
-val zadd_ac = @{thms zadd_ac};
-val zless_int = @{thm zless_int};
-val zadd_int = @{thm zadd_int};
-val zmult_int = @{thm zmult_int};
-val nat_0_le = @{thm nat_0_le};
-val int_0 = @{thm int_0};
-val int_1 = @{thm int_1};
-val abs_split = @{thm abs_split};
-*}
-
-end
--- a/src/HOL/Integ/IntDiv.thy Thu May 31 18:16:51 2007 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,1406 +0,0 @@
-(* Title: HOL/IntDiv.thy
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1999 University of Cambridge
-
-*)
-
-header{*The Division Operators div and mod; the Divides Relation dvd*}
-
-theory IntDiv
-imports IntArith "../Divides" "../FunDef"
-begin
-
-declare zless_nat_conj [simp]
-
-constdefs
- quorem :: "(int*int) * (int*int) => bool"
- --{*definition of quotient and remainder*}
- [code func]: "quorem == %((a,b), (q,r)).
- a = b*q + r &
- (if 0 < b then 0\<le>r & r<b else b<r & r \<le> 0)"
-
- adjust :: "[int, int*int] => int*int"
- --{*for the division algorithm*}
- [code func]: "adjust b == %(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"}*}
-function
- posDivAlg :: "int \<Rightarrow> int \<Rightarrow> int \<times> int"
-where
- "posDivAlg a b =
- (if (a<b | b\<le>0) then (0,a)
- else adjust b (posDivAlg a (2*b)))"
-by auto
-termination by (relation "measure (%(a,b). nat(a - b + 1))") auto
-
-text{*algorithm for the case @{text "a<0, b>0"}*}
-function
- negDivAlg :: "int \<Rightarrow> int \<Rightarrow> int \<times> int"
-where
- "negDivAlg a b =
- (if (0\<le>a+b | b\<le>0) then (-1,a+b)
- else adjust b (negDivAlg a (2*b)))"
-by auto
-termination by (relation "measure (%(a,b). nat(- a - b))") auto
-
-text{*algorithm for the general case @{term "b\<noteq>0"}*}
-constdefs
- negateSnd :: "int*int => int*int"
- [code func]: "negateSnd == %(q,r). (q,-r)"
-
-definition
- divAlg :: "int \<times> int \<Rightarrow> int \<times> int"
- --{*The full division algorithm considers all possible signs for a, b
- including the special case @{text "a=0, b<0"} because
- @{term negDivAlg} requires @{term "a<0"}.*}
-where
- "divAlg = (\<lambda>(a, b). (if 0\<le>a then
- if 0\<le>b then posDivAlg a b
- else if a=0 then (0, 0)
- else negateSnd (negDivAlg (-a) (-b))
- else
- if 0<b then negDivAlg a b
- else negateSnd (posDivAlg (-a) (-b))))"
-
-instance int :: Divides.div
- div_def: "a div b == fst (divAlg (a, b))"
- mod_def: "a mod b == snd (divAlg (a, b))" ..
-
-lemma divAlg_mod_div:
- "divAlg (p, q) = (p div q, p mod q)"
- by (auto simp add: div_def mod_def)
-
-text{*
-Here is the division algorithm in ML:
-
-\begin{verbatim}
- fun posDivAlg (a,b) =
- if a<b then (0,a)
- else let val (q,r) = posDivAlg(a, 2*b)
- in if 0\<le>r-b then (2*q+1, r-b) else (2*q, r)
- end
-
- fun negDivAlg (a,b) =
- if 0\<le>a+b then (~1,a+b)
- else let val (q,r) = negDivAlg(a, 2*b)
- in if 0\<le>r-b then (2*q+1, r-b) else (2*q, r)
- end;
-
- fun negateSnd (q,r:int) = (q,~r);
-
- fun divAlg (a,b) = if 0\<le>a then
- if b>0 then posDivAlg (a,b)
- else if a=0 then (0,0)
- else negateSnd (negDivAlg (~a,~b))
- else
- if 0<b then negDivAlg (a,b)
- else negateSnd (posDivAlg (~a,~b));
-\end{verbatim}
-*}
-
-
-
-subsection{*Uniqueness and Monotonicity of Quotients and Remainders*}
-
-lemma unique_quotient_lemma:
- "[| b*q' + r' \<le> b*q + r; 0 \<le> r'; r' < b; r < b |]
- ==> q' \<le> (q::int)"
-apply (subgoal_tac "r' + b * (q'-q) \<le> r")
- prefer 2 apply (simp add: right_diff_distrib)
-apply (subgoal_tac "0 < b * (1 + q - q') ")
-apply (erule_tac [2] order_le_less_trans)
- prefer 2 apply (simp add: right_diff_distrib right_distrib)
-apply (subgoal_tac "b * q' < b * (1 + q) ")
- prefer 2 apply (simp add: right_diff_distrib right_distrib)
-apply (simp add: mult_less_cancel_left)
-done
-
-lemma unique_quotient_lemma_neg:
- "[| b*q' + r' \<le> b*q + r; r \<le> 0; b < r; b < r' |]
- ==> q \<le> (q'::int)"
-by (rule_tac b = "-b" and r = "-r'" and r' = "-r" in unique_quotient_lemma,
- auto)
-
-lemma unique_quotient:
- "[| quorem ((a,b), (q,r)); quorem ((a,b), (q',r')); b \<noteq> 0 |]
- ==> q = q'"
-apply (simp add: quorem_def linorder_neq_iff split: split_if_asm)
-apply (blast intro: order_antisym
- dest: order_eq_refl [THEN unique_quotient_lemma]
- order_eq_refl [THEN unique_quotient_lemma_neg] sym)+
-done
-
-
-lemma unique_remainder:
- "[| quorem ((a,b), (q,r)); quorem ((a,b), (q',r')); b \<noteq> 0 |]
- ==> r = r'"
-apply (subgoal_tac "q = q'")
- apply (simp add: quorem_def)
-apply (blast intro: unique_quotient)
-done
-
-
-subsection{*Correctness of @{term posDivAlg}, the Algorithm for Non-Negative Dividends*}
-
-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)
- else (2*q, r))"
-by (simp add: Let_def adjust_def)
-
-declare posDivAlg.simps [simp del]
-
-text{*use with a simproc to avoid repeatedly proving the premise*}
-lemma posDivAlg_eqn:
- "0 < b ==>
- posDivAlg a b = (if a<b then (0,a) else adjust b (posDivAlg a (2*b)))"
-by (rule posDivAlg.simps [THEN trans], simp)
-
-text{*Correctness of @{term posDivAlg}: it computes quotients correctly*}
-theorem posDivAlg_correct:
- assumes "0 \<le> a" and "0 < b"
- shows "quorem ((a, b), posDivAlg a b)"
-using prems apply (induct a b rule: posDivAlg.induct)
-apply auto
-apply (simp add: quorem_def)
-apply (subst posDivAlg_eqn, simp add: right_distrib)
-apply (case_tac "a < b")
-apply simp_all
-apply (erule splitE)
-apply (auto simp add: right_distrib Let_def)
-done
-
-
-subsection{*Correctness of @{term negDivAlg}, the Algorithm for Negative Dividends*}
-
-text{*And positive divisors*}
-
-declare negDivAlg.simps [simp del]
-
-text{*use with a simproc to avoid repeatedly proving the premise*}
-lemma negDivAlg_eqn:
- "0 < b ==>
- negDivAlg a b =
- (if 0\<le>a+b then (-1,a+b) else adjust b (negDivAlg a (2*b)))"
-by (rule negDivAlg.simps [THEN trans], simp)
-
-(*Correctness of negDivAlg: it computes quotients correctly
- It doesn't work if a=0 because the 0/b equals 0, not -1*)
-lemma negDivAlg_correct:
- assumes "a < 0" and "b > 0"
- shows "quorem ((a, b), negDivAlg a b)"
-using prems apply (induct a b rule: negDivAlg.induct)
-apply (auto simp add: linorder_not_le)
-apply (simp add: quorem_def)
-apply (subst negDivAlg_eqn, assumption)
-apply (case_tac "a + b < (0\<Colon>int)")
-apply simp_all
-apply (erule splitE)
-apply (auto simp add: right_distrib Let_def)
-done
-
-
-subsection{*Existence Shown by Proving the Division Algorithm to be Correct*}
-
-(*the case a=0*)
-lemma quorem_0: "b \<noteq> 0 ==> quorem ((0,b), (0,0))"
-by (auto simp add: quorem_def linorder_neq_iff)
-
-lemma posDivAlg_0 [simp]: "posDivAlg 0 b = (0, 0)"
-by (subst posDivAlg.simps, auto)
-
-lemma negDivAlg_minus1 [simp]: "negDivAlg -1 b = (-1, b - 1)"
-by (subst negDivAlg.simps, auto)
-
-lemma negateSnd_eq [simp]: "negateSnd(q,r) = (q,-r)"
-by (simp add: negateSnd_def)
-
-lemma quorem_neg: "quorem ((-a,-b), qr) ==> quorem ((a,b), negateSnd qr)"
-by (auto simp add: split_ifs quorem_def)
-
-lemma divAlg_correct: "b \<noteq> 0 ==> quorem ((a,b), divAlg (a, b))"
-by (force simp add: linorder_neq_iff quorem_0 divAlg_def quorem_neg
- posDivAlg_correct negDivAlg_correct)
-
-text{*Arbitrary definitions for division by zero. Useful to simplify
- certain equations.*}
-
-lemma DIVISION_BY_ZERO [simp]: "a div (0::int) = 0 & a mod (0::int) = a"
-by (simp add: div_def mod_def divAlg_def posDivAlg.simps)
-
-
-text{*Basic laws about division and remainder*}
-
-lemma zmod_zdiv_equality: "(a::int) = b * (a div b) + (a mod b)"
-apply (case_tac "b = 0", simp)
-apply (cut_tac a = a and b = b in divAlg_correct)
-apply (auto simp add: quorem_def div_def mod_def)
-done
-
-lemma zdiv_zmod_equality: "(b * (a div b) + (a mod b)) + k = (a::int)+k"
-by(simp add: zmod_zdiv_equality[symmetric])
-
-lemma zdiv_zmod_equality2: "((a div b) * b + (a mod b)) + k = (a::int)+k"
-by(simp add: mult_commute zmod_zdiv_equality[symmetric])
-
-text {* Tool setup *}
-
-ML_setup {*
-local
-
-structure CancelDivMod = CancelDivModFun(
-struct
- val div_name = @{const_name Divides.div};
- val mod_name = @{const_name Divides.mod};
- val mk_binop = HOLogic.mk_binop;
- val mk_sum = Int_Numeral_Simprocs.mk_sum HOLogic.intT;
- val dest_sum = Int_Numeral_Simprocs.dest_sum;
- val div_mod_eqs =
- map mk_meta_eq [@{thm zdiv_zmod_equality},
- @{thm zdiv_zmod_equality2}];
- val trans = trans;
- val prove_eq_sums =
- let
- val simps = diff_int_def :: Int_Numeral_Simprocs.add_0s @ zadd_ac
- in NatArithUtils.prove_conv all_tac (NatArithUtils.simp_all_tac simps) end;
-end)
-
-in
-
-val cancel_zdiv_zmod_proc = NatArithUtils.prep_simproc
- ("cancel_zdiv_zmod", ["(m::int) + n"], K CancelDivMod.proc)
-
-end;
-
-Addsimprocs [cancel_zdiv_zmod_proc]
-*}
-
-lemma pos_mod_conj : "(0::int) < b ==> 0 \<le> a mod b & a mod b < b"
-apply (cut_tac a = a and b = b in divAlg_correct)
-apply (auto simp add: quorem_def mod_def)
-done
-
-lemmas pos_mod_sign [simp] = pos_mod_conj [THEN conjunct1, standard]
- and pos_mod_bound [simp] = pos_mod_conj [THEN conjunct2, standard]
-
-lemma neg_mod_conj : "b < (0::int) ==> a mod b \<le> 0 & b < a mod b"
-apply (cut_tac a = a and b = b in divAlg_correct)
-apply (auto simp add: quorem_def div_def mod_def)
-done
-
-lemmas neg_mod_sign [simp] = neg_mod_conj [THEN conjunct1, standard]
- and neg_mod_bound [simp] = neg_mod_conj [THEN conjunct2, standard]
-
-
-
-subsection{*General Properties of div and mod*}
-
-lemma quorem_div_mod: "b \<noteq> 0 ==> quorem ((a, b), (a div b, a mod b))"
-apply (cut_tac a = a and b = b in zmod_zdiv_equality)
-apply (force simp add: quorem_def linorder_neq_iff)
-done
-
-lemma quorem_div: "[| quorem((a,b),(q,r)); b \<noteq> 0 |] ==> a div b = q"
-by (simp add: quorem_div_mod [THEN unique_quotient])
-
-lemma quorem_mod: "[| quorem((a,b),(q,r)); b \<noteq> 0 |] ==> a mod b = r"
-by (simp add: quorem_div_mod [THEN unique_remainder])
-
-lemma div_pos_pos_trivial: "[| (0::int) \<le> a; a < b |] ==> a div b = 0"
-apply (rule quorem_div)
-apply (auto simp add: quorem_def)
-done
-
-lemma div_neg_neg_trivial: "[| a \<le> (0::int); b < a |] ==> a div b = 0"
-apply (rule quorem_div)
-apply (auto simp add: quorem_def)
-done
-
-lemma div_pos_neg_trivial: "[| (0::int) < a; a+b \<le> 0 |] ==> a div b = -1"
-apply (rule quorem_div)
-apply (auto simp add: quorem_def)
-done
-
-(*There is no div_neg_pos_trivial because 0 div b = 0 would supersede it*)
-
-lemma mod_pos_pos_trivial: "[| (0::int) \<le> a; a < b |] ==> a mod b = a"
-apply (rule_tac q = 0 in quorem_mod)
-apply (auto simp add: quorem_def)
-done
-
-lemma mod_neg_neg_trivial: "[| a \<le> (0::int); b < a |] ==> a mod b = a"
-apply (rule_tac q = 0 in quorem_mod)
-apply (auto simp add: quorem_def)
-done
-
-lemma mod_pos_neg_trivial: "[| (0::int) < a; a+b \<le> 0 |] ==> a mod b = a+b"
-apply (rule_tac q = "-1" in quorem_mod)
-apply (auto simp add: quorem_def)
-done
-
-text{*There is no @{text mod_neg_pos_trivial}.*}
-
-
-(*Simpler laws such as -a div b = -(a div b) FAIL, but see just below*)
-lemma zdiv_zminus_zminus [simp]: "(-a) div (-b) = a div (b::int)"
-apply (case_tac "b = 0", simp)
-apply (simp add: quorem_div_mod [THEN quorem_neg, simplified,
- THEN quorem_div, THEN sym])
-
-done
-
-(*Simpler laws such as -a mod b = -(a mod b) FAIL, but see just below*)
-lemma zmod_zminus_zminus [simp]: "(-a) mod (-b) = - (a mod (b::int))"
-apply (case_tac "b = 0", simp)
-apply (subst quorem_div_mod [THEN quorem_neg, simplified, THEN quorem_mod],
- auto)
-done
-
-
-subsection{*Laws for div and mod with Unary Minus*}
-
-lemma zminus1_lemma:
- "quorem((a,b),(q,r))
- ==> quorem ((-a,b), (if r=0 then -q else -q - 1),
- (if r=0 then 0 else b-r))"
-by (force simp add: split_ifs quorem_def linorder_neq_iff right_diff_distrib)
-
-
-lemma zdiv_zminus1_eq_if:
- "b \<noteq> (0::int)
- ==> (-a) div b =
- (if a mod b = 0 then - (a div b) else - (a div b) - 1)"
-by (blast intro: quorem_div_mod [THEN zminus1_lemma, THEN quorem_div])
-
-lemma zmod_zminus1_eq_if:
- "(-a::int) mod b = (if a mod b = 0 then 0 else b - (a mod b))"
-apply (case_tac "b = 0", simp)
-apply (blast intro: quorem_div_mod [THEN zminus1_lemma, THEN quorem_mod])
-done
-
-lemma zdiv_zminus2: "a div (-b) = (-a::int) div b"
-by (cut_tac a = "-a" in zdiv_zminus_zminus, auto)
-
-lemma zmod_zminus2: "a mod (-b) = - ((-a::int) mod b)"
-by (cut_tac a = "-a" and b = b in zmod_zminus_zminus, auto)
-
-lemma zdiv_zminus2_eq_if:
- "b \<noteq> (0::int)
- ==> a div (-b) =
- (if a mod b = 0 then - (a div b) else - (a div b) - 1)"
-by (simp add: zdiv_zminus1_eq_if zdiv_zminus2)
-
-lemma zmod_zminus2_eq_if:
- "a mod (-b::int) = (if a mod b = 0 then 0 else (a mod b) - b)"
-by (simp add: zmod_zminus1_eq_if zmod_zminus2)
-
-
-subsection{*Division of a Number by Itself*}
-
-lemma self_quotient_aux1: "[| (0::int) < a; a = r + a*q; r < a |] ==> 1 \<le> q"
-apply (subgoal_tac "0 < a*q")
- apply (simp add: zero_less_mult_iff, arith)
-done
-
-lemma self_quotient_aux2: "[| (0::int) < a; a = r + a*q; 0 \<le> r |] ==> q \<le> 1"
-apply (subgoal_tac "0 \<le> a* (1-q) ")
- apply (simp add: zero_le_mult_iff)
-apply (simp add: right_diff_distrib)
-done
-
-lemma self_quotient: "[| quorem((a,a),(q,r)); a \<noteq> (0::int) |] ==> q = 1"
-apply (simp add: split_ifs quorem_def linorder_neq_iff)
-apply (rule order_antisym, safe, simp_all)
-apply (rule_tac [3] a = "-a" and r = "-r" in self_quotient_aux1)
-apply (rule_tac a = "-a" and r = "-r" in self_quotient_aux2)
-apply (force intro: self_quotient_aux1 self_quotient_aux2 simp add: add_commute)+
-done
-
-lemma self_remainder: "[| quorem((a,a),(q,r)); a \<noteq> (0::int) |] ==> r = 0"
-apply (frule self_quotient, assumption)
-apply (simp add: quorem_def)
-done
-
-lemma zdiv_self [simp]: "a \<noteq> 0 ==> a div a = (1::int)"
-by (simp add: quorem_div_mod [THEN self_quotient])
-
-(*Here we have 0 mod 0 = 0, also assumed by Knuth (who puts m mod 0 = 0) *)
-lemma zmod_self [simp]: "a mod a = (0::int)"
-apply (case_tac "a = 0", simp)
-apply (simp add: quorem_div_mod [THEN self_remainder])
-done
-
-
-subsection{*Computation of Division and Remainder*}
-
-lemma zdiv_zero [simp]: "(0::int) div b = 0"
-by (simp add: div_def divAlg_def)
-
-lemma div_eq_minus1: "(0::int) < b ==> -1 div b = -1"
-by (simp add: div_def divAlg_def)
-
-lemma zmod_zero [simp]: "(0::int) mod b = 0"
-by (simp add: mod_def divAlg_def)
-
-lemma zdiv_minus1: "(0::int) < b ==> -1 div b = -1"
-by (simp add: div_def divAlg_def)
-
-lemma zmod_minus1: "(0::int) < b ==> -1 mod b = b - 1"
-by (simp add: mod_def divAlg_def)
-
-text{*a positive, b positive *}
-
-lemma div_pos_pos: "[| 0 < a; 0 \<le> b |] ==> a div b = fst (posDivAlg a b)"
-by (simp add: div_def divAlg_def)
-
-lemma mod_pos_pos: "[| 0 < a; 0 \<le> b |] ==> a mod b = snd (posDivAlg a b)"
-by (simp add: mod_def divAlg_def)
-
-text{*a negative, b positive *}
-
-lemma div_neg_pos: "[| a < 0; 0 < b |] ==> a div b = fst (negDivAlg a b)"
-by (simp add: div_def divAlg_def)
-
-lemma mod_neg_pos: "[| a < 0; 0 < b |] ==> a mod b = snd (negDivAlg a b)"
-by (simp add: mod_def divAlg_def)
-
-text{*a positive, b negative *}
-
-lemma div_pos_neg:
- "[| 0 < a; b < 0 |] ==> a div b = fst (negateSnd (negDivAlg (-a) (-b)))"
-by (simp add: div_def divAlg_def)
-
-lemma mod_pos_neg:
- "[| 0 < a; b < 0 |] ==> a mod b = snd (negateSnd (negDivAlg (-a) (-b)))"
-by (simp add: mod_def divAlg_def)
-
-text{*a negative, b negative *}
-
-lemma div_neg_neg:
- "[| a < 0; b \<le> 0 |] ==> a div b = fst (negateSnd (posDivAlg (-a) (-b)))"
-by (simp add: div_def divAlg_def)
-
-lemma mod_neg_neg:
- "[| a < 0; b \<le> 0 |] ==> a mod b = snd (negateSnd (posDivAlg (-a) (-b)))"
-by (simp add: mod_def divAlg_def)
-
-text {*Simplify expresions in which div and mod combine numerical constants*}
-
-lemmas div_pos_pos_number_of [simp] =
- div_pos_pos [of "number_of v" "number_of w", standard]
-
-lemmas div_neg_pos_number_of [simp] =
- div_neg_pos [of "number_of v" "number_of w", standard]
-
-lemmas div_pos_neg_number_of [simp] =
- div_pos_neg [of "number_of v" "number_of w", standard]
-
-lemmas div_neg_neg_number_of [simp] =
- div_neg_neg [of "number_of v" "number_of w", standard]
-
-
-lemmas mod_pos_pos_number_of [simp] =
- mod_pos_pos [of "number_of v" "number_of w", standard]
-
-lemmas mod_neg_pos_number_of [simp] =
- mod_neg_pos [of "number_of v" "number_of w", standard]
-
-lemmas mod_pos_neg_number_of [simp] =
- mod_pos_neg [of "number_of v" "number_of w", standard]
-
-lemmas mod_neg_neg_number_of [simp] =
- mod_neg_neg [of "number_of v" "number_of w", standard]
-
-
-lemmas posDivAlg_eqn_number_of [simp] =
- posDivAlg_eqn [of "number_of v" "number_of w", standard]
-
-lemmas negDivAlg_eqn_number_of [simp] =
- negDivAlg_eqn [of "number_of v" "number_of w", standard]
-
-
-text{*Special-case simplification *}
-
-lemma zmod_1 [simp]: "a mod (1::int) = 0"
-apply (cut_tac a = a and b = 1 in pos_mod_sign)
-apply (cut_tac [2] a = a and b = 1 in pos_mod_bound)
-apply (auto simp del:pos_mod_bound pos_mod_sign)
-done
-
-lemma zdiv_1 [simp]: "a div (1::int) = a"
-by (cut_tac a = a and b = 1 in zmod_zdiv_equality, auto)
-
-lemma zmod_minus1_right [simp]: "a mod (-1::int) = 0"
-apply (cut_tac a = a and b = "-1" in neg_mod_sign)
-apply (cut_tac [2] a = a and b = "-1" in neg_mod_bound)
-apply (auto simp del: neg_mod_sign neg_mod_bound)
-done
-
-lemma zdiv_minus1_right [simp]: "a div (-1::int) = -a"
-by (cut_tac a = a and b = "-1" in zmod_zdiv_equality, auto)
-
-(** 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 int_0_less_1, of "number_of w", standard]
-
-lemmas div_pos_neg_1_number_of [simp] =
- div_pos_neg [OF int_0_less_1, of "number_of w", standard]
-
-lemmas mod_pos_pos_1_number_of [simp] =
- mod_pos_pos [OF int_0_less_1, of "number_of w", standard]
-
-lemmas mod_pos_neg_1_number_of [simp] =
- mod_pos_neg [OF int_0_less_1, of "number_of w", standard]
-
-
-lemmas posDivAlg_eqn_1_number_of [simp] =
- posDivAlg_eqn [of concl: 1 "number_of w", standard]
-
-lemmas negDivAlg_eqn_1_number_of [simp] =
- negDivAlg_eqn [of concl: 1 "number_of w", standard]
-
-
-
-subsection{*Monotonicity in the First Argument (Dividend)*}
-
-lemma zdiv_mono1: "[| a \<le> a'; 0 < (b::int) |] ==> a div b \<le> a' div b"
-apply (cut_tac a = a and b = b in zmod_zdiv_equality)
-apply (cut_tac a = a' and b = b in zmod_zdiv_equality)
-apply (rule unique_quotient_lemma)
-apply (erule subst)
-apply (erule subst, simp_all)
-done
-
-lemma zdiv_mono1_neg: "[| a \<le> a'; (b::int) < 0 |] ==> a' div b \<le> a div b"
-apply (cut_tac a = a and b = b in zmod_zdiv_equality)
-apply (cut_tac a = a' and b = b in zmod_zdiv_equality)
-apply (rule unique_quotient_lemma_neg)
-apply (erule subst)
-apply (erule subst, simp_all)
-done
-
-
-subsection{*Monotonicity in the Second Argument (Divisor)*}
-
-lemma q_pos_lemma:
- "[| 0 \<le> b'*q' + r'; r' < b'; 0 < b' |] ==> 0 \<le> (q'::int)"
-apply (subgoal_tac "0 < b'* (q' + 1) ")
- apply (simp add: zero_less_mult_iff)
-apply (simp add: right_distrib)
-done
-
-lemma zdiv_mono2_lemma:
- "[| b*q + r = b'*q' + r'; 0 \<le> b'*q' + r';
- r' < b'; 0 \<le> r; 0 < b'; b' \<le> b |]
- ==> q \<le> (q'::int)"
-apply (frule q_pos_lemma, assumption+)
-apply (subgoal_tac "b*q < b* (q' + 1) ")
- apply (simp add: mult_less_cancel_left)
-apply (subgoal_tac "b*q = r' - r + b'*q'")
- prefer 2 apply simp
-apply (simp (no_asm_simp) add: right_distrib)
-apply (subst add_commute, rule zadd_zless_mono, arith)
-apply (rule mult_right_mono, auto)
-done
-
-lemma zdiv_mono2:
- "[| (0::int) \<le> a; 0 < b'; b' \<le> b |] ==> a div b \<le> a div b'"
-apply (subgoal_tac "b \<noteq> 0")
- prefer 2 apply arith
-apply (cut_tac a = a and b = b in zmod_zdiv_equality)
-apply (cut_tac a = a and b = b' in zmod_zdiv_equality)
-apply (rule zdiv_mono2_lemma)
-apply (erule subst)
-apply (erule subst, simp_all)
-done
-
-lemma q_neg_lemma:
- "[| b'*q' + r' < 0; 0 \<le> r'; 0 < b' |] ==> q' \<le> (0::int)"
-apply (subgoal_tac "b'*q' < 0")
- apply (simp add: mult_less_0_iff, arith)
-done
-
-lemma zdiv_mono2_neg_lemma:
- "[| b*q + r = b'*q' + r'; b'*q' + r' < 0;
- r < b; 0 \<le> r'; 0 < b'; b' \<le> b |]
- ==> q' \<le> (q::int)"
-apply (frule q_neg_lemma, assumption+)
-apply (subgoal_tac "b*q' < b* (q + 1) ")
- apply (simp add: mult_less_cancel_left)
-apply (simp add: right_distrib)
-apply (subgoal_tac "b*q' \<le> b'*q'")
- prefer 2 apply (simp add: mult_right_mono_neg, arith)
-done
-
-lemma zdiv_mono2_neg:
- "[| a < (0::int); 0 < b'; b' \<le> b |] ==> a div b' \<le> a div b"
-apply (cut_tac a = a and b = b in zmod_zdiv_equality)
-apply (cut_tac a = a and b = b' in zmod_zdiv_equality)
-apply (rule zdiv_mono2_neg_lemma)
-apply (erule subst)
-apply (erule subst, simp_all)
-done
-
-subsection{*More Algebraic Laws for div and mod*}
-
-text{*proving (a*b) div c = a * (b div c) + a * (b mod c) *}
-
-lemma zmult1_lemma:
- "[| quorem((b,c),(q,r)); c \<noteq> 0 |]
- ==> quorem ((a*b, c), (a*q + a*r div c, a*r mod c))"
-by (force simp add: split_ifs quorem_def linorder_neq_iff right_distrib)
-
-lemma zdiv_zmult1_eq: "(a*b) div c = a*(b div c) + a*(b mod c) div (c::int)"
-apply (case_tac "c = 0", simp)
-apply (blast intro: quorem_div_mod [THEN zmult1_lemma, THEN quorem_div])
-done
-
-lemma zmod_zmult1_eq: "(a*b) mod c = a*(b mod c) mod (c::int)"
-apply (case_tac "c = 0", simp)
-apply (blast intro: quorem_div_mod [THEN zmult1_lemma, THEN quorem_mod])
-done
-
-lemma zmod_zmult1_eq': "(a*b) mod (c::int) = ((a mod c) * b) mod c"
-apply (rule trans)
-apply (rule_tac s = "b*a mod c" in trans)
-apply (rule_tac [2] zmod_zmult1_eq)
-apply (simp_all add: mult_commute)
-done
-
-lemma zmod_zmult_distrib: "(a*b) mod (c::int) = ((a mod c) * (b mod c)) mod c"
-apply (rule zmod_zmult1_eq' [THEN trans])
-apply (rule zmod_zmult1_eq)
-done
-
-lemma zdiv_zmult_self1 [simp]: "b \<noteq> (0::int) ==> (a*b) div b = a"
-by (simp add: zdiv_zmult1_eq)
-
-lemma zdiv_zmult_self2 [simp]: "b \<noteq> (0::int) ==> (b*a) div b = a"
-by (subst mult_commute, erule zdiv_zmult_self1)
-
-lemma zmod_zmult_self1 [simp]: "(a*b) mod b = (0::int)"
-by (simp add: zmod_zmult1_eq)
-
-lemma zmod_zmult_self2 [simp]: "(b*a) mod b = (0::int)"
-by (simp add: mult_commute zmod_zmult1_eq)
-
-lemma zmod_eq_0_iff: "(m mod d = 0) = (EX q::int. m = d*q)"
-proof
- assume "m mod d = 0"
- with zmod_zdiv_equality[of m d] show "EX q::int. m = d*q" by auto
-next
- assume "EX q::int. m = d*q"
- thus "m mod d = 0" by auto
-qed
-
-lemmas zmod_eq_0D [dest!] = zmod_eq_0_iff [THEN iffD1]
-
-text{*proving (a+b) div c = a div c + b div c + ((a mod c + b mod c) div c) *}
-
-lemma zadd1_lemma:
- "[| quorem((a,c),(aq,ar)); quorem((b,c),(bq,br)); c \<noteq> 0 |]
- ==> quorem ((a+b, c), (aq + bq + (ar+br) div c, (ar+br) mod c))"
-by (force simp add: split_ifs quorem_def linorder_neq_iff right_distrib)
-
-(*NOT suitable for rewriting: the RHS has an instance of the LHS*)
-lemma zdiv_zadd1_eq:
- "(a+b) div (c::int) = a div c + b div c + ((a mod c + b mod c) div c)"
-apply (case_tac "c = 0", simp)
-apply (blast intro: zadd1_lemma [OF quorem_div_mod quorem_div_mod] quorem_div)
-done
-
-lemma zmod_zadd1_eq: "(a+b) mod (c::int) = (a mod c + b mod c) mod c"
-apply (case_tac "c = 0", simp)
-apply (blast intro: zadd1_lemma [OF quorem_div_mod quorem_div_mod] quorem_mod)
-done
-
-lemma mod_div_trivial [simp]: "(a mod b) div b = (0::int)"
-apply (case_tac "b = 0", simp)
-apply (auto simp add: linorder_neq_iff div_pos_pos_trivial div_neg_neg_trivial)
-done
-
-lemma mod_mod_trivial [simp]: "(a mod b) mod b = a mod (b::int)"
-apply (case_tac "b = 0", simp)
-apply (force simp add: linorder_neq_iff mod_pos_pos_trivial mod_neg_neg_trivial)
-done
-
-lemma zmod_zadd_left_eq: "(a+b) mod (c::int) = ((a mod c) + b) mod c"
-apply (rule trans [symmetric])
-apply (rule zmod_zadd1_eq, simp)
-apply (rule zmod_zadd1_eq [symmetric])
-done
-
-lemma zmod_zadd_right_eq: "(a+b) mod (c::int) = (a + (b mod c)) mod c"
-apply (rule trans [symmetric])
-apply (rule zmod_zadd1_eq, simp)
-apply (rule zmod_zadd1_eq [symmetric])
-done
-
-lemma zdiv_zadd_self1[simp]: "a \<noteq> (0::int) ==> (a+b) div a = b div a + 1"
-by (simp add: zdiv_zadd1_eq)
-
-lemma zdiv_zadd_self2[simp]: "a \<noteq> (0::int) ==> (b+a) div a = b div a + 1"
-by (simp add: zdiv_zadd1_eq)
-
-lemma zmod_zadd_self1[simp]: "(a+b) mod a = b mod (a::int)"
-apply (case_tac "a = 0", simp)
-apply (simp add: zmod_zadd1_eq)
-done
-
-lemma zmod_zadd_self2[simp]: "(b+a) mod a = b mod (a::int)"
-apply (case_tac "a = 0", simp)
-apply (simp add: zmod_zadd1_eq)
-done
-
-
-subsection{*Proving @{term "a div (b*c) = (a div b) div c"} *}
-
-(*The condition c>0 seems necessary. Consider that 7 div ~6 = ~2 but
- 7 div 2 div ~3 = 3 div ~3 = ~1. The subcase (a div b) mod c = 0 seems
- to cause particular problems.*)
-
-text{*first, four lemmas to bound the remainder for the cases b<0 and b>0 *}
-
-lemma zmult2_lemma_aux1: "[| (0::int) < c; b < r; r \<le> 0 |] ==> b*c < b*(q mod c) + r"
-apply (subgoal_tac "b * (c - q mod c) < r * 1")
-apply (simp add: right_diff_distrib)
-apply (rule order_le_less_trans)
-apply (erule_tac [2] mult_strict_right_mono)
-apply (rule mult_left_mono_neg)
-apply (auto simp add: compare_rls add_commute [of 1]
- add1_zle_eq pos_mod_bound)
-done
-
-lemma zmult2_lemma_aux2:
- "[| (0::int) < c; b < r; r \<le> 0 |] ==> b * (q mod c) + r \<le> 0"
-apply (subgoal_tac "b * (q mod c) \<le> 0")
- apply arith
-apply (simp add: mult_le_0_iff)
-done
-
-lemma zmult2_lemma_aux3: "[| (0::int) < c; 0 \<le> r; r < b |] ==> 0 \<le> b * (q mod c) + r"
-apply (subgoal_tac "0 \<le> b * (q mod c) ")
-apply arith
-apply (simp add: zero_le_mult_iff)
-done
-
-lemma zmult2_lemma_aux4: "[| (0::int) < c; 0 \<le> r; r < b |] ==> b * (q mod c) + r < b * c"
-apply (subgoal_tac "r * 1 < b * (c - q mod c) ")
-apply (simp add: right_diff_distrib)
-apply (rule order_less_le_trans)
-apply (erule mult_strict_right_mono)
-apply (rule_tac [2] mult_left_mono)
-apply (auto simp add: compare_rls add_commute [of 1]
- add1_zle_eq pos_mod_bound)
-done
-
-lemma zmult2_lemma: "[| quorem ((a,b), (q,r)); b \<noteq> 0; 0 < c |]
- ==> quorem ((a, b*c), (q div c, b*(q mod c) + r))"
-by (auto simp add: mult_ac quorem_def linorder_neq_iff
- zero_less_mult_iff right_distrib [symmetric]
- zmult2_lemma_aux1 zmult2_lemma_aux2 zmult2_lemma_aux3 zmult2_lemma_aux4)
-
-lemma zdiv_zmult2_eq: "(0::int) < c ==> a div (b*c) = (a div b) div c"
-apply (case_tac "b = 0", simp)
-apply (force simp add: quorem_div_mod [THEN zmult2_lemma, THEN quorem_div])
-done
-
-lemma zmod_zmult2_eq:
- "(0::int) < c ==> a mod (b*c) = b*(a div b mod c) + a mod b"
-apply (case_tac "b = 0", simp)
-apply (force simp add: quorem_div_mod [THEN zmult2_lemma, THEN quorem_mod])
-done
-
-
-subsection{*Cancellation of Common Factors in div*}
-
-lemma zdiv_zmult_zmult1_aux1:
- "[| (0::int) < b; c \<noteq> 0 |] ==> (c*a) div (c*b) = a div b"
-by (subst zdiv_zmult2_eq, auto)
-
-lemma zdiv_zmult_zmult1_aux2:
- "[| b < (0::int); c \<noteq> 0 |] ==> (c*a) div (c*b) = a div b"
-apply (subgoal_tac " (c * (-a)) div (c * (-b)) = (-a) div (-b) ")
-apply (rule_tac [2] zdiv_zmult_zmult1_aux1, auto)
-done
-
-lemma zdiv_zmult_zmult1: "c \<noteq> (0::int) ==> (c*a) div (c*b) = a div b"
-apply (case_tac "b = 0", simp)
-apply (auto simp add: linorder_neq_iff zdiv_zmult_zmult1_aux1 zdiv_zmult_zmult1_aux2)
-done
-
-lemma zdiv_zmult_zmult2: "c \<noteq> (0::int) ==> (a*c) div (b*c) = a div b"
-apply (drule zdiv_zmult_zmult1)
-apply (auto simp add: mult_commute)
-done
-
-
-
-subsection{*Distribution of Factors over mod*}
-
-lemma zmod_zmult_zmult1_aux1:
- "[| (0::int) < b; c \<noteq> 0 |] ==> (c*a) mod (c*b) = c * (a mod b)"
-by (subst zmod_zmult2_eq, auto)
-
-lemma zmod_zmult_zmult1_aux2:
- "[| b < (0::int); c \<noteq> 0 |] ==> (c*a) mod (c*b) = c * (a mod b)"
-apply (subgoal_tac " (c * (-a)) mod (c * (-b)) = c * ((-a) mod (-b))")
-apply (rule_tac [2] zmod_zmult_zmult1_aux1, auto)
-done
-
-lemma zmod_zmult_zmult1: "(c*a) mod (c*b) = (c::int) * (a mod b)"
-apply (case_tac "b = 0", simp)
-apply (case_tac "c = 0", simp)
-apply (auto simp add: linorder_neq_iff zmod_zmult_zmult1_aux1 zmod_zmult_zmult1_aux2)
-done
-
-lemma zmod_zmult_zmult2: "(a*c) mod (b*c) = (a mod b) * (c::int)"
-apply (cut_tac c = c in zmod_zmult_zmult1)
-apply (auto simp add: mult_commute)
-done
-
-
-subsection {*Splitting Rules for div and mod*}
-
-text{*The proofs of the two lemmas below are essentially identical*}
-
-lemma split_pos_lemma:
- "0<k ==>
- P(n div k :: int)(n mod k) = (\<forall>i j. 0\<le>j & j<k & n = k*i + j --> P i j)"
-apply (rule iffI, clarify)
- apply (erule_tac P="P ?x ?y" in rev_mp)
- apply (subst zmod_zadd1_eq)
- apply (subst zdiv_zadd1_eq)
- apply (simp add: div_pos_pos_trivial mod_pos_pos_trivial)
-txt{*converse direction*}
-apply (drule_tac x = "n div k" in spec)
-apply (drule_tac x = "n mod k" in spec, simp)
-done
-
-lemma split_neg_lemma:
- "k<0 ==>
- P(n div k :: int)(n mod k) = (\<forall>i j. k<j & j\<le>0 & n = k*i + j --> P i j)"
-apply (rule iffI, clarify)
- apply (erule_tac P="P ?x ?y" in rev_mp)
- apply (subst zmod_zadd1_eq)
- apply (subst zdiv_zadd1_eq)
- apply (simp add: div_neg_neg_trivial mod_neg_neg_trivial)
-txt{*converse direction*}
-apply (drule_tac x = "n div k" in spec)
-apply (drule_tac x = "n mod k" in spec, simp)
-done
-
-lemma split_zdiv:
- "P(n div k :: int) =
- ((k = 0 --> P 0) &
- (0<k --> (\<forall>i j. 0\<le>j & j<k & n = k*i + j --> P i)) &
- (k<0 --> (\<forall>i j. k<j & j\<le>0 & n = k*i + j --> P i)))"
-apply (case_tac "k=0", simp)
-apply (simp only: linorder_neq_iff)
-apply (erule disjE)
- apply (simp_all add: split_pos_lemma [of concl: "%x y. P x"]
- split_neg_lemma [of concl: "%x y. P x"])
-done
-
-lemma split_zmod:
- "P(n mod k :: int) =
- ((k = 0 --> P n) &
- (0<k --> (\<forall>i j. 0\<le>j & j<k & n = k*i + j --> P j)) &
- (k<0 --> (\<forall>i j. k<j & j\<le>0 & n = k*i + j --> P j)))"
-apply (case_tac "k=0", simp)
-apply (simp only: linorder_neq_iff)
-apply (erule disjE)
- apply (simp_all add: split_pos_lemma [of concl: "%x y. P y"]
- split_neg_lemma [of concl: "%x y. P y"])
-done
-
-(* Enable arith to deal with div 2 and mod 2: *)
-declare split_zdiv [of _ _ "number_of k", simplified, standard, arith_split]
-declare split_zmod [of _ _ "number_of k", simplified, standard, arith_split]
-
-
-subsection{*Speeding up the Division Algorithm with Shifting*}
-
-text{*computing div by shifting *}
-
-lemma pos_zdiv_mult_2: "(0::int) \<le> a ==> (1 + 2*b) div (2*a) = b div a"
-proof cases
- assume "a=0"
- thus ?thesis by simp
-next
- assume "a\<noteq>0" and le_a: "0\<le>a"
- hence a_pos: "1 \<le> a" by arith
- hence one_less_a2: "1 < 2*a" by arith
- hence le_2a: "2 * (1 + b mod a) \<le> 2 * a"
- by (simp add: mult_le_cancel_left add_commute [of 1] add1_zle_eq)
- with a_pos have "0 \<le> b mod a" by simp
- hence le_addm: "0 \<le> 1 mod (2*a) + 2*(b mod a)"
- by (simp add: mod_pos_pos_trivial one_less_a2)
- with le_2a
- have "(1 mod (2*a) + 2*(b mod a)) div (2*a) = 0"
- by (simp add: div_pos_pos_trivial le_addm mod_pos_pos_trivial one_less_a2
- right_distrib)
- thus ?thesis
- by (subst zdiv_zadd1_eq,
- simp add: zdiv_zmult_zmult1 zmod_zmult_zmult1 one_less_a2
- div_pos_pos_trivial)
-qed
-
-lemma neg_zdiv_mult_2: "a \<le> (0::int) ==> (1 + 2*b) div (2*a) = (b+1) div a"
-apply (subgoal_tac " (1 + 2* (-b - 1)) div (2 * (-a)) = (-b - 1) div (-a) ")
-apply (rule_tac [2] pos_zdiv_mult_2)
-apply (auto simp add: minus_mult_right [symmetric] right_diff_distrib)
-apply (subgoal_tac " (-1 - (2 * b)) = - (1 + (2 * b))")
-apply (simp only: zdiv_zminus_zminus diff_minus minus_add_distrib [symmetric],
- simp)
-done
-
-
-(*Not clear why this must be proved separately; probably number_of causes
- simplification problems*)
-lemma not_0_le_lemma: "~ 0 \<le> x ==> x \<le> (0::int)"
-by auto
-
-lemma zdiv_number_of_BIT[simp]:
- "number_of (v BIT b) div number_of (w BIT bit.B0) =
- (if b=bit.B0 | (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: zdiv_zmult_zmult1 pos_zdiv_mult_2 neg_zdiv_mult_2 add_ac
- split: bit.split)
-done
-
-
-subsection{*Computing mod by Shifting (proofs resemble those for div)*}
-
-lemma pos_zmod_mult_2:
- "(0::int) \<le> a ==> (1 + 2*b) mod (2*a) = 1 + 2 * (b mod a)"
-apply (case_tac "a = 0", simp)
-apply (subgoal_tac "1 < a * 2")
- prefer 2 apply arith
-apply (subgoal_tac "2* (1 + b mod a) \<le> 2*a")
- apply (rule_tac [2] mult_left_mono)
-apply (auto simp add: add_commute [of 1] mult_commute add1_zle_eq
- pos_mod_bound)
-apply (subst zmod_zadd1_eq)
-apply (simp add: zmod_zmult_zmult2 mod_pos_pos_trivial)
-apply (rule mod_pos_pos_trivial)
-apply (auto simp add: mod_pos_pos_trivial left_distrib)
-apply (subgoal_tac "0 \<le> b mod a", arith, simp)
-done
-
-lemma neg_zmod_mult_2:
- "a \<le> (0::int) ==> (1 + 2*b) mod (2*a) = 2 * ((b+1) mod a) - 1"
-apply (subgoal_tac "(1 + 2* (-b - 1)) mod (2* (-a)) =
- 1 + 2* ((-b - 1) mod (-a))")
-apply (rule_tac [2] pos_zmod_mult_2)
-apply (auto simp add: minus_mult_right [symmetric] right_diff_distrib)
-apply (subgoal_tac " (-1 - (2 * b)) = - (1 + (2 * b))")
- prefer 2 apply simp
-apply (simp only: zmod_zminus_zminus diff_minus minus_add_distrib [symmetric])
-done
-
-lemma zmod_number_of_BIT [simp]:
- "number_of (v BIT b) mod number_of (w BIT bit.B0) =
- (case b of
- bit.B0 => 2 * (number_of v mod number_of w)
- | bit.B1 => 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 UNIV_I split: bit.split)
-apply (simp add: zmod_zmult_zmult1 pos_zmod_mult_2
- not_0_le_lemma neg_zmod_mult_2 add_ac)
-done
-
-
-subsection{*Quotients of Signs*}
-
-lemma div_neg_pos_less0: "[| a < (0::int); 0 < b |] ==> a div b < 0"
-apply (subgoal_tac "a div b \<le> -1", force)
-apply (rule order_trans)
-apply (rule_tac a' = "-1" in zdiv_mono1)
-apply (auto simp add: zdiv_minus1)
-done
-
-lemma div_nonneg_neg_le0: "[| (0::int) \<le> a; b < 0 |] ==> a div b \<le> 0"
-by (drule zdiv_mono1_neg, auto)
-
-lemma pos_imp_zdiv_nonneg_iff: "(0::int) < b ==> (0 \<le> a div b) = (0 \<le> a)"
-apply auto
-apply (drule_tac [2] zdiv_mono1)
-apply (auto simp add: linorder_neq_iff)
-apply (simp (no_asm_use) add: linorder_not_less [symmetric])
-apply (blast intro: div_neg_pos_less0)
-done
-
-lemma neg_imp_zdiv_nonneg_iff:
- "b < (0::int) ==> (0 \<le> a div b) = (a \<le> (0::int))"
-apply (subst zdiv_zminus_zminus [symmetric])
-apply (subst pos_imp_zdiv_nonneg_iff, auto)
-done
-
-(*But not (a div b \<le> 0 iff a\<le>0); consider a=1, b=2 when a div b = 0.*)
-lemma pos_imp_zdiv_neg_iff: "(0::int) < b ==> (a div b < 0) = (a < 0)"
-by (simp add: linorder_not_le [symmetric] pos_imp_zdiv_nonneg_iff)
-
-(*Again the law fails for \<le>: consider a = -1, b = -2 when a div b = 0*)
-lemma neg_imp_zdiv_neg_iff: "b < (0::int) ==> (a div b < 0) = (0 < a)"
-by (simp add: linorder_not_le [symmetric] neg_imp_zdiv_nonneg_iff)
-
-
-subsection {* The Divides Relation *}
-
-lemma zdvd_iff_zmod_eq_0: "(m dvd n) = (n mod m = (0::int))"
-by(simp add:dvd_def zmod_eq_0_iff)
-
-lemmas zdvd_iff_zmod_eq_0_number_of [simp] =
- zdvd_iff_zmod_eq_0 [of "number_of x" "number_of y", standard]
-
-lemma zdvd_0_right [iff]: "(m::int) dvd 0"
-by (simp add: dvd_def)
-
-lemma zdvd_0_left [iff]: "(0 dvd (m::int)) = (m = 0)"
- by (simp add: dvd_def)
-
-lemma zdvd_1_left [iff]: "1 dvd (m::int)"
- by (simp add: dvd_def)
-
-lemma zdvd_refl [simp]: "m dvd (m::int)"
-by (auto simp add: dvd_def intro: zmult_1_right [symmetric])
-
-lemma zdvd_trans: "m dvd n ==> n dvd k ==> m dvd (k::int)"
-by (auto simp add: dvd_def intro: mult_assoc)
-
-lemma zdvd_zminus_iff: "(m dvd -n) = (m dvd (n::int))"
- apply (simp add: dvd_def, auto)
- apply (rule_tac [!] x = "-k" in exI, auto)
- done
-
-lemma zdvd_zminus2_iff: "(-m dvd n) = (m dvd (n::int))"
- apply (simp add: dvd_def, auto)
- apply (rule_tac [!] x = "-k" in exI, auto)
- done
-lemma zdvd_abs1: "( \<bar>i::int\<bar> dvd j) = (i dvd j)"
- apply (cases "i > 0", simp)
- apply (simp add: dvd_def)
- apply (rule iffI)
- apply (erule exE)
- apply (rule_tac x="- k" in exI, simp)
- apply (erule exE)
- apply (rule_tac x="- k" in exI, simp)
- done
-lemma zdvd_abs2: "( (i::int) dvd \<bar>j\<bar>) = (i dvd j)"
- apply (cases "j > 0", simp)
- apply (simp add: dvd_def)
- apply (rule iffI)
- apply (erule exE)
- apply (rule_tac x="- k" in exI, simp)
- apply (erule exE)
- apply (rule_tac x="- k" in exI, simp)
- done
-
-lemma zdvd_anti_sym:
- "0 < m ==> 0 < n ==> m dvd n ==> n dvd m ==> m = (n::int)"
- apply (simp add: dvd_def, auto)
- apply (simp add: mult_assoc zero_less_mult_iff zmult_eq_1_iff)
- done
-
-lemma zdvd_zadd: "k dvd m ==> k dvd n ==> k dvd (m + n :: int)"
- apply (simp add: dvd_def)
- apply (blast intro: right_distrib [symmetric])
- done
-
-lemma zdvd_dvd_eq: assumes anz:"a \<noteq> 0" and ab: "(a::int) dvd b" and ba:"b dvd a"
- shows "\<bar>a\<bar> = \<bar>b\<bar>"
-proof-
- from ab obtain k where k:"b = a*k" unfolding dvd_def by blast
- from ba obtain k' where k':"a = b*k'" unfolding dvd_def by blast
- from k k' have "a = a*k*k'" by simp
- with mult_cancel_left1[where c="a" and b="k*k'"]
- have kk':"k*k' = 1" using anz by (simp add: mult_assoc)
- hence "k = 1 \<and> k' = 1 \<or> k = -1 \<and> k' = -1" by (simp add: zmult_eq_1_iff)
- thus ?thesis using k k' by auto
-qed
-
-lemma zdvd_zdiff: "k dvd m ==> k dvd n ==> k dvd (m - n :: int)"
- apply (simp add: dvd_def)
- apply (blast intro: right_diff_distrib [symmetric])
- done
-
-lemma zdvd_zdiffD: "k dvd m - n ==> k dvd n ==> k dvd (m::int)"
- apply (subgoal_tac "m = n + (m - n)")
- apply (erule ssubst)
- apply (blast intro: zdvd_zadd, simp)
- done
-
-lemma zdvd_zmult: "k dvd (n::int) ==> k dvd m * n"
- apply (simp add: dvd_def)
- apply (blast intro: mult_left_commute)
- done
-
-lemma zdvd_zmult2: "k dvd (m::int) ==> k dvd m * n"
- apply (subst mult_commute)
- apply (erule zdvd_zmult)
- done
-
-lemma zdvd_triv_right [iff]: "(k::int) dvd m * k"
- apply (rule zdvd_zmult)
- apply (rule zdvd_refl)
- done
-
-lemma zdvd_triv_left [iff]: "(k::int) dvd k * m"
- apply (rule zdvd_zmult2)
- apply (rule zdvd_refl)
- done
-
-lemma zdvd_zmultD2: "j * k dvd n ==> j dvd (n::int)"
- apply (simp add: dvd_def)
- apply (simp add: mult_assoc, blast)
- done
-
-lemma zdvd_zmultD: "j * k dvd n ==> k dvd (n::int)"
- apply (rule zdvd_zmultD2)
- apply (subst mult_commute, assumption)
- done
-
-lemma zdvd_zmult_mono: "i dvd m ==> j dvd (n::int) ==> i * j dvd m * n"
- apply (simp add: dvd_def, clarify)
- apply (rule_tac x = "k * ka" in exI)
- apply (simp add: mult_ac)
- done
-
-lemma zdvd_reduce: "(k dvd n + k * m) = (k dvd (n::int))"
- apply (rule iffI)
- apply (erule_tac [2] zdvd_zadd)
- apply (subgoal_tac "n = (n + k * m) - k * m")
- apply (erule ssubst)
- apply (erule zdvd_zdiff, simp_all)
- done
-
-lemma zdvd_zmod: "f dvd m ==> f dvd (n::int) ==> f dvd m mod n"
- apply (simp add: dvd_def)
- apply (auto simp add: zmod_zmult_zmult1)
- done
-
-lemma zdvd_zmod_imp_zdvd: "k dvd m mod n ==> k dvd n ==> k dvd (m::int)"
- apply (subgoal_tac "k dvd n * (m div n) + m mod n")
- apply (simp add: zmod_zdiv_equality [symmetric])
- apply (simp only: zdvd_zadd zdvd_zmult2)
- done
-
-lemma zdvd_not_zless: "0 < m ==> m < n ==> \<not> n dvd (m::int)"
- apply (simp add: dvd_def, auto)
- apply (subgoal_tac "0 < n")
- prefer 2
- apply (blast intro: order_less_trans)
- apply (simp add: zero_less_mult_iff)
- apply (subgoal_tac "n * k < n * 1")
- apply (drule mult_less_cancel_left [THEN iffD1], auto)
- done
-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: ring_eq_simps)
-
-lemma zdvd_mult_div_cancel:"(n::int) dvd m \<Longrightarrow> n * (m div n) = m"
-apply (subgoal_tac "m mod n = 0")
- apply (simp add: zmult_div_cancel)
-apply (simp only: zdvd_iff_zmod_eq_0)
-done
-
-lemma zdvd_mult_cancel: assumes d:"k * m dvd k * n" and kz:"k \<noteq> (0::int)"
- shows "m dvd n"
-proof-
- from d obtain h where h: "k*n = k*m * h" unfolding dvd_def by blast
- {assume "n \<noteq> m*h" hence "k* n \<noteq> k* (m*h)" using kz by simp
- with h have False by (simp add: mult_assoc)}
- hence "n = m * h" by blast
- thus ?thesis by blast
-qed
-
-theorem ex_nat: "(\<exists>x::nat. P x) = (\<exists>x::int. 0 <= x \<and> P (nat x))"
- apply (simp split add: split_nat)
- apply (rule iffI)
- apply (erule exE)
- apply (rule_tac x = "int x" in exI)
- apply simp
- apply (erule exE)
- apply (rule_tac x = "nat x" in exI)
- apply (erule conjE)
- apply (erule_tac x = "nat x" in allE)
- apply simp
- done
-
-theorem zdvd_int: "(x dvd y) = (int x dvd int y)"
- apply (simp only: dvd_def ex_nat int_int_eq [symmetric] zmult_int [symmetric]
- nat_0_le cong add: conj_cong)
- apply (rule iffI)
- apply iprover
- apply (erule exE)
- apply (case_tac "x=0")
- apply (rule_tac x=0 in exI)
- apply simp
- apply (case_tac "0 \<le> k")
- apply iprover
- apply (simp add: linorder_not_le)
- apply (drule mult_strict_left_mono_neg [OF iffD2 [OF zero_less_int_conv]])
- apply assumption
- apply (simp add: mult_ac)
- done
-
-lemma zdvd1_eq[simp]: "(x::int) dvd 1 = ( \<bar>x\<bar> = 1)"
-proof
- assume d: "x dvd 1" hence "int (nat \<bar>x\<bar>) dvd int (nat 1)" by (simp add: zdvd_abs1)
- hence "nat \<bar>x\<bar> dvd 1" by (simp add: zdvd_int)
- hence "nat \<bar>x\<bar> = 1" by simp
- thus "\<bar>x\<bar> = 1" by (cases "x < 0", auto)
-next
- assume "\<bar>x\<bar>=1" thus "x dvd 1"
- by(cases "x < 0",simp_all add: minus_equation_iff zdvd_iff_zmod_eq_0)
-qed
-lemma zdvd_mult_cancel1:
- assumes mp:"m \<noteq>(0::int)" shows "(m * n dvd m) = (\<bar>n\<bar> = 1)"
-proof
- assume n1: "\<bar>n\<bar> = 1" thus "m * n dvd m"
- by (cases "n >0", auto simp add: zdvd_zminus2_iff minus_equation_iff)
-next
- assume H: "m * n dvd m" hence H2: "m * n dvd m * 1" by simp
- from zdvd_mult_cancel[OF H2 mp] show "\<bar>n\<bar> = 1" by (simp only: zdvd1_eq)
-qed
-
-lemma int_dvd_iff: "(int m dvd z) = (m dvd nat (abs z))"
- apply (auto simp add: dvd_def nat_abs_mult_distrib)
- apply (auto simp add: nat_eq_iff abs_if split add: split_if_asm)
- apply (rule_tac x = "-(int k)" in exI)
- apply (auto simp add: int_mult)
- done
-
-lemma dvd_int_iff: "(z dvd int m) = (nat (abs z) dvd m)"
- apply (auto simp add: dvd_def abs_if int_mult)
- apply (rule_tac [3] x = "nat k" in exI)
- apply (rule_tac [2] x = "-(int k)" in exI)
- apply (rule_tac x = "nat (-k)" in exI)
- apply (cut_tac [3] k = m in int_less_0_conv)
- apply (cut_tac k = m in int_less_0_conv)
- apply (auto simp add: zero_le_mult_iff mult_less_0_iff
- nat_mult_distrib [symmetric] nat_eq_iff2)
- done
-
-lemma nat_dvd_iff: "(nat z dvd m) = (if 0 \<le> z then (z dvd int m) else m = 0)"
- apply (auto simp add: dvd_def int_mult)
- apply (rule_tac x = "nat k" in exI)
- apply (cut_tac k = m in int_less_0_conv)
- apply (auto simp add: zero_le_mult_iff mult_less_0_iff
- nat_mult_distrib [symmetric] nat_eq_iff2)
- done
-
-lemma zminus_dvd_iff [iff]: "(-z dvd w) = (z dvd (w::int))"
- apply (auto simp add: dvd_def)
- apply (rule_tac [!] x = "-k" in exI, auto)
- done
-
-lemma dvd_zminus_iff [iff]: "(z dvd -w) = (z dvd (w::int))"
- apply (auto simp add: dvd_def)
- apply (drule minus_equation_iff [THEN iffD1])
- apply (rule_tac [!] x = "-k" in exI, auto)
- done
-
-lemma zdvd_imp_le: "[| z dvd n; 0 < n |] ==> z \<le> (n::int)"
- apply (rule_tac z=n in int_cases)
- apply (auto simp add: dvd_int_iff)
- apply (rule_tac z=z in int_cases)
- apply (auto simp add: dvd_imp_le)
- done
-
-
-subsection{*Integer Powers*}
-
-instance int :: power ..
-
-primrec
- "p ^ 0 = 1"
- "p ^ (Suc n) = (p::int) * (p ^ n)"
-
-
-instance int :: recpower
-proof
- fix z :: int
- fix n :: nat
- show "z^0 = 1" by simp
- show "z^(Suc n) = z * (z^n)" by simp
-qed
-
-
-lemma zpower_zmod: "((x::int) mod m)^y mod m = x^y mod m"
-apply (induct "y", auto)
-apply (rule zmod_zmult1_eq [THEN trans])
-apply (simp (no_asm_simp))
-apply (rule zmod_zmult_distrib [symmetric])
-done
-
-lemma zpower_zadd_distrib: "x^(y+z) = ((x^y)*(x^z)::int)"
- by (rule Power.power_add)
-
-lemma zpower_zpower: "(x^y)^z = (x^(y*z)::int)"
- by (rule Power.power_mult [symmetric])
-
-lemma zero_less_zpower_abs_iff [simp]:
- "(0 < (abs x)^n) = (x \<noteq> (0::int) | n=0)"
-apply (induct "n")
-apply (auto simp add: zero_less_mult_iff)
-done
-
-lemma zero_le_zpower_abs [simp]: "(0::int) <= (abs x)^n"
-apply (induct "n")
-apply (auto simp add: zero_le_mult_iff)
-done
-
-lemma int_power: "int (m^n) = (int m) ^ n"
- by (induct n, simp_all add: int_mult)
-
-text{*Compatibility binding*}
-lemmas zpower_int = int_power [symmetric]
-
-lemma zdiv_int: "int (a div b) = (int a) div (int b)"
-apply (subst split_div, auto)
-apply (subst split_zdiv, auto)
-apply (rule_tac a="int (b * i) + int j" and b="int b" and r="int j" and r'=ja in IntDiv.unique_quotient)
-apply (auto simp add: IntDiv.quorem_def int_eq_of_nat)
-done
-
-lemma zmod_int: "int (a mod b) = (int a) mod (int b)"
-apply (subst split_mod, auto)
-apply (subst split_zmod, auto)
-apply (rule_tac a="int (b * i) + int j" and b="int b" and q="int i" and q'=ia
- in unique_remainder)
-apply (auto simp add: IntDiv.quorem_def int_eq_of_nat)
-done
-
-text{*Suggested by Matthias Daum*}
-lemma int_power_div_base:
- "\<lbrakk>0 < m; 0 < k\<rbrakk> \<Longrightarrow> k ^ m div k = (k::int) ^ (m - Suc 0)"
-apply (subgoal_tac "k ^ m = k ^ ((m - 1) + 1)")
- apply (erule ssubst)
- apply (simp only: power_add)
- apply simp_all
-done
-
-text {* code serializer setup *}
-
-code_modulename SML
- IntDiv Integer
-
-code_modulename OCaml
- IntDiv Integer
-
-code_modulename Haskell
- IntDiv Divides
-
-end
--- a/src/HOL/Integ/NatBin.thy Thu May 31 18:16:51 2007 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,903 +0,0 @@
-(* Title: HOL/NatBin.thy
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1999 University of Cambridge
-*)
-
-header {* Binary arithmetic for the natural numbers *}
-
-theory NatBin
-imports IntDiv
-begin
-
-text {*
- Arithmetic for naturals is reduced to that for the non-negative integers.
-*}
-
-instance nat :: number
- nat_number_of_def [code inline]: "number_of v == nat (number_of (v\<Colon>int))" ..
-
-abbreviation (xsymbols)
- square :: "'a::power => 'a" ("(_\<twosuperior>)" [1000] 999) where
- "x\<twosuperior> == x^2"
-
-notation (latex output)
- square ("(_\<twosuperior>)" [1000] 999)
-
-notation (HTML output)
- square ("(_\<twosuperior>)" [1000] 999)
-
-
-subsection{*Function @{term nat}: Coercion from Type @{typ int} to @{typ nat}*}
-
-declare nat_0 [simp] 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 [simp]: "Numeral0 = (0::nat)"
-by (simp add: nat_number_of_def)
-
-lemma nat_numeral_1_eq_1 [simp]: "Numeral1 = (1::nat)"
-by (simp add: nat_1 nat_number_of_def)
-
-lemma numeral_1_eq_Suc_0: "Numeral1 = Suc 0"
-by (simp add: nat_numeral_1_eq_1)
-
-lemma numeral_2_eq_2: "2 = Suc (Suc 0)"
-apply (unfold nat_number_of_def)
-apply (rule nat_2)
-done
-
-
-text{*Distributive laws for type @{text nat}. The others are in theory
- @{text IntArith}, but these require div and mod to be defined for type
- "int". They also need some of the lemmas proved above.*}
-
-lemma nat_div_distrib: "(0::int) <= z ==> nat (z div z') = nat z div nat z'"
-apply (case_tac "0 <= z'")
-apply (auto simp add: div_nonneg_neg_le0 DIVISION_BY_ZERO_DIV)
-apply (case_tac "z' = 0", simp add: DIVISION_BY_ZERO)
-apply (auto elim!: nonneg_eq_int)
-apply (rename_tac m m')
-apply (subgoal_tac "0 <= int m div int m'")
- prefer 2 apply (simp add: nat_numeral_0_eq_0 pos_imp_zdiv_nonneg_iff)
-apply (rule inj_int [THEN injD], simp)
-apply (rule_tac r = "int (m mod m') " in quorem_div)
- prefer 2 apply force
-apply (simp add: nat_less_iff [symmetric] quorem_def nat_numeral_0_eq_0 zadd_int
- zmult_int)
-done
-
-(*Fails if z'<0: the LHS collapses to (nat z) but the RHS doesn't*)
-lemma nat_mod_distrib:
- "[| (0::int) <= z; 0 <= z' |] ==> nat (z mod z') = nat z mod nat z'"
-apply (case_tac "z' = 0", simp add: DIVISION_BY_ZERO)
-apply (auto elim!: nonneg_eq_int)
-apply (rename_tac m m')
-apply (subgoal_tac "0 <= int m mod int m'")
- prefer 2 apply (simp add: nat_less_iff nat_numeral_0_eq_0 pos_mod_sign)
-apply (rule inj_int [THEN injD], simp)
-apply (rule_tac q = "int (m div m') " in quorem_mod)
- prefer 2 apply force
-apply (simp add: nat_less_iff [symmetric] quorem_def nat_numeral_0_eq_0 zadd_int zmult_int)
-done
-
-text{*Suggested by Matthias Daum*}
-lemma int_div_less_self: "\<lbrakk>0 < x; 1 < k\<rbrakk> \<Longrightarrow> x div k < (x::int)"
-apply (subgoal_tac "nat x div nat k < nat x")
- apply (simp (asm_lr) add: nat_div_distrib [symmetric])
-apply (rule Divides.div_less_dividend, simp_all)
-done
-
-subsection{*Function @{term int}: Coercion from Type @{typ nat} to @{typ int}*}
-
-(*"neg" is used in rewrite rules for binary comparisons*)
-lemma int_nat_number_of [simp]:
- "int (number_of v :: nat) =
- (if neg (number_of v :: int) then 0
- else (number_of v :: int))"
-by (simp del: nat_number_of
- add: neg_nat nat_number_of_def not_neg_nat add_assoc)
-
-
-subsubsection{*Successor *}
-
-lemma Suc_nat_eq_nat_zadd1: "(0::int) <= z ==> Suc (nat z) = nat (1 + z)"
-apply (rule sym)
-apply (simp add: nat_eq_iff int_Suc)
-done
-
-lemma Suc_nat_number_of_add:
- "Suc (number_of v + n) =
- (if neg (number_of v :: int) then 1+n else number_of (Numeral.succ v) + n)"
-by (simp del: nat_number_of
- add: nat_number_of_def neg_nat
- Suc_nat_eq_nat_zadd1 number_of_succ)
-
-lemma Suc_nat_number_of [simp]:
- "Suc (number_of v) =
- (if neg (number_of v :: int) then 1 else number_of (Numeral.succ v))"
-apply (cut_tac n = 0 in Suc_nat_number_of_add)
-apply (simp cong del: if_weak_cong)
-done
-
-
-subsubsection{*Addition *}
-
-(*"neg" is used in rewrite rules for binary comparisons*)
-lemma add_nat_number_of [simp]:
- "(number_of v :: nat) + number_of v' =
- (if neg (number_of v :: int) then number_of v'
- else if neg (number_of v' :: int) then number_of v
- else number_of (v + v'))"
-by (force dest!: neg_nat
- simp del: nat_number_of
- simp add: nat_number_of_def nat_add_distrib [symmetric])
-
-
-subsubsection{*Subtraction *}
-
-lemma diff_nat_eq_if:
- "nat z - nat z' =
- (if neg z' then nat z
- else let d = z-z' in
- if neg d then 0 else nat d)"
-apply (simp add: Let_def nat_diff_distrib [symmetric] neg_eq_less_0 not_neg_eq_ge_0)
-done
-
-lemma diff_nat_number_of [simp]:
- "(number_of v :: nat) - number_of v' =
- (if neg (number_of v' :: int) then number_of v
- else let d = number_of (v + uminus v') in
- if neg d then 0 else nat d)"
-by (simp del: nat_number_of add: diff_nat_eq_if nat_number_of_def)
-
-
-
-subsubsection{*Multiplication *}
-
-lemma mult_nat_number_of [simp]:
- "(number_of v :: nat) * number_of v' =
- (if neg (number_of v :: int) then 0 else number_of (v * v'))"
-by (force dest!: neg_nat
- simp del: nat_number_of
- simp add: nat_number_of_def nat_mult_distrib [symmetric])
-
-
-
-subsubsection{*Quotient *}
-
-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'))"
-by (force dest!: neg_nat
- simp del: nat_number_of
- simp add: nat_number_of_def nat_div_distrib [symmetric])
-
-lemma one_div_nat_number_of [simp]:
- "(Suc 0) div number_of v' = (nat (1 div number_of v'))"
-by (simp del: nat_numeral_1_eq_1 add: numeral_1_eq_Suc_0 [symmetric])
-
-
-subsubsection{*Remainder *}
-
-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'))"
-by (force dest!: neg_nat
- simp del: nat_number_of
- simp add: nat_number_of_def nat_mod_distrib [symmetric])
-
-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: nat_numeral_1_eq_1 add: numeral_1_eq_Suc_0 [symmetric])
-
-
-subsubsection{* Divisibility *}
-
-lemmas dvd_eq_mod_eq_0_number_of =
- dvd_eq_mod_eq_0 [of "number_of x" "number_of y", standard]
-
-declare dvd_eq_mod_eq_0_number_of [simp]
-
-ML
-{*
-val nat_number_of_def = thm"nat_number_of_def";
-
-val nat_number_of = thm"nat_number_of";
-val nat_numeral_0_eq_0 = thm"nat_numeral_0_eq_0";
-val nat_numeral_1_eq_1 = thm"nat_numeral_1_eq_1";
-val numeral_1_eq_Suc_0 = thm"numeral_1_eq_Suc_0";
-val numeral_2_eq_2 = thm"numeral_2_eq_2";
-val nat_div_distrib = thm"nat_div_distrib";
-val nat_mod_distrib = thm"nat_mod_distrib";
-val int_nat_number_of = thm"int_nat_number_of";
-val Suc_nat_eq_nat_zadd1 = thm"Suc_nat_eq_nat_zadd1";
-val Suc_nat_number_of_add = thm"Suc_nat_number_of_add";
-val Suc_nat_number_of = thm"Suc_nat_number_of";
-val add_nat_number_of = thm"add_nat_number_of";
-val diff_nat_eq_if = thm"diff_nat_eq_if";
-val diff_nat_number_of = thm"diff_nat_number_of";
-val mult_nat_number_of = thm"mult_nat_number_of";
-val div_nat_number_of = thm"div_nat_number_of";
-val mod_nat_number_of = thm"mod_nat_number_of";
-*}
-
-
-subsection{*Comparisons*}
-
-subsubsection{*Equals (=) *}
-
-lemma eq_nat_nat_iff:
- "[| (0::int) <= z; 0 <= z' |] ==> (nat z = nat z') = (z=z')"
-by (auto elim!: nonneg_eq_int)
-
-(*"neg" is used in rewrite rules for binary comparisons*)
-lemma eq_nat_number_of [simp]:
- "((number_of v :: nat) = number_of v') =
- (if neg (number_of v :: int) then (iszero (number_of v' :: int) | neg (number_of v' :: int))
- else if neg (number_of v' :: int) then iszero (number_of v :: int)
- else iszero (number_of (v + uminus v') :: int))"
-apply (simp only: simp_thms neg_nat not_neg_eq_ge_0 nat_number_of_def
- eq_nat_nat_iff eq_number_of_eq nat_0 iszero_def
- split add: split_if cong add: imp_cong)
-apply (simp only: nat_eq_iff nat_eq_iff2)
-apply (simp add: not_neg_eq_ge_0 [symmetric])
-done
-
-
-subsubsection{*Less-than (<) *}
-
-(*"neg" is used in rewrite rules for binary comparisons*)
-lemma less_nat_number_of [simp]:
- "((number_of v :: nat) < number_of v') =
- (if neg (number_of v :: int) then neg (number_of (uminus v') :: int)
- else neg (number_of (v + uminus v') :: int))"
-by (simp only: simp_thms neg_nat not_neg_eq_ge_0 nat_number_of_def
- nat_less_eq_zless less_number_of_eq_neg zless_nat_eq_int_zless
- cong add: imp_cong, simp add: Pls_def)
-
-
-(*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
-
-
-subsection{*Powers with Numeric Exponents*}
-
-text{*We cannot refer to the number @{term 2} in @{text Ring_and_Field.thy}.
-We cannot prove general results about the numeral @{term "-1"}, so we have to
-use @{term "- 1"} instead.*}
-
-lemma power2_eq_square: "(a::'a::{comm_semiring_1_cancel,recpower})\<twosuperior> = a * a"
- by (simp add: numeral_2_eq_2 Power.power_Suc)
-
-lemma zero_power2 [simp]: "(0::'a::{comm_semiring_1_cancel,recpower})\<twosuperior> = 0"
- by (simp add: power2_eq_square)
-
-lemma one_power2 [simp]: "(1::'a::{comm_semiring_1_cancel,recpower})\<twosuperior> = 1"
- by (simp add: power2_eq_square)
-
-lemma power3_eq_cube: "(x::'a::recpower) ^ 3 = x * x * x"
- apply (subgoal_tac "3 = Suc (Suc (Suc 0))")
- apply (erule ssubst)
- apply (simp add: power_Suc mult_ac)
- apply (unfold nat_number_of_def)
- apply (subst nat_eq_iff)
- apply simp
-done
-
-text{*Squares of literal numerals will be evaluated.*}
-lemmas power2_eq_square_number_of =
- power2_eq_square [of "number_of w", standard]
-declare power2_eq_square_number_of [simp]
-
-
-lemma zero_le_power2[simp]: "0 \<le> (a\<twosuperior>::'a::{ordered_idom,recpower})"
- by (simp add: power2_eq_square)
-
-lemma zero_less_power2[simp]:
- "(0 < a\<twosuperior>) = (a \<noteq> (0::'a::{ordered_idom,recpower}))"
- by (force simp add: power2_eq_square zero_less_mult_iff linorder_neq_iff)
-
-lemma power2_less_0[simp]:
- fixes a :: "'a::{ordered_idom,recpower}"
- shows "~ (a\<twosuperior> < 0)"
-by (force simp add: power2_eq_square mult_less_0_iff)
-
-lemma zero_eq_power2[simp]:
- "(a\<twosuperior> = 0) = (a = (0::'a::{ordered_idom,recpower}))"
- by (force simp add: power2_eq_square mult_eq_0_iff)
-
-lemma abs_power2[simp]:
- "abs(a\<twosuperior>) = (a\<twosuperior>::'a::{ordered_idom,recpower})"
- by (simp add: power2_eq_square abs_mult abs_mult_self)
-
-lemma power2_abs[simp]:
- "(abs a)\<twosuperior> = (a\<twosuperior>::'a::{ordered_idom,recpower})"
- by (simp add: power2_eq_square abs_mult_self)
-
-lemma power2_minus[simp]:
- "(- a)\<twosuperior> = (a\<twosuperior>::'a::{comm_ring_1,recpower})"
- by (simp add: power2_eq_square)
-
-lemma power2_le_imp_le:
- fixes x y :: "'a::{ordered_semidom,recpower}"
- shows "\<lbrakk>x\<twosuperior> \<le> y\<twosuperior>; 0 \<le> y\<rbrakk> \<Longrightarrow> x \<le> y"
-unfolding numeral_2_eq_2 by (rule power_le_imp_le_base)
-
-lemma power2_less_imp_less:
- fixes x y :: "'a::{ordered_semidom,recpower}"
- shows "\<lbrakk>x\<twosuperior> < y\<twosuperior>; 0 \<le> y\<rbrakk> \<Longrightarrow> x < y"
-by (rule power_less_imp_less_base)
-
-lemma power2_eq_imp_eq:
- fixes x y :: "'a::{ordered_semidom,recpower}"
- shows "\<lbrakk>x\<twosuperior> = y\<twosuperior>; 0 \<le> x; 0 \<le> y\<rbrakk> \<Longrightarrow> x = y"
-unfolding numeral_2_eq_2 by (erule (2) power_eq_imp_eq_base, simp)
-
-lemma power_minus1_even[simp]: "(- 1) ^ (2*n) = (1::'a::{comm_ring_1,recpower})"
-apply (induct "n")
-apply (auto simp add: power_Suc power_add)
-done
-
-lemma power_even_eq: "(a::'a::recpower) ^ (2*n) = (a^n)^2"
-by (subst mult_commute) (simp add: power_mult)
-
-lemma power_odd_eq: "(a::int) ^ Suc(2*n) = a * (a^n)^2"
-by (simp add: power_even_eq)
-
-lemma power_minus_even [simp]:
- "(-a) ^ (2*n) = (a::'a::{comm_ring_1,recpower}) ^ (2*n)"
-by (simp add: power_minus1_even power_minus [of a])
-
-lemma zero_le_even_power'[simp]:
- "0 \<le> (a::'a::{ordered_idom,recpower}) ^ (2*n)"
-proof (induct "n")
- case 0
- show ?case by (simp add: zero_le_one)
-next
- case (Suc n)
- have "a ^ (2 * Suc n) = (a*a) * a ^ (2*n)"
- by (simp add: mult_ac power_add power2_eq_square)
- thus ?case
- by (simp add: prems zero_le_mult_iff)
-qed
-
-lemma odd_power_less_zero:
- "(a::'a::{ordered_idom,recpower}) < 0 ==> a ^ Suc(2*n) < 0"
-proof (induct "n")
- case 0
- show ?case by (simp add: Power.power_Suc)
-next
- case (Suc n)
- have "a ^ Suc (2 * Suc n) = (a*a) * a ^ Suc(2*n)"
- by (simp add: mult_ac power_add power2_eq_square Power.power_Suc)
- thus ?case
- by (simp add: prems mult_less_0_iff mult_neg_neg)
-qed
-
-lemma odd_0_le_power_imp_0_le:
- "0 \<le> a ^ Suc(2*n) ==> 0 \<le> (a::'a::{ordered_idom,recpower})"
-apply (insert odd_power_less_zero [of a n])
-apply (force simp add: linorder_not_less [symmetric])
-done
-
-text{*Simprules for comparisons where common factors can be cancelled.*}
-lemmas zero_compare_simps =
- add_strict_increasing add_strict_increasing2 add_increasing
- zero_le_mult_iff zero_le_divide_iff
- zero_less_mult_iff zero_less_divide_iff
- mult_le_0_iff divide_le_0_iff
- mult_less_0_iff divide_less_0_iff
- zero_le_power2 power2_less_0
-
-subsubsection{*Nat *}
-
-lemma Suc_pred': "0 < n ==> n = Suc(n - 1)"
-by (simp add: numerals)
-
-(*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", standard]
-
-subsubsection{*Arith *}
-
-lemma Suc_eq_add_numeral_1: "Suc n = n + 1"
-by (simp add: numerals)
-
-lemma Suc_eq_add_numeral_1_left: "Suc n = 1 + n"
-by (simp add: numerals)
-
-(* These two can be useful when m = number_of... *)
-
-lemma add_eq_if: "(m::nat) + n = (if m=0 then n else Suc ((m - 1) + n))"
-apply (case_tac "m")
-apply (simp_all add: numerals)
-done
-
-lemma mult_eq_if: "(m::nat) * n = (if m=0 then 0 else n + ((m - 1) * n))"
-apply (case_tac "m")
-apply (simp_all add: numerals)
-done
-
-lemma power_eq_if: "(p ^ m :: nat) = (if m=0 then 1 else p * (p ^ (m - 1)))"
-apply (case_tac "m")
-apply (simp_all add: numerals)
-done
-
-
-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)) =
- (if neg (number_of v :: int) then True else iszero (number_of v :: int))"
-by (simp del: nat_numeral_0_eq_0 add: nat_numeral_0_eq_0 [symmetric] iszero_0)
-
-lemma eq_0_number_of [simp]:
- "((0::nat) = number_of v) =
- (if neg (number_of v :: int) then True else iszero (number_of v :: int))"
-by (rule trans [OF eq_sym_conv eq_number_of_0])
-
-lemma less_0_number_of [simp]:
- "((0::nat) < number_of v) = neg (number_of (uminus v) :: int)"
-by (simp del: nat_numeral_0_eq_0 add: nat_numeral_0_eq_0 [symmetric] Pls_def)
-
-
-lemma neg_imp_number_of_eq_0: "neg (number_of v :: int) ==> number_of v = (0::nat)"
-by (simp del: nat_numeral_0_eq_0 add: nat_numeral_0_eq_0 [symmetric] iszero_0)
-
-
-
-subsection{*Comparisons involving @{term Suc} *}
-
-lemma eq_number_of_Suc [simp]:
- "(number_of v = Suc n) =
- (let pv = number_of (Numeral.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 Suc_eq_number_of [simp]:
- "(Suc n = number_of v) =
- (let pv = number_of (Numeral.pred v) in
- if neg pv then False else nat pv = n)"
-by (rule trans [OF eq_sym_conv eq_number_of_Suc])
-
-lemma less_number_of_Suc [simp]:
- "(number_of v < Suc n) =
- (let pv = number_of (Numeral.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_Suc_number_of [simp]:
- "(Suc n < number_of v) =
- (let pv = number_of (Numeral.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 le_number_of_Suc [simp]:
- "(number_of v <= Suc n) =
- (let pv = number_of (Numeral.pred v) in
- if neg pv then True else nat pv <= n)"
-by (simp add: Let_def less_Suc_number_of linorder_not_less [symmetric])
-
-lemma le_Suc_number_of [simp]:
- "(Suc n <= number_of v) =
- (let pv = number_of (Numeral.pred v) in
- if neg pv then False else n <= nat pv)"
-by (simp add: Let_def less_number_of_Suc linorder_not_less [symmetric])
-
-
-(* Push int(.) inwards: *)
-declare zadd_int [symmetric, simp]
-
-lemma lemma1: "(m+m = n+n) = (m = (n::int))"
-by auto
-
-lemma lemma2: "m+m ~= (1::int) + (n + n)"
-apply auto
-apply (drule_tac f = "%x. x mod 2" in arg_cong)
-apply (simp add: zmod_zadd1_eq)
-done
-
-lemma eq_number_of_BIT_BIT:
- "((number_of (v BIT x) ::int) = number_of (w BIT y)) =
- (x=y & (((number_of v) ::int) = number_of w))"
-apply (simp only: number_of_BIT lemma1 lemma2 eq_commute
- OrderedGroup.add_left_cancel add_assoc OrderedGroup.add_0_left
- split add: bit.split)
-apply simp
-done
-
-lemma eq_number_of_BIT_Pls:
- "((number_of (v BIT x) ::int) = Numeral0) =
- (x=bit.B0 & (((number_of v) ::int) = Numeral0))"
-apply (simp only: simp_thms add: number_of_BIT number_of_Pls eq_commute
- split add: bit.split cong: imp_cong)
-apply (rule_tac x = "number_of v" in spec, safe)
-apply (simp_all (no_asm_use))
-apply (drule_tac f = "%x. x mod 2" in arg_cong)
-apply (simp add: zmod_zadd1_eq)
-done
-
-lemma eq_number_of_BIT_Min:
- "((number_of (v BIT x) ::int) = number_of Numeral.Min) =
- (x=bit.B1 & (((number_of v) ::int) = number_of Numeral.Min))"
-apply (simp only: simp_thms add: number_of_BIT number_of_Min eq_commute
- split add: bit.split cong: imp_cong)
-apply (rule_tac x = "number_of v" in spec, auto)
-apply (drule_tac f = "%x. x mod 2" in arg_cong, auto)
-done
-
-lemma eq_number_of_Pls_Min: "(Numeral0 ::int) ~= number_of Numeral.Min"
-by auto
-
-
-
-subsection{*Max and Min Combined with @{term Suc} *}
-
-lemma max_number_of_Suc [simp]:
- "max (Suc n) (number_of v) =
- (let pv = number_of (Numeral.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 (Numeral.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 (Numeral.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 (Numeral.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
-
-subsection{*Literal arithmetic involving powers*}
-
-lemma nat_power_eq: "(0::int) <= z ==> nat (z^n) = nat z ^ n"
-apply (induct "n")
-apply (simp_all (no_asm_simp) add: nat_mult_distrib)
-done
-
-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)
-
-
-lemmas power_nat_number_of_number_of = power_nat_number_of [of _ "number_of w", standard]
-declare power_nat_number_of_number_of [simp]
-
-
-
-text{*For the integers*}
-
-lemma zpower_number_of_even:
- "(z::int) ^ number_of (w BIT bit.B0) = (let w = z ^ (number_of w) in w * w)"
-unfolding Let_def nat_number_of_def number_of_BIT bit.cases
-apply (rule_tac x = "number_of w" in spec, clarify)
-apply (case_tac " (0::int) <= x")
-apply (auto simp add: nat_mult_distrib power_even_eq power2_eq_square)
-done
-
-lemma zpower_number_of_odd:
- "(z::int) ^ number_of (w BIT bit.B1) = (if (0::int) <= number_of w
- then (let w = z ^ (number_of w) in z * w * w) else 1)"
-unfolding Let_def nat_number_of_def number_of_BIT bit.cases
-apply (rule_tac x = "number_of w" in spec, auto)
-apply (simp only: nat_add_distrib nat_mult_distrib)
-apply simp
-apply (auto simp add: nat_add_distrib nat_mult_distrib power_even_eq power2_eq_square neg_nat)
-done
-
-lemmas zpower_number_of_even_number_of =
- zpower_number_of_even [of "number_of v", standard]
-declare zpower_number_of_even_number_of [simp]
-
-lemmas zpower_number_of_odd_number_of =
- zpower_number_of_odd [of "number_of v", standard]
-declare zpower_number_of_odd_number_of [simp]
-
-
-
-
-ML
-{*
-val numerals = thms"numerals";
-val numeral_ss = simpset() addsimps numerals;
-
-val nat_bin_arith_setup =
- Fast_Arith.map_data
- (fn {add_mono_thms, mult_mono_thms, inj_thms, lessD, neqE, simpset} =>
- {add_mono_thms = add_mono_thms, mult_mono_thms = mult_mono_thms,
- inj_thms = inj_thms,
- lessD = lessD, neqE = neqE,
- simpset = simpset addsimps [Suc_nat_number_of, int_nat_number_of,
- not_neg_number_of_Pls,
- neg_number_of_Min,neg_number_of_BIT]})
-*}
-
-setup nat_bin_arith_setup
-
-(* Enable arith to deal with div/mod k where k is a numeral: *)
-declare split_div[of _ _ "number_of k", standard, arith_split]
-declare split_mod[of _ _ "number_of k", standard, arith_split]
-
-lemma nat_number_of_Pls: "Numeral0 = (0::nat)"
- by (simp add: number_of_Pls nat_number_of_def)
-
-lemma nat_number_of_Min: "number_of Numeral.Min = (0::nat)"
- apply (simp only: number_of_Min nat_number_of_def nat_zminus_int)
- done
-
-lemma nat_number_of_BIT_1:
- "number_of (w BIT bit.B1) =
- (if neg (number_of w :: int) then 0
- else let n = number_of w in Suc (n + n))"
- apply (simp only: nat_number_of_def Let_def split: split_if)
- apply (intro conjI impI)
- apply (simp add: neg_nat neg_number_of_BIT)
- apply (rule int_int_eq [THEN iffD1])
- apply (simp only: not_neg_nat neg_number_of_BIT int_Suc zadd_int [symmetric] simp_thms)
- apply (simp only: number_of_BIT zadd_assoc split: bit.split)
- apply simp
- done
-
-lemma nat_number_of_BIT_0:
- "number_of (w BIT bit.B0) = (let n::nat = number_of w in n + n)"
- apply (simp only: nat_number_of_def Let_def)
- apply (cases "neg (number_of w :: int)")
- apply (simp add: neg_nat neg_number_of_BIT)
- apply (rule int_int_eq [THEN iffD1])
- apply (simp only: not_neg_nat neg_number_of_BIT int_Suc zadd_int [symmetric] simp_thms)
- apply (simp only: number_of_BIT zadd_assoc)
- apply simp
- done
-
-lemmas nat_number =
- nat_number_of_Pls nat_number_of_Min
- nat_number_of_BIT_1 nat_number_of_BIT_0
-
-lemma Let_Suc [simp]: "Let (Suc n) f == f (Suc n)"
- by (simp add: Let_def)
-
-lemma power_m1_even: "(-1) ^ (2*n) = (1::'a::{number_ring,recpower})"
-by (simp add: power_mult);
-
-lemma power_m1_odd: "(-1) ^ Suc(2*n) = (-1::'a::{number_ring,recpower})"
-by (simp add: power_mult power_Suc);
-
-
-subsection{*Literal arithmetic and @{term of_nat}*}
-
-lemma of_nat_double:
- "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_ring)
- else 0)"
-by (simp add: int_number_of_def nat_number_of_def number_of_eq of_nat_nat);
-
-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_ring))"
-by (simp only: of_nat_number_of_lemma neg_def, simp)
-
-
-subsection {*Lemmas for the Combination and Cancellation Simprocs*}
-
-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 simp
-
-lemma nat_number_of_mult_left:
- "number_of v * (number_of v' * (k::nat)) =
- (if neg (number_of v :: int) then 0
- else number_of (v * v') * k)"
-by simp
-
-
-subsubsection{*For @{text combine_numerals}*}
-
-lemma left_add_mult_distrib: "i*u + (j*u + k) = (i+j)*u + (k::nat)"
-by (simp add: add_mult_distrib)
-
-
-subsubsection{*For @{text cancel_numerals}*}
-
-lemma nat_diff_add_eq1:
- "j <= (i::nat) ==> ((i*u + m) - (j*u + n)) = (((i-j)*u + m) - n)"
-by (simp split add: nat_diff_split add: add_mult_distrib)
-
-lemma nat_diff_add_eq2:
- "i <= (j::nat) ==> ((i*u + m) - (j*u + n)) = (m - ((j-i)*u + n))"
-by (simp split add: nat_diff_split add: add_mult_distrib)
-
-lemma nat_eq_add_iff1:
- "j <= (i::nat) ==> (i*u + m = j*u + n) = ((i-j)*u + m = n)"
-by (auto split add: nat_diff_split simp add: add_mult_distrib)
-
-lemma nat_eq_add_iff2:
- "i <= (j::nat) ==> (i*u + m = j*u + n) = (m = (j-i)*u + n)"
-by (auto split add: nat_diff_split simp add: add_mult_distrib)
-
-lemma nat_less_add_iff1:
- "j <= (i::nat) ==> (i*u + m < j*u + n) = ((i-j)*u + m < n)"
-by (auto split add: nat_diff_split simp add: add_mult_distrib)
-
-lemma nat_less_add_iff2:
- "i <= (j::nat) ==> (i*u + m < j*u + n) = (m < (j-i)*u + n)"
-by (auto split add: nat_diff_split simp add: add_mult_distrib)
-
-lemma nat_le_add_iff1:
- "j <= (i::nat) ==> (i*u + m <= j*u + n) = ((i-j)*u + m <= n)"
-by (auto split add: nat_diff_split simp add: add_mult_distrib)
-
-lemma nat_le_add_iff2:
- "i <= (j::nat) ==> (i*u + m <= j*u + n) = (m <= (j-i)*u + n)"
-by (auto split add: nat_diff_split simp add: add_mult_distrib)
-
-
-subsubsection{*For @{text cancel_numeral_factors} *}
-
-lemma nat_mult_le_cancel1: "(0::nat) < k ==> (k*m <= k*n) = (m<=n)"
-by auto
-
-lemma nat_mult_less_cancel1: "(0::nat) < k ==> (k*m < k*n) = (m<n)"
-by auto
-
-lemma nat_mult_eq_cancel1: "(0::nat) < k ==> (k*m = k*n) = (m=n)"
-by auto
-
-lemma nat_mult_div_cancel1: "(0::nat) < k ==> (k*m) div (k*n) = (m div n)"
-by auto
-
-
-subsubsection{*For @{text cancel_factor} *}
-
-lemma nat_mult_le_cancel_disj: "(k*m <= k*n) = ((0::nat) < k --> m<=n)"
-by auto
-
-lemma nat_mult_less_cancel_disj: "(k*m < k*n) = ((0::nat) < k & m<n)"
-by auto
-
-lemma nat_mult_eq_cancel_disj: "(k*m = k*n) = (k = (0::nat) | m=n)"
-by auto
-
-lemma nat_mult_div_cancel_disj:
- "(k*m) div (k*n) = (if k = (0::nat) then 0 else m div n)"
-by (simp add: nat_mult_div_cancel1)
-
-
-subsection {* legacy ML bindings *}
-
-ML
-{*
-val eq_nat_nat_iff = thm"eq_nat_nat_iff";
-val eq_nat_number_of = thm"eq_nat_number_of";
-val less_nat_number_of = thm"less_nat_number_of";
-val power2_eq_square = thm "power2_eq_square";
-val zero_le_power2 = thm "zero_le_power2";
-val zero_less_power2 = thm "zero_less_power2";
-val zero_eq_power2 = thm "zero_eq_power2";
-val abs_power2 = thm "abs_power2";
-val power2_abs = thm "power2_abs";
-val power2_minus = thm "power2_minus";
-val power_minus1_even = thm "power_minus1_even";
-val power_minus_even = thm "power_minus_even";
-val odd_power_less_zero = thm "odd_power_less_zero";
-val odd_0_le_power_imp_0_le = thm "odd_0_le_power_imp_0_le";
-
-val Suc_pred' = thm"Suc_pred'";
-val expand_Suc = thm"expand_Suc";
-val Suc_eq_add_numeral_1 = thm"Suc_eq_add_numeral_1";
-val Suc_eq_add_numeral_1_left = thm"Suc_eq_add_numeral_1_left";
-val add_eq_if = thm"add_eq_if";
-val mult_eq_if = thm"mult_eq_if";
-val power_eq_if = thm"power_eq_if";
-val eq_number_of_0 = thm"eq_number_of_0";
-val eq_0_number_of = thm"eq_0_number_of";
-val less_0_number_of = thm"less_0_number_of";
-val neg_imp_number_of_eq_0 = thm"neg_imp_number_of_eq_0";
-val eq_number_of_Suc = thm"eq_number_of_Suc";
-val Suc_eq_number_of = thm"Suc_eq_number_of";
-val less_number_of_Suc = thm"less_number_of_Suc";
-val less_Suc_number_of = thm"less_Suc_number_of";
-val le_number_of_Suc = thm"le_number_of_Suc";
-val le_Suc_number_of = thm"le_Suc_number_of";
-val eq_number_of_BIT_BIT = thm"eq_number_of_BIT_BIT";
-val eq_number_of_BIT_Pls = thm"eq_number_of_BIT_Pls";
-val eq_number_of_BIT_Min = thm"eq_number_of_BIT_Min";
-val eq_number_of_Pls_Min = thm"eq_number_of_Pls_Min";
-val of_nat_number_of_eq = thm"of_nat_number_of_eq";
-val nat_power_eq = thm"nat_power_eq";
-val power_nat_number_of = thm"power_nat_number_of";
-val zpower_number_of_even = thm"zpower_number_of_even";
-val zpower_number_of_odd = thm"zpower_number_of_odd";
-val nat_number_of_Pls = thm"nat_number_of_Pls";
-val nat_number_of_Min = thm"nat_number_of_Min";
-val Let_Suc = thm"Let_Suc";
-
-val nat_number = thms"nat_number";
-
-val nat_number_of_add_left = thm"nat_number_of_add_left";
-val nat_number_of_mult_left = thm"nat_number_of_mult_left";
-val left_add_mult_distrib = thm"left_add_mult_distrib";
-val nat_diff_add_eq1 = thm"nat_diff_add_eq1";
-val nat_diff_add_eq2 = thm"nat_diff_add_eq2";
-val nat_eq_add_iff1 = thm"nat_eq_add_iff1";
-val nat_eq_add_iff2 = thm"nat_eq_add_iff2";
-val nat_less_add_iff1 = thm"nat_less_add_iff1";
-val nat_less_add_iff2 = thm"nat_less_add_iff2";
-val nat_le_add_iff1 = thm"nat_le_add_iff1";
-val nat_le_add_iff2 = thm"nat_le_add_iff2";
-val nat_mult_le_cancel1 = thm"nat_mult_le_cancel1";
-val nat_mult_less_cancel1 = thm"nat_mult_less_cancel1";
-val nat_mult_eq_cancel1 = thm"nat_mult_eq_cancel1";
-val nat_mult_div_cancel1 = thm"nat_mult_div_cancel1";
-val nat_mult_le_cancel_disj = thm"nat_mult_le_cancel_disj";
-val nat_mult_less_cancel_disj = thm"nat_mult_less_cancel_disj";
-val nat_mult_eq_cancel_disj = thm"nat_mult_eq_cancel_disj";
-val nat_mult_div_cancel_disj = thm"nat_mult_div_cancel_disj";
-
-val power_minus_even = thm"power_minus_even";
-*}
-
-end
--- a/src/HOL/Integ/NatSimprocs.thy Thu May 31 18:16:51 2007 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,391 +0,0 @@
-(* Title: HOL/NatSimprocs.thy
- ID: $Id$
- Copyright 2003 TU Muenchen
-*)
-
-header {*Simprocs for the Naturals*}
-
-theory NatSimprocs
-imports NatBin
-uses "int_factor_simprocs.ML" "nat_simprocs.ML"
-begin
-
-setup nat_simprocs_setup
-
-subsection{*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)"
-by (simp add: numeral_0_eq_0 numeral_1_eq_1 split add: 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 (Numeral.pred v)::int) = (number_of v = (0::nat))"
-apply (subgoal_tac "neg (number_of (Numeral.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:
- "neg (number_of (uminus v)::int) ==>
- Suc m - (number_of v) = m - (number_of (Numeral.pred v))"
-apply (subst Suc_diff_eq_diff_pred)
-apply simp
-apply (simp del: nat_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 diff_Suc_eq_diff_pred: "m - Suc n = (m - 1) - n"
-by (simp add: numerals split add: nat_diff_split)
-
-
-subsection{*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 (Numeral.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_add_eq_if [simp]:
- "nat_case a f ((number_of v) + n) =
- (let pv = number_of (Numeral.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: nat_numeral_1_eq_1
- add: numeral_1_eq_Suc_0 [symmetric] Let_def
- neg_imp_number_of_eq_0 neg_number_of_pred_iff_0)
-done
-
-lemma nat_rec_number_of [simp]:
- "nat_rec a f (number_of v) =
- (let pv = number_of (Numeral.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_add_eq_if [simp]:
- "nat_rec a f (number_of v + n) =
- (let pv = number_of (Numeral.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: nat_numeral_1_eq_1
- add: numeral_1_eq_Suc_0 [symmetric] Let_def neg_imp_number_of_eq_0
- neg_number_of_pred_iff_0)
-done
-
-
-subsection{*Various Other Lemmas*}
-
-subsubsection{*Evens and Odds, for Mutilated Chess Board*}
-
-text{*Lemmas for specialist use, NOT as default simprules*}
-lemma nat_mult_2: "2 * z = (z+z::nat)"
-proof -
- have "2*z = (1 + 1)*z" by simp
- also have "... = z+z" by (simp add: left_distrib)
- finally show ?thesis .
-qed
-
-lemma nat_mult_2_right: "z * 2 = (z+z::nat)"
-by (subst mult_commute, rule nat_mult_2)
-
-text{*Case analysis on @{term "n<2"}*}
-lemma less_2_cases: "(n::nat) < 2 ==> n = 0 | n = Suc 0"
-by arith
-
-lemma div2_Suc_Suc [simp]: "Suc(Suc m) div 2 = Suc (m div 2)"
-by arith
-
-lemma add_self_div_2 [simp]: "(m + m) div 2 = (m::nat)"
-by (simp add: nat_mult_2 [symmetric])
-
-lemma mod2_Suc_Suc [simp]: "Suc(Suc(m)) mod 2 = m mod 2"
-apply (subgoal_tac "m mod 2 < 2")
-apply (erule less_2_cases [THEN disjE])
-apply (simp_all (no_asm_simp) add: Let_def mod_Suc nat_1)
-done
-
-lemma mod2_gr_0 [simp]: "!!m::nat. (0 < m mod 2) = (m mod 2 = 1)"
-apply (subgoal_tac "m mod 2 < 2")
-apply (force simp del: mod_less_divisor, simp)
-done
-
-subsubsection{*Removal of Small Numerals: 0, 1 and (in additive positions) 2*}
-
-lemma add_2_eq_Suc [simp]: "2 + n = Suc (Suc n)"
-by simp
-
-lemma add_2_eq_Suc' [simp]: "n + 2 = Suc (Suc n)"
-by simp
-
-text{*Can be used to eliminate long strings of Sucs, but not by default*}
-lemma Suc3_eq_add_3: "Suc (Suc (Suc n)) = 3 + n"
-by simp
-
-
-text{*These lemmas collapse some needless occurrences of Suc:
- at least three Sucs, since two and fewer are rewritten back to Suc again!
- We already have some rules to simplify operands smaller than 3.*}
-
-lemma div_Suc_eq_div_add3 [simp]: "m div (Suc (Suc (Suc n))) = m div (3+n)"
-by (simp add: Suc3_eq_add_3)
-
-lemma mod_Suc_eq_mod_add3 [simp]: "m mod (Suc (Suc (Suc n))) = m mod (3+n)"
-by (simp add: Suc3_eq_add_3)
-
-lemma Suc_div_eq_add3_div: "(Suc (Suc (Suc m))) div n = (3+m) div n"
-by (simp add: Suc3_eq_add_3)
-
-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 =
- Suc_div_eq_add3_div [of _ "number_of v", standard]
-declare Suc_div_eq_add3_div_number_of [simp]
-
-lemmas Suc_mod_eq_add3_mod_number_of =
- Suc_mod_eq_add3_mod [of _ "number_of v", standard]
-declare Suc_mod_eq_add3_mod_number_of [simp]
-
-
-
-subsection{*Special Simplification for Constants*}
-
-text{*These belong here, late in the development of HOL, to prevent their
-interfering with proofs of abstract properties of instances of the function
-@{term number_of}*}
-
-text{*These distributive laws move literals inside sums and differences.*}
-lemmas left_distrib_number_of = left_distrib [of _ _ "number_of v", standard]
-declare left_distrib_number_of [simp]
-
-lemmas right_distrib_number_of = right_distrib [of "number_of v", standard]
-declare right_distrib_number_of [simp]
-
-
-lemmas left_diff_distrib_number_of =
- left_diff_distrib [of _ _ "number_of v", standard]
-declare left_diff_distrib_number_of [simp]
-
-lemmas right_diff_distrib_number_of =
- right_diff_distrib [of "number_of v", standard]
-declare right_diff_distrib_number_of [simp]
-
-
-text{*These are actually for fields, like real: but where else to put them?*}
-lemmas zero_less_divide_iff_number_of =
- zero_less_divide_iff [of "number_of w", standard]
-declare zero_less_divide_iff_number_of [simp]
-
-lemmas divide_less_0_iff_number_of =
- divide_less_0_iff [of "number_of w", standard]
-declare divide_less_0_iff_number_of [simp]
-
-lemmas zero_le_divide_iff_number_of =
- zero_le_divide_iff [of "number_of w", standard]
-declare zero_le_divide_iff_number_of [simp]
-
-lemmas divide_le_0_iff_number_of =
- divide_le_0_iff [of "number_of w", standard]
-declare divide_le_0_iff_number_of [simp]
-
-
-(****
-IF times_divide_eq_right and times_divide_eq_left are removed as simprules,
-then these special-case declarations may be useful.
-
-text{*These simprules move numerals into numerators and denominators.*}
-lemma times_recip_eq_right [simp]: "a * (1/c) = a / (c::'a::field)"
-by (simp add: times_divide_eq)
-
-lemma times_recip_eq_left [simp]: "(1/c) * a = a / (c::'a::field)"
-by (simp add: times_divide_eq)
-
-lemmas times_divide_eq_right_number_of =
- times_divide_eq_right [of "number_of w", standard]
-declare times_divide_eq_right_number_of [simp]
-
-lemmas times_divide_eq_right_number_of =
- times_divide_eq_right [of _ _ "number_of w", standard]
-declare times_divide_eq_right_number_of [simp]
-
-lemmas times_divide_eq_left_number_of =
- times_divide_eq_left [of _ "number_of w", standard]
-declare times_divide_eq_left_number_of [simp]
-
-lemmas times_divide_eq_left_number_of =
- times_divide_eq_left [of _ _ "number_of w", standard]
-declare times_divide_eq_left_number_of [simp]
-
-****)
-
-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 =
- inverse_eq_divide [of "number_of w", standard]
-declare inverse_eq_divide_number_of [simp]
-
-
-subsubsection{*These laws simplify inequalities, moving unary minus from a term
-into the literal.*}
-lemmas less_minus_iff_number_of =
- less_minus_iff [of "number_of v", standard]
-declare less_minus_iff_number_of [simp]
-
-lemmas le_minus_iff_number_of =
- le_minus_iff [of "number_of v", standard]
-declare le_minus_iff_number_of [simp]
-
-lemmas equation_minus_iff_number_of =
- equation_minus_iff [of "number_of v", standard]
-declare equation_minus_iff_number_of [simp]
-
-
-lemmas minus_less_iff_number_of =
- minus_less_iff [of _ "number_of v", standard]
-declare minus_less_iff_number_of [simp]
-
-lemmas minus_le_iff_number_of =
- minus_le_iff [of _ "number_of v", standard]
-declare minus_le_iff_number_of [simp]
-
-lemmas minus_equation_iff_number_of =
- minus_equation_iff [of _ "number_of v", standard]
-declare minus_equation_iff_number_of [simp]
-
-
-subsubsection{*To Simplify Inequalities Where One Side is the Constant 1*}
-
-lemma less_minus_iff_1 [simp]:
- fixes b::"'b::{ordered_idom,number_ring}"
- shows "(1 < - b) = (b < -1)"
-by auto
-
-lemma le_minus_iff_1 [simp]:
- fixes b::"'b::{ordered_idom,number_ring}"
- shows "(1 \<le> - b) = (b \<le> -1)"
-by auto
-
-lemma equation_minus_iff_1 [simp]:
- fixes b::"'b::number_ring"
- shows "(1 = - b) = (b = -1)"
-by (subst equation_minus_iff, auto)
-
-lemma minus_less_iff_1 [simp]:
- fixes a::"'b::{ordered_idom,number_ring}"
- shows "(- a < 1) = (-1 < a)"
-by auto
-
-lemma minus_le_iff_1 [simp]:
- fixes a::"'b::{ordered_idom,number_ring}"
- shows "(- a \<le> 1) = (-1 \<le> a)"
-by auto
-
-lemma minus_equation_iff_1 [simp]:
- fixes a::"'b::number_ring"
- shows "(- a = 1) = (a = -1)"
-by (subst minus_equation_iff, auto)
-
-
-subsubsection {*Cancellation of constant factors in comparisons (@{text "<"} and @{text "\<le>"}) *}
-
-lemmas mult_less_cancel_left_number_of =
- mult_less_cancel_left [of "number_of v", standard]
-declare mult_less_cancel_left_number_of [simp]
-
-lemmas mult_less_cancel_right_number_of =
- mult_less_cancel_right [of _ "number_of v", standard]
-declare mult_less_cancel_right_number_of [simp]
-
-lemmas mult_le_cancel_left_number_of =
- mult_le_cancel_left [of "number_of v", standard]
-declare mult_le_cancel_left_number_of [simp]
-
-lemmas mult_le_cancel_right_number_of =
- mult_le_cancel_right [of _ "number_of v", standard]
-declare mult_le_cancel_right_number_of [simp]
-
-
-subsubsection {*Multiplying out constant divisors in comparisons (@{text "<"}, @{text "\<le>"} and @{text "="}) *}
-
-lemmas le_divide_eq_number_of = le_divide_eq [of _ _ "number_of w", standard]
-declare le_divide_eq_number_of [simp]
-
-lemmas divide_le_eq_number_of = divide_le_eq [of _ "number_of w", standard]
-declare divide_le_eq_number_of [simp]
-
-lemmas less_divide_eq_number_of = less_divide_eq [of _ _ "number_of w", standard]
-declare less_divide_eq_number_of [simp]
-
-lemmas divide_less_eq_number_of = divide_less_eq [of _ "number_of w", standard]
-declare divide_less_eq_number_of [simp]
-
-lemmas eq_divide_eq_number_of = eq_divide_eq [of _ _ "number_of w", standard]
-declare eq_divide_eq_number_of [simp]
-
-lemmas divide_eq_eq_number_of = divide_eq_eq [of _ "number_of w", standard]
-declare divide_eq_eq_number_of [simp]
-
-
-
-subsection{*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", standard]
-lemmas divide_le_eq_number_of = divide_le_eq [of _ _ "number_of w", standard]
-lemmas less_divide_eq_number_of = less_divide_eq [of "number_of w", standard]
-lemmas divide_less_eq_number_of = divide_less_eq [of _ _ "number_of w", standard]
-lemmas eq_divide_eq_number_of = eq_divide_eq [of "number_of w", standard]
-lemmas divide_eq_eq_number_of = divide_eq_eq [of _ _ "number_of w", standard]
-
-
-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_1 divide_le_eq_1 less_divide_eq_1 divide_less_eq_1
-
-subsubsection{*Division By @{text "-1"}*}
-
-lemma divide_minus1 [simp]:
- "x/-1 = -(x::'a::{field,division_by_zero,number_ring})"
-by simp
-
-lemma minus1_divide [simp]:
- "-1 / (x::'a::{field,division_by_zero,number_ring}) = - (1/x)"
-by (simp add: divide_inverse inverse_minus_eq)
-
-lemma half_gt_zero_iff:
- "(0 < r/2) = (0 < (r::'a::{ordered_field,division_by_zero,number_ring}))"
-by auto
-
-lemmas half_gt_zero = half_gt_zero_iff [THEN iffD2, standard]
-declare half_gt_zero [simp]
-
-(* The following lemma should appear in Divides.thy, but there the proof
- doesn't work. *)
-
-lemma nat_dvd_not_less:
- "[| 0 < m; m < n |] ==> \<not> n dvd (m::nat)"
- by (unfold dvd_def) auto
-
-ML {*
-val divide_minus1 = @{thm divide_minus1};
-val minus1_divide = @{thm minus1_divide};
-*}
-
-end
--- a/src/HOL/Integ/Numeral.thy Thu May 31 18:16:51 2007 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,685 +0,0 @@
-(* Title: HOL/Integ/Numeral.thy
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1994 University of Cambridge
-*)
-
-header {* Arithmetic on Binary Integers *}
-
-theory Numeral
-imports IntDef
-uses ("../Tools/numeral_syntax.ML")
-begin
-
-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/Integ/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"}.
-*}
-
-datatype bit = B0 | B1
-
-text{*
- Type @{typ bit} avoids the use of type @{typ bool}, which would make
- all of the rewrite rules higher-order.
-*}
-
-definition
- Pls :: int where
- [code func del]:"Pls = 0"
-
-definition
- Min :: int where
- [code func del]:"Min = - 1"
-
-definition
- Bit :: "int \<Rightarrow> bit \<Rightarrow> int" (infixl "BIT" 90) where
- [code func del]: "k BIT b = (case b of B0 \<Rightarrow> 0 | B1 \<Rightarrow> 1) + k + k"
-
-class number = type + -- {* for numeric types: nat, int, real, \dots *}
- fixes number_of :: "int \<Rightarrow> 'a"
-
-syntax
- "_Numeral" :: "num_const \<Rightarrow> 'a" ("_")
-
-use "../Tools/numeral_syntax.ML"
-setup NumeralSyntax.setup
-
-abbreviation
- "Numeral0 \<equiv> number_of Pls"
-
-abbreviation
- "Numeral1 \<equiv> number_of (Pls BIT B1)"
-
-lemma Let_number_of [simp]: "Let (number_of v) f = f (number_of v)"
- -- {* Unfold all @{text let}s involving constants *}
- unfolding Let_def ..
-
-lemma Let_0 [simp]: "Let 0 f = f 0"
- unfolding Let_def ..
-
-lemma Let_1 [simp]: "Let 1 f = f 1"
- unfolding Let_def ..
-
-definition
- succ :: "int \<Rightarrow> int" where
- [code func del]: "succ k = k + 1"
-
-definition
- pred :: "int \<Rightarrow> int" where
- [code func del]: "pred k = k - 1"
-
-lemmas
- max_number_of [simp] = max_def
- [of "number_of u" "number_of v", standard, simp]
-and
- min_number_of [simp] = min_def
- [of "number_of u" "number_of v", standard, simp]
- -- {* unfolding @{text minx} and @{text max} on numerals *}
-
-lemmas numeral_simps =
- succ_def pred_def Pls_def Min_def Bit_def
-
-text {* Removal of leading zeroes *}
-
-lemma Pls_0_eq [simp, normal post]:
- "Pls BIT B0 = Pls"
- unfolding numeral_simps by simp
-
-lemma Min_1_eq [simp, normal post]:
- "Min BIT B1 = Min"
- unfolding numeral_simps by simp
-
-
-subsection {* The Functions @{term succ}, @{term pred} and @{term uminus} *}
-
-lemma succ_Pls [simp]:
- "succ Pls = Pls BIT B1"
- unfolding numeral_simps by simp
-
-lemma succ_Min [simp]:
- "succ Min = Pls"
- unfolding numeral_simps by simp
-
-lemma succ_1 [simp]:
- "succ (k BIT B1) = succ k BIT B0"
- unfolding numeral_simps by simp
-
-lemma succ_0 [simp]:
- "succ (k BIT B0) = k BIT B1"
- unfolding numeral_simps by simp
-
-lemma pred_Pls [simp]:
- "pred Pls = Min"
- unfolding numeral_simps by simp
-
-lemma pred_Min [simp]:
- "pred Min = Min BIT B0"
- unfolding numeral_simps by simp
-
-lemma pred_1 [simp]:
- "pred (k BIT B1) = k BIT B0"
- unfolding numeral_simps by simp
-
-lemma pred_0 [simp]:
- "pred (k BIT B0) = pred k BIT B1"
- unfolding numeral_simps by simp
-
-lemma minus_Pls [simp]:
- "- Pls = Pls"
- unfolding numeral_simps by simp
-
-lemma minus_Min [simp]:
- "- Min = Pls BIT B1"
- unfolding numeral_simps by simp
-
-lemma minus_1 [simp]:
- "- (k BIT B1) = pred (- k) BIT B1"
- unfolding numeral_simps by simp
-
-lemma minus_0 [simp]:
- "- (k BIT B0) = (- k) BIT B0"
- unfolding numeral_simps by simp
-
-
-subsection {*
- Binary Addition and Multiplication: @{term "op + \<Colon> int \<Rightarrow> int \<Rightarrow> int"}
- and @{term "op * \<Colon> int \<Rightarrow> int \<Rightarrow> int"}
-*}
-
-lemma add_Pls [simp]:
- "Pls + k = k"
- unfolding numeral_simps by simp
-
-lemma add_Min [simp]:
- "Min + k = pred k"
- unfolding numeral_simps by simp
-
-lemma add_BIT_11 [simp]:
- "(k BIT B1) + (l BIT B1) = (k + succ l) BIT B0"
- unfolding numeral_simps by simp
-
-lemma add_BIT_10 [simp]:
- "(k BIT B1) + (l BIT B0) = (k + l) BIT B1"
- unfolding numeral_simps by simp
-
-lemma add_BIT_0 [simp]:
- "(k BIT B0) + (l BIT b) = (k + l) BIT b"
- unfolding numeral_simps by simp
-
-lemma add_Pls_right [simp]:
- "k + Pls = k"
- unfolding numeral_simps by simp
-
-lemma add_Min_right [simp]:
- "k + Min = pred k"
- unfolding numeral_simps by simp
-
-lemma mult_Pls [simp]:
- "Pls * w = Pls"
- unfolding numeral_simps by simp
-
-lemma mult_Min [simp]:
- "Min * k = - k"
- unfolding numeral_simps by simp
-
-lemma mult_num1 [simp]:
- "(k BIT B1) * l = ((k * l) BIT B0) + l"
- unfolding numeral_simps int_distrib by simp
-
-lemma mult_num0 [simp]:
- "(k BIT B0) * l = (k * l) BIT B0"
- unfolding numeral_simps int_distrib by simp
-
-
-
-subsection {* Converting Numerals to Rings: @{term number_of} *}
-
-axclass number_ring \<subseteq> number, comm_ring_1
- number_of_eq: "number_of k = of_int k"
-
-text {* self-embedding of the intergers *}
-
-instance int :: number_ring
- int_number_of_def: "number_of w \<equiv> of_int w"
- by intro_classes (simp only: int_number_of_def)
-
-lemmas [code func del] = int_number_of_def
-
-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 numeral_simps by simp
-
-lemma number_of_add:
- "number_of (v + w) = (number_of v + number_of w::'a::number_ring)"
- unfolding number_of_eq numeral_simps by simp
-
-lemma number_of_mult:
- "number_of (v * w) = (number_of v * number_of w::'a::number_ring)"
- unfolding number_of_eq numeral_simps by simp
-
-text {*
- The correctness of shifting.
- But it doesn't seem to give a measurable speed-up.
-*}
-
-lemma double_number_of_BIT:
- "(1 + 1) * number_of w = (number_of (w BIT B0) ::'a::number_ring)"
- unfolding number_of_eq numeral_simps left_distrib by simp
-
-text {*
- Converting numerals 0 and 1 to their abstract versions.
-*}
-
-lemma numeral_0_eq_0 [simp]:
- "Numeral0 = (0::'a::number_ring)"
- unfolding number_of_eq numeral_simps by simp
-
-lemma numeral_1_eq_1 [simp]:
- "Numeral1 = (1::'a::number_ring)"
- unfolding number_of_eq numeral_simps by simp
-
-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_BIT:
- "number_of(w BIT x) = (case x of B0 => 0 | B1 => (1::'a::number_ring))
- + (number_of w) + (number_of w)"
- unfolding number_of_eq numeral_simps by (simp split: bit.split)
-
-
-subsection {* Equality of Binary Numbers *}
-
-text {* First version by Norbert Voelker *}
-
-lemma eq_number_of_eq:
- "((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: compare_rls)
-
-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
-
-
-subsection {* Comparisons, for Ordered Rings *}
-
-lemma double_eq_0_iff:
- "(a + a = 0) = (a = (0::'a::ordered_idom))"
-proof -
- have "a + a = (1 + 1) * a" unfolding left_distrib by simp
- with zero_less_two [where 'a = 'a]
- show ?thesis by force
-qed
-
-lemma le_imp_0_less:
- assumes le: "0 \<le> z"
- shows "(0::int) < 1 + z"
-proof -
- have "0 \<le> z" .
- also have "... < z + 1" by (rule less_add_one)
- also have "... = 1 + z" by (simp add: add_ac)
- finally show "0 < 1 + z" .
-qed
-
-lemma odd_nonzero:
- "1 + z + z \<noteq> (0::int)";
-proof (cases z rule: int_cases)
- case (nonneg n)
- have le: "0 \<le> z+z" by (simp add: nonneg add_increasing)
- thus ?thesis using le_imp_0_less [OF le]
- by (auto simp add: add_assoc)
-next
- case (neg n)
- show ?thesis
- proof
- assume eq: "1 + z + z = 0"
- have "0 < 1 + (int n + int n)"
- by (simp add: le_imp_0_less add_increasing)
- also have "... = - (1 + z + z)"
- by (simp add: neg add_assoc [symmetric])
- also have "... = 0" by (simp add: eq)
- finally have "0<0" ..
- thus False by blast
- qed
-qed
-
-text {* The premise involving @{term Ints} prevents @{term "a = 1/2"}. *}
-
-lemma Ints_double_eq_0_iff:
- assumes in_Ints: "a \<in> Ints"
- shows "(a + a = 0) = (a = (0::'a::ring_char_0))"
-proof -
- from in_Ints have "a \<in> range of_int" unfolding Ints_def [symmetric] .
- then obtain z where a: "a = of_int z" ..
- show ?thesis
- proof
- assume "a = 0"
- thus "a + a = 0" by simp
- next
- assume eq: "a + a = 0"
- hence "of_int (z + z) = (of_int 0 :: 'a)" by (simp add: a)
- hence "z + z = 0" by (simp only: of_int_eq_iff)
- hence "z = 0" by (simp only: double_eq_0_iff)
- thus "a = 0" by (simp add: a)
- qed
-qed
-
-lemma Ints_odd_nonzero:
- assumes in_Ints: "a \<in> Ints"
- shows "1 + a + a \<noteq> (0::'a::ring_char_0)"
-proof -
- from in_Ints have "a \<in> range of_int" unfolding Ints_def [symmetric] .
- then obtain z where a: "a = of_int z" ..
- show ?thesis
- proof
- assume eq: "1 + a + a = 0"
- hence "of_int (1 + z + z) = (of_int 0 :: 'a)" by (simp add: a)
- hence "1 + z + z = 0" by (simp only: of_int_eq_iff)
- with odd_nonzero show False by blast
- qed
-qed
-
-lemma Ints_number_of:
- "(number_of w :: 'a::number_ring) \<in> Ints"
- unfolding number_of_eq Ints_def by simp
-
-lemma iszero_number_of_BIT:
- "iszero (number_of (w BIT x)::'a) =
- (x = B0 \<and> iszero (number_of w::'a::{ring_char_0,number_ring}))"
- by (simp add: iszero_def number_of_eq numeral_simps Ints_double_eq_0_iff
- Ints_odd_nonzero Ints_def split: bit.split)
-
-lemma iszero_number_of_0:
- "iszero (number_of (w BIT B0) :: 'a::{ring_char_0,number_ring}) =
- iszero (number_of w :: 'a)"
- by (simp only: iszero_number_of_BIT simp_thms)
-
-lemma iszero_number_of_1:
- "~ iszero (number_of (w BIT B1)::'a::{ring_char_0,number_ring})"
- by (simp add: iszero_number_of_BIT)
-
-
-subsection {* The Less-Than Relation *}
-
-lemma less_number_of_eq_neg:
- "((number_of x::'a::{ordered_idom,number_ring}) < number_of y)
- = neg (number_of (x + uminus y) :: 'a)"
-apply (subst less_iff_diff_less_0)
-apply (simp add: neg_def diff_minus number_of_add number_of_minus)
-done
-
-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 Pls ::'a::{ordered_idom,number_ring})"
- by (simp add: neg_def numeral_0_eq_0)
-
-lemma neg_number_of_Min:
- "neg (number_of Min ::'a::{ordered_idom,number_ring})"
- by (simp add: neg_def zero_less_one numeral_m1_eq_minus_1)
-
-lemma double_less_0_iff:
- "(a + a < 0) = (a < (0::'a::ordered_idom))"
-proof -
- have "(a + a < 0) = ((1+1)*a < 0)" by (simp add: left_distrib)
- also have "... = (a < 0)"
- by (simp add: mult_less_0_iff zero_less_two
- order_less_not_sym [OF zero_less_two])
- finally show ?thesis .
-qed
-
-lemma odd_less_0:
- "(1 + z + z < 0) = (z < (0::int))";
-proof (cases z rule: int_cases)
- case (nonneg n)
- thus ?thesis by (simp add: linorder_not_less add_assoc add_increasing
- le_imp_0_less [THEN order_less_imp_le])
-next
- case (neg n)
- thus ?thesis by (simp del: int_Suc
- add: int_Suc0_eq_1 [symmetric] zadd_int compare_rls)
-qed
-
-text {* The premise involving @{term Ints} prevents @{term "a = 1/2"}. *}
-
-lemma Ints_odd_less_0:
- assumes in_Ints: "a \<in> Ints"
- shows "(1 + a + a < 0) = (a < (0::'a::ordered_idom))";
-proof -
- from in_Ints have "a \<in> range of_int" unfolding Ints_def [symmetric] .
- then obtain z where a: "a = of_int z" ..
- hence "((1::'a) + a + a < 0) = (of_int (1 + z + z) < (of_int 0 :: 'a))"
- by (simp add: a)
- also have "... = (z < 0)" by (simp only: of_int_less_iff odd_less_0)
- also have "... = (a < 0)" by (simp add: a)
- finally show ?thesis .
-qed
-
-lemma neg_number_of_BIT:
- "neg (number_of (w BIT x)::'a) =
- neg (number_of w :: 'a::{ordered_idom,number_ring})"
- by (simp add: neg_def number_of_eq numeral_simps double_less_0_iff
- Ints_odd_less_0 Ints_def split: bit.split)
-
-
-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,
- standard]
-
-lemma le_number_of_eq:
- "((number_of x::'a::{ordered_idom,number_ring}) \<le> number_of y)
- = (~ (neg (number_of (y + uminus x) :: 'a)))"
-by (simp add: le_number_of_eq_not_less less_number_of_eq_neg)
-
-
-text {* Absolute value (@{term abs}) *}
-
-lemma abs_number_of:
- "abs(number_of x::'a::{ordered_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
-
-
-subsection {* Simplification of arithmetic operations on integer constants. *}
-
-lemmas arith_extra_simps [standard, 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 =
- bit.distinct
- Pls_0_eq Min_1_eq
- pred_Pls pred_Min pred_1 pred_0
- succ_Pls succ_Min succ_1 succ_0
- add_Pls add_Min add_BIT_0 add_BIT_10 add_BIT_11
- minus_Pls minus_Min minus_1 minus_0
- mult_Pls mult_Min mult_num1 mult_num0
- add_Pls_right add_Min_right
- abs_zero abs_one arith_extra_simps
-
-text {* Simplification of relational operations *}
-
-lemmas rel_simps [simp] =
- eq_number_of_eq iszero_number_of_Pls nonzero_number_of_Min
- iszero_number_of_0 iszero_number_of_1
- less_number_of_eq_neg
- not_neg_number_of_Pls not_neg_0 not_neg_1 not_iszero_1
- neg_number_of_Min neg_number_of_BIT
- le_number_of_eq
-
-
-subsection {* 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 add_number_of_left)
-
-lemma add_number_of_diff2 [simp]:
- "number_of v + (c - number_of w) =
- number_of (v + uminus w) + (c::'a::number_ring)"
-apply (subst diff_number_of_eq [symmetric])
-apply (simp only: compare_rls)
-done
-
-
-subsection {* Configuration of the code generator *}
-
-instance int :: eq ..
-
-code_datatype Pls Min Bit "number_of \<Colon> int \<Rightarrow> int"
-
-definition
- int_aux :: "int \<Rightarrow> nat \<Rightarrow> int" where
- "int_aux i n = (i + int n)"
-
-lemma [code]:
- "int_aux i 0 = i"
- "int_aux i (Suc n) = int_aux (i + 1) n" -- {* tail recursive *}
- by (simp add: int_aux_def)+
-
-lemma [code]:
- "int n = int_aux 0 n"
- by (simp add: int_aux_def)
-
-definition
- nat_aux :: "nat \<Rightarrow> int \<Rightarrow> nat" where
- "nat_aux n i = (n + nat i)"
-
-lemma [code]: "nat_aux n i = (if i <= 0 then n else nat_aux (Suc n) (i - 1))"
- -- {* 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 [code]: "nat i = nat_aux 0 i"
- by (simp add: nat_aux_def)
-
-lemma zero_is_num_zero [code func, code inline, symmetric, normal post]:
- "(0\<Colon>int) = number_of Numeral.Pls"
- by simp
-
-lemma one_is_num_one [code func, code inline, symmetric, normal post]:
- "(1\<Colon>int) = number_of (Numeral.Pls BIT bit.B1)"
- by simp
-
-code_modulename SML
- IntDef Integer
-
-code_modulename OCaml
- IntDef Integer
-
-code_modulename Haskell
- IntDef Integer
-
-code_modulename SML
- Numeral Integer
-
-code_modulename OCaml
- Numeral Integer
-
-code_modulename Haskell
- Numeral Integer
-
-(*FIXME: the IntInf.fromInt below hides a dependence on fixed-precision ints!*)
-
-types_code
- "int" ("int")
-attach (term_of) {*
-val term_of_int = HOLogic.mk_number HOLogic.intT o IntInf.fromInt;
-*}
-attach (test) {*
-fun gen_int i = one_of [~1, 1] * random_range 0 i;
-*}
-
-setup {*
-let
-
-fun number_of_codegen thy defs gr dep module b (Const (@{const_name Numeral.number_of}, Type ("fun", [_, T])) $ t) =
- if T = HOLogic.intT then
- (SOME (fst (Codegen.invoke_tycodegen thy defs dep module false (gr, T)),
- (Pretty.str o IntInf.toString o HOLogic.dest_numeral) t) handle TERM _ => NONE)
- else if T = HOLogic.natT then
- SOME (Codegen.invoke_codegen thy defs dep module b (gr,
- Const ("IntDef.nat", HOLogic.intT --> HOLogic.natT) $
- (Const (@{const_name Numeral.number_of}, HOLogic.intT --> HOLogic.intT) $ t)))
- else NONE
- | number_of_codegen _ _ _ _ _ _ _ = NONE;
-
-in
-
-Codegen.add_codegen "number_of_codegen" number_of_codegen
-
-end
-*}
-
-consts_code
- "0 :: int" ("0")
- "1 :: int" ("1")
- "uminus :: int => int" ("~")
- "op + :: int => int => int" ("(_ +/ _)")
- "op * :: int => int => int" ("(_ */ _)")
- "op \<le> :: int => int => bool" ("(_ <=/ _)")
- "op < :: int => int => bool" ("(_ </ _)")
-
-quickcheck_params [default_type = int]
-
-(*setup continues in theory Presburger*)
-
-hide (open) const Pls Min B0 B1 succ pred
-
-end
--- a/src/HOL/Integ/int_arith1.ML Thu May 31 18:16:51 2007 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,610 +0,0 @@
-(* Title: HOL/Integ/int_arith1.ML
- ID: $Id$
- Authors: Larry Paulson and Tobias Nipkow
-
-Simprocs and decision procedure for linear arithmetic.
-*)
-
-(** Misc ML bindings **)
-
-val succ_Pls = thm "succ_Pls";
-val succ_Min = thm "succ_Min";
-val succ_1 = thm "succ_1";
-val succ_0 = thm "succ_0";
-
-val pred_Pls = thm "pred_Pls";
-val pred_Min = thm "pred_Min";
-val pred_1 = thm "pred_1";
-val pred_0 = thm "pred_0";
-
-val minus_Pls = thm "minus_Pls";
-val minus_Min = thm "minus_Min";
-val minus_1 = thm "minus_1";
-val minus_0 = thm "minus_0";
-
-val add_Pls = thm "add_Pls";
-val add_Min = thm "add_Min";
-val add_BIT_11 = thm "add_BIT_11";
-val add_BIT_10 = thm "add_BIT_10";
-val add_BIT_0 = thm "add_BIT_0";
-val add_Pls_right = thm "add_Pls_right";
-val add_Min_right = thm "add_Min_right";
-
-val mult_Pls = thm "mult_Pls";
-val mult_Min = thm "mult_Min";
-val mult_num1 = thm "mult_num1";
-val mult_num0 = thm "mult_num0";
-
-val neg_def = thm "neg_def";
-val iszero_def = thm "iszero_def";
-
-val number_of_succ = thm "number_of_succ";
-val number_of_pred = thm "number_of_pred";
-val number_of_minus = thm "number_of_minus";
-val number_of_add = thm "number_of_add";
-val diff_number_of_eq = thm "diff_number_of_eq";
-val number_of_mult = thm "number_of_mult";
-val double_number_of_BIT = thm "double_number_of_BIT";
-val numeral_0_eq_0 = thm "numeral_0_eq_0";
-val numeral_1_eq_1 = thm "numeral_1_eq_1";
-val numeral_m1_eq_minus_1 = thm "numeral_m1_eq_minus_1";
-val mult_minus1 = thm "mult_minus1";
-val mult_minus1_right = thm "mult_minus1_right";
-val minus_number_of_mult = thm "minus_number_of_mult";
-val zero_less_nat_eq = thm "zero_less_nat_eq";
-val eq_number_of_eq = thm "eq_number_of_eq";
-val iszero_number_of_Pls = thm "iszero_number_of_Pls";
-val nonzero_number_of_Min = thm "nonzero_number_of_Min";
-val iszero_number_of_BIT = thm "iszero_number_of_BIT";
-val iszero_number_of_0 = thm "iszero_number_of_0";
-val iszero_number_of_1 = thm "iszero_number_of_1";
-val less_number_of_eq_neg = thm "less_number_of_eq_neg";
-val le_number_of_eq = thm "le_number_of_eq";
-val not_neg_number_of_Pls = thm "not_neg_number_of_Pls";
-val neg_number_of_Min = thm "neg_number_of_Min";
-val neg_number_of_BIT = thm "neg_number_of_BIT";
-val le_number_of_eq_not_less = thm "le_number_of_eq_not_less";
-val abs_number_of = thm "abs_number_of";
-val number_of_reorient = thm "number_of_reorient";
-val add_number_of_left = thm "add_number_of_left";
-val mult_number_of_left = thm "mult_number_of_left";
-val add_number_of_diff1 = thm "add_number_of_diff1";
-val add_number_of_diff2 = thm "add_number_of_diff2";
-val less_iff_diff_less_0 = thm "less_iff_diff_less_0";
-val eq_iff_diff_eq_0 = thm "eq_iff_diff_eq_0";
-val le_iff_diff_le_0 = thm "le_iff_diff_le_0";
-
-val arith_extra_simps = thms "arith_extra_simps";
-val arith_simps = thms "arith_simps";
-val rel_simps = thms "rel_simps";
-
-val zless_imp_add1_zle = thm "zless_imp_add1_zle";
-
-val combine_common_factor = thm "combine_common_factor";
-val eq_add_iff1 = thm "eq_add_iff1";
-val eq_add_iff2 = thm "eq_add_iff2";
-val less_add_iff1 = thm "less_add_iff1";
-val less_add_iff2 = thm "less_add_iff2";
-val le_add_iff1 = thm "le_add_iff1";
-val le_add_iff2 = thm "le_add_iff2";
-
-val arith_special = thms "arith_special";
-
-structure Int_Numeral_Base_Simprocs =
- struct
- fun prove_conv tacs ctxt (_: thm list) (t, u) =
- if t aconv u then NONE
- else
- let val eq = HOLogic.mk_Trueprop (HOLogic.mk_eq (t, u))
- in SOME (Goal.prove ctxt [] [] eq (K (EVERY tacs))) end
-
- fun prove_conv_nohyps tacs sg = prove_conv tacs sg [];
-
- fun prep_simproc (name, pats, proc) =
- Simplifier.simproc (the_context()) name pats proc;
-
- fun is_numeral (Const(@{const_name Numeral.number_of}, _) $ w) = true
- | is_numeral _ = false
-
- fun simplify_meta_eq f_number_of_eq f_eq =
- mk_meta_eq ([f_eq, f_number_of_eq] MRS trans)
-
- (*reorientation simprules using ==, for the following simproc*)
- val meta_zero_reorient = zero_reorient RS eq_reflection
- val meta_one_reorient = one_reorient RS eq_reflection
- val meta_number_of_reorient = number_of_reorient RS eq_reflection
-
- (*reorientation simplification procedure: reorients (polymorphic)
- 0 = x, 1 = x, nnn = x provided x isn't 0, 1 or a numeral.*)
- fun reorient_proc sg _ (_ $ t $ u) =
- case u of
- Const(@{const_name HOL.zero}, _) => NONE
- | Const(@{const_name HOL.one}, _) => NONE
- | Const(@{const_name Numeral.number_of}, _) $ _ => NONE
- | _ => SOME (case t of
- Const(@{const_name HOL.zero}, _) => meta_zero_reorient
- | Const(@{const_name HOL.one}, _) => meta_one_reorient
- | Const(@{const_name Numeral.number_of}, _) $ _ => meta_number_of_reorient)
-
- val reorient_simproc =
- prep_simproc ("reorient_simproc", ["0=x", "1=x", "number_of w = x"], reorient_proc)
-
- end;
-
-
-Addsimprocs [Int_Numeral_Base_Simprocs.reorient_simproc];
-
-
-structure Int_Numeral_Simprocs =
-struct
-
-(*Maps 0 to Numeral0 and 1 to Numeral1 so that arithmetic in Int_Numeral_Base_Simprocs
- isn't complicated by the abstract 0 and 1.*)
-val numeral_syms = [numeral_0_eq_0 RS sym, numeral_1_eq_1 RS sym];
-
-(** New term ordering so that AC-rewriting brings numerals to the front **)
-
-(*Order integers by absolute value and then by sign. The standard integer
- ordering is not well-founded.*)
-fun num_ord (i,j) =
- (case IntInf.compare (IntInf.abs i, IntInf.abs j) of
- EQUAL => int_ord (IntInf.sign i, IntInf.sign j)
- | ord => ord);
-
-(*This resembles Term.term_ord, but it puts binary numerals before other
- non-atomic terms.*)
-local open Term
-in
-fun numterm_ord (Abs (_, T, t), Abs(_, U, u)) =
- (case numterm_ord (t, u) of EQUAL => typ_ord (T, U) | ord => ord)
- | numterm_ord
- (Const(@{const_name Numeral.number_of}, _) $ v, Const(@{const_name Numeral.number_of}, _) $ w) =
- num_ord (HOLogic.dest_numeral v, HOLogic.dest_numeral w)
- | numterm_ord (Const(@{const_name Numeral.number_of}, _) $ _, _) = LESS
- | numterm_ord (_, Const(@{const_name Numeral.number_of}, _) $ _) = GREATER
- | numterm_ord (t, u) =
- (case int_ord (size_of_term t, size_of_term u) of
- EQUAL =>
- let val (f, ts) = strip_comb t and (g, us) = strip_comb u in
- (case hd_ord (f, g) of EQUAL => numterms_ord (ts, us) | ord => ord)
- end
- | ord => ord)
-and numterms_ord (ts, us) = list_ord numterm_ord (ts, us)
-end;
-
-fun numtermless tu = (numterm_ord tu = LESS);
-
-(*Defined in this file, but perhaps needed only for Int_Numeral_Base_Simprocs of type nat.*)
-val num_ss = HOL_ss settermless numtermless;
-
-
-(** Utilities **)
-
-fun mk_number T n = HOLogic.number_of_const T $ HOLogic.mk_numeral n;
-
-fun find_first_numeral past (t::terms) =
- ((snd (HOLogic.dest_number t), rev past @ terms)
- handle TERM _ => find_first_numeral (t::past) terms)
- | find_first_numeral past [] = raise TERM("find_first_numeral", []);
-
-val mk_plus = HOLogic.mk_binop @{const_name HOL.plus};
-
-fun mk_minus t =
- let val T = Term.fastype_of t
- in Const (@{const_name HOL.uminus}, T --> T) $ t
- end;
-
-(*Thus mk_sum[t] yields t+0; longer sums don't have a trailing zero*)
-fun mk_sum T [] = mk_number T 0
- | mk_sum T [t,u] = mk_plus (t, u)
- | mk_sum T (t :: ts) = mk_plus (t, mk_sum T ts);
-
-(*this version ALWAYS includes a trailing zero*)
-fun long_mk_sum T [] = mk_number T 0
- | long_mk_sum T (t :: ts) = mk_plus (t, mk_sum T ts);
-
-val dest_plus = HOLogic.dest_bin @{const_name HOL.plus} Term.dummyT;
-
-(*decompose additions AND subtractions as a sum*)
-fun dest_summing (pos, Const (@{const_name HOL.plus}, _) $ t $ u, ts) =
- dest_summing (pos, t, dest_summing (pos, u, ts))
- | dest_summing (pos, Const (@{const_name HOL.minus}, _) $ t $ u, ts) =
- dest_summing (pos, t, dest_summing (not pos, u, ts))
- | dest_summing (pos, t, ts) =
- if pos then t::ts else mk_minus t :: ts;
-
-fun dest_sum t = dest_summing (true, t, []);
-
-val mk_diff = HOLogic.mk_binop @{const_name HOL.minus};
-val dest_diff = HOLogic.dest_bin @{const_name HOL.minus} Term.dummyT;
-
-val mk_times = HOLogic.mk_binop @{const_name HOL.times};
-
-fun mk_prod T =
- let val one = mk_number T 1
- fun mk [] = one
- | mk [t] = t
- | mk (t :: ts) = if t = one then mk ts else mk_times (t, mk ts)
- in mk end;
-
-(*This version ALWAYS includes a trailing one*)
-fun long_mk_prod T [] = mk_number T 1
- | long_mk_prod T (t :: ts) = mk_times (t, mk_prod T ts);
-
-val dest_times = HOLogic.dest_bin @{const_name HOL.times} Term.dummyT;
-
-fun dest_prod t =
- let val (t,u) = dest_times t
- in dest_prod t @ dest_prod u end
- handle TERM _ => [t];
-
-(*DON'T do the obvious simplifications; that would create special cases*)
-fun mk_coeff (k, t) = mk_times (mk_number (Term.fastype_of t) k, t);
-
-(*Express t as a product of (possibly) a numeral with other sorted terms*)
-fun dest_coeff sign (Const (@{const_name HOL.uminus}, _) $ t) = dest_coeff (~sign) t
- | dest_coeff sign t =
- let val ts = sort Term.term_ord (dest_prod t)
- val (n, ts') = find_first_numeral [] ts
- handle TERM _ => (1, ts)
- in (sign*n, mk_prod (Term.fastype_of t) ts') end;
-
-(*Find first coefficient-term THAT MATCHES u*)
-fun find_first_coeff past u [] = raise TERM("find_first_coeff", [])
- | find_first_coeff past u (t::terms) =
- let val (n,u') = dest_coeff 1 t
- in if u aconv u' then (n, rev past @ terms)
- else find_first_coeff (t::past) u terms
- end
- handle TERM _ => find_first_coeff (t::past) u terms;
-
-(*Fractions as pairs of ints. Can't use Rat.rat because the representation
- needs to preserve negative values in the denominator.*)
-fun mk_frac (p, q : IntInf.int) = if q = 0 then raise Div else (p, q);
-
-(*Don't reduce fractions; sums must be proved by rule add_frac_eq.
- Fractions are reduced later by the cancel_numeral_factor simproc.*)
-fun add_frac ((p1 : IntInf.int, q1 : IntInf.int), (p2, q2)) = (p1 * q2 + p2 * q1, q1 * q2);
-
-val mk_divide = HOLogic.mk_binop @{const_name HOL.divide};
-
-(*Build term (p / q) * t*)
-fun mk_fcoeff ((p, q), t) =
- let val T = Term.fastype_of t
- in mk_times (mk_divide (mk_number T p, mk_number T q), t) end;
-
-(*Express t as a product of a fraction with other sorted terms*)
-fun dest_fcoeff sign (Const (@{const_name HOL.uminus}, _) $ t) = dest_fcoeff (~sign) t
- | dest_fcoeff sign (Const (@{const_name HOL.divide}, _) $ t $ u) =
- let val (p, t') = dest_coeff sign t
- val (q, u') = dest_coeff 1 u
- in (mk_frac (p, q), mk_divide (t', u')) end
- | dest_fcoeff sign t =
- let val (p, t') = dest_coeff sign t
- val T = Term.fastype_of t
- in (mk_frac (p, 1), mk_divide (t', mk_number T 1)) end;
-
-
-(*Simplify Numeral0+n, n+Numeral0, Numeral1*n, n*Numeral1*)
-val add_0s = thms "add_0s";
-val mult_1s = thms "mult_1s";
-
-(*Simplify inverse Numeral1, a/Numeral1*)
-val inverse_1s = [@{thm inverse_numeral_1}];
-val divide_1s = [@{thm divide_numeral_1}];
-
-(*To perform binary arithmetic. The "left" rewriting handles patterns
- created by the Int_Numeral_Base_Simprocs, such as 3 * (5 * x). *)
-val simps = [numeral_0_eq_0 RS sym, numeral_1_eq_1 RS sym,
- add_number_of_left, mult_number_of_left] @
- arith_simps @ rel_simps;
-
-(*Binary arithmetic BUT NOT ADDITION since it may collapse adjacent terms
- during re-arrangement*)
-val non_add_simps =
- subtract Thm.eq_thm [add_number_of_left, number_of_add RS sym] simps;
-
-(*To evaluate binary negations of coefficients*)
-val minus_simps = [numeral_m1_eq_minus_1 RS sym, number_of_minus RS sym,
- minus_1, minus_0, minus_Pls, minus_Min,
- pred_1, pred_0, pred_Pls, pred_Min];
-
-(*To let us treat subtraction as addition*)
-val diff_simps = [@{thm diff_minus}, @{thm minus_add_distrib}, @{thm minus_minus}];
-
-(*To let us treat division as multiplication*)
-val divide_simps = [@{thm divide_inverse}, @{thm inverse_mult_distrib}, @{thm inverse_inverse_eq}];
-
-(*push the unary minus down: - x * y = x * - y *)
-val minus_mult_eq_1_to_2 =
- [@{thm minus_mult_left} RS sym, @{thm minus_mult_right}] MRS trans |> standard;
-
-(*to extract again any uncancelled minuses*)
-val minus_from_mult_simps =
- [@{thm minus_minus}, @{thm minus_mult_left} RS sym, @{thm minus_mult_right} RS sym];
-
-(*combine unary minus with numeric literals, however nested within a product*)
-val mult_minus_simps =
- [@{thm mult_assoc}, @{thm minus_mult_left}, minus_mult_eq_1_to_2];
-
-(*Apply the given rewrite (if present) just once*)
-fun trans_tac NONE = all_tac
- | trans_tac (SOME th) = ALLGOALS (rtac (th RS trans));
-
-fun simplify_meta_eq rules =
- let val ss0 = HOL_basic_ss addeqcongs [eq_cong2] addsimps rules
- in fn ss => simplify (Simplifier.inherit_context ss ss0) o mk_meta_eq end
-
-structure CancelNumeralsCommon =
- struct
- val mk_sum = mk_sum
- val dest_sum = dest_sum
- val mk_coeff = mk_coeff
- val dest_coeff = dest_coeff 1
- val find_first_coeff = find_first_coeff []
- val trans_tac = fn _ => trans_tac
-
- val norm_ss1 = num_ss addsimps numeral_syms @ add_0s @ mult_1s @
- diff_simps @ minus_simps @ add_ac
- val norm_ss2 = num_ss addsimps non_add_simps @ mult_minus_simps
- val norm_ss3 = num_ss addsimps minus_from_mult_simps @ add_ac @ mult_ac
- fun norm_tac ss =
- ALLGOALS (simp_tac (Simplifier.inherit_context ss norm_ss1))
- THEN ALLGOALS (simp_tac (Simplifier.inherit_context ss norm_ss2))
- THEN ALLGOALS (simp_tac (Simplifier.inherit_context ss norm_ss3))
-
- val numeral_simp_ss = HOL_ss addsimps add_0s @ simps
- fun numeral_simp_tac ss = ALLGOALS (simp_tac (Simplifier.inherit_context ss numeral_simp_ss))
- val simplify_meta_eq = simplify_meta_eq (add_0s @ mult_1s)
- end;
-
-
-structure EqCancelNumerals = CancelNumeralsFun
- (open CancelNumeralsCommon
- val prove_conv = Int_Numeral_Base_Simprocs.prove_conv
- val mk_bal = HOLogic.mk_eq
- val dest_bal = HOLogic.dest_bin "op =" Term.dummyT
- val bal_add1 = eq_add_iff1 RS trans
- val bal_add2 = eq_add_iff2 RS trans
-);
-
-structure LessCancelNumerals = CancelNumeralsFun
- (open CancelNumeralsCommon
- val prove_conv = Int_Numeral_Base_Simprocs.prove_conv
- val mk_bal = HOLogic.mk_binrel @{const_name Orderings.less}
- val dest_bal = HOLogic.dest_bin @{const_name Orderings.less} Term.dummyT
- val bal_add1 = less_add_iff1 RS trans
- val bal_add2 = less_add_iff2 RS trans
-);
-
-structure LeCancelNumerals = CancelNumeralsFun
- (open CancelNumeralsCommon
- val prove_conv = Int_Numeral_Base_Simprocs.prove_conv
- val mk_bal = HOLogic.mk_binrel @{const_name Orderings.less_eq}
- val dest_bal = HOLogic.dest_bin @{const_name Orderings.less_eq} Term.dummyT
- val bal_add1 = le_add_iff1 RS trans
- val bal_add2 = le_add_iff2 RS trans
-);
-
-val cancel_numerals =
- map Int_Numeral_Base_Simprocs.prep_simproc
- [("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"],
- K EqCancelNumerals.proc),
- ("intless_cancel_numerals",
- ["(l::'a::{ordered_idom,number_ring}) + m < n",
- "(l::'a::{ordered_idom,number_ring}) < m + n",
- "(l::'a::{ordered_idom,number_ring}) - m < n",
- "(l::'a::{ordered_idom,number_ring}) < m - n",
- "(l::'a::{ordered_idom,number_ring}) * m < n",
- "(l::'a::{ordered_idom,number_ring}) < m * n"],
- K LessCancelNumerals.proc),
- ("intle_cancel_numerals",
- ["(l::'a::{ordered_idom,number_ring}) + m <= n",
- "(l::'a::{ordered_idom,number_ring}) <= m + n",
- "(l::'a::{ordered_idom,number_ring}) - m <= n",
- "(l::'a::{ordered_idom,number_ring}) <= m - n",
- "(l::'a::{ordered_idom,number_ring}) * m <= n",
- "(l::'a::{ordered_idom,number_ring}) <= m * n"],
- K LeCancelNumerals.proc)];
-
-
-structure CombineNumeralsData =
- struct
- type coeff = IntInf.int
- val iszero = (fn x : IntInf.int => x = 0)
- val add = IntInf.+
- val mk_sum = long_mk_sum (*to work for e.g. 2*x + 3*x *)
- val dest_sum = dest_sum
- val mk_coeff = mk_coeff
- val dest_coeff = dest_coeff 1
- val left_distrib = combine_common_factor RS trans
- val prove_conv = Int_Numeral_Base_Simprocs.prove_conv_nohyps
- val trans_tac = fn _ => trans_tac
-
- val norm_ss1 = num_ss addsimps numeral_syms @ add_0s @ mult_1s @
- diff_simps @ minus_simps @ add_ac
- val norm_ss2 = num_ss addsimps non_add_simps @ mult_minus_simps
- val norm_ss3 = num_ss addsimps minus_from_mult_simps @ add_ac @ mult_ac
- fun norm_tac ss =
- ALLGOALS (simp_tac (Simplifier.inherit_context ss norm_ss1))
- THEN ALLGOALS (simp_tac (Simplifier.inherit_context ss norm_ss2))
- THEN ALLGOALS (simp_tac (Simplifier.inherit_context ss norm_ss3))
-
- val numeral_simp_ss = HOL_ss addsimps add_0s @ simps
- fun numeral_simp_tac ss = ALLGOALS (simp_tac (Simplifier.inherit_context ss numeral_simp_ss))
- val simplify_meta_eq = simplify_meta_eq (add_0s @ mult_1s)
- end;
-
-structure CombineNumerals = CombineNumeralsFun(CombineNumeralsData);
-
-(*Version for fields, where coefficients can be fractions*)
-structure FieldCombineNumeralsData =
- struct
- type coeff = IntInf.int * IntInf.int
- val iszero = (fn (p : IntInf.int, q) => p = 0)
- val add = add_frac
- val mk_sum = long_mk_sum
- val dest_sum = dest_sum
- val mk_coeff = mk_fcoeff
- val dest_coeff = dest_fcoeff 1
- val left_distrib = combine_common_factor RS trans
- val prove_conv = Int_Numeral_Base_Simprocs.prove_conv_nohyps
- val trans_tac = fn _ => trans_tac
-
- val norm_ss1 = num_ss addsimps numeral_syms @ add_0s @ mult_1s @
- inverse_1s @ divide_simps @ diff_simps @ minus_simps @ add_ac
- val norm_ss2 = num_ss addsimps non_add_simps @ mult_minus_simps
- val norm_ss3 = num_ss addsimps minus_from_mult_simps @ add_ac @ mult_ac
- fun norm_tac ss =
- ALLGOALS (simp_tac (Simplifier.inherit_context ss norm_ss1))
- THEN ALLGOALS (simp_tac (Simplifier.inherit_context ss norm_ss2))
- THEN ALLGOALS (simp_tac (Simplifier.inherit_context ss norm_ss3))
-
- val numeral_simp_ss = HOL_ss addsimps add_0s @ simps @ [@{thm add_frac_eq}]
- fun numeral_simp_tac ss = ALLGOALS (simp_tac (Simplifier.inherit_context ss numeral_simp_ss))
- val simplify_meta_eq = simplify_meta_eq (add_0s @ mult_1s @ divide_1s)
- end;
-
-structure FieldCombineNumerals = CombineNumeralsFun(FieldCombineNumeralsData);
-
-val combine_numerals =
- Int_Numeral_Base_Simprocs.prep_simproc
- ("int_combine_numerals",
- ["(i::'a::number_ring) + j", "(i::'a::number_ring) - j"],
- K CombineNumerals.proc);
-
-val field_combine_numerals =
- Int_Numeral_Base_Simprocs.prep_simproc
- ("field_combine_numerals",
- ["(i::'a::{number_ring,field,division_by_zero}) + j",
- "(i::'a::{number_ring,field,division_by_zero}) - j"],
- K FieldCombineNumerals.proc);
-
-end;
-
-Addsimprocs Int_Numeral_Simprocs.cancel_numerals;
-Addsimprocs [Int_Numeral_Simprocs.combine_numerals];
-Addsimprocs [Int_Numeral_Simprocs.field_combine_numerals];
-
-(*examples:
-print_depth 22;
-set timing;
-set trace_simp;
-fun test s = (Goal s, by (Simp_tac 1));
-
-test "l + 2 + 2 + 2 + (l + 2) + (oo + 2) = (uu::int)";
-
-test "2*u = (u::int)";
-test "(i + j + 12 + (k::int)) - 15 = y";
-test "(i + j + 12 + (k::int)) - 5 = y";
-
-test "y - b < (b::int)";
-test "y - (3*b + c) < (b::int) - 2*c";
-
-test "(2*x - (u*v) + y) - v*3*u = (w::int)";
-test "(2*x*u*v + (u*v)*4 + y) - v*u*4 = (w::int)";
-test "(2*x*u*v + (u*v)*4 + y) - v*u = (w::int)";
-test "u*v - (x*u*v + (u*v)*4 + y) = (w::int)";
-
-test "(i + j + 12 + (k::int)) = u + 15 + y";
-test "(i + j*2 + 12 + (k::int)) = j + 5 + y";
-
-test "2*y + 3*z + 6*w + 2*y + 3*z + 2*u = 2*y' + 3*z' + 6*w' + 2*y' + 3*z' + u + (vv::int)";
-
-test "a + -(b+c) + b = (d::int)";
-test "a + -(b+c) - b = (d::int)";
-
-(*negative numerals*)
-test "(i + j + -2 + (k::int)) - (u + 5 + y) = zz";
-test "(i + j + -3 + (k::int)) < u + 5 + y";
-test "(i + j + 3 + (k::int)) < u + -6 + y";
-test "(i + j + -12 + (k::int)) - 15 = y";
-test "(i + j + 12 + (k::int)) - -15 = y";
-test "(i + j + -12 + (k::int)) - -15 = y";
-*)
-
-
-(** Constant folding for multiplication in semirings **)
-
-(*We do not need folding for addition: combine_numerals does the same thing*)
-
-structure Semiring_Times_Assoc_Data : ASSOC_FOLD_DATA =
-struct
- val assoc_ss = HOL_ss addsimps mult_ac
- val eq_reflection = eq_reflection
-end;
-
-structure Semiring_Times_Assoc = Assoc_Fold (Semiring_Times_Assoc_Data);
-
-val assoc_fold_simproc =
- Int_Numeral_Base_Simprocs.prep_simproc
- ("semiring_assoc_fold", ["(a::'a::comm_semiring_1_cancel) * b"],
- K Semiring_Times_Assoc.proc);
-
-Addsimprocs [assoc_fold_simproc];
-
-
-
-
-(*** decision procedure for linear arithmetic ***)
-
-(*---------------------------------------------------------------------------*)
-(* Linear arithmetic *)
-(*---------------------------------------------------------------------------*)
-
-(*
-Instantiation of the generic linear arithmetic package for int.
-*)
-
-(* Update parameters of arithmetic prover *)
-local
-
-(* reduce contradictory <= to False *)
-val add_rules =
- simp_thms @ arith_simps @ rel_simps @ arith_special @
- [@{thm neg_le_iff_le}, @{thm numeral_0_eq_0}, @{thm numeral_1_eq_1},
- @{thm minus_zero}, @{thm diff_minus}, @{thm left_minus}, @{thm right_minus},
- @{thm mult_zero_left}, @{thm mult_zero_right}, @{thm mult_num1}, @{thm mult_1_right},
- @{thm minus_mult_left} RS sym, @{thm minus_mult_right} RS sym,
- @{thm minus_add_distrib}, @{thm minus_minus}, @{thm mult_assoc},
- 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, int_eq_of_nat]
-
-val nat_inj_thms = [zle_int RS iffD2, int_int_eq RS iffD2]
-
-val Int_Numeral_Base_Simprocs = assoc_fold_simproc
- :: Int_Numeral_Simprocs.combine_numerals
- :: Int_Numeral_Simprocs.cancel_numerals;
-
-in
-
-val int_arith_setup =
- Fast_Arith.map_data (fn {add_mono_thms, mult_mono_thms, inj_thms, lessD, neqE, simpset} =>
- {add_mono_thms = add_mono_thms,
- mult_mono_thms = @{thm mult_strict_left_mono} :: @{thm mult_left_mono} :: mult_mono_thms,
- inj_thms = nat_inj_thms @ inj_thms,
- lessD = lessD @ [zless_imp_add1_zle],
- neqE = neqE,
- simpset = simpset addsimps add_rules
- addsimprocs Int_Numeral_Base_Simprocs
- addcongs [if_weak_cong]}) #>
- arith_inj_const ("Nat.of_nat", HOLogic.natT --> HOLogic.intT) #>
- arith_inj_const ("IntDef.int", HOLogic.natT --> HOLogic.intT) #>
- arith_discrete "IntDef.int"
-
-end;
-
-val fast_int_arith_simproc =
- Simplifier.simproc @{theory}
- "fast_int_arith"
- ["(m::'a::{ordered_idom,number_ring}) < n",
- "(m::'a::{ordered_idom,number_ring}) <= n",
- "(m::'a::{ordered_idom,number_ring}) = n"] Fast_Arith.lin_arith_prover;
-
-Addsimprocs [fast_int_arith_simproc];
--- a/src/HOL/Integ/int_factor_simprocs.ML Thu May 31 18:16:51 2007 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,335 +0,0 @@
-(* Title: HOL/int_factor_simprocs.ML
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 2000 University of Cambridge
-
-Factor cancellation simprocs for the integers (and for fields).
-
-This file can't be combined with int_arith1 because it requires IntDiv.thy.
-*)
-
-
-(*To quote from Provers/Arith/cancel_numeral_factor.ML:
-
-Cancels common coefficients in balanced expressions:
-
- u*#m ~~ u'*#m' == #n*u ~~ #n'*u'
-
-where ~~ is an appropriate balancing operation (e.g. =, <=, <, div, /)
-and d = gcd(m,m') and n=m/d and n'=m'/d.
-*)
-
-val rel_number_of = [eq_number_of_eq, less_number_of_eq_neg, le_number_of_eq];
-
-(** Factor cancellation theorems for integer division (div, not /) **)
-
-Goal "!!k::int. k~=0 ==> (k*m) div (k*n) = (m div n)";
-by (stac @{thm zdiv_zmult_zmult1} 1);
-by Auto_tac;
-qed "int_mult_div_cancel1";
-
-(*For ExtractCommonTermFun, cancelling common factors*)
-Goal "(k*m) div (k*n) = (if k = (0::int) then 0 else m div n)";
-by (simp_tac (simpset() addsimps [int_mult_div_cancel1]) 1);
-qed "int_mult_div_cancel_disj";
-
-
-local
- open Int_Numeral_Simprocs
-in
-
-structure CancelNumeralFactorCommon =
- struct
- val mk_coeff = mk_coeff
- val dest_coeff = dest_coeff 1
- val trans_tac = fn _ => trans_tac
-
- val norm_ss1 = HOL_ss addsimps minus_from_mult_simps @ mult_1s
- val norm_ss2 = HOL_ss addsimps simps @ mult_minus_simps
- val norm_ss3 = HOL_ss addsimps mult_ac
- fun norm_tac ss =
- ALLGOALS (simp_tac (Simplifier.inherit_context ss norm_ss1))
- THEN ALLGOALS (simp_tac (Simplifier.inherit_context ss norm_ss2))
- THEN ALLGOALS (simp_tac (Simplifier.inherit_context ss norm_ss3))
-
- val numeral_simp_ss = HOL_ss addsimps rel_number_of @ simps
- fun numeral_simp_tac ss = ALLGOALS (simp_tac (Simplifier.inherit_context ss numeral_simp_ss))
- val simplify_meta_eq = Int_Numeral_Simprocs.simplify_meta_eq
- [@{thm add_0}, @{thm add_0_right}, @{thm mult_zero_left},
- @{thm mult_zero_right}, @{thm mult_num1}, @{thm mult_1_right}];
- end
-
-(*Version for integer division*)
-structure IntDivCancelNumeralFactor = CancelNumeralFactorFun
- (open CancelNumeralFactorCommon
- val prove_conv = Int_Numeral_Base_Simprocs.prove_conv
- val mk_bal = HOLogic.mk_binop @{const_name Divides.div}
- val dest_bal = HOLogic.dest_bin @{const_name Divides.div} HOLogic.intT
- val cancel = int_mult_div_cancel1 RS trans
- val neg_exchanges = false
-)
-
-(*Version for fields*)
-structure DivideCancelNumeralFactor = CancelNumeralFactorFun
- (open CancelNumeralFactorCommon
- val prove_conv = Int_Numeral_Base_Simprocs.prove_conv
- val mk_bal = HOLogic.mk_binop @{const_name HOL.divide}
- val dest_bal = HOLogic.dest_bin @{const_name HOL.divide} Term.dummyT
- val cancel = @{thm mult_divide_cancel_left} RS trans
- val neg_exchanges = false
-)
-
-structure EqCancelNumeralFactor = CancelNumeralFactorFun
- (open CancelNumeralFactorCommon
- val prove_conv = Int_Numeral_Base_Simprocs.prove_conv
- val mk_bal = HOLogic.mk_eq
- val dest_bal = HOLogic.dest_bin "op =" Term.dummyT
- val cancel = @{thm mult_cancel_left} RS trans
- val neg_exchanges = false
-)
-
-structure LessCancelNumeralFactor = CancelNumeralFactorFun
- (open CancelNumeralFactorCommon
- val prove_conv = Int_Numeral_Base_Simprocs.prove_conv
- val mk_bal = HOLogic.mk_binrel @{const_name Orderings.less}
- val dest_bal = HOLogic.dest_bin @{const_name Orderings.less} Term.dummyT
- val cancel = @{thm mult_less_cancel_left} RS trans
- val neg_exchanges = true
-)
-
-structure LeCancelNumeralFactor = CancelNumeralFactorFun
- (open CancelNumeralFactorCommon
- val prove_conv = Int_Numeral_Base_Simprocs.prove_conv
- val mk_bal = HOLogic.mk_binrel @{const_name Orderings.less_eq}
- val dest_bal = HOLogic.dest_bin @{const_name Orderings.less_eq} Term.dummyT
- val cancel = @{thm mult_le_cancel_left} RS trans
- val neg_exchanges = true
-)
-
-val cancel_numeral_factors =
- map Int_Numeral_Base_Simprocs.prep_simproc
- [("ring_eq_cancel_numeral_factor",
- ["(l::'a::{idom,number_ring}) * m = n",
- "(l::'a::{idom,number_ring}) = m * n"],
- K EqCancelNumeralFactor.proc),
- ("ring_less_cancel_numeral_factor",
- ["(l::'a::{ordered_idom,number_ring}) * m < n",
- "(l::'a::{ordered_idom,number_ring}) < m * n"],
- K LessCancelNumeralFactor.proc),
- ("ring_le_cancel_numeral_factor",
- ["(l::'a::{ordered_idom,number_ring}) * m <= n",
- "(l::'a::{ordered_idom,number_ring}) <= m * n"],
- K LeCancelNumeralFactor.proc),
- ("int_div_cancel_numeral_factors",
- ["((l::int) * m) div n", "(l::int) div (m * n)"],
- K IntDivCancelNumeralFactor.proc),
- ("divide_cancel_numeral_factor",
- ["((l::'a::{division_by_zero,field,number_ring}) * m) / n",
- "(l::'a::{division_by_zero,field,number_ring}) / (m * n)",
- "((number_of v)::'a::{division_by_zero,field,number_ring}) / (number_of w)"],
- K DivideCancelNumeralFactor.proc)];
-
-(* referenced by rat_arith.ML *)
-val field_cancel_numeral_factors =
- map Int_Numeral_Base_Simprocs.prep_simproc
- [("field_eq_cancel_numeral_factor",
- ["(l::'a::{field,number_ring}) * m = n",
- "(l::'a::{field,number_ring}) = m * n"],
- K EqCancelNumeralFactor.proc),
- ("field_cancel_numeral_factor",
- ["((l::'a::{division_by_zero,field,number_ring}) * m) / n",
- "(l::'a::{division_by_zero,field,number_ring}) / (m * n)",
- "((number_of v)::'a::{division_by_zero,field,number_ring}) / (number_of w)"],
- K DivideCancelNumeralFactor.proc)]
-
-end;
-
-Addsimprocs cancel_numeral_factors;
-
-(*examples:
-print_depth 22;
-set timing;
-set trace_simp;
-fun test s = (Goal s; by (Simp_tac 1));
-
-test "9*x = 12 * (y::int)";
-test "(9*x) div (12 * (y::int)) = z";
-test "9*x < 12 * (y::int)";
-test "9*x <= 12 * (y::int)";
-
-test "-99*x = 132 * (y::int)";
-test "(-99*x) div (132 * (y::int)) = z";
-test "-99*x < 132 * (y::int)";
-test "-99*x <= 132 * (y::int)";
-
-test "999*x = -396 * (y::int)";
-test "(999*x) div (-396 * (y::int)) = z";
-test "999*x < -396 * (y::int)";
-test "999*x <= -396 * (y::int)";
-
-test "-99*x = -81 * (y::int)";
-test "(-99*x) div (-81 * (y::int)) = z";
-test "-99*x <= -81 * (y::int)";
-test "-99*x < -81 * (y::int)";
-
-test "-2 * x = -1 * (y::int)";
-test "-2 * x = -(y::int)";
-test "(-2 * x) div (-1 * (y::int)) = z";
-test "-2 * x < -(y::int)";
-test "-2 * x <= -1 * (y::int)";
-test "-x < -23 * (y::int)";
-test "-x <= -23 * (y::int)";
-*)
-
-(*And the same examples for fields such as rat or real:
-test "0 <= (y::rat) * -2";
-test "9*x = 12 * (y::rat)";
-test "(9*x) / (12 * (y::rat)) = z";
-test "9*x < 12 * (y::rat)";
-test "9*x <= 12 * (y::rat)";
-
-test "-99*x = 132 * (y::rat)";
-test "(-99*x) / (132 * (y::rat)) = z";
-test "-99*x < 132 * (y::rat)";
-test "-99*x <= 132 * (y::rat)";
-
-test "999*x = -396 * (y::rat)";
-test "(999*x) / (-396 * (y::rat)) = z";
-test "999*x < -396 * (y::rat)";
-test "999*x <= -396 * (y::rat)";
-
-test "(- ((2::rat) * x) <= 2 * y)";
-test "-99*x = -81 * (y::rat)";
-test "(-99*x) / (-81 * (y::rat)) = z";
-test "-99*x <= -81 * (y::rat)";
-test "-99*x < -81 * (y::rat)";
-
-test "-2 * x = -1 * (y::rat)";
-test "-2 * x = -(y::rat)";
-test "(-2 * x) / (-1 * (y::rat)) = z";
-test "-2 * x < -(y::rat)";
-test "-2 * x <= -1 * (y::rat)";
-test "-x < -23 * (y::rat)";
-test "-x <= -23 * (y::rat)";
-*)
-
-
-(** Declarations for ExtractCommonTerm **)
-
-local
- open Int_Numeral_Simprocs
-in
-
-(*Find first term that matches u*)
-fun find_first_t past u [] = raise TERM ("find_first_t", [])
- | find_first_t past u (t::terms) =
- if u aconv t then (rev past @ terms)
- else find_first_t (t::past) u terms
- handle TERM _ => find_first_t (t::past) u terms;
-
-(** Final simplification for the CancelFactor simprocs **)
-val simplify_one = Int_Numeral_Simprocs.simplify_meta_eq
- [@{thm mult_1_left}, mult_1_right, @{thm zdiv_1}, numeral_1_eq_1];
-
-fun cancel_simplify_meta_eq cancel_th ss th =
- simplify_one ss (([th, cancel_th]) MRS trans);
-
-(*At present, long_mk_prod creates Numeral1, so this requires the axclass
- number_ring*)
-structure CancelFactorCommon =
- struct
- val mk_sum = long_mk_prod
- val dest_sum = dest_prod
- val mk_coeff = mk_coeff
- val dest_coeff = dest_coeff
- val find_first = find_first_t []
- val trans_tac = fn _ => trans_tac
- val norm_ss = HOL_ss addsimps mult_1s @ mult_ac
- fun norm_tac ss = ALLGOALS (simp_tac (Simplifier.inherit_context ss norm_ss))
- end;
-
-(*mult_cancel_left requires a ring with no zero divisors.*)
-structure EqCancelFactor = ExtractCommonTermFun
- (open CancelFactorCommon
- val prove_conv = Int_Numeral_Base_Simprocs.prove_conv
- val mk_bal = HOLogic.mk_eq
- val dest_bal = HOLogic.dest_bin "op =" Term.dummyT
- val simplify_meta_eq = cancel_simplify_meta_eq @{thm mult_cancel_left}
-);
-
-(*int_mult_div_cancel_disj is for integer division (div).*)
-structure IntDivCancelFactor = ExtractCommonTermFun
- (open CancelFactorCommon
- val prove_conv = Int_Numeral_Base_Simprocs.prove_conv
- val mk_bal = HOLogic.mk_binop @{const_name Divides.div}
- val dest_bal = HOLogic.dest_bin @{const_name Divides.div} HOLogic.intT
- val simplify_meta_eq = cancel_simplify_meta_eq int_mult_div_cancel_disj
-);
-
-(*Version for all fields, including unordered ones (type complex).*)
-structure DivideCancelFactor = ExtractCommonTermFun
- (open CancelFactorCommon
- val prove_conv = Int_Numeral_Base_Simprocs.prove_conv
- val mk_bal = HOLogic.mk_binop @{const_name HOL.divide}
- val dest_bal = HOLogic.dest_bin @{const_name HOL.divide} Term.dummyT
- val simplify_meta_eq = cancel_simplify_meta_eq @{thm mult_divide_cancel_eq_if}
-);
-
-(*The number_ring class is necessary because the simprocs refer to the
- binary number 1. FIXME: probably they could use 1 instead.*)
-val cancel_factors =
- map Int_Numeral_Base_Simprocs.prep_simproc
- [("ring_eq_cancel_factor",
- ["(l::'a::{idom,number_ring}) * m = n",
- "(l::'a::{idom,number_ring}) = m * n"],
- K EqCancelFactor.proc),
- ("int_div_cancel_factor",
- ["((l::int) * m) div n", "(l::int) div (m * n)"],
- K IntDivCancelFactor.proc),
- ("divide_cancel_factor",
- ["((l::'a::{division_by_zero,field,number_ring}) * m) / n",
- "(l::'a::{division_by_zero,field,number_ring}) / (m * n)"],
- K DivideCancelFactor.proc)];
-
-end;
-
-Addsimprocs cancel_factors;
-
-
-(*examples:
-print_depth 22;
-set timing;
-set trace_simp;
-fun test s = (Goal s; by (Asm_simp_tac 1));
-
-test "x*k = k*(y::int)";
-test "k = k*(y::int)";
-test "a*(b*c) = (b::int)";
-test "a*(b*c) = d*(b::int)*(x*a)";
-
-test "(x*k) div (k*(y::int)) = (uu::int)";
-test "(k) div (k*(y::int)) = (uu::int)";
-test "(a*(b*c)) div ((b::int)) = (uu::int)";
-test "(a*(b*c)) div (d*(b::int)*(x*a)) = (uu::int)";
-*)
-
-(*And the same examples for fields such as rat or real:
-print_depth 22;
-set timing;
-set trace_simp;
-fun test s = (Goal s; by (Asm_simp_tac 1));
-
-test "x*k = k*(y::rat)";
-test "k = k*(y::rat)";
-test "a*(b*c) = (b::rat)";
-test "a*(b*c) = d*(b::rat)*(x*a)";
-
-
-test "(x*k) / (k*(y::rat)) = (uu::rat)";
-test "(k) / (k*(y::rat)) = (uu::rat)";
-test "(a*(b*c)) / ((b::rat)) = (uu::rat)";
-test "(a*(b*c)) / (d*(b::rat)*(x*a)) = (uu::rat)";
-
-(*FIXME: what do we do about this?*)
-test "a*(b*c)/(y*z) = d*(b::rat)*(x*a)/z";
-*)
--- a/src/HOL/Integ/nat_simprocs.ML Thu May 31 18:16:51 2007 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,550 +0,0 @@
-(* Title: HOL/nat_simprocs.ML
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 2000 University of Cambridge
-
-Simprocs for nat numerals.
-*)
-
-structure Nat_Numeral_Simprocs =
-struct
-
-(*Maps n to #n for n = 0, 1, 2*)
-val numeral_syms =
- [nat_numeral_0_eq_0 RS sym, nat_numeral_1_eq_1 RS sym, numeral_2_eq_2 RS sym];
-val numeral_sym_ss = HOL_ss addsimps numeral_syms;
-
-fun rename_numerals th =
- simplify numeral_sym_ss (Thm.transfer (the_context ()) th);
-
-(*Utilities*)
-
-fun mk_number n = HOLogic.number_of_const HOLogic.natT $ HOLogic.mk_numeral n;
-fun dest_number t = IntInf.max (0, snd (HOLogic.dest_number t));
-
-fun find_first_numeral past (t::terms) =
- ((dest_number t, t, rev past @ terms)
- handle TERM _ => find_first_numeral (t::past) terms)
- | find_first_numeral past [] = raise TERM("find_first_numeral", []);
-
-val zero = mk_number 0;
-val mk_plus = HOLogic.mk_binop @{const_name HOL.plus};
-
-(*Thus mk_sum[t] yields t+0; longer sums don't have a trailing zero*)
-fun mk_sum [] = zero
- | mk_sum [t,u] = mk_plus (t, u)
- | mk_sum (t :: ts) = mk_plus (t, mk_sum ts);
-
-(*this version ALWAYS includes a trailing zero*)
-fun long_mk_sum [] = HOLogic.zero
- | long_mk_sum (t :: ts) = mk_plus (t, mk_sum ts);
-
-val dest_plus = HOLogic.dest_bin @{const_name HOL.plus} HOLogic.natT;
-
-
-(** Other simproc items **)
-
-val trans_tac = Int_Numeral_Simprocs.trans_tac;
-
-val bin_simps =
- [nat_numeral_0_eq_0 RS sym, nat_numeral_1_eq_1 RS sym,
- add_nat_number_of, nat_number_of_add_left,
- diff_nat_number_of, le_number_of_eq_not_less,
- mult_nat_number_of, nat_number_of_mult_left,
- less_nat_number_of,
- @{thm Let_number_of}, nat_number_of] @
- arith_simps @ rel_simps;
-
-fun prep_simproc (name, pats, proc) =
- Simplifier.simproc (the_context ()) name pats proc;
-
-
-(*** CancelNumerals simprocs ***)
-
-val one = mk_number 1;
-val mk_times = HOLogic.mk_binop @{const_name HOL.times};
-
-fun mk_prod [] = one
- | mk_prod [t] = t
- | mk_prod (t :: ts) = if t = one then mk_prod ts
- else mk_times (t, mk_prod ts);
-
-val dest_times = HOLogic.dest_bin @{const_name HOL.times} HOLogic.natT;
-
-fun dest_prod t =
- let val (t,u) = dest_times t
- in dest_prod t @ dest_prod u end
- handle TERM _ => [t];
-
-(*DON'T do the obvious simplifications; that would create special cases*)
-fun mk_coeff (k,t) = mk_times (mk_number k, t);
-
-(*Express t as a product of (possibly) a numeral with other factors, sorted*)
-fun dest_coeff t =
- let val ts = sort Term.term_ord (dest_prod t)
- val (n, _, ts') = find_first_numeral [] ts
- handle TERM _ => (1, one, ts)
- in (n, mk_prod ts') end;
-
-(*Find first coefficient-term THAT MATCHES u*)
-fun find_first_coeff past u [] = raise TERM("find_first_coeff", [])
- | find_first_coeff past u (t::terms) =
- let val (n,u') = dest_coeff t
- in if u aconv u' then (n, rev past @ terms)
- else find_first_coeff (t::past) u terms
- end
- handle TERM _ => find_first_coeff (t::past) u terms;
-
-
-(*Split up a sum into the list of its constituent terms, on the way removing any
- Sucs and counting them.*)
-fun dest_Suc_sum (Const ("Suc", _) $ t, (k,ts)) = dest_Suc_sum (t, (k+1,ts))
- | dest_Suc_sum (t, (k,ts)) =
- let val (t1,t2) = dest_plus t
- in dest_Suc_sum (t1, dest_Suc_sum (t2, (k,ts))) end
- handle TERM _ => (k, t::ts);
-
-(*Code for testing whether numerals are already used in the goal*)
-fun is_numeral (Const(@{const_name Numeral.number_of}, _) $ w) = true
- | is_numeral _ = false;
-
-fun prod_has_numeral t = exists is_numeral (dest_prod t);
-
-(*The Sucs found in the term are converted to a binary numeral. If relaxed is false,
- an exception is raised unless the original expression contains at least one
- numeral in a coefficient position. This prevents nat_combine_numerals from
- introducing numerals to goals.*)
-fun dest_Sucs_sum relaxed t =
- let val (k,ts) = dest_Suc_sum (t,(0,[]))
- in
- if relaxed orelse exists prod_has_numeral ts then
- if k=0 then ts
- else mk_number (IntInf.fromInt k) :: ts
- else raise TERM("Nat_Numeral_Simprocs.dest_Sucs_sum", [t])
- end;
-
-
-(*Simplify 1*n and n*1 to n*)
-val add_0s = map rename_numerals [add_0, add_0_right];
-val mult_1s = map rename_numerals [@{thm nat_mult_1}, @{thm nat_mult_1_right}];
-
-(*Final simplification: cancel + and *; replace Numeral0 by 0 and Numeral1 by 1*)
-
-(*And these help the simproc return False when appropriate, which helps
- the arith prover.*)
-val contra_rules = [add_Suc, add_Suc_right, Zero_not_Suc, Suc_not_Zero,
- le_0_eq];
-
-val simplify_meta_eq =
- Int_Numeral_Simprocs.simplify_meta_eq
- ([nat_numeral_0_eq_0, numeral_1_eq_Suc_0, add_0, add_0_right,
- mult_0, mult_0_right, mult_1, mult_1_right] @ contra_rules);
-
-
-(*Like HOL_ss but with an ordering that brings numerals to the front
- under AC-rewriting.*)
-val num_ss = Int_Numeral_Simprocs.num_ss;
-
-(*** Applying CancelNumeralsFun ***)
-
-structure CancelNumeralsCommon =
- struct
- val mk_sum = (fn T:typ => mk_sum)
- val dest_sum = dest_Sucs_sum true
- val mk_coeff = mk_coeff
- val dest_coeff = dest_coeff
- val find_first_coeff = find_first_coeff []
- val trans_tac = fn _ => trans_tac
-
- val norm_ss1 = num_ss addsimps numeral_syms @ add_0s @ mult_1s @
- [Suc_eq_add_numeral_1_left] @ add_ac
- val norm_ss2 = num_ss addsimps bin_simps @ add_ac @ mult_ac
- fun norm_tac ss =
- ALLGOALS (simp_tac (Simplifier.inherit_context ss norm_ss1))
- THEN ALLGOALS (simp_tac (Simplifier.inherit_context ss norm_ss2))
-
- val numeral_simp_ss = HOL_ss addsimps add_0s @ bin_simps;
- fun numeral_simp_tac ss = ALLGOALS (simp_tac (Simplifier.inherit_context ss numeral_simp_ss));
- val simplify_meta_eq = simplify_meta_eq
- end;
-
-
-structure EqCancelNumerals = CancelNumeralsFun
- (open CancelNumeralsCommon
- val prove_conv = Int_Numeral_Base_Simprocs.prove_conv
- val mk_bal = HOLogic.mk_eq
- val dest_bal = HOLogic.dest_bin "op =" HOLogic.natT
- val bal_add1 = nat_eq_add_iff1 RS trans
- val bal_add2 = nat_eq_add_iff2 RS trans
-);
-
-structure LessCancelNumerals = CancelNumeralsFun
- (open CancelNumeralsCommon
- val prove_conv = Int_Numeral_Base_Simprocs.prove_conv
- val mk_bal = HOLogic.mk_binrel @{const_name Orderings.less}
- val dest_bal = HOLogic.dest_bin @{const_name Orderings.less} HOLogic.natT
- val bal_add1 = nat_less_add_iff1 RS trans
- val bal_add2 = nat_less_add_iff2 RS trans
-);
-
-structure LeCancelNumerals = CancelNumeralsFun
- (open CancelNumeralsCommon
- val prove_conv = Int_Numeral_Base_Simprocs.prove_conv
- val mk_bal = HOLogic.mk_binrel @{const_name Orderings.less_eq}
- val dest_bal = HOLogic.dest_bin @{const_name Orderings.less_eq} HOLogic.natT
- val bal_add1 = nat_le_add_iff1 RS trans
- val bal_add2 = nat_le_add_iff2 RS trans
-);
-
-structure DiffCancelNumerals = CancelNumeralsFun
- (open CancelNumeralsCommon
- val prove_conv = Int_Numeral_Base_Simprocs.prove_conv
- val mk_bal = HOLogic.mk_binop @{const_name HOL.minus}
- val dest_bal = HOLogic.dest_bin @{const_name HOL.minus} HOLogic.natT
- val bal_add1 = nat_diff_add_eq1 RS trans
- val bal_add2 = nat_diff_add_eq2 RS trans
-);
-
-
-val cancel_numerals =
- map prep_simproc
- [("nateq_cancel_numerals",
- ["(l::nat) + m = n", "(l::nat) = m + n",
- "(l::nat) * m = n", "(l::nat) = m * n",
- "Suc m = n", "m = Suc n"],
- K EqCancelNumerals.proc),
- ("natless_cancel_numerals",
- ["(l::nat) + m < n", "(l::nat) < m + n",
- "(l::nat) * m < n", "(l::nat) < m * n",
- "Suc m < n", "m < Suc n"],
- K LessCancelNumerals.proc),
- ("natle_cancel_numerals",
- ["(l::nat) + m <= n", "(l::nat) <= m + n",
- "(l::nat) * m <= n", "(l::nat) <= m * n",
- "Suc m <= n", "m <= Suc n"],
- K LeCancelNumerals.proc),
- ("natdiff_cancel_numerals",
- ["((l::nat) + m) - n", "(l::nat) - (m + n)",
- "(l::nat) * m - n", "(l::nat) - m * n",
- "Suc m - n", "m - Suc n"],
- K DiffCancelNumerals.proc)];
-
-
-(*** Applying CombineNumeralsFun ***)
-
-structure CombineNumeralsData =
- struct
- type coeff = IntInf.int
- val iszero = (fn x : IntInf.int => x = 0)
- val add = IntInf.+
- val mk_sum = (fn T:typ => long_mk_sum) (*to work for 2*x + 3*x *)
- val dest_sum = dest_Sucs_sum false
- val mk_coeff = mk_coeff
- val dest_coeff = dest_coeff
- val left_distrib = left_add_mult_distrib RS trans
- val prove_conv = Int_Numeral_Base_Simprocs.prove_conv_nohyps
- val trans_tac = fn _ => trans_tac
-
- val norm_ss1 = num_ss addsimps numeral_syms @ add_0s @ mult_1s @ [Suc_eq_add_numeral_1] @ add_ac
- val norm_ss2 = num_ss addsimps bin_simps @ add_ac @ mult_ac
- fun norm_tac ss =
- ALLGOALS (simp_tac (Simplifier.inherit_context ss norm_ss1))
- THEN ALLGOALS (simp_tac (Simplifier.inherit_context ss norm_ss2))
-
- val numeral_simp_ss = HOL_ss addsimps add_0s @ bin_simps;
- fun numeral_simp_tac ss = ALLGOALS (simp_tac (Simplifier.inherit_context ss numeral_simp_ss))
- val simplify_meta_eq = simplify_meta_eq
- end;
-
-structure CombineNumerals = CombineNumeralsFun(CombineNumeralsData);
-
-val combine_numerals =
- prep_simproc ("nat_combine_numerals", ["(i::nat) + j", "Suc (i + j)"], K CombineNumerals.proc);
-
-
-(*** Applying CancelNumeralFactorFun ***)
-
-structure CancelNumeralFactorCommon =
- struct
- val mk_coeff = mk_coeff
- val dest_coeff = dest_coeff
- val trans_tac = fn _ => trans_tac
-
- val norm_ss1 = num_ss addsimps
- numeral_syms @ add_0s @ mult_1s @ [Suc_eq_add_numeral_1_left] @ add_ac
- val norm_ss2 = num_ss addsimps bin_simps @ add_ac @ mult_ac
- fun norm_tac ss =
- ALLGOALS (simp_tac (Simplifier.inherit_context ss norm_ss1))
- THEN ALLGOALS (simp_tac (Simplifier.inherit_context ss norm_ss2))
-
- val numeral_simp_ss = HOL_ss addsimps bin_simps
- fun numeral_simp_tac ss = ALLGOALS (simp_tac (Simplifier.inherit_context ss numeral_simp_ss))
- val simplify_meta_eq = simplify_meta_eq
- end
-
-structure DivCancelNumeralFactor = CancelNumeralFactorFun
- (open CancelNumeralFactorCommon
- val prove_conv = Int_Numeral_Base_Simprocs.prove_conv
- val mk_bal = HOLogic.mk_binop @{const_name Divides.div}
- val dest_bal = HOLogic.dest_bin @{const_name Divides.div} HOLogic.natT
- val cancel = nat_mult_div_cancel1 RS trans
- val neg_exchanges = false
-)
-
-structure EqCancelNumeralFactor = CancelNumeralFactorFun
- (open CancelNumeralFactorCommon
- val prove_conv = Int_Numeral_Base_Simprocs.prove_conv
- val mk_bal = HOLogic.mk_eq
- val dest_bal = HOLogic.dest_bin "op =" HOLogic.natT
- val cancel = nat_mult_eq_cancel1 RS trans
- val neg_exchanges = false
-)
-
-structure LessCancelNumeralFactor = CancelNumeralFactorFun
- (open CancelNumeralFactorCommon
- val prove_conv = Int_Numeral_Base_Simprocs.prove_conv
- val mk_bal = HOLogic.mk_binrel @{const_name Orderings.less}
- val dest_bal = HOLogic.dest_bin @{const_name Orderings.less} HOLogic.natT
- val cancel = nat_mult_less_cancel1 RS trans
- val neg_exchanges = true
-)
-
-structure LeCancelNumeralFactor = CancelNumeralFactorFun
- (open CancelNumeralFactorCommon
- val prove_conv = Int_Numeral_Base_Simprocs.prove_conv
- val mk_bal = HOLogic.mk_binrel @{const_name Orderings.less_eq}
- val dest_bal = HOLogic.dest_bin @{const_name Orderings.less_eq} HOLogic.natT
- val cancel = nat_mult_le_cancel1 RS trans
- val neg_exchanges = true
-)
-
-val cancel_numeral_factors =
- map prep_simproc
- [("nateq_cancel_numeral_factors",
- ["(l::nat) * m = n", "(l::nat) = m * n"],
- K EqCancelNumeralFactor.proc),
- ("natless_cancel_numeral_factors",
- ["(l::nat) * m < n", "(l::nat) < m * n"],
- K LessCancelNumeralFactor.proc),
- ("natle_cancel_numeral_factors",
- ["(l::nat) * m <= n", "(l::nat) <= m * n"],
- K LeCancelNumeralFactor.proc),
- ("natdiv_cancel_numeral_factors",
- ["((l::nat) * m) div n", "(l::nat) div (m * n)"],
- K DivCancelNumeralFactor.proc)];
-
-
-
-(*** Applying ExtractCommonTermFun ***)
-
-(*this version ALWAYS includes a trailing one*)
-fun long_mk_prod [] = one
- | long_mk_prod (t :: ts) = mk_times (t, mk_prod ts);
-
-(*Find first term that matches u*)
-fun find_first_t past u [] = raise TERM("find_first_t", [])
- | find_first_t past u (t::terms) =
- if u aconv t then (rev past @ terms)
- else find_first_t (t::past) u terms
- handle TERM _ => find_first_t (t::past) u terms;
-
-(** Final simplification for the CancelFactor simprocs **)
-val simplify_one = Int_Numeral_Simprocs.simplify_meta_eq
- [@{thm mult_1_left}, @{thm mult_1_right}, @{thm div_1}, @{thm numeral_1_eq_Suc_0}];
-
-fun cancel_simplify_meta_eq cancel_th ss th =
- simplify_one ss (([th, cancel_th]) MRS trans);
-
-structure CancelFactorCommon =
- struct
- val mk_sum = (fn T:typ => long_mk_prod)
- val dest_sum = dest_prod
- val mk_coeff = mk_coeff
- val dest_coeff = dest_coeff
- val find_first = find_first_t []
- val trans_tac = fn _ => trans_tac
- val norm_ss = HOL_ss addsimps mult_1s @ mult_ac
- fun norm_tac ss = ALLGOALS (simp_tac (Simplifier.inherit_context ss norm_ss))
- end;
-
-structure EqCancelFactor = ExtractCommonTermFun
- (open CancelFactorCommon
- val prove_conv = Int_Numeral_Base_Simprocs.prove_conv
- val mk_bal = HOLogic.mk_eq
- val dest_bal = HOLogic.dest_bin "op =" HOLogic.natT
- val simplify_meta_eq = cancel_simplify_meta_eq nat_mult_eq_cancel_disj
-);
-
-structure LessCancelFactor = ExtractCommonTermFun
- (open CancelFactorCommon
- val prove_conv = Int_Numeral_Base_Simprocs.prove_conv
- val mk_bal = HOLogic.mk_binrel @{const_name Orderings.less}
- val dest_bal = HOLogic.dest_bin @{const_name Orderings.less} HOLogic.natT
- val simplify_meta_eq = cancel_simplify_meta_eq nat_mult_less_cancel_disj
-);
-
-structure LeCancelFactor = ExtractCommonTermFun
- (open CancelFactorCommon
- val prove_conv = Int_Numeral_Base_Simprocs.prove_conv
- val mk_bal = HOLogic.mk_binrel @{const_name Orderings.less_eq}
- val dest_bal = HOLogic.dest_bin @{const_name Orderings.less_eq} HOLogic.natT
- val simplify_meta_eq = cancel_simplify_meta_eq nat_mult_le_cancel_disj
-);
-
-structure DivideCancelFactor = ExtractCommonTermFun
- (open CancelFactorCommon
- val prove_conv = Int_Numeral_Base_Simprocs.prove_conv
- val mk_bal = HOLogic.mk_binop @{const_name Divides.div}
- val dest_bal = HOLogic.dest_bin @{const_name Divides.div} HOLogic.natT
- val simplify_meta_eq = cancel_simplify_meta_eq nat_mult_div_cancel_disj
-);
-
-val cancel_factor =
- map prep_simproc
- [("nat_eq_cancel_factor",
- ["(l::nat) * m = n", "(l::nat) = m * n"],
- K EqCancelFactor.proc),
- ("nat_less_cancel_factor",
- ["(l::nat) * m < n", "(l::nat) < m * n"],
- K LessCancelFactor.proc),
- ("nat_le_cancel_factor",
- ["(l::nat) * m <= n", "(l::nat) <= m * n"],
- K LeCancelFactor.proc),
- ("nat_divide_cancel_factor",
- ["((l::nat) * m) div n", "(l::nat) div (m * n)"],
- K DivideCancelFactor.proc)];
-
-end;
-
-
-Addsimprocs Nat_Numeral_Simprocs.cancel_numerals;
-Addsimprocs [Nat_Numeral_Simprocs.combine_numerals];
-Addsimprocs Nat_Numeral_Simprocs.cancel_numeral_factors;
-Addsimprocs Nat_Numeral_Simprocs.cancel_factor;
-
-
-(*examples:
-print_depth 22;
-set timing;
-set trace_simp;
-fun test s = (Goal s; by (Simp_tac 1));
-
-(*cancel_numerals*)
-test "l +( 2) + (2) + 2 + (l + 2) + (oo + 2) = (uu::nat)";
-test "(2*length xs < 2*length xs + j)";
-test "(2*length xs < length xs * 2 + j)";
-test "2*u = (u::nat)";
-test "2*u = Suc (u)";
-test "(i + j + 12 + (k::nat)) - 15 = y";
-test "(i + j + 12 + (k::nat)) - 5 = y";
-test "Suc u - 2 = y";
-test "Suc (Suc (Suc u)) - 2 = y";
-test "(i + j + 2 + (k::nat)) - 1 = y";
-test "(i + j + 1 + (k::nat)) - 2 = y";
-
-test "(2*x + (u*v) + y) - v*3*u = (w::nat)";
-test "(2*x*u*v + 5 + (u*v)*4 + y) - v*u*4 = (w::nat)";
-test "(2*x*u*v + (u*v)*4 + y) - v*u = (w::nat)";
-test "Suc (Suc (2*x*u*v + u*4 + y)) - u = w";
-test "Suc ((u*v)*4) - v*3*u = w";
-test "Suc (Suc ((u*v)*3)) - v*3*u = w";
-
-test "(i + j + 12 + (k::nat)) = u + 15 + y";
-test "(i + j + 32 + (k::nat)) - (u + 15 + y) = zz";
-test "(i + j + 12 + (k::nat)) = u + 5 + y";
-(*Suc*)
-test "(i + j + 12 + k) = Suc (u + y)";
-test "Suc (Suc (Suc (Suc (Suc (u + y))))) <= ((i + j) + 41 + k)";
-test "(i + j + 5 + k) < Suc (Suc (Suc (Suc (Suc (u + y)))))";
-test "Suc (Suc (Suc (Suc (Suc (u + y))))) - 5 = v";
-test "(i + j + 5 + k) = Suc (Suc (Suc (Suc (Suc (Suc (Suc (u + y)))))))";
-test "2*y + 3*z + 2*u = Suc (u)";
-test "2*y + 3*z + 6*w + 2*y + 3*z + 2*u = Suc (u)";
-test "2*y + 3*z + 6*w + 2*y + 3*z + 2*u = 2*y' + 3*z' + 6*w' + 2*y' + 3*z' + u + (vv::nat)";
-test "6 + 2*y + 3*z + 4*u = Suc (vv + 2*u + z)";
-test "(2*n*m) < (3*(m*n)) + (u::nat)";
-
-test "(Suc (Suc (Suc (Suc (Suc (Suc (case length (f c) of 0 => 0 | Suc k => k)))))) <= Suc 0)";
-
-test "Suc (Suc (Suc (Suc (Suc (Suc (length l1 + length l2)))))) <= length l1";
-
-test "( (Suc (Suc (Suc (Suc (Suc (length (compT P E A ST mxr e) + length l3)))))) <= length (compT P E A ST mxr e))";
-
-test "( (Suc (Suc (Suc (Suc (Suc (length (compT P E A ST mxr e) + length (compT P E (A Un \<A> e) ST mxr c))))))) <= length (compT P E A ST mxr e))";
-
-
-(*negative numerals: FAIL*)
-test "(i + j + -23 + (k::nat)) < u + 15 + y";
-test "(i + j + 3 + (k::nat)) < u + -15 + y";
-test "(i + j + -12 + (k::nat)) - 15 = y";
-test "(i + j + 12 + (k::nat)) - -15 = y";
-test "(i + j + -12 + (k::nat)) - -15 = y";
-
-(*combine_numerals*)
-test "k + 3*k = (u::nat)";
-test "Suc (i + 3) = u";
-test "Suc (i + j + 3 + k) = u";
-test "k + j + 3*k + j = (u::nat)";
-test "Suc (j*i + i + k + 5 + 3*k + i*j*4) = (u::nat)";
-test "(2*n*m) + (3*(m*n)) = (u::nat)";
-(*negative numerals: FAIL*)
-test "Suc (i + j + -3 + k) = u";
-
-(*cancel_numeral_factors*)
-test "9*x = 12 * (y::nat)";
-test "(9*x) div (12 * (y::nat)) = z";
-test "9*x < 12 * (y::nat)";
-test "9*x <= 12 * (y::nat)";
-
-(*cancel_factor*)
-test "x*k = k*(y::nat)";
-test "k = k*(y::nat)";
-test "a*(b*c) = (b::nat)";
-test "a*(b*c) = d*(b::nat)*(x*a)";
-
-test "x*k < k*(y::nat)";
-test "k < k*(y::nat)";
-test "a*(b*c) < (b::nat)";
-test "a*(b*c) < d*(b::nat)*(x*a)";
-
-test "x*k <= k*(y::nat)";
-test "k <= k*(y::nat)";
-test "a*(b*c) <= (b::nat)";
-test "a*(b*c) <= d*(b::nat)*(x*a)";
-
-test "(x*k) div (k*(y::nat)) = (uu::nat)";
-test "(k) div (k*(y::nat)) = (uu::nat)";
-test "(a*(b*c)) div ((b::nat)) = (uu::nat)";
-test "(a*(b*c)) div (d*(b::nat)*(x*a)) = (uu::nat)";
-*)
-
-
-(*** Prepare linear arithmetic for nat numerals ***)
-
-local
-
-(* reduce contradictory <= to False *)
-val add_rules =
- [@{thm Let_number_of}, @{thm Let_0}, @{thm Let_1}, nat_0, nat_1,
- add_nat_number_of, diff_nat_number_of, mult_nat_number_of,
- eq_nat_number_of, less_nat_number_of, le_number_of_eq_not_less,
- le_Suc_number_of,le_number_of_Suc,
- less_Suc_number_of,less_number_of_Suc,
- Suc_eq_number_of,eq_number_of_Suc,
- mult_Suc, mult_Suc_right,
- eq_number_of_0, eq_0_number_of, less_0_number_of,
- of_int_number_of_eq, of_nat_number_of_eq, nat_number_of, if_True, if_False];
-
-val simprocs = Nat_Numeral_Simprocs.combine_numerals
- :: Nat_Numeral_Simprocs.cancel_numerals;
-
-in
-
-val nat_simprocs_setup =
- Fast_Arith.map_data (fn {add_mono_thms, mult_mono_thms, inj_thms, lessD, neqE, simpset} =>
- {add_mono_thms = add_mono_thms, mult_mono_thms = mult_mono_thms,
- inj_thms = inj_thms, lessD = lessD, neqE = neqE,
- simpset = simpset addsimps add_rules
- addsimprocs simprocs});
-
-end;
--- a/src/HOL/IsaMakefile Thu May 31 18:16:51 2007 +0200
+++ b/src/HOL/IsaMakefile Thu May 31 18:16:52 2007 +0200
@@ -82,26 +82,23 @@
$(SRC)/Provers/quasi.ML $(SRC)/Provers/splitter.ML \
$(SRC)/Provers/trancl.ML $(SRC)/Pure/General/int.ML \
$(SRC)/Pure/General/rat.ML Tools/TFL/casesplit.ML \
- Tools/TFL/dcterm.ML Tools/TFL/post.ML Tools/TFL/rules.ML \
- Tools/TFL/tfl.ML Tools/TFL/thms.ML Tools/TFL/thry.ML \
- Tools/TFL/usyntax.ML Tools/TFL/utils.ML ATP_Linkup.thy \
- Accessible_Part.thy Code_Generator.thy Datatype.thy Divides.thy \
- Equiv_Relations.thy Extraction.thy Finite_Set.thy FixedPoint.thy \
- Fun.thy FunDef.thy HOL.thy Hilbert_Choice.thy Inductive.thy \
- Integ/IntArith.thy Integ/IntDef.thy Integ/IntDiv.thy Integ/NatBin.thy \
- Integ/NatSimprocs.thy Integ/Numeral.thy Integ/int_arith1.ML \
- Integ/int_factor_simprocs.ML Integ/nat_simprocs.ML Lattices.thy \
- List.thy Main.thy Map.thy Nat.ML Nat.thy OrderedGroup.thy \
- Orderings.thy Power.thy PreList.thy Predicate.thy Presburger.thy \
- Product_Type.thy ROOT.ML Recdef.thy Record.thy Refute.thy Relation.thy \
- Relation_Power.thy Ring_and_Field.thy SAT.thy Set.thy SetInterval.thy \
- Sum_Type.thy Tools/ATP/reduce_axiomsN.ML Tools/ATP/watcher.ML \
- Tools/Presburger/cooper_dec.ML Tools/Presburger/cooper_proof.ML \
- Tools/Presburger/presburger.ML Tools/Presburger/qelim.ML \
- Tools/Presburger/reflected_cooper.ML \
- Tools/Presburger/reflected_presburger.ML Tools/cnf_funcs.ML \
- Tools/datatype_abs_proofs.ML Tools/datatype_aux.ML \
- Tools/datatype_case.ML Tools/datatype_codegen.ML \
+ ATP_Linkup.thy Accessible_Part.thy Code_Generator.thy Datatype.thy \
+ Divides.thy Equiv_Relations.thy Extraction.thy Finite_Set.thy \
+ FixedPoint.thy Fun.thy FunDef.thy HOL.thy Hilbert_Choice.thy \
+ Inductive.thy IntArith.thy IntDef.thy IntDiv.thy Lattices.thy List.thy \
+ Main.thy Map.thy Nat.ML Nat.thy NatBin.thy NatSimprocs.thy Numeral.thy \
+ OrderedGroup.thy Orderings.thy Power.thy PreList.thy Predicate.thy \
+ Presburger.thy Product_Type.thy ROOT.ML Recdef.thy Record.thy \
+ Refute.thy Relation.thy Relation_Power.thy Ring_and_Field.thy SAT.thy \
+ Set.thy SetInterval.thy Sum_Type.thy Tools/ATP/reduce_axiomsN.ML \
+ Tools/ATP/watcher.ML Tools/Presburger/cooper_dec.ML \
+ Tools/Presburger/cooper_proof.ML Tools/Presburger/presburger.ML \
+ Tools/Presburger/qelim.ML Tools/Presburger/reflected_cooper.ML \
+ Tools/Presburger/reflected_presburger.ML Tools/TFL/dcterm.ML \
+ Tools/TFL/post.ML Tools/TFL/rules.ML Tools/TFL/tfl.ML \
+ Tools/TFL/thms.ML Tools/TFL/thry.ML Tools/TFL/usyntax.ML \
+ Tools/TFL/utils.ML Tools/cnf_funcs.ML Tools/datatype_abs_proofs.ML \
+ Tools/datatype_aux.ML Tools/datatype_case.ML Tools/datatype_codegen.ML \
Tools/datatype_hooks.ML Tools/datatype_package.ML \
Tools/datatype_prop.ML Tools/datatype_realizer.ML \
Tools/datatype_rep_proofs.ML Tools/function_package/auto_term.ML \
@@ -130,7 +127,7 @@
Tools/typedef_codegen.ML Tools/typedef_package.ML \
Transitive_Closure.thy Typedef.thy Wellfounded_Recursion.thy \
Wellfounded_Relations.thy arith_data.ML document/root.tex hologic.ML \
- simpdata.ML
+ int_arith1.ML int_factor_simprocs.ML nat_simprocs.ML simpdata.ML
@$(ISATOOL) usedir $(HOL_USEDIR_OPTIONS) -b -g true $(OUT)/Pure HOL
@@ -422,7 +419,7 @@
Auth/Guard/Proto.thy Auth/Guard/Guard_Yahalom.thy\
Auth/Smartcard/EventSC.thy Auth/Smartcard/ShoupRubinBella.thy\
Auth/Smartcard/ShoupRubin.thy Auth/Smartcard/Smartcard.thy\
- Auth/document/root.tex
+ Auth/document/root.tex
@$(ISATOOL) usedir -g true $(OUT)/HOL Auth
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/NatBin.thy Thu May 31 18:16:52 2007 +0200
@@ -0,0 +1,903 @@
+(* Title: HOL/NatBin.thy
+ ID: $Id$
+ Author: Lawrence C Paulson, Cambridge University Computer Laboratory
+ Copyright 1999 University of Cambridge
+*)
+
+header {* Binary arithmetic for the natural numbers *}
+
+theory NatBin
+imports IntDiv
+begin
+
+text {*
+ Arithmetic for naturals is reduced to that for the non-negative integers.
+*}
+
+instance nat :: number
+ nat_number_of_def [code inline]: "number_of v == nat (number_of (v\<Colon>int))" ..
+
+abbreviation (xsymbols)
+ square :: "'a::power => 'a" ("(_\<twosuperior>)" [1000] 999) where
+ "x\<twosuperior> == x^2"
+
+notation (latex output)
+ square ("(_\<twosuperior>)" [1000] 999)
+
+notation (HTML output)
+ square ("(_\<twosuperior>)" [1000] 999)
+
+
+subsection{*Function @{term nat}: Coercion from Type @{typ int} to @{typ nat}*}
+
+declare nat_0 [simp] 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 [simp]: "Numeral0 = (0::nat)"
+by (simp add: nat_number_of_def)
+
+lemma nat_numeral_1_eq_1 [simp]: "Numeral1 = (1::nat)"
+by (simp add: nat_1 nat_number_of_def)
+
+lemma numeral_1_eq_Suc_0: "Numeral1 = Suc 0"
+by (simp add: nat_numeral_1_eq_1)
+
+lemma numeral_2_eq_2: "2 = Suc (Suc 0)"
+apply (unfold nat_number_of_def)
+apply (rule nat_2)
+done
+
+
+text{*Distributive laws for type @{text nat}. The others are in theory
+ @{text IntArith}, but these require div and mod to be defined for type
+ "int". They also need some of the lemmas proved above.*}
+
+lemma nat_div_distrib: "(0::int) <= z ==> nat (z div z') = nat z div nat z'"
+apply (case_tac "0 <= z'")
+apply (auto simp add: div_nonneg_neg_le0 DIVISION_BY_ZERO_DIV)
+apply (case_tac "z' = 0", simp add: DIVISION_BY_ZERO)
+apply (auto elim!: nonneg_eq_int)
+apply (rename_tac m m')
+apply (subgoal_tac "0 <= int m div int m'")
+ prefer 2 apply (simp add: nat_numeral_0_eq_0 pos_imp_zdiv_nonneg_iff)
+apply (rule inj_int [THEN injD], simp)
+apply (rule_tac r = "int (m mod m') " in quorem_div)
+ prefer 2 apply force
+apply (simp add: nat_less_iff [symmetric] quorem_def nat_numeral_0_eq_0 zadd_int
+ zmult_int)
+done
+
+(*Fails if z'<0: the LHS collapses to (nat z) but the RHS doesn't*)
+lemma nat_mod_distrib:
+ "[| (0::int) <= z; 0 <= z' |] ==> nat (z mod z') = nat z mod nat z'"
+apply (case_tac "z' = 0", simp add: DIVISION_BY_ZERO)
+apply (auto elim!: nonneg_eq_int)
+apply (rename_tac m m')
+apply (subgoal_tac "0 <= int m mod int m'")
+ prefer 2 apply (simp add: nat_less_iff nat_numeral_0_eq_0 pos_mod_sign)
+apply (rule inj_int [THEN injD], simp)
+apply (rule_tac q = "int (m div m') " in quorem_mod)
+ prefer 2 apply force
+apply (simp add: nat_less_iff [symmetric] quorem_def nat_numeral_0_eq_0 zadd_int zmult_int)
+done
+
+text{*Suggested by Matthias Daum*}
+lemma int_div_less_self: "\<lbrakk>0 < x; 1 < k\<rbrakk> \<Longrightarrow> x div k < (x::int)"
+apply (subgoal_tac "nat x div nat k < nat x")
+ apply (simp (asm_lr) add: nat_div_distrib [symmetric])
+apply (rule Divides.div_less_dividend, simp_all)
+done
+
+subsection{*Function @{term int}: Coercion from Type @{typ nat} to @{typ int}*}
+
+(*"neg" is used in rewrite rules for binary comparisons*)
+lemma int_nat_number_of [simp]:
+ "int (number_of v :: nat) =
+ (if neg (number_of v :: int) then 0
+ else (number_of v :: int))"
+by (simp del: nat_number_of
+ add: neg_nat nat_number_of_def not_neg_nat add_assoc)
+
+
+subsubsection{*Successor *}
+
+lemma Suc_nat_eq_nat_zadd1: "(0::int) <= z ==> Suc (nat z) = nat (1 + z)"
+apply (rule sym)
+apply (simp add: nat_eq_iff int_Suc)
+done
+
+lemma Suc_nat_number_of_add:
+ "Suc (number_of v + n) =
+ (if neg (number_of v :: int) then 1+n else number_of (Numeral.succ v) + n)"
+by (simp del: nat_number_of
+ add: nat_number_of_def neg_nat
+ Suc_nat_eq_nat_zadd1 number_of_succ)
+
+lemma Suc_nat_number_of [simp]:
+ "Suc (number_of v) =
+ (if neg (number_of v :: int) then 1 else number_of (Numeral.succ v))"
+apply (cut_tac n = 0 in Suc_nat_number_of_add)
+apply (simp cong del: if_weak_cong)
+done
+
+
+subsubsection{*Addition *}
+
+(*"neg" is used in rewrite rules for binary comparisons*)
+lemma add_nat_number_of [simp]:
+ "(number_of v :: nat) + number_of v' =
+ (if neg (number_of v :: int) then number_of v'
+ else if neg (number_of v' :: int) then number_of v
+ else number_of (v + v'))"
+by (force dest!: neg_nat
+ simp del: nat_number_of
+ simp add: nat_number_of_def nat_add_distrib [symmetric])
+
+
+subsubsection{*Subtraction *}
+
+lemma diff_nat_eq_if:
+ "nat z - nat z' =
+ (if neg z' then nat z
+ else let d = z-z' in
+ if neg d then 0 else nat d)"
+apply (simp add: Let_def nat_diff_distrib [symmetric] neg_eq_less_0 not_neg_eq_ge_0)
+done
+
+lemma diff_nat_number_of [simp]:
+ "(number_of v :: nat) - number_of v' =
+ (if neg (number_of v' :: int) then number_of v
+ else let d = number_of (v + uminus v') in
+ if neg d then 0 else nat d)"
+by (simp del: nat_number_of add: diff_nat_eq_if nat_number_of_def)
+
+
+
+subsubsection{*Multiplication *}
+
+lemma mult_nat_number_of [simp]:
+ "(number_of v :: nat) * number_of v' =
+ (if neg (number_of v :: int) then 0 else number_of (v * v'))"
+by (force dest!: neg_nat
+ simp del: nat_number_of
+ simp add: nat_number_of_def nat_mult_distrib [symmetric])
+
+
+
+subsubsection{*Quotient *}
+
+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'))"
+by (force dest!: neg_nat
+ simp del: nat_number_of
+ simp add: nat_number_of_def nat_div_distrib [symmetric])
+
+lemma one_div_nat_number_of [simp]:
+ "(Suc 0) div number_of v' = (nat (1 div number_of v'))"
+by (simp del: nat_numeral_1_eq_1 add: numeral_1_eq_Suc_0 [symmetric])
+
+
+subsubsection{*Remainder *}
+
+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'))"
+by (force dest!: neg_nat
+ simp del: nat_number_of
+ simp add: nat_number_of_def nat_mod_distrib [symmetric])
+
+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: nat_numeral_1_eq_1 add: numeral_1_eq_Suc_0 [symmetric])
+
+
+subsubsection{* Divisibility *}
+
+lemmas dvd_eq_mod_eq_0_number_of =
+ dvd_eq_mod_eq_0 [of "number_of x" "number_of y", standard]
+
+declare dvd_eq_mod_eq_0_number_of [simp]
+
+ML
+{*
+val nat_number_of_def = thm"nat_number_of_def";
+
+val nat_number_of = thm"nat_number_of";
+val nat_numeral_0_eq_0 = thm"nat_numeral_0_eq_0";
+val nat_numeral_1_eq_1 = thm"nat_numeral_1_eq_1";
+val numeral_1_eq_Suc_0 = thm"numeral_1_eq_Suc_0";
+val numeral_2_eq_2 = thm"numeral_2_eq_2";
+val nat_div_distrib = thm"nat_div_distrib";
+val nat_mod_distrib = thm"nat_mod_distrib";
+val int_nat_number_of = thm"int_nat_number_of";
+val Suc_nat_eq_nat_zadd1 = thm"Suc_nat_eq_nat_zadd1";
+val Suc_nat_number_of_add = thm"Suc_nat_number_of_add";
+val Suc_nat_number_of = thm"Suc_nat_number_of";
+val add_nat_number_of = thm"add_nat_number_of";
+val diff_nat_eq_if = thm"diff_nat_eq_if";
+val diff_nat_number_of = thm"diff_nat_number_of";
+val mult_nat_number_of = thm"mult_nat_number_of";
+val div_nat_number_of = thm"div_nat_number_of";
+val mod_nat_number_of = thm"mod_nat_number_of";
+*}
+
+
+subsection{*Comparisons*}
+
+subsubsection{*Equals (=) *}
+
+lemma eq_nat_nat_iff:
+ "[| (0::int) <= z; 0 <= z' |] ==> (nat z = nat z') = (z=z')"
+by (auto elim!: nonneg_eq_int)
+
+(*"neg" is used in rewrite rules for binary comparisons*)
+lemma eq_nat_number_of [simp]:
+ "((number_of v :: nat) = number_of v') =
+ (if neg (number_of v :: int) then (iszero (number_of v' :: int) | neg (number_of v' :: int))
+ else if neg (number_of v' :: int) then iszero (number_of v :: int)
+ else iszero (number_of (v + uminus v') :: int))"
+apply (simp only: simp_thms neg_nat not_neg_eq_ge_0 nat_number_of_def
+ eq_nat_nat_iff eq_number_of_eq nat_0 iszero_def
+ split add: split_if cong add: imp_cong)
+apply (simp only: nat_eq_iff nat_eq_iff2)
+apply (simp add: not_neg_eq_ge_0 [symmetric])
+done
+
+
+subsubsection{*Less-than (<) *}
+
+(*"neg" is used in rewrite rules for binary comparisons*)
+lemma less_nat_number_of [simp]:
+ "((number_of v :: nat) < number_of v') =
+ (if neg (number_of v :: int) then neg (number_of (uminus v') :: int)
+ else neg (number_of (v + uminus v') :: int))"
+by (simp only: simp_thms neg_nat not_neg_eq_ge_0 nat_number_of_def
+ nat_less_eq_zless less_number_of_eq_neg zless_nat_eq_int_zless
+ cong add: imp_cong, simp add: Pls_def)
+
+
+(*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
+
+
+subsection{*Powers with Numeric Exponents*}
+
+text{*We cannot refer to the number @{term 2} in @{text Ring_and_Field.thy}.
+We cannot prove general results about the numeral @{term "-1"}, so we have to
+use @{term "- 1"} instead.*}
+
+lemma power2_eq_square: "(a::'a::{comm_semiring_1_cancel,recpower})\<twosuperior> = a * a"
+ by (simp add: numeral_2_eq_2 Power.power_Suc)
+
+lemma zero_power2 [simp]: "(0::'a::{comm_semiring_1_cancel,recpower})\<twosuperior> = 0"
+ by (simp add: power2_eq_square)
+
+lemma one_power2 [simp]: "(1::'a::{comm_semiring_1_cancel,recpower})\<twosuperior> = 1"
+ by (simp add: power2_eq_square)
+
+lemma power3_eq_cube: "(x::'a::recpower) ^ 3 = x * x * x"
+ apply (subgoal_tac "3 = Suc (Suc (Suc 0))")
+ apply (erule ssubst)
+ apply (simp add: power_Suc mult_ac)
+ apply (unfold nat_number_of_def)
+ apply (subst nat_eq_iff)
+ apply simp
+done
+
+text{*Squares of literal numerals will be evaluated.*}
+lemmas power2_eq_square_number_of =
+ power2_eq_square [of "number_of w", standard]
+declare power2_eq_square_number_of [simp]
+
+
+lemma zero_le_power2[simp]: "0 \<le> (a\<twosuperior>::'a::{ordered_idom,recpower})"
+ by (simp add: power2_eq_square)
+
+lemma zero_less_power2[simp]:
+ "(0 < a\<twosuperior>) = (a \<noteq> (0::'a::{ordered_idom,recpower}))"
+ by (force simp add: power2_eq_square zero_less_mult_iff linorder_neq_iff)
+
+lemma power2_less_0[simp]:
+ fixes a :: "'a::{ordered_idom,recpower}"
+ shows "~ (a\<twosuperior> < 0)"
+by (force simp add: power2_eq_square mult_less_0_iff)
+
+lemma zero_eq_power2[simp]:
+ "(a\<twosuperior> = 0) = (a = (0::'a::{ordered_idom,recpower}))"
+ by (force simp add: power2_eq_square mult_eq_0_iff)
+
+lemma abs_power2[simp]:
+ "abs(a\<twosuperior>) = (a\<twosuperior>::'a::{ordered_idom,recpower})"
+ by (simp add: power2_eq_square abs_mult abs_mult_self)
+
+lemma power2_abs[simp]:
+ "(abs a)\<twosuperior> = (a\<twosuperior>::'a::{ordered_idom,recpower})"
+ by (simp add: power2_eq_square abs_mult_self)
+
+lemma power2_minus[simp]:
+ "(- a)\<twosuperior> = (a\<twosuperior>::'a::{comm_ring_1,recpower})"
+ by (simp add: power2_eq_square)
+
+lemma power2_le_imp_le:
+ fixes x y :: "'a::{ordered_semidom,recpower}"
+ shows "\<lbrakk>x\<twosuperior> \<le> y\<twosuperior>; 0 \<le> y\<rbrakk> \<Longrightarrow> x \<le> y"
+unfolding numeral_2_eq_2 by (rule power_le_imp_le_base)
+
+lemma power2_less_imp_less:
+ fixes x y :: "'a::{ordered_semidom,recpower}"
+ shows "\<lbrakk>x\<twosuperior> < y\<twosuperior>; 0 \<le> y\<rbrakk> \<Longrightarrow> x < y"
+by (rule power_less_imp_less_base)
+
+lemma power2_eq_imp_eq:
+ fixes x y :: "'a::{ordered_semidom,recpower}"
+ shows "\<lbrakk>x\<twosuperior> = y\<twosuperior>; 0 \<le> x; 0 \<le> y\<rbrakk> \<Longrightarrow> x = y"
+unfolding numeral_2_eq_2 by (erule (2) power_eq_imp_eq_base, simp)
+
+lemma power_minus1_even[simp]: "(- 1) ^ (2*n) = (1::'a::{comm_ring_1,recpower})"
+apply (induct "n")
+apply (auto simp add: power_Suc power_add)
+done
+
+lemma power_even_eq: "(a::'a::recpower) ^ (2*n) = (a^n)^2"
+by (subst mult_commute) (simp add: power_mult)
+
+lemma power_odd_eq: "(a::int) ^ Suc(2*n) = a * (a^n)^2"
+by (simp add: power_even_eq)
+
+lemma power_minus_even [simp]:
+ "(-a) ^ (2*n) = (a::'a::{comm_ring_1,recpower}) ^ (2*n)"
+by (simp add: power_minus1_even power_minus [of a])
+
+lemma zero_le_even_power'[simp]:
+ "0 \<le> (a::'a::{ordered_idom,recpower}) ^ (2*n)"
+proof (induct "n")
+ case 0
+ show ?case by (simp add: zero_le_one)
+next
+ case (Suc n)
+ have "a ^ (2 * Suc n) = (a*a) * a ^ (2*n)"
+ by (simp add: mult_ac power_add power2_eq_square)
+ thus ?case
+ by (simp add: prems zero_le_mult_iff)
+qed
+
+lemma odd_power_less_zero:
+ "(a::'a::{ordered_idom,recpower}) < 0 ==> a ^ Suc(2*n) < 0"
+proof (induct "n")
+ case 0
+ show ?case by (simp add: Power.power_Suc)
+next
+ case (Suc n)
+ have "a ^ Suc (2 * Suc n) = (a*a) * a ^ Suc(2*n)"
+ by (simp add: mult_ac power_add power2_eq_square Power.power_Suc)
+ thus ?case
+ by (simp add: prems mult_less_0_iff mult_neg_neg)
+qed
+
+lemma odd_0_le_power_imp_0_le:
+ "0 \<le> a ^ Suc(2*n) ==> 0 \<le> (a::'a::{ordered_idom,recpower})"
+apply (insert odd_power_less_zero [of a n])
+apply (force simp add: linorder_not_less [symmetric])
+done
+
+text{*Simprules for comparisons where common factors can be cancelled.*}
+lemmas zero_compare_simps =
+ add_strict_increasing add_strict_increasing2 add_increasing
+ zero_le_mult_iff zero_le_divide_iff
+ zero_less_mult_iff zero_less_divide_iff
+ mult_le_0_iff divide_le_0_iff
+ mult_less_0_iff divide_less_0_iff
+ zero_le_power2 power2_less_0
+
+subsubsection{*Nat *}
+
+lemma Suc_pred': "0 < n ==> n = Suc(n - 1)"
+by (simp add: numerals)
+
+(*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", standard]
+
+subsubsection{*Arith *}
+
+lemma Suc_eq_add_numeral_1: "Suc n = n + 1"
+by (simp add: numerals)
+
+lemma Suc_eq_add_numeral_1_left: "Suc n = 1 + n"
+by (simp add: numerals)
+
+(* These two can be useful when m = number_of... *)
+
+lemma add_eq_if: "(m::nat) + n = (if m=0 then n else Suc ((m - 1) + n))"
+apply (case_tac "m")
+apply (simp_all add: numerals)
+done
+
+lemma mult_eq_if: "(m::nat) * n = (if m=0 then 0 else n + ((m - 1) * n))"
+apply (case_tac "m")
+apply (simp_all add: numerals)
+done
+
+lemma power_eq_if: "(p ^ m :: nat) = (if m=0 then 1 else p * (p ^ (m - 1)))"
+apply (case_tac "m")
+apply (simp_all add: numerals)
+done
+
+
+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)) =
+ (if neg (number_of v :: int) then True else iszero (number_of v :: int))"
+by (simp del: nat_numeral_0_eq_0 add: nat_numeral_0_eq_0 [symmetric] iszero_0)
+
+lemma eq_0_number_of [simp]:
+ "((0::nat) = number_of v) =
+ (if neg (number_of v :: int) then True else iszero (number_of v :: int))"
+by (rule trans [OF eq_sym_conv eq_number_of_0])
+
+lemma less_0_number_of [simp]:
+ "((0::nat) < number_of v) = neg (number_of (uminus v) :: int)"
+by (simp del: nat_numeral_0_eq_0 add: nat_numeral_0_eq_0 [symmetric] Pls_def)
+
+
+lemma neg_imp_number_of_eq_0: "neg (number_of v :: int) ==> number_of v = (0::nat)"
+by (simp del: nat_numeral_0_eq_0 add: nat_numeral_0_eq_0 [symmetric] iszero_0)
+
+
+
+subsection{*Comparisons involving @{term Suc} *}
+
+lemma eq_number_of_Suc [simp]:
+ "(number_of v = Suc n) =
+ (let pv = number_of (Numeral.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 Suc_eq_number_of [simp]:
+ "(Suc n = number_of v) =
+ (let pv = number_of (Numeral.pred v) in
+ if neg pv then False else nat pv = n)"
+by (rule trans [OF eq_sym_conv eq_number_of_Suc])
+
+lemma less_number_of_Suc [simp]:
+ "(number_of v < Suc n) =
+ (let pv = number_of (Numeral.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_Suc_number_of [simp]:
+ "(Suc n < number_of v) =
+ (let pv = number_of (Numeral.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 le_number_of_Suc [simp]:
+ "(number_of v <= Suc n) =
+ (let pv = number_of (Numeral.pred v) in
+ if neg pv then True else nat pv <= n)"
+by (simp add: Let_def less_Suc_number_of linorder_not_less [symmetric])
+
+lemma le_Suc_number_of [simp]:
+ "(Suc n <= number_of v) =
+ (let pv = number_of (Numeral.pred v) in
+ if neg pv then False else n <= nat pv)"
+by (simp add: Let_def less_number_of_Suc linorder_not_less [symmetric])
+
+
+(* Push int(.) inwards: *)
+declare zadd_int [symmetric, simp]
+
+lemma lemma1: "(m+m = n+n) = (m = (n::int))"
+by auto
+
+lemma lemma2: "m+m ~= (1::int) + (n + n)"
+apply auto
+apply (drule_tac f = "%x. x mod 2" in arg_cong)
+apply (simp add: zmod_zadd1_eq)
+done
+
+lemma eq_number_of_BIT_BIT:
+ "((number_of (v BIT x) ::int) = number_of (w BIT y)) =
+ (x=y & (((number_of v) ::int) = number_of w))"
+apply (simp only: number_of_BIT lemma1 lemma2 eq_commute
+ OrderedGroup.add_left_cancel add_assoc OrderedGroup.add_0_left
+ split add: bit.split)
+apply simp
+done
+
+lemma eq_number_of_BIT_Pls:
+ "((number_of (v BIT x) ::int) = Numeral0) =
+ (x=bit.B0 & (((number_of v) ::int) = Numeral0))"
+apply (simp only: simp_thms add: number_of_BIT number_of_Pls eq_commute
+ split add: bit.split cong: imp_cong)
+apply (rule_tac x = "number_of v" in spec, safe)
+apply (simp_all (no_asm_use))
+apply (drule_tac f = "%x. x mod 2" in arg_cong)
+apply (simp add: zmod_zadd1_eq)
+done
+
+lemma eq_number_of_BIT_Min:
+ "((number_of (v BIT x) ::int) = number_of Numeral.Min) =
+ (x=bit.B1 & (((number_of v) ::int) = number_of Numeral.Min))"
+apply (simp only: simp_thms add: number_of_BIT number_of_Min eq_commute
+ split add: bit.split cong: imp_cong)
+apply (rule_tac x = "number_of v" in spec, auto)
+apply (drule_tac f = "%x. x mod 2" in arg_cong, auto)
+done
+
+lemma eq_number_of_Pls_Min: "(Numeral0 ::int) ~= number_of Numeral.Min"
+by auto
+
+
+
+subsection{*Max and Min Combined with @{term Suc} *}
+
+lemma max_number_of_Suc [simp]:
+ "max (Suc n) (number_of v) =
+ (let pv = number_of (Numeral.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 (Numeral.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 (Numeral.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 (Numeral.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
+
+subsection{*Literal arithmetic involving powers*}
+
+lemma nat_power_eq: "(0::int) <= z ==> nat (z^n) = nat z ^ n"
+apply (induct "n")
+apply (simp_all (no_asm_simp) add: nat_mult_distrib)
+done
+
+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)
+
+
+lemmas power_nat_number_of_number_of = power_nat_number_of [of _ "number_of w", standard]
+declare power_nat_number_of_number_of [simp]
+
+
+
+text{*For the integers*}
+
+lemma zpower_number_of_even:
+ "(z::int) ^ number_of (w BIT bit.B0) = (let w = z ^ (number_of w) in w * w)"
+unfolding Let_def nat_number_of_def number_of_BIT bit.cases
+apply (rule_tac x = "number_of w" in spec, clarify)
+apply (case_tac " (0::int) <= x")
+apply (auto simp add: nat_mult_distrib power_even_eq power2_eq_square)
+done
+
+lemma zpower_number_of_odd:
+ "(z::int) ^ number_of (w BIT bit.B1) = (if (0::int) <= number_of w
+ then (let w = z ^ (number_of w) in z * w * w) else 1)"
+unfolding Let_def nat_number_of_def number_of_BIT bit.cases
+apply (rule_tac x = "number_of w" in spec, auto)
+apply (simp only: nat_add_distrib nat_mult_distrib)
+apply simp
+apply (auto simp add: nat_add_distrib nat_mult_distrib power_even_eq power2_eq_square neg_nat)
+done
+
+lemmas zpower_number_of_even_number_of =
+ zpower_number_of_even [of "number_of v", standard]
+declare zpower_number_of_even_number_of [simp]
+
+lemmas zpower_number_of_odd_number_of =
+ zpower_number_of_odd [of "number_of v", standard]
+declare zpower_number_of_odd_number_of [simp]
+
+
+
+
+ML
+{*
+val numerals = thms"numerals";
+val numeral_ss = simpset() addsimps numerals;
+
+val nat_bin_arith_setup =
+ Fast_Arith.map_data
+ (fn {add_mono_thms, mult_mono_thms, inj_thms, lessD, neqE, simpset} =>
+ {add_mono_thms = add_mono_thms, mult_mono_thms = mult_mono_thms,
+ inj_thms = inj_thms,
+ lessD = lessD, neqE = neqE,
+ simpset = simpset addsimps [Suc_nat_number_of, int_nat_number_of,
+ not_neg_number_of_Pls,
+ neg_number_of_Min,neg_number_of_BIT]})
+*}
+
+setup nat_bin_arith_setup
+
+(* Enable arith to deal with div/mod k where k is a numeral: *)
+declare split_div[of _ _ "number_of k", standard, arith_split]
+declare split_mod[of _ _ "number_of k", standard, arith_split]
+
+lemma nat_number_of_Pls: "Numeral0 = (0::nat)"
+ by (simp add: number_of_Pls nat_number_of_def)
+
+lemma nat_number_of_Min: "number_of Numeral.Min = (0::nat)"
+ apply (simp only: number_of_Min nat_number_of_def nat_zminus_int)
+ done
+
+lemma nat_number_of_BIT_1:
+ "number_of (w BIT bit.B1) =
+ (if neg (number_of w :: int) then 0
+ else let n = number_of w in Suc (n + n))"
+ apply (simp only: nat_number_of_def Let_def split: split_if)
+ apply (intro conjI impI)
+ apply (simp add: neg_nat neg_number_of_BIT)
+ apply (rule int_int_eq [THEN iffD1])
+ apply (simp only: not_neg_nat neg_number_of_BIT int_Suc zadd_int [symmetric] simp_thms)
+ apply (simp only: number_of_BIT zadd_assoc split: bit.split)
+ apply simp
+ done
+
+lemma nat_number_of_BIT_0:
+ "number_of (w BIT bit.B0) = (let n::nat = number_of w in n + n)"
+ apply (simp only: nat_number_of_def Let_def)
+ apply (cases "neg (number_of w :: int)")
+ apply (simp add: neg_nat neg_number_of_BIT)
+ apply (rule int_int_eq [THEN iffD1])
+ apply (simp only: not_neg_nat neg_number_of_BIT int_Suc zadd_int [symmetric] simp_thms)
+ apply (simp only: number_of_BIT zadd_assoc)
+ apply simp
+ done
+
+lemmas nat_number =
+ nat_number_of_Pls nat_number_of_Min
+ nat_number_of_BIT_1 nat_number_of_BIT_0
+
+lemma Let_Suc [simp]: "Let (Suc n) f == f (Suc n)"
+ by (simp add: Let_def)
+
+lemma power_m1_even: "(-1) ^ (2*n) = (1::'a::{number_ring,recpower})"
+by (simp add: power_mult);
+
+lemma power_m1_odd: "(-1) ^ Suc(2*n) = (-1::'a::{number_ring,recpower})"
+by (simp add: power_mult power_Suc);
+
+
+subsection{*Literal arithmetic and @{term of_nat}*}
+
+lemma of_nat_double:
+ "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_ring)
+ else 0)"
+by (simp add: int_number_of_def nat_number_of_def number_of_eq of_nat_nat);
+
+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_ring))"
+by (simp only: of_nat_number_of_lemma neg_def, simp)
+
+
+subsection {*Lemmas for the Combination and Cancellation Simprocs*}
+
+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 simp
+
+lemma nat_number_of_mult_left:
+ "number_of v * (number_of v' * (k::nat)) =
+ (if neg (number_of v :: int) then 0
+ else number_of (v * v') * k)"
+by simp
+
+
+subsubsection{*For @{text combine_numerals}*}
+
+lemma left_add_mult_distrib: "i*u + (j*u + k) = (i+j)*u + (k::nat)"
+by (simp add: add_mult_distrib)
+
+
+subsubsection{*For @{text cancel_numerals}*}
+
+lemma nat_diff_add_eq1:
+ "j <= (i::nat) ==> ((i*u + m) - (j*u + n)) = (((i-j)*u + m) - n)"
+by (simp split add: nat_diff_split add: add_mult_distrib)
+
+lemma nat_diff_add_eq2:
+ "i <= (j::nat) ==> ((i*u + m) - (j*u + n)) = (m - ((j-i)*u + n))"
+by (simp split add: nat_diff_split add: add_mult_distrib)
+
+lemma nat_eq_add_iff1:
+ "j <= (i::nat) ==> (i*u + m = j*u + n) = ((i-j)*u + m = n)"
+by (auto split add: nat_diff_split simp add: add_mult_distrib)
+
+lemma nat_eq_add_iff2:
+ "i <= (j::nat) ==> (i*u + m = j*u + n) = (m = (j-i)*u + n)"
+by (auto split add: nat_diff_split simp add: add_mult_distrib)
+
+lemma nat_less_add_iff1:
+ "j <= (i::nat) ==> (i*u + m < j*u + n) = ((i-j)*u + m < n)"
+by (auto split add: nat_diff_split simp add: add_mult_distrib)
+
+lemma nat_less_add_iff2:
+ "i <= (j::nat) ==> (i*u + m < j*u + n) = (m < (j-i)*u + n)"
+by (auto split add: nat_diff_split simp add: add_mult_distrib)
+
+lemma nat_le_add_iff1:
+ "j <= (i::nat) ==> (i*u + m <= j*u + n) = ((i-j)*u + m <= n)"
+by (auto split add: nat_diff_split simp add: add_mult_distrib)
+
+lemma nat_le_add_iff2:
+ "i <= (j::nat) ==> (i*u + m <= j*u + n) = (m <= (j-i)*u + n)"
+by (auto split add: nat_diff_split simp add: add_mult_distrib)
+
+
+subsubsection{*For @{text cancel_numeral_factors} *}
+
+lemma nat_mult_le_cancel1: "(0::nat) < k ==> (k*m <= k*n) = (m<=n)"
+by auto
+
+lemma nat_mult_less_cancel1: "(0::nat) < k ==> (k*m < k*n) = (m<n)"
+by auto
+
+lemma nat_mult_eq_cancel1: "(0::nat) < k ==> (k*m = k*n) = (m=n)"
+by auto
+
+lemma nat_mult_div_cancel1: "(0::nat) < k ==> (k*m) div (k*n) = (m div n)"
+by auto
+
+
+subsubsection{*For @{text cancel_factor} *}
+
+lemma nat_mult_le_cancel_disj: "(k*m <= k*n) = ((0::nat) < k --> m<=n)"
+by auto
+
+lemma nat_mult_less_cancel_disj: "(k*m < k*n) = ((0::nat) < k & m<n)"
+by auto
+
+lemma nat_mult_eq_cancel_disj: "(k*m = k*n) = (k = (0::nat) | m=n)"
+by auto
+
+lemma nat_mult_div_cancel_disj:
+ "(k*m) div (k*n) = (if k = (0::nat) then 0 else m div n)"
+by (simp add: nat_mult_div_cancel1)
+
+
+subsection {* legacy ML bindings *}
+
+ML
+{*
+val eq_nat_nat_iff = thm"eq_nat_nat_iff";
+val eq_nat_number_of = thm"eq_nat_number_of";
+val less_nat_number_of = thm"less_nat_number_of";
+val power2_eq_square = thm "power2_eq_square";
+val zero_le_power2 = thm "zero_le_power2";
+val zero_less_power2 = thm "zero_less_power2";
+val zero_eq_power2 = thm "zero_eq_power2";
+val abs_power2 = thm "abs_power2";
+val power2_abs = thm "power2_abs";
+val power2_minus = thm "power2_minus";
+val power_minus1_even = thm "power_minus1_even";
+val power_minus_even = thm "power_minus_even";
+val odd_power_less_zero = thm "odd_power_less_zero";
+val odd_0_le_power_imp_0_le = thm "odd_0_le_power_imp_0_le";
+
+val Suc_pred' = thm"Suc_pred'";
+val expand_Suc = thm"expand_Suc";
+val Suc_eq_add_numeral_1 = thm"Suc_eq_add_numeral_1";
+val Suc_eq_add_numeral_1_left = thm"Suc_eq_add_numeral_1_left";
+val add_eq_if = thm"add_eq_if";
+val mult_eq_if = thm"mult_eq_if";
+val power_eq_if = thm"power_eq_if";
+val eq_number_of_0 = thm"eq_number_of_0";
+val eq_0_number_of = thm"eq_0_number_of";
+val less_0_number_of = thm"less_0_number_of";
+val neg_imp_number_of_eq_0 = thm"neg_imp_number_of_eq_0";
+val eq_number_of_Suc = thm"eq_number_of_Suc";
+val Suc_eq_number_of = thm"Suc_eq_number_of";
+val less_number_of_Suc = thm"less_number_of_Suc";
+val less_Suc_number_of = thm"less_Suc_number_of";
+val le_number_of_Suc = thm"le_number_of_Suc";
+val le_Suc_number_of = thm"le_Suc_number_of";
+val eq_number_of_BIT_BIT = thm"eq_number_of_BIT_BIT";
+val eq_number_of_BIT_Pls = thm"eq_number_of_BIT_Pls";
+val eq_number_of_BIT_Min = thm"eq_number_of_BIT_Min";
+val eq_number_of_Pls_Min = thm"eq_number_of_Pls_Min";
+val of_nat_number_of_eq = thm"of_nat_number_of_eq";
+val nat_power_eq = thm"nat_power_eq";
+val power_nat_number_of = thm"power_nat_number_of";
+val zpower_number_of_even = thm"zpower_number_of_even";
+val zpower_number_of_odd = thm"zpower_number_of_odd";
+val nat_number_of_Pls = thm"nat_number_of_Pls";
+val nat_number_of_Min = thm"nat_number_of_Min";
+val Let_Suc = thm"Let_Suc";
+
+val nat_number = thms"nat_number";
+
+val nat_number_of_add_left = thm"nat_number_of_add_left";
+val nat_number_of_mult_left = thm"nat_number_of_mult_left";
+val left_add_mult_distrib = thm"left_add_mult_distrib";
+val nat_diff_add_eq1 = thm"nat_diff_add_eq1";
+val nat_diff_add_eq2 = thm"nat_diff_add_eq2";
+val nat_eq_add_iff1 = thm"nat_eq_add_iff1";
+val nat_eq_add_iff2 = thm"nat_eq_add_iff2";
+val nat_less_add_iff1 = thm"nat_less_add_iff1";
+val nat_less_add_iff2 = thm"nat_less_add_iff2";
+val nat_le_add_iff1 = thm"nat_le_add_iff1";
+val nat_le_add_iff2 = thm"nat_le_add_iff2";
+val nat_mult_le_cancel1 = thm"nat_mult_le_cancel1";
+val nat_mult_less_cancel1 = thm"nat_mult_less_cancel1";
+val nat_mult_eq_cancel1 = thm"nat_mult_eq_cancel1";
+val nat_mult_div_cancel1 = thm"nat_mult_div_cancel1";
+val nat_mult_le_cancel_disj = thm"nat_mult_le_cancel_disj";
+val nat_mult_less_cancel_disj = thm"nat_mult_less_cancel_disj";
+val nat_mult_eq_cancel_disj = thm"nat_mult_eq_cancel_disj";
+val nat_mult_div_cancel_disj = thm"nat_mult_div_cancel_disj";
+
+val power_minus_even = thm"power_minus_even";
+*}
+
+end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/NatSimprocs.thy Thu May 31 18:16:52 2007 +0200
@@ -0,0 +1,391 @@
+(* Title: HOL/NatSimprocs.thy
+ ID: $Id$
+ Copyright 2003 TU Muenchen
+*)
+
+header {*Simprocs for the Naturals*}
+
+theory NatSimprocs
+imports NatBin
+uses "int_factor_simprocs.ML" "nat_simprocs.ML"
+begin
+
+setup nat_simprocs_setup
+
+subsection{*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)"
+by (simp add: numeral_0_eq_0 numeral_1_eq_1 split add: 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 (Numeral.pred v)::int) = (number_of v = (0::nat))"
+apply (subgoal_tac "neg (number_of (Numeral.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:
+ "neg (number_of (uminus v)::int) ==>
+ Suc m - (number_of v) = m - (number_of (Numeral.pred v))"
+apply (subst Suc_diff_eq_diff_pred)
+apply simp
+apply (simp del: nat_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 diff_Suc_eq_diff_pred: "m - Suc n = (m - 1) - n"
+by (simp add: numerals split add: nat_diff_split)
+
+
+subsection{*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 (Numeral.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_add_eq_if [simp]:
+ "nat_case a f ((number_of v) + n) =
+ (let pv = number_of (Numeral.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: nat_numeral_1_eq_1
+ add: numeral_1_eq_Suc_0 [symmetric] Let_def
+ neg_imp_number_of_eq_0 neg_number_of_pred_iff_0)
+done
+
+lemma nat_rec_number_of [simp]:
+ "nat_rec a f (number_of v) =
+ (let pv = number_of (Numeral.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_add_eq_if [simp]:
+ "nat_rec a f (number_of v + n) =
+ (let pv = number_of (Numeral.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: nat_numeral_1_eq_1
+ add: numeral_1_eq_Suc_0 [symmetric] Let_def neg_imp_number_of_eq_0
+ neg_number_of_pred_iff_0)
+done
+
+
+subsection{*Various Other Lemmas*}
+
+subsubsection{*Evens and Odds, for Mutilated Chess Board*}
+
+text{*Lemmas for specialist use, NOT as default simprules*}
+lemma nat_mult_2: "2 * z = (z+z::nat)"
+proof -
+ have "2*z = (1 + 1)*z" by simp
+ also have "... = z+z" by (simp add: left_distrib)
+ finally show ?thesis .
+qed
+
+lemma nat_mult_2_right: "z * 2 = (z+z::nat)"
+by (subst mult_commute, rule nat_mult_2)
+
+text{*Case analysis on @{term "n<2"}*}
+lemma less_2_cases: "(n::nat) < 2 ==> n = 0 | n = Suc 0"
+by arith
+
+lemma div2_Suc_Suc [simp]: "Suc(Suc m) div 2 = Suc (m div 2)"
+by arith
+
+lemma add_self_div_2 [simp]: "(m + m) div 2 = (m::nat)"
+by (simp add: nat_mult_2 [symmetric])
+
+lemma mod2_Suc_Suc [simp]: "Suc(Suc(m)) mod 2 = m mod 2"
+apply (subgoal_tac "m mod 2 < 2")
+apply (erule less_2_cases [THEN disjE])
+apply (simp_all (no_asm_simp) add: Let_def mod_Suc nat_1)
+done
+
+lemma mod2_gr_0 [simp]: "!!m::nat. (0 < m mod 2) = (m mod 2 = 1)"
+apply (subgoal_tac "m mod 2 < 2")
+apply (force simp del: mod_less_divisor, simp)
+done
+
+subsubsection{*Removal of Small Numerals: 0, 1 and (in additive positions) 2*}
+
+lemma add_2_eq_Suc [simp]: "2 + n = Suc (Suc n)"
+by simp
+
+lemma add_2_eq_Suc' [simp]: "n + 2 = Suc (Suc n)"
+by simp
+
+text{*Can be used to eliminate long strings of Sucs, but not by default*}
+lemma Suc3_eq_add_3: "Suc (Suc (Suc n)) = 3 + n"
+by simp
+
+
+text{*These lemmas collapse some needless occurrences of Suc:
+ at least three Sucs, since two and fewer are rewritten back to Suc again!
+ We already have some rules to simplify operands smaller than 3.*}
+
+lemma div_Suc_eq_div_add3 [simp]: "m div (Suc (Suc (Suc n))) = m div (3+n)"
+by (simp add: Suc3_eq_add_3)
+
+lemma mod_Suc_eq_mod_add3 [simp]: "m mod (Suc (Suc (Suc n))) = m mod (3+n)"
+by (simp add: Suc3_eq_add_3)
+
+lemma Suc_div_eq_add3_div: "(Suc (Suc (Suc m))) div n = (3+m) div n"
+by (simp add: Suc3_eq_add_3)
+
+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 =
+ Suc_div_eq_add3_div [of _ "number_of v", standard]
+declare Suc_div_eq_add3_div_number_of [simp]
+
+lemmas Suc_mod_eq_add3_mod_number_of =
+ Suc_mod_eq_add3_mod [of _ "number_of v", standard]
+declare Suc_mod_eq_add3_mod_number_of [simp]
+
+
+
+subsection{*Special Simplification for Constants*}
+
+text{*These belong here, late in the development of HOL, to prevent their
+interfering with proofs of abstract properties of instances of the function
+@{term number_of}*}
+
+text{*These distributive laws move literals inside sums and differences.*}
+lemmas left_distrib_number_of = left_distrib [of _ _ "number_of v", standard]
+declare left_distrib_number_of [simp]
+
+lemmas right_distrib_number_of = right_distrib [of "number_of v", standard]
+declare right_distrib_number_of [simp]
+
+
+lemmas left_diff_distrib_number_of =
+ left_diff_distrib [of _ _ "number_of v", standard]
+declare left_diff_distrib_number_of [simp]
+
+lemmas right_diff_distrib_number_of =
+ right_diff_distrib [of "number_of v", standard]
+declare right_diff_distrib_number_of [simp]
+
+
+text{*These are actually for fields, like real: but where else to put them?*}
+lemmas zero_less_divide_iff_number_of =
+ zero_less_divide_iff [of "number_of w", standard]
+declare zero_less_divide_iff_number_of [simp]
+
+lemmas divide_less_0_iff_number_of =
+ divide_less_0_iff [of "number_of w", standard]
+declare divide_less_0_iff_number_of [simp]
+
+lemmas zero_le_divide_iff_number_of =
+ zero_le_divide_iff [of "number_of w", standard]
+declare zero_le_divide_iff_number_of [simp]
+
+lemmas divide_le_0_iff_number_of =
+ divide_le_0_iff [of "number_of w", standard]
+declare divide_le_0_iff_number_of [simp]
+
+
+(****
+IF times_divide_eq_right and times_divide_eq_left are removed as simprules,
+then these special-case declarations may be useful.
+
+text{*These simprules move numerals into numerators and denominators.*}
+lemma times_recip_eq_right [simp]: "a * (1/c) = a / (c::'a::field)"
+by (simp add: times_divide_eq)
+
+lemma times_recip_eq_left [simp]: "(1/c) * a = a / (c::'a::field)"
+by (simp add: times_divide_eq)
+
+lemmas times_divide_eq_right_number_of =
+ times_divide_eq_right [of "number_of w", standard]
+declare times_divide_eq_right_number_of [simp]
+
+lemmas times_divide_eq_right_number_of =
+ times_divide_eq_right [of _ _ "number_of w", standard]
+declare times_divide_eq_right_number_of [simp]
+
+lemmas times_divide_eq_left_number_of =
+ times_divide_eq_left [of _ "number_of w", standard]
+declare times_divide_eq_left_number_of [simp]
+
+lemmas times_divide_eq_left_number_of =
+ times_divide_eq_left [of _ _ "number_of w", standard]
+declare times_divide_eq_left_number_of [simp]
+
+****)
+
+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 =
+ inverse_eq_divide [of "number_of w", standard]
+declare inverse_eq_divide_number_of [simp]
+
+
+subsubsection{*These laws simplify inequalities, moving unary minus from a term
+into the literal.*}
+lemmas less_minus_iff_number_of =
+ less_minus_iff [of "number_of v", standard]
+declare less_minus_iff_number_of [simp]
+
+lemmas le_minus_iff_number_of =
+ le_minus_iff [of "number_of v", standard]
+declare le_minus_iff_number_of [simp]
+
+lemmas equation_minus_iff_number_of =
+ equation_minus_iff [of "number_of v", standard]
+declare equation_minus_iff_number_of [simp]
+
+
+lemmas minus_less_iff_number_of =
+ minus_less_iff [of _ "number_of v", standard]
+declare minus_less_iff_number_of [simp]
+
+lemmas minus_le_iff_number_of =
+ minus_le_iff [of _ "number_of v", standard]
+declare minus_le_iff_number_of [simp]
+
+lemmas minus_equation_iff_number_of =
+ minus_equation_iff [of _ "number_of v", standard]
+declare minus_equation_iff_number_of [simp]
+
+
+subsubsection{*To Simplify Inequalities Where One Side is the Constant 1*}
+
+lemma less_minus_iff_1 [simp]:
+ fixes b::"'b::{ordered_idom,number_ring}"
+ shows "(1 < - b) = (b < -1)"
+by auto
+
+lemma le_minus_iff_1 [simp]:
+ fixes b::"'b::{ordered_idom,number_ring}"
+ shows "(1 \<le> - b) = (b \<le> -1)"
+by auto
+
+lemma equation_minus_iff_1 [simp]:
+ fixes b::"'b::number_ring"
+ shows "(1 = - b) = (b = -1)"
+by (subst equation_minus_iff, auto)
+
+lemma minus_less_iff_1 [simp]:
+ fixes a::"'b::{ordered_idom,number_ring}"
+ shows "(- a < 1) = (-1 < a)"
+by auto
+
+lemma minus_le_iff_1 [simp]:
+ fixes a::"'b::{ordered_idom,number_ring}"
+ shows "(- a \<le> 1) = (-1 \<le> a)"
+by auto
+
+lemma minus_equation_iff_1 [simp]:
+ fixes a::"'b::number_ring"
+ shows "(- a = 1) = (a = -1)"
+by (subst minus_equation_iff, auto)
+
+
+subsubsection {*Cancellation of constant factors in comparisons (@{text "<"} and @{text "\<le>"}) *}
+
+lemmas mult_less_cancel_left_number_of =
+ mult_less_cancel_left [of "number_of v", standard]
+declare mult_less_cancel_left_number_of [simp]
+
+lemmas mult_less_cancel_right_number_of =
+ mult_less_cancel_right [of _ "number_of v", standard]
+declare mult_less_cancel_right_number_of [simp]
+
+lemmas mult_le_cancel_left_number_of =
+ mult_le_cancel_left [of "number_of v", standard]
+declare mult_le_cancel_left_number_of [simp]
+
+lemmas mult_le_cancel_right_number_of =
+ mult_le_cancel_right [of _ "number_of v", standard]
+declare mult_le_cancel_right_number_of [simp]
+
+
+subsubsection {*Multiplying out constant divisors in comparisons (@{text "<"}, @{text "\<le>"} and @{text "="}) *}
+
+lemmas le_divide_eq_number_of = le_divide_eq [of _ _ "number_of w", standard]
+declare le_divide_eq_number_of [simp]
+
+lemmas divide_le_eq_number_of = divide_le_eq [of _ "number_of w", standard]
+declare divide_le_eq_number_of [simp]
+
+lemmas less_divide_eq_number_of = less_divide_eq [of _ _ "number_of w", standard]
+declare less_divide_eq_number_of [simp]
+
+lemmas divide_less_eq_number_of = divide_less_eq [of _ "number_of w", standard]
+declare divide_less_eq_number_of [simp]
+
+lemmas eq_divide_eq_number_of = eq_divide_eq [of _ _ "number_of w", standard]
+declare eq_divide_eq_number_of [simp]
+
+lemmas divide_eq_eq_number_of = divide_eq_eq [of _ "number_of w", standard]
+declare divide_eq_eq_number_of [simp]
+
+
+
+subsection{*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", standard]
+lemmas divide_le_eq_number_of = divide_le_eq [of _ _ "number_of w", standard]
+lemmas less_divide_eq_number_of = less_divide_eq [of "number_of w", standard]
+lemmas divide_less_eq_number_of = divide_less_eq [of _ _ "number_of w", standard]
+lemmas eq_divide_eq_number_of = eq_divide_eq [of "number_of w", standard]
+lemmas divide_eq_eq_number_of = divide_eq_eq [of _ _ "number_of w", standard]
+
+
+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_1 divide_le_eq_1 less_divide_eq_1 divide_less_eq_1
+
+subsubsection{*Division By @{text "-1"}*}
+
+lemma divide_minus1 [simp]:
+ "x/-1 = -(x::'a::{field,division_by_zero,number_ring})"
+by simp
+
+lemma minus1_divide [simp]:
+ "-1 / (x::'a::{field,division_by_zero,number_ring}) = - (1/x)"
+by (simp add: divide_inverse inverse_minus_eq)
+
+lemma half_gt_zero_iff:
+ "(0 < r/2) = (0 < (r::'a::{ordered_field,division_by_zero,number_ring}))"
+by auto
+
+lemmas half_gt_zero = half_gt_zero_iff [THEN iffD2, standard]
+declare half_gt_zero [simp]
+
+(* The following lemma should appear in Divides.thy, but there the proof
+ doesn't work. *)
+
+lemma nat_dvd_not_less:
+ "[| 0 < m; m < n |] ==> \<not> n dvd (m::nat)"
+ by (unfold dvd_def) auto
+
+ML {*
+val divide_minus1 = @{thm divide_minus1};
+val minus1_divide = @{thm minus1_divide};
+*}
+
+end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Numeral.thy Thu May 31 18:16:52 2007 +0200
@@ -0,0 +1,685 @@
+(* Title: HOL/Numeral.thy
+ ID: $Id$
+ Author: Lawrence C Paulson, Cambridge University Computer Laboratory
+ Copyright 1994 University of Cambridge
+*)
+
+header {* Arithmetic on Binary Integers *}
+
+theory Numeral
+imports IntDef
+uses ("Tools/numeral_syntax.ML")
+begin
+
+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"}.
+*}
+
+datatype bit = B0 | B1
+
+text{*
+ Type @{typ bit} avoids the use of type @{typ bool}, which would make
+ all of the rewrite rules higher-order.
+*}
+
+definition
+ Pls :: int where
+ [code func del]:"Pls = 0"
+
+definition
+ Min :: int where
+ [code func del]:"Min = - 1"
+
+definition
+ Bit :: "int \<Rightarrow> bit \<Rightarrow> int" (infixl "BIT" 90) where
+ [code func del]: "k BIT b = (case b of B0 \<Rightarrow> 0 | B1 \<Rightarrow> 1) + k + k"
+
+class number = type + -- {* for numeric types: nat, int, real, \dots *}
+ fixes number_of :: "int \<Rightarrow> 'a"
+
+syntax
+ "_Numeral" :: "num_const \<Rightarrow> 'a" ("_")
+
+use "Tools/numeral_syntax.ML"
+setup NumeralSyntax.setup
+
+abbreviation
+ "Numeral0 \<equiv> number_of Pls"
+
+abbreviation
+ "Numeral1 \<equiv> number_of (Pls BIT B1)"
+
+lemma Let_number_of [simp]: "Let (number_of v) f = f (number_of v)"
+ -- {* Unfold all @{text let}s involving constants *}
+ unfolding Let_def ..
+
+lemma Let_0 [simp]: "Let 0 f = f 0"
+ unfolding Let_def ..
+
+lemma Let_1 [simp]: "Let 1 f = f 1"
+ unfolding Let_def ..
+
+definition
+ succ :: "int \<Rightarrow> int" where
+ [code func del]: "succ k = k + 1"
+
+definition
+ pred :: "int \<Rightarrow> int" where
+ [code func del]: "pred k = k - 1"
+
+lemmas
+ max_number_of [simp] = max_def
+ [of "number_of u" "number_of v", standard, simp]
+and
+ min_number_of [simp] = min_def
+ [of "number_of u" "number_of v", standard, simp]
+ -- {* unfolding @{text minx} and @{text max} on numerals *}
+
+lemmas numeral_simps =
+ succ_def pred_def Pls_def Min_def Bit_def
+
+text {* Removal of leading zeroes *}
+
+lemma Pls_0_eq [simp, normal post]:
+ "Pls BIT B0 = Pls"
+ unfolding numeral_simps by simp
+
+lemma Min_1_eq [simp, normal post]:
+ "Min BIT B1 = Min"
+ unfolding numeral_simps by simp
+
+
+subsection {* The Functions @{term succ}, @{term pred} and @{term uminus} *}
+
+lemma succ_Pls [simp]:
+ "succ Pls = Pls BIT B1"
+ unfolding numeral_simps by simp
+
+lemma succ_Min [simp]:
+ "succ Min = Pls"
+ unfolding numeral_simps by simp
+
+lemma succ_1 [simp]:
+ "succ (k BIT B1) = succ k BIT B0"
+ unfolding numeral_simps by simp
+
+lemma succ_0 [simp]:
+ "succ (k BIT B0) = k BIT B1"
+ unfolding numeral_simps by simp
+
+lemma pred_Pls [simp]:
+ "pred Pls = Min"
+ unfolding numeral_simps by simp
+
+lemma pred_Min [simp]:
+ "pred Min = Min BIT B0"
+ unfolding numeral_simps by simp
+
+lemma pred_1 [simp]:
+ "pred (k BIT B1) = k BIT B0"
+ unfolding numeral_simps by simp
+
+lemma pred_0 [simp]:
+ "pred (k BIT B0) = pred k BIT B1"
+ unfolding numeral_simps by simp
+
+lemma minus_Pls [simp]:
+ "- Pls = Pls"
+ unfolding numeral_simps by simp
+
+lemma minus_Min [simp]:
+ "- Min = Pls BIT B1"
+ unfolding numeral_simps by simp
+
+lemma minus_1 [simp]:
+ "- (k BIT B1) = pred (- k) BIT B1"
+ unfolding numeral_simps by simp
+
+lemma minus_0 [simp]:
+ "- (k BIT B0) = (- k) BIT B0"
+ unfolding numeral_simps by simp
+
+
+subsection {*
+ Binary Addition and Multiplication: @{term "op + \<Colon> int \<Rightarrow> int \<Rightarrow> int"}
+ and @{term "op * \<Colon> int \<Rightarrow> int \<Rightarrow> int"}
+*}
+
+lemma add_Pls [simp]:
+ "Pls + k = k"
+ unfolding numeral_simps by simp
+
+lemma add_Min [simp]:
+ "Min + k = pred k"
+ unfolding numeral_simps by simp
+
+lemma add_BIT_11 [simp]:
+ "(k BIT B1) + (l BIT B1) = (k + succ l) BIT B0"
+ unfolding numeral_simps by simp
+
+lemma add_BIT_10 [simp]:
+ "(k BIT B1) + (l BIT B0) = (k + l) BIT B1"
+ unfolding numeral_simps by simp
+
+lemma add_BIT_0 [simp]:
+ "(k BIT B0) + (l BIT b) = (k + l) BIT b"
+ unfolding numeral_simps by simp
+
+lemma add_Pls_right [simp]:
+ "k + Pls = k"
+ unfolding numeral_simps by simp
+
+lemma add_Min_right [simp]:
+ "k + Min = pred k"
+ unfolding numeral_simps by simp
+
+lemma mult_Pls [simp]:
+ "Pls * w = Pls"
+ unfolding numeral_simps by simp
+
+lemma mult_Min [simp]:
+ "Min * k = - k"
+ unfolding numeral_simps by simp
+
+lemma mult_num1 [simp]:
+ "(k BIT B1) * l = ((k * l) BIT B0) + l"
+ unfolding numeral_simps int_distrib by simp
+
+lemma mult_num0 [simp]:
+ "(k BIT B0) * l = (k * l) BIT B0"
+ unfolding numeral_simps int_distrib by simp
+
+
+
+subsection {* Converting Numerals to Rings: @{term number_of} *}
+
+axclass number_ring \<subseteq> number, comm_ring_1
+ number_of_eq: "number_of k = of_int k"
+
+text {* self-embedding of the intergers *}
+
+instance int :: number_ring
+ int_number_of_def: "number_of w \<equiv> of_int w"
+ by intro_classes (simp only: int_number_of_def)
+
+lemmas [code func del] = int_number_of_def
+
+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 numeral_simps by simp
+
+lemma number_of_add:
+ "number_of (v + w) = (number_of v + number_of w::'a::number_ring)"
+ unfolding number_of_eq numeral_simps by simp
+
+lemma number_of_mult:
+ "number_of (v * w) = (number_of v * number_of w::'a::number_ring)"
+ unfolding number_of_eq numeral_simps by simp
+
+text {*
+ The correctness of shifting.
+ But it doesn't seem to give a measurable speed-up.
+*}
+
+lemma double_number_of_BIT:
+ "(1 + 1) * number_of w = (number_of (w BIT B0) ::'a::number_ring)"
+ unfolding number_of_eq numeral_simps left_distrib by simp
+
+text {*
+ Converting numerals 0 and 1 to their abstract versions.
+*}
+
+lemma numeral_0_eq_0 [simp]:
+ "Numeral0 = (0::'a::number_ring)"
+ unfolding number_of_eq numeral_simps by simp
+
+lemma numeral_1_eq_1 [simp]:
+ "Numeral1 = (1::'a::number_ring)"
+ unfolding number_of_eq numeral_simps by simp
+
+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_BIT:
+ "number_of(w BIT x) = (case x of B0 => 0 | B1 => (1::'a::number_ring))
+ + (number_of w) + (number_of w)"
+ unfolding number_of_eq numeral_simps by (simp split: bit.split)
+
+
+subsection {* Equality of Binary Numbers *}
+
+text {* First version by Norbert Voelker *}
+
+lemma eq_number_of_eq:
+ "((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: compare_rls)
+
+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
+
+
+subsection {* Comparisons, for Ordered Rings *}
+
+lemma double_eq_0_iff:
+ "(a + a = 0) = (a = (0::'a::ordered_idom))"
+proof -
+ have "a + a = (1 + 1) * a" unfolding left_distrib by simp
+ with zero_less_two [where 'a = 'a]
+ show ?thesis by force
+qed
+
+lemma le_imp_0_less:
+ assumes le: "0 \<le> z"
+ shows "(0::int) < 1 + z"
+proof -
+ have "0 \<le> z" .
+ also have "... < z + 1" by (rule less_add_one)
+ also have "... = 1 + z" by (simp add: add_ac)
+ finally show "0 < 1 + z" .
+qed
+
+lemma odd_nonzero:
+ "1 + z + z \<noteq> (0::int)";
+proof (cases z rule: int_cases)
+ case (nonneg n)
+ have le: "0 \<le> z+z" by (simp add: nonneg add_increasing)
+ thus ?thesis using le_imp_0_less [OF le]
+ by (auto simp add: add_assoc)
+next
+ case (neg n)
+ show ?thesis
+ proof
+ assume eq: "1 + z + z = 0"
+ have "0 < 1 + (int n + int n)"
+ by (simp add: le_imp_0_less add_increasing)
+ also have "... = - (1 + z + z)"
+ by (simp add: neg add_assoc [symmetric])
+ also have "... = 0" by (simp add: eq)
+ finally have "0<0" ..
+ thus False by blast
+ qed
+qed
+
+text {* The premise involving @{term Ints} prevents @{term "a = 1/2"}. *}
+
+lemma Ints_double_eq_0_iff:
+ assumes in_Ints: "a \<in> Ints"
+ shows "(a + a = 0) = (a = (0::'a::ring_char_0))"
+proof -
+ from in_Ints have "a \<in> range of_int" unfolding Ints_def [symmetric] .
+ then obtain z where a: "a = of_int z" ..
+ show ?thesis
+ proof
+ assume "a = 0"
+ thus "a + a = 0" by simp
+ next
+ assume eq: "a + a = 0"
+ hence "of_int (z + z) = (of_int 0 :: 'a)" by (simp add: a)
+ hence "z + z = 0" by (simp only: of_int_eq_iff)
+ hence "z = 0" by (simp only: double_eq_0_iff)
+ thus "a = 0" by (simp add: a)
+ qed
+qed
+
+lemma Ints_odd_nonzero:
+ assumes in_Ints: "a \<in> Ints"
+ shows "1 + a + a \<noteq> (0::'a::ring_char_0)"
+proof -
+ from in_Ints have "a \<in> range of_int" unfolding Ints_def [symmetric] .
+ then obtain z where a: "a = of_int z" ..
+ show ?thesis
+ proof
+ assume eq: "1 + a + a = 0"
+ hence "of_int (1 + z + z) = (of_int 0 :: 'a)" by (simp add: a)
+ hence "1 + z + z = 0" by (simp only: of_int_eq_iff)
+ with odd_nonzero show False by blast
+ qed
+qed
+
+lemma Ints_number_of:
+ "(number_of w :: 'a::number_ring) \<in> Ints"
+ unfolding number_of_eq Ints_def by simp
+
+lemma iszero_number_of_BIT:
+ "iszero (number_of (w BIT x)::'a) =
+ (x = B0 \<and> iszero (number_of w::'a::{ring_char_0,number_ring}))"
+ by (simp add: iszero_def number_of_eq numeral_simps Ints_double_eq_0_iff
+ Ints_odd_nonzero Ints_def split: bit.split)
+
+lemma iszero_number_of_0:
+ "iszero (number_of (w BIT B0) :: 'a::{ring_char_0,number_ring}) =
+ iszero (number_of w :: 'a)"
+ by (simp only: iszero_number_of_BIT simp_thms)
+
+lemma iszero_number_of_1:
+ "~ iszero (number_of (w BIT B1)::'a::{ring_char_0,number_ring})"
+ by (simp add: iszero_number_of_BIT)
+
+
+subsection {* The Less-Than Relation *}
+
+lemma less_number_of_eq_neg:
+ "((number_of x::'a::{ordered_idom,number_ring}) < number_of y)
+ = neg (number_of (x + uminus y) :: 'a)"
+apply (subst less_iff_diff_less_0)
+apply (simp add: neg_def diff_minus number_of_add number_of_minus)
+done
+
+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 Pls ::'a::{ordered_idom,number_ring})"
+ by (simp add: neg_def numeral_0_eq_0)
+
+lemma neg_number_of_Min:
+ "neg (number_of Min ::'a::{ordered_idom,number_ring})"
+ by (simp add: neg_def zero_less_one numeral_m1_eq_minus_1)
+
+lemma double_less_0_iff:
+ "(a + a < 0) = (a < (0::'a::ordered_idom))"
+proof -
+ have "(a + a < 0) = ((1+1)*a < 0)" by (simp add: left_distrib)
+ also have "... = (a < 0)"
+ by (simp add: mult_less_0_iff zero_less_two
+ order_less_not_sym [OF zero_less_two])
+ finally show ?thesis .
+qed
+
+lemma odd_less_0:
+ "(1 + z + z < 0) = (z < (0::int))";
+proof (cases z rule: int_cases)
+ case (nonneg n)
+ thus ?thesis by (simp add: linorder_not_less add_assoc add_increasing
+ le_imp_0_less [THEN order_less_imp_le])
+next
+ case (neg n)
+ thus ?thesis by (simp del: int_Suc
+ add: int_Suc0_eq_1 [symmetric] zadd_int compare_rls)
+qed
+
+text {* The premise involving @{term Ints} prevents @{term "a = 1/2"}. *}
+
+lemma Ints_odd_less_0:
+ assumes in_Ints: "a \<in> Ints"
+ shows "(1 + a + a < 0) = (a < (0::'a::ordered_idom))";
+proof -
+ from in_Ints have "a \<in> range of_int" unfolding Ints_def [symmetric] .
+ then obtain z where a: "a = of_int z" ..
+ hence "((1::'a) + a + a < 0) = (of_int (1 + z + z) < (of_int 0 :: 'a))"
+ by (simp add: a)
+ also have "... = (z < 0)" by (simp only: of_int_less_iff odd_less_0)
+ also have "... = (a < 0)" by (simp add: a)
+ finally show ?thesis .
+qed
+
+lemma neg_number_of_BIT:
+ "neg (number_of (w BIT x)::'a) =
+ neg (number_of w :: 'a::{ordered_idom,number_ring})"
+ by (simp add: neg_def number_of_eq numeral_simps double_less_0_iff
+ Ints_odd_less_0 Ints_def split: bit.split)
+
+
+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,
+ standard]
+
+lemma le_number_of_eq:
+ "((number_of x::'a::{ordered_idom,number_ring}) \<le> number_of y)
+ = (~ (neg (number_of (y + uminus x) :: 'a)))"
+by (simp add: le_number_of_eq_not_less less_number_of_eq_neg)
+
+
+text {* Absolute value (@{term abs}) *}
+
+lemma abs_number_of:
+ "abs(number_of x::'a::{ordered_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
+
+
+subsection {* Simplification of arithmetic operations on integer constants. *}
+
+lemmas arith_extra_simps [standard, 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 =
+ bit.distinct
+ Pls_0_eq Min_1_eq
+ pred_Pls pred_Min pred_1 pred_0
+ succ_Pls succ_Min succ_1 succ_0
+ add_Pls add_Min add_BIT_0 add_BIT_10 add_BIT_11
+ minus_Pls minus_Min minus_1 minus_0
+ mult_Pls mult_Min mult_num1 mult_num0
+ add_Pls_right add_Min_right
+ abs_zero abs_one arith_extra_simps
+
+text {* Simplification of relational operations *}
+
+lemmas rel_simps [simp] =
+ eq_number_of_eq iszero_number_of_Pls nonzero_number_of_Min
+ iszero_number_of_0 iszero_number_of_1
+ less_number_of_eq_neg
+ not_neg_number_of_Pls not_neg_0 not_neg_1 not_iszero_1
+ neg_number_of_Min neg_number_of_BIT
+ le_number_of_eq
+
+
+subsection {* 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 add_number_of_left)
+
+lemma add_number_of_diff2 [simp]:
+ "number_of v + (c - number_of w) =
+ number_of (v + uminus w) + (c::'a::number_ring)"
+apply (subst diff_number_of_eq [symmetric])
+apply (simp only: compare_rls)
+done
+
+
+subsection {* Configuration of the code generator *}
+
+instance int :: eq ..
+
+code_datatype Pls Min Bit "number_of \<Colon> int \<Rightarrow> int"
+
+definition
+ int_aux :: "int \<Rightarrow> nat \<Rightarrow> int" where
+ "int_aux i n = (i + int n)"
+
+lemma [code]:
+ "int_aux i 0 = i"
+ "int_aux i (Suc n) = int_aux (i + 1) n" -- {* tail recursive *}
+ by (simp add: int_aux_def)+
+
+lemma [code]:
+ "int n = int_aux 0 n"
+ by (simp add: int_aux_def)
+
+definition
+ nat_aux :: "nat \<Rightarrow> int \<Rightarrow> nat" where
+ "nat_aux n i = (n + nat i)"
+
+lemma [code]: "nat_aux n i = (if i <= 0 then n else nat_aux (Suc n) (i - 1))"
+ -- {* 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 [code]: "nat i = nat_aux 0 i"
+ by (simp add: nat_aux_def)
+
+lemma zero_is_num_zero [code func, code inline, symmetric, normal post]:
+ "(0\<Colon>int) = number_of Numeral.Pls"
+ by simp
+
+lemma one_is_num_one [code func, code inline, symmetric, normal post]:
+ "(1\<Colon>int) = number_of (Numeral.Pls BIT bit.B1)"
+ by simp
+
+code_modulename SML
+ IntDef Integer
+
+code_modulename OCaml
+ IntDef Integer
+
+code_modulename Haskell
+ IntDef Integer
+
+code_modulename SML
+ Numeral Integer
+
+code_modulename OCaml
+ Numeral Integer
+
+code_modulename Haskell
+ Numeral Integer
+
+(*FIXME: the IntInf.fromInt below hides a dependence on fixed-precision ints!*)
+
+types_code
+ "int" ("int")
+attach (term_of) {*
+val term_of_int = HOLogic.mk_number HOLogic.intT o IntInf.fromInt;
+*}
+attach (test) {*
+fun gen_int i = one_of [~1, 1] * random_range 0 i;
+*}
+
+setup {*
+let
+
+fun number_of_codegen thy defs gr dep module b (Const (@{const_name Numeral.number_of}, Type ("fun", [_, T])) $ t) =
+ if T = HOLogic.intT then
+ (SOME (fst (Codegen.invoke_tycodegen thy defs dep module false (gr, T)),
+ (Pretty.str o IntInf.toString o HOLogic.dest_numeral) t) handle TERM _ => NONE)
+ else if T = HOLogic.natT then
+ SOME (Codegen.invoke_codegen thy defs dep module b (gr,
+ Const ("IntDef.nat", HOLogic.intT --> HOLogic.natT) $
+ (Const (@{const_name Numeral.number_of}, HOLogic.intT --> HOLogic.intT) $ t)))
+ else NONE
+ | number_of_codegen _ _ _ _ _ _ _ = NONE;
+
+in
+
+Codegen.add_codegen "number_of_codegen" number_of_codegen
+
+end
+*}
+
+consts_code
+ "0 :: int" ("0")
+ "1 :: int" ("1")
+ "uminus :: int => int" ("~")
+ "op + :: int => int => int" ("(_ +/ _)")
+ "op * :: int => int => int" ("(_ */ _)")
+ "op \<le> :: int => int => bool" ("(_ <=/ _)")
+ "op < :: int => int => bool" ("(_ </ _)")
+
+quickcheck_params [default_type = int]
+
+(*setup continues in theory Presburger*)
+
+hide (open) const Pls Min B0 B1 succ pred
+
+end
--- a/src/HOL/Presburger.thy Thu May 31 18:16:51 2007 +0200
+++ b/src/HOL/Presburger.thy Thu May 31 18:16:52 2007 +0200
@@ -9,7 +9,7 @@
header {* Presburger Arithmetic: Cooper's Algorithm *}
theory Presburger
-imports "Integ/NatSimprocs" SetInterval
+imports NatSimprocs SetInterval
uses
("Tools/Presburger/cooper_dec.ML")
("Tools/Presburger/cooper_proof.ML")
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/int_arith1.ML Thu May 31 18:16:52 2007 +0200
@@ -0,0 +1,610 @@
+(* Title: HOL/int_arith1.ML
+ ID: $Id$
+ Authors: Larry Paulson and Tobias Nipkow
+
+Simprocs and decision procedure for linear arithmetic.
+*)
+
+(** Misc ML bindings **)
+
+val succ_Pls = thm "succ_Pls";
+val succ_Min = thm "succ_Min";
+val succ_1 = thm "succ_1";
+val succ_0 = thm "succ_0";
+
+val pred_Pls = thm "pred_Pls";
+val pred_Min = thm "pred_Min";
+val pred_1 = thm "pred_1";
+val pred_0 = thm "pred_0";
+
+val minus_Pls = thm "minus_Pls";
+val minus_Min = thm "minus_Min";
+val minus_1 = thm "minus_1";
+val minus_0 = thm "minus_0";
+
+val add_Pls = thm "add_Pls";
+val add_Min = thm "add_Min";
+val add_BIT_11 = thm "add_BIT_11";
+val add_BIT_10 = thm "add_BIT_10";
+val add_BIT_0 = thm "add_BIT_0";
+val add_Pls_right = thm "add_Pls_right";
+val add_Min_right = thm "add_Min_right";
+
+val mult_Pls = thm "mult_Pls";
+val mult_Min = thm "mult_Min";
+val mult_num1 = thm "mult_num1";
+val mult_num0 = thm "mult_num0";
+
+val neg_def = thm "neg_def";
+val iszero_def = thm "iszero_def";
+
+val number_of_succ = thm "number_of_succ";
+val number_of_pred = thm "number_of_pred";
+val number_of_minus = thm "number_of_minus";
+val number_of_add = thm "number_of_add";
+val diff_number_of_eq = thm "diff_number_of_eq";
+val number_of_mult = thm "number_of_mult";
+val double_number_of_BIT = thm "double_number_of_BIT";
+val numeral_0_eq_0 = thm "numeral_0_eq_0";
+val numeral_1_eq_1 = thm "numeral_1_eq_1";
+val numeral_m1_eq_minus_1 = thm "numeral_m1_eq_minus_1";
+val mult_minus1 = thm "mult_minus1";
+val mult_minus1_right = thm "mult_minus1_right";
+val minus_number_of_mult = thm "minus_number_of_mult";
+val zero_less_nat_eq = thm "zero_less_nat_eq";
+val eq_number_of_eq = thm "eq_number_of_eq";
+val iszero_number_of_Pls = thm "iszero_number_of_Pls";
+val nonzero_number_of_Min = thm "nonzero_number_of_Min";
+val iszero_number_of_BIT = thm "iszero_number_of_BIT";
+val iszero_number_of_0 = thm "iszero_number_of_0";
+val iszero_number_of_1 = thm "iszero_number_of_1";
+val less_number_of_eq_neg = thm "less_number_of_eq_neg";
+val le_number_of_eq = thm "le_number_of_eq";
+val not_neg_number_of_Pls = thm "not_neg_number_of_Pls";
+val neg_number_of_Min = thm "neg_number_of_Min";
+val neg_number_of_BIT = thm "neg_number_of_BIT";
+val le_number_of_eq_not_less = thm "le_number_of_eq_not_less";
+val abs_number_of = thm "abs_number_of";
+val number_of_reorient = thm "number_of_reorient";
+val add_number_of_left = thm "add_number_of_left";
+val mult_number_of_left = thm "mult_number_of_left";
+val add_number_of_diff1 = thm "add_number_of_diff1";
+val add_number_of_diff2 = thm "add_number_of_diff2";
+val less_iff_diff_less_0 = thm "less_iff_diff_less_0";
+val eq_iff_diff_eq_0 = thm "eq_iff_diff_eq_0";
+val le_iff_diff_le_0 = thm "le_iff_diff_le_0";
+
+val arith_extra_simps = thms "arith_extra_simps";
+val arith_simps = thms "arith_simps";
+val rel_simps = thms "rel_simps";
+
+val zless_imp_add1_zle = thm "zless_imp_add1_zle";
+
+val combine_common_factor = thm "combine_common_factor";
+val eq_add_iff1 = thm "eq_add_iff1";
+val eq_add_iff2 = thm "eq_add_iff2";
+val less_add_iff1 = thm "less_add_iff1";
+val less_add_iff2 = thm "less_add_iff2";
+val le_add_iff1 = thm "le_add_iff1";
+val le_add_iff2 = thm "le_add_iff2";
+
+val arith_special = thms "arith_special";
+
+structure Int_Numeral_Base_Simprocs =
+ struct
+ fun prove_conv tacs ctxt (_: thm list) (t, u) =
+ if t aconv u then NONE
+ else
+ let val eq = HOLogic.mk_Trueprop (HOLogic.mk_eq (t, u))
+ in SOME (Goal.prove ctxt [] [] eq (K (EVERY tacs))) end
+
+ fun prove_conv_nohyps tacs sg = prove_conv tacs sg [];
+
+ fun prep_simproc (name, pats, proc) =
+ Simplifier.simproc (the_context()) name pats proc;
+
+ fun is_numeral (Const(@{const_name Numeral.number_of}, _) $ w) = true
+ | is_numeral _ = false
+
+ fun simplify_meta_eq f_number_of_eq f_eq =
+ mk_meta_eq ([f_eq, f_number_of_eq] MRS trans)
+
+ (*reorientation simprules using ==, for the following simproc*)
+ val meta_zero_reorient = zero_reorient RS eq_reflection
+ val meta_one_reorient = one_reorient RS eq_reflection
+ val meta_number_of_reorient = number_of_reorient RS eq_reflection
+
+ (*reorientation simplification procedure: reorients (polymorphic)
+ 0 = x, 1 = x, nnn = x provided x isn't 0, 1 or a numeral.*)
+ fun reorient_proc sg _ (_ $ t $ u) =
+ case u of
+ Const(@{const_name HOL.zero}, _) => NONE
+ | Const(@{const_name HOL.one}, _) => NONE
+ | Const(@{const_name Numeral.number_of}, _) $ _ => NONE
+ | _ => SOME (case t of
+ Const(@{const_name HOL.zero}, _) => meta_zero_reorient
+ | Const(@{const_name HOL.one}, _) => meta_one_reorient
+ | Const(@{const_name Numeral.number_of}, _) $ _ => meta_number_of_reorient)
+
+ val reorient_simproc =
+ prep_simproc ("reorient_simproc", ["0=x", "1=x", "number_of w = x"], reorient_proc)
+
+ end;
+
+
+Addsimprocs [Int_Numeral_Base_Simprocs.reorient_simproc];
+
+
+structure Int_Numeral_Simprocs =
+struct
+
+(*Maps 0 to Numeral0 and 1 to Numeral1 so that arithmetic in Int_Numeral_Base_Simprocs
+ isn't complicated by the abstract 0 and 1.*)
+val numeral_syms = [numeral_0_eq_0 RS sym, numeral_1_eq_1 RS sym];
+
+(** New term ordering so that AC-rewriting brings numerals to the front **)
+
+(*Order integers by absolute value and then by sign. The standard integer
+ ordering is not well-founded.*)
+fun num_ord (i,j) =
+ (case IntInf.compare (IntInf.abs i, IntInf.abs j) of
+ EQUAL => int_ord (IntInf.sign i, IntInf.sign j)
+ | ord => ord);
+
+(*This resembles Term.term_ord, but it puts binary numerals before other
+ non-atomic terms.*)
+local open Term
+in
+fun numterm_ord (Abs (_, T, t), Abs(_, U, u)) =
+ (case numterm_ord (t, u) of EQUAL => typ_ord (T, U) | ord => ord)
+ | numterm_ord
+ (Const(@{const_name Numeral.number_of}, _) $ v, Const(@{const_name Numeral.number_of}, _) $ w) =
+ num_ord (HOLogic.dest_numeral v, HOLogic.dest_numeral w)
+ | numterm_ord (Const(@{const_name Numeral.number_of}, _) $ _, _) = LESS
+ | numterm_ord (_, Const(@{const_name Numeral.number_of}, _) $ _) = GREATER
+ | numterm_ord (t, u) =
+ (case int_ord (size_of_term t, size_of_term u) of
+ EQUAL =>
+ let val (f, ts) = strip_comb t and (g, us) = strip_comb u in
+ (case hd_ord (f, g) of EQUAL => numterms_ord (ts, us) | ord => ord)
+ end
+ | ord => ord)
+and numterms_ord (ts, us) = list_ord numterm_ord (ts, us)
+end;
+
+fun numtermless tu = (numterm_ord tu = LESS);
+
+(*Defined in this file, but perhaps needed only for Int_Numeral_Base_Simprocs of type nat.*)
+val num_ss = HOL_ss settermless numtermless;
+
+
+(** Utilities **)
+
+fun mk_number T n = HOLogic.number_of_const T $ HOLogic.mk_numeral n;
+
+fun find_first_numeral past (t::terms) =
+ ((snd (HOLogic.dest_number t), rev past @ terms)
+ handle TERM _ => find_first_numeral (t::past) terms)
+ | find_first_numeral past [] = raise TERM("find_first_numeral", []);
+
+val mk_plus = HOLogic.mk_binop @{const_name HOL.plus};
+
+fun mk_minus t =
+ let val T = Term.fastype_of t
+ in Const (@{const_name HOL.uminus}, T --> T) $ t
+ end;
+
+(*Thus mk_sum[t] yields t+0; longer sums don't have a trailing zero*)
+fun mk_sum T [] = mk_number T 0
+ | mk_sum T [t,u] = mk_plus (t, u)
+ | mk_sum T (t :: ts) = mk_plus (t, mk_sum T ts);
+
+(*this version ALWAYS includes a trailing zero*)
+fun long_mk_sum T [] = mk_number T 0
+ | long_mk_sum T (t :: ts) = mk_plus (t, mk_sum T ts);
+
+val dest_plus = HOLogic.dest_bin @{const_name HOL.plus} Term.dummyT;
+
+(*decompose additions AND subtractions as a sum*)
+fun dest_summing (pos, Const (@{const_name HOL.plus}, _) $ t $ u, ts) =
+ dest_summing (pos, t, dest_summing (pos, u, ts))
+ | dest_summing (pos, Const (@{const_name HOL.minus}, _) $ t $ u, ts) =
+ dest_summing (pos, t, dest_summing (not pos, u, ts))
+ | dest_summing (pos, t, ts) =
+ if pos then t::ts else mk_minus t :: ts;
+
+fun dest_sum t = dest_summing (true, t, []);
+
+val mk_diff = HOLogic.mk_binop @{const_name HOL.minus};
+val dest_diff = HOLogic.dest_bin @{const_name HOL.minus} Term.dummyT;
+
+val mk_times = HOLogic.mk_binop @{const_name HOL.times};
+
+fun mk_prod T =
+ let val one = mk_number T 1
+ fun mk [] = one
+ | mk [t] = t
+ | mk (t :: ts) = if t = one then mk ts else mk_times (t, mk ts)
+ in mk end;
+
+(*This version ALWAYS includes a trailing one*)
+fun long_mk_prod T [] = mk_number T 1
+ | long_mk_prod T (t :: ts) = mk_times (t, mk_prod T ts);
+
+val dest_times = HOLogic.dest_bin @{const_name HOL.times} Term.dummyT;
+
+fun dest_prod t =
+ let val (t,u) = dest_times t
+ in dest_prod t @ dest_prod u end
+ handle TERM _ => [t];
+
+(*DON'T do the obvious simplifications; that would create special cases*)
+fun mk_coeff (k, t) = mk_times (mk_number (Term.fastype_of t) k, t);
+
+(*Express t as a product of (possibly) a numeral with other sorted terms*)
+fun dest_coeff sign (Const (@{const_name HOL.uminus}, _) $ t) = dest_coeff (~sign) t
+ | dest_coeff sign t =
+ let val ts = sort Term.term_ord (dest_prod t)
+ val (n, ts') = find_first_numeral [] ts
+ handle TERM _ => (1, ts)
+ in (sign*n, mk_prod (Term.fastype_of t) ts') end;
+
+(*Find first coefficient-term THAT MATCHES u*)
+fun find_first_coeff past u [] = raise TERM("find_first_coeff", [])
+ | find_first_coeff past u (t::terms) =
+ let val (n,u') = dest_coeff 1 t
+ in if u aconv u' then (n, rev past @ terms)
+ else find_first_coeff (t::past) u terms
+ end
+ handle TERM _ => find_first_coeff (t::past) u terms;
+
+(*Fractions as pairs of ints. Can't use Rat.rat because the representation
+ needs to preserve negative values in the denominator.*)
+fun mk_frac (p, q : IntInf.int) = if q = 0 then raise Div else (p, q);
+
+(*Don't reduce fractions; sums must be proved by rule add_frac_eq.
+ Fractions are reduced later by the cancel_numeral_factor simproc.*)
+fun add_frac ((p1 : IntInf.int, q1 : IntInf.int), (p2, q2)) = (p1 * q2 + p2 * q1, q1 * q2);
+
+val mk_divide = HOLogic.mk_binop @{const_name HOL.divide};
+
+(*Build term (p / q) * t*)
+fun mk_fcoeff ((p, q), t) =
+ let val T = Term.fastype_of t
+ in mk_times (mk_divide (mk_number T p, mk_number T q), t) end;
+
+(*Express t as a product of a fraction with other sorted terms*)
+fun dest_fcoeff sign (Const (@{const_name HOL.uminus}, _) $ t) = dest_fcoeff (~sign) t
+ | dest_fcoeff sign (Const (@{const_name HOL.divide}, _) $ t $ u) =
+ let val (p, t') = dest_coeff sign t
+ val (q, u') = dest_coeff 1 u
+ in (mk_frac (p, q), mk_divide (t', u')) end
+ | dest_fcoeff sign t =
+ let val (p, t') = dest_coeff sign t
+ val T = Term.fastype_of t
+ in (mk_frac (p, 1), mk_divide (t', mk_number T 1)) end;
+
+
+(*Simplify Numeral0+n, n+Numeral0, Numeral1*n, n*Numeral1*)
+val add_0s = thms "add_0s";
+val mult_1s = thms "mult_1s";
+
+(*Simplify inverse Numeral1, a/Numeral1*)
+val inverse_1s = [@{thm inverse_numeral_1}];
+val divide_1s = [@{thm divide_numeral_1}];
+
+(*To perform binary arithmetic. The "left" rewriting handles patterns
+ created by the Int_Numeral_Base_Simprocs, such as 3 * (5 * x). *)
+val simps = [numeral_0_eq_0 RS sym, numeral_1_eq_1 RS sym,
+ add_number_of_left, mult_number_of_left] @
+ arith_simps @ rel_simps;
+
+(*Binary arithmetic BUT NOT ADDITION since it may collapse adjacent terms
+ during re-arrangement*)
+val non_add_simps =
+ subtract Thm.eq_thm [add_number_of_left, number_of_add RS sym] simps;
+
+(*To evaluate binary negations of coefficients*)
+val minus_simps = [numeral_m1_eq_minus_1 RS sym, number_of_minus RS sym,
+ minus_1, minus_0, minus_Pls, minus_Min,
+ pred_1, pred_0, pred_Pls, pred_Min];
+
+(*To let us treat subtraction as addition*)
+val diff_simps = [@{thm diff_minus}, @{thm minus_add_distrib}, @{thm minus_minus}];
+
+(*To let us treat division as multiplication*)
+val divide_simps = [@{thm divide_inverse}, @{thm inverse_mult_distrib}, @{thm inverse_inverse_eq}];
+
+(*push the unary minus down: - x * y = x * - y *)
+val minus_mult_eq_1_to_2 =
+ [@{thm minus_mult_left} RS sym, @{thm minus_mult_right}] MRS trans |> standard;
+
+(*to extract again any uncancelled minuses*)
+val minus_from_mult_simps =
+ [@{thm minus_minus}, @{thm minus_mult_left} RS sym, @{thm minus_mult_right} RS sym];
+
+(*combine unary minus with numeric literals, however nested within a product*)
+val mult_minus_simps =
+ [@{thm mult_assoc}, @{thm minus_mult_left}, minus_mult_eq_1_to_2];
+
+(*Apply the given rewrite (if present) just once*)
+fun trans_tac NONE = all_tac
+ | trans_tac (SOME th) = ALLGOALS (rtac (th RS trans));
+
+fun simplify_meta_eq rules =
+ let val ss0 = HOL_basic_ss addeqcongs [eq_cong2] addsimps rules
+ in fn ss => simplify (Simplifier.inherit_context ss ss0) o mk_meta_eq end
+
+structure CancelNumeralsCommon =
+ struct
+ val mk_sum = mk_sum
+ val dest_sum = dest_sum
+ val mk_coeff = mk_coeff
+ val dest_coeff = dest_coeff 1
+ val find_first_coeff = find_first_coeff []
+ val trans_tac = fn _ => trans_tac
+
+ val norm_ss1 = num_ss addsimps numeral_syms @ add_0s @ mult_1s @
+ diff_simps @ minus_simps @ add_ac
+ val norm_ss2 = num_ss addsimps non_add_simps @ mult_minus_simps
+ val norm_ss3 = num_ss addsimps minus_from_mult_simps @ add_ac @ mult_ac
+ fun norm_tac ss =
+ ALLGOALS (simp_tac (Simplifier.inherit_context ss norm_ss1))
+ THEN ALLGOALS (simp_tac (Simplifier.inherit_context ss norm_ss2))
+ THEN ALLGOALS (simp_tac (Simplifier.inherit_context ss norm_ss3))
+
+ val numeral_simp_ss = HOL_ss addsimps add_0s @ simps
+ fun numeral_simp_tac ss = ALLGOALS (simp_tac (Simplifier.inherit_context ss numeral_simp_ss))
+ val simplify_meta_eq = simplify_meta_eq (add_0s @ mult_1s)
+ end;
+
+
+structure EqCancelNumerals = CancelNumeralsFun
+ (open CancelNumeralsCommon
+ val prove_conv = Int_Numeral_Base_Simprocs.prove_conv
+ val mk_bal = HOLogic.mk_eq
+ val dest_bal = HOLogic.dest_bin "op =" Term.dummyT
+ val bal_add1 = eq_add_iff1 RS trans
+ val bal_add2 = eq_add_iff2 RS trans
+);
+
+structure LessCancelNumerals = CancelNumeralsFun
+ (open CancelNumeralsCommon
+ val prove_conv = Int_Numeral_Base_Simprocs.prove_conv
+ val mk_bal = HOLogic.mk_binrel @{const_name Orderings.less}
+ val dest_bal = HOLogic.dest_bin @{const_name Orderings.less} Term.dummyT
+ val bal_add1 = less_add_iff1 RS trans
+ val bal_add2 = less_add_iff2 RS trans
+);
+
+structure LeCancelNumerals = CancelNumeralsFun
+ (open CancelNumeralsCommon
+ val prove_conv = Int_Numeral_Base_Simprocs.prove_conv
+ val mk_bal = HOLogic.mk_binrel @{const_name Orderings.less_eq}
+ val dest_bal = HOLogic.dest_bin @{const_name Orderings.less_eq} Term.dummyT
+ val bal_add1 = le_add_iff1 RS trans
+ val bal_add2 = le_add_iff2 RS trans
+);
+
+val cancel_numerals =
+ map Int_Numeral_Base_Simprocs.prep_simproc
+ [("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"],
+ K EqCancelNumerals.proc),
+ ("intless_cancel_numerals",
+ ["(l::'a::{ordered_idom,number_ring}) + m < n",
+ "(l::'a::{ordered_idom,number_ring}) < m + n",
+ "(l::'a::{ordered_idom,number_ring}) - m < n",
+ "(l::'a::{ordered_idom,number_ring}) < m - n",
+ "(l::'a::{ordered_idom,number_ring}) * m < n",
+ "(l::'a::{ordered_idom,number_ring}) < m * n"],
+ K LessCancelNumerals.proc),
+ ("intle_cancel_numerals",
+ ["(l::'a::{ordered_idom,number_ring}) + m <= n",
+ "(l::'a::{ordered_idom,number_ring}) <= m + n",
+ "(l::'a::{ordered_idom,number_ring}) - m <= n",
+ "(l::'a::{ordered_idom,number_ring}) <= m - n",
+ "(l::'a::{ordered_idom,number_ring}) * m <= n",
+ "(l::'a::{ordered_idom,number_ring}) <= m * n"],
+ K LeCancelNumerals.proc)];
+
+
+structure CombineNumeralsData =
+ struct
+ type coeff = IntInf.int
+ val iszero = (fn x : IntInf.int => x = 0)
+ val add = IntInf.+
+ val mk_sum = long_mk_sum (*to work for e.g. 2*x + 3*x *)
+ val dest_sum = dest_sum
+ val mk_coeff = mk_coeff
+ val dest_coeff = dest_coeff 1
+ val left_distrib = combine_common_factor RS trans
+ val prove_conv = Int_Numeral_Base_Simprocs.prove_conv_nohyps
+ val trans_tac = fn _ => trans_tac
+
+ val norm_ss1 = num_ss addsimps numeral_syms @ add_0s @ mult_1s @
+ diff_simps @ minus_simps @ add_ac
+ val norm_ss2 = num_ss addsimps non_add_simps @ mult_minus_simps
+ val norm_ss3 = num_ss addsimps minus_from_mult_simps @ add_ac @ mult_ac
+ fun norm_tac ss =
+ ALLGOALS (simp_tac (Simplifier.inherit_context ss norm_ss1))
+ THEN ALLGOALS (simp_tac (Simplifier.inherit_context ss norm_ss2))
+ THEN ALLGOALS (simp_tac (Simplifier.inherit_context ss norm_ss3))
+
+ val numeral_simp_ss = HOL_ss addsimps add_0s @ simps
+ fun numeral_simp_tac ss = ALLGOALS (simp_tac (Simplifier.inherit_context ss numeral_simp_ss))
+ val simplify_meta_eq = simplify_meta_eq (add_0s @ mult_1s)
+ end;
+
+structure CombineNumerals = CombineNumeralsFun(CombineNumeralsData);
+
+(*Version for fields, where coefficients can be fractions*)
+structure FieldCombineNumeralsData =
+ struct
+ type coeff = IntInf.int * IntInf.int
+ val iszero = (fn (p : IntInf.int, q) => p = 0)
+ val add = add_frac
+ val mk_sum = long_mk_sum
+ val dest_sum = dest_sum
+ val mk_coeff = mk_fcoeff
+ val dest_coeff = dest_fcoeff 1
+ val left_distrib = combine_common_factor RS trans
+ val prove_conv = Int_Numeral_Base_Simprocs.prove_conv_nohyps
+ val trans_tac = fn _ => trans_tac
+
+ val norm_ss1 = num_ss addsimps numeral_syms @ add_0s @ mult_1s @
+ inverse_1s @ divide_simps @ diff_simps @ minus_simps @ add_ac
+ val norm_ss2 = num_ss addsimps non_add_simps @ mult_minus_simps
+ val norm_ss3 = num_ss addsimps minus_from_mult_simps @ add_ac @ mult_ac
+ fun norm_tac ss =
+ ALLGOALS (simp_tac (Simplifier.inherit_context ss norm_ss1))
+ THEN ALLGOALS (simp_tac (Simplifier.inherit_context ss norm_ss2))
+ THEN ALLGOALS (simp_tac (Simplifier.inherit_context ss norm_ss3))
+
+ val numeral_simp_ss = HOL_ss addsimps add_0s @ simps @ [@{thm add_frac_eq}]
+ fun numeral_simp_tac ss = ALLGOALS (simp_tac (Simplifier.inherit_context ss numeral_simp_ss))
+ val simplify_meta_eq = simplify_meta_eq (add_0s @ mult_1s @ divide_1s)
+ end;
+
+structure FieldCombineNumerals = CombineNumeralsFun(FieldCombineNumeralsData);
+
+val combine_numerals =
+ Int_Numeral_Base_Simprocs.prep_simproc
+ ("int_combine_numerals",
+ ["(i::'a::number_ring) + j", "(i::'a::number_ring) - j"],
+ K CombineNumerals.proc);
+
+val field_combine_numerals =
+ Int_Numeral_Base_Simprocs.prep_simproc
+ ("field_combine_numerals",
+ ["(i::'a::{number_ring,field,division_by_zero}) + j",
+ "(i::'a::{number_ring,field,division_by_zero}) - j"],
+ K FieldCombineNumerals.proc);
+
+end;
+
+Addsimprocs Int_Numeral_Simprocs.cancel_numerals;
+Addsimprocs [Int_Numeral_Simprocs.combine_numerals];
+Addsimprocs [Int_Numeral_Simprocs.field_combine_numerals];
+
+(*examples:
+print_depth 22;
+set timing;
+set trace_simp;
+fun test s = (Goal s, by (Simp_tac 1));
+
+test "l + 2 + 2 + 2 + (l + 2) + (oo + 2) = (uu::int)";
+
+test "2*u = (u::int)";
+test "(i + j + 12 + (k::int)) - 15 = y";
+test "(i + j + 12 + (k::int)) - 5 = y";
+
+test "y - b < (b::int)";
+test "y - (3*b + c) < (b::int) - 2*c";
+
+test "(2*x - (u*v) + y) - v*3*u = (w::int)";
+test "(2*x*u*v + (u*v)*4 + y) - v*u*4 = (w::int)";
+test "(2*x*u*v + (u*v)*4 + y) - v*u = (w::int)";
+test "u*v - (x*u*v + (u*v)*4 + y) = (w::int)";
+
+test "(i + j + 12 + (k::int)) = u + 15 + y";
+test "(i + j*2 + 12 + (k::int)) = j + 5 + y";
+
+test "2*y + 3*z + 6*w + 2*y + 3*z + 2*u = 2*y' + 3*z' + 6*w' + 2*y' + 3*z' + u + (vv::int)";
+
+test "a + -(b+c) + b = (d::int)";
+test "a + -(b+c) - b = (d::int)";
+
+(*negative numerals*)
+test "(i + j + -2 + (k::int)) - (u + 5 + y) = zz";
+test "(i + j + -3 + (k::int)) < u + 5 + y";
+test "(i + j + 3 + (k::int)) < u + -6 + y";
+test "(i + j + -12 + (k::int)) - 15 = y";
+test "(i + j + 12 + (k::int)) - -15 = y";
+test "(i + j + -12 + (k::int)) - -15 = y";
+*)
+
+
+(** Constant folding for multiplication in semirings **)
+
+(*We do not need folding for addition: combine_numerals does the same thing*)
+
+structure Semiring_Times_Assoc_Data : ASSOC_FOLD_DATA =
+struct
+ val assoc_ss = HOL_ss addsimps mult_ac
+ val eq_reflection = eq_reflection
+end;
+
+structure Semiring_Times_Assoc = Assoc_Fold (Semiring_Times_Assoc_Data);
+
+val assoc_fold_simproc =
+ Int_Numeral_Base_Simprocs.prep_simproc
+ ("semiring_assoc_fold", ["(a::'a::comm_semiring_1_cancel) * b"],
+ K Semiring_Times_Assoc.proc);
+
+Addsimprocs [assoc_fold_simproc];
+
+
+
+
+(*** decision procedure for linear arithmetic ***)
+
+(*---------------------------------------------------------------------------*)
+(* Linear arithmetic *)
+(*---------------------------------------------------------------------------*)
+
+(*
+Instantiation of the generic linear arithmetic package for int.
+*)
+
+(* Update parameters of arithmetic prover *)
+local
+
+(* reduce contradictory <= to False *)
+val add_rules =
+ simp_thms @ arith_simps @ rel_simps @ arith_special @
+ [@{thm neg_le_iff_le}, @{thm numeral_0_eq_0}, @{thm numeral_1_eq_1},
+ @{thm minus_zero}, @{thm diff_minus}, @{thm left_minus}, @{thm right_minus},
+ @{thm mult_zero_left}, @{thm mult_zero_right}, @{thm mult_num1}, @{thm mult_1_right},
+ @{thm minus_mult_left} RS sym, @{thm minus_mult_right} RS sym,
+ @{thm minus_add_distrib}, @{thm minus_minus}, @{thm mult_assoc},
+ 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, int_eq_of_nat]
+
+val nat_inj_thms = [zle_int RS iffD2, int_int_eq RS iffD2]
+
+val Int_Numeral_Base_Simprocs = assoc_fold_simproc
+ :: Int_Numeral_Simprocs.combine_numerals
+ :: Int_Numeral_Simprocs.cancel_numerals;
+
+in
+
+val int_arith_setup =
+ Fast_Arith.map_data (fn {add_mono_thms, mult_mono_thms, inj_thms, lessD, neqE, simpset} =>
+ {add_mono_thms = add_mono_thms,
+ mult_mono_thms = @{thm mult_strict_left_mono} :: @{thm mult_left_mono} :: mult_mono_thms,
+ inj_thms = nat_inj_thms @ inj_thms,
+ lessD = lessD @ [zless_imp_add1_zle],
+ neqE = neqE,
+ simpset = simpset addsimps add_rules
+ addsimprocs Int_Numeral_Base_Simprocs
+ addcongs [if_weak_cong]}) #>
+ arith_inj_const ("Nat.of_nat", HOLogic.natT --> HOLogic.intT) #>
+ arith_inj_const ("IntDef.int", HOLogic.natT --> HOLogic.intT) #>
+ arith_discrete "IntDef.int"
+
+end;
+
+val fast_int_arith_simproc =
+ Simplifier.simproc @{theory}
+ "fast_int_arith"
+ ["(m::'a::{ordered_idom,number_ring}) < n",
+ "(m::'a::{ordered_idom,number_ring}) <= n",
+ "(m::'a::{ordered_idom,number_ring}) = n"] Fast_Arith.lin_arith_prover;
+
+Addsimprocs [fast_int_arith_simproc];
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/int_factor_simprocs.ML Thu May 31 18:16:52 2007 +0200
@@ -0,0 +1,335 @@
+(* Title: HOL/int_factor_simprocs.ML
+ ID: $Id$
+ Author: Lawrence C Paulson, Cambridge University Computer Laboratory
+ Copyright 2000 University of Cambridge
+
+Factor cancellation simprocs for the integers (and for fields).
+
+This file can't be combined with int_arith1 because it requires IntDiv.thy.
+*)
+
+
+(*To quote from Provers/Arith/cancel_numeral_factor.ML:
+
+Cancels common coefficients in balanced expressions:
+
+ u*#m ~~ u'*#m' == #n*u ~~ #n'*u'
+
+where ~~ is an appropriate balancing operation (e.g. =, <=, <, div, /)
+and d = gcd(m,m') and n=m/d and n'=m'/d.
+*)
+
+val rel_number_of = [eq_number_of_eq, less_number_of_eq_neg, le_number_of_eq];
+
+(** Factor cancellation theorems for integer division (div, not /) **)
+
+Goal "!!k::int. k~=0 ==> (k*m) div (k*n) = (m div n)";
+by (stac @{thm zdiv_zmult_zmult1} 1);
+by Auto_tac;
+qed "int_mult_div_cancel1";
+
+(*For ExtractCommonTermFun, cancelling common factors*)
+Goal "(k*m) div (k*n) = (if k = (0::int) then 0 else m div n)";
+by (simp_tac (simpset() addsimps [int_mult_div_cancel1]) 1);
+qed "int_mult_div_cancel_disj";
+
+
+local
+ open Int_Numeral_Simprocs
+in
+
+structure CancelNumeralFactorCommon =
+ struct
+ val mk_coeff = mk_coeff
+ val dest_coeff = dest_coeff 1
+ val trans_tac = fn _ => trans_tac
+
+ val norm_ss1 = HOL_ss addsimps minus_from_mult_simps @ mult_1s
+ val norm_ss2 = HOL_ss addsimps simps @ mult_minus_simps
+ val norm_ss3 = HOL_ss addsimps mult_ac
+ fun norm_tac ss =
+ ALLGOALS (simp_tac (Simplifier.inherit_context ss norm_ss1))
+ THEN ALLGOALS (simp_tac (Simplifier.inherit_context ss norm_ss2))
+ THEN ALLGOALS (simp_tac (Simplifier.inherit_context ss norm_ss3))
+
+ val numeral_simp_ss = HOL_ss addsimps rel_number_of @ simps
+ fun numeral_simp_tac ss = ALLGOALS (simp_tac (Simplifier.inherit_context ss numeral_simp_ss))
+ val simplify_meta_eq = Int_Numeral_Simprocs.simplify_meta_eq
+ [@{thm add_0}, @{thm add_0_right}, @{thm mult_zero_left},
+ @{thm mult_zero_right}, @{thm mult_num1}, @{thm mult_1_right}];
+ end
+
+(*Version for integer division*)
+structure IntDivCancelNumeralFactor = CancelNumeralFactorFun
+ (open CancelNumeralFactorCommon
+ val prove_conv = Int_Numeral_Base_Simprocs.prove_conv
+ val mk_bal = HOLogic.mk_binop @{const_name Divides.div}
+ val dest_bal = HOLogic.dest_bin @{const_name Divides.div} HOLogic.intT
+ val cancel = int_mult_div_cancel1 RS trans
+ val neg_exchanges = false
+)
+
+(*Version for fields*)
+structure DivideCancelNumeralFactor = CancelNumeralFactorFun
+ (open CancelNumeralFactorCommon
+ val prove_conv = Int_Numeral_Base_Simprocs.prove_conv
+ val mk_bal = HOLogic.mk_binop @{const_name HOL.divide}
+ val dest_bal = HOLogic.dest_bin @{const_name HOL.divide} Term.dummyT
+ val cancel = @{thm mult_divide_cancel_left} RS trans
+ val neg_exchanges = false
+)
+
+structure EqCancelNumeralFactor = CancelNumeralFactorFun
+ (open CancelNumeralFactorCommon
+ val prove_conv = Int_Numeral_Base_Simprocs.prove_conv
+ val mk_bal = HOLogic.mk_eq
+ val dest_bal = HOLogic.dest_bin "op =" Term.dummyT
+ val cancel = @{thm mult_cancel_left} RS trans
+ val neg_exchanges = false
+)
+
+structure LessCancelNumeralFactor = CancelNumeralFactorFun
+ (open CancelNumeralFactorCommon
+ val prove_conv = Int_Numeral_Base_Simprocs.prove_conv
+ val mk_bal = HOLogic.mk_binrel @{const_name Orderings.less}
+ val dest_bal = HOLogic.dest_bin @{const_name Orderings.less} Term.dummyT
+ val cancel = @{thm mult_less_cancel_left} RS trans
+ val neg_exchanges = true
+)
+
+structure LeCancelNumeralFactor = CancelNumeralFactorFun
+ (open CancelNumeralFactorCommon
+ val prove_conv = Int_Numeral_Base_Simprocs.prove_conv
+ val mk_bal = HOLogic.mk_binrel @{const_name Orderings.less_eq}
+ val dest_bal = HOLogic.dest_bin @{const_name Orderings.less_eq} Term.dummyT
+ val cancel = @{thm mult_le_cancel_left} RS trans
+ val neg_exchanges = true
+)
+
+val cancel_numeral_factors =
+ map Int_Numeral_Base_Simprocs.prep_simproc
+ [("ring_eq_cancel_numeral_factor",
+ ["(l::'a::{idom,number_ring}) * m = n",
+ "(l::'a::{idom,number_ring}) = m * n"],
+ K EqCancelNumeralFactor.proc),
+ ("ring_less_cancel_numeral_factor",
+ ["(l::'a::{ordered_idom,number_ring}) * m < n",
+ "(l::'a::{ordered_idom,number_ring}) < m * n"],
+ K LessCancelNumeralFactor.proc),
+ ("ring_le_cancel_numeral_factor",
+ ["(l::'a::{ordered_idom,number_ring}) * m <= n",
+ "(l::'a::{ordered_idom,number_ring}) <= m * n"],
+ K LeCancelNumeralFactor.proc),
+ ("int_div_cancel_numeral_factors",
+ ["((l::int) * m) div n", "(l::int) div (m * n)"],
+ K IntDivCancelNumeralFactor.proc),
+ ("divide_cancel_numeral_factor",
+ ["((l::'a::{division_by_zero,field,number_ring}) * m) / n",
+ "(l::'a::{division_by_zero,field,number_ring}) / (m * n)",
+ "((number_of v)::'a::{division_by_zero,field,number_ring}) / (number_of w)"],
+ K DivideCancelNumeralFactor.proc)];
+
+(* referenced by rat_arith.ML *)
+val field_cancel_numeral_factors =
+ map Int_Numeral_Base_Simprocs.prep_simproc
+ [("field_eq_cancel_numeral_factor",
+ ["(l::'a::{field,number_ring}) * m = n",
+ "(l::'a::{field,number_ring}) = m * n"],
+ K EqCancelNumeralFactor.proc),
+ ("field_cancel_numeral_factor",
+ ["((l::'a::{division_by_zero,field,number_ring}) * m) / n",
+ "(l::'a::{division_by_zero,field,number_ring}) / (m * n)",
+ "((number_of v)::'a::{division_by_zero,field,number_ring}) / (number_of w)"],
+ K DivideCancelNumeralFactor.proc)]
+
+end;
+
+Addsimprocs cancel_numeral_factors;
+
+(*examples:
+print_depth 22;
+set timing;
+set trace_simp;
+fun test s = (Goal s; by (Simp_tac 1));
+
+test "9*x = 12 * (y::int)";
+test "(9*x) div (12 * (y::int)) = z";
+test "9*x < 12 * (y::int)";
+test "9*x <= 12 * (y::int)";
+
+test "-99*x = 132 * (y::int)";
+test "(-99*x) div (132 * (y::int)) = z";
+test "-99*x < 132 * (y::int)";
+test "-99*x <= 132 * (y::int)";
+
+test "999*x = -396 * (y::int)";
+test "(999*x) div (-396 * (y::int)) = z";
+test "999*x < -396 * (y::int)";
+test "999*x <= -396 * (y::int)";
+
+test "-99*x = -81 * (y::int)";
+test "(-99*x) div (-81 * (y::int)) = z";
+test "-99*x <= -81 * (y::int)";
+test "-99*x < -81 * (y::int)";
+
+test "-2 * x = -1 * (y::int)";
+test "-2 * x = -(y::int)";
+test "(-2 * x) div (-1 * (y::int)) = z";
+test "-2 * x < -(y::int)";
+test "-2 * x <= -1 * (y::int)";
+test "-x < -23 * (y::int)";
+test "-x <= -23 * (y::int)";
+*)
+
+(*And the same examples for fields such as rat or real:
+test "0 <= (y::rat) * -2";
+test "9*x = 12 * (y::rat)";
+test "(9*x) / (12 * (y::rat)) = z";
+test "9*x < 12 * (y::rat)";
+test "9*x <= 12 * (y::rat)";
+
+test "-99*x = 132 * (y::rat)";
+test "(-99*x) / (132 * (y::rat)) = z";
+test "-99*x < 132 * (y::rat)";
+test "-99*x <= 132 * (y::rat)";
+
+test "999*x = -396 * (y::rat)";
+test "(999*x) / (-396 * (y::rat)) = z";
+test "999*x < -396 * (y::rat)";
+test "999*x <= -396 * (y::rat)";
+
+test "(- ((2::rat) * x) <= 2 * y)";
+test "-99*x = -81 * (y::rat)";
+test "(-99*x) / (-81 * (y::rat)) = z";
+test "-99*x <= -81 * (y::rat)";
+test "-99*x < -81 * (y::rat)";
+
+test "-2 * x = -1 * (y::rat)";
+test "-2 * x = -(y::rat)";
+test "(-2 * x) / (-1 * (y::rat)) = z";
+test "-2 * x < -(y::rat)";
+test "-2 * x <= -1 * (y::rat)";
+test "-x < -23 * (y::rat)";
+test "-x <= -23 * (y::rat)";
+*)
+
+
+(** Declarations for ExtractCommonTerm **)
+
+local
+ open Int_Numeral_Simprocs
+in
+
+(*Find first term that matches u*)
+fun find_first_t past u [] = raise TERM ("find_first_t", [])
+ | find_first_t past u (t::terms) =
+ if u aconv t then (rev past @ terms)
+ else find_first_t (t::past) u terms
+ handle TERM _ => find_first_t (t::past) u terms;
+
+(** Final simplification for the CancelFactor simprocs **)
+val simplify_one = Int_Numeral_Simprocs.simplify_meta_eq
+ [@{thm mult_1_left}, mult_1_right, @{thm zdiv_1}, numeral_1_eq_1];
+
+fun cancel_simplify_meta_eq cancel_th ss th =
+ simplify_one ss (([th, cancel_th]) MRS trans);
+
+(*At present, long_mk_prod creates Numeral1, so this requires the axclass
+ number_ring*)
+structure CancelFactorCommon =
+ struct
+ val mk_sum = long_mk_prod
+ val dest_sum = dest_prod
+ val mk_coeff = mk_coeff
+ val dest_coeff = dest_coeff
+ val find_first = find_first_t []
+ val trans_tac = fn _ => trans_tac
+ val norm_ss = HOL_ss addsimps mult_1s @ mult_ac
+ fun norm_tac ss = ALLGOALS (simp_tac (Simplifier.inherit_context ss norm_ss))
+ end;
+
+(*mult_cancel_left requires a ring with no zero divisors.*)
+structure EqCancelFactor = ExtractCommonTermFun
+ (open CancelFactorCommon
+ val prove_conv = Int_Numeral_Base_Simprocs.prove_conv
+ val mk_bal = HOLogic.mk_eq
+ val dest_bal = HOLogic.dest_bin "op =" Term.dummyT
+ val simplify_meta_eq = cancel_simplify_meta_eq @{thm mult_cancel_left}
+);
+
+(*int_mult_div_cancel_disj is for integer division (div).*)
+structure IntDivCancelFactor = ExtractCommonTermFun
+ (open CancelFactorCommon
+ val prove_conv = Int_Numeral_Base_Simprocs.prove_conv
+ val mk_bal = HOLogic.mk_binop @{const_name Divides.div}
+ val dest_bal = HOLogic.dest_bin @{const_name Divides.div} HOLogic.intT
+ val simplify_meta_eq = cancel_simplify_meta_eq int_mult_div_cancel_disj
+);
+
+(*Version for all fields, including unordered ones (type complex).*)
+structure DivideCancelFactor = ExtractCommonTermFun
+ (open CancelFactorCommon
+ val prove_conv = Int_Numeral_Base_Simprocs.prove_conv
+ val mk_bal = HOLogic.mk_binop @{const_name HOL.divide}
+ val dest_bal = HOLogic.dest_bin @{const_name HOL.divide} Term.dummyT
+ val simplify_meta_eq = cancel_simplify_meta_eq @{thm mult_divide_cancel_eq_if}
+);
+
+(*The number_ring class is necessary because the simprocs refer to the
+ binary number 1. FIXME: probably they could use 1 instead.*)
+val cancel_factors =
+ map Int_Numeral_Base_Simprocs.prep_simproc
+ [("ring_eq_cancel_factor",
+ ["(l::'a::{idom,number_ring}) * m = n",
+ "(l::'a::{idom,number_ring}) = m * n"],
+ K EqCancelFactor.proc),
+ ("int_div_cancel_factor",
+ ["((l::int) * m) div n", "(l::int) div (m * n)"],
+ K IntDivCancelFactor.proc),
+ ("divide_cancel_factor",
+ ["((l::'a::{division_by_zero,field,number_ring}) * m) / n",
+ "(l::'a::{division_by_zero,field,number_ring}) / (m * n)"],
+ K DivideCancelFactor.proc)];
+
+end;
+
+Addsimprocs cancel_factors;
+
+
+(*examples:
+print_depth 22;
+set timing;
+set trace_simp;
+fun test s = (Goal s; by (Asm_simp_tac 1));
+
+test "x*k = k*(y::int)";
+test "k = k*(y::int)";
+test "a*(b*c) = (b::int)";
+test "a*(b*c) = d*(b::int)*(x*a)";
+
+test "(x*k) div (k*(y::int)) = (uu::int)";
+test "(k) div (k*(y::int)) = (uu::int)";
+test "(a*(b*c)) div ((b::int)) = (uu::int)";
+test "(a*(b*c)) div (d*(b::int)*(x*a)) = (uu::int)";
+*)
+
+(*And the same examples for fields such as rat or real:
+print_depth 22;
+set timing;
+set trace_simp;
+fun test s = (Goal s; by (Asm_simp_tac 1));
+
+test "x*k = k*(y::rat)";
+test "k = k*(y::rat)";
+test "a*(b*c) = (b::rat)";
+test "a*(b*c) = d*(b::rat)*(x*a)";
+
+
+test "(x*k) / (k*(y::rat)) = (uu::rat)";
+test "(k) / (k*(y::rat)) = (uu::rat)";
+test "(a*(b*c)) / ((b::rat)) = (uu::rat)";
+test "(a*(b*c)) / (d*(b::rat)*(x*a)) = (uu::rat)";
+
+(*FIXME: what do we do about this?*)
+test "a*(b*c)/(y*z) = d*(b::rat)*(x*a)/z";
+*)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/nat_simprocs.ML Thu May 31 18:16:52 2007 +0200
@@ -0,0 +1,550 @@
+(* Title: HOL/nat_simprocs.ML
+ ID: $Id$
+ Author: Lawrence C Paulson, Cambridge University Computer Laboratory
+ Copyright 2000 University of Cambridge
+
+Simprocs for nat numerals.
+*)
+
+structure Nat_Numeral_Simprocs =
+struct
+
+(*Maps n to #n for n = 0, 1, 2*)
+val numeral_syms =
+ [nat_numeral_0_eq_0 RS sym, nat_numeral_1_eq_1 RS sym, numeral_2_eq_2 RS sym];
+val numeral_sym_ss = HOL_ss addsimps numeral_syms;
+
+fun rename_numerals th =
+ simplify numeral_sym_ss (Thm.transfer (the_context ()) th);
+
+(*Utilities*)
+
+fun mk_number n = HOLogic.number_of_const HOLogic.natT $ HOLogic.mk_numeral n;
+fun dest_number t = IntInf.max (0, snd (HOLogic.dest_number t));
+
+fun find_first_numeral past (t::terms) =
+ ((dest_number t, t, rev past @ terms)
+ handle TERM _ => find_first_numeral (t::past) terms)
+ | find_first_numeral past [] = raise TERM("find_first_numeral", []);
+
+val zero = mk_number 0;
+val mk_plus = HOLogic.mk_binop @{const_name HOL.plus};
+
+(*Thus mk_sum[t] yields t+0; longer sums don't have a trailing zero*)
+fun mk_sum [] = zero
+ | mk_sum [t,u] = mk_plus (t, u)
+ | mk_sum (t :: ts) = mk_plus (t, mk_sum ts);
+
+(*this version ALWAYS includes a trailing zero*)
+fun long_mk_sum [] = HOLogic.zero
+ | long_mk_sum (t :: ts) = mk_plus (t, mk_sum ts);
+
+val dest_plus = HOLogic.dest_bin @{const_name HOL.plus} HOLogic.natT;
+
+
+(** Other simproc items **)
+
+val trans_tac = Int_Numeral_Simprocs.trans_tac;
+
+val bin_simps =
+ [nat_numeral_0_eq_0 RS sym, nat_numeral_1_eq_1 RS sym,
+ add_nat_number_of, nat_number_of_add_left,
+ diff_nat_number_of, le_number_of_eq_not_less,
+ mult_nat_number_of, nat_number_of_mult_left,
+ less_nat_number_of,
+ @{thm Let_number_of}, nat_number_of] @
+ arith_simps @ rel_simps;
+
+fun prep_simproc (name, pats, proc) =
+ Simplifier.simproc (the_context ()) name pats proc;
+
+
+(*** CancelNumerals simprocs ***)
+
+val one = mk_number 1;
+val mk_times = HOLogic.mk_binop @{const_name HOL.times};
+
+fun mk_prod [] = one
+ | mk_prod [t] = t
+ | mk_prod (t :: ts) = if t = one then mk_prod ts
+ else mk_times (t, mk_prod ts);
+
+val dest_times = HOLogic.dest_bin @{const_name HOL.times} HOLogic.natT;
+
+fun dest_prod t =
+ let val (t,u) = dest_times t
+ in dest_prod t @ dest_prod u end
+ handle TERM _ => [t];
+
+(*DON'T do the obvious simplifications; that would create special cases*)
+fun mk_coeff (k,t) = mk_times (mk_number k, t);
+
+(*Express t as a product of (possibly) a numeral with other factors, sorted*)
+fun dest_coeff t =
+ let val ts = sort Term.term_ord (dest_prod t)
+ val (n, _, ts') = find_first_numeral [] ts
+ handle TERM _ => (1, one, ts)
+ in (n, mk_prod ts') end;
+
+(*Find first coefficient-term THAT MATCHES u*)
+fun find_first_coeff past u [] = raise TERM("find_first_coeff", [])
+ | find_first_coeff past u (t::terms) =
+ let val (n,u') = dest_coeff t
+ in if u aconv u' then (n, rev past @ terms)
+ else find_first_coeff (t::past) u terms
+ end
+ handle TERM _ => find_first_coeff (t::past) u terms;
+
+
+(*Split up a sum into the list of its constituent terms, on the way removing any
+ Sucs and counting them.*)
+fun dest_Suc_sum (Const ("Suc", _) $ t, (k,ts)) = dest_Suc_sum (t, (k+1,ts))
+ | dest_Suc_sum (t, (k,ts)) =
+ let val (t1,t2) = dest_plus t
+ in dest_Suc_sum (t1, dest_Suc_sum (t2, (k,ts))) end
+ handle TERM _ => (k, t::ts);
+
+(*Code for testing whether numerals are already used in the goal*)
+fun is_numeral (Const(@{const_name Numeral.number_of}, _) $ w) = true
+ | is_numeral _ = false;
+
+fun prod_has_numeral t = exists is_numeral (dest_prod t);
+
+(*The Sucs found in the term are converted to a binary numeral. If relaxed is false,
+ an exception is raised unless the original expression contains at least one
+ numeral in a coefficient position. This prevents nat_combine_numerals from
+ introducing numerals to goals.*)
+fun dest_Sucs_sum relaxed t =
+ let val (k,ts) = dest_Suc_sum (t,(0,[]))
+ in
+ if relaxed orelse exists prod_has_numeral ts then
+ if k=0 then ts
+ else mk_number (IntInf.fromInt k) :: ts
+ else raise TERM("Nat_Numeral_Simprocs.dest_Sucs_sum", [t])
+ end;
+
+
+(*Simplify 1*n and n*1 to n*)
+val add_0s = map rename_numerals [add_0, add_0_right];
+val mult_1s = map rename_numerals [@{thm nat_mult_1}, @{thm nat_mult_1_right}];
+
+(*Final simplification: cancel + and *; replace Numeral0 by 0 and Numeral1 by 1*)
+
+(*And these help the simproc return False when appropriate, which helps
+ the arith prover.*)
+val contra_rules = [add_Suc, add_Suc_right, Zero_not_Suc, Suc_not_Zero,
+ le_0_eq];
+
+val simplify_meta_eq =
+ Int_Numeral_Simprocs.simplify_meta_eq
+ ([nat_numeral_0_eq_0, numeral_1_eq_Suc_0, add_0, add_0_right,
+ mult_0, mult_0_right, mult_1, mult_1_right] @ contra_rules);
+
+
+(*Like HOL_ss but with an ordering that brings numerals to the front
+ under AC-rewriting.*)
+val num_ss = Int_Numeral_Simprocs.num_ss;
+
+(*** Applying CancelNumeralsFun ***)
+
+structure CancelNumeralsCommon =
+ struct
+ val mk_sum = (fn T:typ => mk_sum)
+ val dest_sum = dest_Sucs_sum true
+ val mk_coeff = mk_coeff
+ val dest_coeff = dest_coeff
+ val find_first_coeff = find_first_coeff []
+ val trans_tac = fn _ => trans_tac
+
+ val norm_ss1 = num_ss addsimps numeral_syms @ add_0s @ mult_1s @
+ [Suc_eq_add_numeral_1_left] @ add_ac
+ val norm_ss2 = num_ss addsimps bin_simps @ add_ac @ mult_ac
+ fun norm_tac ss =
+ ALLGOALS (simp_tac (Simplifier.inherit_context ss norm_ss1))
+ THEN ALLGOALS (simp_tac (Simplifier.inherit_context ss norm_ss2))
+
+ val numeral_simp_ss = HOL_ss addsimps add_0s @ bin_simps;
+ fun numeral_simp_tac ss = ALLGOALS (simp_tac (Simplifier.inherit_context ss numeral_simp_ss));
+ val simplify_meta_eq = simplify_meta_eq
+ end;
+
+
+structure EqCancelNumerals = CancelNumeralsFun
+ (open CancelNumeralsCommon
+ val prove_conv = Int_Numeral_Base_Simprocs.prove_conv
+ val mk_bal = HOLogic.mk_eq
+ val dest_bal = HOLogic.dest_bin "op =" HOLogic.natT
+ val bal_add1 = nat_eq_add_iff1 RS trans
+ val bal_add2 = nat_eq_add_iff2 RS trans
+);
+
+structure LessCancelNumerals = CancelNumeralsFun
+ (open CancelNumeralsCommon
+ val prove_conv = Int_Numeral_Base_Simprocs.prove_conv
+ val mk_bal = HOLogic.mk_binrel @{const_name Orderings.less}
+ val dest_bal = HOLogic.dest_bin @{const_name Orderings.less} HOLogic.natT
+ val bal_add1 = nat_less_add_iff1 RS trans
+ val bal_add2 = nat_less_add_iff2 RS trans
+);
+
+structure LeCancelNumerals = CancelNumeralsFun
+ (open CancelNumeralsCommon
+ val prove_conv = Int_Numeral_Base_Simprocs.prove_conv
+ val mk_bal = HOLogic.mk_binrel @{const_name Orderings.less_eq}
+ val dest_bal = HOLogic.dest_bin @{const_name Orderings.less_eq} HOLogic.natT
+ val bal_add1 = nat_le_add_iff1 RS trans
+ val bal_add2 = nat_le_add_iff2 RS trans
+);
+
+structure DiffCancelNumerals = CancelNumeralsFun
+ (open CancelNumeralsCommon
+ val prove_conv = Int_Numeral_Base_Simprocs.prove_conv
+ val mk_bal = HOLogic.mk_binop @{const_name HOL.minus}
+ val dest_bal = HOLogic.dest_bin @{const_name HOL.minus} HOLogic.natT
+ val bal_add1 = nat_diff_add_eq1 RS trans
+ val bal_add2 = nat_diff_add_eq2 RS trans
+);
+
+
+val cancel_numerals =
+ map prep_simproc
+ [("nateq_cancel_numerals",
+ ["(l::nat) + m = n", "(l::nat) = m + n",
+ "(l::nat) * m = n", "(l::nat) = m * n",
+ "Suc m = n", "m = Suc n"],
+ K EqCancelNumerals.proc),
+ ("natless_cancel_numerals",
+ ["(l::nat) + m < n", "(l::nat) < m + n",
+ "(l::nat) * m < n", "(l::nat) < m * n",
+ "Suc m < n", "m < Suc n"],
+ K LessCancelNumerals.proc),
+ ("natle_cancel_numerals",
+ ["(l::nat) + m <= n", "(l::nat) <= m + n",
+ "(l::nat) * m <= n", "(l::nat) <= m * n",
+ "Suc m <= n", "m <= Suc n"],
+ K LeCancelNumerals.proc),
+ ("natdiff_cancel_numerals",
+ ["((l::nat) + m) - n", "(l::nat) - (m + n)",
+ "(l::nat) * m - n", "(l::nat) - m * n",
+ "Suc m - n", "m - Suc n"],
+ K DiffCancelNumerals.proc)];
+
+
+(*** Applying CombineNumeralsFun ***)
+
+structure CombineNumeralsData =
+ struct
+ type coeff = IntInf.int
+ val iszero = (fn x : IntInf.int => x = 0)
+ val add = IntInf.+
+ val mk_sum = (fn T:typ => long_mk_sum) (*to work for 2*x + 3*x *)
+ val dest_sum = dest_Sucs_sum false
+ val mk_coeff = mk_coeff
+ val dest_coeff = dest_coeff
+ val left_distrib = left_add_mult_distrib RS trans
+ val prove_conv = Int_Numeral_Base_Simprocs.prove_conv_nohyps
+ val trans_tac = fn _ => trans_tac
+
+ val norm_ss1 = num_ss addsimps numeral_syms @ add_0s @ mult_1s @ [Suc_eq_add_numeral_1] @ add_ac
+ val norm_ss2 = num_ss addsimps bin_simps @ add_ac @ mult_ac
+ fun norm_tac ss =
+ ALLGOALS (simp_tac (Simplifier.inherit_context ss norm_ss1))
+ THEN ALLGOALS (simp_tac (Simplifier.inherit_context ss norm_ss2))
+
+ val numeral_simp_ss = HOL_ss addsimps add_0s @ bin_simps;
+ fun numeral_simp_tac ss = ALLGOALS (simp_tac (Simplifier.inherit_context ss numeral_simp_ss))
+ val simplify_meta_eq = simplify_meta_eq
+ end;
+
+structure CombineNumerals = CombineNumeralsFun(CombineNumeralsData);
+
+val combine_numerals =
+ prep_simproc ("nat_combine_numerals", ["(i::nat) + j", "Suc (i + j)"], K CombineNumerals.proc);
+
+
+(*** Applying CancelNumeralFactorFun ***)
+
+structure CancelNumeralFactorCommon =
+ struct
+ val mk_coeff = mk_coeff
+ val dest_coeff = dest_coeff
+ val trans_tac = fn _ => trans_tac
+
+ val norm_ss1 = num_ss addsimps
+ numeral_syms @ add_0s @ mult_1s @ [Suc_eq_add_numeral_1_left] @ add_ac
+ val norm_ss2 = num_ss addsimps bin_simps @ add_ac @ mult_ac
+ fun norm_tac ss =
+ ALLGOALS (simp_tac (Simplifier.inherit_context ss norm_ss1))
+ THEN ALLGOALS (simp_tac (Simplifier.inherit_context ss norm_ss2))
+
+ val numeral_simp_ss = HOL_ss addsimps bin_simps
+ fun numeral_simp_tac ss = ALLGOALS (simp_tac (Simplifier.inherit_context ss numeral_simp_ss))
+ val simplify_meta_eq = simplify_meta_eq
+ end
+
+structure DivCancelNumeralFactor = CancelNumeralFactorFun
+ (open CancelNumeralFactorCommon
+ val prove_conv = Int_Numeral_Base_Simprocs.prove_conv
+ val mk_bal = HOLogic.mk_binop @{const_name Divides.div}
+ val dest_bal = HOLogic.dest_bin @{const_name Divides.div} HOLogic.natT
+ val cancel = nat_mult_div_cancel1 RS trans
+ val neg_exchanges = false
+)
+
+structure EqCancelNumeralFactor = CancelNumeralFactorFun
+ (open CancelNumeralFactorCommon
+ val prove_conv = Int_Numeral_Base_Simprocs.prove_conv
+ val mk_bal = HOLogic.mk_eq
+ val dest_bal = HOLogic.dest_bin "op =" HOLogic.natT
+ val cancel = nat_mult_eq_cancel1 RS trans
+ val neg_exchanges = false
+)
+
+structure LessCancelNumeralFactor = CancelNumeralFactorFun
+ (open CancelNumeralFactorCommon
+ val prove_conv = Int_Numeral_Base_Simprocs.prove_conv
+ val mk_bal = HOLogic.mk_binrel @{const_name Orderings.less}
+ val dest_bal = HOLogic.dest_bin @{const_name Orderings.less} HOLogic.natT
+ val cancel = nat_mult_less_cancel1 RS trans
+ val neg_exchanges = true
+)
+
+structure LeCancelNumeralFactor = CancelNumeralFactorFun
+ (open CancelNumeralFactorCommon
+ val prove_conv = Int_Numeral_Base_Simprocs.prove_conv
+ val mk_bal = HOLogic.mk_binrel @{const_name Orderings.less_eq}
+ val dest_bal = HOLogic.dest_bin @{const_name Orderings.less_eq} HOLogic.natT
+ val cancel = nat_mult_le_cancel1 RS trans
+ val neg_exchanges = true
+)
+
+val cancel_numeral_factors =
+ map prep_simproc
+ [("nateq_cancel_numeral_factors",
+ ["(l::nat) * m = n", "(l::nat) = m * n"],
+ K EqCancelNumeralFactor.proc),
+ ("natless_cancel_numeral_factors",
+ ["(l::nat) * m < n", "(l::nat) < m * n"],
+ K LessCancelNumeralFactor.proc),
+ ("natle_cancel_numeral_factors",
+ ["(l::nat) * m <= n", "(l::nat) <= m * n"],
+ K LeCancelNumeralFactor.proc),
+ ("natdiv_cancel_numeral_factors",
+ ["((l::nat) * m) div n", "(l::nat) div (m * n)"],
+ K DivCancelNumeralFactor.proc)];
+
+
+
+(*** Applying ExtractCommonTermFun ***)
+
+(*this version ALWAYS includes a trailing one*)
+fun long_mk_prod [] = one
+ | long_mk_prod (t :: ts) = mk_times (t, mk_prod ts);
+
+(*Find first term that matches u*)
+fun find_first_t past u [] = raise TERM("find_first_t", [])
+ | find_first_t past u (t::terms) =
+ if u aconv t then (rev past @ terms)
+ else find_first_t (t::past) u terms
+ handle TERM _ => find_first_t (t::past) u terms;
+
+(** Final simplification for the CancelFactor simprocs **)
+val simplify_one = Int_Numeral_Simprocs.simplify_meta_eq
+ [@{thm mult_1_left}, @{thm mult_1_right}, @{thm div_1}, @{thm numeral_1_eq_Suc_0}];
+
+fun cancel_simplify_meta_eq cancel_th ss th =
+ simplify_one ss (([th, cancel_th]) MRS trans);
+
+structure CancelFactorCommon =
+ struct
+ val mk_sum = (fn T:typ => long_mk_prod)
+ val dest_sum = dest_prod
+ val mk_coeff = mk_coeff
+ val dest_coeff = dest_coeff
+ val find_first = find_first_t []
+ val trans_tac = fn _ => trans_tac
+ val norm_ss = HOL_ss addsimps mult_1s @ mult_ac
+ fun norm_tac ss = ALLGOALS (simp_tac (Simplifier.inherit_context ss norm_ss))
+ end;
+
+structure EqCancelFactor = ExtractCommonTermFun
+ (open CancelFactorCommon
+ val prove_conv = Int_Numeral_Base_Simprocs.prove_conv
+ val mk_bal = HOLogic.mk_eq
+ val dest_bal = HOLogic.dest_bin "op =" HOLogic.natT
+ val simplify_meta_eq = cancel_simplify_meta_eq nat_mult_eq_cancel_disj
+);
+
+structure LessCancelFactor = ExtractCommonTermFun
+ (open CancelFactorCommon
+ val prove_conv = Int_Numeral_Base_Simprocs.prove_conv
+ val mk_bal = HOLogic.mk_binrel @{const_name Orderings.less}
+ val dest_bal = HOLogic.dest_bin @{const_name Orderings.less} HOLogic.natT
+ val simplify_meta_eq = cancel_simplify_meta_eq nat_mult_less_cancel_disj
+);
+
+structure LeCancelFactor = ExtractCommonTermFun
+ (open CancelFactorCommon
+ val prove_conv = Int_Numeral_Base_Simprocs.prove_conv
+ val mk_bal = HOLogic.mk_binrel @{const_name Orderings.less_eq}
+ val dest_bal = HOLogic.dest_bin @{const_name Orderings.less_eq} HOLogic.natT
+ val simplify_meta_eq = cancel_simplify_meta_eq nat_mult_le_cancel_disj
+);
+
+structure DivideCancelFactor = ExtractCommonTermFun
+ (open CancelFactorCommon
+ val prove_conv = Int_Numeral_Base_Simprocs.prove_conv
+ val mk_bal = HOLogic.mk_binop @{const_name Divides.div}
+ val dest_bal = HOLogic.dest_bin @{const_name Divides.div} HOLogic.natT
+ val simplify_meta_eq = cancel_simplify_meta_eq nat_mult_div_cancel_disj
+);
+
+val cancel_factor =
+ map prep_simproc
+ [("nat_eq_cancel_factor",
+ ["(l::nat) * m = n", "(l::nat) = m * n"],
+ K EqCancelFactor.proc),
+ ("nat_less_cancel_factor",
+ ["(l::nat) * m < n", "(l::nat) < m * n"],
+ K LessCancelFactor.proc),
+ ("nat_le_cancel_factor",
+ ["(l::nat) * m <= n", "(l::nat) <= m * n"],
+ K LeCancelFactor.proc),
+ ("nat_divide_cancel_factor",
+ ["((l::nat) * m) div n", "(l::nat) div (m * n)"],
+ K DivideCancelFactor.proc)];
+
+end;
+
+
+Addsimprocs Nat_Numeral_Simprocs.cancel_numerals;
+Addsimprocs [Nat_Numeral_Simprocs.combine_numerals];
+Addsimprocs Nat_Numeral_Simprocs.cancel_numeral_factors;
+Addsimprocs Nat_Numeral_Simprocs.cancel_factor;
+
+
+(*examples:
+print_depth 22;
+set timing;
+set trace_simp;
+fun test s = (Goal s; by (Simp_tac 1));
+
+(*cancel_numerals*)
+test "l +( 2) + (2) + 2 + (l + 2) + (oo + 2) = (uu::nat)";
+test "(2*length xs < 2*length xs + j)";
+test "(2*length xs < length xs * 2 + j)";
+test "2*u = (u::nat)";
+test "2*u = Suc (u)";
+test "(i + j + 12 + (k::nat)) - 15 = y";
+test "(i + j + 12 + (k::nat)) - 5 = y";
+test "Suc u - 2 = y";
+test "Suc (Suc (Suc u)) - 2 = y";
+test "(i + j + 2 + (k::nat)) - 1 = y";
+test "(i + j + 1 + (k::nat)) - 2 = y";
+
+test "(2*x + (u*v) + y) - v*3*u = (w::nat)";
+test "(2*x*u*v + 5 + (u*v)*4 + y) - v*u*4 = (w::nat)";
+test "(2*x*u*v + (u*v)*4 + y) - v*u = (w::nat)";
+test "Suc (Suc (2*x*u*v + u*4 + y)) - u = w";
+test "Suc ((u*v)*4) - v*3*u = w";
+test "Suc (Suc ((u*v)*3)) - v*3*u = w";
+
+test "(i + j + 12 + (k::nat)) = u + 15 + y";
+test "(i + j + 32 + (k::nat)) - (u + 15 + y) = zz";
+test "(i + j + 12 + (k::nat)) = u + 5 + y";
+(*Suc*)
+test "(i + j + 12 + k) = Suc (u + y)";
+test "Suc (Suc (Suc (Suc (Suc (u + y))))) <= ((i + j) + 41 + k)";
+test "(i + j + 5 + k) < Suc (Suc (Suc (Suc (Suc (u + y)))))";
+test "Suc (Suc (Suc (Suc (Suc (u + y))))) - 5 = v";
+test "(i + j + 5 + k) = Suc (Suc (Suc (Suc (Suc (Suc (Suc (u + y)))))))";
+test "2*y + 3*z + 2*u = Suc (u)";
+test "2*y + 3*z + 6*w + 2*y + 3*z + 2*u = Suc (u)";
+test "2*y + 3*z + 6*w + 2*y + 3*z + 2*u = 2*y' + 3*z' + 6*w' + 2*y' + 3*z' + u + (vv::nat)";
+test "6 + 2*y + 3*z + 4*u = Suc (vv + 2*u + z)";
+test "(2*n*m) < (3*(m*n)) + (u::nat)";
+
+test "(Suc (Suc (Suc (Suc (Suc (Suc (case length (f c) of 0 => 0 | Suc k => k)))))) <= Suc 0)";
+
+test "Suc (Suc (Suc (Suc (Suc (Suc (length l1 + length l2)))))) <= length l1";
+
+test "( (Suc (Suc (Suc (Suc (Suc (length (compT P E A ST mxr e) + length l3)))))) <= length (compT P E A ST mxr e))";
+
+test "( (Suc (Suc (Suc (Suc (Suc (length (compT P E A ST mxr e) + length (compT P E (A Un \<A> e) ST mxr c))))))) <= length (compT P E A ST mxr e))";
+
+
+(*negative numerals: FAIL*)
+test "(i + j + -23 + (k::nat)) < u + 15 + y";
+test "(i + j + 3 + (k::nat)) < u + -15 + y";
+test "(i + j + -12 + (k::nat)) - 15 = y";
+test "(i + j + 12 + (k::nat)) - -15 = y";
+test "(i + j + -12 + (k::nat)) - -15 = y";
+
+(*combine_numerals*)
+test "k + 3*k = (u::nat)";
+test "Suc (i + 3) = u";
+test "Suc (i + j + 3 + k) = u";
+test "k + j + 3*k + j = (u::nat)";
+test "Suc (j*i + i + k + 5 + 3*k + i*j*4) = (u::nat)";
+test "(2*n*m) + (3*(m*n)) = (u::nat)";
+(*negative numerals: FAIL*)
+test "Suc (i + j + -3 + k) = u";
+
+(*cancel_numeral_factors*)
+test "9*x = 12 * (y::nat)";
+test "(9*x) div (12 * (y::nat)) = z";
+test "9*x < 12 * (y::nat)";
+test "9*x <= 12 * (y::nat)";
+
+(*cancel_factor*)
+test "x*k = k*(y::nat)";
+test "k = k*(y::nat)";
+test "a*(b*c) = (b::nat)";
+test "a*(b*c) = d*(b::nat)*(x*a)";
+
+test "x*k < k*(y::nat)";
+test "k < k*(y::nat)";
+test "a*(b*c) < (b::nat)";
+test "a*(b*c) < d*(b::nat)*(x*a)";
+
+test "x*k <= k*(y::nat)";
+test "k <= k*(y::nat)";
+test "a*(b*c) <= (b::nat)";
+test "a*(b*c) <= d*(b::nat)*(x*a)";
+
+test "(x*k) div (k*(y::nat)) = (uu::nat)";
+test "(k) div (k*(y::nat)) = (uu::nat)";
+test "(a*(b*c)) div ((b::nat)) = (uu::nat)";
+test "(a*(b*c)) div (d*(b::nat)*(x*a)) = (uu::nat)";
+*)
+
+
+(*** Prepare linear arithmetic for nat numerals ***)
+
+local
+
+(* reduce contradictory <= to False *)
+val add_rules =
+ [@{thm Let_number_of}, @{thm Let_0}, @{thm Let_1}, nat_0, nat_1,
+ add_nat_number_of, diff_nat_number_of, mult_nat_number_of,
+ eq_nat_number_of, less_nat_number_of, le_number_of_eq_not_less,
+ le_Suc_number_of,le_number_of_Suc,
+ less_Suc_number_of,less_number_of_Suc,
+ Suc_eq_number_of,eq_number_of_Suc,
+ mult_Suc, mult_Suc_right,
+ eq_number_of_0, eq_0_number_of, less_0_number_of,
+ of_int_number_of_eq, of_nat_number_of_eq, nat_number_of, if_True, if_False];
+
+val simprocs = Nat_Numeral_Simprocs.combine_numerals
+ :: Nat_Numeral_Simprocs.cancel_numerals;
+
+in
+
+val nat_simprocs_setup =
+ Fast_Arith.map_data (fn {add_mono_thms, mult_mono_thms, inj_thms, lessD, neqE, simpset} =>
+ {add_mono_thms = add_mono_thms, mult_mono_thms = mult_mono_thms,
+ inj_thms = inj_thms, lessD = lessD, neqE = neqE,
+ simpset = simpset addsimps add_rules
+ addsimprocs simprocs});
+
+end;