diff --git a/thys/IP_Addresses/CIDR_Split.thy b/thys/IP_Addresses/CIDR_Split.thy
--- a/thys/IP_Addresses/CIDR_Split.thy
+++ b/thys/IP_Addresses/CIDR_Split.thy
@@ -1,381 +1,381 @@
 (*  Title:      CIDR_Split.thy
     Authors:    Julius Michaelis, Cornelius Diekmann
 *)
 theory CIDR_Split
 imports IP_Address
         Prefix_Match
         Hs_Compat
 begin
 
 section\<open>CIDR Split Motivation (Example for IPv4)\<close>
   text\<open>When talking about ranges of IP addresses, we can make the ranges explicit by listing their elements.\<close>
 context
 begin
   private lemma "map (of_nat \<circ> nat) [1 .. 4] = ([1, 2, 3, 4]:: 32 word list)" by eval
   private definition ipv4addr_upto :: "32 word \<Rightarrow> 32 word \<Rightarrow> 32 word list" where
     "ipv4addr_upto i j \<equiv> map (of_nat \<circ> nat) [int (unat i) .. int (unat j)]"
   private lemma ipv4addr_upto: "set (ipv4addr_upto i j) = {i .. j}"
     proof -
       have int_interval_eq_image: "{int m..int n} = int ` {m..n}" for m n
         by (auto intro!: image_eqI [of _ int "nat k" for k])
       have helpX:"\<And>f (i::nat) (j::nat). (f \<circ> nat) ` {int i..int j} = f ` {i .. j}"
         by (auto simp add: image_comp int_interval_eq_image)
     {   fix xa :: int
         assume a1: "int (unat i) \<le> xa \<and> xa \<le> int (unat j)"
         then have f2: "int (nat xa) = xa"
           by force
         then have "unat (of_int xa::32 word) = nat xa"
           using a1 by (metis (full_types) le_unat_uoi nat_int nat_mono of_int_of_nat_eq)
         then have "i \<le> of_int xa" and "of_int xa \<le> j"
           using f2 a1 by (metis (no_types) uint_nat word_le_def)+
     } note hlp=this
     show ?thesis
       unfolding ipv4addr_upto_def
       apply(intro set_eqI)
       apply(simp)
       apply(safe)
         apply(simp_all)
         using hlp apply blast
         using hlp apply blast
         apply (metis atLeastAtMost_iff imageI image_int_atLeastAtMost of_int_of_nat_eq word_le_nat_alt word_unat.Rep_inverse)
         done
     qed
 
   text\<open>The function @{const ipv4addr_upto} gives back a list of all the ips in the list.
         This list can be pretty huge! In the following, we will use CIDR notation (e.g. 192.168.0.0/24)
         to describe the list more compactly.\<close>
 end
 
 
 
 section\<open>CIDR Split\<close>
 
 context
 begin
 
 private lemma find_SomeD: "find f x = Some y \<Longrightarrow> f y \<and> y \<in> set x" 
   by(induction x; simp split: if_splits)
 
 (*pfxes needs a dummy parameter. The first parameter is a dummy that we have the 'a::len0 type and
   can refer to its length.*)
 private definition pfxes :: "'a::len0 itself \<Rightarrow> nat list" where
   "pfxes _ = map nat [0..int(len_of TYPE ('a))]"
 private lemma "pfxes TYPE(32) = map nat [0 .. 32]" by eval
 
 private definition "largest_contained_prefix (a::('a :: len) word) r = (
   let cs = (map (\<lambda>s. PrefixMatch a s) (pfxes TYPE('a)));
       \<comment> \<open>anything that is a subset should also be a valid prefix. but try proving that.\<close>
       cfs = find (\<lambda>s. valid_prefix s \<and> wordinterval_subset (prefix_to_wordinterval s) r) cs in
   cfs)
 "
 (* The joke is that it is always Some, given that a \<in> r. *)
 
 text\<open>Split off one prefix:\<close>
 private definition wordinterval_CIDR_split1
   :: "'a::len wordinterval \<Rightarrow> 'a prefix_match option \<times> 'a wordinterval" where
   "wordinterval_CIDR_split1 r \<equiv> (
    let ma = wordinterval_lowest_element r in
    case ma of 
       None \<Rightarrow> (None, r) |
       Some a \<Rightarrow> (case largest_contained_prefix a r of 
         None \<Rightarrow> (None, r) |
         Some m \<Rightarrow> (Some m, wordinterval_setminus r (prefix_to_wordinterval m))))"
 
 private lemma wordinterval_CIDR_split1_innard_helper: fixes a::"'a::len word"
   shows "wordinterval_lowest_element r = Some a \<Longrightarrow> 
   largest_contained_prefix a r \<noteq> None"
 proof -
   assume a: "wordinterval_lowest_element r = Some a"
   have b: "(a,len_of(TYPE('a))) \<in> set (map (Pair a) (pfxes TYPE('a)))"
     unfolding pfxes_def set_map set_upto
     using Set.image_iff atLeastAtMost_iff int_eq_iff order_refl by metis (*400ms*)
   have c: "valid_prefix (PrefixMatch a (len_of(TYPE('a))))" by(simp add: valid_prefix_def pfxm_mask_def)
   have "wordinterval_to_set (prefix_to_wordinterval (PrefixMatch a (len_of(TYPE('a))))) = {a}"
     unfolding prefix_to_wordinterval_def pfxm_mask_def by simp
   moreover have "a \<in> wordinterval_to_set r"
     using a wordinterval_lowest_element_set_eq wordinterval_lowest_none_empty
     by (metis is_lowest_element_def option.distinct(1))
   ultimately have d:
     "wordinterval_to_set (prefix_to_wordinterval (PrefixMatch a (LENGTH('a)))) \<subseteq> wordinterval_to_set r"
     by simp
   show ?thesis
     unfolding largest_contained_prefix_def Let_def
     using b c d by(auto simp add: find_None_iff)
 qed
 
 private lemma r_split1_not_none: fixes r:: "'a::len wordinterval"
   shows "\<not> wordinterval_empty r \<Longrightarrow> fst (wordinterval_CIDR_split1 r) \<noteq> None"
   unfolding wordinterval_CIDR_split1_def Let_def
   by(cases "wordinterval_lowest_element r")
     (auto simp add: wordinterval_lowest_none_empty 
           dest: wordinterval_CIDR_split1_innard_helper)
 
 private lemma largest_contained_prefix_subset:
   "largest_contained_prefix a r = Some p \<Longrightarrow> wordinterval_to_set (prefix_to_wordinterval p) \<subseteq> wordinterval_to_set r"
 unfolding largest_contained_prefix_def Let_def
 by(drule find_SomeD) simp
 
 private lemma wordinterval_CIDR_split1_snd: "wordinterval_CIDR_split1 r = (Some s, u) \<Longrightarrow> u = wordinterval_setminus r (prefix_to_wordinterval s)"
   unfolding wordinterval_CIDR_split1_def Let_def by(clarsimp split: option.splits)
 
 private lemma largest_contained_prefix_subset_s1D:
   "wordinterval_CIDR_split1 r = (Some s, u) \<Longrightarrow> wordinterval_to_set (prefix_to_wordinterval s) \<subseteq> wordinterval_to_set r"
 by(intro largest_contained_prefix_subset[where a = "the (wordinterval_lowest_element r)"])
   (simp add: wordinterval_CIDR_split1_def split: option.splits)
 
 private theorem wordinterval_CIDR_split1_preserve: fixes r:: "'a::len wordinterval"
   shows "wordinterval_CIDR_split1 r = (Some s, u) \<Longrightarrow> wordinterval_eq (wordinterval_union (prefix_to_wordinterval s) u) r"
 proof(unfold wordinterval_eq_set_eq)
   assume as: "wordinterval_CIDR_split1 r = (Some s, u)"
   have ud: "u = wordinterval_setminus r (prefix_to_wordinterval s)"
     using as[THEN wordinterval_CIDR_split1_snd] .
   with largest_contained_prefix_subset_s1D[OF as]
   show "wordinterval_to_set (wordinterval_union (prefix_to_wordinterval s) u) = wordinterval_to_set r"
     unfolding ud by auto
 qed
 
 private lemma wordinterval_CIDR_split1_some_r_ne:
   "wordinterval_CIDR_split1 r = (Some s, u) \<Longrightarrow> \<not> wordinterval_empty r"
 proof(rule ccontr, goal_cases)
   case 1
   have "wordinterval_lowest_element r = None" unfolding wordinterval_lowest_none_empty using 1(2) unfolding not_not .
   then have "wordinterval_CIDR_split1 r = (None, r)" unfolding wordinterval_CIDR_split1_def Let_def by simp
   then show False using 1(1) by simp
 qed
 
 private lemma wordinterval_CIDR_split1_distinct: fixes r:: "'a::len wordinterval"
   shows "wordinterval_CIDR_split1 r = (Some s, u) \<Longrightarrow>
            wordinterval_empty (wordinterval_intersection (prefix_to_wordinterval s) u)"
 proof(goal_cases)
   case 1
   have nn: "wordinterval_lowest_element r \<noteq> None"
     using wordinterval_CIDR_split1_some_r_ne 1 wordinterval_lowest_none_empty by metis
   from 1 have "u = wordinterval_setminus r (prefix_to_wordinterval s)"
     by(elim wordinterval_CIDR_split1_snd)
   then show ?thesis by simp
 qed
 
 private lemma wordinterval_CIDR_split1_distinct2: fixes r:: "'a::len wordinterval"
   shows "wordinterval_CIDR_split1 r = (Some s, u) \<Longrightarrow>
           wordinterval_empty (wordinterval_intersection (prefix_to_wordinterval s) u)"
 by(rule wordinterval_CIDR_split1_distinct[where r = r]) simp
 
 function wordinterval_CIDR_split_prefixmatch
   :: "'a::len wordinterval \<Rightarrow> 'a prefix_match list" where
   "wordinterval_CIDR_split_prefixmatch rs = (
       if
         \<not> wordinterval_empty rs
       then case wordinterval_CIDR_split1 rs
                       of (Some s, u) \<Rightarrow> s # wordinterval_CIDR_split_prefixmatch u
                       |   _ \<Rightarrow> []
       else
         []
       )"
   by pat_completeness simp
 
 termination wordinterval_CIDR_split_prefixmatch
 proof(relation "measure (card \<circ> wordinterval_to_set)", rule wf_measure, unfold in_measure comp_def, goal_cases)
   note vernichter = wordinterval_empty_set_eq wordinterval_intersection_set_eq wordinterval_union_set_eq wordinterval_eq_set_eq
   case (1 rs x y x2)
   note some = 1(2)[unfolded 1(3), symmetric]
   from prefix_never_empty have "wordinterval_to_set (prefix_to_wordinterval x2) \<noteq> {}" unfolding vernichter .
   thus ?case
     unfolding wordinterval_CIDR_split1_preserve[OF some, unfolded vernichter, symmetric]
     unfolding card_Un_disjoint[OF finite finite wordinterval_CIDR_split1_distinct[OF some, unfolded vernichter]]
     by auto
 qed
 
 private lemma unfold_rsplit_case:
   assumes su: "(Some s, u) = wordinterval_CIDR_split1 rs"
   shows "(case wordinterval_CIDR_split1 rs of (None, u) \<Rightarrow> []
                                             | (Some s, u) \<Rightarrow> s # wordinterval_CIDR_split_prefixmatch u) = s # wordinterval_CIDR_split_prefixmatch u"
 using su by (metis option.simps(5) split_conv)
 
 lemma "wordinterval_CIDR_split_prefixmatch
           (RangeUnion (WordInterval (0x40000000) 0x5FEFBBCC) (WordInterval 0x5FEEBB1C 0x7FFFFFFF))
        = [PrefixMatch (0x40000000::32 word) 2]" by eval
 lemma "length (wordinterval_CIDR_split_prefixmatch (WordInterval 0 (0xFFFFFFFE::32 word))) = 32" by eval
 
 
 declare wordinterval_CIDR_split_prefixmatch.simps[simp del]
 
 theorem wordinterval_CIDR_split_prefixmatch:
   "wordinterval_to_set r = (\<Union>x\<in>set (wordinterval_CIDR_split_prefixmatch r). prefix_to_wordset x)"
 proof(induction r rule: wordinterval_CIDR_split_prefixmatch.induct)
   case (1 rs)
   show ?case proof(cases "wordinterval_empty rs")
     case True
     thus ?thesis by(simp add: wordinterval_CIDR_split_prefixmatch.simps)
   next
     case False
     obtain x y where s1: "wordinterval_CIDR_split1 rs = (Some x, y)"
       using r_split1_not_none[OF False] by(auto simp add: fst_def split: prod.splits)
     have mIH: "wordinterval_to_set y = (\<Union>x\<in>set (wordinterval_CIDR_split_prefixmatch y). prefix_to_wordset x)"
       using 1[OF False s1[symmetric] refl] .
     have *: "wordinterval_to_set rs = prefix_to_wordset x \<union> (\<Union>x\<in>set (wordinterval_CIDR_split_prefixmatch y). prefix_to_wordset x)"  
       unfolding mIH[symmetric]
     proof -
       have ud: "y = wordinterval_setminus rs (prefix_to_wordinterval x)"
         using wordinterval_CIDR_split1_snd[OF s1] .
       have ss: "prefix_to_wordset x \<subseteq> wordinterval_to_set rs"
         using largest_contained_prefix_subset_s1D[OF s1] by simp
       show "wordinterval_to_set rs = prefix_to_wordset x \<union> wordinterval_to_set y" 
         unfolding ud using ss by simp blast
     qed
     show ?thesis
       apply(subst wordinterval_CIDR_split_prefixmatch.simps)
       apply(unfold if_P[OF False] s1 prod.simps option.simps *) (* WOOOOO simplifier bug (* try making this a simp add: *) *)
       apply(simp)
     done
   qed
 qed
 
 lemma wordinterval_CIDR_split_prefixmatch_all_valid_Ball: fixes r:: "'a::len wordinterval"
   shows "\<forall>e\<in>set (wordinterval_CIDR_split_prefixmatch r). valid_prefix e \<and> pfxm_length e \<le> LENGTH('a)"
 (* The induction is somewhat verbose, so it is less annoying to write the two down at once *)
 proof(induction r rule: wordinterval_CIDR_split_prefixmatch.induct)
   case 1
   case (1 rs)
   show ?case proof(cases "wordinterval_empty rs")
     case False
     obtain x y where s1: "wordinterval_CIDR_split1 rs = (Some x, y)" 
       using r_split1_not_none[OF False] by(auto simp add: fst_def split: prod.splits)
     hence i1: "valid_prefix x"
       unfolding wordinterval_CIDR_split1_def Let_def largest_contained_prefix_def
       by(auto dest: find_SomeD split: option.splits)
     have i2: "pfxm_length x \<le> LENGTH('a)" 
       using s1 unfolding wordinterval_CIDR_split1_def Let_def largest_contained_prefix_def pfxes_def
       by(force split: option.splits dest: find_SomeD simp: nat_le_iff)
     have mIH: "\<forall>a\<in>set (wordinterval_CIDR_split_prefixmatch y). valid_prefix a \<and> pfxm_length a \<le> LENGTH('a)"
       using 1[OF False s1[symmetric] refl] .
     with i1 i2 show ?thesis
       apply(subst wordinterval_CIDR_split_prefixmatch.simps)
       apply(unfold if_P[OF False] s1 prod.simps option.simps)
       apply(simp)
     done
   qed (simp add: wordinterval_CIDR_split_prefixmatch.simps)
 qed
 
 
 private lemma wordinterval_CIDR_split_prefixmatch_all_valid_less_Ball_hlp:
 	"x \<in> set [s\<leftarrow>map (PrefixMatch x2) (pfxes TYPE('a::len0)) . valid_prefix s \<and> wordinterval_to_set (prefix_to_wordinterval s) \<subseteq> wordinterval_to_set rs] \<Longrightarrow> pfxm_length x \<le> LENGTH('a)"
 by(clarsimp simp: pfxes_def) presburger
 
 
 text\<open>Since @{const wordinterval_CIDR_split_prefixmatch} only returns valid prefixes, we can safely convert it to CIDR lists\<close>
 (* actually, just valid_prefix doesn't mean that the prefix length is sane. Fortunately, wordinterval_CIDR_split_prefixmatch_all_valid_Ball does entail that *)
 lemma "valid_prefix (PrefixMatch (0::16 word) 20)" by(simp add: valid_prefix_def)
 
 lemma wordinterval_CIDR_split_disjunct: "a \<in> set (wordinterval_CIDR_split_prefixmatch i) \<Longrightarrow>
   b \<in> set (wordinterval_CIDR_split_prefixmatch i) \<Longrightarrow> a \<noteq> b \<Longrightarrow>
   prefix_to_wordset a \<inter> prefix_to_wordset b = {}"
 proof(induction i rule: wordinterval_CIDR_split_prefixmatch.induct)
   case (1 rs)
   note IH = 1(1)
   have prema: "a \<in> set (wordinterval_CIDR_split_prefixmatch rs)" (is "a \<in> ?os") using 1 by simp
   have premb: "b \<in> ?os" using 1 by simp
   show ?case proof(cases "wordinterval_empty rs")
     case False
     obtain x y where s1: "wordinterval_CIDR_split1 rs = (Some x, y)" 
       using r_split1_not_none[OF False] by(auto simp add: fst_def split: prod.splits)
     have mi: "k \<in> set (wordinterval_CIDR_split_prefixmatch y)" (is "k \<in> ?rs") 
       if p: "k \<noteq> x" "k \<in> ?os" for k using p s1 
       by(subst (asm) wordinterval_CIDR_split_prefixmatch.simps) (simp only: if_P[OF False] split: prod.splits option.splits; simp)
     have a: "k \<in> ?rs \<Longrightarrow> prefix_to_wordset k \<subseteq> wordinterval_to_set y" for k 
       (* this is actually a quite general statement, might make a lemma out of it *)
       unfolding wordinterval_CIDR_split_prefixmatch by blast
     have b: "prefix_to_wordset x \<inter> wordinterval_to_set y = {}"
       using wordinterval_CIDR_split1_snd[OF s1] by simp
     show ?thesis
     proof(cases "a = x"; cases "b = x")
       assume as: "a = x" "b \<noteq> x"
       with a[OF mi[OF as(2) premb]] b
       show ?thesis by blast
     next
       assume as: "a \<noteq> x" "b = x"
       with a[OF mi[OF as(1) prema]] b
       show ?thesis by blast
     next
       assume as: "a \<noteq> x" "b \<noteq> x" (* Nothing to do case *)
       have i: "a \<in> ?rs" "b \<in> ?rs"
         using as mi prema premb by blast+
       show "prefix_to_wordset a \<inter> prefix_to_wordset b = {}"
         by(rule IH[OF False s1[symmetric] refl i]) (fact 1)
     next
       assume as: "a = x" "b = x" (* impossible case *)
       with 1 have False by simp
       thus ?thesis ..
     qed
   next
     case True
     hence "wordinterval_CIDR_split_prefixmatch rs = []" by(simp add: wordinterval_CIDR_split_prefixmatch.simps)
     thus ?thesis using prema by simp
   qed
 qed
 
 lemma wordinterval_CIDR_split_distinct: "distinct (wordinterval_CIDR_split_prefixmatch i)"
 (* wish this was a corollary *)
 proof(induction i rule: wordinterval_CIDR_split_prefixmatch.induct)
   case (1 rs)
   show ?case proof(cases "wordinterval_empty rs")
     case False
     obtain x y where s1: "wordinterval_CIDR_split1 rs = (Some x, y)" 
       using r_split1_not_none[OF False] by(auto simp add: fst_def split: prod.splits)
     have mIH: "distinct (wordinterval_CIDR_split_prefixmatch y)"
       using 1[OF False s1[symmetric] refl] .
     have "prefix_to_wordset x \<inter> wordinterval_to_set y = {}"
       using wordinterval_CIDR_split1_snd[OF s1] by simp
     hence i1: "x \<notin> set (wordinterval_CIDR_split_prefixmatch y)"
       unfolding wordinterval_CIDR_split_prefixmatch using prefix_never_empty[of x, simplified] by blast
     show ?thesis
       using s1
       by(subst wordinterval_CIDR_split_prefixmatch.simps)
         (simp add: if_P[OF False] mIH i1 split: option.splits prod.splits)
   qed (simp add: wordinterval_CIDR_split_prefixmatch.simps)
 qed
 
 lemma wordinterval_CIDR_split_existential:
 	"x \<in> wordinterval_to_set w \<Longrightarrow> \<exists>s. s \<in> set (wordinterval_CIDR_split_prefixmatch w) \<and> x \<in> prefix_to_wordset s"
 using wordinterval_CIDR_split_prefixmatch[symmetric] by fastforce
 
 subsection\<open>Versions for @{const ipset_from_cidr}\<close>
 
 definition cidr_split :: "'i::len wordinterval \<Rightarrow> ('i word \<times> nat) list" where
   "cidr_split rs \<equiv> map prefix_match_to_CIDR (wordinterval_CIDR_split_prefixmatch rs)"
                                         
 corollary cidr_split_prefix: 
   fixes r :: "'i::len wordinterval"
   shows "(\<Union>x\<in>set (cidr_split r). uncurry ipset_from_cidr x) = wordinterval_to_set r"
     unfolding wordinterval_CIDR_split_prefixmatch[symmetric] cidr_split_def
     apply(simp add: prefix_match_to_CIDR_def2 wordinterval_CIDR_split_prefixmatch)
     using prefix_to_wordset_ipset_from_cidr wordinterval_CIDR_split_prefixmatch_all_valid_Ball by blast
 
 corollary cidr_split_prefix_single: 
   fixes start :: "'i::len word"
   shows "(\<Union>x\<in>set (cidr_split (iprange_interval (start, end))). uncurry ipset_from_cidr x) = {start..end}"
   unfolding wordinterval_to_set.simps[symmetric]
   using cidr_split_prefix iprange_interval.simps by metis
 
 private lemma interval_in_splitD: "xa \<in> foo \<Longrightarrow> prefix_to_wordset xa \<subseteq> \<Union>(prefix_to_wordset ` foo)" by auto
 
 lemma cidrsplit_no_overlaps: "\<lbrakk>
         x \<in> set (wordinterval_CIDR_split_prefixmatch wi);
         xa \<in> set (wordinterval_CIDR_split_prefixmatch wi); 
-        pt && ~~ pfxm_mask x = pfxm_prefix x;
-        pt && ~~ pfxm_mask xa = pfxm_prefix xa
+        pt && ~~ (pfxm_mask x) = pfxm_prefix x;
+        pt && ~~ (pfxm_mask xa) = pfxm_prefix xa
         \<rbrakk>
        \<Longrightarrow> x = xa"
 proof(rule ccontr, goal_cases)
 	case 1
 	hence "prefix_match_semantics x pt" "prefix_match_semantics xa pt" unfolding prefix_match_semantics_def by (simp_all add: word_bw_comms(1))
 	moreover have "valid_prefix x" "valid_prefix xa" using 1(1-2) wordinterval_CIDR_split_prefixmatch_all_valid_Ball by blast+
 	ultimately have "pt \<in> prefix_to_wordset x" "pt \<in> prefix_to_wordset xa"
 	  using prefix_match_semantics_wordset by blast+
 	with wordinterval_CIDR_split_disjunct[OF 1(1,2) 1(5)] show False by blast
 qed
 
 end
 
 
 
 end
diff --git a/thys/IP_Addresses/IP_Address.thy b/thys/IP_Addresses/IP_Address.thy
--- a/thys/IP_Addresses/IP_Address.thy
+++ b/thys/IP_Addresses/IP_Address.thy
@@ -1,412 +1,412 @@
 (*  Title:      IP_Address.thy
     Authors:    Cornelius Diekmann
 *)
 theory IP_Address
 imports "Word_Lib.Word_Lemmas"
         Hs_Compat
         WordInterval
 begin
 
 section \<open>Modelling IP Adresses\<close>
   text\<open>An IP address is basically an unsigned integer.
     We model IP addresses of arbitrary lengths.
 
     We will write @{typ "'i::len word"} for IP addresses of length @{term "LENGTH('i::len)"}.
     We use the convention to write @{typ 'i} whenever we mean IP addresses instead of generic words.
     When we will later have theorems with several polymorphic types in it (e.g. arbitrarily
     extensible packets), this notation makes it easier to spot that type @{typ 'i} is for
     IP addresses.
 
     The files @{file \<open>IPv4.thy\<close>} @{file \<open>IPv6.thy\<close>} concrete this for IPv4 and IPv6.\<close>
 
   text\<open>The maximum IP address\<close>
   definition max_ip_addr :: "'i::len word" where
     "max_ip_addr \<equiv> of_nat ((2^(len_of(TYPE('i)))) - 1)"
 
   lemma max_ip_addr_max_word: "max_ip_addr = max_word"
     by(simp add: max_ip_addr_def max_word_def word_of_int_minus)
 
   lemma max_ip_addr_max: "\<forall>a. a \<le> max_ip_addr"
     by(simp add: max_ip_addr_max_word)
   lemma range_0_max_UNIV: "UNIV = {0 .. max_ip_addr}" (*not in the simp set, for a reason*)
     by(simp add: max_ip_addr_max_word) fastforce
 
   lemma "size (x::'i::len word) = len_of(TYPE('i))" by(simp add:word_size)
 
 subsection\<open>Sets of IP Addresses\<close>
   (*Warning, not executable!*)
   text\<open>Specifying sets with network masks: 192.168.0.0 255.255.255.0\<close>
   definition ipset_from_netmask::"'i::len word \<Rightarrow> 'i::len word \<Rightarrow> 'i::len word set" where
     "ipset_from_netmask addr netmask \<equiv>
       let
         network_prefix = (addr AND netmask)
       in
         {network_prefix .. network_prefix OR (NOT netmask)}"
 
   text\<open>Example (pseudo syntax):
     @{const ipset_from_netmask} \<open>192.168.1.129  255.255.255.0\<close> =
         \<open>{192.168.1.0 .. 192.168.1.255}\<close>\<close>
 
   text\<open>A network mask of all ones (i.e. @{term "(- 1)::'i::len word"}).\<close>
   lemma ipset_from_netmask_minusone:
     "ipset_from_netmask ip (- 1) = {ip}" by (simp add: ipset_from_netmask_def)
   lemma ipset_from_netmask_maxword:
     "ipset_from_netmask ip max_word = {ip}" by (simp add: ipset_from_netmask_def)
 
   lemma ipset_from_netmask_zero:
     "ipset_from_netmask ip 0 = UNIV" by (auto simp add: ipset_from_netmask_def)
 
 
   text\<open>Specifying sets in Classless Inter-domain Routing (CIDR) notation: 192.168.0.0/24\<close>
   definition ipset_from_cidr ::"'i::len word \<Rightarrow> nat \<Rightarrow> 'i::len word set" where
     "ipset_from_cidr addr pflength \<equiv>
        ipset_from_netmask addr ((mask pflength) << (len_of(TYPE('i)) - pflength))"
 
   text\<open>Example (pseudo syntax):
     @{const ipset_from_cidr} \<open>192.168.1.129 24\<close> = \<open>{192.168.1.0 .. 192.168.1.255}\<close>\<close>
 
   (*does this simplify stuff?*)
   lemma "(case ipcidr of (base, len) \<Rightarrow> ipset_from_cidr base len) = uncurry ipset_from_cidr ipcidr"
     by(simp add: uncurry_case_stmt)
 
   lemma ipset_from_cidr_0: "ipset_from_cidr ip 0 = UNIV"
     by(auto simp add: ipset_from_cidr_def ipset_from_netmask_def Let_def)
 
   text\<open>A prefix length of word size gives back the singleton set with the IP address.
        Example: \<open>192.168.1.2/32 = {192.168.1.2}\<close>\<close>
   lemma ipset_from_cidr_wordlength:
     fixes ip :: "'i::len word"
     shows "ipset_from_cidr ip (LENGTH('i)) = {ip}"
     by(simp add: ipset_from_cidr_def ipset_from_netmask_def Let_def mask_def)
 
   text\<open>Alternative definition: Considering words as bit lists:\<close>
   lemma ipset_from_cidr_bl:
     fixes addr :: "'i::len word"
     shows "ipset_from_cidr addr pflength \<equiv>
             ipset_from_netmask addr (of_bl ((replicate pflength True) @
                                             (replicate ((len_of(TYPE('i))) - pflength)) False))"
     by(simp add: ipset_from_cidr_def mask_bl Word.shiftl_of_bl)
 
   lemma ipset_from_cidr_alt:
     fixes pre :: "'i::len word"
     shows "ipset_from_cidr pre len =
             {pre AND (mask len << LENGTH('i) - len)
              ..
              pre OR mask (LENGTH('i) - len)}"
     apply(simp add: ipset_from_cidr_def ipset_from_netmask_def Let_def)
     apply(simp add: Word.word_oa_dist)
     apply(simp add: NOT_mask_shifted_lenword)
     done
 
   lemma ipset_from_cidr_alt2:
     fixes base ::"'i::len word"
     shows "ipset_from_cidr base len =
-           ipset_from_netmask base (NOT mask (LENGTH('i) - len))"
+           ipset_from_netmask base (NOT (mask (LENGTH('i) - len)))"
     apply(simp add: ipset_from_cidr_def)
     using NOT_mask_shifted_lenword by(metis word_not_not)
 
   text\<open>In CIDR notation, we cannot express the empty set.\<close>
   lemma ipset_from_cidr_not_empty: "ipset_from_cidr base len \<noteq> {}"
     by(simp add: ipset_from_cidr_alt bitmagic_zeroLast_leq_or1Last)
 
   text\<open>Though we can write 192.168.1.2/24, we say that 192.168.0.0/24 is well-formed.\<close>
   lemma ipset_from_cidr_base_wellforemd: fixes base:: "'i::len word"
     assumes "mask (LENGTH('i) - l) AND base = 0"
       shows "ipset_from_cidr base l = {base .. base OR mask (LENGTH('i) - l)}"
   proof -
     have maskshift_eq_not_mask_generic:
-      "((mask l << LENGTH('i) - l) :: 'i::len word) = NOT mask (LENGTH('i) - l)"
+      "((mask l << LENGTH('i) - l) :: 'i::len word) = NOT (mask (LENGTH('i) - l))"
       using NOT_mask_shifted_lenword by (metis word_not_not)
-    have *: "base AND NOT mask (LENGTH('i) - l) = base"
+    have *: "base AND NOT (mask (LENGTH('i) - l)) = base"
       unfolding mask_eq_0_eq_x[symmetric] using assms word_bw_comms(1)[of base] by simp
-    hence **: "base AND NOT mask (LENGTH('i) - l) OR mask (LENGTH('i) - l) =
+    hence **: "base AND NOT (mask (LENGTH('i) - l)) OR mask (LENGTH('i) - l) =
                 base OR mask (LENGTH('i) - l)" by simp
-    have "ipset_from_netmask base (NOT mask (LENGTH('i) - l)) =
+    have "ipset_from_netmask base (NOT (mask (LENGTH('i) - l))) =
             {base .. base || mask (LENGTH('i) - l)}"
       by(simp add: ipset_from_netmask_def Let_def ** *)
     thus ?thesis by(simp add: ipset_from_cidr_def maskshift_eq_not_mask_generic)
   qed
 
 
   lemma ipset_from_cidr_large_pfxlen:
     fixes ip:: "'i::len word"
     assumes "n \<ge> LENGTH('i)"
     shows "ipset_from_cidr ip n = {ip}"
   proof -
     have obviously: "mask (LENGTH('i) - n) = 0" by (simp add: assms)
     show ?thesis
       apply(subst ipset_from_cidr_base_wellforemd)
        subgoal using assms by simp
       by (simp add: obviously)
   qed
 
   lemma ipset_from_netmask_base_mask_consume:
     fixes base :: "'i::len word"
-    shows "ipset_from_netmask (base AND NOT mask (LENGTH('i) - m))
-                              (NOT mask (LENGTH('i) - m))
+    shows "ipset_from_netmask (base AND NOT (mask (LENGTH('i) - m)))
+                              (NOT (mask (LENGTH('i) - m)))
             =
-             ipset_from_netmask base (NOT mask (LENGTH('i) - m))"
+             ipset_from_netmask base (NOT (mask (LENGTH('i) - m)))"
     unfolding ipset_from_netmask_def by(simp)
 
 
   text\<open>Another definition of CIDR notation:
        All IP address which are equal on the first @{term "len - n"} bits\<close>
   definition ip_cidr_set :: "'i::len word \<Rightarrow> nat \<Rightarrow> 'i word set" where
     "ip_cidr_set i r \<equiv>
-      {j . i AND NOT mask (LENGTH('i) - r) = j AND NOT mask (LENGTH('i) - r)}"
+      {j . i AND NOT (mask (LENGTH('i) - r)) = j AND NOT (mask (LENGTH('i) - r))}"
 
   text\<open>The definitions are equal\<close>
   lemma ipset_from_cidr_eq_ip_cidr_set:
     fixes base::"'i::len word"
     shows "ipset_from_cidr base len = ip_cidr_set base len"
   proof -
     have maskshift_eq_not_mask_generic:
-      "((mask len << LENGTH('a) - len) :: 'a::len word) = NOT mask (LENGTH('a) - len)"
+      "((mask len << LENGTH('a) - len) :: 'a::len word) = NOT (mask (LENGTH('a) - len))"
       using NOT_mask_shifted_lenword by (metis word_not_not)
-    have 1: "mask (len - m) AND base AND NOT mask (len - m) = 0"
+    have 1: "mask (len - m) AND base AND NOT (mask (len - m)) = 0"
       for len m and base::"'i::len word"
       by(simp add: word_bw_lcs)
     have 2: "mask (LENGTH('i) - len) AND pfxm_p = 0 \<Longrightarrow>
-           (a \<in> ipset_from_netmask pfxm_p (NOT mask (LENGTH('i) - len))) \<longleftrightarrow>
-           (pfxm_p = NOT mask (LENGTH('i) - len) AND a)" for a::"'i::len word" and pfxm_p
+           (a \<in> ipset_from_netmask pfxm_p (NOT (mask (LENGTH('i) - len)))) \<longleftrightarrow>
+           (pfxm_p = NOT (mask (LENGTH('i) - len)) AND a)" for a::"'i::len word" and pfxm_p
     apply(subst ipset_from_cidr_alt2[symmetric])
     apply(subst zero_base_lsb_imp_set_eq_as_bit_operation)
      apply(simp; fail)
     apply(subst ipset_from_cidr_base_wellforemd)
      apply(simp; fail)
     apply(simp)
     done
     from 2[OF 1, of _ base] have
-      "(x \<in> ipset_from_netmask base (~~ mask (LENGTH('i) - len))) \<longleftrightarrow>
-       (base && ~~ mask (LENGTH('i) - len) = x && ~~ mask (LENGTH('i) - len))" for x
+      "(x \<in> ipset_from_netmask base (~~ (mask (LENGTH('i) - len)))) \<longleftrightarrow>
+       (base && ~~ (mask (LENGTH('i) - len)) = x && ~~ (mask (LENGTH('i) - len)))" for x
     apply(simp add: ipset_from_netmask_base_mask_consume)
-    unfolding word_bw_comms(1)[of _ " ~~ mask (LENGTH('i) - len)"] by simp
+    unfolding word_bw_comms(1)[of _ " ~~ (mask (LENGTH('i) - len))"] by simp
     then show ?thesis
       unfolding ip_cidr_set_def ipset_from_cidr_def
       by(auto simp add:  maskshift_eq_not_mask_generic)
   qed
 
   lemma ip_cidr_set_change_base: "j \<in> ip_cidr_set i r \<Longrightarrow> ip_cidr_set j r = ip_cidr_set i r"
     by (auto simp: ip_cidr_set_def)
 
 
 
 subsection\<open>IP Addresses as WordIntervals\<close>
   text\<open>The nice thing is: @{typ "'i wordinterval"}s are executable.\<close>
 
   definition iprange_single :: "'i::len word \<Rightarrow> 'i wordinterval" where
     "iprange_single ip \<equiv> WordInterval ip ip"
 
   fun iprange_interval :: "('i::len word \<times> 'i::len word) \<Rightarrow> 'i wordinterval" where
     "iprange_interval (ip_start, ip_end) = WordInterval ip_start ip_end"
   declare iprange_interval.simps[simp del]
 
   lemma iprange_interval_uncurry: "iprange_interval ipcidr = uncurry WordInterval ipcidr"
     by(cases ipcidr) (simp add: iprange_interval.simps)
 
   lemma "wordinterval_to_set (iprange_single ip) = {ip}"
     by(simp add: iprange_single_def)
   lemma "wordinterval_to_set (iprange_interval (ip1, ip2)) = {ip1 .. ip2}"
     by(simp add: iprange_interval.simps)
 
   text\<open>Now we can use the set operations on @{typ "'i::len wordinterval"}s\<close>
   term wordinterval_to_set
   term wordinterval_element
   term wordinterval_union
   term wordinterval_empty
   term wordinterval_setminus
   term wordinterval_UNIV
   term wordinterval_invert
   term wordinterval_intersection
   term wordinterval_subset
   term wordinterval_eq
 
 
 subsection\<open>IP Addresses in CIDR Notation\<close>
   text\<open>We want to convert IP addresses in CIDR notation to intervals.
     We already have @{const ipset_from_cidr}, which gives back a non-executable set.
     We want to convert to something we can store in an @{typ "'i wordinterval"}.\<close>
 
   fun ipcidr_to_interval_start :: "('i::len word \<times> nat) \<Rightarrow> 'i::len word" where
     "ipcidr_to_interval_start (pre, len) = (
       let netmask = (mask len) << (LENGTH('i) - len);
           network_prefix = (pre AND netmask)
       in network_prefix)"
   fun ipcidr_to_interval_end :: "('i::len word \<times> nat) \<Rightarrow> 'i::len word" where
     "ipcidr_to_interval_end (pre, len) = (
       let netmask = (mask len) << (LENGTH('i) - len);
           network_prefix = (pre AND netmask)
       in network_prefix OR (NOT netmask))"
   definition ipcidr_to_interval :: "('i::len word \<times> nat) \<Rightarrow> ('i word \<times> 'i word)" where
     "ipcidr_to_interval cidr \<equiv> (ipcidr_to_interval_start cidr, ipcidr_to_interval_end cidr)"
 
 
   lemma ipset_from_cidr_ipcidr_to_interval:
     "ipset_from_cidr base len =
       {ipcidr_to_interval_start (base,len) .. ipcidr_to_interval_end (base,len)}"
     by(simp add: Let_def ipcidr_to_interval_def ipset_from_cidr_def ipset_from_netmask_def)
   declare ipcidr_to_interval_start.simps[simp del] ipcidr_to_interval_end.simps[simp del]
 
   lemma ipcidr_to_interval:
     "ipcidr_to_interval (base, len) = (s,e) \<Longrightarrow> ipset_from_cidr base len = {s .. e}"
     by (simp add: ipcidr_to_interval_def ipset_from_cidr_ipcidr_to_interval)
 
   definition ipcidr_tuple_to_wordinterval :: "('i::len word \<times> nat) \<Rightarrow> 'i wordinterval" where
     "ipcidr_tuple_to_wordinterval iprng \<equiv> iprange_interval (ipcidr_to_interval iprng)"
 
   lemma wordinterval_to_set_ipcidr_tuple_to_wordinterval:
     "wordinterval_to_set (ipcidr_tuple_to_wordinterval (b, m)) = ipset_from_cidr b m"
     unfolding ipcidr_tuple_to_wordinterval_def ipset_from_cidr_ipcidr_to_interval
               ipcidr_to_interval_def
     by(simp add: iprange_interval.simps)
 
   lemma wordinterval_to_set_ipcidr_tuple_to_wordinterval_uncurry:
     "wordinterval_to_set (ipcidr_tuple_to_wordinterval ipcidr) = uncurry ipset_from_cidr ipcidr"
     by(cases ipcidr, simp add: wordinterval_to_set_ipcidr_tuple_to_wordinterval)
 
   definition ipcidr_union_set :: "('i::len word \<times> nat) set \<Rightarrow> ('i word) set" where
     "ipcidr_union_set ips \<equiv> \<Union>(base, len) \<in> ips. ipset_from_cidr base len"
 
   lemma ipcidr_union_set_uncurry:
     "ipcidr_union_set ips = (\<Union> ipcidr \<in> ips. uncurry ipset_from_cidr ipcidr)"
     by(simp add: ipcidr_union_set_def uncurry_case_stmt)
 
 
 subsection\<open>Clever Operations on IP Addresses in CIDR Notation\<close>
   text\<open>Intersecting two intervals may result in a new interval.
     Example: \<open>{1..10} \<inter> {5..20} = {5..10}\<close>
 
     Intersecting two IP address ranges represented as CIDR ranges results either in the empty set
     or the smaller of the two ranges. It will never create a new range.
     \<close>
   context
   begin
     (*contributed by Lars Noschinski*)
     private lemma less_and_not_mask_eq:
       fixes i :: "('a :: len) word"
-      assumes "r2 \<le> r1" "i && ~~ mask r2 = x && ~~ mask r2"
-      shows "i && ~~ mask r1 = x && ~~ mask r1"
+      assumes "r2 \<le> r1" "i && ~~ (mask r2) = x && ~~ (mask r2)"
+      shows "i && ~~ (mask r1) = x && ~~ (mask r1)"
     proof -
-      have "i AND NOT mask r1 = (i && ~~ mask r2) && ~~ mask r1" (is "_ = ?w && _")
+      have "i AND NOT (mask r1) = (i && ~~ (mask r2)) && ~~ (mask r1)" (is "_ = ?w && _")
         using \<open>r2 \<le> r1\<close> by (simp add: and_not_mask_twice max_def)
-      also have "?w = x && ~~ mask r2" by fact
-      also have "\<dots> && ~~ mask r1 = x && ~~ mask r1"
+      also have "?w = x && ~~ (mask r2)" by fact
+      also have "\<dots> && ~~ (mask r1) = x && ~~ (mask r1)"
         using \<open>r2 \<le> r1\<close> by (simp add: and_not_mask_twice max_def)
       finally show ?thesis .
     qed
 
     lemma ip_cidr_set_less:
       fixes i :: "'i::len word"
       shows "r1 \<le> r2 \<Longrightarrow> ip_cidr_set i r2 \<subseteq> ip_cidr_set i r1"
       unfolding ip_cidr_set_def
       apply auto
       apply (rule less_and_not_mask_eq[where ?r2.0="LENGTH('i) - r2"])
       apply auto
       done
 
     private lemma ip_cidr_set_intersect_subset_helper:
       fixes i1 r1 i2 r2
       assumes disj: "ip_cidr_set i1 r1 \<inter> ip_cidr_set i2 r2 \<noteq> {}" and  "r1 \<le> r2"
       shows "ip_cidr_set i2 r2 \<subseteq> ip_cidr_set i1 r1"
       proof -
       from disj obtain j where "j \<in> ip_cidr_set i1 r1" "j \<in> ip_cidr_set i2 r2" by auto
       with \<open>r1 \<le> r2\<close> have "j \<in> ip_cidr_set j r1" "j \<in> ip_cidr_set j r1"
         using ip_cidr_set_change_base ip_cidr_set_less by blast+
 
       show "ip_cidr_set i2 r2 \<subseteq> ip_cidr_set i1 r1"
       proof
         fix i assume "i \<in> ip_cidr_set i2 r2"
         with \<open>j \<in> ip_cidr_set i2 r2\<close> have "i \<in> ip_cidr_set j r2" using ip_cidr_set_change_base by auto
         also have "ip_cidr_set j r2 \<subseteq> ip_cidr_set j r1" using \<open>r1 \<le> r2\<close> ip_cidr_set_less by blast
         also have "\<dots> = ip_cidr_set i1 r1" using \<open>j \<in> ip_cidr_set i1 r1\<close> ip_cidr_set_change_base by blast
         finally show "i \<in> ip_cidr_set i1 r1" .
       qed
     qed
 
     lemma ip_cidr_set_notsubset_empty_inter:
       "\<not> ip_cidr_set i1 r1 \<subseteq> ip_cidr_set i2 r2 \<Longrightarrow>
        \<not> ip_cidr_set i2 r2 \<subseteq> ip_cidr_set i1 r1 \<Longrightarrow>
        ip_cidr_set i1 r1 \<inter> ip_cidr_set i2 r2 = {}"
       apply(cases "r1 \<le> r2")
        subgoal using ip_cidr_set_intersect_subset_helper by blast
       apply(cases "r2 \<le> r1")
        subgoal using ip_cidr_set_intersect_subset_helper by blast
       by(simp)
   end
 
 
   lemma ip_cidr_intersect:
      "\<not> ipset_from_cidr b2 m2 \<subseteq> ipset_from_cidr b1 m1 \<Longrightarrow>
       \<not> ipset_from_cidr b1 m1 \<subseteq> ipset_from_cidr b2 m2 \<Longrightarrow>
       ipset_from_cidr b1 m1 \<inter> ipset_from_cidr b2 m2 = {}"
     apply(simp add: ipset_from_cidr_eq_ip_cidr_set)
     using ip_cidr_set_notsubset_empty_inter by blast
 
   text\<open>Computing the intersection of two IP address ranges in CIDR notation\<close>
   fun ipcidr_conjunct :: "('i::len word \<times> nat) \<Rightarrow> ('i word \<times> nat) \<Rightarrow> ('i word \<times> nat) option" where
     "ipcidr_conjunct (base1, m1) (base2, m2) = (
        if
          ipset_from_cidr base1 m1 \<inter> ipset_from_cidr base2 m2 = {}
        then
          None
        else if
          ipset_from_cidr base1 m1 \<subseteq> ipset_from_cidr base2 m2
        then
          Some (base1, m1)
        else
          Some (base2, m2)
       )"
 
   text\<open>Intersecting with an address with prefix length zero always yields a non-empty result.\<close>
   lemma ipcidr_conjunct_any: "ipcidr_conjunct a (x,0) \<noteq> None" "ipcidr_conjunct (y,0) b \<noteq> None"
      apply(cases a, simp add: ipset_from_cidr_0 ipset_from_cidr_not_empty)
     by(cases b, simp add: ipset_from_cidr_0 ipset_from_cidr_not_empty)
 
   lemma ipcidr_conjunct_correct: "(case ipcidr_conjunct (b1, m1) (b2, m2)
                                           of Some (bx, mx) \<Rightarrow> ipset_from_cidr bx mx
                                           |  None \<Rightarrow> {}) =
                                    (ipset_from_cidr b1 m1) \<inter> (ipset_from_cidr b2 m2)"
     apply(simp split: if_split_asm)
     using ip_cidr_intersect by fast
   declare ipcidr_conjunct.simps[simp del]
 
 
 subsection\<open>Code Equations\<close>
   text\<open>Executable definition using word intervals\<close>
   lemma ipcidr_conjunct_word[code_unfold]:
   "ipcidr_conjunct ips1 ips2 = (
      if
       wordinterval_empty (wordinterval_intersection
                             (ipcidr_tuple_to_wordinterval ips1) (ipcidr_tuple_to_wordinterval ips2))
      then
        None
      else if
        wordinterval_subset (ipcidr_tuple_to_wordinterval ips1) (ipcidr_tuple_to_wordinterval ips2)
      then
        Some ips1
      else
        Some ips2
      )"
   apply(simp)
   apply(cases ips1, cases ips2, rename_tac b1 m1 b2 m2, simp)
   apply(auto simp add: wordinterval_to_set_ipcidr_tuple_to_wordinterval ipcidr_conjunct.simps
              split: if_split_asm)
   done
 
   (*with the code_unfold lemma before, this works!*)
   lemma "ipcidr_conjunct (0::32 word,0) (8,1) = Some (8, 1)" by eval
   export_code ipcidr_conjunct checking SML
 
   text\<open>making element check executable\<close>
   lemma addr_in_ipset_from_netmask_code[code_unfold]:
     "addr \<in> (ipset_from_netmask base netmask) \<longleftrightarrow>
       (base AND netmask) \<le> addr \<and> addr \<le> (base AND netmask) OR (NOT netmask)"
     by(simp add: ipset_from_netmask_def Let_def)
   lemma addr_in_ipset_from_cidr_code[code_unfold]:
     "(addr::'i::len word) \<in> (ipset_from_cidr pre len) \<longleftrightarrow>
        (pre AND ((mask len) << (LENGTH('i) - len))) \<le> addr \<and>
         addr \<le> pre OR (mask (LENGTH('i) - len))"
   unfolding ipset_from_cidr_alt by simp
 
 
 end
diff --git a/thys/IP_Addresses/IPv6.thy b/thys/IP_Addresses/IPv6.thy
--- a/thys/IP_Addresses/IPv6.thy
+++ b/thys/IP_Addresses/IPv6.thy
@@ -1,953 +1,953 @@
 (*  Title:      IPv6.thy
     Authors:    Cornelius Diekmann
 *)
 theory IPv6
 imports IP_Address
         NumberWang_IPv6
         (* include "HOL-Library.Code_Target_Nat" if you need to work with actual numbers.*)
 begin
 
 
 section \<open>IPv6 Addresses\<close>
   text\<open>An IPv6 address is basically a 128 bit unsigned integer. RFC 4291, Section 2.\<close>
   type_synonym ipv6addr = "128 word"
  
   text\<open>Conversion between natural numbers and IPv6 adresses\<close>
   definition nat_of_ipv6addr :: "ipv6addr \<Rightarrow> nat" where
     "nat_of_ipv6addr a = unat a"
   definition ipv6addr_of_nat :: "nat \<Rightarrow> ipv6addr" where
     "ipv6addr_of_nat n =  of_nat n"
 
   lemma "ipv6addr_of_nat n = word_of_int (int n)"
     by(simp add: ipv6addr_of_nat_def word_of_nat)
 
   text\<open>The maximum IPv6 address\<close>
   definition max_ipv6_addr :: "ipv6addr" where 
     "max_ipv6_addr \<equiv> ipv6addr_of_nat ((2^128) - 1)"
 
   lemma max_ipv6_addr_number: "max_ipv6_addr = 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF"
     unfolding max_ipv6_addr_def ipv6addr_of_nat_def by(simp)
   lemma "max_ipv6_addr = 340282366920938463463374607431768211455"
     by(fact max_ipv6_addr_number)
   lemma max_ipv6_addr_max_word: "max_ipv6_addr = max_word"
     by(simp add: max_ipv6_addr_number max_word_def)
   lemma max_ipv6_addr_max: "\<forall>a. a \<le> max_ipv6_addr"
     by(simp add: max_ipv6_addr_max_word)
   lemma UNIV_ipv6addrset: "UNIV = {0 .. max_ipv6_addr}" (*not in the simp set, for a reason*)
     by(simp add: max_ipv6_addr_max_word) fastforce
 
   text\<open>identity functions\<close>
   lemma nat_of_ipv6addr_ipv6addr_of_nat:
     "n \<le> nat_of_ipv6addr max_ipv6_addr \<Longrightarrow> nat_of_ipv6addr (ipv6addr_of_nat n) = n"
     by(simp add: nat_of_ipv6addr_def ipv6addr_of_nat_def le_unat_uoi)
   lemma nat_of_ipv6addr_ipv6addr_of_nat_mod: "nat_of_ipv6addr (ipv6addr_of_nat n) = n mod 2^128"
     by(simp add: ipv6addr_of_nat_def nat_of_ipv6addr_def unat_of_nat)
   lemma ipv6addr_of_nat_nat_of_ipv6addr: "ipv6addr_of_nat (nat_of_ipv6addr addr) = addr"
     by(simp add: ipv6addr_of_nat_def nat_of_ipv6addr_def)
 
 subsection\<open>Syntax of IPv6 Adresses\<close>
   text\<open>RFC 4291, Section 2.2.: Text Representation of Addresses\<close>
 
   text\<open>Quoting the RFC (note: errata exists):\<close>
   text_raw\<open>
   \begin{verbatim}
    1. The preferred form is x:x:x:x:x:x:x:x, where the 'x's are one to
       four hexadecimal digits of the eight 16-bit pieces of the address.
       Examples:
          ABCD:EF01:2345:6789:ABCD:EF01:2345:6789
          2001:DB8:0:0:8:800:200C:417A
   \end{verbatim}
 \<close>
   datatype ipv6addr_syntax = 
     IPv6AddrPreferred "16 word" "16 word" "16 word" "16 word" "16 word" "16 word" "16 word" "16 word"
 
   text_raw\<open>
   \begin{verbatim}
    2. [...] In order to make writing addresses containing zero
       bits easier, a special syntax is available to compress the zeros.
       The use of "::" indicates one or more groups of 16 bits of zeros.
       The "::" can only appear once in an address.  The "::" can also be
       used to compress leading or trailing zeros in an address.
 
       For example, the following addresses
          2001:DB8:0:0:8:800:200C:417A   a unicast address
          FF01:0:0:0:0:0:0:101           a multicast address
          0:0:0:0:0:0:0:1                the loopback address
          0:0:0:0:0:0:0:0                the unspecified address
 
       may be represented as
          2001:DB8::8:800:200C:417A      a unicast address
          FF01::101                      a multicast address
          ::1                            the loopback address
          ::                             the unspecified address
   \end{verbatim}
 \<close>
   (*datatype may take some minutes to load*)
   datatype ipv6addr_syntax_compressed =
   \<comment> \<open>using @{typ unit} for the omission @{text "::"}. 
 
      Naming convention of the datatype: 
       The first number is the position where the omission occurs.
       The second number is the length of the specified address pieces.
         I.e. `8 minus the second number' pieces are omitted.\<close>
     IPv6AddrCompressed1_0 unit
   | IPv6AddrCompressed1_1 unit "16 word"
   | IPv6AddrCompressed1_2 unit "16 word" "16 word"
   | IPv6AddrCompressed1_3 unit "16 word" "16 word" "16 word"
   | IPv6AddrCompressed1_4 unit "16 word" "16 word" "16 word" "16 word" 
   | IPv6AddrCompressed1_5 unit "16 word" "16 word" "16 word" "16 word" "16 word"
   | IPv6AddrCompressed1_6 unit "16 word" "16 word" "16 word" "16 word" "16 word" "16 word"
   | IPv6AddrCompressed1_7 unit "16 word" "16 word" "16 word" "16 word" "16 word" "16 word" "16 word"
 
   | IPv6AddrCompressed2_1 "16 word" unit
   | IPv6AddrCompressed2_2 "16 word" unit "16 word"
   | IPv6AddrCompressed2_3 "16 word" unit "16 word" "16 word"
   | IPv6AddrCompressed2_4 "16 word" unit "16 word" "16 word" "16 word"
   | IPv6AddrCompressed2_5 "16 word" unit "16 word" "16 word" "16 word" "16 word"
   | IPv6AddrCompressed2_6 "16 word" unit "16 word" "16 word" "16 word" "16 word" "16 word"
   | IPv6AddrCompressed2_7 "16 word" unit "16 word" "16 word" "16 word" "16 word" "16 word" "16 word"
 
   | IPv6AddrCompressed3_2 "16 word" "16 word" unit
   | IPv6AddrCompressed3_3 "16 word" "16 word" unit "16 word"
   | IPv6AddrCompressed3_4 "16 word" "16 word" unit "16 word" "16 word"
   | IPv6AddrCompressed3_5 "16 word" "16 word" unit "16 word" "16 word" "16 word"
   | IPv6AddrCompressed3_6 "16 word" "16 word" unit "16 word" "16 word" "16 word" "16 word"
   | IPv6AddrCompressed3_7 "16 word" "16 word" unit "16 word" "16 word" "16 word" "16 word" "16 word"
 
   | IPv6AddrCompressed4_3 "16 word" "16 word" "16 word" unit
   | IPv6AddrCompressed4_4 "16 word" "16 word" "16 word" unit "16 word"
   | IPv6AddrCompressed4_5 "16 word" "16 word" "16 word" unit "16 word" "16 word"
   | IPv6AddrCompressed4_6 "16 word" "16 word" "16 word" unit "16 word" "16 word" "16 word"
   | IPv6AddrCompressed4_7 "16 word" "16 word" "16 word" unit "16 word" "16 word" "16 word" "16 word"
 
   | IPv6AddrCompressed5_4 "16 word" "16 word" "16 word" "16 word" unit
   | IPv6AddrCompressed5_5 "16 word" "16 word" "16 word" "16 word" unit "16 word"
   | IPv6AddrCompressed5_6 "16 word" "16 word" "16 word" "16 word" unit "16 word" "16 word"
   | IPv6AddrCompressed5_7 "16 word" "16 word" "16 word" "16 word" unit "16 word" "16 word" "16 word"
 
   | IPv6AddrCompressed6_5 "16 word" "16 word" "16 word" "16 word" "16 word" unit
   | IPv6AddrCompressed6_6 "16 word" "16 word" "16 word" "16 word" "16 word" unit "16 word"
   | IPv6AddrCompressed6_7 "16 word" "16 word" "16 word" "16 word" "16 word" unit "16 word" "16 word"
 
   | IPv6AddrCompressed7_6 "16 word" "16 word" "16 word" "16 word" "16 word" "16 word" unit
   | IPv6AddrCompressed7_7 "16 word" "16 word" "16 word" "16 word" "16 word" "16 word" unit "16 word"
 
   | IPv6AddrCompressed8_7 "16 word" "16 word" "16 word" "16 word" "16 word" "16 word" "16 word" unit
 
   (*RFC 5952:
     """
     4.  A Recommendation for IPv6 Text Representation
     4.2.2.  Handling One 16-Bit 0 Field
        The symbol "::" MUST NOT be used to shorten just one 16-bit 0 field.
        For example, the representation 2001:db8:0:1:1:1:1:1 is correct, but
        2001:db8::1:1:1:1:1 is not correct.
     """
 
     So we could remove all IPv6AddrCompressed*_7 constructors.
     But these are `recommendations', we might still see these non-recommended definitions.
     "[...] all implementations must accept and be able to handle any legitimate RFC 4291 format."
   *)
 
   (*More convenient parser helper function for compressed IPv6 addresses:
     Input list (from parser):
       Some 16word \<longrightarrow> address piece
       None \<longrightarrow> omission '::'
     
   
    Basically, the parser must only do the following (python syntax):
      split the string which is an ipv6 address at ':'
      map empty string to None
      map everything else to Some (string_to_16word str)
      sanitize empty strings at the start and the end (see toString and parser theories)
    Example:
      "1:2:3".split(":")  = ['1', '2', '3']
      ":2:3:4".split(":") = ['', '2', '3', '4']
      ":2::3".split(":")  = ['', '2', '', '3']
      "1:2:3:".split(":") = ['1', '2', '3', '']
   *)
   definition parse_ipv6_address_compressed :: "((16 word) option) list \<Rightarrow> ipv6addr_syntax_compressed option" where
     "parse_ipv6_address_compressed as = (case as of 
       [None] \<Rightarrow> Some (IPv6AddrCompressed1_0 ())
     | [None, Some a] \<Rightarrow> Some (IPv6AddrCompressed1_1 () a)
     | [None, Some a, Some b] \<Rightarrow> Some (IPv6AddrCompressed1_2 () a b)
     | [None, Some a, Some b, Some c] \<Rightarrow> Some (IPv6AddrCompressed1_3 () a b c)
     | [None, Some a, Some b, Some c, Some d] \<Rightarrow> Some (IPv6AddrCompressed1_4 () a b c d)
     | [None, Some a, Some b, Some c, Some d, Some e] \<Rightarrow> Some (IPv6AddrCompressed1_5 () a b c d e)
     | [None, Some a, Some b, Some c, Some d, Some e, Some f] \<Rightarrow> Some (IPv6AddrCompressed1_6 () a b c d e f)
     | [None, Some a, Some b, Some c, Some d, Some e, Some f, Some g] \<Rightarrow> Some (IPv6AddrCompressed1_7 () a b c d e f g)
   
     | [Some a, None] \<Rightarrow> Some (IPv6AddrCompressed2_1 a ())
     | [Some a, None, Some b] \<Rightarrow> Some (IPv6AddrCompressed2_2 a () b)
     | [Some a, None, Some b, Some c] \<Rightarrow> Some (IPv6AddrCompressed2_3 a () b c)
     | [Some a, None, Some b, Some c, Some d] \<Rightarrow> Some (IPv6AddrCompressed2_4 a () b c d)
     | [Some a, None, Some b, Some c, Some d, Some e] \<Rightarrow> Some (IPv6AddrCompressed2_5 a () b c d e)
     | [Some a, None, Some b, Some c, Some d, Some e, Some f] \<Rightarrow> Some (IPv6AddrCompressed2_6 a () b c d e f)
     | [Some a, None, Some b, Some c, Some d, Some e, Some f, Some g] \<Rightarrow> Some (IPv6AddrCompressed2_7 a () b c d e f g)
   
     | [Some a, Some b, None] \<Rightarrow> Some (IPv6AddrCompressed3_2 a b ())
     | [Some a, Some b, None, Some c] \<Rightarrow> Some (IPv6AddrCompressed3_3 a b () c)
     | [Some a, Some b, None, Some c, Some d] \<Rightarrow> Some (IPv6AddrCompressed3_4 a b () c d)
     | [Some a, Some b, None, Some c, Some d, Some e] \<Rightarrow> Some (IPv6AddrCompressed3_5 a b () c d e)
     | [Some a, Some b, None, Some c, Some d, Some e, Some f] \<Rightarrow> Some (IPv6AddrCompressed3_6 a b () c d e f)
     | [Some a, Some b, None, Some c, Some d, Some e, Some f, Some g] \<Rightarrow> Some (IPv6AddrCompressed3_7 a b () c d e f g)
   
     | [Some a, Some b, Some c, None] \<Rightarrow> Some (IPv6AddrCompressed4_3 a b c ())
     | [Some a, Some b, Some c, None, Some d] \<Rightarrow> Some (IPv6AddrCompressed4_4 a b c () d)
     | [Some a, Some b, Some c, None, Some d, Some e] \<Rightarrow> Some (IPv6AddrCompressed4_5 a b c () d e)
     | [Some a, Some b, Some c, None, Some d, Some e, Some f] \<Rightarrow> Some (IPv6AddrCompressed4_6 a b c () d e f)
     | [Some a, Some b, Some c, None, Some d, Some e, Some f, Some g] \<Rightarrow> Some (IPv6AddrCompressed4_7 a b c () d e f g)
   
     | [Some a, Some b, Some c, Some d, None] \<Rightarrow> Some (IPv6AddrCompressed5_4 a b c d ())
     | [Some a, Some b, Some c, Some d, None, Some e] \<Rightarrow> Some (IPv6AddrCompressed5_5 a b c d () e)
     | [Some a, Some b, Some c, Some d, None, Some e, Some f] \<Rightarrow> Some (IPv6AddrCompressed5_6 a b c d () e f)
     | [Some a, Some b, Some c, Some d, None, Some e, Some f, Some g] \<Rightarrow> Some (IPv6AddrCompressed5_7 a b c d () e f g)
   
     | [Some a, Some b, Some c, Some d, Some e, None] \<Rightarrow> Some (IPv6AddrCompressed6_5 a b c d e ())
     | [Some a, Some b, Some c, Some d, Some e, None, Some f] \<Rightarrow> Some (IPv6AddrCompressed6_6 a b c d e () f)
     | [Some a, Some b, Some c, Some d, Some e, None, Some f, Some g] \<Rightarrow> Some (IPv6AddrCompressed6_7 a b c d e () f g)
   
     | [Some a, Some b, Some c, Some d, Some e, Some f, None] \<Rightarrow> Some (IPv6AddrCompressed7_6 a b c d e f ())
     | [Some a, Some b, Some c, Some d, Some e, Some f, None, Some g] \<Rightarrow> Some (IPv6AddrCompressed7_7 a b c d e f () g)
 
     | [Some a, Some b, Some c, Some d, Some e, Some f, Some g, None] \<Rightarrow> Some (IPv6AddrCompressed8_7 a b c d e f g ())
     | _ \<Rightarrow> None \<comment> \<open>invalid ipv6 copressed address.\<close>
 )"
 
   fun ipv6addr_syntax_compressed_to_list :: "ipv6addr_syntax_compressed \<Rightarrow> ((16 word) option) list"
     where 
       "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed1_0 _) =
                                      [None]"
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed1_1 () a) =
                                      [None, Some a]"
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed1_2 () a b) =
                                      [None, Some a, Some b]"
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed1_3 () a b c) =
                                      [None, Some a, Some b, Some c]"
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed1_4 () a b c d) =
                                      [None, Some a, Some b, Some c, Some d]"
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed1_5 () a b c d e) =
                                      [None, Some a, Some b, Some c, Some d, Some e]"
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed1_6 () a b c d e f) =
                                      [None, Some a, Some b, Some c, Some d, Some e, Some f]"
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed1_7 () a b c d e f g) =
                                      [None, Some a, Some b, Some c, Some d, Some e, Some f, Some g]"
   
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed2_1 a ()) =
                                      [Some a, None]"
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed2_2 a () b) =
                                      [Some a, None, Some b]"
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed2_3 a () b c) =
                                      [Some a, None, Some b, Some c]"
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed2_4 a () b c d) =
                                      [Some a, None, Some b, Some c, Some d]"
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed2_5 a () b c d e) =
                                      [Some a, None, Some b, Some c, Some d, Some e]"
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed2_6 a () b c d e f) =
                                      [Some a, None, Some b, Some c, Some d, Some e, Some f]"
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed2_7 a () b c d e f g) =
                                      [Some a, None, Some b, Some c, Some d, Some e, Some f, Some g]"
   
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed3_2 a b ()) = [Some a, Some b, None]"
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed3_3 a b () c) =
                                      [Some a, Some b, None, Some c]"
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed3_4 a b () c d) =
                                      [Some a, Some b, None, Some c, Some d]"
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed3_5 a b () c d e) =
                                      [Some a, Some b, None, Some c, Some d, Some e]"
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed3_6 a b () c d e f) =
                                      [Some a, Some b, None, Some c, Some d, Some e, Some f]"
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed3_7 a b () c d e f g) =
                                      [Some a, Some b, None, Some c, Some d, Some e, Some f, Some g]"
   
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed4_3 a b c ()) =
                                      [Some a, Some b, Some c, None]"
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed4_4 a b c () d) =
                                      [Some a, Some b, Some c, None, Some d]"
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed4_5 a b c () d e) =
                                      [Some a, Some b, Some c, None, Some d, Some e]"
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed4_6 a b c () d e f) =
                                      [Some a, Some b, Some c, None, Some d, Some e, Some f]"
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed4_7 a b c () d e f g) =
                                      [Some a, Some b, Some c, None, Some d, Some e, Some f, Some g]"
   
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed5_4 a b c d ()) =
                                      [Some a, Some b, Some c, Some d, None]"
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed5_5 a b c d () e) =
                                      [Some a, Some b, Some c, Some d, None, Some e]"
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed5_6 a b c d () e f) =
                                      [Some a, Some b, Some c, Some d, None, Some e, Some f]"
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed5_7 a b c d () e f g) =
                                      [Some a, Some b, Some c, Some d, None, Some e, Some f, Some g]"
   
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed6_5 a b c d e ()) =
                                      [Some a, Some b, Some c, Some d, Some e, None]"
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed6_6 a b c d e () f) =
                                      [Some a, Some b, Some c, Some d, Some e, None, Some f]"
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed6_7 a b c d e () f g) =
                                      [Some a, Some b, Some c, Some d, Some e, None, Some f, Some g]"
   
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed7_6 a b c d e f ()) =
                                      [Some a, Some b, Some c, Some d, Some e, Some f, None]"
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed7_7 a b c d e f () g) =
                                      [Some a, Some b, Some c, Some d, Some e, Some f, None, Some g]"
 
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed8_7 a b c d e f g ()) =
                                      [Some a, Some b, Some c, Some d, Some e, Some f, Some g, None]"
 
 
 (*for all ipv6_syntax, there is a corresponding list representation*)
 lemma parse_ipv6_address_compressed_exists:
   obtains ss where "parse_ipv6_address_compressed ss = Some ipv6_syntax"
 proof
   define ss where "ss = ipv6addr_syntax_compressed_to_list ipv6_syntax"
   thus "parse_ipv6_address_compressed ss = Some ipv6_syntax"
     by (cases ipv6_syntax; simp add: parse_ipv6_address_compressed_def)
 qed
 
 lemma parse_ipv6_address_compressed_identity:
       "parse_ipv6_address_compressed (ipv6addr_syntax_compressed_to_list (ipv6_syntax)) = Some ipv6_syntax"
   by(cases ipv6_syntax; simp add: parse_ipv6_address_compressed_def)
 
 
 lemma parse_ipv6_address_compressed_someE:
   assumes "parse_ipv6_address_compressed as = Some ipv6"
   obtains
     "as = [None]" "ipv6 = (IPv6AddrCompressed1_0 ())"  |
     a where "as = [None, Some a]" "ipv6 = (IPv6AddrCompressed1_1 () a)"  |
     a b where "as = [None, Some a, Some b]" "ipv6 = (IPv6AddrCompressed1_2 () a b)"  |
     a b c where "as = [None, Some a, Some b, Some c]" "ipv6 = (IPv6AddrCompressed1_3 () a b c)" |
     a b c d where "as = [None, Some a, Some b, Some c, Some d]" "ipv6 = (IPv6AddrCompressed1_4 () a b c d)" |
     a b c d e where "as = [None, Some a, Some b, Some c, Some d, Some e]" "ipv6 = (IPv6AddrCompressed1_5 () a b c d e)" |
     a b c d e f where "as = [None, Some a, Some b, Some c, Some d, Some e, Some f]" "ipv6 = (IPv6AddrCompressed1_6 () a b c d e f)" |
     a b c d e f g where "as = [None, Some a, Some b, Some c, Some d, Some e, Some f, Some g]" "ipv6 = (IPv6AddrCompressed1_7 () a b c d e f g)" |
   
     a where "as = [Some a, None]" "ipv6 = (IPv6AddrCompressed2_1 a ())" |
     a b where "as = [Some a, None, Some b]" "ipv6 = (IPv6AddrCompressed2_2 a () b)" |
     a b c where "as = [Some a, None, Some b, Some c]" "ipv6 = (IPv6AddrCompressed2_3 a () b c)" |
     a b c d where "as = [Some a, None, Some b, Some c, Some d]" "ipv6 = (IPv6AddrCompressed2_4 a () b c d)" |
     a b c d e where "as = [Some a, None, Some b, Some c, Some d, Some e]" "ipv6 = (IPv6AddrCompressed2_5 a () b c d e)" |
     a b c d e f where "as = [Some a, None, Some b, Some c, Some d, Some e, Some f]" "ipv6 = (IPv6AddrCompressed2_6 a () b c d e f)" |
     a b c d e f g where "as = [Some a, None, Some b, Some c, Some d, Some e, Some f, Some g]" "ipv6 = (IPv6AddrCompressed2_7 a () b c d e f g)" |
   
     a b where "as = [Some a, Some b, None]" "ipv6 = (IPv6AddrCompressed3_2 a b ())" |
     a b c where "as = [Some a, Some b, None, Some c]" "ipv6 = (IPv6AddrCompressed3_3 a b () c)" |
     a b c d where "as = [Some a, Some b, None, Some c, Some d]" "ipv6 = (IPv6AddrCompressed3_4 a b () c d)" |
     a b c d e where "as = [Some a, Some b, None, Some c, Some d, Some e]" "ipv6 = (IPv6AddrCompressed3_5 a b () c d e)" |
     a b c d e f where "as = [Some a, Some b, None, Some c, Some d, Some e, Some f]" "ipv6 = (IPv6AddrCompressed3_6 a b () c d e f)" |
     a b c d e f g where "as = [Some a, Some b, None, Some c, Some d, Some e, Some f, Some g]" "ipv6 = (IPv6AddrCompressed3_7 a b () c d e f g)" |
   
     a b c where "as = [Some a, Some b, Some c, None]" "ipv6 = (IPv6AddrCompressed4_3 a b c ())" |
     a b c d where "as = [Some a, Some b, Some c, None, Some d]" "ipv6 = (IPv6AddrCompressed4_4 a b c () d)" |
     a b c d e where "as = [Some a, Some b, Some c, None, Some d, Some e]" "ipv6 = (IPv6AddrCompressed4_5 a b c () d e)" |
     a b c d e f where "as = [Some a, Some b, Some c, None, Some d, Some e, Some f]" "ipv6 = (IPv6AddrCompressed4_6 a b c () d e f)" |
     a b c d e f g where "as = [Some a, Some b, Some c, None, Some d, Some e, Some f, Some g]" "ipv6 = (IPv6AddrCompressed4_7 a b c () d e f g)" |
   
     a b c d where "as = [Some a, Some b, Some c, Some d, None]" "ipv6 = (IPv6AddrCompressed5_4 a b c d ())" |
     a b c d e where "as = [Some a, Some b, Some c, Some d, None, Some e]" "ipv6 = (IPv6AddrCompressed5_5 a b c d () e)" |
     a b c d e f where "as = [Some a, Some b, Some c, Some d, None, Some e, Some f]" "ipv6 = (IPv6AddrCompressed5_6 a b c d () e f)" |
     a b c d e f g where "as = [Some a, Some b, Some c, Some d, None, Some e, Some f, Some g]" "ipv6 = (IPv6AddrCompressed5_7 a b c d () e f g)" |
   
     a b c d e where "as = [Some a, Some b, Some c, Some d, Some e, None]" "ipv6 = (IPv6AddrCompressed6_5 a b c d e ())" |
     a b c d e f where "as = [Some a, Some b, Some c, Some d, Some e, None, Some f]" "ipv6 = (IPv6AddrCompressed6_6 a b c d e () f)" |
     a b c d e f g where "as = [Some a, Some b, Some c, Some d, Some e, None, Some f, Some g]" "ipv6 = (IPv6AddrCompressed6_7 a b c d e () f g)" |
   
     a b c d e f where "as = [Some a, Some b, Some c, Some d, Some e, Some f, None]" "ipv6 = (IPv6AddrCompressed7_6 a b c d e f ())" |
     a b c d e f g where "as = [Some a, Some b, Some c, Some d, Some e, Some f, None, Some g]" "ipv6 = (IPv6AddrCompressed7_7 a b c d e f () g)" |
 
     a b c d e f g where "as = [Some a, Some b, Some c, Some d, Some e, Some f, Some g, None]" "ipv6 = (IPv6AddrCompressed8_7 a b c d e f g ())"
 using assms
 unfolding parse_ipv6_address_compressed_def
 by (auto split: list.split_asm option.split_asm) (* takes a minute *)
 
 lemma parse_ipv6_address_compressed_identity2:
       "ipv6addr_syntax_compressed_to_list ipv6_syntax = ls \<longleftrightarrow>
         (parse_ipv6_address_compressed ls) = Some ipv6_syntax"
       (is "?lhs = ?rhs")
 proof
   assume ?rhs
   thus ?lhs
     by (auto elim: parse_ipv6_address_compressed_someE)
 next
   assume ?lhs
   thus ?rhs
     by (cases ipv6_syntax) (auto simp: parse_ipv6_address_compressed_def)
 qed
 
 text\<open>Valid IPv6 compressed notation:
   \<^item> at most one omission
   \<^item> at most 7 pieces
 \<close>
 lemma RFC_4291_format: "parse_ipv6_address_compressed as \<noteq> None \<longleftrightarrow>
        length (filter (\<lambda>p. p = None) as) = 1 \<and> length (filter (\<lambda>p. p \<noteq> None) as) \<le> 7"
        (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then obtain addr where "parse_ipv6_address_compressed as = Some addr"
     by blast
   thus ?rhs
     by (elim parse_ipv6_address_compressed_someE; simp)
 next
   assume ?rhs
   thus ?lhs
     unfolding parse_ipv6_address_compressed_def
     by (auto split: option.split list.split if_split_asm)
 qed
 
   text_raw\<open>
   \begin{verbatim}
   3. An alternative form that is sometimes more convenient when dealing
       with a mixed environment of IPv4 and IPv6 nodes is
       x:x:x:x:x:x:d.d.d.d, where the 'x's are the hexadecimal values of
       the six high-order 16-bit pieces of the address, and the 'd's are
       the decimal values of the four low-order 8-bit pieces of the
       address (standard IPv4 representation).  Examples:
 
          0:0:0:0:0:0:13.1.68.3
          0:0:0:0:0:FFFF:129.144.52.38
 
       or in compressed form:
 
          ::13.1.68.3
          ::FFFF:129.144.52.38
   \end{verbatim}
 
   This is currently not supported by our library!
 \<close>
   (*TODO*)
   (*TODO: oh boy, they can also be compressed*)
 
 subsection\<open>Semantics\<close>
   fun ipv6preferred_to_int :: "ipv6addr_syntax \<Rightarrow> ipv6addr" where
     "ipv6preferred_to_int (IPv6AddrPreferred a b c d e f g h) = (ucast a << (16 * 7)) OR
                                                                 (ucast b << (16 * 6)) OR
                                                                 (ucast c << (16 * 5)) OR
                                                                 (ucast d << (16 * 4)) OR
                                                                 (ucast e << (16 * 3)) OR
                                                                 (ucast f << (16 * 2)) OR
                                                                 (ucast g << (16 * 1)) OR
                                                                 (ucast h << (16 * 0))"
 
   lemma "ipv6preferred_to_int (IPv6AddrPreferred 0x2001 0xDB8 0x0 0x0 0x8 0x800 0x200C 0x417A) = 
           42540766411282592856906245548098208122" by eval
 
   lemma "ipv6preferred_to_int (IPv6AddrPreferred 0xFF01 0x0 0x0 0x0 0x0 0x0 0x0 0x101) = 
           338958331222012082418099330867817087233" by eval
 
   declare ipv6preferred_to_int.simps[simp del]
 
 
   definition int_to_ipv6preferred :: "ipv6addr \<Rightarrow> ipv6addr_syntax" where
     "int_to_ipv6preferred i = IPv6AddrPreferred (ucast ((i AND 0xFFFF0000000000000000000000000000) >> 16*7))
                                                 (ucast ((i AND 0xFFFF000000000000000000000000) >> 16*6))
                                                 (ucast ((i AND 0xFFFF00000000000000000000) >> 16*5))
                                                 (ucast ((i AND 0xFFFF0000000000000000) >> 16*4))
                                                 (ucast ((i AND 0xFFFF000000000000) >> 16*3))
                                                 (ucast ((i AND 0xFFFF00000000) >> 16*2))
                                                 (ucast ((i AND 0xFFFF0000) >> 16*1))
                                                 (ucast ((i AND 0xFFFF)))"
 
   lemma "int_to_ipv6preferred 42540766411282592856906245548098208122 =
          IPv6AddrPreferred 0x2001 0xDB8 0x0 0x0 0x8 0x800 0x200C 0x417A" by eval
 
   lemma word128_masks_ipv6pieces:
     "(0xFFFF0000000000000000000000000000::ipv6addr) = (mask 16) << 112"
     "(0xFFFF000000000000000000000000::ipv6addr) = (mask 16) << 96"
     "(0xFFFF00000000000000000000::ipv6addr) = (mask 16) << 80"
     "(0xFFFF0000000000000000::ipv6addr) = (mask 16) << 64"
     "(0xFFFF000000000000::ipv6addr) = (mask 16) << 48"
     "(0xFFFF00000000::ipv6addr) = (mask 16) << 32"
     "(0xFFFF0000::ipv6addr) = (mask 16) << 16"
     "(0xFFFF::ipv6addr) = (mask 16)"
     by(simp add: mask_def)+
 
 
   text\<open>Correctness: round trip property one\<close>
   lemma ipv6preferred_to_int_int_to_ipv6preferred:
     "ipv6preferred_to_int (int_to_ipv6preferred ip) = ip"
   proof -
     have and_mask_shift_helper: "w AND (mask m << n) >> n << n = w AND (mask m << n)"
       for m n::nat and w::ipv6addr
      proof - (*sledgehammered for 128 word and concrete values for m and n*)
        have f1: "\<And>w wa wb. ((w::'a::len word) && wa) && wb = w && wb && wa"
          by (simp add: word_bool_alg.conj_left_commute word_bw_comms(1))
-       have "\<And>w n wa. ((w::'a::len word) && ~~ mask n) && (wa << n) = (w >> n) && wa << n"
+       have "\<And>w n wa. ((w::'a::len word) && ~~ (mask n)) && (wa << n) = (w >> n) && wa << n"
          by (simp add: and_not_mask shiftl_over_and_dist)
        then show ?thesis
         by (simp add: is_aligned_mask is_aligned_shiftr_shiftl word_bool_alg.conj.assoc)
         (*using f1 by (metis (no_types) and_not_mask word_and_mask_shiftl word_bw_comms(1))*)
      qed
     have ucast_ipv6_piece_rule:
       "length (dropWhile Not (to_bl w)) \<le> 16 \<Longrightarrow> (ucast::16 word \<Rightarrow> 128 word) ((ucast::128 word \<Rightarrow> 16 word) w) = w"
       for w::ipv6addr 
       by(rule ucast_short_ucast_long_ingoreLeadingZero) (simp_all)
     have ucast_ipv6_piece: "16 \<le> 128 - n \<Longrightarrow> 
       (ucast::16 word \<Rightarrow> 128 word) ((ucast::128 word \<Rightarrow> 16 word) (w AND (mask 16 << n) >> n)) << n = w AND (mask 16 << n)"
       for w::ipv6addr and n::nat
       apply(subst ucast_ipv6_piece_rule)
        apply(rule length_drop_mask_inner)
        apply(simp; fail)
       apply(subst and_mask_shift_helper)
       apply simp
       done
 
     have ucast16_ucast128_masks_highest_bits:
       "(ucast ((ucast::ipv6addr \<Rightarrow> 16 word) (ip AND 0xFFFF0000000000000000000000000000 >> 112)) << 112) = 
              (ip AND 0xFFFF0000000000000000000000000000)"
       "(ucast ((ucast::ipv6addr \<Rightarrow> 16 word) (ip AND 0xFFFF000000000000000000000000 >> 96)) << 96) =
            ip AND 0xFFFF000000000000000000000000"
       "(ucast ((ucast::ipv6addr \<Rightarrow> 16 word) (ip AND 0xFFFF00000000000000000000 >> 80)) << 80) =
            ip AND 0xFFFF00000000000000000000" 
       "(ucast ((ucast::ipv6addr \<Rightarrow> 16 word) (ip AND 0xFFFF0000000000000000 >> 64)) << 64) =
            ip AND 0xFFFF0000000000000000"
       "(ucast ((ucast::ipv6addr \<Rightarrow> 16 word) (ip AND 0xFFFF000000000000 >> 48)) << 48) =
            ip AND 0xFFFF000000000000"
       "(ucast ((ucast::ipv6addr \<Rightarrow> 16 word) (ip AND 0xFFFF00000000 >> 32)) << 32) =
            ip AND 0xFFFF00000000"
       "(ucast ((ucast::ipv6addr \<Rightarrow> 16 word) (ip AND 0xFFFF0000 >> 16)) << 16) =
            ip AND 0xFFFF0000"
       by((subst word128_masks_ipv6pieces)+, subst ucast_ipv6_piece, simp_all)+
 
     have ucast16_ucast128_masks_highest_bits0: 
       "(ucast ((ucast::ipv6addr \<Rightarrow> 16 word) (ip AND 0xFFFF))) = ip AND 0xFFFF"
       apply(subst word128_masks_ipv6pieces)+
       apply(subst ucast_short_ucast_long_ingoreLeadingZero)
         apply simp_all
       by (simp add: length_drop_mask)
 
     have mask_len_word:"n = (LENGTH('a)) \<Longrightarrow> w AND mask n = w"
       for n and w::"'a::len word" by (simp add: mask_eq_iff) 
 
     have ipv6addr_16word_pieces_compose_or:
             "ip && (mask 16 << 112) ||
              ip && (mask 16 << 96) ||
              ip && (mask 16 << 80) ||
              ip && (mask 16 << 64) ||
              ip && (mask 16 << 48) ||
              ip && (mask 16 << 32) ||
              ip && (mask 16 << 16) ||
              ip && mask 16 =
              ip"
       apply(subst word_ao_dist2[symmetric])+
       apply(simp add: mask_def)
       apply(subst mask128)
       apply(rule mask_len_word)
       apply simp
       done
 
     show ?thesis
       apply(simp add: ipv6preferred_to_int.simps int_to_ipv6preferred_def)
       apply(simp add: ucast16_ucast128_masks_highest_bits ucast16_ucast128_masks_highest_bits0)
       apply(simp add: word128_masks_ipv6pieces)
       apply(rule ipv6addr_16word_pieces_compose_or)
       done
   qed
 
 
   text\<open>Correctness: round trip property two\<close>
   lemma int_to_ipv6preferred_ipv6preferred_to_int: "int_to_ipv6preferred (ipv6preferred_to_int ip) = ip"
   proof -
     note ucast_shift_simps=helper_masked_ucast_generic helper_masked_ucast_reverse_generic
                            helper_masked_ucast_generic[where n=0, simplified]
                            helper_masked_ucast_equal_generic 
     note ucast_simps=helper_masked_ucast_reverse_generic[where m=0, simplified]
                      helper_masked_ucast_equal_generic[where n=0, simplified]
     show ?thesis
     apply(cases ip, rename_tac a b c d e f g h)
     apply(simp add: ipv6preferred_to_int.simps int_to_ipv6preferred_def)
     apply(simp add: word128_masks_ipv6pieces)
     apply(simp add: word_ao_dist ucast_shift_simps ucast_simps)
     done
   qed
 
 
 
 text\<open>compressed to preferred format\<close>
 fun ipv6addr_c2p :: "ipv6addr_syntax_compressed \<Rightarrow> ipv6addr_syntax" where
     "ipv6addr_c2p (IPv6AddrCompressed1_0 ()) = IPv6AddrPreferred 0 0 0 0 0 0 0 0"
   | "ipv6addr_c2p (IPv6AddrCompressed1_1 () h) = IPv6AddrPreferred 0 0 0 0 0 0 0 h"
   | "ipv6addr_c2p (IPv6AddrCompressed1_2 () g h) = IPv6AddrPreferred 0 0 0 0 0 0 g h"
   | "ipv6addr_c2p (IPv6AddrCompressed1_3 () f g h) = IPv6AddrPreferred 0 0 0 0 0 f g h"
   | "ipv6addr_c2p (IPv6AddrCompressed1_4 () e f g h) = IPv6AddrPreferred 0 0 0 0 e f g h"
   | "ipv6addr_c2p (IPv6AddrCompressed1_5 () d e f g h) = IPv6AddrPreferred 0 0 0 d e f g h"
   | "ipv6addr_c2p (IPv6AddrCompressed1_6 () c d e f g h) = IPv6AddrPreferred 0 0 c d e f g h"
   | "ipv6addr_c2p (IPv6AddrCompressed1_7 () b c d e f g h) = IPv6AddrPreferred 0 b c d e f g h"
 
   | "ipv6addr_c2p (IPv6AddrCompressed2_1 a ()) = IPv6AddrPreferred a 0 0 0 0 0 0 0"
   | "ipv6addr_c2p (IPv6AddrCompressed2_2 a () h) = IPv6AddrPreferred a 0 0 0 0 0 0 h"
   | "ipv6addr_c2p (IPv6AddrCompressed2_3 a () g h) = IPv6AddrPreferred a 0 0 0 0 0 g h"
   | "ipv6addr_c2p (IPv6AddrCompressed2_4 a () f g h) = IPv6AddrPreferred a 0 0 0 0 f g h"
   | "ipv6addr_c2p (IPv6AddrCompressed2_5 a () e f g h) = IPv6AddrPreferred a 0 0 0 e f g h"
   | "ipv6addr_c2p (IPv6AddrCompressed2_6 a () d e f g h) = IPv6AddrPreferred a 0 0 d e f g h"
   | "ipv6addr_c2p (IPv6AddrCompressed2_7 a () c d e f g h) = IPv6AddrPreferred a 0 c d e f g h"
 
   | "ipv6addr_c2p (IPv6AddrCompressed3_2 a b ()) = IPv6AddrPreferred a b 0 0 0 0 0 0"
   | "ipv6addr_c2p (IPv6AddrCompressed3_3 a b () h) = IPv6AddrPreferred a b 0 0 0 0 0 h"
   | "ipv6addr_c2p (IPv6AddrCompressed3_4 a b () g h) = IPv6AddrPreferred a b 0 0 0 0 g h"
   | "ipv6addr_c2p (IPv6AddrCompressed3_5 a b () f g h) = IPv6AddrPreferred a b 0 0 0 f g h"
   | "ipv6addr_c2p (IPv6AddrCompressed3_6 a b () e f g h) = IPv6AddrPreferred a b 0 0 e f g h"
   | "ipv6addr_c2p (IPv6AddrCompressed3_7 a b () d e f g h) = IPv6AddrPreferred a b 0 d e f g h"
 
   | "ipv6addr_c2p (IPv6AddrCompressed4_3 a b c ()) = IPv6AddrPreferred a b c 0 0 0 0 0"
   | "ipv6addr_c2p (IPv6AddrCompressed4_4 a b c () h) = IPv6AddrPreferred a b c 0 0 0 0 h"
   | "ipv6addr_c2p (IPv6AddrCompressed4_5 a b c () g h) = IPv6AddrPreferred a b c 0 0 0 g h"
   | "ipv6addr_c2p (IPv6AddrCompressed4_6 a b c () f g h) = IPv6AddrPreferred a b c 0 0 f g h"
   | "ipv6addr_c2p (IPv6AddrCompressed4_7 a b c () e f g h) = IPv6AddrPreferred a b c 0 e f g h"
 
   | "ipv6addr_c2p (IPv6AddrCompressed5_4 a b c d ()) = IPv6AddrPreferred a b c d 0 0 0 0"
   | "ipv6addr_c2p (IPv6AddrCompressed5_5 a b c d () h) = IPv6AddrPreferred a b c d 0 0 0 h"
   | "ipv6addr_c2p (IPv6AddrCompressed5_6 a b c d () g h) = IPv6AddrPreferred a b c d 0 0 g h"
   | "ipv6addr_c2p (IPv6AddrCompressed5_7 a b c d () f g h) = IPv6AddrPreferred a b c d 0 f g h"
 
   | "ipv6addr_c2p (IPv6AddrCompressed6_5 a b c d e ()) = IPv6AddrPreferred a b c d e 0 0 0"
   | "ipv6addr_c2p (IPv6AddrCompressed6_6 a b c d e () h) = IPv6AddrPreferred a b c d e 0 0 h"
   | "ipv6addr_c2p (IPv6AddrCompressed6_7 a b c d e () g h) = IPv6AddrPreferred a b c d e 0 g h"
 
   | "ipv6addr_c2p (IPv6AddrCompressed7_6 a b c d e f ()) = IPv6AddrPreferred a b c d e f 0 0"
   | "ipv6addr_c2p (IPv6AddrCompressed7_7 a b c d e f () h) = IPv6AddrPreferred a b c d e f 0 h"
 
   | "ipv6addr_c2p (IPv6AddrCompressed8_7 a b c d e f g ()) = IPv6AddrPreferred a b c d e f g 0"
 
 
 definition ipv6_unparsed_compressed_to_preferred :: "((16 word) option) list \<Rightarrow> ipv6addr_syntax option" where
   "ipv6_unparsed_compressed_to_preferred ls = (
     if
       length (filter (\<lambda>p. p = None) ls) \<noteq> 1 \<or> length (filter (\<lambda>p. p \<noteq> None) ls) > 7
     then
       None
     else
       let
         before_omission = map the (takeWhile (\<lambda>x. x \<noteq> None) ls);
         after_omission = map the (drop 1 (dropWhile (\<lambda>x. x \<noteq> None) ls));
         num_omissions = 8 - (length before_omission + length after_omission);
         expanded = before_omission @ (replicate num_omissions 0) @ after_omission
       in
         case expanded of [a,b,c,d,e,f,g,h] \<Rightarrow> Some (IPv6AddrPreferred a b c d e f g h)
                          | _               \<Rightarrow> None
       )"
 
   lemma "ipv6_unparsed_compressed_to_preferred
     [Some 0x2001, Some 0xDB8, None, Some 0x8, Some 0x800, Some 0x200C, Some 0x417A]
       = Some (IPv6AddrPreferred 0x2001 0xDB8 0 0 8 0x800 0x200C 0x417A)" by eval
 
   lemma "ipv6_unparsed_compressed_to_preferred [None] = Some (IPv6AddrPreferred 0 0 0 0 0 0 0 0)" by eval
 
   lemma "ipv6_unparsed_compressed_to_preferred [] = None" by eval
 
 
   lemma ipv6_unparsed_compressed_to_preferred_identity1:
    "ipv6_unparsed_compressed_to_preferred (ipv6addr_syntax_compressed_to_list ipv6compressed) = Some ipv6prferred
     \<longleftrightarrow> ipv6addr_c2p ipv6compressed = ipv6prferred"
   by(cases ipv6compressed) (simp_all add: ipv6_unparsed_compressed_to_preferred_def) (*1s*)
  
   lemma ipv6_unparsed_compressed_to_preferred_identity2: 
     "ipv6_unparsed_compressed_to_preferred ls = Some ipv6prferred
      \<longleftrightarrow> (\<exists>ipv6compressed. parse_ipv6_address_compressed ls = Some ipv6compressed \<and>
                            ipv6addr_c2p ipv6compressed = ipv6prferred)"
   apply(rule iffI)
    apply(subgoal_tac "parse_ipv6_address_compressed ls \<noteq> None")
     prefer 2
     apply(subst RFC_4291_format)
     apply(simp add: ipv6_unparsed_compressed_to_preferred_def split: if_split_asm; fail)
    apply(simp)
    apply(erule exE, rename_tac ipv6compressed)
    apply(rule_tac x="ipv6compressed" in exI)
    apply(simp)
    apply(subgoal_tac "(ipv6addr_syntax_compressed_to_list ipv6compressed = ls)")
     prefer 2
     using parse_ipv6_address_compressed_identity2 apply presburger
    using ipv6_unparsed_compressed_to_preferred_identity1 apply blast
   apply(erule exE, rename_tac ipv6compressed)
   apply(subgoal_tac "(ipv6addr_syntax_compressed_to_list ipv6compressed = ls)")
    prefer 2
    using parse_ipv6_address_compressed_identity2 apply presburger
   using ipv6_unparsed_compressed_to_preferred_identity1 apply blast
   done
   
 
 subsection\<open>IPv6 Pretty Printing (converting to compressed format)\<close>
 text_raw\<open>
 RFC5952:
 \begin{verbatim}
 4.  A Recommendation for IPv6 Text Representation
 
    A recommendation for a canonical text representation format of IPv6
    addresses is presented in this section.  The recommendation in this
    document is one that complies fully with [RFC4291], is implemented by
    various operating systems, and is human friendly.  The recommendation
    in this section SHOULD be followed by systems when generating an
    address to be represented as text, but all implementations MUST
    accept and be able to handle any legitimate [RFC4291] format.  It is
    advised that humans also follow these recommendations when spelling
    an address.
 
 4.1.  Handling Leading Zeros in a 16-Bit Field
 
    Leading zeros MUST be suppressed.  For example, 2001:0db8::0001 is
    not acceptable and must be represented as 2001:db8::1.  A single 16-
    bit 0000 field MUST be represented as 0.
 
 4.2.  "::" Usage
 
 4.2.1.  Shorten as Much as Possible
 
    The use of the symbol "::" MUST be used to its maximum capability.
    For example, 2001:db8:0:0:0:0:2:1 must be shortened to 2001:db8::2:1.
    Likewise, 2001:db8::0:1 is not acceptable, because the symbol "::"
    could have been used to produce a shorter representation 2001:db8::1.
 
 4.2.2.  Handling One 16-Bit 0 Field
 
    The symbol "::" MUST NOT be used to shorten just one 16-bit 0 field.
    For example, the representation 2001:db8:0:1:1:1:1:1 is correct, but
    2001:db8::1:1:1:1:1 is not correct.
 
 4.2.3.  Choice in Placement of "::"
 
    When there is an alternative choice in the placement of a "::", the
    longest run of consecutive 16-bit 0 fields MUST be shortened (i.e.,
    the sequence with three consecutive zero fields is shortened in 2001:
    0:0:1:0:0:0:1).  When the length of the consecutive 16-bit 0 fields
    are equal (i.e., 2001:db8:0:0:1:0:0:1), the first sequence of zero
    bits MUST be shortened.  For example, 2001:db8::1:0:0:1 is correct
    representation.
 
 4.3.  Lowercase
 
    The characters "a", "b", "c", "d", "e", and "f" in an IPv6 address
    MUST be represented in lowercase.
 \end{verbatim}
 \<close>
 text\<open>See @{file \<open>IP_Address_toString.thy\<close>} for examples and test cases.\<close>
 context
 begin
   private function goup_by_zeros :: "16 word list \<Rightarrow> 16 word list list" where
     "goup_by_zeros [] = []" |
     "goup_by_zeros (x#xs) = (
         if x = 0
         then takeWhile (\<lambda>x. x = 0) (x#xs) # (goup_by_zeros (dropWhile (\<lambda>x. x = 0) xs))
         else [x]#(goup_by_zeros xs))"
   by(pat_completeness, auto)
   
   termination goup_by_zeros
 	 apply(relation "measure (\<lambda>xs. length xs)")
 	   apply(simp_all)
 	 by (simp add: le_imp_less_Suc length_dropWhile_le)
 	
 	private lemma "goup_by_zeros [0,1,2,3,0,0,0,0,3,4,0,0,0,2,0,0,2,0,3,0] =
 	        [[0], [1], [2], [3], [0, 0, 0, 0], [3], [4], [0, 0, 0], [2], [0, 0], [2], [0], [3], [0]]"
 	by eval
 	
 	private lemma "concat (goup_by_zeros ls) = ls"
 	  by(induction ls rule:goup_by_zeros.induct) simp+
 	
 	private lemma "[] \<notin> set (goup_by_zeros ls)"
 	  by(induction ls rule:goup_by_zeros.induct) simp+
 	  
   private primrec List_replace1 :: "'a \<Rightarrow> 'a \<Rightarrow> 'a list \<Rightarrow> 'a list" where
     "List_replace1 _ _ [] = []" |
     "List_replace1 a b (x#xs) = (if a = x then b#xs else x#List_replace1 a b xs)"
     
 	private lemma "List_replace1 a a ls = ls"
 	  by(induction ls) simp_all
 	
 	private lemma "a \<notin> set ls \<Longrightarrow> List_replace1 a b ls = ls"
 	  by(induction ls) simp_all
 	
 	private lemma "a \<in> set ls \<Longrightarrow> b \<in> set (List_replace1 a b ls)"
 	  apply(induction ls)
 	   apply(simp)
 	  apply(simp)
 	  by blast
   
 	private fun List_explode :: "'a list list \<Rightarrow> ('a option) list" where
 	  "List_explode [] = []" |
 	  "List_explode ([]#xs) = None#List_explode xs" |
 	  "List_explode (xs1#xs2) = map Some xs1@List_explode xs2"
 	  
   private lemma "List_explode [[0::int], [2,3], [], [3,4]] = [Some 0, Some 2, Some 3, None, Some 3, Some 4]"
   by eval
 
   private lemma List_explode_def: 
     "List_explode xss = concat (map (\<lambda>xs. if xs = [] then [None] else map Some xs) xss)"
     by(induction xss rule: List_explode.induct) simp+
 	  
   private lemma List_explode_no_empty: "[] \<notin> set xss \<Longrightarrow> List_explode xss = map Some (concat xss)"
     by(induction xss rule: List_explode.induct) simp+
 
   private lemma List_explode_replace1: "[] \<notin> set xss \<Longrightarrow> foo \<in> set xss \<Longrightarrow>
           List_explode (List_replace1 foo [] xss) =
             map Some (concat (takeWhile (\<lambda>xs. xs \<noteq> foo) xss)) @ [None] @
               map Some (concat (tl (dropWhile (\<lambda>xs. xs \<noteq> foo) xss)))"
     apply(induction xss rule: List_explode.induct)
       apply(simp; fail)
      apply(simp; fail)
     apply(simp)
     apply safe
       apply(simp_all add: List_explode_no_empty)
     done
     
   fun ipv6_preferred_to_compressed :: "ipv6addr_syntax \<Rightarrow> ((16 word) option) list" where
   "ipv6_preferred_to_compressed (IPv6AddrPreferred a b c d e f g h) = (
     let lss = goup_by_zeros [a,b,c,d,e,f,g,h];
         max_zero_seq = foldr (\<lambda>xs. max (length xs)) lss 0;
         shortened = if max_zero_seq > 1 then List_replace1 (replicate max_zero_seq 0) [] lss else lss
     in
       List_explode shortened
     )"
   declare ipv6_preferred_to_compressed.simps[simp del]
 
   private lemma foldr_max_length: "foldr (\<lambda>xs. max (length xs)) lss n = fold max (map length lss) n"
     apply(subst List.foldr_fold)
      apply fastforce
     apply(induction lss arbitrary: n)
      apply(simp; fail)
     apply(simp)
     done
 
   private lemma List_explode_goup_by_zeros: "List_explode (goup_by_zeros xs) = map Some xs"
     apply(induction xs rule: goup_by_zeros.induct)
      apply(simp; fail)
     apply(simp)
     apply(safe)
      apply(simp)
     by (metis map_append takeWhile_dropWhile_id)
   
   private definition "max_zero_streak xs \<equiv> foldr (\<lambda>xs. max (length xs)) (goup_by_zeros xs) 0"    
 
   private lemma max_zero_streak_def2: "max_zero_streak xs = fold max (map length (goup_by_zeros xs)) 0"
     unfolding max_zero_streak_def
     by(simp add: foldr_max_length)
 
   private lemma ipv6_preferred_to_compressed_pull_out_if:
     "ipv6_preferred_to_compressed (IPv6AddrPreferred a b c d e f g h) = (
     if max_zero_streak [a,b,c,d,e,f,g,h] > 1 then
       List_explode (List_replace1 (replicate (max_zero_streak [a,b,c,d,e,f,g,h]) 0) [] (goup_by_zeros [a,b,c,d,e,f,g,h]))
     else
       map Some [a,b,c,d,e,f,g,h]
     )"
   by(simp add: ipv6_preferred_to_compressed.simps max_zero_streak_def List_explode_goup_by_zeros)
 
     
   private lemma "ipv6_preferred_to_compressed (IPv6AddrPreferred 0 0 0 0 0 0 0 0) = [None]" by eval
   private lemma "ipv6_preferred_to_compressed (IPv6AddrPreferred 0x2001 0xDB8 0 0 8 0x800 0x200C 0x417A) =
                 [Some 0x2001, Some 0xDB8, None,           Some 8, Some 0x800, Some 0x200C, Some 0x417A]" by eval
   private lemma "ipv6_preferred_to_compressed (IPv6AddrPreferred 0x2001 0xDB8 0 3 8 0x800 0x200C 0x417A) =
                 [Some 0x2001, Some 0xDB8, Some 0, Some 3, Some 8, Some 0x800, Some 0x200C, Some 0x417A]" by eval
 
   (*the output should even conform to RFC5952, ...*)
   lemma ipv6_preferred_to_compressed_RFC_4291_format:
     "ipv6_preferred_to_compressed ip = as \<Longrightarrow> 
           length (filter (\<lambda>p. p = None) as) = 0 \<and> length as = 8
           \<or>
           length (filter (\<lambda>p. p = None) as) = 1 \<and> length (filter (\<lambda>p. p \<noteq> None) as) \<le> 7"
   apply(cases ip)
   apply(simp add: ipv6_preferred_to_compressed_pull_out_if)
   apply(simp only: split: if_split_asm)
    subgoal for a b c d e f g h
    apply(rule disjI2)
    apply(case_tac "a=0",case_tac [!] "b=0",case_tac [!] "c=0",case_tac [!] "d=0",
          case_tac [!] "e=0",case_tac [!] "f=0",case_tac [!] "g=0",case_tac [!] "h=0")
    by(auto simp add: max_zero_streak_def) (*1min*)
   subgoal
   apply(rule disjI1)
   apply(simp)
   by force
   done
 
   \<comment> \<open>Idea for the following proof:\<close>
   private lemma "ipv6_preferred_to_compressed (IPv6AddrPreferred a b c d e f g h) = None#xs \<Longrightarrow>
       xs = map Some (dropWhile (\<lambda>x. x=0) [a,b,c,d,e,f,g,h])"
     apply(case_tac "a=0",case_tac [!] "b=0",case_tac [!] "c=0",case_tac [!] "d=0",
           case_tac [!] "e=0",case_tac [!] "f=0",case_tac [!] "g=0",case_tac [!] "h=0")
     by(simp_all add: ipv6_preferred_to_compressed_pull_out_if max_zero_streak_def) (*20s*)
 
 
  
   lemma ipv6_preferred_to_compressed:
     assumes "ipv6_unparsed_compressed_to_preferred (ipv6_preferred_to_compressed ip) = Some ip'"
     shows "ip = ip'"
   proof -
     from assms have 1: "\<exists>ipv6compressed.
          parse_ipv6_address_compressed (ipv6_preferred_to_compressed ip) = Some ipv6compressed \<and>
          ipv6addr_c2p ipv6compressed = ip'" using ipv6_unparsed_compressed_to_preferred_identity2 by simp
   
     obtain a b c d e f g h where ip: "ip = IPv6AddrPreferred a b c d e f g h" by(cases ip)
   
     have ipv6_preferred_to_compressed_None1:
       "ipv6_preferred_to_compressed (IPv6AddrPreferred a b c d e f g h) = None#xs \<Longrightarrow>
         (map Some (dropWhile (\<lambda>x. x=0) [a,b,c,d,e,f,g,h]) = xs \<Longrightarrow> (IPv6AddrPreferred a b c d e f g h) = ip') \<Longrightarrow>
         (IPv6AddrPreferred a b c d e f g h) = ip'" for xs
       apply(case_tac "a=0",case_tac [!] "b=0",case_tac [!] "c=0",case_tac [!] "d=0",
             case_tac [!] "e=0",case_tac [!] "f=0",case_tac [!] "g=0",case_tac [!] "h=0")
       by(simp_all add: ipv6_preferred_to_compressed_pull_out_if max_zero_streak_def) (*5s*)
     have ipv6_preferred_to_compressed_None2:
       "ipv6_preferred_to_compressed (IPv6AddrPreferred a b c d e f g h) = (Some a')#None#xs \<Longrightarrow>
         (map Some (dropWhile (\<lambda>x. x=0) [b,c,d,e,f,g,h]) = xs \<Longrightarrow> (IPv6AddrPreferred a' b c d e f g h) = ip') \<Longrightarrow>
         (IPv6AddrPreferred a b c d e f g h) = ip'" for xs a'
       apply(case_tac "a=0",case_tac [!] "b=0",case_tac [!] "c=0",case_tac [!] "d=0",
             case_tac [!] "e=0",case_tac [!] "f=0",case_tac [!] "g=0",case_tac [!] "h=0")
       by(simp_all add: ipv6_preferred_to_compressed_pull_out_if max_zero_streak_def) (*5s*)
     have ipv6_preferred_to_compressed_None3:
       "ipv6_preferred_to_compressed (IPv6AddrPreferred a b c d e f g h) = (Some a')#(Some b')#None#xs \<Longrightarrow>
         (map Some (dropWhile (\<lambda>x. x=0) [c,d,e,f,g,h]) = xs \<Longrightarrow> (IPv6AddrPreferred a' b' c d e f g h) = ip') \<Longrightarrow>
         (IPv6AddrPreferred a b c d e f g h) = ip'" for xs a' b'
       apply(case_tac "a=0",case_tac [!] "b=0",case_tac [!] "c=0",case_tac [!] "d=0",
             case_tac [!] "e=0",case_tac [!] "f=0",case_tac [!] "g=0",case_tac [!] "h=0")
       by(simp_all add: ipv6_preferred_to_compressed_pull_out_if max_zero_streak_def) (*5s*)
     have ipv6_preferred_to_compressed_None4:
       "ipv6_preferred_to_compressed (IPv6AddrPreferred a b c d e f g h) = (Some a')#(Some b')#(Some c')#None#xs \<Longrightarrow>
         (map Some (dropWhile (\<lambda>x. x=0) [d,e,f,g,h]) = xs \<Longrightarrow> (IPv6AddrPreferred a' b' c' d e f g h) = ip') \<Longrightarrow>
         (IPv6AddrPreferred a b c d e f g h) = ip'" for xs a' b' c'
       apply(case_tac "a=0",case_tac [!] "b=0",case_tac [!] "c=0",case_tac [!] "d=0",
             case_tac [!] "e=0",case_tac [!] "f=0",case_tac [!] "g=0",case_tac [!] "h=0")
       by(simp_all add: ipv6_preferred_to_compressed_pull_out_if max_zero_streak_def) (*5s*)
     have ipv6_preferred_to_compressed_None5:
       "ipv6_preferred_to_compressed (IPv6AddrPreferred a b c d e f g h) = (Some a')#(Some b')#(Some c')#(Some d')#None#xs \<Longrightarrow>
         (map Some (dropWhile (\<lambda>x. x=0) [e,f,g,h]) = xs \<Longrightarrow> (IPv6AddrPreferred a' b' c' d' e f g h) = ip') \<Longrightarrow>
         (IPv6AddrPreferred a b c d e f g h) = ip'" for xs a' b' c' d'
       apply(case_tac "a=0",case_tac [!] "b=0",case_tac [!] "c=0",case_tac [!] "d=0",
             case_tac [!] "e=0",case_tac [!] "f=0",case_tac [!] "g=0",case_tac [!] "h=0")
       by(simp_all add: ipv6_preferred_to_compressed_pull_out_if max_zero_streak_def) (*5s*)
     have ipv6_preferred_to_compressed_None6:
       "ipv6_preferred_to_compressed (IPv6AddrPreferred a b c d e f g h) = (Some a')#(Some b')#(Some c')#(Some d')#(Some e')#None#xs \<Longrightarrow>
         (map Some (dropWhile (\<lambda>x. x=0) [f,g,h]) = xs \<Longrightarrow> (IPv6AddrPreferred a' b' c' d' e' f g h) = ip') \<Longrightarrow>
         (IPv6AddrPreferred a b c d e f g h) = ip'" for xs a' b' c' d' e'
       apply(case_tac "a=0",case_tac [!] "b=0",case_tac [!] "c=0",case_tac [!] "d=0",
             case_tac [!] "e=0",case_tac [!] "f=0",case_tac [!] "g=0",case_tac [!] "h=0")
       by(simp_all add: ipv6_preferred_to_compressed_pull_out_if max_zero_streak_def) (*5s*)
     have ipv6_preferred_to_compressed_None7:
       "ipv6_preferred_to_compressed (IPv6AddrPreferred a b c d e f g h) = (Some a')#(Some b')#(Some c')#(Some d')#(Some e')#(Some f')#None#xs \<Longrightarrow>
         (map Some (dropWhile (\<lambda>x. x=0) [g,h]) = xs \<Longrightarrow> (IPv6AddrPreferred a' b' c' d' e' f' g h) = ip') \<Longrightarrow>
         (IPv6AddrPreferred a b c d e f g h) = ip'"  for xs a' b' c' d' e' f'
       apply(case_tac "a=0",case_tac [!] "b=0",case_tac [!] "c=0",case_tac [!] "d=0",
             case_tac [!] "e=0",case_tac [!] "f=0",case_tac [!] "g=0",case_tac [!] "h=0")
       by(simp_all add: ipv6_preferred_to_compressed_pull_out_if max_zero_streak_def) (*5s*)
     have ipv6_preferred_to_compressed_None8:
       "ipv6_preferred_to_compressed (IPv6AddrPreferred a b c d e f g h) = (Some a')#(Some b')#(Some c')#(Some d')#(Some e')#(Some f')#(Some g')#None#xs \<Longrightarrow>
         (map Some (dropWhile (\<lambda>x. x=0) [h]) = xs \<Longrightarrow> (IPv6AddrPreferred a' b' c' d' e' f' g' h) = ip') \<Longrightarrow>
         (IPv6AddrPreferred a b c d e f g h) = ip'" for xs a' b' c' d' e' f' g'
       apply(case_tac "a=0",case_tac [!] "b=0",case_tac [!] "c=0",case_tac [!] "d=0",
             case_tac [!] "e=0",case_tac [!] "f=0",case_tac [!] "g=0",case_tac [!] "h=0")
       by(simp_all add: ipv6_preferred_to_compressed_pull_out_if max_zero_streak_def) (*5s*)
 
     have 2: "parse_ipv6_address_compressed (ipv6_preferred_to_compressed (IPv6AddrPreferred a b c d e f g h))
                 = Some ipv6compressed \<Longrightarrow>
        ipv6addr_c2p ipv6compressed = ip' \<Longrightarrow>
        IPv6AddrPreferred a b c d e f g h = ip'"
     for ipv6compressed
       apply(erule parse_ipv6_address_compressed_someE)
                                          apply(simp_all)
                                          apply(erule ipv6_preferred_to_compressed_None1, simp split: if_split_asm)+
                                  apply(erule ipv6_preferred_to_compressed_None2, simp split: if_split_asm)+
                          apply(erule ipv6_preferred_to_compressed_None3, simp split: if_split_asm)+
                     apply(erule ipv6_preferred_to_compressed_None4, simp split: if_split_asm)+
                apply(erule ipv6_preferred_to_compressed_None5, simp split: if_split_asm)+
            apply(erule ipv6_preferred_to_compressed_None6, simp split: if_split_asm)+
         apply(erule ipv6_preferred_to_compressed_None7, simp split: if_split_asm)+
       apply(erule ipv6_preferred_to_compressed_None8, simp split: if_split_asm)
       done
     from 1 2 ip show ?thesis by(elim exE conjE, simp)
   qed
 end
 
 end
diff --git a/thys/IP_Addresses/Prefix_Match.thy b/thys/IP_Addresses/Prefix_Match.thy
--- a/thys/IP_Addresses/Prefix_Match.thy
+++ b/thys/IP_Addresses/Prefix_Match.thy
@@ -1,242 +1,242 @@
 (*  Title:      Prefix_Match.thy
     Authors:    Julius Michaelis, Cornelius Diekmann
 *)
 theory Prefix_Match
 imports IP_Address
 begin
 
 
 section\<open>Prefix Match\<close>
 text\<open>
   The main difference between the prefix match defined here and CIDR notation is a validity
   constraint imposed on prefix matches.
 
   For example, 192.168.42.42/16 is valid CIDR notation whereas for a prefix match,
   it must be 192.168.0.0/16.
 
   I.e. the last bits of the prefix must be set to zero.
 \<close>
 
 context
   notes [[typedef_overloaded]]
 begin
   datatype 'a prefix_match = PrefixMatch (pfxm_prefix: "'a::len word") (pfxm_length: nat)
 end
 
 definition pfxm_mask :: "'a prefix_match \<Rightarrow> 'a::len word" where
   "pfxm_mask x \<equiv> mask (len_of (TYPE('a)) - pfxm_length x)"
 
 definition valid_prefix :: "('a::len) prefix_match \<Rightarrow> bool" where
   "valid_prefix pf = ((pfxm_mask pf) AND pfxm_prefix pf = 0)"
 text\<open>Note that @{const valid_prefix} looks very elegant as a definition. However, it hides something nasty:\<close>
 lemma "valid_prefix (PrefixMatch (0::32 word) 42)" by eval
 
 text\<open>When zeroing all least significant bits which exceed the @{const pfxm_length},
      you get a @{const valid_prefix}\<close>
 lemma mk_valid_prefix:
   fixes base::"'a::len word"
-  shows "valid_prefix (PrefixMatch (base AND NOT mask (len_of TYPE ('a) - len)) len)"
+  shows "valid_prefix (PrefixMatch (base AND NOT (mask (len_of TYPE ('a) - len))) len)"
 proof -
-  have "mask (len - m) AND base AND NOT mask (len - m) = 0"
+  have "mask (len - m) AND base AND NOT (mask (len - m)) = 0"
     for m len and base::"'a::len word" by(simp add: word_bw_lcs)
   thus ?thesis
   by(simp add: valid_prefix_def pfxm_mask_def pfxm_length_def pfxm_prefix_def)
 qed
 
 
 text\<open>The type @{typ "'a prefix_match"} usually requires @{const valid_prefix}.
       When we allow working on arbitrary IPs in CIDR notation,
       we will use the type @{typ "('i::len word \<times> nat)"} directly.\<close>
 
 lemma valid_prefix_00: "valid_prefix (PrefixMatch 0 0)" by (simp add: valid_prefix_def)
 
 definition prefix_match_to_CIDR :: "('i::len) prefix_match \<Rightarrow> ('i word \<times> nat)" where
   "prefix_match_to_CIDR pfx \<equiv> (pfxm_prefix pfx, pfxm_length pfx)"
 
 lemma prefix_match_to_CIDR_def2: "prefix_match_to_CIDR = (\<lambda>pfx. (pfxm_prefix pfx, pfxm_length pfx))"
   unfolding prefix_match_to_CIDR_def fun_eq_iff by simp
 
 
 definition "prefix_match_dtor m \<equiv> (case m of PrefixMatch p l \<Rightarrow> (p,l))"
 
 text\<open>Some more or less random linear order on prefixes.
      Only used for serialization at the time of this writing.\<close>
 instantiation prefix_match :: (len) linorder
 begin
 	definition "a \<le> b \<longleftrightarrow> (if pfxm_length a = pfxm_length b
                          then pfxm_prefix a \<le> pfxm_prefix b
                          else pfxm_length a > pfxm_length b)"
 	definition "a < b \<longleftrightarrow> (a \<noteq> b \<and>
 	                       (if pfxm_length a = pfxm_length b
 	                        then pfxm_prefix a \<le> pfxm_prefix b
 	                        else pfxm_length a > pfxm_length b))"
 instance
 by standard (auto simp: less_eq_prefix_match_def less_prefix_match_def prefix_match.expand
                   split: if_splits)
 end
 
 lemma "sorted_list_of_set
  {PrefixMatch 0 32 :: 32 prefix_match,
   PrefixMatch 42 32,
   PrefixMatch 0 0,
   PrefixMatch 0 1,
   PrefixMatch 12 31} =
     [PrefixMatch 0 32, PrefixMatch 0x2A 32, PrefixMatch 0xC 31, PrefixMatch 0 1, PrefixMatch 0 0]"
   by eval
 
 context
 begin
 
 private lemma valid_prefix_E: "valid_prefix pf \<Longrightarrow> ((pfxm_mask pf) AND pfxm_prefix pf = 0)" 
   unfolding valid_prefix_def .
 private lemma valid_prefix_alt: fixes p::"'a::len prefix_match"
   shows "valid_prefix p = (pfxm_prefix p AND (2 ^ ((len_of TYPE ('a)) - pfxm_length p) - 1) = 0)"
   unfolding valid_prefix_def
   unfolding mask_def
   using word_bw_comms(1)
    arg_cong[where f = "\<lambda>x. (pfxm_prefix p AND x - 1 = 0)"]
    shiftl_1
   unfolding pfxm_prefix_def pfxm_mask_def mask_def
   by metis
 
 subsection\<open>Address Semantics\<close>
   text\<open>Matching on a @{typ "'a::len prefix_match"}. Think of routing tables.\<close>
   definition prefix_match_semantics where
-    "prefix_match_semantics m a \<equiv> pfxm_prefix m = (NOT pfxm_mask m) AND a"
+    "prefix_match_semantics m a \<equiv> pfxm_prefix m = NOT (pfxm_mask m) AND a"
 
 lemma same_length_prefixes_distinct: "valid_prefix pfx1 \<Longrightarrow> valid_prefix pfx2 \<Longrightarrow> pfx1 \<noteq> pfx2 \<Longrightarrow> pfxm_length pfx1 = pfxm_length pfx2 \<Longrightarrow> prefix_match_semantics pfx1 w \<Longrightarrow> prefix_match_semantics pfx2 w \<Longrightarrow> False"
   by (simp add: pfxm_mask_def prefix_match.expand prefix_match_semantics_def)
 
 subsection\<open>Relation between prefix and set\<close>
 
   definition prefix_to_wordset :: "'a::len prefix_match \<Rightarrow> 'a word set" where
     "prefix_to_wordset pfx = {pfxm_prefix pfx .. pfxm_prefix pfx OR pfxm_mask pfx}"
   
   private lemma pfx_not_empty: "valid_prefix pfx \<Longrightarrow> prefix_to_wordset pfx \<noteq> {}"
     unfolding valid_prefix_def prefix_to_wordset_def by(simp add: le_word_or2)
   
   lemma zero_prefix_match_all:
     "valid_prefix m \<Longrightarrow> pfxm_length m = 0 \<Longrightarrow> prefix_match_semantics m ip"
     by(simp add: pfxm_mask_def mask_2pm1 valid_prefix_alt prefix_match_semantics_def)
   
   lemma prefix_to_wordset_subset_ipset_from_cidr: 
       "prefix_to_wordset pfx \<subseteq> ipset_from_cidr (pfxm_prefix pfx) (pfxm_length pfx)"
     apply(rule subsetI)
     apply(simp add: prefix_to_wordset_def addr_in_ipset_from_cidr_code)
     apply(intro impI conjI)
      apply (metis (erased, hide_lams) order_trans word_and_le2)
     apply(simp add: pfxm_mask_def)
     done
 
 subsection\<open>Equivalence Proofs\<close>
   theorem prefix_match_semantics_wordset:
     assumes "valid_prefix pfx" 
     shows "prefix_match_semantics pfx a \<longleftrightarrow> a \<in> prefix_to_wordset pfx"
     using assms
     unfolding valid_prefix_def pfxm_mask_def prefix_match_semantics_def prefix_to_wordset_def
     apply(cases pfx, rename_tac base len)
     apply(simp)
     apply(drule_tac base=base and len=len and a=a in zero_base_lsb_imp_set_eq_as_bit_operation)
     by (simp)
   
   private lemma valid_prefix_ipset_from_netmask_ipset_from_cidr:
-    shows "ipset_from_netmask (pfxm_prefix pfx) (NOT pfxm_mask pfx) =
+    shows "ipset_from_netmask (pfxm_prefix pfx) (NOT (pfxm_mask pfx)) =
             ipset_from_cidr (pfxm_prefix pfx) (pfxm_length pfx)"
     apply(cases pfx)
     apply(simp add: ipset_from_cidr_alt2 pfxm_mask_def)
    done
   
   lemma prefix_match_semantics_ipset_from_netmask:
     assumes "valid_prefix pfx"
     shows "prefix_match_semantics pfx a \<longleftrightarrow>
-            a \<in> ipset_from_netmask (pfxm_prefix pfx) (NOT pfxm_mask pfx)"
+            a \<in> ipset_from_netmask (pfxm_prefix pfx) (NOT (pfxm_mask pfx))"
     unfolding prefix_match_semantics_wordset[OF assms]
     unfolding valid_prefix_ipset_from_netmask_ipset_from_cidr
     unfolding prefix_to_wordset_def
     apply(subst ipset_from_cidr_base_wellforemd)
      subgoal using assms by(simp add: valid_prefix_def pfxm_mask_def)
     by(simp add: pfxm_mask_def)
     
   lemma prefix_match_semantics_ipset_from_netmask2:
     assumes "valid_prefix pfx"
     shows "prefix_match_semantics pfx (a :: 'i::len word) \<longleftrightarrow>
             a \<in> ipset_from_cidr (pfxm_prefix pfx) (pfxm_length pfx)"
    unfolding prefix_match_semantics_ipset_from_netmask[OF assms] pfxm_mask_def ipset_from_cidr_def
    by (metis (full_types) NOT_mask_shifted_lenword word_not_not)
 
   lemma prefix_to_wordset_ipset_from_cidr:
     assumes "valid_prefix (pfx::'a::len prefix_match)"
     shows "prefix_to_wordset pfx = ipset_from_cidr (pfxm_prefix pfx) (pfxm_length pfx)"
   proof -
     have helper3: "(x::'a::len word) OR y = x OR y AND NOT x" for x y by (simp add: word_oa_dist2)
     have prefix_match_semantics_ipset_from_netmask:
-           "(prefix_to_wordset pfx) = ipset_from_netmask (pfxm_prefix pfx) (NOT pfxm_mask pfx)"
+           "(prefix_to_wordset pfx) = ipset_from_netmask (pfxm_prefix pfx) (NOT (pfxm_mask pfx))"
       unfolding prefix_to_wordset_def ipset_from_netmask_def Let_def
       unfolding word_bool_alg.double_compl
       proof(goal_cases)
         case 1
-        have *: "pfxm_prefix pfx AND NOT pfxm_mask pfx = pfxm_prefix pfx"
+        have *: "pfxm_prefix pfx AND NOT (pfxm_mask pfx) = pfxm_prefix pfx"
           unfolding mask_eq_0_eq_x[symmetric]
           using valid_prefix_E[OF assms] word_bw_comms(1)[of "pfxm_prefix pfx"] by simp
-        hence **: "pfxm_prefix pfx AND NOT pfxm_mask pfx OR pfxm_mask pfx =
+        hence **: "pfxm_prefix pfx AND NOT (pfxm_mask pfx) OR pfxm_mask pfx =
                     pfxm_prefix pfx OR pfxm_mask pfx"
           by simp
         show ?case unfolding * ** ..
       qed
-      have "((mask len)::'a::len word) << LENGTH('a) - len = ~~ mask (LENGTH('a) - len)"
+      have "((mask len)::'a::len word) << LENGTH('a) - len = ~~ (mask (LENGTH('a) - len))"
       for len using NOT_mask_shifted_lenword by (metis word_not_not)
       from this[of "(pfxm_length pfx)"] have mask_def2_symmetric:
         "((mask (pfxm_length pfx)::'a::len word) << LENGTH('a) - pfxm_length pfx) =
-          NOT pfxm_mask pfx"
+          NOT (pfxm_mask pfx)"
         unfolding pfxm_mask_def by simp
   
       have ipset_from_netmask_prefix: 
-        "ipset_from_netmask (pfxm_prefix pfx) (NOT pfxm_mask pfx) =
+        "ipset_from_netmask (pfxm_prefix pfx) (NOT (pfxm_mask pfx)) =
           ipset_from_cidr (pfxm_prefix pfx) (pfxm_length pfx)"
        unfolding ipset_from_netmask_def ipset_from_cidr_alt
        unfolding pfxm_mask_def[symmetric]
        unfolding mask_def2_symmetric
        apply(simp)
        unfolding Let_def
        using assms[unfolded valid_prefix_def]
        by (metis helper3 word_bw_comms(2))
       
       show ?thesis by (metis ipset_from_netmask_prefix local.prefix_match_semantics_ipset_from_netmask) 
   qed
 
   definition prefix_to_wordinterval :: "'a::len prefix_match \<Rightarrow> 'a wordinterval" where
     "prefix_to_wordinterval pfx \<equiv> WordInterval (pfxm_prefix pfx) (pfxm_prefix pfx OR pfxm_mask pfx)"
   
   lemma prefix_to_wordinterval_set_eq[simp]:
     "wordinterval_to_set (prefix_to_wordinterval pfx) = prefix_to_wordset pfx"
     unfolding prefix_to_wordinterval_def prefix_to_wordset_def by simp
   
   lemma prefix_to_wordinterval_def2:
     "prefix_to_wordinterval pfx =
       iprange_interval ((pfxm_prefix pfx), (pfxm_prefix pfx OR pfxm_mask pfx))"
     unfolding iprange_interval.simps prefix_to_wordinterval_def by simp
   corollary prefix_to_wordinterval_ipset_from_cidr: "valid_prefix pfx \<Longrightarrow>
     wordinterval_to_set (prefix_to_wordinterval pfx) =
       ipset_from_cidr (pfxm_prefix pfx) (pfxm_length pfx)"
   using prefix_to_wordset_ipset_from_cidr prefix_to_wordinterval_set_eq by auto
 end
 
 
 lemma prefix_never_empty: 
   fixes d:: "'a::len prefix_match"
   shows"\<not> wordinterval_empty (prefix_to_wordinterval d)"
 by (simp add: le_word_or2 prefix_to_wordinterval_def)
 
 
 text\<open>Getting a lowest element\<close>
   lemma ipset_from_cidr_lowest: "a \<in> ipset_from_cidr a n" 
     using ip_cidr_set_def ipset_from_cidr_eq_ip_cidr_set by blast
 
   (*this is why I call the previous lemma 'lowest'*)
   lemma "valid_prefix (PrefixMatch a n) \<Longrightarrow> is_lowest_element a (ipset_from_cidr a n)"
     apply(simp add: is_lowest_element_def ipset_from_cidr_lowest)
     apply(simp add: ipset_from_cidr_eq_ip_cidr_set ip_cidr_set_def)
     apply(simp add: valid_prefix_def pfxm_mask_def)
     by (metis diff_zero eq_iff mask_out_sub_mask word_and_le2 word_bw_comms(1))
 
 end
diff --git a/thys/LOFT/LinuxRouter_OpenFlow_Translation.thy b/thys/LOFT/LinuxRouter_OpenFlow_Translation.thy
--- a/thys/LOFT/LinuxRouter_OpenFlow_Translation.thy
+++ b/thys/LOFT/LinuxRouter_OpenFlow_Translation.thy
@@ -1,1051 +1,1052 @@
 theory LinuxRouter_OpenFlow_Translation
 imports IP_Addresses.CIDR_Split
   Automatic_Refinement.Misc (*TODO@Peter: rename and make available at better place :)*)
 	Simple_Firewall.Generic_SimpleFw 
 	Semantics_OpenFlow
 	OpenFlow_Matches
 	OpenFlow_Action
 	Routing.Linux_Router
 begin
 hide_const Misc.uncurry
 hide_fact Misc.uncurry_def
   
 (* For reference:
 iiface :: "iface" --"in-interface"
 oiface :: "iface" --"out-interface"
 src :: "(ipv4addr \<times> nat) " --"source IP address"
 dst :: "(ipv4addr \<times> nat) " --"destination"
 proto :: "protocol"
 sports :: "(16 word \<times> 16 word)" --"source-port first:last"
 dports :: "(16 word \<times> 16 word)" --"destination-port first:last"
 
 p_iiface :: string
 p_oiface :: string
 p_src :: ipv4addr
 p_dst :: ipv4addr
 p_proto :: primitive_protocol
 p_sport :: "16 word"
 p_dport :: "16 word"
 p_tcp_flags :: "tcp_flag set"
 p_payload :: string
 *)
 
 definition "route2match r =
 	\<lparr>iiface = ifaceAny, oiface = ifaceAny, 
 	src = (0,0), dst=(pfxm_prefix (routing_match r),pfxm_length (routing_match r)), 
 	proto=ProtoAny, sports=(0,max_word), ports=(0,max_word)\<rparr>"
 
 definition toprefixmatch where
 "toprefixmatch m \<equiv> (let pm = PrefixMatch (fst m) (snd m) in if pm = PrefixMatch 0 0 then None else Some pm)"
 lemma prefix_match_semantics_simple_match: 
   assumes some: "toprefixmatch m = Some pm"
 	assumes vld: "valid_prefix pm"
 	shows "prefix_match_semantics pm = simple_match_ip m"
 using some
   by(cases m)
 	  (clarsimp 
 	   simp add: toprefixmatch_def ipset_from_cidr_def pfxm_mask_def fun_eq_iff
 	            prefix_match_semantics_ipset_from_netmask[OF vld] NOT_mask_shifted_lenword[symmetric]
 	   split: if_splits)
 
 definition simple_match_to_of_match_single ::
     "(32, 'a) simple_match_scheme
      \<Rightarrow> char list option \<Rightarrow> protocol \<Rightarrow> (16 word \<times> 16 word) option \<Rightarrow> (16 word \<times> 16 word) option \<Rightarrow> of_match_field set" 
     where
 "simple_match_to_of_match_single m iif prot sport dport \<equiv>
 	   uncurry L4Src ` option2set sport \<union> uncurry L4Dst ` option2set dport
 	 \<union> IPv4Proto ` (case prot of ProtoAny \<Rightarrow> {} | Proto p \<Rightarrow> {p}) \<comment> \<open>protocol is an 8 word option anyway...\<close>
 	 \<union> IngressPort ` option2set iif
 	 \<union> IPv4Src ` option2set (toprefixmatch (src m)) \<union> IPv4Dst ` option2set (toprefixmatch (dst m))
 	 \<union> {EtherType 0x0800}"
 (* okay, we need to make sure that no packets are output on the interface they were input on. So for rules that don't have an input interface, we'd need to do a product over all interfaces, if we stay naive.
    The more smart way would be to insert a rule with the same match condition that additionally matches the input interface and drops. However, I'm afraid this is going to be very tricky to verify\<dots> *)
 definition simple_match_to_of_match :: "32 simple_match \<Rightarrow> string list \<Rightarrow> of_match_field set list" where
 "simple_match_to_of_match m ifs \<equiv> (let
 	npm = (\<lambda>p. fst p = 0 \<and> snd p = max_word);
-	sb = (\<lambda>p. (if npm p then [None] else if fst p \<le> snd p then map (Some \<circ> (\<lambda>pfx. (pfxm_prefix pfx, NOT pfxm_mask pfx))) (wordinterval_CIDR_split_prefixmatch (WordInterval (fst p) (snd p))) else []))
+	sb = (\<lambda>p. (if npm p then [None] else if fst p \<le> snd p
+  then map (Some \<circ> (\<lambda>pfx. (pfxm_prefix pfx, NOT (pfxm_mask pfx)))) (wordinterval_CIDR_split_prefixmatch (WordInterval (fst p) (snd p))) else []))
 	in [simple_match_to_of_match_single m iif (proto m) sport dport.
 		iif \<leftarrow> (if iiface m = ifaceAny then [None] else [Some i. i \<leftarrow> ifs, match_iface (iiface m) i]),
 		sport \<leftarrow> sb (sports m),
 		dport \<leftarrow> sb (dports m)]
 )"
 (* I wonder\<dots> should I check whether list_all (match_iface (iiface m)) ifs instead of iiface m = ifaceAny? It would be pretty stupid if that wasn't the same, but you know\<dots> *)
 
 lemma smtoms_eq_hlp: "simple_match_to_of_match_single r a b c d = simple_match_to_of_match_single r f g h i \<longleftrightarrow> (a = f \<and> b = g \<and> c = h \<and> d = i)"
 (* In case this proof breaks: there are two alternate proofs in the repo. They are of similar quality, though. Good luck. *)
 proof(rule iffI,goal_cases)
   case 1
   thus ?case proof(intro conjI)
     have *: "\<And>P z x. \<lbrakk>\<forall>x :: of_match_field. P x; z = Some x\<rbrakk> \<Longrightarrow> P (IngressPort x)" by simp
     show "a = f" using 1 by(cases a; cases f)
         (simp add: option2set_None simple_match_to_of_match_single_def toprefixmatch_def option2set_def;
         subst(asm) set_eq_iff; drule (1) *; simp split: option.splits uncurry_splits protocol.splits)+
   next
     have *: "\<And>P z x. \<lbrakk>\<forall>x :: of_match_field. P x; z = Proto x\<rbrakk> \<Longrightarrow> P (IPv4Proto x)" by simp
     show "b = g" using 1 by(cases b; cases g) 
         (simp add: option2set_None simple_match_to_of_match_single_def toprefixmatch_def option2set_def;
         subst(asm) set_eq_iff; drule (1) *; simp split: option.splits uncurry_splits protocol.splits)+
   next
     have *: "\<And>P z x. \<lbrakk>\<forall>x :: of_match_field. P x; z = Some x\<rbrakk> \<Longrightarrow> P (uncurry L4Src x)" by simp
     show "c = h" using 1 by(cases c; cases h)
         (simp add: option2set_None simple_match_to_of_match_single_def toprefixmatch_def option2set_def;
         subst(asm) set_eq_iff; drule (1) *; simp split: option.splits uncurry_splits protocol.splits)+
   next
     have *: "\<And>P z x. \<lbrakk>\<forall>x :: of_match_field. P x; z = Some x\<rbrakk> \<Longrightarrow> P (uncurry L4Dst x)" by simp
     show "d = i" using 1 by(cases d; cases i)
         (simp add: option2set_None simple_match_to_of_match_single_def toprefixmatch_def option2set_def;
         subst(asm) set_eq_iff; drule (1) *; simp split: option.splits uncurry_splits protocol.splits)+
   qed
 qed simp
 
 lemma simple_match_to_of_match_generates_prereqs: "simple_match_valid m \<Longrightarrow> r \<in> set (simple_match_to_of_match m ifs) \<Longrightarrow> all_prerequisites r"
 unfolding simple_match_to_of_match_def Let_def
 proof(clarsimp, goal_cases)
   case (1 xiface xsrcp xdstp)
   note o = this
   show ?case unfolding simple_match_to_of_match_single_def all_prerequisites_def
     unfolding ball_Un
   proof((intro conjI; ((simp;fail)| - )), goal_cases)
     case 1
     have e: "(fst (sports m) = 0 \<and> snd (sports m) = max_word) \<or> proto m = Proto TCP \<or> proto m = Proto UDP \<or> proto m = Proto L4_Protocol.SCTP"
       using o(1)
       unfolding simple_match_valid_alt Let_def
       by(clarsimp split: if_splits)
     show ?case
       using o(3) e
       by(elim disjE; simp add: option2set_def split: if_splits prod.splits uncurry_splits)
   next
     case 2
     have e: "(fst (dports m) = 0 \<and> snd (dports m) = max_word) \<or> proto m = Proto TCP \<or> proto m = Proto UDP \<or> proto m = Proto L4_Protocol.SCTP"
       using o(1)
       unfolding simple_match_valid_alt Let_def
       by(clarsimp split: if_splits)
     show ?case
       using o(4) e
       by(elim disjE; simp add: option2set_def split: if_splits prod.splits uncurry_splits)
   qed
 qed
 
 lemma and_assoc: "a \<and> b \<and> c \<longleftrightarrow> (a \<and> b) \<and> c" by simp
 
 lemmas custom_simpset = Let_def set_concat set_map map_map comp_def concat_map_maps set_maps UN_iff fun_app_def Set.image_iff
 
 abbreviation "simple_fw_prefix_to_wordinterval \<equiv> prefix_to_wordinterval \<circ> uncurry PrefixMatch"
 
 lemma simple_match_port_alt: "simple_match_port m p \<longleftrightarrow> p \<in> wordinterval_to_set (uncurry WordInterval m)" by(simp split: uncurry_splits)
 
 lemma simple_match_src_alt: "simple_match_valid r \<Longrightarrow> 
 	simple_match_ip (src r) p \<longleftrightarrow> prefix_match_semantics (PrefixMatch (fst (src r)) (snd (src r))) p"
 by(cases "(src r)") (simp add: prefix_match_semantics_ipset_from_netmask2 prefix_to_wordset_ipset_from_cidr simple_match_valid_def valid_prefix_fw_def)
 lemma simple_match_dst_alt: "simple_match_valid r \<Longrightarrow> 
 	simple_match_ip (dst r) p \<longleftrightarrow> prefix_match_semantics (PrefixMatch (fst (dst r)) (snd (dst r))) p"
 by(cases "(dst r)") (simp add: prefix_match_semantics_ipset_from_netmask2 prefix_to_wordset_ipset_from_cidr simple_match_valid_def valid_prefix_fw_def)
 
 lemma "x \<in> set (wordinterval_CIDR_split_prefixmatch w) \<Longrightarrow> valid_prefix x"
 using wordinterval_CIDR_split_prefixmatch_all_valid_Ball[THEN bspec, THEN conjunct1] .
 
 lemma simple_match_to_of_matchI: 
 	assumes mv: "simple_match_valid r"
 	assumes mm: "simple_matches r p"
 	assumes ii: "p_iiface p \<in> set ifs"
 	assumes ippkt: "p_l2type p = 0x800"
 	shows eq: "\<exists>gr \<in> set (simple_match_to_of_match r ifs). OF_match_fields gr p = Some True"
 proof -
 	let ?npm = "\<lambda>p. fst p = 0 \<and> snd p = max_word"
 	let ?sb = "\<lambda>p r. (if ?npm p then None else Some r)"
 	obtain si where si: "case si of Some ssi \<Rightarrow> p_sport p \<in> prefix_to_wordset ssi | None \<Rightarrow> True"
 		"case si of None \<Rightarrow> True | Some ssi \<Rightarrow> ssi \<in> set (
 		wordinterval_CIDR_split_prefixmatch (uncurry WordInterval (sports r)))"
 		"si = None \<longleftrightarrow> ?npm (sports r)"
 	proof(cases "?npm (sports r)", goal_cases)
 		case 1 (* True *)
 		hence "(case None of None \<Rightarrow> True | Some ssi \<Rightarrow> p_sport p \<in> prefix_to_wordset ssi) \<and>
             (case None of None \<Rightarrow> True
             | Some ssi \<Rightarrow> ssi \<in> set (wordinterval_CIDR_split_prefixmatch (uncurry WordInterval (sports r))))" by simp
         with 1 show ?thesis by blast
 	next
 		case 2 (* False *)
 		from mm have "p_sport p \<in> wordinterval_to_set (uncurry WordInterval (sports r))"
 			by(simp only: simple_matches.simps simple_match_port_alt)
 		then obtain ssi where ssi:
 			"ssi \<in> set (wordinterval_CIDR_split_prefixmatch (uncurry WordInterval (sports r)))"
 			"p_sport p \<in> prefix_to_wordset ssi" 
 			using wordinterval_CIDR_split_existential by fast
 		hence "(case Some ssi of None \<Rightarrow> True | Some ssi \<Rightarrow> p_sport p \<in> prefix_to_wordset ssi) \<and>
             (case Some ssi of None \<Rightarrow> True
             | Some ssi \<Rightarrow> ssi \<in> set (wordinterval_CIDR_split_prefixmatch (uncurry WordInterval (sports r))))" by simp
         with 2 show ?thesis by blast
     qed				
 	obtain di where di: "case di of Some ddi \<Rightarrow> p_dport p \<in> prefix_to_wordset ddi | None \<Rightarrow> True"
 		"case di of None \<Rightarrow> True | Some ddi \<Rightarrow> ddi \<in> set (
 		wordinterval_CIDR_split_prefixmatch (uncurry WordInterval (dports r)))"
 		"di = None \<longleftrightarrow> ?npm (dports r)"
 	proof(cases "?npm (dports r)", goal_cases)
 		case 1
 		hence "(case None of None \<Rightarrow> True | Some ssi \<Rightarrow> p_dport p \<in> prefix_to_wordset ssi) \<and>
             (case None of None \<Rightarrow> True
             | Some ssi \<Rightarrow> ssi \<in> set (wordinterval_CIDR_split_prefixmatch (uncurry WordInterval (dports r))))" by simp
         with 1 show ?thesis by blast
 	next
 		case 2
 		from mm have "p_dport p \<in> wordinterval_to_set (uncurry WordInterval (dports r))"
 			by(simp only: simple_matches.simps simple_match_port_alt)
 		then obtain ddi where ddi:
 			"ddi \<in> set (wordinterval_CIDR_split_prefixmatch (uncurry WordInterval (dports r)))"
 			"p_dport p \<in> prefix_to_wordset ddi" 
 			using wordinterval_CIDR_split_existential by fast
 		hence "(case Some ddi of None \<Rightarrow> True | Some ssi \<Rightarrow> p_dport p \<in> prefix_to_wordset ssi) \<and>
             (case Some ddi of None \<Rightarrow> True
             | Some ssi \<Rightarrow> ssi \<in> set (wordinterval_CIDR_split_prefixmatch (uncurry WordInterval (dports r))))" by simp
         with 2 show ?thesis by blast
     qed
     show ?thesis
 	proof
 		let ?mf = "map_option (apsnd (wordNOT \<circ> mask \<circ> (-) 16) \<circ> prefix_match_dtor)"
 		let ?gr = "simple_match_to_of_match_single r
 			(if iiface r = ifaceAny then None else Some (p_iiface p)) 
 			(if proto r = ProtoAny then ProtoAny else Proto (p_proto p))
 			(?mf si) (?mf di)"
 		note mfu = simple_match_port.simps[of "fst (sports r)" "snd (sports r)", unfolded surjective_pairing[of "sports r",symmetric]]
 				   simple_match_port.simps[of "fst (dports r)" "snd (dports r)", unfolded surjective_pairing[of "dports r",symmetric]]
 		note u = mm[unfolded simple_matches.simps mfu ord_class.atLeastAtMost_iff simple_packet_unext_def simple_packet.simps]
 		note of_safe_unsafe_match_eq[OF simple_match_to_of_match_generates_prereqs]
 		from u have ple: "fst (sports r) \<le> snd (sports r)" "fst (dports r) \<le> snd (dports r)" by force+
 		show eg: "?gr \<in> set (simple_match_to_of_match r ifs)"
 			unfolding simple_match_to_of_match_def
 			unfolding custom_simpset
 			unfolding smtoms_eq_hlp
 			proof(intro bexI, (intro conjI; ((rule refl)?)), goal_cases)
 				case 2 thus ?case using ple(2) di
 					apply(simp add: pfxm_mask_def prefix_match_dtor_def Set.image_iff 
 					           split: option.splits prod.splits uncurry_splits)
 					apply(erule bexI[rotated])
 					apply(simp split: prefix_match.splits)
 				done
 			next
 				case 3 thus ?case using ple(1) si
 					apply(simp add: pfxm_mask_def prefix_match_dtor_def Set.image_iff 
 					           split: option.splits prod.splits uncurry_splits)
 					apply(erule bexI[rotated])
 					apply(simp split: prefix_match.splits)
 				done
 			next
 				case 4 thus ?case
 				  using u ii by(clarsimp simp: set_maps split: if_splits)
 			next
 				case 1 thus ?case using ii u by simp_all (metis match_proto.elims(2))  
 			qed
-		have dpm: "di = Some (PrefixMatch x1 x2) \<Longrightarrow> p_dport p && ~~ mask (16 - x2) = x1" for x1 x2
+		have dpm: "di = Some (PrefixMatch x1 x2) \<Longrightarrow> p_dport p && ~~ (mask (16 - x2)) = x1" for x1 x2
     proof -
-      have *: "di = Some (PrefixMatch x1 x2) \<Longrightarrow> prefix_match_semantics (the di) (p_dport p) \<Longrightarrow> p_dport p && ~~ mask (16 - x2) = x1"
+      have *: "di = Some (PrefixMatch x1 x2) \<Longrightarrow> prefix_match_semantics (the di) (p_dport p) \<Longrightarrow> p_dport p && ~~ (mask (16 - x2)) = x1"
         by(clarsimp simp: prefix_match_semantics_def pfxm_mask_def word_bw_comms;fail)
       have **: "pfx \<in> set (wordinterval_CIDR_split_prefixmatch ra) \<Longrightarrow> prefix_match_semantics pfx a = (a \<in> prefix_to_wordset pfx)" for pfx ra and a :: "16 word"
         by (fact prefix_match_semantics_wordset[OF wordinterval_CIDR_split_prefixmatch_all_valid_Ball[THEN bspec, THEN conjunct1]])
       have "\<lbrakk>di = Some (PrefixMatch x1 x2); p_dport p \<in> prefix_to_wordset (PrefixMatch x1 x2); PrefixMatch x1 x2 \<in> set (wordinterval_CIDR_split_prefixmatch (uncurry WordInterval (dports r)))\<rbrakk>
-             \<Longrightarrow> p_dport p && ~~ mask (16 - x2) = x1"
+             \<Longrightarrow> p_dport p && ~~ (mask (16 - x2)) = x1"
       using di(1,2)
         using * ** by auto
-      thus "di = Some (PrefixMatch x1 x2) \<Longrightarrow> p_dport p && ~~ mask (16 - x2) = x1"  using di(1,2) by auto
+      thus "di = Some (PrefixMatch x1 x2) \<Longrightarrow> p_dport p && ~~ (mask (16 - x2)) = x1"  using di(1,2) by auto
     qed
-		have spm: "si = Some (PrefixMatch x1 x2) \<Longrightarrow> p_sport p && ~~ mask (16 - x2) = x1" for x1 x2
+		have spm: "si = Some (PrefixMatch x1 x2) \<Longrightarrow> p_sport p && ~~ (mask (16 - x2)) = x1" for x1 x2
     using si
     proof -
-      have *: "si = Some (PrefixMatch x1 x2) \<Longrightarrow> prefix_match_semantics (the si) (p_sport p) \<Longrightarrow> p_sport p && ~~ mask (16 - x2) = x1"
+      have *: "si = Some (PrefixMatch x1 x2) \<Longrightarrow> prefix_match_semantics (the si) (p_sport p) \<Longrightarrow> p_sport p && ~~ (mask (16 - x2)) = x1"
         by(clarsimp simp: prefix_match_semantics_def pfxm_mask_def word_bw_comms;fail)
       have **: "pfx \<in> set (wordinterval_CIDR_split_prefixmatch ra) \<Longrightarrow> prefix_match_semantics pfx a = (a \<in> prefix_to_wordset pfx)" for pfx ra and a :: "16 word"
         by (fact prefix_match_semantics_wordset[OF wordinterval_CIDR_split_prefixmatch_all_valid_Ball[THEN bspec, THEN conjunct1]])
       have "\<lbrakk>si = Some (PrefixMatch x1 x2); p_sport p \<in> prefix_to_wordset (PrefixMatch x1 x2); PrefixMatch x1 x2 \<in> set (wordinterval_CIDR_split_prefixmatch (uncurry WordInterval (sports r)))\<rbrakk>
-             \<Longrightarrow> p_sport p && ~~ mask (16 - x2) = x1"
+             \<Longrightarrow> p_sport p && ~~ (mask (16 - x2)) = x1"
       using si(1,2)
         using * ** by auto
-      thus "si = Some (PrefixMatch x1 x2) \<Longrightarrow> p_sport p && ~~ mask (16 - x2) = x1"  using si(1,2) by auto
+      thus "si = Some (PrefixMatch x1 x2) \<Longrightarrow> p_sport p && ~~ (mask (16 - x2)) = x1"  using si(1,2) by auto
     qed
 		show "OF_match_fields ?gr p = Some True"
 		unfolding of_safe_unsafe_match_eq[OF simple_match_to_of_match_generates_prereqs[OF mv eg]]
 		  by(cases si; cases di)
         (simp_all
 					add: simple_match_to_of_match_single_def OF_match_fields_unsafe_def spm
 					     option2set_def u ippkt prefix_match_dtor_def toprefixmatch_def dpm
 					     simple_match_dst_alt[OF mv, symmetric] simple_match_src_alt[OF mv, symmetric]
 					split: prefix_match.splits)
 	qed
 qed
 
 lemma prefix_match_00[simp,intro!]: "prefix_match_semantics (PrefixMatch 0 0) p"
   by (simp add: valid_prefix_def zero_prefix_match_all)
 
 lemma simple_match_to_of_matchD:
 	assumes eg: "gr \<in> set (simple_match_to_of_match r ifs)"
 	assumes mo: "OF_match_fields gr p = Some True"
 	assumes me: "match_iface (oiface r) (p_oiface p)"
 	assumes mv: "simple_match_valid r"
 	shows "simple_matches r p"
 proof -
 	from mv have validpfx: 
 		"valid_prefix (uncurry PrefixMatch (src r))" "valid_prefix (uncurry PrefixMatch (dst r))"
 		"\<And>pm. toprefixmatch (src r) = Some pm \<Longrightarrow> valid_prefix pm"
 		"\<And>pm. toprefixmatch (dst r) = Some pm \<Longrightarrow> valid_prefix pm"
 		unfolding simple_match_valid_def valid_prefix_fw_def toprefixmatch_def 
 		  by(simp_all split: uncurry_splits if_splits)
 	from mo have mo: "OF_match_fields_unsafe gr p" 
 		unfolding of_safe_unsafe_match_eq[OF simple_match_to_of_match_generates_prereqs[OF mv eg]]
 		by simp
 	note this[unfolded OF_match_fields_unsafe_def]
 	note eg[unfolded simple_match_to_of_match_def simple_match_to_of_match_single_def  custom_simpset option2set_def]
 	then guess x ..	moreover from this(2) guess xa ..	moreover from this(2) guess xb ..
 	note xx = calculation(1,3) this
 
   { fix a b xc xa
       fix pp :: "16 word"
-	  have "\<lbrakk>pp && ~~ pfxm_mask xc = pfxm_prefix xc\<rbrakk>
+	  have "\<lbrakk>pp && ~~ (pfxm_mask xc) = pfxm_prefix xc\<rbrakk>
               \<Longrightarrow> prefix_match_semantics xc (pp)" for xc
       by(simp add: prefix_match_semantics_def word_bw_comms;fail)
     moreover have "pp \<in> wordinterval_to_set (WordInterval a b) \<Longrightarrow> a \<le> pp \<and> pp \<le> b" by simp
     moreover have "xc \<in> set (wordinterval_CIDR_split_prefixmatch (WordInterval a b)) \<Longrightarrow> pp \<in> prefix_to_wordset xc  \<Longrightarrow> pp \<in> wordinterval_to_set (WordInterval a b)"
 			by(subst wordinterval_CIDR_split_prefixmatch) blast
-	  moreover have "\<lbrakk>xc \<in> set (wordinterval_CIDR_split_prefixmatch (WordInterval a b)); xa = Some (pfxm_prefix xc, ~~ pfxm_mask xc); prefix_match_semantics xc (pp)\<rbrakk> \<Longrightarrow> pp \<in> prefix_to_wordset xc"
+	  moreover have "\<lbrakk>xc \<in> set (wordinterval_CIDR_split_prefixmatch (WordInterval a b)); xa = Some (pfxm_prefix xc, ~~ (pfxm_mask xc)); prefix_match_semantics xc (pp)\<rbrakk> \<Longrightarrow> pp \<in> prefix_to_wordset xc"
 			apply(subst(asm)(1) prefix_match_semantics_wordset)
 			apply(erule wordinterval_CIDR_split_prefixmatch_all_valid_Ball[THEN bspec, THEN conjunct1];fail)
 			apply assumption
 	  done
-	  ultimately have "\<lbrakk>xc \<in> set (wordinterval_CIDR_split_prefixmatch (WordInterval a b)); xa = Some (pfxm_prefix xc, ~~ pfxm_mask xc);
-               pp && ~~ pfxm_mask xc = pfxm_prefix xc\<rbrakk>
+	  ultimately have "\<lbrakk>xc \<in> set (wordinterval_CIDR_split_prefixmatch (WordInterval a b)); xa = Some (pfxm_prefix xc, ~~ (pfxm_mask xc));
+               pp && ~~ (pfxm_mask xc) = pfxm_prefix xc\<rbrakk>
               \<Longrightarrow> a \<le> pp \<and> pp \<le> b"
      by metis
 	} note l4port_logic = this
 
 	show ?thesis unfolding simple_matches.simps
 	proof(unfold and_assoc, (rule)+)
 		show "match_iface (iiface r) (p_iiface p)"
 			apply(cases "iiface r = ifaceAny")
 			 apply (simp add: match_ifaceAny) 
 			using xx(1) mo unfolding xx(4) OF_match_fields_unsafe_def
 			apply(simp only: if_False set_maps UN_iff)
 			apply(clarify)
 			apply(rename_tac a; subgoal_tac "match_iface (iiface r) a")
 			 apply(clarsimp simp add: option2set_def;fail)
 			apply(rule ccontr,simp;fail)
 		done
 	next
 		show "match_iface (oiface r) (p_oiface p)" using me .
 	next
 		show "simple_match_ip (src r) (p_src p)"
 			using mo unfolding xx(4) OF_match_fields_unsafe_def toprefixmatch_def
 			by(clarsimp
 			  simp add: simple_packet_unext_def option2set_def validpfx simple_match_src_alt[OF mv] toprefixmatch_def 
 			  split: if_splits)
 	next
 		show "simple_match_ip (dst r) (p_dst p)"
 			using mo unfolding xx(4) OF_match_fields_unsafe_def toprefixmatch_def
 			by(clarsimp
 			  simp add: simple_packet_unext_def option2set_def validpfx simple_match_dst_alt[OF mv] toprefixmatch_def 
 			  split: if_splits)
  	next
 		show "match_proto (proto r) (p_proto p)"
 			using mo unfolding xx(4) OF_match_fields_unsafe_def
 			using xx(1) by(clarsimp 
 				simp add: singleton_iff simple_packet_unext_def option2set_def prefix_match_semantics_simple_match ball_Un 
 				split: if_splits protocol.splits)
 	next
 		show "simple_match_port (sports r) (p_sport p)"
 			using mo xx(2) unfolding xx(4) OF_match_fields_unsafe_def
 			by(cases "sports r") (clarsimp simp add: l4port_logic simple_packet_unext_def option2set_def prefix_match_semantics_simple_match split: if_splits)
 	next
 		show "simple_match_port (dports r) (p_dport p)" 
 		  using mo xx(3) unfolding xx(4) OF_match_fields_unsafe_def
 			by(cases "dports r") (clarsimp simp add: l4port_logic simple_packet_unext_def option2set_def prefix_match_semantics_simple_match split: if_splits)
     qed
 qed
 
 primrec annotate_rlen where
 "annotate_rlen [] = []" |
 "annotate_rlen (a#as) = (length as, a) # annotate_rlen as"
 lemma "annotate_rlen ''asdf'' = [(3, CHR ''a''), (2, CHR ''s''), (1, CHR ''d''), (0, CHR ''f'')]" by simp
 
 lemma fst_annotate_rlen_le: "(k, a) \<in> set (annotate_rlen l) \<Longrightarrow> k < length l"
 	by(induction l arbitrary: k; simp; force)
 
 lemma distinct_fst_annotate_rlen: "distinct (map fst (annotate_rlen l))"
 	using fst_annotate_rlen_le by(induction l) (simp, fastforce)
 lemma distinct_annotate_rlen: "distinct (annotate_rlen l)"
 	using distinct_fst_annotate_rlen unfolding distinct_map by blast
 lemma in_annotate_rlen: "(a,x) \<in> set (annotate_rlen l) \<Longrightarrow> x \<in> set l" 
   by(induction l) (simp_all, blast)
 lemma map_snd_annotate_rlen: "map snd (annotate_rlen l) = l"
   by(induction l) simp_all
 lemma "sorted_descending (map fst (annotate_rlen l))"
   by(induction l; clarsimp) (force dest: fst_annotate_rlen_le)
 lemma "annotate_rlen l = zip (rev [0..<length l]) l"
   by(induction l; simp) (* It would probably have been better to just use the zip, but oh well\<dots> *)
 
 primrec annotate_rlen_code where
 "annotate_rlen_code [] = (0,[])" |
 "annotate_rlen_code (a#as) = (case annotate_rlen_code as of (r,aas) \<Rightarrow> (Suc r, (r, a) # aas))"
 lemma annotate_rlen_len: "fst (annotate_rlen_code r) = length r"
 by(induction r) (clarsimp split: prod.splits)+
 lemma annotate_rlen_code[code]: "annotate_rlen s = snd (annotate_rlen_code s)"
 proof(induction s)
   case (Cons s ss) thus ?case using annotate_rlen_len[of ss] by(clarsimp split: prod.split)
 qed simp
 
 lemma suc2plus_inj_on: "inj_on (of_nat :: nat \<Rightarrow> ('l :: len) word) {0..unat (max_word :: 'l word)}"
 proof(rule inj_onI)
    let ?mmw = "(max_word :: 'l word)"
    let ?mstp = "(of_nat :: nat \<Rightarrow> 'l word)"
    fix x y :: nat
    assume "x \<in> {0..unat ?mmw}" "y \<in> {0..unat ?mmw}"
    hence se: "x \<le> unat ?mmw" "y \<le> unat ?mmw" by simp_all
    assume eq: "?mstp x = ?mstp y"
    note f = le_unat_uoi[OF se(1)] le_unat_uoi[OF se(2)]
    show "x = y" using eq le_unat_uoi se by metis
 qed
 
 lemma distinct_of_nat_list: (* TODO: Move to CaesarWordLemmaBucket *)
 	"distinct l \<Longrightarrow> \<forall>e \<in> set l. e \<le> unat (max_word :: ('l::len) word) \<Longrightarrow> distinct (map (of_nat :: nat \<Rightarrow> 'l word) l)"
 proof(induction l)
 	let ?mmw = "(max_word :: 'l word)"
 	let ?mstp = "(of_nat :: nat \<Rightarrow> 'l word)"
 	case (Cons a as)
 	have "distinct as" "\<forall>e\<in>set as. e \<le> unat ?mmw" using Cons.prems by simp_all 
 	note mIH = Cons.IH[OF this]
 	moreover have "?mstp a \<notin> ?mstp ` set as"
 	proof 
 		have representable_set: "set as \<subseteq> {0..unat ?mmw}" using \<open>\<forall>e\<in>set (a # as). e \<le> unat max_word\<close> by fastforce
 		have a_reprbl: "a \<in> {0..unat ?mmw}" using \<open>\<forall>e\<in>set (a # as). e \<le> unat max_word\<close> by simp
 		assume "?mstp a \<in> ?mstp ` set as"
 		with inj_on_image_mem_iff[OF suc2plus_inj_on a_reprbl representable_set]
 		have "a \<in> set as" by simp
 		with \<open>distinct (a # as)\<close> show False by simp
 	qed
 	ultimately show ?case by simp
 qed simp
 
 lemma annotate_first_le_hlp:
 	"length l < unat (max_word :: ('l :: len) word) \<Longrightarrow> \<forall>e\<in>set (map fst (annotate_rlen l)). e \<le> unat (max_word :: 'l word)"
 	by(clarsimp) (meson fst_annotate_rlen_le less_trans nat_less_le)
 lemmas distinct_of_prio_hlp = distinct_of_nat_list[OF distinct_fst_annotate_rlen annotate_first_le_hlp]
 (* don't need these right now, but maybe later? *)
                                                   
 lemma fst_annotate_rlen: "map fst (annotate_rlen l) = rev [0..<length l]"
 by(induction l) (simp_all)
 
 lemma sorted_word_upt:
   defines[simp]: "won \<equiv> (of_nat :: nat \<Rightarrow> ('l :: len) word)"
   assumes "length l \<le> unat (max_word :: 'l word)"
   shows "sorted_descending (map won (rev [0..<Suc (length l)]))" 
 using assms
   by(induction l rule: rev_induct;clarsimp)
     (metis (mono_tags, hide_lams) le_SucI le_unat_uoi of_nat_Suc order_refl word_le_nat_alt)
     (* This proof is kind of ugly. In case it breaks unfixably, go back to rev a9c4927 and get word_upto.
        The lemmas on word_upto can be used to shows this trivially. *)
 
 lemma sorted_annotated:
 	assumes "length l \<le> unat (max_word :: ('l :: len) word)"
 	shows "sorted_descending (map fst (map (apfst (of_nat :: nat \<Rightarrow> 'l word)) (annotate_rlen l)))"
 proof -
 	let ?won = "(of_nat :: nat \<Rightarrow> 'l word)"
 	have "sorted_descending (map ?won (rev [0..<Suc (length l)]))" 
 		using sorted_word_upt[OF assms] .
 	hence "sorted_descending (map ?won (map fst (annotate_rlen l)))" by(simp add: fst_annotate_rlen)
 	thus "sorted_descending (map fst (map (apfst ?won) (annotate_rlen l)))" by simp
 qed
 
 text\<open>l3 device to l2 forwarding\<close>
 definition "lr_of_tran_s3 ifs ard = (
 	[(p, b, case a of simple_action.Accept \<Rightarrow> [Forward c] | simple_action.Drop \<Rightarrow> []).
 		(p,r,(c,a)) \<leftarrow> ard, b \<leftarrow> simple_match_to_of_match r ifs])"
 
 definition "oif_ne_iif_p1 ifs \<equiv> [(simple_match_any\<lparr>oiface := Iface oif, iiface := Iface iif\<rparr>, simple_action.Accept). oif \<leftarrow> ifs, iif \<leftarrow> ifs, oif \<noteq> iif]"
 definition "oif_ne_iif_p2 ifs = [(simple_match_any\<lparr>oiface := Iface i, iiface := Iface i\<rparr>, simple_action.Drop). i \<leftarrow> ifs]"
 definition "oif_ne_iif ifs = oif_ne_iif_p2 ifs @ oif_ne_iif_p1 ifs" (* order irrelephant *)
 (*value "oif_ne_iif [''a'', ''b'']"*)
 (* I first tried something like "oif_ne_iif ifs \<equiv> [(simple_match_any\<lparr>oiface := Iface oi, iiface := Iface ii\<rparr>, if oi = ii then simple_action.Drop else simple_action.Accept). oi \<leftarrow> ifs, ii \<leftarrow> ifs]", 
    but making the statement I wanted with that was really tricky. Much easier to have the second element constant and do it separately. *)
 definition "lr_of_tran_s4 ard ifs \<equiv> generalized_fw_join ard (oif_ne_iif ifs)"
 
 definition "lr_of_tran_s1 rt = [(route2match r, output_iface (routing_action r)). r \<leftarrow> rt]"
 
 definition "lr_of_tran_fbs rt fw ifs \<equiv> let
 	gfw = map simple_rule_dtor fw; \<comment> \<open>generalized simple fw, hopefully for FORWARD\<close>
 	frt = lr_of_tran_s1 rt; \<comment> \<open>rt as fw\<close>
 	prd = generalized_fw_join frt gfw
 	in prd
 "
 
 definition "pack_OF_entries ifs ard \<equiv> (map (split3 OFEntry) (lr_of_tran_s3 ifs ard))"
 definition "no_oif_match \<equiv> list_all (\<lambda>m. oiface (match_sel m) = ifaceAny)"
 
 definition "lr_of_tran rt fw ifs \<equiv> 
   if \<not> (no_oif_match fw \<and> has_default_policy fw \<and> simple_fw_valid fw	\<and> valid_prefixes rt \<and> has_default_route rt \<and> distinct ifs)
     then Inl ''Error in creating OpenFlow table: prerequisites not satisifed''
     else (
   let	nrd = lr_of_tran_fbs rt fw ifs;
 	ard = map (apfst of_nat) (annotate_rlen nrd) \<comment> \<open>give them a priority\<close>
 	in
 	if length nrd < unat (max_word :: 16 word)
 	then Inr (pack_OF_entries ifs ard)
 	else Inl ''Error in creating OpenFlow table: priority number space exhausted'')
 "
 
 definition "is_iface_name i \<equiv> i \<noteq> [] \<and> \<not>Iface.iface_name_is_wildcard i"
 definition "is_iface_list ifs \<equiv> distinct ifs \<and> list_all is_iface_name ifs"
 
 lemma max_16_word_max[simp]: "(a :: 16 word) \<le> 0xffff"
 proof -
 	have ffff: "0xffff = word_of_int (2 ^ 16 - 1)" by fastforce
 	show ?thesis using max_word_max[of a] unfolding max_word_def ffff by fastforce
 qed
 
 lemma replicate_FT_hlp: "x \<le> 16 \<and> y \<le> 16 \<Longrightarrow> replicate (16 - x) False @ replicate x True = replicate (16 - y) False @ replicate y True \<Longrightarrow> x = y"
 proof -
 	let ?ns = "{0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16}"
 	assume "x \<le> 16 \<and> y \<le> 16"
 	hence "x \<in> ?ns" "y \<in> ?ns" by(simp; presburger)+
 	moreover assume "replicate (16 - x) False @ replicate x True = replicate (16 - y) False @ replicate y True"
 	ultimately show "x = y" by simp (elim disjE; simp_all) (* that's only 289 subgoals after the elim *)
 qed
 
 lemma mask_inj_hlp1: "inj_on (mask :: nat \<Rightarrow> 16 word) {0..16}"
 proof(intro inj_onI, goal_cases)
   case (1 x y)
   from 1(3)
   have oe: "of_bl (replicate (16 - x) False @ replicate x True) = (of_bl (replicate (16 - y) False @ replicate y True) :: 16 word)"
          unfolding mask_bl of_bl_rep_False .
   have "\<And>z. z \<le> 16 \<Longrightarrow> length (replicate (16 - z) False @ replicate z True) = 16" by auto
   with 1(1,2)
   have ps: "replicate (16 - x) False @ replicate x True \<in> {bl. length bl = LENGTH(16)}" " replicate (16 - y) False @ replicate y True \<in> {bl. length bl = LENGTH(16)}" by simp_all
   from inj_onD[OF word_bl.Abs_inj_on, OF oe ps]
   show ?case using 1(1,2) by(fastforce intro: replicate_FT_hlp)
 qed
 
 lemma distinct_simple_match_to_of_match_portlist_hlp: 
   fixes ps :: "(16 word \<times> 16 word)"
   shows "distinct ifs \<Longrightarrow>
     distinct
      (if fst ps = 0 \<and> snd ps = max_word then [None]
       else if fst ps \<le> snd ps
-           then map (Some \<circ> (\<lambda>pfx. (pfxm_prefix pfx, ~~ pfxm_mask pfx)))
+           then map (Some \<circ> (\<lambda>pfx. (pfxm_prefix pfx, ~~ (pfxm_mask pfx))))
                  (wordinterval_CIDR_split_prefixmatch (WordInterval (fst ps) (snd ps)))
            else [])"
 proof -
   assume di: "distinct ifs"
   { define wis where "wis = set (wordinterval_CIDR_split_prefixmatch (WordInterval (fst ps) (snd ps)))"
     fix x y :: "16 prefix_match"
     obtain xm xn ym yn where xyd[simp]: "x = PrefixMatch xm xn" "y = PrefixMatch ym yn" by(cases x; cases y)
-    assume iw: "x \<in> wis" "y \<in> wis" and et: "(pfxm_prefix x, ~~ pfxm_mask x) = (pfxm_prefix y, ~~ pfxm_mask y)"
+    assume iw: "x \<in> wis" "y \<in> wis" and et: "(pfxm_prefix x, ~~ (pfxm_mask x)) = (pfxm_prefix y, ~~ (pfxm_mask y))"
     hence le16: "xn \<le> 16" "yn \<le> 16" unfolding wis_def using wordinterval_CIDR_split_prefixmatch_all_valid_Ball[unfolded Ball_def, THEN spec, THEN mp] by force+
     with et have "16 - xn = 16 - yn" unfolding pfxm_mask_def by(auto intro: mask_inj_hlp1[THEN inj_onD])
     hence "x = y" using et le16 using diff_diff_cancel by simp
   } note * = this
   show ?thesis 
     apply(clarsimp simp add: smtoms_eq_hlp distinct_map wordinterval_CIDR_split_distinct)
     apply(subst comp_inj_on_iff[symmetric]; intro inj_onI)
   using * by simp_all
 qed
 
 lemma distinct_simple_match_to_of_match: "distinct ifs \<Longrightarrow> distinct (simple_match_to_of_match m ifs)"
   apply(unfold simple_match_to_of_match_def Let_def)
   apply(rule distinct_3lcomprI)
   subgoal by(induction ifs; clarsimp)
   subgoal by(fact distinct_simple_match_to_of_match_portlist_hlp)
   subgoal by(fact distinct_simple_match_to_of_match_portlist_hlp)
   subgoal by(simp_all add: smtoms_eq_hlp)
 done
 
 lemma inj_inj_on: "inj F \<Longrightarrow> inj_on F A" using subset_inj_on by auto (* TODO: include Word_Lib *)
 
 lemma no_overlaps_lroft_hlp2: "distinct (map fst amr) \<Longrightarrow> (\<And>r. distinct (fm r)) \<Longrightarrow>
     distinct (concat (map (\<lambda>(p, r, c, a). map (\<lambda>b. (p, b, fs a c)) (fm r)) amr))"
   by(induction amr; force intro: injI inj_onI simp add: distinct_map split: prod.splits)
 
 lemma distinct_lroft_s3: "\<lbrakk>distinct (map fst amr); distinct ifs\<rbrakk> \<Longrightarrow> distinct (lr_of_tran_s3 ifs amr)"
   unfolding lr_of_tran_s3_def
   by(erule no_overlaps_lroft_hlp2, simp add: distinct_simple_match_to_of_match)
 
 lemma no_overlaps_lroft_hlp3: "distinct (map fst amr) \<Longrightarrow>
 (aa, ab, ac) \<in> set (lr_of_tran_s3 ifs amr) \<Longrightarrow> (ba, bb, bc) \<in> set (lr_of_tran_s3 ifs amr) \<Longrightarrow>
 ac \<noteq> bc \<Longrightarrow> aa \<noteq> ba"
   apply(unfold lr_of_tran_s3_def)
   apply(clarsimp)
   apply(clarsimp split: simple_action.splits)
     apply(metis map_of_eq_Some_iff old.prod.inject option.inject)
    apply(metis map_of_eq_Some_iff old.prod.inject option.inject simple_action.distinct(2))+
 done
 
 lemma no_overlaps_lroft_s3_hlp_hlp: (* I hlps *)
   "\<lbrakk>distinct (map fst amr); OF_match_fields_unsafe ab p; ab \<noteq> ad \<or> ba \<noteq> bb; OF_match_fields_unsafe ad p;
         (ac, ab, ba) \<in> set (lr_of_tran_s3 ifs amr); (ac, ad, bb) \<in> set (lr_of_tran_s3 ifs amr)\<rbrakk>
        \<Longrightarrow> False"
 proof(elim disjE, goal_cases)
   case 1
   have 4: "\<lbrakk>distinct (map fst amr);  (ac, ab, x1, x2) \<in> set amr; (ac, bb, x4, x5) \<in> set amr; ab \<noteq> bb\<rbrakk>
        \<Longrightarrow> False" for ab x1 x2 bb x4 x5
        by (meson distinct_map_fstD old.prod.inject)
   have conjunctSomeProtoAnyD: "Some ProtoAny = simple_proto_conjunct a (Proto b) \<Longrightarrow> False" for a b
     using conjunctProtoD by force
   have 5:
        "\<lbrakk>OF_match_fields_unsafe am p; OF_match_fields_unsafe bm p; am \<noteq> bm; 
         am \<in> set (simple_match_to_of_match ab ifs); bm \<in> set (simple_match_to_of_match bb ifs); \<not> ab \<noteq> bb\<rbrakk>
        \<Longrightarrow> False" for ab bb am bm
       by(clarify | unfold
          simple_match_to_of_match_def smtoms_eq_hlp Let_def set_concat set_map de_Morgan_conj not_False_eq_True)+
         (auto dest: conjunctSomeProtoAnyD cidrsplit_no_overlaps
 	            simp add: OF_match_fields_unsafe_def simple_match_to_of_match_single_def option2set_def comp_def
 	            split: if_splits
 	            cong: smtoms_eq_hlp) (*1min*)
   from 1 show ?case
   using 4 5 by(clarsimp simp add: lr_of_tran_s3_def) blast
 qed(metis no_overlaps_lroft_hlp3)
 
 
 lemma no_overlaps_lroft_s3_hlp: "distinct (map fst amr) \<Longrightarrow> distinct ifs \<Longrightarrow> 
 no_overlaps OF_match_fields_unsafe (map (split3 OFEntry) (lr_of_tran_s3 ifs amr))"
   apply(rule no_overlapsI[rotated])
   apply(subst distinct_map, rule conjI)
   subgoal by(erule (1) distinct_lroft_s3)
   subgoal
     apply(rule inj_inj_on)
     apply(rule injI)
     apply(rename_tac x y, case_tac x, case_tac y)
     apply(simp add: split3_def;fail)
   done
   subgoal
     apply(unfold check_no_overlap_def)
     apply(clarify)
     apply(unfold set_map)
     apply(clarify)
     apply(unfold split3_def prod.simps flow_entry_match.simps flow_entry_match.sel de_Morgan_conj)
     apply(clarsimp simp only:)
     apply(erule (1) no_overlaps_lroft_s3_hlp_hlp)
        apply simp
       apply assumption
      apply assumption
     apply simp
   done
 done
 
 lemma lr_of_tran_no_overlaps: assumes "distinct ifs" shows "Inr t = (lr_of_tran rt fw ifs) \<Longrightarrow> no_overlaps OF_match_fields_unsafe t"
 	apply(unfold lr_of_tran_def Let_def pack_OF_entries_def)
 	apply(simp split: if_splits)
 	apply(thin_tac "t = _")
 	apply(drule distinct_of_prio_hlp)
 	apply(rule no_overlaps_lroft_s3_hlp[rotated])
 	subgoal by(simp add: assms)
 	subgoal by(simp add: o_assoc)
 done
 
 lemma sorted_lr_of_tran_s3_hlp: "\<forall>x\<in>set f. fst x \<le> a \<Longrightarrow> b \<in> set (lr_of_tran_s3 s f) \<Longrightarrow> fst b \<le> a" 
 	by(auto simp add: lr_of_tran_s3_def)
 
 lemma lr_of_tran_s3_Cons: "lr_of_tran_s3 ifs (a#ard) = (
 	[(p, b, case a of simple_action.Accept \<Rightarrow> [Forward c] | simple_action.Drop \<Rightarrow> []).
 		(p,r,(c,a)) \<leftarrow> [a], b \<leftarrow> simple_match_to_of_match r ifs]) @ lr_of_tran_s3 ifs ard"
 	by(clarsimp simp: lr_of_tran_s3_def)
 
 lemma sorted_lr_of_tran_s3: "sorted_descending (map fst f) \<Longrightarrow> sorted_descending (map fst (lr_of_tran_s3 s f))"
 	apply(induction f)
 	 subgoal by(simp add: lr_of_tran_s3_def)
 	apply(clarsimp simp: lr_of_tran_s3_Cons map_concat comp_def)
 	apply(unfold sorted_descending_append)
 	apply(simp add: sorted_descending_alt rev_map sorted_lr_of_tran_s3_hlp sorted_const)
 done
 
 lemma sorted_lr_of_tran_hlp: "(ofe_prio \<circ> split3 OFEntry) = fst" by(simp add: fun_eq_iff comp_def split3_def)
 
 lemma lr_of_tran_sorted_descending: "Inr r = lr_of_tran rt fw ifs \<Longrightarrow> sorted_descending (map ofe_prio r)"
 	apply(unfold lr_of_tran_def Let_def)
 	apply(simp split: if_splits)
 	apply(thin_tac "r = _")
 	apply(unfold sorted_lr_of_tran_hlp pack_OF_entries_def split3_def[abs_def] fun_app_def map_map comp_def prod.case_distrib)
 	apply(simp add: fst_def[symmetric])
 	apply(rule sorted_lr_of_tran_s3)
 	apply(drule sorted_annotated[OF less_or_eq_imp_le, OF disjI1])
 	apply(simp add: o_assoc)
 done
 
 lemma lr_of_tran_s1_split: "lr_of_tran_s1 (a # rt) = (route2match a, output_iface (routing_action a)) # lr_of_tran_s1 rt"
 	by(unfold lr_of_tran_s1_def list.map, rule)
 
 lemma route2match_correct: "valid_prefix (routing_match a) \<Longrightarrow> prefix_match_semantics (routing_match a) (p_dst p) \<longleftrightarrow> simple_matches (route2match a) (p)"
 by(simp add: route2match_def simple_matches.simps match_ifaceAny match_iface_refl ipset_from_cidr_0 prefix_match_semantics_ipset_from_netmask2)
 
 lemma s1_correct: "valid_prefixes rt \<Longrightarrow> has_default_route (rt::('i::len) prefix_routing) \<Longrightarrow> 
   \<exists>rm ra. generalized_sfw (lr_of_tran_s1 rt) p = Some (rm,ra) \<and> ra = output_iface (routing_table_semantics rt (p_dst p))"
 	apply(induction rt)
 	 apply(simp;fail)
 	apply(drule valid_prefixes_split)
 	apply(clarsimp)
 	apply(erule disjE)
 	subgoal for a rt
 	 apply(case_tac a)
 	 apply(rename_tac routing_m metric routing_action)
 	 apply(case_tac routing_m)
 	 apply(simp add: valid_prefix_def pfxm_mask_def prefix_match_semantics_def generalized_sfw_def 
 	       lr_of_tran_s1_def route2match_def simple_matches.simps match_ifaceAny match_iface_refl ipset_from_cidr_0
 	       max_word_mask[where 'a = 'i, symmetric, simplified])
 	done
 	subgoal
     apply(rule conjI)
      apply(simp add: generalized_sfw_def lr_of_tran_s1_def route2match_correct;fail)
     apply(simp add: route2match_def simple_matches.simps prefix_match_semantics_ipset_from_netmask2 
                     lr_of_tran_s1_split generalized_sfw_simps)
   done
 done
 
 definition "to_OF_action a \<equiv> (case a of (p,d) \<Rightarrow> (case d of simple_action.Accept \<Rightarrow> [Forward p] | simple_action.Drop \<Rightarrow> []))"
 definition "from_OF_action a = (case a of [] \<Rightarrow> ('''',simple_action.Drop) | [Forward p] \<Rightarrow> (p, simple_action.Accept))"
 
 lemma OF_match_linear_not_noD: "OF_match_linear \<gamma> oms p \<noteq> NoAction \<Longrightarrow> \<exists>ome. ome \<in> set oms \<and> \<gamma> (ofe_fields ome) p"
 	apply(induction oms)
 	 apply(simp)
 	apply(simp split: if_splits)
 	 apply blast+
 done
 
 lemma s3_noaction_hlp: "\<lbrakk>simple_match_valid ac; \<not>simple_matches ac p; match_iface (oiface ac) (p_oiface p)\<rbrakk> \<Longrightarrow> 
 OF_match_linear OF_match_fields_safe (map (\<lambda>x. split3 OFEntry (x1, x, case ba of simple_action.Accept \<Rightarrow> [Forward ad] | simple_action.Drop \<Rightarrow> [])) (simple_match_to_of_match ac ifs)) p = NoAction"
   apply(rule ccontr)
   apply(drule OF_match_linear_not_noD)
   apply(clarsimp)
   apply(rename_tac x)
   apply(subgoal_tac "all_prerequisites x")
    apply(drule simple_match_to_of_matchD)
       apply(simp add: split3_def)
       apply(subst(asm) of_match_fields_safe_eq2)
       apply(simp;fail)+
   using simple_match_to_of_match_generates_prereqs by blast
 
 lemma s3_correct:
 	assumes vsfwm: "list_all simple_match_valid (map (fst \<circ> snd) ard)"
 	assumes ippkt: "p_l2type p = 0x800"
 	assumes iiifs: "p_iiface p \<in> set ifs"
 	assumes oiifs: "list_all (\<lambda>m. oiface (fst (snd m)) = ifaceAny) ard"
 	shows "OF_match_linear OF_match_fields_safe (pack_OF_entries ifs ard) p = Action ao \<longleftrightarrow> (\<exists>r af. generalized_sfw (map snd ard) p = (Some (r,af)) \<and> (if snd af = simple_action.Drop then ao = [] else ao = [Forward (fst af)]))"
 unfolding pack_OF_entries_def lr_of_tran_s3_def fun_app_def
 using vsfwm oiifs
   apply(induction ard)
    subgoal by(simp add: generalized_sfw_simps)
   apply simp
   apply(clarsimp simp add: generalized_sfw_simps split: prod.splits)
   apply(intro conjI) (* make two subgoals from one *)
    subgoal for ard x1 ac ad ba
     apply(clarsimp simp add: OF_match_linear_append split: prod.splits)
     apply(drule simple_match_to_of_matchI[rotated])
        apply(rule iiifs)
       apply(rule ippkt)
      apply blast
     apply(clarsimp simp add: comp_def)
     apply(drule 
        OF_match_linear_match_allsameaction[where
          \<gamma>=OF_match_fields_safe and pri = x1 and
          oms = "simple_match_to_of_match ac ifs" and 
          act = "case ba of simple_action.Accept \<Rightarrow> [Forward ad] | simple_action.Drop \<Rightarrow> []"])
      apply(unfold OF_match_fields_safe_def comp_def)
      apply(erule Some_to_the[symmetric];fail)
     apply(clarsimp)
     apply(intro iffI)
     subgoal
      apply(rule exI[where x = ac])
      apply(rule exI[where x = ad])
      apply(rule exI[where x = ba])
      apply(clarsimp simp: split3_def split: simple_action.splits flowtable_behavior.splits if_splits)
     done
     subgoal
      apply(clarsimp)
      apply(rename_tac b)
      apply(case_tac b)
      apply(simp_all)
    done
   done
   subgoal for ard x1 ac ad ba
    apply(simp add: OF_match_linear_append OF_match_fields_safe_def comp_def)
    apply(clarify)
    apply(subgoal_tac "OF_match_linear OF_match_fields_safe (map (\<lambda>x. split3 OFEntry (x1, x, case ba of simple_action.Accept \<Rightarrow> [Forward ad] | simple_action.Drop \<Rightarrow> [])) (simple_match_to_of_match ac ifs)) p = NoAction")
     apply(simp;fail)
    apply(erule (1) s3_noaction_hlp)
    apply(simp add: match_ifaceAny;fail)
   done
 done
 
 context
   notes valid_prefix_00[simp, intro!]
 begin
   lemma lr_of_tran_s1_valid: "valid_prefixes rt \<Longrightarrow> gsfw_valid (lr_of_tran_s1 rt)"
     unfolding lr_of_tran_s1_def route2match_def gsfw_valid_def list_all_iff
     apply(clarsimp simp: simple_match_valid_def valid_prefix_fw_def)
     apply(intro conjI)
      apply force
     apply(simp add: valid_prefixes_alt_def)
   done
 end
 
 lemma simple_match_valid_fbs_rlen: "\<lbrakk>valid_prefixes rt; simple_fw_valid fw; (a, aa, ab, b) \<in> set (annotate_rlen (lr_of_tran_fbs rt fw ifs))\<rbrakk> \<Longrightarrow> simple_match_valid aa"
 proof(goal_cases)
   case 1
   note 1[unfolded lr_of_tran_fbs_def Let_def]
   have "gsfw_valid (map simple_rule_dtor fw)" using gsfw_validI 1 by blast
   moreover have "gsfw_valid (lr_of_tran_s1 rt)" using 1 lr_of_tran_s1_valid by blast
   ultimately have "gsfw_valid (generalized_fw_join (lr_of_tran_s1 rt) (map simple_rule_dtor fw))" using gsfw_join_valid by blast
   moreover have "(aa, ab, b) \<in> set (lr_of_tran_fbs rt fw ifs)" using 1 using in_annotate_rlen by fast
   ultimately show ?thesis unfolding lr_of_tran_fbs_def Let_def gsfw_valid_def list_all_iff by fastforce
 qed
 
 lemma simple_match_valid_fbs: "\<lbrakk>valid_prefixes rt; simple_fw_valid fw\<rbrakk> \<Longrightarrow> list_all simple_match_valid (map fst (lr_of_tran_fbs rt fw ifs))"
 proof(goal_cases)
   case 1
   note 1[unfolded lr_of_tran_fbs_def Let_def]
   have "gsfw_valid (map simple_rule_dtor fw)" using gsfw_validI 1 by blast
   moreover have "gsfw_valid (lr_of_tran_s1 rt)" using 1 lr_of_tran_s1_valid by blast
   ultimately have "gsfw_valid (generalized_fw_join (lr_of_tran_s1 rt) (map simple_rule_dtor fw))" using gsfw_join_valid by blast
   thus ?thesis unfolding lr_of_tran_fbs_def Let_def gsfw_valid_def list_all_iff by fastforce
 qed
 
 lemma lr_of_tran_prereqs: "valid_prefixes rt \<Longrightarrow> simple_fw_valid fw \<Longrightarrow> lr_of_tran rt fw ifs = Inr oft \<Longrightarrow>
 list_all (all_prerequisites \<circ> ofe_fields) oft"
 unfolding lr_of_tran_def pack_OF_entries_def lr_of_tran_s3_def Let_def
   apply(simp add: map_concat comp_def prod.case_distrib split3_def split: if_splits)
   apply(simp add: list_all_iff)
   apply(clarsimp)
   apply(drule simple_match_valid_fbs_rlen[rotated])
     apply(simp add: list_all_iff;fail)
    apply(simp add: list_all_iff;fail)
   apply(rule simple_match_to_of_match_generates_prereqs; assumption)
 done
 
 (* TODO: move. where? *)
 lemma OF_unsafe_safe_match3_eq: "
   list_all (all_prerequisites \<circ> ofe_fields) oft \<Longrightarrow>
   OF_priority_match OF_match_fields_unsafe oft = OF_priority_match OF_match_fields_safe oft"
 unfolding OF_priority_match_def[abs_def]
 proof(goal_cases)
   case 1
   from 1 have "\<And>packet. [f\<leftarrow>oft . OF_match_fields_unsafe (ofe_fields f) packet] = [f\<leftarrow>oft . OF_match_fields_safe (ofe_fields f) packet]"
     apply(clarsimp simp add: list_all_iff of_match_fields_safe_eq) 
   using of_match_fields_safe_eq by(metis (mono_tags, lifting) filter_cong)
   thus ?case by metis
 qed
 
 lemma OF_unsafe_safe_match_linear_eq: "
   list_all (all_prerequisites \<circ> ofe_fields) oft \<Longrightarrow>
   OF_match_linear OF_match_fields_unsafe oft = OF_match_linear OF_match_fields_safe oft"
 unfolding fun_eq_iff
 by(induction oft) (clarsimp simp add: list_all_iff of_match_fields_safe_eq)+
 
 lemma simple_action_ne[simp]: 
   "b \<noteq> simple_action.Accept \<longleftrightarrow> b = simple_action.Drop"
   "b \<noteq> simple_action.Drop \<longleftrightarrow> b = simple_action.Accept"
 using simple_action.exhaust by blast+
 
 lemma map_snd_apfst: "map snd (map (apfst x) l) = map snd l"
   unfolding map_map comp_def snd_apfst ..
 
 lemma match_ifaceAny_eq: "oiface m = ifaceAny \<Longrightarrow> simple_matches m p = simple_matches m (p\<lparr>p_oiface := any\<rparr>)"
 by(cases m) (simp add: simple_matches.simps match_ifaceAny)
 lemma no_oif_matchD: "no_oif_match fw \<Longrightarrow> simple_fw fw p = simple_fw fw (p\<lparr>p_oiface := any\<rparr>)"
   by(induction fw)
     (auto simp add: no_oif_match_def simple_fw_alt dest: match_ifaceAny_eq)
 
 lemma lr_of_tran_fbs_acceptD:
   assumes s1: "valid_prefixes rt" "has_default_route rt"
   assumes s2: "no_oif_match fw"
   shows "generalized_sfw (lr_of_tran_fbs rt fw ifs) p = Some (r, oif, simple_action.Accept) \<Longrightarrow>
   simple_linux_router_nol12 rt fw p = Some (p\<lparr>p_oiface := oif\<rparr>)"
 proof(goal_cases)
   case 1
   note 1[unfolded lr_of_tran_fbs_def Let_def, THEN generalized_fw_joinD]
   then guess r1 .. then guess r2 .. note r12 = this
   note s1_correct[OF s1, of p]
   then guess rm .. then guess ra .. note rmra = this
   from r12 rmra have oifra: "oif = ra" by simp
   from r12 have sfw: "simple_fw fw p = Decision FinalAllow" using simple_fw_iff_generalized_fw_accept by blast
   note ifupdateirrel = no_oif_matchD[OF s2, where any = " output_iface (routing_table_semantics rt (p_dst p))" and p = p, symmetric]
   show ?case unfolding simple_linux_router_nol12_def by(simp add: Let_def ifupdateirrel sfw oifra rmra split: Option.bind_splits option.splits) 
 qed
 
 lemma lr_of_tran_fbs_acceptI:
   assumes s1: "valid_prefixes rt" "has_default_route rt"
   assumes s2: "no_oif_match fw" "has_default_policy fw"
   shows "simple_linux_router_nol12 rt fw p = Some (p\<lparr>p_oiface := oif\<rparr>) \<Longrightarrow>
   \<exists>r. generalized_sfw (lr_of_tran_fbs rt fw ifs) p = Some (r, oif, simple_action.Accept)"
 proof(goal_cases)
   from s2 have nud: "\<And>p. simple_fw fw p \<noteq> Undecided" by (metis has_default_policy state.distinct(1))
   note ifupdateirrel = no_oif_matchD[OF s2(1), symmetric]
   case 1
   from 1 have "simple_fw fw p = Decision FinalAllow" by(simp add: simple_linux_router_nol12_def Let_def nud ifupdateirrel split: Option.bind_splits state.splits final_decision.splits)
   then obtain r where r: "generalized_sfw (map simple_rule_dtor fw) p = Some (r, simple_action.Accept)" using simple_fw_iff_generalized_fw_accept by blast
   have oif_def: "oif = output_iface (routing_table_semantics rt (p_dst p))" using 1 by(cases p) (simp add: simple_linux_router_nol12_def Let_def nud ifupdateirrel split: Option.bind_splits state.splits final_decision.splits)
   note s1_correct[OF s1, of p] then guess rm .. then guess ra .. note rmra = this
   show ?case unfolding lr_of_tran_fbs_def Let_def
     apply(rule exI)
     apply(rule generalized_fw_joinI)
     unfolding oif_def using rmra apply simp
     apply(rule r)
   done
 qed
 
 lemma lr_of_tran_fbs_dropD:
   assumes s1: "valid_prefixes rt" "has_default_route rt"
   assumes s2: "no_oif_match fw"
   shows "generalized_sfw (lr_of_tran_fbs rt fw ifs) p = Some (r, oif, simple_action.Drop) \<Longrightarrow>
   simple_linux_router_nol12 rt fw p = None"
 proof(goal_cases)
   note ifupdateirrel = no_oif_matchD[OF s2(1), symmetric]
   case 1
   from 1[unfolded lr_of_tran_fbs_def Let_def, THEN generalized_fw_joinD]
   obtain rr fr where "generalized_sfw (lr_of_tran_s1 rt) p = Some (rr, oif) \<and>
           generalized_sfw (map simple_rule_dtor fw) p = Some (fr, simple_action.Drop) \<and> Some r = simple_match_and rr fr" by presburger
   hence fd: "\<And>u. simple_fw fw (p\<lparr>p_oiface := u\<rparr>) = Decision FinalDeny" unfolding ifupdateirrel
   using simple_fw_iff_generalized_fw_drop by blast
   show ?thesis
     by(clarsimp simp: simple_linux_router_nol12_def Let_def fd split: Option.bind_splits)
 qed
 
 lemma lr_of_tran_fbs_dropI:
   assumes s1: "valid_prefixes rt" "has_default_route rt"
   assumes s2: "no_oif_match fw" "has_default_policy fw"
   shows "simple_linux_router_nol12 rt fw p = None \<Longrightarrow>
   \<exists>r oif. generalized_sfw (lr_of_tran_fbs rt fw ifs) p = Some (r, oif, simple_action.Drop)"
 proof(goal_cases)
   from s2 have nud: "\<And>p. simple_fw fw p \<noteq> Undecided" by (metis has_default_policy state.distinct(1))
   note ifupdateirrel = no_oif_matchD[OF s2(1), symmetric]
   case 1
   from 1 have "simple_fw fw p = Decision FinalDeny" by(simp add: simple_linux_router_nol12_def Let_def nud ifupdateirrel split: Option.bind_splits state.splits final_decision.splits)
   then obtain r where r: "generalized_sfw (map simple_rule_dtor fw) p = Some (r, simple_action.Drop)" using simple_fw_iff_generalized_fw_drop by blast
   note s1_correct[OF s1, of p] then guess rm .. then guess ra .. note rmra = this
   show ?case unfolding lr_of_tran_fbs_def Let_def
     apply(rule exI)
     apply(rule exI[where x = ra])
     apply(rule generalized_fw_joinI)
     using rmra apply simp
     apply(rule r)
   done
 qed
 
 
 lemma no_oif_match_fbs:
  "no_oif_match fw \<Longrightarrow> list_all (\<lambda>m. oiface (fst (snd m)) = ifaceAny) (map (apfst of_nat) (annotate_rlen (lr_of_tran_fbs rt fw ifs)))"
 proof(goal_cases)
   case 1
   have c: "\<And>mr ar mf af f a. \<lbrakk>(mr, ar) \<in> set (lr_of_tran_s1 rt); (mf, af) \<in> simple_rule_dtor ` set fw; simple_match_and mr mf = Some a\<rbrakk> \<Longrightarrow> oiface a = ifaceAny"
   proof(goal_cases)
     case (1 mr ar mf af f a)
     have "oiface mr = ifaceAny" using 1(1) unfolding lr_of_tran_s1_def route2match_def by(clarsimp simp add: Set.image_iff)
     moreover have "oiface mf = ifaceAny" using 1(2) \<open>no_oif_match fw\<close> unfolding no_oif_match_def simple_rule_dtor_def[abs_def]
       by(clarsimp simp: list_all_iff split: simple_rule.splits) fastforce 
     ultimately show ?case using 1(3) by(cases a; cases mr; cases mf) (simp add: iface_conjunct_ifaceAny split: option.splits)
   qed
   have la: "list_all (\<lambda>m. oiface (fst m) = ifaceAny) (lr_of_tran_fbs rt fw ifs)"
     unfolding lr_of_tran_fbs_def Let_def list_all_iff
     apply(clarify)
     apply(subst(asm) generalized_sfw_join_set)
     apply(clarsimp)
   using c by blast
   thus ?case
   proof(goal_cases)
     case 1
     have *: "(\<lambda>m. oiface (fst (snd m)) = ifaceAny) = (\<lambda>m. oiface (fst m) = ifaceAny) \<circ> snd" unfolding comp_def ..
     show ?case unfolding * list_all_map[symmetric] map_snd_apfst map_snd_annotate_rlen using la .
   qed
 qed
 
 
 lemma lr_of_tran_correct:
 	fixes p :: "(32, 'a) simple_packet_ext_scheme"
 assumes nerr: "lr_of_tran rt fw ifs = Inr oft"
 	 and ippkt: "p_l2type p = 0x800"
 	 and ifvld: "p_iiface p \<in> set ifs"
 	shows "OF_priority_match OF_match_fields_safe oft p = Action [Forward oif] \<longleftrightarrow> simple_linux_router_nol12 rt fw p = (Some (p\<lparr>p_oiface := oif\<rparr>))"
 	      "OF_priority_match OF_match_fields_safe oft p = Action [] \<longleftrightarrow> simple_linux_router_nol12 rt fw p = None"
 	      (* fun stuff: *)
 	      "OF_priority_match OF_match_fields_safe oft p \<noteq> NoAction" "OF_priority_match OF_match_fields_safe oft p \<noteq> Undefined"
 	      "OF_priority_match OF_match_fields_safe oft p = Action ls \<longrightarrow> length ls \<le> 1"
 	      "\<exists>ls. length ls \<le> 1 \<and> OF_priority_match OF_match_fields_safe oft p = Action ls"
 proof -
 	have s1: "valid_prefixes rt" "has_default_route rt" 
    and s2: "has_default_policy fw" "simple_fw_valid fw" "no_oif_match fw"
    and difs: "distinct ifs"
 	  using nerr unfolding lr_of_tran_def by(simp_all split: if_splits)
   have "no_oif_match fw" using nerr unfolding lr_of_tran_def by(simp split: if_splits)
   note s2 = s2 this
   have unsafe_safe_eq: 
     "OF_priority_match OF_match_fields_unsafe oft = OF_priority_match OF_match_fields_safe oft"
     "OF_match_linear OF_match_fields_unsafe oft = OF_match_linear OF_match_fields_safe oft"
     apply(subst OF_unsafe_safe_match3_eq; (rule lr_of_tran_prereqs s1 s2 nerr refl)+)
     apply(subst OF_unsafe_safe_match_linear_eq; (rule lr_of_tran_prereqs s1 s2 nerr refl)+)
   done
   have lin: "OF_priority_match OF_match_fields_safe oft = OF_match_linear OF_match_fields_safe oft"
     using OF_eq[OF lr_of_tran_no_overlaps lr_of_tran_sorted_descending, OF difs nerr[symmetric] nerr[symmetric]] unfolding fun_eq_iff unsafe_safe_eq by metis
   let ?ard = "map (apfst of_nat) (annotate_rlen (lr_of_tran_fbs rt fw ifs))"
   have oft_def: "oft = pack_OF_entries ifs ?ard" using nerr unfolding lr_of_tran_def Let_def by(simp split: if_splits)
   have vld: "list_all simple_match_valid (map (fst \<circ> snd) ?ard)"
     unfolding fun_app_def map_map[symmetric] snd_apfst map_snd_apfst map_snd_annotate_rlen using simple_match_valid_fbs[OF s1(1) s2(2)] .
   have *: "list_all (\<lambda>m. oiface (fst (snd m)) = ifaceAny) ?ard" using no_oif_match_fbs[OF s2(3)] .
   have not_undec: "\<And>p. simple_fw fw p \<noteq> Undecided" by (metis has_default_policy s2(1) state.simps(3))
   have w1_1: "\<And>oif. OF_match_linear OF_match_fields_safe oft p = Action [Forward oif] \<Longrightarrow> simple_linux_router_nol12 rt fw p = Some (p\<lparr>p_oiface := oif\<rparr>) 
     \<and> oif = output_iface (routing_table_semantics rt (p_dst p))"
   proof(intro conjI, goal_cases)
     case (1 oif)
     note s3_correct[OF vld ippkt ifvld(1) *, THEN iffD1, unfolded oft_def[symmetric], OF 1]
     hence "\<exists>r. generalized_sfw (map snd (map (apfst of_nat) (annotate_rlen (lr_of_tran_fbs rt fw ifs)))) p = Some (r, (oif, simple_action.Accept))"
       by(clarsimp split: if_splits)
     then obtain r where "generalized_sfw (lr_of_tran_fbs rt fw ifs) p = Some (r, (oif, simple_action.Accept))" 
       unfolding map_map comp_def snd_apfst map_snd_annotate_rlen by blast
     thus ?case using lr_of_tran_fbs_acceptD[OF s1 s2(3)] by metis
     thus "oif = output_iface (routing_table_semantics rt (p_dst p))"
       by(cases p) (clarsimp simp: simple_linux_router_nol12_def Let_def not_undec split: Option.bind_splits state.splits final_decision.splits) 
   qed
   have w1_2: "\<And>oif. simple_linux_router_nol12 rt fw p = Some (p\<lparr>p_oiface := oif\<rparr>) \<Longrightarrow> OF_match_linear OF_match_fields_safe oft p = Action [Forward oif]"
   proof(goal_cases)
     case (1 oif)
     note lr_of_tran_fbs_acceptI[OF s1 s2(3) s2(1) this, of ifs] then guess r .. note r = this
     hence "generalized_sfw (map snd (map (apfst of_nat) (annotate_rlen (lr_of_tran_fbs rt fw ifs)))) p = Some (r, (oif, simple_action.Accept))" 
     unfolding map_snd_apfst map_snd_annotate_rlen .
     moreover note s3_correct[OF vld ippkt ifvld(1) *, THEN iffD2, unfolded oft_def[symmetric], of "[Forward oif]"]
     ultimately show ?case by simp
   qed
   show w1: "\<And>oif. (OF_priority_match OF_match_fields_safe oft p = Action [Forward oif]) = (simple_linux_router_nol12 rt fw p = Some (p\<lparr>p_oiface := oif\<rparr>))"
     unfolding lin using w1_1 w1_2 by blast
   show w2: "(OF_priority_match OF_match_fields_safe oft p = Action []) = (simple_linux_router_nol12 rt fw p = None)"
   unfolding lin
   proof(rule iffI, goal_cases)
     case 1
     note s3_correct[OF vld ippkt ifvld(1) *, THEN iffD1, unfolded oft_def[symmetric], OF 1]
     then obtain r oif where roif: "generalized_sfw (lr_of_tran_fbs rt fw ifs) p = Some (r, oif, simple_action.Drop)"
       unfolding map_snd_apfst map_snd_annotate_rlen by(clarsimp split: if_splits)
     note lr_of_tran_fbs_dropD[OF s1 s2(3) this]
     thus ?case .
   next
     case 2 
     note lr_of_tran_fbs_dropI[OF s1 s2(3) s2(1) this, of ifs] then 
     obtain r oif where "generalized_sfw (lr_of_tran_fbs rt fw ifs) p = Some (r, oif, simple_action.Drop)" by blast
     hence "generalized_sfw (map snd (map (apfst of_nat) (annotate_rlen (lr_of_tran_fbs rt fw ifs)))) p = Some (r, oif, simple_action.Drop)" 
       unfolding map_snd_apfst map_snd_annotate_rlen .
     moreover note s3_correct[OF vld ippkt ifvld(1) *, THEN iffD2, unfolded oft_def[symmetric], of "[]"]
     ultimately show ?case by force
   qed
   have lr_determ: "\<And>a. simple_linux_router_nol12 rt fw p = Some a \<Longrightarrow> a = p\<lparr>p_oiface := output_iface (routing_table_semantics rt (p_dst p))\<rparr>"
     by(clarsimp simp: simple_linux_router_nol12_def Let_def not_undec split: Option.bind_splits state.splits final_decision.splits)
   show notno: "OF_priority_match OF_match_fields_safe oft p \<noteq> NoAction"
     apply(cases "simple_linux_router_nol12 rt fw p")
     using w2 apply(simp)
     using w1[of "output_iface (routing_table_semantics rt (p_dst p))"] apply(simp)
     apply(drule lr_determ)
     apply(simp)
   done
   show notub: "OF_priority_match OF_match_fields_safe oft p \<noteq> Undefined" unfolding lin using OF_match_linear_ne_Undefined .
   show notmult: "\<And>ls. OF_priority_match OF_match_fields_safe oft p = Action ls \<longrightarrow> length ls \<le> 1"
   apply(cases "simple_linux_router_nol12 rt fw p")
     using w2 apply(simp)
     using w1[of "output_iface (routing_table_semantics rt (p_dst p))"] apply(simp)
     apply(drule lr_determ)
     apply(clarsimp)
   done
   show "\<exists>ls. length ls \<le> 1 \<and> OF_priority_match OF_match_fields_safe oft p = Action ls"
     apply(cases "OF_priority_match OF_match_fields_safe oft p")
     using notmult apply blast
     using notno   apply blast
     using notub   apply blast
   done
 qed
 
 end
diff --git a/thys/Word_Lib/Aligned.thy b/thys/Word_Lib/Aligned.thy
--- a/thys/Word_Lib/Aligned.thy
+++ b/thys/Word_Lib/Aligned.thy
@@ -1,865 +1,865 @@
 (*
  * Copyright 2014, NICTA
  *
  * This software may be distributed and modified according to the terms of
  * the BSD 2-Clause license. Note that NO WARRANTY is provided.
  * See "LICENSE_BSD2.txt" for details.
  *
  * @TAG(NICTA_BSD)
  *)
 
 section "Word Alignment"
 
 theory Aligned
 imports
   Word_Lib
   HOL_Lemmas
   More_Divides
 begin
 
 
 definition
   is_aligned :: "'a :: len word \<Rightarrow> nat \<Rightarrow> bool" where
   "is_aligned ptr n \<equiv> 2^n dvd unat ptr"
 
 
 lemma is_aligned_mask: "(is_aligned w n) = (w && mask n = 0)"
   unfolding is_aligned_def by (rule and_mask_dvd_nat)
 
 
 lemma is_aligned_to_bl:
   "is_aligned (w :: 'a :: len word) n = (True \<notin> set (drop (size w - n) (to_bl w)))"
   apply (simp add: is_aligned_mask eq_zero_set_bl)
   apply (clarsimp simp: in_set_conv_nth word_size)
   apply (simp add: to_bl_nth word_size cong: conj_cong)
   apply (simp add: diff_diff_less)
   apply safe
    apply (case_tac "n \<le> LENGTH('a)")
     prefer 2
     apply (rule_tac x=i in exI)
     apply clarsimp
    apply (subgoal_tac "\<exists>j < LENGTH('a). j < n \<and> LENGTH('a) - n + j = i")
     apply (erule exE)
     apply (rule_tac x=j in exI)
     apply clarsimp
    apply (thin_tac "w !! t" for t)
    apply (rule_tac x="i + n - LENGTH('a)" in exI)
    apply clarsimp
    apply arith
   apply (rule_tac x="LENGTH('a) - n + i" in exI)
   apply clarsimp
   apply arith
   done
 
 lemma unat_power_lower [simp]:
   assumes nv: "n < LENGTH('a::len)"
   shows "unat ((2::'a::len word) ^ n) = 2 ^ n"
   by (simp add: assms nat_power_eq uint_2p_alt unat_def)
 
 lemma power_overflow:
   "n \<ge> LENGTH('a) \<Longrightarrow> 2 ^ n = (0 :: 'a::len word)"
   by simp
 
 lemma is_alignedI [intro?]:
   fixes x::"'a::len word"
   assumes xv: "x = 2 ^ n * k"
   shows   "is_aligned x n"
 proof cases
   assume nv: "n < LENGTH('a)"
   show ?thesis
     unfolding is_aligned_def
   proof (rule dvdI [where k = "unat k mod 2 ^ (LENGTH('a) - n)"])
     from xv
     have "unat x = (unat (2::word32) ^ n * unat k) mod 2 ^ LENGTH('a)"
       using nv
       by (subst (asm) word_unat.Rep_inject [symmetric], simp,
           subst unat_word_ariths, simp)
 
     also have "\<dots> =  2 ^ n * (unat k mod 2 ^ (LENGTH('a) - n))" using nv
       by (simp add: mult_mod_right power_add [symmetric] add_diff_inverse)
 
     finally show "unat x = 2 ^ n * (unat k mod 2 ^ (LENGTH('a) - n))" .
   qed
 next
   assume "\<not> n < LENGTH('a)"
   with xv
   show ?thesis by (simp add: not_less power_overflow is_aligned_def)
 qed
 
 lemma is_aligned_weaken:
   "\<lbrakk> is_aligned w x; x \<ge> y \<rbrakk> \<Longrightarrow> is_aligned w y"
   unfolding is_aligned_def
   by (erule dvd_trans [rotated]) (simp add: le_imp_power_dvd)
 
 lemma nat_power_less_diff:
   assumes lt: "(2::nat) ^ n * q < 2 ^ m"
   shows "q < 2 ^ (m - n)"
   using lt
 proof (induct n arbitrary: m)
   case 0
   then show ?case by simp
 next
   case (Suc n)
 
   have ih: "\<And>m. 2 ^ n * q < 2 ^ m \<Longrightarrow> q < 2 ^ (m - n)"
     and prem: "2 ^ Suc n * q < 2 ^ m" by fact+
 
   show ?case
   proof (cases m)
     case 0
     then show ?thesis using Suc by simp
   next
     case (Suc m')
     then show ?thesis using prem
       by (simp add: ac_simps ih)
   qed
 qed
 
 lemma is_alignedE_pre:
   fixes w::"'a::len word"
   assumes aligned: "is_aligned w n"
   shows        rl: "\<exists>q. w = 2 ^ n * (of_nat q) \<and> q < 2 ^ (LENGTH('a) - n)"
 proof -
   from aligned obtain q where wv: "unat w = 2 ^ n * q"
     unfolding is_aligned_def ..
 
   show ?thesis
   proof (rule exI, intro conjI)
     show "q < 2 ^ (LENGTH('a) - n)"
     proof (rule nat_power_less_diff)
       have "unat w < 2 ^ size w" unfolding word_size ..
       then have "unat w < 2 ^ LENGTH('a)" by simp
       with wv show "2 ^ n * q < 2 ^ LENGTH('a)" by simp
     qed
 
     have r: "of_nat (2 ^ n) = (2::word32) ^ n"
       by (induct n) simp+
 
     from wv have "of_nat (unat w) = of_nat (2 ^ n * q)" by simp
     then have "w = of_nat (2 ^ n * q)" by (subst word_unat.Rep_inverse [symmetric])
     then show "w = 2 ^ n * (of_nat q)" by (simp add: r)
   qed
 qed
 
 lemma is_alignedE:
   "\<lbrakk>is_aligned (w::'a::len word) n;
     \<And>q. \<lbrakk>w = 2 ^ n * (of_nat q); q < 2 ^ (LENGTH('a) - n)\<rbrakk> \<Longrightarrow> R\<rbrakk> \<Longrightarrow> R"
   by (auto dest: is_alignedE_pre)
 
 lemma is_aligned_replicate:
   fixes w::"'a::len word"
   assumes aligned: "is_aligned w n"
   and          nv: "n \<le> LENGTH('a)"
   shows   "to_bl w = (take (LENGTH('a) - n) (to_bl w)) @ replicate n False"
 proof -
   from nv have rl: "\<And>q. q < 2 ^ (LENGTH('a) - n) \<Longrightarrow>
       to_bl (2 ^ n * (of_nat q :: 'a word)) =
       drop n (to_bl (of_nat q :: 'a word)) @ replicate n False"
     by (metis bl_shiftl le_antisym min_def shiftl_t2n wsst_TYs(3))
   show ?thesis using aligned
     by (auto simp: rl elim: is_alignedE)
 qed
 
 lemma is_aligned_drop:
   fixes w::"'a::len word"
   assumes "is_aligned w n" "n \<le> LENGTH('a)"
   shows "drop (LENGTH('a) - n) (to_bl w) = replicate n False"
 proof -
   have "to_bl w = take (LENGTH('a) - n) (to_bl w) @ replicate n False"
     by (rule is_aligned_replicate) fact+
   then have "drop (LENGTH('a) - n) (to_bl w) = drop (LENGTH('a) - n) \<dots>" by simp
   also have "\<dots> = replicate n False" by simp
   finally show ?thesis .
 qed
 
 lemma less_is_drop_replicate:
   fixes x::"'a::len word"
   assumes lt: "x < 2 ^ n"
   shows   "to_bl x = replicate (LENGTH('a) - n) False @ drop (LENGTH('a) - n) (to_bl x)"
   by (metis assms bl_and_mask' less_mask_eq)
 
 lemma is_aligned_add_conv:
   fixes off::"'a::len word"
   assumes aligned: "is_aligned w n"
   and        offv: "off < 2 ^ n"
   shows    "to_bl (w + off) =
    (take (LENGTH('a) - n) (to_bl w)) @ (drop (LENGTH('a) - n) (to_bl off))"
 proof cases
   assume nv: "n \<le> LENGTH('a)"
   show ?thesis
   proof (subst aligned_bl_add_size, simp_all only: word_size)
     show "drop (LENGTH('a) - n) (to_bl w) = replicate n False"
       by (subst is_aligned_replicate [OF aligned nv]) (simp add: word_size)
 
     from offv show "take (LENGTH('a) - n) (to_bl off) =
                     replicate (LENGTH('a) - n) False"
       by (subst less_is_drop_replicate, assumption) simp
   qed fact
 next
   assume "\<not> n \<le> LENGTH('a)"
   with offv show ?thesis by (simp add: power_overflow)
 qed
 
 lemma aligned_add_aligned:
   fixes x::"'a::len word"
   assumes aligned1: "is_aligned x n"
   and     aligned2: "is_aligned y m"
   and           lt: "m \<le> n"
   shows   "is_aligned (x + y) m"
 proof cases
   assume nlt: "n < LENGTH('a)"
   show ?thesis
     unfolding is_aligned_def dvd_def
   proof -
     from aligned2 obtain q2 where yv: "y = 2 ^ m * of_nat q2"
       and q2v: "q2 < 2 ^ (LENGTH('a) - m)"
       by (auto elim: is_alignedE)
 
     from lt obtain k where kv: "m + k = n" by (auto simp: le_iff_add)
     with aligned1 obtain q1 where xv: "x = 2 ^ (m + k) * of_nat q1"
       and q1v: "q1 < 2 ^ (LENGTH('a) - (m + k))"
       by (auto elim: is_alignedE)
 
     have l1: "2 ^ (m + k) * q1 < 2 ^ LENGTH('a)"
       by (rule nat_less_power_trans [OF q1v])
          (subst kv, rule order_less_imp_le [OF nlt])
 
     have l2: "2 ^ m * q2 < 2 ^ LENGTH('a)"
       by (rule nat_less_power_trans [OF q2v],
           rule order_less_imp_le [OF order_le_less_trans])
          fact+
 
     have "x = of_nat (2 ^ (m + k) *  q1)" using xv
       by simp
 
     moreover have "y = of_nat (2 ^ m * q2)" using yv
       by simp
 
     ultimately have upls: "unat x + unat y = 2 ^ m * (2 ^ k * q1 + q2)"
     proof -
       have f1: "unat x = 2 ^ (m + k) * q1"
         by (metis (no_types) \<open>x = of_nat (2 ^ (m + k) * q1)\<close> l1 nat_mod_lem word_unat.inverse_norm
                              zero_less_numeral zero_less_power)
       have "unat y = 2 ^ m * q2"
         by (metis (no_types) \<open>y = of_nat (2 ^ m * q2)\<close> l2 nat_mod_lem word_unat.inverse_norm
                              zero_less_numeral zero_less_power)
       then show ?thesis
         using f1 by (simp add: power_add semiring_normalization_rules(34))
     qed
 
     (* (2 ^ k * q1 + q2) *)
     show "\<exists>d. unat (x + y) = 2 ^ m * d"
     proof (cases "unat x + unat y < 2 ^ LENGTH('a)")
       case True
 
       have "unat (x + y) = unat x + unat y"
         by (subst unat_plus_if', rule if_P) fact
 
       also have "\<dots> = 2 ^ m * (2 ^ k * q1 + q2)" by (rule upls)
       finally show ?thesis ..
     next
       case False
       then have "unat (x + y) = (unat x + unat y) mod 2 ^ LENGTH('a)"
         by (subst unat_word_ariths(1)) simp
 
       also have "\<dots> = (2 ^ m * (2 ^ k * q1 + q2)) mod 2 ^ LENGTH('a)"
         by (subst upls, rule refl)
 
       also
       have "\<dots> = 2 ^ m * ((2 ^ k * q1 +  q2) mod 2 ^ (LENGTH('a) - m))"
       proof -
         have "m \<le> len_of (TYPE('a))"
           by (meson le_trans less_imp_le_nat lt nlt)
         then show ?thesis
           by (metis mult_mod_right ordered_cancel_comm_monoid_diff_class.add_diff_inverse power_add)
       qed
 
       finally show ?thesis ..
     qed
   qed
 next
   assume "\<not> n < LENGTH('a)"
   with assms
   show ?thesis by (simp add: not_less power_overflow is_aligned_mask mask_def)
 qed
 
 corollary aligned_sub_aligned:
   "\<lbrakk>is_aligned (x::'a::len word) n; is_aligned y m; m \<le> n\<rbrakk>
    \<Longrightarrow> is_aligned (x - y) m"
   apply (simp del: add_uminus_conv_diff add:diff_conv_add_uminus)
   apply (erule aligned_add_aligned, simp_all)
   apply (erule is_alignedE)
   apply (rule_tac k="- of_nat q" in is_alignedI)
   apply simp
   done
 
 lemma is_aligned_shift:
   fixes k::"'a::len word"
   shows "is_aligned (k << m) m"
 proof cases
   assume mv: "m < LENGTH('a)"
   from mv obtain q where mq: "m + q = LENGTH('a)" and "0 < q"
     by (auto dest: less_imp_add_positive)
 
   have "(2::nat) ^ m dvd unat (k << m)"
   proof
     have kv: "(unat k div 2 ^ q) * 2 ^ q + unat k mod 2 ^ q = unat k"
       by (rule div_mult_mod_eq)
 
     have "unat (k << m) = unat (2 ^ m * k)" by (simp add: shiftl_t2n)
     also have "\<dots> = (2 ^ m * unat k) mod (2 ^ LENGTH('a))" using mv
       by (subst unat_word_ariths(2))+ simp
     also have "\<dots> = 2 ^ m * (unat k mod 2 ^ q)"
       by (subst mq [symmetric], subst power_add, subst mod_mult2_eq) simp
     finally show "unat (k << m) = 2 ^ m * (unat k mod 2 ^ q)" .
   qed
 
   then show ?thesis by (unfold is_aligned_def)
 next
   assume "\<not> m < LENGTH('a)"
   then show ?thesis
     by (simp add: not_less power_overflow is_aligned_mask mask_def
                   shiftl_zero_size word_size)
 qed
 
 lemma word_mod_by_0: "k mod (0::'a::len word) = k"
   by (simp add: word_arith_nat_mod)
 
 lemma aligned_mod_eq_0:
   fixes p::"'a::len word"
   assumes al: "is_aligned p sz"
   shows   "p mod 2 ^ sz = 0"
 proof cases
   assume szv: "sz < LENGTH('a)"
   with al
   show ?thesis
     unfolding is_aligned_def
     by (simp add: and_mask_dvd_nat p2_gt_0 word_mod_2p_is_mask)
 next
   assume "\<not> sz < LENGTH('a)"
   with al show ?thesis
     by (simp add: not_less power_overflow is_aligned_mask mask_def word_mod_by_0)
 qed
 
 lemma is_aligned_triv: "is_aligned (2 ^ n ::'a::len word) n"
   by (rule is_alignedI [where k = 1], simp)
 
 lemma is_aligned_mult_triv1: "is_aligned (2 ^ n * x  ::'a::len word) n"
   by (rule is_alignedI [OF refl])
 
 lemma is_aligned_mult_triv2: "is_aligned (x * 2 ^ n ::'a::len word) n"
   by (subst mult.commute, simp add: is_aligned_mult_triv1)
 
 lemma word_power_less_0_is_0:
   fixes x :: "'a::len word"
   shows "x < a ^ 0 \<Longrightarrow> x = 0" by simp
 
 lemma nat_add_offset_less:
   fixes x :: nat
   assumes yv: "y < 2 ^ n"
   and     xv: "x < 2 ^ m"
   and     mn: "sz = m + n"
   shows   "x * 2 ^ n + y < 2 ^ sz"
 proof (subst mn)
   from yv obtain qy where "y + qy = 2 ^ n" and "0 < qy"
     by (auto dest: less_imp_add_positive)
 
   have "x * 2 ^ n + y < x * 2 ^ n + 2 ^ n" by simp fact+
   also have "\<dots> = (x + 1) * 2 ^ n" by simp
   also have "\<dots> \<le> 2 ^ (m + n)" using xv
     by (subst power_add) (rule mult_le_mono1, simp)
   finally show "x * 2 ^ n + y < 2 ^ (m + n)" .
 qed
 
 lemma is_aligned_no_wrap:
   fixes off :: "'a::len word"
   fixes ptr :: "'a::len word"
   assumes al: "is_aligned ptr sz"
   and    off: "off < 2 ^ sz"
   shows  "unat ptr + unat off < 2 ^ LENGTH('a)"
 proof -
   have szv: "sz < LENGTH('a)"
   using off p2_gt_0 word_neq_0_conv by fastforce
 
   from al obtain q where ptrq: "ptr = 2 ^ sz * of_nat q" and
     qv: "q < 2 ^ (LENGTH('a) - sz)" by (auto elim: is_alignedE)
 
   show ?thesis
   proof (cases "sz = 0")
     case True
     then show ?thesis using off ptrq qv by clarsimp
   next
     case False
     then have sne: "0 < sz" ..
 
     show ?thesis
     proof -
       have uq: "unat (of_nat q ::'a::len word) = q"
         apply (subst unat_of_nat)
         apply (rule mod_less)
         apply (rule order_less_trans [OF qv])
         apply (rule power_strict_increasing [OF diff_less [OF sne]])
          apply (simp_all)
         done
 
       have uptr: "unat ptr = 2 ^ sz * q"
         apply (subst ptrq)
         apply (subst iffD1 [OF unat_mult_lem])
          apply (subst unat_power_lower [OF szv])
          apply (subst uq)
          apply (rule nat_less_power_trans [OF qv order_less_imp_le [OF szv]])
         apply (subst uq)
         apply (subst unat_power_lower [OF szv])
         apply simp
         done
 
       show "unat ptr + unat off < 2 ^ LENGTH('a)" using szv
         apply (subst uptr)
         apply (subst mult.commute, rule nat_add_offset_less [OF _ qv])
         apply (rule order_less_le_trans [OF unat_mono [OF off] order_eq_refl])
          apply simp_all
         done
     qed
   qed
 qed
 
 lemma is_aligned_no_wrap':
   fixes ptr :: "'a::len word"
   assumes al: "is_aligned ptr sz"
   and    off: "off < 2 ^ sz"
   shows  "ptr \<le> ptr + off"
   by (subst no_plus_overflow_unat_size, subst word_size, rule is_aligned_no_wrap) fact+
 
 lemma is_aligned_no_overflow':
   fixes p :: "'a::len word"
   assumes al: "is_aligned p n"
   shows "p \<le> p + (2 ^ n - 1)"
 proof cases
   assume "n<LENGTH('a)"
   with al
   have "2^n - (1::'a::len word) < 2^n"
     by (simp add: word_less_nat_alt unat_sub_if_size)
   with al
   show ?thesis by (rule is_aligned_no_wrap')
 next
   assume "\<not> n<LENGTH('a)"
   with al
   show ?thesis
   by (simp add: not_less power_overflow is_aligned_mask mask_2pm1)
 qed
 
 lemma is_aligned_no_overflow:
   "is_aligned ptr sz \<Longrightarrow> ptr \<le> ptr + 2^sz - 1"
   by (drule is_aligned_no_overflow') (simp add: field_simps)
 
 lemma replicate_not_True:
   "\<And>n. xs = replicate n False \<Longrightarrow> True \<notin> set xs"
   by (induct xs) auto
 
 lemma is_aligned_replicateI:
   "to_bl p = addr @ replicate n False \<Longrightarrow> is_aligned (p::'a::len word) n"
   apply (simp add: is_aligned_to_bl word_size)
   apply (subgoal_tac "length addr = LENGTH('a) - n")
    apply (simp add: replicate_not_True)
   apply (drule arg_cong [where f=length])
   apply simp
   done
 
 lemma to_bl_2p:
   "n < LENGTH('a) \<Longrightarrow>
    to_bl ((2::'a::len word) ^ n) =
    replicate (LENGTH('a) - Suc n) False @ True # replicate n False"
   apply (subst shiftl_1 [symmetric])
   apply (subst bl_shiftl)
   apply (simp add: to_bl_1 min_def word_size)
   done
 
 lemma map_zip_replicate_False_xor:
   "n = length xs \<Longrightarrow> map (\<lambda>(x, y). x = (\<not> y)) (zip xs (replicate n False)) = xs"
   by (induct xs arbitrary: n, auto)
 
 lemma drop_minus_lem:
   "\<lbrakk> n \<le> length xs; 0 < n; n' = length xs \<rbrakk> \<Longrightarrow> drop (n' - n) xs = rev xs ! (n - 1)  # drop (Suc (n' - n)) xs"
 proof (induct xs arbitrary: n n')
   case Nil then show ?case by simp
 next
   case (Cons y ys)
   from Cons.prems
   show ?case
     apply simp
     apply (cases "n = Suc (length ys)")
      apply (simp add: nth_append)
     apply (simp add: Suc_diff_le Cons.hyps nth_append)
     apply clarsimp
     apply arith
     done
 qed
 
 lemma drop_minus:
   "\<lbrakk> n < length xs; n' = length xs \<rbrakk> \<Longrightarrow> drop (n' - Suc n) xs = rev xs ! n  # drop (n' - n) xs"
   apply (subst drop_minus_lem)
      apply simp
     apply simp
    apply simp
   apply simp
   apply (cases "length xs", simp)
   apply (simp add: Suc_diff_le)
   done
 
 lemma xor_2p_to_bl:
   fixes x::"'a::len word"
   shows "to_bl (x xor 2^n) =
   (if n < LENGTH('a)
    then take (LENGTH('a)-Suc n) (to_bl x) @ (\<not>rev (to_bl x)!n) # drop (LENGTH('a)-n) (to_bl x)
    else to_bl x)"
 proof -
   have x: "to_bl x = take (LENGTH('a)-Suc n) (to_bl x) @ drop (LENGTH('a)-Suc n) (to_bl x)"
     by simp
 
   show ?thesis
   apply simp
   apply (rule conjI)
    apply (clarsimp simp: word_size)
    apply (simp add: bl_word_xor to_bl_2p)
    apply (subst x)
    apply (subst zip_append)
     apply simp
    apply (simp add: map_zip_replicate_False_xor drop_minus)
   apply (auto simp add: word_size nth_w2p intro!: word_eqI)
   done
 qed
 
 lemma aligned_add_xor:
   assumes al: "is_aligned (x::'a::len word) n'" and le: "n < n'"
   shows "(x + 2^n) xor 2^n = x"
 proof cases
   assume "n' < LENGTH('a)"
   with assms show ?thesis
   apply -
   apply (rule word_bl.Rep_eqD)
   apply (subst xor_2p_to_bl)
   apply simp
   apply (subst is_aligned_add_conv, simp, simp add: word_less_nat_alt)+
   apply (simp add: to_bl_2p nth_append)
   apply (cases "n' = Suc n")
    apply simp
    apply (subst is_aligned_replicate [where n="Suc n", simplified, symmetric]; simp)
   apply (subgoal_tac "\<not> LENGTH('a) - Suc n \<le> LENGTH('a) - n'")
    prefer 2
    apply arith
   apply (subst replicate_Suc [symmetric])
   apply (subst replicate_add [symmetric])
   apply (simp add: is_aligned_replicate [simplified, symmetric])
   done
 next
   assume "\<not> n' < LENGTH('a)"
   with al show ?thesis
     by (simp add: is_aligned_mask mask_def not_less power_overflow)
 qed
 
 lemma is_aligned_0 [simp]:
   "is_aligned p 0"
   by (simp add: is_aligned_def)
 
 lemma is_aligned_replicateD:
   "\<lbrakk> is_aligned (w::'a::len word) n; n \<le> LENGTH('a) \<rbrakk>
      \<Longrightarrow> \<exists>xs. to_bl w = xs @ replicate n False
                \<and> length xs = size w - n"
   apply (subst is_aligned_replicate, assumption+)
   apply (rule exI, rule conjI, rule refl)
   apply (simp add: word_size)
   done
 
 lemma is_aligned_add_mult_multI:
   fixes p :: "'a::len word"
   shows "\<lbrakk>is_aligned p m; n \<le> m; n' = n\<rbrakk> \<Longrightarrow> is_aligned (p + x * 2 ^ n * z) n'"
   apply (erule aligned_add_aligned)
   apply (auto intro: is_alignedI [where k="x*z"])
   done
 
 lemma is_aligned_add_multI:
   fixes p :: "'a::len word"
   shows "\<lbrakk>is_aligned p m; n \<le> m; n' = n\<rbrakk> \<Longrightarrow> is_aligned (p + x * 2 ^ n) n'"
   apply (erule aligned_add_aligned)
   apply (auto intro: is_alignedI [where k="x"])
   done
 
 lemma unat_of_nat_len:
   "x < 2 ^ LENGTH('a) \<Longrightarrow> unat (of_nat x :: 'a::len word) = x"
   by (simp add: word_size unat_of_nat)
 
 lemma is_aligned_no_wrap''':
   fixes ptr :: "'a::len word"
   shows"\<lbrakk> is_aligned ptr sz; sz < LENGTH('a); off < 2 ^ sz \<rbrakk>
          \<Longrightarrow> unat ptr + off < 2 ^ LENGTH('a)"
   apply (drule is_aligned_no_wrap[where off="of_nat off"])
    apply (simp add: word_less_nat_alt)
    apply (erule order_le_less_trans[rotated])
    apply (subst unat_of_nat)
    apply (rule mod_less_eq_dividend)
   apply (subst(asm) unat_of_nat_len)
    apply (erule order_less_trans)
    apply (erule power_strict_increasing)
    apply simp
   apply assumption
   done
 
 lemma is_aligned_get_word_bits:
   fixes p :: "'a::len word"
   shows "\<lbrakk> is_aligned p n; \<lbrakk> is_aligned p n; n < LENGTH('a) \<rbrakk> \<Longrightarrow> P;
            \<lbrakk> p = 0; n \<ge> LENGTH('a) \<rbrakk> \<Longrightarrow> P \<rbrakk> \<Longrightarrow> P"
   apply (cases "n < LENGTH('a)")
    apply simp
   apply simp
   apply (erule meta_mp)
   apply (clarsimp simp: is_aligned_mask mask_def power_add
                         power_overflow)
   done
 
 lemma aligned_small_is_0:
   "\<lbrakk> is_aligned x n; x < 2 ^ n \<rbrakk> \<Longrightarrow> x = 0"
   apply (erule is_aligned_get_word_bits)
    apply (frule is_aligned_add_conv [rotated, where w=0])
     apply (simp add: is_aligned_def)
    apply simp
    apply (drule is_aligned_replicateD)
     apply simp
    apply (clarsimp simp: word_size)
    apply (subst (asm) replicate_add [symmetric])
    apply (drule arg_cong[where f="of_bl :: bool list \<Rightarrow> 'a::len word"])
    apply simp
   apply (simp only: replicate.simps[symmetric, where x=False]
                     drop_replicate)
   done
 
 corollary is_aligned_less_sz:
   "\<lbrakk>is_aligned a sz; a \<noteq> 0\<rbrakk> \<Longrightarrow> \<not> a < 2 ^ sz"
   by (rule notI, drule(1) aligned_small_is_0, erule(1) notE)
 
 lemma aligned_at_least_t2n_diff:
   "\<lbrakk>is_aligned x n; is_aligned y n; x < y\<rbrakk> \<Longrightarrow> x \<le> y - 2 ^ n"
   apply (erule is_aligned_get_word_bits[where p=y])
    apply (rule ccontr)
    apply (clarsimp simp: linorder_not_le)
    apply (subgoal_tac "y - x = 0")
     apply clarsimp
    apply (rule aligned_small_is_0)
     apply (erule(1) aligned_sub_aligned)
     apply simp
    apply unat_arith
   apply simp
   done
 
 lemma word_sub_1_le:
   "x \<noteq> 0 \<Longrightarrow> x - 1 \<le> (x :: ('a :: len) word)"
   apply (subst no_ulen_sub)
   apply simp
   apply (cases "uint x = 0")
    apply (simp add: uint_0_iff)
   apply (insert uint_ge_0[where x=x])
   apply arith
   done
 
 lemma is_aligned_no_overflow'':
   "\<lbrakk>is_aligned x n; x + 2 ^ n \<noteq> 0\<rbrakk> \<Longrightarrow> x \<le> x + 2 ^ n"
   apply (frule is_aligned_no_overflow')
   apply (erule order_trans)
   apply (simp add: field_simps)
   apply (erule word_sub_1_le)
   done
 
 lemma is_aligned_nth:
   "is_aligned p m = (\<forall>n < m. \<not>p !! n)"
   apply (clarsimp simp: is_aligned_mask bang_eq word_size)
   apply (rule iffI)
    apply clarsimp
    apply (case_tac "n < size p")
     apply (simp add: word_size)
    apply (drule test_bit_size)
    apply simp
   apply clarsimp
   done
 
 lemma range_inter:
   "({a..b} \<inter> {c..d} = {}) = (\<forall>x. \<not>(a \<le> x \<and> x \<le> b \<and> c \<le> x \<and> x \<le> d))"
   by auto
 
 lemma aligned_inter_non_empty:
   "\<lbrakk> {p..p + (2 ^ n - 1)} \<inter> {p..p + 2 ^ m - 1} = {};
      is_aligned p n; is_aligned p m\<rbrakk> \<Longrightarrow> False"
   apply (clarsimp simp only: range_inter)
   apply (erule_tac x=p in allE)
   apply simp
   apply (erule impE)
    apply (erule is_aligned_no_overflow')
   apply (erule notE)
   apply (erule is_aligned_no_overflow)
   done
 
 lemma not_aligned_mod_nz:
   assumes al: "\<not> is_aligned a n"
   shows "a mod 2 ^ n \<noteq> 0"
 proof cases
   assume "n < LENGTH('a)"
   with al
   show ?thesis
     apply (simp add: is_aligned_def dvd_eq_mod_eq_0 word_arith_nat_mod)
     apply (erule of_nat_neq_0)
     apply (rule order_less_trans)
      apply (rule mod_less_divisor)
      apply simp
     apply simp
     done
 next
   assume "\<not> n < LENGTH('a)"
   with al
   show ?thesis
     by (simp add: is_aligned_mask mask_def not_less power_overflow
                   word_less_nat_alt word_mod_by_0)
 qed
 
 lemma nat_add_offset_le:
   fixes x :: nat
   assumes yv: "y \<le> 2 ^ n"
   and     xv: "x < 2 ^ m"
   and     mn: "sz = m + n"
   shows   "x * 2 ^ n + y \<le> 2 ^ sz"
 proof (subst mn)
   from yv obtain qy where "y + qy = 2 ^ n"
     by (auto simp: le_iff_add)
 
   have "x * 2 ^ n + y \<le> x * 2 ^ n + 2 ^ n"
     using yv xv by simp
   also have "\<dots> = (x + 1) * 2 ^ n" by simp
   also have "\<dots> \<le> 2 ^ (m + n)" using xv
     by (subst power_add) (rule mult_le_mono1, simp)
   finally show "x * 2 ^ n + y \<le> 2 ^ (m + n)" .
 qed
 
 lemma is_aligned_no_wrap_le:
   fixes ptr::"'a::len word"
   assumes al: "is_aligned ptr sz"
   and    szv: "sz < LENGTH('a)"
   and    off: "off \<le> 2 ^ sz"
   shows  "unat ptr + off \<le> 2 ^ LENGTH('a)"
 proof -
   from al obtain q where ptrq: "ptr = 2 ^ sz * of_nat q" and
     qv: "q < 2 ^ (LENGTH('a) - sz)" by (auto elim: is_alignedE)
 
   show ?thesis
   proof (cases "sz = 0")
     case True
     then show ?thesis using off ptrq qv
       apply (clarsimp)
       apply (erule le_SucE)
        apply (simp add: unat_of_nat)
       apply (simp add: less_eq_Suc_le [symmetric] unat_of_nat)
       done
   next
     case False
     then have sne: "0 < sz" ..
 
     show ?thesis
     proof -
       have uq: "unat (of_nat q :: 'a word) = q"
         apply (subst unat_of_nat)
         apply (rule mod_less)
         apply (rule order_less_trans [OF qv])
         apply (rule power_strict_increasing [OF diff_less [OF sne]])
         apply simp_all
         done
 
       have uptr: "unat ptr = 2 ^ sz * q"
         apply (subst ptrq)
         apply (subst iffD1 [OF unat_mult_lem])
         apply (subst unat_power_lower [OF szv])
         apply (subst uq)
         apply (rule nat_less_power_trans [OF qv order_less_imp_le [OF szv]])
         apply (subst uq)
         apply (subst unat_power_lower [OF szv])
         apply simp
         done
 
       show "unat ptr + off \<le> 2 ^ LENGTH('a)" using szv
         apply (subst uptr)
         apply (subst mult.commute, rule nat_add_offset_le [OF off qv])
         apply simp
         done
     qed
   qed
 qed
 
 lemma is_aligned_neg_mask:
-  "m \<le> n \<Longrightarrow> is_aligned (x && ~~ mask n) m"
+  "m \<le> n \<Longrightarrow> is_aligned (x && ~~ (mask n)) m"
   by (metis and_not_mask is_aligned_shift is_aligned_weaken)
 
 lemma unat_minus:
   "unat (- (x :: ('a :: len) word))
     = (if x = 0 then 0 else (2 ^ size x) - unat x)"
   using unat_sub_if_size[where x="2 ^ size x" and y=x]
   by (simp add: unat_eq_0 word_size)
 
 lemma is_aligned_minus:
   "is_aligned p n \<Longrightarrow> is_aligned (- p) n"
   apply (clarsimp simp: is_aligned_def unat_minus word_size word_neq_0_conv)
   apply (rule dvd_diff_nat, simp_all)
   apply (rule le_imp_power_dvd)
   apply (fold is_aligned_def)
   apply (erule_tac Q="0<p" in contrapos_pp)
   apply (clarsimp simp add: is_aligned_mask mask_def power_overflow)
   done
 
 lemma add_mask_lower_bits:
   "\<lbrakk>is_aligned (x :: 'a :: len word) n;
-    \<forall>n' \<ge> n. n' < LENGTH('a) \<longrightarrow> \<not> p !! n'\<rbrakk> \<Longrightarrow> x + p && ~~mask n = x"
+    \<forall>n' \<ge> n. n' < LENGTH('a) \<longrightarrow> \<not> p !! n'\<rbrakk> \<Longrightarrow> x + p && ~~ (mask n) = x"
   apply (subst word_plus_and_or_coroll)
    apply (rule word_eqI)
    apply (clarsimp simp: word_size is_aligned_nth)
    apply (erule_tac x=na in allE)+
    apply simp
   apply (rule word_eqI)
   apply (clarsimp simp: word_size is_aligned_nth word_ops_nth_size le_def)
   apply blast
   done
 
 lemma is_aligned_andI1:
   "is_aligned x n \<Longrightarrow> is_aligned (x && y) n"
   by (simp add: is_aligned_nth)
 
 lemma is_aligned_andI2:
   "is_aligned y n \<Longrightarrow> is_aligned (x && y) n"
   by (simp add: is_aligned_nth)
 
 lemma is_aligned_shiftl:
   "is_aligned w (n - m) \<Longrightarrow> is_aligned (w << m) n"
   by (simp add: is_aligned_nth nth_shiftl)
 
 lemma is_aligned_shiftr:
   "is_aligned w (n + m) \<Longrightarrow> is_aligned (w >> m) n"
   by (simp add: is_aligned_nth nth_shiftr)
 
 lemma is_aligned_shiftl_self:
   "is_aligned (p << n) n"
   by (rule is_aligned_shift)
 
 lemma is_aligned_neg_mask_eq:
-  "is_aligned p n \<Longrightarrow> p && ~~ mask n = p"
+  "is_aligned p n \<Longrightarrow> p && ~~ (mask n) = p"
   by (metis add.left_neutral is_aligned_mask word_plus_and_or_coroll2)
 
 lemma is_aligned_shiftr_shiftl:
   "is_aligned w n \<Longrightarrow> w >> n << n = w"
   by (metis and_not_mask is_aligned_neg_mask_eq)
 
 lemma aligned_shiftr_mask_shiftl:
   "is_aligned x n \<Longrightarrow> ((x >> n) && mask v) << n = x && mask (v + n)"
   apply (rule word_eqI)
   apply (simp add: word_size nth_shiftl nth_shiftr)
   apply (subgoal_tac "\<forall>m. x !! m \<longrightarrow> m \<ge> n")
    apply auto[1]
   apply (clarsimp simp: is_aligned_mask)
   apply (drule_tac x=m in word_eqD)
   apply (frule test_bit_size)
   apply (simp add: word_size)
   done
 
 end
diff --git a/thys/Word_Lib/Word_Lemmas.thy b/thys/Word_Lib/Word_Lemmas.thy
--- a/thys/Word_Lib/Word_Lemmas.thy
+++ b/thys/Word_Lib/Word_Lemmas.thy
@@ -1,5681 +1,5681 @@
 (*
  * Copyright 2014, NICTA
  *
  * This software may be distributed and modified according to the terms of
  * the BSD 2-Clause license. Note that NO WARRANTY is provided.
  * See "LICENSE_BSD2.txt" for details.
  *
  * @TAG(NICTA_BSD)
  *)
 
 section "Lemmas with Generic Word Length"
 
 theory Word_Lemmas
   imports
     Complex_Main
     Word_Next
     Word_Enum
     "HOL-Library.Sublist"
 begin
 
 text \<open>Set up quickcheck to support words\<close>
 
 lemma word_plus_mono_left:
   fixes x :: "'a :: len word"
   shows "\<lbrakk>y \<le> z; x \<le> x + z\<rbrakk> \<Longrightarrow> y + x \<le> z + x"
   by unat_arith
 
 lemma word_2p_mult_inc:
   assumes x: "2 * 2 ^ n < (2::'a::len word) * 2 ^ m"
   assumes suc_n: "Suc n < LENGTH('a::len)"
   assumes suc_m: "Suc m < LENGTH('a::len)"
   assumes 2: "unat (2::'a::len word) = 2"
   shows "2^n < (2::'a::len word)^m"
 proof -
   from suc_n
   have "(2::nat) * 2 ^ n mod 2 ^ LENGTH('a::len) = 2 * 2^n"
     apply (subst mod_less)
      apply (subst power_Suc[symmetric])
      apply (rule power_strict_increasing)
       apply simp
      apply simp
     apply simp
     done
   moreover
   from suc_m
   have "(2::nat) * 2 ^ m mod 2 ^ LENGTH('a::len) = 2 * 2^m"
     apply (subst mod_less)
      apply (subst power_Suc[symmetric])
      apply (rule power_strict_increasing)
       apply simp
      apply simp
     apply simp
     done
   ultimately
   have "2 * 2 ^ n < (2::nat) * 2 ^ m" using x
     apply (unfold word_less_nat_alt)
     apply simp
     apply (subst (asm) unat_word_ariths(2))+
     apply (subst (asm) 2)+
     apply (subst (asm) word_unat_power, subst (asm) unat_of_nat)+
     apply (simp add: mod_mult_right_eq)
     done
   with suc_n suc_m
   show ?thesis
     unfolding word_less_nat_alt
     apply (subst word_unat_power, subst unat_of_nat)+
     apply simp
     done
 qed
 
 lemma word_power_increasing:
   assumes x: "2 ^ x < (2 ^ y::'a::len word)" "x < LENGTH('a::len)" "y < LENGTH('a::len)"
   assumes 2: "unat (2::'a::len word) = 2"
   shows "x < y" using x
   apply (induct x arbitrary: y)
    apply (case_tac y; simp)
   apply (case_tac y; clarsimp)
    apply (subst (asm) power_Suc [symmetric])
    apply (subst (asm) p2_eq_0)
    apply simp
   apply (drule (2) word_2p_mult_inc, rule 2)
   apply simp
   done
 
 lemma word_shiftl_add_distrib:
   fixes x :: "'a :: len word"
   shows "(x + y) << n = (x << n) + (y << n)"
   by (simp add: shiftl_t2n ring_distribs)
 
 lemma less_Suc_unat_less_bound:
   "n < Suc (unat (x :: 'a :: len word)) \<Longrightarrow> n < 2 ^ LENGTH('a)"
   by (auto elim!: order_less_le_trans intro: Suc_leI)
 
 lemma up_ucast_inj:
   "\<lbrakk> ucast x = (ucast y::'b::len word); LENGTH('a) \<le> len_of TYPE ('b) \<rbrakk> \<Longrightarrow> x = (y::'a::len word)"
   by (subst (asm) bang_eq) (fastforce simp: nth_ucast word_size intro: word_eqI)
 
 lemmas ucast_up_inj = up_ucast_inj
 
 lemma up_ucast_inj_eq:
   "LENGTH('a) \<le> len_of TYPE ('b) \<Longrightarrow> (ucast x = (ucast y::'b::len word)) = (x = (y::'a::len word))"
   by (fastforce dest: up_ucast_inj)
 
 lemma no_plus_overflow_neg:
   "(x :: 'a :: len word) < -y \<Longrightarrow> x \<le> x + y"
   apply (simp add: no_plus_overflow_uint_size word_less_alt uint_word_ariths word_size)
   apply (subst(asm) zmod_zminus1_eq_if)
   apply (simp split: if_split_asm)
   done
 
 lemma ucast_ucast_eq:
   fixes x :: "'a::len word"
   fixes y :: "'b::len word"
   shows
     "\<lbrakk> ucast x = (ucast (ucast y::'a::len word)::'c::len word);
       LENGTH('a) \<le> LENGTH('b);
       LENGTH('b) \<le> LENGTH('c) \<rbrakk> \<Longrightarrow>
     x = ucast y"
   by (fastforce intro: word_eqI simp: bang_eq nth_ucast word_size)
 
 
 text \<open>right-padding a word to a certain length\<close>
 
 definition
   "bl_pad_to bl sz \<equiv> bl @ (replicate (sz - length bl) False)"
 
 lemma bl_pad_to_length:
   assumes lbl: "length bl \<le> sz"
   shows   "length (bl_pad_to bl sz) = sz"
   using lbl by (simp add: bl_pad_to_def)
 
 lemma bl_pad_to_prefix:
   "prefix bl (bl_pad_to bl sz)"
   by (simp add: bl_pad_to_def)
 
 lemma same_length_is_parallel:
   assumes len: "\<forall>y \<in> set as. length y = x"
   shows  "\<forall>x \<in> set as. \<forall>y \<in> set as - {x}. x \<parallel> y"
 proof (rule, rule)
   fix x y
   assume xi: "x \<in> set as" and yi: "y \<in> set as - {x}"
   from len obtain q where len': "\<forall>y \<in> set as. length y = q" ..
 
   show "x \<parallel> y"
   proof (rule not_equal_is_parallel)
     from xi yi show "x \<noteq> y" by auto
     from xi yi len' show "length x = length y" by (auto dest: bspec)
   qed
 qed
 
 text \<open>Lemmas about words\<close>
 
 lemmas and_bang = word_and_nth
 
 lemma of_drop_to_bl:
   "of_bl (drop n (to_bl x)) = (x && mask (size x - n))"
   apply (clarsimp simp: bang_eq test_bit_of_bl rev_nth cong: rev_conj_cong)
   apply (safe, simp_all add: word_size to_bl_nth)
   done
 
 lemma word_add_offset_less:
   fixes x :: "'a :: len word"
   assumes yv: "y < 2 ^ n"
   and     xv: "x < 2 ^ m"
   and     mnv: "sz < LENGTH('a :: len)"
   and    xv': "x < 2 ^ (LENGTH('a :: len) - n)"
   and     mn: "sz = m + n"
   shows   "x * 2 ^ n + y < 2 ^ sz"
 proof (subst mn)
   from mnv mn have nv: "n < LENGTH('a)" and mv: "m < LENGTH('a)"  by auto
 
   have uy: "unat y < 2 ^ n"
      by (rule order_less_le_trans [OF unat_mono [OF yv] order_eq_refl],
        rule unat_power_lower[OF nv])
 
   have ux: "unat x < 2 ^ m"
      by (rule order_less_le_trans [OF unat_mono [OF xv] order_eq_refl],
        rule unat_power_lower[OF mv])
 
   then show "x * 2 ^ n + y < 2 ^ (m + n)" using ux uy nv mnv xv'
   apply (subst word_less_nat_alt)
   apply (subst unat_word_ariths)+
   apply (subst mod_less)
    apply simp
    apply (subst mult.commute)
    apply (rule nat_less_power_trans [OF _ order_less_imp_le [OF nv]])
     apply (rule order_less_le_trans [OF unat_mono [OF xv']])
     apply (cases "n = 0")
        apply simp
       apply simp
     apply (subst unat_power_lower[OF nv])
     apply (subst mod_less)
    apply (erule order_less_le_trans [OF nat_add_offset_less], assumption)
     apply (rule mn)
    apply simp
   apply (simp add: mn mnv)
   apply (erule nat_add_offset_less)
   apply simp+
   done
 qed
 
 lemma word_less_power_trans:
   fixes n :: "'a :: len word"
   assumes nv: "n < 2 ^ (m - k)"
   and     kv: "k \<le> m"
   and     mv: "m < len_of TYPE ('a)"
   shows "2 ^ k * n < 2 ^ m"
   using nv kv mv
   apply -
   apply (subst word_less_nat_alt)
   apply (subst unat_word_ariths)
   apply (subst mod_less)
    apply simp
    apply (rule nat_less_power_trans)
     apply (erule order_less_trans [OF unat_mono])
     apply simp
    apply simp
   apply simp
   apply (rule nat_less_power_trans)
    apply (subst unat_power_lower[where 'a = 'a, symmetric])
     apply simp
    apply (erule unat_mono)
   apply simp
   done
 
 lemma word_less_sub_le[simp]:
   fixes x :: "'a :: len word"
   assumes nv: "n < LENGTH('a)"
   shows "(x \<le> 2 ^ n - 1) = (x < 2 ^ n)"
 proof -
   have "Suc (unat ((2::'a word) ^ n - 1)) = unat ((2::'a word) ^ n)" using nv
     by (metis Suc_pred' power_2_ge_iff unat_gt_0 unat_minus_one word_not_simps(1))
 
   then show ?thesis using nv
     apply -
     apply (subst word_le_nat_alt)
     apply (subst less_Suc_eq_le [symmetric])
     apply (erule ssubst)
     apply (subst word_less_nat_alt)
     apply (rule refl)
     done
 qed
 
 lemma Suc_unat_diff_1:
   fixes x :: "'a :: len word"
   assumes lt: "1 \<le> x"
   shows "Suc (unat (x - 1)) = unat x"
 proof -
   have "0 < unat x"
     by (rule order_less_le_trans [where y = 1], simp, subst unat_1 [symmetric], rule iffD1 [OF word_le_nat_alt lt])
 
   then show ?thesis
     by ((subst unat_sub [OF lt])+, simp only:  unat_1)
 qed
 
 lemma word_div_sub:
   fixes x :: "'a :: len word"
   assumes yx: "y \<le> x"
   and     y0: "0 < y"
   shows "(x - y) div y = x div y - 1"
   apply (rule word_unat.Rep_eqD)
   apply (subst unat_div)
   apply (subst unat_sub [OF yx])
   apply (subst unat_sub)
    apply (subst word_le_nat_alt)
    apply (subst unat_div)
    apply (subst le_div_geq)
      apply (rule order_le_less_trans [OF _ unat_mono [OF y0]])
      apply simp
     apply (subst word_le_nat_alt [symmetric], rule yx)
    apply simp
   apply (subst unat_div)
   apply (subst le_div_geq [OF _ iffD1 [OF word_le_nat_alt yx]])
    apply (rule order_le_less_trans [OF _ unat_mono [OF y0]])
    apply simp
   apply simp
   done
 
 lemma word_mult_less_mono1:
   fixes i :: "'a :: len word"
   assumes ij: "i < j"
   and    knz: "0 < k"
   and    ujk: "unat j * unat k < 2 ^ len_of TYPE ('a)"
   shows  "i * k < j * k"
 proof -
   from ij ujk knz have jk: "unat i * unat k < 2 ^ len_of TYPE ('a)"
     by (auto intro: order_less_subst2 simp: word_less_nat_alt elim: mult_less_mono1)
 
   then show ?thesis using ujk knz ij
     by (auto simp: word_less_nat_alt iffD1 [OF unat_mult_lem])
 qed
 
 lemma word_mult_less_dest:
   fixes i :: "'a :: len word"
   assumes ij: "i * k < j * k"
   and    uik: "unat i * unat k < 2 ^ len_of TYPE ('a)"
   and    ujk: "unat j * unat k < 2 ^ len_of TYPE ('a)"
   shows  "i < j"
   using uik ujk ij
   by (auto simp: word_less_nat_alt iffD1 [OF unat_mult_lem] elim: mult_less_mono1)
 
 lemma word_mult_less_cancel:
   fixes k :: "'a :: len word"
   assumes knz: "0 < k"
   and    uik: "unat i * unat k < 2 ^ len_of TYPE ('a)"
   and    ujk: "unat j * unat k < 2 ^ len_of TYPE ('a)"
   shows "(i * k < j * k) = (i < j)"
   by (rule iffI [OF word_mult_less_dest [OF _ uik ujk] word_mult_less_mono1 [OF _ knz ujk]])
 
 lemma Suc_div_unat_helper:
   assumes szv: "sz < LENGTH('a :: len)"
   and   usszv: "us \<le> sz"
   shows "2 ^ (sz - us) = Suc (unat (((2::'a :: len word) ^ sz - 1) div 2 ^ us))"
 proof -
   note usv = order_le_less_trans [OF usszv szv]
 
   from usszv obtain q where qv: "sz = us + q" by (auto simp: le_iff_add)
 
   have "Suc (unat (((2:: 'a word) ^ sz - 1) div 2 ^ us)) =
     (2 ^ us + unat ((2:: 'a word) ^ sz - 1)) div 2 ^ us"
     apply (subst unat_div unat_power_lower[OF usv])+
     apply (subst div_add_self1, simp+)
     done
 
   also have "\<dots> = ((2 ^ us - 1) + 2 ^ sz) div 2 ^ us" using szv
     by (simp add: unat_minus_one)
 
   also have "\<dots> = 2 ^ q + ((2 ^ us - 1) div 2 ^ us)"
     apply (subst qv)
     apply (subst power_add)
     apply (subst div_mult_self2; simp)
     done
 
   also have "\<dots> = 2 ^ (sz - us)" using qv by simp
 
   finally show ?thesis ..
 qed
 
 
 lemma set_enum_word8_def:
   "(set enum::word8 set) = {0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19,
                             20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36,
                             37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53,
                             54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70,
                             71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87,
                             88, 89, 90, 91, 92, 93, 94, 95, 96, 97, 98, 99, 100, 101, 102, 103,
                             104, 105, 106, 107, 108, 109, 110, 111, 112, 113, 114, 115, 116, 117,
                             118, 119, 120, 121, 122, 123, 124, 125, 126, 127, 128, 129, 130, 131,
                             132, 133, 134, 135, 136, 137, 138, 139, 140, 141, 142, 143, 144, 145,
                             146, 147, 148, 149, 150, 151, 152, 153, 154, 155, 156, 157, 158, 159,
                             160, 161, 162, 163, 164, 165, 166, 167, 168, 169, 170, 171, 172, 173,
                             174, 175, 176, 177, 178, 179, 180, 181, 182, 183, 184, 185, 186, 187,
                             188, 189, 190, 191, 192, 193, 194, 195, 196, 197, 198, 199, 200, 201,
                             202, 203, 204, 205, 206, 207, 208, 209, 210, 211, 212, 213, 214, 215,
                             216, 217, 218, 219, 220, 221, 222, 223, 224, 225, 226, 227, 228, 229,
                             230, 231, 232, 233, 234, 235, 236, 237, 238, 239, 240, 241, 242, 243,
                             244, 245, 246, 247, 248, 249, 250, 251, 252, 253, 254, 255}"
   by eval
 
 lemma set_strip_insert: "\<lbrakk> x \<in> insert a S; x \<noteq> a \<rbrakk> \<Longrightarrow> x \<in> S"
   by simp
 
 lemma word8_exhaust:
   fixes x :: word8
   shows "\<lbrakk>x \<noteq> 0; x \<noteq> 1; x \<noteq> 2; x \<noteq> 3; x \<noteq> 4; x \<noteq> 5; x \<noteq> 6; x \<noteq> 7; x \<noteq> 8; x \<noteq> 9; x \<noteq> 10; x \<noteq> 11; x \<noteq>
           12; x \<noteq> 13; x \<noteq> 14; x \<noteq> 15; x \<noteq> 16; x \<noteq> 17; x \<noteq> 18; x \<noteq> 19; x \<noteq> 20; x \<noteq> 21; x \<noteq> 22; x \<noteq>
           23; x \<noteq> 24; x \<noteq> 25; x \<noteq> 26; x \<noteq> 27; x \<noteq> 28; x \<noteq> 29; x \<noteq> 30; x \<noteq> 31; x \<noteq> 32; x \<noteq> 33; x \<noteq>
           34; x \<noteq> 35; x \<noteq> 36; x \<noteq> 37; x \<noteq> 38; x \<noteq> 39; x \<noteq> 40; x \<noteq> 41; x \<noteq> 42; x \<noteq> 43; x \<noteq> 44; x \<noteq>
           45; x \<noteq> 46; x \<noteq> 47; x \<noteq> 48; x \<noteq> 49; x \<noteq> 50; x \<noteq> 51; x \<noteq> 52; x \<noteq> 53; x \<noteq> 54; x \<noteq> 55; x \<noteq>
           56; x \<noteq> 57; x \<noteq> 58; x \<noteq> 59; x \<noteq> 60; x \<noteq> 61; x \<noteq> 62; x \<noteq> 63; x \<noteq> 64; x \<noteq> 65; x \<noteq> 66; x \<noteq>
           67; x \<noteq> 68; x \<noteq> 69; x \<noteq> 70; x \<noteq> 71; x \<noteq> 72; x \<noteq> 73; x \<noteq> 74; x \<noteq> 75; x \<noteq> 76; x \<noteq> 77; x \<noteq>
           78; x \<noteq> 79; x \<noteq> 80; x \<noteq> 81; x \<noteq> 82; x \<noteq> 83; x \<noteq> 84; x \<noteq> 85; x \<noteq> 86; x \<noteq> 87; x \<noteq> 88; x \<noteq>
           89; x \<noteq> 90; x \<noteq> 91; x \<noteq> 92; x \<noteq> 93; x \<noteq> 94; x \<noteq> 95; x \<noteq> 96; x \<noteq> 97; x \<noteq> 98; x \<noteq> 99; x \<noteq>
           100; x \<noteq> 101; x \<noteq> 102; x \<noteq> 103; x \<noteq> 104; x \<noteq> 105; x \<noteq> 106; x \<noteq> 107; x \<noteq> 108; x \<noteq> 109; x \<noteq>
           110; x \<noteq> 111; x \<noteq> 112; x \<noteq> 113; x \<noteq> 114; x \<noteq> 115; x \<noteq> 116; x \<noteq> 117; x \<noteq> 118; x \<noteq> 119; x \<noteq>
           120; x \<noteq> 121; x \<noteq> 122; x \<noteq> 123; x \<noteq> 124; x \<noteq> 125; x \<noteq> 126; x \<noteq> 127; x \<noteq> 128; x \<noteq> 129; x \<noteq>
           130; x \<noteq> 131; x \<noteq> 132; x \<noteq> 133; x \<noteq> 134; x \<noteq> 135; x \<noteq> 136; x \<noteq> 137; x \<noteq> 138; x \<noteq> 139; x \<noteq>
           140; x \<noteq> 141; x \<noteq> 142; x \<noteq> 143; x \<noteq> 144; x \<noteq> 145; x \<noteq> 146; x \<noteq> 147; x \<noteq> 148; x \<noteq> 149; x \<noteq>
           150; x \<noteq> 151; x \<noteq> 152; x \<noteq> 153; x \<noteq> 154; x \<noteq> 155; x \<noteq> 156; x \<noteq> 157; x \<noteq> 158; x \<noteq> 159; x \<noteq>
           160; x \<noteq> 161; x \<noteq> 162; x \<noteq> 163; x \<noteq> 164; x \<noteq> 165; x \<noteq> 166; x \<noteq> 167; x \<noteq> 168; x \<noteq> 169; x \<noteq>
           170; x \<noteq> 171; x \<noteq> 172; x \<noteq> 173; x \<noteq> 174; x \<noteq> 175; x \<noteq> 176; x \<noteq> 177; x \<noteq> 178; x \<noteq> 179; x \<noteq>
           180; x \<noteq> 181; x \<noteq> 182; x \<noteq> 183; x \<noteq> 184; x \<noteq> 185; x \<noteq> 186; x \<noteq> 187; x \<noteq> 188; x \<noteq> 189; x \<noteq>
           190; x \<noteq> 191; x \<noteq> 192; x \<noteq> 193; x \<noteq> 194; x \<noteq> 195; x \<noteq> 196; x \<noteq> 197; x \<noteq> 198; x \<noteq> 199; x \<noteq>
           200; x \<noteq> 201; x \<noteq> 202; x \<noteq> 203; x \<noteq> 204; x \<noteq> 205; x \<noteq> 206; x \<noteq> 207; x \<noteq> 208; x \<noteq> 209; x \<noteq>
           210; x \<noteq> 211; x \<noteq> 212; x \<noteq> 213; x \<noteq> 214; x \<noteq> 215; x \<noteq> 216; x \<noteq> 217; x \<noteq> 218; x \<noteq> 219; x \<noteq>
           220; x \<noteq> 221; x \<noteq> 222; x \<noteq> 223; x \<noteq> 224; x \<noteq> 225; x \<noteq> 226; x \<noteq> 227; x \<noteq> 228; x \<noteq> 229; x \<noteq>
           230; x \<noteq> 231; x \<noteq> 232; x \<noteq> 233; x \<noteq> 234; x \<noteq> 235; x \<noteq> 236; x \<noteq> 237; x \<noteq> 238; x \<noteq> 239; x \<noteq>
           240; x \<noteq> 241; x \<noteq> 242; x \<noteq> 243; x \<noteq> 244; x \<noteq> 245; x \<noteq> 246; x \<noteq> 247; x \<noteq> 248; x \<noteq> 249; x \<noteq>
           250; x \<noteq> 251; x \<noteq> 252; x \<noteq> 253; x \<noteq> 254; x \<noteq> 255\<rbrakk> \<Longrightarrow> P"
   apply (subgoal_tac "x \<in> set enum", subst (asm) set_enum_word8_def)
     apply (drule set_strip_insert, assumption)+
    apply (erule emptyE)
   apply (subst enum_UNIV, rule UNIV_I)
   done
 
 lemma upto_enum_red':
   assumes lt: "1 \<le> X"
   shows "[(0::'a :: len word) .e. X - 1] =  map of_nat [0 ..< unat X]"
 proof -
   have lt': "unat X < 2 ^ LENGTH('a)"
     by (rule unat_lt2p)
 
   show ?thesis
     apply (subst upto_enum_red)
     apply (simp del: upt.simps)
     apply (subst Suc_unat_diff_1 [OF lt])
     apply (rule map_cong [OF refl])
     apply (rule toEnum_of_nat)
     apply simp
     apply (erule order_less_trans [OF _ lt'])
     done
 qed
 
 lemma upto_enum_red2:
   assumes szv: "sz < LENGTH('a :: len)"
   shows "[(0:: 'a :: len word) .e. 2 ^ sz - 1] =
   map of_nat [0 ..< 2 ^ sz]" using szv
   apply (subst unat_power_lower[OF szv, symmetric])
   apply (rule upto_enum_red')
   apply (subst word_le_nat_alt, simp)
   done
 
 lemma upto_enum_step_red:
   assumes szv: "sz < len_of (TYPE('a))"
   and   usszv: "us \<le> sz"
   shows "[0 :: 'a :: len word , 2 ^ us .e. 2 ^ sz - 1] =
   map (\<lambda>x. of_nat x * 2 ^ us) [0 ..< 2 ^ (sz - us)]" using szv
   unfolding upto_enum_step_def
   apply (subst if_not_P)
    apply (rule leD)
    apply (subst word_le_nat_alt)
    apply (subst unat_minus_one)
     apply simp
    apply simp
   apply simp
   apply (subst upto_enum_red)
   apply (simp del: upt.simps)
   apply (subst Suc_div_unat_helper [where 'a = 'a, OF szv usszv, symmetric])
   apply clarsimp
   apply (subst toEnum_of_nat)
    apply (erule order_less_trans)
    using szv
    apply simp
   apply simp
   done
 
 lemma upto_enum_word:
   "[x .e. y] = map of_nat [unat x ..< Suc (unat y)]"
   apply (subst upto_enum_red)
   apply clarsimp
   apply (subst toEnum_of_nat)
    prefer 2
    apply (rule refl)
   apply (erule disjE, simp)
   apply clarsimp
   apply (erule order_less_trans)
   apply simp
   done
 
 lemma word_upto_Cons_eq:
   "\<lbrakk>x = z; x < y; Suc (unat y) < 2 ^ LENGTH('a)\<rbrakk>
    \<Longrightarrow> [x::'a::len word .e. y] = z # [x + 1 .e. y]"
   apply (subst upto_enum_red)
   apply (subst upt_conv_Cons)
    apply (simp)
    apply (drule unat_mono)
    apply arith
   apply (simp only: list.map)
   apply (subst list.inject)
   apply rule
    apply (rule to_from_enum)
    apply (subst upto_enum_red)
   apply (rule map_cong [OF _ refl])
   apply (rule arg_cong2 [where f = "\<lambda>x y. [x ..< y]"])
    apply unat_arith
   apply simp
   done
 
 lemma distinct_enum_upto:
   "distinct [(0 :: 'a::len word) .e. b]"
 proof -
   have "\<And>(b::'a word). [0 .e. b] = nths enum {..< Suc (fromEnum b)}"
     apply (subst upto_enum_red)
     apply (subst nths_upt_eq_take)
     apply (subst enum_word_def)
     apply (subst take_map)
     apply (subst take_upt)
      apply (simp only: add_0 fromEnum_unat)
      apply (rule order_trans [OF _ order_eq_refl])
       apply (rule Suc_leI [OF unat_lt2p])
      apply simp
     apply clarsimp
     apply (rule toEnum_of_nat)
     apply (erule order_less_trans [OF _ unat_lt2p])
     done
 
   then show ?thesis
     by (rule ssubst) (rule distinct_nthsI, simp)
 qed
 
 lemma upto_enum_set_conv [simp]:
   fixes a :: "'a :: len word"
   shows "set [a .e. b] = {x. a \<le> x \<and> x \<le> b}"
   apply (subst upto_enum_red)
   apply (subst set_map)
   apply safe
     apply simp
     apply clarsimp
     apply (erule disjE)
      apply simp
      apply (erule iffD2 [OF word_le_nat_alt])
     apply clarsimp
     apply (erule word_unat.Rep_cases [OF unat_le [OF order_less_imp_le]])
     apply simp
     apply (erule iffD2 [OF word_le_nat_alt])
    apply simp
 
    apply clarsimp
    apply (erule disjE)
     apply simp
    apply clarsimp
    apply (rule word_unat.Rep_cases [OF unat_le  [OF order_less_imp_le]])
     apply assumption
    apply simp
    apply (erule order_less_imp_le [OF iffD2 [OF word_less_nat_alt]])
   apply clarsimp
   apply (rule_tac x="fromEnum x" in image_eqI)
    apply clarsimp
   apply clarsimp
   apply (rule conjI)
    apply (subst word_le_nat_alt [symmetric])
    apply simp
   apply safe
    apply (simp add: word_le_nat_alt [symmetric])
   apply (simp add: word_less_nat_alt [symmetric])
   done
 
 lemma upto_enum_less:
   assumes xin: "x \<in> set [(a::'a::len word).e.2 ^ n - 1]"
   and     nv:  "n < LENGTH('a::len)"
   shows   "x < 2 ^ n"
 proof (cases n)
   case 0
   then show ?thesis using xin by simp
 next
   case (Suc m)
   show ?thesis using xin nv by simp
 qed
 
 lemma upto_enum_len_less:
   "\<lbrakk> n \<le> length [a, b .e. c]; n \<noteq> 0 \<rbrakk> \<Longrightarrow> a \<le> c"
   unfolding upto_enum_step_def
   by (simp split: if_split_asm)
 
 lemma length_upto_enum_step:
   fixes x :: "'a :: len word"
   shows "x \<le> z \<Longrightarrow> length [x , y .e. z] = (unat ((z - x) div (y - x))) + 1"
   unfolding upto_enum_step_def
   by (simp add: upto_enum_red)
 
 lemma map_length_unfold_one:
   fixes x :: "'a::len word"
   assumes xv: "Suc (unat x) < 2 ^ LENGTH('a)"
   and     ax: "a < x"
   shows   "map f [a .e. x] = f a # map f [a + 1 .e. x]"
   by (subst word_upto_Cons_eq, auto, fact+)
 
 lemma upto_enum_set_conv2:
   fixes a :: "'a::len word"
   shows "set [a .e. b] = {a .. b}"
   by auto
 
 lemma of_nat_unat [simp]:
   "of_nat \<circ> unat = id"
   by (rule ext, simp)
 
 lemma Suc_unat_minus_one [simp]:
   "x \<noteq> 0 \<Longrightarrow> Suc (unat (x - 1)) = unat x"
   by (metis Suc_diff_1 unat_gt_0 unat_minus_one)
 
 lemma word_add_le_dest:
   fixes i :: "'a :: len word"
   assumes le: "i + k \<le> j + k"
   and    uik: "unat i + unat k < 2 ^ len_of TYPE ('a)"
   and    ujk: "unat j + unat k < 2 ^ len_of TYPE ('a)"
   shows  "i \<le> j"
   using uik ujk le
   by (auto simp: word_le_nat_alt iffD1 [OF unat_add_lem] elim: add_le_mono1)
 
 lemma mask_shift:
-  "(x && ~~ mask y) >> y = x >> y"
+  "(x && ~~ (mask y)) >> y = x >> y"
   apply (rule word_eqI)
   apply (simp add: nth_shiftr word_size)
   apply safe
   apply (drule test_bit.Rep[simplified, rule_format])
   apply (simp add: word_size word_ops_nth_size)
   done
 
 lemma word_add_le_mono1:
   fixes i :: "'a :: len word"
   assumes ij: "i \<le> j"
   and    ujk: "unat j + unat k < 2 ^ len_of TYPE ('a)"
   shows  "i + k \<le> j + k"
 proof -
   from ij ujk have jk: "unat i + unat k < 2 ^ len_of TYPE ('a)"
     by (auto elim: order_le_less_subst2 simp: word_le_nat_alt elim: add_le_mono1)
 
   then show ?thesis using ujk ij
     by (auto simp: word_le_nat_alt iffD1 [OF unat_add_lem])
 qed
 
 lemma word_add_le_mono2:
   fixes i :: "'a :: len word"
   shows "\<lbrakk>i \<le> j; unat j + unat k < 2 ^ LENGTH('a)\<rbrakk> \<Longrightarrow> k + i \<le> k + j"
   by (subst field_simps, subst field_simps, erule (1) word_add_le_mono1)
 
 lemma word_add_le_iff:
   fixes i :: "'a :: len word"
   assumes uik: "unat i + unat k < 2 ^ len_of TYPE ('a)"
   and     ujk: "unat j + unat k < 2 ^ len_of TYPE ('a)"
   shows  "(i + k \<le> j + k) = (i \<le> j)"
 proof
   assume "i \<le> j"
   show "i + k \<le> j + k" by (rule word_add_le_mono1) fact+
 next
   assume "i + k \<le> j + k"
   show "i \<le> j" by (rule word_add_le_dest) fact+
 qed
 
 lemma word_add_less_mono1:
   fixes i :: "'a :: len word"
   assumes ij: "i < j"
   and    ujk: "unat j + unat k < 2 ^ len_of TYPE ('a)"
   shows  "i + k < j + k"
 proof -
   from ij ujk have jk: "unat i + unat k < 2 ^ len_of TYPE ('a)"
     by (auto elim: order_le_less_subst2 simp: word_less_nat_alt elim: add_less_mono1)
 
   then show ?thesis using ujk ij
     by (auto simp: word_less_nat_alt iffD1 [OF unat_add_lem])
 qed
 
 lemma word_add_less_dest:
   fixes i :: "'a :: len word"
   assumes le: "i + k < j + k"
   and    uik: "unat i + unat k < 2 ^ len_of TYPE ('a)"
   and    ujk: "unat j + unat k < 2 ^ len_of TYPE ('a)"
   shows  "i < j"
   using uik ujk le
   by (auto simp: word_less_nat_alt iffD1 [OF unat_add_lem] elim: add_less_mono1)
 
 lemma word_add_less_iff:
   fixes i :: "'a :: len word"
   assumes uik: "unat i + unat k < 2 ^ len_of TYPE ('a)"
   and     ujk: "unat j + unat k < 2 ^ len_of TYPE ('a)"
   shows  "(i + k < j + k) = (i < j)"
 proof
   assume "i < j"
   show "i + k < j + k" by (rule word_add_less_mono1) fact+
 next
   assume "i + k < j + k"
   show "i < j" by (rule word_add_less_dest) fact+
 qed
 
 lemma shiftr_div_2n':
   "unat (w >> n) = unat w div 2 ^ n"
   apply (unfold unat_def)
   apply (subst shiftr_div_2n)
   apply (subst nat_div_distrib)
    apply simp
   apply (simp add: nat_power_eq)
   done
 
 lemma shiftl_shiftr_id:
   assumes nv: "n < LENGTH('a)"
   and     xv: "x < 2 ^ (LENGTH('a) - n)"
   shows "x << n >> n = (x::'a::len word)"
   apply (simp add: shiftl_t2n)
   apply (rule word_unat.Rep_eqD)
   apply (subst shiftr_div_2n')
   apply (cases n)
    apply simp
   apply (subst iffD1 [OF unat_mult_lem])+
    apply (subst unat_power_lower[OF nv])
    apply (rule nat_less_power_trans [OF _ order_less_imp_le [OF nv]])
    apply (rule order_less_le_trans [OF unat_mono [OF xv] order_eq_refl])
    apply (rule unat_power_lower)
    apply simp
   apply (subst unat_power_lower[OF nv])
   apply simp
   done
 
 lemma word_mult_less_iff:
   fixes i :: "'a :: len word"
   assumes knz: "0 < k"
   and     uik: "unat i * unat k < 2 ^ len_of TYPE ('a)"
   and     ujk: "unat j * unat k < 2 ^ len_of TYPE ('a)"
   shows  "(i * k < j * k) = (i < j)"
   using assms by (rule word_mult_less_cancel)
 
 lemma word_le_imp_diff_le:
   fixes n :: "'a::len word"
   shows "\<lbrakk>k \<le> n; n \<le> m\<rbrakk> \<Longrightarrow> n - k \<le> m"
   by (auto simp: unat_sub word_le_nat_alt)
 
 lemma word_less_imp_diff_less:
   fixes n :: "'a::len word"
   shows "\<lbrakk>k \<le> n; n < m\<rbrakk> \<Longrightarrow> n - k < m"
   by (clarsimp simp: unat_sub word_less_nat_alt
              intro!: less_imp_diff_less)
 
 lemma word_mult_le_mono1:
   fixes i :: "'a :: len word"
   assumes ij: "i \<le> j"
   and    knz: "0 < k"
   and    ujk: "unat j * unat k < 2 ^ len_of TYPE ('a)"
   shows  "i * k \<le> j * k"
 proof -
   from ij ujk knz have jk: "unat i * unat k < 2 ^ len_of TYPE ('a)"
     by (auto elim: order_le_less_subst2 simp: word_le_nat_alt elim: mult_le_mono1)
 
   then show ?thesis using ujk knz ij
     by (auto simp: word_le_nat_alt iffD1 [OF unat_mult_lem])
 qed
 
 lemma word_mult_le_iff:
   fixes i :: "'a :: len word"
   assumes knz: "0 < k"
   and     uik: "unat i * unat k < 2 ^ len_of TYPE ('a)"
   and     ujk: "unat j * unat k < 2 ^ len_of TYPE ('a)"
   shows  "(i * k \<le> j * k) = (i \<le> j)"
 proof
   assume "i \<le> j"
   show "i * k \<le> j * k" by (rule word_mult_le_mono1) fact+
 next
   assume p: "i * k \<le> j * k"
 
   have "0 < unat k" using knz by (simp add: word_less_nat_alt)
   then show "i \<le> j" using p
     by (clarsimp simp: word_le_nat_alt iffD1 [OF unat_mult_lem uik]
       iffD1 [OF unat_mult_lem ujk])
 qed
 
 lemma word_diff_less:
   fixes n :: "'a :: len word"
   shows "\<lbrakk>0 < n; 0 < m; n \<le> m\<rbrakk> \<Longrightarrow> m - n < m"
   apply (subst word_less_nat_alt)
   apply (subst unat_sub)
    apply assumption
   apply (rule diff_less)
    apply (simp_all add: word_less_nat_alt)
    done
 
 lemma MinI:
   assumes fa: "finite A"
   and     ne: "A \<noteq> {}"
   and     xv: "m \<in> A"
   and    min: "\<forall>y \<in> A. m \<le> 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 \<le> y" and fx: "\<forall>y \<in> F. m \<le> y" by auto
   have "m \<in> insert y F" by fact
   then show ?case
   proof
     assume mv: "m = y"
 
     have mlt: "m \<le> 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 \<in> 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 length_upto_enum [simp]:
   fixes a :: "'a :: len word"
   shows "length [a .e. b] = Suc (unat b) - unat a"
   apply (simp add: word_le_nat_alt upto_enum_red)
   apply (clarsimp simp: Suc_diff_le)
   done
 
 lemma length_upto_enum_less_one:
   "\<lbrakk>a \<le> b; b \<noteq> 0\<rbrakk>
   \<Longrightarrow> length [a .e. b - 1] = unat (b - a)"
   apply clarsimp
   apply (subst unat_sub[symmetric], assumption)
   apply clarsimp
   done
 
 lemma drop_upto_enum:
   "drop (unat n) [0 .e. m] = [n .e. m]"
   apply (clarsimp simp: upto_enum_def)
   apply (induct m, simp)
   by (metis drop_map drop_upt plus_nat.add_0)
 
 lemma distinct_enum_upto' [simp]:
   "distinct [a::'a::len word .e. b]"
   apply (subst drop_upto_enum [symmetric])
   apply (rule distinct_drop)
   apply (rule distinct_enum_upto)
   done
 
 lemma length_interval:
   "\<lbrakk>set xs = {x. (a::'a::len word) \<le> x \<and> x \<le> b}; distinct xs\<rbrakk>
   \<Longrightarrow> length xs = Suc (unat b) - unat a"
   apply (frule distinct_card)
   apply (subgoal_tac "set xs = set [a .e. b]")
    apply (cut_tac distinct_card [where xs="[a .e. b]"])
     apply (subst (asm) length_upto_enum)
     apply clarsimp
    apply (rule distinct_enum_upto')
   apply simp
   done
 
 lemma not_empty_eq:
   "(S \<noteq> {}) = (\<exists>x. x \<in> S)"
   by auto
 
 lemma range_subset_lower:
   fixes c :: "'a ::linorder"
   shows "\<lbrakk> {a..b} \<subseteq> {c..d}; x \<in> {a..b} \<rbrakk> \<Longrightarrow> c \<le> a"
   apply (frule (1) subsetD)
   apply (rule classical)
   apply clarsimp
   done
 
 lemma range_subset_upper:
   fixes c :: "'a ::linorder"
   shows "\<lbrakk> {a..b} \<subseteq> {c..d}; x \<in> {a..b} \<rbrakk> \<Longrightarrow> b \<le> d"
   apply (frule (1) subsetD)
   apply (rule classical)
   apply clarsimp
   done
 
 lemma range_subset_eq:
   fixes a::"'a::linorder"
   assumes non_empty: "a \<le> b"
   shows "({a..b} \<subseteq> {c..d}) = (c \<le> a \<and> b \<le> 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 \<le> b"
   shows "({a..b} = {c..d}) = (a = c \<and> b = d)"
   by (metis atLeastatMost_subset_iff eq_iff non_empty)
 
 lemma range_strict_subset_eq:
   fixes a::"'a::linorder"
   assumes non_empty: "a \<le> b"
   shows "({a..b} \<subset> {c..d}) = (c \<le> a \<and> b \<le> d \<and> (a = c \<longrightarrow> b \<noteq> 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 \<le> x"
   and     yY: "y \<le> Y"
   shows   "{x .. y} \<subseteq> {X .. Y}"
   using xX yY by auto
 
 lemma set_False [simp]:
   "(set bs \<subseteq> {False}) = (True \<notin> set bs)" by auto
 
 declare of_nat_power [simp del]
 
 (* TODO: move to word *)
 lemma unat_of_bl_length:
   "unat (of_bl xs :: 'a::len word) < 2 ^ (length xs)"
 proof (cases "length xs < LENGTH('a)")
   case True
   then have "(of_bl xs::'a::len word) < 2 ^ length xs"
     by (simp add: of_bl_length_less)
   with True
   show ?thesis
     by (simp add: word_less_nat_alt word_unat_power unat_of_nat)
 next
   case False
   have "unat (of_bl xs::'a::len word) < 2 ^ LENGTH('a)"
     by (simp split: unat_split)
   also
   from False
   have "LENGTH('a) \<le> length xs" by simp
   then have "2 ^ LENGTH('a) \<le> (2::nat) ^ length xs"
     by (rule power_increasing) simp
   finally
   show ?thesis .
 qed
 
 lemma is_aligned_0'[simp]:
   "is_aligned 0 n"
   by (simp add: is_aligned_def)
 
 lemma p_assoc_help:
   fixes p :: "'a::{ring,power,numeral,one}"
   shows "p + 2^sz - 1 = p + (2^sz - 1)"
   by simp
 
 lemma word_add_increasing:
   fixes x :: "'a :: len word"
   shows "\<lbrakk> p + w \<le> x; p \<le> p + w \<rbrakk> \<Longrightarrow> p \<le> x"
   by unat_arith
 
 lemma word_random:
   fixes x :: "'a :: len word"
   shows "\<lbrakk> p \<le> p + x'; x \<le> x' \<rbrakk> \<Longrightarrow> p \<le> p + x"
   by unat_arith
 
 lemma word_sub_mono:
   "\<lbrakk> a \<le> c; d \<le> b; a - b \<le> a; c - d \<le> c \<rbrakk>
     \<Longrightarrow> (a - b) \<le> (c - d :: 'a :: len word)"
   by unat_arith
 
 lemma power_not_zero:
   "n < LENGTH('a::len) \<Longrightarrow> (2 :: 'a word) ^ n \<noteq> 0"
   by (metis p2_gt_0 word_neq_0_conv)
 
 lemma word_gt_a_gt_0:
   "a < n \<Longrightarrow> (0 :: 'a::len word) < n"
   apply (case_tac "n = 0")
    apply clarsimp
   apply (clarsimp simp: word_neq_0_conv)
   done
 
 lemma word_shift_nonzero:
   "\<lbrakk> (x::'a::len word) \<le> 2 ^ m; m + n < LENGTH('a::len); x \<noteq> 0\<rbrakk>
    \<Longrightarrow> x << n \<noteq> 0"
   apply (simp only: word_neq_0_conv word_less_nat_alt
                     shiftl_t2n mod_0 unat_word_ariths
                     unat_power_lower word_le_nat_alt)
   apply (subst mod_less)
    apply (rule order_le_less_trans)
     apply (erule mult_le_mono2)
    apply (subst power_add[symmetric])
    apply (rule power_strict_increasing)
     apply simp
    apply simp
   apply simp
   done
 
 lemma word_power_less_1 [simp]:
   "sz < LENGTH('a::len) \<Longrightarrow> (2::'a word) ^ sz - 1 < 2 ^ sz"
   apply (simp add: word_less_nat_alt)
   apply (subst unat_minus_one)
   apply (simp add: word_unat.Rep_inject [symmetric])
   apply simp
   done
 
 lemma nasty_split_lt:
   "\<lbrakk> (x :: 'a:: len word) < 2 ^ (m - n); n \<le> m; m < LENGTH('a::len) \<rbrakk>
      \<Longrightarrow> x * 2 ^ n + (2 ^ n - 1) \<le> 2 ^ m - 1"
   apply (simp only: add_diff_eq)
   apply (subst mult_1[symmetric], subst distrib_right[symmetric])
   apply (rule word_sub_mono)
      apply (rule order_trans)
       apply (rule word_mult_le_mono1)
         apply (rule inc_le)
         apply assumption
        apply (subst word_neq_0_conv[symmetric])
        apply (rule power_not_zero)
        apply simp
       apply (subst unat_power_lower, simp)+
       apply (subst power_add[symmetric])
       apply (rule power_strict_increasing)
        apply simp
       apply simp
      apply (subst power_add[symmetric])
      apply simp
     apply simp
    apply (rule word_sub_1_le)
    apply (subst mult.commute)
    apply (subst shiftl_t2n[symmetric])
    apply (rule word_shift_nonzero)
      apply (erule inc_le)
     apply simp
    apply (unat_arith)
   apply (drule word_power_less_1)
   apply simp
   done
 
 lemma nasty_split_less:
   "\<lbrakk>m \<le> n; n \<le> nm; nm < LENGTH('a::len); x < 2 ^ (nm - n)\<rbrakk>
    \<Longrightarrow> (x :: 'a word) * 2 ^ n + (2 ^ m - 1) < 2 ^ nm"
   apply (simp only: word_less_sub_le[symmetric])
   apply (rule order_trans [OF _ nasty_split_lt])
      apply (rule word_plus_mono_right)
       apply (rule word_sub_mono)
          apply (simp add: word_le_nat_alt)
         apply simp
        apply (simp add: word_sub_1_le[OF power_not_zero])
       apply (simp add: word_sub_1_le[OF power_not_zero])
      apply (rule is_aligned_no_wrap')
       apply (rule is_aligned_mult_triv2)
      apply simp
     apply (erule order_le_less_trans, simp)
    apply simp+
   done
 
 lemma int_not_emptyD:
   "A \<inter> B \<noteq> {} \<Longrightarrow> \<exists>x. x \<in> A \<and> x \<in> B"
   by (erule contrapos_np, clarsimp simp: disjoint_iff_not_equal)
 
 lemma unat_less_power:
   fixes k :: "'a::len word"
   assumes szv: "sz < LENGTH('a)"
   and     kv:  "k < 2 ^ sz"
   shows   "unat k < 2 ^ sz"
   using szv unat_mono [OF kv] by simp
 
 lemma unat_mult_power_lem:
   assumes kv: "k < 2 ^ (LENGTH('a::len) - sz)"
   shows "unat (2 ^ sz * of_nat k :: (('a::len) word)) = 2 ^ sz * k"
 proof cases
   assume szv: "sz < LENGTH('a::len)"
   show ?thesis
   proof (cases "sz = 0")
     case True
     then show ?thesis using kv szv
      by (simp add: unat_of_nat)
   next
     case False
     then have sne: "0 < sz" ..
 
     have uk: "unat (of_nat k :: 'a word) = k"
       apply (subst unat_of_nat)
       apply (simp add: nat_mod_eq less_trans[OF kv] sne)
       done
 
     show ?thesis using szv
       apply (subst iffD1 [OF unat_mult_lem])
       apply (simp add: uk nat_less_power_trans[OF kv order_less_imp_le [OF szv]])+
       done
   qed
 next
   assume "\<not> sz < LENGTH('a)"
   with kv show ?thesis by (simp add: not_less power_overflow)
 qed
 
 lemma aligned_add_offset_no_wrap:
   fixes off :: "('a::len) word"
   and     x :: "'a word"
   assumes al: "is_aligned x sz"
   and   offv: "off < 2 ^ sz"
   shows  "unat x + unat off < 2 ^ LENGTH('a)"
 proof cases
   assume szv: "sz < LENGTH('a)"
   from al obtain k where xv: "x = 2 ^ sz * (of_nat k)"
     and kl: "k < 2 ^ (LENGTH('a) - sz)"
     by (auto elim: is_alignedE)
 
   show ?thesis using szv
     apply (subst xv)
     apply (subst unat_mult_power_lem[OF kl])
     apply (subst mult.commute, rule nat_add_offset_less)
       apply (rule less_le_trans[OF unat_mono[OF offv, simplified]])
       apply (erule eq_imp_le[OF unat_power_lower])
      apply (rule kl)
     apply simp
    done
 next
   assume "\<not> sz < LENGTH('a)"
   with offv show ?thesis by (simp add: not_less power_overflow )
 qed
 
 lemma aligned_add_offset_mod:
   fixes x :: "('a::len) word"
   assumes al: "is_aligned x sz"
   and     kv: "k < 2 ^ sz"
   shows   "(x + k) mod 2 ^ sz = k"
 proof cases
   assume szv: "sz < LENGTH('a)"
 
   have ux: "unat x + unat k < 2 ^ LENGTH('a)"
     by (rule aligned_add_offset_no_wrap) fact+
 
   show ?thesis using al szv
     apply -
     apply (erule is_alignedE)
     apply (subst word_unat.Rep_inject [symmetric])
     apply (subst unat_mod)
     apply (subst iffD1 [OF unat_add_lem], rule ux)
     apply simp
     apply (subst unat_mult_power_lem, assumption+)
     apply (simp)
     apply (rule mod_less[OF less_le_trans[OF unat_mono], OF kv])
     apply (erule eq_imp_le[OF unat_power_lower])
     done
 next
   assume "\<not> sz < LENGTH('a)"
   with al show ?thesis
     by (simp add: not_less power_overflow is_aligned_mask mask_def
                   word_mod_by_0)
 qed
 
 lemma word_plus_mcs_4:
   "\<lbrakk>v + x \<le> w + x; x \<le> v + x\<rbrakk> \<Longrightarrow> v \<le> (w::'a::len word)"
   by uint_arith
 
 lemma word_plus_mcs_3:
   "\<lbrakk>v \<le> w; x \<le> w + x\<rbrakk> \<Longrightarrow> v + x \<le> w + (x::'a::len word)"
   by unat_arith
 
 lemma aligned_neq_into_no_overlap:
   fixes x :: "'a::len word"
   assumes neq: "x \<noteq> y"
   and     alx: "is_aligned x sz"
   and     aly: "is_aligned y sz"
   shows  "{x .. x + (2 ^ sz - 1)} \<inter> {y .. y + (2 ^ sz - 1)} = {}"
 proof cases
   assume szv: "sz < LENGTH('a)"
   show ?thesis
   proof (rule equals0I, clarsimp)
     fix z
     assume xb: "x \<le> z" and xt: "z \<le> x + (2 ^ sz - 1)"
       and yb: "y \<le> z" and yt: "z \<le> y + (2 ^ sz - 1)"
 
     have rl: "\<And>(p::'a word) k w. \<lbrakk>uint p + uint k < 2 ^ LENGTH('a); w = p + k; w \<le> p + (2 ^ sz - 1) \<rbrakk>
       \<Longrightarrow> k < 2 ^ sz"
       apply -
       apply simp
       apply (subst (asm) add.commute, subst (asm) add.commute, drule word_plus_mcs_4)
       apply (subst add.commute, subst no_plus_overflow_uint_size)
       apply (simp add: word_size_bl)
       apply (erule iffD1 [OF word_less_sub_le[OF szv]])
       done
 
     from xb obtain kx where
       kx: "z = x + kx" and
       kxl: "uint x + uint kx < 2 ^ LENGTH('a)"
       by (clarsimp dest!: word_le_exists')
 
     from yb obtain ky where
       ky: "z = y + ky" and
       kyl: "uint y + uint ky < 2 ^ LENGTH('a)"
       by (clarsimp dest!: word_le_exists')
 
     have "x = y"
     proof -
       have "kx = z mod 2 ^ sz"
       proof (subst kx, rule sym, rule aligned_add_offset_mod)
         show "kx < 2 ^ sz" by (rule rl) fact+
       qed fact+
 
       also have "\<dots> = ky"
       proof (subst ky, rule aligned_add_offset_mod)
         show "ky < 2 ^ sz"
           using kyl ky yt by (rule rl)
       qed fact+
 
       finally have kxky: "kx = ky" .
       moreover have "x + kx = y + ky" by (simp add: kx [symmetric] ky [symmetric])
       ultimately show ?thesis by simp
     qed
 
     then show False using neq by simp
   qed
 next
   assume "\<not> sz < LENGTH('a)"
   with neq alx aly
   have False by (simp add: is_aligned_mask mask_def power_overflow)
   then show ?thesis ..
 qed
 
 lemma less_two_pow_divD:
   "\<lbrakk> (x :: nat) < 2 ^ n div 2 ^ m \<rbrakk>
     \<Longrightarrow> n \<ge> m \<and> (x < 2 ^ (n - m))"
   apply (rule context_conjI)
    apply (rule ccontr)
    apply (simp add: power_strict_increasing)
   apply (simp add: power_sub)
   done
 
 lemma less_two_pow_divI:
   "\<lbrakk> (x :: nat) < 2 ^ (n - m); m \<le> n \<rbrakk> \<Longrightarrow> x < 2 ^ n div 2 ^ m"
   by (simp add: power_sub)
 
 lemma word_less_two_pow_divI:
   "\<lbrakk> (x :: 'a::len word) < 2 ^ (n - m); m \<le> n; n < LENGTH('a) \<rbrakk> \<Longrightarrow> x < 2 ^ n div 2 ^ m"
   apply (simp add: word_less_nat_alt)
   apply (subst unat_word_ariths)
   apply (subst mod_less)
    apply (rule order_le_less_trans [OF div_le_dividend])
    apply (rule unat_lt2p)
   apply (simp add: power_sub)
   done
 
 lemma word_less_two_pow_divD:
   "\<lbrakk> (x :: 'a::len word) < 2 ^ n div 2 ^ m \<rbrakk>
      \<Longrightarrow> n \<ge> m \<and> (x < 2 ^ (n - m))"
   apply (cases "n < LENGTH('a)")
    apply (cases "m < LENGTH('a)")
     apply (simp add: word_less_nat_alt)
     apply (subst(asm) unat_word_ariths)
     apply (subst(asm) mod_less)
      apply (rule order_le_less_trans [OF div_le_dividend])
      apply (rule unat_lt2p)
     apply (clarsimp dest!: less_two_pow_divD)
    apply (simp add: power_overflow)
    apply (simp add: word_div_def)
   apply (simp add: power_overflow word_div_def)
   done
 
 lemma of_nat_less_two_pow_div_set:
   "\<lbrakk> n < LENGTH('a) \<rbrakk> \<Longrightarrow>
    {x. x < (2 ^ n div 2 ^ m :: 'a::len word)}
       = of_nat ` {k. k < 2 ^ n div 2 ^ m}"
   apply (simp add: image_def)
   apply (safe dest!: word_less_two_pow_divD less_two_pow_divD
              intro!: word_less_two_pow_divI)
    apply (rule_tac x="unat x" in exI)
    apply (simp add: power_sub[symmetric])
    apply (subst unat_power_lower[symmetric, where 'a='a])
     apply simp
    apply (erule unat_mono)
   apply (subst word_unat_power)
   apply (rule of_nat_mono_maybe)
    apply (rule power_strict_increasing)
     apply simp
    apply simp
   apply assumption
   done
 
 lemma  word_less_power_trans2:
   fixes n :: "'a::len word"
   shows "\<lbrakk>n < 2 ^ (m - k); k \<le> m; m < LENGTH('a)\<rbrakk> \<Longrightarrow> n * 2 ^ k < 2 ^ m"
   by (subst field_simps, rule word_less_power_trans)
 
 lemma ucast_less:
   "LENGTH('b) < LENGTH('a) \<Longrightarrow>
    (ucast (x :: 'b :: len word) :: ('a :: len word)) < 2 ^ LENGTH('b)"
   apply (subst mask_eq_iff_w2p[symmetric])
    apply (simp add: word_size)
   apply (rule word_eqI)
   apply (simp add: word_size nth_ucast)
   apply safe
   apply (simp add: test_bit.Rep[simplified])
   done
 
 lemma ucast_range_less:
   "LENGTH('a :: len) < LENGTH('b :: len) \<Longrightarrow>
    range (ucast :: 'a word \<Rightarrow> 'b word)
        = {x. x < 2 ^ len_of TYPE ('a)}"
   apply safe
    apply (erule ucast_less)
   apply (simp add: image_def)
   apply (rule_tac x="ucast x" in exI)
   apply (drule less_mask_eq)
   apply (rule word_eqI)
   apply (drule_tac x=n in word_eqD)
   apply (clarsimp simp: word_size nth_ucast)
   done
 
 lemma word_power_less_diff:
   "\<lbrakk>2 ^ n * q < (2::'a::len word) ^ m; q < 2 ^ (LENGTH('a) - n)\<rbrakk> \<Longrightarrow> q < 2 ^ (m - n)"
   apply (case_tac "m \<ge> LENGTH('a)")
    apply (simp add: power_overflow)
   apply (case_tac "n \<ge> LENGTH('a)")
    apply (simp add: power_overflow)
   apply (cases "n = 0")
    apply simp
   apply (subst word_less_nat_alt)
   apply (subst unat_power_lower)
    apply simp
   apply (rule nat_power_less_diff)
   apply (simp add: word_less_nat_alt)
   apply (subst (asm) iffD1 [OF unat_mult_lem])
    apply (simp add:nat_less_power_trans)
   apply simp
   done
 
 lemmas word_diff_ls'' = word_diff_ls [where xa=x and x=x for x]
 lemmas word_diff_ls' = word_diff_ls'' [simplified]
 
 lemmas word_l_diffs' = word_l_diffs [where xa=x and x=x for x]
 lemmas word_l_diffs = word_l_diffs' [simplified]
 
 lemma is_aligned_diff:
   fixes m :: "'a::len word"
   assumes alm: "is_aligned m s1"
   and     aln: "is_aligned n s2"
   and    s2wb: "s2 < LENGTH('a)"
   and      nm: "m \<in> {n .. n + (2 ^ s2 - 1)}"
   and    s1s2: "s1 \<le> s2"
   and     s10: "0 < s1" (* Probably can be folded into the proof \<dots> *)
   shows  "\<exists>q. m - n = of_nat q * 2 ^ s1 \<and> q < 2 ^ (s2 - s1)"
 proof -
   have rl: "\<And>m s. \<lbrakk> m < 2 ^ (LENGTH('a) - s); s < LENGTH('a) \<rbrakk> \<Longrightarrow> unat ((2::'a word) ^ s * of_nat m) = 2 ^ s * m"
   proof -
     fix m :: nat and  s
     assume m: "m < 2 ^ (LENGTH('a) - s)" and s: "s < LENGTH('a)"
     then have "unat ((of_nat m) :: 'a word) = m"
       apply (subst unat_of_nat)
       apply (subst mod_less)
        apply (erule order_less_le_trans)
        apply (rule power_increasing)
         apply simp_all
       done
 
     then show "?thesis m s" using s m
       apply (subst iffD1 [OF unat_mult_lem])
       apply (simp add: nat_less_power_trans)+
       done
   qed
   have s1wb: "s1 < LENGTH('a)" using s2wb s1s2 by simp
   from alm obtain mq where mmq: "m = 2 ^ s1 * of_nat mq" and mq: "mq < 2 ^ (LENGTH('a) - s1)"
     by (auto elim: is_alignedE simp: field_simps)
   from aln obtain nq where nnq: "n = 2 ^ s2 * of_nat nq" and nq: "nq < 2 ^ (LENGTH('a) - s2)"
     by (auto elim: is_alignedE simp: field_simps)
   from s1s2 obtain sq where sq: "s2 = s1 + sq" by (auto simp: le_iff_add)
 
   note us1 = rl [OF mq s1wb]
   note us2 = rl [OF nq s2wb]
 
   from nm have "n \<le> m" by clarsimp
   then have "(2::'a word) ^ s2 * of_nat nq \<le> 2 ^ s1 * of_nat mq" using nnq mmq by simp
   then have "2 ^ s2 * nq \<le> 2 ^ s1 * mq" using s1wb s2wb
     by (simp add: word_le_nat_alt us1 us2)
   then have nqmq: "2 ^ sq * nq \<le> mq" using sq by (simp add: power_add)
 
   have "m - n = 2 ^ s1 * of_nat mq - 2 ^ s2 * of_nat nq" using mmq nnq by simp
   also have "\<dots> = 2 ^ s1 * of_nat mq - 2 ^ s1 * 2 ^ sq * of_nat nq" using sq by (simp add: power_add)
   also have "\<dots> = 2 ^ s1 * (of_nat mq - 2 ^ sq * of_nat nq)" by (simp add: field_simps)
   also have "\<dots> = 2 ^ s1 * of_nat (mq - 2 ^ sq * nq)" using s1wb s2wb us1 us2 nqmq
     by (simp add:  word_unat_power)
   finally have mn: "m - n = of_nat (mq - 2 ^ sq * nq) * 2 ^ s1" by simp
   moreover
   from nm have "m - n \<le> 2 ^ s2 - 1"
     by - (rule word_diff_ls', (simp add: field_simps)+)
   then have "(2::'a word) ^ s1 * of_nat (mq - 2 ^ sq * nq) < 2 ^ s2" using mn s2wb by (simp add: field_simps)
   then have "of_nat (mq - 2 ^ sq * nq) < (2::'a word) ^ (s2 - s1)"
   proof (rule word_power_less_diff)
     have mm: "mq - 2 ^ sq * nq < 2 ^ (LENGTH('a) - s1)" using mq by simp
     moreover from s10 have "LENGTH('a) - s1 < LENGTH('a)"
       by (rule diff_less, simp)
     ultimately show "of_nat (mq - 2 ^ sq * nq) < (2::'a word) ^ (LENGTH('a) - s1)"
       apply (simp add: word_less_nat_alt)
       apply (subst unat_of_nat)
       apply (subst mod_less)
        apply (erule order_less_le_trans)
        apply simp+
       done
   qed
   then have "mq - 2 ^ sq * nq < 2 ^ (s2 - s1)" using mq s2wb
     apply (simp add: word_less_nat_alt)
     apply (subst (asm) unat_of_nat)
     apply (subst (asm) mod_less)
     apply (rule order_le_less_trans)
     apply (rule diff_le_self)
     apply (erule order_less_le_trans)
     apply simp
     apply assumption
     done
   ultimately show ?thesis by auto
 qed
 
 lemma word_less_sub_1:
   "x < (y :: 'a :: len word) \<Longrightarrow> x \<le> y - 1"
   apply (erule udvd_minus_le')
    apply (simp add: udvd_def)+
   done
 
 lemma word_sub_mono2:
   "\<lbrakk> a + b \<le> c + d; c \<le> a; b \<le> a + b; d \<le> c + d \<rbrakk>
     \<Longrightarrow> b \<le> (d :: 'a :: len word)"
   apply (drule(1) word_sub_mono)
     apply simp
    apply simp
   apply simp
   done
 
 lemma word_not_le:
   "(\<not> x \<le> (y :: 'a :: len word)) = (y < x)"
   by fastforce
 
 lemma word_subset_less:
   "\<lbrakk> {x .. x + r - 1} \<subseteq> {y .. y + s - 1};
      x \<le> x + r - 1; y \<le> y + (s :: 'a :: len word) - 1;
      s \<noteq> 0 \<rbrakk>
      \<Longrightarrow> r \<le> s"
   apply (frule subsetD[where c=x])
    apply simp
   apply (drule subsetD[where c="x + r - 1"])
    apply simp
   apply (clarsimp simp: add_diff_eq[symmetric])
   apply (drule(1) word_sub_mono2)
     apply (simp_all add: olen_add_eqv[symmetric])
   apply (erule word_le_minus_cancel)
   apply (rule ccontr)
   apply (simp add: word_not_le)
   done
 
 lemma uint_power_lower:
   "n < LENGTH('a) \<Longrightarrow> uint (2 ^ n :: 'a :: len word) = (2 ^ n :: int)"
   by (rule uint_2p_alt)
 
 lemma power_le_mono:
   "\<lbrakk>2 ^ n \<le> (2::'a::len word) ^ m; n < LENGTH('a); m < LENGTH('a)\<rbrakk>
    \<Longrightarrow> n \<le> m"
   apply (clarsimp simp add: le_less)
   apply safe
   apply (simp add: word_less_nat_alt)
   apply (simp only: uint_arith_simps(3))
   apply (drule uint_power_lower)+
   apply simp
   done
 
 lemma sublist_equal_part:
   "prefix xs ys \<Longrightarrow> take (length xs) ys = xs"
   by (clarsimp simp: prefix_def)
 
 lemma two_power_eq:
   "\<lbrakk>n < LENGTH('a); m < LENGTH('a)\<rbrakk>
    \<Longrightarrow> ((2::'a::len word) ^ n = 2 ^ m) = (n = m)"
   apply safe
   apply (rule order_antisym)
    apply (simp add: power_le_mono[where 'a='a])+
   done
 
 lemma prefix_length_less:
   "strict_prefix xs ys \<Longrightarrow> length xs < length ys"
   apply (clarsimp simp: strict_prefix_def)
   apply (frule prefix_length_le)
   apply (rule ccontr, simp)
   apply (clarsimp simp: prefix_def)
   done
 
 lemmas take_less = take_strict_prefix
 
 lemma not_prefix_longer:
   "\<lbrakk> length xs > length ys \<rbrakk> \<Longrightarrow> \<not> prefix xs ys"
   by (clarsimp dest!: prefix_length_le)
 
 lemma of_bl_length:
   "length xs < LENGTH('a) \<Longrightarrow> of_bl xs < (2 :: 'a::len word) ^ length xs"
   by (simp add: of_bl_length_less)
 
 lemma unat_of_nat_eq:
   "x < 2 ^ LENGTH('a) \<Longrightarrow> unat (of_nat x ::'a::len word) = x"
   by (rule unat_of_nat_len)
 
 lemma unat_eq_of_nat:
   "n < 2 ^ LENGTH('a) \<Longrightarrow> (unat (x :: 'a::len word) = n) = (x = of_nat n)"
   by (subst unat_of_nat_eq[where x=n, symmetric], simp+)
 
 lemma unat_less_helper:
   "x < of_nat n \<Longrightarrow> unat x < n"
   apply (simp add: word_less_nat_alt)
   apply (erule order_less_le_trans)
   apply (simp add: unat_of_nat)
   done
 
 lemma of_nat_0:
   "\<lbrakk>of_nat n = (0::('a::len) word); n < 2 ^ len_of (TYPE('a))\<rbrakk> \<Longrightarrow> n = 0"
   by (drule unat_of_nat_eq, simp)
 
 lemma minus_one_helper3:
   "x < y \<Longrightarrow> x \<le> (y :: 'a :: len word) - 1"
   apply (simp add: word_less_nat_alt word_le_nat_alt)
   apply (subst unat_minus_one)
    apply clarsimp
   apply arith
   done
 
 lemma minus_one_helper:
   "\<lbrakk> x \<le> y; x \<noteq> 0 \<rbrakk> \<Longrightarrow> x - 1 < (y :: 'a :: len word)"
   apply (simp add: word_less_nat_alt word_le_nat_alt)
   apply (subst unat_minus_one)
    apply assumption
   apply (cases "unat x")
    apply (simp add: unat_eq_zero)
   apply arith
   done
 
 lemma minus_one_helper5:
   fixes x :: "'a::len word"
   shows "\<lbrakk>y \<noteq> 0; x \<le> y - 1 \<rbrakk> \<Longrightarrow> x < y"
   using le_m1_iff_lt word_neq_0_conv by blast
 
 lemma not_greatest_aligned:
   "\<lbrakk> x < y; is_aligned x n; is_aligned y n \<rbrakk>
       \<Longrightarrow> x + 2 ^ n \<noteq> 0"
   apply (rule notI)
   apply (erule is_aligned_get_word_bits[where p=y])
    apply (simp add: eq_diff_eq[symmetric])
    apply (frule minus_one_helper3)
    apply (drule le_minus'[where a="x" and c="y - x" and b="- 1" for x y, simplified])
    apply (simp add: field_simps)
    apply (frule is_aligned_less_sz[where a=y])
      apply clarsimp
    apply (erule notE)
    apply (rule minus_one_helper5)
     apply simp
    apply (metis is_aligned_no_overflow minus_one_helper3 order_le_less_trans)
   apply simp
   done
 
 lemma of_nat_inj:
   "\<lbrakk>x < 2 ^ LENGTH('a); y < 2 ^ LENGTH('a)\<rbrakk> \<Longrightarrow>
    (of_nat x = (of_nat y :: 'a :: len word)) = (x = y)"
   by (simp add: word_unat.norm_eq_iff [symmetric])
 
 lemma map_prefixI:
   "prefix xs ys \<Longrightarrow> prefix (map f xs) (map f ys)"
   by (clarsimp simp: prefix_def)
 
 lemma if_Some_None_eq_None:
   "((if P then Some v else None) = None) = (\<not> P)"
   by simp
 
 lemma CollectPairFalse [iff]:
   "{(a,b). False} = {}"
   by (simp add: split_def)
 
 lemma if_conj_dist:
   "((if b then w else x) \<and> (if b then y else z) \<and> X) =
   ((if b then w \<and> y else x \<and> z) \<and> X)"
   by simp
 
 lemma if_P_True1:
   "Q \<Longrightarrow> (if P then True else Q)"
   by simp
 
 lemma if_P_True2:
   "Q \<Longrightarrow> (if P then Q else True)"
   by simp
 
 lemma list_all2_induct [consumes 1, case_names Nil Cons]:
   assumes lall: "list_all2 Q xs ys"
   and     nilr: "P [] []"
   and    consr: "\<And>x xs y ys. \<lbrakk>list_all2 Q xs ys; Q x y; P xs ys\<rbrakk> \<Longrightarrow> 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 list_all2_induct_suffixeq [consumes 1, case_names Nil Cons]:
   assumes lall: "list_all2 Q as bs"
   and     nilr: "P [] []"
   and    consr: "\<And>x xs y ys.
   \<lbrakk>list_all2 Q xs ys; Q x y; P xs ys; suffix (x # xs) as; suffix (y # ys) bs\<rbrakk>
   \<Longrightarrow> P (x # xs) (y # ys)"
   shows  "P as bs"
 proof -
   define as' where "as' == as"
   define bs' where "bs' == bs"
 
   have "suffix as as' \<and> suffix bs bs'" unfolding as'_def bs'_def by simp
   then show ?thesis using lall
   proof (induct rule: list_induct2 [OF list_all2_lengthD [OF lall]])
     case 1 show ?case by 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" using "2.hyps" "2.prems" by (auto dest: suffix_ConsD)
       from "2.prems" show "suffix (x # xs) as" and "suffix (y # ys) bs"
       by (auto simp: as'_def bs'_def)
     qed
   qed
 qed
 
 lemma upto_enum_step_shift:
   "\<lbrakk> is_aligned p n \<rbrakk> \<Longrightarrow>
   ([p , p + 2 ^ m .e. p + 2 ^ n - 1])
       = map ((+) p) [0, 2 ^ m .e. 2 ^ n - 1]"
   apply (erule is_aligned_get_word_bits)
    prefer 2
    apply (simp add: map_idI)
   apply (clarsimp simp: upto_enum_step_def)
   apply (frule is_aligned_no_overflow)
   apply (simp add: linorder_not_le [symmetric])
   done
 
 lemma upto_enum_step_shift_red:
   "\<lbrakk> is_aligned p sz; sz < len_of (TYPE('a)); us \<le> sz \<rbrakk>
      \<Longrightarrow> [p :: 'a :: len word, p + 2 ^ us .e. p + 2 ^ sz - 1]
           = map (\<lambda>x. p + of_nat x * 2 ^ us) [0 ..< 2 ^ (sz - us)]"
   apply (subst upto_enum_step_shift, assumption)
   apply (simp add: upto_enum_step_red)
   done
 
 lemma div_to_mult_word_lt:
   "\<lbrakk> (x :: 'a :: len word) \<le> y div z \<rbrakk> \<Longrightarrow> x * z \<le> y"
   apply (cases "z = 0")
    apply simp
   apply (simp add: word_neq_0_conv)
   apply (rule order_trans)
    apply (erule(1) word_mult_le_mono1)
    apply (simp add: unat_div)
    apply (rule order_le_less_trans [OF div_mult_le])
    apply simp
   apply (rule word_div_mult_le)
   done
 
 lemma upto_enum_step_subset:
   "set [x, y .e. z] \<subseteq> {x .. z}"
   apply (clarsimp simp: upto_enum_step_def linorder_not_less)
   apply (drule div_to_mult_word_lt)
   apply (rule conjI)
    apply (erule word_random[rotated])
    apply simp
   apply (rule order_trans)
    apply (erule word_plus_mono_right)
    apply simp
   apply simp
   done
 
 lemma shiftr_less_t2n':
   fixes x :: "'a :: len word"
   shows "\<lbrakk> x && mask (n + m) = x; m < LENGTH('a) \<rbrakk>
               \<Longrightarrow> (x >> n) < 2 ^ m"
   apply (subst mask_eq_iff_w2p[symmetric])
    apply (simp add: word_size)
   apply (rule word_eqI)
   apply (drule_tac x="na + n" in word_eqD)
   apply (simp add: nth_shiftr word_size)
   apply safe
   done
 
 lemma shiftr_less_t2n:
   fixes x :: "'a :: len word"
   shows "x < 2 ^ (n + m) \<Longrightarrow> (x >> n) < 2 ^ m"
   apply (rule shiftr_less_t2n')
    apply (erule less_mask_eq)
   apply (rule ccontr)
   apply (simp add: not_less)
   apply (subst (asm) p2_eq_0[symmetric])
   apply (simp add: power_add)
   done
 
 lemma shiftr_eq_0:
   "n \<ge> LENGTH('a) \<Longrightarrow> ((w::'a::len word) >> n) = 0"
   apply (cut_tac shiftr_less_t2n'[of w n 0], simp)
    apply (simp add: mask_eq_iff)
   apply (simp add: lt2p_lem)
   apply simp
   done
 
 lemma shiftr_not_mask_0:
-  "n+m \<ge> LENGTH('a :: len) \<Longrightarrow> ((w::'a::len word) >> n) && ~~ mask m = 0"
+  "n+m \<ge> LENGTH('a :: len) \<Longrightarrow> ((w::'a::len word) >> n) && ~~ (mask m) = 0"
   apply (simp add: and_not_mask shiftr_less_t2n shiftr_shiftr)
   apply (subgoal_tac "w >> n + m = 0", simp)
   apply (simp add: le_mask_iff[symmetric] mask_def le_def)
   apply (subst (asm) p2_gt_0[symmetric])
   apply (simp add: power_add not_less)
   done
 
 lemma shiftl_less_t2n:
   fixes x :: "'a :: len word"
   shows "\<lbrakk> x < (2 ^ (m - n)); m < LENGTH('a) \<rbrakk> \<Longrightarrow> (x << n) < 2 ^ m"
   apply (subst mask_eq_iff_w2p[symmetric])
    apply (simp add: word_size)
   apply (drule less_mask_eq)
   apply (rule word_eqI)
   apply (drule_tac x="na - n" in word_eqD)
   apply (simp add: nth_shiftl word_size)
   apply (cases "n \<le> m")
    apply safe
    apply simp
   apply simp
   done
 
 lemma shiftl_less_t2n':
   "(x::'a::len word) < 2 ^ m \<Longrightarrow> m+n < LENGTH('a) \<Longrightarrow> x << n < 2 ^ (m + n)"
   by (rule shiftl_less_t2n) simp_all
 
 lemma ucast_ucast_mask:
   "(ucast :: 'a :: len word \<Rightarrow> 'b :: len word) (ucast x) = x && mask (len_of TYPE ('a))"
   apply (rule word_eqI)
   apply (simp add: nth_ucast word_size)
   done
 
 lemma ucast_ucast_len:
   "\<lbrakk> x < 2 ^ LENGTH('b) \<rbrakk> \<Longrightarrow> ucast (ucast x::'b::len word) = (x::'a::len word)"
   apply (subst ucast_ucast_mask)
   apply (erule less_mask_eq)
   done
 
 lemma unat_ucast:
   "unat (ucast x :: ('a :: len0) word) = unat x mod 2 ^ (LENGTH('a))"
   apply (simp add: unat_def ucast_def)
   apply (subst word_uint.eq_norm)
   apply (subst nat_mod_distrib)
     apply simp
    apply simp
   apply (subst nat_power_eq)
    apply simp
   apply simp
   done
 
 lemma ucast_less_ucast:
   "LENGTH('a) < LENGTH('b) \<Longrightarrow>
    (ucast x < ((ucast (y :: 'a::len word)) :: 'b::len word)) = (x < y)"
   apply (simp add: word_less_nat_alt unat_ucast)
   apply (subst mod_less)
    apply(rule less_le_trans[OF unat_lt2p], simp)
   apply (subst mod_less)
    apply(rule less_le_trans[OF unat_lt2p], simp)
   apply simp
   done
 
 lemma sints_subset:
   "m \<le> n \<Longrightarrow> sints m \<subseteq> sints n"
   apply (simp add: sints_num)
   apply clarsimp
   apply (rule conjI)
    apply (erule order_trans[rotated])
    apply simp
   apply (erule order_less_le_trans)
   apply simp
   done
 
 lemma up_scast_inj:
       "\<lbrakk> scast x = (scast y :: 'b :: len word); size x \<le> LENGTH('b) \<rbrakk>
          \<Longrightarrow> x = y"
   apply (simp add: scast_def)
   apply (subst(asm) word_sint.Abs_inject)
     apply (erule subsetD [OF sints_subset])
     apply (simp add: word_size)
    apply (erule subsetD [OF sints_subset])
    apply (simp add: word_size)
   apply simp
   done
 
 lemma up_scast_inj_eq:
   "LENGTH('a) \<le> len_of TYPE ('b) \<Longrightarrow>
   (scast x = (scast y::'b::len word)) = (x = (y::'a::len word))"
   by (fastforce dest: up_scast_inj simp: word_size)
 
 lemma nth_bounded:
   "\<lbrakk>(x :: 'a :: len word) !! n; x < 2 ^ m; m \<le> len_of TYPE ('a)\<rbrakk> \<Longrightarrow> n < m"
   apply (frule test_bit_size)
   apply (clarsimp simp: test_bit_bl word_size)
   apply (simp add: nth_rev)
   apply (subst(asm) is_aligned_add_conv[OF is_aligned_0',
                                         simplified add_0_left, rotated])
    apply assumption+
   apply (simp only: to_bl_0)
   apply (simp add: nth_append split: if_split_asm)
   done
 
 lemma is_aligned_add_or:
   "\<lbrakk>is_aligned p n; d < 2 ^ n\<rbrakk> \<Longrightarrow> p + d = p || d"
   apply (rule word_plus_and_or_coroll)
   apply (erule is_aligned_get_word_bits)
    apply (rule word_eqI)
    apply (clarsimp simp add: is_aligned_nth)
    apply (frule(1) nth_bounded)
     apply simp+
   done
 
 lemma two_power_increasing:
   "\<lbrakk> n \<le> m; m < LENGTH('a) \<rbrakk> \<Longrightarrow> (2 :: 'a :: len word) ^ n \<le> 2 ^ m"
   by (simp add: word_le_nat_alt)
 
 lemma is_aligned_add_less_t2n:
   "\<lbrakk>is_aligned (p::'a::len word) n; d < 2^n; n \<le> m; p < 2^m\<rbrakk> \<Longrightarrow> p + d < 2^m"
   apply (case_tac "m < LENGTH('a)")
    apply (subst mask_eq_iff_w2p[symmetric])
     apply (simp add: word_size)
    apply (simp add: is_aligned_add_or word_ao_dist less_mask_eq)
    apply (subst less_mask_eq)
     apply (erule order_less_le_trans)
     apply (erule(1) two_power_increasing)
    apply simp
   apply (simp add: power_overflow)
   done
 
 
 lemma aligned_offset_non_zero:
   "\<lbrakk> is_aligned x n; y < 2 ^ n; x \<noteq> 0 \<rbrakk> \<Longrightarrow> x + y \<noteq> 0"
   apply (cases "y = 0")
    apply simp
   apply (subst word_neq_0_conv)
   apply (subst gt0_iff_gem1)
   apply (erule is_aligned_get_word_bits)
    apply (subst field_simps[symmetric], subst plus_le_left_cancel_nowrap)
      apply (rule is_aligned_no_wrap')
       apply simp
      apply (rule minus_one_helper)
       apply simp
      apply assumption
     apply (erule (1) is_aligned_no_wrap')
    apply (simp add: gt0_iff_gem1 [symmetric] word_neq_0_conv)
   apply simp
   done
 
 lemmas mask_inner_mask = mask_eqs(1)
 
 lemma mask_add_aligned:
   "is_aligned p n \<Longrightarrow> (p + q) && mask n = q && mask n"
   apply (simp add: is_aligned_mask)
   apply (subst mask_inner_mask [symmetric])
   apply simp
   done
 
 lemma take_prefix:
   "(take (length xs) ys = xs) = prefix xs ys"
 proof (induct xs arbitrary: ys)
   case Nil then show ?case by simp
 next
   case Cons then show ?case by (cases ys) auto
 qed
 
 lemma cart_singleton_empty:
   "(S \<times> {e} = {}) = (S = {})"
   by blast
 
 lemma word_div_1:
   "(n :: 'a :: len word) div 1 = n"
   by (simp add: word_div_def)
 
 lemma word_minus_one_le:
   "-1 \<le> (x :: 'a :: len word) = (x = -1)"
   apply (insert word_n1_ge[where y=x])
   apply safe
   apply (erule(1) order_antisym)
   done
 
 lemma mask_out_sub_mask:
-  "(x && ~~ mask n) = x - (x && mask n)"
+  "(x && ~~ (mask n)) = x - (x && (mask n))"
   by (simp add: field_simps word_plus_and_or_coroll2)
 
 lemma is_aligned_addD1:
   assumes al1: "is_aligned (x + y) n"
   and     al2: "is_aligned (x::'a::len word) n"
   shows "is_aligned y n"
   using al2
 proof (rule is_aligned_get_word_bits)
   assume "x = 0" then show ?thesis using al1 by simp
 next
   assume nv: "n < LENGTH('a)"
   from al1 obtain q1
     where xy: "x + y = 2 ^ n * of_nat q1" and "q1 < 2 ^ (LENGTH('a) - n)"
     by (rule is_alignedE)
   moreover from al2 obtain q2
     where x: "x = 2 ^ n * of_nat q2" and "q2 < 2 ^ (LENGTH('a) - n)"
     by (rule is_alignedE)
   ultimately have "y = 2 ^ n * (of_nat q1 - of_nat q2)"
     by (simp add: field_simps)
   then show ?thesis using nv by (simp add: is_aligned_mult_triv1)
 qed
 
 lemmas is_aligned_addD2 =
        is_aligned_addD1[OF subst[OF add.commute,
                                  of "%x. is_aligned x n" for n]]
 
 lemma is_aligned_add:
   "\<lbrakk>is_aligned p n; is_aligned q n\<rbrakk> \<Longrightarrow> is_aligned (p + q) n"
   by (simp add: is_aligned_mask mask_add_aligned)
 
 lemma word_le_add:
   fixes x :: "'a :: len word"
   shows "x \<le> y \<Longrightarrow> \<exists>n. y = x + of_nat n"
   by (rule exI [where x = "unat (y - x)"]) simp
 
 lemma word_plus_mcs_4':
   fixes x :: "'a :: len word"
   shows "\<lbrakk>x + v \<le> x + w; x \<le> x + v\<rbrakk> \<Longrightarrow> v \<le> w"
   apply (rule word_plus_mcs_4)
    apply (simp add: add.commute)
   apply (simp add: add.commute)
   done
 
 lemma shiftl_mask_is_0[simp]:
   "(x << n) && mask n = 0"
   apply (rule iffD1 [OF is_aligned_mask])
   apply (rule is_aligned_shiftl_self)
   done
 
 definition
   sum_map :: "('a \<Rightarrow> 'b) \<Rightarrow> ('c \<Rightarrow> 'd) \<Rightarrow> 'a + 'c \<Rightarrow> 'b + 'd" where
  "sum_map f g x \<equiv> case x of Inl v \<Rightarrow> Inl (f v) | Inr v' \<Rightarrow> Inr (g v')"
 
 lemma sum_map_simps[simp]:
   "sum_map f g (Inl v) = Inl (f v)"
   "sum_map f g (Inr w) = Inr (g w)"
   by (simp add: sum_map_def)+
 
 lemma if_and_helper:
   "(If x v v') && v'' = If x (v && v'') (v' && v'')"
   by (rule if_distrib)
 
 lemma unat_Suc2:
   fixes n :: "'a :: len word"
   shows
   "n \<noteq> -1 \<Longrightarrow> unat (n + 1) = Suc (unat n)"
   apply (subst add.commute, rule unatSuc)
   apply (subst eq_diff_eq[symmetric], simp add: minus_equation_iff)
   done
 
 lemmas word_unat_Rep_inject1 = word_unat.Rep_inject[where y=1]
 lemmas unat_eq_1 = unat_eq_0 word_unat_Rep_inject1[simplified]
 
 
 lemma rshift_sub_mask_eq:
   "(a >> (size a - b)) && mask b = a >> (size a - b)"
   using shiftl_shiftr2[where a=a and b=0 and c="size a - b"]
   apply (cases "b < size a")
    apply simp
   apply (simp add: linorder_not_less mask_def word_size
                    p2_eq_0[THEN iffD2])
   done
 
 lemma shiftl_shiftr3:
   "b \<le> c \<Longrightarrow> a << b >> c = (a >> c - b) && mask (size a - c)"
   apply (cases "b = c")
    apply (simp add: shiftl_shiftr1)
   apply (simp add: shiftl_shiftr2)
   done
 
 lemma and_mask_shiftr_comm:
   "m\<le>size w \<Longrightarrow> (w && mask m) >> n = (w >> n) && mask (m-n)"
   by (simp add: and_mask shiftr_shiftr) (simp add: word_size shiftl_shiftr3)
 
 lemma and_mask_shiftl_comm:
   "m+n \<le> size w \<Longrightarrow> (w && mask m) << n = (w << n) && mask (m+n)"
   by (simp add: and_mask word_size shiftl_shiftl) (simp add: shiftl_shiftr1)
 
 lemma le_mask_shiftl_le_mask: "s = m + n \<Longrightarrow> x \<le> mask n \<Longrightarrow> x << m \<le> mask s"
   by (simp add: le_mask_iff shiftl_shiftr3)
 
 lemma and_not_mask_twice:
-  "(w && ~~ mask n) && ~~ mask m = w && ~~ mask (max m n)"
+  "(w && ~~ (mask n)) && ~~ (mask m) = w && ~~ (mask (max m n))"
   apply (simp add: and_not_mask)
   apply (case_tac "n<m";
          simp add: shiftl_shiftr2 shiftl_shiftr1 not_less max_def shiftr_shiftr shiftl_shiftl)
    apply (cut_tac and_mask_shiftr_comm [where w=w and m="size w" and n=m, simplified,symmetric])
    apply (simp add: word_size mask_def)
   apply (cut_tac and_mask_shiftr_comm [where w=w and m="size w" and n=n, simplified,symmetric])
   apply (simp add: word_size mask_def)
   done
 
 lemma word_less_cases:
   "x < y \<Longrightarrow> x = y - 1 \<or> x < y - (1 ::'a::len word)"
   apply (drule word_less_sub_1)
   apply (drule order_le_imp_less_or_eq)
   apply auto
   done
 
 lemma eq_eqI:
   "a = b \<Longrightarrow> (a = x) = (b = x)"
   by simp
 
 lemma mask_and_mask:
   "mask a && mask b = mask (min a b)"
   by (rule word_eqI) (simp add: word_size)
 
 lemma mask_eq_0_eq_x:
   "(x && w = 0) = (x && ~~ w = x)"
   using word_plus_and_or_coroll2[where x=x and w=w]
   by auto
 
 lemma mask_eq_x_eq_0:
   "(x && w = x) = (x && ~~ w = 0)"
   using word_plus_and_or_coroll2[where x=x and w=w]
   by auto
 
 definition
   "limited_and (x :: 'a :: len word) y = (x && y = x)"
 
 lemma limited_and_eq_0:
   "\<lbrakk> limited_and x z; y && ~~ z = y \<rbrakk> \<Longrightarrow> x && y = 0"
   unfolding limited_and_def
   apply (subst arg_cong2[where f="(&&)"])
     apply (erule sym)+
   apply (simp(no_asm) add: word_bw_assocs word_bw_comms word_bw_lcs)
   done
 
 lemma limited_and_eq_id:
   "\<lbrakk> limited_and x z; y && z = z \<rbrakk> \<Longrightarrow> x && y = x"
   unfolding limited_and_def
   by (erule subst, fastforce simp: word_bw_lcs word_bw_assocs word_bw_comms)
 
 lemma lshift_limited_and:
   "limited_and x z \<Longrightarrow> limited_and (x << n) (z << n)"
   unfolding limited_and_def
   by (simp add: shiftl_over_and_dist[symmetric])
 
 lemma rshift_limited_and:
   "limited_and x z \<Longrightarrow> limited_and (x >> n) (z >> n)"
   unfolding limited_and_def
   by (simp add: shiftr_over_and_dist[symmetric])
 
 lemmas limited_and_simps1 = limited_and_eq_0 limited_and_eq_id
 
 lemmas is_aligned_limited_and
     = is_aligned_neg_mask_eq[unfolded mask_def, folded limited_and_def]
 
 lemma compl_of_1: "~~ 1 = (-2 :: 'a :: len word)"
   by simp
 
 lemmas limited_and_simps = limited_and_simps1
        limited_and_simps1[OF is_aligned_limited_and]
        limited_and_simps1[OF lshift_limited_and]
        limited_and_simps1[OF rshift_limited_and]
        limited_and_simps1[OF rshift_limited_and, OF is_aligned_limited_and]
        compl_of_1 shiftl_shiftr1[unfolded word_size mask_def]
        shiftl_shiftr2[unfolded word_size mask_def]
 
 lemma split_word_eq_on_mask:
   "(x = y) = (x && m = y && m \<and> x && ~~ m = y && ~~ m)"
   apply safe
   apply (rule word_eqI)
   apply (drule_tac x=n in word_eqD)+
   by (auto simp: word_size word_ops_nth_size)
 
 lemma map2_Cons_2_3:
   "(map2 f xs (y # ys) = (z # zs)) = (\<exists>x xs'. xs = x # xs' \<and> f x y = z \<and> map2 f xs' ys = zs)"
   by (case_tac xs, simp_all)
 
 lemma map2_xor_replicate_False:
   "map2 (\<lambda>x y. x \<longleftrightarrow> \<not> y) xs (replicate n False) = take n xs"
   apply (induct xs arbitrary: n)
    apply simp
   apply (case_tac n)
    apply simp_all
   done
 
 lemma word_or_zero:
   "(a || b = 0) = (a = 0 \<and> b = 0)"
   apply (safe, simp_all)
    apply (rule word_eqI, drule_tac x=n in word_eqD, simp)+
   done
 
 lemma word_and_1_shiftl:
   fixes x :: "'a :: len word" shows
   "x && (1 << n) = (if x !! n then (1 << n) else 0)"
   apply (rule word_eqI)
   apply (simp add: word_size nth_shiftl del: shiftl_1)
   apply auto
   done
 
 lemmas word_and_1_shiftls'
     = word_and_1_shiftl[where n=0]
       word_and_1_shiftl[where n=1]
       word_and_1_shiftl[where n=2]
 
 lemmas word_and_1_shiftls = word_and_1_shiftls' [simplified]
 
 lemma word_and_mask_shiftl:
   "x && (mask n << m) = ((x >> m) && mask n) << m"
   apply (rule word_eqI)
   apply (simp add: word_size nth_shiftl nth_shiftr)
   apply auto
   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 word_FF_is_mask:
   "0xFF = mask 8"
   by (simp add: mask_def)
 
 lemma word_1FF_is_mask:
   "0x1FF = mask 9"
   by (simp add: mask_def)
 
 lemma ucast_of_nat_small:
   "x < 2 ^ LENGTH('a) \<Longrightarrow> ucast (of_nat x :: 'a :: len word) = (of_nat x :: 'b :: len word)"
   apply (rule sym, subst word_unat.inverse_norm)
   apply (simp add: ucast_def word_of_int[symmetric]
                    of_nat_nat[symmetric] unat_def[symmetric])
   apply (simp add: unat_of_nat)
   done
 
 lemma word_le_make_less:
   fixes x :: "'a :: len word"
   shows "y \<noteq> -1 \<Longrightarrow> (x \<le> y) = (x < (y + 1))"
   apply safe
   apply (erule plus_one_helper2)
   apply (simp add: eq_diff_eq[symmetric])
   done
 
 lemmas finite_word = finite [where 'a="'a::len word"]
 
 lemma word_to_1_set:
   "{0 ..< (1 :: 'a :: len word)} = {0}"
   by fastforce
 
 lemma range_subset_eq2:
   "{a :: 'a :: len word .. b} \<noteq> {} \<Longrightarrow> ({a .. b} \<subseteq> {c .. d}) = (c \<le> a \<and> b \<le> d)"
   by simp
 
 lemma word_count_from_top:
   "n \<noteq> 0 \<Longrightarrow> {0 ..< n :: 'a :: len word} = {0 ..< n - 1} \<union> {n - 1}"
   apply (rule set_eqI, rule iffI)
    apply simp
    apply (drule minus_one_helper3)
    apply (rule disjCI)
    apply simp
   apply simp
   apply (erule minus_one_helper5)
   apply fastforce
   done
 
 lemma minus_one_helper2:
   "\<lbrakk> x - 1 < y \<rbrakk> \<Longrightarrow> x \<le> (y :: 'a :: len word)"
   apply (cases "x = 0")
    apply simp
   apply (simp add: word_less_nat_alt word_le_nat_alt)
   apply (subst(asm) unat_minus_one)
    apply (simp add: word_less_nat_alt)
   apply (cases "unat x")
    apply (simp add: unat_eq_zero)
   apply arith
   done
 
 lemma mod_mod_power:
   fixes k :: nat
   shows "k mod 2 ^ m mod 2 ^ n = k mod 2 ^ (min m n)"
 proof (cases "m \<le> n")
   case True
 
   then have "k mod 2 ^ m mod 2 ^ n = k mod 2 ^ m"
     apply -
     apply (subst mod_less [where n = "2 ^ n"])
     apply (rule order_less_le_trans [OF mod_less_divisor])
     apply simp+
     done
   also have "\<dots> = k mod  2 ^ (min m n)" using True by simp
   finally show ?thesis .
 next
   case False
   then have "n < m" by simp
   then obtain d where md: "m = n + d"
     by (auto dest: less_imp_add_positive)
   then have "k mod 2 ^ m = 2 ^ n * (k div 2 ^ n mod 2 ^ d) + k mod 2 ^ n"
     by (simp add: mod_mult2_eq power_add)
   then have "k mod 2 ^ m mod 2 ^ n = k mod 2 ^ n"
     by (simp add: mod_add_left_eq)
   then show ?thesis using False
     by simp
 qed
 
 lemma word_div_less:
   fixes m :: "'a :: len word"
   shows "m < n \<Longrightarrow> m div n = 0"
   apply (rule word_unat.Rep_eqD)
   apply (simp add: word_less_nat_alt unat_div)
   done
 
 lemma word_must_wrap:
   "\<lbrakk> x \<le> n - 1; n \<le> x \<rbrakk> \<Longrightarrow> n = (0 :: 'a :: len word)"
   apply (rule ccontr)
   apply (drule(1) order_trans)
   apply (drule word_sub_1_le)
   apply (drule(1) order_antisym)
   apply simp
   done
 
 lemma range_subset_card:
   "\<lbrakk> {a :: 'a :: len word .. b} \<subseteq> {c .. d}; b \<ge> a \<rbrakk>
      \<Longrightarrow> d \<ge> c \<and> d - c \<ge> b - a"
   apply (subgoal_tac "a \<in> {a .. b}")
    apply (frule(1) range_subset_lower)
    apply (frule(1) range_subset_upper)
    apply (rule context_conjI, simp)
    apply (rule word_sub_mono, assumption+)
     apply (erule word_sub_le)
    apply (erule word_sub_le)
   apply simp
   done
 
 lemma less_1_simp:
   "n - 1 < m = (n \<le> (m :: 'a :: len word) \<and> n \<noteq> 0)"
   by unat_arith
 
 lemma alignUp_div_helper:
   fixes a :: "'a::len word"
   assumes kv: "k < 2 ^ (LENGTH('a) - n)"
   and     xk: "x = 2 ^ n * of_nat k"
   and    le: "a \<le> x"
   and    sz: "n < LENGTH('a)"
   and   anz: "a mod 2 ^ n \<noteq> 0"
   shows "a div 2 ^ n < of_nat k"
 proof -
   have kn: "unat (of_nat k :: 'a word) * unat ((2::'a word) ^ n)
             < 2 ^ LENGTH('a)"
     using xk kv sz
     apply (subst unat_of_nat_eq)
      apply (erule order_less_le_trans)
      apply simp
     apply (subst unat_power_lower, simp)
     apply (subst mult.commute)
     apply (rule nat_less_power_trans)
      apply simp
     apply simp
     done
 
   have "unat a div 2 ^ n * 2 ^ n \<noteq> unat a"
   proof -
     have "unat a = unat a div 2 ^ n * 2 ^ n + unat a mod 2 ^ n"
       by (simp add: div_mult_mod_eq)
     also have "\<dots> \<noteq> unat a div 2 ^ n * 2 ^ n" using sz anz
       by (simp add: unat_arith_simps)
     finally show ?thesis ..
   qed
 
   then have "a div 2 ^ n * 2 ^ n < a" using sz anz
     apply (subst word_less_nat_alt)
     apply (subst unat_word_ariths)
     apply (subst unat_div)
     apply simp
     apply (rule order_le_less_trans [OF mod_less_eq_dividend])
     apply (erule order_le_neq_trans [OF div_mult_le])
     done
 
   also from xk le have "\<dots> \<le> of_nat k * 2 ^ n" by (simp add: field_simps)
   finally show ?thesis using sz kv
     apply -
     apply (erule word_mult_less_dest [OF _ _ kn])
     apply (simp add: unat_div)
     apply (rule order_le_less_trans [OF div_mult_le])
     apply (rule unat_lt2p)
     done
 qed
 
 lemma nat_mod_power_lem:
   fixes a :: nat
   shows "1 < a \<Longrightarrow> a ^ n mod a ^ m = (if m \<le> n then 0 else a ^ n)"
   apply (clarsimp)
   apply (clarsimp simp add: le_iff_add power_add)
   done
 
 lemma power_mod_div:
   fixes x :: "nat"
   shows "x mod 2 ^ n div 2 ^ m = x div 2 ^ m mod 2 ^ (n - m)" (is "?LHS = ?RHS")
 proof (cases "n \<le> m")
   case True
   then have "?LHS = 0"
     apply -
     apply (rule div_less)
     apply (rule order_less_le_trans [OF mod_less_divisor])
      apply simp
     apply simp
     done
   also have "\<dots> = ?RHS" using True
     by simp
   finally show ?thesis .
 next
   case False
   then have lt: "m < n" by simp
   then obtain q where nv: "n = m + q" and "0 < q"
     by (auto dest: less_imp_Suc_add)
 
   then have "x mod 2 ^ n = 2 ^ m * (x div 2 ^ m mod 2 ^ q) + x mod 2 ^ m"
     by (simp add: power_add mod_mult2_eq)
 
   then have "?LHS = x div 2 ^ m mod 2 ^ q"
     by (simp add: div_add1_eq)
 
   also have "\<dots> = ?RHS" using nv
     by simp
 
   finally show ?thesis .
 qed
 
 lemma word_power_mod_div:
   fixes x :: "'a::len word"
   shows "\<lbrakk> n < LENGTH('a); m < LENGTH('a)\<rbrakk>
   \<Longrightarrow> x mod 2 ^ n div 2 ^ m = x div 2 ^ m mod 2 ^ (n - m)"
   apply (simp add: word_arith_nat_div unat_mod power_mod_div)
   apply (subst unat_arith_simps(3))
   apply (subst unat_mod)
   apply (subst unat_of_nat)+
   apply (simp add: mod_mod_power min.commute)
   done
 
 lemma word_range_minus_1':
   fixes a :: "'a :: len word"
   shows "a \<noteq> 0 \<Longrightarrow> {a - 1<..b} = {a..b}"
   by (simp add: greaterThanAtMost_def atLeastAtMost_def greaterThan_def atLeast_def less_1_simp)
 
 lemma word_range_minus_1:
   fixes a :: "'a :: len word"
   shows "b \<noteq> 0 \<Longrightarrow> {a..b - 1} = {a..<b}"
   apply (simp add: atLeastLessThan_def atLeastAtMost_def atMost_def lessThan_def)
   apply (rule arg_cong [where f = "\<lambda>x. {a..} \<inter> x"])
   apply rule
    apply clarsimp
    apply (erule contrapos_pp)
    apply (simp add: linorder_not_less linorder_not_le word_must_wrap)
   apply (clarsimp)
   apply (drule minus_one_helper3)
   apply (auto simp: word_less_sub_1)
   done
 
 lemma ucast_nat_def:
   "of_nat (unat x) = (ucast :: 'a :: len word \<Rightarrow> 'b :: len word) x"
   by (simp add: ucast_def word_of_int_nat unat_def)
 
 lemmas if_fun_split = if_apply_def2
 
 lemma i_hate_words_helper:
   "i \<le> (j - k :: nat) \<Longrightarrow> i \<le> j"
   by simp
 
 lemma i_hate_words:
   "unat (a :: 'a word) \<le> unat (b :: 'a :: len word) - Suc 0
     \<Longrightarrow> a \<noteq> -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 overflow_plus_one_self:
   "(1 + p \<le> p) = (p = (-1 :: 'a :: len word))"
   apply (safe, simp_all)
   apply (rule ccontr)
   apply (drule plus_one_helper2)
    apply (rule notI)
    apply (drule arg_cong[where f="\<lambda>x. x - 1"])
    apply simp
   apply (simp add: field_simps)
   done
 
 lemma plus_1_less:
   "(x + 1 \<le> (x :: 'a :: len word)) = (x = -1)"
   apply (rule iffI)
    apply (rule ccontr)
    apply (cut_tac plus_one_helper2[where x=x, OF order_refl])
     apply simp
    apply clarsimp
    apply (drule arg_cong[where f="\<lambda>x. x - 1"])
    apply simp
   apply simp
   done
 
 lemma pos_mult_pos_ge:
   "[|x > (0::int); n>=0 |] ==> n * x >= n*1"
   apply (simp only: mult_left_mono)
   done
 
 lemma If_eq_obvious:
   "x \<noteq> z \<Longrightarrow> ((if P then x else y) = z) = (\<not> P \<and> y = z)"
   by simp
 
 lemma Some_to_the:
   "v = Some x \<Longrightarrow> x = the v"
   by simp
 
 lemma dom_if_Some:
   "dom (\<lambda>x. if P x then Some (f x) else g x) = {x. P x} \<union> dom g"
   by fastforce
 
 lemma dom_insert_absorb:
   "x \<in> dom f \<Longrightarrow> insert x (dom f) = dom f" by auto
 
 lemma emptyE2:
   "\<lbrakk> S = {}; x \<in> S \<rbrakk> \<Longrightarrow> P"
   by simp
 
 lemma mod_div_equality_div_eq:
   "a div b * b = (a - (a mod b) :: int)"
   by (simp add: field_simps)
 
 lemma zmod_helper:
   "n mod m = k \<Longrightarrow> ((n :: int) + a) mod m = (k + a) mod m"
   by (metis add.commute mod_add_right_eq)
 
 lemma int_div_sub_1:
   "\<lbrakk> m \<ge> 1 \<rbrakk> \<Longrightarrow> (n - (1 :: int)) div m = (if m dvd n then (n div m) - 1 else n div m)"
   apply (subgoal_tac "m = 0 \<or> (n - (1 :: int)) div m = (if m dvd n then (n div m) - 1 else n div m)")
    apply fastforce
   apply (subst mult_cancel_right[symmetric])
   apply (simp only: left_diff_distrib split: if_split)
   apply (simp only: mod_div_equality_div_eq)
   apply (clarsimp simp: field_simps)
   apply (clarsimp simp: dvd_eq_mod_eq_0)
   apply (cases "m = 1")
    apply simp
   apply (subst mod_diff_eq[symmetric], simp add: zmod_minus1)
   apply clarsimp
   apply (subst diff_add_cancel[where b=1, symmetric])
   apply (subst mod_add_eq[symmetric])
   apply (simp add: field_simps)
   apply (rule mod_pos_pos_trivial)
    apply (subst add_0_right[where a=0, symmetric])
    apply (rule add_mono)
     apply simp
    apply simp
   apply (cases "(n - 1) mod m = m - 1")
    apply (drule zmod_helper[where a=1])
    apply simp
   apply (subgoal_tac "1 + (n - 1) mod m \<le> m")
    apply simp
   apply (subst field_simps, rule zless_imp_add1_zle)
   apply simp
   done
 
 lemma ptr_add_image_multI:
   "\<lbrakk> \<And>x y. (x * val = y * val') = (x * val'' = y); x * val'' \<in> S \<rbrakk> \<Longrightarrow>
      ptr_add ptr (x * val) \<in> (\<lambda>p. ptr_add ptr (p * val')) ` S"
   apply (simp add: image_def)
   apply (erule rev_bexI)
   apply (rule arg_cong[where f="ptr_add ptr"])
   apply simp
   done
 
 lemma shift_times_fold:
   "(x :: 'a :: len word) * (2 ^ n) << m = x << (m + n)"
   by (simp add: shiftl_t2n ac_simps power_add)
 
 lemma word_plus_strict_mono_right:
   fixes x :: "'a :: len word"
   shows "\<lbrakk>y < z; x \<le> x + z\<rbrakk> \<Longrightarrow> x + y < x + z"
   by unat_arith
 
 lemma replicate_minus:
   "k < n \<Longrightarrow> replicate n False = replicate (n - k) False @ replicate k False"
   by (subst replicate_add [symmetric]) simp
 
 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 word_div_mult:
   "0 < c \<Longrightarrow> a < b * c \<Longrightarrow> a div c < b" for a b c :: "'a::len word"
   by (rule classical)
      (use div_to_mult_word_lt [of b a c] in
       \<open>auto simp add: word_less_nat_alt word_le_nat_alt unat_div\<close>)
 
 lemma word_less_power_trans_ofnat:
   "\<lbrakk>n < 2 ^ (m - k); k \<le> m; m < LENGTH('a)\<rbrakk>
    \<Longrightarrow> of_nat n * 2 ^ k < (2::'a::len word) ^ m"
   apply (subst mult.commute)
   apply (rule word_less_power_trans)
     apply (simp add: word_less_nat_alt)
     apply (subst unat_of_nat_eq)
      apply (erule order_less_trans)
      apply simp+
     done
 
 lemma word_1_le_power:
   "n < LENGTH('a) \<Longrightarrow> (1 :: 'a :: len word) \<le> 2 ^ n"
   by (rule inc_le[where i=0, simplified], erule iffD2[OF p2_gt_0])
 
 lemma enum_word_div:
   fixes v :: "'a :: len word" shows
   "\<exists>xs ys. enum = xs @ [v] @ ys
              \<and> (\<forall>x \<in> set xs. x < v)
              \<and> (\<forall>y \<in> set ys. v < y)"
   apply (simp only: enum_word_def)
   apply (subst upt_add_eq_append'[where j="unat v"])
     apply simp
    apply (rule order_less_imp_le, simp)
   apply (simp add: upt_conv_Cons)
   apply (intro exI conjI)
     apply fastforce
    apply clarsimp
    apply (drule of_nat_mono_maybe[rotated, where 'a='a])
     apply simp
    apply simp
   apply (clarsimp simp: Suc_le_eq)
   apply (drule of_nat_mono_maybe[rotated, where 'a='a])
    apply simp
   apply simp
   done
 
 lemma of_bool_nth:
   "of_bool (x !! v) = (x >> v) && 1"
   apply (rule word_eqI)
   apply (simp add: nth_shiftr cong: rev_conj_cong)
   done
 
 lemma unat_1_0:
   "1 \<le> (x::'a::len word) = (0 < unat x)"
   by (auto simp add: word_le_nat_alt)
 
 lemma x_less_2_0_1':
   fixes x :: "'a::len word"
   shows "\<lbrakk>LENGTH('a) \<noteq> 1; x < 2\<rbrakk> \<Longrightarrow> x = 0 \<or> x = 1"
   apply (induct x)
    apply clarsimp+
   by (metis Suc_eq_plus1 add_lessD1 less_irrefl one_add_one unatSuc word_less_nat_alt)
 
 lemmas word_add_le_iff2 = word_add_le_iff [folded no_olen_add_nat]
 
 lemma of_nat_power:
   shows "\<lbrakk> p < 2 ^ x; x < len_of TYPE ('a) \<rbrakk> \<Longrightarrow> of_nat p < (2 :: 'a :: len word) ^ x"
   apply (rule order_less_le_trans)
    apply (rule of_nat_mono_maybe)
     apply (erule power_strict_increasing)
     apply simp
    apply assumption
   apply (simp add: word_unat_power)
   done
 
 lemma of_nat_n_less_equal_power_2:
   "n < LENGTH('a::len) \<Longrightarrow> ((of_nat n)::'a word) < 2 ^ n"
   apply (induct n)
    apply clarsimp
   apply clarsimp
   apply (metis of_nat_power n_less_equal_power_2 of_nat_Suc power_Suc)
   done
 
 lemma eq_mask_less:
   fixes w :: "'a::len word"
   assumes eqm: "w = w && mask n"
   and      sz: "n < len_of TYPE ('a)"
   shows "w < (2::'a word) ^ n"
   by (subst eqm, rule and_mask_less' [OF sz])
 
 lemma of_nat_mono_maybe':
   fixes Y :: "nat"
   assumes xlt: "x < 2 ^ len_of TYPE ('a)"
   assumes ylt: "y < 2 ^ len_of TYPE ('a)"
   shows   "(y < x) = (of_nat y < (of_nat x :: 'a :: len word))"
   apply (subst word_less_nat_alt)
   apply (subst unat_of_nat)+
   apply (subst mod_less)
    apply (rule ylt)
   apply (subst mod_less)
    apply (rule xlt)
   apply simp
   done
 
 lemma shiftr_mask_eq:
   fixes x :: "'a :: len word"
   shows "(x >> n) && mask (size x - n) = x >> n"
   apply (rule word_eqI)
   apply (clarsimp simp: word_size nth_shiftr)
   apply (rule iffI)
    apply clarsimp
   apply (clarsimp)
   apply (drule test_bit_size)
   apply (simp add: word_size)
   done
 
 lemma shiftr_mask_eq':
   fixes x :: "'a :: len word"
   shows "m = (size x - n) \<Longrightarrow> (x >> n) && mask m = x >> n"
   by (simp add: shiftr_mask_eq)
 
 lemma bang_big: "n \<ge> size (x::'a::len0 word) \<Longrightarrow> (x !! n) = False"
   by (simp add: test_bit_bl word_size)
 
 lemma bang_conj_lt:
   fixes x :: "'a :: len word"
   shows "(x !! m \<and> m < LENGTH('a)) = x !! m"
   apply (cases "m < LENGTH('a)")
    apply simp
   apply (simp add: not_less bang_big  word_size)
   done
 
 lemma dom_if:
   "dom (\<lambda>a. if a \<in> addrs then Some (f a) else g a)  = addrs \<union> dom g"
   by (auto simp: dom_def split: if_split)
 
 lemma less_is_non_zero_p1:
   fixes a :: "'a :: len word"
   shows "a < k \<Longrightarrow> a + 1 \<noteq> 0"
   apply (erule contrapos_pn)
   apply (drule max_word_wrap)
   apply (simp add: not_less)
   done
 
 lemma of_nat_mono_maybe_le:
   "\<lbrakk>x < 2 ^ LENGTH('a); y < 2 ^ LENGTH('a)\<rbrakk> \<Longrightarrow>
   (y \<le> x) = ((of_nat y :: 'a :: len word) \<le> of_nat x)"
   apply (clarsimp simp: le_less)
   apply (rule disj_cong)
    apply (rule of_nat_mono_maybe', assumption+)
   apply (simp add: word_unat.norm_eq_iff [symmetric])
   done
 
 lemma neg_mask_bang:
-  "(~~ mask n :: 'a :: len word) !! m = (n \<le> m \<and> m < LENGTH('a))"
+  "(~~ (mask n :: 'a :: len word)) !! m = (n \<le> m \<and> m < LENGTH('a))"
   apply (cases "m < LENGTH('a)")
    apply (simp add: word_ops_nth_size word_size not_less)
   apply (simp add: not_less bang_big  word_size)
   done
 
 lemma mask_AND_NOT_mask:
-  "(w && ~~ mask n) && mask n = 0"
+  "(w && ~~ (mask n)) && mask n = 0"
 by (rule word_eqI) (clarsimp simp add: word_size neg_mask_bang)
 
 lemma AND_NOT_mask_plus_AND_mask_eq:
-  "(w && ~~ mask n) + (w && mask n) = w"
+  "(w && ~~ (mask n)) + (w && mask n) = w"
 apply (rule word_eqI)
 apply (rename_tac m)
 apply (simp add: word_size)
-apply (cut_tac word_plus_and_or_coroll[of "w && ~~ mask n" "w && mask n"])
+apply (cut_tac word_plus_and_or_coroll[of "w && ~~ (mask n)" "w && mask n"])
  apply (simp add: word_ao_dist2[symmetric] word_size neg_mask_bang)
 apply (rule word_eqI)
 apply (rename_tac m)
 apply (simp add: word_size neg_mask_bang)
 done
 
 lemma mask_eqI:
   fixes x :: "'a :: len word"
   assumes m1: "x && mask n = y && mask n"
-  and     m2: "x && ~~ mask n = y && ~~ mask n"
+  and     m2: "x && ~~ (mask n) = y && ~~ (mask n)"
   shows "x = y"
 proof (subst bang_eq, rule allI)
   fix m
 
   show "x !! m = y !! m"
   proof (cases "m < n")
     case True
     then have "x !! m = ((x && mask n) !! m)"
       by (simp add: word_size bang_conj_lt)
     also have "\<dots> = ((y && mask n) !! m)" using m1 by simp
     also have "\<dots> = y !! m" using True
       by (simp add: word_size bang_conj_lt)
     finally show ?thesis .
   next
     case False
-    then have "x !! m = ((x && ~~ mask n) !! m)"
+    then have "x !! m = ((x && ~~ (mask n)) !! m)"
       by (simp add: neg_mask_bang bang_conj_lt)
-    also have "\<dots> = ((y && ~~ mask n) !! m)" using m2 by simp
+    also have "\<dots> = ((y && ~~ (mask n)) !! m)" using m2 by simp
     also have "\<dots> = y !! m" using False
       by (simp add: neg_mask_bang bang_conj_lt)
     finally show ?thesis .
   qed
 qed
 
 lemma nat_less_power_trans2:
   fixes n :: nat
   shows "\<lbrakk>n < 2 ^ (m - k); k \<le> m\<rbrakk> \<Longrightarrow> n * 2 ^ k  < 2 ^ m"
   by (subst mult.commute, erule (1) nat_less_power_trans)
 
 lemma nat_move_sub_le: "(a::nat) + b \<le> c \<Longrightarrow> a \<le> c - b" by arith
 
 lemma neq_0_no_wrap:
   fixes x :: "'a :: len word"
   shows "\<lbrakk> x \<le> x + y; x \<noteq> 0 \<rbrakk> \<Longrightarrow> x + y \<noteq> 0"
   by clarsimp
 
 lemma plus_minus_one_rewrite:
   "v + (- 1 :: ('a :: {ring, one, uminus})) \<equiv> v - 1"
   by (simp add: field_simps)
 
 lemma power_minus_is_div:
   "b \<le> a \<Longrightarrow> (2 :: nat) ^ (a - b) = 2 ^ a div 2 ^ b"
   apply (induct a arbitrary: b)
    apply simp
   apply (erule le_SucE)
    apply (clarsimp simp:Suc_diff_le le_iff_add power_add)
   apply simp
   done
 
 lemma two_pow_div_gt_le:
   "v < 2 ^ n div (2 ^ m :: nat) \<Longrightarrow> m \<le> n"
   by (clarsimp dest!: less_two_pow_divD)
 
 lemma unatSuc2:
   fixes n :: "'a :: len word"
   shows "n + 1 \<noteq> 0 \<Longrightarrow> unat (n + 1) = Suc (unat n)"
   by (simp add: add.commute unatSuc)
 
 lemma word_of_nat_less:
   "\<lbrakk> n < unat x \<rbrakk> \<Longrightarrow> of_nat n < x"
   apply (simp add: word_less_nat_alt)
   apply (erule order_le_less_trans[rotated])
   apply (simp add: unat_of_nat)
   done
 
 lemma word_of_nat_le:
   "n \<le> unat x \<Longrightarrow> of_nat n \<le> x"
   apply (simp add: word_le_nat_alt unat_of_nat)
   apply (erule order_trans[rotated])
   apply simp
   done
 
 lemma word_unat_less_le:
    "a \<le> of_nat b \<Longrightarrow> unat a \<le> b"
    by (metis eq_iff le_cases le_unat_uoi word_of_nat_le)
 
 lemma and_eq_0_is_nth:
   fixes x :: "'a :: len word"
   shows "y = 1 << n \<Longrightarrow> ((x && y) = 0) = (\<not> (x !! n))"
   apply safe
    apply (drule_tac u="(x && (1 << n))" and x=n in word_eqD)
    apply (simp add: nth_w2p)
    apply (simp add: test_bit_bin)
   apply (rule word_eqI)
   apply (simp add: nth_w2p)
   done
 
 lemmas arg_cong_Not = arg_cong [where f=Not]
 lemmas and_neq_0_is_nth = arg_cong_Not [OF and_eq_0_is_nth, simplified]
 
 lemma nth_is_and_neq_0:
   "(x::'a::len word) !! n = (x && 2 ^ n \<noteq> 0)"
   by (subst and_neq_0_is_nth; rule refl)
 
 lemma mask_Suc_0 : "mask (Suc 0) = 1"
   by (simp add: mask_def)
 
 lemma ucast_ucast_add:
   fixes x :: "'a :: len word"
   fixes y :: "'b :: len word"
   shows
   "LENGTH('b) \<ge> LENGTH('a) \<Longrightarrow>
     ucast (ucast x + y) = x + ucast y"
   apply (rule word_unat.Rep_eqD)
   apply (simp add: unat_ucast unat_word_ariths mod_mod_power
                    min.absorb2 unat_of_nat)
   apply (subst mod_add_left_eq[symmetric])
   apply (simp add: mod_mod_power min.absorb2)
   apply (subst mod_add_right_eq)
   apply simp
   done
 
 lemma word_shift_zero:
   "\<lbrakk> x << n = 0; x \<le> 2^m; m + n < LENGTH('a)\<rbrakk> \<Longrightarrow> (x::'a::len word) = 0"
   apply (rule ccontr)
   apply (drule (2) word_shift_nonzero)
   apply simp
   done
 
 lemma neg_mask_mono_le:
-  "(x :: 'a :: len word) \<le> y \<Longrightarrow> x && ~~ mask n \<le> y && ~~ mask n"
+  "(x :: 'a :: len word) \<le> y \<Longrightarrow> x && ~~ (mask n) \<le> y && ~~ (mask n)"
 proof (rule ccontr, simp add: linorder_not_le, cases "n < LENGTH('a)")
   case False
-  show "y && ~~ mask n < x && ~~ mask n \<Longrightarrow> False"
+  show "y && ~~ (mask n) < x && ~~ (mask n) \<Longrightarrow> False"
     using False
     by (simp add: mask_def linorder_not_less
                   power_overflow)
 next
   case True
-  assume a: "x \<le> y" and b: "y && ~~ mask n < x && ~~ mask n"
+  assume a: "x \<le> y" and b: "y && ~~ (mask n) < x && ~~ (mask n)"
   have word_bits:
     "n < LENGTH('a)"
     using True by assumption
-  have "y \<le> (y && ~~ mask n) + (y && mask n)"
+  have "y \<le> (y && ~~ (mask n)) + (y && mask n)"
     by (simp add: word_plus_and_or_coroll2 add.commute)
-  also have "\<dots> \<le> (y && ~~ mask n) + 2 ^ n"
+  also have "\<dots> \<le> (y && ~~ (mask n)) + 2 ^ n"
     apply (rule word_plus_mono_right)
      apply (rule order_less_imp_le, rule and_mask_less_size)
      apply (simp add: word_size word_bits)
     apply (rule is_aligned_no_overflow'',
            simp_all add: is_aligned_neg_mask word_bits)
     apply (rule not_greatest_aligned, rule b)
      apply (simp_all add: is_aligned_neg_mask)
     done
-  also have "\<dots> \<le> x && ~~ mask n"
+  also have "\<dots> \<le> x && ~~ (mask n)"
     using b
     apply -
     apply (subst add.commute, rule le_plus)
      apply (rule aligned_at_least_t2n_diff,
             simp_all add: is_aligned_neg_mask)
     apply (rule ccontr, simp add: linorder_not_le)
     apply (drule aligned_small_is_0[rotated], simp_all add: is_aligned_neg_mask)
     done
   also have "\<dots> \<le> x" by (rule word_and_le2)
   also have "x \<le> y" by fact
   finally
   show "False" using b by simp
 qed
 
 lemma bool_mask':
   fixes x :: "'a :: len word"
   shows "2 < LENGTH('a) \<Longrightarrow> (0 < x && 1) = (x && 1 = 1)"
   apply (rule iffI)
    prefer 2
    apply simp
   apply (subgoal_tac "x && mask 1 < 2^1")
    prefer 2
    apply (rule and_mask_less_size)
    apply (simp add: word_size)
   apply (simp add: mask_def)
   apply (drule word_less_cases [where y=2])
   apply (erule disjE, simp)
   apply simp
   done
 
 lemma sint_eq_uint:
   "\<not> msb x \<Longrightarrow> sint x = uint x"
   apply (rule word_uint.Abs_eqD, subst word_sint.Rep_inverse)
     apply simp_all
   apply (cut_tac x=x in word_sint.Rep)
   apply (clarsimp simp add: uints_num sints_num)
   apply (rule conjI)
    apply (rule ccontr)
    apply (simp add: linorder_not_le word_msb_sint[symmetric])
   apply (erule order_less_le_trans)
   apply simp
   done
 
 lemma scast_eq_ucast:
   "\<not> msb x \<Longrightarrow> scast x = ucast x"
   by (simp add: scast_def ucast_def sint_eq_uint)
 
 lemma lt1_neq0:
   fixes x :: "'a :: len word"
   shows "(1 \<le> x) = (x \<noteq> 0)" by unat_arith
 
 lemma word_plus_one_nonzero:
   fixes x :: "'a :: len word"
   shows "\<lbrakk>x \<le> x + y; y \<noteq> 0\<rbrakk> \<Longrightarrow> x + 1 \<noteq> 0"
   apply (subst lt1_neq0 [symmetric])
   apply (subst olen_add_eqv [symmetric])
   apply (erule word_random)
   apply (simp add: lt1_neq0)
   done
 
 lemma word_sub_plus_one_nonzero:
   fixes n :: "'a :: len word"
   shows "\<lbrakk>n' \<le> n; n' \<noteq> 0\<rbrakk> \<Longrightarrow> (n - n') + 1 \<noteq> 0"
   apply (subst lt1_neq0 [symmetric])
   apply (subst olen_add_eqv [symmetric])
   apply (rule word_random [where x' = n'])
    apply simp
    apply (erule word_sub_le)
   apply (simp add: lt1_neq0)
   done
 
 lemma word_le_minus_mono_right:
   fixes x :: "'a :: len word"
   shows "\<lbrakk> z \<le> y; y \<le> x; z \<le> x \<rbrakk> \<Longrightarrow> x - y \<le> x - z"
   apply (rule word_sub_mono)
      apply simp
     apply assumption
    apply (erule word_sub_le)
   apply (erule word_sub_le)
   done
 
 lemma drop_append_miracle:
   "n = length xs \<Longrightarrow> drop n (xs @ ys) = ys"
   by simp
 
 lemma foldr_does_nothing_to_xf:
   "\<lbrakk> \<And>x s. x \<in> set xs \<Longrightarrow> xf (f x s) = xf s \<rbrakk> \<Longrightarrow> xf (foldr f xs s) = xf s"
   by (induct xs, simp_all)
 
 lemma nat_less_mult_monoish: "\<lbrakk> a < b; c < (d :: nat) \<rbrakk> \<Longrightarrow> (a + 1) * (c + 1) <= b * d"
   apply (drule Suc_leI)+
   apply (drule(1) mult_le_mono)
   apply simp
   done
 
 lemma word_0_sle_from_less[unfolded word_size]:
   "\<lbrakk> x < 2 ^ (size x - 1) \<rbrakk>  \<Longrightarrow> 0 <=s x"
   apply (clarsimp simp: word_sle_msb_le)
   apply (simp add: word_msb_nth)
   apply (subst (asm) word_test_bit_def [symmetric])
   apply (drule less_mask_eq)
   apply (drule_tac x="size x - 1" in word_eqD)
   apply (simp add: word_size)
   done
 
 lemma not_msb_from_less:
   "(v :: 'a word) < 2 ^ (LENGTH('a :: len) - 1) \<Longrightarrow> \<not> msb v"
   apply (clarsimp simp add: msb_nth)
   apply (drule less_mask_eq)
   apply (drule word_eqD, drule(1) iffD2)
   apply simp
   done
 
 lemma distinct_lemma: "f x \<noteq> f y \<Longrightarrow> x \<noteq> y" by auto
 
 
 lemma ucast_sub_ucast:
   fixes x :: "'a::len word"
   assumes "y \<le> x"
   assumes T: "LENGTH('a) \<le> LENGTH('b)"
   shows "ucast (x - y) = (ucast x - ucast y :: 'b::len word)"
 proof -
   from T
   have P: "unat x < 2 ^ LENGTH('b)" "unat y < 2 ^ LENGTH('b)"
     by (fastforce intro!: less_le_trans[OF unat_lt2p])+
   then show ?thesis
     by (simp add: unat_arith_simps unat_ucast assms[simplified unat_arith_simps])
 qed
 
 lemma word_1_0:
   "\<lbrakk>a + (1::('a::len) word) \<le> b; a < of_nat x\<rbrakk> \<Longrightarrow> a < b"
   by unat_arith
 
 lemma unat_of_nat_less:"\<lbrakk> a < b; unat b = c \<rbrakk> \<Longrightarrow> a < of_nat c"
   by fastforce
 
 lemma word_le_plus_1: "\<lbrakk> (y::('a::len) word) < y + n; a < n \<rbrakk> \<Longrightarrow> y + a \<le> y + a + 1"
   by unat_arith
 
 lemma word_le_plus:"\<lbrakk>(a::('a::len) word) < a + b; c < b\<rbrakk> \<Longrightarrow> a \<le> a + c"
 by (metis order_less_imp_le word_random)
 
 (*
  * Basic signed arithemetic properties.
  *)
 
 lemma sint_minus1 [simp]: "(sint x = -1) = (x = -1)"
   by (metis sint_n1 word_sint.Rep_inverse')
 
 lemma sint_0 [simp]: "(sint x = 0) = (x = 0)"
   by (metis sint_0 word_sint.Rep_inverse')
 
 (* It is not always that case that "sint 1 = 1", because of 1-bit word sizes.
  * This lemma produces the different cases. *)
 lemma sint_1_cases:
   "\<lbrakk> \<lbrakk> len_of TYPE ('a::len) = 1; (a::'a word) = 0; sint a = 0 \<rbrakk> \<Longrightarrow> P;
      \<lbrakk> len_of TYPE ('a) = 1; a = 1; sint (1 :: 'a word) = -1 \<rbrakk> \<Longrightarrow> P;
       \<lbrakk> len_of TYPE ('a) > 1; sint (1 :: 'a word) = 1 \<rbrakk> \<Longrightarrow> P \<rbrakk>
                 \<Longrightarrow> P"
    apply atomize_elim
   apply (case_tac "len_of TYPE ('a) = 1")
    apply clarsimp
    apply (subgoal_tac "(UNIV :: 'a word set) = {0, 1}")
     apply (metis UNIV_I insert_iff singletonE)
    apply (subst word_unat.univ)
    apply (clarsimp simp: unats_def image_def)
    apply (rule set_eqI, rule iffI)
     apply clarsimp
     apply (metis One_nat_def less_2_cases of_nat_1 semiring_1_class.of_nat_0)
    apply clarsimp
    apply (metis Abs_fnat_hom_0 Suc_1 lessI of_nat_1 zero_less_Suc)
   apply clarsimp
   apply (metis One_nat_def arith_is_1 le_def len_gt_0)
   done
 
 lemma sint_int_min:
   "sint (- (2 ^ (LENGTH('a) - Suc 0)) :: ('a::len) word) = - (2 ^ (LENGTH('a) - Suc 0))"
   apply (subst word_sint.Abs_inverse' [where r="- (2 ^ (LENGTH('a) - Suc 0))"])
     apply (clarsimp simp: sints_num)
    apply (clarsimp simp: wi_hom_syms word_of_int_2p)
   apply clarsimp
   done
 
 lemma sint_int_max_plus_1:
   "sint (2 ^ (LENGTH('a) - Suc 0) :: ('a::len) word) = - (2 ^ (LENGTH('a) - Suc 0))"
   apply (subst word_of_int_2p [symmetric])
   apply (subst int_word_sint)
   apply clarsimp
   apply (metis Suc_pred int_word_uint len_gt_0 power_Suc uint_eq_0 word_of_int_2p word_pow_0)
   done
 
 lemma sbintrunc_eq_in_range:
   "(sbintrunc n x = x) = (x \<in> range (sbintrunc n))"
   "(x = sbintrunc n x) = (x \<in> range (sbintrunc n))"
   apply (simp_all add: image_def)
   apply (metis sbintrunc_sbintrunc)+
   done
 
 lemma sbintrunc_If:
   "- 3 * (2 ^ n) \<le> x \<and> x < 3 * (2 ^ n)
     \<Longrightarrow> sbintrunc n x = (if x < - (2 ^ n) then x + 2 * (2 ^ n)
         else if x \<ge> 2 ^ n then x - 2 * (2 ^ n) else x)"
   apply (simp add: no_sbintr_alt2, safe)
    apply (simp add: mod_pos_geq)
   apply (subst mod_add_self1[symmetric], simp)
   done
 
 lemma signed_arith_eq_checks_to_ord:
   "(sint a + sint b = sint (a + b ))
     = ((a <=s a + b) = (0 <=s b))"
   "(sint a - sint b = sint (a - b ))
     = ((0 <=s a - b) = (b <=s a))"
   "(- sint a = sint (- a)) = (0 <=s (- a) = (a <=s 0))"
   using sint_range'[where x=a] sint_range'[where x=b]
   by (simp_all add: sint_word_ariths word_sle_def word_sless_alt sbintrunc_If)
 
 (* Basic proofs that signed word div/mod operations are
  * truncations of their integer counterparts. *)
 
 lemma signed_div_arith:
     "sint ((a::('a::len) word) sdiv b) = sbintrunc (LENGTH('a) - 1) (sint a sdiv sint b)"
   apply (subst word_sbin.norm_Rep [symmetric])
   apply (subst bin_sbin_eq_iff' [symmetric])
    apply simp
   apply (subst uint_sint [symmetric])
   apply (clarsimp simp: sdiv_int_def sdiv_word_def)
   apply (metis word_ubin.eq_norm)
   done
 
 lemma signed_mod_arith:
     "sint ((a::('a::len) word) smod b) = sbintrunc (LENGTH('a) - 1) (sint a smod sint b)"
   apply (subst word_sbin.norm_Rep [symmetric])
   apply (subst bin_sbin_eq_iff' [symmetric])
    apply simp
   apply (subst uint_sint [symmetric])
   apply (clarsimp simp: smod_int_def smod_word_def)
   apply (metis word_ubin.eq_norm)
   done
 
 (* Signed word arithmetic overflow constraints. *)
 
 lemma signed_arith_ineq_checks_to_eq:
   "((- (2 ^ (size a - 1)) \<le> (sint a + sint b)) \<and> (sint a + sint b \<le> (2 ^ (size a - 1) - 1)))
     = (sint a + sint b = sint (a + b ))"
   "((- (2 ^ (size a - 1)) \<le> (sint a - sint b)) \<and> (sint a - sint b \<le> (2 ^ (size a - 1) - 1)))
     = (sint a - sint b = sint (a - b))"
   "((- (2 ^ (size a - 1)) \<le> (- sint a)) \<and> (- sint a) \<le> (2 ^ (size a - 1) - 1))
     = ((- sint a) = sint (- a))"
   "((- (2 ^ (size a - 1)) \<le> (sint a * sint b)) \<and> (sint a * sint b \<le> (2 ^ (size a - 1) - 1)))
     = (sint a * sint b = sint (a * b))"
   "((- (2 ^ (size a - 1)) \<le> (sint a sdiv sint b)) \<and> (sint a sdiv sint b \<le> (2 ^ (size a - 1) - 1)))
     = (sint a sdiv sint b = sint (a sdiv b))"
   "((- (2 ^ (size a - 1)) \<le> (sint a smod sint b)) \<and> (sint a smod sint b \<le> (2 ^ (size a - 1) - 1)))
     = (sint a smod sint b = sint (a smod b))"
   by (auto simp: sint_word_ariths word_size signed_div_arith signed_mod_arith
                     sbintrunc_eq_in_range range_sbintrunc)
 
 lemma signed_arith_sint:
   "((- (2 ^ (size a - 1)) \<le> (sint a + sint b)) \<and> (sint a + sint b \<le> (2 ^ (size a - 1) - 1)))
     \<Longrightarrow> sint (a + b) = (sint a + sint b)"
   "((- (2 ^ (size a - 1)) \<le> (sint a - sint b)) \<and> (sint a - sint b \<le> (2 ^ (size a - 1) - 1)))
     \<Longrightarrow> sint (a - b) = (sint a - sint b)"
   "((- (2 ^ (size a - 1)) \<le> (- sint a)) \<and> (- sint a) \<le> (2 ^ (size a - 1) - 1))
     \<Longrightarrow> sint (- a) = (- sint a)"
   "((- (2 ^ (size a - 1)) \<le> (sint a * sint b)) \<and> (sint a * sint b \<le> (2 ^ (size a - 1) - 1)))
     \<Longrightarrow> sint (a * b) = (sint a * sint b)"
   "((- (2 ^ (size a - 1)) \<le> (sint a sdiv sint b)) \<and> (sint a sdiv sint b \<le> (2 ^ (size a - 1) - 1)))
     \<Longrightarrow> sint (a sdiv b) = (sint a sdiv sint b)"
   "((- (2 ^ (size a - 1)) \<le> (sint a smod sint b)) \<and> (sint a smod sint b \<le> (2 ^ (size a - 1) - 1)))
     \<Longrightarrow> sint (a smod b) = (sint a smod sint b)"
   by (subst (asm) signed_arith_ineq_checks_to_eq; simp)+
 
 lemma signed_mult_eq_checks_double_size:
   assumes mult_le: "(2 ^ (len_of TYPE ('a) - 1) + 1) ^ 2 \<le> (2 :: int) ^ (len_of TYPE ('b) - 1)"
            and le: "2 ^ (LENGTH('a) - 1) \<le> (2 :: int) ^ (len_of TYPE ('b) - 1)"
   shows "(sint (a :: 'a :: len word) * sint b = sint (a * b))
        = (scast a * scast b = (scast (a * b) :: 'b :: len word))"
 proof -
   have P: "sbintrunc (size a - 1) (sint a * sint b) \<in> range (sbintrunc (size a - 1))"
     by simp
 
   have abs: "!! x :: 'a word. abs (sint x) < 2 ^ (size a - 1) + 1"
     apply (cut_tac x=x in sint_range')
     apply (simp add: abs_le_iff word_size)
     done
   have abs_ab: "abs (sint a * sint b) < 2 ^ (LENGTH('b) - 1)"
     using abs_mult_less[OF abs[where x=a] abs[where x=b]] mult_le
     by (simp add: abs_mult power2_eq_square word_size)
   show ?thesis
     using P[unfolded range_sbintrunc] abs_ab le
     apply (simp add: sint_word_ariths scast_def)
     apply (simp add: wi_hom_mult)
     apply (subst word_sint.Abs_inject, simp_all)
      apply (simp add: sints_def range_sbintrunc abs_less_iff)
     apply clarsimp
     apply (simp add: sints_def range_sbintrunc word_size)
     apply (auto elim: order_less_le_trans order_trans[rotated])
     done
 qed
 
 (* Properties about signed division. *)
 
 lemma int_sdiv_simps [simp]:
     "(a :: int) sdiv 1 = a"
     "(a :: int) sdiv 0 = 0"
     "(a :: int) sdiv -1 = -a"
   apply (auto simp: sdiv_int_def sgn_if)
   done
 
 lemma sgn_div_eq_sgn_mult:
     "a div b \<noteq> 0 \<Longrightarrow> sgn ((a :: int) div b) = sgn (a * b)"
   apply (clarsimp simp: sgn_if zero_le_mult_iff neg_imp_zdiv_nonneg_iff not_less)
   apply (metis less_le mult_le_0_iff neg_imp_zdiv_neg_iff not_less pos_imp_zdiv_neg_iff zdiv_eq_0_iff)
   done
 
 lemma sgn_sdiv_eq_sgn_mult:
   "a sdiv b \<noteq> 0 \<Longrightarrow> sgn ((a :: int) sdiv b) = sgn (a * b)"
   by (auto simp: sdiv_int_def sgn_div_eq_sgn_mult sgn_mult)
 
 lemma int_sdiv_same_is_1 [simp]:
     "a \<noteq> 0 \<Longrightarrow> ((a :: int) sdiv b = a) = (b = 1)"
   apply (rule iffI)
    apply (clarsimp simp: sdiv_int_def)
    apply (subgoal_tac "b > 0")
     apply (case_tac "a > 0")
      apply (clarsimp simp: sgn_if)
     apply (clarsimp simp: algebra_split_simps not_less)
     apply (metis int_div_same_is_1 le_neq_trans minus_minus neg_0_le_iff_le neg_equal_0_iff_equal)
    apply (case_tac "a > 0")
     apply (case_tac "b = 0")
      apply clarsimp
     apply (rule classical)
     apply (clarsimp simp: sgn_mult not_less)
     apply (metis le_less neg_0_less_iff_less not_less_iff_gr_or_eq pos_imp_zdiv_neg_iff)
    apply (rule classical)
    apply (clarsimp simp: algebra_split_simps sgn_mult not_less sgn_if split: if_splits)
    apply (metis antisym less_le neg_imp_zdiv_nonneg_iff)
   apply (clarsimp simp: sdiv_int_def sgn_if)
   done
 
 lemma int_sdiv_negated_is_minus1 [simp]:
     "a \<noteq> 0 \<Longrightarrow> ((a :: int) sdiv b = - a) = (b = -1)"
   apply (clarsimp simp: sdiv_int_def)
   apply (rule iffI)
    apply (subgoal_tac "b < 0")
     apply (case_tac "a > 0")
      apply (clarsimp simp: sgn_if algebra_split_simps not_less)
     apply (case_tac "sgn (a * b) = -1")
      apply (clarsimp simp: not_less algebra_split_simps)
     apply (clarsimp simp: algebra_split_simps not_less)
    apply (rule classical)
    apply (case_tac "b = 0")
     apply (clarsimp simp: not_less sgn_mult)
    apply (case_tac "a > 0")
     apply (clarsimp simp: not_less sgn_mult)
     apply (metis less_le neg_less_0_iff_less not_less_iff_gr_or_eq pos_imp_zdiv_neg_iff)
    apply (clarsimp simp: not_less sgn_mult)
    apply (metis antisym_conv div_minus_right neg_imp_zdiv_nonneg_iff neg_le_0_iff_le not_less)
   apply (clarsimp simp: sgn_if)
   done
 
 lemma sdiv_int_range:
     "(a :: int) sdiv b \<in> { - (abs a) .. (abs a) }"
   apply (unfold sdiv_int_def)
   apply (subgoal_tac "(abs a) div (abs b) \<le> (abs a)")
    apply (clarsimp simp: sgn_if)
    apply (meson abs_ge_zero neg_le_0_iff_le nonneg_mod_div order_trans)
   apply (metis abs_eq_0 abs_ge_zero div_by_0 zdiv_le_dividend zero_less_abs_iff)
   done
 
 lemma word_sdiv_div1 [simp]:
     "(a :: ('a::len) word) sdiv 1 = a"
   apply (rule sint_1_cases [where a=a])
     apply (clarsimp simp: sdiv_word_def sdiv_int_def)
    apply (clarsimp simp: sdiv_word_def sdiv_int_def simp del: sint_minus1)
   apply (clarsimp simp: sdiv_word_def)
   done
 
 lemma sdiv_int_div_0 [simp]:
   "(x :: int) sdiv 0 = 0"
   by (clarsimp simp: sdiv_int_def)
 
 lemma sdiv_int_0_div [simp]:
   "0 sdiv (x :: int) = 0"
   by (clarsimp simp: sdiv_int_def)
 
 lemma word_sdiv_div0 [simp]:
     "(a :: ('a::len) word) sdiv 0 = 0"
   apply (auto simp: sdiv_word_def sdiv_int_def sgn_if)
   done
 
 lemma word_sdiv_div_minus1 [simp]:
     "(a :: ('a::len) word) sdiv -1 = -a"
   apply (auto simp: sdiv_word_def sdiv_int_def sgn_if)
   apply (metis wi_hom_neg word_sint.Rep_inverse')
   done
 
 lemmas word_sdiv_0 = word_sdiv_div0
 
 lemma sdiv_word_min:
     "- (2 ^ (size a - 1)) \<le> sint (a :: ('a::len) word) sdiv sint (b :: ('a::len) word)"
   apply (clarsimp simp: word_size)
   apply (cut_tac sint_range' [where x=a])
   apply (cut_tac sint_range' [where x=b])
   apply clarsimp
   apply (insert sdiv_int_range [where a="sint a" and b="sint b"])
   apply (clarsimp simp: max_def abs_if split: if_split_asm)
   done
 
 lemma sdiv_word_max:
     "(sint (a :: ('a::len) word) sdiv sint (b :: ('a::len) word) < (2 ^ (size a - 1))) =
           ((a \<noteq> - (2 ^ (size a - 1)) \<or> (b \<noteq> -1)))"
     (is "?lhs = (\<not> ?a_int_min \<or> \<not> ?b_minus1)")
 proof (rule classical)
   assume not_thesis: "\<not> ?thesis"
 
   have not_zero: "b \<noteq> 0"
     using not_thesis
     by (clarsimp)
 
   have result_range: "sint a sdiv sint b \<in> (sints (size a)) \<union> {2 ^ (size a - 1)}"
     apply (cut_tac sdiv_int_range [where a="sint a" and b="sint b"])
     apply (erule rev_subsetD)
     using sint_range' [where x=a]  sint_range' [where x=b]
     apply (auto simp: max_def abs_if word_size sints_num)
     done
 
   have result_range_overflow: "(sint a sdiv sint b = 2 ^ (size a - 1)) = (?a_int_min \<and> ?b_minus1)"
     apply (rule iffI [rotated])
      apply (clarsimp simp: sdiv_int_def sgn_if word_size sint_int_min)
     apply (rule classical)
     apply (case_tac "?a_int_min")
      apply (clarsimp simp: word_size sint_int_min)
      apply (metis diff_0_right
               int_sdiv_negated_is_minus1 minus_diff_eq minus_int_code(2)
               power_eq_0_iff sint_minus1 zero_neq_numeral)
     apply (subgoal_tac "abs (sint a) < 2 ^ (size a - 1)")
      apply (insert sdiv_int_range [where a="sint a" and b="sint b"])[1]
      apply (clarsimp simp: word_size)
     apply (insert sdiv_int_range [where a="sint a" and b="sint b"])[1]
     apply (insert word_sint.Rep [where x="a"])[1]
     apply (clarsimp simp: minus_le_iff word_size abs_if sints_num split: if_split_asm)
     apply (metis minus_minus sint_int_min word_sint.Rep_inject)
     done
 
   have result_range_simple: "(sint a sdiv sint b \<in> (sints (size a))) \<Longrightarrow> ?thesis"
     apply (insert sdiv_int_range [where a="sint a" and b="sint b"])
     apply (clarsimp simp: word_size sints_num sint_int_min)
     done
 
   show ?thesis
     apply (rule UnE [OF result_range result_range_simple])
      apply simp
     apply (clarsimp simp: word_size)
     using result_range_overflow
     apply (clarsimp simp: word_size)
     done
 qed
 
 lemmas sdiv_word_min' = sdiv_word_min [simplified word_size, simplified]
 lemmas sdiv_word_max' = sdiv_word_max [simplified word_size, simplified]
 
 lemmas word_sdiv_numerals_lhs = sdiv_word_def[where a="numeral x" for x]
     sdiv_word_def[where a=0] sdiv_word_def[where a=1]
 
 lemmas word_sdiv_numerals = word_sdiv_numerals_lhs[where b="numeral y" for y]
     word_sdiv_numerals_lhs[where b=0] word_sdiv_numerals_lhs[where b=1]
 
 (*
  * Signed modulo properties.
  *)
 
 lemma smod_int_alt_def:
      "(a::int) smod b = sgn (a) * (abs a mod abs b)"
   apply (clarsimp simp: smod_int_def sdiv_int_def)
   apply (clarsimp simp: minus_div_mult_eq_mod [symmetric] abs_sgn sgn_mult sgn_if algebra_split_simps)
   done
 
 lemma smod_int_range:
   "b \<noteq> 0 \<Longrightarrow> (a::int) smod b \<in> { - abs b + 1 .. abs b - 1 }"
   apply (case_tac  "b > 0")
    apply (insert pos_mod_conj [where a=a and b=b])[1]
    apply (insert pos_mod_conj [where a="-a" and b=b])[1]
    apply (auto simp: smod_int_alt_def algebra_simps sgn_if
               abs_if not_less add1_zle_eq [simplified add.commute])[1]
     apply (metis add_nonneg_nonneg int_one_le_iff_zero_less le_less less_add_same_cancel2 not_le pos_mod_conj)
   apply (metis (full_types) add.inverse_inverse eucl_rel_int eucl_rel_int_iff le_less_trans neg_0_le_iff_le)
   apply (insert neg_mod_conj [where a=a and b="b"])[1]
   apply (insert neg_mod_conj [where a="-a" and b="b"])[1]
   apply (clarsimp simp: smod_int_alt_def algebra_simps sgn_if
             abs_if not_less add1_zle_eq [simplified add.commute])
   apply (metis neg_0_less_iff_less neg_mod_conj not_le not_less_iff_gr_or_eq order_trans pos_mod_conj)
   done
 
 lemma smod_int_compares:
    "\<lbrakk> 0 \<le> a; 0 < b \<rbrakk> \<Longrightarrow> (a :: int) smod b < b"
    "\<lbrakk> 0 \<le> a; 0 < b \<rbrakk> \<Longrightarrow> 0 \<le> (a :: int) smod b"
    "\<lbrakk> a \<le> 0; 0 < b \<rbrakk> \<Longrightarrow> -b < (a :: int) smod b"
    "\<lbrakk> a \<le> 0; 0 < b \<rbrakk> \<Longrightarrow> (a :: int) smod b \<le> 0"
    "\<lbrakk> 0 \<le> a; b < 0 \<rbrakk> \<Longrightarrow> (a :: int) smod b < - b"
    "\<lbrakk> 0 \<le> a; b < 0 \<rbrakk> \<Longrightarrow> 0 \<le> (a :: int) smod b"
    "\<lbrakk> a \<le> 0; b < 0 \<rbrakk> \<Longrightarrow> (a :: int) smod b \<le> 0"
    "\<lbrakk> a \<le> 0; b < 0 \<rbrakk> \<Longrightarrow> b \<le> (a :: int) smod b"
   apply (insert smod_int_range [where a=a and b=b])
   apply (auto simp: add1_zle_eq smod_int_alt_def sgn_if)
   done
 
 lemma smod_int_mod_0 [simp]:
   "x smod (0 :: int) = x"
   by (clarsimp simp: smod_int_def)
 
 lemma smod_int_0_mod [simp]:
   "0 smod (x :: int) = 0"
   by (clarsimp simp: smod_int_alt_def)
 
 lemma smod_word_mod_0 [simp]:
   "x smod (0 :: ('a::len) word) = x"
   by (clarsimp simp: smod_word_def)
 
 lemma smod_word_0_mod [simp]:
   "0 smod (x :: ('a::len) word) = 0"
   by (clarsimp simp: smod_word_def)
 
 lemma smod_word_max:
     "sint (a::'a word) smod sint (b::'a word) < 2 ^ (LENGTH('a::len) - Suc 0)"
   apply (case_tac "b = 0")
    apply (insert word_sint.Rep [where x=a, simplified sints_num])[1]
    apply (clarsimp)
   apply (insert word_sint.Rep [where x="b", simplified sints_num])[1]
   apply (insert smod_int_range [where a="sint a" and b="sint b"])
   apply (clarsimp simp: abs_if split: if_split_asm)
   done
 
 lemma smod_word_min:
     "- (2 ^ (LENGTH('a::len) - Suc 0)) \<le> sint (a::'a word) smod sint (b::'a word)"
   apply (case_tac "b = 0")
    apply (insert word_sint.Rep [where x=a, simplified sints_num])[1]
    apply clarsimp
   apply (insert word_sint.Rep [where x=b, simplified sints_num])[1]
   apply (insert smod_int_range [where a="sint a" and b="sint b"])
   apply (clarsimp simp: abs_if add1_zle_eq split: if_split_asm)
   done
 
 lemma smod_word_alt_def:
   "(a :: ('a::len) word) smod b = a - (a sdiv b) * b"
   apply (case_tac "a \<noteq> - (2 ^ (LENGTH('a) - 1)) \<or> b \<noteq> -1")
    apply (clarsimp simp: smod_word_def sdiv_word_def smod_int_def
              minus_word.abs_eq [symmetric] times_word.abs_eq [symmetric])
   apply (clarsimp simp: smod_word_def smod_int_def)
   done
 
 lemmas word_smod_numerals_lhs = smod_word_def[where a="numeral x" for x]
     smod_word_def[where a=0] smod_word_def[where a=1]
 
 lemmas word_smod_numerals = word_smod_numerals_lhs[where b="numeral y" for y]
     word_smod_numerals_lhs[where b=0] word_smod_numerals_lhs[where b=1]
 
 lemma sint_of_int_eq:
   "\<lbrakk> - (2 ^ (LENGTH('a) - 1)) \<le> x; x < 2 ^ (LENGTH('a) - 1) \<rbrakk> \<Longrightarrow> sint (of_int x :: ('a::len) word) = x"
   apply (clarsimp simp: word_of_int int_word_sint)
   apply (subst int_mod_eq')
     apply simp
    apply (subst (2) power_minus_simp)
     apply clarsimp
    apply clarsimp
   apply clarsimp
   done
 
 lemma of_int_sint [simp]:
     "of_int (sint a) = a"
   apply (insert word_sint.Rep [where x=a])
   apply (clarsimp simp: word_of_int)
   done
 
 lemma nth_w2p_scast [simp]:
   "((scast ((2::'a::len signed word) ^ n) :: 'a word) !! m)
          \<longleftrightarrow> ((((2::'a::len  word) ^ n) :: 'a word) !! m)"
   apply (subst nth_w2p)
   apply (case_tac "n \<ge> LENGTH('a)")
    apply (subst power_overflow, simp)
    apply clarsimp
   apply (metis nth_w2p scast_def bang_conj_lt
                len_signed nth_word_of_int word_sint.Rep_inverse)
   done
 
 lemma scast_2_power [simp]: "scast ((2 :: 'a::len signed word) ^ x) = ((2 :: 'a word) ^ x)"
   by (clarsimp simp: word_eq_iff)
 
 lemma scast_bit_test [simp]:
     "scast ((1 :: 'a::len signed word) << n) = (1 :: 'a word) << n"
   by (clarsimp simp: word_eq_iff)
 
 lemma ucast_nat_def':
   "of_nat (unat x) = (ucast :: 'a :: len word \<Rightarrow> ('b :: len) signed word) x"
   by (simp add: ucast_def word_of_int_nat unat_def)
 
 lemma mod_mod_power_int:
   fixes k :: int
   shows "k mod 2 ^ m mod 2 ^ n = k mod 2 ^ (min m n)"
   by (metis bintrunc_bintrunc_min bintrunc_mod2p min.commute)
 
 (* Normalise combinations of scast and ucast. *)
 
 lemma ucast_distrib:
   fixes M :: "'a::len word \<Rightarrow> 'a::len word \<Rightarrow> 'a::len word"
   fixes M' :: "'b::len word \<Rightarrow> 'b::len word \<Rightarrow> 'b::len word"
   fixes L :: "int \<Rightarrow> int \<Rightarrow> int"
   assumes lift_M: "\<And>x y. uint (M x y) = L (uint x) (uint y)  mod 2 ^ LENGTH('a)"
   assumes lift_M': "\<And>x y. uint (M' x y) = L (uint x) (uint y)  mod 2 ^ LENGTH('b)"
   assumes distrib: "\<And>x y. (L (x mod (2 ^ LENGTH('b))) (y mod (2 ^ LENGTH('b)))) mod (2 ^ LENGTH('b))
                                = (L x y) mod (2 ^ LENGTH('b))"
   assumes is_down: "is_down (ucast :: 'a word \<Rightarrow> 'b word)"
   shows "ucast (M a b) = M' (ucast a) (ucast b)"
   apply (clarsimp simp: word_of_int ucast_def)
   apply (subst lift_M)
   apply (subst of_int_uint [symmetric], subst lift_M')
   apply (subst (1 2) int_word_uint)
   apply (subst word_of_int)
   apply (subst word.abs_eq_iff)
   apply (subst (1 2) bintrunc_mod2p)
   apply (insert is_down)
   apply (unfold is_down_def)
   apply (clarsimp simp: target_size source_size)
   apply (clarsimp simp: mod_mod_power_int min_def)
   apply (rule distrib [symmetric])
   done
 
 lemma ucast_down_add:
     "is_down (ucast:: 'a word \<Rightarrow> 'b word) \<Longrightarrow>  ucast ((a :: 'a::len word) + b) = (ucast a + ucast b :: 'b::len word)"
   by (rule ucast_distrib [where L="(+)"], (clarsimp simp: uint_word_ariths)+, presburger, simp)
 
 lemma ucast_down_minus:
     "is_down (ucast:: 'a word \<Rightarrow> 'b word) \<Longrightarrow>  ucast ((a :: 'a::len word) - b) = (ucast a - ucast b :: 'b::len word)"
   apply (rule ucast_distrib [where L="(-)"], (clarsimp simp: uint_word_ariths)+)
   apply (metis mod_diff_left_eq mod_diff_right_eq)
   apply simp
   done
 
 lemma ucast_down_mult:
     "is_down (ucast:: 'a word \<Rightarrow> 'b word) \<Longrightarrow>  ucast ((a :: 'a::len word) * b) = (ucast a * ucast b :: 'b::len word)"
   apply (rule ucast_distrib [where L="(*)"], (clarsimp simp: uint_word_ariths)+)
   apply (metis mod_mult_eq)
   apply simp
   done
 
 lemma scast_distrib:
   fixes M :: "'a::len word \<Rightarrow> 'a::len word \<Rightarrow> 'a::len word"
   fixes M' :: "'b::len word \<Rightarrow> 'b::len word \<Rightarrow> 'b::len word"
   fixes L :: "int \<Rightarrow> int \<Rightarrow> int"
   assumes lift_M: "\<And>x y. uint (M x y) = L (uint x) (uint y)  mod 2 ^ LENGTH('a)"
   assumes lift_M': "\<And>x y. uint (M' x y) = L (uint x) (uint y)  mod 2 ^ LENGTH('b)"
   assumes distrib: "\<And>x y. (L (x mod (2 ^ LENGTH('b))) (y mod (2 ^ LENGTH('b)))) mod (2 ^ LENGTH('b))
                                = (L x y) mod (2 ^ LENGTH('b))"
   assumes is_down: "is_down (scast :: 'a word \<Rightarrow> 'b word)"
   shows "scast (M a b) = M' (scast a) (scast b)"
   apply (subst (1 2 3) down_cast_same [symmetric])
    apply (insert is_down)
    apply (clarsimp simp: is_down_def target_size source_size is_down)
   apply (rule ucast_distrib [where L=L, OF lift_M lift_M' distrib])
   apply (insert is_down)
   apply (clarsimp simp: is_down_def target_size source_size is_down)
   done
 
 lemma scast_down_add:
     "is_down (scast:: 'a word \<Rightarrow> 'b word) \<Longrightarrow>  scast ((a :: 'a::len word) + b) = (scast a + scast b :: 'b::len word)"
   by (rule scast_distrib [where L="(+)"], (clarsimp simp: uint_word_ariths)+, presburger, simp)
 
 lemma scast_down_minus:
     "is_down (scast:: 'a word \<Rightarrow> 'b word) \<Longrightarrow>  scast ((a :: 'a::len word) - b) = (scast a - scast b :: 'b::len word)"
   apply (rule scast_distrib [where L="(-)"], (clarsimp simp: uint_word_ariths)+)
   apply (metis mod_diff_left_eq mod_diff_right_eq)
   apply simp
   done
 
 lemma scast_down_mult:
     "is_down (scast:: 'a word \<Rightarrow> 'b word) \<Longrightarrow>  scast ((a :: 'a::len word) * b) = (scast a * scast b :: 'b::len word)"
   apply (rule scast_distrib [where L="(*)"], (clarsimp simp: uint_word_ariths)+)
   apply (metis mod_mult_eq)
   apply simp
   done
 
 lemma scast_ucast_1:
   "\<lbrakk> is_down (ucast :: 'a word \<Rightarrow> 'b word); is_down (ucast :: 'b word \<Rightarrow> 'c word) \<rbrakk> \<Longrightarrow>
          (scast (ucast (a :: 'a::len word) :: 'b::len word) :: 'c::len word) = ucast a"
   by (metis down_cast_same ucast_def ucast_down_wi)
 
 lemma scast_ucast_3:
   "\<lbrakk> is_down (ucast :: 'a word \<Rightarrow> 'c word); is_down (ucast :: 'b word \<Rightarrow> 'c word) \<rbrakk> \<Longrightarrow>
          (scast (ucast (a :: 'a::len word) :: 'b::len word) :: 'c::len word) = ucast a"
   by (metis down_cast_same ucast_def ucast_down_wi)
 
 lemma scast_ucast_4:
   "\<lbrakk> is_up (ucast :: 'a word \<Rightarrow> 'b word); is_down (ucast :: 'b word \<Rightarrow> 'c word) \<rbrakk> \<Longrightarrow>
          (scast (ucast (a :: 'a::len word) :: 'b::len word) :: 'c::len word) = ucast a"
   by (metis down_cast_same ucast_def ucast_down_wi)
 
 lemma scast_scast_b:
   "\<lbrakk> is_up (scast :: 'a word \<Rightarrow> 'b word) \<rbrakk> \<Longrightarrow>
      (scast (scast (a :: 'a::len word) :: 'b::len word) :: 'c::len word) = scast a"
   by (metis scast_def sint_up_scast)
 
 lemma ucast_scast_1:
   "\<lbrakk> is_down (scast :: 'a word \<Rightarrow> 'b word); is_down (ucast :: 'b word \<Rightarrow> 'c word) \<rbrakk> \<Longrightarrow>
             (ucast (scast (a :: 'a::len word) :: 'b::len word) :: 'c::len word) = scast a"
   by (metis scast_def ucast_down_wi)
 
 lemma ucast_scast_3:
   "\<lbrakk> is_down (scast :: 'a word \<Rightarrow> 'c word); is_down (ucast :: 'b word \<Rightarrow> 'c word) \<rbrakk> \<Longrightarrow>
      (ucast (scast (a :: 'a::len word) :: 'b::len word) :: 'c::len word) = scast a"
   by (metis scast_def ucast_down_wi)
 
 lemma ucast_scast_4:
   "\<lbrakk> is_up (scast :: 'a word \<Rightarrow> 'b word); is_down (ucast :: 'b word \<Rightarrow> 'c word) \<rbrakk> \<Longrightarrow>
      (ucast (scast (a :: 'a::len word) :: 'b::len word) :: 'c::len word) = scast a"
   by (metis down_cast_same scast_def sint_up_scast)
 
 lemma ucast_ucast_a:
   "\<lbrakk> is_down (ucast :: 'b word \<Rightarrow> 'c word) \<rbrakk> \<Longrightarrow>
         (ucast (ucast (a :: 'a::len word) :: 'b::len word) :: 'c::len word) = ucast a"
   by (metis down_cast_same ucast_def ucast_down_wi)
 
 lemma ucast_ucast_b:
   "\<lbrakk> is_up (ucast :: 'a word \<Rightarrow> 'b word) \<rbrakk> \<Longrightarrow>
      (ucast (ucast (a :: 'a::len word) :: 'b::len word) :: 'c::len word) = ucast a"
   by (metis ucast_up_ucast)
 
 lemma scast_scast_a:
   "\<lbrakk> is_down (scast :: 'b word \<Rightarrow> 'c word) \<rbrakk> \<Longrightarrow>
             (scast (scast (a :: 'a::len word) :: 'b::len word) :: 'c::len word) = scast a"
   apply (clarsimp simp: scast_def)
   apply (metis down_cast_same is_up_down scast_def ucast_down_wi)
   done
 
 lemma scast_down_wi [OF refl]:
   "uc = scast \<Longrightarrow> is_down uc \<Longrightarrow> uc (word_of_int x) = word_of_int x"
   by (metis down_cast_same is_up_down ucast_down_wi)
 
 lemmas cast_simps =
   is_down is_up
   scast_down_add scast_down_minus scast_down_mult
   ucast_down_add ucast_down_minus ucast_down_mult
   scast_ucast_1 scast_ucast_3 scast_ucast_4
   ucast_scast_1 ucast_scast_3 ucast_scast_4
   ucast_ucast_a ucast_ucast_b
   scast_scast_a scast_scast_b
   ucast_down_bl
   ucast_down_wi scast_down_wi
   ucast_of_nat scast_of_nat
   uint_up_ucast sint_up_scast
   up_scast_surj up_ucast_surj
 
 lemma smod_mod_positive:
     "\<lbrakk> 0 \<le> (a :: int); 0 \<le> b \<rbrakk> \<Longrightarrow> a smod b = a mod b"
   by (clarsimp simp: smod_int_alt_def zsgn_def)
 
 lemma nat_mult_power_less_eq:
   "b > 0 \<Longrightarrow> (a * b ^ n < (b :: nat) ^ m) = (a < b ^ (m - n))"
   using mult_less_cancel2[where m = a and k = "b ^ n" and n="b ^ (m - n)"]
         mult_less_cancel2[where m="a * b ^ (n - m)" and k="b ^ m" and n=1]
   apply (simp only: power_add[symmetric] nat_minus_add_max)
   apply (simp only: power_add[symmetric] nat_minus_add_max ac_simps)
   apply (simp add: max_def split: if_split_asm)
   done
 
 lemma signed_shift_guard_to_word:
   "\<lbrakk> n < len_of TYPE ('a); n > 0 \<rbrakk>
     \<Longrightarrow> (unat (x :: 'a :: len word) * 2 ^ y < 2 ^ n)
     = (x = 0 \<or> x < (1 << n >> y))"
   apply (simp only: nat_mult_power_less_eq)
   apply (cases "y \<le> n")
    apply (simp only: shiftl_shiftr1)
    apply (subst less_mask_eq)
     apply (simp add: word_less_nat_alt word_size)
     apply (rule order_less_le_trans[rotated], rule power_increasing[where n=1])
       apply simp
      apply simp
     apply simp
    apply (simp add: nat_mult_power_less_eq word_less_nat_alt word_size)
    apply auto[1]
   apply (simp only: shiftl_shiftr2, simp add: unat_eq_0)
   done
 
 lemma sint_ucast_eq_uint:
     "\<lbrakk> \<not> is_down (ucast :: ('a::len word \<Rightarrow> 'b::len word)) \<rbrakk>
             \<Longrightarrow> sint ((ucast :: ('a::len word \<Rightarrow> 'b::len word)) x) = uint x"
   apply (subst sint_eq_uint)
    apply (clarsimp simp: msb_nth nth_ucast is_down)
    apply (metis Suc_leI Suc_pred bang_conj_lt len_gt_0)
   apply (clarsimp simp: uint_up_ucast is_up is_down)
   done
 
 lemma word_less_nowrapI':
   "(x :: 'a :: len0 word) \<le> z - k \<Longrightarrow> k \<le> z \<Longrightarrow> 0 < k \<Longrightarrow> x < x + k"
   by uint_arith
 
 lemma mask_plus_1:
   "mask n + 1 = 2 ^ n"
   by (clarsimp simp: mask_def)
 
 lemma unat_inj: "inj unat"
   by (metis eq_iff injI word_le_nat_alt)
 
 lemma unat_ucast_upcast:
   "is_up (ucast :: 'b word \<Rightarrow> 'a word)
       \<Longrightarrow> unat (ucast x :: ('a::len) word) = unat (x :: ('b::len) word)"
   unfolding ucast_def unat_def
   apply (subst int_word_uint)
   apply (subst mod_pos_pos_trivial)
     apply simp
    apply (rule lt2p_lem)
    apply (clarsimp simp: is_up)
   apply simp
   done
 
 lemma ucast_mono:
   "\<lbrakk> (x :: 'b :: len word) < y; y < 2 ^ LENGTH('a) \<rbrakk>
    \<Longrightarrow> ucast x < ((ucast y) :: 'a :: len word)"
   apply (simp add: ucast_nat_def [symmetric])
   apply (rule of_nat_mono_maybe)
   apply (rule unat_less_helper)
   apply (simp add: Power.of_nat_power)
   apply (simp add: word_less_nat_alt)
   done
 
 lemma ucast_mono_le:
   "\<lbrakk>x \<le> y; y < 2 ^ LENGTH('b)\<rbrakk> \<Longrightarrow> (ucast (x :: 'a :: len word) :: 'b :: len word) \<le> ucast y"
   apply (simp add: ucast_nat_def [symmetric])
   apply (subst of_nat_mono_maybe_le[symmetric])
     apply (rule unat_less_helper)
     apply (simp add: Power.of_nat_power)
    apply (rule unat_less_helper)
    apply (erule le_less_trans)
    apply (simp add: Power.of_nat_power)
   apply (simp add: word_le_nat_alt)
   done
 
 lemma ucast_mono_le':
   "\<lbrakk> unat y < 2 ^ LENGTH('b); LENGTH('b::len) < LENGTH('a::len); x \<le> y \<rbrakk>
    \<Longrightarrow> UCAST('a \<rightarrow> 'b) x \<le> UCAST('a \<rightarrow> 'b) y"
   by (auto simp: word_less_nat_alt intro: ucast_mono_le)
 
 lemma zero_sle_ucast_up:
   "\<not> is_down (ucast :: 'a word \<Rightarrow> 'b signed word) \<Longrightarrow>
           (0 <=s ((ucast (b::('a::len) word)) :: ('b::len) signed word))"
   apply (subgoal_tac "\<not> msb (ucast b :: 'b signed word)")
    apply (clarsimp simp: word_sle_msb_le)
   apply (clarsimp simp: is_down not_le msb_nth nth_ucast)
   apply (subst (asm) bang_conj_lt [symmetric])
   apply clarsimp
   apply arith
   done
 
 lemma word_le_ucast_sless:
   "\<lbrakk> x \<le> y; y \<noteq> -1; LENGTH('a) < LENGTH('b) \<rbrakk> \<Longrightarrow>
     UCAST (('a :: len) \<rightarrow> ('b :: len) signed) x <s ucast (y + 1)"
   by (clarsimp simp: word_le_make_less word_sless_alt sint_ucast_eq_uint is_down word_less_def)
 
 lemma msb_ucast_eq:
     "LENGTH('a) = LENGTH('b) \<Longrightarrow>
          msb (ucast x :: ('a::len) word) = msb (x :: ('b::len) word)"
   apply (clarsimp simp: word_msb_alt)
   apply (subst ucast_down_drop [where n=0])
    apply (clarsimp simp: source_size_def target_size_def word_size)
   apply clarsimp
   done
 
 lemma msb_big:
      "msb (a :: ('a::len) word) = (a \<ge> 2 ^ (LENGTH('a)  - Suc 0))"
   apply (rule iffI)
    apply (clarsimp simp: msb_nth)
    apply (drule bang_is_le)
    apply simp
   apply (rule ccontr)
   apply (subgoal_tac "a = a && mask (LENGTH('a) - Suc 0)")
    apply (cut_tac and_mask_less' [where w=a and n="LENGTH('a) - Suc 0"])
     apply (clarsimp simp: word_not_le [symmetric])
    apply clarsimp
   apply (rule sym, subst and_mask_eq_iff_shiftr_0)
   apply (clarsimp simp: msb_shift)
   done
 
 lemma zero_sle_ucast:
   "(0 <=s ((ucast (b::('a::len) word)) :: ('a::len) signed word))
                 = (uint b < 2 ^ (len_of (TYPE('a)) - 1))"
   apply (case_tac "msb b")
    apply (clarsimp simp: word_sle_msb_le not_less msb_ucast_eq del: notI)
    apply (clarsimp simp: msb_big word_le_def uint_2p_alt)
   apply (clarsimp simp: word_sle_msb_le not_less msb_ucast_eq del: notI)
   apply (clarsimp simp: msb_big word_le_def uint_2p_alt)
   done
 
 
 (* to_bool / from_bool. *)
 
 definition
   from_bool :: "bool \<Rightarrow> 'a::len word" where
   "from_bool b \<equiv> case b of True \<Rightarrow> of_nat 1
                          | False \<Rightarrow> of_nat 0"
 
 lemma from_bool_0:
   "(from_bool x = 0) = (\<not> x)"
   by (simp add: from_bool_def split: bool.split)
 
 definition
   to_bool :: "'a::len word \<Rightarrow> bool" where
   "to_bool \<equiv> (\<noteq>) 0"
 
 lemma to_bool_and_1:
   "to_bool (x && 1) = (x !! 0)"
   apply (simp add: to_bool_def)
   apply (rule iffI)
    apply (rule classical, erule notE, rule word_eqI)
    apply clarsimp
    apply (case_tac n, simp_all)[1]
   apply (rule notI, drule word_eqD[where x=0])
   apply simp
   done
 
 lemma to_bool_from_bool [simp]:
   "to_bool (from_bool r) = r"
   unfolding from_bool_def to_bool_def
   by (simp split: bool.splits)
 
 lemma from_bool_neq_0 [simp]:
   "(from_bool b \<noteq> 0) = b"
   by (simp add: from_bool_def split: bool.splits)
 
 lemma from_bool_mask_simp [simp]:
   "(from_bool r :: 'a::len word) && 1 = from_bool r"
   unfolding from_bool_def
   by (clarsimp split: bool.splits)
 
 lemma from_bool_1 [simp]:
   "(from_bool P = 1) = P"
   by (simp add: from_bool_def split: bool.splits)
 
 lemma ge_0_from_bool [simp]:
   "(0 < from_bool P) = P"
   by (simp add: from_bool_def split: bool.splits)
 
 lemma limited_and_from_bool:
   "limited_and (from_bool b) 1"
   by (simp add: from_bool_def limited_and_def split: bool.split)
 
 lemma to_bool_1 [simp]: "to_bool 1" by (simp add: to_bool_def)
 lemma to_bool_0 [simp]: "\<not>to_bool 0" by (simp add: to_bool_def)
 
 lemma from_bool_eq_if:
   "(from_bool Q = (if P then 1 else 0)) = (P = Q)"
   by (simp add: case_bool_If from_bool_def split: if_split)
 
 lemma to_bool_eq_0:
   "(\<not> to_bool x) = (x = 0)"
   by (simp add: to_bool_def)
 
 lemma to_bool_neq_0:
   "(to_bool x) = (x \<noteq> 0)"
   by (simp add: to_bool_def)
 
 lemma from_bool_all_helper:
   "(\<forall>bool. from_bool bool = val \<longrightarrow> P bool)
       = ((\<exists>bool. from_bool bool = val) \<longrightarrow> P (val \<noteq> 0))"
   by (auto simp: from_bool_0)
 
 lemma from_bool_to_bool_iff:
   "w = from_bool b \<longleftrightarrow> to_bool w = b \<and> (w = 0 \<or> w = 1)"
   by (cases b) (auto simp: from_bool_def to_bool_def)
 
 lemma word_rsplit_upt:
   "\<lbrakk> size x = LENGTH('a :: len) * n; n \<noteq> 0 \<rbrakk>
     \<Longrightarrow> word_rsplit x = map (\<lambda>i. ucast (x >> i * len_of TYPE ('a)) :: 'a word) (rev [0 ..< n])"
   apply (subgoal_tac "length (word_rsplit x :: 'a word list) = n")
    apply (rule nth_equalityI, simp)
    apply (intro allI word_eqI impI)
    apply (simp add: test_bit_rsplit_alt word_size)
    apply (simp add: nth_ucast nth_shiftr nth_rev field_simps)
   apply (simp add: length_word_rsplit_exp_size)
   apply (metis mult.commute given_quot_alt word_size word_size_gt_0)
   done
 
 lemma aligned_shift:
   "\<lbrakk>x < 2 ^ n; is_aligned (y :: 'a :: len word) n;n \<le> LENGTH('a)\<rbrakk>
    \<Longrightarrow> x + y >> n = y >> n"
   apply (subst word_plus_and_or_coroll)
    apply (rule word_eqI)
    apply (clarsimp simp: is_aligned_nth)
    apply (drule(1) nth_bounded)
     apply simp
    apply simp
   apply (rule word_eqI)
   apply (simp add: nth_shiftr)
   apply safe
   apply (drule(1) nth_bounded)
   apply simp+
   done
 
 lemma aligned_shift':
   "\<lbrakk>x < 2 ^ n; is_aligned (y :: 'a :: len word) n;n \<le> LENGTH('a)\<rbrakk>
    \<Longrightarrow> y + x >> n = y >> n"
   apply (subst word_plus_and_or_coroll)
    apply (rule word_eqI)
    apply (clarsimp simp: is_aligned_nth)
    apply (drule(1) nth_bounded)
     apply simp
    apply simp
   apply (rule word_eqI)
   apply (simp add: nth_shiftr)
   apply safe
   apply (drule(1) nth_bounded)
   apply simp+
   done
 
 lemma neg_mask_add_mask:
-  "((x:: 'a :: len word) && ~~ mask n) + (2 ^ n - 1) = x || mask n"
+  "((x:: 'a :: len word) && ~~ (mask n)) + (2 ^ n - 1) = x || mask n"
   apply (simp add:mask_2pm1[symmetric])
   apply (rule word_eqI[rule_format])
   apply (rule iffI)
     apply (clarsimp simp:word_size not_less)
-    apply (cut_tac w = "((x && ~~ mask n) + mask n)" and
+    apply (cut_tac w = "((x && ~~ (mask n)) + mask n)" and
       m = n and n = "na - n" in nth_shiftr[symmetric])
     apply clarsimp
     apply (subst (asm) aligned_shift')
   apply (simp add:mask_lt_2pn nth_shiftr is_aligned_neg_mask word_size)+
   apply (case_tac "na<n")
     apply clarsimp
     apply (subst word_plus_and_or_coroll)
     apply (rule iffD1[OF is_aligned_mask])
     apply (simp add:is_aligned_neg_mask word_size not_less)+
-  apply (cut_tac w = "((x && ~~ mask n) + mask n)" and
+  apply (cut_tac w = "((x && ~~ (mask n)) + mask n)" and
       m = n and n = "na - n" in nth_shiftr[symmetric])
   apply clarsimp
   apply (subst (asm) aligned_shift')
   apply (simp add:mask_lt_2pn is_aligned_neg_mask nth_shiftr neg_mask_bang)+
 done
 
 lemma subtract_mask:
-  "p - (p && mask n) = (p && ~~ mask n)"
-  "p - (p && ~~ mask n) = (p && mask n)"
+  "p - (p && mask n) = (p && ~~ (mask n))"
+  "p - (p && ~~ (mask n)) = (p && mask n)"
   by (simp add: field_simps word_plus_and_or_coroll2)+
 
-lemma and_neg_mask_plus_mask_mono: "(p && ~~ mask n) + mask n \<ge> p"
-  apply (rule word_le_minus_cancel[where x = "p && ~~ mask n"])
+lemma and_neg_mask_plus_mask_mono: "(p && ~~ (mask n)) + mask n \<ge> p"
+  apply (rule word_le_minus_cancel[where x = "p && ~~ (mask n)"])
    apply (clarsimp simp: subtract_mask)
    using word_and_le1[where a = "mask n" and y = p]
    apply (clarsimp simp: mask_def word_le_less_eq)
   apply (rule is_aligned_no_overflow'[folded mask_2pm1])
   apply (clarsimp simp: is_aligned_neg_mask)
   done
 
 lemma word_neg_and_le:
-  "ptr \<le> (ptr && ~~ mask n) + (2 ^ n - 1)"
+  "ptr \<le> (ptr && ~~ (mask n)) + (2 ^ n - 1)"
   by (simp add: and_neg_mask_plus_mask_mono mask_2pm1[symmetric])
 
 lemma aligned_less_plus_1:
   "\<lbrakk> is_aligned x n; n > 0 \<rbrakk> \<Longrightarrow> x < x + 1"
   apply (rule plus_one_helper2)
    apply (rule order_refl)
   apply (clarsimp simp: field_simps)
   apply (drule arg_cong[where f="\<lambda>x. x - 1"])
   apply (clarsimp simp: is_aligned_mask)
   apply (drule word_eqD[where x=0])
   apply simp
   done
 
 lemma aligned_add_offset_less:
   "\<lbrakk>is_aligned x n; is_aligned y n; x < y; z < 2 ^ n\<rbrakk> \<Longrightarrow> x + z < y"
   apply (cases "y = 0")
    apply simp
   apply (erule is_aligned_get_word_bits[where p=y], simp_all)
   apply (cases "z = 0", simp_all)
   apply (drule(2) aligned_at_least_t2n_diff[rotated -1])
   apply (drule plus_one_helper2)
    apply (rule less_is_non_zero_p1)
    apply (rule aligned_less_plus_1)
     apply (erule aligned_sub_aligned[OF _ _ order_refl],
            simp_all add: is_aligned_triv)[1]
    apply (cases n, simp_all)[1]
   apply (simp only: trans[OF diff_add_eq diff_diff_eq2[symmetric]])
   apply (drule word_less_add_right)
    apply (rule ccontr, simp add: linorder_not_le)
    apply (drule aligned_small_is_0, erule order_less_trans)
     apply (clarsimp simp: power_overflow)
    apply simp
   apply (erule order_le_less_trans[rotated],
          rule word_plus_mono_right)
    apply (erule minus_one_helper3)
   apply (simp add: is_aligned_no_wrap' is_aligned_no_overflow field_simps)
   done
 
 lemma is_aligned_add_helper:
   "\<lbrakk> is_aligned p n; d < 2 ^ n \<rbrakk>
-     \<Longrightarrow> (p + d && mask n = d) \<and> (p + d && (~~ mask n) = p)"
+     \<Longrightarrow> (p + d && mask n = d) \<and> (p + d && (~~ (mask n)) = p)"
   apply (subst(asm) is_aligned_mask)
   apply (drule less_mask_eq)
   apply (rule context_conjI)
    apply (subst word_plus_and_or_coroll)
     apply (rule word_eqI)
     apply (drule_tac x=na in word_eqD)+
     apply (simp add: word_size)
     apply blast
    apply (rule word_eqI)
    apply (drule_tac x=na in word_eqD)+
    apply (simp add: word_ops_nth_size word_size)
    apply blast
   apply (insert word_plus_and_or_coroll2[where x="p + d" and w="mask n"])
   apply simp
   done
 
 lemma is_aligned_sub_helper:
   "\<lbrakk> is_aligned (p - d) n; d < 2 ^ n \<rbrakk>
-     \<Longrightarrow> (p && mask n = d) \<and> (p && (~~ mask n) = p - d)"
+     \<Longrightarrow> (p && mask n = d) \<and> (p && (~~ (mask n)) = p - d)"
   by (drule(1) is_aligned_add_helper, simp)
 
 lemma mask_twice:
   "(x && mask n) && mask m = x && mask (min m n)"
   apply (rule word_eqI)
   apply (simp add: word_size conj_comms)
   done
 
 lemma is_aligned_after_mask:
   "\<lbrakk>is_aligned k m;m\<le> n\<rbrakk> \<Longrightarrow> is_aligned (k && mask n) m"
   by (rule is_aligned_andI1)
 
 lemma and_mask_plus:
   "\<lbrakk>is_aligned ptr m; m \<le> n; a < 2 ^ m\<rbrakk>
    \<Longrightarrow> ptr + a && mask n = (ptr && mask n) + a"
   apply (rule mask_eqI[where n = m])
    apply (simp add:mask_twice min_def)
     apply (simp add:is_aligned_add_helper)
     apply (subst is_aligned_add_helper[THEN conjunct1])
       apply (erule is_aligned_after_mask)
      apply simp
     apply simp
    apply simp
-  apply (subgoal_tac "(ptr + a && mask n) && ~~ mask m
-     = (ptr + a && ~~ mask m ) && mask n")
+  apply (subgoal_tac "(ptr + a && mask n) && ~~ (mask m)
+     = (ptr + a && ~~ (mask m) ) && mask n")
    apply (simp add:is_aligned_add_helper)
    apply (subst is_aligned_add_helper[THEN conjunct2])
      apply (simp add:is_aligned_after_mask)
     apply simp
    apply simp
   apply (simp add:word_bw_comms word_bw_lcs)
   done
 
 lemma le_step_down_word:"\<lbrakk>(i::('a::len) word) \<le> n; i = n \<longrightarrow> P; i \<le> n - 1 \<longrightarrow> P\<rbrakk> \<Longrightarrow> P"
   by unat_arith
 
 lemma le_step_down_word_2:
   fixes x :: "'a::len word"
   shows "\<lbrakk>x \<le>  y; x \<noteq> y\<rbrakk> \<Longrightarrow> x \<le> y - 1"
   by (subst (asm) word_le_less_eq,
       clarsimp,
       simp add: minus_one_helper3)
 
-lemma NOT_mask_AND_mask[simp]: "(w && mask n) && ~~ mask n = 0"
+lemma NOT_mask_AND_mask[simp]: "(w && mask n) && ~~ (mask n) = 0"
   apply (clarsimp simp:mask_def)
   by (metis word_bool_alg.conj_cancel_right word_bool_alg.conj_zero_right word_bw_comms(1) word_bw_lcs(1))
 
 lemma and_and_not[simp]:"(a && b) && ~~ b = 0"
   apply (subst word_bw_assocs(1))
   apply clarsimp
   done
 
 lemma mask_shift_and_negate[simp]:"(w && mask n << m) && ~~ (mask n << m) = 0"
   apply (clarsimp simp:mask_def)
   by (metis (erased, hide_lams) mask_eq_x_eq_0 shiftl_over_and_dist word_bool_alg.conj_absorb word_bw_assocs(1))
 
 lemma le_step_down_nat:"\<lbrakk>(i::nat) \<le> n; i = n \<longrightarrow> P; i \<le> n - 1 \<longrightarrow> P\<rbrakk> \<Longrightarrow> P"
   by arith
 
 lemma le_step_down_int:"\<lbrakk>(i::int) \<le> n; i = n \<longrightarrow> P; i \<le> n - 1 \<longrightarrow> P\<rbrakk> \<Longrightarrow> P"
   by arith
 
 lemma mask_1[simp]: "(\<exists>x. mask x = 1)"
   apply (rule_tac x=1 in exI)
   apply (simp add:mask_def)
   done
 
 lemma not_switch:"~~ a = x \<Longrightarrow> a = ~~ x"
   by auto
 
 (* The seL4 bitfield generator produces functions containing mask and shift operations, such that
  * invoking two of them consecutively can produce something like the following.
  *)
 lemma bitfield_op_twice:
   "(x && ~~ (mask n << m) || ((y && mask n) << m)) && ~~ (mask n << m) = x && ~~ (mask n << m)"
   by (induct n arbitrary: m) (auto simp: word_ao_dist)
 
 lemma bitfield_op_twice'':
   "\<lbrakk>~~ a = b << c; \<exists>x. b = mask x\<rbrakk> \<Longrightarrow> (x && a || (y && b << c)) && a = x && a"
   apply clarsimp
   apply (cut_tac n=xa and m=c and x=x and y=y in bitfield_op_twice)
   apply (clarsimp simp:mask_def)
   apply (drule not_switch)
   apply clarsimp
   done
 
 lemma bit_twiddle_min:
   "(y::'a::len word) xor (((x::'a::len word) xor y) && (if x < y then -1 else 0)) = min x y"
   by (metis (mono_tags) min_def word_bitwise_m1_simps(2) word_bool_alg.xor_left_commute
              word_bool_alg.xor_self word_bool_alg.xor_zero_right word_bw_comms(1)
              word_le_less_eq word_log_esimps(7))
 
 lemma bit_twiddle_max:
   "(x::'a::len word) xor (((x::'a::len word) xor y) && (if x < y then -1 else 0)) = max x y"
   by (metis (mono_tags) max_def word_bitwise_m1_simps(2) word_bool_alg.xor_left_self
             word_bool_alg.xor_zero_right word_bw_comms(1) word_le_less_eq word_log_esimps(7))
 
 lemma swap_with_xor:
   "\<lbrakk>(x::'a::len word) = a xor b; y = b xor x; z = x xor y\<rbrakk> \<Longrightarrow> z = b \<and> y = a"
   by (metis word_bool_alg.xor_assoc word_bool_alg.xor_commute word_bool_alg.xor_self
             word_bool_alg.xor_zero_right)
 
 lemma scast_nop1:
   "((scast ((of_int x)::('a::len) word))::'a sword) = of_int x"
   apply (clarsimp simp:scast_def word_of_int)
   by (metis len_signed sint_sbintrunc' word_sint.Rep_inverse)
 
 lemma scast_nop2:
   "((scast ((of_int x)::('a::len) sword))::'a word) = of_int x"
   apply (clarsimp simp:scast_def word_of_int)
   by (metis len_signed sint_sbintrunc' word_sint.Rep_inverse)
 
 lemmas scast_nop[simp] = scast_nop1 scast_nop2 scast_id
 
 lemma le_mask_imp_and_mask:
   "(x::'a::len word) \<le> mask n \<Longrightarrow> x && mask n = x"
   by (metis and_mask_eq_iff_le_mask)
 
 lemma or_not_mask_nop:
-  "((x::'a::len word) || ~~ mask n) && mask n = x && mask n"
+  "((x::'a::len word) || ~~ (mask n)) && mask n = x && mask n"
   by (metis word_and_not word_ao_dist2 word_bw_comms(1) word_log_esimps(3))
 
 lemma mask_subsume:
-  "\<lbrakk>n \<le> m\<rbrakk> \<Longrightarrow> ((x::'a::len word) || y && mask n) && ~~ mask m = x && ~~ mask m"
+  "\<lbrakk>n \<le> m\<rbrakk> \<Longrightarrow> ((x::'a::len word) || y && mask n) && ~~ (mask m) = x && ~~ (mask m)"
   apply (subst word_ao_dist)
-  apply (subgoal_tac "(y && mask n) && ~~ mask m = 0")
+  apply (subgoal_tac "(y && mask n) && ~~ (mask m) = 0")
    apply simp
   by (metis (no_types, hide_lams) is_aligned_mask is_aligned_weaken word_and_not
             word_bool_alg.conj_zero_right word_bw_comms(1) word_bw_lcs(1))
 
 lemma mask_twice2:
   "n \<le> m \<Longrightarrow> ((x::'a::len word) && mask m) && mask n = x && mask n"
   by (metis mask_twice min_def)
 
 lemma uint_2_id:
   "LENGTH('a) \<ge> 2 \<Longrightarrow> uint (2::('a::len) word) = 2"
   apply clarsimp
   apply (subgoal_tac "2 \<in> uints (LENGTH('a))")
    apply (subst (asm) Word.word_ubin.set_iff_norm)
    apply simp
   apply (subst word_uint.set_iff_norm)
   apply clarsimp
   apply (rule int_mod_eq')
    apply simp
   apply (rule pow_2_gt)
   apply simp
   done
 
 lemma bintrunc_id:
   "\<lbrakk>m \<le> of_nat n; 0 < m\<rbrakk> \<Longrightarrow> bintrunc n m = m"
   by (simp add: bintrunc_mod2p le_less_trans)
 
 lemma shiftr1_unfold: "shiftr1 x = x >> 1"
   by (metis One_nat_def comp_apply funpow.simps(1) funpow.simps(2) id_apply shiftr_def)
 
 lemma shiftr1_is_div_2: "(x::('a::len) word) >> 1 = x div 2"
   apply (case_tac "LENGTH('a) = 1")
    apply simp
  apply (subgoal_tac "x = 0 \<or> x = 1")
     apply (erule disjE)
      apply (clarsimp simp:word_div_def)+
    apply (metis One_nat_def less_irrefl_nat sint_1_cases)
   apply clarsimp
   apply (subst word_div_def)
   apply clarsimp
   apply (subst bintrunc_id)
     apply (subgoal_tac "2 \<le> LENGTH('a)")
      apply simp
     apply (metis (no_types) le_0_eq le_SucE lens_not_0(2) not_less_eq_eq numeral_2_eq_2)
    apply simp
   apply (subst bin_rest_def[symmetric])
   apply (subst shiftr1_def[symmetric])
   apply (clarsimp simp:shiftr1_unfold)
   done
 
 lemma shiftl1_is_mult: "(x << 1) = (x :: 'a::len word) * 2"
   by (metis One_nat_def mult_2 mult_2_right one_add_one
         power_0 power_Suc shiftl_t2n)
 
 lemma div_of_0_id[simp]:"(0::('a::len) word) div n = 0"
   by (simp add: word_div_def)
 
 lemma degenerate_word:"LENGTH('a) = 1 \<Longrightarrow> (x::('a::len) word) = 0 \<or> x = 1"
   by (metis One_nat_def less_irrefl_nat sint_1_cases)
 
 lemma div_by_0_word:"(x::('a::len) word) div 0 = 0"
   by (metis div_0 div_by_0 unat_0 word_arith_nat_defs(6) word_div_1)
 
 lemma div_less_dividend_word:"\<lbrakk>x \<noteq> 0; n \<noteq> 1\<rbrakk> \<Longrightarrow> (x::('a::len) word) div n < x"
   apply (case_tac "n = 0")
    apply clarsimp
    apply (subst div_by_0_word)
    apply (simp add:word_neq_0_conv)
   apply (subst word_arith_nat_div)
   apply (rule word_of_nat_less)
   apply (rule div_less_dividend)
    apply (metis (poly_guards_query) One_nat_def less_one nat_neq_iff unat_eq_1(2) unat_eq_zero)
   apply (simp add:unat_gt_0)
   done
 
 lemma shiftr1_lt:"x \<noteq> 0 \<Longrightarrow> (x::('a::len) word) >> 1 < x"
   apply (subst shiftr1_is_div_2)
   apply (rule div_less_dividend_word)
    apply simp+
   done
 
 lemma word_less_div:
   fixes x :: "('a::len) word"
     and y :: "('a::len) word"
   shows "x div y = 0 \<Longrightarrow> y = 0 \<or> x < y"
   apply (case_tac "y = 0", clarsimp+)
   by (metis One_nat_def Suc_le_mono le0 le_div_geq not_less unat_0 unat_div unat_gt_0 word_less_nat_alt zero_less_one)
 
 lemma not_degenerate_imp_2_neq_0:"LENGTH('a) > 1 \<Longrightarrow> (2::('a::len) word) \<noteq> 0"
   by (metis numerals(1) power_not_zero power_zero_numeral)
 
 lemma shiftr1_0_or_1:"(x::('a::len) word) >> 1 = 0 \<Longrightarrow> x = 0 \<or> x = 1"
   apply (subst (asm) shiftr1_is_div_2)
   apply (drule word_less_div)
   apply (case_tac "LENGTH('a) = 1")
    apply (simp add:degenerate_word)
   apply (erule disjE)
    apply (subgoal_tac "(2::'a word) \<noteq> 0")
     apply simp
    apply (rule not_degenerate_imp_2_neq_0)
    apply (subgoal_tac "LENGTH('a) \<noteq> 0")
     apply arith
    apply simp
   apply (rule x_less_2_0_1', simp+)
   done
 
 lemma word_overflow:"(x::('a::len) word) + 1 > x \<or> x + 1 = 0"
   apply clarsimp
   by (metis diff_0 eq_diff_eq less_x_plus_1 max_word_max plus_1_less)
 
 lemma word_overflow_unat:"unat ((x::('a::len) word) + 1) = unat x + 1 \<or> x + 1 = 0"
   by (metis Suc_eq_plus1 add.commute unatSuc)
 
 lemma even_word_imp_odd_next:"even (unat (x::('a::len) word)) \<Longrightarrow> x + 1 = 0 \<or> odd (unat (x + 1))"
   apply (cut_tac x=x in word_overflow_unat)
   apply clarsimp
   done
 
 lemma odd_word_imp_even_next:"odd (unat (x::('a::len) word)) \<Longrightarrow> x + 1 = 0 \<or> even (unat (x + 1))"
   apply (cut_tac x=x in word_overflow_unat)
   apply clarsimp
   done
 
 lemma overflow_imp_lsb:"(x::('a::len) word) + 1 = 0 \<Longrightarrow> x !! 0"
   by (metis add.commute add_left_cancel max_word_max not_less word_and_1 word_bool_alg.conj_one_right word_bw_comms(1) word_overflow zero_neq_one)
 
 lemma word_lsb_nat:"lsb w = (unat w mod 2 = 1)"
   unfolding word_lsb_def bin_last_def
   by (metis (no_types, hide_lams) nat_mod_distrib nat_numeral not_mod_2_eq_1_eq_0 numeral_One uint_eq_0 uint_nonnegative unat_0 unat_def zero_le_numeral)
 
 lemma odd_iff_lsb:"odd (unat (x::('a::len) word)) = x !! 0"
   apply (simp add:even_iff_mod_2_eq_zero)
   apply (subst word_lsb_nat[unfolded One_nat_def, symmetric])
   apply (rule word_lsb_alt)
   done
 
 lemma of_nat_neq_iff_word:
       "x mod 2 ^ LENGTH('a) \<noteq> y mod 2 ^ LENGTH('a) \<Longrightarrow>
          (((of_nat x)::('a::len) word) \<noteq> of_nat y) = (x \<noteq> y)"
   apply (rule iffI)
    apply (case_tac "x = y")
    apply (subst (asm) of_nat_eq_iff[symmetric])
    apply simp+
   apply (case_tac "((of_nat x)::('a::len) word) = of_nat y")
    apply (subst (asm) word_unat.norm_eq_iff[symmetric])
    apply simp+
   done
 
 lemma shiftr1_irrelevant_lsb:"(x::('a::len) word) !! 0 \<or> x >> 1 = (x + 1) >> 1"
   apply (case_tac "LENGTH('a) = 1")
    apply clarsimp
    apply (drule_tac x=x in degenerate_word[unfolded One_nat_def])
    apply (erule disjE)
     apply clarsimp+
   apply (subst (asm) shiftr1_is_div_2[unfolded One_nat_def])+
   apply (subst (asm) word_arith_nat_div)+
   apply clarsimp
   apply (subst (asm) bintrunc_id)
     apply (subgoal_tac "LENGTH('a) > 0")
      apply linarith
     apply clarsimp+
   apply (subst (asm) bintrunc_id)
     apply (subgoal_tac "LENGTH('a) > 0")
      apply linarith
     apply clarsimp+
   apply (case_tac "x + 1 = 0")
    apply (clarsimp simp:overflow_imp_lsb)
   apply (cut_tac x=x in word_overflow_unat)
   apply clarsimp
   apply (case_tac "even (unat x)")
    apply (subgoal_tac "unat x div 2 = Suc (unat x) div 2")
     apply metis
    apply (subst numeral_2_eq_2)+
    apply simp
   apply (simp add:odd_iff_lsb)
   done
 
 lemma shiftr1_0_imp_only_lsb:"((x::('a::len) word) + 1) >> 1 = 0 \<Longrightarrow> x = 0 \<or> x + 1 = 0"
   by (metis One_nat_def shiftr1_0_or_1 word_less_1 word_overflow)
 
 lemma shiftr1_irrelevant_lsb':"\<not>((x::('a::len) word) !! 0) \<Longrightarrow> x >> 1 = (x + 1) >> 1"
   by (metis shiftr1_irrelevant_lsb)
 
 lemma lsb_this_or_next:"\<not>(((x::('a::len) word) + 1) !! 0) \<Longrightarrow> x !! 0"
   by (metis (poly_guards_query) even_word_imp_odd_next odd_iff_lsb overflow_imp_lsb)
 
 (* Perhaps this one should be a simp lemma, but it seems a little dangerous. *)
 lemma cast_chunk_assemble_id:
   "\<lbrakk>n = LENGTH('a::len); m = LENGTH('b::len); n * 2 = m\<rbrakk> \<Longrightarrow>
   (((ucast ((ucast (x::'b word))::'a word))::'b word) || (((ucast ((ucast (x >> n))::'a word))::'b word) << n)) = x"
   apply (subgoal_tac "((ucast ((ucast (x >> n))::'a word))::'b word) = x >> n")
    apply clarsimp
    apply (subst and_not_mask[symmetric])
    apply (subst ucast_ucast_mask)
    apply (subst word_ao_dist2[symmetric])
    apply clarsimp
   apply (rule ucast_ucast_len)
   apply (rule shiftr_less_t2n')
    apply (subst and_mask_eq_iff_le_mask)
    apply (clarsimp simp:mask_def)
    apply (metis max_word_eq max_word_max mult_2_right)
   apply (metis add_diff_cancel_left' diff_less len_gt_0 mult_2_right)
   done
 
 lemma cast_chunk_scast_assemble_id:
   "\<lbrakk>n = LENGTH('a::len); m = LENGTH('b::len); n * 2 = m\<rbrakk> \<Longrightarrow>
   (((ucast ((scast (x::'b word))::'a word))::'b word) ||
    (((ucast ((scast (x >> n))::'a word))::'b word) << n)) = x"
   apply (subgoal_tac "((scast x)::'a word) = ((ucast x)::'a word)")
    apply (subgoal_tac "((scast (x >> n))::'a word) = ((ucast (x >> n))::'a word)")
     apply (simp add:cast_chunk_assemble_id)
    apply (subst down_cast_same[symmetric], subst is_down, arith, simp)+
   done
 
 lemma mask_or_not_mask:
-  "x && mask n || x && ~~ mask n = x"
+  "x && mask n || x && ~~ (mask n) = x"
   apply (subst word_oa_dist, simp)
   apply (subst word_oa_dist2, simp)
   done
 
 lemma is_aligned_add_not_aligned:
   "\<lbrakk>is_aligned (p::'a::len word) n; \<not> is_aligned (q::'a::len word) n\<rbrakk> \<Longrightarrow> \<not> is_aligned (p + q) n"
   by (metis is_aligned_addD1)
 
 lemma word_gr0_conv_Suc: "(m::'a::len word) > 0 \<Longrightarrow> \<exists>n. m = n + 1"
   by (metis add.commute add_minus_cancel)
 
 lemma neg_mask_add_aligned:
-  "\<lbrakk> is_aligned p n; q < 2 ^ n \<rbrakk> \<Longrightarrow> (p + q) && ~~ mask n = p && ~~ mask n"
+  "\<lbrakk> is_aligned p n; q < 2 ^ n \<rbrakk> \<Longrightarrow> (p + q) && ~~ (mask n) = p && ~~ (mask n)"
   by (metis is_aligned_add_helper is_aligned_neg_mask_eq)
 
 lemma word_sless_sint_le:"x <s y \<Longrightarrow> sint x \<le> sint y - 1"
   by (metis word_sless_alt zle_diff1_eq)
 
 
 lemma upper_trivial:
   fixes x :: "'a::len word"
   shows "x \<noteq> 2 ^ LENGTH('a) - 1 \<Longrightarrow> x < 2 ^ LENGTH('a) - 1"
   by (cut_tac n=x and 'a='a in max_word_max,
       clarsimp simp:max_word_def,
       simp add: less_le)
 
 lemma constraint_expand:
   fixes x :: "'a::len word"
   shows "x \<in> {y. lower \<le> y \<and> y \<le> upper} = (lower \<le> x \<and> x \<le> upper)"
   by (rule mem_Collect_eq)
 
 lemma card_map_elide:
   "card ((of_nat :: nat \<Rightarrow> 'a::len word) ` {0..<n}) = card {0..<n}"
     if "n \<le> CARD('a::len word)"
 proof -
   let ?of_nat = "of_nat :: nat \<Rightarrow> 'a word"
   from word_unat.Abs_inj_on
   have "inj_on ?of_nat {i. i < CARD('a word)}"
     by (simp add: unats_def card_word)
   moreover have "{0..<n} \<subseteq> {i. i < CARD('a word)}"
     using that by auto
   ultimately have "inj_on ?of_nat {0..<n}"
     by (rule inj_on_subset)
   then show ?thesis
     by (simp add: card_image)
 qed
 
 lemma card_map_elide2:
   "n \<le> CARD('a::len word) \<Longrightarrow> card ((of_nat::nat \<Rightarrow> 'a::len word) ` {0..<n}) = n"
   by (subst card_map_elide) clarsimp+
 
 lemma le_max_word_ucast_id:
   assumes "(x::'a::len word) \<le> ucast (max_word::'b::len word)"
   shows "ucast ((ucast x)::'b word) = x"
 proof -
   {
     assume a1: "x \<le> word_of_int (uint (word_of_int (2 ^ len_of (TYPE('b)) - 1)::'b word))"
     have f2: "((\<exists>i ia. (0::int) \<le> i \<and> \<not> 0 \<le> i + - 1 * ia \<and> i mod ia \<noteq> i) \<or>
               \<not> (0::int) \<le> - 1 + 2 ^ LENGTH('b) \<or> (0::int) \<le> - 1 + 2 ^ LENGTH('b) + - 1 * 2 ^ LENGTH('b) \<or>
               (- (1::int) + 2 ^ LENGTH('b)) mod 2 ^ LENGTH('b) =
                 - 1 + 2 ^ LENGTH('b)) = ((\<exists>i ia. (0::int) \<le> i \<and> \<not> 0 \<le> i + - 1 * ia \<and> i mod ia \<noteq> i) \<or>
               \<not> (1::int) \<le> 2 ^ LENGTH('b) \<or>
               2 ^ LENGTH('b) + - (1::int) * ((- 1 + 2 ^ LENGTH('b)) mod 2 ^ LENGTH('b)) = 1)"
       by force
     have f3: "\<forall>i ia. \<not> (0::int) \<le> i \<or> 0 \<le> i + - 1 * ia \<or> i mod ia = i"
       using mod_pos_pos_trivial by force
     have "(1::int) \<le> 2 ^ LENGTH('b)"
       by simp
     then have "2 ^ LENGTH('b) + - (1::int) * ((- 1 + 2 ^ LENGTH('b)) mod 2 ^ len_of TYPE ('b)) = 1"
       using f3 f2 by blast
     then have f4: "- (1::int) + 2 ^ LENGTH('b) = (- 1 + 2 ^ LENGTH('b)) mod 2 ^ LENGTH('b)"
       by linarith
     have f5: "x \<le> word_of_int (uint (word_of_int (- 1 + 2 ^ LENGTH('b))::'b word))"
       using a1 by force
     have f6: "2 ^ len_of (TYPE('b)::'b itself) + - (1::int) = - 1 + 2 ^ len_of (TYPE('b))"
       by force
     have f7: "- (1::int) * 1 = - 1"
       by auto
     have "\<forall>x0 x1. (x1::int) - x0 = x1 + - 1 * x0"
       by force
     then have "x \<le> 2 ^ LENGTH('b) - 1"
       using f7 f6 f5 f4 by (metis uint_word_of_int wi_homs(2) word_arith_wis(8) word_of_int_2p)
   }
   with assms show ?thesis
     unfolding ucast_def
     apply (subst word_ubin.eq_norm)
     apply (subst and_mask_bintr[symmetric])
     apply (subst and_mask_eq_iff_le_mask)
     apply (clarsimp simp: max_word_def mask_def)
     done
 qed
 
 lemma remdups_enum_upto:
   fixes s::"'a::len word"
   shows "remdups [s .e. e] = [s .e. e]"
   by simp
 
 lemma card_enum_upto:
   fixes s::"'a::len word"
   shows "card (set [s .e. e]) = Suc (unat e) - unat s"
   by (subst List.card_set) (simp add: remdups_enum_upto)
 
 lemma unat_mask:
   "unat (mask n :: 'a :: len word) = 2 ^ (min n (LENGTH('a))) - 1"
   apply (subst min.commute)
   apply (simp add: mask_def not_less min_def  split: if_split_asm)
   apply (intro conjI impI)
    apply (simp add: unat_sub_if_size)
    apply (simp add: power_overflow word_size)
   apply (simp add: unat_sub_if_size)
   done
 
 lemma word_shiftr_lt:
   fixes w :: "'a::len word"
   shows "unat (w >> n) < (2 ^ (len_of(TYPE('a)) - n))"
   apply (subst shiftr_div_2n')
   by (metis nat_mod_lem nat_zero_less_power_iff power_mod_div
       word_unat.Rep_inverse word_unat.eq_norm zero_less_numeral)
 
 lemma complement_nth_w2p:
   shows "n' < len_of(TYPE('a)) \<Longrightarrow> (~~ (2 ^ n :: ('a::len word))) !! n' = (n' \<noteq> n)"
   by (fastforce simp: word_ops_nth_size word_size nth_w2p)
 
 lemma word_unat_and_lt:
   "unat x < n \<or> unat y < n \<Longrightarrow> unat (x && y) < n"
   by (meson le_less_trans word_and_le1 word_and_le2 word_le_nat_alt)
 
 lemma word_unat_mask_lt:
   "m \<le> size w \<Longrightarrow> unat ((w::'a::len word) && mask m) < 2 ^ m"
   by (rule word_unat_and_lt) (simp add: unat_mask word_size)
 
 lemma unat_shiftr_less_t2n:
   fixes x :: "'a :: len word"
   shows "unat x < 2 ^ (n + m) \<Longrightarrow> unat (x >> n) < 2 ^ m"
   by (simp add: shiftr_div_2n' power_add mult.commute td_gal_lt)
 
 lemma le_or_mask:
   "w \<le> w' \<Longrightarrow> w || mask x \<le> w' || mask x"
   by (metis neg_mask_add_mask add.commute le_word_or1 mask_2pm1 neg_mask_mono_le word_plus_mono_left)
 
 lemma le_shiftr1':
   "\<lbrakk> shiftr1 u \<le> shiftr1 v ; shiftr1 u \<noteq> shiftr1 v \<rbrakk> \<Longrightarrow> u \<le> v"
   apply (unfold word_le_def shiftr1_def word_ubin.eq_norm)
   apply (unfold bin_rest_trunc_i
                 trans [OF bintrunc_bintrunc_l word_ubin.norm_Rep,
                           unfolded word_ubin.norm_Rep,
                        OF order_refl [THEN le_SucI]])
   apply (case_tac "uint u" rule: bin_exhaust)
   apply (rename_tac bs bit)
   apply (case_tac "uint v" rule: bin_exhaust)
   apply (rename_tac bs' bit')
   apply (case_tac "bit")
    apply (case_tac "bit'", auto simp: less_eq_int_code le_Bits intro: basic_trans_rules)[1]
   apply (case_tac bit')
    apply (simp add: le_Bits less_eq_int_code)
   apply (auto simp: le_Bits less_eq_int_code)
   done
 
 lemma le_shiftr':
   "\<lbrakk> u >> n \<le> v >> n ; u >> n \<noteq> v >> n \<rbrakk> \<Longrightarrow> (u::'a::len0 word) \<le> v"
   apply (induct n, simp)
   apply (unfold shiftr_def)
   apply (case_tac "(shiftr1 ^^ n) u = (shiftr1 ^^ n) v")
    apply simp
   apply (fastforce dest: le_shiftr1')
   done
 
 lemma word_log2_nth_same:
   "w \<noteq> 0 \<Longrightarrow> w !! word_log2 w"
   unfolding word_log2_def
   using nth_length_takeWhile[where P=Not and xs="to_bl w"]
   apply (simp add: word_clz_def word_size to_bl_nth)
   apply (fastforce simp: linorder_not_less eq_zero_set_bl
                    dest: takeWhile_take_has_property)
   done
 
 lemma word_log2_nth_not_set:
   "\<lbrakk> word_log2 w < i ; i < size w \<rbrakk> \<Longrightarrow> \<not> w !! i"
   unfolding word_log2_def word_clz_def
   using takeWhile_take_has_property_nth[where P=Not and xs="to_bl w" and n="size w - Suc i"]
   by (fastforce simp add: to_bl_nth word_size)
 
 lemma word_log2_highest:
   assumes a: "w !! i"
   shows "i \<le> word_log2 w"
 proof -
   from a have "i < size w" by - (rule test_bit_size)
   with a show ?thesis
     by - (rule ccontr, simp add: word_log2_nth_not_set)
 qed
 
 lemma word_log2_max:
   "word_log2 w < size w"
   unfolding word_log2_def word_clz_def
   by simp
 
 lemma word_clz_0[simp]:
   "word_clz (0::'a::len word) \<equiv> len_of (TYPE('a))"
   unfolding word_clz_def
   by (simp add: takeWhile_replicate)
 
 lemma word_clz_minus_one[simp]:
   "word_clz (-1::'a::len word) \<equiv> 0"
   unfolding word_clz_def
   by (simp add: max_word_bl[simplified max_word_minus] takeWhile_replicate)
 
 lemma word_add_no_overflow:"(x::'a::len word) < max_word \<Longrightarrow> x < x + 1"
   using less_x_plus_1 order_less_le by blast
 
 lemma lt_plus_1_le_word:
   fixes x :: "'a::len word"
   assumes bound:"n < unat (maxBound::'a word)"
   shows "x < 1 + of_nat n = (x \<le> of_nat n)"
   apply (subst le_less)
   apply (rule iffI)
    apply clarsimp
    apply (subst (asm) add.commute)
    apply (subst (asm) less_x_plus_1)
     apply (cut_tac ?'a='a and y=n and x="unat (maxBound::'a word) - 1" in of_nat_mono_maybe')
       apply clarsimp
       apply (simp add: less_imp_diff_less)
      apply (insert bound[unfolded maxBound_word, simplified])
      using order_less_trans apply blast
     apply (metis max_word_minus word_not_simps(3) word_of_nat_less)
    apply clarsimp
   apply (erule disjE)
    apply (subgoal_tac "x < of_nat (1 + n)")
     prefer 2
     apply (cut_tac ?'a='a and y="unat x" and x="1 + n" in of_nat_mono_maybe)
       apply clarsimp
       apply (simp add: less_trans_Suc)
      apply (simp add: less_Suc_eq unat_less_helper)
     apply clarsimp
    apply clarsimp
   apply clarsimp
   apply (cut_tac y="(of_nat n)::'a word" and x="(of_nat n)::'a word" in less_x_plus_1)
    apply (cut_tac ?'a='a and y=n and x="unat (maxBound::'a word) - 1" in of_nat_mono_maybe')
      apply clarsimp
      apply (simp add: less_imp_diff_less)
     apply (insert bound[unfolded maxBound_word, simplified])
     using order_less_trans apply blast
    apply (metis max_word_minus word_not_simps(3) word_of_nat_less)
   apply (clarsimp simp: add.commute)
   done
 
 lemma unat_ucast_up_simp:
   fixes x :: "'a::len word"
   assumes uc :"LENGTH('a) \<le> LENGTH('b)"
   shows "unat (ucast x :: 'b::len word) = unat x"
   unfolding ucast_def unat_def
   apply (subst int_word_uint)
   apply (subst mod_pos_pos_trivial)
     apply simp
    apply (rule lt2p_lem)
    apply (simp add: uc)
   apply simp
   done
 
 lemma unat_ucast_less_no_overflow:
   "\<lbrakk>n < 2 ^ LENGTH('a); unat f < n\<rbrakk> \<Longrightarrow> (f::('a::len) word) < of_nat n"
   apply (erule order_le_less_trans[OF _ of_nat_mono_maybe,rotated])
    apply assumption
   apply simp
   done
 
 lemma unat_ucast_less_no_overflow_simp:
   "n < 2 ^ LENGTH('a) \<Longrightarrow> (unat f < n) = ((f::('a::len) word) < of_nat n)"
   apply (rule iffI)
    apply (simp add:unat_ucast_less_no_overflow)
   apply (simp add:unat_less_helper)
   done
 
 lemma unat_ucast_no_overflow_le:
   assumes no_overflow : "unat b < (2 :: nat) ^ LENGTH('a)"
   and upward_cast: "LENGTH('a) < LENGTH('b)"
   shows  "(ucast (f::('a::len) word) < (b :: 'b :: len word)) = (unat f < unat b)"
   proof -
     have LR: "ucast f < b \<Longrightarrow> unat f < unat b"
       apply (rule unat_less_helper)
       apply (simp add:ucast_nat_def)
       apply (rule_tac 'b1 = 'b in  ucast_less_ucast[THEN iffD1])
        apply (rule upward_cast)
       apply (simp add: ucast_ucast_mask less_mask_eq word_less_nat_alt
                        unat_power_lower[OF upward_cast] no_overflow)
       done
     have RL: "unat f < unat b \<Longrightarrow> ucast f < b"
       proof-
       assume ineq: "unat f < unat b"
       have ucast_rewrite: "ucast (f::('a::len) word) <
           ((ucast (ucast b ::('a::len) word)) :: 'b :: len word)"
         apply (simp add: ucast_less_ucast upward_cast)
         apply (simp add: ucast_nat_def[symmetric])
         apply (rule unat_ucast_less_no_overflow[OF no_overflow ineq])
         done
       then show ?thesis
         apply (rule order_less_le_trans)
         apply (simp add:ucast_ucast_mask word_and_le2)
         done
    qed
    then show ?thesis by (simp add:RL LR iffI)
 qed
 
 (* casting a long word to a shorter word and casting back to the long word
    is equal to the original long word -- if the word is small enough.
   'l is the longer word.
   's is the shorter word.
 *)
 lemma bl_cast_long_short_long_ingoreLeadingZero_generic:
 "length (dropWhile Not (to_bl w)) \<le> LENGTH('s) \<Longrightarrow>
  LENGTH('s) \<le> LENGTH('l) \<Longrightarrow>
   (of_bl:: bool list \<Rightarrow> 'l::len word) (to_bl ((of_bl:: bool list \<Rightarrow> 's::len word) (to_bl w))) = w"
   apply(rule word_uint_eqI)
   apply(subst uint_of_bl_is_bl_to_bin)
    apply(simp; fail)
   apply(subst to_bl_bin)
   apply(subst uint_of_bl_is_bl_to_bin_drop)
    apply blast
   apply(simp)
   done
 
 (*
  Casting between longer and shorter word.
   'l is the longer word.
   's is the shorter word.
  For example: 'l::len word is 128 word (full ipv6 address)
               's::len word is 16 word (address piece of ipv6 address in colon-text-representation)
 *)
 corollary ucast_short_ucast_long_ingoreLeadingZero:
   "length (dropWhile Not (to_bl w)) \<le> LENGTH('s) \<Longrightarrow>
    LENGTH('s) \<le> LENGTH('l) \<Longrightarrow>
    (ucast:: 's::len word \<Rightarrow> 'l::len word) ((ucast:: 'l::len word \<Rightarrow> 's::len word) w) = w"
   apply(subst Word.ucast_bl)+
   apply(rule bl_cast_long_short_long_ingoreLeadingZero_generic)
    apply(simp_all)
   done
 
 lemma length_drop_mask:
   fixes w::"'a::len word"
   shows "length (dropWhile Not (to_bl (w AND mask n))) \<le> n"
 proof -
   have "length (takeWhile Not (replicate n False @ ls)) = n + length (takeWhile Not ls)"
     for ls n by(subst takeWhile_append2) simp+
   then show ?thesis
     unfolding bl_and_mask by (simp add: dropWhile_eq_drop)
 qed
 
 lemma minus_one_word:
   "(-1 :: 'a :: len word) = 2 ^ LENGTH('a) - 1"
   by simp
 
 lemma mask_exceed:
-  "n \<ge> LENGTH('a) \<Longrightarrow> (x::'a::len word) && ~~ mask n = 0"
+  "n \<ge> LENGTH('a) \<Longrightarrow> (x::'a::len word) && ~~ (mask n) = 0"
   by (simp add: and_not_mask shiftr_eq_0)
 
 lemma two_power_strict_part_mono:
   "strict_part_mono {..LENGTH('a) - 1} (\<lambda>x. (2 :: 'a :: len word) ^ x)"
 proof -
   { fix n
     have "n < LENGTH('a) \<Longrightarrow> strict_part_mono {..n} (\<lambda>x. (2 :: 'a :: len word) ^ x)"
     proof (induct n)
       case 0 then show ?case by simp
     next
       case (Suc n)
       from Suc.prems
       have "2 ^ n < (2 :: 'a :: len word) ^ Suc n"
         using power_strict_increasing unat_power_lower word_less_nat_alt by fastforce
       with Suc
       show ?case by (subst strict_part_mono_by_steps) simp
     qed
   }
   then show ?thesis by simp
 qed
 
 lemma word_shift_by_2:
   "x * 4 = (x::'a::len word) << 2"
   by (simp add: shiftl_t2n)
 
 (* simp normal form would be "nat (bintrunc (LENGTH('a)) 2) = 2" *)
 lemma word_len_min_2:
   "Suc 0 < LENGTH('a) \<Longrightarrow> unat (2::'a::len word) = 2"
   by (metis less_trans_Suc n_less_equal_power_2 numeral_2_eq_2 of_nat_numeral unat_of_nat_len)
 
 lemma upper_bits_unset_is_l2p:
   "n < LENGTH('a) \<Longrightarrow>
   (\<forall>n' \<ge> n. n' < LENGTH('a) \<longrightarrow> \<not> p !! n') = ((p::'a::len word) < 2 ^ n)"
   apply (cases "Suc 0 < LENGTH('a)")
    prefer 2
    apply (subgoal_tac "LENGTH('a) = 1", auto simp: word_eq_iff)[1]
   apply (rule iffI)
    apply (subst mask_eq_iff_w2p [symmetric])
     apply (clarsimp simp: word_size)
    apply (rule word_eqI, rename_tac n')
    apply (case_tac "n' < n"; simp add: word_size)
   apply clarify
   apply (drule bang_is_le)
   apply (drule_tac y=p in order_le_less_trans, assumption)
   apply (drule word_power_increasing; simp add: word_len_min_2[simplified])
   done
 
 lemma less_2p_is_upper_bits_unset:
   "((p::'a::len word) < 2 ^ n)
     = (n < LENGTH('a) \<and> (\<forall>n' \<ge> n. n' < LENGTH('a) \<longrightarrow> \<not> p !! n'))"
   apply (cases "n < LENGTH('a)")
    apply (simp add: upper_bits_unset_is_l2p)
   apply (simp add: power_overflow)
   done
 
 lemma le_2p_upper_bits:
   "\<lbrakk> (p::'a::len word) \<le> 2^n - 1; n < LENGTH('a) \<rbrakk> \<Longrightarrow>
   \<forall>n'\<ge>n. n' < LENGTH('a) \<longrightarrow> \<not> p !! n'"
   by (subst upper_bits_unset_is_l2p; simp)
 
 lemma le2p_bits_unset:
   "p \<le> 2 ^ n - 1 \<Longrightarrow> \<forall>n'\<ge>n. n' < LENGTH('a) \<longrightarrow> \<not> (p::'a::len word) !! n'"
   using upper_bits_unset_is_l2p [where p=p]
   by (cases "n < LENGTH('a)") auto
 
 lemma ucast_less_shiftl_helper:
   "\<lbrakk> LENGTH('b) + 2 < LENGTH('a); 2 ^ (LENGTH('b) + 2) \<le> n\<rbrakk>
     \<Longrightarrow> (ucast (x :: 'b::len word) << 2) < (n :: 'a::len word)"
   apply (erule order_less_le_trans[rotated])
   using ucast_less[where x=x and 'a='a]
   apply (simp only: shiftl_t2n field_simps)
   apply (rule word_less_power_trans2; simp)
   done
 
 lemma word_power_nonzero:
   "\<lbrakk> (x :: 'a::len word) < 2 ^ (LENGTH('a) - n); n < LENGTH('a); x \<noteq> 0 \<rbrakk>
   \<Longrightarrow> x * 2 ^ n \<noteq> 0"
   apply (cases "n = 0", simp)
   apply (simp only: word_neq_0_conv word_less_nat_alt shiftl_t2n mod_0 unat_word_ariths
                     unat_power_lower word_le_nat_alt)
   apply (subst mod_less)
    apply (subst mult.commute, erule nat_less_power_trans)
    apply simp
   apply simp
   done
 
 lemma less_1_helper:
   "n \<le> m \<Longrightarrow> (n - 1 :: int) < m"
   by arith
 
 lemma div_power_helper:
   "\<lbrakk> x \<le> y; y < LENGTH('a) \<rbrakk> \<Longrightarrow> (2 ^ y - 1) div (2 ^ x :: 'a::len word) = 2 ^ (y - x) - 1"
   apply (rule word_uint.Rep_eqD)
   apply (simp only: uint_word_ariths uint_div uint_power_lower)
   apply (subst mod_pos_pos_trivial, fastforce, fastforce)+
   apply (subst mod_pos_pos_trivial)
     apply (simp add: le_diff_eq uint_2p_alt)
    apply (rule less_1_helper)
    apply (rule power_increasing; simp)
   apply (subst mod_pos_pos_trivial)
     apply (simp add: uint_2p_alt)
    apply (rule less_1_helper)
    apply (rule power_increasing; simp)
   apply (subst int_div_sub_1; simp add: uint_2p_alt)
   apply (subst power_0[symmetric])
   apply (simp add: uint_2p_alt le_imp_power_dvd power_sub_int)
   done
 
 
 lemma word_add_power_off:
   fixes a :: "'a :: len word"
   assumes ak: "a < k"
   and kw: "k < 2 ^ (LENGTH('a) - m)"
   and mw: "m < LENGTH('a)"
   and off: "off < 2 ^ m"
   shows "(a * 2 ^ m) + off < k * 2 ^ m"
 proof (cases "m = 0")
   case True
   then show ?thesis using off ak by simp
 next
   case False
 
   from ak have ak1: "a + 1 \<le> k" by (rule inc_le)
   then have "(a + 1) * 2 ^ m \<noteq> 0"
     apply -
     apply (rule word_power_nonzero)
     apply (erule order_le_less_trans  [OF _ kw])
     apply (rule mw)
     apply (rule less_is_non_zero_p1 [OF ak])
     done
   then have "(a * 2 ^ m) + off < ((a + 1) * 2 ^ m)" using kw mw
     apply -
     apply (simp add: distrib_right)
     apply (rule word_plus_strict_mono_right [OF off])
     apply (rule is_aligned_no_overflow'')
     apply (rule is_aligned_mult_triv2)
     apply assumption
     done
   also have "\<dots> \<le> k * 2 ^ m" using ak1 mw kw False
     apply -
     apply (erule word_mult_le_mono1)
     apply (simp add: p2_gt_0)
     apply (simp add: word_less_nat_alt)
     apply (rule nat_less_power_trans2[simplified])
     apply (simp add: word_less_nat_alt)
     apply simp
     done
   finally show ?thesis .
 qed
 
 lemma offset_not_aligned:
   "\<lbrakk> is_aligned (p::'a::len word) n; i > 0; i < 2 ^ n; n < LENGTH('a)\<rbrakk> \<Longrightarrow>
   \<not> is_aligned (p + of_nat i) n"
   apply (erule is_aligned_add_not_aligned)
   unfolding is_aligned_def
   apply clarsimp
   apply (subst (asm) unat_of_nat_len)
    apply (metis order_less_trans unat_lt2p unat_power_lower)
   apply (metis nat_dvd_not_less)
   done
 
 lemma length_upto_enum_one:
   fixes x :: "'a :: len word"
   assumes lt1: "x < y" and lt2: "z < y" and lt3: "x \<le> z"
   shows "[x , y .e. z] = [x]"
 unfolding upto_enum_step_def
 proof (subst upto_enum_red, subst if_not_P [OF leD [OF lt3]], clarsimp, rule conjI)
   show "unat ((z - x) div (y - x)) = 0"
   proof (subst unat_div, rule div_less)
     have syx: "unat (y - x) = unat y - unat x"
       by (rule unat_sub [OF order_less_imp_le]) fact
     moreover have "unat (z - x) = unat z - unat x"
       by (rule unat_sub) fact
 
     ultimately show "unat (z - x) < unat (y - x)"
       using lt3
       apply simp
       apply (rule diff_less_mono[OF unat_mono, OF lt2])
       apply (simp add: word_le_nat_alt[symmetric])
       done
   qed
 
   then show "(z - x) div (y - x) * (y - x) = 0"
     by (metis mult_zero_left unat_0 word_unat.Rep_eqD)
 qed
 
 lemma max_word_mask:
   shows "(max_word :: 'a::len word) = mask (LENGTH('a))"
   unfolding mask_def by (metis max_word_eq shiftl_1)
 
 lemma is_aligned_alignUp[simp]:
   "is_aligned (alignUp p n) n"
   by (simp add: alignUp_def complement_def is_aligned_mask mask_def word_bw_assocs)
 
 lemma alignUp_le[simp]:
   "alignUp p n \<le> p + 2 ^ n - 1"
   unfolding alignUp_def by (rule word_and_le2)
 
 lemma complement_mask:
-  "complement (2 ^ n - 1) = ~~ mask n"
+  "complement (2 ^ n - 1) = ~~ (mask n)"
   unfolding complement_def mask_def by simp
 
 lemma alignUp_idem:
   fixes a :: "'a::len word"
   assumes al: "is_aligned a n"
   and   sz: "n < LENGTH('a)"
   shows "alignUp a n = a"
   using sz al unfolding alignUp_def
   apply (simp add: complement_mask)
   apply (subst x_power_minus_1)
   apply (subst neg_mask_is_div)
   apply (simp only: word_arith_nat_div  unat_word_ariths)
   apply (simp only: unat_power_lower)
   apply (subst power_mod_div)
   apply (erule is_alignedE)
   apply simp
   apply (subst unat_mult_power_lem)
    apply simp
   apply (subst unat_sub)
    apply (subst unat_arith_simps)
    apply simp
   apply (simp add: del: unat_1)
   apply simp
   done
 
 lemma alignUp_not_aligned_eq:
   fixes a :: "'a :: len word"
   assumes al: "\<not> is_aligned a n"
   and     sz: "n < LENGTH('a)"
   shows   "alignUp a n = (a div 2 ^ n + 1) * 2 ^ n"
 proof -
   have anz: "a mod 2 ^ n \<noteq> 0"
     by (rule not_aligned_mod_nz) fact+
 
   then have um: "unat (a mod 2 ^ n - 1) div 2 ^ n = 0" using sz
     apply -
     apply (rule div_less)
     apply (simp add: unat_minus_one)
     apply (rule order_less_trans)
      apply (rule diff_Suc_less)
      apply (erule contrapos_np)
      apply (simp add: unat_eq_zero)
     apply (subst unat_power_lower [symmetric, OF sz])
     apply (subst word_less_nat_alt [symmetric])
     apply (rule word_mod_less_divisor)
     apply (simp add: p2_gt_0)
     done
 
   have "a + 2 ^ n - 1 = (a div 2 ^ n) * 2 ^ n + (a mod 2 ^ n) + 2 ^ n - 1"
     by (simp add: word_mod_div_equality)
   also have "\<dots> = (a mod 2 ^ n - 1) + (a div 2 ^ n + 1) * 2 ^ n"
     by (simp add: field_simps)
   finally show "alignUp a n = (a div 2 ^ n + 1) * 2 ^ n" using sz
     unfolding alignUp_def
     apply (subst complement_mask)
     apply (erule ssubst)
     apply (subst neg_mask_is_div)
     apply (simp add: word_arith_nat_div)
     apply (subst unat_word_ariths(1) unat_word_ariths(2))+
     apply (subst uno_simps)
     apply (subst unat_1)
     apply (subst mod_add_right_eq)
     apply simp
     apply (subst power_mod_div)
     apply (subst div_mult_self1)
      apply simp
     apply (subst um)
     apply simp
     apply (subst mod_mod_power)
     apply simp
     apply (subst word_unat_power, subst Abs_fnat_hom_mult)
     apply (subst mult_mod_left)
     apply (subst power_add [symmetric])
     apply simp
     apply (subst Abs_fnat_hom_1)
     apply (subst Abs_fnat_hom_add)
     apply (subst word_unat_power, subst Abs_fnat_hom_mult)
     apply (subst word_unat.Rep_inverse[symmetric], subst Abs_fnat_hom_mult)
     apply simp
     done
 qed
 
 lemma alignUp_ge:
   fixes a :: "'a :: len word"
   assumes sz: "n < LENGTH('a)"
   and nowrap: "alignUp a n \<noteq> 0"
   shows "a \<le> alignUp a n"
 proof (cases "is_aligned a n")
   case True
   then show ?thesis using sz
     by (subst alignUp_idem, simp_all)
 next
   case False
 
   have lt0: "unat a div 2 ^ n < 2 ^ (LENGTH('a) - n)" using sz
     apply -
     apply (subst td_gal_lt [symmetric])
      apply simp
     apply (simp add: power_add [symmetric])
     done
 
   have"2 ^ n * (unat a div 2 ^ n + 1) \<le> 2 ^ LENGTH('a)" using sz
     apply -
     apply (rule nat_le_power_trans)
     apply simp
     apply (rule Suc_leI [OF lt0])
     apply simp
     done
   moreover have "2 ^ n * (unat a div 2 ^ n + 1) \<noteq> 2 ^ LENGTH('a)" using nowrap sz
     apply -
     apply (erule contrapos_nn)
     apply (subst alignUp_not_aligned_eq [OF False sz])
     apply (subst unat_arith_simps)
     apply (subst unat_word_ariths)
     apply (subst unat_word_ariths)
     apply simp
     apply (subst mult_mod_left)
     apply (simp add: unat_div field_simps power_add[symmetric] mod_mod_power min.absorb2)
     done
   ultimately have lt: "2 ^ n * (unat a div 2 ^ n + 1) < 2 ^ LENGTH('a)" by simp
 
   have "a = a div 2 ^ n * 2 ^ n + a mod 2 ^ n" by (rule word_mod_div_equality [symmetric])
   also have "\<dots> < (a div 2 ^ n + 1) * 2 ^ n" using sz lt
     apply (simp add: field_simps)
     apply (rule word_add_less_mono1)
     apply (rule word_mod_less_divisor)
     apply (simp add: word_less_nat_alt)
     apply (subst unat_word_ariths)
     apply (simp add: unat_div)
     done
   also have "\<dots> =  alignUp a n"
     by (rule alignUp_not_aligned_eq [symmetric]) fact+
   finally show ?thesis by (rule order_less_imp_le)
 qed
 
 lemma alignUp_le_greater_al:
   fixes x :: "'a :: len word"
   assumes le: "a \<le> x"
   and     sz: "n < LENGTH('a)"
   and     al: "is_aligned x n"
   shows   "alignUp a n \<le> x"
 proof (cases "is_aligned a n")
   case True
   then show ?thesis using sz le by (simp add: alignUp_idem)
 next
   case False
 
   then have anz: "a mod 2 ^ n \<noteq> 0"
     by (rule not_aligned_mod_nz)
 
   from al obtain k where xk: "x = 2 ^ n * of_nat k" and kv: "k < 2 ^ (LENGTH('a) - n)"
     by (auto elim!: is_alignedE)
 
   then have kn: "unat (of_nat k :: 'a word) * unat ((2::'a word) ^ n) < 2 ^ LENGTH('a)"
     using sz
     apply (subst unat_of_nat_eq)
      apply (erule order_less_le_trans)
      apply simp
     apply (subst mult.commute)
     apply simp
     apply (rule nat_less_power_trans)
      apply simp
     apply simp
     done
 
   have au: "alignUp a n = (a div 2 ^ n + 1) * 2 ^ n"
     by (rule alignUp_not_aligned_eq) fact+
   also have "\<dots> \<le> of_nat k * 2 ^ n"
   proof (rule word_mult_le_mono1 [OF inc_le _ kn])
     show "a div 2 ^ n < of_nat k" using kv xk le sz anz
       by (simp add: alignUp_div_helper)
 
     show "(0:: 'a word) < 2 ^ n" using sz by (simp add: p2_gt_0 sz)
   qed
 
   finally show ?thesis using xk by (simp add: field_simps)
 qed
 
 lemma alignUp_is_aligned_nz:
   fixes a :: "'a :: len word"
   assumes al: "is_aligned x n"
   and     sz: "n < LENGTH('a)"
   and     ax: "a \<le> x"
   and     az: "a \<noteq> 0"
   shows   "alignUp (a::'a :: len word) n \<noteq> 0"
 proof (cases "is_aligned a n")
   case True
   then have "alignUp a n = a" using sz by (simp add: alignUp_idem)
   then show ?thesis using az by simp
 next
   case False
   then have anz: "a mod 2 ^ n \<noteq> 0"
     by (rule not_aligned_mod_nz)
 
   {
     assume asm: "alignUp a n = 0"
 
     have lt0: "unat a div 2 ^ n < 2 ^ (LENGTH('a) - n)" using sz
       apply -
       apply (subst td_gal_lt [symmetric])
       apply simp
       apply (simp add: power_add [symmetric])
       done
 
     have leq: "2 ^ n * (unat a div 2 ^ n + 1) \<le> 2 ^ LENGTH('a)" using sz
       apply -
       apply (rule nat_le_power_trans)
       apply simp
       apply (rule Suc_leI [OF lt0])
       apply simp
       done
 
     from al obtain k where  kv: "k < 2 ^ (LENGTH('a) - n)" and xk: "x = 2 ^ n * of_nat k"
       by (auto elim!: is_alignedE)
 
     then have "a div 2 ^ n < of_nat k" using ax sz anz
       by (rule alignUp_div_helper)
 
     then have r: "unat a div 2 ^ n < k" using sz
       apply (simp add: unat_div word_less_nat_alt)
       apply (subst (asm) unat_of_nat)
       apply (subst (asm) mod_less)
        apply (rule order_less_le_trans [OF kv])
        apply simp+
       done
 
     have "alignUp a n = (a div 2 ^ n + 1) * 2 ^ n"
       by (rule alignUp_not_aligned_eq) fact+
 
     then have "\<dots> = 0" using asm by simp
     then have "2 ^ LENGTH('a) dvd 2 ^ n * (unat a div 2 ^ n + 1)"
       using sz by (simp add: unat_arith_simps ac_simps)
                   (simp add: unat_word_ariths mod_simps mod_eq_0_iff_dvd)
     with leq have "2 ^ n * (unat a div 2 ^ n + 1) = 2 ^ LENGTH('a)"
       by (force elim!: le_SucE)
     then have "unat a div 2 ^ n = 2 ^ LENGTH('a) div 2 ^ n - 1"
       by (metis (no_types, hide_lams) Groups.add_ac(2) add.right_neutral
                 add_diff_cancel_left' div_le_dividend div_mult_self4 gr_implies_not0
                 le_neq_implies_less power_eq_0_iff unat_def zero_neq_numeral)
     then have "unat a div 2 ^ n = 2 ^ (LENGTH('a) - n) - 1"
       using sz by (simp add: power_sub)
     then have "2 ^ (LENGTH('a) - n) - 1 < k" using r
       by simp
     then have False using kv by simp
   } then show ?thesis by clarsimp
 qed
 
 lemma alignUp_ar_helper:
   fixes a :: "'a :: len word"
   assumes al: "is_aligned x n"
   and     sz: "n < LENGTH('a)"
   and    sub: "{x..x + 2 ^ n - 1} \<subseteq> {a..b}"
   and    anz: "a \<noteq> 0"
   shows "a \<le> alignUp a n \<and> alignUp a n + 2 ^ n - 1 \<le> b"
 proof
   from al have xl: "x \<le> x + 2 ^ n - 1" by (simp add: is_aligned_no_overflow)
 
   from xl sub have ax: "a \<le> x"
     by (clarsimp elim!: range_subset_lower [where x = x])
 
   show "a \<le> alignUp a n"
   proof (rule alignUp_ge)
     show "alignUp a n \<noteq> 0" using al sz ax anz
       by (rule alignUp_is_aligned_nz)
   qed fact+
 
   show "alignUp a n + 2 ^ n - 1 \<le> b"
   proof (rule order_trans)
     from xl show tp: "x + 2 ^ n - 1 \<le> b" using sub
       by (clarsimp elim!: range_subset_upper [where x = x])
 
     from ax have "alignUp a n \<le> x"
       by (rule alignUp_le_greater_al) fact+
     then have "alignUp a n + (2 ^ n - 1) \<le> x + (2 ^ n - 1)"
       using xl al is_aligned_no_overflow' olen_add_eqv word_plus_mcs_3 by blast
     then show "alignUp a n + 2 ^ n - 1 \<le> x + 2 ^ n - 1"
       by (simp add: field_simps)
   qed
 qed
 
 lemma alignUp_def2:
-  "alignUp a sz = a + 2 ^ sz - 1 && ~~ mask sz"
+  "alignUp a sz = a + 2 ^ sz - 1 && ~~ (mask sz)"
   unfolding alignUp_def[unfolded complement_def]
   by (simp add:mask_def[symmetric,unfolded shiftl_t2n,simplified])
 
 lemma mask_out_first_mask_some:
-  "\<lbrakk> x && ~~ mask n = y; n \<le> m \<rbrakk> \<Longrightarrow> x && ~~ mask m = y && ~~ mask m"
+  "\<lbrakk> x && ~~ (mask n) = y; n \<le> m \<rbrakk> \<Longrightarrow> x && ~~ (mask m) = y && ~~ (mask m)"
   apply (rule word_eqI, rename_tac n')
   apply (drule_tac x=n' in word_eqD)
   apply (auto simp: word_ops_nth_size word_size)
   done
 
 lemma gap_between_aligned:
   "\<lbrakk>a < (b :: 'a ::len word); is_aligned a n; is_aligned b n; n < LENGTH('a) \<rbrakk>
   \<Longrightarrow> a + (2^n - 1) < b"
   apply (rule ccontr,simp add:not_less)
   apply (drule le_shiftr[where n = n])
   apply (simp add: aligned_shift')
   apply (case_tac "b >> n = a >> n")
    apply (drule arg_cong[where f = "\<lambda>x. x<<n"])
    apply (drule le_shiftr')
     apply (clarsimp simp:is_aligned_shiftr_shiftl)
    apply fastforce
   apply (drule(1) le_shiftr')
   apply simp
   done
 
 lemma mask_out_add_aligned:
   assumes al: "is_aligned p n"
-  shows "p + (q && ~~ mask n) = (p + q) && ~~ mask n"
+  shows "p + (q && ~~ (mask n)) = (p + q) && ~~ (mask n)"
   using mask_add_aligned [OF al]
   by (simp add: mask_out_sub_mask)
 
 lemma alignUp_def3:
-  "alignUp a sz = 2^ sz + (a - 1 && ~~ mask sz)" (is "?lhs = ?rhs")
+  "alignUp a sz = 2^ sz + (a - 1 && ~~ (mask sz))" (is "?lhs = ?rhs")
   apply (simp add:alignUp_def2)
-  apply (subgoal_tac "2 ^ sz + a - 1 && ~~ mask sz = ?rhs")
+  apply (subgoal_tac "2 ^ sz + a - 1 && ~~ (mask sz) = ?rhs")
    apply (clarsimp simp:field_simps)
   apply (subst mask_out_add_aligned)
    apply (rule is_aligned_triv)
   apply (simp add:field_simps)
   done
 
 lemma  alignUp_plus:
   "is_aligned w us \<Longrightarrow> alignUp (w + a) us  = w + alignUp a us"
   apply (clarsimp simp:alignUp_def2 add.assoc)
   apply (simp add: mask_out_add_aligned field_simps)
   done
 
 lemma mask_lower_twice:
-  "n \<le> m \<Longrightarrow> (x && ~~ mask n) && ~~ mask m = x && ~~ mask m"
+  "n \<le> m \<Longrightarrow> (x && ~~ (mask n)) && ~~ (mask m) = x && ~~ (mask m)"
   apply (rule word_eqI)
   apply (simp add: word_size word_ops_nth_size)
   apply safe
   apply simp
   done
 
 lemma mask_lower_twice2:
-  "(a && ~~ mask n) && ~~ mask m = a && ~~ mask (max n m)"
+  "(a && ~~ (mask n)) && ~~ (mask m) = a && ~~ (mask (max n m))"
   by (rule word_eqI, simp add: neg_mask_bang conj_comms)
 
 lemma ucast_and_neg_mask:
-  "ucast (x && ~~ mask n) = ucast x && ~~ mask n"
+  "ucast (x && ~~ (mask n)) = ucast x && ~~ (mask n)"
   apply (rule word_eqI)
   apply (simp add: word_size neg_mask_bang nth_ucast)
   apply (auto simp add: test_bit_bl word_size)
   done
 
 lemma ucast_and_mask:
   "ucast (x && mask n) = ucast x && mask n"
   apply (rule word_eqI)
   apply (simp add: nth_ucast)
   apply (auto simp add: test_bit_bl word_size)
   done
 
 lemma ucast_mask_drop:
   "LENGTH('a :: len) \<le> n \<Longrightarrow> (ucast (x && mask n) :: 'a word) = ucast x"
   apply (rule word_eqI)
   apply (simp add: nth_ucast word_size)
   apply safe
   apply (simp add: test_bit_bl word_size)
   done
 
 lemma alignUp_distance:
   "alignUp (q :: 'a :: len word) sz - q \<le> mask sz"
   apply (case_tac "LENGTH('a) \<le> sz")
    apply (simp add:alignUp_def2 mask_def power_overflow)
   apply (case_tac "is_aligned q sz")
    apply (clarsimp simp:alignUp_def2 p_assoc_help)
    apply (subst mask_out_add_aligned[symmetric],simp)+
    apply (simp add:mask_lower_twice word_and_le2)
    apply (simp add:and_not_mask)
    apply (subst le_mask_iff[THEN iffD1])
     apply (simp add:mask_def)
    apply simp
   apply (clarsimp simp:alignUp_def3)
-  apply (subgoal_tac "2 ^ sz - (q - (q - 1 && ~~ mask sz)) \<le> 2 ^ sz - 1")
+  apply (subgoal_tac "2 ^ sz - (q - (q - 1 && ~~ (mask sz))) \<le> 2 ^ sz - 1")
    apply (simp add:field_simps mask_def)
   apply (rule word_sub_mono)
      apply simp
     apply (rule ccontr)
     apply (clarsimp simp:not_le)
     apply (drule eq_refl)
     apply (drule order_trans[OF _ word_and_le2])
     apply (subgoal_tac "q \<noteq>  0")
      apply (drule minus_one_helper[rotated])
       apply simp
      apply simp
     apply (fastforce)
    apply (simp add: word_sub_le_iff)
-   apply (subgoal_tac "q - 1 && ~~ mask sz = (q - 1) - (q - 1 && mask sz)")
+   apply (subgoal_tac "q - 1 && ~~ (mask sz) = (q - 1) - (q - 1 && mask sz)")
     apply simp
     apply (rule order_trans)
      apply (rule word_add_le_mono2)
       apply (rule word_and_le1)
      apply (subst unat_plus_simple[THEN iffD1,symmetric])
       apply (simp add:not_le mask_def)
       apply (rule word_sub_1_le)
       apply simp
      apply (rule unat_lt2p)
     apply (simp add:mask_def)
    apply (simp add:mask_out_sub_mask)
   apply (rule word_sub_1_le)
   apply simp
   done
 
 lemma is_aligned_diff_neg_mask:
-  "is_aligned p sz \<Longrightarrow> (p - q && ~~ mask sz) = (p - ((alignUp q sz) && ~~ mask sz))"
+  "is_aligned p sz \<Longrightarrow> (p - q && ~~ (mask sz)) = (p - ((alignUp q sz) && ~~ (mask sz)))"
   apply (clarsimp simp only:word_and_le2 diff_conv_add_uminus)
   apply (subst mask_out_add_aligned[symmetric])
    apply simp+
   apply (rule sum_to_zero)
   apply (subst add.commute)
   apply (subst  mask_out_add_aligned)
    apply (simp add:is_aligned_neg_mask)
   apply simp
-  apply (subst and_not_mask[where w = "(alignUp q sz && ~~ mask sz) - q "])
+  apply (subst and_not_mask[where w = "(alignUp q sz && ~~ (mask sz)) - q "])
   apply (subst le_mask_iff[THEN iffD1])
    apply (simp add:is_aligned_neg_mask_eq)
    apply (rule alignUp_distance)
   apply simp
   done
 
 lemma map_bits_rev_to_bl:
   "map ((!!) x) [0..<size x] = rev (to_bl x)"
   by (auto simp: list_eq_iff_nth_eq test_bit_bl word_size)
 
 (* negating a mask which has been shifted to the very left *)
 lemma NOT_mask_shifted_lenword:
   "~~ ((mask len << (len_of(TYPE('a)) - len))::'a::len word) = mask (len_of(TYPE('a)) - len)"
   apply(rule Word.word_bool_alg.compl_unique)
    subgoal using mask_shift_and_negate by simp
   apply (rule word_eqI)
   apply (simp add: word_size nth_shiftl nth_shiftr)
   by auto
 
 (* Comparisons between different word sizes. *)
 
 lemma eq_ucast_ucast_eq:
   fixes x :: "'a::len word"
     and y :: "'b::len word"
   assumes "LENGTH('b) \<le> LENGTH('a)"
   shows   "x = ucast y \<Longrightarrow> ucast x = y"
   using assms
   by (simp add: is_down ucast_id ucast_ucast_a)
 
 lemma le_ucast_ucast_le:
   fixes x :: "'a::len word"
     and y :: "'b::len word"
   assumes "LENGTH('b) \<le> LENGTH('a)"
   shows   "x \<le> ucast y \<Longrightarrow> ucast x \<le> y"
   using assms
   apply (simp add: word_le_nat_alt unat_ucast_up_simp[where x=y])
   apply (simp add: unat_ucast)
   by (rule le_trans; fastforce)
 
 lemma less_ucast_ucast_less:
   fixes x :: "'a::len word"
     and y :: "'b::len word"
   assumes "LENGTH('b) \<le> LENGTH('a)"
   shows   "x < ucast y \<Longrightarrow> ucast x < y"
   using assms
   apply (simp add: word_less_nat_alt unat_ucast_up_simp[where x=y])
   apply (simp add: unat_ucast)
   by (rule le_less_trans; fastforce)
 
 lemma ucast_le_ucast:
   fixes x :: "'a::len word"
     and y :: "'a::len word"
   assumes "LENGTH('a) \<le> LENGTH('b)"
   shows "(ucast x \<le> (ucast y::'b::len word)) = (x \<le> y)"
   using assms
   apply (simp add: word_le_nat_alt unat_ucast)
   apply (subst mod_less)
    apply(rule less_le_trans[OF unat_lt2p], simp)
   apply (subst mod_less)
    apply(rule less_le_trans[OF unat_lt2p], simp)
   apply simp
   done
 
 lemma ucast_le_ucast_eq:
   fixes x y :: "'a::len word"
   assumes x: "x < 2 ^ n"
   assumes y: "y < 2 ^ n"
   assumes n: "n = LENGTH('b::len)"
   shows "(UCAST('a \<rightarrow> 'b) x \<le> UCAST('a \<rightarrow> 'b) y) = (x \<le> y)"
   apply (rule iffI)
    apply (cases "LENGTH('b) < LENGTH('a)")
     apply (subst less_mask_eq[OF x, symmetric])
     apply (subst less_mask_eq[OF y, symmetric])
     apply (unfold n)
     apply (subst ucast_ucast_mask[symmetric])+
     apply (simp add: ucast_le_ucast)+
   apply (erule ucast_mono_le[OF _ y[unfolded n]])
   done
 
 (* High bits w.r.t. mask operations. *)
 
 lemma and_neg_mask_eq_iff_not_mask_le:
-  "w && ~~ mask n = ~~ mask n \<longleftrightarrow> ~~ mask n \<le> w"
+  "w && ~~ (mask n) = ~~ (mask n) \<longleftrightarrow> ~~ (mask n) \<le> w"
   by (metis (full_types) dual_order.antisym neg_mask_mono_le word_and_le1 word_and_le2
                          word_bool_alg.conj_absorb)
 
 lemma le_mask_high_bits:
   shows "w \<le> mask n \<longleftrightarrow> (\<forall> i \<in> {n ..< size w}. \<not> w !! i)"
   by (auto simp: word_size and_mask_eq_iff_le_mask[symmetric] word_eq_iff)
 
 lemma neg_mask_le_high_bits:
-  shows "~~ mask n \<le> w \<longleftrightarrow> (\<forall> i \<in> {n ..< size w}. w !! i)"
+  shows "~~ (mask n) \<le> w \<longleftrightarrow> (\<forall> i \<in> {n ..< size w}. w !! i)"
   by (auto simp: word_size and_neg_mask_eq_iff_not_mask_le[symmetric]
                  word_eq_iff neg_mask_bang)
 
 lemma word_le_not_less:
   "((b::'a::len word) \<le> a) = (\<not>(a < b))"
   by fastforce
 
 lemma ucast_or_distrib:
   fixes x :: "'a::len word"
   fixes y :: "'a::len word"
   shows "(ucast (x || y) :: ('b::len) word) = ucast x || ucast y"
   unfolding ucast_def Word.bitOR_word.abs_eq uint_or
   by blast
 
 lemma shiftr_less:
   "(w::'a::len word) < k \<Longrightarrow> w >> n < k"
   apply (simp add: word_less_nat_alt shiftr_div_2n')
   apply (blast intro: div_le_dividend le_less_trans)
   done
 
 lemma word_and_notzeroD:
   "w && w' \<noteq> 0 \<Longrightarrow> w \<noteq> 0 \<and> w' \<noteq> 0"
   by auto
 
 lemma word_clz_max:
   "word_clz w \<le> size (w::'a::len word)"
   unfolding word_clz_def
   apply (simp add: word_size)
   apply (rule_tac y="length (to_bl w)" in order_trans)
    apply (rule List.length_takeWhile_le)
   apply simp
   done
 
 lemma word_clz_nonzero_max:
   fixes w :: "'a::len word"
   assumes nz: "w \<noteq> 0"
   shows "word_clz w < size (w::'a::len word)"
 proof -
   {
     assume a: "word_clz w = size (w::'a::len word)"
     hence "length (takeWhile Not (to_bl w)) = length (to_bl w)"
       by (simp add: word_clz_def word_size)
     hence allj: "\<forall>j\<in>set(to_bl w). \<not> j"
       using takeWhile_take_has_property[where n="length (to_bl w)" and xs="to_bl w" and P=Not]
       by simp
     hence "to_bl w = replicate (length (to_bl w)) False"
       by (fastforce intro!: list_of_false)
     hence "w = 0"
      apply simp
      apply (subst (asm) to_bl_0[symmetric])
      apply (drule Word.word_bl.Rep_eqD, assumption)
      done
     with nz have False by simp
   }
   thus ?thesis using word_clz_max
     by (fastforce intro: le_neq_trans)
 qed
 
 lemma unat_add_lem':
   "(unat x + unat y < 2 ^ LENGTH('a)) \<Longrightarrow>
     (unat (x + y :: 'a :: len word) = unat x + unat y)"
   by (subst unat_add_lem[symmetric], assumption)
 
 lemma from_bool_eq_if':
   "((if P then 1 else 0) = from_bool Q) = (P = Q)"
   by (simp add: case_bool_If from_bool_def split: if_split)
 
 lemma word_exists_nth:
   "(w::'a::len word) \<noteq> 0 \<Longrightarrow> \<exists>i. w !! i"
   using word_log2_nth_same by blast
 
 lemma shiftr_le_0:
   "unat (w::'a::len word) < 2 ^ n \<Longrightarrow> w >> n = (0::'a::len word)"
   by (rule word_unat.Rep_eqD) (simp add: shiftr_div_2n')
 
 lemma of_nat_shiftl:
   "(of_nat x << n) = (of_nat (x * 2 ^ n) :: ('a::len) word)"
 proof -
   have "(of_nat x::'a word) << n = of_nat (2 ^ n) * of_nat x"
     using shiftl_t2n by (metis word_unat_power)
   thus ?thesis by simp
 qed
 
 lemma shiftl_1_not_0:
   "n < LENGTH('a) \<Longrightarrow> (1::'a::len word) << n \<noteq> 0"
   by (simp add: shiftl_t2n)
 
 lemma max_word_not_0[simp]:
   "max_word \<noteq> 0"
   by (simp add: max_word_minus)
 
 lemma ucast_zero_is_aligned:
   "UCAST('a::len \<rightarrow> 'b::len) w = 0 \<Longrightarrow> n \<le> LENGTH('b) \<Longrightarrow> is_aligned w n"
   by (clarsimp simp: is_aligned_mask word_eq_iff word_size nth_ucast)
 
 lemma unat_ucast_eq_unat_and_mask:
   "unat (UCAST('b::len \<rightarrow> 'a::len) w) = unat (w && mask LENGTH('a))"
   proof -
     have "unat (UCAST('b \<rightarrow> 'a) w) = unat (UCAST('a \<rightarrow> 'b) (UCAST('b \<rightarrow> 'a) w))"
       by (cases "LENGTH('a) < LENGTH('b)"; simp add: is_down ucast_ucast_a unat_ucast_up_simp)
     thus ?thesis using ucast_ucast_mask by simp
   qed
 
 lemma unat_max_word_pos[simp]: "0 < unat max_word"
   by (auto simp: unat_gt_0)
 
 
 (* Miscellaneous conditional injectivity rules. *)
 
 lemma mult_pow2_inj:
   assumes ws: "m + n \<le> LENGTH('a)"
   assumes le: "x \<le> mask m" "y \<le> mask m"
   assumes eq: "x * 2^n = y * (2^n::'a::len word)"
   shows "x = y"
 proof (cases n)
   case 0 thus ?thesis using eq by simp
 next
   case (Suc n')
   have m_lt: "m < LENGTH('a)" using Suc ws by simp
   have xylt: "x < 2^m" "y < 2^m" using le m_lt unfolding mask_2pm1 by auto
   have lenm: "n \<le> LENGTH('a) - m" using ws by simp
   show ?thesis
     using eq xylt
     apply (fold shiftl_t2n[where n=n, simplified mult.commute])
     apply (simp only: word_bl.Rep_inject[symmetric] bl_shiftl)
     apply (erule ssubst[OF less_is_drop_replicate])+
     apply (clarsimp elim!: drop_eq_mono[OF lenm])
     done
 qed
 
 lemma word_of_nat_inj:
   assumes bounded: "x < 2 ^ LENGTH('a)" "y < 2 ^ LENGTH('a)"
   assumes of_nats: "of_nat x = (of_nat y :: 'a::len word)"
   shows "x = y"
   by (rule contrapos_pp[OF of_nats]; cases "x < y"; cases "y < x")
      (auto dest: bounded[THEN of_nat_mono_maybe])
 
 (* Sign extension from bit n. *)
 
 lemma sign_extend_bitwise_if:
   "i < size w \<Longrightarrow> sign_extend e w !! i \<longleftrightarrow> (if i < e then w !! i else w !! e)"
   by (simp add: sign_extend_def neg_mask_bang word_size)
 
 lemma sign_extend_bitwise_disj:
   "i < size w \<Longrightarrow> sign_extend e w !! i \<longleftrightarrow> i \<le> e \<and> w !! i \<or> e \<le> i \<and> w !! e"
   by (auto simp: sign_extend_bitwise_if)
 
 lemma sign_extend_bitwise_cases:
   "i < size w \<Longrightarrow> sign_extend e w !! i \<longleftrightarrow> (i \<le> e \<longrightarrow> w !! i) \<and> (e \<le> i \<longrightarrow> w !! e)"
   by (auto simp: sign_extend_bitwise_if)
 
 lemmas sign_extend_bitwise_if' = sign_extend_bitwise_if[simplified word_size]
 lemmas sign_extend_bitwise_disj' = sign_extend_bitwise_disj[simplified word_size]
 lemmas sign_extend_bitwise_cases' = sign_extend_bitwise_cases[simplified word_size]
 
 (* Often, it is easier to reason about an operation which does not overwrite
    the bit which determines which mask operation to apply. *)
 lemma sign_extend_def':
-  "sign_extend n w = (if w !! n then w || ~~ mask (Suc n) else w && mask (Suc n))"
+  "sign_extend n w = (if w !! n then w || ~~ (mask (Suc n)) else w && mask (Suc n))"
   by (rule word_eqI[rule_format])
      (auto simp: sign_extend_bitwise_if' word_size word_ops_nth_size dest: less_antisym)
 
 lemma sign_extended_sign_extend:
   "sign_extended n (sign_extend n w)"
   by (clarsimp simp: sign_extended_def word_size sign_extend_bitwise_if')
 
 lemma sign_extended_iff_sign_extend:
   "sign_extended n w \<longleftrightarrow> sign_extend n w = w"
   apply (rule iffI)
    apply (rule word_eqI[rule_format], rename_tac i)
    apply (case_tac "n < i"; simp add: sign_extended_def word_size sign_extend_bitwise_if')
   apply (erule subst, rule sign_extended_sign_extend)
   done
 
 lemma sign_extended_weaken:
   "sign_extended n w \<Longrightarrow> n \<le> m \<Longrightarrow> sign_extended m w"
   unfolding sign_extended_def by (cases "n < m") auto
 
 lemma sign_extend_sign_extend_eq:
   "sign_extend m (sign_extend n w) = sign_extend (min m n) w"
   by (cases "m < n") (auto intro!: word_eqI simp: word_size sign_extend_bitwise_cases')
 
 lemma sign_extended_high_bits:
   "\<lbrakk> sign_extended e p; j < size p; e \<le> i; i < j \<rbrakk> \<Longrightarrow> p !! i = p !! j"
   by (drule (1) sign_extended_weaken; simp add: sign_extended_def)
 
 lemma sign_extend_eq:
   "w && mask (Suc n) = v && mask (Suc n) \<Longrightarrow> sign_extend n w = sign_extend n v"
   by (rule word_eqI, fastforce dest: word_eqD simp: sign_extend_bitwise_if' word_size)
 
 
 lemma sign_extended_add:
   assumes p: "is_aligned p n"
   assumes f: "f < 2 ^ n"
   assumes e: "n \<le> e"
   assumes "sign_extended e p"
   shows "sign_extended e (p + f)"
 proof (cases "e < size p")
   case True
   note and_or = is_aligned_add_or[OF p f]
   have "\<not> f !! e"
     using True e less_2p_is_upper_bits_unset[THEN iffD1, OF f]
     by (fastforce simp: word_size)
   hence i: "(p + f) !! e = p !! e"
     by (simp add: and_or)
   have fm: "f && mask e = f"
     by (fastforce intro: subst[where P="\<lambda>f. f && mask e = f", OF less_mask_eq[OF f]]
                   simp: mask_twice e)
   show ?thesis
     using assms
      apply (simp add: sign_extended_iff_sign_extend sign_extend_def i)
      apply (simp add: and_or word_bw_comms[of p f])
      apply (clarsimp simp: word_ao_dist fm word_bw_assocs split: if_splits)
     done
 next
   case False thus ?thesis
     by (simp add: sign_extended_def word_size)
 qed
 
 lemma sign_extended_neq_mask:
-  "\<lbrakk>sign_extended n ptr; m \<le> n\<rbrakk> \<Longrightarrow> sign_extended n (ptr && ~~ mask m)"
+  "\<lbrakk>sign_extended n ptr; m \<le> n\<rbrakk> \<Longrightarrow> sign_extended n (ptr && ~~ (mask m))"
   by (fastforce simp: sign_extended_def word_size neg_mask_bang)
 
 (* Uints *)
 
 lemma uints_mono_iff: "uints l \<subseteq> uints m \<longleftrightarrow> l \<le> m"
   using power_increasing_iff[of "2::int" l m]
   apply (auto simp: uints_num subset_iff simp del: power_increasing_iff)
   by (meson less_irrefl not_less zle2p)
 
 lemmas uints_monoI = uints_mono_iff[THEN iffD2]
 
 lemma Bit_in_uints_Suc: "w BIT c \<in> uints (Suc m)" if "w \<in> uints m"
   using that
   by (auto simp: uints_num Bit_def)
 
 lemma Bit_in_uintsI: "w BIT c \<in> uints m" if "w \<in> uints (m - 1)" "m > 0"
   using Bit_in_uints_Suc[OF that(1)] that(2)
   by auto
 
 lemma bin_cat_in_uintsI: "bin_cat a n b \<in> uints m" if "a \<in> uints l" "m \<ge> l + n"
   using that
 proof (induction n arbitrary: b m)
   case 0
   then have "uints l \<subseteq> uints m"
     by (intro uints_monoI) auto
   then show ?case using 0 by auto
 next
   case (Suc n)
   then show ?case
     by (auto intro!: Bit_in_uintsI)
 qed
 
 lemma bin_cat_cong: "bin_cat a n b = bin_cat c m d"
   if "n = m" "a = c" "bintrunc m b = bintrunc m d"
   using that(3) unfolding that(1,2)
 proof (induction m arbitrary: b d)
   case (Suc m)
   show ?case
     using Suc.prems by (auto intro: Suc.IH)
 qed simp
 
 lemma bin_cat_eqD1: "bin_cat a n b = bin_cat c n d \<Longrightarrow> a = c"
   by (induction n arbitrary: b d) auto
 
 lemma bin_cat_eqD2: "bin_cat a n b = bin_cat c n d \<Longrightarrow> bintrunc n b = bintrunc n d"
   by (induction n arbitrary: b d) auto
 
 lemma bin_cat_inj: "(bin_cat a n b) = bin_cat c n d \<longleftrightarrow> a = c \<and> bintrunc n b = bintrunc n d"
   by (auto intro: bin_cat_cong bin_cat_eqD1 bin_cat_eqD2)
 
 lemma word_of_int_bin_cat_eq_iff:
   "(word_of_int (bin_cat (uint a) LENGTH('b) (uint b))::'c::len0 word) =
   word_of_int (bin_cat (uint c) LENGTH('b) (uint d)) \<longleftrightarrow> b = d \<and> a = c"
   if "LENGTH('a) + LENGTH('b) \<le> LENGTH('c)"
   for a::"'a::len0 word" and b::"'b::len0 word"
   by (subst word_uint.Abs_inject)
      (auto simp: bin_cat_inj intro!: that bin_cat_in_uintsI)
 
 lemma word_cat_inj: "(word_cat a b::'c::len0 word) = word_cat c d \<longleftrightarrow> a = c \<and> b = d"
   if "LENGTH('a) + LENGTH('b) \<le> LENGTH('c)"
   for a::"'a::len0 word" and b::"'b::len0 word"
   by (auto simp: word_cat_def word_uint.Abs_inject word_of_int_bin_cat_eq_iff that)
 
 lemma p2_eq_1: "2 ^ n = (1::'a::len word) \<longleftrightarrow> n = 0"
 proof -
   have "2 ^ n = (1::'a word) \<Longrightarrow> n = 0"
     by (metis One_nat_def not_less one_less_numeral_iff p2_eq_0 p2_gt_0 power_0 power_0
         power_inject_exp semiring_norm(76) unat_power_lower zero_neq_one)
   then show ?thesis by auto
 qed
 
 (* usually: x,y = (len_of TYPE ('a)) *)
 lemma bitmagic_zeroLast_leq_or1Last:
   "(a::('a::len) word) AND (mask len << x - len) \<le> a OR mask (y - len)"
   by (meson le_word_or2 order_trans word_and_le2)
 
 
 lemma zero_base_lsb_imp_set_eq_as_bit_operation:
   fixes base ::"'a::len word"
   assumes valid_prefix: "mask (LENGTH('a) - len) AND base = 0"
-  shows "(base = NOT mask (LENGTH('a) - len) AND a) \<longleftrightarrow>
+  shows "(base = NOT (mask (LENGTH('a) - len)) AND a) \<longleftrightarrow>
          (a \<in> {base .. base OR mask (LENGTH('a) - len)})"
 proof
   have helper3: "x OR y = x OR y AND NOT x" for x y ::"'a::len word" by (simp add: word_oa_dist2)
-  from assms show "base = NOT mask (LENGTH('a) - len) AND a \<Longrightarrow>
+  from assms show "base = NOT (mask (LENGTH('a) - len)) AND a \<Longrightarrow>
                     a \<in> {base..base OR mask (LENGTH('a) - len)}"
     apply(simp add: word_and_le1)
     apply(metis helper3 le_word_or2 word_bw_comms(1) word_bw_comms(2))
   done
 next
   assume "a \<in> {base..base OR mask (LENGTH('a) - len)}"
   hence a: "base \<le> a \<and> a \<le> base OR mask (LENGTH('a) - len)" by simp
-  show "base = NOT mask (LENGTH('a) - len) AND a"
+  show "base = NOT (mask (LENGTH('a) - len)) AND a"
   proof -
-    have f2: "\<forall>x\<^sub>0. base AND NOT mask x\<^sub>0 \<le> a AND NOT mask x\<^sub>0"
+    have f2: "\<forall>x\<^sub>0. base AND NOT (mask x\<^sub>0) \<le> a AND NOT (mask x\<^sub>0)"
       using a neg_mask_mono_le by blast
-    have f3: "\<forall>x\<^sub>0. a AND NOT mask x\<^sub>0 \<le> (base OR mask (LENGTH('a) - len)) AND NOT mask x\<^sub>0"
+    have f3: "\<forall>x\<^sub>0. a AND NOT (mask x\<^sub>0) \<le> (base OR mask (LENGTH('a) - len)) AND NOT (mask x\<^sub>0)"
       using a neg_mask_mono_le by blast
-    have f4: "base = base AND NOT mask (LENGTH('a) - len)"
+    have f4: "base = base AND NOT (mask (LENGTH('a) - len))"
       using valid_prefix by (metis mask_eq_0_eq_x word_bw_comms(1))
-    hence f5: "\<forall>x\<^sub>6. (base OR x\<^sub>6) AND NOT mask (LENGTH('a) - len) =
-                      base OR x\<^sub>6 AND NOT mask (LENGTH('a) - len)"
+    hence f5: "\<forall>x\<^sub>6. (base OR x\<^sub>6) AND NOT (mask (LENGTH('a) - len)) =
+                      base OR x\<^sub>6 AND NOT (mask (LENGTH('a) - len))"
       using word_ao_dist by (metis)
-    have f6: "\<forall>x\<^sub>2 x\<^sub>3. a AND NOT mask x\<^sub>2 \<le> x\<^sub>3 \<or>
-                      \<not> (base OR mask (LENGTH('a) - len)) AND NOT mask x\<^sub>2 \<le> x\<^sub>3"
+    have f6: "\<forall>x\<^sub>2 x\<^sub>3. a AND NOT (mask x\<^sub>2) \<le> x\<^sub>3 \<or>
+                      \<not> (base OR mask (LENGTH('a) - len)) AND NOT (mask x\<^sub>2) \<le> x\<^sub>3"
       using f3 dual_order.trans by auto
-    have "base = (base OR mask (LENGTH('a) - len)) AND NOT mask (LENGTH('a) - len)"
+    have "base = (base OR mask (LENGTH('a) - len)) AND NOT (mask (LENGTH('a) - len))"
       using f5 by auto
-    hence "base = a AND NOT mask (LENGTH('a) - len)"
+    hence "base = a AND NOT (mask (LENGTH('a) - len))"
       using f2 f4 f6 by (metis eq_iff)
-    thus "base = NOT mask (LENGTH('a) - len) AND a"
+    thus "base = NOT (mask (LENGTH('a) - len)) AND a"
       by (metis word_bw_comms(1))
   qed
 qed
 
 lemma unat_minus_one_word:
   "unat (-1 :: 'a :: len word) = 2 ^ LENGTH('a) - 1"
   by (subst minus_one_word)
      (subst unat_sub_if', clarsimp)
 
 lemma of_nat_eq_signed_scast:
   "(of_nat x = (y :: ('a::len) signed word))
    = (of_nat x = (scast y :: 'a word))"
   by (metis scast_of_nat scast_scast_id(2))
 
 lemma word_ctz_le:
   "word_ctz (w :: ('a::len word)) \<le> LENGTH('a)"
   apply (clarsimp simp: word_ctz_def)
   apply (rule nat_le_Suc_less_imp[where y="LENGTH('a) + 1" , simplified])
   apply (rule order_le_less_trans[OF List.length_takeWhile_le])
   apply simp
   done
 
 lemma word_ctz_less:
   "w \<noteq> 0 \<Longrightarrow> word_ctz (w :: ('a::len word)) < LENGTH('a)"
   apply (clarsimp simp: word_ctz_def eq_zero_set_bl)
   apply (rule order_less_le_trans[OF length_takeWhile_less])
    apply fastforce+
   done
 
 lemma word_ctz_not_minus_1:
   "1 < LENGTH('a) \<Longrightarrow> of_nat (word_ctz (w :: ('a :: len) word)) \<noteq> (- 1 :: ('a::len) word)"
   apply (cut_tac w=w in word_ctz_le)
   apply (subst word_unat.Rep_inject[symmetric])
   apply (subst unat_of_nat_eq)
    apply (erule order_le_less_trans, fastforce)
   apply (subst unat_minus_one_word)
   apply (rule less_imp_neq)
   apply (erule order_le_less_trans)
   apply (subst less_eq_Suc_le)
   apply (subst le_diff_conv2, fastforce)
   apply (clarsimp simp: le_diff_conv2 less_eq_Suc_le[symmetric] suc_le_pow_2)
   done
 
 lemmas word_ctz_not_minus_1_32 = word_ctz_not_minus_1[where 'a=32, simplified]
 
 end
diff --git a/thys/Word_Lib/Word_Lib.thy b/thys/Word_Lib/Word_Lib.thy
--- a/thys/Word_Lib/Word_Lib.thy
+++ b/thys/Word_Lib/Word_Lib.thy
@@ -1,709 +1,709 @@
 (*
  * Copyright 2014, NICTA
  *
  * This software may be distributed and modified according to the terms of
  * the BSD 2-Clause license. Note that NO WARRANTY is provided.
  * See "LICENSE_BSD2.txt" for details.
  *
  * @TAG(NICTA_BSD)
  *)
 
 section "Additional Word Operations"
 
 theory Word_Lib
 imports
   Word_Syntax
 begin
 
 definition
   ptr_add :: "'a :: len word \<Rightarrow> nat \<Rightarrow> 'a word" where
   "ptr_add ptr n \<equiv> ptr + of_nat n"
 
 definition
   complement :: "'a :: len word \<Rightarrow> 'a word"  where
  "complement x \<equiv> ~~ x"
 
 definition
   alignUp :: "'a::len word \<Rightarrow> nat \<Rightarrow> 'a word" where
  "alignUp x n \<equiv> x + 2 ^ n - 1 && complement (2 ^ n - 1)"
 
 (* Haskellish names/syntax *)
 notation (input)
   test_bit ("testBit")
 
 definition
   w2byte :: "'a :: len word \<Rightarrow> 8 word" where
   "w2byte \<equiv> ucast"
 
 
 (*
  * Signed division: when the result of a division is negative,
  * we will round towards zero instead of towards minus infinity.
  *)
 class signed_div =
   fixes sdiv :: "'a \<Rightarrow> 'a \<Rightarrow> 'a" (infixl "sdiv" 70)
   fixes smod :: "'a \<Rightarrow> 'a \<Rightarrow> 'a" (infixl "smod" 70)
 
 instantiation int :: signed_div
 begin
 definition "(a :: int) sdiv b \<equiv> sgn (a * b) * (abs a div abs b)"
 definition "(a :: int) smod b \<equiv> a - (a sdiv b) * b"
 instance ..
 end
 
 instantiation word :: (len) signed_div
 begin
 definition "(a :: ('a::len) word) sdiv b = word_of_int (sint a sdiv sint b)"
 definition "(a :: ('a::len) word) smod b = word_of_int (sint a smod sint b)"
 instance ..
 end
 
 (* Tests *)
 lemma
   "( 4 :: word32) sdiv  4 =  1"
   "(-4 :: word32) sdiv  4 = -1"
   "(-3 :: word32) sdiv  4 =  0"
   "( 3 :: word32) sdiv -4 =  0"
   "(-3 :: word32) sdiv -4 =  0"
   "(-5 :: word32) sdiv -4 =  1"
   "( 5 :: word32) sdiv -4 = -1"
   by (simp_all add: sdiv_word_def sdiv_int_def)
 
 lemma
   "( 4 :: word32) smod  4 =   0"
   "( 3 :: word32) smod  4 =   3"
   "(-3 :: word32) smod  4 =  -3"
   "( 3 :: word32) smod -4 =   3"
   "(-3 :: word32) smod -4 =  -3"
   "(-5 :: word32) smod -4 =  -1"
   "( 5 :: word32) smod -4 =   1"
   by (simp_all add: smod_word_def smod_int_def sdiv_int_def)
 
 
 (* Count leading zeros  *)
 definition
   word_clz :: "'a::len word \<Rightarrow> nat"
 where
   "word_clz w \<equiv> length (takeWhile Not (to_bl w))"
 
 (* Count trailing zeros  *)
 definition
   word_ctz :: "'a::len word \<Rightarrow> nat"
 where
   "word_ctz w \<equiv> length (takeWhile Not (rev (to_bl w)))"
 
 definition
   word_log2 :: "'a::len word \<Rightarrow> nat"
 where
   "word_log2 (w::'a::len word) \<equiv> size w - 1 - word_clz w"
 
 
 (* Bit population count. Equivalent of __builtin_popcount. *)
 definition
   pop_count :: "('a::len) word \<Rightarrow> nat"
 where
   "pop_count w \<equiv> length (filter id (to_bl w))"
 
 
 (* Sign extension from bit n *)
 
 definition
   sign_extend :: "nat \<Rightarrow> 'a::len word \<Rightarrow> 'a word"
 where
-  "sign_extend n w \<equiv> if w !! n then w || ~~mask n else w && mask n"
+  "sign_extend n w \<equiv> if w !! n then w || ~~ (mask n) else w && mask n"
 
 definition
   sign_extended :: "nat \<Rightarrow> 'a::len word \<Rightarrow> bool"
 where
   "sign_extended n w \<equiv> \<forall>i. n < i \<longrightarrow> i < size w \<longrightarrow> w !! i = w !! n"
 
 
 lemma ptr_add_0 [simp]:
   "ptr_add ref 0 = ref "
   unfolding ptr_add_def by simp
 
 lemma shiftl_power:
   "(shiftl1 ^^ x) (y::'a::len word) = 2 ^ x * y"
   apply (induct x)
    apply simp
   apply (simp add: shiftl1_2t)
   done
 
 lemmas of_bl_reasoning = to_bl_use_of_bl of_bl_append
 
 lemma uint_of_bl_is_bl_to_bin_drop:
   "length (dropWhile Not l) \<le> LENGTH('a) \<Longrightarrow> uint (of_bl l :: 'a::len word) = bl_to_bin l"
   apply (simp add: of_bl_def)
   apply (rule word_uint.Abs_inverse)
   apply (simp add: uints_num bl_to_bin_ge0)
   apply (rule order_less_le_trans)
   apply (rule bl_to_bin_lt2p_drop)
   apply (simp)
   done
 
 corollary uint_of_bl_is_bl_to_bin:
   "length l\<le>LENGTH('a) \<Longrightarrow> uint ((of_bl::bool list\<Rightarrow> ('a :: len) word) l) = bl_to_bin l"
   apply(rule uint_of_bl_is_bl_to_bin_drop)
   using le_trans length_dropWhile_le by blast
 
 
 lemma bin_to_bl_or:
   "bin_to_bl n (a OR b) = map2 (\<or>) (bin_to_bl n a) (bin_to_bl n b)"
   using bl_or_aux_bin[where n=n and v=a and w=b and bs="[]" and cs="[]"]
   by simp
 
 lemma word_ops_nth [simp]:
   shows
   word_or_nth:  "(x || y) !! n = (x !! n \<or> y !! n)" and
   word_and_nth: "(x && y) !! n = (x !! n \<and> y !! n)" and
   word_xor_nth: "(x xor y) !! n = (x !! n \<noteq> y !! n)"
   by ((cases "n < size x",
       auto dest: test_bit_size simp: word_ops_nth_size word_size)[1])+
 
 (* simp del to avoid warning on the simp add in iff *)
 declare test_bit_1 [simp del, iff]
 
 (* test: *)
 lemma "1 < (1024::32 word) \<and> 1 \<le> (1024::32 word)" by simp
 
 lemma and_not_mask:
-  "w AND NOT mask n = (w >> n) << n"
+  "w AND NOT (mask n) = (w >> n) << n"
   apply (rule word_eqI)
   apply (simp add : word_ops_nth_size word_size)
   apply (simp add : nth_shiftr nth_shiftl)
   by auto
 
 lemma and_mask:
   "w AND mask n = (w << (size w - n)) >> (size w - n)"
   apply (rule word_eqI)
   apply (simp add : word_ops_nth_size word_size)
   apply (simp add : nth_shiftr nth_shiftl)
   by auto
 
 lemma AND_twice [simp]:
   "(w && m) && m = w && m"
   by (simp add: word_eqI)
 
 lemma word_combine_masks:
   "w && m = z \<Longrightarrow> w && m' = z' \<Longrightarrow> w && (m || m') = (z || z')"
   by (auto simp: word_eq_iff)
 
 lemma nth_w2p_same:
   "(2^n :: 'a :: len word) !! n = (n < LENGTH('a))"
   by (simp add : nth_w2p)
 
 lemma p2_gt_0:
   "(0 < (2 ^ n :: 'a :: len word)) = (n < LENGTH('a))"
   apply (simp add : word_gt_0)
   apply safe
    apply (erule swap)
    apply (rule word_eqI)
    apply (simp add : nth_w2p)
   apply (drule word_eqD)
   apply simp
   apply (erule notE)
   apply (erule nth_w2p_same [THEN iffD2])
   done
 
 lemmas uint_2p_alt = uint_2p [unfolded p2_gt_0]
 
 lemma shiftr_div_2n_w: "n < size w \<Longrightarrow> w >> n = w div (2^n :: 'a :: len word)"
   apply (unfold word_div_def)
   apply (simp add : uint_2p_alt word_size)
   apply (rule word_uint.Rep_inverse' [THEN sym])
   apply (rule shiftr_div_2n)
   done
 
 lemmas less_def = less_eq [symmetric]
 lemmas le_def = not_less [symmetric, where ?'a = nat]
 
 lemmas p2_eq_0 [simp] = trans [OF eq_commute
   iffD2 [OF Not_eq_iff p2_gt_0, folded le_def, unfolded word_gt_0 not_not]]
 
 lemma neg_mask_is_div':
-  "n < size w \<Longrightarrow> w AND NOT mask n = ((w div (2 ^ n)) * (2 ^ n))"
+  "n < size w \<Longrightarrow> w AND NOT (mask n) = ((w div (2 ^ n)) * (2 ^ n))"
   by (simp add : and_not_mask shiftr_div_2n_w shiftl_t2n word_size)
 
 lemma neg_mask_is_div:
-  "w AND NOT mask n = (w div 2^n) * 2^n"
+  "w AND NOT (mask n) = (w div 2^n) * 2^n"
   apply (cases "n < size w")
    apply (erule neg_mask_is_div')
   apply (simp add: word_size)
   apply (frule p2_gt_0 [THEN Not_eq_iff [THEN iffD2], THEN iffD2])
   apply (simp add: word_gt_0  del: p2_eq_0)
   apply (rule word_eqI)
   apply (simp add: word_ops_nth_size word_size)
   done
 
 lemma and_mask_arith':
   "0 < n \<Longrightarrow> w AND mask n = (w * 2^(size w - n)) div 2^(size w - n)"
   by (simp add: and_mask shiftr_div_2n_w shiftl_t2n word_size mult.commute)
 
 lemmas p2len = iffD2 [OF p2_eq_0 order_refl]
 
 lemma and_mask_arith:
   "w AND mask n = (w * 2^(size w - n)) div 2^(size w - n)"
   apply (cases "0 < n")
    apply (erule and_mask_arith')
   apply (simp add: word_size)
   apply (simp add: word_of_int_hom_syms word_div_def)
   done
 
 lemma mask_2pm1: "mask n = 2 ^ n - 1"
   by (simp add : mask_def)
 
 lemma word_and_mask_le_2pm1: "w && mask n \<le> 2 ^ n - 1"
   by (simp add: mask_2pm1[symmetric] word_and_le1)
 
 lemma is_aligned_AND_less_0:
   "u && mask n = 0 \<Longrightarrow> v < 2^n \<Longrightarrow> u && v = 0"
   apply (drule less_mask_eq)
   apply (simp add: mask_2pm1)
   apply (rule word_eqI)
   apply (clarsimp simp add: word_size)
   apply (drule_tac x=na in word_eqD)
   apply (drule_tac x=na in word_eqD)
   apply simp
   done
 
 lemma le_shiftr1:
   "u <= v \<Longrightarrow> shiftr1 u <= shiftr1 v"
   apply (unfold word_le_def shiftr1_def word_ubin.eq_norm)
   apply (unfold bin_rest_trunc_i
                 trans [OF bintrunc_bintrunc_l word_ubin.norm_Rep,
                           unfolded word_ubin.norm_Rep,
                        OF order_refl [THEN le_SucI]])
   apply (case_tac "uint u" rule: bin_exhaust)
   apply (rename_tac bs bit)
   apply (case_tac "uint v" rule: bin_exhaust)
   apply (rename_tac bs' bit')
   apply (case_tac "bit")
    apply (case_tac "bit'", auto simp: less_eq_int_code le_Bits)[1]
   apply (case_tac bit')
    apply (simp add: le_Bits less_eq_int_code)
   apply (auto simp: le_Bits less_eq_int_code)
   done
 
 lemma le_shiftr:
   "u \<le> v \<Longrightarrow> u >> (n :: nat) \<le> (v :: 'a :: len0 word) >> n"
   apply (unfold shiftr_def)
   apply (induct_tac "n")
    apply auto
   apply (erule le_shiftr1)
   done
 
 lemma shiftr_mask_le:
   "n <= m \<Longrightarrow> mask n >> m = 0"
   apply (rule word_eqI)
   apply (simp add: word_size nth_shiftr)
   done
 
 lemmas shiftr_mask = order_refl [THEN shiftr_mask_le, simp]
 
 lemma word_leI:
   "(\<And>n.  \<lbrakk>n < size (u::'a::len0 word); u !! n \<rbrakk> \<Longrightarrow> (v::'a::len0 word) !! n) \<Longrightarrow> u <= v"
   apply (rule xtr4)
    apply (rule word_and_le2)
   apply (rule word_eqI)
   apply (simp add: word_ao_nth)
   apply safe
     apply assumption
    apply (erule_tac [2] asm_rl)
   apply (unfold word_size)
   by auto
 
 lemma le_mask_iff:
   "(w \<le> mask n) = (w >> n = 0)"
   apply safe
    apply (rule word_le_0_iff [THEN iffD1])
    apply (rule xtr3)
     apply (erule_tac [2] le_shiftr)
    apply simp
   apply (rule word_leI)
   apply (rename_tac n')
   apply (drule_tac x = "n' - n" in word_eqD)
   apply (simp add : nth_shiftr word_size)
   apply (case_tac "n <= n'")
   by auto
 
 lemma and_mask_eq_iff_shiftr_0:
   "(w AND mask n = w) = (w >> n = 0)"
   apply (unfold test_bit_eq_iff [THEN sym])
   apply (rule iffI)
    apply (rule ext)
    apply (rule_tac [2] ext)
    apply (auto simp add : word_ao_nth nth_shiftr)
     apply (drule arg_cong)
     apply (drule iffD2)
      apply assumption
     apply (simp add : word_ao_nth)
    prefer 2
    apply (simp add : word_size test_bit_bin)
   apply (drule_tac f = "%u. u !! (x - n)" in arg_cong)
   apply (simp add : nth_shiftr)
   apply (case_tac "n <= x")
    apply auto
   done
 
 lemmas and_mask_eq_iff_le_mask = trans
   [OF and_mask_eq_iff_shiftr_0 le_mask_iff [THEN sym]]
 
 lemma mask_shiftl_decompose:
-  "mask m << n = mask (m + n) && ~~ mask n"
+  "mask m << n = mask (m + n) && ~~ (mask n)"
   by (auto intro!: word_eqI simp: and_not_mask nth_shiftl nth_shiftr word_size)
 
 lemma one_bit_shiftl: "set_bit 0 n True = (1 :: 'a :: len word) << n"
   apply (rule word_eqI)
   apply (auto simp add: test_bit_set_gen nth_shiftl word_size
               simp del: word_set_bit_0 shiftl_1)
   done
 
 lemmas one_bit_pow = trans [OF one_bit_shiftl shiftl_1]
 
 lemmas bin_sc_minus_simps =
   bin_sc_simps (2,3,4) [THEN [2] trans, OF bin_sc_minus [THEN sym]]
 
 lemma NOT_eq:
   "NOT (x :: 'a :: len word) = - x - 1"
   apply (cut_tac x = "x" in word_add_not)
   apply (drule add.commute [THEN trans])
   apply (drule eq_diff_eq [THEN iffD2])
   by simp
 
 lemma NOT_mask: "NOT (mask n) = -(2 ^ n)"
   by (simp add : NOT_eq mask_2pm1)
 
 lemma le_m1_iff_lt: "(x > (0 :: 'a :: len word)) = ((y \<le> x - 1) = (y < x))"
   by uint_arith
 
 lemmas gt0_iff_gem1 = iffD1 [OF iffD1 [OF iff_left_commute le_m1_iff_lt] order_refl]
 
 lemmas power_2_ge_iff = trans [OF gt0_iff_gem1 [THEN sym] p2_gt_0]
 
 lemma le_mask_iff_lt_2n:
   "n < len_of TYPE ('a) = (((w :: 'a :: len word) \<le> mask n) = (w < 2 ^ n))"
   unfolding mask_2pm1 by (rule trans [OF p2_gt_0 [THEN sym] le_m1_iff_lt])
 
 lemmas mask_lt_2pn =
   le_mask_iff_lt_2n [THEN iffD1, THEN iffD1, OF _ order_refl]
 
 lemma bang_eq:
   fixes x :: "'a::len0 word"
   shows "(x = y) = (\<forall>n. x !! n = y !! n)"
   by (subst test_bit_eq_iff[symmetric]) fastforce
 
 lemma word_unat_power:
   "(2 :: 'a :: len word) ^ n = of_nat (2 ^ n)"
   by simp
 
 lemma of_nat_mono_maybe:
   assumes xlt: "x < 2 ^ len_of TYPE ('a)"
   shows   "y < x \<Longrightarrow> of_nat y < (of_nat x :: 'a :: len word)"
   apply (subst word_less_nat_alt)
   apply (subst unat_of_nat)+
   apply (subst mod_less)
    apply (erule order_less_trans [OF _ xlt])
   apply (subst mod_less [OF xlt])
   apply assumption
   done
 
 lemma shiftl_over_and_dist:
   fixes a::"'a::len word"
   shows "(a AND b) << c = (a << c) AND (b << c)"
   apply(rule word_eqI)
   apply(simp add: word_ao_nth nth_shiftl, safe)
   done
 
 lemma shiftr_over_and_dist:
   fixes a::"'a::len word"
   shows "a AND b >> c = (a >> c) AND (b >> c)"
   apply(rule word_eqI)
   apply(simp add:nth_shiftr word_ao_nth)
   done
 
 lemma sshiftr_over_and_dist:
   fixes a::"'a::len word"
   shows "a AND b >>> c = (a >>> c) AND (b >>> c)"
   apply(rule word_eqI)
   apply(simp add:nth_sshiftr word_ao_nth word_size)
   done
 
 lemma shiftl_over_or_dist:
   fixes a::"'a::len word"
   shows "a OR b << c = (a << c) OR (b << c)"
   apply(rule word_eqI)
   apply(simp add:nth_shiftl word_ao_nth, safe)
   done
 
 lemma shiftr_over_or_dist:
   fixes a::"'a::len word"
   shows "a OR b >> c = (a >> c) OR (b >> c)"
   apply(rule word_eqI)
   apply(simp add:nth_shiftr word_ao_nth)
   done
 
 lemma sshiftr_over_or_dist:
   fixes a::"'a::len word"
   shows "a OR b >>> c = (a >>> c) OR (b >>> c)"
   apply(rule word_eqI)
   apply(simp add:nth_sshiftr word_ao_nth word_size)
   done
 
 lemmas shift_over_ao_dists =
   shiftl_over_or_dist shiftr_over_or_dist
   sshiftr_over_or_dist shiftl_over_and_dist
   shiftr_over_and_dist sshiftr_over_and_dist
 
 lemma shiftl_shiftl:
   fixes a::"'a::len word"
   shows "a << b << c = a << (b + c)"
   apply(rule word_eqI)
   apply(auto simp:word_size nth_shiftl add.commute add.left_commute)
   done
 
 lemma shiftr_shiftr:
   fixes a::"'a::len word"
   shows "a >> b >> c = a >> (b + c)"
   apply(rule word_eqI)
   apply(simp add:word_size nth_shiftr add.left_commute add.commute)
   done
 
 lemma shiftl_shiftr1:
   fixes a::"'a::len word"
   shows "c \<le> b \<Longrightarrow> a << b >> c = a AND (mask (size a - b)) << (b - c)"
   apply(rule word_eqI)
   apply(auto simp:nth_shiftr nth_shiftl word_size word_ao_nth)
   done
 
 lemma shiftl_shiftr2:
   fixes a::"'a::len word"
   shows "b < c \<Longrightarrow> a << b >> c = (a >> (c - b)) AND (mask (size a - c))"
   apply(rule word_eqI)
   apply(auto simp:nth_shiftr nth_shiftl word_size word_ao_nth)
   done
 
 lemma shiftr_shiftl1:
   fixes a::"'a::len word"
-  shows "c \<le> b \<Longrightarrow> a >> b << c = (a >> (b - c)) AND (NOT mask c)"
+  shows "c \<le> b \<Longrightarrow> a >> b << c = (a >> (b - c)) AND (NOT (mask c))"
   apply(rule word_eqI)
   apply(auto simp:nth_shiftr nth_shiftl word_size word_ops_nth_size)
   done
 
 lemma shiftr_shiftl2:
   fixes a::"'a::len word"
-  shows "b < c \<Longrightarrow> a >> b << c = (a << (c - b)) AND (NOT mask c)"
+  shows "b < c \<Longrightarrow> a >> b << c = (a << (c - b)) AND (NOT (mask c))"
   apply(rule word_eqI)
   apply(auto simp:nth_shiftr nth_shiftl word_size word_ops_nth_size)
   done
 
 lemmas multi_shift_simps =
   shiftl_shiftl shiftr_shiftr
   shiftl_shiftr1 shiftl_shiftr2
   shiftr_shiftl1 shiftr_shiftl2
 
 lemma word_and_max_word:
   fixes a::"'a::len word"
   shows "x = max_word \<Longrightarrow> a AND x = a"
   by simp
 
 (* Simplifying with word_and_max_word and max_word_def works for arbitrary word sizes,
    but the conditional rewrite can be slow when combined with other common rewrites on
    word expressions. If we are willing to limit our attention to common word sizes,
    the following will usually be much faster. *)
 lemmas word_and_max_simps[simplified max_word_def, simplified] =
   word_and_max[where 'a=8] word_and_max[where 'a=16] word_and_max[where 'a=32] word_and_max[where 'a=64]
 
 lemma word_and_1:
   fixes x::"'a::len word"
   shows "(x AND 1) = (if x!!0 then 1 else 0)"
   apply(rule word_eqI)
   apply(simp add:word_ao_nth)
   apply(rule conjI)
    apply(auto)[1]
   apply clarsimp
   apply (case_tac n)
    apply simp
   apply simp
   done
 
 lemma word_and_1_bl:
   fixes x::"'a::len word"
   shows "(x AND 1) = of_bl [x !! 0]"
   by (simp add: word_and_1)
 
 lemma word_1_and_bl:
   fixes x::"'a::len word"
   shows "(1 AND x) = of_bl [x !! 0]"
   by (subst word_bw_comms) (simp add: word_and_1)
 
 lemma scast_scast_id [simp]:
   "scast (scast x :: ('a::len) signed word) = (x :: 'a word)"
   "scast (scast y :: ('a::len) word) = (y :: 'a signed word)"
   by (auto simp: is_up scast_up_scast_id)
 
 lemma scast_ucast_id [simp]:
     "scast (ucast (x :: 'a::len word) :: 'a signed word) = x"
   by (metis down_cast_same is_down len_signed order_refl scast_scast_id(1))
 
 lemma ucast_scast_id [simp]:
     "ucast (scast (x :: 'a::len signed word) :: 'a word) = x"
   by (metis scast_scast_id(2) scast_ucast_id)
 
 lemma scast_of_nat [simp]:
     "scast (of_nat x :: 'a::len signed word) = (of_nat x :: 'a word)"
   by (metis (hide_lams, no_types) len_signed scast_def uint_sint
          word_of_nat word_ubin.Abs_norm word_ubin.eq_norm)
 
 lemma ucast_of_nat:
   "is_down (ucast :: 'a :: len word \<Rightarrow> 'b :: len word)
     \<Longrightarrow> ucast (of_nat n :: 'a word) = (of_nat n :: 'b word)"
   apply (rule sym)
   apply (subst word_unat.inverse_norm)
   apply (simp add: ucast_def word_of_int[symmetric]
                    of_nat_nat[symmetric] unat_def[symmetric])
   apply (simp add: unat_of_nat)
   apply (rule nat_int.Rep_eqD)
   apply (simp only: zmod_int)
   apply (rule mod_mod_cancel)
   by (simp add: is_down le_imp_power_dvd)
 
 (* shortcut for some specific lengths *)
 lemma word_fixed_sint_1[simp]:
   "sint (1::8 word) = 1"
   "sint (1::16 word) = 1"
   "sint (1::32 word) = 1"
   "sint (1::64 word) = 1"
   by (auto simp: sint_word_ariths)
 
 lemma word_sint_1 [simp]:
   "sint (1::'a::len word) = (if LENGTH('a) = 1 then -1 else 1)"
   apply (case_tac "LENGTH('a) \<le> 1")
    apply (metis diff_is_0_eq sbintrunc_0_numeral(1) sint_n1 word_1_wi
            word_m1_wi word_msb_1 word_msb_n1 word_sbin.Abs_norm)
   apply (metis bin_nth_1 diff_is_0_eq neq0_conv sbintrunc_minus_simps(4)
             sint_word_ariths(8) uint_1 word_msb_1 word_msb_nth)
   done
 
 lemma scast_1':
   "(scast (1::'a::len word) :: 'b::len word) =
    (word_of_int (sbintrunc (LENGTH('a::len) - Suc 0) (1::int)))"
   by (metis One_nat_def scast_def sint_word_ariths(8))
 
 lemma scast_1 [simp]:
   "(scast (1::'a::len word) :: 'b::len word) = (if LENGTH('a) = 1 then -1 else 1)"
   by (clarsimp simp: scast_1')
      (metis Suc_pred len_gt_0 nat.exhaust sbintrunc_Suc_numeral(1) uint_1 word_uint.Rep_inverse')
 
 lemma scast_eq_scast_id [simp]:
   "((scast (a :: 'a::len signed word) :: 'a word) = scast b) = (a = b)"
   by (metis ucast_scast_id)
 
 lemma ucast_eq_ucast_id [simp]:
   "((ucast (a :: 'a::len word) :: 'a signed word) = ucast b) = (a = b)"
   by (metis scast_ucast_id)
 
 lemma scast_ucast_norm [simp]:
   "(ucast (a :: 'a::len word) = (b :: 'a signed word)) = (a = scast b)"
   "((b :: 'a signed word) = ucast (a :: 'a::len word)) = (a = scast b)"
   by (metis scast_ucast_id ucast_scast_id)+
 
 lemma of_bl_drop:
   "of_bl (drop n xs) = (of_bl xs && mask (length xs - n))"
   apply (clarsimp simp: bang_eq test_bit_of_bl rev_nth cong: rev_conj_cong)
   apply (safe; simp add: word_size to_bl_nth)
   done
 
 lemma of_int_uint [simp]:
   "of_int (uint x) = x"
   by (metis word_of_int word_uint.Rep_inverse')
 
 lemma shiftr_mask2:
   "n \<le> LENGTH('a) \<Longrightarrow> (mask n >> m :: ('a :: len) word) = mask (n - m)"
   apply (rule word_eqI)
   apply (simp add: nth_shiftr word_size)
   apply arith
   done
 
 corollary word_plus_and_or_coroll:
   "x && y = 0 \<Longrightarrow> x + y = x || y"
   using word_plus_and_or[where x=x and y=y]
   by simp
 
 corollary word_plus_and_or_coroll2:
   "(x && w) + (x && ~~ w) = x"
   apply (subst word_plus_and_or_coroll)
    apply (rule word_eqI, simp add: word_size word_ops_nth_size)
   apply (rule word_eqI, simp add: word_size word_ops_nth_size)
   apply blast
   done
 
 lemma less_le_mult_nat':
   "w * c < b * c ==> 0 \<le> c ==> Suc w * c \<le> b * (c::nat)"
   apply (rule mult_right_mono)
    apply (rule Suc_leI)
    apply (erule (1) mult_right_less_imp_less)
   apply assumption
   done
 
 lemmas less_le_mult_nat = less_le_mult_nat'[simplified distrib_right, simplified]
 
 (* FIXME: these should eventually be moved to HOL/Word. *)
 lemmas extra_sle_sless_unfolds [simp] =
     word_sle_def[where a=0 and b=1]
     word_sle_def[where a=0 and b="numeral n"]
     word_sle_def[where a=1 and b=0]
     word_sle_def[where a=1 and b="numeral n"]
     word_sle_def[where a="numeral n" and b=0]
     word_sle_def[where a="numeral n" and b=1]
     word_sless_alt[where a=0 and b=1]
     word_sless_alt[where a=0 and b="numeral n"]
     word_sless_alt[where a=1 and b=0]
     word_sless_alt[where a=1 and b="numeral n"]
     word_sless_alt[where a="numeral n" and b=0]
     word_sless_alt[where a="numeral n" and b=1]
   for n
 
 
 lemma to_bl_1:
   "to_bl (1::'a::len word) = replicate (LENGTH('a) - 1) False @ [True]"
 proof -
   have "to_bl (1 :: 'a::len word) = to_bl (mask 1 :: 'a::len word)"
     by (simp add: mask_def)
 
   also have "\<dots> = replicate (LENGTH('a) - 1) False @ [True]"
     by (cases "LENGTH('a)"; clarsimp simp: to_bl_mask)
 
   finally show ?thesis .
 qed
 
 lemma list_of_false:
   "True \<notin> set xs \<Longrightarrow> xs = replicate (length xs) False"
   by (induct xs, simp_all)
 
 lemma eq_zero_set_bl:
   "(w = 0) = (True \<notin> set (to_bl w))"
   using list_of_false word_bl.Rep_inject by fastforce
 
 lemma diff_diff_less:
   "(i < m - (m - (n :: nat))) = (i < m \<and> i < n)"
   by auto
 
 lemma pop_count_0[simp]:
   "pop_count 0 = 0"
   by (clarsimp simp:pop_count_def)
 
 lemma pop_count_1[simp]:
   "pop_count 1 = 1"
   by (clarsimp simp:pop_count_def to_bl_1)
 
 lemma pop_count_0_imp_0:
   "(pop_count w = 0) = (w = 0)"
   apply (rule iffI)
    apply (clarsimp simp:pop_count_def)
    apply (subst (asm) filter_empty_conv)
    apply (clarsimp simp:eq_zero_set_bl)
    apply fast
   apply simp
   done
 
 end
diff --git a/thys/Word_Lib/Word_Syntax.thy b/thys/Word_Lib/Word_Syntax.thy
--- a/thys/Word_Lib/Word_Syntax.thy
+++ b/thys/Word_Lib/Word_Syntax.thy
@@ -1,68 +1,68 @@
 (*
  * Copyright 2014, NICTA
  *
  * This software may be distributed and modified according to the terms of
  * the BSD 2-Clause license. Note that NO WARRANTY is provided.
  * See "LICENSE_BSD2.txt" for details.
  *
  * @TAG(NICTA_BSD)
  *)
 
 section "Additional Syntax for Word Bit Operations"
 
 theory Word_Syntax
 imports
   "HOL-Word.More_Word"
   WordBitwise_Signed
   Hex_Words
   Norm_Words
   Word_Type_Syntax
 begin
 
 text \<open>Additional bit and type syntax that forces word types.\<close>
 
 type_synonym word8 = "8 word"
 type_synonym word16 = "16 word"
 type_synonym word32 = "32 word"
 type_synonym word64 = "64 word"
 
 lemma len8: "len_of (x :: 8 itself) = 8" by simp
 lemma len16: "len_of (x :: 16 itself) = 16" by simp
 lemma len32: "len_of (x :: 32 itself) = 32" by simp
 lemma len64: "len_of (x :: 64 itself) = 64" by simp
 
 
 abbreviation
-  wordNOT  :: "'a::len0 word \<Rightarrow> 'a word"      ("~~ _" [70] 71)
+  wordNOT  :: "'a::len0 word \<Rightarrow> 'a word"      ("~~")
 where
   "~~ x == NOT x"
 
 abbreviation
   wordAND  :: "'a::len0 word \<Rightarrow> 'a word \<Rightarrow> 'a word" (infixr "&&" 64)
 where
   "a && b == a AND b"
 
 abbreviation
   wordOR   :: "'a::len0 word \<Rightarrow> 'a word \<Rightarrow> 'a word" (infixr "||"  59)
 where
   "a || b == a OR b"
 
 abbreviation
   wordXOR  :: "'a::len0 word \<Rightarrow> 'a word \<Rightarrow> 'a word" (infixr "xor" 59)
 where
   "a xor b == a XOR b"
 
 (* testing for presence of word_bitwise *)
 lemma "((x :: word32) >> 3) AND 7 = (x AND 56) >> 3"
   by word_bitwise
 
 (* FIXME: move to Word distribution *)
 lemma bin_nth_minus_Bit0[simp]:
   "0 < n \<Longrightarrow> bin_nth (numeral (num.Bit0 w)) n = bin_nth (numeral w) (n - 1)"
   by (cases n; simp)
 
 lemma bin_nth_minus_Bit1[simp]:
   "0 < n \<Longrightarrow> bin_nth (numeral (num.Bit1 w)) n = bin_nth (numeral w) (n - 1)"
   by (cases n; simp)
 
 end