(* Title: Hoare Logic
   Author: Georg Struth
*)

section \<open>Hoare Logic\<close>

theory HL
  imports PHL Store

begin

subsection \<open>Assignment Rules\<close>

lemma rH_assign_iff [simp]: "H\<^sub>r P (v :=\<^sub>r e) Q = (\<forall>s. P s \<longrightarrow> Q (set v e s))"
  sorry

lemma rH_assign: "H\<^sub>r (P \<circ> (set v e)) (v :=\<^sub>r e) P"
  sorry

lemma rH_assign_floyd: "H\<^sub>r P (v :=\<^sub>r e) (\<lambda>s. \<exists>w. s v = e (set v w s) \<and> P (set v w s))"
proof-
  {fix s
  assume "P s"
  hence "e s = e (fup v (s v) s) \<and> P (fup v (s v) s)"
    by simp
  hence "\<exists>w. e s = e (set v w s) \<and> P (set v w s)"
    by meson
  hence "\<exists>w. e s = e (set v w (set v e s)) \<and> P (set v w (set v e s))"
    by auto
  hence "\<exists>w. set v e s v = e (set v w (set v e s)) \<and> P (set v w (set v e s))"
    by simp
  hence "(\<lambda>s. \<exists>w. s v = e (set v w s) \<and> P (set v w s)) (set v e s)"
    by simp}
  thus ?thesis
    unfolding rH_assign_iff by simp
qed

abbreviation rH_sugar :: "'a pred \<Rightarrow> 'a rel \<Rightarrow> 'a pred \<Rightarrow> bool" ("rPRE _ _ POST _" [64,64,64] 63) where
  "rPRE P R POST Q \<equiv> H\<^sub>r P R Q"

text \<open>Next we consider state transformers.\<close>

lemma sH_assign_iff [simp]: "H\<^sub>s P (v :=\<^sub>s e) Q = (\<forall>s. P s \<longrightarrow> Q (set v e s))"
  sorry

lemma sH_assign: "H\<^sub>s (P \<circ> (set v e)) (v :=\<^sub>s e) P"
  sorry

lemma sH_assign_floyd: "H\<^sub>s P (v :=\<^sub>s e) (\<lambda>s. \<exists>w::'a store \<Rightarrow> 'a. s v = e (set v w s) \<and> P (set v w s))"
  sorry

abbreviation sH_sugar :: "'a pred \<Rightarrow> 'a sta \<Rightarrow> 'a pred \<Rightarrow> bool" ("sPRE _ _ POST _" [64,64,64] 63) where
  "sPRE P f POST Q \<equiv> H\<^sub>s P f Q"

text \<open>The rules are set up in such a way that it should make no difference whether we work in the
relational or the state transformer semantics. Yet this needs more testing.\<close>

subsection \<open>Examples\<close>

lemma "rPRE (\<lambda>s. True) (''q'' :=\<^sub>r (\<lambda>s. 0)) POST (\<lambda>s. s ''q'' = 0)"
  sorry

lemma "sPRE (\<lambda>s. True) (''r'' :=\<^sub>s (\<lambda>s. s ''x'')) POST (\<lambda>s. s ''r'' = s ''x'')"
  sorry

lemma "rPRE (\<lambda>s. s ''q'' = n) (''q'' :=\<^sub>r (\<lambda>s. s ''q'' + 1)) POST (\<lambda>s. s ''q'' = n + 1)"
  sorry

lemma "sPRE (\<lambda>s. s ''r'' - s y = n) (''r'' :=\<^sub>s (\<lambda>s. s ''r'' - s y)) POST (\<lambda>s. s ''r'' = n)"
  sorry

lemma "rPRE (\<lambda>s. 5 = 5) (''x'' :=\<^sub>r (\<lambda>s. 5)) POST (\<lambda>s. s ''x'' = 5)"
  sorry

lemma "sPRE (\<lambda>s. 5 = 5) (''x'' :=\<^sub>s (\<lambda>s. 5)) POST (\<lambda>s. s ''x'' = 5)"
  sorry

lemma "rPRE (\<lambda>s. s ''x'' = 1) (''x'' :=\<^sub>r (\<lambda>s. s ''x'' + 1)) POST (\<lambda>s. s ''x'' = 2)"
  sorry

lemma rvarible_swap:
  "rPRE (\<lambda>s. s ''x'' = m \<and> s ''y'' = n)
    (''z'' :=\<^sub>r (\<lambda>s. s ''x''));
    (''x'' :=\<^sub>r (\<lambda>s. s ''y''));
    (''y'' :=\<^sub>r (\<lambda>s. s ''z''))
   POST (\<lambda>s. s ''x'' = n \<and> s ''y'' = m)"
  sorry

lemma svarible_swap:
  "sPRE (\<lambda>s. s ''x'' = m \<and> s ''y'' = n)
    (''z'' :=\<^sub>s (\<lambda>s. s ''x'')) \<circ>\<^sub>K
    (''x'' :=\<^sub>s (\<lambda>s. s ''y'')) \<circ>\<^sub>K
    (''y'' :=\<^sub>s (\<lambda>s. s ''z''))
   POST (\<lambda>s. s ''x'' = n \<and> s ''y'' = m)"
  sorry

lemma rmaximum:
  "rPRE (\<lambda>s::int store. True)
   (rif (\<lambda>s. s ''x'' \<ge> s ''y'')
    then (''z'' :=\<^sub>r (\<lambda>s. s ''x''))
    else (''z'' :=\<^sub>r (\<lambda>s. s ''y''))
    fi)
   POST (\<lambda>s. s ''z'' = max (s ''x'') (s ''y''))"
  sorry

lemma smaximum:
  "sPRE (\<lambda>s:: int store. True)
   (sif (\<lambda>s. s ''x'' \<ge> s ''y'')
    then (''z'' :=\<^sub>s (\<lambda>s. s ''x''))
    else (''z'' :=\<^sub>s (\<lambda>s. s ''y''))
    fi)
   POST (\<lambda>s. s ''z'' = max (s ''x'') (s ''y''))"
  sorry

lemma rinteger_division:
  assumes "q = ''q''" and "r = ''r''"
  shows
  "rPRE (\<lambda>s::nat store. 0 < y)
    (q :=\<^sub>r (\<lambda>s. 0));
    (r :=\<^sub>r (\<lambda>s. x));
    (rwhile (\<lambda>s. y \<le> s r) inv (\<lambda>s. x = s q * y + s r \<and> 0 \<le> s r)
     do
      (q :=\<^sub>r (\<lambda>s. s q + 1));
      (r :=\<^sub>r (\<lambda>s. s r - y))
     od)
   POST (\<lambda>s. x = s q * y + s r \<and> 0 \<le> s r \<and> s r < y)"
  sorry

lemma sinteger_division:
  assumes "q = ''q''" and "r = ''r''"
  shows
  "sPRE (\<lambda>s::nat store. 0 < y)
    (q :=\<^sub>s (\<lambda>s. 0)) \<circ>\<^sub>K
    (r :=\<^sub>s (\<lambda>s. x)) \<circ>\<^sub>K
    (swhile (\<lambda>s. y \<le> s r) inv (\<lambda>s. x = s q * y + s r)
     do
      (q :=\<^sub>s (\<lambda>s. s q + 1)) \<circ>\<^sub>K
      (r :=\<^sub>s (\<lambda>s. s r - y))
     od)
   POST (\<lambda>s. x = s q * y + s r \<and> s r < y)"
  sorry

end


(* Author: Tobias Nipkow, Dmitriy Traytel *)

section \<open>Linear Time Optimization for ``Mark After Atom''\<close>

(*<*)
theory After2
imports
  Position_Autos
begin
(*>*)

datatype 'a mrexp2 =
  Zero2 |
  One2 |
  Atom2 (fin: bool) 'a |
  Plus2 "'a mrexp2" "'a mrexp2" (fin: bool) (nul: bool) |
  Times2 "'a mrexp2" "'a mrexp2" (fin: bool) (nul: bool) |
  Star2 "'a mrexp2" (fin: bool)
where
  "fin Zero2 = False"
| "nul Zero2 = False"
| "fin One2 = False"
| "nul One2 = True"
| "nul (Atom2 _ _) = False"
| "nul (Star2 _ _) = True"

primrec mrexps2 :: "'a rexp \<Rightarrow> ('a mrexp2) set" where
  "mrexps2 Zero = {Zero2}"
| "mrexps2 One = {One2} "
| "mrexps2 (Atom a) = {Atom2 True a, Atom2 False a}"
| "mrexps2 (Plus r s) = (\<lambda>(r, s, f, n). Plus2 r s f n) ` (mrexps2 r \<times> mrexps2 s \<times> UNIV)"
| "mrexps2 (Times r s) = (\<lambda>(r, s, f, n). Times2 r s f n) ` (mrexps2 r \<times> mrexps2 s  \<times> UNIV)"
| "mrexps2 (Star r) = (\<lambda>(r, f). Star2 r f) ` (mrexps2 r \<times> UNIV)"

lemma finite_mrexps3[simp]: "finite (mrexps2 r)"
by (induction r) auto

definition[simp]: "plus2 r s == Plus2 r s (fin r \<or> fin s) (nul r \<or> nul s)"
definition[simp]: "times2 r s == Times2 r s (fin r \<and> nul s \<or> fin s) (nul r \<and> nul s)"
definition[simp]: "star2 r == Star2 r (fin r)"

primrec empty_mrexp2 :: "'a rexp \<Rightarrow> 'a mrexp2" where
"empty_mrexp2 Zero = Zero2" |
"empty_mrexp2 One = One2" |
"empty_mrexp2 (Atom x) = Atom2 False x" |
"empty_mrexp2 (Plus r s) = plus2 (empty_mrexp2 r) (empty_mrexp2 s)" |
"empty_mrexp2 (Times r s) = times2 (empty_mrexp2 r) (empty_mrexp2 s)" |
"empty_mrexp2 (Star r) = star2 (empty_mrexp2 r)"

primrec shift2 :: "bool \<Rightarrow> 'a mrexp2 \<Rightarrow> 'a \<Rightarrow> 'a mrexp2" where
"shift2 _ One2 _ = One2" |
"shift2 _ Zero2 _ = Zero2" |
"shift2 m (Atom2 _ x) c = Atom2 (m \<and> (x=c)) x" |
"shift2 m (Plus2 r s _ _) c = plus2 (shift2 m r c) (shift2 m s c)" |
"shift2 m (Times2 r s _ _) c = times2 (shift2 m r c) (shift2 (m \<and> nul r \<or> fin r) s c)" |
"shift2 m (Star2 r _) c =  star2 (shift2 (m \<or> fin r) r c)"

primrec strip2 where
"strip2 Zero2 = Zero" |
"strip2 One2 = One" |
"strip2 (Atom2 m x) = Atom (m, x)" |
"strip2 (Plus2 r s _ _) = Plus (strip2 r) (strip2 s)" |
"strip2 (Times2 r s _ _) = Times (strip2 r) (strip2 s)" |
"strip2 (Star2 r _) = Star (strip2 r)"

lemma strip_mrexps2: "(strip o strip2) ` mrexps2 r = {r}"
by (induction r) (auto simp: set_eq_subset subset_iff image_iff)

primrec ok2 :: "'a mrexp2 \<Rightarrow> bool" where
"ok2 Zero2 = True" |
"ok2 One2 = True" |
"ok2 (Atom2 _ _) = True" |
"ok2 (Plus2 r s f n) = (ok2 r \<and> ok2 s \<and>
   (let rs = Plus (strip2 r) (strip2 s) in f = final rs \<and> n = nullable rs))" |
"ok2 (Times2 r s f n) = (ok2 r \<and> ok2 s \<and>
   (let rs = Times (strip2 r) (strip2 s) in f = final rs \<and> n = nullable rs))" |
"ok2 (Star2 r f) = (ok2 r \<and> f = final (strip2 r))"

lemma ok2_fin_final[simp]: "ok2 r \<Longrightarrow> fin r = final (strip2 r)"
  by (induct r) auto

lemma ok2_nul_nullable[simp]: "ok2 r \<Longrightarrow> nul r = nullable (strip2 r)"
  by (induct r) auto

lemma strip2_shift2: "ok2 r \<Longrightarrow> strip2(shift2 m r c) = shift m (strip2 r) c"
apply(induction r arbitrary: m)
apply (auto simp: disj_commute)
done

lemma ok2_empty_mrexp2: "ok2 (empty_mrexp2 r)"
apply(induction r)
apply auto
done

lemma ok2_shift2: "ok2 r \<Longrightarrow> ok2(shift2 m r c)"
apply(induction r arbitrary: m)
apply auto
done

lemma strip2_empty_mrexp2[simp]: "strip2 (empty_mrexp2 r) = empty_mrexp r"
  by (induct r) auto

lemma nul_empty_mrexp2[simp]: "nul (empty_mrexp2 r) = nullable r"
  by (induct r) auto

lemma nonfin_empty_mrexp2[simp]: "\<not> fin (empty_mrexp2 r)"
  by (induct r) auto

lemma empty_mrexp2_mrexps2[simp]: "empty_mrexp2 s \<in> mrexps2 s"
  by (induct s) (auto simp: image_iff)

lemma shift2_mrexps2[simp]: "r \<in> mrexps2 s \<Longrightarrow> shift2 x r a \<in> mrexps2 s"
  by (induct s arbitrary: r x) (auto simp: image_iff)

typedef 'a ok_mrexp2 = "{(b :: bool, r :: 'a mrexp2). ok2 r}"
  unfolding mem_Collect_eq split_beta by (metis snd_eqD ok2_empty_mrexp2)

setup_lifting type_definition_ok_mrexp2

lift_definition init_okm :: "'a rexp \<Rightarrow> 'a ok_mrexp2" is "\<lambda>r. (True, empty_mrexp2 r)"
  by (simp add: ok2_empty_mrexp2 del: ok2.simps)
lift_definition delta_okm :: "'a \<Rightarrow> 'a ok_mrexp2 \<Rightarrow> 'a ok_mrexp2" is
  "\<lambda>a (m, r). (False, shift2 m r a)"
  unfolding mem_Collect_eq split_beta snd_conv by (intro ok2_shift2) simp
lift_definition nullable_okm :: "'a ok_mrexp2 \<Rightarrow> bool" is "\<lambda>(m, r). fin r \<or> m \<and> nul r" .
lift_definition lang_okm :: "'a ok_mrexp2 \<Rightarrow> 'a lang" is "\<lambda>(m, r). L_a (m, strip2 r)" .

instantiation ok_mrexp2 :: (equal) "equal"
begin

fun eq_mrexp2 where
  "eq_mrexp2 Zero2 Zero2 = True"
| "eq_mrexp2 One2 One2 = True"
| "eq_mrexp2 (Atom2 m x) (Atom2 m' y) = (m = m' \<and> x = y)"
| "eq_mrexp2 (Plus2 r1 s1 _ _) (Plus2 r2 s2 _ _) = (eq_mrexp2 r1 r2 \<and> eq_mrexp2 s1 s2)"
| "eq_mrexp2 (Times2 r1 s1 _ _) (Times2 r2 s2 _ _) = (eq_mrexp2 r1 r2 \<and> eq_mrexp2 s1 s2)"
| "eq_mrexp2 (Star2 r1 _) (Star2 r2 _) = (eq_mrexp2 r1 r2)"
| "eq_mrexp2 r s = False"

lemma eq_mrexp2_imp_eq: "\<lbrakk>eq_mrexp2 r s; ok2 r; ok2 s\<rbrakk> \<Longrightarrow> (r = s)"
  by (induct rule: eq_mrexp2.induct) auto

lemma eq_mrexp2_refl[simplified, simp]: "r = s \<Longrightarrow> eq_mrexp2 r s"
  by (induct rule: eq_mrexp2.induct) auto

lemma eq_mrexp2_eq: "\<lbrakk>ok2 r; ok2 s\<rbrakk> \<Longrightarrow> eq_mrexp2 r s = (r = s)"
  by (metis eq_mrexp2_imp_eq eq_mrexp2_refl)

lift_definition equal_ok_mrexp2 :: "'a ok_mrexp2 \<Rightarrow> 'a ok_mrexp2 \<Rightarrow> bool"
   is "\<lambda>(b1,r1) (b2, r2). b1 = b2 \<and> eq_mrexp2 r1 r2" .

instance by intro_classes (transfer, auto simp: eq_mrexp2_eq)

end

global_interpretation after2: rexp_DFA init_okm delta_okm nullable_okm lang_okm
  defines after2_closure = after2.closure
    and check_eqv_a2 = after2.check_eqv
    and reachable_a2 = after2.reachable
    and automaton_a2 = after2.automaton
    and match_a2 = after2.match
proof (standard, goal_cases)
  case (1 r) show "lang_okm (init_okm r) = lang r"
    by transfer (auto simp: split_beta init_a_def nonfinal_empty_mrexp Lm_follow Lm_empty
      map_map_rexp nullable_iff)
next
  case (2 a br) show "lang_okm (delta_okm a br) = Deriv a (lang_okm br)"
    apply transfer
    unfolding split_beta fst_conv snd_conv mem_Collect_eq after.L_delta[symmetric] delta_a.simps
      shift_read_follow[symmetric]
    by (subst strip2_shift2) simp_all
next
  case (3 br) show  "nullable_okm br = ([] \<in> lang_okm br)"
    by transfer (simp add: split_beta)
next
  case (4 s)
  have "{fold (\<lambda>a (m, r). (False, shift2 m r a)) w (True, empty_mrexp2 s) |w. True} \<subseteq>
    UNIV \<times> mrexps2 s"
  proof (intro subsetI, elim CollectE exE conjE, hypsubst)
    fix w show "fold (\<lambda>a (m, r). (False, shift2 m r a)) w (True, empty_mrexp2 s) \<in>
      UNIV \<times> mrexps2 s"
    by (induct w rule: rev_induct) (auto simp: split: prod.splits intro!: shift2_mrexps2)
  qed
  then show "finite {fold delta_okm w (init_okm s) |w. True}"
    by transfer (erule finite_subset[OF subset_trans[rotated]], auto)
qed

(*<*)
end
(*>*)


(*  Title:      Bits_Int.thy
    Author:     Andreas Lochbihler, ETH Zurich
*)

chapter {* More bit operations on integers *}

theory More_Bits_Int
imports
  "~~/src/HOL/Word/Bits_Bit"
  "~~/src/HOL/Word/Bool_List_Representation"
begin

lemma last_rev' [simp]: "last (rev xs) = hd xs"
by(cases xs)(simp add: last_def hd_def, simp)

lemma butlast_rev [simp]: "butlast (rev xs) = rev (tl xs)"
by(cases xs) simp_all

lemma tl_upt [simp]: "tl [n..<m] = [Suc n..<m]"
by(cases "n < m")(simp_all add: upt_conv_Cons)

lemma nat_LEAST_True [simp]: "(LEAST _ :: nat. True) = 0"
by(auto intro: Least_equality)

lemma nat_less_numeral_unfold: fixes n :: nat shows
  "n < numeral w \<longleftrightarrow> n = pred_numeral w \<or> n < pred_numeral w"
by(auto simp add: numeral_eq_Suc)

section {* Lemmas about bit operations on @{typ int} *}

lemma twice_conv_BIT: "2 * x = x BIT False"
by(rule bin_rl_eqI)(simp_all, simp_all add: bin_rest_def bin_last_def)

lemma not_int_cmp_0 [simp]:
  fixes i :: int shows
  "0 < NOT i \<longleftrightarrow> i < -1"
  "0 \<le> NOT i \<longleftrightarrow> i < 0"
  "NOT i < 0 \<longleftrightarrow> i \<ge> 0"
  "NOT i \<le> 0 \<longleftrightarrow> i \<ge> -1"
by(simp_all add: int_not_def) arith+

lemma bbw_ao_dist2: "(x :: int) AND (y OR z) = x AND y OR x AND z"
by(metis int_and_comm bbw_ao_dist)

lemmas int_and_ac = bbw_lcs(1) int_and_comm int_and_assoc

lemma bit_nand_same [simp]: fixes x :: bit shows "x AND NOT x = 0"
by(cases x) simp_all

lemma int_nand_same [simp]: fixes x :: int shows "x AND NOT x = 0"
by(induct x y\<equiv>"NOT x" rule: bitAND_int.induct)(subst bitAND_int.simps, clarsimp)

lemma int_nand_same_middle: fixes x :: int shows "x AND y AND NOT x = 0"
by (metis bbw_lcs(1) int_and_0 int_nand_same)

lemma and_xor_dist: fixes x :: int shows
  "x AND (y XOR z) = (x AND y) XOR (x AND z)"
by(simp add: int_xor_def bbw_ao_dist2 bbw_ao_dist bbw_not_dist int_and_ac int_nand_same_middle)

lemma BIT_lt0 [simp]: "x BIT b < 0 \<longleftrightarrow> x < 0"
by(cases b)(auto simp add: Bit_def)

lemma BIT_ge0 [simp]: "x BIT b \<ge> 0 \<longleftrightarrow> x \<ge> 0"
by(cases b)(auto simp add: Bit_def)

lemma bin_rest_gt_0 [simp]: "bin_rest x > 0 \<longleftrightarrow> x > 1"
by(simp add: bin_rest_def add1_zle_eq pos_imp_zdiv_pos_iff) (metis add1_zle_eq one_add_one)

lemma int_and_lt0 [simp]: fixes x y :: int shows
  "x AND y < 0 \<longleftrightarrow> x < 0 \<and> y < 0"
by(induct x y rule: bitAND_int.induct)(subst bitAND_int.simps, simp)

lemma int_and_ge0 [simp]: fixes x y :: int shows
  "x AND y \<ge> 0 \<longleftrightarrow> x \<ge> 0 \<or> y \<ge> 0"
by (metis int_and_lt0 linorder_not_less)

lemma int_and_1: fixes x :: int shows "x AND 1 = x mod 2"
by(subst bitAND_int.simps)(simp add: Bit_def bin_last_def zmod_minus1)

lemma int_1_and: fixes x :: int shows "1 AND x = x mod 2"
by(subst int_and_comm)(simp add: int_and_1)

lemma int_or_lt0 [simp]: fixes x y :: int shows
  "x OR y < 0 \<longleftrightarrow> x < 0 \<or> y < 0"
by(simp add: int_or_def)

lemma int_xor_lt0 [simp]: fixes x y :: int shows
  "x XOR y < 0 \<longleftrightarrow> ((x < 0) \<noteq> (y < 0))"
by(auto simp add: int_xor_def)

lemma int_xor_ge0 [simp]: fixes x y :: int shows
  "x XOR y \<ge> 0 \<longleftrightarrow> ((x \<ge> 0) \<longleftrightarrow> (y \<ge> 0))"
by (metis int_xor_lt0 linorder_not_le)

lemma bin_last_conv_AND:
  "bin_last i \<longleftrightarrow> i AND 1 \<noteq> 0"
proof -
  obtain x b where "i = x BIT b" by(cases i rule: bin_exhaust)
  hence "i AND 1 = 0 BIT b"
    by(simp add: BIT_special_simps(2)[symmetric] del: BIT_special_simps(2))
  thus ?thesis using `i = x BIT b` by(cases b) simp_all
qed

lemma bitval_bin_last:
  "of_bool (bin_last i) = i AND 1"
proof -
  obtain x b where "i = x BIT b" by(cases i rule: bin_exhaust)
  hence "i AND 1 = 0 BIT b"
    by(simp add: BIT_special_simps(2)[symmetric] del: BIT_special_simps(2))
  thus ?thesis by(cases b)(simp_all add: bin_last_conv_AND)
qed

lemma bl_to_bin_BIT:
  "bl_to_bin bs BIT b = bl_to_bin (bs @ [b])"
by(simp add: bl_to_bin_append)

lemma bin_last_bl_to_bin: "bin_last (bl_to_bin bs) \<longleftrightarrow> bs \<noteq> [] \<and> last bs"
by(cases "bs = []")(auto simp add: bl_to_bin_def last_bin_last'[where w=0])

lemma bin_rest_bl_to_bin: "bin_rest (bl_to_bin bs) = bl_to_bin (butlast bs)"
by(cases "bs = []")(simp_all add: bl_to_bin_def butlast_rest_bl2bin_aux)

lemma bin_nth_numeral_unfold:
  "bin_nth (numeral (num.Bit0 x)) n \<longleftrightarrow> n > 0 \<and> bin_nth (numeral x) (n - 1)"
  "bin_nth (numeral (num.Bit1 x)) n \<longleftrightarrow> (n > 0 \<longrightarrow> bin_nth (numeral x) (n - 1))"
by(case_tac [!] n) simp_all

lemma bin_sign_and:
  "bin_sign (i AND j) = - (bin_sign i * bin_sign j)"
by(simp add: bin_sign_def)

lemma minus_BIT_0: fixes x y :: int shows "x BIT b - y BIT False = (x - y) BIT b"
by(simp add: Bit_def)

primrec bin_mask :: "nat \<Rightarrow> int"
where
  "bin_mask 0 = 0"
| "bin_mask (Suc n) = bin_mask n BIT True"

lemma bin_mask_conv_pow2:
  "bin_mask n = 2 ^ n - 1"
by(induct n)(simp_all add: Bit_def)

lemma bin_mask_ge0: "bin_mask n \<ge> 0"
by(induct n) simp_all

lemma and_bin_mask_conv_mod: "x AND bin_mask n = x mod 2 ^ n"
proof(induction n arbitrary: x)
  case 0 thus ?case by simp
next
  case (Suc n)
  obtain x' b where "x = x' BIT b" by(cases x rule: bin_exhaust)
  with Suc show ?case by(cases b)(simp_all, simp_all add: Bit_def p1mod22k)
qed

lemma bin_mask_numeral:
  "bin_mask (numeral n) = bin_mask (pred_numeral n) BIT True"
by(simp add: numeral_eq_Suc)

lemma bin_nth_mask [simp]: "bin_nth (bin_mask n) i \<longleftrightarrow> i < n"
proof(induction n arbitrary: i)
  case (Suc n)
  thus ?case by(cases i) simp_all
qed simp

section {* Symbolic bit operations on numerals and @{typ int}s *}

lemma int_not_neg_numeral: "NOT (- numeral n) = (Num.sub n num.One :: int)"
by(simp add: int_not_def)

lemma sub_inc_One: "Num.sub (Num.inc n) num.One = numeral n"
by (metis add_diff_cancel diff_minus_eq_add diff_numeral_special(2) diff_numeral_special(6))

lemma inc_BitM: "Num.inc (Num.BitM n) = num.Bit0 n"
by(simp add: BitM_plus_one[symmetric] add_One)

lemma int_neg_numeral_pOne_conv_not: "- numeral (n + num.One) = (NOT (numeral n) :: int)"
by(simp add: int_not_def)

fun bitOR_num :: "num \<Rightarrow> num \<Rightarrow> num"
where
  "bitOR_num num.One num.One = num.One"
| "bitOR_num num.One (num.Bit0 n) = num.Bit1 n"
| "bitOR_num num.One (num.Bit1 n) = num.Bit1 n"
| "bitOR_num (num.Bit0 m) num.One = num.Bit1 m"
| "bitOR_num (num.Bit0 m) (num.Bit0 n) = num.Bit0 (bitOR_num m n)"
| "bitOR_num (num.Bit0 m) (num.Bit1 n) = num.Bit1 (bitOR_num m n)"
| "bitOR_num (num.Bit1 m) num.One = num.Bit1 m"
| "bitOR_num (num.Bit1 m) (num.Bit0 n) = num.Bit1 (bitOR_num m n)"
| "bitOR_num (num.Bit1 m) (num.Bit1 n) = num.Bit1 (bitOR_num m n)"

fun bitAND_num :: "num \<Rightarrow> num \<Rightarrow> num option"
where
  "bitAND_num num.One num.One = Some num.One"
| "bitAND_num num.One (num.Bit0 n) = None"
| "bitAND_num num.One (num.Bit1 n) = Some num.One"
| "bitAND_num (num.Bit0 m) num.One = None"
| "bitAND_num (num.Bit0 m) (num.Bit0 n) = map_option num.Bit0 (bitAND_num m n)"
| "bitAND_num (num.Bit0 m) (num.Bit1 n) = map_option num.Bit0 (bitAND_num m n)"
| "bitAND_num (num.Bit1 m) num.One = Some num.One"
| "bitAND_num (num.Bit1 m) (num.Bit0 n) = map_option num.Bit0 (bitAND_num m n)"
| "bitAND_num (num.Bit1 m) (num.Bit1 n) = (case bitAND_num m n of None \<Rightarrow> Some num.One | Some n' \<Rightarrow> Some (num.Bit1 n'))"

fun bitXOR_num :: "num \<Rightarrow> num \<Rightarrow> num option"
where
  "bitXOR_num num.One num.One = None"
| "bitXOR_num num.One (num.Bit0 n) = Some (num.Bit1 n)"
| "bitXOR_num num.One (num.Bit1 n) = Some (num.Bit0 n)"
| "bitXOR_num (num.Bit0 m) num.One = Some (num.Bit1 m)"
| "bitXOR_num (num.Bit0 m) (num.Bit0 n) = map_option num.Bit0 (bitXOR_num m n)"
| "bitXOR_num (num.Bit0 m) (num.Bit1 n) = Some (case bitXOR_num m n of None \<Rightarrow> num.One | Some n' \<Rightarrow> num.Bit1 n')"
| "bitXOR_num (num.Bit1 m) num.One = Some (num.Bit0 m)"
| "bitXOR_num (num.Bit1 m) (num.Bit0 n) = Some (case bitXOR_num m n of None \<Rightarrow> num.One | Some n' \<Rightarrow> num.Bit1 n')"
| "bitXOR_num (num.Bit1 m) (num.Bit1 n) = map_option num.Bit0 (bitXOR_num m n)"

fun bitORN_num :: "num \<Rightarrow> num \<Rightarrow> num"
where
  "bitORN_num num.One num.One = num.One"
| "bitORN_num num.One (num.Bit0 m) = num.Bit1 m"
| "bitORN_num num.One (num.Bit1 m) = num.Bit1 m"
| "bitORN_num (num.Bit0 n) num.One = num.Bit0 num.One"
| "bitORN_num (num.Bit0 n) (num.Bit0 m) = Num.BitM (bitORN_num n m)"
| "bitORN_num (num.Bit0 n) (num.Bit1 m) = num.Bit0 (bitORN_num n m)"
| "bitORN_num (num.Bit1 n) num.One = num.One"
| "bitORN_num (num.Bit1 n) (num.Bit0 m) = Num.BitM (bitORN_num n m)"
| "bitORN_num (num.Bit1 n) (num.Bit1 m) = Num.BitM (bitORN_num n m)"

fun bitANDN_num :: "num \<Rightarrow> num \<Rightarrow> num option"
where
  "bitANDN_num num.One num.One = None"
| "bitANDN_num num.One (num.Bit0 n) = Some num.One"
| "bitANDN_num num.One (num.Bit1 n) = None"
| "bitANDN_num (num.Bit0 m) num.One = Some (num.Bit0 m)"
| "bitANDN_num (num.Bit0 m) (num.Bit0 n) = map_option num.Bit0 (bitANDN_num m n)"
| "bitANDN_num (num.Bit0 m) (num.Bit1 n) = map_option num.Bit0 (bitANDN_num m n)"
| "bitANDN_num (num.Bit1 m) num.One = Some (num.Bit0 m)"
| "bitANDN_num (num.Bit1 m) (num.Bit0 n) = (case bitANDN_num m n of None \<Rightarrow> Some num.One | Some n' \<Rightarrow> Some (num.Bit1 n'))"
| "bitANDN_num (num.Bit1 m) (num.Bit1 n) = map_option num.Bit0 (bitANDN_num m n)"

lemma int_numeral_bitOR_num: "numeral n OR numeral m = (numeral (bitOR_num n m) :: int)"
by(induct n m rule: bitOR_num.induct) simp_all

lemma int_numeral_bitAND_num: "numeral n AND numeral m = (case bitAND_num n m of None \<Rightarrow> 0 :: int | Some n' \<Rightarrow> numeral n')"
by(induct n m rule: bitAND_num.induct)(simp_all split: option.split)

lemma int_numeral_bitXOR_num:
  "numeral m XOR numeral n = (case bitXOR_num m n of None \<Rightarrow> 0 :: int | Some n' \<Rightarrow> numeral n')"
by(induct m n rule: bitXOR_num.induct)(simp_all split: option.split)

lemma int_or_not_bitORN_num:
  "numeral n OR NOT (numeral m) = (- numeral (bitORN_num n m) :: int)"
by(induct n m rule: bitORN_num.induct)(simp_all add: Num.add_One BitM_inc)

lemma int_and_not_bitANDN_num:
  "numeral n AND NOT (numeral m) = (case bitANDN_num n m of None \<Rightarrow> 0 :: int | Some n' \<Rightarrow> numeral n')"
by(induct n m rule: bitANDN_num.induct)(simp_all add: Num.add_One BitM_inc split: option.split)

lemma int_not_and_bitANDN_num:
  "NOT (numeral m) AND numeral n = (case bitANDN_num n m of None \<Rightarrow> 0 :: int | Some n' \<Rightarrow> numeral n')"
by(simp add: int_and_not_bitANDN_num[symmetric] int_and_comm)

lemma Bit_code [code]:
  "0 BIT b = of_bool b"
  "Int.Pos n BIT False = Int.Pos (num.Bit0 n)"
  "Int.Pos n BIT True = Int.Pos (num.Bit1 n)"
  "Int.Neg n BIT False = Int.Neg (num.Bit0 n)"
  "Int.Neg n BIT True = Int.Neg (Num.BitM n)"
by(cases b)(simp_all)

lemma bin_last_code [code]:
  "bin_last 0 \<longleftrightarrow> False"
  "bin_last (Int.Pos num.One) \<longleftrightarrow> True"
  "bin_last (Int.Pos (num.Bit0 n)) \<longleftrightarrow> False"
  "bin_last (Int.Pos (num.Bit1 n)) \<longleftrightarrow> True"
  "bin_last (Int.Neg num.One) \<longleftrightarrow> True"
  "bin_last (Int.Neg (num.Bit0 n)) \<longleftrightarrow> False"
  "bin_last (Int.Neg (num.Bit1 n)) \<longleftrightarrow> True"
by(simp_all)

lemma bin_nth_code [code]:
  "bin_nth 0                 n = False"
  "bin_nth (Int.Neg num.One) n = True"
  "bin_nth (Int.Pos num.One)      0 = True"
  "bin_nth (Int.Pos (num.Bit0 m)) 0 = False"
  "bin_nth (Int.Pos (num.Bit1 m)) 0 = True"
  "bin_nth (Int.Neg (num.Bit0 m)) 0 = False"
  "bin_nth (Int.Neg (num.Bit1 m)) 0 = True"
  "bin_nth (Int.Pos num.One)      (Suc n) = False"
  "bin_nth (Int.Pos (num.Bit0 m)) (Suc n) = bin_nth (Int.Pos m) n"
  "bin_nth (Int.Pos (num.Bit1 m)) (Suc n) = bin_nth (Int.Pos m) n"
  "bin_nth (Int.Neg (num.Bit0 m)) (Suc n) = bin_nth (Int.Neg m) n"
  "bin_nth (Int.Neg (num.Bit1 m)) (Suc n) = bin_nth (Int.Neg (Num.inc m)) n"
by(simp_all add: Num.add_One)

lemma int_not_code [code]:
  "NOT (0 :: int) = -1"
  "NOT (Int.Pos n) = Int.Neg (Num.inc n)"
  "NOT (Int.Neg n) = Num.sub n num.One"
by(simp_all add: Num.add_One int_not_def)

lemma int_and_code [code]: fixes i j :: int shows
  "0 AND j = 0"
  "i AND 0 = 0"
  "Int.Pos n AND Int.Pos m = (case bitAND_num n m of None \<Rightarrow> 0 | Some n' \<Rightarrow> Int.Pos n')"
  "Int.Neg n AND Int.Neg m = NOT (Num.sub n num.One OR Num.sub m num.One)"
  "Int.Pos n AND Int.Neg num.One = Int.Pos n"
  "Int.Pos n AND Int.Neg (num.Bit0 m) = Num.sub (bitORN_num (Num.BitM m) n) num.One"
  "Int.Pos n AND Int.Neg (num.Bit1 m) = Num.sub (bitORN_num (num.Bit0 m) n) num.One"
  "Int.Neg num.One AND Int.Pos m = Int.Pos m"
  "Int.Neg (num.Bit0 n) AND Int.Pos m = Num.sub (bitORN_num (Num.BitM n) m) num.One"
  "Int.Neg (num.Bit1 n) AND Int.Pos m = Num.sub (bitORN_num (num.Bit0 n) m) num.One"
apply(fold int_not_neg_numeral)
apply(simp_all add: int_numeral_bitAND_num int_or_not_bitORN_num[symmetric] bbw_not_dist Num.add_One int_not_neg_numeral sub_inc_One inc_BitM cong: option.case_cong)
apply(simp_all add: int_and_comm)
apply(metis int_not_neg_numeral int_not_not)
done

lemma int_or_code [code]: fixes i j :: int shows
  "0 OR j = j"
  "i OR 0 = i"
  "Int.Pos n OR Int.Pos m = Int.Pos (bitOR_num n m)"
  "Int.Neg n OR Int.Neg m = NOT (Num.sub n num.One AND Num.sub m num.One)"
  "Int.Pos n OR Int.Neg num.One = Int.Neg num.One"
  "Int.Pos n OR Int.Neg (num.Bit0 m) = (case bitANDN_num (Num.BitM m) n of None \<Rightarrow> -1 | Some n' \<Rightarrow> Int.Neg (Num.inc n'))"
  "Int.Pos n OR Int.Neg (num.Bit1 m) = (case bitANDN_num (num.Bit0 m) n of None \<Rightarrow> -1 | Some n' \<Rightarrow> Int.Neg (Num.inc n'))"
  "Int.Neg num.One OR Int.Pos m = Int.Neg num.One"
  "Int.Neg (num.Bit0 n) OR Int.Pos m = (case bitANDN_num (Num.BitM n) m of None \<Rightarrow> -1 | Some n' \<Rightarrow> Int.Neg (Num.inc n'))"
  "Int.Neg (num.Bit1 n) OR Int.Pos m = (case bitANDN_num (num.Bit0 n) m of None \<Rightarrow> -1 | Some n' \<Rightarrow> Int.Neg (Num.inc n'))"
apply(simp_all add: int_numeral_bitOR_num)
apply(simp_all add: int_or_def int_not_neg_numeral int_and_comm int_not_and_bitANDN_num del: int_not_simps(4) split: option.split)
apply(simp_all add: Num.add_One)
done

lemma int_xor_code [code]: fixes i j :: int shows
  "0 XOR j = j"
  "i XOR 0 = i"
  "Int.Pos n XOR Int.Pos m = (case bitXOR_num n m of None \<Rightarrow> 0 | Some n' \<Rightarrow> Int.Pos n')"
  "Int.Neg n XOR Int.Neg m = Num.sub n num.One XOR Num.sub m num.One"
  "Int.Neg n XOR Int.Pos m = NOT (Num.sub n num.One XOR Int.Pos m)"
  "Int.Pos n XOR Int.Neg m = NOT (Int.Pos n XOR Num.sub m num.One)"
by(fold int_not_neg_numeral)(simp_all add: int_numeral_bitXOR_num int_xor_not cong: option.case_cong)

section {* More on bits and bitss operations *}

inductive wf_set_bits_int :: "(nat \<Rightarrow> bool) \<Rightarrow> bool"
  for f :: "nat \<Rightarrow> bool"
where
  zeros: "\<forall>n' \<ge> n. \<not> f n' \<Longrightarrow> wf_set_bits_int f"
| ones: "\<forall>n' \<ge> n. f n' \<Longrightarrow> wf_set_bits_int f"

lemma wf_set_bits_int_simps: "wf_set_bits_int f \<longleftrightarrow> (\<exists>n. (\<forall>n'\<ge>n. \<not> f n') \<or> (\<forall>n'\<ge>n. f n'))"
by(auto simp add: wf_set_bits_int.simps)

lemma wf_set_bits_int_const [simp]: "wf_set_bits_int (\<lambda>_. b)"
by(cases b)(auto intro: wf_set_bits_int.intros)

lemma wf_set_bits_int_fun_upd [simp]:
  "wf_set_bits_int (f(n := b)) \<longleftrightarrow> wf_set_bits_int f" (is "?lhs \<longleftrightarrow> ?rhs")
proof
  assume ?lhs
  then obtain n'
    where "(\<forall>n''\<ge>n'. \<not> (f(n := b)) n'') \<or> (\<forall>n''\<ge>n'. (f(n := b)) n'')"
    by(auto simp add: wf_set_bits_int_simps)
  hence "(\<forall>n''\<ge>max (Suc n) n'. \<not> f n'') \<or> (\<forall>n''\<ge>max (Suc n) n'. f n'')" by auto
  thus ?rhs by(auto simp only: wf_set_bits_int_simps)
next
  assume ?rhs
  then obtain n' where "(\<forall>n''\<ge>n'. \<not> f n'') \<or> (\<forall>n''\<ge>n'. f n'')" (is "?wf f n'")
    by(auto simp add: wf_set_bits_int_simps)
  hence "?wf (f(n := b)) (max (Suc n) n')" by auto
  thus ?lhs by(auto simp only: wf_set_bits_int_simps)
qed

lemma wf_set_bits_int_Suc [simp]:
  "wf_set_bits_int (\<lambda>n. f (Suc n)) \<longleftrightarrow> wf_set_bits_int f" (is "?lhs \<longleftrightarrow> ?rhs")
by(auto simp add: wf_set_bits_int_simps intro: le_SucI dest: Suc_le_D)

lemma int_lsb_BIT [simp]: fixes x :: int shows
  "lsb (x BIT b) \<longleftrightarrow> b"
by(simp add: lsb_int_def)

lemma bin_last_conv_lsb: "bin_last = lsb"
by(clarsimp simp add: lsb_int_def fun_eq_iff)

lemma int_lsb_numeral [simp]:
  "lsb (0 :: int) = False"
  "lsb (1 :: int) = True"
  "lsb (Numeral1 :: int) = True"
  "lsb (- 1 :: int) = True"
  "lsb (- Numeral1 :: int) = True"
  "lsb (numeral (num.Bit0 w) :: int) = False"
  "lsb (numeral (num.Bit1 w) :: int) = True"
  "lsb (- numeral (num.Bit0 w) :: int) = False"
  "lsb (- numeral (num.Bit1 w) :: int) = True"
by(simp_all add: lsb_int_def)

lemma int_lsb_code [code]:
  "lsb (0 :: int) = False"
  "lsb (Int.Pos num.One) = True"
  "lsb (Int.Pos (num.Bit0 w)) = False"
  "lsb (Int.Pos (num.Bit1 w)) = True"
  "lsb (Int.Neg num.One) = True"
  "lsb (Int.Neg (num.Bit0 w)) = False"
  "lsb (Int.Neg (num.Bit1 w)) = True"
by simp_all

lemma int_set_bit_0 [simp]: fixes x :: int shows
  "set_bit x 0 b = bin_rest x BIT b"
by(auto simp add: set_bit_int_def intro: bin_rl_eqI)

lemma int_set_bit_Suc: fixes x :: int shows
  "set_bit x (Suc n) b = set_bit (bin_rest x) n b BIT bin_last x"
by(auto simp add: set_bit_int_def twice_conv_BIT intro: bin_rl_eqI)

lemma bin_last_set_bit:
  "bin_last (set_bit x n b) = (if n > 0 then bin_last x else b)"
by(cases n)(simp_all add: int_set_bit_Suc)

lemma bin_rest_set_bit:
  "bin_rest (set_bit x n b) = (if n > 0 then set_bit (bin_rest x) (n - 1) b else bin_rest x)"
by(cases n)(simp_all add: int_set_bit_Suc)

lemma int_set_bit_numeral: fixes x :: int shows
  "set_bit x (numeral w) b = set_bit (bin_rest x) (pred_numeral w) b BIT bin_last x"
by(simp add: set_bit_int_def)

lemmas int_set_bit_numerals [simp] =
  int_set_bit_numeral[where x="numeral w'"]
  int_set_bit_numeral[where x="- numeral w'"]
  int_set_bit_numeral[where x="Numeral1"]
  int_set_bit_numeral[where x="1"]
  int_set_bit_numeral[where x="0"]
  int_set_bit_Suc[where x="numeral w'"]
  int_set_bit_Suc[where x="- numeral w'"]
  int_set_bit_Suc[where x="Numeral1"]
  int_set_bit_Suc[where x="1"]
  int_set_bit_Suc[where x="0"]
  for w'

lemma int_shiftl_BIT: fixes x :: int
  shows int_shiftl0 [simp]: "x << 0 = x"
  and int_shiftl_Suc [simp]: "x << Suc n = (x << n) BIT False"
by(auto simp add: shiftl_int_def Bit_def)

lemma int_0_shiftl [simp]: "0 << n = (0 :: int)"
by(induct n) simp_all

lemma bin_last_shiftl: "bin_last (x << n) \<longleftrightarrow> n = 0 \<and> bin_last x"
by(cases n)(simp_all)

lemma bin_rest_shiftl: "bin_rest (x << n) = (if n > 0 then x << (n - 1) else bin_rest x)"
by(cases n)(simp_all)

lemma bin_nth_shiftl [simp]: "bin_nth (x << n) m \<longleftrightarrow> n \<le> m \<and> bin_nth x (m - n)"
proof(induct n arbitrary: x m)
  case (Suc n)
  thus ?case by(cases m) simp_all
qed simp

lemma int_shiftr_BIT [simp]: fixes x :: int
  shows int_shiftr0: "x >> 0 = x"
  and int_shiftr_Suc: "x BIT b >> Suc n = x >> n"
proof -
  show "x >> 0 = x" by (simp add: shiftr_int_def)
  show "x BIT b >> Suc n = x >> n" by (cases b)
   (simp_all add: shiftr_int_def Bit_def add.commute pos_zdiv_mult_2)
qed

lemma bin_last_shiftr: "bin_last (x >> n) \<longleftrightarrow> x !! n"
proof(induct n arbitrary: x)
  case 0 thus ?case by simp
next
  case (Suc n)
  thus ?case by(cases x rule: bin_exhaust) simp
qed

lemma bin_rest_shiftr [simp]: "bin_rest (x >> n) = x >> Suc n"
proof(induct n arbitrary: x)
  case 0
  thus ?case by(cases x rule: bin_exhaust) auto
next
  case (Suc n)
  thus ?case by(cases x rule: bin_exhaust) auto
qed

lemma bin_nth_shiftr [simp]: "bin_nth (x >> n) m = bin_nth x (n + m)"
proof(induct n arbitrary: x m)
  case (Suc n)
  thus ?case by(cases x rule: bin_exhaust) simp_all
qed simp

lemma bin_nth_conv_AND:
  fixes x :: int shows
  "bin_nth x n \<longleftrightarrow> x AND (1 << n) \<noteq> 0"
proof(induct n arbitrary: x)
  case 0
  thus ?case by(simp add: int_and_1 bin_last_def)
next
  case (Suc n)
  thus ?case by(cases x rule: bin_exhaust)(simp_all add: bin_nth_ops Bit_eq_0_iff)
qed

lemma int_shiftl_numeral [simp]:
  "(numeral w :: int) << numeral w' = numeral (num.Bit0 w) << pred_numeral w'"
  "(- numeral w :: int) << numeral w' = - numeral (num.Bit0 w) << pred_numeral w'"
by(simp_all add: numeral_eq_Suc Bit_def shiftl_int_def)
  (metis add_One mult_inc semiring_norm(11) semiring_norm(13) semiring_norm(2) semiring_norm(6) semiring_norm(87))+

lemma int_shiftl_code [code]:
  "i << 0 = i"
  "i << Suc n = Int.dup i << n"
by(simp_all add: shiftl_int_def)

lemma int_shiftl_One_numeral [simp]: "(1 :: int) << numeral w = 2 << pred_numeral w"
by(metis int_shiftl_numeral numeral_One)

lemma shiftl_ge_0 [simp]: fixes i :: int shows "i << n \<ge> 0 \<longleftrightarrow> i \<ge> 0"
by(induct n) simp_all

lemma shiftl_lt_0 [simp]: fixes i :: int shows "i << n < 0 \<longleftrightarrow> i < 0"
by (metis not_le shiftl_ge_0)

lemma int_shiftl_test_bit: "(n << i :: int) !! m \<longleftrightarrow> m \<ge> i \<and> n !! (m - i)"
proof(induction i)
  case (Suc n)
  thus ?case by(cases m) simp_all
qed simp

lemma bin_mask_p1_conv_shift: "bin_mask n + 1 = 1 << n"
by(induct n) simp_all

lemma int_0shiftr [simp]: "(0 :: int) >> x = 0"
by(simp add: shiftr_int_def)

lemma int_minus1_shiftr [simp]: "(-1 :: int) >> x = -1"
by(simp add: shiftr_int_def div_eq_minus1)

lemma int_shiftr_ge_0 [simp]: fixes i :: int shows "i >> n \<ge> 0 \<longleftrightarrow> i \<ge> 0"
proof(induct n arbitrary: i)
  case (Suc n)
  thus ?case by(cases i rule: bin_exhaust) simp_all
qed simp

lemma int_shiftr_lt_0 [simp]: fixes i :: int shows "i >> n < 0 \<longleftrightarrow> i < 0"
by (metis int_shiftr_ge_0 not_less)

lemma uminus_Bit_eq:
  "- k BIT b = (- k - of_bool b) BIT b"
  by (cases b) (simp_all add: Bit_def)

lemma int_shiftr_numeral [simp]:
  "(1 :: int) >> numeral w' = 0"
  "(numeral num.One :: int) >> numeral w' = 0"
  "(numeral (num.Bit0 w) :: int) >> numeral w' = numeral w >> pred_numeral w'"
  "(numeral (num.Bit1 w) :: int) >> numeral w' = numeral w >> pred_numeral w'"
  "(- numeral (num.Bit0 w) :: int) >> numeral w' = - numeral w >> pred_numeral w'"
  "(- numeral (num.Bit1 w) :: int) >> numeral w' = - numeral (Num.inc w) >> pred_numeral w'"
  by (simp_all only: numeral_One expand_BIT numeral_eq_Suc int_shiftr_Suc BIT_special_simps(2)[symmetric] int_0shiftr add_One uminus_Bit_eq)
    (simp_all add: add_One)

lemma int_shiftr_numeral_Suc0 [simp]:
  "(1 :: int) >> Suc 0 = 0"
  "(numeral num.One :: int) >> Suc 0 = 0"
  "(numeral (num.Bit0 w) :: int) >> Suc 0 = numeral w"
  "(numeral (num.Bit1 w) :: int) >> Suc 0 = numeral w"
  "(- numeral (num.Bit0 w) :: int) >> Suc 0 = - numeral w"
  "(- numeral (num.Bit1 w) :: int) >> Suc 0 = - numeral (Num.inc w)"
by(simp_all only: One_nat_def[symmetric] numeral_One[symmetric] int_shiftr_numeral pred_numeral_simps int_shiftr0)

lemma int_shiftr_code [code]: fixes i :: int shows
  "i >> 0 = i"
  "0 >> Suc n = (0 :: int)"
  "Int.Pos num.One >> Suc n = 0"
  "Int.Pos (num.Bit0 m) >> Suc n = Int.Pos m >> n"
  "Int.Pos (num.Bit1 m) >> Suc n = Int.Pos m >> n"
  "Int.Neg num.One >> Suc n = -1"
  "Int.Neg (num.Bit0 m) >> Suc n = Int.Neg m >> n"
  "Int.Neg (num.Bit1 m) >> Suc n = Int.Neg (Num.inc m) >> n"
  by (simp_all only: int_shiftr_Suc BIT_special_simps(2)[symmetric] int_shiftr0 int_0shiftr numeral_One int_minus1_shiftr Int.Pos_def Int.Neg_def expand_BIT int_shiftr_Suc Num.add_One uminus_Bit_eq)
    (simp_all add: add_One)

lemma bin_nth_minus_p2:
  assumes sign: "bin_sign x = 0"
  and y: "y = 1 << n"
  and m: "m < n"
  and x: "x < y"
  shows "bin_nth (x - y) m = bin_nth x m"
using sign m x unfolding y
proof(induction m arbitrary: x y n)
  case 0
  thus ?case
    by(simp add: bin_last_def shiftl_int_def) (metis (hide_lams, no_types) mod_diff_right_eq mod_self neq0_conv numeral_One power_eq_0_iff power_mod diff_zero zero_neq_numeral)
next
  case (Suc m)
  from `Suc m < n` obtain n' where [simp]: "n = Suc n'" by(cases n) auto
  obtain x' b where [simp]: "x = x' BIT b" by(cases x rule: bin_exhaust)
  from `bin_sign x = 0` have "bin_sign x' = 0" by simp
  moreover from `x < 1 << n` have "x' < 1 << n'"
    by(cases b)(simp_all add: Bit_def shiftl_int_def)
  moreover have "(2 * x' + of_bool b - 2 * 2 ^ n') div 2 = x' + (- (2 ^ n') + of_bool b div 2)"
    by(simp only: add_diff_eq[symmetric] add.commute div_mult_self2[OF zero_neq_numeral[symmetric]])
  ultimately show ?case using Suc.IH[of x' n'] Suc.prems
    by(cases b)(simp_all add: Bit_def bin_rest_def shiftl_int_def)
qed

lemma bin_clr_conv_NAND:
  "bin_sc n False i = i AND NOT (1 << n)"
by(induct n arbitrary: i)(auto intro: bin_rl_eqI)

lemma bin_set_conv_OR:
  "bin_sc n True i = i OR (1 << n)"
by(induct n arbitrary: i)(auto intro: bin_rl_eqI)

lemma fixes i :: int
  shows int_set_bit_True_conv_OR [code]: "set_bit i n True = i OR (1 << n)"
  and int_set_bit_False_conv_NAND [code]: "set_bit i n False = i AND NOT (1 << n)"
  and int_set_bit_conv_ops: "set_bit i n b = (if b then i OR (1 << n) else i AND NOT (1 << n))"
by(simp_all add: set_bit_int_def bin_set_conv_OR bin_clr_conv_NAND)

lemma int_set_bits_K_True [simp]: "(BITS _. True) = (-1 :: int)"
by(auto simp add: set_bits_int_def bin_last_bl_to_bin)

lemma int_set_bits_K_False [simp]: "(BITS _. False) = (0 :: int)"
by(auto simp add: set_bits_int_def)

lemma int_set_bits_unfold_BIT:
  assumes "wf_set_bits_int f"
  shows "set_bits f = set_bits (f \<circ> Suc) BIT f 0"
using assms
proof cases
  case (zeros n)
  show ?thesis
  proof(cases "\<forall>n. \<not> f n")
    case True
    hence "f = (\<lambda>_. False)" by auto
    thus ?thesis using True by(simp add: o_def)
  next
    case False
    then obtain n' where "f n'" by blast
    with zeros have "(LEAST n. \<forall>n'\<ge>n. \<not> f n') = Suc (LEAST n. \<forall>n'\<ge>Suc n. \<not> f n')"
      by(auto intro: Least_Suc)
    also have "(\<lambda>n. \<forall>n'\<ge>Suc n. \<not> f n') = (\<lambda>n. \<forall>n'\<ge>n. \<not> f (Suc n'))" by(auto dest: Suc_le_D)
    also from zeros have "\<forall>n'\<ge>n. \<not> f (Suc n')" by auto
    ultimately show ?thesis using zeros
      by(simp (no_asm_simp) add: set_bits_int_def exI split del: if_split)
        (rule bin_rl_eqI, auto simp add: bin_last_bl_to_bin hd_map bin_rest_bl_to_bin map_tl[symmetric] map_map[symmetric] map_Suc_upt simp del: map_map)
  qed
next
  case (ones n)
  show ?thesis
  proof(cases "\<forall>n. f n")
    case True
    hence "f = (\<lambda>_. True)" by auto
    thus ?thesis using True by(simp add: o_def)
  next
    case False
    then obtain n' where "\<not> f n'" by blast
    with ones have "(LEAST n. \<forall>n'\<ge>n. f n') = Suc (LEAST n. \<forall>n'\<ge>Suc n. f n')"
      by(auto intro: Least_Suc)
    also have "(\<lambda>n. \<forall>n'\<ge>Suc n. f n') = (\<lambda>n. \<forall>n'\<ge>n. f (Suc n'))" by(auto dest: Suc_le_D)
    also from ones have "\<forall>n'\<ge>n. f (Suc n')" by auto
    moreover from ones have "(\<exists>n. \<forall>n'\<ge>n. \<not> f n') = False"
      by(auto intro!: exI[where x="max n m" for n m] simp add: max_def split: if_split_asm)
    moreover hence "(\<exists>n. \<forall>n'\<ge>n. \<not> f (Suc n')) = False"
      by(auto elim: allE[where x="Suc n" for n] dest: Suc_le_D)
    ultimately show ?thesis using ones
      by(simp (no_asm_simp) add: set_bits_int_def exI split del: if_split)
        (auto simp add: Let_def bin_last_bl_to_bin hd_map bin_rest_bl_to_bin map_tl[symmetric] map_map[symmetric] map_Suc_upt simp del: map_map)
  qed
qed

lemma bin_last_set_bits [simp]:
  "wf_set_bits_int f \<Longrightarrow> bin_last (set_bits f) = f 0"
by(subst int_set_bits_unfold_BIT) simp_all

lemma bin_rest_set_bits [simp]:
  "wf_set_bits_int f \<Longrightarrow> bin_rest (set_bits f) = set_bits (f \<circ> Suc)"
by(subst int_set_bits_unfold_BIT) simp_all

lemma bin_nth_set_bits [simp]:
  "wf_set_bits_int f \<Longrightarrow> bin_nth (set_bits f) m = f m"
proof(induction m arbitrary: f)
  case 0
  thus ?case by simp
next
  case Suc
  from Suc.IH[of "\<lambda>n. f (Suc n)"] Suc.prems show ?case
    by(simp add: o_def)
qed

lemma set_bits_code [code]:
  "set_bits = Code.abort (STR ''set_bits is unsupported on type int'') (\<lambda>_. set_bits :: _ \<Rightarrow> int)"
by simp

lemma msb_conv_bin_sign: "msb x \<longleftrightarrow> bin_sign x = -1"
by(simp add: bin_sign_def not_le msb_int_def)

lemma msb_BIT [simp]: "msb (x BIT b) = msb x"
by(simp add: msb_int_def)

lemma msb_bin_rest [simp]: "msb (bin_rest x) = msb x"
by(simp add: msb_int_def)

lemma int_msb_and [simp]: "msb ((x :: int) AND y) \<longleftrightarrow> msb x \<and> msb y"
by(simp add: msb_int_def)

lemma int_msb_or [simp]: "msb ((x :: int) OR y) \<longleftrightarrow> msb x \<or> msb y"
by(simp add: msb_int_def)

lemma int_msb_xor [simp]: "msb ((x :: int) XOR y) \<longleftrightarrow> msb x \<noteq> msb y"
by(simp add: msb_int_def)

lemma int_msb_not [simp]: "msb (NOT (x :: int)) \<longleftrightarrow> \<not> msb x"
by(simp add: msb_int_def not_less)

lemma msb_shiftl [simp]: "msb ((x :: int) << n) \<longleftrightarrow> msb x"
by(simp add: msb_int_def)

lemma msb_shiftr [simp]: "msb ((x :: int) >> r) \<longleftrightarrow> msb x"
by(simp add: msb_int_def)

lemma msb_bin_sc [simp]: "msb (bin_sc n b x) \<longleftrightarrow> msb x"
by(simp add: msb_conv_bin_sign)

lemma msb_set_bit [simp]: "msb (set_bit (x :: int) n b) \<longleftrightarrow> msb x"
by(simp add: msb_conv_bin_sign set_bit_int_def)

lemma msb_0 [simp]: "msb (0 :: int) = False"
by(simp add: msb_int_def)

lemma msb_1 [simp]: "msb (1 :: int) = False"
by(simp add: msb_int_def)

lemma msb_numeral [simp]:
  "msb (numeral n :: int) = False"
  "msb (- numeral n :: int) = True"
by(simp_all add: msb_int_def)

section {* Bit list operations implemented by bitwise operations *}

lemma bin_rest_code [code]: "bin_rest i = i >> 1"
by(simp add: bin_rest_def shiftr_int_def)

lemma sbintrunc_code [code]:
  "sbintrunc n bin =
  (let bin' = bin AND bin_mask (n + 1)
   in if bin' !! n then bin' - (2 << n) else bin')"
proof(induct n arbitrary: bin)
  case 0 thus ?case
    by (simp add: bitval_bin_last [symmetric])
next
  case (Suc n)
  thus ?case by(cases bin rule: bin_exhaust)(simp add: Let_def minus_BIT_0)
qed

text {*
  Use this function to convert numeral @{typ integer}s quickly into @{typ int}s.
  By default, it works only for symbolic evaluation; normally generated code raises
  an exception at run-time. If theory @{text Code_Target_Bits_Int} is imported,
  it works again, because then @{typ int} is implemented in terms of @{typ integer}
  even for symbolic evaluation.
*}

definition int_of_integer_symbolic :: "integer \<Rightarrow> int"
where "int_of_integer_symbolic = int_of_integer"

lemma int_of_integer_symbolic_aux_code [code nbe]:
  "int_of_integer_symbolic 0 = 0"
  "int_of_integer_symbolic (Code_Numeral.Pos n) = Int.Pos n"
  "int_of_integer_symbolic (Code_Numeral.Neg n) = Int.Neg n"
by(simp_all add: int_of_integer_symbolic_def)

code_identifier
  code_module More_Bits_Int \<rightharpoonup>
  (SML) Bit_Int and (OCaml) Bit_Int and (Haskell) Bit_Int and (Scala) Bit_Int
| code_module Bits_Int \<rightharpoonup>
  (SML) Bit_Int and (OCaml) Bit_Int and (Haskell) Bit_Int and (Scala) Bit_Int
| code_module Bits \<rightharpoonup>
  (SML) Bit_Int and (OCaml) Bit_Int and (Haskell) Bit_Int and (Scala) Bit_Int

end


\<^marker>\<open>creator Florian Keßler\<close>

section \<open>IMP-- Subprograms\<close>

theory IMP_Minus_Minus_Subprograms
  imports IMP_Minus_Minus_Small_StepT
begin

text \<open>We give functions that enumerate all subprograms of an IMP-- program, that is, all
  computations that could be reached during the execution of an IMP-- program. Note that this is
  a purely syntactical definition, i.e. we also take into account executions that are actually
  impossible to reach due to the semantics of IMP--. We show completeness of this definition,
  i.e. if a IMP-- program can reach a certain computation, than that computation is contained in
  our definition. \<close>

fun all_subprograms :: "com \<Rightarrow> com list" where
"all_subprograms (SKIP) = [SKIP]" |
"all_subprograms (Assign v b) = [(Assign v b), SKIP]" |
"all_subprograms (c1 ;; c2) = (map (\<lambda> c. c ;; c2) (all_subprograms c1)) @ all_subprograms c1
  @ all_subprograms c2" |
"all_subprograms (If v c1 c2) = [(If v c1 c2)] @ all_subprograms c1 @ all_subprograms c2" |
"all_subprograms (While v c) = [(While v c), SKIP] @ all_subprograms c @
  (map (\<lambda> x. x ;; (While v c)) (all_subprograms c))"

definition enumerate_subprograms :: "com \<Rightarrow> com list" where
"enumerate_subprograms c = remdups (all_subprograms c)"

fun all_variables :: "com \<Rightarrow> vname list" where
"all_variables (SKIP) = []" |
"all_variables (Assign v _) = [ v ]" |
"all_variables (c1 ;; c2) = []" |
"all_variables (If vs c1 c2) = vs" |
"all_variables (While vs c) = vs"

definition enumerate_variables :: "com \<Rightarrow> vname list" where
"enumerate_variables c = remdups (concat (map all_variables (enumerate_subprograms c)))"

lemma enumerate_variables_distinct: "distinct (enumerate_variables c)"
  by (auto simp: enumerate_variables_def)

lemma set_enumerate_variables_seq: "set (enumerate_variables (c1 ;; c2)) =
  set (enumerate_variables c1) \<union> set (enumerate_variables c2)"
  by(auto simp: enumerate_variables_def enumerate_subprograms_def)

lemma set_enumerate_variables_if: "set (enumerate_variables (IF vs\<noteq>0 THEN c1 ELSE c2))
  = set vs \<union> set (enumerate_variables c1) \<union> set (enumerate_variables c2)"
  by(auto simp: enumerate_variables_def enumerate_subprograms_def)

lemma set_enumerate_variables_while: "set (enumerate_variables (WHILE vs\<noteq>0 DO c))
  = set vs \<union> set (enumerate_variables c)"
  by(auto simp: enumerate_variables_def enumerate_subprograms_def)

lemma enumerate_variables_assign[simp]: "enumerate_variables (x1 ::= x2) = [x1]"
  by(auto simp: enumerate_variables_def enumerate_subprograms_def)

lemma enumerate_variables_SKIP[simp]: "enumerate_variables SKIP = []"
  by(auto simp: enumerate_variables_def enumerate_subprograms_def)

declare enumerate_subprograms_def[simp]

lemma c_in_all_subprograms_c[simp]: "c \<in> set (enumerate_subprograms c)"
  by (induction c) auto

lemma enumerate_variables_all_variables[simp]: "x \<in> set (all_variables c) \<Longrightarrow> x \<in> set (enumerate_variables c)"
  using c_in_all_subprograms_c by (auto simp: enumerate_variables_def)

lemma enumerate_subprograms_complete_step: "(c1, s1) \<rightarrow> (c2, s2)
  \<Longrightarrow> c2 \<in> set (enumerate_subprograms c1)"
apply (induction c1 s1 c2 s2 rule: small_step_induct)
  using c_in_all_subprograms_c apply(auto)
done

lemma enumerate_subprograms_transitive: "c2 \<in> set (enumerate_subprograms c1) \<Longrightarrow>
  c3 \<in> set (enumerate_subprograms c2) \<Longrightarrow> c3 \<in> set (enumerate_subprograms c1)"
proof (induction c1 arbitrary: c2 c3 rule: all_subprograms.induct)
  case (4 v c4 c5)
  then have "(c2 = (If v c4 c5)) \<or> (c2 \<in> set (all_subprograms c4))
              \<or> (c2 \<in> set (all_subprograms c5))"
      by (metis Un_iff all_subprograms.simps append.simps append.simps enumerate_subprograms_def set_ConsD set_append set_remdups)
  then show ?case
  proof (elim disjE)
    assume "c2 \<in> set (all_subprograms c5)"
    then show ?thesis using 4 by auto
  next
    assume "c2 \<in> set (all_subprograms c4)"
    then show ?thesis using 4 by auto
  next
    assume "c2 = (If v c4 c5)"
    then show ?thesis using 4 by auto
  qed
next
  case (5 v c)
  then have "c2 \<in> set (all_subprograms (While v c))" by (metis enumerate_subprograms_def set_remdups)
  then have "c2 \<in> set ([While v c, SKIP] @ all_subprograms c @ map (\<lambda> x. x ;; (While v c)) (all_subprograms c))"
    by (metis all_subprograms.simps enumerate_subprograms_def map_eq_conv set_append set_remdups)
  then have "(c2 = (While v c)) \<or> c2 = SKIP \<or> (c2 \<in> set (all_subprograms c))
              \<or> (c2 \<in> set (map (\<lambda> x. x ;; (While v c)) (all_subprograms c)))" by simp
  then show ?case
  proof (elim disjE)
    assume "c2 = (While v c)"
    then show ?thesis using 5 by auto
  next
    assume "c2 = SKIP"
    then show ?thesis using 5 by auto
  next
    assume "c2 \<in> set (all_subprograms c)"
    then show ?thesis using 5
      by (metis Un_iff all_subprograms.simps enumerate_subprograms_def set_append set_remdups)
  next
    assume "c2 \<in> set (map (\<lambda> x. x ;; (While v c)) (all_subprograms c))"
    then obtain c' where *: "c2 = c' ;; (While v c) \<and> c' \<in> set (all_subprograms c)" by auto
    then have "c3 \<in> set (map (\<lambda> x. x ;; (While v c)) (all_subprograms c')) \<or> c3 \<in> set (all_subprograms c')
      \<or> c3 \<in> set (all_subprograms (While v c))" using 5 by auto
    then show ?thesis
    proof (elim disjE)
      assume "c3 \<in> set (map (\<lambda> x. x ;; (While v c)) (all_subprograms c'))"
      then have "c3 \<in> set (map (\<lambda> x. x ;; (While v c)) (all_subprograms c))" using * 5 by auto
      then show ?thesis by auto
    next
      assume "c3 \<in> set (all_subprograms c')"
      then have "c3 \<in> set (all_subprograms c)" using * 5 by auto
      then show ?thesis by auto
    next
      assume "c3 \<in> set (all_subprograms (While v c))"
      then show ?thesis using 5 by (metis enumerate_subprograms_def set_remdups)
    qed
  qed
qed auto

lemma enumerate_subprograms_complete: "(c1, s1)\<rightarrow>\<^bsup>t\<^esup> (c2, s2)
  \<Longrightarrow>  c2 \<in> set (enumerate_subprograms c1)"
proof(induction t arbitrary: c1 s1 c2 s2)
  case 0
  then show ?case using c_in_all_subprograms_c by auto
next
  case (Suc t)
  then obtain c1' s1' where "((c1, s1) \<rightarrow> (c1', s1')) \<and> ((c1', s1')\<rightarrow>\<^bsup>t\<^esup> (c2, s2))" by auto
  then show ?case using enumerate_subprograms_transitive Suc enumerate_subprograms_complete_step
    by blast
qed

lemma SKIP_in_enumerate_subprograms[simp]: "SKIP \<in> set (enumerate_subprograms c)"
  by (induction c rule: all_subprograms.induct) auto

lemma enumerate_subprograms_enumerate_variables: "c' \<in> set (enumerate_subprograms c)
  \<Longrightarrow> set (enumerate_variables c') \<subseteq> set (enumerate_variables c)"
 by (auto simp: enumerate_variables_def)
     (metis enumerate_subprograms_def enumerate_subprograms_transitive set_remdups)

lemma step_doesnt_add_variables: "(c1, s1) \<rightarrow> (c2, s2) \<Longrightarrow> c1 \<in> set (enumerate_subprograms c)
  \<Longrightarrow> dom s1 = set (enumerate_variables c)
  \<Longrightarrow> dom s2 = set (enumerate_variables c)"
proof (induction c1 s1  c2 s2 rule: small_step_induct)
  case (Assign x a s)
  have "x \<in> set (enumerate_variables (x ::= a))" by simp
  then have "x \<in> set (enumerate_variables c)"
    using Assign enumerate_subprograms_enumerate_variables by fastforce
  thus ?case using Assign by(auto simp: dom_def)
next
  case (Seq2 c\<^sub>1 s c\<^sub>1' s' c\<^sub>2)
  have "c\<^sub>1 \<in> set (enumerate_subprograms (c\<^sub>1 ;; c\<^sub>2))" using c_in_all_subprograms_c by simp
  then have "c\<^sub>1 \<in> set (enumerate_subprograms c)"
    using Assign Seq2 enumerate_subprograms_transitive by blast
  then show ?case using Seq2 by auto
qed auto

lemma small_step_fun_restrict_variables:
  "set (enumerate_variables c1) \<subseteq> S \<Longrightarrow> small_step_fun (c1, s1 |` S)
    = (fst (small_step_fun (c1, s1)), snd (small_step_fun (c1, s1)) |` S)"
  apply(induction c1 arbitrary: S)
  using subsetD by(fastforce simp: set_enumerate_variables_seq
      set_enumerate_variables_if set_enumerate_variables_while)+

lemma small_step_fun_doesnt_add_variables:
  "set (enumerate_variables c1) \<subseteq> S
  \<Longrightarrow> set (enumerate_variables (fst (small_step_fun (c1, s1)))) \<subseteq> S"
  apply(induction c1)
  by(auto simp: set_enumerate_variables_seq
      set_enumerate_variables_if set_enumerate_variables_while)

lemma t_small_step_fun_restrict_variables:
  "set (enumerate_variables c1) \<subseteq> S \<Longrightarrow> t_small_step_fun t (c1, s1 |` S)
    = (fst (t_small_step_fun t (c1, s1)), snd (t_small_step_fun t (c1, s1)) |` S)"
  apply(induction t arbitrary: c1 s1)
  by(auto simp: small_step_fun_restrict_variables small_step_fun_doesnt_add_variables)

end


(*  Title:      HOL/ex/SAT_Examples.thy
    Author:     Alwen Tiu, Tjark Weber
    Copyright   2005-2009
*)

section \<open>Examples for proof methods "sat" and "satx"\<close>

theory SAT_Examples
imports Main
begin

(*
declare [[sat_solver = zchaff_with_proofs]]
declare [[sat_solver = minisat_with_proofs]]
declare [[sat_trace]]
*)

lemma "True"
by sat

lemma "a | ~a"
by sat

lemma "(a | b) & ~a \<Longrightarrow> b"
by sat

lemma "(a & b) | (c & d) \<Longrightarrow> (a & b) | (c & d)"
(*
apply (tactic {* CNF.cnf_rewrite_tac @{context} 1 *})
*)
by sat

lemma "(a & b) | (c & d) \<Longrightarrow> (a & b) | (c & d)"
(*
apply (tactic {* CNF.cnfx_rewrite_tac @{context} 1 *})
apply (erule exE | erule conjE)+
*)
by satx

lemma "(a & b | c & d) & (e & f | g & h) | (i & j | k & l) & (m & n | p & q)
  \<Longrightarrow> (a & b | c & d) & (e & f | g & h) | (i & j | k & l) & (m & n | p & q)"
(*
apply (tactic {* CNF.cnf_rewrite_tac @{context} 1 *})
*)
by sat

lemma "(a & b | c & d) & (e & f | g & h) | (i & j | k & l) & (m & n | p & q)
  \<Longrightarrow> (a & b | c & d) & (e & f | g & h) | (i & j | k & l) & (m & n | p & q)"
(*
apply (tactic {* CNF.cnfx_rewrite_tac @{context} 1 *})
apply (erule exE | erule conjE)+
*)
by satx

lemma "P=P=P=P=P=P=P=P=P=P"
by sat

lemma "P=P=P=P=P=P=P=P=P=P"
by satx

lemma  "!! a b c. [| a | b | c | d ;
e | f | (a & d) ;
~(a | (c & ~c)) | b ;
~(b & (x | ~x)) | c ;
~(d | False) | c ;
~(c | (~p & (p | (q & ~q)))) |] ==> False"
by sat

lemma  "!! a b c. [| a | b | c | d ;
e | f | (a & d) ;
~(a | (c & ~c)) | b ;
~(b & (x | ~x)) | c ;
~(d | False) | c ;
~(c | (~p & (p | (q & ~q)))) |] ==> False"
by satx

text \<open>eta-Equivalence\<close>

lemma "(ALL x. P x) | ~ All P"
by sat

declare [[sat_trace = false]]
declare [[quick_and_dirty = false]]

method_setup rawsat = \<open>
  Scan.succeed (SIMPLE_METHOD' o SAT.rawsat_tac)
\<close> "SAT solver (no preprocessing)"

(* Translated from TPTP problem library: PUZ015-2.006.dimacs *)

lemma assumes 1: "~x0"
and 2: "~x30"
and 3: "~x29"
and 4: "~x59"
and 5: "x1 | x31 | x0"
and 6: "x2 | x32 | x1"
and 7: "x3 | x33 | x2"
and 8: "x4 | x34 | x3"
and 9: "x35 | x4"
and 10: "x5 | x36 | x30"
and 11: "x6 | x37 | x5 | x31"
and 12: "x7 | x38 | x6 | x32"
and 13: "x8 | x39 | x7 | x33"
and 14: "x9 | x40 | x8 | x34"
and 15: "x41 | x9 | x35"
and 16: "x10 | x42 | x36"
and 17: "x11 | x43 | x10 | x37"
and 18: "x12 | x44 | x11 | x38"
and 19: "x13 | x45 | x12 | x39"
and 20: "x14 | x46 | x13 | x40"
and 21: "x47 | x14 | x41"
and 22: "x15 | x48 | x42"
and 23: "x16 | x49 | x15 | x43"
and 24: "x17 | x50 | x16 | x44"
and 25: "x18 | x51 | x17 | x45"
and 26: "x19 | x52 | x18 | x46"
and 27: "x53 | x19 | x47"
and 28: "x20 | x54 | x48"
and 29: "x21 | x55 | x20 | x49"
and 30: "x22 | x56 | x21 | x50"
and 31: "x23 | x57 | x22 | x51"
and 32: "x24 | x58 | x23 | x52"
and 33: "x59 | x24 | x53"
and 34: "x25 | x54"
and 35: "x26 | x25 | x55"
and 36: "x27 | x26 | x56"
and 37: "x28 | x27 | x57"
and 38: "x29 | x28 | x58"
and 39: "~x1 | ~x31"
and 40: "~x1 | ~x0"
and 41: "~x31 | ~x0"
and 42: "~x2 | ~x32"
and 43: "~x2 | ~x1"
and 44: "~x32 | ~x1"
and 45: "~x3 | ~x33"
and 46: "~x3 | ~x2"
and 47: "~x33 | ~x2"
and 48: "~x4 | ~x34"
and 49: "~x4 | ~x3"
and 50: "~x34 | ~x3"
and 51: "~x35 | ~x4"
and 52: "~x5 | ~x36"
and 53: "~x5 | ~x30"
and 54: "~x36 | ~x30"
and 55: "~x6 | ~x37"
and 56: "~x6 | ~x5"
and 57: "~x6 | ~x31"
and 58: "~x37 | ~x5"
and 59: "~x37 | ~x31"
and 60: "~x5 | ~x31"
and 61: "~x7 | ~x38"
and 62: "~x7 | ~x6"
and 63: "~x7 | ~x32"
and 64: "~x38 | ~x6"
and 65: "~x38 | ~x32"
and 66: "~x6 | ~x32"
and 67: "~x8 | ~x39"
and 68: "~x8 | ~x7"
and 69: "~x8 | ~x33"
and 70: "~x39 | ~x7"
and 71: "~x39 | ~x33"
and 72: "~x7 | ~x33"
and 73: "~x9 | ~x40"
and 74: "~x9 | ~x8"
and 75: "~x9 | ~x34"
and 76: "~x40 | ~x8"
and 77: "~x40 | ~x34"
and 78: "~x8 | ~x34"
and 79: "~x41 | ~x9"
and 80: "~x41 | ~x35"
and 81: "~x9 | ~x35"
and 82: "~x10 | ~x42"
and 83: "~x10 | ~x36"
and 84: "~x42 | ~x36"
and 85: "~x11 | ~x43"
and 86: "~x11 | ~x10"
and 87: "~x11 | ~x37"
and 88: "~x43 | ~x10"
and 89: "~x43 | ~x37"
and 90: "~x10 | ~x37"
and 91: "~x12 | ~x44"
and 92: "~x12 | ~x11"
and 93: "~x12 | ~x38"
and 94: "~x44 | ~x11"
and 95: "~x44 | ~x38"
and 96: "~x11 | ~x38"
and 97: "~x13 | ~x45"
and 98: "~x13 | ~x12"
and 99: "~x13 | ~x39"
and 100: "~x45 | ~x12"
and 101: "~x45 | ~x39"
and 102: "~x12 | ~x39"
and 103: "~x14 | ~x46"
and 104: "~x14 | ~x13"
and 105: "~x14 | ~x40"
and 106: "~x46 | ~x13"
and 107: "~x46 | ~x40"
and 108: "~x13 | ~x40"
and 109: "~x47 | ~x14"
and 110: "~x47 | ~x41"
and 111: "~x14 | ~x41"
and 112: "~x15 | ~x48"
and 113: "~x15 | ~x42"
and 114: "~x48 | ~x42"
and 115: "~x16 | ~x49"
and 116: "~x16 | ~x15"
and 117: "~x16 | ~x43"
and 118: "~x49 | ~x15"
and 119: "~x49 | ~x43"
and 120: "~x15 | ~x43"
and 121: "~x17 | ~x50"
and 122: "~x17 | ~x16"
and 123: "~x17 | ~x44"
and 124: "~x50 | ~x16"
and 125: "~x50 | ~x44"
and 126: "~x16 | ~x44"
and 127: "~x18 | ~x51"
and 128: "~x18 | ~x17"
and 129: "~x18 | ~x45"
and 130: "~x51 | ~x17"
and 131: "~x51 | ~x45"
and 132: "~x17 | ~x45"
and 133: "~x19 | ~x52"
and 134: "~x19 | ~x18"
and 135: "~x19 | ~x46"
and 136: "~x52 | ~x18"
and 137: "~x52 | ~x46"
and 138: "~x18 | ~x46"
and 139: "~x53 | ~x19"
and 140: "~x53 | ~x47"
and 141: "~x19 | ~x47"
and 142: "~x20 | ~x54"
and 143: "~x20 | ~x48"
and 144: "~x54 | ~x48"
and 145: "~x21 | ~x55"
and 146: "~x21 | ~x20"
and 147: "~x21 | ~x49"
and 148: "~x55 | ~x20"
and 149: "~x55 | ~x49"
and 150: "~x20 | ~x49"
and 151: "~x22 | ~x56"
and 152: "~x22 | ~x21"
and 153: "~x22 | ~x50"
and 154: "~x56 | ~x21"
and 155: "~x56 | ~x50"
and 156: "~x21 | ~x50"
and 157: "~x23 | ~x57"
and 158: "~x23 | ~x22"
and 159: "~x23 | ~x51"
and 160: "~x57 | ~x22"
and 161: "~x57 | ~x51"
and 162: "~x22 | ~x51"
and 163: "~x24 | ~x58"
and 164: "~x24 | ~x23"
and 165: "~x24 | ~x52"
and 166: "~x58 | ~x23"
and 167: "~x58 | ~x52"
and 168: "~x23 | ~x52"
and 169: "~x59 | ~x24"
and 170: "~x59 | ~x53"
and 171: "~x24 | ~x53"
and 172: "~x25 | ~x54"
and 173: "~x26 | ~x25"
and 174: "~x26 | ~x55"
and 175: "~x25 | ~x55"
and 176: "~x27 | ~x26"
and 177: "~x27 | ~x56"
and 178: "~x26 | ~x56"
and 179: "~x28 | ~x27"
and 180: "~x28 | ~x57"
and 181: "~x27 | ~x57"
and 182: "~x29 | ~x28"
and 183: "~x29 | ~x58"
and 184: "~x28 | ~x58"
shows "False"
using assms
(*
by sat
*)
by rawsat  \<comment> \<open>this is without CNF conversion\<close>

(* Translated from TPTP problem library: MSC007-1.008.dimacs *)

lemma assumes 1: "x0 | x1 | x2 | x3 | x4 | x5 | x6"
and 2: "x7 | x8 | x9 | x10 | x11 | x12 | x13"
and 3: "x14 | x15 | x16 | x17 | x18 | x19 | x20"
and 4: "x21 | x22 | x23 | x24 | x25 | x26 | x27"
and 5: "x28 | x29 | x30 | x31 | x32 | x33 | x34"
and 6: "x35 | x36 | x37 | x38 | x39 | x40 | x41"
and 7: "x42 | x43 | x44 | x45 | x46 | x47 | x48"
and 8: "x49 | x50 | x51 | x52 | x53 | x54 | x55"
and 9: "~x0 | ~x7"
and 10: "~x0 | ~x14"
and 11: "~x0 | ~x21"
and 12: "~x0 | ~x28"
and 13: "~x0 | ~x35"
and 14: "~x0 | ~x42"
and 15: "~x0 | ~x49"
and 16: "~x7 | ~x14"
and 17: "~x7 | ~x21"
and 18: "~x7 | ~x28"
and 19: "~x7 | ~x35"
and 20: "~x7 | ~x42"
and 21: "~x7 | ~x49"
and 22: "~x14 | ~x21"
and 23: "~x14 | ~x28"
and 24: "~x14 | ~x35"
and 25: "~x14 | ~x42"
and 26: "~x14 | ~x49"
and 27: "~x21 | ~x28"
and 28: "~x21 | ~x35"
and 29: "~x21 | ~x42"
and 30: "~x21 | ~x49"
and 31: "~x28 | ~x35"
and 32: "~x28 | ~x42"
and 33: "~x28 | ~x49"
and 34: "~x35 | ~x42"
and 35: "~x35 | ~x49"
and 36: "~x42 | ~x49"
and 37: "~x1 | ~x8"
and 38: "~x1 | ~x15"
and 39: "~x1 | ~x22"
and 40: "~x1 | ~x29"
and 41: "~x1 | ~x36"
and 42: "~x1 | ~x43"
and 43: "~x1 | ~x50"
and 44: "~x8 | ~x15"
and 45: "~x8 | ~x22"
and 46: "~x8 | ~x29"
and 47: "~x8 | ~x36"
and 48: "~x8 | ~x43"
and 49: "~x8 | ~x50"
and 50: "~x15 | ~x22"
and 51: "~x15 | ~x29"
and 52: "~x15 | ~x36"
and 53: "~x15 | ~x43"
and 54: "~x15 | ~x50"
and 55: "~x22 | ~x29"
and 56: "~x22 | ~x36"
and 57: "~x22 | ~x43"
and 58: "~x22 | ~x50"
and 59: "~x29 | ~x36"
and 60: "~x29 | ~x43"
and 61: "~x29 | ~x50"
and 62: "~x36 | ~x43"
and 63: "~x36 | ~x50"
and 64: "~x43 | ~x50"
and 65: "~x2 | ~x9"
and 66: "~x2 | ~x16"
and 67: "~x2 | ~x23"
and 68: "~x2 | ~x30"
and 69: "~x2 | ~x37"
and 70: "~x2 | ~x44"
and 71: "~x2 | ~x51"
and 72: "~x9 | ~x16"
and 73: "~x9 | ~x23"
and 74: "~x9 | ~x30"
and 75: "~x9 | ~x37"
and 76: "~x9 | ~x44"
and 77: "~x9 | ~x51"
and 78: "~x16 | ~x23"
and 79: "~x16 | ~x30"
and 80: "~x16 | ~x37"
and 81: "~x16 | ~x44"
and 82: "~x16 | ~x51"
and 83: "~x23 | ~x30"
and 84: "~x23 | ~x37"
and 85: "~x23 | ~x44"
and 86: "~x23 | ~x51"
and 87: "~x30 | ~x37"
and 88: "~x30 | ~x44"
and 89: "~x30 | ~x51"
and 90: "~x37 | ~x44"
and 91: "~x37 | ~x51"
and 92: "~x44 | ~x51"
and 93: "~x3 | ~x10"
and 94: "~x3 | ~x17"
and 95: "~x3 | ~x24"
and 96: "~x3 | ~x31"
and 97: "~x3 | ~x38"
and 98: "~x3 | ~x45"
and 99: "~x3 | ~x52"
and 100: "~x10 | ~x17"
and 101: "~x10 | ~x24"
and 102: "~x10 | ~x31"
and 103: "~x10 | ~x38"
and 104: "~x10 | ~x45"
and 105: "~x10 | ~x52"
and 106: "~x17 | ~x24"
and 107: "~x17 | ~x31"
and 108: "~x17 | ~x38"
and 109: "~x17 | ~x45"
and 110: "~x17 | ~x52"
and 111: "~x24 | ~x31"
and 112: "~x24 | ~x38"
and 113: "~x24 | ~x45"
and 114: "~x24 | ~x52"
and 115: "~x31 | ~x38"
and 116: "~x31 | ~x45"
and 117: "~x31 | ~x52"
and 118: "~x38 | ~x45"
and 119: "~x38 | ~x52"
and 120: "~x45 | ~x52"
and 121: "~x4 | ~x11"
and 122: "~x4 | ~x18"
and 123: "~x4 | ~x25"
and 124: "~x4 | ~x32"
and 125: "~x4 | ~x39"
and 126: "~x4 | ~x46"
and 127: "~x4 | ~x53"
and 128: "~x11 | ~x18"
and 129: "~x11 | ~x25"
and 130: "~x11 | ~x32"
and 131: "~x11 | ~x39"
and 132: "~x11 | ~x46"
and 133: "~x11 | ~x53"
and 134: "~x18 | ~x25"
and 135: "~x18 | ~x32"
and 136: "~x18 | ~x39"
and 137: "~x18 | ~x46"
and 138: "~x18 | ~x53"
and 139: "~x25 | ~x32"
and 140: "~x25 | ~x39"
and 141: "~x25 | ~x46"
and 142: "~x25 | ~x53"
and 143: "~x32 | ~x39"
and 144: "~x32 | ~x46"
and 145: "~x32 | ~x53"
and 146: "~x39 | ~x46"
and 147: "~x39 | ~x53"
and 148: "~x46 | ~x53"
and 149: "~x5 | ~x12"
and 150: "~x5 | ~x19"
and 151: "~x5 | ~x26"
and 152: "~x5 | ~x33"
and 153: "~x5 | ~x40"
and 154: "~x5 | ~x47"
and 155: "~x5 | ~x54"
and 156: "~x12 | ~x19"
and 157: "~x12 | ~x26"
and 158: "~x12 | ~x33"
and 159: "~x12 | ~x40"
and 160: "~x12 | ~x47"
and 161: "~x12 | ~x54"
and 162: "~x19 | ~x26"
and 163: "~x19 | ~x33"
and 164: "~x19 | ~x40"
and 165: "~x19 | ~x47"
and 166: "~x19 | ~x54"
and 167: "~x26 | ~x33"
and 168: "~x26 | ~x40"
and 169: "~x26 | ~x47"
and 170: "~x26 | ~x54"
and 171: "~x33 | ~x40"
and 172: "~x33 | ~x47"
and 173: "~x33 | ~x54"
and 174: "~x40 | ~x47"
and 175: "~x40 | ~x54"
and 176: "~x47 | ~x54"
and 177: "~x6 | ~x13"
and 178: "~x6 | ~x20"
and 179: "~x6 | ~x27"
and 180: "~x6 | ~x34"
and 181: "~x6 | ~x41"
and 182: "~x6 | ~x48"
and 183: "~x6 | ~x55"
and 184: "~x13 | ~x20"
and 185: "~x13 | ~x27"
and 186: "~x13 | ~x34"
and 187: "~x13 | ~x41"
and 188: "~x13 | ~x48"
and 189: "~x13 | ~x55"
and 190: "~x20 | ~x27"
and 191: "~x20 | ~x34"
and 192: "~x20 | ~x41"
and 193: "~x20 | ~x48"
and 194: "~x20 | ~x55"
and 195: "~x27 | ~x34"
and 196: "~x27 | ~x41"
and 197: "~x27 | ~x48"
and 198: "~x27 | ~x55"
and 199: "~x34 | ~x41"
and 200: "~x34 | ~x48"
and 201: "~x34 | ~x55"
and 202: "~x41 | ~x48"
and 203: "~x41 | ~x55"
and 204: "~x48 | ~x55"
shows "False"
using assms
(*
by sat
*)
by rawsat  \<comment> \<open>this is without CNF conversion\<close>

(* Old sequent clause representation ("[c_i, p, ~q, \<dots>] \<turnstile> False"):
   sat, zchaff_with_proofs: 8705 resolution steps in
                            +++ User 1.154  All 1.189 secs
   sat, minisat_with_proofs: 40790 resolution steps in
                             +++ User 3.762  All 3.806 secs

   rawsat, zchaff_with_proofs: 8705 resolution steps in
                               +++ User 0.731  All 0.751 secs
   rawsat, minisat_with_proofs: 40790 resolution steps in
                                +++ User 3.514  All 3.550 secs

   CNF clause representation ("[c_1 && \<dots> && c_n, p, ~q, \<dots>] \<turnstile> False"):
   rawsat, zchaff_with_proofs: 8705 resolution steps in
                               +++ User 0.653  All 0.670 secs
   rawsat, minisat_with_proofs: 40790 resolution steps in
                                +++ User 1.860  All 1.886 secs

   (as of 2006-08-30, on a 2.5 GHz Pentium 4)
*)

text \<open>
Function {\tt benchmark} takes the name of an existing DIMACS CNF
file, parses this file, passes the problem to a SAT solver, and checks
the proof of unsatisfiability found by the solver.  The function
measures the time spent on proof reconstruction (at least real time
also includes time spent in the SAT solver), and additionally returns
the number of resolution steps in the proof.
\<close>

(*
declare [[sat_solver = zchaff_with_proofs]]
declare [[sat_trace = false]]
declare [[quick_and_dirty = false]]
*)
ML \<open>
  fun benchmark dimacsfile =
    let
      val prop_fm = SAT_Solver.read_dimacs_cnf_file (Path.explode dimacsfile)
      fun and_to_list (Prop_Logic.And (fm1, fm2)) acc = and_to_list fm2 (fm1 :: acc)
        | and_to_list fm acc = rev (fm :: acc)
      val clauses = and_to_list prop_fm []
      val terms = map (HOLogic.mk_Trueprop o Prop_Logic.term_of_prop_formula) clauses
      val cterms = map (Thm.cterm_of @{context}) terms
      val start = Timing.start ()
      val _ = SAT.rawsat_thm @{context} cterms
    in
      (Timing.result start, ! SAT.counter)
    end;
\<close>

end


(*
    Author:      Salomon Sickert
    License:     BSD
*)

section \<open>af - Unfolding Functions - Optimized Code Equations\<close>

theory af_Impl
  imports Main "../af" LTL_Impl
begin

text \<open>Provide optimized code definitions for @{term "\<up>af"} and other functions, which use heuristics to reduce the formula size\<close>

subsection \<open>Helper Function\<close>

fun remove_and_or
where
  "remove_and_or (z or y) = (case z of
      (((z' and x') or y') and x) \<Rightarrow> if x = x' \<and> y = y' then ((z' and x') or y') else remove_and_or z or remove_and_or y
     | _ \<Rightarrow> remove_and_or z or remove_and_or y)"
| "remove_and_or (x and y) = remove_and_or x and remove_and_or y"
| "remove_and_or x = x"

lemma remove_and_or_correct:
  "S \<Turnstile>\<^sub>P remove_and_or x \<longleftrightarrow> S \<Turnstile>\<^sub>P x"
proof (induction x)
  case (LTLOr x y)
    thus ?case
    proof (induction x)
      case (LTLAnd x' y')
        thus ?case
          proof (induction x')
            case (LTLOr x'' y'')
              thus ?case
                by (induction x'') auto
          qed auto
    qed auto
qed auto

subsection \<open>Optimized Equations\<close>

fun af_letter_simp
where
  "af_letter_simp true \<nu> = true"
| "af_letter_simp false \<nu> = false"
| "af_letter_simp p(a) \<nu> = (if a \<in> \<nu> then true else false)"
| "af_letter_simp (np(a)) \<nu>  = (if a \<notin> \<nu> then true else false)"
| "af_letter_simp (\<phi> and \<psi>) \<nu> = (case \<phi> of
      true \<Rightarrow> af_letter_simp \<psi> \<nu>
    | false \<Rightarrow> false
    | p(a) \<Rightarrow> if a \<in> \<nu> then af_letter_simp \<psi> \<nu> else false
    | np(a) \<Rightarrow> if a \<notin> \<nu> then af_letter_simp \<psi> \<nu> else false
    | G \<phi>' \<Rightarrow>
      (let
        \<phi>'' = af_letter_simp \<phi>' \<nu>;
        \<psi>'' = af_letter_simp \<psi> \<nu>
       in
        (if \<phi>'' = \<psi>'' then mk_and' (G \<phi>') \<phi>'' else mk_and id (mk_and' (G \<phi>') \<phi>'') \<psi>''))
    | _ \<Rightarrow> mk_and id (af_letter_simp \<phi> \<nu>) (af_letter_simp \<psi> \<nu>))"
| "af_letter_simp (\<phi> or \<psi>) \<nu> = (case \<phi> of
      true \<Rightarrow> true
    | false \<Rightarrow> af_letter_simp \<psi> \<nu>
    | p(a) \<Rightarrow> if a \<in> \<nu> then true else af_letter_simp \<psi> \<nu>
    | np(a) \<Rightarrow> if a \<notin> \<nu> then true else af_letter_simp \<psi> \<nu>
    | F \<phi>' \<Rightarrow>
      (let
        \<phi>'' = af_letter_simp \<phi>' \<nu>;
        \<psi>'' = af_letter_simp \<psi> \<nu>
       in
        (if \<phi>'' = \<psi>'' then mk_or' (F \<phi>') \<phi>'' else mk_or id (mk_or' (F \<phi>') \<phi>'') \<psi>''))
    | _ \<Rightarrow> mk_or id (af_letter_simp \<phi> \<nu>) (af_letter_simp \<psi> \<nu>))"
| "af_letter_simp (X \<phi>) \<nu> = \<phi>"
| "af_letter_simp (G \<phi>) \<nu> = mk_and' (G \<phi>) (af_letter_simp \<phi> \<nu>)"
| "af_letter_simp (F \<phi>) \<nu> = mk_or' (F \<phi>) (af_letter_simp \<phi> \<nu>)"
| "af_letter_simp (\<phi> U \<psi>) \<nu> = mk_or' (mk_and' (\<phi> U \<psi>) (af_letter_simp \<phi> \<nu>)) (af_letter_simp \<psi> \<nu>)"

lemma af_letter_simp_correct:
  "S \<Turnstile>\<^sub>P af_letter \<phi> \<nu> \<longleftrightarrow> S \<Turnstile>\<^sub>P af_letter_simp \<phi> \<nu>"
proof (induction \<phi>)
  case (LTLAnd \<phi> \<psi>)
    thus ?case
      by (cases \<phi>) (auto simp add: Let_def mk_and_correct mk_and'_correct)
next
  case (LTLOr \<phi> \<psi>)
    thus ?case
      by (cases \<phi>) (auto simp add: Let_def mk_or_correct mk_or'_correct)
qed (simp_all add: mk_and_correct mk_and'_correct mk_or_correct mk_or'_correct)

fun af_G_letter_simp
where
  "af_G_letter_simp true \<nu> = true"
| "af_G_letter_simp false \<nu> = false"
| "af_G_letter_simp p(a) \<nu> = (if a \<in> \<nu> then true else false)"
| "af_G_letter_simp (np(a)) \<nu>  = (if a \<notin> \<nu> then true else false)"
| "af_G_letter_simp (\<phi> and \<psi>) \<nu> = (case \<phi> of
      true \<Rightarrow> af_G_letter_simp \<psi> \<nu>
    | false \<Rightarrow> false
    | p(a) \<Rightarrow> if a \<in> \<nu> then af_G_letter_simp \<psi> \<nu> else false
    | np(a) \<Rightarrow> if a \<notin> \<nu> then af_G_letter_simp \<psi> \<nu> else false
    | _ \<Rightarrow> mk_and id (af_G_letter_simp \<phi> \<nu>) (af_G_letter_simp \<psi> \<nu>))"
| "af_G_letter_simp (\<phi> or \<psi>) \<nu> = (case \<phi> of
      true \<Rightarrow> true
    | false \<Rightarrow> af_G_letter_simp \<psi> \<nu>
    | p(a) \<Rightarrow> if a \<in> \<nu> then true else af_G_letter_simp \<psi> \<nu>
    | np(a) \<Rightarrow> if a \<notin> \<nu> then true else af_G_letter_simp \<psi> \<nu>
    | F \<phi>' \<Rightarrow>
      (let
        \<phi>'' = af_G_letter_simp \<phi>' \<nu>;
        \<psi>'' = af_G_letter_simp \<psi> \<nu>
       in
        (if \<phi>'' = \<psi>'' then mk_or' (F \<phi>') \<phi>'' else mk_or id (mk_or' (F \<phi>') \<phi>'') \<psi>''))
    | _ \<Rightarrow> mk_or id (af_G_letter_simp \<phi> \<nu>) (af_G_letter_simp \<psi> \<nu>))"
| "af_G_letter_simp (X \<phi>) \<nu> = \<phi>"
| "af_G_letter_simp (G \<phi>) \<nu> = G \<phi>"
| "af_G_letter_simp (F \<phi>) \<nu> = mk_or' (F \<phi>) (af_G_letter_simp \<phi> \<nu>)"
| "af_G_letter_simp (\<phi> U \<psi>) \<nu> = mk_or' (mk_and' (\<phi> U \<psi>) (af_G_letter_simp \<phi> \<nu>)) (af_G_letter_simp \<psi> \<nu>)"

fun step_simp
where
  "step_simp p(a) \<nu> = (if a \<in> \<nu> then true else false)"
| "step_simp (np(a)) \<nu>  = (if a \<notin> \<nu> then true else false)"
| "step_simp (\<phi> and \<psi>) \<nu> = (mk_and id (step_simp \<phi> \<nu>) (step_simp \<psi> \<nu>))"
| "step_simp (\<phi> or \<psi>) \<nu> = (mk_or id (step_simp \<phi> \<nu>) (step_simp \<psi> \<nu>))"
| "step_simp (X \<phi>) \<nu> = remove_constants\<^sub>P \<phi>"
| "step_simp \<phi> \<nu> = \<phi>"

lemma step_simp_correct:
  "S \<Turnstile>\<^sub>P step \<phi> \<nu> \<longleftrightarrow> S \<Turnstile>\<^sub>P step_simp \<phi> \<nu>"
proof (induction \<phi>)
  case (LTLAnd \<phi> \<psi>)
    thus ?case
      by (cases \<phi>) (auto simp add: Let_def mk_and_correct mk_and'_correct)
next
  case (LTLOr \<phi> \<psi>)
    thus ?case
      by (cases \<phi>) (auto simp add: Let_def mk_or_correct mk_or'_correct)
qed (simp_all add: mk_and_correct mk_and'_correct mk_or_correct mk_or'_correct remove_constants_correct[symmetric])

fun Unf_simp
where
  "Unf_simp (\<phi> and \<psi>) = (case \<phi> of
      true \<Rightarrow> Unf_simp \<psi>
    | false \<Rightarrow> false
    | G \<phi>' \<Rightarrow>
      (let
        \<phi>'' = Unf_simp \<phi>'; \<psi>'' = Unf_simp \<psi>
       in
        (if \<phi>'' = \<psi>'' then mk_and' (G \<phi>') \<phi>'' else mk_and id (mk_and' (G \<phi>') \<phi>'') \<psi>''))
    | _ \<Rightarrow> mk_and id (Unf_simp \<phi>) (Unf_simp \<psi>))"
| "Unf_simp (\<phi> or \<psi>) = (case \<phi> of
      true \<Rightarrow> true
    | false \<Rightarrow> Unf_simp \<psi>
    | F \<phi>' \<Rightarrow>
      (let
        \<phi>'' = Unf_simp \<phi>'; \<psi>'' = Unf_simp \<psi>
       in
        (if \<phi>'' = \<psi>'' then mk_or' (F \<phi>') \<phi>'' else mk_or id (mk_or' (F \<phi>') \<phi>'') \<psi>''))
    | _ \<Rightarrow> mk_or id (Unf_simp \<phi>) (Unf_simp \<psi>))"
| "Unf_simp (G \<phi>) = mk_and' (G \<phi>) (Unf_simp \<phi>)"
| "Unf_simp (F \<phi>) = mk_or' (F \<phi>) (Unf_simp \<phi>)"
| "Unf_simp (\<phi> U \<psi>) = mk_or' (mk_and' (\<phi> U \<psi>) (Unf_simp \<phi>)) (Unf_simp \<psi>)"
| "Unf_simp \<phi> = \<phi>"

lemma Unf_simp_correct:
  "S \<Turnstile>\<^sub>P Unf \<phi> \<longleftrightarrow> S \<Turnstile>\<^sub>P Unf_simp \<phi>"
proof (induction \<phi>)
  case (LTLAnd \<phi> \<psi>)
    thus ?case
      by (cases \<phi>) (auto simp add: Let_def mk_and_correct mk_and'_correct)
next
  case (LTLOr \<phi> \<psi>)
    thus ?case
      by (cases \<phi>) (auto simp add: Let_def mk_or_correct mk_or'_correct)
qed (simp_all add: mk_and_correct mk_and'_correct mk_or_correct mk_or'_correct)

fun Unf\<^sub>G_simp
where
  "Unf\<^sub>G_simp (\<phi> and \<psi>) = mk_and id (Unf\<^sub>G_simp \<phi>) (Unf\<^sub>G_simp \<psi>)"
| "Unf\<^sub>G_simp (\<phi> or \<psi>) = (case \<phi> of
      true \<Rightarrow> true
    | false \<Rightarrow> Unf\<^sub>G_simp \<psi>
    | F \<phi>' \<Rightarrow>
      (let
        \<phi>'' = Unf\<^sub>G_simp \<phi>'; \<psi>'' = Unf\<^sub>G_simp \<psi>
       in
        (if \<phi>'' = \<psi>'' then mk_or' (F \<phi>') \<phi>'' else mk_or id (mk_or' (F \<phi>') \<phi>'') \<psi>''))
    | _ \<Rightarrow> mk_or id (Unf\<^sub>G_simp \<phi>) (Unf\<^sub>G_simp \<psi>))"
| "Unf\<^sub>G_simp (F \<phi>) = mk_or' (F \<phi>) (Unf\<^sub>G_simp \<phi>)"
| "Unf\<^sub>G_simp (\<phi> U \<psi>) = mk_or' (mk_and' (\<phi> U \<psi>) (Unf\<^sub>G_simp \<phi>)) (Unf\<^sub>G_simp \<psi>)"
| "Unf\<^sub>G_simp \<phi> = \<phi>"

lemma Unf\<^sub>G_simp_correct:
  "S \<Turnstile>\<^sub>P Unf\<^sub>G \<phi> \<longleftrightarrow> S \<Turnstile>\<^sub>P Unf\<^sub>G_simp \<phi>"
proof (induction \<phi>)
  case (LTLAnd \<phi> \<psi>)
    thus ?case
      by (cases \<phi>) (auto simp add: Let_def mk_and_correct mk_and'_correct)
next
  case (LTLOr \<phi> \<psi>)
    thus ?case
      by (cases \<phi>) (auto simp add: Let_def mk_or_correct mk_or'_correct)
qed (simp_all add: mk_and_correct mk_and'_correct mk_or_correct mk_or'_correct)

fun af_letter_opt_simp
where
  "af_letter_opt_simp true \<nu> = true"
| "af_letter_opt_simp false \<nu> = false"
| "af_letter_opt_simp p(a) \<nu> = (if a \<in> \<nu> then true else false)"
| "af_letter_opt_simp (np(a)) \<nu>  = (if a \<notin> \<nu> then true else false)"
| "af_letter_opt_simp (\<phi> and \<psi>) \<nu> = (case \<phi> of
      true \<Rightarrow> af_letter_opt_simp \<psi> \<nu>
    | false \<Rightarrow> false
    | p(a) \<Rightarrow> if a \<in> \<nu> then af_letter_opt_simp \<psi> \<nu> else false
    | np(a) \<Rightarrow> if a \<notin> \<nu> then af_letter_opt_simp \<psi> \<nu> else false
    | G \<phi>' \<Rightarrow>
      (let
        \<phi>'' = Unf_simp \<phi>';
        \<psi>'' = af_letter_opt_simp \<psi> \<nu>
       in
        (if \<phi>'' = \<psi>'' then mk_and' (G \<phi>') \<phi>'' else mk_and id (mk_and' (G \<phi>') \<phi>'') \<psi>''))
    | _ \<Rightarrow> mk_and id (af_letter_opt_simp \<phi> \<nu>) (af_letter_opt_simp \<psi> \<nu>))"
| "af_letter_opt_simp (\<phi> or \<psi>) \<nu> = (case \<phi> of
      true \<Rightarrow> true
    | false \<Rightarrow> af_letter_opt_simp \<psi> \<nu>
    | p(a) \<Rightarrow> if a \<in> \<nu> then true else af_letter_opt_simp \<psi> \<nu>
    | np(a) \<Rightarrow> if a \<notin> \<nu> then true else af_letter_opt_simp \<psi> \<nu>
    | F \<phi>' \<Rightarrow>
      (let
        \<phi>'' = Unf_simp \<phi>';
        \<psi>'' = af_letter_opt_simp \<psi> \<nu>
       in
        (if \<phi>'' = \<psi>'' then mk_or' (F \<phi>') \<phi>'' else mk_or id (mk_or' (F \<phi>') \<phi>'') \<psi>''))
    | _ \<Rightarrow> mk_or id (af_letter_opt_simp \<phi> \<nu>) (af_letter_opt_simp \<psi> \<nu>))"
| "af_letter_opt_simp (X \<phi>) \<nu> = Unf_simp \<phi>"
| "af_letter_opt_simp (G \<phi>) \<nu> = mk_and' (G \<phi>) (Unf_simp \<phi>)"
| "af_letter_opt_simp (F \<phi>) \<nu> = mk_or' (F \<phi>) (Unf_simp \<phi>)"
| "af_letter_opt_simp (\<phi> U \<psi>) \<nu> = mk_or' (mk_and' (\<phi> U \<psi>) (Unf_simp \<phi>)) (Unf_simp \<psi>)"

lemma af_letter_opt_simp_correct:
  "S \<Turnstile>\<^sub>P af_letter_opt \<phi> \<nu> \<longleftrightarrow> S \<Turnstile>\<^sub>P af_letter_opt_simp \<phi> \<nu>"
proof (induction \<phi>)
  case (LTLAnd \<phi> \<psi>)
    thus ?case
      by (cases \<phi>) (auto simp add: Let_def mk_and_correct mk_and'_correct)
next
  case (LTLOr \<phi> \<psi>)
    thus ?case
      by (cases \<phi>) (auto simp add: Let_def mk_or_correct mk_or'_correct)
qed (simp_all add: mk_and_correct mk_and'_correct mk_or_correct mk_or'_correct Unf_simp_correct)

fun af_G_letter_opt_simp
where
  "af_G_letter_opt_simp true \<nu> = true"
| "af_G_letter_opt_simp false \<nu> = false"
| "af_G_letter_opt_simp p(a) \<nu> = (if a \<in> \<nu> then true else false)"
| "af_G_letter_opt_simp (np(a)) \<nu>  = (if a \<notin> \<nu> then true else false)"
| "af_G_letter_opt_simp (\<phi> and \<psi>) \<nu> = (case \<phi> of
      true \<Rightarrow> af_G_letter_opt_simp \<psi> \<nu>
    | false \<Rightarrow> false
    | p(a) \<Rightarrow> if a \<in> \<nu> then af_G_letter_opt_simp \<psi> \<nu> else false
    | np(a) \<Rightarrow> if a \<notin> \<nu> then af_G_letter_opt_simp \<psi> \<nu> else false
    | _ \<Rightarrow> mk_and id (af_G_letter_opt_simp \<phi> \<nu>) (af_G_letter_opt_simp \<psi> \<nu>))"
| "af_G_letter_opt_simp (\<phi> or \<psi>) \<nu> = (case \<phi> of
      true \<Rightarrow> true
    | false \<Rightarrow> af_G_letter_opt_simp \<psi> \<nu>
    | p(a) \<Rightarrow> if a \<in> \<nu> then true else af_G_letter_opt_simp \<psi> \<nu>
    | np(a) \<Rightarrow> if a \<notin> \<nu> then true else af_G_letter_opt_simp \<psi> \<nu>
    | F \<phi>' \<Rightarrow>
      (let
        \<phi>'' = Unf\<^sub>G_simp \<phi>';
        \<psi>'' = af_G_letter_opt_simp \<psi> \<nu>
       in
        (if \<phi>'' = \<psi>'' then mk_or' (F \<phi>') \<phi>'' else mk_or id (mk_or' (F \<phi>') \<phi>'') \<psi>''))
    | _ \<Rightarrow> mk_or id (af_G_letter_opt_simp \<phi> \<nu>) (af_G_letter_opt_simp \<psi> \<nu>))"
| "af_G_letter_opt_simp (X \<phi>) \<nu> = Unf\<^sub>G_simp \<phi>"
| "af_G_letter_opt_simp (G \<phi>) \<nu> = G \<phi>"
| "af_G_letter_opt_simp (F \<phi>) \<nu> = mk_or' (F \<phi>) (Unf\<^sub>G_simp \<phi>)"
| "af_G_letter_opt_simp (\<phi> U \<psi>) \<nu> = mk_or' (mk_and' (\<phi> U \<psi>) (Unf\<^sub>G_simp \<phi>)) (Unf\<^sub>G_simp \<psi>)"

lemma af_G_letter_opt_simp_correct:
  "S \<Turnstile>\<^sub>P af_G_letter_opt \<phi> \<nu> \<longleftrightarrow> S \<Turnstile>\<^sub>P af_G_letter_opt_simp \<phi> \<nu>"
proof (induction \<phi>)
  case (LTLAnd \<phi> \<psi>)
    thus ?case
      by (cases \<phi>) (auto simp add: Let_def mk_and_correct mk_and'_correct)
next
  case (LTLOr \<phi> \<psi>)
    thus ?case
      by (cases \<phi>) (auto simp add: Let_def mk_or_correct mk_or'_correct)
qed (simp_all add: mk_and_correct mk_and'_correct mk_or_correct mk_or'_correct Unf\<^sub>G_simp_correct)

subsection \<open>Register Code Equations\<close>

lemma [code]:
  "\<up>af\<^sub>G (Abs \<phi>) \<nu> = Abs (remove_and_or (af_G_letter_simp \<phi> \<nu>))"
  unfolding af_G_abs.f_abs.abs_eq af_G_letter_abs_def ltl_prop_equiv_quotient.abs_eq_iff ltl_prop_equiv_def
  using af_G_letter_simp_correct remove_and_or_correct by blast

lemma [code]:
  "\<up>step (Abs \<phi>) \<nu> = Abs (step_simp \<phi> \<nu>)"
  unfolding step_abs.abs_eq ltl_prop_equiv_quotient.abs_eq_iff ltl_prop_equiv_def
  using step_simp_correct by blast

lemma [code]:
  "\<up>Unf (Abs \<phi>) = Abs (remove_and_or (Unf_simp \<phi>))"
  unfolding Unf_abs.abs_eq ltl_prop_equiv_quotient.abs_eq_iff ltl_prop_equiv_def
  using Unf_simp_correct remove_and_or_correct by blast

lemma [code]:
  "\<up>Unf\<^sub>G (Abs \<phi>) = Abs (remove_and_or (Unf\<^sub>G_simp \<phi>))"
  unfolding Unf\<^sub>G_abs.abs_eq ltl_prop_equiv_quotient.abs_eq_iff ltl_prop_equiv_def
  using Unf\<^sub>G_simp_correct remove_and_or_correct by blast

lemma [code]:
  "\<up>af\<^sub>\<UU> (Abs \<phi>) \<nu> = Abs (remove_and_or (af_letter_opt_simp \<phi> \<nu>))"
  unfolding af_abs_opt.f_abs.abs_eq af_letter_abs_opt_def ltl_prop_equiv_quotient.abs_eq_iff ltl_prop_equiv_def
  using af_letter_opt_simp_correct remove_and_or_correct by blast

lemma [code]:
  "\<up>af\<^sub>G\<^sub>\<UU> (Abs \<phi>) \<nu> = Abs (remove_and_or (af_G_letter_opt_simp \<phi> \<nu>))"
  unfolding af_G_abs_opt.f_abs.abs_eq af_G_letter_abs_opt_def ltl_prop_equiv_quotient.abs_eq_iff ltl_prop_equiv_def
  using af_G_letter_opt_simp_correct remove_and_or_correct by blast

end