Theory Word_Lib.Many_More
theory Many_More
imports
Main
"HOL-Library.Word"
More_Word
Even_More_List
begin
lemma nat_less_mult_monoish: "⟦ a < b; c < (d :: nat) ⟧ ⟹ (a + 1) * (c + 1) <= b * d"
apply (drule Suc_leI)+
apply (drule(1) mult_le_mono)
apply simp
done
context
includes bit_operations_syntax
begin
lemma if_and_helper:
"(If x v v') AND v'' = If x (v AND v'') (v' AND v'')"
by (rule if_distrib)
end
lemma eq_eqI:
"a = b ⟹ (a = x) = (b = x)"
by simp
lemma map2_Cons_2_3:
"(map2 f xs (y # ys) = (z # zs)) = (∃x xs'. xs = x # xs' ∧ f x y = z ∧ map2 f xs' ys = zs)"
by (case_tac xs, simp_all)
lemma map2_xor_replicate_False:
"map2 (λx y. x ⟷ ¬ y) xs (replicate n False) = take n xs"
apply (induct xs arbitrary: n, simp)
apply (case_tac n; simp)
done
lemma plus_Collect_helper:
"(+) x ` {xa. P (xa :: 'a :: len word)} = {xa. P (xa - x)}"
by (fastforce simp add: image_def)
lemma plus_Collect_helper2:
"(+) (- x) ` {xa. P (xa :: 'a :: len word)} = {xa. P (x + xa)}"
using plus_Collect_helper [of "- x" P] by (simp add: ac_simps)
lemma range_subset_eq2:
"{a :: 'a :: len word .. b} ≠ {} ⟹ ({a .. b} ⊆ {c .. d}) = (c ≤ a ∧ b ≤ d)"
by simp
lemma nat_mod_power_lem:
fixes a :: nat
shows "1 < a ⟹ a ^ n mod a ^ m = (if m ≤ n then 0 else a ^ n)"
apply (clarsimp)
apply (clarsimp simp add: le_iff_add power_add)
done
lemma i_hate_words_helper:
"i ≤ (j - k :: nat) ⟹ i ≤ j"
by simp
lemma i_hate_words:
"unat (a :: 'a word) ≤ unat (b :: 'a :: len word) - Suc 0
⟹ a ≠ -1"
apply (frule i_hate_words_helper)
apply (subst(asm) word_le_nat_alt[symmetric])
apply (clarsimp simp only: word_minus_one_le)
apply (simp only: linorder_not_less[symmetric])
apply (erule notE)
apply (rule diff_Suc_less)
apply (subst neq0_conv[symmetric])
apply (subst unat_eq_0)
apply (rule notI, drule arg_cong[where f="(+) 1"])
apply simp
done
lemma If_eq_obvious:
"x ≠ z ⟹ ((if P then x else y) = z) = (¬ P ∧ y = z)"
by simp
lemma Some_to_the:
"v = Some x ⟹ x = the v"
by simp
lemma dom_if_Some:
"dom (λx. if P x then Some (f x) else g x) = {x. P x} ∪ dom g"
by fastforce
lemma dom_insert_absorb:
"x ∈ dom f ⟹ insert x (dom f) = dom f"
by (fact insert_absorb)
lemma emptyE2:
"⟦ S = {}; x ∈ S ⟧ ⟹ P"
by simp
lemma ptr_add_image_multI:
"⟦ ⋀x y. (x * val = y * val') = (x * val'' = y); x * val'' ∈ S ⟧ ⟹
ptr_add ptr (x * val) ∈ (λp. ptr_add ptr (p * val')) ` S"
by (auto simp add: image_iff) metis
lemmas map_prod_split_imageI'
= map_prod_imageI[where f="case_prod f" and g="case_prod g"
and a="(a, b)" and b="(c, d)" for a b c d f g]
lemmas map_prod_split_imageI = map_prod_split_imageI'[simplified]
lemma dom_if:
"dom (λa. if a ∈ addrs then Some (f a) else g a) = addrs ∪ dom g"
by (auto simp: dom_def split: if_split)
lemmas arg_cong_Not = arg_cong [where f=Not]
lemma drop_append_miracle:
"n = length xs ⟹ drop n (xs @ ys) = ys"
by simp
lemma foldr_does_nothing_to_xf:
"⟦ ⋀x s. x ∈ set xs ⟹ xf (f x s) = xf s ⟧ ⟹ xf (foldr f xs s) = xf s"
by (induct xs, simp_all)
lemma mod_mod_power_int:
fixes k :: int
shows "k mod 2 ^ m mod 2 ^ n = k mod 2 ^ (min m n)"
by (fact mod_exp_eq)
lemma le_step_down_nat:"⟦(i::nat) ≤ n; i = n ⟶ P; i ≤ n - 1 ⟶ P⟧ ⟹ P"
by arith
lemma le_step_down_int:"⟦(i::int) ≤ n; i = n ⟶ P; i ≤ n - 1 ⟶ P⟧ ⟹ P"
by arith
lemma replicate_numeral [simp]: "replicate (numeral k) x = x # replicate (pred_numeral k) x"
by (simp add: numeral_eq_Suc)
lemma list_exhaust_size_gt0:
assumes "⋀a list. y = a # list ⟹ P"
shows "0 < length y ⟹ P"
apply (cases y)
apply simp
apply (rule assms)
apply fastforce
done
lemma list_exhaust_size_eq0:
assumes "y = [] ⟹ P"
shows "length y = 0 ⟹ P"
apply (cases y)
apply (rule assms)
apply simp
apply simp
done
lemma size_Cons_lem_eq: "y = xa # list ⟹ size y = Suc k ⟹ size list = k"
by auto
lemma takeWhile_take_has_property:
"n ≤ length (takeWhile P xs) ⟹ ∀x ∈ set (take n xs). P x"
by (induct xs arbitrary: n; simp split: if_split_asm) (case_tac n, simp_all)
lemma takeWhile_take_has_property_nth:
"⟦ n < length (takeWhile P xs) ⟧ ⟹ P (xs ! n)"
by (induct xs arbitrary: n; simp split: if_split_asm) (case_tac n, simp_all)
lemma takeWhile_replicate:
"takeWhile f (replicate len x) = (if f x then replicate len x else [])"
by (induct_tac len) auto
lemma takeWhile_replicate_empty:
"¬ f x ⟹ takeWhile f (replicate len x) = []"
by (simp add: takeWhile_replicate)
lemma takeWhile_replicate_id:
"f x ⟹ takeWhile f (replicate len x) = replicate len x"
by (simp add: takeWhile_replicate)
lemma nth_rev: "n < length xs ⟹ rev xs ! n = xs ! (length xs - 1 - n)"
using rev_nth by simp
lemma nth_rev_alt: "n < length ys ⟹ ys ! n = rev ys ! (length ys - Suc n)"
by (simp add: nth_rev)
lemma hd_butlast: "length xs > 1 ⟹ hd (butlast xs) = hd xs"
by (cases xs) auto
lemma split_upt_on_n:
"n < m ⟹ [0 ..< m] = [0 ..< n] @ [n] @ [Suc n ..< m]"
by (metis append_Cons append_Nil less_Suc_eq_le less_imp_le_nat upt_add_eq_append'
upt_rec zero_less_Suc)
lemma drop_eq_mono:
assumes le: "m ≤ n"
assumes drop: "drop m xs = drop m ys"
shows "drop n xs = drop n ys"
proof -
have ex: "∃p. n = p + m" by (rule exI[of _ "n - m"]) (simp add: le)
then obtain p where p: "n = p + m" by blast
show ?thesis unfolding p drop_drop[symmetric] drop by simp
qed
lemma drop_Suc_nth:
"n < length xs ⟹ drop n xs = xs!n # drop (Suc n) xs"
by (simp add: Cons_nth_drop_Suc)
lemma and_len: "xs = ys ⟹ xs = ys ∧ length xs = length ys"
by auto
lemma tl_if: "tl (if p then xs else ys) = (if p then tl xs else tl ys)"
by auto
lemma hd_if: "hd (if p then xs else ys) = (if p then hd xs else hd ys)"
by auto
lemma if_single: "(if xc then [xab] else [an]) = [if xc then xab else an]"
by auto
lemma if_Cons: "(if p then x # xs else y # ys) = If p x y # If p xs ys"
by auto
lemma list_of_false:
"True ∉ set xs ⟹ xs = replicate (length xs) False"
by (induct xs, simp_all)
lemma list_all2_induct [consumes 1, case_names Nil Cons]:
assumes lall: "list_all2 Q xs ys"
and nilr: "P [] []"
and consr: "⋀x xs y ys. ⟦list_all2 Q xs ys; Q x y; P xs ys⟧ ⟹ P (x # xs) (y # ys)"
shows "P xs ys"
using lall
proof (induct rule: list_induct2 [OF list_all2_lengthD [OF lall]])
case 1 then show ?case by auto fact+
next
case (2 x xs y ys)
show ?case
proof (rule consr)
from "2.prems" show "list_all2 Q xs ys" and "Q x y" by simp_all
then show "P xs ys" by (intro "2.hyps")
qed
qed
lemma replicate_minus:
"k < n ⟹ replicate n False = replicate (n - k) False @ replicate k False"
by (subst replicate_add [symmetric]) simp
lemma cart_singleton_empty:
"(S × {e} = {}) = (S = {})"
by blast
lemma MinI:
assumes fa: "finite A"
and ne: "A ≠ {}"
and xv: "m ∈ A"
and min: "∀y ∈ A. m ≤ y"
shows "Min A = m" using fa ne xv min
proof (induct A arbitrary: m rule: finite_ne_induct)
case singleton then show ?case by simp
next
case (insert y F)
from insert.prems have yx: "m ≤ y" and fx: "∀y ∈ F. m ≤ y" by auto
have "m ∈ insert y F" by fact
then show ?case
proof
assume mv: "m = y"
have mlt: "m ≤ Min F"
by (rule iffD2 [OF Min_ge_iff [OF insert.hyps(1) insert.hyps(2)] fx])
show ?case
apply (subst Min_insert [OF insert.hyps(1) insert.hyps(2)])
apply (subst mv [symmetric])
apply (auto simp: min_def mlt)
done
next
assume "m ∈ F"
then have mf: "Min F = m"
by (rule insert.hyps(4) [OF _ fx])
show ?case
apply (subst Min_insert [OF insert.hyps(1) insert.hyps(2)])
apply (subst mf)
apply (rule iffD2 [OF _ yx])
apply (auto simp: min_def)
done
qed
qed
lemma power_numeral: "a ^ numeral k = a * a ^ (pred_numeral k)"
by (simp add: numeral_eq_Suc)
lemma funpow_numeral [simp]: "f ^^ numeral k = f ∘ f ^^ (pred_numeral k)"
by (simp add: numeral_eq_Suc)
lemma funpow_minus_simp: "0 < n ⟹ f ^^ n = f ∘ f ^^ (n - 1)"
by (auto dest: gr0_implies_Suc)
lemma rco_alt: "(f ∘ g) ^^ n ∘ f = f ∘ (g ∘ f) ^^ n"
apply (rule ext)
apply (induct n)
apply (simp_all add: o_def)
done
lemma union_sub:
"⟦B ⊆ A; C ⊆ B⟧ ⟹ (A - B) ∪ (B - C) = (A - C)"
by fastforce
lemma insert_sub:
"x ∈ xs ⟹ (insert x (xs - ys)) = (xs - (ys - {x}))"
by blast
lemma ran_upd:
"⟦ inj_on f (dom f); f y = Some z ⟧ ⟹ ran (λx. if x = y then None else f x) = ran f - {z}"
unfolding ran_def
apply (rule set_eqI)
apply simp
by (metis domI inj_on_eq_iff option.sel)
lemma if_apply_def2:
"(if P then F else G) = (λx. (P ⟶ F x) ∧ (¬ P ⟶ G x))"
by simp
lemma case_bool_If:
"case_bool P Q b = (if b then P else Q)"
by simp
lemma if_f:
"(if a then f b else f c) = f (if a then b else c)"
by simp
lemma size_if: "size (if p then xs else ys) = (if p then size xs else size ys)"
by (fact if_distrib)
lemma if_Not_x: "(if p then ¬ x else x) = (p = (¬ x))"
by auto
lemma if_x_Not: "(if p then x else ¬ x) = (p = x)"
by auto
lemma if_same_and: "(If p x y ∧ If p u v) = (if p then x ∧ u else y ∧ v)"
by auto
lemma if_same_eq: "(If p x y = (If p u v)) = (if p then x = u else y = v)"
by auto
lemma if_same_eq_not: "(If p x y = (¬ If p u v)) = (if p then x = (¬ u) else y = (¬ v))"
by auto
lemma the_elemI: "y = {x} ⟹ the_elem y = x"
by simp
lemma nonemptyE: "S ≠ {} ⟹ (⋀x. x ∈ S ⟹ R) ⟹ R"
by auto
lemmas xtr1 = xtrans(1)
lemmas xtr2 = xtrans(2)
lemmas xtr3 = xtrans(3)
lemmas xtr4 = xtrans(4)
lemmas xtr5 = xtrans(5)
lemmas xtr6 = xtrans(6)
lemmas xtr7 = xtrans(7)
lemmas xtr8 = xtrans(8)
lemmas if_fun_split = if_apply_def2
lemma not_empty_eq:
"(S ≠ {}) = (∃x. x ∈ S)"
by auto
lemma range_subset_lower:
fixes c :: "'a ::linorder"
shows "⟦ {a..b} ⊆ {c..d}; x ∈ {a..b} ⟧ ⟹ c ≤ a"
apply (frule (1) subsetD)
apply (rule classical)
apply clarsimp
done
lemma range_subset_upper:
fixes c :: "'a ::linorder"
shows "⟦ {a..b} ⊆ {c..d}; x ∈ {a..b} ⟧ ⟹ b ≤ d"
apply (frule (1) subsetD)
apply (rule classical)
apply clarsimp
done
lemma range_subset_eq:
fixes a::"'a::linorder"
assumes non_empty: "a ≤ b"
shows "({a..b} ⊆ {c..d}) = (c ≤ a ∧ b ≤ d)"
apply (insert non_empty)
apply (rule iffI)
apply (frule range_subset_lower [where x=a], simp)
apply (drule range_subset_upper [where x=a], simp)
apply simp
apply auto
done
lemma range_eq:
fixes a::"'a::linorder"
assumes non_empty: "a ≤ b"
shows "({a..b} = {c..d}) = (a = c ∧ b = d)"
by (metis atLeastatMost_subset_iff eq_iff non_empty)
lemma range_strict_subset_eq:
fixes a::"'a::linorder"
assumes non_empty: "a ≤ b"
shows "({a..b} ⊂ {c..d}) = (c ≤ a ∧ b ≤ d ∧ (a = c ⟶ b ≠ d))"
apply (insert non_empty)
apply (subst psubset_eq)
apply (subst range_subset_eq, assumption+)
apply (subst range_eq, assumption+)
apply simp
done
lemma range_subsetI:
fixes x :: "'a :: order"
assumes xX: "X ≤ x"
and yY: "y ≤ Y"
shows "{x .. y} ⊆ {X .. Y}"
using xX yY by auto
lemma set_False [simp]:
"(set bs ⊆ {False}) = (True ∉ set bs)" by auto
lemma int_not_emptyD:
"A ∩ B ≠ {} ⟹ ∃x. x ∈ A ∧ x ∈ B"
by (erule contrapos_np, clarsimp simp: disjoint_iff_not_equal)
definition
sum_map :: "('a ⇒ 'b) ⇒ ('c ⇒ 'd) ⇒ 'a + 'c ⇒ 'b + 'd" where
"sum_map f g x ≡ case x of Inl v ⇒ Inl (f v) | Inr v' ⇒ Inr (g v')"
lemma sum_map_simps[simp]:
"sum_map f g (Inl v) = Inl (f v)"
"sum_map f g (Inr w) = Inr (g w)"
by (simp add: sum_map_def)+
lemma if_Some_None_eq_None:
"((if P then Some v else None) = None) = (¬ P)"
by simp
lemma CollectPairFalse [iff]:
"{(a,b). False} = {}"
by (simp add: split_def)
lemma if_conj_dist:
"((if b then w else x) ∧ (if b then y else z) ∧ X) =
((if b then w ∧ y else x ∧ z) ∧ X)"
by simp
lemma if_P_True1:
"Q ⟹ (if P then True else Q)"
by simp
lemma if_P_True2:
"Q ⟹ (if P then Q else True)"
by simp
lemmas nat_simps = diff_add_inverse2 diff_add_inverse
lemmas nat_iffs = le_add1 le_add2
lemma nat_min_simps:
"(a::nat) ≤ b ⟹ min b a = a"
"a ≤ b ⟹ min a b = a"
by simp_all
lemmas zadd_diff_inverse =
trans [OF diff_add_cancel [symmetric] add.commute]
lemmas add_diff_cancel2 =
add.commute [THEN diff_eq_eq [THEN iffD2]]
lemmas mcl = mult_cancel_left [THEN iffD1, THEN make_pos_rule]
lemma pl_pl_rels: "a + b = c + d ⟹ a ≥ c ∧ b ≤ d ∨ a ≤ c ∧ b ≥ d"
for a b c d :: nat
by arith
lemmas pl_pl_rels' = add.commute [THEN [2] trans, THEN pl_pl_rels]
lemma iszero_minus:
‹iszero (- z) ⟷ iszero z›
by (simp add: iszero_def)
lemma diff_le_eq': "a - b ≤ c ⟷ a ≤ b + c"
for a b c :: int
by arith
lemma zless2: "0 < (2 :: int)"
by (fact zero_less_numeral)
lemma zless2p: "0 < (2 ^ n :: int)"
by arith
lemma zle2p: "0 ≤ (2 ^ n :: int)"
by arith
lemma ex_eq_or: "(∃m. n = Suc m ∧ (m = k ∨ P m)) ⟷ n = Suc k ∨ (∃m. n = Suc m ∧ P m)"
by auto
lemma power_minus_simp: "0 < n ⟹ a ^ n = a * a ^ (n - 1)"
by (auto dest: gr0_implies_Suc)
lemma n2s_ths:
‹2 + n = Suc (Suc n)›
‹n + 2 = Suc (Suc n)›
by (fact add_2_eq_Suc add_2_eq_Suc')+
lemma s2n_ths:
‹Suc (Suc n) = 2 + n›
‹Suc (Suc n) = n + 2›
by simp_all
lemma gt_or_eq_0: "0 < y ∨ 0 = y"
for y :: nat
by arith
lemma sum_imp_diff: "j = k + i ⟹ j - i = k"
for k :: nat
by simp
lemma le_diff_eq': "a ≤ c - b ⟷ b + a ≤ c"
for a b c :: int
by arith
lemma less_diff_eq': "a < c - b ⟷ b + a < c"
for a b c :: int
by arith
lemma diff_less_eq': "a - b < c ⟷ a < b + c"
for a b c :: int
by arith
lemma axxbyy: "a + m + m = b + n + n ⟹ a = 0 ∨ a = 1 ⟹ b = 0 ∨ b = 1 ⟹ a = b ∧ m = n"
for a b m n :: int
by arith
lemma minus_eq: "m - k = m ⟷ k = 0 ∨ m = 0"
for k m :: nat
by arith
lemma pl_pl_mm: "a + b = c + d ⟹ a - c = d - b"
for a b c d :: nat
by arith
lemmas pl_pl_mm' = add.commute [THEN [2] trans, THEN pl_pl_mm]
lemma less_le_mult': "w * c < b * c ⟹ 0 ≤ c ⟹ (w + 1) * c ≤ b * c"
for b c w :: int
apply (rule mult_right_mono)
apply (rule zless_imp_add1_zle)
apply (erule (1) mult_right_less_imp_less)
apply assumption
done
lemma less_le_mult: "w * c < b * c ⟹ 0 ≤ c ⟹ w * c + c ≤ b * c"
for b c w :: int
using less_le_mult' [of w c b] by (simp add: algebra_simps)
lemmas less_le_mult_minus = iffD2 [OF le_diff_eq less_le_mult,
simplified left_diff_distrib]
lemma gen_minus: "0 < n ⟹ f n = f (Suc (n - 1))"
by auto
lemma mpl_lem: "j ≤ i ⟹ k < j ⟹ i - j + k < i"
for i j k :: nat
by arith
lemmas dme = div_mult_mod_eq
lemmas dtle = div_times_less_eq_dividend
lemmas th2 = order_trans [OF order_refl [THEN [2] mult_le_mono] div_times_less_eq_dividend]
lemmas sdl = div_nat_eqI
lemma given_quot: "f > 0 ⟹ (f * l + (f - 1)) div f = l"
for f l :: nat
by (rule div_nat_eqI) (simp_all)
lemma given_quot_alt: "f > 0 ⟹ (l * f + f - Suc 0) div f = l"
for f l :: nat
apply (frule given_quot)
apply (rule trans)
prefer 2
apply (erule asm_rl)
apply (rule_tac f="λn. n div f" in arg_cong)
apply (simp add : ac_simps)
done
lemma x_power_minus_1:
fixes x :: "'a :: {ab_group_add, power, numeral, one}"
shows "x + (2::'a) ^ n - (1::'a) = x + (2 ^ n - 1)" by simp
lemma nat_diff_add:
fixes i :: nat
shows "⟦ i + j = k ⟧ ⟹ i = k - j"
by arith
lemma pow_2_gt: "n ≥ 2 ⟹ (2::int) < 2 ^ n"
by (induct n) auto
lemma sum_to_zero:
"(a :: 'a :: ring) + b = 0 ⟹ a = (- b)"
by (drule arg_cong[where f="λ x. x - a"], simp)
lemma arith_is_1:
"⟦ x ≤ Suc 0; x > 0 ⟧ ⟹ x = 1"
by arith
lemma suc_le_pow_2:
"1 < (n::nat) ⟹ Suc n < 2 ^ n"
by (induct n; clarsimp)
(case_tac "n = 1"; clarsimp)
lemma nat_le_Suc_less_imp:
"x < y ⟹ x ≤ y - Suc 0"
by arith
lemma power_sub_int:
"⟦ m ≤ n; 0 < b ⟧ ⟹ b ^ n div b ^ m = (b ^ (n - m) :: int)"
apply (subgoal_tac "∃n'. n = m + n'")
apply (clarsimp simp: power_add)
apply (rule exI[where x="n - m"])
apply simp
done
lemma nat_Suc_less_le_imp:
"(k::nat) < Suc n ⟹ k ≤ n"
by auto
lemma nat_add_less_by_max:
"⟦ (x::nat) ≤ xmax ; y < k - xmax ⟧ ⟹ x + y < k"
by simp
lemma nat_le_Suc_less:
"0 < y ⟹ (x ≤ y - Suc 0) = (x < y)"
by arith
lemma nat_power_minus_less:
"a < 2 ^ (x - n) ⟹ (a :: nat) < 2 ^ x"
by (erule order_less_le_trans) simp
lemma less_le_mult_nat':
"w * c < b * c ==> 0 ≤ c ==> Suc w * c ≤ b * (c::nat)"
apply (rule mult_right_mono)
apply (rule Suc_leI)
apply (erule (1) mult_right_less_imp_less)
apply assumption
done
lemma less_le_mult_nat:
‹0 < c ∧ w < b ⟹ c + w * c ≤ b * c› for b c w :: nat
using less_le_mult_nat' [of w c b] by simp
lemma p_assoc_help:
fixes p :: "'a::{ring,power,numeral,one}"
shows "p + 2^sz - 1 = p + (2^sz - 1)"
by simp
lemma pow_mono_leq_imp_lt:
"x ≤ y ⟹ x < 2 ^ y"
by (simp add: le_less_trans)
lemma small_powers_of_2:
"x ≥ 3 ⟹ x < 2 ^ (x - 1)"
by (induct x; simp add: suc_le_pow_2)
lemma nat_less_power_trans2:
fixes n :: nat
shows "⟦n < 2 ^ (m - k); k ≤ m⟧ ⟹ n * 2 ^ k < 2 ^ m"
by (subst mult.commute, erule (1) nat_less_power_trans)
lemma nat_move_sub_le: "(a::nat) + b ≤ c ⟹ a ≤ c - b"
by arith
lemma plus_minus_one_rewrite:
"v + (- 1 :: ('a :: {ring, one, uminus})) ≡ v - 1"
by (simp add: field_simps)
lemma Suc_0_lt_2p_len_of: "Suc 0 < 2 ^ LENGTH('a :: len)"
by (metis One_nat_def len_gt_0 lessI numeral_2_eq_2 one_less_power)
lemma bin_rest_code: "i div 2 = drop_bit 1 i" for i :: int
by (simp add: drop_bit_eq_div)
end