diff --git a/thys/Algebraic_Numbers/Real_Roots.thy b/thys/Algebraic_Numbers/Real_Roots.thy
--- a/thys/Algebraic_Numbers/Real_Roots.thy
+++ b/thys/Algebraic_Numbers/Real_Roots.thy
@@ -1,746 +1,746 @@
 (*  
     Author:      René Thiemann 
                  Akihisa Yamada
     License:     BSD
 *)
 section \<open>Real Roots\<close>
 
 text \<open>This theory contains an algorithm to determine the set of real roots of a 
   rational polynomial. It further contains an algorithm which tries to determine the
   real roots of real-valued polynomial, which incorporates Yun-factorization and 
   closed formulas for polynomials of degree 2.\<close>
 
 theory Real_Roots
 imports 
   Real_Algebraic_Numbers
 begin
 
 hide_const (open) UnivPoly.coeff
 hide_const (open) Module.smult
 
 text \<open>Division of integers, rounding to the upper value.\<close>
 definition div_ceiling :: "int \<Rightarrow> int \<Rightarrow> int" where
   "div_ceiling x y = (let q = x div y in if q * y = x then q else q + 1)" 
 
 definition root_bound :: "int poly \<Rightarrow> rat" where 
   "root_bound p \<equiv> let 
      n = degree p;
      m = 1 + div_ceiling (max_list_non_empty (map (\<lambda>i. abs (coeff p i)) [0..<n])) 
           (abs (lead_coeff p))
      \<comment> \<open>round to the next higher number \<open>2^n\<close>, so that bisection will\<close>
      \<comment> \<open>stay on integers for as long as possible\<close>
    in of_int (2 ^ (log_ceiling 2 m))"
   
 partial_function (tailrec) roots_of_2_main :: 
   "int poly \<Rightarrow> root_info \<Rightarrow> (rat \<Rightarrow> rat \<Rightarrow> nat) \<Rightarrow> (rat \<times> rat)list \<Rightarrow> real_alg_2 list \<Rightarrow> real_alg_2 list" where
   [code]: "roots_of_2_main p ri cr lrs rais = (case lrs of Nil \<Rightarrow> rais
   | (l,r) # lrs \<Rightarrow> let c = cr l r in 
     if c = 0 then roots_of_2_main p ri cr lrs rais
     else if c = 1 then roots_of_2_main p ri cr lrs (real_alg_2'' ri p l r # rais)
     else let m = (l + r) / 2 in roots_of_2_main p ri cr ((m,r) # (l,m) # lrs) rais)"
   
 definition roots_of_2_irr :: "int poly \<Rightarrow> real_alg_2 list" where
   "roots_of_2_irr p = (if degree p = 1
     then [Rational (Rat.Fract (- coeff p 0) (coeff p 1)) ] else 
     let ri = root_info p;
         cr = root_info.l_r ri;
         B = root_bound p
       in (roots_of_2_main p ri cr [(-B,B)] []))"
   
 lemma root_imp_deg_nonzero: assumes "p \<noteq> 0" "poly p x = 0"
   shows "degree p \<noteq> 0" 
 proof
   assume "degree p = 0" 
   from degree0_coeffs[OF this] assms show False by auto
 qed
   
 lemma cauchy_root_bound: fixes x :: "'a :: real_normed_field"
   assumes x: "poly p x = 0" and p: "p \<noteq> 0" 
   shows "norm x \<le> 1 + max_list_non_empty (map (\<lambda> i. norm (coeff p i)) [0 ..< degree p]) 
     / norm (lead_coeff p)" (is "_ \<le> _ + ?max / ?nlc")
 proof -
   let ?n = "degree p" 
   let ?p = "coeff p" 
   let ?lc = "lead_coeff p" 
   define ml where "ml = ?max / ?nlc" 
   from p have lc: "?lc \<noteq> 0" by auto
   hence nlc: "norm ?lc > 0" by auto
   from root_imp_deg_nonzero[OF p x] have *: "0 \<in> set [0 ..< degree p]" by auto
   have "0 \<le> norm (?p 0)" by simp
   also have "\<dots> \<le> ?max" 
     by (rule max_list_non_empty, insert *, auto)
   finally have max0: "?max \<ge> 0" .
   with nlc have ml0: "ml \<ge> 0" unfolding ml_def by auto
   hence easy: "norm x \<le> 1 \<Longrightarrow> ?thesis" unfolding ml_def[symmetric] by auto
   show ?thesis
   proof (cases "norm x \<le> 1")
     case True
     thus ?thesis using easy by auto
   next
     case False
     hence nx: "norm x > 1" by simp 
     hence x0: "x \<noteq> 0" by auto
     hence xn0: "0 < norm x ^ ?n" by auto
     from x[unfolded poly_altdef] have "x ^ ?n * ?lc = x ^ ?n * ?lc - (\<Sum>i\<le>?n. x ^ i * ?p i)" 
       unfolding poly_altdef by (simp add: ac_simps)    
     also have "(\<Sum>i\<le>?n. x ^ i * ?p i) = x ^ ?n * ?lc + (\<Sum>i < ?n. x ^ i * ?p i)" 
       by (subst sum.remove[of _ ?n], auto intro: sum.cong)
     finally have "x ^ ?n * ?lc = - (\<Sum>i < ?n. x ^ i * ?p i)" by simp
     with lc have "x ^ ?n = - (\<Sum>i < ?n. x ^ i * ?p i) / ?lc" by (simp add: field_simps)
     from arg_cong[OF this, of norm]
     have "norm x ^ ?n = norm ((\<Sum>i < ?n. x ^ i * ?p i) / ?lc)" unfolding norm_power by simp
     also have "(\<Sum>i < ?n. x ^ i * ?p i) / ?lc = (\<Sum>i < ?n. x ^ i * ?p i / ?lc)" 
       by (rule sum_divide_distrib)
     also have "norm \<dots> \<le> (\<Sum>i < ?n. norm (x ^ i * (?p i / ?lc)))" 
       by (simp add: field_simps, rule norm_sum)
     also have "\<dots> = (\<Sum>i < ?n. norm x ^ i * norm (?p i / ?lc))" 
       unfolding norm_mult norm_power ..
     also have "\<dots> \<le> (\<Sum>i < ?n. norm x ^ i * ml)" 
     proof (rule sum_mono)
       fix i
       assume "i \<in> {..<?n}" 
       hence i: "i < ?n" by simp
       show "norm x ^ i * norm (?p i / ?lc) \<le> norm x ^ i * ml" 
       proof (rule mult_left_mono)
         show "0 \<le> norm x ^ i" using nx by auto
         show "norm (?p i / ?lc) \<le> ml" unfolding norm_divide ml_def
           by (rule divide_right_mono[OF max_list_non_empty], insert nlc i, auto)
       qed
     qed
     also have "\<dots> = ml * (\<Sum>i < ?n. norm x ^ i)" 
       unfolding sum_distrib_right[symmetric] by simp
     also have "(\<Sum>i < ?n. norm x ^ i) = (norm x ^ ?n - 1) / (norm x - 1)" 
       by (rule geometric_sum, insert nx, auto)
     finally have "norm x ^ ?n \<le> ml * (norm x ^ ?n - 1) / (norm x - 1)" by simp        
     from mult_left_mono[OF this, of "norm x - 1"]
     have "(norm x - 1) * (norm x ^ ?n) \<le> ml * (norm x ^ ?n - 1)" using nx by auto
     also have "\<dots> = (ml * (1 - 1 / (norm x ^ ?n))) * norm x ^ ?n" 
       using nx False x0 by (simp add: field_simps)
     finally have "(norm x - 1) * (norm x ^ ?n) \<le> (ml * (1 - 1 / (norm x ^ ?n))) * norm x ^ ?n" .
     from mult_right_le_imp_le[OF this xn0]
     have "norm x - 1 \<le> ml * (1 - 1 / (norm x ^ ?n))" by simp
     hence "norm x \<le> 1 + ml - ml / (norm x ^ ?n)" by (simp add: field_simps)
     also have "\<dots> \<le> 1 + ml" using ml0 xn0 by auto
     finally show ?thesis unfolding ml_def .
   qed
 qed
       
 lemma div_le_div_ceiling: "x div y \<le> div_ceiling x y" 
   unfolding div_ceiling_def Let_def by auto
     
 lemma div_ceiling: assumes q: "q \<noteq> 0"  
   shows "(of_int x :: 'a :: floor_ceiling) / of_int q \<le> of_int (div_ceiling x q)" 
 proof (cases "q dvd x")
   case True
   then obtain k where xqk: "x = q * k" unfolding dvd_def by auto
   hence id: "div_ceiling x q = k" unfolding div_ceiling_def Let_def using q by auto
   show ?thesis unfolding id unfolding xqk using q by simp
 next
   case False
   {
     assume "x div q * q = x" 
     hence "x = q * (x div q)" by (simp add: ac_simps)
     hence "q dvd x" unfolding dvd_def by auto
     with False have False by simp
   }
   hence id: "div_ceiling x q = x div q + 1" 
     unfolding div_ceiling_def Let_def using q by auto
   show ?thesis unfolding id
     by (metis floor_divide_of_int_eq le_less add1_zle_eq floor_less_iff)
 qed
   
 lemma max_list_non_empty_map: assumes hom: "\<And> x y. max (f x) (f y) = f (max x y)"  
   shows "xs \<noteq> [] \<Longrightarrow> max_list_non_empty (map f xs) = f (max_list_non_empty xs)" 
   by (induct xs rule: max_list_non_empty.induct, auto simp: hom)
 
 lemma root_bound: assumes "root_bound p = B" and deg: "degree p > 0"
   shows "ipoly p (x :: real) = 0 \<Longrightarrow> norm x \<le> of_rat B" "B \<ge> 0" 
 proof -
   let ?r = real_of_rat
   let ?i = real_of_int
   let ?p = "real_of_int_poly p"
   define n where "n = degree p"
   let ?lc = "coeff p n" 
   let ?list = "map (\<lambda>i. abs (coeff p i)) [0..<n]" 
   let ?list' = "(map (\<lambda>i. ?i (abs ((coeff p i)))) [0..<n])" 
   define m where "m = max_list_non_empty ?list"
   define m_up where "m_up = 1 + div_ceiling m (abs ?lc)"
   define C where "C = rat_of_int (2^(log_ceiling 2 m_up))"
   from deg have p0: "p \<noteq> 0" by auto
   from p0 have alc0: "abs ?lc \<noteq> 0" unfolding n_def by auto
   from deg have mem: "abs (coeff p 0) \<in> set ?list" unfolding n_def by auto
   from max_list_non_empty[OF this, folded m_def]    
   have m0: "m \<ge> 0" by auto
   have "div_ceiling m (abs ?lc) \<ge> 0" 
     by (rule order_trans[OF _ div_le_div_ceiling[of m "abs ?lc"]], subst
     pos_imp_zdiv_nonneg_iff, insert p0 m0, auto simp: n_def)
   hence mup: "m_up \<ge> 1" unfolding m_up_def by auto
   have "m_up \<le> 2 ^ (log_ceiling 2 m_up)" using  mup log_ceiling_sound(1) by auto
   hence Cmup: "C \<ge> of_int m_up" unfolding C_def by linarith
   with mup have C: "C \<ge> 1" by auto      
   from assms(1)[unfolded root_bound_def Let_def]
   have B: "C = of_rat B" unfolding C_def m_up_def n_def m_def by auto
   note dc = div_le_div_ceiling[of m "abs ?lc"] 
   with C show "B \<ge> 0" unfolding B by auto
   assume "ipoly p x = 0" 
   hence rt: "poly ?p x = 0" by simp
   from root_imp_deg_nonzero[OF _ this] p0 have n0: "n \<noteq> 0" unfolding n_def by auto
   from cauchy_root_bound[OF rt] p0
   have "norm x \<le> 1 + max_list_non_empty ?list' / ?i (abs ?lc)" 
     by (simp add: n_def)
   also have "?list' = map ?i ?list" by simp
   also have "max_list_non_empty \<dots> = ?i m" unfolding m_def
     by (rule max_list_non_empty_map, insert mem, auto)
   also have "1 + m / ?i (abs ?lc) \<le> ?i m_up" 
     unfolding m_up_def using div_ceiling[OF alc0, of m] by auto
   also have "\<dots> \<le> ?r C" using Cmup using of_rat_less_eq by force
   finally have "norm x \<le> ?r C" .
   thus "norm x \<le> ?r B" unfolding B by simp
 qed
   
 fun pairwise_disjoint :: "'a set list \<Rightarrow> bool" where
   "pairwise_disjoint [] = True" 
 | "pairwise_disjoint (x # xs) = ((x \<inter> (\<Union> y \<in> set xs. y) = {}) \<and> pairwise_disjoint xs)" 
 
 lemma roots_of_2_irr: assumes pc: "poly_cond p" and deg: "degree p > 0"
   shows "real_of_2 ` set (roots_of_2_irr p) = {x. ipoly p x = 0}" (is ?one)
     "Ball (set (roots_of_2_irr p)) invariant_2" (is ?two)
     "distinct (map real_of_2 (roots_of_2_irr p))" (is ?three)
 proof -
   note d = roots_of_2_irr_def
   from poly_condD[OF pc] have mon: "lead_coeff p > 0" and irr: "irreducible p" by auto
   let ?norm = "real_alg_2'"
   have "?one \<and> ?two \<and> ?three"
   proof (cases "degree p = 1")
     case True
     define c where "c = coeff p 0"
     define d where "d = coeff p 1" 
     from True have rr: "roots_of_2_irr p = [Rational (Rat.Fract (- c) (d))]" unfolding d d_def c_def by auto
     from degree1_coeffs[OF True] have p: "p = [:c,d:]" and d: "d \<noteq> 0" unfolding c_def d_def by auto
     have *: "real_of_int c + x * real_of_int d = 0 \<Longrightarrow> x = - (real_of_int c / real_of_int d)" for x
       using d by (simp add: field_simps)
     show ?thesis unfolding rr using d * unfolding p using of_rat_1[of "Rat.Fract (- c) (d)"]
       by (auto simp: Fract_of_int_quotient hom_distribs)
   next
     case False
     let ?r = real_of_rat
     let ?rp = "map_poly ?r"
     let ?rr = "set (roots_of_2_irr p)"
     define ri where "ri = root_info p"
     define cr where "cr = root_info.l_r ri"
     define bnds where "bnds = [(-root_bound p, root_bound p)]"
     define empty where "empty = (Nil :: real_alg_2 list)"
     have empty: "Ball (set empty) invariant_2 \<and> distinct (map real_of_2 empty)" unfolding empty_def by auto
     from mon have p: "p \<noteq> 0" by auto
     from root_info[OF irr deg] have ri: "root_info_cond ri p" unfolding ri_def .    
     from False 
     have rr: "roots_of_2_irr p = roots_of_2_main p ri cr bnds empty"
       unfolding d ri_def cr_def Let_def bnds_def empty_def by auto
     note root_bound = root_bound[OF refl deg]
     from root_bound(2)
     have bnds: "\<And> l r. (l,r) \<in> set bnds \<Longrightarrow> l \<le> r" unfolding bnds_def by auto
     have "ipoly p x = 0 \<Longrightarrow> ?r (- root_bound p) \<le> x \<and> x \<le> ?r (root_bound p)" for x
       using root_bound(1)[of x] by (auto simp: hom_distribs)
     hence rts: "{x. ipoly p x = 0} 
       = real_of_2 ` set empty \<union> {x. \<exists> l r. root_cond (p,l,r) x \<and> (l,r) \<in> set bnds}" 
       unfolding empty_def bnds_def by (force simp: root_cond_def)
     define rts where "rts lr = Collect (root_cond (p,lr))" for lr 
     have disj: "pairwise_disjoint (real_of_2 ` set empty # map rts bnds)" 
       unfolding empty_def bnds_def by auto
     from deg False have deg1: "degree p > 1" by auto
     define delta where "delta = ipoly_root_delta p"
     note delta = ipoly_root_delta[OF p, folded delta_def]
     define rel' where "rel' = ({(x, y). 0 \<le> y \<and> delta_gt delta x y})^-1"
     define mm where "mm = (\<lambda>bnds. mset (map (\<lambda> (l,r). ?r r - ?r l) bnds))"
     define rel where "rel = inv_image (mult1 rel') mm"
     have wf: "wf rel" unfolding rel_def rel'_def
       by (rule wf_inv_image[OF wf_mult1[OF SN_imp_wf[OF delta_gt_SN[OF delta(1)]]]])
     let ?main = "roots_of_2_main p ri cr"    
     have "real_of_2 ` set (?main bnds empty) =
       real_of_2 ` set empty \<union>
       {x. \<exists>l r. root_cond (p, l, r) x \<and> (l, r) \<in> set bnds} \<and>
       Ball (set (?main bnds empty)) invariant_2 \<and> distinct (map real_of_2 (?main bnds empty))" (is "?one' \<and> ?two' \<and> ?three'")
       using empty bnds disj
     proof (induct bnds arbitrary: empty rule: wf_induct[OF wf])
       case (1 lrss rais)
       note rais = 1(2)[rule_format]
       note lrs = 1(3)
       note disj = 1(4)
       note IH = 1(1)[rule_format]
       note simp = roots_of_2_main.simps[of p ri cr lrss rais]
       show ?case
       proof (cases lrss)
         case Nil
         with rais show ?thesis unfolding simp by auto
       next
         case (Cons lr lrs)
         obtain l r where lr': "lr = (l,r)" by force
         {
           fix lr'
           assume lt: "\<And> l' r'. (l',r') \<in> set lr' \<Longrightarrow> 
             l' \<le> r' \<and> delta_gt delta (?r r - ?r l) (?r r' - ?r l')"
           have l: "mm (lr' @ lrs) = mm lrs + mm lr'" unfolding mm_def by (auto simp: ac_simps)
           have r: "mm lrss = mm lrs + {# ?r r - ?r l #}" unfolding Cons lr' rel_def mm_def
             by auto
           have "(mm (lr' @ lrs), mm lrss) \<in> mult1 rel'" unfolding l r mult1_def
           proof (rule, unfold split, intro exI conjI, unfold add_mset_add_single[symmetric], rule refl, rule refl, intro allI impI)
             fix d
             assume "d \<in># mm lr'"
             then obtain l' r' where d: "d = ?r r' - ?r l'" and lr': "(l',r') \<in> set lr'"
               unfolding mm_def in_multiset_in_set by auto
             from lt[OF lr']
             show "(d, ?r r - ?r l) \<in> rel'"  unfolding d rel'_def 
               by (auto simp: of_rat_less_eq)
           qed
           hence "(lr' @ lrs, lrss) \<in> rel" unfolding rel_def by auto
         } note rel = this
         from rel[of Nil] have easy_rel: "(lrs,lrss) \<in> rel" by auto
         define c where "c = cr l r"
         from simp Cons lr' have simp: "?main lrss rais = 
           (if c = 0 then ?main lrs rais else if c = 1 then 
              ?main lrs (real_alg_2' ri p l r # rais)
                else let m = (l + r) / 2 in ?main ((m, r) # (l, m) # lrs) rais)"
           unfolding c_def simp Cons lr' using real_alg_2''[OF False] by auto
         note lrs = lrs[unfolded Cons lr']        
         from lrs have lr: "l \<le> r" by auto
         from root_info_condD(1)[OF ri lr, folded cr_def] 
         have c: "c = card {x. root_cond (p,l,r) x}" unfolding c_def by auto
         let ?rt = "\<lambda> lrs. {x. \<exists>l r. root_cond (p, l, r) x \<and> (l, r) \<in> set lrs}"
         have rts: "?rt lrss = ?rt lrs \<union> {x. root_cond (p,l,r) x}" (is "?rt1 = ?rt2 \<union> ?rt3")
           unfolding Cons lr' by auto
         show ?thesis 
         proof (cases "c = 0")
           case True          
           with simp have simp: "?main lrss rais = ?main lrs rais" by simp
           from disj have disj: "pairwise_disjoint (real_of_2 ` set rais # map rts lrs)" 
             unfolding Cons by auto
           from finite_ipoly_roots[OF p] True[unfolded c] have empty: "?rt3 = {}"
             unfolding root_cond_def[abs_def] split by simp
           with rts have rts: "?rt1 = ?rt2" by auto
           show ?thesis unfolding simp rts 
             by (rule IH[OF easy_rel rais lrs disj], auto)
         next
           case False
           show ?thesis
           proof (cases "c = 1")
             case True
             let ?rai = "real_alg_2' ri p l r"
             from True simp have simp: "?main lrss rais = ?main lrs (?rai # rais)" by auto
             from card_1_Collect_ex1[OF c[symmetric, unfolded True]] 
             have ur: "unique_root (p,l,r)"  .            
             from real_alg_2'[OF ur pc ri]
             have rai: "invariant_2 ?rai" "real_of_2 ?rai = the_unique_root (p, l, r)" by auto
             with rais have rais: "\<And> x. x \<in> set (?rai # rais) \<Longrightarrow> invariant_2 x" 
               and dist: "distinct (map real_of_2 rais)" by auto
             have rt3: "?rt3 = {real_of_2 ?rai}" 
-              using rc1 ur rai by (auto intro: the_unique_root_eqI theI')            
+              using ur rai by (auto intro: the_unique_root_eqI theI')            
             have "real_of_2 ` set (roots_of_2_main p ri cr lrs (?rai # rais)) =
               real_of_2 ` set (?rai # rais) \<union> ?rt2 \<and>
               Ball (set (roots_of_2_main p ri cr lrs (?rai # rais))) invariant_2 \<and>
               distinct (map real_of_2 (roots_of_2_main p ri cr lrs (?rai # rais)))"
               (is "?one \<and> ?two \<and> ?three")
             proof (rule IH[OF easy_rel, of "?rai # rais", OF conjI lrs])
               show "Ball (set (real_alg_2' ri p l r # rais)) invariant_2" using rais by auto
               have "real_of_2 (real_alg_2' ri p l r) \<notin> set (map real_of_2 rais)"
                 using disj rt3 unfolding Cons lr' rts_def by auto
               thus "distinct (map real_of_2 (real_alg_2' ri p l r # rais))" using dist by auto
               show "pairwise_disjoint (real_of_2 ` set (real_alg_2' ri p l r # rais) # map rts lrs)"
                 using disj rt3 unfolding Cons lr' rts_def by auto
             qed auto
             hence ?one ?two ?three by blast+
             show ?thesis unfolding simp rts rt3 
               by (rule conjI[OF _ conjI[OF \<open>?two\<close> \<open>?three\<close>]], unfold \<open>?one\<close>, auto)
           next
             case False
             let ?m = "(l+r)/2"
             let ?lrs = "[(?m,r),(l,?m)] @ lrs"
             from False \<open>c \<noteq> 0\<close> have simp: "?main lrss rais = ?main ?lrs rais"
               unfolding simp by (auto simp: Let_def)
             from False \<open>c \<noteq> 0\<close> have "c \<ge> 2" by auto
             from delta(2)[OF this[unfolded c]] have delta: "delta \<le> ?r (r - l) / 4" by auto
             have lrs: "\<And> l r. (l,r) \<in> set ?lrs \<Longrightarrow> l \<le> r"
               using lr lrs by (fastforce simp: field_simps)
             have "?r ?m \<in> \<rat>" unfolding Rats_def by blast
             with poly_cond_degree_gt_1[OF pc deg1, of "?r ?m"]
             have disj1: "?r ?m \<notin> rts lr" for lr unfolding rts_def root_cond_def by auto
             have disj2: "rts (?m, r) \<inter> rts (l, ?m) = {}" using disj1[of "(l,?m)"] disj1[of "(?m,r)"] 
               unfolding rts_def root_cond_def by auto
             have disj3: "(rts (l,?m) \<union> rts (?m,r)) = rts (l,r)"
               unfolding rts_def root_cond_def by (auto simp: hom_distribs)
             have disj4: "real_of_2 ` set rais \<inter> rts (l,r) = {}" using disj unfolding Cons lr' by auto
             have disj: "pairwise_disjoint (real_of_2 ` set rais # map rts ([(?m, r), (l, ?m)] @ lrs))" 
               using disj disj2 disj3 disj4 by (auto simp: Cons lr')
             have "(?lrs,lrss) \<in> rel"
             proof (rule rel, intro conjI)
               fix l' r'
               assume mem: "(l', r') \<in> set [(?m,r),(l,?m)]"
               from mem lr show "l' \<le> r'" by auto
               from mem have diff: "?r r' - ?r l' = (?r r - ?r l) / 2" by auto 
                (metis eq_diff_eq minus_diff_eq mult_2_right of_rat_add of_rat_diff,
                 metis of_rat_add of_rat_mult of_rat_numeral_eq)
               show "delta_gt delta (?r r - ?r l) (?r r' - ?r l')" unfolding diff
                 delta_gt_def by (rule order.trans[OF delta], insert lr, 
                 auto simp: field_simps of_rat_diff of_rat_less_eq)
             qed
             note IH = IH[OF this, of rais, OF rais lrs disj]
             have "real_of_2 ` set (?main ?lrs rais) =
               real_of_2 ` set rais \<union> ?rt ?lrs \<and>
               Ball (set (?main ?lrs rais)) invariant_2 \<and> distinct (map real_of_2 (?main ?lrs rais))"
               (is "?one \<and> ?two")
               by (rule IH)
             hence ?one ?two by blast+
             have cong: "\<And> a b c. b = c \<Longrightarrow> a \<union> b = a \<union> c" by auto
             have id: "?rt ?lrs = ?rt lrs \<union> ?rt [(?m,r),(l,?m)]" by auto
             show ?thesis unfolding rts simp \<open>?one\<close> id
             proof (rule conjI[OF cong[OF cong] conjI])
               have "\<And> x. root_cond (p,l,r) x = (root_cond (p,l,?m) x \<or> root_cond (p,?m,r) x)"
                 unfolding root_cond_def by (auto simp:hom_distribs)
               hence id: "Collect (root_cond (p,l,r)) = {x. (root_cond (p,l,?m) x \<or> root_cond (p,?m,r) x)}" 
                 by auto
               show "?rt [(?m,r),(l,?m)] = Collect (root_cond (p,l,r))" unfolding id list.simps by blast
               show "\<forall> a \<in> set (?main ?lrs rais). invariant_2 a" using \<open>?two\<close> by auto
               show "distinct (map real_of_2 (?main ?lrs rais))" using \<open>?two\<close> by auto
             qed
           qed
         qed
       qed
     qed
     hence idd: "?one'" and cond: ?two' ?three' by blast+
     define res where "res = roots_of_2_main p ri cr bnds empty"
     have e: "set empty = {}" unfolding empty_def by auto
     from idd[folded res_def] e have idd: "real_of_2 ` set res = {} \<union> {x. \<exists>l r. root_cond (p, l, r) x \<and> (l, r) \<in> set bnds}"
       by auto
     show ?thesis
       unfolding rr unfolding rts id e norm_def using cond 
       unfolding res_def[symmetric] image_empty e idd[symmetric] by auto
   qed
   thus ?one ?two ?three by blast+
 qed
  
 definition roots_of_2 :: "int poly \<Rightarrow> real_alg_2 list" where
   "roots_of_2 p = concat (map roots_of_2_irr 
      (factors_of_int_poly p))"
     
 lemma roots_of_2:
   shows "p \<noteq> 0 \<Longrightarrow> real_of_2 ` set (roots_of_2 p) = {x. ipoly p x = 0}"
     "Ball (set (roots_of_2 p)) invariant_2"
     "distinct (map real_of_2 (roots_of_2 p))" 
 proof -
   let ?rr = "roots_of_2 p"
   note d = roots_of_2_def
   note frp1 = factors_of_int_poly
   {
     fix q r
     assume "q \<in> set ?rr"
     then obtain s where 
       s: "s \<in> set (factors_of_int_poly p)" and
       q: "q \<in> set (roots_of_2_irr s)"
       unfolding d by auto
     from frp1(1)[OF refl s] have "poly_cond s" "degree s > 0" by (auto simp: poly_cond_def)
     from roots_of_2_irr[OF this] q
     have "invariant_2 q" by auto
   }
   thus "Ball (set ?rr) invariant_2" by auto
   {  
     assume p: "p \<noteq> 0" 
     have "real_of_2 ` set ?rr = (\<Union> ((\<lambda> p. real_of_2 ` set (roots_of_2_irr p)) ` 
       (set (factors_of_int_poly p))))"
       (is "_ = ?rrr")
       unfolding d set_concat set_map by auto
     also have "\<dots> = {x. ipoly p x = 0}"
     proof -
       {
         fix x
         assume "x \<in> ?rrr"
         then obtain q s where 
           s: "s \<in> set (factors_of_int_poly p)" and
           q: "q \<in> set (roots_of_2_irr s)" and
           x: "x = real_of_2 q" by auto
         from frp1(1)[OF refl s] have s0: "s \<noteq> 0" and pt: "poly_cond s" "degree s > 0"
           by (auto simp: poly_cond_def)
         from roots_of_2_irr[OF pt] q have rt: "ipoly s x = 0" unfolding x by auto
         from frp1(2)[OF refl p, of x] rt s have rt: "ipoly p x = 0" by auto
       }
       moreover
       {
         fix x :: real
         assume rt: "ipoly p x = 0"
         from rt frp1(2)[OF refl p, of x] obtain s where s: "s \<in> set (factors_of_int_poly p)" 
           and rt: "ipoly s x = 0" by auto
         from frp1(1)[OF refl s] have s0: "s \<noteq> 0" and ty: "poly_cond s" "degree s > 0"
           by (auto simp: poly_cond_def)
         from roots_of_2_irr(1)[OF ty] rt obtain q where 
           q: "q \<in> set (roots_of_2_irr s)" and
           x: "x = real_of_2 q" by blast
         have "x \<in> ?rrr" unfolding x using q s by auto
       }
       ultimately show ?thesis by auto
     qed
     finally show "real_of_2 ` set ?rr = {x. ipoly p x = 0}" by auto
   }
   show "distinct (map real_of_2 (roots_of_2 p))"
   proof (cases "p = 0")
     case True
     from factors_of_int_poly_const[of 0] True show ?thesis unfolding roots_of_2_def by auto
   next
     case p: False
     note frp1 = frp1[OF refl]
     let ?fp = "factors_of_int_poly p" 
     let ?cc = "concat (map roots_of_2_irr ?fp)" 
     show ?thesis unfolding roots_of_2_def distinct_conv_nth length_map
     proof (intro allI impI notI)
       fix i j
       assume ij: "i < length ?cc" "j < length ?cc" "i \<noteq> j" and id: "map real_of_2 ?cc ! i = map real_of_2 ?cc ! j"       
       from ij id have id: "real_of_2 (?cc ! i) = real_of_2 (?cc ! j)" by auto
       from nth_concat_diff[OF ij, unfolded length_map] obtain j1 k1 j2 k2 where 
         *: "(j1,k1) \<noteq> (j2,k2)"
         "j1 < length ?fp" "j2 < length ?fp" and
         "k1 < length (map roots_of_2_irr ?fp ! j1)"
         "k2 < length (map roots_of_2_irr ?fp ! j2)"
         "?cc ! i = map roots_of_2_irr ?fp ! j1 ! k1" 
         "?cc ! j = map roots_of_2_irr ?fp ! j2 ! k2" by blast
       hence **: "k1 < length (roots_of_2_irr (?fp ! j1))" 
         "k2 < length (roots_of_2_irr (?fp ! j2))" 
         "?cc ! i = roots_of_2_irr (?fp ! j1) ! k1"
         "?cc ! j = roots_of_2_irr (?fp ! j2) ! k2"
         by auto
       from * have mem: "?fp ! j1 \<in> set ?fp" "?fp ! j2 \<in> set ?fp" by auto
       from frp1(1)[OF mem(1)] frp1(1)[OF mem(2)]
       have pc1: "poly_cond (?fp ! j1)" "degree (?fp ! j1) > 0" and pc10: "?fp ! j1 \<noteq> 0" 
         and pc2: "poly_cond (?fp ! j2)" "degree (?fp ! j2) > 0" 
         by (auto simp: poly_cond_def)
       show False
       proof (cases "j1 = j2")
         case True
         with * have neq: "k1 \<noteq> k2" by auto
         from **[unfolded True] id *
         have "map real_of_2 (roots_of_2_irr (?fp ! j2)) ! k1 = real_of_2 (?cc ! j)" 
           "map real_of_2 (roots_of_2_irr (?fp ! j2)) ! k1 = real_of_2 (?cc ! j)"
           by auto
         hence "\<not> distinct (map real_of_2 (roots_of_2_irr (?fp ! j2)))" 
           unfolding distinct_conv_nth using * ** True by auto
         with roots_of_2_irr(3)[OF pc2] show False by auto
       next
         case neq: False
         with frp1(4)[of p] * have neq: "?fp ! j1 \<noteq> ?fp ! j2" unfolding distinct_conv_nth by auto
         let ?x = "real_of_2 (?cc ! i)" 
         define x where "x = ?x" 
         from ** have "x \<in> real_of_2 ` set (roots_of_2_irr (?fp ! j1))" unfolding x_def by auto
         with roots_of_2_irr(1)[OF pc1] have x1: "ipoly (?fp ! j1) x = 0" by auto
         from ** id have "x \<in> real_of_2 ` set (roots_of_2_irr (?fp ! j2))" unfolding x_def
           by (metis image_eqI nth_mem)
         with roots_of_2_irr(1)[OF pc2] have x2: "ipoly (?fp ! j2) x = 0" by auto
         have "ipoly p x = 0" using x1 mem unfolding roots_of_2_def by (metis frp1(2) p)
         from frp1(3)[OF p this] x1 x2 neq mem show False by blast
       qed
     qed
   qed
 qed      
 
 lift_definition roots_of_3 :: "int poly \<Rightarrow> real_alg_3 list" is roots_of_2
   by (insert roots_of_2, auto simp: list_all_iff)
 
 lemma roots_of_3: 
   shows "p \<noteq> 0 \<Longrightarrow> real_of_3 ` set (roots_of_3 p) = {x. ipoly p x = 0}"
     "distinct (map real_of_3 (roots_of_3 p))" 
 proof -
   show "p \<noteq> 0 \<Longrightarrow> real_of_3 ` set (roots_of_3 p) = {x. ipoly p x = 0}"
     by (transfer; intro roots_of_2, auto)
   show "distinct (map real_of_3 (roots_of_3 p))" 
     by (transfer; insert roots_of_2, auto)
 qed
 
 lift_definition roots_of_real_alg :: "int poly \<Rightarrow> real_alg list" is roots_of_3 . 
 
 lemma roots_of_real_alg: 
   "p \<noteq> 0 \<Longrightarrow> real_of ` set (roots_of_real_alg p) = {x. ipoly p x = 0}" 
   "distinct (map real_of (roots_of_real_alg p))"
 proof -
   show "p \<noteq> 0 \<Longrightarrow> real_of ` set (roots_of_real_alg p) = {x. ipoly p x = 0}"
     by (transfer', insert roots_of_3, auto)
   show "distinct (map real_of (roots_of_real_alg p))"      
     by (transfer, insert roots_of_3(2), auto)
 qed
 
 text \<open>It follows an implementation for @{const roots_of_3}, 
   since the current definition does not provide a code equation.\<close>
 context
 begin
 private typedef real_alg_2_list = "{xs. Ball (set xs) invariant_2}" by (intro exI[of _ Nil], auto)
 
 setup_lifting type_definition_real_alg_2_list
 
 private lift_definition roots_of_2_list :: "int poly \<Rightarrow> real_alg_2_list" is roots_of_2
   by (insert roots_of_2, auto)
 private lift_definition real_alg_2_list_nil :: "real_alg_2_list \<Rightarrow> bool" is "\<lambda> xs. case xs of Nil \<Rightarrow> True | _ \<Rightarrow> False" .
 
 private fun real_alg_2_list_hd_intern :: "real_alg_2 list \<Rightarrow> real_alg_2" where
   "real_alg_2_list_hd_intern (Cons x xs) = x"
 | "real_alg_2_list_hd_intern Nil = of_rat_2 0"
 
 private lift_definition real_alg_2_list_hd :: "real_alg_2_list \<Rightarrow> real_alg_3" is real_alg_2_list_hd_intern
 proof (goal_cases)
   case (1 xs)
   thus ?case using of_rat_2[of 0] by (cases xs, auto)
 qed
 
 private lift_definition real_alg_2_list_tl :: "real_alg_2_list \<Rightarrow> real_alg_2_list" is tl 
 proof (goal_cases)
   case (1 xs)
   thus ?case by (cases xs, auto)
 qed
 
 private lift_definition real_alg_2_list_length :: "real_alg_2_list \<Rightarrow> nat" is length .
 
 private lemma real_alg_2_list_length[simp]: "\<not> real_alg_2_list_nil xs \<Longrightarrow> real_alg_2_list_length (real_alg_2_list_tl xs) < real_alg_2_list_length xs"
   by (transfer, auto split: list.splits)
 
 private function real_alg_2_list_convert :: "real_alg_2_list \<Rightarrow> real_alg_3 list" where
   "real_alg_2_list_convert xs = (if real_alg_2_list_nil xs then [] else real_alg_2_list_hd xs 
     # real_alg_2_list_convert (real_alg_2_list_tl xs))" by pat_completeness auto
 
 termination by (relation "measure real_alg_2_list_length", auto)
 
 private definition roots_of_3_impl :: "int poly \<Rightarrow> real_alg_3 list" where
   "roots_of_3_impl p = real_alg_2_list_convert (roots_of_2_list p)"
 
 private lift_definition real_alg_2_list_convert_id :: "real_alg_2_list \<Rightarrow> real_alg_3 list" is id
   by (auto simp: list_all_iff)
 
 lemma real_alg_2_list_convert: "real_alg_2_list_convert xs = real_alg_2_list_convert_id xs"
 proof (induct xs rule: wf_induct[OF wf_measure[of real_alg_2_list_length], rule_format])
   case (1 xs)
   show ?case
   proof (cases "real_alg_2_list_nil xs")
     case True
     hence "real_alg_2_list_convert xs = []" by auto
     also have "[] = real_alg_2_list_convert_id xs" using True
       by (transfer', auto split: list.splits)
     finally show ?thesis .
   next
     case False
     hence "real_alg_2_list_convert xs = real_alg_2_list_hd xs # real_alg_2_list_convert (real_alg_2_list_tl xs)" by simp
     also have "real_alg_2_list_convert (real_alg_2_list_tl xs) = real_alg_2_list_convert_id (real_alg_2_list_tl xs)"
       by (rule 1, insert False, simp)
     also have "real_alg_2_list_hd xs # \<dots> = real_alg_2_list_convert_id xs" using False
       by (transfer', auto split: list.splits)
     finally show ?thesis .
   qed
 qed
 
 lemma roots_of_3_code[code]: "roots_of_3 p = roots_of_3_impl p" 
   unfolding roots_of_3_impl_def real_alg_2_list_convert
   by (transfer, simp)
 end
 
 definition real_roots_of_int_poly :: "int poly \<Rightarrow> real list" where
   "real_roots_of_int_poly p = map real_of (roots_of_real_alg p)"
 
 definition real_roots_of_rat_poly :: "rat poly \<Rightarrow> real list" where
   "real_roots_of_rat_poly p = map real_of (roots_of_real_alg (snd (rat_to_int_poly p)))"
 
 abbreviation rpoly :: "rat poly \<Rightarrow> 'a :: field_char_0 \<Rightarrow> 'a"
 where "rpoly f \<equiv> poly (map_poly of_rat f)"
 
 lemma real_roots_of_int_poly: "p \<noteq> 0 \<Longrightarrow> set (real_roots_of_int_poly p) = {x. ipoly p x = 0}" 
   "distinct (real_roots_of_int_poly p)" 
   unfolding real_roots_of_int_poly_def using roots_of_real_alg[of p] by auto
 
 lemma real_roots_of_rat_poly: "p \<noteq> 0 \<Longrightarrow> set (real_roots_of_rat_poly p) = {x. rpoly p x = 0}" 
   "distinct (real_roots_of_rat_poly p)"
 proof -
   obtain c q where cq: "rat_to_int_poly p = (c,q)" by force
   from rat_to_int_poly[OF this]
   have pq: "p = smult (inverse (of_int c)) (of_int_poly q)" 
     and c: "c \<noteq> 0" by auto
   have id: "{x. rpoly p x = (0 :: real)} = {x. ipoly q x = 0}" 
     unfolding pq by (simp add: c of_rat_of_int_poly hom_distribs)
   show "distinct (real_roots_of_rat_poly p)" unfolding real_roots_of_rat_poly_def cq snd_conv 
     using roots_of_real_alg(2)[of q] .
   assume "p \<noteq> 0" 
   with pq c have q: "q \<noteq> 0" by auto
   show "set (real_roots_of_rat_poly p) = {x. rpoly p x = 0}" unfolding id
     unfolding real_roots_of_rat_poly_def cq snd_conv using roots_of_real_alg(1)[OF q]
     by auto
 qed
 
 text \<open>The upcoming functions no longer demand an integer or rational polynomial as input.\<close>
 
 definition roots_of_real_main :: "real poly \<Rightarrow> real list" where 
   "roots_of_real_main p \<equiv> let n = degree p in 
     if n = 0 then [] else if n = 1 then [roots1 p] else if n = 2 then rroots2 p
     else (real_roots_of_rat_poly (map_poly to_rat p))"
   
 definition roots_of_real_poly :: "real poly \<Rightarrow> real list option" where
   "roots_of_real_poly p \<equiv> let (c,pis) = yun_factorization gcd p in
     if (c \<noteq> 0 \<and> (\<forall> (p,i) \<in> set pis. degree p \<le> 2 \<or> (\<forall> x \<in> set (coeffs p). x \<in> \<rat>))) then 
     Some (concat (map (roots_of_real_main o fst) pis)) else None"
 
 lemma roots_of_real_main: assumes p: "p \<noteq> 0" and deg: "degree p \<le> 2 \<or> set (coeffs p) \<subseteq> \<rat>"
   shows "set (roots_of_real_main p) = {x. poly p x = 0}" (is "?l = ?r")
 proof -
   note d = roots_of_real_main_def Let_def
   show ?thesis 
   proof (cases "degree p = 0")
     case True
     hence "?l = {}" unfolding d by auto
     with roots0[OF p True] show ?thesis by auto
   next
     case False note 0 = this
     show ?thesis
     proof (cases "degree p = 1")
       case True
       hence "?l = {roots1 p}" unfolding d by auto
       with roots1[OF True] show ?thesis by auto
     next
       case False note 1 = this
       show ?thesis
       proof (cases "degree p = 2")
         case True
         hence "?l = set (rroots2 p)" unfolding d by auto
         with rroots2[OF True] show ?thesis by auto
       next
         case False note 2 = this
         let ?q = "map_poly to_rat p"
         from 0 1 2 have l: "?l = set (real_roots_of_rat_poly ?q)" unfolding d by auto
         from deg 0 1 2 have rat: "set (coeffs p) \<subseteq> \<rat>" by auto
         have "p = map_poly (of_rat o to_rat) p"
           by (rule sym, rule map_poly_idI, insert rat, auto)
         also have "\<dots> = real_of_rat_poly ?q"
           by (subst map_poly_map_poly, auto simp: to_rat)
         finally have id: "{x. poly p x = 0} = {x. poly (real_of_rat_poly ?q) x = 0}" and q: "?q \<noteq> 0" 
           using p by auto
         from real_roots_of_rat_poly(1)[OF q, folded id l] show ?thesis by simp
       qed
     qed
   qed
 qed
   
 lemma roots_of_real_poly: assumes rt: "roots_of_real_poly p = Some xs"
   shows "set xs = {x. poly p x = 0}"
 proof -
   obtain c pis where yun: "yun_factorization gcd p = (c,pis)" by force
   from rt[unfolded roots_of_real_poly_def yun split Let_def]
   have c: "c \<noteq> 0" and pis: "\<And> p i. (p, i)\<in>set pis \<Longrightarrow> degree p \<le> 2 \<or> (\<forall>x\<in>set (coeffs p). x \<in> \<rat>)"
     and xs: "xs = concat (map (roots_of_real_main \<circ> fst) pis)"
     by (auto split: if_splits)
   note yun = square_free_factorizationD(1,2,4)[OF yun_factorization(1)[OF yun]]
   from yun(1) have p: "p = smult c (\<Prod>(a, i)\<in>set pis. a ^ Suc i)" .
   have "{x. poly p x = 0} = {x. poly (\<Prod>(a, i)\<in>set pis. a ^ Suc i) x = 0}"
     unfolding p using c by auto
   also have "\<dots> = \<Union> ((\<lambda> p. {x. poly p x = 0}) ` fst ` set pis)" (is "_ = ?r")
     by (subst poly_prod_0, force+)
   finally have r: "{x. poly p x = 0} = ?r" .
   {
     fix p i
     assume p: "(p,i) \<in> set pis"
     have "set (roots_of_real_main p) = {x. poly p x = 0}"
       by (rule roots_of_real_main, insert yun(2)[OF p] pis[OF p], auto)
   } note main = this
   have "set xs = \<Union> ((\<lambda> (p, i). set (roots_of_real_main p)) ` set pis)" unfolding xs o_def
     by auto
   also have "\<dots> = ?r" using main by auto
   finally show ?thesis unfolding r by simp
 qed
 
 end
diff --git a/thys/Berlekamp_Zassenhaus/Finite_Field_Record_Based.thy b/thys/Berlekamp_Zassenhaus/Finite_Field_Record_Based.thy
--- a/thys/Berlekamp_Zassenhaus/Finite_Field_Record_Based.thy
+++ b/thys/Berlekamp_Zassenhaus/Finite_Field_Record_Based.thy
@@ -1,1652 +1,1651 @@
 (*
     Authors:      Jose Divasón
                   Sebastiaan Joosten
                   René Thiemann
                   Akihisa Yamada
 *)
 subsection \<open>Finite Fields\<close>
 
 text \<open>We provide four implementations for $GF(p)$ -- the field with $p$ elements for some
   prime $p$ -- one by int, one by integers, one by 32-bit numbers and one 64-bit implementation. 
   Correctness of the implementations is proven by
   transfer rules to the type-based version of $GF(p)$.\<close>
 
 theory Finite_Field_Record_Based
 imports
   Finite_Field
   Arithmetic_Record_Based
   Native_Word.Uint32 
   Native_Word.Uint64
   Native_Word.Code_Target_Bits_Int
   "HOL-Library.Code_Target_Numeral"  
 begin
 
 (* mod on standard case which can immediately be mapped to 
    target languages without considering special cases *)
 definition mod_nonneg_pos :: "integer \<Rightarrow> integer \<Rightarrow> integer" where
   "x \<ge> 0 \<Longrightarrow> y > 0 \<Longrightarrow> mod_nonneg_pos x y = (x mod y)"
   
 code_printing \<comment> \<open>FIXME illusion of partiality\<close>
   constant mod_nonneg_pos \<rightharpoonup>
         (SML) "IntInf.mod/ ( _,/ _ )"
     and (Eval) "IntInf.mod/ ( _,/ _ )"
     and (OCaml) "Z.rem"
     and (Haskell) "Prelude.mod/ ( _ )/ ( _ )"
     and (Scala) "!((k: BigInt) => (l: BigInt) =>/ (k '% l))"
 
 definition mod_nonneg_pos_int :: "int \<Rightarrow> int \<Rightarrow> int" where
   "mod_nonneg_pos_int x y = int_of_integer (mod_nonneg_pos (integer_of_int x) (integer_of_int y))" 
 
 lemma mod_nonneg_pos_int[simp]: "x \<ge> 0 \<Longrightarrow> y > 0 \<Longrightarrow> mod_nonneg_pos_int x y = (x mod y)" 
   unfolding mod_nonneg_pos_int_def using mod_nonneg_pos_def by simp
 
 context
   fixes p :: int
 begin
 definition plus_p :: "int \<Rightarrow> int \<Rightarrow> int" where
   "plus_p x y \<equiv> let z = x + y in if z \<ge> p then z - p else z"
 
 definition minus_p :: "int \<Rightarrow> int \<Rightarrow> int" where
   "minus_p x y \<equiv> if y \<le> x then x - y else x + p - y"
 
 definition uminus_p :: "int \<Rightarrow> int" where
   "uminus_p x = (if x = 0 then 0 else p - x)"
 
 definition mult_p :: "int \<Rightarrow> int \<Rightarrow> int" where
   "mult_p x y = (mod_nonneg_pos_int (x * y) p)"
 
 fun power_p :: "int \<Rightarrow> nat \<Rightarrow> int" where
   "power_p x n = (if n = 0 then 1 else
     let (d,r) = Divides.divmod_nat n 2;
        rec = power_p (mult_p x x) d in
     if r = 0 then rec else mult_p rec x)"
 
 text \<open>In experiments with Berlekamp-factorization (where the prime $p$ is usually small),
   it turned out that taking the below implementation of inverse via exponentiation
   is faster than the one based on the extended Euclidean algorithm.\<close>
 
 definition inverse_p :: "int \<Rightarrow> int" where
   "inverse_p x = (if x = 0 then 0 else power_p x (nat (p - 2)))"
 
 definition divide_p :: "int \<Rightarrow> int \<Rightarrow> int"  where
   "divide_p x y = mult_p x (inverse_p y)"
 
 definition finite_field_ops_int :: "int arith_ops_record" where
   "finite_field_ops_int \<equiv> Arith_Ops_Record
       0
       1
       plus_p
       mult_p
       minus_p
       uminus_p
       divide_p
       inverse_p
       (\<lambda> x y . if y = 0 then x else 0)
       (\<lambda> x . if x = 0 then 0 else 1)
       (\<lambda> x . x)
       (\<lambda> x . x)
       (\<lambda> x . x)
       (\<lambda> x. 0 \<le> x \<and> x < p)"
 
 end
 
 context
   fixes p :: uint32
 begin
 definition plus_p32 :: "uint32 \<Rightarrow> uint32 \<Rightarrow> uint32" where
   "plus_p32 x y \<equiv> let z = x + y in if z \<ge> p then z - p else z"
 
 definition minus_p32 :: "uint32 \<Rightarrow> uint32 \<Rightarrow> uint32" where
   "minus_p32 x y \<equiv> if y \<le> x then x - y else (x + p) - y"
 
 definition uminus_p32 :: "uint32 \<Rightarrow> uint32" where
   "uminus_p32 x = (if x = 0 then 0 else p - x)"
 
 definition mult_p32 :: "uint32 \<Rightarrow> uint32 \<Rightarrow> uint32" where
   "mult_p32 x y = (x * y mod p)"
 
-lemma int_of_uint32_shift: "int_of_uint32 (shiftr n k) = (int_of_uint32 n) div (2 ^ k)" 
+lemma int_of_uint32_shift: "int_of_uint32 (drop_bit k n) = (int_of_uint32 n) div (2 ^ k)" 
   apply transfer
   apply transfer
   apply (simp add: take_bit_drop_bit min_def)
   apply (simp add: drop_bit_eq_div)
   done
 
 lemma int_of_uint32_0_iff: "int_of_uint32 n = 0 \<longleftrightarrow> n = 0" 
   by (transfer, rule uint_0_iff)
   
 lemma int_of_uint32_0: "int_of_uint32 0 = 0" unfolding int_of_uint32_0_iff by simp
 
 lemma int_of_uint32_ge_0: "int_of_uint32 n \<ge> 0" 
   by (transfer, auto)
 
 lemma two_32: "2 ^ LENGTH(32) = (4294967296 :: int)" by simp
 
 lemma int_of_uint32_plus: "int_of_uint32 (x + y) = (int_of_uint32 x + int_of_uint32 y) mod 4294967296" 
   by (transfer, unfold uint_word_ariths two_32, rule refl)  
 
 lemma int_of_uint32_minus: "int_of_uint32 (x - y) = (int_of_uint32 x - int_of_uint32 y) mod 4294967296" 
   by (transfer, unfold uint_word_ariths two_32, rule refl)  
 
 lemma int_of_uint32_mult: "int_of_uint32 (x * y) = (int_of_uint32 x * int_of_uint32 y) mod 4294967296" 
   by (transfer, unfold uint_word_ariths two_32, rule refl)  
 
 lemma int_of_uint32_mod: "int_of_uint32 (x mod y) = (int_of_uint32 x mod int_of_uint32 y)" 
   by (transfer, unfold uint_mod two_32, rule refl)  
 
 lemma int_of_uint32_inv: "0 \<le> x \<Longrightarrow> x < 4294967296 \<Longrightarrow> int_of_uint32 (uint32_of_int x) = x"
   by transfer (simp add: take_bit_int_eq_self)
 
 function power_p32 :: "uint32 \<Rightarrow> uint32 \<Rightarrow> uint32" where
   "power_p32 x n = (if n = 0 then 1 else
-    let rec = power_p32 (mult_p32 x x) (shiftr n 1) in
+    let rec = power_p32 (mult_p32 x x) (drop_bit 1 n) in
     if n AND 1 = 0 then rec else mult_p32 rec x)"
   by pat_completeness auto
 
 termination 
 proof -
   {
     fix n :: uint32
     assume "n \<noteq> 0" 
     with int_of_uint32_ge_0[of n] int_of_uint32_0_iff[of n] have "int_of_uint32 n > 0" by auto
     hence "0 < int_of_uint32 n" "int_of_uint32 n div 2 < int_of_uint32 n" by auto
   } note * = this
   show ?thesis
     by (relation "measure (\<lambda> (x,n). nat (int_of_uint32 n))", auto simp: int_of_uint32_shift *) 
 qed
 
 text \<open>In experiments with Berlekamp-factorization (where the prime $p$ is usually small),
   it turned out that taking the below implementation of inverse via exponentiation
   is faster than the one based on the extended Euclidean algorithm.\<close>
 
 definition inverse_p32 :: "uint32 \<Rightarrow> uint32" where
   "inverse_p32 x = (if x = 0 then 0 else power_p32 x (p - 2))"
 
 definition divide_p32 :: "uint32 \<Rightarrow> uint32 \<Rightarrow> uint32"  where
   "divide_p32 x y = mult_p32 x (inverse_p32 y)"
 
 definition finite_field_ops32 :: "uint32 arith_ops_record" where
   "finite_field_ops32 \<equiv> Arith_Ops_Record
       0
       1
       plus_p32
       mult_p32
       minus_p32
       uminus_p32
       divide_p32
       inverse_p32
       (\<lambda> x y . if y = 0 then x else 0)
       (\<lambda> x . if x = 0 then 0 else 1)
       (\<lambda> x . x)
       uint32_of_int
       int_of_uint32
       (\<lambda> x. 0 \<le> x \<and> x < p)"
 end 
 
 lemma shiftr_uint32_code [code_unfold]: "drop_bit 1 x = (uint32_shiftr x 1)"
-  by (simp add: uint32_shiftr_def shiftr_eq_drop_bit)
+  by (simp add: uint32_shiftr_def)
 
 (* ******************************************************************************** *)
 subsubsection \<open>Transfer Relation\<close>
 locale mod_ring_locale =
   fixes p :: int and ty :: "'a :: nontriv itself"
   assumes p: "p = int CARD('a)"
 begin
 lemma nat_p: "nat p = CARD('a)" unfolding p by simp
 lemma p2: "p \<ge> 2" unfolding p using nontriv[where 'a = 'a] by auto
 lemma p2_ident: "int (CARD('a) - 2) = p - 2" using p2 unfolding p by simp
 
 definition mod_ring_rel :: "int \<Rightarrow> 'a mod_ring \<Rightarrow> bool" where
   "mod_ring_rel x x' = (x = to_int_mod_ring x')"
 
 (* domain transfer rules *)
 lemma Domainp_mod_ring_rel [transfer_domain_rule]:
   "Domainp (mod_ring_rel) = (\<lambda> v. v \<in> {0 ..< p})"
 proof -
   {
     fix v :: int
     assume *: "0 \<le> v" "v < p"
     have "Domainp mod_ring_rel v"
     proof
       show "mod_ring_rel v (of_int_mod_ring v)" unfolding mod_ring_rel_def using * p by auto
     qed
   } note * = this
   show ?thesis
     by (intro ext iffI, insert range_to_int_mod_ring[where 'a = 'a] *, auto simp: mod_ring_rel_def p)
 qed
 
 (* left/right/bi-unique *)
 lemma bi_unique_mod_ring_rel [transfer_rule]:
   "bi_unique mod_ring_rel" "left_unique mod_ring_rel" "right_unique mod_ring_rel"
   unfolding mod_ring_rel_def bi_unique_def left_unique_def right_unique_def
   by auto
 
 (* left/right-total *)
 lemma right_total_mod_ring_rel [transfer_rule]: "right_total mod_ring_rel"
   unfolding mod_ring_rel_def right_total_def by simp
 
 
 (* ************************************************************************************ *)
 subsubsection \<open>Transfer Rules\<close>
 
 (* 0 / 1 *)
 lemma mod_ring_0[transfer_rule]: "mod_ring_rel 0 0" unfolding mod_ring_rel_def by simp
 lemma mod_ring_1[transfer_rule]: "mod_ring_rel 1 1" unfolding mod_ring_rel_def by simp
 
 (* addition *)
 lemma plus_p_mod_def: assumes x: "x \<in> {0 ..< p}" and y: "y \<in> {0 ..< p}"
   shows "plus_p p x y = ((x + y) mod p)"
 proof (cases "p \<le> x + y")
   case False
   thus ?thesis using x y unfolding plus_p_def Let_def by auto
 next
   case True
   from True x y have *: "p > 0" "0 \<le> x + y - p" "x + y - p < p" by auto
   from True have id: "plus_p p x y = x + y - p" unfolding plus_p_def by auto
   show ?thesis unfolding id using * using mod_pos_pos_trivial by fastforce
 qed
 
 lemma mod_ring_plus[transfer_rule]: "(mod_ring_rel ===> mod_ring_rel ===> mod_ring_rel) (plus_p p) (+)"
 proof -
   {
     fix x y :: "'a mod_ring"
     have "plus_p p (to_int_mod_ring x) (to_int_mod_ring y) = to_int_mod_ring (x + y)"
       by (transfer, subst plus_p_mod_def, auto, auto simp: p)
   } note * = this
   show ?thesis
     by (intro rel_funI, auto simp: mod_ring_rel_def *)
 qed
 
 (* subtraction *)
 lemma minus_p_mod_def: assumes x: "x \<in> {0 ..< p}" and y: "y \<in> {0 ..< p}"
   shows "minus_p p x y = ((x - y) mod p)"
 proof (cases "x - y < 0")
   case False
   thus ?thesis using x y unfolding minus_p_def Let_def by auto
 next
   case True
   from True x y have *: "p > 0" "0 \<le> x - y + p" "x - y + p < p" by auto
   from True have id: "minus_p p x y = x - y + p" unfolding minus_p_def by auto
   show ?thesis unfolding id using * using mod_pos_pos_trivial by fastforce
 qed
 
 lemma mod_ring_minus[transfer_rule]: "(mod_ring_rel ===> mod_ring_rel ===> mod_ring_rel) (minus_p p) (-)"
 proof -
   {
     fix x y :: "'a mod_ring"
     have "minus_p p (to_int_mod_ring x) (to_int_mod_ring y) = to_int_mod_ring (x - y)"
       by (transfer, subst minus_p_mod_def, auto simp: p)
   } note * = this
   show ?thesis
     by (intro rel_funI, auto simp: mod_ring_rel_def *)
 qed
 
 (* unary minus *)
 lemma mod_ring_uminus[transfer_rule]: "(mod_ring_rel ===> mod_ring_rel) (uminus_p p) uminus"
 proof -
   {
     fix x :: "'a mod_ring"
     have "uminus_p p (to_int_mod_ring x) = to_int_mod_ring (uminus x)"
       by (transfer, auto simp: uminus_p_def p)
   } note * = this
   show ?thesis
     by (intro rel_funI, auto simp: mod_ring_rel_def *)
 qed
 
 (* multiplication *)
 lemma mod_ring_mult[transfer_rule]: "(mod_ring_rel ===> mod_ring_rel ===> mod_ring_rel) (mult_p p) ((*))"
 proof -
   {
     fix x y :: "'a mod_ring"
     have "mult_p p (to_int_mod_ring x) (to_int_mod_ring y) = to_int_mod_ring (x * y)"
       by (transfer, auto simp: mult_p_def p)
   } note * = this
   show ?thesis
     by (intro rel_funI, auto simp: mod_ring_rel_def *)
 qed
 
 (* equality *)
 lemma mod_ring_eq[transfer_rule]: "(mod_ring_rel ===> mod_ring_rel ===> (=)) (=) (=)"
   by (intro rel_funI, auto simp: mod_ring_rel_def)
 
 (* power *)
 lemma mod_ring_power[transfer_rule]: "(mod_ring_rel ===> (=) ===> mod_ring_rel) (power_p p) (^)"
 proof (intro rel_funI, clarify, unfold binary_power[symmetric], goal_cases)
   fix x y n
   assume xy: "mod_ring_rel x y"
   from xy show "mod_ring_rel (power_p p x n) (binary_power y n)"
   proof (induct y n arbitrary: x rule: binary_power.induct)
     case (1 x n y)
     note 1(2)[transfer_rule]
     show ?case
     proof (cases "n = 0")
       case True
       thus ?thesis by (simp add: mod_ring_1)
     next
       case False
       obtain d r where id: "Divides.divmod_nat n 2 = (d,r)" by force
       let ?int = "power_p p (mult_p p y y) d"
       let ?gfp = "binary_power (x * x) d"
       from False have id': "?thesis = (mod_ring_rel
          (if r = 0 then ?int else mult_p p ?int y)
          (if r = 0 then ?gfp else ?gfp * x))"
         unfolding power_p.simps[of _ _ n] binary_power.simps[of _ n] Let_def id split by simp
       have [transfer_rule]: "mod_ring_rel ?int ?gfp"
         by (rule 1(1)[OF False refl id[symmetric]], transfer_prover)
       show ?thesis unfolding id' by transfer_prover
     qed
   qed
 qed
 
 declare power_p.simps[simp del]
 
 lemma ring_finite_field_ops_int: "ring_ops (finite_field_ops_int p) mod_ring_rel"
   by (unfold_locales, auto simp:
   finite_field_ops_int_def
   bi_unique_mod_ring_rel
   right_total_mod_ring_rel
   mod_ring_plus
   mod_ring_minus
   mod_ring_uminus
   mod_ring_mult
   mod_ring_eq
   mod_ring_0
   mod_ring_1
   Domainp_mod_ring_rel)
 end
 
 locale prime_field = mod_ring_locale p ty for p and ty :: "'a :: prime_card itself"
 begin
 
 lemma prime: "prime p" unfolding p using prime_card[where 'a = 'a] by simp
 
 (* mod *)
 lemma mod_ring_mod[transfer_rule]:
  "(mod_ring_rel ===> mod_ring_rel ===> mod_ring_rel) ((\<lambda> x y. if y = 0 then x else 0)) (mod)"
 proof -
   {
     fix x y :: "'a mod_ring"
     have "(if to_int_mod_ring y = 0 then to_int_mod_ring x else 0) = to_int_mod_ring (x mod y)"
       unfolding modulo_mod_ring_def by auto
   } note * = this
   show ?thesis
     by (intro rel_funI, auto simp: mod_ring_rel_def *[symmetric])
 qed
 
 (* normalize *)
 lemma mod_ring_normalize[transfer_rule]: "(mod_ring_rel ===> mod_ring_rel) ((\<lambda> x. if x = 0 then 0 else 1)) normalize"
 proof -
   {
     fix x :: "'a mod_ring"
     have "(if to_int_mod_ring x = 0 then 0 else 1) = to_int_mod_ring (normalize x)"
       unfolding normalize_mod_ring_def by auto
   } note * = this
   show ?thesis
     by (intro rel_funI, auto simp: mod_ring_rel_def *[symmetric])
 qed
 
 (* unit_factor *)
 lemma mod_ring_unit_factor[transfer_rule]: "(mod_ring_rel ===> mod_ring_rel) (\<lambda> x. x) unit_factor"
 proof -
   {
     fix x :: "'a mod_ring"
     have "to_int_mod_ring x = to_int_mod_ring (unit_factor x)"
       unfolding unit_factor_mod_ring_def by auto
   } note * = this
   show ?thesis
     by (intro rel_funI, auto simp: mod_ring_rel_def *[symmetric])
 qed
 
 (* inverse *)
 lemma mod_ring_inverse[transfer_rule]: "(mod_ring_rel ===> mod_ring_rel) (inverse_p p) inverse"
 proof (intro rel_funI)
   fix x y
   assume [transfer_rule]: "mod_ring_rel x y"
   show "mod_ring_rel (inverse_p p x) (inverse y)"
     unfolding inverse_p_def inverse_mod_ring_def
     apply (transfer_prover_start)
     apply (transfer_step)+
     apply (unfold p2_ident)
     apply (rule refl)
     done
 qed
 
 (* division *)
 lemma mod_ring_divide[transfer_rule]: "(mod_ring_rel ===> mod_ring_rel ===> mod_ring_rel)
   (divide_p p) (/)"
   unfolding divide_p_def[abs_def] divide_mod_ring_def[abs_def] inverse_mod_ring_def[symmetric]
   by transfer_prover
 
 lemma mod_ring_rel_unsafe: assumes "x < CARD('a)"
   shows "mod_ring_rel (int x) (of_nat x)" "0 < x \<Longrightarrow> of_nat x \<noteq> (0 :: 'a mod_ring)"
 proof -
   have id: "of_nat x = (of_int (int x) :: 'a mod_ring)" by simp
   show "mod_ring_rel (int x) (of_nat x)" "0 < x \<Longrightarrow> of_nat x \<noteq> (0 :: 'a mod_ring)" unfolding id
   unfolding mod_ring_rel_def
   proof (auto simp add: assms of_int_of_int_mod_ring)
     assume "0 < x" with assms
     have "of_int_mod_ring (int x) \<noteq> (0 :: 'a mod_ring)"
       by (metis (no_types) less_imp_of_nat_less less_irrefl of_nat_0_le_iff of_nat_0_less_iff to_int_mod_ring_hom.hom_zero to_int_mod_ring_of_int_mod_ring)
     thus "of_int_mod_ring (int x) = (0 :: 'a mod_ring) \<Longrightarrow> False" by blast
   qed
 qed
 
 lemma finite_field_ops_int: "field_ops (finite_field_ops_int p) mod_ring_rel"
   by (unfold_locales, auto simp:
   finite_field_ops_int_def
   bi_unique_mod_ring_rel
   right_total_mod_ring_rel
   mod_ring_divide
   mod_ring_plus
   mod_ring_minus
   mod_ring_uminus
   mod_ring_inverse
   mod_ring_mod
   mod_ring_unit_factor
   mod_ring_normalize
   mod_ring_mult
   mod_ring_eq
   mod_ring_0
   mod_ring_1
   Domainp_mod_ring_rel)
 
 end
 
 text \<open>Once we have proven the soundness of the implementation, we do not care any longer
   that @{typ "'a mod_ring"} has been defined internally via lifting. Disabling the transfer-rules
   will hide the internal definition in further applications of transfer.\<close>
 lifting_forget mod_ring.lifting
 
 text \<open>For soundness of the 32-bit implementation, we mainly prove that this implementation
   implements the int-based implementation of the mod-ring.\<close>
 context mod_ring_locale
 begin
 
 context fixes pp :: "uint32" 
   assumes ppp: "p = int_of_uint32 pp" 
   and small: "p \<le> 65535" 
 begin
 
 lemmas uint32_simps = 
   int_of_uint32_0
   int_of_uint32_plus 
   int_of_uint32_minus
   int_of_uint32_mult
   
 
 definition urel32 :: "uint32 \<Rightarrow> int \<Rightarrow> bool" where "urel32 x y = (y = int_of_uint32 x \<and> y < p)" 
 
 definition mod_ring_rel32 :: "uint32 \<Rightarrow> 'a mod_ring \<Rightarrow> bool" where
   "mod_ring_rel32 x y = (\<exists> z. urel32 x z \<and> mod_ring_rel z y)" 
 
 lemma urel32_0: "urel32 0 0" unfolding urel32_def using p2 by (simp, transfer, simp)
 
 lemma urel32_1: "urel32 1 1" unfolding urel32_def using p2 by (simp, transfer, simp)
 
 lemma le_int_of_uint32: "(x \<le> y) = (int_of_uint32 x \<le> int_of_uint32 y)" 
   by (transfer, simp add: word_le_def)
 
 lemma urel32_plus: assumes "urel32 x y" "urel32 x' y'"
   shows "urel32 (plus_p32 pp x x') (plus_p p y y')"
 proof -    
   let ?x = "int_of_uint32 x" 
   let ?x' = "int_of_uint32 x'" 
   let ?p = "int_of_uint32 pp" 
   from assms int_of_uint32_ge_0 have id: "y = ?x" "y' = ?x'" 
     and rel: "0 \<le> ?x" "?x < p" 
       "0 \<le> ?x'" "?x' \<le> p" unfolding urel32_def by auto
   have le: "(pp \<le> x + x') = (?p \<le> ?x + ?x')" unfolding le_int_of_uint32
     using rel small by (auto simp: uint32_simps)
   show ?thesis
   proof (cases "?p \<le> ?x + ?x'")
     case True
     hence True: "(?p \<le> ?x + ?x') = True" by simp
     show ?thesis unfolding id 
       using small rel unfolding plus_p32_def plus_p_def Let_def urel32_def 
       unfolding ppp le True if_True
       using True by (auto simp: uint32_simps)
   next
     case False
     hence False: "(?p \<le> ?x + ?x') = False" by simp
     show ?thesis unfolding id 
       using small rel unfolding plus_p32_def plus_p_def Let_def urel32_def 
       unfolding ppp le False if_False
       using False by (auto simp: uint32_simps)
   qed
 qed
   
 lemma urel32_minus: assumes "urel32 x y" "urel32 x' y'"
   shows "urel32 (minus_p32 pp x x') (minus_p p y y')"
 proof -    
   let ?x = "int_of_uint32 x" 
   let ?x' = "int_of_uint32 x'" 
   from assms int_of_uint32_ge_0 have id: "y = ?x" "y' = ?x'" 
     and rel: "0 \<le> ?x" "?x < p" 
       "0 \<le> ?x'" "?x' \<le> p" unfolding urel32_def by auto
   have le: "(x' \<le> x) = (?x' \<le> ?x)" unfolding le_int_of_uint32
     using rel small by (auto simp: uint32_simps)
   show ?thesis
   proof (cases "?x' \<le> ?x")
     case True
     hence True: "(?x' \<le> ?x) = True" by simp
     show ?thesis unfolding id 
       using small rel unfolding minus_p32_def minus_p_def Let_def urel32_def 
       unfolding ppp le True if_True
       using True by (auto simp: uint32_simps)
   next
     case False
     hence False: "(?x' \<le> ?x) = False" by simp
     show ?thesis unfolding id 
       using small rel unfolding minus_p32_def minus_p_def Let_def urel32_def 
       unfolding ppp le False if_False
       using False by (auto simp: uint32_simps)
   qed
 qed
 
 lemma urel32_uminus: assumes "urel32 x y"
   shows "urel32 (uminus_p32 pp x) (uminus_p p y)"
 proof -    
   let ?x = "int_of_uint32 x"  
   from assms int_of_uint32_ge_0 have id: "y = ?x" 
     and rel: "0 \<le> ?x" "?x < p" 
       unfolding urel32_def by auto
   have le: "(x = 0) = (?x = 0)" unfolding int_of_uint32_0_iff
     using rel small by (auto simp: uint32_simps)
   show ?thesis
   proof (cases "?x = 0")
     case True
     hence True: "(?x = 0) = True" by simp
     show ?thesis unfolding id 
       using small rel unfolding uminus_p32_def uminus_p_def Let_def urel32_def 
       unfolding ppp le True if_True
       using True by (auto simp: uint32_simps)
   next
     case False
     hence False: "(?x = 0) = False" by simp
     show ?thesis unfolding id 
       using small rel unfolding uminus_p32_def uminus_p_def Let_def urel32_def 
       unfolding ppp le False if_False
       using False by (auto simp: uint32_simps)
   qed
 qed
 
 lemma urel32_mult: assumes "urel32 x y" "urel32 x' y'"
   shows "urel32 (mult_p32 pp x x') (mult_p p y y')"
 proof -    
   let ?x = "int_of_uint32 x" 
   let ?x' = "int_of_uint32 x'" 
   from assms int_of_uint32_ge_0 have id: "y = ?x" "y' = ?x'" 
     and rel: "0 \<le> ?x" "?x < p" 
       "0 \<le> ?x'" "?x' < p" unfolding urel32_def by auto
   from rel have "?x * ?x' < p * p" by (metis mult_strict_mono') 
   also have "\<dots> \<le> 65536 * 65536"
     by (rule mult_mono, insert p2 small, auto)
   finally have le: "?x * ?x' < 4294967296" by simp
   show ?thesis unfolding id
       using small rel unfolding mult_p32_def mult_p_def Let_def urel32_def 
       unfolding ppp 
     by (auto simp: uint32_simps, unfold int_of_uint32_mod int_of_uint32_mult, 
         subst mod_pos_pos_trivial[of _ 4294967296], insert le, auto)
 qed
 
 lemma urel32_eq: assumes "urel32 x y" "urel32 x' y'" 
   shows "(x = x') = (y = y')" 
 proof -    
   let ?x = "int_of_uint32 x" 
   let ?x' = "int_of_uint32 x'" 
   from assms int_of_uint32_ge_0 have id: "y = ?x" "y' = ?x'" 
     unfolding urel32_def by auto
   show ?thesis unfolding id by (transfer, transfer) rule
 qed
 
 lemma urel32_normalize: 
 assumes x: "urel32 x y"
 shows "urel32 (if x = 0 then 0 else 1) (if y = 0 then 0 else 1)"
  unfolding urel32_eq[OF x urel32_0] using urel32_0 urel32_1 by auto
 
 lemma urel32_mod: 
 assumes x: "urel32 x x'" and y: "urel32 y y'" 
 shows "urel32 (if y = 0 then x else 0) (if y' = 0 then x' else 0)"
   unfolding urel32_eq[OF y urel32_0] using urel32_0 x by auto 
 
 lemma urel32_power: "urel32 x x' \<Longrightarrow> urel32 y (int y') \<Longrightarrow> urel32 (power_p32 pp x y) (power_p p x' y')"
 proof (induct x' y' arbitrary: x y rule: power_p.induct[of _ p])
   case (1 x' y' x y)
   note x = 1(2) note y = 1(3)
   show ?case
   proof (cases "y' = 0")
     case True
     hence y: "y = 0" using urel32_eq[OF y urel32_0] by auto
     show ?thesis unfolding y True by (simp add: power_p.simps urel32_1)
   next
     case False
     hence id: "(y = 0) = False" "(y' = 0) = False" using urel32_eq[OF y urel32_0] by auto
     obtain d' r' where dr': "Divides.divmod_nat y' 2 = (d',r')" by force
     from divmod_nat_def[of y' 2, unfolded dr']
     have r': "r' = y' mod 2" and d': "d' = y' div 2" by auto
     have "urel32 (y AND 1) r'"
       unfolding r'
       using y
       unfolding urel32_def
       using small
       apply (simp add: ppp and_one_eq)
       apply transfer
       apply transfer
       apply (auto simp add: zmod_int take_bit_int_eq_self)
       apply (rule le_less_trans)
        apply (rule zmod_le_nonneg_dividend)
       apply simp_all
       done
     from urel32_eq[OF this urel32_0]     
     have rem: "(y AND 1 = 0) = (r' = 0)" by simp
-    have div: "urel32 (shiftr y 1) (int d')" unfolding d' using y unfolding urel32_def using small
+    have div: "urel32 (drop_bit 1 y) (int d')" unfolding d' using y unfolding urel32_def using small
       unfolding ppp 
       apply transfer
       apply transfer
       apply (auto simp add: drop_bit_Suc)
       done
     note IH = 1(1)[OF False refl dr'[symmetric] urel32_mult[OF x x] div]
     show ?thesis unfolding power_p.simps[of _ _ "y'"] power_p32.simps[of _ _ y] dr' id if_False rem
       using IH urel32_mult[OF IH x] by (auto simp: Let_def)
   qed
 qed
   
 
 lemma urel32_inverse: assumes x: "urel32 x x'" 
   shows "urel32 (inverse_p32 pp x) (inverse_p p x')" 
 proof -
   have p: "urel32 (pp - 2) (int (nat (p - 2)))" using p2 small unfolding urel32_def unfolding ppp
     by (transfer, auto simp: uint_word_ariths)
   show ?thesis
     unfolding inverse_p32_def inverse_p_def urel32_eq[OF x urel32_0] using urel32_0 urel32_power[OF x p]
     by auto
 qed
 
 lemma mod_ring_0_32: "mod_ring_rel32 0 0"
   using urel32_0 mod_ring_0 unfolding mod_ring_rel32_def by blast
 
 lemma mod_ring_1_32: "mod_ring_rel32 1 1"
   using urel32_1 mod_ring_1 unfolding mod_ring_rel32_def by blast
 
 lemma mod_ring_uminus32: "(mod_ring_rel32 ===> mod_ring_rel32) (uminus_p32 pp) uminus"
   using urel32_uminus mod_ring_uminus unfolding mod_ring_rel32_def rel_fun_def by blast
 
 lemma mod_ring_plus32: "(mod_ring_rel32 ===> mod_ring_rel32 ===> mod_ring_rel32) (plus_p32 pp) (+)"
   using urel32_plus mod_ring_plus unfolding mod_ring_rel32_def rel_fun_def by blast
 
 lemma mod_ring_minus32: "(mod_ring_rel32 ===> mod_ring_rel32 ===> mod_ring_rel32) (minus_p32 pp) (-)"
   using urel32_minus mod_ring_minus unfolding mod_ring_rel32_def rel_fun_def by blast
 
 lemma mod_ring_mult32: "(mod_ring_rel32 ===> mod_ring_rel32 ===> mod_ring_rel32) (mult_p32 pp) ((*))"
   using urel32_mult mod_ring_mult unfolding mod_ring_rel32_def rel_fun_def by blast
 
 lemma mod_ring_eq32: "(mod_ring_rel32 ===> mod_ring_rel32 ===> (=)) (=) (=)" 
   using urel32_eq mod_ring_eq unfolding mod_ring_rel32_def rel_fun_def by blast
 
 lemma urel32_inj: "urel32 x y \<Longrightarrow> urel32 x z \<Longrightarrow> y = z" 
   using urel32_eq[of x y x z] by auto
 
 lemma urel32_inj': "urel32 x z \<Longrightarrow> urel32 y z \<Longrightarrow> x = y" 
   using urel32_eq[of x z y z] by auto
 
 lemma bi_unique_mod_ring_rel32:
   "bi_unique mod_ring_rel32" "left_unique mod_ring_rel32" "right_unique mod_ring_rel32"
   using bi_unique_mod_ring_rel urel32_inj'
   unfolding mod_ring_rel32_def bi_unique_def left_unique_def right_unique_def
   by (auto simp: urel32_def)  
 
 lemma right_total_mod_ring_rel32: "right_total mod_ring_rel32"
   unfolding mod_ring_rel32_def right_total_def
 proof 
   fix y :: "'a mod_ring" 
   from right_total_mod_ring_rel[unfolded right_total_def, rule_format, of y]
   obtain z where zy: "mod_ring_rel z y" by auto  
   hence zp: "0 \<le> z" "z < p" unfolding mod_ring_rel_def p using range_to_int_mod_ring[where 'a = 'a] by auto
   hence "urel32 (uint32_of_int z) z" unfolding urel32_def using small unfolding ppp 
     by (auto simp: int_of_uint32_inv) 
   with zy show "\<exists> x z. urel32 x z \<and> mod_ring_rel z y" by blast
 qed
 
 lemma Domainp_mod_ring_rel32: "Domainp mod_ring_rel32 = (\<lambda>x. 0 \<le> x \<and> x < pp)"
 proof 
   fix x
   show "Domainp mod_ring_rel32 x = (0 \<le> x \<and> x < pp)"   
     unfolding Domainp.simps
     unfolding mod_ring_rel32_def
   proof
     let ?i = "int_of_uint32" 
     assume *: "0 \<le> x \<and> x < pp"     
     hence "0 \<le> ?i x \<and> ?i x < p" using small unfolding ppp
       by (transfer, auto simp: word_less_def)
     hence "?i x \<in> {0 ..< p}" by auto
     with Domainp_mod_ring_rel
     have "Domainp mod_ring_rel (?i x)" by auto
     from this[unfolded Domainp.simps]
     obtain b where b: "mod_ring_rel (?i x) b" by auto
     show "\<exists>a b. x = a \<and> (\<exists>z. urel32 a z \<and> mod_ring_rel z b)" 
     proof (intro exI, rule conjI[OF refl], rule exI, rule conjI[OF _ b])
       show "urel32 x (?i x)" unfolding urel32_def using small * unfolding ppp
         by (transfer, auto simp: word_less_def)
     qed
   next
     assume "\<exists>a b. x = a \<and> (\<exists>z. urel32 a z \<and> mod_ring_rel z b)" 
     then obtain b z where xz: "urel32 x z" and zb: "mod_ring_rel z b" by auto
     hence "Domainp mod_ring_rel z"  by auto
     with Domainp_mod_ring_rel have "0 \<le> z" "z < p" by auto
     with xz show "0 \<le> x \<and> x < pp" unfolding urel32_def using small unfolding ppp
       by (transfer, auto simp: word_less_def)
   qed
 qed
 
 lemma ring_finite_field_ops32: "ring_ops (finite_field_ops32 pp) mod_ring_rel32"
   by (unfold_locales, auto simp:
   finite_field_ops32_def
   bi_unique_mod_ring_rel32
   right_total_mod_ring_rel32
   mod_ring_plus32
   mod_ring_minus32
   mod_ring_uminus32
   mod_ring_mult32
   mod_ring_eq32
   mod_ring_0_32
   mod_ring_1_32
   Domainp_mod_ring_rel32)
 end
 end
 
 context prime_field
 begin
 context fixes pp :: "uint32" 
   assumes *: "p = int_of_uint32 pp" "p \<le> 65535" 
 begin
 
 lemma mod_ring_normalize32: "(mod_ring_rel32 ===> mod_ring_rel32) (\<lambda>x. if x = 0 then 0 else 1) normalize" 
   using urel32_normalize[OF *] mod_ring_normalize unfolding mod_ring_rel32_def[OF *] rel_fun_def by blast
 
 lemma mod_ring_mod32: "(mod_ring_rel32 ===> mod_ring_rel32 ===> mod_ring_rel32) (\<lambda>x y. if y = 0 then x else 0) (mod)" 
   using urel32_mod[OF *] mod_ring_mod unfolding mod_ring_rel32_def[OF *] rel_fun_def by blast
 
 lemma mod_ring_unit_factor32: "(mod_ring_rel32 ===> mod_ring_rel32) (\<lambda>x. x) unit_factor" 
   using mod_ring_unit_factor unfolding mod_ring_rel32_def[OF *] rel_fun_def by blast
 
 lemma mod_ring_inverse32: "(mod_ring_rel32 ===> mod_ring_rel32) (inverse_p32 pp) inverse"
   using urel32_inverse[OF *] mod_ring_inverse unfolding mod_ring_rel32_def[OF *] rel_fun_def by blast
 
 lemma mod_ring_divide32: "(mod_ring_rel32 ===> mod_ring_rel32 ===> mod_ring_rel32) (divide_p32 pp) (/)"
   using mod_ring_inverse32 mod_ring_mult32[OF *]
   unfolding divide_p32_def divide_mod_ring_def inverse_mod_ring_def[symmetric]
     rel_fun_def by blast
 
 lemma finite_field_ops32: "field_ops (finite_field_ops32 pp) mod_ring_rel32"
   by (unfold_locales, insert ring_finite_field_ops32[OF *], auto simp:
   ring_ops_def
   finite_field_ops32_def
   mod_ring_divide32
   mod_ring_inverse32
   mod_ring_mod32
   mod_ring_normalize32)
 
 end
 end
 
 (* now there is 64-bit time *)
 context
   fixes p :: uint64
 begin
 definition plus_p64 :: "uint64 \<Rightarrow> uint64 \<Rightarrow> uint64" where
   "plus_p64 x y \<equiv> let z = x + y in if z \<ge> p then z - p else z"
 
 definition minus_p64 :: "uint64 \<Rightarrow> uint64 \<Rightarrow> uint64" where
   "minus_p64 x y \<equiv> if y \<le> x then x - y else (x + p) - y"
 
 definition uminus_p64 :: "uint64 \<Rightarrow> uint64" where
   "uminus_p64 x = (if x = 0 then 0 else p - x)"
 
 definition mult_p64 :: "uint64 \<Rightarrow> uint64 \<Rightarrow> uint64" where
   "mult_p64 x y = (x * y mod p)"
 
-lemma int_of_uint64_shift: "int_of_uint64 (shiftr n k) = (int_of_uint64 n) div (2 ^ k)" 
+lemma int_of_uint64_shift: "int_of_uint64 (drop_bit k n) = (int_of_uint64 n) div (2 ^ k)" 
   apply transfer
   apply transfer
   apply (simp add: take_bit_drop_bit min_def)
   apply (simp add: drop_bit_eq_div)
   done
 
 lemma int_of_uint64_0_iff: "int_of_uint64 n = 0 \<longleftrightarrow> n = 0" 
   by (transfer, rule uint_0_iff)
   
 lemma int_of_uint64_0: "int_of_uint64 0 = 0" unfolding int_of_uint64_0_iff by simp
 
 lemma int_of_uint64_ge_0: "int_of_uint64 n \<ge> 0" 
   by (transfer, auto)
 
 lemma two_64: "2 ^ LENGTH(64) = (18446744073709551616 :: int)" by simp
 
 lemma int_of_uint64_plus: "int_of_uint64 (x + y) = (int_of_uint64 x + int_of_uint64 y) mod 18446744073709551616" 
   by (transfer, unfold uint_word_ariths two_64, rule refl)  
 
 lemma int_of_uint64_minus: "int_of_uint64 (x - y) = (int_of_uint64 x - int_of_uint64 y) mod 18446744073709551616" 
   by (transfer, unfold uint_word_ariths two_64, rule refl)  
 
 lemma int_of_uint64_mult: "int_of_uint64 (x * y) = (int_of_uint64 x * int_of_uint64 y) mod 18446744073709551616" 
   by (transfer, unfold uint_word_ariths two_64, rule refl)  
 
 lemma int_of_uint64_mod: "int_of_uint64 (x mod y) = (int_of_uint64 x mod int_of_uint64 y)" 
   by (transfer, unfold uint_mod two_64, rule refl)  
 
 lemma int_of_uint64_inv: "0 \<le> x \<Longrightarrow> x < 18446744073709551616 \<Longrightarrow> int_of_uint64 (uint64_of_int x) = x"
   by transfer (simp add: take_bit_int_eq_self)
 
 function power_p64 :: "uint64 \<Rightarrow> uint64 \<Rightarrow> uint64" where
   "power_p64 x n = (if n = 0 then 1 else
-    let rec = power_p64 (mult_p64 x x) (shiftr n 1) in
+    let rec = power_p64 (mult_p64 x x) (drop_bit 1 n) in
     if n AND 1 = 0 then rec else mult_p64 rec x)"
   by pat_completeness auto
 
 termination 
 proof -
   {
     fix n :: uint64
     assume "n \<noteq> 0" 
     with int_of_uint64_ge_0[of n] int_of_uint64_0_iff[of n] have "int_of_uint64 n > 0" by auto
     hence "0 < int_of_uint64 n" "int_of_uint64 n div 2 < int_of_uint64 n" by auto
   } note * = this
   show ?thesis
     by (relation "measure (\<lambda> (x,n). nat (int_of_uint64 n))", auto simp: int_of_uint64_shift *) 
 qed
 
 text \<open>In experiments with Berlekamp-factorization (where the prime $p$ is usually small),
   it turned out that taking the below implementation of inverse via exponentiation
   is faster than the one based on the extended Euclidean algorithm.\<close>
 
 definition inverse_p64 :: "uint64 \<Rightarrow> uint64" where
   "inverse_p64 x = (if x = 0 then 0 else power_p64 x (p - 2))"
 
 definition divide_p64 :: "uint64 \<Rightarrow> uint64 \<Rightarrow> uint64"  where
   "divide_p64 x y = mult_p64 x (inverse_p64 y)"
 
 definition finite_field_ops64 :: "uint64 arith_ops_record" where
   "finite_field_ops64 \<equiv> Arith_Ops_Record
       0
       1
       plus_p64
       mult_p64
       minus_p64
       uminus_p64
       divide_p64
       inverse_p64
       (\<lambda> x y . if y = 0 then x else 0)
       (\<lambda> x . if x = 0 then 0 else 1)
       (\<lambda> x . x)
       uint64_of_int
       int_of_uint64
       (\<lambda> x. 0 \<le> x \<and> x < p)"
 end 
 
 lemma shiftr_uint64_code [code_unfold]: "drop_bit 1 x = (uint64_shiftr x 1)"
   by (simp add: uint64_shiftr_def)
 
 text \<open>For soundness of the 64-bit implementation, we mainly prove that this implementation
   implements the int-based implementation of GF(p).\<close>
 context mod_ring_locale
 begin
 
 context fixes pp :: "uint64" 
   assumes ppp: "p = int_of_uint64 pp" 
   and small: "p \<le> 4294967295" 
 begin
 
 lemmas uint64_simps = 
   int_of_uint64_0
   int_of_uint64_plus 
   int_of_uint64_minus
   int_of_uint64_mult
   
 
 definition urel64 :: "uint64 \<Rightarrow> int \<Rightarrow> bool" where "urel64 x y = (y = int_of_uint64 x \<and> y < p)" 
 
 definition mod_ring_rel64 :: "uint64 \<Rightarrow> 'a mod_ring \<Rightarrow> bool" where
   "mod_ring_rel64 x y = (\<exists> z. urel64 x z \<and> mod_ring_rel z y)" 
 
 lemma urel64_0: "urel64 0 0" unfolding urel64_def using p2 by (simp, transfer, simp)
 
 lemma urel64_1: "urel64 1 1" unfolding urel64_def using p2 by (simp, transfer, simp)
 
 lemma le_int_of_uint64: "(x \<le> y) = (int_of_uint64 x \<le> int_of_uint64 y)" 
   by (transfer, simp add: word_le_def)
 
 lemma urel64_plus: assumes "urel64 x y" "urel64 x' y'"
   shows "urel64 (plus_p64 pp x x') (plus_p p y y')"
 proof -    
   let ?x = "int_of_uint64 x" 
   let ?x' = "int_of_uint64 x'" 
   let ?p = "int_of_uint64 pp" 
   from assms int_of_uint64_ge_0 have id: "y = ?x" "y' = ?x'" 
     and rel: "0 \<le> ?x" "?x < p" 
       "0 \<le> ?x'" "?x' \<le> p" unfolding urel64_def by auto
   have le: "(pp \<le> x + x') = (?p \<le> ?x + ?x')" unfolding le_int_of_uint64
     using rel small by (auto simp: uint64_simps)
   show ?thesis
   proof (cases "?p \<le> ?x + ?x'")
     case True
     hence True: "(?p \<le> ?x + ?x') = True" by simp
     show ?thesis unfolding id 
       using small rel unfolding plus_p64_def plus_p_def Let_def urel64_def 
       unfolding ppp le True if_True
       using True by (auto simp: uint64_simps)
   next
     case False
     hence False: "(?p \<le> ?x + ?x') = False" by simp
     show ?thesis unfolding id 
       using small rel unfolding plus_p64_def plus_p_def Let_def urel64_def 
       unfolding ppp le False if_False
       using False by (auto simp: uint64_simps)
   qed
 qed
   
 lemma urel64_minus: assumes "urel64 x y" "urel64 x' y'"
   shows "urel64 (minus_p64 pp x x') (minus_p p y y')"
 proof -    
   let ?x = "int_of_uint64 x" 
   let ?x' = "int_of_uint64 x'" 
   from assms int_of_uint64_ge_0 have id: "y = ?x" "y' = ?x'" 
     and rel: "0 \<le> ?x" "?x < p" 
       "0 \<le> ?x'" "?x' \<le> p" unfolding urel64_def by auto
   have le: "(x' \<le> x) = (?x' \<le> ?x)" unfolding le_int_of_uint64
     using rel small by (auto simp: uint64_simps)
   show ?thesis
   proof (cases "?x' \<le> ?x")
     case True
     hence True: "(?x' \<le> ?x) = True" by simp
     show ?thesis unfolding id 
       using small rel unfolding minus_p64_def minus_p_def Let_def urel64_def 
       unfolding ppp le True if_True
       using True by (auto simp: uint64_simps)
   next
     case False
     hence False: "(?x' \<le> ?x) = False" by simp
     show ?thesis unfolding id 
       using small rel unfolding minus_p64_def minus_p_def Let_def urel64_def 
       unfolding ppp le False if_False
       using False by (auto simp: uint64_simps)
   qed
 qed
 
 lemma urel64_uminus: assumes "urel64 x y"
   shows "urel64 (uminus_p64 pp x) (uminus_p p y)"
 proof -    
   let ?x = "int_of_uint64 x"  
   from assms int_of_uint64_ge_0 have id: "y = ?x" 
     and rel: "0 \<le> ?x" "?x < p" 
       unfolding urel64_def by auto
   have le: "(x = 0) = (?x = 0)" unfolding int_of_uint64_0_iff
     using rel small by (auto simp: uint64_simps)
   show ?thesis
   proof (cases "?x = 0")
     case True
     hence True: "(?x = 0) = True" by simp
     show ?thesis unfolding id 
       using small rel unfolding uminus_p64_def uminus_p_def Let_def urel64_def 
       unfolding ppp le True if_True
       using True by (auto simp: uint64_simps)
   next
     case False
     hence False: "(?x = 0) = False" by simp
     show ?thesis unfolding id 
       using small rel unfolding uminus_p64_def uminus_p_def Let_def urel64_def 
       unfolding ppp le False if_False
       using False by (auto simp: uint64_simps)
   qed
 qed
 
 lemma urel64_mult: assumes "urel64 x y" "urel64 x' y'"
   shows "urel64 (mult_p64 pp x x') (mult_p p y y')"
 proof -    
   let ?x = "int_of_uint64 x" 
   let ?x' = "int_of_uint64 x'" 
   from assms int_of_uint64_ge_0 have id: "y = ?x" "y' = ?x'" 
     and rel: "0 \<le> ?x" "?x < p" 
       "0 \<le> ?x'" "?x' < p" unfolding urel64_def by auto
   from rel have "?x * ?x' < p * p" by (metis mult_strict_mono') 
   also have "\<dots> \<le> 4294967296 * 4294967296"
     by (rule mult_mono, insert p2 small, auto)
   finally have le: "?x * ?x' < 18446744073709551616" by simp
   show ?thesis unfolding id
       using small rel unfolding mult_p64_def mult_p_def Let_def urel64_def 
       unfolding ppp 
     by (auto simp: uint64_simps, unfold int_of_uint64_mod int_of_uint64_mult, 
         subst mod_pos_pos_trivial[of _ 18446744073709551616], insert le, auto)
 qed
 
 lemma urel64_eq: assumes "urel64 x y" "urel64 x' y'" 
   shows "(x = x') = (y = y')" 
 proof -    
   let ?x = "int_of_uint64 x" 
   let ?x' = "int_of_uint64 x'" 
   from assms int_of_uint64_ge_0 have id: "y = ?x" "y' = ?x'" 
     unfolding urel64_def by auto
   show ?thesis unfolding id by (transfer, transfer) rule
 qed
 
 lemma urel64_normalize: 
 assumes x: "urel64 x y"
 shows "urel64 (if x = 0 then 0 else 1) (if y = 0 then 0 else 1)"
  unfolding urel64_eq[OF x urel64_0] using urel64_0 urel64_1 by auto
 
 lemma urel64_mod: 
 assumes x: "urel64 x x'" and y: "urel64 y y'" 
 shows "urel64 (if y = 0 then x else 0) (if y' = 0 then x' else 0)"
   unfolding urel64_eq[OF y urel64_0] using urel64_0 x by auto 
 
 lemma urel64_power: "urel64 x x' \<Longrightarrow> urel64 y (int y') \<Longrightarrow> urel64 (power_p64 pp x y) (power_p p x' y')"
 proof (induct x' y' arbitrary: x y rule: power_p.induct[of _ p])
   case (1 x' y' x y)
   note x = 1(2) note y = 1(3)
   show ?case
   proof (cases "y' = 0")
     case True
     hence y: "y = 0" using urel64_eq[OF y urel64_0] by auto
     show ?thesis unfolding y True by (simp add: power_p.simps urel64_1)
   next
     case False
     hence id: "(y = 0) = False" "(y' = 0) = False" using urel64_eq[OF y urel64_0] by auto
     obtain d' r' where dr': "Divides.divmod_nat y' 2 = (d',r')" by force
     from divmod_nat_def[of y' 2, unfolded dr']
     have r': "r' = y' mod 2" and d': "d' = y' div 2" by auto
     have "urel64 (y AND 1) r'"
       unfolding r'
       using y
       unfolding urel64_def
       using small
       apply (simp add: ppp and_one_eq)
       apply transfer apply transfer
       apply (auto simp add: int_eq_iff nat_take_bit_eq nat_mod_distrib zmod_int)
        apply (auto simp add: zmod_int mod_2_eq_odd)
       apply (auto simp add: less_le)
         apply (auto simp add: le_less)
        apply (metis linorder_neqE_linordered_idom mod_pos_pos_trivial not_take_bit_negative power_0 take_bit_0 take_bit_eq_mod take_bit_nonnegative)
       apply (metis even_take_bit_eq mod_pos_pos_trivial neq0_conv numeral_eq_Suc power_0 take_bit_eq_mod take_bit_nonnegative zero_less_Suc)
       done
     from urel64_eq[OF this urel64_0]     
     have rem: "(y AND 1 = 0) = (r' = 0)" by simp
-    have div: "urel64 (shiftr y 1) (int d')" unfolding d' using y unfolding urel64_def using small
+    have div: "urel64 (drop_bit 1 y) (int d')" unfolding d' using y unfolding urel64_def using small
       unfolding ppp
       apply transfer
       apply transfer
       apply (auto simp add: drop_bit_Suc)
       done
     note IH = 1(1)[OF False refl dr'[symmetric] urel64_mult[OF x x] div]
     show ?thesis unfolding power_p.simps[of _ _ "y'"] power_p64.simps[of _ _ y] dr' id if_False rem
       using IH urel64_mult[OF IH x] by (auto simp: Let_def)
   qed
 qed
   
 
 lemma urel64_inverse: assumes x: "urel64 x x'" 
   shows "urel64 (inverse_p64 pp x) (inverse_p p x')" 
 proof -
   have p: "urel64 (pp - 2) (int (nat (p - 2)))" using p2 small unfolding urel64_def unfolding ppp
     by (transfer, auto simp: uint_word_ariths)
   show ?thesis
     unfolding inverse_p64_def inverse_p_def urel64_eq[OF x urel64_0] using urel64_0 urel64_power[OF x p]
     by auto
 qed
 
 lemma mod_ring_0_64: "mod_ring_rel64 0 0"
   using urel64_0 mod_ring_0 unfolding mod_ring_rel64_def by blast
 
 lemma mod_ring_1_64: "mod_ring_rel64 1 1"
   using urel64_1 mod_ring_1 unfolding mod_ring_rel64_def by blast
 
 lemma mod_ring_uminus64: "(mod_ring_rel64 ===> mod_ring_rel64) (uminus_p64 pp) uminus"
   using urel64_uminus mod_ring_uminus unfolding mod_ring_rel64_def rel_fun_def by blast
 
 lemma mod_ring_plus64: "(mod_ring_rel64 ===> mod_ring_rel64 ===> mod_ring_rel64) (plus_p64 pp) (+)"
   using urel64_plus mod_ring_plus unfolding mod_ring_rel64_def rel_fun_def by blast
 
 lemma mod_ring_minus64: "(mod_ring_rel64 ===> mod_ring_rel64 ===> mod_ring_rel64) (minus_p64 pp) (-)"
   using urel64_minus mod_ring_minus unfolding mod_ring_rel64_def rel_fun_def by blast
 
 lemma mod_ring_mult64: "(mod_ring_rel64 ===> mod_ring_rel64 ===> mod_ring_rel64) (mult_p64 pp) ((*))"
   using urel64_mult mod_ring_mult unfolding mod_ring_rel64_def rel_fun_def by blast
 
 lemma mod_ring_eq64: "(mod_ring_rel64 ===> mod_ring_rel64 ===> (=)) (=) (=)" 
   using urel64_eq mod_ring_eq unfolding mod_ring_rel64_def rel_fun_def by blast
 
 lemma urel64_inj: "urel64 x y \<Longrightarrow> urel64 x z \<Longrightarrow> y = z" 
   using urel64_eq[of x y x z] by auto
 
 lemma urel64_inj': "urel64 x z \<Longrightarrow> urel64 y z \<Longrightarrow> x = y" 
   using urel64_eq[of x z y z] by auto
 
 lemma bi_unique_mod_ring_rel64:
   "bi_unique mod_ring_rel64" "left_unique mod_ring_rel64" "right_unique mod_ring_rel64"
   using bi_unique_mod_ring_rel urel64_inj'
   unfolding mod_ring_rel64_def bi_unique_def left_unique_def right_unique_def
   by (auto simp: urel64_def)  
 
 lemma right_total_mod_ring_rel64: "right_total mod_ring_rel64"
   unfolding mod_ring_rel64_def right_total_def
 proof 
   fix y :: "'a mod_ring" 
   from right_total_mod_ring_rel[unfolded right_total_def, rule_format, of y]
   obtain z where zy: "mod_ring_rel z y" by auto  
   hence zp: "0 \<le> z" "z < p" unfolding mod_ring_rel_def p using range_to_int_mod_ring[where 'a = 'a] by auto
   hence "urel64 (uint64_of_int z) z" unfolding urel64_def using small unfolding ppp 
     by (auto simp: int_of_uint64_inv) 
   with zy show "\<exists> x z. urel64 x z \<and> mod_ring_rel z y" by blast
 qed
 
 lemma Domainp_mod_ring_rel64: "Domainp mod_ring_rel64 = (\<lambda>x. 0 \<le> x \<and> x < pp)"
 proof 
   fix x
   show "Domainp mod_ring_rel64 x = (0 \<le> x \<and> x < pp)"   
     unfolding Domainp.simps
     unfolding mod_ring_rel64_def
   proof
     let ?i = "int_of_uint64" 
     assume *: "0 \<le> x \<and> x < pp"     
     hence "0 \<le> ?i x \<and> ?i x < p" using small unfolding ppp
       by (transfer, auto simp: word_less_def)
     hence "?i x \<in> {0 ..< p}" by auto
     with Domainp_mod_ring_rel
     have "Domainp mod_ring_rel (?i x)" by auto
     from this[unfolded Domainp.simps]
     obtain b where b: "mod_ring_rel (?i x) b" by auto
     show "\<exists>a b. x = a \<and> (\<exists>z. urel64 a z \<and> mod_ring_rel z b)" 
     proof (intro exI, rule conjI[OF refl], rule exI, rule conjI[OF _ b])
       show "urel64 x (?i x)" unfolding urel64_def using small * unfolding ppp
         by (transfer, auto simp: word_less_def)
     qed
   next
     assume "\<exists>a b. x = a \<and> (\<exists>z. urel64 a z \<and> mod_ring_rel z b)" 
     then obtain b z where xz: "urel64 x z" and zb: "mod_ring_rel z b" by auto
     hence "Domainp mod_ring_rel z"  by auto
     with Domainp_mod_ring_rel have "0 \<le> z" "z < p" by auto
     with xz show "0 \<le> x \<and> x < pp" unfolding urel64_def using small unfolding ppp
       by (transfer, auto simp: word_less_def)
   qed
 qed
 
 lemma ring_finite_field_ops64: "ring_ops (finite_field_ops64 pp) mod_ring_rel64"
   by (unfold_locales, auto simp:
   finite_field_ops64_def
   bi_unique_mod_ring_rel64
   right_total_mod_ring_rel64
   mod_ring_plus64
   mod_ring_minus64
   mod_ring_uminus64
   mod_ring_mult64
   mod_ring_eq64
   mod_ring_0_64
   mod_ring_1_64
   Domainp_mod_ring_rel64)
 end
 end
 
 context prime_field
 begin
 context fixes pp :: "uint64" 
   assumes *: "p = int_of_uint64 pp" "p \<le> 4294967295" 
 begin
 
 lemma mod_ring_normalize64: "(mod_ring_rel64 ===> mod_ring_rel64) (\<lambda>x. if x = 0 then 0 else 1) normalize" 
   using urel64_normalize[OF *] mod_ring_normalize unfolding mod_ring_rel64_def[OF *] rel_fun_def by blast
 
 lemma mod_ring_mod64: "(mod_ring_rel64 ===> mod_ring_rel64 ===> mod_ring_rel64) (\<lambda>x y. if y = 0 then x else 0) (mod)" 
   using urel64_mod[OF *] mod_ring_mod unfolding mod_ring_rel64_def[OF *] rel_fun_def by blast
 
 lemma mod_ring_unit_factor64: "(mod_ring_rel64 ===> mod_ring_rel64) (\<lambda>x. x) unit_factor" 
   using mod_ring_unit_factor unfolding mod_ring_rel64_def[OF *] rel_fun_def by blast
 
 lemma mod_ring_inverse64: "(mod_ring_rel64 ===> mod_ring_rel64) (inverse_p64 pp) inverse"
   using urel64_inverse[OF *] mod_ring_inverse unfolding mod_ring_rel64_def[OF *] rel_fun_def by blast
 
 lemma mod_ring_divide64: "(mod_ring_rel64 ===> mod_ring_rel64 ===> mod_ring_rel64) (divide_p64 pp) (/)"
   using mod_ring_inverse64 mod_ring_mult64[OF *]
   unfolding divide_p64_def divide_mod_ring_def inverse_mod_ring_def[symmetric]
     rel_fun_def by blast
 
 lemma finite_field_ops64: "field_ops (finite_field_ops64 pp) mod_ring_rel64"
   by (unfold_locales, insert ring_finite_field_ops64[OF *], auto simp:
   ring_ops_def
   finite_field_ops64_def
   mod_ring_divide64
   mod_ring_inverse64
   mod_ring_mod64
   mod_ring_normalize64)
 end
 end
 
 (* and a final implementation via integer *)
 context
   fixes p :: integer
 begin
 definition plus_p_integer :: "integer \<Rightarrow> integer \<Rightarrow> integer" where
   "plus_p_integer x y \<equiv> let z = x + y in if z \<ge> p then z - p else z"
 
 definition minus_p_integer :: "integer \<Rightarrow> integer \<Rightarrow> integer" where
   "minus_p_integer x y \<equiv> if y \<le> x then x - y else (x + p) - y"
 
 definition uminus_p_integer :: "integer \<Rightarrow> integer" where
   "uminus_p_integer x = (if x = 0 then 0 else p - x)"
 
 definition mult_p_integer :: "integer \<Rightarrow> integer \<Rightarrow> integer" where
   "mult_p_integer x y = (x * y mod p)"
 
 lemma int_of_integer_0_iff: "int_of_integer n = 0 \<longleftrightarrow> n = 0"
   using integer_eqI by auto
   
 lemma int_of_integer_0: "int_of_integer 0 = 0" unfolding int_of_integer_0_iff by simp
 
 lemma int_of_integer_plus: "int_of_integer (x + y) = (int_of_integer x + int_of_integer y)" 
   by simp
 
 lemma int_of_integer_minus: "int_of_integer (x - y) = (int_of_integer x - int_of_integer y)"
   by simp
 
 lemma int_of_integer_mult: "int_of_integer (x * y) = (int_of_integer x * int_of_integer y)" 
   by simp  
 
 lemma int_of_integer_mod: "int_of_integer (x mod y) = (int_of_integer x mod int_of_integer y)" 
   by simp  
 
 lemma int_of_integer_inv: "int_of_integer (integer_of_int x) = x" by simp
 
-lemma int_of_integer_shift: "int_of_integer (shiftr n k) = (int_of_integer n) div (2 ^ k)" 
+lemma int_of_integer_shift: "int_of_integer (drop_bit k n) = (int_of_integer n) div (2 ^ k)" 
   by transfer (simp add: int_of_integer_pow shiftr_integer_conv_div_pow2)
 
 
 function power_p_integer :: "integer \<Rightarrow> integer \<Rightarrow> integer" where
   "power_p_integer x n = (if n \<le> 0 then 1 else
-    let rec = power_p_integer (mult_p_integer x x) (shiftr n 1) in
+    let rec = power_p_integer (mult_p_integer x x) (drop_bit 1 n) in
     if n AND 1 = 0 then rec else mult_p_integer rec x)"
   by pat_completeness auto
 
 termination 
 proof -
   {
     fix n :: integer
     assume "\<not> (n \<le> 0)" 
     hence "n > 0" by auto
     hence "int_of_integer n > 0"
       by (simp add: less_integer.rep_eq)
     hence "0 < int_of_integer n" "int_of_integer n div 2 < int_of_integer n" by auto
   } note * = this
   show ?thesis
     by (relation "measure (\<lambda> (x,n). nat (int_of_integer n))", auto simp: * int_of_integer_shift) 
 qed
 
 text \<open>In experiments with Berlekamp-factorization (where the prime $p$ is usually small),
   it turned out that taking the below implementation of inverse via exponentiation
   is faster than the one based on the extended Euclidean algorithm.\<close>
 
 definition inverse_p_integer :: "integer \<Rightarrow> integer" where
   "inverse_p_integer x = (if x = 0 then 0 else power_p_integer x (p - 2))"
 
 definition divide_p_integer :: "integer \<Rightarrow> integer \<Rightarrow> integer"  where
   "divide_p_integer x y = mult_p_integer x (inverse_p_integer y)"
 
 definition finite_field_ops_integer :: "integer arith_ops_record" where
   "finite_field_ops_integer \<equiv> Arith_Ops_Record
       0
       1
       plus_p_integer
       mult_p_integer
       minus_p_integer
       uminus_p_integer
       divide_p_integer
       inverse_p_integer
       (\<lambda> x y . if y = 0 then x else 0)
       (\<lambda> x . if x = 0 then 0 else 1)
       (\<lambda> x . x)
       integer_of_int
       int_of_integer
       (\<lambda> x. 0 \<le> x \<and> x < p)"
 end 
 
 lemma shiftr_integer_code [code_unfold]: "drop_bit 1 x = (integer_shiftr x 1)"
   unfolding shiftr_integer_code using integer_of_nat_1 by auto
 
 text \<open>For soundness of the integer implementation, we mainly prove that this implementation
   implements the int-based implementation of GF(p).\<close>
 context mod_ring_locale
 begin
 
 context fixes pp :: "integer" 
   assumes ppp: "p = int_of_integer pp" 
 begin
 
 lemmas integer_simps = 
   int_of_integer_0
   int_of_integer_plus 
   int_of_integer_minus
   int_of_integer_mult
   
 
 definition urel_integer :: "integer \<Rightarrow> int \<Rightarrow> bool" where "urel_integer x y = (y = int_of_integer x \<and> y \<ge> 0 \<and> y < p)" 
 
 definition mod_ring_rel_integer :: "integer \<Rightarrow> 'a mod_ring \<Rightarrow> bool" where
   "mod_ring_rel_integer x y = (\<exists> z. urel_integer x z \<and> mod_ring_rel z y)" 
 
 lemma urel_integer_0: "urel_integer 0 0" unfolding urel_integer_def using p2 by simp
 
 lemma urel_integer_1: "urel_integer 1 1" unfolding urel_integer_def using p2 by simp
 
 lemma le_int_of_integer: "(x \<le> y) = (int_of_integer x \<le> int_of_integer y)" 
   by (rule less_eq_integer.rep_eq)
 
 lemma urel_integer_plus: assumes "urel_integer x y" "urel_integer x' y'"
   shows "urel_integer (plus_p_integer pp x x') (plus_p p y y')"
 proof -    
   let ?x = "int_of_integer x" 
   let ?x' = "int_of_integer x'" 
   let ?p = "int_of_integer pp" 
   from assms have id: "y = ?x" "y' = ?x'" 
     and rel: "0 \<le> ?x" "?x < p" 
       "0 \<le> ?x'" "?x' \<le> p" unfolding urel_integer_def by auto
   have le: "(pp \<le> x + x') = (?p \<le> ?x + ?x')" unfolding le_int_of_integer
     using rel by auto
   show ?thesis
   proof (cases "?p \<le> ?x + ?x'")
     case True
     hence True: "(?p \<le> ?x + ?x') = True" by simp
     show ?thesis unfolding id 
       using rel unfolding plus_p_integer_def plus_p_def Let_def urel_integer_def 
       unfolding ppp le True if_True
       using True by auto
   next
     case False
     hence False: "(?p \<le> ?x + ?x') = False" by simp
     show ?thesis unfolding id 
       using rel unfolding plus_p_integer_def plus_p_def Let_def urel_integer_def 
       unfolding ppp le False if_False
       using False by auto
   qed
 qed
   
 lemma urel_integer_minus: assumes "urel_integer x y" "urel_integer x' y'"
   shows "urel_integer (minus_p_integer pp x x') (minus_p p y y')"
 proof -    
   let ?x = "int_of_integer x" 
   let ?x' = "int_of_integer x'" 
   from assms have id: "y = ?x" "y' = ?x'" 
     and rel: "0 \<le> ?x" "?x < p" 
       "0 \<le> ?x'" "?x' \<le> p" unfolding urel_integer_def by auto
   have le: "(x' \<le> x) = (?x' \<le> ?x)" unfolding le_int_of_integer
     using rel by auto
   show ?thesis
   proof (cases "?x' \<le> ?x")
     case True
     hence True: "(?x' \<le> ?x) = True" by simp
     show ?thesis unfolding id 
       using rel unfolding minus_p_integer_def minus_p_def Let_def urel_integer_def 
       unfolding ppp le True if_True
       using True by auto
   next
     case False
     hence False: "(?x' \<le> ?x) = False" by simp
     show ?thesis unfolding id 
       using rel unfolding minus_p_integer_def minus_p_def Let_def urel_integer_def 
       unfolding ppp le False if_False
       using False by auto
   qed
 qed
 
 lemma urel_integer_uminus: assumes "urel_integer x y"
   shows "urel_integer (uminus_p_integer pp x) (uminus_p p y)"
 proof -    
   let ?x = "int_of_integer x"  
   from assms have id: "y = ?x" 
     and rel: "0 \<le> ?x" "?x < p" 
       unfolding urel_integer_def by auto
   have le: "(x = 0) = (?x = 0)" unfolding int_of_integer_0_iff
     using rel by auto
   show ?thesis
   proof (cases "?x = 0")
     case True
     hence True: "(?x = 0) = True" by simp
     show ?thesis unfolding id 
       using rel unfolding uminus_p_integer_def uminus_p_def Let_def urel_integer_def 
       unfolding ppp le True if_True
       using True by auto
   next
     case False
     hence False: "(?x = 0) = False" by simp
     show ?thesis unfolding id 
       using rel unfolding uminus_p_integer_def uminus_p_def Let_def urel_integer_def 
       unfolding ppp le False if_False
       using False by auto
   qed
 qed
 
 lemma pp_pos: "int_of_integer pp > 0" 
   using ppp nontriv[where 'a = 'a]  unfolding p
   by (simp add: less_integer.rep_eq)
 
 lemma urel_integer_mult: assumes "urel_integer x y" "urel_integer x' y'"
   shows "urel_integer (mult_p_integer pp x x') (mult_p p y y')"
 proof -    
   let ?x = "int_of_integer x" 
   let ?x' = "int_of_integer x'" 
   from assms  have id: "y = ?x" "y' = ?x'" 
     and rel: "0 \<le> ?x" "?x < p" 
       "0 \<le> ?x'" "?x' < p" unfolding urel_integer_def by auto
   from rel(1,3) have xx: "0 \<le> ?x * ?x'" by simp
   show ?thesis unfolding id
     using rel unfolding mult_p_integer_def mult_p_def Let_def urel_integer_def     
     unfolding ppp mod_nonneg_pos_int[OF xx pp_pos] using xx pp_pos by simp        
 qed
 
 lemma urel_integer_eq: assumes "urel_integer x y" "urel_integer x' y'" 
   shows "(x = x') = (y = y')" 
 proof -    
   let ?x = "int_of_integer x" 
   let ?x' = "int_of_integer x'" 
   from assms have id: "y = ?x" "y' = ?x'" 
     unfolding urel_integer_def by auto
   show ?thesis unfolding id integer_eq_iff ..
 qed
 
 lemma urel_integer_normalize: 
 assumes x: "urel_integer x y"
 shows "urel_integer (if x = 0 then 0 else 1) (if y = 0 then 0 else 1)"
  unfolding urel_integer_eq[OF x urel_integer_0] using urel_integer_0 urel_integer_1 by auto
 
 lemma urel_integer_mod: 
 assumes x: "urel_integer x x'" and y: "urel_integer y y'" 
 shows "urel_integer (if y = 0 then x else 0) (if y' = 0 then x' else 0)"
   unfolding urel_integer_eq[OF y urel_integer_0] using urel_integer_0 x by auto 
 
 lemma urel_integer_power: "urel_integer x x' \<Longrightarrow> urel_integer y (int y') \<Longrightarrow> urel_integer (power_p_integer pp x y) (power_p p x' y')"
 proof (induct x' y' arbitrary: x y rule: power_p.induct[of _ p])
   case (1 x' y' x y)
   note x = 1(2) note y = 1(3)
   show ?case
   proof (cases "y' \<le> 0")
     case True
     hence y: "y = 0" "y' = 0" using urel_integer_eq[OF y urel_integer_0] by auto
     show ?thesis unfolding y True by (simp add: power_p.simps urel_integer_1)
   next
     case False
     hence id: "(y \<le> 0) = False" "(y' = 0) = False" using False y
       by (auto simp add: urel_integer_def not_le) (metis of_int_integer_of of_int_of_nat_eq of_nat_0_less_iff)
     obtain d' r' where dr': "Divides.divmod_nat y' 2 = (d',r')" by force
     from divmod_nat_def[of y' 2, unfolded dr']
     have r': "r' = y' mod 2" and d': "d' = y' div 2" by auto
     have aux: "\<And> y'. int (y' mod 2) = int y' mod 2" by presburger
     have "urel_integer (y AND 1) r'" unfolding r' using y unfolding urel_integer_def 
       unfolding ppp
       apply (auto simp add: and_one_eq)
       apply (simp add: of_nat_mod)
       done
     from urel_integer_eq[OF this urel_integer_0]     
     have rem: "(y AND 1 = 0) = (r' = 0)" by simp
-    have div: "urel_integer (shiftr y 1) (int d')" unfolding d' using y unfolding urel_integer_def
+    have div: "urel_integer (drop_bit 1 y) (int d')" unfolding d' using y unfolding urel_integer_def
       unfolding ppp shiftr_integer_conv_div_pow2 by auto
     from id have "y' \<noteq> 0" by auto
     note IH = 1(1)[OF this refl dr'[symmetric] urel_integer_mult[OF x x] div]
     show ?thesis unfolding power_p.simps[of _ _ "y'"] power_p_integer.simps[of _ _ y] dr' id if_False rem
       using IH urel_integer_mult[OF IH x] by (auto simp: Let_def)
   qed
 qed
   
 
 lemma urel_integer_inverse: assumes x: "urel_integer x x'" 
   shows "urel_integer (inverse_p_integer pp x) (inverse_p p x')" 
 proof -
   have p: "urel_integer (pp - 2) (int (nat (p - 2)))" using p2 unfolding urel_integer_def unfolding ppp
     by auto
   show ?thesis
     unfolding inverse_p_integer_def inverse_p_def urel_integer_eq[OF x urel_integer_0] using urel_integer_0 urel_integer_power[OF x p]
     by auto
 qed
 
 lemma mod_ring_0__integer: "mod_ring_rel_integer 0 0"
   using urel_integer_0 mod_ring_0 unfolding mod_ring_rel_integer_def by blast
 
 lemma mod_ring_1__integer: "mod_ring_rel_integer 1 1"
   using urel_integer_1 mod_ring_1 unfolding mod_ring_rel_integer_def by blast
 
 lemma mod_ring_uminus_integer: "(mod_ring_rel_integer ===> mod_ring_rel_integer) (uminus_p_integer pp) uminus"
   using urel_integer_uminus mod_ring_uminus unfolding mod_ring_rel_integer_def rel_fun_def by blast
 
 lemma mod_ring_plus_integer: "(mod_ring_rel_integer ===> mod_ring_rel_integer ===> mod_ring_rel_integer) (plus_p_integer pp) (+)"
   using urel_integer_plus mod_ring_plus unfolding mod_ring_rel_integer_def rel_fun_def by blast
 
 lemma mod_ring_minus_integer: "(mod_ring_rel_integer ===> mod_ring_rel_integer ===> mod_ring_rel_integer) (minus_p_integer pp) (-)"
   using urel_integer_minus mod_ring_minus unfolding mod_ring_rel_integer_def rel_fun_def by blast
 
 lemma mod_ring_mult_integer: "(mod_ring_rel_integer ===> mod_ring_rel_integer ===> mod_ring_rel_integer) (mult_p_integer pp) ((*))"
   using urel_integer_mult mod_ring_mult unfolding mod_ring_rel_integer_def rel_fun_def by blast
 
 lemma mod_ring_eq_integer: "(mod_ring_rel_integer ===> mod_ring_rel_integer ===> (=)) (=) (=)" 
   using urel_integer_eq mod_ring_eq unfolding mod_ring_rel_integer_def rel_fun_def by blast
 
 lemma urel_integer_inj: "urel_integer x y \<Longrightarrow> urel_integer x z \<Longrightarrow> y = z" 
   using urel_integer_eq[of x y x z] by auto
 
 lemma urel_integer_inj': "urel_integer x z \<Longrightarrow> urel_integer y z \<Longrightarrow> x = y" 
   using urel_integer_eq[of x z y z] by auto
 
 lemma bi_unique_mod_ring_rel_integer:
   "bi_unique mod_ring_rel_integer" "left_unique mod_ring_rel_integer" "right_unique mod_ring_rel_integer"
   using bi_unique_mod_ring_rel urel_integer_inj'
   unfolding mod_ring_rel_integer_def bi_unique_def left_unique_def right_unique_def
   by (auto simp: urel_integer_def)  
 
 lemma right_total_mod_ring_rel_integer: "right_total mod_ring_rel_integer"
   unfolding mod_ring_rel_integer_def right_total_def
 proof 
   fix y :: "'a mod_ring" 
   from right_total_mod_ring_rel[unfolded right_total_def, rule_format, of y]
   obtain z where zy: "mod_ring_rel z y" by auto  
   hence zp: "0 \<le> z" "z < p" unfolding mod_ring_rel_def p using range_to_int_mod_ring[where 'a = 'a] by auto
   hence "urel_integer (integer_of_int z) z" unfolding urel_integer_def unfolding ppp 
     by auto 
   with zy show "\<exists> x z. urel_integer x z \<and> mod_ring_rel z y" by blast
 qed
 
 lemma Domainp_mod_ring_rel_integer: "Domainp mod_ring_rel_integer = (\<lambda>x. 0 \<le> x \<and> x < pp)"
 proof 
   fix x
   show "Domainp mod_ring_rel_integer x = (0 \<le> x \<and> x < pp)"   
     unfolding Domainp.simps
     unfolding mod_ring_rel_integer_def
   proof
     let ?i = "int_of_integer" 
     assume *: "0 \<le> x \<and> x < pp"     
     hence "0 \<le> ?i x \<and> ?i x < p" unfolding ppp 
       by (simp add: le_int_of_integer less_integer.rep_eq)
     hence "?i x \<in> {0 ..< p}" by auto
     with Domainp_mod_ring_rel
     have "Domainp mod_ring_rel (?i x)" by auto
     from this[unfolded Domainp.simps]
     obtain b where b: "mod_ring_rel (?i x) b" by auto
     show "\<exists>a b. x = a \<and> (\<exists>z. urel_integer a z \<and> mod_ring_rel z b)" 
     proof (intro exI, rule conjI[OF refl], rule exI, rule conjI[OF _ b])
       show "urel_integer x (?i x)" unfolding urel_integer_def using * unfolding ppp
         by (simp add: le_int_of_integer less_integer.rep_eq)
     qed
   next
     assume "\<exists>a b. x = a \<and> (\<exists>z. urel_integer a z \<and> mod_ring_rel z b)" 
     then obtain b z where xz: "urel_integer x z" and zb: "mod_ring_rel z b" by auto
     hence "Domainp mod_ring_rel z"  by auto
     with Domainp_mod_ring_rel have "0 \<le> z" "z < p" by auto
     with xz show "0 \<le> x \<and> x < pp" unfolding urel_integer_def unfolding ppp
       by (simp add: le_int_of_integer less_integer.rep_eq)
   qed
 qed
 
 lemma ring_finite_field_ops_integer: "ring_ops (finite_field_ops_integer pp) mod_ring_rel_integer"
   by (unfold_locales, auto simp:
   finite_field_ops_integer_def
   bi_unique_mod_ring_rel_integer
   right_total_mod_ring_rel_integer
   mod_ring_plus_integer
   mod_ring_minus_integer
   mod_ring_uminus_integer
   mod_ring_mult_integer
   mod_ring_eq_integer
   mod_ring_0__integer
   mod_ring_1__integer
   Domainp_mod_ring_rel_integer)
 end
 end
 
 context prime_field
 begin
 context fixes pp :: "integer" 
   assumes *: "p = int_of_integer pp"  
 begin
 
 lemma mod_ring_normalize_integer: "(mod_ring_rel_integer ===> mod_ring_rel_integer) (\<lambda>x. if x = 0 then 0 else 1) normalize" 
   using urel_integer_normalize[OF *] mod_ring_normalize unfolding mod_ring_rel_integer_def[OF *] rel_fun_def by blast
 
 lemma mod_ring_mod_integer: "(mod_ring_rel_integer ===> mod_ring_rel_integer ===> mod_ring_rel_integer) (\<lambda>x y. if y = 0 then x else 0) (mod)" 
   using urel_integer_mod[OF *] mod_ring_mod unfolding mod_ring_rel_integer_def[OF *] rel_fun_def by blast
 
 lemma mod_ring_unit_factor_integer: "(mod_ring_rel_integer ===> mod_ring_rel_integer) (\<lambda>x. x) unit_factor" 
   using mod_ring_unit_factor unfolding mod_ring_rel_integer_def[OF *] rel_fun_def by blast
 
 lemma mod_ring_inverse_integer: "(mod_ring_rel_integer ===> mod_ring_rel_integer) (inverse_p_integer pp) inverse"
   using urel_integer_inverse[OF *] mod_ring_inverse unfolding mod_ring_rel_integer_def[OF *] rel_fun_def by blast
 
 lemma mod_ring_divide_integer: "(mod_ring_rel_integer ===> mod_ring_rel_integer ===> mod_ring_rel_integer) (divide_p_integer pp) (/)"
   using mod_ring_inverse_integer mod_ring_mult_integer[OF *]
   unfolding divide_p_integer_def divide_mod_ring_def inverse_mod_ring_def[symmetric]
     rel_fun_def by blast
 
 lemma finite_field_ops_integer: "field_ops (finite_field_ops_integer pp) mod_ring_rel_integer"
   by (unfold_locales, insert ring_finite_field_ops_integer[OF *], auto simp:
   ring_ops_def
   finite_field_ops_integer_def
   mod_ring_divide_integer
   mod_ring_inverse_integer
   mod_ring_mod_integer
   mod_ring_normalize_integer)
 end
 end
 
 context prime_field
 begin
  (* four implementations of modular integer arithmetic for finite fields *)
 thm 
   finite_field_ops64
   finite_field_ops32
   finite_field_ops_integer
   finite_field_ops_int
 end
 
 context mod_ring_locale
 begin
  (* four implementations of modular integer arithmetic for finite rings *)
 thm 
   ring_finite_field_ops64
   ring_finite_field_ops32
   ring_finite_field_ops_integer
   ring_finite_field_ops_int
 end
 
-no_notation shiftr (infixl ">>" 55) (* to avoid conflict with bind *)
 end
diff --git a/thys/CakeML/generated/Lem_word.thy b/thys/CakeML/generated/Lem_word.thy
--- a/thys/CakeML/generated/Lem_word.thy
+++ b/thys/CakeML/generated/Lem_word.thy
@@ -1,1024 +1,1024 @@
 chapter \<open>Generated by Lem from \<open>word.lem\<close>.\<close>
 
 theory "Lem_word" 
 
 imports
   Main
   "Lem_bool"
   "Lem_maybe"
   "Lem_num"
   "Lem_basic_classes"
   "Lem_list"
   "HOL-Library.Word"
 
 begin 
 
 
 
 \<comment> \<open>\<open>open import Bool Maybe Num Basic_classes List\<close>\<close>
 
 \<comment> \<open>\<open>open import {isabelle} `HOL-Library.Word`\<close>\<close>
 \<comment> \<open>\<open>open import {hol} `wordsTheory` `wordsLib`\<close>\<close>
 
 
 \<comment> \<open>\<open> ========================================================================== \<close>\<close>
 \<comment> \<open>\<open> Define general purpose word, i.e. sequences of bits of arbitrary length    \<close>\<close>
 \<comment> \<open>\<open> ========================================================================== \<close>\<close>
 
 datatype bitSequence = BitSeq " 
     nat option  " " \<comment> \<open>\<open> length of the sequence, Nothing means infinite length \<close>\<close>
    bool " " bool       \<comment> \<open>\<open> sign of the word, used to fill up after concrete value is exhausted \<close>\<close>
    list "    \<comment> \<open>\<open> the initial part of the sequence, least significant bit first \<close>\<close>
 
 \<comment> \<open>\<open>val bitSeqEq : bitSequence -> bitSequence -> bool\<close>\<close>
 
 \<comment> \<open>\<open>val boolListFrombitSeq : nat -> bitSequence -> list bool\<close>\<close>
 
 fun  boolListFrombitSeqAux  :: " nat \<Rightarrow> 'a \<Rightarrow> 'a list \<Rightarrow> 'a list "  where 
      " boolListFrombitSeqAux n s bl = (
   if n =( 0 :: nat) then [] else
   (case  bl of
       []       => List.replicate n s
     | b # bl' => b # (boolListFrombitSeqAux (n-( 1 :: nat)) s bl')
   ))"
 
 
 fun boolListFrombitSeq  :: " nat \<Rightarrow> bitSequence \<Rightarrow>(bool)list "  where 
      " boolListFrombitSeq n (BitSeq _ s bl) = ( boolListFrombitSeqAux n s bl )"
 
 
 
 \<comment> \<open>\<open>val bitSeqFromBoolList : list bool -> maybe bitSequence\<close>\<close>
 definition bitSeqFromBoolList  :: "(bool)list \<Rightarrow>(bitSequence)option "  where 
      " bitSeqFromBoolList bl = (
   (case  dest_init bl of
       None => None
     | Some (bl', s) => Some (BitSeq (Some (List.length bl)) s bl')
   ))"
 
 
 
 \<comment> \<open>\<open> cleans up the representation of a bitSequence without changing its semantics \<close>\<close>
 \<comment> \<open>\<open>val cleanBitSeq : bitSequence -> bitSequence\<close>\<close>
 fun cleanBitSeq  :: " bitSequence \<Rightarrow> bitSequence "  where 
      " cleanBitSeq (BitSeq len s bl) = ( (case  len of
     None => (BitSeq len s (List.rev (dropWhile ((\<longleftrightarrow>) s) (List.rev bl))))
   | Some n  => (BitSeq len s (List.rev (dropWhile ((\<longleftrightarrow>) s) (List.rev (List.take (n-( 1 :: nat)) bl)))))
 ))"
 
 
 
 \<comment> \<open>\<open>val bitSeqTestBit : bitSequence -> nat -> maybe bool\<close>\<close>
 fun bitSeqTestBit  :: " bitSequence \<Rightarrow> nat \<Rightarrow>(bool)option "  where 
      " bitSeqTestBit (BitSeq None s bl) pos = ( if pos < List.length bl then index bl pos else Some s )"
 |" bitSeqTestBit (BitSeq(Some l) s bl) pos = ( if (pos \<ge> l) then None else
                 if ((pos = (l -( 1 :: nat))) \<or> (pos \<ge> List.length bl)) then Some s else
                 index bl pos )"
 
 
 \<comment> \<open>\<open>val bitSeqSetBit : bitSequence -> nat -> bool -> bitSequence\<close>\<close>
 fun bitSeqSetBit  :: " bitSequence \<Rightarrow> nat \<Rightarrow> bool \<Rightarrow> bitSequence "  where 
      " bitSeqSetBit (BitSeq len s bl) pos v = (
   (let bl' = (if (pos < List.length bl) then bl else bl @ List.replicate pos s) in
   (let bl'' = (List.list_update bl' pos v) in
   (let bs' = (BitSeq len s bl'') in
   cleanBitSeq bs'))))"
 
 
 
 \<comment> \<open>\<open>val resizeBitSeq : maybe nat -> bitSequence -> bitSequence\<close>\<close>
 definition resizeBitSeq  :: "(nat)option \<Rightarrow> bitSequence \<Rightarrow> bitSequence "  where 
      " resizeBitSeq new_len bs = ( 
   (case  cleanBitSeq bs of
       (BitSeq len s bl) =>
   (let shorten_opt = ((case  (new_len, len) of
                             (None, _) => None
                         | (Some l1, None) => Some l1
                         | (Some l1, Some l2) =>
                       if (l1 < l2) then Some l1 else None
                       )) in
   (case  shorten_opt of
         None => BitSeq new_len s bl
     | Some l1 => (
                  (let bl' = (List.take l1 (bl @ [s])) in
                  (case  dest_init bl' of
                        None => (BitSeq len s bl) \<comment> \<open>\<open> do nothing if size 0 is requested \<close>\<close>
                    | Some (bl'', s') => cleanBitSeq (BitSeq new_len s' bl'')
                  )))
   ))
   ) )"
  
 
 \<comment> \<open>\<open>val bitSeqNot : bitSequence -> bitSequence\<close>\<close>
 fun bitSeqNot  :: " bitSequence \<Rightarrow> bitSequence "  where 
      " bitSeqNot (BitSeq len s bl) = ( BitSeq len (\<not> s) (List.map (\<lambda> x. \<not> x) bl))"
 
 
 \<comment> \<open>\<open>val bitSeqBinop : (bool -> bool -> bool) -> bitSequence -> bitSequence -> bitSequence\<close>\<close>
 
 \<comment> \<open>\<open>val bitSeqBinopAux : (bool -> bool -> bool) -> bool -> list bool -> bool -> list bool -> list bool\<close>\<close>
 fun  bitSeqBinopAux  :: "(bool \<Rightarrow> bool \<Rightarrow> bool)\<Rightarrow> bool \<Rightarrow>(bool)list \<Rightarrow> bool \<Rightarrow>(bool)list \<Rightarrow>(bool)list "  where 
      " bitSeqBinopAux binop s1 ([]) s2 ([]) = ( [])"
 |" bitSeqBinopAux binop s1 (b1 # bl1') s2 ([]) = ( (binop b1 s2) # bitSeqBinopAux binop s1 bl1' s2 [])"
 |" bitSeqBinopAux binop s1 ([]) s2 (b2 # bl2') = ( (binop s1 b2) # bitSeqBinopAux binop s1 []   s2 bl2' )"
 |" bitSeqBinopAux binop s1 (b1 # bl1') s2 (b2 # bl2') = ( (binop b1 b2) # bitSeqBinopAux binop s1 bl1' s2 bl2' )"
 
 
 definition bitSeqBinop  :: "(bool \<Rightarrow> bool \<Rightarrow> bool)\<Rightarrow> bitSequence \<Rightarrow> bitSequence \<Rightarrow> bitSequence "  where 
      " bitSeqBinop binop bs1 bs2 = ( ( 
   (case  cleanBitSeq bs1 of
       (BitSeq len1 s1 bl1) =>
   (case  cleanBitSeq bs2 of
       (BitSeq len2 s2 bl2) =>
   (let len = ((case  (len1, len2) of
                     (Some l1, Some l2) => Some (max l1 l2)
                 | _ => None
               )) in
   (let s = (binop s1 s2) in
   (let bl = (bitSeqBinopAux binop s1 bl1 s2 bl2) in
   cleanBitSeq (BitSeq len s bl))))
   )
   )
 ))"
 
 
 definition bitSeqAnd  :: " bitSequence \<Rightarrow> bitSequence \<Rightarrow> bitSequence "  where 
      " bitSeqAnd = ( bitSeqBinop (\<and>))"
 
 definition bitSeqOr  :: " bitSequence \<Rightarrow> bitSequence \<Rightarrow> bitSequence "  where 
      " bitSeqOr = ( bitSeqBinop (\<or>))"
 
 definition bitSeqXor  :: " bitSequence \<Rightarrow> bitSequence \<Rightarrow> bitSequence "  where 
      " bitSeqXor = ( bitSeqBinop (\<lambda> b1 b2. \<not> (b1 \<longleftrightarrow> b2)))"
 
 
 \<comment> \<open>\<open>val bitSeqShiftLeft : bitSequence -> nat -> bitSequence\<close>\<close>
 fun bitSeqShiftLeft  :: " bitSequence \<Rightarrow> nat \<Rightarrow> bitSequence "  where 
      " bitSeqShiftLeft (BitSeq len s bl) n = ( cleanBitSeq (BitSeq len s (List.replicate n False @ bl)))"
 
 
 \<comment> \<open>\<open>val bitSeqArithmeticShiftRight : bitSequence -> nat -> bitSequence\<close>\<close>
 definition bitSeqArithmeticShiftRight  :: " bitSequence \<Rightarrow> nat \<Rightarrow> bitSequence "  where 
      " bitSeqArithmeticShiftRight bs n = ( 
   (case  cleanBitSeq bs of
       (BitSeq len s bl) =>
   cleanBitSeq (BitSeq len s (List.drop n bl))
   ) )"
 
 
 \<comment> \<open>\<open>val bitSeqLogicalShiftRight : bitSequence -> nat -> bitSequence\<close>\<close>
 definition bitSeqLogicalShiftRight  :: " bitSequence \<Rightarrow> nat \<Rightarrow> bitSequence "  where 
      " bitSeqLogicalShiftRight bs n = ( 
   if (n =( 0 :: nat)) then cleanBitSeq bs else  
   (case  cleanBitSeq bs of
       (BitSeq len s bl) =>
   (case  len of
         None => cleanBitSeq (BitSeq len s (List.drop n bl))
     | Some l => cleanBitSeq
                   (BitSeq len False ((List.drop n bl) @ List.replicate l s))
   )
   ) )"
 
 
 
 \<comment> \<open>\<open> integerFromBoolList sign bl creates an integer from a list of bits
    (least significant bit first) and an explicitly given sign bit.
    It uses two's complement encoding. \<close>\<close>
 \<comment> \<open>\<open>val integerFromBoolList : (bool * list bool) -> integer\<close>\<close>
 
 fun  integerFromBoolListAux  :: " int \<Rightarrow>(bool)list \<Rightarrow> int "  where 
      " integerFromBoolListAux (acc1 :: int) (([]) :: bool list) = ( acc1 )"
 |" integerFromBoolListAux (acc1 :: int) ((True # bl') :: bool list) = ( integerFromBoolListAux ((acc1 *( 2 :: int)) +( 1 :: int)) bl' )"
 |" integerFromBoolListAux (acc1 :: int) ((False # bl') :: bool list) = ( integerFromBoolListAux (acc1 *( 2 :: int)) bl' )"
 
 
 fun integerFromBoolList  :: " bool*(bool)list \<Rightarrow> int "  where 
      " integerFromBoolList (sign, bl) = ( 
    if sign then 
      - (integerFromBoolListAux(( 0 :: int)) (List.rev (List.map (\<lambda> x. \<not> x) bl)) +( 1 :: int))
    else integerFromBoolListAux(( 0 :: int)) (List.rev bl))"
 
 
 \<comment> \<open>\<open> [boolListFromInteger i] creates a sign bit and a list of booleans from an integer. The len_opt tells it when to stop.\<close>\<close>
 \<comment> \<open>\<open>val boolListFromInteger :    integer -> bool * list bool\<close>\<close>
 
 fun  boolListFromNatural  :: "(bool)list \<Rightarrow> nat \<Rightarrow>(bool)list "  where 
      " boolListFromNatural acc1 (remainder :: nat) = (
  if (remainder >( 0 :: nat)) then 
    (boolListFromNatural (((remainder mod( 2 :: nat)) =( 1 :: nat)) # acc1) 
       (remainder div( 2 :: nat)))
  else
    List.rev acc1 )"
 
 
 definition boolListFromInteger  :: " int \<Rightarrow> bool*(bool)list "  where 
      " boolListFromInteger (i :: int) = ( 
   if (i <( 0 :: int)) then
     (True, List.map (\<lambda> x. \<not> x) (boolListFromNatural [] (nat (abs (- (i +( 1 :: int)))))))
   else
     (False, boolListFromNatural [] (nat (abs i))))"
 
 
 
 \<comment> \<open>\<open> [bitSeqFromInteger len_opt i] encodes [i] as a bitsequence with [len_opt] bits. If there are not enough
    bits, truncation happens \<close>\<close>
 \<comment> \<open>\<open>val bitSeqFromInteger : maybe nat -> integer -> bitSequence\<close>\<close>
 definition bitSeqFromInteger  :: "(nat)option \<Rightarrow> int \<Rightarrow> bitSequence "  where 
      " bitSeqFromInteger len_opt i = (
   (let (s, bl) = (boolListFromInteger i) in
   resizeBitSeq len_opt (BitSeq None s bl)))"
 
 
 
 \<comment> \<open>\<open>val integerFromBitSeq : bitSequence -> integer\<close>\<close>
 definition integerFromBitSeq  :: " bitSequence \<Rightarrow> int "  where 
      " integerFromBitSeq bs = ( 
   (case  cleanBitSeq bs of (BitSeq len s bl) => integerFromBoolList (s, bl) ) )"
 
 
 
 \<comment> \<open>\<open> Now we can via translation to integers map arithmetic operations to bitSequences \<close>\<close>
 
 \<comment> \<open>\<open>val bitSeqArithUnaryOp : (integer -> integer) -> bitSequence -> bitSequence\<close>\<close>
 definition bitSeqArithUnaryOp  :: "(int \<Rightarrow> int)\<Rightarrow> bitSequence \<Rightarrow> bitSequence "  where 
      " bitSeqArithUnaryOp uop bs = ( 
   (case  bs of
       (BitSeq len _ _) =>
   bitSeqFromInteger len (uop (integerFromBitSeq bs))
   ) )"
 
 
 \<comment> \<open>\<open>val bitSeqArithBinOp : (integer -> integer -> integer) -> bitSequence -> bitSequence -> bitSequence\<close>\<close>
 definition bitSeqArithBinOp  :: "(int \<Rightarrow> int \<Rightarrow> int)\<Rightarrow> bitSequence \<Rightarrow> bitSequence \<Rightarrow> bitSequence "  where 
      " bitSeqArithBinOp binop bs1 bs2 = ( 
   (case  bs1 of
       (BitSeq len1 _ _) =>
   (case  bs2 of
       (BitSeq len2 _ _) =>
   (let len = ((case  (len1, len2) of
                     (Some l1, Some l2) => Some (max l1 l2)
                 | _ => None
               )) in
   bitSeqFromInteger len
     (binop (integerFromBitSeq bs1) (integerFromBitSeq bs2)))
   )
   ) )"
 
 
 \<comment> \<open>\<open>val bitSeqArithBinTest : forall 'a. (integer -> integer -> 'a) -> bitSequence -> bitSequence -> 'a\<close>\<close>
 definition bitSeqArithBinTest  :: "(int \<Rightarrow> int \<Rightarrow> 'a)\<Rightarrow> bitSequence \<Rightarrow> bitSequence \<Rightarrow> 'a "  where 
      " bitSeqArithBinTest binop bs1 bs2 = ( binop (integerFromBitSeq bs1) (integerFromBitSeq bs2))"
 
 
 
 \<comment> \<open>\<open> now instantiate the number interface for bit-sequences \<close>\<close>
 
 \<comment> \<open>\<open>val bitSeqFromNumeral : numeral -> bitSequence\<close>\<close>
 
 \<comment> \<open>\<open>val bitSeqLess : bitSequence -> bitSequence -> bool\<close>\<close>
 definition bitSeqLess  :: " bitSequence \<Rightarrow> bitSequence \<Rightarrow> bool "  where 
      " bitSeqLess bs1 bs2 = ( bitSeqArithBinTest (<) bs1 bs2 )"
 
 
 \<comment> \<open>\<open>val bitSeqLessEqual : bitSequence -> bitSequence -> bool\<close>\<close>
 definition bitSeqLessEqual  :: " bitSequence \<Rightarrow> bitSequence \<Rightarrow> bool "  where 
      " bitSeqLessEqual bs1 bs2 = ( bitSeqArithBinTest (\<le>) bs1 bs2 )"
 
 
 \<comment> \<open>\<open>val bitSeqGreater : bitSequence -> bitSequence -> bool\<close>\<close>
 definition bitSeqGreater  :: " bitSequence \<Rightarrow> bitSequence \<Rightarrow> bool "  where 
      " bitSeqGreater bs1 bs2 = ( bitSeqArithBinTest (>) bs1 bs2 )"
 
 
 \<comment> \<open>\<open>val bitSeqGreaterEqual : bitSequence -> bitSequence -> bool\<close>\<close>
 definition bitSeqGreaterEqual  :: " bitSequence \<Rightarrow> bitSequence \<Rightarrow> bool "  where 
      " bitSeqGreaterEqual bs1 bs2 = ( bitSeqArithBinTest (\<ge>) bs1 bs2 )"
 
 
 \<comment> \<open>\<open>val bitSeqCompare : bitSequence -> bitSequence -> ordering\<close>\<close>
 definition bitSeqCompare  :: " bitSequence \<Rightarrow> bitSequence \<Rightarrow> ordering "  where 
      " bitSeqCompare bs1 bs2 = ( bitSeqArithBinTest (genericCompare (<) (=)) bs1 bs2 )"
 
 
 definition instance_Basic_classes_Ord_Word_bitSequence_dict  :: "(bitSequence)Ord_class "  where 
      " instance_Basic_classes_Ord_Word_bitSequence_dict = ((|
 
   compare_method = bitSeqCompare,
 
   isLess_method = bitSeqLess,
 
   isLessEqual_method = bitSeqLessEqual,
 
   isGreater_method = bitSeqGreater,
 
   isGreaterEqual_method = bitSeqGreaterEqual |) )"
 
 
 \<comment> \<open>\<open> arithmetic negation, don't mix up with bitwise negation \<close>\<close>
 \<comment> \<open>\<open>val bitSeqNegate : bitSequence -> bitSequence\<close>\<close> 
 definition bitSeqNegate  :: " bitSequence \<Rightarrow> bitSequence "  where 
      " bitSeqNegate bs = ( bitSeqArithUnaryOp (\<lambda> i. - i) bs )"
 
 
 definition instance_Num_NumNegate_Word_bitSequence_dict  :: "(bitSequence)NumNegate_class "  where 
      " instance_Num_NumNegate_Word_bitSequence_dict = ((|
 
   numNegate_method = bitSeqNegate |) )"
 
 
 
 \<comment> \<open>\<open>val bitSeqAdd : bitSequence -> bitSequence -> bitSequence\<close>\<close>
 definition bitSeqAdd  :: " bitSequence \<Rightarrow> bitSequence \<Rightarrow> bitSequence "  where 
      " bitSeqAdd bs1 bs2 = ( bitSeqArithBinOp (+) bs1 bs2 )"
 
 
 definition instance_Num_NumAdd_Word_bitSequence_dict  :: "(bitSequence)NumAdd_class "  where 
      " instance_Num_NumAdd_Word_bitSequence_dict = ((|
 
   numAdd_method = bitSeqAdd |) )"
 
 
 \<comment> \<open>\<open>val bitSeqMinus : bitSequence -> bitSequence -> bitSequence\<close>\<close>
 definition bitSeqMinus  :: " bitSequence \<Rightarrow> bitSequence \<Rightarrow> bitSequence "  where 
      " bitSeqMinus bs1 bs2 = ( bitSeqArithBinOp (-) bs1 bs2 )"
 
 
 definition instance_Num_NumMinus_Word_bitSequence_dict  :: "(bitSequence)NumMinus_class "  where 
      " instance_Num_NumMinus_Word_bitSequence_dict = ((|
 
   numMinus_method = bitSeqMinus |) )"
 
 
 \<comment> \<open>\<open>val bitSeqSucc : bitSequence -> bitSequence\<close>\<close>
 definition bitSeqSucc  :: " bitSequence \<Rightarrow> bitSequence "  where 
      " bitSeqSucc bs = ( bitSeqArithUnaryOp (\<lambda> n. n +( 1 :: int)) bs )"
 
 
 definition instance_Num_NumSucc_Word_bitSequence_dict  :: "(bitSequence)NumSucc_class "  where 
      " instance_Num_NumSucc_Word_bitSequence_dict = ((|
 
   succ_method = bitSeqSucc |) )"
 
 
 \<comment> \<open>\<open>val bitSeqPred : bitSequence -> bitSequence\<close>\<close>
 definition bitSeqPred  :: " bitSequence \<Rightarrow> bitSequence "  where 
      " bitSeqPred bs = ( bitSeqArithUnaryOp (\<lambda> n. n -( 1 :: int)) bs )"
 
 
 definition instance_Num_NumPred_Word_bitSequence_dict  :: "(bitSequence)NumPred_class "  where 
      " instance_Num_NumPred_Word_bitSequence_dict = ((|
 
   pred_method = bitSeqPred |) )"
 
 
 \<comment> \<open>\<open>val bitSeqMult : bitSequence -> bitSequence -> bitSequence\<close>\<close>
 definition bitSeqMult  :: " bitSequence \<Rightarrow> bitSequence \<Rightarrow> bitSequence "  where 
      " bitSeqMult bs1 bs2 = ( bitSeqArithBinOp (*) bs1 bs2 )"
 
 
 definition instance_Num_NumMult_Word_bitSequence_dict  :: "(bitSequence)NumMult_class "  where 
      " instance_Num_NumMult_Word_bitSequence_dict = ((|
 
   numMult_method = bitSeqMult |) )"
 
 
 
 \<comment> \<open>\<open>val bitSeqPow : bitSequence -> nat -> bitSequence\<close>\<close>
 definition bitSeqPow  :: " bitSequence \<Rightarrow> nat \<Rightarrow> bitSequence "  where 
      " bitSeqPow bs n = ( bitSeqArithUnaryOp (\<lambda> i .  i ^ n) bs )"
 
 
 definition instance_Num_NumPow_Word_bitSequence_dict  :: "(bitSequence)NumPow_class "  where 
      " instance_Num_NumPow_Word_bitSequence_dict = ((|
 
   numPow_method = bitSeqPow |) )"
 
 
 \<comment> \<open>\<open>val bitSeqDiv : bitSequence -> bitSequence -> bitSequence\<close>\<close>
 definition bitSeqDiv  :: " bitSequence \<Rightarrow> bitSequence \<Rightarrow> bitSequence "  where 
      " bitSeqDiv bs1 bs2 = ( bitSeqArithBinOp (div) bs1 bs2 )"
 
 
 definition instance_Num_NumIntegerDivision_Word_bitSequence_dict  :: "(bitSequence)NumIntegerDivision_class "  where 
      " instance_Num_NumIntegerDivision_Word_bitSequence_dict = ((|
 
   div_method = bitSeqDiv |) )"
 
 
 definition instance_Num_NumDivision_Word_bitSequence_dict  :: "(bitSequence)NumDivision_class "  where 
      " instance_Num_NumDivision_Word_bitSequence_dict = ((|
 
   numDivision_method = bitSeqDiv |) )"
 
 
 \<comment> \<open>\<open>val bitSeqMod : bitSequence -> bitSequence -> bitSequence\<close>\<close>
 definition bitSeqMod  :: " bitSequence \<Rightarrow> bitSequence \<Rightarrow> bitSequence "  where 
      " bitSeqMod bs1 bs2 = ( bitSeqArithBinOp (mod) bs1 bs2 )"
 
 
 definition instance_Num_NumRemainder_Word_bitSequence_dict  :: "(bitSequence)NumRemainder_class "  where 
      " instance_Num_NumRemainder_Word_bitSequence_dict = ((|
 
   mod_method = bitSeqMod |) )"
 
 
 \<comment> \<open>\<open>val bitSeqMin : bitSequence -> bitSequence -> bitSequence\<close>\<close>
 definition bitSeqMin  :: " bitSequence \<Rightarrow> bitSequence \<Rightarrow> bitSequence "  where 
      " bitSeqMin bs1 bs2 = ( bitSeqArithBinOp min bs1 bs2 )"
 
 
 \<comment> \<open>\<open>val bitSeqMax : bitSequence -> bitSequence -> bitSequence\<close>\<close>
 definition bitSeqMax  :: " bitSequence \<Rightarrow> bitSequence \<Rightarrow> bitSequence "  where 
      " bitSeqMax bs1 bs2 = ( bitSeqArithBinOp max bs1 bs2 )"
 
 
 definition instance_Basic_classes_OrdMaxMin_Word_bitSequence_dict  :: "(bitSequence)OrdMaxMin_class "  where 
      " instance_Basic_classes_OrdMaxMin_Word_bitSequence_dict = ((|
 
   max_method = bitSeqMax,
 
   min_method = bitSeqMin |) )"
 
 
 
 
 
 \<comment> \<open>\<open> ========================================================================== \<close>\<close>
 \<comment> \<open>\<open> Interface for bitoperations                                                \<close>\<close>
 \<comment> \<open>\<open> ========================================================================== \<close>\<close>
 
 record 'a WordNot_class= 
 
   lnot_method ::" 'a \<Rightarrow> 'a "
 
 
 
 record 'a WordAnd_class= 
 
   land_method  ::" 'a \<Rightarrow> 'a \<Rightarrow> 'a "
 
 
 
 record 'a WordOr_class= 
 
   lor_method ::" 'a \<Rightarrow> 'a \<Rightarrow> 'a "
 
 
 
 
 record 'a WordXor_class= 
 
   lxor_method ::" 'a \<Rightarrow> 'a \<Rightarrow> 'a "
 
 
 
 record 'a WordLsl_class= 
 
   lsl_method ::" 'a \<Rightarrow> nat \<Rightarrow> 'a "
 
 
 
 record 'a WordLsr_class= 
 
   lsr_method ::" 'a \<Rightarrow> nat \<Rightarrow> 'a "
 
 
 
 record 'a WordAsr_class= 
 
   asr_method ::" 'a \<Rightarrow> nat \<Rightarrow> 'a "
 
 
 
 \<comment> \<open>\<open> ----------------------- \<close>\<close>
 \<comment> \<open>\<open> bitSequence             \<close>\<close>
 \<comment> \<open>\<open> ----------------------- \<close>\<close>
 
 definition instance_Word_WordNot_Word_bitSequence_dict  :: "(bitSequence)WordNot_class "  where 
      " instance_Word_WordNot_Word_bitSequence_dict = ((|
 
   lnot_method = bitSeqNot |) )"
 
 
 definition instance_Word_WordAnd_Word_bitSequence_dict  :: "(bitSequence)WordAnd_class "  where 
      " instance_Word_WordAnd_Word_bitSequence_dict = ((|
 
   land_method = bitSeqAnd |) )"
 
 
 definition instance_Word_WordOr_Word_bitSequence_dict  :: "(bitSequence)WordOr_class "  where 
      " instance_Word_WordOr_Word_bitSequence_dict = ((|
 
   lor_method = bitSeqOr |) )"
 
 
 definition instance_Word_WordXor_Word_bitSequence_dict  :: "(bitSequence)WordXor_class "  where 
      " instance_Word_WordXor_Word_bitSequence_dict = ((|
 
   lxor_method = bitSeqXor |) )"
 
 
 definition instance_Word_WordLsl_Word_bitSequence_dict  :: "(bitSequence)WordLsl_class "  where 
      " instance_Word_WordLsl_Word_bitSequence_dict = ((|
 
   lsl_method = bitSeqShiftLeft |) )"
 
 
 definition instance_Word_WordLsr_Word_bitSequence_dict  :: "(bitSequence)WordLsr_class "  where 
      " instance_Word_WordLsr_Word_bitSequence_dict = ((|
 
   lsr_method = bitSeqLogicalShiftRight |) )"
 
 
 definition instance_Word_WordAsr_Word_bitSequence_dict  :: "(bitSequence)WordAsr_class "  where 
      " instance_Word_WordAsr_Word_bitSequence_dict = ((|
 
   asr_method = bitSeqArithmeticShiftRight |) )"
 
 
 
 \<comment> \<open>\<open> ----------------------- \<close>\<close>
 \<comment> \<open>\<open> int32                   \<close>\<close>
 \<comment> \<open>\<open> ----------------------- \<close>\<close>
 
 \<comment> \<open>\<open>val int32Lnot : int32 -> int32\<close>\<close> \<comment> \<open>\<open> XXX: fix \<close>\<close>
 
 definition instance_Word_WordNot_Num_int32_dict  :: "( 32 word)WordNot_class "  where 
      " instance_Word_WordNot_Num_int32_dict = ((|
 
   lnot_method = (\<lambda> w. (NOT w))|) )"
 
 
 
 \<comment> \<open>\<open>val int32Lor  : int32 -> int32 -> int32\<close>\<close> \<comment> \<open>\<open> XXX: fix \<close>\<close>
 
 definition instance_Word_WordOr_Num_int32_dict  :: "( 32 word)WordOr_class "  where 
      " instance_Word_WordOr_Num_int32_dict = ((|
 
   lor_method = (OR)|) )"
 
 
 \<comment> \<open>\<open>val int32Lxor : int32 -> int32 -> int32\<close>\<close> \<comment> \<open>\<open> XXX: fix \<close>\<close>
 
 definition instance_Word_WordXor_Num_int32_dict  :: "( 32 word)WordXor_class "  where 
      " instance_Word_WordXor_Num_int32_dict = ((|
 
   lxor_method = (XOR)|) )"
 
 
 \<comment> \<open>\<open>val int32Land : int32 -> int32 -> int32\<close>\<close> \<comment> \<open>\<open> XXX: fix \<close>\<close>
 
 definition instance_Word_WordAnd_Num_int32_dict  :: "( 32 word)WordAnd_class "  where 
      " instance_Word_WordAnd_Num_int32_dict = ((|
 
   land_method = (AND)|) )"
 
 
 \<comment> \<open>\<open>val int32Lsl  : int32 -> nat -> int32\<close>\<close> \<comment> \<open>\<open> XXX: fix \<close>\<close>
 
 definition instance_Word_WordLsl_Num_int32_dict  :: "( 32 word)WordLsl_class "  where 
      " instance_Word_WordLsl_Num_int32_dict = ((|
 
-  lsl_method = (<<)|) )"
+  lsl_method = (\<lambda>w n. push_bit n w)|) )"
 
 
 \<comment> \<open>\<open>val int32Lsr  : int32 -> nat -> int32\<close>\<close> \<comment> \<open>\<open> XXX: fix \<close>\<close>
 
 definition instance_Word_WordLsr_Num_int32_dict  :: "( 32 word)WordLsr_class "  where 
      " instance_Word_WordLsr_Num_int32_dict = ((|
 
-  lsr_method = (>>)|) )"
+  lsr_method = (\<lambda>w n. drop_bit n w)|) )"
 
 
 
 \<comment> \<open>\<open>val int32Asr  : int32 -> nat -> int32\<close>\<close> \<comment> \<open>\<open> XXX: fix \<close>\<close>
 
 definition instance_Word_WordAsr_Num_int32_dict  :: "( 32 word)WordAsr_class "  where 
      " instance_Word_WordAsr_Num_int32_dict = ((|
 
-  asr_method = (>>>)|) )"
+  asr_method = (\<lambda>w n. signed_drop_bit n w)|) )"
 
 
 
 \<comment> \<open>\<open> ----------------------- \<close>\<close>
 \<comment> \<open>\<open> int64                   \<close>\<close>
 \<comment> \<open>\<open> ----------------------- \<close>\<close>
 
 \<comment> \<open>\<open>val int64Lnot : int64 -> int64\<close>\<close> \<comment> \<open>\<open> XXX: fix \<close>\<close>
 
 definition instance_Word_WordNot_Num_int64_dict  :: "( 64 word)WordNot_class "  where 
      " instance_Word_WordNot_Num_int64_dict = ((|
 
   lnot_method = (\<lambda> w. (NOT w))|) )"
 
 
 \<comment> \<open>\<open>val int64Lor  : int64 -> int64 -> int64\<close>\<close> \<comment> \<open>\<open> XXX: fix \<close>\<close>
 
 definition instance_Word_WordOr_Num_int64_dict  :: "( 64 word)WordOr_class "  where 
      " instance_Word_WordOr_Num_int64_dict = ((|
 
   lor_method = (OR)|) )"
 
 
 \<comment> \<open>\<open>val int64Lxor : int64 -> int64 -> int64\<close>\<close> \<comment> \<open>\<open> XXX: fix \<close>\<close>
 
 definition instance_Word_WordXor_Num_int64_dict  :: "( 64 word)WordXor_class "  where 
      " instance_Word_WordXor_Num_int64_dict = ((|
 
   lxor_method = (XOR)|) )"
 
 
 \<comment> \<open>\<open>val int64Land : int64 -> int64 -> int64\<close>\<close> \<comment> \<open>\<open> XXX: fix \<close>\<close>
 
 definition instance_Word_WordAnd_Num_int64_dict  :: "( 64 word)WordAnd_class "  where 
      " instance_Word_WordAnd_Num_int64_dict = ((|
 
   land_method = (AND)|) )"
 
 
 \<comment> \<open>\<open>val int64Lsl  : int64 -> nat -> int64\<close>\<close> \<comment> \<open>\<open> XXX: fix \<close>\<close>
 
 definition instance_Word_WordLsl_Num_int64_dict  :: "( 64 word)WordLsl_class "  where 
      " instance_Word_WordLsl_Num_int64_dict = ((|
 
-  lsl_method = (<<)|) )"
+  lsl_method = (\<lambda>w n. push_bit n w)|) )"
 
 
 \<comment> \<open>\<open>val int64Lsr  : int64 -> nat -> int64\<close>\<close> \<comment> \<open>\<open> XXX: fix \<close>\<close>
 
 definition instance_Word_WordLsr_Num_int64_dict  :: "( 64 word)WordLsr_class "  where 
      " instance_Word_WordLsr_Num_int64_dict = ((|
 
-  lsr_method = (>>)|) )"
+  lsr_method = (\<lambda>w n. drop_bit n w)|) )"
 
 
 \<comment> \<open>\<open>val int64Asr  : int64 -> nat -> int64\<close>\<close> \<comment> \<open>\<open> XXX: fix \<close>\<close>
 
 definition instance_Word_WordAsr_Num_int64_dict  :: "( 64 word)WordAsr_class "  where 
      " instance_Word_WordAsr_Num_int64_dict = ((|
 
-  asr_method = (>>>)|) )"
+  asr_method = (\<lambda>w n. signed_drop_bit n w)|) )"
 
 
 
 \<comment> \<open>\<open> ----------------------- \<close>\<close>
 \<comment> \<open>\<open> Words via bit sequences \<close>\<close>
 \<comment> \<open>\<open> ----------------------- \<close>\<close>
 
 \<comment> \<open>\<open>val defaultLnot : forall 'a. (bitSequence -> 'a) -> ('a -> bitSequence) -> 'a -> 'a\<close>\<close> 
 definition defaultLnot  :: "(bitSequence \<Rightarrow> 'a)\<Rightarrow>('a \<Rightarrow> bitSequence)\<Rightarrow> 'a \<Rightarrow> 'a "  where 
      " defaultLnot fromBitSeq toBitSeq x = ( fromBitSeq (bitSeqNegate (toBitSeq x)))"
 
 
 \<comment> \<open>\<open>val defaultLand : forall 'a. (bitSequence -> 'a) -> ('a -> bitSequence) -> 'a -> 'a -> 'a\<close>\<close>
 definition defaultLand  :: "(bitSequence \<Rightarrow> 'a)\<Rightarrow>('a \<Rightarrow> bitSequence)\<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'a "  where 
      " defaultLand fromBitSeq toBitSeq x1 x2 = ( fromBitSeq (bitSeqAnd (toBitSeq x1) (toBitSeq x2)))"
 
 
 \<comment> \<open>\<open>val defaultLor : forall 'a. (bitSequence -> 'a) -> ('a -> bitSequence) -> 'a -> 'a -> 'a\<close>\<close>
 definition defaultLor  :: "(bitSequence \<Rightarrow> 'a)\<Rightarrow>('a \<Rightarrow> bitSequence)\<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'a "  where 
      " defaultLor fromBitSeq toBitSeq x1 x2 = ( fromBitSeq (bitSeqOr (toBitSeq x1) (toBitSeq x2)))"
 
 
 \<comment> \<open>\<open>val defaultLxor : forall 'a. (bitSequence -> 'a) -> ('a -> bitSequence) -> 'a -> 'a -> 'a\<close>\<close>
 definition defaultLxor  :: "(bitSequence \<Rightarrow> 'a)\<Rightarrow>('a \<Rightarrow> bitSequence)\<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'a "  where 
      " defaultLxor fromBitSeq toBitSeq x1 x2 = ( fromBitSeq (bitSeqXor (toBitSeq x1) (toBitSeq x2)))"
 
 
 \<comment> \<open>\<open>val defaultLsl : forall 'a. (bitSequence -> 'a) -> ('a -> bitSequence) -> 'a -> nat -> 'a\<close>\<close>
 definition defaultLsl  :: "(bitSequence \<Rightarrow> 'a)\<Rightarrow>('a \<Rightarrow> bitSequence)\<Rightarrow> 'a \<Rightarrow> nat \<Rightarrow> 'a "  where 
      " defaultLsl fromBitSeq toBitSeq x n = ( fromBitSeq (bitSeqShiftLeft (toBitSeq x) n))"
 
 
 \<comment> \<open>\<open>val defaultLsr : forall 'a. (bitSequence -> 'a) -> ('a -> bitSequence) -> 'a -> nat -> 'a\<close>\<close>
 definition defaultLsr  :: "(bitSequence \<Rightarrow> 'a)\<Rightarrow>('a \<Rightarrow> bitSequence)\<Rightarrow> 'a \<Rightarrow> nat \<Rightarrow> 'a "  where 
      " defaultLsr fromBitSeq toBitSeq x n = ( fromBitSeq (bitSeqLogicalShiftRight (toBitSeq x) n))"
 
 
 \<comment> \<open>\<open>val defaultAsr : forall 'a. (bitSequence -> 'a) -> ('a -> bitSequence) -> 'a -> nat -> 'a\<close>\<close>
 definition defaultAsr  :: "(bitSequence \<Rightarrow> 'a)\<Rightarrow>('a \<Rightarrow> bitSequence)\<Rightarrow> 'a \<Rightarrow> nat \<Rightarrow> 'a "  where 
      " defaultAsr fromBitSeq toBitSeq x n = ( fromBitSeq (bitSeqArithmeticShiftRight (toBitSeq x) n))"
 
 
 \<comment> \<open>\<open> ----------------------- \<close>\<close>
 \<comment> \<open>\<open> integer                 \<close>\<close>
 \<comment> \<open>\<open> ----------------------- \<close>\<close>
 
 \<comment> \<open>\<open>val integerLnot : integer -> integer\<close>\<close>
 definition integerLnot  :: " int \<Rightarrow> int "  where 
      " integerLnot i = ( - (i +( 1 :: int)))"
 
 
 definition instance_Word_WordNot_Num_integer_dict  :: "(int)WordNot_class "  where 
      " instance_Word_WordNot_Num_integer_dict = ((|
 
   lnot_method = integerLnot |) )"
 
 
 
 \<comment> \<open>\<open>val integerLor  : integer -> integer -> integer\<close>\<close>
 definition integerLor  :: " int \<Rightarrow> int \<Rightarrow> int "  where 
      " integerLor i1 i2 = ( defaultLor integerFromBitSeq (bitSeqFromInteger None) i1 i2 )"
 
 
 definition instance_Word_WordOr_Num_integer_dict  :: "(int)WordOr_class "  where 
      " instance_Word_WordOr_Num_integer_dict = ((|
 
   lor_method = integerLor |) )"
 
 
 \<comment> \<open>\<open>val integerLxor : integer -> integer -> integer\<close>\<close>
 definition integerLxor  :: " int \<Rightarrow> int \<Rightarrow> int "  where 
      " integerLxor i1 i2 = ( defaultLxor integerFromBitSeq (bitSeqFromInteger None) i1 i2 )"
 
 
 definition instance_Word_WordXor_Num_integer_dict  :: "(int)WordXor_class "  where 
      " instance_Word_WordXor_Num_integer_dict = ((|
 
   lxor_method = integerLxor |) )"
 
 
 \<comment> \<open>\<open>val integerLand : integer -> integer -> integer\<close>\<close>
 definition integerLand  :: " int \<Rightarrow> int \<Rightarrow> int "  where 
      " integerLand i1 i2 = ( defaultLand integerFromBitSeq (bitSeqFromInteger None) i1 i2 )"
 
 
 definition instance_Word_WordAnd_Num_integer_dict  :: "(int)WordAnd_class "  where 
      " instance_Word_WordAnd_Num_integer_dict = ((|
 
   land_method = integerLand |) )"
 
 
 \<comment> \<open>\<open>val integerLsl  : integer -> nat -> integer\<close>\<close>
 definition integerLsl  :: " int \<Rightarrow> nat \<Rightarrow> int "  where 
      " integerLsl i n = ( defaultLsl integerFromBitSeq (bitSeqFromInteger None) i n )"
 
 
 definition instance_Word_WordLsl_Num_integer_dict  :: "(int)WordLsl_class "  where 
      " instance_Word_WordLsl_Num_integer_dict = ((|
 
   lsl_method = integerLsl |) )"
 
 
 \<comment> \<open>\<open>val integerAsr  : integer -> nat -> integer\<close>\<close>
 definition integerAsr  :: " int \<Rightarrow> nat \<Rightarrow> int "  where 
      " integerAsr i n = ( defaultAsr integerFromBitSeq (bitSeqFromInteger None) i n )"
 
 
 definition instance_Word_WordLsr_Num_integer_dict  :: "(int)WordLsr_class "  where 
      " instance_Word_WordLsr_Num_integer_dict = ((|
 
   lsr_method = integerAsr |) )"
 
 
 definition instance_Word_WordAsr_Num_integer_dict  :: "(int)WordAsr_class "  where 
      " instance_Word_WordAsr_Num_integer_dict = ((|
 
   asr_method = integerAsr |) )"
 
 
 
 \<comment> \<open>\<open> ----------------------- \<close>\<close>
 \<comment> \<open>\<open> int                     \<close>\<close>
 \<comment> \<open>\<open> ----------------------- \<close>\<close>
 
 \<comment> \<open>\<open> sometimes it is convenient to be able to perform bit-operations on ints.
    However, since int is not well-defined (it has different size on different systems),
    it should be used very carefully and only for operations that don't depend on the
    bitwidth of int \<close>\<close>
 
 \<comment> \<open>\<open>val intFromBitSeq : bitSequence -> int\<close>\<close>
 definition intFromBitSeq  :: " bitSequence \<Rightarrow> int "  where 
      " intFromBitSeq bs = (  (integerFromBitSeq (resizeBitSeq (Some(( 31 :: nat))) bs)))"
 
 
 
 \<comment> \<open>\<open>val bitSeqFromInt : int -> bitSequence\<close>\<close> 
 definition bitSeqFromInt  :: " int \<Rightarrow> bitSequence "  where 
      " bitSeqFromInt i = ( bitSeqFromInteger (Some(( 31 :: nat))) ( i))"
 
 
 
 \<comment> \<open>\<open>val intLnot : int -> int\<close>\<close>
 definition intLnot  :: " int \<Rightarrow> int "  where 
      " intLnot i = ( - (i +( 1 :: int)))"
 
 
 definition instance_Word_WordNot_Num_int_dict  :: "(int)WordNot_class "  where 
      " instance_Word_WordNot_Num_int_dict = ((|
 
   lnot_method = intLnot |) )"
 
 
 \<comment> \<open>\<open>val intLor  : int -> int -> int\<close>\<close>
 definition intLor  :: " int \<Rightarrow> int \<Rightarrow> int "  where 
      " intLor i1 i2 = ( defaultLor intFromBitSeq bitSeqFromInt i1 i2 )"
 
 
 definition instance_Word_WordOr_Num_int_dict  :: "(int)WordOr_class "  where 
      " instance_Word_WordOr_Num_int_dict = ((|
 
   lor_method = intLor |) )"
 
 
 \<comment> \<open>\<open>val intLxor : int -> int -> int\<close>\<close>
 definition intLxor  :: " int \<Rightarrow> int \<Rightarrow> int "  where 
      " intLxor i1 i2 = ( defaultLxor intFromBitSeq bitSeqFromInt i1 i2 )"
 
 
 definition instance_Word_WordXor_Num_int_dict  :: "(int)WordXor_class "  where 
      " instance_Word_WordXor_Num_int_dict = ((|
 
   lxor_method = intLxor |) )"
 
 
 \<comment> \<open>\<open>val intLand : int -> int -> int\<close>\<close>
 definition intLand  :: " int \<Rightarrow> int \<Rightarrow> int "  where 
      " intLand i1 i2 = ( defaultLand intFromBitSeq bitSeqFromInt i1 i2 )"
 
 
 definition instance_Word_WordAnd_Num_int_dict  :: "(int)WordAnd_class "  where 
      " instance_Word_WordAnd_Num_int_dict = ((|
 
   land_method = intLand |) )"
 
 
 \<comment> \<open>\<open>val intLsl  : int -> nat -> int\<close>\<close>
 definition intLsl  :: " int \<Rightarrow> nat \<Rightarrow> int "  where 
      " intLsl i n = ( defaultLsl intFromBitSeq bitSeqFromInt i n )"
 
 
 definition instance_Word_WordLsl_Num_int_dict  :: "(int)WordLsl_class "  where 
      " instance_Word_WordLsl_Num_int_dict = ((|
 
   lsl_method = intLsl |) )"
 
 
 \<comment> \<open>\<open>val intAsr  : int -> nat -> int\<close>\<close>
 definition intAsr  :: " int \<Rightarrow> nat \<Rightarrow> int "  where 
      " intAsr i n = ( defaultAsr intFromBitSeq bitSeqFromInt i n )"
 
 
 definition instance_Word_WordAsr_Num_int_dict  :: "(int)WordAsr_class "  where 
      " instance_Word_WordAsr_Num_int_dict = ((|
 
   asr_method = intAsr |) )"
 
 
 
 
 \<comment> \<open>\<open> ----------------------- \<close>\<close>
 \<comment> \<open>\<open> natural                 \<close>\<close>
 \<comment> \<open>\<open> ----------------------- \<close>\<close>
 
 \<comment> \<open>\<open> some operations work also on positive numbers \<close>\<close>
 
 \<comment> \<open>\<open>val naturalFromBitSeq : bitSequence -> natural\<close>\<close>
 definition naturalFromBitSeq  :: " bitSequence \<Rightarrow> nat "  where 
      " naturalFromBitSeq bs = ( nat (abs (integerFromBitSeq bs)))"
 
 
 \<comment> \<open>\<open>val bitSeqFromNatural : maybe nat -> natural -> bitSequence\<close>\<close>
 definition bitSeqFromNatural  :: "(nat)option \<Rightarrow> nat \<Rightarrow> bitSequence "  where 
      " bitSeqFromNatural len n = ( bitSeqFromInteger len (int n))"
 
 
 \<comment> \<open>\<open>val naturalLor  : natural -> natural -> natural\<close>\<close>
 definition naturalLor  :: " nat \<Rightarrow> nat \<Rightarrow> nat "  where 
      " naturalLor i1 i2 = ( defaultLor naturalFromBitSeq (bitSeqFromNatural None) i1 i2 )"
 
 
 definition instance_Word_WordOr_Num_natural_dict  :: "(nat)WordOr_class "  where 
      " instance_Word_WordOr_Num_natural_dict = ((|
 
   lor_method = naturalLor |) )"
 
 
 \<comment> \<open>\<open>val naturalLxor : natural -> natural -> natural\<close>\<close>
 definition naturalLxor  :: " nat \<Rightarrow> nat \<Rightarrow> nat "  where 
      " naturalLxor i1 i2 = ( defaultLxor naturalFromBitSeq (bitSeqFromNatural None) i1 i2 )"
 
 
 definition instance_Word_WordXor_Num_natural_dict  :: "(nat)WordXor_class "  where 
      " instance_Word_WordXor_Num_natural_dict = ((|
 
   lxor_method = naturalLxor |) )"
 
 
 \<comment> \<open>\<open>val naturalLand : natural -> natural -> natural\<close>\<close>
 definition naturalLand  :: " nat \<Rightarrow> nat \<Rightarrow> nat "  where 
      " naturalLand i1 i2 = ( defaultLand naturalFromBitSeq (bitSeqFromNatural None) i1 i2 )"
 
 
 definition instance_Word_WordAnd_Num_natural_dict  :: "(nat)WordAnd_class "  where 
      " instance_Word_WordAnd_Num_natural_dict = ((|
 
   land_method = naturalLand |) )"
 
 
 \<comment> \<open>\<open>val naturalLsl  : natural -> nat -> natural\<close>\<close>
 definition naturalLsl  :: " nat \<Rightarrow> nat \<Rightarrow> nat "  where 
      " naturalLsl i n = ( defaultLsl naturalFromBitSeq (bitSeqFromNatural None) i n )"
 
 
 definition instance_Word_WordLsl_Num_natural_dict  :: "(nat)WordLsl_class "  where 
      " instance_Word_WordLsl_Num_natural_dict = ((|
 
   lsl_method = naturalLsl |) )"
 
 
 \<comment> \<open>\<open>val naturalAsr  : natural -> nat -> natural\<close>\<close>
 definition naturalAsr  :: " nat \<Rightarrow> nat \<Rightarrow> nat "  where 
      " naturalAsr i n = ( defaultAsr naturalFromBitSeq (bitSeqFromNatural None) i n )"
 
 
 definition instance_Word_WordLsr_Num_natural_dict  :: "(nat)WordLsr_class "  where 
      " instance_Word_WordLsr_Num_natural_dict = ((|
 
   lsr_method = naturalAsr |) )"
 
 
 definition instance_Word_WordAsr_Num_natural_dict  :: "(nat)WordAsr_class "  where 
      " instance_Word_WordAsr_Num_natural_dict = ((|
 
   asr_method = naturalAsr |) )"
 
 
 
 \<comment> \<open>\<open> ----------------------- \<close>\<close>
 \<comment> \<open>\<open> nat                     \<close>\<close>
 \<comment> \<open>\<open> ----------------------- \<close>\<close>
 
 \<comment> \<open>\<open> sometimes it is convenient to be able to perform bit-operations on nats.
    However, since nat is not well-defined (it has different size on different systems),
    it should be used very carefully and only for operations that don't depend on the
    bitwidth of nat \<close>\<close>
 
 \<comment> \<open>\<open>val natFromBitSeq : bitSequence -> nat\<close>\<close>
 definition natFromBitSeq  :: " bitSequence \<Rightarrow> nat "  where 
      " natFromBitSeq bs = (  (naturalFromBitSeq (resizeBitSeq (Some(( 31 :: nat))) bs)))"
 
 
 
 \<comment> \<open>\<open>val bitSeqFromNat : nat -> bitSequence\<close>\<close> 
 definition bitSeqFromNat  :: " nat \<Rightarrow> bitSequence "  where 
      " bitSeqFromNat i = ( bitSeqFromNatural (Some(( 31 :: nat))) ( i))"
 
 
 
 \<comment> \<open>\<open>val natLor  : nat -> nat -> nat\<close>\<close>
 definition natLor  :: " nat \<Rightarrow> nat \<Rightarrow> nat "  where 
      " natLor i1 i2 = ( defaultLor natFromBitSeq bitSeqFromNat i1 i2 )"
 
 
 definition instance_Word_WordOr_nat_dict  :: "(nat)WordOr_class "  where 
      " instance_Word_WordOr_nat_dict = ((|
 
   lor_method = natLor |) )"
 
 
 \<comment> \<open>\<open>val natLxor : nat -> nat -> nat\<close>\<close>
 definition natLxor  :: " nat \<Rightarrow> nat \<Rightarrow> nat "  where 
      " natLxor i1 i2 = ( defaultLxor natFromBitSeq bitSeqFromNat i1 i2 )"
 
 
 definition instance_Word_WordXor_nat_dict  :: "(nat)WordXor_class "  where 
      " instance_Word_WordXor_nat_dict = ((|
 
   lxor_method = natLxor |) )"
 
 
 \<comment> \<open>\<open>val natLand : nat -> nat -> nat\<close>\<close>
 definition natLand  :: " nat \<Rightarrow> nat \<Rightarrow> nat "  where 
      " natLand i1 i2 = ( defaultLand natFromBitSeq bitSeqFromNat i1 i2 )"
 
 
 definition instance_Word_WordAnd_nat_dict  :: "(nat)WordAnd_class "  where 
      " instance_Word_WordAnd_nat_dict = ((|
 
   land_method = natLand |) )"
 
 
 \<comment> \<open>\<open>val natLsl  : nat -> nat -> nat\<close>\<close>
 definition natLsl  :: " nat \<Rightarrow> nat \<Rightarrow> nat "  where 
      " natLsl i n = ( defaultLsl natFromBitSeq bitSeqFromNat i n )"
 
 
 definition instance_Word_WordLsl_nat_dict  :: "(nat)WordLsl_class "  where 
      " instance_Word_WordLsl_nat_dict = ((|
 
   lsl_method = natLsl |) )"
 
 
 \<comment> \<open>\<open>val natAsr  : nat -> nat -> nat\<close>\<close>
 definition natAsr  :: " nat \<Rightarrow> nat \<Rightarrow> nat "  where 
      " natAsr i n = ( defaultAsr natFromBitSeq bitSeqFromNat i n )"
 
 
 definition instance_Word_WordAsr_nat_dict  :: "(nat)WordAsr_class "  where 
      " instance_Word_WordAsr_nat_dict = ((|
 
   asr_method = natAsr |) )"
 
 
 end
diff --git a/thys/IP_Addresses/IPv4.thy b/thys/IP_Addresses/IPv4.thy
--- a/thys/IP_Addresses/IPv4.thy
+++ b/thys/IP_Addresses/IPv4.thy
@@ -1,261 +1,260 @@
 (*  Title:      IPv4.thy
     Authors:    Cornelius Diekmann, Julius Michaelis
 *)
 theory IPv4
 imports IP_Address
         NumberWang_IPv4
         (* include "HOL-Library.Code_Target_Nat" if you need to work with actual numbers.*)
 begin
 
 lemma take_bit_word_beyond_length_eq:
   \<open>take_bit n w = w\<close> if \<open>LENGTH('a) \<le> n\<close> for w :: \<open>'a::len word\<close>
   using that by transfer simp
 
 
 section \<open>IPv4 Adresses\<close>
   text\<open>An IPv4 address is basically a 32 bit unsigned integer.\<close>
   type_synonym ipv4addr = "32 word"
 
   text\<open>Conversion between natural numbers and IPv4 adresses\<close>
   definition nat_of_ipv4addr :: "ipv4addr \<Rightarrow> nat" where
     "nat_of_ipv4addr a = unat a"
   definition ipv4addr_of_nat :: "nat \<Rightarrow> ipv4addr" where
     "ipv4addr_of_nat n =  of_nat n"
 
   text\<open>The maximum IPv4 addres\<close>
   definition max_ipv4_addr :: "ipv4addr" where
     "max_ipv4_addr \<equiv> ipv4addr_of_nat ((2^32) - 1)"
 
   lemma max_ipv4_addr_number: "max_ipv4_addr = 4294967295"
     unfolding max_ipv4_addr_def ipv4addr_of_nat_def by(simp)
   lemma "max_ipv4_addr = 0b11111111111111111111111111111111"
     by(fact max_ipv4_addr_number)
   lemma max_ipv4_addr_max_word: "max_ipv4_addr = - 1"
     by(simp add: max_ipv4_addr_number)
   lemma max_ipv4_addr_max[simp]: "\<forall>a. a \<le> max_ipv4_addr"
     by(simp add: max_ipv4_addr_max_word)
   lemma UNIV_ipv4addrset: "UNIV = {0 .. max_ipv4_addr}" (*not in the simp set, for a reason*)
     by(simp add: max_ipv4_addr_max_word) fastforce
 
   text\<open>identity functions\<close>
   lemma nat_of_ipv4addr_ipv4addr_of_nat_mod: "nat_of_ipv4addr (ipv4addr_of_nat n) = n mod 2^32"
     by (simp add: ipv4addr_of_nat_def nat_of_ipv4addr_def unat_of_nat take_bit_eq_mod)
   lemma nat_of_ipv4addr_ipv4addr_of_nat:
     "\<lbrakk> n \<le> nat_of_ipv4addr max_ipv4_addr \<rbrakk> \<Longrightarrow> nat_of_ipv4addr (ipv4addr_of_nat n) = n"
     by (simp add: nat_of_ipv4addr_ipv4addr_of_nat_mod max_ipv4_addr_def)
   lemma ipv4addr_of_nat_nat_of_ipv4addr: "ipv4addr_of_nat (nat_of_ipv4addr addr) = addr"
     by(simp add: ipv4addr_of_nat_def nat_of_ipv4addr_def)
 
 subsection\<open>Representing IPv4 Adresses (Syntax)\<close>
   fun ipv4addr_of_dotdecimal :: "nat \<times> nat \<times> nat \<times> nat \<Rightarrow> ipv4addr" where
     "ipv4addr_of_dotdecimal (a,b,c,d) = ipv4addr_of_nat (d + 256 * c + 65536 * b + 16777216 * a )"
 
   fun dotdecimal_of_ipv4addr :: "ipv4addr \<Rightarrow> nat \<times> nat \<times> nat \<times> nat" where
     "dotdecimal_of_ipv4addr a = (nat_of_ipv4addr ((a >> 24) AND 0xFF),
                                     nat_of_ipv4addr ((a >> 16) AND 0xFF),
                                     nat_of_ipv4addr ((a >> 8) AND 0xFF),
                                     nat_of_ipv4addr (a AND 0xff))"
 
   declare ipv4addr_of_dotdecimal.simps[simp del]
   declare dotdecimal_of_ipv4addr.simps[simp del]
 
   text\<open>Examples:\<close>
   lemma "ipv4addr_of_dotdecimal (192, 168, 0, 1) = 3232235521"
     by(simp add: ipv4addr_of_dotdecimal.simps ipv4addr_of_nat_def)
     (*could be solved by eval, but needs "HOL-Library.Code_Target_Nat"*)
   lemma "dotdecimal_of_ipv4addr 3232235521 = (192, 168, 0, 1)"
     by(simp add: dotdecimal_of_ipv4addr.simps nat_of_ipv4addr_def)
 
   text\<open>a different notation for @{term ipv4addr_of_dotdecimal}\<close>
   lemma ipv4addr_of_dotdecimal_bit:
     "ipv4addr_of_dotdecimal (a,b,c,d) =
       (ipv4addr_of_nat a << 24) + (ipv4addr_of_nat b << 16) +
        (ipv4addr_of_nat c << 8) + ipv4addr_of_nat d"
   proof -
     have a: "(ipv4addr_of_nat a) << 24 = ipv4addr_of_nat (a * 16777216)"
       by(simp add: ipv4addr_of_nat_def shiftl_t2n)
     have b: "(ipv4addr_of_nat b) << 16 = ipv4addr_of_nat (b * 65536)"
       by(simp add: ipv4addr_of_nat_def shiftl_t2n)
     have c: "(ipv4addr_of_nat c) << 8 = ipv4addr_of_nat (c * 256)"
       by(simp add: ipv4addr_of_nat_def shiftl_t2n)
     have ipv4addr_of_nat_suc: "\<And>x. ipv4addr_of_nat (Suc x) = word_succ (ipv4addr_of_nat (x))"
       by(simp add: ipv4addr_of_nat_def, metis Abs_fnat_hom_Suc of_nat_Suc)
     { fix x y
       have "ipv4addr_of_nat x + ipv4addr_of_nat y = ipv4addr_of_nat (x+y)"
         apply(induction x arbitrary: y)
          apply(simp add: ipv4addr_of_nat_def; fail)
         by(simp add: ipv4addr_of_nat_suc word_succ_p1)
     } from this a b c
     show ?thesis
       apply(simp add: ipv4addr_of_dotdecimal.simps)
       apply(rule arg_cong[where f=ipv4addr_of_nat])
       apply(thin_tac _)+
       by presburger
   qed
 
   lemma size_ipv4addr: "size (x::ipv4addr) = 32" by(simp add:word_size)
 
   lemma dotdecimal_of_ipv4addr_ipv4addr_of_dotdecimal:
   "\<lbrakk> a < 256; b < 256; c < 256; d < 256 \<rbrakk> \<Longrightarrow>
     dotdecimal_of_ipv4addr (ipv4addr_of_dotdecimal (a,b,c,d)) = (a,b,c,d)"
   proof -
     assume  "a < 256" and "b < 256" and "c < 256" and "d < 256"
     note assms= \<open>a < 256\<close> \<open>b < 256\<close> \<open>c < 256\<close> \<open>d < 256\<close>
     hence a:  "nat_of_ipv4addr ((ipv4addr_of_nat (d + 256 * c + 65536 * b + 16777216 * a) >> 24) AND mask 8) = a"
       apply (simp add: ipv4addr_of_nat_def nat_of_ipv4addr_def)
       apply transfer
       apply (simp add: drop_bit_take_bit nat_take_bit_eq flip: take_bit_eq_mask)
       apply (simp add: drop_bit_eq_div take_bit_eq_mod)
       done
     have ipv4addr_of_nat_AND_mask8: "(ipv4addr_of_nat a) AND mask 8 = (ipv4addr_of_nat (a mod 256))"
       for a
       apply (simp add: ipv4addr_of_nat_def)
       apply transfer
       apply (simp flip: take_bit_eq_mask)
       apply (simp add: take_bit_eq_mod of_nat_mod)
       done
     from assms have b:
       "nat_of_ipv4addr ((ipv4addr_of_nat (d + 256 * c + 65536 * b + 16777216 * a) >> 16) AND mask 8) = b"
       apply (simp add: ipv4addr_of_nat_def nat_of_ipv4addr_def)
       apply transfer
       apply (simp add: drop_bit_take_bit flip: take_bit_eq_mask)
       using div65536
       apply (simp add: drop_bit_eq_div take_bit_eq_mod)
       done
     from assms have c:
       "nat_of_ipv4addr ((ipv4addr_of_nat (d + 256 * c + 65536 * b + 16777216 * a) >> 8) AND mask 8) = c"
       apply (simp add: ipv4addr_of_nat_def nat_of_ipv4addr_def)
       apply transfer
       apply (simp add: drop_bit_take_bit flip: take_bit_eq_mask)
       using div256
       apply (simp add: drop_bit_eq_div take_bit_eq_mod)
       done
     from \<open>d < 256\<close> have d: "nat_of_ipv4addr (ipv4addr_of_nat (d + 256 * c + 65536 * b + 16777216 * a) AND mask 8) = d"
       apply (simp add: ipv4addr_of_nat_AND_mask8 ipv4addr_of_nat_def nat_of_ipv4addr_def)
       apply transfer
       apply (simp flip: take_bit_eq_mask)
       apply (simp add: take_bit_eq_mod nat_mod_distrib nat_add_distrib nat_mult_distrib mod256)
       done
     from a b c d show ?thesis
       apply (simp add: ipv4addr_of_dotdecimal.simps dotdecimal_of_ipv4addr.simps)
-      apply (simp add: mask_eq)
+      apply (simp add: mask_eq push_bit_of_1)
       done
   qed
 
   lemma ipv4addr_of_dotdecimal_dotdecimal_of_ipv4addr:
     "(ipv4addr_of_dotdecimal (dotdecimal_of_ipv4addr ip)) = ip"
   proof -
     have ip_and_mask8_bl_drop24: "(ip::ipv4addr) AND mask 8 = of_bl (drop 24 (to_bl ip))"
       by(simp add: of_drop_to_bl size_ipv4addr)
     have List_rev_drop_geqn: "length x \<ge> n \<Longrightarrow> (take n (rev x)) = rev (drop (length x - n) x)"
       for x :: "'a list" and n by(simp add: List.rev_drop)
     have and_mask_bl_take: "length x \<ge> n \<Longrightarrow> ((of_bl x) AND mask n) = (of_bl (rev (take n (rev (x)))))"
       for x n by(simp add: List_rev_drop_geqn of_bl_drop)
     have ipv4addr_and_255: "x AND 255 = x AND mask 8" for x :: ipv4addr
-      by(simp add: mask_eq)
+      by (simp add: mask_eq push_bit_of_1)
     have bit_equality:
       "((ip >> 24) AND 0xFF << 24) + ((ip >> 16) AND 0xFF << 16) + ((ip >> 8) AND 0xFF << 8) + (ip AND 0xFF) =
        of_bl (take 8 (to_bl ip) @ take 8 (drop 8 (to_bl ip)) @ take 8 (drop 16 (to_bl ip)) @ drop 24 (to_bl ip))"
       apply(simp add: ipv4addr_and_255)
       apply(simp add: shiftr_slice)
-      apply(simp add: slice_take' size_ipv4addr)
-      apply(simp add: and_mask_bl_take)
+      apply(simp add: slice_take' size_ipv4addr and_mask_bl_take flip: push_bit_and)
       apply(simp add: List_rev_drop_geqn)
       apply(simp add: drop_take)
       apply(simp add: shiftl_of_bl)
       apply(simp add: of_bl_append)
       apply(simp add: ip_and_mask8_bl_drop24)
       done
     have blip_split: "\<And> blip. length blip = 32 \<Longrightarrow>
       blip = (take 8 blip) @ (take 8 (drop 8 blip)) @ (take 8 (drop 16 blip)) @ (take 8 (drop 24 blip))"
       by(rename_tac blip,case_tac blip,simp_all)+ (*I'm so sorry for this ...*)
     have "ipv4addr_of_dotdecimal (dotdecimal_of_ipv4addr ip) = of_bl (to_bl ip)"
-      apply(subst blip_split)
-       apply(simp; fail)
-      apply(simp add: ipv4addr_of_dotdecimal_bit dotdecimal_of_ipv4addr.simps)
-      apply(simp add: ipv4addr_of_nat_nat_of_ipv4addr)
-      apply(simp add: bit_equality)
+      apply (subst blip_split)
+       apply simp
+      apply (simp add: ipv4addr_of_dotdecimal_bit dotdecimal_of_ipv4addr.simps)
+      apply (simp add: ipv4addr_of_nat_nat_of_ipv4addr)
+      apply (simp flip: bit_equality)
       done
     thus ?thesis using word_bl.Rep_inverse[symmetric] by simp
   qed
 
   lemma ipv4addr_of_dotdecimal_eqE:
     "\<lbrakk> ipv4addr_of_dotdecimal (a,b,c,d) = ipv4addr_of_dotdecimal (e,f,g,h);
        a < 256; b < 256; c < 256; d < 256; e < 256; f < 256; g < 256; h < 256 \<rbrakk> \<Longrightarrow>
          a = e \<and> b = f \<and> c = g \<and> d = h"
      by (metis Pair_inject dotdecimal_of_ipv4addr_ipv4addr_of_dotdecimal)
 
 subsection\<open>IP Ranges: Examples\<close>
   lemma "(UNIV :: ipv4addr set) = {0 .. max_ipv4_addr}" by(simp add: UNIV_ipv4addrset)
   lemma "(42::ipv4addr) \<in> UNIV" by(simp)
 
   (*Warning, not executable!*)
 
   lemma "ipset_from_netmask (ipv4addr_of_dotdecimal (192,168,0,42)) (ipv4addr_of_dotdecimal (255,255,0,0)) =
           {ipv4addr_of_dotdecimal (192,168,0,0) .. ipv4addr_of_dotdecimal (192,168,255,255)}"
    by(simp add: ipset_from_netmask_def ipv4addr_of_dotdecimal.simps ipv4addr_of_nat_def)
 
   lemma "ipset_from_netmask (ipv4addr_of_dotdecimal (192,168,0,42)) (ipv4addr_of_dotdecimal (0,0,0,0)) = UNIV"
     by(simp add: UNIV_ipv4addrset ipset_from_netmask_def ipv4addr_of_dotdecimal.simps
                  ipv4addr_of_nat_def max_ipv4_addr_max_word)
 
   text\<open>192.168.0.0/24\<close>
 
   lemma fixes addr :: ipv4addr
     shows "ipset_from_cidr addr pflength =
             ipset_from_netmask addr ((mask pflength) << (32 - pflength))"
     by(simp add: ipset_from_cidr_def)
 
   lemma "ipset_from_cidr (ipv4addr_of_dotdecimal (192,168,0,42)) 16 =
           {ipv4addr_of_dotdecimal (192,168,0,0) .. ipv4addr_of_dotdecimal (192,168,255,255)}"
-   by(simp add: ipset_from_cidr_alt mask_eq ipv4addr_of_dotdecimal.simps ipv4addr_of_nat_def)
+   by(simp add: ipset_from_cidr_alt mask_eq ipv4addr_of_dotdecimal.simps ipv4addr_of_nat_def push_bit_of_1)
 
   lemma "ip \<in> (ipset_from_cidr (ipv4addr_of_dotdecimal (0, 0, 0, 0)) 0)"
     by(simp add: ipset_from_cidr_0)
 
   lemma ipv4set_from_cidr_32: fixes addr :: ipv4addr
     shows "ipset_from_cidr addr 32 = {addr}"
     by (simp add: ipset_from_cidr_alt take_bit_word_beyond_length_eq flip: take_bit_eq_mask)
 
   lemma  fixes pre :: ipv4addr
     shows "ipset_from_cidr pre len = {(pre AND ((mask len) << (32 - len))) .. pre OR (mask (32 - len))}"
     by (simp add: ipset_from_cidr_alt ipset_from_cidr_def)
 
   text\<open>making element check executable\<close>
   lemma addr_in_ipv4set_from_netmask_code[code_unfold]:
     fixes addr :: ipv4addr
     shows "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: addr_in_ipset_from_netmask_code)
   lemma addr_in_ipv4set_from_cidr_code[code_unfold]:
     fixes addr :: ipv4addr
     shows "addr \<in> (ipset_from_cidr pre len) \<longleftrightarrow>
               (pre AND ((mask len) << (32 - len))) \<le> addr \<and> addr \<le> pre OR (mask (32 - len))"
     by(simp add: addr_in_ipset_from_cidr_code)
 
   (*small numbers because we didn't load Code_Target_Nat. Should work by eval*)
 lemma "ipv4addr_of_dotdecimal (192,168,42,8) \<in> (ipset_from_cidr (ipv4addr_of_dotdecimal (192,168,0,0)) 16)"
   by (simp add: ipv4addr_of_nat_def ipset_from_cidr_def ipv4addr_of_dotdecimal.simps
     ipset_from_netmask_def mask_eq_exp_minus_1 word_le_def take_bit_minus_one_eq_mask)
 
   definition ipv4range_UNIV :: "32 wordinterval" where "ipv4range_UNIV \<equiv> wordinterval_UNIV"
 
   lemma ipv4range_UNIV_set_eq: "wordinterval_to_set ipv4range_UNIV = UNIV"
     by(simp only: ipv4range_UNIV_def wordinterval_UNIV_set_eq)
 
 
   thm iffD1[OF wordinterval_eq_set_eq]
   (*TODO: probably the following is a good idea?*)
   (*
   declare iffD1[OF wordinterval_eq_set_eq, cong]
   *)
 
 
   text\<open>This \<open>LENGTH('a)\<close> is 32 for IPv4 addresses.\<close>
   lemma ipv4cidr_to_interval_simps[code_unfold]: "ipcidr_to_interval ((pre::ipv4addr), len) = (
       let netmask = (mask len) << (32 - len);
           network_prefix = (pre AND netmask)
       in (network_prefix, network_prefix OR (NOT netmask)))"
   by(simp add: ipcidr_to_interval_def Let_def ipcidr_to_interval_start.simps ipcidr_to_interval_end.simps)
 
 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,946 +1,956 @@
 (*  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)
 
   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 = - 1"
     by(simp add: max_ipv6_addr_number)
   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_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 take_bit_eq_mod)
   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_ipv6addr_of_nat_mod max_ipv6_addr_def)
   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_eq)+
+    by (simp_all add: mask_eq push_bit_of_1)
 
 
   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
       by (metis is_aligned_shift is_aligned_shiftr_shiftl shiftr_and_eq_shiftl)
     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)+
+            apply (simp_all add: word128_masks_ipv6pieces ucast_ipv6_piece and_mask2 word_size flip: take_bit_eq_mask)
+            apply (simp_all add: bit_eq_iff)
+            apply (auto simp add: bit_simps)
+      done
 
     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_eq)
+      apply(simp add: mask_eq push_bit_of_1)
       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)
+      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 ucast_ucast_mask)
+      using ipv6addr_16word_pieces_compose_or
+      apply (simp flip: push_bit_and add: shiftr_and_eq_shiftl)
       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
+    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)
+      apply (simp add: unsigned_or_eq)
+      apply (simp flip: take_bit_eq_mask add: unsigned_take_bit_eq take_bit_word_eq_self)
+      apply (simp add: shiftl_shiftr1 shiftl_shiftr2)
+      apply (simp flip: take_bit_eq_mask push_bit_and add: word_size)
+      apply (simp add: unsigned_take_bit_eq take_bit_word_eq_self)
+      apply (simp flip: unsigned_take_bit_eq)
+      apply (simp add: unsigned_ucast_eq)
+      apply (simp add: unsigned_push_bit_eq take_bit_word_eq_self)
+      apply (simp flip: ucast_drop_bit_eq)
+      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 numeral_eq_Suc) (*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/NumberWang_IPv6.thy b/thys/IP_Addresses/NumberWang_IPv6.thy
--- a/thys/IP_Addresses/NumberWang_IPv6.thy
+++ b/thys/IP_Addresses/NumberWang_IPv6.thy
@@ -1,230 +1,230 @@
 theory NumberWang_IPv6
 imports 
   Word_Lib.Word_Lemmas
   Word_Lib.Word_Syntax
   Word_Lib.Reversed_Bit_Lists
 begin
 
 section\<open>Helper Lemmas for Low-Level Operations on Machine Words\<close>
 text\<open>Needed for IPv6 Syntax\<close>
 
 lemma length_drop_bl: "length (dropWhile Not (to_bl (of_bl bs))) \<le> length bs"
 proof -
   have length_takeWhile_Not_replicate_False:
     "length (takeWhile Not (replicate n False @ ls)) = n + length (takeWhile Not ls)"
   for n ls by(subst takeWhile_append2) simp+
   show ?thesis by(simp add: word_rep_drop dropWhile_eq_drop length_takeWhile_Not_replicate_False)
 qed
 
 lemma bl_drop_leading_zeros: 
       "(of_bl:: bool list \<Rightarrow> 'a::len word) (dropWhile Not bs) =
        (of_bl:: bool list \<Rightarrow> 'a::len word) bs"
 by(induction bs) simp_all
 
 
 lemma bl_length_drop_bound: assumes "length (dropWhile Not bs) \<le> n"
   shows "length (dropWhile Not (to_bl ((of_bl:: bool list \<Rightarrow> 'a::len word) bs))) \<le> n"
 proof -
   have bl_length_drop_twice: 
       "length (dropWhile Not (to_bl ((of_bl:: bool list \<Rightarrow> 'a::len word) (dropWhile Not bs)))) =
        length (dropWhile Not (to_bl ((of_bl:: bool list \<Rightarrow> 'a::len word) bs)))"
     by(simp add: bl_drop_leading_zeros)
   from length_drop_bl
   have *: "length (dropWhile Not (to_bl ((of_bl:: bool list \<Rightarrow> 'a::len word) bs))) \<le> length (dropWhile Not bs)"
    apply(rule dual_order.trans)
    apply(subst bl_length_drop_twice)
    ..
   show ?thesis
   apply(rule order.trans, rule *)
   using assms by(simp)
 qed
 
 lemma length_drop_mask_outer: fixes ip::"'a::len word"
   shows "LENGTH('a) - n' = len \<Longrightarrow> length (dropWhile Not (to_bl (ip AND (mask n << n') >> n'))) \<le> len"
   apply(subst word_and_mask_shiftl)
   apply(subst shiftl_shiftr1)
    apply(simp; fail)
   apply(simp)
   apply(subst and_mask)
   apply(simp add: word_size)
   apply(simp add: length_drop_mask)
   done
 lemma length_drop_mask_inner: fixes ip::"'a::len word"
   shows "n \<le> LENGTH('a) - n' \<Longrightarrow> length (dropWhile Not (to_bl (ip AND (mask n << n') >> n'))) \<le> n"
   apply(subst word_and_mask_shiftl)
   apply(subst shiftl_shiftr3)
    apply(simp; fail)
   apply(simp)
   apply(simp add: word_size)
   apply(simp add: mask_twice)
   apply(simp add: length_drop_mask)
   done
 
 
 lemma mask128: "0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF = (mask 128 :: 'a::len word)"
-  by (simp add: mask_eq)
+  by (simp add: mask_eq push_bit_of_1)
 
 
 (*-------------- things for ipv6 syntax round trip property two ------------------*)
 
 (*n small, m large*)
 lemma helper_masked_ucast_generic:
   fixes b::"16 word"
   assumes "n + 16 \<le> m" and "m < 128"
   shows "((ucast:: 16 word \<Rightarrow> 128 word) b << n) && (mask 16 << m) = 0"
 proof -
   have "x < 2 ^ (m - n)" if mnh2: "x < 0x10000"
     for x::"128 word"
   proof -
     from assms(1) have mnh3: "16 \<le> m - n" by fastforce
     have power_2_16_nat: "(16::nat) \<le> n \<Longrightarrow> (65535::nat) < 2 ^ n" if a:"16 \<le> n"for n
     proof -
       have power2_rule: "a \<le> b \<Longrightarrow> (2::nat)^a \<le> 2 ^ b" for a b by fastforce
       show ?thesis
        apply(subgoal_tac "65536 \<le> 2 ^ n")
         apply(subst Nat.less_eq_Suc_le)
         apply(simp; fail)
        apply(subgoal_tac "(65536::nat) = 2^16")
         subgoal using power2_rule \<open>16 \<le> n\<close> by presburger
        by(simp)
     qed
     have "65536 = unat (65536::128 word)" by auto
     moreover from mnh2 have "unat x <  unat (65536::128 word)" by(rule Word.unat_mono)
     ultimately have x: "unat x < 65536" by simp
     with mnh3 have "unat x < 2 ^ (m - n)" 
       using power_2_16_nat [of \<open>m - n\<close>] by simp
     with assms(2) show ?thesis by(subst word_less_nat_alt) simp
   qed
   hence mnhelper2: "(of_bl::bool list \<Rightarrow> 128 word) (to_bl b) < 2 ^ (m - n)"
     apply(subgoal_tac "(of_bl::bool list \<Rightarrow> 128 word) (to_bl b) < 2^(LENGTH(16))")
      apply(simp; fail)
     by(rule of_bl_length_less) simp+
   have mnhelper3: "(of_bl::bool list \<Rightarrow> 128 word) (to_bl b) * 2 ^ n < 2 ^ m"
     apply(rule div_lt_mult)
      apply(rule word_less_two_pow_divI)
        using assms by(simp_all add: mnhelper2 p2_gt_0)
 
   from assms show ?thesis
     apply(subst ucast_bl)+
     apply(subst shiftl_of_bl)
     apply(subst of_bl_append)
     apply simp
     apply(subst word_and_mask_shiftl)
     apply(subst shiftr_div_2n_w)
      subgoal by(simp add: word_size; fail)
     apply(subst word_div_less)
      subgoal by(rule mnhelper3)
     apply simp
     done
 qed
 
 
 lemma unat_of_bl_128_16_less_helper:
   fixes b::"16 word"
   shows "unat ((of_bl::bool list \<Rightarrow> 128 word) (to_bl b)) < 2^16"
 proof -
   from word_bl_Rep' have 1: "length (to_bl b) = 16" by simp
   have "unat ((of_bl::bool list \<Rightarrow> 128 word) (to_bl b)) < 2^(length (to_bl b))"
     by(fact unat_of_bl_length)
   with 1 show ?thesis by auto
 qed
 lemma unat_of_bl_128_16_le_helper: "unat ((of_bl:: bool list \<Rightarrow> 128 word) (to_bl (b::16 word))) \<le> 65535"
 proof -
   from unat_of_bl_128_16_less_helper[of b] have
     "unat ((of_bl:: bool list \<Rightarrow> 128 word) (to_bl b)) < 65536" by simp 
   from Suc_leI[OF this] show ?thesis by simp
 qed
 
 
 (*reverse*)
  lemma helper_masked_ucast_reverse_generic:
    fixes b::"16 word"
    assumes "m + 16 \<le> n" and "n \<le> 128 - 16"
    shows "((ucast:: 16 word \<Rightarrow> 128 word) b << n) && (mask 16 << m) = 0"
  proof -
 
    have power_less_128_helper: "2 ^ n * unat ((of_bl::bool list \<Rightarrow> 128 word) (to_bl b)) < 2 ^ LENGTH(128)"
      if n: "n \<le> 128 - 16" for n
    proof -
      have help_mult: "n \<le> l \<Longrightarrow> 2 ^ n * x < 2 ^ l \<longleftrightarrow> x < 2 ^ (l - n)" for x::nat and l
        by (simp add: nat_mult_power_less_eq semiring_normalization_rules(7))
      from n show ?thesis
        apply(subst help_mult)
         subgoal by (simp)
        apply(rule order_less_le_trans)
         apply(rule unat_of_bl_128_16_less_helper)
        apply(rule Power.power_increasing)
         apply(simp_all)
        done
    qed
 
    have *: "2 ^ m * (2 ^ (n - m) * unat ((of_bl::bool list \<Rightarrow> 128 word) (to_bl b))) = 
             2 ^ n * unat ((of_bl::bool list \<Rightarrow> 128 word) (to_bl b))"
    proof(cases "unat ((of_bl::bool list \<Rightarrow> 128 word) (to_bl b)) = 0")
    case True thus ?thesis by simp
    next
    case False
     have help_mult: "x \<noteq> 0 \<Longrightarrow> b * (c * x) = a * (x::nat)  \<longleftrightarrow> b * c = a" for x a b c by simp
     from assms show ?thesis
      apply(subst help_mult[OF False])
      apply(subst Power.monoid_mult_class.power_add[symmetric])
      apply(simp)
      done
    qed
 
   from assms have "unat ((2 ^ n)::128 word) * unat ((of_bl::bool list \<Rightarrow> 128 word) (to_bl b)) mod 2 ^ LENGTH(128) =
         2 ^ m * (2 ^ (n - m) * unat ((of_bl::bool list \<Rightarrow> 128 word) (to_bl b)) mod 2 ^ LENGTH(128))"
      apply(subst nat_mod_eq')
       subgoal apply(subst unat_power_lower)
        subgoal by(simp; fail)
       subgoal by (rule power_less_128_helper) simp
       done
      apply(subst nat_mod_eq')
       subgoal by(rule power_less_128_helper) simp
      apply(subst unat_power_lower)
       apply(simp; fail)
      apply(simp only: *)
      done
    hence ex_k: "\<exists>k. unat ((2 ^ n)::128 word) * unat ((of_bl::bool list \<Rightarrow> 128 word) (to_bl b)) mod 2 ^ LENGTH(128) = 2 ^ m * k"
      by blast
 
    hence aligned: "is_aligned ((of_bl::bool list \<Rightarrow> 128 word) (to_bl b) << n) m"
      unfolding is_aligned_iff_dvd_nat
      unfolding dvd_def
      unfolding shiftl_t2n
      unfolding Word.unat_word_ariths(2)
      by assumption
 
    from assms have of_bl_to_bl_shift_mask: "((of_bl::bool list \<Rightarrow> 128 word) (to_bl b) << n) && mask (16 + m) = 0"
     using is_aligned_mask is_aligned_shiftl by force (*sledgehammer*)
 
    show ?thesis
     apply(subst ucast_bl)+
     apply(subst word_and_mask_shiftl)
     apply(subst aligned_shiftr_mask_shiftl)
      subgoal by (fact aligned)
     subgoal by (fact of_bl_to_bl_shift_mask)
     done
 qed
 
 
 lemma helper_masked_ucast_equal_generic:
   fixes b::"16 word"
   assumes "n \<le> 128 - 16"
   shows "ucast (((ucast:: 16 word \<Rightarrow> 128 word) b << n) && (mask 16 << n) >> n) = b"
 proof -
   have ucast_mask: "(ucast:: 16 word \<Rightarrow> 128 word) b && mask 16 = ucast b" 
     by transfer (simp flip: take_bit_eq_mask)
   from assms have "ucast (((ucast:: 16 word \<Rightarrow> 128 word) b && mask (128 - n) && mask 16) && mask (128 - n)) = b"
     by (auto simp add: bit_simps word_size intro!: bit_word_eqI)
   thus ?thesis
   apply(subst word_and_mask_shiftl)
   apply(subst shiftl_shiftr3)
    apply(simp; fail)
   apply(simp)
   apply(subst shiftl_shiftr3)
     apply(simp_all add: word_size and.assoc)
   done
 qed
 
 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,235 +1,235 @@
 (*  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)"
 proof -
   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_eq
   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_eq
   apply (cases p)
-  apply (simp add: ac_simps)
+  apply (simp add: ac_simps push_bit_of_1)
   done
 
 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"
 
 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)) =
             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))"
     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))"
       unfolding prefix_to_wordset_def ipset_from_netmask_def Let_def
       using assms
         by (clarsimp dest!: valid_prefix_E) (metis bit.conj_commute mask_eq_0_eq_x)
       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)"
         unfolding pfxm_mask_def by simp
   
       have ipset_from_netmask_prefix: 
         "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/JinjaThreads/Common/BinOp.thy b/thys/JinjaThreads/Common/BinOp.thy
--- a/thys/JinjaThreads/Common/BinOp.thy
+++ b/thys/JinjaThreads/Common/BinOp.thy
@@ -1,589 +1,589 @@
 (*  Title:      JinjaThreads/Common/BinOp.thy
     Author:     Andreas Lochbihler
 *)
 
 section \<open>Binary Operators\<close>
 
 theory BinOp
 imports
-  WellForm "Word_Lib.Traditional_Infix_Syntax"
+  WellForm "Word_Lib.Bit_Shifts_Infix_Syntax"
 begin
 
 datatype bop =  \<comment> \<open>names of binary operations\<close>
     Eq
   | NotEq
   | LessThan
   | LessOrEqual
   | GreaterThan
   | GreaterOrEqual
   | Add    
   | Subtract
   | Mult
   | Div
   | Mod
   | BinAnd
   | BinOr
   | BinXor
   | ShiftLeft
   | ShiftRightZeros
   | ShiftRightSigned
 
 subsection\<open>The semantics of binary operators\<close>
 
 type_synonym 'addr binop_ret = "'addr val + 'addr" \<comment> \<open>a value or the address of an exception\<close>
 
 fun binop_LessThan :: "'addr val \<Rightarrow> 'addr val \<Rightarrow> 'addr binop_ret option"
 where
   "binop_LessThan (Intg i1) (Intg i2) = Some (Inl (Bool (i1 <s i2)))"
 | "binop_LessThan v1 v2 = None"
 
 fun binop_LessOrEqual :: "'addr val \<Rightarrow> 'addr val \<Rightarrow> 'addr binop_ret option"
 where
   "binop_LessOrEqual (Intg i1) (Intg i2) = Some (Inl (Bool (i1 <=s i2)))"
 | "binop_LessOrEqual v1 v2 = None"
 
 fun binop_GreaterThan :: "'addr val \<Rightarrow> 'addr val \<Rightarrow> 'addr binop_ret option"
 where
   "binop_GreaterThan (Intg i1) (Intg i2) = Some (Inl (Bool (i2 <s i1)))"
 | "binop_GreaterThan v1 v2 = None"
 
 fun binop_GreaterOrEqual :: "'addr val \<Rightarrow> 'addr val \<Rightarrow> 'addr binop_ret option"
 where
   "binop_GreaterOrEqual (Intg i1) (Intg i2) = Some (Inl (Bool (i2 <=s i1)))"
 | "binop_GreaterOrEqual v1 v2 = None"
 
 fun binop_Add :: "'addr val \<Rightarrow> 'addr val \<Rightarrow> 'addr binop_ret option"
 where
   "binop_Add (Intg i1) (Intg i2) = Some (Inl (Intg (i1 + i2)))"
 | "binop_Add v1 v2 = None"
 
 fun binop_Subtract :: "'addr val \<Rightarrow> 'addr val \<Rightarrow> 'addr binop_ret option"
 where
   "binop_Subtract (Intg i1) (Intg i2) = Some (Inl (Intg (i1 - i2)))"
 | "binop_Subtract v1 v2 = None"
 
 fun binop_Mult :: "'addr val \<Rightarrow> 'addr val \<Rightarrow> 'addr binop_ret option"
 where
   "binop_Mult (Intg i1) (Intg i2) = Some (Inl (Intg (i1 * i2)))"
 | "binop_Mult v1 v2 = None"
 
 fun binop_BinAnd :: "'addr val \<Rightarrow> 'addr val \<Rightarrow> 'addr binop_ret option"
 where
   "binop_BinAnd (Intg i1) (Intg i2) = Some (Inl (Intg (i1 AND i2)))"
 | "binop_BinAnd (Bool b1) (Bool b2) = Some (Inl (Bool (b1 \<and> b2)))"
 | "binop_BinAnd v1 v2 = None"
 
 fun binop_BinOr :: "'addr val \<Rightarrow> 'addr val \<Rightarrow> 'addr binop_ret option"
 where
   "binop_BinOr (Intg i1) (Intg i2) = Some (Inl (Intg (i1 OR i2)))"
 | "binop_BinOr (Bool b1) (Bool b2) = Some (Inl (Bool (b1 \<or> b2)))"
 | "binop_BinOr v1 v2 = None"
 
 fun binop_BinXor :: "'addr val \<Rightarrow> 'addr val \<Rightarrow> 'addr binop_ret option"
 where
   "binop_BinXor (Intg i1) (Intg i2) = Some (Inl (Intg (i1 XOR i2)))"
 | "binop_BinXor (Bool b1) (Bool b2) = Some (Inl (Bool (b1 \<noteq> b2)))"
 | "binop_BinXor v1 v2 = None"
 
 fun binop_ShiftLeft :: "'addr val \<Rightarrow> 'addr val \<Rightarrow> 'addr binop_ret option"
 where
   "binop_ShiftLeft (Intg i1) (Intg i2) = Some (Inl (Intg (i1 << unat (i2 AND 0x1f))))"
 | "binop_ShiftLeft v1 v2 = None"
 
 fun binop_ShiftRightZeros :: "'addr val \<Rightarrow> 'addr val \<Rightarrow> 'addr binop_ret option"
 where
   "binop_ShiftRightZeros (Intg i1) (Intg i2) = Some (Inl (Intg (i1 >> unat (i2 AND 0x1f))))"
 | "binop_ShiftRightZeros v1 v2 = None"
 
 fun binop_ShiftRightSigned :: "'addr val \<Rightarrow> 'addr val \<Rightarrow> 'addr binop_ret option"
 where
   "binop_ShiftRightSigned (Intg i1) (Intg i2) = Some (Inl (Intg (i1 >>> unat (i2 AND 0x1f))))"
 | "binop_ShiftRightSigned v1 v2 = None"
 
 text \<open>
   Division on @{typ "'a word"} is unsigned, but JLS specifies signed division.
 \<close>
 definition word_sdiv :: "'a :: len word \<Rightarrow> 'a word \<Rightarrow> 'a word" (infixl "sdiv" 70)
 where [code]:
   "x sdiv y =
    (let x' = sint x; y' = sint y;
         negative = (x' < 0) \<noteq> (y' < 0);
         result = abs x' div abs y'
     in word_of_int (if negative then -result else result))"
 
 definition word_smod :: "'a :: len word \<Rightarrow> 'a word \<Rightarrow> 'a word" (infixl "smod" 70)
 where [code]:
   "x smod y =
    (let x' = sint x; y' = sint y;
         negative = (x' < 0);
         result = abs x' mod abs y'
     in word_of_int (if negative then -result else result))"
 
 declare word_sdiv_def [simp] word_smod_def [simp]
 
 lemma sdiv_smod_id: "(a sdiv b) * b + (a smod b) = a"
 proof -
   have F5: "\<forall>u::'a word. - (- u) = u"
     by simp
   have F7: "\<forall>v u::'a word. u + v = v + u"
     by (simp add: ac_simps)
   have F8: "\<forall>(w::'a word) (v::int) u::int. word_of_int u + word_of_int v * w = word_of_int (u + v * sint w)"
     by simp
   have "\<exists>u. u = - sint b \<and> word_of_int (sint a mod u + - (- u * (sint a div u))) = a"
     using F5 by simp
   hence "word_of_int (sint a mod - sint b + - (sint b * (sint a div - sint b))) = a"
     by (metis equation_minus_iff)
   hence "word_of_int (sint a mod - sint b) + word_of_int (- (sint a div - sint b)) * b = a"
     using F8 by (simp add: ac_simps)
   hence eq: "word_of_int (- (sint a div - sint b)) * b + word_of_int (sint a mod - sint b) = a"
     using F7 by simp
 
   show ?thesis
   proof(cases "sint a < 0")
     case True note a = this
     show ?thesis
     proof(cases "sint b < 0")
       case True
       with a show ?thesis
         by simp (metis F7 F8 eq minus_equation_iff minus_mult_minus mod_div_mult_eq)
     next
       case False
       from eq have "word_of_int (- (- sint a div sint b)) * b + word_of_int (- (- sint a mod sint b)) = a"
         by (metis div_minus_right mod_minus_right)
       with a False show ?thesis by simp
     qed
   next
     case False note a = this
     show ?thesis
     proof(cases "sint b < 0")
       case True
       with a eq show ?thesis by simp
     next
       case False with a show ?thesis
         by (simp add: F7 F8)
     qed
   qed
 qed
 
 notepad begin
 have  "  5  sdiv ( 3 :: word32) =  1"
   and "  5  smod ( 3 :: word32) =  2"
   and "  5  sdiv (-3 :: word32) = -1"
   and "  5  smod (-3 :: word32) =  2"
   and "(-5) sdiv ( 3 :: word32) = -1"
   and "(-5) smod ( 3 :: word32) = -2"
   and "(-5) sdiv (-3 :: word32) =  1"
   and "(-5) smod (-3 :: word32) = -2"
   and "-2147483648 sdiv 1 = (-2147483648 :: word32)"
   by eval+
 end
 
 context heap_base begin
 
 fun binop_Mod :: "'addr val \<Rightarrow> 'addr val \<Rightarrow> 'addr binop_ret option"
 where
   "binop_Mod (Intg i1) (Intg i2) = 
    Some (if i2 = 0 then Inr (addr_of_sys_xcpt ArithmeticException) else Inl (Intg (i1 smod i2)))"
 | "binop_Mod v1 v2 = None"
 
 fun binop_Div :: "'addr val \<Rightarrow> 'addr val \<Rightarrow> 'addr binop_ret option"
 where
   "binop_Div (Intg i1) (Intg i2) = 
    Some (if i2 = 0 then Inr (addr_of_sys_xcpt ArithmeticException) else Inl (Intg (i1 sdiv i2)))"
 | "binop_Div v1 v2 = None"
 
 primrec binop :: "bop \<Rightarrow> 'addr val \<Rightarrow> 'addr val \<Rightarrow> 'addr binop_ret option"
 where
   "binop Eq v1 v2 =  Some (Inl (Bool (v1 = v2)))"
 | "binop NotEq v1 v2 = Some (Inl (Bool (v1 \<noteq> v2)))"
 | "binop LessThan = binop_LessThan"
 | "binop LessOrEqual = binop_LessOrEqual"
 | "binop GreaterThan = binop_GreaterThan"
 | "binop GreaterOrEqual = binop_GreaterOrEqual"
 | "binop Add = binop_Add"
 | "binop Subtract = binop_Subtract"
 | "binop Mult = binop_Mult"
 | "binop Mod = binop_Mod"
 | "binop Div = binop_Div"
 | "binop BinAnd = binop_BinAnd"
 | "binop BinOr = binop_BinOr"
 | "binop BinXor = binop_BinXor"
 | "binop ShiftLeft = binop_ShiftLeft"
 | "binop ShiftRightZeros = binop_ShiftRightZeros"
 | "binop ShiftRightSigned = binop_ShiftRightSigned"
 
 end
 
 lemma [simp]:
   "(binop_LessThan v1 v2 = Some va) \<longleftrightarrow> 
    (\<exists>i1 i2. v1 = Intg i1 \<and> v2 = Intg i2 \<and> va = Inl (Bool (i1 <s i2)))"
 by(cases "(v1, v2)" rule: binop_LessThan.cases) auto
 
 lemma [simp]:
   "(binop_LessOrEqual v1 v2 = Some va) \<longleftrightarrow> 
    (\<exists>i1 i2. v1 = Intg i1 \<and> v2 = Intg i2 \<and> va = Inl (Bool (i1 <=s i2)))"
 by(cases "(v1, v2)" rule: binop_LessOrEqual.cases) auto
 
 lemma [simp]:
   "(binop_GreaterThan v1 v2 = Some va) \<longleftrightarrow> 
    (\<exists>i1 i2. v1 = Intg i1 \<and> v2 = Intg i2 \<and> va = Inl (Bool (i2 <s i1)))"
 by(cases "(v1, v2)" rule: binop_GreaterThan.cases) auto
 
 lemma [simp]:
   "(binop_GreaterOrEqual v1 v2 = Some va) \<longleftrightarrow> 
    (\<exists>i1 i2. v1 = Intg i1 \<and> v2 = Intg i2 \<and> va = Inl (Bool (i2 <=s i1)))"
 by(cases "(v1, v2)" rule: binop_GreaterOrEqual.cases) auto
 
 lemma [simp]:
   "(binop_Add v\<^sub>1 v\<^sub>2  = Some va) \<longleftrightarrow>
    (\<exists>i\<^sub>1 i\<^sub>2. v\<^sub>1 = Intg i\<^sub>1 \<and> v\<^sub>2 = Intg i\<^sub>2 \<and> va = Inl (Intg (i\<^sub>1+i\<^sub>2)))"
 by(cases "(v\<^sub>1, v\<^sub>2)" rule: binop_Add.cases) auto
 
 lemma [simp]:
   "(binop_Subtract v1 v2 = Some va) \<longleftrightarrow> 
    (\<exists>i1 i2. v1 = Intg i1 \<and> v2 = Intg i2 \<and> va = Inl (Intg (i1 - i2)))"
 by(cases "(v1, v2)" rule: binop_Subtract.cases) auto
 
 lemma [simp]: 
   "(binop_Mult v1 v2 = Some va) \<longleftrightarrow> 
    (\<exists>i1 i2. v1 = Intg i1 \<and> v2 = Intg i2 \<and> va = Inl (Intg (i1 * i2)))"
 by(cases "(v1, v2)" rule: binop_Mult.cases) auto
 
 lemma [simp]:
   "(binop_BinAnd v1 v2 = Some va) \<longleftrightarrow> 
    (\<exists>b1 b2. v1 = Bool b1 \<and> v2 = Bool b2 \<and> va = Inl (Bool (b1 \<and> b2))) \<or> 
    (\<exists>i1 i2. v1 = Intg i1 \<and> v2 = Intg i2 \<and> va = Inl (Intg (i1 AND i2)))"
 by(cases "(v1, v2)" rule: binop_BinAnd.cases) auto
 
 lemma [simp]:
   "(binop_BinOr v1 v2 = Some va) \<longleftrightarrow> 
    (\<exists>b1 b2. v1 = Bool b1 \<and> v2 = Bool b2 \<and> va = Inl (Bool (b1 \<or> b2))) \<or>
    (\<exists>i1 i2. v1 = Intg i1 \<and> v2 = Intg i2 \<and> va = Inl (Intg (i1 OR i2)))"
 by(cases "(v1, v2)" rule: binop_BinOr.cases) auto
 
 lemma [simp]:
   "(binop_BinXor v1 v2 = Some va) \<longleftrightarrow>
    (\<exists>b1 b2. v1 = Bool b1 \<and> v2 = Bool b2 \<and> va = Inl (Bool (b1 \<noteq> b2))) \<or>
    (\<exists>i1 i2. v1 = Intg i1 \<and> v2 = Intg i2 \<and> va = Inl (Intg (i1 XOR i2)))"
 by(cases "(v1, v2)" rule: binop_BinXor.cases) auto
 
 lemma [simp]:
   "(binop_ShiftLeft v1 v2 = Some va) \<longleftrightarrow> 
    (\<exists>i1 i2. v1 = Intg i1 \<and> v2 = Intg i2 \<and> va = Inl (Intg (i1 << unat (i2 AND 0x1f))))"
 by(cases "(v1, v2)" rule: binop_ShiftLeft.cases) auto
 
 lemma [simp]:
   "(binop_ShiftRightZeros v1 v2 = Some va) \<longleftrightarrow> 
    (\<exists>i1 i2. v1 = Intg i1 \<and> v2 = Intg i2 \<and> va = Inl (Intg (i1 >> unat (i2 AND 0x1f))))"
 by(cases "(v1, v2)" rule: binop_ShiftRightZeros.cases) auto
 
 lemma [simp]:
   "(binop_ShiftRightSigned v1 v2 = Some va) \<longleftrightarrow> 
    (\<exists>i1 i2. v1 = Intg i1 \<and> v2 = Intg i2 \<and> va = Inl (Intg (i1 >>> unat (i2 AND 0x1f))))"
 by(cases "(v1, v2)" rule: binop_ShiftRightSigned.cases) auto
 
 context heap_base begin
 
 lemma [simp]:
   "(binop_Mod v1 v2 = Some va) \<longleftrightarrow> 
    (\<exists>i1 i2. v1 = Intg i1 \<and> v2 = Intg i2 \<and> 
       va = (if i2 = 0 then Inr (addr_of_sys_xcpt ArithmeticException) else Inl (Intg(i1 smod i2))))"
 by(cases "(v1, v2)" rule: binop_Mod.cases) auto
 
 lemma [simp]:
   "(binop_Div v1 v2 = Some va) \<longleftrightarrow> 
    (\<exists>i1 i2. v1 = Intg i1 \<and> v2 = Intg i2 \<and> 
       va = (if i2 = 0 then Inr (addr_of_sys_xcpt ArithmeticException) else Inl (Intg(i1 sdiv i2))))"
 by(cases "(v1, v2)" rule: binop_Div.cases) auto
 
 end
 
 subsection \<open>Typing for binary operators\<close>
 
 inductive WT_binop :: "'m prog \<Rightarrow> ty \<Rightarrow> bop \<Rightarrow> ty \<Rightarrow> ty \<Rightarrow> bool" ("_ \<turnstile> _\<guillemotleft>_\<guillemotright>_ :: _" [51,0,0,0,51] 50)
 where
   WT_binop_Eq:
   "P \<turnstile> T1 \<le> T2 \<or> P \<turnstile> T2 \<le> T1 \<Longrightarrow> P \<turnstile> T1\<guillemotleft>Eq\<guillemotright>T2 :: Boolean"
 
 | WT_binop_NotEq:
   "P \<turnstile> T1 \<le> T2 \<or> P \<turnstile> T2 \<le> T1 \<Longrightarrow> P \<turnstile> T1\<guillemotleft>NotEq\<guillemotright>T2 :: Boolean"
 
 | WT_binop_LessThan:
   "P \<turnstile> Integer\<guillemotleft>LessThan\<guillemotright>Integer :: Boolean"
 
 | WT_binop_LessOrEqual:
   "P \<turnstile> Integer\<guillemotleft>LessOrEqual\<guillemotright>Integer :: Boolean"
 
 | WT_binop_GreaterThan:
   "P \<turnstile> Integer\<guillemotleft>GreaterThan\<guillemotright>Integer :: Boolean"
 
 | WT_binop_GreaterOrEqual:
   "P \<turnstile> Integer\<guillemotleft>GreaterOrEqual\<guillemotright>Integer :: Boolean"
 
 | WT_binop_Add:
   "P \<turnstile> Integer\<guillemotleft>Add\<guillemotright>Integer :: Integer"
 
 | WT_binop_Subtract:
   "P \<turnstile> Integer\<guillemotleft>Subtract\<guillemotright>Integer :: Integer"
 
 | WT_binop_Mult:
   "P \<turnstile> Integer\<guillemotleft>Mult\<guillemotright>Integer :: Integer"
 
 | WT_binop_Div:
   "P \<turnstile> Integer\<guillemotleft>Div\<guillemotright>Integer :: Integer"
 
 | WT_binop_Mod:
   "P \<turnstile> Integer\<guillemotleft>Mod\<guillemotright>Integer :: Integer"
 
 | WT_binop_BinAnd_Bool:
   "P \<turnstile> Boolean\<guillemotleft>BinAnd\<guillemotright>Boolean :: Boolean"
 
 | WT_binop_BinAnd_Int:
   "P \<turnstile> Integer\<guillemotleft>BinAnd\<guillemotright>Integer :: Integer"
 
 | WT_binop_BinOr_Bool:
   "P \<turnstile> Boolean\<guillemotleft>BinOr\<guillemotright>Boolean :: Boolean"
 
 | WT_binop_BinOr_Int:
   "P \<turnstile> Integer\<guillemotleft>BinOr\<guillemotright>Integer :: Integer"
 
 | WT_binop_BinXor_Bool:
   "P \<turnstile> Boolean\<guillemotleft>BinXor\<guillemotright>Boolean :: Boolean"
 
 | WT_binop_BinXor_Int:
   "P \<turnstile> Integer\<guillemotleft>BinXor\<guillemotright>Integer :: Integer"
 
 | WT_binop_ShiftLeft:
   "P \<turnstile> Integer\<guillemotleft>ShiftLeft\<guillemotright>Integer :: Integer"
 
 | WT_binop_ShiftRightZeros:
   "P \<turnstile> Integer\<guillemotleft>ShiftRightZeros\<guillemotright>Integer :: Integer"
 
 | WT_binop_ShiftRightSigned:
   "P \<turnstile> Integer\<guillemotleft>ShiftRightSigned\<guillemotright>Integer :: Integer"
 
 lemma WT_binopI [intro]:
   "P \<turnstile> T1 \<le> T2 \<or> P \<turnstile> T2 \<le> T1 \<Longrightarrow> P \<turnstile> T1\<guillemotleft>Eq\<guillemotright>T2 :: Boolean"
   "P \<turnstile> T1 \<le> T2 \<or> P \<turnstile> T2 \<le> T1 \<Longrightarrow> P \<turnstile> T1\<guillemotleft>NotEq\<guillemotright>T2 :: Boolean"
   "bop = Add \<or> bop = Subtract \<or> bop = Mult \<or> bop = Mod \<or> bop = Div \<or> bop = BinAnd \<or> bop = BinOr \<or> bop = BinXor \<or> 
    bop = ShiftLeft \<or> bop = ShiftRightZeros \<or> bop = ShiftRightSigned
    \<Longrightarrow> P \<turnstile> Integer\<guillemotleft>bop\<guillemotright>Integer :: Integer"
   "bop = LessThan \<or> bop = LessOrEqual \<or> bop = GreaterThan \<or> bop = GreaterOrEqual \<Longrightarrow> P \<turnstile> Integer\<guillemotleft>bop\<guillemotright>Integer :: Boolean"
   "bop = BinAnd \<or> bop = BinOr \<or> bop = BinXor \<Longrightarrow> P \<turnstile> Boolean\<guillemotleft>bop\<guillemotright>Boolean :: Boolean"
 by(auto intro: WT_binop.intros)
 
 inductive_cases [elim]:
   "P \<turnstile> T1\<guillemotleft>Eq\<guillemotright>T2 :: T"
   "P \<turnstile> T1\<guillemotleft>NotEq\<guillemotright>T2 :: T"
   "P \<turnstile> T1\<guillemotleft>LessThan\<guillemotright>T2 :: T"
   "P \<turnstile> T1\<guillemotleft>LessOrEqual\<guillemotright>T2 :: T"
   "P \<turnstile> T1\<guillemotleft>GreaterThan\<guillemotright>T2 :: T"
   "P \<turnstile> T1\<guillemotleft>GreaterOrEqual\<guillemotright>T2 :: T"
   "P \<turnstile> T1\<guillemotleft>Add\<guillemotright>T2 :: T"
   "P \<turnstile> T1\<guillemotleft>Subtract\<guillemotright>T2 :: T"
   "P \<turnstile> T1\<guillemotleft>Mult\<guillemotright>T2 :: T"
   "P \<turnstile> T1\<guillemotleft>Div\<guillemotright>T2 :: T"
   "P \<turnstile> T1\<guillemotleft>Mod\<guillemotright>T2 :: T"
   "P \<turnstile> T1\<guillemotleft>BinAnd\<guillemotright>T2 :: T"
   "P \<turnstile> T1\<guillemotleft>BinOr\<guillemotright>T2 :: T"
   "P \<turnstile> T1\<guillemotleft>BinXor\<guillemotright>T2 :: T"
   "P \<turnstile> T1\<guillemotleft>ShiftLeft\<guillemotright>T2 :: T"
   "P \<turnstile> T1\<guillemotleft>ShiftRightZeros\<guillemotright>T2 :: T"
   "P \<turnstile> T1\<guillemotleft>ShiftRightSigned\<guillemotright>T2 :: T"
 
 lemma WT_binop_fun: "\<lbrakk> P \<turnstile> T1\<guillemotleft>bop\<guillemotright>T2 :: T; P \<turnstile> T1\<guillemotleft>bop\<guillemotright>T2 :: T' \<rbrakk> \<Longrightarrow> T = T'"
 by(cases bop)(auto)
 
 lemma WT_binop_is_type:
   "\<lbrakk> P \<turnstile> T1\<guillemotleft>bop\<guillemotright>T2 :: T; is_type P T1; is_type P T2 \<rbrakk> \<Longrightarrow> is_type P T"
 by(cases bop) auto
 
 inductive WTrt_binop :: "'m prog \<Rightarrow> ty \<Rightarrow> bop \<Rightarrow> ty \<Rightarrow> ty \<Rightarrow> bool" ("_ \<turnstile> _\<guillemotleft>_\<guillemotright>_ : _" [51,0,0,0,51] 50)
 where
   WTrt_binop_Eq:
   "P \<turnstile> T1\<guillemotleft>Eq\<guillemotright>T2 : Boolean"
 
 | WTrt_binop_NotEq:
   "P \<turnstile> T1\<guillemotleft>NotEq\<guillemotright>T2 : Boolean"
 
 | WTrt_binop_LessThan:
   "P \<turnstile> Integer\<guillemotleft>LessThan\<guillemotright>Integer : Boolean"
 
 | WTrt_binop_LessOrEqual:
   "P \<turnstile> Integer\<guillemotleft>LessOrEqual\<guillemotright>Integer : Boolean"
 
 | WTrt_binop_GreaterThan:
   "P \<turnstile> Integer\<guillemotleft>GreaterThan\<guillemotright>Integer : Boolean"
 
 | WTrt_binop_GreaterOrEqual:
   "P \<turnstile> Integer\<guillemotleft>GreaterOrEqual\<guillemotright>Integer : Boolean"
 
 | WTrt_binop_Add:
   "P \<turnstile> Integer\<guillemotleft>Add\<guillemotright>Integer : Integer"
 
 | WTrt_binop_Subtract:
   "P \<turnstile> Integer\<guillemotleft>Subtract\<guillemotright>Integer : Integer"
 
 | WTrt_binop_Mult:
   "P \<turnstile> Integer\<guillemotleft>Mult\<guillemotright>Integer : Integer"
 
 | WTrt_binop_Div:
   "P \<turnstile> Integer\<guillemotleft>Div\<guillemotright>Integer : Integer"
 
 | WTrt_binop_Mod:
   "P \<turnstile> Integer\<guillemotleft>Mod\<guillemotright>Integer : Integer"
 
 | WTrt_binop_BinAnd_Bool:
   "P \<turnstile> Boolean\<guillemotleft>BinAnd\<guillemotright>Boolean : Boolean"
 
 | WTrt_binop_BinAnd_Int:
   "P \<turnstile> Integer\<guillemotleft>BinAnd\<guillemotright>Integer : Integer"
 
 | WTrt_binop_BinOr_Bool:
   "P \<turnstile> Boolean\<guillemotleft>BinOr\<guillemotright>Boolean : Boolean"
 
 | WTrt_binop_BinOr_Int:
   "P \<turnstile> Integer\<guillemotleft>BinOr\<guillemotright>Integer : Integer"
 
 | WTrt_binop_BinXor_Bool:
   "P \<turnstile> Boolean\<guillemotleft>BinXor\<guillemotright>Boolean : Boolean"
 
 | WTrt_binop_BinXor_Int:
   "P \<turnstile> Integer\<guillemotleft>BinXor\<guillemotright>Integer : Integer"
 
 | WTrt_binop_ShiftLeft:
   "P \<turnstile> Integer\<guillemotleft>ShiftLeft\<guillemotright>Integer : Integer"
 
 | WTrt_binop_ShiftRightZeros:
   "P \<turnstile> Integer\<guillemotleft>ShiftRightZeros\<guillemotright>Integer : Integer"
 
 | WTrt_binop_ShiftRightSigned:
   "P \<turnstile> Integer\<guillemotleft>ShiftRightSigned\<guillemotright>Integer : Integer"
 
 lemma WTrt_binopI [intro]:
   "P \<turnstile> T1\<guillemotleft>Eq\<guillemotright>T2 : Boolean"
   "P \<turnstile> T1\<guillemotleft>NotEq\<guillemotright>T2 : Boolean"
   "bop = Add \<or> bop = Subtract \<or> bop = Mult \<or> bop = Div \<or> bop = Mod \<or> bop = BinAnd \<or> bop = BinOr \<or> bop = BinXor \<or>
    bop = ShiftLeft \<or> bop = ShiftRightZeros \<or> bop = ShiftRightSigned
    \<Longrightarrow> P \<turnstile> Integer\<guillemotleft>bop\<guillemotright>Integer : Integer"
   "bop = LessThan \<or> bop = LessOrEqual \<or> bop = GreaterThan \<or> bop = GreaterOrEqual \<Longrightarrow> P \<turnstile> Integer\<guillemotleft>bop\<guillemotright>Integer : Boolean"
   "bop = BinAnd \<or> bop = BinOr \<or> bop = BinXor \<Longrightarrow> P \<turnstile> Boolean\<guillemotleft>bop\<guillemotright>Boolean : Boolean"
 by(auto intro: WTrt_binop.intros)
 
 inductive_cases WTrt_binop_cases [elim]:
   "P \<turnstile> T1\<guillemotleft>Eq\<guillemotright>T2 : T"
   "P \<turnstile> T1\<guillemotleft>NotEq\<guillemotright>T2 : T"
   "P \<turnstile> T1\<guillemotleft>LessThan\<guillemotright>T2 : T"
   "P \<turnstile> T1\<guillemotleft>LessOrEqual\<guillemotright>T2 : T"
   "P \<turnstile> T1\<guillemotleft>GreaterThan\<guillemotright>T2 : T"
   "P \<turnstile> T1\<guillemotleft>GreaterOrEqual\<guillemotright>T2 : T"
   "P \<turnstile> T1\<guillemotleft>Add\<guillemotright>T2 : T"
   "P \<turnstile> T1\<guillemotleft>Subtract\<guillemotright>T2 : T"
   "P \<turnstile> T1\<guillemotleft>Mult\<guillemotright>T2 : T"
   "P \<turnstile> T1\<guillemotleft>Div\<guillemotright>T2 : T"
   "P \<turnstile> T1\<guillemotleft>Mod\<guillemotright>T2 : T"
   "P \<turnstile> T1\<guillemotleft>BinAnd\<guillemotright>T2 : T"
   "P \<turnstile> T1\<guillemotleft>BinOr\<guillemotright>T2 : T"
   "P \<turnstile> T1\<guillemotleft>BinXor\<guillemotright>T2 : T"
   "P \<turnstile> T1\<guillemotleft>ShiftLeft\<guillemotright>T2 : T"
   "P \<turnstile> T1\<guillemotleft>ShiftRightZeros\<guillemotright>T2 : T"
   "P \<turnstile> T1\<guillemotleft>ShiftRightSigned\<guillemotright>T2 : T"
 
 inductive_simps WTrt_binop_simps [simp]:
   "P \<turnstile> T1\<guillemotleft>Eq\<guillemotright>T2 : T"
   "P \<turnstile> T1\<guillemotleft>NotEq\<guillemotright>T2 : T"
   "P \<turnstile> T1\<guillemotleft>LessThan\<guillemotright>T2 : T"
   "P \<turnstile> T1\<guillemotleft>LessOrEqual\<guillemotright>T2 : T"
   "P \<turnstile> T1\<guillemotleft>GreaterThan\<guillemotright>T2 : T"
   "P \<turnstile> T1\<guillemotleft>GreaterOrEqual\<guillemotright>T2 : T"
   "P \<turnstile> T1\<guillemotleft>Add\<guillemotright>T2 : T"
   "P \<turnstile> T1\<guillemotleft>Subtract\<guillemotright>T2 : T"
   "P \<turnstile> T1\<guillemotleft>Mult\<guillemotright>T2 : T"
   "P \<turnstile> T1\<guillemotleft>Div\<guillemotright>T2 : T"
   "P \<turnstile> T1\<guillemotleft>Mod\<guillemotright>T2 : T"
   "P \<turnstile> T1\<guillemotleft>BinAnd\<guillemotright>T2 : T"
   "P \<turnstile> T1\<guillemotleft>BinOr\<guillemotright>T2 : T"
   "P \<turnstile> T1\<guillemotleft>BinXor\<guillemotright>T2 : T"
   "P \<turnstile> T1\<guillemotleft>ShiftLeft\<guillemotright>T2 : T"
   "P \<turnstile> T1\<guillemotleft>ShiftRightZeros\<guillemotright>T2 : T"
   "P \<turnstile> T1\<guillemotleft>ShiftRightSigned\<guillemotright>T2 : T"
 
 fun binop_relevant_class :: "bop \<Rightarrow> 'm prog \<Rightarrow> cname \<Rightarrow> bool"
 where
   "binop_relevant_class Div = (\<lambda>P C. P \<turnstile> ArithmeticException \<preceq>\<^sup>* C )"
 | "binop_relevant_class Mod = (\<lambda>P C. P \<turnstile> ArithmeticException \<preceq>\<^sup>* C )"
 | "binop_relevant_class _ = (\<lambda>P C. False)"
 
 lemma WT_binop_WTrt_binop:
   "P \<turnstile> T1\<guillemotleft>bop\<guillemotright>T2 :: T \<Longrightarrow> P \<turnstile> T1\<guillemotleft>bop\<guillemotright>T2 : T"
 by(auto elim: WT_binop.cases)
 
 context heap begin
 
 lemma binop_progress:
   "\<lbrakk> typeof\<^bsub>h\<^esub> v1 = \<lfloor>T1\<rfloor>; typeof\<^bsub>h\<^esub> v2 = \<lfloor>T2\<rfloor>; P \<turnstile> T1\<guillemotleft>bop\<guillemotright>T2 : T \<rbrakk>
   \<Longrightarrow> \<exists>va. binop bop v1 v2 = \<lfloor>va\<rfloor>"
 by(cases bop)(auto del: disjCI split del: if_split)
 
 lemma binop_type:
   assumes wf: "wf_prog wf_md P"
   and pre: "preallocated h"
   and type: "typeof\<^bsub>h\<^esub> v1 = \<lfloor>T1\<rfloor>" "typeof\<^bsub>h\<^esub> v2 = \<lfloor>T2\<rfloor>" "P \<turnstile> T1\<guillemotleft>bop\<guillemotright>T2 : T"
   shows "binop bop v1 v2 = \<lfloor>Inl v\<rfloor> \<Longrightarrow> P,h \<turnstile> v :\<le> T"
   and "binop bop v1 v2 = \<lfloor>Inr a\<rfloor> \<Longrightarrow> P,h \<turnstile> Addr a :\<le> Class Throwable"
 using type
 apply(case_tac [!] bop)
 apply(auto split: if_split_asm simp add: conf_def wf_preallocatedD[OF wf pre])
 done
 
 lemma binop_relevant_class:
   assumes wf: "wf_prog wf_md P"
   and pre: "preallocated h"
   and bop: "binop bop v1 v2 = \<lfloor>Inr a\<rfloor>"
   and sup: "P \<turnstile> cname_of h a \<preceq>\<^sup>* C"
   shows "binop_relevant_class bop P C"
 using assms
 by(cases bop)(auto split: if_split_asm)
 
 end
 
 lemma WTrt_binop_fun: "\<lbrakk> P \<turnstile> T1\<guillemotleft>bop\<guillemotright>T2 : T; P \<turnstile> T1\<guillemotleft>bop\<guillemotright>T2 : T' \<rbrakk> \<Longrightarrow> T = T'"
 by(cases bop)(auto)
 
 lemma WTrt_binop_THE [simp]: "P \<turnstile> T1\<guillemotleft>bop\<guillemotright>T2 : T \<Longrightarrow> The (WTrt_binop P T1 bop T2) = T"
 by(auto dest: WTrt_binop_fun)
 
 lemma WTrt_binop_widen_mono:
   "\<lbrakk> P \<turnstile> T1\<guillemotleft>bop\<guillemotright>T2 : T; P \<turnstile> T1' \<le> T1; P \<turnstile> T2' \<le> T2 \<rbrakk> \<Longrightarrow> \<exists>T'. P \<turnstile> T1'\<guillemotleft>bop\<guillemotright>T2' : T' \<and> P \<turnstile> T' \<le> T"
 by(cases bop)(auto elim!: WTrt_binop_cases)
 
 lemma WTrt_binop_is_type:
   "\<lbrakk> P \<turnstile> T1\<guillemotleft>bop\<guillemotright>T2 : T; is_type P T1; is_type P T2 \<rbrakk> \<Longrightarrow> is_type P T"
 by(cases bop) auto
 
 subsection \<open>Code generator setup\<close>
 
 lemmas [code] =
   heap_base.binop_Div.simps
   heap_base.binop_Mod.simps
   heap_base.binop.simps
 
 code_pred 
   (modes: i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> bool, i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> bool)
   WT_binop
 .
 
 code_pred
   (modes: i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> bool, i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> bool)
   WTrt_binop
 .
 
 lemma eval_WTrt_binop_i_i_i_i_o:
   "Predicate.eval (WTrt_binop_i_i_i_i_o P T1 bop T2) T \<longleftrightarrow> P \<turnstile> T1\<guillemotleft>bop\<guillemotright>T2 : T"
 by(auto elim: WTrt_binop_i_i_i_i_oE intro: WTrt_binop_i_i_i_i_oI)
 
 lemma the_WTrt_binop_code:
   "(THE T. P \<turnstile> T1\<guillemotleft>bop\<guillemotright>T2 : T) = Predicate.the (WTrt_binop_i_i_i_i_o P T1 bop T2)"
 by(simp add: Predicate.the_def eval_WTrt_binop_i_i_i_i_o)
 
 end
diff --git a/thys/Mersenne_Primes/Lucas_Lehmer_Code.thy b/thys/Mersenne_Primes/Lucas_Lehmer_Code.thy
--- a/thys/Mersenne_Primes/Lucas_Lehmer_Code.thy
+++ b/thys/Mersenne_Primes/Lucas_Lehmer_Code.thy
@@ -1,268 +1,268 @@
 section \<open>Efficient code for testing Mersenne primes\<close>
 theory Lucas_Lehmer_Code
 imports
   Lucas_Lehmer
   "HOL-Library.Code_Target_Numeral"
   "Native_Word.Code_Target_Bits_Int"
 begin
 
 subsection \<open>Efficient computation of remainders modulo a Mersenne number\<close>
 
 text \<open>
   We have $k = k\ \text{mod}\ 2^n + k\ \text{div}\ 2^n\ \ (\text{mod}\ (2^n - 1))$,
   and $k\ \text{mod}\ 2^n = k\, \&\, (2^n - 1)$ and $k\ \text{div}\ 2^n = k \gg n$.
   Therefore, we can reduce $k$ modulo $2^n - 1$ using only bitwise operations, addition, and
   bit shifts. 
 \<close>
 lemma cong_mersenne_number_int:
   fixes k :: int
   shows "[k mod 2 ^ n + k div 2 ^ n = k] (mod (2 ^ n - 1))"
 proof -
   have "k = (2 ^ n - 1 + 1) * (k div 2 ^ n) + (k mod 2 ^ n)"
     by simp
   also have "[\<dots> = (0 + 1) * (k div 2 ^ n) + (k mod 2 ^ n)] (mod (2 ^ n - 1))"
     by (intro cong_add cong_mult cong_refl) (auto simp: cong_def)
   finally show ?thesis by (simp add: cong_sym add_ac)
 qed
 
 text \<open>
   We encapsulate a single reduction step in the following operation. Note, however,
   that the result is not, in general, the same as $k\ \text{mod}\ (2^n - 1)$. Multiple 
   reductions might be required in order to reduce it below $2^n$, and a multiple of $2 ^ n - 1$
   can be reduced to $2 ^ n - 1$, which is invariant to further reduction steps.
 \<close>
 definition mersenne_mod :: "int \<Rightarrow> nat \<Rightarrow> int" where
   "mersenne_mod k n = k mod 2 ^ n + k div 2 ^ n"
 
 lemma mersenne_mod_code [code]:
-  "mersenne_mod k n = (k AND ((1 << n) - 1)) + (k >> n)"
+  "mersenne_mod k n = (k AND ((push_bit n 1) - 1)) + (drop_bit n k)"
   by (simp add: mersenne_mod_def shiftr_int_def shiftl_int_def AND_mod)
 
 lemma cong_mersenne_mod: "[mersenne_mod k n = k] (mod (2 ^ n - 1))"
   unfolding mersenne_mod_def by (rule cong_mersenne_number_int)
 
 lemma mersenne_mod_nonneg [simp]: "k \<ge> 0 \<Longrightarrow> mersenne_mod k n \<ge> 0"
   unfolding mersenne_mod_def by (intro add_nonneg_nonneg) (simp_all add: pos_imp_zdiv_nonneg_iff)
 
 lemma mersenne_mod_less:
   assumes "k \<le> 2 ^ m" "m \<ge> n"
   shows   "mersenne_mod k n < 2 ^ n + 2 ^ (m - n)"
 proof -
   have "mersenne_mod k n = k mod 2 ^ n + k div 2 ^ n"
     by (simp add: mersenne_mod_def)
   also have "k mod 2 ^ n < 2 ^ n"
     by simp
   also {
     have "k div 2 ^ n * 2 ^ n + 0 \<le> k div 2 ^ n * 2 ^ n + k mod (2 ^ n)"
       by (intro add_mono) auto
     also have "\<dots> = k"
       by (subst mult.commute) auto
     also have "\<dots> \<le> 2 ^ m"
       using assms by simp
     also have "\<dots> = 2 ^ (m - n) * 2 ^ n"
       using assms by (simp flip: power_add)
     finally have "k div 2 ^ n \<le> 2 ^ (m - n)"
       by simp
   }
   finally show ?thesis by simp
 qed
 
 lemma mersenne_mod_less':
   assumes "k \<le> 5 * 2 ^ n"
   shows   "mersenne_mod k n < 2 ^ n + 5"
 proof -
   have "mersenne_mod k n = k mod 2 ^ n + k div 2 ^ n"
     by (simp add: mersenne_mod_def)
   also have "k mod 2 ^ n < 2 ^ n"
     by simp
   also {
     have "k div 2 ^ n * 2 ^ n + 0 \<le> k div 2 ^ n * 2 ^ n + k mod (2 ^ n)"
       by (intro add_mono) auto
     also have "\<dots> = k"
       by (subst mult.commute) auto
     also have "\<dots> \<le> 5 * 2 ^ n"
       using assms by simp
     finally have "k div 2 ^ n \<le> 5"
       by simp
   }
   finally show ?thesis by simp
 qed
 
 text \<open>
   It turns out that for our use case, a single reduction is not enough to reduce
   the number in question enough (or at least I was unable to prove that it is). We
   therefore perform two reduction steps, which is enough to guarantee that our numbers
   are below $2^n + 4$ before and after every step in the Lucas--Lehmer sequence.
 
   Whether one or two reductions are performed is not very important anyway, since the
   dominant step is the squaring anyway.
 \<close>
 definition mersenne_mod2 :: "int \<Rightarrow> nat \<Rightarrow> int" where
   "mersenne_mod2 k n = mersenne_mod (mersenne_mod k n) n"
 
 lemma cong_mersenne_mod2: "[mersenne_mod2 k n = k] (mod (2 ^ n - 1))"
   unfolding mersenne_mod2_def by (rule cong_trans) (rule cong_mersenne_mod)+
 
 lemma mersenne_mod2_nonneg [simp]: "k \<ge> 0 \<Longrightarrow> mersenne_mod2 k n \<ge> 0"
   unfolding mersenne_mod2_def by simp
 
 lemma mersenne_mod2_less:
   assumes "n > 2" and "k \<le> 2 ^ (2 * n + 2)"
   shows   "mersenne_mod2 k n < 2 ^ n + 5"
 proof -
   from assms have "2 ^ 3 \<le> (2 ^ n :: int)"
     by (intro power_increasing) auto
   hence "2 ^ n \<ge> (8 :: int)" by simp
   have "mersenne_mod k n < 2 ^ n + 2 ^ (2 * n + 2 - n)"
     by (rule mersenne_mod_less) (use assms in auto)
   also have "\<dots> \<le> 5 * 2 ^ n"
     by (simp add: power_add)
   finally have "mersenne_mod (mersenne_mod k n) n < 2 ^ n + 5"
     by (intro mersenne_mod_less') auto
   thus ?thesis by (simp add: mersenne_mod2_def)
 qed
 
 text \<open>
   Since we subtract 2 at one point, the intermediate results can become negative. This
   is not a problem since our reduction modulo $2 ^ p - 1$ happens to make them positive again
   immediately.
 \<close>
 lemma mersenne_mod_nonneg_strong:
   assumes "a > -(2 ^ p) + 1"
   shows   "mersenne_mod a p \<ge> 0"
 proof (cases "a < 0")
   case True
   have "eucl_rel_int a (2 ^ p) (- 1, a + 2 ^ p)"
     using assms True by (auto simp: eucl_rel_int_iff)
   hence "a div 2 ^ p = -1" and "a mod 2 ^ p = a + 2 ^ p"
     by (simp_all add: div_int_unique mod_int_unique) 
   hence "mersenne_mod a p = a + 2 ^ p - 1"
     by (simp add: mersenne_mod_def)
   also have "\<dots> > 0" using assms by simp
   finally show ?thesis by simp
 qed auto
 
 lemma mersenne_mod2_nonneg_strong:
   assumes "a > -(2 ^ p) + 1"
   shows   "mersenne_mod2 a p \<ge> 0"
   unfolding mersenne_mod2_def 
   by (rule mersenne_mod_nonneg, rule mersenne_mod_nonneg_strong) (use assms in auto)
 
 
 subsection \<open>Efficient code for the Lucas--Lehmer sequence\<close>
 
 primrec gen_lucas_lehmer_sequence'' :: "nat \<Rightarrow> int \<Rightarrow> nat \<Rightarrow> int" where
   "gen_lucas_lehmer_sequence'' p a 0 = a"
 | "gen_lucas_lehmer_sequence'' p a (Suc n) =
      gen_lucas_lehmer_sequence'' p (mersenne_mod2 (a ^ 2 - 2) p) n"
 
 lemma gen_lucas_lehmer_sequence''_correct:
   assumes "[a = a'] (mod (2 ^ p - 1))"
   shows   "[gen_lucas_lehmer_sequence'' p a n = gen_lucas_lehmer_sequence a' n] (mod (2 ^ p - 1))"
   using assms
 proof (induction n arbitrary: a a')
   case (Suc n)
   have "[mersenne_mod2 (a ^ 2 - 2) p = a ^ 2 - 2] (mod (2 ^ p - 1))"
     by (rule cong_mersenne_mod2)
   also have "[a ^ 2 - 2 = a' ^ 2 - 2] (mod (2 ^ p - 1))"
     by (intro cong_pow cong_diff Suc.prems cong_refl)
   finally have "[gen_lucas_lehmer_sequence'' p (mersenne_mod2 (a\<^sup>2 - 2) p) n =
                  gen_lucas_lehmer_sequence (a'\<^sup>2 - 2) n] (mod 2 ^ p - 1)"
     by (rule Suc.IH)
   thus ?case
     by (auto simp del: gen_lucas_lehmer_sequence.simps simp: gen_lucas_lehmer_sequence_Suc')
 qed auto
 
 lemma gen_lucas_lehmer_sequence''_bounds:
   assumes "a \<ge> 0" "a < 2 ^ p + 5" "p > 2"
   shows   "gen_lucas_lehmer_sequence'' p a n \<in> {0..<2 ^ p + 5}"
   using assms 
 proof (induction n arbitrary: a)
   case (Suc n)
   from Suc.prems have "a ^ 2 < (2 ^ p + 5) ^ 2"
     by (intro power_strict_mono Suc.prems) auto
   also have "\<dots> \<le> (2 ^ (p + 1)) ^ 2"
     using power_increasing[of 3 p "2 :: int"] \<open>p > 2\<close> by (intro power_mono) auto
   finally have "a ^ 2 - 2 < 2 ^ (2 * p + 2)"
     by (simp flip: power_mult mult_ac)
   moreover {
     from \<open>p > 2\<close> have "(2 ^ p) \<ge> (2 ^ 3 :: int)"
       by (intro power_increasing) auto
     hence "-(2 ^ p) + 1 < (-2 :: int)"
       by simp
     also have "-2 \<le> a ^ 2 - 2"
       by simp
     finally have "mersenne_mod2 (a ^ 2 - 2) p \<ge> 0"
       by (rule mersenne_mod2_nonneg_strong)
   }
   ultimately have "gen_lucas_lehmer_sequence'' p (mersenne_mod2 (a\<^sup>2 - 2) p) n \<in> {0..<2 ^ p + 5}"
     using \<open>p > 2\<close> by (intro Suc.IH mersenne_mod2_less) auto
   thus ?case by simp
 qed auto
 
 
 subsection \<open>Code for the Lucas--Lehmer test\<close>
 
 lemmas [code del] = lucas_lehmer_test_code_arithmetic
 
 lemma lucas_lehmer_test_code [code]:
   "lucas_lehmer_test p =
-     (2 < p \<and> (let x = gen_lucas_lehmer_sequence'' p 4 (p - 2) in x = 0 \<or> x = (1 << p) - 1))"
+     (2 < p \<and> (let x = gen_lucas_lehmer_sequence'' p 4 (p - 2) in x = 0 \<or> x = (push_bit p 1) - 1))"
   unfolding lucas_lehmer_test_def
 proof (rule conj_cong)
   assume "p > 2"
   define x where "x = gen_lucas_lehmer_sequence'' p 4 (p - 2)"
   from \<open>p > 2\<close> have "2 ^ 3 \<le> (2 ^ p :: int)" by (intro power_increasing) auto
   hence "2 ^ p \<ge> (8 :: int)" by simp
   hence bounds: "x \<in> {0..<2 ^ p + 5}"
     unfolding x_def using \<open>p > 2\<close> by (intro gen_lucas_lehmer_sequence''_bounds) auto
   have "2 ^ p - 1 dvd gen_lucas_lehmer_sequence 4 (p - 2) \<longleftrightarrow> 2 ^ p - 1 dvd x"
     unfolding x_def by (intro cong_dvd_iff cong_sym[OF gen_lucas_lehmer_sequence''_correct]) auto
   also have "\<dots> \<longleftrightarrow> x \<in> {0, 2 ^ p - 1}"
   proof
     assume "2 ^ p - 1 dvd x"
     then obtain k where k: "x = (2 ^ p - 1) * k" by auto
     have "k \<ge> 0" using bounds \<open>2 ^ p \<ge> 8\<close>
       by (auto simp: k zero_le_mult_iff)
     moreover {
       have "x < 2 ^ p + 5" using bounds by simp
       also have "\<dots> \<le> (2 ^ p - 1) * 2"
         using \<open>2 ^ p \<ge> 8\<close> by simp
       finally have "(2 ^ p - 1) * k < (2 ^ p - 1) * 2"
         unfolding k .
       hence "k < 2"
         by (subst (asm) mult_less_cancel_left) auto
     }
     ultimately have "k = 0 \<or> k = 1" by auto
     thus "x \<in> {0, 2 ^ p - 1}"
       using k by auto
   qed auto
   finally show "(2 ^ p - 1 dvd gen_lucas_lehmer_sequence 4 (p - 2)) =
-                ((let x = x in x = 0 \<or> x = (1 << p) - 1))"
+                ((let x = x in x = 0 \<or> x = (push_bit p 1) - 1))"
     by (simp add: shiftl_int_def Let_def)
 qed auto
 
 
 subsection \<open>Examples\<close>
 
 text \<open>
   Note that for some reason, the clever bit-arithmetic version of the Lucas--Lehmer test is 
   actually much slower than the one using integer arithmetic when using PolyML, and even more so 
   when using the built-in evaluator in Isabelle (which also uses PolyML with a slightly different 
   setup).
 
   I do not quite know why this is the case, but it is likely because of inefficient implementations
   of bit arithmetic operations in PolyML and/or the code generator setup for it.
 
   When running with GHC, the bit-arithmetic version is \<^emph>\<open>much\<close> faster.
 \<close>
 
 value "filter mersenne_prime [0..<100]"
 
 lemma "prime (2 ^ 521 - 1 :: nat)"
   by (subst lucas_lehmer_correct') eval
 
 lemma "prime (2 ^ 4253 - 1 :: nat)"
   by (subst lucas_lehmer_correct') eval
 
 end
\ No newline at end of file
diff --git a/thys/Native_Word/Bits_Integer.thy b/thys/Native_Word/Bits_Integer.thy
--- a/thys/Native_Word/Bits_Integer.thy
+++ b/thys/Native_Word/Bits_Integer.thy
@@ -1,684 +1,668 @@
 (*  Title:      Bits_Integer.thy
     Author:     Andreas Lochbihler, ETH Zurich
 *)
 
 chapter \<open>Bit operations for target language integers\<close>
 
 theory Bits_Integer imports
   More_Bits_Int
   Code_Symbolic_Bits_Int
 begin
 
 lemmas [transfer_rule] =
   identity_quotient
   fun_quotient
   Quotient_integer[folded integer.pcr_cr_eq]
 
 lemma undefined_transfer:
   assumes "Quotient R Abs Rep T"
   shows "T (Rep undefined) undefined"
 using assms unfolding Quotient_alt_def by blast
 
 bundle undefined_transfer = undefined_transfer[transfer_rule]
 
 section \<open>More lemmas about @{typ integer}s\<close>
 
 context
 includes integer.lifting
 begin
 
 lemma bitval_integer_transfer [transfer_rule]:
   "(rel_fun (=) pcr_integer) of_bool of_bool"
 by(auto simp add: of_bool_def integer.pcr_cr_eq cr_integer_def)
 
 lemma integer_of_nat_less_0_conv [simp]: "\<not> integer_of_nat n < 0"
 by(transfer) simp
 
 lemma int_of_integer_pow: "int_of_integer (x ^ n) = int_of_integer x ^ n"
 by(induct n) simp_all
 
 lemma pow_integer_transfer [transfer_rule]:
   "(rel_fun pcr_integer (rel_fun (=) pcr_integer)) (^) (^)"
 by(auto 4 3 simp add: integer.pcr_cr_eq cr_integer_def int_of_integer_pow)
 
 lemma sub1_lt_0_iff [simp]: "Code_Numeral.sub n num.One < 0 \<longleftrightarrow> False"
 by(cases n)(simp_all add: Code_Numeral.sub_code)
 
 lemma nat_of_integer_numeral [simp]: "nat_of_integer (numeral n) = numeral n"
 by transfer simp
 
 lemma nat_of_integer_sub1_conv_pred_numeral [simp]:
   "nat_of_integer (Code_Numeral.sub n num.One) = pred_numeral n"
 by(cases n)(simp_all add: Code_Numeral.sub_code)
 
 lemma nat_of_integer_1 [simp]: "nat_of_integer 1 = 1"
 by transfer simp
 
 lemma dup_1 [simp]: "Code_Numeral.dup 1 = 2"
 by transfer simp
 
 
 section \<open>Bit operations on @{typ integer}\<close>
 
 text \<open>Bit operations on @{typ integer} are the same as on @{typ int}\<close>
 
 lift_definition bin_rest_integer :: "integer \<Rightarrow> integer" is \<open>\<lambda>k . k div 2\<close> .
 lift_definition bin_last_integer :: "integer \<Rightarrow> bool" is odd .
 lift_definition Bit_integer :: "integer \<Rightarrow> bool \<Rightarrow> integer" is \<open>\<lambda>k b. of_bool b + 2 * k\<close> .
 
 end
 
-instance integer :: semiring_bit_syntax ..
-
-context
-  includes lifting_syntax integer.lifting
-begin
-
-lemma shiftl_integer_transfer [transfer_rule]:
-  \<open>(pcr_integer ===> (=) ===> pcr_integer) (\<lambda>k n. push_bit n k) (<<)\<close>
-  unfolding shiftl_eq_push_bit by transfer_prover
-
-lemma shiftr_integer_transfer [transfer_rule]:
-  \<open>(pcr_integer ===> (=) ===> pcr_integer) (\<lambda>k n. drop_bit n k) (>>)\<close>
-  unfolding shiftr_eq_drop_bit by transfer_prover
-
-end
-
 instantiation integer :: lsb begin
 context includes integer.lifting begin
 
 lift_definition lsb_integer :: "integer \<Rightarrow> bool" is lsb .
 
 instance
   by (standard; transfer) (fact lsb_odd)
 
 end
 end
 
 instantiation integer :: msb begin
 context includes integer.lifting begin
 
 lift_definition msb_integer :: "integer \<Rightarrow> bool" is msb .
 
 instance ..
 
 end
 end
 
 instantiation integer :: set_bit begin
 context includes integer.lifting begin
 
 lift_definition set_bit_integer :: "integer \<Rightarrow> nat \<Rightarrow> bool \<Rightarrow> integer" is set_bit .
 
 instance
   apply standard
   apply transfer
   apply (simp add: bit_simps)
   done
 
 end
 end
 
 abbreviation (input) wf_set_bits_integer
 where "wf_set_bits_integer \<equiv> wf_set_bits_int"
 
 
 section \<open>Target language implementations\<close>
 
 text \<open>
   Unfortunately, this is not straightforward,
   because these API functions have different signatures and preconditions on the parameters:
 
   \begin{description}
   \item[Standard ML] Shifts in IntInf are given as word, but not IntInf.
   \item[Haskell] In the Data.Bits.Bits type class, shifts and bit indices are given as Int rather than Integer.
   \end{description}
 
   Additional constants take only parameters of type @{typ integer} rather than @{typ nat}
   and check the preconditions as far as possible (e.g., being non-negative) in a portable way.
   Manual implementations inside code\_printing perform the remaining range checks and convert
   these @{typ integer}s into the right type.
 
   For normalisation by evaluation, we derive custom code equations, because NBE
   does not know these code\_printing serialisations and would otherwise loop.
 \<close>
 
 code_identifier code_module Bits_Integer \<rightharpoonup>
   (SML) Bits_Int and (OCaml) Bits_Int and (Haskell) Bits_Int and (Scala) Bits_Int
 
 code_printing code_module Bits_Integer \<rightharpoonup> (SML)
 \<open>structure Bits_Integer : sig
   val set_bit : IntInf.int -> IntInf.int -> bool -> IntInf.int
   val shiftl : IntInf.int -> IntInf.int -> IntInf.int
   val shiftr : IntInf.int -> IntInf.int -> IntInf.int
   val test_bit : IntInf.int -> IntInf.int -> bool
 end = struct
 
 val maxWord = IntInf.pow (2, Word.wordSize);
 
 fun set_bit x n b =
   if n < maxWord then
     if b then IntInf.orb (x, IntInf.<< (1, Word.fromLargeInt (IntInf.toLarge n)))
     else IntInf.andb (x, IntInf.notb (IntInf.<< (1, Word.fromLargeInt (IntInf.toLarge n))))
   else raise (Fail ("Bit index too large: " ^ IntInf.toString n));
 
 fun shiftl x n =
   if n < maxWord then IntInf.<< (x, Word.fromLargeInt (IntInf.toLarge n))
   else raise (Fail ("Shift operand too large: " ^ IntInf.toString n));
 
 fun shiftr x n =
   if n < maxWord then IntInf.~>> (x, Word.fromLargeInt (IntInf.toLarge n))
   else raise (Fail ("Shift operand too large: " ^ IntInf.toString n));
 
 fun test_bit x n =
   if n < maxWord then IntInf.andb (x, IntInf.<< (1, Word.fromLargeInt (IntInf.toLarge n))) <> 0
   else raise (Fail ("Bit index too large: " ^ IntInf.toString n));
 
 end; (*struct Bits_Integer*)\<close>
 code_reserved SML Bits_Integer
 
 code_printing code_module Bits_Integer \<rightharpoonup> (OCaml)
 \<open>module Bits_Integer : sig
   val shiftl : Z.t -> Z.t -> Z.t
   val shiftr : Z.t -> Z.t -> Z.t
   val test_bit : Z.t -> Z.t -> bool
 end = struct
 
 (* We do not need an explicit range checks here,
    because Big_int.int_of_big_int raises Failure
    if the argument does not fit into an int. *)
 let shiftl x n = Z.shift_left x (Z.to_int n);;
 
 let shiftr x n = Z.shift_right x (Z.to_int n);;
 
 let test_bit x n =  Z.testbit x (Z.to_int n);;
 
 end;; (*struct Bits_Integer*)\<close>
 code_reserved OCaml Bits_Integer
 
 code_printing code_module Data_Bits \<rightharpoonup> (Haskell)
 \<open>
 module Data_Bits where {
 
 import qualified Data.Bits;
 
 {-
   The ...Bounded functions assume that the Integer argument for the shift
   or bit index fits into an Int, is non-negative and (for types of fixed bit width)
   less than bitSize
 -}
 
 infixl 7 .&.;
 infixl 6 `xor`;
 infixl 5 .|.;
 
 (.&.) :: Data.Bits.Bits a => a -> a -> a;
 (.&.) = (Data.Bits..&.);
 
 xor :: Data.Bits.Bits a => a -> a -> a;
 xor = Data.Bits.xor;
 
 (.|.) :: Data.Bits.Bits a => a -> a -> a;
 (.|.) = (Data.Bits..|.);
 
 complement :: Data.Bits.Bits a => a -> a;
 complement = Data.Bits.complement;
 
 testBitUnbounded :: Data.Bits.Bits a => a -> Integer -> Bool;
 testBitUnbounded x b
   | b <= toInteger (Prelude.maxBound :: Int) = Data.Bits.testBit x (fromInteger b)
   | otherwise = error ("Bit index too large: " ++ show b)
 ;
 
 testBitBounded :: Data.Bits.Bits a => a -> Integer -> Bool;
 testBitBounded x b = Data.Bits.testBit x (fromInteger b);
 
 setBitUnbounded :: Data.Bits.Bits a => a -> Integer -> Bool -> a;
 setBitUnbounded x n b
   | n <= toInteger (Prelude.maxBound :: Int) =
     if b then Data.Bits.setBit x (fromInteger n) else Data.Bits.clearBit x (fromInteger n)
   | otherwise = error ("Bit index too large: " ++ show n)
 ;
 
 setBitBounded :: Data.Bits.Bits a => a -> Integer -> Bool -> a;
 setBitBounded x n True = Data.Bits.setBit x (fromInteger n);
 setBitBounded x n False = Data.Bits.clearBit x (fromInteger n);
 
 shiftlUnbounded :: Data.Bits.Bits a => a -> Integer -> a;
 shiftlUnbounded x n
   | n <= toInteger (Prelude.maxBound :: Int) = Data.Bits.shiftL x (fromInteger n)
   | otherwise = error ("Shift operand too large: " ++ show n)
 ;
 
 shiftlBounded :: Data.Bits.Bits a => a -> Integer -> a;
 shiftlBounded x n = Data.Bits.shiftL x (fromInteger n);
 
 shiftrUnbounded :: Data.Bits.Bits a => a -> Integer -> a;
 shiftrUnbounded x n
   | n <= toInteger (Prelude.maxBound :: Int) = Data.Bits.shiftR x (fromInteger n)
   | otherwise = error ("Shift operand too large: " ++ show n)
 ;
 
 shiftrBounded :: (Ord a, Data.Bits.Bits a) => a -> Integer -> a;
 shiftrBounded x n = Data.Bits.shiftR x (fromInteger n);
 
 }\<close>
 
   and \<comment> \<open>@{theory HOL.Quickcheck_Narrowing} maps @{typ integer} to
             Haskell's Prelude.Int type instead of Integer. For compatibility
             with the Haskell target, we nevertheless provide bounded and
             unbounded functions.\<close>
   (Haskell_Quickcheck)
 \<open>
 module Data_Bits where {
 
 import qualified Data.Bits;
 
 {-
   The functions assume that the Int argument for the shift or bit index is
   non-negative and (for types of fixed bit width) less than bitSize
 -}
 
 infixl 7 .&.;
 infixl 6 `xor`;
 infixl 5 .|.;
 
 (.&.) :: Data.Bits.Bits a => a -> a -> a;
 (.&.) = (Data.Bits..&.);
 
 xor :: Data.Bits.Bits a => a -> a -> a;
 xor = Data.Bits.xor;
 
 (.|.) :: Data.Bits.Bits a => a -> a -> a;
 (.|.) = (Data.Bits..|.);
 
 complement :: Data.Bits.Bits a => a -> a;
 complement = Data.Bits.complement;
 
 testBitUnbounded :: Data.Bits.Bits a => a -> Prelude.Int -> Bool;
 testBitUnbounded = Data.Bits.testBit;
 
 testBitBounded :: Data.Bits.Bits a => a -> Prelude.Int -> Bool;
 testBitBounded = Data.Bits.testBit;
 
 setBitUnbounded :: Data.Bits.Bits a => a -> Prelude.Int -> Bool -> a;
 setBitUnbounded x n True = Data.Bits.setBit x n;
 setBitUnbounded x n False = Data.Bits.clearBit x n;
 
 setBitBounded :: Data.Bits.Bits a => a -> Prelude.Int -> Bool -> a;
 setBitBounded x n True = Data.Bits.setBit x n;
 setBitBounded x n False = Data.Bits.clearBit x n;
 
 shiftlUnbounded :: Data.Bits.Bits a => a -> Prelude.Int -> a;
 shiftlUnbounded = Data.Bits.shiftL;
 
 shiftlBounded :: Data.Bits.Bits a => a -> Prelude.Int -> a;
 shiftlBounded = Data.Bits.shiftL;
 
 shiftrUnbounded :: Data.Bits.Bits a => a -> Prelude.Int -> a;
 shiftrUnbounded = Data.Bits.shiftR;
 
 shiftrBounded :: (Ord a, Data.Bits.Bits a) => a -> Prelude.Int -> a;
 shiftrBounded = Data.Bits.shiftR;
 
 }\<close>
 code_reserved Haskell Data_Bits
 
 code_printing code_module Bits_Integer \<rightharpoonup> (Scala)
 \<open>object Bits_Integer {
 
 def setBit(x: BigInt, n: BigInt, b: Boolean) : BigInt =
   if (n.isValidInt)
     if (b)
       x.setBit(n.toInt)
     else
       x.clearBit(n.toInt)
   else
     sys.error("Bit index too large: " + n.toString)
 
 def shiftl(x: BigInt, n: BigInt) : BigInt =
   if (n.isValidInt)
     x << n.toInt
   else
     sys.error("Shift index too large: " + n.toString)
 
 def shiftr(x: BigInt, n: BigInt) : BigInt =
   if (n.isValidInt)
     x << n.toInt
   else
     sys.error("Shift index too large: " + n.toString)
 
 def testBit(x: BigInt, n: BigInt) : Boolean =
   if (n.isValidInt)
     x.testBit(n.toInt)
   else
     sys.error("Bit index too large: " + n.toString)
 
 } /* object Bits_Integer */\<close>
 
 code_printing
   constant "(AND) :: integer \<Rightarrow> integer \<Rightarrow> integer" \<rightharpoonup>
   (SML) "IntInf.andb ((_),/ (_))" and
   (OCaml) "Z.logand" and
   (Haskell) "((Data'_Bits..&.) :: Integer -> Integer -> Integer)" and
   (Haskell_Quickcheck) "((Data'_Bits..&.) :: Prelude.Int -> Prelude.Int -> Prelude.Int)" and
   (Scala) infixl 3 "&"
 | constant "(OR) :: integer \<Rightarrow> integer \<Rightarrow> integer" \<rightharpoonup>
   (SML) "IntInf.orb ((_),/ (_))" and
   (OCaml) "Z.logor" and
   (Haskell) "((Data'_Bits..|.) :: Integer -> Integer -> Integer)" and
   (Haskell_Quickcheck) "((Data'_Bits..|.) :: Prelude.Int -> Prelude.Int -> Prelude.Int)" and
   (Scala) infixl 1 "|"
 | constant "(XOR) :: integer \<Rightarrow> integer \<Rightarrow> integer" \<rightharpoonup>
   (SML) "IntInf.xorb ((_),/ (_))" and
   (OCaml) "Z.logxor" and
   (Haskell) "(Data'_Bits.xor :: Integer -> Integer -> Integer)" and
   (Haskell_Quickcheck) "(Data'_Bits.xor :: Prelude.Int -> Prelude.Int -> Prelude.Int)" and
   (Scala) infixl 2 "^"
 | constant "NOT :: integer \<Rightarrow> integer" \<rightharpoonup>
   (SML) "IntInf.notb" and
   (OCaml) "Z.lognot" and
   (Haskell) "(Data'_Bits.complement :: Integer -> Integer)" and
   (Haskell_Quickcheck) "(Data'_Bits.complement :: Prelude.Int -> Prelude.Int)" and
   (Scala) "_.unary'_~"
 
 code_printing constant bin_rest_integer \<rightharpoonup>
   (SML) "IntInf.div ((_), 2)" and
   (OCaml) "Z.shift'_right/ _/ 1" and
   (Haskell) "(Data'_Bits.shiftrUnbounded _ 1 :: Integer)" and
   (Haskell_Quickcheck) "(Data'_Bits.shiftrUnbounded _ 1 :: Prelude.Int)" and
   (Scala) "_ >> 1"
 
 context
 includes integer.lifting
 begin
 
 lemma bitNOT_integer_code [code]:
   fixes i :: integer shows
   "NOT i = - i - 1"
 by transfer(simp add: int_not_def)
 
 lemma bin_rest_integer_code [code nbe]:
   "bin_rest_integer i = i div 2"
   by transfer rule
 
 lemma bin_last_integer_code [code]:
   "bin_last_integer i \<longleftrightarrow> i AND 1 \<noteq> 0"
   by transfer (rule bin_last_conv_AND)
 
 lemma bin_last_integer_nbe [code nbe]:
   "bin_last_integer i \<longleftrightarrow> i mod 2 \<noteq> 0"
 by transfer(simp add: bin_last_def)
 
 lemma bitval_bin_last_integer [code_unfold]:
   "of_bool (bin_last_integer i) = i AND 1"
 by transfer(rule bitval_bin_last)
 
 end
 
 definition integer_test_bit :: "integer \<Rightarrow> integer \<Rightarrow> bool"
   where "integer_test_bit x n = (if n < 0 then undefined x n else bit x (nat_of_integer n))"
 
 declare [[code drop: \<open>bit :: integer \<Rightarrow> nat \<Rightarrow> bool\<close>]]
 
 lemma bit_integer_code [code]:
   "bit x n \<longleftrightarrow> integer_test_bit x (integer_of_nat n)"
   by (simp add: integer_test_bit_def)
 
 lemma integer_test_bit_code [code]:
   "integer_test_bit x (Code_Numeral.Neg n) = undefined x (Code_Numeral.Neg n)"
   "integer_test_bit 0 0 = False"
   "integer_test_bit 0 (Code_Numeral.Pos n) = False"
   "integer_test_bit (Code_Numeral.Pos num.One)      0 = True"
   "integer_test_bit (Code_Numeral.Pos (num.Bit0 n)) 0 = False"
   "integer_test_bit (Code_Numeral.Pos (num.Bit1 n)) 0 = True"
   "integer_test_bit (Code_Numeral.Pos num.One)      (Code_Numeral.Pos n') = False"
   "integer_test_bit (Code_Numeral.Pos (num.Bit0 n)) (Code_Numeral.Pos n') =
    integer_test_bit (Code_Numeral.Pos n) (Code_Numeral.sub n' num.One)"
   "integer_test_bit (Code_Numeral.Pos (num.Bit1 n)) (Code_Numeral.Pos n') =
    integer_test_bit (Code_Numeral.Pos n) (Code_Numeral.sub n' num.One)"
   "integer_test_bit (Code_Numeral.Neg num.One)      0 = True"
   "integer_test_bit (Code_Numeral.Neg (num.Bit0 n)) 0 = False"
   "integer_test_bit (Code_Numeral.Neg (num.Bit1 n)) 0 = True"
   "integer_test_bit (Code_Numeral.Neg num.One)      (Code_Numeral.Pos n') = True"
   "integer_test_bit (Code_Numeral.Neg (num.Bit0 n)) (Code_Numeral.Pos n') =
    integer_test_bit (Code_Numeral.Neg n) (Code_Numeral.sub n' num.One)"
   "integer_test_bit (Code_Numeral.Neg (num.Bit1 n)) (Code_Numeral.Pos n') =
    integer_test_bit (Code_Numeral.Neg (n + num.One)) (Code_Numeral.sub n' num.One)"
                 apply (simp_all add: integer_test_bit_def bit_integer_def)
   using bin_nth_numeral_simps bit_numeral_int_simps(6)
   by presburger
 
 code_printing constant integer_test_bit \<rightharpoonup>
   (SML) "Bits'_Integer.test'_bit" and
   (OCaml) "Bits'_Integer.test'_bit" and
   (Haskell) "(Data'_Bits.testBitUnbounded :: Integer -> Integer -> Bool)" and
   (Haskell_Quickcheck) "(Data'_Bits.testBitUnbounded :: Prelude.Int -> Prelude.Int -> Bool)" and
   (Scala) "Bits'_Integer.testBit"
 
 context
 includes integer.lifting
 begin
 
 lemma lsb_integer_code [code]:
   fixes x :: integer shows
   "lsb x = bit x 0"
 by transfer(simp add: lsb_int_def)
 
 definition integer_set_bit :: "integer \<Rightarrow> integer \<Rightarrow> bool \<Rightarrow> integer"
 where [code del]: "integer_set_bit x n b = (if n < 0 then undefined x n b else set_bit x (nat_of_integer n) b)"
 
 lemma set_bit_integer_code [code]:
   "set_bit x i b = integer_set_bit x (integer_of_nat i) b"
 by(simp add: integer_set_bit_def)
 
 lemma set_bit_integer_conv_masks:
   fixes x :: integer shows
-  "set_bit x i b = (if b then x OR (1 << i) else x AND NOT (1 << i))"
-  by transfer (simp add: int_set_bit_False_conv_NAND int_set_bit_True_conv_OR shiftl_eq_push_bit)
+  "set_bit x i b = (if b then x OR (push_bit i 1) else x AND NOT (push_bit i 1))"
+  by transfer (simp add: int_set_bit_False_conv_NAND int_set_bit_True_conv_OR)
 
 end
 
 code_printing constant integer_set_bit \<rightharpoonup>
   (SML) "Bits'_Integer.set'_bit" and
   (Haskell) "(Data'_Bits.setBitUnbounded :: Integer -> Integer -> Bool -> Integer)" and
   (Haskell_Quickcheck) "(Data'_Bits.setBitUnbounded :: Prelude.Int -> Prelude.Int -> Bool -> Prelude.Int)" and
   (Scala) "Bits'_Integer.setBit"
 
 text \<open>
   OCaml.Big\_int does not have a method for changing an individual bit, so we emulate that with masks.
   We prefer an Isabelle implementation, because this then takes care of the signs for AND and OR.
 \<close>
 lemma integer_set_bit_code [code]:
   "integer_set_bit x n b =
   (if n < 0 then undefined x n b else
    if b then x OR (push_bit (nat_of_integer n) 1)
    else x AND NOT (push_bit (nat_of_integer n) 1))"
   by (auto simp add: integer_set_bit_def not_less set_bit_eq set_bit_def unset_bit_def)
 
 definition integer_shiftl :: "integer \<Rightarrow> integer \<Rightarrow> integer"
 where [code del]: "integer_shiftl x n = (if n < 0 then undefined x n else push_bit (nat_of_integer n) x)"
 
 declare [[code drop: \<open>push_bit :: nat \<Rightarrow> integer \<Rightarrow> integer\<close>]]
 
 lemma shiftl_integer_code [code]:
   fixes x :: integer shows
   "push_bit n x = integer_shiftl x (integer_of_nat n)"
 by(auto simp add: integer_shiftl_def)
 
 context
 includes integer.lifting
 begin
 
 lemma shiftl_integer_conv_mult_pow2:
   fixes x :: integer shows
-  "x << n = x * 2 ^ n"
-  by (simp add: push_bit_eq_mult shiftl_eq_push_bit)
+  "push_bit n x = x * 2 ^ n"
+  by (fact push_bit_eq_mult)
 
 lemma integer_shiftl_code [code]:
   "integer_shiftl x (Code_Numeral.Neg n) = undefined x (Code_Numeral.Neg n)"
   "integer_shiftl x 0 = x"
   "integer_shiftl x (Code_Numeral.Pos n) = integer_shiftl (Code_Numeral.dup x) (Code_Numeral.sub n num.One)"
   "integer_shiftl 0 (Code_Numeral.Pos n) = 0"
      apply (simp_all add: integer_shiftl_def numeral_eq_Suc)
   apply transfer
   apply (simp add: ac_simps)
   done
 
 end
 
 code_printing constant integer_shiftl \<rightharpoonup>
   (SML) "Bits'_Integer.shiftl" and
   (OCaml) "Bits'_Integer.shiftl" and
   (Haskell) "(Data'_Bits.shiftlUnbounded :: Integer -> Integer -> Integer)" and
   (Haskell_Quickcheck) "(Data'_Bits.shiftlUnbounded :: Prelude.Int -> Prelude.Int -> Prelude.Int)" and
   (Scala) "Bits'_Integer.shiftl"
 
 definition integer_shiftr :: "integer \<Rightarrow> integer \<Rightarrow> integer"
 where [code del]: "integer_shiftr x n = (if n < 0 then undefined x n else drop_bit (nat_of_integer n) x)"
 
 declare [[code drop: \<open>drop_bit :: nat \<Rightarrow> integer \<Rightarrow> integer\<close>]]
 
 lemma shiftr_integer_conv_div_pow2:
   includes integer.lifting fixes x :: integer shows
-  "x >> n = x div 2 ^ n"
-  by (simp add: drop_bit_eq_div shiftr_eq_drop_bit)
+  "drop_bit n x = x div 2 ^ n"
+  by (fact drop_bit_eq_div)
 
 lemma shiftr_integer_code [code]:
   fixes x :: integer shows
   "drop_bit n x = integer_shiftr x (integer_of_nat n)"
 by(auto simp add: integer_shiftr_def)
 
 code_printing constant integer_shiftr \<rightharpoonup>
   (SML) "Bits'_Integer.shiftr" and
   (OCaml) "Bits'_Integer.shiftr" and
   (Haskell) "(Data'_Bits.shiftrUnbounded :: Integer -> Integer -> Integer)" and
   (Haskell_Quickcheck) "(Data'_Bits.shiftrUnbounded :: Prelude.Int -> Prelude.Int -> Prelude.Int)" and
   (Scala) "Bits'_Integer.shiftr"
 
 lemma integer_shiftr_code [code]:
   includes integer.lifting
   shows
   "integer_shiftr x (Code_Numeral.Neg n) = undefined x (Code_Numeral.Neg n)"
   "integer_shiftr x 0 = x"
   "integer_shiftr 0 (Code_Numeral.Pos n) = 0"
   "integer_shiftr (Code_Numeral.Pos num.One) (Code_Numeral.Pos n) = 0"
   "integer_shiftr (Code_Numeral.Pos (num.Bit0 n')) (Code_Numeral.Pos n) =
    integer_shiftr (Code_Numeral.Pos n') (Code_Numeral.sub n num.One)"
   "integer_shiftr (Code_Numeral.Pos (num.Bit1 n')) (Code_Numeral.Pos n) =
    integer_shiftr (Code_Numeral.Pos n') (Code_Numeral.sub n num.One)"
   "integer_shiftr (Code_Numeral.Neg num.One) (Code_Numeral.Pos n) = -1"
   "integer_shiftr (Code_Numeral.Neg (num.Bit0 n')) (Code_Numeral.Pos n) =
    integer_shiftr (Code_Numeral.Neg n') (Code_Numeral.sub n num.One)"
   "integer_shiftr (Code_Numeral.Neg (num.Bit1 n')) (Code_Numeral.Pos n) =
    integer_shiftr (Code_Numeral.Neg (Num.inc n')) (Code_Numeral.sub n num.One)"
           apply (simp_all add: integer_shiftr_def numeral_eq_Suc drop_bit_Suc)
     apply transfer apply simp
    apply transfer apply simp
   apply transfer apply (simp add: add_One)
   done
 
 context
 includes integer.lifting
 begin
 
 lemma Bit_integer_code [code]:
   "Bit_integer i False = push_bit 1 i"
   "Bit_integer i True = (push_bit 1 i) + 1"
   by (transfer; simp add: shiftl_int_def)+
 
 lemma msb_integer_code [code]:
   "msb (x :: integer) \<longleftrightarrow> x < 0"
 by transfer(simp add: msb_int_def)
 
 end
 
 context
 includes integer.lifting natural.lifting
 begin
 
 lemma bitAND_integer_unfold [code]:
   "x AND y =
    (if x = 0 then 0
     else if x = - 1 then y
     else Bit_integer (bin_rest_integer x AND bin_rest_integer y) (bin_last_integer x \<and> bin_last_integer y))"
   by transfer
     (auto simp add: algebra_simps
       and_int_rec [of _ \<open>_ * 2\<close>] and_int_rec [of \<open>_ * 2\<close>] and_int_rec [of \<open>1 + _ * 2\<close>]
       elim!: evenE oddE)
 
 lemma bitOR_integer_unfold [code]:
   "x OR y =
    (if x = 0 then y
     else if x = - 1 then - 1
     else Bit_integer (bin_rest_integer x OR bin_rest_integer y) (bin_last_integer x \<or> bin_last_integer y))"
   by transfer
     (auto simp add: algebra_simps
       or_int_rec [of _ \<open>_ * 2\<close>] or_int_rec [of _ \<open>1 + _ * 2\<close>] or_int_rec [of \<open>1 + _ * 2\<close>]
       elim!: evenE oddE)
 
 lemma bitXOR_integer_unfold [code]:
   "x XOR y =
    (if x = 0 then y
     else if x = - 1 then NOT y
     else Bit_integer (bin_rest_integer x XOR bin_rest_integer y)
       (\<not> bin_last_integer x \<longleftrightarrow> bin_last_integer y))"
   by transfer
     (auto simp add: algebra_simps
       xor_int_rec [of _ \<open>_ * 2\<close>] xor_int_rec [of \<open>_ * 2\<close>] xor_int_rec [of \<open>1 + _ * 2\<close>]
       elim!: evenE oddE)
 
 end
 
 
 section \<open>Test code generator setup\<close>
 
 definition bit_integer_test :: "bool" where
   "bit_integer_test =
   (([ -1 AND 3, 1 AND -3, 3 AND 5, -3 AND (- 5)
     , -3 OR 1, 1 OR -3, 3 OR 5, -3 OR (- 5)
     , NOT 1, NOT (- 3)
     , -1 XOR 3, 1 XOR (- 3), 3 XOR 5, -5 XOR (- 3)
     , set_bit 5 4 True, set_bit (- 5) 2 True, set_bit 5 0 False, set_bit (- 5) 1 False
-    , 1 << 2, -1 << 3
-    , 100 >> 3, -100 >> 3] :: integer list)
+    , push_bit 2 1, push_bit 3 (- 1)
+    , drop_bit 3 100, drop_bit 3 (- 100)] :: integer list)
   = [ 3, 1, 1, -7
     , -3, -3, 7, -1
     , -2, 2
     , -4, -4, 6, 6
     , 21, -1, 4, -7
     , 4, -8
     , 12, -13] \<and>
     [ bit (5 :: integer) 4, bit (5 :: integer) 2, bit (-5 :: integer) 4, bit (-5 :: integer) 2
     , lsb (5 :: integer), lsb (4 :: integer), lsb (-1 :: integer), lsb (-2 :: integer),
       msb (5 :: integer), msb (0 :: integer), msb (-1 :: integer), msb (-2 :: integer)]
   = [ False, True, True, False,
       True, False, True, False,
       False, False, True, True])"
 
 export_code bit_integer_test checking SML Haskell? Haskell_Quickcheck? OCaml? Scala
 
 notepad begin
 have bit_integer_test by eval
 have bit_integer_test by normalization
 have bit_integer_test by code_simp
 end
 ML_val \<open>val true = @{code bit_integer_test}\<close>
 
 lemma "x AND y = x OR (y :: integer)"
 quickcheck[random, expect=counterexample]
 quickcheck[exhaustive, expect=counterexample]
 oops
 
 lemma "(x :: integer) AND x = x OR x"
 quickcheck[narrowing, expect=no_counterexample]
 oops
 
 lemma "(f :: integer \<Rightarrow> unit) = g"
 quickcheck[narrowing, size=3, expect=no_counterexample]
 by(simp add: fun_eq_iff)
 
 hide_const bit_integer_test
 hide_fact bit_integer_test_def
 
 end
diff --git a/thys/Native_Word/Code_Symbolic_Bits_Int.thy b/thys/Native_Word/Code_Symbolic_Bits_Int.thy
--- a/thys/Native_Word/Code_Symbolic_Bits_Int.thy
+++ b/thys/Native_Word/Code_Symbolic_Bits_Int.thy
@@ -1,122 +1,122 @@
 (*  Title:      Code_Symbolic_Bits_Int.thy
     Author:     Andreas Lochbihler, ETH Zurich
 *)
 
 chapter \<open>Symbolic implementation of bit operations on int\<close>
 
 theory Code_Symbolic_Bits_Int
 imports
   "Word_Lib.Generic_set_bit"
   "Word_Lib.Least_significant_bit"
   More_Bits_Int
 begin
 
 section \<open>Implementations of bit operations on \<^typ>\<open>int\<close> operating on symbolic representation\<close>
 
 lemma test_bit_int_code [code]:
   "bit (0::int)          n = False"
   "bit (Int.Neg num.One) n = True"
   "bit (Int.Pos num.One)      0 = True"
   "bit (Int.Pos (num.Bit0 m)) 0 = False"
   "bit (Int.Pos (num.Bit1 m)) 0 = True"
   "bit (Int.Neg (num.Bit0 m)) 0 = False"
   "bit (Int.Neg (num.Bit1 m)) 0 = True"
   "bit (Int.Pos num.One)      (Suc n) = False"
   "bit (Int.Pos (num.Bit0 m)) (Suc n) = bit (Int.Pos m) n"
   "bit (Int.Pos (num.Bit1 m)) (Suc n) = bit (Int.Pos m) n"
   "bit (Int.Neg (num.Bit0 m)) (Suc n) = bit (Int.Neg m) n"
   "bit (Int.Neg (num.Bit1 m)) (Suc n) = bit (Int.Neg (Num.inc m)) n"
   by (simp_all add: Num.add_One bit_Suc)
 
 lemma int_not_code [code]:
   "NOT (0 :: int) = -1"
   "NOT (Int.Pos n) = Int.Neg (Num.inc n)"
   "NOT (Int.Neg n) = Num.sub n num.One"
 by(simp_all add: Num.add_One int_not_def)
 
 lemma int_and_code [code]: fixes i j :: int shows
   "0 AND j = 0"
   "i AND 0 = 0"
   "Int.Pos n AND Int.Pos m = (case bitAND_num n m of None \<Rightarrow> 0 | Some n' \<Rightarrow> Int.Pos n')"
   "Int.Neg n AND Int.Neg m = NOT (Num.sub n num.One OR Num.sub m num.One)"
   "Int.Pos n AND Int.Neg num.One = Int.Pos n"
   "Int.Pos n AND Int.Neg (num.Bit0 m) = Num.sub (bitORN_num (Num.BitM m) n) num.One"
   "Int.Pos n AND Int.Neg (num.Bit1 m) = Num.sub (bitORN_num (num.Bit0 m) n) num.One"
   "Int.Neg num.One AND Int.Pos m = Int.Pos m"
   "Int.Neg (num.Bit0 n) AND Int.Pos m = Num.sub (bitORN_num (Num.BitM n) m) num.One"
   "Int.Neg (num.Bit1 n) AND Int.Pos m = Num.sub (bitORN_num (num.Bit0 n) m) num.One"
            apply (simp_all add: int_numeral_bitAND_num Num.add_One
               sub_inc_One_eq inc_BitM_eq not_minus_numeral_inc_eq
               flip: int_not_neg_numeral int_or_not_bitORN_num split: option.split)
    apply (simp_all add: ac_simps)
   done
 
 lemma int_or_code [code]: fixes i j :: int shows
   "0 OR j = j"
   "i OR 0 = i"
   "Int.Pos n OR Int.Pos m = Int.Pos (bitOR_num n m)"
   "Int.Neg n OR Int.Neg m = NOT (Num.sub n num.One AND Num.sub m num.One)"
   "Int.Pos n OR Int.Neg num.One = Int.Neg num.One"
   "Int.Pos n OR Int.Neg (num.Bit0 m) = (case bitANDN_num (Num.BitM m) n of None \<Rightarrow> -1 | Some n' \<Rightarrow> Int.Neg (Num.inc n'))"
   "Int.Pos n OR Int.Neg (num.Bit1 m) = (case bitANDN_num (num.Bit0 m) n of None \<Rightarrow> -1 | Some n' \<Rightarrow> Int.Neg (Num.inc n'))"
   "Int.Neg num.One OR Int.Pos m = Int.Neg num.One"
   "Int.Neg (num.Bit0 n) OR Int.Pos m = (case bitANDN_num (Num.BitM n) m of None \<Rightarrow> -1 | Some n' \<Rightarrow> Int.Neg (Num.inc n'))"
   "Int.Neg (num.Bit1 n) OR Int.Pos m = (case bitANDN_num (num.Bit0 n) m of None \<Rightarrow> -1 | Some n' \<Rightarrow> Int.Neg (Num.inc n'))"
            apply (simp_all add: int_numeral_bitOR_num flip: int_not_neg_numeral)
      apply (simp_all add: or_int_def int_and_comm int_not_and_bitANDN_num del: int_not_simps(4) split: option.split)
      apply (simp_all add: Num.add_One)
   done
 
 lemma int_xor_code [code]: fixes i j :: int shows
   "0 XOR j = j"
   "i XOR 0 = i"
   "Int.Pos n XOR Int.Pos m = (case bitXOR_num n m of None \<Rightarrow> 0 | Some n' \<Rightarrow> Int.Pos n')"
   "Int.Neg n XOR Int.Neg m = Num.sub n num.One XOR Num.sub m num.One"
   "Int.Neg n XOR Int.Pos m = NOT (Num.sub n num.One XOR Int.Pos m)"
   "Int.Pos n XOR Int.Neg m = NOT (Int.Pos n XOR Num.sub m num.One)"
   by(fold int_not_neg_numeral)(simp_all add: int_numeral_bitXOR_num int_xor_not cong: option.case_cong)
 
-lemma bin_rest_code: "i div 2 = i >> 1" for i :: int
+lemma bin_rest_code: "i div 2 = drop_bit 1 i" for i :: int
   by (simp add: shiftr_int_def)
 
 lemma set_bits_code [code]: 
   "set_bits = Code.abort (STR ''set_bits is unsupported on type int'') (\<lambda>_. set_bits :: _ \<Rightarrow> int)"
 by simp
 
 lemma fixes i :: int 
-  shows int_set_bit_True_conv_OR [code]: "set_bit i n True = i OR (1 << n)"
-  and int_set_bit_False_conv_NAND [code]: "set_bit i n False = i AND NOT (1 << n)"
-  and int_set_bit_conv_ops: "set_bit i n b = (if b then i OR (1 << n) else i AND NOT (1 << n))"
+  shows int_set_bit_True_conv_OR [code]: "set_bit i n True = i OR push_bit n 1"
+  and int_set_bit_False_conv_NAND [code]: "set_bit i n False = i AND NOT (push_bit n 1)"
+  and int_set_bit_conv_ops: "set_bit i n b = (if b then i OR (push_bit n 1) else i AND NOT (push_bit n 1))"
 by(simp_all add: set_bit_int_def bin_set_conv_OR bin_clr_conv_NAND)
 
 declare [[code drop: \<open>drop_bit :: nat \<Rightarrow> int \<Rightarrow> int\<close>]]
 
 lemma drop_bit_int_code [code]: fixes i :: int shows
   "drop_bit 0 i = i"
   "drop_bit (Suc n) 0 = (0 :: int)"
   "drop_bit (Suc n) (Int.Pos num.One) = 0"
   "drop_bit (Suc n) (Int.Pos (num.Bit0 m)) = drop_bit n (Int.Pos m)"
   "drop_bit (Suc n) (Int.Pos (num.Bit1 m)) = drop_bit n (Int.Pos m)"
   "drop_bit (Suc n) (Int.Neg num.One) = - 1"
   "drop_bit (Suc n) (Int.Neg (num.Bit0 m)) = drop_bit n (Int.Neg m)"
   "drop_bit (Suc n) (Int.Neg (num.Bit1 m)) = drop_bit n (Int.Neg (Num.inc m))"
-  by (simp_all add: shiftr_eq_drop_bit drop_bit_Suc add_One)
+  by (simp_all add: drop_bit_Suc add_One)
 
 declare [[code drop: \<open>push_bit :: nat \<Rightarrow> int \<Rightarrow> int\<close>]]
 
 lemma push_bit_int_code [code]:
   "push_bit 0 i = i"
   "push_bit (Suc n) i = push_bit n (Int.dup i)"
   by (simp_all add: ac_simps)
 
 lemma int_lsb_code [code]:
   "lsb (0 :: int) = False"
   "lsb (Int.Pos num.One) = True"
   "lsb (Int.Pos (num.Bit0 w)) = False"
   "lsb (Int.Pos (num.Bit1 w)) = True"
   "lsb (Int.Neg num.One) = True"
   "lsb (Int.Neg (num.Bit0 w)) = False"
   "lsb (Int.Neg (num.Bit1 w)) = True"
   by simp_all
 
 end
diff --git a/thys/Native_Word/Code_Target_Word_Base.thy b/thys/Native_Word/Code_Target_Word_Base.thy
--- a/thys/Native_Word/Code_Target_Word_Base.thy
+++ b/thys/Native_Word/Code_Target_Word_Base.thy
@@ -1,394 +1,396 @@
 (*  Title:      Code_Target_Word_Base.thy
     Author:     Andreas Lochbihler, ETH Zurich
 *)
 
 chapter \<open>Common base for target language implementations of word types\<close>
 
 theory Code_Target_Word_Base imports
   "HOL-Library.Word"
   "Word_Lib.Signed_Division_Word"
+  (*"Word_Lib.Bit_Shifts_Infix_Syntax"*)
   Bits_Integer
 begin
 
 text \<open>More lemmas\<close>
 
 lemma div_half_nat:
   fixes x y :: nat
   assumes "y \<noteq> 0"
   shows "(x div y, x mod y) = (let q = 2 * (x div 2 div y); r = x - q * y in if y \<le> r then (q + 1, r - y) else (q, r))"
 proof -
   let ?q = "2 * (x div 2 div y)"
   have q: "?q = x div y - x div y mod 2"
     by(metis div_mult2_eq mult.commute minus_mod_eq_mult_div [symmetric])
   let ?r = "x - ?q * y"
   have r: "?r = x mod y + x div y mod 2 * y"
     by(simp add: q diff_mult_distrib minus_mod_eq_div_mult [symmetric])(metis diff_diff_cancel mod_less_eq_dividend mod_mult2_eq add.commute mult.commute)
 
   show ?thesis
   proof(cases "y \<le> x - ?q * y")
     case True
     with assms q have "x div y mod 2 \<noteq> 0" unfolding r
       by (metis Nat.add_0_right diff_0_eq_0 diff_Suc_1 le_div_geq mod2_gr_0 mod_div_trivial mult_0 neq0_conv numeral_1_eq_Suc_0 numerals(1)) 
     hence "x div y = ?q + 1" unfolding q
       by simp
     moreover hence "x mod y = ?r - y"
       by simp(metis minus_div_mult_eq_mod [symmetric] diff_commute diff_diff_left mult_Suc)
     ultimately show ?thesis using True by(simp add: Let_def)
   next
     case False
     hence "x div y mod 2 = 0" unfolding r
       by(simp add: not_le)(metis Nat.add_0_right assms div_less div_mult_self2 mod_div_trivial mult.commute)
     hence "x div y = ?q" unfolding q by simp
     moreover hence "x mod y = ?r" by (metis minus_div_mult_eq_mod [symmetric])
     ultimately show ?thesis using False by(simp add: Let_def)
   qed
 qed
 
 lemma div_half_word:
   fixes x y :: "'a :: len word"
   assumes "y \<noteq> 0"
-  shows "(x div y, x mod y) = (let q = (x >> 1) div y << 1; r = x - q * y in if y \<le> r then (q + 1, r - y) else (q, r))"
+  shows "(x div y, x mod y) = (let q = push_bit 1 (drop_bit 1 x div y); r = x - q * y in if y \<le> r then (q + 1, r - y) else (q, r))"
 proof -
   obtain n where n: "x = of_nat n" "n < 2 ^ LENGTH('a)"
     by (rule that [of \<open>unat x\<close>]) simp_all
   moreover obtain m where m: "y = of_nat m" "m < 2 ^ LENGTH('a)"
     by (rule that [of \<open>unat y\<close>]) simp_all
   ultimately have [simp]: \<open>unat (of_nat n :: 'a word) = n\<close> \<open>unat (of_nat m :: 'a word) = m\<close>
     by (transfer, simp add: take_bit_of_nat take_bit_nat_eq_self_iff)+
-  let ?q = "(x >> 1) div y << 1"
+  let ?q = "push_bit 1 (drop_bit 1 x div y)"
   let ?q' = "2 * (n div 2 div m)"
-  have "n div 2 div m < 2 ^ LENGTH('a)" using n by (metis of_nat_inverse unat_lt2p uno_simps(2))
+  have "n div 2 div m < 2 ^ LENGTH('a)"
+    using n by (metis of_nat_inverse unat_lt2p uno_simps(2))
   hence q: "?q = of_nat ?q'" using n m
-    by (auto simp add: shiftr_word_eq drop_bit_eq_div shiftl_t2n word_arith_nat_div uno_simps take_bit_nat_eq_self)
+    by (auto simp add: drop_bit_eq_div word_arith_nat_div uno_simps take_bit_nat_eq_self)
   from assms have "m \<noteq> 0" using m by -(rule notI, simp)
 
   from n have "2 * (n div 2 div m) < 2 ^ LENGTH('a)"
     by(metis mult.commute div_mult2_eq minus_mod_eq_mult_div [symmetric] less_imp_diff_less of_nat_inverse unat_lt2p uno_simps(2))
   moreover
   have "2 * (n div 2 div m) * m < 2 ^ LENGTH('a)" using n unfolding div_mult2_eq[symmetric]
     by(subst (2) mult.commute)(simp add: minus_mod_eq_div_mult [symmetric] diff_mult_distrib minus_mod_eq_mult_div [symmetric] div_mult2_eq)
   moreover have "2 * (n div 2 div m) * m \<le> n"
     by (simp flip: div_mult2_eq ac_simps)
   ultimately
   have r: "x - ?q * y = of_nat (n - ?q' * m)"
     and "y \<le> x - ?q * y \<Longrightarrow> of_nat (n - ?q' * m) - y = of_nat (n - ?q' * m - m)"
     using n m unfolding q
      apply (simp_all add: of_nat_diff)
     apply (subst of_nat_diff)
     apply (simp_all add: word_le_nat_alt take_bit_nat_eq_self unat_sub_if' unat_word_ariths)
     done
   then show ?thesis using n m div_half_nat [OF \<open>m \<noteq> 0\<close>, of n] unfolding q
     by (simp add: word_le_nat_alt word_div_def word_mod_def Let_def take_bit_nat_eq_self
       flip: zdiv_int zmod_int
       split del: if_split split: if_split_asm)
 qed
 
 lemma word_test_bit_set_bits: "bit (BITS n. f n :: 'a :: len word) n \<longleftrightarrow> n < LENGTH('a) \<and> f n"
   by (fact bit_set_bits_word_iff)
 
 lemma word_of_int_conv_set_bits: "word_of_int i = (BITS n. bit i n)"
   by (rule word_eqI) (auto simp add: word_test_bit_set_bits bit_simps)
 
 lemma word_and_mask_or_conv_and_mask:
-  "bit n index \<Longrightarrow> (n AND mask index) OR (1 << index) = n AND mask (index + 1)"
+  "bit n index \<Longrightarrow> (n AND mask index) OR (push_bit index 1) = n AND mask (index + 1)"
   for n :: \<open>'a::len word\<close>
 by(rule word_eqI)(auto simp add: bit_simps)
 
 lemma uint_and_mask_or_full:
   fixes n :: "'a :: len word"
   assumes "bit n (LENGTH('a) - 1)"
   and "mask1 = mask (LENGTH('a) - 1)"
-  and "mask2 = 1 << LENGTH('a) - 1"
+  and "mask2 = push_bit (LENGTH('a) - 1) 1"
   shows "uint (n AND mask1) OR mask2 = uint n"
 proof -
-  have "mask2 = uint (1 << LENGTH('a) - 1 :: 'a word)" using assms
-    by (simp add: uint_shiftl word_size bintrunc_shiftl del: shiftl_1)
-  hence "uint (n AND mask1) OR mask2 = uint (n AND mask1 OR (1 << LENGTH('a) - 1 :: 'a word))"
+  have "mask2 = uint (push_bit (LENGTH('a) - 1) 1 :: 'a word)" using assms
+    by (simp add: uint_shiftl word_size bintrunc_shiftl)
+  hence "uint (n AND mask1) OR mask2 = uint (n AND mask1 OR (push_bit (LENGTH('a) - 1) 1 :: 'a word))"
     by(simp add: uint_or)
   also have "\<dots> = uint (n AND mask (LENGTH('a) - 1 + 1))"
     using assms by(simp only: word_and_mask_or_conv_and_mask)
   also have "\<dots> = uint n" by simp
   finally show ?thesis .
 qed
 
 
 text \<open>Division on @{typ "'a word"} is unsigned, but Scala and OCaml only have signed division and modulus.\<close>
 
 lemmas word_sdiv_def = sdiv_word_def
 lemmas word_smod_def = smod_word_def
 
 lemma [code]:
   "x sdiv y =
    (let x' = sint x; y' = sint y;
         negative = (x' < 0) \<noteq> (y' < 0);
         result = abs x' div abs y'
     in word_of_int (if negative then -result else result))"
   for x y :: \<open>'a::len word\<close>
   by (simp add: sdiv_word_def signed_divide_int_def sgn_if Let_def not_less not_le)
 
 lemma [code]:
   "x smod y =
    (let x' = sint x; y' = sint y;
         negative = (x' < 0);
         result = abs x' mod abs y'
     in word_of_int (if negative then -result else result))"
   for x y :: \<open>'a::len word\<close>
 proof -
   have *: \<open>k mod l = k - k div l * l\<close> for k l :: int
     by (simp add: minus_div_mult_eq_mod)
   show ?thesis
     by (simp add: smod_word_def signed_modulo_int_def signed_divide_int_def * sgn_if Let_def)
 qed
 
 text \<open>
   This algorithm implements unsigned division in terms of signed division.
   Taken from Hacker's Delight.
 \<close>
 
 lemma divmod_via_sdivmod:
   fixes x y :: "'a :: len word"
   assumes "y \<noteq> 0"
   shows
   "(x div y, x mod y) =
-  (if 1 << (LENGTH('a) - 1) \<le> y then if x < y then (0, x) else (1, x - y)
-   else let q = ((x >> 1) sdiv y) << 1;
+  (if push_bit (LENGTH('a) - 1) 1 \<le> y then if x < y then (0, x) else (1, x - y)
+   else let q = (push_bit 1 (drop_bit 1 x sdiv y));
             r = x - q * y
         in if r \<ge> y then (q + 1, r - y) else (q, r))"
-proof(cases "1 << (LENGTH('a) - 1) \<le> y")
+proof(cases "push_bit (LENGTH('a) - 1) 1 \<le> y")
   case True
   note y = this
   show ?thesis
   proof(cases "x < y")
     case True
     then have "x mod y = x"
       by transfer simp
     thus ?thesis using True y by(simp add: word_div_lt_eq_0)
   next
     case False
     obtain n where n: "y = of_nat n" "n < 2 ^ LENGTH('a)"
       by (rule that [of \<open>unat y\<close>]) simp_all
     have "unat x < 2 ^ LENGTH('a)" by(rule unat_lt2p)
     also have "\<dots> = 2 * 2 ^ (LENGTH('a) - 1)"
       by(metis Suc_pred len_gt_0 power_Suc One_nat_def)
     also have "\<dots> \<le> 2 * n" using y n
       by transfer (simp add: push_bit_of_1 take_bit_eq_mod)
     finally have div: "x div of_nat n = 1" using False n
       by (simp add: word_div_eq_1_iff take_bit_nat_eq_self)
     moreover have "x mod y = x - x div y * y"
       by (simp add: minus_div_mult_eq_mod)
     with div n have "x mod y = x - y" by simp
     ultimately show ?thesis using False y n by simp
   qed
 next
   case False
   note y = this
   obtain n where n: "x = of_nat n" "n < 2 ^ LENGTH('a)"
     by (rule that [of \<open>unat x\<close>]) simp_all
   hence "int n div 2 + 2 ^ (LENGTH('a) - Suc 0) < 2 ^ LENGTH('a)"
     by (cases \<open>LENGTH('a)\<close>)
       (auto dest: less_imp_of_nat_less [where ?'a = int])
-  with y n have "sint (x >> 1) = uint (x >> 1)"
-    by (simp add: sint_uint sbintrunc_mod2p shiftr_div_2n take_bit_nat_eq_self)
+  with y n have "sint (drop_bit 1 x) = uint (drop_bit 1 x)"
+    by (simp add: sint_uint sbintrunc_mod2p drop_bit_eq_div take_bit_nat_eq_self uint_div_distrib)
   moreover have "uint y + 2 ^ (LENGTH('a) - Suc 0) < 2 ^ LENGTH('a)"
-    using y by (cases "LENGTH('a)")
-      (simp_all add: not_le word_2p_lem word_size)
+    using y by (cases \<open>LENGTH('a)\<close>)
+      (simp_all add: not_le push_bit_of_1 word_less_alt uint_power_lower)
   then have "sint y = uint y"
     by (simp add: sint_uint sbintrunc_mod2p)
   ultimately show ?thesis using y
     apply (subst div_half_word [OF assms])
     apply (simp add: sdiv_word_def signed_divide_int_def flip: uint_div)
     done
 qed
 
 
 text \<open>More implementations tailored towards target-language implementations\<close>
 
 context
 includes integer.lifting
 begin
 lift_definition word_of_integer :: "integer \<Rightarrow> 'a :: len word" is word_of_int .
 
 lemma word_of_integer_code [code]: "word_of_integer n = word_of_int (int_of_integer n)"
 by(simp add: word_of_integer.rep_eq)
 end
 
 lemma word_of_int_code:
   "uint (word_of_int x :: 'a word) = x AND mask (LENGTH('a :: len))"
   by (simp add: take_bit_eq_mask)
 
 context fixes f :: "nat \<Rightarrow> bool" begin
 
 definition set_bits_aux :: \<open>'a word \<Rightarrow> nat \<Rightarrow> 'a :: len word\<close>
   where \<open>set_bits_aux w n = push_bit n w OR take_bit n (set_bits f)\<close>
 
 lemma bit_set_bit_aux [bit_simps]:
   \<open>bit (set_bits_aux w n) m \<longleftrightarrow> m < LENGTH('a) \<and>
     (if m < n then f m else bit w (m - n))\<close> for w :: \<open>'a::len word\<close>
   by (auto simp add: bit_simps set_bits_aux_def)
 
 lemma set_bits_aux_conv:
-  \<open>set_bits_aux w n = (w << n) OR (set_bits f AND mask n)\<close>
+  \<open>set_bits_aux w n = (push_bit n w) OR (set_bits f AND mask n)\<close>
   for w :: \<open>'a::len word\<close>
   by (rule bit_word_eqI) (simp add: bit_simps)
 
 corollary set_bits_conv_set_bits_aux:
   \<open>set_bits f = (set_bits_aux 0 (LENGTH('a)) :: 'a :: len word)\<close>
   by (simp add: set_bits_aux_conv)
 
 lemma set_bits_aux_0 [simp]:
   \<open>set_bits_aux w 0 = w\<close>
   by (simp add: set_bits_aux_conv)
 
 lemma set_bits_aux_Suc [simp]:
-  \<open>set_bits_aux w (Suc n) = set_bits_aux ((w << 1) OR (if f n then 1 else 0)) n\<close>
-  by (rule bit_word_eqI) (auto simp add: bit_simps not_less le_less_Suc_eq)
+  \<open>set_bits_aux w (Suc n) = set_bits_aux (push_bit 1 w OR (if f n then 1 else 0)) n\<close>
+  by (rule bit_word_eqI) (auto simp add: bit_simps not_less le_less_Suc_eq mult.commute [of _ 2])
 
 lemma set_bits_aux_simps [code]:
   \<open>set_bits_aux w 0 = w\<close>
-  \<open>set_bits_aux w (Suc n) = set_bits_aux ((w << 1) OR (if f n then 1 else 0)) n\<close>
+  \<open>set_bits_aux w (Suc n) = set_bits_aux (push_bit 1 w OR (if f n then 1 else 0)) n\<close>
   by simp_all
 
 end
 
 lemma word_of_int_via_signed:
   fixes mask
   assumes mask_def: "mask = Bit_Operations.mask (LENGTH('a))"
-  and shift_def: "shift = 1 << LENGTH('a)"
+  and shift_def: "shift = push_bit LENGTH('a) 1"
   and index_def: "index = LENGTH('a) - 1"
-  and overflow_def:"overflow = 1 << (LENGTH('a) - 1)"
+  and overflow_def:"overflow = push_bit (LENGTH('a) - 1) 1"
   and least_def: "least = - overflow"
   shows
   "(word_of_int i :: 'a :: len word) =
    (let i' = i AND mask
     in if bit i' index then
          if i' - shift < least \<or> overflow \<le> i' - shift then arbitrary1 i' else word_of_int (i' - shift)
        else if i' < least \<or> overflow \<le> i' then arbitrary2 i' else word_of_int i')"
 proof -
   define i' where "i' = i AND mask"
   have "shift = mask + 1" unfolding assms by(simp add: bin_mask_p1_conv_shift)
   hence "i' < shift" by(simp add: mask_def i'_def int_and_le)
   show ?thesis
   proof(cases "bit i' index")
     case True
     then have unf: "i' = overflow OR i'"
-      apply (simp add: assms i'_def shiftl_eq_push_bit push_bit_of_1 flip: take_bit_eq_mask)
+      apply (simp add: assms i'_def push_bit_of_1 flip: take_bit_eq_mask)
       apply (rule bit_eqI)
       apply (auto simp add: bit_take_bit_iff bit_or_iff bit_exp_iff)
       done
     have "overflow \<le> i'" by(subst unf)(rule le_int_or, simp add: bin_sign_and assms i'_def)
     hence "i' - shift < least \<longleftrightarrow> False" unfolding assms
-      by(cases "LENGTH('a)")(simp_all add: not_less)
+      by(cases "LENGTH('a)")(simp_all add: not_less push_bit_of_1)
     moreover
     have "overflow \<le> i' - shift \<longleftrightarrow> False" using \<open>i' < shift\<close> unfolding assms
-      by(cases "LENGTH('a)")(auto simp add: not_le elim: less_le_trans)
+      by(cases "LENGTH('a)")(auto simp add: not_le push_bit_of_1 elim: less_le_trans)
     moreover
     have "word_of_int (i' - shift) = (word_of_int i :: 'a word)" using \<open>i' < shift\<close>
-      by (simp add: i'_def shift_def mask_def shiftl_eq_push_bit push_bit_of_1 word_of_int_eq_iff flip: take_bit_eq_mask)
+      by (simp add: i'_def shift_def mask_def push_bit_of_1 word_of_int_eq_iff flip: take_bit_eq_mask)
     ultimately show ?thesis using True by(simp add: Let_def i'_def)
   next
     case False
     hence "i' = i AND Bit_Operations.mask (LENGTH('a) - 1)" unfolding assms i'_def
-      by(clarsimp simp add: i'_def bin_nth_ops intro!: bin_eqI)(cases "LENGTH('a)", auto simp add: less_Suc_eq)
+      by(clarsimp simp add: i'_def bit_simps intro!: bin_eqI)(cases "LENGTH('a)", auto simp add: less_Suc_eq)
     also have "\<dots> \<le> Bit_Operations.mask (LENGTH('a) - 1)" by(rule int_and_le) simp
     also have "\<dots> < overflow" unfolding overflow_def
       by(simp add: bin_mask_p1_conv_shift[symmetric])
     also
     have "least \<le> 0" unfolding least_def overflow_def by simp
     have "0 \<le> i'" by (simp add: i'_def mask_def)
     hence "least \<le> i'" using \<open>least \<le> 0\<close> by simp
     moreover
     have "word_of_int i' = (word_of_int i :: 'a word)"
       by (simp add: i'_def mask_def of_int_and_eq of_int_mask_eq)
     ultimately show ?thesis using False by(simp add: Let_def i'_def)
   qed
 qed
 
 
 
 text \<open>Quickcheck conversion functions\<close>
 
 context
   includes state_combinator_syntax
 begin
 
 definition qc_random_cnv ::
   "(natural \<Rightarrow> 'a::term_of) \<Rightarrow> natural \<Rightarrow> Random.seed
     \<Rightarrow> ('a \<times> (unit \<Rightarrow> Code_Evaluation.term)) \<times> Random.seed"
   where "qc_random_cnv a_of_natural i = Random.range (i + 1) \<circ>\<rightarrow> (\<lambda>k. Pair (
        let n = a_of_natural k
        in (n, \<lambda>_. Code_Evaluation.term_of n)))"
 
 end
 
 definition qc_exhaustive_cnv :: "(natural \<Rightarrow> 'a) \<Rightarrow> ('a \<Rightarrow> (bool \<times> term list) option)
   \<Rightarrow> natural \<Rightarrow> (bool \<times> term list) option"
 where
   "qc_exhaustive_cnv a_of_natural f d =
    Quickcheck_Exhaustive.exhaustive (%x. f (a_of_natural x)) d"
 
 definition qc_full_exhaustive_cnv ::
   "(natural \<Rightarrow> ('a::term_of)) \<Rightarrow> ('a \<times> (unit \<Rightarrow> term) \<Rightarrow> (bool \<times> term list) option)
   \<Rightarrow> natural \<Rightarrow> (bool \<times> term list) option"
 where
   "qc_full_exhaustive_cnv a_of_natural f d = Quickcheck_Exhaustive.full_exhaustive
   (%(x, xt). f (a_of_natural x, %_. Code_Evaluation.term_of (a_of_natural x))) d"
 
 declare [[quickcheck_narrowing_ghc_options = "-XTypeSynonymInstances"]]
 
 definition qc_narrowing_drawn_from :: "'a list \<Rightarrow> integer \<Rightarrow> _"
 where
   "qc_narrowing_drawn_from xs =
    foldr Quickcheck_Narrowing.sum (map Quickcheck_Narrowing.cons (butlast xs)) (Quickcheck_Narrowing.cons (last xs))"
 
 locale quickcheck_narrowing_samples =
   fixes a_of_integer :: "integer \<Rightarrow> 'a \<times> 'a :: {partial_term_of, term_of}"
   and zero :: "'a"
   and tr :: "typerep"
 begin
 
 function narrowing_samples :: "integer \<Rightarrow> 'a list"
 where
   "narrowing_samples i =
    (if i > 0 then let (a, a') = a_of_integer i in narrowing_samples (i - 1) @ [a, a'] else [zero])"
 by pat_completeness auto
 termination including integer.lifting
 proof(relation "measure nat_of_integer")
   fix i :: integer
   assume "0 < i"
   thus "(i - 1, i) \<in> measure nat_of_integer"
     by simp(transfer, simp)
 qed simp
 
 definition partial_term_of_sample :: "integer \<Rightarrow> 'a"
 where
   "partial_term_of_sample i =
   (if i < 0 then undefined
    else if i = 0 then zero
    else if i mod 2 = 0 then snd (a_of_integer (i div 2))
    else fst (a_of_integer (i div 2 + 1)))"
 
 lemma partial_term_of_code:
   "partial_term_of (ty :: 'a itself) (Quickcheck_Narrowing.Narrowing_variable p t) \<equiv>
     Code_Evaluation.Free (STR ''_'') tr"
   "partial_term_of (ty :: 'a itself) (Quickcheck_Narrowing.Narrowing_constructor i []) \<equiv>
    Code_Evaluation.term_of (partial_term_of_sample i)"
 by (rule partial_term_of_anything)+
 
 end
 
 lemmas [code] =
   quickcheck_narrowing_samples.narrowing_samples.simps
   quickcheck_narrowing_samples.partial_term_of_sample_def
 
 
 text \<open>
   The separate code target \<open>SML_word\<close> collects setups for the
   code generator that PolyML does not provide.
 \<close>
 
 setup \<open>Code_Target.add_derived_target ("SML_word", [(Code_ML.target_SML, I)])\<close>
 
 code_identifier code_module Code_Target_Word_Base \<rightharpoonup>
   (SML) Word and (Haskell) Word and (OCaml) Word and (Scala) Word
 
 end
diff --git a/thys/Native_Word/Native_Word_Test.thy b/thys/Native_Word/Native_Word_Test.thy
--- a/thys/Native_Word/Native_Word_Test.thy
+++ b/thys/Native_Word/Native_Word_Test.thy
@@ -1,485 +1,485 @@
 (*  Title:      Native_Word_Test.thy
     Author:     Andreas Lochbihler, ETH Zurich
 *)
 
 chapter \<open>Test cases\<close>
 
 theory Native_Word_Test imports
   Uint64 Uint32 Uint16 Uint8 Uint Native_Cast_Uint
-  "HOL-Library.Code_Test"
+  "HOL-Library.Code_Test" "Word_Lib.Bit_Shifts_Infix_Syntax"
 begin
 
 section \<open>Tests for @{typ uint32}\<close>
 
 notation sshiftr_uint32 (infixl ">>>" 55)
 
 definition test_uint32 where
   "test_uint32 \<longleftrightarrow>
   (([ 0x100000001, -1, -4294967291, 0xFFFFFFFF, 0x12345678
     , 0x5A AND 0x36
     , 0x5A OR 0x36
     , 0x5A XOR 0x36
     , NOT 0x5A
     , 5 + 6, -5 + 6, -6 + 5, -5 + (- 6), 0xFFFFFFFFF + 1
     , 5 - 3, 3 - 5
     , 5 * 3, -5 * 3, -5 * -4, 0x12345678 * 0x87654321
     , 5 div 3, -5 div 3, -5 div -3, 5 div -3
     , 5 mod 3, -5 mod 3, -5 mod -3, 5 mod -3
     , set_bit 5 4 True, set_bit (- 5) 2 True, set_bit 5 0 False, set_bit (- 5) 1 False
     , set_bit 5 32 True, set_bit 5 32 False, set_bit (- 5) 32 True, set_bit (- 5) 32 False
     , 1 << 2, -1 << 3, 1 << 32, 1 << 0
     , 100 >> 3, -100 >> 3, 100 >> 32, -100 >> 32
     , 100 >>> 3, -100 >>> 3, 100 >>> 32, -100 >>> 32] :: uint32 list)
    =
     [ 1, 4294967295, 5, 4294967295, 305419896
     , 18
     , 126
     , 108
     , 4294967205
     , 11, 1, 4294967295, 4294967285, 0
     , 2, 4294967294
     , 15, 4294967281, 20, 1891143032
     , 1, 1431655763, 0, 0
     , 2, 2, 4294967291, 5 
     , 21, 4294967295, 4, 4294967289
     , 5, 5, 4294967291, 4294967291
     , 4, 4294967288, 0, 1
     , 12, 536870899, 0, 0
     , 12, 4294967283, 0, 4294967295]) \<and>
   ([ (0x5 :: uint32) = 0x5, (0x5 :: uint32) = 0x6
    , (0x5 :: uint32) < 0x5, (0x5 :: uint32) < 0x6, (-5 :: uint32) < 6, (6 :: uint32) < -5
    , (0x5 :: uint32) \<le> 0x5, (0x5 :: uint32) \<le> 0x4, (-5 :: uint32) \<le> 6, (6 :: uint32) \<le> -5 
    , (0x7FFFFFFF :: uint32) < 0x80000000, (0xFFFFFFFF :: uint32) < 0, (0x80000000 :: uint32) < 0x7FFFFFFF
    , bit (0x7FFFFFFF :: uint32) 0, bit (0x7FFFFFFF :: uint32) 31, bit (0x80000000 :: uint32) 31, bit (0x80000000 :: uint32) 32
    ]
   =
    [ True, False
    , False, True, False, True
    , True, False, False, True
    , True, False, False
    , True, False, True, False
    ]) \<and>
   ([integer_of_uint32 0, integer_of_uint32 0x7FFFFFFF, integer_of_uint32 0x80000000, integer_of_uint32 0xAAAAAAAA]
   =
    [0, 0x7FFFFFFF, 0x80000000, 0xAAAAAAAA])"
 
 no_notation sshiftr_uint32 (infixl ">>>" 55)
 
 export_code test_uint32 checking SML Haskell? OCaml? Scala
 
 notepad begin
 have test_uint32 by eval
 have test_uint32 by code_simp
 have test_uint32 by normalization
 end
 
 definition test_uint32' :: uint32 
 where "test_uint32' = 0 + 10 - 14 * 3 div 6 mod 3 << 3 >> 2"
 ML \<open>val 0wx12 = @{code test_uint32'}\<close>
 
 lemma "x AND y = x OR (y :: uint32)"
 quickcheck[random, expect=counterexample]
 quickcheck[exhaustive, expect=counterexample]
 oops
 
 lemma "(x :: uint32) AND x = x OR x"
 quickcheck[narrowing, expect=no_counterexample]
 by transfer simp
 
 lemma "(f :: uint32 \<Rightarrow> unit) = g"
 quickcheck[narrowing, size=3, expect=no_counterexample]
 by(simp add: fun_eq_iff)
 
 section \<open>Tests for @{typ uint16}\<close>
 
 notation sshiftr_uint16 (infixl ">>>" 55)
 
 definition test_uint16 where
   "test_uint16 \<longleftrightarrow>
   (([ 0x10001, -1, -65535, 0xFFFF, 0x1234
     , 0x5A AND 0x36
     , 0x5A OR 0x36
     , 0x5A XOR 0x36
     , NOT 0x5A
     , 5 + 6, -5 + 6, -6 + 5, -5 + -6, 0xFFFF + 1
     , 5 - 3, 3 - 5
     , 5 * 3, -5 * 3, -5 * -4, 0x1234 * 0x8765
     , 5 div 3, -5 div 3, -5 div -3, 5 div -3
     , 5 mod 3, -5 mod 3, -5 mod -3, 5 mod -3
     , set_bit 5 4 True, set_bit (- 5) 2 True, set_bit 5 0 False, set_bit (- 5) 1 False
     , set_bit 5 32 True, set_bit 5 32 False, set_bit (- 5) 32 True, set_bit (- 5) 32 False
     , 1 << 2, -1 << 3, 1 << 16, 1 << 0
     , 100 >> 3, -100 >> 3, 100 >> 16, -100 >> 16
     , 100 >>> 3, -100 >>> 3, 100 >>> 16, -100 >>> 16] :: uint16 list)
    =
     [ 1, 65535, 1, 65535, 4660
     , 18
     , 126
     , 108
     , 65445
     , 11, 1, 65535, 65525, 0
     , 2, 65534
     , 15, 65521, 20, 39556
     , 1, 21843, 0, 0
     , 2, 2, 65531, 5
     , 21, 65535, 4, 65529
     , 5, 5, 65531, 65531
     , 4, 65528, 0, 1
     , 12, 8179, 0, 0
     , 12, 65523, 0, 65535]) \<and>
   ([ (0x5 :: uint16) = 0x5, (0x5 :: uint16) = 0x6
    , (0x5 :: uint16) < 0x5, (0x5 :: uint16) < 0x6, (-5 :: uint16) < 6, (6 :: uint16) < -5
    , (0x5 :: uint16) \<le> 0x5, (0x5 :: uint16) \<le> 0x4, (-5 :: uint16) \<le> 6, (6 :: uint16) \<le> -5 
    , (0x7FFF :: uint16) < 0x8000, (0xFFFF :: uint16) < 0, (0x8000 :: uint16) < 0x7FFF
    , bit (0x7FFF :: uint16) 0, bit (0x7FFF :: uint16) 15, bit (0x8000 :: uint16) 15, bit (0x8000 :: uint16) 16
    ]
   =
    [ True, False
    , False, True, False, True
    , True, False, False, True
    , True, False, False
    , True, False, True, False
    ]) \<and>
   ([integer_of_uint16 0, integer_of_uint16 0x7FFF, integer_of_uint16 0x8000, integer_of_uint16 0xAAAA]
   =
    [0, 0x7FFF, 0x8000, 0xAAAA])"
 
 no_notation sshiftr_uint16 (infixl ">>>" 55)
 
 export_code test_uint16 checking Haskell? Scala
 export_code test_uint16 in SML_word
 
 notepad begin
 have test_uint16 by code_simp
 have test_uint16 by normalization
 end
 
 lemma "(x :: uint16) AND x = x OR x"
 quickcheck[narrowing, expect=no_counterexample]
 by transfer simp
 
 lemma "(f :: uint16 \<Rightarrow> unit) = g"
 quickcheck[narrowing, size=3, expect=no_counterexample]
 by(simp add: fun_eq_iff)
 
 section \<open>Tests for @{typ uint8}\<close>
 
 notation sshiftr_uint8 (infixl ">>>" 55)
 
 definition test_uint8 where
   "test_uint8 \<longleftrightarrow> 
   (([ 0x101, -1, -255, 0xFF, 0x12
     , 0x5A AND 0x36
     , 0x5A OR 0x36
     , 0x5A XOR 0x36
     , NOT 0x5A
     , 5 + 6, -5 + 6, -6 + 5, -5 + -6, 0xFF + 1
     , 5 - 3, 3 - 5
     , 5 * 3, -5 * 3, -5 * -4, 0x12 * 0x87
     , 5 div 3, -5 div 3, -5 div -3, 5 div -3
     , 5 mod 3, -5 mod 3, -5 mod -3, 5 mod -3
     , set_bit 5 4 True, set_bit (- 5) 2 True, set_bit 5 0 False, set_bit (- 5) 1 False
     , set_bit 5 32 True, set_bit 5 32 False, set_bit (- 5) 32 True, set_bit (- 5) 32 False
     , 1 << 2, -1 << 3, 1 << 8, 1 << 0
     , 100 >> 3, -100 >> 3, 100 >> 8, -100 >> 8
     , 100 >>> 3, -100 >>> 3, 100 >>> 8, -100 >>> 8] :: uint8 list)
    =
     [ 1, 255, 1, 255, 18
     , 18
     , 126
     , 108
     , 165
     , 11, 1, 255, 245, 0
     , 2, 254
     , 15, 241, 20, 126
     , 1, 83, 0, 0
     , 2, 2, 251, 5
     , 21, 255, 4, 249
     , 5, 5, 251, 251
     , 4, 248, 0, 1
     , 12, 19, 0, 0
     , 12, 243, 0, 255]) \<and>
   ([ (0x5 :: uint8) = 0x5, (0x5 :: uint8) = 0x6
    , (0x5 :: uint8) < 0x5, (0x5 :: uint8) < 0x6, (-5 :: uint8) < 6, (6 :: uint8) < -5
    , (0x5 :: uint8) \<le> 0x5, (0x5 :: uint8) \<le> 0x4, (-5 :: uint8) \<le> 6, (6 :: uint8) \<le> -5 
    , (0x7F :: uint8) < 0x80, (0xFF :: uint8) < 0, (0x80 :: uint8) < 0x7F
    , bit (0x7F :: uint8) 0, bit (0x7F :: uint8) 7, bit (0x80 :: uint8) 7, bit (0x80 :: uint8) 8
    ]
   =
    [ True, False
    , False, True, False, True
    , True, False, False, True
    , True, False, False
    , True, False, True, False
    ]) \<and>
   ([integer_of_uint8 0, integer_of_uint8 0x7F, integer_of_uint8 0x80, integer_of_uint8 0xAA]
   =
    [0, 0x7F, 0x80, 0xAA])"
 
 no_notation sshiftr_uint8 (infixl ">>>" 55)
 
 export_code test_uint8 checking SML Haskell? Scala
 
 export_code test_uint8 in SML
 
 notepad begin
 have test_uint8 by eval
 have test_uint8 by code_simp
 have test_uint8 by normalization
 end
 ML_val \<open>val true = @{code test_uint8}\<close>
 
 definition test_uint8' :: uint8
 where "test_uint8' = 0 + 10 - 14 * 3 div 6 mod 3 << 3 >> 2"
 ML \<open>val 0wx12 = @{code test_uint8'}\<close>
 
 lemma "x AND y = x OR (y :: uint8)"
 quickcheck[random, expect=counterexample]
 quickcheck[exhaustive, expect=counterexample]
 oops
 
 lemma "(x :: uint8) AND x = x OR x"
 quickcheck[narrowing, expect=no_counterexample]
 by transfer simp
 
 lemma "(f :: uint8 \<Rightarrow> unit) = g"
 quickcheck[narrowing, size=3, expect=no_counterexample]
 by(simp add: fun_eq_iff)
 
 section \<open>Tests for @{typ "uint"}\<close>
 
 notation sshiftr_uint (infixl ">>>" 55)
 
 definition "test_uint \<equiv> let 
   test_list1 = (let
       HS = uint_of_int (2 ^ (dflt_size - 1))
     in
       ([ HS + HS + 1, -1, -HS - HS + 5, HS + (HS - 1), 0x12
       , 0x5A AND 0x36
       , 0x5A OR 0x36
       , 0x5A XOR 0x36
       , NOT 0x5A
       , 5 + 6, -5 + 6, -6 + 5, -5 + -6, HS + (HS - 1) + 1
       , 5 - 3, 3 - 5
       , 5 * 3, -5 * 3, -5 * -4, 0x12345678 * 0x87654321]
     @ (if dflt_size > 4 then
       [ 5 div 3, -5 div 3, -5 div -3, 5 div -3
       , 5 mod 3, -5 mod 3, -5 mod -3, 5 mod -3
       , set_bit 5 4 True, set_bit (- 5) 2 True, set_bit 5 0 False, set_bit (- 5) 1 False
       , set_bit 5 dflt_size True, set_bit 5 dflt_size False, set_bit (- 5) dflt_size True, set_bit (- 5) dflt_size False
-      , 1 << 2, -1 << 3, 1 << dflt_size, 1 << 0
+      , 1 << 2, -1 << 3, push_bit dflt_size 1, 1 << 0
       , 31 >> 3, -1 >> 3, 31 >> dflt_size, -1 >> dflt_size
       , 15 >>> 2, -1 >>> 3, 15 >>> dflt_size, -1 >>> dflt_size]
     else []) :: uint list));
   
   test_list2 = (let 
       S = wivs_shift 
     in 
       ([ 1, -1, -S + 5, S - 1, 0x12
       , 0x5A AND 0x36
       , 0x5A OR 0x36
       , 0x5A XOR 0x36
       , NOT 0x5A
       , 5 + 6, -5 + 6, -6 + 5, -5 + -6, 0
       , 5 - 3, 3 - 5
       , 5 * 3, -5 * 3, -5 * -4, 0x12345678 * 0x87654321]
     @ (if dflt_size > 4 then
       [ 5 div 3, (S - 5) div 3, (S - 5) div (S - 3), 5 div (S - 3)
       , 5 mod 3, (S - 5) mod 3, (S - 5) mod (S - 3), 5 mod (S - 3)
       , set_bit 5 4 True, -1, set_bit 5 0 False, -7
       , 5, 5, -5, -5
       , 4, -8, 0, 1
       , 3, (S >> 3) - 1, 0, 0
       , 3, (S >> 1) + (S >> 1) - 1, 0, -1] 
     else []) :: int list));
 
   test_list_c1 = (let
       HS = uint_of_int ((2^(dflt_size - 1)))
     in
   [  (0x5 :: uint) = 0x5, (0x5 :: uint) = 0x6
    , (0x5 :: uint) < 0x5, (0x5 :: uint) < 0x6, (-5 :: uint) < 6, (6 :: uint) < -5
    , (0x5 :: uint) \<le> 0x5, (0x5 :: uint) \<le> 0x4, (-5 :: uint) \<le> 6, (6 :: uint) \<le> -5 
    , (HS - 1) < HS, (HS + HS - 1) < 0, HS < HS - 1
    , bit (HS - 1) 0, bit (HS - 1 :: uint) (dflt_size - 1), bit (HS :: uint) (dflt_size - 1), bit (HS :: uint) dflt_size
    ]);
 
   test_list_c2 =
    [ True, False
    , False, dflt_size\<ge>2, dflt_size=3, dflt_size\<noteq>3
    , True, False, dflt_size=3, dflt_size\<noteq>3
    , True, False, False
    , dflt_size\<noteq>1, False, True, False
    ]
 in
   test_list1 = map uint_of_int test_list2
 \<and> test_list_c1 = test_list_c2"
 
 no_notation sshiftr_uint (infixl ">>>" 55)
 
 export_code test_uint checking SML Haskell? OCaml? Scala
 
 lemma "test_uint"
 quickcheck[exhaustive, expect=no_counterexample]
 oops \<comment> \<open>FIXME: prove correctness of test by reflective means (not yet supported)\<close>
 
 lemma "x AND y = x OR (y :: uint)"
 quickcheck[random, expect=counterexample]
 quickcheck[exhaustive, expect=counterexample]
 oops
 
 lemma "(x :: uint) AND x = x OR x"
 quickcheck[narrowing, expect=no_counterexample]
 by transfer simp
 
 lemma "(f :: uint \<Rightarrow> unit) = g"
 quickcheck[narrowing, size=3, expect=no_counterexample]
 by(simp add: fun_eq_iff)
 
 section \<open> Tests for @{typ uint64} \<close>
 
 notation sshiftr_uint64 (infixl ">>>" 55)
 
 definition test_uint64 where
   "test_uint64 \<longleftrightarrow>
   (([ 0x10000000000000001, -1, -9223372036854775808, 0xFFFFFFFFFFFFFFFF, 0x1234567890ABCDEF
     , 0x5A AND 0x36
     , 0x5A OR 0x36
     , 0x5A XOR 0x36
     , NOT 0x5A
     , 5 + 6, -5 + 6, -6 + 5, -5 + (- 6), 0xFFFFFFFFFFFFFFFFFF + 1
     , 5 - 3, 3 - 5
     , 5 * 3, -5 * 3, -5 * -4, 0x1234567890ABCDEF * 0xFEDCBA0987654321
     , 5 div 3, -5 div 3, -5 div -3, 5 div -3
     , 5 mod 3, -5 mod 3, -5 mod -3, 5 mod -3
     , set_bit 5 4 True, set_bit (- 5) 2 True, set_bit 5 0 False, set_bit (- 5) 1 False
     , set_bit 5 64 True, set_bit 5 64 False, set_bit (- 5) 64 True, set_bit (- 5) 64 False
     , 1 << 2, -1 << 3, 1 << 64, 1 << 0
     , 100 >> 3, -100 >> 3, 100 >> 64, -100 >> 64
     , 100 >>> 3, -100 >>> 3, 100 >>> 64, -100 >>> 64] :: uint64 list)
    =
     [ 1, 18446744073709551615, 9223372036854775808, 18446744073709551615, 1311768467294899695
     , 18
     , 126
     , 108
     , 18446744073709551525
     , 11, 1, 18446744073709551615, 18446744073709551605, 0
     , 2, 18446744073709551614
     , 15, 18446744073709551601, 20, 14000077364136384719
     , 1, 6148914691236517203, 0, 0
     , 2, 2, 18446744073709551611, 5 
     , 21, 18446744073709551615, 4, 18446744073709551609
     , 5, 5, 18446744073709551611, 18446744073709551611
     , 4, 18446744073709551608, 0, 1
     , 12, 2305843009213693939, 0, 0
     , 12, 18446744073709551603, 0, 18446744073709551615]) \<and>
   ([ (0x5 :: uint64) = 0x5, (0x5 :: uint64) = 0x6
    , (0x5 :: uint64) < 0x5, (0x5 :: uint64) < 0x6, (-5 :: uint64) < 6, (6 :: uint64) < -5
    , (0x5 :: uint64) \<le> 0x5, (0x5 :: uint64) \<le> 0x4, (-5 :: uint64) \<le> 6, (6 :: uint64) \<le> -5 
    , (0x7FFFFFFFFFFFFFFF :: uint64) < 0x8000000000000000, (0xFFFFFFFFFFFFFFFF :: uint64) < 0, (0x8000000000000000 :: uint64) < 0x7FFFFFFFFFFFFFFF
    , bit (0x7FFFFFFFFFFFFFFF :: uint64) 0, bit (0x7FFFFFFFFFFFFFFF :: uint64) 63, bit (0x8000000000000000 :: uint64) 63, bit (0x8000000000000000 :: uint64) 64
    ]
   =
    [ True, False
    , False, True, False, True
    , True, False, False, True
    , True, False, False
    , True, False, True, False
    ]) \<and>
   ([integer_of_uint64 0, integer_of_uint64 0x7FFFFFFFFFFFFFFF, integer_of_uint64 0x8000000000000000, integer_of_uint64 0xAAAAAAAAAAAAAAAA]
   =
    [0, 0x7FFFFFFFFFFFFFFF, 0x8000000000000000, 0xAAAAAAAAAAAAAAAA])"
 
 value [nbe] "[0x10000000000000001, -1, -9223372036854775808, 0xFFFFFFFFFFFFFFFF, 0x1234567890ABCDEF
     , 0x5A AND 0x36
     , 0x5A OR 0x36
     , 0x5A XOR 0x36
     , NOT 0x5A
     , 5 + 6, -5 + 6, -6 + 5, -5 + (- 6), 0xFFFFFFFFFFFFFFFFFF + 1
     , 5 - 3, 3 - 5
     , 5 * 3, -5 * 3, -5 * -4, 0x1234567890ABCDEF * 0xFEDCBA0987654321
     , 5 div 3, -5 div 3, -5 div -3, 5 div -3
     , 5 mod 3, -5 mod 3, -5 mod -3, 5 mod -3
     , set_bit 5 4 True, set_bit (- 5) 2 True, set_bit 5 0 False, set_bit (- 5) 1 False
     , set_bit 5 64 True, set_bit 5 64 False, set_bit (- 5) 64 True, set_bit (- 5) 64 False
     , 1 << 2, -1 << 3, 1 << 64, 1 << 0
     , 100 >> 3, -100 >> 3, 100 >> 64, -100 >> 64
     , 100 >>> 3, -100 >>> 3, 100 >>> 64, -100 >>> 64] :: uint64 list"
 
 no_notation sshiftr_uint64 (infixl ">>>" 55)
 
 export_code test_uint64 checking SML Haskell? OCaml? Scala
 
 notepad begin
 have test_uint64 by eval
 have test_uint64 by code_simp
 have test_uint64 by normalization
 end
 ML_val \<open>val true = @{code test_uint64}\<close>
 
 definition test_uint64' :: uint64
 where "test_uint64' = 0 + 10 - 14 * 3 div 6 mod 3 << 3 >> 2"
 
 section \<open>Tests for casts\<close>
 
 definition test_casts :: bool
 where "test_casts \<longleftrightarrow>
   map uint8_of_uint32 [10, 0, 0xFE, 0xFFFFFFFF] = [10, 0, 0xFE, 0xFF] \<and>
   map uint8_of_uint64 [10, 0, 0xFE, 0xFFFFFFFFFFFFFFFF] = [10, 0, 0xFE, 0xFF] \<and>
   map uint32_of_uint8 [10, 0, 0xFF] = [10, 0, 0xFF] \<and>
   map uint64_of_uint8 [10, 0, 0xFF] = [10, 0, 0xFF]"
 
 definition test_casts' :: bool
 where "test_casts' \<longleftrightarrow>
   map uint8_of_uint16 [10, 0, 0xFE, 0xFFFF] = [10, 0, 0xFE, 0xFF] \<and>
   map uint16_of_uint8 [10, 0, 0xFF] = [10, 0, 0xFF] \<and>
   map uint16_of_uint32 [10, 0, 0xFFFE, 0xFFFFFFFF] = [10, 0, 0xFFFE, 0xFFFF] \<and>
   map uint16_of_uint64 [10, 0, 0xFFFE, 0xFFFFFFFFFFFFFFFF] = [10, 0, 0xFFFE, 0xFFFF] \<and>
   map uint32_of_uint16 [10, 0, 0xFFFF] = [10, 0, 0xFFFF] \<and>
   map uint64_of_uint16 [10, 0, 0xFFFF] = [10, 0, 0xFFFF]"
 
 definition test_casts'' :: bool
 where "test_casts'' \<longleftrightarrow>
   map uint32_of_uint64 [10, 0, 0xFFFFFFFE, 0xFFFFFFFFFFFFFFFF] = [10, 0, 0xFFFFFFFE, 0xFFFFFFFF] \<and>
   map uint64_of_uint32 [10, 0, 0xFFFFFFFF] = [10, 0, 0xFFFFFFFF]"
 
 export_code test_casts test_casts'' checking SML Haskell? Scala
 export_code test_casts'' checking OCaml?
 export_code test_casts' checking Haskell? Scala
 
 notepad begin
   have test_casts by eval
   have test_casts by normalization
   have test_casts by code_simp
   have test_casts' by normalization
   have test_casts' by code_simp
   have test_casts'' by eval
   have test_casts'' by normalization
   have test_casts'' by code_simp
 end
 ML \<open>
   val true = @{code test_casts}
   val true = @{code test_casts''}
 \<close>
 
 definition test_casts_uint :: bool where
   "test_casts_uint \<longleftrightarrow>
-  map uint_of_uint32 ([0, 10] @ (if dflt_size < 32 then [1 << (dflt_size - 1), 0xFFFFFFFF] else [0xFFFFFFFF])) = 
-  [0, 10] @ (if dflt_size < 32 then [1 << (dflt_size - 1), (1 << dflt_size) - 1] else [0xFFFFFFFF]) \<and>
-  map uint32_of_uint [0, 10, if dflt_size < 32 then 1 << (dflt_size - 1) else 0xFFFFFFFF] =
-  [0, 10, if dflt_size < 32 then 1 << (dflt_size - 1) else 0xFFFFFFFF] \<and>
-  map uint_of_uint64 [0, 10, 1 << (dflt_size - 1), 0xFFFFFFFFFFFFFFFF] =
-  [0, 10, 1 << (dflt_size - 1), (1 << dflt_size) - 1] \<and>
-  map uint64_of_uint [0, 10, 1 << (dflt_size - 1)] =
-  [0, 10, 1 << (dflt_size - 1)]"
+  map uint_of_uint32 ([0, 10] @ (if dflt_size < 32 then [push_bit (dflt_size - 1) 1, 0xFFFFFFFF] else [0xFFFFFFFF])) = 
+  [0, 10] @ (if dflt_size < 32 then [push_bit (dflt_size - 1) 1, (push_bit dflt_size 1) - 1] else [0xFFFFFFFF]) \<and>
+  map uint32_of_uint [0, 10, if dflt_size < 32 then push_bit (dflt_size - 1) 1 else 0xFFFFFFFF] =
+  [0, 10, if dflt_size < 32 then push_bit (dflt_size - 1) 1 else 0xFFFFFFFF] \<and>
+  map uint_of_uint64 [0, 10, push_bit (dflt_size - 1) 1, 0xFFFFFFFFFFFFFFFF] =
+  [0, 10, push_bit (dflt_size - 1) 1, (push_bit dflt_size 1) - 1] \<and>
+  map uint64_of_uint [0, 10, push_bit (dflt_size - 1) 1] =
+  [0, 10, push_bit (dflt_size - 1) 1]"
 
 definition test_casts_uint' :: bool where
   "test_casts_uint' \<longleftrightarrow>
   map uint_of_uint16 [0, 10, 0xFFFF] = [0, 10, 0xFFFF] \<and>
   map uint16_of_uint [0, 10, 0xFFFF] = [0, 10, 0xFFFF]"
 
 definition test_casts_uint'' :: bool where
   "test_casts_uint'' \<longleftrightarrow>
   map uint_of_uint8 [0, 10, 0xFF] = [0, 10, 0xFF] \<and>
   map uint8_of_uint [0, 10, 0xFF] = [0, 10, 0xFF]"
 
 end
diff --git a/thys/Native_Word/Native_Word_Test_Scala.thy b/thys/Native_Word/Native_Word_Test_Scala.thy
--- a/thys/Native_Word/Native_Word_Test_Scala.thy
+++ b/thys/Native_Word/Native_Word_Test_Scala.thy
@@ -1,29 +1,28 @@
 (*  Title:      Native_Word_Test_Scala.thy
     Author:     Andreas Lochbihler, ETH Zurich
 *)
 
 theory Native_Word_Test_Scala imports
   Native_Word_Test
 begin
 
 section \<open>Test with Scala\<close>
 
 text \<open>
   In Scala, @{typ uint} and @{typ uint32} are both implemented as type \texttt{Int}.
   When they are used in the same generated program, we have to suppress the type class
   instances for one of them.
 \<close>
 code_printing class_instance uint32 :: equal \<rightharpoonup> (Scala) -
-code_printing class_instance uint32 :: semiring_bit_syntax \<rightharpoonup> (Scala) -
 
 test_code
   test_uint64 "test_uint64' = 0x12"
   test_uint32 "test_uint32' = 0x12"
   test_uint16
   test_uint8 "test_uint8' = 0x12" 
   test_uint
   test_casts test_casts' test_casts''
   test_casts_uint test_casts_uint' test_casts_uint''
 in Scala
 
 end
diff --git a/thys/Native_Word/Uint.thy b/thys/Native_Word/Uint.thy
--- a/thys/Native_Word/Uint.thy
+++ b/thys/Native_Word/Uint.thy
@@ -1,912 +1,896 @@
 (*  Title:      Uint.thy
     Author:     Peter Lammich, TU Munich
     Author:     Andreas Lochbihler, ETH Zurich
 *)
 
 chapter \<open>Unsigned words of default size\<close>
 
 theory Uint imports
   Code_Target_Word_Base
 begin
 
 text \<open>
   This theory provides access to words in the target languages of the code generator
   whose bit width is the default of the target language. To that end, the type \<open>uint\<close>
   models words of width \<open>dflt_size\<close>, but \<open>dflt_size\<close> is known only to be positive.
 
   Usage restrictions:
   Default-size words (type \<open>uint\<close>) cannot be used for evaluation, because 
   the results depend on the particular choice of word size in the target language
   and implementation. Symbolic evaluation has not yet been set up for \<open>uint\<close>.
 \<close>
 
 text \<open>The default size type\<close>
 typedecl dflt_size
 
 instantiation dflt_size :: typerep begin
 definition "typerep_class.typerep \<equiv>  \<lambda>_ :: dflt_size itself. Typerep.Typerep (STR ''Uint.dflt_size'') []"
 instance ..
 end
 
 consts dflt_size_aux :: "nat"
 specification (dflt_size_aux) dflt_size_aux_g0: "dflt_size_aux > 0"
   by auto
 hide_fact dflt_size_aux_def
 
 instantiation dflt_size :: len begin
 definition "len_of_dflt_size (_ :: dflt_size itself) \<equiv> dflt_size_aux"
 instance by(intro_classes)(simp add: len_of_dflt_size_def dflt_size_aux_g0)
 end
 
 abbreviation "dflt_size \<equiv> len_of (TYPE (dflt_size))"
 
 context includes integer.lifting begin
 lift_definition dflt_size_integer :: integer is "int dflt_size" .
 declare dflt_size_integer_def[code del]
   \<comment> \<open>The code generator will substitute a machine-dependent value for this constant\<close>
 
 lemma dflt_size_by_int[code]: "dflt_size = nat_of_integer dflt_size_integer"
 by transfer simp
 
 lemma dflt_size[simp]: 
   "dflt_size > 0"
   "dflt_size \<ge> Suc 0"
   "\<not> dflt_size < Suc 0"
   using len_gt_0[where 'a=dflt_size]
   by (simp_all del: len_gt_0)
 end
 
 declare prod.Quotient[transfer_rule]
 
 section \<open>Type definition and primitive operations\<close>
 
 typedef uint = "UNIV :: dflt_size word set" .. 
 
 setup_lifting type_definition_uint
 
 text \<open>Use an abstract type for code generation to disable pattern matching on @{term Abs_uint}.\<close>
 declare Rep_uint_inverse[code abstype]
 
 declare Quotient_uint[transfer_rule]
 
 instantiation uint :: comm_ring_1
 begin
 lift_definition zero_uint :: uint is "0 :: dflt_size word" .
 lift_definition one_uint :: uint is "1" .
 lift_definition plus_uint :: "uint \<Rightarrow> uint \<Rightarrow> uint" is "(+) :: dflt_size word \<Rightarrow> _" .
 lift_definition minus_uint :: "uint \<Rightarrow> uint \<Rightarrow> uint" is "(-)" .
 lift_definition uminus_uint :: "uint \<Rightarrow> uint" is uminus .
 lift_definition times_uint :: "uint \<Rightarrow> uint \<Rightarrow> uint" is "(*)" .
 instance by (standard; transfer) (simp_all add: algebra_simps)
 end
 
 instantiation uint :: semiring_modulo
 begin
 lift_definition divide_uint :: "uint \<Rightarrow> uint \<Rightarrow> uint" is "(div)" .
 lift_definition modulo_uint :: "uint \<Rightarrow> uint \<Rightarrow> uint" is "(mod)" .
 instance by (standard; transfer) (fact word_mod_div_equality)
 end
 
 instantiation uint :: linorder begin
 lift_definition less_uint :: "uint \<Rightarrow> uint \<Rightarrow> bool" is "(<)" .
 lift_definition less_eq_uint :: "uint \<Rightarrow> uint \<Rightarrow> bool" is "(\<le>)" .
 instance by (standard; transfer) (simp_all add: less_le_not_le linear)
 end
 
 lemmas [code] = less_uint.rep_eq less_eq_uint.rep_eq
 
 context
   includes lifting_syntax
   notes
     transfer_rule_of_bool [transfer_rule]
     transfer_rule_numeral [transfer_rule]
 begin
 
 lemma [transfer_rule]:
   "((=) ===> cr_uint) of_bool of_bool"
   by transfer_prover
 
 lemma transfer_rule_numeral_uint [transfer_rule]:
   "((=) ===> cr_uint) numeral numeral"
   by transfer_prover
 
 lemma [transfer_rule]:
   \<open>(cr_uint ===> (\<longleftrightarrow>)) even ((dvd) 2 :: uint \<Rightarrow> bool)\<close>
   by (unfold dvd_def) transfer_prover
 
 end
 
 instantiation uint :: semiring_bits
 begin
 
 lift_definition bit_uint :: \<open>uint \<Rightarrow> nat \<Rightarrow> bool\<close> is bit .
 
 instance
   by (standard; transfer)
     (fact bit_iff_odd even_iff_mod_2_eq_zero odd_iff_mod_2_eq_one odd_one bits_induct
        bits_div_0 bits_div_by_1 bits_mod_div_trivial even_succ_div_2
        even_mask_div_iff exp_div_exp_eq div_exp_eq mod_exp_eq mult_exp_mod_exp_eq
        div_exp_mod_exp_eq even_mult_exp_div_exp_iff)+
 
 end
 
 instantiation uint :: semiring_bit_shifts
 begin
 lift_definition push_bit_uint :: \<open>nat \<Rightarrow> uint \<Rightarrow> uint\<close> is push_bit .
 lift_definition drop_bit_uint :: \<open>nat \<Rightarrow> uint \<Rightarrow> uint\<close> is drop_bit .
 lift_definition take_bit_uint :: \<open>nat \<Rightarrow> uint \<Rightarrow> uint\<close> is take_bit .
 instance by (standard; transfer)
   (fact push_bit_eq_mult drop_bit_eq_div take_bit_eq_mod)+
 end
 
 instantiation uint :: ring_bit_operations
 begin
 lift_definition not_uint :: \<open>uint \<Rightarrow> uint\<close> is NOT .
 lift_definition and_uint :: \<open>uint \<Rightarrow> uint \<Rightarrow> uint\<close> is \<open>(AND)\<close> .
 lift_definition or_uint :: \<open>uint \<Rightarrow> uint \<Rightarrow> uint\<close> is \<open>(OR)\<close> .
 lift_definition xor_uint :: \<open>uint \<Rightarrow> uint \<Rightarrow> uint\<close> is \<open>(XOR)\<close> .
 lift_definition mask_uint :: \<open>nat \<Rightarrow> uint\<close> is mask .
 lift_definition set_bit_uint :: \<open>nat \<Rightarrow> uint \<Rightarrow> uint\<close> is \<open>Bit_Operations.set_bit\<close> .
 lift_definition unset_bit_uint :: \<open>nat \<Rightarrow> uint \<Rightarrow> uint\<close> is \<open>unset_bit\<close> .
 lift_definition flip_bit_uint :: \<open>nat \<Rightarrow> uint \<Rightarrow> uint\<close> is \<open>flip_bit\<close> .
 instance by (standard; transfer)
   (simp_all add: bit_simps mask_eq_decr_exp minus_eq_not_minus_1 set_bit_def flip_bit_def)
 end
 
 lemma [code]:
   \<open>take_bit n a = a AND mask n\<close> for a :: uint
   by (fact take_bit_eq_mask)
 
 lemma [code]:
   \<open>mask (Suc n) = push_bit n (1 :: uint) OR mask n\<close>
   \<open>mask 0 = (0 :: uint)\<close>
   by (simp_all add: mask_Suc_exp push_bit_of_1)
 
 lemma [code]:
   \<open>Bit_Operations.set_bit n w = w OR push_bit n 1\<close> for w :: uint
   by (fact set_bit_eq_or)
 
 lemma [code]:
   \<open>unset_bit n w = w AND NOT (push_bit n 1)\<close> for w :: uint
   by (fact unset_bit_eq_and_not)
 
 lemma [code]:
   \<open>flip_bit n w = w XOR push_bit n 1\<close> for w :: uint
   by (fact flip_bit_eq_xor)
 
-instance uint :: semiring_bit_syntax ..
-
-context
-  includes lifting_syntax
-begin
-
-lemma shiftl_uint_transfer [transfer_rule]:
-  \<open>(cr_uint ===> (=) ===> cr_uint) (\<lambda>k n. push_bit n k) (<<)\<close>
-  unfolding shiftl_eq_push_bit by transfer_prover
-
-lemma shiftr_uint_transfer [transfer_rule]:
-  \<open>(cr_uint ===> (=) ===> cr_uint) (\<lambda>k n. drop_bit n k) (>>)\<close>
-  unfolding shiftr_eq_drop_bit by transfer_prover
-
-end
-
 instantiation uint :: lsb
 begin
 lift_definition lsb_uint :: \<open>uint \<Rightarrow> bool\<close> is lsb .
 instance by (standard; transfer)
   (fact lsb_odd)
 end
 
 instantiation uint :: msb
 begin
 lift_definition msb_uint :: \<open>uint \<Rightarrow> bool\<close> is msb .
 instance ..
 end
 
 setup \<open>Context.theory_map (Name_Space.map_naming (Name_Space.qualified_path true \<^binding>\<open>Generic\<close>))\<close>
 
 instantiation uint :: set_bit
 begin
 lift_definition set_bit_uint :: \<open>uint \<Rightarrow> nat \<Rightarrow> bool \<Rightarrow> uint\<close> is set_bit .
 instance
   apply standard
   apply transfer
   apply (simp add: bit_simps)
   done
 end
 
 setup \<open>Context.theory_map (Name_Space.map_naming (Name_Space.parent_path))\<close>
 
 instantiation uint :: bit_comprehension begin
 lift_definition set_bits_uint :: "(nat \<Rightarrow> bool) \<Rightarrow> uint" is "set_bits" .
 instance by (standard; transfer) (fact set_bits_bit_eq)
 end
 
 lemmas [code] = bit_uint.rep_eq lsb_uint.rep_eq msb_uint.rep_eq
 
 instantiation uint :: equal begin
 lift_definition equal_uint :: "uint \<Rightarrow> uint \<Rightarrow> bool" is "equal_class.equal" .
 instance by standard (transfer, simp add: equal_eq)
 end
 
 lemmas [code] = equal_uint.rep_eq
 
 instantiation uint :: size begin
 lift_definition size_uint :: "uint \<Rightarrow> nat" is "size" .
 instance ..
 end
 
 lemmas [code] = size_uint.rep_eq
 
 lift_definition sshiftr_uint :: "uint \<Rightarrow> nat \<Rightarrow> uint" (infixl ">>>" 55) is \<open>\<lambda>w n. signed_drop_bit n w\<close> .
 
 lift_definition uint_of_int :: "int \<Rightarrow> uint" is "word_of_int" .
 
 text \<open>Use pretty numerals from integer for pretty printing\<close>
 
 context includes integer.lifting begin
 
 lift_definition Uint :: "integer \<Rightarrow> uint" is "word_of_int" .
 
 lemma Rep_uint_numeral [simp]: "Rep_uint (numeral n) = numeral n"
 by(induction n)(simp_all add: one_uint_def Abs_uint_inverse numeral.simps plus_uint_def)
 
 lemma numeral_uint_transfer [transfer_rule]:
   "(rel_fun (=) cr_uint) numeral numeral"
 by(auto simp add: cr_uint_def)
 
 lemma numeral_uint [code_unfold]: "numeral n = Uint (numeral n)"
 by transfer simp
 
 lemma Rep_uint_neg_numeral [simp]: "Rep_uint (- numeral n) = - numeral n"
 by(simp only: uminus_uint_def)(simp add: Abs_uint_inverse)
 
 lemma neg_numeral_uint [code_unfold]: "- numeral n = Uint (- numeral n)"
 by transfer(simp add: cr_uint_def)
 
 end
 
 lemma Abs_uint_numeral [code_post]: "Abs_uint (numeral n) = numeral n"
 by(induction n)(simp_all add: one_uint_def numeral.simps plus_uint_def Abs_uint_inverse)
 
 lemma Abs_uint_0 [code_post]: "Abs_uint 0 = 0"
 by(simp add: zero_uint_def)
 
 lemma Abs_uint_1 [code_post]: "Abs_uint 1 = 1"
 by(simp add: one_uint_def)
 
 section \<open>Code setup\<close>
 
 code_printing code_module Uint \<rightharpoonup> (SML)
 \<open>
 structure Uint : sig
   val set_bit : Word.word -> IntInf.int -> bool -> Word.word
   val shiftl : Word.word -> IntInf.int -> Word.word
   val shiftr : Word.word -> IntInf.int -> Word.word
   val shiftr_signed : Word.word -> IntInf.int -> Word.word
   val test_bit : Word.word -> IntInf.int -> bool
 end = struct
 
 fun set_bit x n b =
   let val mask = Word.<< (0wx1, Word.fromLargeInt (IntInf.toLarge n))
   in if b then Word.orb (x, mask)
      else Word.andb (x, Word.notb mask)
   end
 
 fun shiftl x n =
   Word.<< (x, Word.fromLargeInt (IntInf.toLarge n))
 
 fun shiftr x n =
   Word.>> (x, Word.fromLargeInt (IntInf.toLarge n))
 
 fun shiftr_signed x n =
   Word.~>> (x, Word.fromLargeInt (IntInf.toLarge n))
 
 fun test_bit x n =
   Word.andb (x, Word.<< (0wx1, Word.fromLargeInt (IntInf.toLarge n))) <> Word.fromInt 0
 
 end; (* struct Uint *)\<close>
 code_reserved SML Uint
 
 code_printing code_module Uint \<rightharpoonup> (Haskell)
  \<open>module Uint(Int, Word, dflt_size) where
 
   import qualified Prelude
   import Data.Int(Int)
   import Data.Word(Word)
   import qualified Data.Bits
 
   dflt_size :: Prelude.Integer
   dflt_size = Prelude.toInteger (bitSize_aux (0::Word)) where
     bitSize_aux :: (Data.Bits.Bits a, Prelude.Bounded a) => a -> Int
     bitSize_aux = Data.Bits.bitSize\<close>
   and (Haskell_Quickcheck)
  \<open>module Uint(Int, Word, dflt_size) where
 
   import qualified Prelude
   import Data.Int(Int)
   import Data.Word(Word)
   import qualified Data.Bits
 
   dflt_size :: Prelude.Int
   dflt_size = bitSize_aux (0::Word) where
     bitSize_aux :: (Data.Bits.Bits a, Prelude.Bounded a) => a -> Int
     bitSize_aux = Data.Bits.bitSize
 \<close>
 code_reserved Haskell Uint dflt_size
 
 text \<open>
   OCaml and Scala provide only signed bit numbers, so we use these and 
   implement sign-sensitive operations like comparisons manually.
 \<close>
 
 code_printing code_module "Uint" \<rightharpoonup> (OCaml)
 \<open>module Uint : sig
   type t = int
   val dflt_size : Z.t
   val less : t -> t -> bool
   val less_eq : t -> t -> bool
   val set_bit : t -> Z.t -> bool -> t
   val shiftl : t -> Z.t -> t
   val shiftr : t -> Z.t -> t
   val shiftr_signed : t -> Z.t -> t
   val test_bit : t -> Z.t -> bool
   val int_mask : int
   val int32_mask : int32
   val int64_mask : int64
 end = struct
 
 type t = int
 
 let dflt_size = Z.of_int Sys.int_size;;
 
 (* negative numbers have their highest bit set, 
    so they are greater than positive ones *)
 let less x y =
   if x<0 then
     y<0 && x<y
   else y < 0 || x < y;;
 
 let less_eq x y =
   if x < 0 then
     y < 0 &&  x <= y
   else y < 0 || x <= y;;
 
 let set_bit x n b =
   let mask = 1 lsl (Z.to_int n)
   in if b then x lor mask
      else x land (lnot mask);;
 
 let shiftl x n = x lsl (Z.to_int n);;
 
 let shiftr x n = x lsr (Z.to_int n);;
 
 let shiftr_signed x n = x asr (Z.to_int n);;
 
 let test_bit x n = x land (1 lsl (Z.to_int n)) <> 0;;
 
 let int_mask =
   if Sys.int_size < 32 then lnot 0 else 0xFFFFFFFF;;
 
 let int32_mask = 
   if Sys.int_size < 32 then Int32.pred (Int32.shift_left Int32.one Sys.int_size)
   else Int32.of_string "0xFFFFFFFF";;
 
 let int64_mask = 
   if Sys.int_size < 64 then Int64.pred (Int64.shift_left Int64.one Sys.int_size)
   else Int64.of_string "0xFFFFFFFFFFFFFFFF";;
 
 end;; (*struct Uint*)\<close>
 code_reserved OCaml Uint
 
 code_printing code_module Uint \<rightharpoonup> (Scala)
 \<open>object Uint {
 def dflt_size : BigInt = BigInt(32)
 
 def less(x: Int, y: Int) : Boolean =
   if (x < 0) y < 0 && x < y
   else y < 0 || x < y
 
 def less_eq(x: Int, y: Int) : Boolean =
   if (x < 0) y < 0 && x <= y
   else y < 0 || x <= y
 
 def set_bit(x: Int, n: BigInt, b: Boolean) : Int =
   if (b)
     x | (1 << n.intValue)
   else
     x & (1 << n.intValue).unary_~
 
 def shiftl(x: Int, n: BigInt) : Int = x << n.intValue
 
 def shiftr(x: Int, n: BigInt) : Int = x >>> n.intValue
 
 def shiftr_signed(x: Int, n: BigInt) : Int = x >> n.intValue
 
 def test_bit(x: Int, n: BigInt) : Boolean =
   (x & (1 << n.intValue)) != 0
 
 } /* object Uint */\<close>
 code_reserved Scala Uint
 
 
 text \<open>
   OCaml's conversion from Big\_int to int demands that the value fits into a signed integer.
   The following justifies the implementation.
 \<close>
 
 context includes integer.lifting begin
 definition wivs_mask :: int where "wivs_mask = 2^ dflt_size - 1"
 lift_definition wivs_mask_integer :: integer is wivs_mask .
 lemma [code]: "wivs_mask_integer = 2 ^ dflt_size - 1"
   by transfer (simp add: wivs_mask_def)
 
 definition wivs_shift :: int where "wivs_shift = 2 ^ dflt_size"
 lift_definition wivs_shift_integer :: integer is wivs_shift .
 lemma [code]: "wivs_shift_integer = 2 ^ dflt_size"
   by transfer (simp add: wivs_shift_def)
 
 definition wivs_index :: nat where "wivs_index == dflt_size - 1"
 lift_definition wivs_index_integer :: integer is "int wivs_index".
 lemma wivs_index_integer_code[code]: "wivs_index_integer = dflt_size_integer - 1"
   by transfer (simp add: wivs_index_def of_nat_diff)
 
 definition wivs_overflow :: int where "wivs_overflow == 2^ (dflt_size - 1)"
 lift_definition wivs_overflow_integer :: integer is wivs_overflow .
 lemma [code]: "wivs_overflow_integer = 2 ^ (dflt_size - 1)"
   by transfer (simp add: wivs_overflow_def)
 
 definition wivs_least :: int where "wivs_least == - wivs_overflow"
 lift_definition wivs_least_integer :: integer is wivs_least .
 lemma [code]: "wivs_least_integer = - (2 ^ (dflt_size - 1))"
   by transfer (simp add: wivs_overflow_def wivs_least_def)
 
 definition Uint_signed :: "integer \<Rightarrow> uint" where
   "Uint_signed i = (if i < wivs_least_integer \<or> wivs_overflow_integer \<le> i then undefined Uint i else Uint i)"
 
 lemma Uint_code [code]:
   "Uint i = 
   (let i' = i AND wivs_mask_integer in 
    if bit i' wivs_index then Uint_signed (i' - wivs_shift_integer) else Uint_signed i')"
   including undefined_transfer 
   unfolding Uint_signed_def
   apply transfer
   apply (subst word_of_int_via_signed)
-       apply (auto simp add: shiftl_eq_push_bit push_bit_of_1 mask_eq_exp_minus_1 word_of_int_via_signed
+       apply (auto simp add: push_bit_of_1 mask_eq_exp_minus_1 word_of_int_via_signed
          wivs_mask_def wivs_index_def wivs_overflow_def wivs_least_def wivs_shift_def)
   done
 
 lemma Uint_signed_code [code abstract]:
   "Rep_uint (Uint_signed i) = 
   (if i < wivs_least_integer \<or> i \<ge> wivs_overflow_integer then Rep_uint (undefined Uint i) else word_of_int (int_of_integer_symbolic i))"
   unfolding Uint_signed_def Uint_def int_of_integer_symbolic_def word_of_integer_def
   by(simp add: Abs_uint_inverse)
 end
 
 text \<open>
   Avoid @{term Abs_uint} in generated code, use @{term Rep_uint'} instead. 
   The symbolic implementations for code\_simp use @{term Rep_uint}.
 
   The new destructor @{term Rep_uint'} is executable.
   As the simplifier is given the [code abstract] equations literally, 
   we cannot implement @{term Rep_uint} directly, because that makes code\_simp loop.
 
   If code generation raises Match, some equation probably contains @{term Rep_uint} 
   ([code abstract] equations for @{typ uint} may use @{term Rep_uint} because
   these instances will be folded away.)
 \<close>
 
 definition Rep_uint' where [simp]: "Rep_uint' = Rep_uint"
 
 lemma Rep_uint'_code [code]: "Rep_uint' x = (BITS n. bit x n)"
   unfolding Rep_uint'_def by transfer (simp add: set_bits_bit_eq)
 
 lift_definition Abs_uint' :: "dflt_size word \<Rightarrow> uint" is "\<lambda>x :: dflt_size word. x" .
 
 lemma Abs_uint'_code [code]:
   "Abs_uint' x = Uint (integer_of_int (uint x))"
 including integer.lifting by transfer simp
 
 declare [[code drop: "term_of_class.term_of :: uint \<Rightarrow> _"]]
 
 lemma term_of_uint_code [code]:
   defines "TR \<equiv> typerep.Typerep" and "bit0 \<equiv> STR ''Numeral_Type.bit0''" 
   shows
   "term_of_class.term_of x = 
    Code_Evaluation.App (Code_Evaluation.Const (STR ''Uint.uint.Abs_uint'') (TR (STR ''fun'') [TR (STR ''Word.word'')  [TR (STR ''Uint.dflt_size'') []], TR (STR ''Uint.uint'') []]))
        (term_of_class.term_of (Rep_uint' x))"
   by(simp add: term_of_anything)
 
 text \<open>Important:
   We must prevent the reflection oracle (eval-tac) to 
   use our machine-dependent type.
 \<close>
 
 code_printing
   type_constructor uint \<rightharpoonup>
   (SML) "Word.word" and
   (Haskell) "Uint.Word" and
   (OCaml) "Uint.t" and
   (Scala) "Int" and
   (Eval) "*** \"Error: Machine dependent type\" ***" and
   (Quickcheck) "Word.word" 
 | constant dflt_size_integer \<rightharpoonup>
   (SML) "(IntInf.fromLarge (Int.toLarge Word.wordSize))" and
   (Eval) "(raise (Fail \"Machine dependent code\"))" and
   (Quickcheck) "Word.wordSize" and
   (Haskell) "Uint.dflt'_size" and
   (OCaml) "Uint.dflt'_size" and
   (Scala) "Uint.dflt'_size"
 | constant Uint \<rightharpoonup>
   (SML) "Word.fromLargeInt (IntInf.toLarge _)" and
   (Eval) "(raise (Fail \"Machine dependent code\"))" and
   (Quickcheck) "Word.fromInt" and
   (Haskell) "(Prelude.fromInteger _ :: Uint.Word)" and
   (Haskell_Quickcheck) "(Prelude.fromInteger (Prelude.toInteger _) :: Uint.Word)" and
   (Scala) "_.intValue"
 | constant Uint_signed \<rightharpoonup>
   (OCaml) "Z.to'_int"
 | constant "0 :: uint" \<rightharpoonup>
   (SML) "(Word.fromInt 0)" and
   (Eval) "(raise (Fail \"Machine dependent code\"))" and
   (Quickcheck) "(Word.fromInt 0)" and
   (Haskell) "(0 :: Uint.Word)" and
   (OCaml) "0" and
   (Scala) "0"
 | constant "1 :: uint" \<rightharpoonup>
   (SML) "(Word.fromInt 1)" and
   (Eval) "(raise (Fail \"Machine dependent code\"))" and
   (Quickcheck) "(Word.fromInt 1)" and
   (Haskell) "(1 :: Uint.Word)" and
   (OCaml) "1" and
   (Scala) "1"
 | constant "plus :: uint \<Rightarrow> _ " \<rightharpoonup>
   (SML) "Word.+ ((_), (_))" and
   (Eval) "(raise (Fail \"Machine dependent code\"))" and
   (Quickcheck) "Word.+ ((_), (_))" and
   (Haskell) infixl 6 "+" and
   (OCaml) "Pervasives.(+)" and
   (Scala) infixl 7 "+"
 | constant "uminus :: uint \<Rightarrow> _" \<rightharpoonup>
   (SML) "Word.~" and
   (Eval) "(raise (Fail \"Machine dependent code\"))" and
   (Quickcheck) "Word.~" and
   (Haskell) "negate" and
   (OCaml) "Pervasives.(~-)" and
   (Scala) "!(- _)"
 | constant "minus :: uint \<Rightarrow> _" \<rightharpoonup>
   (SML) "Word.- ((_), (_))" and
   (Eval) "(raise (Fail \"Machine dependent code\"))" and
   (Quickcheck) "Word.- ((_), (_))" and
   (Haskell) infixl 6 "-" and
   (OCaml) "Pervasives.(-)" and
   (Scala) infixl 7 "-"
 | constant "times :: uint \<Rightarrow> _ \<Rightarrow> _" \<rightharpoonup>
   (SML) "Word.* ((_), (_))" and
   (Eval) "(raise (Fail \"Machine dependent code\"))" and
   (Quickcheck) "Word.* ((_), (_))" and
   (Haskell) infixl 7 "*" and
   (OCaml) "Pervasives.( * )" and
   (Scala) infixl 8 "*"
 | constant "HOL.equal :: uint \<Rightarrow> _ \<Rightarrow> bool" \<rightharpoonup>
   (SML) "!((_ : Word.word) = _)" and
   (Eval) "(raise (Fail \"Machine dependent code\"))" and
   (Quickcheck) "!((_ : Word.word) = _)" and
   (Haskell) infix 4 "==" and
   (OCaml) "(Pervasives.(=):Uint.t -> Uint.t -> bool)" and
   (Scala) infixl 5 "=="
 | class_instance uint :: equal \<rightharpoonup>
   (Haskell) -
 | constant "less_eq :: uint \<Rightarrow> _ \<Rightarrow> bool" \<rightharpoonup>
   (SML) "Word.<= ((_), (_))" and
   (Eval) "(raise (Fail \"Machine dependent code\"))" and
   (Quickcheck) "Word.<= ((_), (_))" and
   (Haskell) infix 4 "<=" and
   (OCaml) "Uint.less'_eq" and
   (Scala) "Uint.less'_eq"
 | constant "less :: uint \<Rightarrow> _ \<Rightarrow> bool" \<rightharpoonup>
   (SML) "Word.< ((_), (_))" and
   (Eval) "(raise (Fail \"Machine dependent code\"))" and
   (Quickcheck) "Word.< ((_), (_))" and
   (Haskell) infix 4 "<" and
   (OCaml) "Uint.less" and
   (Scala) "Uint.less"
 | constant "NOT :: uint \<Rightarrow> _" \<rightharpoonup>
   (SML) "Word.notb" and
   (Eval) "(raise (Fail \"Machine dependent code\"))" and
   (Quickcheck) "Word.notb" and
   (Haskell) "Data'_Bits.complement" and
   (OCaml) "Pervasives.lnot" and
   (Scala) "_.unary'_~"
 | constant "(AND) :: uint \<Rightarrow> _" \<rightharpoonup>
   (SML) "Word.andb ((_),/ (_))" and
   (Eval) "(raise (Fail \"Machine dependent code\"))" and
   (Quickcheck) "Word.andb ((_),/ (_))" and
   (Haskell) infixl 7 "Data_Bits..&." and
   (OCaml) "Pervasives.(land)" and
   (Scala) infixl 3 "&"
 | constant "(OR) :: uint \<Rightarrow> _" \<rightharpoonup>
   (SML) "Word.orb ((_),/ (_))" and
   (Eval) "(raise (Fail \"Machine dependent code\"))" and
   (Quickcheck) "Word.orb ((_),/ (_))" and
   (Haskell) infixl 5 "Data_Bits..|." and
   (OCaml) "Pervasives.(lor)" and
   (Scala) infixl 1 "|"
 | constant "(XOR) :: uint \<Rightarrow> _" \<rightharpoonup>
   (SML) "Word.xorb ((_),/ (_))" and
   (Eval) "(raise (Fail \"Machine dependent code\"))" and
   (Quickcheck) "Word.xorb ((_),/ (_))" and
   (Haskell) "Data'_Bits.xor" and
   (OCaml) "Pervasives.(lxor)" and
   (Scala) infixl 2 "^"
 
 definition uint_divmod :: "uint \<Rightarrow> uint \<Rightarrow> uint \<times> uint" where
   "uint_divmod x y = 
   (if y = 0 then (undefined ((div) :: uint \<Rightarrow> _) x (0 :: uint), undefined ((mod) :: uint \<Rightarrow> _) x (0 :: uint)) 
   else (x div y, x mod y))"
 
 definition uint_div :: "uint \<Rightarrow> uint \<Rightarrow> uint" 
 where "uint_div x y = fst (uint_divmod x y)"
 
 definition uint_mod :: "uint \<Rightarrow> uint \<Rightarrow> uint" 
 where "uint_mod x y = snd (uint_divmod x y)"
 
 lemma div_uint_code [code]: "x div y = (if y = 0 then 0 else uint_div x y)"
 including undefined_transfer unfolding uint_divmod_def uint_div_def
 by transfer(simp add: word_div_def)
 
 lemma mod_uint_code [code]: "x mod y = (if y = 0 then x else uint_mod x y)"
 including undefined_transfer unfolding uint_mod_def uint_divmod_def
 by transfer(simp add: word_mod_def)
 
 definition uint_sdiv :: "uint \<Rightarrow> uint \<Rightarrow> uint"
 where [code del]:
   "uint_sdiv x y =
    (if y = 0 then undefined ((div) :: uint \<Rightarrow> _) x (0 :: uint)
     else Abs_uint (Rep_uint x sdiv Rep_uint y))"
 
 definition div0_uint :: "uint \<Rightarrow> uint"
 where [code del]: "div0_uint x = undefined ((div) :: uint \<Rightarrow> _) x (0 :: uint)"
 declare [[code abort: div0_uint]]
 
 definition mod0_uint :: "uint \<Rightarrow> uint"
 where [code del]: "mod0_uint x = undefined ((mod) :: uint \<Rightarrow> _) x (0 :: uint)"
 declare [[code abort: mod0_uint]]
 
 definition wivs_overflow_uint :: uint 
   where "wivs_overflow_uint \<equiv> push_bit (dflt_size - 1) 1"
 
 lemma uint_divmod_code [code]:
   "uint_divmod x y =
   (if wivs_overflow_uint \<le> y then if x < y then (0, x) else (1, x - y)
    else if y = 0 then (div0_uint x, mod0_uint x)
    else let q = push_bit 1 (uint_sdiv (drop_bit 1 x) y);
             r = x - q * y
         in if r \<ge> y then (q + 1, r - y) else (q, r))"
 proof (cases \<open>y = 0\<close>)
   case True
   moreover have \<open>x \<ge> 0\<close>
     by transfer simp
   moreover have \<open>wivs_overflow_uint > 0\<close>
     apply (simp add: wivs_overflow_uint_def push_bit_of_1)
     apply transfer
     apply transfer
     apply simp
     done
   ultimately show ?thesis
     by (auto simp add: uint_divmod_def div0_uint_def mod0_uint_def not_less)
 next
   case False
   then show ?thesis
     including undefined_transfer 
     unfolding uint_divmod_def uint_sdiv_def div0_uint_def mod0_uint_def
       wivs_overflow_uint_def
     apply transfer
-    apply (simp add: divmod_via_sdivmod push_bit_of_1 shiftl_eq_push_bit shiftr_eq_drop_bit)
+    apply (simp add: divmod_via_sdivmod push_bit_of_1)
     done
 qed
 
 lemma uint_sdiv_code [code abstract]:
   "Rep_uint (uint_sdiv x y) =
    (if y = 0 then Rep_uint (undefined ((div) :: uint \<Rightarrow> _) x (0 :: uint))
     else Rep_uint x sdiv Rep_uint y)"
 unfolding uint_sdiv_def by(simp add: Abs_uint_inverse)
 
 text \<open>
   Note that we only need a translation for signed division, but not for the remainder
   because @{thm uint_divmod_code} computes both with division only.
 \<close>
 
 code_printing
   constant uint_div \<rightharpoonup>
   (SML) "Word.div ((_), (_))" and
   (Eval) "(raise (Fail \"Machine dependent code\"))" and
   (Quickcheck) "Word.div ((_), (_))" and
   (Haskell) "Prelude.div"
 | constant uint_mod \<rightharpoonup>
   (SML) "Word.mod ((_), (_))" and
   (Eval) "(raise (Fail \"Machine dependent code\"))" and
   (Quickcheck) "Word.mod ((_), (_))" and
   (Haskell) "Prelude.mod"
 | constant uint_divmod \<rightharpoonup>
   (Haskell) "divmod"
 | constant uint_sdiv \<rightharpoonup>
   (OCaml) "Pervasives.('/)" and
   (Scala) "_ '/ _"
 
 definition uint_test_bit :: "uint \<Rightarrow> integer \<Rightarrow> bool"
 where [code del]:
   "uint_test_bit x n =
   (if n < 0 \<or> dflt_size_integer \<le> n then undefined (bit :: uint \<Rightarrow> _) x n
    else bit x (nat_of_integer n))"
 
 lemma test_bit_uint_code [code]:
   "bit x n \<longleftrightarrow> n < dflt_size \<and> uint_test_bit x (integer_of_nat n)"
   including undefined_transfer integer.lifting unfolding uint_test_bit_def
   by (transfer, simp, transfer, simp)
 
 lemma uint_test_bit_code [code]:
   "uint_test_bit w n =
   (if n < 0 \<or> dflt_size_integer \<le> n then undefined (bit :: uint \<Rightarrow> _) w n else bit (Rep_uint w) (nat_of_integer n))"
   unfolding uint_test_bit_def by(simp add: bit_uint.rep_eq)
 
 code_printing constant uint_test_bit \<rightharpoonup>
   (SML) "Uint.test'_bit" and
   (Eval) "(raise (Fail \"Machine dependent code\"))" and
   (Quickcheck) "Uint.test'_bit" and
   (Haskell) "Data'_Bits.testBitBounded" and
   (OCaml) "Uint.test'_bit" and
   (Scala) "Uint.test'_bit"
 
 definition uint_set_bit :: "uint \<Rightarrow> integer \<Rightarrow> bool \<Rightarrow> uint"
 where [code del]:
   "uint_set_bit x n b =
   (if n < 0 \<or> dflt_size_integer \<le> n then undefined (set_bit :: uint \<Rightarrow> _) x n b
    else set_bit x (nat_of_integer n) b)"
 
 lemma set_bit_uint_code [code]:
   "set_bit x n b = (if n < dflt_size then uint_set_bit x (integer_of_nat n) b else x)"
   including undefined_transfer integer.lifting unfolding uint_set_bit_def
   by (transfer) (auto cong: conj_cong simp add: not_less set_bit_beyond word_size)
 
 lemma uint_set_bit_code [code abstract]:
   "Rep_uint (uint_set_bit w n b) = 
   (if n < 0 \<or> dflt_size_integer \<le> n then Rep_uint (undefined (set_bit :: uint \<Rightarrow> _) w n b)
    else set_bit (Rep_uint w) (nat_of_integer n) b)"
 including undefined_transfer integer.lifting unfolding uint_set_bit_def by transfer simp
 
 code_printing constant uint_set_bit \<rightharpoonup>
   (SML) "Uint.set'_bit" and
   (Eval) "(raise (Fail \"Machine dependent code\"))" and
   (Quickcheck) "Uint.set'_bit" and
   (Haskell) "Data'_Bits.setBitBounded" and
   (OCaml) "Uint.set'_bit" and
   (Scala) "Uint.set'_bit"
 
 lift_definition uint_set_bits :: "(nat \<Rightarrow> bool) \<Rightarrow> uint \<Rightarrow> nat \<Rightarrow> uint" is set_bits_aux .
 
 lemma uint_set_bits_code [code]:
   "uint_set_bits f w n =
   (if n = 0 then w 
    else let n' = n - 1 in uint_set_bits f (push_bit 1 w OR (if f n' then 1 else 0)) n')"
   apply (transfer fixing: n)
   apply (cases n)
-   apply (simp_all add: shiftl_eq_push_bit)
+   apply simp_all
   done
 
 lemma set_bits_uint [code]:
   "(BITS n. f n) = uint_set_bits f 0 dflt_size"
   by transfer (simp add: set_bits_conv_set_bits_aux)
 
 lemma lsb_code [code]: fixes x :: uint shows "lsb x = bit x 0"
   by transfer (simp add: lsb_word_eq)
 
 definition uint_shiftl :: "uint \<Rightarrow> integer \<Rightarrow> uint"
 where [code del]:
   "uint_shiftl x n = (if n < 0 \<or> dflt_size_integer \<le> n then undefined (push_bit :: nat \<Rightarrow> uint \<Rightarrow> _) x n else push_bit (nat_of_integer n) x)"
 
 lemma shiftl_uint_code [code]: "push_bit n x = (if n < dflt_size then uint_shiftl x (integer_of_nat n) else 0)"
   including undefined_transfer integer.lifting unfolding uint_shiftl_def
   by (transfer fixing: n) simp
 
 lemma uint_shiftl_code [code abstract]:
   "Rep_uint (uint_shiftl w n) =
   (if n < 0 \<or> dflt_size_integer \<le> n then Rep_uint (undefined (push_bit :: nat \<Rightarrow> uint \<Rightarrow> _) w n) else push_bit (nat_of_integer n) (Rep_uint w))"
   including undefined_transfer integer.lifting unfolding uint_shiftl_def by transfer simp
 
 code_printing constant uint_shiftl \<rightharpoonup>
   (SML) "Uint.shiftl" and
   (Eval) "(raise (Fail \"Machine dependent code\"))" and
   (Quickcheck) "Uint.shiftl" and
   (Haskell) "Data'_Bits.shiftlBounded" and
   (OCaml) "Uint.shiftl" and
   (Scala) "Uint.shiftl"
 
 definition uint_shiftr :: "uint \<Rightarrow> integer \<Rightarrow> uint"
 where [code del]:
   "uint_shiftr x n = (if n < 0 \<or> dflt_size_integer \<le> n then undefined (drop_bit :: nat \<Rightarrow> uint \<Rightarrow> _) x n else drop_bit (nat_of_integer n) x)"
 
 lemma shiftr_uint_code [code]: "drop_bit n x = (if n < dflt_size then uint_shiftr x (integer_of_nat n) else 0)"
   including undefined_transfer integer.lifting unfolding uint_shiftr_def
   by (transfer fixing: n) simp
   
 lemma uint_shiftr_code [code abstract]:
   "Rep_uint (uint_shiftr w n) =
   (if n < 0 \<or> dflt_size_integer \<le> n then Rep_uint (undefined (drop_bit :: nat \<Rightarrow> uint \<Rightarrow> _) w n) else drop_bit (nat_of_integer n) (Rep_uint w))"
 including undefined_transfer unfolding uint_shiftr_def by transfer simp
 
 code_printing constant uint_shiftr \<rightharpoonup>
   (SML) "Uint.shiftr" and
   (Eval) "(raise (Fail \"Machine dependent code\"))" and
   (Quickcheck) "Uint.shiftr" and
   (Haskell) "Data'_Bits.shiftrBounded" and
   (OCaml) "Uint.shiftr" and
   (Scala) "Uint.shiftr"
 
 definition uint_sshiftr :: "uint \<Rightarrow> integer \<Rightarrow> uint"
 where [code del]:
   "uint_sshiftr x n =
   (if n < 0 \<or> dflt_size_integer \<le> n then undefined sshiftr_uint x n else sshiftr_uint x (nat_of_integer n))"
 
 lemma sshiftr_uint_code [code]:
   "x >>> n = 
   (if n < dflt_size then uint_sshiftr x (integer_of_nat n) else 
     if bit x wivs_index then -1 else 0)"
 including undefined_transfer integer.lifting unfolding uint_sshiftr_def
 by transfer(simp add: not_less signed_drop_bit_beyond word_size wivs_index_def)
 
 lemma uint_sshiftr_code [code abstract]:
   "Rep_uint (uint_sshiftr w n) =
   (if n < 0 \<or> dflt_size_integer \<le> n then Rep_uint (undefined sshiftr_uint w n) else signed_drop_bit (nat_of_integer n) (Rep_uint w))"
 including undefined_transfer unfolding uint_sshiftr_def by transfer simp
 
 code_printing constant uint_sshiftr \<rightharpoonup>
   (SML) "Uint.shiftr'_signed" and
   (Eval) "(raise (Fail \"Machine dependent code\"))" and
   (Quickcheck) "Uint.shiftr'_signed" and
   (Haskell) 
     "(Prelude.fromInteger (Prelude.toInteger (Data'_Bits.shiftrBounded (Prelude.fromInteger (Prelude.toInteger _) :: Uint.Int) _)) :: Uint.Word)" and
   (OCaml) "Uint.shiftr'_signed" and
   (Scala) "Uint.shiftr'_signed"
 
 lemma uint_msb_test_bit: "msb x \<longleftrightarrow> bit (x :: uint) wivs_index"
   by transfer (simp add: msb_word_iff_bit wivs_index_def)
 
 lemma msb_uint_code [code]: "msb x \<longleftrightarrow> uint_test_bit x wivs_index_integer"
   apply(simp add: uint_test_bit_def uint_msb_test_bit 
   wivs_index_integer_code dflt_size_integer_def wivs_index_def)
   by (metis (full_types) One_nat_def dflt_size(2) less_iff_diff_less_0 
     nat_of_integer_of_nat of_nat_1 of_nat_diff of_nat_less_0_iff wivs_index_def)
 
 lemma uint_of_int_code [code]: "uint_of_int i = (BITS n. bit i n)"
   by transfer (simp add: word_of_int_conv_set_bits)
 
 
 section \<open>Quickcheck setup\<close>
 
 definition uint_of_natural :: "natural \<Rightarrow> uint"
 where "uint_of_natural x \<equiv> Uint (integer_of_natural x)"
 
 instantiation uint :: "{random, exhaustive, full_exhaustive}" begin
 definition "random_uint \<equiv> qc_random_cnv uint_of_natural"
 definition "exhaustive_uint \<equiv> qc_exhaustive_cnv uint_of_natural"
 definition "full_exhaustive_uint \<equiv> qc_full_exhaustive_cnv uint_of_natural"
 instance ..
 end
 
 instantiation uint :: narrowing begin
 
 interpretation quickcheck_narrowing_samples
   "\<lambda>i. (Uint i, Uint (- i))" "0"
   "Typerep.Typerep (STR ''Uint.uint'') []" .
 
 definition "narrowing_uint d = qc_narrowing_drawn_from (narrowing_samples d) d"
 declare [[code drop: "partial_term_of :: uint itself \<Rightarrow> _"]]
 lemmas partial_term_of_uint [code] = partial_term_of_code
 
 instance ..
 end
 
 no_notation sshiftr_uint (infixl ">>>" 55)
 
 end
diff --git a/thys/Native_Word/Uint16.thy b/thys/Native_Word/Uint16.thy
--- a/thys/Native_Word/Uint16.thy
+++ b/thys/Native_Word/Uint16.thy
@@ -1,638 +1,622 @@
 (*  Title:      Uint16.thy
     Author:     Andreas Lochbihler, ETH Zurich
 *)
 
 chapter \<open>Unsigned words of 16 bits\<close>
 
 theory Uint16 imports
   Code_Target_Word_Base
 begin
 
 text \<open>
   Restriction for ML code generation:
   This theory assumes that the ML system provides a Word16
   implementation (mlton does, but PolyML 5.5 does not).
   Therefore, the code setup lives in the target \<open>SML_word\<close>
   rather than \<open>SML\<close>.  This ensures that code generation still
   works as long as \<open>uint16\<close> is not involved.
   For the target \<open>SML\<close> itself, no special code generation 
   for this type is set up. Nevertheless, it should work by emulation via @{typ "16 word"} 
   if the theory \<open>Code_Target_Bits_Int\<close> is imported.
 
   Restriction for OCaml code generation:
   OCaml does not provide an int16 type, so no special code generation 
   for this type is set up.
 \<close>
 
 declare prod.Quotient[transfer_rule]
 
 section \<open>Type definition and primitive operations\<close>
 
 typedef uint16 = "UNIV :: 16 word set" ..
 
 setup_lifting type_definition_uint16
 
 text \<open>Use an abstract type for code generation to disable pattern matching on @{term Abs_uint16}.\<close>
 declare Rep_uint16_inverse[code abstype]
 
 declare Quotient_uint16[transfer_rule]
 
 instantiation uint16 :: comm_ring_1
 begin
 lift_definition zero_uint16 :: uint16 is "0 :: 16 word" .
 lift_definition one_uint16 :: uint16 is "1" .
 lift_definition plus_uint16 :: "uint16 \<Rightarrow> uint16 \<Rightarrow> uint16" is "(+) :: 16 word \<Rightarrow> _" .
 lift_definition minus_uint16 :: "uint16 \<Rightarrow> uint16 \<Rightarrow> uint16" is "(-)" .
 lift_definition uminus_uint16 :: "uint16 \<Rightarrow> uint16" is uminus .
 lift_definition times_uint16 :: "uint16 \<Rightarrow> uint16 \<Rightarrow> uint16" is "(*)" .
 instance by (standard; transfer) (simp_all add: algebra_simps)
 end
 
 instantiation uint16 :: semiring_modulo
 begin
 lift_definition divide_uint16 :: "uint16 \<Rightarrow> uint16 \<Rightarrow> uint16" is "(div)" .
 lift_definition modulo_uint16 :: "uint16 \<Rightarrow> uint16 \<Rightarrow> uint16" is "(mod)" .
 instance by (standard; transfer) (fact word_mod_div_equality)
 end
 
 instantiation uint16 :: linorder begin
 lift_definition less_uint16 :: "uint16 \<Rightarrow> uint16 \<Rightarrow> bool" is "(<)" .
 lift_definition less_eq_uint16 :: "uint16 \<Rightarrow> uint16 \<Rightarrow> bool" is "(\<le>)" .
 instance by (standard; transfer) (simp_all add: less_le_not_le linear)
 end
 
 lemmas [code] = less_uint16.rep_eq less_eq_uint16.rep_eq
 
 context
   includes lifting_syntax
   notes
     transfer_rule_of_bool [transfer_rule]
     transfer_rule_numeral [transfer_rule]
 begin
 
 lemma [transfer_rule]:
   "((=) ===> cr_uint16) of_bool of_bool"
   by transfer_prover
 
 lemma transfer_rule_numeral_uint [transfer_rule]:
   "((=) ===> cr_uint16) numeral numeral"
   by transfer_prover
 
 lemma [transfer_rule]:
   \<open>(cr_uint16 ===> (\<longleftrightarrow>)) even ((dvd) 2 :: uint16 \<Rightarrow> bool)\<close>
   by (unfold dvd_def) transfer_prover
 
 end
 
 instantiation uint16 :: semiring_bits
 begin
 
 lift_definition bit_uint16 :: \<open>uint16 \<Rightarrow> nat \<Rightarrow> bool\<close> is bit .
 
 instance
   by (standard; transfer)
     (fact bit_iff_odd even_iff_mod_2_eq_zero odd_iff_mod_2_eq_one odd_one bits_induct
        bits_div_0 bits_div_by_1 bits_mod_div_trivial even_succ_div_2
        even_mask_div_iff exp_div_exp_eq div_exp_eq mod_exp_eq mult_exp_mod_exp_eq
        div_exp_mod_exp_eq even_mult_exp_div_exp_iff)+
 
 end
 
 instantiation uint16 :: semiring_bit_shifts
 begin
 lift_definition push_bit_uint16 :: \<open>nat \<Rightarrow> uint16 \<Rightarrow> uint16\<close> is push_bit .
 lift_definition drop_bit_uint16 :: \<open>nat \<Rightarrow> uint16 \<Rightarrow> uint16\<close> is drop_bit .
 lift_definition take_bit_uint16 :: \<open>nat \<Rightarrow> uint16 \<Rightarrow> uint16\<close> is take_bit .
 instance by (standard; transfer)
   (fact push_bit_eq_mult drop_bit_eq_div take_bit_eq_mod)+
 end
 
 instantiation uint16 :: ring_bit_operations
 begin
 lift_definition not_uint16 :: \<open>uint16 \<Rightarrow> uint16\<close> is NOT .
 lift_definition and_uint16 :: \<open>uint16 \<Rightarrow> uint16 \<Rightarrow> uint16\<close> is \<open>(AND)\<close> .
 lift_definition or_uint16 :: \<open>uint16 \<Rightarrow> uint16 \<Rightarrow> uint16\<close> is \<open>(OR)\<close> .
 lift_definition xor_uint16 :: \<open>uint16 \<Rightarrow> uint16 \<Rightarrow> uint16\<close> is \<open>(XOR)\<close> .
 lift_definition mask_uint16 :: \<open>nat \<Rightarrow> uint16\<close> is mask .
 lift_definition set_bit_uint16 :: \<open>nat \<Rightarrow> uint16 \<Rightarrow> uint16\<close> is \<open>Bit_Operations.set_bit\<close> .
 lift_definition unset_bit_uint16 :: \<open>nat \<Rightarrow> uint16 \<Rightarrow> uint16\<close> is \<open>unset_bit\<close> .
 lift_definition flip_bit_uint16 :: \<open>nat \<Rightarrow> uint16 \<Rightarrow> uint16\<close> is \<open>flip_bit\<close> .
 instance by (standard; transfer)
   (simp_all add: bit_simps mask_eq_decr_exp minus_eq_not_minus_1 set_bit_def flip_bit_def)
 end
 
 lemma [code]:
   \<open>take_bit n a = a AND mask n\<close> for a :: uint16
   by (fact take_bit_eq_mask)
 
 lemma [code]:
   \<open>mask (Suc n) = push_bit n (1 :: uint16) OR mask n\<close>
   \<open>mask 0 = (0 :: uint16)\<close>
   by (simp_all add: mask_Suc_exp push_bit_of_1)
 
 lemma [code]:
   \<open>Bit_Operations.set_bit n w = w OR push_bit n 1\<close> for w :: uint16
   by (fact set_bit_eq_or)
 
 lemma [code]:
   \<open>unset_bit n w = w AND NOT (push_bit n 1)\<close> for w :: uint16
   by (fact unset_bit_eq_and_not)
 
 lemma [code]:
   \<open>flip_bit n w = w XOR push_bit n 1\<close> for w :: uint16
   by (fact flip_bit_eq_xor)
 
-instance uint16 :: semiring_bit_syntax ..
-
-context
-  includes lifting_syntax
-begin
-
-lemma shiftl_uint16_transfer [transfer_rule]:
-  \<open>(cr_uint16 ===> (=) ===> cr_uint16) (\<lambda>k n. push_bit n k) (<<)\<close>
-  unfolding shiftl_eq_push_bit by transfer_prover
-
-lemma shiftr_uint16_transfer [transfer_rule]:
-  \<open>(cr_uint16 ===> (=) ===> cr_uint16) (\<lambda>k n. drop_bit n k) (>>)\<close>
-  unfolding shiftr_eq_drop_bit by transfer_prover
-
-end
-
 instantiation uint16 :: lsb
 begin
 lift_definition lsb_uint16 :: \<open>uint16 \<Rightarrow> bool\<close> is lsb .
 instance by (standard; transfer)
   (fact lsb_odd)
 end
 
 instantiation uint16 :: msb
 begin
 lift_definition msb_uint16 :: \<open>uint16 \<Rightarrow> bool\<close> is msb .
 instance ..
 end
 
 setup \<open>Context.theory_map (Name_Space.map_naming (Name_Space.qualified_path true \<^binding>\<open>Generic\<close>))\<close>
 
 instantiation uint16 :: set_bit
 begin
 lift_definition set_bit_uint16 :: \<open>uint16 \<Rightarrow> nat \<Rightarrow> bool \<Rightarrow> uint16\<close> is set_bit .
 instance
   apply standard
   apply transfer
   apply (simp add: bit_simps)
   done
 end
 
 setup \<open>Context.theory_map (Name_Space.map_naming (Name_Space.parent_path))\<close>
 
 instantiation uint16 :: bit_comprehension begin
 lift_definition set_bits_uint16 :: "(nat \<Rightarrow> bool) \<Rightarrow> uint16" is "set_bits" .
 instance by (standard; transfer) (fact set_bits_bit_eq)
 end
 
 lemmas [code] = bit_uint16.rep_eq lsb_uint16.rep_eq msb_uint16.rep_eq
 
 instantiation uint16 :: equal begin
 lift_definition equal_uint16 :: "uint16 \<Rightarrow> uint16 \<Rightarrow> bool" is "equal_class.equal" .
 instance by standard (transfer, simp add: equal_eq)
 end
 
 lemmas [code] = equal_uint16.rep_eq
 
 instantiation uint16 :: size begin
 lift_definition size_uint16 :: "uint16 \<Rightarrow> nat" is "size" .
 instance ..
 end
 
 lemmas [code] = size_uint16.rep_eq
 
 lift_definition sshiftr_uint16 :: "uint16 \<Rightarrow> nat \<Rightarrow> uint16" (infixl ">>>" 55) is \<open>\<lambda>w n. signed_drop_bit n w\<close> .
 
 lift_definition uint16_of_int :: "int \<Rightarrow> uint16" is "word_of_int" .
 
 definition uint16_of_nat :: "nat \<Rightarrow> uint16"
 where "uint16_of_nat = uint16_of_int \<circ> int"
 
 lift_definition int_of_uint16 :: "uint16 \<Rightarrow> int" is "uint" .
 lift_definition nat_of_uint16 :: "uint16 \<Rightarrow> nat" is "unat" .
 
 definition integer_of_uint16 :: "uint16 \<Rightarrow> integer"
 where "integer_of_uint16 = integer_of_int o int_of_uint16"
 
 text \<open>Use pretty numerals from integer for pretty printing\<close>
 
 context includes integer.lifting begin
 
 lift_definition Uint16 :: "integer \<Rightarrow> uint16" is "word_of_int" .
 
 lemma Rep_uint16_numeral [simp]: "Rep_uint16 (numeral n) = numeral n"
 by(induction n)(simp_all add: one_uint16_def Abs_uint16_inverse numeral.simps plus_uint16_def)
 
 lemma Rep_uint16_neg_numeral [simp]: "Rep_uint16 (- numeral n) = - numeral n"
 by(simp only: uminus_uint16_def)(simp add: Abs_uint16_inverse)
 
 lemma numeral_uint16_transfer [transfer_rule]:
   "(rel_fun (=) cr_uint16) numeral numeral"
 by(auto simp add: cr_uint16_def)
 
 lemma numeral_uint16 [code_unfold]: "numeral n = Uint16 (numeral n)"
 by transfer simp
 
 lemma neg_numeral_uint16 [code_unfold]: "- numeral n = Uint16 (- numeral n)"
 by transfer(simp add: cr_uint16_def)
 
 end
 
 lemma Abs_uint16_numeral [code_post]: "Abs_uint16 (numeral n) = numeral n"
 by(induction n)(simp_all add: one_uint16_def numeral.simps plus_uint16_def Abs_uint16_inverse)
 
 lemma Abs_uint16_0 [code_post]: "Abs_uint16 0 = 0"
 by(simp add: zero_uint16_def)
 
 lemma Abs_uint16_1 [code_post]: "Abs_uint16 1 = 1"
 by(simp add: one_uint16_def)
 
 section \<open>Code setup\<close>
 
 code_printing code_module Uint16 \<rightharpoonup> (SML_word)
 \<open>(* Test that words can handle numbers between 0 and 15 *)
 val _ = if 4 <= Word.wordSize then () else raise (Fail ("wordSize less than 4"));
 
 structure Uint16 : sig
   val set_bit : Word16.word -> IntInf.int -> bool -> Word16.word
   val shiftl : Word16.word -> IntInf.int -> Word16.word
   val shiftr : Word16.word -> IntInf.int -> Word16.word
   val shiftr_signed : Word16.word -> IntInf.int -> Word16.word
   val test_bit : Word16.word -> IntInf.int -> bool
 end = struct
 
 fun set_bit x n b =
   let val mask = Word16.<< (0wx1, Word.fromLargeInt (IntInf.toLarge n))
   in if b then Word16.orb (x, mask)
      else Word16.andb (x, Word16.notb mask)
   end
 
 fun shiftl x n =
   Word16.<< (x, Word.fromLargeInt (IntInf.toLarge n))
 
 fun shiftr x n =
   Word16.>> (x, Word.fromLargeInt (IntInf.toLarge n))
 
 fun shiftr_signed x n =
   Word16.~>> (x, Word.fromLargeInt (IntInf.toLarge n))
 
 fun test_bit x n =
   Word16.andb (x, Word16.<< (0wx1, Word.fromLargeInt (IntInf.toLarge n))) <> Word16.fromInt 0
 
 end; (* struct Uint16 *)\<close>
 code_reserved SML_word Uint16
 
 code_printing code_module Uint16 \<rightharpoonup> (Haskell)
  \<open>module Uint16(Int16, Word16) where
 
   import Data.Int(Int16)
   import Data.Word(Word16)\<close>
 code_reserved Haskell Uint16
 
 text \<open>Scala provides unsigned 16-bit numbers as Char.\<close>
 
 code_printing code_module Uint16 \<rightharpoonup> (Scala)
 \<open>object Uint16 {
 
 def set_bit(x: scala.Char, n: BigInt, b: Boolean) : scala.Char =
   if (b)
     (x | (1.toChar << n.intValue)).toChar
   else
     (x & (1.toChar << n.intValue).unary_~).toChar
 
 def shiftl(x: scala.Char, n: BigInt) : scala.Char = (x << n.intValue).toChar
 
 def shiftr(x: scala.Char, n: BigInt) : scala.Char = (x >>> n.intValue).toChar
 
 def shiftr_signed(x: scala.Char, n: BigInt) : scala.Char = (x.toShort >> n.intValue).toChar
 
 def test_bit(x: scala.Char, n: BigInt) : Boolean = (x & (1.toChar << n.intValue)) != 0
 
 } /* object Uint16 */\<close>
 code_reserved Scala Uint16
 
 text \<open>
   Avoid @{term Abs_uint16} in generated code, use @{term Rep_uint16'} instead. 
   The symbolic implementations for code\_simp use @{term Rep_uint16}.
 
   The new destructor @{term Rep_uint16'} is executable.
   As the simplifier is given the [code abstract] equations literally, 
   we cannot implement @{term Rep_uint16} directly, because that makes code\_simp loop.
 
   If code generation raises Match, some equation probably contains @{term Rep_uint16} 
   ([code abstract] equations for @{typ uint16} may use @{term Rep_uint16} because
   these instances will be folded away.)
 
   To convert @{typ "16 word"} values into @{typ uint16}, use @{term "Abs_uint16'"}.
 \<close>
 
 definition Rep_uint16' where [simp]: "Rep_uint16' = Rep_uint16"
 
 lemma Rep_uint16'_transfer [transfer_rule]:
   "rel_fun cr_uint16 (=) (\<lambda>x. x) Rep_uint16'"
 unfolding Rep_uint16'_def by(rule uint16.rep_transfer)
 
 lemma Rep_uint16'_code [code]: "Rep_uint16' x = (BITS n. bit x n)"
   by transfer (simp add: set_bits_bit_eq)
 
 lift_definition Abs_uint16' :: "16 word \<Rightarrow> uint16" is "\<lambda>x :: 16 word. x" .
 
 lemma Abs_uint16'_code [code]:
   "Abs_uint16' x = Uint16 (integer_of_int (uint x))"
 including integer.lifting by transfer simp
 
 declare [[code drop: "term_of_class.term_of :: uint16 \<Rightarrow> _"]]
 
 lemma term_of_uint16_code [code]:
   defines "TR \<equiv> typerep.Typerep" and "bit0 \<equiv> STR ''Numeral_Type.bit0''" shows
   "term_of_class.term_of x = 
    Code_Evaluation.App (Code_Evaluation.Const (STR ''Uint16.uint16.Abs_uint16'') (TR (STR ''fun'') [TR (STR ''Word.word'') [TR bit0 [TR bit0 [TR bit0 [TR bit0 [TR (STR ''Numeral_Type.num1'') []]]]]], TR (STR ''Uint16.uint16'') []]))
        (term_of_class.term_of (Rep_uint16' x))"
 by(simp add: term_of_anything)
 
 lemma Uin16_code [code abstract]: "Rep_uint16 (Uint16 i) = word_of_int (int_of_integer_symbolic i)"
 unfolding Uint16_def int_of_integer_symbolic_def by(simp add: Abs_uint16_inverse)
 
 code_printing
   type_constructor uint16 \<rightharpoonup>
   (SML_word) "Word16.word" and
   (Haskell) "Uint16.Word16" and
   (Scala) "scala.Char"
 | constant Uint16 \<rightharpoonup>
   (SML_word) "Word16.fromLargeInt (IntInf.toLarge _)" and
   (Haskell) "(Prelude.fromInteger _ :: Uint16.Word16)" and
   (Haskell_Quickcheck) "(Prelude.fromInteger (Prelude.toInteger _) :: Uint16.Word16)" and
   (Scala) "_.charValue"
 | constant "0 :: uint16" \<rightharpoonup>
   (SML_word) "(Word16.fromInt 0)" and
   (Haskell) "(0 :: Uint16.Word16)" and
   (Scala) "0"
 | constant "1 :: uint16" \<rightharpoonup>
   (SML_word) "(Word16.fromInt 1)" and
   (Haskell) "(1 :: Uint16.Word16)" and
   (Scala) "1"
 | constant "plus :: uint16 \<Rightarrow> _ \<Rightarrow> _" \<rightharpoonup>
   (SML_word) "Word16.+ ((_), (_))" and
   (Haskell) infixl 6 "+" and
   (Scala) "(_ +/ _).toChar"
 | constant "uminus :: uint16 \<Rightarrow> _" \<rightharpoonup>
   (SML_word) "Word16.~" and
   (Haskell) "negate" and
   (Scala) "(- _).toChar"
 | constant "minus :: uint16 \<Rightarrow> _" \<rightharpoonup>
   (SML_word) "Word16.- ((_), (_))" and
   (Haskell) infixl 6 "-" and
   (Scala) "(_ -/ _).toChar"
 | constant "times :: uint16 \<Rightarrow> _ \<Rightarrow> _" \<rightharpoonup>
   (SML_word) "Word16.* ((_), (_))" and
   (Haskell) infixl 7 "*" and
   (Scala) "(_ */ _).toChar"
 | constant "HOL.equal :: uint16 \<Rightarrow> _ \<Rightarrow> bool" \<rightharpoonup>
   (SML_word) "!((_ : Word16.word) = _)" and
   (Haskell) infix 4 "==" and
   (Scala) infixl 5 "=="
 | class_instance uint16 :: equal \<rightharpoonup> (Haskell) -
 | constant "less_eq :: uint16 \<Rightarrow> _ \<Rightarrow> bool" \<rightharpoonup>
   (SML_word) "Word16.<= ((_), (_))" and
   (Haskell) infix 4 "<=" and
   (Scala) infixl 4 "<="
 | constant "less :: uint16 \<Rightarrow> _ \<Rightarrow> bool" \<rightharpoonup>
   (SML_word) "Word16.< ((_), (_))" and
   (Haskell) infix 4 "<" and
   (Scala) infixl 4 "<"
 | constant "NOT :: uint16 \<Rightarrow> _" \<rightharpoonup>
   (SML_word) "Word16.notb" and
   (Haskell) "Data'_Bits.complement" and
   (Scala) "_.unary'_~.toChar"
 | constant "(AND) :: uint16 \<Rightarrow> _" \<rightharpoonup>
   (SML_word) "Word16.andb ((_),/ (_))" and
   (Haskell) infixl 7 "Data_Bits..&." and
   (Scala) "(_ & _).toChar"
 | constant "(OR) :: uint16 \<Rightarrow> _" \<rightharpoonup>
   (SML_word) "Word16.orb ((_),/ (_))" and
   (Haskell) infixl 5 "Data_Bits..|." and
   (Scala) "(_ | _).toChar"
 | constant "(XOR) :: uint16 \<Rightarrow> _" \<rightharpoonup>
   (SML_word) "Word16.xorb ((_),/ (_))" and
   (Haskell) "Data'_Bits.xor" and
   (Scala) "(_ ^ _).toChar"
 
 definition uint16_div :: "uint16 \<Rightarrow> uint16 \<Rightarrow> uint16" 
 where "uint16_div x y = (if y = 0 then undefined ((div) :: uint16 \<Rightarrow> _) x (0 :: uint16) else x div y)"
 
 definition uint16_mod :: "uint16 \<Rightarrow> uint16 \<Rightarrow> uint16" 
 where "uint16_mod x y = (if y = 0 then undefined ((mod) :: uint16 \<Rightarrow> _) x (0 :: uint16) else x mod y)"
 
 context includes undefined_transfer begin
 
 lemma div_uint16_code [code]: "x div y = (if y = 0 then 0 else uint16_div x y)"
 unfolding uint16_div_def by transfer (simp add: word_div_def)
 
 lemma mod_uint16_code [code]: "x mod y = (if y = 0 then x else uint16_mod x y)"
 unfolding uint16_mod_def by transfer (simp add: word_mod_def)
 
 lemma uint16_div_code [code abstract]:
   "Rep_uint16 (uint16_div x y) =
   (if y = 0 then Rep_uint16 (undefined ((div) :: uint16 \<Rightarrow> _) x (0 :: uint16)) else Rep_uint16 x div Rep_uint16 y)"
 unfolding uint16_div_def by transfer simp
 
 lemma uint16_mod_code [code abstract]:
   "Rep_uint16 (uint16_mod x y) =
   (if y = 0 then Rep_uint16 (undefined ((mod) :: uint16 \<Rightarrow> _) x (0 :: uint16)) else Rep_uint16 x mod Rep_uint16 y)"
 unfolding uint16_mod_def by transfer simp
 
 end
 
 code_printing constant uint16_div \<rightharpoonup>
   (SML_word) "Word16.div ((_), (_))" and
   (Haskell) "Prelude.div" and
   (Scala) "(_ '/ _).toChar"
 | constant uint16_mod \<rightharpoonup>
   (SML_word) "Word16.mod ((_), (_))" and
   (Haskell) "Prelude.mod" and
   (Scala) "(_ % _).toChar"
 
 definition uint16_test_bit :: "uint16 \<Rightarrow> integer \<Rightarrow> bool"
 where [code del]:
   "uint16_test_bit x n =
   (if n < 0 \<or> 15 < n then undefined (bit :: uint16 \<Rightarrow> _) x n
    else bit x (nat_of_integer n))"
 
 lemma test_bit_uint16_code [code]:
   "bit x n \<longleftrightarrow> n < 16 \<and> uint16_test_bit x (integer_of_nat n)"
   including undefined_transfer integer.lifting unfolding uint16_test_bit_def
   by (transfer, simp, transfer, simp)
 
 lemma uint16_test_bit_code [code]:
   "uint16_test_bit w n =
   (if n < 0 \<or> 15 < n then undefined (bit :: uint16 \<Rightarrow> _) w n else bit (Rep_uint16 w) (nat_of_integer n))"
   unfolding uint16_test_bit_def by (simp add: bit_uint16.rep_eq)
 
 code_printing constant uint16_test_bit \<rightharpoonup>
   (SML_word) "Uint16.test'_bit" and
   (Haskell) "Data'_Bits.testBitBounded" and
   (Scala) "Uint16.test'_bit"
 
 definition uint16_set_bit :: "uint16 \<Rightarrow> integer \<Rightarrow> bool \<Rightarrow> uint16"
 where [code del]:
   "uint16_set_bit x n b =
   (if n < 0 \<or> 15 < n then undefined (set_bit :: uint16 \<Rightarrow> _) x n b
    else set_bit x (nat_of_integer n) b)"
 
 lemma set_bit_uint16_code [code]:
   "set_bit x n b = (if n < 16 then uint16_set_bit x (integer_of_nat n) b else x)"
 including undefined_transfer integer.lifting unfolding uint16_set_bit_def
 by(transfer)(auto cong: conj_cong simp add: not_less set_bit_beyond word_size)
 
 lemma uint16_set_bit_code [code abstract]:
   "Rep_uint16 (uint16_set_bit w n b) = 
   (if n < 0 \<or> 15 < n then Rep_uint16 (undefined (set_bit :: uint16 \<Rightarrow> _) w n b)
    else set_bit (Rep_uint16 w) (nat_of_integer n) b)"
 including undefined_transfer unfolding uint16_set_bit_def by transfer simp
 
 code_printing constant uint16_set_bit \<rightharpoonup>
   (SML_word) "Uint16.set'_bit" and
   (Haskell) "Data'_Bits.setBitBounded" and
   (Scala) "Uint16.set'_bit"
 
 lift_definition uint16_set_bits :: "(nat \<Rightarrow> bool) \<Rightarrow> uint16 \<Rightarrow> nat \<Rightarrow> uint16" is set_bits_aux .
 
 lemma uint16_set_bits_code [code]:
   "uint16_set_bits f w n =
   (if n = 0 then w 
    else let n' = n - 1 in uint16_set_bits f ((push_bit 1 w) OR (if f n' then 1 else 0)) n')"
   apply (transfer fixing: n)
   apply (cases n)
-   apply (simp_all add: shiftl_eq_push_bit)
+   apply simp_all
   done
 
 lemma set_bits_uint16 [code]:
   "(BITS n. f n) = uint16_set_bits f 0 16"
 by transfer(simp add: set_bits_conv_set_bits_aux)
 
 
 lemma lsb_code [code]: fixes x :: uint16 shows "lsb x \<longleftrightarrow> bit x 0"
   by transfer (simp add: lsb_odd)
 
 definition uint16_shiftl :: "uint16 \<Rightarrow> integer \<Rightarrow> uint16"
 where [code del]:
   "uint16_shiftl x n = (if n < 0 \<or> 16 \<le> n then undefined (push_bit :: nat \<Rightarrow> uint16 \<Rightarrow> _) x n else push_bit (nat_of_integer n) x)"
 
 lemma shiftl_uint16_code [code]: "push_bit n x = (if n < 16 then uint16_shiftl x (integer_of_nat n) else 0)"
   including undefined_transfer integer.lifting unfolding uint16_shiftl_def
   by transfer simp
 
 lemma uint16_shiftl_code [code abstract]:
   "Rep_uint16 (uint16_shiftl w n) =
   (if n < 0 \<or> 16 \<le> n then Rep_uint16 (undefined (push_bit :: nat \<Rightarrow> uint16 \<Rightarrow> _) w n)
    else push_bit (nat_of_integer n) (Rep_uint16 w))"
   including undefined_transfer unfolding uint16_shiftl_def
   by transfer simp
 
 code_printing constant uint16_shiftl \<rightharpoonup>
   (SML_word) "Uint16.shiftl" and
   (Haskell) "Data'_Bits.shiftlBounded" and
   (Scala) "Uint16.shiftl"
 
 definition uint16_shiftr :: "uint16 \<Rightarrow> integer \<Rightarrow> uint16"
 where [code del]:
   "uint16_shiftr x n = (if n < 0 \<or> 16 \<le> n then undefined (drop_bit :: nat \<Rightarrow> uint16 \<Rightarrow> _) x n else drop_bit (nat_of_integer n) x)"
 
 lemma shiftr_uint16_code [code]: "drop_bit n x = (if n < 16 then uint16_shiftr x (integer_of_nat n) else 0)"
   including undefined_transfer integer.lifting unfolding uint16_shiftr_def
   by transfer simp
 
 lemma uint16_shiftr_code [code abstract]:
   "Rep_uint16 (uint16_shiftr w n) =
   (if n < 0 \<or> 16 \<le> n then Rep_uint16 (undefined (drop_bit :: nat \<Rightarrow> uint16 \<Rightarrow> _) w n)
    else drop_bit (nat_of_integer n) (Rep_uint16 w))"
 including undefined_transfer unfolding uint16_shiftr_def by transfer simp
 
 code_printing constant uint16_shiftr \<rightharpoonup>
   (SML_word) "Uint16.shiftr" and
   (Haskell) "Data'_Bits.shiftrBounded" and
   (Scala) "Uint16.shiftr"
 
 definition uint16_sshiftr :: "uint16 \<Rightarrow> integer \<Rightarrow> uint16"
 where [code del]:
   "uint16_sshiftr x n =
   (if n < 0 \<or> 16 \<le> n then undefined sshiftr_uint16 x n else sshiftr_uint16 x (nat_of_integer n))"
 
 lemma sshiftr_uint16_code [code]:
   "x >>> n = 
   (if n < 16 then uint16_sshiftr x (integer_of_nat n) else if bit x 15 then -1 else 0)"
 including undefined_transfer integer.lifting unfolding uint16_sshiftr_def
 by transfer (simp add: not_less signed_drop_bit_beyond word_size)
 
 lemma uint16_sshiftr_code [code abstract]:
   "Rep_uint16 (uint16_sshiftr w n) =
   (if n < 0 \<or> 16 \<le> n then Rep_uint16 (undefined sshiftr_uint16 w n)
    else signed_drop_bit (nat_of_integer n) (Rep_uint16 w))"
 including undefined_transfer unfolding uint16_sshiftr_def by transfer simp
 
 code_printing constant uint16_sshiftr \<rightharpoonup>
   (SML_word) "Uint16.shiftr'_signed" and
   (Haskell) 
     "(Prelude.fromInteger (Prelude.toInteger (Data'_Bits.shiftrBounded (Prelude.fromInteger (Prelude.toInteger _) :: Uint16.Int16) _)) :: Uint16.Word16)" and
   (Scala) "Uint16.shiftr'_signed"
 
 lemma uint16_msb_test_bit: "msb x \<longleftrightarrow> bit (x :: uint16) 15"
   by transfer (simp add: msb_word_iff_bit)
 
 lemma msb_uint16_code [code]: "msb x \<longleftrightarrow> uint16_test_bit x 15"
   by (simp add: uint16_test_bit_def uint16_msb_test_bit)
 
 lemma uint16_of_int_code [code]: "uint16_of_int i = Uint16 (integer_of_int i)"
 including integer.lifting by transfer simp
 
 lemma int_of_uint16_code [code]:
   "int_of_uint16 x = int_of_integer (integer_of_uint16 x)"
 by(simp add: integer_of_uint16_def)
 
 lemma nat_of_uint16_code [code]:
   "nat_of_uint16 x = nat_of_integer (integer_of_uint16 x)"
 unfolding integer_of_uint16_def including integer.lifting by transfer simp
 
 lemma integer_of_uint16_code [code]:
   "integer_of_uint16 n = integer_of_int (uint (Rep_uint16' n))"
 unfolding integer_of_uint16_def by transfer auto
 
 code_printing
   constant "integer_of_uint16" \<rightharpoonup>
   (SML_word) "Word16.toInt _ : IntInf.int" and
   (Haskell) "Prelude.toInteger" and
   (Scala) "BigInt"
 
 section \<open>Quickcheck setup\<close>
 
 definition uint16_of_natural :: "natural \<Rightarrow> uint16"
 where "uint16_of_natural x \<equiv> Uint16 (integer_of_natural x)"
 
 instantiation uint16 :: "{random, exhaustive, full_exhaustive}" begin
 definition "random_uint16 \<equiv> qc_random_cnv uint16_of_natural"
 definition "exhaustive_uint16 \<equiv> qc_exhaustive_cnv uint16_of_natural"
 definition "full_exhaustive_uint16 \<equiv> qc_full_exhaustive_cnv uint16_of_natural"
 instance ..
 end
 
 instantiation uint16 :: narrowing begin
 
 interpretation quickcheck_narrowing_samples
   "\<lambda>i. let x = Uint16 i in (x, 0xFFFF - x)" "0"
   "Typerep.Typerep (STR ''Uint16.uint16'') []" .
 
 definition "narrowing_uint16 d = qc_narrowing_drawn_from (narrowing_samples d) d"
 declare [[code drop: "partial_term_of :: uint16 itself \<Rightarrow> _"]]
 lemmas partial_term_of_uint16 [code] = partial_term_of_code
 
 instance ..
 end
 
 no_notation sshiftr_uint16 (infixl ">>>" 55)
 
 end
diff --git a/thys/Native_Word/Uint32.thy b/thys/Native_Word/Uint32.thy
--- a/thys/Native_Word/Uint32.thy
+++ b/thys/Native_Word/Uint32.thy
@@ -1,785 +1,769 @@
 (*  Title:      Uint32.thy
     Author:     Andreas Lochbihler, ETH Zurich
 *)
 
 chapter \<open>Unsigned words of 32 bits\<close>
 
 theory Uint32 imports
   Code_Target_Word_Base
 begin
 
 declare prod.Quotient[transfer_rule]
 
 section \<open>Type definition and primitive operations\<close>
 
 typedef uint32 = "UNIV :: 32 word set" .. 
 
 setup_lifting type_definition_uint32
 
 text \<open>Use an abstract type for code generation to disable pattern matching on @{term Abs_uint32}.\<close>
 declare Rep_uint32_inverse[code abstype]
 
 declare Quotient_uint32[transfer_rule]
 
 instantiation uint32 :: comm_ring_1
 begin
 lift_definition zero_uint32 :: uint32 is "0 :: 32 word" .
 lift_definition one_uint32 :: uint32 is "1" .
 lift_definition plus_uint32 :: "uint32 \<Rightarrow> uint32 \<Rightarrow> uint32" is "(+) :: 32 word \<Rightarrow> _" .
 lift_definition minus_uint32 :: "uint32 \<Rightarrow> uint32 \<Rightarrow> uint32" is "(-)" .
 lift_definition uminus_uint32 :: "uint32 \<Rightarrow> uint32" is uminus .
 lift_definition times_uint32 :: "uint32 \<Rightarrow> uint32 \<Rightarrow> uint32" is "(*)" .
 instance by (standard; transfer) (simp_all add: algebra_simps)
 end
 
 instantiation uint32 :: semiring_modulo
 begin
 lift_definition divide_uint32 :: "uint32 \<Rightarrow> uint32 \<Rightarrow> uint32" is "(div)" .
 lift_definition modulo_uint32 :: "uint32 \<Rightarrow> uint32 \<Rightarrow> uint32" is "(mod)" .
 instance by (standard; transfer) (fact word_mod_div_equality)
 end
 
 instantiation uint32 :: linorder begin
 lift_definition less_uint32 :: "uint32 \<Rightarrow> uint32 \<Rightarrow> bool" is "(<)" .
 lift_definition less_eq_uint32 :: "uint32 \<Rightarrow> uint32 \<Rightarrow> bool" is "(\<le>)" .
 instance by (standard; transfer) (simp_all add: less_le_not_le linear)
 end
 
 lemmas [code] = less_uint32.rep_eq less_eq_uint32.rep_eq
 
 context
   includes lifting_syntax
   notes
     transfer_rule_of_bool [transfer_rule]
     transfer_rule_numeral [transfer_rule]
 begin
 
 lemma [transfer_rule]:
   "((=) ===> cr_uint32) of_bool of_bool"
   by transfer_prover
 
 lemma transfer_rule_numeral_uint [transfer_rule]:
   "((=) ===> cr_uint32) numeral numeral"
   by transfer_prover
 
 lemma [transfer_rule]:
   \<open>(cr_uint32 ===> (\<longleftrightarrow>)) even ((dvd) 2 :: uint32 \<Rightarrow> bool)\<close>
   by (unfold dvd_def) transfer_prover
 
 end
 
 instantiation uint32:: semiring_bits
 begin
 
 lift_definition bit_uint32 :: \<open>uint32 \<Rightarrow> nat \<Rightarrow> bool\<close> is bit .
 
 instance
   by (standard; transfer)
     (fact bit_iff_odd even_iff_mod_2_eq_zero odd_iff_mod_2_eq_one odd_one bits_induct
        bits_div_0 bits_div_by_1 bits_mod_div_trivial even_succ_div_2
        even_mask_div_iff exp_div_exp_eq div_exp_eq mod_exp_eq mult_exp_mod_exp_eq
        div_exp_mod_exp_eq even_mult_exp_div_exp_iff)+
 
 end
 
 instantiation uint32 :: semiring_bit_shifts
 begin
 lift_definition push_bit_uint32 :: \<open>nat \<Rightarrow> uint32 \<Rightarrow> uint32\<close> is push_bit .
 lift_definition drop_bit_uint32 :: \<open>nat \<Rightarrow> uint32 \<Rightarrow> uint32\<close> is drop_bit .
 lift_definition take_bit_uint32 :: \<open>nat \<Rightarrow> uint32 \<Rightarrow> uint32\<close> is take_bit .
 instance by (standard; transfer)
   (fact push_bit_eq_mult drop_bit_eq_div take_bit_eq_mod)+
 end
 
 instantiation uint32 :: ring_bit_operations
 begin
 lift_definition not_uint32 :: \<open>uint32 \<Rightarrow> uint32\<close> is NOT .
 lift_definition and_uint32 :: \<open>uint32 \<Rightarrow> uint32 \<Rightarrow> uint32\<close> is \<open>(AND)\<close> .
 lift_definition or_uint32 :: \<open>uint32 \<Rightarrow> uint32 \<Rightarrow> uint32\<close> is \<open>(OR)\<close> .
 lift_definition xor_uint32 :: \<open>uint32 \<Rightarrow> uint32 \<Rightarrow> uint32\<close> is \<open>(XOR)\<close> .
 lift_definition mask_uint32 :: \<open>nat \<Rightarrow> uint32\<close> is mask .
 lift_definition set_bit_uint32 :: \<open>nat \<Rightarrow> uint32 \<Rightarrow> uint32\<close> is \<open>Bit_Operations.set_bit\<close> .
 lift_definition unset_bit_uint32 :: \<open>nat \<Rightarrow> uint32 \<Rightarrow> uint32\<close> is \<open>unset_bit\<close> .
 lift_definition flip_bit_uint32 :: \<open>nat \<Rightarrow> uint32 \<Rightarrow> uint32\<close> is \<open>flip_bit\<close> .
 instance by (standard; transfer)
   (simp_all add: bit_simps mask_eq_decr_exp minus_eq_not_minus_1 set_bit_def flip_bit_def)
 end
 
 lemma [code]:
   \<open>take_bit n a = a AND mask n\<close> for a :: uint32
   by (fact take_bit_eq_mask)
 
 lemma [code]:
   \<open>mask (Suc n) = push_bit n (1 :: uint32) OR mask n\<close>
   \<open>mask 0 = (0 :: uint32)\<close>
   by (simp_all add: mask_Suc_exp push_bit_of_1)
 
 lemma [code]:
   \<open>Bit_Operations.set_bit n w = w OR push_bit n 1\<close> for w :: uint32
   by (fact set_bit_eq_or)
 
 lemma [code]:
   \<open>unset_bit n w = w AND NOT (push_bit n 1)\<close> for w :: uint32
   by (fact unset_bit_eq_and_not)
 
 lemma [code]:
   \<open>flip_bit n w = w XOR push_bit n 1\<close> for w :: uint32
   by (fact flip_bit_eq_xor)
 
-instance uint32 :: semiring_bit_syntax ..
-
-context
-  includes lifting_syntax
-begin
-
-lemma shiftl_uint32_transfer [transfer_rule]:
-  \<open>(cr_uint32 ===> (=) ===> cr_uint32) (\<lambda>k n. push_bit n k) (<<)\<close>
-  unfolding shiftl_eq_push_bit by transfer_prover
-
-lemma shiftr_uint32_transfer [transfer_rule]:
-  \<open>(cr_uint32 ===> (=) ===> cr_uint32) (\<lambda>k n. drop_bit n k) (>>)\<close>
-  unfolding shiftr_eq_drop_bit by transfer_prover
-
-end
-
 instantiation uint32 :: lsb
 begin
 lift_definition lsb_uint32 :: \<open>uint32 \<Rightarrow> bool\<close> is lsb .
 instance by (standard; transfer)
   (fact lsb_odd)
 end
 
 instantiation uint32 :: msb
 begin
 lift_definition msb_uint32 :: \<open>uint32 \<Rightarrow> bool\<close> is msb .
 instance ..
 end
 
 setup \<open>Context.theory_map (Name_Space.map_naming (Name_Space.qualified_path true \<^binding>\<open>Generic\<close>))\<close>
 
 instantiation uint32 :: set_bit
 begin
 lift_definition set_bit_uint32 :: \<open>uint32 \<Rightarrow> nat \<Rightarrow> bool \<Rightarrow> uint32\<close> is set_bit .
 instance
   apply standard
   apply transfer
   apply (simp add: bit_simps)
   done
 end
 
 setup \<open>Context.theory_map (Name_Space.map_naming (Name_Space.parent_path))\<close>
 
 instantiation uint32 :: bit_comprehension begin
 lift_definition set_bits_uint32 :: "(nat \<Rightarrow> bool) \<Rightarrow> uint32" is "set_bits" .
 instance by (standard; transfer) (fact set_bits_bit_eq)
 end
 
 lemmas [code] = bit_uint32.rep_eq lsb_uint32.rep_eq msb_uint32.rep_eq
 
 instantiation uint32 :: equal begin
 lift_definition equal_uint32 :: "uint32 \<Rightarrow> uint32 \<Rightarrow> bool" is "equal_class.equal" .
 instance by standard (transfer, simp add: equal_eq)
 end
 
 lemmas [code] = equal_uint32.rep_eq
 
 instantiation uint32 :: size begin
 lift_definition size_uint32 :: "uint32 \<Rightarrow> nat" is "size" .
 instance ..
 end
 
 lemmas [code] = size_uint32.rep_eq                                                    
 
 lift_definition sshiftr_uint32 :: "uint32 \<Rightarrow> nat \<Rightarrow> uint32" (infixl ">>>" 55) is \<open>\<lambda>w n. signed_drop_bit n w\<close> .
 
 lift_definition uint32_of_int :: "int \<Rightarrow> uint32" is "word_of_int" .
 
 definition uint32_of_nat :: "nat \<Rightarrow> uint32"
 where "uint32_of_nat = uint32_of_int \<circ> int"
 
 lift_definition int_of_uint32 :: "uint32 \<Rightarrow> int" is "uint" .
 lift_definition nat_of_uint32 :: "uint32 \<Rightarrow> nat" is "unat" .
 
 definition integer_of_uint32 :: "uint32 \<Rightarrow> integer"
 where "integer_of_uint32 = integer_of_int o int_of_uint32"
 
 text \<open>Use pretty numerals from integer for pretty printing\<close>
 
 context includes integer.lifting begin
 
 lift_definition Uint32 :: "integer \<Rightarrow> uint32" is "word_of_int" .
 
 lemma Rep_uint32_numeral [simp]: "Rep_uint32 (numeral n) = numeral n"
 by(induction n)(simp_all add: one_uint32_def Abs_uint32_inverse numeral.simps plus_uint32_def)
 
 lemma numeral_uint32_transfer [transfer_rule]:
   "(rel_fun (=) cr_uint32) numeral numeral"
 by(auto simp add: cr_uint32_def)
 
 lemma numeral_uint32 [code_unfold]: "numeral n = Uint32 (numeral n)"
 by transfer simp
 
 lemma Rep_uint32_neg_numeral [simp]: "Rep_uint32 (- numeral n) = - numeral n"
 by(simp only: uminus_uint32_def)(simp add: Abs_uint32_inverse)
 
 lemma neg_numeral_uint32 [code_unfold]: "- numeral n = Uint32 (- numeral n)"
 by transfer(simp add: cr_uint32_def)
 
 end
 
 lemma Abs_uint32_numeral [code_post]: "Abs_uint32 (numeral n) = numeral n"
 by(induction n)(simp_all add: one_uint32_def numeral.simps plus_uint32_def Abs_uint32_inverse)
 
 lemma Abs_uint32_0 [code_post]: "Abs_uint32 0 = 0"
 by(simp add: zero_uint32_def)
 
 lemma Abs_uint32_1 [code_post]: "Abs_uint32 1 = 1"
 by(simp add: one_uint32_def)
 
 section \<open>Code setup\<close>
 
 code_printing code_module Uint32 \<rightharpoonup> (SML)
 \<open>(* Test that words can handle numbers between 0 and 31 *)
 val _ = if 5 <= Word.wordSize then () else raise (Fail ("wordSize less than 5"));
 
 structure Uint32 : sig
   val set_bit : Word32.word -> IntInf.int -> bool -> Word32.word
   val shiftl : Word32.word -> IntInf.int -> Word32.word
   val shiftr : Word32.word -> IntInf.int -> Word32.word
   val shiftr_signed : Word32.word -> IntInf.int -> Word32.word
   val test_bit : Word32.word -> IntInf.int -> bool
 end = struct
 
 fun set_bit x n b =
   let val mask = Word32.<< (0wx1, Word.fromLargeInt (IntInf.toLarge n))
   in if b then Word32.orb (x, mask)
      else Word32.andb (x, Word32.notb mask)
   end
 
 fun shiftl x n =
   Word32.<< (x, Word.fromLargeInt (IntInf.toLarge n))
 
 fun shiftr x n =
   Word32.>> (x, Word.fromLargeInt (IntInf.toLarge n))
 
 fun shiftr_signed x n =
   Word32.~>> (x, Word.fromLargeInt (IntInf.toLarge n))
 
 fun test_bit x n =
   Word32.andb (x, Word32.<< (0wx1, Word.fromLargeInt (IntInf.toLarge n))) <> Word32.fromInt 0
 
 end; (* struct Uint32 *)\<close>
 code_reserved SML Uint32
 
 code_printing code_module Uint32 \<rightharpoonup> (Haskell)
  \<open>module Uint32(Int32, Word32) where
 
   import Data.Int(Int32)
   import Data.Word(Word32)\<close>
 code_reserved Haskell Uint32
 
 text \<open>
   OCaml and Scala provide only signed 32bit numbers, so we use these and 
   implement sign-sensitive operations like comparisons manually.
 \<close>
 code_printing code_module "Uint32" \<rightharpoonup> (OCaml)
 \<open>module Uint32 : sig
   val less : int32 -> int32 -> bool
   val less_eq : int32 -> int32 -> bool
   val set_bit : int32 -> Z.t -> bool -> int32
   val shiftl : int32 -> Z.t -> int32
   val shiftr : int32 -> Z.t -> int32
   val shiftr_signed : int32 -> Z.t -> int32
   val test_bit : int32 -> Z.t -> bool
 end = struct
 
 (* negative numbers have their highest bit set, 
    so they are greater than positive ones *)
 let less x y =
   if Int32.compare x Int32.zero < 0 then
     Int32.compare y Int32.zero < 0 && Int32.compare x y < 0
   else Int32.compare y Int32.zero < 0 || Int32.compare x y < 0;;
 
 let less_eq x y =
   if Int32.compare x Int32.zero < 0 then
     Int32.compare y Int32.zero < 0 && Int32.compare x y <= 0
   else Int32.compare y Int32.zero < 0 || Int32.compare x y <= 0;;
 
 let set_bit x n b =
   let mask = Int32.shift_left Int32.one (Z.to_int n)
   in if b then Int32.logor x mask
      else Int32.logand x (Int32.lognot mask);;
 
 let shiftl x n = Int32.shift_left x (Z.to_int n);;
 
 let shiftr x n = Int32.shift_right_logical x (Z.to_int n);;
 
 let shiftr_signed x n = Int32.shift_right x (Z.to_int n);;
 
 let test_bit x n =
   Int32.compare 
     (Int32.logand x (Int32.shift_left Int32.one (Z.to_int n)))
     Int32.zero
   <> 0;;
 
 end;; (*struct Uint32*)\<close>
 code_reserved OCaml Uint32
 
 code_printing code_module Uint32 \<rightharpoonup> (Scala)
 \<open>object Uint32 {
 
 def less(x: Int, y: Int) : Boolean =
   if (x < 0) y < 0 && x < y
   else y < 0 || x < y
 
 def less_eq(x: Int, y: Int) : Boolean =
   if (x < 0) y < 0 && x <= y
   else y < 0 || x <= y
 
 def set_bit(x: Int, n: BigInt, b: Boolean) : Int =
   if (b)
     x | (1 << n.intValue)
   else
     x & (1 << n.intValue).unary_~
 
 def shiftl(x: Int, n: BigInt) : Int = x << n.intValue
 
 def shiftr(x: Int, n: BigInt) : Int = x >>> n.intValue
 
 def shiftr_signed(x: Int, n: BigInt) : Int = x >> n.intValue
 
 def test_bit(x: Int, n: BigInt) : Boolean =
   (x & (1 << n.intValue)) != 0
 
 } /* object Uint32 */\<close>
 code_reserved Scala Uint32
 
 text \<open>
   OCaml's conversion from Big\_int to int32 demands that the value fits int a signed 32-bit integer.
   The following justifies the implementation.
 \<close>
 
 definition Uint32_signed :: "integer \<Rightarrow> uint32" 
 where "Uint32_signed i = (if i < -(0x80000000) \<or> i \<ge> 0x80000000 then undefined Uint32 i else Uint32 i)"
 
 lemma Uint32_code [code]:
   "Uint32 i = 
   (let i' = i AND 0xFFFFFFFF
    in if bit i' 31 then Uint32_signed (i' - 0x100000000) else Uint32_signed i')"
   including undefined_transfer integer.lifting unfolding Uint32_signed_def
   apply transfer
   apply (subst word_of_int_via_signed)
-     apply (auto simp add: shiftl_eq_push_bit push_bit_of_1 mask_eq_exp_minus_1 word_of_int_via_signed cong del: if_cong)
+     apply (auto simp add: push_bit_of_1 mask_eq_exp_minus_1 word_of_int_via_signed cong del: if_cong)
   done
 
 lemma Uint32_signed_code [code abstract]:
   "Rep_uint32 (Uint32_signed i) = 
   (if i < -(0x80000000) \<or> i \<ge> 0x80000000 then Rep_uint32 (undefined Uint32 i) else word_of_int (int_of_integer_symbolic i))"
 unfolding Uint32_signed_def Uint32_def int_of_integer_symbolic_def word_of_integer_def
 by(simp add: Abs_uint32_inverse)
 
 text \<open>
   Avoid @{term Abs_uint32} in generated code, use @{term Rep_uint32'} instead. 
   The symbolic implementations for code\_simp use @{term Rep_uint32}.
 
   The new destructor @{term Rep_uint32'} is executable.
   As the simplifier is given the [code abstract] equations literally, 
   we cannot implement @{term Rep_uint32} directly, because that makes code\_simp loop.
 
   If code generation raises Match, some equation probably contains @{term Rep_uint32} 
   ([code abstract] equations for @{typ uint32} may use @{term Rep_uint32} because
   these instances will be folded away.)
 
   To convert @{typ "32 word"} values into @{typ uint32}, use @{term "Abs_uint32'"}.
 \<close>
 
 definition Rep_uint32' where [simp]: "Rep_uint32' = Rep_uint32"
 
 lemma Rep_uint32'_transfer [transfer_rule]:
   "rel_fun cr_uint32 (=) (\<lambda>x. x) Rep_uint32'"
 unfolding Rep_uint32'_def by(rule uint32.rep_transfer)
 
 lemma Rep_uint32'_code [code]: "Rep_uint32' x = (BITS n. bit x n)"
   by transfer (simp add: set_bits_bit_eq) 
 
 lift_definition Abs_uint32' :: "32 word \<Rightarrow> uint32" is "\<lambda>x :: 32 word. x" .
 
 lemma Abs_uint32'_code [code]:
   "Abs_uint32' x = Uint32 (integer_of_int (uint x))"
 including integer.lifting by transfer simp
 
 declare [[code drop: "term_of_class.term_of :: uint32 \<Rightarrow> _"]]
 
 lemma term_of_uint32_code [code]:
   defines "TR \<equiv> typerep.Typerep" and "bit0 \<equiv> STR ''Numeral_Type.bit0''" 
   shows
   "term_of_class.term_of x = 
    Code_Evaluation.App (Code_Evaluation.Const (STR ''Uint32.uint32.Abs_uint32'') (TR (STR ''fun'') [TR (STR ''Word.word'') [TR bit0 [TR bit0 [TR bit0 [TR bit0 [TR bit0 [TR (STR ''Numeral_Type.num1'') []]]]]]], TR (STR ''Uint32.uint32'') []]))
        (term_of_class.term_of (Rep_uint32' x))"
 by(simp add: term_of_anything)
 
 code_printing
   type_constructor uint32 \<rightharpoonup>
   (SML) "Word32.word" and
   (Haskell) "Uint32.Word32" and
   (OCaml) "int32" and
   (Scala) "Int" and
   (Eval) "Word32.word"
 | constant Uint32 \<rightharpoonup>
   (SML) "Word32.fromLargeInt (IntInf.toLarge _)" and
   (Haskell) "(Prelude.fromInteger _ :: Uint32.Word32)" and
   (Haskell_Quickcheck) "(Prelude.fromInteger (Prelude.toInteger _) :: Uint32.Word32)" and
   (Scala) "_.intValue"
 | constant Uint32_signed \<rightharpoonup>
   (OCaml) "Z.to'_int32"
 | constant "0 :: uint32" \<rightharpoonup>
   (SML) "(Word32.fromInt 0)" and
   (Haskell) "(0 :: Uint32.Word32)" and
   (OCaml) "Int32.zero" and
   (Scala) "0"
 | constant "1 :: uint32" \<rightharpoonup>
   (SML) "(Word32.fromInt 1)" and
   (Haskell) "(1 :: Uint32.Word32)" and
   (OCaml) "Int32.one" and
   (Scala) "1"
 | constant "plus :: uint32 \<Rightarrow> _ " \<rightharpoonup>
   (SML) "Word32.+ ((_), (_))" and
   (Haskell) infixl 6 "+" and
   (OCaml) "Int32.add" and
   (Scala) infixl 7 "+"
 | constant "uminus :: uint32 \<Rightarrow> _" \<rightharpoonup>
   (SML) "Word32.~" and
   (Haskell) "negate" and
   (OCaml) "Int32.neg" and
   (Scala) "!(- _)"
 | constant "minus :: uint32 \<Rightarrow> _" \<rightharpoonup>
   (SML) "Word32.- ((_), (_))" and
   (Haskell) infixl 6 "-" and
   (OCaml) "Int32.sub" and
   (Scala) infixl 7 "-"
 | constant "times :: uint32 \<Rightarrow> _ \<Rightarrow> _" \<rightharpoonup>
   (SML) "Word32.* ((_), (_))" and
   (Haskell) infixl 7 "*" and
   (OCaml) "Int32.mul" and
   (Scala) infixl 8 "*"
 | constant "HOL.equal :: uint32 \<Rightarrow> _ \<Rightarrow> bool" \<rightharpoonup>
   (SML) "!((_ : Word32.word) = _)" and
   (Haskell) infix 4 "==" and
   (OCaml) "(Int32.compare _ _ = 0)" and
   (Scala) infixl 5 "=="
 | class_instance uint32 :: equal \<rightharpoonup>
   (Haskell) -
 | constant "less_eq :: uint32 \<Rightarrow> _ \<Rightarrow> bool" \<rightharpoonup>
   (SML) "Word32.<= ((_), (_))" and
   (Haskell) infix 4 "<=" and
   (OCaml) "Uint32.less'_eq" and
   (Scala) "Uint32.less'_eq"
 | constant "less :: uint32 \<Rightarrow> _ \<Rightarrow> bool" \<rightharpoonup>
   (SML) "Word32.< ((_), (_))" and
   (Haskell) infix 4 "<" and
   (OCaml) "Uint32.less" and
   (Scala) "Uint32.less"
 | constant "NOT :: uint32 \<Rightarrow> _" \<rightharpoonup>
   (SML) "Word32.notb" and
   (Haskell) "Data'_Bits.complement" and
   (OCaml) "Int32.lognot" and
   (Scala) "_.unary'_~"
 | constant "(AND) :: uint32 \<Rightarrow> _" \<rightharpoonup>
   (SML) "Word32.andb ((_),/ (_))" and
   (Haskell) infixl 7 "Data_Bits..&." and
   (OCaml) "Int32.logand" and
   (Scala) infixl 3 "&"
 | constant "(OR) :: uint32 \<Rightarrow> _" \<rightharpoonup>
   (SML) "Word32.orb ((_),/ (_))" and
   (Haskell) infixl 5 "Data_Bits..|." and
   (OCaml) "Int32.logor" and
   (Scala) infixl 1 "|"
 | constant "(XOR) :: uint32 \<Rightarrow> _" \<rightharpoonup>
   (SML) "Word32.xorb ((_),/ (_))" and
   (Haskell) "Data'_Bits.xor" and
   (OCaml) "Int32.logxor" and
   (Scala) infixl 2 "^"
 
 definition uint32_divmod :: "uint32 \<Rightarrow> uint32 \<Rightarrow> uint32 \<times> uint32" where
   "uint32_divmod x y = 
   (if y = 0 then (undefined ((div) :: uint32 \<Rightarrow> _) x (0 :: uint32), undefined ((mod) :: uint32 \<Rightarrow> _) x (0 :: uint32)) 
   else (x div y, x mod y))"
 
 definition uint32_div :: "uint32 \<Rightarrow> uint32 \<Rightarrow> uint32" 
 where "uint32_div x y = fst (uint32_divmod x y)"
 
 definition uint32_mod :: "uint32 \<Rightarrow> uint32 \<Rightarrow> uint32" 
 where "uint32_mod x y = snd (uint32_divmod x y)"
 
 lemma div_uint32_code [code]: "x div y = (if y = 0 then 0 else uint32_div x y)"
 including undefined_transfer unfolding uint32_divmod_def uint32_div_def
 by transfer (simp add: word_div_def)
 
 lemma mod_uint32_code [code]: "x mod y = (if y = 0 then x else uint32_mod x y)"
 including undefined_transfer unfolding uint32_mod_def uint32_divmod_def
 by transfer (simp add: word_mod_def)
 
 definition uint32_sdiv :: "uint32 \<Rightarrow> uint32 \<Rightarrow> uint32"
 where [code del]:
   "uint32_sdiv x y =
    (if y = 0 then undefined ((div) :: uint32 \<Rightarrow> _) x (0 :: uint32)
     else Abs_uint32 (Rep_uint32 x sdiv Rep_uint32 y))"
 
 definition div0_uint32 :: "uint32 \<Rightarrow> uint32"
 where [code del]: "div0_uint32 x = undefined ((div) :: uint32 \<Rightarrow> _) x (0 :: uint32)"
 declare [[code abort: div0_uint32]]
 
 definition mod0_uint32 :: "uint32 \<Rightarrow> uint32"
 where [code del]: "mod0_uint32 x = undefined ((mod) :: uint32 \<Rightarrow> _) x (0 :: uint32)"
 declare [[code abort: mod0_uint32]]
 
 lemma uint32_divmod_code [code]:
   "uint32_divmod x y =
   (if 0x80000000 \<le> y then if x < y then (0, x) else (1, x - y)
    else if y = 0 then (div0_uint32 x, mod0_uint32 x)
-   else let q = (uint32_sdiv (drop_bit 1 x) y) << 1;
+   else let q = push_bit 1 (uint32_sdiv (drop_bit 1 x) y);
             r = x - q * y
         in if r \<ge> y then (q + 1, r - y) else (q, r))"
   including undefined_transfer unfolding uint32_divmod_def uint32_sdiv_def div0_uint32_def mod0_uint32_def
-  by transfer (simp add: divmod_via_sdivmod shiftr_eq_drop_bit shiftl_eq_push_bit ac_simps)
+  by transfer (simp add: divmod_via_sdivmod ac_simps)
 
 lemma uint32_sdiv_code [code abstract]:
   "Rep_uint32 (uint32_sdiv x y) =
    (if y = 0 then Rep_uint32 (undefined ((div) :: uint32 \<Rightarrow> _) x (0 :: uint32))
     else Rep_uint32 x sdiv Rep_uint32 y)"
 unfolding uint32_sdiv_def by(simp add: Abs_uint32_inverse)
 
 text \<open>
   Note that we only need a translation for signed division, but not for the remainder
   because @{thm uint32_divmod_code} computes both with division only.
 \<close>
 
 code_printing
   constant uint32_div \<rightharpoonup>
   (SML) "Word32.div ((_), (_))" and
   (Haskell) "Prelude.div"
 | constant uint32_mod \<rightharpoonup>
   (SML) "Word32.mod ((_), (_))" and
   (Haskell) "Prelude.mod"
 | constant uint32_divmod \<rightharpoonup>
   (Haskell) "divmod"
 | constant uint32_sdiv \<rightharpoonup>
   (OCaml) "Int32.div" and
   (Scala) "_ '/ _"
 
 definition uint32_test_bit :: "uint32 \<Rightarrow> integer \<Rightarrow> bool"
 where [code del]:
   "uint32_test_bit x n =
   (if n < 0 \<or> 31 < n then undefined (bit :: uint32 \<Rightarrow> _) x n
    else bit x (nat_of_integer n))"
 
 lemma test_bit_uint32_code [code]:
   "bit x n \<longleftrightarrow> n < 32 \<and> uint32_test_bit x (integer_of_nat n)"
   including undefined_transfer integer.lifting unfolding uint32_test_bit_def
   by (transfer, simp, transfer, simp)
 
 lemma uint32_test_bit_code [code]:
   "uint32_test_bit w n =
   (if n < 0 \<or> 31 < n then undefined (bit :: uint32 \<Rightarrow> _) w n else bit (Rep_uint32 w) (nat_of_integer n))"
   unfolding uint32_test_bit_def by(simp add: bit_uint32.rep_eq)
 
 code_printing constant uint32_test_bit \<rightharpoonup>
   (SML) "Uint32.test'_bit" and
   (Haskell) "Data'_Bits.testBitBounded" and
   (OCaml) "Uint32.test'_bit" and
   (Scala) "Uint32.test'_bit" and
   (Eval) "(fn w => fn n => if n < 0 orelse 32 <= n then raise (Fail \"argument to uint32'_test'_bit out of bounds\") else Uint32.test'_bit w n)"
 
 definition uint32_set_bit :: "uint32 \<Rightarrow> integer \<Rightarrow> bool \<Rightarrow> uint32"
 where [code del]:
   "uint32_set_bit x n b =
   (if n < 0 \<or> 31 < n then undefined (set_bit :: uint32 \<Rightarrow> _) x n b
    else set_bit x (nat_of_integer n) b)"
 
 lemma set_bit_uint32_code [code]:
   "set_bit x n b = (if n < 32 then uint32_set_bit x (integer_of_nat n) b else x)"
 including undefined_transfer integer.lifting unfolding uint32_set_bit_def
 by(transfer)(auto cong: conj_cong simp add: not_less set_bit_beyond word_size)
 
 lemma uint32_set_bit_code [code abstract]:
   "Rep_uint32 (uint32_set_bit w n b) = 
   (if n < 0 \<or> 31 < n then Rep_uint32 (undefined (set_bit :: uint32 \<Rightarrow> _) w n b)
    else set_bit (Rep_uint32 w) (nat_of_integer n) b)"
 including undefined_transfer unfolding uint32_set_bit_def by transfer simp
 
 code_printing constant uint32_set_bit \<rightharpoonup>
   (SML) "Uint32.set'_bit" and
   (Haskell) "Data'_Bits.setBitBounded" and
   (OCaml) "Uint32.set'_bit" and
   (Scala) "Uint32.set'_bit" and
   (Eval) "(fn w => fn n => fn b => if n < 0 orelse 32 <= n then raise (Fail \"argument to uint32'_set'_bit out of bounds\") else Uint32.set'_bit x n b)"
 
 lift_definition uint32_set_bits :: "(nat \<Rightarrow> bool) \<Rightarrow> uint32 \<Rightarrow> nat \<Rightarrow> uint32" is set_bits_aux .
 
 lemma uint32_set_bits_code [code]:
   "uint32_set_bits f w n =
   (if n = 0 then w 
    else let n' = n - 1 in uint32_set_bits f (push_bit 1 w OR (if f n' then 1 else 0)) n')"
   apply (transfer fixing: n)
   apply (cases n)
-   apply (simp_all add: shiftl_eq_push_bit)
+   apply simp_all
   done
 
 lemma set_bits_uint32 [code]:
   "(BITS n. f n) = uint32_set_bits f 0 32"
 by transfer(simp add: set_bits_conv_set_bits_aux)
 
 
 lemma lsb_code [code]: fixes x :: uint32 shows "lsb x \<longleftrightarrow> bit x 0"
   by transfer (simp add: lsb_word_eq)
 
 
 definition uint32_shiftl :: "uint32 \<Rightarrow> integer \<Rightarrow> uint32"
 where [code del]:
   "uint32_shiftl x n = (if n < 0 \<or> 32 \<le> n then undefined (push_bit :: nat \<Rightarrow> uint32 \<Rightarrow> _) x n else push_bit (nat_of_integer n) x)"
 
 lemma shiftl_uint32_code [code]: "push_bit n x = (if n < 32 then uint32_shiftl x (integer_of_nat n) else 0)"
   including undefined_transfer integer.lifting unfolding uint32_shiftl_def
   by transfer simp
 
 lemma uint32_shiftl_code [code abstract]:
   "Rep_uint32 (uint32_shiftl w n) =
   (if n < 0 \<or> 32 \<le> n then Rep_uint32 (undefined (push_bit :: nat \<Rightarrow> uint32 \<Rightarrow> _) w n) else push_bit (nat_of_integer n) (Rep_uint32 w))"
   including undefined_transfer unfolding uint32_shiftl_def
-  by transfer (simp add: shiftl_eq_push_bit)
+  by transfer simp
 
 code_printing constant uint32_shiftl \<rightharpoonup>
   (SML) "Uint32.shiftl" and
   (Haskell) "Data'_Bits.shiftlBounded" and
   (OCaml) "Uint32.shiftl" and
   (Scala) "Uint32.shiftl" and
   (Eval) "(fn x => fn i => if i < 0 orelse i >= 32 then raise Fail \"argument to uint32'_shiftl out of bounds\" else Uint32.shiftl x i)"
 
 definition uint32_shiftr :: "uint32 \<Rightarrow> integer \<Rightarrow> uint32"
 where [code del]:
   "uint32_shiftr x n = (if n < 0 \<or> 32 \<le> n then undefined (drop_bit :: nat \<Rightarrow> uint32 \<Rightarrow> _) x n else drop_bit (nat_of_integer n) x)"
 
 lemma shiftr_uint32_code [code]: "drop_bit n x = (if n < 32 then uint32_shiftr x (integer_of_nat n) else 0)"
   including undefined_transfer integer.lifting unfolding uint32_shiftr_def
   by transfer simp
 
 lemma uint32_shiftr_code [code abstract]:
   "Rep_uint32 (uint32_shiftr w n) =
   (if n < 0 \<or> 32 \<le> n then Rep_uint32 (undefined (drop_bit :: nat \<Rightarrow> uint32 \<Rightarrow> _) w n) else drop_bit (nat_of_integer n) (Rep_uint32 w))"
   including undefined_transfer unfolding uint32_shiftr_def by transfer simp
 
 code_printing constant uint32_shiftr \<rightharpoonup>
   (SML) "Uint32.shiftr" and
   (Haskell) "Data'_Bits.shiftrBounded" and
   (OCaml) "Uint32.shiftr" and
   (Scala) "Uint32.shiftr" and
   (Eval) "(fn x => fn i => if i < 0 orelse i >= 32 then raise Fail \"argument to uint32'_shiftr out of bounds\" else Uint32.shiftr x i)"
 
 definition uint32_sshiftr :: "uint32 \<Rightarrow> integer \<Rightarrow> uint32"
 where [code del]:
   "uint32_sshiftr x n =
   (if n < 0 \<or> 32 \<le> n then undefined sshiftr_uint32 x n else sshiftr_uint32 x (nat_of_integer n))"
 
 lemma sshiftr_uint32_code [code]:
   "x >>> n = 
   (if n < 32 then uint32_sshiftr x (integer_of_nat n) else if bit x 31 then - 1 else 0)"
   including undefined_transfer integer.lifting unfolding uint32_sshiftr_def
   by transfer (simp add: not_less signed_drop_bit_beyond)
 
 lemma uint32_sshiftr_code [code abstract]:
   "Rep_uint32 (uint32_sshiftr w n) =
   (if n < 0 \<or> 32 \<le> n then Rep_uint32 (undefined sshiftr_uint32 w n) else signed_drop_bit (nat_of_integer n) (Rep_uint32 w))"
 including undefined_transfer unfolding uint32_sshiftr_def by transfer simp
 
 code_printing constant uint32_sshiftr \<rightharpoonup>
   (SML) "Uint32.shiftr'_signed" and
   (Haskell) 
     "(Prelude.fromInteger (Prelude.toInteger (Data'_Bits.shiftrBounded (Prelude.fromInteger (Prelude.toInteger _) :: Uint32.Int32) _)) :: Uint32.Word32)" and
   (OCaml) "Uint32.shiftr'_signed" and
   (Scala) "Uint32.shiftr'_signed" and
   (Eval) "(fn x => fn i => if i < 0 orelse i >= 32 then raise Fail \"argument to uint32'_shiftr'_signed out of bounds\" else Uint32.shiftr'_signed x i)"
 
 lemma uint32_msb_test_bit: "msb x \<longleftrightarrow> bit (x :: uint32) 31"
   by transfer (simp add: msb_word_iff_bit)
 
 lemma msb_uint32_code [code]: "msb x \<longleftrightarrow> uint32_test_bit x 31"
   by (simp add: uint32_test_bit_def uint32_msb_test_bit)
 
 lemma uint32_of_int_code [code]: "uint32_of_int i = Uint32 (integer_of_int i)"
 including integer.lifting by transfer simp
 
 lemma int_of_uint32_code [code]:
   "int_of_uint32 x = int_of_integer (integer_of_uint32 x)"
 by(simp add: integer_of_uint32_def)
 
 lemma nat_of_uint32_code [code]:
   "nat_of_uint32 x = nat_of_integer (integer_of_uint32 x)"
 unfolding integer_of_uint32_def including integer.lifting by transfer simp
 
 definition integer_of_uint32_signed :: "uint32 \<Rightarrow> integer"
 where
   "integer_of_uint32_signed n = (if bit n 31 then undefined integer_of_uint32 n else integer_of_uint32 n)"
 
 lemma integer_of_uint32_signed_code [code]:
   "integer_of_uint32_signed n =
   (if bit n 31 then undefined integer_of_uint32 n else integer_of_int (uint (Rep_uint32' n)))"
 unfolding integer_of_uint32_signed_def integer_of_uint32_def
 including undefined_transfer by transfer simp
 
 lemma integer_of_uint32_code [code]:
   "integer_of_uint32 n =
   (if bit n 31 then integer_of_uint32_signed (n AND 0x7FFFFFFF) OR 0x80000000 else integer_of_uint32_signed n)"
 proof -
   have \<open>(0x7FFFFFFF :: uint32) = mask 31\<close>
     by (simp add: mask_eq_exp_minus_1)
   then have *: \<open>n AND 0x7FFFFFFF = take_bit 31 n\<close>
     by (simp add: take_bit_eq_mask)
   have **: \<open>(0x80000000 :: int) = 2 ^ 31\<close>
     by simp
   show ?thesis
     unfolding integer_of_uint32_def integer_of_uint32_signed_def o_def *
     including undefined_transfer integer.lifting
     apply transfer
     apply (rule bit_eqI)
     apply (simp add: bit_or_iff bit_take_bit_iff bit_uint_iff)
     apply (simp only: bit_exp_iff bit_or_iff **)
     apply auto
     done
 qed
 
 code_printing
   constant "integer_of_uint32" \<rightharpoonup>
   (SML) "IntInf.fromLarge (Word32.toLargeInt _) : IntInf.int" and
   (Haskell) "Prelude.toInteger"
 | constant "integer_of_uint32_signed" \<rightharpoonup>
   (OCaml) "Z.of'_int32" and
   (Scala) "BigInt"
 
 section \<open>Quickcheck setup\<close>
 
 definition uint32_of_natural :: "natural \<Rightarrow> uint32"
 where "uint32_of_natural x \<equiv> Uint32 (integer_of_natural x)"
 
 instantiation uint32 :: "{random, exhaustive, full_exhaustive}" begin
 definition "random_uint32 \<equiv> qc_random_cnv uint32_of_natural"
 definition "exhaustive_uint32 \<equiv> qc_exhaustive_cnv uint32_of_natural"
 definition "full_exhaustive_uint32 \<equiv> qc_full_exhaustive_cnv uint32_of_natural"
 instance ..
 end
 
 instantiation uint32 :: narrowing begin
 
 interpretation quickcheck_narrowing_samples
   "\<lambda>i. let x = Uint32 i in (x, 0xFFFFFFFF - x)" "0"
   "Typerep.Typerep (STR ''Uint32.uint32'') []" .
 
 definition "narrowing_uint32 d = qc_narrowing_drawn_from (narrowing_samples d) d"
 declare [[code drop: "partial_term_of :: uint32 itself \<Rightarrow> _"]]
 lemmas partial_term_of_uint32 [code] = partial_term_of_code
 
 instance ..
 end
 
 no_notation sshiftr_uint32 (infixl ">>>" 55)
 
 end
diff --git a/thys/Native_Word/Uint64.thy b/thys/Native_Word/Uint64.thy
--- a/thys/Native_Word/Uint64.thy
+++ b/thys/Native_Word/Uint64.thy
@@ -1,984 +1,968 @@
 (*  Title:      Uint64.thy
     Author:     Andreas Lochbihler, ETH Zurich
 *)
 
 chapter \<open>Unsigned words of 64 bits\<close>
 
 theory Uint64 imports
   Code_Target_Word_Base
 begin
 
 text \<open>
   PolyML (in version 5.7) provides a Word64 structure only when run in 64-bit mode.
   Therefore, we by default provide an implementation of 64-bit words using \verb$IntInf.int$ and
   masking. The code target \texttt{SML\_word} replaces this implementation and maps the operations
   directly to the \verb$Word64$ structure provided by the Standard ML implementations.
 
   The \verb$Eval$ target used by @{command value} and @{method eval} dynamically tests at
   runtime for the version of PolyML and uses PolyML's Word64 structure if it detects a 64-bit 
   version which does not suffer from a division bug found in PolyML 5.6.
 \<close>
 
 declare prod.Quotient[transfer_rule]
 
 section \<open>Type definition and primitive operations\<close>
 
 typedef uint64 = "UNIV :: 64 word set" .. 
 
 setup_lifting type_definition_uint64
 
 text \<open>Use an abstract type for code generation to disable pattern matching on @{term Abs_uint64}.\<close>
 declare Rep_uint64_inverse[code abstype]
 
 declare Quotient_uint64[transfer_rule]
 
 instantiation uint64 :: comm_ring_1
 begin
 lift_definition zero_uint64 :: uint64 is "0 :: 64 word" .
 lift_definition one_uint64 :: uint64 is "1" .
 lift_definition plus_uint64 :: "uint64 \<Rightarrow> uint64 \<Rightarrow> uint64" is "(+) :: 64 word \<Rightarrow> _" .
 lift_definition minus_uint64 :: "uint64 \<Rightarrow> uint64 \<Rightarrow> uint64" is "(-)" .
 lift_definition uminus_uint64 :: "uint64 \<Rightarrow> uint64" is uminus .
 lift_definition times_uint64 :: "uint64 \<Rightarrow> uint64 \<Rightarrow> uint64" is "(*)" .
 instance by (standard; transfer) (simp_all add: algebra_simps)
 end
 
 instantiation uint64 :: semiring_modulo
 begin
 lift_definition divide_uint64 :: "uint64 \<Rightarrow> uint64 \<Rightarrow> uint64" is "(div)" .
 lift_definition modulo_uint64 :: "uint64 \<Rightarrow> uint64 \<Rightarrow> uint64" is "(mod)" .
 instance by (standard; transfer) (fact word_mod_div_equality)
 end
 
 instantiation uint64 :: linorder begin
 lift_definition less_uint64 :: "uint64 \<Rightarrow> uint64 \<Rightarrow> bool" is "(<)" .
 lift_definition less_eq_uint64 :: "uint64 \<Rightarrow> uint64 \<Rightarrow> bool" is "(\<le>)" .
 instance by (standard; transfer) (simp_all add: less_le_not_le linear)
 end
 
 lemmas [code] = less_uint64.rep_eq less_eq_uint64.rep_eq
 
 context
   includes lifting_syntax
   notes
     transfer_rule_of_bool [transfer_rule]
     transfer_rule_numeral [transfer_rule]
 begin
 
 lemma [transfer_rule]:
   "((=) ===> cr_uint64) of_bool of_bool"
   by transfer_prover
 
 lemma transfer_rule_numeral_uint [transfer_rule]:
   "((=) ===> cr_uint64) numeral numeral"
   by transfer_prover
 
 lemma [transfer_rule]:
   \<open>(cr_uint64 ===> (\<longleftrightarrow>)) even ((dvd) 2 :: uint64 \<Rightarrow> bool)\<close>
   by (unfold dvd_def) transfer_prover
 
 end
 
 instantiation uint64 :: semiring_bits
 begin
 
 lift_definition bit_uint64 :: \<open>uint64 \<Rightarrow> nat \<Rightarrow> bool\<close> is bit .
 
 instance
   by (standard; transfer)
     (fact bit_iff_odd even_iff_mod_2_eq_zero odd_iff_mod_2_eq_one odd_one bits_induct
        bits_div_0 bits_div_by_1 bits_mod_div_trivial even_succ_div_2
        even_mask_div_iff exp_div_exp_eq div_exp_eq mod_exp_eq mult_exp_mod_exp_eq
        div_exp_mod_exp_eq even_mult_exp_div_exp_iff)+
 
 end
 
 instantiation uint64 :: semiring_bit_shifts
 begin
 lift_definition push_bit_uint64 :: \<open>nat \<Rightarrow> uint64 \<Rightarrow> uint64\<close> is push_bit .
 lift_definition drop_bit_uint64 :: \<open>nat \<Rightarrow> uint64 \<Rightarrow> uint64\<close> is drop_bit .
 lift_definition take_bit_uint64 :: \<open>nat \<Rightarrow> uint64 \<Rightarrow> uint64\<close> is take_bit .
 instance by (standard; transfer)
   (fact push_bit_eq_mult drop_bit_eq_div take_bit_eq_mod)+
 end
 
 instantiation uint64 :: ring_bit_operations
 begin
 lift_definition not_uint64 :: \<open>uint64 \<Rightarrow> uint64\<close> is NOT .
 lift_definition and_uint64 :: \<open>uint64 \<Rightarrow> uint64 \<Rightarrow> uint64\<close> is \<open>(AND)\<close> .
 lift_definition or_uint64 :: \<open>uint64 \<Rightarrow> uint64 \<Rightarrow> uint64\<close> is \<open>(OR)\<close> .
 lift_definition xor_uint64 :: \<open>uint64 \<Rightarrow> uint64 \<Rightarrow> uint64\<close> is \<open>(XOR)\<close> .
 lift_definition mask_uint64 :: \<open>nat \<Rightarrow> uint64\<close> is mask .
 lift_definition set_bit_uint64 :: \<open>nat \<Rightarrow> uint64 \<Rightarrow> uint64\<close> is \<open>Bit_Operations.set_bit\<close> .
 lift_definition unset_bit_uint64 :: \<open>nat \<Rightarrow> uint64 \<Rightarrow> uint64\<close> is \<open>unset_bit\<close> .
 lift_definition flip_bit_uint64 :: \<open>nat \<Rightarrow> uint64 \<Rightarrow> uint64\<close> is \<open>flip_bit\<close> .
 instance by (standard; transfer)
   (simp_all add: bit_simps mask_eq_decr_exp minus_eq_not_minus_1 set_bit_def flip_bit_def)
 end
 
 lemma [code]:
   \<open>take_bit n a = a AND mask n\<close> for a :: uint64
   by (fact take_bit_eq_mask)
 
 lemma [code]:
   \<open>mask (Suc n) = push_bit n (1 :: uint64) OR mask n\<close>
   \<open>mask 0 = (0 :: uint64)\<close>
   by (simp_all add: mask_Suc_exp push_bit_of_1)
 
 lemma [code]:
   \<open>Bit_Operations.set_bit n w = w OR push_bit n 1\<close> for w :: uint64
   by (fact set_bit_eq_or)
 
 lemma [code]:
   \<open>unset_bit n w = w AND NOT (push_bit n 1)\<close> for w :: uint64
   by (fact unset_bit_eq_and_not)
 
 lemma [code]:
   \<open>flip_bit n w = w XOR push_bit n 1\<close> for w :: uint64
   by (fact flip_bit_eq_xor)
 
-instance uint64 :: semiring_bit_syntax ..
-
-context
-  includes lifting_syntax
-begin
-
-lemma shiftl_uint64_transfer [transfer_rule]:
-  \<open>(cr_uint64 ===> (=) ===> cr_uint64) (\<lambda>k n. push_bit n k) (<<)\<close>
-  unfolding shiftl_eq_push_bit by transfer_prover
-
-lemma shiftr_uint64_transfer [transfer_rule]:
-  \<open>(cr_uint64 ===> (=) ===> cr_uint64) (\<lambda>k n. drop_bit n k) (>>)\<close>
-  unfolding shiftr_eq_drop_bit by transfer_prover
-
-end
-
 instantiation uint64 :: lsb
 begin
 lift_definition lsb_uint64 :: \<open>uint64 \<Rightarrow> bool\<close> is lsb .
 instance by (standard; transfer)
   (fact lsb_odd)
 end
 
 instantiation uint64 :: msb
 begin
 lift_definition msb_uint64 :: \<open>uint64 \<Rightarrow> bool\<close> is msb .
 instance ..
 end
 
 setup \<open>Context.theory_map (Name_Space.map_naming (Name_Space.qualified_path true \<^binding>\<open>Generic\<close>))\<close>
 
 instantiation uint64 :: set_bit
 begin
 lift_definition set_bit_uint64 :: \<open>uint64 \<Rightarrow> nat \<Rightarrow> bool \<Rightarrow> uint64\<close> is set_bit .
 instance
   apply standard
   apply transfer
   apply (simp add: bit_simps)
   done
 end
 
 setup \<open>Context.theory_map (Name_Space.map_naming (Name_Space.parent_path))\<close>
 
 instantiation uint64 :: bit_comprehension begin
 lift_definition set_bits_uint64 :: "(nat \<Rightarrow> bool) \<Rightarrow> uint64" is "set_bits" .
 instance by (standard; transfer) (fact set_bits_bit_eq)
 end
 
 lemmas [code] = bit_uint64.rep_eq lsb_uint64.rep_eq msb_uint64.rep_eq
 
 instantiation uint64 :: equal begin
 lift_definition equal_uint64 :: "uint64 \<Rightarrow> uint64 \<Rightarrow> bool" is "equal_class.equal" .
 instance by standard (transfer, simp add: equal_eq)
 end
 
 lemmas [code] = equal_uint64.rep_eq
 
 instantiation uint64 :: size begin
 lift_definition size_uint64 :: "uint64 \<Rightarrow> nat" is "size" .
 instance ..
 end
 
 lemmas [code] = size_uint64.rep_eq
 
 lift_definition sshiftr_uint64 :: "uint64 \<Rightarrow> nat \<Rightarrow> uint64" (infixl ">>>" 55) is \<open>\<lambda>w n. signed_drop_bit n w\<close> .
 
 lift_definition uint64_of_int :: "int \<Rightarrow> uint64" is "word_of_int" .
 
 definition uint64_of_nat :: "nat \<Rightarrow> uint64"
 where "uint64_of_nat = uint64_of_int \<circ> int"
 
 lift_definition int_of_uint64 :: "uint64 \<Rightarrow> int" is "uint" .
 lift_definition nat_of_uint64 :: "uint64 \<Rightarrow> nat" is "unat" .
 
 definition integer_of_uint64 :: "uint64 \<Rightarrow> integer"
 where "integer_of_uint64 = integer_of_int o int_of_uint64"
 
 text \<open>Use pretty numerals from integer for pretty printing\<close>
 
 context includes integer.lifting begin
 
 lift_definition Uint64 :: "integer \<Rightarrow> uint64" is "word_of_int" .
 
 lemma Rep_uint64_numeral [simp]: "Rep_uint64 (numeral n) = numeral n"
 by(induction n)(simp_all add: one_uint64_def Abs_uint64_inverse numeral.simps plus_uint64_def)
 
 lemma numeral_uint64_transfer [transfer_rule]:
   "(rel_fun (=) cr_uint64) numeral numeral"
 by(auto simp add: cr_uint64_def)
 
 lemma numeral_uint64 [code_unfold]: "numeral n = Uint64 (numeral n)"
 by transfer simp
 
 lemma Rep_uint64_neg_numeral [simp]: "Rep_uint64 (- numeral n) = - numeral n"
 by(simp only: uminus_uint64_def)(simp add: Abs_uint64_inverse)
 
 lemma neg_numeral_uint64 [code_unfold]: "- numeral n = Uint64 (- numeral n)"
 by transfer(simp add: cr_uint64_def)
 
 end
 
 lemma Abs_uint64_numeral [code_post]: "Abs_uint64 (numeral n) = numeral n"
 by(induction n)(simp_all add: one_uint64_def numeral.simps plus_uint64_def Abs_uint64_inverse)
 
 lemma Abs_uint64_0 [code_post]: "Abs_uint64 0 = 0"
 by(simp add: zero_uint64_def)
 
 lemma Abs_uint64_1 [code_post]: "Abs_uint64 1 = 1"
 by(simp add: one_uint64_def)
 
 section \<open>Code setup\<close>
 
 text \<open> For SML, we generate an implementation of unsigned 64-bit words using \verb$IntInf.int$.
   If @{ML "LargeWord.wordSize > 63"} of the Isabelle/ML runtime environment holds, then we assume
   that there is also a \<open>Word64\<close> structure available and accordingly replace the implementation
   for the target \verb$Eval$.
 \<close>
 code_printing code_module "Uint64" \<rightharpoonup> (SML) \<open>(* Test that words can handle numbers between 0 and 63 *)
 val _ = if 6 <= Word.wordSize then () else raise (Fail ("wordSize less than 6"));
 
 structure Uint64 : sig
   eqtype uint64;
   val zero : uint64;
   val one : uint64;
   val fromInt : IntInf.int -> uint64;
   val toInt : uint64 -> IntInf.int;
   val toLarge : uint64 -> LargeWord.word;
   val fromLarge : LargeWord.word -> uint64
   val plus : uint64 -> uint64 -> uint64;
   val minus : uint64 -> uint64 -> uint64;
   val times : uint64 -> uint64 -> uint64;
   val divide : uint64 -> uint64 -> uint64;
   val modulus : uint64 -> uint64 -> uint64;
   val negate : uint64 -> uint64;
   val less_eq : uint64 -> uint64 -> bool;
   val less : uint64 -> uint64 -> bool;
   val notb : uint64 -> uint64;
   val andb : uint64 -> uint64 -> uint64;
   val orb : uint64 -> uint64 -> uint64;
   val xorb : uint64 -> uint64 -> uint64;
   val shiftl : uint64 -> IntInf.int -> uint64;
   val shiftr : uint64 -> IntInf.int -> uint64;
   val shiftr_signed : uint64 -> IntInf.int -> uint64;
   val set_bit : uint64 -> IntInf.int -> bool -> uint64;
   val test_bit : uint64 -> IntInf.int -> bool;
 end = struct
 
 type uint64 = IntInf.int;
 
 val mask = 0xFFFFFFFFFFFFFFFF : IntInf.int;
 
 val zero = 0 : IntInf.int;
 
 val one = 1 : IntInf.int;
 
 fun fromInt x = IntInf.andb(x, mask);
 
 fun toInt x = x
 
 fun toLarge x = LargeWord.fromLargeInt (IntInf.toLarge x);
 
 fun fromLarge x = IntInf.fromLarge (LargeWord.toLargeInt x);
 
 fun plus x y = IntInf.andb(IntInf.+(x, y), mask);
 
 fun minus x y = IntInf.andb(IntInf.-(x, y), mask);
 
 fun negate x = IntInf.andb(IntInf.~(x), mask);
 
 fun times x y = IntInf.andb(IntInf.*(x, y), mask);
 
 fun divide x y = IntInf.div(x, y);
 
 fun modulus x y = IntInf.mod(x, y);
 
 fun less_eq x y = IntInf.<=(x, y);
 
 fun less x y = IntInf.<(x, y);
 
 fun notb x = IntInf.andb(IntInf.notb(x), mask);
 
 fun orb x y = IntInf.orb(x, y);
 
 fun andb x y = IntInf.andb(x, y);
 
 fun xorb x y = IntInf.xorb(x, y);
 
 val maxWord = IntInf.pow (2, Word.wordSize);
 
 fun shiftl x n = 
   if n < maxWord then IntInf.andb(IntInf.<< (x, Word.fromLargeInt (IntInf.toLarge n)), mask)
   else 0;
 
 fun shiftr x n =
   if n < maxWord then IntInf.~>> (x, Word.fromLargeInt (IntInf.toLarge n))
   else 0;
 
 val msb_mask = 0x8000000000000000 : IntInf.int;
 
 fun shiftr_signed x i =
   if IntInf.andb(x, msb_mask) = 0 then shiftr x i
   else if i >= 64 then 0xFFFFFFFFFFFFFFFF
   else let
     val x' = shiftr x i
     val m' = IntInf.andb(IntInf.<<(mask, Word.max(0w64 - Word.fromLargeInt (IntInf.toLarge i), 0w0)), mask)
   in IntInf.orb(x', m') end;
 
 fun test_bit x n =
   if n < maxWord then IntInf.andb (x, IntInf.<< (1, Word.fromLargeInt (IntInf.toLarge n))) <> 0
   else false;
 
 fun set_bit x n b =
   if n < 64 then
     if b then IntInf.orb (x, IntInf.<< (1, Word.fromLargeInt (IntInf.toLarge n)))
     else IntInf.andb (x, IntInf.notb (IntInf.<< (1, Word.fromLargeInt (IntInf.toLarge n))))
   else x;
 
 end
 \<close>
 code_reserved SML Uint64
 
 setup \<open>
 let
   val polyml64 = LargeWord.wordSize > 63;
   (* PolyML 5.6 has bugs in its Word64 implementation. We test for one such bug and refrain
      from using Word64 in that case. Testing is done with dynamic code evaluation such that
      the compiler does not choke on the Word64 structure, which need not be present in a 32bit
      environment. *)
   val error_msg = "Buggy Word64 structure";
   val test_code = 
    "val _ = if Word64.div (0w18446744073709551611 : Word64.word, 0w3) = 0w6148914691236517203 then ()\n" ^
    "else raise (Fail \"" ^ error_msg ^ "\");";
   val f = Exn.interruptible_capture (fn () => ML_Compiler.eval ML_Compiler.flags Position.none (ML_Lex.tokenize test_code))
   val use_Word64 = polyml64 andalso
     (case f () of 
        Exn.Res _ => true
      | Exn.Exn (e as ERROR m) => if String.isSuffix error_msg m then false else Exn.reraise e
      | Exn.Exn e => Exn.reraise e)
     ;
 
   val newline = "\n";
   val content = 
     "structure Uint64 : sig" ^ newline ^
     "  eqtype uint64;" ^ newline ^
     "  val zero : uint64;" ^ newline ^
     "  val one : uint64;" ^ newline ^
     "  val fromInt : IntInf.int -> uint64;" ^ newline ^
     "  val toInt : uint64 -> IntInf.int;" ^ newline ^
     "  val toLarge : uint64 -> LargeWord.word;" ^ newline ^
     "  val fromLarge : LargeWord.word -> uint64" ^ newline ^
     "  val plus : uint64 -> uint64 -> uint64;" ^ newline ^
     "  val minus : uint64 -> uint64 -> uint64;" ^ newline ^
     "  val times : uint64 -> uint64 -> uint64;" ^ newline ^
     "  val divide : uint64 -> uint64 -> uint64;" ^ newline ^
     "  val modulus : uint64 -> uint64 -> uint64;" ^ newline ^
     "  val negate : uint64 -> uint64;" ^ newline ^
     "  val less_eq : uint64 -> uint64 -> bool;" ^ newline ^
     "  val less : uint64 -> uint64 -> bool;" ^ newline ^
     "  val notb : uint64 -> uint64;" ^ newline ^
     "  val andb : uint64 -> uint64 -> uint64;" ^ newline ^
     "  val orb : uint64 -> uint64 -> uint64;" ^ newline ^
     "  val xorb : uint64 -> uint64 -> uint64;" ^ newline ^
     "  val shiftl : uint64 -> IntInf.int -> uint64;" ^ newline ^
     "  val shiftr : uint64 -> IntInf.int -> uint64;" ^ newline ^
     "  val shiftr_signed : uint64 -> IntInf.int -> uint64;" ^ newline ^
     "  val set_bit : uint64 -> IntInf.int -> bool -> uint64;" ^ newline ^
     "  val test_bit : uint64 -> IntInf.int -> bool;" ^ newline ^
     "end = struct" ^ newline ^
     "" ^ newline ^
     "type uint64 = Word64.word;" ^ newline ^
     "" ^ newline ^
     "val zero = (0wx0 : uint64);" ^ newline ^
     "" ^ newline ^
     "val one = (0wx1 : uint64);" ^ newline ^
     "" ^ newline ^
     "fun fromInt x = Word64.fromLargeInt (IntInf.toLarge x);" ^ newline ^
     "" ^ newline ^
     "fun toInt x = IntInf.fromLarge (Word64.toLargeInt x);"  ^ newline ^
     "" ^ newline ^
     "fun fromLarge x = Word64.fromLarge x;" ^ newline ^
     "" ^ newline ^
     "fun toLarge x = Word64.toLarge x;"  ^ newline ^
     "" ^ newline ^
     "fun plus x y = Word64.+(x, y);" ^ newline ^
     "" ^ newline ^
     "fun minus x y = Word64.-(x, y);" ^ newline ^
     "" ^ newline ^
     "fun negate x = Word64.~(x);" ^ newline ^
     "" ^ newline ^
     "fun times x y = Word64.*(x, y);" ^ newline ^
     "" ^ newline ^
     "fun divide x y = Word64.div(x, y);" ^ newline ^
     "" ^ newline ^
     "fun modulus x y = Word64.mod(x, y);" ^ newline ^
     "" ^ newline ^
     "fun less_eq x y = Word64.<=(x, y);" ^ newline ^
     "" ^ newline ^
     "fun less x y = Word64.<(x, y);" ^ newline ^
     "" ^ newline ^
     "fun set_bit x n b =" ^ newline ^
     "  let val mask = Word64.<< (0wx1, Word.fromLargeInt (IntInf.toLarge n))" ^ newline ^
     "  in if b then Word64.orb (x, mask)" ^ newline ^
     "     else Word64.andb (x, Word64.notb mask)" ^ newline ^
     "  end" ^ newline ^
     "" ^ newline ^
     "fun shiftl x n =" ^ newline ^
     "  Word64.<< (x, Word.fromLargeInt (IntInf.toLarge n))" ^ newline ^
     "" ^ newline ^
     "fun shiftr x n =" ^ newline ^
     "  Word64.>> (x, Word.fromLargeInt (IntInf.toLarge n))" ^ newline ^
     "" ^ newline ^
     "fun shiftr_signed x n =" ^ newline ^
     "  Word64.~>> (x, Word.fromLargeInt (IntInf.toLarge n))" ^ newline ^
     "" ^ newline ^
     "fun test_bit x n =" ^ newline ^
     "  Word64.andb (x, Word64.<< (0wx1, Word.fromLargeInt (IntInf.toLarge n))) <> Word64.fromInt 0" ^ newline ^
     "" ^ newline ^
     "val notb = Word64.notb" ^ newline ^
     "" ^ newline ^
     "fun andb x y = Word64.andb(x, y);" ^ newline ^
     "" ^ newline ^
     "fun orb x y = Word64.orb(x, y);" ^ newline ^
     "" ^ newline ^
     "fun xorb x y = Word64.xorb(x, y);" ^ newline ^
     "" ^ newline ^
     "end (*struct Uint64*)"
   val target_SML64 = "SML_word";
 in
   (if use_Word64 then Code_Target.set_printings (Code_Symbol.Module ("Uint64", [(Code_Runtime.target, SOME (content, []))])) else I)
   #> Code_Target.set_printings (Code_Symbol.Module ("Uint64", [(target_SML64, SOME (content, []))]))
 end
 \<close>
 
 code_printing code_module Uint64 \<rightharpoonup> (Haskell)
  \<open>module Uint64(Int64, Word64) where
 
   import Data.Int(Int64)
   import Data.Word(Word64)\<close>
 code_reserved Haskell Uint64
 
 text \<open>
   OCaml and Scala provide only signed 64bit numbers, so we use these and 
   implement sign-sensitive operations like comparisons manually.
 \<close>
 code_printing code_module "Uint64" \<rightharpoonup> (OCaml)
 \<open>module Uint64 : sig
   val less : int64 -> int64 -> bool
   val less_eq : int64 -> int64 -> bool
   val set_bit : int64 -> Z.t -> bool -> int64
   val shiftl : int64 -> Z.t -> int64
   val shiftr : int64 -> Z.t -> int64
   val shiftr_signed : int64 -> Z.t -> int64
   val test_bit : int64 -> Z.t -> bool
 end = struct
 
 (* negative numbers have their highest bit set, 
    so they are greater than positive ones *)
 let less x y =
   if Int64.compare x Int64.zero < 0 then
     Int64.compare y Int64.zero < 0 && Int64.compare x y < 0
   else Int64.compare y Int64.zero < 0 || Int64.compare x y < 0;;
 
 let less_eq x y =
   if Int64.compare x Int64.zero < 0 then
     Int64.compare y Int64.zero < 0 && Int64.compare x y <= 0
   else Int64.compare y Int64.zero < 0 || Int64.compare x y <= 0;;
 
 let set_bit x n b =
   let mask = Int64.shift_left Int64.one (Z.to_int n)
   in if b then Int64.logor x mask
      else Int64.logand x (Int64.lognot mask);;
 
 let shiftl x n = Int64.shift_left x (Z.to_int n);;
 
 let shiftr x n = Int64.shift_right_logical x (Z.to_int n);;
 
 let shiftr_signed x n = Int64.shift_right x (Z.to_int n);;
 
 let test_bit x n =
   Int64.compare 
     (Int64.logand x (Int64.shift_left Int64.one (Z.to_int n)))
     Int64.zero
   <> 0;;
 
 end;; (*struct Uint64*)\<close>
 code_reserved OCaml Uint64
 
 code_printing code_module Uint64 \<rightharpoonup> (Scala)
 \<open>object Uint64 {
 
 def less(x: Long, y: Long) : Boolean =
   if (x < 0) y < 0 && x < y
   else y < 0 || x < y
 
 def less_eq(x: Long, y: Long) : Boolean =
   if (x < 0) y < 0 && x <= y
   else y < 0 || x <= y
 
 def set_bit(x: Long, n: BigInt, b: Boolean) : Long =
   if (b)
     x | (1L << n.intValue)
   else
     x & (1L << n.intValue).unary_~
 
 def shiftl(x: Long, n: BigInt) : Long = x << n.intValue
 
 def shiftr(x: Long, n: BigInt) : Long = x >>> n.intValue
 
 def shiftr_signed(x: Long, n: BigInt) : Long = x >> n.intValue
 
 def test_bit(x: Long, n: BigInt) : Boolean =
   (x & (1L << n.intValue)) != 0
 
 } /* object Uint64 */\<close>
 code_reserved Scala Uint64
 
 text \<open>
   OCaml's conversion from Big\_int to int64 demands that the value fits int a signed 64-bit integer.
   The following justifies the implementation.
 \<close>
 
 definition Uint64_signed :: "integer \<Rightarrow> uint64" 
 where "Uint64_signed i = (if i < -(0x8000000000000000) \<or> i \<ge> 0x8000000000000000 then undefined Uint64 i else Uint64 i)"
 
 lemma Uint64_code [code]:
   "Uint64 i = 
   (let i' = i AND 0xFFFFFFFFFFFFFFFF
    in if bit i' 63 then Uint64_signed (i' - 0x10000000000000000) else Uint64_signed i')"
   including undefined_transfer integer.lifting unfolding Uint64_signed_def
   apply transfer
   apply (subst word_of_int_via_signed)
-     apply (auto simp add: shiftl_eq_push_bit push_bit_of_1 mask_eq_exp_minus_1 word_of_int_via_signed cong del: if_cong)
+     apply (auto simp add: push_bit_of_1 mask_eq_exp_minus_1 word_of_int_via_signed cong del: if_cong)
   done
 
 lemma Uint64_signed_code [code abstract]:
   "Rep_uint64 (Uint64_signed i) = 
   (if i < -(0x8000000000000000) \<or> i \<ge> 0x8000000000000000 then Rep_uint64 (undefined Uint64 i) else word_of_int (int_of_integer_symbolic i))"
 unfolding Uint64_signed_def Uint64_def int_of_integer_symbolic_def word_of_integer_def
 by(simp add: Abs_uint64_inverse)
 
 text \<open>
   Avoid @{term Abs_uint64} in generated code, use @{term Rep_uint64'} instead. 
   The symbolic implementations for code\_simp use @{term Rep_uint64}.
 
   The new destructor @{term Rep_uint64'} is executable.
   As the simplifier is given the [code abstract] equations literally, 
   we cannot implement @{term Rep_uint64} directly, because that makes code\_simp loop.
 
   If code generation raises Match, some equation probably contains @{term Rep_uint64} 
   ([code abstract] equations for @{typ uint64} may use @{term Rep_uint64} because
   these instances will be folded away.)
 
   To convert @{typ "64 word"} values into @{typ uint64}, use @{term "Abs_uint64'"}.
 \<close>
 
 definition Rep_uint64' where [simp]: "Rep_uint64' = Rep_uint64"
 
 lemma Rep_uint64'_transfer [transfer_rule]:
   "rel_fun cr_uint64 (=) (\<lambda>x. x) Rep_uint64'"
 unfolding Rep_uint64'_def by(rule uint64.rep_transfer)
 
 lemma Rep_uint64'_code [code]: "Rep_uint64' x = (BITS n. bit x n)"
   by transfer (simp add: set_bits_bit_eq)
 
 lift_definition Abs_uint64' :: "64 word \<Rightarrow> uint64" is "\<lambda>x :: 64 word. x" .
 
 lemma Abs_uint64'_code [code]:
   "Abs_uint64' x = Uint64 (integer_of_int (uint x))"
 including integer.lifting by transfer simp
 
 declare [[code drop: "term_of_class.term_of :: uint64 \<Rightarrow> _"]]
 
 lemma term_of_uint64_code [code]:
   defines "TR \<equiv> typerep.Typerep" and "bit0 \<equiv> STR ''Numeral_Type.bit0''" 
   shows
   "term_of_class.term_of x = 
    Code_Evaluation.App (Code_Evaluation.Const (STR ''Uint64.uint64.Abs_uint64'') (TR (STR ''fun'') [TR (STR ''Word.word'') [TR bit0 [TR bit0 [TR bit0 [TR bit0 [TR bit0 [TR bit0 [TR (STR ''Numeral_Type.num1'') []]]]]]]], TR (STR ''Uint64.uint64'') []]))
        (term_of_class.term_of (Rep_uint64' x))"
 by(simp add: term_of_anything)
 
 code_printing
   type_constructor uint64 \<rightharpoonup>
   (SML) "Uint64.uint64" and
   (Haskell) "Uint64.Word64" and
   (OCaml) "int64" and
   (Scala) "Long"
 | constant Uint64 \<rightharpoonup>
   (SML) "Uint64.fromInt" and
   (Haskell) "(Prelude.fromInteger _ :: Uint64.Word64)" and
   (Haskell_Quickcheck) "(Prelude.fromInteger (Prelude.toInteger _) :: Uint64.Word64)" and
   (Scala) "_.longValue"
 | constant Uint64_signed \<rightharpoonup>
   (OCaml) "Z.to'_int64"
 | constant "0 :: uint64" \<rightharpoonup>
   (SML) "Uint64.zero" and
   (Haskell) "(0 :: Uint64.Word64)" and
   (OCaml) "Int64.zero" and
   (Scala) "0"
 | constant "1 :: uint64" \<rightharpoonup>
   (SML) "Uint64.one" and
   (Haskell) "(1 :: Uint64.Word64)" and
   (OCaml) "Int64.one" and
   (Scala) "1"
 | constant "plus :: uint64 \<Rightarrow> _ " \<rightharpoonup>
   (SML) "Uint64.plus" and
   (Haskell) infixl 6 "+" and
   (OCaml) "Int64.add" and
   (Scala) infixl 7 "+"
 | constant "uminus :: uint64 \<Rightarrow> _" \<rightharpoonup>
   (SML) "Uint64.negate" and
   (Haskell) "negate" and
   (OCaml) "Int64.neg" and
   (Scala) "!(- _)"
 | constant "minus :: uint64 \<Rightarrow> _" \<rightharpoonup>
   (SML) "Uint64.minus" and
   (Haskell) infixl 6 "-" and
   (OCaml) "Int64.sub" and
   (Scala) infixl 7 "-"
 | constant "times :: uint64 \<Rightarrow> _ \<Rightarrow> _" \<rightharpoonup>
   (SML) "Uint64.times" and
   (Haskell) infixl 7 "*" and
   (OCaml) "Int64.mul" and
   (Scala) infixl 8 "*"
 | constant "HOL.equal :: uint64 \<Rightarrow> _ \<Rightarrow> bool" \<rightharpoonup>
   (SML) "!((_ : Uint64.uint64) = _)" and
   (Haskell) infix 4 "==" and
   (OCaml) "(Int64.compare _ _ = 0)" and
   (Scala) infixl 5 "=="
 | class_instance uint64 :: equal \<rightharpoonup>
   (Haskell) -
 | constant "less_eq :: uint64 \<Rightarrow> _ \<Rightarrow> bool" \<rightharpoonup>
   (SML) "Uint64.less'_eq" and
   (Haskell) infix 4 "<=" and
   (OCaml) "Uint64.less'_eq" and
   (Scala) "Uint64.less'_eq"
 | constant "less :: uint64 \<Rightarrow> _ \<Rightarrow> bool" \<rightharpoonup>
   (SML) "Uint64.less" and
   (Haskell) infix 4 "<" and
   (OCaml) "Uint64.less" and
   (Scala) "Uint64.less"
 | constant "NOT :: uint64 \<Rightarrow> _" \<rightharpoonup>
   (SML) "Uint64.notb" and
   (Haskell) "Data'_Bits.complement" and
   (OCaml) "Int64.lognot" and
   (Scala) "_.unary'_~"
 | constant "(AND) :: uint64 \<Rightarrow> _" \<rightharpoonup>
   (SML) "Uint64.andb" and
   (Haskell) infixl 7 "Data_Bits..&." and
   (OCaml) "Int64.logand" and
   (Scala) infixl 3 "&"
 | constant "(OR) :: uint64 \<Rightarrow> _" \<rightharpoonup>
   (SML) "Uint64.orb" and
   (Haskell) infixl 5 "Data_Bits..|." and
   (OCaml) "Int64.logor" and
   (Scala) infixl 1 "|"
 | constant "(XOR) :: uint64 \<Rightarrow> _" \<rightharpoonup>
   (SML) "Uint64.xorb" and
   (Haskell) "Data'_Bits.xor" and
   (OCaml) "Int64.logxor" and
   (Scala) infixl 2 "^"
 
 definition uint64_divmod :: "uint64 \<Rightarrow> uint64 \<Rightarrow> uint64 \<times> uint64" where
   "uint64_divmod x y = 
   (if y = 0 then (undefined ((div) :: uint64 \<Rightarrow> _) x (0 :: uint64), undefined ((mod) :: uint64 \<Rightarrow> _) x (0 :: uint64)) 
   else (x div y, x mod y))"
 
 definition uint64_div :: "uint64 \<Rightarrow> uint64 \<Rightarrow> uint64" 
 where "uint64_div x y = fst (uint64_divmod x y)"
 
 definition uint64_mod :: "uint64 \<Rightarrow> uint64 \<Rightarrow> uint64" 
 where "uint64_mod x y = snd (uint64_divmod x y)"
 
 lemma div_uint64_code [code]: "x div y = (if y = 0 then 0 else uint64_div x y)"
 including undefined_transfer unfolding uint64_divmod_def uint64_div_def
 by transfer (simp add: word_div_def)
 
 lemma mod_uint64_code [code]: "x mod y = (if y = 0 then x else uint64_mod x y)"
 including undefined_transfer unfolding uint64_mod_def uint64_divmod_def
 by transfer (simp add: word_mod_def)
 
 definition uint64_sdiv :: "uint64 \<Rightarrow> uint64 \<Rightarrow> uint64"
 where [code del]:
   "uint64_sdiv x y =
    (if y = 0 then undefined ((div) :: uint64 \<Rightarrow> _) x (0 :: uint64)
     else Abs_uint64 (Rep_uint64 x sdiv Rep_uint64 y))"
 
 definition div0_uint64 :: "uint64 \<Rightarrow> uint64"
 where [code del]: "div0_uint64 x = undefined ((div) :: uint64 \<Rightarrow> _) x (0 :: uint64)"
 declare [[code abort: div0_uint64]]
 
 definition mod0_uint64 :: "uint64 \<Rightarrow> uint64"
 where [code del]: "mod0_uint64 x = undefined ((mod) :: uint64 \<Rightarrow> _) x (0 :: uint64)"
 declare [[code abort: mod0_uint64]]
 
 lemma uint64_divmod_code [code]:
   "uint64_divmod x y =
   (if 0x8000000000000000 \<le> y then if x < y then (0, x) else (1, x - y)
    else if y = 0 then (div0_uint64 x, mod0_uint64 x)
    else let q = push_bit 1 (uint64_sdiv (drop_bit 1 x) y);
             r = x - q * y
         in if r \<ge> y then (q + 1, r - y) else (q, r))"
   including undefined_transfer unfolding uint64_divmod_def uint64_sdiv_def div0_uint64_def mod0_uint64_def
-  by transfer (simp add: divmod_via_sdivmod shiftr_eq_drop_bit shiftl_eq_push_bit ac_simps)
+  by transfer (simp add: divmod_via_sdivmod ac_simps)
 
 lemma uint64_sdiv_code [code abstract]:
   "Rep_uint64 (uint64_sdiv x y) =
    (if y = 0 then Rep_uint64 (undefined ((div) :: uint64 \<Rightarrow> _) x (0 :: uint64))
     else Rep_uint64 x sdiv Rep_uint64 y)"
 unfolding uint64_sdiv_def by(simp add: Abs_uint64_inverse)
 
 text \<open>
   Note that we only need a translation for signed division, but not for the remainder
   because @{thm uint64_divmod_code} computes both with division only.
 \<close>
 
 code_printing
   constant uint64_div \<rightharpoonup>
   (SML) "Uint64.divide" and
   (Haskell) "Prelude.div"
 | constant uint64_mod \<rightharpoonup>
   (SML) "Uint64.modulus" and
   (Haskell) "Prelude.mod"
 | constant uint64_divmod \<rightharpoonup>
   (Haskell) "divmod"
 | constant uint64_sdiv \<rightharpoonup>
   (OCaml) "Int64.div" and
   (Scala) "_ '/ _"
 
 definition uint64_test_bit :: "uint64 \<Rightarrow> integer \<Rightarrow> bool"
 where [code del]:
   "uint64_test_bit x n =
   (if n < 0 \<or> 63 < n then undefined (bit :: uint64 \<Rightarrow> _) x n
    else bit x (nat_of_integer n))"
 
 lemma bit_uint64_code [code]:
   "bit x n \<longleftrightarrow> n < 64 \<and> uint64_test_bit x (integer_of_nat n)"
   including undefined_transfer integer.lifting unfolding uint64_test_bit_def
   by (transfer, simp, transfer, simp)
 
 lemma uint64_test_bit_code [code]:
   "uint64_test_bit w n =
   (if n < 0 \<or> 63 < n then undefined (bit :: uint64 \<Rightarrow> _) w n else bit (Rep_uint64 w) (nat_of_integer n))"
   unfolding uint64_test_bit_def by(simp add: bit_uint64.rep_eq)
 
 code_printing constant uint64_test_bit \<rightharpoonup>
   (SML) "Uint64.test'_bit" and
   (Haskell) "Data'_Bits.testBitBounded" and
   (OCaml) "Uint64.test'_bit" and
   (Scala) "Uint64.test'_bit" and
   (Eval) "(fn x => fn i => if i < 0 orelse i >= 64 then raise (Fail \"argument to uint64'_test'_bit out of bounds\") else Uint64.test'_bit x i)"
 
 definition uint64_set_bit :: "uint64 \<Rightarrow> integer \<Rightarrow> bool \<Rightarrow> uint64"
 where [code del]:
   "uint64_set_bit x n b =
   (if n < 0 \<or> 63 < n then undefined (set_bit :: uint64 \<Rightarrow> _) x n b
    else set_bit x (nat_of_integer n) b)"
 
 lemma set_bit_uint64_code [code]:
   "set_bit x n b = (if n < 64 then uint64_set_bit x (integer_of_nat n) b else x)"
 including undefined_transfer integer.lifting unfolding uint64_set_bit_def
 by(transfer)(auto cong: conj_cong simp add: not_less set_bit_beyond word_size)
 
 lemma uint64_set_bit_code [code abstract]:
   "Rep_uint64 (uint64_set_bit w n b) = 
   (if n < 0 \<or> 63 < n then Rep_uint64 (undefined (set_bit :: uint64 \<Rightarrow> _) w n b)
    else set_bit (Rep_uint64 w) (nat_of_integer n) b)"
 including undefined_transfer unfolding uint64_set_bit_def by transfer simp
 
 code_printing constant uint64_set_bit \<rightharpoonup>
   (SML) "Uint64.set'_bit" and
   (Haskell) "Data'_Bits.setBitBounded" and
   (OCaml) "Uint64.set'_bit" and
   (Scala) "Uint64.set'_bit" and
   (Eval) "(fn x => fn i => fn b => if i < 0 orelse i >= 64 then raise (Fail \"argument to uint64'_set'_bit out of bounds\") else Uint64.set'_bit x i b)"
 
 lift_definition uint64_set_bits :: "(nat \<Rightarrow> bool) \<Rightarrow> uint64 \<Rightarrow> nat \<Rightarrow> uint64" is set_bits_aux .
 
 lemma uint64_set_bits_code [code]:
   "uint64_set_bits f w n =
   (if n = 0 then w 
    else let n' = n - 1 in uint64_set_bits f (push_bit 1 w OR (if f n' then 1 else 0)) n')"
   apply (transfer fixing: n)
   apply (cases n)
-   apply (simp_all add: shiftl_eq_push_bit)
+   apply simp_all
   done
 
 lemma set_bits_uint64 [code]:
   "(BITS n. f n) = uint64_set_bits f 0 64"
 by transfer(simp add: set_bits_conv_set_bits_aux)
 
 
 lemma lsb_code [code]: fixes x :: uint64 shows "lsb x = bit x 0"
   by transfer (simp add: lsb_word_eq)
 
 
 definition uint64_shiftl :: "uint64 \<Rightarrow> integer \<Rightarrow> uint64"
 where [code del]:
   "uint64_shiftl x n = (if n < 0 \<or> 64 \<le> n then undefined (push_bit :: nat \<Rightarrow> uint64 \<Rightarrow> _) x n else push_bit (nat_of_integer n) x)"
 
 lemma shiftl_uint64_code [code]: "push_bit n x = (if n < 64 then uint64_shiftl x (integer_of_nat n) else 0)"
   including undefined_transfer integer.lifting unfolding uint64_shiftl_def
   by transfer simp
 
 lemma uint64_shiftl_code [code abstract]:
   "Rep_uint64 (uint64_shiftl w n) =
   (if n < 0 \<or> 64 \<le> n then Rep_uint64 (undefined (push_bit :: nat \<Rightarrow> uint64 \<Rightarrow> _) w n) else push_bit (nat_of_integer n) (Rep_uint64 w))"
 including undefined_transfer unfolding uint64_shiftl_def by transfer simp
 
 code_printing constant uint64_shiftl \<rightharpoonup>
   (SML) "Uint64.shiftl" and
   (Haskell) "Data'_Bits.shiftlBounded" and
   (OCaml) "Uint64.shiftl" and
   (Scala) "Uint64.shiftl" and
   (Eval) "(fn x => fn i => if i < 0 orelse i >= 64 then raise (Fail \"argument to uint64'_shiftl out of bounds\") else Uint64.shiftl x i)"
 
 
 definition uint64_shiftr :: "uint64 \<Rightarrow> integer \<Rightarrow> uint64"
 where [code del]:
   "uint64_shiftr x n = (if n < 0 \<or> 64 \<le> n then undefined (drop_bit :: nat \<Rightarrow> uint64 \<Rightarrow> _) x n else drop_bit (nat_of_integer n) x)"
 
 lemma shiftr_uint64_code [code]: "drop_bit n x = (if n < 64 then uint64_shiftr x (integer_of_nat n) else 0)"
   including undefined_transfer integer.lifting unfolding uint64_shiftr_def
   by transfer simp
 
 lemma uint64_shiftr_code [code abstract]:
   "Rep_uint64 (uint64_shiftr w n) =
   (if n < 0 \<or> 64 \<le> n then Rep_uint64 (undefined (drop_bit :: nat \<Rightarrow> uint64 \<Rightarrow> _) w n) else drop_bit (nat_of_integer n) (Rep_uint64 w))"
   including undefined_transfer unfolding uint64_shiftr_def by transfer simp
 
 code_printing constant uint64_shiftr \<rightharpoonup>
   (SML) "Uint64.shiftr" and
   (Haskell) "Data'_Bits.shiftrBounded" and
   (OCaml) "Uint64.shiftr" and
   (Scala) "Uint64.shiftr" and
   (Eval) "(fn x => fn i => if i < 0 orelse i >= 64 then raise (Fail \"argument to uint64'_shiftr out of bounds\") else Uint64.shiftr x i)"
 
 
 definition uint64_sshiftr :: "uint64 \<Rightarrow> integer \<Rightarrow> uint64"
 where [code del]:
   "uint64_sshiftr x n =
   (if n < 0 \<or> 64 \<le> n then undefined sshiftr_uint64 x n else sshiftr_uint64 x (nat_of_integer n))"
 
 lemma sshiftr_uint64_code [code]:
   "x >>> n = 
   (if n < 64 then uint64_sshiftr x (integer_of_nat n) else if bit x 63 then - 1 else 0)"
   including undefined_transfer integer.lifting unfolding uint64_sshiftr_def
   by transfer (simp add: not_less signed_drop_bit_beyond)
 
 lemma uint64_sshiftr_code [code abstract]:
   "Rep_uint64 (uint64_sshiftr w n) =
   (if n < 0 \<or> 64 \<le> n then Rep_uint64 (undefined sshiftr_uint64 w n) else signed_drop_bit (nat_of_integer n) (Rep_uint64 w))"
 including undefined_transfer unfolding uint64_sshiftr_def by transfer simp
 
 code_printing constant uint64_sshiftr \<rightharpoonup>
   (SML) "Uint64.shiftr'_signed" and
   (Haskell) 
     "(Prelude.fromInteger (Prelude.toInteger (Data'_Bits.shiftrBounded (Prelude.fromInteger (Prelude.toInteger _) :: Uint64.Int64) _)) :: Uint64.Word64)" and
   (OCaml) "Uint64.shiftr'_signed" and
   (Scala) "Uint64.shiftr'_signed" and
   (Eval) "(fn x => fn i => if i < 0 orelse i >= 64 then raise (Fail \"argument to uint64'_shiftr'_signed out of bounds\") else Uint64.shiftr'_signed x i)"
 
 lemma uint64_msb_test_bit: "msb x \<longleftrightarrow> bit (x :: uint64) 63"
   by transfer (simp add: msb_word_iff_bit)
 
 lemma msb_uint64_code [code]: "msb x \<longleftrightarrow> uint64_test_bit x 63"
   by (simp add: uint64_test_bit_def uint64_msb_test_bit)
 
 lemma uint64_of_int_code [code]: "uint64_of_int i = Uint64 (integer_of_int i)"
 including integer.lifting by transfer simp
 
 lemma int_of_uint64_code [code]:
   "int_of_uint64 x = int_of_integer (integer_of_uint64 x)"
 by(simp add: integer_of_uint64_def)
 
 lemma nat_of_uint64_code [code]:
   "nat_of_uint64 x = nat_of_integer (integer_of_uint64 x)"
 unfolding integer_of_uint64_def including integer.lifting by transfer simp
 
 definition integer_of_uint64_signed :: "uint64 \<Rightarrow> integer"
 where
   "integer_of_uint64_signed n = (if bit n 63 then undefined integer_of_uint64 n else integer_of_uint64 n)"
 
 lemma integer_of_uint64_signed_code [code]:
   "integer_of_uint64_signed n =
   (if bit n 63 then undefined integer_of_uint64 n else integer_of_int (uint (Rep_uint64' n)))"
 unfolding integer_of_uint64_signed_def integer_of_uint64_def
 including undefined_transfer by transfer simp
 
 lemma integer_of_uint64_code [code]:
   "integer_of_uint64 n =
   (if bit n 63 then integer_of_uint64_signed (n AND 0x7FFFFFFFFFFFFFFF) OR 0x8000000000000000 else integer_of_uint64_signed n)"
 proof -
   have \<open>(0x7FFFFFFFFFFFFFFF :: uint64) = mask 63\<close>
     by (simp add: mask_eq_exp_minus_1)
   then have *: \<open>n AND 0x7FFFFFFFFFFFFFFF = take_bit 63 n\<close>
     by (simp add: take_bit_eq_mask)
   have **: \<open>(0x8000000000000000 :: int) = 2 ^ 63\<close>
     by simp
   show ?thesis
     unfolding integer_of_uint64_def integer_of_uint64_signed_def o_def *
     including undefined_transfer integer.lifting
     apply transfer
     apply (rule bit_eqI)
     apply (simp add: bit_or_iff bit_take_bit_iff bit_uint_iff)
     apply (simp only: bit_exp_iff bit_or_iff **)
     apply auto
     done
 qed
 
 code_printing
   constant "integer_of_uint64" \<rightharpoonup>
   (SML) "Uint64.toInt" and
   (Haskell) "Prelude.toInteger"
 | constant "integer_of_uint64_signed" \<rightharpoonup>
   (OCaml) "Z.of'_int64" and
   (Scala) "BigInt"
 
 section \<open>Quickcheck setup\<close>
 
 definition uint64_of_natural :: "natural \<Rightarrow> uint64"
 where "uint64_of_natural x \<equiv> Uint64 (integer_of_natural x)"
 
 instantiation uint64 :: "{random, exhaustive, full_exhaustive}" begin
 definition "random_uint64 \<equiv> qc_random_cnv uint64_of_natural"
 definition "exhaustive_uint64 \<equiv> qc_exhaustive_cnv uint64_of_natural"
 definition "full_exhaustive_uint64 \<equiv> qc_full_exhaustive_cnv uint64_of_natural"
 instance ..
 end
 
 instantiation uint64 :: narrowing begin
 
 interpretation quickcheck_narrowing_samples
   "\<lambda>i. let x = Uint64 i in (x, 0xFFFFFFFFFFFFFFFF - x)" "0"
   "Typerep.Typerep (STR ''Uint64.uint64'') []" .
 
 definition "narrowing_uint64 d = qc_narrowing_drawn_from (narrowing_samples d) d"
 declare [[code drop: "partial_term_of :: uint64 itself \<Rightarrow> _"]]
 lemmas partial_term_of_uint64 [code] = partial_term_of_code
 
 instance ..
 end
 
 no_notation sshiftr_uint64 (infixl ">>>" 55)
 
 end
diff --git a/thys/Native_Word/Uint8.thy b/thys/Native_Word/Uint8.thy
--- a/thys/Native_Word/Uint8.thy
+++ b/thys/Native_Word/Uint8.thy
@@ -1,714 +1,697 @@
 (*  Title:      Uint8.thy
     Author:     Andreas Lochbihler, ETH Zurich
 *)
 
 chapter \<open>Unsigned words of 8 bits\<close>
 
 theory Uint8 imports
   Code_Target_Word_Base
 begin
 
 text \<open>
   Restriction for OCaml code generation:
   OCaml does not provide an int8 type, so no special code generation 
   for this type is set up. If the theory \<open>Code_Target_Bits_Int\<close>
   is imported, the type \<open>uint8\<close> is emulated via @{typ "8 word"}.
 \<close>
 
 declare prod.Quotient[transfer_rule]
 
 section \<open>Type definition and primitive operations\<close>
 
 typedef uint8 = "UNIV :: 8 word set" ..
 
 setup_lifting type_definition_uint8
 
 text \<open>Use an abstract type for code generation to disable pattern matching on @{term Abs_uint8}.\<close>
 declare Rep_uint8_inverse[code abstype]
 
 declare Quotient_uint8[transfer_rule]
 
 instantiation uint8 :: comm_ring_1
 begin
 lift_definition zero_uint8 :: uint8 is "0 :: 8 word" .
 lift_definition one_uint8 :: uint8 is "1" .
 lift_definition plus_uint8 :: "uint8 \<Rightarrow> uint8 \<Rightarrow> uint8" is "(+) :: 8 word \<Rightarrow> _" .
 lift_definition minus_uint8 :: "uint8 \<Rightarrow> uint8 \<Rightarrow> uint8" is "(-)" .
 lift_definition uminus_uint8 :: "uint8 \<Rightarrow> uint8" is uminus .
 lift_definition times_uint8 :: "uint8 \<Rightarrow> uint8 \<Rightarrow> uint8" is "(*)" .
 instance by (standard; transfer) (simp_all add: algebra_simps)
 end
 
 instantiation uint8 :: semiring_modulo
 begin
 lift_definition divide_uint8 :: "uint8 \<Rightarrow> uint8 \<Rightarrow> uint8" is "(div)" .
 lift_definition modulo_uint8 :: "uint8 \<Rightarrow> uint8 \<Rightarrow> uint8" is "(mod)" .
 instance by (standard; transfer) (fact word_mod_div_equality)
 end
 
 instantiation uint8 :: linorder begin
 lift_definition less_uint8 :: "uint8 \<Rightarrow> uint8 \<Rightarrow> bool" is "(<)" .
 lift_definition less_eq_uint8 :: "uint8 \<Rightarrow> uint8 \<Rightarrow> bool" is "(\<le>)" .
 instance by (standard; transfer) (simp_all add: less_le_not_le linear)
 end
 
 lemmas [code] = less_uint8.rep_eq less_eq_uint8.rep_eq
 
 context
   includes lifting_syntax
   notes
     transfer_rule_of_bool [transfer_rule]
     transfer_rule_numeral [transfer_rule]
 begin
 
 lemma [transfer_rule]:
   "((=) ===> cr_uint8) of_bool of_bool"
   by transfer_prover
 
 lemma transfer_rule_numeral_uint [transfer_rule]:
   "((=) ===> cr_uint8) numeral numeral"
   by transfer_prover
 
 lemma [transfer_rule]:
   \<open>(cr_uint8 ===> (\<longleftrightarrow>)) even ((dvd) 2 :: uint8 \<Rightarrow> bool)\<close>
   by (unfold dvd_def) transfer_prover
 
 end
 
 instantiation uint8 :: semiring_bits
 begin
 
 lift_definition bit_uint8 :: \<open>uint8 \<Rightarrow> nat \<Rightarrow> bool\<close> is bit .
 
 instance
   by (standard; transfer)
     (fact bit_iff_odd even_iff_mod_2_eq_zero odd_iff_mod_2_eq_one odd_one bits_induct
        bits_div_0 bits_div_by_1 bits_mod_div_trivial even_succ_div_2
        even_mask_div_iff exp_div_exp_eq div_exp_eq mod_exp_eq mult_exp_mod_exp_eq
        div_exp_mod_exp_eq even_mult_exp_div_exp_iff)+
 
 end
 
 instantiation uint8 :: semiring_bit_shifts
 begin
 lift_definition push_bit_uint8 :: \<open>nat \<Rightarrow> uint8 \<Rightarrow> uint8\<close> is push_bit .
 lift_definition drop_bit_uint8 :: \<open>nat \<Rightarrow> uint8 \<Rightarrow> uint8\<close> is drop_bit .
 lift_definition take_bit_uint8 :: \<open>nat \<Rightarrow> uint8 \<Rightarrow> uint8\<close> is take_bit .
 instance by (standard; transfer)
   (fact push_bit_eq_mult drop_bit_eq_div take_bit_eq_mod)+
 end
 
 instantiation uint8 :: ring_bit_operations
 begin
 lift_definition not_uint8 :: \<open>uint8 \<Rightarrow> uint8\<close> is NOT .
 lift_definition and_uint8 :: \<open>uint8 \<Rightarrow> uint8 \<Rightarrow> uint8\<close> is \<open>(AND)\<close> .
 lift_definition or_uint8 :: \<open>uint8 \<Rightarrow> uint8 \<Rightarrow> uint8\<close> is \<open>(OR)\<close> .
 lift_definition xor_uint8 :: \<open>uint8 \<Rightarrow> uint8 \<Rightarrow> uint8\<close> is \<open>(XOR)\<close> .
 lift_definition mask_uint8 :: \<open>nat \<Rightarrow> uint8\<close> is mask .
 lift_definition set_bit_uint8 :: \<open>nat \<Rightarrow> uint8 \<Rightarrow> uint8\<close> is \<open>Bit_Operations.set_bit\<close> .
 lift_definition unset_bit_uint8 :: \<open>nat \<Rightarrow> uint8 \<Rightarrow> uint8\<close> is \<open>unset_bit\<close> .
 lift_definition flip_bit_uint8 :: \<open>nat \<Rightarrow> uint8 \<Rightarrow> uint8\<close> is \<open>flip_bit\<close> .
 instance by (standard; transfer)
   (simp_all add: bit_simps mask_eq_decr_exp minus_eq_not_minus_1 set_bit_def flip_bit_def)
 end
 
 lemma [code]:
   \<open>take_bit n a = a AND mask n\<close> for a :: uint8
   by (fact take_bit_eq_mask)
 
 lemma [code]:
   \<open>mask (Suc n) = push_bit n (1 :: uint8) OR mask n\<close>
   \<open>mask 0 = (0 :: uint8)\<close>
   by (simp_all add: mask_Suc_exp push_bit_of_1)
 
 lemma [code]:
   \<open>Bit_Operations.set_bit n w = w OR push_bit n 1\<close> for w :: uint8
   by (fact set_bit_eq_or)
 
 lemma [code]:
   \<open>unset_bit n w = w AND NOT (push_bit n 1)\<close> for w :: uint8
   by (fact unset_bit_eq_and_not)
 
 lemma [code]:
   \<open>flip_bit n w = w XOR push_bit n 1\<close> for w :: uint8
   by (fact flip_bit_eq_xor)
 
-instance uint8 :: semiring_bit_syntax ..
-
-context
-  includes lifting_syntax
-begin
-
-lemma shiftl_uint8_transfer [transfer_rule]:
-  \<open>(cr_uint8 ===> (=) ===> cr_uint8) (\<lambda>k n. push_bit n k) (<<)\<close>
-  unfolding shiftl_eq_push_bit by transfer_prover
-
-lemma shiftr_uint8_transfer [transfer_rule]:
-  \<open>(cr_uint8 ===> (=) ===> cr_uint8) (\<lambda>k n. drop_bit n k) (>>)\<close>
-  unfolding shiftr_eq_drop_bit by transfer_prover
-
-end
-
 instantiation uint8 :: lsb
 begin
 lift_definition lsb_uint8 :: \<open>uint8 \<Rightarrow> bool\<close> is lsb .
 instance by (standard; transfer)
   (fact lsb_odd)
 end
 
 instantiation uint8 :: msb
 begin
 lift_definition msb_uint8 :: \<open>uint8 \<Rightarrow> bool\<close> is msb .
 instance ..
 end
 
 setup \<open>Context.theory_map (Name_Space.map_naming (Name_Space.qualified_path true \<^binding>\<open>Generic\<close>))\<close>
 
 instantiation uint8 :: set_bit
 begin
 lift_definition set_bit_uint8 :: \<open>uint8 \<Rightarrow> nat \<Rightarrow> bool \<Rightarrow> uint8\<close> is set_bit .
 instance
   apply standard
   apply transfer
   apply (simp add: bit_simps)
   done
 end
 
 setup \<open>Context.theory_map (Name_Space.map_naming (Name_Space.parent_path))\<close>
 
 instantiation uint8 :: bit_comprehension begin
 lift_definition set_bits_uint8 :: "(nat \<Rightarrow> bool) \<Rightarrow> uint8" is "set_bits" .
 instance by (standard; transfer) (fact set_bits_bit_eq)
 end
 
 lemmas [code] = bit_uint8.rep_eq lsb_uint8.rep_eq msb_uint8.rep_eq
 
 instantiation uint8 :: equal begin
 lift_definition equal_uint8 :: "uint8 \<Rightarrow> uint8 \<Rightarrow> bool" is "equal_class.equal" .
 instance by standard (transfer, simp add: equal_eq)
 end
 
 lemmas [code] = equal_uint8.rep_eq
 
 instantiation uint8 :: size begin
 lift_definition size_uint8 :: "uint8 \<Rightarrow> nat" is "size" .
 instance ..
 end
 
 lemmas [code] = size_uint8.rep_eq
 
 lift_definition sshiftr_uint8 :: "uint8 \<Rightarrow> nat \<Rightarrow> uint8" (infixl ">>>" 55) is \<open>\<lambda>w n. signed_drop_bit n w\<close> .
 
 lift_definition uint8_of_int :: "int \<Rightarrow> uint8" is "word_of_int" .
 
 definition uint8_of_nat :: "nat \<Rightarrow> uint8"
 where "uint8_of_nat = uint8_of_int \<circ> int"
 
 lift_definition int_of_uint8 :: "uint8 \<Rightarrow> int" is "uint" .
 lift_definition nat_of_uint8 :: "uint8 \<Rightarrow> nat" is "unat" .
 
 definition integer_of_uint8 :: "uint8 \<Rightarrow> integer"
 where "integer_of_uint8 = integer_of_int o int_of_uint8"
 
 text \<open>Use pretty numerals from integer for pretty printing\<close>
 
 context includes integer.lifting begin
 
 lift_definition Uint8 :: "integer \<Rightarrow> uint8" is "word_of_int" .
 
 lemma Rep_uint8_numeral [simp]: "Rep_uint8 (numeral n) = numeral n"
 by(induction n)(simp_all add: one_uint8_def Abs_uint8_inverse numeral.simps plus_uint8_def)
 
 lemma numeral_uint8_transfer [transfer_rule]:
   "(rel_fun (=) cr_uint8) numeral numeral"
 by(auto simp add: cr_uint8_def)
 
 lemma numeral_uint8 [code_unfold]: "numeral n = Uint8 (numeral n)"
 by transfer simp
 
 lemma Rep_uint8_neg_numeral [simp]: "Rep_uint8 (- numeral n) = - numeral n"
 by(simp only: uminus_uint8_def)(simp add: Abs_uint8_inverse)
 
 lemma neg_numeral_uint8 [code_unfold]: "- numeral n = Uint8 (- numeral n)"
 by transfer(simp add: cr_uint8_def)
 
 end
 
 lemma Abs_uint8_numeral [code_post]: "Abs_uint8 (numeral n) = numeral n"
 by(induction n)(simp_all add: one_uint8_def numeral.simps plus_uint8_def Abs_uint8_inverse)
 
 lemma Abs_uint8_0 [code_post]: "Abs_uint8 0 = 0"
 by(simp add: zero_uint8_def)
 
 lemma Abs_uint8_1 [code_post]: "Abs_uint8 1 = 1"
 by(simp add: one_uint8_def)
 
 section \<open>Code setup\<close>
 
 code_printing code_module Uint8 \<rightharpoonup> (SML)
 \<open>(* Test that words can handle numbers between 0 and 3 *)
 val _ = if 3 <= Word.wordSize then () else raise (Fail ("wordSize less than 3"));
 
 structure Uint8 : sig
   val set_bit : Word8.word -> IntInf.int -> bool -> Word8.word
   val shiftl : Word8.word -> IntInf.int -> Word8.word
   val shiftr : Word8.word -> IntInf.int -> Word8.word
   val shiftr_signed : Word8.word -> IntInf.int -> Word8.word
   val test_bit : Word8.word -> IntInf.int -> bool
 end = struct
 
 fun set_bit x n b =
   let val mask = Word8.<< (0wx1, Word.fromLargeInt (IntInf.toLarge n))
   in if b then Word8.orb (x, mask)
      else Word8.andb (x, Word8.notb mask)
   end
 
 fun shiftl x n =
   Word8.<< (x, Word.fromLargeInt (IntInf.toLarge n))
 
 fun shiftr x n =
   Word8.>> (x, Word.fromLargeInt (IntInf.toLarge n))
 
 fun shiftr_signed x n =
   Word8.~>> (x, Word.fromLargeInt (IntInf.toLarge n))
 
 fun test_bit x n =
   Word8.andb (x, Word8.<< (0wx1, Word.fromLargeInt (IntInf.toLarge n))) <> Word8.fromInt 0
 
 end; (* struct Uint8 *)\<close>
 code_reserved SML Uint8
 
 code_printing code_module Uint8 \<rightharpoonup> (Haskell)
  \<open>module Uint8(Int8, Word8) where
 
   import Data.Int(Int8)
   import Data.Word(Word8)\<close>
 code_reserved Haskell Uint8
 
 text \<open>
   Scala provides only signed 8bit numbers, so we use these and 
   implement sign-sensitive operations like comparisons manually.
 \<close>
 
 code_printing code_module Uint8 \<rightharpoonup> (Scala)
 \<open>object Uint8 {
 
 def less(x: Byte, y: Byte) : Boolean =
   if (x < 0) y < 0 && x < y
   else y < 0 || x < y
 
 def less_eq(x: Byte, y: Byte) : Boolean =
   if (x < 0) y < 0 && x <= y
   else y < 0 || x <= y
 
 def set_bit(x: Byte, n: BigInt, b: Boolean) : Byte =
   if (b)
     (x | (1 << n.intValue)).toByte
   else
     (x & (1 << n.intValue).unary_~).toByte
 
 def shiftl(x: Byte, n: BigInt) : Byte = (x << n.intValue).toByte
 
 def shiftr(x: Byte, n: BigInt) : Byte = ((x & 255) >>> n.intValue).toByte
 
 def shiftr_signed(x: Byte, n: BigInt) : Byte = (x >> n.intValue).toByte
 
 def test_bit(x: Byte, n: BigInt) : Boolean =
   (x & (1 << n.intValue)) != 0
 
 } /* object Uint8 */\<close>
 code_reserved Scala Uint8
 
 text \<open>
   Avoid @{term Abs_uint8} in generated code, use @{term Rep_uint8'} instead. 
   The symbolic implementations for code\_simp use @{term Rep_uint8}.
 
   The new destructor @{term Rep_uint8'} is executable.
   As the simplifier is given the [code abstract] equations literally, 
   we cannot implement @{term Rep_uint8} directly, because that makes code\_simp loop.
 
   If code generation raises Match, some equation probably contains @{term Rep_uint8} 
   ([code abstract] equations for @{typ uint8} may use @{term Rep_uint8} because
   these instances will be folded away.)
 
   To convert @{typ "8 word"} values into @{typ uint8}, use @{term "Abs_uint8'"}.
 \<close>
 
 definition Rep_uint8' where [simp]: "Rep_uint8' = Rep_uint8"
 
 lemma Rep_uint8'_transfer [transfer_rule]:
   "rel_fun cr_uint8 (=) (\<lambda>x. x) Rep_uint8'"
 unfolding Rep_uint8'_def by(rule uint8.rep_transfer)
 
 lemma Rep_uint8'_code [code]: "Rep_uint8' x = (BITS n. bit x n)"
   by transfer (simp add: set_bits_bit_eq)
 
 lift_definition Abs_uint8' :: "8 word \<Rightarrow> uint8" is "\<lambda>x :: 8 word. x" .
 
 lemma Abs_uint8'_code [code]: "Abs_uint8' x = Uint8 (integer_of_int (uint x))"
 including integer.lifting by transfer simp
 
 declare [[code drop: "term_of_class.term_of :: uint8 \<Rightarrow> _"]]
 
 lemma term_of_uint8_code [code]:
   defines "TR \<equiv> typerep.Typerep" and "bit0 \<equiv> STR ''Numeral_Type.bit0''" shows
   "term_of_class.term_of x = 
    Code_Evaluation.App (Code_Evaluation.Const (STR ''Uint8.uint8.Abs_uint8'') (TR (STR ''fun'') [TR (STR ''Word.word'') [TR bit0 [TR bit0 [TR bit0 [TR (STR ''Numeral_Type.num1'') []]]]], TR (STR ''Uint8.uint8'') []]))
        (term_of_class.term_of (Rep_uint8' x))"
 by(simp add: term_of_anything)
 
 lemma Uin8_code [code abstract]: "Rep_uint8 (Uint8 i) = word_of_int (int_of_integer_symbolic i)"
 unfolding Uint8_def int_of_integer_symbolic_def by(simp add: Abs_uint8_inverse)
 
 code_printing type_constructor uint8 \<rightharpoonup>
   (SML) "Word8.word" and
   (Haskell) "Uint8.Word8" and
   (Scala) "Byte"
 | constant Uint8 \<rightharpoonup> 
   (SML) "Word8.fromLargeInt (IntInf.toLarge _)" and
   (Haskell) "(Prelude.fromInteger _ :: Uint8.Word8)" and
   (Haskell_Quickcheck) "(Prelude.fromInteger (Prelude.toInteger _) :: Uint8.Word8)" and
   (Scala) "_.byteValue"
 | constant "0 :: uint8" \<rightharpoonup>
   (SML) "(Word8.fromInt 0)" and
   (Haskell) "(0 :: Uint8.Word8)" and
   (Scala) "0.toByte"
 | constant "1 :: uint8" \<rightharpoonup>
   (SML) "(Word8.fromInt 1)" and
   (Haskell) "(1 :: Uint8.Word8)" and
   (Scala) "1.toByte"
 | constant "plus :: uint8 \<Rightarrow> _ \<Rightarrow> _" \<rightharpoonup>
   (SML) "Word8.+ ((_), (_))" and
   (Haskell) infixl 6 "+" and
   (Scala) "(_ +/ _).toByte"
 | constant "uminus :: uint8 \<Rightarrow> _" \<rightharpoonup>
   (SML) "Word8.~" and
   (Haskell) "negate" and
   (Scala) "(- _).toByte"
 | constant "minus :: uint8 \<Rightarrow> _" \<rightharpoonup>
   (SML) "Word8.- ((_), (_))" and
   (Haskell) infixl 6 "-" and
   (Scala) "(_ -/ _).toByte"
 | constant "times :: uint8 \<Rightarrow> _ \<Rightarrow> _" \<rightharpoonup>
   (SML) "Word8.* ((_), (_))" and
   (Haskell) infixl 7 "*" and
   (Scala) "(_ */ _).toByte"
 | constant "HOL.equal :: uint8 \<Rightarrow> _ \<Rightarrow> bool" \<rightharpoonup>
   (SML) "!((_ : Word8.word) = _)" and
   (Haskell) infix 4 "==" and
   (Scala) infixl 5 "=="
 | class_instance uint8 :: equal \<rightharpoonup> (Haskell) -
 | constant "less_eq :: uint8 \<Rightarrow> _ \<Rightarrow> bool" \<rightharpoonup>
   (SML) "Word8.<= ((_), (_))" and
   (Haskell) infix 4 "<=" and
   (Scala) "Uint8.less'_eq"
 | constant "less :: uint8 \<Rightarrow> _ \<Rightarrow> bool" \<rightharpoonup>
   (SML) "Word8.< ((_), (_))" and
   (Haskell) infix 4 "<" and
   (Scala) "Uint8.less"
 | constant "NOT :: uint8 \<Rightarrow> _" \<rightharpoonup>
   (SML) "Word8.notb" and
   (Haskell) "Data'_Bits.complement" and
   (Scala) "_.unary'_~.toByte"
 | constant "(AND) :: uint8 \<Rightarrow> _" \<rightharpoonup>
   (SML) "Word8.andb ((_),/ (_))" and
   (Haskell) infixl 7 "Data_Bits..&." and
   (Scala) "(_ & _).toByte"
 | constant "(OR) :: uint8 \<Rightarrow> _" \<rightharpoonup>
   (SML) "Word8.orb ((_),/ (_))" and
   (Haskell) infixl 5 "Data_Bits..|." and
   (Scala) "(_ | _).toByte"
 | constant "(XOR) :: uint8 \<Rightarrow> _" \<rightharpoonup>
   (SML) "Word8.xorb ((_),/ (_))" and
   (Haskell) "Data'_Bits.xor" and
   (Scala) "(_ ^ _).toByte"
 
 definition uint8_divmod :: "uint8 \<Rightarrow> uint8 \<Rightarrow> uint8 \<times> uint8" where
   "uint8_divmod x y = 
   (if y = 0 then (undefined ((div) :: uint8 \<Rightarrow> _) x (0 :: uint8), undefined ((mod) :: uint8 \<Rightarrow> _) x (0 :: uint8)) 
   else (x div y, x mod y))"
 
 definition uint8_div :: "uint8 \<Rightarrow> uint8 \<Rightarrow> uint8" 
 where "uint8_div x y = fst (uint8_divmod x y)"
 
 definition uint8_mod :: "uint8 \<Rightarrow> uint8 \<Rightarrow> uint8" 
 where "uint8_mod x y = snd (uint8_divmod x y)"
 
 lemma div_uint8_code [code]: "x div y = (if y = 0 then 0 else uint8_div x y)"
 including undefined_transfer unfolding uint8_divmod_def uint8_div_def
 by transfer (simp add: word_div_def)
 
 lemma mod_uint8_code [code]: "x mod y = (if y = 0 then x else uint8_mod x y)"
 including undefined_transfer unfolding uint8_mod_def uint8_divmod_def
 by transfer (simp add: word_mod_def)
 
 definition uint8_sdiv :: "uint8 \<Rightarrow> uint8 \<Rightarrow> uint8"
 where
   "uint8_sdiv x y =
    (if y = 0 then undefined ((div) :: uint8 \<Rightarrow> _) x (0 :: uint8)
     else Abs_uint8 (Rep_uint8 x sdiv Rep_uint8 y))"
 
 definition div0_uint8 :: "uint8 \<Rightarrow> uint8"
 where [code del]: "div0_uint8 x = undefined ((div) :: uint8 \<Rightarrow> _) x (0 :: uint8)"
 declare [[code abort: div0_uint8]]
 
 definition mod0_uint8 :: "uint8 \<Rightarrow> uint8"
 where [code del]: "mod0_uint8 x = undefined ((mod) :: uint8 \<Rightarrow> _) x (0 :: uint8)"
 declare [[code abort: mod0_uint8]]
 
 lemma uint8_divmod_code [code]:
   "uint8_divmod x y =
   (if 0x80 \<le> y then if x < y then (0, x) else (1, x - y)
    else if y = 0 then (div0_uint8 x, mod0_uint8 x)
-   else let q = (uint8_sdiv (x >> 1) y) << 1;
+   else let q = push_bit 1 (uint8_sdiv (drop_bit 1 x) y);
             r = x - q * y
         in if r \<ge> y then (q + 1, r - y) else (q, r))"
 including undefined_transfer unfolding uint8_divmod_def uint8_sdiv_def div0_uint8_def mod0_uint8_def
   apply transfer
-  apply (simp add: divmod_via_sdivmod)
-  apply (simp add: shiftl_eq_push_bit shiftr_eq_drop_bit)
+  apply (simp add: divmod_via_sdivmod push_bit_eq_mult)
   done
 
 lemma uint8_sdiv_code [code abstract]:
   "Rep_uint8 (uint8_sdiv x y) =
    (if y = 0 then Rep_uint8 (undefined ((div) :: uint8 \<Rightarrow> _) x (0 :: uint8))
     else Rep_uint8 x sdiv Rep_uint8 y)"
 unfolding uint8_sdiv_def by(simp add: Abs_uint8_inverse)
 
 text \<open>
   Note that we only need a translation for signed division, but not for the remainder
   because @{thm uint8_divmod_code} computes both with division only.
 \<close>
 
 code_printing
   constant uint8_div \<rightharpoonup>
   (SML) "Word8.div ((_), (_))" and
   (Haskell) "Prelude.div"
 | constant uint8_mod \<rightharpoonup>
   (SML) "Word8.mod ((_), (_))" and
   (Haskell) "Prelude.mod"
 | constant uint8_divmod \<rightharpoonup>
   (Haskell) "divmod"
 | constant uint8_sdiv \<rightharpoonup>
   (Scala) "(_ '/ _).toByte"
 
 definition uint8_test_bit :: "uint8 \<Rightarrow> integer \<Rightarrow> bool"
 where [code del]:
   "uint8_test_bit x n =
   (if n < 0 \<or> 7 < n then undefined (bit :: uint8 \<Rightarrow> _) x n
    else bit x (nat_of_integer n))"
 
 lemma bit_uint8_code [code]:
   "bit x n \<longleftrightarrow> n < 8 \<and> uint8_test_bit x (integer_of_nat n)"
   including undefined_transfer integer.lifting unfolding uint8_test_bit_def
   by (transfer, simp, transfer, simp)
 
 lemma uint8_test_bit_code [code]:
   "uint8_test_bit w n =
   (if n < 0 \<or> 7 < n then undefined (bit :: uint8 \<Rightarrow> _) w n else bit (Rep_uint8 w) (nat_of_integer n))"
   unfolding uint8_test_bit_def
   by (simp add: bit_uint8.rep_eq)
 
 code_printing constant uint8_test_bit \<rightharpoonup>
   (SML) "Uint8.test'_bit" and
   (Haskell) "Data'_Bits.testBitBounded" and
   (Scala) "Uint8.test'_bit" and
   (Eval) "(fn x => fn i => if i < 0 orelse i >= 8 then raise (Fail \"argument to uint8'_test'_bit out of bounds\") else Uint8.test'_bit x i)"
 
 
 definition uint8_set_bit :: "uint8 \<Rightarrow> integer \<Rightarrow> bool \<Rightarrow> uint8"
 where [code del]:
   "uint8_set_bit x n b =
   (if n < 0 \<or> 7 < n then undefined (set_bit :: uint8 \<Rightarrow> _) x n b
    else set_bit x (nat_of_integer n) b)"
 
 lemma set_bit_uint8_code [code]:
   "set_bit x n b = (if n < 8 then uint8_set_bit x (integer_of_nat n) b else x)"
 including undefined_transfer integer.lifting unfolding uint8_set_bit_def
 by(transfer)(auto cong: conj_cong simp add: not_less set_bit_beyond word_size)
 
 lemma uint8_set_bit_code [code abstract]:
   "Rep_uint8 (uint8_set_bit w n b) = 
   (if n < 0 \<or> 7 < n then Rep_uint8 (undefined (set_bit :: uint8 \<Rightarrow> _) w n b)
    else set_bit (Rep_uint8 w) (nat_of_integer n) b)"
 including undefined_transfer unfolding uint8_set_bit_def by transfer simp
 
 code_printing constant uint8_set_bit \<rightharpoonup>
   (SML) "Uint8.set'_bit" and
   (Haskell) "Data'_Bits.setBitBounded" and
   (Scala) "Uint8.set'_bit" and
   (Eval) "(fn x => fn i => fn b => if i < 0 orelse i >= 8 then raise (Fail \"argument to uint8'_set'_bit out of bounds\") else Uint8.set'_bit x i b)"
 
 
 lift_definition uint8_set_bits :: "(nat \<Rightarrow> bool) \<Rightarrow> uint8 \<Rightarrow> nat \<Rightarrow> uint8" is set_bits_aux .
 
 lemma uint8_set_bits_code [code]:
   "uint8_set_bits f w n =
   (if n = 0 then w 
    else let n' = n - 1 in uint8_set_bits f (push_bit 1 w OR (if f n' then 1 else 0)) n')"
   apply (transfer fixing: n)
   apply (cases n)
-   apply (simp_all add: shiftl_eq_push_bit)
+   apply simp_all
   done
 
 lemma set_bits_uint8 [code]:
   "(BITS n. f n) = uint8_set_bits f 0 8"
 by transfer(simp add: set_bits_conv_set_bits_aux)
 
 
 lemma lsb_code [code]: fixes x :: uint8 shows "lsb x = bit x 0"
   by (simp add: lsb_odd)
 
 
 definition uint8_shiftl :: "uint8 \<Rightarrow> integer \<Rightarrow> uint8"
 where [code del]:
   "uint8_shiftl x n = (if n < 0 \<or> 8 \<le> n then undefined (push_bit :: nat \<Rightarrow> uint8 \<Rightarrow> _) x n else push_bit (nat_of_integer n) x)"
 
 lemma shiftl_uint8_code [code]:
   "push_bit n x = (if n < 8 then uint8_shiftl x (integer_of_nat n) else 0)"
   including undefined_transfer integer.lifting unfolding uint8_shiftl_def
   by transfer simp
 
 lemma uint8_shiftl_code [code abstract]:
   "Rep_uint8 (uint8_shiftl w n) =
   (if n < 0 \<or> 8 \<le> n then Rep_uint8 (undefined (push_bit :: nat \<Rightarrow> uint8 \<Rightarrow> _) w n)
    else push_bit (nat_of_integer n) (Rep_uint8 w))"
   including undefined_transfer unfolding uint8_shiftl_def
   by transfer simp
 
 code_printing constant uint8_shiftl \<rightharpoonup>
   (SML) "Uint8.shiftl" and
   (Haskell) "Data'_Bits.shiftlBounded" and
   (Scala) "Uint8.shiftl" and
   (Eval) "(fn x => fn i => if i < 0 orelse i >= 8 then raise (Fail \"argument to uint8'_shiftl out of bounds\") else Uint8.shiftl x i)"
 
 definition uint8_shiftr :: "uint8 \<Rightarrow> integer \<Rightarrow> uint8"
 where [code del]:
-  "uint8_shiftr x n = (if n < 0 \<or> 8 \<le> n then undefined (shiftr :: uint8 \<Rightarrow> _) x n else x >> (nat_of_integer n))"
+  "uint8_shiftr x n = (if n < 0 \<or> 8 \<le> n then undefined (drop_bit :: _ \<Rightarrow> _ \<Rightarrow> uint8) x n else drop_bit (nat_of_integer n) x)"
 
 lemma shiftr_uint8_code [code]:
   "drop_bit n x = (if n < 8 then uint8_shiftr x (integer_of_nat n) else 0)"
   including undefined_transfer integer.lifting unfolding uint8_shiftr_def
   by transfer simp
 
 lemma uint8_shiftr_code [code abstract]:
   "Rep_uint8 (uint8_shiftr w n) =
-  (if n < 0 \<or> 8 \<le> n then Rep_uint8 (undefined (shiftr :: uint8 \<Rightarrow> _) w n) 
+  (if n < 0 \<or> 8 \<le> n then Rep_uint8 (undefined (drop_bit :: _ \<Rightarrow> _ \<Rightarrow> uint8) w n) 
    else drop_bit (nat_of_integer n) (Rep_uint8 w))"
 including undefined_transfer unfolding uint8_shiftr_def by transfer simp
 
 code_printing constant uint8_shiftr \<rightharpoonup>
   (SML) "Uint8.shiftr" and
   (Haskell) "Data'_Bits.shiftrBounded" and
   (Scala) "Uint8.shiftr" and
   (Eval) "(fn x => fn i => if i < 0 orelse i >= 8 then raise (Fail \"argument to uint8'_shiftr out of bounds\") else Uint8.shiftr x i)"
 
 definition uint8_sshiftr :: "uint8 \<Rightarrow> integer \<Rightarrow> uint8"
 where [code del]:
   "uint8_sshiftr x n =
   (if n < 0 \<or> 8 \<le> n then undefined sshiftr_uint8 x n else sshiftr_uint8 x (nat_of_integer n))"
 
 lemma sshiftr_uint8_code [code]:
   "x >>> n = 
   (if n < 8 then uint8_sshiftr x (integer_of_nat n) else if bit x 7 then -1 else 0)"
   including undefined_transfer integer.lifting unfolding uint8_sshiftr_def
   by transfer (simp add: not_less signed_drop_bit_beyond word_size)
 
 lemma uint8_sshiftr_code [code abstract]:
   "Rep_uint8 (uint8_sshiftr w n) =
   (if n < 0 \<or> 8 \<le> n then Rep_uint8 (undefined sshiftr_uint8 w n)
    else signed_drop_bit (nat_of_integer n) (Rep_uint8 w))"
   including undefined_transfer unfolding uint8_sshiftr_def
   by transfer simp
 
 code_printing constant uint8_sshiftr \<rightharpoonup>
   (SML) "Uint8.shiftr'_signed" and
   (Haskell) 
     "(Prelude.fromInteger (Prelude.toInteger (Data'_Bits.shiftrBounded (Prelude.fromInteger (Prelude.toInteger _) :: Uint8.Int8) _)) :: Uint8.Word8)" and
   (Scala) "Uint8.shiftr'_signed" and
   (Eval) "(fn x => fn i => if i < 0 orelse i >= 8 then raise (Fail \"argument to uint8'_sshiftr out of bounds\") else Uint8.shiftr'_signed x i)"
 
 lemma uint8_msb_test_bit: "msb x \<longleftrightarrow> bit (x :: uint8) 7"
   by transfer (simp add: msb_word_iff_bit)
 
 lemma msb_uint16_code [code]: "msb x \<longleftrightarrow> uint8_test_bit x 7"
   by (simp add: uint8_test_bit_def uint8_msb_test_bit)
 
 lemma uint8_of_int_code [code]: "uint8_of_int i = Uint8 (integer_of_int i)"
 including integer.lifting by transfer simp
 
 lemma int_of_uint8_code [code]:
   "int_of_uint8 x = int_of_integer (integer_of_uint8 x)"
 by(simp add: integer_of_uint8_def)
 
 lemma nat_of_uint8_code [code]:
   "nat_of_uint8 x = nat_of_integer (integer_of_uint8 x)"
 unfolding integer_of_uint8_def including integer.lifting by transfer simp
 
 definition integer_of_uint8_signed :: "uint8 \<Rightarrow> integer"
 where
   "integer_of_uint8_signed n = (if bit n 7 then undefined integer_of_uint8 n else integer_of_uint8 n)"
 
 lemma integer_of_uint8_signed_code [code]:
   "integer_of_uint8_signed n =
   (if bit n 7 then undefined integer_of_uint8 n else integer_of_int (uint (Rep_uint8' n)))"
 unfolding integer_of_uint8_signed_def integer_of_uint8_def
 including undefined_transfer by transfer simp
 
 lemma integer_of_uint8_code [code]:
   "integer_of_uint8 n =
   (if bit n 7 then integer_of_uint8_signed (n AND 0x7F) OR 0x80 else integer_of_uint8_signed n)"
 proof -
   have \<open>(0x7F :: uint8) = mask 7\<close>
     by (simp add: mask_eq_exp_minus_1)
   then have *: \<open>n AND 0x7F = take_bit 7 n\<close>
     by (simp only: take_bit_eq_mask)
   have **: \<open>(0x80 :: int) = 2 ^ 7\<close>
     by simp
   show ?thesis
   unfolding integer_of_uint8_def integer_of_uint8_signed_def o_def *
   including undefined_transfer integer.lifting
   apply transfer
   apply (auto simp add: bit_take_bit_iff uint_take_bit_eq)
   apply (rule bit_eqI)
   apply (simp add: bit_uint_iff bit_or_iff bit_take_bit_iff)
   apply (simp only: ** bit_exp_iff)
   apply auto
   done
 qed
 
 code_printing
   constant "integer_of_uint8" \<rightharpoonup>
   (SML) "IntInf.fromLarge (Word8.toLargeInt _)" and
   (Haskell) "Prelude.toInteger"
 | constant "integer_of_uint8_signed" \<rightharpoonup>
   (Scala) "BigInt"
 
 section \<open>Quickcheck setup\<close>
 
 definition uint8_of_natural :: "natural \<Rightarrow> uint8"
 where "uint8_of_natural x \<equiv> Uint8 (integer_of_natural x)"
 
 instantiation uint8 :: "{random, exhaustive, full_exhaustive}" begin
 definition "random_uint8 \<equiv> qc_random_cnv uint8_of_natural"
 definition "exhaustive_uint8 \<equiv> qc_exhaustive_cnv uint8_of_natural"
 definition "full_exhaustive_uint8 \<equiv> qc_full_exhaustive_cnv uint8_of_natural"
 instance ..
 end
 
 instantiation uint8 :: narrowing begin
 
 interpretation quickcheck_narrowing_samples
   "\<lambda>i. let x = Uint8 i in (x, 0xFF - x)" "0"
   "Typerep.Typerep (STR ''Uint8.uint8'') []" .
 
 definition "narrowing_uint8 d = qc_narrowing_drawn_from (narrowing_samples d) d"
 declare [[code drop: "partial_term_of :: uint8 itself \<Rightarrow> _"]]
 lemmas partial_term_of_uint8 [code] = partial_term_of_code
 
 instance ..
 end
 
 no_notation sshiftr_uint8 (infixl ">>>" 55)
 
 end
diff --git a/thys/SPARCv8/SparcModel_MMU/RegistersOps.thy b/thys/SPARCv8/SparcModel_MMU/RegistersOps.thy
--- a/thys/SPARCv8/SparcModel_MMU/RegistersOps.thy
+++ b/thys/SPARCv8/SparcModel_MMU/RegistersOps.thy
@@ -1,79 +1,79 @@
 section\<open>Register Operations\<close>
 theory RegistersOps
-imports Main "../lib/WordDecl" "Word_Lib.Traditional_Infix_Syntax"
+imports Main "../lib/WordDecl" "Word_Lib.Bit_Shifts_Infix_Syntax"
 begin
 
 text\<open>
  This theory provides operations to get, set and clear bits in registers
 \<close>
 
 section "Getting Fields"
   
 text\<open>
   Get a field of type @{typ "'b::len word"} 
   starting at @{term "index"} from @{term "addr"} of type @{typ "'a::len word"}
 \<close>
 definition get_field_from_word_a_b:: "'a::len word \<Rightarrow> nat \<Rightarrow> 'b::len word"
  where
   "get_field_from_word_a_b addr index 
     \<equiv> let off = (size addr - LENGTH('b)) 
        in ucast ((addr << (off-index)) >> off)"
 
 text\<open>
   Obtain, from addr of type @{typ "'a::len word"}, 
   another @{typ "'a::len word"} containing the field of length \<open>len\<close>
   starting at \<open>index\<close> in \<open>addr\<close>. 
 \<close>
 definition get_field_from_word_a_a:: "'a::len word \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> 'a::len word"
  where
   "get_field_from_word_a_a addr index len 
     \<equiv> (addr << (size addr - (index+len)) >> (size addr - len))"
 
 section "Setting Fields"
 
 text\<open>
   Set the field of type @{typ "'b::len word"} 
   at \<open>index\<close> from \<open>record\<close>
   of type @{typ "'a::len word"}. 
 \<close>
 definition set_field :: "'a::len word \<Rightarrow> 'b::len word \<Rightarrow> nat \<Rightarrow> 'a::len word"
  where 
   "set_field record field index 
     \<equiv> let mask:: ('a::len word) = (mask (size field)) << index 
       in  (record AND (NOT mask)) OR ((ucast field) << index)"
 
 
 section "Clearing Fields"
 
 text\<open>
   Zero the \<open>n\<close> initial bits of \<open>addr\<close>.
 \<close>
 definition clear_n_bits:: "'a::len word \<Rightarrow> nat \<Rightarrow> 'a::len word" 
  where
    "clear_n_bits addr n \<equiv> addr AND (NOT (mask n))"
 
 text\<open>
   Gets the natural value of a 32 bit mask 
 \<close>
 
 definition get_nat_from_mask::"word32 \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> (word32 \<times> nat)" 
 where
 "
 get_nat_from_mask w m v \<equiv> if (w AND (mask m) =0) then (w>>m, v+m)
                           else (w,m)
 "
 
 definition get_nat_from_mask32::"word32\<Rightarrow> nat"
 where
 "get_nat_from_mask32 w \<equiv> 
                             if (w=0) then len_of TYPE (word_length32)
                             else
                                 let (w,res) = get_nat_from_mask w 16 0 in
                                      let (w,res)= get_nat_from_mask w 8 res in
                                           let (w,res) = get_nat_from_mask w 4 res in
                                               let (w,res) = get_nat_from_mask w 2 res in
                                                   let (w,res) = get_nat_from_mask w 1 res in
                                                         res
 "
 
 end 
diff --git a/thys/SPARCv8/SparcModel_MMU/Sparc_Types.thy b/thys/SPARCv8/SparcModel_MMU/Sparc_Types.thy
--- a/thys/SPARCv8/SparcModel_MMU/Sparc_Types.thy
+++ b/thys/SPARCv8/SparcModel_MMU/Sparc_Types.thy
@@ -1,791 +1,791 @@
 (*
  * Copyright 2016, NTU
  *
  * 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.
  *
  * Author: Zhe Hou, David Sanan. 
  *)
 
 section \<open>SPARC V8 architecture CPU model\<close>
 theory Sparc_Types    
-imports Main "../lib/WordDecl" "Word_Lib.Traditional_Infix_Syntax"
+imports Main "../lib/WordDecl" "Word_Lib.Bit_Shifts_Infix_Syntax"
 begin
 
 text \<open>The following type definitions are taken from David Sanan's 
 definitions for SPARC machines.\<close>
 
 type_synonym machine_word = word32
 type_synonym byte = word8
 type_synonym phys_address = word36
 
 type_synonym virtua_address = word32
 type_synonym page_address = word24
 type_synonym offset = word12
 
 type_synonym table_entry = word8
 
 definition page_size :: "word32" where "page_size \<equiv> 4096"
 
 type_synonym virtua_page_address = word20
 type_synonym context_type = word8
 
 type_synonym word_length_t1 = word_length8
 type_synonym word_length_t2 = word_length6
 type_synonym word_length_t3 = word_length6
 type_synonym word_length_offset = word_length12
 type_synonym word_length_page = word_length24
 type_synonym word_length_phys_address = word_length36
 type_synonym word_length_virtua_address = word_length32
 type_synonym word_length_entry_type = word_length2
 type_synonym word_length_machine_word = word_length32
 
 definition length_machine_word :: "nat" 
  where "length_machine_word \<equiv> LENGTH(word_length_machine_word)"
 
 text_raw \<open>\newpage\<close>
 
 section \<open>CPU Register Definitions\<close>
 
 text\<open>
  The definitions below come from the SPARC Architecture Manual, Version 8.
  The LEON3 processor has been certified SPARC V8 conformant (2005).
 \<close>
 
 definition leon3khz ::"word32"
 where
 "leon3khz \<equiv> 33000"
 
 text \<open>The following type definitions for MMU is taken from 
 David Sanan's definitions for MMU.\<close>
 
 text\<open>
   The definitions below come from the UT699 LEON 3FT/SPARC V8 Microprocessor Functional Manual, 
    Aeroflex, June 20, 2012, p35.
 \<close>
 datatype MMU_register
  = CR    \<comment> \<open>Control Register\<close>
  | CTP   \<comment> \<open>ConText Pointer register\<close>
  | CNR   \<comment> \<open>Context Register\<close>
  | FTSR   \<comment> \<open>Fault Status Register\<close>
  | FAR   \<comment> \<open>Fault Address Register\<close>
 
 lemma MMU_register_induct: 
   "P CR \<Longrightarrow> P CTP \<Longrightarrow> P CNR \<Longrightarrow> P FTSR \<Longrightarrow> P FAR 
    \<Longrightarrow> P x"
   by (cases x) auto
 
 lemma UNIV_MMU_register [no_atp]: "UNIV = {CR, CTP, CNR, FTSR, FAR}"
    apply (safe)
    apply (case_tac x)
    apply (auto intro:MMU_register_induct)
   done
 
 
 instantiation MMU_register :: enum begin
 
 definition "enum_MMU_register = [ CR, CTP, CNR, FTSR, FAR ]"
 
 definition
   "enum_all_MMU_register P \<longleftrightarrow> P CR \<and> P CTP \<and> P CNR \<and> P FTSR \<and> P FAR "
 definition
   "enum_ex_MMU_register P \<longleftrightarrow> P CR \<or> P CTP \<or> P CNR \<or> P FTSR \<or> P FAR"
 
  instance proof
   qed (simp_all only: enum_MMU_register_def enum_all_MMU_register_def 
                       enum_ex_MMU_register_def UNIV_MMU_register, simp_all)
 end
 type_synonym MMU_context = "MMU_register \<Rightarrow> machine_word"
 
 text \<open>\<open>PTE_flags\<close> is the last 8 bits of a PTE. See page 242 of SPARCv8 manual.
 \<^item> C - bit 7
 \<^item> M - bit 6,
 \<^item> R - bit 5
 \<^item> ACC - bit 4~2
 \<^item> ET - bit 1~0.\<close>
 
 type_synonym PTE_flags = word8
 
 text \<open>
   @{term CPU_register} datatype is an enumeration with the CPU registers defined in the SPARC V8 
   architecture.
 \<close>
 datatype CPU_register = 
    PSR   \<comment> \<open>Processor State Register\<close>
  | WIM   \<comment> \<open>Window Invalid Mask\<close>
  | TBR   \<comment> \<open>Trap Base Register\<close>
  | Y     \<comment> \<open>Multiply/Divide Register\<close>
  | PC    \<comment> \<open>Program Counter\<close>
  | nPC   \<comment> \<open>next Program Counter\<close>
  | DTQ   \<comment> \<open>Deferred-Trap Queue\<close>
  | FSR   \<comment> \<open>Floating-Point State Register\<close>
  | FQ    \<comment> \<open>Floating-Point Deferred-Trap Queue\<close>
  | CSR   \<comment> \<open>Coprocessor State Register\<close>
  | CQ    \<comment> \<open>Coprocessor Deferred-Trap Queue\<close>
  (*| CCR   --   "Cache Control Register"*)
  | ASR "word5"  \<comment> \<open>Ancillary State Register\<close>
 
 text \<open>The following two functions are dummies since we will not use 
         ASRs. Future formalisation may add more details to this.\<close>
 
 definition privileged_ASR :: "word5 \<Rightarrow> bool"
 where
 "privileged_ASR r \<equiv> False
 "
 
 definition illegal_instruction_ASR :: "word5 \<Rightarrow> bool"
 where
 "illegal_instruction_ASR r \<equiv> False
 "
 
 definition get_tt :: "word32 \<Rightarrow> word8"
 where
 "get_tt tbr \<equiv>
   ucast (((AND) tbr 0b00000000000000000000111111110000) >> 4)
 "
 
 text \<open>Write the tt field of the TBR register. 
         Return the new value of TBR.\<close>
 definition write_tt :: "word8 \<Rightarrow> word32 \<Rightarrow> word32"
 where
 "write_tt new_tt_val tbr_val \<equiv>
   let tmp = (AND) tbr_val 0b111111111111111111111000000001111 in
       (OR) tmp (((ucast new_tt_val)::word32) << 4)
 "
 
 text \<open>Get the nth bit of WIM. This equals ((AND) WIM $2^n$). 
         N.B. the first bit of WIM is the 0th bit.\<close>
 definition get_WIM_bit :: "nat \<Rightarrow> word32 \<Rightarrow> word1"
 where
 "get_WIM_bit n wim \<equiv>
   let mask = ((ucast (0b1::word1))::word32) << n in
   ucast (((AND) mask wim) >> n)
 "
 
 definition get_CWP :: "word32 \<Rightarrow> word5"
 where
 "get_CWP psr \<equiv> 
   ucast ((AND) psr 0b00000000000000000000000000011111) 
 "
 
 definition get_ET :: "word32 \<Rightarrow> word1"
 where
 "get_ET psr \<equiv> 
   ucast (((AND) psr 0b00000000000000000000000000100000) >> 5) 
 "
 
 definition get_PIL :: "word32 \<Rightarrow> word4"
 where
 "get_PIL psr \<equiv> 
   ucast (((AND) psr 0b00000000000000000000111100000000) >> 8) 
 "
 
 definition get_PS :: "word32 \<Rightarrow> word1"
 where
 "get_PS psr \<equiv> 
   ucast (((AND) psr 0b00000000000000000000000001000000) >> 6) 
 "
 
 definition get_S :: "word32 \<Rightarrow> word1"
 where
 "get_S psr \<equiv> 
   \<^cancel>\<open>ucast (((AND) psr 0b00000000000000000000000010000000) >> 7)\<close>
   if ((AND) psr (0b00000000000000000000000010000000::word32)) = 0 then 0
   else 1
 "
 
 definition get_icc_N :: "word32 \<Rightarrow> word1"
 where
 "get_icc_N psr \<equiv>
   ucast (((AND) psr 0b00000000100000000000000000000000) >> 23)
 "
 
 definition get_icc_Z :: "word32 \<Rightarrow> word1"
 where
 "get_icc_Z psr \<equiv>
   ucast (((AND) psr 0b00000000010000000000000000000000) >> 22)
 "
 
 definition get_icc_V :: "word32 \<Rightarrow> word1"
 where
 "get_icc_V psr \<equiv>
   ucast (((AND) psr 0b00000000001000000000000000000000) >> 21)
 "
 
 definition get_icc_C :: "word32 \<Rightarrow> word1"
 where
 "get_icc_C psr \<equiv>
   ucast (((AND) psr 0b00000000000100000000000000000000) >> 20)
 "
 
 definition update_S :: "word1 \<Rightarrow> word32 \<Rightarrow> word32"
 where
 "update_S s_val psr_val \<equiv>
   let tmp0 = (AND) psr_val 0b11111111111111111111111101111111 in
   (OR) tmp0 (((ucast s_val)::word32) << 7)
 "
 
 text \<open>Update the CWP field of PSR. 
         Return the new value of PSR.\<close>
 definition update_CWP :: "word5 \<Rightarrow> word32 \<Rightarrow> word32"
 where
 "update_CWP cwp_val psr_val \<equiv>
   let tmp0 = (AND) psr_val (0b11111111111111111111111111100000::word32);
       s_val = ((ucast (get_S psr_val))::word1)
   in
   if s_val = 0 then  
     (AND) ((OR) tmp0 ((ucast cwp_val)::word32)) (0b11111111111111111111111101111111::word32)
   else
     (OR) ((OR) tmp0 ((ucast cwp_val)::word32)) (0b00000000000000000000000010000000::word32)
 "
 
 text \<open>Update the the ET, CWP, and S fields of PSR. 
         Return the new value of PSR.\<close>
 definition update_PSR_rett :: "word5 \<Rightarrow> word1 \<Rightarrow> word1 \<Rightarrow> word32 \<Rightarrow> word32"
 where
 "update_PSR_rett cwp_val et_val s_val psr_val \<equiv>
   let tmp0 = (AND) psr_val 0b11111111111111111111111101000000;
       tmp1 = (OR) tmp0 ((ucast cwp_val)::word32);
       tmp2 = (OR) tmp1 (((ucast et_val)::word32) << 5); 
       tmp3 = (OR) tmp2 (((ucast s_val)::word32) << 7)
   in  
   tmp3
 "
 
 definition update_PSR_exe_trap :: "word5 \<Rightarrow> word1 \<Rightarrow> word1 \<Rightarrow> word32 \<Rightarrow> word32"
 where
 "update_PSR_exe_trap cwp_val et_val ps_val psr_val \<equiv>
   let tmp0 = (AND) psr_val 0b11111111111111111111111110000000;
       tmp1 = (OR) tmp0 ((ucast cwp_val)::word32);
       tmp2 = (OR) tmp1 (((ucast et_val)::word32) << 5); 
       tmp3 = (OR) tmp2 (((ucast ps_val)::word32) << 6)
   in  
   tmp3
 "
 
 text \<open>Update the N, Z, V, C fields of PSR. 
         Return the new value of PSR.\<close>
 definition update_PSR_icc :: "word1 \<Rightarrow> word1 \<Rightarrow> word1 \<Rightarrow> word1 \<Rightarrow> word32 \<Rightarrow> word32"
 where
 "update_PSR_icc n_val z_val v_val c_val psr_val \<equiv>
   let
       n_val_32 = if n_val = 0 then 0 
                  else       (0b00000000100000000000000000000000::word32); 
       z_val_32 = if z_val = 0 then 0 
                  else       (0b00000000010000000000000000000000::word32); 
       v_val_32 = if v_val = 0 then 0 
                  else       (0b00000000001000000000000000000000::word32);
       c_val_32 = if c_val = 0 then 0 
                  else       (0b00000000000100000000000000000000::word32);
       tmp0 = (AND) psr_val (0b11111111000011111111111111111111::word32);
       tmp1 = (OR) tmp0 n_val_32;
       tmp2 = (OR) tmp1 z_val_32;
       tmp3 = (OR) tmp2 v_val_32;
       tmp4 = (OR) tmp3 c_val_32
   in
   tmp4
 "
 
 text \<open>Update the ET, PIL fields of PSR. 
         Return the new value of PSR.\<close>
 definition update_PSR_et_pil :: "word1 \<Rightarrow> word4 \<Rightarrow> word32 \<Rightarrow> word32"
 where
 "update_PSR_et_pil et pil psr_val \<equiv>
   let tmp0 = (AND) psr_val 0b111111111111111111111000011011111;
       tmp1 = (OR) tmp0 (((ucast et)::word32) << 5);
       tmp2 = (OR) tmp1 (((ucast pil)::word32) << 8)
   in
   tmp2
 "
 
 text \<open>
    SPARC V8 architecture is organized in windows of 32 user registers.
    The data stored in a register is defined as a 32 bits word @{term reg_type}:
 \<close>
 type_synonym reg_type = "word32"
 
 text \<open>
   The access to the value of a CPU register of type @{term CPU_register} is
   defined by a total function @{term cpu_context}
 \<close>
 
 type_synonym cpu_context = "CPU_register \<Rightarrow> reg_type"
 
 text \<open>
   User registers are defined with the type @{term user_reg} represented by a 5 bits word.
 \<close>
 
 type_synonym user_reg_type = "word5"
 
 definition PSR_S ::"reg_type"
 where "PSR_S \<equiv> 6"
 text \<open>
   Each window context is defined by a total function @{term window_context} from @{term user_register} 
   to @{term reg_type} (32 bits word storing the actual value of the register).
 \<close>
 
 type_synonym window_context = "user_reg_type \<Rightarrow> reg_type"
 text \<open>
   The number of windows is implementation dependent. 
   The LEON architecture is composed of 16 different windows (a 4 bits word).
 \<close>
 
 definition NWINDOWS :: "int"
 where "NWINDOWS \<equiv> 8"
 
 text \<open>Maximum number of windows is 32 in SPARCv8.\<close>
 type_synonym ('a) window_size = "'a word"
 
 text \<open>
 Finally the user context is defined by another total function @{term user_context} from 
 @{term window_size} to @{term window_context}. That is, the user context is a function taking as
 argument a register set window and a register within that window, and it returns the value stored
 in that user register.
 \<close>
 type_synonym ('a) user_context = "('a) window_size \<Rightarrow> window_context"
 
 datatype sys_reg = 
          CCR    \<comment> \<open>Cache control register\<close>
         |ICCR   \<comment> \<open>Instruction cache configuration register\<close>
         |DCCR   \<comment> \<open>Data cache configuration register\<close>
 
 type_synonym sys_context = "sys_reg \<Rightarrow> reg_type"
 
 text\<open>
 The memory model is defined by a total function from 32 bits words to 8 bits words
 \<close>
 type_synonym asi_type = "word8"
 
 text \<open>
  The memory is defined as a function from page address to page, which is also defined
   as a function from physical address to @{term "machine_word"}
 \<close>
 
 type_synonym mem_val_type = "word8"
 type_synonym mem_context = "asi_type \<Rightarrow> phys_address \<Rightarrow> mem_val_type option"
 
 type_synonym cache_tag = "word20"
 type_synonym cache_line_size = "word12"
 type_synonym cache_type = "(cache_tag \<times> cache_line_size)"
 type_synonym cache_context = "cache_type \<Rightarrow> mem_val_type option"
 
 text \<open>The delayed-write pool generated from write state register instructions.\<close>
 type_synonym delayed_write_pool = "(int \<times> reg_type \<times> CPU_register) list"
 
 definition DELAYNUM :: "int"
 where "DELAYNUM \<equiv> 0"
 
 text \<open>Convert a set to a list.\<close>
 definition list_of_set :: "'a set \<Rightarrow> 'a list"
   where "list_of_set s = (SOME l. set l = s)"
 
 lemma set_list_of_set: "finite s \<Longrightarrow> set (list_of_set s) = s"
 unfolding list_of_set_def 
 by (metis (mono_tags) finite_list some_eq_ex)
 
 type_synonym ANNUL = "bool"
 type_synonym RESET_TRAP = "bool"
 type_synonym EXECUTE_MODE = "bool"
 type_synonym RESET_MODE = "bool"
 type_synonym ERROR_MODE = "bool"
 type_synonym TICC_TRAP_TYPE = "word7"
 type_synonym INTERRUPT_LEVEL = "word3"
 type_synonym STORE_BARRIER_PENDING = "bool"
 
 text \<open>The processor asserts this signal to ensure that the
 memory system will not process another SWAP or
 LDSTUB operation to the same memory byte.\<close>
 type_synonym pb_block_ldst_byte = "virtua_address \<Rightarrow> bool"
 
 text\<open>The processor asserts this signal to ensure that the
 memory system will not process another SWAP or
 LDSTUB operation to the same memory word.\<close>
 type_synonym pb_block_ldst_word = "virtua_address \<Rightarrow> bool"
 
 record sparc_state_var =
 annul:: ANNUL
 resett:: RESET_TRAP
 exe:: EXECUTE_MODE
 reset:: RESET_MODE
 err:: ERROR_MODE
 ticc:: TICC_TRAP_TYPE
 itrpt_lvl:: INTERRUPT_LEVEL
 st_bar:: STORE_BARRIER_PENDING
 atm_ldst_byte:: pb_block_ldst_byte
 atm_ldst_word:: pb_block_ldst_word
 
 definition get_annul :: "sparc_state_var \<Rightarrow> bool"
 where "get_annul v \<equiv> annul v"
 
 definition get_reset_trap :: "sparc_state_var \<Rightarrow> bool"
 where "get_reset_trap v \<equiv> resett v"
 
 definition get_exe_mode :: "sparc_state_var \<Rightarrow> bool"
 where "get_exe_mode v \<equiv> exe v"
 
 definition get_reset_mode :: "sparc_state_var \<Rightarrow> bool"
 where "get_reset_mode v \<equiv> reset v"
 
 definition get_err_mode :: "sparc_state_var \<Rightarrow> bool"
 where "get_err_mode v \<equiv> err v"
 
 definition get_ticc_trap_type :: "sparc_state_var \<Rightarrow> word7"
 where "get_ticc_trap_type v \<equiv> ticc v"
 
 definition get_interrupt_level :: "sparc_state_var \<Rightarrow> word3"
 where "get_interrupt_level v \<equiv> itrpt_lvl v"
 
 definition get_store_barrier_pending :: "sparc_state_var \<Rightarrow> bool"
 where "get_store_barrier_pending v \<equiv> st_bar v"
 
 definition write_annul :: "bool \<Rightarrow> sparc_state_var \<Rightarrow> sparc_state_var"
 where "write_annul b v \<equiv> v\<lparr>annul := b\<rparr>"
 
 definition write_reset_trap :: "bool \<Rightarrow> sparc_state_var \<Rightarrow> sparc_state_var"
 where "write_reset_trap b v \<equiv> v\<lparr>resett := b\<rparr>"
 
 definition write_exe_mode :: "bool \<Rightarrow> sparc_state_var \<Rightarrow> sparc_state_var"
 where "write_exe_mode b v \<equiv> v\<lparr>exe := b\<rparr>"
 
 definition write_reset_mode :: "bool \<Rightarrow> sparc_state_var \<Rightarrow> sparc_state_var"
 where "write_reset_mode b v \<equiv> v\<lparr>reset := b\<rparr>"
 
 definition write_err_mode :: "bool \<Rightarrow> sparc_state_var \<Rightarrow> sparc_state_var"
 where "write_err_mode b v \<equiv> v\<lparr>err := b\<rparr>"
 
 definition write_ticc_trap_type :: "word7 \<Rightarrow> sparc_state_var \<Rightarrow> sparc_state_var"
 where "write_ticc_trap_type w v \<equiv> v\<lparr>ticc := w\<rparr>"
 
 definition write_interrupt_level :: "word3 \<Rightarrow> sparc_state_var \<Rightarrow> sparc_state_var"
 where "write_interrupt_level w v \<equiv> v\<lparr>itrpt_lvl := w\<rparr>"
 
 definition write_store_barrier_pending :: "bool \<Rightarrow> sparc_state_var \<Rightarrow> sparc_state_var"
 where "write_store_barrier_pending b v \<equiv> v\<lparr>st_bar := b\<rparr>"
 
 text \<open>Given a word7 value, find the highest bit,
         and fill the left bits to be the highest bit.\<close>
 definition sign_ext7::"word7 \<Rightarrow> word32"
 where
 "sign_ext7 w \<equiv> 
   let highest_bit = ((AND) w 0b1000000) >> 6 in
   if highest_bit = 0 then
     (ucast w)::word32
   else (OR) ((ucast w)::word32) 0b11111111111111111111111110000000
 "
 
 definition zero_ext8 :: "word8 \<Rightarrow> word32"
 where
 "zero_ext8 w \<equiv> (ucast w)::word32
 "
 
 text \<open>Given a word8 value, find the highest bit,
         and fill the left bits to be the highest bit.\<close>
 definition sign_ext8::"word8 \<Rightarrow> word32"
 where
 "sign_ext8 w \<equiv> 
   let highest_bit = ((AND) w 0b10000000) >> 7 in
   if highest_bit = 0 then
     (ucast w)::word32
   else (OR) ((ucast w)::word32) 0b11111111111111111111111100000000
 "
 
 text \<open>Given a word13 value, find the highest bit,
         and fill the left bits to be the highest bit.\<close>
 definition sign_ext13::"word13 \<Rightarrow> word32"
 where
 "sign_ext13 w \<equiv> 
   let highest_bit = ((AND) w 0b1000000000000) >> 12 in
   if highest_bit = 0 then
     (ucast w)::word32
   else (OR) ((ucast w)::word32) 0b11111111111111111110000000000000
 "
 
 definition zero_ext16 :: "word16 \<Rightarrow> word32"
 where
 "zero_ext16 w \<equiv> (ucast w)::word32
 "
 
 text \<open>Given a word16 value, find the highest bit,
         and fill the left bits to be the highest bit.\<close>
 definition sign_ext16::"word16 \<Rightarrow> word32"
 where
 "sign_ext16 w \<equiv> 
   let highest_bit = ((AND) w 0b1000000000000000) >> 15 in
   if highest_bit = 0 then
     (ucast w)::word32
   else (OR) ((ucast w)::word32) 0b11111111111111110000000000000000
 "
 
 text \<open>Given a word22 value, find the highest bit,
         and fill the left bits to tbe the highest bit.\<close>
 definition sign_ext22::"word22 \<Rightarrow> word32"
 where
 "sign_ext22 w \<equiv>
   let highest_bit = ((AND) w 0b1000000000000000000000) >> 21 in
   if highest_bit = 0 then
     (ucast w)::word32
   else (OR) ((ucast w)::word32) 0b11111111110000000000000000000000
 "
 
 text \<open>Given a word24 value, find the highest bit,
         and fill the left bits to tbe the highest bit.\<close>
 definition sign_ext24::"word24 \<Rightarrow> word32"
 where
 "sign_ext24 w \<equiv>
   let highest_bit = ((AND) w 0b100000000000000000000000) >> 23 in
   if highest_bit = 0 then
     (ucast w)::word32
   else (OR) ((ucast w)::word32) 0b11111111000000000000000000000000
 "
 
 text\<open>
 Operations to be defined.
 The SPARC V8 architecture is composed of the following set of instructions:
   \<^item> Load Integer Instructions
   \<^item> Load Floating-point Instructions
   \<^item> Load Coprocessor Instructions
   \<^item> Store Integer Instructions
   \<^item> Store Floating-point Instructions
   \<^item> Store Coprocessor Instructions
   \<^item> Atomic Load-Store Unsigned Byte Instructions
   \<^item> SWAP Register With Memory Instruction
   \<^item> SETHI Instructions
   \<^item> NOP Instruction
   \<^item> Logical Instructions
   \<^item> Shift Instructions
   \<^item> Add Instructions
   \<^item> Tagged Add Instructions
   \<^item> Subtract Instructions
   \<^item> Tagged Subtract Instructions
   \<^item> Multiply Step Instruction
   \<^item> Multiply Instructions
   \<^item> Divide Instructions
   \<^item> SAVE and RESTORE Instructions
   \<^item> Branch on Integer Condition Codes Instructions
   \<^item> Branch on Floating-point Condition Codes Instructions
   \<^item> Branch on Coprocessor Condition Codes Instructions
   \<^item> Call and Link Instruction
   \<^item> Jump and Link Instruction
   \<^item> Return from Trap Instruction
   \<^item> Trap on Integer Condition Codes Instructions
   \<^item> Read State Register Instructions
   \<^item> Write State Register Instructions
   \<^item> STBAR Instruction
   \<^item> Unimplemented Instruction
   \<^item> Flush Instruction Memory
   \<^item> Floating-point Operate (FPop) Instructions
   \<^item> Convert Integer to Floating point Instructions
   \<^item> Convert Floating point to Integer Instructions
   \<^item> Convert Between Floating-point Formats Instructions
   \<^item> Floating-point Move Instructions
   \<^item> Floating-point Square Root Instructions
   \<^item> Floating-point Add and Subtract Instructions
   \<^item> Floating-point Multiply and Divide Instructions
   \<^item> Floating-point Compare Instructions
   \<^item> Coprocessor Operate Instructions
 \<close>
 
 text \<open>The CALL instruction.\<close>
 datatype call_type = CALL \<comment> \<open>Call and Link\<close>
 
 text \<open>The SETHI instruction.\<close>
 datatype sethi_type = SETHI    \<comment> \<open>Set High 22 bits of r Register\<close>
 
 text \<open>The NOP instruction.\<close>
 datatype nop_type = NOP      \<comment> \<open>No Operation\<close>
 
 text \<open>The Branch on integer condition codes instructions.\<close> 
 datatype bicc_type = 
   BE       \<comment> \<open>Branch on Equal\<close>
  | BNE      \<comment> \<open>Branch on Not Equal\<close>
  | BGU      \<comment> \<open>Branch on Greater Unsigned\<close>
  | BLE      \<comment> \<open>Branch on Less or Equal\<close>
  | BL       \<comment> \<open>Branch on Less\<close>
  | BGE      \<comment> \<open>Branch on Greater or Equal\<close>
  | BNEG     \<comment> \<open>Branch on Negative\<close>
  | BG       \<comment> \<open>Branch on Greater\<close>
  | BCS      \<comment> \<open>Branch on Carry Set (Less than, Unsigned)\<close>
  | BLEU     \<comment> \<open>Branch on Less or Equal Unsigned\<close>
  | BCC      \<comment> \<open>Branch on Carry Clear (Greater than or Equal, Unsigned)\<close>
  | BA       \<comment> \<open>Branch Always\<close>
  | BN       \<comment> \<open>Branch Never\<close> \<comment> \<open>Added for unconditional branches\<close>
  | BPOS     \<comment> \<open>Branch on Positive\<close>
  | BVC      \<comment> \<open>Branch on Overflow Clear\<close>
  | BVS      \<comment> \<open>Branch on Overflow Set\<close>
 
 text \<open>Memory instructions. That is, load and store.\<close>
 datatype load_store_type =
   LDSB     \<comment> \<open>Load Signed Byte\<close>
  | LDUB     \<comment> \<open>Load Unsigned Byte\<close>
  | LDUBA    \<comment> \<open>Load Unsigned Byte from Alternate space\<close>
  | LDUH     \<comment> \<open>Load Unsigned Halfword\<close>
  | LD       \<comment> \<open>Load Word\<close>
  | LDA      \<comment> \<open>Load Word from Alternate space\<close>
  | LDD      \<comment> \<open>Load Doubleword\<close>
  | STB      \<comment> \<open>Store Byte\<close>
  | STH      \<comment> \<open>Store Halfword\<close>
  | ST       \<comment> \<open>Store Word\<close>
  | STA      \<comment> \<open>Store Word into Alternate space\<close>
  | STD      \<comment> \<open>Store Doubleword\<close>
  | LDSBA    \<comment> \<open>Load Signed Byte from Alternate space\<close>
  | LDSH     \<comment> \<open>Load Signed Halfword\<close>
  | LDSHA    \<comment> \<open>Load Signed Halfword from Alternate space\<close>
  | LDUHA    \<comment> \<open>Load Unsigned Halfword from Alternate space\<close>
  | LDDA     \<comment> \<open>Load Doubleword from Alternate space\<close>
  | STBA     \<comment> \<open>Store Byte into Alternate space\<close>
  | STHA     \<comment> \<open>Store Halfword into Alternate space\<close>
  | STDA     \<comment> \<open>Store Doubleword into Alternate space\<close>
  | LDSTUB   \<comment> \<open>Atomic Load Store Unsigned Byte\<close>
  | LDSTUBA  \<comment> \<open>Atomic Load Store Unsinged Byte in Alternate space\<close>
  | SWAP     \<comment> \<open>Swap r Register with Mmemory\<close>
  | SWAPA    \<comment> \<open>Swap r Register with Mmemory in Alternate space\<close>
  | FLUSH    \<comment> \<open>Flush Instruction Memory\<close>
  | STBAR    \<comment> \<open>Store Barrier\<close>
 
 text \<open>Arithmetic instructions.\<close>
 datatype arith_type =
   ADD      \<comment> \<open>Add\<close>
  | ADDcc    \<comment> \<open>Add and modify icc\<close>
  | ADDX     \<comment> \<open>Add with Carry\<close>
  | SUB      \<comment> \<open>Subtract\<close>
  | SUBcc    \<comment> \<open>Subtract and modify icc\<close>
  | SUBX     \<comment> \<open>Subtract with Carry\<close>
  | UMUL     \<comment> \<open>Unsigned Integer Multiply\<close>
  | SMUL     \<comment> \<open>Signed Integer Multiply\<close>
  | SMULcc   \<comment> \<open>Signed Integer Multiply and modify icc\<close>
  | UDIV     \<comment> \<open>Unsigned Integer Divide\<close>
  | UDIVcc   \<comment> \<open>Unsigned Integer Divide and modify icc\<close>
  | SDIV     \<comment> \<open>Signed Integer Divide\<close> 
  | ADDXcc   \<comment> \<open>Add with Carry and modify icc\<close>
  | TADDcc   \<comment> \<open>Tagged Add and modify icc\<close>
  | TADDccTV \<comment> \<open>Tagged Add and modify icc and Trap on overflow\<close>
  | SUBXcc   \<comment> \<open>Subtract with Carry and modify icc\<close>
  | TSUBcc   \<comment> \<open>Tagged Subtract and modify icc\<close>
  | TSUBccTV \<comment> \<open>Tagged Subtract and modify icc and Trap on overflow\<close>
  | MULScc   \<comment> \<open>Multiply Step and modify icc\<close>
  | UMULcc   \<comment> \<open>Unsigned Integer Multiply and modify icc\<close>
  | SDIVcc   \<comment> \<open>Signed Integer Divide and modify icc\<close>
 
 text \<open>Logical instructions.\<close>
 datatype logic_type =
   ANDs      \<comment> \<open>And\<close>
  | ANDcc    \<comment> \<open>And and modify icc\<close>
  | ANDN     \<comment> \<open>And Not\<close>
  | ANDNcc   \<comment> \<open>And Not and modify icc\<close>
  | ORs       \<comment> \<open>Inclusive-Or\<close>
  | ORcc     \<comment> \<open>Inclusive-Or and modify icc\<close>
  | ORN      \<comment> \<open>Inclusive Or Not\<close>
  | XORs      \<comment> \<open>Exclusive-Or\<close>
  | XNOR     \<comment> \<open>Exclusive-Nor\<close>
  | ORNcc    \<comment> \<open>Inclusive-Or Not and modify icc\<close>
  | XORcc    \<comment> \<open>Exclusive-Or and modify icc\<close>
  | XNORcc   \<comment> \<open>Exclusive-Nor and modify icc\<close>
  
 text \<open>Shift instructions.\<close>
 datatype shift_type =
   SLL      \<comment> \<open>Shift Left Logical\<close>
  | SRL      \<comment> \<open>Shift Right Logical\<close>
  | SRA      \<comment> \<open>Shift Right Arithmetic\<close> 
 
 text \<open>Other Control-transfer instructions.\<close>
 datatype ctrl_type = 
   JMPL     \<comment> \<open>Jump and Link\<close>
  | RETT     \<comment> \<open>Return from Trap\<close>
  | SAVE     \<comment> \<open>Save caller's window\<close>
  | RESTORE  \<comment> \<open>Restore caller's window\<close> 
 
 text \<open>Access state registers instructions.\<close>
 datatype sreg_type =
   RDASR    \<comment> \<open>Read Ancillary State Register\<close>
  | RDY      \<comment> \<open>Read Y Register\<close>
  | RDPSR    \<comment> \<open>Read Processor State Register\<close>
  | RDWIM    \<comment> \<open>Read Window Invalid Mask Register\<close>
  | RDTBR    \<comment> \<open>Read Trap Base Regiser\<close>
  | WRASR    \<comment> \<open>Write Ancillary State Register\<close>
  | WRY      \<comment> \<open>Write Y Register\<close>
  | WRPSR    \<comment> \<open>Write Processor State Register\<close>
  | WRWIM    \<comment> \<open>Write Window Invalid Mask Register\<close>
  | WRTBR    \<comment> \<open>Write Trap Base Register\<close> 
 
 text \<open>Unimplemented instruction.\<close>
 datatype uimp_type = UNIMP    \<comment> \<open>Unimplemented\<close> 
 
 text \<open>Trap on integer condition code instructions.\<close>
 datatype ticc_type =
  TA       \<comment> \<open>Trap Always\<close>
  | TN       \<comment> \<open>Trap Never\<close>
  | TNE      \<comment> \<open>Trap on Not Equal\<close>
  | TE       \<comment> \<open>Trap on Equal\<close>
  | TG       \<comment> \<open>Trap on Greater\<close>
  | TLE      \<comment> \<open>Trap on Less or Equal\<close>
  | TGE      \<comment> \<open>Trap on Greater or Equal\<close>
  | TL       \<comment> \<open>Trap on Less\<close>
  | TGU      \<comment> \<open>Trap on Greater Unsigned\<close>
  | TLEU     \<comment> \<open>Trap on Less or Equal Unsigned\<close>
  | TCC      \<comment> \<open>Trap on Carry Clear (Greater than or Equal, Unsigned)\<close>
  | TCS      \<comment> \<open>Trap on Carry Set (Less Than, Unsigned)\<close>
  | TPOS     \<comment> \<open>Trap on Postive\<close>
  | TNEG     \<comment> \<open>Trap on Negative\<close>
  | TVC      \<comment> \<open>Trap on Overflow Clear\<close>
  | TVS      \<comment> \<open>Trap on Overflow Set\<close>
 
 datatype sparc_operation =
   call_type call_type
  | sethi_type sethi_type
  | nop_type nop_type
  | bicc_type bicc_type
  | load_store_type load_store_type
  | arith_type arith_type
  | logic_type logic_type
  | shift_type shift_type
  | ctrl_type ctrl_type
  | sreg_type sreg_type
  | uimp_type uimp_type
  | ticc_type ticc_type
 
 datatype Trap = 
 reset 
 |data_store_error
 |instruction_access_MMU_miss
 |instruction_access_error
 |r_register_access_error
 |instruction_access_exception
 |privileged_instruction
 |illegal_instruction
 |unimplemented_FLUSH
 |watchpoint_detected
 |fp_disabled
 |cp_disabled
 |window_overflow
 |window_underflow
 |mem_address_not_aligned
 |fp_exception
 |cp_exception
 |data_access_error
 |data_access_MMU_miss
 |data_access_exception
 |tag_overflow
 |division_by_zero
 |trap_instruction
 |interrupt_level_n
 
 datatype Exception =
 \<comment> \<open>The following are processor states that are not in the instruction model,\<close>
 \<comment> \<open>but we MAY want to deal with these from hardware perspective.\<close>
 \<^cancel>\<open>|execute_mode\<close>
 \<^cancel>\<open>|reset_mode\<close>
 \<^cancel>\<open>|error_mode\<close>
 \<comment> \<open>The following are self-defined exceptions.\<close>
 invalid_cond_f2
 |invalid_op2_f2
 |illegal_instruction2 \<comment> \<open>when \<open>i = 0\<close> for load/store not from alternate space\<close>
 |invalid_op3_f3_op11
 |case_impossible
 |invalid_op3_f3_op10
 |invalid_op_f3
 |unsupported_instruction
 |fetch_instruction_error
 |invalid_trap_cond
 
 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,1275 +1,1282 @@
 (*
  * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
  *
  * SPDX-License-Identifier: BSD-2-Clause
  *)
 
 section "Word Alignment"
 
 theory Aligned
   imports
     "HOL-Library.Word"
     More_Word
     Word_EqI
     Typedef_Morphisms
 begin
 
 lift_definition is_aligned :: \<open>'a::len word \<Rightarrow> nat \<Rightarrow> bool\<close>
   is \<open>\<lambda>k n. 2 ^ n dvd take_bit LENGTH('a) k\<close>
   by simp
 
 lemma is_aligned_iff_udvd:
   \<open>is_aligned w n \<longleftrightarrow> 2 ^ n udvd w\<close>
   by transfer (simp flip: take_bit_eq_0_iff add: min_def)
 
 lemma is_aligned_iff_take_bit_eq_0:
   \<open>is_aligned w n \<longleftrightarrow> take_bit n w = 0\<close>
   by (simp add: is_aligned_iff_udvd take_bit_eq_0_iff exp_dvd_iff_exp_udvd)
 
 lemma is_aligned_iff_dvd_int:
   \<open>is_aligned ptr n \<longleftrightarrow> 2 ^ n dvd uint ptr\<close>
   by transfer simp
 
 lemma is_aligned_iff_dvd_nat:
   \<open>is_aligned ptr n \<longleftrightarrow> 2 ^ n dvd unat ptr\<close>
 proof -
   have \<open>unat ptr = nat \<bar>uint ptr\<bar>\<close>
     by transfer simp
   then have \<open>2 ^ n dvd unat ptr \<longleftrightarrow> 2 ^ n dvd uint ptr\<close>
     by (simp only: dvd_nat_abs_iff) simp
   then show ?thesis
     by (simp add: is_aligned_iff_dvd_int)
 qed
 
 lemma is_aligned_0 [simp]:
   \<open>is_aligned 0 n\<close>
   by transfer simp
 
 lemma is_aligned_at_0 [simp]:
   \<open>is_aligned w 0\<close>
   by transfer simp
 
 lemma is_aligned_beyond_length:
   \<open>is_aligned w n \<longleftrightarrow> w = 0\<close> if \<open>LENGTH('a) \<le> n\<close> for w :: \<open>'a::len word\<close>
   using that
   apply (simp add: is_aligned_iff_udvd)
   apply transfer
   apply auto
   done
 
 lemma is_alignedI [intro?]:
   \<open>is_aligned x n\<close> if \<open>x = 2 ^ n * k\<close> for x :: \<open>'a::len word\<close>
 proof (unfold is_aligned_iff_udvd)
   from that show \<open>2 ^ n udvd x\<close>
     using dvd_triv_left exp_dvd_iff_exp_udvd by blast
 qed
 
 lemma is_alignedE:
   fixes w :: \<open>'a::len word\<close>
   assumes \<open>is_aligned w n\<close>
   obtains q where \<open>w = 2 ^ n * word_of_nat q\<close> \<open>q < 2 ^ (LENGTH('a) - n)\<close>
 proof (cases \<open>n < LENGTH('a)\<close>)
   case False
   with assms have \<open>w = 0\<close>
     by (simp add: is_aligned_beyond_length)
   with that [of 0] show thesis
     by simp
 next
   case True
   moreover define m where \<open>m = LENGTH('a) - n\<close>
   ultimately have l: \<open>LENGTH('a) = n + m\<close> and \<open>m \<noteq> 0\<close>
     by simp_all
   from \<open>n < LENGTH('a)\<close> have *: \<open>unat (2 ^ n :: 'a word) = 2 ^ n\<close>
     by transfer simp
   from assms have \<open>2 ^ n udvd w\<close>
     by (simp add: is_aligned_iff_udvd)
   then obtain v :: \<open>'a word\<close>
     where \<open>unat w = unat (2 ^ n :: 'a word) * unat v\<close> ..
   moreover define q where \<open>q = unat v\<close>
   ultimately have unat_w: \<open>unat w = 2 ^ n * q\<close>
     by (simp add: *)
   then have \<open>word_of_nat (unat w) = (word_of_nat (2 ^ n * q) :: 'a word)\<close>
     by simp
   then have w: \<open>w = 2 ^ n * word_of_nat q\<close>
     by simp
   moreover have \<open>q < 2 ^ (LENGTH('a) - n)\<close>
   proof (rule ccontr)
     assume \<open>\<not> q < 2 ^ (LENGTH('a) - n)\<close>
     then have \<open>2 ^ (LENGTH('a) - n) \<le> q\<close>
       by simp
     then have \<open>2 ^ LENGTH('a) \<le> 2 ^ n * q\<close>
       by (simp add: l power_add)
     with unat_w [symmetric] show False
       by (metis le_antisym nat_less_le unsigned_less) 
   qed
   ultimately show thesis
     using that by blast
 qed
 
 lemma is_alignedE' [elim?]:
   fixes w :: \<open>'a::len word\<close>
   assumes \<open>is_aligned w n\<close>
   obtains q where \<open>w = push_bit n (word_of_nat q)\<close> \<open>q < 2 ^ (LENGTH('a) - n)\<close>
 proof -
   from assms
   obtain q where \<open>w = 2 ^ n * word_of_nat q\<close> \<open>q < 2 ^ (LENGTH('a) - n)\<close>
     by (rule is_alignedE)
   then have \<open>w = push_bit n (word_of_nat q)\<close>
     by (simp add: push_bit_eq_mult)
   with that show thesis
     using \<open>q < 2 ^ (LENGTH('a) - n)\<close> .
 qed
 
 lemma is_aligned_mask:
   \<open>is_aligned w n \<longleftrightarrow> w AND mask n = 0\<close>
   by (simp add: is_aligned_iff_take_bit_eq_0 take_bit_eq_mask)
 
 lemma is_aligned_imp_not_bit:
   \<open>\<not> bit w m\<close> if \<open>is_aligned w n\<close> and \<open>m < n\<close>
   for w :: \<open>'a::len word\<close>
 proof -
   from \<open>is_aligned w n\<close>
   obtain q where \<open>w = push_bit n (word_of_nat q)\<close> \<open>q < 2 ^ (LENGTH('a) - n)\<close> ..
   moreover have \<open>\<not> bit (push_bit n (word_of_nat q :: 'a word)) m\<close>
     using \<open>m < n\<close> by (simp add: bit_simps)
   ultimately show ?thesis
     by simp
 qed
 
 lemma is_aligned_weaken:
   "\<lbrakk> is_aligned w x; x \<ge> y \<rbrakk> \<Longrightarrow> is_aligned w y"
   unfolding is_aligned_iff_dvd_nat
   by (erule dvd_trans [rotated]) (simp add: le_imp_power_dvd)
 
 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)"
   using aligned is_alignedE by blast
 
 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_iff_dvd_nat 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: is_aligned_mask not_less take_bit_eq_mod power_overflow word_arith_nat_defs(7) flip: take_bit_eq_mask)
 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"
+  shows "is_aligned (push_bit m k) 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)"
+  have "(2::nat) ^ m dvd unat (push_bit m k)"
   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)
+    have "unat (push_bit m k) = unat (2 ^ m * k)"
+      by (simp add: push_bit_eq_mult)
     also have "\<dots> = (2 ^ m * unat k) mod (2 ^ LENGTH('a))" using mv
       by (simp add: unat_word_ariths(2))
     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)" .
+    finally show "unat (push_bit m k) = 2 ^ m * (unat k mod 2 ^ q)" .
   qed
 
   then show ?thesis by (unfold is_aligned_iff_dvd_nat)
 next
   assume "\<not> m < LENGTH('a)"
   then show ?thesis
-    by (simp add: not_less power_overflow is_aligned_mask shiftl_zero_size word_size)
+    by (simp add: not_less power_overflow is_aligned_mask 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_iff_dvd_nat
     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: is_aligned_mask flip: take_bit_eq_mask take_bit_eq_mod)
 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 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 simp
   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 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 aligned_add_xor:
   \<open>(x + 2 ^ n) XOR 2 ^ n = x\<close>
   if al: \<open>is_aligned (x::'a::len word) n'\<close> and le: \<open>n < n'\<close>
 proof -
   have \<open>\<not> bit x n\<close>
     using that by (rule is_aligned_imp_not_bit)
   then have \<open>x + 2 ^ n = x OR 2 ^ n\<close>
     by (subst disjunctive_add) (auto simp add: bit_simps disjunctive_add)
   moreover have \<open>(x OR 2 ^ n) XOR 2 ^ n = x\<close>
     by (rule bit_word_eqI) (auto simp add: bit_simps \<open>\<not> bit x n\<close>)
   ultimately show ?thesis
     by simp
 qed
 
 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 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 (simp add: take_bit_eq_mod)
   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 (simp add: is_aligned_mask power_add power_overflow not_less
     flip: take_bit_eq_mask)
   apply (metis take_bit_length_eq take_bit_of_0 take_bit_tightened)
   done
 
 lemma aligned_small_is_0:
   "\<lbrakk> is_aligned x n; x < 2 ^ n \<rbrakk> \<Longrightarrow> x = 0"
   by (simp add: is_aligned_mask less_mask_eq)
 
 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 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_bitI:
   \<open>is_aligned p m\<close> if \<open>\<And>n. n < m \<Longrightarrow> \<not> bit p n\<close>
   apply (simp add: is_aligned_mask)
   apply (rule bit_word_eqI)
   using that
   apply (auto simp add: bit_simps)
   done
 
 lemma is_aligned_nth [word_eqI_simps]:
   "is_aligned p m = (\<forall>n < m. \<not> bit p n)"
   apply (auto intro: is_aligned_bitI simp add: is_aligned_mask bit_eq_iff)
    apply (auto simp: bit_simps)
   using bit_imp_le_length not_less apply blast
   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"
   apply (rule ccontr)
   using al apply (rule notE)
   apply simp
   apply (rule is_alignedI [of _ _ \<open>a div 2 ^ n\<close>])
   apply (metis add.right_neutral mult.commute word_mod_div_equality)
   done
 
 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
       by (auto simp add: le_Suc_eq Suc_le_eq) (simp add: le_less)
   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 AND NOT (mask n)) m"
-  by (metis and_not_mask is_aligned_shift is_aligned_weaken)
+  by (rule is_aligned_bitI) (simp add: bit_simps)
 
 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:
   \<open>is_aligned (- p) n\<close> if \<open>is_aligned p n\<close> for p :: \<open>'a::len word\<close>
   using that
   apply (cases \<open>n < LENGTH('a)\<close>)
   apply (simp_all add: not_less is_aligned_beyond_length)
   apply transfer
   apply (simp flip: take_bit_eq_0_iff)
   apply (subst take_bit_minus [symmetric])
   apply simp
   done
 
 lemma add_mask_lower_bits:
   "\<lbrakk>is_aligned (x :: 'a :: len word) n;
     \<forall>n' \<ge> n. n' < LENGTH('a) \<longrightarrow> \<not> bit p n'\<rbrakk> \<Longrightarrow> x + p AND NOT (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 add: bit_simps)
   apply (rule bit_word_eqI)
   apply (auto simp add: bit_simps not_less word_size)
   apply (metis is_aligned_nth not_le)
   done
 
 lemma is_aligned_andI1:
   "is_aligned x n \<Longrightarrow> is_aligned (x AND y) n"
   by (simp add: is_aligned_nth bit_simps)
 
 lemma is_aligned_andI2:
   "is_aligned y n \<Longrightarrow> is_aligned (x AND y) n"
   by (simp add: is_aligned_nth bit_simps)
 
 lemma is_aligned_shiftl:
-  "is_aligned w (n - m) \<Longrightarrow> is_aligned (w << m) n"
-  by (simp add: is_aligned_nth nth_shiftl)
+  "is_aligned w (n - m) \<Longrightarrow> is_aligned (push_bit m w) n"
+  by (simp add: is_aligned_nth bit_simps)
 
 lemma is_aligned_shiftr:
-  "is_aligned w (n + m) \<Longrightarrow> is_aligned (w >> m) n"
-  by (simp add: is_aligned_nth nth_shiftr)
+  "is_aligned w (n + m) \<Longrightarrow> is_aligned (drop_bit m w) n"
+  by (simp add: is_aligned_nth bit_simps)
 
 lemma is_aligned_shiftl_self:
-  "is_aligned (p << n) n"
+  "is_aligned (push_bit n p) n"
   by (rule is_aligned_shift)
 
 lemma is_aligned_neg_mask_eq:
   "is_aligned p n \<Longrightarrow> p AND NOT (mask n) = p"
-  by (metis add.left_neutral is_aligned_mask word_plus_and_or_coroll2)
+  apply (rule bit_word_eqI)
+  apply (auto simp add: bit_simps is_aligned_nth)
+  done
 
 lemma is_aligned_shiftr_shiftl:
-  "is_aligned w n \<Longrightarrow> w >> n << n = w"
-  by (metis and_not_mask is_aligned_neg_mask_eq)
+  "is_aligned w n \<Longrightarrow> push_bit n (drop_bit n w) = w"
+  apply (rule bit_word_eqI)
+  apply (auto simp add: bit_simps is_aligned_nth)
+  using not_le_imp_less apply blast
+  apply (metis add_diff_inverse_nat)
+  done
 
 lemma aligned_shiftr_mask_shiftl:
-  "is_aligned x n \<Longrightarrow> ((x >> n) AND mask v) << n = x AND mask (v + n)"
+  "is_aligned x n \<Longrightarrow> push_bit n (drop_bit n x AND mask v) = x AND mask (v + n)"
   apply (rule word_eqI)
-  apply (simp add: word_size nth_shiftl nth_shiftr bit_simps)
+  apply (simp add: word_size bit_simps)
   apply (subgoal_tac "\<forall>m. bit 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 bit_simps)
   done
 
 lemma mask_zero:
   "is_aligned x a \<Longrightarrow> x AND mask a = 0"
   by (metis is_aligned_mask)
 
 lemma is_aligned_neg_mask_eq_concrete:
   "\<lbrakk> is_aligned p n; msk AND NOT (mask n) = NOT (mask n) \<rbrakk>
    \<Longrightarrow> p AND msk = p"
   by (metis word_bw_assocs(1) word_bw_comms(1) is_aligned_neg_mask_eq)
 
 lemma is_aligned_and_not_zero:
   "\<lbrakk> is_aligned n k; n \<noteq> 0 \<rbrakk> \<Longrightarrow> 2 ^ k \<le> n"
   using is_aligned_less_sz leI by blast
 
 lemma is_aligned_and_2_to_k:
   "(n AND 2 ^ k - 1) = 0 \<Longrightarrow> is_aligned (n :: 'a :: len word) k"
   by (simp add: is_aligned_mask mask_eq_decr_exp)
 
 lemma is_aligned_power2:
   "b \<le> a \<Longrightarrow> is_aligned (2 ^ a) b"
   by (metis is_aligned_triv is_aligned_weaken)
 
 lemma aligned_sub_aligned':
   "\<lbrakk> is_aligned (a :: 'a :: len word) n; is_aligned b n; n < LENGTH('a) \<rbrakk>
    \<Longrightarrow> is_aligned (a - b) n"
   by (simp add: aligned_sub_aligned)
 
 lemma is_aligned_neg_mask_weaken:
   "\<lbrakk> is_aligned p n; m \<le> n \<rbrakk> \<Longrightarrow> p AND NOT (mask m) = p"
    using is_aligned_neg_mask_eq is_aligned_weaken by blast
 
 lemma is_aligned_neg_mask2 [simp]:
   "is_aligned (a AND NOT (mask n)) n"
-  by (simp add: and_not_mask is_aligned_shift)
+  by (rule is_aligned_bitI) (simp add: bit_simps)
 
 lemma is_aligned_0':
   "is_aligned 0 n"
   by (fact is_aligned_0)
 
 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_eq_decr_exp
                   word_mod_by_0)
 qed
 
 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 transfer
       apply simp
       apply (auto simp add: le_less power_2_ge_iff szv)
       apply (metis le_less_trans mask_eq_decr_exp mask_lt_2pn order_less_imp_le 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_eq_decr_exp power_overflow)
   then show ?thesis ..
 qed
 
 lemma is_aligned_add_helper:
   "\<lbrakk> is_aligned p n; d < 2 ^ n \<rbrakk>
      \<Longrightarrow> (p + d AND mask n = d) \<and> (p + d AND (NOT (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 (simp_all flip: take_bit_eq_mask)
    apply (metis take_bit_eq_mask word_bw_lcs(1) word_log_esimps(1))
   apply (metis add.commute add_left_imp_eq take_bit_eq_mask word_plus_and_or_coroll2)
   done
 
 lemmas mask_inner_mask = mask_eqs(1)
 
 lemma mask_add_aligned:
   "is_aligned p n \<Longrightarrow> (p + q) AND mask n = q AND mask n"
   apply (simp add: is_aligned_mask)
   apply (subst mask_inner_mask [symmetric])
   apply simp
   done
 
 lemma mask_out_add_aligned:
   assumes al: "is_aligned p n"
   shows "p + (q AND NOT (mask n)) = (p + q) AND NOT (mask n)"
   using mask_add_aligned [OF al]
   by (simp add: mask_out_sub_mask)
 
 lemma is_aligned_add_or:
   "\<lbrakk>is_aligned p n; d < 2 ^ n\<rbrakk> \<Longrightarrow> p + d = p OR d"
   apply (subst disjunctive_add)
    apply (simp_all add: is_aligned_iff_take_bit_eq_0)
   apply (simp add: bit_eq_iff)
   apply (auto simp add: bit_simps)
   subgoal for m
     apply (cases \<open>m < n\<close>)
      apply (auto simp add: not_less)
     apply (metis bit_take_bit_iff less_mask_eq take_bit_eq_mask)
     done
   done
 
 lemma not_greatest_aligned:
   "\<lbrakk> x < y; is_aligned x n; is_aligned y n \<rbrakk> \<Longrightarrow> x + 2 ^ n \<noteq> 0"
   by (metis NOT_mask add_diff_cancel_right' diff_0 is_aligned_neg_mask_eq not_le word_and_le1)
 
 lemma neg_mask_mono_le:
   "x \<le> y \<Longrightarrow> x AND NOT(mask n) \<le> y AND NOT(mask n)" for x :: "'a :: len word"
 proof (rule ccontr, simp add: linorder_not_le, cases "n < LENGTH('a)")
   case False
   then show "y AND NOT(mask n) < x AND NOT(mask n) \<Longrightarrow> False"
     by (simp add: mask_eq_decr_exp linorder_not_less power_overflow)
 next
   case True
   assume a: "x \<le> y" and b: "y AND NOT(mask n) < x AND NOT(mask n)"
   have word_bits: "n < LENGTH('a)" by fact
   have "y \<le> (y AND NOT(mask n)) + (y AND mask n)"
     by (simp add: word_plus_and_or_coroll2 add.commute)
   also have "\<dots> \<le> (y AND NOT(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 add: is_aligned_neg_mask word_bits)
     apply (rule not_greatest_aligned, rule b; simp add: is_aligned_neg_mask)
     done
   also have "\<dots> \<le> x AND NOT(mask n)"
     using b
     apply (subst add.commute)
     apply (rule le_plus)
      apply (rule aligned_at_least_t2n_diff; simp add: is_aligned_neg_mask)
     apply (rule ccontr, simp add: linorder_not_le)
     apply (drule aligned_small_is_0[rotated]; simp 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 and_neg_mask_eq_iff_not_mask_le:
   "w AND NOT(mask n) = NOT(mask n) \<longleftrightarrow> NOT(mask n) \<le> w"
   for w :: \<open>'a::len word\<close>
   by (metis eq_iff neg_mask_mono_le word_and_le1 word_and_le2 word_bw_same(1))
 
 lemma neg_mask_le_high_bits [word_eqI_simps]:
   \<open>NOT (mask n) \<le> w \<longleftrightarrow> (\<forall>i \<in> {n ..< size w}. bit w i)\<close> (is \<open>?P \<longleftrightarrow> ?Q\<close>)
   for w :: \<open>'a::len word\<close>
 proof
   assume ?Q
   then have \<open>w AND NOT (mask n) = NOT (mask n)\<close>
     by (auto simp add: bit_simps word_size intro: bit_word_eqI)
   then show ?P
     by (simp add: and_neg_mask_eq_iff_not_mask_le)
 next
   assume ?P
   then have *: \<open>w AND NOT (mask n) = NOT (mask n)\<close>
     by (simp add: and_neg_mask_eq_iff_not_mask_le)
   show \<open>?Q\<close>
   proof (rule ccontr)
     assume \<open>\<not> (\<forall>i\<in>{n..<size w}. bit w i)\<close>
     then obtain m where m: \<open>\<not> bit w m\<close> \<open>n \<le> m\<close> \<open>m < LENGTH('a)\<close>
       by (auto simp add: word_size)
     from * have \<open>bit (w AND NOT (mask n)) m \<longleftrightarrow> bit (NOT (mask n :: 'a word)) m\<close>
       by auto
     with m show False by (auto simp add: bit_simps)
   qed
 qed
 
 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 word_leq_le_minus_one)
       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
 
 lemma is_aligned_over_length:
   "\<lbrakk> is_aligned p n; LENGTH('a) \<le> n \<rbrakk> \<Longrightarrow> (p::'a::len word) = 0"
   by (simp add: is_aligned_mask mask_over_length)
 
 lemma is_aligned_no_overflow_mask:
   "is_aligned x n \<Longrightarrow> x \<le> x + mask n"
   by (simp add: mask_eq_decr_exp) (erule is_aligned_no_overflow')
 
 lemma aligned_mask_step:
   "\<lbrakk> n' \<le> n; p' \<le> p + mask n; is_aligned p n; is_aligned p' n' \<rbrakk> \<Longrightarrow>
    (p'::'a::len word) + mask n' \<le> p + mask n"
   apply (cases "LENGTH('a) \<le> n")
    apply (frule (1) is_aligned_over_length)
    apply (drule mask_over_length)
    apply clarsimp
   apply (simp add: not_le)
   apply (simp add: word_le_nat_alt unat_plus_simple)
   apply (subst unat_plus_simple[THEN iffD1], erule is_aligned_no_overflow_mask)+
   apply (subst (asm) unat_plus_simple[THEN iffD1], erule is_aligned_no_overflow_mask)
   apply (clarsimp simp: dvd_def is_aligned_iff_dvd_nat)
   apply (rename_tac k k')
   apply (thin_tac "unat p = x" for p x)+
   apply (subst Suc_le_mono[symmetric])
   apply (simp only: Suc_2p_unat_mask)
   apply (drule le_imp_less_Suc, subst (asm) Suc_2p_unat_mask, assumption)
   apply (erule (1) power_2_mult_step_le)
   done
 
 lemma is_aligned_mask_offset_unat:
   fixes off :: "('a::len) word"
   and     x :: "'a word"
   assumes al: "is_aligned x sz"
   and   offv: "off \<le> mask 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)
 
   from offv szv have offv': "unat off < 2 ^ sz"
     by (simp add: mask_2pm1 unat_less_power)
 
   show ?thesis using szv
     using al is_aligned_no_wrap''' offv' by blast
 next
   assume "\<not> sz < LENGTH('a)"
   with al have "x = 0"
     by (meson is_aligned_get_word_bits) 
   thus ?thesis by simp
 qed
 
 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 add: even_mask_iff)
   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 word_le_minus_one_leq)
   apply (simp add: is_aligned_no_wrap' is_aligned_no_overflow field_simps)
   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"
   by (simp add: aligned_add_offset_less)
 
 lemma is_aligned_add_step_le:
   "\<lbrakk> is_aligned (a::'a::len word) n; is_aligned b n; a < b; b \<le> a + mask n \<rbrakk> \<Longrightarrow> False"
   apply (simp flip: not_le)
   apply (erule notE)
   apply (cases "LENGTH('a) \<le> n")
    apply (drule (1) is_aligned_over_length)+
    apply (drule mask_over_length)
    apply clarsimp
   apply (clarsimp simp: word_le_nat_alt not_less not_le)
   apply (subst (asm) unat_plus_simple[THEN iffD1], erule is_aligned_no_overflow_mask)
   apply (subst (asm) unat_add_lem' [symmetric])
    apply (simp add: is_aligned_mask_offset_unat)
   apply (metis gap_between_aligned linorder_not_less mask_eq_decr_exp unat_arith_simps(2))
   done
 
 lemma aligned_add_mask_lessD:
   "\<lbrakk> x + mask n < y; is_aligned x n \<rbrakk> \<Longrightarrow> x < y" for y::"'a::len word"
   by (metis is_aligned_no_overflow' mask_2pm1 order_le_less_trans)
 
 lemma aligned_add_mask_less_eq:
   "\<lbrakk> is_aligned x n; is_aligned y n;  n < LENGTH('a) \<rbrakk> \<Longrightarrow> (x + mask n < y) = (x < y)"
   for y::"'a::len word"
   using aligned_add_mask_lessD is_aligned_add_step_le word_le_not_less by blast
 
 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: of_nat_diff)
   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)"
       using take_bit_nat_less_self_iff [of \<open>LENGTH('a)\<close> \<open>mq - 2 ^ sq * nq\<close>]
       apply (auto simp add: word_less_nat_alt not_le not_less)
       apply (metis take_bit_nat_eq_self_iff)
       done
   qed
   then have "mq - 2 ^ sq * nq < 2 ^ (s2 - s1)" using mq s2wb
     apply (simp add: word_less_nat_alt take_bit_eq_mod)
     apply (subst (asm) mod_less)
     apply auto
      apply (rule order_le_less_trans)
       apply (rule diff_le_self)
      apply (erule order_less_le_trans)
     apply simp
     done
   ultimately show ?thesis
     by auto
 qed
 
 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 aligned_shift:
   "\<lbrakk>x < 2 ^ n; is_aligned (y :: 'a :: len word) n;n \<le> LENGTH('a)\<rbrakk>
-   \<Longrightarrow> x + y >> n = y >> n"
+   \<Longrightarrow> drop_bit n (x + y) = drop_bit n y"
   apply (subst word_plus_and_or_coroll; rule bit_word_eqI)
    apply (auto simp add: bit_simps is_aligned_nth)
    apply (metis less_2p_is_upper_bits_unset not_le)
   apply (metis le_add1 less_2p_is_upper_bits_unset test_bit_bin)
   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"
+   \<Longrightarrow> drop_bit n (y + x) = drop_bit n y"
   apply (subst word_plus_and_or_coroll; rule bit_word_eqI)
    apply (auto simp add: bit_simps is_aligned_nth)
    apply (metis less_2p_is_upper_bits_unset not_le)
   apply (metis bit_imp_le_length le_add1 less_2p_is_upper_bits_unset)
   done
 
 lemma and_neg_mask_plus_mask_mono: "(p AND NOT (mask n)) + mask n \<ge> p"
   for p :: \<open>'a::len word\<close>
   apply (rule word_le_minus_cancel[where x = "p AND NOT (mask n)"])
    apply (clarsimp simp: subtract_mask)
    using word_and_le1[where a = "mask n" and y = p]
     apply (clarsimp simp: mask_eq_decr_exp 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 AND NOT (mask n)) + (2 ^ n - 1)"
   for ptr :: \<open>'a::len word\<close>
   by (simp add: and_neg_mask_plus_mask_mono mask_2pm1[symmetric])
 
 lemma is_aligned_sub_helper:
   "\<lbrakk> is_aligned (p - d) n; d < 2 ^ n \<rbrakk>
      \<Longrightarrow> (p AND mask n = d) \<and> (p AND (NOT (mask n)) = p - d)"
   by (drule(1) is_aligned_add_helper, simp)
 
 lemma is_aligned_after_mask:
   "\<lbrakk>is_aligned k m;m\<le> n\<rbrakk> \<Longrightarrow> is_aligned (k AND 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 AND mask n = (ptr AND 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 AND mask n) AND NOT (mask m)
      = (ptr + a AND NOT (mask m) ) AND 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 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 neg_mask_add_aligned:
   "\<lbrakk> is_aligned p n; q < 2 ^ n \<rbrakk> \<Longrightarrow> (p + q) AND NOT (mask n) = p AND NOT (mask n)"
   by (metis is_aligned_add_helper is_aligned_neg_mask_eq)
 
 end
diff --git a/thys/Word_Lib/Ancient_Numeral.thy b/thys/Word_Lib/Ancient_Numeral.thy
--- a/thys/Word_Lib/Ancient_Numeral.thy
+++ b/thys/Word_Lib/Ancient_Numeral.thy
@@ -1,235 +1,231 @@
 (*
  * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
  *
  * SPDX-License-Identifier: BSD-2-Clause
  *)
 
 theory Ancient_Numeral
   imports Main Reversed_Bit_Lists Legacy_Aliases
 begin
 
 definition Bit :: "int \<Rightarrow> bool \<Rightarrow> int"  (infixl "BIT" 90)
   where "k BIT b = (if b then 1 else 0) + k + k"
 
 lemma Bit_B0: "k BIT False = k + k"
    by (simp add: Bit_def)
 
 lemma Bit_B1: "k BIT True = k + k + 1"
    by (simp add: Bit_def)
 
 lemma Bit_B0_2t: "k BIT False = 2 * k"
   by (rule trans, rule Bit_B0) simp
 
 lemma Bit_B1_2t: "k BIT True = 2 * k + 1"
   by (rule trans, rule Bit_B1) simp
 
 lemma uminus_Bit_eq:
   "- k BIT b = (- k - of_bool b) BIT b"
   by (cases b) (simp_all add: Bit_def)
 
 lemma power_BIT: "2 ^ Suc n - 1 = (2 ^ n - 1) BIT True"
   by (simp add: Bit_B1)
 
 lemma bin_rl_simp [simp]: "bin_rest w BIT bin_last w = w"
   by (simp add: Bit_def)
 
 lemma bin_rest_BIT [simp]: "bin_rest (x BIT b) = x"
   by (simp add: Bit_def)
 
 lemma even_BIT [simp]: "even (x BIT b) \<longleftrightarrow> \<not> b"
   by (simp add: Bit_def)
 
 lemma bin_last_BIT [simp]: "bin_last (x BIT b) = b"
   by simp
 
 lemma BIT_eq_iff [iff]: "u BIT b = v BIT c \<longleftrightarrow> u = v \<and> b = c"
   by (auto simp: Bit_def) arith+
 
 lemma BIT_bin_simps [simp]:
   "numeral k BIT False = numeral (Num.Bit0 k)"
   "numeral k BIT True = numeral (Num.Bit1 k)"
   "(- numeral k) BIT False = - numeral (Num.Bit0 k)"
   "(- numeral k) BIT True = - numeral (Num.BitM k)"
   by (simp_all only: Bit_B0 Bit_B1 numeral.simps numeral_BitM)
 
 lemma BIT_special_simps [simp]:
   shows "0 BIT False = 0"
     and "0 BIT True = 1"
     and "1 BIT False = 2"
     and "1 BIT True = 3"
     and "(- 1) BIT False = - 2"
     and "(- 1) BIT True = - 1"
   by (simp_all add: Bit_def)
 
 lemma Bit_eq_0_iff: "w BIT b = 0 \<longleftrightarrow> w = 0 \<and> \<not> b"
   by (auto simp: Bit_def) arith
 
 lemma Bit_eq_m1_iff: "w BIT b = -1 \<longleftrightarrow> w = -1 \<and> b"
   by (auto simp: Bit_def) arith
 
 lemma expand_BIT:
   "numeral (Num.Bit0 w) = numeral w BIT False"
   "numeral (Num.Bit1 w) = numeral w BIT True"
   "- numeral (Num.Bit0 w) = (- numeral w) BIT False"
   "- numeral (Num.Bit1 w) = (- numeral (w + Num.One)) BIT True"
   by (simp_all add: BitM_inc_eq add_One)
 
 lemma less_Bits: "v BIT b < w BIT c \<longleftrightarrow> v < w \<or> v \<le> w \<and> \<not> b \<and> c"
   by (auto simp: Bit_def)
 
 lemma le_Bits: "v BIT b \<le> w BIT c \<longleftrightarrow> v < w \<or> v \<le> w \<and> (\<not> b \<or> c)"
   by (auto simp: Bit_def)
 
 lemma pred_BIT_simps [simp]:
   "x BIT False - 1 = (x - 1) BIT True"
   "x BIT True - 1 = x BIT False"
   by (simp_all add: Bit_B0_2t Bit_B1_2t)
 
 lemma succ_BIT_simps [simp]:
   "x BIT False + 1 = x BIT True"
   "x BIT True + 1 = (x + 1) BIT False"
   by (simp_all add: Bit_B0_2t Bit_B1_2t)
 
 lemma add_BIT_simps [simp]:
   "x BIT False + y BIT False = (x + y) BIT False"
   "x BIT False + y BIT True = (x + y) BIT True"
   "x BIT True + y BIT False = (x + y) BIT True"
   "x BIT True + y BIT True = (x + y + 1) BIT False"
   by (simp_all add: Bit_B0_2t Bit_B1_2t)
 
 lemma mult_BIT_simps [simp]:
   "x BIT False * y = (x * y) BIT False"
   "x * y BIT False = (x * y) BIT False"
   "x BIT True * y = (x * y) BIT False + y"
   by (simp_all add: Bit_B0_2t Bit_B1_2t algebra_simps)
 
 lemma B_mod_2': "X = 2 \<Longrightarrow> (w BIT True) mod X = 1 \<and> (w BIT False) mod X = 0"
   by (simp add: Bit_B0 Bit_B1)
 
 lemma bin_ex_rl: "\<exists>w b. w BIT b = bin"
   by (metis bin_rl_simp)
 
 lemma bin_exhaust: "(\<And>x b. bin = x BIT b \<Longrightarrow> Q) \<Longrightarrow> Q"
 by (metis bin_ex_rl)
 
 lemma bin_abs_lem: "bin = (w BIT b) \<Longrightarrow> bin \<noteq> -1 \<longrightarrow> bin \<noteq> 0 \<longrightarrow> nat \<bar>w\<bar> < nat \<bar>bin\<bar>"
   apply clarsimp
   apply (unfold Bit_def)
   apply (cases b)
    apply (clarsimp, arith)
   apply (clarsimp, arith)
   done
 
 lemma bin_induct:
   assumes PPls: "P 0"
     and PMin: "P (- 1)"
     and PBit: "\<And>bin bit. P bin \<Longrightarrow> P (bin BIT bit)"
   shows "P bin"
   apply (rule_tac P=P and a=bin and f1="nat \<circ> abs" in wf_measure [THEN wf_induct])
   apply (simp add: measure_def inv_image_def)
   apply (case_tac x rule: bin_exhaust)
   apply (frule bin_abs_lem)
   apply (auto simp add : PPls PMin PBit)
   done
 
 lemma Bit_div2: "(w BIT b) div 2 = w"
   by (fact bin_rest_BIT)
 
 lemma twice_conv_BIT: "2 * x = x BIT False"
   by (simp add: Bit_def)
 
 lemma BIT_lt0 [simp]: "x BIT b < 0 \<longleftrightarrow> x < 0"
 by(cases b)(auto simp add: Bit_def)
 
 lemma BIT_ge0 [simp]: "x BIT b \<ge> 0 \<longleftrightarrow> x \<ge> 0"
 by(cases b)(auto simp add: Bit_def)
 
 lemma bin_to_bl_aux_Bit_minus_simp [simp]:
   "0 < n \<Longrightarrow> bin_to_bl_aux n (w BIT b) bl = bin_to_bl_aux (n - 1) w (b # bl)"
   by (cases n) auto
 
 lemma bl_to_bin_BIT:
   "bl_to_bin bs BIT b = bl_to_bin (bs @ [b])"
   by (simp add: bl_to_bin_append Bit_def)
 
 lemma bin_nth_0_BIT: "bin_nth (w BIT b) 0 \<longleftrightarrow> b"
   by simp
 
 lemma bin_nth_Suc_BIT: "bin_nth (w BIT b) (Suc n) = bin_nth w n"
   by (simp add: bit_Suc)
 
 lemma bin_nth_minus [simp]: "0 < n \<Longrightarrow> bin_nth (w BIT b) n = bin_nth w (n - 1)"
   by (cases n) (simp_all add: bit_Suc)
 
 lemma bin_sign_simps [simp]:
   "bin_sign (w BIT b) = bin_sign w"
   by (simp add: bin_sign_def Bit_def)
 
 lemma bin_nth_Bit: "bin_nth (w BIT b) n \<longleftrightarrow> n = 0 \<and> b \<or> (\<exists>m. n = Suc m \<and> bin_nth w m)"
   by (cases n) auto
 
 lemmas sbintrunc_Suc_BIT [simp] =
   signed_take_bit_Suc [where a="w BIT b", simplified bin_last_BIT bin_rest_BIT] for w b
 
 lemmas sbintrunc_0_BIT_B0 [simp] =
   signed_take_bit_0 [where a="w BIT False", simplified bin_last_numeral_simps bin_rest_numeral_simps]
   for w
 
 lemmas sbintrunc_0_BIT_B1 [simp] =
   signed_take_bit_0 [where a="w BIT True", simplified bin_last_BIT bin_rest_numeral_simps]
   for w
 
 lemma sbintrunc_Suc_minus_Is:
   \<open>0 < n \<Longrightarrow>
   sbintrunc (n - 1) w = y \<Longrightarrow>
   sbintrunc n (w BIT b) = y BIT b\<close>
   by (cases n) (simp_all add: Bit_def signed_take_bit_Suc)
 
 lemma bin_cat_Suc_Bit: "bin_cat w (Suc n) (v BIT b) = bin_cat w n v BIT b"
   by (auto simp add: Bit_def concat_bit_Suc)
 
 lemma int_not_BIT [simp]: "NOT (w BIT b) = (NOT w) BIT (\<not> b)"
   by (simp add: not_int_def Bit_def)
 
 lemma int_and_Bits [simp]: "(x BIT b) AND (y BIT c) = (x AND y) BIT (b \<and> c)"
   using and_int_rec [of \<open>x BIT b\<close> \<open>y BIT c\<close>] by (auto simp add: Bit_B0_2t Bit_B1_2t)
 
 lemma int_or_Bits [simp]: "(x BIT b) OR (y BIT c) = (x OR y) BIT (b \<or> c)"
   using or_int_rec [of \<open>x BIT b\<close> \<open>y BIT c\<close>] by (auto simp add: Bit_B0_2t Bit_B1_2t)
 
 lemma int_xor_Bits [simp]: "(x BIT b) XOR (y BIT c) = (x XOR y) BIT ((b \<or> c) \<and> \<not> (b \<and> c))"
   using xor_int_rec [of \<open>x BIT b\<close> \<open>y BIT c\<close>] by (auto simp add: Bit_B0_2t Bit_B1_2t)
 
 lemma mod_BIT:
   "bin BIT bit mod 2 ^ Suc n = (bin mod 2 ^ n) BIT bit" for bit
 proof -
   have "2 * (bin mod 2 ^ n) + 1 = (2 * bin mod 2 ^ Suc n) + 1"
     by (simp add: mod_mult_mult1)
   also have "\<dots> = ((2 * bin mod 2 ^ Suc n) + 1) mod 2 ^ Suc n"
     by (simp add: ac_simps pos_zmod_mult_2)
   also have "\<dots> = (2 * bin + 1) mod 2 ^ Suc n"
     by (simp only: mod_simps)
   finally show ?thesis
     by (auto simp add: Bit_def)
 qed
 
 lemma minus_BIT_0: fixes x y :: int shows "x BIT b - y BIT False = (x - y) BIT b"
 by(simp add: Bit_def)
 
 lemma int_lsb_BIT [simp]: fixes x :: int shows
   "lsb (x BIT b) \<longleftrightarrow> b"
 by(simp add: lsb_int_def)
 
 lemma int_shiftr_BIT [simp]: fixes x :: int
-  shows int_shiftr0: "x >> 0 = x"
-  and int_shiftr_Suc: "x BIT b >> Suc n = x >> n"
-proof -
-  show "x >> 0 = x" by (simp add: shiftr_int_def)
-  show "x BIT b >> Suc n = x >> n" by (cases b)
-   (simp_all add: shiftr_int_def Bit_def add.commute pos_zdiv_mult_2)
-qed
+  shows int_shiftr0: "drop_bit 0 x = x"
+  and int_shiftr_Suc: "drop_bit (Suc n) (x BIT b) = drop_bit n x"
+  by (simp_all add: drop_bit_Suc)
 
 lemma msb_BIT [simp]: "msb (x BIT b) = msb x"
 by(simp add: msb_int_def)
 
 end
\ No newline at end of file
diff --git a/thys/Word_Lib/Traditional_Infix_Syntax.thy b/thys/Word_Lib/Bit_Shifts_Infix_Syntax.thy
rename from thys/Word_Lib/Traditional_Infix_Syntax.thy
rename to thys/Word_Lib/Bit_Shifts_Infix_Syntax.thy
--- a/thys/Word_Lib/Traditional_Infix_Syntax.thy
+++ b/thys/Word_Lib/Bit_Shifts_Infix_Syntax.thy
@@ -1,820 +1,29 @@
 (*
  * Copyright Data61, CSIRO (ABN 41 687 119 230)
  *
  * SPDX-License-Identifier: BSD-2-Clause
  *)
 
 (* Author: Jeremy Dawson, NICTA *)
 
-section \<open>Operation variants with traditional syntax\<close>
+section \<open>Shift operations with traditional infix syntax\<close>
 
-theory Traditional_Infix_Syntax
-  imports "HOL-Library.Word" More_Word Signed_Words Syntax_Bundles
-begin
-
-class semiring_bit_syntax = semiring_bit_shifts
+theory Bit_Shifts_Infix_Syntax
+  imports "HOL-Library.Word"
 begin
 
-definition shiftl :: \<open>'a \<Rightarrow> nat \<Rightarrow> 'a\<close>  (infixl "<<" 55)
-  where shiftl_eq_push_bit: \<open>a << n = push_bit n a\<close>
-
-definition shiftr :: \<open>'a \<Rightarrow> nat \<Rightarrow> 'a\<close>  (infixl ">>" 55)
-  where shiftr_eq_drop_bit: \<open>a >> n = drop_bit n a\<close>
-
-end
-
-instance word :: (len) semiring_bit_syntax ..
-
-context
-  includes lifting_syntax
+context semiring_bit_shifts
 begin
 
-lemma shiftl_word_transfer [transfer_rule]:
-  \<open>(pcr_word ===> (=) ===> pcr_word) (\<lambda>k n. push_bit n k) shiftl\<close>
-  by (unfold shiftl_eq_push_bit) transfer_prover
+abbreviation shiftl :: \<open>'a \<Rightarrow> nat \<Rightarrow> 'a\<close>  (infixl "<<" 55)
+  where \<open>a << n \<equiv> push_bit n a\<close>
 
-lemma shiftr_word_transfer [transfer_rule]:
-  \<open>(pcr_word ===> (=) ===> pcr_word) (\<lambda>k n. (drop_bit n \<circ> take_bit LENGTH('a)) k) (shiftr :: 'a::len word \<Rightarrow> _)\<close>
-  by (unfold shiftr_eq_drop_bit) transfer_prover
+abbreviation shiftr :: \<open>'a \<Rightarrow> nat \<Rightarrow> 'a\<close>  (infixl ">>" 55)
+  where \<open>a >> n \<equiv> drop_bit n a\<close>
 
 end
 
-lemma shiftl_word_eq:
-  \<open>w << n = push_bit n w\<close> for w :: \<open>'a::len word\<close>
-  by (fact shiftl_eq_push_bit)
-
-lemma shiftr_word_eq:
-  \<open>w >> n = drop_bit n w\<close> for w :: \<open>'a::len word\<close>
-  by (fact shiftr_eq_drop_bit)
-
-lemma uint_shiftr_eq:
-  \<open>uint (w >> n) = uint w div 2 ^ n\<close>
-  by transfer (simp flip: drop_bit_eq_div add: drop_bit_take_bit min_def le_less less_diff_conv)
-
-lemma bit_shiftl_word_iff [bit_simps]:
-  \<open>bit (w << m) n \<longleftrightarrow> m \<le> n \<and> n < LENGTH('a) \<and> bit w (n - m)\<close>
-  for w :: \<open>'a::len word\<close>
-  by (simp add: shiftl_word_eq bit_push_bit_iff not_le)
-
-lemma shiftl_def:
-  \<open>w << n = ((*) 2 ^^ n) w\<close> for w :: \<open>'a::len word\<close>
-proof -
-  have \<open>push_bit n = (((*) 2 ^^ n) :: int \<Rightarrow> int)\<close> for n
-    by (induction n) (simp_all add: fun_eq_iff funpow_swap1, simp add: ac_simps)
-  then show ?thesis
-    by transfer simp
-qed
-
-lemma shiftr_def:
-  \<open>w >> n = ((\<lambda>w. w div 2) ^^ n) w\<close> for w :: \<open>'a::len word\<close>
-proof -
-  have \<open>(\<lambda>w. w div 2) ^^ n = (drop_bit n :: 'a word \<Rightarrow> 'a word)\<close>
-    by (induction n) (simp_all add: drop_bit_half drop_bit_Suc)
-  then show ?thesis
-    by (simp add: shiftr_eq_drop_bit)
-qed
-
-lemma bit_shiftr_word_iff [bit_simps]:
-  \<open>bit (w >> m) n \<longleftrightarrow> bit w (m + n)\<close>
-  for w :: \<open>'a::len word\<close>
-  by (simp add: shiftr_word_eq bit_drop_bit_eq)
-
-lift_definition sshiftr :: \<open>'a::len word \<Rightarrow> nat \<Rightarrow> 'a word\<close>  (infixl \<open>>>>\<close> 55)
-  is \<open>\<lambda>k n. take_bit LENGTH('a) (drop_bit n (signed_take_bit (LENGTH('a) - Suc 0) k))\<close>
-  by (simp flip: signed_take_bit_decr_length_iff)
-
-lemma sshiftr_eq [code]:
-  \<open>w >>> n = signed_drop_bit n w\<close>
-  by transfer simp
-
-lemma sshiftr_eq_funpow_sshiftr1:
-  \<open>w >>> n = (signed_drop_bit (Suc 0) ^^ n) w\<close>
-  apply (rule sym)
-  apply (simp add: sshiftr_eq)
-  apply (induction n)
-   apply simp_all
-  done
-
-lemma uint_sshiftr_eq:
-  \<open>uint (w >>> n) = take_bit LENGTH('a) (sint w div 2 ^  n)\<close>
-  for w :: \<open>'a::len word\<close>
-  by transfer (simp flip: drop_bit_eq_div)
-
-lemma sshiftr_0 [simp]: "0 >>> n = 0"
-  by transfer simp
-
-lemma sshiftr_n1 [simp]: "-1 >>> n = -1"
-  by transfer simp
-
-lemma bit_sshiftr_word_iff [bit_simps]:
-  \<open>bit (w >>> m) n \<longleftrightarrow> bit w (if LENGTH('a) - m \<le> n \<and> n < LENGTH('a) then LENGTH('a) - 1 else (m + n))\<close>
-  for w :: \<open>'a::len word\<close>
-  apply transfer
-  apply (auto simp add: bit_take_bit_iff bit_drop_bit_eq bit_signed_take_bit_iff min_def not_le simp flip: bit_Suc)
-  using le_less_Suc_eq apply fastforce
-  using le_less_Suc_eq apply fastforce
-  done
-
-lemma nth_sshiftr :
-  "bit (w >>> m) n =
-    (n < size w \<and> (if n + m \<ge> size w then bit w (size w - 1) else bit w (n + m)))"
-  apply transfer
-  apply (auto simp add: bit_take_bit_iff bit_drop_bit_eq bit_signed_take_bit_iff min_def not_le ac_simps)
-  using le_less_Suc_eq apply fastforce
-  using le_less_Suc_eq apply fastforce
-  done
-
-lemma sshiftr_numeral [simp]:
-  \<open>(numeral k >>> numeral n :: 'a::len word) =
-    word_of_int (drop_bit (numeral n) (signed_take_bit (LENGTH('a) - 1) (numeral k)))\<close>
-  apply (rule bit_word_eqI)
-   apply (simp add: word_size nth_sshiftr ac_simps bit_simps)
-  done
-
-setup \<open>
-  Context.theory_map (fold SMT_Word.add_word_shift' [
-    (\<^term>\<open>shiftl :: 'a::len word \<Rightarrow> _\<close>, "bvshl"),
-    (\<^term>\<open>shiftr :: 'a::len word \<Rightarrow> _\<close>, "bvlshr"),
-    (\<^term>\<open>sshiftr :: 'a::len word \<Rightarrow> _\<close>, "bvashr")
-  ])
-\<close>
-
-lemma revcast_down_us [OF refl]:
-  "rc = revcast \<Longrightarrow> source_size rc = target_size rc + n \<Longrightarrow> rc w = ucast (w >>> n)"
-  for w :: "'a::len word"
-  apply (simp add: source_size_def target_size_def)
-  apply (rule bit_word_eqI)
-  apply (simp add: bit_revcast_iff bit_ucast_iff bit_sshiftr_word_iff ac_simps)
-  done
-
-lemma revcast_down_ss [OF refl]:
-  "rc = revcast \<Longrightarrow> source_size rc = target_size rc + n \<Longrightarrow> rc w = scast (w >>> n)"
-  for w :: "'a::len word"
-  apply (simp add: source_size_def target_size_def)
-  apply (rule bit_word_eqI)
-  apply (simp add: bit_revcast_iff bit_word_scast_iff bit_sshiftr_word_iff ac_simps)
-  done
-
-lemma sshiftr_div_2n: "sint (w >>> n) = sint w div 2 ^ n"
-  using sint_signed_drop_bit_eq [of n w]
-  by (simp add: drop_bit_eq_div sshiftr_eq)
-
-lemma mask_eq:
-  \<open>mask n = (1 << n) - (1 :: 'a::len word)\<close>
-  by transfer (simp add: mask_eq_exp_minus_1 push_bit_of_1)
-
-lemma shiftl_0 [simp]: "(0::'a::len word) << n = 0"
-  by transfer simp
-
-lemma shiftr_0 [simp]: "(0::'a::len word) >> n = 0"
-  by transfer simp
-
-lemma nth_shiftl': "bit (w << m) n \<longleftrightarrow> n < size w \<and> n >= m \<and> bit w (n - m)"
-  for w :: "'a::len word"
-  by transfer (auto simp add: bit_push_bit_iff)
-
-lemmas nth_shiftl = nth_shiftl' [unfolded word_size]
-
-lemma nth_shiftr: "bit (w >> m) n = bit w (n + m)"
-  for w :: "'a::len word"
-  by (simp add: bit_simps ac_simps)
-
-lemma shiftr_div_2n: "uint (shiftr w n) = uint w div 2 ^ n"
-  by (fact uint_shiftr_eq)
-
-lemma shiftl_rev: "shiftl w n = word_reverse (shiftr (word_reverse w) n)"
-  by (rule bit_word_eqI) (auto simp add: bit_simps)
-
-lemma rev_shiftl: "word_reverse w << n = word_reverse (w >> n)"
-  by (simp add: shiftl_rev)
-
-lemma shiftr_rev: "w >> n = word_reverse (word_reverse w << n)"
-  by (simp add: rev_shiftl)
-
-lemma rev_shiftr: "word_reverse w >> n = word_reverse (w << n)"
-  by (simp add: shiftr_rev)
-
-lemma shiftl_numeral [simp]:
-  \<open>numeral k << numeral l = (push_bit (numeral l) (numeral k) :: 'a::len word)\<close>
-  by (fact shiftl_word_eq)
-
-lemma shiftl_zero_size: "size x \<le> n \<Longrightarrow> x << n = 0"
-  for x :: "'a::len word"
-  apply transfer
-  apply (simp add: take_bit_push_bit)
-  done
-
-lemma shiftl_t2n: "shiftl w n = 2 ^ n * w"
-  for w :: "'a::len word"
-  by (simp add: shiftl_eq_push_bit push_bit_eq_mult)
-
-lemma shiftr_numeral [simp]:
-  \<open>(numeral k >> numeral n :: 'a::len word) = drop_bit (numeral n) (numeral k)\<close>
-  by (fact shiftr_word_eq)
-
-lemma shiftr_numeral_Suc [simp]:
-  \<open>(numeral k >> Suc 0 :: 'a::len word) = drop_bit (Suc 0) (numeral k)\<close>
-  by (fact shiftr_word_eq)
-
-lemma slice_shiftr: "slice n w = ucast (w >> n)"
-  apply (rule bit_word_eqI)
-  apply (cases \<open>n \<le> LENGTH('b)\<close>)
-   apply (auto simp add: bit_slice_iff bit_ucast_iff bit_shiftr_word_iff ac_simps
-    dest: bit_imp_le_length)
-  done
-
-lemma revcast_down_uu [OF refl]:
-  "rc = revcast \<Longrightarrow> source_size rc = target_size rc + n \<Longrightarrow> rc w = ucast (w >> n)"
-  for w :: "'a::len word"
-  apply (simp add: source_size_def target_size_def)
-  apply (rule bit_word_eqI)
-  apply (simp add: bit_revcast_iff bit_ucast_iff bit_shiftr_word_iff ac_simps)
-  done
-
-lemma revcast_down_su [OF refl]:
-  "rc = revcast \<Longrightarrow> source_size rc = target_size rc + n \<Longrightarrow> rc w = scast (w >> n)"
-  for w :: "'a::len word"
-  apply (simp add: source_size_def target_size_def)
-  apply (rule bit_word_eqI)
-  apply (simp add: bit_revcast_iff bit_word_scast_iff bit_shiftr_word_iff ac_simps)
-  done
-
-lemma cast_down_rev [OF refl]:
-  "uc = ucast \<Longrightarrow> source_size uc = target_size uc + n \<Longrightarrow> uc w = revcast (w << n)"
-  for w :: "'a::len word"
-  apply (simp add: source_size_def target_size_def)
-  apply (rule bit_word_eqI)
-  apply (simp add: bit_revcast_iff bit_word_ucast_iff bit_shiftl_word_iff)
-  done
-
-lemma revcast_up [OF refl]:
-  "rc = revcast \<Longrightarrow> source_size rc + n = target_size rc \<Longrightarrow>
-    rc w = (ucast w :: 'a::len word) << n"
-  apply (simp add: source_size_def target_size_def)
-  apply (rule bit_word_eqI)
-  apply (simp add: bit_revcast_iff bit_word_ucast_iff bit_shiftl_word_iff)
-  apply auto
-  apply (metis add.commute add_diff_cancel_right)
-  apply (metis diff_add_inverse2 diff_diff_add)
-  done
-
-lemmas rc1 = revcast_up [THEN
-  revcast_rev_ucast [symmetric, THEN trans, THEN word_rev_gal, symmetric]]
-lemmas rc2 = revcast_down_uu [THEN
-  revcast_rev_ucast [symmetric, THEN trans, THEN word_rev_gal, symmetric]]
-
-lemmas ucast_up =
-  rc1 [simplified rev_shiftr [symmetric] revcast_ucast [symmetric]]
-lemmas ucast_down =
-  rc2 [simplified rev_shiftr revcast_ucast [symmetric]]
-
-\<comment> \<open>problem posed by TPHOLs referee:
-      criterion for overflow of addition of signed integers\<close>
-
-lemma sofl_test:
-  \<open>sint x + sint y = sint (x + y) \<longleftrightarrow>
-    (x + y XOR x) AND (x + y XOR y) >> (size x - 1) = 0\<close>
-  for x y :: \<open>'a::len word\<close>
-proof -
-  obtain n where n: \<open>LENGTH('a) = Suc n\<close>
-    by (cases \<open>LENGTH('a)\<close>) simp_all
-  have *: \<open>sint x + sint y + 2 ^ Suc n > signed_take_bit n (sint x + sint y) \<Longrightarrow> sint x + sint y \<ge> - (2 ^ n)\<close>
-    \<open>signed_take_bit n (sint x + sint y) > sint x + sint y - 2 ^ Suc n \<Longrightarrow> 2 ^ n > sint x + sint y\<close>
-    using signed_take_bit_int_greater_eq [of \<open>sint x + sint y\<close> n] signed_take_bit_int_less_eq [of n \<open>sint x + sint y\<close>]
-    by (auto intro: ccontr)
-  have \<open>sint x + sint y = sint (x + y) \<longleftrightarrow>
-    (sint (x + y) < 0 \<longleftrightarrow> sint x < 0) \<or>
-    (sint (x + y) < 0 \<longleftrightarrow> sint y < 0)\<close>
-    using sint_less [of x] sint_greater_eq [of x] sint_less [of y] sint_greater_eq [of y]
-    signed_take_bit_int_eq_self [of \<open>LENGTH('a) - 1\<close> \<open>sint x + sint y\<close>]
-    apply (auto simp add: not_less)
-       apply (unfold sint_word_ariths)
-       apply (subst signed_take_bit_int_eq_self)
-         prefer 4
-         apply (subst signed_take_bit_int_eq_self)
-           prefer 7
-           apply (subst signed_take_bit_int_eq_self)
-             prefer 10
-             apply (subst signed_take_bit_int_eq_self)
-               apply (auto simp add: signed_take_bit_int_eq_self signed_take_bit_eq_take_bit_minus take_bit_Suc_from_most n not_less intro!: *)
-       apply (smt (z3) take_bit_nonnegative)
-      apply (smt (z3) take_bit_int_less_exp)
-     apply (smt (z3) take_bit_nonnegative)
-    apply (smt (z3) take_bit_int_less_exp)
-    done
-  then show ?thesis
-    apply (simp only: One_nat_def word_size shiftr_word_eq drop_bit_eq_zero_iff_not_bit_last bit_and_iff bit_xor_iff)
-    apply (simp add: bit_last_iff)
-    done
-qed
-
-lemma shiftr_zero_size: "size x \<le> n \<Longrightarrow> x >> n = 0"
-  for x :: "'a :: len word"
-  by (rule word_eqI) (auto simp add: nth_shiftr dest: test_bit_size)
-
-lemma shiftr_x_0 [iff]: "x >> 0 = x"
-  for x :: "'a::len word"
-  by transfer simp
-
-lemma shiftl_x_0 [simp]: "x << 0 = x"
-  for x :: "'a::len word"
-  by (simp add: shiftl_t2n)
-
-lemma shiftl_1 [simp]: "(1::'a::len word) << n = 2^n"
-  by (simp add: shiftl_t2n)
-
-lemma shiftr_1[simp]: "(1::'a::len word) >> n = (if n = 0 then 1 else 0)"
-  by (induct n) (auto simp: shiftr_def)
-
-lemma shiftl0:
-  "x << 0 = (x :: 'a :: len word)"
-  by (fact shiftl_x_0)
-
-lemma word_ops_nth:
-  fixes x y :: \<open>'a::len word\<close>
-  shows
-  word_or_nth:  "bit (x OR y) n = (bit x n \<or> bit y n)" and
-  word_and_nth: "bit (x AND y) n = (bit x n \<and> bit y n)" and
-  word_xor_nth: "bit (x XOR y) n = (bit x n \<noteq> bit y n)"
-  by (simp_all add: bit_simps)
-
-lemma and_not_mask:
-  "w AND NOT (mask n) = (w >> n) << n"
-  for w :: \<open>'a::len word\<close>
-  by (rule bit_word_eqI) (auto simp add: bit_simps)
-
-lemma and_mask:
-  "w AND mask n = (w << (size w - n)) >> (size w - n)"
-  for w :: \<open>'a::len word\<close>
-  by (rule bit_word_eqI) (auto simp add: bit_simps word_size)
-
-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 (metis uint_shiftr_eq word_of_int_uint)
-  done
-
-lemma le_shiftr:
-  "u \<le> v \<Longrightarrow> u >> (n :: nat) \<le> (v :: 'a :: len word) >> n"
-  apply transfer
-  apply (simp add: take_bit_drop_bit)
-  apply (simp add: drop_bit_eq_div zdiv_mono1)
-  done
-
-lemma shiftr_mask_le:
-  "n <= m \<Longrightarrow> mask n >> m = (0 :: 'a::len word)"
-  by (rule bit_word_eqI) (auto simp add: bit_simps)
-
-lemma shiftr_mask [simp]:
-  \<open>mask m >> m = (0::'a::len word)\<close>
-  by (rule shiftr_mask_le) simp
-
-lemma le_mask_iff:
-  "(w \<le> mask n) = (w >> n = 0)"
-  for w :: \<open>'a::len word\<close>
-  apply safe
-   apply (rule word_le_0_iff [THEN iffD1])
-   apply (rule xtrans(3))
-    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 bit_simps)
-  apply (case_tac "n <= n'")
-  by auto
-
-lemma and_mask_eq_iff_shiftr_0:
-  "(w AND mask n = w) = (w >> n = 0)"
-  for w :: \<open>'a::len word\<close>
-  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 transfer
-  apply (auto simp add: fun_eq_iff bit_simps)
-  apply (metis add_diff_inverse_nat)
-  done
-
-lemma mask_shiftl_decompose:
-  "mask m << n = mask (m + n) AND NOT (mask n :: 'a::len word)"
-  by (rule bit_word_eqI) (auto simp add: bit_simps)
-
-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 bit_simps)
-  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 bit_simps)
-  done
-
-lemma shiftr_shiftl1:
-  fixes a::"'a::len word"
-  shows "c \<le> b \<Longrightarrow> a >> b << c = (a >> (b - c)) AND (NOT (mask c))"
-  by (rule bit_word_eqI) (auto simp add: bit_simps)
-
-lemma shiftr_shiftl2:
-  fixes a::"'a::len word"
-  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 bit_simps)
-  done
-
-lemmas multi_shift_simps =
-  shiftl_shiftl shiftr_shiftr
-  shiftl_shiftr1 shiftl_shiftr2
-  shiftr_shiftl1 shiftr_shiftl2
-
-lemma shiftr_mask2:
-  "n \<le> LENGTH('a) \<Longrightarrow> (mask n >> m :: ('a :: len) word) = mask (n - m)"
-  by (rule bit_word_eqI) (auto simp add: bit_simps)
-
-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 mask_shift:
-  "(x AND NOT (mask y)) >> y = x >> y"
-  for x :: \<open>'a::len word\<close>
-  apply (rule bit_eqI)
-  apply (simp add: bit_and_iff bit_not_iff bit_shiftr_word_iff bit_mask_iff not_le)
-  using bit_imp_le_length apply auto
-  done
-
-lemma shiftr_div_2n':
-  "unat (w >> n) = unat w div 2 ^ n"
-  apply (unfold unat_eq_nat_uint)
-  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_eq_unatI)
-  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 ucast_shiftl_eq_0:
-  fixes w :: "'a :: len word"
-  shows "\<lbrakk> n \<ge> LENGTH('b) \<rbrakk> \<Longrightarrow> ucast (w << n) = (0 :: 'b :: len word)"
-  by transfer (simp add: take_bit_push_bit)
-
-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_shiftr_lt:
-  fixes w :: "'a::len word"
-  shows "unat (w >> n) < (2 ^ (LENGTH('a) - n))"
-  apply (subst shiftr_div_2n')
-  apply transfer
-  apply (simp flip: drop_bit_eq_div add: drop_bit_nat_eq drop_bit_take_bit)
-  done
-
-lemma shiftr_less_t2n':
-  "\<lbrakk> x AND mask (n + m) = x; m < LENGTH('a) \<rbrakk> \<Longrightarrow> x >> n < 2 ^ m" for x :: "'a :: len word"
-  apply (simp add: word_size mask_eq_iff_w2p [symmetric] flip: take_bit_eq_mask)
-  apply transfer
-  apply (simp add: take_bit_drop_bit ac_simps)
-  done
-
-lemma shiftr_less_t2n:
-  "x < 2 ^ (n + m) \<Longrightarrow> x >> n < 2 ^ m" for x :: "'a :: len word"
-  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 shiftl_less_t2n:
-  fixes x :: "'a :: len word"
-  shows "\<lbrakk> x < (2 ^ (m - n)); m < LENGTH('a) \<rbrakk> \<Longrightarrow> (x << n) < 2 ^ m"
-  apply (simp add: word_size mask_eq_iff_w2p [symmetric] flip: take_bit_eq_mask)
-  apply transfer
-  apply (simp add: take_bit_push_bit)
-  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 scast_bit_test [simp]:
-    "scast ((1 :: 'a::len signed word) << n) = (1 :: 'a word) << n"
-  by (clarsimp simp: word_eq_iff)
-
-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 shiftr_not_mask_0:
-  "n+m \<ge> LENGTH('a :: len) \<Longrightarrow> ((w::'a::len word) >> n) AND NOT (mask m) = 0"
-  by (rule bit_word_eqI) (auto simp add: bit_simps word_size dest: bit_imp_le_length)
-
-lemma shiftl_mask_is_0[simp]:
-  "(x << n) AND mask n = 0"
-  for x :: \<open>'a::len word\<close>
-  by (simp flip: take_bit_eq_mask add: shiftl_eq_push_bit take_bit_push_bit)
-
-lemma rshift_sub_mask_eq:
-  "(a >> (size a - b)) AND mask b = a >> (size a - b)"
-  for a :: \<open>'a::len word\<close>
-  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_eq_decr_exp word_size
-                   p2_eq_0[THEN iffD2])
-  done
-
-lemma shiftl_shiftr3:
-  "b \<le> c \<Longrightarrow> a << b >> c = (a >> c - b) AND mask (size a - c)"
-  for a :: \<open>'a::len word\<close>
-  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 AND mask m) >> n = (w >> n) AND mask (m-n)"
-  for w :: \<open>'a::len word\<close>
-  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 AND mask m) << n = (w << n) AND mask (m+n)"
-  for w :: \<open>'a::len word\<close>
-  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"
-  for x :: \<open>'a::len word\<close>
-  by (simp add: le_mask_iff shiftl_shiftr3)
-
-lemma word_and_1_shiftl:
-  "x AND (1 << n) = (if bit x n then (1 << n) else 0)" for x :: "'a :: len word"
-  apply (rule bit_word_eqI; transfer)
-  apply (auto simp add: bit_simps not_le ac_simps)
-  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 AND (mask n << m) = ((x >> m) AND mask n) << m"
-  for x :: \<open>'a::len word\<close>
-  apply (rule bit_word_eqI; transfer)
-  apply (auto simp add: bit_simps not_le ac_simps)
-  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 of_bool_nth:
-  "of_bool (bit x v) = (x >> v) AND 1"
-  for x :: \<open>'a::len word\<close>
-  by (simp add: bit_iff_odd_drop_bit shiftr_word_eq word_and_1)
-
-lemma shiftr_mask_eq:
-  "(x >> n) AND mask (size x - n) = x >> n" for x :: "'a :: len word"
-  apply (simp flip: take_bit_eq_mask)
-  apply transfer
-  apply (simp add: take_bit_drop_bit)
-  done
-
-lemma shiftr_mask_eq':
-  "m = (size x - n) \<Longrightarrow> (x >> n) AND mask m = x >> n" for x :: "'a :: len word"
-  by (simp add: shiftr_mask_eq)
-
-lemma and_eq_0_is_nth:
-  fixes x :: "'a :: len word"
-  shows "y = 1 << n \<Longrightarrow> ((x AND y) = 0) = (\<not> (bit x n))"
-  by (simp add: and_exp_eq_0_iff_not_bit)
-
-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 mask_shift_and_negate[simp]:"(w AND mask n << m) AND NOT (mask n << m) = 0"
-  for w :: \<open>'a::len word\<close>
-  by (clarsimp simp add: mask_eq_decr_exp Parity.bit_eq_iff bit_and_iff bit_not_iff shiftl_word_eq bit_push_bit_iff)
-
-(* 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 AND NOT (mask n << m) OR ((y AND mask n) << m)) AND NOT (mask n << m) = x AND NOT (mask n << m)"
-  for x :: \<open>'a::len word\<close>
-  by (induct n arbitrary: m) (auto simp: word_ao_dist)
-
-lemma bitfield_op_twice'':
-  "\<lbrakk>NOT a = b << c; \<exists>x. b = mask x\<rbrakk> \<Longrightarrow> (x AND a OR (y AND b << c)) AND a = x AND a"
-  for a b :: \<open>'a::len word\<close>
-  apply clarsimp
-  apply (cut_tac n=xa and m=c and x=x and y=y in bitfield_op_twice)
-  apply (clarsimp simp:mask_eq_decr_exp)
-  apply (drule not_switch)
-  apply clarsimp
-  done
-
-lemma shiftr1_unfold: "x div 2 = x >> 1"
-  by (simp add: drop_bit_eq_div shiftr_eq_drop_bit)
-
-lemma shiftr1_is_div_2: "(x::('a::len) word) >> 1 = x div 2"
-  by (simp add: drop_bit_eq_div shiftr_eq_drop_bit)
-
-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 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 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 shiftr1_irrelevant_lsb: "bit (x::('a::len) word) 0 \<or> x >> 1 = (x + 1) >> 1"
-  apply (cases \<open>LENGTH('a)\<close>; transfer)
-   apply (simp_all add: take_bit_drop_bit)
-  apply (simp add: drop_bit_take_bit drop_bit_Suc)
-  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> (bit (x::('a::len) word) 0) \<Longrightarrow> x >> 1 = (x + 1) >> 1"
-  by (metis shiftr1_irrelevant_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) OR (((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 (simp_all add: mask_eq_decr_exp flip: mult_2_right)
-  apply (metis add_diff_cancel_left' len_gt_0 mult_2_right zero_less_diff)
-  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) OR
-   (((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
+abbreviation sshiftr :: \<open>'a::len word \<Rightarrow> nat \<Rightarrow> 'a word\<close>  (infixl \<open>>>>\<close> 55)
+  where \<open>w >>> n \<equiv> signed_drop_bit n w\<close>
 
 end
diff --git a/thys/Word_Lib/Bits_Int.thy b/thys/Word_Lib/Bits_Int.thy
--- a/thys/Word_Lib/Bits_Int.thy
+++ b/thys/Word_Lib/Bits_Int.thy
@@ -1,1465 +1,1454 @@
 (*
  * Copyright Brian Huffman, PSU; Jeremy Dawson and Gerwin Klein, NICTA
  *
  * SPDX-License-Identifier: BSD-2-Clause
  *)
 
 section \<open>Bitwise Operations on integers\<close>
 
 theory Bits_Int
-  imports
-    "HOL-Library.Word"
-    Traditional_Infix_Syntax
+  imports "HOL-Library.Word"
 begin
 
 subsection \<open>Implicit bit representation of \<^typ>\<open>int\<close>\<close>
 
 lemma bin_last_def:
   "(odd :: int \<Rightarrow> bool) w \<longleftrightarrow> w mod 2 = 1"
   by (fact odd_iff_mod_2_eq_one)
 
 lemma bin_last_numeral_simps [simp]:
   "\<not> odd (0 :: int)"
   "odd (1 :: int)"
   "odd (- 1 :: int)"
   "odd (Numeral1 :: int)"
   "\<not> odd (numeral (Num.Bit0 w) :: int)"
   "odd (numeral (Num.Bit1 w) :: int)"
   "\<not> odd (- numeral (Num.Bit0 w) :: int)"
   "odd (- numeral (Num.Bit1 w) :: int)"
   by simp_all
 
 lemma bin_rest_numeral_simps [simp]:
   "(\<lambda>k::int. k div 2) 0 = 0"
   "(\<lambda>k::int. k div 2) 1 = 0"
   "(\<lambda>k::int. k div 2) (- 1) = - 1"
   "(\<lambda>k::int. k div 2) Numeral1 = 0"
   "(\<lambda>k::int. k div 2) (numeral (Num.Bit0 w)) = numeral w"
   "(\<lambda>k::int. k div 2) (numeral (Num.Bit1 w)) = numeral w"
   "(\<lambda>k::int. k div 2) (- numeral (Num.Bit0 w)) = - numeral w"
   "(\<lambda>k::int. k div 2) (- numeral (Num.Bit1 w)) = - numeral (w + Num.One)"
   by simp_all
 
 lemma bin_rl_eqI: "\<lbrakk>(\<lambda>k::int. k div 2) x = (\<lambda>k::int. k div 2) y; odd x = odd y\<rbrakk> \<Longrightarrow> x = y"
   by (auto elim: oddE)
 
 lemma [simp]:
   shows bin_rest_lt0: "(\<lambda>k::int. k div 2) i < 0 \<longleftrightarrow> i < 0"
   and  bin_rest_ge_0: "(\<lambda>k::int. k div 2) i \<ge> 0 \<longleftrightarrow> i \<ge> 0"
   by auto
 
 lemma bin_rest_gt_0 [simp]: "(\<lambda>k::int. k div 2) x > 0 \<longleftrightarrow> x > 1"
   by auto
 
 
 subsection \<open>Bit projection\<close>
 
 lemma bin_nth_eq_iff: "(bit :: int \<Rightarrow> nat \<Rightarrow> bool) x = (bit :: int \<Rightarrow> nat \<Rightarrow> bool) y \<longleftrightarrow> x = y"
   by (simp add: bit_eq_iff fun_eq_iff)
 
 lemma bin_eqI:
   "x = y" if "\<And>n. (bit :: int \<Rightarrow> nat \<Rightarrow> bool) x n \<longleftrightarrow> (bit :: int \<Rightarrow> nat \<Rightarrow> bool) y n"
   using that bin_nth_eq_iff [of x y] by (simp add: fun_eq_iff)
 
 lemma bin_eq_iff: "x = y \<longleftrightarrow> (\<forall>n. (bit :: int \<Rightarrow> nat \<Rightarrow> bool) x n = (bit :: int \<Rightarrow> nat \<Rightarrow> bool) y n)"
   by (fact bit_eq_iff)
 
 lemma bin_nth_zero [simp]: "\<not> (bit :: int \<Rightarrow> nat \<Rightarrow> bool) 0 n"
   by simp
 
 lemma bin_nth_1 [simp]: "(bit :: int \<Rightarrow> nat \<Rightarrow> bool) 1 n \<longleftrightarrow> n = 0"
   by (cases n) (simp_all add: bit_Suc)
 
 lemma bin_nth_minus1 [simp]: "(bit :: int \<Rightarrow> nat \<Rightarrow> bool) (- 1) n"
   by (induction n) (simp_all add: bit_Suc)
 
 lemma bin_nth_numeral: "(\<lambda>k::int. k div 2) x = y \<Longrightarrow> (bit :: int \<Rightarrow> nat \<Rightarrow> bool) x (numeral n) = (bit :: int \<Rightarrow> nat \<Rightarrow> bool) y (pred_numeral n)"
   by (simp add: numeral_eq_Suc bit_Suc)
 
 lemmas bin_nth_numeral_simps [simp] =
   bin_nth_numeral [OF bin_rest_numeral_simps(8)]
 
 lemmas bin_nth_simps =
   bit_0 bit_Suc bin_nth_zero bin_nth_minus1
   bin_nth_numeral_simps
 
 lemma nth_2p_bin: "(bit :: int \<Rightarrow> nat \<Rightarrow> bool) (2 ^ n) m = (m = n)" \<comment> \<open>for use when simplifying with \<open>bin_nth_Bit\<close>\<close>
   by (auto simp add: bit_exp_iff)
 
 lemma nth_rest_power_bin: "(bit :: int \<Rightarrow> nat \<Rightarrow> bool) (((\<lambda>k::int. k div 2) ^^ k) w) n = (bit :: int \<Rightarrow> nat \<Rightarrow> bool) w (n + k)"
   apply (induct k arbitrary: n)
    apply clarsimp
   apply clarsimp
   apply (simp only: bit_Suc [symmetric] add_Suc)
   done
 
 lemma bin_nth_numeral_unfold:
   "(bit :: int \<Rightarrow> nat \<Rightarrow> bool) (numeral (num.Bit0 x)) n \<longleftrightarrow> n > 0 \<and> (bit :: int \<Rightarrow> nat \<Rightarrow> bool) (numeral x) (n - 1)"
   "(bit :: int \<Rightarrow> nat \<Rightarrow> bool) (numeral (num.Bit1 x)) n \<longleftrightarrow> (n > 0 \<longrightarrow> (bit :: int \<Rightarrow> nat \<Rightarrow> bool) (numeral x) (n - 1))"
   by (cases n; simp)+
 
 
 subsection \<open>Truncating\<close>
 
 definition bin_sign :: "int \<Rightarrow> int"
   where "bin_sign k = (if k \<ge> 0 then 0 else - 1)"
 
 lemma bin_sign_simps [simp]:
   "bin_sign 0 = 0"
   "bin_sign 1 = 0"
   "bin_sign (- 1) = - 1"
   "bin_sign (numeral k) = 0"
   "bin_sign (- numeral k) = -1"
   by (simp_all add: bin_sign_def)
 
 lemma bin_sign_rest [simp]: "bin_sign ((\<lambda>k::int. k div 2) w) = bin_sign w"
   by (simp add: bin_sign_def)
 
 lemma bintrunc_mod2p: "(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n w = w mod 2 ^ n"
   by (fact take_bit_eq_mod)
 
 lemma sbintrunc_mod2p: "(signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n w = (w + 2 ^ n) mod 2 ^ Suc n - 2 ^ n"
   by (simp add: bintrunc_mod2p signed_take_bit_eq_take_bit_shift)
 
 lemma sbintrunc_eq_take_bit:
   \<open>(signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n k = take_bit (Suc n) (k + 2 ^ n) - 2 ^ n\<close>
   by (fact signed_take_bit_eq_take_bit_shift)
 
 lemma sign_bintr: "bin_sign ((take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n w) = 0"
   by (simp add: bin_sign_def)
 
 lemma bintrunc_n_0: "(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n 0 = 0"
   by (fact take_bit_of_0)
 
 lemma sbintrunc_n_0: "(signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n 0 = 0"
   by (fact signed_take_bit_of_0)
 
 lemma sbintrunc_n_minus1: "(signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n (- 1) = -1"
   by (fact signed_take_bit_of_minus_1)
 
 lemma bintrunc_Suc_numeral:
   "(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (Suc n) 1 = 1"
   "(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (Suc n) (- 1) = 1 + 2 * (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n (- 1)"
   "(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (Suc n) (numeral (Num.Bit0 w)) = 2 * (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n (numeral w)"
   "(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (Suc n) (numeral (Num.Bit1 w)) = 1 + 2 * (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n (numeral w)"
   "(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (Suc n) (- numeral (Num.Bit0 w)) = 2 * (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n (- numeral w)"
   "(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (Suc n) (- numeral (Num.Bit1 w)) = 1 + 2 * (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n (- numeral (w + Num.One))"
   by (simp_all add: take_bit_Suc)
 
 lemma sbintrunc_0_numeral [simp]:
   "(signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) 0 1 = -1"
   "(signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) 0 (numeral (Num.Bit0 w)) = 0"
   "(signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) 0 (numeral (Num.Bit1 w)) = -1"
   "(signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) 0 (- numeral (Num.Bit0 w)) = 0"
   "(signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) 0 (- numeral (Num.Bit1 w)) = -1"
   by simp_all
 
 lemma sbintrunc_Suc_numeral:
   "(signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (Suc n) 1 = 1"
   "(signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (Suc n) (numeral (Num.Bit0 w)) = 2 * (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n (numeral w)"
   "(signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (Suc n) (numeral (Num.Bit1 w)) = 1 + 2 * (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n (numeral w)"
   "(signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (Suc n) (- numeral (Num.Bit0 w)) = 2 * (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n (- numeral w)"
   "(signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (Suc n) (- numeral (Num.Bit1 w)) = 1 + 2 * (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n (- numeral (w + Num.One))"
   by (simp_all add: signed_take_bit_Suc)
 
 lemma bin_sign_lem: "(bin_sign ((signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n bin) = -1) = bit bin n"
   by (simp add: bin_sign_def)
 
 lemma nth_bintr: "(bit :: int \<Rightarrow> nat \<Rightarrow> bool) ((take_bit :: nat \<Rightarrow> int \<Rightarrow> int) m w) n \<longleftrightarrow> n < m \<and> (bit :: int \<Rightarrow> nat \<Rightarrow> bool) w n"
   by (fact bit_take_bit_iff)
 
 lemma nth_sbintr: "(bit :: int \<Rightarrow> nat \<Rightarrow> bool) ((signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) m w) n = (if n < m then (bit :: int \<Rightarrow> nat \<Rightarrow> bool) w n else (bit :: int \<Rightarrow> nat \<Rightarrow> bool) w m)"
   by (simp add: bit_signed_take_bit_iff min_def)
 
 lemma bin_nth_Bit0:
   "(bit :: int \<Rightarrow> nat \<Rightarrow> bool) (numeral (Num.Bit0 w)) n \<longleftrightarrow>
     (\<exists>m. n = Suc m \<and> (bit :: int \<Rightarrow> nat \<Rightarrow> bool) (numeral w) m)"
   using bit_double_iff [of \<open>numeral w :: int\<close> n]
   by (auto intro: exI [of _ \<open>n - 1\<close>])
 
 lemma bin_nth_Bit1:
   "(bit :: int \<Rightarrow> nat \<Rightarrow> bool) (numeral (Num.Bit1 w)) n \<longleftrightarrow>
     n = 0 \<or> (\<exists>m. n = Suc m \<and> (bit :: int \<Rightarrow> nat \<Rightarrow> bool) (numeral w) m)"
   using even_bit_succ_iff [of \<open>2 * numeral w :: int\<close> n]
     bit_double_iff [of \<open>numeral w :: int\<close> n]
   by auto
 
 lemma bintrunc_bintrunc_l: "n \<le> m \<Longrightarrow> (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) m ((take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n w) = (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n w"
-  by simp
+  by (simp add: min.absorb2)
 
 lemma sbintrunc_sbintrunc_l: "n \<le> m \<Longrightarrow> (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) m ((signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n w) = (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n w"
-  by (simp add: min_def)
+  by (simp add: min.absorb2)
 
 lemma bintrunc_bintrunc_ge: "n \<le> m \<Longrightarrow> (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n ((take_bit :: nat \<Rightarrow> int \<Rightarrow> int) m w) = (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n w"
   by (rule bin_eqI) (auto simp: nth_bintr)
 
 lemma bintrunc_bintrunc_min [simp]: "(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) m ((take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n w) = (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (min m n) w"
   by (rule take_bit_take_bit)
 
 lemma sbintrunc_sbintrunc_min [simp]: "(signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) m ((signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n w) = (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (min m n) w"
   by (rule signed_take_bit_signed_take_bit)
 
 lemmas sbintrunc_Suc_Pls =
   signed_take_bit_Suc [where a="0::int", simplified bin_last_numeral_simps bin_rest_numeral_simps]
 
 lemmas sbintrunc_Suc_Min =
   signed_take_bit_Suc [where a="-1::int", simplified bin_last_numeral_simps bin_rest_numeral_simps]
 
 lemmas sbintrunc_Sucs = sbintrunc_Suc_Pls sbintrunc_Suc_Min
   sbintrunc_Suc_numeral
 
 lemmas sbintrunc_Pls =
   signed_take_bit_0 [where a="0::int", simplified bin_last_numeral_simps bin_rest_numeral_simps]
 
 lemmas sbintrunc_Min =
   signed_take_bit_0 [where a="-1::int", simplified bin_last_numeral_simps bin_rest_numeral_simps]
 
 lemmas sbintrunc_0_simps =
   sbintrunc_Pls sbintrunc_Min
 
 lemmas sbintrunc_simps = sbintrunc_0_simps sbintrunc_Sucs
 
 lemma bintrunc_minus: "0 < n \<Longrightarrow> (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (Suc (n - 1)) w = (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n w"
   by auto
 
 lemma sbintrunc_minus: "0 < n \<Longrightarrow> (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (Suc (n - 1)) w = (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n w"
   by auto
 
 lemmas sbintrunc_minus_simps =
   sbintrunc_Sucs [THEN [2] sbintrunc_minus [symmetric, THEN trans]]
 
 lemma sbintrunc_BIT_I:
   \<open>0 < n \<Longrightarrow>
   (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (n - 1) 0 = y \<Longrightarrow>
   (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n 0 = 2 * y\<close>
   by simp
 
 lemma sbintrunc_Suc_Is:
   \<open>(signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n (- 1) = y \<Longrightarrow>
   (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (Suc n) (- 1) = 1 + 2 * y\<close>
   by auto
 
 lemma sbintrunc_Suc_lem: "(signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (Suc n) x = y \<Longrightarrow> m = Suc n \<Longrightarrow> (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) m x = y"
   by (rule ssubst)
 
 lemmas sbintrunc_Suc_Ialts =
   sbintrunc_Suc_Is [THEN sbintrunc_Suc_lem]
 
 lemma sbintrunc_bintrunc_lt: "m > n \<Longrightarrow> (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n ((take_bit :: nat \<Rightarrow> int \<Rightarrow> int) m w) = (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n w"
   by (rule bin_eqI) (auto simp: nth_sbintr nth_bintr)
 
 lemma bintrunc_sbintrunc_le: "m \<le> Suc n \<Longrightarrow> (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) m ((signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n w) = (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) m w"
   by (rule take_bit_signed_take_bit)
 
 lemmas bintrunc_sbintrunc [simp] = order_refl [THEN bintrunc_sbintrunc_le]
 lemmas sbintrunc_bintrunc [simp] = lessI [THEN sbintrunc_bintrunc_lt]
 lemmas bintrunc_bintrunc [simp] = order_refl [THEN bintrunc_bintrunc_l]
 lemmas sbintrunc_sbintrunc [simp] = order_refl [THEN sbintrunc_sbintrunc_l]
 
 lemma bintrunc_sbintrunc' [simp]: "0 < n \<Longrightarrow> (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n ((signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (n - 1) w) = (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n w"
   by (cases n) simp_all
 
 lemma sbintrunc_bintrunc' [simp]: "0 < n \<Longrightarrow> (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (n - 1) ((take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n w) = (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (n - 1) w"
   by (cases n) simp_all
 
 lemma bin_sbin_eq_iff: "(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (Suc n) x = (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (Suc n) y \<longleftrightarrow> (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n x = (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n y"
   apply (rule iffI)
    apply (rule box_equals [OF _ sbintrunc_bintrunc sbintrunc_bintrunc])
    apply simp
   apply (rule box_equals [OF _ bintrunc_sbintrunc bintrunc_sbintrunc])
   apply simp
   done
 
 lemma bin_sbin_eq_iff':
   "0 < n \<Longrightarrow> (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n x = (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n y \<longleftrightarrow> (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (n - 1) x = (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (n - 1) y"
   by (cases n) (simp_all add: bin_sbin_eq_iff)
 
 lemmas bintrunc_sbintruncS0 [simp] = bintrunc_sbintrunc' [unfolded One_nat_def]
 lemmas sbintrunc_bintruncS0 [simp] = sbintrunc_bintrunc' [unfolded One_nat_def]
 
 lemmas bintrunc_bintrunc_l' = le_add1 [THEN bintrunc_bintrunc_l]
 lemmas sbintrunc_sbintrunc_l' = le_add1 [THEN sbintrunc_sbintrunc_l]
 
 (* although bintrunc_minus_simps, if added to default simpset,
   tends to get applied where it's not wanted in developing the theories,
   we get a version for when the word length is given literally *)
 
 lemmas nat_non0_gr =
   trans [OF iszero_def [THEN Not_eq_iff [THEN iffD2]] refl]
 
 lemma bintrunc_numeral:
   "(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (numeral k) x = of_bool (odd x) + 2 * (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (pred_numeral k) (x div 2)"
   by (simp add: numeral_eq_Suc take_bit_Suc mod_2_eq_odd)
 
 lemma sbintrunc_numeral:
   "(signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (numeral k) x = of_bool (odd x) + 2 * (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (pred_numeral k) (x div 2)"
   by (simp add: numeral_eq_Suc signed_take_bit_Suc mod2_eq_if)
 
 lemma bintrunc_numeral_simps [simp]:
   "(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (numeral k) (numeral (Num.Bit0 w)) =
     2 * (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (pred_numeral k) (numeral w)"
   "(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (numeral k) (numeral (Num.Bit1 w)) =
     1 + 2 * (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (pred_numeral k) (numeral w)"
   "(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (numeral k) (- numeral (Num.Bit0 w)) =
     2 * (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (pred_numeral k) (- numeral w)"
   "(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (numeral k) (- numeral (Num.Bit1 w)) =
     1 + 2 * (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (pred_numeral k) (- numeral (w + Num.One))"
   "(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (numeral k) 1 = 1"
   by (simp_all add: bintrunc_numeral)
 
 lemma sbintrunc_numeral_simps [simp]:
   "(signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (numeral k) (numeral (Num.Bit0 w)) =
     2 * (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (pred_numeral k) (numeral w)"
   "(signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (numeral k) (numeral (Num.Bit1 w)) =
     1 + 2 * (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (pred_numeral k) (numeral w)"
   "(signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (numeral k) (- numeral (Num.Bit0 w)) =
     2 * (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (pred_numeral k) (- numeral w)"
   "(signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (numeral k) (- numeral (Num.Bit1 w)) =
     1 + 2 * (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (pred_numeral k) (- numeral (w + Num.One))"
   "(signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (numeral k) 1 = 1"
   by (simp_all add: sbintrunc_numeral)
 
 lemma no_bintr_alt1: "(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n = (\<lambda>w. w mod 2 ^ n :: int)"
   by (rule ext) (rule bintrunc_mod2p)
 
 lemma range_bintrunc: "range ((take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n) = {i. 0 \<le> i \<and> i < 2 ^ n}"
   by (auto simp add: take_bit_eq_mod image_iff) (metis mod_pos_pos_trivial)
 
 lemma no_sbintr_alt2: "(signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n = (\<lambda>w. (w + 2 ^ n) mod 2 ^ Suc n - 2 ^ n :: int)"
   by (rule ext) (simp add : sbintrunc_mod2p)
 
 lemma range_sbintrunc: "range ((signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n) = {i. - (2 ^ n) \<le> i \<and> i < 2 ^ n}"
 proof -
   have \<open>surj (\<lambda>k::int. k + 2 ^ n)\<close>
     by (rule surjI [of _ \<open>(\<lambda>k. k - 2 ^ n)\<close>]) simp
   moreover have \<open>(signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n = ((\<lambda>k. k - 2 ^ n) \<circ> take_bit (Suc n) \<circ> (\<lambda>k. k + 2 ^ n))\<close>
     by (simp add: sbintrunc_eq_take_bit fun_eq_iff)
   ultimately show ?thesis
     apply (simp only: fun.set_map range_bintrunc)
     apply (auto simp add: image_iff)
     apply presburger
     done
 qed
 
 lemma sbintrunc_inc:
   \<open>k + 2 ^ Suc n \<le> (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n k\<close> if \<open>k < - (2 ^ n)\<close>
   using that by (fact signed_take_bit_int_greater_eq)
 
 lemma sbintrunc_dec:
   \<open>(signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n k \<le> k - 2 ^ (Suc n)\<close> if \<open>k \<ge> 2 ^ n\<close>
   using that by (fact signed_take_bit_int_less_eq)
 
 lemma bintr_ge0: "0 \<le> (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n w"
   by (simp add: bintrunc_mod2p)
 
 lemma bintr_lt2p: "(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n w < 2 ^ n"
   by (simp add: bintrunc_mod2p)
 
 lemma bintr_Min: "(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n (- 1) = 2 ^ n - 1"
   by (simp add: stable_imp_take_bit_eq)
 
 lemma sbintr_ge: "- (2 ^ n) \<le> (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n w"
   by (simp add: sbintrunc_mod2p)
 
 lemma sbintr_lt: "(signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n w < 2 ^ n"
   by (simp add: sbintrunc_mod2p)
 
 lemma sign_Pls_ge_0: "bin_sign bin = 0 \<longleftrightarrow> bin \<ge> 0"
   for bin :: int
   by (simp add: bin_sign_def)
 
 lemma sign_Min_lt_0: "bin_sign bin = -1 \<longleftrightarrow> bin < 0"
   for bin :: int
   by (simp add: bin_sign_def)
 
 lemma bin_rest_trunc: "(\<lambda>k::int. k div 2) ((take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n bin) = (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (n - 1) ((\<lambda>k::int. k div 2) bin)"
   by (simp add: take_bit_rec [of n bin])
 
 lemma bin_rest_power_trunc:
   "((\<lambda>k::int. k div 2) ^^ k) ((take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n bin) = (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (n - k) (((\<lambda>k::int. k div 2) ^^ k) bin)"
   by (induct k) (auto simp: bin_rest_trunc)
 
 lemma bin_rest_trunc_i: "(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n ((\<lambda>k::int. k div 2) bin) = (\<lambda>k::int. k div 2) ((take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (Suc n) bin)"
   by (auto simp add: take_bit_Suc)
 
 lemma bin_rest_strunc: "(\<lambda>k::int. k div 2) ((signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (Suc n) bin) = (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n ((\<lambda>k::int. k div 2) bin)"
   by (simp add: signed_take_bit_Suc)
 
 lemma bintrunc_rest [simp]: "(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n ((\<lambda>k::int. k div 2) ((take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n bin)) = (\<lambda>k::int. k div 2) ((take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n bin)"
   by (induct n arbitrary: bin) (simp_all add: take_bit_Suc)
 
 lemma sbintrunc_rest [simp]: "(signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n ((\<lambda>k::int. k div 2) ((signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n bin)) = (\<lambda>k::int. k div 2) ((signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n bin)"
   by (induct n arbitrary: bin) (simp_all add: signed_take_bit_Suc mod2_eq_if)
 
 lemma bintrunc_rest': "(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n \<circ> (\<lambda>k::int. k div 2) \<circ> (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n = (\<lambda>k::int. k div 2) \<circ> (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n"
   by (rule ext) auto
 
 lemma sbintrunc_rest': "(signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n \<circ> (\<lambda>k::int. k div 2) \<circ> (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n = (\<lambda>k::int. k div 2) \<circ> (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n"
   by (rule ext) auto
 
 lemma rco_lem: "f \<circ> g \<circ> f = g \<circ> f \<Longrightarrow> f \<circ> (g \<circ> f) ^^ n = g ^^ n \<circ> f"
   apply (rule ext)
   apply (induct_tac n)
    apply (simp_all (no_asm))
   apply (drule fun_cong)
   apply (unfold o_def)
   apply (erule trans)
   apply simp
   done
 
 lemmas rco_bintr = bintrunc_rest'
   [THEN rco_lem [THEN fun_cong], unfolded o_def]
 lemmas rco_sbintr = sbintrunc_rest'
   [THEN rco_lem [THEN fun_cong], unfolded o_def]
 
 
 subsection \<open>Splitting and concatenation\<close>
 
 definition bin_split :: \<open>nat \<Rightarrow> int \<Rightarrow> int \<times> int\<close>
   where [simp]: \<open>bin_split n k = (drop_bit n k, take_bit n k)\<close>
 
 lemma [code]:
   "bin_split (Suc n) w = (let (w1, w2) = bin_split n (w div 2) in (w1, of_bool (odd w) + 2 * w2))"
   "bin_split 0 w = (w, 0)"
   by (simp_all add: drop_bit_Suc take_bit_Suc mod_2_eq_odd)
 
 lemma bin_cat_eq_push_bit_add_take_bit:
   \<open>concat_bit n l k = push_bit n k + take_bit n l\<close>
   by (simp add: concat_bit_eq)
 
 lemma bin_sign_cat: "bin_sign ((\<lambda>k n l. concat_bit n l k) x n y) = bin_sign x"
 proof -
   have \<open>0 \<le> x\<close> if \<open>0 \<le> x * 2 ^ n + y mod 2 ^ n\<close>
   proof -
     have \<open>y mod 2 ^ n < 2 ^ n\<close>
       using pos_mod_bound [of \<open>2 ^ n\<close> y] by simp
     then have \<open>\<not> y mod 2 ^ n \<ge> 2 ^ n\<close>
       by (simp add: less_le)
     with that have \<open>x \<noteq> - 1\<close>
       by auto
     have *: \<open>- 1 \<le> (- (y mod 2 ^ n)) div 2 ^ n\<close>
       by (simp add: zdiv_zminus1_eq_if)
     from that have \<open>- (y mod 2 ^ n) \<le> x * 2 ^ n\<close>
       by simp
     then have \<open>(- (y mod 2 ^ n)) div 2 ^ n \<le> (x * 2 ^ n) div 2 ^ n\<close>
       using zdiv_mono1 zero_less_numeral zero_less_power by blast
     with * have \<open>- 1 \<le> x * 2 ^ n div 2 ^ n\<close> by simp
     with \<open>x \<noteq> - 1\<close> show ?thesis
       by simp
   qed
   then show ?thesis
     by (simp add: bin_sign_def not_le not_less bin_cat_eq_push_bit_add_take_bit push_bit_eq_mult take_bit_eq_mod)
 qed
 
 lemma bin_cat_assoc: "(\<lambda>k n l. concat_bit n l k) ((\<lambda>k n l. concat_bit n l k) x m y) n z = (\<lambda>k n l. concat_bit n l k) x (m + n) ((\<lambda>k n l. concat_bit n l k) y n z)"
   by (fact concat_bit_assoc)
 
 lemma bin_cat_assoc_sym: "(\<lambda>k n l. concat_bit n l k) x m ((\<lambda>k n l. concat_bit n l k) y n z) = (\<lambda>k n l. concat_bit n l k) ((\<lambda>k n l. concat_bit n l k) x (m - n) y) (min m n) z"
   by (fact concat_bit_assoc_sym)
 
 definition bin_rcat :: \<open>nat \<Rightarrow> int list \<Rightarrow> int\<close>
   where \<open>bin_rcat n = horner_sum (take_bit n) (2 ^ n) \<circ> rev\<close>
 
 lemma bin_rcat_eq_foldl:
   \<open>bin_rcat n = foldl (\<lambda>u v. (\<lambda>k n l. concat_bit n l k) u n v) 0\<close>
 proof
   fix ks :: \<open>int list\<close>
   show \<open>bin_rcat n ks = foldl (\<lambda>u v. (\<lambda>k n l. concat_bit n l k) u n v) 0 ks\<close>
     by (induction ks rule: rev_induct)
       (simp_all add: bin_rcat_def concat_bit_eq push_bit_eq_mult)
 qed
 
 fun bin_rsplit_aux :: "nat \<Rightarrow> nat \<Rightarrow> int \<Rightarrow> int list \<Rightarrow> int list"
   where "bin_rsplit_aux n m c bs =
     (if m = 0 \<or> n = 0 then bs
      else
       let (a, b) = bin_split n c
       in bin_rsplit_aux n (m - n) a (b # bs))"
 
 definition bin_rsplit :: "nat \<Rightarrow> nat \<times> int \<Rightarrow> int list"
   where "bin_rsplit n w = bin_rsplit_aux n (fst w) (snd w) []"
 
 fun bin_rsplitl_aux :: "nat \<Rightarrow> nat \<Rightarrow> int \<Rightarrow> int list \<Rightarrow> int list"
   where "bin_rsplitl_aux n m c bs =
     (if m = 0 \<or> n = 0 then bs
      else
       let (a, b) = bin_split (min m n) c
       in bin_rsplitl_aux n (m - n) a (b # bs))"
 
 definition bin_rsplitl :: "nat \<Rightarrow> nat \<times> int \<Rightarrow> int list"
   where "bin_rsplitl n w = bin_rsplitl_aux n (fst w) (snd w) []"
 
 declare bin_rsplit_aux.simps [simp del]
 declare bin_rsplitl_aux.simps [simp del]
 
 lemma bin_nth_cat:
   "(bit :: int \<Rightarrow> nat \<Rightarrow> bool) ((\<lambda>k n l. concat_bit n l k) x k y) n =
     (if n < k then (bit :: int \<Rightarrow> nat \<Rightarrow> bool) y n else (bit :: int \<Rightarrow> nat \<Rightarrow> bool) x (n - k))"
   by (simp add: bit_concat_bit_iff)
 
 lemma bin_nth_drop_bit_iff:
   \<open>(bit :: int \<Rightarrow> nat \<Rightarrow> bool) (drop_bit n c) k \<longleftrightarrow> (bit :: int \<Rightarrow> nat \<Rightarrow> bool) c (n + k)\<close>
   by (simp add: bit_drop_bit_eq)
 
 lemma bin_nth_take_bit_iff:
   \<open>(bit :: int \<Rightarrow> nat \<Rightarrow> bool) (take_bit n c) k \<longleftrightarrow> k < n \<and> (bit :: int \<Rightarrow> nat \<Rightarrow> bool) c k\<close>
   by (fact bit_take_bit_iff)
 
 lemma bin_nth_split:
   "bin_split n c = (a, b) \<Longrightarrow>
     (\<forall>k. (bit :: int \<Rightarrow> nat \<Rightarrow> bool) a k = (bit :: int \<Rightarrow> nat \<Rightarrow> bool) c (n + k)) \<and>
     (\<forall>k. (bit :: int \<Rightarrow> nat \<Rightarrow> bool) b k = (k < n \<and> (bit :: int \<Rightarrow> nat \<Rightarrow> bool) c k))"
   by (auto simp add: bin_nth_drop_bit_iff bin_nth_take_bit_iff)
 
 lemma bin_cat_zero [simp]: "(\<lambda>k n l. concat_bit n l k) 0 n w = (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n w"
   by (simp add: bin_cat_eq_push_bit_add_take_bit)
 
 lemma bintr_cat1: "(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (k + n) ((\<lambda>k n l. concat_bit n l k) a n b) = (\<lambda>k n l. concat_bit n l k) ((take_bit :: nat \<Rightarrow> int \<Rightarrow> int) k a) n b"
   by (metis bin_cat_assoc bin_cat_zero)
 
 lemma bintr_cat: "(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) m ((\<lambda>k n l. concat_bit n l k) a n b) =
     (\<lambda>k n l. concat_bit n l k) ((take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (m - n) a) n ((take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (min m n) b)"
   by (rule bin_eqI) (auto simp: bin_nth_cat nth_bintr)
 
 lemma bintr_cat_same [simp]: "(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n ((\<lambda>k n l. concat_bit n l k) a n b) = (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n b"
   by (auto simp add : bintr_cat)
 
 lemma cat_bintr [simp]: "(\<lambda>k n l. concat_bit n l k) a n ((take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n b) = (\<lambda>k n l. concat_bit n l k) a n b"
   by (simp add: bin_cat_eq_push_bit_add_take_bit)
 
 lemma split_bintrunc: "bin_split n c = (a, b) \<Longrightarrow> b = (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n c"
   by simp
 
 lemma bin_cat_split: "bin_split n w = (u, v) \<Longrightarrow> w = (\<lambda>k n l. concat_bit n l k) u n v"
   by (auto simp add: bin_cat_eq_push_bit_add_take_bit bits_ident)
 
 lemma drop_bit_bin_cat_eq:
   \<open>drop_bit n ((\<lambda>k n l. concat_bit n l k) v n w) = v\<close>
   by (rule bit_eqI) (simp add: bit_drop_bit_eq bit_concat_bit_iff)
 
 lemma take_bit_bin_cat_eq:
   \<open>take_bit n ((\<lambda>k n l. concat_bit n l k) v n w) = take_bit n w\<close>
   by (rule bit_eqI) (simp add: bit_concat_bit_iff)
 
 lemma bin_split_cat: "bin_split n ((\<lambda>k n l. concat_bit n l k) v n w) = (v, (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n w)"
   by (simp add: drop_bit_bin_cat_eq take_bit_bin_cat_eq)
 
 lemma bin_split_zero [simp]: "bin_split n 0 = (0, 0)"
   by simp
 
 lemma bin_split_minus1 [simp]:
   "bin_split n (- 1) = (- 1, (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n (- 1))"
   by simp
 
 lemma bin_split_trunc:
   "bin_split (min m n) c = (a, b) \<Longrightarrow>
     bin_split n ((take_bit :: nat \<Rightarrow> int \<Rightarrow> int) m c) = ((take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (m - n) a, b)"
   apply (induct n arbitrary: m b c, clarsimp)
   apply (simp add: bin_rest_trunc Let_def split: prod.split_asm)
   apply (case_tac m)
    apply (auto simp: Let_def drop_bit_Suc take_bit_Suc mod_2_eq_odd split: prod.split_asm)
   done
 
 lemma bin_split_trunc1:
   "bin_split n c = (a, b) \<Longrightarrow>
     bin_split n ((take_bit :: nat \<Rightarrow> int \<Rightarrow> int) m c) = ((take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (m - n) a, (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) m b)"
   apply (induct n arbitrary: m b c, clarsimp)
   apply (simp add: bin_rest_trunc Let_def split: prod.split_asm)
   apply (case_tac m)
    apply (auto simp: Let_def drop_bit_Suc take_bit_Suc mod_2_eq_odd split: prod.split_asm)
   done
 
 lemma bin_cat_num: "(\<lambda>k n l. concat_bit n l k) a n b = a * 2 ^ n + (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n b"
   by (simp add: bin_cat_eq_push_bit_add_take_bit push_bit_eq_mult)
 
 lemma bin_split_num: "bin_split n b = (b div 2 ^ n, b mod 2 ^ n)"
   by (simp add: drop_bit_eq_div take_bit_eq_mod)
 
 lemmas bin_rsplit_aux_simps = bin_rsplit_aux.simps bin_rsplitl_aux.simps
 lemmas rsplit_aux_simps = bin_rsplit_aux_simps
 
 lemmas th_if_simp1 = if_split [where P = "(=) l", THEN iffD1, THEN conjunct1, THEN mp] for l
 lemmas th_if_simp2 = if_split [where P = "(=) l", THEN iffD1, THEN conjunct2, THEN mp] for l
 
 lemmas rsplit_aux_simp1s = rsplit_aux_simps [THEN th_if_simp1]
 
 lemmas rsplit_aux_simp2ls = rsplit_aux_simps [THEN th_if_simp2]
 \<comment> \<open>these safe to \<open>[simp add]\<close> as require calculating \<open>m - n\<close>\<close>
 lemmas bin_rsplit_aux_simp2s [simp] = rsplit_aux_simp2ls [unfolded Let_def]
 lemmas rbscl = bin_rsplit_aux_simp2s (2)
 
 lemmas rsplit_aux_0_simps [simp] =
   rsplit_aux_simp1s [OF disjI1] rsplit_aux_simp1s [OF disjI2]
 
 lemma bin_rsplit_aux_append: "bin_rsplit_aux n m c (bs @ cs) = bin_rsplit_aux n m c bs @ cs"
   apply (induct n m c bs rule: bin_rsplit_aux.induct)
   apply (subst bin_rsplit_aux.simps)
   apply (subst bin_rsplit_aux.simps)
   apply (clarsimp split: prod.split)
   done
 
 lemma bin_rsplitl_aux_append: "bin_rsplitl_aux n m c (bs @ cs) = bin_rsplitl_aux n m c bs @ cs"
   apply (induct n m c bs rule: bin_rsplitl_aux.induct)
   apply (subst bin_rsplitl_aux.simps)
   apply (subst bin_rsplitl_aux.simps)
   apply (clarsimp split: prod.split)
   done
 
 lemmas rsplit_aux_apps [where bs = "[]"] =
   bin_rsplit_aux_append bin_rsplitl_aux_append
 
 lemmas rsplit_def_auxs = bin_rsplit_def bin_rsplitl_def
 
 lemmas rsplit_aux_alts = rsplit_aux_apps
   [unfolded append_Nil rsplit_def_auxs [symmetric]]
 
 lemma bin_split_minus: "0 < n \<Longrightarrow> bin_split (Suc (n - 1)) w = bin_split n w"
   by auto
 
 lemma bin_split_pred_simp [simp]:
   "(0::nat) < numeral bin \<Longrightarrow>
     bin_split (numeral bin) w =
       (let (w1, w2) = bin_split (numeral bin - 1) ((\<lambda>k::int. k div 2) w)
        in (w1, of_bool (odd w) + 2 * w2))"
   by (simp add: take_bit_rec drop_bit_rec mod_2_eq_odd)
 
 lemma bin_rsplit_aux_simp_alt:
   "bin_rsplit_aux n m c bs =
     (if m = 0 \<or> n = 0 then bs
      else let (a, b) = bin_split n c in bin_rsplit n (m - n, a) @ b # bs)"
   apply (simp add: bin_rsplit_aux.simps [of n m c bs])
   apply (subst rsplit_aux_alts)
   apply (simp add: bin_rsplit_def)
   done
 
 lemmas bin_rsplit_simp_alt =
   trans [OF bin_rsplit_def bin_rsplit_aux_simp_alt]
 
 lemmas bthrs = bin_rsplit_simp_alt [THEN [2] trans]
 
 lemma bin_rsplit_size_sign' [rule_format]:
   "n > 0 \<Longrightarrow> rev sw = bin_rsplit n (nw, w) \<Longrightarrow> \<forall>v\<in>set sw. (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n v = v"
   apply (induct sw arbitrary: nw w)
    apply clarsimp
   apply clarsimp
   apply (drule bthrs)
   apply (simp (no_asm_use) add: Let_def split: prod.split_asm if_split_asm)
   apply clarify
   apply simp
   done
 
 lemmas bin_rsplit_size_sign = bin_rsplit_size_sign' [OF asm_rl
   rev_rev_ident [THEN trans] set_rev [THEN equalityD2 [THEN subsetD]]]
 
 lemma bin_nth_rsplit [rule_format] :
   "n > 0 \<Longrightarrow> m < n \<Longrightarrow>
     \<forall>w k nw.
       rev sw = bin_rsplit n (nw, w) \<longrightarrow>
       k < size sw \<longrightarrow> (bit :: int \<Rightarrow> nat \<Rightarrow> bool) (sw ! k) m = (bit :: int \<Rightarrow> nat \<Rightarrow> bool) w (k * n + m)"
   apply (induct sw)
    apply clarsimp
   apply clarsimp
   apply (drule bthrs)
   apply (simp (no_asm_use) add: Let_def split: prod.split_asm if_split_asm)
   apply (erule allE, erule impE, erule exI)
   apply (case_tac k)
    apply clarsimp
    prefer 2
    apply clarsimp
    apply (erule allE)
    apply (erule (1) impE)
    apply (simp add: bit_drop_bit_eq ac_simps)
   apply (simp add: bit_take_bit_iff ac_simps)
   done
 
 lemma bin_rsplit_all: "0 < nw \<Longrightarrow> nw \<le> n \<Longrightarrow> bin_rsplit n (nw, w) = [(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n w]"
   by (auto simp: bin_rsplit_def rsplit_aux_simp2ls split: prod.split dest!: split_bintrunc)
 
 lemma bin_rsplit_l [rule_format]:
   "\<forall>bin. bin_rsplitl n (m, bin) = bin_rsplit n (m, (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) m bin)"
   apply (rule_tac a = "m" in wf_less_than [THEN wf_induct])
   apply (simp (no_asm) add: bin_rsplitl_def bin_rsplit_def)
   apply (rule allI)
   apply (subst bin_rsplitl_aux.simps)
   apply (subst bin_rsplit_aux.simps)
   apply (clarsimp simp: Let_def split: prod.split)
   apply (simp add: ac_simps)
   apply (subst rsplit_aux_alts(1))
   apply (subst rsplit_aux_alts(2))
   apply clarsimp
   unfolding bin_rsplit_def bin_rsplitl_def
   apply (simp add: drop_bit_take_bit)
   apply (case_tac \<open>x < n\<close>)
   apply (simp_all add: not_less min_def)
   done
 
 lemma bin_rsplit_rcat [rule_format]:
   "n > 0 \<longrightarrow> bin_rsplit n (n * size ws, bin_rcat n ws) = map ((take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n) ws"
   apply (unfold bin_rsplit_def bin_rcat_eq_foldl)
   apply (rule_tac xs = ws in rev_induct)
    apply clarsimp
   apply clarsimp
   apply (subst rsplit_aux_alts)
   apply (simp add: drop_bit_bin_cat_eq take_bit_bin_cat_eq)
   done
 
 lemma bin_rsplit_aux_len_le [rule_format] :
   "\<forall>ws m. n \<noteq> 0 \<longrightarrow> ws = bin_rsplit_aux n nw w bs \<longrightarrow>
     length ws \<le> m \<longleftrightarrow> nw + length bs * n \<le> m * n"
 proof -
   have *: R
     if d: "i \<le> j \<or> m < j'"
     and R1: "i * k \<le> j * k \<Longrightarrow> R"
     and R2: "Suc m * k' \<le> j' * k' \<Longrightarrow> R"
     for i j j' k k' m :: nat and R
     using d
     apply safe
     apply (rule R1, erule mult_le_mono1)
     apply (rule R2, erule Suc_le_eq [THEN iffD2 [THEN mult_le_mono1]])
     done
   have **: "0 < sc \<Longrightarrow> sc - n + (n + lb * n) \<le> m * n \<longleftrightarrow> sc + lb * n \<le> m * n"
     for sc m n lb :: nat
     apply safe
      apply arith
     apply (case_tac "sc \<ge> n")
      apply arith
     apply (insert linorder_le_less_linear [of m lb])
     apply (erule_tac k=n and k'=n in *)
      apply arith
     apply simp
     done
   show ?thesis
     apply (induct n nw w bs rule: bin_rsplit_aux.induct)
     apply (subst bin_rsplit_aux.simps)
     apply (simp add: ** Let_def split: prod.split)
     done
 qed
 
 lemma bin_rsplit_len_le: "n \<noteq> 0 \<longrightarrow> ws = bin_rsplit n (nw, w) \<longrightarrow> length ws \<le> m \<longleftrightarrow> nw \<le> m * n"
   by (auto simp: bin_rsplit_def bin_rsplit_aux_len_le)
 
 lemma bin_rsplit_aux_len:
   "n \<noteq> 0 \<Longrightarrow> length (bin_rsplit_aux n nw w cs) = (nw + n - 1) div n + length cs"
   apply (induct n nw w cs rule: bin_rsplit_aux.induct)
   apply (subst bin_rsplit_aux.simps)
   apply (clarsimp simp: Let_def split: prod.split)
   apply (erule thin_rl)
   apply (case_tac m)
    apply simp
   apply (case_tac "m \<le> n")
    apply (auto simp add: div_add_self2)
   done
 
 lemma bin_rsplit_len: "n \<noteq> 0 \<Longrightarrow> length (bin_rsplit n (nw, w)) = (nw + n - 1) div n"
   by (auto simp: bin_rsplit_def bin_rsplit_aux_len)
 
 lemma bin_rsplit_aux_len_indep:
   "n \<noteq> 0 \<Longrightarrow> length bs = length cs \<Longrightarrow>
     length (bin_rsplit_aux n nw v bs) =
     length (bin_rsplit_aux n nw w cs)"
 proof (induct n nw w cs arbitrary: v bs rule: bin_rsplit_aux.induct)
   case (1 n m w cs v bs)
   show ?case
   proof (cases "m = 0")
     case True
     with \<open>length bs = length cs\<close> show ?thesis by simp
   next
     case False
     from "1.hyps" [of \<open>bin_split n w\<close> \<open>drop_bit n w\<close> \<open>take_bit n w\<close>] \<open>m \<noteq> 0\<close> \<open>n \<noteq> 0\<close>
     have hyp: "\<And>v bs. length bs = Suc (length cs) \<Longrightarrow>
       length (bin_rsplit_aux n (m - n) v bs) =
       length (bin_rsplit_aux n (m - n) (drop_bit n w) (take_bit n w # cs))"
       using bin_rsplit_aux_len by fastforce
     from \<open>length bs = length cs\<close> \<open>n \<noteq> 0\<close> show ?thesis
       by (auto simp add: bin_rsplit_aux_simp_alt Let_def bin_rsplit_len split: prod.split)
   qed
 qed
 
 lemma bin_rsplit_len_indep:
   "n \<noteq> 0 \<Longrightarrow> length (bin_rsplit n (nw, v)) = length (bin_rsplit n (nw, w))"
   apply (unfold bin_rsplit_def)
   apply (simp (no_asm))
   apply (erule bin_rsplit_aux_len_indep)
   apply (rule refl)
   done
 
 
 subsection \<open>Logical operations\<close>
 
 primrec bin_sc :: "nat \<Rightarrow> bool \<Rightarrow> int \<Rightarrow> int"
   where
     Z: "bin_sc 0 b w = of_bool b + 2 * (\<lambda>k::int. k div 2) w"
   | Suc: "bin_sc (Suc n) b w = of_bool (odd w) + 2 * bin_sc n b (w div 2)"
 
-lemma bin_nth_sc [simp]: "bit (bin_sc n b w) n \<longleftrightarrow> b"
+lemma bin_nth_sc [bit_simps]: "bit (bin_sc n b w) n \<longleftrightarrow> b"
   by (induction n arbitrary: w) (simp_all add: bit_Suc)
 
 lemma bin_sc_sc_same [simp]: "bin_sc n c (bin_sc n b w) = bin_sc n c w"
   by (induction n arbitrary: w) (simp_all add: bit_Suc)
 
 lemma bin_sc_sc_diff: "m \<noteq> n \<Longrightarrow> bin_sc m c (bin_sc n b w) = bin_sc n b (bin_sc m c w)"
   apply (induct n arbitrary: w m)
    apply (case_tac [!] m)
      apply auto
   done
 
 lemma bin_nth_sc_gen: "(bit :: int \<Rightarrow> nat \<Rightarrow> bool) (bin_sc n b w) m = (if m = n then b else (bit :: int \<Rightarrow> nat \<Rightarrow> bool) w m)"
   apply (induct n arbitrary: w m)
    apply (case_tac m; simp add: bit_Suc)
   apply (case_tac m; simp add: bit_Suc)
   done
 
 lemma bin_sc_eq:
   \<open>bin_sc n False = unset_bit n\<close>
   \<open>bin_sc n True = Bit_Operations.set_bit n\<close>
   by (simp_all add: fun_eq_iff bit_eq_iff)
     (simp_all add: bin_nth_sc_gen bit_set_bit_iff bit_unset_bit_iff)
 
 lemma bin_sc_nth [simp]: "bin_sc n ((bit :: int \<Rightarrow> nat \<Rightarrow> bool) w n) w = w"
   by (rule bit_eqI) (simp add: bin_nth_sc_gen)
 
 lemma bin_sign_sc [simp]: "bin_sign (bin_sc n b w) = bin_sign w"
 proof (induction n arbitrary: w)
   case 0
   then show ?case
     by (auto simp add: bin_sign_def) (use bin_rest_ge_0 in fastforce)
 next
   case (Suc n)
   from Suc [of \<open>w div 2\<close>]
   show ?case by (auto simp add: bin_sign_def split: if_splits)
 qed
 
 lemma bin_sc_bintr [simp]:
   "(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) m (bin_sc n x ((take_bit :: nat \<Rightarrow> int \<Rightarrow> int) m w)) = (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) m (bin_sc n x w)"
   apply (cases x)
    apply (simp_all add: bin_sc_eq bit_eq_iff)
    apply (auto simp add: bit_take_bit_iff bit_set_bit_iff bit_unset_bit_iff)
   done
 
 lemma bin_clr_le: "bin_sc n False w \<le> w"
   by (simp add: bin_sc_eq unset_bit_less_eq)
 
 lemma bin_set_ge: "bin_sc n True w \<ge> w"
   by (simp add: bin_sc_eq set_bit_greater_eq)
 
 lemma bintr_bin_clr_le: "(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n (bin_sc m False w) \<le> (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n w"
   by (simp add: bin_sc_eq take_bit_unset_bit_eq unset_bit_less_eq)
 
 lemma bintr_bin_set_ge: "(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n (bin_sc m True w) \<ge> (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n w"
   by (simp add: bin_sc_eq take_bit_set_bit_eq set_bit_greater_eq)
 
 lemma bin_sc_FP [simp]: "bin_sc n False 0 = 0"
   by (induct n) auto
 
 lemma bin_sc_TM [simp]: "bin_sc n True (- 1) = - 1"
   by (induct n) auto
 
 lemmas bin_sc_simps = bin_sc.Z bin_sc.Suc bin_sc_TM bin_sc_FP
 
 lemma bin_sc_minus: "0 < n \<Longrightarrow> bin_sc (Suc (n - 1)) b w = bin_sc n b w"
   by auto
 
 lemmas bin_sc_Suc_minus =
   trans [OF bin_sc_minus [symmetric] bin_sc.Suc]
 
 lemma bin_sc_numeral [simp]:
   "bin_sc (numeral k) b w =
     of_bool (odd w) + 2 * bin_sc (pred_numeral k) b (w div 2)"
   by (simp add: numeral_eq_Suc)
 
 lemmas bin_sc_minus_simps =
   bin_sc_simps (2,3,4) [THEN [2] trans, OF bin_sc_minus [THEN sym]]
 
-instance int :: semiring_bit_syntax ..
-
 lemma shiftl_int_def:
-  "shiftl x n = x * 2 ^ n" for x :: int
-  by (simp add: push_bit_int_def shiftl_eq_push_bit)
+  "push_bit n x = x * 2 ^ n" for x :: int
+  by (fact push_bit_eq_mult)
 
 lemma shiftr_int_def:
-  "shiftr x n = x div 2 ^ n" for x :: int
-  by (simp add: drop_bit_int_def shiftr_eq_drop_bit)
+  "drop_bit n x = x div 2 ^ n" for x :: int
+  by (fact drop_bit_eq_div)
 
 
 subsubsection \<open>Basic simplification rules\<close>
 
 lemmas int_not_def = not_int_def
 
 lemma int_not_simps [simp]:
   "NOT (0::int) = -1"
   "NOT (1::int) = -2"
   "NOT (- 1::int) = 0"
   "NOT (numeral w::int) = - numeral (w + Num.One)"
   "NOT (- numeral (Num.Bit0 w)::int) = numeral (Num.BitM w)"
   "NOT (- numeral (Num.Bit1 w)::int) = numeral (Num.Bit0 w)"
   by (simp_all add: not_int_def)
 
 lemma int_not_not: "NOT (NOT x) = x"
   for x :: int
   by (fact bit.double_compl)
 
 lemma int_and_0 [simp]: "0 AND x = 0"
   for x :: int
   by (fact bit.conj_zero_left)
 
 lemma int_and_m1 [simp]: "-1 AND x = x"
   for x :: int
   by (fact bit.conj_one_left)
 
 lemma int_or_zero [simp]: "0 OR x = x"
   for x :: int
   by (fact bit.disj_zero_left)
 
 lemma int_or_minus1 [simp]: "-1 OR x = -1"
   for x :: int
   by (fact bit.disj_one_left)
 
 lemma int_xor_zero [simp]: "0 XOR x = x"
   for x :: int
   by (fact bit.xor_zero_left)
 
 
 subsubsection \<open>Binary destructors\<close>
 
 lemma bin_rest_NOT [simp]: "(\<lambda>k::int. k div 2) (NOT x) = NOT ((\<lambda>k::int. k div 2) x)"
   by (fact not_int_div_2)
 
 lemma bin_last_NOT [simp]: "(odd :: int \<Rightarrow> bool) (NOT x) \<longleftrightarrow> \<not> (odd :: int \<Rightarrow> bool) x"
   by simp
 
 lemma bin_rest_AND [simp]: "(\<lambda>k::int. k div 2) (x AND y) = (\<lambda>k::int. k div 2) x AND (\<lambda>k::int. k div 2) y"
   by (subst and_int_rec) auto
 
 lemma bin_last_AND [simp]: "(odd :: int \<Rightarrow> bool) (x AND y) \<longleftrightarrow> (odd :: int \<Rightarrow> bool) x \<and> (odd :: int \<Rightarrow> bool) y"
   by (subst and_int_rec) auto
 
 lemma bin_rest_OR [simp]: "(\<lambda>k::int. k div 2) (x OR y) = (\<lambda>k::int. k div 2) x OR (\<lambda>k::int. k div 2) y"
   by (subst or_int_rec) auto
 
 lemma bin_last_OR [simp]: "(odd :: int \<Rightarrow> bool) (x OR y) \<longleftrightarrow> (odd :: int \<Rightarrow> bool) x \<or> (odd :: int \<Rightarrow> bool) y"
   by (subst or_int_rec) auto
 
 lemma bin_rest_XOR [simp]: "(\<lambda>k::int. k div 2) (x XOR y) = (\<lambda>k::int. k div 2) x XOR (\<lambda>k::int. k div 2) y"
   by (subst xor_int_rec) auto
 
 lemma bin_last_XOR [simp]: "(odd :: int \<Rightarrow> bool) (x XOR y) \<longleftrightarrow> ((odd :: int \<Rightarrow> bool) x \<or> (odd :: int \<Rightarrow> bool) y) \<and> \<not> ((odd :: int \<Rightarrow> bool) x \<and> (odd :: int \<Rightarrow> bool) y)"
   by (subst xor_int_rec) auto
 
 lemma bin_nth_ops:
   "\<And>x y. (bit :: int \<Rightarrow> nat \<Rightarrow> bool) (x AND y) n \<longleftrightarrow> (bit :: int \<Rightarrow> nat \<Rightarrow> bool) x n \<and> (bit :: int \<Rightarrow> nat \<Rightarrow> bool) y n"
   "\<And>x y. (bit :: int \<Rightarrow> nat \<Rightarrow> bool) (x OR y) n \<longleftrightarrow> (bit :: int \<Rightarrow> nat \<Rightarrow> bool) x n \<or> (bit :: int \<Rightarrow> nat \<Rightarrow> bool) y n"
   "\<And>x y. (bit :: int \<Rightarrow> nat \<Rightarrow> bool) (x XOR y) n \<longleftrightarrow> (bit :: int \<Rightarrow> nat \<Rightarrow> bool) x n \<noteq> (bit :: int \<Rightarrow> nat \<Rightarrow> bool) y n"
   "\<And>x. (bit :: int \<Rightarrow> nat \<Rightarrow> bool) (NOT x) n \<longleftrightarrow> \<not> (bit :: int \<Rightarrow> nat \<Rightarrow> bool) x n"
   by (simp_all add: bit_and_iff bit_or_iff bit_xor_iff bit_not_iff)
 
 
 subsubsection \<open>Derived properties\<close>
 
 lemma int_xor_minus1 [simp]: "-1 XOR x = NOT x"
   for x :: int
   by (fact bit.xor_one_left)
 
 lemma int_xor_extra_simps [simp]:
   "w XOR 0 = w"
   "w XOR -1 = NOT w"
   for w :: int
   by simp_all
 
 lemma int_or_extra_simps [simp]:
   "w OR 0 = w"
   "w OR -1 = -1"
   for w :: int
   by simp_all
 
 lemma int_and_extra_simps [simp]:
   "w AND 0 = 0"
   "w AND -1 = w"
   for w :: int
   by simp_all
 
 text \<open>Commutativity of the above.\<close>
 lemma bin_ops_comm:
   fixes x y :: int
   shows int_and_comm: "x AND y = y AND x"
     and int_or_comm:  "x OR y = y OR x"
     and int_xor_comm: "x XOR y = y XOR x"
   by (simp_all add: ac_simps)
 
 lemma bin_ops_same [simp]:
   "x AND x = x"
   "x OR x = x"
   "x XOR x = 0"
   for x :: int
   by simp_all
 
 lemmas bin_log_esimps =
   int_and_extra_simps  int_or_extra_simps  int_xor_extra_simps
   int_and_0 int_and_m1 int_or_zero int_or_minus1 int_xor_zero int_xor_minus1
 
 
 subsubsection \<open>Basic properties of logical (bit-wise) operations\<close>
 
 lemma bbw_ao_absorb: "x AND (y OR x) = x \<and> x OR (y AND x) = x"
   for x y :: int
   by (auto simp add: bin_eq_iff bin_nth_ops)
 
 lemma bbw_ao_absorbs_other:
   "x AND (x OR y) = x \<and> (y AND x) OR x = x"
   "(y OR x) AND x = x \<and> x OR (x AND y) = x"
   "(x OR y) AND x = x \<and> (x AND y) OR x = x"
   for x y :: int
   by (auto simp add: bin_eq_iff bin_nth_ops)
 
 lemmas bbw_ao_absorbs [simp] = bbw_ao_absorb bbw_ao_absorbs_other
 
 lemma int_xor_not: "(NOT x) XOR y = NOT (x XOR y) \<and> x XOR (NOT y) = NOT (x XOR y)"
   for x y :: int
   by (auto simp add: bin_eq_iff bin_nth_ops)
 
 lemma int_and_assoc: "(x AND y) AND z = x AND (y AND z)"
   for x y z :: int
   by (auto simp add: bin_eq_iff bin_nth_ops)
 
 lemma int_or_assoc: "(x OR y) OR z = x OR (y OR z)"
   for x y z :: int
   by (auto simp add: bin_eq_iff bin_nth_ops)
 
 lemma int_xor_assoc: "(x XOR y) XOR z = x XOR (y XOR z)"
   for x y z :: int
   by (auto simp add: bin_eq_iff bin_nth_ops)
 
 lemmas bbw_assocs = int_and_assoc int_or_assoc int_xor_assoc
 
 (* BH: Why are these declared as simp rules??? *)
 lemma bbw_lcs [simp]:
   "y AND (x AND z) = x AND (y AND z)"
   "y OR (x OR z) = x OR (y OR z)"
   "y XOR (x XOR z) = x XOR (y XOR z)"
   for x y :: int
   by (auto simp add: bin_eq_iff bin_nth_ops)
 
 lemma bbw_not_dist:
   "NOT (x OR y) = (NOT x) AND (NOT y)"
   "NOT (x AND y) = (NOT x) OR (NOT y)"
   for x y :: int
   by (auto simp add: bin_eq_iff bin_nth_ops)
 
 lemma bbw_oa_dist: "(x AND y) OR z = (x OR z) AND (y OR z)"
   for x y z :: int
   by (auto simp add: bin_eq_iff bin_nth_ops)
 
 lemma bbw_ao_dist: "(x OR y) AND z = (x AND z) OR (y AND z)"
   for x y z :: int
   by (auto simp add: bin_eq_iff bin_nth_ops)
 
-(*
-Why were these declared simp???
-declare bin_ops_comm [simp] bbw_assocs [simp]
-*)
-
 
 subsubsection \<open>Simplification with numerals\<close>
 
 text \<open>Cases for \<open>0\<close> and \<open>-1\<close> are already covered by other simp rules.\<close>
 
 lemma bin_rest_neg_numeral_BitM [simp]:
   "(\<lambda>k::int. k div 2) (- numeral (Num.BitM w)) = - numeral w"
   by simp
 
 lemma bin_last_neg_numeral_BitM [simp]:
   "(odd :: int \<Rightarrow> bool) (- numeral (Num.BitM w))"
   by simp
 
 
 subsubsection \<open>Interactions with arithmetic\<close>
 
 lemma le_int_or: "bin_sign y = 0 \<Longrightarrow> x \<le> x OR y"
   for x y :: int
   by (simp add: bin_sign_def or_greater_eq split: if_splits)
 
 lemmas int_and_le =
   xtrans(3) [OF bbw_ao_absorbs (2) [THEN conjunct2, symmetric] le_int_or]
 
 text \<open>Interaction between bit-wise and arithmetic: good example of \<open>bin_induction\<close>.\<close>
 lemma bin_add_not: "x + NOT x = (-1::int)"
   by (simp add: not_int_def)
 
 lemma AND_mod: "x AND (2 ^ n - 1) = x mod 2 ^ n"
   for x :: int
   by (simp flip: take_bit_eq_mod add: take_bit_eq_mask mask_eq_exp_minus_1)
 
 
 subsubsection \<open>Truncating results of bit-wise operations\<close>
 
 lemma bin_trunc_ao:
   "(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n x AND (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n y = (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n (x AND y)"
   "(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n x OR (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n y = (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n (x OR y)"
   by simp_all
 
 lemma bin_trunc_xor: "(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n ((take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n x XOR (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n y) = (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n (x XOR y)"
   by simp
 
 lemma bin_trunc_not: "(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n (NOT ((take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n x)) = (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n (NOT x)"
   by (fact take_bit_not_take_bit)
 
 text \<open>Want theorems of the form of \<open>bin_trunc_xor\<close>.\<close>
 lemma bintr_bintr_i: "x = (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n y \<Longrightarrow> (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n x = (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n y"
   by auto
 
 lemmas bin_trunc_and = bin_trunc_ao(1) [THEN bintr_bintr_i]
 lemmas bin_trunc_or = bin_trunc_ao(2) [THEN bintr_bintr_i]
 
 
 subsubsection \<open>More lemmas\<close>
 
 lemma not_int_cmp_0 [simp]:
   fixes i :: int shows
   "0 < NOT i \<longleftrightarrow> i < -1"
   "0 \<le> NOT i \<longleftrightarrow> i < 0"
   "NOT i < 0 \<longleftrightarrow> i \<ge> 0"
   "NOT i \<le> 0 \<longleftrightarrow> i \<ge> -1"
 by(simp_all add: int_not_def) arith+
 
 lemma bbw_ao_dist2: "(x :: int) AND (y OR z) = x AND y OR x AND z"
   by (fact bit.conj_disj_distrib)
 
 lemmas int_and_ac = bbw_lcs(1) int_and_comm int_and_assoc
 
 lemma int_nand_same [simp]: fixes x :: int shows "x AND NOT x = 0"
   by simp
 
 lemma int_nand_same_middle: fixes x :: int shows "x AND y AND NOT x = 0"
   by (simp add: bit_eq_iff bit_and_iff bit_not_iff)
 
 lemma and_xor_dist: fixes x :: int shows
   "x AND (y XOR z) = (x AND y) XOR (x AND z)"
   by (fact bit.conj_xor_distrib)
 
 lemma int_and_lt0 [simp]:
   \<open>x AND y < 0 \<longleftrightarrow> x < 0 \<and> y < 0\<close> for x y :: int
   by (fact and_negative_int_iff)
 
 lemma int_and_ge0 [simp]:
   \<open>x AND y \<ge> 0 \<longleftrightarrow> x \<ge> 0 \<or> y \<ge> 0\<close> for x y :: int
   by (fact and_nonnegative_int_iff)
 
 lemma int_and_1: fixes x :: int shows "x AND 1 = x mod 2"
   by (fact and_one_eq)
 
 lemma int_1_and: fixes x :: int shows "1 AND x = x mod 2"
   by (fact one_and_eq)
 
 lemma int_or_lt0 [simp]:
   \<open>x OR y < 0 \<longleftrightarrow> x < 0 \<or> y < 0\<close> for x y :: int
   by (fact or_negative_int_iff)
 
 lemma int_or_ge0 [simp]:
   \<open>x OR y \<ge> 0 \<longleftrightarrow> x \<ge> 0 \<and> y \<ge> 0\<close> for x y :: int
   by (fact or_nonnegative_int_iff)
 
 lemma int_xor_lt0 [simp]:
   \<open>x XOR y < 0 \<longleftrightarrow> (x < 0) \<noteq> (y < 0)\<close> for x y :: int
   by (fact xor_negative_int_iff)
 
 lemma int_xor_ge0 [simp]:
   \<open>x XOR y \<ge> 0 \<longleftrightarrow> (x \<ge> 0 \<longleftrightarrow> y \<ge> 0)\<close> for x y :: int
   by (fact xor_nonnegative_int_iff)
 
 lemma even_conv_AND:
   \<open>even i \<longleftrightarrow> i AND 1 = 0\<close> for i :: int
   by (simp add: and_one_eq mod2_eq_if)
 
 lemma bin_last_conv_AND:
   "(odd :: int \<Rightarrow> bool) i \<longleftrightarrow> i AND 1 \<noteq> 0"
   by (simp add: and_one_eq mod2_eq_if)
 
 lemma bitval_bin_last:
   "of_bool ((odd :: int \<Rightarrow> bool) i) = i AND 1"
   by (simp add: and_one_eq mod2_eq_if)
 
 lemma bin_sign_and:
   "bin_sign (i AND j) = - (bin_sign i * bin_sign j)"
 by(simp add: bin_sign_def)
 
 lemma int_not_neg_numeral: "NOT (- numeral n) = (Num.sub n num.One :: int)"
 by(simp add: int_not_def)
 
 lemma int_neg_numeral_pOne_conv_not: "- numeral (n + num.One) = (NOT (numeral n) :: int)"
 by(simp add: int_not_def)
 
 
 subsection \<open>Setting and clearing bits\<close>
 
 lemma int_shiftl_BIT: fixes x :: int
-  shows int_shiftl0 [simp]: "x << 0 = x"
-  and int_shiftl_Suc [simp]: "x << Suc n = 2 * (x << n)"
+  shows int_shiftl0: "push_bit 0 x = x"
+  and int_shiftl_Suc: "push_bit (Suc n) x = 2 * push_bit n x"
   by (auto simp add: shiftl_int_def)
 
-lemma int_0_shiftl [simp]: "0 << n = (0 :: int)"
-by(induct n) simp_all
-
-lemma bin_last_shiftl: "(odd :: int \<Rightarrow> bool) (x << n) \<longleftrightarrow> n = 0 \<and> (odd :: int \<Rightarrow> bool) x"
-by(cases n)(simp_all)
-
-lemma bin_rest_shiftl: "(\<lambda>k::int. k div 2) (x << n) = (if n > 0 then x << (n - 1) else (\<lambda>k::int. k div 2) x)"
-by(cases n)(simp_all)
+lemma int_0_shiftl: "push_bit n 0 = (0 :: int)"
+  by (fact push_bit_of_0)
 
-lemma bin_nth_shiftl [simp]: "(bit :: int \<Rightarrow> nat \<Rightarrow> bool) (x << n) m \<longleftrightarrow> n \<le> m \<and> (bit :: int \<Rightarrow> nat \<Rightarrow> bool) x (m - n)"
-  by (simp add: bit_push_bit_iff_int shiftl_eq_push_bit)
+lemma bin_last_shiftl: "odd (push_bit n x) \<longleftrightarrow> n = 0 \<and> (odd :: int \<Rightarrow> bool) x"
+  by simp
 
-lemma bin_last_shiftr: "odd (x >> n) \<longleftrightarrow> bit x n" for x :: int
-  by (simp add: shiftr_eq_drop_bit bit_iff_odd_drop_bit)
+lemma bin_rest_shiftl: "(\<lambda>k::int. k div 2) (push_bit n x) = (if n > 0 then push_bit (n - 1) x else (\<lambda>k::int. k div 2) x)"
+  by (cases n) (simp_all add: push_bit_eq_mult)
 
-lemma bin_rest_shiftr [simp]: "(\<lambda>k::int. k div 2) (x >> n) = x >> Suc n"
-  by (simp add: bit_eq_iff shiftr_eq_drop_bit drop_bit_Suc bit_drop_bit_eq drop_bit_half)
+lemma bin_nth_shiftl: "(bit :: int \<Rightarrow> nat \<Rightarrow> bool) (push_bit n x) m \<longleftrightarrow> n \<le> m \<and> (bit :: int \<Rightarrow> nat \<Rightarrow> bool) x (m - n)"
+  by (fact bit_push_bit_iff_int)
 
-lemma bin_nth_shiftr [simp]: "(bit :: int \<Rightarrow> nat \<Rightarrow> bool) (x >> n) m = (bit :: int \<Rightarrow> nat \<Rightarrow> bool) x (n + m)"
-  by (simp add: shiftr_eq_drop_bit bit_drop_bit_eq)
+lemma bin_last_shiftr: "odd (drop_bit n x) \<longleftrightarrow> bit x n" for x :: int
+  by (simp add: bit_iff_odd_drop_bit)
+
+lemma bin_rest_shiftr: "(\<lambda>k::int. k div 2) (drop_bit n x) = drop_bit (Suc n) x"
+  by (simp add: drop_bit_Suc drop_bit_half)
+
+lemma bin_nth_shiftr: "(bit :: int \<Rightarrow> nat \<Rightarrow> bool) (drop_bit n x) m = (bit :: int \<Rightarrow> nat \<Rightarrow> bool) x (n + m)"
+  by (simp add: bit_simps)
 
 lemma bin_nth_conv_AND:
   fixes x :: int shows
-  "(bit :: int \<Rightarrow> nat \<Rightarrow> bool) x n \<longleftrightarrow> x AND (1 << n) \<noteq> 0"
-  by (simp add: bit_eq_iff)
-    (auto simp add: shiftl_eq_push_bit bit_and_iff bit_push_bit_iff bit_exp_iff)
+  "(bit :: int \<Rightarrow> nat \<Rightarrow> bool) x n \<longleftrightarrow> x AND (push_bit n 1) \<noteq> 0"
+  by (fact bit_iff_and_push_bit_not_eq_0)
 
 lemma int_shiftl_numeral [simp]:
-  "(numeral w :: int) << numeral w' = numeral (num.Bit0 w) << pred_numeral w'"
-  "(- numeral w :: int) << numeral w' = - numeral (num.Bit0 w) << pred_numeral w'"
+  "push_bit (numeral w') (numeral w :: int) = push_bit (pred_numeral w') (numeral (num.Bit0 w))"
+  "push_bit (numeral w') (- numeral w :: int) = push_bit (pred_numeral w') (- numeral (num.Bit0 w))"
 by(simp_all add: numeral_eq_Suc shiftl_int_def)
   (metis add_One mult_inc semiring_norm(11) semiring_norm(13) semiring_norm(2) semiring_norm(6) semiring_norm(87))+
 
 lemma int_shiftl_One_numeral [simp]:
-  "(1 :: int) << numeral w = 2 << pred_numeral w"
-  using int_shiftl_numeral [of Num.One w] by simp
-
-lemma shiftl_ge_0 [simp]: fixes i :: int shows "i << n \<ge> 0 \<longleftrightarrow> i \<ge> 0"
-by(induct n) simp_all
-
-lemma shiftl_lt_0 [simp]: fixes i :: int shows "i << n < 0 \<longleftrightarrow> i < 0"
-by (metis not_le shiftl_ge_0)
+  "push_bit (numeral w) (1::int) = push_bit (pred_numeral w) 2"
+  using int_shiftl_numeral [of Num.One w]
+  by (simp add: numeral_eq_Suc) 
 
-lemma int_shiftl_test_bit: "bit (n << i :: int) m \<longleftrightarrow> m \<ge> i \<and> bit n (m - i)"
-  by simp
-
-lemma int_0shiftr [simp]: "(0 :: int) >> x = 0"
-by(simp add: shiftr_int_def)
+lemma shiftl_ge_0: fixes i :: int shows "push_bit n i \<ge> 0 \<longleftrightarrow> i \<ge> 0"
+  by (fact push_bit_nonnegative_int_iff)
 
-lemma int_minus1_shiftr [simp]: "(-1 :: int) >> x = -1"
-by(simp add: shiftr_int_def div_eq_minus1)
+lemma shiftl_lt_0: fixes i :: int shows "push_bit n i < 0 \<longleftrightarrow> i < 0"
+  by (fact push_bit_negative_int_iff)
 
-lemma int_shiftr_ge_0 [simp]: fixes i :: int shows "i >> n \<ge> 0 \<longleftrightarrow> i \<ge> 0"
-  by (simp add: shiftr_eq_drop_bit)
+lemma int_shiftl_test_bit: "bit (push_bit i n :: int) m \<longleftrightarrow> m \<ge> i \<and> bit n (m - i)"
+  by (fact bit_push_bit_iff_int)
 
-lemma int_shiftr_lt_0 [simp]: fixes i :: int shows "i >> n < 0 \<longleftrightarrow> i < 0"
-by (metis int_shiftr_ge_0 not_less)
+lemma int_0shiftr: "drop_bit x (0 :: int) = 0"
+  by (fact drop_bit_of_0)
+
+lemma int_minus1_shiftr: "drop_bit x (-1 :: int) = -1"
+  by (fact drop_bit_minus_one)
+
+lemma int_shiftr_ge_0: fixes i :: int shows "drop_bit n i \<ge> 0 \<longleftrightarrow> i \<ge> 0"
+  by (fact drop_bit_nonnegative_int_iff)
+
+lemma int_shiftr_lt_0 [simp]: fixes i :: int shows "drop_bit n i < 0 \<longleftrightarrow> i < 0"
+  by (fact drop_bit_negative_int_iff)
 
 lemma int_shiftr_numeral [simp]:
-  "(1 :: int) >> numeral w' = 0"
-  "(numeral num.One :: int) >> numeral w' = 0"
-  "(numeral (num.Bit0 w) :: int) >> numeral w' = numeral w >> pred_numeral w'"
-  "(numeral (num.Bit1 w) :: int) >> numeral w' = numeral w >> pred_numeral w'"
-  "(- numeral (num.Bit0 w) :: int) >> numeral w' = - numeral w >> pred_numeral w'"
-  "(- numeral (num.Bit1 w) :: int) >> numeral w' = - numeral (Num.inc w) >> pred_numeral w'"
-  by (simp_all add: shiftr_eq_drop_bit numeral_eq_Suc add_One drop_bit_Suc)
+  "drop_bit (numeral w') (1 :: int) = 0"
+  "drop_bit (numeral w') (numeral num.One :: int) = 0"
+  "drop_bit (numeral w') (numeral (num.Bit0 w) :: int) = drop_bit (pred_numeral w') (numeral w)"
+  "drop_bit (numeral w') (numeral (num.Bit1 w) :: int) = drop_bit (pred_numeral w') (numeral w)"
+  "drop_bit (numeral w') (- numeral (num.Bit0 w) :: int) = drop_bit (pred_numeral w') (- numeral w)"
+  "drop_bit (numeral w') (- numeral (num.Bit1 w) :: int) = drop_bit (pred_numeral w') (- numeral (Num.inc w))"
+  by (simp_all add: numeral_eq_Suc add_One drop_bit_Suc)
 
 lemma int_shiftr_numeral_Suc0 [simp]:
-  "(1 :: int) >> Suc 0 = 0"
-  "(numeral num.One :: int) >> Suc 0 = 0"
-  "(numeral (num.Bit0 w) :: int) >> Suc 0 = numeral w"
-  "(numeral (num.Bit1 w) :: int) >> Suc 0 = numeral w"
-  "(- numeral (num.Bit0 w) :: int) >> Suc 0 = - numeral w"
-  "(- numeral (num.Bit1 w) :: int) >> Suc 0 = - numeral (Num.inc w)"
-  by (simp_all add: shiftr_eq_drop_bit drop_bit_Suc add_One)
+  "drop_bit (Suc 0) (1 :: int) = 0"
+  "drop_bit (Suc 0) (numeral num.One :: int) = 0"
+  "drop_bit (Suc 0) (numeral (num.Bit0 w) :: int) = numeral w"
+  "drop_bit (Suc 0) (numeral (num.Bit1 w) :: int) = numeral w"
+  "drop_bit (Suc 0) (- numeral (num.Bit0 w) :: int) = - numeral w"
+  "drop_bit (Suc 0) (- numeral (num.Bit1 w) :: int) = - numeral (Num.inc w)"
+  by (simp_all add: drop_bit_Suc add_One)
 
 lemma bin_nth_minus_p2:
   assumes sign: "bin_sign x = 0"
-  and y: "y = 1 << n"
+  and y: "y = push_bit n 1"
   and m: "m < n"
   and x: "x < y"
-  shows "(bit :: int \<Rightarrow> nat \<Rightarrow> bool) (x - y) m = (bit :: int \<Rightarrow> nat \<Rightarrow> bool) x m"
+  shows "bit (x - y) m = bit x m"
 proof -
   from sign y x have \<open>x \<ge> 0\<close> and \<open>y = 2 ^ n\<close> and \<open>x < 2 ^ n\<close>
-    by (simp_all add: bin_sign_def shiftl_eq_push_bit push_bit_eq_mult split: if_splits)
+    by (simp_all add: bin_sign_def push_bit_eq_mult split: if_splits)
   from \<open>0 \<le> x\<close> \<open>x < 2 ^ n\<close> \<open>m < n\<close> have \<open>bit x m \<longleftrightarrow> bit (x - 2 ^ n) m\<close>
   proof (induction m arbitrary: x n)
     case 0
     then show ?case
       by simp
   next
     case (Suc m)
     moreover define q where \<open>q = n - 1\<close>
     ultimately have n: \<open>n = Suc q\<close>
       by simp
     have \<open>(x - 2 ^ Suc q) div 2 = x div 2 - 2 ^ q\<close>
       by simp
     moreover from Suc.IH [of \<open>x div 2\<close> q] Suc.prems
     have \<open>bit (x div 2) m \<longleftrightarrow> bit (x div 2 - 2 ^ q) m\<close>
       by (simp add: n)
     ultimately show ?case
       by (simp add: bit_Suc n)
   qed
   with \<open>y = 2 ^ n\<close> show ?thesis
     by simp
 qed
 
 lemma bin_clr_conv_NAND:
-  "bin_sc n False i = i AND NOT (1 << n)"
-  by (induct n arbitrary: i) (rule bin_rl_eqI; simp)+
+  "bin_sc n False i = i AND NOT (push_bit n 1)"
+  by (rule bit_eqI) (auto simp add: bin_sc_eq bit_simps)
 
 lemma bin_set_conv_OR:
-  "bin_sc n True i = i OR (1 << n)"
-  by (induct n arbitrary: i) (rule bin_rl_eqI; simp)+
+  "bin_sc n True i = i OR (push_bit n 1)"
+  by (rule bit_eqI) (auto simp add: bin_sc_eq bit_simps)
 
 
 subsection \<open>More lemmas on words\<close>
 
 lemma word_rcat_eq:
   \<open>word_rcat ws = word_of_int (bin_rcat (LENGTH('a::len)) (map uint ws))\<close>
   for ws :: \<open>'a::len word list\<close>
   apply (simp add: word_rcat_def bin_rcat_def rev_map)
   apply transfer
   apply (simp add: horner_sum_foldr foldr_map comp_def)
   done
 
 lemma sign_uint_Pls [simp]: "bin_sign (uint x) = 0"
   by (simp add: sign_Pls_ge_0)
 
 lemmas bin_log_bintrs = bin_trunc_not bin_trunc_xor bin_trunc_and bin_trunc_or
 
 \<comment> \<open>following definitions require both arithmetic and bit-wise word operations\<close>
 
 \<comment> \<open>to get \<open>word_no_log_defs\<close> from \<open>word_log_defs\<close>, using \<open>bin_log_bintrs\<close>\<close>
 lemmas wils1 = bin_log_bintrs [THEN word_of_int_eq_iff [THEN iffD2],
   folded uint_word_of_int_eq, THEN eq_reflection]
 
 \<comment> \<open>the binary operations only\<close>  (* BH: why is this needed? *)
 lemmas word_log_binary_defs =
   word_and_def word_or_def word_xor_def
 
 lemma setBit_no: "set_bit n (numeral bin) = word_of_int (bin_sc n True (numeral bin))"
   by transfer (simp add: bin_sc_eq)
 
 lemma clearBit_no:
   "unset_bit n (numeral bin) = word_of_int (bin_sc n False (numeral bin))"
   by transfer (simp add: bin_sc_eq)
 
 lemma eq_mod_iff: "0 < n \<Longrightarrow> b = b mod n \<longleftrightarrow> 0 \<le> b \<and> b < n"
   for b n :: int
   by auto (metis pos_mod_conj)+
 
 lemma split_uint_lem: "bin_split n (uint w) = (a, b) \<Longrightarrow>
     a = take_bit (LENGTH('a) - n) a \<and> b = take_bit (LENGTH('a)) b"
   for w :: "'a::len word"
   by transfer (simp add: drop_bit_take_bit ac_simps)
 
 \<comment> \<open>limited hom result\<close>
 lemma word_cat_hom:
   "LENGTH('a::len) \<le> LENGTH('b::len) + LENGTH('c::len) \<Longrightarrow>
     (word_cat (word_of_int w :: 'b word) (b :: 'c word) :: 'a word) =
     word_of_int ((\<lambda>k n l. concat_bit n l k) w (size b) (uint b))"
   by transfer (simp add: take_bit_concat_bit_eq)
 
 lemma bintrunc_shiftl:
-  "take_bit n (m << i) = take_bit (n - i) m << i"
+  "take_bit n (push_bit i m) = push_bit i (take_bit (n - i) m)"
   for m :: int
-  by (rule bit_eqI) (auto simp add: bit_take_bit_iff)
+  by (fact take_bit_push_bit)
 
 lemma uint_shiftl:
-  "uint (n << i) = take_bit (size n) (uint n << i)"
-  by transfer (simp add: push_bit_take_bit shiftl_eq_push_bit)
+  "uint (push_bit i n) = take_bit (size n) (push_bit i (uint n))"
+  by (simp add: unsigned_push_bit_eq word_size)
 
 lemma bin_mask_conv_pow2:
   "mask n = 2 ^ n - (1 :: int)"
   by (fact mask_eq_exp_minus_1)
 
 lemma bin_mask_ge0: "mask n \<ge> (0 :: int)"
   by (fact mask_nonnegative_int)
 
 lemma and_bin_mask_conv_mod: "x AND mask n = x mod 2 ^ n"
   for x :: int
   by (simp flip: take_bit_eq_mod add: take_bit_eq_mask)
 
 lemma bin_mask_numeral:
   "mask (numeral n) = (1 :: int) + 2 * mask (pred_numeral n)"
   by (fact mask_numeral)
 
-lemma bin_nth_mask [simp]: "bit (mask n :: int) i \<longleftrightarrow> i < n"
+lemma bin_nth_mask: "bit (mask n :: int) i \<longleftrightarrow> i < n"
   by (simp add: bit_mask_iff)
 
 lemma bin_sign_mask [simp]: "bin_sign (mask n) = 0"
   by (simp add: bin_sign_def bin_mask_conv_pow2)
 
-lemma bin_mask_p1_conv_shift: "mask n + 1 = (1 :: int) << n"
+lemma bin_mask_p1_conv_shift: "mask n + 1 = push_bit n (1 :: int)"
   by (simp add: bin_mask_conv_pow2 shiftl_int_def)
 
 lemma sbintrunc_eq_in_range:
   "((signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n x = x) = (x \<in> range ((signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n))"
   "(x = (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n x) = (x \<in> range ((signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) 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> (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) 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 sint_range':
   \<open>- (2 ^ (LENGTH('a) - Suc 0)) \<le> sint x \<and> sint x < 2 ^ (LENGTH('a) - Suc 0)\<close>
   for x :: \<open>'a::len word\<close>
   apply transfer
   using sbintr_ge sbintr_lt apply auto
   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_eq word_sless_alt sbintrunc_If)
 
 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: "(signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (size a - 1) (sint a * sint b) \<in> range ((signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (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)
   define r s where \<open>r = LENGTH('a) - 1\<close> \<open>s = LENGTH('b) - 1\<close>
   then have \<open>LENGTH('a) = Suc r\<close> \<open>LENGTH('b) = Suc s\<close>
     \<open>size a = Suc r\<close> \<open>size b = Suc r\<close>
     by (simp_all add: word_size)
   then show ?thesis
     using P[unfolded range_sbintrunc] abs_ab le
     apply clarsimp
     apply (transfer fixing: r s)
-    apply (auto simp add: signed_take_bit_int_eq_self simp flip: signed_take_bit_eq_iff_take_bit_eq)
+    apply (auto simp add: signed_take_bit_int_eq_self min.absorb2 simp flip: signed_take_bit_eq_iff_take_bit_eq)
     done
 qed
 
 lemma bintrunc_id:
   "\<lbrakk>m \<le> int n; 0 < m\<rbrakk> \<Longrightarrow> take_bit n m = m"
-  apply (simp add: take_bit_int_eq_self_iff)
-  apply (metis n_less_equal_power_2 not_le of_nat_less_iff of_nat_numeral order_trans semiring_1_class.of_nat_power)
-  done
+  by (simp add: take_bit_int_eq_self_iff le_less_trans less_exp)
 
 code_identifier
   code_module Bits_Int \<rightharpoonup>
   (SML) Bit_Operations and (OCaml) Bit_Operations and (Haskell) Bit_Operations and (Scala) Bit_Operations
 
 end
diff --git a/thys/Word_Lib/Bitwise.thy b/thys/Word_Lib/Bitwise.thy
--- a/thys/Word_Lib/Bitwise.thy
+++ b/thys/Word_Lib/Bitwise.thy
@@ -1,503 +1,507 @@
 (*
  * Copyright Thomas Sewell, NICTA and Sascha Boehme, TU Muenchen
  *
  * SPDX-License-Identifier: BSD-2-Clause
  *)
 
 theory Bitwise
   imports
     "HOL-Library.Word"
     More_Arithmetic
     Reversed_Bit_Lists
+    Bit_Shifts_Infix_Syntax
 begin
 
 text \<open>Helper constants used in defining addition\<close>
 
 definition xor3 :: "bool \<Rightarrow> bool \<Rightarrow> bool \<Rightarrow> bool"
   where "xor3 a b c = (a = (b = c))"
 
 definition carry :: "bool \<Rightarrow> bool \<Rightarrow> bool \<Rightarrow> bool"
   where "carry a b c = ((a \<and> (b \<or> c)) \<or> (b \<and> c))"
 
 lemma carry_simps:
   "carry True a b = (a \<or> b)"
   "carry a True b = (a \<or> b)"
   "carry a b True = (a \<or> b)"
   "carry False a b = (a \<and> b)"
   "carry a False b = (a \<and> b)"
   "carry a b False = (a \<and> b)"
   by (auto simp add: carry_def)
 
 lemma xor3_simps:
   "xor3 True a b = (a = b)"
   "xor3 a True b = (a = b)"
   "xor3 a b True = (a = b)"
   "xor3 False a b = (a \<noteq> b)"
   "xor3 a False b = (a \<noteq> b)"
   "xor3 a b False = (a \<noteq> b)"
   by (simp_all add: xor3_def)
 
 text \<open>Breaking up word equalities into equalities on their
   bit lists. Equalities are generated and manipulated in the
   reverse order to \<^const>\<open>to_bl\<close>.\<close>
 
 lemma bl_word_sub: "to_bl (x - y) = to_bl (x + (- y))"
   by simp
 
 lemma rbl_word_1: "rev (to_bl (1 :: 'a::len word)) = takefill False (LENGTH('a)) [True]"
   apply (rule_tac s="rev (to_bl (word_succ (0 :: 'a word)))" in trans)
    apply simp
   apply (simp only: rtb_rbl_ariths(1)[OF refl])
   apply simp
   apply (case_tac "LENGTH('a)")
    apply simp
   apply (simp add: takefill_alt)
   done
 
 lemma rbl_word_if: "rev (to_bl (if P then x else y)) = map2 (If P) (rev (to_bl x)) (rev (to_bl y))"
   by (simp add: split_def)
 
 lemma rbl_add_carry_Cons:
   "(if car then rbl_succ else id) (rbl_add (x # xs) (y # ys)) =
     xor3 x y car # (if carry x y car then rbl_succ else id) (rbl_add xs ys)"
   by (simp add: carry_def xor3_def)
 
 lemma rbl_add_suc_carry_fold:
   "length xs = length ys \<Longrightarrow>
     \<forall>car. (if car then rbl_succ else id) (rbl_add xs ys) =
       (foldr (\<lambda>(x, y) res car. xor3 x y car # res (carry x y car)) (zip xs ys) (\<lambda>_. [])) car"
   apply (erule list_induct2)
    apply simp
   apply (simp only: rbl_add_carry_Cons)
   apply simp
   done
 
 lemma to_bl_plus_carry:
   "to_bl (x + y) =
     rev (foldr (\<lambda>(x, y) res car. xor3 x y car # res (carry x y car))
       (rev (zip (to_bl x) (to_bl y))) (\<lambda>_. []) False)"
   using rbl_add_suc_carry_fold[where xs="rev (to_bl x)" and ys="rev (to_bl y)"]
   apply (simp add: word_add_rbl[OF refl refl])
   apply (drule_tac x=False in spec)
   apply (simp add: zip_rev)
   done
 
 definition "rbl_plus cin xs ys =
   foldr (\<lambda>(x, y) res car. xor3 x y car # res (carry x y car)) (zip xs ys) (\<lambda>_. []) cin"
 
 lemma rbl_plus_simps:
   "rbl_plus cin (x # xs) (y # ys) = xor3 x y cin # rbl_plus (carry x y cin) xs ys"
   "rbl_plus cin [] ys = []"
   "rbl_plus cin xs [] = []"
   by (simp_all add: rbl_plus_def)
 
 lemma rbl_word_plus: "rev (to_bl (x + y)) = rbl_plus False (rev (to_bl x)) (rev (to_bl y))"
   by (simp add: rbl_plus_def to_bl_plus_carry zip_rev)
 
 definition "rbl_succ2 b xs = (if b then rbl_succ xs else xs)"
 
 lemma rbl_succ2_simps:
   "rbl_succ2 b [] = []"
   "rbl_succ2 b (x # xs) = (b \<noteq> x) # rbl_succ2 (x \<and> b) xs"
   by (simp_all add: rbl_succ2_def)
 
 lemma twos_complement: "- x = word_succ (NOT x)"
   using arg_cong[OF word_add_not[where x=x], where f="\<lambda>a. a - x + 1"]
   by (simp add: word_succ_p1 word_sp_01[unfolded word_succ_p1] del: word_add_not)
 
 lemma rbl_word_neg: "rev (to_bl (- x)) = rbl_succ2 True (map Not (rev (to_bl x)))"
   for x :: \<open>'a::len word\<close>
   by (simp add: twos_complement word_succ_rbl[OF refl] bl_word_not rev_map rbl_succ2_def)
 
 lemma rbl_word_cat:
   "rev (to_bl (word_cat x y :: 'a::len word)) =
     takefill False (LENGTH('a)) (rev (to_bl y) @ rev (to_bl x))"
   by (simp add: word_cat_bl word_rev_tf)
 
 lemma rbl_word_slice:
   "rev (to_bl (slice n w :: 'a::len word)) =
     takefill False (LENGTH('a)) (drop n (rev (to_bl w)))"
   apply (simp add: slice_take word_rev_tf rev_take)
   apply (cases "n < LENGTH('b)", simp_all)
   done
 
 lemma rbl_word_ucast:
   "rev (to_bl (ucast x :: 'a::len word)) = takefill False (LENGTH('a)) (rev (to_bl x))"
   apply (simp add: to_bl_ucast takefill_alt)
   apply (simp add: rev_drop)
   apply (cases "LENGTH('a) < LENGTH('b)")
    apply simp_all
   done
 
 lemma rbl_shiftl:
   "rev (to_bl (w << n)) = takefill False (size w) (replicate n False @ rev (to_bl w))"
   by (simp add: bl_shiftl takefill_alt word_size rev_drop)
 
 lemma rbl_shiftr:
   "rev (to_bl (w >> n)) = takefill False (size w) (drop n (rev (to_bl w)))"
   by (simp add: shiftr_slice rbl_word_slice word_size)
 
 definition "drop_nonempty v n xs = (if n < length xs then drop n xs else [last (v # xs)])"
 
 lemma drop_nonempty_simps:
   "drop_nonempty v (Suc n) (x # xs) = drop_nonempty x n xs"
   "drop_nonempty v 0 (x # xs) = (x # xs)"
   "drop_nonempty v n [] = [v]"
   by (simp_all add: drop_nonempty_def)
 
 definition "takefill_last x n xs = takefill (last (x # xs)) n xs"
 
 lemma takefill_last_simps:
   "takefill_last z (Suc n) (x # xs) = x # takefill_last x n xs"
   "takefill_last z 0 xs = []"
   "takefill_last z n [] = replicate n z"
   by (simp_all add: takefill_last_def) (simp_all add: takefill_alt)
 
 lemma rbl_sshiftr:
   "rev (to_bl (w >>> n)) = takefill_last False (size w) (drop_nonempty False n (rev (to_bl w)))"
   apply (cases "n < size w")
    apply (simp add: bl_sshiftr takefill_last_def word_size
       takefill_alt rev_take last_rev
       drop_nonempty_def)
   apply (subgoal_tac "(w >>> n) = of_bl (replicate (size w) (msb w))")
    apply (simp add: word_size takefill_last_def takefill_alt
       last_rev word_msb_alt word_rev_tf
       drop_nonempty_def take_Cons')
    apply (case_tac "LENGTH('a)", simp_all)
   apply (rule word_eqI)
-  apply (simp add: nth_sshiftr word_size test_bit_of_bl
+  apply (simp add: bit_simps word_size test_bit_of_bl
       msb_nth)
   done
 
 lemma nth_word_of_int:
   "bit (word_of_int x :: 'a::len word) n = (n < LENGTH('a) \<and> bit x n)"
   apply (simp add: test_bit_bl word_size to_bl_of_bin)
   apply (subst conj_cong[OF refl], erule bin_nth_bl)
   apply auto
   done
 
 lemma nth_scast:
   "bit (scast (x :: 'a::len word) :: 'b::len word) n =
     (n < LENGTH('b) \<and>
     (if n < LENGTH('a) - 1 then bit x n
      else bit x (LENGTH('a) - 1)))"
   apply transfer
   apply (auto simp add: bit_signed_take_bit_iff min_def)
   done
 
 lemma rbl_word_scast:
   "rev (to_bl (scast x :: 'a::len word)) = takefill_last False (LENGTH('a)) (rev (to_bl x))"
   apply (rule nth_equalityI)
    apply (simp add: word_size takefill_last_def)
   apply (clarsimp simp: nth_scast takefill_last_def
       nth_takefill word_size rev_nth to_bl_nth)
   apply (cases "LENGTH('b)")
    apply simp
   apply (clarsimp simp: less_Suc_eq_le linorder_not_less
       last_rev word_msb_alt[symmetric]
       msb_nth)
   done
 
 definition rbl_mul :: "bool list \<Rightarrow> bool list \<Rightarrow> bool list"
   where "rbl_mul xs ys = foldr (\<lambda>x sm. rbl_plus False (map ((\<and>) x) ys) (False # sm)) xs []"
 
 lemma rbl_mul_simps:
   "rbl_mul (x # xs) ys = rbl_plus False (map ((\<and>) x) ys) (False # rbl_mul xs ys)"
   "rbl_mul [] ys = []"
   by (simp_all add: rbl_mul_def)
 
 lemma takefill_le2: "length xs \<le> n \<Longrightarrow> takefill x m (takefill x n xs) = takefill x m xs"
   by (simp add: takefill_alt replicate_add[symmetric])
 
 lemma take_rbl_plus: "\<forall>n b. take n (rbl_plus b xs ys) = rbl_plus b (take n xs) (take n ys)"
   apply (simp add: rbl_plus_def take_zip[symmetric])
   apply (rule_tac list="zip xs ys" in list.induct)
    apply simp
   apply (clarsimp simp: split_def)
   apply (case_tac n, simp_all)
   done
 
 lemma word_rbl_mul_induct:
   "length xs \<le> size y \<Longrightarrow>
     rbl_mul xs (rev (to_bl y)) = take (length xs) (rev (to_bl (of_bl (rev xs) * y)))"
   for y :: "'a::len word"
 proof (induct xs)
   case Nil
   show ?case by (simp add: rbl_mul_simps)
 next
   case (Cons z zs)
 
   have rbl_word_plus': "to_bl (x + y) = rev (rbl_plus False (rev (to_bl x)) (rev (to_bl y)))"
     for x y :: "'a word"
     by (simp add: rbl_word_plus[symmetric])
 
   have mult_bit: "to_bl (of_bl [z] * y) = map ((\<and>) z) (to_bl y)"
     by (cases z) (simp cong: map_cong, simp add: map_replicate_const cong: map_cong)
 
   have shiftl: "of_bl xs * 2 * y = (of_bl xs * y) << 1" for xs
-    by (simp add: shiftl_t2n)
+    by (simp add: push_bit_eq_mult)
 
   have zip_take_triv: "\<And>xs ys n. n = length ys \<Longrightarrow> zip (take n xs) ys = zip xs ys"
     by (rule nth_equalityI) simp_all
 
   from Cons show ?case
     apply (simp add: trans [OF of_bl_append add.commute]
         rbl_mul_simps rbl_word_plus' distrib_right mult_bit shiftl rbl_shiftl)
     apply (simp add: takefill_alt word_size rev_map take_rbl_plus min_def)
-    apply (simp add: rbl_plus_def zip_take_triv)
+    apply (simp add: rbl_plus_def)
+    apply (simp add: zip_take_triv)
+    apply (simp only: mult.commute [of _ 2] mult.assoc bl_shiftl1)
+    apply (simp flip: butlast_rev add: take_butlast)
     done
 qed
 
 lemma rbl_word_mul: "rev (to_bl (x * y)) = rbl_mul (rev (to_bl x)) (rev (to_bl y))"
   for x :: "'a::len word"
   using word_rbl_mul_induct[where xs="rev (to_bl x)" and y=y] by (simp add: word_size)
 
 text \<open>Breaking up inequalities into bitlist properties.\<close>
 
 definition
   "rev_bl_order F xs ys =
      (length xs = length ys \<and>
        ((xs = ys \<and> F)
           \<or> (\<exists>n < length xs. drop (Suc n) xs = drop (Suc n) ys
                    \<and> \<not> xs ! n \<and> ys ! n)))"
 
 lemma rev_bl_order_simps:
   "rev_bl_order F [] [] = F"
   "rev_bl_order F (x # xs) (y # ys) = rev_bl_order ((y \<and> \<not> x) \<or> ((y \<or> \<not> x) \<and> F)) xs ys"
    apply (simp_all add: rev_bl_order_def)
   apply (rule conj_cong[OF refl])
   apply (cases "xs = ys")
    apply (simp add: nth_Cons')
    apply blast
   apply (simp add: nth_Cons')
   apply safe
    apply (rule_tac x="n - 1" in exI)
    apply simp
   apply (rule_tac x="Suc n" in exI)
   apply simp
   done
 
 lemma rev_bl_order_rev_simp:
   "length xs = length ys \<Longrightarrow>
    rev_bl_order F (xs @ [x]) (ys @ [y]) = ((y \<and> \<not> x) \<or> ((y \<or> \<not> x) \<and> rev_bl_order F xs ys))"
   by (induct arbitrary: F rule: list_induct2) (auto simp: rev_bl_order_simps)
 
 lemma rev_bl_order_bl_to_bin:
   "length xs = length ys \<Longrightarrow>
     rev_bl_order True xs ys = (bl_to_bin (rev xs) \<le> bl_to_bin (rev ys)) \<and>
     rev_bl_order False xs ys = (bl_to_bin (rev xs) < bl_to_bin (rev ys))"
   apply (induct xs ys rule: list_induct2)
    apply (simp_all add: rev_bl_order_simps bl_to_bin_app_cat concat_bit_Suc)
   apply (auto simp add: bl_to_bin_def add1_zle_eq)
   done
 
 lemma word_le_rbl: "x \<le> y \<longleftrightarrow> rev_bl_order True (rev (to_bl x)) (rev (to_bl y))"
   for x y :: "'a::len word"
   by (simp add: rev_bl_order_bl_to_bin word_le_def)
 
 lemma word_less_rbl: "x < y \<longleftrightarrow> rev_bl_order False (rev (to_bl x)) (rev (to_bl y))"
   for x y :: "'a::len word"
   by (simp add: word_less_alt rev_bl_order_bl_to_bin)
 
 definition "map_last f xs = (if xs = [] then [] else butlast xs @ [f (last xs)])"
 
 lemma map_last_simps:
   "map_last f [] = []"
   "map_last f [x] = [f x]"
   "map_last f (x # y # zs) = x # map_last f (y # zs)"
   by (simp_all add: map_last_def)
 
 lemma word_sle_rbl:
   "x <=s y \<longleftrightarrow> rev_bl_order True (map_last Not (rev (to_bl x))) (map_last Not (rev (to_bl y)))"
   using word_msb_alt[where w=x] word_msb_alt[where w=y]
   apply (simp add: word_sle_msb_le word_le_rbl)
   apply (subgoal_tac "length (to_bl x) = length (to_bl y)")
    apply (cases "to_bl x", simp)
    apply (cases "to_bl y", simp)
    apply (clarsimp simp: map_last_def rev_bl_order_rev_simp)
    apply auto
   done
 
 lemma word_sless_rbl:
   "x <s y \<longleftrightarrow> rev_bl_order False (map_last Not (rev (to_bl x))) (map_last Not (rev (to_bl y)))"
   using word_msb_alt[where w=x] word_msb_alt[where w=y]
   apply (simp add: word_sless_msb_less word_less_rbl)
   apply (subgoal_tac "length (to_bl x) = length (to_bl y)")
    apply (cases "to_bl x", simp)
    apply (cases "to_bl y", simp)
    apply (clarsimp simp: map_last_def rev_bl_order_rev_simp)
    apply auto
   done
 
 text \<open>Lemmas for unpacking \<^term>\<open>rev (to_bl n)\<close> for numerals n and also
   for irreducible values and expressions.\<close>
 
 lemma rev_bin_to_bl_simps:
   "rev (bin_to_bl 0 x) = []"
   "rev (bin_to_bl (Suc n) (numeral (num.Bit0 nm))) = False # rev (bin_to_bl n (numeral nm))"
   "rev (bin_to_bl (Suc n) (numeral (num.Bit1 nm))) = True # rev (bin_to_bl n (numeral nm))"
   "rev (bin_to_bl (Suc n) (numeral (num.One))) = True # replicate n False"
   "rev (bin_to_bl (Suc n) (- numeral (num.Bit0 nm))) = False # rev (bin_to_bl n (- numeral nm))"
   "rev (bin_to_bl (Suc n) (- numeral (num.Bit1 nm))) =
     True # rev (bin_to_bl n (- numeral (nm + num.One)))"
   "rev (bin_to_bl (Suc n) (- numeral (num.One))) = True # replicate n True"
   "rev (bin_to_bl (Suc n) (- numeral (num.Bit0 nm + num.One))) =
     True # rev (bin_to_bl n (- numeral (nm + num.One)))"
   "rev (bin_to_bl (Suc n) (- numeral (num.Bit1 nm + num.One))) =
     False # rev (bin_to_bl n (- numeral (nm + num.One)))"
   "rev (bin_to_bl (Suc n) (- numeral (num.One + num.One))) =
     False # rev (bin_to_bl n (- numeral num.One))"
   by (simp_all add: bin_to_bl_aux_append bin_to_bl_zero_aux bin_to_bl_minus1_aux replicate_append_same)
 
 lemma to_bl_upt: "to_bl x = rev (map (bit x) [0 ..< size x])"
   by (simp add: to_bl_eq_rev word_size rev_map)
 
 lemma rev_to_bl_upt: "rev (to_bl x) = map (bit x) [0 ..< size x]"
   by (simp add: to_bl_upt)
 
 lemma upt_eq_list_intros:
   "j \<le> i \<Longrightarrow> [i ..< j] = []"
   "i = x \<Longrightarrow> x < j \<Longrightarrow> [x + 1 ..< j] = xs \<Longrightarrow> [i ..< j] = (x # xs)"
   by (simp_all add: upt_eq_Cons_conv)
 
 
 subsection \<open>Tactic definition\<close>
 
 lemma if_bool_simps:
   "If p True y = (p \<or> y) \<and> If p False y = (\<not> p \<and> y) \<and>
     If p y True = (p \<longrightarrow> y) \<and> If p y False = (p \<and> y)"
   by auto
 
 ML \<open>
 structure Word_Bitwise_Tac =
 struct
 
 val word_ss = simpset_of \<^theory_context>\<open>Word\<close>;
 
 fun mk_nat_clist ns =
   fold_rev (Thm.mk_binop \<^cterm>\<open>Cons :: nat \<Rightarrow> _\<close>)
     ns \<^cterm>\<open>[] :: nat list\<close>;
 
 fun upt_conv ctxt ct =
   case Thm.term_of ct of
     (\<^const>\<open>upt\<close> $ n $ m) =>
       let
         val (i, j) = apply2 (snd o HOLogic.dest_number) (n, m);
         val ns = map (Numeral.mk_cnumber \<^ctyp>\<open>nat\<close>) (i upto (j - 1))
           |> mk_nat_clist;
         val prop =
           Thm.mk_binop \<^cterm>\<open>(=) :: nat list \<Rightarrow> _\<close> ct ns
           |> Thm.apply \<^cterm>\<open>Trueprop\<close>;
       in
         try (fn () =>
           Goal.prove_internal ctxt [] prop
             (K (REPEAT_DETERM (resolve_tac ctxt @{thms upt_eq_list_intros} 1
                 ORELSE simp_tac (put_simpset word_ss ctxt) 1))) |> mk_meta_eq) ()
       end
   | _ => NONE;
 
 val expand_upt_simproc =
   Simplifier.make_simproc \<^context> "expand_upt"
    {lhss = [\<^term>\<open>upt x y\<close>], proc = K upt_conv};
 
 fun word_len_simproc_fn ctxt ct =
   (case Thm.term_of ct of
     Const (\<^const_name>\<open>len_of\<close>, _) $ t =>
      (let
         val T = fastype_of t |> dest_Type |> snd |> the_single
         val n = Numeral.mk_cnumber \<^ctyp>\<open>nat\<close> (Word_Lib.dest_binT T);
         val prop =
           Thm.mk_binop \<^cterm>\<open>(=) :: nat \<Rightarrow> _\<close> ct n
           |> Thm.apply \<^cterm>\<open>Trueprop\<close>;
       in
         Goal.prove_internal ctxt [] prop (K (simp_tac (put_simpset word_ss ctxt) 1))
         |> mk_meta_eq |> SOME
       end handle TERM _ => NONE | TYPE _ => NONE)
   | _ => NONE);
 
 val word_len_simproc =
   Simplifier.make_simproc \<^context> "word_len"
    {lhss = [\<^term>\<open>len_of x\<close>], proc = K word_len_simproc_fn};
 
 (* convert 5 or nat 5 to Suc 4 when n_sucs = 1, Suc (Suc 4) when n_sucs = 2,
    or just 5 (discarding nat) when n_sucs = 0 *)
 
 fun nat_get_Suc_simproc_fn n_sucs ctxt ct =
   let
     val (f, arg) = dest_comb (Thm.term_of ct);
     val n =
       (case arg of \<^term>\<open>nat\<close> $ n => n | n => n)
       |> HOLogic.dest_number |> snd;
     val (i, j) = if n > n_sucs then (n_sucs, n - n_sucs) else (n, 0);
     val arg' = funpow i HOLogic.mk_Suc (HOLogic.mk_number \<^typ>\<open>nat\<close> j);
     val _ = if arg = arg' then raise TERM ("", []) else ();
     fun propfn g =
       HOLogic.mk_eq (g arg, g arg')
       |> HOLogic.mk_Trueprop |> Thm.cterm_of ctxt;
     val eq1 =
       Goal.prove_internal ctxt [] (propfn I)
         (K (simp_tac (put_simpset word_ss ctxt) 1));
   in
     Goal.prove_internal ctxt [] (propfn (curry (op $) f))
       (K (simp_tac (put_simpset HOL_ss ctxt addsimps [eq1]) 1))
     |> mk_meta_eq |> SOME
   end handle TERM _ => NONE;
 
 fun nat_get_Suc_simproc n_sucs ts =
   Simplifier.make_simproc \<^context> "nat_get_Suc"
    {lhss = map (fn t => t $ \<^term>\<open>n :: nat\<close>) ts,
     proc = K (nat_get_Suc_simproc_fn n_sucs)};
 
 val no_split_ss =
   simpset_of (put_simpset HOL_ss \<^context>
     |> Splitter.del_split @{thm if_split});
 
 val expand_word_eq_sss =
   (simpset_of (put_simpset HOL_basic_ss \<^context> addsimps
        @{thms word_eq_rbl_eq word_le_rbl word_less_rbl word_sle_rbl word_sless_rbl}),
   map simpset_of [
    put_simpset no_split_ss \<^context> addsimps
     @{thms rbl_word_plus rbl_word_and rbl_word_or rbl_word_not
                                 rbl_word_neg bl_word_sub rbl_word_xor
                                 rbl_word_cat rbl_word_slice rbl_word_scast
                                 rbl_word_ucast rbl_shiftl rbl_shiftr rbl_sshiftr
                                 rbl_word_if},
    put_simpset no_split_ss \<^context> addsimps
     @{thms to_bl_numeral to_bl_neg_numeral to_bl_0 rbl_word_1},
    put_simpset no_split_ss \<^context> addsimps
     @{thms rev_rev_ident rev_replicate rev_map to_bl_upt word_size}
           addsimprocs [word_len_simproc],
    put_simpset no_split_ss \<^context> addsimps
     @{thms list.simps split_conv replicate.simps list.map
                                 zip_Cons_Cons zip_Nil drop_Suc_Cons drop_0 drop_Nil
                                 foldr.simps list.map zip.simps(1) zip_Nil zip_Cons_Cons takefill_Suc_Cons
                                 takefill_Suc_Nil takefill.Z rbl_succ2_simps
                                 rbl_plus_simps rev_bin_to_bl_simps append.simps
                                 takefill_last_simps drop_nonempty_simps
                                 rev_bl_order_simps}
           addsimprocs [expand_upt_simproc,
                        nat_get_Suc_simproc 4
                          [\<^term>\<open>replicate\<close>, \<^term>\<open>takefill x\<close>,
                           \<^term>\<open>drop\<close>, \<^term>\<open>bin_to_bl\<close>,
                           \<^term>\<open>takefill_last x\<close>,
                           \<^term>\<open>drop_nonempty x\<close>]],
     put_simpset no_split_ss \<^context> addsimps @{thms xor3_simps carry_simps if_bool_simps}
   ])
 
 fun tac ctxt =
   let
     val (ss, sss) = expand_word_eq_sss;
   in
     foldr1 (op THEN_ALL_NEW)
       ((CHANGED o safe_full_simp_tac (put_simpset ss ctxt)) ::
         map (fn ss => safe_full_simp_tac (put_simpset ss ctxt)) sss)
   end;
 
 end
 \<close>
 
 method_setup word_bitwise =
   \<open>Scan.succeed (fn ctxt => Method.SIMPLE_METHOD (Word_Bitwise_Tac.tac ctxt 1))\<close>
   "decomposer for word equalities and inequalities into bit propositions"
 
 end
diff --git a/thys/Word_Lib/Generic_set_bit.thy b/thys/Word_Lib/Generic_set_bit.thy
--- a/thys/Word_Lib/Generic_set_bit.thy
+++ b/thys/Word_Lib/Generic_set_bit.thy
@@ -1,191 +1,191 @@
 (*
  * Copyright Data61, CSIRO (ABN 41 687 119 230)
  *
  * SPDX-License-Identifier: BSD-2-Clause
  *)
 
 (* Author: Jeremy Dawson, NICTA *)
 
 section \<open>Operation variant for setting and unsetting bits\<close>
 
 theory Generic_set_bit
   imports
     "HOL-Library.Word"
     Bits_Int
     Most_significant_bit
 begin
 
 class set_bit = semiring_bits +
   fixes set_bit :: \<open>'a \<Rightarrow> nat \<Rightarrow> bool \<Rightarrow> 'a\<close>
   assumes bit_set_bit_iff [bit_simps]:
     \<open>bit (set_bit a m b) n \<longleftrightarrow>
       (if m = n then b else bit a n) \<and> 2 ^ n \<noteq> 0\<close>
 
 lemma set_bit_eq:
   \<open>set_bit a n b = (if b then Bit_Operations.set_bit else unset_bit) n a\<close>
   for a :: \<open>'a::{ring_bit_operations, set_bit}\<close>
   by (rule bit_eqI) (simp add: bit_simps)
 
 instantiation int :: set_bit
 begin
 
 definition set_bit_int :: \<open>int \<Rightarrow> nat \<Rightarrow> bool \<Rightarrow> int\<close>
   where \<open>set_bit i n b = bin_sc n b i\<close>
 
 instance
   by standard
     (simp_all add: set_bit_int_def bin_nth_sc_gen bit_simps)
 
 end
 
 lemma int_set_bit_0 [simp]: fixes x :: int shows
   "set_bit x 0 b = of_bool b + 2 * (x div 2)"
   by (auto simp add: set_bit_int_def intro: bin_rl_eqI)
 
 lemma int_set_bit_Suc: fixes x :: int shows
   "set_bit x (Suc n) b = of_bool (odd x) + 2 * set_bit (x div 2) n b"
   by (auto simp add: set_bit_int_def intro: bin_rl_eqI)
 
 lemma bin_last_set_bit:
   "odd (set_bit x n b :: int) = (if n > 0 then odd x else b)"
   by (cases n) (simp_all add: int_set_bit_Suc)
 
 lemma bin_rest_set_bit:
   "(set_bit x n b :: int) div 2 = (if n > 0 then set_bit (x div 2) (n - 1) b else x div 2)"
   by (cases n) (simp_all add: int_set_bit_Suc)
 
 lemma int_set_bit_numeral: fixes x :: int shows
   "set_bit x (numeral w) b = of_bool (odd x) + 2 * set_bit (x div 2) (pred_numeral w) b"
   by (simp add: set_bit_int_def)
 
 lemmas int_set_bit_numerals [simp] =
   int_set_bit_numeral[where x="numeral w'"]
   int_set_bit_numeral[where x="- numeral w'"]
   int_set_bit_numeral[where x="Numeral1"]
   int_set_bit_numeral[where x="1"]
   int_set_bit_numeral[where x="0"]
   int_set_bit_Suc[where x="numeral w'"]
   int_set_bit_Suc[where x="- numeral w'"]
   int_set_bit_Suc[where x="Numeral1"]
   int_set_bit_Suc[where x="1"]
   int_set_bit_Suc[where x="0"]
   for w'
 
 lemma msb_set_bit [simp]: "msb (set_bit (x :: int) n b) \<longleftrightarrow> msb x"
 by(simp add: msb_conv_bin_sign set_bit_int_def)
 
 instantiation word :: (len) set_bit
 begin
 
 definition set_bit_word :: \<open>'a word \<Rightarrow> nat \<Rightarrow> bool \<Rightarrow> 'a word\<close>
   where word_set_bit_def: \<open>set_bit a n x = word_of_int (bin_sc n x (uint a))\<close>
 
 instance
   by standard
     (auto simp add: word_set_bit_def bin_nth_sc_gen bit_simps)
 
 end
 
 lemma set_bit_unfold:
   \<open>set_bit w n b = (if b then Bit_Operations.set_bit n w else unset_bit n w)\<close>
   for w :: \<open>'a::len word\<close>
   by (simp add: set_bit_eq)
 
 lemma bit_set_bit_word_iff [bit_simps]:
   \<open>bit (set_bit w m b) n \<longleftrightarrow> (if m = n then n < LENGTH('a) \<and> b else bit w n)\<close>
   for w :: \<open>'a::len word\<close>
   by (auto simp add: bit_simps dest: bit_imp_le_length)
 
 lemma word_set_nth: "set_bit w n (bit w n) = w"
   for w :: "'a::len word"
   by (auto simp: word_test_bit_def word_set_bit_def)
 
 lemma test_bit_set: "bit (set_bit w n x) n \<longleftrightarrow> n < size w \<and> x"
   for w :: "'a::len word"
-  by (auto simp: word_size word_test_bit_def word_set_bit_def nth_bintr)
+  by (auto simp add: bit_simps word_size)
 
 lemma test_bit_set_gen:
   "bit (set_bit w n x) m = (if m = n then n < size w \<and> x else bit w m)"
   for w :: "'a::len word"
   apply (unfold word_size word_test_bit_def word_set_bit_def)
   apply (clarsimp simp add: nth_bintr bin_nth_sc_gen)
   apply (auto elim!: test_bit_size [unfolded word_size]
       simp add: word_test_bit_def [symmetric])
   done
 
 lemma word_set_set_same [simp]: "set_bit (set_bit w n x) n y = set_bit w n y"
   for w :: "'a::len word"
   by (rule word_eqI) (simp add : test_bit_set_gen word_size)
 
 lemma word_set_set_diff:
   fixes w :: "'a::len word"
   assumes "m \<noteq> n"
   shows "set_bit (set_bit w m x) n y = set_bit (set_bit w n y) m x"
   by (rule word_eqI) (auto simp: test_bit_set_gen word_size assms)
 
 lemma set_bit_word_of_int: "set_bit (word_of_int x) n b = word_of_int (bin_sc n b x)"
   unfolding word_set_bit_def
   by (rule word_eqI) (simp add: word_size bin_nth_sc_gen nth_bintr bit_simps)
 
 lemma word_set_numeral [simp]:
   "set_bit (numeral bin::'a::len word) n b =
     word_of_int (bin_sc n b (numeral bin))"
   unfolding word_numeral_alt by (rule set_bit_word_of_int)
 
 lemma word_set_neg_numeral [simp]:
   "set_bit (- numeral bin::'a::len word) n b =
     word_of_int (bin_sc n b (- numeral bin))"
   unfolding word_neg_numeral_alt by (rule set_bit_word_of_int)
 
 lemma word_set_bit_0 [simp]: "set_bit 0 n b = word_of_int (bin_sc n b 0)"
   unfolding word_0_wi by (rule set_bit_word_of_int)
 
 lemma word_set_bit_1 [simp]: "set_bit 1 n b = word_of_int (bin_sc n b 1)"
   unfolding word_1_wi by (rule set_bit_word_of_int)
 
 lemma word_set_nth_iff: "set_bit w n b = w \<longleftrightarrow> bit w n = b \<or> n \<ge> size w"
   for w :: "'a::len word"
   apply (rule iffI)
    apply (rule disjCI)
    apply (drule word_eqD)
    apply (erule sym [THEN trans])
    apply (simp add: test_bit_set)
   apply (erule disjE)
    apply clarsimp
   apply (rule word_eqI)
    apply (clarsimp simp add : test_bit_set_gen)
    apply (auto simp add: word_size)
   apply (rule bit_eqI)
   apply (simp add: bit_simps)
   done
 
 lemma word_clr_le: "w \<ge> set_bit w n False"
   for w :: "'a::len word"
   apply (simp add: word_set_bit_def word_le_def)
   apply transfer
   apply (rule order_trans)
    apply (rule bintr_bin_clr_le)
   apply simp
   done
 
 lemma word_set_ge: "w \<le> set_bit w n True"
   for w :: "'a::len word"
   apply (simp add: word_set_bit_def word_le_def)
   apply transfer
   apply (rule order_trans [OF _ bintr_bin_set_ge])
   apply simp
   done
 
 lemma set_bit_beyond:
   "size x \<le> n \<Longrightarrow> set_bit x n b = x" for x :: "'a :: len word"
   by (simp add: word_set_nth_iff)
 
-lemma one_bit_shiftl: "set_bit 0 n True = (1 :: 'a :: len word) << n"
+lemma one_bit_shiftl: "set_bit 0 n True = push_bit n (1 :: 'a :: len word)"
   apply (rule word_eqI)
-  apply (auto simp add: nth_shiftl word_size bit_simps
-              simp del: word_set_bit_0 shiftl_1)
+  apply (auto simp add: word_size bit_simps
+              simp del: word_set_bit_0)
   done
 
-lemmas one_bit_pow = trans [OF one_bit_shiftl shiftl_1]
+lemmas one_bit_pow = trans [OF one_bit_shiftl push_bit_of_1]
 
 end
diff --git a/thys/Word_Lib/Guide.thy b/thys/Word_Lib/Guide.thy
--- a/thys/Word_Lib/Guide.thy
+++ b/thys/Word_Lib/Guide.thy
@@ -1,389 +1,411 @@
 (*
  * Copyright Florian Haftmann
  *
  * SPDX-License-Identifier: BSD-2-Clause
  *)
 
 (*<*)
 theory Guide
   imports Word_Lib_Sumo Word_64 Ancient_Numeral
 begin
 
-hide_const (open) Generic_set_bit.set_bit
+notation (output)  push_bit (\<open>push'_bit\<close>)
+
+notation (output)  drop_bit (\<open>drop'_bit\<close>)
+
+notation (output)  signed_drop_bit (\<open>signed'_drop'_bit\<close>)
+
+notation (output)  Generic_set_bit.set_bit (\<open>Generic'_set'_bit.set'_bit\<close>)
+
+hide_const (open) Generic_set_bit.set_bit push_bit drop_bit signed_drop_bit
+
+no_notation bit  (infixl \<open>!!\<close> 100)
+
+abbreviation \<open>push_bit n a \<equiv> a << n\<close>
+
+abbreviation \<open>drop_bit n a \<equiv> a >> n\<close>
+
+abbreviation \<open>signed_drop_bit n a \<equiv> a >>> n\<close>
 
 (*>*)
 section \<open>A short overview over bit operations and word types\<close>
 
 subsection \<open>Basic theories and key ideas\<close>
 
 text \<open>
   When formalizing bit operations, it is tempting to represent
   bit values as explicit lists over a binary type. This however
   is a bad idea, mainly due to the inherent ambiguities in
   representation concerning repeating leading bits.
 
   Hence this approach avoids such explicit lists altogether
   following an algebraic path:
 
     \<^item> Bit values are represented by numeric types: idealized
       unbounded bit values can be represented by type \<^typ>\<open>int\<close>,
       bounded bit values by quotient types over \<^typ>\<open>int\<close>, aka \<^typ>\<open>'a word\<close>.
 
     \<^item> (A special case are idealized unbounded bit values ending
       in @{term [source] 0} which can be represented by type \<^typ>\<open>nat\<close> but
       only support a restricted set of operations).
 
   The most fundamental ideas are developed in theory \<^theory>\<open>HOL.Parity\<close>
   (which is part of \<^theory>\<open>Main\<close>):
 
     \<^item> Multiplication by \<^term>\<open>2 :: int\<close> is a bit shift to the left and
 
     \<^item> Division by \<^term>\<open>2 :: int\<close> is a bit shift to the right.
 
     \<^item> Concerning bounded bit values, iterated shifts to the left
     may result in eliminating all bits by shifting them all
     beyond the boundary.  The property \<^prop>\<open>(2 :: int) ^ n \<noteq> 0\<close>
     represents that \<^term>\<open>n\<close> is \<^emph>\<open>not\<close> beyond that boundary.
 
     \<^item> The projection on a single bit is then @{thm [mode=iff] bit_iff_odd [where ?'a = int, no_vars]}.
 
     \<^item> This leads to the most fundamental properties of bit values:
 
       \<^item> Equality rule: @{thm [display, mode=iff] bit_eq_iff [where ?'a = int, no_vars]}
 
       \<^item> Induction rule: @{thm [display, mode=iff] bits_induct [where ?'a = int, no_vars]}
 
-    \<^item> Characteristic properties \<^prop>\<open>bit (f x) n \<longleftrightarrow> P x n\<close>
+    \<^item> Characteristic properties @{prop [source] \<open>bit (f x) n \<longleftrightarrow> P x n\<close>}
       are available in fact collection \<^text>\<open>bit_simps\<close>.
 
   On top of this, the following generic operations are provided
   after import of theory \<^theory>\<open>HOL-Library.Bit_Operations\<close>:
 
     \<^item> Singleton \<^term>\<open>n\<close>th bit: \<^term>\<open>(2 :: int) ^ n\<close>
 
     \<^item> Bit mask upto bit \<^term>\<open>n\<close>: @{thm mask_eq_exp_minus_1 [where ?'a = int, no_vars]}
 
     \<^item> Left shift: @{thm push_bit_eq_mult [where ?'a = int, no_vars]}
 
     \<^item> Right shift: @{thm drop_bit_eq_div [where ?'a = int, no_vars]}
 
     \<^item> Truncation: @{thm take_bit_eq_mod [where ?'a = int, no_vars]}
 
     \<^item> Bitwise negation: @{thm [mode=iff] bit_not_iff [where ?'a = int, no_vars]}
 
     \<^item> Bitwise conjunction: @{thm [mode=iff] bit_and_iff [where ?'a = int, no_vars]}
 
     \<^item> Bitwise disjunction: @{thm [mode=iff] bit_or_iff [where ?'a = int, no_vars]}
 
     \<^item> Bitwise exclusive disjunction: @{thm [mode=iff] bit_xor_iff [where ?'a = int, no_vars]}
 
     \<^item> Setting a single bit: @{thm set_bit_def [where ?'a = int, no_vars]}
 
     \<^item> Unsetting a single bit: @{thm unset_bit_def [where ?'a = int, no_vars]}
 
     \<^item> Flipping a single bit: @{thm flip_bit_def [where ?'a = int, no_vars]}
 
     \<^item> Signed truncation, or modulus centered around \<^term>\<open>0::int\<close>:
         @{thm [display] signed_take_bit_def [where ?'a = int, no_vars]}
 
     \<^item> (Bounded) conversion from and to a list of bits:
         @{thm [display] horner_sum_bit_eq_take_bit [where ?'a = int, no_vars]}
 
   Bit concatenation on \<^typ>\<open>int\<close> as given by 
     @{thm [display] concat_bit_def [no_vars]}
   appears quite
   technical but is the logical foundation for the quite natural bit concatenation
   on \<^typ>\<open>'a word\<close> (see below).
   
   Proper word types are introduced in theory \<^theory>\<open>HOL-Library.Word\<close>, with
   the following specific operations:
 
     \<^item> Standard arithmetic:
         @{term \<open>(+) :: 'a::len word \<Rightarrow> 'a word \<Rightarrow> 'a word\<close>},
         @{term \<open>uminus :: 'a::len word \<Rightarrow> 'a word\<close>},
         @{term \<open>(-) :: 'a::len word \<Rightarrow> 'a word \<Rightarrow> 'a word\<close>},
         @{term \<open>(*) :: 'a::len word \<Rightarrow> 'a word \<Rightarrow> 'a word\<close>},
         @{term \<open>0 :: 'a::len word\<close>}, @{term \<open>1 :: 'a::len word\<close>}, numerals etc.
 
     \<^item> Standard bit operations: see above.
 
     \<^item> Conversion with unsigned interpretation of words:
 
         \<^item> @{term [source] \<open>unsigned :: 'a::len word \<Rightarrow> 'b::semiring_1\<close>}
 
         \<^item> Important special cases as abbreviations:
 
             \<^item> @{term [source] \<open>unat :: 'a::len word \<Rightarrow> nat\<close>}
 
             \<^item> @{term [source] \<open>uint :: 'a::len word \<Rightarrow> int\<close>}
 
             \<^item> @{term [source] \<open>ucast :: 'a::len word \<Rightarrow> 'b::len word\<close>}
 
     \<^item> Conversion with signed interpretation of words:
 
         \<^item> @{term [source] \<open>signed :: 'a::len word \<Rightarrow> 'b::ring_1\<close>}
 
         \<^item> Important special cases as abbreviations:
 
             \<^item> @{term [source] \<open>sint :: 'a::len word \<Rightarrow> int\<close>}
 
             \<^item> @{term [source] \<open>scast :: 'a::len word \<Rightarrow> 'b::len word\<close>}
 
     \<^item> Operations with unsigned interpretation of words:
 
         \<^item> @{thm [mode=iff] word_le_nat_alt [no_vars]}
 
         \<^item> @{thm [mode=iff] word_less_nat_alt [no_vars]}
 
         \<^item> @{thm unat_div_distrib [no_vars]}
 
         \<^item> @{thm unat_drop_bit_eq [no_vars]}
 
         \<^item> @{thm unat_mod_distrib [no_vars]}
 
         \<^item> @{thm [mode=iff] udvd_iff_dvd [no_vars]}
 
     \<^item> Operations with signed interpretation of words:
 
         \<^item> @{thm [mode=iff] word_sle_eq [no_vars]}
 
         \<^item> @{thm [mode=iff] word_sless_alt [no_vars]}
 
         \<^item> @{thm sint_signed_drop_bit_eq [no_vars]}
 
     \<^item> Rotation and reversal:
 
         \<^item> @{term [source] \<open>word_rotl :: nat \<Rightarrow> 'a::len word \<Rightarrow> 'a word\<close>}
 
         \<^item> @{term [source] \<open>word_rotr :: nat \<Rightarrow> 'a::len word \<Rightarrow> 'a word\<close>}
 
         \<^item> @{term [source] \<open>word_roti :: int \<Rightarrow> 'a::len word \<Rightarrow> 'a word\<close>}
 
         \<^item> @{term [source] \<open>word_reverse :: 'a::len word \<Rightarrow> 'a word\<close>}
 
     \<^item> Concatenation: @{term [source, display] \<open>word_cat :: 'a::len word \<Rightarrow> 'b::len word \<Rightarrow> 'c::len word\<close>}
 
   For proofs about words the following default strategies are applicable:
 
     \<^item> Using bit extensionality (facts \<^text>\<open>bit_eq_iff\<close>, \<^text>\<open>bit_eqI\<close>; fact
       collection \<^text>\<open>bit_simps\<close>).
 
     \<^item> Using the @{method transfer} method.
 \<close>
 
 subsection \<open>More library theories\<close>
 
 text \<open>
   Note: currently, the theories listed here are hardly separate
   entities since they import each other in various ways.
   Always inspect them to understand what you pull in if you
   want to import one.
 
     \<^descr>[Syntax]
 
       \<^descr>[\<^theory>\<open>Word_Lib.Syntax_Bundles\<close>]
-        Bundles to provide alternative syntax for various bit operations
+        Bundles to provide alternative syntax for various bit operations.
 
       \<^descr>[\<^theory>\<open>Word_Lib.Hex_Words\<close>]
         Printing word numerals as hexadecimal numerals.
 
       \<^descr>[\<^theory>\<open>Word_Lib.Type_Syntax\<close>]
         Pretty type-sensitive syntax for cast operations.
 
       \<^descr>[\<^theory>\<open>Word_Lib.Word_Syntax\<close>]
         Specific ASCII syntax for prominent bit operations on word.
 
     \<^descr>[Proof tools]
 
       \<^descr>[\<^theory>\<open>Word_Lib.Norm_Words\<close>]
         Rewriting word numerals to normal forms.
 
       \<^descr>[\<^theory>\<open>Word_Lib.Bitwise\<close>]
         Method @{method word_bitwise} decomposes word equalities and inequalities into bit propositions.
 
       \<^descr>[\<^theory>\<open>Word_Lib.Word_EqI\<close>]
         Method @{method word_eqI_solve} decomposes word equalities and inequalities into bit propositions.
 
     \<^descr>[Operations]
 
       \<^descr>[\<^theory>\<open>Word_Lib.Signed_Division_Word\<close>]
 
         Signed division on word:
 
           \<^item> @{term [source] \<open>(sdiv) :: 'a::len word \<Rightarrow> 'a word \<Rightarrow> 'a word\<close>}
 
           \<^item> @{term [source] \<open>(smod) :: 'a::len word \<Rightarrow> 'a word \<Rightarrow> 'a word\<close>}
 
       \<^descr>[\<^theory>\<open>Word_Lib.Aligned\<close>] \
 
           \<^item> @{thm [mode=iff] is_aligned_iff_udvd [no_vars]}
 
       \<^descr>[\<^theory>\<open>Word_Lib.Least_significant_bit\<close>]
 
         The least significant bit as an alias:
         @{thm [mode=iff] lsb_odd [where ?'a = int, no_vars]}
 
       \<^descr>[\<^theory>\<open>Word_Lib.Most_significant_bit\<close>]
 
         The most significant bit:
 
           \<^item> @{thm [mode=iff] msb_int_def [of k]}
 
           \<^item> @{thm [mode=iff] word_msb_sint [no_vars]}
 
           \<^item> @{thm [mode=iff] msb_word_iff_sless_0 [no_vars]}
 
           \<^item> @{thm [mode=iff] msb_word_iff_bit [no_vars]}
 
-      \<^descr>[\<^theory>\<open>Word_Lib.Traditional_Infix_Syntax\<close>]
-
-        Clones of existing operations decorated with
-        traditional syntax:
+      \<^descr>[\<^theory>\<open>Word_Lib.Bit_Shifts_Infix_Syntax\<close>]
 
-          \<^item> @{thm shiftl_eq_push_bit [no_vars]}
+        Abbreviations for bit shifts decorated with
+        traditional infix syntax:
 
-          \<^item> @{thm shiftr_eq_drop_bit [no_vars]}
+          \<^item> @{abbrev shiftl}
 
-          \<^item> @{thm sshiftr_eq [no_vars]}
+          \<^item> @{abbrev shiftr}
+
+          \<^item> @{abbrev sshiftr}
 
       \<^descr>[\<^theory>\<open>Word_Lib.Next_and_Prev\<close>] \
 
           \<^item> @{thm word_next_unfold [no_vars]}
 
           \<^item> @{thm word_prev_unfold [no_vars]}
 
       \<^descr>[\<^theory>\<open>Word_Lib.Enumeration_Word\<close>]
 
         More on explicit enumeration of word types.
 
       \<^descr>[\<^theory>\<open>Word_Lib.More_Word_Operations\<close>]
 
         Even more operations on word.
 
     \<^descr>[Types]
 
       \<^descr>[\<^theory>\<open>Word_Lib.Signed_Words\<close>]
 
           Formal tagging of word types with a \<^text>\<open>signed\<close> marker.
 
     \<^descr>[Lemmas]
 
       \<^descr>[\<^theory>\<open>Word_Lib.More_Word\<close>]
 
           More lemmas on words.
 
       \<^descr>[\<^theory>\<open>Word_Lib.Word_Lemmas\<close>]
 
           More lemmas on words, covering many other theories mentioned here.
 
     \<^descr>[Words of popular lengths].
 
       \<^descr>[\<^theory>\<open>Word_Lib.Word_8\<close>]
 
           for 8-bit words.
 
       \<^descr>[\<^theory>\<open>Word_Lib.Word_16\<close>]
 
           for 16-bit words.
 
       \<^descr>[\<^theory>\<open>Word_Lib.Word_32\<close>]
 
           for 32-bit words.
 
       \<^descr>[\<^theory>\<open>Word_Lib.Word_64\<close>]
 
           for 64-bit words. This theory is not part of \<^text>\<open>Word_Lib_Sumo\<close>, because it shadows
           names from \<^theory>\<open>Word_Lib.Word_32\<close>. They can be used together, but then require
           to use qualified names in applications.
 \<close>
 
 
 subsection \<open>More library sessions\<close>
 
 text \<open>
   \<^descr>[\<^text>\<open>Native_Word\<close>] Makes machine words and machine arithmetic available for code generation.
   It provides a common abstraction that hides the differences between the different target languages.
   The code generator maps these operations to the APIs of the target languages.
 \<close>
 
 subsection \<open>Legacy theories\<close>
 
 text \<open>
   The following theories contain material which has been
   factored out since it is not recommended to use it in
   new applications, mostly because matters can be expressed
   succinctly using already existing operations.
 
   This section gives some indication how to migrate away
   from those theories.  However theorem coverage may still
   be terse in some cases.
 
   \<^descr>[\<^theory>\<open>Word_Lib.Word_Lib_Sumo\<close>]
 
     An entry point importing any relevant theory in that session.  Intended
     for backward compatibility: start importing this theory when
     migrating applications to Isabelle2021, and later sort out
     what you really need. You may need to include
    \<^theory>\<open>Word_Lib.Word_64\<close> separately.
 
   \<^descr>[\<^theory>\<open>Word_Lib.Generic_set_bit\<close>]
 
     Kind of an alias: @{thm set_bit_eq [no_vars]}
 
   \<^descr>[\<^theory>\<open>Word_Lib.Typedef_Morphisms\<close>]
 
     A low-level extension to HOL typedef providing
     conversions along type morphisms.  The @{method transfer} method
     seems to be sufficient for most applications though.
 
   \<^descr>[\<^theory>\<open>Word_Lib.Bit_Comprehension\<close>]
 
     Comprehension syntax for bit values over predicates
     \<^typ>\<open>nat \<Rightarrow> bool\<close>.  For \<^typ>\<open>'a::len word\<close>, straightforward
     alternatives exist; difficult to handle for \<^typ>\<open>int\<close>.
 
   \<^descr>[\<^theory>\<open>Word_Lib.Reversed_Bit_Lists\<close>]
 
     Representation of bit values as explicit list in
     \<^emph>\<open>reversed\<close> order.
 
     This should rarely be necessary: the \<^const>\<open>bit\<close> projection
     should be sufficient in most cases.  In case explicit lists
     are needed, existing operations can be used:
 
     @{thm [display] horner_sum_bit_eq_take_bit [where ?'a = int, no_vars]}
 
   \<^descr>[\<^theory>\<open>Word_Lib.Many_More\<close>]
 
     Collection of operations and theorems which are kept for backward
     compatibility and not used in other theories in session \<^text>\<open>Word_Lib\<close>.
     They are used in applications of \<^text>\<open>Word_Lib\<close>, but should be migrated to there.
 \<close>
 
 section \<open>Changelog\<close>
 
 text \<open>
   \<^descr>[Changes since AFP 2021] ~
 
     \<^item> Theory \<^theory>\<open>Word_Lib.Ancient_Numeral\<close> is no part of \<^theory>\<open>Word_Lib.Word_Lib_Sumo\<close>
       any longer.
 
     \<^item> Abbreviation \<^abbrev>\<open>max_word\<close> moved from distribution into theory
       \<^theory>\<open>Word_Lib.Legacy_Aliases\<close>.
 
+    \<^item> Operation \<^const>\<open>test_bit\<close> replaced by input abbreviation \<^abbrev>\<open>test_bit\<close>.
+
+    \<^item> Operation \<^const>\<open>shiftl\<close> replaced by input abbreviation \<^abbrev>\<open>shiftl\<close>.
+
+    \<^item> Operation \<^const>\<open>shiftr\<close> replaced by input abbreviation \<^abbrev>\<open>shiftr\<close>.
+
+    \<^item> Operation \<^const>\<open>sshiftr\<close> replaced by input abbreviation \<^abbrev>\<open>sshiftr\<close>.
+
     \<^item> Abbreviations \<^abbrev>\<open>bin_nth\<close>, \<^abbrev>\<open>bin_last\<close>, \<^abbrev>\<open>bin_rest\<close>,
       \<^abbrev>\<open>bintrunc\<close>, \<^abbrev>\<open>sbintrunc\<close>, \<^abbrev>\<open>norm_sint\<close>,
       \<^abbrev>\<open>bin_cat\<close> moved into theory \<^theory>\<open>Word_Lib.Legacy_Aliases\<close>.
 
     \<^item> Operations \<^abbrev>\<open>shiftl1\<close>, \<^abbrev>\<open>shiftr1\<close>, \<^abbrev>\<open>sshiftr1\<close>, \<^abbrev>\<open>bshiftr1\<close>,
       \<^abbrev>\<open>setBit\<close>, \<^abbrev>\<open>clearBit\<close> moved from distribution into theory
       \<^theory>\<open>Word_Lib.Legacy_Aliases\<close> and replaced by input abbreviations.
 
-    \<^item> Operation \<^const>\<open>test_bit\<close> replaced by input abbreviation \<^abbrev>\<open>test_bit\<close>.
-
     \<^item> Operation \<^const>\<open>complement\<close> replaced by input abbreviation \<^abbrev>\<open>complement\<close>.
 \<close>
 
 (*<*)
 end
 (*>*)
diff --git a/thys/Word_Lib/Least_significant_bit.thy b/thys/Word_Lib/Least_significant_bit.thy
--- a/thys/Word_Lib/Least_significant_bit.thy
+++ b/thys/Word_Lib/Least_significant_bit.thy
@@ -1,94 +1,95 @@
 (*
  * Copyright Data61, CSIRO (ABN 41 687 119 230)
  *
  * SPDX-License-Identifier: BSD-2-Clause
  *)
 
 (* Author: Jeremy Dawson, NICTA *)
 
 section \<open>Operation variant for the least significant bit\<close>
 
 theory Least_significant_bit
   imports
     "HOL-Library.Word"
     Bits_Int
+    More_Word
 begin
 
 class lsb = semiring_bits +
   fixes lsb :: \<open>'a \<Rightarrow> bool\<close>
   assumes lsb_odd: \<open>lsb = odd\<close>
 
 instantiation int :: lsb
 begin
 
 definition lsb_int :: \<open>int \<Rightarrow> bool\<close>
   where \<open>lsb i = bit i 0\<close> for i :: int
 
 instance
   by standard (simp add: fun_eq_iff lsb_int_def)
 
 end
 
 lemma bin_last_conv_lsb: "odd = (lsb :: int \<Rightarrow> bool)"
   by (simp add: lsb_odd)
 
 lemma int_lsb_numeral [simp]:
   "lsb (0 :: int) = False"
   "lsb (1 :: int) = True"
   "lsb (Numeral1 :: int) = True"
   "lsb (- 1 :: int) = True"
   "lsb (- Numeral1 :: int) = True"
   "lsb (numeral (num.Bit0 w) :: int) = False"
   "lsb (numeral (num.Bit1 w) :: int) = True"
   "lsb (- numeral (num.Bit0 w) :: int) = False"
   "lsb (- numeral (num.Bit1 w) :: int) = True"
   by (simp_all add: lsb_int_def)
 
 instantiation word :: (len) lsb
 begin
 
 definition lsb_word :: \<open>'a word \<Rightarrow> bool\<close>
   where word_lsb_def: \<open>lsb a \<longleftrightarrow> odd (uint a)\<close> for a :: \<open>'a word\<close>
 
 instance
   apply standard
   apply (simp add: fun_eq_iff word_lsb_def)
   apply transfer apply simp
   done
 
 end
 
 lemma lsb_word_eq:
   \<open>lsb = (odd :: 'a word \<Rightarrow> bool)\<close> for w :: \<open>'a::len word\<close>
   by (fact lsb_odd)
 
 lemma word_lsb_alt: "lsb w = bit w 0"
   for w :: "'a::len word"
-  by (auto simp: word_test_bit_def word_lsb_def)
+  by (simp add: lsb_word_eq)
 
 lemma word_lsb_1_0 [simp]: "lsb (1::'a::len word) \<and> \<not> lsb (0::'b::len word)"
   unfolding word_lsb_def by simp
 
 lemma word_lsb_int: "lsb w \<longleftrightarrow> uint w mod 2 = 1"
   apply (simp add: lsb_odd flip: odd_iff_mod_2_eq_one)
   apply transfer
   apply simp
   done
 
 lemmas word_ops_lsb = lsb0 [unfolded word_lsb_alt]
 
 lemma word_lsb_numeral [simp]:
   "lsb (numeral bin :: 'a::len word) \<longleftrightarrow> odd (numeral bin :: int)"
   by (simp only: lsb_odd, transfer) rule
 
 lemma word_lsb_neg_numeral [simp]:
   "lsb (- numeral bin :: 'a::len word) \<longleftrightarrow> odd (- numeral bin :: int)"
   by (simp only: lsb_odd, transfer) rule
 
 lemma word_lsb_nat:"lsb w = (unat w mod 2 = 1)"
   apply (simp add: word_lsb_def Groebner_Basis.algebra(31))
   apply transfer
   apply (simp add: even_nat_iff)
   done
 
 end
diff --git a/thys/Word_Lib/More_Arithmetic.thy b/thys/Word_Lib/More_Arithmetic.thy
--- a/thys/Word_Lib/More_Arithmetic.thy
+++ b/thys/Word_Lib/More_Arithmetic.thy
@@ -1,141 +1,141 @@
 (*
  * Copyright Data61, CSIRO (ABN 41 687 119 230)
  *
  * SPDX-License-Identifier: BSD-2-Clause
  *)
 
 section \<open>Arithmetic lemmas\<close>
 
 theory More_Arithmetic
   imports Main "HOL-Library.Type_Length" "HOL-Library.Bit_Operations"
 begin
 
 declare iszero_0 [intro]
 
-declare min.absorb1 [simp] min.absorb2 [simp]
+declare min.absorb1 [simp] min.absorb2 [simp] \<comment> \<open>TODO: consider for move to distro; and the same also for max\<close>
 
 lemma n_less_equal_power_2 [simp]:
   "n < 2 ^ n"
   by (fact less_exp)
 
 lemma min_pm [simp]: "min a b + (a - b) = a"
   for a b :: nat
   by arith
 
 lemma min_pm1 [simp]: "a - b + min a b = a"
   for a b :: nat
   by arith
 
 lemma rev_min_pm [simp]: "min b a + (a - b) = a"
   for a b :: nat
   by arith
 
 lemma rev_min_pm1 [simp]: "a - b + min b a = a"
   for a b :: nat
   by arith
 
 lemma min_minus [simp]: "min m (m - k) = m - k"
   for m k :: nat
   by arith
 
 lemma min_minus' [simp]: "min (m - k) m = m - k"
   for m k :: nat
   by arith
 
 lemma nat_less_power_trans:
   fixes n :: nat
   assumes nv: "n < 2 ^ (m - k)"
   and     kv: "k \<le> m"
   shows "2 ^ k * n < 2 ^ m"
 proof (rule order_less_le_trans)
   show "2 ^ k * n < 2 ^ k * 2 ^ (m - k)"
     by (rule mult_less_mono2 [OF nv zero_less_power]) simp
   show "(2::nat) ^ k * 2 ^ (m - k) \<le> 2 ^ m" using nv kv
     by (subst power_add [symmetric]) simp
 qed
 
 lemma nat_le_power_trans:
   fixes n :: nat
   shows "\<lbrakk>n \<le> 2 ^ (m - k); k \<le> m\<rbrakk> \<Longrightarrow> 2 ^ k * n \<le> 2 ^ m"
   by (metis le_add_diff_inverse mult_le_mono2 semiring_normalization_rules(26))
 
 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 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 power_2_mult_step_le:
   "\<lbrakk>n' \<le> n; 2 ^ n' * k' < 2 ^ n * k\<rbrakk> \<Longrightarrow> 2 ^ n' * (k' + 1) \<le> 2 ^ n * (k::nat)"
   apply (cases "n'=n", simp)
    apply (metis Suc_leI le_refl mult_Suc_right mult_le_mono semiring_normalization_rules(7))
   apply (drule (1) le_neq_trans)
   apply clarsimp
   apply (subgoal_tac "\<exists>m. n = n' + m")
    prefer 2
    apply (simp add: le_Suc_ex)
   apply (clarsimp simp: power_add)
   apply (metis Suc_leI mult.assoc mult_Suc_right nat_mult_le_cancel_disj)
   done
 
 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 diff_diff_less:
   "(i < m - (m - (n :: nat))) = (i < m \<and> i < n)"
   by auto
 
 lemma small_powers_of_2:
   \<open>x < 2 ^ (x - 1)\<close> if \<open>x \<ge> 3\<close> for x :: nat
 proof -
   define m where \<open>m = x - 3\<close>
   with that have \<open>x = m + 3\<close>
     by simp
   moreover have \<open>m + 3 < 4 * 2 ^ m\<close>
     by (induction m) simp_all
   ultimately show ?thesis
     by simp
 qed
 
 end
diff --git a/thys/Word_Lib/More_Divides.thy b/thys/Word_Lib/More_Divides.thy
--- a/thys/Word_Lib/More_Divides.thy
+++ b/thys/Word_Lib/More_Divides.thy
@@ -1,415 +1,413 @@
 (*
  * Copyright Data61, CSIRO (ABN 41 687 119 230)
  *
  * SPDX-License-Identifier: BSD-2-Clause
  *)
 
 section \<open>Lemmas on division\<close>
 
 theory More_Divides
   imports
     "HOL-Library.Word"
 begin
 
 declare div_eq_dividend_iff [simp]
 
 lemma int_div_same_is_1 [simp]:
   \<open>a div b = a \<longleftrightarrow> b = 1\<close> if \<open>0 < a\<close> for a b :: int
   using that by (metis div_by_1 abs_ge_zero abs_of_pos int_div_less_self neq_iff
             nonneg1_imp_zdiv_pos_iff zabs_less_one_iff)
 
 lemma int_div_minus_is_minus1 [simp]:
   \<open>a div b = - a \<longleftrightarrow> b = - 1\<close> if \<open>0 > a\<close> for a b :: int
   using that by (metis div_minus_right equation_minus_iff int_div_same_is_1 neg_0_less_iff_less)
 
 lemma nat_div_eq_Suc_0_iff: "n div m = Suc 0 \<longleftrightarrow> m \<le> n \<and> n < 2 * m"
   apply auto
   using div_greater_zero_iff apply fastforce
    apply (metis One_nat_def div_greater_zero_iff dividend_less_div_times mult.right_neutral mult_Suc mult_numeral_1 numeral_2_eq_2 zero_less_numeral)
   apply (simp add: div_nat_eqI)
   done
 
 lemma diff_mod_le:
   \<open>a - a mod b \<le> d - b\<close> if \<open>a < d\<close> \<open>b dvd d\<close> for a b d :: nat
   using that
   apply(subst minus_mod_eq_mult_div)
   apply(clarsimp simp: dvd_def)
   apply(cases \<open>b = 0\<close>)
    apply simp
   apply(subgoal_tac "a div b \<le> k - 1")
    prefer 2
    apply(subgoal_tac "a div b < k")
     apply(simp add: less_Suc_eq_le [symmetric])
    apply(subgoal_tac "b * (a div b) < b * ((b * k) div b)")
     apply clarsimp
    apply(subst div_mult_self1_is_m)
     apply arith
    apply(rule le_less_trans)
     apply simp
     apply(subst mult.commute)
     apply(rule div_times_less_eq_dividend)
    apply assumption
   apply clarsimp
   apply(subgoal_tac "b * (a div b) \<le> b * (k - 1)")
    apply(erule le_trans)
    apply(simp add: diff_mult_distrib2)
   apply simp
   done
 
 lemma one_mod_exp_eq_one [simp]:
   "1 mod (2 * 2 ^ n) = (1::int)"
   using power_gt1 [of 2 n] by (auto intro: mod_pos_pos_trivial)
 
 lemma int_mod_lem: "0 < n \<Longrightarrow> 0 \<le> b \<and> b < n \<longleftrightarrow> b mod n = b"
   for b n :: int
   apply safe
     apply (erule (1) mod_pos_pos_trivial)
    apply (erule_tac [!] subst)
    apply auto
   done
 
 lemma int_mod_ge': "b < 0 \<Longrightarrow> 0 < n \<Longrightarrow> b + n \<le> b mod n"
   for b n :: int
   by (metis add_less_same_cancel2 int_mod_ge mod_add_self2)
 
 lemma int_mod_le': "0 \<le> b - n \<Longrightarrow> b mod n \<le> b - n"
   for b n :: int
   by (metis minus_mod_self2 zmod_le_nonneg_dividend)
 
 lemma emep1: "even n \<Longrightarrow> even d \<Longrightarrow> 0 \<le> d \<Longrightarrow> (n + 1) mod d = (n mod d) + 1"
   for n d :: int
   by (auto simp add: pos_zmod_mult_2 add.commute dvd_def)
 
 lemma m1mod2k: "- 1 mod 2 ^ n = (2 ^ n - 1 :: int)"
   by (rule zmod_minus1) simp
 
 lemma sb_inc_lem: "a + 2^k < 0 \<Longrightarrow> a + 2^k + 2^(Suc k) \<le> (a + 2^k) mod 2^(Suc k)"
   for a :: int
   using int_mod_ge' [where n = "2 ^ (Suc k)" and b = "a + 2 ^ k"]
   by simp
 
 lemma sb_inc_lem': "a < - (2^k) \<Longrightarrow> a + 2^k + 2^(Suc k) \<le> (a + 2^k) mod 2^(Suc k)"
   for a :: int
   by (rule sb_inc_lem) simp
 
 lemma sb_dec_lem: "0 \<le> - (2 ^ k) + a \<Longrightarrow> (a + 2 ^ k) mod (2 * 2 ^ k) \<le> - (2 ^ k) + a"
   for a :: int
   using int_mod_le'[where n = "2 ^ (Suc k)" and b = "a + 2 ^ k"] by simp
 
 lemma sb_dec_lem': "2 ^ k \<le> a \<Longrightarrow> (a + 2 ^ k) mod (2 * 2 ^ k) \<le> - (2 ^ k) + a"
   for a :: int
   by (rule sb_dec_lem) simp
 
 lemma mod_2_neq_1_eq_eq_0: "k mod 2 \<noteq> 1 \<longleftrightarrow> k mod 2 = 0"
   for k :: int
   by (fact not_mod_2_eq_1_eq_0)
 
 lemma z1pmod2: "(2 * b + 1) mod 2 = (1::int)"
   for b :: int
   by arith
 
 lemma p1mod22k': "(1 + 2 * b) mod (2 * 2 ^ n) = 1 + 2 * (b mod 2 ^ n)"
   for b :: int
   by (rule pos_zmod_mult_2) simp
 
 lemma p1mod22k: "(2 * b + 1) mod (2 * 2 ^ n) = 2 * (b mod 2 ^ n) + 1"
   for b :: int
   by (simp add: p1mod22k' add.commute)
 
 lemma pos_mod_sign2:
   \<open>0 \<le> a mod 2\<close> for a :: int
   by simp
 
 lemma pos_mod_bound2:
   \<open>a mod 2 < 2\<close> for a :: int
   by simp
 
 lemma nmod2: "n mod 2 = 0 \<or> n mod 2 = 1"
   for n :: int
   by arith
 
 lemma eme1p:
   "even n \<Longrightarrow> even d \<Longrightarrow> 0 \<le> d \<Longrightarrow> (1 + n) mod d = 1 + n mod d" for n d :: int
   using emep1 [of n d] by (simp add: ac_simps)
 
 lemma m1mod22k:
   \<open>- 1 mod (2 * 2 ^ n) = 2 * 2 ^ n - (1::int)\<close>
   by (simp add: zmod_minus1)
 
 lemma z1pdiv2: "(2 * b + 1) div 2 = b"
   for b :: int
   by arith
 
 lemma zdiv_le_dividend:
   \<open>0 \<le> a \<Longrightarrow> 0 < b \<Longrightarrow> a div b \<le> a\<close> for a b :: int
   by (metis div_by_1 int_one_le_iff_zero_less zdiv_mono2 zero_less_one)
 
 lemma axxmod2: "(1 + x + x) mod 2 = 1 \<and> (0 + x + x) mod 2 = 0"
   for x :: int
   by arith
 
 lemma axxdiv2: "(1 + x + x) div 2 = x \<and> (0 + x + x) div 2 = x"
   for x :: int
   by arith
 
 lemmas rdmods =
   mod_minus_eq [symmetric]
   mod_diff_left_eq [symmetric]
   mod_diff_right_eq [symmetric]
   mod_add_left_eq [symmetric]
   mod_add_right_eq [symmetric]
   mod_mult_right_eq [symmetric]
   mod_mult_left_eq [symmetric]
 
 lemma mod_plus_right: "(a + x) mod m = (b + x) mod m \<longleftrightarrow> a mod m = b mod m"
   for a b m x :: nat
   by (induct x) (simp_all add: mod_Suc, arith)
 
 lemma nat_minus_mod: "(n - n mod m) mod m = 0"
   for m n :: nat
   by (induct n) (simp_all add: mod_Suc)
 
 lemmas nat_minus_mod_plus_right =
   trans [OF nat_minus_mod mod_0 [symmetric],
     THEN mod_plus_right [THEN iffD2], simplified]
 
 lemmas push_mods' = mod_add_eq
   mod_mult_eq mod_diff_eq
   mod_minus_eq
 
 lemmas push_mods = push_mods' [THEN eq_reflection]
 lemmas pull_mods = push_mods [symmetric] rdmods [THEN eq_reflection]
 
 lemma nat_mod_eq: "b < n \<Longrightarrow> a mod n = b mod n \<Longrightarrow> a mod n = b"
   for a b n :: nat
   by (induct a) auto
 
 lemmas nat_mod_eq' = refl [THEN [2] nat_mod_eq]
 
 lemma nat_mod_lem: "0 < n \<Longrightarrow> b < n \<longleftrightarrow> b mod n = b"
   for b n :: nat
   apply safe
    apply (erule nat_mod_eq')
   apply (erule subst)
   apply (erule mod_less_divisor)
   done
 
 lemma mod_nat_add: "x < z \<Longrightarrow> y < z \<Longrightarrow> (x + y) mod z = (if x + y < z then x + y else x + y - z)"
   for x y z :: nat
   apply (rule nat_mod_eq)
    apply auto
   apply (rule trans)
    apply (rule le_mod_geq)
    apply simp
   apply (rule nat_mod_eq')
   apply arith
   done
 
 lemma mod_nat_sub: "x < z \<Longrightarrow> (x - y) mod z = x - y"
   for x y :: nat
   by (rule nat_mod_eq') arith
 
 lemma int_mod_eq: "0 \<le> b \<Longrightarrow> b < n \<Longrightarrow> a mod n = b mod n \<Longrightarrow> a mod n = b"
   for a b n :: int
   by (metis mod_pos_pos_trivial)
 
 lemma zmde:
   \<open>b * (a div b) = a - a mod b\<close> for a b :: \<open>'a::{group_add,semiring_modulo}\<close>
   using mult_div_mod_eq [of b a] by (simp add: eq_diff_eq)
 
 (* already have this for naturals, div_mult_self1/2, but not for ints *)
 lemma zdiv_mult_self: "m \<noteq> 0 \<Longrightarrow> (a + m * n) div m = a div m + n"
   for a m n :: int
   by simp
 
 lemma mod_power_lem: "a > 1 \<Longrightarrow> a ^ n mod a ^ m = (if m \<le> n then 0 else a ^ n)"
   for a :: int
   by (simp add: mod_eq_0_iff_dvd le_imp_power_dvd)
 
 lemma nonneg_mod_div: "0 \<le> a \<Longrightarrow> 0 \<le> b \<Longrightarrow> 0 \<le> (a mod b) \<and> 0 \<le> a div b"
   for a b :: int
   by (cases "b = 0") (auto intro: pos_imp_zdiv_nonneg_iff [THEN iffD2])
 
 lemma mod_exp_less_eq_exp:
   \<open>a mod 2 ^ n < 2 ^ n\<close> for a :: int
   by (rule pos_mod_bound) simp
 
 lemma div_mult_le:
   \<open>a div b * b \<le> a\<close> for a b :: nat
   by (fact div_times_less_eq_dividend)
 
 lemma power_sub:
   fixes a :: nat
   assumes lt: "n \<le> m"
   and     av: "0 < a"
   shows "a ^ (m - n) = a ^ m div a ^ n"
 proof (subst nat_mult_eq_cancel1 [symmetric])
   show "(0::nat) < a ^ n" using av by simp
 next
   from lt obtain q where mv: "n + q = m"
     by (auto simp: le_iff_add)
 
   have "a ^ n * (a ^ m div a ^ n) = a ^ m"
   proof (subst mult.commute)
     have "a ^ m = (a ^ m div a ^ n) * a ^ n + a ^ m mod a ^ n"
       by (rule  div_mult_mod_eq [symmetric])
 
     moreover have "a ^ m mod a ^ n = 0"
       by (subst mod_eq_0_iff_dvd, subst dvd_def, rule exI [where x = "a ^ q"],
       (subst power_add [symmetric] mv)+, rule refl)
 
     ultimately show "(a ^ m div a ^ n) * a ^ n = a ^ m" by simp
   qed
 
   then show "a ^ n * a ^ (m - n) = a ^ n * (a ^ m div a ^ n)" using lt
     by (simp add: power_add [symmetric])
 qed
 
 lemma mod_lemma: "[| (0::nat) < c; r < b |] ==> b * (q mod c) + r < b * c"
   apply (cut_tac m = q and n = c in mod_less_divisor)
   apply (drule_tac [2] m = "q mod c" in less_imp_Suc_add, auto)
   apply (erule_tac P = "%x. lhs < rhs x" for lhs rhs in ssubst)
   apply (simp add: add_mult_distrib2)
   done
 
 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)
 
 lemmas m2pths = pos_mod_sign mod_exp_less_eq_exp
 
 lemmas int_mod_eq' = mod_pos_pos_trivial (* FIXME delete *)
 
 lemmas int_mod_le = zmod_le_nonneg_dividend (* FIXME: delete *)
 
 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]; 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 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 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 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 td_gal_lt:
   \<open>0 < c \<Longrightarrow> a < b * c \<longleftrightarrow> a div c < b\<close>
   for a b c :: nat
-  apply (auto dest: less_mult_imp_div_less)
-  apply (metis div_le_mono div_mult_self_is_m leD leI)
-  done
+  by (simp add: div_less_iff_less_mult)
 
 lemma td_gal:
   \<open>0 < c \<Longrightarrow> b * c \<le> a  \<longleftrightarrow> b \<le> a div c\<close>
   for a b c :: nat
-  by (meson not_le td_gal_lt)
+  by (simp add: less_eq_div_iff_mult_less_eq)
 
 end
diff --git a/thys/Word_Lib/More_Word_Operations.thy b/thys/Word_Lib/More_Word_Operations.thy
--- a/thys/Word_Lib/More_Word_Operations.thy
+++ b/thys/Word_Lib/More_Word_Operations.thy
@@ -1,1014 +1,1026 @@
 (*
  * Copyright Data61, CSIRO (ABN 41 687 119 230)
  *
  * SPDX-License-Identifier: BSD-2-Clause
  *)
 
 section \<open>Misc word operations\<close>
 
 theory More_Word_Operations
   imports
     "HOL-Library.Word"
     Aligned
     Reversed_Bit_Lists
     More_Misc
     Signed_Words
+    Word_Lemmas
 begin
 
 definition
   ptr_add :: "'a :: len word \<Rightarrow> nat \<Rightarrow> 'a word" where
   "ptr_add ptr n \<equiv> ptr + of_nat n"
 
 definition
   alignUp :: "'a::len word \<Rightarrow> nat \<Rightarrow> 'a word" where
  "alignUp x n \<equiv> x + 2 ^ n - 1 AND NOT (2 ^ n - 1)"
 
 lemma alignUp_unfold:
   \<open>alignUp w n = (w + mask n) AND NOT (mask n)\<close>
   by (simp add: alignUp_def mask_eq_exp_minus_1 add_mask_fold)
 
 (* standard notation for blocks of 2^n-1 words, usually aligned;
    abbreviation so it simplifies directly *)
 abbreviation mask_range :: "'a::len word \<Rightarrow> nat \<Rightarrow> 'a word set" where
   "mask_range p n \<equiv> {p .. p + mask n}"
 
 definition
   w2byte :: "'a :: len word \<Rightarrow> 8 word" where
   "w2byte \<equiv> ucast"
 
 (* 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)))"
 
 lemma word_ctz_le:
   "word_ctz (w :: ('a::len word)) \<le> LENGTH('a)"
   apply (clarsimp simp: word_ctz_def)
   using length_takeWhile_le apply (rule order_trans)
   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)
   using length_takeWhile_less apply (rule less_le_trans)
   apply auto
   done
 
 lemma take_bit_word_ctz_eq [simp]:
   \<open>take_bit LENGTH('a) (word_ctz w) = word_ctz w\<close>
   for w :: \<open>'a::len word\<close>
   apply (simp add: take_bit_nat_eq_self_iff word_ctz_def to_bl_unfold)
   using length_takeWhile_le apply (rule le_less_trans)
   apply simp
   done
 
 lemma word_ctz_not_minus_1:
   \<open>word_of_nat (word_ctz (w :: 'a :: len word)) \<noteq> (- 1 :: 'a::len word)\<close> if \<open>1 < LENGTH('a)\<close>
 proof -
   note word_ctz_le
   also from that have \<open>LENGTH('a) < mask LENGTH('a)\<close>
     by (simp add: less_mask)
   finally have \<open>word_ctz w < mask LENGTH('a)\<close> .
   then have \<open>word_of_nat (word_ctz w) < (word_of_nat (mask LENGTH('a)) :: 'a word)\<close>
     by (simp add: of_nat_word_less_iff)
   also have \<open>\<dots> = - 1\<close>
     by (rule bit_word_eqI) (simp add: bit_simps)
   finally show ?thesis
     by simp
 qed
 
 lemma unat_of_nat_ctz_mw:
   "unat (of_nat (word_ctz (w :: 'a :: len word)) :: 'a :: len word) = word_ctz w"
   by simp
 
 lemma unat_of_nat_ctz_smw:
   "unat (of_nat (word_ctz (w :: 'a :: len word)) :: 'a :: len signed word) = word_ctz w"
   by simp
 
 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 bit w n then w OR NOT (mask n) else w AND mask n"
 
 lemma sign_extend_eq_signed_take_bit:
   \<open>sign_extend = signed_take_bit\<close>
 proof (rule ext)+
   fix n and w :: \<open>'a::len word\<close>
   show \<open>sign_extend n w = signed_take_bit n w\<close>
   proof (rule bit_word_eqI)
     fix q
     assume \<open>q < LENGTH('a)\<close>
     then show \<open>bit (sign_extend n w) q \<longleftrightarrow> bit (signed_take_bit n w) q\<close>
       by (auto simp add: bit_signed_take_bit_iff
         sign_extend_def bit_and_iff bit_or_iff bit_not_iff bit_mask_iff not_less
         exp_eq_0_imp_not_bit not_le min_def)
   qed
 qed
 
 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> bit w i = bit w n"
 
 lemma ptr_add_0 [simp]:
   "ptr_add ref 0 = ref "
   unfolding ptr_add_def by simp
 
 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
 
 lemma word_log2_zero_eq [simp]:
   \<open>word_log2 0 = 0\<close>
   by (simp add: word_log2_def word_clz_def word_size)
 
 lemma word_log2_unfold:
   \<open>word_log2 w = (if w = 0 then 0 else Max {n. bit w n})\<close>
   for w :: \<open>'a::len word\<close>
 proof (cases \<open>w = 0\<close>)
   case True
   then show ?thesis
     by simp
 next
   case False
   then obtain r where \<open>bit w r\<close>
     by (auto simp add: bit_eq_iff)
   then have \<open>Max {m. bit w m} = LENGTH('a) - Suc (length
     (takeWhile (Not \<circ> bit w) (rev [0..<LENGTH('a)])))\<close>
     by (subst Max_eq_length_takeWhile [of _ \<open>LENGTH('a)\<close>])
       (auto simp add: bit_imp_le_length)
   then have \<open>word_log2 w = Max {x. bit w x}\<close>
     by (simp add: word_log2_def word_clz_def word_size to_bl_unfold rev_map takeWhile_map)
   with \<open>w \<noteq> 0\<close> show ?thesis
     by simp
 qed
 
 lemma word_log2_eqI:
   \<open>word_log2 w = n\<close>
   if \<open>w \<noteq> 0\<close> \<open>bit w n\<close> \<open>\<And>m. bit w m \<Longrightarrow> m \<le> n\<close>
   for w :: \<open>'a::len word\<close>
 proof -
   from \<open>w \<noteq> 0\<close> have \<open>word_log2 w = Max {n. bit w n}\<close>
     by (simp add: word_log2_unfold)
   also have \<open>Max {n. bit w n} = n\<close>
     using that by (auto intro: Max_eqI)
   finally show ?thesis .
 qed
 
 lemma bit_word_log2:
   \<open>bit w (word_log2 w)\<close> if \<open>w \<noteq> 0\<close>
 proof -
   from \<open>w \<noteq> 0\<close> have \<open>\<exists>r. bit w r\<close>
     by (simp add: bit_eq_iff)
   then obtain r where \<open>bit w r\<close> ..
   from \<open>w \<noteq> 0\<close> have \<open>word_log2 w = Max {n. bit w n}\<close>
     by (simp add: word_log2_unfold)
   also have \<open>Max {n. bit w n} \<in> {n. bit w n}\<close>
     using \<open>bit w r\<close> by (subst Max_in) auto
   finally show ?thesis
     by simp
 qed
 
 lemma word_log2_maximum:
   \<open>n \<le> word_log2 w\<close> if \<open>bit w n\<close>
 proof -
   have \<open>n \<le> Max {n. bit w n}\<close>
     using that by (auto intro: Max_ge)
   also from that have \<open>w \<noteq> 0\<close>
     by force
   then have \<open>Max {n. bit w n} = word_log2 w\<close>
     by (simp add: word_log2_unfold)
   finally show ?thesis .
 qed
 
 lemma word_log2_nth_same:
   "w \<noteq> 0 \<Longrightarrow> bit w (word_log2 w)"
   by (drule bit_word_log2) simp
 
 lemma word_log2_nth_not_set:
   "\<lbrakk> word_log2 w < i ; i < size w \<rbrakk> \<Longrightarrow> \<not> bit w i"
   using word_log2_maximum [of w i] by auto
 
 lemma word_log2_highest:
   assumes a: "bit w i"
   shows "i \<le> word_log2 w"
   using a by (simp add: word_log2_maximum)
 
 lemma word_log2_max:
   "word_log2 w < size w"
   apply (cases \<open>w = 0\<close>)
    apply (simp_all add: word_size)
   apply (drule bit_word_log2)
   apply (fact bit_imp_le_length)
   done
 
 lemma word_clz_0[simp]:
   "word_clz (0::'a::len word) = LENGTH('a)"
   unfolding word_clz_def by simp
 
 lemma word_clz_minus_one[simp]:
   "word_clz (-1::'a::len word) = 0"
   unfolding word_clz_def by simp
 
 lemma is_aligned_alignUp[simp]:
   "is_aligned (alignUp p n) n"
   by (simp add: alignUp_def is_aligned_mask mask_eq_decr_exp word_bw_assocs)
 
 lemma alignUp_le[simp]:
   "alignUp p n \<le> p + 2 ^ n - 1"
   unfolding alignUp_def by (rule word_and_le2)
 
 lemma alignUp_idem:
   fixes a :: "'a::len word"
   assumes "is_aligned a n" "n < LENGTH('a)"
   shows "alignUp a n = a"
   using assms unfolding alignUp_def
   by (metis add_cancel_right_right add_diff_eq and_mask_eq_iff_le_mask mask_eq_decr_exp mask_out_add_aligned order_refl word_plus_and_or_coroll2)
 
 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
     by (meson Euclidean_Division.div_eq_0_iff le_m1_iff_lt measure_unat order_less_trans
               unat_less_power word_less_sub_le word_mod_less_divisor)
 
   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 mask_eq_decr_exp [symmetric])
     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
-    by (metis shiftr_div_2n' word_shiftr_lt)
+    by (metis le_add_diff_inverse2 less_mult_imp_div_less order_less_imp_le power_add unsigned_less)
 
   have"2 ^ n * (unat a div 2 ^ n + 1) \<le> 2 ^ LENGTH('a)" using sz
     by (metis One_nat_def Suc_leI add.right_neutral add_Suc_right lt0 nat_le_power_trans nat_less_le)
   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)
     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
-      by (metis shiftr_div_2n' word_shiftr_lt)
+      by (metis le_add_diff_inverse2 less_mult_imp_div_less order_less_imp_le power_add unsigned_less)
 
     have leq: "2 ^ n * (unat a div 2 ^ n + 1) \<le> 2 ^ LENGTH('a)" using sz
       by (metis One_nat_def Suc_leI add.right_neutral add_Suc_right lt0 nat_le_power_trans
                 order_less_imp_le)
 
     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
       by (simp flip: drop_bit_eq_div unat_drop_bit_eq) (metis leI le_unat_uoi unat_mono)
 
     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 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 auto
 
   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 auto
 
     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 AND NOT (mask sz)"
   by (simp add: alignUp_def flip: mask_eq_decr_exp)
 
 lemma alignUp_def3:
   "alignUp a sz = 2^ sz + (a - 1 AND NOT (mask sz))"
   by (simp add: alignUp_def2 is_aligned_triv field_simps mask_out_add_aligned)
 
 lemma  alignUp_plus:
   "is_aligned w us \<Longrightarrow> alignUp (w + a) us  = w + alignUp a us"
   by (clarsimp simp: alignUp_def2 mask_out_add_aligned field_simps)
 
 lemma alignUp_distance:
   "alignUp (q :: 'a :: len word) sz - q \<le> mask sz"
   by (metis (no_types) add.commute add_diff_cancel_left alignUp_def2 diff_add_cancel
                        mask_2pm1 subtract_mask(2) word_and_le1 word_sub_le_iff)
 
 lemma is_aligned_diff_neg_mask:
   "is_aligned p sz \<Longrightarrow> (p - q AND NOT (mask sz)) = (p - ((alignUp q sz) AND NOT (mask sz)))"
   apply (clarsimp simp only:word_and_le2 diff_conv_add_uminus)
   apply (subst mask_out_add_aligned[symmetric]; simp)
   apply (simp add: eq_neg_iff_add_eq_0)
   apply (subst add.commute)
   apply (simp add: alignUp_distance is_aligned_neg_mask_eq mask_out_add_aligned and_mask_eq_iff_le_mask flip: mask_eq_x_eq_0)
   done
 
 lemma word_clz_max:
   "word_clz w \<le> size (w::'a::len word)"
   unfolding word_clz_def
   by (metis length_takeWhile_le word_size_bl)
 
 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"
       by (metis a length_takeWhile_less less_irrefl_nat word_clz_def)
     hence "to_bl w = replicate (length (to_bl w)) False"
       using eq_zero_set_bl nz by fastforce
     hence "w = 0"
       by (metis to_bl_0 word_bl.Rep_eqD word_bl_Rep')
     with nz have False by simp
   }
   thus ?thesis using word_clz_max
     by (fastforce intro: le_neq_trans)
 qed
 
 (* Sign extension from bit n. *)
 
 lemma bin_sign_extend_iff [bit_simps]:
   \<open>bit (sign_extend e w) i \<longleftrightarrow> bit w (min e i)\<close>
   if \<open>i < LENGTH('a)\<close> for w :: \<open>'a::len word\<close>
   using that by (simp add: sign_extend_def bit_simps min_def)
 
 lemma sign_extend_bitwise_if:
   "i < size w \<Longrightarrow> bit (sign_extend e w) i \<longleftrightarrow> (if i < e then bit w i else bit w e)"
   by (simp add: word_size bit_simps)
 
 lemma sign_extend_bitwise_if'  [word_eqI_simps]:
   \<open>i < LENGTH('a) \<Longrightarrow> bit (sign_extend e w) i \<longleftrightarrow> (if i < e then bit w i else bit w e)\<close>
   for w :: \<open>'a::len word\<close>
   using sign_extend_bitwise_if [of i w e] by (simp add: word_size)
 
 lemma sign_extend_bitwise_disj:
   "i < size w \<Longrightarrow> bit (sign_extend e w) i \<longleftrightarrow> i \<le> e \<and> bit w i \<or> e \<le> i \<and> bit w e"
   by (auto simp: sign_extend_bitwise_if)
 
 lemma sign_extend_bitwise_cases:
   "i < size w \<Longrightarrow> bit (sign_extend e w) i \<longleftrightarrow> (i \<le> e \<longrightarrow> bit w i) \<and> (e \<le> i \<longrightarrow> bit w e)"
   by (auto simp: sign_extend_bitwise_if)
 
 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 bit w n then w OR NOT (mask (Suc n)) else w AND mask (Suc n))"
   by (rule bit_word_eqI) (auto simp add: bit_simps sign_extend_eq_signed_take_bit min_def less_Suc_eq_le)
 
 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 auto
    apply (auto simp add: bit_eq_iff)
     apply (simp_all add: bit_simps sign_extend_eq_signed_take_bit not_le min_def sign_extended_def word_size split: if_splits)
   using le_imp_less_or_eq apply auto[1]
    apply (metis bit_imp_le_length nat_less_le)
   apply (metis Suc_leI Suc_n_not_le_n le_trans nat_less_le)
   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 (rule bit_word_eqI) (simp add: sign_extend_eq_signed_take_bit bit_simps)
 
 lemma sign_extended_high_bits:
   "\<lbrakk> sign_extended e p; j < size p; e \<le> i; i < j \<rbrakk> \<Longrightarrow> bit p i = bit p j"
   by (drule (1) sign_extended_weaken; simp add: sign_extended_def)
 
 lemma sign_extend_eq:
   "w AND mask (Suc n) = v AND mask (Suc n) \<Longrightarrow> sign_extend n w = sign_extend n v"
   by (simp flip: take_bit_eq_mask add: sign_extend_eq_signed_take_bit signed_take_bit_eq_iff_take_bit_eq)
 
 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> bit f e"
     using True e less_2p_is_upper_bits_unset[THEN iffD1, OF f]
     by (fastforce simp: word_size)
   hence i: "bit (p + f) e = bit p e"
     by (simp add: and_or bit_simps)
   have fm: "f AND mask e = f"
     by (fastforce intro: subst[where P="\<lambda>f. f AND 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 AND NOT (mask m))"
   by (fastforce simp: sign_extended_def word_size neg_mask_test_bit bit_simps)
 
 definition
   "limited_and (x :: 'a :: len word) y \<longleftrightarrow> (x AND y = x)"
 
 lemma limited_and_eq_0:
   "\<lbrakk> limited_and x z; y AND NOT z = y \<rbrakk> \<Longrightarrow> x AND y = 0"
   unfolding limited_and_def
   apply (subst arg_cong2[where f="(AND)"])
     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 AND z = z \<rbrakk> \<Longrightarrow> x AND 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])
+  by (metis push_bit_and)
 
 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])
+  by (metis drop_bit_and)
 
 lemmas limited_and_simps1 = limited_and_eq_0 limited_and_eq_id
 
 lemmas is_aligned_limited_and
     = is_aligned_neg_mask_eq[unfolded mask_eq_decr_exp, folded limited_and_def]
 
 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]
-       not_one shiftl_shiftr1[unfolded word_size mask_eq_decr_exp]
-       shiftl_shiftr2[unfolded word_size mask_eq_decr_exp]
+       not_one
 
 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_eq:
   \<open>from_bool = of_bool\<close>
   by (simp add: fun_eq_iff from_bool_def)
 
 lemma from_bool_0:
   "(from_bool x = 0) = (\<not> x)"
   by (simp add: from_bool_def split: bool.split)
 
 lemma from_bool_eq_if':
   "((if P then 1 else 0) = from_bool Q) = (P = Q)"
   by (cases Q) (simp_all add: from_bool_def)
 
 definition
   to_bool :: "'a::len word \<Rightarrow> bool" where
   "to_bool \<equiv> (\<noteq>) 0"
 
 lemma to_bool_and_1:
   "to_bool (x AND 1) \<longleftrightarrow> bit x 0"
   by (simp add: to_bool_def and_one_eq mod_2_eq_odd)
 
 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) AND 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 (cases Q) (simp_all add: from_bool_def)
 
 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 fold_eq_0_to_bool:
   "(v = 0) = (\<not> to_bool v)"
   by (simp add: to_bool_def)
 
 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 from_bool_eqI:
   "from_bool x = from_bool y \<Longrightarrow> x = y"
   unfolding from_bool_def
   by (auto split: bool.splits)
 
 lemma neg_mask_in_mask_range:
   "is_aligned ptr bits \<Longrightarrow> (ptr' AND NOT(mask bits) = ptr) = (ptr' \<in> mask_range ptr bits)"
   apply (erule is_aligned_get_word_bits)
    apply (rule iffI)
     apply (drule sym)
     apply (simp add: word_and_le2)
     apply (subst word_plus_and_or_coroll, word_eqI_solve)
     apply (metis bit.disj_ac(2) bit.disj_conj_distrib2 le_word_or2 word_and_max word_or_not)
    apply clarsimp
    apply (smt add.right_neutral eq_iff is_aligned_neg_mask_eq mask_out_add_aligned neg_mask_mono_le
               word_and_not)
   apply (simp add: power_overflow mask_eq_decr_exp)
   done
 
 lemma aligned_offset_in_range:
   "\<lbrakk> is_aligned (x :: 'a :: len word) m; y < 2 ^ m; is_aligned p n; n \<ge> m; n < LENGTH('a) \<rbrakk>
    \<Longrightarrow> (x + y \<in> {p .. p + mask n}) = (x \<in> mask_range p n)"
   apply (subst disjunctive_add)
    apply (simp add: bit_simps)
   apply (erule is_alignedE')
    apply (auto simp add: bit_simps not_le)[1]
    apply (metis less_2p_is_upper_bits_unset)
   apply (simp only: is_aligned_add_or word_ao_dist flip: neg_mask_in_mask_range)
   apply (subgoal_tac \<open>y AND NOT (mask n) = 0\<close>)
    apply simp
   apply (metis (full_types) is_aligned_mask is_aligned_neg_mask less_mask_eq word_bw_comms(1) word_bw_lcs(1))
   done
 
 lemma mask_range_to_bl':
   "\<lbrakk> is_aligned (ptr :: 'a :: len word) bits; bits < LENGTH('a) \<rbrakk>
    \<Longrightarrow> mask_range ptr bits
        = {x. take (LENGTH('a) - bits) (to_bl x) = take (LENGTH('a) - bits) (to_bl ptr)}"
   apply (rule set_eqI, rule iffI)
    apply clarsimp
    apply (subgoal_tac "\<exists>y. x = ptr + y \<and> y < 2 ^ bits")
     apply clarsimp
     apply (subst is_aligned_add_conv)
        apply assumption
       apply simp
     apply simp
    apply (rule_tac x="x - ptr" in exI)
    apply (simp add: add_diff_eq[symmetric])
    apply (simp only: word_less_sub_le[symmetric])
    apply (rule word_diff_ls')
     apply (simp add: field_simps mask_eq_decr_exp)
    apply assumption
   apply simp
   apply (subgoal_tac "\<exists>y. y < 2 ^ bits \<and> to_bl (ptr + y) = to_bl x")
    apply clarsimp
    apply (rule conjI)
     apply (erule(1) is_aligned_no_wrap')
    apply (simp only: add_diff_eq[symmetric] mask_eq_decr_exp)
    apply (rule word_plus_mono_right)
     apply simp
    apply (erule is_aligned_no_wrap')
    apply simp
   apply (rule_tac x="of_bl (drop (LENGTH('a) - bits) (to_bl x))" in exI)
   apply (rule context_conjI)
    apply (rule order_less_le_trans [OF of_bl_length])
     apply simp
    apply simp
   apply (subst is_aligned_add_conv)
      apply assumption
     apply simp
   apply (drule sym)
   apply (simp add: word_rep_drop)
   done
 
 lemma mask_range_to_bl:
   "is_aligned (ptr :: 'a :: len word) bits
    \<Longrightarrow> mask_range ptr bits
         = {x. take (LENGTH('a) - bits) (to_bl x) = take (LENGTH('a) - bits) (to_bl ptr)}"
   apply (erule is_aligned_get_word_bits)
    apply (erule(1) mask_range_to_bl')
   apply (rule set_eqI)
   apply (simp add: power_overflow mask_eq_decr_exp)
   done
 
 lemma aligned_mask_range_cases:
   "\<lbrakk> is_aligned (p :: 'a :: len word) n; is_aligned (p' :: 'a :: len word) n' \<rbrakk>
    \<Longrightarrow> mask_range p n \<inter> mask_range p' n' = {} \<or>
        mask_range p n \<subseteq> mask_range p' n' \<or>
        mask_range p n \<supseteq> mask_range p' n'"
   apply (simp add: mask_range_to_bl)
   apply (rule Meson.disj_comm, rule disjCI)
   apply auto
   apply (subgoal_tac "(\<exists>n''. LENGTH('a) - n = (LENGTH('a) - n') + n'')
                     \<or> (\<exists>n''. LENGTH('a) - n' = (LENGTH('a) - n) + n'')")
    apply (fastforce simp: take_add)
   apply arith
   done
 
 lemma aligned_mask_range_offset_subset:
   assumes al: "is_aligned (ptr :: 'a :: len word) sz" and al': "is_aligned x sz'"
   and szv: "sz' \<le> sz"
   and xsz: "x < 2 ^ sz"
   shows "mask_range (ptr+x) sz' \<subseteq> mask_range ptr sz"
   using al
 proof (rule is_aligned_get_word_bits)
   assume p0: "ptr = 0" and szv': "LENGTH ('a) \<le> sz"
   then have "(2 ::'a word) ^ sz = 0" by simp
   show ?thesis using p0
     by (simp add: \<open>2 ^ sz = 0\<close> mask_eq_decr_exp)
 next
   assume szv': "sz < LENGTH('a)"
 
   hence blah: "2 ^ (sz - sz') < (2 :: nat) ^ LENGTH('a)"
     using szv by auto
   show ?thesis using szv szv'
     apply auto
     using al assms(4) is_aligned_no_wrap' apply blast
     apply (simp only: flip: add_diff_eq add_mask_fold)
     apply (subst add.assoc, rule word_plus_mono_right)
      using al' is_aligned_add_less_t2n xsz
      apply fastforce
     apply (simp add: field_simps szv al is_aligned_no_overflow)
     done
 qed
 
 lemma aligned_mask_ranges_disjoint:
   "\<lbrakk> is_aligned (p :: 'a :: len word) n; is_aligned (p' :: 'a :: len word) n';
      p AND NOT(mask n') \<noteq> p'; p' AND NOT(mask n) \<noteq> p \<rbrakk>
    \<Longrightarrow> mask_range p n \<inter> mask_range p' n' = {}"
   using aligned_mask_range_cases
   by (auto simp: neg_mask_in_mask_range)
 
 lemma aligned_mask_ranges_disjoint2:
   "\<lbrakk> is_aligned p n; is_aligned ptr bits; n \<ge> m; n < size p; m \<le> bits;
      (\<forall>y < 2 ^ (n - m). p + (y << m) \<notin> mask_range ptr bits) \<rbrakk>
    \<Longrightarrow> mask_range p n \<inter> mask_range ptr bits = {}"
   apply safe
   apply (simp only: flip: neg_mask_in_mask_range)
+  apply simp
   apply (drule_tac x="x AND mask n >> m" in spec)
-  apply (clarsimp simp: and_mask_less_size wsst_TYs shiftr_less_t2n multiple_mask_trivia neg_mask_twice
-                        word_bw_assocs max_absorb2 shiftr_shiftl1)
+  apply (auto simp add: and_mask_less_size wsst_TYs multiple_mask_trivia neg_mask_twice
+                        word_bw_assocs max_absorb2)
+   apply (erule notE)
+
+  apply (simp add: shiftr_mask2)
+   apply (rule and_mask_less')
+  apply simp
+  apply (subst (asm) disjunctive_add)
+   apply (simp add: bit_simps)
+  apply auto
+  apply (erule notE)
+  apply (rule bit_word_eqI)
+  apply (auto simp add: bit_simps)
   done
 
 lemma word_clz_sint_upper[simp]:
   "LENGTH('a) \<ge> 3 \<Longrightarrow> sint (of_nat (word_clz (w :: 'a :: len word)) :: 'a sword) \<le> int (LENGTH('a))"
   using word_clz_max [of w]
   apply (simp add: word_size)
   apply (subst signed_take_bit_int_eq_self)
     apply simp_all
    apply (metis negative_zle of_nat_numeral semiring_1_class.of_nat_power)
   apply (drule small_powers_of_2)
   apply (erule le_less_trans)
   apply simp
   done
 
 lemma word_clz_sint_lower[simp]:
   "LENGTH('a) \<ge> 3
    \<Longrightarrow> - sint (of_nat (word_clz (w :: 'a :: len word)) :: 'a signed word) \<le> int (LENGTH('a))"
   apply (subst sint_eq_uint)
   using word_clz_max [of w]
    apply (simp_all add: word_size)
   apply (rule not_msb_from_less)
   apply (simp add: word_less_nat_alt)
   apply (subst take_bit_nat_eq_self)
    apply (simp add: le_less_trans)
   apply (drule small_powers_of_2)
   apply (erule le_less_trans)
   apply simp
   done
 
 lemma mask_range_subsetD:
   "\<lbrakk> p' \<in> mask_range p n; x' \<in> mask_range p' n'; n' \<le> n; is_aligned p n; is_aligned p' n' \<rbrakk> \<Longrightarrow>
    x' \<in> mask_range p n"
   using aligned_mask_step by fastforce
 
 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 add_mult_in_mask_range:
   "\<lbrakk> is_aligned (base :: 'a :: len word) n; n < LENGTH('a); bits \<le> n; x < 2 ^ (n - bits) \<rbrakk>
    \<Longrightarrow> base + x * 2^bits \<in> mask_range base n"
   by (simp add: is_aligned_no_wrap' mask_2pm1 nasty_split_lt word_less_power_trans2
                 word_plus_mono_right)
 
 lemma from_to_bool_last_bit:
   "from_bool (to_bool (x AND 1)) = x AND 1"
   by (metis from_bool_to_bool_iff word_and_1)
 
 lemma sint_ctz:
   "LENGTH('a) > 2
    \<Longrightarrow> 0 \<le> sint (of_nat (word_ctz (x :: 'a :: len word)) :: 'a signed word)
         \<and> sint (of_nat (word_ctz x) :: 'a signed word) \<le> int (LENGTH('a))"
   apply (subgoal_tac "LENGTH('a) < 2 ^ (LENGTH('a) - 1)")
    apply (rule conjI)
     apply (metis len_signed order_le_less_trans sint_of_nat_ge_zero word_ctz_le)
    apply (metis int_eq_sint len_signed sint_of_nat_le word_ctz_le)
   using small_powers_of_2 [of \<open>LENGTH('a)\<close>] by simp
 
 lemma unat_of_nat_word_log2:
   "LENGTH('a) < 2 ^ LENGTH('b)
    \<Longrightarrow> unat (of_nat (word_log2 (n :: 'a :: len word)) :: 'b :: len word) = word_log2 n"
   by (metis less_trans unat_of_nat_eq word_log2_max word_size)
 
 lemma aligned_mask_diff:
   "\<lbrakk> is_aligned (dest :: 'a :: len word) bits; is_aligned (ptr :: 'a :: len word) sz;
      bits \<le> sz; sz < LENGTH('a); dest < ptr \<rbrakk>
    \<Longrightarrow> mask bits + dest < ptr"
   apply (frule_tac p' = ptr in aligned_mask_range_cases, assumption)
   apply (elim disjE)
     apply (drule_tac is_aligned_no_overflow_mask, simp)+
     apply (simp add: algebra_split_simps word_le_not_less)
    apply (drule is_aligned_no_overflow_mask; fastforce)
   apply (simp add: is_aligned_weaken algebra_split_simps)
   apply (auto simp add: not_le)
   using is_aligned_no_overflow_mask leD apply blast
   apply (meson aligned_add_mask_less_eq is_aligned_weaken le_less_trans)
   done
 
 end
\ No newline at end of file
diff --git a/thys/Word_Lib/Most_significant_bit.thy b/thys/Word_Lib/Most_significant_bit.thy
--- a/thys/Word_Lib/Most_significant_bit.thy
+++ b/thys/Word_Lib/Most_significant_bit.thy
@@ -1,203 +1,206 @@
 (*
  * Copyright Data61, CSIRO (ABN 41 687 119 230)
  *
  * SPDX-License-Identifier: BSD-2-Clause
  *)
 
 (* Author: Jeremy Dawson, NICTA *)
 
 section \<open>Dedicated operation for the most significant bit\<close>
 
 theory Most_significant_bit
   imports
     "HOL-Library.Word"
     Bits_Int
-    Traditional_Infix_Syntax
+    More_Word
     More_Arithmetic
 begin
 
 class msb =
   fixes msb :: \<open>'a \<Rightarrow> bool\<close>
 
 instantiation int :: msb
 begin
 
 definition \<open>msb x \<longleftrightarrow> x < 0\<close> for x :: int
 
 instance ..
 
 end
 
 lemma msb_conv_bin_sign: "msb x \<longleftrightarrow> bin_sign x = -1"
 by(simp add: bin_sign_def not_le msb_int_def)
 
 lemma msb_bin_rest [simp]: "msb (x div 2) = msb x"
   for x :: int
   by (simp add: msb_int_def)
 
 lemma int_msb_and [simp]: "msb ((x :: int) AND y) \<longleftrightarrow> msb x \<and> msb y"
 by(simp add: msb_int_def)
 
 lemma int_msb_or [simp]: "msb ((x :: int) OR y) \<longleftrightarrow> msb x \<or> msb y"
 by(simp add: msb_int_def)
 
 lemma int_msb_xor [simp]: "msb ((x :: int) XOR y) \<longleftrightarrow> msb x \<noteq> msb y"
 by(simp add: msb_int_def)
 
 lemma int_msb_not [simp]: "msb (NOT (x :: int)) \<longleftrightarrow> \<not> msb x"
 by(simp add: msb_int_def not_less)
 
-lemma msb_shiftl [simp]: "msb ((x :: int) << n) \<longleftrightarrow> msb x"
+lemma msb_shiftl [simp]: "msb (push_bit n (x :: int)) \<longleftrightarrow> msb x"
 by(simp add: msb_int_def)
 
-lemma msb_shiftr [simp]: "msb ((x :: int) >> r) \<longleftrightarrow> msb x"
+lemma msb_shiftr [simp]: "msb (drop_bit r (x :: int)) \<longleftrightarrow> msb x"
 by(simp add: msb_int_def)
 
 lemma msb_bin_sc [simp]: "msb (bin_sc n b x) \<longleftrightarrow> msb x"
 by(simp add: msb_conv_bin_sign)
 
 lemma msb_0 [simp]: "msb (0 :: int) = False"
 by(simp add: msb_int_def)
 
 lemma msb_1 [simp]: "msb (1 :: int) = False"
 by(simp add: msb_int_def)
 
 lemma msb_numeral [simp]:
   "msb (numeral n :: int) = False"
   "msb (- numeral n :: int) = True"
 by(simp_all add: msb_int_def)
 
 instantiation word :: (len) msb
 begin
 
 definition msb_word :: \<open>'a word \<Rightarrow> bool\<close>
   where \<open>msb a \<longleftrightarrow> bin_sign (signed_take_bit (LENGTH('a) - 1) (uint a)) = - 1\<close>
 
 lemma msb_word_eq:
   \<open>msb w \<longleftrightarrow> bit w (LENGTH('a) - 1)\<close> for w :: \<open>'a::len word\<close>
   by (simp add: msb_word_def bin_sign_lem bit_uint_iff)
 
 instance ..
 
 end
 
 lemma msb_word_iff_bit:
   \<open>msb w \<longleftrightarrow> bit w (LENGTH('a) - Suc 0)\<close>
   for w :: \<open>'a::len word\<close>
   by (simp add: msb_word_def bin_sign_def bit_uint_iff)
 
 lemma word_msb_def:
   "msb a \<longleftrightarrow> bin_sign (sint a) = - 1"
   by (simp add: msb_word_def sint_uint)
 
 lemma word_msb_sint: "msb w \<longleftrightarrow> sint w < 0"
   by (simp add: msb_word_eq bit_last_iff)
 
 lemma msb_word_iff_sless_0:
   \<open>msb w \<longleftrightarrow> w <s 0\<close>
   by (simp add: word_msb_sint word_sless_alt)
 
 lemma msb_word_of_int: "msb (word_of_int x::'a::len word) = bit x (LENGTH('a) - 1)"
   by (simp add: word_msb_def bin_sign_lem)
 
 lemma word_msb_numeral [simp]:
   "msb (numeral w::'a::len word) = bit (numeral w :: int) (LENGTH('a) - 1)"
   unfolding word_numeral_alt by (rule msb_word_of_int)
 
 lemma word_msb_neg_numeral [simp]:
   "msb (- numeral w::'a::len word) = bit (- numeral w :: int) (LENGTH('a) - 1)"
   unfolding word_neg_numeral_alt by (rule msb_word_of_int)
 
 lemma word_msb_0 [simp]: "\<not> msb (0::'a::len word)"
   by (simp add: word_msb_def bin_sign_def sint_uint sbintrunc_eq_take_bit)
 
 lemma word_msb_1 [simp]: "msb (1::'a::len word) \<longleftrightarrow> LENGTH('a) = 1"
   unfolding word_1_wi msb_word_of_int eq_iff [where 'a=nat]
   by (simp add: Suc_le_eq)
 
 lemma word_msb_nth: "msb w = bit (uint w) (LENGTH('a) - 1)"
   for w :: "'a::len word"
   by (simp add: word_msb_def sint_uint bin_sign_lem)
 
 lemma msb_nth: "msb w = bit w (LENGTH('a) - 1)"
   for w :: "'a::len word"
-  by (simp add: word_msb_nth word_test_bit_def)
-
+  by (fact msb_word_eq)
+  
 lemma word_msb_n1 [simp]: "msb (-1::'a::len word)"
   by (simp add: msb_word_eq not_le)
 
-lemma msb_shift: "msb w \<longleftrightarrow> w >> (LENGTH('a) - 1) \<noteq> 0"
+lemma msb_shift: "msb w \<longleftrightarrow> drop_bit (LENGTH('a) - 1) w \<noteq> 0"
   for w :: "'a::len word"
-  by (simp add: msb_word_eq shiftr_word_eq bit_iff_odd_drop_bit drop_bit_eq_zero_iff_not_bit_last)
+  by (simp add: msb_word_eq bit_iff_odd_drop_bit drop_bit_eq_zero_iff_not_bit_last)
 
 lemmas word_ops_msb = msb1 [unfolded msb_nth [symmetric, unfolded One_nat_def]]
 
 lemma word_sint_msb_eq: "sint x = uint x - (if msb x then 2 ^ size x else 0)"
   apply (cases \<open>LENGTH('a)\<close>)
    apply (simp_all add: msb_word_def bin_sign_def bit_simps word_size)
   apply transfer
   apply (auto simp add: take_bit_Suc_from_most signed_take_bit_eq_if_positive signed_take_bit_eq_if_negative minus_exp_eq_not_mask ac_simps)
   apply (subst disjunctive_add)
    apply (simp_all add: bit_simps)
   done
 
 lemma word_sle_msb_le: "x <=s y \<longleftrightarrow> (msb y \<longrightarrow> msb x) \<and> ((msb x \<and> \<not> msb y) \<or> x \<le> y)"
   apply (simp add: word_sle_eq word_sint_msb_eq word_size word_le_def)
   apply safe
    apply (rule order_trans[OF _ uint_ge_0])
    apply (simp add: order_less_imp_le)
   apply (erule notE[OF leD])
   apply (rule order_less_le_trans[OF _ uint_ge_0])
   apply simp
   done
 
 lemma word_sless_msb_less: "x <s y \<longleftrightarrow> (msb y \<longrightarrow> msb x) \<and> ((msb x \<and> \<not> msb y) \<or> x < y)"
   by (auto simp add: word_sless_eq word_sle_msb_le)
 
 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 add: bit_simps)
   done
 
 lemma sint_eq_uint:
   "\<not> msb x \<Longrightarrow> sint x = uint x"
   apply (simp add: msb_word_eq)
   apply transfer
   apply auto
   apply (smt One_nat_def bintrunc_bintrunc_l bintrunc_sbintrunc' diff_le_self len_gt_0 signed_take_bit_eq_if_positive)
   done
 
 lemma scast_eq_ucast:
   "\<not> msb x \<Longrightarrow> scast x = ucast x"
   apply (cases \<open>LENGTH('a)\<close>)
   apply simp
   apply (rule bit_word_eqI)
   apply (auto simp add: bit_signed_iff bit_unsigned_iff min_def msb_word_eq)
   apply (erule notE)
   apply (metis le_less_Suc_eq test_bit_bin)
   done
 
 lemma msb_ucast_eq:
     "LENGTH('a) = LENGTH('b) \<Longrightarrow>
          msb (ucast x :: ('a::len) word) = msb (x :: ('b::len) word)"
   by (simp add: msb_word_eq bit_simps)
 
 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
+  \<open>msb a \<longleftrightarrow> 2 ^ (LENGTH('a) - Suc 0) \<le> a\<close>
+  for a :: \<open>'a::len word\<close>
+  using bang_is_le [of a \<open>LENGTH('a) - Suc 0\<close>]
+  apply (auto simp add: msb_nth word_le_not_less)
   apply (rule ccontr)
+  apply (erule notE)
+  apply (rule ccontr)
+    apply (clarsimp simp: not_less)
   apply (subgoal_tac "a = a AND 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)
+    apply clarsimp
+  apply simp
+  apply (simp flip: take_bit_eq_mask)
+  apply (rule sym)
+  apply (simp add: take_bit_eq_self_iff_drop_bit_eq_0 drop_bit_eq_zero_iff_not_bit_last)
   done
 
 end
diff --git a/thys/Word_Lib/Reversed_Bit_Lists.thy b/thys/Word_Lib/Reversed_Bit_Lists.thy
--- a/thys/Word_Lib/Reversed_Bit_Lists.thy
+++ b/thys/Word_Lib/Reversed_Bit_Lists.thy
@@ -1,2281 +1,2228 @@
 (*
  * Copyright Data61, CSIRO (ABN 41 687 119 230)
  *
  * SPDX-License-Identifier: BSD-2-Clause
  *)
 
 (* Author: Jeremy Dawson, NICTA *)
 
 section \<open>Bit values as reversed lists of bools\<close>
 
 theory Reversed_Bit_Lists
   imports
     "HOL-Library.Word"
     Typedef_Morphisms
     Least_significant_bit
     Most_significant_bit
     Even_More_List
     "HOL-Library.Sublist"
     Aligned
     Legacy_Aliases
 begin
 
 lemma horner_sum_of_bool_2_concat:
   \<open>horner_sum of_bool 2 (concat (map (\<lambda>x. map (bit x) [0..<LENGTH('a)]) ws)) = horner_sum uint (2 ^ LENGTH('a)) ws\<close>
   for ws :: \<open>'a::len word list\<close>
 proof (induction ws)
   case Nil
   then show ?case
     by simp
 next
   case (Cons w ws)
   moreover have \<open>horner_sum of_bool 2 (map (bit w) [0..<LENGTH('a)]) = uint w\<close>
   proof transfer
     fix k :: int
     have \<open>map (\<lambda>n. n < LENGTH('a) \<and> bit k n) [0..<LENGTH('a)]
       = map (bit k) [0..<LENGTH('a)]\<close>
       by simp
     then show \<open>horner_sum of_bool 2 (map (\<lambda>n. n < LENGTH('a) \<and> bit k n) [0..<LENGTH('a)])
       = take_bit LENGTH('a) k\<close>
       by (simp only: horner_sum_bit_eq_take_bit)
   qed
   ultimately show ?case
     by (simp add: horner_sum_append)
 qed
 
 
 subsection \<open>Implicit augmentation of list prefixes\<close>
 
 primrec takefill :: "'a \<Rightarrow> nat \<Rightarrow> 'a list \<Rightarrow> 'a list"
 where
     Z: "takefill fill 0 xs = []"
   | Suc: "takefill fill (Suc n) xs =
       (case xs of
         [] \<Rightarrow> fill # takefill fill n xs
       | y # ys \<Rightarrow> y # takefill fill n ys)"
 
 lemma nth_takefill: "m < n \<Longrightarrow> takefill fill n l ! m = (if m < length l then l ! m else fill)"
   apply (induct n arbitrary: m l)
    apply clarsimp
   apply clarsimp
   apply (case_tac m)
    apply (simp split: list.split)
   apply (simp split: list.split)
   done
 
 lemma takefill_alt: "takefill fill n l = take n l @ replicate (n - length l) fill"
   by (induct n arbitrary: l) (auto split: list.split)
 
 lemma takefill_replicate [simp]: "takefill fill n (replicate m fill) = replicate n fill"
   by (simp add: takefill_alt replicate_add [symmetric])
 
 lemma takefill_le': "n = m + k \<Longrightarrow> takefill x m (takefill x n l) = takefill x m l"
   by (induct m arbitrary: l n) (auto split: list.split)
 
 lemma length_takefill [simp]: "length (takefill fill n l) = n"
   by (simp add: takefill_alt)
 
 lemma take_takefill': "n = k + m \<Longrightarrow> take k (takefill fill n w) = takefill fill k w"
   by (induct k arbitrary: w n) (auto split: list.split)
 
 lemma drop_takefill: "drop k (takefill fill (m + k) w) = takefill fill m (drop k w)"
   by (induct k arbitrary: w) (auto split: list.split)
 
 lemma takefill_le [simp]: "m \<le> n \<Longrightarrow> takefill x m (takefill x n l) = takefill x m l"
   by (auto simp: le_iff_add takefill_le')
 
 lemma take_takefill [simp]: "m \<le> n \<Longrightarrow> take m (takefill fill n w) = takefill fill m w"
   by (auto simp: le_iff_add take_takefill')
 
 lemma takefill_append: "takefill fill (m + length xs) (xs @ w) = xs @ (takefill fill m w)"
   by (induct xs) auto
 
 lemma takefill_same': "l = length xs \<Longrightarrow> takefill fill l xs = xs"
   by (induct xs arbitrary: l) auto
 
 lemmas takefill_same [simp] = takefill_same' [OF refl]
 
 lemma tf_rev:
   "n + k = m + length bl \<Longrightarrow> takefill x m (rev (takefill y n bl)) =
     rev (takefill y m (rev (takefill x k (rev bl))))"
   apply (rule nth_equalityI)
    apply (auto simp add: nth_takefill rev_nth)
   apply (rule_tac f = "\<lambda>n. bl ! n" in arg_cong)
   apply arith
   done
 
 lemma takefill_minus: "0 < n \<Longrightarrow> takefill fill (Suc (n - 1)) w = takefill fill n w"
   by auto
 
 lemmas takefill_Suc_cases =
   list.cases [THEN takefill.Suc [THEN trans]]
 
 lemmas takefill_Suc_Nil = takefill_Suc_cases (1)
 lemmas takefill_Suc_Cons = takefill_Suc_cases (2)
 
 lemmas takefill_minus_simps = takefill_Suc_cases [THEN [2]
   takefill_minus [symmetric, THEN trans]]
 
 lemma takefill_numeral_Nil [simp]:
   "takefill fill (numeral k) [] = fill # takefill fill (pred_numeral k) []"
   by (simp add: numeral_eq_Suc)
 
 lemma takefill_numeral_Cons [simp]:
   "takefill fill (numeral k) (x # xs) = x # takefill fill (pred_numeral k) xs"
   by (simp add: numeral_eq_Suc)
 
 
 subsection \<open>Range projection\<close>
 
 definition bl_of_nth :: "nat \<Rightarrow> (nat \<Rightarrow> 'a) \<Rightarrow> 'a list"
   where "bl_of_nth n f = map f (rev [0..<n])"
 
 lemma bl_of_nth_simps [simp, code]:
   "bl_of_nth 0 f = []"
   "bl_of_nth (Suc n) f = f n # bl_of_nth n f"
   by (simp_all add: bl_of_nth_def)
 
 lemma length_bl_of_nth [simp]: "length (bl_of_nth n f) = n"
   by (simp add: bl_of_nth_def)
 
 lemma nth_bl_of_nth [simp]: "m < n \<Longrightarrow> rev (bl_of_nth n f) ! m = f m"
   by (simp add: bl_of_nth_def rev_map)
 
 lemma bl_of_nth_inj: "(\<And>k. k < n \<Longrightarrow> f k = g k) \<Longrightarrow> bl_of_nth n f = bl_of_nth n g"
   by (simp add: bl_of_nth_def)
 
 lemma bl_of_nth_nth_le: "n \<le> length xs \<Longrightarrow> bl_of_nth n (nth (rev xs)) = drop (length xs - n) xs"
   apply (induct n arbitrary: xs)
    apply clarsimp
   apply clarsimp
   apply (rule trans [OF _ hd_Cons_tl])
    apply (frule Suc_le_lessD)
    apply (simp add: rev_nth trans [OF drop_Suc drop_tl, symmetric])
    apply (subst hd_drop_conv_nth)
     apply force
    apply simp_all
   apply (rule_tac f = "\<lambda>n. drop n xs" in arg_cong)
   apply simp
   done
 
 lemma bl_of_nth_nth [simp]: "bl_of_nth (length xs) ((!) (rev xs)) = xs"
   by (simp add: bl_of_nth_nth_le)
 
 
 subsection \<open>More\<close>
 
 definition rotater1 :: "'a list \<Rightarrow> 'a list"
   where "rotater1 ys =
     (case ys of [] \<Rightarrow> [] | x # xs \<Rightarrow> last ys # butlast ys)"
 
 definition rotater :: "nat \<Rightarrow> 'a list \<Rightarrow> 'a list"
   where "rotater n = rotater1 ^^ n"
 
 lemmas rotater_0' [simp] = rotater_def [where n = "0", simplified]
 
 lemma rotate1_rl': "rotater1 (l @ [a]) = a # l"
   by (cases l) (auto simp: rotater1_def)
 
 lemma rotate1_rl [simp] : "rotater1 (rotate1 l) = l"
   apply (unfold rotater1_def)
   apply (cases "l")
    apply (case_tac [2] "list")
     apply auto
   done
 
 lemma rotate1_lr [simp] : "rotate1 (rotater1 l) = l"
   by (cases l) (auto simp: rotater1_def)
 
 lemma rotater1_rev': "rotater1 (rev xs) = rev (rotate1 xs)"
   by (cases "xs") (simp add: rotater1_def, simp add: rotate1_rl')
 
 lemma rotater_rev': "rotater n (rev xs) = rev (rotate n xs)"
   by (induct n) (auto simp: rotater_def intro: rotater1_rev')
 
 lemma rotater_rev: "rotater n ys = rev (rotate n (rev ys))"
   using rotater_rev' [where xs = "rev ys"] by simp
 
 lemma rotater_drop_take:
   "rotater n xs =
     drop (length xs - n mod length xs) xs @
     take (length xs - n mod length xs) xs"
   by (auto simp: rotater_rev rotate_drop_take rev_take rev_drop)
 
 lemma rotater_Suc [simp]: "rotater (Suc n) xs = rotater1 (rotater n xs)"
   unfolding rotater_def by auto
 
 lemma nth_rotater:
   \<open>rotater m xs ! n = xs ! ((n + (length xs - m mod length xs)) mod length xs)\<close> if \<open>n < length xs\<close>
   using that by (simp add: rotater_drop_take nth_append not_less less_diff_conv ac_simps le_mod_geq)
 
 lemma nth_rotater1:
   \<open>rotater1 xs ! n = xs ! ((n + (length xs - 1)) mod length xs)\<close> if \<open>n < length xs\<close>
   using that nth_rotater [of n xs 1] by simp
 
 lemma rotate_inv_plus [rule_format]:
   "\<forall>k. k = m + n \<longrightarrow> rotater k (rotate n xs) = rotater m xs \<and>
     rotate k (rotater n xs) = rotate m xs \<and>
     rotater n (rotate k xs) = rotate m xs \<and>
     rotate n (rotater k xs) = rotater m xs"
   by (induct n) (auto simp: rotater_def rotate_def intro: funpow_swap1 [THEN trans])
 
 lemmas rotate_inv_rel = le_add_diff_inverse2 [symmetric, THEN rotate_inv_plus]
 
 lemmas rotate_inv_eq = order_refl [THEN rotate_inv_rel, simplified]
 
 lemmas rotate_lr [simp] = rotate_inv_eq [THEN conjunct1]
 lemmas rotate_rl [simp] = rotate_inv_eq [THEN conjunct2, THEN conjunct1]
 
 lemma rotate_gal: "rotater n xs = ys \<longleftrightarrow> rotate n ys = xs"
   by auto
 
 lemma rotate_gal': "ys = rotater n xs \<longleftrightarrow> xs = rotate n ys"
   by auto
 
 lemma length_rotater [simp]: "length (rotater n xs) = length xs"
   by (simp add : rotater_rev)
 
 lemma rotate_eq_mod: "m mod length xs = n mod length xs \<Longrightarrow> rotate m xs = rotate n xs"
   apply (rule box_equals)
     defer
     apply (rule rotate_conv_mod [symmetric])+
   apply simp
   done
 
 lemma restrict_to_left: "x = y \<Longrightarrow> x = z \<longleftrightarrow> y = z"
   by simp
 
 lemmas rotate_eqs =
   trans [OF rotate0 [THEN fun_cong] id_apply]
   rotate_rotate [symmetric]
   rotate_id
   rotate_conv_mod
   rotate_eq_mod
 
 lemmas rrs0 = rotate_eqs [THEN restrict_to_left,
   simplified rotate_gal [symmetric] rotate_gal' [symmetric]]
 lemmas rrs1 = rrs0 [THEN refl [THEN rev_iffD1]]
 lemmas rotater_eqs = rrs1 [simplified length_rotater]
 lemmas rotater_0 = rotater_eqs (1)
 lemmas rotater_add = rotater_eqs (2)
 
 lemma butlast_map: "xs \<noteq> [] \<Longrightarrow> butlast (map f xs) = map f (butlast xs)"
   by (induct xs) auto
 
 lemma rotater1_map: "rotater1 (map f xs) = map f (rotater1 xs)"
   by (cases xs) (auto simp: rotater1_def last_map butlast_map)
 
 lemma rotater_map: "rotater n (map f xs) = map f (rotater n xs)"
   by (induct n) (auto simp: rotater_def rotater1_map)
 
 lemma but_last_zip [rule_format] :
   "\<forall>ys. length xs = length ys \<longrightarrow> xs \<noteq> [] \<longrightarrow>
     last (zip xs ys) = (last xs, last ys) \<and>
     butlast (zip xs ys) = zip (butlast xs) (butlast ys)"
   apply (induct xs)
    apply auto
      apply ((case_tac ys, auto simp: neq_Nil_conv)[1])+
   done
 
 lemma but_last_map2 [rule_format] :
   "\<forall>ys. length xs = length ys \<longrightarrow> xs \<noteq> [] \<longrightarrow>
     last (map2 f xs ys) = f (last xs) (last ys) \<and>
     butlast (map2 f xs ys) = map2 f (butlast xs) (butlast ys)"
   apply (induct xs)
    apply auto
      apply ((case_tac ys, auto simp: neq_Nil_conv)[1])+
   done
 
 lemma rotater1_zip:
   "length xs = length ys \<Longrightarrow>
     rotater1 (zip xs ys) = zip (rotater1 xs) (rotater1 ys)"
   apply (unfold rotater1_def)
   apply (cases xs)
    apply auto
    apply ((case_tac ys, auto simp: neq_Nil_conv but_last_zip)[1])+
   done
 
 lemma rotater1_map2:
   "length xs = length ys \<Longrightarrow>
     rotater1 (map2 f xs ys) = map2 f (rotater1 xs) (rotater1 ys)"
   by (simp add: rotater1_map rotater1_zip)
 
 lemmas lrth =
   box_equals [OF asm_rl length_rotater [symmetric]
                  length_rotater [symmetric],
               THEN rotater1_map2]
 
 lemma rotater_map2:
   "length xs = length ys \<Longrightarrow>
     rotater n (map2 f xs ys) = map2 f (rotater n xs) (rotater n ys)"
   by (induct n) (auto intro!: lrth)
 
 lemma rotate1_map2:
   "length xs = length ys \<Longrightarrow>
     rotate1 (map2 f xs ys) = map2 f (rotate1 xs) (rotate1 ys)"
   by (cases xs; cases ys) auto
 
 lemmas lth = box_equals [OF asm_rl length_rotate [symmetric]
   length_rotate [symmetric], THEN rotate1_map2]
 
 lemma rotate_map2:
   "length xs = length ys \<Longrightarrow>
     rotate n (map2 f xs ys) = map2 f (rotate n xs) (rotate n ys)"
   by (induct n) (auto intro!: lth)
 
 
 subsection \<open>Explicit bit representation of \<^typ>\<open>int\<close>\<close>
 
 primrec bl_to_bin_aux :: "bool list \<Rightarrow> int \<Rightarrow> int"
   where
     Nil: "bl_to_bin_aux [] w = w"
   | Cons: "bl_to_bin_aux (b # bs) w = bl_to_bin_aux bs (of_bool b + 2 * w)"
 
 definition bl_to_bin :: "bool list \<Rightarrow> int"
   where "bl_to_bin bs = bl_to_bin_aux bs 0"
 
 primrec bin_to_bl_aux :: "nat \<Rightarrow> int \<Rightarrow> bool list \<Rightarrow> bool list"
   where
     Z: "bin_to_bl_aux 0 w bl = bl"
   | Suc: "bin_to_bl_aux (Suc n) w bl = bin_to_bl_aux n (w div 2) (odd w # bl)"
 
 definition bin_to_bl :: "nat \<Rightarrow> int \<Rightarrow> bool list"
   where "bin_to_bl n w = bin_to_bl_aux n w []"
 
 lemma bin_to_bl_aux_zero_minus_simp [simp]:
   "0 < n \<Longrightarrow> bin_to_bl_aux n 0 bl = bin_to_bl_aux (n - 1) 0 (False # bl)"
   by (cases n) auto
 
 lemma bin_to_bl_aux_minus1_minus_simp [simp]:
   "0 < n \<Longrightarrow> bin_to_bl_aux n (- 1) bl = bin_to_bl_aux (n - 1) (- 1) (True # bl)"
   by (cases n) auto
 
 lemma bin_to_bl_aux_one_minus_simp [simp]:
   "0 < n \<Longrightarrow> bin_to_bl_aux n 1 bl = bin_to_bl_aux (n - 1) 0 (True # bl)"
   by (cases n) auto
 
 lemma bin_to_bl_aux_Bit0_minus_simp [simp]:
   "0 < n \<Longrightarrow>
     bin_to_bl_aux n (numeral (Num.Bit0 w)) bl = bin_to_bl_aux (n - 1) (numeral w) (False # bl)"
   by (cases n) simp_all
 
 lemma bin_to_bl_aux_Bit1_minus_simp [simp]:
   "0 < n \<Longrightarrow>
     bin_to_bl_aux n (numeral (Num.Bit1 w)) bl = bin_to_bl_aux (n - 1) (numeral w) (True # bl)"
   by (cases n) simp_all
 
 lemma bl_to_bin_aux_append: "bl_to_bin_aux (bs @ cs) w = bl_to_bin_aux cs (bl_to_bin_aux bs w)"
   by (induct bs arbitrary: w) auto
 
 lemma bin_to_bl_aux_append: "bin_to_bl_aux n w bs @ cs = bin_to_bl_aux n w (bs @ cs)"
   by (induct n arbitrary: w bs) auto
 
 lemma bl_to_bin_append: "bl_to_bin (bs @ cs) = bl_to_bin_aux cs (bl_to_bin bs)"
   unfolding bl_to_bin_def by (rule bl_to_bin_aux_append)
 
 lemma bin_to_bl_aux_alt: "bin_to_bl_aux n w bs = bin_to_bl n w @ bs"
   by (simp add: bin_to_bl_def bin_to_bl_aux_append)
 
 lemma bin_to_bl_0 [simp]: "bin_to_bl 0 bs = []"
   by (auto simp: bin_to_bl_def)
 
 lemma size_bin_to_bl_aux: "length (bin_to_bl_aux n w bs) = n + length bs"
   by (induct n arbitrary: w bs) auto
 
 lemma size_bin_to_bl [simp]: "length (bin_to_bl n w) = n"
   by (simp add: bin_to_bl_def size_bin_to_bl_aux)
 
 lemma bl_bin_bl': "bin_to_bl (n + length bs) (bl_to_bin_aux bs w) = bin_to_bl_aux n w bs"
   apply (induct bs arbitrary: w n)
    apply auto
     apply (simp_all only: add_Suc [symmetric])
     apply (auto simp add: bin_to_bl_def)
   done
 
 lemma bl_bin_bl [simp]: "bin_to_bl (length bs) (bl_to_bin bs) = bs"
   unfolding bl_to_bin_def
   apply (rule box_equals)
     apply (rule bl_bin_bl')
    prefer 2
    apply (rule bin_to_bl_aux.Z)
   apply simp
   done
 
 lemma bl_to_bin_inj: "bl_to_bin bs = bl_to_bin cs \<Longrightarrow> length bs = length cs \<Longrightarrow> bs = cs"
   apply (rule_tac box_equals)
     defer
     apply (rule bl_bin_bl)
    apply (rule bl_bin_bl)
   apply simp
   done
 
 lemma bl_to_bin_False [simp]: "bl_to_bin (False # bl) = bl_to_bin bl"
   by (auto simp: bl_to_bin_def)
 
 lemma bl_to_bin_Nil [simp]: "bl_to_bin [] = 0"
   by (auto simp: bl_to_bin_def)
 
 lemma bin_to_bl_zero_aux: "bin_to_bl_aux n 0 bl = replicate n False @ bl"
   by (induct n arbitrary: bl) (auto simp: replicate_app_Cons_same)
 
 lemma bin_to_bl_zero: "bin_to_bl n 0 = replicate n False"
   by (simp add: bin_to_bl_def bin_to_bl_zero_aux)
 
 lemma bin_to_bl_minus1_aux: "bin_to_bl_aux n (- 1) bl = replicate n True @ bl"
   by (induct n arbitrary: bl) (auto simp: replicate_app_Cons_same)
 
 lemma bin_to_bl_minus1: "bin_to_bl n (- 1) = replicate n True"
   by (simp add: bin_to_bl_def bin_to_bl_minus1_aux)
 
 
 subsection \<open>Semantic interpretation of \<^typ>\<open>bool list\<close> as \<^typ>\<open>int\<close>\<close>
 
 lemma bin_bl_bin': "bl_to_bin (bin_to_bl_aux n w bs) = bl_to_bin_aux bs (take_bit n w)"
   by (induct n arbitrary: w bs) (auto simp: bl_to_bin_def take_bit_Suc ac_simps mod_2_eq_odd)
 
 lemma bin_bl_bin [simp]: "bl_to_bin (bin_to_bl n w) = take_bit n w"
   by (auto simp: bin_to_bl_def bin_bl_bin')
 
 lemma bl_to_bin_rep_F: "bl_to_bin (replicate n False @ bl) = bl_to_bin bl"
   by (simp add: bin_to_bl_zero_aux [symmetric] bin_bl_bin') (simp add: bl_to_bin_def)
 
 lemma bin_to_bl_trunc [simp]: "n \<le> m \<Longrightarrow> bin_to_bl n (take_bit m w) = bin_to_bl n w"
   by (auto intro: bl_to_bin_inj)
 
 lemma bin_to_bl_aux_bintr:
   "bin_to_bl_aux n (take_bit m bin) bl =
     replicate (n - m) False @ bin_to_bl_aux (min n m) bin bl"
   apply (induct n arbitrary: m bin bl)
    apply clarsimp
   apply clarsimp
   apply (case_tac "m")
    apply (clarsimp simp: bin_to_bl_zero_aux)
    apply (erule thin_rl)
    apply (induct_tac n)
     apply (auto simp add: take_bit_Suc)
   done
 
 lemma bin_to_bl_bintr:
   "bin_to_bl n (take_bit m bin) = replicate (n - m) False @ bin_to_bl (min n m) bin"
   unfolding bin_to_bl_def by (rule bin_to_bl_aux_bintr)
 
 lemma bl_to_bin_rep_False: "bl_to_bin (replicate n False) = 0"
   by (induct n) auto
 
 lemma len_bin_to_bl_aux: "length (bin_to_bl_aux n w bs) = n + length bs"
   by (fact size_bin_to_bl_aux)
 
 lemma len_bin_to_bl: "length (bin_to_bl n w) = n"
   by (fact size_bin_to_bl) (* FIXME: duplicate *)
 
 lemma sign_bl_bin': "bin_sign (bl_to_bin_aux bs w) = bin_sign w"
   by (induction bs arbitrary: w) (simp_all add: bin_sign_def)
 
 lemma sign_bl_bin: "bin_sign (bl_to_bin bs) = 0"
   by (simp add: bl_to_bin_def sign_bl_bin')
 
 lemma bl_sbin_sign_aux: "hd (bin_to_bl_aux (Suc n) w bs) = (bin_sign (signed_take_bit n w) = -1)"
   by (induction n arbitrary: w bs) (auto simp add: bin_sign_def even_iff_mod_2_eq_zero bit_Suc)
 
 lemma bl_sbin_sign: "hd (bin_to_bl (Suc n) w) = (bin_sign (signed_take_bit n w) = -1)"
   unfolding bin_to_bl_def by (rule bl_sbin_sign_aux)
 
 lemma bin_nth_of_bl_aux:
   "bit (bl_to_bin_aux bl w) n =
     (n < size bl \<and> rev bl ! n \<or> n \<ge> length bl \<and> bit w (n - size bl))"
   apply (induction bl arbitrary: w)
    apply simp_all
   apply safe
                       apply (simp_all add: not_le nth_append bit_double_iff even_bit_succ_iff split: if_splits)
   done
 
 lemma bin_nth_of_bl: "bit (bl_to_bin bl) n = (n < length bl \<and> rev bl ! n)"
   by (simp add: bl_to_bin_def bin_nth_of_bl_aux)
 
 lemma bin_nth_bl: "n < m \<Longrightarrow> bit w n = nth (rev (bin_to_bl m w)) n"
   apply (induct n arbitrary: m w)
    apply clarsimp
    apply (case_tac m, clarsimp)
    apply (clarsimp simp: bin_to_bl_def)
    apply (simp add: bin_to_bl_aux_alt)
   apply (case_tac m, clarsimp)
   apply (clarsimp simp: bin_to_bl_def)
   apply (simp add: bin_to_bl_aux_alt bit_Suc)
   done
 
 lemma nth_bin_to_bl_aux:
   "n < m + length bl \<Longrightarrow> (bin_to_bl_aux m w bl) ! n =
     (if n < m then bit w (m - 1 - n) else bl ! (n - m))"
   apply (induction bl arbitrary: w)
    apply simp_all
    apply (simp add: bin_nth_bl [of \<open>m - Suc n\<close> m] rev_nth flip: bin_to_bl_def)
    apply (metis One_nat_def Suc_pred add_diff_cancel_left'
      add_diff_cancel_right' bin_to_bl_aux_alt bin_to_bl_def
      diff_Suc_Suc diff_is_0_eq diff_zero less_Suc_eq_0_disj
      less_antisym less_imp_Suc_add list.size(3) nat_less_le nth_append size_bin_to_bl_aux)
   done
 
 lemma nth_bin_to_bl: "n < m \<Longrightarrow> (bin_to_bl m w) ! n = bit w (m - Suc n)"
   by (simp add: bin_to_bl_def nth_bin_to_bl_aux)
 
 lemma takefill_bintrunc: "takefill False n bl = rev (bin_to_bl n (bl_to_bin (rev bl)))"
   apply (rule nth_equalityI)
    apply simp
   apply (clarsimp simp: nth_takefill rev_nth nth_bin_to_bl bin_nth_of_bl)
   done
 
 lemma bl_bin_bl_rtf: "bin_to_bl n (bl_to_bin bl) = rev (takefill False n (rev bl))"
   by (simp add: takefill_bintrunc)
 
 lemma bl_to_bin_lt2p_aux: "bl_to_bin_aux bs w < (w + 1) * (2 ^ length bs)"
 proof (induction bs arbitrary: w)
   case Nil
   then show ?case
     by simp
 next
   case (Cons b bs)
   from Cons.IH [of \<open>1 + 2 * w\<close>] Cons.IH [of \<open>2 * w\<close>]
   show ?case
     apply (auto simp add: algebra_simps)
     apply (subst mult_2 [of \<open>2 ^ length bs\<close>])
     apply (simp only: add.assoc)
     apply (rule pos_add_strict)
      apply simp_all
     done
 qed
 
 lemma bl_to_bin_lt2p_drop: "bl_to_bin bs < 2 ^ length (dropWhile Not bs)"
 proof (induct bs)
   case Nil
   then show ?case by simp
 next
   case (Cons b bs)
   with bl_to_bin_lt2p_aux[where w=1] show ?case
     by (simp add: bl_to_bin_def)
 qed
 
 lemma bl_to_bin_lt2p: "bl_to_bin bs < 2 ^ length bs"
   by (metis bin_bl_bin bintr_lt2p bl_bin_bl)
 
 lemma bl_to_bin_ge2p_aux: "bl_to_bin_aux bs w \<ge> w * (2 ^ length bs)"
 proof (induction bs arbitrary: w)
   case Nil
   then show ?case
     by simp
 next
   case (Cons b bs)
   from Cons.IH [of \<open>1 + 2 * w\<close>] Cons.IH [of \<open>2 * w\<close>]
   show ?case
     apply (auto simp add: algebra_simps)
     apply (rule add_le_imp_le_left [of \<open>2 ^ length bs\<close>])
     apply (rule add_increasing)
     apply simp_all
     done
 qed
 
 lemma bl_to_bin_ge0: "bl_to_bin bs \<ge> 0"
   apply (unfold bl_to_bin_def)
   apply (rule xtrans(4))
    apply (rule bl_to_bin_ge2p_aux)
   apply simp
   done
 
 lemma butlast_rest_bin: "butlast (bin_to_bl n w) = bin_to_bl (n - 1) (w div 2)"
   apply (unfold bin_to_bl_def)
   apply (cases n, clarsimp)
   apply clarsimp
   apply (auto simp add: bin_to_bl_aux_alt)
   done
 
 lemma butlast_bin_rest: "butlast bl = bin_to_bl (length bl - Suc 0) (bl_to_bin bl div 2)"
   using butlast_rest_bin [where w="bl_to_bin bl" and n="length bl"] by simp
 
 lemma butlast_rest_bl2bin_aux:
   "bl \<noteq> [] \<Longrightarrow> bl_to_bin_aux (butlast bl) w = bl_to_bin_aux bl w div 2"
   by (induct bl arbitrary: w) auto
 
 lemma butlast_rest_bl2bin: "bl_to_bin (butlast bl) = bl_to_bin bl div 2"
   by (cases bl) (auto simp: bl_to_bin_def butlast_rest_bl2bin_aux)
 
 lemma trunc_bl2bin_aux:
   "take_bit m (bl_to_bin_aux bl w) =
     bl_to_bin_aux (drop (length bl - m) bl) (take_bit (m - length bl) w)"
 proof (induct bl arbitrary: w)
   case Nil
   show ?case by simp
 next
   case (Cons b bl)
   show ?case
   proof (cases "m - length bl")
     case 0
     then have "Suc (length bl) - m = Suc (length bl - m)" by simp
     with Cons show ?thesis by simp
   next
     case (Suc n)
     then have "m - Suc (length bl) = n" by simp
     with Cons Suc show ?thesis by (simp add: take_bit_Suc ac_simps)
   qed
 qed
 
 lemma trunc_bl2bin: "take_bit m (bl_to_bin bl) = bl_to_bin (drop (length bl - m) bl)"
   by (simp add: bl_to_bin_def trunc_bl2bin_aux)
 
 lemma trunc_bl2bin_len [simp]: "take_bit (length bl) (bl_to_bin bl) = bl_to_bin bl"
   by (simp add: trunc_bl2bin)
 
 lemma bl2bin_drop: "bl_to_bin (drop k bl) = take_bit (length bl - k) (bl_to_bin bl)"
   apply (rule trans)
    prefer 2
    apply (rule trunc_bl2bin [symmetric])
   apply (cases "k \<le> length bl")
    apply auto
   done
 
 lemma take_rest_power_bin: "m \<le> n \<Longrightarrow> take m (bin_to_bl n w) = bin_to_bl m (((\<lambda>w. w div 2) ^^ (n - m)) w)"
   apply (rule nth_equalityI)
    apply simp
   apply (clarsimp simp add: nth_bin_to_bl nth_rest_power_bin)
   done
 
 lemma last_bin_last': "size xs > 0 \<Longrightarrow> last xs \<longleftrightarrow> odd (bl_to_bin_aux xs w)"
   by (induct xs arbitrary: w) auto
 
 lemma last_bin_last: "size xs > 0 \<Longrightarrow> last xs \<longleftrightarrow> odd (bl_to_bin xs)"
   unfolding bl_to_bin_def by (erule last_bin_last')
 
 lemma bin_last_last: "odd w \<longleftrightarrow> last (bin_to_bl (Suc n) w)"
   by (simp add: bin_to_bl_def) (auto simp: bin_to_bl_aux_alt)
 
 lemma drop_bin2bl_aux:
   "drop m (bin_to_bl_aux n bin bs) =
     bin_to_bl_aux (n - m) bin (drop (m - n) bs)"
   apply (induction n arbitrary: m bin bs)
    apply auto
   apply (case_tac "m \<le> n")
    apply (auto simp add: not_le Suc_diff_le)
   apply (case_tac "m - n")
    apply auto
   apply (use Suc_diff_Suc in fastforce)
   done
 
 lemma drop_bin2bl: "drop m (bin_to_bl n bin) = bin_to_bl (n - m) bin"
   by (simp add: bin_to_bl_def drop_bin2bl_aux)
 
 lemma take_bin2bl_lem1: "take m (bin_to_bl_aux m w bs) = bin_to_bl m w"
   apply (induct m arbitrary: w bs)
    apply clarsimp
   apply clarsimp
   apply (simp add: bin_to_bl_aux_alt)
   apply (simp add: bin_to_bl_def)
   apply (simp add: bin_to_bl_aux_alt)
   done
 
 lemma take_bin2bl_lem: "take m (bin_to_bl_aux (m + n) w bs) = take m (bin_to_bl (m + n) w)"
   by (induct n arbitrary: w bs) (simp_all (no_asm) add: bin_to_bl_def take_bin2bl_lem1, simp)
 
 lemma bin_split_take: "bin_split n c = (a, b) \<Longrightarrow> bin_to_bl m a = take m (bin_to_bl (m + n) c)"
   apply (induct n arbitrary: b c)
    apply clarsimp
   apply (clarsimp simp: Let_def split: prod.split_asm)
   apply (simp add: bin_to_bl_def)
   apply (simp add: take_bin2bl_lem drop_bit_Suc)
   done
 
 lemma bin_to_bl_drop_bit:
   "k = m + n \<Longrightarrow> bin_to_bl m (drop_bit n c) = take m (bin_to_bl k c)"
   using bin_split_take by simp
 
 lemma bin_split_take1:
   "k = m + n \<Longrightarrow> bin_split n c = (a, b) \<Longrightarrow> bin_to_bl m a = take m (bin_to_bl k c)"
   using bin_split_take by simp
 
 lemma bl_bin_bl_rep_drop:
   "bin_to_bl n (bl_to_bin bl) =
     replicate (n - length bl) False @ drop (length bl - n) bl"
   by (simp add: bl_to_bin_inj bl_to_bin_rep_F trunc_bl2bin)
 
 lemma bl_to_bin_aux_cat:
   "bl_to_bin_aux bs (concat_bit nv v w) =
     concat_bit (nv + length bs) (bl_to_bin_aux bs v) w"
   by (rule bit_eqI)
     (auto simp add: bin_nth_of_bl_aux bin_nth_cat algebra_simps)
 
 lemma bin_to_bl_aux_cat:
   "bin_to_bl_aux (nv + nw) (concat_bit nw w v) bs =
     bin_to_bl_aux nv v (bin_to_bl_aux nw w bs)"
   by (induction nw arbitrary: w bs) (simp_all add: concat_bit_Suc)
 
 lemma bl_to_bin_aux_alt: "bl_to_bin_aux bs w = concat_bit (length bs) (bl_to_bin bs) w"
   using bl_to_bin_aux_cat [where nv = "0" and v = "0"]
   by (simp add: bl_to_bin_def [symmetric])
 
 lemma bin_to_bl_cat:
   "bin_to_bl (nv + nw) (concat_bit nw w v) =
     bin_to_bl_aux nv v (bin_to_bl nw w)"
   by (simp add: bin_to_bl_def bin_to_bl_aux_cat)
 
 lemmas bl_to_bin_aux_app_cat =
   trans [OF bl_to_bin_aux_append bl_to_bin_aux_alt]
 
 lemmas bin_to_bl_aux_cat_app =
   trans [OF bin_to_bl_aux_cat bin_to_bl_aux_alt]
 
 lemma bl_to_bin_app_cat:
   "bl_to_bin (bsa @ bs) = concat_bit (length bs) (bl_to_bin bs) (bl_to_bin bsa)"
   by (simp only: bl_to_bin_aux_app_cat bl_to_bin_def)
 
 lemma bin_to_bl_cat_app:
   "bin_to_bl (n + nw) (concat_bit nw wa w) = bin_to_bl n w @ bin_to_bl nw wa"
   by (simp only: bin_to_bl_def bin_to_bl_aux_cat_app)
 
 text \<open>\<open>bl_to_bin_app_cat_alt\<close> and \<open>bl_to_bin_app_cat\<close> are easily interderivable.\<close>
 lemma bl_to_bin_app_cat_alt: "concat_bit n w (bl_to_bin cs) = bl_to_bin (cs @ bin_to_bl n w)"
   by (simp add: bl_to_bin_app_cat)
 
 lemma mask_lem: "(bl_to_bin (True # replicate n False)) = bl_to_bin (replicate n True) + 1"
   apply (unfold bl_to_bin_def)
   apply (induct n)
    apply simp
   apply (simp only: Suc_eq_plus1 replicate_add append_Cons [symmetric] bl_to_bin_aux_append)
   apply simp
   done
 
 lemma bin_exhaust:
   "(\<And>x b. bin = of_bool b + 2 * x \<Longrightarrow> Q) \<Longrightarrow> Q" for bin :: int
   apply (cases \<open>even bin\<close>)
    apply (auto elim!: evenE oddE)
    apply fastforce
   apply fastforce
   done
 
 primrec rbl_succ :: "bool list \<Rightarrow> bool list"
   where
     Nil: "rbl_succ Nil = Nil"
   | Cons: "rbl_succ (x # xs) = (if x then False # rbl_succ xs else True # xs)"
 
 primrec rbl_pred :: "bool list \<Rightarrow> bool list"
   where
     Nil: "rbl_pred Nil = Nil"
   | Cons: "rbl_pred (x # xs) = (if x then False # xs else True # rbl_pred xs)"
 
 primrec rbl_add :: "bool list \<Rightarrow> bool list \<Rightarrow> bool list"
   where \<comment> \<open>result is length of first arg, second arg may be longer\<close>
     Nil: "rbl_add Nil x = Nil"
   | Cons: "rbl_add (y # ys) x =
       (let ws = rbl_add ys (tl x)
        in (y \<noteq> hd x) # (if hd x \<and> y then rbl_succ ws else ws))"
 
 primrec rbl_mult :: "bool list \<Rightarrow> bool list \<Rightarrow> bool list"
   where \<comment> \<open>result is length of first arg, second arg may be longer\<close>
     Nil: "rbl_mult Nil x = Nil"
   | Cons: "rbl_mult (y # ys) x =
       (let ws = False # rbl_mult ys x
        in if y then rbl_add ws x else ws)"
 
 lemma size_rbl_pred: "length (rbl_pred bl) = length bl"
   by (induct bl) auto
 
 lemma size_rbl_succ: "length (rbl_succ bl) = length bl"
   by (induct bl) auto
 
 lemma size_rbl_add: "length (rbl_add bl cl) = length bl"
   by (induct bl arbitrary: cl) (auto simp: Let_def size_rbl_succ)
 
 lemma size_rbl_mult: "length (rbl_mult bl cl) = length bl"
   by (induct bl arbitrary: cl) (auto simp add: Let_def size_rbl_add)
 
 lemmas rbl_sizes [simp] =
   size_rbl_pred size_rbl_succ size_rbl_add size_rbl_mult
 
 lemmas rbl_Nils =
   rbl_pred.Nil rbl_succ.Nil rbl_add.Nil rbl_mult.Nil
 
 lemma rbl_add_app2: "length blb \<ge> length bla \<Longrightarrow> rbl_add bla (blb @ blc) = rbl_add bla blb"
   apply (induct bla arbitrary: blb)
    apply simp
   apply clarsimp
   apply (case_tac blb, clarsimp)
   apply (clarsimp simp: Let_def)
   done
 
 lemma rbl_add_take2:
   "length blb \<ge> length bla \<Longrightarrow> rbl_add bla (take (length bla) blb) = rbl_add bla blb"
   apply (induct bla arbitrary: blb)
    apply simp
   apply clarsimp
   apply (case_tac blb, clarsimp)
   apply (clarsimp simp: Let_def)
   done
 
 lemma rbl_mult_app2: "length blb \<ge> length bla \<Longrightarrow> rbl_mult bla (blb @ blc) = rbl_mult bla blb"
   apply (induct bla arbitrary: blb)
    apply simp
   apply clarsimp
   apply (case_tac blb, clarsimp)
   apply (clarsimp simp: Let_def rbl_add_app2)
   done
 
 lemma rbl_mult_take2:
   "length blb \<ge> length bla \<Longrightarrow> rbl_mult bla (take (length bla) blb) = rbl_mult bla blb"
   apply (rule trans)
    apply (rule rbl_mult_app2 [symmetric])
    apply simp
   apply (rule_tac f = "rbl_mult bla" in arg_cong)
   apply (rule append_take_drop_id)
   done
 
 lemma rbl_add_split:
   "P (rbl_add (y # ys) (x # xs)) =
     (\<forall>ws. length ws = length ys \<longrightarrow> ws = rbl_add ys xs \<longrightarrow>
       (y \<longrightarrow> ((x \<longrightarrow> P (False # rbl_succ ws)) \<and> (\<not> x \<longrightarrow> P (True # ws)))) \<and>
       (\<not> y \<longrightarrow> P (x # ws)))"
   by (cases y) (auto simp: Let_def)
 
 lemma rbl_mult_split:
   "P (rbl_mult (y # ys) xs) =
     (\<forall>ws. length ws = Suc (length ys) \<longrightarrow> ws = False # rbl_mult ys xs \<longrightarrow>
       (y \<longrightarrow> P (rbl_add ws xs)) \<and> (\<not> y \<longrightarrow> P ws))"
   by (auto simp: Let_def)
 
 lemma rbl_pred: "rbl_pred (rev (bin_to_bl n bin)) = rev (bin_to_bl n (bin - 1))"
 proof (unfold bin_to_bl_def, induction n arbitrary: bin)
   case 0
   then show ?case
     by simp
 next
   case (Suc n)
   obtain b k where \<open>bin = of_bool b + 2 * k\<close>
     using bin_exhaust by blast
   moreover have \<open>(2 * k - 1) div 2 = k - 1\<close>
     using even_succ_div_2 [of \<open>2 * (k - 1)\<close>]
     by simp
   ultimately show ?case
     using Suc [of \<open>bin div 2\<close>]
     by simp (auto simp add: bin_to_bl_aux_alt)
 qed
 
 lemma rbl_succ: "rbl_succ (rev (bin_to_bl n bin)) = rev (bin_to_bl n (bin + 1))"
   apply (unfold bin_to_bl_def)
   apply (induction n arbitrary: bin)
    apply simp_all
   apply (case_tac bin rule: bin_exhaust)
    apply (simp_all add: bin_to_bl_aux_alt ac_simps)
   done
 
 lemma rbl_add:
   "\<And>bina binb. rbl_add (rev (bin_to_bl n bina)) (rev (bin_to_bl n binb)) =
     rev (bin_to_bl n (bina + binb))"
   apply (unfold bin_to_bl_def)
   apply (induct n)
    apply simp
   apply clarsimp
   apply (case_tac bina rule: bin_exhaust)
   apply (case_tac binb rule: bin_exhaust)
   apply (case_tac b)
    apply (case_tac [!] "ba")
      apply (auto simp: rbl_succ bin_to_bl_aux_alt Let_def ac_simps)
   done
 
 lemma rbl_add_long:
   "m \<ge> n \<Longrightarrow> rbl_add (rev (bin_to_bl n bina)) (rev (bin_to_bl m binb)) =
     rev (bin_to_bl n (bina + binb))"
   apply (rule box_equals [OF _ rbl_add_take2 rbl_add])
    apply (rule_tac f = "rbl_add (rev (bin_to_bl n bina))" in arg_cong)
    apply (rule rev_swap [THEN iffD1])
    apply (simp add: rev_take drop_bin2bl)
   apply simp
   done
 
 lemma rbl_mult_gt1:
   "m \<ge> length bl \<Longrightarrow>
     rbl_mult bl (rev (bin_to_bl m binb)) =
     rbl_mult bl (rev (bin_to_bl (length bl) binb))"
   apply (rule trans)
    apply (rule rbl_mult_take2 [symmetric])
    apply simp_all
   apply (rule_tac f = "rbl_mult bl" in arg_cong)
   apply (rule rev_swap [THEN iffD1])
   apply (simp add: rev_take drop_bin2bl)
   done
 
 lemma rbl_mult_gt:
   "m > n \<Longrightarrow>
     rbl_mult (rev (bin_to_bl n bina)) (rev (bin_to_bl m binb)) =
     rbl_mult (rev (bin_to_bl n bina)) (rev (bin_to_bl n binb))"
   by (auto intro: trans [OF rbl_mult_gt1])
 
 lemmas rbl_mult_Suc = lessI [THEN rbl_mult_gt]
 
 lemma rbbl_Cons: "b # rev (bin_to_bl n x) = rev (bin_to_bl (Suc n) (of_bool b + 2 * x))"
   by (simp add: bin_to_bl_def) (simp add: bin_to_bl_aux_alt)
 
 lemma rbl_mult:
   "rbl_mult (rev (bin_to_bl n bina)) (rev (bin_to_bl n binb)) =
     rev (bin_to_bl n (bina * binb))"
   apply (induct n arbitrary: bina binb)
    apply simp_all
   apply (unfold bin_to_bl_def)
   apply clarsimp
   apply (case_tac bina rule: bin_exhaust)
   apply (case_tac binb rule: bin_exhaust)
   apply (simp_all add: bin_to_bl_aux_alt)
   apply (simp_all add: rbbl_Cons rbl_mult_Suc rbl_add algebra_simps)
   done
 
 lemma sclem: "size (concat (map (bin_to_bl n) xs)) = length xs * n"
   by (simp add: length_concat comp_def sum_list_triv)
 
 lemma bin_cat_foldl_lem:
   "foldl (\<lambda>u k. concat_bit n k u) x xs =
     concat_bit (size xs * n) (foldl (\<lambda>u k. concat_bit n k u) y xs) x"
   apply (induct xs arbitrary: x)
    apply simp
   apply (simp (no_asm))
   apply (frule asm_rl)
   apply (drule meta_spec)
   apply (erule trans)
   apply (drule_tac x = "concat_bit n a y" in meta_spec)
   apply (simp add: bin_cat_assoc_sym)
   done
 
 lemma bin_rcat_bl: "bin_rcat n wl = bl_to_bin (concat (map (bin_to_bl n) wl))"
   apply (unfold bin_rcat_eq_foldl)
   apply (rule sym)
   apply (induct wl)
    apply (auto simp add: bl_to_bin_append)
   apply (simp add: bl_to_bin_aux_alt sclem)
   apply (simp add: bin_cat_foldl_lem [symmetric])
   done
 
 lemma bin_last_bl_to_bin: "odd (bl_to_bin bs) \<longleftrightarrow> bs \<noteq> [] \<and> last bs"
 by(cases "bs = []")(auto simp add: bl_to_bin_def last_bin_last'[where w=0])
 
 lemma bin_rest_bl_to_bin: "bl_to_bin bs div 2 = bl_to_bin (butlast bs)"
 by(cases "bs = []")(simp_all add: bl_to_bin_def butlast_rest_bl2bin_aux)
 
 lemma bl_xor_aux_bin:
   "map2 (\<lambda>x y. x \<noteq> y) (bin_to_bl_aux n v bs) (bin_to_bl_aux n w cs) =
     bin_to_bl_aux n (v XOR w) (map2 (\<lambda>x y. x \<noteq> y) bs cs)"
   apply (induction n arbitrary: v w bs cs)
    apply auto
   apply (case_tac v rule: bin_exhaust)
   apply (case_tac w rule: bin_exhaust)
   apply clarsimp
   done
 
 lemma bl_or_aux_bin:
   "map2 (\<or>) (bin_to_bl_aux n v bs) (bin_to_bl_aux n w cs) =
     bin_to_bl_aux n (v OR w) (map2 (\<or>) bs cs)"
   by (induct n arbitrary: v w bs cs) simp_all
 
 lemma bl_and_aux_bin:
   "map2 (\<and>) (bin_to_bl_aux n v bs) (bin_to_bl_aux n w cs) =
     bin_to_bl_aux n (v AND w) (map2 (\<and>) bs cs)"
   by (induction n arbitrary: v w bs cs) simp_all
 
 lemma bl_not_aux_bin: "map Not (bin_to_bl_aux n w cs) = bin_to_bl_aux n (NOT w) (map Not cs)"
   by (induct n arbitrary: w cs) auto
 
 lemma bl_not_bin: "map Not (bin_to_bl n w) = bin_to_bl n (NOT w)"
   by (simp add: bin_to_bl_def bl_not_aux_bin)
 
 lemma bl_and_bin: "map2 (\<and>) (bin_to_bl n v) (bin_to_bl n w) = bin_to_bl n (v AND w)"
   by (simp add: bin_to_bl_def bl_and_aux_bin)
 
 lemma bl_or_bin: "map2 (\<or>) (bin_to_bl n v) (bin_to_bl n w) = bin_to_bl n (v OR w)"
   by (simp add: bin_to_bl_def bl_or_aux_bin)
 
 lemma bl_xor_bin: "map2 (\<noteq>) (bin_to_bl n v) (bin_to_bl n w) = bin_to_bl n (v XOR w)"
   using bl_xor_aux_bin by (simp add: bin_to_bl_def)
 
 
 subsection \<open>Type \<^typ>\<open>'a word\<close>\<close>
 
 lift_definition of_bl :: \<open>bool list \<Rightarrow> 'a::len word\<close>
   is bl_to_bin .
 
 lift_definition to_bl :: \<open>'a::len word \<Rightarrow> bool list\<close>
   is \<open>bin_to_bl LENGTH('a)\<close>
   by (simp add: bl_to_bin_inj)
 
 lemma to_bl_eq:
   \<open>to_bl w = bin_to_bl (LENGTH('a)) (uint w)\<close>
   for w :: \<open>'a::len word\<close>
   by transfer simp
 
 lemma bit_of_bl_iff [bit_simps]:
   \<open>bit (of_bl bs :: 'a word) n \<longleftrightarrow> rev bs ! n \<and> n < LENGTH('a::len) \<and> n < length bs\<close>
   by transfer (simp add: bin_nth_of_bl ac_simps)
 
 lemma rev_to_bl_eq:
   \<open>rev (to_bl w) = map (bit w) [0..<LENGTH('a)]\<close>
   for w :: \<open>'a::len word\<close>
   apply (rule nth_equalityI)
    apply (simp add: to_bl.rep_eq)
   apply (simp add: bin_nth_bl bit_word.rep_eq to_bl.rep_eq)
   done
 
 lemma to_bl_eq_rev:
   \<open>to_bl w = map (bit w) (rev [0..<LENGTH('a)])\<close>
   for w :: \<open>'a::len word\<close>
   using rev_to_bl_eq [of w]
   apply (subst rev_is_rev_conv [symmetric])
   apply (simp add: rev_map)
   done
 
 lemma of_bl_rev_eq:
   \<open>of_bl (rev bs) = horner_sum of_bool 2 bs\<close>
   apply (rule bit_word_eqI)
   apply (simp add: bit_of_bl_iff)
   apply transfer
   apply (simp add: bit_horner_sum_bit_iff ac_simps)
   done
 
 lemma of_bl_eq:
   \<open>of_bl bs = horner_sum of_bool 2 (rev bs)\<close>
   using of_bl_rev_eq [of \<open>rev bs\<close>] by simp
 
 lemma bshiftr1_eq:
   \<open>bshiftr1 b w = of_bl (b # butlast (to_bl w))\<close>
   apply (rule bit_word_eqI)
   apply (auto simp add: bit_simps to_bl_eq_rev nth_append rev_nth nth_butlast not_less simp flip: bit_Suc)
   apply (metis Suc_pred len_gt_0 less_eq_decr_length_iff not_bit_length verit_la_disequality)
   done
 
 lemma length_to_bl_eq:
   \<open>length (to_bl w) = LENGTH('a)\<close>
   for w :: \<open>'a::len word\<close>
   by transfer simp
 
 lemma word_rotr_eq:
   \<open>word_rotr n w = of_bl (rotater n (to_bl w))\<close>
   apply (rule bit_word_eqI)
   subgoal for n
     apply (cases \<open>n < LENGTH('a)\<close>)
      apply (simp_all add: bit_word_rotr_iff bit_of_bl_iff rotater_rev length_to_bl_eq nth_rotate rev_to_bl_eq ac_simps)
     done
   done
 
 lemma word_rotl_eq:
   \<open>word_rotl n w = of_bl (rotate n (to_bl w))\<close>
 proof -
   have \<open>rotate n (to_bl w) = rev (rotater n (rev (to_bl w)))\<close>
     by (simp add: rotater_rev')
   then show ?thesis
     apply (simp add: word_rotl_eq_word_rotr bit_of_bl_iff length_to_bl_eq rev_to_bl_eq)
     apply (rule bit_word_eqI)
     subgoal for n
       apply (cases \<open>n < LENGTH('a)\<close>)
        apply (simp_all add: bit_word_rotr_iff bit_of_bl_iff nth_rotater)
       done
     done
 qed
 
 lemma to_bl_def': "(to_bl :: 'a::len word \<Rightarrow> bool list) = bin_to_bl (LENGTH('a)) \<circ> uint"
   by transfer (simp add: fun_eq_iff)
 
 \<comment> \<open>type definitions theorem for in terms of equivalent bool list\<close>
 lemma td_bl:
   "type_definition
     (to_bl :: 'a::len word \<Rightarrow> bool list)
     of_bl
     {bl. length bl = LENGTH('a)}"
   apply (standard; transfer)
   apply (auto dest: sym)
   done
 
 interpretation word_bl:
   type_definition
     "to_bl :: 'a::len word \<Rightarrow> bool list"
     of_bl
     "{bl. length bl = LENGTH('a::len)}"
   by (fact td_bl)
 
 lemmas word_bl_Rep' = word_bl.Rep [unfolded mem_Collect_eq, iff]
 
 lemma word_size_bl: "size w = size (to_bl w)"
   by (auto simp: word_size)
 
 lemma to_bl_use_of_bl: "to_bl w = bl \<longleftrightarrow> w = of_bl bl \<and> length bl = length (to_bl w)"
   by (fastforce elim!: word_bl.Abs_inverse [unfolded mem_Collect_eq])
 
 lemma length_bl_gt_0 [iff]: "0 < length (to_bl x)"
   for x :: "'a::len word"
   unfolding word_bl_Rep' by (rule len_gt_0)
 
 lemma bl_not_Nil [iff]: "to_bl x \<noteq> []"
   for x :: "'a::len word"
   by (fact length_bl_gt_0 [unfolded length_greater_0_conv])
 
 lemma length_bl_neq_0 [iff]: "length (to_bl x) \<noteq> 0"
   for x :: "'a::len word"
   by (fact length_bl_gt_0 [THEN gr_implies_not0])
 
 lemma hd_bl_sign_sint: "hd (to_bl w) = (bin_sign (sint w) = -1)"
   apply transfer
   apply (auto simp add: bin_sign_def)
   using bin_sign_lem bl_sbin_sign apply fastforce
   using bin_sign_lem bl_sbin_sign apply force
   done
 
 lemma of_bl_drop':
   "lend = length bl - LENGTH('a::len) \<Longrightarrow>
     of_bl (drop lend bl) = (of_bl bl :: 'a word)"
   by transfer (simp flip: trunc_bl2bin)
 
 lemma test_bit_of_bl:
   "bit (of_bl bl::'a::len word) n = (rev bl ! n \<and> n < LENGTH('a) \<and> n < length bl)"
   by transfer (simp add: bin_nth_of_bl ac_simps)
 
 lemma no_of_bl: "(numeral bin ::'a::len word) = of_bl (bin_to_bl (LENGTH('a)) (numeral bin))"
   by transfer simp
 
 lemma uint_bl: "to_bl w = bin_to_bl (size w) (uint w)"
   by transfer simp
 
 lemma to_bl_bin: "bl_to_bin (to_bl w) = uint w"
   by (simp add: uint_bl word_size)
 
 lemma to_bl_of_bin: "to_bl (word_of_int bin::'a::len word) = bin_to_bl (LENGTH('a)) bin"
   by (auto simp: uint_bl word_ubin.eq_norm word_size)
 
 lemma to_bl_numeral [simp]:
   "to_bl (numeral bin::'a::len word) =
     bin_to_bl (LENGTH('a)) (numeral bin)"
   unfolding word_numeral_alt by (rule to_bl_of_bin)
 
 lemma to_bl_neg_numeral [simp]:
   "to_bl (- numeral bin::'a::len word) =
     bin_to_bl (LENGTH('a)) (- numeral bin)"
   unfolding word_neg_numeral_alt by (rule to_bl_of_bin)
 
 lemma to_bl_to_bin [simp] : "bl_to_bin (to_bl w) = uint w"
   by (simp add: uint_bl word_size)
 
 lemma uint_bl_bin: "bl_to_bin (bin_to_bl (LENGTH('a)) (uint x)) = uint x"
   for x :: "'a::len word"
   by (rule trans [OF bin_bl_bin word_ubin.norm_Rep])
 
 lemma ucast_bl: "ucast w = of_bl (to_bl w)"
   by transfer simp
 
 lemma ucast_down_bl:
   \<open>(ucast :: 'a::len word \<Rightarrow> 'b::len word) (of_bl bl) = of_bl bl\<close>
     if \<open>is_down (ucast :: 'a::len word \<Rightarrow> 'b::len word)\<close>
   using that by transfer simp
 
 lemma of_bl_append_same: "of_bl (X @ to_bl w) = w"
   by transfer (simp add: bl_to_bin_app_cat)
 
 lemma ucast_of_bl_up:
   \<open>ucast (of_bl bl :: 'a::len word) = of_bl bl\<close>
   if \<open>size bl \<le> size (of_bl bl :: 'a::len word)\<close>
   using that
   apply transfer
   apply (rule bit_eqI)
   apply (auto simp add: bit_take_bit_iff)
   apply (subst (asm) trunc_bl2bin_len [symmetric])
   apply (auto simp only: bit_take_bit_iff)
   done
 
 lemma word_rev_tf:
   "to_bl (of_bl bl::'a::len word) =
     rev (takefill False (LENGTH('a)) (rev bl))"
   by transfer (simp add: bl_bin_bl_rtf)
 
 lemma word_rep_drop:
   "to_bl (of_bl bl::'a::len word) =
     replicate (LENGTH('a) - length bl) False @
     drop (length bl - LENGTH('a)) bl"
   by (simp add: word_rev_tf takefill_alt rev_take)
 
 lemma to_bl_ucast:
   "to_bl (ucast (w::'b::len word) ::'a::len word) =
     replicate (LENGTH('a) - LENGTH('b)) False @
     drop (LENGTH('b) - LENGTH('a)) (to_bl w)"
   apply (unfold ucast_bl)
   apply (rule trans)
    apply (rule word_rep_drop)
   apply simp
   done
 
 lemma ucast_up_app:
   \<open>to_bl (ucast w :: 'b::len word) = replicate n False @ (to_bl w)\<close>
     if \<open>source_size (ucast :: 'a word \<Rightarrow> 'b word) + n = target_size (ucast :: 'a word \<Rightarrow> 'b word)\<close>
     for w :: \<open>'a::len word\<close>
   using that
   by (auto simp add : source_size target_size to_bl_ucast)
 
 lemma ucast_down_drop [OF refl]:
   "uc = ucast \<Longrightarrow> source_size uc = target_size uc + n \<Longrightarrow>
     to_bl (uc w) = drop n (to_bl w)"
   by (auto simp add : source_size target_size to_bl_ucast)
 
 lemma scast_down_drop [OF refl]:
   "sc = scast \<Longrightarrow> source_size sc = target_size sc + n \<Longrightarrow>
     to_bl (sc w) = drop n (to_bl w)"
   apply (subgoal_tac "sc = ucast")
    apply safe
    apply simp
    apply (erule ucast_down_drop)
   apply (rule down_cast_same [symmetric])
   apply (simp add : source_size target_size is_down)
   done
 
 lemma word_0_bl [simp]: "of_bl [] = 0"
   by transfer simp
 
 lemma word_1_bl: "of_bl [True] = 1"
   by transfer (simp add: bl_to_bin_def)
 
 lemma of_bl_0 [simp]: "of_bl (replicate n False) = 0"
   by transfer (simp add: bl_to_bin_rep_False)
 
 lemma to_bl_0 [simp]: "to_bl (0::'a::len word) = replicate (LENGTH('a)) False"
   by (simp add: uint_bl word_size bin_to_bl_zero)
 
 \<comment> \<open>links with \<open>rbl\<close> operations\<close>
 lemma word_succ_rbl: "to_bl w = bl \<Longrightarrow> to_bl (word_succ w) = rev (rbl_succ (rev bl))"
   by transfer (simp add: rbl_succ)
 
 lemma word_pred_rbl: "to_bl w = bl \<Longrightarrow> to_bl (word_pred w) = rev (rbl_pred (rev bl))"
   by transfer (simp add: rbl_pred)
 
 lemma word_add_rbl:
   "to_bl v = vbl \<Longrightarrow> to_bl w = wbl \<Longrightarrow>
     to_bl (v + w) = rev (rbl_add (rev vbl) (rev wbl))"
   apply transfer
   apply (drule sym)
   apply (drule sym)
   apply (simp add: rbl_add)
   done
 
 lemma word_mult_rbl:
   "to_bl v = vbl \<Longrightarrow> to_bl w = wbl \<Longrightarrow>
     to_bl (v * w) = rev (rbl_mult (rev vbl) (rev wbl))"
   apply transfer
   apply (drule sym)
   apply (drule sym)
   apply (simp add: rbl_mult)
   done
 
 lemma rtb_rbl_ariths:
   "rev (to_bl w) = ys \<Longrightarrow> rev (to_bl (word_succ w)) = rbl_succ ys"
   "rev (to_bl w) = ys \<Longrightarrow> rev (to_bl (word_pred w)) = rbl_pred ys"
   "rev (to_bl v) = ys \<Longrightarrow> rev (to_bl w) = xs \<Longrightarrow> rev (to_bl (v * w)) = rbl_mult ys xs"
   "rev (to_bl v) = ys \<Longrightarrow> rev (to_bl w) = xs \<Longrightarrow> rev (to_bl (v + w)) = rbl_add ys xs"
   by (auto simp: rev_swap [symmetric] word_succ_rbl word_pred_rbl word_mult_rbl word_add_rbl)
 
 lemma of_bl_length_less:
   \<open>(of_bl x :: 'a::len word) < 2 ^ k\<close>
     if \<open>length x = k\<close> \<open>k < LENGTH('a)\<close>
 proof -
   from that have \<open>length x < LENGTH('a)\<close>
     by simp
   then have \<open>(of_bl x :: 'a::len word) < 2 ^ length x\<close>
     apply (simp add: of_bl_eq)
     apply transfer
     apply (simp add: take_bit_horner_sum_bit_eq)
     apply (subst length_rev [symmetric])
     apply (simp only: horner_sum_of_bool_2_less)
     done
   with that show ?thesis
     by simp
 qed
 
 lemma word_eq_rbl_eq: "x = y \<longleftrightarrow> rev (to_bl x) = rev (to_bl y)"
   by simp
 
 lemma bl_word_not: "to_bl (NOT w) = map Not (to_bl w)"
   by transfer (simp add: bl_not_bin)
 
 lemma bl_word_xor: "to_bl (v XOR w) = map2 (\<noteq>) (to_bl v) (to_bl w)"
   by transfer (simp flip: bl_xor_bin)
 
 lemma bl_word_or: "to_bl (v OR w) = map2 (\<or>) (to_bl v) (to_bl w)"
   by transfer (simp flip: bl_or_bin)
 
 lemma bl_word_and: "to_bl (v AND w) = map2 (\<and>) (to_bl v) (to_bl w)"
   by transfer (simp flip: bl_and_bin)
 
 lemma bin_nth_uint': "bit (uint w) n \<longleftrightarrow> rev (bin_to_bl (size w) (uint w)) ! n \<and> n < size w"
   apply (unfold word_size)
   apply (safe elim!: bin_nth_uint_imp)
    apply (frule bin_nth_uint_imp)
    apply (fast dest!: bin_nth_bl)+
   done
 
 lemmas bin_nth_uint = bin_nth_uint' [unfolded word_size]
 
 lemma test_bit_bl: "bit w n \<longleftrightarrow> rev (to_bl w) ! n \<and> n < size w"
   by transfer (auto simp add: bin_nth_bl)
 
 lemma to_bl_nth: "n < size w \<Longrightarrow> to_bl w ! n = bit w (size w - Suc n)"
   by (simp add: word_size rev_nth test_bit_bl)
 
 lemma map_bit_interval_eq:
   \<open>map (bit w) [0..<n] = takefill False n (rev (to_bl w))\<close> for w :: \<open>'a::len word\<close>
 proof (rule nth_equalityI)
   show \<open>length (map (bit w) [0..<n]) =
     length (takefill False n (rev (to_bl w)))\<close>
     by simp
   fix m
   assume \<open>m < length (map (bit w) [0..<n])\<close>
   then have \<open>m < n\<close>
     by simp
   then have \<open>bit w m \<longleftrightarrow> takefill False n (rev (to_bl w)) ! m\<close>
     by (auto simp add: nth_takefill not_less rev_nth to_bl_nth word_size dest: bit_imp_le_length)
   with \<open>m < n \<close>show \<open>map (bit w) [0..<n] ! m \<longleftrightarrow> takefill False n (rev (to_bl w)) ! m\<close>
     by simp
 qed
 
 lemma to_bl_unfold:
   \<open>to_bl w = rev (map (bit w) [0..<LENGTH('a)])\<close> for w :: \<open>'a::len word\<close>
   by (simp add: map_bit_interval_eq takefill_bintrunc to_bl_def flip: bin_to_bl_def)
 
 lemma nth_rev_to_bl:
   \<open>rev (to_bl w) ! n \<longleftrightarrow> bit w n\<close>
   if \<open>n < LENGTH('a)\<close> for w :: \<open>'a::len word\<close>
   using that by (simp add: to_bl_unfold)
 
 lemma nth_to_bl:
   \<open>to_bl w ! n \<longleftrightarrow> bit w (LENGTH('a) - Suc n)\<close>
   if \<open>n < LENGTH('a)\<close> for w :: \<open>'a::len word\<close>
   using that by (simp add: to_bl_unfold rev_nth)
 
 lemma of_bl_rep_False: "of_bl (replicate n False @ bs) = of_bl bs"
   by (auto simp: of_bl_def bl_to_bin_rep_F)
 
 lemma [code abstract]:
   \<open>Word.the_int (of_bl bs :: 'a word) = horner_sum of_bool 2 (take LENGTH('a::len) (rev bs))\<close>
   apply (simp add: of_bl_eq flip: take_bit_horner_sum_bit_eq)
   apply transfer
   apply simp
   done
 
 lemma [code]:
   \<open>to_bl w = map (bit w) (rev [0..<LENGTH('a::len)])\<close>
   for w :: \<open>'a::len word\<close>
   by (fact to_bl_eq_rev)
 
 lemma word_reverse_eq_of_bl_rev_to_bl:
   \<open>word_reverse w = of_bl (rev (to_bl w))\<close>
   by (rule bit_word_eqI)
     (auto simp add: bit_word_reverse_iff bit_of_bl_iff nth_to_bl)
 
 lemmas word_reverse_no_def [simp] =
   word_reverse_eq_of_bl_rev_to_bl [of "numeral w"] for w
 
 lemma to_bl_word_rev: "to_bl (word_reverse w) = rev (to_bl w)"
   by (rule nth_equalityI) (simp_all add: nth_rev_to_bl word_reverse_def word_rep_drop flip: of_bl_eq)
 
 lemma to_bl_n1 [simp]: "to_bl (-1::'a::len word) = replicate (LENGTH('a)) True"
   apply (rule word_bl.Abs_inverse')
    apply simp
   apply (rule word_eqI)
   apply (clarsimp simp add: word_size)
   apply (auto simp add: word_bl.Abs_inverse test_bit_bl word_size)
   done
 
 lemma rbl_word_or: "rev (to_bl (x OR y)) = map2 (\<or>) (rev (to_bl x)) (rev (to_bl y))"
   by (simp add: zip_rev bl_word_or rev_map)
 
 lemma rbl_word_and: "rev (to_bl (x AND y)) = map2 (\<and>) (rev (to_bl x)) (rev (to_bl y))"
   by (simp add: zip_rev bl_word_and rev_map)
 
 lemma rbl_word_xor: "rev (to_bl (x XOR y)) = map2 (\<noteq>) (rev (to_bl x)) (rev (to_bl y))"
   by (simp add: zip_rev bl_word_xor rev_map)
 
 lemma rbl_word_not: "rev (to_bl (NOT x)) = map Not (rev (to_bl x))"
   by (simp add: bl_word_not rev_map)
 
 lemma bshiftr1_numeral [simp]:
   \<open>bshiftr1 b (numeral w :: 'a word) = of_bl (b # butlast (bin_to_bl LENGTH('a::len) (numeral w)))\<close>
   by (rule bit_word_eqI) (auto simp add: bit_simps rev_nth nth_append nth_butlast nth_bin_to_bl simp flip: bit_Suc)
 
 lemma bshiftr1_bl: "to_bl (bshiftr1 b w) = b # butlast (to_bl w)"
   unfolding bshiftr1_eq by (rule word_bl.Abs_inverse) simp
 
 lemma shiftl1_of_bl: "shiftl1 (of_bl bl) = of_bl (bl @ [False])"
   by transfer (simp add: bl_to_bin_append)
 
 lemma shiftl1_bl: "shiftl1 w = of_bl (to_bl w @ [False])"
   for w :: "'a::len word"
 proof -
   have "shiftl1 w = shiftl1 (of_bl (to_bl w))"
     by simp
   also have "\<dots> = of_bl (to_bl w @ [False])"
     by (rule shiftl1_of_bl)
   finally show ?thesis .
 qed
 
 lemma bl_shiftl1: "to_bl (shiftl1 w) = tl (to_bl w) @ [False]"
   for w :: "'a::len word"
   by (simp add: shiftl1_bl word_rep_drop drop_Suc drop_Cons') (fast intro!: Suc_leI)
 
 \<comment> \<open>Generalized version of \<open>bl_shiftl1\<close>. Maybe this one should replace it?\<close>
 lemma bl_shiftl1': "to_bl (shiftl1 w) = tl (to_bl w @ [False])"
   by (simp add: shiftl1_bl word_rep_drop drop_Suc del: drop_append)
 
 lemma shiftr1_bl:
   \<open>shiftr1 w = of_bl (butlast (to_bl w))\<close>
 proof (rule bit_word_eqI)
   fix n
   assume \<open>n < LENGTH('a)\<close>
   show \<open>bit (shiftr1 w) n \<longleftrightarrow> bit (of_bl (butlast (to_bl w)) :: 'a word) n\<close>
   proof (cases \<open>n = LENGTH('a) - 1\<close>)
     case True
     then show ?thesis
       by (simp add: bit_shiftr1_iff bit_of_bl_iff)
   next
     case False
     with \<open>n < LENGTH('a)\<close>
     have \<open>n < LENGTH('a) - 1\<close>
       by simp
     with \<open>n < LENGTH('a)\<close> show ?thesis
       by (simp add: bit_shiftr1_iff bit_of_bl_iff rev_nth nth_butlast
         word_size to_bl_nth)
   qed
 qed
 
 lemma bl_shiftr1: "to_bl (shiftr1 w) = False # butlast (to_bl w)"
   for w :: "'a::len word"
   by (simp add: shiftr1_bl word_rep_drop len_gt_0 [THEN Suc_leI])
 
 \<comment> \<open>Generalized version of \<open>bl_shiftr1\<close>. Maybe this one should replace it?\<close>
 lemma bl_shiftr1': "to_bl (shiftr1 w) = butlast (False # to_bl w)"
   apply (rule word_bl.Abs_inverse')
    apply (simp del: butlast.simps)
   apply (simp add: shiftr1_bl of_bl_def)
   done
 
 lemma bl_sshiftr1: "to_bl (sshiftr1 w) = hd (to_bl w) # butlast (to_bl w)"
   for w :: "'a::len word"
 proof (rule nth_equalityI)
   fix n
   assume \<open>n < length (to_bl (sshiftr1 w))\<close>
   then have \<open>n < LENGTH('a)\<close>
     by simp
   then show \<open>to_bl (sshiftr1 w) ! n \<longleftrightarrow> (hd (to_bl w) # butlast (to_bl w)) ! n\<close>
     apply (cases n)
      apply (simp_all add: to_bl_nth word_size hd_conv_nth bit_sshiftr1_iff nth_butlast Suc_diff_Suc nth_to_bl)
     done
 qed simp
 
-lemma drop_shiftr: "drop n (to_bl (w >> n)) = take (size w - n) (to_bl w)"
+lemma drop_shiftr: "drop n (to_bl (drop_bit n w)) = take (size w - n) (to_bl w)"
   for w :: "'a::len word"
-  apply (unfold shiftr_def)
-  apply (induct n)
-   prefer 2
-   apply (simp add: drop_Suc bl_shiftr1 butlast_drop [symmetric])
-   apply (rule butlast_take [THEN trans])
-    apply (auto simp: word_size)
+  apply (rule nth_equalityI)
+   apply (simp_all add: word_size to_bl_nth bit_simps)
   done
 
-lemma drop_sshiftr: "drop n (to_bl (w >>> n)) = take (size w - n) (to_bl w)"
+lemma drop_sshiftr: "drop n (to_bl (signed_drop_bit n w)) = take (size w - n) (to_bl w)"
   for w :: "'a::len word"
-   apply (simp_all add: word_size sshiftr_eq)
+   apply (simp_all add: word_size)
   apply (rule nth_equalityI)
    apply (simp_all add: word_size nth_to_bl bit_signed_drop_bit_iff)
   done
 
-lemma take_shiftr: "n \<le> size w \<Longrightarrow> take n (to_bl (w >> n)) = replicate n False"
-  apply (unfold shiftr_def)
-  apply (induct n)
-   prefer 2
-   apply (simp add: bl_shiftr1' length_0_conv [symmetric] word_size)
-   apply (rule take_butlast [THEN trans])
-    apply (auto simp: word_size)
-  done
+lemma take_shiftr: "n \<le> size w \<Longrightarrow> take n (to_bl (drop_bit n w)) = replicate n False"
+  apply (rule nth_equalityI)
+   apply (simp_all add: word_size to_bl_nth bit_simps)
+  using bit_imp_le_length by fastforce
 
 lemma take_sshiftr':
-  "n \<le> size w \<Longrightarrow> hd (to_bl (w >>> n)) = hd (to_bl w) \<and>
-    take n (to_bl (w >>> n)) = replicate n (hd (to_bl w))"
+  "n \<le> size w \<Longrightarrow> hd (to_bl (signed_drop_bit n w)) = hd (to_bl w) \<and>
+    take n (to_bl (signed_drop_bit n w)) = replicate n (hd (to_bl w))"
   for w :: "'a::len word"
-  apply (auto simp add: sshiftr_eq hd_bl_sign_sint bin_sign_def not_le word_size sint_signed_drop_bit_eq)
+  apply (auto simp add: hd_bl_sign_sint bin_sign_def not_le word_size sint_signed_drop_bit_eq)
   apply (rule nth_equalityI)
     apply (auto simp add: nth_to_bl bit_signed_drop_bit_iff bit_last_iff)
   apply (rule nth_equalityI)
    apply (auto simp add: nth_to_bl bit_signed_drop_bit_iff bit_last_iff)
   done
 
 lemmas hd_sshiftr = take_sshiftr' [THEN conjunct1]
 lemmas take_sshiftr = take_sshiftr' [THEN conjunct2]
 
 lemma atd_lem: "take n xs = t \<Longrightarrow> drop n xs = d \<Longrightarrow> xs = t @ d"
   by (auto intro: append_take_drop_id [symmetric])
 
 lemmas bl_shiftr = atd_lem [OF take_shiftr drop_shiftr]
 lemmas bl_sshiftr = atd_lem [OF take_sshiftr drop_sshiftr]
 
-lemma shiftl_of_bl: "of_bl bl << n = of_bl (bl @ replicate n False)"
-  by (induct n) (auto simp: shiftl_def shiftl1_of_bl replicate_app_Cons_same)
+lemma shiftl_of_bl: "push_bit n (of_bl bl) = of_bl (bl @ replicate n False)"
+  apply (rule bit_word_eqI)
+  apply (auto simp add: bit_simps nth_append)
+  done
 
-lemma shiftl_bl: "w << n = of_bl (to_bl w @ replicate n False)"
+lemma shiftl_bl: "push_bit n w = of_bl (to_bl w @ replicate n False)"
   for w :: "'a::len word"
 proof -
-  have "w << n = of_bl (to_bl w) << n"
+  have "push_bit n w = push_bit n (of_bl (to_bl w))"
     by simp
   also have "\<dots> = of_bl (to_bl w @ replicate n False)"
     by (rule shiftl_of_bl)
   finally show ?thesis .
 qed
 
-lemma bl_shiftl: "to_bl (w << n) = drop n (to_bl w) @ replicate (min (size w) n) False"
+lemma bl_shiftl: "to_bl (push_bit n w) = drop n (to_bl w) @ replicate (min (size w) n) False"
   by (simp add: shiftl_bl word_rep_drop word_size)
 
 lemma shiftr1_bl_of:
   "length bl \<le> LENGTH('a) \<Longrightarrow>
     shiftr1 (of_bl bl::'a::len word) = of_bl (butlast bl)"
   apply (cases bl rule: rev_cases)
   apply simp_all
   apply (rule bit_word_eqI)
   apply (auto simp add: bit_simps simp flip: bit_Suc)
   done
 
 lemma shiftr_bl_of:
   "length bl \<le> LENGTH('a) \<Longrightarrow>
-    (of_bl bl::'a::len word) >> n = of_bl (take (length bl - n) bl)"
+    drop_bit n (of_bl bl::'a::len word) = of_bl (take (length bl - n) bl)"
   by (rule bit_word_eqI) (auto simp add: bit_simps rev_nth)
 
-lemma shiftr_bl: "x >> n \<equiv> of_bl (take (LENGTH('a) - n) (to_bl x))"
+lemma shiftr_bl: "drop_bit n x \<equiv> of_bl (take (LENGTH('a) - n) (to_bl x))"
   for x :: "'a::len word"
   using shiftr_bl_of [where 'a='a, of "to_bl x"] by simp
 
 lemma aligned_bl_add_size [OF refl]:
   "size x - n = m \<Longrightarrow> n \<le> size x \<Longrightarrow> drop m (to_bl x) = replicate n False \<Longrightarrow>
     take m (to_bl y) = replicate m False \<Longrightarrow>
     to_bl (x + y) = take m (to_bl x) @ drop m (to_bl y)" for x :: \<open>'a::len word\<close>
   apply (subgoal_tac "x AND y = 0")
    prefer 2
    apply (rule word_bl.Rep_eqD)
    apply (simp add: bl_word_and)
    apply (rule align_lem_and [THEN trans])
        apply (simp_all add: word_size)[5]
    apply simp
   apply (subst word_plus_and_or [symmetric])
   apply (simp add : bl_word_or)
   apply (rule align_lem_or)
      apply (simp_all add: word_size)
   done
 
 lemma mask_bl: "mask n = of_bl (replicate n True)"
   by (auto simp add: bit_simps intro!: word_eqI)
 
 lemma bl_and_mask':
   "to_bl (w AND mask n :: 'a::len word) =
     replicate (LENGTH('a) - n) False @
     drop (LENGTH('a) - n) (to_bl w)"
   apply (rule nth_equalityI)
    apply simp
   apply (clarsimp simp add: to_bl_nth word_size bit_simps)
   apply (auto simp add: word_size test_bit_bl nth_append rev_nth)
   done
 
 lemma slice1_eq_of_bl:
   \<open>(slice1 n w :: 'b::len word) = of_bl (takefill False n (to_bl w))\<close>
   for w :: \<open>'a::len word\<close>
 proof (rule bit_word_eqI)
   fix m
   assume \<open>m < LENGTH('b)\<close>
   show \<open>bit (slice1 n w :: 'b::len word) m \<longleftrightarrow> bit (of_bl (takefill False n (to_bl w)) :: 'b word) m\<close>
     by (cases \<open>m \<ge> n\<close>; cases \<open>LENGTH('a) \<ge> n\<close>)
       (auto simp add: bit_slice1_iff bit_of_bl_iff not_less rev_nth not_le nth_takefill nth_to_bl algebra_simps)
 qed
 
 lemma slice1_no_bin [simp]:
   "slice1 n (numeral w :: 'b word) = of_bl (takefill False n (bin_to_bl (LENGTH('b::len)) (numeral w)))"
   by (simp add: slice1_eq_of_bl) (* TODO: neg_numeral *)
 
 lemma slice_no_bin [simp]:
   "slice n (numeral w :: 'b word) = of_bl (takefill False (LENGTH('b::len) - n)
     (bin_to_bl (LENGTH('b::len)) (numeral w)))"
   by (simp add: slice_def) (* TODO: neg_numeral *)
 
 lemma slice_take': "slice n w = of_bl (take (size w - n) (to_bl w))"
   by (simp add: slice_def word_size slice1_eq_of_bl takefill_alt)
 
 lemmas slice_take = slice_take' [unfolded word_size]
 
 \<comment> \<open>shiftr to a word of the same size is just slice,
     slice is just shiftr then ucast\<close>
 lemmas shiftr_slice = trans [OF shiftr_bl [THEN meta_eq_to_obj_eq] slice_take [symmetric]]
 
 lemma slice1_down_alt':
   "sl = slice1 n w \<Longrightarrow> fs = size sl \<Longrightarrow> fs + k = n \<Longrightarrow>
     to_bl sl = takefill False fs (drop k (to_bl w))"
   apply (simp add: slice1_eq_of_bl)
   apply transfer
   apply (simp add: bl_bin_bl_rep_drop)
   using drop_takefill
   apply force
   done
 
 lemma slice1_up_alt':
   "sl = slice1 n w \<Longrightarrow> fs = size sl \<Longrightarrow> fs = n + k \<Longrightarrow>
     to_bl sl = takefill False fs (replicate k False @ (to_bl w))"
   apply (simp add: slice1_eq_of_bl)
   apply transfer
   apply (simp add: bl_bin_bl_rep_drop flip: takefill_append)
   apply (metis diff_add_inverse)
   done
 
 lemmas sd1 = slice1_down_alt' [OF refl refl, unfolded word_size]
 lemmas su1 = slice1_up_alt' [OF refl refl, unfolded word_size]
 lemmas slice1_down_alt = le_add_diff_inverse [THEN sd1]
 lemmas slice1_up_alts =
   le_add_diff_inverse [symmetric, THEN su1]
   le_add_diff_inverse2 [symmetric, THEN su1]
 
 lemma slice1_tf_tf':
   "to_bl (slice1 n w :: 'a::len word) =
     rev (takefill False (LENGTH('a)) (rev (takefill False n (to_bl w))))"
   unfolding slice1_eq_of_bl by (rule word_rev_tf)
 
 lemmas slice1_tf_tf = slice1_tf_tf' [THEN word_bl.Rep_inverse', symmetric]
 
 lemma revcast_eq_of_bl:
   \<open>(revcast w :: 'b::len word) = of_bl (takefill False (LENGTH('b)) (to_bl w))\<close>
   for w :: \<open>'a::len word\<close>
   by (simp add: revcast_def slice1_eq_of_bl)
 
 lemmas revcast_no_def [simp] = revcast_eq_of_bl [where w="numeral w", unfolded word_size] for w
 
 lemma to_bl_revcast:
   "to_bl (revcast w :: 'a::len word) = takefill False (LENGTH('a)) (to_bl w)"
   apply (rule nth_equalityI)
   apply simp
   apply (cases \<open>LENGTH('a) \<le> LENGTH('b)\<close>)
    apply (auto simp add: nth_to_bl nth_takefill bit_revcast_iff)
   done
 
 lemma word_cat_bl: "word_cat a b = of_bl (to_bl a @ to_bl b)"
   apply (rule bit_word_eqI)
   apply (simp add: bit_word_cat_iff bit_of_bl_iff nth_append not_less nth_rev_to_bl)
   apply (meson bit_word.rep_eq less_diff_conv2 nth_rev_to_bl)
   done
 
 lemma of_bl_append:
   "(of_bl (xs @ ys) :: 'a::len word) = of_bl xs * 2^(length ys) + of_bl ys"
   apply transfer
   apply (simp add: bl_to_bin_app_cat bin_cat_num)
   done
 
 lemma of_bl_False [simp]: "of_bl (False#xs) = of_bl xs"
   by (rule word_eqI) (auto simp: test_bit_of_bl nth_append)
 
 lemma of_bl_True [simp]: "(of_bl (True # xs) :: 'a::len word) = 2^length xs + of_bl xs"
   by (subst of_bl_append [where xs="[True]", simplified]) (simp add: word_1_bl)
 
 lemma of_bl_Cons: "of_bl (x#xs) = of_bool x * 2^length xs + of_bl xs"
   by (cases x) simp_all
 
 lemma word_split_bl':
   "std = size c - size b \<Longrightarrow> (word_split c = (a, b)) \<Longrightarrow>
     (a = of_bl (take std (to_bl c)) \<and> b = of_bl (drop std (to_bl c)))"
   apply (simp add: word_split_def)
   apply transfer
   apply (cases \<open>LENGTH('b) \<le> LENGTH('a)\<close>)
    apply (auto simp add: drop_bit_take_bit drop_bin2bl bin_to_bl_drop_bit [symmetric, of \<open>LENGTH('a)\<close> \<open>LENGTH('a) - LENGTH('b)\<close> \<open>LENGTH('b)\<close>] min_absorb2)
   done
 
 lemma word_split_bl: "std = size c - size b \<Longrightarrow>
     (a = of_bl (take std (to_bl c)) \<and> b = of_bl (drop std (to_bl c))) \<longleftrightarrow>
     word_split c = (a, b)"
   apply (rule iffI)
    defer
    apply (erule (1) word_split_bl')
   apply (case_tac "word_split c")
   apply (auto simp add: word_size)
   apply (frule word_split_bl' [rotated])
    apply (auto simp add: word_size)
   done
 
 lemma word_split_bl_eq:
   "(word_split c :: ('c::len word \<times> 'd::len word)) =
     (of_bl (take (LENGTH('a::len) - LENGTH('d::len)) (to_bl c)),
      of_bl (drop (LENGTH('a) - LENGTH('d)) (to_bl c)))"
   for c :: "'a::len word"
   apply (rule word_split_bl [THEN iffD1])
    apply (unfold word_size)
    apply (rule refl conjI)+
   done
 
 lemma word_rcat_bl:
   \<open>word_rcat wl = of_bl (concat (map to_bl wl))\<close>
 proof -
   define ws where \<open>ws = rev wl\<close>
   moreover have \<open>word_rcat (rev ws) = of_bl (concat (map to_bl (rev ws)))\<close>
     apply (simp add: word_rcat_def of_bl_eq rev_concat rev_map comp_def rev_to_bl_eq flip: horner_sum_of_bool_2_concat)
     apply transfer
     apply simp
     done
   ultimately show ?thesis
     by simp
 qed
 
 lemma size_rcat_lem': "size (concat (map to_bl wl)) = length wl * size (hd wl)"
   by (induct wl) (auto simp: word_size)
 
 lemmas size_rcat_lem = size_rcat_lem' [unfolded word_size]
 
 lemma nth_rcat_lem:
   "n < length (wl::'a word list) * LENGTH('a::len) \<Longrightarrow>
     rev (concat (map to_bl wl)) ! n =
     rev (to_bl (rev wl ! (n div LENGTH('a)))) ! (n mod LENGTH('a))"
   apply (induct wl)
    apply clarsimp
   apply (clarsimp simp add : nth_append size_rcat_lem)
   apply (simp flip: mult_Suc minus_div_mult_eq_mod add: less_Suc_eq_le not_less)
   apply (metis (no_types, lifting) diff_is_0_eq div_le_mono len_not_eq_0 less_Suc_eq less_mult_imp_div_less nonzero_mult_div_cancel_right not_le nth_Cons_0)
   done
 
 lemma foldl_eq_foldr: "foldl (+) x xs = foldr (+) (x # xs) 0"
   for x :: "'a::comm_monoid_add"
   by (induct xs arbitrary: x) (auto simp: add.assoc)
 
 lemmas word_cat_bl_no_bin [simp] =
   word_cat_bl [where a="numeral a" and b="numeral b", unfolded to_bl_numeral]
   for a b (* FIXME: negative numerals, 0 and 1 *)
 
 lemmas word_split_bl_no_bin [simp] =
   word_split_bl_eq [where c="numeral c", unfolded to_bl_numeral] for c
 
 lemmas word_rot_defs = word_roti_eq_word_rotr_word_rotl word_rotr_eq word_rotl_eq
 
 lemma to_bl_rotl: "to_bl (word_rotl n w) = rotate n (to_bl w)"
   by (simp add: word_rotl_eq to_bl_use_of_bl)
 
 lemmas blrs0 = rotate_eqs [THEN to_bl_rotl [THEN trans]]
 
 lemmas word_rotl_eqs =
   blrs0 [simplified word_bl_Rep' word_bl.Rep_inject to_bl_rotl [symmetric]]
 
 lemma to_bl_rotr: "to_bl (word_rotr n w) = rotater n (to_bl w)"
   by (simp add: word_rotr_eq to_bl_use_of_bl)
 
 lemmas brrs0 = rotater_eqs [THEN to_bl_rotr [THEN trans]]
 
 lemmas word_rotr_eqs =
   brrs0 [simplified word_bl_Rep' word_bl.Rep_inject to_bl_rotr [symmetric]]
 
 declare word_rotr_eqs (1) [simp]
 declare word_rotl_eqs (1) [simp]
 
 lemmas abl_cong = arg_cong [where f = "of_bl"]
 
 locale word_rotate
 begin
 
 lemmas word_rot_defs' = to_bl_rotl to_bl_rotr
 
 lemmas blwl_syms [symmetric] = bl_word_not bl_word_and bl_word_or bl_word_xor
 
 lemmas lbl_lbl = trans [OF word_bl_Rep' word_bl_Rep' [symmetric]]
 
 lemmas ths_map2 [OF lbl_lbl] = rotate_map2 rotater_map2
 
 lemmas ths_map [where xs = "to_bl v"] = rotate_map rotater_map for v
 
 lemmas th1s [simplified word_rot_defs' [symmetric]] = ths_map2 ths_map
 
 end
 
 lemmas bl_word_rotl_dt = trans [OF to_bl_rotl rotate_drop_take,
   simplified word_bl_Rep']
 
 lemmas bl_word_rotr_dt = trans [OF to_bl_rotr rotater_drop_take,
   simplified word_bl_Rep']
 
 lemma bl_word_roti_dt':
   "n = nat ((- i) mod int (size (w :: 'a::len word))) \<Longrightarrow>
     to_bl (word_roti i w) = drop n (to_bl w) @ take n (to_bl w)"
   apply (unfold word_roti_eq_word_rotr_word_rotl)
   apply (simp add: bl_word_rotl_dt bl_word_rotr_dt word_size)
   apply safe
    apply (simp add: zmod_zminus1_eq_if)
    apply safe
     apply (simp add: nat_mult_distrib)
    apply (simp add: nat_diff_distrib [OF pos_mod_sign pos_mod_conj
                                       [THEN conjunct2, THEN order_less_imp_le]]
                     nat_mod_distrib)
   apply (simp add: nat_mod_distrib)
   done
 
 lemmas bl_word_roti_dt = bl_word_roti_dt' [unfolded word_size]
 
 lemmas word_rotl_dt = bl_word_rotl_dt [THEN word_bl.Rep_inverse' [symmetric]]
 lemmas word_rotr_dt = bl_word_rotr_dt [THEN word_bl.Rep_inverse' [symmetric]]
 lemmas word_roti_dt = bl_word_roti_dt [THEN word_bl.Rep_inverse' [symmetric]]
 
 lemmas word_rotr_dt_no_bin' [simp] =
   word_rotr_dt [where w="numeral w", unfolded to_bl_numeral] for w
   (* FIXME: negative numerals, 0 and 1 *)
 
 lemmas word_rotl_dt_no_bin' [simp] =
   word_rotl_dt [where w="numeral w", unfolded to_bl_numeral] for w
   (* FIXME: negative numerals, 0 and 1 *)
 
 lemma max_word_bl: "to_bl (- 1::'a::len word) = replicate LENGTH('a) True"
   by (fact to_bl_n1)
 
 lemma to_bl_mask:
   "to_bl (mask n :: 'a::len word) =
   replicate (LENGTH('a) - n) False @
     replicate (min (LENGTH('a)) n) True"
   by (simp add: mask_bl word_rep_drop min_def)
 
 lemma map_replicate_True:
   "n = length xs \<Longrightarrow>
     map (\<lambda>(x,y). x \<and> y) (zip xs (replicate n True)) = xs"
   by (induct xs arbitrary: n) auto
 
 lemma map_replicate_False:
   "n = length xs \<Longrightarrow> map (\<lambda>(x,y). x \<and> y)
     (zip xs (replicate n False)) = replicate n False"
   by (induct xs arbitrary: n) auto
 
 lemma bl_and_mask:
   fixes w :: "'a::len word"
     and n :: nat
   defines "n' \<equiv> LENGTH('a) - n"
   shows "to_bl (w AND mask n) = replicate n' False @ drop n' (to_bl w)"
 proof -
   note [simp] = map_replicate_True map_replicate_False
   have "to_bl (w AND mask n) = map2 (\<and>) (to_bl w) (to_bl (mask n::'a::len word))"
     by (simp add: bl_word_and)
   also have "to_bl w = take n' (to_bl w) @ drop n' (to_bl w)"
     by simp
   also have "map2 (\<and>) \<dots> (to_bl (mask n::'a::len word)) =
       replicate n' False @ drop n' (to_bl w)"
     unfolding to_bl_mask n'_def by (subst zip_append) auto
   finally show ?thesis .
 qed
 
 lemma drop_rev_takefill:
   "length xs \<le> n \<Longrightarrow>
     drop (n - length xs) (rev (takefill False n (rev xs))) = xs"
   by (simp add: takefill_alt rev_take)
 
 declare bin_to_bl_def [simp]
 
 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 transfer
   apply (simp add: take_bit_eq_mod)
   apply (rule Divides.mod_less)
    apply (rule bl_to_bin_ge0)
   using bl_to_bin_lt2p_drop apply (rule order.strict_trans2)
   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_and_1_bl:
   fixes x::"'a::len word"
   shows "(x AND 1) = of_bl [bit x 0]"
   by (simp add: mod_2_eq_odd and_one_eq)
 
 lemma word_1_and_bl:
   fixes x::"'a::len word"
   shows "(1 AND x) = of_bl [bit x 0]"
   by (simp add: mod_2_eq_odd one_and_eq)
 
 lemma of_bl_drop:
   "of_bl (drop n xs) = (of_bl xs AND mask (length xs - n))"
   apply (rule bit_word_eqI)
   apply (auto simp: rev_nth bit_simps cong: rev_conj_cong)
   done
 
 lemma to_bl_1:
   "to_bl (1::'a::len word) = replicate (LENGTH('a) - 1) False @ [True]"
   by (rule nth_equalityI) (auto simp add: to_bl_unfold nth_append rev_nth bit_1_iff not_less not_le)
 
 lemma eq_zero_set_bl:
   "(w = 0) = (True \<notin> set (to_bl w))"
   apply (auto simp add: to_bl_unfold)
   apply (rule bit_word_eqI)
   apply auto
   done
 
 lemma of_drop_to_bl:
   "of_bl (drop n (to_bl x)) = (x AND mask (size x - n))"
   by (simp add: of_bl_drop word_size_bl)
 
 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 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 word_msb_alt: "msb w \<longleftrightarrow> hd (to_bl w)"
   for w :: "'a::len word"
   apply (simp add: msb_word_eq)
   apply (subst hd_conv_nth)
    apply simp
   apply (subst nth_to_bl)
    apply simp
   apply simp
   done
 
 lemma word_lsb_last:
   \<open>lsb w \<longleftrightarrow> last (to_bl w)\<close>
   for w :: \<open>'a::len word\<close>
   using nth_to_bl [of \<open>LENGTH('a) - Suc 0\<close> w]
   by (simp add: lsb_odd last_conv_nth)
 
 lemma is_aligned_to_bl:
   "is_aligned (w :: 'a :: len word) n = (True \<notin> set (drop (size w - n) (to_bl w)))"
   by (simp add: is_aligned_mask eq_zero_set_bl bl_and_mask word_size)
 
 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
+  apply (rule nth_equalityI)
+  using assms apply (simp_all add: nth_append not_less word_size to_bl_nth is_aligned_imp_not_bit)
+  done
 
 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 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)
+  apply (rule nth_equalityI)
+   apply (auto simp add: nth_append to_bl_nth word_size bit_simps not_less nth_Cons le_diff_conv)
+  subgoal for i
+  apply (cases \<open>Suc (i + n) - LENGTH('a)\<close>)
+  apply simp_all
+    done
   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)"
   apply (auto simp add: to_bl_eq_rev take_map drop_map take_rev drop_rev bit_simps)
   apply (rule nth_equalityI)
    apply (auto simp add: bit_simps rev_nth nth_append Suc_diff_Suc)
   done
 
 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
 
 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 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 of_bl_mult_and_not_mask_eq:
   "\<lbrakk>is_aligned (a :: 'a::len word) n; length b + m \<le> n\<rbrakk>
    \<Longrightarrow> a + of_bl b * (2^m) AND NOT(mask n) = a"
   apply (simp flip: push_bit_eq_mult subtract_mask(1) take_bit_eq_mask)
   apply (subst disjunctive_add)
    apply (auto simp add: bit_simps not_le not_less)
    apply (meson is_aligned_imp_not_bit is_aligned_weaken less_diff_conv2)
   apply (erule is_alignedE')
   apply (simp add: take_bit_push_bit)
   apply (rule bit_word_eqI)
   apply (auto simp add: bit_simps)
   done
 
 lemma bin_to_bl_of_bl_eq:
   "\<lbrakk>is_aligned (a::'a::len word) n; length b + c \<le> n; length b + c < LENGTH('a)\<rbrakk>
-  \<Longrightarrow> bin_to_bl (length b) (uint ((a + of_bl b * 2^c) >> c)) = b"
-  apply (simp flip: push_bit_eq_mult take_bit_eq_mask add: shiftr_eq_drop_bit)
+  \<Longrightarrow> bin_to_bl (length b) (uint (drop_bit c (a + of_bl b * 2^c))) = b"
+  apply (simp flip: push_bit_eq_mult take_bit_eq_mask)
   apply (subst disjunctive_add)
    apply (auto simp add: bit_simps not_le not_less unsigned_or_eq unsigned_drop_bit_eq
      unsigned_push_bit_eq bin_to_bl_or simp flip: bin_to_bl_def)
    apply (meson is_aligned_imp_not_bit is_aligned_weaken less_diff_conv2)
   apply (erule is_alignedE')
   apply (rule nth_equalityI)
    apply (auto simp add: nth_bin_to_bl bit_simps rev_nth simp flip: bin_to_bl_def)
   done
 
 (* FIXME: move to Word distribution *)
 lemma bin_nth_minus_Bit0[simp]:
   "0 < n \<Longrightarrow> bit (numeral (num.Bit0 w) :: int) n = bit (numeral w :: int) (n - 1)"
   by (cases n; simp)
 
 lemma bin_nth_minus_Bit1[simp]:
   "0 < n \<Longrightarrow> bit (numeral (num.Bit1 w) :: int) n = bit (numeral w :: int) (n - 1)"
   by (cases n; simp)
 
 (* 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:
   "\<lbrakk> length (dropWhile Not (to_bl w)) \<le> LENGTH('s); LENGTH('s) \<le> LENGTH('l) \<rbrakk> \<Longrightarrow>
    (of_bl :: _ \<Rightarrow> 'l::len word) (to_bl ((of_bl::_ \<Rightarrow> 's::len word) (to_bl w))) = w"
   by (rule word_uint_eqI) (simp add: uint_of_bl_is_bl_to_bin uint_of_bl_is_bl_to_bin_drop)
 
 (*
  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:
   "\<lbrakk> length (dropWhile Not (to_bl w)) \<le> LENGTH('s); LENGTH('s) \<le> LENGTH('l) \<rbrakk> \<Longrightarrow>
    (ucast:: 's::len word \<Rightarrow> 'l::len word) ((ucast:: 'l::len word \<Rightarrow> 's::len word) w) = w"
   apply (subst ucast_bl)+
   apply (rule bl_cast_long_short_long_ingoreLeadingZero_generic; simp)
   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 map_bits_rev_to_bl:
   "map (bit x) [0..<size x] = rev (to_bl x)"
   by (auto simp: list_eq_iff_nth_eq test_bit_bl word_size)
 
 lemma of_bl_length2:
   "length xs + c < LENGTH('a) \<Longrightarrow> of_bl xs * 2^c < (2::'a::len word) ^ (length xs + c)"
   by (simp add: of_bl_length word_less_power_trans2)
 
 lemma of_bl_max:
   "(of_bl xs :: 'a::len word) \<le> mask (length xs)"
 proof -
   define ys where \<open>ys = rev xs\<close>
   have \<open>take_bit (length ys) (horner_sum of_bool 2 ys :: 'a word) = horner_sum of_bool 2 ys\<close>
     by transfer (simp add: take_bit_horner_sum_bit_eq min_def)
   then have \<open>(of_bl (rev ys) :: 'a word) \<le> mask (length ys)\<close>
     by (simp only: of_bl_rev_eq less_eq_mask_iff_take_bit_eq_self)
   with ys_def show ?thesis
     by simp
 qed
 
 text\<open>Some auxiliaries for sign-shifting by the entire word length or more\<close>
 
 lemma sshiftr_clamp_pos:
   assumes
     "LENGTH('a) \<le> n"
     "0 \<le> sint x"
-  shows "(x::'a::len word) >>> n = 0"
+  shows "signed_drop_bit n (x::'a::len word) = 0"
   apply (rule word_sint.Rep_eqD)
-  apply (unfold sshiftr_div_2n Word.sint_0)
-  apply (rule div_pos_pos_trivial)
-  subgoal using assms(2) .
-  apply (rule order.strict_trans[where b="2 ^ (LENGTH('a) - 1)"])
-  using sint_lt assms(1) by auto
+  apply (simp add: sint_signed_drop_bit_eq)
+  using assms
+  by (metis Word.sint_0 bit_last_iff not_less signed_drop_bit_beyond sint_signed_drop_bit_eq) 
 
 lemma sshiftr_clamp_neg:
   assumes
     "LENGTH('a) \<le> n"
     "sint x < 0"
-  shows "(x::'a::len word) >>> n = -1"
-proof -
-  have *: "- (2 ^ n) < sint x"
-    apply (rule order.strict_trans2[where b="- (2 ^ (LENGTH('a) - 1))"])
-    using assms(1) sint_ge by auto
-  show ?thesis
-    apply (rule word_sint.Rep_eqD)
-    apply (unfold sshiftr_div_2n Word.sint_n1)
-    apply (subst div_minus_minus[symmetric])
-    apply (rule div_pos_neg_trivial)
-    subgoal using assms(2) by linarith
-    using * by simp
-qed
+  shows "signed_drop_bit n (x::'a::len word) = -1"
+  apply (rule word_sint.Rep_eqD)
+  apply (simp add: sint_signed_drop_bit_eq)
+  using assms
+  by (metis bit_last_iff signed_drop_bit_beyond sint_n1 sint_signed_drop_bit_eq) 
 
 lemma sshiftr_clamp:
   assumes "LENGTH('a) \<le> n"
-  shows "(x::'a::len word) >>> n = x >>> LENGTH('a)"
+  shows "signed_drop_bit n (x::'a::len word) = signed_drop_bit LENGTH('a) x"
   apply (cases "0 \<le> sint x")
   subgoal
     apply (subst sshiftr_clamp_pos[OF assms])
     defer apply (subst sshiftr_clamp_pos)
     by auto
   apply (subst sshiftr_clamp_neg[OF assms])
   defer apply (subst sshiftr_clamp_neg)
   by auto
 
 text\<open>
 Like @{thm shiftr1_bl_of}, but the precondition is stronger because we need to pick the msb out of
 the list.
 \<close>
 lemma sshiftr1_bl_of:
   "length bl = LENGTH('a) \<Longrightarrow>
     sshiftr1 (of_bl bl::'a::len word) = of_bl (hd bl # butlast bl)"
   apply (rule word_bl.Rep_eqD)
   apply (subst bl_sshiftr1[of "of_bl bl :: 'a word"])
   by (simp add: word_bl.Abs_inverse)
 
 text\<open>
 Like @{thm sshiftr1_bl_of}, with a weaker precondition.
 We still get a direct equation for @{term \<open>sshiftr1 (of_bl bl)\<close>}, it's just uglier.
 \<close>
 lemma sshiftr1_bl_of':
   "LENGTH('a) \<le> length bl \<Longrightarrow>
     sshiftr1 (of_bl bl::'a::len word) =
     of_bl (hd (drop (length bl - LENGTH('a)) bl) # butlast (drop (length bl - LENGTH('a)) bl))"
   apply (subst of_bl_drop'[symmetric, of "length bl - LENGTH('a)"])
   using sshiftr1_bl_of[of "drop (length bl - LENGTH('a)) bl"]
   by auto
 
 text\<open>
 Like @{thm shiftr_bl_of}.
 \<close>
 lemma sshiftr_bl_of:
   assumes "length bl = LENGTH('a)"
-  shows "(of_bl bl::'a::len word) >>> n = of_bl (replicate n (hd bl) @ take (length bl - n) bl)"
+  shows "signed_drop_bit n (of_bl bl::'a::len word) = of_bl (replicate n (hd bl) @ take (length bl - n) bl)"
 proof -
-  {
-    fix n
-    assume "n \<le> LENGTH('a)"
-    hence "(of_bl bl::'a::len word) >>> n = of_bl (replicate n (hd bl) @ take (length bl - n) bl)"
-    proof (induction n)
-      case (Suc n)
-      hence "n < length bl" by (simp add: assms)
-      hence ne: "\<not>take (length bl - n) bl = []" by auto
-      have left: "hd (replicate n (hd bl) @ take (length bl - n) bl) = (hd bl)"
-        by (cases "0 < n") auto
-      have right: "butlast (take (length bl - n) bl) = take (length bl - Suc n) bl"
-        by (subst butlast_take) auto
-      have "(of_bl bl::'a::len word) >>> Suc n = sshiftr1 ((of_bl bl::'a::len word) >>> n)"
-        unfolding sshiftr_eq_funpow_sshiftr1 by simp
-      also have "\<dots> = of_bl (replicate (Suc n) (hd bl) @ take (length bl - Suc n) bl)"
-        apply (subst Suc.IH[OF Suc_leD[OF Suc.prems]])
-        apply (subst sshiftr1_bl_of)
-        subgoal using assms Suc.prems by simp
-        apply (rule arg_cong[where f=of_bl])
-        apply (subst butlast_append)
-        unfolding left right using ne by simp
-      finally show ?case .
-    qed (transfer, simp)
-  }
-  note pos = this
-  {
-    assume n: "LENGTH('a) \<le> n"
-    have "(of_bl bl::'a::len word) >>> n = (of_bl bl::'a::len word) >>> LENGTH('a)"
-      by (rule sshiftr_clamp[OF n])
-    also have "\<dots> = of_bl (replicate LENGTH('a) (hd bl) @ take (length bl - LENGTH('a)) bl)"
-      apply (rule pos) ..
-    also have "\<dots> = of_bl (replicate n (hd bl) @ take (length bl - n) bl)"
-    proof -
-      have "(of_bl (replicate LENGTH('a) (hd bl)) :: 'a word) = of_bl (replicate n (hd bl))"
-        apply (subst of_bl_drop'[symmetric, of "n - LENGTH('a)" "replicate n (hd bl)"])
-        unfolding length_replicate by (auto simp: n)
-      thus ?thesis by (simp add: assms n)
-    qed
-    finally have "(of_bl bl::'a::len word) >>> n
-      = of_bl (replicate n (hd bl) @ take (length bl - n) bl)" .
-  }
-  thus ?thesis using pos by fastforce
+  from assms obtain b bs where \<open>bl = b # bs\<close>
+    by (cases bl) simp_all
+  then have *: \<open>bl ! 0 \<longleftrightarrow> b\<close> \<open>hd bl \<longleftrightarrow> b\<close>
+    by simp_all
+  show ?thesis
+  apply (rule bit_word_eqI)
+    using assms * by (auto simp add: bit_simps nth_append rev_nth not_less)
 qed
 
 text\<open>Like @{thm shiftr_bl}\<close>
-lemma sshiftr_bl: "x >>> n \<equiv> of_bl (replicate n (msb x) @ take (LENGTH('a) - n) (to_bl x))"
+lemma sshiftr_bl: "signed_drop_bit n x \<equiv> of_bl (replicate n (msb x) @ take (LENGTH('a) - n) (to_bl x))"
   for x :: "'a::len word"
   unfolding word_msb_alt
   by (smt (z3) length_to_bl_eq sshiftr_bl_of word_bl.Rep_inverse)
 
 end
diff --git a/thys/Word_Lib/Rsplit.thy b/thys/Word_Lib/Rsplit.thy
--- a/thys/Word_Lib/Rsplit.thy
+++ b/thys/Word_Lib/Rsplit.thy
@@ -1,168 +1,168 @@
 (*
  * Copyright Data61, CSIRO (ABN 41 687 119 230)
  *
  * SPDX-License-Identifier: BSD-2-Clause
  *)
 
 (* Author: Jeremy Dawson and Gerwin Klein, NICTA *)
 
 section \<open>Splitting words into lists\<close>
 
 theory Rsplit
-  imports "HOL-Library.Word" Bits_Int
+  imports "HOL-Library.Word" More_Word Bits_Int
 begin
 
 definition word_rsplit :: "'a::len word \<Rightarrow> 'b::len word list"
   where "word_rsplit w = map word_of_int (bin_rsplit LENGTH('b) (LENGTH('a), uint w))"
 
 lemma word_rsplit_no:
   "(word_rsplit (numeral bin :: 'b::len word) :: 'a word list) =
     map word_of_int (bin_rsplit (LENGTH('a::len))
       (LENGTH('b), take_bit (LENGTH('b)) (numeral bin)))"
   by (simp add: word_rsplit_def of_nat_take_bit)
 
 lemmas word_rsplit_no_cl [simp] = word_rsplit_no
   [unfolded bin_rsplitl_def bin_rsplit_l [symmetric]]
 
 text \<open>
   This odd result arises from the fact that the statement of the
   result implies that the decoded words are of the same type,
   and therefore of the same length, as the original word.\<close>
 
 lemma word_rsplit_same: "word_rsplit w = [w]"
   apply (simp add: word_rsplit_def bin_rsplit_all)
   apply transfer
   apply simp
   done
 
 lemma word_rsplit_empty_iff_size: "word_rsplit w = [] \<longleftrightarrow> size w = 0"
   by (simp add: word_rsplit_def bin_rsplit_def word_size bin_rsplit_aux_simp_alt Let_def
       split: prod.split)
 
 lemma test_bit_rsplit:
   "sw = word_rsplit w \<Longrightarrow> m < size (hd sw) \<Longrightarrow>
     k < length sw \<Longrightarrow> bit (rev sw ! k) m = bit w (k * size (hd sw) + m)"
   for sw :: "'a::len word list"
   apply (unfold word_rsplit_def word_test_bit_def)
   apply (rule trans)
    apply (rule_tac f = "\<lambda>x. bit x m" in arg_cong)
    apply (rule nth_map [symmetric])
    apply simp
   apply (rule bin_nth_rsplit)
      apply simp_all
   apply (simp add : word_size rev_map)
   apply (rule trans)
    defer
    apply (rule map_ident [THEN fun_cong])
   apply (rule refl [THEN map_cong])
   apply simp
   using bin_rsplit_size_sign take_bit_int_eq_self_iff by blast
 
 lemma test_bit_rsplit_alt:
   \<open>bit ((word_rsplit w  :: 'b::len word list) ! i) m \<longleftrightarrow>
     bit w ((length (word_rsplit w :: 'b::len word list) - Suc i) * size (hd (word_rsplit w :: 'b::len word list)) + m)\<close>
   if \<open>i < length (word_rsplit w :: 'b::len word list)\<close> \<open>m < size (hd (word_rsplit w :: 'b::len word list))\<close> \<open>0 < length (word_rsplit w :: 'b::len word list)\<close>
   for w :: \<open>'a::len word\<close>
   apply (rule trans)
    apply (rule test_bit_cong)
    apply (rule rev_nth [of _ \<open>rev (word_rsplit w)\<close>, simplified rev_rev_ident])
   apply simp
    apply (rule that(1))
   apply simp
   apply (rule test_bit_rsplit)
     apply (rule refl)
   apply (rule asm_rl)
    apply (rule that(2))
   apply (rule diff_Suc_less)
   apply (rule that(3))
   done
 
 lemma word_rsplit_len_indep [OF refl refl refl refl]:
   "[u,v] = p \<Longrightarrow> [su,sv] = q \<Longrightarrow> word_rsplit u = su \<Longrightarrow>
     word_rsplit v = sv \<Longrightarrow> length su = length sv"
   by (auto simp: word_rsplit_def bin_rsplit_len_indep)
 
 lemma length_word_rsplit_size:
   "n = LENGTH('a::len) \<Longrightarrow>
     length (word_rsplit w :: 'a word list) \<le> m \<longleftrightarrow> size w \<le> m * n"
   by (auto simp: word_rsplit_def word_size bin_rsplit_len_le)
 
 lemmas length_word_rsplit_lt_size =
   length_word_rsplit_size [unfolded Not_eq_iff linorder_not_less [symmetric]]
 
 lemma length_word_rsplit_exp_size:
   "n = LENGTH('a::len) \<Longrightarrow>
     length (word_rsplit w :: 'a word list) = (size w + n - 1) div n"
   by (auto simp: word_rsplit_def word_size bin_rsplit_len)
 
 lemma length_word_rsplit_even_size:
   "n = LENGTH('a::len) \<Longrightarrow> size w = m * n \<Longrightarrow>
     length (word_rsplit w :: 'a word list) = m"
   by (cases \<open>LENGTH('a)\<close>) (simp_all add: length_word_rsplit_exp_size div_nat_eqI)
 
 lemmas length_word_rsplit_exp_size' = refl [THEN length_word_rsplit_exp_size]
 
 \<comment> \<open>alternative proof of \<open>word_rcat_rsplit\<close>\<close>
 lemmas tdle = times_div_less_eq_dividend
 lemmas dtle = xtrans(4) [OF tdle mult.commute]
 
 lemma word_rcat_rsplit: "word_rcat (word_rsplit w) = w"
   apply (rule word_eqI)
   apply (clarsimp simp: test_bit_rcat word_size)
   apply (subst refl [THEN test_bit_rsplit])
     apply (simp_all add: word_size
       refl [THEN length_word_rsplit_size [simplified not_less [symmetric], simplified]])
    apply safe
    apply (erule xtrans(7), rule dtle)+
   done
 
 lemma size_word_rsplit_rcat_size:
   "word_rcat ws = frcw \<Longrightarrow> size frcw = length ws * LENGTH('a)
     \<Longrightarrow> length (word_rsplit frcw::'a word list) = length ws"
   for ws :: "'a::len word list" and frcw :: "'b::len word"
   by (cases \<open>LENGTH('a)\<close>) (simp_all add: word_size length_word_rsplit_exp_size' div_nat_eqI)
 
 lemma msrevs:
   "0 < n \<Longrightarrow> (k * n + m) div n = m div n + k"
   "(k * n + m) mod n = m mod n"
   for n :: nat
   by (auto simp: add.commute)
 
 lemma word_rsplit_rcat_size [OF refl]:
   "word_rcat ws = frcw \<Longrightarrow>
     size frcw = length ws * LENGTH('a) \<Longrightarrow> word_rsplit frcw = ws"
   for ws :: "'a::len word list"
   apply (frule size_word_rsplit_rcat_size, assumption)
   apply (clarsimp simp add : word_size)
   apply (rule nth_equalityI, assumption)
   apply clarsimp
   apply (rule word_eqI [rule_format])
   apply (rule trans)
    apply (rule test_bit_rsplit_alt)
      apply (clarsimp simp: word_size)+
   apply (rule trans)
    apply (rule test_bit_rcat [OF refl refl])
   apply (simp add: word_size)
   apply (subst rev_nth)
    apply arith
   apply (simp add: le0 [THEN [2] xtrans(7), THEN diff_Suc_less])
   apply safe
   apply (simp add: diff_mult_distrib)
    apply (cases "size ws")
     apply simp_all
   done
 
 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])"
+    \<Longrightarrow> word_rsplit x = map (\<lambda>i. ucast (drop_bit (i * LENGTH('a)) x) :: '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 rev_nth field_simps)
+   apply (simp add: nth_ucast bit_simps rev_nth field_simps)
   apply (simp add: length_word_rsplit_exp_size)
   apply transfer
   apply (metis (no_types, lifting) Nat.add_diff_assoc Suc_leI add_0_left diff_Suc_less div_less len_gt_0 msrevs(1) mult.commute)
   done
 
 end
\ No newline at end of file
diff --git a/thys/Word_Lib/Typedef_Morphisms.thy b/thys/Word_Lib/Typedef_Morphisms.thy
--- a/thys/Word_Lib/Typedef_Morphisms.thy
+++ b/thys/Word_Lib/Typedef_Morphisms.thy
@@ -1,368 +1,368 @@
 (*
  * Copyright Data61, CSIRO (ABN 41 687 119 230)
  *
  * SPDX-License-Identifier: BSD-2-Clause
  *)
 
 (*
   Author: Jeremy Dawson and Gerwin Klein, NICTA
 
   Consequences of type definition theorems, and of extended type definition.
 *)
 
 section \<open>Type Definition Theorems\<close>
 
 theory Typedef_Morphisms
   imports Main "HOL-Library.Word" Bit_Comprehension Bits_Int
 begin
 
 subsection "More lemmas about normal type definitions"
 
 lemma tdD1: "type_definition Rep Abs A \<Longrightarrow> \<forall>x. Rep x \<in> A"
   and tdD2: "type_definition Rep Abs A \<Longrightarrow> \<forall>x. Abs (Rep x) = x"
   and tdD3: "type_definition Rep Abs A \<Longrightarrow> \<forall>y. y \<in> A \<longrightarrow> Rep (Abs y) = y"
   by (auto simp: type_definition_def)
 
 lemma td_nat_int: "type_definition int nat (Collect ((\<le>) 0))"
   unfolding type_definition_def by auto
 
 context type_definition
 begin
 
 declare Rep [iff] Rep_inverse [simp] Rep_inject [simp]
 
 lemma Abs_eqD: "Abs x = Abs y \<Longrightarrow> x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> x = y"
   by (simp add: Abs_inject)
 
 lemma Abs_inverse': "r \<in> A \<Longrightarrow> Abs r = a \<Longrightarrow> Rep a = r"
   by (safe elim!: Abs_inverse)
 
 lemma Rep_comp_inverse: "Rep \<circ> f = g \<Longrightarrow> Abs \<circ> g = f"
   using Rep_inverse by auto
 
 lemma Rep_eqD [elim!]: "Rep x = Rep y \<Longrightarrow> x = y"
   by simp
 
 lemma Rep_inverse': "Rep a = r \<Longrightarrow> Abs r = a"
   by (safe intro!: Rep_inverse)
 
 lemma comp_Abs_inverse: "f \<circ> Abs = g \<Longrightarrow> g \<circ> Rep = f"
   using Rep_inverse by auto
 
 lemma set_Rep: "A = range Rep"
 proof (rule set_eqI)
   show "x \<in> A \<longleftrightarrow> x \<in> range Rep" for x
     by (auto dest: Abs_inverse [of x, symmetric])
 qed
 
 lemma set_Rep_Abs: "A = range (Rep \<circ> Abs)"
 proof (rule set_eqI)
   show "x \<in> A \<longleftrightarrow> x \<in> range (Rep \<circ> Abs)" for x
     by (auto dest: Abs_inverse [of x, symmetric])
 qed
 
 lemma Abs_inj_on: "inj_on Abs A"
   unfolding inj_on_def
   by (auto dest: Abs_inject [THEN iffD1])
 
 lemma image: "Abs ` A = UNIV"
   by (fact Abs_image)
 
 lemmas td_thm = type_definition_axioms
 
 lemma fns1: "Rep \<circ> fa = fr \<circ> Rep \<or> fa \<circ> Abs = Abs \<circ> fr \<Longrightarrow> Abs \<circ> fr \<circ> Rep = fa"
   by (auto dest: Rep_comp_inverse elim: comp_Abs_inverse simp: o_assoc)
 
 lemmas fns1a = disjI1 [THEN fns1]
 lemmas fns1b = disjI2 [THEN fns1]
 
 lemma fns4: "Rep \<circ> fa \<circ> Abs = fr \<Longrightarrow> Rep \<circ> fa = fr \<circ> Rep \<and> fa \<circ> Abs = Abs \<circ> fr"
   by auto
 
 end
 
 interpretation nat_int: type_definition int nat "Collect ((\<le>) 0)"
   by (rule td_nat_int)
 
 declare
   nat_int.Rep_cases [cases del]
   nat_int.Abs_cases [cases del]
   nat_int.Rep_induct [induct del]
   nat_int.Abs_induct [induct del]
 
 
 subsection "Extended form of type definition predicate"
 
 lemma td_conds:
   "norm \<circ> norm = norm \<Longrightarrow>
     fr \<circ> norm = norm \<circ> fr \<longleftrightarrow> norm \<circ> fr \<circ> norm = fr \<circ> norm \<and> norm \<circ> fr \<circ> norm = norm \<circ> fr"
   apply safe
     apply (simp_all add: comp_assoc)
    apply (simp_all add: o_assoc)
   done
 
 lemma fn_comm_power: "fa \<circ> tr = tr \<circ> fr \<Longrightarrow> fa ^^ n \<circ> tr = tr \<circ> fr ^^ n"
   apply (rule ext)
   apply (induct n)
    apply (auto dest: fun_cong)
   done
 
 lemmas fn_comm_power' =
   ext [THEN fn_comm_power, THEN fun_cong, unfolded o_def]
 
 
 locale td_ext = type_definition +
   fixes norm
   assumes eq_norm: "\<And>x. Rep (Abs x) = norm x"
 begin
 
 lemma Abs_norm [simp]: "Abs (norm x) = Abs x"
   using eq_norm [of x] by (auto elim: Rep_inverse')
 
 lemma td_th: "g \<circ> Abs = f \<Longrightarrow> f (Rep x) = g x"
   by (drule comp_Abs_inverse [symmetric]) simp
 
 lemma eq_norm': "Rep \<circ> Abs = norm"
   by (auto simp: eq_norm)
 
 lemma norm_Rep [simp]: "norm (Rep x) = Rep x"
   by (auto simp: eq_norm' intro: td_th)
 
 lemmas td = td_thm
 
 lemma set_iff_norm: "w \<in> A \<longleftrightarrow> w = norm w"
   by (auto simp: set_Rep_Abs eq_norm' eq_norm [symmetric])
 
 lemma inverse_norm: "Abs n = w \<longleftrightarrow> Rep w = norm n"
   apply (rule iffI)
    apply (clarsimp simp add: eq_norm)
   apply (simp add: eq_norm' [symmetric])
   done
 
 lemma norm_eq_iff: "norm x = norm y \<longleftrightarrow> Abs x = Abs y"
   by (simp add: eq_norm' [symmetric])
 
 lemma norm_comps:
   "Abs \<circ> norm = Abs"
   "norm \<circ> Rep = Rep"
   "norm \<circ> norm = norm"
   by (auto simp: eq_norm' [symmetric] o_def)
 
 lemmas norm_norm [simp] = norm_comps
 
 lemma fns5: "Rep \<circ> fa \<circ> Abs = fr \<Longrightarrow> fr \<circ> norm = fr \<and> norm \<circ> fr = fr"
   by (fold eq_norm') auto
 
 text \<open>
   following give conditions for converses to \<open>td_fns1\<close>
   \<^item> the condition \<open>norm \<circ> fr \<circ> norm = fr \<circ> norm\<close> says that
     \<open>fr\<close> takes normalised arguments to normalised results
   \<^item> \<open>norm \<circ> fr \<circ> norm = norm \<circ> fr\<close> says that \<open>fr\<close>
     takes norm-equivalent arguments to norm-equivalent results
   \<^item> \<open>fr \<circ> norm = fr\<close> says that \<open>fr\<close>
     takes norm-equivalent arguments to the same result
   \<^item> \<open>norm \<circ> fr = fr\<close> says that \<open>fr\<close> takes any argument to a normalised result
 \<close>
 lemma fns2: "Abs \<circ> fr \<circ> Rep = fa \<Longrightarrow> norm \<circ> fr \<circ> norm = fr \<circ> norm \<longleftrightarrow> Rep \<circ> fa = fr \<circ> Rep"
   apply (fold eq_norm')
   apply safe
    prefer 2
    apply (simp add: o_assoc)
   apply (rule ext)
   apply (drule_tac x="Rep x" in fun_cong)
   apply auto
   done
 
 lemma fns3: "Abs \<circ> fr \<circ> Rep = fa \<Longrightarrow> norm \<circ> fr \<circ> norm = norm \<circ> fr \<longleftrightarrow> fa \<circ> Abs = Abs \<circ> fr"
   apply (fold eq_norm')
   apply safe
    prefer 2
    apply (simp add: comp_assoc)
   apply (rule ext)
   apply (drule_tac f="a \<circ> b" for a b in fun_cong)
   apply simp
   done
 
 lemma fns: "fr \<circ> norm = norm \<circ> fr \<Longrightarrow> fa \<circ> Abs = Abs \<circ> fr \<longleftrightarrow> Rep \<circ> fa = fr \<circ> Rep"
   apply safe
    apply (frule fns1b)
    prefer 2
    apply (frule fns1a)
    apply (rule fns3 [THEN iffD1])
      prefer 3
      apply (rule fns2 [THEN iffD1])
        apply (simp_all add: comp_assoc)
    apply (simp_all add: o_assoc)
   done
 
 lemma range_norm: "range (Rep \<circ> Abs) = A"
   by (simp add: set_Rep_Abs)
 
 end
 
 lemmas td_ext_def' =
   td_ext_def [unfolded type_definition_def td_ext_axioms_def]
 
 
 subsection \<open>Type-definition locale instantiations\<close>
 
 definition uints :: "nat \<Rightarrow> int set"
   \<comment> \<open>the sets of integers representing the words\<close>
   where "uints n = range (take_bit n)"
 
 definition sints :: "nat \<Rightarrow> int set"
   where "sints n = range (signed_take_bit (n - 1))"
 
 lemma uints_num: "uints n = {i. 0 \<le> i \<and> i < 2 ^ n}"
   by (simp add: uints_def range_bintrunc)
 
 lemma sints_num: "sints n = {i. - (2 ^ (n - 1)) \<le> i \<and> i < 2 ^ (n - 1)}"
   by (simp add: sints_def range_sbintrunc)
 
 definition unats :: "nat \<Rightarrow> nat set"
   where "unats n = {i. i < 2 ^ n}"
 
 \<comment> \<open>naturals\<close>
 lemma uints_unats: "uints n = int ` unats n"
   apply (unfold unats_def uints_num)
   apply safe
     apply (rule_tac image_eqI)
      apply (erule_tac nat_0_le [symmetric])
   by auto
 
 lemma unats_uints: "unats n = nat ` uints n"
   by (auto simp: uints_unats image_iff)
 
 lemma td_ext_uint:
   "td_ext (uint :: 'a word \<Rightarrow> int) word_of_int (uints (LENGTH('a::len)))
     (\<lambda>w::int. w mod 2 ^ LENGTH('a))"
   apply (unfold td_ext_def')
   apply transfer
   apply (simp add: uints_num take_bit_eq_mod)
   done
 
 interpretation word_uint:
   td_ext
     "uint::'a::len word \<Rightarrow> int"
     word_of_int
     "uints (LENGTH('a::len))"
     "\<lambda>w. w mod 2 ^ LENGTH('a::len)"
   by (fact td_ext_uint)
 
 lemmas td_uint = word_uint.td_thm
 lemmas int_word_uint = word_uint.eq_norm
 
 lemma td_ext_ubin:
   "td_ext (uint :: 'a word \<Rightarrow> int) word_of_int (uints (LENGTH('a::len)))
     (take_bit (LENGTH('a)))"
   apply standard
   apply transfer
   apply simp
   done
 
 interpretation word_ubin:
   td_ext
     "uint::'a::len word \<Rightarrow> int"
     word_of_int
     "uints (LENGTH('a::len))"
     "take_bit (LENGTH('a::len))"
   by (fact td_ext_ubin)
 
 lemma td_ext_unat [OF refl]:
   "n = LENGTH('a::len) \<Longrightarrow>
     td_ext (unat :: 'a word \<Rightarrow> nat) of_nat (unats n) (\<lambda>i. i mod 2 ^ n)"
   apply (standard; transfer)
      apply (simp_all add: unats_def take_bit_of_nat take_bit_nat_eq_self_iff
       flip: take_bit_eq_mod)
   done
 
 lemmas unat_of_nat = td_ext_unat [THEN td_ext.eq_norm]
 
 interpretation word_unat:
   td_ext
     "unat::'a::len word \<Rightarrow> nat"
     of_nat
     "unats (LENGTH('a::len))"
     "\<lambda>i. i mod 2 ^ LENGTH('a::len)"
   by (rule td_ext_unat)
 
 lemmas td_unat = word_unat.td_thm
 
 lemma unat_le: "y \<le> unat z \<Longrightarrow> y \<in> unats (LENGTH('a))"
   for z :: "'a::len word"
   apply (unfold unats_def)
   apply clarsimp
-  apply (rule xtrans, rule unat_lt2p, assumption)
+  apply (metis le_unat_uoi unsigned_less)
   done
 
 lemma td_ext_sbin:
   "td_ext (sint :: 'a word \<Rightarrow> int) word_of_int (sints (LENGTH('a::len)))
     (signed_take_bit (LENGTH('a) - 1))"
   by (standard; transfer) (auto simp add: sints_def)
 
 lemma td_ext_sint:
   "td_ext (sint :: 'a word \<Rightarrow> int) word_of_int (sints (LENGTH('a::len)))
      (\<lambda>w. (w + 2 ^ (LENGTH('a) - 1)) mod 2 ^ LENGTH('a) -
          2 ^ (LENGTH('a) - 1))"
   using td_ext_sbin [where ?'a = 'a] by (simp add: no_sbintr_alt2)
 
 text \<open>
   We do \<open>sint\<close> before \<open>sbin\<close>, before \<open>sint\<close> is the user version
   and interpretations do not produce thm duplicates. I.e.
   we get the name \<open>word_sint.Rep_eqD\<close>, but not \<open>word_sbin.Req_eqD\<close>,
   because the latter is the same thm as the former.
 \<close>
 interpretation word_sint:
   td_ext
     "sint ::'a::len word \<Rightarrow> int"
     word_of_int
     "sints (LENGTH('a::len))"
     "\<lambda>w. (w + 2^(LENGTH('a::len) - 1)) mod 2^LENGTH('a::len) -
       2 ^ (LENGTH('a::len) - 1)"
   by (rule td_ext_sint)
 
 interpretation word_sbin:
   td_ext
     "sint ::'a::len word \<Rightarrow> int"
     word_of_int
     "sints (LENGTH('a::len))"
     "signed_take_bit (LENGTH('a::len) - 1)"
   by (rule td_ext_sbin)
 
 lemmas int_word_sint = td_ext_sint [THEN td_ext.eq_norm]
 
 lemmas td_sint = word_sint.td
 
 lemma uints_mod: "uints n = range (\<lambda>w. w mod 2 ^ n)"
   by (fact uints_def [unfolded no_bintr_alt1])
 
 lemmas bintr_num =
   word_ubin.norm_eq_iff [of "numeral a" "numeral b", symmetric, folded word_numeral_alt] for a b
 lemmas sbintr_num =
   word_sbin.norm_eq_iff [of "numeral a" "numeral b", symmetric, folded word_numeral_alt] for a b
 
 lemmas uint_div_alt = word_div_def [THEN trans [OF uint_cong int_word_uint]]
 lemmas uint_mod_alt = word_mod_def [THEN trans [OF uint_cong int_word_uint]]
 
 interpretation test_bit:
   td_ext
     "bit :: 'a::len word \<Rightarrow> nat \<Rightarrow> bool"
     set_bits
     "{f. \<forall>i. f i \<longrightarrow> i < LENGTH('a::len)}"
     "(\<lambda>h i. h i \<and> i < LENGTH('a::len))"
   by standard (auto simp add: bit_imp_le_length bit_set_bits_word_iff set_bits_bit_eq)
 
 lemmas td_nth = test_bit.td_thm
 
 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
 
 end
diff --git a/thys/Word_Lib/Word_32.thy b/thys/Word_Lib/Word_32.thy
--- a/thys/Word_Lib/Word_32.thy
+++ b/thys/Word_Lib/Word_32.thy
@@ -1,341 +1,342 @@
 (*
  * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
  *
  * SPDX-License-Identifier: BSD-2-Clause
  *)
 
 section "Words of Length 32"
 
 theory Word_32
   imports
     Word_Lemmas
     Word_Syntax
     Word_Names
     Rsplit
     More_Word_Operations
     Bitwise
 begin
 
 type_synonym word32 = "32 word"
 lemma len32: "len_of (x :: 32 itself) = 32" by simp
 
 type_synonym sword32 = "32 sword"
 
 type_synonym machine_word_len = 32
 type_synonym machine_word = "machine_word_len word"
 
 definition word_bits :: nat
 where
   "word_bits = LENGTH(machine_word_len)"
 
 text \<open>The following two are numerals so they can be used as nats and words.\<close>
 definition word_size_bits :: "'a :: numeral"
 where
   "word_size_bits = 2"
 
 definition word_size :: "'a :: numeral"
 where
   "word_size = 4"
 
 lemma word_bits_conv[code]:
   "word_bits = 32"
   unfolding word_bits_def by simp
 
 lemma word_size_word_size_bits:
   "(word_size::nat) = 2 ^ word_size_bits"
   unfolding word_size_def word_size_bits_def by simp
 
 lemma word_bits_word_size_conv:
   "word_bits = word_size * 8"
   unfolding word_bits_def word_size_def by simp
 
 lemma ucast_8_32_inj:
   "inj (ucast ::  8 word \<Rightarrow> 32 word)"
   by (rule down_ucast_inj) (clarsimp simp: is_down_def target_size source_size)
 
 lemma upto_2_helper:
   "{0..<2 :: 32 word} = {0, 1}"
   by (safe; simp) unat_arith
 
 lemmas upper_bits_unset_is_l2p_32 = upper_bits_unset_is_l2p [where 'a=32, folded word_bits_def]
 lemmas le_2p_upper_bits_32 = le_2p_upper_bits [where 'a=32, folded word_bits_def]
 lemmas le2p_bits_unset_32 = le2p_bits_unset[where 'a=32, folded word_bits_def]
 
 lemma word_bits_len_of:
   "len_of TYPE (32) = word_bits"
   by (simp add: word_bits_conv)
 
 lemmas unat_power_lower32' = unat_power_lower[where 'a=32]
 lemmas unat_power_lower32 [simp] = unat_power_lower32'[unfolded word_bits_len_of]
 
 lemmas word32_less_sub_le' = word_less_sub_le[where 'a = 32]
 lemmas word32_less_sub_le[simp] = word32_less_sub_le' [folded word_bits_def]
 
 lemma word_bits_size:
   "size (w::word32) = word_bits"
   by (simp add: word_bits_def word_size)
 
 lemmas word32_power_less_1' = word_power_less_1[where 'a = 32]
 lemmas word32_power_less_1[simp] = word32_power_less_1'[folded word_bits_def]
 
 lemma of_nat32_0:
   "\<lbrakk>of_nat n = (0::word32); n < 2 ^ word_bits\<rbrakk> \<Longrightarrow> n = 0"
   by (erule of_nat_0, simp add: word_bits_def)
 
 lemma unat_mask_2_less_4:
   "unat (p && mask 2 :: word32) < 4"
-  apply (rule unat_less_helper)
-  apply (rule order_le_less_trans, rule word_and_le1)
-  apply (simp add: mask_eq)
-  done
+  by (rule unat_less_helper) (simp flip: take_bit_eq_mask add: take_bit_eq_mod word_mod_less_divisor)
 
 lemmas unat_of_nat32' = unat_of_nat_eq[where 'a=32]
 lemmas unat_of_nat32 = unat_of_nat32'[unfolded word_bits_len_of]
 
 lemmas word_power_nonzero_32 = word_power_nonzero [where 'a=32, folded word_bits_def]
 
 lemmas unat_mult_simple = iffD1 [OF unat_mult_lem [where 'a = 32, unfolded word_bits_len_of]]
 
 lemmas div_power_helper_32 = div_power_helper [where 'a=32, folded word_bits_def]
 
 lemma n_less_word_bits:
   "(n < word_bits) = (n < 32)"
   by (simp add: word_bits_def)
 
 lemmas of_nat_less_pow_32 = of_nat_power [where 'a=32, folded word_bits_def]
 
 lemma lt_word_bits_lt_pow:
   "sz < word_bits \<Longrightarrow> sz < 2 ^ word_bits"
   by (simp add: word_bits_conv)
 
 lemma unat_less_word_bits:
   fixes y :: word32
   shows "x < unat y \<Longrightarrow> x < 2 ^ word_bits"
   unfolding word_bits_def
   by (rule order_less_trans [OF _ unat_lt2p])
 
 lemmas unat_mask_word32' = unat_mask[where 'a=32]
 lemmas unat_mask_word32 = unat_mask_word32'[folded word_bits_def]
 
 lemma unat_less_2p_word_bits:
   "unat (x :: 32 word) < 2 ^ word_bits"
   apply (simp only: word_bits_def)
   apply (rule unat_lt2p)
   done
 
 lemma Suc_unat_mask_div:
   "Suc (unat (mask sz div word_size::word32)) = 2 ^ (min sz word_bits - 2)"
-  apply (case_tac "sz < word_bits")
-   apply (case_tac "2 \<le> sz")
-    apply (clarsimp simp: word_size_def word_bits_def min_def mask_eq)
-    apply (drule (2) Suc_div_unat_helper
-           [where 'a=32 and sz=sz and us=2, simplified, symmetric])
-   apply (simp add: not_le word_size_def word_bits_def)
-   apply (case_tac sz, simp add: unat_word_ariths)
-   apply (case_tac nat, simp add: unat_word_ariths
-                                  unat_mask_word32 min_def word_bits_def)
-   apply simp
-  apply (simp add: unat_word_ariths
-                   unat_mask_word32 min_def word_bits_def word_size_def)
-  done
+proof (cases \<open>sz \<ge> 2\<close>)
+  case False
+  then have \<open>sz \<in> {0, 1}\<close>
+    by auto
+  then show ?thesis by (auto simp add: unat_div word_size_def)
+next
+  case True
+  moreover define n where \<open>n = sz - 2\<close>
+  ultimately have \<open>sz = n + 2\<close>
+    by simp
+  moreover have \<open>4 * 2 ^ n = 2 ^ n * (4::nat)\<close>
+    by (simp add: ac_simps)
+  then have \<open>4 * 2 ^ n - Suc 0 = (2 ^ n - 1) * 4 + 3\<close>
+    by (simp add: mult_eq_if)
+  ultimately show ?thesis
+    by (simp add: unat_div unat_mask word_size_def word_bits_def min_def)
+qed
 
 lemmas word32_minus_one_le' = word_minus_one_le[where 'a=32]
 lemmas word32_minus_one_le = word32_minus_one_le'[simplified]
 
 lemma ucast_not_helper:
   fixes a::"8 word"
   assumes a: "a \<noteq> 0xFF"
   shows "ucast a \<noteq> (0xFF::word32)"
 proof
   assume "ucast a = (0xFF::word32)"
   also
   have "(0xFF::word32) = ucast (0xFF::8 word)" by simp
   finally
   show False using a
     apply -
     apply (drule up_ucast_inj, simp)
     apply simp
     done
 qed
 
 lemma less_4_cases:
   "(x::word32) < 4 \<Longrightarrow> x=0 \<or> x=1 \<or> x=2 \<or> x=3"
   apply clarsimp
   apply (drule word_less_cases, erule disjE, simp, simp)+
   done
 
 lemma unat_ucast_8_32:
   fixes x :: "8 word"
   shows "unat (ucast x :: word32) = unat x"
   by transfer simp
 
 lemma if_then_1_else_0:
   "((if P then 1 else 0) = (0 :: word32)) = (\<not> P)"
   by simp
 
 lemma if_then_0_else_1:
   "((if P then 0 else 1) = (0 :: word32)) = (P)"
   by simp
 
 lemmas if_then_simps = if_then_0_else_1 if_then_1_else_0
 
 lemma ucast_le_ucast_8_32:
   "(ucast x \<le> (ucast y :: word32)) = (x \<le> (y :: 8 word))"
   by (simp add: ucast_le_ucast)
 
 lemma in_16_range:
   "0 \<in> S \<Longrightarrow> r \<in> (\<lambda>x. r + x * (16 :: word32)) ` S"
   "n - 1 \<in> S \<Longrightarrow> (r + (16 * n - 16)) \<in> (\<lambda>x :: word32. r + x * 16) ` S"
   by (clarsimp simp: image_def elim!: bexI[rotated])+
 
 lemma eq_2_32_0:
   "(2 ^ 32 :: word32) = 0"
   by simp
 
 lemma x_less_2_0_1:
   fixes x :: word32 shows
   "x < 2 \<Longrightarrow> x = 0 \<or> x = 1"
   by (rule x_less_2_0_1') auto
 
 lemmas mask_32_max_word  = max_word_mask [symmetric, where 'a=32, simplified]
 
 lemma of_nat32_n_less_equal_power_2:
  "n < 32 \<Longrightarrow> ((of_nat n)::32 word) < 2 ^ n"
   by (rule of_nat_n_less_equal_power_2, clarsimp simp: word_size)
 
 lemma word_rsplit_0:
   "word_rsplit (0 :: word32) = [0, 0, 0, 0 :: 8 word]"
   by (simp add: word_rsplit_def bin_rsplit_def)
 
 lemma unat_ucast_10_32 :
   fixes x :: "10 word"
   shows "unat (ucast x :: word32) = unat x"
   by transfer simp
 
 lemma bool_mask [simp]:
   fixes x :: word32
   shows "(0 < x && 1) = (x && 1 = 1)"
   by (rule bool_mask') auto
 
 lemma word32_bounds:
   "- (2 ^ (size (x :: word32) - 1)) = (-2147483648 :: int)"
   "((2 ^ (size (x :: word32) - 1)) - 1) = (2147483647 :: int)"
   "- (2 ^ (size (y :: 32 signed word) - 1)) = (-2147483648 :: int)"
   "((2 ^ (size (y :: 32 signed word) - 1)) - 1) = (2147483647 :: int)"
   by (simp_all add: word_size)
 
 lemma word_ge_min:"sint (x::32 word) \<ge> -2147483648"
   by (metis sint_ge word32_bounds(1) word_size)
 
 lemmas signed_arith_ineq_checks_to_eq_word32'
     = signed_arith_ineq_checks_to_eq[where 'a=32]
       signed_arith_ineq_checks_to_eq[where 'a="32 signed"]
 
 lemmas signed_arith_ineq_checks_to_eq_word32
     = signed_arith_ineq_checks_to_eq_word32' [unfolded word32_bounds]
 
 lemmas signed_mult_eq_checks32_to_64'
     = signed_mult_eq_checks_double_size[where 'a=32 and 'b=64]
       signed_mult_eq_checks_double_size[where 'a="32 signed" and 'b=64]
 
 lemmas signed_mult_eq_checks32_to_64 = signed_mult_eq_checks32_to_64'[simplified]
 
 lemmas sdiv_word32_max' = sdiv_word_max [where 'a=32] sdiv_word_max [where 'a="32 signed"]
 lemmas sdiv_word32_max = sdiv_word32_max'[simplified word_size, simplified]
 
 lemmas sdiv_word32_min' = sdiv_word_min [where 'a=32] sdiv_word_min [where 'a="32 signed"]
 lemmas sdiv_word32_min = sdiv_word32_min' [simplified word_size, simplified]
 
 lemmas sint32_of_int_eq' = sint_of_int_eq [where 'a=32]
 lemmas sint32_of_int_eq = sint32_of_int_eq' [simplified]
 
 lemma ucast_of_nats [simp]:
   "(ucast (of_nat x :: word32) :: sword32) = (of_nat x)"
   "(ucast (of_nat x :: word32) :: 16 sword) = (of_nat x)"
   "(ucast (of_nat x :: word32) :: 8 sword) = (of_nat x)"
   "(ucast (of_nat x :: 16 word) :: 16 sword) = (of_nat x)"
   "(ucast (of_nat x :: 16 word) :: 8 sword) = (of_nat x)"
   "(ucast (of_nat x :: 8 word) :: 8 sword) = (of_nat x)"
   by (simp_all add: of_nat_take_bit take_bit_word_eq_self)
 
 lemmas signed_shift_guard_simpler_32'
     = power_strict_increasing_iff[where b="2 :: nat" and y=31]
 lemmas signed_shift_guard_simpler_32 = signed_shift_guard_simpler_32'[simplified]
 
 lemma word32_31_less:
   "31 < len_of TYPE (32 signed)" "31 > (0 :: nat)"
   "31 < len_of TYPE (32)" "31 > (0 :: nat)"
   by auto
 
 lemmas signed_shift_guard_to_word_32
     = signed_shift_guard_to_word[OF word32_31_less(1-2)]
     signed_shift_guard_to_word[OF word32_31_less(3-4)]
 
 lemma le_step_down_word_3:
   fixes x :: "32 word"
   shows "\<lbrakk>x \<le>  y; x \<noteq> y; y < 2 ^ 32 - 1\<rbrakk> \<Longrightarrow> x \<le> y - 1"
   by (rule le_step_down_word_2, assumption+)
 
 lemma shiftr_1:
   "(x::word32) >> 1 = 0 \<Longrightarrow> x < 2"
   by transfer (simp add: take_bit_drop_bit drop_bit_Suc)
 
 lemma has_zero_byte:
   "~~ (((((v::word32) && 0x7f7f7f7f) + 0x7f7f7f7f) || v) || 0x7f7f7f7f) \<noteq> 0
     \<Longrightarrow> v && 0xff000000 = 0 \<or> v && 0xff0000 = 0 \<or> v && 0xff00 = 0 \<or> v && 0xff = 0"
   by word_bitwise auto
 
 lemma mask_step_down_32:
   \<open>\<exists>x. mask x = b\<close> if \<open>b && 1 = 1\<close>
     and \<open>\<exists>x. x < 32 \<and> mask x = b >> 1\<close> for b :: \<open>32word\<close>
 proof -
   from \<open>b && 1 = 1\<close> have \<open>odd b\<close>
     by (auto simp add: mod_2_eq_odd and_one_eq)
   then have \<open>b mod 2 = 1\<close>
     using odd_iff_mod_2_eq_one by blast
   from \<open>\<exists>x. x < 32 \<and> mask x = b >> 1\<close> obtain x where \<open>x < 32\<close> \<open>mask x = b >> 1\<close> by blast
   then have \<open>mask x = b div 2\<close>
     using shiftr1_is_div_2 [of b] by simp
   with \<open>b mod 2 = 1\<close> have \<open>2 * mask x + 1 = 2 * (b div 2) + b mod 2\<close>
     by (simp only:)
   also have \<open>\<dots> = b\<close>
     by (simp add: mult_div_mod_eq)
   finally have \<open>2 * mask x + 1 = b\<close> .
   moreover have \<open>mask (Suc x) = 2 * mask x + (1 :: 'a::len word)\<close>
     by (simp add: mask_Suc_rec)
   ultimately show ?thesis
     by auto
 qed
 
 lemma unat_of_int_32:
   "\<lbrakk>i \<ge> 0; i \<le>2 ^ 31\<rbrakk> \<Longrightarrow> (unat ((of_int i)::sword32)) = nat i"
   unfolding unat_eq_nat_uint
   apply (subst eq_nat_nat_iff)
     apply (auto simp add: take_bit_int_eq_self)
   done
 
 lemmas word_ctz_not_minus_1_32 = word_ctz_not_minus_1[where 'a=32, simplified]
 
 (* Helper for packing then unpacking a 64-bit variable. *)
 lemma cast_chunk_assemble_id_64[simp]:
   "(((ucast ((ucast (x::64 word))::32 word))::64 word) || (((ucast ((ucast (x >> 32))::32 word))::64 word) << 32)) = x"
   by (simp add:cast_chunk_assemble_id)
 
 (* Another variant of packing and unpacking a 64-bit variable. *)
 lemma cast_chunk_assemble_id_64'[simp]:
   "(((ucast ((scast (x::64 word))::32 word))::64 word) || (((ucast ((scast (x >> 32))::32 word))::64 word) << 32)) = x"
   by (simp add:cast_chunk_scast_assemble_id)
 
 (* Specialisations of down_cast_same for adding to local simpsets. *)
 lemma cast_down_u64: "(scast::64 word \<Rightarrow> 32 word) = (ucast::64 word \<Rightarrow> 32 word)"
   by (subst down_cast_same[symmetric]; simp add:is_down)+
 
 lemma cast_down_s64: "(scast::64 sword \<Rightarrow> 32 word) = (ucast::64 sword \<Rightarrow> 32 word)"
   by (subst down_cast_same[symmetric]; simp add:is_down)
 
 lemma word32_and_max_simp:
   \<open>x AND 0xFFFFFFFF = x\<close> for x :: \<open>32 word\<close>
   using word_and_full_mask_simp [of x]
   by (simp add: numeral_eq_Suc mask_Suc_exp)
 
 end
diff --git a/thys/Word_Lib/Word_64.thy b/thys/Word_Lib/Word_64.thy
--- a/thys/Word_Lib/Word_64.thy
+++ b/thys/Word_Lib/Word_64.thy
@@ -1,308 +1,306 @@
 (*
  * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
  *
  * SPDX-License-Identifier: BSD-2-Clause
  *)
 
 section "Words of Length 64"
 
 theory Word_64
   imports
     Word_Lemmas
     Word_Names
     Word_Syntax
     Rsplit
     More_Word_Operations
 begin
 
 lemma len64: "len_of (x :: 64 itself) = 64" by simp
 
 type_synonym machine_word_len = 64
 type_synonym machine_word = "machine_word_len word"
 
 definition word_bits :: nat
 where
   "word_bits = LENGTH(machine_word_len)"
 
 text \<open>The following two are numerals so they can be used as nats and words.\<close>
 definition word_size_bits :: "'a :: numeral"
 where
   "word_size_bits = 3"
 
 definition word_size :: "'a :: numeral"
 where
   "word_size = 8"
 
 lemma word_bits_conv[code]:
   "word_bits = 64"
   unfolding word_bits_def by simp
 
 lemma word_size_word_size_bits:
   "(word_size::nat) = 2 ^ word_size_bits"
   unfolding word_size_def word_size_bits_def by simp
 
 lemma word_bits_word_size_conv:
   "word_bits = word_size * 8"
   unfolding word_bits_def word_size_def by simp
 
 lemma ucast_8_64_inj:
   "inj (ucast ::  8 word \<Rightarrow> 64 word)"
   by (rule down_ucast_inj) (clarsimp simp: is_down_def target_size source_size)
 
 lemma upto_2_helper:
   "{0..<2 :: 64 word} = {0, 1}"
   by (safe; simp) unat_arith
 
 lemmas upper_bits_unset_is_l2p_64 = upper_bits_unset_is_l2p [where 'a=64, folded word_bits_def]
 lemmas le_2p_upper_bits_64 = le_2p_upper_bits [where 'a=64, folded word_bits_def]
 lemmas le2p_bits_unset_64 = le2p_bits_unset[where 'a=64, folded word_bits_def]
 
 lemma word_bits_len_of:
   "len_of TYPE (64) = word_bits"
   by (simp add: word_bits_conv)
 
 lemmas unat_power_lower64' = unat_power_lower[where 'a=64]
 lemmas unat_power_lower64 [simp] = unat_power_lower64'[unfolded word_bits_len_of]
 
 lemmas word64_less_sub_le' = word_less_sub_le[where 'a = 64]
 lemmas word64_less_sub_le[simp] = word64_less_sub_le' [folded word_bits_def]
 
 lemma word_bits_size:
   "size (w::word64) = word_bits"
   by (simp add: word_bits_def word_size)
 
 lemmas word64_power_less_1' = word_power_less_1[where 'a = 64]
 lemmas word64_power_less_1[simp] = word64_power_less_1'[folded word_bits_def]
 
 lemma of_nat64_0:
   "\<lbrakk>of_nat n = (0::word64); n < 2 ^ word_bits\<rbrakk> \<Longrightarrow> n = 0"
   by (erule of_nat_0, simp add: word_bits_def)
 
 lemma unat_mask_2_less_4:
   "unat (p && mask 2 :: word64) < 4"
-  apply (rule unat_less_helper)
-  apply (rule order_le_less_trans, rule word_and_le1)
-  apply (simp add: mask_eq)
-  done
+  by (rule unat_less_helper) (simp flip: take_bit_eq_mask add: take_bit_eq_mod word_mod_less_divisor)
 
 lemmas unat_of_nat64' = unat_of_nat_eq[where 'a=64]
 lemmas unat_of_nat64 = unat_of_nat64'[unfolded word_bits_len_of]
 
 lemmas word_power_nonzero_64 = word_power_nonzero [where 'a=64, folded word_bits_def]
 
 lemmas unat_mult_simple = iffD1 [OF unat_mult_lem [where 'a = 64, unfolded word_bits_len_of]]
 
 lemmas div_power_helper_64 = div_power_helper [where 'a=64, folded word_bits_def]
 
 lemma n_less_word_bits:
   "(n < word_bits) = (n < 64)"
   by (simp add: word_bits_def)
 
 lemmas of_nat_less_pow_64 = of_nat_power [where 'a=64, folded word_bits_def]
 
 lemma lt_word_bits_lt_pow:
   "sz < word_bits \<Longrightarrow> sz < 2 ^ word_bits"
   by (simp add: word_bits_conv)
 
 lemma unat_less_word_bits:
   fixes y :: word64
   shows "x < unat y \<Longrightarrow> x < 2 ^ word_bits"
   unfolding word_bits_def
   by (rule order_less_trans [OF _ unat_lt2p])
 
 lemmas unat_mask_word64' = unat_mask[where 'a=64]
 lemmas unat_mask_word64 = unat_mask_word64'[folded word_bits_def]
 
 lemma unat_less_2p_word_bits:
   "unat (x :: 64 word) < 2 ^ word_bits"
   apply (simp only: word_bits_def)
   apply (rule unat_lt2p)
   done
 
 lemma Suc_unat_mask_div:
   "Suc (unat (mask sz div word_size::word64)) = 2 ^ (min sz word_bits - 3)"
-  apply (case_tac "sz < word_bits")
-   apply (case_tac "3 \<le> sz")
-    apply (clarsimp simp: word_size_def word_bits_def min_def mask_eq)
-    apply (drule (2) Suc_div_unat_helper
-           [where 'a=64 and sz=sz and us=3, simplified, symmetric])
-   apply (simp add: not_le word_size_def word_bits_def)
-   apply (case_tac sz, simp add: unat_word_ariths)
-   apply (case_tac nat, simp add: unat_word_ariths
-                                  unat_mask_word64 min_def word_bits_def)
-   apply (case_tac nata, simp add: unat_word_ariths unat_mask_word64 word_bits_def)
-   apply simp
-  apply (simp add: unat_word_ariths
-                   unat_mask_word64 min_def word_bits_def word_size_def)
-  done
+proof (cases \<open>sz \<ge> 3\<close>)
+  case False
+  then have \<open>sz \<in> {0, 1, 2}\<close>
+    by auto
+  then show ?thesis by (auto simp add: unat_div word_size_def unat_mask)
+next
+  case True
+  moreover define n where \<open>n = sz - 3\<close>
+  ultimately have \<open>sz = n + 3\<close>
+    by simp
+  moreover have \<open>2 ^ n * 8 - Suc 0 = (2 ^ n - 1) * 8 + 7\<close>
+    by (simp add: mult_eq_if)
+  ultimately show ?thesis
+    by (simp add: unat_div unat_mask word_size_def word_bits_def min_def power_add)
+qed
 
 lemmas word64_minus_one_le' = word_minus_one_le[where 'a=64]
 lemmas word64_minus_one_le = word64_minus_one_le'[simplified]
 
 lemma ucast_not_helper:
   fixes a::"8 word"
   assumes a: "a \<noteq> 0xFF"
   shows "ucast a \<noteq> (0xFF::word64)"
 proof
   assume "ucast a = (0xFF::word64)"
   also
   have "(0xFF::word64) = ucast (0xFF::8 word)" by simp
   finally
   show False using a
     apply -
     apply (drule up_ucast_inj, simp)
     apply simp
     done
 qed
 
 lemma less_4_cases:
   "(x::word64) < 4 \<Longrightarrow> x=0 \<or> x=1 \<or> x=2 \<or> x=3"
   apply clarsimp
   apply (drule word_less_cases, erule disjE, simp, simp)+
   done
 
 lemma if_then_1_else_0:
   "((if P then 1 else 0) = (0 :: word64)) = (\<not> P)"
   by simp
 
 lemma if_then_0_else_1:
   "((if P then 0 else 1) = (0 :: word64)) = (P)"
   by simp
 
 lemmas if_then_simps = if_then_0_else_1 if_then_1_else_0
 
 lemma ucast_le_ucast_8_64:
   "(ucast x \<le> (ucast y :: word64)) = (x \<le> (y :: 8 word))"
   by (simp add: ucast_le_ucast)
 
 lemma in_16_range:
   "0 \<in> S \<Longrightarrow> r \<in> (\<lambda>x. r + x * (16 :: word64)) ` S"
   "n - 1 \<in> S \<Longrightarrow> (r + (16 * n - 16)) \<in> (\<lambda>x :: word64. r + x * 16) ` S"
   by (clarsimp simp: image_def elim!: bexI[rotated])+
 
 lemma eq_2_64_0:
   "(2 ^ 64 :: word64) = 0"
   by simp
 
 lemma x_less_2_0_1:
   fixes x :: word64 shows
   "x < 2 \<Longrightarrow> x = 0 \<or> x = 1"
   by (rule x_less_2_0_1') auto
 
 lemmas mask_64_max_word  = max_word_mask [symmetric, where 'a=64, simplified]
 
 lemma of_nat64_n_less_equal_power_2:
  "n < 64 \<Longrightarrow> ((of_nat n)::64 word) < 2 ^ n"
   by (rule of_nat_n_less_equal_power_2, clarsimp simp: word_size)
 
 lemma word_rsplit_0:
   "word_rsplit (0 :: word64) = [0, 0, 0, 0, 0, 0, 0, 0 :: 8 word]"
   by (simp add: word_rsplit_def bin_rsplit_def)
 
 lemma unat_ucast_10_64 :
   fixes x :: "10 word"
   shows "unat (ucast x :: word64) = unat x"
   by transfer simp
 
 lemma bool_mask [simp]:
   fixes x :: word64
   shows "(0 < x && 1) = (x && 1 = 1)"
   by (rule bool_mask') auto
 
 lemma word64_bounds:
   "- (2 ^ (size (x :: word64) - 1)) = (-9223372036854775808 :: int)"
   "((2 ^ (size (x :: word64) - 1)) - 1) = (9223372036854775807 :: int)"
   "- (2 ^ (size (y :: 64 signed word) - 1)) = (-9223372036854775808 :: int)"
   "((2 ^ (size (y :: 64 signed word) - 1)) - 1) = (9223372036854775807 :: int)"
   by (simp_all add: word_size)
 
 lemma word_ge_min:"sint (x::64 word) \<ge> -9223372036854775808"
   by (metis sint_ge word64_bounds(1) word_size)
 
 lemmas signed_arith_ineq_checks_to_eq_word64'
     = signed_arith_ineq_checks_to_eq[where 'a=64]
       signed_arith_ineq_checks_to_eq[where 'a="64 signed"]
 
 lemmas signed_arith_ineq_checks_to_eq_word64
     = signed_arith_ineq_checks_to_eq_word64' [unfolded word64_bounds]
 
 lemmas signed_mult_eq_checks64_to_64'
     = signed_mult_eq_checks_double_size[where 'a=64 and 'b=64]
       signed_mult_eq_checks_double_size[where 'a="64 signed" and 'b=64]
 
 lemmas signed_mult_eq_checks64_to_64 = signed_mult_eq_checks64_to_64'[simplified]
 
 lemmas sdiv_word64_max' = sdiv_word_max [where 'a=64] sdiv_word_max [where 'a="64 signed"]
 lemmas sdiv_word64_max = sdiv_word64_max'[simplified word_size, simplified]
 
 lemmas sdiv_word64_min' = sdiv_word_min [where 'a=64] sdiv_word_min [where 'a="64 signed"]
 lemmas sdiv_word64_min = sdiv_word64_min' [simplified word_size, simplified]
 
 lemmas sint64_of_int_eq' = sint_of_int_eq [where 'a=64]
 lemmas sint64_of_int_eq = sint64_of_int_eq' [simplified]
 
 lemma ucast_of_nats [simp]:
   "(ucast (of_nat x :: word64) :: sword64) = (of_nat x)"
   "(ucast (of_nat x :: word64) :: 16 sword) = (of_nat x)"
   "(ucast (of_nat x :: word64) :: 8 sword) = (of_nat x)"
   by (simp_all add: of_nat_take_bit take_bit_word_eq_self)
 
 lemmas signed_shift_guard_simpler_64'
     = power_strict_increasing_iff[where b="2 :: nat" and y=31]
 lemmas signed_shift_guard_simpler_64 = signed_shift_guard_simpler_64'[simplified]
 
 lemma word64_31_less:
   "31 < len_of TYPE (64 signed)" "31 > (0 :: nat)"
   "31 < len_of TYPE (64)" "31 > (0 :: nat)"
   by auto
 
 lemmas signed_shift_guard_to_word_64
     = signed_shift_guard_to_word[OF word64_31_less(1-2)]
     signed_shift_guard_to_word[OF word64_31_less(3-4)]
 
 lemma le_step_down_word_3:
   fixes x :: "64 word"
   shows "\<lbrakk>x \<le>  y; x \<noteq> y; y < 2 ^ 64 - 1\<rbrakk> \<Longrightarrow> x \<le> y - 1"
   by (rule le_step_down_word_2, assumption+)
 
 lemma shiftr_1:
   "(x::word64) >> 1 = 0 \<Longrightarrow> x < 2"
   by transfer (simp add: take_bit_drop_bit drop_bit_Suc)
 
 lemma mask_step_down_64:
   \<open>\<exists>x. mask x = b\<close> if \<open>b && 1 = 1\<close>
     and \<open>\<exists>x. x < 64 \<and> mask x = b >> 1\<close> for b :: \<open>64word\<close>
 proof -
   from \<open>b && 1 = 1\<close> have \<open>odd b\<close>
     by (auto simp add: mod_2_eq_odd and_one_eq)
   then have \<open>b mod 2 = 1\<close>
     using odd_iff_mod_2_eq_one by blast
   from \<open>\<exists>x. x < 64 \<and> mask x = b >> 1\<close> obtain x where \<open>x < 64\<close> \<open>mask x = b >> 1\<close> by blast
   then have \<open>mask x = b div 2\<close>
     using shiftr1_is_div_2 [of b] by simp
   with \<open>b mod 2 = 1\<close> have \<open>2 * mask x + 1 = 2 * (b div 2) + b mod 2\<close>
     by (simp only:)
   also have \<open>\<dots> = b\<close>
     by (simp add: mult_div_mod_eq)
   finally have \<open>2 * mask x + 1 = b\<close> .
   moreover have \<open>mask (Suc x) = 2 * mask x + (1 :: 'a::len word)\<close>
     by (simp add: mask_Suc_rec)
   ultimately show ?thesis
     by auto
 qed
 
 lemma unat_of_int_64:
   "\<lbrakk>i \<ge> 0; i \<le> 2 ^ 63\<rbrakk> \<Longrightarrow> (unat ((of_int i)::sword64)) = nat i"
   unfolding unat_eq_nat_uint
   apply (subst eq_nat_nat_iff)
   apply (simp_all add: take_bit_int_eq_self)
   done
 
 lemmas word_ctz_not_minus_1_64 = word_ctz_not_minus_1[where 'a=64, simplified]
 
 lemma word64_and_max_simp:
   \<open>x AND 0xFFFFFFFFFFFFFFFF = x\<close> for x :: \<open>64 word\<close>
   using word_and_full_mask_simp [of x]
   by (simp add: numeral_eq_Suc mask_Suc_exp)
 
 end
diff --git a/thys/Word_Lib/Word_EqI.thy b/thys/Word_Lib/Word_EqI.thy
--- a/thys/Word_Lib/Word_EqI.thy
+++ b/thys/Word_Lib/Word_EqI.thy
@@ -1,70 +1,69 @@
 (*
  * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
  *
  * SPDX-License-Identifier: BSD-2-Clause
  *)
 
 section "Solving Word Equalities"
 
 theory Word_EqI
   imports
     More_Word
-    Traditional_Infix_Syntax
     "HOL-Eisbach.Eisbach_Tools"
 begin
 
 text \<open>
   Some word equalities can be solved by considering the problem bitwise for all
   @{prop "n < LENGTH('a::len)"}, which is different to running @{text word_bitwise}
   and expanding into an explicit list of bits.
 \<close>
 
 named_theorems word_eqI_simps
 
 lemmas [word_eqI_simps] =
   word_ops_nth_size
   bit_mask_iff
   word_size
   word_or_zero
   neg_mask_test_bit
   nth_ucast
-  nth_w2p nth_shiftl
-  nth_shiftr
+  nth_w2p bit_push_bit_iff
+  bit_drop_bit_eq
   less_2p_is_upper_bits_unset
   le_mask_high_bits
   bang_eq
   neg_test_bit
   is_up
   is_down
 
 lemmas word_eqI_rule = word_eqI [rule_format]
 
 lemma test_bit_lenD:
   "bit x n \<Longrightarrow> n < LENGTH('a) \<and> bit x n" for x :: "'a :: len word"
   by (fastforce dest: test_bit_size simp: word_size)
 
 method word_eqI uses simp simp_del split split_del cong flip =
   ((* reduce conclusion to test_bit: *)
    rule word_eqI_rule,
    (* make sure we're in clarsimp normal form: *)
    (clarsimp simp: simp simp del: simp_del simp flip: flip split: split split del: split_del cong: cong)?,
    (* turn x < 2^n assumptions into mask equations: *)
    ((drule less_mask_eq)+)?,
    (* expand and distribute test_bit everywhere: *)
    (clarsimp simp: word_eqI_simps simp simp del: simp_del simp flip: flip
              split: split split del: split_del cong: cong)?,
    (* add any additional word size constraints to new indices: *)
    ((drule test_bit_lenD)+)?,
    (* try to make progress (can't use +, would loop): *)
    (clarsimp simp: word_eqI_simps simp simp del: simp_del simp flip: flip
              split: split split del: split_del cong: cong)?,
    (* helps sometimes, rarely: *)
    (simp add: simp test_bit_conj_lt del: simp_del flip: flip split: split split del: split_del cong: cong)?)
 
 method word_eqI_solve uses simp simp_del split split_del cong flip =
   solves \<open>word_eqI simp: simp simp_del: simp_del split: split split_del: split_del
                    cong: cong simp flip: flip;
           (fastforce dest: test_bit_size simp: word_eqI_simps simp flip: flip
                      simp: simp simp del: simp_del split: split split del: split_del cong: cong)?\<close>
 
 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,1689 +1,2459 @@
 (*
  * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
  *
  * SPDX-License-Identifier: BSD-2-Clause
  *)
 
 section "Lemmas with Generic Word Length"
 
 theory Word_Lemmas
   imports
     Type_Syntax
     Signed_Division_Word
     Signed_Words
     More_Word
     Most_significant_bit
     Enumeration_Word
     Aligned
+    Bit_Shifts_Infix_Syntax
 begin
 
+lemma uint_shiftr_eq:
+  \<open>uint (w >> n) = uint w div 2 ^ n\<close>
+  by transfer (simp flip: drop_bit_eq_div add: drop_bit_take_bit min_def le_less less_diff_conv)
+
+lemma bit_shiftl_word_iff [bit_simps]:
+  \<open>bit (w << m) n \<longleftrightarrow> m \<le> n \<and> n < LENGTH('a) \<and> bit w (n - m)\<close>
+  for w :: \<open>'a::len word\<close>
+  by (simp add: bit_push_bit_iff not_le)
+
+lemma shiftl_def:
+  \<open>w << n = ((*) 2 ^^ n) w\<close> for w :: \<open>'a::len word\<close>
+proof -
+  have \<open>push_bit n = (((*) 2 ^^ n) :: int \<Rightarrow> int)\<close> for n
+    by (induction n) (simp_all add: fun_eq_iff funpow_swap1, simp add: ac_simps)
+  then show ?thesis
+    by transfer simp
+qed
+
+lemma shiftr_def:
+  \<open>w >> n = ((\<lambda>w. w div 2) ^^ n) w\<close> for w :: \<open>'a::len word\<close>
+proof -
+  have \<open>(\<lambda>w. w div 2) ^^ n = (drop_bit n :: 'a word \<Rightarrow> 'a word)\<close>
+    by (induction n) (simp_all add: drop_bit_half drop_bit_Suc)
+  then show ?thesis
+    by simp
+qed
+
+lemma bit_shiftr_word_iff:
+  \<open>bit (w >> m) n \<longleftrightarrow> bit w (m + n)\<close>
+  for w :: \<open>'a::len word\<close>
+  by (simp add: bit_simps)
+
+lemma sshiftr_eq_funpow_sshiftr1:
+  \<open>w >>> n = (signed_drop_bit (Suc 0) ^^ n) w\<close>
+  apply (rule sym)
+  apply (induction n)
+   apply simp_all
+  done
+
+lemma uint_sshiftr_eq:
+  \<open>uint (w >>> n) = take_bit LENGTH('a) (sint w div 2 ^  n)\<close>
+  for w :: \<open>'a::len word\<close>
+  by transfer (simp flip: drop_bit_eq_div)
+
+lemma sshiftr_0: "0 >>> n = 0"
+  by (fact signed_drop_bit_of_0)
+
+lemma sshiftr_n1: "-1 >>> n = -1"
+  by (fact signed_drop_bit_of_minus_1)
+
+lemma bit_sshiftr_word_iff:
+  \<open>bit (w >>> m) n \<longleftrightarrow> bit w (if LENGTH('a) - m \<le> n \<and> n < LENGTH('a) then LENGTH('a) - 1 else (m + n))\<close>
+  for w :: \<open>'a::len word\<close>
+  by (fact bit_signed_drop_bit_iff)
+
+lemma nth_sshiftr :
+  "bit (w >>> m) n =
+    (n < size w \<and> (if n + m \<ge> size w then bit w (size w - 1) else bit w (n + m)))"
+  apply (auto simp add: bit_simps word_size ac_simps not_less)
+  apply (meson bit_imp_le_length bit_shiftr_word_iff leD)
+  done
+
+lemma sshiftr_numeral [simp]:
+  \<open>(numeral k >>> numeral n :: 'a::len word) =
+    word_of_int (drop_bit (numeral n) (signed_take_bit (LENGTH('a) - 1) (numeral k)))\<close>
+  apply (rule bit_word_eqI)
+   apply (simp add: word_size nth_sshiftr ac_simps bit_simps)
+  done
+
+lemma revcast_down_us [OF refl]:
+  "rc = revcast \<Longrightarrow> source_size rc = target_size rc + n \<Longrightarrow> rc w = ucast (w >>> n)"
+  for w :: "'a::len word"
+  apply (simp add: source_size_def target_size_def)
+  apply (rule bit_word_eqI)
+  apply (simp add: bit_revcast_iff bit_ucast_iff bit_sshiftr_word_iff ac_simps)
+  done
+
+lemma revcast_down_ss [OF refl]:
+  "rc = revcast \<Longrightarrow> source_size rc = target_size rc + n \<Longrightarrow> rc w = scast (w >>> n)"
+  for w :: "'a::len word"
+  apply (simp add: source_size_def target_size_def)
+  apply (rule bit_word_eqI)
+  apply (simp add: bit_revcast_iff bit_word_scast_iff bit_sshiftr_word_iff ac_simps)
+  done
+
+lemma sshiftr_div_2n: "sint (w >>> n) = sint w div 2 ^ n"
+  using sint_signed_drop_bit_eq [of n w]
+  by (simp add: drop_bit_eq_div)
+
+lemma mask_eq:
+  \<open>mask n = (1 << n) - (1 :: 'a::len word)\<close>
+  by transfer (simp add: mask_eq_exp_minus_1 push_bit_of_1)
+
+lemma shiftl_0: "(0::'a::len word) << n = 0"
+  by (fact push_bit_of_0)
+
+lemma shiftr_0: "(0::'a::len word) >> n = 0"
+  by (fact drop_bit_of_0)
+
+lemma nth_shiftl': "bit (w << m) n \<longleftrightarrow> n < size w \<and> n >= m \<and> bit w (n - m)"
+  for w :: "'a::len word"
+  by transfer (auto simp add: bit_push_bit_iff)
+
+lemmas nth_shiftl = nth_shiftl' [unfolded word_size]
+
+lemma nth_shiftr: "bit (w >> m) n = bit w (n + m)"
+  for w :: "'a::len word"
+  by (simp add: bit_simps ac_simps)
+
+lemma shiftr_div_2n: "uint (shiftr w n) = uint w div 2 ^ n"
+  by (fact uint_shiftr_eq)
+
+lemma shiftl_rev: "shiftl w n = word_reverse (shiftr (word_reverse w) n)"
+  by (rule bit_word_eqI) (auto simp add: bit_simps)
+
+lemma rev_shiftl: "word_reverse w << n = word_reverse (w >> n)"
+  by (simp add: shiftl_rev)
+
+lemma shiftr_rev: "w >> n = word_reverse (word_reverse w << n)"
+  by (simp add: rev_shiftl)
+
+lemma rev_shiftr: "word_reverse w >> n = word_reverse (w << n)"
+  by (simp add: shiftr_rev)
+
+lemma shiftl_zero_size: "size x \<le> n \<Longrightarrow> x << n = 0"
+  for x :: "'a::len word"
+  apply transfer
+  apply (simp add: take_bit_push_bit)
+  done
+
+lemma shiftl_t2n: "shiftl w n = 2 ^ n * w"
+  for w :: "'a::len word"
+  by (simp add: push_bit_eq_mult)
+
+lemma slice_shiftr: "slice n w = ucast (w >> n)"
+  apply (rule bit_word_eqI)
+  apply (cases \<open>n \<le> LENGTH('b)\<close>)
+   apply (auto simp add: bit_slice_iff bit_ucast_iff bit_shiftr_word_iff ac_simps
+    dest: bit_imp_le_length)
+  done
+
+lemma revcast_down_uu [OF refl]:
+  "rc = revcast \<Longrightarrow> source_size rc = target_size rc + n \<Longrightarrow> rc w = ucast (w >> n)"
+  for w :: "'a::len word"
+  apply (simp add: source_size_def target_size_def)
+  apply (rule bit_word_eqI)
+  apply (simp add: bit_revcast_iff bit_ucast_iff bit_shiftr_word_iff ac_simps)
+  done
+
+lemma revcast_down_su [OF refl]:
+  "rc = revcast \<Longrightarrow> source_size rc = target_size rc + n \<Longrightarrow> rc w = scast (w >> n)"
+  for w :: "'a::len word"
+  apply (simp add: source_size_def target_size_def)
+  apply (rule bit_word_eqI)
+  apply (simp add: bit_revcast_iff bit_word_scast_iff bit_shiftr_word_iff ac_simps)
+  done
+
+lemma cast_down_rev [OF refl]:
+  "uc = ucast \<Longrightarrow> source_size uc = target_size uc + n \<Longrightarrow> uc w = revcast (w << n)"
+  for w :: "'a::len word"
+  apply (simp add: source_size_def target_size_def)
+  apply (rule bit_word_eqI)
+  apply (simp add: bit_revcast_iff bit_word_ucast_iff bit_shiftl_word_iff)
+  done
+
+lemma revcast_up [OF refl]:
+  "rc = revcast \<Longrightarrow> source_size rc + n = target_size rc \<Longrightarrow>
+    rc w = (ucast w :: 'a::len word) << n"
+  apply (simp add: source_size_def target_size_def)
+  apply (rule bit_word_eqI)
+  apply (simp add: bit_revcast_iff bit_word_ucast_iff bit_shiftl_word_iff)
+  apply auto
+  apply (metis add.commute add_diff_cancel_right)
+  apply (metis diff_add_inverse2 diff_diff_add)
+  done
+
+lemmas rc1 = revcast_up [THEN
+  revcast_rev_ucast [symmetric, THEN trans, THEN word_rev_gal, symmetric]]
+lemmas rc2 = revcast_down_uu [THEN
+  revcast_rev_ucast [symmetric, THEN trans, THEN word_rev_gal, symmetric]]
+
+lemmas ucast_up =
+  rc1 [simplified rev_shiftr [symmetric] revcast_ucast [symmetric]]
+lemmas ucast_down =
+  rc2 [simplified rev_shiftr revcast_ucast [symmetric]]
+
+\<comment> \<open>problem posed by TPHOLs referee:
+      criterion for overflow of addition of signed integers\<close>
+
+lemma sofl_test:
+  \<open>sint x + sint y = sint (x + y) \<longleftrightarrow>
+    (x + y XOR x) AND (x + y XOR y) >> (size x - 1) = 0\<close>
+  for x y :: \<open>'a::len word\<close>
+proof -
+  obtain n where n: \<open>LENGTH('a) = Suc n\<close>
+    by (cases \<open>LENGTH('a)\<close>) simp_all
+  have *: \<open>sint x + sint y + 2 ^ Suc n > signed_take_bit n (sint x + sint y) \<Longrightarrow> sint x + sint y \<ge> - (2 ^ n)\<close>
+    \<open>signed_take_bit n (sint x + sint y) > sint x + sint y - 2 ^ Suc n \<Longrightarrow> 2 ^ n > sint x + sint y\<close>
+    using signed_take_bit_int_greater_eq [of \<open>sint x + sint y\<close> n] signed_take_bit_int_less_eq [of n \<open>sint x + sint y\<close>]
+    by (auto intro: ccontr)
+  have \<open>sint x + sint y = sint (x + y) \<longleftrightarrow>
+    (sint (x + y) < 0 \<longleftrightarrow> sint x < 0) \<or>
+    (sint (x + y) < 0 \<longleftrightarrow> sint y < 0)\<close>
+    using sint_less [of x] sint_greater_eq [of x] sint_less [of y] sint_greater_eq [of y]
+    signed_take_bit_int_eq_self [of \<open>LENGTH('a) - 1\<close> \<open>sint x + sint y\<close>]
+    apply (auto simp add: not_less)
+       apply (unfold sint_word_ariths)
+       apply (subst signed_take_bit_int_eq_self)
+         prefer 4
+         apply (subst signed_take_bit_int_eq_self)
+           prefer 7
+           apply (subst signed_take_bit_int_eq_self)
+             prefer 10
+             apply (subst signed_take_bit_int_eq_self)
+               apply (auto simp add: signed_take_bit_int_eq_self signed_take_bit_eq_take_bit_minus take_bit_Suc_from_most n not_less intro!: *)
+       apply (smt (z3) take_bit_nonnegative)
+      apply (smt (z3) take_bit_int_less_exp)
+     apply (smt (z3) take_bit_nonnegative)
+    apply (smt (z3) take_bit_int_less_exp)
+    done
+  then show ?thesis
+    apply (simp only: One_nat_def word_size drop_bit_eq_zero_iff_not_bit_last bit_and_iff bit_xor_iff)
+    apply (simp add: bit_last_iff)
+    done
+qed
+
+lemma shiftr_zero_size: "size x \<le> n \<Longrightarrow> x >> n = 0"
+  for x :: "'a :: len word"
+  by (rule word_eqI) (auto simp add: nth_shiftr dest: test_bit_size)
+
+lemma shiftr_x_0: "x >> 0 = x"
+  for x :: "'a::len word"
+  by simp
+
+lemma shiftl_x_0: "x << 0 = x"
+  for x :: "'a::len word"
+  by simp
+
+lemma shiftl_1: "(1::'a::len word) << n = 2^n"
+  by (fact push_bit_of_1)
+
+lemma shiftr_1: "(1::'a::len word) >> n = (if n = 0 then 1 else 0)"
+  by simp
+
+lemma shiftl0:
+  "x << 0 = (x :: 'a :: len word)"
+  by (fact shiftl_x_0)
+
+lemma word_ops_nth:
+  fixes x y :: \<open>'a::len word\<close>
+  shows
+  word_or_nth:  "bit (x OR y) n = (bit x n \<or> bit y n)" and
+  word_and_nth: "bit (x AND y) n = (bit x n \<and> bit y n)" and
+  word_xor_nth: "bit (x XOR y) n = (bit x n \<noteq> bit y n)"
+  by (simp_all add: bit_simps)
+
+lemma and_not_mask:
+  "w AND NOT (mask n) = (w >> n) << n"
+  for w :: \<open>'a::len word\<close>
+  by (rule bit_word_eqI) (auto simp add: bit_simps)
+
+lemma and_mask:
+  "w AND mask n = (w << (size w - n)) >> (size w - n)"
+  for w :: \<open>'a::len word\<close>
+  by (rule bit_word_eqI) (auto simp add: bit_simps word_size)
+
+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 (metis uint_shiftr_eq word_of_int_uint)
+  done
+
+lemma le_shiftr:
+  "u \<le> v \<Longrightarrow> u >> (n :: nat) \<le> (v :: 'a :: len word) >> n"
+  apply transfer
+  apply (simp add: take_bit_drop_bit)
+  apply (simp add: drop_bit_eq_div zdiv_mono1)
+  done
+
+lemma shiftr_mask_le:
+  "n <= m \<Longrightarrow> mask n >> m = (0 :: 'a::len word)"
+  by (rule bit_word_eqI) (auto simp add: bit_simps)
+
+lemma shiftr_mask [simp]:
+  \<open>mask m >> m = (0::'a::len word)\<close>
+  by (rule shiftr_mask_le) simp
+
+lemma le_mask_iff:
+  "(w \<le> mask n) = (w >> n = 0)"
+  for w :: \<open>'a::len word\<close>
+  apply safe
+   apply (rule word_le_0_iff [THEN iffD1])
+   apply (rule xtrans(3))
+    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 bit_simps)
+  apply (case_tac "n <= n'")
+  by auto
+
+lemma and_mask_eq_iff_shiftr_0:
+  "(w AND mask n = w) = (w >> n = 0)"
+  for w :: \<open>'a::len word\<close>
+  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 transfer
+  apply (auto simp add: fun_eq_iff bit_simps)
+  apply (metis add_diff_inverse_nat)
+  done
+
+lemma mask_shiftl_decompose:
+  "mask m << n = mask (m + n) AND NOT (mask n :: 'a::len word)"
+  by (rule bit_word_eqI) (auto simp add: bit_simps)
+
+lemma shiftl_over_and_dist:
+  fixes a::"'a::len word"
+  shows "(a AND b) << c = (a << c) AND (b << c)"
+  by (fact push_bit_and)
+
+lemma shiftr_over_and_dist:
+  fixes a::"'a::len word"
+  shows "a AND b >> c = (a >> c) AND (b >> c)"
+  by (fact drop_bit_and)
+
+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)"
+  by (fact push_bit_or)
+
+lemma shiftr_over_or_dist:
+  fixes a::"'a::len word"
+  shows "a OR b >> c = (a >> c) OR (b >> c)"
+  by (fact drop_bit_or)
+
+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 add: bit_simps not_le word_size ac_simps)
+  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 bit_simps)
+  done
+
+lemma shiftr_shiftl1:
+  fixes a::"'a::len word"
+  shows "c \<le> b \<Longrightarrow> a >> b << c = (a >> (b - c)) AND (NOT (mask c))"
+  by (rule bit_word_eqI) (auto simp add: bit_simps)
+
+lemma shiftr_shiftl2:
+  fixes a::"'a::len word"
+  shows "b < c \<Longrightarrow> a >> b << c = (a << (c - b)) AND (NOT (mask c))"
+  apply (rule word_eqI)
+  apply (auto simp add: bit_simps not_le word_size ac_simps)
+  done
+
+lemmas multi_shift_simps =
+  shiftl_shiftl shiftr_shiftr
+  shiftl_shiftr1 shiftl_shiftr2
+  shiftr_shiftl1 shiftr_shiftl2
+
+lemma shiftr_mask2:
+  "n \<le> LENGTH('a) \<Longrightarrow> (mask n >> m :: ('a :: len) word) = mask (n - m)"
+  by (rule bit_word_eqI) (auto simp add: bit_simps)
+
+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 mask_shift:
+  "(x AND NOT (mask y)) >> y = x >> y"
+  for x :: \<open>'a::len word\<close>
+  apply (rule bit_eqI)
+  apply (simp add: bit_and_iff bit_not_iff bit_shiftr_word_iff bit_mask_iff not_le)
+  using bit_imp_le_length apply auto
+  done
+
+lemma shiftr_div_2n':
+  "unat (w >> n) = unat w div 2 ^ n"
+  apply (unfold unat_eq_nat_uint)
+  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_eq_unatI)
+  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 ucast_shiftl_eq_0:
+  fixes w :: "'a :: len word"
+  shows "\<lbrakk> n \<ge> LENGTH('b) \<rbrakk> \<Longrightarrow> ucast (w << n) = (0 :: 'b :: len word)"
+  by transfer (simp add: take_bit_push_bit)
+
+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_shiftr_lt:
+  fixes w :: "'a::len word"
+  shows "unat (w >> n) < (2 ^ (LENGTH('a) - n))"
+  apply (subst shiftr_div_2n')
+  apply transfer
+  apply (simp flip: drop_bit_eq_div add: drop_bit_nat_eq drop_bit_take_bit)
+  done
+
+lemma shiftr_less_t2n':
+  "\<lbrakk> x AND mask (n + m) = x; m < LENGTH('a) \<rbrakk> \<Longrightarrow> x >> n < 2 ^ m" for x :: "'a :: len word"
+  apply (simp add: word_size mask_eq_iff_w2p [symmetric] flip: take_bit_eq_mask)
+  apply transfer
+  apply (simp add: take_bit_drop_bit ac_simps)
+  done
+
+lemma shiftr_less_t2n:
+  "x < 2 ^ (n + m) \<Longrightarrow> x >> n < 2 ^ m" for x :: "'a :: len word"
+  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 shiftl_less_t2n:
+  fixes x :: "'a :: len word"
+  shows "\<lbrakk> x < (2 ^ (m - n)); m < LENGTH('a) \<rbrakk> \<Longrightarrow> (x << n) < 2 ^ m"
+  apply (simp add: word_size mask_eq_iff_w2p [symmetric] flip: take_bit_eq_mask)
+  apply transfer
+  apply (simp add: take_bit_push_bit)
+  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 scast_bit_test [simp]:
+  "scast ((1 :: 'a::len signed word) << n) = (1 :: 'a word) << n"
+  by (rule bit_word_eqI) (simp add: bit_simps)
+
+lemma signed_shift_guard_to_word:
+  \<open>unat x * 2 ^ y < 2 ^ n \<longleftrightarrow> x = 0 \<or> x < 1 << n >> y\<close>
+    if \<open>n < LENGTH('a)\<close> \<open>0 < n\<close>
+    for x :: \<open>'a::len word\<close>
+proof (cases \<open>x = 0\<close>)
+  case True
+  then show ?thesis
+    by simp
+next
+  case False
+  then have \<open>unat x \<noteq> 0\<close>
+    by (simp add: unat_eq_0)
+  then have \<open>unat x \<ge> 1\<close>
+    by simp
+  show ?thesis
+  proof (cases \<open>y < n\<close>)
+    case False
+    then have \<open>n \<le> y\<close>
+      by simp
+    then obtain q where \<open>y = n + q\<close>
+      using le_Suc_ex by blast
+    moreover have \<open>(2 :: nat) ^ n >> n + q \<le> 1\<close>
+      by (simp add: drop_bit_eq_div power_add)
+    ultimately show ?thesis
+      using \<open>x \<noteq> 0\<close> \<open>unat x \<ge> 1\<close> \<open>n < LENGTH('a)\<close>
+      by (simp add: power_add not_less word_le_nat_alt unat_drop_bit_eq push_bit_of_1)
+  next
+    case True
+    with that have \<open>y < LENGTH('a)\<close>
+      by simp
+    show ?thesis
+    proof (cases \<open>2 ^ n = unat x * 2 ^ y\<close>)
+      case True
+      moreover have \<open>unat x * 2 ^ y < 2 ^ LENGTH('a)\<close>
+        using \<open>n < LENGTH('a)\<close> by (simp flip: True)
+      moreover have \<open>(word_of_nat (2 ^ n) :: 'a word) = word_of_nat (unat x * 2 ^ y)\<close>
+        using True by simp
+      then have \<open>2 ^ n = x * 2 ^ y\<close>
+        by simp
+      ultimately show ?thesis
+        using \<open>y < LENGTH('a)\<close>
+        by (auto simp add: push_bit_of_1 drop_bit_eq_div word_less_nat_alt unat_div unat_word_ariths)
+    next
+      case False
+      with \<open>y < n\<close> have *: \<open>unat x \<noteq> 2 ^ n div 2 ^ y\<close>
+        by (auto simp flip: power_sub power_add)
+      have \<open>unat x * 2 ^ y < 2 ^ n \<longleftrightarrow> unat x * 2 ^ y \<le> 2 ^ n\<close>
+        using False by (simp add: less_le)
+      also have \<open>\<dots> \<longleftrightarrow> unat x \<le> 2 ^ n div 2 ^ y\<close>
+        by (simp add: less_eq_div_iff_mult_less_eq)
+      also have \<open>\<dots> \<longleftrightarrow> unat x < 2 ^ n div 2 ^ y\<close>
+        using * by (simp add: less_le)
+      finally show ?thesis
+      using that \<open>x \<noteq> 0\<close> by (simp flip: push_bit_eq_mult drop_bit_eq_div
+        add: push_bit_of_1 unat_drop_bit_eq word_less_iff_unsigned [where ?'a = nat])
+    qed
+  qed
+qed
+
+lemma shiftr_not_mask_0:
+  "n+m \<ge> LENGTH('a :: len) \<Longrightarrow> ((w::'a::len word) >> n) AND NOT (mask m) = 0"
+  by (rule bit_word_eqI) (auto simp add: bit_simps word_size dest: bit_imp_le_length)
+
+lemma shiftl_mask_is_0[simp]:
+  "(x << n) AND mask n = 0"
+  for x :: \<open>'a::len word\<close>
+  by (simp flip: take_bit_eq_mask add: take_bit_push_bit)
+
+lemma rshift_sub_mask_eq:
+  "(a >> (size a - b)) AND mask b = a >> (size a - b)"
+  for a :: \<open>'a::len word\<close>
+  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_eq_decr_exp word_size
+                   p2_eq_0[THEN iffD2])
+  done
+
+lemma shiftl_shiftr3:
+  "b \<le> c \<Longrightarrow> a << b >> c = (a >> c - b) AND mask (size a - c)"
+  for a :: \<open>'a::len word\<close>
+  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 AND mask m) >> n = (w >> n) AND mask (m-n)"
+  for w :: \<open>'a::len word\<close>
+  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 AND mask m) << n = (w << n) AND mask (m+n)"
+  for w :: \<open>'a::len word\<close>
+  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"
+  for x :: \<open>'a::len word\<close>
+  by (simp add: le_mask_iff shiftl_shiftr3)
+
+lemma word_and_1_shiftl:
+  "x AND (1 << n) = (if bit x n then (1 << n) else 0)" for x :: "'a :: len word"
+  apply (rule bit_word_eqI; transfer)
+  apply (auto simp add: bit_simps not_le ac_simps)
+  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 AND (mask n << m) = ((x >> m) AND mask n) << m"
+  for x :: \<open>'a::len word\<close>
+  apply (rule bit_word_eqI; transfer)
+  apply (auto simp add: bit_simps not_le ac_simps)
+  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 of_bool_nth:
+  "of_bool (bit x v) = (x >> v) AND 1"
+  for x :: \<open>'a::len word\<close>
+  by (simp add: bit_iff_odd_drop_bit word_and_1)
+
+lemma shiftr_mask_eq:
+  "(x >> n) AND mask (size x - n) = x >> n" for x :: "'a :: len word"
+  apply (simp flip: take_bit_eq_mask)
+  apply transfer
+  apply (simp add: take_bit_drop_bit)
+  done
+
+lemma shiftr_mask_eq':
+  "m = (size x - n) \<Longrightarrow> (x >> n) AND mask m = x >> n" for x :: "'a :: len word"
+  by (simp add: shiftr_mask_eq)
+
+lemma and_eq_0_is_nth:
+  fixes x :: "'a :: len word"
+  shows "y = 1 << n \<Longrightarrow> ((x AND y) = 0) = (\<not> (bit x n))"
+  by (simp add: and_exp_eq_0_iff_not_bit push_bit_of_1)
+
+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 mask_shift_and_negate[simp]:"(w AND mask n << m) AND NOT (mask n << m) = 0"
+  for w :: \<open>'a::len word\<close>
+  by (clarsimp simp add: mask_eq_decr_exp Parity.bit_eq_iff bit_and_iff bit_not_iff bit_push_bit_iff)
+
+(* 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 AND NOT (mask n << m) OR ((y AND mask n) << m)) AND NOT (mask n << m) = x AND NOT (mask n << m)"
+  for x :: \<open>'a::len word\<close>
+  by (induct n arbitrary: m) (auto simp: word_ao_dist)
+
+lemma bitfield_op_twice'':
+  "\<lbrakk>NOT a = b << c; \<exists>x. b = mask x\<rbrakk> \<Longrightarrow> (x AND a OR (y AND b << c)) AND a = x AND a"
+  for a b :: \<open>'a::len word\<close>
+  apply clarsimp
+  apply (cut_tac n=xa and m=c and x=x and y=y in bitfield_op_twice)
+  apply (clarsimp simp:mask_eq_decr_exp)
+  apply (drule not_switch)
+  apply clarsimp
+  done
+
+lemma shiftr1_unfold: "x div 2 = x >> 1"
+  by (simp add: drop_bit_eq_div)
+
+lemma shiftr1_is_div_2: "(x::('a::len) word) >> 1 = x div 2"
+  by (simp add: drop_bit_eq_div)
+
+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 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 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 shiftr1_irrelevant_lsb: "bit (x::('a::len) word) 0 \<or> x >> 1 = (x + 1) >> 1"
+  apply (cases \<open>LENGTH('a)\<close>; transfer)
+   apply (simp_all add: take_bit_drop_bit)
+  apply (simp add: drop_bit_take_bit drop_bit_Suc)
+  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> (bit (x::('a::len) word) 0) \<Longrightarrow> x >> 1 = (x + 1) >> 1"
+  by (metis shiftr1_irrelevant_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) OR (((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 (simp_all add: mask_eq_decr_exp flip: mult_2_right)
+  apply (metis add_diff_cancel_left' len_gt_0 mult_2_right zero_less_diff)
+  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) OR
+   (((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 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 (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:
   \<open>UCAST('b \<rightarrow> 'a) (UCAST('a \<rightarrow> 'b) x) = x\<close>
     if \<open>x \<le> UCAST('b::len \<rightarrow> 'a) (- 1)\<close>
     for x :: \<open>'a::len word\<close>
 proof -
   from that have a1: \<open>x \<le> word_of_int (uint (word_of_int (2 ^ LENGTH('b) - 1) :: 'b word))\<close>
     by simp
   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 ^ LENGTH('b) + - (1::int) = - 1 + 2 ^ LENGTH('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)
   then have \<open>uint x \<le> uint (2 ^ LENGTH('b) - (1 :: 'a word))\<close>
     by (simp add: word_le_def)
   then have \<open>uint x \<le> 2 ^ LENGTH('b) - 1\<close>
     by (simp add: uint_word_ariths)
       (metis \<open>1 \<le> 2 ^ LENGTH('b)\<close> \<open>uint x \<le> uint (2 ^ LENGTH('b) - 1)\<close> linorder_not_less lt2p_lem uint_1 uint_minus_simple_alt uint_power_lower word_le_def zle_diff1_eq)
   then show ?thesis
     apply (simp add: word_ubin.eq_norm bintrunc_mod2p unsigned_ucast_eq)
     apply (metis \<open>x \<le> 2 ^ LENGTH('b) - 1\<close> and_mask_eq_iff_le_mask mask_eq_decr_exp take_bit_eq_mask)
     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 complement_nth_w2p:
   shows "n' < LENGTH('a) \<Longrightarrow> bit (NOT (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 AND 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) AND 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 less_mult_imp_div_less)
 
 lemma le_or_mask:
   "w \<le> w' \<Longrightarrow> w OR mask x \<le> w' OR mask x"
   for w w' :: \<open>'a::len word\<close>
   by (metis neg_mask_add_mask add.commute le_word_or1 mask_2pm1 neg_mask_mono_le word_plus_mono_left)
 
 lemma le_shiftr':
   "\<lbrakk> u >> n \<le> v >> n ; u >> n \<noteq> v >> n \<rbrakk> \<Longrightarrow> (u::'a::len word) \<le> v"
-  apply (simp add: shiftr_eq_drop_bit)
-  apply (metis le_cases le_shiftr shiftr_word_eq verit_la_disequality)
+  apply (metis le_cases le_shiftr verit_la_disequality)
   done
 
 lemma word_add_no_overflow:"(x::'a::len word) < - 1 \<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)"
   by (metis add.commute bound max_word_max word_Suc_leq word_not_le word_of_nat_less)
 
 lemma unat_ucast_up_simp:
   fixes x :: "'a::len word"
   assumes "LENGTH('a) \<le> LENGTH('b)"
   shows "unat (ucast x :: 'b::len word) = unat x"
   unfolding ucast_eq unat_eq_nat_uint
   apply (subst int_word_uint)
   apply (subst mod_pos_pos_trivial; simp?)
   apply (rule lt2p_lem)
   apply (simp add: assms)
   done
 
 lemma unat_ucast_less_no_overflow:
   "\<lbrakk>n < 2 ^ LENGTH('a); unat f < n\<rbrakk> \<Longrightarrow> (f::('a::len) word) < of_nat n"
   by (erule (1)  order_le_less_trans[OF _ of_nat_mono_maybe,rotated]) simp
 
 lemma unat_ucast_less_no_overflow_simp:
   "n < 2 ^ LENGTH('a) \<Longrightarrow> (unat f < n) = ((f::('a::len) word) < of_nat n)"
   using unat_less_helper unat_ucast_less_no_overflow by blast
 
 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[OF order.strict_implies_order, 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 (f::'a::len word) < ((ucast (ucast b ::'a::len word)) :: 'b :: len word)"
       apply (simp add: ucast_less_ucast[OF order.strict_implies_order] upward_cast)
       apply (simp only: flip: ucast_nat_def)
       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
 
 lemmas ucast_up_mono = ucast_less_ucast[THEN iffD2]
 
 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) AND NOT (mask n) = 0"
-  by (simp add: and_not_mask shiftr_eq_0)
+  by (simp add: and_not_mask)
 
 lemma word_shift_by_2:
   "x * 4 = (x::'a::len word) << 2"
   by (simp add: shiftl_t2n)
 
 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> bit 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> bit (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"
   by (metis and_mask_eq_iff_shiftr_0 less_mask_eq p2_gt_0 semiring_normalization_rules(7)
             shiftl_shiftr_id shiftl_t2n)
 
 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_diff_power_eq)
   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 (meson nat_mult_power_less_eq zero_less_numeral)
     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)
   apply transfer
   apply (auto simp add: is_aligned_iff_udvd)
   apply (metis bintrunc_bintrunc_ge int_ops(1) nat_int_comparison(1) nat_less_le take_bit_eq_0_iff take_bit_nat_eq_self_iff take_bit_of_nat)
   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 lt2 lt3 unat_mono word_less_minus_mono_left by blast
   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:
   "(- 1 :: 'a::len word) = mask LENGTH('a)"
   by (fact minus_1_eq_mask)
 
 lemmas mask_len_max = max_word_mask[symmetric]
 
 lemma mask_out_first_mask_some:
   "\<lbrakk> x AND NOT (mask n) = y; n \<le> m \<rbrakk> \<Longrightarrow> x AND NOT (mask m) = y AND NOT (mask m)"
   for x y :: \<open>'a::len word\<close>
   by (rule bit_word_eqI) (auto simp add: bit_simps word_size)
 
 lemma mask_lower_twice:
   "n \<le> m \<Longrightarrow> (x AND NOT (mask n)) AND NOT (mask m) = x AND NOT (mask m)"
   for x :: \<open>'a::len word\<close>
   by (rule bit_word_eqI) (auto simp add: bit_simps word_size)
 
 lemma mask_lower_twice2:
   "(a AND NOT (mask n)) AND NOT (mask m) = a AND NOT (mask (max n m))"
   for a :: \<open>'a::len word\<close>
   by (rule bit_word_eqI) (auto simp add: bit_simps)
 
 lemma ucast_and_neg_mask:
   "ucast (x AND NOT (mask n)) = ucast x AND NOT (mask n)"
   apply (rule bit_word_eqI)
   apply (auto simp add: bit_simps dest: bit_imp_le_length)
   done
 
 lemma ucast_and_mask:
   "ucast (x AND mask n) = ucast x AND mask n"
   apply (rule bit_word_eqI)
   apply (auto simp add: bit_simps dest: bit_imp_le_length)
   done
 
 lemma ucast_mask_drop:
   "LENGTH('a :: len) \<le> n \<Longrightarrow> (ucast (x AND mask n) :: 'a word) = ucast x"
   apply (rule bit_word_eqI)
   apply (auto simp add: bit_simps dest: bit_imp_le_length)
   done
 
 (* negating a mask which has been shifted to the very left *)
 lemma NOT_mask_shifted_lenword:
   "NOT (mask len << (LENGTH('a) - len) ::'a::len word) = mask (LENGTH('a) - len)"
   by (rule bit_word_eqI)
-    (auto simp add: shiftl_word_eq word_size bit_not_iff bit_push_bit_iff bit_mask_iff)
+    (auto simp add: word_size bit_not_iff bit_push_bit_iff bit_mask_iff)
 
 (* Comparisons between different word sizes. *)
 
 lemma eq_ucast_ucast_eq:
   "LENGTH('b) \<le> LENGTH('a) \<Longrightarrow> x = ucast y \<Longrightarrow> ucast x = y"
   for x :: "'a::len word" and y :: "'b::len word"
   by transfer simp
 
 lemma le_ucast_ucast_le:
   "x \<le> ucast y \<Longrightarrow> ucast x \<le> y"
   for x :: "'a::len word" and y :: "'b::len word"
   by (smt le_unat_uoi linorder_not_less order_less_imp_le ucast_nat_def unat_arith_simps(1))
 
 lemma less_ucast_ucast_less:
   "LENGTH('b) \<le> LENGTH('a) \<Longrightarrow> x < ucast y \<Longrightarrow> ucast x < y"
   for x :: "'a::len word" and y :: "'b::len word"
   by (metis ucast_nat_def unat_mono unat_ucast_up_simp word_of_nat_less)
 
 lemma ucast_le_ucast:
   "LENGTH('a) \<le> LENGTH('b) \<Longrightarrow> (ucast x \<le> (ucast y::'b::len word)) = (x \<le> y)"
   for x :: "'a::len word"
   by (simp add: unat_arith_simps(1) unat_ucast_up_simp)
 
 lemmas ucast_up_mono_le = ucast_le_ucast[THEN iffD2]
 
 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
 
 lemma ucast_or_distrib:
   fixes x :: "'a::len word"
   fixes y :: "'a::len word"
   shows "(ucast (x OR y) :: ('b::len) word) = ucast x OR ucast y"
   by transfer simp
 
 lemma shiftr_less:
   "(w::'a::len word) < k \<Longrightarrow> w >> n < k"
   by (metis div_le_dividend le_less_trans shiftr_div_2n' unat_arith_simps(2))
 
 lemma word_and_notzeroD:
   "w AND w' \<noteq> 0 \<Longrightarrow> w \<noteq> 0 \<and> w' \<noteq> 0"
   by auto
 
 lemma word_exists_nth:
   "(w::'a::len word) \<noteq> 0 \<Longrightarrow> \<exists>i. bit w i"
   by (simp add: bit_eq_iff)
 
 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]:
   "- 1 \<noteq> (0 :: 'a::len word)"
   by simp
 
 lemma ucast_zero_is_aligned:
   \<open>is_aligned w n\<close> if \<open>UCAST('a::len \<rightarrow> 'b::len) w = 0\<close> \<open>n \<le> LENGTH('b)\<close>
 proof (rule is_aligned_bitI)
   fix q
   assume \<open>q < n\<close>
   moreover have \<open>bit (UCAST('a::len \<rightarrow> 'b::len) w) q = bit 0 q\<close>
     using that by simp
   with \<open>q < n\<close> \<open>n \<le> LENGTH('b)\<close> show \<open>\<not> bit w q\<close>
     by (simp add: bit_simps)
 qed
 
 lemma unat_ucast_eq_unat_and_mask:
   "unat (UCAST('b::len \<rightarrow> 'a::len) w) = unat (w AND mask LENGTH('a))"
   apply (simp flip: take_bit_eq_mask)
   apply transfer
   apply (simp add: ac_simps)
   done
 
 lemma unat_max_word_pos[simp]: "0 < unat (- 1 :: 'a::len word)"
   using unat_gt_0 [of \<open>- 1 :: 'a::len word\<close>] by simp
 
 
 (* 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 (rule bit_word_eqI)
   fix q
   assume \<open>q < LENGTH('a)\<close>
   from eq have \<open>push_bit n x = push_bit n y\<close>
     by (simp add: push_bit_eq_mult)
   moreover from le have \<open>take_bit m x = x\<close> \<open>take_bit m y = y\<close>
     by (simp_all add: less_eq_mask_iff_take_bit_eq_self)
   ultimately have \<open>push_bit n (take_bit m x) = push_bit n (take_bit m y)\<close>
     by simp_all
   with \<open>q < LENGTH('a)\<close> ws show \<open>bit x q \<longleftrightarrow> bit y q\<close>
     apply (simp add: push_bit_take_bit)
     unfolding bit_eq_iff
     apply (simp add: bit_simps not_le)
     apply (metis (full_types) \<open>take_bit m x = x\<close> \<open>take_bit m y = y\<close> add.commute add_diff_cancel_right' add_less_cancel_right bit_take_bit_iff le_add2 less_le_trans)
     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])
 
 (* 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)
   apply (meson less_irrefl not_le zero_le_numeral zero_le_power)
   done
 
 lemmas uints_monoI = uints_mono_iff[THEN iffD2]
 
 lemma Bit_in_uints_Suc: "of_bool c + 2 * w \<in> uints (Suc m)" if "w \<in> uints m"
   using that
   by (auto simp: uints_num)
 
 lemma Bit_in_uintsI: "of_bool c + 2 * w \<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:
   \<open>concat_bit n b a \<in> uints m\<close> if \<open>a \<in> uints l\<close> \<open>m \<ge> l + n\<close>
 proof -
   from \<open>m \<ge> l + n\<close> obtain q where \<open>m = l + n + q\<close>
     using le_Suc_ex by blast
   then have \<open>(2::int) ^ m = 2 ^ n * 2 ^ (l + q)\<close>
     by (simp add: ac_simps power_add)
   moreover have \<open>a mod 2 ^ (l + q) = a\<close>
     using \<open>a \<in> uints l\<close>
     by (auto simp add: uints_def take_bit_eq_mod power_add Divides.mod_mult2_eq)
   ultimately have \<open>concat_bit n b a = take_bit m (concat_bit n b a)\<close>
     by (simp add: concat_bit_eq take_bit_eq_mod push_bit_eq_mult Divides.mod_mult2_eq)
   then show ?thesis
     by (simp add: uints_def)
 qed
 
 lemma bin_cat_cong: "concat_bit n b a = concat_bit m d c"
   if "n = m" "a = c" "take_bit m b = take_bit m d"
   using that(3) unfolding that(1,2) by (simp add: bin_cat_eq_push_bit_add_take_bit)
 
 lemma bin_cat_eqD1: "concat_bit n b a = concat_bit n d c \<Longrightarrow> a = c"
   by (metis drop_bit_bin_cat_eq)
 
 lemma bin_cat_eqD2: "concat_bit n b a = concat_bit n d c \<Longrightarrow> take_bit n b = take_bit n d"
   by (metis take_bit_bin_cat_eq)
 
 lemma bin_cat_inj: "(concat_bit n b a) = concat_bit n d c \<longleftrightarrow> a = c \<and> take_bit n b = take_bit 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 (concat_bit LENGTH('b) (uint b) (uint a))::'c::len word) =
   word_of_int (concat_bit LENGTH('b) (uint d) (uint c)) \<longleftrightarrow> b = d \<and> a = c"
   if "LENGTH('a) + LENGTH('b) \<le> LENGTH('c)"
   for a::"'a::len word" and b::"'b::len 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::len word) = word_cat c d \<longleftrightarrow> a = c \<and> b = d"
   if "LENGTH('a) + LENGTH('b) \<le> LENGTH('c)"
   for a::"'a::len word" and b::"'b::len word"
   using word_of_int_bin_cat_eq_iff [OF that, of b a d c]
   by transfer auto
 
 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>
          (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>
                     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"
   proof -
     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)"
       using a neg_mask_mono_le by blast
     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))"
       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"
       using f3 dual_order.trans by auto
     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))"
       using f2 f4 f6 by (metis eq_iff)
     thus "base = NOT (mask (LENGTH('a) - len)) AND a"
       by (metis word_bw_comms(1))
   qed
 qed
 
 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_aligned_add_no_wrap_bounded:
   "\<lbrakk> w + 2^n \<le> x; w + 2^n \<noteq> 0; is_aligned w n \<rbrakk> \<Longrightarrow> (w::'a::len word) < x"
   by (blast dest: is_aligned_no_overflow le_less_trans word_leq_le_minus_one)
 
 lemma mask_Suc:
   "mask (Suc n) = (2 :: 'a::len word) ^ n + mask n"
   by (simp add: mask_eq_decr_exp)
 
 lemma mask_mono:
   "sz' \<le> sz \<Longrightarrow> mask sz' \<le> (mask sz :: 'a::len word)"
   by (simp add: le_mask_iff shiftr_mask_le)
 
 lemma aligned_mask_disjoint:
   "\<lbrakk> is_aligned (a :: 'a :: len word) n; b \<le> mask n \<rbrakk> \<Longrightarrow> a AND b = 0"
   by (metis and_zero_eq is_aligned_mask le_mask_imp_and_mask word_bw_lcs(1))
 
 lemma word_and_or_mask_aligned:
   "\<lbrakk> is_aligned a n; b \<le> mask n \<rbrakk> \<Longrightarrow> a + b = a OR b"
   by (simp add: aligned_mask_disjoint word_plus_and_or_coroll)
 
 lemma word_and_or_mask_aligned2:
   \<open>is_aligned b n \<Longrightarrow> a \<le> mask n \<Longrightarrow> a + b = a OR b\<close>
   using word_and_or_mask_aligned [of b n a] by (simp add: ac_simps)
 
 lemma is_aligned_ucastI:
   "is_aligned w n \<Longrightarrow> is_aligned (ucast w) n"
   apply transfer
   apply (auto simp add: min_def)
   apply (metis bintrunc_bintrunc_ge bintrunc_n_0 nat_less_le not_le take_bit_eq_0_iff)
   done
 
 lemma ucast_le_maskI:
   "a \<le> mask n \<Longrightarrow> UCAST('a::len \<rightarrow> 'b::len) a \<le> mask n"
   by (metis and_mask_eq_iff_le_mask ucast_and_mask)
 
 lemma ucast_add_mask_aligned:
   "\<lbrakk> a \<le> mask n; is_aligned b n \<rbrakk> \<Longrightarrow> UCAST ('a::len \<rightarrow> 'b::len) (a + b) = ucast a + ucast b"
   by (metis add.commute is_aligned_ucastI ucast_le_maskI ucast_or_distrib word_and_or_mask_aligned)
 
 lemma ucast_shiftl:
   "LENGTH('b) \<le> LENGTH ('a) \<Longrightarrow> UCAST ('a::len \<rightarrow> 'b::len) x << n = ucast (x << n)"
   by word_eqI_solve
 
 lemma ucast_leq_mask:
   "LENGTH('a) \<le> n \<Longrightarrow> ucast (x::'a::len word) \<le> mask n"
   apply (simp add: less_eq_mask_iff_take_bit_eq_self)
   apply transfer
   apply (simp add: ac_simps)
   done
 
 lemma shiftl_inj:
   "\<lbrakk> x << n = y << n; x \<le> mask (LENGTH('a)-n); y \<le> mask (LENGTH('a)-n) \<rbrakk> \<Longrightarrow>
    x = (y :: 'a :: len word)"
   apply word_eqI
   apply (rename_tac n')
   apply (case_tac "LENGTH('a) - n \<le> n'", simp)
   by (metis add.commute add.right_neutral diff_add_inverse le_diff_conv linorder_not_less zero_order(1))
 
 lemma distinct_word_add_ucast_shift_inj:
   \<open>p' = p \<and> off' = off\<close>
   if *: \<open>p + (UCAST('a::len \<rightarrow> 'b::len) off << n) = p' + (ucast off' << n)\<close>
     and \<open>is_aligned p n'\<close> \<open>is_aligned p' n'\<close> \<open>n' = n + LENGTH('a)\<close> \<open>n' < LENGTH('b)\<close>
 proof -
   from \<open>n' = n + LENGTH('a)\<close>
   have [simp]: \<open>n' - n = LENGTH('a)\<close> \<open>n + LENGTH('a) = n'\<close>
     by simp_all
   from \<open>is_aligned p n'\<close> obtain q
     where p: \<open>p = push_bit n' (word_of_nat q)\<close> \<open>q < 2 ^ (LENGTH('b) - n')\<close>
     by (rule is_alignedE')
   from \<open>is_aligned p' n'\<close> obtain q'
     where p': \<open>p' = push_bit n' (word_of_nat q')\<close> \<open>q' < 2 ^ (LENGTH('b) - n')\<close>
     by (rule is_alignedE')
   define m :: nat where \<open>m = unat off\<close>
   then have off: \<open>off = word_of_nat m\<close>
     by simp
   define m' :: nat where \<open>m' = unat off'\<close>
   then have off': \<open>off' = word_of_nat m'\<close>
     by simp
   have \<open>push_bit n' q + take_bit n' (push_bit n m) < 2 ^ LENGTH('b)\<close>
     by (metis id_apply is_aligned_no_wrap''' of_nat_eq_id of_nat_push_bit p(1) p(2) take_bit_nat_eq_self_iff take_bit_nat_less_exp take_bit_push_bit that(2) that(5) unsigned_of_nat)
   moreover have \<open>push_bit n' q' + take_bit n' (push_bit n m') < 2 ^ LENGTH('b)\<close>
     by (metis \<open>n' - n = LENGTH('a)\<close> id_apply is_aligned_no_wrap''' m'_def of_nat_eq_id of_nat_push_bit off' p'(1) p'(2) take_bit_nat_eq_self_iff take_bit_push_bit that(3) that(5) unsigned_of_nat)
   ultimately have \<open>push_bit n' q + take_bit n' (push_bit n m) = push_bit n' q' + take_bit n' (push_bit n m')\<close>
-    using * by (simp add: p p' off off' shiftl_eq_push_bit push_bit_of_nat push_bit_take_bit word_of_nat_inj flip: of_nat_add)
+    using * by (simp add: p p' off off' push_bit_of_nat push_bit_take_bit word_of_nat_inj flip: of_nat_add)
   then have \<open>int (push_bit n' q + take_bit n' (push_bit n m))
     = int (push_bit n' q' + take_bit n' (push_bit n m'))\<close>
     by simp
   then have \<open>concat_bit n' (int (push_bit n m)) (int q)
     = concat_bit n' (int (push_bit n m')) (int q')\<close>
     by (simp add: of_nat_push_bit of_nat_take_bit bin_cat_eq_push_bit_add_take_bit)
   then show ?thesis
     by (simp add: bin_cat_inj p p' off off' take_bit_of_nat take_bit_push_bit word_of_nat_eq_iff)
       (simp add: push_bit_eq_mult)
 qed
 
 lemma word_upto_Nil:
   "y < x \<Longrightarrow> [x .e. y ::'a::len word] = []"
   by (simp add: upto_enum_red not_le word_less_nat_alt)
 
 lemma word_enum_decomp_elem:
   assumes "[x .e. (y ::'a::len word)] = as @ a # bs"
   shows "x \<le> a \<and> a \<le> y"
 proof -
   have "set as \<subseteq> set [x .e. y] \<and> a \<in> set [x .e. y]"
     using assms by (auto dest: arg_cong[where f=set])
   then show ?thesis by auto
 qed
 
 lemma word_enum_prefix:
   "[x .e. (y ::'a::len word)] = as @ a # bs \<Longrightarrow> as = (if x < a then [x .e. a - 1] else [])"
   apply (induct as arbitrary: x; clarsimp)
    apply (case_tac "x < y")
     prefer 2
     apply (case_tac "x = y", simp)
     apply (simp add: not_less)
     apply (drule (1) dual_order.not_eq_order_implies_strict)
     apply (simp add: word_upto_Nil)
    apply (simp add: word_upto_Cons_eq)
   apply (case_tac "x < y")
    prefer 2
    apply (case_tac "x = y", simp)
    apply (simp add: not_less)
    apply (drule (1) dual_order.not_eq_order_implies_strict)
    apply (simp add: word_upto_Nil)
   apply (clarsimp simp: word_upto_Cons_eq)
   apply (frule word_enum_decomp_elem)
   apply clarsimp
   apply (rule conjI)
    prefer 2
    apply (subst word_Suc_le[symmetric]; clarsimp)
   apply (drule meta_spec)
   apply (drule (1) meta_mp)
   apply clarsimp
   apply (rule conjI; clarsimp)
   apply (subst (2) word_upto_Cons_eq)
    apply unat_arith
   apply simp
   done
 
 lemma word_enum_decomp_set:
   "[x .e. (y ::'a::len word)] = as @ a # bs \<Longrightarrow> a \<notin> set as"
   by (metis distinct_append distinct_enum_upto' not_distinct_conv_prefix)
 
 lemma word_enum_decomp:
   assumes "[x .e. (y ::'a::len word)] = as @ a # bs"
   shows "x \<le> a \<and> a \<le> y \<and> a \<notin> set as \<and> (\<forall>z \<in> set as. x \<le> z \<and> z \<le> y)"
 proof -
   from assms
   have "set as \<subseteq> set [x .e. y] \<and> a \<in> set [x .e. y]"
     by (auto dest: arg_cong[where f=set])
   with word_enum_decomp_set[OF assms]
   show ?thesis by auto
 qed
 
 lemma of_nat_unat_le_mask_ucast:
   "\<lbrakk>of_nat (unat t) = w; t \<le> mask LENGTH('a)\<rbrakk> \<Longrightarrow> t = UCAST('a::len \<rightarrow> 'b::len) w"
   by (clarsimp simp: ucast_nat_def ucast_ucast_mask simp flip: and_mask_eq_iff_le_mask)
 
 lemma less_diff_gt0:
   "a < b \<Longrightarrow> (0 :: 'a :: len word) < b - a"
   by unat_arith
 
 lemma unat_plus_gt:
   "unat ((a :: 'a :: len word) + b) \<le> unat a + unat b"
   by (clarsimp simp: unat_plus_if_size)
 
 lemma const_less:
   "\<lbrakk> (a :: 'a :: len word) - 1 < b; a \<noteq> b \<rbrakk> \<Longrightarrow> a < b"
   by (metis less_1_simp word_le_less_eq)
 
 lemma add_mult_aligned_neg_mask:
   \<open>(x + y * m) AND NOT(mask n) = (x AND NOT(mask n)) + y * m\<close>
   if \<open>m AND (2 ^ n - 1) = 0\<close>
   for x y m :: \<open>'a::len word\<close>
   by (metis (no_types, hide_lams)
     add.assoc add.commute add.right_neutral add_uminus_conv_diff
    mask_eq_decr_exp mask_eqs(2) mask_eqs(6) mult.commute mult_zero_left
    subtract_mask(1) that)
 
 lemma unat_of_nat_minus_1:
   "\<lbrakk> n < 2 ^ LENGTH('a); n \<noteq> 0 \<rbrakk> \<Longrightarrow> unat ((of_nat n:: 'a :: len word) - 1) = n - 1"
   by (simp add: of_nat_diff unat_eq_of_nat)
 
 lemma word_eq_zeroI:
   "a \<le> a - 1 \<Longrightarrow> a = 0" for a :: "'a :: len word"
   by (simp add: word_must_wrap)
 
 lemma word_add_format:
   "(-1 :: 'a :: len  word) + b + c = b + (c - 1)"
   by simp
 
 lemma upto_enum_word_nth:
   "\<lbrakk> i \<le> j; k \<le> unat (j - i) \<rbrakk> \<Longrightarrow> [i .e. j] ! k = i + of_nat k"
   apply (clarsimp simp: upto_enum_def nth_append)
   apply (clarsimp simp: word_le_nat_alt[symmetric])
   apply (rule conjI, clarsimp)
    apply (subst toEnum_of_nat, unat_arith)
    apply unat_arith
   apply (clarsimp simp: not_less unat_sub[symmetric])
   apply unat_arith
   done
 
 lemma upto_enum_step_nth:
   "\<lbrakk> a \<le> c; n \<le> unat ((c - a) div (b - a)) \<rbrakk>
    \<Longrightarrow> [a, b .e. c] ! n = a + of_nat n * (b - a)"
   by (clarsimp simp: upto_enum_step_def not_less[symmetric] upto_enum_word_nth)
 
 lemma upto_enum_inc_1_len:
   "a < - 1 \<Longrightarrow> [(0 :: 'a :: len word) .e. 1 + a] = [0 .e. a] @ [1 + a]"
   apply (simp add: upto_enum_word)
   apply (subgoal_tac "unat (1+a) = 1 + unat a")
    apply simp
   apply (subst unat_plus_simple[THEN iffD1])
    apply (metis add.commute no_plus_overflow_neg olen_add_eqv)
   apply unat_arith
   done
 
 lemma neg_mask_add:
   "y AND mask n = 0 \<Longrightarrow> x + y AND NOT(mask n) = (x AND NOT(mask n)) + y"
   for x y :: \<open>'a::len word\<close>
   by (clarsimp simp: mask_out_sub_mask mask_eqs(7)[symmetric] mask_twice)
 
 lemma shiftr_shiftl_shiftr[simp]:
   "(x :: 'a :: len word)  >> a << a >> a = x >> a"
   by word_eqI_solve
 
 lemma add_right_shift:
   "\<lbrakk> x AND mask n = 0; y AND mask n = 0; x \<le> x + y \<rbrakk>
    \<Longrightarrow> (x + y :: ('a :: len) word) >> n = (x >> n) + (y >> n)"
   apply (simp add: no_olen_add_nat is_aligned_mask[symmetric])
   apply (simp add: unat_arith_simps shiftr_div_2n' split del: if_split)
   apply (subst if_P)
    apply (erule order_le_less_trans[rotated])
    apply (simp add: add_mono)
   apply (simp add: shiftr_div_2n' is_aligned_iff_dvd_nat)
   done
 
 lemma sub_right_shift:
   "\<lbrakk> x AND mask n = 0; y AND mask n = 0; y \<le> x \<rbrakk>
    \<Longrightarrow> (x - y) >> n = (x >> n :: 'a :: len word) - (y >> n)"
   using add_right_shift[where x="x - y" and y=y and n=n]
   by (simp add: aligned_sub_aligned is_aligned_mask[symmetric] word_sub_le)
 
 lemma and_and_mask_simple:
   "y AND mask n = mask n \<Longrightarrow> (x AND y) AND mask n = x AND mask n"
   by (simp add: ac_simps)
 
 lemma and_and_mask_simple_not:
   "y AND mask n = 0 \<Longrightarrow> (x AND y) AND mask n = 0"
   by (simp add: ac_simps)
 
 lemma word_and_le':
   "b \<le> c \<Longrightarrow> (a :: 'a :: len word) AND b \<le> c"
   by (metis word_and_le1 order_trans)
 
 lemma word_and_less':
   "b < c \<Longrightarrow> (a :: 'a :: len word) AND b < c"
   by transfer simp
 
 lemma shiftr_w2p:
   "x < LENGTH('a) \<Longrightarrow> 2 ^ x = (2 ^ (LENGTH('a) - 1) >> (LENGTH('a) - 1 - x) :: 'a :: len word)"
   by word_eqI_solve
 
 lemma t2p_shiftr:
   "\<lbrakk> b \<le> a; a < LENGTH('a) \<rbrakk> \<Longrightarrow> (2 :: 'a :: len word) ^ a >> b = 2 ^ (a - b)"
   by word_eqI_solve
 
 lemma scast_1[simp]:
   "scast (1 :: 'a :: len signed word) = (1 :: 'a word)"
   by simp
 
 lemma unsigned_uminus1 [simp]:
   \<open>(unsigned (-1::'b::len word)::'c::len word) = mask LENGTH('b)\<close>
   by (rule bit_word_eqI) (auto simp add: bit_simps)
 
 lemma ucast_ucast_mask_eq:
   "\<lbrakk> UCAST('a::len \<rightarrow> 'b::len) x = y; x AND mask LENGTH('b) = x \<rbrakk> \<Longrightarrow> x = ucast y"
   by (drule sym) (simp flip: take_bit_eq_mask add: unsigned_ucast_eq)
 
 lemma ucast_up_eq:
   "\<lbrakk> ucast x = (ucast y::'b::len word); LENGTH('a) \<le> LENGTH ('b) \<rbrakk>
    \<Longrightarrow> ucast x = (ucast y::'a::len word)"
   by word_eqI_solve
 
 lemma ucast_up_neq:
   "\<lbrakk> ucast x \<noteq> (ucast y::'b::len word); LENGTH('b) \<le> LENGTH ('a) \<rbrakk>
    \<Longrightarrow> ucast x \<noteq> (ucast y::'a::len word)"
   by (fastforce dest: ucast_up_eq)
 
 lemma mask_AND_less_0:
   "\<lbrakk> x AND mask n = 0; m \<le> n \<rbrakk> \<Longrightarrow> x AND mask m = 0"
   for x :: \<open>'a::len word\<close>
   by (metis mask_twice2 word_and_notzeroD)
 
 lemma mask_len_id [simp]:
   "(x :: 'a :: len word) AND mask LENGTH('a) = x"
   using uint_lt2p [of x] by (simp add: mask_eq_iff)
 
 lemma scast_ucast_down_same:
   "LENGTH('b) \<le> LENGTH('a) \<Longrightarrow> SCAST('a \<rightarrow> 'b) = UCAST('a::len \<rightarrow> 'b::len)"
   by (simp add: down_cast_same is_down)
 
 lemma word_aligned_0_sum:
   "\<lbrakk> a + b = 0; is_aligned (a :: 'a :: len word) n; b \<le> mask n; n < LENGTH('a) \<rbrakk>
    \<Longrightarrow> a = 0 \<and> b = 0"
   by (simp add: word_plus_and_or_coroll aligned_mask_disjoint word_or_zero)
 
 lemma mask_eq1_nochoice:
   "\<lbrakk> LENGTH('a) > 1; (x :: 'a :: len word) AND 1 = x \<rbrakk> \<Longrightarrow> x = 0 \<or> x = 1"
   by (metis word_and_1)
 
 lemma shiftr_and_eq_shiftl:
   "(w >> n) AND x = y \<Longrightarrow> w AND (x << n) = (y << n)" for y :: "'a:: len word"
   by (metis (no_types, lifting) and_not_mask bit.conj_ac(1) bit.conj_ac(2) mask_eq_0_eq_x shiftl_mask_is_0 shiftl_over_and_dist)
 
 lemma add_mask_lower_bits':
   "\<lbrakk> len = LENGTH('a); is_aligned (x :: 'a :: len word) n;
      \<forall>n' \<ge> n. n' < len \<longrightarrow> \<not> bit p n' \<rbrakk>
    \<Longrightarrow> x + p AND NOT(mask n) = x"
   using add_mask_lower_bits by auto
 
 lemma leq_mask_shift:
   "(x :: 'a :: len word) \<le> mask (low_bits + high_bits) \<Longrightarrow> (x >> low_bits) \<le> mask high_bits"
-  by (simp add: le_mask_iff shiftr_shiftr)
+  by (simp add: le_mask_iff shiftr_shiftr ac_simps)
 
 lemma ucast_ucast_eq_mask_shift:
   "(x :: 'a :: len word) \<le> mask (low_bits + LENGTH('b))
    \<Longrightarrow> ucast((ucast (x >> low_bits)) :: 'b :: len word) = x >> low_bits"
   by (meson and_mask_eq_iff_le_mask eq_ucast_ucast_eq not_le_imp_less shiftr_less_t2n'
             ucast_ucast_len)
 
 lemma const_le_unat:
   "\<lbrakk> b < 2 ^ LENGTH('a); of_nat b \<le> a \<rbrakk> \<Longrightarrow> b \<le> unat (a :: 'a :: len word)"
   apply (simp add: word_le_def)
   apply (simp only: uint_nat zle_int)
   apply transfer
   apply (simp add: take_bit_nat_eq_self)
   done
 
 lemma upt_enum_offset_trivial:
   "\<lbrakk> x < 2 ^ LENGTH('a) - 1 ; n \<le> unat x \<rbrakk>
    \<Longrightarrow> ([(0 :: 'a :: len word) .e. x] ! n) = of_nat n"
   apply (induct x arbitrary: n)
     apply simp
   by (simp add: upto_enum_word_nth)
 
 lemma word_le_mask_out_plus_2sz:
   "x \<le> (x AND NOT(mask sz)) + 2 ^ sz - 1"
   for x :: \<open>'a::len word\<close>
   by (metis add_diff_eq word_neg_and_le)
 
 lemma ucast_add:
   "ucast (a + (b :: 'a :: len word)) = ucast a + (ucast b :: ('a signed word))"
   by transfer (simp add: take_bit_add)
 
 lemma ucast_minus:
   "ucast (a - (b :: 'a :: len word)) = ucast a - (ucast b :: ('a signed word))"
   apply (insert ucast_add[where a=a and b="-b"])
   apply (metis (no_types, hide_lams) add_diff_eq diff_add_cancel ucast_add)
   done
 
 lemma scast_ucast_add_one [simp]:
   "scast (ucast (x :: 'a::len word) + (1 :: 'a signed word)) = x + 1"
   apply (subst ucast_1[symmetric])
   apply (subst ucast_add[symmetric])
   apply clarsimp
   done
 
 lemma word_and_le_plus_one:
   "a > 0 \<Longrightarrow> (x :: 'a :: len word) AND (a - 1) < a"
   by (simp add: gt0_iff_gem1 word_and_less')
 
 lemma unat_of_ucast_then_shift_eq_unat_of_shift[simp]:
   "LENGTH('b) \<ge> LENGTH('a)
    \<Longrightarrow> unat ((ucast (x :: 'a :: len word) :: 'b :: len word) >> n) = unat (x >> n)"
   by (simp add: shiftr_div_2n' unat_ucast_up_simp)
 
 lemma unat_of_ucast_then_mask_eq_unat_of_mask[simp]:
   "LENGTH('b) \<ge> LENGTH('a)
    \<Longrightarrow> unat ((ucast (x :: 'a :: len word) :: 'b :: len word) AND mask m) = unat (x AND mask m)"
   by (metis ucast_and_mask unat_ucast_up_simp)
 
 lemma shiftr_less_t2n3:
   "\<lbrakk> (2 :: 'a word) ^ (n + m) = 0; m < LENGTH('a) \<rbrakk>
    \<Longrightarrow> (x :: 'a :: len word) >> n < 2 ^ m"
   by (fastforce intro: shiftr_less_t2n' simp: mask_eq_decr_exp power_overflow)
 
 lemma unat_shiftr_le_bound:
   "\<lbrakk> 2 ^ (LENGTH('a :: len) - n) - 1 \<le> bnd; 0 < n \<rbrakk>
    \<Longrightarrow> unat ((x :: 'a word) >> n) \<le> bnd"
   apply transfer
   apply (simp add: take_bit_drop_bit)
   apply (simp add: drop_bit_take_bit)
   apply (rule order_trans)
    defer
    apply assumption
   apply (simp add: nat_le_iff of_nat_diff)
   done
 
 lemma shiftr_eqD:
   "\<lbrakk> x >> n = y >> n; is_aligned x n; is_aligned y n \<rbrakk>
    \<Longrightarrow> x = y"
   by (metis is_aligned_shiftr_shiftl)
 
 lemma word_shiftr_shiftl_shiftr_eq_shiftr:
   "a \<ge> b \<Longrightarrow> (x :: 'a :: len word) >> a << b >> b = x >> a"
-  by (simp add: mask_shift multi_shift_simps(5) shiftr_shiftr)
+  apply (rule bit_word_eqI)
+  apply (auto simp add: bit_simps dest: bit_imp_le_length)
+  done
 
 lemma of_int_uint_ucast:
    "of_int (uint (x :: 'a::len word)) = (ucast x :: 'b::len word)"
   by (fact Word.of_int_uint)
 
 lemma mod_mask_drop:
   "\<lbrakk> m = 2 ^ n; 0 < m; mask n AND msk = mask n \<rbrakk>
    \<Longrightarrow> (x mod m) AND msk = x mod m"
   for x :: \<open>'a::len word\<close>
   by (simp add: word_mod_2p_is_mask word_bw_assocs)
 
 lemma mask_eq_ucast_eq:
   "\<lbrakk> x AND mask LENGTH('a) = (x :: ('c :: len word));
      LENGTH('a) \<le> LENGTH('b)\<rbrakk>
     \<Longrightarrow> ucast (ucast x :: ('a :: len word)) = (ucast x :: ('b :: len word))"
   by (metis ucast_and_mask ucast_id ucast_ucast_mask ucast_up_eq)
 
 lemma of_nat_less_t2n:
   "of_nat i < (2 :: ('a :: len) word) ^ n \<Longrightarrow> n < LENGTH('a) \<and> unat (of_nat i :: 'a word) < 2 ^ n"
   by (metis order_less_trans p2_gt_0 unat_less_power word_neq_0_conv)
 
 lemma two_power_increasing_less_1:
   "\<lbrakk> n \<le> m; m \<le> LENGTH('a) \<rbrakk> \<Longrightarrow> (2 :: 'a :: len word) ^ n - 1 \<le> 2 ^ m - 1"
   by (metis diff_diff_cancel le_m1_iff_lt less_imp_diff_less p2_gt_0 two_power_increasing
             word_1_le_power word_le_minus_mono_left word_less_sub_1)
 
 lemma word_sub_mono4:
   "\<lbrakk> y + x \<le> z + x; y \<le> y + x; z \<le> z + x \<rbrakk> \<Longrightarrow> y \<le> z" for y :: "'a :: len word"
   by (simp add: word_add_le_iff2)
 
 lemma eq_or_less_helperD:
   "\<lbrakk> n = unat (2 ^ m - 1 :: 'a :: len word) \<or> n < unat (2 ^ m - 1 :: 'a word); m < LENGTH('a) \<rbrakk>
    \<Longrightarrow> n < 2 ^ m"
   by (meson le_less_trans nat_less_le unat_less_power word_power_less_1)
 
 lemma mask_sub:
   "n \<le> m \<Longrightarrow> mask m - mask n = mask m AND NOT(mask n :: 'a::len word)"
   by (metis (full_types) and_mask_eq_iff_shiftr_0 mask_out_sub_mask shiftr_mask_le word_bw_comms(1))
 
 lemma neg_mask_diff_bound:
   "sz'\<le> sz \<Longrightarrow> (ptr AND NOT(mask sz')) - (ptr AND NOT(mask sz)) \<le> 2 ^ sz - 2 ^ sz'"
   (is "_ \<Longrightarrow> ?lhs \<le> ?rhs")
   for ptr :: \<open>'a::len word\<close>
 proof -
   assume lt: "sz' \<le> sz"
   hence "?lhs = ptr AND (mask sz AND NOT(mask sz'))"
     by (metis add_diff_cancel_left' multiple_mask_trivia)
   also have "\<dots> \<le> ?rhs" using lt
     by (metis (mono_tags) add_diff_eq diff_eq_eq eq_iff mask_2pm1 mask_sub word_and_le')
   finally show ?thesis by simp
 qed
 
 lemma mask_out_eq_0:
   "\<lbrakk> idx < 2 ^ sz; sz < LENGTH('a) \<rbrakk> \<Longrightarrow> (of_nat idx :: 'a :: len word) AND NOT(mask sz) = 0"
   by (simp add: of_nat_power less_mask_eq mask_eq_0_eq_x)
 
 lemma is_aligned_neg_mask_eq':
   "is_aligned ptr sz = (ptr AND NOT(mask sz) = ptr)"
   using is_aligned_mask mask_eq_0_eq_x by blast
 
 lemma neg_mask_mask_unat:
   "sz < LENGTH('a)
    \<Longrightarrow> unat ((ptr :: 'a :: len word) AND NOT(mask sz)) + unat (ptr AND mask sz) = unat ptr"
   by (metis AND_NOT_mask_plus_AND_mask_eq unat_plus_simple word_and_le2)
 
 lemma unat_pow_le_intro:
   "LENGTH('a) \<le> n \<Longrightarrow> unat (x :: 'a :: len word) < 2 ^ n"
   by (metis lt2p_lem not_le of_nat_le_iff of_nat_numeral semiring_1_class.of_nat_power uint_nat)
 
 lemma unat_shiftl_less_t2n:
   "\<lbrakk> unat (x :: 'a :: len word) < 2 ^ (m - n); m < LENGTH('a) \<rbrakk> \<Longrightarrow> unat (x << n) < 2 ^ m"
   by (metis (no_types) of_nat_power diff_le_self le_less_trans shiftl_less_t2n
                        unat_less_power word_unat.Rep_inverse)
 
 lemma unat_is_aligned_add:
   "\<lbrakk> is_aligned p n; unat d < 2 ^ n \<rbrakk>
    \<Longrightarrow> unat (p + d AND mask n) = unat d \<and> unat (p + d AND NOT(mask n)) = unat p"
   by (metis add.right_neutral and_mask_eq_iff_le_mask and_not_mask le_mask_iff mask_add_aligned
             mask_out_add_aligned mult_zero_right shiftl_t2n shiftr_le_0)
 
 lemma unat_shiftr_shiftl_mask_zero:
   "\<lbrakk> c + a \<ge> LENGTH('a) + b ; c < LENGTH('a) \<rbrakk>
    \<Longrightarrow> unat (((q :: 'a :: len word) >> a << b) AND NOT(mask c)) = 0"
   by (fastforce intro: unat_is_aligned_add[where p=0 and n=c, simplified, THEN conjunct2]
                        unat_shiftl_less_t2n unat_shiftr_less_t2n unat_pow_le_intro)
 
 lemmas of_nat_ucast = ucast_of_nat[symmetric]
 
 lemma shift_then_mask_eq_shift_low_bits:
   "x \<le> mask (low_bits + high_bits) \<Longrightarrow> (x >> low_bits) AND mask high_bits = x >> low_bits"
   for x :: \<open>'a::len word\<close>
   by (simp add: leq_mask_shift le_mask_imp_and_mask)
 
 lemma leq_low_bits_iff_zero:
   "\<lbrakk> x \<le> mask (low bits + high bits); x >> low_bits = 0 \<rbrakk> \<Longrightarrow> (x AND mask low_bits = 0) = (x = 0)"
   for x :: \<open>'a::len word\<close>
   using and_mask_eq_iff_shiftr_0 by force
 
 lemma unat_less_iff:
   "\<lbrakk> unat (a :: 'a :: len word) = b; c < 2 ^ LENGTH('a) \<rbrakk> \<Longrightarrow> (a < of_nat c) = (b < c)"
   using unat_ucast_less_no_overflow_simp by blast
 
 lemma is_aligned_no_overflow3:
  "\<lbrakk> is_aligned (a :: 'a :: len word) n; n < LENGTH('a); b < 2 ^ n; c \<le> 2 ^ n; b < c \<rbrakk>
   \<Longrightarrow> a + b \<le> a + (c - 1)"
   by (meson is_aligned_no_wrap' le_m1_iff_lt not_le word_less_sub_1 word_plus_mono_right)
 
 lemma mask_add_aligned_right:
   "is_aligned p n \<Longrightarrow> (q + p) AND mask n = q AND mask n"
   by (simp add: mask_add_aligned add.commute)
 
 lemma leq_high_bits_shiftr_low_bits_leq_bits_mask:
   "x \<le> mask high_bits \<Longrightarrow> (x :: 'a :: len word) << low_bits \<le> mask (low_bits + high_bits)"
   by (metis le_mask_shiftl_le_mask)
 
 lemma word_two_power_neg_ineq:
   "2 ^ m \<noteq> (0 :: 'a word) \<Longrightarrow> 2 ^ n \<le> - (2 ^ m :: 'a :: len word)"
   apply (cases "n < LENGTH('a)"; simp add: power_overflow)
   apply (cases "m < LENGTH('a)"; simp add: power_overflow)
   apply (simp add: word_le_nat_alt unat_minus word_size)
   apply (cases "LENGTH('a)"; simp)
   apply (simp add: less_Suc_eq_le)
   apply (drule power_increasing[where a=2 and n=n] power_increasing[where a=2 and n=m], simp)+
   apply (drule(1) add_le_mono)
   apply simp
   done
 
 lemma unat_shiftl_absorb:
   "\<lbrakk> x \<le> 2 ^ p; p + k < LENGTH('a) \<rbrakk> \<Longrightarrow> unat (x :: 'a :: len word) * 2 ^ k = unat (x * 2 ^ k)"
   by (smt add_diff_cancel_right' add_lessD1 le_add2 le_less_trans mult.commute nat_le_power_trans
           unat_lt2p unat_mult_lem unat_power_lower word_le_nat_alt)
 
 lemma word_plus_mono_right_split:
   "\<lbrakk> unat ((x :: 'a :: len word) AND mask sz) + unat z < 2 ^ sz; sz < LENGTH('a) \<rbrakk>
    \<Longrightarrow> x \<le> x + z"
   apply (subgoal_tac "(x AND NOT(mask sz)) + (x AND mask sz) \<le> (x AND NOT(mask sz)) + ((x AND mask sz) + z)")
    apply (simp add:word_plus_and_or_coroll2 field_simps)
   apply (rule word_plus_mono_right)
    apply (simp add: less_le_trans no_olen_add_nat)
   using of_nat_power is_aligned_no_wrap' by force
 
 lemma mul_not_mask_eq_neg_shiftl:
   "NOT(mask n :: 'a::len word) = -1 << n"
   by (simp add: NOT_mask shiftl_t2n)
 
 lemma shiftr_mul_not_mask_eq_and_not_mask:
   "(x >> n) * NOT(mask n) = - (x AND NOT(mask n))"
   for x :: \<open>'a::len word\<close>
   by (metis NOT_mask and_not_mask mult_minus_left semiring_normalization_rules(7) shiftl_t2n)
 
 lemma mask_eq_n1_shiftr:
   "n \<le> LENGTH('a) \<Longrightarrow> (mask n :: 'a :: len word) = -1 >> (LENGTH('a) - n)"
   by (metis diff_diff_cancel eq_refl mask_full shiftr_mask2)
 
 lemma is_aligned_mask_out_add_eq:
   "is_aligned p n \<Longrightarrow> (p + x) AND NOT(mask n) = p + (x AND NOT(mask n))"
   by (simp add: mask_out_sub_mask mask_add_aligned)
 
 lemmas is_aligned_mask_out_add_eq_sub
     = is_aligned_mask_out_add_eq[where x="a - b" for a b, simplified field_simps]
 
 lemma aligned_bump_down:
   "is_aligned x n \<Longrightarrow> (x - 1) AND NOT(mask n) = x - 2 ^ n"
   by (drule is_aligned_mask_out_add_eq[where x="-1"]) (simp add: NOT_mask)
 
 lemma unat_2tp_if:
   "unat (2 ^ n :: ('a :: len) word) = (if n < LENGTH ('a) then 2 ^ n else 0)"
   by (split if_split, simp_all add: power_overflow)
 
 lemma mask_of_mask:
   "mask (n::nat) AND mask (m::nat) = (mask (min m n) :: 'a::len word)"
   by word_eqI_solve
 
 lemma unat_signed_ucast_less_ucast:
   "LENGTH('a) \<le> LENGTH('b) \<Longrightarrow> unat (ucast (x :: 'a :: len word) :: 'b :: len signed word) = unat x"
   by (simp add: unat_ucast_up_simp)
 
 lemma toEnum_of_ucast:
   "LENGTH('b) \<le> LENGTH('a) \<Longrightarrow>
    (toEnum (unat (b::'b :: len word))::'a :: len word) = of_nat (unat b)"
   by (simp add: unat_pow_le_intro)
 
 lemmas unat_ucast_mask = unat_ucast_eq_unat_and_mask[where w=a for a]
 
 lemma t2n_mask_eq_if:
   "2 ^ n AND mask m = (if n < m then 2 ^ n else (0 :: 'a::len word))"
   by (rule word_eqI) (auto simp add: bit_simps)
 
 lemma unat_ucast_le:
   "unat (ucast (x :: 'a :: len word) :: 'b :: len word) \<le> unat x"
   by (simp add: ucast_nat_def word_unat_less_le)
 
 lemma ucast_le_up_down_iff:
   "\<lbrakk> LENGTH('a) \<le> LENGTH('b); (x :: 'b :: len word) \<le> ucast (- 1 :: 'a :: len word) \<rbrakk>
    \<Longrightarrow> (ucast x \<le> (y :: 'a word)) = (x \<le> ucast y)"
   using le_max_word_ucast_id ucast_le_ucast by metis
 
 lemma ucast_ucast_mask_shift:
   "a \<le> LENGTH('a) + b
    \<Longrightarrow> ucast (ucast (p AND mask a >> b) :: 'a :: len word) = p AND mask a >> b"
   by (metis add.commute le_mask_iff shiftr_mask_le ucast_ucast_eq_mask_shift word_and_le')
 
 lemma unat_ucast_mask_shift:
   "a \<le> LENGTH('a) + b
    \<Longrightarrow> unat (ucast (p AND mask a >> b) :: 'a :: len word) = unat (p AND mask a >> b)"
   by (metis linear ucast_ucast_mask_shift unat_ucast_up_simp)
 
 lemma mask_overlap_zero:
   "a \<le> b \<Longrightarrow> (p AND mask a) AND NOT(mask b) = 0"
   for p :: \<open>'a::len word\<close>
   by (metis NOT_mask_AND_mask mask_lower_twice2 max_def)
 
 lemma mask_shifl_overlap_zero:
   "a + c \<le> b \<Longrightarrow> (p AND mask a << c) AND NOT(mask b) = 0"
   for p :: \<open>'a::len word\<close>
   by (metis and_mask_0_iff_le_mask mask_mono mask_shiftl_decompose order_trans shiftl_over_and_dist word_and_le' word_and_le2)
 
 lemma mask_overlap_zero':
   "a \<ge> b \<Longrightarrow> (p AND NOT(mask a)) AND mask b = 0"
   for p :: \<open>'a::len word\<close>
   using mask_AND_NOT_mask mask_AND_less_0 by blast
 
 lemma mask_rshift_mult_eq_rshift_lshift:
   "((a :: 'a :: len word) >> b) * (1 << c) = (a >> b << c)"
   by (simp add: shiftl_t2n)
 
 lemma shift_alignment:
   "a \<ge> b \<Longrightarrow> is_aligned (p >> a << a) b"
   using is_aligned_shift is_aligned_weaken by blast
 
 lemma mask_split_sum_twice:
   "a \<ge> b \<Longrightarrow> (p AND NOT(mask a)) + ((p AND mask a) AND NOT(mask b)) + (p AND mask b) = p"
   for p :: \<open>'a::len word\<close>
   by (simp add: add.commute multiple_mask_trivia word_bw_comms(1) word_bw_lcs(1) word_plus_and_or_coroll2)
 
 lemma mask_shift_eq_mask_mask:
   "(p AND mask a >> b << b) = (p AND mask a) AND NOT(mask b)"
   for p :: \<open>'a::len word\<close>
   by (simp add: and_not_mask)
 
 lemma mask_shift_sum:
   "\<lbrakk> a \<ge> b; unat n = unat (p AND mask b) \<rbrakk>
    \<Longrightarrow> (p AND NOT(mask a)) + (p AND mask a >> b) * (1 << b) + n = (p :: 'a :: len word)"
   by (metis and_not_mask mask_rshift_mult_eq_rshift_lshift mask_split_sum_twice word_unat.Rep_eqD)
 
 lemma is_up_compose:
   "\<lbrakk> is_up uc; is_up uc' \<rbrakk> \<Longrightarrow> is_up (uc' \<circ> uc)"
   unfolding is_up_def by (simp add: Word.target_size Word.source_size)
 
 lemma of_int_sint_scast:
   "of_int (sint (x :: 'a :: len word)) = (scast x :: 'b :: len word)"
   by (fact Word.of_int_sint)
 
 lemma scast_of_nat_to_signed [simp]:
   "scast (of_nat x :: 'a :: len word) = (of_nat x :: 'a signed word)"
   by transfer simp
 
 lemma scast_of_nat_signed_to_unsigned_add:
   "scast (of_nat x + of_nat y :: 'a :: len signed word) = (of_nat x + of_nat y :: 'a :: len word)"
   by (metis of_nat_add scast_of_nat)
 
 lemma scast_of_nat_unsigned_to_signed_add:
   "(scast (of_nat x + of_nat y :: 'a :: len word)) = (of_nat x + of_nat y :: 'a :: len signed word)"
   by (metis Abs_fnat_hom_add scast_of_nat_to_signed)
 
 lemma and_mask_cases:
   fixes x :: "'a :: len word"
   assumes len: "n < LENGTH('a)"
   shows "x AND mask n \<in> of_nat ` set [0 ..< 2 ^ n]"
   apply (simp flip: take_bit_eq_mask)
   apply (rule image_eqI [of _ _ \<open>unat (take_bit n x)\<close>])
   using len apply simp_all
   apply transfer
   apply simp
   done
 
 lemma sint_eq_uint_2pl:
   "\<lbrakk> (a :: 'a :: len word) < 2 ^ (LENGTH('a) - 1) \<rbrakk>
    \<Longrightarrow> sint a = uint a"
   by (simp add: not_msb_from_less sint_eq_uint word_2p_lem word_size)
 
 lemma pow_sub_less:
   "\<lbrakk> a + b \<le> LENGTH('a); unat (x :: 'a :: len word) = 2 ^ a \<rbrakk>
    \<Longrightarrow> unat (x * 2 ^ b - 1) < 2 ^ (a + b)"
   by (metis (mono_tags) eq_or_less_helperD not_less of_nat_numeral power_add
                         semiring_1_class.of_nat_power unat_pow_le_intro word_unat.Rep_inverse)
 
 lemma sle_le_2pl:
   "\<lbrakk> (b :: 'a :: len word) < 2 ^ (LENGTH('a) - 1); a \<le> b \<rbrakk> \<Longrightarrow> a <=s b"
   by (simp add: not_msb_from_less word_sle_msb_le)
 
 lemma sless_less_2pl:
   "\<lbrakk> (b :: 'a :: len word) < 2 ^ (LENGTH('a) - 1); a < b \<rbrakk> \<Longrightarrow> a <s b"
   using not_msb_from_less word_sless_msb_less by blast
 
 lemma and_mask2:
   "w << n >> n = w AND mask (size w - n)"
   for w :: \<open>'a::len word\<close>
   by (cases "n \<le> size w"; clarsimp simp: word_and_le2 and_mask shiftl_zero_size)
 
 lemma aligned_sub_aligned_simple:
   "\<lbrakk> is_aligned a n; is_aligned b n \<rbrakk> \<Longrightarrow> is_aligned (a - b) n"
   by (simp add: aligned_sub_aligned)
 
 lemma minus_one_shift:
   "- (1 << n) = (-1 << n :: 'a::len word)"
-  by (simp add: mask_eq_decr_exp NOT_eq flip: mul_not_mask_eq_neg_shiftl)
+  by (simp flip: mul_not_mask_eq_neg_shiftl minus_exp_eq_not_mask add: push_bit_of_1)
 
 lemma ucast_eq_mask:
   "(UCAST('a::len \<rightarrow> 'b::len) x = UCAST('a \<rightarrow> 'b) y) =
    (x AND mask LENGTH('b) = y AND mask LENGTH('b))"
   by transfer (simp flip: take_bit_eq_mask add: ac_simps)
 
 context
   fixes w :: "'a::len word"
 begin
 
 private lemma sbintrunc_uint_ucast:
   assumes "Suc n = LENGTH('b::len)"
   shows "signed_take_bit n (uint (ucast w :: 'b word)) = signed_take_bit n (uint w)"
   by (rule bit_eqI) (use assms in \<open>simp add: bit_simps\<close>)
 
 private lemma test_bit_sbintrunc:
   assumes "i < LENGTH('a)"
   shows "bit (word_of_int (signed_take_bit n (uint w)) :: 'a word) i
            = (if n < i then bit w n else bit w i)"
   using assms by (simp add: bit_simps)
 
 private lemma test_bit_sbintrunc_ucast:
   assumes len_a: "i < LENGTH('a)"
   shows "bit (word_of_int (signed_take_bit (LENGTH('b) - 1) (uint (ucast w :: 'b word))) :: 'a word) i
           = (if LENGTH('b::len) \<le> i then bit w (LENGTH('b) - 1) else bit w i)"
   using len_a by (auto simp add: sbintrunc_uint_ucast bit_simps)
 
 lemma scast_ucast_high_bits:
   \<open>scast (ucast w :: 'b::len word) = w
      \<longleftrightarrow> (\<forall> i \<in> {LENGTH('b) ..< size w}. bit w i = bit w (LENGTH('b) - 1))\<close>
 proof (cases \<open>LENGTH('a) \<le> LENGTH('b)\<close>)
   case True
   moreover define m where \<open>m = LENGTH('b) - LENGTH('a)\<close>
   ultimately have \<open>LENGTH('b) = m + LENGTH('a)\<close>
     by simp
   then show ?thesis
     apply (simp_all add: signed_ucast_eq word_size)
     apply (rule bit_word_eqI)
     apply (simp add: bit_signed_take_bit_iff)
     done
 next
   case False
   define q where \<open>q = LENGTH('b) - 1\<close>
   then have \<open>LENGTH('b) = Suc q\<close>
     by simp
   moreover define m where \<open>m = Suc LENGTH('a) - LENGTH('b)\<close>
   with False \<open>LENGTH('b) = Suc q\<close> have \<open>LENGTH('a) = m + q\<close>
     by (simp add: not_le)
   ultimately show ?thesis
     apply (simp_all add: signed_ucast_eq word_size)
     apply (transfer fixing: m q)
     apply (simp add: signed_take_bit_take_bit)
     apply rule
     apply (subst bit_eq_iff)
     apply (simp add: bit_take_bit_iff bit_signed_take_bit_iff min_def)
     apply (auto simp add: Suc_le_eq)
     using less_imp_le_nat apply blast
     using less_imp_le_nat apply blast
     done
 qed
 
 lemma scast_ucast_mask_compare:
   "scast (ucast w :: 'b::len word) = w
    \<longleftrightarrow> (w \<le> mask (LENGTH('b) - 1) \<or> NOT(mask (LENGTH('b) - 1)) \<le> w)"
   apply (clarsimp simp: le_mask_high_bits neg_mask_le_high_bits scast_ucast_high_bits word_size)
   apply (rule iffI; clarsimp)
    apply (rename_tac i j; case_tac "i = LENGTH('b) - 1"; case_tac "j = LENGTH('b) - 1")
   by auto
 
 lemma ucast_less_shiftl_helper':
   "\<lbrakk> LENGTH('b) + (a::nat) < LENGTH('a); 2 ^ (LENGTH('b) + a) \<le> n\<rbrakk>
    \<Longrightarrow> (ucast (x :: 'b::len word) << a) < (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
 
 end
 
 lemma ucast_ucast_mask2:
   "is_down (UCAST ('a \<rightarrow> 'b)) \<Longrightarrow>
    UCAST ('b::len \<rightarrow> 'c::len) (UCAST ('a::len \<rightarrow> 'b::len) x) = UCAST ('a \<rightarrow> 'c) (x AND mask LENGTH('b))"
   apply (simp flip: take_bit_eq_mask)
   apply transfer
   apply simp
   done
 
 lemma ucast_NOT:
   "ucast (NOT x) = NOT(ucast x) AND mask (LENGTH('a))" for x::"'a::len word"
   by word_eqI
 
 lemma ucast_NOT_down:
   "is_down UCAST('a::len \<rightarrow> 'b::len) \<Longrightarrow> UCAST('a \<rightarrow> 'b) (NOT x) = NOT(UCAST('a \<rightarrow> 'b) x)"
   by word_eqI
 
 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 < LENGTH('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 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 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 (simp only: ucast_eq)
   apply (subst lift_M)
   apply (subst of_int_uint [symmetric], subst lift_M')
   apply (subst (1 2) int_word_uint)
   apply (subst word_ubin.norm_eq_iff [symmetric])
   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_exp_eq 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_eq 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_eq 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_eq 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_eq 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_eq 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_eq 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_eq 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_eq 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 (simp only: scast_eq)
   apply (metis down_cast_same is_up_down scast_eq 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_wi scast_down_wi
   ucast_of_nat scast_of_nat
   uint_up_ucast sint_up_scast
   up_scast_surj up_ucast_surj
 
 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: signed_divide_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]
 
 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)+
 
 end
diff --git a/thys/Word_Lib/Word_Lib_Sumo.thy b/thys/Word_Lib/Word_Lib_Sumo.thy
--- a/thys/Word_Lib/Word_Lib_Sumo.thy
+++ b/thys/Word_Lib/Word_Lib_Sumo.thy
@@ -1,139 +1,134 @@
 (*
  * Copyright Florian Haftmann
  *
  * SPDX-License-Identifier: BSD-2-Clause
  *)
 
 section \<open>Ancient comprehensive Word Library\<close>
 
 theory Word_Lib_Sumo
 imports
   "HOL-Library.Word"
   Aligned
   Bit_Comprehension
+  Bit_Shifts_Infix_Syntax
   Bits_Int
   Bitwise_Signed
   Bitwise
   Enumeration_Word
   Generic_set_bit
   Hex_Words
   Least_significant_bit
   More_Arithmetic
   More_Divides
   More_Sublist
   Even_More_List
   More_Misc
   Strict_part_mono
   Legacy_Aliases
   Most_significant_bit
   Next_and_Prev
   Norm_Words
   Reversed_Bit_Lists
   Rsplit
   Signed_Words
   Syntax_Bundles
-  Traditional_Infix_Syntax
   Typedef_Morphisms
   Type_Syntax
   Word_EqI
   Word_Lemmas
   Word_8
   Word_16
   Word_32
   Word_Syntax
   Signed_Division_Word
   More_Word_Operations
   Many_More
 begin
 
 unbundle bit_projection_infix_syntax
 
 declare word_induct2[induct type]
 declare word_nat_cases[cases type]
 
 declare signed_take_bit_Suc [simp]
 
 (* these generate take_bit terms, which we often don't want for concrete lengths *)
 lemmas of_int_and_nat = unsigned_of_nat unsigned_of_int signed_of_int signed_of_nat
 
 bundle no_take_bit
 begin
   declare of_int_and_nat[simp del]
 end
 
 lemmas bshiftr1_def = bshiftr1_eq
 lemmas is_down_def = is_down_eq
 lemmas is_up_def = is_up_eq
 lemmas mask_def = mask_eq
 lemmas scast_def = scast_eq
 lemmas shiftl1_def = shiftl1_eq
 lemmas shiftr1_def = shiftr1_eq
 lemmas sshiftr1_def = sshiftr1_eq
 lemmas sshiftr_def = sshiftr_eq_funpow_sshiftr1
 lemmas to_bl_def = to_bl_eq
 lemmas ucast_def = ucast_eq
 lemmas unat_def = unat_eq_nat_uint
 lemmas word_cat_def = word_cat_eq
 lemmas word_reverse_def = word_reverse_eq_of_bl_rev_to_bl
 lemmas word_roti_def = word_roti_eq_word_rotr_word_rotl
 lemmas word_rotl_def = word_rotl_eq
 lemmas word_rotr_def = word_rotr_eq
 lemmas word_sle_def = word_sle_eq
 lemmas word_sless_def = word_sless_eq
 
 lemmas uint_0 = uint_nonnegative
 lemmas uint_lt = uint_bounded
 lemmas uint_mod_same = uint_idem
 lemmas of_nth_def = word_set_bits_def
 
 lemmas of_nat_word_eq_iff = word_of_nat_eq_iff
 lemmas of_nat_word_eq_0_iff = word_of_nat_eq_0_iff
 lemmas of_int_word_eq_iff = word_of_int_eq_iff
 lemmas of_int_word_eq_0_iff = word_of_int_eq_0_iff
 
 lemmas word_next_def = word_next_unfold
 
 lemmas word_prev_def = word_prev_unfold
 
 lemmas is_aligned_def = is_aligned_iff_dvd_nat
 
-lemma shiftl_transfer [transfer_rule]:
-  includes lifting_syntax
-  shows "(pcr_word ===> (=) ===> pcr_word) (<<) (<<)"
-  by (unfold shiftl_eq_push_bit) transfer_prover
-
 lemmas word_and_max_simps =
   word8_and_max_simp
   word16_and_max_simp
   word32_and_max_simp
 
 lemma distinct_lemma: "f x \<noteq> f y \<Longrightarrow> x \<noteq> y" by auto
 
 lemmas and_bang = word_and_nth
 
 lemmas sdiv_int_def = signed_divide_int_def
 lemmas smod_int_def = signed_modulo_int_def
 
 (* 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)
 
 declare of_nat_diff [simp]
 
 (* Haskellish names/syntax *)
 notation (input)
   bit ("testBit")
 
 lemmas cast_simps = cast_simps ucast_down_bl
 
 (* shadows the slightly weaker Word.nth_ucast *)
 lemma nth_ucast:
   "(ucast (w::'a::len word)::'b::len word) !! n =
    (w !! n \<and> n < min LENGTH('a) LENGTH('b))"
-  by transfer (simp add: bit_take_bit_iff ac_simps)
+  by (auto simp add: bit_simps not_le dest: bit_imp_le_length)
 
 end