(* * Copyright Data61, CSIRO (ABN 41 687 119 230) * * SPDX-License-Identifier: BSD-2-Clause *) 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_empty: "\ f x \ takeWhile f (replicate len x) = []" by simp lemma takeWhile_replicate_id: "f x \ takeWhile f (replicate len x) = replicate len x" by simp lemma takeWhile_all: "length (takeWhile P xs) = length xs \ \x \ set xs. P x" by (induct xs) (auto split: if_split_asm) 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 \ \note -- \if_Cons\ can cause blowup in the size, if \p\ is complex, so make a simproc\ 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 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