diff --git a/thys/Modular_arithmetic_LLL_and_HNF_algorithms/HNF_Mod_Det_Soundness.thy b/thys/Modular_arithmetic_LLL_and_HNF_algorithms/HNF_Mod_Det_Soundness.thy
--- a/thys/Modular_arithmetic_LLL_and_HNF_algorithms/HNF_Mod_Det_Soundness.thy
+++ b/thys/Modular_arithmetic_LLL_and_HNF_algorithms/HNF_Mod_Det_Soundness.thy
@@ -1,11563 +1,11568 @@
 
 subsection \<open>Soundness of the algorithm\<close>
 
 theory HNF_Mod_Det_Soundness
   imports
     HNF_Mod_Det_Algorithm
     Signed_Modulo
 begin
 
 hide_const(open) Determinants.det Determinants2.upper_triangular
   Finite_Cartesian_Product.row Finite_Cartesian_Product.rows
   Finite_Cartesian_Product.vec
 
 subsubsection \<open>Results connecting lattices and Hermite normal form\<close>
 
 text \<open>The following results will also be useful for proving the soundness of the certification 
 approach.\<close>
 
 lemma of_int_mat_hom_int_id[simp]:
   fixes A::"int mat"
   shows "of_int_hom.mat_hom A = A" unfolding map_mat_def by auto
 
 
 definition "is_sound_HNF algorithm associates res 
     = (\<forall>A. let (P,H) = algorithm A; m = dim_row A; n = dim_col A in 
         P \<in> carrier_mat m m \<and> H \<in> carrier_mat m n \<and> invertible_mat P \<and> A = P * H 
         \<and> Hermite_JNF associates res H)"
 
 lemma HNF_A_eq_HNF_PA:
   fixes A::"'a::{bezout_ring_div,normalization_euclidean_semiring,unique_euclidean_ring} mat"
   assumes A: "A \<in> carrier_mat n n" and inv_A: "invertible_mat A" 
     and inv_P: "invertible_mat P" and P: "P \<in> carrier_mat n n"
     and sound_HNF: "is_sound_HNF HNF associates res"
     and P1_H1: "(P1,H1) = HNF (P*A)"
     and P2_H2: "(P2,H2) = HNF A"
   shows "H1 = H2"
 proof -
   obtain inv_P where P_inv_P: "inverts_mat P inv_P" and inv_P_P: "inverts_mat inv_P P"
     and inv_P: "inv_P \<in> carrier_mat n n"
     using P inv_P obtain_inverse_matrix by blast
   have P1: "P1 \<in> carrier_mat n n"
       using P1_H1 sound_HNF unfolding is_sound_HNF_def Let_def
       by (metis (no_types, lifting) P carrier_matD(1) index_mult_mat(2) old.prod.case)
     have H1: "H1 \<in> carrier_mat n n" using P1_H1 sound_HNF unfolding is_sound_HNF_def Let_def
   by (metis (no_types, lifting) A P carrier_matD(1) carrier_matD(2) case_prodD index_mult_mat(2,3))
   have invertible_inv_P: "invertible_mat inv_P"
       using P_inv_P inv_P inv_P_P invertible_mat_def square_mat.simps by blast
   have P_A_P1_H1: "P * A = P1 * H1" using P1_H1 sound_HNF unfolding is_sound_HNF_def Let_def
     by (metis (mono_tags, lifting) case_prod_conv)
   hence "A = inv_P * (P1 * H1)"
     by (smt A P inv_P_P inv_P assoc_mult_mat carrier_matD(1) inverts_mat_def left_mult_one_mat)
   hence A_inv_P_P1_H1: "A = (inv_P * P1) * H1"
     by (smt P P1_H1 assoc_mult_mat carrier_matD(1) fst_conv index_mult_mat(2) inv_P 
         is_sound_HNF_def prod.sel(2) sound_HNF split_beta)
   have A_P2_H2: "A = P2 * H2" using P2_H2 sound_HNF unfolding is_sound_HNF_def Let_def
     by (metis (mono_tags, lifting) case_prod_conv)
   have invertible_inv_P_P1: "invertible_mat (inv_P * P1)"
   proof (rule invertible_mult_JNF[OF inv_P P1 invertible_inv_P])   
     show "invertible_mat P1"
       by (smt P1_H1 is_sound_HNF_def prod.sel(1) sound_HNF split_beta)
   qed
   show ?thesis
   proof (rule Hermite_unique_JNF[OF A _ H1 _ _ A_inv_P_P1_H1 A_P2_H2 inv_A invertible_inv_P_P1])
     show "inv_P * P1 \<in> carrier_mat n n"
       by (metis carrier_matD(1) carrier_matI index_mult_mat(2) inv_P
           invertible_inv_P_P1 invertible_mat_def square_mat.simps)
     show "P2 \<in> carrier_mat n n" 
       by (smt A P2_H2 carrier_matD(1) is_sound_HNF_def prod.sel(1) sound_HNF split_beta)
     show "H2 \<in> carrier_mat n n"
       by (smt A P2_H2 carrier_matD(1) carrier_matD(2) is_sound_HNF_def prod.sel(2) sound_HNF split_beta)
     show "invertible_mat P2"
       by (smt P2_H2 is_sound_HNF_def prod.sel(1) sound_HNF split_beta)
     show "Hermite_JNF associates res H1" 
       by (smt P1_H1 is_sound_HNF_def prod.sel(2) sound_HNF split_beta)
     show "Hermite_JNF associates res H2"
       by (smt P2_H2 is_sound_HNF_def prod.sel(2) sound_HNF split_beta)
   qed
 qed
 
 
 context vec_module
 begin
 
 lemma mat_mult_invertible_lattice_eq: 
   assumes fs: "set fs \<subseteq> carrier_vec n"
   and gs: "set gs \<subseteq> carrier_vec n"  
   and P: "P \<in> carrier_mat m m" and invertible_P: "invertible_mat P"
   and length_fs: "length fs = m" and length_gs: "length gs = m"
   and prod: "mat_of_rows n fs = (map_mat of_int P) * mat_of_rows n gs" 
   shows "lattice_of fs = lattice_of gs" 
 proof thm mat_mult_sub_lattice
   show "lattice_of fs \<subseteq> lattice_of gs"
     by (rule mat_mult_sub_lattice[OF fs gs _ prod],simp add: length_fs length_gs P)
 next
   obtain inv_P where P_inv_P: "inverts_mat P inv_P" and inv_P_P: "inverts_mat inv_P P"
     and inv_P: "inv_P \<in> carrier_mat m m"
     using P invertible_P obtain_inverse_matrix by blast
   have "of_int_hom.mat_hom (inv_P) * mat_of_rows n fs 
       = of_int_hom.mat_hom (inv_P) * ((map_mat of_int P) * mat_of_rows n gs)" 
     using prod by auto
   also have "... = of_int_hom.mat_hom (inv_P) * (map_mat of_int P) * mat_of_rows n gs"
     by (smt P assoc_mult_mat inv_P length_gs map_carrier_mat mat_of_rows_carrier(1))
   also have "... = of_int_hom.mat_hom (inv_P * P) * mat_of_rows n gs"
     by (metis P inv_P of_int_hom.mat_hom_mult)
   also have "... = mat_of_rows n gs"
     by (metis carrier_matD(1) inv_P inv_P_P inverts_mat_def left_mult_one_mat' 
         length_gs mat_of_rows_carrier(2) of_int_hom.mat_hom_one)    
   finally have prod: "mat_of_rows n gs = of_int_hom.mat_hom (inv_P) * mat_of_rows n fs" ..
   show "lattice_of gs \<subseteq> lattice_of fs"
     by (rule mat_mult_sub_lattice[OF gs fs _ prod], simp add: length_fs length_gs inv_P)
 qed                     
 
 end
 
 
 context
   fixes n :: nat
 begin
 
 interpretation vec_module "TYPE(int)" .
 
 lemma lattice_of_HNF:
   assumes sound_HNF: "is_sound_HNF HNF associates res"
     and P1_H1: "(P,H) = HNF (mat_of_rows n fs)"
     and fs: "set fs \<subseteq> carrier_vec n" and len: "length fs = m"
   shows "lattice_of fs = lattice_of (rows H)"
 proof (rule mat_mult_invertible_lattice_eq[OF fs])
   have H: "H \<in> carrier_mat m n" using sound_HNF P1_H1 unfolding is_sound_HNF_def Let_def
     by (metis (mono_tags, lifting) assms(4) mat_of_rows_carrier(2) mat_of_rows_carrier(3) prod.sel(2) split_beta)
   have H_rw: "mat_of_rows n (Matrix.rows H) = H" using mat_of_rows_rows H by fast
   have PH_fs_init: "mat_of_rows n fs = P * H" using sound_HNF P1_H1 unfolding is_sound_HNF_def Let_def
     by (metis (mono_tags, lifting) case_prodD)
   show "mat_of_rows n fs = of_int_hom.mat_hom P * mat_of_rows n (Matrix.rows H)"
     unfolding H_rw of_int_mat_hom_int_id using PH_fs_init by simp  
   show "set (Matrix.rows H) \<subseteq> carrier_vec n" using H rows_carrier by blast
   show "P \<in> carrier_mat m m" using sound_HNF P1_H1 unfolding is_sound_HNF_def Let_def
     by (metis (no_types, lifting) len case_prodD mat_of_rows_carrier(2))    
   show "invertible_mat P" using sound_HNF P1_H1 unfolding is_sound_HNF_def Let_def
     by (metis (no_types, lifting) case_prodD)
   show "length fs = m" using len by simp
   show "length (Matrix.rows H) = m" using H by auto
 qed
 end
 
 
 context LLL_with_assms 
 begin            
 
 (*For this proof, it seems that is not necessary fs_init to be a list of independent vectors. 
 The context assumes it, though.*)
 lemma certification_via_eq_HNF:
   assumes sound_HNF: "is_sound_HNF HNF associates res"
     and P1_H1: "(P1,H1) = HNF (mat_of_rows n fs_init)"
     and P2_H2: "(P2,H2) = HNF (mat_of_rows n gs)"
     and H1_H2: "H1 = H2" (*The HNF are equal*)
     and gs: "set gs \<subseteq> carrier_vec n" and len_gs: "length gs = m"
   shows "lattice_of gs = lattice_of fs_init" "LLL_with_assms n m gs \<alpha>"
 proof -                                           
   have "lattice_of fs_init = lattice_of (rows H1)"
     by (rule lattice_of_HNF[OF sound_HNF P1_H1 fs_init], simp add: len)
   also have "... = lattice_of (rows H2)" using H1_H2 by auto
   also have "... = lattice_of gs" 
     by (rule lattice_of_HNF[symmetric, OF sound_HNF P2_H2 gs len_gs])
   finally show "lattice_of gs = lattice_of fs_init" ..
     have invertible_P1: "invertible_mat P1" 
       using sound_HNF P1_H1 unfolding is_sound_HNF_def
       by (metis (mono_tags, lifting) case_prodD)
   have invertible_P2: "invertible_mat P2"
       using sound_HNF P2_H2 unfolding is_sound_HNF_def
       by (metis (mono_tags, lifting) case_prodD)
     have P2: "P2 \<in> carrier_mat m m" 
       using sound_HNF P2_H2 unfolding is_sound_HNF_def
       by (metis (no_types, lifting) len_gs case_prodD mat_of_rows_carrier(2))
     obtain inv_P2 where P2_inv_P2: "inverts_mat P2 inv_P2" and inv_P2_P2: "inverts_mat inv_P2 P2"
     and inv_P2: "inv_P2 \<in> carrier_mat m m"
       using P2 invertible_P2 obtain_inverse_matrix by blast
     have P1: "P1 \<in> carrier_mat m m" 
       using sound_HNF P1_H1 unfolding is_sound_HNF_def
       by (metis (no_types, lifting) len case_prodD mat_of_rows_carrier(2))
     have H1: "H1 \<in> carrier_mat m n" 
       using sound_HNF P1_H1 unfolding is_sound_HNF_def
       by (metis (no_types, lifting) case_prodD len mat_of_rows_carrier(2) mat_of_rows_carrier(3))
     have H2: "H2 \<in> carrier_mat m n" 
       using sound_HNF P2_H2 unfolding is_sound_HNF_def
       by (metis (no_types, lifting) len_gs case_prodD mat_of_rows_carrier(2) mat_of_rows_carrier(3))
     have P2_H2: "P2 * H2 = mat_of_rows n gs"
       by (smt P2_H2 sound_HNF case_prodD is_sound_HNF_def)
     have P1_H1_fs: "P1 * H1 = mat_of_rows n fs_init"
       by (smt P1_H1 sound_HNF case_prodD is_sound_HNF_def)
     obtain inv_P1 where P1_inv_P1: "inverts_mat P1 inv_P1" and inv_P1_P1: "inverts_mat inv_P1 P1"
     and inv_P1: "inv_P1 \<in> carrier_mat m m"
       using P1 invertible_P1 obtain_inverse_matrix by blast
   show "LLL_with_assms n m gs \<alpha>"
   proof (rule LLL_change_basis(2)[OF gs len_gs])
     show "P1 * inv_P2 \<in> carrier_mat m m" using P1 inv_P2 by auto
     have "mat_of_rows n fs_init = P1 * H1" using sound_HNF P2_H2 unfolding is_sound_HNF_def
       by (metis (mono_tags, lifting) P1_H1 case_prodD)
     also have "... = P1 * inv_P2 * P2 * H1"
       by (smt P1 P2 assoc_mult_mat carrier_matD(1) inv_P2 inv_P2_P2 inverts_mat_def right_mult_one_mat)
     also have "... = P1 * inv_P2 * P2 * H2" using H1_H2 by blast
     also have "... = P1 * inv_P2 * (P2 * H2)" 
       using H2 P2 \<open>P1 * inv_P2 \<in> carrier_mat m m\<close> assoc_mult_mat by blast
     also have "... = P1 * (inv_P2 * P2 * H2)"
       by (metis H2 \<open>P1 * H1 = P1 * inv_P2 * P2 * H1\<close> \<open>P1 * inv_P2 * P2 * H2 = P1 * inv_P2 * (P2 * H2)\<close> 
           H1_H2 carrier_matD(1) inv_P2 inv_P2_P2 inverts_mat_def left_mult_one_mat)
     also have "... = P1 * (inv_P2 * (P2 * H2))" using H2 P2 inv_P2 by auto
     also have "... =  P1 * inv_P2 * mat_of_rows n gs"
       using P2_H2 \<open>P1 * (inv_P2 * P2 * H2) = P1 * (inv_P2 * (P2 * H2))\<close> 
         \<open>P1 * inv_P2 * (P2 * H2) = P1 * (inv_P2 * P2 * H2)\<close> by auto
     finally show "mat_of_rows n fs_init = P1 * inv_P2 * mat_of_rows n gs" .
     show "P2 * inv_P1 \<in> carrier_mat m m" 
       using P2 inv_P1 by auto
     have "mat_of_rows n gs = P2 * H2" using sound_HNF P2_H2 unfolding is_sound_HNF_def by metis
     also have "... = P2 * inv_P1 * P1 * H2"
       by (smt P1 P2 assoc_mult_mat carrier_matD(1) inv_P1 inv_P1_P1 inverts_mat_def right_mult_one_mat)
     also have "... = P2 * inv_P1 * P1 * H1" using H1_H2 by blast
     also have "... = P2 * inv_P1 * (P1 * H1)" 
       using H1 P1 \<open>P2 * inv_P1 \<in> carrier_mat m m\<close> assoc_mult_mat by blast
     also have "... = P2 * (inv_P1 * P1 * H1)"
       by (metis H2 \<open>P2 * H2 = P2 * inv_P1 * P1 * H2\<close> \<open>P2 * inv_P1 * P1 * H1 = P2 * inv_P1 * (P1 * H1)\<close> 
           H1_H2 carrier_matD(1) inv_P1 inv_P1_P1 inverts_mat_def left_mult_one_mat)
     also have "... = P2 * (inv_P1 * (P1 * H1))" using H1 P1 inv_P1 by auto
     also have "... =  P2 * inv_P1 * mat_of_rows n fs_init"
       using P1_H1_fs \<open>P2 * (inv_P1 * P1 * H1) = P2 * (inv_P1 * (P1 * H1))\<close> 
         \<open>P2 * inv_P1 * (P1 * H1) = P2 * (inv_P1 * P1 * H1)\<close> by auto
     finally show "mat_of_rows n gs = P2 * inv_P1 * mat_of_rows n fs_init" .
   qed
 qed
 
 end
 
 text \<open>Now, we need to generalize some lemmas.\<close>
 
 context vec_module
 begin
 
 (*Generalized version of thm vec_space.finsum_index, now in vec_module*)
 lemma finsum_index:
   assumes i: "i < n"
     and f: "f \<in> A \<rightarrow> carrier_vec n"
     and A: "A \<subseteq> carrier_vec n"
   shows "finsum V f A $ i = sum (\<lambda>x. f x $ i) A"
   using A f
 proof (induct A rule: infinite_finite_induct)
   case empty
     then show ?case using i by simp next
   case (insert x X)
     then have Xf: "finite X"
       and xX: "x \<notin> X"
       and x: "x \<in> carrier_vec n"
       and X: "X \<subseteq> carrier_vec n"
       and fx: "f x \<in> carrier_vec n"
       and f: "f \<in> X \<rightarrow> carrier_vec n" by auto
     have i2: "i < dim_vec (finsum V f X)"
       using i finsum_closed[OF f] by auto
     have ix: "i < dim_vec x" using x i by auto
     show ?case
       unfolding finsum_insert[OF Xf xX f fx]
       unfolding sum.insert[OF Xf xX]
       unfolding index_add_vec(1)[OF i2]
       using insert lincomb_def
       by auto
 qed (insert i, auto)
 
 (*Generalized version of thm vec_space.mat_of_rows_mult_as_finsum, now in vec_module*)
 lemma mat_of_rows_mult_as_finsum:
   assumes "v \<in> carrier_vec (length lst)" "\<And> i. i < length lst \<Longrightarrow> lst ! i \<in> carrier_vec n"
   defines "f l \<equiv> sum (\<lambda> i. if l = lst ! i then v $ i else 0) {0..<length lst}"
   shows mat_of_cols_mult_as_finsum:"mat_of_cols n lst *\<^sub>v v = lincomb f (set lst)"
 proof -
   from assms have "\<forall> i < length lst. lst ! i \<in> carrier_vec n" by blast
   note an = all_nth_imp_all_set[OF this] hence slc:"set lst \<subseteq> carrier_vec n" by auto
   hence dn [simp]:"\<And> x. x \<in> set lst \<Longrightarrow> dim_vec x = n" by auto
   have dl [simp]:"dim_vec (lincomb f (set lst)) = n" using an
     by (simp add: slc)
   show ?thesis proof
     show "dim_vec (mat_of_cols n lst *\<^sub>v v) = dim_vec (lincomb f (set lst))" using assms(1,2) by auto
     fix i assume i:"i < dim_vec (lincomb f (set lst))" hence i':"i < n" by auto
     with an have fcarr:"(\<lambda>v. f v \<cdot>\<^sub>v v) \<in> set lst \<rightarrow> carrier_vec n" by auto
     from i' have "(mat_of_cols n lst *\<^sub>v v) $ i = row (mat_of_cols n lst) i \<bullet> v" by auto
     also have "\<dots> = (\<Sum>ia = 0..<dim_vec v. lst ! ia $ i * v $ ia)"
       unfolding mat_of_cols_def row_def scalar_prod_def
       apply(rule sum.cong[OF refl]) using i an assms(1) by auto
     also have "\<dots> = (\<Sum>ia = 0..<length lst. lst ! ia $ i * v $ ia)" using assms(1) by auto
     also have "\<dots> = (\<Sum>x\<in>set lst. f x * x $ i)"
       unfolding f_def sum_distrib_right apply (subst sum.swap)
       apply(rule sum.cong[OF refl])
       unfolding if_distrib if_distribR mult_zero_left sum.delta[OF finite_set] by auto
     also have "\<dots> = (\<Sum>x\<in>set lst. (f x \<cdot>\<^sub>v x) $ i)"
       apply(rule sum.cong[OF refl],subst index_smult_vec) using i slc by auto
     also have "\<dots> = (\<Oplus>\<^bsub>V\<^esub>v\<in>set lst. f v \<cdot>\<^sub>v v) $ i" 
       unfolding finsum_index[OF i' fcarr slc] by auto
     finally show "(mat_of_cols n lst *\<^sub>v v) $ i = lincomb f (set lst) $ i"
       by (auto simp:lincomb_def)
   qed
 qed
 
 
 lemma lattice_of_altdef_lincomb:
   assumes "set fs \<subseteq> carrier_vec n"
   shows "lattice_of fs = {y. \<exists>f. lincomb (of_int \<circ> f) (set fs) = y}"
   unfolding lincomb_def lattice_of_altdef[OF assms] image_def by auto
 
 end
 
 context vec_module
 begin
 
 (*Generalized version of thm idom_vec.lincomb_as_lincomb_list, now in vec_module*)
 lemma lincomb_as_lincomb_list:
   fixes ws f
   assumes s: "set ws \<subseteq> carrier_vec n"
   shows "lincomb f (set ws) = lincomb_list (\<lambda>i. if \<exists>j<i. ws!i = ws!j then 0 else f (ws ! i)) ws"
   using assms
 proof (induct ws rule: rev_induct)
   case (snoc a ws)
   let ?f = "\<lambda>i. if \<exists>j<i. ws ! i = ws ! j then 0 else f (ws ! i)"
   let ?g = "\<lambda>i. (if \<exists>j<i. (ws @ [a]) ! i = (ws @ [a]) ! j then 0 else f ((ws @ [a]) ! i)) \<cdot>\<^sub>v (ws @ [a]) ! i"
   let ?g2= "(\<lambda>i. (if \<exists>j<i. ws ! i = ws ! j then 0 else f (ws ! i)) \<cdot>\<^sub>v ws ! i)"
   have [simp]: "\<And>v. v \<in> set ws \<Longrightarrow> v \<in> carrier_vec n" using snoc.prems(1) by auto
   then have ws: "set ws \<subseteq> carrier_vec n" by auto
   have hyp: "lincomb f (set ws) = lincomb_list ?f ws"
     by (intro snoc.hyps ws)  
   show ?case
   proof (cases "a\<in>set ws")
     case True    
     have g_length: "?g (length ws) = 0\<^sub>v n" using True
       by (auto, metis in_set_conv_nth nth_append)
     have "(map ?g [0..<length (ws @ [a])]) = (map ?g [0..<length ws]) @ [?g (length ws)]"
        by auto
     also have "... = (map ?g [0..<length ws]) @ [0\<^sub>v n]" using g_length by simp
     finally have map_rw: "(map ?g [0..<length (ws @ [a])]) = (map ?g [0..<length ws]) @ [0\<^sub>v n]" .
     have "M.sumlist (map ?g2 [0..<length ws]) = M.sumlist (map ?g [0..<length ws])"
       by (rule arg_cong[of _ _ "M.sumlist"], intro nth_equalityI, auto simp add: nth_append)
     also have "... =  M.sumlist (map ?g [0..<length ws]) + 0\<^sub>v n "
       by (metis M.r_zero calculation hyp lincomb_closed lincomb_list_def ws)
     also have "... = M.sumlist (map ?g [0..<length ws] @ [0\<^sub>v n])" 
       by (rule M.sumlist_snoc[symmetric], auto simp add: nth_append)
     finally have summlist_rw: "M.sumlist (map ?g2 [0..<length ws]) 
       = M.sumlist (map ?g [0..<length ws] @ [0\<^sub>v n])" .
     have "lincomb f (set (ws @ [a])) = lincomb f (set ws)" using True unfolding lincomb_def
       by (simp add: insert_absorb)
     thus ?thesis 
       unfolding hyp lincomb_list_def map_rw summlist_rw
       by auto
   next
     case False    
     have g_length: "?g (length ws) = f a \<cdot>\<^sub>v a" using False by (auto simp add: nth_append)
     have "(map ?g [0..<length (ws @ [a])]) = (map ?g [0..<length ws]) @ [?g (length ws)]"
        by auto
     also have "... = (map ?g [0..<length ws]) @ [(f a \<cdot>\<^sub>v a)]" using g_length by simp
     finally have map_rw: "(map ?g [0..<length (ws @ [a])]) = (map ?g [0..<length ws]) @ [(f a \<cdot>\<^sub>v a)]" .
     have summlist_rw: "M.sumlist (map ?g2 [0..<length ws]) = M.sumlist (map ?g [0..<length ws])"
       by (rule arg_cong[of _ _ "M.sumlist"], intro nth_equalityI, auto simp add: nth_append)
     have "lincomb f (set (ws @ [a])) = lincomb f (set (a # ws))" by auto
     also have "... = (\<Oplus>\<^bsub>V\<^esub>v\<in>set (a # ws). f v \<cdot>\<^sub>v v)" unfolding lincomb_def ..
     also have "... = (\<Oplus>\<^bsub>V\<^esub>v\<in> insert a (set ws). f v \<cdot>\<^sub>v v)" by simp    
     also have "... = (f a \<cdot>\<^sub>v a) + (\<Oplus>\<^bsub>V\<^esub>v\<in> (set ws). f v \<cdot>\<^sub>v v)"
     proof (rule finsum_insert)
       show "finite (set ws)" by auto
       show "a \<notin> set ws" using False by auto
       show "(\<lambda>v. f v \<cdot>\<^sub>v v) \<in> set ws \<rightarrow> carrier_vec n"
         using snoc.prems(1) by auto
       show "f a \<cdot>\<^sub>v a \<in> carrier_vec n" using snoc.prems by auto
     qed
     also have "... = (f a \<cdot>\<^sub>v a) + lincomb f (set ws)" unfolding lincomb_def ..
     also have "... = (f a \<cdot>\<^sub>v a) + lincomb_list ?f ws" using hyp by auto
     also have "... =  lincomb_list ?f ws  + (f a \<cdot>\<^sub>v a)"
       using M.add.m_comm lincomb_list_carrier snoc.prems by auto
     also have "... = lincomb_list (\<lambda>i. if \<exists>j<i. (ws @ [a]) ! i 
       = (ws @ [a]) ! j then 0 else f ((ws @ [a]) ! i)) (ws @ [a])" 
     proof (unfold lincomb_list_def map_rw summlist_rw, rule M.sumlist_snoc[symmetric])
       show "set (map ?g [0..<length ws]) \<subseteq> carrier_vec n" using snoc.prems
         by (auto simp add: nth_append)
       show "f a \<cdot>\<^sub>v a \<in> carrier_vec n"
         using snoc.prems by auto
     qed
     finally show ?thesis .
   qed
 qed auto
 end
 
 context 
 begin
 
 interpretation vec_module "TYPE(int)" .
 
 lemma lattice_of_cols_as_mat_mult:
   assumes A: "A \<in> carrier_mat n nc" (*Integer matrix*)
   shows "lattice_of (cols A) = {y\<in>carrier_vec (dim_row A). \<exists>x\<in>carrier_vec (dim_col A). A *\<^sub>v x = y}"
 proof -
   let ?ws = "cols A"
   have set_cols_in: "set (cols A) \<subseteq> carrier_vec n" using A unfolding cols_def by auto
   have "lincomb (of_int \<circ> f)(set  ?ws) \<in> carrier_vec (dim_row A)" for f 
     using lincomb_closed A
     by (metis (full_types) carrier_matD(1) cols_dim lincomb_closed)
   moreover have "\<exists>x\<in>carrier_vec (dim_col A). A *\<^sub>v x = lincomb (of_int \<circ> f) (set (cols A))" for f
   proof -    
     let ?g = "(\<lambda>v. of_int (f v))"
     let ?g' = "(\<lambda>i. if \<exists>j<i. ?ws ! i = ?ws ! j then 0 else ?g (?ws ! i))"           
     have "lincomb (of_int \<circ> f) (set (cols A)) = lincomb ?g (set ?ws)" unfolding o_def by auto
     also have "... = lincomb_list ?g' ?ws" 
       by (rule lincomb_as_lincomb_list[OF set_cols_in])
     also have "... = mat_of_cols n ?ws *\<^sub>v vec (length ?ws) ?g'" 
       by (rule lincomb_list_as_mat_mult, insert set_cols_in A, auto)
     also have "... = A *\<^sub>v (vec (length ?ws) ?g')" using mat_of_cols_cols A by auto
     finally show ?thesis by auto
   qed 
   moreover have "\<exists>f. A *\<^sub>v x = lincomb (of_int \<circ> f) (set (cols A))" 
     if Ax: "A *\<^sub>v x \<in> carrier_vec (dim_row A)" and x: "x \<in> carrier_vec (dim_col A)" for x 
   proof -
     let ?c = "\<lambda>i. x $ i"
     have x_vec: "vec (length ?ws) ?c = x" using x by auto
     have "A *\<^sub>v x = mat_of_cols n ?ws *\<^sub>v vec (length ?ws) ?c" using mat_of_cols_cols A x_vec by auto
     also have "... = lincomb_list ?c ?ws"
       by (rule lincomb_list_as_mat_mult[symmetric], insert set_cols_in A, auto)
     also have "... = lincomb (mk_coeff ?ws ?c) (set ?ws)" 
       by (rule lincomb_list_as_lincomb, insert set_cols_in A, auto)    
     finally show ?thesis by auto
   qed
   ultimately show ?thesis unfolding lattice_of_altdef_lincomb[OF set_cols_in]
     by (metis (mono_tags, opaque_lifting))
 qed
 
 
 corollary lattice_of_as_mat_mult:
   assumes fs: "set fs \<subseteq> carrier_vec n"
   shows "lattice_of fs = {y\<in>carrier_vec n. \<exists>x\<in>carrier_vec (length fs). (mat_of_cols n fs) *\<^sub>v x = y}"
 proof -
   have cols_eq: "cols (mat_of_cols n fs) = fs" using cols_mat_of_cols[OF fs] by simp
   have m: "(mat_of_cols n fs) \<in> carrier_mat n (length fs)" using mat_of_cols_carrier(1) by auto
   show ?thesis using lattice_of_cols_as_mat_mult[OF m] unfolding cols_eq using m by auto
 qed
 end
 
 context vec_space
 begin
 
 lemma lin_indpt_cols_imp_det_not_0:
   fixes A::"'a mat"
   assumes A: "A \<in> carrier_mat n n" and li: "lin_indpt (set (cols A))" and d: "distinct (cols A)" 
   shows "det A \<noteq> 0"  
   using A li d det_rank_iff lin_indpt_full_rank by blast
 
 corollary lin_indpt_rows_imp_det_not_0:
   fixes A::"'a mat"
   assumes A: "A \<in> carrier_mat n n" and li: "lin_indpt (set (rows A))" and d: "distinct (rows A)" 
   shows "det A \<noteq> 0"  
   using A li d det_rank_iff lin_indpt_full_rank
   by (metis (full_types) Determinant.det_transpose cols_transpose transpose_carrier_mat)
 end
 
 context LLL
 begin
 
 lemma eq_lattice_imp_mat_mult_invertible_cols:
   assumes fs: "set fs \<subseteq> carrier_vec n"
   and gs: "set gs \<subseteq> carrier_vec n"  and ind_fs: "lin_indep fs" (*fs is a basis*)
   and length_fs: "length fs = n" and length_gs: "length gs = n" (*For the moment, only valid for square matrices*)
   and l: "lattice_of fs = lattice_of gs" 
 shows "\<exists>Q \<in> carrier_mat n n. invertible_mat Q \<and> mat_of_cols n fs = mat_of_cols n gs * Q"
 proof (cases "n=0")
   case True
   show ?thesis
     by (rule bexI[of _ "1\<^sub>m 0"], insert True assms, auto) 
 next
   case False
   hence n: "0<n" by simp
   have ind_RAT_fs: "gs.lin_indpt (set (RAT fs))" using ind_fs
     by (simp add: cof_vec_space.lin_indpt_list_def)
   have fs_carrier: "mat_of_cols n fs \<in> carrier_mat n n" by (simp add: length_fs carrier_matI)
   let ?f = "(\<lambda>i. SOME x. x\<in>carrier_vec (length gs) \<and> (mat_of_cols n gs) *\<^sub>v x = fs ! i)"
   let ?cols_Q = "map ?f [0..<length fs]"
   let ?Q = "mat_of_cols n ?cols_Q"
   show ?thesis
   proof (rule bexI[of _ ?Q], rule conjI)
     show Q: "?Q \<in> carrier_mat n n" using length_fs by auto
     show fs_gs_Q: "mat_of_cols n fs = mat_of_cols n gs * ?Q"
     proof (rule mat_col_eqI)
       fix j assume j: "j < dim_col (mat_of_cols n gs * ?Q)"
       have j2: "j<n" using j Q length_gs by auto
       have fs_j_in_gs: "fs ! j \<in> lattice_of gs" using fs l basis_in_latticeI j by auto
       have fs_j_carrier_vec: "fs ! j \<in> carrier_vec n"
         using fs_j_in_gs gs lattice_of_as_mat_mult by blast      
       let ?x = "SOME x. x\<in>carrier_vec (length gs) \<and> (mat_of_cols n gs) *\<^sub>v x = fs ! j"
       have "?x\<in>carrier_vec (length gs) \<and> (mat_of_cols n gs) *\<^sub>v ?x = fs ! j"
         by (rule someI_ex, insert fs_j_in_gs lattice_of_as_mat_mult[OF gs], auto)
       hence x: "?x \<in> carrier_vec (length gs)"
         and gs_x: "(mat_of_cols n gs) *\<^sub>v ?x = fs ! j" by blast+
       have "col ?Q j = ?cols_Q ! j"
       proof (rule col_mat_of_cols)
         show "j < length (map ?f [0..<length fs])" using length_fs j2 by auto
         have "map ?f [0..<length fs] ! j = ?f ([0..<length fs] ! j)" 
           by (rule nth_map, insert j2 length_fs, auto) 
         also have "... = ?f j" by (simp add: length_fs j2)
         also have "... \<in> carrier_vec n" using x length_gs by auto        
         finally show "map ?f [0..<length fs] ! j \<in> carrier_vec n" .
       qed
       also have "... = ?f ([0..<length fs] ! j)" 
         by (rule nth_map, insert j2 length_fs, auto)
       also have "... = ?x" by (simp add: length_fs j2)
       finally have col_Qj_x: "col ?Q j = ?x" .
       have "col (mat_of_cols n fs) j = fs ! j"
         by (metis (no_types, lifting) j Q fs length_fs carrier_matD(2) cols_mat_of_cols cols_nth
             index_mult_mat(3) mat_of_cols_carrier(3))
       also have "... = (mat_of_cols n gs) *\<^sub>v ?x" using gs_x by auto
       also have "... = (mat_of_cols n gs) *\<^sub>v (col ?Q j)" unfolding col_Qj_x by simp
       also have "... = col (mat_of_cols n gs * ?Q) j"
         by (rule col_mult2[symmetric, OF _ Q j2], insert length_gs mat_of_cols_def, auto)
       finally show "col (mat_of_cols n fs) j = col (mat_of_cols n gs * ?Q) j" .      
     qed (insert length_gs gs, auto)
     show "invertible_mat ?Q"
     (* Sketch of the proof:
       1) fs = gs * Q, proved previously
       2) gs = fs * Q', similar proof as the previous one.
       3) fs = fs * Q' * Q
       4) fs * (?Q' * ?Q - 1\<^sub>m n) = 0\<^sub>m n n and hence (?Q' * ?Q - 1\<^sub>m n) = 0 since fs independent
       5) det ?Q' = det ?Q = det 1 = 1, then det ?Q = \<plusminus>1 and ?Q invertible since the determinant 
          divides a unit.
     *)
     proof -
       let ?f' = "(\<lambda>i. SOME x. x\<in>carrier_vec (length fs) \<and> (mat_of_cols n fs) *\<^sub>v x = gs ! i)"
       let ?cols_Q' = "map ?f' [0..<length gs]"
       let ?Q' = "mat_of_cols n ?cols_Q'"
       have Q': "?Q' \<in> carrier_mat n n" using length_gs by auto
       have gs_fs_Q': "mat_of_cols n gs = mat_of_cols n fs * ?Q'"
       proof (rule mat_col_eqI)
         fix j assume j: "j < dim_col (mat_of_cols n fs * ?Q')"
         have j2: "j<n" using j Q length_gs by auto
         have gs_j_in_fs: "gs ! j \<in> lattice_of fs" using gs l basis_in_latticeI j by auto
         have gs_j_carrier_vec: "gs ! j \<in> carrier_vec n"
           using gs_j_in_fs fs lattice_of_as_mat_mult by blast      
         let ?x = "SOME x. x\<in>carrier_vec (length fs) \<and> (mat_of_cols n fs) *\<^sub>v x = gs ! j"
         have "?x\<in>carrier_vec (length fs) \<and> (mat_of_cols n fs) *\<^sub>v ?x = gs ! j"
           by (rule someI_ex, insert gs_j_in_fs lattice_of_as_mat_mult[OF fs], auto)
         hence x: "?x \<in> carrier_vec (length fs)"
           and fs_x: "(mat_of_cols n fs) *\<^sub>v ?x = gs ! j" by blast+
         have "col ?Q' j = ?cols_Q' ! j"
         proof (rule col_mat_of_cols)
           show "j < length (map ?f' [0..<length gs])" using length_gs j2 by auto
           have "map ?f' [0..<length gs] ! j = ?f' ([0..<length gs] ! j)" 
             by (rule nth_map, insert j2 length_gs, auto) 
           also have "... = ?f' j" by (simp add: length_gs j2)
           also have "... \<in> carrier_vec n" using x length_fs by auto        
           finally show "map ?f' [0..<length gs] ! j \<in> carrier_vec n" .
         qed
         also have "... = ?f' ([0..<length gs] ! j)" 
           by (rule nth_map, insert j2 length_gs, auto)
         also have "... = ?x" by (simp add: length_gs j2)
         finally have col_Qj_x: "col ?Q' j = ?x" .
         have "col (mat_of_cols n gs) j = gs ! j" by (simp add: length_gs gs_j_carrier_vec j2)
         also have "... = (mat_of_cols n fs) *\<^sub>v ?x" using fs_x by auto
         also have "... = (mat_of_cols n fs) *\<^sub>v (col ?Q' j)" unfolding col_Qj_x by simp
         also have "... = col (mat_of_cols n fs * ?Q') j"
           by (rule col_mult2[symmetric, OF _ Q' j2], insert length_fs mat_of_cols_def, auto)
         finally show "col (mat_of_cols n gs) j = col (mat_of_cols n fs * ?Q') j" .      
       qed (insert length_fs fs, auto)
       
       have det_fs_not_zero: "rat_of_int (det (mat_of_cols n fs)) \<noteq> 0"
       proof -
         let ?A = "(of_int_hom.mat_hom (mat_of_cols n fs)):: rat mat"
         have "rat_of_int (det (mat_of_cols n fs)) = det ?A"
           by simp
         moreover have "det ?A \<noteq> 0"
         proof (rule gs.lin_indpt_cols_imp_det_not_0[of ?A])
           have c_eq: "(set (cols ?A)) = set (RAT fs)"
             by (metis assms(3) cof_vec_space.lin_indpt_list_def cols_mat_of_cols fs mat_of_cols_map)
           show "?A \<in> carrier_mat n n" by (simp add: fs_carrier)
           show "gs.lin_indpt (set (cols ?A))" using ind_RAT_fs c_eq by auto
           show "distinct (cols ?A)"
             by (metis ind_fs cof_vec_space.lin_indpt_list_def cols_mat_of_cols fs mat_of_cols_map)
         qed
         ultimately show ?thesis by auto
       qed
       have Q'Q: "?Q' * ?Q \<in> carrier_mat n n" using Q Q' mult_carrier_mat by blast
       have fs_fs_Q'Q: "mat_of_cols n fs = mat_of_cols n fs * ?Q' * ?Q" using gs_fs_Q' fs_gs_Q by presburger
       hence "0\<^sub>m n n = mat_of_cols n fs * ?Q' * ?Q - mat_of_cols n fs" using length_fs by auto
       also have "... = mat_of_cols n fs * ?Q' * ?Q - mat_of_cols n fs * 1\<^sub>m n"
         using fs_carrier by auto
       also have "... = mat_of_cols n fs * (?Q' * ?Q) - mat_of_cols n fs * 1\<^sub>m n"
         using Q Q' fs_carrier by auto
       also have "... = mat_of_cols n fs * (?Q' * ?Q - 1\<^sub>m n)"
         by (rule mult_minus_distrib_mat[symmetric, OF fs_carrier Q'Q], auto)      
       finally have "mat_of_cols n fs * (?Q' * ?Q - 1\<^sub>m n) = 0\<^sub>m n n" ..
       have "det (?Q' * ?Q) = 1"
         by (smt Determinant.det_mult Q Q' Q'Q fs_fs_Q'Q assoc_mult_mat det_fs_not_zero 
             fs_carrier mult_cancel_left2 of_int_code(2))
       hence det_Q'_Q_1: "det ?Q * det ?Q' = 1"
         by (metis (no_types, lifting) Determinant.det_mult Groups.mult_ac(2) Q Q')
       hence "det ?Q = 1 \<or> det ?Q = -1" by (rule pos_zmult_eq_1_iff_lemma)
       thus ?thesis using invertible_iff_is_unit_JNF[OF Q] by fastforce
     qed
   qed
 qed
 
 
 corollary eq_lattice_imp_mat_mult_invertible_rows:
   assumes fs: "set fs \<subseteq> carrier_vec n"
   and gs: "set gs \<subseteq> carrier_vec n"  and ind_fs: "lin_indep fs" (*fs is a basis*)
   and length_fs: "length fs = n" and length_gs: "length gs = n" (*For the moment, only valid for square matrices*)
   and l: "lattice_of fs = lattice_of gs" 
 shows "\<exists>P \<in> carrier_mat n n. invertible_mat P \<and> mat_of_rows n fs = P * mat_of_rows n gs"
 proof -
   obtain Q where Q: "Q \<in> carrier_mat n n" and inv_Q: "invertible_mat Q" 
     and fs_gs_Q: "mat_of_cols n fs = mat_of_cols n gs * Q" 
     using eq_lattice_imp_mat_mult_invertible_cols[OF assms] by auto
   have "invertible_mat Q\<^sup>T" by (simp add: inv_Q invertible_mat_transpose)
   moreover have "mat_of_rows n fs = Q\<^sup>T * mat_of_rows n gs" using fs_gs_Q
     by (metis Matrix.transpose_mult Q length_gs mat_of_cols_carrier(1) transpose_mat_of_cols)
   moreover have "Q\<^sup>T \<in> carrier_mat n n" using Q by auto
   ultimately show ?thesis by blast
 qed
 end
 
 subsubsection \<open>Missing results\<close>
 
 text \<open>This is a new definition for upper triangular matrix, valid for rectangular matrices. 
 This definition will allow us to prove that echelon form implies upper triangular for any matrix.\<close>
 
 definition "upper_triangular' A = (\<forall>i < dim_row A. \<forall> j<dim_col A. j < i \<longrightarrow> A $$ (i,j) = 0)"
 
 lemma upper_triangular'D[elim] :
   "upper_triangular' A \<Longrightarrow> j<dim_col A \<Longrightarrow> j < i \<Longrightarrow> i < dim_row A \<Longrightarrow> A $$ (i,j) = 0"
 unfolding upper_triangular'_def by auto
 
 lemma upper_triangular'I[intro] :
   "(\<And>i j. j<dim_col A \<Longrightarrow> j < i \<Longrightarrow> i < dim_row A \<Longrightarrow> A $$ (i,j) = 0) \<Longrightarrow> upper_triangular' A"
   unfolding upper_triangular'_def by auto
 
 lemma prod_list_abs(*[simp]?*):
   fixes xs:: "int list"
   shows "prod_list (map abs xs) = abs (prod_list xs)"
   by (induct xs, auto simp add: abs_mult)
 
 lemma euclid_ext2_works:
   assumes "euclid_ext2 a b = (p,q,u,v,d)"
   shows "p*a+q*b = d" and "d = gcd a b" and "gcd a b * u = -b" and "gcd a b * v = a"
   and "u = -b div gcd a b" and "v = a div gcd a b"
   using assms unfolding euclid_ext2_def
   by (auto simp add: bezout_coefficients_fst_snd)
 
 lemma res_function_euclidean2: 
   "res_function (\<lambda>b n::'a::{unique_euclidean_ring}. n mod b)"
 proof- 
   have "n mod b = n" if "b=0" for n b::"'a :: unique_euclidean_ring" using that by auto
   hence "res_function_euclidean = (\<lambda>b n::'a. n mod b)" 
     by (unfold fun_eq_iff res_function_euclidean_def, auto)
   thus ?thesis using res_function_euclidean by auto
 qed
 
 lemma mult_row_1_id:
   fixes A:: "'a::semiring_1^'n^'m"
   shows "mult_row A b 1 = A" unfolding mult_row_def by vector
 
 text \<open>Results about appending rows\<close>
 
 lemma row_append_rows1:
   assumes A: "A \<in> carrier_mat m n"
   and B: "B \<in> carrier_mat p n"
   assumes i: "i < dim_row A"
   shows "Matrix.row (A @\<^sub>r B) i = Matrix.row A i"  
 proof (rule eq_vecI)
   have AB_carrier[simp]: "(A @\<^sub>r B) \<in> carrier_mat (m+p) n" by (rule carrier_append_rows[OF A B])
   thus "dim_vec (Matrix.row (A @\<^sub>r B) i) = dim_vec (Matrix.row A i)"
     using A B by (auto, insert carrier_matD(2), blast)
   fix j assume j: "j < dim_vec (Matrix.row A i)" 
   have "Matrix.row (A @\<^sub>r B) i $v j = (A @\<^sub>r B) $$ (i, j)"
     by (metis AB_carrier Matrix.row_def j A carrier_matD(2) index_row(2) index_vec)
   also have "... = (if i < dim_row A then A $$ (i, j) else B $$ (i - m, j))"
     by (rule append_rows_nth, insert assms j, auto)
   also have "... = A$$ (i,j)" using i by simp
   finally show "Matrix.row (A @\<^sub>r B) i $v j = Matrix.row A i $v j" using i j by simp  
 qed
 
 lemma row_append_rows2:
   assumes A: "A \<in> carrier_mat m n"
   and B: "B \<in> carrier_mat p n"
   assumes i: "i \<in> {m..<m+p}"
   shows "Matrix.row (A @\<^sub>r B) i = Matrix.row B (i - m)"
 proof (rule eq_vecI)
   have AB_carrier[simp]: "(A @\<^sub>r B) \<in> carrier_mat (m+p) n" by (rule carrier_append_rows[OF A B])
   thus "dim_vec (Matrix.row (A @\<^sub>r B) i) = dim_vec (Matrix.row B (i-m))"
     using A B by (auto, insert carrier_matD(2), blast)
   fix j assume j: "j < dim_vec (Matrix.row B (i-m))" 
   have "Matrix.row (A @\<^sub>r B) i $v j = (A @\<^sub>r B) $$ (i, j)"
     by (metis AB_carrier Matrix.row_def j B carrier_matD(2) index_row(2) index_vec)
   also have "... = (if i < dim_row A then A $$ (i, j) else B $$ (i - m, j))"
     by (rule append_rows_nth, insert assms j, auto)
   also have "... = B $$ (i - m, j)" using i A by simp
   finally show "Matrix.row (A @\<^sub>r B) i $v j = Matrix.row B (i-m) $v j" using i j A B by auto  
 qed
 
 
 lemma rows_append_rows:
   assumes A: "A \<in> carrier_mat m n"
   and B: "B \<in> carrier_mat p n"
 shows "Matrix.rows (A @\<^sub>r B) = Matrix.rows A @ Matrix.rows B"
 proof -
   have AB_carrier: "(A @\<^sub>r B) \<in> carrier_mat (m+p) n" 
     by (rule carrier_append_rows, insert A B, auto)
   hence 1: "dim_row (A @\<^sub>r B) = dim_row A + dim_row B" using A B by blast
   moreover have "Matrix.row (A @\<^sub>r B) i = (Matrix.rows A @ Matrix.rows B) ! i"
     if i: "i < dim_row (A @\<^sub>r B)" for i
   proof (cases "i<dim_row A")
     case True
     have "Matrix.row (A @\<^sub>r B) i = Matrix.row A i" using A True B row_append_rows1 by blast
     also have "... = Matrix.rows A ! i" unfolding Matrix.rows_def using True by auto
     also have "... = (Matrix.rows A @ Matrix.rows B) ! i" using True by (simp add: nth_append)
     finally show ?thesis .
   next
     case False
     have i_mp: "i < m + p" using AB_carrier A B i by fastforce
     have "Matrix.row (A @\<^sub>r B) i = Matrix.row B (i-m)" using A False B i row_append_rows2 i_mp
       by (smt AB_carrier atLeastLessThan_iff carrier_matD(1) le_add1
           linordered_semidom_class.add_diff_inverse row_append_rows2)
     also have "... = Matrix.rows B ! (i-m)" unfolding Matrix.rows_def using False i A 1 by auto
     also have "... = (Matrix.rows A @ Matrix.rows B) ! (i-m+m)"
       by (metis add_diff_cancel_right' A carrier_matD(1) length_rows not_add_less2 nth_append)
     also have "... =  (Matrix.rows A @ Matrix.rows B) ! i" using False A by auto
     finally show ?thesis .
   qed  
   ultimately show ?thesis unfolding list_eq_iff_nth_eq by auto  
 qed
 
 
 
 lemma append_rows_nth2:
   assumes A': "A' \<in> carrier_mat m n"
   and B: "B \<in> carrier_mat p n"
   and A_def: "A = (A' @\<^sub>r  B)"
   and a: "a<m" and ap: "a < p" and j: "j<n"
   shows "A $$ (a + m, j) = B $$ (a,j)" 
 proof -
   have "A $$ (a + m, j) = (if a + m < dim_row A' then A' $$ (a + m, j) else B $$ (a + m - m, j))"
     unfolding A_def by (rule append_rows_nth[OF A' B _ j], insert ap a, auto)
   also have "... = B $$ (a,j)" using ap a A' by auto
   finally show ?thesis .
 qed
 
 
 lemma append_rows_nth3:
   assumes A': "A' \<in> carrier_mat m n"
   and B: "B \<in> carrier_mat p n"
   and A_def: "A = (A' @\<^sub>r  B)"
   and a: "a\<ge>m" and ap: "a < m + p" and j: "j<n"
   shows "A $$ (a, j) = B $$ (a-m,j)" 
 proof -
   have "A $$ (a, j) = (if a < dim_row A' then A' $$ (a, j) else B $$ (a - m, j))"
     unfolding A_def by (rule append_rows_nth[OF A' B _ j], insert ap a, auto)
   also have "... = B $$ (a-m,j)" using ap a A' by auto
   finally show ?thesis .
 qed
 
 
 text \<open>Results about submatrices\<close>
 
 lemma pick_first_id: assumes i: "i<n" shows "pick {0..<n} i = i"
 proof -
   have "i = (card {a \<in> {0..<n}. a < i})" using i
     by (auto, smt Collect_cong card_Collect_less_nat nat_SN.gt_trans)
   thus ?thesis using pick_card_in_set i
     by (metis atLeastLessThan_iff zero_order(1))
 qed
 
 lemma submatrix_index_id:
   assumes H: "H \<in> carrier_mat m n" and i: "i<k1" and j: "j<k2"
   and k1: "k1\<le>m" and k2: "k2\<le>n"
   shows "(submatrix H {0..<k1} {0..<k2}) $$ (i,j) = H $$ (i,j)" 
 proof -
   let ?I = "{0..<k1}"
   let ?J = "{0..<k2}"
   let ?H = "submatrix H ?I ?J"  
   have km: "k1\<le>m" and kn: "k2\<le>n" using k1 k2 by simp+
   have card_mk: "card {i. i < m \<and> i < k1} = k1" using km 
     by (smt Collect_cong card_Collect_less_nat le_eq_less_or_eq nat_less_induct nat_neq_iff)
   have card_nk: "card {i. i < n \<and> i < k2} = k2" using kn 
     by (smt Collect_cong card_Collect_less_nat le_eq_less_or_eq nat_less_induct nat_neq_iff)
   show ?thesis
   proof- 
     have pick_j: "pick ?J j = j" by (rule pick_first_id[OF j])
     have pick_i: "pick ?I i = i" by (rule pick_first_id[OF i])
     have "submatrix H ?I ?J $$ (i, j) = H $$ (pick ?I i, pick ?J j)" 
       by (rule submatrix_index, insert H i j card_mk card_nk, auto)
     also have "... = H $$ (i,j)" using pick_i pick_j by simp
     finally show ?thesis .
   qed
 qed
 
 lemma submatrix_carrier_first:
   assumes H: "H \<in> carrier_mat m n"
   and k1: "k1 \<le> m" and k2: "k2 \<le> n"
   shows"submatrix H {0..<k1} {0..<k2} \<in> carrier_mat k1 k2"
 proof -  
   have km: "k1\<le>m" and kn: "k2\<le>n" using k1 k2 by simp+
   have card_mk: "card {i. i < m \<and> i < k1} = k1" using km 
     by (smt Collect_cong card_Collect_less_nat le_eq_less_or_eq nat_less_induct nat_neq_iff)
   have card_nk: "card {i. i < n \<and> i < k2} = k2" using kn 
     by (smt Collect_cong card_Collect_less_nat le_eq_less_or_eq nat_less_induct nat_neq_iff)
   show ?thesis
     by (smt Collect_cong H atLeastLessThan_iff card_mk card_nk carrier_matD 
         carrier_matI dim_submatrix zero_order(1))
 qed
 
 
 
 lemma Units_eq_invertible_mat:
   assumes "A \<in> carrier_mat n n"
   shows "A \<in> Group.Units (ring_mat TYPE('a::comm_ring_1) n b) = invertible_mat A" (is "?lhs = ?rhs")
 proof -
   interpret m: ring "ring_mat TYPE('a) n b" by (rule ring_mat)
   show ?thesis
   proof
     assume "?lhs" thus "?rhs"
       unfolding Group.Units_def 
       by (insert assms, auto simp add: ring_mat_def invertible_mat_def inverts_mat_def)
   next
     assume "?rhs" 
     from this obtain B where AB: "A * B = 1\<^sub>m n" and BA: "B * A = 1\<^sub>m n" and B: "B \<in> carrier_mat n n"
       by (metis assms carrier_matD(1) inverts_mat_def obtain_inverse_matrix)
     hence "\<exists>x\<in>carrier (ring_mat TYPE('a) n b). x \<otimes>\<^bsub>ring_mat TYPE('a) n b\<^esub> A = \<one>\<^bsub>ring_mat TYPE('a) n b\<^esub> 
       \<and> A \<otimes>\<^bsub>ring_mat TYPE('a) n b\<^esub> x = \<one>\<^bsub>ring_mat TYPE('a) n b\<^esub>"
       unfolding ring_mat_def by auto
     thus "?lhs" unfolding Group.Units_def using assms unfolding ring_mat_def by auto
   qed
 qed
 
 lemma map_first_rows_index:
   assumes "A \<in> carrier_mat M n" and "m \<le> M" and "i<m" and "ja<n"
   shows "map (Matrix.row A) [0..<m] ! i $v ja = A $$ (i, ja)"
   using assms by auto
 
 lemma matrix_append_rows_eq_if_preserves:
   assumes A: "A \<in> carrier_mat (m+p) n" and B: "B \<in> carrier_mat p n"
     and eq: "\<forall>i\<in>{m..<m+p}.\<forall>j<n. A$$(i,j) = B $$ (i-m,j)"
   shows "A = mat_of_rows n [Matrix.row A i. i \<leftarrow> [0..<m]] @\<^sub>r B" (is "_ = ?A' @\<^sub>r _")
 proof (rule eq_matI)
   have A': "?A' \<in> carrier_mat m n" by (simp add: mat_of_rows_def)
   hence A'B: "?A' @\<^sub>r B \<in> carrier_mat (m+p) n" using B by blast
   show "dim_row A = dim_row (?A' @\<^sub>r B)" and "dim_col A = dim_col (?A' @\<^sub>r B)" using A'B A by auto
   fix i j assume i: "i < dim_row (?A' @\<^sub>r B)"
     and j: "j < dim_col (?A' @\<^sub>r B)" 
   have jn: "j<n" using A
     by (metis append_rows_def dim_col_mat(1) index_mat_four_block(3) index_zero_mat(3) 
         j mat_of_rows_def nat_arith.rule0)
   let ?xs = "(map (Matrix.row A) [0..<m])"
   show "A $$ (i, j) = (?A' @\<^sub>r B) $$ (i, j)"
   proof (cases "i<m")
     case True
     have "(?A' @\<^sub>r B) $$ (i, j) = ?A' $$ (i,j)"      
       by (metis (no_types, lifting) Nat.add_0_right True append_rows_def diff_zero i 
           index_mat_four_block index_zero_mat(3) j length_map length_upt mat_of_rows_carrier(2))
     also have "... = ?xs ! i $v j" 
       by (rule mat_of_rows_index, insert i True j, auto simp add: append_rows_def)
     also have "... = A $$ (i,j)"
       by (rule map_first_rows_index, insert assms A True i jn, auto)
     finally show ?thesis ..
   next
     case False
     have "(?A' @\<^sub>r B) $$ (i, j) = B $$ (i-m,j)"      
       by (smt (z3) A' carrier_matD(1) False append_rows_def i index_mat_four_block j jn length_map
           length_upt mat_of_rows_carrier(2,3))
     also have "... = A $$ (i,j)"
       by (metis False append_rows_def B eq atLeastLessThan_iff carrier_matD(1) diff_zero i 
           index_mat_four_block(2) index_zero_mat(2) jn le_add1 length_map length_upt 
           linordered_semidom_class.add_diff_inverse mat_of_rows_carrier(2))
     finally show ?thesis ..
   qed
 qed
 
 lemma invertible_mat_first_column_not0:
   fixes A::"'a :: comm_ring_1 mat"
   assumes A: "A \<in> carrier_mat n n" and inv_A: "invertible_mat A" and n0: "0<n"
   shows "col A 0 \<noteq> (0\<^sub>v n)"
 proof (rule ccontr)
   assume " \<not> col A 0 \<noteq> 0\<^sub>v n" hence col_A0: "col A 0 = 0\<^sub>v n" by simp
   have "(det A dvd 1)" using inv_A invertible_iff_is_unit_JNF[OF A] by auto
   hence 1: "det A \<noteq> 0" by auto
   have "det A = (\<Sum>i<n. A $$ (i, 0) * Determinant.cofactor A i 0)" 
     by (rule laplace_expansion_column[OF A n0])
   also have "... = 0" 
     by (rule sum.neutral, insert col_A0 n0 A, auto simp add: col_def,
         metis Matrix.zero_vec_def index_vec mult_zero_left)
   finally show False using 1 by contradiction 
 qed
 
 lemma invertible_mat_mult_int:
   assumes "A = P * B" 
     and "P \<in> carrier_mat n n"
     and "B \<in> carrier_mat n n"
     and "invertible_mat P" 
     and "invertible_mat (map_mat rat_of_int B)"
   shows "invertible_mat (map_mat rat_of_int A)"
   by (metis (no_types, opaque_lifting) assms dvd_field_iff 
       invertible_iff_is_unit_JNF invertible_mult_JNF map_carrier_mat not_is_unit_0 
       of_int_hom.hom_0 of_int_hom.hom_det of_int_hom.mat_hom_mult)
 
 
 lemma echelon_form_JNF_intro: 
   assumes "(\<forall>i<dim_row A. is_zero_row_JNF i A \<longrightarrow> \<not> (\<exists>j. j < dim_row A \<and> j>i \<and> \<not> is_zero_row_JNF j A))"
   and "(\<forall>i j. i<j \<and> j<dim_row A \<and> \<not> (is_zero_row_JNF i A) \<and> \<not> (is_zero_row_JNF j A) 
          \<longrightarrow> ((LEAST n. A $$ (i, n) \<noteq> 0) < (LEAST n. A $$ (j, n) \<noteq> 0)))"
   shows "echelon_form_JNF A" using assms unfolding echelon_form_JNF_def by simp
 
 
 lemma echelon_form_submatrix:
   assumes ef_H: "echelon_form_JNF H" and H: "H \<in> carrier_mat m n"
   and k: "k \<le> min m n"
 shows "echelon_form_JNF (submatrix H {0..<k} {0..<k})" 
 proof -
   let ?I = "{0..<k}"
   let ?H = "submatrix H ?I ?I"  
   have km: "k\<le>m" and kn: "k\<le>n" using k by simp+
   have card_mk: "card {i. i < m \<and> i < k} = k" using km 
     by (smt Collect_cong card_Collect_less_nat le_eq_less_or_eq nat_less_induct nat_neq_iff)
   have card_nk: "card {i. i < n \<and> i < k} = k" using kn 
     by (smt Collect_cong card_Collect_less_nat le_eq_less_or_eq nat_less_induct nat_neq_iff)
   have H_ij: "H $$ (i,j) = (submatrix H ?I ?I) $$ (i,j)"  if i: "i<k" and j: "j<k" for i j
   proof- 
     have pick_j: "pick ?I j = j" by (rule pick_first_id[OF j])
     have pick_i: "pick ?I i = i" by (rule pick_first_id[OF i])
     have "submatrix H ?I ?I $$ (i, j) = H $$ (pick ?I i, pick ?I j)" 
       by (rule submatrix_index, insert H i j card_mk card_nk, auto)
     also have "... = H $$ (i,j)" using pick_i pick_j by simp
     finally show ?thesis ..
   qed
   have H'[simp]: "?H \<in> carrier_mat k k" 
     using H dim_submatrix[of H "{0..<k}" "{0..<k}"] card_mk card_nk by auto
   show ?thesis
   proof (rule echelon_form_JNF_intro, auto)   
     fix i j assume iH'_0: "is_zero_row_JNF i ?H" and ij: "i < j" and j: "j < dim_row ?H"  
     have jm: "j<m"
       by (metis H' carrier_matD(1) j km le_eq_less_or_eq nat_SN.gt_trans)
     show "is_zero_row_JNF j ?H"
     proof (rule ccontr)
       assume j_not0_H': "\<not> is_zero_row_JNF j ?H"
       define a where "a = (LEAST n. ?H $$ (j,n) \<noteq> 0)"
       have H'_ja: "?H $$ (j,a) \<noteq> 0" 
         by (metis (mono_tags) LeastI j_not0_H' a_def is_zero_row_JNF_def)
       have a: "a < dim_col ?H"
         by (smt j_not0_H' a_def is_zero_row_JNF_def linorder_neqE_nat not_less_Least order_trans_rules(19))
       have j_not0_H: "\<not> is_zero_row_JNF j H"
         by (metis H' H'_ja H_ij a assms(2) basic_trans_rules(19) carrier_matD is_zero_row_JNF_def j kn le_eq_less_or_eq)
       hence i_not0_H: "\<not> is_zero_row_JNF i H" using ef_H j ij unfolding echelon_form_JNF_def
         by (metis H' \<open>\<not> is_zero_row_JNF j H\<close> assms(2) carrier_matD(1) ij j km 
             not_less_iff_gr_or_eq order.strict_trans order_trans_rules(21))
       hence least_ab: "(LEAST n. H $$ (i, n) \<noteq> 0) < (LEAST n. H $$ (j, n) \<noteq> 0)" using jm
         using j_not0_H assms(2) echelon_form_JNF_def ef_H ij by blast
       define b where "b = (LEAST n. H $$ (i, n) \<noteq> 0)"
       have H_ib: "H $$ (i, b) \<noteq> 0"
         by (metis (mono_tags, lifting) LeastI b_def i_not0_H is_zero_row_JNF_def)
       have b: "b < dim_col ?H" using least_ab a unfolding a_def b_def
         by (metis (mono_tags, lifting) H' H'_ja H_ij a_def carrier_matD dual_order.strict_trans j nat_neq_iff not_less_Least)
       have H'_ib: "?H $$ (i,b) \<noteq> 0" using H_ib b H_ij H' ij j 
         by (metis H' carrier_matD dual_order.strict_trans ij j)
       hence "\<not> is_zero_row_JNF i ?H" using b is_zero_row_JNF_def by blast
       thus False using iH'_0 by contradiction
     qed  
   next
     fix i j assume ij: "i < j" and j: "j < dim_row ?H"
     have jm: "j<m"
       by (metis H' carrier_matD(1) j km le_eq_less_or_eq nat_SN.gt_trans)
     assume not0_iH': "\<not> is_zero_row_JNF i ?H"
       and not0_jH': "\<not> is_zero_row_JNF j ?H"
     define a where "a = (LEAST n. ?H $$ (i, n) \<noteq> 0)"
     define b where "b = (LEAST n. ?H $$ (j, n) \<noteq> 0)"
     have H'_ia: "?H $$ (i,a) \<noteq> 0"
       by (metis (mono_tags) LeastI_ex a_def is_zero_row_JNF_def not0_iH')
     have H'_jb: "?H $$ (j,b) \<noteq> 0"
       by (metis (mono_tags) LeastI_ex b_def is_zero_row_JNF_def not0_jH')
     have a: "a < dim_row ?H"
       by (smt H' a_def carrier_matD is_zero_row_JNF_def less_trans linorder_neqE_nat not0_iH' not_less_Least)
     have b: "b < dim_row ?H"
       by (smt H' b_def carrier_matD is_zero_row_JNF_def less_trans linorder_neqE_nat not0_jH' not_less_Least)
     have a_eq: "a = (LEAST n. H $$ (i, n) \<noteq> 0)"
       by (smt H' H'_ia H_ij LeastI_ex a a_def carrier_matD(1) ij j linorder_neqE_nat not_less_Least order_trans_rules(19))
     have b_eq: "b = (LEAST n. H $$ (j, n) \<noteq> 0)"
       by (smt H' H'_jb H_ij LeastI_ex b b_def carrier_matD(1) ij j linorder_neqE_nat not_less_Least order_trans_rules(19)) 
     have not0_iH: "\<not> is_zero_row_JNF i H" 
       by (metis H' H'_ia H_ij a H carrier_matD ij is_zero_row_JNF_def j kn le_eq_less_or_eq order.strict_trans)
     have not0_jH: "\<not> is_zero_row_JNF j H" 
       by (metis H' H'_jb H_ij b H carrier_matD is_zero_row_JNF_def j kn le_eq_less_or_eq order.strict_trans)
     show "(LEAST n. ?H $$ (i, n) \<noteq> 0) < (LEAST n. ?H $$ (j, n) \<noteq> 0)"
       unfolding a_def[symmetric] b_def[symmetric] a_eq b_eq using not0_iH not0_jH ef_H ij jm H 
       unfolding echelon_form_JNF_def by auto
   qed
 qed
 
 
 lemma HNF_submatrix:
   assumes HNF_H: "Hermite_JNF associates res H" and H: "H \<in> carrier_mat m n"
   and k: "k \<le> min m n"
   shows "Hermite_JNF associates res (submatrix H {0..<k} {0..<k})" 
 proof -
   let ?I = "{0..<k}"
   let ?H = "submatrix H ?I ?I"  
   have km: "k\<le>m" and kn: "k\<le>n" using k by simp+
   have card_mk: "card {i. i < m \<and> i < k} = k" using km 
     by (smt Collect_cong card_Collect_less_nat le_eq_less_or_eq nat_less_induct nat_neq_iff)
   have card_nk: "card {i. i < n \<and> i < k} = k" using kn 
     by (smt Collect_cong card_Collect_less_nat le_eq_less_or_eq nat_less_induct nat_neq_iff)
   have H_ij: "H $$ (i,j) = (submatrix H ?I ?I) $$ (i,j)"  if i: "i<k" and j: "j<k" for i j
   proof- 
     have pick_j: "pick ?I j = j" by (rule pick_first_id[OF j])
     have pick_i: "pick ?I i = i" by (rule pick_first_id[OF i])
     have "submatrix H ?I ?I $$ (i, j) = H $$ (pick ?I i, pick ?I j)" 
       by (rule submatrix_index, insert H i j card_mk card_nk, auto)
     also have "... = H $$ (i,j)" using pick_i pick_j by simp
     finally show ?thesis ..
   qed
   have H'[simp]: "?H \<in> carrier_mat k k" 
     using H dim_submatrix[of H "{0..<k}" "{0..<k}"] card_mk card_nk by auto
   have CS_ass: "Complete_set_non_associates associates" using HNF_H unfolding Hermite_JNF_def by simp
   moreover have CS_res: "Complete_set_residues res"  using HNF_H unfolding Hermite_JNF_def by simp
   have ef_H: "echelon_form_JNF H" using HNF_H unfolding Hermite_JNF_def by auto
   have ef_H': "echelon_form_JNF ?H"
     by (rule echelon_form_submatrix[OF ef_H H k])
   have HNF1: "?H $$ (i, LEAST n. ?H $$ (i, n) \<noteq> 0) \<in> associates" 
     and HNF2: "(\<forall>j<i. ?H $$ (j, LEAST n. ?H $$ (i, n) \<noteq> 0)
                \<in> res (?H $$ (i, LEAST n. ?H $$ (i, n) \<noteq> 0)))"
     if i: "i<dim_row ?H" and not0_iH': "\<not> is_zero_row_JNF i ?H" for i
   proof -
     define a where "a = (LEAST n. ?H $$ (i, n) \<noteq> 0)"
     have im: "i<m"
       by (metis H' carrier_matD(1) km order.strict_trans2 that(1))
     have H'_ia: "?H $$ (i,a) \<noteq> 0"
       by (metis (mono_tags) LeastI_ex a_def is_zero_row_JNF_def not0_iH')
     have a: "a < dim_row ?H"
       by (smt H' a_def carrier_matD is_zero_row_JNF_def less_trans linorder_neqE_nat not0_iH' not_less_Least)
     have a_eq: "a = (LEAST n. H $$ (i, n) \<noteq> 0)"
       by (smt H' H'_ia H_ij LeastI_ex a a_def carrier_matD(1) i linorder_neqE_nat not_less_Least order_trans_rules(19))
     have H'_ia_H_ia: "?H $$ (i, a) = H $$ (i, a)"  by (metis H' H_ij a carrier_matD(1) i)
     have not'_iH: "\<not> is_zero_row_JNF i H"
       by (metis H' H'_ia H'_ia_H_ia a assms(2) carrier_matD(1) carrier_matD(2) is_zero_row_JNF_def kn order.strict_trans2)
     thus "?H $$ (i, LEAST n. ?H $$ (i, n) \<noteq> 0) \<in> associates" using im
       by (metis H'_ia_H_ia Hermite_JNF_def a_def a_eq HNF_H H carrier_matD(1))
     show "(\<forall>j<i. ?H $$ (j, LEAST n. ?H $$ (i, n) \<noteq> 0)
                \<in> res (?H $$ (i, LEAST n. ?H $$ (i, n) \<noteq> 0)))" 
     proof -
       { fix nn :: nat
     have ff1: "\<forall>n. ?H $$ (n, a) = H $$ (n, a) \<or> \<not> n < k"
       by (metis (no_types) H' H_ij a carrier_matD(1))
       have ff2: "i < k"
     by (metis H' carrier_matD(1) that(1))
     then have "H $$ (nn, a) \<in> res (H $$ (i, a)) \<longrightarrow> H $$ (nn, a) \<in> res (?H $$ (i, a))"
     using ff1 by (metis (no_types))
       moreover
       { assume "H $$ (nn, a) \<in> res (?H $$ (i, a))"
         then have "?H $$ (nn, a) = H $$ (nn, a) \<longrightarrow> ?H $$ (nn, a) \<in> res (?H $$ (i, a))"
             by presburger
           then have "\<not> nn < i \<or> ?H $$ (nn, LEAST n. ?H $$ (i, n) \<noteq> 0) \<in> res (?H $$ (i, LEAST n. ?H $$ (i, n) \<noteq> 0))"
             using ff2 ff1 a_def order.strict_trans by blast }
         ultimately have "\<not> nn < i \<or> ?H $$ (nn, LEAST n. ?H $$ (i, n) \<noteq> 0) \<in> res (?H $$ (i, LEAST n. ?H $$ (i, n) \<noteq> 0))"
           using Hermite_JNF_def a_eq assms(1) assms(2) im not'_iH by blast }
       then show ?thesis
         by meson
     qed
   qed
   show ?thesis using HNF1 HNF2 ef_H' CS_res CS_ass unfolding Hermite_JNF_def by blast
 qed
 
 lemma HNF_of_HNF_id:
   fixes H :: "int mat"
   assumes HNF_H: "Hermite_JNF associates res H"
   and H: "H \<in> carrier_mat n n"
   and H_P1_H1: "H = P1 * H1"
   and inv_P1: "invertible_mat P1"
   and H1: "H1 \<in> carrier_mat n n" 
   and P1: "P1 \<in> carrier_mat n n"
   and HNF_H1: "Hermite_JNF associates res H1"
   and inv_H: "invertible_mat (map_mat rat_of_int H)"
   shows "H1 = H" 
 proof (rule HNF_unique_generalized_JNF[OF H P1 H1 _ H H_P1_H1])   
   show "H = (1\<^sub>m n) * H" using H by auto  
 qed (insert assms, auto)
 
 
 (*Some of the following lemmas could be moved outside this context*)
 
 context
   fixes n :: nat
 begin
 
 interpretation vec_module "TYPE(int)" .        
 
 lemma lattice_is_monotone:
   fixes S T
   assumes S: "set S \<subseteq> carrier_vec n"
   assumes T: "set T \<subseteq> carrier_vec n"
   assumes subs: "set S \<subseteq> set T"
   shows "lattice_of S \<subseteq> lattice_of T"
 proof -
   have "\<exists>fa. lincomb fa (set T) = lincomb f (set S)" for f
   proof -
     let ?f = "\<lambda>i. if i \<in> set T - set S then 0 else f i"
     have set_T_eq: "set T = set S \<union> (set T - set S)" using subs by blast
     have l0: "lincomb ?f (set T - set S) = 0\<^sub>v n" by (rule lincomb_zero, insert T, auto)
     have "lincomb ?f (set T) = lincomb ?f (set S \<union> (set T - set S))" using set_T_eq by simp
     also have "... = lincomb ?f (set S) + lincomb ?f (set T - set S)"
       by (rule lincomb_union, insert S T subs, auto)
     also have "... = lincomb ?f (set S)" using l0 by (auto simp add: S)
     also have "... = lincomb f (set S)" using S by fastforce
     finally show ?thesis by blast    
   qed
   thus ?thesis unfolding lattice_of_altdef_lincomb[OF S] lattice_of_altdef_lincomb[OF T]
     by auto
 qed
 
 lemma lattice_of_append:
   assumes fs: "set fs \<subseteq> carrier_vec n"
   assumes gs: "set gs \<subseteq> carrier_vec n" 
   shows "lattice_of (fs @ gs) = lattice_of (gs @ fs)"
 proof -
   have fsgs: "set (fs @ gs) \<subseteq> carrier_vec n" using fs gs by auto
   have gsfs: "set (gs @ fs) \<subseteq> carrier_vec n" using fs gs by auto
   show ?thesis
     unfolding lattice_of_altdef_lincomb[OF fsgs] lattice_of_altdef_lincomb[OF gsfs] 
     by auto (metis Un_commute)+
 qed
 
 lemma lattice_of_append_cons:
   assumes fs: "set fs \<subseteq> carrier_vec n"   and v: "v \<in> carrier_vec n"
   shows "lattice_of (v # fs) = lattice_of (fs @ [v])"
 proof -
   have v_fs: "set (v # fs) \<subseteq> carrier_vec n" using fs v by auto
   hence fs_v: "set (fs @ [v]) \<subseteq> carrier_vec n" by simp
   show ?thesis
     unfolding lattice_of_altdef_lincomb[OF v_fs] lattice_of_altdef_lincomb[OF fs_v] by auto
 qed
 
 lemma already_in_lattice_subset:
   assumes fs: "set fs \<subseteq> carrier_vec n" and inlattice: "v \<in> lattice_of fs"
   and v: "v \<in> carrier_vec n"
   shows "lattice_of (v # fs) \<subseteq> lattice_of fs"
 proof (cases "v\<in>set fs")
   case True
   then show ?thesis
     by (metis fs lattice_is_monotone set_ConsD subset_code(1))
 next
   case False note v_notin_fs = False  
   obtain g where v_g: "lincomb g (set fs) = v"
     using lattice_of_altdef_lincomb[OF fs] inlattice by auto
   have v_fs: "set (v # fs) \<subseteq> carrier_vec n" using v fs by auto
   have "\<exists>fa. lincomb fa (set fs) = lincomb f (insert v (set fs))" for f
   proof -
     have smult_rw: "f v \<cdot>\<^sub>v (lincomb g (set fs)) = lincomb (\<lambda>w. f v * g w) (set fs)" 
       by (rule lincomb_smult[symmetric, OF fs])
     have "lincomb f (insert v (set fs)) =  f v \<cdot>\<^sub>v v + lincomb f (set fs)" 
       by (rule lincomb_insert2[OF _ fs _ v_notin_fs v], auto)
     also have "... = f v \<cdot>\<^sub>v (lincomb g (set fs)) + lincomb f (set fs)" using v_g by simp
     also have "... = lincomb (\<lambda>w. f v * g w) (set fs)  + lincomb f (set fs)"
       unfolding smult_rw by auto
     also have "... = lincomb (\<lambda>w. (\<lambda>w. f v * g w) w + f w) (set fs)"
       by (rule lincomb_sum[symmetric, OF _ fs], simp)
     finally show ?thesis by auto
   qed
   thus ?thesis unfolding lattice_of_altdef_lincomb[OF v_fs] lattice_of_altdef_lincomb[OF fs] by auto
 qed
 
 
 lemma already_in_lattice:
   assumes fs: "set fs \<subseteq> carrier_vec n" and inlattice: "v \<in> lattice_of fs"
   and v: "v \<in> carrier_vec n"
   shows "lattice_of fs = lattice_of (v # fs)"
 proof - 
   have dir1: "lattice_of fs \<subseteq> lattice_of (v # fs)"
     by (intro lattice_is_monotone, insert fs v, auto)
   moreover have dir2: "lattice_of (v # fs) \<subseteq> lattice_of fs"
     by (rule already_in_lattice_subset[OF assms])
   ultimately show ?thesis by auto
 qed
 
 
 lemma already_in_lattice_append:
   assumes fs: "set fs \<subseteq> carrier_vec n" and inlattice: "lattice_of gs \<subseteq> lattice_of fs"
   and gs: "set gs \<subseteq> carrier_vec n"
 shows "lattice_of fs = lattice_of (fs @ gs)"
   using assms
 proof (induct gs arbitrary: fs)
   case Nil
   then show ?case by auto
 next
   case (Cons a gs)
   note fs = Cons.prems(1)
   note inlattice = Cons.prems(2)
   note gs = Cons.prems(3)
   have gs_in_fs: "lattice_of gs \<subseteq> lattice_of fs"
     by (meson basic_trans_rules(23) gs lattice_is_monotone local.Cons(3) set_subset_Cons)
   have a: "a \<in> lattice_of (fs @ gs)"
     using basis_in_latticeI fs gs gs_in_fs local.Cons(1) local.Cons(3) by auto
   have "lattice_of (fs @ a # gs) = lattice_of ((a # gs) @ fs)"
     by (rule lattice_of_append, insert fs gs, auto) 
   also have "... = lattice_of (a # (gs @ fs))" by auto
   also have "... = lattice_of (a # (fs @ gs))"
     by (rule lattice_of_eq_set, insert gs fs, auto)
   also have "... = lattice_of (fs @ gs)"
     by (rule already_in_lattice[symmetric, OF _ a], insert fs gs, auto)
   also have "... = lattice_of fs" by (rule Cons.hyps[symmetric, OF fs gs_in_fs], insert gs, auto)     
   finally show ?case ..
 qed
 
 lemma zero_in_lattice:
   assumes fs_carrier: "set fs \<subseteq> carrier_vec n"
   shows "0\<^sub>v n \<in> lattice_of fs"
 proof - 
   have "\<forall>f. lincomb (\<lambda>v. 0 * f v) (set fs) = 0\<^sub>v n"
       using fs_carrier lincomb_closed lincomb_smult lmult_0 by presburger
   hence "lincomb (\<lambda>i. 0) (set fs) = 0\<^sub>v n" by fastforce 
   thus ?thesis unfolding lattice_of_altdef_lincomb[OF fs_carrier] by auto
 qed
 
 
 lemma lattice_zero_rows_subset:
   assumes H: "H \<in> carrier_mat a n"
   shows "lattice_of (Matrix.rows (0\<^sub>m m n)) \<subseteq> lattice_of (Matrix.rows H)"
 proof 
   let ?fs = "Matrix.rows (0\<^sub>m m n)"
   let ?gs = "Matrix.rows H"
   have fs_carrier: "set ?fs \<subseteq> carrier_vec n" unfolding Matrix.rows_def by auto
   have gs_carrier: "set ?gs \<subseteq> carrier_vec n" using H unfolding Matrix.rows_def by auto
   fix x assume x: "x \<in> lattice_of (Matrix.rows (0\<^sub>m m n))"
   obtain f where fx: "lincomb (of_int \<circ> f) (set (Matrix.rows (0\<^sub>m m n))) = x"
     using x lattice_of_altdef_lincomb[OF fs_carrier] by blast
   have "lincomb (of_int \<circ> f) (set (Matrix.rows (0\<^sub>m m n))) = 0\<^sub>v n"
     unfolding lincomb_def by (rule M.finsum_all0, unfold Matrix.rows_def, auto)
   hence "x = 0\<^sub>v n" using fx by auto
   thus "x \<in> lattice_of (Matrix.rows H)" using zero_in_lattice[OF gs_carrier] by auto 
 qed
 
 (*TODO: move outside this context (the previous lemmas too)*)
 lemma lattice_of_append_zero_rows:
   assumes H': "H' \<in> carrier_mat m n"
   and H: "H = H' @\<^sub>r (0\<^sub>m m n)"
 shows "lattice_of (Matrix.rows H) = lattice_of (Matrix.rows H')"
 proof -
   have "Matrix.rows H = Matrix.rows H' @ Matrix.rows (0\<^sub>m m n)"
     by (unfold H, rule rows_append_rows[OF H'], auto)
   also have "lattice_of ... = lattice_of (Matrix.rows H')"
   proof (rule already_in_lattice_append[symmetric])
     show "lattice_of (Matrix.rows (0\<^sub>m m n)) \<subseteq> lattice_of (Matrix.rows H')"
       by (rule lattice_zero_rows_subset[OF H'])
   qed (insert H', auto simp add: Matrix.rows_def)
   finally show ?thesis .
 qed
 end
 
 text \<open>Lemmas about echelon form\<close>
 
 lemma echelon_form_JNF_1xn:
   assumes "A\<in>carrier_mat m n" and "m<2"  
 shows "echelon_form_JNF A"
   using assms unfolding echelon_form_JNF_def is_zero_row_JNF_def by fastforce
 
 
 lemma echelon_form_JNF_mx1:
   assumes "A\<in>carrier_mat m n" and "n<2"
   and "\<forall>i \<in> {1..<m}. A$$(i,0) = 0"
 shows "echelon_form_JNF A"
   using assms unfolding echelon_form_JNF_def is_zero_row_JNF_def
     using atLeastLessThan_iff less_2_cases by fastforce
 
 
 lemma echelon_form_mx0:
   assumes "A \<in> carrier_mat m 0"
   shows "echelon_form_JNF A" using assms unfolding echelon_form_JNF_def is_zero_row_JNF_def by auto
 
 lemma echelon_form_JNF_first_column_0:
   assumes eA: "echelon_form_JNF A" and A: "A \<in> carrier_mat m n"
     and i0: "0<i" and im: "i<m" and n0: "0<n"
   shows "A $$ (i,0) =0"
 proof (rule ccontr)
   assume Ai0: "A $$ (i, 0) \<noteq> 0"
   hence nz_iA:  "\<not> is_zero_row_JNF i A" using n0 A unfolding is_zero_row_JNF_def by auto
   hence nz_0A: "\<not> is_zero_row_JNF 0 A" using eA A unfolding echelon_form_JNF_def using i0 im by auto
   have "(LEAST n. A $$ (0, n) \<noteq> 0) < (LEAST n. A $$ (i, n) \<noteq> 0)"
     using nz_iA nz_0A eA A unfolding echelon_form_JNF_def using i0 im by blast
   moreover have "(LEAST n. A $$ (i, n) \<noteq> 0) = 0" using Ai0 by simp
   ultimately show False by auto
 qed
 
 
 lemma is_zero_row_JNF_multrow[simp]: 
   fixes A::"'a::comm_ring_1 mat"
   assumes "i<dim_row A"
   shows "is_zero_row_JNF i (multrow j (- 1) A) = is_zero_row_JNF i A"
   using assms unfolding is_zero_row_JNF_def by auto
 
 lemma echelon_form_JNF_multrow:
   assumes "A : carrier_mat m n" and "i<m" and eA: "echelon_form_JNF A"
   shows "echelon_form_JNF (multrow i (- 1) A)"
 proof (rule echelon_form_JNF_intro)
   have "A $$ (j, ja) = 0" if  "\<forall>j'<dim_col A. A $$ (ia, j') = 0" 
     and iaj: "ia < j" and j: "j < dim_row A" and ja: "ja < dim_col A" for ia j ja
     using assms that unfolding echelon_form_JNF_def is_zero_row_JNF_def 
     by (meson order.strict_trans) 
   thus " \<forall>ia<dim_row (multrow i (- 1) A). is_zero_row_JNF ia (multrow i (- 1) A) 
       \<longrightarrow> \<not> (\<exists>j<dim_row (multrow i (- 1) A). ia < j \<and> \<not> is_zero_row_JNF j (multrow i (- 1) A))"
     unfolding is_zero_row_JNF_def by simp 
   have Least_eq: "(LEAST n. multrow i (- 1) A $$ (ia, n) \<noteq> 0) = (LEAST n. A $$ (ia, n) \<noteq> 0)"
     if ia: "ia < dim_row A" and nz_ia_mrA: "\<not> is_zero_row_JNF ia (multrow i (- 1) A)" for ia
   proof (rule Least_equality)
     have nz_ia_A: "\<not> is_zero_row_JNF ia A" using nz_ia_mrA ia by auto
     have Least_Aian_n: "(LEAST n. A $$ (ia, n) \<noteq> 0) < dim_col A"
       by (smt dual_order.strict_trans is_zero_row_JNF_def not_less_Least not_less_iff_gr_or_eq nz_ia_A)
     show "multrow i (- 1) A $$ (ia, LEAST n. A $$ (ia, n) \<noteq> 0) \<noteq> 0"
       by (smt LeastI Least_Aian_n class_cring.cring_simprules(22) equation_minus_iff ia
           index_mat_multrow(1) is_zero_row_JNF_def mult_minus1 nz_ia_A)
     show " \<And>y. multrow i (- 1) A $$ (ia, y) \<noteq> 0 \<Longrightarrow> (LEAST n. A $$ (ia, n) \<noteq> 0) \<le> y"
       by (metis (mono_tags, lifting) Least_Aian_n class_cring.cring_simprules(22) ia 
           index_mat_multrow(1) leI mult_minus1 order.strict_trans wellorder_Least_lemma(2))
   qed
   have "(LEAST n. multrow i (- 1) A $$ (ia, n) \<noteq> 0) < (LEAST n. multrow i (- 1) A $$ (j, n) \<noteq> 0)"
     if ia_j: "ia < j" and
       j: "j < dim_row A"
       and nz_ia_A: "\<not> is_zero_row_JNF ia A"
       and nz_j_A: "\<not> is_zero_row_JNF j A"
     for ia j
   proof -
     have ia: "ia < dim_row A" using ia_j j by auto
     show ?thesis using Least_eq[OF ia] Least_eq[OF j] nz_ia_A nz_j_A 
         is_zero_row_JNF_multrow[OF ia] is_zero_row_JNF_multrow[OF j] eA ia_j j
       unfolding echelon_form_JNF_def by simp
   qed 
   thus "\<forall>ia j.
        ia < j \<and> j < dim_row (multrow i (- 1) A) \<and> \<not> is_zero_row_JNF ia (multrow i (- 1) A)
         \<and> \<not> is_zero_row_JNF j (multrow i (- 1) A) \<longrightarrow>
        (LEAST n. multrow i (- 1) A $$ (ia, n) \<noteq> 0) < (LEAST n. multrow i (- 1) A $$ (j, n) \<noteq> 0)"
     by auto 
 qed
 
 
 (*The following lemma is already in HOL Analysis (thm echelon_form_imp_upper_triagular),
 but only for square matrices. We prove it here for rectangular matrices.*)
 thm echelon_form_imp_upper_triagular
 
 (*First we prove an auxiliary statement*)
 lemma echelon_form_JNF_least_position_ge_diagonal:
   assumes eA: "echelon_form_JNF A" 
   and A: "A: carrier_mat m n"
   and nz_iA: "\<not> is_zero_row_JNF i A"
   and im: "i<m"
 shows "i\<le>(LEAST n. A $$ (i,n) \<noteq> 0)"
   using nz_iA im
 proof (induct i rule: less_induct)
   case (less i)
   note nz_iA = less.prems(1) 
   note im = less.prems(2)
   show ?case
   proof (cases "i=0")
     case True show ?thesis using True by blast
   next
     case False
     show ?thesis
     proof (rule ccontr)
       assume " \<not> i \<le> (LEAST n. A $$ (i, n) \<noteq> 0)"
       hence i_least: "i > (LEAST n. A $$ (i, n) \<noteq> 0)" by auto
       have nz_i1A: "\<not> is_zero_row_JNF (i-1) A" 
         using nz_iA im False A eA unfolding echelon_form_JNF_def
         by (metis Num.numeral_nat(7) Suc_pred carrier_matD(1) gr_implies_not0 
             lessI linorder_neqE_nat order.strict_trans)  
       have "i-1\<le>(LEAST n. A $$ (i-1,n) \<noteq> 0)" by (rule less.hyps, insert im nz_i1A False, auto)
       moreover have "(LEAST n. A $$ (i,n) \<noteq> 0) > (LEAST n. A $$ (i-1,n) \<noteq> 0)"
         using nz_i1A nz_iA im False A eA unfolding echelon_form_JNF_def by auto   
       ultimately show False using i_least by auto
     qed
   qed
 qed
 
 
 lemma echelon_form_JNF_imp_upper_triangular:
   assumes eA: "echelon_form_JNF A" 
   shows "upper_triangular A"
 proof
   fix i j assume ji: "j<i" and i: "i<dim_row A"
   have A: "A \<in> carrier_mat (dim_row A) (dim_col A)" by auto
   show "A $$ (i,j) = 0"
   proof (cases "is_zero_row_JNF i A")
     case False
     have "i\<le> (LEAST n. A $$(i,n) \<noteq> 0)"
       by (rule echelon_form_JNF_least_position_ge_diagonal[OF eA A False i])
     then show ?thesis 
       using ji not_less_Least order.strict_trans2 by blast
   next
     case True
       (*
     Problem detected: at this point, we don't know if j < dim_col A. 
     That is, upper_triangular definition only works for matrices \<in> carrier_mat m n with n\<ge>m.
     The definition is: 
        - upper_triangular A \<equiv> \<forall>i < dim_row A. \<forall> j < i. A $$ (i,j) = 0
      But we need here:
        - upper_triangular A \<equiv> \<forall>i < dim_row A. \<forall> j < dim_col A. j < i  \<longrightarrow> A $$ (i,j) = 0
   
     Anyway, the existing definition makes sense since upper triangular is usually 
     restricted to square matrices.
   *)
     then show ?thesis unfolding is_zero_row_JNF_def oops
 
 
 (*We do the same with the new definition upper_triangular'*)
 lemma echelon_form_JNF_imp_upper_triangular:
   assumes eA: "echelon_form_JNF A" 
   shows "upper_triangular' A"
 proof
   fix i j assume ji: "j<i" and i: "i<dim_row A" and j: "j<dim_col A"
   have A: "A \<in> carrier_mat (dim_row A) (dim_col A)" by auto
   show "A $$ (i,j) = 0"
   proof (cases "is_zero_row_JNF i A")
     case False
     have "i\<le> (LEAST n. A $$(i,n) \<noteq> 0)"
       by (rule echelon_form_JNF_least_position_ge_diagonal[OF eA A False i])
     then show ?thesis 
       using ji not_less_Least order.strict_trans2 by blast
   next
     case True     
     then show ?thesis unfolding is_zero_row_JNF_def using j by auto
   qed
 qed
 
 
 lemma upper_triangular_append_zero:
   assumes uH: "upper_triangular' H" 
   and H: "H \<in> carrier_mat (m+m) n" and mn: "n\<le>m"
   shows "H = mat_of_rows n (map (Matrix.row H) [0..<m]) @\<^sub>r 0\<^sub>m m n" (is "_ = ?H' @\<^sub>r 0\<^sub>m m n")
 proof 
   have H': "?H' \<in> carrier_mat m n" using H uH by auto
   have H'0: "(?H' @\<^sub>r 0\<^sub>m m n) \<in> carrier_mat (m+m) n" by (simp add: H')
   thus dr: "dim_row H = dim_row (?H' @\<^sub>r 0\<^sub>m m n)" using H H'  by (simp add: append_rows_def) 
   show dc: "dim_col H = dim_col (?H' @\<^sub>r 0\<^sub>m m n)" using H H'  by (simp add: append_rows_def) 
   fix i j assume i: "i < dim_row (?H' @\<^sub>r 0\<^sub>m m n)" and j: "j < dim_col (?H' @\<^sub>r 0\<^sub>m m n)"
   show "H $$ (i, j) = (?H' @\<^sub>r 0\<^sub>m m n) $$ (i, j)"
   proof (cases "i<m")
     case True
     have "H $$ (i, j) = ?H' $$ (i,j)"
       by (metis True H' append_rows_def H carrier_matD index_mat_four_block(3) index_zero_mat(3) j 
           le_add1 map_first_rows_index mat_of_rows_carrier(2) mat_of_rows_index nat_arith.rule0)
     then show ?thesis
       by (metis (mono_tags, lifting) H' True add.comm_neutral append_rows_def 
           carrier_matD(1) i index_mat_four_block index_zero_mat(3) j)
   next
     case False 
     have imn: "i<m+m" using i dr H by auto
     have jn: "j<n" using j dc H by auto
     have ji: "j<i" using j i False mn jn by linarith
     hence "H $$ (i, j) = 0" using uH unfolding upper_triangular'_def dr imn using i jn 
       by (simp add: dc j)
     also have "... = (?H' @\<^sub>r 0\<^sub>m m n) $$ (i, j)"
       by (smt False H' append_rows_def assms(2) carrier_matD(1) carrier_matD(2) dc imn
           index_mat_four_block(1,3) index_zero_mat j less_diff_conv2 linorder_not_less)
     finally show ?thesis .
   qed
 qed
 
 subsubsection \<open>The algorithm is sound\<close>
 
 lemma find_fst_non0_in_row: 
   assumes A: "A \<in> carrier_mat m n"
   and res: "find_fst_non0_in_row l A = Some j"
   shows "A $$ (l,j) \<noteq> 0" "l \<le> j" "j < dim_col A"
 proof -
   let ?xs = "filter (\<lambda>j. A $$ (l, j) \<noteq> 0) [l ..< dim_col A]"
   from res[unfolded find_fst_non0_in_row_def Let_def]
   have xs: "?xs \<noteq> []" by (cases ?xs, auto)
   have j_in_xs: "j \<in> set ?xs" using res unfolding find_fst_non0_in_row_def Let_def
     by (metis (no_types, lifting) length_greater_0_conv list.case(2) list.exhaust nth_mem option.simps(1) xs)
   show "A $$ (l,j) \<noteq> 0" "l \<le> j" "j < dim_col A" using j_in_xs by auto+  
 qed
 
 
 lemma find_fst_non0_in_row_zero_before: 
   assumes A: "A \<in> carrier_mat m n"
   and res: "find_fst_non0_in_row l A = Some j"
   shows "\<forall>j'\<in>{l..<j}. A $$ (l,j') = 0"
 proof -
   let ?xs = "filter (\<lambda>j. A $$ (l, j) \<noteq> 0) [l ..< dim_col A]"
   from res[unfolded find_fst_non0_in_row_def Let_def]
   have xs: "?xs \<noteq> []" by (cases ?xs, auto)
   have j_in_xs: "j \<in> set ?xs" using res unfolding find_fst_non0_in_row_def Let_def
     by (metis (no_types, lifting) length_greater_0_conv list.case(2) list.exhaust nth_mem option.simps(1) xs)
   have j_xs0: "j = ?xs ! 0"
     by (smt res[unfolded find_fst_non0_in_row_def Let_def] list.case(2) list.exhaust option.inject xs)
   show "\<forall>j'\<in>{l..<j}. A $$ (l,j') = 0"
   proof (rule+, rule ccontr)
     fix j' assume j': "j' : {l..<j}" and Alj': "A $$ (l, j') \<noteq> 0"
     have j'j: "j'<j" using j' by auto
     have j'_in_xs: "j' \<in> set ?xs"
       by (metis (mono_tags, lifting) A Set.member_filter j' Alj' res atLeastLessThan_iff filter_set
           find_fst_non0_in_row(3) nat_SN.gt_trans set_upt)  
     have l_rw: "[l..<dim_col A] = [l ..<j] @[j..<dim_col A]"
       using assms(1) assms(2) find_fst_non0_in_row(3) j' upt_append by auto
     have xs_rw: "?xs = filter (\<lambda>j. A $$ (l, j) \<noteq> 0) ([l ..<j] @[j..<dim_col A])"
       using l_rw by auto
     hence "filter (\<lambda>j. A $$ (l, j) \<noteq> 0) [l ..<j] = []" using j_xs0 
       by (metis (no_types, lifting) Set.member_filter atLeastLessThan_iff filter_append filter_set
           length_greater_0_conv nth_append nth_mem order_less_irrefl set_upt)
     thus False using j_xs0 j' j_xs0 
       by (metis Set.member_filter filter_empty_conv filter_set j'_in_xs set_upt)
   qed
 qed
 
 
 corollary find_fst_non0_in_row_zero_before': 
   assumes A: "A \<in> carrier_mat m n"
   and res: "find_fst_non0_in_row l A = Some j"
   and "j' \<in> {l..<j}"
   shows "A $$ (l,j') = 0" using find_fst_non0_in_row_zero_before assms by auto
 
 lemma find_fst_non0_in_row_LEAST: 
   assumes A: "A \<in> carrier_mat m n"
   and ut_A: "upper_triangular' A"
   and res: "find_fst_non0_in_row l A = Some j"
   and lm: "l<m"
 shows "j = (LEAST n. A $$ (l,n) \<noteq> 0)"
 proof (rule Least_equality[symmetric])
   show " A $$ (l, j) \<noteq> 0" using res find_fst_non0_in_row(1) by blast
   show "\<And>y. A $$ (l, y) \<noteq> 0 \<Longrightarrow> j \<le> y"
   proof (rule ccontr)
     fix y assume Aly: "A $$ (l, y) \<noteq> 0" and jy: " \<not> j \<le> y "
     have yn: "y < n"
       by (metis A jy carrier_matD(2) find_fst_non0_in_row(3) leI less_imp_le_nat nat_SN.compat res)
     have "A $$(l,y) = 0"
     proof (cases "y\<in>{l..<j}")
       case True
       show ?thesis by (rule find_fst_non0_in_row_zero_before'[OF A res True])
     next
       case False hence "y<l" using jy by auto
       thus ?thesis using ut_A A lm unfolding upper_triangular'_def using yn by blast
     qed
     thus False using Aly by contradiction
   qed 
 qed
 
 
 
 lemma find_fst_non0_in_row_None': 
   assumes A: "A \<in> carrier_mat m n"  
   and lm: "l<m"
 shows "(find_fst_non0_in_row l A = None) = (\<forall>j\<in>{l..<dim_col A}. A $$ (l,j) = 0)" (is "?lhs = ?rhs")
 proof
   assume res: ?lhs
   let ?xs = "filter (\<lambda>j. A $$ (l, j) \<noteq> 0) [l ..< dim_col A]"
   from res[unfolded find_fst_non0_in_row_def Let_def]
   have xs: "?xs = []" by (cases ?xs, auto)
   have "A $$ (l, j) = 0" if j: "j\<in>{l..<dim_col A}" for j
     using xs by (metis (mono_tags, lifting) empty_filter_conv j set_upt)
   thus "?rhs" by blast
 next
   assume rhs: ?rhs
   show ?lhs
   proof (rule ccontr)
     assume "find_fst_non0_in_row l A \<noteq> None" 
     from this obtain j where r: "find_fst_non0_in_row l A = Some j" by blast
     hence "A $$ (l,j) \<noteq> 0" and  "l\<le>j" and "j<dim_col A" using find_fst_non0_in_row[OF A r] by blast+
     thus False using rhs by auto  
   qed
 qed
 
 
 lemma find_fst_non0_in_row_None: 
   assumes A: "A \<in> carrier_mat m n"
   and ut_A: "upper_triangular' A"
   and lm: "l<m"
 shows "(find_fst_non0_in_row l A = None) = (is_zero_row_JNF l A)" (is "?lhs = ?rhs")
 proof
   assume res: ?lhs
   let ?xs = "filter (\<lambda>j. A $$ (l, j) \<noteq> 0) [l ..< dim_col A]"
   from res[unfolded find_fst_non0_in_row_def Let_def]
   have xs: "?xs = []" by (cases ?xs, auto)
   have "A $$ (l, j) = 0" if j: "j < dim_col A" for j
   proof (cases "j<l")
     case True
     then show ?thesis using ut_A A lm j unfolding upper_triangular'_def by blast
   next
     case False
     hence j_ln: "j \<in> {l..<dim_col A}" using A lm j by simp
     then show ?thesis using xs by (metis (mono_tags, lifting) empty_filter_conv set_upt)
   qed
   thus "?rhs" unfolding is_zero_row_JNF_def by blast
 next
   assume rhs: ?rhs
   show ?lhs
   proof (rule ccontr)
     assume "find_fst_non0_in_row l A \<noteq> None" 
     from this obtain j where r: "find_fst_non0_in_row l A = Some j" by blast
     hence "A $$ (l,j) \<noteq> 0" and "j<dim_col A" using find_fst_non0_in_row[OF A r] by blast+
     hence "\<not> is_zero_row_JNF l A" unfolding is_zero_row_JNF_def using lm A by auto
     thus False using rhs by contradiction    
   qed
 qed
 
 lemma make_first_column_positive_preserves_dimensions:
   shows [simp]: "dim_row (make_first_column_positive A) = dim_row A" 
     and [simp]: "dim_col (make_first_column_positive A) = dim_col A"
   by (auto)
 
 
 lemma make_first_column_positive_works: 
   assumes "A\<in>carrier_mat m n" and i: "i<m" and "0<n"
   shows "make_first_column_positive A $$ (i,0) \<ge> 0"
   and "j<n \<Longrightarrow> A $$ (i,0) < 0 \<Longrightarrow> (make_first_column_positive A) $$ (i,j) = - A $$ (i,j)"
   and "j<n \<Longrightarrow> A $$ (i,0) \<ge> 0 \<Longrightarrow> (make_first_column_positive A) $$ (i,j) = A $$ (i,j)"
   using assms by auto 
 
 
 lemma make_first_column_positive_invertible: 
   shows  "\<exists>P. invertible_mat P \<and> P \<in> carrier_mat (dim_row A) (dim_row A) 
   \<and> make_first_column_positive A = P * A" 
 proof -
   let ?P = "Matrix.mat (dim_row A) (dim_row A)
           (\<lambda>(i,j). if i = j then if A $$(i,0) < 0 then - 1 else 1 else 0::int)"
   have "invertible_mat ?P"
   proof -
     have "(map abs (diag_mat ?P)) = replicate (length ((map abs (diag_mat ?P)))) 1" 
       by (rule replicate_length_same[symmetric], auto simp add: diag_mat_def)
     hence m_rw: "(map abs (diag_mat ?P)) = replicate (dim_row A) 1" by (auto simp add: diag_mat_def)
     have "Determinant.det ?P = prod_list (diag_mat ?P)" by (rule det_upper_triangular, auto)
     also have "abs ... = prod_list (map abs (diag_mat ?P))" unfolding prod_list_abs by blast
     also have " ... = prod_list (replicate (dim_row A) 1)" using m_rw by simp
     also have "... = 1" by auto
     finally have "\<bar>Determinant.det ?P\<bar> = 1" by blast
     hence "Determinant.det ?P dvd 1" by fastforce
     thus ?thesis using invertible_iff_is_unit_JNF mat_carrier by blast (*Thanks to the new bridge*)
   qed    
   moreover have "make_first_column_positive A = ?P * A" (is "?M = _")
   proof (rule eq_matI)
     show "dim_row ?M = dim_row (?P * A)" and "dim_col ?M = dim_col (?P * A)" by auto
     fix i j assume i: "i < dim_row (?P * A)" and j: "j < dim_col (?P * A)"
     have set_rw: "{0..<dim_row A} = insert i ({0..<dim_row A} - {i})" using i by auto
       have rw0: "(\<Sum>ia \<in> {0..<dim_row A } - {i}. Matrix.row ?P i $v ia * col A j $v ia) = 0"
         by (rule sum.neutral, insert i, auto)        
     have "(?P * A) $$ (i, j) = Matrix.row ?P i \<bullet> col A j" using i j by auto
     also have "... = (\<Sum>ia = 0..<dim_row A. Matrix.row ?P i $v ia * col A j $v ia)"
         unfolding scalar_prod_def by auto
       also have "... =  (\<Sum>ia \<in> insert i ({0..<dim_row A} - {i}). Matrix.row ?P i $v ia * col A j $v ia)"
         using set_rw by argo
       also have "... = Matrix.row ?P i $v i * col A j $v i 
         + (\<Sum>ia \<in> {0..<dim_row A } - {i}. Matrix.row ?P i $v ia * col A j $v ia)" 
         by (rule sum.insert, auto)
       also have "... = Matrix.row ?P i $v i * col A j $v i" unfolding rw0 by simp
       finally have *: "(?P * A) $$ (i, j) = Matrix.row ?P i $v i * col A j $v i" .
     also have "... = ?M $$ (i,j)" 
       by (cases " A $$ (i, 0) < 0", insert i j, auto simp add: col_def)
     finally show "?M $$ (i, j) = (?P * A) $$ (i, j)" ..
   qed
   moreover have "?P \<in> carrier_mat (dim_row A) (dim_row A)" by auto
   ultimately show ?thesis by blast
 qed
 
 locale proper_mod_operation = mod_operation +
   assumes dvd_gdiv_mult_right[simp]: "b > 0 \<Longrightarrow> b dvd a \<Longrightarrow> (a gdiv b) * b = a"
     and gmod_gdiv: "y > 0 \<Longrightarrow> x gmod y = x - x gdiv y * y"
     and dvd_imp_gmod_0: "0 < a \<Longrightarrow> a dvd b \<Longrightarrow> b gmod a = 0" 
     and gmod_0_imp_dvd: "a gmod b = 0 \<Longrightarrow> b dvd a" 
     and gmod_0[simp]: "n gmod 0 = n" "n > 0 \<Longrightarrow> 0 gmod n = 0"
 begin
 lemma reduce_alt_def_not0: 
   assumes "A $$ (a,0) \<noteq> 0" and pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A $$ (b,0))"
   shows "reduce a b D A =
        Matrix.mat (dim_row A) (dim_col A)
           (\<lambda>(i,k). if i = a then let r = (p*A$$(a,k) + q*A$$(b,k)) in
                               if k = 0 then if D dvd r then D else r else r gmod D
                    else if i = b then let r = u * A$$(a,k) + v * A$$(b,k) in
                               if k = 0 then r else r gmod D
                    else A$$(i,k))" (is "_ = ?rhs")
   and 
    "reduce_abs a b D A =
        Matrix.mat (dim_row A) (dim_col A)
           (\<lambda>(i,k). if i = a then let r = (p*A$$(a,k) + q*A$$(b,k)) in
                               if abs r > D then if k = 0 \<and> D dvd r then D else r gmod D else r 
                    else if i = b then let r = u * A$$(a,k) + v * A$$(b,k) in
                               if abs r > D then r gmod D else r
                    else A$$(i,k))" (is "_ = ?rhs_abs")
 proof -
   have "reduce a b D A =
        (case euclid_ext2 (A$$(a,0)) (A $$ (b,0)) of (p,q,u,v,d) \<Rightarrow>
        Matrix.mat (dim_row A) (dim_col A)
           (\<lambda>(i,k). if i = a then let r = (p*A$$(a,k) + q*A$$(b,k)) in
                                if k = 0 then if D dvd r then D else r else r gmod D
                    else if i = b then let r = u * A$$(a,k) + v * A$$(b,k) in
                                 if k = 0 then r else r gmod D
                    else A$$(i,k)
             ))" using assms by auto
   also have "... = ?rhs" unfolding reduce.simps Let_def 
     by (rule eq_matI, insert pquvd) (metis (no_types, lifting) split_conv)+
   finally show "reduce a b D A = ?rhs" .
   have "reduce_abs a b D A =
        (case euclid_ext2 (A$$(a,0)) (A $$ (b,0)) of (p,q,u,v,d) \<Rightarrow>
        Matrix.mat (dim_row A) (dim_col A)
           (\<lambda>(i,k). if i = a then let r = (p*A$$(a,k) + q*A$$(b,k)) in
                                if abs r > D then if k = 0 \<and> D dvd r then D else r gmod D else r 
                    else if i = b then let r = u * A$$(a,k) + v * A$$(b,k) in
                                if abs r > D then r gmod D else r
                    else A$$(i,k)
             ))" using assms by auto
   also have "... = ?rhs_abs" unfolding reduce.simps Let_def 
     by (rule eq_matI, insert pquvd) (metis (no_types, lifting) split_conv)+
   finally show "reduce_abs a b D A = ?rhs_abs" .
 qed
 
 lemma reduce_preserves_dimensions:
   shows [simp]: "dim_row (reduce a b D A) = dim_row A" 
     and [simp]: "dim_col (reduce a b D A) = dim_col A"
   and [simp]: "dim_row (reduce_abs a b D A) = dim_row A" 
     and [simp]: "dim_col (reduce_abs a b D A) = dim_col A"
   by (auto simp add: Let_def split_beta)
 
 lemma reduce_carrier:
   assumes "A \<in> carrier_mat m n"
   shows "(reduce a b D A) \<in> carrier_mat m n" 
     and "(reduce_abs a b D A) \<in> carrier_mat m n" 
   by (insert assms, auto simp add: Let_def split_beta)
 
 lemma reduce_gcd: 
   assumes A: "A \<in> carrier_mat m n" and a: "a<m" and j: "0<n" 
   and Aaj: "A $$ (a,0) \<noteq> 0"
 shows "(reduce a b D A) $$ (a,0) = (let r = gcd (A$$(a,0)) (A$$(b,0)) in if D dvd r then D else r)" (is "?lhs = ?rhs")
   and "(reduce_abs a b D A) $$ (a,0) = (let r = gcd (A$$(a,0)) (A$$(b,0)) in if D < r then
                       if D dvd r then D else r gmod D else r)" (is "?lhs_abs = ?rhs_abs")
 proof -
   obtain p q u v d where pquvd: "euclid_ext2 (A$$(a,0)) (A$$(b,0)) = (p,q,u,v,d)"
     using prod_cases5 by blast
   have "p * A $$ (a, 0) + q * A $$ (b, 0) = d" 
     using Aaj pquvd is_bezout_ext_euclid_ext2 unfolding is_bezout_ext_def 
     by (smt Pair_inject bezout_coefficients_fst_snd euclid_ext2_def)
   also have " ... = gcd (A$$(a,0)) (A$$(b,0))" by (metis euclid_ext2_def pquvd prod.sel(2))
   finally have pAaj_qAbj_gcd: "p * A $$ (a, 0) + q * A $$ (b, 0) = gcd (A$$(a,0)) (A$$(b,0))" .
   let ?f = "(\<lambda>(i, k). if i = a then let r = p * A $$ (a, k) + q * A $$ (b, k) in if k = 0 then if D dvd r then D else r else r gmod D
               else if i = b then let r = u * A $$ (a, k) + v * A $$ (b, k) in if k = 0 then r else r gmod D else A $$ (i, k))"
   have "(reduce a b D A) $$ (a,0) = Matrix.mat (dim_row A) (dim_col A) ?f $$ (a, 0)"
     using Aaj pquvd by auto 
   also have "... = (let r = p * A $$ (a, 0) + q * A $$ (b, 0) in if (0::nat) = 0 then if D dvd r then D else r else r gmod D)"
     using A a j by auto
   also have "... = (if D dvd gcd (A$$(a,0)) (A$$(b,0)) then D else 
       gcd (A$$(a,0)) (A$$(b,0)))" 
     by (simp add: pAaj_qAbj_gcd)
   finally show "?lhs = ?rhs" by auto
   let ?g = "(\<lambda>(i, k). if i = a then let r = p * A $$ (a, k) + q * A $$ (b, k) in 
                 if D < \<bar>r\<bar> then if k = 0 \<and> D dvd r then D else r gmod D else r
               else if i = b then let r = u * A $$ (a, k) + v * A $$ (b, k) in 
                     if D < \<bar>r\<bar> then r gmod D else r else A $$ (i, k))"
   have "(reduce_abs a b D A) $$ (a,0) = Matrix.mat (dim_row A) (dim_col A) ?g $$ (a, 0)"
     using Aaj pquvd by auto 
   also have "... = (let r = p * A $$ (a, 0) + q * A $$ (b, 0) in if D < \<bar>r\<bar> then
             if (0::nat) = 0 \<and> D dvd r then D else r gmod D else r)"
     using A a j by auto
   also have "... = (if D < \<bar>gcd (A$$(a,0)) (A$$(b,0))\<bar> then if D dvd gcd (A$$(a,0)) (A$$(b,0)) then D else 
       gcd (A$$(a,0)) (A$$(b,0)) gmod D else gcd (A$$(a,0)) (A$$(b,0)))"
     by (simp add: pAaj_qAbj_gcd)
   finally show "?lhs_abs = ?rhs_abs" by auto
 qed
 
 
 
 
 lemma reduce_preserves: 
   assumes A: "A \<in> carrier_mat m n" and j: "j<n" 
   and Aaj: "A $$ (a,0) \<noteq> 0" and ib: "i\<noteq>b" and ia: "i\<noteq>a" and im: "i<m"
 shows "(reduce a b D A) $$ (i,j) = A $$ (i,j)"  (is "?thesis1")
 and "(reduce_abs a b D A) $$ (i,j) = A $$ (i,j)" (is "?thesis2") 
 proof -
   obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(b,0))"
     using prod_cases5 by metis
   show ?thesis1 unfolding reduce_alt_def_not0[OF Aaj pquvd] using ia im j A ib by auto
   show ?thesis2 unfolding reduce_alt_def_not0[OF Aaj pquvd] using ia im j A ib by auto
 qed
 
 
 lemma reduce_0: 
   assumes A: "A \<in> carrier_mat m n" and a: "a<m" and j: "0<n" and b: "b<m" and ab: "a \<noteq> b"
   and Aaj: "A $$ (a,0) \<noteq> 0"
   and D: "D \<ge> 0" 
 shows "(reduce a b D A) $$ (b,0) = 0" (is "?thesis1")
 and "(reduce_abs a b D A) $$ (b,0) = 0" (is "?thesis2")
 proof -
   obtain p q u v d where pquvd: "euclid_ext2 (A$$(a,0)) (A$$(b,0)) = (p,q,u,v,d)"
     using prod_cases5 by blast
   hence u: "u = - (A$$(b,0)) div gcd (A$$(a,0)) (A$$(b,0))"
     using euclid_ext2_works[OF pquvd] by auto
   have v: "v = A$$(a,0) div gcd (A$$(a,0)) (A$$(b,0))" using euclid_ext2_works[OF pquvd] by auto
   have uv0: "u * A$$(a,0) + v * A$$(b,0) = 0" using u v
   proof -
     have "\<forall>i ia. gcd (ia::int) i * (ia div gcd ia i) = ia"
     by (meson dvd_mult_div_cancel gcd_dvd1)
     then have "v * - A $$ (b, 0) = u * A $$ (a, 0)"
       by (metis (no_types) dvd_minus_iff dvd_mult_div_cancel gcd_dvd2 minus_minus mult.assoc mult.commute u v)
     then show ?thesis
       by simp
   qed
   let ?f = "(\<lambda>(i, k). if i = a then let r = p * A $$ (a, k) + q * A $$ (b, k) in 
             if k = 0 then if D dvd r then D else r else r gmod D
               else if i = b then let r = u * A $$ (a, k) + v * A $$ (b, k) in 
                    if k = 0 then r else r gmod D else A $$ (i, k))" 
   have "(reduce a b D A) $$ (b,0) = Matrix.mat (dim_row A) (dim_col A) ?f $$ (b, 0)"
     using Aaj pquvd by auto 
   also have "... = (let r = u * A$$(a,0) + v * A$$(b,0) in r)"
     using A a j ab b by auto
   also have "... = 0" using uv0 D 
     by (smt (z3) gmod_0(1) gmod_0(2)) 
   finally show ?thesis1 .
   let ?g = "(\<lambda>(i, k). if i = a then let r = p * A $$ (a, k) + q * A $$ (b, k) in 
           if D < \<bar>r\<bar> then if k = 0 \<and> D dvd r then D else r gmod D else r
               else if i = b then let r = u * A $$ (a, k) + v * A $$ (b, k) in 
                   if D < \<bar>r\<bar> then r gmod D else r else A $$ (i, k))" 
   have "(reduce_abs a b D A) $$ (b,0) = Matrix.mat (dim_row A) (dim_col A) ?g $$ (b, 0)"
     using Aaj pquvd by auto 
   also have "... = (let r = u * A$$(a,0) + v * A$$(b,0) in if D < \<bar>r\<bar> then r gmod D else r)"
     using A a j ab b by auto
   also have "... = 0" using uv0 D by simp
   finally show ?thesis2 .
 qed
 end
 
 
 text \<open>Let us show the key lemma: operations modulo determinant don't modify the (integer) row span.\<close>
 
 context LLL_with_assms
 begin
 
 lemma lattice_of_kId_subset_fs_init: 
   assumes k_det: "k = Determinant.det (mat_of_rows n fs_init)"
   and mn: "m=n"
   shows "lattice_of (Matrix.rows (k \<cdot>\<^sub>m (1\<^sub>m m))) \<subseteq> lattice_of fs_init"
 proof -
   let ?Z = "(mat_of_rows n fs_init)"
   let ?RAT = "of_int_hom.mat_hom :: int mat \<Rightarrow> rat mat"
   have RAT_fs_init: "?RAT (mat_of_rows n fs_init) \<in> carrier_mat n n"
       using len map_carrier_mat mat_of_rows_carrier(1) mn by blast
   have det_RAT_fs_init: "Determinant.det (?RAT ?Z) \<noteq> 0"
   proof (rule gs.lin_indpt_rows_imp_det_not_0[OF RAT_fs_init])   
     have rw: "Matrix.rows (?RAT (mat_of_rows n fs_init)) = RAT fs_init"
       by (metis cof_vec_space.lin_indpt_list_def fs_init lin_dep mat_of_rows_map rows_mat_of_rows)
     thus "gs.lin_indpt (set (Matrix.rows (?RAT (mat_of_rows n fs_init))))" 
       by (insert lin_dep, simp add: cof_vec_space.lin_indpt_list_def)
     show "distinct (Matrix.rows (?RAT (mat_of_rows n fs_init)))"
       using rw cof_vec_space.lin_indpt_list_def lin_dep by auto
   qed
   obtain inv_Z where inverts_Z: "inverts_mat (?RAT ?Z) inv_Z" and inv_Z: "inv_Z \<in> carrier_mat m m"
     by (metis mn det_RAT_fs_init dvd_field_iff invertible_iff_is_unit_JNF
         len map_carrier_mat mat_of_rows_carrier(1) obtain_inverse_matrix)
   have det_rat_Z_k: "Determinant.det (?RAT ?Z) = rat_of_int k"
     using k_det of_int_hom.hom_det by blast
   have "?RAT ?Z *  adj_mat (?RAT ?Z) = Determinant.det (?RAT ?Z) \<cdot>\<^sub>m 1\<^sub>m n" 
     by (rule adj_mat[OF RAT_fs_init])
   hence "inv_Z * (?RAT ?Z *  adj_mat (?RAT ?Z)) = inv_Z * (Determinant.det (?RAT ?Z) \<cdot>\<^sub>m 1\<^sub>m n)" by simp
   hence k_inv_Z_eq_adj: "(rat_of_int k) \<cdot>\<^sub>m inv_Z = adj_mat (?RAT ?Z)"
     by (smt Determinant.mat_mult_left_right_inverse RAT_fs_init adj_mat(1,3) mn 
         carrier_matD det_RAT_fs_init det_rat_Z_k gs.det_nonzero_congruence inv_Z inverts_Z 
         inverts_mat_def mult_smult_assoc_mat smult_carrier_mat)
   have adj_mat_Z: "adj_mat (?RAT ?Z) $$ (i,j) \<in> \<int>" if i: "i<m" and j: "j<n" for i j
   proof -
     have det_mat_delete_Z: "Determinant.det (mat_delete (?RAT ?Z) j i) \<in> \<int>"
     proof (rule Ints_det)
       fix ia ja
       assume ia: "ia < dim_row  (mat_delete (?RAT ?Z) j i)"
         and ja: "ja < dim_col  (mat_delete (?RAT ?Z) j i)"
       have "(mat_delete (?RAT ?Z) j i) $$ (ia, ja) =  (?RAT ?Z) $$ (insert_index j ia, insert_index i ja)"        
         by (rule mat_delete_index[symmetric], insert i j mn len ia ja RAT_fs_init, auto)
       also have "... = rat_of_int (?Z $$ (insert_index j ia, insert_index i ja))"
         by (rule index_map_mat, insert i j ia ja, auto simp add: insert_index_def)
       also have "... \<in> \<int>" using Ints_of_int by blast
       finally show "(mat_delete (?RAT ?Z) j i) $$ (ia, ja) \<in> \<int>" .
     qed
     have "adj_mat (?RAT ?Z) $$ (i,j) = Determinant.cofactor (?RAT ?Z) j i"
       unfolding adj_mat_def
       by (simp add: len i j)
     also have "... =  (- 1) ^ (j + i) * Determinant.det (mat_delete (?RAT ?Z) j i)"
       unfolding Determinant.cofactor_def by auto
     also have "... \<in> \<int>" using det_mat_delete_Z by auto
     finally show ?thesis .
   qed                
   have kinvZ_in_Z: "((rat_of_int k) \<cdot>\<^sub>m inv_Z) $$ (i,j) \<in> \<int>" if i: "i<m" and j: "j<n" for i j
     using k_inv_Z_eq_adj by (simp add: adj_mat_Z i j)
   have "?RAT (k \<cdot>\<^sub>m (1\<^sub>m m)) = Determinant.det (?RAT ?Z) \<cdot>\<^sub>m (inv_Z * ?RAT ?Z)" (is "?lhs = ?rhs")
   proof - 
     have "(inv_Z * ?RAT ?Z) = (1\<^sub>m m)"
       by (metis Determinant.mat_mult_left_right_inverse RAT_fs_init mn carrier_matD(1)
           inv_Z inverts_Z inverts_mat_def)
     from this have "?rhs = rat_of_int k \<cdot>\<^sub>m (1\<^sub>m m)" using det_rat_Z_k by auto
     also have "... = ?lhs" by auto
     finally show ?thesis ..
   qed
   also have "... = (Determinant.det (?RAT ?Z) \<cdot>\<^sub>m inv_Z) * ?RAT ?Z"
     by (metis RAT_fs_init mn inv_Z mult_smult_assoc_mat)
   also have "... = ((rat_of_int k) \<cdot>\<^sub>m inv_Z) * ?RAT ?Z" by (simp add: k_det)
   finally have r': "?RAT (k \<cdot>\<^sub>m (1\<^sub>m m)) = ((rat_of_int k) \<cdot>\<^sub>m inv_Z) * ?RAT ?Z" .
   have r: "(k \<cdot>\<^sub>m (1\<^sub>m m)) = ((map_mat int_of_rat ((rat_of_int k) \<cdot>\<^sub>m inv_Z))) * ?Z"
   proof -
     have "?RAT ((map_mat int_of_rat ((rat_of_int k) \<cdot>\<^sub>m inv_Z))) = ((rat_of_int k) \<cdot>\<^sub>m inv_Z)"
     proof (rule eq_matI, auto)
       fix i j assume i: "i < dim_row inv_Z" and j: "j < dim_col inv_Z"
       have "((rat_of_int k) \<cdot>\<^sub>m inv_Z) $$ (i,j) =  (rat_of_int k * inv_Z $$ (i, j))"
         using index_smult_mat i j by auto
       hence kinvZ_in_Z': "... \<in> \<int>" using kinvZ_in_Z i j inv_Z mn by simp
       show "rat_of_int (int_of_rat (rat_of_int k * inv_Z $$ (i, j))) = rat_of_int k * inv_Z $$ (i, j)" 
         by (rule int_of_rat, insert kinvZ_in_Z', auto)
     qed
     hence "?RAT (k \<cdot>\<^sub>m (1\<^sub>m m)) = ?RAT ((map_mat int_of_rat ((rat_of_int k) \<cdot>\<^sub>m inv_Z))) * ?RAT ?Z"
       using r' by simp
     also have "... = ?RAT ((map_mat int_of_rat ((rat_of_int k) \<cdot>\<^sub>m inv_Z)) * ?Z)"
       by (metis RAT_fs_init adj_mat(1) k_inv_Z_eq_adj map_carrier_mat of_int_hom.mat_hom_mult)
     finally show ?thesis by (rule of_int_hom.mat_hom_inj)
   qed
   show ?thesis
   proof (rule mat_mult_sub_lattice[OF _ fs_init])
     have rw: "of_int_hom.mat_hom (map_mat int_of_rat ((rat_of_int k) \<cdot>\<^sub>m inv_Z)) 
       = map_mat int_of_rat ((rat_of_int k) \<cdot>\<^sub>m inv_Z)" by auto
     have "mat_of_rows n (Matrix.rows (k \<cdot>\<^sub>m 1\<^sub>m m)) = (k \<cdot>\<^sub>m (1\<^sub>m m))" 
       by (metis mn index_one_mat(3) index_smult_mat(3) mat_of_rows_rows)
     also have "... = of_int_hom.mat_hom (map_mat int_of_rat ((rat_of_int k) \<cdot>\<^sub>m inv_Z)) * mat_of_rows n fs_init" 
        using r rw by auto 
     finally show "mat_of_rows n (Matrix.rows (k \<cdot>\<^sub>m 1\<^sub>m m)) 
       = of_int_hom.mat_hom (map_mat int_of_rat ((rat_of_int k) \<cdot>\<^sub>m inv_Z)) * mat_of_rows n fs_init" .
    show "set (Matrix.rows (k \<cdot>\<^sub>m 1\<^sub>m m)) \<subseteq> carrier_vec n"using mn unfolding Matrix.rows_def by auto
    show "map_mat int_of_rat (rat_of_int k \<cdot>\<^sub>m inv_Z) \<in> carrier_mat (length (Matrix.rows (k \<cdot>\<^sub>m 1\<^sub>m m))) (length fs_init)"
      using len fs_init by (simp add: inv_Z)
   qed
 qed
 
 end
 
 context LLL_with_assms
 begin
 
 
 lemma lattice_of_append_det_preserves:  
   assumes k_det: "k = abs (Determinant.det (mat_of_rows n fs_init))"
   and mn: "m = n"
   and A: "A = (mat_of_rows n fs_init) @\<^sub>r (k \<cdot>\<^sub>m (1\<^sub>m m))"
 shows "lattice_of (Matrix.rows A) = lattice_of fs_init"
 proof -
   have "Matrix.rows (mat_of_rows n fs_init @\<^sub>r k \<cdot>\<^sub>m 1\<^sub>m m) = (Matrix.rows (mat_of_rows n fs_init) @ Matrix.rows (k \<cdot>\<^sub>m (1\<^sub>m m)))"
     by (rule rows_append_rows, insert fs_init len mn, auto)
   also have "... = (fs_init @ Matrix.rows (k \<cdot>\<^sub>m (1\<^sub>m m)))" by (simp add: fs_init)
   finally have rw: "Matrix.rows (mat_of_rows n fs_init @\<^sub>r k \<cdot>\<^sub>m 1\<^sub>m m) 
     = (fs_init @ Matrix.rows (k \<cdot>\<^sub>m (1\<^sub>m m)))" .
   have "lattice_of (Matrix.rows A) = lattice_of (fs_init @ Matrix.rows (k \<cdot>\<^sub>m (1\<^sub>m m)))"
     by (rule arg_cong[of _ _ lattice_of], auto simp add: A rw)
   also have "... = lattice_of fs_init" 
   proof (cases "k = Determinant.det (mat_of_rows n fs_init)")
     case True
     then show ?thesis 
     by (rule already_in_lattice_append[symmetric, OF fs_init 
              lattice_of_kId_subset_fs_init[OF _ mn]], insert mn, auto simp add: Matrix.rows_def)
   next
     case False
     hence k2: "k = -Determinant.det (mat_of_rows n fs_init)" using k_det by auto
     have l: "lattice_of (Matrix.rows (- k \<cdot>\<^sub>m 1\<^sub>m m)) \<subseteq> lattice_of fs_init"
       by (rule lattice_of_kId_subset_fs_init[OF _ mn], insert k2, auto)
     have l2: "lattice_of (Matrix.rows (- k \<cdot>\<^sub>m 1\<^sub>m m)) = lattice_of (Matrix.rows (k \<cdot>\<^sub>m 1\<^sub>m m))" 
     proof (rule mat_mult_invertible_lattice_eq)
       let ?P = "(- 1::int) \<cdot>\<^sub>m 1\<^sub>m m"
       show P: "?P \<in> carrier_mat m m" by simp
       have "det ?P = 1 \<or> det ?P = -1" unfolding det_smult by (auto simp add: minus_1_power_even)
       hence "det ?P dvd 1" by (smt minus_dvd_iff one_dvd)
       thus " invertible_mat ?P" unfolding invertible_iff_is_unit_JNF[OF P] .
       have "(- k \<cdot>\<^sub>m 1\<^sub>m m) = ?P * (k \<cdot>\<^sub>m 1\<^sub>m m)"
         unfolding mat_diag_smult[symmetric] unfolding mat_diag_diag by auto
       thus " mat_of_rows n (Matrix.rows (- k \<cdot>\<^sub>m 1\<^sub>m m)) = of_int_hom.mat_hom ?P * mat_of_rows n (Matrix.rows (k \<cdot>\<^sub>m 1\<^sub>m m))"
         by (metis mn index_one_mat(3) index_smult_mat(3) mat_of_rows_rows of_int_mat_hom_int_id)
       show " set (Matrix.rows (- k \<cdot>\<^sub>m 1\<^sub>m m)) \<subseteq> carrier_vec n"
         and "set (Matrix.rows (k \<cdot>\<^sub>m 1\<^sub>m m)) \<subseteq> carrier_vec n"
         using assms(2) one_carrier_mat set_rows_carrier smult_carrier_mat by blast+
     qed (insert mn, auto)
     hence l2: "lattice_of (Matrix.rows (k \<cdot>\<^sub>m 1\<^sub>m m)) \<subseteq> lattice_of fs_init" using l by auto
     show ?thesis by (rule already_in_lattice_append[symmetric, OF fs_init l2],
           insert mn one_carrier_mat set_rows_carrier smult_carrier_mat, blast)
   qed  
   finally show ?thesis .
 qed
 
 text \<open>This is another key lemma.
 Here, $A$ is the initial matrix @{text "(mat_of_rows n fs_init)"} augmented with $m$ rows 
 $(k,0,\dots,0),(0,k,0,\dots,0), \dots , (0,\dots,0,k)$ where $k$ is the determinant of 
 @{text "(mat_of_rows n fs_init)"}. 
 With the algorithm of the article, we obtain @{text "H = H' @\<^sub>r (0\<^sub>m m n)"} by means of an invertible 
 matrix $P$ (which is computable). Then, $H$ is the HNF of $A$.
 The lemma shows that $H'$ is the HNF of @{text "(mat_of_rows n fs_init)"}
 and that there exists an invertible matrix to carry out the transformation.\<close>
 
 lemma Hermite_append_det_id:
   assumes k_det: "k = abs (Determinant.det (mat_of_rows n fs_init))"
   and mn: "m = n"
   and A: "A = (mat_of_rows n fs_init) @\<^sub>r (k \<cdot>\<^sub>m (1\<^sub>m m))"
   and H': "H'\<in> carrier_mat m n"
   and H_append: "H = H' @\<^sub>r (0\<^sub>m m n)"
   and P: "P \<in> carrier_mat (m+m) (m+m)"
   and inv_P: "invertible_mat P"
   and A_PH: "A = P * H"
   and HNF_H: "Hermite_JNF associates res H"
 shows "Hermite_JNF associates res H'" 
   and "(\<exists>P'. invertible_mat P' \<and> P' \<in> carrier_mat m m \<and> (mat_of_rows n fs_init) = P' * H')"
 proof -
   have A_carrier: "A \<in> carrier_mat (m+m) n" using A mn len by auto
   let ?A' = "(mat_of_rows n fs_init)"
   let ?H' = "submatrix H {0..<m} {0..<n}"
   have nm: "n\<le>m" by (simp add: mn) 
   have H: "H \<in> carrier_mat (m + m) n" using H_append H' by auto
   have submatrix_carrier: "submatrix H {0..<m} {0..<n} \<in> carrier_mat m n"
     by (rule submatrix_carrier_first[OF H], auto)
   have H'_eq: "H' = ?H'"
   proof (rule eq_matI)
     fix i j assume i: "i < dim_row ?H'" and j: "j < dim_col ?H'"
     have im: "i<m" and jn: "j<n" using i j submatrix_carrier by auto
     have "?H' $$ (i,j) = H $$ (i,j)"
       by (rule submatrix_index_id[OF H], insert i j submatrix_carrier, auto)
     also have "... =  (if i < dim_row H' then H' $$ (i, j) else (0\<^sub>m m n) $$ (i - m, j))"
       unfolding H_append by (rule append_rows_nth[OF H'], insert im jn, auto)
     also have "... = H' $$ (i,j)" using H' im jn by simp
     finally show "H' $$ (i, j) = ?H' $$ (i, j)" ..
   qed (insert H' submatrix_carrier, auto)  
   show HNF_H': "Hermite_JNF associates res H'"
     unfolding H'_eq mn by (rule HNF_submatrix[OF HNF_H H], insert nm, simp)
   have L_fs_init_A: "lattice_of (fs_init) = lattice_of (Matrix.rows A)" 
     by (rule lattice_of_append_det_preserves[symmetric, OF k_det mn A])
   have L_H'_H: "lattice_of (Matrix.rows H') = lattice_of (Matrix.rows H)"
     using H_append H' lattice_of_append_zero_rows by blast
   have L_A_H: "lattice_of (Matrix.rows A) = lattice_of (Matrix.rows H)"
   proof (rule mat_mult_invertible_lattice_eq[OF _ _ P inv_P])
     show "set (Matrix.rows A) \<subseteq> carrier_vec n" using A_carrier set_rows_carrier by blast
     show "set (Matrix.rows H) \<subseteq> carrier_vec n" using H set_rows_carrier by blast
     show "length (Matrix.rows A) = m + m" using A_carrier by auto      
     show "length (Matrix.rows H) = m + m" using H by auto
     show "mat_of_rows n (Matrix.rows A) = of_int_hom.mat_hom P * mat_of_rows n (Matrix.rows H)"      
       by (metis A_carrier H A_PH carrier_matD(2) mat_of_rows_rows of_int_mat_hom_int_id)
   qed
   have L_fs_init_H': "lattice_of fs_init = lattice_of (Matrix.rows H')"
     using L_fs_init_A L_A_H L_H'_H by auto
   have exists_P2: 
       "\<exists>P2. P2 \<in> carrier_mat n n \<and> invertible_mat P2 \<and> mat_of_rows n  (Matrix.rows H') = P2 * H'"
     by (rule exI[of _ "1\<^sub>m n"], insert H' mn, auto)
   have exist_P': "\<exists>P'\<in>carrier_mat n n. invertible_mat P' 
       \<and> mat_of_rows n fs_init = P' * mat_of_rows n (Matrix.rows H')"
     by (rule eq_lattice_imp_mat_mult_invertible_rows[OF fs_init _ lin_dep len[unfolded mn] _ L_fs_init_H'],
         insert H' mn set_rows_carrier, auto)
   thus "\<exists>P'. invertible_mat P' \<and> P' \<in> carrier_mat m m \<and> (mat_of_rows n fs_init) = P' * H'"
     by (metis mn H' carrier_matD(2) mat_of_rows_rows)
 qed
 end
 
 
 
 context proper_mod_operation
 begin
 
 (* Perform the modulo D operation to reduce the element A$$(a,j), assuming A = A' @\<^sub>r  (D \<cdot>\<^sub>m (1\<^sub>m m))*)
 definition "reduce_element_mod_D (A::int mat) a j D m =  
   (if j = 0 then if D dvd A$$(a,j) then addrow (-((A$$(a,j) gdiv D)) + 1) a (j + m) A else A
   else addrow (-((A$$(a,j) gdiv D))) a (j + m) A)"
 
 definition "reduce_element_mod_D_abs (A::int mat) a j D m =  
   (if j = 0 \<and> D dvd A$$(a,j) then addrow (-((A$$(a,j) gdiv D)) + 1) a (j + m) A 
   else addrow (-((A$$(a,j) gdiv D))) a (j + m) A)"
 
 lemma reduce_element_mod_D_preserves_dimensions:
   shows [simp]: "dim_row (reduce_element_mod_D A a j D m) = dim_row A" 
     and [simp]: "dim_col (reduce_element_mod_D A a j D m) = dim_col A"
     and [simp]: "dim_row (reduce_element_mod_D_abs A a j D m) = dim_row A" 
     and [simp]: "dim_col (reduce_element_mod_D_abs A a j D m) = dim_col A"
   by (auto simp add: reduce_element_mod_D_def reduce_element_mod_D_abs_def Let_def split_beta)
 
 lemma reduce_element_mod_D_carrier:
   shows "reduce_element_mod_D A a j D m \<in> carrier_mat (dim_row A) (dim_col A)" 
     and "reduce_element_mod_D_abs A a j D m \<in> carrier_mat (dim_row A) (dim_col A)" by auto
 
 
 lemma reduce_element_mod_D_invertible_mat:
   assumes A_def: "A = A' @\<^sub>r  (D \<cdot>\<^sub>m (1\<^sub>m n))"
     and A': "A' \<in> carrier_mat m n" and a: "a<m" and j: "j<n" and mn: "m\<ge>n"
   shows "\<exists>P. P \<in> carrier_mat (m+n) (m+n) \<and> invertible_mat P \<and> 
     reduce_element_mod_D A a j D m = P * A" (is ?thesis1)
     and "\<exists>P. P \<in> carrier_mat (m+n) (m+n) \<and> invertible_mat P \<and> 
     reduce_element_mod_D_abs A a j D m = P * A" (is ?thesis2)
   unfolding atomize_conj
 proof (rule conjI; cases "j = 0 \<and> D dvd A$$(a,j)")
   case True
   let ?P = "addrow_mat (m+n) (- (A $$ (a, j) gdiv D) + 1) a (j + m)"
   have A: "A \<in> carrier_mat (m + n) n" using A_def A' mn by auto
   have "reduce_element_mod_D A a j D m = addrow (- (A $$ (a, j) gdiv D) + 1) a (j + m) A"
     unfolding reduce_element_mod_D_def using True by auto
   also have "... = ?P * A" by (rule addrow_mat[OF A], insert j mn, auto)
   finally have "reduce_element_mod_D A a j D m = ?P * A" .
   moreover have P: "?P \<in> carrier_mat (m+n) (m+n)" by simp
   moreover have inv_P: "invertible_mat ?P"
     by (metis addrow_mat_carrier a det_addrow_mat dvd_mult_right 
         invertible_iff_is_unit_JNF mult.right_neutral not_add_less2 semiring_gcd_class.gcd_dvd1)
   ultimately show ?thesis1 by blast
   have "reduce_element_mod_D_abs A a j D m = addrow (- (A $$ (a, j) gdiv D) + 1) a (j + m) A"
     unfolding reduce_element_mod_D_abs_def using True by auto
   also have "... = ?P * A" by (rule addrow_mat[OF A], insert j mn, auto)
   finally have "reduce_element_mod_D_abs A a j D m = ?P * A" .
   thus ?thesis2 using P inv_P by blast
 next
   case False note nc1 = False
   let ?P = "addrow_mat (m+n) (- (A $$ (a, j) gdiv D)) a (j + m)"
   have A: "A \<in> carrier_mat (m + n) n" using A_def A' mn by auto
   have P: "?P \<in> carrier_mat (m+n) (m+n)" by simp
   have inv_P: "invertible_mat ?P"
     by (metis addrow_mat_carrier a det_addrow_mat dvd_mult_right 
         invertible_iff_is_unit_JNF mult.right_neutral not_add_less2 semiring_gcd_class.gcd_dvd1)
   show ?thesis1
   proof (cases "j = 0")
     case True
     have "reduce_element_mod_D A a j D m = A" 
       unfolding reduce_element_mod_D_def using True nc1 by auto
     thus ?thesis1
       by (metis A_def A' carrier_append_rows invertible_mat_one 
           left_mult_one_mat one_carrier_mat smult_carrier_mat)
   next
     case False   
     have "reduce_element_mod_D A a j D m =  addrow (- (A $$ (a, j) gdiv D)) a (j + m) A"
       unfolding reduce_element_mod_D_def using False by auto
     also have "... = ?P * A" by (rule addrow_mat[OF A], insert j mn, auto)
     finally have "reduce_element_mod_D A a j D m = ?P * A" .    
     thus ?thesis using P inv_P by blast
   qed
   have "reduce_element_mod_D_abs A a j D m =  addrow (- (A $$ (a, j) gdiv D)) a (j + m) A"
     unfolding reduce_element_mod_D_abs_def using False by auto
   also have "... = ?P * A" by (rule addrow_mat[OF A], insert j mn, auto)
   finally have "reduce_element_mod_D_abs A a j D m = ?P * A" .    
   thus ?thesis2 using P inv_P by blast
 qed
 
 
 lemma reduce_element_mod_D_append:
   assumes A_def: "A = A' @\<^sub>r  (D \<cdot>\<^sub>m (1\<^sub>m n))"
   and A': "A' \<in> carrier_mat m n" and a: "a<m" and j: "j<n" and mn: "m\<ge>n"
 shows "reduce_element_mod_D A a j D m 
   = mat_of_rows n [Matrix.row (reduce_element_mod_D A a j D m) i. i \<leftarrow> [0..<m]] @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))" (is "?lhs = ?A' @\<^sub>r ?D")
 and "reduce_element_mod_D_abs A a j D m 
   = mat_of_rows n [Matrix.row (reduce_element_mod_D_abs A a j D m) i. i \<leftarrow> [0..<m]] @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))" (is "?lhs_abs = ?A'_abs @\<^sub>r ?D")
   unfolding atomize_conj
 proof (rule conjI; rule eq_matI)
   let ?xs = "(map (Matrix.row (reduce_element_mod_D A a j D m)) [0..<m])"
   let ?xs_abs = "(map (Matrix.row (reduce_element_mod_D_abs A a j D m)) [0..<m])"
   have lhs_carrier: "?lhs \<in> carrier_mat (m+n) n"
     and lhs_carrier_abs: "?lhs_abs \<in> carrier_mat (m+n) n"
     by (metis (no_types, lifting) add.comm_neutral append_rows_def A_def A' carrier_matD 
         carrier_mat_triv index_mat_four_block(2,3) index_one_mat(2) index_smult_mat(2) index_zero_mat(2,3) 
         reduce_element_mod_D_preserves_dimensions)+
   have map_A_carrier[simp]: "?A' \<in> carrier_mat m n" 
     and map_A_carrier_abs[simp]: "?A'_abs \<in> carrier_mat m n"
     by (simp add: mat_of_rows_def)+
   have AD_carrier[simp]: "?A' @\<^sub>r ?D \<in> carrier_mat (m+n) n" 
     and AD_carrier_abs[simp]: "?A'_abs @\<^sub>r ?D \<in> carrier_mat (m+n) n" 
     by (rule carrier_append_rows, insert lhs_carrier mn, auto)
   show "dim_row (?lhs) = dim_row (?A' @\<^sub>r ?D)"  and "dim_col (?lhs) = dim_col (?A' @\<^sub>r ?D)"
     "dim_row (?lhs_abs) = dim_row (?A'_abs @\<^sub>r ?D)"  and "dim_col (?lhs_abs) = dim_col (?A'_abs @\<^sub>r ?D)"
     using lhs_carrier lhs_carrier_abs AD_carrier AD_carrier_abs unfolding carrier_mat_def by simp+
   show "?lhs $$ (i, ja) = (?A' @\<^sub>r ?D) $$ (i, ja)" if i: "i < dim_row (?A' @\<^sub>r ?D)" and ja: "ja < dim_col (?A' @\<^sub>r ?D)" for i ja
   proof (cases "i<m")
     case True
     have ja_n: "ja < n"
       by (metis Nat.add_0_right append_rows_def index_mat_four_block(3) index_zero_mat(3) ja mat_of_rows_carrier(3))
     have "(?A' @\<^sub>r ?D) $$ (i, ja) = ?A' $$ (i,ja)"
       by (metis (no_types, lifting) Nat.add_0_right True append_rows_def diff_zero i 
           index_mat_four_block index_zero_mat(3) ja length_map length_upt mat_of_rows_carrier(2))
     also have "... = ?xs ! i $v ja" 
       by (rule mat_of_rows_index, insert i True ja , auto simp add: append_rows_def)
     also have "... = ?lhs $$ (i,ja)"
       by (rule map_first_rows_index, insert assms lhs_carrier True i ja_n, auto)
     finally show ?thesis ..
   next
     case False
     have ja_n: "ja < n"
       by (metis Nat.add_0_right append_rows_def index_mat_four_block(3) index_zero_mat(3) ja mat_of_rows_carrier(3))
     have "(?A' @\<^sub>r ?D) $$ (i, ja) =?D $$ (i-m,ja)"
       by (smt False Nat.add_0_right map_A_carrier append_rows_def carrier_matD i 
           index_mat_four_block index_zero_mat(3) ja_n)
     also have "... = ?lhs $$ (i,ja)"
       by (metis (no_types, lifting) False Nat.add_0_right map_A_carrier append_rows_def A_def A' a 
           carrier_matD i index_mat_addrow(1) index_mat_four_block(1,2) index_zero_mat(3) ja_n 
           lhs_carrier reduce_element_mod_D_def reduce_element_mod_D_preserves_dimensions)
     finally show ?thesis ..
   qed
   fix i ja assume i: "i < dim_row (?A'_abs @\<^sub>r ?D)" and ja: "ja < dim_col (?A'_abs @\<^sub>r ?D)"
   have ja_n: "ja < n"
     by (metis Nat.add_0_right append_rows_def index_mat_four_block(3) index_zero_mat(3) ja mat_of_rows_carrier(3))
   show "?lhs_abs $$ (i, ja) = (?A'_abs @\<^sub>r ?D) $$ (i, ja)"
   proof (cases "i<m")
     case True
     have "(?A'_abs @\<^sub>r ?D) $$ (i, ja) = ?A'_abs $$ (i,ja)"
       by (metis (no_types, lifting) Nat.add_0_right True append_rows_def diff_zero i 
           index_mat_four_block index_zero_mat(3) ja length_map length_upt mat_of_rows_carrier(2))
     also have "... = ?xs_abs ! i $v ja" 
       by (rule mat_of_rows_index, insert i True ja , auto simp add: append_rows_def)
     also have "... = ?lhs_abs $$ (i,ja)"
       by (rule map_first_rows_index, insert assms lhs_carrier_abs True i ja_n, auto)
     finally show ?thesis ..
   next
     case False
     have "(?A'_abs @\<^sub>r ?D) $$ (i, ja) = ?D $$ (i-m,ja)"
       by (smt False Nat.add_0_right map_A_carrier_abs append_rows_def carrier_matD i 
           index_mat_four_block index_zero_mat(3) ja_n)
     also have "... = ?lhs_abs $$ (i,ja)"
       by (metis (no_types, lifting) False Nat.add_0_right map_A_carrier_abs append_rows_def A_def A' a 
           carrier_matD i index_mat_addrow(1) index_mat_four_block(1,2) index_zero_mat(3) ja_n 
           lhs_carrier_abs reduce_element_mod_D_abs_def reduce_element_mod_D_preserves_dimensions)
     finally show ?thesis ..
   qed
 qed
 
 
 lemma reduce_append_rows_eq:
   assumes A': "A' \<in> carrier_mat m n"
     and A_def: "A = A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))" and a: "a<m" and xm: "x<m" and "0<n"
   and Aaj: "A $$ (a,0) \<noteq> 0" 
   shows "reduce a x D A 
   = mat_of_rows n [Matrix.row ((reduce a x D A)) i. i \<leftarrow> [0..<m]] @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n" (is ?thesis1)
   and "reduce_abs a x D A 
   = mat_of_rows n [Matrix.row ((reduce_abs a x D A)) i. i \<leftarrow> [0..<m]] @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n" (is ?thesis2)
   unfolding atomize_conj
 proof (rule conjI; rule matrix_append_rows_eq_if_preserves)
   let ?reduce_ax = "reduce a x D A"
   let ?reduce_abs = "reduce_abs a x D A"
  obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))"
    by (metis prod_cases5)
   have A: "A: carrier_mat (m+n) n" by (simp add: A_def A')
   show D1: "D \<cdot>\<^sub>m 1\<^sub>m n \<in> carrier_mat n n" and "D \<cdot>\<^sub>m 1\<^sub>m n \<in> carrier_mat n n" by simp+
   show "?reduce_ax \<in> carrier_mat (m + n) n"  "?reduce_abs \<in> carrier_mat (m + n) n"
     by (metis Nat.add_0_right append_rows_def A' A_def carrier_matD carrier_mat_triv index_mat_four_block(2,3)
         index_one_mat(2) index_smult_mat(2) index_zero_mat(2) index_zero_mat(3) reduce_preserves_dimensions)+
   show "\<forall>i\<in>{m..<m + n}. \<forall>ja<n. ?reduce_ax $$ (i, ja) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i - m, ja)" 
     and "\<forall>i\<in>{m..<m + n}. \<forall>ja<n. ?reduce_abs $$ (i, ja) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i - m, ja)"
     unfolding atomize_conj
   proof (rule conjI; rule+)
     fix i ja assume i: "i \<in> {m..<m + n}" and ja: "ja < n"
     have ja_dc: "ja < dim_col A" and i_dr: "i < dim_row A" using i ja A by auto
     have i_not_a: "i \<noteq> a" using i a by auto
     have i_not_x: "i \<noteq> x" using i xm by auto
     have "?reduce_ax $$ (i,ja) = A $$ (i,ja)" 
       unfolding reduce_alt_def_not0[OF Aaj pquvd] using ja_dc i_dr i_not_a i_not_x by auto 
     also have "... = (if i < dim_row A' then A' $$(i,ja) else (D \<cdot>\<^sub>m (1\<^sub>m n))$$(i-m,ja))"
       by (unfold A_def, rule append_rows_nth[OF A' D1 _ ja], insert A i_dr, simp)
     also have "... = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i - m, ja)" using i A' by auto
     finally show "?reduce_ax $$ (i,ja) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i - m, ja)" .   
     have "?reduce_abs $$ (i,ja) = A $$ (i,ja)" 
       unfolding reduce_alt_def_not0[OF Aaj pquvd] using ja_dc i_dr i_not_a i_not_x by auto 
     also have "... = (if i < dim_row A' then A' $$(i,ja) else (D \<cdot>\<^sub>m (1\<^sub>m n))$$(i-m,ja))"
       by (unfold A_def, rule append_rows_nth[OF A' D1 _ ja], insert A i_dr, simp)
     also have "... = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i - m, ja)" using i A' by auto
     finally show "?reduce_abs $$ (i,ja) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i - m, ja)" .   
   qed
 qed
 
 fun reduce_row_mod_D
   where "reduce_row_mod_D A a [] D m = A" |
         "reduce_row_mod_D A a (x # xs) D m = reduce_row_mod_D (reduce_element_mod_D A a x D m) a xs D m"
 
 fun reduce_row_mod_D_abs
   where "reduce_row_mod_D_abs A a [] D m = A" |
         "reduce_row_mod_D_abs A a (x # xs) D m = reduce_row_mod_D_abs (reduce_element_mod_D_abs A a x D m) a xs D m"
 
 
 lemma reduce_row_mod_D_preserves_dimensions:
   shows [simp]: "dim_row (reduce_row_mod_D A a xs D m) = dim_row A" 
     and [simp]: "dim_col (reduce_row_mod_D A a xs D m) = dim_col A"
   by (induct A a xs D m rule: reduce_row_mod_D.induct, auto)
   
 lemma reduce_row_mod_D_preserves_dimensions_abs:
   shows [simp]: "dim_row (reduce_row_mod_D_abs A a xs D m) = dim_row A" 
     and [simp]: "dim_col (reduce_row_mod_D_abs A a xs D m) = dim_col A"
   by (induct A a xs D m rule: reduce_row_mod_D_abs.induct, auto)
 
 lemma reduce_row_mod_D_invertible_mat:
   assumes A_def: "A = A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
   and A': "A' \<in> carrier_mat m n" and a: "a<m" and j: "\<forall>j\<in>set xs. j<n" and mn: "m\<ge>n"
   shows "\<exists>P. P \<in> carrier_mat (m+n) (m+n) \<and> invertible_mat P \<and> 
     reduce_row_mod_D A a xs D m = P * A"
   using assms
 proof (induct A a xs D m arbitrary: A' rule: reduce_row_mod_D.induct)
   case (1 A a D m)
   show ?case by (rule exI[of _ "1\<^sub>m (m+n)"], insert "1.prems", auto simp add: append_rows_def)
 next
   case (2 A a x xs D m)
   let ?reduce_xs = "(reduce_element_mod_D A a x D m)"
   have 1: "reduce_row_mod_D A a (x # xs) D m 
     = reduce_row_mod_D ?reduce_xs a xs D m" by simp
   have "\<exists>P. P \<in> carrier_mat (m+n) (m+n) \<and> invertible_mat P \<and> 
     reduce_element_mod_D A a x D m = P * A" 
     by (rule reduce_element_mod_D_invertible_mat, insert "2.prems", auto)
   from this obtain P where P: "P \<in> carrier_mat (m+n) (m+n)" and inv_P: "invertible_mat P"
     and R_P: "reduce_element_mod_D A a x D m = P * A" by auto
   have "\<exists>P. P \<in> carrier_mat (m + n) (m + n) \<and> invertible_mat P \<and> reduce_row_mod_D ?reduce_xs a xs D m = P * ?reduce_xs"
   proof (rule "2.hyps")
     let ?A' = "mat_of_rows n [Matrix.row (reduce_element_mod_D A a x D m) i. i \<leftarrow> [0..<m]]"
     show "reduce_element_mod_D A a x D m = ?A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
       by (rule reduce_element_mod_D_append, insert "2.prems", auto)
   qed (insert "2.prems", auto)   
   from this obtain P2 where P2: "P2 \<in> carrier_mat (m + n) (m + n)" and inv_P2: "invertible_mat P2"
     and R_P2: "reduce_row_mod_D ?reduce_xs a xs D m = P2 * ?reduce_xs"
     by auto
   have "invertible_mat (P2 * P)" using P P2 inv_P inv_P2 invertible_mult_JNF by blast
   moreover have "(P2 * P) \<in> carrier_mat (m+n) (m+n)" using P2 P by auto
   moreover have "reduce_row_mod_D A a (x # xs) D m = (P2 * P) * A" 
     by (smt P P2 R_P R_P2 1 assoc_mult_mat carrier_matD carrier_mat_triv
         index_mult_mat reduce_row_mod_D_preserves_dimensions)
   ultimately show ?case by blast
 qed
 
 
 lemma reduce_row_mod_D_abs_invertible_mat:
   assumes A_def: "A = A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
   and A': "A' \<in> carrier_mat m n" and a: "a<m" and j: "\<forall>j\<in>set xs. j<n" and mn: "m\<ge>n"
   shows "\<exists>P. P \<in> carrier_mat (m+n) (m+n) \<and> invertible_mat P \<and> 
     reduce_row_mod_D_abs A a xs D m = P * A"
   using assms
 proof (induct A a xs D m arbitrary: A' rule: reduce_row_mod_D_abs.induct)
   case (1 A a D m)
   show ?case by (rule exI[of _ "1\<^sub>m (m+n)"], insert "1.prems", auto simp add: append_rows_def)
 next
   case (2 A a x xs D m)
   let ?reduce_xs = "(reduce_element_mod_D_abs A a x D m)"
   have 1: "reduce_row_mod_D_abs A a (x # xs) D m 
     = reduce_row_mod_D_abs ?reduce_xs a xs D m" by simp
   have "\<exists>P. P \<in> carrier_mat (m+n) (m+n) \<and> invertible_mat P \<and> 
     reduce_element_mod_D_abs A a x D m = P * A" 
     by (rule reduce_element_mod_D_invertible_mat, insert "2.prems", auto)
   from this obtain P where P: "P \<in> carrier_mat (m+n) (m+n)" and inv_P: "invertible_mat P"
     and R_P: "reduce_element_mod_D_abs A a x D m = P * A" by auto
   have "\<exists>P. P \<in> carrier_mat (m + n) (m + n) \<and> invertible_mat P \<and> reduce_row_mod_D_abs ?reduce_xs a xs D m = P * ?reduce_xs"
   proof (rule "2.hyps")
     let ?A' = "mat_of_rows n [Matrix.row (reduce_element_mod_D_abs A a x D m) i. i \<leftarrow> [0..<m]]"
     show "reduce_element_mod_D_abs A a x D m = ?A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
       by (rule reduce_element_mod_D_append, insert "2.prems", auto)
   qed (insert "2.prems", auto)   
   from this obtain P2 where P2: "P2 \<in> carrier_mat (m + n) (m + n)" and inv_P2: "invertible_mat P2"
     and R_P2: "reduce_row_mod_D_abs ?reduce_xs a xs D m = P2 * ?reduce_xs"
     by auto
   have "invertible_mat (P2 * P)" using P P2 inv_P inv_P2 invertible_mult_JNF by blast
   moreover have "(P2 * P) \<in> carrier_mat (m+n) (m+n)" using P2 P by auto
   moreover have "reduce_row_mod_D_abs A a (x # xs) D m = (P2 * P) * A" 
     by (smt P P2 R_P R_P2 1 assoc_mult_mat carrier_matD carrier_mat_triv
         index_mult_mat reduce_row_mod_D_preserves_dimensions_abs)
   ultimately show ?case by blast
 qed
 end
 
 context proper_mod_operation
 begin
 lemma dvd_gdiv_mult_left[simp]: assumes "b > 0" "b dvd a" shows "b * (a gdiv b) = a"
   using dvd_gdiv_mult_right[OF assms] by (auto simp: ac_simps)
 
 
 lemma reduce_element_mod_D:
   assumes A_def: "A = A' @\<^sub>r  (D \<cdot>\<^sub>m (1\<^sub>m n))"
   and A': "A' \<in> carrier_mat m n" and a: "a\<le>m" and j: "j<n" and mn: "m\<ge>n"
   and D: "D > 0" 
   shows "reduce_element_mod_D A a j D m = Matrix.mat (dim_row A) (dim_col A)
           (\<lambda>(i,k). if i = a \<and> k = j then if j = 0 then if D dvd A$$(i,k) 
           then D else A$$(i,k) else A$$(i,k) gmod D else A$$(i,k))" (is "_ = ?A")
     and "reduce_element_mod_D_abs A a j D m = Matrix.mat (dim_row A) (dim_col A)
       (\<lambda>(i,k). if i = a \<and> k = j then if j = 0 \<and> D dvd A$$(i,k) then D else A$$(i,k) gmod D else A$$(i,k))" (is "_ = ?A_abs")
 unfolding atomize_conj
 proof (rule conjI; rule eq_matI)
   have A: "A \<in> carrier_mat (m+n) n" using A_def A'  by simp
   have dr: "dim_row ?A = dim_row ?A_abs" and dc: "dim_col ?A = dim_col ?A_abs" by auto
   have 1: "reduce_element_mod_D A a j D m $$ (i, ja) = ?A $$ (i, ja)" (is ?thesis1)
     and 2: "reduce_element_mod_D_abs A a j D m $$ (i, ja) = ?A_abs $$ (i, ja)" (is ?thesis2)
     if i: "i < dim_row ?A" and ja: "ja < dim_col ?A" for i ja
     unfolding atomize_conj
   proof (rule conjI; cases "i=a")
     case False
     have "reduce_element_mod_D A a j D m = (if j = 0 then if D dvd A$$(a,j) then addrow (-((A$$(a,j) gdiv D)) + 1) a (j + m) A 
     else A
     else addrow (-((A$$(a,j) gdiv D))) a (j + m) A)"
       unfolding reduce_element_mod_D_def by simp
     also have "... $$ (i,ja) = A $$ (i, ja)" unfolding mat_addrow_def using False ja i by auto     
     also have "... = ?A $$ (i,ja)" using False using i ja by auto
     finally show ?thesis1 .
     have "reduce_element_mod_D_abs A a j D m $$ (i,ja) = A $$ (i, ja)"
       unfolding reduce_element_mod_D_abs_def mat_addrow_def using False ja i by auto     
     also have "... = ?A_abs $$ (i,ja)" using False using i ja by auto
     finally show ?thesis2 .
   next
     case True note ia = True
     have "reduce_element_mod_D A a j D m 
       = (if j = 0 then if D dvd A$$(a,j) then addrow (-((A$$(a,j) gdiv D)) + 1) a (j + m) A else A
         else addrow (-((A$$(a,j) gdiv D))) a (j + m) A)" 
       unfolding reduce_element_mod_D_def by simp
     also have "... $$ (i,ja) = ?A $$ (i,ja)"
     proof (cases "ja = j")
       case True note ja_j = True
       have "A $$ (j + m, ja) = (D \<cdot>\<^sub>m (1\<^sub>m n)) $$ (j,ja)"
         by (rule append_rows_nth2[OF A' _ A_def ], insert j ja A mn, auto)       
       also have "... = D * (1\<^sub>m n) $$ (j,ja)" by (rule index_smult_mat, insert ja j A mn, auto)
       also have "... = D" by (simp add: True j mn)
       finally have A_ja_jaD: "A $$ (j + m, ja) = D" .
       show ?thesis
       proof (cases "j=0 \<and> D dvd A$$(a,j)")
         case True         
         have 1: "reduce_element_mod_D A a j D m = addrow (-((A$$(a,j) gdiv D)) + 1) a (j + m) A "
           using True ia ja_j unfolding reduce_element_mod_D_def by auto
         also have "... $$(i,ja) = (- (A $$ (a, j) gdiv D) + 1) * A $$ (j + m, ja) + A $$ (i, ja)"
           unfolding mat_addrow_def using True ja_j ia
           using A i j by auto
         also have "... = D"
         proof -
           have "A $$ (i, ja) + D * - (A $$ (i, ja) gdiv D) = 0"
             using True ia ja_j D by force
           then show ?thesis
             by (metis A_ja_jaD ab_semigroup_add_class.add_ac(1) add.commute add_right_imp_eq ia int_distrib(2)
                 ja_j more_arith_simps(3) mult.commute mult_cancel_right1)
         qed   
         also have "... = ?A $$ (i,ja)" using True ia A i j ja_j by auto
         finally show ?thesis
           using True 1 by auto
       next
         case False
         show ?thesis
         proof (cases "ja=0")
           case True
           then show ?thesis
             using False i ja ja_j by force
         next
           case False
         have "?A $$ (i,ja) = A $$ (i, ja) gmod D" using True ia A i j False by auto
         also have "... = A $$ (i, ja) - ((A $$ (i, ja) gdiv D) * D)"
           by (subst gmod_gdiv[OF D], auto)
         also have "... =  - (A $$ (a, j) gdiv D) * A $$ (j + m, ja) + A $$ (i, ja)"
           unfolding A_ja_jaD by (simp add: True ia)
         finally show ?thesis 
           using A False True i ia j by auto
       qed
     qed
   next
       case False
       have "A $$ (j + m, ja) = (D \<cdot>\<^sub>m (1\<^sub>m n)) $$ (j,ja)"
         by (rule append_rows_nth2[OF A' _ A_def ], insert j mn ja A, auto)       
       also have "... = D * (1\<^sub>m n) $$ (j,ja)" by (rule index_smult_mat, insert ja j A mn, auto)
       also have "... = 0" using False using A a mn ja j by force        
       finally have A_am_ja0: "A $$ (j + m, ja) = 0" .
       then show ?thesis using False i ja by fastforce
     qed
     finally show ?thesis1 .
     have "reduce_element_mod_D_abs A a j D m 
       = (if j = 0 \<and> D dvd A$$(a,j) then addrow (-((A$$(a,j) gdiv D)) + 1) a (j + m) A
         else addrow (-((A$$(a,j) gdiv D))) a (j + m) A)" 
       unfolding reduce_element_mod_D_abs_def by simp
     also have "... $$ (i,ja) = ?A_abs $$ (i,ja)"
     proof (cases "ja = j")
       case True note ja_j = True
       have "A $$ (j + m, ja) = (D \<cdot>\<^sub>m (1\<^sub>m n)) $$ (j,ja)"
         by (rule append_rows_nth2[OF A' _ A_def ], insert j ja A mn, auto)       
       also have "... = D * (1\<^sub>m n) $$ (j,ja)" by (rule index_smult_mat, insert ja j A mn, auto)
       also have "... = D" by (simp add: True j mn)
       finally have A_ja_jaD: "A $$ (j + m, ja) = D" .
       show ?thesis
       proof (cases "j=0 \<and> D dvd A$$(a,j)")
         case True         
         have 1: "reduce_element_mod_D_abs A a j D m = addrow (-((A$$(a,j) gdiv D)) + 1) a (j + m) A "
           using True ia ja_j unfolding reduce_element_mod_D_abs_def by auto
         also have "... $$(i,ja) = (- (A $$ (a, j) gdiv D) + 1) * A $$ (j + m, ja) + A $$ (i, ja)"
           unfolding mat_addrow_def using True ja_j ia
           using A i j by auto
         also have "... = D"
         proof -
           have "A $$ (i, ja) + D * - (A $$ (i, ja) gdiv D) = 0"
             using True ia ja_j D by force
           then show ?thesis
             by (metis A_ja_jaD ab_semigroup_add_class.add_ac(1) add.commute add_right_imp_eq ia int_distrib(2)
                 ja_j more_arith_simps(3) mult.commute mult_cancel_right1)
         qed   
         also have "... = ?A_abs $$ (i,ja)" using True ia A i j ja_j by auto
         finally show ?thesis
           using True 1 by auto
       next
         case False
         have i: "i<dim_row ?A_abs" and ja: "ja<dim_col ?A_abs" using i ja by auto
         have "?A_abs $$ (i,ja) = A $$ (i, ja) gmod D" using True ia A i j False by auto
         also have "... = A $$ (i, ja) - ((A $$ (i, ja) gdiv D) * D)"
           by (subst gmod_gdiv[OF D], auto)
         also have "... =  - (A $$ (a, j) gdiv D) * A $$ (j + m, ja) + A $$ (i, ja)"
           unfolding A_ja_jaD by (simp add: True ia)
         finally show ?thesis 
           using A False True i ia j by auto
       qed    
   next
       case False
       have "A $$ (j + m, ja) = (D \<cdot>\<^sub>m (1\<^sub>m n)) $$ (j,ja)"
         by (rule append_rows_nth2[OF A' _ A_def ], insert j mn ja A, auto)       
       also have "... = D * (1\<^sub>m n) $$ (j,ja)" by (rule index_smult_mat, insert ja j A mn, auto)
       also have "... = 0" using False using A a mn ja j by force        
       finally have A_am_ja0: "A $$ (j + m, ja) = 0" .
       then show ?thesis using False i ja by fastforce
     qed
     finally show ?thesis2 .  
   qed
   from this
   show "\<And>i ja. i<dim_row ?A \<Longrightarrow> ja < dim_col ?A \<Longrightarrow> reduce_element_mod_D A a j D m $$ (i, ja) = ?A $$ (i, ja)" 
     and "\<And>i ja. i<dim_row ?A_abs \<Longrightarrow> ja < dim_col ?A_abs \<Longrightarrow> reduce_element_mod_D_abs A a j D m $$ (i, ja) = ?A_abs $$ (i, ja)" 
     using dr dc by auto
 next
   show "dim_row (reduce_element_mod_D A a j D m) = dim_row ?A" 
     and "dim_col (reduce_element_mod_D A a j D m) = dim_col ?A"
     "dim_row (reduce_element_mod_D_abs A a j D m) = dim_row ?A_abs" 
     and "dim_col (reduce_element_mod_D_abs A a j D m) = dim_col ?A_abs"
     by auto
 qed
 
 
 lemma reduce_row_mod_D:
   assumes A_def: "A = A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
     and A': "A' \<in> carrier_mat m n" and a: "a<m" and j: "\<forall>j\<in>set xs. j<n"
     and d: "distinct xs" and "m\<ge>n"
     and "D > 0" 
   shows "reduce_row_mod_D A a xs D m = Matrix.mat (dim_row A) (dim_col A)
           (\<lambda>(i,k). if i = a \<and> k \<in> set xs then if k = 0 then if D dvd A$$(i,k) 
            then D else A$$(i,k) else A$$(i,k) gmod D else A$$(i,k))"
   using assms
 proof (induct A a xs D m arbitrary: A' rule: reduce_row_mod_D.induct)
   case (1 A a D m)
   then show ?case by force
 next
   case (2 A a x xs D m)
   let ?reduce_xs = "(reduce_element_mod_D A a x D m)"
   have 1: "reduce_row_mod_D A a (x # xs) D m 
     = reduce_row_mod_D ?reduce_xs a xs D m" by simp
   have 2: "reduce_element_mod_D A a j D m = Matrix.mat (dim_row A) (dim_col A)
           (\<lambda>(i,k). if i = a \<and> k = j then if j = 0 then if D dvd A$$(i,k)
           then D else A$$(i,k) else A$$(i,k) gmod D else A$$(i,k))" if "j<n" for j
     by (rule reduce_element_mod_D, insert "2.prems" that, auto)
   have "reduce_row_mod_D ?reduce_xs a xs D m =
     Matrix.mat (dim_row ?reduce_xs) (dim_col ?reduce_xs) (\<lambda>(i,k). if i = a \<and> k \<in> set xs then 
     if k=0 then if D dvd ?reduce_xs $$ (i, k) then D else ?reduce_xs $$ (i, k)
     else ?reduce_xs $$ (i, k) gmod D else ?reduce_xs $$ (i, k))"
   proof (rule "2.hyps")
     let ?A' = "mat_of_rows n [Matrix.row (reduce_element_mod_D A a x D m) i. i \<leftarrow> [0..<m]]"
     show "reduce_element_mod_D A a x D m = ?A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
       by (rule reduce_element_mod_D_append, insert "2.prems", auto)
   qed (insert "2.prems", auto)
   also have "... = Matrix.mat (dim_row A) (dim_col A)
           (\<lambda>(i,k). if i = a \<and> k \<in> set (x # xs) then if k = 0 then if D dvd A$$(i,k)
           then D else A$$(i,k) else A$$(i,k) gmod D else A$$(i,k))" (is "?lhs = ?rhs")
   proof (rule eq_matI) 
     show "dim_row ?lhs = dim_row ?rhs" and "dim_col ?lhs = dim_col ?rhs" by auto
     fix i j assume i: "i<dim_row ?rhs" and j: "j < dim_col ?rhs"
     have jn: "j<n" using j "2.prems" by (simp add: append_rows_def)
     have xn: "x < n" by (simp add: "2.prems"(4))
     show "?lhs $$ (i,j) = ?rhs $$ (i,j)"
     proof (cases "i=a \<and> j \<in> set xs")
       case True note ia_jxs = True
       have j_not_x: "j\<noteq>x"
         using "2.prems"(5) True by auto
       show ?thesis
       proof (cases "j=0 \<and> D dvd ?reduce_xs $$(i,j)")
         case True
         have "?lhs $$ (i,j) = D"
           using True i j ia_jxs by auto
         also have "... = ?rhs $$ (i,j)" using i j j_not_x 
           by (smt "2" calculation dim_col_mat(1) dim_row_mat(1) index_mat(1) insert_iff list.set(2) prod.simps(2) xn)
         finally show ?thesis .
       next
         case False note nc1 = False
         show ?thesis
         proof (cases "j=0")
           case True
           then show ?thesis
             by (smt (z3) "2" False case_prod_conv dim_col_mat(1) dim_row_mat(1) i index_mat(1) j j_not_x xn)
         next
           case False          
       have "?lhs $$ (i,j) = ?reduce_xs $$ (i, j) gmod D"
         using True False i j by auto
       also have "... = A $$ (i,j) gmod D" using 2[OF xn] j_not_x i j by auto
       also have "... = ?rhs $$ (i,j)" using i j j_not_x \<open>D > 0\<close>        
         using False True dim_col_mat(1) dim_row_mat(1) index_mat(1) list.set_intros(2) old.prod.case
         by auto
       finally show ?thesis .
     qed
   qed
   next
       case False
       show ?thesis using 2 i j xn 
         by (smt False dim_col_mat(1) dim_row_mat(1) index_mat(1) insert_iff list.set(2) prod.simps(2))
     qed   
   qed  
   finally show ?case using 1 by simp
 qed
 
 
 
 
 lemma reduce_row_mod_D_abs:
   assumes A_def: "A = A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
     and A': "A' \<in> carrier_mat m n" and a: "a<m" and j: "\<forall>j\<in>set xs. j<n"
     and d: "distinct xs" and "m\<ge>n"
     and "D > 0" 
   shows "reduce_row_mod_D_abs A a xs D m = Matrix.mat (dim_row A) (dim_col A)
              (\<lambda>(i,k). if i = a \<and> k \<in> set xs then if k = 0 \<and> D dvd A$$(i,k)
               then D else A$$(i,k) gmod D else A$$(i,k))"
   using assms
 proof (induct A a xs D m arbitrary: A' rule: reduce_row_mod_D_abs.induct)
   case (1 A a D m)
   then show ?case by force
 next
   case (2 A a x xs D m)
   let ?reduce_xs = "(reduce_element_mod_D_abs A a x D m)"
   have 1: "reduce_row_mod_D_abs A a (x # xs) D m 
     = reduce_row_mod_D_abs ?reduce_xs a xs D m" by simp
   have 2: "reduce_element_mod_D_abs A a j D m = Matrix.mat (dim_row A) (dim_col A)
   (\<lambda>(i,k). if i = a \<and> k = j then if j = 0 \<and> D dvd A$$(i,k) then D 
     else A$$(i,k) gmod D else A$$(i,k))" if "j<n" for j
     by (rule reduce_element_mod_D, insert "2.prems" that, auto)
   have "reduce_row_mod_D_abs ?reduce_xs a xs D m =
     Matrix.mat (dim_row ?reduce_xs) (dim_col ?reduce_xs) (\<lambda>(i,k). if i = a \<and> k \<in> set xs then 
     if k=0 \<and> D dvd ?reduce_xs $$ (i, k) then D
     else ?reduce_xs $$ (i, k) gmod D else ?reduce_xs $$ (i, k))"
   proof (rule "2.hyps")
     let ?A' = "mat_of_rows n [Matrix.row (reduce_element_mod_D_abs A a x D m) i. i \<leftarrow> [0..<m]]"
     show "reduce_element_mod_D_abs A a x D m = ?A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
       by (rule reduce_element_mod_D_append, insert "2.prems", auto)
   qed (insert "2.prems", auto)
   also have "... = Matrix.mat (dim_row A) (dim_col A)
             (\<lambda>(i,k). if i = a \<and> k \<in> set (x # xs) then if k = 0 \<and> D dvd A$$(i,k)
             then D else A$$(i,k) gmod D else A$$(i,k))" (is "?lhs = ?rhs")
   proof (rule eq_matI) 
     show "dim_row ?lhs = dim_row ?rhs" and "dim_col ?lhs = dim_col ?rhs" by auto
     fix i j assume i: "i<dim_row ?rhs" and j: "j < dim_col ?rhs"
     have jn: "j<n" using j "2.prems" by (simp add: append_rows_def)
     have xn: "x < n" by (simp add: "2.prems"(4))
     show "?lhs $$ (i,j) = ?rhs $$ (i,j)"
     proof (cases "i=a \<and> j \<in> set xs")
       case True note ia_jxs = True
       have j_not_x: "j\<noteq>x"
         using "2.prems"(5) True by auto
       show ?thesis
       proof (cases "j=0 \<and> D dvd ?reduce_xs $$(i,j)")
         case True
         have "?lhs $$ (i,j) = D"
           using True i j ia_jxs by auto
         also have "... = ?rhs $$ (i,j)" using i j j_not_x 
           by (smt "2" calculation dim_col_mat(1) dim_row_mat(1) index_mat(1) insert_iff list.set(2) prod.simps(2) xn)
         finally show ?thesis .
       next
         case False 
       have "?lhs $$ (i,j) = ?reduce_xs $$ (i, j) gmod D"
         using True False i j by auto
       also have "... = A $$ (i,j) gmod D" using 2[OF xn] j_not_x i j by auto
       also have "... = ?rhs $$ (i,j)" using i j j_not_x \<open>D > 0\<close>  
         using "2" False True dim_col_mat(1) dim_row_mat(1) index_mat(1) list.set_intros(2) 
           old.prod.case xn by auto     
       finally show ?thesis .
     qed  
   next
       case False
       show ?thesis using 2 i j xn 
         by (smt False dim_col_mat(1) dim_row_mat(1) index_mat(1) insert_iff list.set(2) prod.simps(2))
     qed   
   qed  
   finally show ?case using 1 by simp
 qed
 end
 
 
 text \<open>Now, we prove some transfer rules to connect B\'ezout matrices in HOL Analysis and JNF\<close>
 (*Connecting Bezout Matrix in HOL Analysis (thm bezout_matrix_def) and JNF (thm bezout_matrix_JNF_def)*)
 lemma HMA_bezout_matrix[transfer_rule]:
   shows "((Mod_Type_Connect.HMA_M :: _ \<Rightarrow> 'a :: {bezout_ring} ^ 'n :: mod_type ^ 'm :: mod_type \<Rightarrow> _) 
   ===> (Mod_Type_Connect.HMA_I :: _ \<Rightarrow> 'm \<Rightarrow> _) ===> (Mod_Type_Connect.HMA_I :: _ \<Rightarrow> 'm \<Rightarrow> _) 
   ===> (Mod_Type_Connect.HMA_I :: _ \<Rightarrow> 'n \<Rightarrow> _) ===> (=) ===> (Mod_Type_Connect.HMA_M)) 
   (bezout_matrix_JNF) (bezout_matrix)" 
 proof (intro rel_funI, goal_cases)
   case (1 A A' a a' b b' j j' bezout bezout')
   note HMA_AA'[transfer_rule] = "1"(1)
   note HMI_aa'[transfer_rule] = "1"(2)
   note HMI_bb'[transfer_rule] = "1"(3)
   note HMI_jj'[transfer_rule] = "1"(4)
   note eq_bezout'[transfer_rule] = "1"(5)
   show ?case unfolding Mod_Type_Connect.HMA_M_def Mod_Type_Connect.from_hma\<^sub>m_def 
   proof (rule eq_matI) 
     let ?A = "Matrix.mat CARD('m) CARD('m) (\<lambda>(i, j). bezout_matrix A' a' b' j' bezout' 
         $h mod_type_class.from_nat i $h mod_type_class.from_nat j)"
     show "dim_row (bezout_matrix_JNF A a b j bezout) = dim_row ?A"
       and "dim_col (bezout_matrix_JNF A a b j bezout) = dim_col ?A"
       using Mod_Type_Connect.dim_row_transfer_rule[OF HMA_AA']
       unfolding bezout_matrix_JNF_def by auto  
     fix i ja assume i: "i < dim_row ?A" and ja: "ja < dim_col ?A"
     let ?i = "mod_type_class.from_nat i :: 'm"
     let ?ja = "mod_type_class.from_nat ja :: 'm"    
     have i_A: "i < dim_row A"
       using HMA_AA' Mod_Type_Connect.dim_row_transfer_rule i by fastforce
     have ja_A: "ja < dim_row A"
       using Mod_Type_Connect.dim_row_transfer_rule[OF HMA_AA'] ja by fastforce
     have HMA_I_ii'[transfer_rule]: "Mod_Type_Connect.HMA_I i ?i"
       unfolding Mod_Type_Connect.HMA_I_def using from_nat_not_eq i by auto
     have HMA_I_ja'[transfer_rule]: "Mod_Type_Connect.HMA_I ja ?ja"
       unfolding Mod_Type_Connect.HMA_I_def using from_nat_not_eq ja by auto
     have Aaj: "A' $h a' $h j' = A $$ (a,j)" unfolding index_hma_def[symmetric] by (transfer, simp)
     have Abj: "A' $h b' $h j' = A $$ (b, j)" unfolding index_hma_def[symmetric] by (transfer, simp) 
     have "?A $$ (i, ja) = bezout_matrix A' a' b' j' bezout' $h ?i $h ?ja" using i ja by auto
     also have "... = (let (p, q, u, v, d) = bezout' (A' $h a' $h j') (A' $h b' $h j')
             in if ?i = a' \<and> ?ja = a' then p else if ?i = a' \<and> ?ja = b' then q else if ?i = b' \<and> ?ja = a' 
             then u else if ?i = b' \<and> ?ja = b' then v else if ?i = ?ja then 1 else 0)" 
       unfolding bezout_matrix_def by auto
     also have "... =  (let 
         (p, q, u, v, d) = bezout (A $$ (a, j)) (A $$ (b, j)) 
        in
          if i = a \<and> ja = a then p else
          if i = a \<and> ja = b then q else
          if i = b \<and> ja = a then u else
          if i = b \<and> ja = b then v else
          if i = ja then 1 else 0)" unfolding eq_bezout' Aaj Abj by (transfer, simp)
     also have "... = bezout_matrix_JNF A a b j bezout $$ (i,ja)"
       unfolding bezout_matrix_JNF_def using i_A ja_A by auto
     finally show "bezout_matrix_JNF A a b j bezout $$ (i, ja) = ?A $$ (i, ja)" ..
   qed
 qed
 
 (*thm invertible_bezout_matrix must be transferred from HOL Analysis to JNF*)
 
 context
 begin
 
 private lemma invertible_bezout_matrix_JNF_mod_type:
   fixes A::"'a::{bezout_ring_div} mat"
   assumes "A \<in> carrier_mat CARD('m::mod_type) CARD('n::mod_type)"
   assumes ib: "is_bezout_ext bezout"
   and a_less_b: "a < b" and b: "b<CARD('m)" and j: "j<CARD('n)"
   and aj: "A $$ (a, j) \<noteq> 0"
 shows "invertible_mat (bezout_matrix_JNF A a b j bezout)" 
 proof -
   define A' where "A' = (Mod_Type_Connect.to_hma\<^sub>m A :: 'a ^'n :: mod_type ^'m :: mod_type)"
   define a' where "a' = (Mod_Type.from_nat a :: 'm)"
   define b' where "b' = (Mod_Type.from_nat b :: 'm)"
   define j' where "j' = (Mod_Type.from_nat j :: 'n)"
   have AA'[transfer_rule]: "Mod_Type_Connect.HMA_M A A'"
     unfolding Mod_Type_Connect.HMA_M_def using assms A'_def by auto
   have aa'[transfer_rule]: "Mod_Type_Connect.HMA_I a a'"
     unfolding Mod_Type_Connect.HMA_I_def a'_def using assms
     using from_nat_not_eq order.strict_trans by blast
   have bb'[transfer_rule]: "Mod_Type_Connect.HMA_I b b'"
     unfolding Mod_Type_Connect.HMA_I_def b'_def using assms
     using from_nat_not_eq order.strict_trans by blast
   have jj'[transfer_rule]: "Mod_Type_Connect.HMA_I j j'"
     unfolding Mod_Type_Connect.HMA_I_def j'_def using assms
     using from_nat_not_eq order.strict_trans by blast
   have [transfer_rule]: "bezout = bezout" ..
   have [transfer_rule]: "Mod_Type_Connect.HMA_M (bezout_matrix_JNF A a b j bezout) 
       (bezout_matrix A' a' b' j' bezout)"
     by transfer_prover
   have "invertible (bezout_matrix A' a' b' j' bezout)"
   proof (rule invertible_bezout_matrix[OF ib])
     show "a' < b'" using a_less_b by (simp add: a'_def b b'_def from_nat_mono)
     show "A' $h a' $h j' \<noteq> 0" unfolding index_hma_def[symmetric] using aj by (transfer, simp)
   qed
   thus ?thesis by (transfer, simp)
 qed 
 
 private lemma invertible_bezout_matrix_JNF_nontriv_mod_ring:
   fixes A::"'a::{bezout_ring_div} mat"
   assumes "A \<in> carrier_mat CARD('m::nontriv mod_ring) CARD('n::nontriv mod_ring)"
   assumes ib: "is_bezout_ext bezout"
   and a_less_b: "a < b" and b: "b<CARD('m)" and j: "j<CARD('n)"
   and aj: "A $$ (a, j) \<noteq> 0"
 shows "invertible_mat (bezout_matrix_JNF A a b j bezout)" 
   using assms invertible_bezout_matrix_JNF_mod_type by (smt CARD_mod_ring) 
 
 
 (*We internalize both sort constraints in one step*)
 lemmas invertible_bezout_matrix_JNF_internalized = 
   invertible_bezout_matrix_JNF_nontriv_mod_ring[unfolded CARD_mod_ring, 
       internalize_sort "'m::nontriv", internalize_sort "'c::nontriv"]
 
 context
   fixes m::nat and n::nat
   assumes local_typedef1: "\<exists>(Rep :: ('b \<Rightarrow> int)) Abs. type_definition Rep Abs {0..<m :: int}"
   assumes local_typedef2: "\<exists>(Rep :: ('c \<Rightarrow> int)) Abs. type_definition Rep Abs {0..<n :: int}"
   and m: "m>1"
   and n: "n>1"
 begin
 
 lemma type_to_set1:
   shows "class.nontriv TYPE('b)" (is ?a) and "m=CARD('b)" (is ?b)
 proof -
   from local_typedef1 obtain Rep::"('b \<Rightarrow> int)" and Abs 
     where t: "type_definition Rep Abs {0..<m :: int}" by auto
   have "card (UNIV :: 'b set) = card {0..<m}" using t type_definition.card by fastforce
   also have "... = m" by auto
   finally show ?b ..
   then show ?a unfolding class.nontriv_def using m by auto
 qed
 
 lemma type_to_set2:
   shows "class.nontriv TYPE('c)" (is ?a) and "n=CARD('c)" (is ?b)
 proof -
   from local_typedef2 obtain Rep::"('c \<Rightarrow> int)" and Abs 
     where t: "type_definition Rep Abs {0..<n :: int}" by blast
   have "card (UNIV :: 'c set) = card {0..<n}" using t type_definition.card by force
   also have "... = n" by auto
   finally show ?b ..
   then show ?a unfolding class.nontriv_def using n by auto
 qed
 
 
 lemma invertible_bezout_matrix_JNF_nontriv_mod_ring_aux:
   fixes A::"'a::{bezout_ring_div} mat"
   assumes "A \<in> carrier_mat m n"
   assumes ib: "is_bezout_ext bezout"
   and a_less_b: "a < b" and b: "b<m" and j: "j<n"
   and aj: "A $$ (a, j) \<noteq> 0"
 shows "invertible_mat (bezout_matrix_JNF A a b j bezout)" 
   using invertible_bezout_matrix_JNF_internalized[OF type_to_set2(1) type_to_set(1), where ?'aa = 'b]
   using assms 
   using type_to_set1(2) type_to_set2(2) local_typedef1 m by blast
 end
 
 
 (*Canceling the first local type definitions*)
 context
 begin
 
 (*Canceling the first*)
 private lemma invertible_bezout_matrix_JNF_cancelled_first:
 "\<exists>Rep Abs. type_definition Rep Abs {0..<int n} \<Longrightarrow> {0..<int m} \<noteq> {} \<Longrightarrow>
 1 < m \<Longrightarrow> 1 < n \<Longrightarrow>
 (A::'a::bezout_ring_div mat) \<in> carrier_mat m n \<Longrightarrow> is_bezout_ext bezout 
 \<Longrightarrow> a < b \<Longrightarrow> b < m \<Longrightarrow> j < n \<Longrightarrow> A $$ (a, j) \<noteq> 0 \<Longrightarrow> invertible_mat (bezout_matrix_JNF A a b j bezout)"
   using invertible_bezout_matrix_JNF_nontriv_mod_ring_aux[cancel_type_definition] by blast
 
 (*Canceling the second*)
 private lemma invertible_bezout_matrix_JNF_cancelled_both:
 "{0..<int n} \<noteq> {} \<Longrightarrow> {0..<int m} \<noteq> {} \<Longrightarrow> 1 < m \<Longrightarrow> 1 < n \<Longrightarrow>
 1 < m \<Longrightarrow> 1 < n \<Longrightarrow>
 (A::'a::bezout_ring_div mat) \<in> carrier_mat m n \<Longrightarrow> is_bezout_ext bezout 
 \<Longrightarrow> a < b \<Longrightarrow> b < m \<Longrightarrow> j < n \<Longrightarrow> A $$ (a, j) \<noteq> 0 \<Longrightarrow> invertible_mat (bezout_matrix_JNF A a b j bezout)"
   using invertible_bezout_matrix_JNF_cancelled_first[cancel_type_definition] by blast
 
 (*The final result in JNF*)
 lemma invertible_bezout_matrix_JNF':
   fixes A::"'a::{bezout_ring_div} mat"
   assumes "A \<in> carrier_mat m n"
   assumes ib: "is_bezout_ext bezout"
   and a_less_b: "a < b" and b: "b<m" and j: "j<n" 
   and "n>1" (* Required from the mod_type restrictions*)
   and aj: "A $$ (a, j) \<noteq> 0"
 shows "invertible_mat (bezout_matrix_JNF A a b j bezout)" 
   using invertible_bezout_matrix_JNF_cancelled_both assms by auto
 
 (*Trick: we want to get rid out the "n>1" assumption, which has appeared since CARD('m::mod_type)>1.
 Given an mx1 matrix, we just append another column and the bezout_matrix is the same, so it will
 also be invertible by the previous transfered theorem
 *)
 lemma invertible_bezout_matrix_JNF_n1:
   fixes A::"'a::{bezout_ring_div} mat"
   assumes A: "A \<in> carrier_mat m n"
   assumes ib: "is_bezout_ext bezout"
   and a_less_b: "a < b" and b: "b<m" and j: "j<n" 
   and n1: "n=1" (* Required from the mod_type restrictions*)
   and aj: "A $$ (a, j) \<noteq> 0"
 shows "invertible_mat (bezout_matrix_JNF A a b j bezout)" 
 proof -
   let ?A = "A @\<^sub>c (0\<^sub>m m n)"
   have "(A @\<^sub>c 0\<^sub>m m n) $$ (a, j) =  (if j < dim_col A then A $$ (a, j) else (0\<^sub>m m n) $$ (a, j - n))"     
     by (rule append_cols_nth[OF A], insert assms, auto)
   also have "... = A $$ (a,j)" using assms by auto
   finally have Aaj: "(A @\<^sub>c 0\<^sub>m m n) $$ (a, j) =  A $$ (a,j)" .
   have "(A @\<^sub>c 0\<^sub>m m n) $$ (b, j) =  (if j < dim_col A then A $$ (b, j) else (0\<^sub>m m n) $$ (b, j - n))"     
     by (rule append_cols_nth[OF A], insert assms, auto)
   also have "... = A $$ (b,j)" using assms by auto
   finally have Abj: "(A @\<^sub>c 0\<^sub>m m n) $$ (b, j) = A $$ (b, j)" .
   have dr: "dim_row A = dim_row ?A"  by (simp add: append_cols_def)
   have dc: "dim_col ?A = 2"
     by (metis Suc_1 append_cols_def A n1 carrier_matD(2) index_mat_four_block(3) 
         index_zero_mat(3) plus_1_eq_Suc)
   have bz_eq: "bezout_matrix_JNF A a b j bezout = bezout_matrix_JNF ?A a b j bezout"
     unfolding bezout_matrix_JNF_def Aaj Abj dr by auto
   have "invertible_mat (bezout_matrix_JNF ?A a b j bezout)"
     by (rule invertible_bezout_matrix_JNF', insert assms Aaj Abj dr dc, auto)
   thus ?thesis using bz_eq by simp
 qed
 
 (*The final result in JNF without requiring n>1*)
 corollary invertible_bezout_matrix_JNF:
   fixes A::"'a::{bezout_ring_div} mat"
   assumes "A \<in> carrier_mat m n"
   assumes ib: "is_bezout_ext bezout"
   and a_less_b: "a < b" and b: "b<m" and j: "j<n" 
   and aj: "A $$ (a, j) \<noteq> 0"
 shows "invertible_mat (bezout_matrix_JNF A a b j bezout)" 
   using invertible_bezout_matrix_JNF_n1 invertible_bezout_matrix_JNF' assms
   by (metis One_nat_def gr_implies_not0 less_Suc0 not_less_iff_gr_or_eq)
 
 end
 end
 
 text \<open>We continue with the soundness of the algorithm\<close>
 
 lemma bezout_matrix_JNF_mult_eq:
   assumes A': "A' \<in> carrier_mat m n" and a: "a\<le>m"  and b: "b\<le>m" and ab: "a \<noteq> b" 
   and A_def: "A = A' @\<^sub>r B" and B: "B \<in> carrier_mat n n"
   assumes pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,j)) (A$$(b,j))"
   shows "Matrix.mat (dim_row A) (dim_col A)
           (\<lambda>(i,k). if i = a then (p*A$$(a,k) + q*A$$(b,k))
                    else if i = b then u * A$$(a,k) + v * A$$(b,k)
                    else A$$(i,k)
             ) = (bezout_matrix_JNF A a b j euclid_ext2) * A" (is "?A = ?BM * A")
 proof (rule eq_matI) 
   have A: "A \<in> carrier_mat (m+n) n" using A_def A' B by simp
   hence A_carrier: "?A \<in> carrier_mat (m+n) n" by auto  
   show dr: "dim_row ?A = dim_row (?BM * A)" and dc: "dim_col ?A = dim_col (?BM * A)"
     unfolding bezout_matrix_JNF_def by auto
   fix i ja assume i: "i < dim_row  (?BM * A)" and ja: "ja < dim_col (?BM * A)"
   let ?f = "\<lambda>ia. (bezout_matrix_JNF A a b j euclid_ext2) $$ (i,ia) * A $$ (ia,ja)"
   have dv: "dim_vec (col A ja) = m+n" using A by auto
   have i_dr: "i<dim_row A" using i A unfolding bezout_matrix_JNF_def by auto
   have a_dr: "a<dim_row A" using A a ja by auto
   have b_dr: "b<dim_row A" using A b ja by auto
   show "?A $$ (i,ja) = (?BM * A) $$ (i,ja)"
   proof -
     have "(?BM * A) $$ (i,ja) = Matrix.row ?BM i \<bullet> col A ja"
       by (rule index_mult_mat, insert i ja, auto)
     also have "... = (\<Sum>ia = 0..<dim_vec (col A ja). 
           Matrix.row (bezout_matrix_JNF A a b j euclid_ext2) i $v ia * col A ja $v ia)"
       by (simp add: scalar_prod_def)
     also have "... = (\<Sum>ia = 0..<m+n. ?f ia)"
       by (rule sum.cong, insert A i dr dc, auto) (smt bezout_matrix_JNF_def carrier_matD(1) 
           dim_col_mat(1) index_col index_mult_mat(3) index_row(1) ja)
     also have "... = (\<Sum>ia \<in> ({a,b} \<union> ({0..<m+n} - {a,b})). ?f ia)"
       by (rule sum.cong, insert a a_dr b A ja, auto)
     also have "... = sum ?f {a,b} + sum ?f ({0..<m+n} - {a,b})" 
       by (rule sum.union_disjoint, auto)
     finally have BM_A_ija_eq: "(?BM * A) $$ (i,ja) = sum ?f {a,b} + sum ?f ({0..<m+n} - {a,b})" by auto
     show ?thesis
     proof (cases "i = a")
       case True
       have sum0: "sum ?f ({0..<m+n} - {a,b}) = 0"
       proof (rule sum.neutral, rule)
         fix x assume x: "x \<in> {0..<m + n} - {a, b}"
         hence xm: "x < m+n" by auto
         have x_not_i: "x \<noteq> i" using True x by blast
         have x_dr: "x < dim_row A" using x A by auto
         have "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, x) = 0"
           unfolding bezout_matrix_JNF_def 
           unfolding index_mat(1)[OF i_dr x_dr] using x_not_i x by auto
         thus "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, x) * A $$ (x, ja) = 0" by auto
       qed
       have fa: "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, a) = p" 
         unfolding bezout_matrix_JNF_def index_mat(1)[OF i_dr a_dr] using True pquvd 
         by (auto, metis split_conv)
       have fb: "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, b) = q"
         unfolding bezout_matrix_JNF_def index_mat(1)[OF i_dr b_dr] using True pquvd ab
         by (auto, metis split_conv)
       have "sum ?f {a,b} + sum ?f ({0..<m+n} - {a,b}) = ?f a + ?f b" using sum0 by (simp add: ab)
       also have "... = p * A $$ (a, ja) + q * A $$ (b, ja)" unfolding fa fb by simp
       also have "... = ?A $$ (i,ja)" using A True dr i ja by auto
       finally show ?thesis using BM_A_ija_eq by simp
     next
       case False note i_not_a = False
       show ?thesis
       proof (cases "i=b")
         case True
         have sum0: "sum ?f ({0..<m+n} - {a,b}) = 0"
         proof (rule sum.neutral, rule)
           fix x assume x: "x \<in> {0..<m + n} - {a, b}"
           hence xm: "x < m+n" by auto
           have x_not_i: "x \<noteq> i" using True x by blast
           have x_dr: "x < dim_row A" using x A by auto
           have "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, x) = 0"
             unfolding bezout_matrix_JNF_def 
             unfolding index_mat(1)[OF i_dr x_dr] using x_not_i x by auto
           thus "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, x) * A $$ (x, ja) = 0" by auto
         qed
         have fa: "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, a) = u" 
           unfolding bezout_matrix_JNF_def index_mat(1)[OF i_dr a_dr] using True i_not_a pquvd 
           by (auto, metis split_conv)
         have fb: "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, b) = v"
           unfolding bezout_matrix_JNF_def index_mat(1)[OF i_dr b_dr] using True i_not_a pquvd ab
           by (auto, metis split_conv)
         have "sum ?f {a,b} + sum ?f ({0..<m+n} - {a,b}) = ?f a + ?f b" using sum0 by (simp add: ab)
         also have "... = u * A $$ (a, ja) + v * A $$ (b, ja)" unfolding fa fb by simp
         also have "... = ?A $$ (i,ja)" using A True i_not_a dr i ja by auto
         finally show ?thesis using BM_A_ija_eq by simp
       next
         case False note i_not_b = False
         have sum0: "sum ?f ({0..<m+n} - {a,b} - {i}) = 0" 
         proof (rule sum.neutral, rule)
           fix x assume x: "x \<in> {0..<m + n} - {a, b} - {i}"
           hence xm: "x < m+n" by auto
           have x_not_i: "x \<noteq> i" using x by blast
           have x_dr: "x < dim_row A" using x A by auto
           have "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, x) = 0"
             unfolding bezout_matrix_JNF_def 
             unfolding index_mat(1)[OF i_dr x_dr] using x_not_i x by auto
           thus "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, x) * A $$ (x, ja) = 0" by auto
         qed
         have fa: "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, a) = 0" 
           unfolding bezout_matrix_JNF_def index_mat(1)[OF i_dr a_dr] using False i_not_a pquvd 
           by auto
         have fb: "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, b) = 0" 
           unfolding bezout_matrix_JNF_def index_mat(1)[OF i_dr b_dr] using False i_not_a pquvd 
           by auto
         have "sum ?f ({0..<m+n} - {a,b}) = sum ?f (insert i ({0..<m+n} - {a,b} - {i}))"
           by (rule sum.cong, insert i_dr A i_not_a i_not_b, auto)
         also have "... = ?f i + sum ?f ({0..<m+n} - {a,b} - {i})" by (rule sum.insert, auto)
         also have "... = ?f i" using sum0 by simp
         also have "... = ?A $$ (i,ja)"
           unfolding bezout_matrix_JNF_def using i_not_a i_not_b  A dr i ja by fastforce
         finally show ?thesis unfolding BM_A_ija_eq by (simp add: ab fa fb)
       qed    
     qed
   qed
 qed
 
 
 
 
 context proper_mod_operation
 begin
 
 lemma reduce_invertible_mat: 
   assumes A': "A' \<in> carrier_mat m n" and a: "a<m" and j: "0<n" and b: "b<m" and ab: "a \<noteq> b" 
   and A_def: "A = A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
   and Aaj: "A $$ (a,0) \<noteq> 0"
   and a_less_b: "a < b"
   and mn: "m\<ge>n"
   and D_ge0: "D > 0"
 shows "\<exists>P. invertible_mat P \<and> P \<in> carrier_mat (m+n) (m+n) \<and> (reduce a b D A) = P * A" (is ?thesis1)
 proof -
   obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(b,0))"
     by (metis prod_cases5)
   let ?A = "Matrix.mat (dim_row A) (dim_col A)
           (\<lambda>(i,k). if i = a then (p*A$$(a,k) + q*A$$(b,k))
                    else if i = b then u * A$$(a,k) + v * A$$(b,k)
                    else A$$(i,k)
             )"
   have D: "D \<cdot>\<^sub>m 1\<^sub>m n \<in> carrier_mat n n" by auto
   have A: "A \<in> carrier_mat (m+n) n" using A_def A' by simp
   hence A_carrier: "?A \<in> carrier_mat (m+n) n" by auto
 
   let ?BM = "bezout_matrix_JNF A a b 0 euclid_ext2" 
   have A'_BZ_A: "?A = ?BM * A"
     by (rule bezout_matrix_JNF_mult_eq[OF A' _ _ ab A_def D pquvd], insert a b, auto)  
   have invertible_bezout: "invertible_mat ?BM"
     by (rule invertible_bezout_matrix_JNF[OF A is_bezout_ext_euclid_ext2 a_less_b _ j Aaj],
         insert a_less_b b, auto)      
   have BM: "?BM \<in> carrier_mat (m+n) (m+n)" unfolding bezout_matrix_JNF_def using A by auto
 
   define xs where "xs = [0..<n]"
   let ?reduce_a = "reduce_row_mod_D ?A a xs D m"
   let ?A' = "mat_of_rows n [Matrix.row ?A i. i \<leftarrow> [0..<m]]"
   have A_A'_D: "?A = ?A' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
   proof (rule matrix_append_rows_eq_if_preserves[OF A_carrier D], rule+)
     fix i j assume i: "i \<in> {m..<m + n}" and j: "j < n"
     have "?A $$ (i,j) = A $$ (i,j)" using i a b A j by auto
     also have "... = (if i < dim_row A' then A' $$(i,j) else (D \<cdot>\<^sub>m (1\<^sub>m n))$$(i-m,j))"
       by (unfold A_def, rule append_rows_nth[OF A' D _ j], insert i, auto)
     also have "... = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i - m, j)" using i A' by auto
     finally show "?A $$ (i,j) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i - m, j)" .   
   qed
   have reduce_a_eq: "?reduce_a = Matrix.mat (dim_row ?A) (dim_col ?A) 
     (\<lambda>(i, k). if i = a \<and> k \<in> set xs then if k = 0 then if D dvd ?A$$(i,k) then D
               else ?A $$ (i, k) else ?A $$ (i, k) gmod D else ?A $$ (i, k))"
     by (rule reduce_row_mod_D[OF A_A'_D _ a _], insert xs_def mn D_ge0, auto)  
   have reduce_a: "?reduce_a \<in> carrier_mat (m+n) n"  using reduce_a_eq A by auto
   have "\<exists>P. P \<in> carrier_mat (m + n) (m + n) \<and> invertible_mat P \<and> ?reduce_a = P * ?A"
     by (rule reduce_row_mod_D_invertible_mat[OF A_A'_D _ a], insert xs_def mn, auto)    
   from this obtain P where P: "P \<in> carrier_mat (m + n) (m + n)" and inv_P: "invertible_mat P" 
     and reduce_a_PA: "?reduce_a = P * ?A" by blast
   define ys where "ys = [1..<n]"
   let ?reduce_b = "reduce_row_mod_D ?reduce_a b ys D m"
   let ?B' = "mat_of_rows n [Matrix.row ?reduce_a i. i \<leftarrow> [0..<m]]"
   have reduce_a_B'_D: "?reduce_a = ?B' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
   proof (rule matrix_append_rows_eq_if_preserves[OF reduce_a D], rule+)
     fix i ja assume i: "i \<in> {m..<m + n}" and ja: "ja < n"
     have i_not_a:"i\<noteq>a" and i_not_b: "i\<noteq>b" using i a b by auto
     have "?reduce_a $$ (i,ja) = ?A $$ (i, ja)"
       unfolding reduce_a_eq using i i_not_a i_not_b ja A by auto      
     also have "... = A $$ (i,ja)"  using i i_not_a i_not_b ja A by auto
     also have "... = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i - m, ja)"
       by (smt D append_rows_nth A' A_def atLeastLessThan_iff 
           carrier_matD(1) i ja less_irrefl_nat nat_SN.compat)    
     finally show "?reduce_a $$ (i,ja) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i - m, ja)" .
   qed
   have reduce_b_eq: "?reduce_b = Matrix.mat (dim_row ?reduce_a) (dim_col ?reduce_a) 
     (\<lambda>(i, k). if i = b \<and> k \<in> set ys then if k = 0 then if D dvd ?reduce_a$$(i,k) then D else ?reduce_a $$ (i, k)
       else ?reduce_a $$ (i, k) gmod D else ?reduce_a $$ (i, k))"
     by (rule reduce_row_mod_D[OF reduce_a_B'_D _ b _ _ mn], unfold ys_def, insert D_ge0, auto)
   have "\<exists>P. P \<in> carrier_mat (m + n) (m + n) \<and> invertible_mat P \<and> ?reduce_b = P * ?reduce_a"
     by (rule reduce_row_mod_D_invertible_mat[OF reduce_a_B'_D _ b _ mn], insert ys_def, auto)    
   from this obtain Q where Q: "Q \<in> carrier_mat (m + n) (m + n)" and inv_Q: "invertible_mat Q" 
     and reduce_b_Q_reduce: "?reduce_b = Q * ?reduce_a" by blast
   have reduce_b_eq_reduce: "?reduce_b = (reduce a b D A)"
   proof (rule eq_matI)
     show dr_eq: "dim_row ?reduce_b = dim_row (reduce a b D A)" 
       and dc_eq: "dim_col ?reduce_b = dim_col (reduce a b D A)"
       using reduce_preserves_dimensions by auto
     fix i ja assume i: "i<dim_row (reduce a b D A)" and ja: "ja< dim_col (reduce a b D A)"
     have im: "i<m+n" using A i reduce_preserves_dimensions(1) by auto
     have ja_n: "ja<n" using A ja reduce_preserves_dimensions(2) by auto
     show "?reduce_b $$ (i,ja) = (reduce a b D A) $$ (i,ja)"
     proof (cases "(i\<noteq>a \<and> i\<noteq>b)")
       case True
       have "?reduce_b $$ (i,ja) = ?reduce_a $$ (i,ja)" unfolding reduce_b_eq 
         by (smt True dr_eq dc_eq i index_mat(1) ja prod.simps(2) reduce_row_mod_D_preserves_dimensions)
       also have "... = ?A $$ (i,ja)"
         by (smt A True carrier_matD(2) dim_col_mat(1) dim_row_mat(1) i index_mat(1) ja_n 
             reduce_a_eq reduce_preserves_dimensions(1) split_conv)
       also have "... = A $$ (i,ja)" using A True im ja_n by auto
       also have "... = (reduce a b D A) $$ (i,ja)" unfolding reduce_alt_def_not0[OF Aaj pquvd]
         using im ja_n A True by auto
       finally show ?thesis .      
     next
       case False note a_or_b = False
       show ?thesis
       proof (cases "i=a")
         case True note ia = True
         hence i_not_b: "i\<noteq>b" using ab by auto
         show ?thesis
         proof -
           have ja_in_xs: "ja \<in> set xs"
             unfolding xs_def using True ja_n im a A unfolding set_filter by auto
           have 1: "?reduce_b $$ (i,ja) = ?reduce_a $$ (i,ja)" unfolding reduce_b_eq             
             by (smt ab dc_eq dim_row_mat(1) dr_eq i ia index_mat(1) ja prod.simps(2)
                 reduce_b_eq reduce_row_mod_D_preserves_dimensions(2))
           show ?thesis 
           proof (cases "ja = 0 \<and> D dvd p*A$$(a,ja) + q*A$$(b,ja)")
             case True
             have "?reduce_a $$ (i,ja) = D"
               unfolding reduce_a_eq using True ab a_or_b i_not_b ja_n im a A ja_in_xs False by auto
             also have "... = (reduce a b D A) $$ (i,ja)"
               unfolding reduce_alt_def_not0[OF Aaj pquvd]
               using True a_or_b i_not_b ja_n im A False                
               by auto 
             finally show ?thesis using 1 by simp
           next
             case False note nc1 = False
             show ?thesis
             proof (cases "ja=0")
               case True
               then show ?thesis
                 by (smt (z3) "1" A assms(3) assms(7) dim_col_mat(1) dim_row_mat(1) euclid_ext2_works i ia im index_mat(1)
                     ja ja_in_xs old.prod.case pquvd reduce_gcd reduce_preserves_dimensions reduce_a_eq)
             next
               case False
               have "?reduce_a $$ (i,ja) = ?A $$ (i, ja) gmod D"
                 unfolding reduce_a_eq using True ab a_or_b i_not_b ja_n im a A ja_in_xs False by auto
               also have "... = (reduce a b D A) $$ (i,ja)"
                 unfolding reduce_alt_def_not0[OF Aaj pquvd] using True a_or_b i_not_b ja_n im A False by auto
               finally show ?thesis using 1 by simp
           qed    
         qed        
       qed
       next
         case False note i_not_a = False
         have i_drb: "i<dim_row ?reduce_b"
           and i_dra: "i<dim_row ?reduce_a"
           and ja_drb: "ja < dim_col ?reduce_b"
           and ja_dra: "ja < dim_col ?reduce_a" using reduce_carrier[OF A] i ja A dr_eq dc_eq by auto
           have ib: "i=b" using False a_or_b by auto
         show ?thesis
         proof (cases "ja \<in> set  ys")
           case True note ja_in_ys = True     
           hence ja_not0: "ja \<noteq> 0" unfolding ys_def by auto
           have "?reduce_b $$ (i,ja) = (if ja = 0 then if D dvd ?reduce_a$$(i,ja) then D
                 else ?reduce_a $$ (i, ja) else ?reduce_a $$ (i, ja) gmod D)"
             unfolding reduce_b_eq using i_not_a True  ja ja_in_ys 
             by (smt i_dra ja_dra a_or_b index_mat(1) prod.simps(2))
           also have "... = (if ja = 0 then if D dvd ?reduce_a$$(i,ja) then D else ?A $$ (i, ja) else ?A $$ (i, ja) gmod D)"
             unfolding reduce_a_eq using True ab a_or_b ib False ja_n im a A ja_in_ys by auto
           also have "... = (reduce a b D A) $$ (i,ja)"
             unfolding reduce_alt_def_not0[OF Aaj pquvd] using True ja_not0 False a_or_b ib ja_n im A 
             using i_not_a by auto                
           finally show ?thesis .
         next
           case False
           hence ja0:"ja = 0" using ja_n unfolding ys_def by auto
           have rw0: "u * A $$ (a, ja) + v * A $$ (b, ja) = 0"
             unfolding euclid_ext2_works[OF pquvd[symmetric]] ja0
             by (smt euclid_ext2_works[OF pquvd[symmetric]] more_arith_simps(11) mult.commute mult_minus_left)
           have "?reduce_b $$ (i,ja) = ?reduce_a $$ (i,ja)" unfolding reduce_b_eq             
             by (smt False a_or_b dc_eq dim_row_mat(1) dr_eq i index_mat(1) ja 
                 prod.simps(2) reduce_b_eq reduce_row_mod_D_preserves_dimensions(2))
           also have "... = ?A $$ (i, ja)"
             unfolding reduce_a_eq using False ab a_or_b i_not_a ja_n im a A  by auto
           also have "... = u * A $$ (a, ja) + v * A $$ (b, ja)" 
             by (smt (verit, ccfv_SIG) A \<open>ja = 0\<close> assms(3) assms(5) carrier_matD(2) i ib index_mat(1)
                 old.prod.case reduce_preserves_dimensions(1))  
           also have "... = (reduce a b D A) $$ (i,ja)"
             unfolding reduce_alt_def_not0[OF Aaj pquvd] 
             using False a_or_b i_not_a ja_n im A ja0 by auto
           finally show ?thesis .
         qed
       qed      
     qed    
   qed
   have inv_QPBM: "invertible_mat (Q * P * ?BM)"
     by (meson BM P Q inv_P inv_Q invertible_bezout invertible_mult_JNF mult_carrier_mat)
   moreover have "(Q*P*?BM) \<in> carrier_mat (m + n) (m + n)" using BM P Q by auto
   moreover have "(reduce a b D A) = (Q*P*?BM) * A"
   proof -
     have "?BM * A = ?A" using A'_BZ_A by auto
     hence "P * (?BM * A) = ?reduce_a" using reduce_a_PA by auto
     hence "Q * (P * (?BM * A)) = ?reduce_b" using reduce_b_Q_reduce by auto
     thus ?thesis using reduce_b_eq_reduce
       by (smt A A'_BZ_A A_carrier BM P Q assoc_mult_mat mn mult_carrier_mat reduce_a_PA)  
   qed
   ultimately show ?thesis by blast
 qed
 
 
 lemma reduce_abs_invertible_mat: 
   assumes A': "A' \<in> carrier_mat m n" and a: "a<m" and j: "0<n" and b: "b<m" and ab: "a \<noteq> b" 
   and A_def: "A = A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
   and Aaj: "A $$ (a,0) \<noteq> 0"
   and a_less_b: "a < b"
   and mn: "m\<ge>n"
   and D_ge0: "D > 0"
 shows "\<exists>P. invertible_mat P \<and> P \<in> carrier_mat (m+n) (m+n) \<and> (reduce_abs a b D A) = P * A" (is ?thesis1)
 proof -
   obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(b,0))"
     by (metis prod_cases5)
   let ?A = "Matrix.mat (dim_row A) (dim_col A)
           (\<lambda>(i,k). if i = a then (p*A$$(a,k) + q*A$$(b,k))
                    else if i = b then u * A$$(a,k) + v * A$$(b,k)
                    else A$$(i,k)
             )"
   have D: "D \<cdot>\<^sub>m 1\<^sub>m n \<in> carrier_mat n n" by auto
   have A: "A \<in> carrier_mat (m+n) n" using A_def A' by simp
   hence A_carrier: "?A \<in> carrier_mat (m+n) n" by auto
 
   let ?BM = "bezout_matrix_JNF A a b 0 euclid_ext2" 
   have A'_BZ_A: "?A = ?BM * A"
     by (rule bezout_matrix_JNF_mult_eq[OF A' _ _ ab A_def D pquvd], insert a b, auto)  
   have invertible_bezout: "invertible_mat ?BM"
     by (rule invertible_bezout_matrix_JNF[OF A is_bezout_ext_euclid_ext2 a_less_b _ j Aaj],
         insert a_less_b b, auto)      
   have BM: "?BM \<in> carrier_mat (m+n) (m+n)" unfolding bezout_matrix_JNF_def using A by auto
 
   define xs where "xs = filter (\<lambda>i. abs (?A $$ (a,i)) > D) [0..<n]"
   let ?reduce_a = "reduce_row_mod_D_abs ?A a xs D m"
   let ?A' = "mat_of_rows n [Matrix.row ?A i. i \<leftarrow> [0..<m]]"
   have A_A'_D: "?A = ?A' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
   proof (rule matrix_append_rows_eq_if_preserves[OF A_carrier D], rule+)
     fix i j assume i: "i \<in> {m..<m + n}" and j: "j < n"
     have "?A $$ (i,j) = A $$ (i,j)" using i a b A j by auto
     also have "... = (if i < dim_row A' then A' $$(i,j) else (D \<cdot>\<^sub>m (1\<^sub>m n))$$(i-m,j))"
       by (unfold A_def, rule append_rows_nth[OF A' D _ j], insert i, auto)
     also have "... = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i - m, j)" using i A' by auto
     finally show "?A $$ (i,j) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i - m, j)" .   
   qed
   have reduce_a_eq: "?reduce_a = Matrix.mat (dim_row ?A) (dim_col ?A) 
     (\<lambda>(i, k). if i = a \<and> k \<in> set xs then 
       if k = 0 \<and> D dvd ?A$$(i,k) then D else ?A $$ (i, k) gmod D else ?A $$ (i, k))"
     by (rule reduce_row_mod_D_abs[OF A_A'_D _ a _], insert xs_def mn D_ge0, auto)  
   have reduce_a: "?reduce_a \<in> carrier_mat (m+n) n"  using reduce_a_eq A by auto
   have "\<exists>P. P \<in> carrier_mat (m + n) (m + n) \<and> invertible_mat P \<and> ?reduce_a = P * ?A"
     by (rule reduce_row_mod_D_abs_invertible_mat[OF A_A'_D _ a], insert xs_def mn, auto)    
   from this obtain P where P: "P \<in> carrier_mat (m + n) (m + n)" and inv_P: "invertible_mat P" 
     and reduce_a_PA: "?reduce_a = P * ?A" by blast
   define ys where "ys = filter (\<lambda>i. abs (?A $$ (b,i)) > D) [0..<n]"
   let ?reduce_b = "reduce_row_mod_D_abs ?reduce_a b ys D m"
   let ?B' = "mat_of_rows n [Matrix.row ?reduce_a i. i \<leftarrow> [0..<m]]"
   have reduce_a_B'_D: "?reduce_a = ?B' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
   proof (rule matrix_append_rows_eq_if_preserves[OF reduce_a D], rule+)
     fix i ja assume i: "i \<in> {m..<m + n}" and ja: "ja < n"
     have i_not_a:"i\<noteq>a" and i_not_b: "i\<noteq>b" using i a b by auto
     have "?reduce_a $$ (i,ja) = ?A $$ (i, ja)"
       unfolding reduce_a_eq using i i_not_a i_not_b ja A by auto      
     also have "... = A $$ (i,ja)"  using i i_not_a i_not_b ja A by auto
     also have "... = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i - m, ja)"
       by (smt D append_rows_nth A' A_def atLeastLessThan_iff 
           carrier_matD(1) i ja less_irrefl_nat nat_SN.compat)    
     finally show "?reduce_a $$ (i,ja) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i - m, ja)" .
   qed
   have reduce_b_eq: "?reduce_b = Matrix.mat (dim_row ?reduce_a) (dim_col ?reduce_a) 
     (\<lambda>(i, k). if i = b \<and> k \<in> set ys then if k = 0 \<and> D dvd ?reduce_a$$(i,k) then D 
       else ?reduce_a $$ (i, k) gmod D else ?reduce_a $$ (i, k))"
     by (rule reduce_row_mod_D_abs[OF reduce_a_B'_D _ b _ _ mn], unfold ys_def, insert D_ge0, auto)
   have "\<exists>P. P \<in> carrier_mat (m + n) (m + n) \<and> invertible_mat P \<and> ?reduce_b = P * ?reduce_a"
     by (rule reduce_row_mod_D_abs_invertible_mat[OF reduce_a_B'_D _ b _ mn], insert ys_def, auto)    
   from this obtain Q where Q: "Q \<in> carrier_mat (m + n) (m + n)" and inv_Q: "invertible_mat Q" 
     and reduce_b_Q_reduce: "?reduce_b = Q * ?reduce_a" by blast
   have reduce_b_eq_reduce: "?reduce_b = (reduce_abs a b D A)"
   proof (rule eq_matI)
     show dr_eq: "dim_row ?reduce_b = dim_row (reduce_abs a b D A)" 
       and dc_eq: "dim_col ?reduce_b = dim_col (reduce_abs a b D A)"
       using reduce_preserves_dimensions by auto
     fix i ja assume i: "i<dim_row (reduce_abs a b D A)" and ja: "ja< dim_col (reduce_abs a b D A)"
     have im: "i<m+n" using A i reduce_preserves_dimensions(3) by auto
     have ja_n: "ja<n" using A ja reduce_preserves_dimensions(4) by auto
     show "?reduce_b $$ (i,ja) = (reduce_abs a b D A) $$ (i,ja)"
     proof (cases "(i\<noteq>a \<and> i\<noteq>b)")
       case True
       have "?reduce_b $$ (i,ja) = ?reduce_a $$ (i,ja)" unfolding reduce_b_eq 
         by (smt True dr_eq dc_eq i index_mat(1) ja prod.simps(2) reduce_row_mod_D_preserves_dimensions_abs)
       also have "... = ?A $$ (i,ja)"
         by (smt A True carrier_matD(2) dim_col_mat(1) dim_row_mat(1) i index_mat(1) ja_n 
             reduce_a_eq reduce_preserves_dimensions(3) split_conv)
       also have "... = A $$ (i,ja)" using A True im ja_n by auto
       also have "... = (reduce_abs a b D A) $$ (i,ja)" unfolding reduce_alt_def_not0[OF Aaj pquvd]
         using im ja_n A True by auto
       finally show ?thesis .      
     next
       case False note a_or_b = False
       show ?thesis
       proof (cases "i=a")
         case True note ia = True
         hence i_not_b: "i\<noteq>b" using ab by auto
         show ?thesis
         proof (cases "abs((p*A$$(a,ja) + q*A$$(b,ja))) > D")
           case True note ge_D = True
           have ja_in_xs: "ja \<in> set xs"
             unfolding xs_def using True ja_n im a A unfolding set_filter by auto
           have 1: "?reduce_b $$ (i,ja) = ?reduce_a $$ (i,ja)" unfolding reduce_b_eq             
             by (smt ab dc_eq dim_row_mat(1) dr_eq i ia index_mat(1) ja prod.simps(2)
                 reduce_b_eq reduce_row_mod_D_preserves_dimensions_abs(2))
           show ?thesis 
           proof (cases "ja = 0 \<and> D dvd p*A$$(a,ja) + q*A$$(b,ja)")
             case True
             have "?reduce_a $$ (i,ja) = D"
               unfolding reduce_a_eq using True ab a_or_b i_not_b ja_n im a A ja_in_xs False by auto
             also have "... = (reduce_abs a b D A) $$ (i,ja)"
               unfolding reduce_alt_def_not0[OF Aaj pquvd]
               using True a_or_b i_not_b ja_n im A False ge_D               
               by auto 
             finally show ?thesis using 1 by simp
           next
             case False
             have "?reduce_a $$ (i,ja) = ?A $$ (i, ja) gmod D"
               unfolding reduce_a_eq using True ab a_or_b i_not_b ja_n im a A ja_in_xs False by auto
             also have "... = (reduce_abs a b D A) $$ (i,ja)"
               unfolding reduce_alt_def_not0[OF Aaj pquvd] using True a_or_b i_not_b ja_n im A False by auto
             finally show ?thesis using 1 by simp
           qed        
         next
           case False
           have ja_in_xs: "ja \<notin> set xs"
             unfolding xs_def using False ja_n im a A unfolding set_filter by auto
           have "?reduce_b $$ (i,ja) = ?reduce_a $$ (i,ja)" unfolding reduce_b_eq             
             by (smt ab dc_eq dim_row_mat(1) dr_eq i ia index_mat(1) ja prod.simps(2)
                 reduce_b_eq reduce_row_mod_D_preserves_dimensions_abs(2))
           also have "... = ?A $$ (i, ja)"
             unfolding reduce_a_eq using False ab a_or_b i_not_b ja_n im a A ja_in_xs by auto
           also have "... = (reduce_abs a b D A) $$ (i,ja)"
             unfolding reduce_alt_def_not0[OF Aaj pquvd] using False a_or_b i_not_b ja_n im A by auto
           finally show ?thesis .
         qed      
       next
         case False note i_not_a = False
         have i_drb: "i<dim_row ?reduce_b"
           and i_dra: "i<dim_row ?reduce_a"
           and ja_drb: "ja < dim_col ?reduce_b"
           and ja_dra: "ja < dim_col ?reduce_a" using reduce_carrier[OF A] i ja A dr_eq dc_eq by auto
           have ib: "i=b" using False a_or_b by auto
         show ?thesis
         proof (cases "abs((u*A$$(a,ja) + v * A$$(b,ja))) > D")
           case True note ge_D = True
           have ja_in_ys: "ja \<in> set ys"
             unfolding ys_def using True False ib ja_n im a b A unfolding set_filter by auto
           have "?reduce_b $$ (i,ja) = (if ja = 0 \<and> D dvd ?reduce_a$$(i,ja) then D else ?reduce_a $$ (i, ja) gmod D)"          
             unfolding reduce_b_eq using i_not_a True  ja ja_in_ys 
             by (smt i_dra ja_dra a_or_b index_mat(1) prod.simps(2))
           also have "... = (if ja = 0 \<and> D dvd ?reduce_a$$(i,ja) then D else ?A $$ (i, ja) gmod D)"   
             unfolding reduce_a_eq using True ab a_or_b ib False ja_n im a A ja_in_ys by auto
           also have "... = (reduce_abs a b D A) $$ (i,ja)"
           proof (cases "ja = 0 \<and> D dvd ?reduce_a$$(i,ja)")
             case True
             have ja0: "ja=0" using True by auto
             have "u * A $$ (a, ja) + v * A $$ (b, ja) = 0"
               unfolding euclid_ext2_works[OF pquvd[symmetric]] ja0
               by (smt euclid_ext2_works[OF pquvd[symmetric]] more_arith_simps(11) mult.commute mult_minus_left)
             hence abs_0: "abs((u*A$$(a,ja) + v * A$$(b,ja))) = 0" by auto
             show ?thesis using abs_0 D_ge0 ge_D by linarith           
           next
             case False
             then show ?thesis 
               unfolding reduce_alt_def_not0[OF Aaj pquvd] using True ge_D False a_or_b ib ja_n im A 
               using i_not_a by auto           
           qed              
           finally show ?thesis .
         next
           case False
           have ja_in_ys: "ja \<notin> set ys"
             unfolding ys_def using i_not_a False ib ja_n im a b A unfolding set_filter by auto
           have "?reduce_b $$ (i,ja) = ?reduce_a $$ (i,ja)" unfolding reduce_b_eq                         
             using i_dra ja_dra ja_in_ys by auto
           also have "... = ?A $$ (i, ja)"
             unfolding reduce_a_eq using False ab a_or_b i_not_a ja_n im a A  by auto
           also have "... = u * A $$ (a, ja) + v * A $$ (b, ja)" 
             unfolding reduce_a_eq using False ab a_or_b i_not_a ja_n im a A ja_in_ys by auto            
           also have "... = (reduce_abs a b D A) $$ (i,ja)"
             unfolding reduce_alt_def_not0[OF Aaj pquvd] 
             using False a_or_b i_not_a ja_n im A by auto
           finally show ?thesis .
         qed
       qed      
     qed    
   qed
   have inv_QPBM: "invertible_mat (Q * P * ?BM)"
     by (meson BM P Q inv_P inv_Q invertible_bezout invertible_mult_JNF mult_carrier_mat)
   moreover have "(Q*P*?BM) \<in> carrier_mat (m + n) (m + n)" using BM P Q by auto
   moreover have "(reduce_abs a b D A) = (Q*P*?BM) * A"
   proof -
     have "?BM * A = ?A" using A'_BZ_A by auto
     hence "P * (?BM * A) = ?reduce_a" using reduce_a_PA by auto
     hence "Q * (P * (?BM * A)) = ?reduce_b" using reduce_b_Q_reduce by auto
     thus ?thesis using reduce_b_eq_reduce
       by (smt A A'_BZ_A A_carrier BM P Q assoc_mult_mat mn mult_carrier_mat reduce_a_PA)  
   qed
   ultimately show ?thesis by blast
 qed
 
 
 
 
 lemma reduce_element_mod_D_case_m':
   assumes A_def: "A = A' @\<^sub>r  B" and B: "B\<in>carrier_mat n n"
   and A': "A' \<in> carrier_mat m n" and a: "a\<le>m" and j: "j<n" 
   and mn: "m>=n" and B1: "B $$ (j, j) = D" and B2: "(\<forall>j'\<in>{0..<n}-{j}. B $$ (j, j') = 0)"
   and D0: "D > 0" 
   shows "reduce_element_mod_D A a j D m = Matrix.mat (dim_row A) (dim_col A)
           (\<lambda>(i,k). if i = a \<and> k = j then if j = 0 then if D dvd A$$(i,k) then D
                    else A$$(i,k) else A$$(i,k) gmod D else A$$(i,k))" (is "_ = ?A")
 proof (rule eq_matI)
   have jm: "j<m" using mn j by auto
   have A: "A \<in> carrier_mat (m+n) n" using A_def A' B mn by simp
   fix i ja assume i: "i < dim_row ?A" and ja: "ja < dim_col ?A"
   show "reduce_element_mod_D A a j D m $$ (i, ja) = ?A $$ (i, ja)"
  proof (cases "i=a")
     case False
     have "reduce_element_mod_D A a j D m = (if j = 0 then if D dvd A$$(a,j)
         then addrow (-((A$$(a,j) gdiv D)) + 1) a (j + m) A else A
         else addrow (-((A$$(a,j) gdiv D))) a (j + m) A)"
       unfolding reduce_element_mod_D_def by simp
     also have "... $$ (i,ja) = A $$ (i, ja)" unfolding mat_addrow_def using False ja i by auto     
     also have "... = ?A $$ (i,ja)" using False using i ja by auto
     finally show ?thesis .
   next
     case True note ia = True
     have "reduce_element_mod_D A a j D m 
       = (if j = 0 then if D dvd A$$(a,j) then addrow (-((A$$(a,j) gdiv D)) + 1) a (j + m) A else A
         else addrow (-((A$$(a,j) gdiv D))) a (j + m) A)" 
       unfolding reduce_element_mod_D_def by simp
     also have "... $$ (i,ja) = ?A $$ (i,ja)"
     proof (cases "ja = j")
       case True note ja_j = True
       have "A $$ (j + m, ja) = B $$ (j,ja)"
         by (rule append_rows_nth2[OF A' _ A_def ], insert j ja A B mn, auto)  
       also have "... = D" using True j mn B1 B2 B by auto      
       finally have A_ja_jaD: "A $$ (j + m, ja) = D" .
 
       show ?thesis
       proof (cases "j=0 \<and> D dvd A$$(a,j)")
         case True         
         have 1: "reduce_element_mod_D A a j D m = addrow (-((A$$(a,j) gdiv D)) + 1) a (j + m) A "
           using True ia ja_j unfolding reduce_element_mod_D_def by auto
         also have "... $$(i,ja) = (- (A $$ (a, j) gdiv D) + 1) * A $$ (j + m, ja) + A $$ (i, ja)"
           unfolding mat_addrow_def using True ja_j ia
           using A i j by auto
         also have "... = D"
         proof -
           have "A $$ (i, ja) + D * - (A $$ (i, ja) gdiv D) = 0"
             using True ia ja_j using D0 by force
           then show ?thesis
             by (metis A_ja_jaD ab_semigroup_add_class.add_ac(1) add.commute add_right_imp_eq ia int_distrib(2)
                 ja_j more_arith_simps(3) mult.commute mult_cancel_right1)
         qed   
         also have "... = ?A $$ (i,ja)" using True ia A i j ja_j by auto
         finally show ?thesis
           using True 1 by auto
       next
         case False
         show ?thesis
         proof (cases "j=0")
           case True
           then show ?thesis 
             using False i ja by auto
         next
           case False
           have "?A $$ (i,ja) = A $$ (i, ja) gmod D" using True ia A i j False by auto
           also have "... = A $$ (i, ja) - ((A $$ (i, ja) gdiv D) * D)"
             by (subst gmod_gdiv[OF D0], auto)
           also have "... =  - (A $$ (a, j) gdiv D) * A $$ (j + m, ja) + A $$ (i, ja)"
             unfolding A_ja_jaD by (simp add: True ia)
           finally show ?thesis 
             using A False True i ia j by auto
       qed
     qed
     next
       case False
       have "A $$ (j + m, ja) = B $$ (j,ja)"
         by (rule append_rows_nth2[OF A' _ A_def ], insert j mn ja A B, auto)
       also have "... = 0" using False using A a mn ja j B2 by force        
       finally have A_am_ja0: "A $$ (j + m, ja) = 0" .
       then show ?thesis using False i ja by fastforce
     qed
     finally show ?thesis .
   qed
 next
   show "dim_row (reduce_element_mod_D A a j D m) = dim_row ?A" 
     and "dim_col (reduce_element_mod_D A a j D m) = dim_col ?A"
     using reduce_element_mod_D_def by auto
 qed
 
 
 
 
 lemma reduce_element_mod_D_abs_case_m':
   assumes A_def: "A = A' @\<^sub>r  B" and B: "B\<in>carrier_mat n n"
   and A': "A' \<in> carrier_mat m n" and a: "a\<le>m" and j: "j<n" 
   and mn: "m>=n" and B1: "B $$ (j, j) = D" and B2: "(\<forall>j'\<in>{0..<n}-{j}. B $$ (j, j') = 0)"
   and D0: "D > 0" 
   shows "reduce_element_mod_D_abs A a j D m = Matrix.mat (dim_row A) (dim_col A)
           (\<lambda>(i,k). if i = a \<and> k = j then if j = 0 \<and> D dvd A$$(i,k) then D else A$$(i,k) gmod D else A$$(i,k))" (is "_ = ?A")
 proof (rule eq_matI)
   have jm: "j<m" using mn j by auto
   have A: "A \<in> carrier_mat (m+n) n" using A_def A' B mn by simp
   fix i ja assume i: "i < dim_row ?A" and ja: "ja < dim_col ?A"
   show "reduce_element_mod_D_abs A a j D m $$ (i, ja) = ?A $$ (i, ja)"
  proof (cases "i=a")
     case False
     have "reduce_element_mod_D_abs A a j D m = (if j = 0 \<and> D dvd A$$(a,j)
         then addrow (-((A$$(a,j) gdiv D)) + 1) a (j + m) A
         else addrow (-((A$$(a,j) gdiv D))) a (j + m) A)"
       unfolding reduce_element_mod_D_abs_def by simp
     also have "... $$ (i,ja) = A $$ (i, ja)" unfolding mat_addrow_def using False ja i by auto     
     also have "... = ?A $$ (i,ja)" using False using i ja by auto
     finally show ?thesis .
   next
     case True note ia = True
     have "reduce_element_mod_D_abs A a j D m 
       = (if j = 0 \<and> D dvd A$$(a,j) then addrow (-((A$$(a,j) gdiv D)) + 1) a (j + m) A
         else addrow (-((A$$(a,j) gdiv D))) a (j + m) A)" 
       unfolding reduce_element_mod_D_abs_def by simp
     also have "... $$ (i,ja) = ?A $$ (i,ja)"
     proof (cases "ja = j")
       case True note ja_j = True
       have "A $$ (j + m, ja) = B $$ (j,ja)"
         by (rule append_rows_nth2[OF A' _ A_def ], insert j ja A B mn, auto)  
       also have "... = D" using True j mn B1 B2 B by auto      
       finally have A_ja_jaD: "A $$ (j + m, ja) = D" .
 
       show ?thesis
       proof (cases "j=0 \<and> D dvd A$$(a,j)")
         case True         
         have 1: "reduce_element_mod_D_abs A a j D m = addrow (-((A$$(a,j) gdiv D)) + 1) a (j + m) A "
           using True ia ja_j unfolding reduce_element_mod_D_abs_def by auto
         also have "... $$(i,ja) = (- (A $$ (a, j) gdiv D) + 1) * A $$ (j + m, ja) + A $$ (i, ja)"
           unfolding mat_addrow_def using True ja_j ia
           using A i j by auto
         also have "... = D"
         proof -
           have "A $$ (i, ja) + D * - (A $$ (i, ja) gdiv D) = 0"
             using True ia ja_j using D0 by force
           then show ?thesis
             by (metis A_ja_jaD ab_semigroup_add_class.add_ac(1) add.commute add_right_imp_eq ia int_distrib(2)
                 ja_j more_arith_simps(3) mult.commute mult_cancel_right1)
         qed   
         also have "... = ?A $$ (i,ja)" using True ia A i j ja_j by auto
         finally show ?thesis
           using True 1 by auto
       next
         case False        
           have "?A $$ (i,ja) = A $$ (i, ja) gmod D" using True ia A i j False by auto
           also have "... = A $$ (i, ja) - ((A $$ (i, ja) gdiv D) * D)"
             by (subst gmod_gdiv[OF D0], auto)
           also have "... =  - (A $$ (a, j) gdiv D) * A $$ (j + m, ja) + A $$ (i, ja)"
             unfolding A_ja_jaD by (simp add: True ia)
           finally show ?thesis 
             using A False True i ia j by auto
         qed    
     next
       case False
       have "A $$ (j + m, ja) = B $$ (j,ja)"
         by (rule append_rows_nth2[OF A' _ A_def ], insert j mn ja A B, auto)
       also have "... = 0" using False using A a mn ja j B2 by force        
       finally have A_am_ja0: "A $$ (j + m, ja) = 0" .
       then show ?thesis using False i ja by fastforce
     qed
     finally show ?thesis .
   qed
 next
   show "dim_row (reduce_element_mod_D_abs A a j D m) = dim_row ?A" 
     and "dim_col (reduce_element_mod_D_abs A a j D m) = dim_col ?A"
     using reduce_element_mod_D_abs_def by auto
 qed
 
 
 lemma reduce_row_mod_D_case_m':
   assumes A_def: "A = A' @\<^sub>r B" and "B \<in> carrier_mat n n"
     and A': "A' \<in> carrier_mat m n" and "a < m" 
     and j: "\<forall>j\<in>set xs. j<n \<and> (B $$ (j, j) = D) \<and> (\<forall>j'\<in>{0..<n}-{j}. B $$ (j, j') = 0)" 
     and d: "distinct xs" and "m\<ge>n"
     and D: "D > 0" 
   shows "reduce_row_mod_D A a xs D m = Matrix.mat (dim_row A) (dim_col A)
           (\<lambda>(i,k). if i = a \<and> k \<in> set xs then if k = 0 then if D dvd A$$(i,k) then D
                    else A$$(i,k) else A$$(i,k) gmod D else A$$(i,k))"
   using assms
 proof (induct A a xs D m arbitrary: A' B rule: reduce_row_mod_D.induct)
   case (1 A a D m)
   then show ?case by force
 next
   case (2 A a x xs D m)
   note A_A'B = "2.prems"(1)
   note B = "2.prems"(2)
   note A' = "2.prems"(3)
   note a = "2.prems"(4)
   note j = "2.prems"(5)
   note mn = "2.prems"(7)
   note d = "2.prems"(6)
   let ?reduce_xs = "(reduce_element_mod_D A a x D m)"
   have reduce_xs_carrier: "?reduce_xs \<in> carrier_mat (m + n) n"
     by (metis "2.prems"(1) "2.prems"(2) "2.prems"(3) add.right_neutral append_rows_def 
             carrier_matD carrier_mat_triv index_mat_four_block(2,3) index_zero_mat(2,3)
             reduce_element_mod_D_preserves_dimensions)
   have 1: "reduce_row_mod_D A a (x # xs) D m 
     = reduce_row_mod_D ?reduce_xs a xs D m" by simp
   have 2: "reduce_element_mod_D A a j D m = Matrix.mat (dim_row A) (dim_col A)
           (\<lambda>(i,k). if i = a \<and> k = j then if j = 0 then if D dvd A$$(i,k) 
           then D else A$$(i,k) else A$$(i,k) gmod D else A$$(i,k))" if "j\<in>set (x#xs)" for j
     by (rule reduce_element_mod_D_case_m'[OF A_A'B B A'], insert "2.prems" that, auto)
   have "reduce_row_mod_D ?reduce_xs a xs D m =
     Matrix.mat (dim_row ?reduce_xs) (dim_col ?reduce_xs) (\<lambda>(i,k). if i = a \<and> k \<in> set xs 
     then if k = 0 then if D dvd ?reduce_xs $$ (i, k) then D else ?reduce_xs $$ (i, k) else
     ?reduce_xs $$ (i, k) gmod D else ?reduce_xs $$ (i, k))"
   proof (rule "2.hyps"[OF _ B _ a _ _ mn])
     let ?A' = "mat_of_rows n [Matrix.row (reduce_element_mod_D A a x D m) i. i \<leftarrow> [0..<m]]"
     show "reduce_element_mod_D A a x D m = ?A' @\<^sub>r B"
     proof (rule matrix_append_rows_eq_if_preserves[OF reduce_xs_carrier B])
       show " \<forall>i\<in>{m..<m + n}. \<forall>j<n. reduce_element_mod_D A a x D m $$ (i, j) = B $$ (i - m, j) "       
         by (smt A_A'B A' B a Metric_Arith.nnf_simps(7) add_diff_cancel_left' atLeastLessThan_iff
             carrier_matD index_mat_addrow(1) index_row(1) le_add_diff_inverse2 less_diff_conv
             reduce_element_mod_D_def reduce_element_mod_D_preserves_dimensions reduce_xs_carrier
             row_append_rows2)        
     qed
   qed (insert "2.prems", auto simp add: mat_of_rows_def)
   also have "... = Matrix.mat (dim_row A) (dim_col A)
           (\<lambda>(i,k). if i = a \<and> k \<in> set (x # xs) then if k = 0 then if D dvd A$$(i,k)
           then D else A$$(i,k) else A$$(i,k) gmod D else A$$(i,k))" (is "?lhs = ?rhs")
   proof (rule eq_matI) 
     show "dim_row ?lhs = dim_row ?rhs" and "dim_col ?lhs = dim_col ?rhs" by auto
     fix i j assume i: "i<dim_row ?rhs" and j: "j < dim_col ?rhs"
     have jn: "j<n" using j "2.prems" by (simp add: append_rows_def)
     have xn: "x < n" 
       by (simp add: "2.prems"(5))
     show "?lhs $$ (i,j) = ?rhs $$ (i,j)"
     proof (cases "i=a \<and> j \<in> set xs")
       case True note ia_jxs = True
       have j_not_x: "j\<noteq>x" using d True by auto
       show ?thesis
       proof (cases "j=0 \<and> D dvd ?reduce_xs $$(i,j)")
         case True
         have "?lhs $$ (i,j) = D"
           using True i j ia_jxs by auto
         also have "... = ?rhs $$ (i,j)" using i j j_not_x 
           by (smt "2" calculation dim_col_mat(1) dim_row_mat(1) index_mat(1) insert_iff list.set(2) prod.simps(2) xn)
         finally show ?thesis .
       next
         case False
         show ?thesis
         proof (cases "j=0")
           case True
           then show ?thesis
             by (smt (z3) "2" dim_col_mat(1) dim_row_mat(1) i index_mat(1) insert_iff j list.set(2) old.prod.case)
         next
           case False
           have "?lhs $$ (i,j) = ?reduce_xs $$ (i, j) gmod D"
             using True False i j by auto
           also have "... = A $$ (i,j) gmod D" using 2[OF ] j_not_x i j by auto
           also have "... = ?rhs $$ (i,j)" using i j j_not_x 
             using False True dim_col_mat(1) dim_row_mat(1) index_mat(1) 
               list.set_intros(2) old.prod.case by auto
           finally show ?thesis .
         qed
     qed
   next
       case False
       show ?thesis using 2 i j xn 
         by (smt False dim_col_mat(1) dim_row_mat(1) index_mat(1) insert_iff list.set(2) prod.simps(2))
     qed   
   qed  
   finally show ?case using 1 by simp
 qed
 
 
 
 
 lemma reduce_row_mod_D_abs_case_m':
   assumes A_def: "A = A' @\<^sub>r B" and "B \<in> carrier_mat n n"
     and A': "A' \<in> carrier_mat m n" and "a < m" 
     and j: "\<forall>j\<in>set xs. j<n \<and> (B $$ (j, j) = D) \<and> (\<forall>j'\<in>{0..<n}-{j}. B $$ (j, j') = 0)" 
     and d: "distinct xs" and "m\<ge>n"
     and D: "D > 0" 
   shows "reduce_row_mod_D_abs A a xs D m = Matrix.mat (dim_row A) (dim_col A)
           (\<lambda>(i,k). if i = a \<and> k \<in> set xs then if k = 0 \<and> D dvd A$$(i,k) then D
                    else A$$(i,k) gmod D else A$$(i,k))"
   using assms
 proof (induct A a xs D m arbitrary: A' B rule: reduce_row_mod_D_abs.induct)
   case (1 A a D m)
   then show ?case by force
 next
   case (2 A a x xs D m)
   note A_A'B = "2.prems"(1)
   note B = "2.prems"(2)
   note A' = "2.prems"(3)
   note a = "2.prems"(4)
   note j = "2.prems"(5)
   note mn = "2.prems"(7)
   note d = "2.prems"(6)
   let ?reduce_xs = "(reduce_element_mod_D_abs A a x D m)"
   have reduce_xs_carrier: "?reduce_xs \<in> carrier_mat (m + n) n"
     by (metis "2.prems"(1) "2.prems"(2) "2.prems"(3) add.right_neutral append_rows_def 
             carrier_matD carrier_mat_triv index_mat_four_block(2,3) index_zero_mat(2,3)
             reduce_element_mod_D_preserves_dimensions)
   have 1: "reduce_row_mod_D_abs A a (x # xs) D m 
     = reduce_row_mod_D_abs ?reduce_xs a xs D m" by simp
   have 2: "reduce_element_mod_D_abs A a j D m = Matrix.mat (dim_row A) (dim_col A)
            (\<lambda>(i,k). if i = a \<and> k = j then if j = 0 \<and> D dvd A$$(i,k) 
             then D else A$$(i,k) gmod D else A$$(i,k))" if "j\<in>set (x#xs)" for j
     by (rule reduce_element_mod_D_abs_case_m'[OF A_A'B B A'], insert "2.prems" that, auto)
   have "reduce_row_mod_D_abs ?reduce_xs a xs D m =
     Matrix.mat (dim_row ?reduce_xs) (dim_col ?reduce_xs) (\<lambda>(i,k). if i = a \<and> k \<in> set xs 
     then if k = 0 \<and> D dvd ?reduce_xs $$ (i, k) then D else
     ?reduce_xs $$ (i, k) gmod D else ?reduce_xs $$ (i, k))"
   proof (rule "2.hyps"[OF _ B _ a _ _ mn])
     let ?A' = "mat_of_rows n [Matrix.row (reduce_element_mod_D_abs A a x D m) i. i \<leftarrow> [0..<m]]"
     show "reduce_element_mod_D_abs A a x D m = ?A' @\<^sub>r B"
     proof (rule matrix_append_rows_eq_if_preserves[OF reduce_xs_carrier B])
       show " \<forall>i\<in>{m..<m + n}. \<forall>j<n. reduce_element_mod_D_abs A a x D m $$ (i, j) = B $$ (i - m, j) "       
         by (smt A_A'B A' B a Metric_Arith.nnf_simps(7) add_diff_cancel_left' atLeastLessThan_iff
             carrier_matD index_mat_addrow(1) index_row(1) le_add_diff_inverse2 less_diff_conv
             reduce_element_mod_D_abs_def reduce_element_mod_D_preserves_dimensions reduce_xs_carrier
             row_append_rows2)        
     qed
   qed (insert "2.prems", auto simp add: mat_of_rows_def)
   also have "... = Matrix.mat (dim_row A) (dim_col A)
           (\<lambda>(i,k). if i = a \<and> k \<in> set (x # xs) then if k = 0 \<and> D dvd A$$(i,k)
           then D else A$$(i,k) gmod D else A$$(i,k))" (is "?lhs = ?rhs")
   proof (rule eq_matI) 
     show "dim_row ?lhs = dim_row ?rhs" and "dim_col ?lhs = dim_col ?rhs" by auto
     fix i j assume i: "i<dim_row ?rhs" and j: "j < dim_col ?rhs"
     have jn: "j<n" using j "2.prems" by (simp add: append_rows_def)
     have xn: "x < n" 
       by (simp add: "2.prems"(5))
     show "?lhs $$ (i,j) = ?rhs $$ (i,j)"
     proof (cases "i=a \<and> j \<in> set xs")
       case True note ia_jxs = True
       have j_not_x: "j\<noteq>x" using d True by auto
       show ?thesis
       proof (cases "j=0 \<and> D dvd ?reduce_xs $$(i,j)")
         case True
         have "?lhs $$ (i,j) = D"
           using True i j ia_jxs by auto
         also have "... = ?rhs $$ (i,j)" using i j j_not_x 
           by (smt "2" calculation dim_col_mat(1) dim_row_mat(1) index_mat(1) insert_iff list.set(2) prod.simps(2) xn)
         finally show ?thesis .
       next
         case False        
         have "?lhs $$ (i,j) = ?reduce_xs $$ (i, j) gmod D"
          using True False i j by auto
        also have "... = A $$ (i,j) gmod D" using 2[OF ] j_not_x i j by auto
        also have "... = ?rhs $$ (i,j)" using i j j_not_x
          by (smt False True \<open>Matrix.mat (dim_row ?reduce_xs) 
            (dim_col ?reduce_xs) (\<lambda>(i, k). if i = a \<and> k \<in> set xs 
            then if k = 0 \<and> D dvd  ?reduce_xs $$ (i, k) 
            then D else  ?reduce_xs $$ (i, k) gmod D 
            else  ?reduce_xs $$ (i, k)) $$ (i, j) =  ?reduce_xs $$ (i, j) gmod D\<close> 
                calculation dim_col_mat(1) dim_row_mat(1) dvd_imp_gmod_0[OF \<open>D > 0\<close>] index_mat(1) 
                insert_iff list.set(2) gmod_0_imp_dvd prod.simps(2))
        finally show ?thesis .
      qed   
   next
       case False
       show ?thesis using 2 i j xn 
         by (smt False dim_col_mat(1) dim_row_mat(1) index_mat(1) insert_iff list.set(2) prod.simps(2))
     qed   
   qed  
   finally show ?case using 1 by simp
 qed
 
 
 
 lemma
   assumes A_def: "A = A' @\<^sub>r B" and B: "B \<in> carrier_mat n n"
   and A': "A' \<in> carrier_mat m n" and a: "a<m" and j: "j<n" and mn: "m\<ge>n"
 shows reduce_element_mod_D_invertible_mat_case_m: 
   "\<exists>P. P \<in> carrier_mat (m+n) (m+n) \<and> invertible_mat P \<and> reduce_element_mod_D A a j D m = P * A" (is ?thesis1)
   and reduce_element_mod_D_abs_invertible_mat_case_m:
   "\<exists>P. P \<in> carrier_mat (m+n) (m+n) \<and> invertible_mat P \<and> 
       reduce_element_mod_D_abs A a j D m = P * A" (is ?thesis2)
   unfolding atomize_conj
 proof (rule conjI; cases "j = 0 \<and> D dvd A$$(a,j)")
   case True
   let ?P = "addrow_mat (m+n) (- (A $$ (a, j) gdiv D) + 1) a (j + m)"
   have A: "A \<in> carrier_mat (m + n) n" using A_def A' B mn by auto
   have "reduce_element_mod_D_abs A a j D m =  addrow (- (A $$ (a, j) gdiv D) + 1) a (j + m) A"
     unfolding reduce_element_mod_D_abs_def using True by auto
   also have "... = ?P * A" by (rule addrow_mat[OF A], insert j mn, auto)
   finally have rw: "reduce_element_mod_D_abs A a j D m = ?P * A" .
   have "reduce_element_mod_D A a j D m =  addrow (- (A $$ (a, j) gdiv D) + 1) a (j + m) A"
     unfolding reduce_element_mod_D_def using True by auto
   also have "... = ?P * A" by (rule addrow_mat[OF A], insert j mn, auto)
   finally have "reduce_element_mod_D A a j D m = ?P * A" .
   moreover have "?P \<in> carrier_mat (m+n) (m+n)" by simp
   moreover have "invertible_mat ?P"
     by (metis addrow_mat_carrier a det_addrow_mat dvd_mult_right 
         invertible_iff_is_unit_JNF mult.right_neutral not_add_less2 semiring_gcd_class.gcd_dvd1)
   ultimately show ?thesis1 and ?thesis2 using rw by blast+
 next
   case False
   show ?thesis1
   proof (cases "j=0")
     case True
     have "reduce_element_mod_D A a j D m = A" unfolding reduce_element_mod_D_def using False True by auto
     then show ?thesis
       by (metis A_def assms(2) assms(3) carrier_append_rows invertible_mat_one left_mult_one_mat one_carrier_mat)
   next
     case False
     let ?P = "addrow_mat (m+n) (- (A $$ (a, j) gdiv D)) a (j + m)"
     have A: "A \<in> carrier_mat (m + n) n" using A_def B A' mn by auto
     have "reduce_element_mod_D A a j D m =  addrow (- (A $$ (a, j) gdiv D)) a (j + m) A"
       unfolding reduce_element_mod_D_def using False by auto
     also have "... = ?P * A" by (rule addrow_mat[OF A], insert j mn, auto)
     finally have "reduce_element_mod_D A a j D m = ?P * A" .
     moreover have "?P \<in> carrier_mat (m+n) (m+n)" by simp
     moreover have "invertible_mat ?P"
       by (metis addrow_mat_carrier a det_addrow_mat dvd_mult_right 
           invertible_iff_is_unit_JNF mult.right_neutral not_add_less2 semiring_gcd_class.gcd_dvd1)
     ultimately show ?thesis by blast
   qed
   show ?thesis2
   proof -
     let ?P = "addrow_mat (m+n) (- (A $$ (a, j) gdiv D)) a (j + m)"
     have A: "A \<in> carrier_mat (m + n) n" using A_def B A' mn by auto
     have "reduce_element_mod_D_abs A a j D m =  addrow (- (A $$ (a, j) gdiv D)) a (j + m) A"
       unfolding reduce_element_mod_D_abs_def using False by auto
     also have "... = ?P * A" by (rule addrow_mat[OF A], insert j mn, auto)
     finally have "reduce_element_mod_D_abs A a j D m = ?P * A" .
     moreover have "?P \<in> carrier_mat (m+n) (m+n)" by simp
     moreover have "invertible_mat ?P"
       by (metis addrow_mat_carrier a det_addrow_mat dvd_mult_right 
           invertible_iff_is_unit_JNF mult.right_neutral not_add_less2 semiring_gcd_class.gcd_dvd1)
     ultimately show ?thesis by blast
   qed
 qed
 
 
 lemma reduce_row_mod_D_invertible_mat_case_m:
   assumes A_def: "A = A' @\<^sub>r B" and "B \<in> carrier_mat n n"
     and A': "A' \<in> carrier_mat m n" and a: "a < m" 
     and j: "\<forall>j\<in>set xs. j<n \<and> (B $$ (j, j) = D) \<and> (\<forall>j'\<in>{0..<n}-{j}. B $$ (j, j') = 0)" 
     and mn: "m\<ge>n"
   shows "\<exists>P. P \<in> carrier_mat (m+n) (m+n) \<and> invertible_mat P \<and> 
     reduce_row_mod_D A a xs D m = P * A"
   using assms
 proof (induct A a xs D m arbitrary: A' B rule: reduce_row_mod_D.induct)
   case (1 A a D m)
   show ?case by (rule exI[of _ "1\<^sub>m (m+n)"], insert "1.prems", auto simp add: append_rows_def)
 next
   case (2 A a x xs D m)
   note A_def = "2.prems"(1)
   note B = "2.prems"(2)
   note A' = "2.prems"(3)
   note a = "2.prems"(4)
   note j = "2.prems"(5)
   note mn = "2.prems"(6)  
   let ?reduce_xs = "(reduce_element_mod_D A a x D m)"
   have 1: "reduce_row_mod_D A a (x # xs) D m 
     = reduce_row_mod_D ?reduce_xs a xs D m" by simp
   have "\<exists>P. P \<in> carrier_mat (m+n) (m+n) \<and> invertible_mat P \<and> 
     reduce_element_mod_D A a x D m = P * A" 
     by (rule reduce_element_mod_D_invertible_mat_case_m, insert "2.prems", auto)
   from this obtain P where P: "P \<in> carrier_mat (m+n) (m+n)" and inv_P: "invertible_mat P"
     and R_P: "reduce_element_mod_D A a x D m = P * A" by auto
   have "\<exists>P. P \<in> carrier_mat (m + n) (m + n) \<and> invertible_mat P 
       \<and> reduce_row_mod_D ?reduce_xs a xs D m = P * ?reduce_xs"
   proof (rule "2.hyps")
     let ?A' = "mat_of_rows n [Matrix.row ?reduce_xs i. i \<leftarrow> [0..<m]]"
     let ?B' = "mat_of_rows n [Matrix.row ?reduce_xs i. i \<leftarrow> [m..<m+n]]"
 
     show reduce_xs_A'B': "?reduce_xs = ?A' @\<^sub>r ?B'"
       by (smt "2"(2) "2"(4) P R_P add.comm_neutral append_rows_def append_rows_split carrier_matD
           index_mat_four_block(3) index_mult_mat(2) index_zero_mat(3) le_add1 reduce_element_mod_D_preserves_dimensions(2))
     show "\<forall>j\<in>set xs. j < n \<and> ?B' $$ (j, j) = D \<and> (\<forall>j'\<in>{0..<n} - {j}. ?B' $$ (j, j') = 0)"
     proof
       fix j assume j_in_xs: "j \<in> set xs"
       have jn: "j<n" using j_in_xs j by auto
       have "?B' $$ (j, j) = ?reduce_xs $$ (m+j,j)"
         by (smt "2"(7) Groups.add_ac(2) jn reduce_xs_A'B' add_diff_cancel_left' append_rows_nth2
             diff_zero length_map length_upt mat_of_rows_carrier(1) nat_SN.compat)
       also have "... = B $$ (j,j)" 
         by (smt "2"(2) "2"(5) A' P R_P add_diff_cancel_left' append_rows_def carrier_matD
             group_cancel.rule0 index_mat_addrow(1) index_mat_four_block(1) index_mat_four_block(2,3)
             index_mult_mat(2) index_zero_mat(3) jn le_add1 linorder_not_less nat_SN.plus_gt_right_mono 
             reduce_element_mod_D_def reduce_element_mod_D_preserves_dimensions(1))
       also have "... = D" using j j_in_xs by auto
       finally have B'_jj: "?B' $$ (j, j) = D" by auto
       moreover have "\<forall>j'\<in>{0..<n} - {j}. ?B' $$ (j, j') = 0" 
       proof 
         fix j' assume j': "j' \<in>{0..<n} - {j}"
         have "?B' $$ (j, j') = ?reduce_xs $$ (m+j,j')"
           by (smt mn Diff_iff j' add.commute add_diff_cancel_left' 
               append_rows_nth2 atLeastLessThan_iff diff_zero jn length_map length_upt 
               mat_of_rows_carrier(1) nat_SN.compat reduce_xs_A'B')
         also have "... = B $$ (j,j')"
           by (smt "2"(2) "2"(5) A' Diff_iff P R_P j' add.commute add_diff_cancel_left'  
             append_rows_def atLeastLessThan_iff carrier_matD group_cancel.rule0 index_mat_addrow(1)
             index_mat_four_block index_mult_mat(2) index_zero_mat(3) jn nat_SN.plus_gt_right_mono 
             not_add_less2 reduce_element_mod_D_def reduce_element_mod_D_preserves_dimensions(1))
         also have "... = 0" using j j_in_xs j' by auto
         finally show "?B' $$ (j, j') = 0" .
       qed
       ultimately show "j < n \<and> ?B' $$ (j, j) = D \<and> (\<forall>j'\<in>{0..<n} - {j}. ?B' $$ (j, j') = 0)"
         using jn by blast
     qed
     show "?A' : carrier_mat m n" by auto      
     show "?B' : carrier_mat n n" by auto
     show "a<m" using "2.prems" by auto
     show "n\<le>m" using "2.prems" by auto    
   qed
   from this obtain P2 where P2: "P2 \<in> carrier_mat (m + n) (m + n)" and inv_P2: "invertible_mat P2"
     and R_P2: "reduce_row_mod_D ?reduce_xs a xs D m = P2 * ?reduce_xs"
     by auto
   have "invertible_mat (P2 * P)" using P P2 inv_P inv_P2 invertible_mult_JNF by blast
   moreover have "(P2 * P) \<in> carrier_mat (m+n) (m+n)" using P2 P by auto
   moreover have "reduce_row_mod_D A a (x # xs) D m = (P2 * P) * A" 
     by (smt P P2 R_P R_P2 1 assoc_mult_mat carrier_matD carrier_mat_triv
         index_mult_mat reduce_row_mod_D_preserves_dimensions)
   ultimately show ?case by blast
 qed
 
 
 
 
 lemma reduce_row_mod_D_abs_invertible_mat_case_m:
   assumes A_def: "A = A' @\<^sub>r B" and "B \<in> carrier_mat n n"
     and A': "A' \<in> carrier_mat m n" and a: "a < m" 
     and j: "\<forall>j\<in>set xs. j<n \<and> (B $$ (j, j) = D) \<and> (\<forall>j'\<in>{0..<n}-{j}. B $$ (j, j') = 0)" 
     and mn: "m\<ge>n"
   shows "\<exists>P. P \<in> carrier_mat (m+n) (m+n) \<and> invertible_mat P \<and> 
     reduce_row_mod_D_abs A a xs D m = P * A"
   using assms
 proof (induct A a xs D m arbitrary: A' B rule: reduce_row_mod_D_abs.induct)
   case (1 A a D m)
   show ?case by (rule exI[of _ "1\<^sub>m (m+n)"], insert "1.prems", auto simp add: append_rows_def)
 next
   case (2 A a x xs D m)
   note A_def = "2.prems"(1)
   note B = "2.prems"(2)
   note A' = "2.prems"(3)
   note a = "2.prems"(4)
   note j = "2.prems"(5)
   note mn = "2.prems"(6)  
   let ?reduce_xs = "(reduce_element_mod_D_abs A a x D m)"
   have 1: "reduce_row_mod_D_abs A a (x # xs) D m 
     = reduce_row_mod_D_abs ?reduce_xs a xs D m" by simp
   have "\<exists>P. P \<in> carrier_mat (m+n) (m+n) \<and> invertible_mat P \<and> 
     reduce_element_mod_D_abs A a x D m = P * A" 
     by (rule reduce_element_mod_D_abs_invertible_mat_case_m, insert "2.prems", auto)
   from this obtain P where P: "P \<in> carrier_mat (m+n) (m+n)" and inv_P: "invertible_mat P"
     and R_P: "reduce_element_mod_D_abs A a x D m = P * A" by auto
   have "\<exists>P. P \<in> carrier_mat (m + n) (m + n) \<and> invertible_mat P 
       \<and> reduce_row_mod_D_abs ?reduce_xs a xs D m = P * ?reduce_xs"
   proof (rule "2.hyps")
     let ?A' = "mat_of_rows n [Matrix.row ?reduce_xs i. i \<leftarrow> [0..<m]]"
     let ?B' = "mat_of_rows n [Matrix.row ?reduce_xs i. i \<leftarrow> [m..<m+n]]"
 
     show reduce_xs_A'B': "?reduce_xs = ?A' @\<^sub>r ?B'"
       by (smt "2"(2) "2"(4) P R_P add.comm_neutral append_rows_def append_rows_split carrier_matD
           index_mat_four_block(3) index_mult_mat(2) index_zero_mat(3) le_add1 reduce_element_mod_D_preserves_dimensions(4))
     show "\<forall>j\<in>set xs. j < n \<and> ?B' $$ (j, j) = D \<and> (\<forall>j'\<in>{0..<n} - {j}. ?B' $$ (j, j') = 0)"
     proof
       fix j assume j_in_xs: "j \<in> set xs"
       have jn: "j<n" using j_in_xs j by auto
       have "?B' $$ (j, j) = ?reduce_xs $$ (m+j,j)"
         by (smt "2"(7) Groups.add_ac(2) jn reduce_xs_A'B' add_diff_cancel_left' append_rows_nth2
             diff_zero length_map length_upt mat_of_rows_carrier(1) nat_SN.compat)
       also have "... = B $$ (j,j)" 
         by (smt "2"(2) "2"(5) A' P R_P add_diff_cancel_left' append_rows_def carrier_matD
             group_cancel.rule0 index_mat_addrow(1) index_mat_four_block(1) index_mat_four_block(2,3)
             index_mult_mat(2) index_zero_mat(3) jn le_add1 linorder_not_less nat_SN.plus_gt_right_mono 
             reduce_element_mod_D_abs_def reduce_element_mod_D_preserves_dimensions(3))
       also have "... = D" using j j_in_xs by auto
       finally have B'_jj: "?B' $$ (j, j) = D" by auto
       moreover have "\<forall>j'\<in>{0..<n} - {j}. ?B' $$ (j, j') = 0" 
       proof 
         fix j' assume j': "j' \<in>{0..<n} - {j}"
         have "?B' $$ (j, j') = ?reduce_xs $$ (m+j,j')"
           by (smt mn Diff_iff j' add.commute add_diff_cancel_left' 
               append_rows_nth2 atLeastLessThan_iff diff_zero jn length_map length_upt 
               mat_of_rows_carrier(1) nat_SN.compat reduce_xs_A'B')
         also have "... = B $$ (j,j')"
           by (smt "2"(2) "2"(5) A' Diff_iff P R_P j' add.commute add_diff_cancel_left'  
             append_rows_def atLeastLessThan_iff carrier_matD group_cancel.rule0 index_mat_addrow(1)
             index_mat_four_block index_mult_mat(2) index_zero_mat(3) jn nat_SN.plus_gt_right_mono 
             not_add_less2 reduce_element_mod_D_abs_def reduce_element_mod_D_preserves_dimensions(3))
         also have "... = 0" using j j_in_xs j' by auto
         finally show "?B' $$ (j, j') = 0" .
       qed
       ultimately show "j < n \<and> ?B' $$ (j, j) = D \<and> (\<forall>j'\<in>{0..<n} - {j}. ?B' $$ (j, j') = 0)"
         using jn by blast
     qed
     show "?A' : carrier_mat m n" by auto      
     show "?B' : carrier_mat n n" by auto
     show "a<m" using "2.prems" by auto
     show "n\<le>m" using "2.prems" by auto    
   qed
   from this obtain P2 where P2: "P2 \<in> carrier_mat (m + n) (m + n)" and inv_P2: "invertible_mat P2"
     and R_P2: "reduce_row_mod_D_abs ?reduce_xs a xs D m = P2 * ?reduce_xs"
     by auto
   have "invertible_mat (P2 * P)" using P P2 inv_P inv_P2 invertible_mult_JNF by blast
   moreover have "(P2 * P) \<in> carrier_mat (m+n) (m+n)" using P2 P by auto
   moreover have "reduce_row_mod_D_abs A a (x # xs) D m = (P2 * P) * A" 
     by (smt P P2 R_P R_P2 1 assoc_mult_mat carrier_matD carrier_mat_triv
         index_mult_mat reduce_row_mod_D_preserves_dimensions_abs)
   ultimately show ?case by blast
 qed
 
 
 
 
 (*Similar to thm reduce_row_mod_D_case_m' but including the case a = m. 
 This could substitute the previous version.*)
 lemma reduce_row_mod_D_case_m'':
   assumes A_def: "A = A' @\<^sub>r B" and "B \<in> carrier_mat n n"
     and A': "A' \<in> carrier_mat m n" and "a \<le> m" 
     and j: "\<forall>j\<in>set xs. j<n \<and> (B $$ (j, j) = D) \<and> (\<forall>j'\<in>{0..<n}-{j}. B $$ (j, j') = 0)" 
     and d: "distinct xs" and "m\<ge>n" and "0 \<notin> set xs"
     and "D > 0" 
   shows "reduce_row_mod_D A a xs D m = Matrix.mat (dim_row A) (dim_col A)
           (\<lambda>(i,k). if i = a \<and> k \<in> set xs then if k = 0 then if D dvd A$$(i,k) then D
                     else A$$(i,k) else A$$(i,k) gmod D else A$$(i,k))"
   using assms
 proof (induct A a xs D m arbitrary: A' B rule: reduce_row_mod_D.induct)
   case (1 A a D m)
   then show ?case by force
 next
   case (2 A a x xs D m)
   note A_A'B = "2.prems"(1)
   note B = "2.prems"(2)
   note A' = "2.prems"(3)
   note a = "2.prems"(4)
   note j = "2.prems"(5)
   note mn = "2.prems"(7)
   note d = "2.prems"(6)
   note zero_not_xs = "2.prems"(8)
   let ?reduce_xs = "(reduce_element_mod_D A a x D m)"
   have reduce_xs_carrier: "?reduce_xs \<in> carrier_mat (m + n) n"
     by (metis "2.prems"(1) "2.prems"(2) "2.prems"(3) add.right_neutral append_rows_def 
             carrier_matD carrier_mat_triv index_mat_four_block(2,3) index_zero_mat(2,3)
             reduce_element_mod_D_preserves_dimensions)
   have A: "A:carrier_mat (m+n) n" using A' B A_A'B by blast
   have 1: "reduce_row_mod_D A a (x # xs) D m 
     = reduce_row_mod_D ?reduce_xs a xs D m" by simp
   have 2: "reduce_element_mod_D A a j D m = Matrix.mat (dim_row A) (dim_col A)
           (\<lambda>(i,k). if i = a \<and> k = j then if j = 0 then if D dvd A$$(i,k)
           then D else A$$(i,k) else A$$(i,k) gmod D else A$$(i,k))" if "j\<in>set (x#xs)" for j
     by (rule reduce_element_mod_D_case_m'[OF A_A'B B A'], insert "2.prems" that, auto)
   have "reduce_row_mod_D ?reduce_xs a xs D m =
     Matrix.mat (dim_row ?reduce_xs) (dim_col ?reduce_xs) (\<lambda>(i,k). if i = a \<and> k \<in> set xs 
     then if k=0 then if D dvd ?reduce_xs $$ (i, k) then D else ?reduce_xs $$ (i, k)
     else ?reduce_xs $$ (i, k) gmod D else ?reduce_xs $$ (i, k))"
   proof (rule "2.hyps"[OF _ _ _ a _ _ mn])
     let ?A' = "mat_of_rows n [Matrix.row (reduce_element_mod_D A a x D m) i. i \<leftarrow> [0..<m]]"
     define B' where "B' = mat_of_rows n [Matrix.row ?reduce_xs i. i \<leftarrow> [m..<dim_row A]]"
     show A'': "?A' : carrier_mat m n" by auto
     show B': "B' : carrier_mat n n" unfolding B'_def using mn A by auto 
     show reduce_split: "?reduce_xs = ?A' @\<^sub>r B'" 
       by (metis B'_def append_rows_split carrier_matD
           reduce_element_mod_D_preserves_dimensions(1) reduce_xs_carrier le_add1)
     show "\<forall>j\<in>set xs. j<n \<and> (B' $$ (j, j) = D) \<and> (\<forall>j'\<in>{0..<n}-{j}. B' $$ (j, j') = 0)"
     proof 
       fix j assume j_xs: "j\<in>set xs"
       have "B $$ (j,j') = B' $$ (j,j')" if j': "j'<n" for j'
       proof -
         have "B $$ (j,j') = A $$ (m+j,j')"
           by (smt A_A'B A A' Groups.add_ac(2) j_xs add_diff_cancel_left' append_rows_def carrier_matD j'
               index_mat_four_block(1) index_mat_four_block(2,3) insert_iff j less_diff_conv list.set(2) not_add_less1)
         also have "... = ?reduce_xs $$ (m+j,j')"
           by (smt (verit, ccfv_threshold) A'' diff_add_zero index_mat_addrow(3) neq0_conv
               a j zero_not_xs A add.commute add_diff_cancel_left' reduce_element_mod_D_def
               cancel_comm_monoid_add_class.diff_cancel carrier_matD index_mat_addrow(1) j'
               j_xs le_eq_less_or_eq less_diff_conv less_not_refl2 list.set_intros(2) nat_SN.compat)
         also have "... = B'$$ (j,j')"
           by (smt B A A' A_A'B B' A'' reduce_split add.commute add_diff_cancel_left' j' not_add_less1
               append_rows_def carrier_matD index_mat_four_block j j_xs less_diff_conv list.set_intros(2))
         finally show ?thesis .
       qed
       thus "j < n \<and> B' $$ (j, j) = D \<and> (\<forall>j'\<in>{0..<n} - {j}. B' $$ (j, j') = 0)" using j
         by (metis Diff_iff atLeastLessThan_iff insert_iff j_xs list.simps(15))
     qed          
   qed (insert "2.prems", auto simp add: mat_of_rows_def)
   also have "... = Matrix.mat (dim_row A) (dim_col A)
           (\<lambda>(i,k). if i = a \<and> k \<in> set (x # xs) then if k = 0 then if D dvd A$$(i,k) 
           then D else A$$(i,k) else A$$(i,k) gmod D else A$$(i,k))" (is "?lhs = ?rhs")
   proof (rule eq_matI) 
     show "dim_row ?lhs = dim_row ?rhs" and "dim_col ?lhs = dim_col ?rhs" by auto
     fix i j assume i: "i<dim_row ?rhs" and j: "j < dim_col ?rhs"
     have jn: "j<n" using j "2.prems" by (simp add: append_rows_def)
     have xn: "x < n" 
       by (simp add: "2.prems"(5))
     show "?lhs $$ (i,j) = ?rhs $$ (i,j)"
     proof (cases "i=a \<and> j \<in> set xs")
       case True note ia_jxs = True
       have j_not_x: "j\<noteq>x" using d True by auto
       show ?thesis
       proof (cases "j=0 \<and> D dvd ?reduce_xs $$(i,j)")
         case True
         have "?lhs $$ (i,j) = D"
           using True i j ia_jxs by auto
         also have "... = ?rhs $$ (i,j)" using i j j_not_x
           by (metis "2.prems"(8) True ia_jxs list.set_intros(2))
         finally show ?thesis .
       next
         case False   
         show ?thesis
           by (smt (z3) "2" "2.prems"(8) dim_col_mat(1) dim_row_mat(1) i index_mat(1) insert_iff j j_not_x list.set(2) old.prod.case)     
     qed
   next
       case False
       show ?thesis using 2 i j xn
         by (smt (z3) "2.prems"(8) False carrier_matD(2) dim_row_mat(1) index_mat(1) 
             insert_iff jn list.set(2) old.prod.case reduce_element_mod_D_preserves_dimensions(2) reduce_xs_carrier)
     qed   
   qed  
   finally show ?case using 1 by simp
 qed
 
 
 
 
 (*Similar to thm reduce_row_mod_D_abs_case_m' but including the case a = m. 
 This could substitute the previous version.*)
 lemma reduce_row_mod_D_abs_case_m'':
   assumes A_def: "A = A' @\<^sub>r B" and "B \<in> carrier_mat n n"
     and A': "A' \<in> carrier_mat m n" and "a \<le> m" 
     and j: "\<forall>j\<in>set xs. j<n \<and> (B $$ (j, j) = D) \<and> (\<forall>j'\<in>{0..<n}-{j}. B $$ (j, j') = 0)" 
     and d: "distinct xs" and "m\<ge>n" and "0 \<notin> set xs"
     and "D > 0" 
   shows "reduce_row_mod_D_abs A a xs D m = Matrix.mat (dim_row A) (dim_col A)
           (\<lambda>(i,k). if i = a \<and> k \<in> set xs then if k = 0 \<and> D dvd A$$(i,k) then D
                    else A$$(i,k) gmod D else A$$(i,k))"
   using assms
 proof (induct A a xs D m arbitrary: A' B rule: reduce_row_mod_D_abs.induct)
   case (1 A a D m)
   then show ?case by force
 next
   case (2 A a x xs D m)
   note A_A'B = "2.prems"(1)
   note B = "2.prems"(2)
   note A' = "2.prems"(3)
   note a = "2.prems"(4)
   note j = "2.prems"(5)
   note mn = "2.prems"(7)
   note d = "2.prems"(6)
   note zero_not_xs = "2.prems"(8)
   let ?reduce_xs = "(reduce_element_mod_D_abs A a x D m)"
   have reduce_xs_carrier: "?reduce_xs \<in> carrier_mat (m + n) n"
     by (metis "2.prems"(1) "2.prems"(2) "2.prems"(3) add.right_neutral append_rows_def 
             carrier_matD carrier_mat_triv index_mat_four_block(2,3) index_zero_mat(2,3)
             reduce_element_mod_D_preserves_dimensions)
   have A: "A:carrier_mat (m+n) n" using A' B A_A'B by blast
   have 1: "reduce_row_mod_D_abs A a (x # xs) D m 
     = reduce_row_mod_D_abs ?reduce_xs a xs D m" by simp
   have 2: "reduce_element_mod_D_abs A a j D m = Matrix.mat (dim_row A) (dim_col A)
           (\<lambda>(i,k). if i = a \<and> k = j then if j = 0 \<and> D dvd A$$(i,k)
           then D else A$$(i,k) gmod D else A$$(i,k))" if "j\<in>set (x#xs)" for j
     by (rule reduce_element_mod_D_abs_case_m'[OF A_A'B B A'], insert "2.prems" that, auto)
   have "reduce_row_mod_D_abs ?reduce_xs a xs D m =
     Matrix.mat (dim_row ?reduce_xs) (dim_col ?reduce_xs) (\<lambda>(i,k). if i = a \<and> k \<in> set xs 
     then if k=0 \<and> D dvd ?reduce_xs $$ (i, k) then D 
     else ?reduce_xs $$ (i, k) gmod D else ?reduce_xs $$ (i, k))"
   proof (rule "2.hyps"[OF _ _ _ a _ _ mn])
     let ?A' = "mat_of_rows n [Matrix.row (reduce_element_mod_D_abs A a x D m) i. i \<leftarrow> [0..<m]]"
     define B' where "B' = mat_of_rows n [Matrix.row ?reduce_xs i. i \<leftarrow> [m..<dim_row A]]"
     show A'': "?A' : carrier_mat m n" by auto
     show B': "B' : carrier_mat n n" unfolding B'_def using mn A by auto 
     show reduce_split: "?reduce_xs = ?A' @\<^sub>r B'" 
       by (metis B'_def append_rows_split carrier_matD
           reduce_element_mod_D_preserves_dimensions(3) reduce_xs_carrier le_add1)
     show "\<forall>j\<in>set xs. j<n \<and> (B' $$ (j, j) = D) \<and> (\<forall>j'\<in>{0..<n}-{j}. B' $$ (j, j') = 0)"
     proof 
       fix j assume j_xs: "j\<in>set xs"
       have "B $$ (j,j') = B' $$ (j,j')" if j': "j'<n" for j'
       proof -
         have "B $$ (j,j') = A $$ (m+j,j')"
           by (smt A_A'B A A' Groups.add_ac(2) j_xs add_diff_cancel_left' append_rows_def carrier_matD j'
               index_mat_four_block(1) index_mat_four_block(2,3) insert_iff j less_diff_conv list.set(2) not_add_less1)
         also have "... = ?reduce_xs $$ (m+j,j')"
           by (smt (verit, ccfv_threshold) A'' diff_add_zero index_mat_addrow(3) neq0_conv
               a j zero_not_xs A add.commute add_diff_cancel_left' reduce_element_mod_D_abs_def
               cancel_comm_monoid_add_class.diff_cancel carrier_matD index_mat_addrow(1) j'
               j_xs le_eq_less_or_eq less_diff_conv less_not_refl2 list.set_intros(2) nat_SN.compat)
         also have "... = B'$$ (j,j')"
           by (smt B A A' A_A'B B' A'' reduce_split add.commute add_diff_cancel_left' j' not_add_less1
               append_rows_def carrier_matD index_mat_four_block j j_xs less_diff_conv list.set_intros(2))
         finally show ?thesis .
       qed
       thus "j < n \<and> B' $$ (j, j) = D \<and> (\<forall>j'\<in>{0..<n} - {j}. B' $$ (j, j') = 0)" using j
         by (metis Diff_iff atLeastLessThan_iff insert_iff j_xs list.simps(15))
     qed          
   qed (insert "2.prems", auto simp add: mat_of_rows_def)
   also have "... = Matrix.mat (dim_row A) (dim_col A)
           (\<lambda>(i,k). if i = a \<and> k \<in> set (x # xs) then if k = 0 then if D dvd A$$(i,k) 
           then D else A$$(i,k) else A$$(i,k) gmod D else A$$(i,k))" (is "?lhs = ?rhs")
   proof (rule eq_matI) 
     show "dim_row ?lhs = dim_row ?rhs" and "dim_col ?lhs = dim_col ?rhs" by auto
     fix i j assume i: "i<dim_row ?rhs" and j: "j < dim_col ?rhs"
     have jn: "j<n" using j "2.prems" by (simp add: append_rows_def)
     have xn: "x < n" 
       by (simp add: "2.prems"(5))
     show "?lhs $$ (i,j) = ?rhs $$ (i,j)"
     proof (cases "i=a \<and> j \<in> set xs")
       case True note ia_jxs = True
       have j_not_x: "j\<noteq>x" using d True by auto
       show ?thesis
       proof (cases "j=0 \<and> D dvd ?reduce_xs $$(i,j)")
         case True
         have "?lhs $$ (i,j) = D"
           using True i j ia_jxs by auto
         also have "... = ?rhs $$ (i,j)" using i j j_not_x
           by (metis "2.prems"(8) True ia_jxs list.set_intros(2))
         finally show ?thesis .
       next
         case False   
         show ?thesis
           by (smt (z3) "2" "2.prems"(8) dim_col_mat(1) dim_row_mat(1) i index_mat(1) insert_iff j j_not_x list.set(2) old.prod.case)     
     qed
   next
       case False
       show ?thesis using 2 i j xn
         by (smt (z3) "2.prems"(8) False carrier_matD(2) dim_row_mat(1) index_mat(1) 
             insert_iff jn list.set(2) old.prod.case reduce_element_mod_D_preserves_dimensions(4) reduce_xs_carrier)
     qed   
   qed  
   finally show ?case using 1
     by (smt (verit, ccfv_SIG) "2.prems"(8) cong_mat split_conv)
 qed
 
 
 
 lemma
   assumes A_def: "A = A' @\<^sub>r B" and B: "B \<in> carrier_mat n n"
   and A': "A' \<in> carrier_mat m n" and a: "a\<le>m" and j: "j<n" and mn: "m\<ge>n" and j0: "j\<noteq>0"
 shows reduce_element_mod_D_invertible_mat_case_m':
   "\<exists>P. P \<in> carrier_mat (m+n) (m+n) \<and> invertible_mat P \<and> reduce_element_mod_D A a j D m = P * A" (is ?thesis1)
   and reduce_element_mod_D_abs_invertible_mat_case_m': 
   "\<exists>P. P \<in> carrier_mat (m+n) (m+n) \<and> invertible_mat P \<and> reduce_element_mod_D_abs A a j D m = P * A" (is ?thesis2)
 proof -
   let ?P = "addrow_mat (m+n) (- (A $$ (a, j) gdiv D)) a (j + m)"
   have jm: "j+m \<noteq>a" using j0 a by auto
   have A: "A \<in> carrier_mat (m + n) n" using A_def A' B mn by auto
   have rw: "reduce_element_mod_D A a j D m = reduce_element_mod_D_abs A a j D m" 
     unfolding reduce_element_mod_D_def reduce_element_mod_D_abs_def using j0 by auto
   have "reduce_element_mod_D A a j D m =  addrow (- (A $$ (a, j) gdiv D)) a (j + m) A"
     unfolding reduce_element_mod_D_def using j0 by auto
   also have "... = ?P * A" by (rule addrow_mat[OF A], insert j mn, auto)
   finally have "reduce_element_mod_D A a j D m = ?P * A" .
   moreover have "?P \<in> carrier_mat (m+n) (m+n)" by simp
   moreover have "invertible_mat ?P"
     by (metis addrow_mat_carrier det_addrow_mat dvd_mult_right jm
         invertible_iff_is_unit_JNF mult.right_neutral semiring_gcd_class.gcd_dvd1)
   ultimately show ?thesis1 and ?thesis2 using rw by metis+
 qed
 
 (*Similar to reduce_row_mod_D_invertible_mat_case_m but including the case a = m, and then
 adding the assumption 0 not in set xs.*)
 lemma reduce_row_mod_D_invertible_mat_case_m':
   assumes A_def: "A = A' @\<^sub>r B" and "B \<in> carrier_mat n n"
     and A': "A' \<in> carrier_mat m n" and a: "a \<le> m" 
     and j: "\<forall>j\<in>set xs. j<n \<and> (B $$ (j, j) = D) \<and> (\<forall>j'\<in>{0..<n}-{j}. B $$ (j, j') = 0)" 
     and d: "distinct xs" and mn: "m\<ge>n" and "0\<notin> set xs"
   shows "\<exists>P. P \<in> carrier_mat (m+n) (m+n) \<and> invertible_mat P \<and> 
     reduce_row_mod_D A a xs D m = P * A"
   using assms
 proof (induct A a xs D m arbitrary: A' B rule: reduce_row_mod_D.induct)
   case (1 A a D m)
   show ?case by (rule exI[of _ "1\<^sub>m (m+n)"], insert "1.prems", auto simp add: append_rows_def)
 next
   case (2 A a x xs D m)
   note A_A'B = "2.prems"(1)
   note B = "2.prems"(2)
   note A' = "2.prems"(3)
   note a = "2.prems"(4)
   note j = "2.prems"(5)
   note mn = "2.prems"(7)
   note d = "2.prems"(6)
   note zero_not_xs = "2.prems"(8)
   let ?reduce_xs = "(reduce_element_mod_D A a x D m)"
   have reduce_xs_carrier: "?reduce_xs \<in> carrier_mat (m + n) n"
     by (metis "2.prems"(1) "2.prems"(2) "2.prems"(3) add.right_neutral append_rows_def 
             carrier_matD carrier_mat_triv index_mat_four_block(2,3) index_zero_mat(2,3)
             reduce_element_mod_D_preserves_dimensions)
   have A: "A:carrier_mat (m+n) n" using A' B A_A'B by blast 
   let ?reduce_xs = "(reduce_element_mod_D A a x D m)"
   have 1: "reduce_row_mod_D A a (x # xs) D m 
     = reduce_row_mod_D ?reduce_xs a xs D m" by simp
   have "\<exists>P. P \<in> carrier_mat (m+n) (m+n) \<and> invertible_mat P \<and> 
     reduce_element_mod_D A a x D m = P * A"
     by (rule reduce_element_mod_D_invertible_mat_case_m'[OF A_A'B B A' a _ mn],
         insert zero_not_xs j, auto)
   from this obtain P where P: "P \<in> carrier_mat (m+n) (m+n)" and inv_P: "invertible_mat P"
     and R_P: "reduce_element_mod_D A a x D m = P * A" by auto
   have "\<exists>P. P \<in> carrier_mat (m + n) (m + n) \<and> invertible_mat P 
       \<and> reduce_row_mod_D ?reduce_xs a xs D m = P * ?reduce_xs"
   proof (rule "2.hyps")
     let ?A' = "mat_of_rows n [Matrix.row ?reduce_xs i. i \<leftarrow> [0..<m]]"
     let ?B' = "mat_of_rows n [Matrix.row ?reduce_xs i. i \<leftarrow> [m..<m+n]]"
     show B': "?B' \<in> carrier_mat n n" by auto
     show A'': "?A' : carrier_mat m n" by auto
     show reduce_split: "?reduce_xs = ?A' @\<^sub>r ?B'"
       by (smt "2"(2) "2"(4) P R_P add.comm_neutral append_rows_def append_rows_split carrier_matD
           index_mat_four_block(3) index_mult_mat(2) index_zero_mat(3) le_add1 reduce_element_mod_D_preserves_dimensions(2))
     show "\<forall>j\<in>set xs. j < n \<and> ?B' $$ (j, j) = D \<and> (\<forall>j'\<in>{0..<n} - {j}. ?B' $$ (j, j') = 0)"
     proof
       fix j assume j_xs: "j\<in>set xs"
       have "B $$ (j,j') = ?B' $$ (j,j')" if j': "j'<n" for j'
       proof -
         have "B $$ (j,j') = A $$ (m+j,j')"
           by (smt A_A'B A A' Groups.add_ac(2) j_xs add_diff_cancel_left' append_rows_def carrier_matD j'
               index_mat_four_block(1) index_mat_four_block(2,3) insert_iff j less_diff_conv list.set(2) not_add_less1)
         also have "... = ?reduce_xs $$ (m+j,j')"
           by (smt (verit, ccfv_SIG) not_add_less1
               a j zero_not_xs A add.commute add_diff_cancel_left' reduce_element_mod_D_def
               cancel_comm_monoid_add_class.diff_cancel carrier_matD index_mat_addrow(1) j'
               j_xs le_eq_less_or_eq less_diff_conv less_not_refl2 list.set_intros(2) nat_SN.compat)
         also have "... = ?B'$$ (j,j')"
           by (smt B A A' A_A'B B' A'' reduce_split add.commute add_diff_cancel_left' j' not_add_less1
               append_rows_def carrier_matD index_mat_four_block j j_xs less_diff_conv list.set_intros(2))
         finally show ?thesis .
       qed
       thus "j < n \<and> ?B' $$ (j, j) = D \<and> (\<forall>j'\<in>{0..<n} - {j}. ?B' $$ (j, j') = 0)" using j
         by (metis Diff_iff atLeastLessThan_iff insert_iff j_xs list.simps(15))
     qed        
   qed (insert d zero_not_xs a mn, auto)
   from this obtain P2 where P2: "P2 \<in> carrier_mat (m + n) (m + n)" and inv_P2: "invertible_mat P2"
     and R_P2: "reduce_row_mod_D ?reduce_xs a xs D m = P2 * ?reduce_xs"
     by auto
   have "invertible_mat (P2 * P)" using P P2 inv_P inv_P2 invertible_mult_JNF by blast
   moreover have "(P2 * P) \<in> carrier_mat (m+n) (m+n)" using P2 P by auto
   moreover have "reduce_row_mod_D A a (x # xs) D m = (P2 * P) * A" 
     by (smt P P2 R_P R_P2 1 assoc_mult_mat carrier_matD carrier_mat_triv
         index_mult_mat reduce_row_mod_D_preserves_dimensions)
   ultimately show ?case by blast
 qed
 
 
 
 lemma reduce_row_mod_D_abs_invertible_mat_case_m':
   assumes A_def: "A = A' @\<^sub>r B" and "B \<in> carrier_mat n n"
     and A': "A' \<in> carrier_mat m n" and a: "a \<le> m" 
     and j: "\<forall>j\<in>set xs. j<n \<and> (B $$ (j, j) = D) \<and> (\<forall>j'\<in>{0..<n}-{j}. B $$ (j, j') = 0)" 
     and d: "distinct xs" and mn: "m\<ge>n" and "0\<notin> set xs"
   shows "\<exists>P. P \<in> carrier_mat (m+n) (m+n) \<and> invertible_mat P \<and> 
     reduce_row_mod_D_abs A a xs D m = P * A"
   using assms
 proof (induct A a xs D m arbitrary: A' B rule: reduce_row_mod_D_abs.induct)
   case (1 A a D m)
   show ?case by (rule exI[of _ "1\<^sub>m (m+n)"], insert "1.prems", auto simp add: append_rows_def)
 next
   case (2 A a x xs D m)
   note A_A'B = "2.prems"(1)
   note B = "2.prems"(2)
   note A' = "2.prems"(3)
   note a = "2.prems"(4)
   note j = "2.prems"(5)
   note mn = "2.prems"(7)
   note d = "2.prems"(6)
   note zero_not_xs = "2.prems"(8)
   let ?reduce_xs = "(reduce_element_mod_D_abs A a x D m)"
   have reduce_xs_carrier: "?reduce_xs \<in> carrier_mat (m + n) n"
     by (metis "2.prems"(1) "2.prems"(2) "2.prems"(3) add.right_neutral append_rows_def 
             carrier_matD carrier_mat_triv index_mat_four_block(2,3) index_zero_mat(2,3)
             reduce_element_mod_D_preserves_dimensions)
   have A: "A:carrier_mat (m+n) n" using A' B A_A'B by blast 
   let ?reduce_xs = "(reduce_element_mod_D_abs A a x D m)"
   have 1: "reduce_row_mod_D_abs A a (x # xs) D m 
     = reduce_row_mod_D_abs ?reduce_xs a xs D m" by simp
   have "\<exists>P. P \<in> carrier_mat (m+n) (m+n) \<and> invertible_mat P \<and> 
     reduce_element_mod_D_abs A a x D m = P * A"
     by (rule reduce_element_mod_D_abs_invertible_mat_case_m'[OF A_A'B B A' a _ mn],
         insert zero_not_xs j, auto)
   from this obtain P where P: "P \<in> carrier_mat (m+n) (m+n)" and inv_P: "invertible_mat P"
     and R_P: "reduce_element_mod_D_abs A a x D m = P * A" by auto
   have "\<exists>P. P \<in> carrier_mat (m + n) (m + n) \<and> invertible_mat P 
       \<and> reduce_row_mod_D_abs ?reduce_xs a xs D m = P * ?reduce_xs"
   proof (rule "2.hyps")
     let ?A' = "mat_of_rows n [Matrix.row ?reduce_xs i. i \<leftarrow> [0..<m]]"
     let ?B' = "mat_of_rows n [Matrix.row ?reduce_xs i. i \<leftarrow> [m..<m+n]]"
     show B': "?B' \<in> carrier_mat n n" by auto
     show A'': "?A' : carrier_mat m n" by auto
     show reduce_split: "?reduce_xs = ?A' @\<^sub>r ?B'"
       by (smt "2"(2) "2"(4) P R_P add.comm_neutral append_rows_def append_rows_split carrier_matD
           index_mat_four_block(3) index_mult_mat(2) index_zero_mat(3) le_add1 reduce_element_mod_D_preserves_dimensions(4))
     show "\<forall>j\<in>set xs. j < n \<and> ?B' $$ (j, j) = D \<and> (\<forall>j'\<in>{0..<n} - {j}. ?B' $$ (j, j') = 0)"
     proof
       fix j assume j_xs: "j\<in>set xs"
       have "B $$ (j,j') = ?B' $$ (j,j')" if j': "j'<n" for j'
       proof -
         have "B $$ (j,j') = A $$ (m+j,j')"
           by (smt A_A'B A A' Groups.add_ac(2) j_xs add_diff_cancel_left' append_rows_def carrier_matD j'
               index_mat_four_block(1) index_mat_four_block(2,3) insert_iff j less_diff_conv list.set(2) not_add_less1)
         also have "... = ?reduce_xs $$ (m+j,j')"
           by (smt (verit, ccfv_SIG) not_add_less1
               a j zero_not_xs A add.commute add_diff_cancel_left' reduce_element_mod_D_abs_def
               cancel_comm_monoid_add_class.diff_cancel carrier_matD index_mat_addrow(1) j'
               j_xs le_eq_less_or_eq less_diff_conv less_not_refl2 list.set_intros(2) nat_SN.compat)
         also have "... = ?B'$$ (j,j')"
           by (smt B A A' A_A'B B' A'' reduce_split add.commute add_diff_cancel_left' j' not_add_less1
               append_rows_def carrier_matD index_mat_four_block j j_xs less_diff_conv list.set_intros(2))
         finally show ?thesis .
       qed
       thus "j < n \<and> ?B' $$ (j, j) = D \<and> (\<forall>j'\<in>{0..<n} - {j}. ?B' $$ (j, j') = 0)" using j
         by (metis Diff_iff atLeastLessThan_iff insert_iff j_xs list.simps(15))
     qed        
   qed (insert d zero_not_xs a mn, auto)
   from this obtain P2 where P2: "P2 \<in> carrier_mat (m + n) (m + n)" and inv_P2: "invertible_mat P2"
     and R_P2: "reduce_row_mod_D_abs ?reduce_xs a xs D m = P2 * ?reduce_xs"
     by auto
   have "invertible_mat (P2 * P)" using P P2 inv_P inv_P2 invertible_mult_JNF by blast
   moreover have "(P2 * P) \<in> carrier_mat (m+n) (m+n)" using P2 P by auto
   moreover have "reduce_row_mod_D_abs A a (x # xs) D m = (P2 * P) * A" 
     by (smt P P2 R_P R_P2 1 assoc_mult_mat carrier_matD carrier_mat_triv
         index_mult_mat reduce_row_mod_D_preserves_dimensions_abs)
   ultimately show ?case by blast
 qed
 
 
 lemma reduce_invertible_mat_case_m: 
   assumes A': "A' \<in> carrier_mat m n" and B: "B \<in> carrier_mat n n"
     and a: "a<m" and ab: "a \<noteq> m" 
   and A_def: "A = A' @\<^sub>r B"
     and j: "\<forall>j\<in>set xs. j<n \<and> (B $$ (j, j) = D) \<and> (\<forall>j'\<in>{0..<n}-{j}. B $$ (j, j') = 0)"  
   and Aaj: "A $$ (a,0) \<noteq> 0"
   and mn: "m\<ge>n"
   and n0: "0<n"
   and pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(m,0))"
   and A2_def: "A2 = Matrix.mat (dim_row A) (dim_col A)
           (\<lambda>(i,k). if i = a then (p*A$$(a,k) + q*A$$(m,k))
                    else if i = m then u * A$$(a,k) + v * A$$(m,k)
                    else A$$(i,k)
             )"
   and xs_def: "xs = [1..<n]"
   and ys_def: "ys = [1..<n]"
     and j_ys: "\<forall>j\<in>set ys. j<n \<and> (B $$ (j, j) = D) \<and> (\<forall>j'\<in>{0..<n}-{j}. B $$ (j, j') = 0)"
     and D0: "D > 0"
   and Am0_D: "A $$ (m, 0) \<in> {0,D}"
   and Am0_D2: "A $$ (m, 0) = 0 \<longrightarrow> A $$ (a, 0) = D"
 shows "\<exists>P. invertible_mat P \<and> P \<in> carrier_mat (m+n) (m+n) \<and> (reduce a m D A) = P * A"
 proof -
   let ?A = "Matrix.mat (dim_row A) (dim_col A)
           (\<lambda>(i,k). if i = a then (p*A$$(a,k) + q*A$$(m,k))
                    else if i = m then u * A$$(a,k) + v * A$$(m,k)
                    else A$$(i,k)
             )"
   have D: "D \<cdot>\<^sub>m 1\<^sub>m n \<in> carrier_mat n n" using mn by auto
   have A: "A \<in> carrier_mat (m+n) n" using A_def A' B mn by simp
   hence A_carrier: "?A \<in> carrier_mat (m+n) n" by auto
 
   let ?BM = "bezout_matrix_JNF A a m 0 euclid_ext2"
   
   have A'_BZ_A: "?A = ?BM * A"
     by (rule bezout_matrix_JNF_mult_eq[OF A' _ _ ab A_def B pquvd], insert a, auto)  
   have invertible_bezout: "invertible_mat ?BM"
     by (rule invertible_bezout_matrix_JNF[OF A is_bezout_ext_euclid_ext2 a _ _ Aaj], insert a n0, auto)      
   have BM: "?BM \<in> carrier_mat (m+n) (m+n)" unfolding bezout_matrix_JNF_def using A by auto
   let ?reduce_a = "reduce_row_mod_D ?A a xs D m"
   define A'1 where "A'1 = mat_of_rows n [Matrix.row ?A i. i \<leftarrow> [0..<m]]"
   define A'2 where "A'2 = mat_of_rows n [Matrix.row ?A i. i \<leftarrow> [m..<dim_row A]]"
   have A_A'_D: "?A = A'1 @\<^sub>r A'2" using append_rows_split A
     by (metis (no_types, lifting) A'1_def A'2_def A_carrier carrier_matD le_add1)
   have j_A'1_A'2: "\<forall>j\<in>set xs. j < n \<and> A'2 $$ (j, j) = D \<and> (\<forall>j'\<in>{0..<n} - {j}. A'2 $$ (j, j') = 0)"
     proof (rule ballI)
       fix ja assume ja: "ja\<in>set xs"
       have ja_n: "ja < n" using ja unfolding xs_def by auto
       have ja2: "ja < dim_row A - m" using A mn ja_n by auto
       have ja_m: "ja < m" using ja_n mn by auto
       have ja_not_0: "ja \<noteq> 0" using ja unfolding xs_def by auto
       show "ja < n \<and> A'2 $$ (ja, ja) = D \<and> (\<forall>j'\<in>{0..<n} - {ja}. A'2 $$ (ja, j') = 0)"
       proof -
         have "A'2 $$ (ja, ja) = [Matrix.row ?A i. i \<leftarrow> [m..<dim_row A]] ! ja $v ja"
           by (metis (no_types, lifting) A A'2_def add_diff_cancel_left' carrier_matD(1) 
               ja_n length_map length_upt mat_of_rows_index)
         also have "... = ?A $$ (m + ja, ja)" using A mn ja_n by auto
         also have "... = A $$ (m+ja, ja)" using A a mn ja_n ja_not_0 by auto
         also have "... =  (A' @\<^sub>r B) $$ (m + ja, ja)" unfolding A_def ..
         also have "... = B $$ (ja, ja)"
           by (metis B Groups.add_ac(2) append_rows_nth2 assms(1) ja_n mn nat_SN.compat)
         also have "... = D" using j ja by blast
         finally have A2_D: "A'2 $$ (ja, ja) = D" .
 
         moreover have "(\<forall>j'\<in>{0..<n} - {ja}. A'2 $$ (ja, j') = 0)"
         proof (rule ballI)
           fix j' assume j': "j': {0..<n} - {ja}"
           have "A'2 $$ (ja, j') = [Matrix.row ?A i. i \<leftarrow> [m..<dim_row A]] ! ja $v j'"
             unfolding A'2_def by (rule mat_of_rows_index, insert j' ja_n ja2, auto)
           also have "... = ?A $$ (m + ja, j')" using A mn ja_n j' by auto
           also have "... = A $$ (m+ja, j')" using A a mn ja_n ja_not_0 j' by auto
           also have "... =  (A' @\<^sub>r B) $$ (ja + m, j')" unfolding A_def
             by (simp add: add.commute)
           also have "... = B $$ (ja, j')"
             by (rule append_rows_nth2[OF A' B _ ja_m ja_n], insert j', auto)
           also have "... = 0" using mn j' ja_n j ja by auto
           finally show "A'2 $$ (ja, j') = 0" .
         qed
         ultimately show ?thesis using ja_n by simp
       qed
     qed
   have reduce_a_eq: "?reduce_a = Matrix.mat (dim_row ?A) (dim_col ?A) 
     (\<lambda>(i, k). if i = a \<and> k \<in> set xs then if k = 0 then if D dvd ?A $$ (i, k) then D
     else ?A $$ (i, k) else ?A $$ (i, k) gmod D else ?A $$ (i, k))"
   proof (rule reduce_row_mod_D_case_m'[OF A_A'_D _ _ a j_A'1_A'2 _ mn D0])    
     show "A'2 \<in> carrier_mat n n" using A A'2_def by auto
     show "A'1 \<in> carrier_mat m n" by (simp add: A'1_def mat_of_rows_def) 
     show "distinct xs" using distinct_filter distinct_upt xs_def by blast
   qed
   have reduce_a: "?reduce_a \<in> carrier_mat (m+n) n" using reduce_a_eq A by auto
   have "\<exists>P. P \<in> carrier_mat (m + n) (m + n) \<and> invertible_mat P \<and> ?reduce_a = P * ?A"
     by (rule reduce_row_mod_D_invertible_mat_case_m[OF A_A'_D _ _ _ j_A'1_A'2 mn],
         insert a A A'2_def A'1_def, auto)
   from this obtain P where P: "P \<in> carrier_mat (m + n) (m + n)" and inv_P: "invertible_mat P" 
     and reduce_a_PA: "?reduce_a = P * ?A" by blast
   let ?reduce_b = "reduce_row_mod_D ?reduce_a m ys D m"
   let ?B' = "mat_of_rows n [Matrix.row ?reduce_a i. i \<leftarrow> [0..<m]]"
   define reduce_a1 where "reduce_a1 = mat_of_rows (dim_col ?reduce_a) [Matrix.row ?reduce_a i. i \<leftarrow> [0..<m]]"
   define reduce_a2 where "reduce_a2 = mat_of_rows (dim_col ?reduce_a) [Matrix.row ?reduce_a i. i \<leftarrow> [m..<dim_row ?reduce_a]]"
   have reduce_a_split: "?reduce_a = reduce_a1 @\<^sub>r reduce_a2"
     by (unfold reduce_a1_def reduce_a2_def, rule append_rows_split, insert mn A, auto)  
   have zero_notin_ys: "0 \<notin> set ys"
   proof -
     have m: "m<dim_row A" using A n0 by auto
     have "?A $$ (m,0) =  u * A $$ (a, 0) + v * A $$ (m, 0)" using m n0 a A by auto
     also have "... = 0" using pquvd
       by (smt dvd_mult_div_cancel euclid_ext2_def euclid_ext2_works(3) more_arith_simps(11)
           mult.commute mult_minus_left prod.sel(1) prod.sel(2) semiring_gcd_class.gcd_dvd1)
     finally show ?thesis using D0 unfolding ys_def by auto
   qed
   have reduce_a2: "reduce_a2 \<in> carrier_mat n n" unfolding reduce_a2_def using A by auto
   have reduce_a1: "reduce_a1 \<in> carrier_mat m n" unfolding reduce_a1_def using A by auto
   have j2: "\<forall>j\<in>set ys. j < n \<and> reduce_a2 $$ (j, j) = D \<and> (\<forall>j'\<in>{0..<n} - {j}. reduce_a2 $$ (j, j') = 0)"
   proof
     fix j assume j_in_ys: "j \<in> set ys"
     have a_jm: "a \<noteq> j+m" using a by auto
     have m_not_jm: "m \<noteq> j + m" using zero_notin_ys j_in_ys by fastforce
     have jm: "j+m < dim_row ?A" using A_carrier j_in_ys unfolding ys_def by auto
     have jn: "j < dim_col ?A" using A_carrier j_in_ys unfolding ys_def by auto
     have jm': "j+m < dim_row A" using A_carrier j_in_ys unfolding ys_def by auto
     have jn': "j < dim_col A" using A_carrier j_in_ys unfolding ys_def by auto
     have "reduce_a2 $$ (j, j') = B $$ (j,j')" if j': "j'<n" for j'
     proof -
       have "reduce_a2 $$ (j, j') = ?reduce_a $$ (j+m,j')"
         by (rule append_rows_nth2[symmetric, OF reduce_a1 reduce_a2 reduce_a_split],
             insert j_in_ys mn j', auto simp add: ys_def)
       also have "... = ?A $$ (j+m, j')" using reduce_a_eq jm jn a_jm j' A_carrier by auto          
       also have "... = A $$ (j+m, j')" using a_jm m_not_jm jm' jn' j' A_carrier by auto
       also have "... = B $$ (j,j')"
         by (smt A append_rows_nth2 A' B A_def mn carrier_matD(2) jn' le_Suc_ex that trans_less_add1)
       finally show ?thesis .
     qed
     thus "j < n \<and> reduce_a2 $$ (j, j) = D \<and> (\<forall>j'\<in>{0..<n} - {j}. reduce_a2 $$ (j, j') = 0)"
       using j_ys j_in_ys by auto
   qed
   have reduce_b_eq: "?reduce_b = Matrix.mat (dim_row ?reduce_a) (dim_col ?reduce_a) 
     (\<lambda>(i, k). if i = m \<and> k \<in> set ys then if k = 0 then if D dvd ?reduce_a $$ (i, k) then D
       else ?reduce_a $$ (i, k) else ?reduce_a $$ (i, k) gmod D else ?reduce_a $$ (i, k))"
     by (rule reduce_row_mod_D_case_m''[OF reduce_a_split reduce_a2 reduce_a1 _ j2 _ mn zero_notin_ys],
         insert D0, auto simp add: ys_def)    
   have "\<exists>P. P \<in> carrier_mat (m + n) (m + n) \<and> invertible_mat P \<and> ?reduce_b = P * ?reduce_a"
     by (rule reduce_row_mod_D_invertible_mat_case_m'[OF reduce_a_split reduce_a2 reduce_a1 _ j2 _ mn zero_notin_ys],
         auto simp add: ys_def) 
   from this obtain Q where Q: "Q \<in> carrier_mat (m + n) (m + n)" and inv_Q: "invertible_mat Q" 
     and reduce_b_Q_reduce: "?reduce_b = Q * ?reduce_a" by blast
   have reduce_b_eq_reduce: "?reduce_b = (reduce a m D A)"
   proof (rule eq_matI)
     show dr_eq: "dim_row ?reduce_b = dim_row (reduce a m D A)" 
       and dc_eq: "dim_col ?reduce_b = dim_col (reduce a m D A)"
       using reduce_preserves_dimensions by auto
     fix i ja assume i: "i<dim_row (reduce a m D A)" and ja: "ja< dim_col (reduce a m D A)"
     have im: "i<m+n" using A i reduce_preserves_dimensions(1) by auto
     have ja_n: "ja<n" using A ja reduce_preserves_dimensions(2) by auto
     show "?reduce_b $$ (i,ja) = (reduce a m D A) $$ (i,ja)"    
     proof (cases "(i\<noteq>a \<and> i\<noteq>m)")
       case True
       have "?reduce_b $$ (i,ja) = ?reduce_a $$ (i,ja)" unfolding reduce_b_eq 
         by (smt True dr_eq dc_eq i index_mat(1) ja prod.simps(2) reduce_row_mod_D_preserves_dimensions)
       also have "... = ?A $$ (i,ja)"
         by (smt A True carrier_matD(2) dim_col_mat(1) dim_row_mat(1) i index_mat(1) ja_n 
             reduce_a_eq reduce_preserves_dimensions(1) split_conv)
       also have "... = A $$ (i,ja)" using A True im ja_n by auto
       also have "... = (reduce a m D A) $$ (i,ja)" unfolding reduce_alt_def_not0[OF Aaj pquvd]
         using im ja_n A True by auto
       finally show ?thesis .      
     next
       case False note a_or_b = False
       have gcd_pq: "p * A $$ (a, 0) + q * A $$ (m, 0) = gcd (A $$ (a, 0)) (A $$ (m, 0))"
         by (metis assms(10) euclid_ext2_works(1) euclid_ext2_works(2))
       have gcd_le_D: "gcd (A $$ (a, 0)) (A $$ (m, 0)) \<le> D"        
         by (metis Am0_D D0 assms(17) empty_iff gcd_le1_int gcd_le2_int insert_iff)
       show ?thesis
       proof (cases "i=a")
         case True note ia = True
         hence i_not_b: "i\<noteq>m" using ab by auto
         have 1: "?reduce_b $$ (i,ja) = ?reduce_a $$ (i,ja)" unfolding reduce_b_eq             
             by (smt ab dc_eq dim_row_mat(1) dr_eq i ia index_mat(1) ja prod.simps(2)
                 reduce_b_eq reduce_row_mod_D_preserves_dimensions(2))
         show ?thesis
         proof (cases "ja=0")
           case True note ja0 = True           
           hence ja_notin_xs: "ja \<notin> set xs" unfolding xs_def by auto
           have "?reduce_a $$ (i,ja) = p * A $$ (a, 0) + q * A $$ (m, 0)" 
             unfolding reduce_a_eq using True ja0 ab a_or_b i_not_b ja_n im a A False ja_notin_xs
             by auto
           also have "... = (reduce a m D A) $$ (i,ja)"
             unfolding reduce_alt_def_not0[OF Aaj pquvd]
             using True a_or_b i_not_b ja_n im A False               
             using gcd_le_D gcd_pq Am0_D Am0_D2 by auto 
           finally show ?thesis using 1 by auto
         next
           case False
           hence ja_in_xs: "ja \<in> set xs"
             unfolding xs_def using True ja_n im a A unfolding set_filter by auto
           have "?reduce_a $$ (i,ja) = ?A $$ (i, ja) gmod D"
             unfolding reduce_a_eq using True ab a_or_b i_not_b ja_n im a A ja_in_xs False by auto
           also have "... = (reduce a m D A) $$ (i,ja)"
             unfolding reduce_alt_def_not0[OF Aaj pquvd] using True a_or_b i_not_b ja_n im A False by auto
           finally show ?thesis using 1 by simp
         qed
       next
         case False note i_not_a = False
         have i_drb: "i<dim_row ?reduce_b" 
           and i_dra: "i<dim_row ?reduce_a" 
           and ja_drb: "ja < dim_col ?reduce_b"
           and ja_dra: "ja < dim_col ?reduce_a" using i ja reduce_carrier[OF A] A ja_n im by auto
         have ib: "i=m" using False a_or_b by auto
         show ?thesis
         proof (cases "ja = 0")
           case True note ja0 = True
           have uv: "u * A $$ (a, ja) + v * A $$ (m, ja) = 0"
             unfolding euclid_ext2_works[OF pquvd[symmetric]] True
             by (smt euclid_ext2_works[OF pquvd[symmetric]] more_arith_simps(11) mult.commute mult_minus_left)
           have "?reduce_b $$ (i,ja) = u * A $$ (a, ja) + v * A $$ (m, ja)"
             by (smt (z3) A A_carrier True assms(4) carrier_matD i ib index_mat(1) reduce_a_eq
                 ja_dra old.prod.case reduce_preserves_dimensions(1) zero_notin_ys reduce_b_eq
                 reduce_row_mod_D_preserves_dimensions)
           also have "... = 0" using uv by blast
           also have "... = (reduce a m D A) $$ (i,ja)" 
             unfolding reduce_alt_def_not0[OF Aaj pquvd] using True False a_or_b ib ja_n im A 
               using i_not_a uv by auto
           finally show ?thesis by auto
         next
           case False
           have ja_in_ys: "ja \<in> set ys"
             unfolding ys_def using False ib ja_n im a  A unfolding set_filter by auto
           have "?reduce_b $$ (i,ja) = (if ja = 0 then if D dvd ?reduce_a$$(i,ja) then D
                                   else ?reduce_a $$ (i, ja) else ?reduce_a $$ (i, ja) gmod D)"
             unfolding reduce_b_eq using i_not_a  ja ja_in_ys 
             by (smt i_dra ja_dra a_or_b index_mat(1) prod.simps(2))
           also have "... = (if ja = 0 then if D dvd ?reduce_a$$(i,ja) then D
                             else ?A $$ (i, ja) else ?A $$ (i, ja) gmod D)"
             unfolding reduce_a_eq using ab a_or_b ib False ja_n im a A ja_in_ys by auto
           also have "... = (reduce a m D A) $$ (i,ja)"
             unfolding reduce_alt_def_not0[OF Aaj pquvd] using  False a_or_b ib ja_n im A 
             using i_not_a  by auto         
           finally show ?thesis .
         qed
       qed
     qed
   qed
   have r: "?reduce_a = (P*?BM) * A" using A A'_BZ_A BM P reduce_a_PA by auto
   have "Q * P * ?BM : carrier_mat (m+n) (m+n)" using P BM Q by auto
   moreover have "invertible_mat (Q * P*?BM)"
     using inv_P invertible_bezout BM P invertible_mult_JNF inv_Q Q by (metis mult_carrier_mat)
   moreover have "(reduce a m D A) = (Q * P * ?BM) * A" using reduce_a_eq r reduce_b_eq_reduce
     by (smt BM P Q assoc_mult_mat carrier_matD carrier_mat_triv 
         dim_row_mat(1) index_mult_mat(2,3) reduce_b_Q_reduce)
   ultimately show ?thesis by auto
 qed
 
 
 
 lemma reduce_abs_invertible_mat_case_m: 
   assumes A': "A' \<in> carrier_mat m n" and B: "B \<in> carrier_mat n n"
     and a: "a<m" and ab: "a \<noteq> m" 
   and A_def: "A = A' @\<^sub>r B"
     and j: "\<forall>j\<in>set xs. j<n \<and> (B $$ (j, j) = D) \<and> (\<forall>j'\<in>{0..<n}-{j}. B $$ (j, j') = 0)"  
   and Aaj: "A $$ (a,0) \<noteq> 0"
   and mn: "m\<ge>n"
   and n0: "0<n"
   and pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(m,0))"
   and A2_def: "A2 = Matrix.mat (dim_row A) (dim_col A)
           (\<lambda>(i,k). if i = a then (p*A$$(a,k) + q*A$$(m,k))
                    else if i = m then u * A$$(a,k) + v * A$$(m,k)
                    else A$$(i,k)
             )"
   and xs_def: "xs = filter (\<lambda>i. abs (A2 $$ (a,i)) > D) [0..<n]"
   and ys_def: "ys = filter (\<lambda>i. abs (A2 $$ (m,i)) > D) [0..<n]"
     and j_ys: "\<forall>j\<in>set ys. j<n \<and> (B $$ (j, j) = D) \<and> (\<forall>j'\<in>{0..<n}-{j}. B $$ (j, j') = 0)"
     and D0: "D > 0"
 shows "\<exists>P. invertible_mat P \<and> P \<in> carrier_mat (m+n) (m+n) \<and> (reduce_abs a m D A) = P * A"
 proof -
   let ?A = "Matrix.mat (dim_row A) (dim_col A)
           (\<lambda>(i,k). if i = a then (p*A$$(a,k) + q*A$$(m,k))
                    else if i = m then u * A$$(a,k) + v * A$$(m,k)
                    else A$$(i,k)
             )"
   note xs_def = xs_def[unfolded A2_def]
   note ys_def = ys_def[unfolded A2_def]
   have D: "D \<cdot>\<^sub>m 1\<^sub>m n \<in> carrier_mat n n" using mn by auto
   have A: "A \<in> carrier_mat (m+n) n" using A_def A' B mn by simp
   hence A_carrier: "?A \<in> carrier_mat (m+n) n" by auto
 
   let ?BM = "bezout_matrix_JNF A a m 0 euclid_ext2"
   
   have A'_BZ_A: "?A = ?BM * A"
     by (rule bezout_matrix_JNF_mult_eq[OF A' _ _ ab A_def B pquvd], insert a, auto)  
   have invertible_bezout: "invertible_mat ?BM"
     by (rule invertible_bezout_matrix_JNF[OF A is_bezout_ext_euclid_ext2 a _ _ Aaj], insert a n0, auto)      
   have BM: "?BM \<in> carrier_mat (m+n) (m+n)" unfolding bezout_matrix_JNF_def using A by auto
   let ?reduce_a = "reduce_row_mod_D_abs ?A a xs D m"
   define A'1 where "A'1 = mat_of_rows n [Matrix.row ?A i. i \<leftarrow> [0..<m]]"
   define A'2 where "A'2 = mat_of_rows n [Matrix.row ?A i. i \<leftarrow> [m..<dim_row A]]"
   have A_A'_D: "?A = A'1 @\<^sub>r A'2" using append_rows_split A
     by (metis (no_types, lifting) A'1_def A'2_def A_carrier carrier_matD le_add1)
   have j_A'1_A'2: "\<forall>j\<in>set xs. j < n \<and> A'2 $$ (j, j) = D \<and> (\<forall>j'\<in>{0..<n} - {j}. A'2 $$ (j, j') = 0)"
     proof (rule ballI)
       fix ja assume ja: "ja\<in>set xs"
       have ja_n: "ja < n" using ja unfolding xs_def by auto
       have ja2: "ja < dim_row A - m" using A mn ja_n by auto
       have ja_m: "ja < m" using ja_n mn by auto
       have abs_A_a_ja_D: "\<bar>(?A $$ (a,ja))\<bar> > D" using ja unfolding xs_def by auto
       have ja_not_0: "ja \<noteq> 0"
       proof (rule ccontr, simp)
         assume ja_a: "ja = 0" 
         have A_mja_D: "A$$(m,ja) = D"
         proof -
           have "A$$(m,ja) = (A' @\<^sub>r B) $$ (m, ja)" unfolding A_def ..
           also have "... = B $$ (m-m,ja)"                        
             by (metis B append_rows_nth A' assms(9) carrier_matD(1) ja_a less_add_same_cancel1 less_irrefl_nat)
           also have "... = B $$ (0,0)" unfolding ja_a by auto
           also have "... = D" using mn unfolding ja_a using ja_n ja j ja_a by auto 
           finally show ?thesis .
         qed
         have "?A $$ (a, ja) = p*A$$(a,ja) + q*A$$(m,ja)" using A_carrier ja_n a A by auto
         also have "... = d" using pquvd A assms(2) ja_n ja_a
           by (simp add: bezout_coefficients_fst_snd euclid_ext2_def)
         also have "... = gcd (A$$(a,ja)) (A$$(m,ja))"
           by (metis euclid_ext2_works(2) ja_a pquvd)
         also have "abs(...) \<le> D" using A_mja_D  by (simp add: D0)       
         finally have "abs (?A $$ (a, ja)) \<le> D" .
         thus False using abs_A_a_ja_D by auto
       qed      
       show "ja < n \<and> A'2 $$ (ja, ja) = D \<and> (\<forall>j'\<in>{0..<n} - {ja}. A'2 $$ (ja, j') = 0)"
       proof -
         have "A'2 $$ (ja, ja) = [Matrix.row ?A i. i \<leftarrow> [m..<dim_row A]] ! ja $v ja"
           by (metis (no_types, lifting) A A'2_def add_diff_cancel_left' carrier_matD(1) 
               ja_n length_map length_upt mat_of_rows_index)
         also have "... = ?A $$ (m + ja, ja)" using A mn ja_n by auto
         also have "... = A $$ (m+ja, ja)" using A a mn ja_n ja_not_0 by auto
         also have "... =  (A' @\<^sub>r B) $$ (m + ja, ja)" unfolding A_def ..
         also have "... = B $$ (ja, ja)"
           by (metis B Groups.add_ac(2) append_rows_nth2 assms(1) ja_n mn nat_SN.compat)
         also have "... = D" using j ja by blast
         finally have A2_D: "A'2 $$ (ja, ja) = D" .
 
         moreover have "(\<forall>j'\<in>{0..<n} - {ja}. A'2 $$ (ja, j') = 0)"
         proof (rule ballI)
           fix j' assume j': "j': {0..<n} - {ja}"
           have "A'2 $$ (ja, j') = [Matrix.row ?A i. i \<leftarrow> [m..<dim_row A]] ! ja $v j'"
             unfolding A'2_def by (rule mat_of_rows_index, insert j' ja_n ja2, auto)
           also have "... = ?A $$ (m + ja, j')" using A mn ja_n j' by auto
           also have "... = A $$ (m+ja, j')" using A a mn ja_n ja_not_0 j' by auto
           also have "... =  (A' @\<^sub>r B) $$ (ja + m, j')" unfolding A_def
             by (simp add: add.commute)
           also have "... = B $$ (ja, j')"
             by (rule append_rows_nth2[OF A' B _ ja_m ja_n], insert j', auto)
           also have "... = 0" using mn j' ja_n j ja by auto
           finally show "A'2 $$ (ja, j') = 0" .
         qed
         ultimately show ?thesis using ja_n by simp
       qed
     qed
   have reduce_a_eq: "?reduce_a = Matrix.mat (dim_row ?A) (dim_col ?A) 
     (\<lambda>(i, k). if i = a \<and> k \<in> set xs then if k = 0 \<and> D dvd ?A $$ (i, k) then D else ?A $$ (i, k) gmod D else ?A $$ (i, k))"
   proof (rule reduce_row_mod_D_abs_case_m'[OF A_A'_D _ _ a j_A'1_A'2 _ mn D0])    
     show "A'2 \<in> carrier_mat n n" using A A'2_def by auto
     show "A'1 \<in> carrier_mat m n" by (simp add: A'1_def mat_of_rows_def) 
     show "distinct xs" using distinct_filter distinct_upt xs_def by blast
   qed
   have reduce_a: "?reduce_a \<in> carrier_mat (m+n) n" using reduce_a_eq A by auto
   have "\<exists>P. P \<in> carrier_mat (m + n) (m + n) \<and> invertible_mat P \<and> ?reduce_a = P * ?A"
     by (rule reduce_row_mod_D_abs_invertible_mat_case_m[OF A_A'_D _ _ _ j_A'1_A'2 mn],
         insert a A A'2_def A'1_def, auto)
   from this obtain P where P: "P \<in> carrier_mat (m + n) (m + n)" and inv_P: "invertible_mat P" 
     and reduce_a_PA: "?reduce_a = P * ?A" by blast
   let ?reduce_b = "reduce_row_mod_D_abs ?reduce_a m ys D m"
   let ?B' = "mat_of_rows n [Matrix.row ?reduce_a i. i \<leftarrow> [0..<m]]"
   define reduce_a1 where "reduce_a1 = mat_of_rows (dim_col ?reduce_a) [Matrix.row ?reduce_a i. i \<leftarrow> [0..<m]]"
   define reduce_a2 where "reduce_a2 = mat_of_rows (dim_col ?reduce_a) [Matrix.row ?reduce_a i. i \<leftarrow> [m..<dim_row ?reduce_a]]"
   have reduce_a_split: "?reduce_a = reduce_a1 @\<^sub>r reduce_a2"
     by (unfold reduce_a1_def reduce_a2_def, rule append_rows_split, insert mn A, auto)  
   have zero_notin_ys: "0 \<notin> set ys"
   proof -
     have m: "m<dim_row A" using A n0 by auto
     have "?A $$ (m,0) =  u * A $$ (a, 0) + v * A $$ (m, 0)" using m n0 a A by auto
     also have "... = 0" using pquvd
       by (smt dvd_mult_div_cancel euclid_ext2_def euclid_ext2_works(3) more_arith_simps(11)
           mult.commute mult_minus_left prod.sel(1) prod.sel(2) semiring_gcd_class.gcd_dvd1)
     finally show ?thesis using D0 unfolding ys_def by auto
   qed
   have reduce_a2: "reduce_a2 \<in> carrier_mat n n" unfolding reduce_a2_def using A by auto
   have reduce_a1: "reduce_a1 \<in> carrier_mat m n" unfolding reduce_a1_def using A by auto
   have j2: "\<forall>j\<in>set ys. j < n \<and> reduce_a2 $$ (j, j) = D \<and> (\<forall>j'\<in>{0..<n} - {j}. reduce_a2 $$ (j, j') = 0)"
   proof
     fix j assume j_in_ys: "j \<in> set ys"
     have a_jm: "a \<noteq> j+m" using a by auto
     have m_not_jm: "m \<noteq> j + m" using zero_notin_ys j_in_ys by fastforce
     have jm: "j+m < dim_row ?A" using A_carrier j_in_ys unfolding ys_def by auto
     have jn: "j < dim_col ?A" using A_carrier j_in_ys unfolding ys_def by auto
     have jm': "j+m < dim_row A" using A_carrier j_in_ys unfolding ys_def by auto
     have jn': "j < dim_col A" using A_carrier j_in_ys unfolding ys_def by auto
     have "reduce_a2 $$ (j, j') = B $$ (j,j')" if j': "j'<n" for j'
     proof -
       have "reduce_a2 $$ (j, j') = ?reduce_a $$ (j+m,j')"
         by (rule append_rows_nth2[symmetric, OF reduce_a1 reduce_a2 reduce_a_split],
             insert j_in_ys mn j', auto simp add: ys_def)
       also have "... = ?A $$ (j+m, j')" using reduce_a_eq jm jn a_jm j' A_carrier by auto          
       also have "... = A $$ (j+m, j')" using a_jm m_not_jm jm' jn' j' A_carrier by auto
       also have "... = B $$ (j,j')"
         by (smt A append_rows_nth2 A' B A_def mn carrier_matD(2) jn' le_Suc_ex that trans_less_add1)
       finally show ?thesis .
     qed
     thus "j < n \<and> reduce_a2 $$ (j, j) = D \<and> (\<forall>j'\<in>{0..<n} - {j}. reduce_a2 $$ (j, j') = 0)"
       using j_ys j_in_ys by auto
   qed
   have reduce_b_eq: "?reduce_b = Matrix.mat (dim_row ?reduce_a) (dim_col ?reduce_a) 
     (\<lambda>(i, k). if i = m \<and> k \<in> set ys then if k = 0 \<and> D dvd ?reduce_a $$ (i, k) then D else ?reduce_a $$ (i, k) gmod D else ?reduce_a $$ (i, k))"
     by (rule reduce_row_mod_D_abs_case_m''[OF reduce_a_split reduce_a2 reduce_a1 _ j2 _ mn zero_notin_ys],
         insert D0, auto simp add: ys_def)    
   have "\<exists>P. P \<in> carrier_mat (m + n) (m + n) \<and> invertible_mat P \<and> ?reduce_b = P * ?reduce_a"
     by (rule reduce_row_mod_D_abs_invertible_mat_case_m'[OF reduce_a_split reduce_a2 reduce_a1 _ j2 _ mn zero_notin_ys],
         auto simp add: ys_def) 
   from this obtain Q where Q: "Q \<in> carrier_mat (m + n) (m + n)" and inv_Q: "invertible_mat Q" 
     and reduce_b_Q_reduce: "?reduce_b = Q * ?reduce_a" by blast
   have reduce_b_eq_reduce: "?reduce_b = (reduce_abs a m D A)"
   proof (rule eq_matI)
     show dr_eq: "dim_row ?reduce_b = dim_row (reduce_abs a m D A)" 
       and dc_eq: "dim_col ?reduce_b = dim_col (reduce_abs a m D A)"
       using reduce_preserves_dimensions by auto
     fix i ja assume i: "i<dim_row (reduce_abs a m D A)" and ja: "ja< dim_col (reduce_abs a m D A)"
     have im: "i<m+n" using A i reduce_preserves_dimensions(3) by auto
     have ja_n: "ja<n" using A ja reduce_preserves_dimensions(4) by auto
     show "?reduce_b $$ (i,ja) = (reduce_abs a m D A) $$ (i,ja)"    
     proof (cases "(i\<noteq>a \<and> i\<noteq>m)")
       case True
       have "?reduce_b $$ (i,ja) = ?reduce_a $$ (i,ja)" unfolding reduce_b_eq 
         by (smt True dr_eq dc_eq i index_mat(1) ja prod.simps(2) reduce_row_mod_D_preserves_dimensions_abs)
       also have "... = ?A $$ (i,ja)"
         by (smt A True carrier_matD(2) dim_col_mat(1) dim_row_mat(1) i index_mat(1) ja_n 
             reduce_a_eq reduce_preserves_dimensions(3) split_conv)
       also have "... = A $$ (i,ja)" using A True im ja_n by auto
       also have "... = (reduce_abs a m D A) $$ (i,ja)" unfolding reduce_alt_def_not0[OF Aaj pquvd]
         using im ja_n A True by auto
       finally show ?thesis .      
     next
       case False note a_or_b = False
       show ?thesis
       proof (cases "i=a")
         case True note ia = True
         hence i_not_b: "i\<noteq>m" using ab by auto
         show ?thesis
         proof (cases "abs((p*A$$(a,ja) + q*A$$(m,ja))) > D")
           case True note ge_D = True
           have ja_in_xs: "ja \<in> set xs"
             unfolding xs_def using True ja_n im a A unfolding set_filter by auto
           have 1: "?reduce_b $$ (i,ja) = ?reduce_a $$ (i,ja)" unfolding reduce_b_eq             
             by (smt ab dc_eq dim_row_mat(1) dr_eq i ia index_mat(1) ja prod.simps(2)
                 reduce_b_eq reduce_row_mod_D_preserves_dimensions_abs(2))
           show ?thesis 
           proof (cases "ja = 0 \<and> D dvd p*A$$(a,ja) + q*A$$(m,ja)")
             case True
             have "?reduce_a $$ (i,ja) = D"
               unfolding reduce_a_eq using True ab a_or_b i_not_b ja_n im a A ja_in_xs False by auto
             also have "... = (reduce_abs a m D A) $$ (i,ja)"
               unfolding reduce_alt_def_not0[OF Aaj pquvd]
               using True a_or_b i_not_b ja_n im A False ge_D               
               by auto 
             finally show ?thesis using 1 by simp
           next
             case False
             have "?reduce_a $$ (i,ja) = ?A $$ (i, ja) gmod D"
               unfolding reduce_a_eq using True ab a_or_b i_not_b ja_n im a A ja_in_xs False by auto
             also have "... = (reduce_abs a m D A) $$ (i,ja)"
               unfolding reduce_alt_def_not0[OF Aaj pquvd] using True a_or_b i_not_b ja_n im A False by auto
             finally show ?thesis using 1 by simp
           qed        
         next
           case False
           have ja_in_xs: "ja \<notin> set xs"
             unfolding xs_def using False ja_n im a A unfolding set_filter by auto
           have "?reduce_b $$ (i,ja) = ?reduce_a $$ (i,ja)" unfolding reduce_b_eq             
             by (smt ab dc_eq dim_row_mat(1) dr_eq i ia index_mat(1) ja prod.simps(2)
                 reduce_b_eq reduce_row_mod_D_preserves_dimensions_abs(2))
           also have "... = ?A $$ (i, ja)"
             unfolding reduce_a_eq using False ab a_or_b i_not_b ja_n im a A ja_in_xs by auto
           also have "... = (reduce_abs a m D A) $$ (i,ja)"
             unfolding reduce_alt_def_not0[OF Aaj pquvd] using False a_or_b i_not_b ja_n im A by auto
           finally show ?thesis .
         qed
       next
         case False note i_not_a = False
         have i_drb: "i<dim_row ?reduce_b" 
           and i_dra: "i<dim_row ?reduce_a" 
           and ja_drb: "ja < dim_col ?reduce_b"
           and ja_dra: "ja < dim_col ?reduce_a" using i ja reduce_carrier[OF A] A ja_n im by auto
           have ib: "i=m" using False a_or_b by auto
         show ?thesis
         proof (cases "abs((u*A$$(a,ja) + v * A$$(m,ja))) > D")
           case True note ge_D = True
           have ja_in_ys: "ja \<in> set ys"
             unfolding ys_def using True False ib ja_n im a  A unfolding set_filter by auto
           have "?reduce_b $$ (i,ja) = (if ja = 0 \<and> D dvd ?reduce_a$$(i,ja) then D else ?reduce_a $$ (i, ja) gmod D)"
             unfolding reduce_b_eq using i_not_a True  ja ja_in_ys 
             by (smt i_dra ja_dra a_or_b index_mat(1) prod.simps(2))
           also have "... = (if ja = 0 \<and> D dvd ?reduce_a$$(i,ja) then D else ?A $$ (i, ja) gmod D)"
             unfolding reduce_a_eq using True ab a_or_b ib False ja_n im a A ja_in_ys by auto
           also have "... = (reduce_abs a m D A) $$ (i,ja)"
           proof (cases "ja = 0 \<and> D dvd ?reduce_a$$(i,ja)")
             case True
             have ja0: "ja=0" using True by auto
             have "u * A $$ (a, ja) + v * A $$ (m, ja) = 0"
               unfolding euclid_ext2_works[OF pquvd[symmetric]] ja0
               by (smt euclid_ext2_works[OF pquvd[symmetric]] more_arith_simps(11) mult.commute mult_minus_left)
             hence abs_0: "abs((u*A$$(a,ja) + v * A$$(m,ja))) = 0" by auto
             show ?thesis using abs_0 D0 ge_D by linarith           
           next
             case False
             then show ?thesis 
               unfolding reduce_alt_def_not0[OF Aaj pquvd] using True ge_D False a_or_b ib ja_n im A 
               using i_not_a by auto           
           qed      
           finally show ?thesis .
         next
           case False
           have ja_in_ys: "ja \<notin> set ys"
             unfolding ys_def using i_not_a False ib ja_n im a  A unfolding set_filter by auto
           have "?reduce_b $$ (i,ja) = ?reduce_a $$ (i,ja)" unfolding reduce_b_eq             
             by (smt False a_or_b dc_eq dim_row_mat(1) dr_eq i index_mat(1) ja ja_in_ys
                 prod.simps(2) reduce_b_eq reduce_row_mod_D_preserves_dimensions_abs(2))
           also have "... = ?A $$ (i, ja)"
             unfolding reduce_a_eq using False ab a_or_b i_not_a ja_n im a A ja_in_ys by auto
           also have "... = (reduce_abs a m D A) $$ (i,ja)"
             unfolding reduce_alt_def_not0[OF Aaj pquvd] using False a_or_b i_not_a ja_n im A by auto
           finally show ?thesis .
         qed
       qed      
     qed    
   qed
   have r: "?reduce_a = (P*?BM) * A" using A A'_BZ_A BM P reduce_a_PA by auto
   have "Q * P * ?BM : carrier_mat (m+n) (m+n)" using P BM Q by auto
   moreover have "invertible_mat (Q * P*?BM)"
     using inv_P invertible_bezout BM P invertible_mult_JNF inv_Q Q by (metis mult_carrier_mat)
   moreover have "(reduce_abs a m D A) = (Q * P * ?BM) * A" using reduce_a_eq r reduce_b_eq_reduce
     by (smt BM P Q assoc_mult_mat carrier_matD carrier_mat_triv 
         dim_row_mat(1) index_mult_mat(2,3) reduce_b_Q_reduce)
   ultimately show ?thesis by auto
 qed
 
 
 
 
 lemma reduce_not0:
   assumes A: "A \<in> carrier_mat m n" and a: "a<m" and a_less_b: "a<b" and j: "0<n" and b: "b<m"
     and Aaj: "A $$ (a,0) \<noteq> 0" and D0: "D \<noteq> 0"
   shows "reduce a b D A $$ (a, 0) \<noteq> 0" (is "?reduce $$ (a,0) \<noteq> _")
   and "reduce_abs a b D A $$ (a, 0) \<noteq> 0" (is "?reduce_abs $$ (a,0) \<noteq> _")
 proof -
   have "?reduce $$ (a,0) = (let r = gcd (A $$ (a, 0)) (A $$ (b, 0)) in if D dvd r then D else r)" 
     by (rule reduce_gcd[OF A _ j Aaj], insert a, simp)
   also have "... \<noteq> 0" unfolding Let_def using D0 
     by (smt Aaj gcd_eq_0_iff gmod_0_imp_dvd)
   finally show "reduce a b D A $$ (a, 0) \<noteq> 0" .
   have "?reduce_abs $$ (a,0) = (let r = gcd (A $$ (a, 0)) (A $$ (b, 0)) in 
         if D < r then if D dvd r then D else r gmod D else r)"
     by (rule reduce_gcd[OF A _ j Aaj], insert a, simp)
   also have "... \<noteq> 0" unfolding Let_def using D0 
     by (smt Aaj gcd_eq_0_iff gmod_0_imp_dvd)
   finally show "reduce_abs a b D A $$ (a, 0) \<noteq> 0" .
 qed
 
 lemma reduce_below_not0:
  assumes A: "A \<in> carrier_mat m n" and a: "a<m" and j: "0<n" 
     and Aaj: "A $$ (a,0) \<noteq> 0" 
 and "distinct xs" and "\<forall>x \<in> set xs. x < m \<and> a < x"
   and "D\<noteq> 0"
   shows "reduce_below a xs D A $$ (a, 0) \<noteq> 0" (is "?R $$ (a,0) \<noteq> _")
   using assms
 proof (induct a xs D A arbitrary: A rule: reduce_below.induct)
   case (1 a D A)
   then show ?case by auto
 next
   case (2 a x xs D A)
   note A = "2.prems"(1)
   note a = "2.prems"(2)
   note j = "2.prems"(3)
   note Aaj = "2.prems"(4)
   note d = "2.prems"(5)
   note D0 = "2.prems"(7)
   note x_less_xxs = "2.prems"(6)
   have xm: "x < m" using "2.prems" by auto
   have D1: "D \<cdot>\<^sub>m 1\<^sub>m n \<in> carrier_mat n n" by simp
   obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))"
     by (metis prod_cases5)
   let ?reduce_ax = "reduce a x D A"
   have reduce_ax: "?reduce_ax \<in> carrier_mat m n"
     by (metis (no_types, lifting) A carrier_matD carrier_mat_triv reduce_preserves_dimensions)
   have h: "reduce_below a xs D (reduce a x D A) $$ (a,0) \<noteq> 0"
   proof (rule "2.hyps")
     show "reduce a x D A $$ (a, 0) \<noteq> 0"
       by (rule reduce_not0[OF A a _ j xm Aaj D0], insert x_less_xxs, simp)
   qed (insert A a j Aaj d x_less_xxs xm reduce_ax D0, auto)
   thus ?case by auto
 qed
 
 
 
 lemma reduce_below_abs_not0:
  assumes A: "A \<in> carrier_mat m n" and a: "a<m" and j: "0<n" 
     and Aaj: "A $$ (a,0) \<noteq> 0" 
 and "distinct xs" and "\<forall>x \<in> set xs. x < m \<and> a < x"
   and "D\<noteq> 0"
   shows "reduce_below_abs a xs D A $$ (a, 0) \<noteq> 0" (is "?R $$ (a,0) \<noteq> _")
   using assms
 proof (induct a xs D A arbitrary: A rule: reduce_below_abs.induct)
   case (1 a D A)
   then show ?case by auto
 next
   case (2 a x xs D A)
   note A = "2.prems"(1)
   note a = "2.prems"(2)
   note j = "2.prems"(3)
   note Aaj = "2.prems"(4)
   note d = "2.prems"(5)
   note D0 = "2.prems"(7)
   note x_less_xxs = "2.prems"(6)
   have xm: "x < m" using "2.prems" by auto
   have D1: "D \<cdot>\<^sub>m 1\<^sub>m n \<in> carrier_mat n n" by simp
   obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))"
     by (metis prod_cases5)
   let ?reduce_ax = "reduce_abs a x D A"
   have reduce_ax: "?reduce_ax \<in> carrier_mat m n"
     by (metis (no_types, lifting) A carrier_matD carrier_mat_triv reduce_preserves_dimensions)
   have h: "reduce_below_abs a xs D (reduce_abs a x D A) $$ (a,0) \<noteq> 0"
   proof (rule "2.hyps")
     show "reduce_abs a x D A $$ (a, 0) \<noteq> 0"
       by (rule reduce_not0[OF A a _ j xm Aaj D0], insert x_less_xxs, simp)
   qed (insert A a j Aaj d x_less_xxs xm reduce_ax D0, auto)
   thus ?case by auto
 qed
 
 
 
 lemma reduce_below_not0_case_m:
  assumes A': "A' \<in> carrier_mat m n" and a: "a<m" and j: "0<n"
     and A_def: "A = A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
     and Aaj: "A $$ (a,0) \<noteq> 0"
     and mn: "m\<ge>n"
     and "\<forall>x \<in> set xs. x < m \<and> a < x"
     and "D \<noteq> 0"
   shows "reduce_below a (xs@[m]) D A $$ (a, 0) \<noteq> 0" (is "?R $$ (a,0) \<noteq> _")
   using assms
 proof (induct a xs D A arbitrary: A A' rule: reduce_below.induct)
   case (1 a D A)
   note A' = "1.prems"(1)
   note a = "1.prems"(2)
   note n = "1.prems"(3)
   note A_def = "1.prems"(4)
   note Aaj = "1.prems"(5)
   note mn = "1.prems"(6)
   note all_less_xxs = "1.prems"(7)
   note D0 = "1.prems"(8)
   have A: "A \<in> carrier_mat (m+n) n" using A' A_def by auto
   have "reduce_below a ([] @ [m]) D A $$ (a, 0) = reduce_below a [m] D A $$ (a, 0)" by auto
   also have "... = reduce a m D A $$ (a, 0)" by auto
   also have "... \<noteq> 0"
     by (rule reduce_not0[OF A _ a n _ Aaj D0], insert a n, auto)
   finally show ?case .
 next
   case (2 a x xs D A)
   note A' = "2.prems"(1)
   note a = "2.prems"(2)
   note n = "2.prems"(3)
   note A_def = "2.prems"(4)
   note Aaj = "2.prems"(5)
   note mn = "2.prems"(6)
   note x_less_xxs = "2.prems"(7)
   note D0= "2.prems"(8)
   have xm: "x < m" using "2.prems" by auto
   have D1: "D \<cdot>\<^sub>m 1\<^sub>m n \<in> carrier_mat n n" by simp
   have A: "A \<in> carrier_mat (m+n) n" using A' A_def by auto
   obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))"
     by (metis prod_cases5)
   let ?reduce_ax = "reduce a x D A"
   have reduce_ax: "?reduce_ax \<in> carrier_mat (m+n) n"
     by (metis (no_types, lifting) A carrier_matD carrier_mat_triv reduce_preserves_dimensions)
   have h: "reduce_below a (xs@[m]) D (reduce a x D A) $$ (a,0) \<noteq> 0"
   proof (rule "2.hyps")
     show "reduce a x D A $$ (a, 0) \<noteq> 0"
       by (rule reduce_not0[OF A _ _ _ _ _ D0], insert x_less_xxs j Aaj, auto)
     let ?reduce_ax' = "mat_of_rows n (map (Matrix.row ?reduce_ax) [0..<m])"
     show "?reduce_ax = ?reduce_ax' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n" by (rule reduce_append_rows_eq[OF A' A_def a xm n Aaj])
   qed (insert A a j Aaj x_less_xxs xm reduce_ax mn D0, auto)
   thus ?case by auto
 qed
 
 lemma reduce_below_abs_not0_case_m:
  assumes A': "A' \<in> carrier_mat m n" and a: "a<m" and j: "0<n"
     and A_def: "A = A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
     and Aaj: "A $$ (a,0) \<noteq> 0"
     and mn: "m\<ge>n"
     and "\<forall>x \<in> set xs. x < m \<and> a < x"
     and "D \<noteq> 0"
   shows "reduce_below_abs a (xs@[m]) D A $$ (a, 0) \<noteq> 0" (is "?R $$ (a,0) \<noteq> _")
   using assms
 proof (induct a xs D A arbitrary: A A' rule: reduce_below_abs.induct)
   case (1 a D A)
   note A' = "1.prems"(1)
   note a = "1.prems"(2)
   note n = "1.prems"(3)
   note A_def = "1.prems"(4)
   note Aaj = "1.prems"(5)
   note mn = "1.prems"(6)
   note all_less_xxs = "1.prems"(7)
   note D0 = "1.prems"(8)
   have A: "A \<in> carrier_mat (m+n) n" using A' A_def by auto
   have "reduce_below_abs a ([] @ [m]) D A $$ (a, 0) = reduce_below_abs a [m] D A $$ (a, 0)" by auto
   also have "... = reduce_abs a m D A $$ (a, 0)" by auto
   also have "... \<noteq> 0"
     by (rule reduce_not0[OF A _ a n _ Aaj D0], insert a n, auto)
   finally show ?case .
 next
   case (2 a x xs D A)
   note A' = "2.prems"(1)
   note a = "2.prems"(2)
   note n = "2.prems"(3)
   note A_def = "2.prems"(4)
   note Aaj = "2.prems"(5)
   note mn = "2.prems"(6)
   note x_less_xxs = "2.prems"(7)
   note D0= "2.prems"(8)
   have xm: "x < m" using "2.prems" by auto
   have D1: "D \<cdot>\<^sub>m 1\<^sub>m n \<in> carrier_mat n n" by simp
   have A: "A \<in> carrier_mat (m+n) n" using A' A_def by auto
   obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))"
     by (metis prod_cases5)
   let ?reduce_ax = "reduce_abs a x D A"
   have reduce_ax: "?reduce_ax \<in> carrier_mat (m+n) n"
     by (metis (no_types, lifting) A carrier_matD carrier_mat_triv reduce_preserves_dimensions)
   have h: "reduce_below_abs a (xs@[m]) D (reduce_abs a x D A) $$ (a,0) \<noteq> 0"
   proof (rule "2.hyps")
     show "reduce_abs a x D A $$ (a, 0) \<noteq> 0"
       by (rule reduce_not0[OF A _ _ _ _ _ D0], insert x_less_xxs j Aaj, auto)
     let ?reduce_ax' = "mat_of_rows n (map (Matrix.row ?reduce_ax) [0..<m])"
     show "?reduce_ax = ?reduce_ax' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n" by (rule reduce_append_rows_eq[OF A' A_def a xm n Aaj])
   qed (insert A a j Aaj x_less_xxs xm reduce_ax mn D0, auto)
   thus ?case by auto
 qed
 
 
 
 
 
 lemma reduce_below_invertible_mat:
   assumes A': "A' \<in> carrier_mat m n" and a: "a<m" and j: "0<n"
     and A_def: "A = A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
     and Aaj: "A $$ (a,0) \<noteq> 0"
     and "distinct xs" and "\<forall>x \<in> set xs. x < m \<and> a < x"
     and "m\<ge>n"
     and "D>0"
   shows "(\<exists>P. invertible_mat P \<and> P \<in> carrier_mat (m+n) (m+n) \<and> reduce_below a xs D A = P * A)"
   using assms
 proof (induct a xs D A arbitrary: A' rule: reduce_below.induct)
   case (1 a D A)
   then show ?case
     by (metis append_rows_def carrier_matD(1) index_mat_four_block(2) reduce_below.simps(1)
         index_smult_mat(2) index_zero_mat(2) invertible_mat_one left_mult_one_mat' one_carrier_mat)
 next
   case (2 a x xs D A)
   note A' = "2.prems"(1)
   note a = "2.prems"(2)
   note j = "2.prems"(3)
   note A_def = "2.prems"(4)
   note Aaj = "2.prems"(5)
   note d = "2.prems"(6)
   note x_less_xxs = "2.prems"(7)
   note mn = "2.prems"(8)
   note D_ge0 = "2.prems"(9)
   have D0: "D\<noteq>0" using D_ge0 by simp
   have A: "A \<in> carrier_mat (m+n) n" using A' A_def by auto
   have xm: "x < m" using "2.prems" by auto
   have D1: "D \<cdot>\<^sub>m 1\<^sub>m n \<in> carrier_mat n n" by simp
   obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))"
     by (metis prod_cases5)
   let ?reduce_ax = "reduce a x D A"
   have reduce_ax: "?reduce_ax \<in> carrier_mat (m + n) n"
     by (metis (no_types, lifting) "2" add.comm_neutral append_rows_def 
         carrier_matD carrier_mat_triv index_mat_four_block(2,3)
         index_one_mat(2) index_smult_mat(2) index_zero_mat(2,3) reduce_preserves_dimensions)
   have h: "(\<exists>P. invertible_mat P \<and> P \<in> carrier_mat (m + n) (m + n) 
     \<and> reduce_below a xs D (reduce a x D A) = P * reduce a x D A)"
   proof (rule "2.hyps"[OF _ a j _ _ ])
     let ?A' = "mat_of_rows n (map (Matrix.row ?reduce_ax) [0..<m])"
     show "reduce a x D A = ?A' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
       by (rule reduce_append_rows_eq[OF A' A_def a xm j Aaj])  
     show "reduce a x D A $$ (a, 0) \<noteq> 0"
       by (rule reduce_not0[OF A _ _ j _ Aaj], insert "2.prems", auto)
   qed (insert mn d x_less_xxs D_ge0, auto)
   from this obtain P where inv_P: "invertible_mat P" and P: "P \<in> carrier_mat (m + n) (m + n)"
     and rb_Pr: "reduce_below a xs D (reduce a x D A) = P * reduce a x D A" by blast
   have *: "reduce_below a (x # xs) D A = reduce_below a xs D (reduce a x D A)" by simp
   have "\<exists>Q. invertible_mat Q \<and> Q \<in> carrier_mat (m+n) (m+n) \<and> (reduce a x D A) = Q * A"
     by (rule reduce_invertible_mat[OF A' a j xm _ A_def Aaj ], insert "2.prems", auto)
   from this obtain Q where inv_Q: "invertible_mat Q" and Q: "Q \<in> carrier_mat (m + n) (m + n)"
     and r_QA: "reduce a x D A = Q * A" by blast
   have "invertible_mat (P*Q)" using inv_P inv_Q P Q invertible_mult_JNF by blast
   moreover have "P * Q \<in> carrier_mat (m+n) (m+n)" using P Q by auto
   moreover have "reduce_below a (x # xs) D A = (P*Q) * A" 
     by (smt P Q * assoc_mult_mat carrier_matD(1) carrier_mat_triv index_mult_mat(2) 
         r_QA rb_Pr reduce_preserves_dimensions(1))
   ultimately show ?case by blast
 qed
 
 
 lemma reduce_below_abs_invertible_mat:
   assumes A': "A' \<in> carrier_mat m n" and a: "a<m" and j: "0<n"
     and A_def: "A = A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
     and Aaj: "A $$ (a,0) \<noteq> 0"
     and "distinct xs" and "\<forall>x \<in> set xs. x < m \<and> a < x"
     and "m\<ge>n"
     and "D>0"
   shows "(\<exists>P. invertible_mat P \<and> P \<in> carrier_mat (m+n) (m+n) \<and> reduce_below_abs a xs D A = P * A)"
   using assms
 proof (induct a xs D A arbitrary: A' rule: reduce_below_abs.induct)
   case (1 a D A)
   then show ?case
     by (metis carrier_append_rows invertible_mat_one left_mult_one_mat one_carrier_mat
         reduce_below_abs.simps(1) smult_carrier_mat)
 next
   case (2 a x xs D A)
   note A' = "2.prems"(1)
   note a = "2.prems"(2)
   note j = "2.prems"(3)
   note A_def = "2.prems"(4)
   note Aaj = "2.prems"(5)
   note d = "2.prems"(6)
   note x_less_xxs = "2.prems"(7)
   note mn = "2.prems"(8)
   note D_ge0 = "2.prems"(9)
   have D0: "D\<noteq>0" using D_ge0 by simp
   have A: "A \<in> carrier_mat (m+n) n" using A' A_def by auto
   have xm: "x < m" using "2.prems" by auto
   have D1: "D \<cdot>\<^sub>m 1\<^sub>m n \<in> carrier_mat n n" by simp
   obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))"
     by (metis prod_cases5)
   let ?reduce_ax = "reduce_abs a x D A"
   have reduce_ax: "?reduce_ax \<in> carrier_mat (m + n) n"
     by (metis (no_types, lifting) "2" add.comm_neutral append_rows_def 
         carrier_matD carrier_mat_triv index_mat_four_block(2,3)
         index_one_mat(2) index_smult_mat(2) index_zero_mat(2,3) reduce_preserves_dimensions)
   have h: "(\<exists>P. invertible_mat P \<and> P \<in> carrier_mat (m + n) (m + n) 
     \<and> reduce_below_abs a xs D (reduce_abs a x D A) = P * reduce_abs a x D A)"
   proof (rule "2.hyps"[OF _ a j _ _ ])
     let ?A' = "mat_of_rows n (map (Matrix.row ?reduce_ax) [0..<m])"
     show "reduce_abs a x D A = ?A' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
       by (rule reduce_append_rows_eq[OF A' A_def a xm j Aaj])  
     show "reduce_abs a x D A $$ (a, 0) \<noteq> 0"
       by (rule reduce_not0[OF A _ _ j _ Aaj], insert "2.prems", auto)
   qed (insert mn d x_less_xxs D_ge0, auto)
   from this obtain P where inv_P: "invertible_mat P" and P: "P \<in> carrier_mat (m + n) (m + n)"
     and rb_Pr: "reduce_below_abs a xs D (reduce_abs a x D A) = P * reduce_abs a x D A" by blast
   have *: "reduce_below_abs a (x # xs) D A = reduce_below_abs a xs D (reduce_abs a x D A)" by simp
   have "\<exists>Q. invertible_mat Q \<and> Q \<in> carrier_mat (m+n) (m+n) \<and> (reduce_abs a x D A) = Q * A"
     by (rule reduce_abs_invertible_mat[OF A' a j xm _ A_def Aaj ], insert "2.prems", auto)
   from this obtain Q where inv_Q: "invertible_mat Q" and Q: "Q \<in> carrier_mat (m + n) (m + n)"
     and r_QA: "reduce_abs a x D A = Q * A" by blast
   have "invertible_mat (P*Q)" using inv_P inv_Q P Q invertible_mult_JNF by blast
   moreover have "P * Q \<in> carrier_mat (m+n) (m+n)" using P Q by auto
   moreover have "reduce_below_abs a (x # xs) D A = (P*Q) * A" 
     by (smt P Q * assoc_mult_mat carrier_matD(1) carrier_mat_triv index_mult_mat(2) 
         r_QA rb_Pr reduce_preserves_dimensions(3))
   ultimately show ?case by blast
 qed
 
 
 
 lemma reduce_below_preserves:
   assumes A': "A' \<in> carrier_mat m n" and a: "a<m" and j: "j<n"
     and A_def: "A = A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
     and Aaj: "A $$ (a,0) \<noteq> 0"
     and mn: "m\<ge>n"
   assumes "i \<notin> set xs" and "distinct xs" and "\<forall>x \<in> set xs. x < m \<and> a < x"
     and "i\<noteq>a" and "i<m+n"
   and "D>0"
   shows "reduce_below a xs D A $$ (i,j) = A $$ (i,j)"
   using assms
 proof (induct a xs D A arbitrary: A' i rule: reduce_below.induct)
   case (1 a D A)
   then show ?case by auto
 next
   case (2 a x xs D A)
   note A' = "2.prems"(1)
   note a = "2.prems"(2)
   note j = "2.prems"(3)
   note A_def = "2.prems"(4)
   note Aaj = "2.prems"(5)
   note mn = "2.prems"(6)
   note i_set_xxs = "2.prems"(7)
   note d = "2.prems"(8)
   note xxs_less_m = "2.prems"(9)
   note ia = "2.prems"(10)
   note imm = "2.prems"(11)
   note D_ge0 = "2.prems"(12)
   have D0: "D\<noteq>0" using D_ge0 by simp
   have A: "A \<in> carrier_mat (m+n) n" using A' mn A_def by auto
   have xm: "x < m"  using "2.prems" by auto
   have D1: "D \<cdot>\<^sub>m 1\<^sub>m n \<in> carrier_mat n n" by (simp add: mn)
   obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))"
     by (metis prod_cases5)
   let ?reduce_ax = "(reduce a x D A)"
   have reduce_ax: "?reduce_ax \<in> carrier_mat (m + n) n"
     by (metis (no_types, lifting) 2 add.comm_neutral append_rows_def 
         carrier_matD carrier_mat_triv index_mat_four_block(2,3)
         index_one_mat(2) index_smult_mat(2) index_zero_mat(2,3) reduce_preserves_dimensions)
   have "reduce_below a (x # xs) D A $$ (i, j) = reduce_below a xs D (reduce a x D A) $$ (i, j)"
     by auto
   also have "... = reduce a x D A $$ (i, j)"
   proof (rule "2.hyps"[OF _ a j _ _ mn _ _ _ ia imm D_ge0])
     let ?A' = "mat_of_rows n (map (Matrix.row ?reduce_ax) [0..<m])"
     show "reduce a x D A = ?A' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
       by (rule reduce_append_rows_eq[OF A' A_def a xm _ Aaj], insert j, auto)  
     show "i \<notin> set xs" using i_set_xxs by auto
     show "distinct xs" using d by auto
     show "\<forall>x\<in>set xs. x < m \<and> a < x" using xxs_less_m by auto
     show "reduce a x D A $$ (a, 0) \<noteq> 0"
       by (rule reduce_not0[OF A _ _ _ _ Aaj], insert "2.prems", auto)
     show "?A' \<in> carrier_mat m n" by auto    
   qed  
   also have "... = A $$ (i,j)" by (rule reduce_preserves[OF A j Aaj], insert "2.prems", auto)
   finally show ?case .
 qed
 
 
 
 
 lemma reduce_below_abs_preserves:
   assumes A': "A' \<in> carrier_mat m n" and a: "a<m" and j: "j<n"
     and A_def: "A = A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
     and Aaj: "A $$ (a,0) \<noteq> 0"
     and mn: "m\<ge>n"
   assumes "i \<notin> set xs" and "distinct xs" and "\<forall>x \<in> set xs. x < m \<and> a < x"
     and "i\<noteq>a" and "i<m+n"
   and "D>0"
   shows "reduce_below_abs a xs D A $$ (i,j) = A $$ (i,j)"
   using assms
 proof (induct a xs D A arbitrary: A' i rule: reduce_below_abs.induct)
   case (1 a D A)
   then show ?case by auto
 next
   case (2 a x xs D A)
   note A' = "2.prems"(1)
   note a = "2.prems"(2)
   note j = "2.prems"(3)
   note A_def = "2.prems"(4)
   note Aaj = "2.prems"(5)
   note mn = "2.prems"(6)
   note i_set_xxs = "2.prems"(7)
   note d = "2.prems"(8)
   note xxs_less_m = "2.prems"(9)
   note ia = "2.prems"(10)
   note imm = "2.prems"(11)
   note D_ge0 = "2.prems"(12)
   have D0: "D\<noteq>0" using D_ge0 by simp
   have A: "A \<in> carrier_mat (m+n) n" using A' mn A_def by auto
   have xm: "x < m"  using "2.prems" by auto
   have D1: "D \<cdot>\<^sub>m 1\<^sub>m n \<in> carrier_mat n n" by (simp add: mn)
   obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))"
     by (metis prod_cases5)
   let ?reduce_ax = "(reduce_abs a x D A)"
   have reduce_ax: "?reduce_ax \<in> carrier_mat (m + n) n"
     by (metis (no_types, lifting) 2 add.comm_neutral append_rows_def 
         carrier_matD carrier_mat_triv index_mat_four_block(2,3)
         index_one_mat(2) index_smult_mat(2) index_zero_mat(2,3) reduce_preserves_dimensions)
   have "reduce_below_abs a (x # xs) D A $$ (i, j) = reduce_below_abs a xs D (reduce_abs a x D A) $$ (i, j)"
     by auto
   also have "... = reduce_abs a x D A $$ (i, j)"
   proof (rule "2.hyps"[OF _ a j _ _ mn _ _ _ ia imm D_ge0])
     let ?A' = "mat_of_rows n (map (Matrix.row ?reduce_ax) [0..<m])"
     show "reduce_abs a x D A = ?A' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
       by (rule reduce_append_rows_eq[OF A' A_def a xm _ Aaj], insert j, auto)  
     show "i \<notin> set xs" using i_set_xxs by auto
     show "distinct xs" using d by auto
     show "\<forall>x\<in>set xs. x < m \<and> a < x" using xxs_less_m by auto
     show "reduce_abs a x D A $$ (a, 0) \<noteq> 0"
       by (rule reduce_not0[OF A _ _ _ _ Aaj], insert "2.prems", auto)
     show "?A' \<in> carrier_mat m n" by auto    
   qed  
   also have "... = A $$ (i,j)" by (rule reduce_preserves[OF A j Aaj], insert "2.prems", auto)
   finally show ?case .
 qed
 
 
 
 lemma reduce_below_0:
   assumes A': "A' \<in> carrier_mat m n" and a: "a<m" and j: "0<n"
     and A_def: "A = A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
     and Aaj: "A $$ (a,0) \<noteq> 0"
     and mn: "m\<ge>n"
   assumes "i \<in> set xs" and "distinct xs" and "\<forall>x \<in> set xs. x < m \<and> a < x"
   and "D>0"
   shows "reduce_below a xs D A $$ (i,0) = 0"
   using assms
 proof (induct a xs D A arbitrary: A' i rule: reduce_below.induct)
   case (1 a D A)
   then show ?case by auto
 next
   case (2 a x xs D A)
   note A' = "2.prems"(1)
   note a = "2.prems"(2)
   note j = "2.prems"(3)
   note A_def = "2.prems"(4)
   note Aaj = "2.prems"(5)
   note mn = "2.prems"(6)
   note i_set_xxs = "2.prems"(7)
   note d = "2.prems"(8)
   note xxs_less_m = "2.prems"(9)
   note D_ge0 = "2.prems"(10)
   have D0: "D\<noteq>0" using D_ge0 by simp
   have A: "A \<in> carrier_mat (m+n) n" using A' mn A_def by auto
   have xm: "x < m"  using "2.prems" by auto
   have D1: "D \<cdot>\<^sub>m 1\<^sub>m n \<in> carrier_mat n n" by (simp add: mn)
   obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))"
     by (metis prod_cases5)
   let ?reduce_ax = "reduce a x D A"
   have reduce_ax: "?reduce_ax \<in> carrier_mat (m + n) n"
     by (metis (no_types, lifting) "2" add.comm_neutral append_rows_def 
         carrier_matD carrier_mat_triv index_mat_four_block(2,3)
         index_one_mat(2) index_smult_mat(2) index_zero_mat(2,3) reduce_preserves_dimensions)
   show ?case
   proof (cases "i=x")
     case True
     have "reduce_below a (x # xs) D A $$ (i, 0) = reduce_below a xs D (reduce a x D A) $$ (i, 0)"
       by auto
     also have "... = (reduce a x D A) $$ (i, 0)"
     proof (rule reduce_below_preserves[OF _ a j _ _ mn ])
       let ?A' = "mat_of_rows n (map (Matrix.row ?reduce_ax) [0..<m])"
       show "reduce a x D A = ?A' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
         by (rule reduce_append_rows_eq[OF A' A_def a xm j Aaj])      
       show "distinct xs" using d by auto
       show "\<forall>x\<in>set xs. x < m \<and> a < x" using xxs_less_m by auto
       show "reduce a x D A $$ (a, 0) \<noteq> 0"
         by (rule reduce_not0[OF A _ _ j _ Aaj], insert "2.prems", auto)
       show "?A' \<in> carrier_mat m n" by auto
       show "i \<notin> set xs" using True d by auto
       show "i \<noteq> a" using "2.prems" by blast
       show "i < m + n"
         by (simp add: True trans_less_add1 xm)
     qed (insert D_ge0)
     also have "... = 0" unfolding True by (rule reduce_0[OF A _ j _ _ Aaj], insert "2.prems", auto)
     finally show ?thesis .
   next
     case False note i_not_x = False    
     have h: "reduce_below a xs D (reduce a x D A) $$ (i, 0) = 0 "
     proof (rule "2.hyps"[OF _ a j _ _ mn])
       let ?A' = "mat_of_rows n (map (Matrix.row ?reduce_ax) [0..<m])"
       show "reduce a x D A = ?A' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
       proof (rule matrix_append_rows_eq_if_preserves[OF reduce_ax D1])
         show "\<forall>i\<in>{m..<m + n}. \<forall>ja<n. ?reduce_ax $$ (i, ja) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i - m, ja)" 
         proof (rule+)
           fix i ja assume i: "i \<in> {m..<m + n}" and ja: "ja < n"
           have ja_dc: "ja < dim_col A" and i_dr: "i < dim_row A" using i ja A by auto
           have i_not_a: "i \<noteq> a" using i a by auto
           have i_not_x: "i \<noteq> x" using i xm by auto
           have "?reduce_ax $$ (i,ja) = A $$ (i,ja)" 
             unfolding reduce_alt_def_not0[OF Aaj pquvd] using ja_dc i_dr i_not_a i_not_x by auto 
           also have "... = (if i < dim_row A' then A' $$(i,ja) else (D \<cdot>\<^sub>m (1\<^sub>m n))$$(i-m,ja))"
             by (unfold A_def, rule append_rows_nth[OF A' D1 _ ja], insert A i_dr, simp)
           also have "... = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i - m, ja)" using i A' by auto
           finally show "?reduce_ax $$ (i,ja) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i - m, ja)" .   
         qed
       qed
       show "i \<in> set xs" using i_set_xxs i_not_x by auto
       show "distinct xs" using d by auto
       show "\<forall>x\<in>set xs. x < m \<and> a < x" using xxs_less_m by auto
       show "reduce a x D A $$ (a, 0) \<noteq> 0"
         by (rule reduce_not0[OF A _ _ j _ Aaj], insert "2.prems", auto)
       show "?A' \<in> carrier_mat m n" by auto
     qed (insert D_ge0)
     have "reduce_below a (x # xs) D A $$ (i, 0) = reduce_below a xs D (reduce a x D A) $$ (i, 0)"
       by auto
     also have "... = 0" using h .
     finally show ?thesis .
   qed
 qed
 
 lemma reduce_below_abs_0:
   assumes A': "A' \<in> carrier_mat m n" and a: "a<m" and j: "0<n"
     and A_def: "A = A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
     and Aaj: "A $$ (a,0) \<noteq> 0"
     and mn: "m\<ge>n"
   assumes "i \<in> set xs" and "distinct xs" and "\<forall>x \<in> set xs. x < m \<and> a < x"
   and "D>0"
   shows "reduce_below_abs a xs D A $$ (i,0) = 0"
   using assms
 proof (induct a xs D A arbitrary: A' i rule: reduce_below_abs.induct)
   case (1 a D A)
   then show ?case by auto
 next
   case (2 a x xs D A)
   note A' = "2.prems"(1)
   note a = "2.prems"(2)
   note j = "2.prems"(3)
   note A_def = "2.prems"(4)
   note Aaj = "2.prems"(5)
   note mn = "2.prems"(6)
   note i_set_xxs = "2.prems"(7)
   note d = "2.prems"(8)
   note xxs_less_m = "2.prems"(9)
   note D_ge0 = "2.prems"(10)
   have D0: "D\<noteq>0" using D_ge0 by simp
   have A: "A \<in> carrier_mat (m+n) n" using A' mn A_def by auto
   have xm: "x < m"  using "2.prems" by auto
   have D1: "D \<cdot>\<^sub>m 1\<^sub>m n \<in> carrier_mat n n" by (simp add: mn)
   obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))"
     by (metis prod_cases5)
   let ?reduce_ax = "reduce_abs a x D A"
   have reduce_ax: "?reduce_ax \<in> carrier_mat (m + n) n"
     by (metis (no_types, lifting) "2" add.comm_neutral append_rows_def 
         carrier_matD carrier_mat_triv index_mat_four_block(2,3)
         index_one_mat(2) index_smult_mat(2) index_zero_mat(2,3) reduce_preserves_dimensions)
   show ?case
   proof (cases "i=x")
     case True
     have "reduce_below_abs a (x # xs) D A $$ (i, 0) = reduce_below_abs a xs D (reduce_abs a x D A) $$ (i, 0)"
       by auto
     also have "... = (reduce_abs a x D A) $$ (i, 0)"
     proof (rule reduce_below_abs_preserves[OF _ a j _ _ mn ])
       let ?A' = "mat_of_rows n (map (Matrix.row ?reduce_ax) [0..<m])"
       show "reduce_abs a x D A = ?A' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
         by (rule reduce_append_rows_eq[OF A' A_def a xm j Aaj])      
       show "distinct xs" using d by auto
       show "\<forall>x\<in>set xs. x < m \<and> a < x" using xxs_less_m by auto
       show "reduce_abs a x D A $$ (a, 0) \<noteq> 0"
         by (rule reduce_not0[OF A _ _ j _ Aaj], insert "2.prems", auto)
       show "?A' \<in> carrier_mat m n" by auto
       show "i \<notin> set xs" using True d by auto
       show "i \<noteq> a" using "2.prems" by blast
       show "i < m + n"
         by (simp add: True trans_less_add1 xm)
     qed (insert D_ge0)
     also have "... = 0" unfolding True by (rule reduce_0[OF A _ j _ _ Aaj], insert "2.prems", auto)
     finally show ?thesis .
   next
     case False note i_not_x = False    
     have h: "reduce_below_abs a xs D (reduce_abs a x D A) $$ (i, 0) = 0 "
     proof (rule "2.hyps"[OF _ a j _ _ mn])
       let ?A' = "mat_of_rows n (map (Matrix.row ?reduce_ax) [0..<m])"
       show "reduce_abs a x D A = ?A' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
       proof (rule matrix_append_rows_eq_if_preserves[OF reduce_ax D1])
         show "\<forall>i\<in>{m..<m + n}. \<forall>ja<n. ?reduce_ax $$ (i, ja) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i - m, ja)" 
         proof (rule+)
           fix i ja assume i: "i \<in> {m..<m + n}" and ja: "ja < n"
           have ja_dc: "ja < dim_col A" and i_dr: "i < dim_row A" using i ja A by auto
           have i_not_a: "i \<noteq> a" using i a by auto
           have i_not_x: "i \<noteq> x" using i xm by auto
           have "?reduce_ax $$ (i,ja) = A $$ (i,ja)" 
             unfolding reduce_alt_def_not0[OF Aaj pquvd] using ja_dc i_dr i_not_a i_not_x by auto 
           also have "... = (if i < dim_row A' then A' $$(i,ja) else (D \<cdot>\<^sub>m (1\<^sub>m n))$$(i-m,ja))"
             by (unfold A_def, rule append_rows_nth[OF A' D1 _ ja], insert A i_dr, simp)
           also have "... = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i - m, ja)" using i A' by auto
           finally show "?reduce_ax $$ (i,ja) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i - m, ja)" .   
         qed
       qed
       show "i \<in> set xs" using i_set_xxs i_not_x by auto
       show "distinct xs" using d by auto
       show "\<forall>x\<in>set xs. x < m \<and> a < x" using xxs_less_m by auto
       show "reduce_abs a x D A $$ (a, 0) \<noteq> 0"
         by (rule reduce_not0[OF A _ _ j _ Aaj], insert "2.prems", auto)
       show "?A' \<in> carrier_mat m n" by auto
     qed (insert D_ge0)
     have "reduce_below_abs a (x # xs) D A $$ (i, 0) = reduce_below_abs a xs D (reduce_abs a x D A) $$ (i, 0)"
       by auto
     also have "... = 0" using h .
     finally show ?thesis .
   qed
 qed
 
 
 
 
 lemma reduce_below_preserves_case_m:
   assumes A': "A' \<in> carrier_mat m n" and a: "a<m" and j: "j<n"
     and A_def: "A = A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
     and Aaj: "A $$ (a,0) \<noteq> 0"
     and mn: "m\<ge>n"
   assumes "i \<notin> set xs" and "distinct xs" and "\<forall>x \<in> set xs. x < m \<and> a < x"
     and "i\<noteq>a" and "i<m+n" and "i\<noteq> m"
   and "D>0"
   shows "reduce_below a (xs @ [m]) D A $$ (i,j) = A $$ (i,j)"
   using assms
 proof (induct a xs D A arbitrary: A' i rule: reduce_below.induct)
   case (1 a D A)
   have "reduce_below a ([] @ [m]) D A $$ (i, j) =  reduce_below a [m] D A $$ (i, j)" by auto
   also have "... = reduce a m D A $$ (i,j)" by auto
   also have "... = A $$ (i,j)"
     by (rule reduce_preserves, insert "1", auto)
   finally show ?case .
 next
   case (2 a x xs D A)
   note A' = "2.prems"(1)
   note a = "2.prems"(2)
   note j = "2.prems"(3)
   note A_def = "2.prems"(4)
   note Aaj = "2.prems"(5)
   note mn = "2.prems"(6)
   note i_set_xxs = "2.prems"(7)
   note d = "2.prems"(8)
   note xxs_less_m = "2.prems"(9)
   note ia = "2.prems"(10)
   note imm = "2.prems"(11)
   note D_ge0 = "2.prems"(13)
   have D0: "D\<noteq>0" using D_ge0 by simp
   have A: "A \<in> carrier_mat (m+n) n" using A' mn A_def by auto
   have xm: "x < m"  using "2.prems" by auto
   have D1: "D \<cdot>\<^sub>m 1\<^sub>m n \<in> carrier_mat n n" by (simp add: mn)
   obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))"
     by (metis prod_cases5)
   let ?reduce_ax = "(reduce a x D A)"
   have reduce_ax: "?reduce_ax \<in> carrier_mat (m + n) n"
     by (metis (no_types, lifting) A' A_def add.comm_neutral append_rows_def 
         carrier_matD carrier_mat_triv index_mat_four_block(2,3)
         index_one_mat(2) index_smult_mat(2) index_zero_mat(2,3) reduce_preserves_dimensions)
   have "reduce_below a ((x # xs) @ [m]) D A $$ (i, j) 
       = reduce_below a (xs@[m]) D (reduce a x D A) $$ (i, j)"
     by auto
   also have "... = reduce a x D A $$ (i, j)"
   proof (rule "2.hyps"[OF _ a j _ _ mn _ _ _ ia imm _ D_ge0])
     let ?A' = "mat_of_rows n (map (Matrix.row ?reduce_ax) [0..<m])"
     show "reduce a x D A = ?A' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
       by (rule reduce_append_rows_eq[OF A' A_def a xm _ Aaj], insert j, auto)  
     show "i \<notin> set xs" using i_set_xxs by auto
     show "distinct xs" using d by auto
     show "\<forall>x\<in>set xs. x < m \<and> a < x" using xxs_less_m by auto
     show "reduce a x D A $$ (a, 0) \<noteq> 0"
       by (rule reduce_not0[OF A _ _ _ _ Aaj], insert "2.prems", auto)
     show "?A' \<in> carrier_mat m n" by auto    
     show "i\<noteq>m" using "2.prems" by auto
   qed  
   also have "... = A $$ (i,j)" by (rule reduce_preserves[OF A j Aaj], insert "2.prems", auto)
   finally show ?case .
 qed
 
 
 lemma reduce_below_abs_preserves_case_m:
   assumes A': "A' \<in> carrier_mat m n" and a: "a<m" and j: "j<n"
     and A_def: "A = A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
     and Aaj: "A $$ (a,0) \<noteq> 0"
     and mn: "m\<ge>n"
   assumes "i \<notin> set xs" and "distinct xs" and "\<forall>x \<in> set xs. x < m \<and> a < x"
     and "i\<noteq>a" and "i<m+n" and "i\<noteq> m"
   and "D>0"
   shows "reduce_below_abs a (xs @ [m]) D A $$ (i,j) = A $$ (i,j)"
   using assms
 proof (induct a xs D A arbitrary: A' i rule: reduce_below_abs.induct)
   case (1 a D A)
   have "reduce_below_abs a ([] @ [m]) D A $$ (i, j) = reduce_below_abs a [m] D A $$ (i, j)" by auto
   also have "... = reduce_abs a m D A $$ (i,j)" by auto
   also have "... = A $$ (i,j)"
     by (rule reduce_preserves, insert "1", auto)
   finally show ?case .
 next
   case (2 a x xs D A)
   note A' = "2.prems"(1)
   note a = "2.prems"(2)
   note j = "2.prems"(3)
   note A_def = "2.prems"(4)
   note Aaj = "2.prems"(5)
   note mn = "2.prems"(6)
   note i_set_xxs = "2.prems"(7)
   note d = "2.prems"(8)
   note xxs_less_m = "2.prems"(9)
   note ia = "2.prems"(10)
   note imm = "2.prems"(11)
   note D_ge0 = "2.prems"(13)
   have D0: "D\<noteq>0" using D_ge0 by simp
   have A: "A \<in> carrier_mat (m+n) n" using A' mn A_def by auto
   have xm: "x < m"  using "2.prems" by auto
   have D1: "D \<cdot>\<^sub>m 1\<^sub>m n \<in> carrier_mat n n" by (simp add: mn)
   obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))"
     by (metis prod_cases5)
   let ?reduce_ax = "(reduce_abs a x D A)"
   have reduce_ax: "?reduce_ax \<in> carrier_mat (m + n) n"
     by (metis (no_types, lifting) A' A_def add.comm_neutral append_rows_def 
         carrier_matD carrier_mat_triv index_mat_four_block(2,3)
         index_one_mat(2) index_smult_mat(2) index_zero_mat(2,3) reduce_preserves_dimensions)
   have "reduce_below_abs a ((x # xs) @ [m]) D A $$ (i, j) 
       = reduce_below_abs a (xs@[m]) D (reduce_abs a x D A) $$ (i, j)"
     by auto
   also have "... = reduce_abs a x D A $$ (i, j)"
   proof (rule "2.hyps"[OF _ a j _ _ mn _ _ _ ia imm _ D_ge0])
     let ?A' = "mat_of_rows n (map (Matrix.row ?reduce_ax) [0..<m])"
     show "reduce_abs a x D A = ?A' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
       by (rule reduce_append_rows_eq[OF A' A_def a xm _ Aaj], insert j, auto)  
     show "i \<notin> set xs" using i_set_xxs by auto
     show "distinct xs" using d by auto
     show "\<forall>x\<in>set xs. x < m \<and> a < x" using xxs_less_m by auto
     show "reduce_abs a x D A $$ (a, 0) \<noteq> 0"
       by (rule reduce_not0[OF A _ _ _ _ Aaj], insert "2.prems", auto)
     show "?A' \<in> carrier_mat m n" by auto    
     show "i\<noteq>m" using "2.prems" by auto
   qed  
   also have "... = A $$ (i,j)" by (rule reduce_preserves[OF A j Aaj], insert "2.prems", auto)
   finally show ?case .
 qed
 
 
 
 lemma reduce_below_0_case_m1:
   assumes A': "A' \<in> carrier_mat m n" and a: "a<m" and j: "0<n"
     and A_def: "A = A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
     and Aaj: "A $$ (a,0) \<noteq> 0"
     and mn: "m\<ge>n"
   assumes "distinct xs" and "\<forall>x \<in> set xs. x < m \<and> a < x"
     and "m\<noteq>a"
   and "D>0"
   shows "reduce_below a (xs @ [m]) D A $$ (m,0) = 0"
   using assms
 proof (induct a xs D A arbitrary: A' rule: reduce_below.induct)
   case (1 a D A)
   have A: "A \<in> carrier_mat (m+n) n" using "1" by auto
   have " reduce_below a ([] @ [m]) D A $$ (m, 0) =  reduce_below a [m] D A $$ (m, 0)" by auto
   also have "... = reduce a m D A $$ (m,0)" by auto
   also have "... = 0" by (rule reduce_0[OF A], insert "1.prems", auto)
   finally show ?case .
 next
   case (2 a x xs D A)
   note A' = "2.prems"(1)
   note a = "2.prems"(2)
   note j = "2.prems"(3)
   note A_def = "2.prems"(4)
   note Aaj = "2.prems"(5)
   note mn = "2.prems"(6)
   note d = "2.prems"(7)
   note xxs_less_m = "2.prems"(8)
   note ma = "2.prems"(9)
   note D_ge0 = "2.prems"(10)
   have D0: "D\<noteq>0" using D_ge0 by simp
   have A: "A \<in> carrier_mat (m+n) n" using A' mn A_def by auto
   have xm: "x < m"  using "2.prems" by auto
   have D1: "D \<cdot>\<^sub>m 1\<^sub>m n \<in> carrier_mat n n" by (simp add: mn)
   obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))"
     by (metis prod_cases5)
   let ?reduce_ax = "(reduce a x D A)"
   have reduce_ax: "?reduce_ax \<in> carrier_mat (m + n) n"
     by (metis (no_types, lifting) "2" add.comm_neutral append_rows_def 
         carrier_matD carrier_mat_triv index_mat_four_block(2,3)
         index_one_mat(2) index_smult_mat(2) index_zero_mat(2,3) reduce_preserves_dimensions)
   have "reduce_below a ((x # xs) @ [m]) D A $$ (m, 0) = reduce_below a (xs@[m]) D (reduce a x D A) $$ (m, 0)"
     by auto
   also have "... = 0"
   proof (rule "2.hyps"[OF ])
     let ?A' = "mat_of_rows n (map (Matrix.row ?reduce_ax) [0..<m])"
     show "reduce a x D A = ?A' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
       by (rule reduce_append_rows_eq[OF A' A_def a xm j Aaj])  
     show "distinct xs" using d by auto
     show "\<forall>x\<in>set xs. x < m \<and> a < x" using xxs_less_m by auto
     show "reduce a x D A $$ (a, 0) \<noteq> 0"
       by (rule reduce_not0[OF A _ _ j _ Aaj], insert "2.prems", auto)
     show "?A' \<in> carrier_mat m n" by auto    
   qed (insert "2.prems", auto)
   finally show ?case .
 qed
 
 lemma reduce_below_abs_0_case_m1:
   assumes A': "A' \<in> carrier_mat m n" and a: "a<m" and j: "0<n"
     and A_def: "A = A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
     and Aaj: "A $$ (a,0) \<noteq> 0"
     and mn: "m\<ge>n"
   assumes "distinct xs" and "\<forall>x \<in> set xs. x < m \<and> a < x"
     and "m\<noteq>a"
   and "D>0"
   shows "reduce_below_abs a (xs @ [m]) D A $$ (m,0) = 0"
   using assms
 proof (induct a xs D A arbitrary: A' rule: reduce_below_abs.induct)
   case (1 a D A)
   have A: "A \<in> carrier_mat (m+n) n" using "1" by auto
   have " reduce_below_abs a ([] @ [m]) D A $$ (m, 0) =  reduce_below_abs a [m] D A $$ (m, 0)" by auto
   also have "... = reduce_abs a m D A $$ (m,0)" by auto
   also have "... = 0" by (rule reduce_0[OF A], insert "1.prems", auto)
   finally show ?case .
 next
   case (2 a x xs D A)
   note A' = "2.prems"(1)
   note a = "2.prems"(2)
   note j = "2.prems"(3)
   note A_def = "2.prems"(4)
   note Aaj = "2.prems"(5)
   note mn = "2.prems"(6)
   note d = "2.prems"(7)
   note xxs_less_m = "2.prems"(8)
   note ma = "2.prems"(9)
   note D_ge0 = "2.prems"(10)
   have D0: "D\<noteq>0" using D_ge0 by simp
   have A: "A \<in> carrier_mat (m+n) n" using A' mn A_def by auto
   have xm: "x < m"  using "2.prems" by auto
   have D1: "D \<cdot>\<^sub>m 1\<^sub>m n \<in> carrier_mat n n" by (simp add: mn)
   obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))"
     by (metis prod_cases5)
   let ?reduce_ax = "(reduce_abs a x D A)"
   have reduce_ax: "?reduce_ax \<in> carrier_mat (m + n) n"
     by (metis (no_types, lifting) "2" add.comm_neutral append_rows_def 
         carrier_matD carrier_mat_triv index_mat_four_block(2,3)
         index_one_mat(2) index_smult_mat(2) index_zero_mat(2,3) reduce_preserves_dimensions)
   have "reduce_below_abs a ((x # xs) @ [m]) D A $$ (m, 0) = reduce_below_abs a (xs@[m]) D (reduce_abs a x D A) $$ (m, 0)"
     by auto
   also have "... = 0"
   proof (rule "2.hyps"[OF ])
     let ?A' = "mat_of_rows n (map (Matrix.row ?reduce_ax) [0..<m])"
     show "reduce_abs a x D A = ?A' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
       by (rule reduce_append_rows_eq[OF A' A_def a xm j Aaj])  
     show "distinct xs" using d by auto
     show "\<forall>x\<in>set xs. x < m \<and> a < x" using xxs_less_m by auto
     show "reduce_abs a x D A $$ (a, 0) \<noteq> 0"
       by (rule reduce_not0[OF A _ _ j _ Aaj], insert "2.prems", auto)
     show "?A' \<in> carrier_mat m n" by auto    
   qed (insert "2.prems", auto)
   finally show ?case .
 qed
 
 
 
 lemma reduce_below_preserves_case_m2:
   assumes A': "A' \<in> carrier_mat m n" and a: "a<m" and j: "0<n"
     and A_def: "A = A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
     and Aaj: "A $$ (a,0) \<noteq> 0"
     and mn: "m\<ge>n"
   assumes "i \<in> set xs" and "distinct xs" and "\<forall>x \<in> set xs. x < m \<and> a < x"
     and "i\<noteq>a" and "i<m+n"
   and "D>0"
   shows "reduce_below a (xs @ [m]) D A $$ (i,0) = reduce_below a xs D A $$ (i,0)"
   using assms
 proof (induct a xs D A arbitrary: A' i rule: reduce_below.induct)
   case (1 a D A)
   then show ?case by auto
 next
   case (2 a x xs D A)
   note A' = "2.prems"(1)
   note a = "2.prems"(2)
   note j = "2.prems"(3)
   note A_def = "2.prems"(4)
   note Aaj = "2.prems"(5)
   note mn = "2.prems"(6)
   note i_set_xxs = "2.prems"(7)
   note d = "2.prems"(8)
   note xxs_less_m = "2.prems"(9)
   note ia = "2.prems"(10)
   note imm = "2.prems"(11)
   note D_ge0 = "2.prems"(12)
   have D0: "D\<noteq>0" using D_ge0 by simp
   have A: "A \<in> carrier_mat (m+n) n" using A' mn A_def by auto
   have xm: "x < m"  using "2.prems" by auto
   have D1: "D \<cdot>\<^sub>m 1\<^sub>m n \<in> carrier_mat n n" by (simp add: mn)
   obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))"
     by (metis prod_cases5)
   let ?reduce_ax = "(reduce a x D A)"
   have reduce_ax: "?reduce_ax \<in> carrier_mat (m + n) n"
     by (metis (no_types, lifting) A_def A' add.comm_neutral append_rows_def 
         carrier_matD carrier_mat_triv index_mat_four_block(2,3)
         index_one_mat(2) index_smult_mat(2) index_zero_mat(2,3) reduce_preserves_dimensions)
   show ?case
   proof (cases "i=x")
     case True
     have "reduce_below a ((x # xs) @ [m]) D A $$ (i, 0) 
       = reduce_below a (xs @ [m]) D (reduce a x D A) $$ (i, 0)"
       by auto
     also have "... = (reduce a x D A) $$ (i, 0)"
     proof (rule reduce_below_preserves_case_m[OF _ a j _ _ mn _ _ _ _ _ _ D_ge0])
       let ?A' = "mat_of_rows n (map (Matrix.row ?reduce_ax) [0..<m])"
       show "reduce a x D A = ?A' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
       proof (rule matrix_append_rows_eq_if_preserves[OF reduce_ax D1])
         show "\<forall>i\<in>{m..<m + n}. \<forall>ja<n. ?reduce_ax $$ (i, ja) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i - m, ja)" 
         proof (rule+)
           fix i ja assume i: "i \<in> {m..<m + n}" and ja: "ja < n"
           have ja_dc: "ja < dim_col A" and i_dr: "i < dim_row A" using i ja A by auto
           have i_not_a: "i \<noteq> a" using i a by auto
           have i_not_x: "i \<noteq> x" using i xm by auto
           have "?reduce_ax $$ (i,ja) = A $$ (i,ja)" 
             unfolding reduce_alt_def_not0[OF Aaj pquvd] using ja_dc i_dr i_not_a i_not_x by auto 
           also have "... = (if i < dim_row A' then A' $$(i,ja) else (D \<cdot>\<^sub>m (1\<^sub>m n))$$(i-m,ja))"
             by (unfold A_def, rule append_rows_nth[OF A' D1 _ ja], insert A i_dr, simp)
           also have "... = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i - m, ja)" using i A' by auto
           finally show "?reduce_ax $$ (i,ja) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i - m, ja)" .   
         qed
       qed
       show "distinct xs" using d by auto
       show "\<forall>x\<in>set xs. x < m \<and> a < x" using xxs_less_m by auto
       show "reduce a x D A $$ (a, 0) \<noteq> 0"
         by (rule reduce_not0[OF A _ _ _ _ Aaj], insert "2.prems", auto)
       show "?A' \<in> carrier_mat m n" by auto
       show "i \<notin> set xs" using True d by auto
       show "i \<noteq> a" using "2.prems" by blast
       show "i < m + n" 
         by (simp add: True trans_less_add1 xm)
       show "i \<noteq> m"  by (simp add: True less_not_refl3 xm)
     qed
     also have "... = 0" unfolding True by (rule reduce_0[OF A _ _ _ _ Aaj], insert "2.prems", auto)
     also have "... = reduce_below a (x # xs) D A $$ (i, 0) "
       unfolding True by (rule reduce_below_0[symmetric], insert "2.prems", auto)
     finally show ?thesis .
   next
     case False
     have "reduce_below a ((x # xs) @ [m]) D A $$ (i, 0) 
       = reduce_below a (xs@[m]) D (reduce a x D A) $$ (i, 0)"
       by auto
     also have "... = reduce_below a xs D (reduce a x D A) $$ (i, 0)"
     proof (rule "2.hyps"[OF _ a j _ _ mn _ _ _ ia imm D_ge0])
       let ?A' = "mat_of_rows n (map (Matrix.row ?reduce_ax) [0..<m])"
       show "reduce a x D A = ?A' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
         by (rule reduce_append_rows_eq[OF A' A_def a xm j Aaj])  
       show "i \<in> set xs" using i_set_xxs False by auto
       show "distinct xs" using d by auto
       show "\<forall>x\<in>set xs. x < m \<and> a < x" using xxs_less_m by auto
       show "reduce a x D A $$ (a, 0) \<noteq> 0"
         by (rule reduce_not0[OF A _ _ j _ Aaj], insert "2.prems", auto)
       show "?A' \<in> carrier_mat m n" by auto    
     qed  
     also have "... = reduce_below a (x # xs) D A $$ (i, 0)" by auto
     finally show ?thesis .
   qed
 qed
 
 
 lemma reduce_below_abs_preserves_case_m2:
   assumes A': "A' \<in> carrier_mat m n" and a: "a<m" and j: "0<n"
     and A_def: "A = A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
     and Aaj: "A $$ (a,0) \<noteq> 0"
     and mn: "m\<ge>n"
   assumes "i \<in> set xs" and "distinct xs" and "\<forall>x \<in> set xs. x < m \<and> a < x"
     and "i\<noteq>a" and "i<m+n"
   and "D>0"
   shows "reduce_below_abs a (xs @ [m]) D A $$ (i,0) = reduce_below_abs a xs D A $$ (i,0)"
   using assms
 proof (induct a xs D A arbitrary: A' i rule: reduce_below_abs.induct)
   case (1 a D A)
   then show ?case by auto
 next
   case (2 a x xs D A)
   note A' = "2.prems"(1)
   note a = "2.prems"(2)
   note j = "2.prems"(3)
   note A_def = "2.prems"(4)
   note Aaj = "2.prems"(5)
   note mn = "2.prems"(6)
   note i_set_xxs = "2.prems"(7)
   note d = "2.prems"(8)
   note xxs_less_m = "2.prems"(9)
   note ia = "2.prems"(10)
   note imm = "2.prems"(11)
   note D_ge0 = "2.prems"(12)
   have D0: "D\<noteq>0" using D_ge0 by simp
   have A: "A \<in> carrier_mat (m+n) n" using A' mn A_def by auto
   have xm: "x < m"  using "2.prems" by auto
   have D1: "D \<cdot>\<^sub>m 1\<^sub>m n \<in> carrier_mat n n" by (simp add: mn)
   obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))"
     by (metis prod_cases5)
   let ?reduce_ax = "(reduce_abs a x D A)"
   have reduce_ax: "?reduce_ax \<in> carrier_mat (m + n) n"
     by (metis (no_types, lifting) A_def A' add.comm_neutral append_rows_def 
         carrier_matD carrier_mat_triv index_mat_four_block(2,3)
         index_one_mat(2) index_smult_mat(2) index_zero_mat(2,3) reduce_preserves_dimensions)
   show ?case
   proof (cases "i=x")
     case True
     have "reduce_below_abs a ((x # xs) @ [m]) D A $$ (i, 0) 
       = reduce_below_abs a (xs @ [m]) D (reduce_abs a x D A) $$ (i, 0)"
       by auto
     also have "... = (reduce_abs a x D A) $$ (i, 0)"
     proof (rule reduce_below_abs_preserves_case_m[OF _ a j _ _ mn _ _ _ _ _ _ D_ge0])
       let ?A' = "mat_of_rows n (map (Matrix.row ?reduce_ax) [0..<m])"
       show "reduce_abs a x D A = ?A' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
       proof (rule matrix_append_rows_eq_if_preserves[OF reduce_ax D1])
         show "\<forall>i\<in>{m..<m + n}. \<forall>ja<n. ?reduce_ax $$ (i, ja) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i - m, ja)" 
         proof (rule+)
           fix i ja assume i: "i \<in> {m..<m + n}" and ja: "ja < n"
           have ja_dc: "ja < dim_col A" and i_dr: "i < dim_row A" using i ja A by auto
           have i_not_a: "i \<noteq> a" using i a by auto
           have i_not_x: "i \<noteq> x" using i xm by auto
           have "?reduce_ax $$ (i,ja) = A $$ (i,ja)" 
             unfolding reduce_alt_def_not0[OF Aaj pquvd] using ja_dc i_dr i_not_a i_not_x by auto 
           also have "... = (if i < dim_row A' then A' $$(i,ja) else (D \<cdot>\<^sub>m (1\<^sub>m n))$$(i-m,ja))"
             by (unfold A_def, rule append_rows_nth[OF A' D1 _ ja], insert A i_dr, simp)
           also have "... = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i - m, ja)" using i A' by auto
           finally show "?reduce_ax $$ (i,ja) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i - m, ja)" .   
         qed
       qed
       show "distinct xs" using d by auto
       show "\<forall>x\<in>set xs. x < m \<and> a < x" using xxs_less_m by auto
       show "reduce_abs a x D A $$ (a, 0) \<noteq> 0"
         by (rule reduce_not0[OF A _ _ _ _ Aaj], insert "2.prems", auto)
       show "?A' \<in> carrier_mat m n" by auto
       show "i \<notin> set xs" using True d by auto
       show "i \<noteq> a" using "2.prems" by blast
       show "i < m + n" 
         by (simp add: True trans_less_add1 xm)
       show "i \<noteq> m"  by (simp add: True less_not_refl3 xm)
     qed
     also have "... = 0" unfolding True by (rule reduce_0[OF A _ _ _ _ Aaj], insert "2.prems", auto)
     also have "... = reduce_below_abs a (x # xs) D A $$ (i, 0) "
       unfolding True by (rule reduce_below_abs_0[symmetric], insert "2.prems", auto)
     finally show ?thesis .
   next
     case False
     have "reduce_below_abs a ((x # xs) @ [m]) D A $$ (i, 0) 
       = reduce_below_abs a (xs@[m]) D (reduce_abs a x D A) $$ (i, 0)"
       by auto
     also have "... = reduce_below_abs a xs D (reduce_abs a x D A) $$ (i, 0)"
     proof (rule "2.hyps"[OF _ a j _ _ mn _ _ _ ia imm D_ge0])
       let ?A' = "mat_of_rows n (map (Matrix.row ?reduce_ax) [0..<m])"
       show "reduce_abs a x D A = ?A' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
         by (rule reduce_append_rows_eq[OF A' A_def a xm j Aaj])  
       show "i \<in> set xs" using i_set_xxs False by auto
       show "distinct xs" using d by auto
       show "\<forall>x\<in>set xs. x < m \<and> a < x" using xxs_less_m by auto
       show "reduce_abs a x D A $$ (a, 0) \<noteq> 0"
         by (rule reduce_not0[OF A _ _ j _ Aaj], insert "2.prems", auto)
       show "?A' \<in> carrier_mat m n" by auto    
     qed  
     also have "... = reduce_below_abs a (x # xs) D A $$ (i, 0)" by auto
     finally show ?thesis .
   qed
 qed
 
 
 lemma reduce_below_0_case_m:
   assumes A': "A' \<in> carrier_mat m n" and a: "a<m" and j: "0<n"
     and A_def: "A = A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
     and Aaj: "A $$ (a,0) \<noteq> 0"
     and mn: "m\<ge>n"
   assumes "i \<in> set (xs @ [m])" and "distinct xs" and "\<forall>x \<in> set xs. x < m \<and> a < x"
   and "D>0"
   shows "reduce_below a (xs @ [m]) D A $$ (i,0) = 0"
 proof (cases "i=m")
   case True
   show ?thesis by (unfold True, rule reduce_below_0_case_m1, insert assms, auto)
 next
   case False
   have "reduce_below a (xs @ [m]) D A $$ (i,0) = reduce_below a (xs) D A $$ (i,0)"
     by (rule reduce_below_preserves_case_m2[OF A' a j A_def Aaj mn], insert assms False, auto) 
   also have "... = 0" by (rule reduce_below_0, insert assms False, auto)
   finally show ?thesis .
 qed
 
 
 lemma reduce_below_abs_0_case_m:
   assumes A': "A' \<in> carrier_mat m n" and a: "a<m" and j: "0<n"
     and A_def: "A = A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
     and Aaj: "A $$ (a,0) \<noteq> 0"
     and mn: "m\<ge>n"
   assumes "i \<in> set (xs @ [m])" and "distinct xs" and "\<forall>x \<in> set xs. x < m \<and> a < x"
   and "D>0"
   shows "reduce_below_abs a (xs @ [m]) D A $$ (i,0) = 0"
 proof (cases "i=m")
   case True
   show ?thesis by (unfold True, rule reduce_below_abs_0_case_m1, insert assms, auto)
 next
   case False
   have "reduce_below_abs a (xs @ [m]) D A $$ (i,0) = reduce_below_abs a (xs) D A $$ (i,0)"
     by (rule reduce_below_abs_preserves_case_m2[OF A' a j A_def Aaj mn], insert assms False, auto) 
   also have "... = 0" by (rule reduce_below_abs_0, insert assms False, auto)
   finally show ?thesis .
 qed
 
 
 lemma reduce_below_0_case_m_complete:
   assumes A': "A' \<in> carrier_mat m n" and a: "0<m" and j: "0<n"
     and A_def: "A = A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
     and Aaj: "A $$ (0,0) \<noteq> 0"
     and mn: "m\<ge>n"
   assumes i_mn: "i < m+n" and d_xs: "distinct xs" and xs: "\<forall>x \<in> set xs. x < m \<and> 0 < x"
     and ia: "i\<noteq>0"
   and xs_def: "xs = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<dim_row A]"
   and D: "D>0"
   shows "reduce_below 0 (xs @ [m]) D A $$ (i,0) = 0"
 proof (cases "i \<in> set (xs @ [m])")
   case True
   show ?thesis by (rule reduce_below_0_case_m[OF A' a j A_def Aaj mn True d_xs xs D])
 next
   case False
   have A: "A \<in> carrier_mat (m+n) n" using A' A_def by simp
   have "reduce_below 0 (xs @ [m]) D A $$ (i,0) = A $$ (i,0)"    
     by (rule reduce_below_preserves_case_m[OF A' a j A_def Aaj mn _ _ _ _ _ _ D],
         insert i_mn d_xs xs ia False, auto) 
   also have "... = 0"  using False ia i_mn A unfolding xs_def by auto    
   finally show ?thesis .
 qed
 
 
 
 lemma reduce_below_abs_0_case_m_complete:
   assumes A': "A' \<in> carrier_mat m n" and a: "0<m" and j: "0<n"
     and A_def: "A = A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
     and Aaj: "A $$ (0,0) \<noteq> 0"
     and mn: "m\<ge>n"
   assumes i_mn: "i < m+n" and d_xs: "distinct xs" and xs: "\<forall>x \<in> set xs. x < m \<and> 0 < x"
     and ia: "i\<noteq>0"
   and xs_def: "xs = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<dim_row A]"
   and D: "D>0"
   shows "reduce_below_abs 0 (xs @ [m]) D A $$ (i,0) = 0"
 proof (cases "i \<in> set (xs @ [m])")
   case True
   show ?thesis by (rule reduce_below_abs_0_case_m[OF A' a j A_def Aaj mn True d_xs xs D])
 next
   case False
   have A: "A \<in> carrier_mat (m+n) n" using A' A_def by simp
   have "reduce_below_abs 0 (xs @ [m]) D A $$ (i,0) = A $$ (i,0)"    
     by (rule reduce_below_abs_preserves_case_m[OF A' a j A_def Aaj mn _ _ _ _ _ _ D],
         insert i_mn d_xs xs ia False, auto) 
   also have "... = 0"  using False ia i_mn A unfolding xs_def by auto    
   finally show ?thesis .
 qed
 
 
 (*Now we take care of the mth row of A*)
 lemma reduce_below_invertible_mat_case_m:
   assumes A': "A' \<in> carrier_mat m n" and a: "a<m" and n0: "0<n"
     and A_def: "A = A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
     and Aaj: "A $$ (a,0) \<noteq> 0"
     and mn: "m\<ge>n" and "distinct xs" and "\<forall>x \<in> set xs. x < m \<and> a < x" 
     and D0: "D>0"
   shows "(\<exists>P. invertible_mat P \<and> P \<in> carrier_mat (m+n) (m+n) \<and> reduce_below a (xs@[m]) D A = P * A)"
   using assms
 proof (induct a xs D A arbitrary: A' rule: reduce_below.induct)
   case (1 a D A)
   obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(m,0))"
     by (metis prod_cases5)
   have D: "D \<cdot>\<^sub>m (1\<^sub>m n) : carrier_mat n n" by auto
   note A' = "1.prems"(1)
   note a = "1.prems"(2)
   note j = "1.prems"(3)
   note A_def = "1.prems"(4)
   note Aaj = "1.prems"(5)
   note mn = "1.prems"(6)  
   note D0 = "1.prems"(9)
   have Am0_D: "A $$ (m, 0) = D"
   proof -
     have "A $$ (m, 0) = (D \<cdot>\<^sub>m (1\<^sub>m n)) $$ (m-m,0)"
       by (smt (z3) "1"(1) "1"(3) "1"(4) D append_rows_nth3 diff_is_0_eq diff_self_eq_0 less_add_same_cancel1)
     also have "... = D" by (simp add: n0)
     finally show ?thesis .
   qed
   have "reduce_below a ([]@[m]) D A = reduce a m D A" by auto
   let ?A = "Matrix.mat (dim_row A) (dim_col A) 
       (\<lambda>(i, k). if i = a then p * A $$ (a, k) + q * A $$ (m, k) else 
         if i = m then u * A $$ (a, k) + v * A $$ (m, k) else A $$ (i, k))"
   let ?xs = "[1..<n]"
   let ?ys = "[1..<n]"  
   have "\<exists>P. invertible_mat P \<and> P \<in> carrier_mat (m + n) (m + n) \<and> reduce a m D A = P * A"
     by (rule reduce_invertible_mat_case_m[OF A' D a _ A_def _ Aaj mn n0 pquvd, of ?xs _ _ ?ys],
         insert a D0 Am0_D, auto)
   then show ?case by auto
 next
   case (2 a x xs D A)
   note A' = "2.prems"(1)
   note a = "2.prems"(2)
   note n0 = "2.prems"(3)
   note A_def = "2.prems"(4)
   note Aaj = "2.prems"(5)
   note mn = "2.prems"(6)
   note d = "2.prems"(7)
   note xxs_less_m = "2.prems"(8)
   note D0 = "2.prems"(9)
   have A: "A \<in> carrier_mat (m+n) n" using A' mn A_def by auto
   have xm: "x < m"  using "2.prems" by auto
   have D1: "D \<cdot>\<^sub>m 1\<^sub>m n \<in> carrier_mat n n" by (simp add: mn)
   have Am0_D: "A $$ (m, 0) = D"
   proof -
     have "A $$ (m, 0) = (D \<cdot>\<^sub>m (1\<^sub>m n)) $$ (m-m,0)"
       by (smt (z3) "2"(2) "2"(4) "2"(5) D1 append_rows_nth3 
           cancel_comm_monoid_add_class.diff_cancel diff_is_0_eq less_add_same_cancel1)
     also have "... = D" by (simp add: n0)
     finally show ?thesis .
   qed
   obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))"
     by (metis prod_cases5)
   let ?reduce_ax = "reduce a x D A"
   have reduce_ax: "?reduce_ax \<in> carrier_mat (m + n) n"
     by (metis (no_types, lifting) "2" add.comm_neutral append_rows_def 
         carrier_matD carrier_mat_triv index_mat_four_block(2,3)
         index_one_mat(2) index_smult_mat(2) index_zero_mat(2,3) reduce_preserves_dimensions)
   have h: "(\<exists>P. invertible_mat P \<and> P \<in> carrier_mat (m + n) (m + n) 
     \<and> reduce_below a (xs@[m]) D (reduce a x D A) = P * reduce a x D A)"
   proof (rule "2.hyps"[OF _ a n0 _ _ ])
     let ?A' = "mat_of_rows n (map (Matrix.row ?reduce_ax) [0..<m])"
     show "reduce a x D A = ?A' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
       by (rule reduce_append_rows_eq[OF A' A_def a xm n0 Aaj])  
     show "reduce a x D A $$ (a, 0) \<noteq> 0"
       by (rule reduce_not0[OF A _ _ n0 _ Aaj], insert "2.prems", auto)
   qed (insert d xxs_less_m mn n0 D0, auto)
   from this obtain P where inv_P: "invertible_mat P" and P: "P \<in> carrier_mat (m + n) (m + n)"
     and rb_Pr: "reduce_below a (xs@[m]) D (reduce a x D A) = P * reduce a x D A" by blast
   have *: "reduce_below a ((x # xs)@[m]) D A = reduce_below a (xs@[m]) D (reduce a x D A)" by simp
   have "\<exists>Q. invertible_mat Q \<and> Q \<in> carrier_mat (m+n) (m+n) \<and> (reduce a x D A) = Q * A"
     by (rule reduce_invertible_mat[OF A' a n0 xm _ A_def Aaj _ mn D0], insert xxs_less_m, auto)
   from this obtain Q where inv_Q: "invertible_mat Q" and Q: "Q \<in> carrier_mat (m + n) (m + n)"
     and r_QA: "reduce a x D A = Q * A" by blast
   have "invertible_mat (P*Q)" using inv_P inv_Q P Q invertible_mult_JNF by blast
   moreover have "P * Q \<in> carrier_mat (m+n) (m+n)" using P Q by auto
   moreover have "reduce_below a ((x # xs)@[m]) D A = (P*Q) * A" 
     by (smt P Q * assoc_mult_mat carrier_matD(1) carrier_mat_triv index_mult_mat(2) 
         r_QA rb_Pr reduce_preserves_dimensions(1))
   ultimately show ?case by blast
 qed
 
 
 
 
 (*Now we take care of the mth row of A*)
 lemma reduce_below_abs_invertible_mat_case_m:
   assumes A': "A' \<in> carrier_mat m n" and a: "a<m" and n0: "0<n"
     and A_def: "A = A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
     and Aaj: "A $$ (a,0) \<noteq> 0"
     and mn: "m\<ge>n" and "distinct xs" and "\<forall>x \<in> set xs. x < m \<and> a < x" 
     and D0: "D>0"
   shows "(\<exists>P. invertible_mat P \<and> P \<in> carrier_mat (m+n) (m+n) \<and> reduce_below_abs a (xs@[m]) D A = P * A)"
   using assms
 proof (induct a xs D A arbitrary: A' rule: reduce_below_abs.induct)
   case (1 a D A)
   obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(m,0))"
     by (metis prod_cases5)
   have D: "D \<cdot>\<^sub>m (1\<^sub>m n) : carrier_mat n n" by auto
   note A' = "1.prems"(1)
   note a = "1.prems"(2)
   note j = "1.prems"(3)
   note A_def = "1.prems"(4)
   note Aaj = "1.prems"(5)
   note mn = "1.prems"(6)  
   note D0 = "1.prems"(9)
   have Am0_D: "A $$ (m, 0) = D"
   proof -
     have "A $$ (m, 0) = (D \<cdot>\<^sub>m (1\<^sub>m n)) $$ (m-m,0)"
       by (smt (z3) "1"(1) "1"(3) "1"(4) D append_rows_nth3 diff_is_0_eq diff_self_eq_0 less_add_same_cancel1)
     also have "... = D" by (simp add: n0)
     finally show ?thesis .
   qed
   have "reduce_below_abs a ([]@[m]) D A = reduce_abs a m D A" by auto
   let ?A = "Matrix.mat (dim_row A) (dim_col A) 
       (\<lambda>(i, k). if i = a then p * A $$ (a, k) + q * A $$ (m, k) else 
         if i = m then u * A $$ (a, k) + v * A $$ (m, k) else A $$ (i, k))"
   let ?xs = "filter (\<lambda>i. D < \<bar>?A $$ (a, i)\<bar>) [0..<n]"
   let ?ys = "filter (\<lambda>i. D < \<bar>?A $$ (m, i)\<bar>) [0..<n]"  
   have "\<exists>P. invertible_mat P \<and> P \<in> carrier_mat (m + n) (m + n) \<and> reduce_abs a m D A = P * A"
     by (rule reduce_abs_invertible_mat_case_m[OF A' D a _ A_def _ Aaj mn n0 pquvd, of ?xs _ _ ?ys],
         insert a D0 Am0_D, auto)
   then show ?case by auto
 next
   case (2 a x xs D A)
   note A' = "2.prems"(1)
   note a = "2.prems"(2)
   note n0 = "2.prems"(3)
   note A_def = "2.prems"(4)
   note Aaj = "2.prems"(5)
   note mn = "2.prems"(6)
   note d = "2.prems"(7)
   note xxs_less_m = "2.prems"(8)
   note D0 = "2.prems"(9)
   have A: "A \<in> carrier_mat (m+n) n" using A' mn A_def by auto
   have xm: "x < m"  using "2.prems" by auto
   have D1: "D \<cdot>\<^sub>m 1\<^sub>m n \<in> carrier_mat n n" by (simp add: mn)
   have Am0_D: "A $$ (m, 0) = D"
   proof -
     have "A $$ (m, 0) = (D \<cdot>\<^sub>m (1\<^sub>m n)) $$ (m-m,0)"
       by (smt (z3) "2"(2) "2"(4) "2"(5) D1 append_rows_nth3 
           cancel_comm_monoid_add_class.diff_cancel diff_is_0_eq less_add_same_cancel1)
     also have "... = D" by (simp add: n0)
     finally show ?thesis .
   qed
   obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))"
     by (metis prod_cases5)
   let ?reduce_ax = "reduce_abs a x D A"
   have reduce_ax: "?reduce_ax \<in> carrier_mat (m + n) n"
     by (metis (no_types, lifting) "2" add.comm_neutral append_rows_def 
         carrier_matD carrier_mat_triv index_mat_four_block(2,3)
         index_one_mat(2) index_smult_mat(2) index_zero_mat(2,3) reduce_preserves_dimensions)
   have h: "(\<exists>P. invertible_mat P \<and> P \<in> carrier_mat (m + n) (m + n) 
     \<and> reduce_below_abs a (xs@[m]) D (reduce_abs a x D A) = P * reduce_abs a x D A)"
   proof (rule "2.hyps"[OF _ a n0 _ _ ])
     let ?A' = "mat_of_rows n (map (Matrix.row ?reduce_ax) [0..<m])"
     show "reduce_abs a x D A = ?A' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
       by (rule reduce_append_rows_eq[OF A' A_def a xm n0 Aaj])  
     show "reduce_abs a x D A $$ (a, 0) \<noteq> 0"
       by (rule reduce_not0[OF A _ _ n0 _ Aaj], insert "2.prems", auto)
   qed (insert d xxs_less_m mn n0 D0, auto)
   from this obtain P where inv_P: "invertible_mat P" and P: "P \<in> carrier_mat (m + n) (m + n)"
     and rb_Pr: "reduce_below_abs a (xs@[m]) D (reduce_abs a x D A) = P * reduce_abs a x D A" by blast
   have *: "reduce_below_abs a ((x # xs)@[m]) D A = reduce_below_abs a (xs@[m]) D (reduce_abs a x D A)" by simp
   have "\<exists>Q. invertible_mat Q \<and> Q \<in> carrier_mat (m+n) (m+n) \<and> (reduce_abs a x D A) = Q * A"
     by (rule reduce_abs_invertible_mat[OF A' a n0 xm _ A_def Aaj _ mn D0], insert xxs_less_m, auto)
   from this obtain Q where inv_Q: "invertible_mat Q" and Q: "Q \<in> carrier_mat (m + n) (m + n)"
     and r_QA: "reduce_abs a x D A = Q * A" by blast
   have "invertible_mat (P*Q)" using inv_P inv_Q P Q invertible_mult_JNF by blast
   moreover have "P * Q \<in> carrier_mat (m+n) (m+n)" using P Q by auto
   moreover have "reduce_below_abs a ((x # xs)@[m]) D A = (P*Q) * A" 
     by (smt P Q * assoc_mult_mat carrier_matD(1) carrier_mat_triv index_mult_mat(2) 
         r_QA rb_Pr reduce_preserves_dimensions(3))
   ultimately show ?case by blast
 qed
 
 end
 
 hide_const (open) C
 
 text \<open>This lemma will be very important, since it will allow us to prove that the output
 matrix is in echelon form.\<close>
 
 lemma echelon_form_four_block_mat:
   assumes A: "A \<in> carrier_mat 1 1"
   and B: "B \<in> carrier_mat 1 (n-1)"
   and D: "D \<in> carrier_mat (m-1) (n-1)"
   and H_def: "H = four_block_mat A B (0\<^sub>m (m-1) 1) D"
   and A00: "A $$ (0,0) \<noteq> 0"
   and e_D: "echelon_form_JNF D"
   and m: "m>0" and n: "n>0"
 shows "echelon_form_JNF H"
 proof (rule echelon_form_JNF_intro)
   have H: "H \<in> carrier_mat m n"
     by (metis H_def Num.numeral_nat(7) A D m n carrier_matD carrier_mat_triv
         index_mat_four_block(2,3) linordered_semidom_class.add_diff_inverse not_less_eq)
   have Hij_Dij: "H $$ (i+1,j+1) = D $$ (i,j)" if i: "i<m-1" and j: "j<n-1" for i j
   proof -
     have "H $$ (i+1,j+1) =  (if (i+1) < dim_row A then if (j+1) < dim_col A then A $$ ((i+1), (j+1)) 
     else B $$ ((i+1), (j+1) - dim_col A) else if (j+1) < dim_col A then 
     (0\<^sub>m (m-1) 1) $$ ((i+1) - dim_row A, (j+1)) else D $$ ((i+1) - dim_row A, (j+1) - dim_col A))"
       unfolding H_def by (rule index_mat_four_block, insert A D i j, auto)
     also have "... = D $$ ((i+1) - dim_row A, (j+1) - dim_col A)" using A D i j B m n by auto
     also have "... = D $$ (i,j)" using A by auto
     finally show ?thesis .
   qed
   have Hij_Dij':  "H $$ (i,j) = D $$ (i-1,j-1)" 
     if i: "i<m" and j: "j<n" and i0: "i>0" and j0: "j>0" for i j
     by (metis (no_types, lifting) H H_def Num.numeral_nat(7) A carrier_matD 
         index_mat_four_block less_Suc0 less_not_refl3 i j i0 j0)
   have Hi0: "H$$(i,0) = 0" if i: "i\<in>{1..<m}" for i
   proof -
     have "H $$ (i,0) =  (if i < dim_row A then if 0 < dim_col A then A $$ (i, 0) 
       else B $$ (i, 0 - dim_col A) else if 0 < dim_col A then 
       (0\<^sub>m (m-1) 1) $$ (i - dim_row A, 0) else D $$ (i - dim_row A, 0 - dim_col A))"
       unfolding H_def by (rule index_mat_four_block, insert A D i, auto)
     also have "... = (0\<^sub>m (m-1) 1) $$ (i - dim_row A, 0)" using A D i m n by auto
     also have "... = 0" using i A n by auto
     finally show ?thesis .
   qed
   have A00_H00: "A $$ (0,0) = H $$ (0,0)" unfolding H_def using A by auto
   have "is_zero_row_JNF j H" if zero_iH: "is_zero_row_JNF i H" and ij: "i < j" and j: "j < dim_row H"
     for i j 
   proof -
     have "\<not> is_zero_row_JNF 0 H" unfolding is_zero_row_JNF_def using m n H A00 A00_H00 by auto
     hence i_not0: "i\<noteq>0" using zero_iH by meson
     have "is_zero_row_JNF (i-1) D" using zero_iH i_not0 Hij_Dij m n D H unfolding is_zero_row_JNF_def
       by (auto, smt (z3) Suc_leI carrier_matD(1) le_add_diff_inverse2 Hij_Dij One_nat_def Suc_pred carrier_matD(1) j le_add_diff_inverse2
           less_diff_conv less_imp_add_positive plus_1_eq_Suc that(2) trans_less_add1)
     hence "is_zero_row_JNF (j-1) D" using ij e_D D j m i_not0 unfolding echelon_form_JNF_def
       by (auto, smt H Nat.lessE Suc_pred carrier_matD(1) diff_Suc_1 diff_Suc_less order.strict_trans)
     thus ?thesis
       by (smt A H H_def Hi0 D atLeastLessThan_iff carrier_matD index_mat_four_block(1)
           is_zero_row_JNF_def le_add1 less_one linordered_semidom_class.add_diff_inverse not_less_eq
           plus_1_eq_Suc ij j zero_order(3))
   qed
   thus "\<forall>i<dim_row H. is_zero_row_JNF i H \<longrightarrow> \<not> (\<exists>j<dim_row H. i < j \<and> \<not> is_zero_row_JNF j H)"
     by blast
   have "(LEAST n. H $$ (i, n) \<noteq> 0) < (LEAST n. H $$ (j, n) \<noteq> 0)"
     if ij: "i < j" and j: "j < dim_row H" and not_zero_iH: "\<not> is_zero_row_JNF i H" 
     and not_zero_jH: "\<not> is_zero_row_JNF j H" for i j
   proof (cases "i = 0")
     case True
     have "(LEAST n. H $$ (i, n) \<noteq> 0) = 0" unfolding True using A00_H00 A00 by auto
     then show ?thesis
       by (metis (mono_tags) H Hi0 LeastI True atLeastLessThan_iff carrier_matD(1) 
           is_zero_row_JNF_def leI less_one not_gr0 ij j not_zero_jH)
   next
     case False note i_not0 = False
     let ?least_H = "(LEAST n. H $$ (i, n) \<noteq> 0)"
     let ?least_Hj = "(LEAST n. H $$ (j, n) \<noteq> 0)"
 
     have least_not0: "(LEAST n. H $$ (i, n) \<noteq> 0) \<noteq> 0" 
     proof -
-      have "\<exists>n. H $$ (i, n) \<noteq> 0 \<and> H $$ (i, 0) = 0"
-        by (metis (no_types) False H Hi0 Num.numeral_nat(7) atLeastLessThan_iff carrier_matD(1)
-            is_zero_row_JNF_def j nat_LEAST_True nat_neq_iff not_less_Least not_less_eq order.strict_trans
-            ij not_zero_iH wellorder_Least_lemma(1) wellorder_Least_lemma(2))
-      then show ?thesis
-        by (metis (mono_tags, lifting) LeastI_ex)
+      have \<open>dim_row H = m\<close>
+        using H by auto
+      with \<open>i < j\<close> \<open>j < dim_row H\<close> have \<open>i < m\<close>
+        by simp
+      then have \<open>H $$ (i, 0) = 0\<close>
+        using i_not0 by (auto simp add: Suc_le_eq intro: Hi0)
+      moreover from is_zero_row_JNF_def [of i H] not_zero_iH
+      obtain n where \<open>H $$ (i, n) \<noteq> 0\<close>
+        by blast
+      ultimately show ?thesis
+        by (metis (mono_tags, lifting) LeastI)
     qed
     have least_not0j: "(LEAST n. H $$ (j, n) \<noteq> 0) \<noteq> 0"
     proof -
       have "\<exists>n. H $$ (j, 0) = 0 \<and> H $$ (j, n) \<noteq> 0"
         by (metis (no_types) H Hi0 LeastI_ex Num.numeral_nat(7) atLeastLessThan_iff carrier_matD(1)
             is_zero_row_JNF_def linorder_neqE_nat not_gr0 not_less_Least not_less_eq order_trans_rules(19)
             ij j not_zero_jH wellorder_Least_lemma(2))
       then show ?thesis
         by (metis (mono_tags, lifting) LeastI_ex)
     qed
     have least_n: "?least_H<n"
       by (smt H carrier_matD(2) dual_order.strict_trans is_zero_row_JNF_def 
           not_less_Least not_less_iff_gr_or_eq not_zero_iH)
     have Hil: "H $$ (i,?least_H) \<noteq> 0" and ln':"(\<forall>n'. (H $$ (i, n') \<noteq> 0) \<longrightarrow> ?least_H \<le> n')" 
       by (metis (mono_tags, lifting) is_zero_row_JNF_def that(3) wellorder_Least_lemma)+
     have Hil_Dil: "H $$ (i,?least_H) = D $$ (i-1,?least_H - 1)"      
     proof -
       have "H $$ (i,?least_H) = (if i < dim_row A then if ?least_H < dim_col A then A $$ (i, ?least_H) 
       else B $$ (i, ?least_H - dim_col A) else if ?least_H < dim_col A then 
       (0\<^sub>m (m-1) 1) $$ (i - dim_row A, ?least_H) else D $$ (i - dim_row A, ?least_H - dim_col A))"
         unfolding H_def
         by (rule index_mat_four_block, insert False j ij H A D n least_n, auto simp add: H_def)
       also have "... = D $$ (i - 1, ?least_H - 1)"
         using False j ij H A D n least_n B Hi0 Hil by auto
       finally show ?thesis .
     qed
     have not_zero_iD: "\<not> is_zero_row_JNF (i-1) D" 
       by (metis (no_types, lifting) Hil Hil_Dil D carrier_matD(2) is_zero_row_JNF_def le_add1 
           le_add_diff_inverse2 least_n least_not0 less_diff_conv less_one
           linordered_semidom_class.add_diff_inverse)
     have not_zero_jD: "\<not> is_zero_row_JNF (j-1) D"
       by (smt H Hij_Dij' One_nat_def Suc_pred D m carrier_matD diff_Suc_1 ij is_zero_row_JNF_def j
           least_not0j less_Suc0 less_Suc_eq_0_disj less_one neq0_conv not_less_Least not_less_eq
           plus_1_eq_Suc not_zero_jH zero_order(3))
     have "?least_H - 1 = (LEAST n. D $$ (i-1, n) \<noteq> 0 \<and> n<dim_col D)"
     proof (rule Least_equality[symmetric], rule)
       show "D $$ (i - 1, ?least_H - 1) \<noteq> 0" using Hil Hil_Dil by auto
       show "(LEAST n. H $$ (i, n) \<noteq> 0) - 1 < dim_col D" using least_n least_not0 H D n by auto
       fix n' assume "D $$ (i - 1, n') \<noteq> 0 \<and> n' < dim_col D" 
       hence Di1n'1: "D $$ (i - 1, n') \<noteq> 0" and n': "n' < dim_col D" by auto
       have "(LEAST n. H $$ (i, n) \<noteq> 0) \<le> n' + 1"
       proof (rule Least_le)
         have "H $$ (i, n'+1) = D $$ (i -1, (n'+1)-1)"
           by (rule Hij_Dij', insert i_not0 False H A ij j n' D, auto)
         thus Hin': "H $$ (i, n'+1) \<noteq> 0" using False Di1n'1 Hij_Dij' by auto
       qed
       thus  "(LEAST n. H $$ (i, n) \<noteq> 0) -1 \<le> n'" using least_not0 by auto
     qed
     also have "... = (LEAST n. D $$ (i-1, n) \<noteq> 0)"
     proof (rule Least_equality)
       have "D $$ (i - 1, LEAST n. D $$ (i - 1, n) \<noteq> 0) \<noteq> 0" 
         by (metis (mono_tags, lifting) Hil Hil_Dil LeastI_ex)
       moreover have leastD: "(LEAST n. D $$ (i - 1, n) \<noteq> 0) < dim_col D"
         by (smt dual_order.strict_trans is_zero_row_JNF_def linorder_neqE_nat
             not_less_Least not_zero_iD) 
       ultimately show "D $$ (i - 1, LEAST n. D $$ (i - 1, n) \<noteq> 0) \<noteq> 0 
         \<and> (LEAST n. D $$ (i - 1, n) \<noteq> 0) < dim_col D" by simp  
       fix y assume "D $$ (i - 1, y) \<noteq> 0 \<and> y < dim_col D" 
       thus "(LEAST n. D $$ (i - 1, n) \<noteq> 0) \<le> y" by (meson wellorder_Least_lemma(2))
     qed
     finally have leastHi_eq: "?least_H - 1 = (LEAST n. D $$ (i-1, n) \<noteq> 0)" .
     have least_nj: "?least_Hj<n"
       by (smt H carrier_matD(2) dual_order.strict_trans is_zero_row_JNF_def 
           not_less_Least not_less_iff_gr_or_eq not_zero_jH)
     have Hjl: "H $$ (j,?least_Hj) \<noteq> 0" and ln':"(\<forall>n'. (H $$ (j, n') \<noteq> 0) \<longrightarrow> ?least_Hj \<le> n')" 
       by (metis (mono_tags, lifting) is_zero_row_JNF_def not_zero_jH wellorder_Least_lemma)+
     have Hjl_Djl: "H $$ (j,?least_Hj) = D $$ (j-1,?least_Hj - 1)"      
     proof -
       have "H $$ (j,?least_Hj) = (if j < dim_row A then if ?least_Hj < dim_col A then A $$ (j, ?least_Hj) 
       else B $$ (j, ?least_Hj - dim_col A) else if ?least_Hj < dim_col A then 
       (0\<^sub>m (m-1) 1) $$ (j - dim_row A, ?least_Hj) else D $$ (j - dim_row A, ?least_Hj - dim_col A))"
         unfolding H_def
         by (rule index_mat_four_block, insert False j ij H A D n least_nj, auto simp add: H_def)
       also have "... = D $$ (j - 1, ?least_Hj - 1)"
         using False j ij H A D n least_n B Hi0 Hjl by auto
       finally show ?thesis .
     qed
     have "(LEAST n. H $$ (j, n) \<noteq> 0) - 1 = (LEAST n. D $$ (j-1, n) \<noteq> 0 \<and> n<dim_col D)"
     proof (rule Least_equality[symmetric], rule)
       show "D $$ (j - 1, ?least_Hj - 1) \<noteq> 0" using Hil Hil_Dil
         by (smt H Hij_Dij' LeastI_ex carrier_matD is_zero_row_JNF_def j least_not0j 
             linorder_neqE_nat not_gr0 not_less_Least order.strict_trans ij not_zero_jH)
       show "(LEAST n. H $$ (j, n) \<noteq> 0) - 1 < dim_col D" using least_nj least_not0j H D n by auto
       fix n' assume "D $$ (j - 1, n') \<noteq> 0 \<and> n' < dim_col D" 
       hence Di1n'1: "D $$ (j - 1, n') \<noteq> 0" and n': "n' < dim_col D" by auto
       have "(LEAST n. H $$ (j, n) \<noteq> 0) \<le> n' + 1"
       proof (rule Least_le)
         have "H $$ (j, n'+1) = D $$ (j -1, (n'+1)-1)"
           by (rule Hij_Dij', insert i_not0 False H A ij j n' D, auto)
         thus Hin': "H $$ (j, n'+1) \<noteq> 0" using False Di1n'1 Hij_Dij' by auto
       qed
       thus  "(LEAST n. H $$ (j, n) \<noteq> 0) -1 \<le> n'" using least_not0 by auto
     qed
     also have "... = (LEAST n. D $$ (j-1, n) \<noteq> 0)"
     proof (rule Least_equality)
       have "D $$ (j - 1, LEAST n. D $$ (j - 1, n) \<noteq> 0) \<noteq> 0" 
         by (metis (mono_tags, lifting) Hjl Hjl_Djl LeastI_ex)
       moreover have leastD: "(LEAST n. D $$ (j - 1, n) \<noteq> 0) < dim_col D"
         by (smt dual_order.strict_trans is_zero_row_JNF_def linorder_neqE_nat
             not_less_Least not_zero_jD) 
       ultimately show "D $$ (j - 1, LEAST n. D $$ (j - 1, n) \<noteq> 0) \<noteq> 0 
         \<and> (LEAST n. D $$ (j - 1, n) \<noteq> 0) < dim_col D" by simp  
       fix y assume "D $$ (j - 1, y) \<noteq> 0 \<and> y < dim_col D" 
       thus "(LEAST n. D $$ (j - 1, n) \<noteq> 0) \<le> y" by (meson wellorder_Least_lemma(2))
     qed
     finally have leastHj_eq: "(LEAST n. H $$ (j, n) \<noteq> 0) - 1 = (LEAST n. D $$ (j-1, n) \<noteq> 0)" .
     have ij': "i-1 < j-1" using ij False by auto
     have "j-1 < dim_row D "  using D H ij j by auto
     hence "(LEAST n. D $$ (i-1, n) \<noteq> 0) < (LEAST n. D $$ (j-1, n) \<noteq> 0)" 
       using e_D echelon_form_JNF_def ij' not_zero_jD order.strict_trans by blast    
     thus ?thesis using leastHj_eq leastHi_eq by auto
   qed
   thus "\<forall>i j. i < j \<and> j < dim_row H \<and> \<not> is_zero_row_JNF i H \<and> \<not> is_zero_row_JNF j H 
   \<longrightarrow> (LEAST n. H $$ (i, n) \<noteq> 0) < (LEAST n. H $$ (j, n) \<noteq> 0)" by blast    
 qed
 
 context mod_operation
 begin
 
 
 lemma reduce_below:
   assumes "A \<in> carrier_mat m n"
   shows "reduce_below a xs D A \<in> carrier_mat m n" 
   using assms 
   by (induct a xs D A rule: reduce_below.induct, auto simp add: Let_def euclid_ext2_def) 
 
 lemma reduce_below_preserves_dimensions:
  shows [simp]: "dim_row (reduce_below a xs D A) = dim_row A" 
     and [simp]: "dim_col (reduce_below a xs D A) = dim_col A"
   using reduce_below[of A "dim_row A" "dim_col A"] by auto
 
 
 lemma reduce_below_abs:
   assumes "A \<in> carrier_mat m n"
   shows "reduce_below_abs a xs D A \<in> carrier_mat m n" 
   using assms 
   by (induct a xs D A rule: reduce_below_abs.induct, auto simp add: Let_def euclid_ext2_def) 
 
 lemma reduce_below_abs_preserves_dimensions:
  shows [simp]: "dim_row (reduce_below_abs a xs D A) = dim_row A" 
     and [simp]: "dim_col (reduce_below_abs a xs D A) = dim_col A"
   using reduce_below_abs[of A "dim_row A" "dim_col A"] by auto
 
 
 lemma FindPreHNF_1xn:
  assumes A: "A \<in> carrier_mat m n" and "m<2 \<or> n = 0"
  shows "FindPreHNF abs_flag D A \<in> carrier_mat m n" using assms by auto
 
 lemma FindPreHNF_mx1:
  assumes A: "A \<in> carrier_mat m n" and "m\<ge>2" and "n \<noteq> 0" "n<2"
  shows "FindPreHNF abs_flag D A \<in> carrier_mat m n"
 proof (cases "abs_flag")
   case True
   let ?nz = "(filter (\<lambda>i. A $$ (i, 0) \<noteq> 0) [1..<m])"
   have "FindPreHNF abs_flag D A =  (let non_zero_positions = filter (\<lambda>i. A $$ (i, 0) \<noteq> 0) [Suc 0..<m]
      in reduce_below_abs 0 non_zero_positions D (if A $$ (0, 0) \<noteq> 0 then A else 
   let i = non_zero_positions ! 0 in swaprows 0 i A))" 
     using assms True by auto
   also have "... =  reduce_below_abs 0 ?nz D (if A $$ (0, 0) \<noteq> 0 then A 
   else let i = ?nz ! 0 in swaprows 0 i A)" unfolding Let_def by auto
   also have "... \<in> carrier_mat m n" using A by auto
   finally show ?thesis .  
 next
   case False
   let ?nz = "(filter (\<lambda>i. A $$ (i, 0) \<noteq> 0) [1..<m])"
   have "FindPreHNF abs_flag D A =  (let non_zero_positions = filter (\<lambda>i. A $$ (i, 0) \<noteq> 0) [Suc 0..<m]
      in reduce_below 0 non_zero_positions D (if A $$ (0, 0) \<noteq> 0 then A else 
   let i = non_zero_positions ! 0 in swaprows 0 i A))" 
     using assms False by auto
   also have "... =  reduce_below 0 ?nz D (if A $$ (0, 0) \<noteq> 0 then A 
   else let i = ?nz ! 0 in swaprows 0 i A)" unfolding Let_def by auto
   also have "... \<in> carrier_mat m n" using A by auto
   finally show ?thesis .
 qed
   
 
 lemma FindPreHNF_mxn2:
  assumes A: "A \<in> carrier_mat m n" and m: "m\<ge>2" and n: "n\<ge>2"
  shows "FindPreHNF abs_flag D A \<in> carrier_mat m n" 
 using assms
 proof (induct abs_flag D A arbitrary: m n rule: FindPreHNF.induct)
   case (1 abs_flag D A)
   note A = "1.prems"(1)
   note m = "1.prems"(2)
   note n = "1.prems"(3)
   define non_zero_positions where "non_zero_positions = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<dim_row A]"
   define A' where "A' = (if A $$ (0, 0) \<noteq> 0 then A else let i = non_zero_positions ! 0 in swaprows 0 i A)"
   define Reduce where [simp]: "Reduce = (if abs_flag then reduce_below_abs else reduce_below)"
   obtain A'_UL A'_UR A'_DL A'_DR where A'_split: "(A'_UL, A'_UR, A'_DL, A'_DR) 
     = split_block (Reduce 0 non_zero_positions D (make_first_column_positive A')) 1 1"     
     by (metis prod_cases4)
   define sub_PreHNF where "sub_PreHNF = FindPreHNF abs_flag D A'_DR"
   have A': "A' \<in> carrier_mat m n" unfolding A'_def using A by auto
   have A'_DR: "A'_DR \<in> carrier_mat (m -1) (n-1)"
     by (cases abs_flag; rule split_block(4)[OF A'_split[symmetric]], insert Reduce_def A A' m n, auto)
   have sub_PreHNF: "sub_PreHNF \<in> carrier_mat (m - 1) (n-1)"
   proof (cases "m-1<2")
     case True
     show ?thesis using A'_DR True unfolding sub_PreHNF_def by auto
   next
     case False note m' = False
     show ?thesis
     proof (cases "n-1<2")
       case True
       show ?thesis 
         unfolding sub_PreHNF_def by (rule FindPreHNF_mx1[OF A'_DR _ _ True], insert n m', auto)
     next
       case False
       show ?thesis
         by (unfold sub_PreHNF_def, rule "1.hyps"
             [of m n, OF _ _ _ non_zero_positions_def A'_def Reduce_def _ A'_split _ _ _ A'_DR],
             insert A False n m' Reduce_def, auto)
     qed  
   qed      
   have A'_UL: "A'_UL \<in> carrier_mat 1 1"
     by (cases abs_flag; rule split_block(1)[OF A'_split[symmetric], of "m-1" "n-1"], insert n m A', auto) 
   have A'_UR: "A'_UR \<in> carrier_mat 1 (n-1)"
     by (cases abs_flag; rule split_block(2)[OF A'_split[symmetric], of "m-1"], insert n m A', auto)
   have A'_DL: "A'_DL \<in> carrier_mat (m - 1) 1"
      by (cases abs_flag; rule split_block(3)[OF A'_split[symmetric], of _ "n-1"], insert n m A', auto)
   have *: "(dim_col A = 0) = False" using 1(2-) by auto
   have FindPreHNF_as_fbm: "FindPreHNF abs_flag D A = four_block_mat A'_UL A'_UR A'_DL sub_PreHNF" 
     unfolding FindPreHNF.simps[of abs_flag D A] using A'_split m n A
     unfolding Let_def sub_PreHNF_def  A'_def non_zero_positions_def * 
     apply (cases abs_flag)
     by (smt (z3) Reduce_def carrier_matD(1) carrier_matD(2) linorder_not_less prod.simps(2))+
   also have "... \<in> carrier_mat m n"
     by (smt m A'_UL One_nat_def add.commute carrier_matD carrier_mat_triv index_mat_four_block(2,3) 
         le_add_diff_inverse2 le_eq_less_or_eq lessI n nat_SN.compat numerals(2) sub_PreHNF)  
   finally show ?case .
 qed
 
 
 lemma FindPreHNF:
  assumes A: "A \<in> carrier_mat m n"
  shows "FindPreHNF abs_flag D A \<in> carrier_mat m n" 
   using assms FindPreHNF_mxn2[OF A] FindPreHNF_mx1[OF A] FindPreHNF_1xn[OF A]
   using linorder_not_less by blast
 end
 
 lemma make_first_column_positive_append_id:
  assumes A': "A' \<in> carrier_mat m n"
     and A_def: "A = A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
   and D0: "D>0"
   and n0: "0<n"
   shows "make_first_column_positive A 
   = mat_of_rows n (map (Matrix.row (make_first_column_positive A)) [0..<m]) @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
 proof (rule matrix_append_rows_eq_if_preserves)
   have A: "A \<in> carrier_mat (m+n) n" using A' A_def by auto
   thus "make_first_column_positive A \<in> carrier_mat (m + n) n" by auto
   have "make_first_column_positive A $$ (i, j) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i - m, j)"
     if j: "j<n" and i: "i \<in> {m..<m + n}" for i j
   proof -
     have i_mn: "i<m+n" using i by auto
     have "A $$ (i,0) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i - m, 0)" unfolding A_def
       by (smt A append_rows_def assms(1) assms(2) atLeastLessThan_iff carrier_matD 
           index_mat_four_block less_irrefl_nat nat_SN.compat j i n0)
     also have "... \<ge> 0" using D0 mult_not_zero that(2) by auto
     finally have Ai0: "A$$(i,0)\<ge>0" .
     have "make_first_column_positive A $$ (i, j) = A$$(i,j)"
       using make_first_column_positive_works[OF A i_mn n0] j Ai0 by auto
     also have "... = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i - m, j)" unfolding A_def
       by (smt A append_rows_def A' A_def atLeastLessThan_iff carrier_matD 
           index_mat_four_block less_irrefl_nat nat_SN.compat i j)
     finally show ?thesis .
   qed
   thus "\<forall>i\<in>{m..<m + n}. \<forall>j<n. make_first_column_positive A $$ (i, j) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i - m, j)"
     by simp
 qed (auto)
 
 
 lemma A'_swaprows_invertible_mat:
   fixes A::"int mat"
   assumes A: "A\<in>carrier_mat m n"
   assumes A'_def: "A' = (if A $$ (0, 0) \<noteq> 0 then A else let i = non_zero_positions ! 0 in swaprows 0 i A)"
   and nz_def: "non_zero_positions = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<dim_row A]"
   and nz_empty: "A$$(0,0) =0 \<Longrightarrow> non_zero_positions \<noteq> []"
   and m0: "0<m"
 shows "\<exists>P. P \<in> carrier_mat m m \<and> invertible_mat P \<and> A' = P * A"
 proof (cases "A$$(0,0) \<noteq> 0")
   case True
   then show ?thesis
     by (metis A A'_def invertible_mat_one left_mult_one_mat one_carrier_mat)
 next
   case False
   have nz_empty: "non_zero_positions \<noteq> []" using nz_empty False by simp
   let ?i = "non_zero_positions ! 0"
   let ?M = "(swaprows_mat m 0 ?i) :: int mat"
   have i_set_nz: "?i \<in> set (non_zero_positions)" using nz_empty by auto
   have im: "?i < m" using A nz_def i_set_nz by auto
   have i_not0: "?i \<noteq> 0" using A nz_def i_set_nz by auto
   have "A' = swaprows 0 ?i A" using False A'_def by simp
   also have "... = ?M * A"
     by (rule swaprows_mat[OF A], insert nz_def nz_empty False A m0 im, auto) 
   finally have 1: "A' = ?M * A" .
   have 2: "?M \<in> carrier_mat m m" by auto
   have "Determinant.det ?M = - 1"
     by (rule det_swaprows_mat[OF m0 im i_not0[symmetric]])
   hence 3: "invertible_mat ?M" using invertible_iff_is_unit_JNF[OF 2] by auto  
   show ?thesis using 1 2 3 by blast
 qed
 
 lemma swaprows_append_id:
  assumes A': "A' \<in> carrier_mat m n"
     and A_def: "A = A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
   and i:"i<m"
   shows "swaprows 0 i A 
   = mat_of_rows n (map (Matrix.row (swaprows 0 i A)) [0..<m]) @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
 proof (rule matrix_append_rows_eq_if_preserves)
   have A: "A \<in> carrier_mat (m+n) n" using A' A_def by auto
   show swap: "swaprows 0 i A \<in> carrier_mat (m + n) n" by (simp add: A)
   have "swaprows 0 i A $$ (ia, j) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (ia - m, j)"
     if ia: "ia \<in> {m..<m + n}" and j: "j<n" for ia j
   proof -
     have "swaprows 0 i A $$ (ia, j) = A $$ (ia,j)" using i ia j A by auto
     also have "... = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (ia - m, j)" 
       by (smt A append_rows_def A' A_def atLeastLessThan_iff carrier_matD 
           index_mat_four_block less_irrefl_nat nat_SN.compat ia j)
     finally show "swaprows 0 i A $$ (ia, j) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (ia - m, j)" .
   qed
   thus "\<forall>ia\<in>{m..<m + n}. \<forall>j<n. swaprows 0 i A $$ (ia, j) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (ia - m, j)" by simp
 qed (simp)
 
 
 
 lemma non_zero_positions_xs_m:
   fixes A::"'a::comm_ring_1 mat"
   assumes A_def: "A = A' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
   and A': "A' \<in> carrier_mat m n" 
   and nz_def: "non_zero_positions = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<dim_row A]"
   and m0: "0<m" and n0: "0<n"
   and D0: "D \<noteq> 0"
 shows "\<exists>xs. non_zero_positions = xs @ [m] \<and> distinct xs \<and> (\<forall>x\<in>set xs. x < m \<and> 0 < x)"
 proof -  
   have A: "A \<in> carrier_mat (m+n) n" using A' A_def by auto
   let ?xs = "filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<m]"
   have l_rw: "[1..<dim_row A] = [1..<m+1]@[m+1..<dim_row A]" using A m0 n0
     by (auto, metis Suc_leI less_add_same_cancel1 upt_add_eq_append upt_conv_Cons)
   have f0: "filter (\<lambda>i. A $$ (i,0) \<noteq> 0) ([m+1..<dim_row A]) = []"
   proof (rule filter_False) 
     have "A $$ (i,0) = 0" if i: "i\<in>set [m + 1..<dim_row A]" for i
     proof -
       have "A $$ (i,0) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i-m,0)"
         by (rule append_rows_nth3[OF A' _ A_def _ _ n0], insert i A, auto)
       also have "... = 0" using i A by auto
       finally show ?thesis .        
     qed
     thus "\<forall>x\<in>set [m + 1..<dim_row A]. \<not> A $$ (x, 0) \<noteq> 0" by blast
   qed
   have fm: "filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [m] = [m]"
   proof -
     have "A $$ (m, 0) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (m-m,0)"
       by (rule append_rows_nth3[OF A' _ A_def _ _ n0], insert n0, auto)
     also have "... = D" using m0 n0 by auto
     finally show ?thesis using D0 by auto
   qed
   have "non_zero_positions = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) ([1..<m+1]@[m+1..<dim_row A])"
     using nz_def l_rw by auto
   also have "... = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<m+1] @ filter (\<lambda>i. A $$ (i,0) \<noteq> 0) ([m+1..<dim_row A])"
     by auto
   also have "... = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<m+1]" using f0 by auto
   also have "... = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) ([1..<m]@[m])" using m0 by auto
   also have "... = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<m] @ [m]" using fm by auto
   finally have "non_zero_positions = ?xs @ [m]" .
   moreover have "distinct ?xs" by auto
   moreover have "(\<forall>x\<in>set ?xs. x < m \<and> 0 < x)" by auto
   ultimately show ?thesis by blast
 qed
 
 
 
 
 lemma non_zero_positions_xs_m':
   fixes A::"'a::comm_ring_1 mat"
   assumes A_def: "A = A' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
   and A': "A' \<in> carrier_mat m n" 
   and nz_def: "non_zero_positions = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<dim_row A]"
   and m0: "0<m" and n0: "0<n"
   and D0: "D \<noteq> 0"
 shows "non_zero_positions = (filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<m]) @ [m] 
   \<and> distinct (filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<m]) 
   \<and> (\<forall>x\<in>set (filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<m]). x < m \<and> 0 < x)"
 proof -  
   have A: "A \<in> carrier_mat (m+n) n" using A' A_def by auto
   let ?xs = "filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<m]"
   have l_rw: "[1..<dim_row A] = [1..<m+1]@[m+1..<dim_row A]" using A m0 n0
     by (auto, metis Suc_leI less_add_same_cancel1 upt_add_eq_append upt_conv_Cons)
   have f0: "filter (\<lambda>i. A $$ (i,0) \<noteq> 0) ([m+1..<dim_row A]) = []"
   proof (rule filter_False) 
     have "A $$ (i,0) = 0" if i: "i\<in>set [m + 1..<dim_row A]" for i
     proof -
       have "A $$ (i,0) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i-m,0)"
         by (rule append_rows_nth3[OF A' _ A_def _ _ n0], insert i A, auto)
       also have "... = 0" using i A by auto
       finally show ?thesis .        
     qed
     thus "\<forall>x\<in>set [m + 1..<dim_row A]. \<not> A $$ (x, 0) \<noteq> 0" by blast
   qed
   have fm: "filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [m] = [m]"
   proof -
     have "A $$ (m, 0) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (m-m,0)"
       by (rule append_rows_nth3[OF A' _ A_def _ _ n0], insert n0, auto)
     also have "... = D" using m0 n0 by auto
     finally show ?thesis using D0 by auto
   qed
   have "non_zero_positions = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) ([1..<m+1]@[m+1..<dim_row A])"
     using nz_def l_rw by auto
   also have "... = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<m+1] @ filter (\<lambda>i. A $$ (i,0) \<noteq> 0) ([m+1..<dim_row A])"
     by auto
   also have "... = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<m+1]" using f0 by auto
   also have "... = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) ([1..<m]@[m])" using m0 by auto
   also have "... = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<m] @ [m]" using fm by auto
   finally have "non_zero_positions = ?xs @ [m]" .
   moreover have "distinct ?xs" by auto
   moreover have "(\<forall>x\<in>set ?xs. x < m \<and> 0 < x)" by auto
   ultimately show ?thesis by blast
 qed
 
 lemma A_A'D_eq_first_n_rows:
  assumes A_def: "A = A' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
   and A': "A' \<in> carrier_mat m n" 
   and mn: "m\<ge>n"
 shows "(mat_of_rows n (map (Matrix.row A') [0..<n])) 
   = (mat_of_rows n (map (Matrix.row A) [0..<n]))" (is "?lhs = ?rhs")
 proof (rule eq_matI) 
   show dr: "dim_row ?lhs = dim_row ?rhs" and dc: "dim_col ?lhs = dim_col ?rhs" by auto
   have D: "D \<cdot>\<^sub>m 1\<^sub>m n : carrier_mat n n" by simp
   fix i j assume i: "i<dim_row ?rhs" and j: "j<dim_col ?rhs"
   have "?lhs $$ (i,j) = A' $$ (i,j)" using i j dr dc A' mn by (simp add: mat_of_rows_def)
   also have "... = A $$ (i,j)" using append_rows_nth[OF A' D] i j dr dc A' mn A_def by auto
   also have "... = ?rhs $$ (i,j)" using i j dr dc A' A_def mn
     by (metis D calculation carrier_matD(1) diff_zero gr_implies_not0 length_map length_upt 
         linordered_semidom_class.add_diff_inverse mat_of_rows_carrier(2,3)
         mat_of_rows_index nat_SN.compat nth_map_upt row_append_rows1)
   finally show "?lhs $$ (i,j) = ?rhs $$ (i,j)" .
 qed
 
 lemma non_zero_positions_xs_m_invertible:  
   assumes A_def: "A = A' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
   and A': "A' \<in> carrier_mat m n" 
   and nz_def: "non_zero_positions = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<dim_row A]"
   and m0: "0<m" and n0: "0<n"
   and D0: "D \<noteq> 0"
   and inv_A'': "invertible_mat (map_mat rat_of_int (mat_of_rows n (map (Matrix.row A') [0..<n])))"
   and A'00: "A' $$ (0,0) = 0"
   and mn: "m\<ge>n"
 shows "length non_zero_positions > 1"
 proof -  
   have A: "A \<in> carrier_mat (m+n) n" using A' A_def by auto
   have D: "D \<cdot>\<^sub>m 1\<^sub>m n : carrier_mat n n" by auto
   let ?RAT = "map_mat rat_of_int"
   let ?A'' = "(mat_of_rows n (map (Matrix.row A') [0..<n]))"
   have A'': "?A'' \<in> carrier_mat n n" by auto
   have RAT_A'': "?RAT ?A'' \<in> carrier_mat n n" by auto
   let ?ys = "filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<m]"
   let ?xs = "filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<n]"
   have xs_not_empty:"?xs \<noteq> []"
   proof (rule ccontr)
     assume "\<not> ?xs \<noteq> []" hence xs0: "?xs = []" by simp
     have A00: "A $$ (0,0) = 0" 
     proof -
       have "A $$ (0,0) = A'$$(0,0)" unfolding A_def using append_rows_nth[OF A' D] m0 n0 A' by auto
       thus ?thesis using A'00 by simp
     qed
     hence "(\<forall>i\<in>set [1..<n]. A $$ (i,0) = 0)"
       by (metis (mono_tags, lifting) empty_filter_conv xs0)
     hence *: "(\<forall>i<n. A $$ (i,0) = 0)" using A00 n0 using linorder_not_less by force
     have "col ?A'' 0 = 0\<^sub>v n"
     proof (rule eq_vecI)
       show "dim_vec (col ?A'' 0) = dim_vec (0\<^sub>vn)" using A' by auto
       fix i assume i: "i < dim_vec (0\<^sub>v n)" 
       have "col ?A'' 0 $v i = ?A'' $$ (i,0)" by (rule index_col, insert i A' n0, auto)
       also have "... = A $$ (i,0)" 
         unfolding A_def using i A append_rows_nth[OF A' D _ n0] A' mn 
         by (metis A'' n0 carrier_matD(1) index_zero_vec(2) le_add2 map_first_rows_index
             mat_of_rows_carrier(2) mat_of_rows_index nat_SN.compat)
       also have "... = 0" using * i by auto
       finally show "col ?A'' 0 $v i = 0\<^sub>v n $v i" using i by auto
     qed
     hence "col (?RAT ?A'') 0 = 0\<^sub>v n" by auto
     hence "\<not> invertible_mat (?RAT ?A'')"
       using invertible_mat_first_column_not0[OF RAT_A'' _ n0] by auto
     thus False using inv_A'' by contradiction
   qed
   have l_rw: "[1..<dim_row A] = [1..<m+1]@[m+1..<dim_row A]" using A m0 n0
     by (auto, metis Suc_leI less_add_same_cancel1 upt_add_eq_append upt_conv_Cons)
   have f0: "filter (\<lambda>i. A $$ (i,0) \<noteq> 0) ([m+1..<dim_row A]) = []"
   proof (rule filter_False) 
     have "A $$ (i,0) = 0" if i: "i\<in>set [m + 1..<dim_row A]" for i
     proof -
       have "A $$ (i,0) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i-m,0)"
         by (rule append_rows_nth3[OF A' _ A_def _ _ n0], insert i A, auto)
       also have "... = 0" using i A by auto
       finally show ?thesis .        
     qed
     thus "\<forall>x\<in>set [m + 1..<dim_row A]. \<not> A $$ (x, 0) \<noteq> 0" by blast
   qed
   have fm: "filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [m] = [m]"
   proof -
     have "A $$ (m, 0) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (m-m,0)"
       by (rule append_rows_nth3[OF A' _ A_def _ _ n0], insert n0, auto)
     also have "... = D" using m0 n0 by auto
     finally show ?thesis using D0 by auto
   qed
   have "non_zero_positions = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) ([1..<m+1]@[m+1..<dim_row A])"
     using nz_def l_rw by auto
   also have "... = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<m+1] @ filter (\<lambda>i. A $$ (i,0) \<noteq> 0) ([m+1..<dim_row A])"
     by auto
   also have "... = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<m+1]" using f0 by auto
   also have "... = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) ([1..<m]@[m])" using m0 by auto
   also have "... = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<m] @ [m]" using fm by auto
   finally have nz: "non_zero_positions = ?ys @ [m]" .
   moreover have ys_not_empty: "?ys \<noteq> []" using xs_not_empty mn
     by (metis (no_types, lifting) atLeastLessThan_iff empty_filter_conv nat_SN.compat set_upt)
   show ?thesis unfolding nz using ys_not_empty by auto  
 qed
 
 
 
 corollary non_zero_positions_length_xs:  
   assumes A_def: "A = A' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
   and A': "A' \<in> carrier_mat m n" 
   and nz_def: "non_zero_positions = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<dim_row A]"
   and m0: "0<m" and n0: "0<n"
   and D0: "D \<noteq> 0"
   and inv_A'': "invertible_mat (map_mat rat_of_int (mat_of_rows n (map (Matrix.row A') [0..<n])))"
   and A'00: "A' $$ (0,0) = 0"
   and mn: "m\<ge>n"
   and nz_xs_m: "non_zero_positions = xs @ [m]"
 shows "length xs > 0"
 proof -  
   have "length non_zero_positions > 1" 
     by (rule non_zero_positions_xs_m_invertible[OF A_def A' nz_def m0 n0 D0 inv_A'' A'00 mn])
   thus ?thesis using nz_xs_m by auto  
 qed
 
 
 
 lemma make_first_column_positive_nz_conv:
   assumes "i<dim_row A" and "j<dim_col A"
   shows "(make_first_column_positive A $$ (i, j) \<noteq> 0) = (A $$ (i, j) \<noteq> 0)"
   using assms unfolding make_first_column_positive.simps by auto
 
 
 
 lemma make_first_column_positive_00:
   assumes A_def: "A = A'' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
     and A'': "A'' : carrier_mat m n"
   assumes nz_def: "non_zero_positions = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<dim_row A]"
     and A'_def: "A' = (if A $$ (0, 0) \<noteq> 0 then A else let i = non_zero_positions ! 0 in swaprows 0 i A)"
     and m0: "0<m" and n0: "0<n" and D0: "D \<noteq> 0" and mn: "m\<ge>n"
   shows "make_first_column_positive A' $$ (0, 0) \<noteq> 0"
 proof -
   have A: "A \<in> carrier_mat (m+n) n" using A_def A'' by auto
   hence A': "A' \<in> carrier_mat (m+n) n" unfolding A'_def by auto 
   have "(make_first_column_positive A' $$ (0, 0) \<noteq> 0) = (A' $$ (0, 0) \<noteq> 0)"
     by (rule make_first_column_positive_nz_conv, insert m0 n0 A', auto)
   moreover have "A' $$ (0, 0) \<noteq> 0"
   proof (cases "A $$ (0, 0) \<noteq> 0")
     case True
     then show ?thesis unfolding A'_def by auto
   next
     case False
     have "A $$ (0, 0) = A'' $$ (0, 0)"
       by (smt add_gr_0 append_rows_def A_def A'' carrier_matD index_mat_four_block(1) mn n0 nat_SN.compat)
     hence A''00: "A''$$(0,0) = 0" using False by auto
     let ?i = "non_zero_positions ! 0"
     obtain xs where non_zero_positions_xs_m: "non_zero_positions = xs @ [m]" and d_xs: "distinct xs"
       and all_less_m: "\<forall>x\<in>set xs. x < m \<and> 0 < x" 
       using non_zero_positions_xs_m[OF A_def A'' nz_def m0 n0] using D0 by fast    
     have Ai0:"A $$ (?i,0) \<noteq> 0"
       by (smt append.simps(1) append_Cons append_same_eq nz_def in_set_conv_nth length_greater_0_conv
           list.simps(3) local.non_zero_positions_xs_m mem_Collect_eq set_filter)  
     have "A' $$ (0, 0) = swaprows 0 ?i A $$ (0,0)"  using False A'_def by auto
     also have "... \<noteq> 0" using A Ai0 n0 by auto  
     finally show ?thesis .
   qed
   ultimately show ?thesis by blast
 qed
 
 
 context proper_mod_operation
 begin
 lemma reduce_below_0_case_m_make_first_column_positive:
   assumes A': "A' \<in> carrier_mat m n" and m0: "0<m" and n0: "0<n"
     and A_def: "A = A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
     and mn: "m\<ge>n"
   assumes i_mn: "i < m+n" and d_xs: "distinct xs" and xs: "\<forall>x \<in> set xs. x < m \<and> 0 < x"
     and ia: "i\<noteq>0"
     and A''_def: "A'' = (if A $$ (0, 0) \<noteq> 0 then A else let i = non_zero_positions ! 0 in swaprows 0 i A)"
     and D0: "D>0"
     and nz_def: "non_zero_positions = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<dim_row A]"
   shows "reduce_below 0 non_zero_positions D (make_first_column_positive A'') $$ (i,0) = 0"
 proof -
   have A: "A \<in> carrier_mat (m+n) n" using A' A_def by auto
   define xs where "xs = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<m]"
   have nz_xs_m: "non_zero_positions = xs @ [m]" and d_xs: "distinct xs"
     and all_less_m: "\<forall>x\<in>set xs. x < m \<and> 0 < x" 
     using non_zero_positions_xs_m'[OF A_def A' nz_def m0 n0] using D0 A unfolding nz_def xs_def by auto
   have A'': "A'' \<in> carrier_mat (m+n) n" using A' A_def A''_def by auto
   have D_not0: "D\<noteq>0" using D0 by auto
   have Ai0: "A $$ (i, 0) = 0" if im: "i>m" and imn: "i<m+n" for i
   proof-
     have D: "(D \<cdot>\<^sub>m (1\<^sub>m n)) \<in> carrier_mat n n" by simp
     have "A $$ (i, 0) = (D \<cdot>\<^sub>m (1\<^sub>m n)) $$ (i-m, 0)"
       unfolding A_def using append_rows_nth[OF A' D imn n0] im A' by auto 
     also have "... = 0" using im imn n0 by auto
     finally show ?thesis .
   qed
   let ?M' = "mat_of_rows n (map (Matrix.row (make_first_column_positive A'')) [0..<m])"
   have M': "?M' \<in> carrier_mat m n" using A'' by auto
   have mk0: "make_first_column_positive A'' $$ (0, 0) \<noteq> 0"
     by (rule make_first_column_positive_00[OF A_def A' nz_def A''_def m0 n0 D_not0 mn])
   have M_M'D: "make_first_column_positive A'' = ?M' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n" if xs_empty: "xs \<noteq> []"
   proof (cases "A$$(0,0) \<noteq> 0")
     case True
     then have *: "make_first_column_positive A'' = make_first_column_positive A"
       unfolding A''_def by auto        
     show ?thesis 
       by (unfold *, rule make_first_column_positive_append_id[OF A' A_def D0 n0])
   next
     case False
     then have *: "make_first_column_positive A'' 
                   = make_first_column_positive (swaprows 0 (non_zero_positions ! 0) A)"
       unfolding A''_def by auto
     show ?thesis
     proof (unfold *, rule make_first_column_positive_append_id)
       let ?S = "mat_of_rows n (map (Matrix.row (swaprows 0 (non_zero_positions ! 0) A)) [0..<m])"
       show "swaprows 0 (non_zero_positions ! 0) A =  ?S @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
       proof (rule swaprows_append_id[OF A' A_def])
         have A'00: "A' $$ (0, 0) = 0"          
           by (metis (no_types, lifting) A False add_pos_pos append_rows_def A' A_def 
               carrier_matD index_mat_four_block m0 n0)
         have length_xs: "length xs > 0" using xs_empty by auto
         have "non_zero_positions ! 0 = xs ! 0" unfolding nz_xs_m
           by (meson length_xs nth_append)
         thus "non_zero_positions ! 0 < m" using all_less_m length_xs by simp
       qed
     qed (insert n0 D0, auto)            
   qed
   show ?thesis
   proof (cases "xs = []")
     case True note xs_empty = True
     have "reduce_below 0 non_zero_positions D (make_first_column_positive A'') 
       = reduce 0 m D (make_first_column_positive A'')"
       unfolding nz_xs_m True by auto
 
     also have "...  $$ (i, 0) = 0"
     proof (cases "i=m")
       case True
       from D0 have "D \<ge> 1" "D \<ge> 0" by auto
       then show ?thesis using D0 True
         by (metis A add_sign_intros(2) A''_def carrier_matD(1) carrier_matD(2) carrier_matI 
             index_mat_swaprows(2) index_mat_swaprows(3) less_add_same_cancel1 m0 
             make_first_column_positive_preserves_dimensions mk0 n0 neq0_conv reduce_0)
     next
       case False note i_not_m = False
       have nz_m: "non_zero_positions ! 0 = m" unfolding nz_xs_m True by auto
       let ?M = "make_first_column_positive A''"
       have M: "?M \<in> carrier_mat (m+n) n" using A'' by auto
       show ?thesis
       proof (cases "A$$(0,0) = 0")
         case True
         have "reduce 0 m D ?M $$ (i, 0) = ?M $$ (i,0)" 
           by (rule reduce_preserves[OF M n0 mk0 False ia i_mn])
         also have Mi0: "... = abs (A'' $$ (i,0))"
           by (smt M carrier_matD(1) carrier_matD(2) i_mn index_mat(1) make_first_column_positive.simps
               make_first_column_positive_preserves_dimensions n0 prod.simps(2))
         also have Mi02: "... = abs (A $$ (i,0)) " unfolding A''_def nz_m
           using True A False i_mn ia n0 by auto
         also have "... = 0"
         proof -
           have "filter (\<lambda>n. A $$ (n, 0) \<noteq> 0) [1..<m] = []"
             using xs_empty xs_def by presburger
           then have "\<forall>n. A $$ (n, 0) = 0 \<or> n \<notin> set [1..<m]" using filter_empty_conv by fast          
           then show ?thesis
             by (metis (no_types) Ai0 False arith_simps(43) assms(9) atLeastLessThan_iff i_mn
                 le_eq_less_or_eq less_one linorder_neqE_nat set_upt)
         qed
         finally show ?thesis .
       next
         case False hence A00: "A $$ (0,0) \<noteq> 0" by simp
         have "reduce 0 m D ?M $$ (i, 0) = ?M $$ (i,0)" 
           by (rule reduce_preserves[OF M n0 mk0 i_not_m ia i_mn])
         also have Mi0: "... = abs (A'' $$ (i,0))"
           by (smt M carrier_matD(1) carrier_matD(2) i_mn index_mat(1) make_first_column_positive.simps
               make_first_column_positive_preserves_dimensions n0 prod.simps(2))
         also have Mi02: "... = abs (swaprows 0 m A $$ (i,0)) " unfolding A''_def nz_m
           using A00 A i_not_m i_mn ia n0 by auto
         also have "... = abs (A $$ (i,0))" using False ia A00 Mi0 A''_def calculation Mi02 by presburger  
         also have "... = 0"
         proof -
           have "filter (\<lambda>n. A $$ (n, 0) \<noteq> 0) [1..<m] = []"
             using True xs_def by presburger
           then have "\<forall>n. A $$ (n, 0) = 0 \<or> n \<notin> set [1..<m]" using filter_empty_conv by fast          
           then show ?thesis
             by (metis (no_types) Ai0 i_not_m arith_simps(43) ia atLeastLessThan_iff i_mn
                 le_eq_less_or_eq less_one linorder_neqE_nat set_upt)
         qed
         finally show ?thesis .
       qed
     qed
     finally show ?thesis .
   next
     case False note xs_not_empty = False
     note M_M'D = M_M'D[OF xs_not_empty]
     show ?thesis   
     proof (cases "i \<in> set (xs @ [m])")
       case True
       show ?thesis  
         by (unfold nz_xs_m, rule reduce_below_0_case_m[OF M' m0 n0 M_M'D mk0 mn True d_xs all_less_m D0])
     next
       case False note i_notin_xs_m = False
       have 1: "reduce_below 0 (xs @ [m]) D (make_first_column_positive A'') $$ (i,0) 
         = (make_first_column_positive A'') $$ (i,0)"    
         by (rule reduce_below_preserves_case_m[OF M' m0 n0 M_M'D mk0 mn _ d_xs all_less_m ia i_mn _ D0],
             insert False, auto) 
       have "((make_first_column_positive A'') $$ (i,0) \<noteq> 0) = (A'' $$ (i,0) \<noteq> 0)"
         by (rule make_first_column_positive_nz_conv, insert A'' i_mn n0, auto)
       hence 2: "((make_first_column_positive A'') $$ (i,0) = 0) = (A'' $$ (i,0) = 0)" by auto
       have 3: "(A'' $$ (i,0) = 0)"
       proof (cases "A$$(0,0) \<noteq> 0")
         case True
         then have "A'' $$ (i, 0) = A $$ (i, 0)" unfolding A''_def by auto
         also have "... = 0" using False ia i_mn A nz_xs_m Ai0 unfolding nz_def xs_def by auto
         finally show ?thesis by auto
       next
         case False hence A00: "A $$ (0,0) = 0" by simp
         let ?i = "non_zero_positions ! 0"
         have i_noti: "i\<noteq>?i" 
           using i_notin_xs_m unfolding nz_xs_m
           by (metis Nil_is_append_conv length_greater_0_conv list.distinct(2) nth_mem)
         have "A''$$(i,0) = (swaprows 0 ?i A) $$ (i,0)" using False unfolding A''_def by auto
         also have "... = A $$ (i,0)" using i_notin_xs_m ia i_mn A i_noti n0 unfolding xs_def by fastforce  
         also have "... = 0" using i_notin_xs_m ia i_mn A i_noti n0 unfolding xs_def 
           by (smt nz_def atLeastLessThan_iff carrier_matD(1) less_one linorder_not_less
               mem_Collect_eq nz_xs_m set_filter set_upt xs_def) 
         finally show ?thesis .
       qed
       show ?thesis using 1 2 3 nz_xs_m by argo
     qed
   qed
 qed
 
 
 lemma reduce_below_abs_0_case_m_make_first_column_positive:
   assumes A': "A' \<in> carrier_mat m n" and m0: "0<m" and n0: "0<n"
     and A_def: "A = A' @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
     and mn: "m\<ge>n"
   assumes i_mn: "i < m+n" and d_xs: "distinct xs" and xs: "\<forall>x \<in> set xs. x < m \<and> 0 < x"
     and ia: "i\<noteq>0"
     and A''_def: "A'' = (if A $$ (0, 0) \<noteq> 0 then A else let i = non_zero_positions ! 0 in swaprows 0 i A)"
     and D0: "D>0"
     and nz_def: "non_zero_positions = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<dim_row A]"
   shows "reduce_below_abs 0 non_zero_positions D (make_first_column_positive A'') $$ (i,0) = 0"
 proof -
   have A: "A \<in> carrier_mat (m+n) n" using A' A_def by auto
   define xs where "xs = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<m]"
   have nz_xs_m: "non_zero_positions = xs @ [m]" and d_xs: "distinct xs"
     and all_less_m: "\<forall>x\<in>set xs. x < m \<and> 0 < x" 
     using non_zero_positions_xs_m'[OF A_def A' nz_def m0 n0] using D0 A unfolding nz_def xs_def by auto
   have A'': "A'' \<in> carrier_mat (m+n) n" using A' A_def A''_def by auto
   have D_not0: "D\<noteq>0" using D0 by auto
   have Ai0: "A $$ (i, 0) = 0" if im: "i>m" and imn: "i<m+n" for i
   proof-
     have D: "(D \<cdot>\<^sub>m (1\<^sub>m n)) \<in> carrier_mat n n" by simp
     have "A $$ (i, 0) = (D \<cdot>\<^sub>m (1\<^sub>m n)) $$ (i-m, 0)"
       unfolding A_def using append_rows_nth[OF A' D imn n0] im A' by auto 
     also have "... = 0" using im imn n0 by auto
     finally show ?thesis .
   qed
   let ?M' = "mat_of_rows n (map (Matrix.row (make_first_column_positive A'')) [0..<m])"
   have M': "?M' \<in> carrier_mat m n" using A'' by auto
   have mk0: "make_first_column_positive A'' $$ (0, 0) \<noteq> 0"
     by (rule make_first_column_positive_00[OF A_def A' nz_def A''_def m0 n0 D_not0 mn])
   have M_M'D: "make_first_column_positive A'' = ?M' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n" if xs_empty: "xs \<noteq> []"
   proof (cases "A$$(0,0) \<noteq> 0")
     case True
     then have *: "make_first_column_positive A'' = make_first_column_positive A"
       unfolding A''_def by auto        
     show ?thesis 
       by (unfold *, rule make_first_column_positive_append_id[OF A' A_def D0 n0])
   next
     case False
     then have *: "make_first_column_positive A'' 
                   = make_first_column_positive (swaprows 0 (non_zero_positions ! 0) A)"
       unfolding A''_def by auto
     show ?thesis
     proof (unfold *, rule make_first_column_positive_append_id)
       let ?S = "mat_of_rows n (map (Matrix.row (swaprows 0 (non_zero_positions ! 0) A)) [0..<m])"
       show "swaprows 0 (non_zero_positions ! 0) A =  ?S @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
       proof (rule swaprows_append_id[OF A' A_def])
         have A'00: "A' $$ (0, 0) = 0"          
           by (metis (no_types, lifting) A False add_pos_pos append_rows_def A' A_def 
               carrier_matD index_mat_four_block m0 n0)
         have length_xs: "length xs > 0" using xs_empty by auto
         have "non_zero_positions ! 0 = xs ! 0" unfolding nz_xs_m
           by (meson length_xs nth_append)
         thus "non_zero_positions ! 0 < m" using all_less_m length_xs by simp
       qed
     qed (insert n0 D0, auto)            
   qed
   show ?thesis
   proof (cases "xs = []")
     case True note xs_empty = True
     have "reduce_below_abs 0 non_zero_positions D (make_first_column_positive A'') 
       = reduce_abs 0 m D (make_first_column_positive A'')"
       unfolding nz_xs_m True by auto
 
     also have "...  $$ (i, 0) = 0"
     proof (cases "i=m")
       case True
       from D0 have "D \<ge> 1" "D \<ge> 0" by auto
       then show ?thesis using D0 True
         by (metis A add_sign_intros(2) A''_def carrier_matD(1) carrier_matD(2) carrier_matI 
             index_mat_swaprows(2) index_mat_swaprows(3) less_add_same_cancel1 m0 
             make_first_column_positive_preserves_dimensions mk0 n0 neq0_conv reduce_0)
     next
       case False note i_not_m = False
       have nz_m: "non_zero_positions ! 0 = m" unfolding nz_xs_m True by auto
       let ?M = "make_first_column_positive A''"
       have M: "?M \<in> carrier_mat (m+n) n" using A'' by auto
       show ?thesis
       proof (cases "A$$(0,0) = 0")
         case True
         have "reduce_abs 0 m D ?M $$ (i, 0) = ?M $$ (i,0)" 
           by (rule reduce_preserves[OF M n0 mk0 False ia i_mn])
         also have Mi0: "... = abs (A'' $$ (i,0))"
           by (smt M carrier_matD(1) carrier_matD(2) i_mn index_mat(1) make_first_column_positive.simps
               make_first_column_positive_preserves_dimensions n0 prod.simps(2))
         also have Mi02: "... = abs (A $$ (i,0)) " unfolding A''_def nz_m
           using True A False i_mn ia n0 by auto
         also have "... = 0"
         proof -
           have "filter (\<lambda>n. A $$ (n, 0) \<noteq> 0) [1..<m] = []"
             using xs_empty xs_def by presburger
           then have "\<forall>n. A $$ (n, 0) = 0 \<or> n \<notin> set [1..<m]" using filter_empty_conv by fast          
           then show ?thesis
             by (metis (no_types) Ai0 False arith_simps(43) assms(9) atLeastLessThan_iff i_mn
                 le_eq_less_or_eq less_one linorder_neqE_nat set_upt)
         qed
         finally show ?thesis .
       next
         case False hence A00: "A $$ (0,0) \<noteq> 0" by simp
         have "reduce_abs 0 m D ?M $$ (i, 0) = ?M $$ (i,0)" 
           by (rule reduce_preserves[OF M n0 mk0 i_not_m ia i_mn])
         also have Mi0: "... = abs (A'' $$ (i,0))"
           by (smt M carrier_matD(1) carrier_matD(2) i_mn index_mat(1) make_first_column_positive.simps
               make_first_column_positive_preserves_dimensions n0 prod.simps(2))
         also have Mi02: "... = abs (swaprows 0 m A $$ (i,0)) " unfolding A''_def nz_m
           using A00 A i_not_m i_mn ia n0 by auto
         also have "... = abs (A $$ (i,0))" using False ia A00 Mi0 A''_def calculation Mi02 by presburger  
         also have "... = 0"
         proof -
           have "filter (\<lambda>n. A $$ (n, 0) \<noteq> 0) [1..<m] = []"
             using True xs_def by presburger
           then have "\<forall>n. A $$ (n, 0) = 0 \<or> n \<notin> set [1..<m]" using filter_empty_conv by fast          
           then show ?thesis
             by (metis (no_types) Ai0 i_not_m arith_simps(43) ia atLeastLessThan_iff i_mn
                 le_eq_less_or_eq less_one linorder_neqE_nat set_upt)
         qed
         finally show ?thesis .
       qed
     qed
     finally show ?thesis .
   next
     case False note xs_not_empty = False
     note M_M'D = M_M'D[OF xs_not_empty]
     show ?thesis   
     proof (cases "i \<in> set (xs @ [m])")
       case True
       show ?thesis  
         by (unfold nz_xs_m, rule reduce_below_abs_0_case_m[OF M' m0 n0 M_M'D mk0 mn True d_xs all_less_m D0])
     next
       case False note i_notin_xs_m = False
       have 1: "reduce_below_abs 0 (xs @ [m]) D (make_first_column_positive A'') $$ (i,0) 
         = (make_first_column_positive A'') $$ (i,0)"    
         by (rule reduce_below_abs_preserves_case_m[OF M' m0 n0 M_M'D mk0 mn _ d_xs all_less_m ia i_mn _ D0],
             insert False, auto) 
       have "((make_first_column_positive A'') $$ (i,0) \<noteq> 0) = (A'' $$ (i,0) \<noteq> 0)"
         by (rule make_first_column_positive_nz_conv, insert A'' i_mn n0, auto)
       hence 2: "((make_first_column_positive A'') $$ (i,0) = 0) = (A'' $$ (i,0) = 0)" by auto
       have 3: "(A'' $$ (i,0) = 0)"
       proof (cases "A$$(0,0) \<noteq> 0")
         case True
         then have "A'' $$ (i, 0) = A $$ (i, 0)" unfolding A''_def by auto
         also have "... = 0" using False ia i_mn A nz_xs_m Ai0 unfolding nz_def xs_def by auto
         finally show ?thesis by auto
       next
         case False hence A00: "A $$ (0,0) = 0" by simp
         let ?i = "non_zero_positions ! 0"
         have i_noti: "i\<noteq>?i" 
           using i_notin_xs_m unfolding nz_xs_m
           by (metis Nil_is_append_conv length_greater_0_conv list.distinct(2) nth_mem)
         have "A''$$(i,0) = (swaprows 0 ?i A) $$ (i,0)" using False unfolding A''_def by auto
         also have "... = A $$ (i,0)" using i_notin_xs_m ia i_mn A i_noti n0 unfolding xs_def by fastforce  
         also have "... = 0" using i_notin_xs_m ia i_mn A i_noti n0 unfolding xs_def 
           by (smt nz_def atLeastLessThan_iff carrier_matD(1) less_one linorder_not_less
               mem_Collect_eq nz_xs_m set_filter set_upt xs_def) 
         finally show ?thesis .
       qed
       show ?thesis using 1 2 3 nz_xs_m by argo
     qed
   qed
 qed
 
 
 lemma FindPreHNF_invertible_mat_2xn:
   assumes A: "A \<in> carrier_mat m n" and "m<2"
   shows "\<exists>P. P \<in> carrier_mat m m \<and> invertible_mat P \<and> FindPreHNF abs_flag D A = P * A"
   using assms
   by (auto, metis invertible_mat_one left_mult_one_mat one_carrier_mat)
 
 
 lemma FindPreHNF_invertible_mat_mx2:
   assumes A_def: "A = A'' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
   and A'': "A'' \<in> carrier_mat m n" and n2: "n<2" and n0: "0<n" and D_g0: "D>0" and mn: "m\<ge>n"
 shows "\<exists>P. P \<in> carrier_mat (m+n) (m+n) \<and> invertible_mat P \<and> FindPreHNF abs_flag D A = P * A"
 proof -
   have A: "A \<in> carrier_mat (m+n) n" using A_def A'' by auto
   have m0: "m>0" using mn n2 n0 by auto
   have D0: "D\<noteq>0" using D_g0 by auto
   show ?thesis
   proof (cases "m+n<2")
     case True
     show ?thesis by (rule FindPreHNF_invertible_mat_2xn[OF A True])
   next
     case False note mn_le_2 = False
     have dr_A: "dim_row A \<ge>2" using False n2 A by auto
     have dc_A: "dim_col A < 2" using n2 A by auto
     let ?non_zero_positions = "filter (\<lambda>i. A $$ (i, 0) \<noteq> 0) [Suc 0..<dim_row A]" 
     let ?A' = "(if A $$ (0, 0) \<noteq> 0 then A else let i = ?non_zero_positions ! 0 in swaprows 0 i A)"
     define xs where "xs = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<m]"
     let ?Reduce = "(if abs_flag then reduce_below_abs else reduce_below)"
     have nz_xs_m: "?non_zero_positions = xs @ [m]" and d_xs: "distinct xs"
       and all_less_m: "\<forall>x\<in>set xs. x < m \<and> 0 < x" 
       using non_zero_positions_xs_m'[OF A_def A'' _ m0 n0 D0] using D0 A unfolding xs_def by auto  
     have *: "FindPreHNF abs_flag D A = (if abs_flag then reduce_below_abs 0 ?non_zero_positions D ?A' 
         else reduce_below 0 ?non_zero_positions D ?A')"
       using dr_A dc_A by (auto simp add: Let_def) 
     have l: "length ?non_zero_positions > 1" if "xs\<noteq>[]" using that unfolding nz_xs_m by auto
     have inv: "\<exists>P. invertible_mat P \<and> P \<in> carrier_mat (m + n) (m + n) 
       \<and> reduce_below 0 ?non_zero_positions D ?A' = P * ?A'"
     proof (cases "A $$ (0,0) \<noteq>0")
       case True
       show ?thesis
         by (unfold nz_xs_m, rule reduce_below_invertible_mat_case_m
             [OF A'' m0 n0 _ _ mn d_xs all_less_m], insert A_def True D_g0, auto)
     next
       case False hence A00: "A $$ (0,0) = 0" by auto
       let ?S = "swaprows 0 (?non_zero_positions ! 0) A"
       have rw: "(if A $$ (0, 0) \<noteq> 0 then A else let i = ?non_zero_positions ! 0 in swaprows 0 i A)
           = ?S" using False by auto
       show ?thesis
       proof (cases "xs = []")
         case True
         have nz_m: "?non_zero_positions = [m]" using True nz_xs_m by simp
         obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (swaprows 0 m A $$ (0, 0)) (swaprows 0 m A $$ (m, 0))"
           by (metis prod_cases5)        
         have Am0: "A $$ (m,0) = D"
         proof -
           have "A $$ (m,0) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (m-m, 0)"
             by (smt (z3) A append_rows_def A_def A'' n0 carrier_matD diff_self_eq_0 index_mat_four_block
                 less_add_same_cancel1 less_diff_conv diff_add nat_less_le)
           also have "... = D" by (simp add: n0)
           finally show ?thesis .
         qed
         have Sm0: "(swaprows 0 m A) $$ (m,0) = 0" using A False n0 by auto
         have S00: "(swaprows 0 m A) $$ (0,0) = D" using A Am0 n0 by auto
         have pquvd2: "(p,q,u,v,d) = euclid_ext2 (A $$ (m, 0)) (A $$ (0, 0))"
           using pquvd Sm0 S00 Am0 A00 by auto
         have "reduce_below 0 ?non_zero_positions D ?A' = reduce 0 m D ?A'" unfolding nz_m by auto
         also have "... = reduce 0 m D (swaprows 0 m A)" using True False rw nz_m by auto
         have " \<exists>P. invertible_mat P \<and> P \<in> carrier_mat (m + n) (m + n) \<and>
            reduce 0 m D (swaprows 0 m A) = P * (swaprows 0 m A)"
         proof (rule reduce_invertible_mat_case_m[OF _ _ m0 _ _ _ _ mn n0])
           show "swaprows 0 m A $$ (0, 0) \<noteq> 0" using S00 D0 by auto
           define S' where  "S' = mat_of_rows n (map (Matrix.row ?S) [0..<m])"
           define S'' where "S'' = mat_of_rows n (map (Matrix.row ?S) [m..<m+n])"
           define A2 where "A2 = Matrix.mat (dim_row (swaprows 0 m A)) (dim_col (swaprows 0 m A))
              (\<lambda>(i, k). if i = 0 then p * A $$ (m, k) + q * A $$ (0, k)
              else if i = m then u * A $$ (m, k) + v * A $$ (0, k) else A $$ (i, k))"
           show S_S'_S'': "swaprows 0 m A = S' @\<^sub>r S''" unfolding S'_def S''_def
             by (metis A append_rows_split carrier_matD index_mat_swaprows(2,3) le_add1 nth_Cons_0 nz_m)
           show S': "S' \<in> carrier_mat m n" unfolding S'_def by fastforce
           show S'': "S'' \<in> carrier_mat n n" unfolding S''_def by fastforce
           show "0 \<noteq> m" using m0 by simp
           show "(p,q,u,v,d) = euclid_ext2 (swaprows 0 m A $$ (0, 0)) (swaprows 0 m A $$ (m, 0))"
             using pquvd by simp
           show "A2 = Matrix.mat (dim_row (swaprows 0 m A)) (dim_col (swaprows 0 m A))
          (\<lambda>(i, k). if i = 0 then p * swaprows 0 m A $$ (0, k) + q * swaprows 0 m A $$ (m, k)
          else if i = m then u * swaprows 0 m A $$ (0, k) + v * swaprows 0 m A $$ (m, k) else swaprows 0 m A $$ (i, k))"
             (is "_ = ?rhs") using A A2_def by auto
           define xs' where "xs' = [1..<n]"
           define ys' where  "ys' = [1..<n]"
           show "xs' = [1..<n]" unfolding xs'_def by auto
           show "ys' = [1..<n]" unfolding ys'_def by auto
           have S''D: "(S'' $$ (j, j) = D) \<and> (\<forall>j'\<in>{0..<n}-{j}. S'' $$ (j, j') = 0)"
             if jn: "j<n" and j0: "j>0" for j
           proof -
             have "S'' $$ (j, i) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (j,i)" if i_n: "i<n" for i
             proof -
               have "S'' $$ (j, i) = swaprows 0 m A $$ (j+m,i)"
                 by (metis S' S'' S_S'_S'' append_rows_nth2 mn nat_SN.compat i_n jn)
               also have "... = A $$ (j+m,i)" using A jn j0 i_n by auto
               also have "... = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (j,i)"
                 by (smt A Groups.add_ac(2) add_mono_thms_linordered_field(1) append_rows_def A_def A'' i_n
                     carrier_matD index_mat_four_block(1,2) add_diff_cancel_right' not_add_less2 jn trans_less_add1)
               finally show ?thesis .
             qed
             thus ?thesis using jn j0 by auto
           qed
           have "0 \<notin> set xs'"
           proof -
             have "A2 $$ (0,0) = p * A $$ (m, 0) + q * A $$ (0, 0)" 
               using A A2_def n0 by auto
             also have "... = gcd (A $$ (m, 0)) (A $$ (0, 0))"
               by (metis euclid_ext2_works(1) euclid_ext2_works(2) pquvd2)
             also have "... = D" using Am0 A00 D_g0 by auto             
             finally have "A2 $$ (0,0) = D" .
             thus ?thesis unfolding xs'_def using D_g0 by auto
           qed
           thus "\<forall>j\<in>set xs'. j<n \<and> (S'' $$ (j, j) = D) \<and> (\<forall>j'\<in>{0..<n}-{j}. S'' $$ (j, j') = 0)"  
             using S''D xs'_def by auto
           have "0 \<notin> set ys'"
           proof -
             have "A2 $$ (m,0) = u * A $$ (m, 0) + v * A $$ (0, 0)"
               using A A2_def n0 m0 by auto
             also have "... = - A $$ (0, 0) div gcd (A $$ (m, 0)) (A $$ (0, 0)) * A $$ (m, 0) 
               + A $$ (m, 0) div gcd (A $$ (m, 0)) (A $$ (0, 0)) * A $$ (0, 0)"
               by (simp add: euclid_ext2_works[OF pquvd2[symmetric]])
             also have "... = 0" using A00 Am0 by auto
             finally have "A2 $$ (m,0) = 0" .
             thus ?thesis unfolding ys'_def using D_g0 by auto
           qed
           thus "\<forall>j\<in>set ys'. j<n \<and> (S'' $$ (j, j) = D) \<and> (\<forall>j'\<in>{0..<n}-{j}. S'' $$ (j, j') = 0)"
             using S''D ys'_def by auto    
           show "swaprows 0 m A $$ (m, 0) \<in> {0, D}" using Sm0 by blast
           thus "swaprows 0 m A $$ (m, 0) = 0 \<longrightarrow> swaprows 0 m A $$ (0, 0) = D"
             using S00 by linarith                  
         qed (insert D_g0)      
         then show ?thesis by (simp add: False nz_m)
       next
         case False note xs_not_empty = False
         show ?thesis       
       proof (unfold nz_xs_m, rule reduce_below_invertible_mat_case_m[OF _ m0 n0 _ _ mn d_xs all_less_m D_g0])
         let ?S' = "mat_of_rows n (map (Matrix.row ?S) [0..<m])"
         show "?S' \<in> carrier_mat m n" by auto
         have l: "length ?non_zero_positions > 1" using l False by blast
         hence nz0_less_m: "?non_zero_positions ! 0 < m"
           by (metis One_nat_def add.commute add.left_neutral all_less_m append_Cons_nth_left 
               length_append less_add_same_cancel1 list.size(3,4) nth_mem nz_xs_m)    
         have "?S = ?S' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n" by (rule swaprows_append_id[OF A'' A_def nz0_less_m])
         thus "(if A $$ (0, 0) \<noteq> 0 then A else let i = (xs @ [m]) ! 0 in swaprows 0 i A)= ?S' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n" 
           using rw nz_xs_m by argo
         have "?S $$ (0, 0) \<noteq> 0"
           by (smt A l add_pos_pos carrier_matD index_mat_swaprows(1) le_eq_less_or_eq length_greater_0_conv
               less_one linorder_not_less list.size(3) m0 mem_Collect_eq n0 nth_mem set_filter)
         thus "(if A $$ (0, 0) \<noteq> 0 then A else let i = (xs @ [m]) ! 0 in swaprows 0 i A) $$ (0, 0) \<noteq> 0"
           using rw nz_xs_m by algebra
       qed
     qed
   qed
     have inv2: "\<exists>P. invertible_mat P \<and> P \<in> carrier_mat (m + n) (m + n) 
       \<and> reduce_below_abs 0 ?non_zero_positions D ?A' = P * ?A'"
     proof (cases "A $$ (0,0) \<noteq>0")
       case True
       show ?thesis
         by (unfold nz_xs_m, rule reduce_below_abs_invertible_mat_case_m
             [OF A'' m0 n0 _ _ mn d_xs all_less_m], insert A_def True D_g0, auto)
     next
       case False hence A00: "A $$ (0,0) = 0" by auto
       let ?S = "swaprows 0 (?non_zero_positions ! 0) A"
       have rw: "(if A $$ (0, 0) \<noteq> 0 then A else let i = ?non_zero_positions ! 0 in swaprows 0 i A)
           = ?S" using False by auto
       show ?thesis
       proof (cases "xs = []")
         case True
         have nz_m: "?non_zero_positions = [m]" using True nz_xs_m by simp
         obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (swaprows 0 m A $$ (0, 0)) (swaprows 0 m A $$ (m, 0))"
           by (metis prod_cases5)        
         have Am0: "A $$ (m,0) = D"
         proof -
           have "A $$ (m,0) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (m-m, 0)"
             by (smt (z3) A append_rows_def A_def A'' n0 carrier_matD diff_self_eq_0 index_mat_four_block
                 less_add_same_cancel1 less_diff_conv diff_add nat_less_le)
           also have "... = D" by (simp add: n0)
           finally show ?thesis .
         qed
         have Sm0: "(swaprows 0 m A) $$ (m,0) = 0" using A False n0 by auto
         have S00: "(swaprows 0 m A) $$ (0,0) = D" using A Am0 n0 by auto
         have pquvd2: "(p,q,u,v,d) = euclid_ext2 (A $$ (m, 0)) (A $$ (0, 0))"
           using pquvd Sm0 S00 Am0 A00 by auto
         have "reduce_below 0 ?non_zero_positions D ?A' = reduce 0 m D ?A'" unfolding nz_m by auto
         also have "... = reduce 0 m D (swaprows 0 m A)" using True False rw nz_m by auto
         have " \<exists>P. invertible_mat P \<and> P \<in> carrier_mat (m + n) (m + n) \<and>
            reduce_abs 0 m D (swaprows 0 m A) = P * (swaprows 0 m A)"
         proof (rule reduce_abs_invertible_mat_case_m[OF _ _ m0 _ _ _ _ mn n0])
           show "swaprows 0 m A $$ (0, 0) \<noteq> 0" using S00 D0 by auto
           define S' where  "S' = mat_of_rows n (map (Matrix.row ?S) [0..<m])"
           define S'' where "S'' = mat_of_rows n (map (Matrix.row ?S) [m..<m+n])"
           define A2 where "A2 = Matrix.mat (dim_row (swaprows 0 m A)) (dim_col (swaprows 0 m A))
              (\<lambda>(i, k). if i = 0 then p * A $$ (m, k) + q * A $$ (0, k)
              else if i = m then u * A $$ (m, k) + v * A $$ (0, k) else A $$ (i, k))"
           show S_S'_S'': "swaprows 0 m A = S' @\<^sub>r S''" unfolding S'_def S''_def
             by (metis A append_rows_split carrier_matD index_mat_swaprows(2,3) le_add1 nth_Cons_0 nz_m)
           show S': "S' \<in> carrier_mat m n" unfolding S'_def by fastforce
           show S'': "S'' \<in> carrier_mat n n" unfolding S''_def by fastforce
           show "0 \<noteq> m" using m0 by simp
           show "(p,q,u,v,d) = euclid_ext2 (swaprows 0 m A $$ (0, 0)) (swaprows 0 m A $$ (m, 0))"
             using pquvd by simp
           show "A2 = Matrix.mat (dim_row (swaprows 0 m A)) (dim_col (swaprows 0 m A))
          (\<lambda>(i, k). if i = 0 then p * swaprows 0 m A $$ (0, k) + q * swaprows 0 m A $$ (m, k)
          else if i = m then u * swaprows 0 m A $$ (0, k) + v * swaprows 0 m A $$ (m, k) else swaprows 0 m A $$ (i, k))"
             (is "_ = ?rhs") using A A2_def by auto
           define xs' where "xs' = filter (\<lambda>i. abs (A2 $$ (0,i)) > D) [0..<n]"
           define ys' where  "ys' = filter (\<lambda>i. abs (A2 $$ (m,i)) > D) [0..<n]"
           show "xs' = filter (\<lambda>i. abs (A2 $$ (0,i)) > D) [0..<n]" unfolding xs'_def by auto
           show "ys' = filter (\<lambda>i. abs (A2 $$ (m,i)) > D) [0..<n]" unfolding ys'_def by auto
           have S''D: "(S'' $$ (j, j) = D) \<and> (\<forall>j'\<in>{0..<n}-{j}. S'' $$ (j, j') = 0)"
             if jn: "j<n" and j0: "j>0" for j
           proof -
             have "S'' $$ (j, i) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (j,i)" if i_n: "i<n" for i
             proof -
               have "S'' $$ (j, i) = swaprows 0 m A $$ (j+m,i)"
                 by (metis S' S'' S_S'_S'' append_rows_nth2 mn nat_SN.compat i_n jn)
               also have "... = A $$ (j+m,i)" using A jn j0 i_n by auto
               also have "... = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (j,i)"
                 by (smt A Groups.add_ac(2) add_mono_thms_linordered_field(1) append_rows_def A_def A'' i_n
                     carrier_matD index_mat_four_block(1,2) add_diff_cancel_right' not_add_less2 jn trans_less_add1)
               finally show ?thesis .
             qed
             thus ?thesis using jn j0 by auto
           qed
           have "0 \<notin> set xs'"
           proof -
             have "A2 $$ (0,0) = p * A $$ (m, 0) + q * A $$ (0, 0)" 
               using A A2_def n0 by auto
             also have "... = gcd (A $$ (m, 0)) (A $$ (0, 0))"
               by (metis euclid_ext2_works(1) euclid_ext2_works(2) pquvd2)
             also have "... = D" using Am0 A00 D_g0 by auto             
             finally have "A2 $$ (0,0) = D" .
             thus ?thesis unfolding xs'_def using D_g0 by auto
           qed
           thus "\<forall>j\<in>set xs'. j<n \<and> (S'' $$ (j, j) = D) \<and> (\<forall>j'\<in>{0..<n}-{j}. S'' $$ (j, j') = 0)"  
             using S''D xs'_def by auto
           have "0 \<notin> set ys'"
           proof -
             have "A2 $$ (m,0) = u * A $$ (m, 0) + v * A $$ (0, 0)"
               using A A2_def n0 m0 by auto
             also have "... = - A $$ (0, 0) div gcd (A $$ (m, 0)) (A $$ (0, 0)) * A $$ (m, 0) 
               + A $$ (m, 0) div gcd (A $$ (m, 0)) (A $$ (0, 0)) * A $$ (0, 0)"
               by (simp add: euclid_ext2_works[OF pquvd2[symmetric]])
             also have "... = 0" using A00 Am0 by auto
             finally have "A2 $$ (m,0) = 0" .
             thus ?thesis unfolding ys'_def using D_g0 by auto
           qed
           thus "\<forall>j\<in>set ys'. j<n \<and> (S'' $$ (j, j) = D) \<and> (\<forall>j'\<in>{0..<n}-{j}. S'' $$ (j, j') = 0)"
             using S''D ys'_def by auto    
         qed (insert D_g0)      
         then show ?thesis by (simp add: False nz_m)
       next
         case False note xs_not_empty = False
         show ?thesis       
       proof (unfold nz_xs_m, rule reduce_below_abs_invertible_mat_case_m[OF _ m0 n0 _ _ mn d_xs all_less_m D_g0])
         let ?S' = "mat_of_rows n (map (Matrix.row ?S) [0..<m])"
         show "?S' \<in> carrier_mat m n" by auto
         have l: "length ?non_zero_positions > 1" using l False by blast
         hence nz0_less_m: "?non_zero_positions ! 0 < m"
           by (metis One_nat_def add.commute add.left_neutral all_less_m append_Cons_nth_left 
               length_append less_add_same_cancel1 list.size(3,4) nth_mem nz_xs_m)    
         have "?S = ?S' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n" by (rule swaprows_append_id[OF A'' A_def nz0_less_m])
         thus "(if A $$ (0, 0) \<noteq> 0 then A else let i = (xs @ [m]) ! 0 in swaprows 0 i A)= ?S' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n" 
           using rw nz_xs_m by argo
         have "?S $$ (0, 0) \<noteq> 0"
           by (smt A l add_pos_pos carrier_matD index_mat_swaprows(1) le_eq_less_or_eq length_greater_0_conv
               less_one linorder_not_less list.size(3) m0 mem_Collect_eq n0 nth_mem set_filter)
         thus "(if A $$ (0, 0) \<noteq> 0 then A else let i = (xs @ [m]) ! 0 in swaprows 0 i A) $$ (0, 0) \<noteq> 0"
           using rw nz_xs_m by algebra
       qed
     qed
   qed
   show ?thesis
   proof (cases abs_flag)
     case False
     from inv obtain P where inv_P: "invertible_mat P" and P: "P \<in> carrier_mat (m + n) (m + n)"
       and r_PA': "reduce_below 0 ?non_zero_positions D ?A' = P * ?A'" by blast
     have Find_rw: "FindPreHNF abs_flag D A = reduce_below 0 ?non_zero_positions D ?A'"
       using n0 A dr_A dc_A False * by (auto simp add: Let_def)
     have "\<exists>P. P \<in> carrier_mat (m + n) (m + n) \<and> invertible_mat P \<and> ?A' = P * A" 
       by (rule A'_swaprows_invertible_mat[OF A], insert non_zero_positions_xs_m n0 m0 l nz_xs_m, auto) 
     from this obtain Q where Q: "Q \<in> carrier_mat (m + n) (m + n)"
       and inv_Q: "invertible_mat Q" and A'_QA: "?A' = Q * A" by blast
     have "reduce_below 0 ?non_zero_positions D ?A' = (P * Q) * A" using Q A'_QA P r_PA' A by auto
     moreover have "invertible_mat (P*Q)" using P Q inv_P inv_Q invertible_mult_JNF by blast
     moreover have "(P*Q) \<in> carrier_mat (m + n) (m + n)" using P Q by auto
     ultimately show ?thesis using Find_rw by metis
   next
     case True
     from inv2 obtain P where inv_P: "invertible_mat P" and P: "P \<in> carrier_mat (m + n) (m + n)"
       and r_PA': "reduce_below_abs 0 ?non_zero_positions D ?A' = P * ?A'" by blast
     have Find_rw: "FindPreHNF abs_flag D A = reduce_below_abs 0 ?non_zero_positions D ?A'"
       using n0 A dr_A dc_A True * by (auto simp add: Let_def)
     have "\<exists>P. P \<in> carrier_mat (m + n) (m + n) \<and> invertible_mat P \<and> ?A' = P * A" 
       by (rule A'_swaprows_invertible_mat[OF A], insert non_zero_positions_xs_m n0 m0 l nz_xs_m, auto) 
     from this obtain Q where Q: "Q \<in> carrier_mat (m + n) (m + n)"
       and inv_Q: "invertible_mat Q" and A'_QA: "?A' = Q * A" by blast
     have "reduce_below_abs 0 ?non_zero_positions D ?A' = (P * Q) * A" using Q A'_QA P r_PA' A by auto
     moreover have "invertible_mat (P*Q)" using P Q inv_P inv_Q invertible_mult_JNF by blast
     moreover have "(P*Q) \<in> carrier_mat (m + n) (m + n)" using P Q by auto
     ultimately show ?thesis using Find_rw by metis
   qed     
   qed
 qed
 
 
 corollary FindPreHNF_echelon_form_mx0:
   assumes "A \<in> carrier_mat m 0"
   shows "echelon_form_JNF (FindPreHNF abs_flag D A)"
   by (rule echelon_form_mx0, rule FindPreHNF[OF assms])
                
 
 lemma FindPreHNF_echelon_form_mx1:
   assumes A_def: "A = A'' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
   and A'': "A'' \<in> carrier_mat m n" and n2: "n<2" and D_g0: "D>0" and mn: "m\<ge>n"
 shows "echelon_form_JNF (FindPreHNF abs_flag D A)"
 proof (cases "n=0")
   case True
   have A: "A \<in> carrier_mat m 0" using A_def A'' True 
     by (metis add.comm_neutral append_rows_def carrier_matD carrier_matI index_mat_four_block(2,3)
         index_one_mat(2) index_smult_mat(2) index_zero_mat(2,3)) 
   show ?thesis unfolding True by (rule FindPreHNF_echelon_form_mx0, insert A, auto)
 next
   case False hence n0: "0<n" by auto
   have A: "A \<in> carrier_mat (m+n) n" using A_def A'' by auto
   have m0: "m>0" using mn n2 n0 by auto
   have D0: "D\<noteq>0" using D_g0 by auto
   show ?thesis
   proof (cases "m+n<2")
     case True
     show ?thesis by (rule echelon_form_JNF_1xn[OF _ True], rule FindPreHNF[OF A])
   next
     case False note mn_le_2 = False
     have dr_A: "dim_row A \<ge>2" using False n2 A by auto
     have dc_A: "dim_col A < 2" using n2 A by auto
     let ?non_zero_positions = "filter (\<lambda>i. A $$ (i, 0) \<noteq> 0) [Suc 0..<dim_row A]" 
     let ?A' = "(if A $$ (0, 0) \<noteq> 0 then A else let i = ?non_zero_positions ! 0 in swaprows 0 i A)" 
     define xs where "xs = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<m]"
     let ?Reduce = "(if abs_flag then reduce_below_abs else reduce_below)"
     have nz_xs_m: "?non_zero_positions = xs @ [m]" and d_xs: "distinct xs"
       and all_less_m: "\<forall>x\<in>set xs. x < m \<and> 0 < x" 
       using non_zero_positions_xs_m'[OF A_def A'' _ m0 n0 D0] using D0 A unfolding xs_def by auto  
     have *: "FindPreHNF abs_flag D A = (if abs_flag then reduce_below_abs 0 ?non_zero_positions D ?A' 
         else reduce_below 0 ?non_zero_positions D ?A')"
       using dr_A dc_A by (auto simp add: Let_def) 
     have l: "length ?non_zero_positions > 1" if "xs\<noteq>[]" using that unfolding nz_xs_m by auto
     have e: "echelon_form_JNF (reduce_below 0 ?non_zero_positions D ?A')"
     proof (cases "A $$ (0,0) \<noteq>0")
       case True note A00 = True
       have 1: "reduce_below 0 ?non_zero_positions D ?A' = reduce_below 0 ?non_zero_positions D A"
         using True by auto
       have "echelon_form_JNF (reduce_below 0 ?non_zero_positions D A)"
       proof (rule echelon_form_JNF_mx1[OF _ n2]) 
         show "reduce_below 0 ?non_zero_positions D A \<in> carrier_mat (m+n) n" using A by auto
         show "\<forall>i\<in>{1..<m + n}. reduce_below 0 ?non_zero_positions D A $$ (i, 0) = 0"
         proof 
           fix i assume i: "i \<in> {1..<m + n}"
           show "reduce_below 0 ?non_zero_positions D A $$ (i, 0) =0"
           proof (cases "i\<in>set ?non_zero_positions")
             case True
             show ?thesis unfolding nz_xs_m 
               by (rule reduce_below_0_case_m[OF A'' m0 n0 A_def A00 mn _ d_xs all_less_m D_g0],
                   insert nz_xs_m True, auto)
           next
             case False note i_notin_set = False
             have "reduce_below 0 ?non_zero_positions D A $$ (i, 0) = A $$ (i, 0)" unfolding nz_xs_m 
               by (rule reduce_below_preserves_case_m[OF A'' m0 n0 A_def A00 mn _ d_xs all_less_m _ _ _ D_g0],
                   insert i nz_xs_m i_notin_set, auto)
             also have "... = 0" using i_notin_set i A unfolding set_filter by auto
             finally show ?thesis .        
           qed
         qed
       qed
       thus ?thesis using 1 by argo
     next
       case False hence A00: "A $$ (0,0) = 0" by simp
       let ?i = "((xs @ [m]) ! 0)"
       let ?S = "swaprows 0 ?i A"
       let ?S' = "mat_of_rows n (map (Matrix.row (swaprows 0 ?i A)) [0..<m])"
       have rw: "(if A$$(0, 0) \<noteq> 0 then A else let i = ?non_zero_positions!0 in swaprows 0 i A) = ?S"
         using A00 nz_xs_m by auto
       have S: "?S \<in> carrier_mat (m+n) n" using A by auto
       have A00_eq_A'00: "A $$ (0, 0) = A'' $$ (0, 0)" 
         by (metis A'' A_def add_gr_0 append_rows_def n0 carrier_matD index_mat_four_block(1) m0)
       show ?thesis
       proof (cases "xs=[]")
         case True
         have nz_m: "?non_zero_positions = [m]" using True nz_xs_m by simp
         obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (swaprows 0 m A $$ (0, 0)) (swaprows 0 m A $$ (m, 0))"
           by (metis prod_cases5)        
         have Am0: "A $$ (m,0) = D"
         proof -
           have "A $$ (m,0) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (m-m, 0)"
             by (smt A append_rows_def A_def A'' n0 carrier_matD diff_self_eq_0 index_mat_four_block
                 less_add_same_cancel1 less_diff_conv ordered_cancel_comm_monoid_diff_class.diff_add
                 nat_less_le)
           also have "... = D" by (simp add: n0)
           finally show ?thesis .
         qed
         have Sm0: "(swaprows 0 m A) $$ (m,0) = 0" using A False n0 by auto
         have S00: "(swaprows 0 m A) $$ (0,0) = D" using A Am0 n0 by auto
         have pquvd2: "(p,q,u,v,d) = euclid_ext2 (A $$ (m, 0)) (A $$ (0, 0))"
           using pquvd Sm0 S00 Am0 A00 by auto
         have "reduce_below 0 ?non_zero_positions D ?A' = reduce 0 m D ?A'" unfolding nz_m by auto
         also have "... = reduce 0 m D (swaprows 0 m A)" using True False rw nz_m by auto
         finally have *: "reduce_below 0 ?non_zero_positions D ?A' = reduce 0 m D (swaprows 0 m A)" .
         have "echelon_form_JNF (reduce 0 m D (swaprows 0 m A))"
         proof (rule echelon_form_JNF_mx1[OF _ n2])
           show "reduce 0 m D (swaprows 0 m A) \<in> carrier_mat (m+n) n"
             using A n2 reduce_carrier by (auto simp add: Let_def) 
           show "\<forall>i\<in>{1..<m+n}. reduce 0 m D (swaprows 0 m A) $$ (i, 0) = 0"
           proof
             fix i assume i: "i \<in> {1..<m+n}"
             show "reduce 0 m D (swaprows 0 m A) $$ (i, 0) = 0"
             proof (cases "i=m")
               case True
               show ?thesis
               proof (unfold True, rule reduce_0[OF _ _ n0])
                 show "swaprows 0 m A \<in> carrier_mat (m+n) n" using A by auto
               qed (insert m0 n0 S00 D_g0, auto)
             next
               case False
               have "reduce 0 m D (swaprows 0 m A) $$ (i, 0) = (swaprows 0 m A) $$ (i, 0)"
               proof (rule reduce_preserves[OF _ n0])
                 show "swaprows 0 m A \<in> carrier_mat (m+n) n" using A by auto  
               qed (insert m0 n0 S00 D_g0 False i, auto)
               also have "... = A $$ (i, 0)" using i False A n0 by auto
               also have "... = 0"
               proof (rule ccontr)
                 assume "A $$ (i, 0) \<noteq> 0" hence "i \<in> set ?non_zero_positions" using i A by auto 
                 hence "i=m" using nz_xs_m True by auto
                 thus False using False by contradiction
               qed
               finally show ?thesis .
             qed 
           qed
         qed       
         then show ?thesis using * by presburger
       next
         case False        
       have l: "length ?non_zero_positions > 1"    using False nz_xs_m by auto   
       hence l_xs: "length xs > 0" using nz_xs_m by auto
       hence xs_m_less_m: "(xs@[m]) ! 0 < m" by (simp add: all_less_m nth_append)
       have S00: "?S $$ (0,0) \<noteq> 0"
         by (smt A add_pos_pos append_Cons_nth_left n0 carrier_matD index_mat_swaprows(1)
             l_xs m0 mem_Collect_eq nth_mem set_filter xs_def)
       have S': "?S' \<in> carrier_mat m n" using A by auto
       have S_S'D: "?S = ?S' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n" by (rule swaprows_append_id[OF A'' A_def xs_m_less_m]) 
       have 2: "reduce_below 0 ?non_zero_positions D ?A' = reduce_below 0 ?non_zero_positions D ?S"
         using A00 nz_xs_m by algebra
       have "echelon_form_JNF (reduce_below 0 ?non_zero_positions D ?S)"
       proof (rule echelon_form_JNF_mx1[OF _ n2])
         show "reduce_below 0 ?non_zero_positions D ?S \<in> carrier_mat (m+n) n" using A by auto
         show "\<forall>i\<in>{1..<m + n}. reduce_below 0 ?non_zero_positions D ?S $$ (i, 0) = 0"
         proof 
           fix i assume i: "i \<in> {1..<m + n}"
           show "reduce_below 0 ?non_zero_positions D ?S $$ (i, 0) =0"
           proof (cases "i\<in>set ?non_zero_positions")
             case True
             show ?thesis unfolding nz_xs_m 
               by (rule reduce_below_0_case_m[OF S' m0 n0 S_S'D S00 mn _ d_xs all_less_m D_g0],
                   insert True nz_xs_m, auto)
           next
             case False note i_notin_set = False
             have "reduce_below 0 ?non_zero_positions D ?S $$ (i, 0) = ?S $$ (i, 0)" unfolding nz_xs_m 
               by (rule reduce_below_preserves_case_m[OF S' m0 n0 S_S'D S00 mn _ d_xs all_less_m _ _ _ D_g0],
                   insert i nz_xs_m i_notin_set, auto)
             also have "... = 0" using i_notin_set i A S00 n0 unfolding set_filter by auto              
             finally show ?thesis .        
           qed
         qed
       qed
       thus ?thesis using 2 by argo
     qed
   qed
     have e2: "echelon_form_JNF (reduce_below_abs 0 ?non_zero_positions D ?A')"
     proof (cases "A $$ (0,0) \<noteq>0")
       case True note A00 = True
       have 1: "reduce_below_abs 0 ?non_zero_positions D ?A' = reduce_below_abs 0 ?non_zero_positions D A"
         using True by auto
       have "echelon_form_JNF (reduce_below_abs 0 ?non_zero_positions D A)"
       proof (rule echelon_form_JNF_mx1[OF _ n2]) 
         show "reduce_below_abs 0 ?non_zero_positions D A \<in> carrier_mat (m+n) n" using A by auto
         show "\<forall>i\<in>{1..<m + n}. reduce_below_abs 0 ?non_zero_positions D A $$ (i, 0) = 0"
         proof 
           fix i assume i: "i \<in> {1..<m + n}"
           show "reduce_below_abs 0 ?non_zero_positions D A $$ (i, 0) =0"
           proof (cases "i\<in>set ?non_zero_positions")
             case True
             show ?thesis unfolding nz_xs_m 
               by (rule reduce_below_abs_0_case_m[OF A'' m0 n0 A_def A00 mn _ d_xs all_less_m D_g0],
                   insert nz_xs_m True, auto)
           next
             case False note i_notin_set = False
             have "reduce_below_abs 0 ?non_zero_positions D A $$ (i, 0) = A $$ (i, 0)" unfolding nz_xs_m 
               by (rule reduce_below_abs_preserves_case_m[OF A'' m0 n0 A_def A00 mn _ d_xs all_less_m _ _ _ D_g0],
                   insert i nz_xs_m i_notin_set, auto)
             also have "... = 0" using i_notin_set i A unfolding set_filter by auto
             finally show ?thesis .        
           qed
         qed
       qed
       thus ?thesis using 1 by argo
     next
       case False hence A00: "A $$ (0,0) = 0" by simp
       let ?i = "((xs @ [m]) ! 0)"
       let ?S = "swaprows 0 ?i A"
       let ?S' = "mat_of_rows n (map (Matrix.row (swaprows 0 ?i A)) [0..<m])"
       have rw: "(if A$$(0, 0) \<noteq> 0 then A else let i = ?non_zero_positions!0 in swaprows 0 i A) = ?S"
         using A00 nz_xs_m by auto
       have S: "?S \<in> carrier_mat (m+n) n" using A by auto
       have A00_eq_A'00: "A $$ (0, 0) = A'' $$ (0, 0)" 
         by (metis A'' A_def add_gr_0 append_rows_def n0 carrier_matD index_mat_four_block(1) m0)
       show ?thesis
       proof (cases "xs=[]")
         case True
         have nz_m: "?non_zero_positions = [m]" using True nz_xs_m by simp
         obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (swaprows 0 m A $$ (0, 0)) (swaprows 0 m A $$ (m, 0))"
           by (metis prod_cases5)        
         have Am0: "A $$ (m,0) = D"
         proof -
           have "A $$ (m,0) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (m-m, 0)"
             by (smt A append_rows_def A_def A'' n0 carrier_matD diff_self_eq_0 index_mat_four_block
                 less_add_same_cancel1 less_diff_conv ordered_cancel_comm_monoid_diff_class.diff_add
                 nat_less_le)
           also have "... = D" by (simp add: n0)
           finally show ?thesis .
         qed
         have Sm0: "(swaprows 0 m A) $$ (m,0) = 0" using A False n0 by auto
         have S00: "(swaprows 0 m A) $$ (0,0) = D" using A Am0 n0 by auto
         have pquvd2: "(p,q,u,v,d) = euclid_ext2 (A $$ (m, 0)) (A $$ (0, 0))"
           using pquvd Sm0 S00 Am0 A00 by auto
         have "reduce_below_abs 0 ?non_zero_positions D ?A' = reduce_abs 0 m D ?A'" unfolding nz_m by auto
         also have "... = reduce_abs 0 m D (swaprows 0 m A)" using True False rw nz_m by auto
         finally have *: "reduce_below_abs 0 ?non_zero_positions D ?A' = reduce_abs 0 m D (swaprows 0 m A)" .
         have "echelon_form_JNF (reduce_abs 0 m D (swaprows 0 m A))"
         proof (rule echelon_form_JNF_mx1[OF _ n2])
           show "reduce_abs 0 m D (swaprows 0 m A) \<in> carrier_mat (m+n) n"
             using A n2 reduce_carrier by (auto simp add: Let_def) 
           show "\<forall>i\<in>{1..<m+n}. reduce_abs 0 m D (swaprows 0 m A) $$ (i, 0) = 0"
           proof
             fix i assume i: "i \<in> {1..<m+n}"
             show "reduce_abs 0 m D (swaprows 0 m A) $$ (i, 0) = 0"
             proof (cases "i=m")
               case True
               show ?thesis
               proof (unfold True, rule reduce_0[OF _ _ n0])
                 show "swaprows 0 m A \<in> carrier_mat (m+n) n" using A by auto
               qed (insert m0 n0 S00 D_g0, auto)
             next
               case False
               have "reduce_abs 0 m D (swaprows 0 m A) $$ (i, 0) = (swaprows 0 m A) $$ (i, 0)"
               proof (rule reduce_preserves[OF _ n0])
                 show "swaprows 0 m A \<in> carrier_mat (m+n) n" using A by auto  
               qed (insert m0 n0 S00 D_g0 False i, auto)
               also have "... = A $$ (i, 0)" using i False A n0 by auto
               also have "... = 0"
               proof (rule ccontr)
                 assume "A $$ (i, 0) \<noteq> 0" hence "i \<in> set ?non_zero_positions" using i A by auto 
                 hence "i=m" using nz_xs_m True by auto
                 thus False using False by contradiction
               qed
               finally show ?thesis .
             qed 
           qed
         qed       
         then show ?thesis using * by presburger
       next
         case False        
       have l: "length ?non_zero_positions > 1"    using False nz_xs_m by auto   
       hence l_xs: "length xs > 0" using nz_xs_m by auto
       hence xs_m_less_m: "(xs@[m]) ! 0 < m" by (simp add: all_less_m nth_append)
       have S00: "?S $$ (0,0) \<noteq> 0"
         by (smt A add_pos_pos append_Cons_nth_left n0 carrier_matD index_mat_swaprows(1)
             l_xs m0 mem_Collect_eq nth_mem set_filter xs_def)
       have S': "?S' \<in> carrier_mat m n" using A by auto
       have S_S'D: "?S = ?S' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n" by (rule swaprows_append_id[OF A'' A_def xs_m_less_m]) 
       have 2: "reduce_below_abs 0 ?non_zero_positions D ?A' = reduce_below_abs 0 ?non_zero_positions D ?S"
         using A00 nz_xs_m by algebra
       have "echelon_form_JNF (reduce_below_abs 0 ?non_zero_positions D ?S)"
       proof (rule echelon_form_JNF_mx1[OF _ n2])
         show "reduce_below_abs 0 ?non_zero_positions D ?S \<in> carrier_mat (m+n) n" using A by auto
         show "\<forall>i\<in>{1..<m + n}. reduce_below_abs 0 ?non_zero_positions D ?S $$ (i, 0) = 0"
         proof 
           fix i assume i: "i \<in> {1..<m + n}"
           show "reduce_below_abs 0 ?non_zero_positions D ?S $$ (i, 0) =0"
           proof (cases "i\<in>set ?non_zero_positions")
             case True
             show ?thesis unfolding nz_xs_m 
               by (rule reduce_below_abs_0_case_m[OF S' m0 n0 S_S'D S00 mn _ d_xs all_less_m D_g0],
                   insert True nz_xs_m, auto)
           next
             case False note i_notin_set = False
             have "reduce_below_abs 0 ?non_zero_positions D ?S $$ (i, 0) = ?S $$ (i, 0)" unfolding nz_xs_m 
               by (rule reduce_below_abs_preserves_case_m[OF S' m0 n0 S_S'D S00 mn _ d_xs all_less_m _ _ _ D_g0],
                   insert i nz_xs_m i_notin_set, auto)
             also have "... = 0" using i_notin_set i A S00 n0 unfolding set_filter by auto              
             finally show ?thesis .        
           qed
         qed
       qed
       thus ?thesis using 2 by argo
     qed
   qed
     thus ?thesis using * e by presburger
   qed
 qed
 
 
 lemma FindPreHNF_works_n_ge2:
   assumes A_def: "A = A'' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
   and A'': "A'' \<in> carrier_mat m n" and "n\<ge>2" and m_le_n: "m\<ge>n" and "D>0"
 shows "\<exists>P. P \<in> carrier_mat (m+n) (m+n) \<and> invertible_mat P \<and> FindPreHNF abs_flag D A = P * A \<and> echelon_form_JNF (FindPreHNF abs_flag D A)"
   using assms
 proof (induct abs_flag D A arbitrary: A'' m n rule: FindPreHNF.induct)
   case (1 abs_flag D A)  
   note A_def = "1.prems"(1)
   note A'' = "1.prems"(2)
   note n = "1.prems"(3)
   note m_le_n = "1.prems"(4)
   note D0 = "1.prems"(5)
   let ?RAT = "map_mat rat_of_int"
   have A: "A \<in> carrier_mat (m+n) n" using A_def A'' by auto
   have mn: "2\<le>m+n" using n by auto
   have m0: "0<m" using n m_le_n by auto
   have n0: "0<n" using n by simp
   have D_not0: "D\<noteq>0" using D0 by auto
   define non_zero_positions where "non_zero_positions = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<dim_row A]"
   define A' where "A' = (if A $$ (0, 0) \<noteq> 0 then A else let i = non_zero_positions ! 0 in swaprows 0 i A)"
   let ?Reduce = "(if abs_flag then reduce_below_abs else reduce_below)"
   obtain A'_UL A'_UR A'_DL A'_DR where A'_split: "(A'_UL, A'_UR, A'_DL, A'_DR) 
     = split_block (?Reduce 0 non_zero_positions D (make_first_column_positive A')) 1 1"     
     by (metis prod_cases4)
   define sub_PreHNF where "sub_PreHNF = FindPreHNF abs_flag D A'_DR"
   obtain xs where non_zero_positions_xs_m: "non_zero_positions = xs @ [m]" and d_xs: "distinct xs"
     and all_less_m: "\<forall>x\<in>set xs. x < m \<and> 0 < x" 
     using non_zero_positions_xs_m[OF A_def A'' non_zero_positions_def m0 n0] using D0 by fast
   define M where "M = (make_first_column_positive A')"  
   have A': "A' \<in> carrier_mat (m+n) n" unfolding A'_def using A by auto 
   have mk_A'_not0:"make_first_column_positive A' $$ (0,0) \<noteq> 0"
     by (rule make_first_column_positive_00[OF A_def A'' non_zero_positions_def
           A'_def m0 n0 D_not0 m_le_n])  
   have M: "M \<in> carrier_mat (m+n) n" using A' M_def by auto
   let ?M' = "mat_of_rows n (map (Matrix.row (make_first_column_positive A')) [0..<m])"
   have M': "?M' \<in> carrier_mat m n" by auto            
   have M_M'D: "make_first_column_positive A' = ?M' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n" if xs_empty: "xs \<noteq> []"
   proof (cases "A$$(0,0) \<noteq> 0")
     case True
     then have *: "make_first_column_positive A' = make_first_column_positive A"
       unfolding A'_def by auto        
     show ?thesis 
       by (unfold *, rule make_first_column_positive_append_id[OF A'' A_def D0 n0])
   next
     case False
     then have *: "make_first_column_positive A' 
                   = make_first_column_positive (swaprows 0 (non_zero_positions ! 0) A)"
       unfolding A'_def by auto
     show ?thesis
     proof (unfold *, rule make_first_column_positive_append_id)
       let ?S = "mat_of_rows n (map (Matrix.row (swaprows 0 (non_zero_positions ! 0) A)) [0..<m])"
       show "swaprows 0 (non_zero_positions ! 0) A =  ?S @\<^sub>r (D \<cdot>\<^sub>m (1\<^sub>m n))"
       proof (rule swaprows_append_id[OF A'' A_def])
         have A''00: "A'' $$ (0, 0) = 0"
           by (metis (no_types, lifting) A A'' A_def False add_sign_intros(2) append_rows_def
               carrier_matD index_mat_four_block m0 n0)
         have length_xs: "length xs > 0" using xs_empty by auto
         have "non_zero_positions ! 0 = xs ! 0" unfolding non_zero_positions_xs_m
           by (meson length_xs nth_append)
         thus "non_zero_positions ! 0 < m" using all_less_m length_xs by simp
       qed
     qed (insert n0 D0, auto)            
   qed
   have A'_DR: "A'_DR \<in> carrier_mat (m + (n-1)) (n-1)"
     by (rule split_block(4)[OF A'_split[symmetric]], insert n M M_def, auto)  
   have sub_PreHNF: "sub_PreHNF \<in> carrier_mat (m + (n -1)) (n-1)"
     unfolding sub_PreHNF_def by (rule FindPreHNF[OF A'_DR])
   hence sub_PreHNF': "sub_PreHNF \<in> carrier_mat (m+n - 1) (n-1)" using n by auto
   have A'_UL: "A'_UL \<in> carrier_mat 1 1"
     by (rule split_block(1)[OF A'_split[symmetric], of "m+n-1" "n-1"], insert n A', auto) 
   have A'_UR: "A'_UR \<in> carrier_mat 1 (n-1)"
     by (rule split_block(2)[OF A'_split[symmetric], of "m+n-1"], insert n A', auto)
   have A'_DL: "A'_DL \<in> carrier_mat (m + (n - 1)) 1"
     by (rule split_block(3)[OF A'_split[symmetric], of _ "n-1"], insert n A', auto)
 
   show ?case
   proof (cases abs_flag)
     case True note abs_flag = True
       hence A'_split: "(A'_UL, A'_UR, A'_DL, A'_DR) 
     = split_block (reduce_below_abs 0 non_zero_positions D (make_first_column_positive A')) 1 1"   using A'_split by auto
     let ?R = "reduce_below_abs 0 non_zero_positions D (make_first_column_positive A')"
    have fbm_R: "four_block_mat A'_UL A'_UR A'_DL A'_DR 
      = reduce_below_abs 0 non_zero_positions D (make_first_column_positive A')"
     by (rule split_block(5)[symmetric, OF A'_split[symmetric], of "m+n-1" "n-1"], insert A' n, auto)
   have A'_DL0: "A'_DL = (0\<^sub>m (m + (n - 1)) 1)"   
   proof (rule eq_matI)
     show "dim_row A'_DL = dim_row (0\<^sub>m (m + (n - 1)) 1)"
       and "dim_col A'_DL = dim_col (0\<^sub>m (m + (n - 1)) 1)" using A'_DL by auto    
     fix i j assume i: "i < dim_row (0\<^sub>m (m + (n - 1)) 1)" and j: "j < dim_col (0\<^sub>m (m + (n - 1)) 1)"
     have j0: "j=0" using j by auto
     have "0 = ?R $$ (i+1,j)"
     proof (unfold M_def non_zero_positions_xs_m j0, 
         rule reduce_below_abs_0_case_m_make_first_column_positive[symmetric,
           OF A'' m0 n0 A_def m_le_n _  d_xs all_less_m _ _ D0 _ ])
       show "A' = (if A $$ (0, 0) \<noteq> 0 then A else let i = (xs @ [m]) ! 0 in swaprows 0 i A)"
         using A'_def non_zero_positions_def non_zero_positions_xs_m by presburger
       show "xs @ [m] = filter (\<lambda>i. A $$ (i, 0) \<noteq> 0) [1..<dim_row A]"
         using A'_def non_zero_positions_def non_zero_positions_xs_m by presburger
     qed (insert i n0, auto)
     also have "... = four_block_mat A'_UL A'_UR A'_DL A'_DR $$ (i+1,j)" unfolding fbm_R ..
     also have "... = (if i+1 < dim_row A'_UL then if j < dim_col A'_UL 
             then A'_UL $$ (i+1, j) else A'_UR $$ (i+1, j - dim_col A'_UL)
             else if j < dim_col A'_UL then A'_DL $$ (i+1 - dim_row A'_UL, j)
             else A'_DR $$ (i+1 - dim_row A'_UL, j - dim_col A'_UL))"
       by (rule index_mat_four_block, insert A'_UL A'_DR i j, auto)
     also have "... = A'_DL $$ (i, j)" using A'_UL A'_UR i j by auto
     finally show "A'_DL $$ (i, j) = 0\<^sub>m (m + (n - 1)) 1 $$ (i, j)" using i j by auto
   qed
 
   let ?A'_DR_m = "mat_of_rows (n-1) [Matrix.row A'_DR i. i \<leftarrow> [0..<m]]"
   have A'_DR_m: "?A'_DR_m \<in> carrier_mat m (n-1)" by auto
   have A'DR_A'DR_m_D: "A'_DR = ?A'_DR_m @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m (n - 1)"
   proof (rule eq_matI)
     show dr: "dim_row A'_DR = dim_row (?A'_DR_m @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m (n - 1))" 
       by (metis A'_DR A'_DR_m append_rows_def carrier_matD(1) index_mat_four_block(2) 
           index_one_mat(2) index_smult_mat(2) index_zero_mat(2))
     show dc: "dim_col A'_DR = dim_col (?A'_DR_m @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m (n - 1))"
       by (metis A'_DR A'_DR_m add.comm_neutral append_rows_def
           carrier_matD(2) index_mat_four_block(3) index_zero_mat(3))  
     fix i j assume i: "i < dim_row(?A'_DR_m @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m (n - 1))"
       and j: "j<dim_col (?A'_DR_m @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m (n - 1))"
     have jn1: "j<n-1" using dc j A'_DR by auto
     show "A'_DR $$ (i,j) = (?A'_DR_m @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m (n - 1)) $$ (i,j)"
     proof (cases "i<m")
       case True
       have "A'_DR $$ (i,j) = ?A'_DR_m $$ (i,j)"
         by (metis A'_DR A'_DR_m True dc carrier_matD(1) carrier_matD(2) j le_add1 
             map_first_rows_index mat_of_rows_carrier(2) mat_of_rows_index)
       also have "... = (?A'_DR_m @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m (n - 1)) $$ (i,j)"
         by (metis (mono_tags, lifting) A'_DR A'_DR_m True append_rows_def 
             carrier_matD dc i index_mat_four_block j)
       finally show ?thesis .
     next
       case False note i_ge_m = False
       let ?reduce_below = "reduce_below_abs 0 non_zero_positions D (make_first_column_positive A')"
       have 1: "(?A'_DR_m @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m (n - 1)) $$ (i,j) = (D \<cdot>\<^sub>m 1\<^sub>m (n - 1)) $$ (i-m,j)"
         by (smt A'_DR A'_DR_m False append_rows_nth carrier_matD carrier_mat_triv dc dr i
             index_one_mat(2) index_one_mat(3) index_smult_mat(2,3) j)
       have "?reduce_below = four_block_mat A'_UL A'_UR A'_DL A'_DR" using fbm_R ..
       also have "... $$ (i+1,j+1) = (if i+1 < dim_row A'_UL then if j+1 < dim_col A'_UL 
               then A'_UL $$ (i+1, j+1) else A'_UR $$ (i+1, j+1 - dim_col A'_UL)
               else if j+1 < dim_col A'_UL then A'_DL $$ (i+1 - dim_row A'_UL, j+1)
               else A'_DR $$ (i+1 - dim_row A'_UL, j+1 - dim_col A'_UL))"
         by (rule index_mat_four_block, insert i j A'_UL A'_DR dr dc, auto)
       also have "... = A'_DR $$ (i,j)" using A'_UL by auto
       finally have 2: "?reduce_below $$ (i+1,j+1) = A'_DR $$ (i,j)" .
       show ?thesis 
       proof (cases "xs = []")
         case True note xs_empty = True
         have i1_m: "i + 1 \<noteq> m" 
           using False less_add_one by blast
         have j1n: "j+1<n"
           using jn1 less_diff_conv by blast
         have i1_mn: "i+1<m + n"
           using i i_ge_m
           by (metis A'_DR carrier_matD(1) dr less_diff_conv sub_PreHNF sub_PreHNF')
         have "?reduce_below = reduce_abs 0 m D M"
           unfolding non_zero_positions_xs_m xs_empty M_def by auto
         also have "... $$ (i+1,j+1) = M $$ (i+1, j+1)"
           by (rule reduce_preserves[OF M j1n _ i1_m _ i1_mn], insert M_def mk_A'_not0, auto)         
         also have "... = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ ((i+1)-m, j+1)"
         proof (cases "A $$ (0,0) = 0")
           case True
           let ?S = "(swaprows 0 m A)"
           have S: "?S \<in> carrier_mat (m+n) n" using A by auto
           have Si10: "?S $$ (i+1,0) = 0"
           proof -
             have "?S $$ (i+1,0) = A $$ (i+1,0)" using i1_m n0 i1_mn S by auto
             also have "... = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i+1 - m,0)"
               by (smt A_def A'' A i_ge_m append_rows_def carrier_matD diff_add_inverse2 i1_mn 
                   index_mat_four_block less_imp_diff_less n0)
             also have "... = 0" using i_ge_m n0 i1_mn by auto
             finally show ?thesis .
           qed
           have "M $$ (i+1, j+1) = (make_first_column_positive ?S) $$ (i+1,j+1)"
             by (simp add: A'_def M_def True non_zero_positions_xs_m xs_empty)
           also have "... = (if ?S $$ (i+1,0) < 0 then - ?S $$ (i+1,j+1) else ?S $$ (i+1,j+1))" 
             unfolding make_first_column_positive.simps using S i1_mn j1n by auto
           also have "... = ?S $$ (i+1,j+1)" using Si10 by auto
           also have "... = A $$ (i+1,j+1)" using i1_m n0 i1_mn S jn1 by auto
           also have "... = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i+1 - m,j+1)"
             by (smt A_def A'' A i_ge_m append_rows_def carrier_matD i1_mn index_mat_four_block(1,3)
                 index_one_mat(2) index_smult_mat(2) index_zero_mat(2) j1n less_imp_diff_less add_diff_cancel_right')
           finally show ?thesis .
         next
           case False         
           have Ai10: "A $$ (i+1,0) = 0"
           proof -
             have "A $$ (i+1,0) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i+1 - m,0)"
               by (smt A_def A'' A i_ge_m append_rows_def carrier_matD diff_add_inverse2 i1_mn 
                   index_mat_four_block less_imp_diff_less n0)
             also have "... = 0" using i_ge_m n0 i1_mn by auto
             finally show ?thesis .
           qed          
           have "M $$ (i+1, j+1) = (make_first_column_positive A) $$ (i+1,j+1)"
             by (simp add: A'_def M_def False True non_zero_positions_xs_m)
           also have "... = (if A $$ (i+1,0) < 0 then - A $$ (i+1,j+1) else A $$ (i+1,j+1))" 
             unfolding make_first_column_positive.simps using A i1_mn j1n by auto
           also have "... = A $$ (i+1,j+1)" using Ai10 by auto
           also have "... = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i+1 - m,j+1)"
             by (smt A_def A'' A i_ge_m append_rows_def carrier_matD i1_mn index_mat_four_block(1,3)
                 index_one_mat(2) index_smult_mat(2) index_zero_mat(2) j1n less_imp_diff_less add_diff_cancel_right')
           finally show ?thesis .
         qed
         also have "... = D * (1\<^sub>m n) $$ ((i+1)-m, j+1)"
           by (rule index_smult_mat, insert i jn1 A'_DR False dr, auto)            
         also have "... = D *(1\<^sub>m (n - 1)) $$ (i-m,j)" using dc dr i j A'_DR i_ge_m
           by (smt Nat.add_diff_assoc2 carrier_matD(1) index_one_mat(1) jn1 less_diff_conv 
               linorder_not_less add_diff_cancel_right' add_diff_cancel_right' add_diff_cancel_left')
         also have "... = (D \<cdot>\<^sub>m 1\<^sub>m (n - 1)) $$ (i-m,j)"
           by (rule index_smult_mat[symmetric], insert i jn1 A'_DR False dr, auto)
         finally show ?thesis using 1 2 by auto
       next
         case False     
       have "?reduce_below $$ (i+1, j+1) = M $$ (i+1, j+1)"
       proof (unfold non_zero_positions_xs_m M_def,
           rule reduce_below_abs_preserves_case_m[OF M' m0 _ M_M'D mk_A'_not0 m_le_n _ d_xs all_less_m _ _ _ D0])            
         show "j + 1 < n" using jn1 by auto
         show "i + 1 \<notin> set xs" using all_less_m i_ge_m non_zero_positions_xs_m by auto
         show "i + 1 \<noteq> 0" by auto
         show " i + 1 < m + n" using i_ge_m i dr A'_DR by auto
         show " i + 1 \<noteq> m" using i_ge_m by auto
       qed (insert False)
       also have "... = (?M' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i+1, j+1)" unfolding M_def using False M_M'D by argo
       also have "... = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ ((i+1)-m, j+1)"
       proof -
         have f1: "1 + j < n"
           by (metis Groups.add_ac(2) jn1 less_diff_conv)
         have f2: "\<forall>n. \<not> n + i < m"
           by (meson i_ge_m linorder_not_less nat_SN.compat not_add_less2)
         have "i < m + (n - 1)"
           by (metis (no_types) A'_DR carrier_matD(1) dr i)
         then have "1 + i < m + n"
           using f1 by linarith
         then show ?thesis
           using f2 f1 by (metis (no_types) Groups.add_ac(2) M' append_rows_def carrier_matD(1) 
               dim_col_mat(1) index_mat_four_block(1) index_one_mat(2) index_smult_mat(2) 
               index_zero_mat(2,3) mat_of_rows_def nat_arith.rule0)
       qed
       also have "... = D * (1\<^sub>m n) $$ ((i+1)-m, j+1)"
         by (rule index_smult_mat, insert i jn1 A'_DR False dr, auto)            
       also have "... = D *(1\<^sub>m (n - 1)) $$ (i-m,j)" using dc dr i j A'_DR i_ge_m
         by (smt Nat.add_diff_assoc2 carrier_matD(1) index_one_mat(1) jn1 less_diff_conv 
             linorder_not_less add_diff_cancel_right' add_diff_cancel_left')
       also have "... = (D \<cdot>\<^sub>m 1\<^sub>m (n - 1)) $$ (i-m,j)"
         by (rule index_smult_mat[symmetric], insert i jn1 A'_DR False dr, auto)
       finally have 3: "?reduce_below $$ (i+1,j+1) = (D \<cdot>\<^sub>m 1\<^sub>m (n - 1)) $$ (i-m,j)" .            
       show ?thesis using 1 2 3 by presburger
     qed              
   qed
 qed
   let ?A'_DR_n = "mat_of_rows (n - 1) (map (Matrix.row A'_DR) [0..<n - 1])"
   have hyp: "\<exists>P. P\<in>carrier_mat (m + (n-1)) (m + (n-1)) \<and> invertible_mat P \<and> sub_PreHNF = P * A'_DR 
   \<and> echelon_form_JNF sub_PreHNF" 
   proof (cases "2 \<le> n - 1")
     case True
     show ?thesis
       by (unfold sub_PreHNF_def, rule "1.hyps"[OF _ _ _ non_zero_positions_def A'_def _ _ _ _ _])
          (insert A n D0 m_le_n True A'DR_A'DR_m_D A A'_split abs_flag, auto)
   next
     case False
     have "\<exists>P. P\<in>carrier_mat (m + (n-1)) (m + (n-1)) \<and> invertible_mat P \<and> sub_PreHNF = P * A'_DR"
       by (unfold sub_PreHNF_def, rule FindPreHNF_invertible_mat_mx2
           [OF A'DR_A'DR_m_D A'_DR_m _ _ D0 _])
           (insert False m_le_n n0 m0 "1"(4), auto)
     moreover have "echelon_form_JNF sub_PreHNF" unfolding sub_PreHNF_def 
       by (rule FindPreHNF_echelon_form_mx1[OF A'DR_A'DR_m_D A'_DR_m _ D0 _],
           insert False n0 m_le_n, auto) 
     ultimately show ?thesis by simp
   qed  
   from this obtain P where P: "P \<in> carrier_mat (m + (n - 1)) (m + (n - 1))"
     and inv_P: "invertible_mat P" and sub_PreHNF_P_A'_DR: "sub_PreHNF = P * A'_DR" by blast
   define P' where "P' = (four_block_mat (1\<^sub>m 1) (0\<^sub>m 1 (m+(n-1))) (0\<^sub>m (m+(n-1)) 1) P)"
   have P': "P' \<in> carrier_mat (m+n) (m+n)" 
   proof -
     have "P' \<in> carrier_mat (1 + (m+(n-1))) (1 + (m+(n-1))) "
       unfolding P'_def by (rule four_block_carrier_mat[OF _ P], simp) 
     thus ?thesis using n by auto
   qed
   have inv_P': "invertible_mat P'" 
     unfolding P'_def by (rule invertible_mat_four_block_mat_lower_right[OF P inv_P])
   have dr_A2: "dim_row A \<ge> 2" using A m0 n by auto
   have dc_A2: "dim_col A \<ge> 2" using n A by blast
   have *: "(dim_col A = 0) = False" using dc_A2 by auto
   have FindPreHNF_as_fbm: "FindPreHNF abs_flag D A = four_block_mat A'_UL A'_UR A'_DL sub_PreHNF" 
     unfolding FindPreHNF.simps[of abs_flag D A] using A'_split mn n A dr_A2 dc_A2 abs_flag
     unfolding Let_def sub_PreHNF_def M_def A'_def non_zero_positions_def *    
     by (smt (z3) linorder_not_less split_conv)
   also have "... = P' * (reduce_below_abs 0 non_zero_positions D M)"
   proof -
     have "P' * (reduce_below_abs 0 non_zero_positions D M) 
       = four_block_mat (1\<^sub>m 1) (0\<^sub>m 1 (m + (n - 1))) (0\<^sub>m (m + (n - 1)) 1) P 
       * four_block_mat A'_UL A'_UR A'_DL A'_DR"
       unfolding P'_def fbm_R[unfolded M_def[symmetric], symmetric] ..
     also have "... = four_block_mat 
             ((1\<^sub>m 1) * A'_UL + (0\<^sub>m 1 (m + (n - 1)) * A'_DL)) 
             ((1\<^sub>m 1) * A'_UR + (0\<^sub>m 1 (m + (n - 1))) * A'_DR) 
             ((0\<^sub>m (m + (n - 1)) 1) * A'_UL + P * A'_DL) 
             ((0\<^sub>m (m + (n - 1)) 1) * A'_UR + P * A'_DR)" 
       by (rule mult_four_block_mat[OF _ _ _ P A'_UL A'_UR A'_DL A'_DR], auto)
     also have "... = four_block_mat A'_UL A'_UR (P * A'_DL) (P * A'_DR)"
       by (rule cong_four_block_mat, insert A'_UL A'_UR A'_DL A'_DR P, auto)
     also have "... = four_block_mat A'_UL A'_UR (0\<^sub>m (m + (n - 1)) 1) sub_PreHNF"
       unfolding A'_DL0 sub_PreHNF_P_A'_DR using P by simp
     also have "... = four_block_mat A'_UL A'_UR A'_DL sub_PreHNF"
       unfolding A'_DL0 by simp
     finally show ?thesis ..
   qed
   finally have Find_P'_reduceM: "FindPreHNF abs_flag D A =  P' * (reduce_below_abs 0 non_zero_positions D M)" .
   have "\<exists>Q. invertible_mat Q \<and> Q \<in> carrier_mat (m + n) (m + n) 
     \<and> reduce_below_abs 0 (xs @ [m]) D M = Q * M"
   proof (cases "xs = []")
     case True note xs_empty = True
     have rw: "reduce_below_abs 0 (xs @ [m]) D M = reduce_abs 0 m D M" using True by auto
     obtain p q u v d where pquvd: "(p, q, u, v, d) = euclid_ext2 (M $$ (0, 0)) (M $$ (m, 0))"
       by (simp add: euclid_ext2_def)
     have "\<exists>P. invertible_mat P \<and> P \<in> carrier_mat (m + n) (m + n) \<and> reduce_abs 0 m D M = P * M"  
     proof (rule reduce_abs_invertible_mat_case_m[OF _ _ m0 _ _ _ _ m_le_n n0 pquvd])
           show "M $$ (0, 0) \<noteq> 0" 
             using M_def mk_A'_not0 by blast
           define M' where  "M' = mat_of_rows n (map (Matrix.row M) [0..<m])"
           define M'' where "M'' = mat_of_rows n (map (Matrix.row M) [m..<m+n])"
           define A2 where "A2 = Matrix.mat (dim_row M) (dim_col M)
           (\<lambda>(i, k). if i = 0 then p * M $$ (0, k) + q * M $$ (m, k) 
                     else if i = m then u * M $$ (0, k) + v * M $$ (m, k)
                     else M $$ (i, k))"
           show M_M'_M'': "M = M' @\<^sub>r M''" unfolding M'_def M''_def            
             by (metis M append_rows_split carrier_matD le_add1)
           show M': "M' \<in> carrier_mat m n" unfolding M'_def by fastforce
           show M'': "M'' \<in> carrier_mat n n" unfolding M''_def by fastforce
           show "0 \<noteq> m" using m0 by simp
           show "A2 = Matrix.mat (dim_row M) (dim_col M)
           (\<lambda>(i, k). if i = 0 then p * M $$ (0, k) + q * M $$ (m, k) 
                     else if i = m then u * M $$ (0, k) + v * M $$ (m, k)
                     else M $$ (i, k))"
             (is "_ = ?rhs") using A A2_def by auto
           define xs' where "xs' =  filter (\<lambda>i. abs (A2 $$ (0,i)) > D) [0..<n]"
           define ys' where  "ys' = filter (\<lambda>i. abs (A2 $$ (m,i)) > D) [0..<n]"
           show "xs' = filter (\<lambda>i. abs (A2 $$ (0,i)) > D) [0..<n]" unfolding xs'_def by auto
           show "ys' = filter (\<lambda>i. abs (A2 $$ (m,i)) > D) [0..<n]" unfolding ys'_def by auto
           have M''D: "(M'' $$ (j, j) = D) \<and> (\<forall>j'\<in>{0..<n}-{j}. M'' $$ (j, j') = 0)"
             if jn: "j<n" and j0: "j>0" for j
           proof -
             have Ajm0: "A $$ (j+m,0) = 0"
             proof -
               have "A $$ (j+m,0) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (j+m-m,0)"
                 by (smt "1"(2) "1"(3) M M' M'' M_M'_M'' add.commute append_rows_def carrier_matD
                     diff_add_inverse2 index_mat_four_block index_one_mat(2) index_smult_mat(2)
                     le_add2 less_diff_conv2 n0 not_add_less2 that(1))
               also have "... = 0" using jn j0 by auto
               finally show ?thesis .
             qed
             have "M'' $$ (j, i) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (j,i)" if i_n: "i<n" for i
             proof (cases "A$$(0,0) = 0")
               case True 
               have "M'' $$ (j, i) = make_first_column_positive (swaprows 0 m A) $$ (j+m,i)"                
                 by (smt A'_def Groups.add_ac(2) M' M'' M_M'_M'' M_def True append.simps(1) 
                     append_rows_nth3 diff_add_inverse2 jn le_add2 local.non_zero_positions_xs_m
                     nat_add_left_cancel_less nth_Cons_0 that xs_empty)
               also have "... = A $$ (j+m,i)" using A jn j0 i_n Ajm0 by auto
               also have "... = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (j,i)"
                 by (smt A Groups.add_ac(2) add_mono_thms_linordered_field(1) append_rows_def A_def A'' i_n
                     carrier_matD index_mat_four_block(1,2) add_diff_cancel_right' not_add_less2 jn trans_less_add1)
               finally show ?thesis .            
             next
               case False
               have "A' = A" unfolding A'_def non_zero_positions_xs_m using False True by auto
               hence "M'' $$ (j, i) = make_first_column_positive A $$ (j+m,i)"                
                 by (smt m_le_n M' M'' M_M'_M'' M_def append_rows_nth2 jn nat_SN.compat that)                
               also have "... = A $$ (j+m,i)" using A jn j0 i_n Ajm0 by auto
               also have "... = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (j,i)"
                 by (smt A Groups.add_ac(2) add_mono_thms_linordered_field(1) append_rows_def A_def A'' i_n
                     carrier_matD index_mat_four_block(1,2) add_diff_cancel_right' not_add_less2 jn trans_less_add1)
               finally show ?thesis .
             qed                           
             thus ?thesis using jn j0 by auto
           qed
           have Am0D: "A$$(m,0) = D"
           proof -
             have "A$$(m,0) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (m-m,0)"
               by (smt "1"(2) "1"(3) M M' M'' M_M'_M'' append_rows_def carrier_matD
                   diff_less_mono2 diff_self_eq_0 index_mat_four_block index_one_mat(2) 
                   index_smult_mat(2) less_add_same_cancel1 n0 semiring_norm(137))
             also have "... = D" using m0 n0 by auto
             finally show ?thesis .
           qed
           hence S00D: "(swaprows 0 m A) $$ (0,0) = D" using n0 m0 A by auto
           have Sm00: "(swaprows 0 m A) $$ (m,0) = A$$(0,0)" using n0 m0 A by auto
           have M00D: "M $$ (0, 0) = D" if A00: "A$$(0,0) = 0"
           proof -
             have "M $$ (0,0) = (make_first_column_positive (swaprows 0 m A)) $$ (0,0)"
               unfolding M_def A'_def using A00
               by (simp add: True non_zero_positions_xs_m)
             also have "... = (if (swaprows 0 m A) $$ (0,0) < 0 then - (swaprows 0 m A) $$(0,0)
                               else (swaprows 0 m A) $$(0,0))"
               unfolding make_first_column_positive.simps using m0 n0 A by auto
             also have "... = (swaprows 0 m A) $$(0,0)" using S00D D0 by auto
             also have "... = D" using S00D by auto
             finally show ?thesis .
           qed
           have Mm00: "M $$ (m, 0) = 0" if A00: "A$$(0,0) = 0"
           proof -
             have "M $$ (m,0) = (make_first_column_positive (swaprows 0 m A)) $$ (m,0)"
               unfolding M_def A'_def using A00
               by (simp add: True non_zero_positions_xs_m)
             also have "... = (if (swaprows 0 m A) $$ (m,0) < 0 then - (swaprows 0 m A) $$(m,0)
                               else (swaprows 0 m A) $$(m,0))"
               unfolding make_first_column_positive.simps using m0 n0 A by auto
             also have "... = (swaprows 0 m A) $$(m,0)" using Sm00 A00 D0 by auto
             also have "... = 0" using Sm00 A00 by auto
             finally show ?thesis .
           qed
           have M000: "M $$ (0, 0) = abs (A$$(0,0))" if A00: "A$$(0,0) \<noteq> 0"
           proof -
             have "M $$ (0,0) = (make_first_column_positive A) $$ (0,0)"
               unfolding M_def A'_def using A00
               by (simp add: True non_zero_positions_xs_m)
             also have "... = (if A $$ (0,0) < 0 then - A $$(0,0)
                               else A $$(0,0))"
               unfolding make_first_column_positive.simps using m0 n0 A by auto
             also have "... = abs (A$$(0,0))" using Sm00 A00 by auto
             finally show ?thesis .
           qed
           have Mm0D: "M $$ (m, 0) = D" if A00: "A $$ (0,0) \<noteq> 0"
           proof -
             have "M $$ (m,0) = (make_first_column_positive A) $$ (m,0)"
               unfolding M_def A'_def using A00
               by (simp add: True non_zero_positions_xs_m)
             also have "... = (if A $$ (m,0) < 0 then - A $$(m,0)
                               else A $$(m,0))"
               unfolding make_first_column_positive.simps using m0 n0 A by auto
             also have "... = A $$(m,0)" using S00D D0 Am0D by auto
             also have "... = D" using Am0D D0 by auto
             finally show ?thesis .
           qed
           have "0 \<notin> set xs'"
           proof -
             have "A2 $$ (0,0) = p * M $$ (0, 0) + q * M $$ (m, 0)" 
               using A A2_def n0 M by auto
             also have "... = gcd (M $$ (0, 0)) (M $$ (m, 0))"
               by (metis euclid_ext2_works(1,2) pquvd)
             also have "abs ... \<le> D" using M00D Mm00 M000 Mm0D using gcd_0_int D0 by fastforce
             finally have "abs (A2 $$ (0,0)) \<le> D" .
             thus ?thesis unfolding xs'_def using D0 by auto
           qed
           thus "\<forall>j\<in>set xs'. j<n \<and> (M'' $$ (j, j) = D) \<and> (\<forall>j'\<in>{0..<n}-{j}. M'' $$ (j, j') = 0)"  
             using M''D xs'_def by auto
           have "0 \<notin> set ys'"
           proof -
             have "A2 $$ (m,0) = u * M $$ (0, 0) + v * M $$ (m, 0)"
               using A A2_def n0 m0 M by auto
             also have "... = - M $$ (m, 0) div gcd (M $$ (0, 0)) (M $$ (m, 0)) * M $$ (0, 0) 
                 + M $$ (0, 0) div gcd (M $$ (0, 0)) (M $$ (m, 0)) * M $$ (m, 0) "
               by (simp add: euclid_ext2_works[OF pquvd[symmetric]])
             also have "... = 0" using M00D Mm00 M000 Mm0D
               by (smt dvd_div_mult_self euclid_ext2_works(3) euclid_ext2_works(5)
                   more_arith_simps(11) mult.commute mult_minus_left pquvd semiring_gcd_class.gcd_dvd1)
             finally have "A2 $$ (m,0) = 0" .
             thus ?thesis unfolding ys'_def using D0 by auto
           qed
           thus "\<forall>j\<in>set ys'. j<n \<and> (M'' $$ (j, j) = D) \<and> (\<forall>j'\<in>{0..<n}-{j}. M'' $$ (j, j') = 0)"
             using M''D ys'_def by auto   
         qed (insert D0)
         then show ?thesis using rw by auto
   next
     case False
     show ?thesis
       by (unfold M_def, rule reduce_below_abs_invertible_mat_case_m[OF M' m0 n0 M_M'D[OF False] 
           mk_A'_not0 m_le_n d_xs all_less_m D0])
   qed
    
   from this obtain Q where inv_Q: "invertible_mat Q" and Q: "Q \<in> carrier_mat (m + n) (m + n)"
     and reduce_QM: "reduce_below_abs 0 (xs @ [m]) D M = Q * M" by blast
   have "\<exists>R. invertible_mat R 
     \<and> R \<in> carrier_mat (dim_row A') (dim_row A') \<and> M = R * A'"
     by (unfold M_def, rule make_first_column_positive_invertible)
   from this obtain R where inv_R: "invertible_mat R"
     and R: "R \<in> carrier_mat (dim_row A') (dim_row A')" and M_RA': "M = R * A'" by blast
   have "\<exists>P. P \<in> carrier_mat (m + n) (m + n) \<and> invertible_mat P \<and> A' = P * A" 
     by (rule A'_swaprows_invertible_mat[OF A A'_def non_zero_positions_def],
         insert non_zero_positions_xs_m n m0, auto)
   from this obtain S where inv_S: "invertible_mat S"
    and S: "S \<in> carrier_mat (dim_row A) (dim_row A)" and A'_SA: "A' = S * A" 
     using A by auto
   have "(P'*Q*R*S) \<in> carrier_mat (m+n) (m+n)" using P' Q R S A' A by auto
   moreover have "FindPreHNF abs_flag D A = (P'*Q*R*S) * A" using Find_P'_reduceM reduce_QM 
     unfolding  M_RA' A'_SA M_def
     by (smt A' A'_SA P' Q R S assoc_mult_mat carrier_matD carrier_mat_triv index_mult_mat(2,3) 
         non_zero_positions_xs_m)
   moreover have "invertible_mat (P'*Q*R*S)" using inv_P' inv_Q inv_R inv_S using P' Q R S A' A 
     by (metis carrier_matD carrier_mat_triv index_mult_mat(2,3) invertible_mult_JNF)
   ultimately have exists_inv: "\<exists>P. P \<in> carrier_mat (m + n) (m + n) \<and> invertible_mat P 
     \<and> FindPreHNF abs_flag D A = P * A" by blast
   moreover have "echelon_form_JNF (FindPreHNF abs_flag D A)" 
   proof (rule echelon_form_four_block_mat[OF A'_UL A'_UR sub_PreHNF'   ])
     show "FindPreHNF abs_flag D A = four_block_mat A'_UL A'_UR (0\<^sub>m (m + n - 1) 1) sub_PreHNF" 
       using A'_DL0 FindPreHNF_as_fbm sub_PreHNF sub_PreHNF' by auto
     have "A'_UL $$ (0, 0) = ?R $$ (0,0)"
       by (metis (mono_tags, lifting) A A'_DR A'_UL Find_P'_reduceM M_def 
           \<open>FindPreHNF abs_flag D A = P' * Q * R * S * A\<close> add_Suc_right add_sign_intros(2) carrier_matD fbm_R
           index_mat_four_block(1,3) index_mult_mat(3) m0 n0 plus_1_eq_Suc
           zero_less_one_class.zero_less_one)
     also have "... \<noteq> 0"
     proof (cases "xs=[]")
       case True
       have "?R $$ (0,0) = reduce_abs 0 m D M $$ (0,0)"
         unfolding non_zero_positions_xs_m True M_def by simp
       also have "... \<noteq> 0"
         by (metis D_not0 M M_def add_pos_pos less_add_same_cancel1 m0 mk_A'_not0 n0 reduce_not0)
       finally show ?thesis .
     next
       case False
       show ?thesis
         by (unfold non_zero_positions_xs_m,
           rule reduce_below_abs_not0_case_m[OF M' m0 n0 M_M'D[OF False] mk_A'_not0 m_le_n all_less_m D_not0])     
     qed       
     finally show "A'_UL $$ (0, 0) \<noteq> 0" .
   qed (insert mn n hyp, auto)
   ultimately show ?thesis by blast
   next
     case False
       hence A'_split: "(A'_UL, A'_UR, A'_DL, A'_DR) 
     = split_block (reduce_below 0 non_zero_positions D (make_first_column_positive A')) 1 1"   using A'_split by auto
     let ?R = "reduce_below 0 non_zero_positions D (make_first_column_positive A')"
    have fbm_R: "four_block_mat A'_UL A'_UR A'_DL A'_DR 
      = reduce_below 0 non_zero_positions D (make_first_column_positive A')"
     by (rule split_block(5)[symmetric, OF A'_split[symmetric], of "m+n-1" "n-1"], insert A' n, auto)
   have A'_DL0: "A'_DL = (0\<^sub>m (m + (n - 1)) 1)"   
   proof (rule eq_matI)
     show "dim_row A'_DL = dim_row (0\<^sub>m (m + (n - 1)) 1)"
       and "dim_col A'_DL = dim_col (0\<^sub>m (m + (n - 1)) 1)" using A'_DL by auto    
     fix i j assume i: "i < dim_row (0\<^sub>m (m + (n - 1)) 1)" and j: "j < dim_col (0\<^sub>m (m + (n - 1)) 1)"
     have j0: "j=0" using j by auto
     have "0 = ?R $$ (i+1,j)"
     proof (unfold M_def non_zero_positions_xs_m j0, 
         rule reduce_below_0_case_m_make_first_column_positive[symmetric,
           OF A'' m0 n0 A_def m_le_n _  d_xs all_less_m _ _ D0 _ ])
       show "A' = (if A $$ (0, 0) \<noteq> 0 then A else let i = (xs @ [m]) ! 0 in swaprows 0 i A)"
         using A'_def non_zero_positions_def non_zero_positions_xs_m by presburger
       show "xs @ [m] = filter (\<lambda>i. A $$ (i, 0) \<noteq> 0) [1..<dim_row A]"
         using A'_def non_zero_positions_def non_zero_positions_xs_m by presburger
     qed (insert i n0, auto)
     also have "... = four_block_mat A'_UL A'_UR A'_DL A'_DR $$ (i+1,j)" unfolding fbm_R ..
     also have "... = (if i+1 < dim_row A'_UL then if j < dim_col A'_UL 
             then A'_UL $$ (i+1, j) else A'_UR $$ (i+1, j - dim_col A'_UL)
             else if j < dim_col A'_UL then A'_DL $$ (i+1 - dim_row A'_UL, j)
             else A'_DR $$ (i+1 - dim_row A'_UL, j - dim_col A'_UL))"
       by (rule index_mat_four_block, insert A'_UL A'_DR i j, auto)
     also have "... = A'_DL $$ (i, j)" using A'_UL A'_UR i j by auto
     finally show "A'_DL $$ (i, j) = 0\<^sub>m (m + (n - 1)) 1 $$ (i, j)" using i j by auto
   qed
 
   let ?A'_DR_m = "mat_of_rows (n-1) [Matrix.row A'_DR i. i \<leftarrow> [0..<m]]"
   have A'_DR_m: "?A'_DR_m \<in> carrier_mat m (n-1)" by auto
   have A'DR_A'DR_m_D: "A'_DR = ?A'_DR_m @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m (n - 1)"
   proof (rule eq_matI)
     show dr: "dim_row A'_DR = dim_row (?A'_DR_m @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m (n - 1))" 
       by (metis A'_DR A'_DR_m append_rows_def carrier_matD(1) index_mat_four_block(2) 
           index_one_mat(2) index_smult_mat(2) index_zero_mat(2))
     show dc: "dim_col A'_DR = dim_col (?A'_DR_m @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m (n - 1))"
       by (metis A'_DR A'_DR_m add.comm_neutral append_rows_def
           carrier_matD(2) index_mat_four_block(3) index_zero_mat(3))  
     fix i j assume i: "i < dim_row(?A'_DR_m @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m (n - 1))"
       and j: "j<dim_col (?A'_DR_m @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m (n - 1))"
     have jn1: "j<n-1" using dc j A'_DR by auto
     show "A'_DR $$ (i,j) = (?A'_DR_m @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m (n - 1)) $$ (i,j)"
     proof (cases "i<m")
       case True
       have "A'_DR $$ (i,j) = ?A'_DR_m $$ (i,j)"
         by (metis A'_DR A'_DR_m True dc carrier_matD(1) carrier_matD(2) j le_add1 
             map_first_rows_index mat_of_rows_carrier(2) mat_of_rows_index)
       also have "... = (?A'_DR_m @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m (n - 1)) $$ (i,j)"
         by (metis (mono_tags, lifting) A'_DR A'_DR_m True append_rows_def 
             carrier_matD dc i index_mat_four_block j)
       finally show ?thesis .
     next
       case False note i_ge_m = False
       let ?reduce_below = "reduce_below 0 non_zero_positions D (make_first_column_positive A')"
       have 1: "(?A'_DR_m @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m (n - 1)) $$ (i,j) = (D \<cdot>\<^sub>m 1\<^sub>m (n - 1)) $$ (i-m,j)"
         by (smt A'_DR A'_DR_m False append_rows_nth carrier_matD carrier_mat_triv dc dr i
             index_one_mat(2) index_one_mat(3) index_smult_mat(2,3) j)
       have "?reduce_below = four_block_mat A'_UL A'_UR A'_DL A'_DR" using fbm_R ..
       also have "... $$ (i+1,j+1) = (if i+1 < dim_row A'_UL then if j+1 < dim_col A'_UL 
               then A'_UL $$ (i+1, j+1) else A'_UR $$ (i+1, j+1 - dim_col A'_UL)
               else if j+1 < dim_col A'_UL then A'_DL $$ (i+1 - dim_row A'_UL, j+1)
               else A'_DR $$ (i+1 - dim_row A'_UL, j+1 - dim_col A'_UL))"
         by (rule index_mat_four_block, insert i j A'_UL A'_DR dr dc, auto)
       also have "... = A'_DR $$ (i,j)" using A'_UL by auto
       finally have 2: "?reduce_below $$ (i+1,j+1) = A'_DR $$ (i,j)" .
       show ?thesis 
       proof (cases "xs = []")
         case True note xs_empty = True
         have i1_m: "i + 1 \<noteq> m" 
           using False less_add_one by blast
         have j1n: "j+1<n"
           using jn1 less_diff_conv by blast
         have i1_mn: "i+1<m + n"
           using i i_ge_m
           by (metis A'_DR carrier_matD(1) dr less_diff_conv sub_PreHNF sub_PreHNF')
         have "?reduce_below = reduce 0 m D M"
           unfolding non_zero_positions_xs_m xs_empty M_def by auto
         also have "... $$ (i+1,j+1) = M $$ (i+1, j+1)"
           by (rule reduce_preserves[OF M j1n _ i1_m _ i1_mn], insert M_def mk_A'_not0, auto)         
         also have "... = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ ((i+1)-m, j+1)"
         proof (cases "A $$ (0,0) = 0")
           case True
           let ?S = "(swaprows 0 m A)"
           have S: "?S \<in> carrier_mat (m+n) n" using A by auto
           have Si10: "?S $$ (i+1,0) = 0"
           proof -
             have "?S $$ (i+1,0) = A $$ (i+1,0)" using i1_m n0 i1_mn S by auto
             also have "... = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i+1 - m,0)"
               by (smt A_def A'' A i_ge_m append_rows_def carrier_matD diff_add_inverse2 i1_mn 
                   index_mat_four_block less_imp_diff_less n0)
             also have "... = 0" using i_ge_m n0 i1_mn by auto
             finally show ?thesis .
           qed
           have "M $$ (i+1, j+1) = (make_first_column_positive ?S) $$ (i+1,j+1)"
             by (simp add: A'_def M_def True non_zero_positions_xs_m xs_empty)
           also have "... = (if ?S $$ (i+1,0) < 0 then - ?S $$ (i+1,j+1) else ?S $$ (i+1,j+1))" 
             unfolding make_first_column_positive.simps using S i1_mn j1n by auto
           also have "... = ?S $$ (i+1,j+1)" using Si10 by auto
           also have "... = A $$ (i+1,j+1)" using i1_m n0 i1_mn S jn1 by auto
           also have "... = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i+1 - m,j+1)"
             by (smt A_def A'' A i_ge_m append_rows_def carrier_matD i1_mn index_mat_four_block(1,3)
                 index_one_mat(2) index_smult_mat(2) index_zero_mat(2) j1n less_imp_diff_less add_diff_cancel_right')
           finally show ?thesis .
         next
           case False         
           have Ai10: "A $$ (i+1,0) = 0"
           proof -
             have "A $$ (i+1,0) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i+1 - m,0)"
               by (smt A_def A'' A i_ge_m append_rows_def carrier_matD diff_add_inverse2 i1_mn 
                   index_mat_four_block less_imp_diff_less n0)
             also have "... = 0" using i_ge_m n0 i1_mn by auto
             finally show ?thesis .
           qed          
           have "M $$ (i+1, j+1) = (make_first_column_positive A) $$ (i+1,j+1)"
             by (simp add: A'_def M_def False True non_zero_positions_xs_m)
           also have "... = (if A $$ (i+1,0) < 0 then - A $$ (i+1,j+1) else A $$ (i+1,j+1))" 
             unfolding make_first_column_positive.simps using A i1_mn j1n by auto
           also have "... = A $$ (i+1,j+1)" using Ai10 by auto
           also have "... = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i+1 - m,j+1)"
             by (smt A_def A'' A i_ge_m append_rows_def carrier_matD i1_mn index_mat_four_block(1,3)
                 index_one_mat(2) index_smult_mat(2) index_zero_mat(2) j1n less_imp_diff_less add_diff_cancel_right')
           finally show ?thesis .
         qed
         also have "... = D * (1\<^sub>m n) $$ ((i+1)-m, j+1)"
           by (rule index_smult_mat, insert i jn1 A'_DR False dr, auto)            
         also have "... = D *(1\<^sub>m (n - 1)) $$ (i-m,j)" using dc dr i j A'_DR i_ge_m
           by (smt Nat.add_diff_assoc2 carrier_matD(1) index_one_mat(1) jn1 less_diff_conv 
               linorder_not_less add_diff_cancel_right' add_diff_cancel_right' add_diff_cancel_left')
         also have "... = (D \<cdot>\<^sub>m 1\<^sub>m (n - 1)) $$ (i-m,j)"
           by (rule index_smult_mat[symmetric], insert i jn1 A'_DR False dr, auto)
         finally show ?thesis using 1 2 by auto
       next
         case False     
       have "?reduce_below $$ (i+1, j+1) = M $$ (i+1, j+1)"
       proof (unfold non_zero_positions_xs_m M_def,
           rule reduce_below_preserves_case_m[OF M' m0 _ M_M'D mk_A'_not0 m_le_n _ d_xs all_less_m _ _ _ D0])            
         show "j + 1 < n" using jn1 by auto
         show "i + 1 \<notin> set xs" using all_less_m i_ge_m non_zero_positions_xs_m by auto
         show "i + 1 \<noteq> 0" by auto
         show " i + 1 < m + n" using i_ge_m i dr A'_DR by auto
         show " i + 1 \<noteq> m" using i_ge_m by auto
       qed (insert False)
       also have "... = (?M' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n) $$ (i+1, j+1)" unfolding M_def using False M_M'D by argo
       also have "... = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ ((i+1)-m, j+1)"
       proof -
         have f1: "1 + j < n"
           by (metis Groups.add_ac(2) jn1 less_diff_conv)
         have f2: "\<forall>n. \<not> n + i < m"
           by (meson i_ge_m linorder_not_less nat_SN.compat not_add_less2)
         have "i < m + (n - 1)"
           by (metis (no_types) A'_DR carrier_matD(1) dr i)
         then have "1 + i < m + n"
           using f1 by linarith
         then show ?thesis
           using f2 f1 by (metis (no_types) Groups.add_ac(2) M' append_rows_def carrier_matD(1) 
               dim_col_mat(1) index_mat_four_block(1) index_one_mat(2) index_smult_mat(2) 
               index_zero_mat(2,3) mat_of_rows_def nat_arith.rule0)
       qed
       also have "... = D * (1\<^sub>m n) $$ ((i+1)-m, j+1)"
         by (rule index_smult_mat, insert i jn1 A'_DR False dr, auto)            
       also have "... = D *(1\<^sub>m (n - 1)) $$ (i-m,j)" using dc dr i j A'_DR i_ge_m
         by (smt Nat.add_diff_assoc2 carrier_matD(1) index_one_mat(1) jn1 less_diff_conv 
             linorder_not_less add_diff_cancel_right' add_diff_cancel_left')
       also have "... = (D \<cdot>\<^sub>m 1\<^sub>m (n - 1)) $$ (i-m,j)"
         by (rule index_smult_mat[symmetric], insert i jn1 A'_DR False dr, auto)
       finally have 3: "?reduce_below $$ (i+1,j+1) = (D \<cdot>\<^sub>m 1\<^sub>m (n - 1)) $$ (i-m,j)" .            
       show ?thesis using 1 2 3 by presburger
     qed              
   qed
 qed
   let ?A'_DR_n = "mat_of_rows (n - 1) (map (Matrix.row A'_DR) [0..<n - 1])"
   have hyp: "\<exists>P. P\<in>carrier_mat (m + (n-1)) (m + (n-1)) \<and> invertible_mat P \<and> sub_PreHNF = P * A'_DR 
   \<and> echelon_form_JNF sub_PreHNF" 
   proof (cases "2 \<le> n - 1")
     case True
     show ?thesis
       by (unfold sub_PreHNF_def, rule "1.hyps"[OF _ _ _ non_zero_positions_def A'_def _ _ _ _ _])
          (insert A n D0 m_le_n True A'DR_A'DR_m_D A A'_split False, auto)
   next
     case False
     have "\<exists>P. P\<in>carrier_mat (m + (n-1)) (m + (n-1)) \<and> invertible_mat P \<and> sub_PreHNF = P * A'_DR"
       by (unfold sub_PreHNF_def, rule FindPreHNF_invertible_mat_mx2
           [OF A'DR_A'DR_m_D A'_DR_m _ _ D0 _])
           (insert False m_le_n n0 m0 "1"(4), auto)
     moreover have "echelon_form_JNF sub_PreHNF" unfolding sub_PreHNF_def 
       by (rule FindPreHNF_echelon_form_mx1[OF A'DR_A'DR_m_D A'_DR_m _ D0 _],
           insert False n0 m_le_n, auto) 
     ultimately show ?thesis by simp
   qed  
   from this obtain P where P: "P \<in> carrier_mat (m + (n - 1)) (m + (n - 1))"
     and inv_P: "invertible_mat P" and sub_PreHNF_P_A'_DR: "sub_PreHNF = P * A'_DR" by blast
   define P' where "P' = (four_block_mat (1\<^sub>m 1) (0\<^sub>m 1 (m+(n-1))) (0\<^sub>m (m+(n-1)) 1) P)"
   have P': "P' \<in> carrier_mat (m+n) (m+n)" 
   proof -
     have "P' \<in> carrier_mat (1 + (m+(n-1))) (1 + (m+(n-1))) "
       unfolding P'_def by (rule four_block_carrier_mat[OF _ P], simp) 
     thus ?thesis using n by auto
   qed
   have inv_P': "invertible_mat P'" 
     unfolding P'_def by (rule invertible_mat_four_block_mat_lower_right[OF P inv_P])
   have dr_A2: "dim_row A \<ge> 2" using A m0 n by auto
   have dc_A2: "dim_col A \<ge> 2" using n A by blast
   have *: "(dim_col A = 0) = False" using dc_A2 by auto
   have FindPreHNF_as_fbm: "FindPreHNF abs_flag D A = four_block_mat A'_UL A'_UR A'_DL sub_PreHNF" 
     unfolding FindPreHNF.simps[of abs_flag D A] using A'_split mn n A dr_A2 dc_A2 False
     unfolding Let_def sub_PreHNF_def M_def A'_def non_zero_positions_def *    
     by (smt (z3) linorder_not_less split_conv)
   also have "... = P' * (reduce_below 0 non_zero_positions D M)"
   proof -
     have "P' * (reduce_below 0 non_zero_positions D M) 
       = four_block_mat (1\<^sub>m 1) (0\<^sub>m 1 (m + (n - 1))) (0\<^sub>m (m + (n - 1)) 1) P 
       * four_block_mat A'_UL A'_UR A'_DL A'_DR"
       unfolding P'_def fbm_R[unfolded M_def[symmetric], symmetric] ..
     also have "... = four_block_mat 
             ((1\<^sub>m 1) * A'_UL + (0\<^sub>m 1 (m + (n - 1)) * A'_DL)) 
             ((1\<^sub>m 1) * A'_UR + (0\<^sub>m 1 (m + (n - 1))) * A'_DR) 
             ((0\<^sub>m (m + (n - 1)) 1) * A'_UL + P * A'_DL) 
             ((0\<^sub>m (m + (n - 1)) 1) * A'_UR + P * A'_DR)" 
       by (rule mult_four_block_mat[OF _ _ _ P A'_UL A'_UR A'_DL A'_DR], auto)
     also have "... = four_block_mat A'_UL A'_UR (P * A'_DL) (P * A'_DR)"
       by (rule cong_four_block_mat, insert A'_UL A'_UR A'_DL A'_DR P, auto)
     also have "... = four_block_mat A'_UL A'_UR (0\<^sub>m (m + (n - 1)) 1) sub_PreHNF"
       unfolding A'_DL0 sub_PreHNF_P_A'_DR using P by simp
     also have "... = four_block_mat A'_UL A'_UR A'_DL sub_PreHNF"
       unfolding A'_DL0 by simp
     finally show ?thesis ..
   qed
   finally have Find_P'_reduceM: "FindPreHNF abs_flag D A =  P' * (reduce_below 0 non_zero_positions D M)" .
   have "\<exists>Q. invertible_mat Q \<and> Q \<in> carrier_mat (m + n) (m + n) 
     \<and> reduce_below 0 (xs @ [m]) D M = Q * M"
   proof (cases "xs = []")
     case True note xs_empty = True
     have rw: "reduce_below 0 (xs @ [m]) D M = reduce 0 m D M" using True by auto
     obtain p q u v d where pquvd: "(p, q, u, v, d) = euclid_ext2 (M $$ (0, 0)) (M $$ (m, 0))"
       by (simp add: euclid_ext2_def)
     have "\<exists>P. invertible_mat P \<and> P \<in> carrier_mat (m + n) (m + n) \<and> reduce 0 m D M = P * M"  
     proof (rule reduce_invertible_mat_case_m[OF _ _ m0 _ _ _ _ m_le_n n0 pquvd])
           show "M $$ (0, 0) \<noteq> 0" 
             using M_def mk_A'_not0 by blast
           define M' where  "M' = mat_of_rows n (map (Matrix.row M) [0..<m])"
           define M'' where "M'' = mat_of_rows n (map (Matrix.row M) [m..<m+n])"
           define A2 where "A2 = Matrix.mat (dim_row M) (dim_col M)
           (\<lambda>(i, k). if i = 0 then p * M $$ (0, k) + q * M $$ (m, k) 
                     else if i = m then u * M $$ (0, k) + v * M $$ (m, k)
                     else M $$ (i, k))"
           show M_M'_M'': "M = M' @\<^sub>r M''" unfolding M'_def M''_def            
             by (metis M append_rows_split carrier_matD le_add1)
           show M': "M' \<in> carrier_mat m n" unfolding M'_def by fastforce
           show M'': "M'' \<in> carrier_mat n n" unfolding M''_def by fastforce
           show "0 \<noteq> m" using m0 by simp
           show "A2 = Matrix.mat (dim_row M) (dim_col M)
           (\<lambda>(i, k). if i = 0 then p * M $$ (0, k) + q * M $$ (m, k) 
                     else if i = m then u * M $$ (0, k) + v * M $$ (m, k)
                     else M $$ (i, k))"
             (is "_ = ?rhs") using A A2_def by auto
           define xs' where "xs' = [1..<n]"
           define ys' where  "ys' = [1..<n]"
           show "xs' = [1..<n]" unfolding xs'_def by auto
           show "ys' = [1..<n]" unfolding ys'_def by auto
           have M''D: "(M'' $$ (j, j) = D) \<and> (\<forall>j'\<in>{0..<n}-{j}. M'' $$ (j, j') = 0)"
             if jn: "j<n" and j0: "j>0" for j
           proof -
             have Ajm0: "A $$ (j+m,0) = 0"
             proof -
               have "A $$ (j+m,0) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (j+m-m,0)"
                 by (smt "1"(2) "1"(3) M M' M'' M_M'_M'' add.commute append_rows_def carrier_matD
                     diff_add_inverse2 index_mat_four_block index_one_mat(2) index_smult_mat(2)
                     le_add2 less_diff_conv2 n0 not_add_less2 that(1))
               also have "... = 0" using jn j0 by auto
               finally show ?thesis .
             qed
             have "M'' $$ (j, i) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (j,i)" if i_n: "i<n" for i
             proof (cases "A$$(0,0) = 0")
               case True 
               have "M'' $$ (j, i) = make_first_column_positive (swaprows 0 m A) $$ (j+m,i)"                
                 by (smt A'_def Groups.add_ac(2) M' M'' M_M'_M'' M_def True append.simps(1) 
                     append_rows_nth3 diff_add_inverse2 jn le_add2 local.non_zero_positions_xs_m
                     nat_add_left_cancel_less nth_Cons_0 that xs_empty)
               also have "... = A $$ (j+m,i)" using A jn j0 i_n Ajm0 by auto
               also have "... = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (j,i)"
                 by (smt A Groups.add_ac(2) add_mono_thms_linordered_field(1) append_rows_def A_def A'' i_n
                     carrier_matD index_mat_four_block(1,2) add_diff_cancel_right' not_add_less2 jn trans_less_add1)
               finally show ?thesis .            
             next
               case False
               have "A' = A" unfolding A'_def non_zero_positions_xs_m using False True by auto
               hence "M'' $$ (j, i) = make_first_column_positive A $$ (j+m,i)"                
                 by (smt m_le_n M' M'' M_M'_M'' M_def append_rows_nth2 jn nat_SN.compat that)                
               also have "... = A $$ (j+m,i)" using A jn j0 i_n Ajm0 by auto
               also have "... = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (j,i)"
                 by (smt A Groups.add_ac(2) add_mono_thms_linordered_field(1) append_rows_def A_def A'' i_n
                     carrier_matD index_mat_four_block(1,2) add_diff_cancel_right' not_add_less2 jn trans_less_add1)
               finally show ?thesis .
             qed                           
             thus ?thesis using jn j0 by auto
           qed
           have Am0D: "A$$(m,0) = D"
           proof -
             have "A$$(m,0) = (D \<cdot>\<^sub>m 1\<^sub>m n) $$ (m-m,0)"
               by (smt "1"(2) "1"(3) M M' M'' M_M'_M'' append_rows_def carrier_matD
                   diff_less_mono2 diff_self_eq_0 index_mat_four_block index_one_mat(2) 
                   index_smult_mat(2) less_add_same_cancel1 n0 semiring_norm(137))
             also have "... = D" using m0 n0 by auto
             finally show ?thesis .
           qed
           hence S00D: "(swaprows 0 m A) $$ (0,0) = D" using n0 m0 A by auto
           have Sm00: "(swaprows 0 m A) $$ (m,0) = A$$(0,0)" using n0 m0 A by auto
           have M00D: "M $$ (0, 0) = D" if A00: "A$$(0,0) = 0"
           proof -
             have "M $$ (0,0) = (make_first_column_positive (swaprows 0 m A)) $$ (0,0)"
               unfolding M_def A'_def using A00
               by (simp add: True non_zero_positions_xs_m)
             also have "... = (if (swaprows 0 m A) $$ (0,0) < 0 then - (swaprows 0 m A) $$(0,0)
                               else (swaprows 0 m A) $$(0,0))"
               unfolding make_first_column_positive.simps using m0 n0 A by auto
             also have "... = (swaprows 0 m A) $$(0,0)" using S00D D0 by auto
             also have "... = D" using S00D by auto
             finally show ?thesis .
           qed
           have Mm00: "M $$ (m, 0) = 0" if A00: "A$$(0,0) = 0"
           proof -
             have "M $$ (m,0) = (make_first_column_positive (swaprows 0 m A)) $$ (m,0)"
               unfolding M_def A'_def using A00
               by (simp add: True non_zero_positions_xs_m)
             also have "... = (if (swaprows 0 m A) $$ (m,0) < 0 then - (swaprows 0 m A) $$(m,0)
                               else (swaprows 0 m A) $$(m,0))"
               unfolding make_first_column_positive.simps using m0 n0 A by auto
             also have "... = (swaprows 0 m A) $$(m,0)" using Sm00 A00 D0 by auto
             also have "... = 0" using Sm00 A00 by auto
             finally show ?thesis .
           qed
           have M000: "M $$ (0, 0) = abs (A$$(0,0))" if A00: "A$$(0,0) \<noteq> 0"
           proof -
             have "M $$ (0,0) = (make_first_column_positive A) $$ (0,0)"
               unfolding M_def A'_def using A00
               by (simp add: True non_zero_positions_xs_m)
             also have "... = (if A $$ (0,0) < 0 then - A $$(0,0)
                               else A $$(0,0))"
               unfolding make_first_column_positive.simps using m0 n0 A by auto
             also have "... = abs (A$$(0,0))" using Sm00 A00 by auto
             finally show ?thesis .
           qed
           have Mm0D: "M $$ (m, 0) = D" if A00: "A $$ (0,0) \<noteq> 0"
           proof -
             have "M $$ (m,0) = (make_first_column_positive A) $$ (m,0)"
               unfolding M_def A'_def using A00
               by (simp add: True non_zero_positions_xs_m)
             also have "... = (if A $$ (m,0) < 0 then - A $$(m,0)
                               else A $$(m,0))"
               unfolding make_first_column_positive.simps using m0 n0 A by auto
             also have "... = A $$(m,0)" using S00D D0 Am0D by auto
             also have "... = D" using Am0D D0 by auto
             finally show ?thesis .
           qed
           have "0 \<notin> set xs'"
           proof -
             have "A2 $$ (0,0) = p * M $$ (0, 0) + q * M $$ (m, 0)" 
               using A A2_def n0 M by auto
             also have "... = gcd (M $$ (0, 0)) (M $$ (m, 0))"
               by (metis euclid_ext2_works(1,2) pquvd)
             also have "abs ... \<le> D" using M00D Mm00 M000 Mm0D using gcd_0_int D0 by fastforce
             finally have "abs (A2 $$ (0,0)) \<le> D" .
             thus ?thesis unfolding xs'_def using D0 by auto
           qed
           thus "\<forall>j\<in>set xs'. j<n \<and> (M'' $$ (j, j) = D) \<and> (\<forall>j'\<in>{0..<n}-{j}. M'' $$ (j, j') = 0)"  
             using M''D xs'_def by auto
           have "0 \<notin> set ys'"
           proof -
             have "A2 $$ (m,0) = u * M $$ (0, 0) + v * M $$ (m, 0)"
               using A A2_def n0 m0 M by auto
             also have "... = - M $$ (m, 0) div gcd (M $$ (0, 0)) (M $$ (m, 0)) * M $$ (0, 0) 
                 + M $$ (0, 0) div gcd (M $$ (0, 0)) (M $$ (m, 0)) * M $$ (m, 0) "
               by (simp add: euclid_ext2_works[OF pquvd[symmetric]])
             also have "... = 0" using M00D Mm00 M000 Mm0D
               by (smt dvd_div_mult_self euclid_ext2_works(3) euclid_ext2_works(5)
                   more_arith_simps(11) mult.commute mult_minus_left pquvd semiring_gcd_class.gcd_dvd1)
             finally have "A2 $$ (m,0) = 0" .
             thus ?thesis unfolding ys'_def using D0 by auto
           qed
           thus "\<forall>j\<in>set ys'. j<n \<and> (M'' $$ (j, j) = D) \<and> (\<forall>j'\<in>{0..<n}-{j}. M'' $$ (j, j') = 0)"
             using M''D ys'_def by auto   
           show "M $$ (m, 0) \<in> {0,D}" using Mm00 Mm0D by blast
           show " M $$ (m, 0) = 0 \<longrightarrow> M $$ (0, 0) = D"  using Mm00 Mm0D D_not0 M00D by blast          
         qed (insert D0)
         then show ?thesis using rw by auto
   next
     case False
     show ?thesis
       by (unfold M_def, rule reduce_below_invertible_mat_case_m[OF M' m0 n0 M_M'D[OF False] 
           mk_A'_not0 m_le_n d_xs all_less_m D0])
   qed
    
   from this obtain Q where inv_Q: "invertible_mat Q" and Q: "Q \<in> carrier_mat (m + n) (m + n)"
     and reduce_QM: "reduce_below 0 (xs @ [m]) D M = Q * M" by blast
   have "\<exists>R. invertible_mat R 
     \<and> R \<in> carrier_mat (dim_row A') (dim_row A') \<and> M = R * A'"
     by (unfold M_def, rule make_first_column_positive_invertible)
   from this obtain R where inv_R: "invertible_mat R"
     and R: "R \<in> carrier_mat (dim_row A') (dim_row A')" and M_RA': "M = R * A'" by blast
   have "\<exists>P. P \<in> carrier_mat (m + n) (m + n) \<and> invertible_mat P \<and> A' = P * A" 
     by (rule A'_swaprows_invertible_mat[OF A A'_def non_zero_positions_def],
         insert non_zero_positions_xs_m n m0, auto)
   from this obtain S where inv_S: "invertible_mat S"
    and S: "S \<in> carrier_mat (dim_row A) (dim_row A)" and A'_SA: "A' = S * A" 
     using A by auto
   have "(P'*Q*R*S) \<in> carrier_mat (m+n) (m+n)" using P' Q R S A' A by auto
   moreover have "FindPreHNF abs_flag D A = (P'*Q*R*S) * A" using Find_P'_reduceM reduce_QM 
     unfolding  M_RA' A'_SA M_def
     by (smt A' A'_SA P' Q R S assoc_mult_mat carrier_matD carrier_mat_triv index_mult_mat(2,3) 
         non_zero_positions_xs_m)
   moreover have "invertible_mat (P'*Q*R*S)" using inv_P' inv_Q inv_R inv_S using P' Q R S A' A 
     by (metis carrier_matD carrier_mat_triv index_mult_mat(2,3) invertible_mult_JNF)
   ultimately have exists_inv: "\<exists>P. P \<in> carrier_mat (m + n) (m + n) \<and> invertible_mat P 
     \<and> FindPreHNF abs_flag D A = P * A" by blast
   moreover have "echelon_form_JNF (FindPreHNF abs_flag D A)" 
   proof (rule echelon_form_four_block_mat[OF A'_UL A'_UR sub_PreHNF'   ])
     show "FindPreHNF abs_flag D A = four_block_mat A'_UL A'_UR (0\<^sub>m (m + n - 1) 1) sub_PreHNF" 
       using A'_DL0 FindPreHNF_as_fbm sub_PreHNF sub_PreHNF' by auto
     have "A'_UL $$ (0, 0) = ?R $$ (0,0)"
       by (metis (mono_tags, lifting) A A'_DR A'_UL Find_P'_reduceM M_def 
           \<open>FindPreHNF abs_flag D A = P' * Q * R * S * A\<close> add_Suc_right add_sign_intros(2) carrier_matD fbm_R
           index_mat_four_block(1,3) index_mult_mat(3) m0 n0 plus_1_eq_Suc
           zero_less_one_class.zero_less_one)
     also have "... \<noteq> 0"
     proof (cases "xs=[]")
       case True
       have "?R $$ (0,0) = reduce 0 m D M $$ (0,0)"
         unfolding non_zero_positions_xs_m True M_def by simp
       also have "... \<noteq> 0"
         by (metis D_not0 M M_def add_pos_pos less_add_same_cancel1 m0 mk_A'_not0 n0 reduce_not0)
       finally show ?thesis .
     next
       case False
       show ?thesis
         by (unfold non_zero_positions_xs_m,
           rule reduce_below_not0_case_m[OF M' m0 n0 M_M'D[OF False] mk_A'_not0 m_le_n all_less_m D_not0])     
     qed       
     finally show "A'_UL $$ (0, 0) \<noteq> 0" .
   qed (insert mn n hyp, auto)
   ultimately show ?thesis by blast
 qed
 qed
 
 lemma
   assumes A_def: "A = A'' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
   and A'': "A'' \<in> carrier_mat m n" and "n\<ge>2" and m_le_n: "m\<ge>n" and "D>0"
 shows FindPreHNF_invertible_mat_n_ge2: "\<exists>P. P \<in> carrier_mat (m+n) (m+n) \<and> invertible_mat P \<and> FindPreHNF abs_flag D A = P * A"
 and FindPreHNF_echelon_form_n_ge2: "echelon_form_JNF (FindPreHNF abs_flag D A)"
   using FindPreHNF_works_n_ge2[OF assms] by blast+
 
 lemma FindPreHNF_invertible_mat:
   assumes A_def: "A = A'' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
     and A'': "A'' \<in> carrier_mat m n" and n0: "0<n" and mn: "m\<ge>n" and D: "D>0"
   shows "\<exists>P. P \<in> carrier_mat (m+n) (m+n) \<and> invertible_mat P \<and> FindPreHNF abs_flag D A = P * A"
 proof -
   have A: "A \<in> carrier_mat (m+n) n" using A_def A'' by auto
   show ?thesis
   proof (cases "m+n<2")
     case True
     show ?thesis by (rule FindPreHNF_invertible_mat_2xn[OF A True])
   next
     case False note m_ge2 = False
     show ?thesis
     proof (cases "n<2")
       case True
       show ?thesis by (rule FindPreHNF_invertible_mat_mx2[OF A_def A'' True n0 D mn])
     next
       case False
       show ?thesis 
         by (rule FindPreHNF_invertible_mat_n_ge2[OF A_def A'' _ mn D], insert False, auto)
     qed  
   qed
 qed
 
 
 lemma FindPreHNF_echelon_form:
   assumes A_def: "A = A'' @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n"
     and A'': "A'' \<in> carrier_mat m n" and mn: "m\<ge>n" and D: "D>0"
   shows "echelon_form_JNF (FindPreHNF abs_flag D A)"
 proof -
   have A: "A \<in> carrier_mat (m+n) n" using A_def A'' by auto
   have FindPreHNF: "(FindPreHNF abs_flag D A) \<in> carrier_mat (m+n) n" by (rule FindPreHNF[OF A])
   show ?thesis
   proof (cases "m+n<2")
     case True
     show ?thesis by (rule echelon_form_JNF_1xn[OF FindPreHNF True])
   next
     case False note m_ge2 = False
     show ?thesis
     proof (cases "n<2")
       case True
       show ?thesis by (rule FindPreHNF_echelon_form_mx1[OF A_def A'' True D mn])
     next
       case False
       show ?thesis 
         by (rule FindPreHNF_echelon_form_n_ge2[OF A_def A'' _ mn D], insert False, auto)
     qed  
   qed
 qed
 end
 
 text \<open>We connect the algorithm developed in the Hermite AFP entry with ours. This would permit
 to reuse many existing results and prove easily the soundness.\<close>
 
 (*In HOL Analysis*)
 thm Hermite.Hermite_reduce_above.simps
 thm Hermite.Hermite_of_row_i_def
 thm Hermite.Hermite_of_upt_row_i_def
 thm Hermite.Hermite_of_def
 
 (*In JNF*)
 thm Hermite_reduce_above.simps
 thm Hermite_of_row_i_def
 thm Hermite_of_list_of_rows.simps
 thm mod_operation.Hermite_mod_det_def
 
 (*Connecting Hermite.Hermite_reduce_above and Hermite_reduce_above*)
 thm Hermite.Hermite_reduce_above.simps Hermite_reduce_above.simps
 
 context includes lifting_syntax
 begin
 
 definition "res_int = (\<lambda>b n::int. n mod b)"
 
 lemma res_function_res_int: 
   "res_function res_int"
   using res_function_euclidean2 unfolding res_int_def by auto
 
 lemma HMA_Hermite_reduce_above[transfer_rule]: 
   assumes "n<CARD('m)"
   shows "((Mod_Type_Connect.HMA_M :: _ \<Rightarrow> int ^ 'n :: mod_type ^ 'm :: mod_type \<Rightarrow> _) 
     ===> (Mod_Type_Connect.HMA_I) ===> (Mod_Type_Connect.HMA_I) ===> (Mod_Type_Connect.HMA_M)) 
   (\<lambda>A i j. Hermite_reduce_above A n i j)
   (\<lambda>A i j. Hermite.Hermite_reduce_above A n i j res_int)"
 proof (intro rel_funI, goal_cases)
   case (1 A A' i i' j j')
   then show ?case using assms
   proof (induct n arbitrary: A A')
     case 0
     then show ?case by auto
   next
     case (Suc n)
     note AA'[transfer_rule] = "Suc.prems"(1)
     note ii'[transfer_rule] = "Suc.prems"(2)
     note jj'[transfer_rule] = "Suc.prems"(3)
     note Suc_n_less_m = "Suc.prems"(4)
 
     let ?H_JNF = "HNF_Mod_Det_Algorithm.Hermite_reduce_above"
     let ?H_HMA = "Hermite.Hermite_reduce_above"
     let ?from_nat_rows = "mod_type_class.from_nat :: _ \<Rightarrow> 'm"
     have nn[transfer_rule]: "Mod_Type_Connect.HMA_I n (?from_nat_rows n)" 
       unfolding Mod_Type_Connect.HMA_I_def
       by (simp add: Suc_lessD Suc_n_less_m mod_type_class.from_nat_to_nat)
 
     have Anj: "A' $h (?from_nat_rows n) $h j' = A $$ (n,j)" 
       by (unfold index_hma_def[symmetric], transfer, simp)
     have Aij: "A' $h i' $h j' = A $$ (i,j)" by (unfold index_hma_def[symmetric], transfer, simp)
     let ?s = "(- (A $$ (n, j) div A $$ (i, j)))"
     let ?s' = "((res_int (A' $h i' $h j') (A' $h ?from_nat_rows n $h j') 
       - A' $h ?from_nat_rows n $h j') div A' $h i' $h j')"
     have ss'[transfer_rule]: "?s = ?s'" unfolding res_int_def Anj Aij
       by (metis (no_types, opaque_lifting) Groups.add_ac(2) add_diff_cancel_left' div_by_0 
           minus_div_mult_eq_mod more_arith_simps(7) nat_arith.rule0 nonzero_mult_div_cancel_right
           uminus_add_conv_diff)
     have H_JNF_eq: "?H_JNF A (Suc n) i j = ?H_JNF (addrow (- (A $$ (n, j) div A $$ (i, j))) n i A) n i j"
       by auto
     have H_HMA_eq: "?H_HMA A' (Suc n) i' j' res_int = ?H_HMA (row_add A' (?from_nat_rows n) i' ?s') n i' j' res_int"
       by (auto simp add: Let_def)
     have "Mod_Type_Connect.HMA_M (?H_JNF (addrow ?s n i A) n i j) 
       (?H_HMA (row_add A' (?from_nat_rows n) i' ?s') n i' j' res_int)" 
       by (rule "Suc.hyps"[OF _ ii' jj'], transfer_prover, insert Suc_n_less_m, simp)
     thus ?case using H_JNF_eq H_HMA_eq by auto
   qed
 qed
 
 
 corollary HMA_Hermite_reduce_above': 
   assumes "n<CARD('m)"
   and "Mod_Type_Connect.HMA_M A (A':: int ^ 'n :: mod_type ^ 'm :: mod_type)"
   and "Mod_Type_Connect.HMA_I i i'" and "Mod_Type_Connect.HMA_I j j'"
   shows"Mod_Type_Connect.HMA_M (Hermite_reduce_above A n i j) (Hermite.Hermite_reduce_above A' n i' j' res_int)"
   using HMA_Hermite_reduce_above assms unfolding rel_fun_def by metis
 
 
 lemma HMA_Hermite_of_row_i[transfer_rule]: 
   assumes upt_A: "upper_triangular' A"
   and AA': "Mod_Type_Connect.HMA_M A (A':: int ^ 'n :: mod_type ^ 'm :: mod_type)"
   and ii': "Mod_Type_Connect.HMA_I i i'"
   shows "Mod_Type_Connect.HMA_M (Hermite_of_row_i A i)
   (Hermite.Hermite_of_row_i ass_function_euclidean res_int A' i')"
 proof -
   note AA'[transfer_rule]
   note ii'[transfer_rule]
   have i: "i<dim_row A"
     by (metis (full_types) AA' ii' Mod_Type_Connect.HMA_I_def 
         Mod_Type_Connect.dim_row_transfer_rule mod_type_class.to_nat_less_card)  
   show ?thesis
   proof (cases "is_zero_row i' A'")
     case True
     hence "is_zero_row_JNF i A" by (transfer, simp)
     hence "find_fst_non0_in_row i A = None" using find_fst_non0_in_row_None[OF _ upt_A i] by auto
     thus ?thesis using True AA' unfolding Hermite.Hermite_of_row_i_def Hermite_of_row_i_def by auto
   next
     case False
     have nz_iA: "\<not> is_zero_row_JNF i A" using False by transfer
     hence "find_fst_non0_in_row i A \<noteq> None" using find_fst_non0_in_row_None[OF _ upt_A i] by auto
     from this obtain j where j: "find_fst_non0_in_row i A = Some j" by blast
     have j_eq: "j = (LEAST n. A $$ (i,n) \<noteq> 0)"
       by (rule find_fst_non0_in_row_LEAST[OF _ upt_A j i], auto)
     have H_JNF_rw: "(Hermite_of_row_i A i) = 
     (if A $$ (i, j) < 0 then Hermite_reduce_above (multrow i (- 1) A) i i j
      else Hermite_reduce_above A i i j)" unfolding Hermite_of_row_i_def using j by auto
     let ?H_HMA = "Hermite.Hermite_of_row_i"
     let ?j' = "(LEAST n. A' $h i' $h n \<noteq> 0)"
     have ii'2: "(mod_type_class.to_nat i') = i" using ii'
       by (simp add: Mod_Type_Connect.HMA_I_def)                                            
     have jj'[transfer_rule]: "Mod_Type_Connect.HMA_I j ?j'"
       unfolding j_eq index_hma_def[symmetric] by (rule HMA_LEAST[OF AA' ii' nz_iA])
     have Aij: "A $$ (i, j) = A' $h i' $h (LEAST n. A' $h i' $h n \<noteq> 0)"
       by (subst index_hma_def[symmetric], transfer', simp)
     have H_HMA_rw: "?H_HMA ass_function_euclidean res_int A' i' = 
     Hermite.Hermite_reduce_above (mult_row A' i' (\<bar>A' $h i' $h ?j'\<bar> 
       div A' $h i' $h ?j'))
      (mod_type_class.to_nat i') i' ?j' res_int" 
       unfolding Hermite.Hermite_of_row_i_def Let_def ass_function_euclidean_def
       by (auto simp add: False)
     have im: "i < CARD('m)" using ii' unfolding Mod_Type_Connect.HMA_I_def
       using mod_type_class.to_nat_less_card by blast
     show ?thesis
     proof (cases "A $$ (i, j) < 0")
       case True
       have A'i'j'_le_0: "A' $h i' $h ?j' < 0" using Aij True by auto
       hence 1: "(\<bar>A' $h i' $h ?j'\<bar> div A' $h i' $h ?j') 
           = -1" using div_pos_neg_trivial by auto
       have [transfer_rule]: "Mod_Type_Connect.HMA_M (multrow i (- 1) A) 
       (mult_row A' i' (\<bar>A' $h i' $h ?j'\<bar> 
       div A' $h i' $h ?j'))" unfolding 1 by transfer_prover      
       have H_HMA_rw2: "Hermite_of_row_i A i = Hermite_reduce_above (multrow i (- 1) A) i i j"
         using True H_JNF_rw by auto
       have *: "Mod_Type_Connect.HMA_M (Hermite_reduce_above (multrow i (- 1) A) i i j) 
         (Hermite.Hermite_reduce_above (mult_row A' i' (\<bar>A' $h i' $h ?j'\<bar> 
         div A' $h i' $h ?j'))
         (mod_type_class.to_nat i') i' ?j' res_int) "
         unfolding 1 ii'2
         by (rule HMA_Hermite_reduce_above'[OF im _ ii' jj'], transfer_prover)
        show ?thesis unfolding H_JNF_rw H_HMA_rw unfolding H_HMA_rw2 using True * by auto
     next
       case False
       have Aij_not0: "A $$ (i, j) \<noteq> 0" using j_eq nz_iA
         by (metis (mono_tags) LeastI is_zero_row_JNF_def)
       have A'i'j'_le_0: "A' $h i' $h ?j' > 0" using False Aij_not0 Aij by auto
       hence 1: "(\<bar>A' $h i' $h ?j'\<bar> div A' $h i' $h ?j') = 1" by auto
       have H_HMA_rw2: "Hermite_of_row_i A i = Hermite_reduce_above A i i j"
         using False H_JNF_rw by auto
       have *: "?H_HMA ass_function_euclidean res_int A' i' = 
       (Hermite.Hermite_reduce_above A' (mod_type_class.to_nat i') i' ?j' res_int)"
         using H_HMA_rw unfolding 1 unfolding mult_row_1_id by simp
       have "Mod_Type_Connect.HMA_M (Hermite_reduce_above A i i j) 
         (Hermite.Hermite_reduce_above A' (mod_type_class.to_nat i') i' ?j' res_int)"
         unfolding 1 ii'2
         by (rule HMA_Hermite_reduce_above'[OF im AA' ii' jj'])
       then show ?thesis using H_HMA_rw * H_HMA_rw2 by presburger
     qed        
   qed
 qed
 
 
 lemma Hermite_of_list_of_rows_append:
 "Hermite_of_list_of_rows A (xs @ [x]) = Hermite_of_row_i (Hermite_of_list_of_rows A xs) x"
   by (induct xs arbitrary: A, auto)
 
 
 lemma Hermite_reduce_above[simp]: "Hermite_reduce_above A n i j \<in> carrier_mat (dim_row A) (dim_col A)"  
 proof (induct n arbitrary: A)
   case 0
   then show ?case by auto
 next
   case (Suc n)    
   let ?A = "(addrow (- (A $$ (n, j) div A $$ (i, j))) n i A)"  
   have "Hermite_reduce_above A (Suc n) i j = Hermite_reduce_above ?A n i j"
     by (auto simp add: Let_def)
   also have "... \<in> carrier_mat (dim_row ?A) (dim_col ?A)" by(rule Suc.hyps)
   finally show ?case by auto  
 qed                           
 
 
 lemma Hermite_of_row_i: "Hermite_of_row_i A i \<in> carrier_mat (dim_row A) (dim_col A)" 
 proof -
   have "Hermite_reduce_above (multrow i (- 1) A) i i a 
     \<in> carrier_mat (dim_row (multrow i (- 1) A)) (dim_col (multrow i (- 1) A))" 
     for a by (rule Hermite_reduce_above)
   thus ?thesis
     unfolding Hermite_of_row_i_def using Hermite_reduce_above 
     by (cases "find_fst_non0_in_row i A", auto)
 qed
 
 end
 
 
 text \<open>We now move more lemmas from HOL Analysis (with mod-type restrictions) to the JNF matrix
 representation.\<close>
 
 (*thm echelon_form_Hermite_of_row will be transferred from HOL Analysis to JNF*)
 
 context
 begin
 
 private lemma echelon_form_Hermite_of_row_mod_type:
   fixes A::"int mat"
   assumes "A \<in> carrier_mat CARD('m::mod_type) CARD('n::mod_type)"
   assumes eA: "echelon_form_JNF A"
   and i: "i<CARD('m)"
   shows "echelon_form_JNF (Hermite_of_row_i A i)"
 proof -
   have uA: "upper_triangular' A" by (rule echelon_form_JNF_imp_upper_triangular[OF eA])
   define A' where "A' = (Mod_Type_Connect.to_hma\<^sub>m A :: int ^'n :: mod_type ^'m :: mod_type)"
   define i' where "i' = (Mod_Type.from_nat i :: 'm)"
   have AA'[transfer_rule]: "Mod_Type_Connect.HMA_M A A'"
     unfolding Mod_Type_Connect.HMA_M_def using assms A'_def by auto
   have ii'[transfer_rule]: "Mod_Type_Connect.HMA_I i i'"
     unfolding Mod_Type_Connect.HMA_I_def i'_def using assms
     using from_nat_not_eq order.strict_trans by blast 
   have eA'[transfer_rule]: "echelon_form A'" using eA by transfer
   have [transfer_rule]: "Mod_Type_Connect.HMA_M 
     (HNF_Mod_Det_Algorithm.Hermite_of_row_i A i) 
     (Hermite.Hermite_of_row_i ass_function_euclidean res_int A' i')"
     by (rule HMA_Hermite_of_row_i[OF uA AA' ii'])
   have "echelon_form (Hermite.Hermite_of_row_i ass_function_euclidean res_int A' i')"
     by (rule echelon_form_Hermite_of_row[OF ass_function_euclidean res_function_res_int eA'])    
   thus ?thesis by (transfer, simp)
 qed 
 
 
 private lemma echelon_form_Hermite_of_row_nontriv_mod_ring:
   fixes A::"int mat"
   assumes "A \<in> carrier_mat CARD('m::nontriv mod_ring) CARD('n::nontriv mod_ring)"
   assumes eA: "echelon_form_JNF A"
   and "i<CARD('m)"
   shows "echelon_form_JNF (Hermite_of_row_i A i)"
 using assms echelon_form_Hermite_of_row_mod_type by (smt CARD_mod_ring) 
 
 (*We internalize both sort constraints in one step*)
 lemmas echelon_form_Hermite_of_row_nontriv_mod_ring_internalized = 
   echelon_form_Hermite_of_row_nontriv_mod_ring[unfolded CARD_mod_ring, 
       internalize_sort "'m::nontriv", internalize_sort "'b::nontriv"]
 
 context
   fixes m::nat and n::nat
   assumes local_typedef1: "\<exists>(Rep :: ('b \<Rightarrow> int)) Abs. type_definition Rep Abs {0..<m :: int}"
   assumes local_typedef2: "\<exists>(Rep :: ('c \<Rightarrow> int)) Abs. type_definition Rep Abs {0..<n :: int}"
   and m: "m>1"
   and n: "n>1"
 begin
 
 lemma echelon_form_Hermite_of_row_nontriv_mod_ring_aux:
  fixes A::"int mat"
   assumes "A \<in> carrier_mat m n"
   assumes eA: "echelon_form_JNF A"
   and "i<m"
 shows "echelon_form_JNF (Hermite_of_row_i A i)"  
   using echelon_form_Hermite_of_row_nontriv_mod_ring_internalized
     [OF type_to_set2(1)[OF local_typedef1 local_typedef2] 
         type_to_set1(1)[OF local_typedef1 local_typedef2]]
   using assms 
   using type_to_set1(2) local_typedef1 local_typedef2 n m by metis 
 
 end
 
 (*Canceling the first local type definitions*)
 context
 begin
 
 (*Canceling the first*)
 
 private lemma echelon_form_Hermite_of_row_i_cancelled_first:
 "\<exists>Rep Abs. type_definition Rep Abs {0..<int n} \<Longrightarrow> 1 < m \<Longrightarrow> 1 < n 
   \<Longrightarrow> A \<in> carrier_mat m n \<Longrightarrow> echelon_form_JNF A \<Longrightarrow> i < m 
   \<Longrightarrow> echelon_form_JNF (HNF_Mod_Det_Algorithm.Hermite_of_row_i A i)"
   using echelon_form_Hermite_of_row_nontriv_mod_ring_aux[cancel_type_definition, of m n A i]
   by auto  
 
 (*Canceling the second*)
 private lemma echelon_form_Hermite_of_row_i_cancelled_both:
 "1 < m \<Longrightarrow> 1 < n \<Longrightarrow> A \<in> carrier_mat m n \<Longrightarrow> echelon_form_JNF A \<Longrightarrow> i < m 
   \<Longrightarrow> echelon_form_JNF (HNF_Mod_Det_Algorithm.Hermite_of_row_i A i)"
   using echelon_form_Hermite_of_row_i_cancelled_first[cancel_type_definition, of n m A i] by simp
 
 (*The final results in JNF*)
 
 lemma echelon_form_JNF_Hermite_of_row_i':
  fixes A::"int mat"
   assumes "A \<in> carrier_mat m n"
   assumes eA: "echelon_form_JNF A"
   and "i<m"
   and "1 < m" and "1 < n" (*Required from the mod_type restrictions*)
 shows "echelon_form_JNF (Hermite_of_row_i A i)"  
   using echelon_form_Hermite_of_row_i_cancelled_both assms by auto
 
 
 corollary echelon_form_JNF_Hermite_of_row_i:
   fixes A::"int mat"
   assumes eA: "echelon_form_JNF A"
     and i: "i<dim_row A"
   shows "echelon_form_JNF (Hermite_of_row_i A i)"  
 proof (cases "dim_row A < 2")
   case True
   show ?thesis 
     by (rule echelon_form_JNF_1xn[OF Hermite_of_row_i True])
 next
   case False note m_ge2 = False
   show ?thesis
   proof (cases "1<dim_col A")
     case True
     show ?thesis by (rule echelon_form_JNF_Hermite_of_row_i'[OF _ eA i _ True], insert m_ge2, auto)
   next
     case False
     hence dc_01: "dim_col A \<in> {0,1}" by auto
     show ?thesis
     proof (cases "dim_col A = 0")
       case True
       have H: "Hermite_of_row_i A i \<in> carrier_mat (dim_row A) (dim_col A)"
         using Hermite_of_row_i by blast
       show ?thesis by (rule echelon_form_mx0, insert True H, auto)
     next
       case False
       hence dc_1: "dim_col A = 1" using dc_01 by simp
       then show ?thesis     
       proof (cases "i=0")
         case True      
         have eA': "echelon_form_JNF (multrow 0 (- 1) A)"
           by (rule echelon_form_JNF_multrow[OF _ _ eA], insert m_ge2, auto)
         show ?thesis using True unfolding Hermite_of_row_i_def
           by (cases "find_fst_non0_in_row 0 A", insert eA eA', auto)
       next
         case False  
         have all_zero: "(\<forall>j\<in>{i..<dim_col A}. A $$ (i, j) = 0)" unfolding dc_1 using False by auto
         hence "find_fst_non0_in_row i A = None" using find_fst_non0_in_row_None'[OF _ i] by blast
         hence "Hermite_of_row_i A i = A" unfolding Hermite_of_row_i_def by auto
         then show ?thesis using eA by auto
       qed  
     qed  
   qed
 qed
 
 
 
 lemma Hermite_of_list_of_rows:
  "(Hermite_of_list_of_rows A xs) \<in> carrier_mat (dim_row A) (dim_col A)"
 proof (induct xs arbitrary: A rule: rev_induct)
   case Nil
   then show ?case by auto
 next
   case (snoc x xs)
   let ?A = "(Hermite_of_list_of_rows A xs)"
   have hyp: "(Hermite_of_list_of_rows A xs) \<in> carrier_mat (dim_row A) (dim_col A)" by (rule snoc.hyps)
   have "Hermite_of_list_of_rows A (xs @ [x]) = Hermite_of_row_i ?A x"
     using Hermite_of_list_of_rows_append by auto
   also have "... \<in> carrier_mat (dim_row ?A) (dim_col ?A)" using Hermite_of_row_i by auto
   finally show ?case using hyp by auto  
 qed
 
 lemma echelon_form_JNF_Hermite_of_list_of_rows:
   assumes "A\<in>carrier_mat m n"
  and "\<forall>x\<in>set xs. x < m"
   and "echelon_form_JNF A"
 shows "echelon_form_JNF (Hermite_of_list_of_rows A xs)"
   using assms
 proof (induct xs arbitrary: A rule: rev_induct)
   case Nil
   then show ?case by auto
 next
   case (snoc x xs)
   have hyp: "echelon_form_JNF (Hermite_of_list_of_rows A xs)"
     by (rule snoc.hyps, insert snoc.prems, auto)
   have H_Axs: "(Hermite_of_list_of_rows A xs) \<in> carrier_mat (dim_row A) (dim_col A)" 
     by (rule Hermite_of_list_of_rows)
   have "(Hermite_of_list_of_rows A (xs @ [x])) = Hermite_of_row_i (Hermite_of_list_of_rows A xs) x"
     using Hermite_of_list_of_rows_append by simp
   also have "echelon_form_JNF ..."
   proof (rule echelon_form_JNF_Hermite_of_row_i[OF hyp])
     show "x < dim_row (Hermite_of_list_of_rows A xs)" using snoc.prems H_Axs by auto
   qed
   finally show ?case .
 qed
 
 
 
 
 lemma HMA_Hermite_of_upt_row_i[transfer_rule]: 
   assumes "xs = [0..<i]"
     and "\<forall>x\<in>set xs. x < CARD('m)"
   assumes "Mod_Type_Connect.HMA_M A (A':: int ^ 'n :: mod_type ^ 'm :: mod_type)" 
     and "echelon_form_JNF A"
   shows "Mod_Type_Connect.HMA_M (Hermite_of_list_of_rows A xs)
   (Hermite.Hermite_of_upt_row_i A' i ass_function_euclidean res_int)"
   using assms
 proof (induct xs arbitrary: A A' i rule: rev_induct)
   case Nil
   have "i=0" using Nil by (metis le_0_eq upt_eq_Nil_conv)
   then show ?case using Nil unfolding Hermite_of_upt_row_i_def by auto
 next
   case (snoc x xs)
   note xs_x_eq = snoc.prems(1)
   note all_xm = snoc.prems(2)
   note AA' = snoc.prems(3)
   note upt_A = snoc.prems(4)
   let ?x' = "(mod_type_class.from_nat x::'m)"
   have xm: "x < CARD('m)" using all_xm by auto
   have xx'[transfer_rule]: "Mod_Type_Connect.HMA_I x ?x'"
     unfolding Mod_Type_Connect.HMA_I_def using from_nat_not_eq xm by blast
   have last_i1: "last [0..<i] = i-1"
     by (metis append_is_Nil_conv last_upt list.simps(3) neq0_conv xs_x_eq upt.simps(1))
   have "last (xs @ [x]) = i-1" using xs_x_eq last_i1 by auto
   hence x_i1: "x = i-1" by auto
   have xs_eq: "xs = [0..<x]" using xs_x_eq x_i1
     by (metis add_diff_inverse_nat append_is_Nil_conv append_same_eq less_one list.simps(3)
         plus_1_eq_Suc upt_Suc upt_eq_Nil_conv)
   have list_rw: "[0..<i] = 0 #[1..<i]" 
     by (auto, metis append_is_Nil_conv list.distinct(2) upt_rec xs_x_eq)
   have 1: "Hermite_of_list_of_rows A (xs @ [x]) = Hermite_of_row_i (Hermite_of_list_of_rows A xs) x"
     unfolding Hermite_of_list_of_rows_append by auto
   let ?H_upt_HA = "Hermite.Hermite_of_upt_row_i"
   let ?H_HA = "Hermite.Hermite_of_row_i ass_function_euclidean res_int"
   have "(Hermite_of_upt_row_i A' i ass_function_euclidean res_int) = 
     foldl ?H_HA A' (map mod_type_class.from_nat [0..<i])"
     unfolding Hermite_of_upt_row_i_def by auto
   also have "... = foldl ?H_HA A' ((map mod_type_class.from_nat [0..<i-1])@[?x'])"
     by (metis list.simps(8) list.simps(9) map_append x_i1 xs_eq xs_x_eq)
   also have "... = foldl ?H_HA (?H_upt_HA A' (i - 1) ass_function_euclidean res_int) [?x']"
     unfolding foldl_append unfolding Hermite_of_upt_row_i_def[symmetric] by auto
   also have "... = ?H_HA (Hermite_of_upt_row_i A' (i - 1) ass_function_euclidean res_int) ?x'" by auto
   finally have 2: "?H_upt_HA A' i ass_function_euclidean res_int =
     ?H_HA (Hermite_of_upt_row_i A' (i - 1) ass_function_euclidean res_int) ?x'" .
 
   have hyp[transfer_rule]: "Mod_Type_Connect.HMA_M (Hermite_of_list_of_rows A xs)
               (Hermite_of_upt_row_i A' (i - 1) ass_function_euclidean res_int)"
     by (rule snoc.hyps[OF _ _ AA' upt_A], insert xs_eq x_i1 xm, auto)
 
   have upt_H_Axs:"upper_triangular' (Hermite_of_list_of_rows A xs)"
   proof (rule echelon_form_JNF_imp_upper_triangular, 
       rule echelon_form_JNF_Hermite_of_list_of_rows[OF _ _ upt_A])
     show "A\<in>carrier_mat (CARD('m)) (CARD('n))"
       using Mod_Type_Connect.dim_col_transfer_rule
         Mod_Type_Connect.dim_row_transfer_rule snoc(4) by blast
     show "\<forall>x\<in>set xs. x < CARD('m)" using all_xm by auto
   qed
   show ?case unfolding 1 2 
   by (rule HMA_Hermite_of_row_i[OF upt_H_Axs hyp xx'])
 qed
 
 (*This is the lemma that I will transfer to JNF to get the soundness*)
 lemma Hermite_Hermite_of_upt_row_i:
   assumes a: "ass_function ass"
     and r: "res_function res"
     and eA: "echelon_form A"
   shows "Hermite (range ass) (\<lambda>c. range (res c)) (Hermite_of_upt_row_i A (nrows A) ass res)" 
 proof -
   let ?H = "(Hermite_of_upt_row_i A (nrows A) ass res)"  
   show ?thesis
   proof (rule Hermite_intro, auto)
     show "Complete_set_non_associates (range ass)"
       by (simp add: ass_function_Complete_set_non_associates a)
     show "Complete_set_residues (\<lambda>c. range (res c))"
       by (simp add: r res_function_Complete_set_residues)
     show "echelon_form ?H"
       by (rule echelon_form_Hermite_of_upt_row_i[OF eA a r])  
     fix i
     assume i: "\<not> is_zero_row i ?H" 
     show "?H $ i $ (LEAST n. ?H $ i $ n \<noteq> 0) \<in> range ass"
     proof -
       have non_zero_i_eA: "\<not> is_zero_row i A"
         using Hermite_of_upt_row_preserves_zero_rows[OF _ _ a r] i eA by blast   
       have least: "(LEAST n. ?H $h i $h n \<noteq> 0) = (LEAST n. A $h i $h n \<noteq> 0)"
         by (rule Hermite_of_upt_row_i_Least[OF non_zero_i_eA eA a r], simp)
       have "?H $ i $ (LEAST n. A $ i $ n \<noteq> 0) \<in> range ass"
         by (rule Hermite_of_upt_row_i_in_range[OF non_zero_i_eA eA a r], auto)
       thus ?thesis unfolding least by auto
     qed
   next
     fix i j assume i: "\<not> is_zero_row i ?H" and j: "j < i"
     show "?H $ j $ (LEAST n. ?H $ i $ n \<noteq> 0)
     \<in> range (res (?H $ i $ (LEAST n. ?H $ i $ n \<noteq> 0)))"
     proof -
       have non_zero_i_eA: "\<not> is_zero_row i A"
         using Hermite_of_upt_row_preserves_zero_rows[OF _ _ a r] i eA by blast   
       have least: "(LEAST n. ?H $h i $h n \<noteq> 0) = (LEAST n. A $h i $h n \<noteq> 0)"
         by (rule Hermite_of_upt_row_i_Least[OF non_zero_i_eA eA a r], simp)
       have "?H $ j $ (LEAST n. A $ i $ n \<noteq> 0) \<in> range (res (?H $ i $ (LEAST n. A $ i $ n \<noteq> 0)))"
         by (rule Hermite_of_upt_row_i_in_range_res[OF non_zero_i_eA eA a r _ _ j], auto)
       thus ?thesis unfolding least by auto
     qed
   qed
 qed
 
 
 lemma Hermite_of_row_i_0:
   "Hermite_of_row_i A 0 = A \<or> Hermite_of_row_i A 0 = multrow 0 (- 1) A"
     by (cases "find_fst_non0_in_row 0 A", unfold Hermite_of_row_i_def, auto)
 
 lemma Hermite_JNF_intro:
 assumes 
 "Complete_set_non_associates associates" "(Complete_set_residues res)" "echelon_form_JNF A"
  "(\<forall>i<dim_row A. \<not> is_zero_row_JNF i A \<longrightarrow> A $$ (i, LEAST n. A $$ (i, n) \<noteq> 0) \<in> associates)"
  "(\<forall>i<dim_row A. \<not> is_zero_row_JNF i A \<longrightarrow> (\<forall>j. j<i \<longrightarrow> A $$ (j, (LEAST n. A $$ (i, n) \<noteq> 0)) 
      \<in> res (A $$ (i,(LEAST n. A $$ (i,n) \<noteq> 0)))))"
 shows "Hermite_JNF associates res A"
   using assms unfolding Hermite_JNF_def by auto
 
 lemma least_multrow:
   assumes "A \<in> carrier_mat m n" and "i<m" and eA: "echelon_form_JNF A"
   assumes ia: "ia < dim_row A" and nz_ia_mrA: "\<not> is_zero_row_JNF ia (multrow i (- 1) A)"
   shows "(LEAST n. multrow i (- 1) A $$ (ia, n) \<noteq> 0) = (LEAST n. A $$ (ia, n) \<noteq> 0)"
 proof (rule Least_equality)
   have nz_ia_A: "\<not> is_zero_row_JNF ia A" using nz_ia_mrA ia by auto
   have Least_Aian_n: "(LEAST n. A $$ (ia, n) \<noteq> 0) < dim_col A"
     by (smt dual_order.strict_trans is_zero_row_JNF_def not_less_Least not_less_iff_gr_or_eq nz_ia_A)
   show "multrow i (- 1) A $$ (ia, LEAST n. A $$ (ia, n) \<noteq> 0) \<noteq> 0"
     by (smt LeastI Least_Aian_n class_cring.cring_simprules(22) equation_minus_iff ia
         index_mat_multrow(1) is_zero_row_JNF_def mult_minus1 nz_ia_A)
   show " \<And>y. multrow i (- 1) A $$ (ia, y) \<noteq> 0 \<Longrightarrow> (LEAST n. A $$ (ia, n) \<noteq> 0) \<le> y"
     by (metis (mono_tags, lifting) Least_Aian_n class_cring.cring_simprules(22) ia 
         index_mat_multrow(1) leI mult_minus1 order.strict_trans wellorder_Least_lemma(2))
 qed
 
 
 lemma Hermite_Hermite_of_row_i:
   assumes A: "A \<in> carrier_mat 1 n"
   shows "Hermite_JNF (range ass_function_euclidean) (\<lambda>c. range (res_int c)) (Hermite_of_row_i A 0)"
 proof (rule Hermite_JNF_intro)
   show "Complete_set_non_associates (range ass_function_euclidean)"   
     using ass_function_Complete_set_non_associates ass_function_euclidean by blast
   show "Complete_set_residues (\<lambda>c. range (res_int c))"
     using res_function_Complete_set_residues res_function_res_int by blast
   show "echelon_form_JNF (HNF_Mod_Det_Algorithm.Hermite_of_row_i A 0)"
     by (metis (full_types) assms carrier_matD(1) echelon_form_JNF_Hermite_of_row_i
         echelon_form_JNF_def less_one not_less_zero)
   let ?H = "Hermite_of_row_i A 0"
   show "\<forall>i<dim_row ?H. \<not> is_zero_row_JNF i ?H 
       \<longrightarrow> ?H $$ (i, LEAST n. ?H $$ (i, n) \<noteq> 0) \<in> range ass_function_euclidean"
   proof (auto)
     fix i assume i: "i<dim_row ?H" and nz_iH: "\<not> is_zero_row_JNF i ?H"
     have nz_iA: "\<not> is_zero_row_JNF i A"
       by (metis (full_types) Hermite_of_row_i Hermite_of_row_i_0 carrier_matD(1)
           i is_zero_row_JNF_multrow nz_iH)
     have "?H $$ (i, LEAST n. ?H $$ (i, n) \<noteq> 0) \<ge> 0"
     proof (cases "find_fst_non0_in_row 0 A")
       case None
        then show ?thesis using nz_iH unfolding Hermite_of_row_i_def
          by (smt HNF_Mod_Det_Algorithm.Hermite_of_row_i_def upper_triangular'_def assms 
              carrier_matD(1) find_fst_non0_in_row_None i less_one not_less_zero option.simps(4))
     next
       case (Some a)
       have upA: "upper_triangular' A" using A unfolding upper_triangular'_def by auto
       have eA: "echelon_form_JNF A" by (metis A Suc_1 echelon_form_JNF_1xn lessI)
       have i0: "i=0" using Hermite_of_row_i[of A 0] A i by auto        
       have Aia: "A $$ (i,a) \<noteq> 0" and a0: "0 \<le> a" and an: "a<n"
         using i0 Some assms find_fst_non0_in_row by auto+
       have l: "(LEAST n. A $$ (i, n) \<noteq> 0) = (LEAST n.  multrow 0 (- 1) A $$ (i, n) \<noteq> 0)"
         by (rule least_multrow[symmetric, OF A _ eA _], insert nz_iA i A i0, auto)
       have a1: "a = (LEAST n. A $$ (i, n) \<noteq> 0)"
         by (rule find_fst_non0_in_row_LEAST[OF A upA], insert Some i0, auto)
       hence a2: "a = (LEAST n.  multrow 0 (- 1) A $$ (i, n) \<noteq> 0)" unfolding l by simp
       have m1: "multrow 0 (- 1) A $$ (i, LEAST n. multrow 0 (- 1) A $$ (i, n) \<noteq> 0) 
           = (- 1) * A $$ (i, LEAST n. A $$ (i, n) \<noteq> 0)"
         by (metis Hermite_of_row_i_0 a1 a2 an assms carrier_matD(2) i i0 index_mat_multrow(1,4))
       then show ?thesis using nz_iH Some a1 Aia a2 i0 unfolding Hermite_of_row_i_def by auto 
     qed
     thus "?H $$ (i, LEAST n. ?H $$ (i, n) \<noteq> 0) \<in> range ass_function_euclidean"
       using ass_function_int ass_function_int_UNIV by auto
     qed
     show "\<forall>i<dim_row ?H. \<not> is_zero_row_JNF i ?H \<longrightarrow> (\<forall>j<i. ?H $$ (j, LEAST n. ?H $$ (i, n) \<noteq> 0)
     \<in> range (res_int (?H $$ (i, LEAST n. ?H $$ (i, n) \<noteq> 0))))"
       using Hermite_of_row_i[of A 0] A by auto
   qed
   
 lemma Hermite_of_row_i_0_eq_0:
   assumes A: "A\<in>carrier_mat m n" and i: "i>0" and eA: "echelon_form_JNF A" and im: "i<m"
     and n0: "0<n"
   shows "Hermite_of_row_i A 0 $$ (i, 0) = 0"
 proof -
   have Ai0: "A $$ (i, 0) = 0" by (rule echelon_form_JNF_first_column_0[OF eA A i im n0]) 
   show ?thesis
   proof (cases "find_fst_non0_in_row 0 A")
     case None  
     thus ?thesis using Ai0 unfolding Hermite_of_row_i_def by auto 
   next
     case (Some a)
     have "A $$ (0, a) \<noteq> 0"  and a0: "0 \<le> a" and an: "a<n"
       using find_fst_non0_in_row[OF A Some] A by auto
     then show ?thesis using Some Ai0 A an a0 im unfolding Hermite_of_row_i_def mat_multrow_def by auto
   qed
 qed
 
   
 
 lemma Hermite_Hermite_of_row_i_mx1:
   assumes A: "A \<in> carrier_mat m 1" and eA: "echelon_form_JNF A"
   shows "Hermite_JNF (range ass_function_euclidean) (\<lambda>c. range (res_int c)) (Hermite_of_row_i A 0)"
 proof (rule Hermite_JNF_intro)
   show "Complete_set_non_associates (range ass_function_euclidean)"   
     using ass_function_Complete_set_non_associates ass_function_euclidean by blast
   show "Complete_set_residues (\<lambda>c. range (res_int c))"
     using res_function_Complete_set_residues res_function_res_int by blast
   have H: "Hermite_of_row_i A 0 : carrier_mat m 1" using A Hermite_of_row_i[of A] by auto
   have upA: "upper_triangular' A"
     by (simp add: eA echelon_form_JNF_imp_upper_triangular)
   show eH: "echelon_form_JNF (Hermite_of_row_i A 0)"
   proof (rule echelon_form_JNF_mx1[OF H])
     show "\<forall>i\<in>{1..<m}. HNF_Mod_Det_Algorithm.Hermite_of_row_i A 0 $$ (i, 0) = 0"
       using Hermite_of_row_i_0_eq_0 assms by auto
   qed (simp)
   let ?H = "Hermite_of_row_i A 0"
   show "\<forall>i<dim_row ?H. \<not> is_zero_row_JNF i ?H 
       \<longrightarrow> ?H $$ (i, LEAST n. ?H $$ (i, n) \<noteq> 0) \<in> range ass_function_euclidean"
   proof (auto)
     fix i assume i: "i<dim_row ?H" and nz_iH: "\<not> is_zero_row_JNF i ?H"
     have nz_iA: "\<not> is_zero_row_JNF i A"
       by (metis (full_types) Hermite_of_row_i Hermite_of_row_i_0 carrier_matD(1)
           i is_zero_row_JNF_multrow nz_iH)    
     have "?H $$ (i, LEAST n. ?H $$ (i, n) \<noteq> 0) \<ge> 0"
     proof (cases "find_fst_non0_in_row 0 A")
       case None
       have "is_zero_row_JNF i A"
         by (metis H upper_triangular'_def None assms(1) carrier_matD find_fst_non0_in_row_None
             i is_zero_row_JNF_def less_one linorder_neqE_nat not_less0 upA)
        then show ?thesis using nz_iH None unfolding Hermite_of_row_i_def by auto
      next
       case (Some a)
       have Aia: "A $$ (0,a) \<noteq> 0" and a0: "0 \<le> a" and an: "a<1"
         using find_fst_non0_in_row[OF A Some] A by auto  
       have nz_j_mA: "is_zero_row_JNF j (multrow 0 (- 1) A)" if j0: "j>0" and jm: "j<m" for j 
         unfolding is_zero_row_JNF_def using A j0 jm upA by auto
       show ?thesis
       proof (cases "i=0")
         case True
         then show ?thesis
           using nz_iH Some nz_j_mA A H i Aia an unfolding Hermite_of_row_i_def by auto
       next
         case False
         have nz_iA: "is_zero_row_JNF i A"
           by (metis False H Hermite_of_row_i_0 carrier_matD(1) i is_zero_row_JNF_multrow not_gr0 nz_iH nz_j_mA)
         hence "is_zero_row_JNF i (multrow 0 (- 1) A)" using A H i by auto
         then show ?thesis using nz_iH Some nz_j_mA False nz_iA 
           unfolding Hermite_of_row_i_def by fastforce
       qed
     qed
     thus "?H $$ (i, LEAST n. ?H $$ (i, n) \<noteq> 0) \<in> range ass_function_euclidean"
       using ass_function_int ass_function_int_UNIV by auto
     qed
     show "\<forall>i<dim_row ?H. \<not> is_zero_row_JNF i ?H \<longrightarrow> (\<forall>j<i. ?H $$ (j, LEAST n. ?H $$ (i, n) \<noteq> 0)
     \<in> range (res_int (?H $$ (i, LEAST n. ?H $$ (i, n) \<noteq> 0))))"
     proof auto
       fix i j assume i: "i<dim_row ?H" and nz_iH: "\<not> is_zero_row_JNF i ?H" and ji: "j<i"
       have "i=0"
         by (metis H upper_triangular'_def One_nat_def nz_iH eH i carrier_matD(2) nat_neq_iff
             echelon_form_JNF_imp_upper_triangular is_zero_row_JNF_def less_Suc0 not_less_zero)
       thus "?H $$ (j, LEAST n. ?H $$ (i, n) \<noteq> 0)
            \<in> range (res_int (?H $$ (i, LEAST n. ?H $$ (i, n) \<noteq> 0)))" using ji by auto
     qed
 qed
 
 
 lemma Hermite_of_list_of_rows_1xn:
   assumes A: "A \<in> carrier_mat 1 n"
     and eA: "echelon_form_JNF A" 
     and x: "\<forall>x \<in> set xs. x < 1" and xs: "xs\<noteq>[]"
   shows "Hermite_JNF (range ass_function_euclidean) 
   (\<lambda>c. range (res_int c)) (Hermite_of_list_of_rows A xs)"
   using x xs
 proof (induct xs rule: rev_induct)
   case Nil
   then show ?case by auto
 next
   case (snoc x xs)
   have x0: "x=0" using snoc.prems by auto
   show ?case 
   proof (cases "xs = []")
     case True    
     have "Hermite_of_list_of_rows A (xs @ [x]) = Hermite_of_row_i A 0"
       unfolding Hermite_of_list_of_rows_append x0 using True by auto
     then show ?thesis using Hermite_Hermite_of_row_i[OF A] by auto
   next
     case False
     have x0: "x=0" using snoc.prems by auto
     have hyp: "Hermite_JNF (range ass_function_euclidean) 
       (\<lambda>c. range (res_int c)) (Hermite_of_list_of_rows A xs)"
         by (rule snoc.hyps, insert snoc.prems False, auto)
     have "Hermite_of_list_of_rows A (xs @ [x]) = Hermite_of_row_i (Hermite_of_list_of_rows A xs) 0"
       unfolding Hermite_of_list_of_rows_append hyp x0 ..
     thus ?thesis
       by (metis A Hermite_Hermite_of_row_i Hermite_of_list_of_rows carrier_matD(1))
   qed
 qed
 
 
 lemma Hermite_of_row_i_id_mx1:
   assumes H': "Hermite_JNF (range ass_function_euclidean) (\<lambda>c. range (res_int c)) A"
     and x: "x<dim_row A" and A: "A\<in>carrier_mat m 1"
 shows "Hermite_of_row_i A x = A"  
 proof (cases "find_fst_non0_in_row x A")
   case None
   then show ?thesis unfolding Hermite_of_row_i_def by auto
 next
   case (Some a)
   have eH: "echelon_form_JNF A" using H' unfolding Hermite_JNF_def by simp
   have ut_A: "upper_triangular' A" by (simp add: eH echelon_form_JNF_imp_upper_triangular)
   have a_least: "a = (LEAST n. A $$ (x,n) \<noteq> 0)" 
     by (rule find_fst_non0_in_row_LEAST[OF _ ut_A Some], insert x, auto)
   have Axa: "A $$ (x, a) \<noteq> 0" and xa: "x\<le>a" and a: "a<dim_col A"
     using find_fst_non0_in_row[OF A Some] unfolding a_least by auto
   have nz_xA: "\<not> is_zero_row_JNF x A" using Axa xa x a unfolding is_zero_row_JNF_def by blast
   have a0: "a = 0" using a A by auto
   have x0: "x=0" using echelon_form_JNF_first_column_0[OF eH A] Axa a0 xa by blast  
   have "A $$ (x, a) \<in> (range ass_function_euclidean)" 
     using nz_xA H' x unfolding a_least unfolding Hermite_JNF_def by auto
   hence "A $$ (x, a) > 0" using Axa unfolding image_def ass_function_euclidean_def by auto
   then show ?thesis unfolding Hermite_of_row_i_def using Some x0 by auto
 qed
 
 lemma Hermite_of_row_i_id_mx1':
   assumes eA: "echelon_form_JNF A"
     and x: "x<dim_row A" and A: "A\<in>carrier_mat m 1"
 shows "Hermite_of_row_i A x = A \<or> Hermite_of_row_i A x = multrow 0 (- 1) A" 
 proof (cases "find_fst_non0_in_row x A")
   case None
   then show ?thesis unfolding Hermite_of_row_i_def by auto
 next
   case (Some a)
   have ut_A: "upper_triangular' A" by (simp add: eA echelon_form_JNF_imp_upper_triangular)
   have a_least: "a = (LEAST n. A $$ (x,n) \<noteq> 0)" 
     by (rule find_fst_non0_in_row_LEAST[OF _ ut_A Some], insert x, auto)
   have Axa: "A $$ (x, a) \<noteq> 0" and xa: "x\<le>a" and a: "a<dim_col A"
     using find_fst_non0_in_row[OF A Some] unfolding a_least by auto
   have nz_xA: "\<not> is_zero_row_JNF x A" using Axa xa x a unfolding is_zero_row_JNF_def by blast
   have a0: "a = 0" using a A by auto
   have x0: "x=0" using echelon_form_JNF_first_column_0[OF eA A] Axa a0 xa by blast
   show ?thesis by (cases "A $$(x,a)>0", unfold Hermite_of_row_i_def, insert Some x0, auto)
 qed
 
 
 lemma Hermite_of_list_of_rows_mx1:
   assumes A: "A \<in> carrier_mat m 1"
     and eA: "echelon_form_JNF A" 
     and x: "\<forall>x \<in> set xs. x < m" and xs: "xs=[0..<i]" and i: "i>0"
   shows "Hermite_JNF (range ass_function_euclidean) 
   (\<lambda>c. range (res_int c)) (Hermite_of_list_of_rows A xs)"
   using x xs i
 proof (induct xs arbitrary: i rule: rev_induct)
   case Nil
   then show ?case by (metis neq0_conv not_less upt_eq_Nil_conv)
 next
   case (snoc x xs)
   note all_n_xs_x = snoc.prems(1)
   note xs_x = snoc.prems(2)
   note i0 = snoc.prems(3)
   have i_list_rw:"[0..<i] = [0..<i-1] @ [i-1]" using i0 less_imp_Suc_add by fastforce
   hence xs: "xs = [0..<i-1]" using xs_x by force
   hence x: "x=i-1" using i_list_rw xs_x by auto
   have H: "Hermite_of_list_of_rows A xs \<in> carrier_mat m 1"
     using A Hermite_of_list_of_rows[of A xs] by auto
   show ?case
   proof (cases "i-1=0")
     case True
     hence xs_empty: "xs = []" using xs by auto
     have *: "Hermite_of_list_of_rows A (xs @ [x]) = Hermite_of_row_i A 0"
       unfolding Hermite_of_list_of_rows_append xs_empty x True by simp    
     show ?thesis unfolding * by (rule Hermite_Hermite_of_row_i_mx1[OF A eA])
   next
     case False          
     have hyp: "Hermite_JNF (range ass_function_euclidean) 
       (\<lambda>c. range (res_int c)) (Hermite_of_list_of_rows A xs)"
       by (rule snoc.hyps[OF _ xs], insert False all_n_xs_x, auto)
     have "Hermite_of_list_of_rows A (xs @ [x]) 
         = Hermite_of_row_i (Hermite_of_list_of_rows A xs) x" 
       unfolding Hermite_of_list_of_rows_append ..
     also have "... = (Hermite_of_list_of_rows A xs)"
       by (rule Hermite_of_row_i_id_mx1[OF hyp _ H], insert snoc.prems H x, auto)
     finally show ?thesis using hyp by auto
   qed
 qed
 
 
 
 lemma invertible_Hermite_of_list_of_rows_1xn:
   assumes "A \<in> carrier_mat 1 n"
   shows "\<exists>P. P \<in> carrier_mat 1 1 \<and> invertible_mat P \<and> Hermite_of_list_of_rows A [0..<1] = P * A"
 proof -
   let ?H = "Hermite_of_list_of_rows A [0..<1]"
   have "?H = Hermite_of_row_i A 0" by auto 
   hence H_or: "?H = A \<or> ?H = multrow 0 (- 1) A"
     using Hermite_of_row_i_0 by simp
   show ?thesis
   proof (cases "?H = A")
     case True
     then show ?thesis
       by (metis assms invertible_mat_one left_mult_one_mat one_carrier_mat)
   next
     case False
     hence H_mr: "?H = multrow 0 (- 1) A" using H_or by simp
     let ?M = "multrow_mat 1 0 (-1)::int mat"
     show ?thesis
     proof (rule exI[of _ "?M"])
       have "?M \<in> carrier_mat 1 1" by auto
       moreover have "invertible_mat ?M"
         by (metis calculation det_multrow_mat det_one dvd_mult_right invertible_iff_is_unit_JNF
             invertible_mat_one one_carrier_mat square_eq_1_iff zero_less_one_class.zero_less_one)
       moreover have "?H= ?M * A"
         by (metis H_mr assms multrow_mat)      
       ultimately show "?M \<in> carrier_mat 1 1 \<and> invertible_mat (?M) 
   \<and> Hermite_of_list_of_rows A [0..<1] = ?M * A" by blast
     qed
   qed
 qed
 
 
 
 lemma invertible_Hermite_of_list_of_rows_mx1':
   assumes A: "A \<in> carrier_mat m 1" and eA: "echelon_form_JNF A"
     and xs_i: "xs = [0..<i]" and xs_m: "\<forall>x\<in>set xs. x < m" and i: "i>0"
   shows "\<exists>P. P \<in> carrier_mat m m \<and> invertible_mat P \<and> Hermite_of_list_of_rows A xs = P * A"
   using xs_i xs_m i
 proof (induct xs arbitrary: i rule: rev_induct)
   case Nil
   then show ?case by (metis diff_zero length_upt list.size(3) zero_order(3))
 next
   case (snoc x xs)
   note all_n_xs_x = snoc.prems(2)
   note xs_x = snoc.prems(1)
   note i0 = snoc.prems(3)
   have i_list_rw:"[0..<i] = [0..<i-1] @ [i-1]" using i0 less_imp_Suc_add by fastforce
   hence xs: "xs = [0..<i-1]" using xs_x by force
   hence x: "x=i-1" using i_list_rw xs_x by auto
   have H: "Hermite_of_list_of_rows A xs \<in> carrier_mat m 1"
     using A Hermite_of_list_of_rows[of A xs] by auto
   show ?case
   proof (cases "i-1=0")
     case True
     hence xs_empty: "xs = []" using xs by auto
     let ?H = "Hermite_of_list_of_rows A (xs @ [x])"
     have *: "Hermite_of_list_of_rows A (xs @ [x]) = Hermite_of_row_i A 0"
       unfolding Hermite_of_list_of_rows_append xs_empty x True by simp  
     hence H_or: "?H = A \<or> ?H = multrow 0 (- 1) A" using Hermite_of_row_i_0 by simp
     thus ?thesis
     proof (cases "?H=A")
       case True
       then show ?thesis unfolding * 
         by (metis A invertible_mat_one left_mult_one_mat one_carrier_mat)
     next
       case False
       hence H_mr: "?H = multrow 0 (- 1) A" using H_or by simp    
       let ?M = "multrow_mat m 0 (-1)::int mat"
     show ?thesis 
     proof (rule exI[of _ "?M"])
       have "?M \<in> carrier_mat m m" by auto
       moreover have "invertible_mat ?M"
         by (metis (full_types) det_multrow_mat dvd_mult_right invertible_iff_is_unit_JNF
             invertible_mat_zero more_arith_simps(10) mult_minus1_right multrow_mat_carrier neq0_conv)
       moreover have "?H = ?M * A" unfolding H_mr using A multrow_mat by blast            
       ultimately show "?M \<in> carrier_mat m m \<and> invertible_mat ?M \<and> ?H = ?M * A" by blast
     qed
   qed
   next
     case False
     let ?A = "(Hermite_of_list_of_rows A xs)"
     have A': "?A \<in> carrier_mat m 1" using A Hermite_of_list_of_rows[of A xs] by simp
     have hyp: "\<exists>P. P \<in> carrier_mat m m \<and> invertible_mat P \<and> Hermite_of_list_of_rows A xs = P * A"
       by (rule snoc.hyps[OF xs], insert False all_n_xs_x, auto)
     have rw: "Hermite_of_list_of_rows A (xs @ [x]) 
         = Hermite_of_row_i (Hermite_of_list_of_rows A xs) x" 
       unfolding Hermite_of_list_of_rows_append ..
     have *: "Hermite_of_row_i ?A x = ?A \<or> Hermite_of_row_i ?A x = multrow 0 (- 1) ?A"
     proof (rule Hermite_of_row_i_id_mx1'[OF _ _ A'])
       show "echelon_form_JNF ?A"
         using A eA echelon_form_JNF_Hermite_of_list_of_rows snoc(3) by auto
       show "x < dim_row ?A" using A' x i A by (simp add: snoc(3))
     qed
     show ?thesis
     proof (cases "Hermite_of_row_i ?A x = ?A")
     case True
       then show ?thesis 
         by (simp add: hyp rw)
     next
       case False
       let ?M = "multrow_mat m 0 (-1)::int mat"
       obtain P where P: "P \<in> carrier_mat m m" 
         and inv_P: "invertible_mat P" and H_PA: "Hermite_of_list_of_rows A xs = P * A"
         using hyp by auto
       have M: "?M \<in> carrier_mat m m" by auto
       have inv_M: "invertible_mat ?M"
         by (metis (full_types) det_multrow_mat dvd_mult_right invertible_iff_is_unit_JNF
             invertible_mat_zero more_arith_simps(10) mult_minus1_right multrow_mat_carrier neq0_conv)
       have H_MA': "Hermite_of_row_i ?A x = ?M * ?A" using False * H multrow_mat by metis
       have inv_MP: "invertible_mat (?M*P)" using M inv_M P inv_P invertible_mult_JNF by blast
       moreover have MP: "(?M*P) \<in> carrier_mat m m" using M P by fastforce
       moreover have "Hermite_of_list_of_rows A (xs @ [x]) = (?M*P) * A"
         by (metis A H_MA' H_PA M P assoc_mult_mat rw)  
       ultimately show ?thesis by blast
     qed  
   qed
 qed
 
 
 corollary invertible_Hermite_of_list_of_rows_mx1:
   assumes "A \<in> carrier_mat m 1" and eA: "echelon_form_JNF A"
   shows "\<exists>P. P \<in> carrier_mat m m \<and> invertible_mat P \<and> Hermite_of_list_of_rows A [0..<m] = P * A"
 proof (cases "m=0")
   case True
   then show ?thesis 
     by (auto, metis assms(1) invertible_mat_one left_mult_one_mat one_carrier_mat)
 next
   case False
   then show ?thesis using invertible_Hermite_of_list_of_rows_mx1' assms by simp
 qed
   
 
 lemma Hermite_of_list_of_rows_mx0:
   assumes A: "A \<in> carrier_mat m 0"
   and xs: "xs = [0..<i]" and x: "\<forall>x\<in> set xs. x < m"
 shows "Hermite_of_list_of_rows A xs = A"
   using xs x
 proof (induct xs arbitrary: i rule: rev_induct)
   case Nil
   then show ?case by auto
 next
   case (snoc x xs)    
   note all_n_xs_x = snoc.prems(2)
   note xs_x = snoc.prems(1)
   have i0: "i>0" using neq0_conv snoc(2) by fastforce
   have i_list_rw:"[0..<i] = [0..<i-1] @ [i-1]" using i0 less_imp_Suc_add by fastforce
   hence xs: "xs = [0..<i-1]" using xs_x by force
   hence x: "x=i-1" using i_list_rw xs_x by auto
   have H: "Hermite_of_list_of_rows A xs \<in> carrier_mat m 0"
     using A Hermite_of_list_of_rows[of A xs] by auto
   define A' where "A' = (Hermite_of_list_of_rows A xs)"
   have A'A: "A' = A" by (unfold A'_def, rule snoc.hyps, insert snoc.prems xs, auto)
   have "Hermite_of_list_of_rows A (xs @ [x]) = Hermite_of_row_i A' x"
     using Hermite_of_list_of_rows_append A'_def by auto
   also have "... = A"
   proof (cases "find_fst_non0_in_row x A'")
     case None
     then show ?thesis unfolding Hermite_of_row_i_def using A'A by auto
     next
       case (Some a)
     then show ?thesis
       by (metis (full_types) A'A A carrier_matD(2) find_fst_non0_in_row(3) zero_order(3))
   qed
   finally show ?case .
 qed
 
 
 text \<open>Again, we move more lemmas from HOL Analysis (with mod-type restrictions) to the JNF matrix
 representation.\<close>
 
 (*
 The following lemmas will be transferred from HOL Analysis to JNF:
 thm Hermite_Hermite_of_upt_row_i
 thm invertible_Hermite_of_upt_row_i
 *)
 
 context
 begin
 
 private lemma Hermite_Hermite_of_list_of_rows_mod_type:
   fixes A::"int mat"
   assumes "A \<in> carrier_mat CARD('m::mod_type) CARD('n::mod_type)"
   assumes eA: "echelon_form_JNF A"
 shows "Hermite_JNF (range ass_function_euclidean) 
   (\<lambda>c. range (res_int c)) (Hermite_of_list_of_rows A [0..<CARD('m)])"
 proof -
   define A' where "A' = (Mod_Type_Connect.to_hma\<^sub>m A :: int ^'n :: mod_type ^'m :: mod_type)"
   have AA'[transfer_rule]: "Mod_Type_Connect.HMA_M A A'"
     unfolding Mod_Type_Connect.HMA_M_def using assms A'_def by auto 
   have eA'[transfer_rule]: "echelon_form A'" using eA by transfer
   have [transfer_rule]: "Mod_Type_Connect.HMA_M (Hermite_of_list_of_rows A [0..<CARD('m)]) 
   (Hermite_of_upt_row_i A' (CARD('m)) ass_function_euclidean res_int)"
     by (rule HMA_Hermite_of_upt_row_i[OF _ _ AA' eA], auto)
   have [transfer_rule]: " (range ass_function_euclidean) =  (range ass_function_euclidean)" ..
   have [transfer_rule]: "(\<lambda>c. range (res_int c)) = (\<lambda>c. range (res_int c))" ..
   have n: "CARD('m) = nrows A'" using AA' unfolding nrows_def by auto
   have "Hermite (range ass_function_euclidean) (\<lambda>c. range (res_int c)) 
   (Hermite_of_upt_row_i A' (CARD('m)) ass_function_euclidean res_int)"
     by (unfold n, rule Hermite_Hermite_of_upt_row_i[OF ass_function_euclidean res_function_res_int eA'])    
   thus ?thesis by transfer
 qed 
 
 private lemma invertible_Hermite_of_list_of_rows_mod_type:
   fixes A::"int mat"
   assumes "A \<in> carrier_mat CARD('m::mod_type) CARD('n::mod_type)"
   assumes eA: "echelon_form_JNF A"
   shows "\<exists>P. P \<in> carrier_mat CARD('m) CARD('m) \<and> 
     invertible_mat P \<and> Hermite_of_list_of_rows A [0..<CARD('m)] = P * A"
 proof -
   define A' where "A' = (Mod_Type_Connect.to_hma\<^sub>m A :: int ^'n :: mod_type ^'m :: mod_type)"
   have AA'[transfer_rule]: "Mod_Type_Connect.HMA_M A A'"
     unfolding Mod_Type_Connect.HMA_M_def using assms A'_def by auto 
   have eA'[transfer_rule]: "echelon_form A'" using eA by transfer
   have [transfer_rule]: "Mod_Type_Connect.HMA_M (Hermite_of_list_of_rows A [0..<CARD('m)]) 
   (Hermite_of_upt_row_i A' (CARD('m)) ass_function_euclidean res_int)"
     by (rule HMA_Hermite_of_upt_row_i[OF _ _ AA' eA], auto)
   have [transfer_rule]: " (range ass_function_euclidean) =  (range ass_function_euclidean)" ..
   have [transfer_rule]: "(\<lambda>c. range (res_int c)) = (\<lambda>c. range (res_int c))" ..
   have n: "CARD('m) = nrows A'" using AA' unfolding nrows_def by auto
   have "\<exists>P. invertible P \<and> Hermite_of_upt_row_i A' (CARD('m)) ass_function_euclidean res_int 
       = P ** A'" by (rule invertible_Hermite_of_upt_row_i[OF ass_function_euclidean])
   thus ?thesis by (transfer, auto)
 qed
 
 
 private lemma Hermite_Hermite_of_list_of_rows_nontriv_mod_ring:
   fixes A::"int mat"
   assumes "A \<in> carrier_mat CARD('m::nontriv mod_ring) CARD('n::nontriv mod_ring)"
   assumes eA: "echelon_form_JNF A"
 shows "Hermite_JNF (range ass_function_euclidean) 
   (\<lambda>c. range (res_int c)) (Hermite_of_list_of_rows A [0..<CARD('m)])"
 using assms Hermite_Hermite_of_list_of_rows_mod_type by (smt CARD_mod_ring) 
 
 private lemma invertible_Hermite_of_list_of_rows_nontriv_mod_ring:
   fixes A::"int mat"
   assumes "A \<in> carrier_mat CARD('m::nontriv mod_ring) CARD('n::nontriv mod_ring)"
   assumes eA: "echelon_form_JNF A"
   shows "\<exists>P. P \<in> carrier_mat CARD('m) CARD('m) \<and> 
     invertible_mat P \<and> Hermite_of_list_of_rows A [0..<CARD('m)] = P * A"
 using assms invertible_Hermite_of_list_of_rows_mod_type by (smt CARD_mod_ring) 
 
 
 (*We internalize both sort constraints in one step*)
 lemmas Hermite_Hermite_of_list_of_rows_nontriv_mod_ring_internalized = 
   Hermite_Hermite_of_list_of_rows_nontriv_mod_ring[unfolded CARD_mod_ring, 
       internalize_sort "'m::nontriv", internalize_sort "'b::nontriv"]
 
 lemmas invertible_Hermite_of_list_of_rows_nontriv_mod_ring_internalized = 
   invertible_Hermite_of_list_of_rows_nontriv_mod_ring[unfolded CARD_mod_ring, 
       internalize_sort "'m::nontriv", internalize_sort "'b::nontriv"]
 
 
 context
   fixes m::nat and n::nat
   assumes local_typedef1: "\<exists>(Rep :: ('b \<Rightarrow> int)) Abs. type_definition Rep Abs {0..<m :: int}"
   assumes local_typedef2: "\<exists>(Rep :: ('c \<Rightarrow> int)) Abs. type_definition Rep Abs {0..<n :: int}"
   and m: "m>1"
   and n: "n>1"
 begin
 
 lemma Hermite_Hermite_of_list_of_rows_nontriv_mod_ring_aux:
  fixes A::"int mat"
    assumes "A \<in> carrier_mat m n"
   assumes eA: "echelon_form_JNF A"
 shows "Hermite_JNF (range ass_function_euclidean) 
   (\<lambda>c. range (res_int c)) (Hermite_of_list_of_rows A [0..<m])"
   using Hermite_Hermite_of_list_of_rows_nontriv_mod_ring_internalized
     [OF type_to_set2(1)[OF local_typedef1 local_typedef2] 
         type_to_set1(1)[OF local_typedef1 local_typedef2]]
   using assms 
   using type_to_set1(2) local_typedef1 local_typedef2 n m by metis 
 
 
 
 lemma invertible_Hermite_of_list_of_rows_nontriv_mod_ring_aux:
   fixes A::"int mat"
   assumes "A \<in> carrier_mat m n"
   assumes eA: "echelon_form_JNF A"
   shows "\<exists>P. P \<in> carrier_mat m m \<and> invertible_mat P \<and> Hermite_of_list_of_rows A [0..<m] = P * A"
 using invertible_Hermite_of_list_of_rows_nontriv_mod_ring_internalized
     [OF type_to_set2(1)[OF local_typedef1 local_typedef2] 
         type_to_set1(1)[OF local_typedef1 local_typedef2]]
   using assms 
   using type_to_set1(2) local_typedef1 local_typedef2 n m by metis 
 end
 
 
 (*Canceling the first local type definitions*)
 context
 begin
 
 (*Canceling the first*)
 private lemma invertible_Hermite_of_list_of_rows_cancelled_first:
   "\<exists>Rep Abs. type_definition Rep Abs {0..<int n} 
   \<Longrightarrow> 1 < m \<Longrightarrow> 1 < n \<Longrightarrow> A \<in> carrier_mat m n \<Longrightarrow> echelon_form_JNF A 
   \<Longrightarrow> \<exists>P. P \<in> carrier_mat m m \<and> invertible_mat P \<and> Hermite_of_list_of_rows A [0..<m] = P * A"
   using invertible_Hermite_of_list_of_rows_nontriv_mod_ring_aux[cancel_type_definition, of m n A]
   by auto  
 
 (*Canceling the second*)
 private lemma invertible_Hermite_of_list_of_rows_cancelled_both:
   "1 < m \<Longrightarrow> 1 < n \<Longrightarrow> A \<in> carrier_mat m n \<Longrightarrow> echelon_form_JNF A 
   \<Longrightarrow> \<exists>P. P \<in> carrier_mat m m \<and> invertible_mat P \<and> Hermite_of_list_of_rows A [0..<m] = P * A"
   using invertible_Hermite_of_list_of_rows_cancelled_first[cancel_type_definition, of n m A] by simp
 
 
 (*Canceling the first*)
 
 private lemma Hermite_Hermite_of_list_of_rows_cancelled_first:
 "\<exists>Rep Abs. type_definition Rep Abs {0..<int n} \<Longrightarrow>
   1 < m \<Longrightarrow>
   1 < n \<Longrightarrow>
   A \<in> carrier_mat m n \<Longrightarrow>
   echelon_form_JNF A 
   \<Longrightarrow> Hermite_JNF (range ass_function_euclidean) (\<lambda>c. range (res_int c)) (Hermite_of_list_of_rows A [0..<m])"
   using Hermite_Hermite_of_list_of_rows_nontriv_mod_ring_aux[cancel_type_definition, of m n A]
   by auto  
 
 (*Canceling the second*)
 private lemma Hermite_Hermite_of_list_of_rows_cancelled_both:
 "1 < m \<Longrightarrow>
   1 < n \<Longrightarrow>
   A \<in> carrier_mat m n \<Longrightarrow>
   echelon_form_JNF A 
   \<Longrightarrow> Hermite_JNF (range ass_function_euclidean) (\<lambda>c. range (res_int c)) (Hermite_of_list_of_rows A [0..<m])"
   using Hermite_Hermite_of_list_of_rows_cancelled_first[cancel_type_definition, of n m A] by simp
 
 
 (*The final results in JNF*)
 
 lemma Hermite_Hermite_of_list_of_rows':
  fixes A::"int mat"
   assumes "A \<in> carrier_mat m n"
     and "echelon_form_JNF A"  
   and "1 < m" and "1 < n" (*Required from the mod_type restrictions*)
 shows "Hermite_JNF (range ass_function_euclidean) 
   (\<lambda>c. range (res_int c)) (Hermite_of_list_of_rows A [0..<m])"  
   using Hermite_Hermite_of_list_of_rows_cancelled_both assms by auto
 
 corollary Hermite_Hermite_of_list_of_rows:
  fixes A::"int mat"
   assumes A: "A \<in> carrier_mat m n"
     and eA: "echelon_form_JNF A"  
 shows "Hermite_JNF (range ass_function_euclidean) 
   (\<lambda>c. range (res_int c)) (Hermite_of_list_of_rows A [0..<m])"
 proof (cases "m=0 \<or> n=0")
   case True
   then show ?thesis 
     by (auto, metis Hermite_Hermite_of_row_i Hermite_JNF_def A eA carrier_matD(1) one_carrier_mat zero_order(3))   
      (metis Hermite_Hermite_of_row_i Hermite_JNF_def Hermite_of_list_of_rows A carrier_matD(2) 
        echelon_form_mx0 is_zero_row_JNF_def mat_carrier zero_order(3))
 next
   case False note not_m0_or_n0 = False
   show ?thesis
   proof (cases "m=1 \<or> n=1")
     case True
     then show ?thesis
       by (metis False Hermite_of_list_of_rows_1xn Hermite_of_list_of_rows_mx1 A eA 
           atLeastLessThan_iff linorder_not_less neq0_conv set_upt upt_eq_Nil_conv)
   next
     case False
     show ?thesis
       by (rule Hermite_Hermite_of_list_of_rows'[OF A eA], insert not_m0_or_n0 False, auto)
   qed
 qed
 
 lemma invertible_Hermite_of_list_of_rows:
   assumes A: "A \<in> carrier_mat m n"
   and eA: "echelon_form_JNF A"
 shows "\<exists>P. P \<in> carrier_mat m m \<and> invertible_mat P \<and> Hermite_of_list_of_rows A [0..<m] = P * A"
 proof (cases "m=0 \<or> n=0")
   case True
   have *: "Hermite_of_list_of_rows A [0..<m] = A" if n: "n=0"
     by (rule Hermite_of_list_of_rows_mx0, insert A n, auto)
   show ?thesis using True
     by (auto, metis assms(1) invertible_mat_one left_mult_one_mat one_carrier_mat)
        (metis (full_types) "*" assms(1) invertible_mat_one left_mult_one_mat one_carrier_mat)
 next
   case False note mn = False
   show ?thesis
   proof (cases "m=1 \<or> n=1")
     case True
     then show ?thesis 
       using A eA invertible_Hermite_of_list_of_rows_1xn invertible_Hermite_of_list_of_rows_mx1 by blast
   next
     case False
     then show ?thesis 
       using invertible_Hermite_of_list_of_rows_cancelled_both[OF _ _ A eA] False mn by auto
   qed  
 qed
 end
 end
 end
 end
 
 
 text \<open>Now we have all the required stuff to prove the soundness of the algorithm.\<close>
 
 context proper_mod_operation
 begin
 
 (*
 thm invertible_Hermite_of_list_of_rows
 thm Hermite_Hermite_of_list_of_rows
 thm LLL_with_assms.Hermite_append_det_id
 thm FindPreHNF_invertible_mat
 thm FindPreHNF_echelon_form
 *)
 
 lemma Hermite_mod_det_mx0:
   assumes "A \<in> carrier_mat m 0"
   shows "Hermite_mod_det abs_flag A = A"
   unfolding Hermite_mod_det_def Let_def using assms by auto
 
 lemma Hermite_JNF_mx0:
   assumes A: "A \<in> carrier_mat m 0"
   shows "Hermite_JNF (range ass_function_euclidean) (\<lambda>c. range (res_int c)) A"
   unfolding Hermite_JNF_def using A echelon_form_mx0 unfolding is_zero_row_JNF_def 
   using ass_function_Complete_set_non_associates[OF ass_function_euclidean]
   using res_function_Complete_set_residues[OF res_function_res_int] by auto
   
 
 lemma Hermite_mod_det_soundness_mx0:
   assumes  A: "A \<in> carrier_mat m n"
   and n0: "n=0"
 shows "Hermite_JNF (range ass_function_euclidean) (\<lambda>c. range (res_int c)) (Hermite_mod_det abs_flag A)" 
 and "(\<exists>P. invertible_mat P \<and> P \<in> carrier_mat m m \<and> (Hermite_mod_det abs_flag A) = P * A)"
 proof -
   have A: "A \<in> carrier_mat m 0" using A n0 by blast
   then show "Hermite_JNF (range ass_function_euclidean) (\<lambda>c. range (res_int c)) (Hermite_mod_det abs_flag A)"
     using Hermite_JNF_mx0[OF A] Hermite_mod_det_mx0[OF A] by auto
   show "(\<exists>P. invertible_mat P \<and> P \<in> carrier_mat m m \<and> (Hermite_mod_det abs_flag A) = P * A)"
     by (metis A Hermite_mod_det_mx0 invertible_mat_one left_mult_one_mat one_carrier_mat)
 qed
 
 
 lemma Hermite_mod_det_soundness_mxn:
   assumes mn: "m = n"
   and A: "A \<in> carrier_mat m n"
   and n0: "0<n"
   and inv_RAT_A: "invertible_mat (map_mat rat_of_int A)"
 shows "Hermite_JNF (range ass_function_euclidean) (\<lambda>c. range (res_int c)) (Hermite_mod_det abs_flag A)" 
   and "(\<exists>P. invertible_mat P \<and> P \<in> carrier_mat m m \<and> (Hermite_mod_det abs_flag A) = P * A)"
 proof -
   define D A' E H H' where D_def: "D = \<bar>Determinant.det A\<bar>"
   and A'_def: "A' = A @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n" and E_def: "E = FindPreHNF abs_flag D A'"
   and H_def: "H = Hermite_of_list_of_rows E [0..<m+n]"
   and H'_def: "H' = mat_of_rows n (map (Matrix.row H) [0..<m])"
   have A': "A' \<in> carrier_mat (m+n) n" using A A A'_def by auto
   let ?RAT = "of_int_hom.mat_hom :: int mat \<Rightarrow> rat mat"
   have RAT_A: "?RAT A \<in> carrier_mat n n"
     using A map_carrier_mat mat_of_rows_carrier(1) mn by auto 
   have det_RAT_fs_init: "det (?RAT A) \<noteq> 0"
     using inv_RAT_A unfolding invertible_iff_is_unit_JNF[OF RAT_A] by auto
   moreover have "mat_of_rows n (map (Matrix.row A') [0..<n]) = A"
   proof
     let ?A' = "mat_of_rows n (map (Matrix.row A') [0..<n])"    
     show dr: "dim_row ?A' = dim_row A" and dc: "dim_col ?A' = dim_col A" using A mn by auto
     fix i j assume i: "i < dim_row A" and j: "j < dim_col A"
     have D: "D \<cdot>\<^sub>m 1\<^sub>m n \<in> carrier_mat n n" using mn by auto
     have "?A' $$ (i,j) =  (map (Matrix.row A') [0..<n]) ! i $v j"
       by (rule mat_of_rows_index, insert i j dr dc A, auto) 
     also have "... = A' $$ (i,j)" using A' mn i j A by auto
     also have "... = A $$ (i,j)" unfolding A'_def using i append_rows_nth[OF A D] mn j A by auto
     finally show "?A' $$ (i, j) = A $$ (i, j)" .
   qed
   ultimately have inv_RAT_A'n: 
     "invertible_mat (map_mat rat_of_int (mat_of_rows n (map (Matrix.row A') [0..<n])))" 
     using inv_RAT_A by auto
   have eE: "echelon_form_JNF E"
     by (unfold E_def, rule FindPreHNF_echelon_form[OF A'_def A _ _],
         insert mn D_def det_RAT_fs_init, auto)
   have E: "E \<in> carrier_mat (m+n) n" unfolding E_def by (rule FindPreHNF[OF A'])
   have "\<exists>P. P \<in> carrier_mat (m + n) (m + n) \<and> invertible_mat P \<and> E = P * A'"
   by (unfold E_def, rule FindPreHNF_invertible_mat[OF A'_def A n0 _ _],
       insert mn D_def det_RAT_fs_init, auto)
   from this obtain P where P: "P \<in> carrier_mat (m + n) (m + n)"
     and inv_P: "invertible_mat P" and E_PA': "E = P * A'"
     by blast
   have "\<exists>Q. Q \<in> carrier_mat (m+n) (m+n) \<and> invertible_mat Q \<and> H = Q * E"
     by (unfold H_def, rule invertible_Hermite_of_list_of_rows[OF E eE])  
   from this obtain Q where Q: "Q \<in> carrier_mat (m+n) (m+n)"
     and inv_Q: "invertible_mat Q" and H_QE: "H = Q * E" by blast
   let ?ass ="(range ass_function_euclidean)"
   let ?res = "(\<lambda>c. range (res_int c))"
   have Hermite_H: "Hermite_JNF (range ass_function_euclidean) (\<lambda>c. range (res_int c)) H"
     by (unfold H_def, rule Hermite_Hermite_of_list_of_rows[OF E eE])
   hence eH: "echelon_form_JNF H" unfolding Hermite_JNF_def by auto
   have H': "H' \<in> carrier_mat m n" using H'_def by auto
   have H_H'0: "H = H' @\<^sub>r 0\<^sub>m m n"
   proof (unfold H'_def, rule upper_triangular_append_zero)
     show "upper_triangular' H" using eH by (rule echelon_form_JNF_imp_upper_triangular)
     show "H \<in> carrier_mat (m + m) n"
       unfolding H_def using Hermite_of_list_of_rows[of E] E mn by auto
   qed (insert mn, simp)
   obtain P' where PP': "inverts_mat P P'"
     and P'P: "inverts_mat P' P" and P': "P' \<in> carrier_mat (m+n) (m+n)"         
     using P inv_P obtain_inverse_matrix by blast
   obtain Q' where QQ': "inverts_mat Q Q'"
     and Q'Q: "inverts_mat Q' Q" and Q': "Q' \<in> carrier_mat (m+n) (m+n)"         
     using Q inv_Q obtain_inverse_matrix by blast
   have P'Q': "(P'*Q') \<in> carrier_mat (m + m) (m + m)" using P' Q' mn by simp
   have A'_P'Q'H: "A' = P' * Q' * H"
   proof -
     have QP: "Q * P \<in> carrier_mat (m + m) (m + m)" using Q P mn by auto
     have "H = Q * (P * A')" using H_QE E_PA' by auto
     also have "... = (Q * P) * A'" using A' P Q by auto
     also have "(P' * Q') * ... = ((P' * Q') * (Q * P)) * A'" using A' P'Q' QP mn by auto
     also have "... =  (P' * (Q' * Q) * P) * A'"
       by (smt P P' P'Q' Q Q' assms(1) assoc_mult_mat)
     also have "... = (P'*P) * A'" 
       by (metis P' Q' Q'Q carrier_matD(1) inverts_mat_def right_mult_one_mat)
     also have "... = A'"
       by (metis A' P' P'P carrier_matD(1) inverts_mat_def left_mult_one_mat)
     finally show "A' = P' * Q' * H" ..
   qed
   have inv_P'Q': "invertible_mat (P' * Q')"
     by (metis P' P'P PP' Q' Q'Q QQ' carrier_matD(1) carrier_matD(2) invertible_mat_def
         invertible_mult_JNF square_mat.simps)
   interpret vec_module "TYPE(int)" .
   interpret B: cof_vec_space n "TYPE(rat)" .
   interpret A: LLL_with_assms n m "(Matrix.rows A)" "4/3"
   proof       
     show "length (rows A) = m " using A unfolding Matrix.rows_def by simp
     have s: "set (map of_int_hom.vec_hom (rows A)) \<subseteq> carrier_vec n"
       using A unfolding Matrix.rows_def by auto
     have rw: "(map of_int_hom.vec_hom (rows A)) = (rows (?RAT A))" 
       by (metis A s carrier_matD(2) mat_of_rows_map mat_of_rows_rows rows_mat_of_rows set_rows_carrier subsetI)
     have "B.lin_indpt (set (map of_int_hom.vec_hom (rows A)))"
       unfolding rw by (rule B.det_not_0_imp_lin_indpt_rows[OF RAT_A det_RAT_fs_init])
     moreover have "distinct (map of_int_hom.vec_hom (rows A)::rat Matrix.vec list)"
     proof (rule ccontr)
       assume " \<not> distinct (map of_int_hom.vec_hom (rows A)::rat Matrix.vec list)"
       from this obtain i j where "row (?RAT A) i = row (?RAT A) j" and "i \<noteq> j" and "i < n" and "j < n"
         unfolding rw
         by (metis Determinant.det_transpose RAT_A add_0 cols_transpose det_RAT_fs_init 
             not_add_less2 transpose_carrier_mat vec_space.det_rank_iff vec_space.non_distinct_low_rank)
       thus False using Determinant.det_identical_rows[OF RAT_A] using det_RAT_fs_init RAT_A by auto      
     qed      
     ultimately show "B.lin_indpt_list (map of_int_hom.vec_hom (rows A))"
       using s unfolding B.lin_indpt_list_def by auto
   qed (simp)
   have A_eq: "mat_of_rows n (Matrix.rows A) = A" using A mat_of_rows_rows by blast
   have D_A: "D = \<bar>det (mat_of_rows n (rows A))\<bar>" using D_def A_eq by auto
   have Hermite_H': "Hermite_JNF ?ass ?res H'"
     by (rule A.Hermite_append_det_id(1)[OF _ mn _ H' H_H'0 P'Q' inv_P'Q' A'_P'Q'H Hermite_H],
          insert D_def A'_def mn A inv_RAT_A D_A A_eq, auto) 
   have dc: "dim_row A = m" and dr: "dim_col A = n" using A by auto
   have Hermite_mod_det_H': "Hermite_mod_det abs_flag A = H'" 
     unfolding Hermite_mod_det_def Let_def H'_def H_def E_def A'_def D_def dc dr det_int by blast
   show "Hermite_JNF ?ass ?res (Hermite_mod_det abs_flag A)" using Hermite_mod_det_H' Hermite_H' by simp
   have "\<exists>R. invertible_mat R \<and> R \<in> carrier_mat m m \<and> A = R * H'"
     by (subst A_eq[symmetric], 
         rule A.Hermite_append_det_id(2)[OF _ mn _ H' H_H'0 P'Q' inv_P'Q' A'_P'Q'H Hermite_H],
         insert D_def A'_def mn A inv_RAT_A D_A A_eq, auto)
   from this obtain R where inv_R: "invertible_mat R" 
     and R: "R \<in> carrier_mat m m" and A_RH': "A = R * H'"
     by blast
   obtain R' where inverts_R: "inverts_mat R R'" and R': "R' \<in> carrier_mat m m"    
     by (meson R inv_R obtain_inverse_matrix)
   have inv_R': "invertible_mat R'" using inverts_R unfolding invertible_mat_def inverts_mat_def
     using R R' mat_mult_left_right_inverse by auto
   moreover have "H' = R' * A"
   proof -
     have "R' * A = R' * (R * H')" using A_RH' by auto
     also have "... = (R'*R) * H'" using H' R R' by auto
     also have "... = H'"
       by (metis H' R R' mat_mult_left_right_inverse carrier_matD(1) 
           inverts_R inverts_mat_def left_mult_one_mat)
     finally show ?thesis ..
   qed
   ultimately show "\<exists>S. invertible_mat S \<and> S \<in> carrier_mat m m \<and> Hermite_mod_det abs_flag A = S * A" 
     using R' Hermite_mod_det_H' by blast
 qed
 
 
 lemma Hermite_mod_det_soundness:
   assumes mn: "m = n"
   and A_def: "A \<in> carrier_mat m n"
   and i: "invertible_mat (map_mat rat_of_int A)"
 shows "Hermite_JNF (range ass_function_euclidean) (\<lambda>c. range (res_int c)) (Hermite_mod_det abs_flag A)" 
   and "(\<exists>P. invertible_mat P \<and> P \<in> carrier_mat m m \<and> (Hermite_mod_det abs_flag A) = P * A)" 
   using A_def Hermite_mod_det_soundness_mx0(1) Hermite_mod_det_soundness_mxn(1) mn i 
   by blast (insert Hermite_mod_det_soundness_mx0(2) Hermite_mod_det_soundness_mxn(2) assms, blast)
 
 
 text \<open>We can even move the whole echelon form algorithm @{text "echelon_form_of"} from HOL Analysis 
 to JNF and then we can combine it with @{text "Hermite_of_list_of_rows"} to have another 
 HNF algorithm which is not efficient, but valid for arbitrary matrices.\<close>
 
 lemma reduce_D0:
 "reduce a b 0 A = (let Aaj = A$$(a,0); Abj = A $$ (b,0)     
   in
   if Aaj = 0 then A else
   case euclid_ext2 Aaj Abj of (p,q,u,v,d) \<Rightarrow> 
        Matrix.mat (dim_row A) (dim_col A)
           (\<lambda>(i,k). if i = a then  (p*A$$(a,k) + q*A$$(b,k))
                    else if i = b then  u * A$$(a,k) + v * A$$(b,k)
                    else A$$(i,k)
             )
   )" (is "?lhs = ?rhs")
 proof 
   obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A $$ (a, 0)) (A $$ (b, 0))"
     by (simp add: euclid_ext2_def) 
   have *:" Matrix.mat (dim_row A) (dim_col A)
         (\<lambda>(i, k).
             if i = a then let r = p * A $$ (a, k) + q * A $$ (b, k) in if 0 < \<bar>r\<bar> then 
                                   if k = 0 \<and> 0 dvd r then 0 else r mod 0 else r
             else if i = b then let r = u * A $$ (a, k) + v * A $$ (b, k) in 
                               if 0 < \<bar>r\<bar> then r mod 0 else r else A $$ (i, k)) 
         = Matrix.mat (dim_row A) (dim_col A)
           (\<lambda>(i,k). if i = a then  (p*A$$(a,k) + q*A$$(b,k))
                    else if i = b then  u * A$$(a,k) + v * A$$(b,k)
                    else A$$(i,k) 
             )" 
     by (rule eq_matI, auto simp add: Let_def)
   show "dim_row ?lhs = dim_row ?rhs" 
     unfolding reduce.simps Let_def by (smt dim_row_mat(1) pquvd prod.simps(2))
   show "dim_col ?lhs = dim_col ?rhs"
     unfolding reduce.simps Let_def by (smt dim_col_mat(1) pquvd prod.simps(2))
   fix i j assume i: "i<dim_row ?rhs" and j: "j<dim_col ?rhs"
   show "?lhs $$ (i,j) = ?rhs $$ (i,j)"
     by (cases " A $$ (a, 0) = 0", insert * pquvd i j, auto simp add: case_prod_beta Let_def)
 qed
 
 
 
 lemma bezout_matrix_JNF_mult_eq':
   assumes A': "A' \<in> carrier_mat m n" and a: "a<m"  and b: "b<m" and ab: "a \<noteq> b" 
   and A_def: "A = A' @\<^sub>r B" and B: "B \<in> carrier_mat t n"
   assumes pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,j)) (A$$(b,j))"
   shows "Matrix.mat (dim_row A) (dim_col A)
           (\<lambda>(i,k). if i = a then (p*A$$(a,k) + q*A$$(b,k))
                    else if i = b then u * A$$(a,k) + v * A$$(b,k)
                    else A$$(i,k)
             ) = (bezout_matrix_JNF A a b j euclid_ext2) * A" (is "?A = ?BM * A")
 proof (rule eq_matI) 
   have A: "A \<in> carrier_mat (m+t) n" using A_def A' B by simp
   hence A_carrier: "?A \<in> carrier_mat (m+t) n" by auto  
   show dr: "dim_row ?A = dim_row (?BM * A)" and dc: "dim_col ?A = dim_col (?BM * A)"
     unfolding bezout_matrix_JNF_def by auto
   fix i ja assume i: "i < dim_row  (?BM * A)" and ja: "ja < dim_col (?BM * A)"
   let ?f = "\<lambda>ia. (bezout_matrix_JNF A a b j euclid_ext2) $$ (i,ia) * A $$ (ia,ja)"
   have dv: "dim_vec (col A ja) = m+t" using A by auto
   have i_dr: "i<dim_row A" using i A unfolding bezout_matrix_JNF_def by auto
   have a_dr: "a<dim_row A" using A a ja by auto
   have b_dr: "b<dim_row A" using A b ja by auto
   show "?A $$ (i,ja) = (?BM * A) $$ (i,ja)"
   proof -
     have "(?BM * A) $$ (i,ja) = Matrix.row ?BM i \<bullet> col A ja"
       by (rule index_mult_mat, insert i ja, auto)
     also have "... = (\<Sum>ia = 0..<dim_vec (col A ja). 
           Matrix.row (bezout_matrix_JNF A a b j euclid_ext2) i $v ia * col A ja $v ia)"
       by (simp add: scalar_prod_def)
     also have "... = (\<Sum>ia = 0..<m+t. ?f ia)"
       by (rule sum.cong, insert A i dr dc, auto) (smt bezout_matrix_JNF_def carrier_matD(1) 
           dim_col_mat(1) index_col index_mult_mat(3) index_row(1) ja)
     also have "... = (\<Sum>ia \<in> ({a,b} \<union> ({0..<m+t} - {a,b})). ?f ia)"
       by (rule sum.cong, insert a a_dr b A ja, auto)
     also have "... = sum ?f {a,b} + sum ?f ({0..<m+t} - {a,b})" 
       by (rule sum.union_disjoint, auto)
     finally have BM_A_ija_eq: "(?BM * A) $$ (i,ja) = sum ?f {a,b} + sum ?f ({0..<m+t} - {a,b})" by auto
     show ?thesis
     proof (cases "i = a")
       case True
       have sum0: "sum ?f ({0..<m+t} - {a,b}) = 0"
       proof (rule sum.neutral, rule)
         fix x assume x: "x \<in> {0..<m + t} - {a, b}"
         hence xm: "x < m+t" by auto
         have x_not_i: "x \<noteq> i" using True x by blast
         have x_dr: "x < dim_row A" using x A by auto
         have "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, x) = 0"
           unfolding bezout_matrix_JNF_def 
           unfolding index_mat(1)[OF i_dr x_dr] using x_not_i x by auto
         thus "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, x) * A $$ (x, ja) = 0" by auto
       qed
       have fa: "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, a) = p" 
         unfolding bezout_matrix_JNF_def index_mat(1)[OF i_dr a_dr] using True pquvd 
         by (auto, metis split_conv)
       have fb: "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, b) = q"
         unfolding bezout_matrix_JNF_def index_mat(1)[OF i_dr b_dr] using True pquvd ab
         by (auto, metis split_conv)
       have "sum ?f {a,b} + sum ?f ({0..<m+t} - {a,b}) = ?f a + ?f b" using sum0 by (simp add: ab)
       also have "... = p * A $$ (a, ja) + q * A $$ (b, ja)" unfolding fa fb by simp
       also have "... = ?A $$ (i,ja)" using A True dr i ja by auto
       finally show ?thesis using BM_A_ija_eq by simp
     next
       case False note i_not_a = False
       show ?thesis
       proof (cases "i=b")
         case True
         have sum0: "sum ?f ({0..<m+t} - {a,b}) = 0"
         proof (rule sum.neutral, rule)
           fix x assume x: "x \<in> {0..<m + t} - {a, b}"
           hence xm: "x < m+t" by auto
           have x_not_i: "x \<noteq> i" using True x by blast
           have x_dr: "x < dim_row A" using x A by auto
           have "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, x) = 0"
             unfolding bezout_matrix_JNF_def 
             unfolding index_mat(1)[OF i_dr x_dr] using x_not_i x by auto
           thus "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, x) * A $$ (x, ja) = 0" by auto
         qed
         have fa: "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, a) = u" 
           unfolding bezout_matrix_JNF_def index_mat(1)[OF i_dr a_dr] using True i_not_a pquvd 
           by (auto, metis split_conv)
         have fb: "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, b) = v"
           unfolding bezout_matrix_JNF_def index_mat(1)[OF i_dr b_dr] using True i_not_a pquvd ab
           by (auto, metis split_conv)
         have "sum ?f {a,b} + sum ?f ({0..<m+t} - {a,b}) = ?f a + ?f b" using sum0 by (simp add: ab)
         also have "... = u * A $$ (a, ja) + v * A $$ (b, ja)" unfolding fa fb by simp
         also have "... = ?A $$ (i,ja)" using A True i_not_a dr i ja by auto
         finally show ?thesis using BM_A_ija_eq by simp
       next
         case False note i_not_b = False
         have sum0: "sum ?f ({0..<m+t} - {a,b} - {i}) = 0" 
         proof (rule sum.neutral, rule)
           fix x assume x: "x \<in> {0..<m + t} - {a, b} - {i}"
           hence xm: "x < m+t" by auto
           have x_not_i: "x \<noteq> i" using x by blast
           have x_dr: "x < dim_row A" using x A by auto
           have "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, x) = 0"
             unfolding bezout_matrix_JNF_def 
             unfolding index_mat(1)[OF i_dr x_dr] using x_not_i x by auto
           thus "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, x) * A $$ (x, ja) = 0" by auto
         qed
         have fa: "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, a) = 0" 
           unfolding bezout_matrix_JNF_def index_mat(1)[OF i_dr a_dr] using False i_not_a pquvd 
           by auto
         have fb: "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, b) = 0" 
           unfolding bezout_matrix_JNF_def index_mat(1)[OF i_dr b_dr] using False i_not_a pquvd 
           by auto
         have "sum ?f ({0..<m+t} - {a,b}) = sum ?f (insert i ({0..<m+t} - {a,b} - {i}))"
           by (rule sum.cong, insert i_dr A i_not_a i_not_b, auto)
         also have "... = ?f i + sum ?f ({0..<m+t} - {a,b} - {i})" by (rule sum.insert, auto)
         also have "... = ?f i" using sum0 by simp
         also have "... = ?A $$ (i,ja)"
           unfolding bezout_matrix_JNF_def using i_not_a i_not_b  A dr i ja by fastforce
         finally show ?thesis unfolding BM_A_ija_eq by (simp add: ab fa fb)
       qed    
     qed
   qed
 qed
 
 
 
 lemma bezout_matrix_JNF_mult_eq2:
   assumes A: "A \<in> carrier_mat m n" and a: "a<m"  and b: "b<m" and ab: "a \<noteq> b" 
   assumes pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,j)) (A$$(b,j))"
   shows "Matrix.mat (dim_row A) (dim_col A)
           (\<lambda>(i,k). if i = a then (p*A$$(a,k) + q*A$$(b,k))
                    else if i = b then u * A$$(a,k) + v * A$$(b,k)
                    else A$$(i,k)
             ) = (bezout_matrix_JNF A a b j euclid_ext2) * A" (is "?A = ?BM * A")
 proof (rule bezout_matrix_JNF_mult_eq'[OF A a b ab _ _ pquvd])
   show "A = A @\<^sub>r (0\<^sub>m 0 n)" by (rule eq_matI, unfold append_rows_def, auto)
   show "(0\<^sub>m 0 n) \<in> carrier_mat 0 n" by auto
 qed
 
 
 lemma reduce_invertible_mat_D0_BM:
   assumes A: "A \<in> carrier_mat m n"
   and a: "a < m"
   and b: "b < m"
   and ab: "a \<noteq> b"
   and Aa0: "A$$(a,0) \<noteq> 0"
   shows "reduce a b 0 A = (bezout_matrix_JNF A a b 0 euclid_ext2) * A"
 proof -
  obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(b,0))"
     by (simp add: euclid_ext2_def)
   let ?BM = "bezout_matrix_JNF A a b 0 euclid_ext2"
   let ?A = "Matrix.mat (dim_row A) (dim_col A)
           (\<lambda>(i,k). if i = a then  (p*A$$(a,k) + q*A$$(b,k))
                    else if i = b then  u * A$$(a,k) + v * A$$(b,k)
                    else A$$(i,k))"
   have A'_BZ_A: "?A = ?BM * A"
     by (rule bezout_matrix_JNF_mult_eq2[OF A _ _ ab pquvd], insert a b, auto)  
   moreover have "?A = reduce a b 0 A" using pquvd Aa0 unfolding reduce_D0 Let_def
     by (metis (no_types, lifting) split_conv)
   ultimately show ?thesis by simp
 qed
 
 
 lemma reduce_invertible_mat_D0:
   assumes A: "A \<in> carrier_mat m n"
   and a: "a < m"
   and b: "b < m"
   and n0: "0<n"
   and ab: "a \<noteq> b"
   and a_less_b: "a<b"
   shows "\<exists>P. invertible_mat P \<and> P \<in> carrier_mat m m \<and> reduce a b 0 A = P * A"
 proof (cases "A$$(a,0) = 0")
   case True
   then show ?thesis
     by (smt A invertible_mat_one left_mult_one_mat one_carrier_mat reduce.simps)
 next
   case False
   obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(b,0))"
     by (simp add: euclid_ext2_def)
   let ?BM = "bezout_matrix_JNF A a b 0 euclid_ext2"
   have "reduce a b 0 A = ?BM * A"  by (rule reduce_invertible_mat_D0_BM[OF A a b ab False])
   moreover have invertible_bezout: "invertible_mat ?BM"
     by (rule invertible_bezout_matrix_JNF[OF A is_bezout_ext_euclid_ext2 a_less_b _ n0 False],
         insert a_less_b b, auto)      
   moreover have BM: "?BM \<in> carrier_mat m m" unfolding bezout_matrix_JNF_def using A by auto
   ultimately show ?thesis by blast
 qed
 
 lemma reduce_below_invertible_mat_D0:
   assumes A': "A \<in> carrier_mat m n" and a: "a<m" and j: "0<n"
     and "distinct xs" and "\<forall>x \<in> set xs. x < m \<and> a < x"
   and "D=0"
 shows "(\<exists>P. invertible_mat P \<and> P \<in> carrier_mat m m \<and> reduce_below a xs D A = P * A)"
   using assms
 proof (induct a xs D A arbitrary: A rule: reduce_below.induct)
   case (1 a D A)
   then show ?case
     by (auto, metis invertible_mat_one left_mult_one_mat one_carrier_mat)
 next
   case (2 a x xs D A)
   note A = "2.prems"(1)
   note a = "2.prems"(2)
   note j = "2.prems"(3)
   note d = "2.prems"(4)
   note x_xs = "2.prems"(5)
   note D0 = "2.prems"(6)
   have xm: "x < m" using "2.prems" by auto
   obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))"
     by (metis prod_cases5)
   let ?reduce_ax = "reduce a x D A"
   have reduce_ax: "?reduce_ax \<in> carrier_mat m n"
     by (metis (no_types, lifting) "2" add.comm_neutral append_rows_def 
         carrier_matD carrier_mat_triv index_mat_four_block(2,3)
         index_one_mat(2) index_smult_mat(2) index_zero_mat(2,3) reduce_preserves_dimensions)
   have h: "(\<exists>P. invertible_mat P \<and> P \<in> carrier_mat m m
     \<and> reduce_below a xs D (reduce a x D A) = P * reduce a x D A)"
     by (rule "2.hyps"[OF _ a j _ _ ],insert  d x_xs  D0 reduce_ax, auto)   
   from this obtain P where inv_P: "invertible_mat P" and P: "P \<in> carrier_mat m m"
     and rb_Pr: "reduce_below a xs D (reduce a x D A) = P * reduce a x D A" by blast
   have *: "reduce_below a (x # xs) D A = reduce_below a xs D (reduce a x D A)" by simp
   have "\<exists>Q. invertible_mat Q \<and> Q \<in> carrier_mat m m \<and> (reduce a x D A) = Q * A"
     by (unfold D0, rule reduce_invertible_mat_D0[OF A a xm j], insert "2.prems", auto)
   from this obtain Q where inv_Q: "invertible_mat Q" and Q: "Q \<in> carrier_mat m m"
     and r_QA: "reduce a x D A = Q * A" by blast
   have "invertible_mat (P*Q)" using inv_P inv_Q P Q invertible_mult_JNF by blast
   moreover have "P * Q \<in> carrier_mat m m" using P Q by auto
   moreover have "reduce_below a (x # xs) D A = (P*Q) * A" 
     by (smt P Q * assoc_mult_mat carrier_matD(1) carrier_mat_triv index_mult_mat(2) 
         r_QA rb_Pr reduce_preserves_dimensions(1))
   ultimately show ?case by blast
 qed
 
 
 (*This lemma permits to get rid of one assumption in reduce_not0*)
 lemma reduce_not0':
   assumes A: "A \<in> carrier_mat m n" and a: "a<m" and a_less_b: "a<b" and j: "0<n" and b: "b<m"
     and Aaj: "A $$ (a,0) \<noteq> 0"
   shows "reduce a b 0 A $$ (a, 0) \<noteq> 0" (is "?reduce_ab $$ (a,0) \<noteq> _")
 proof -
   have "?reduce_ab $$ (a,0) = (let r = gcd (A $$ (a, 0)) (A $$ (b, 0)) in if 0 dvd r then 0 else r)" 
     by (rule reduce_gcd[OF A _ j Aaj], insert a, simp)
   also have "... \<noteq> 0" unfolding Let_def
     by (simp add: assms(6))
   finally show ?thesis .
 qed
 
 
 lemma reduce_below_preserves_D0:
   assumes A': "A \<in> carrier_mat m n" and a: "a<m" and j: "j<n"
     and Aaj: "A $$ (a,0) \<noteq> 0"
   assumes "i \<notin> set xs" and "distinct xs" and "\<forall>x \<in> set xs. x < m \<and> a < x"
     and "i\<noteq>a" and "i<m"
   and "D=0"
   shows "reduce_below a xs D A $$ (i,j) = A $$ (i,j)"
   using assms
 proof (induct a xs D A arbitrary: A i rule: reduce_below.induct)
   case (1 a D A)
   then show ?case by auto
 next
   case (2 a x xs D A)
   note A = "2.prems"(1)
   note a = "2.prems"(2)
   note j = "2.prems"(3)
   note Aaj = "2.prems"(4)
   note i_set_xxs = "2.prems"(5)
   note d = "2.prems"(6)
   note xxs_less_m = "2.prems"(7)
   note ia = "2.prems"(8)
   note im = "2.prems"(9)
   note D0 = "2.prems"(10)
   have xm: "x < m"  using "2.prems" by auto
   obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))"
     by (metis prod_cases5)
   let ?reduce_ax = "(reduce a x D A)"
   have reduce_ax: "?reduce_ax \<in> carrier_mat m n"
     by (metis (no_types, lifting) "2" add.comm_neutral append_rows_def 
         carrier_matD carrier_mat_triv index_mat_four_block(2,3)
         index_one_mat(2) index_smult_mat(2) index_zero_mat(2,3) reduce_preserves_dimensions)
   have "reduce_below a (x # xs) D A $$ (i, j) = reduce_below a xs D (reduce a x D A) $$ (i, j)"
     by auto
   also have "... = reduce a x D A $$ (i, j)"
   proof (rule "2.hyps"[OF _ a j _ _ ])   
     show "i \<notin> set xs" using i_set_xxs by auto
     show "distinct xs" using d by auto
     show "\<forall>x\<in>set xs. x < m \<and> a < x" using xxs_less_m by auto
     show "reduce a x D A $$ (a, 0) \<noteq> 0"
       by (unfold D0, rule reduce_not0'[OF A _ _ _ _ Aaj], insert "2.prems", auto)
     show "reduce a x D A \<in> carrier_mat m n" using reduce_ax by linarith
   qed (insert "2.prems", auto)
   also have "... = A $$ (i,j)" by (rule reduce_preserves[OF A j Aaj], insert "2.prems", auto)
   finally show ?case .
 qed
 
 
 
 lemma reduce_below_0_D0:
   assumes A: "A \<in> carrier_mat m n" and a: "a<m" and j: "0<n"
     and Aaj: "A $$ (a,0) \<noteq> 0"
   assumes "i \<in> set xs" and "distinct xs" and "\<forall>x \<in> set xs. x < m \<and> a < x"
   and "D=0"
   shows "reduce_below a xs D A $$ (i,0) = 0"
   using assms
 proof (induct a xs D A arbitrary: A i rule: reduce_below.induct)
   case (1 a D A)
   then show ?case by auto 
 next
   case (2 a x xs D A)
   note A = "2.prems"(1)
   note a = "2.prems"(2)
   note j = "2.prems"(3)
   note Aaj = "2.prems"(4)
   note i_set_xxs = "2.prems"(5)
   note d = "2.prems"(6)
   note xxs_less_m = "2.prems"(7)
   note D0 = "2.prems"(8)
   have xm: "x < m"  using "2.prems" by auto
   obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))"
     by (metis prod_cases5)
   let ?reduce_ax = "reduce a x D A"
   have reduce_ax: "?reduce_ax \<in> carrier_mat m n"
     by (metis (no_types, lifting) "2" add.comm_neutral append_rows_def 
         carrier_matD carrier_mat_triv index_mat_four_block(2,3)
         index_one_mat(2) index_smult_mat(2) index_zero_mat(2,3) reduce_preserves_dimensions)
   show ?case
   proof (cases "i=x")
     case True
     have "reduce_below a (x # xs) D A $$ (i, 0) = reduce_below a xs D (reduce a x D A) $$ (i, 0)"
       by auto
     also have "... = (reduce a x D A) $$ (i, 0)"
     proof (rule reduce_below_preserves_D0[OF _ a j _ _ ])
       show "reduce a x D A \<in> carrier_mat m n" using reduce_ax by linarith
       show "distinct xs" using d by auto
       show "\<forall>x\<in>set xs. x < m \<and> a < x" using xxs_less_m by auto
       show "reduce a x D A $$ (a, 0) \<noteq> 0"
         by (unfold D0, rule reduce_not0'[OF A _ _ j _ Aaj], insert "2.prems", auto)
       show "i \<notin> set xs" using True d by auto
       show "i \<noteq> a" using "2.prems" by blast
       show "i < m" by (simp add: True trans_less_add1 xm)
     qed (insert D0)
     also have "... = 0" unfolding True by (rule reduce_0[OF A _ j _ _ Aaj], insert "2.prems", auto)
     finally show ?thesis .
   next
     case False note i_not_x = False    
     have h: "reduce_below a xs D (reduce a x D A) $$ (i, 0) = 0 "
     proof (rule "2.hyps"[OF _ a j _ _ ])
       show "reduce a x D A \<in> carrier_mat m n" using reduce_ax by linarith
       show "i \<in> set xs" using i_set_xxs i_not_x by auto
       show "distinct xs" using d by auto
       show "\<forall>x\<in>set xs. x < m \<and> a < x" using xxs_less_m by auto
       show "reduce a x D A $$ (a, 0) \<noteq> 0"
         by (unfold D0, rule reduce_not0'[OF A _ _ j _ Aaj], insert "2.prems", auto)
     qed (insert D0)
     have "reduce_below a (x # xs) D A $$ (i, 0) = reduce_below a xs D (reduce a x D A) $$ (i, 0)"
       by auto
     also have "... = 0" using h .
     finally show ?thesis .
   qed
 qed
 
 end
 
 text \<open>Definition of the echelon form algorithm in JNF\<close>
 
 primrec bezout_iterate_JNF
 where "bezout_iterate_JNF A 0 i j bezout = A"
     | "bezout_iterate_JNF A (Suc n) i j bezout = 
         (if (Suc n) \<le> i then A else 
               bezout_iterate_JNF (bezout_matrix_JNF A i ((Suc n)) j bezout * A) n i j bezout)"
 
 definition 
   "echelon_form_of_column_k_JNF bezout A' k = 
     (let (A, i) = A' 
      in if (i = dim_row A) \<or> (\<forall>m \<in> {i..<dim_row A}. A $$ (m, k) = 0) then (A, i) else 
         if (\<forall>m\<in>{i+1..<dim_row A}. A $$ (m,k) = 0) then (A, i + 1) else
             let n = (LEAST n. A $$ (n,k) \<noteq> 0 \<and> i \<le> n); 
                 interchange_A = swaprows i n A
            in
             (bezout_iterate_JNF (interchange_A) (dim_row A - 1) i k bezout, i + 1) )"
 
 
 definition "echelon_form_of_upt_k_JNF A k bezout = (fst (foldl (echelon_form_of_column_k_JNF bezout) (A,0) [0..<Suc k]))"
 definition "echelon_form_of_JNF A bezout = echelon_form_of_upt_k_JNF A (dim_col A - 1) bezout"
 
 
 context includes lifting_syntax
 begin
 
 lemma HMA_bezout_iterate[transfer_rule]: 
   assumes "n<CARD('m)"
   shows "((Mod_Type_Connect.HMA_M :: _ \<Rightarrow> int ^ 'n :: mod_type ^ 'm :: mod_type \<Rightarrow> _) 
      ===> (Mod_Type_Connect.HMA_I) ===> (Mod_Type_Connect.HMA_I) ===> (=) ===> (Mod_Type_Connect.HMA_M)) 
   (\<lambda>A i j bezout. bezout_iterate_JNF A n i j bezout)  
   (\<lambda>A i j bezout. bezout_iterate A n i j bezout)
   "
 proof (intro rel_funI, goal_cases)
   case (1 A A' i i' j j' bezout bezout')
   then show ?case using assms
   proof (induct n arbitrary: A A')
     case 0
     then show ?case by auto
   next
     case (Suc n)
     note AA'[transfer_rule] = "Suc.prems"(1)
     note ii'[transfer_rule] = "Suc.prems"(2)
     note jj'[transfer_rule] = "Suc.prems"(3)
     note bb'[transfer_rule] = "Suc.prems"(4)
     note Suc_n_less_m = "Suc.prems"(5)
     let ?BI_JNF = "bezout_iterate_JNF"
     let ?BI_HMA = "bezout_iterate"
     let ?from_nat_rows = "mod_type_class.from_nat :: _ \<Rightarrow> 'm"
     have Sucn[transfer_rule]: "Mod_Type_Connect.HMA_I (Suc n) (?from_nat_rows (Suc n))"
       unfolding Mod_Type_Connect.HMA_I_def
       by (simp add: Suc_lessD Suc_n_less_m mod_type_class.from_nat_to_nat)
     have n: " n < CARD('m)" using Suc_n_less_m by simp
     have [transfer_rule]: 
       "Mod_Type_Connect.HMA_M (?BI_JNF (bezout_matrix_JNF A i (Suc n) j bezout * A) n i j bezout)
      (?BI_HMA (bezout_matrix A' i' (?from_nat_rows (Suc n)) j' bezout' ** A') n i' j' bezout')"    
       by (rule Suc.hyps[OF _ ii' jj' bb' n], transfer_prover)
     moreover have "Suc n \<le> i \<Longrightarrow>  Suc n \<le> mod_type_class.to_nat i'"
       and "Suc n > i \<Longrightarrow> Suc n > mod_type_class.to_nat i'" 
       by (metis "1"(2) Mod_Type_Connect.HMA_I_def)+
     ultimately show ?case using AA' by auto
   qed
 qed
 
 
 corollary HMA_bezout_iterate'[transfer_rule]: 
   fixes A'::"int ^ 'n :: mod_type ^ 'm :: mod_type"
   assumes n: "n<CARD('m)"
   and "Mod_Type_Connect.HMA_M A A'"
    and "Mod_Type_Connect.HMA_I i i'" and "Mod_Type_Connect.HMA_I j j'" 
  shows "Mod_Type_Connect.HMA_M (bezout_iterate_JNF A n i j bezout) (bezout_iterate A' n i' j' bezout)"
   using assms HMA_bezout_iterate[OF n] unfolding rel_fun_def by force
 
 
 
 lemma snd_echelon_form_of_column_k_JNF_le_dim_row:
   assumes "i<dim_row A"
   shows "snd (echelon_form_of_column_k_JNF bezout (A,i) k ) \<le> dim_row A"   
   using assms unfolding echelon_form_of_column_k_JNF_def by auto
 
 
 
 lemma HMA_echelon_form_of_column_k[transfer_rule]: 
   assumes k: "k<CARD('n)"
   shows "((=) ===> rel_prod (Mod_Type_Connect.HMA_M :: _ \<Rightarrow> int ^ 'n :: mod_type ^ 'm :: mod_type \<Rightarrow> _) (\<lambda>a b. a=b \<and> a\<le>CARD('m))
     ===> (rel_prod (Mod_Type_Connect.HMA_M) (\<lambda>a b. a=b \<and> a\<le>CARD('m)))) 
   (\<lambda>bezout A. echelon_form_of_column_k_JNF bezout A k)  
   (\<lambda>bezout A. echelon_form_of_column_k bezout A k)
   "
 proof (intro rel_funI, goal_cases)
   case (1 bezout bezout' xa ya )
   obtain A i where xa: "xa = (A,i)" using surjective_pairing by blast
   obtain A' i' where ya: "ya = (A',i')" using surjective_pairing by blast
   have ii'[transfer_rule]: "i=i'" using "1"(2) xa ya by auto
   have i_le_m: "i\<le>CARD('m)"  using "1"(2) xa ya by auto
   have AA'[transfer_rule]: "Mod_Type_Connect.HMA_M A A'" using "1"(2) xa ya by auto
   have bb'[transfer_rule]: "bezout=bezout'" using "1" by auto
   let ?from_nat_rows = "mod_type_class.from_nat :: _ \<Rightarrow> 'm"
   let ?from_nat_cols = "mod_type_class.from_nat :: _ \<Rightarrow> 'n"
   have kk'[transfer_rule]: "Mod_Type_Connect.HMA_I k (?from_nat_cols k)"
     by (simp add: Mod_Type_Connect.HMA_I_def assms mod_type_class.to_nat_from_nat_id)
   have c1_eq: "(i = dim_row A) = (i = nrows A')"
     by (metis AA' Mod_Type_Connect.dim_row_transfer_rule nrows_def)
   have c2_eq: "(\<forall>m \<in> {i..<dim_row A}. A $$ (m, k) = 0) 
       = (\<forall>m\<ge>?from_nat_rows i. A' $ m $ ?from_nat_cols k = 0)" (is "?lhs = ?rhs") if i_not: "i\<noteq>dim_row A" 
   proof 
     assume lhs: "?lhs"
     show "?rhs"
     proof (rule+)    
       fix m 
       assume im: "?from_nat_rows i \<le> m"
       have im': "i<CARD('m)" using i_le_m i_not
         by (simp add: c1_eq dual_order.order_iff_strict nrows_def)
       let ?m' = "mod_type_class.to_nat m"
       have mm'[transfer_rule]: "Mod_Type_Connect.HMA_I ?m' m" 
         by (simp add: Mod_Type_Connect.HMA_I_def)
       from im have "mod_type_class.to_nat (?from_nat_rows i) \<le> ?m'"
         by (simp add: to_nat_mono')
       hence "?m' >= i" using im im' by (simp add: mod_type_class.to_nat_from_nat_id)
       hence "?m' \<in> {i..<dim_row A}"
         using AA' Mod_Type_Connect.dim_row_transfer_rule mod_type_class.to_nat_less_card by fastforce
       hence "A $$ (?m', k) = 0" using lhs by auto
       moreover have "A $$ (?m', k) = A' $h m $h ?from_nat_cols k" unfolding index_hma_def[symmetric] by transfer_prover
       ultimately show "A' $h m $h ?from_nat_cols k = 0" by simp
     qed
   next
     assume rhs: "?rhs"
     show "?lhs"
     proof (rule)
       fix m assume m: "m \<in> {i..<dim_row A}"
       let ?m = "?from_nat_rows m"
       have mm'[transfer_rule]: "Mod_Type_Connect.HMA_I m ?m" 
         by (metis AA' Mod_Type_Connect.HMA_I_def Mod_Type_Connect.dim_row_transfer_rule
             atLeastLessThan_iff m mod_type_class.from_nat_to_nat)
       have m_ge_i: "?m\<ge>?from_nat_rows i"
         using AA' Mod_Type_Connect.dim_row_transfer_rule from_nat_mono' m by fastforce
       hence "A' $h ?m $h ?from_nat_cols k = 0" using rhs by auto
       moreover have "A $$ (m, k) = A' $h ?m $h ?from_nat_cols k"
         unfolding index_hma_def[symmetric] by transfer_prover
       ultimately show "A $$ (m, k) = 0" by simp
     qed
   qed
   show ?case 
   proof (cases "(i = dim_row A) \<or> (\<forall>m \<in> {i..<dim_row A}. A $$ (m, k) = 0)")
     case True   
     hence *: "(\<forall>m\<ge>?from_nat_rows i. A' $ m $ ?from_nat_cols k = 0) \<or> (i = nrows A')"
       using c1_eq c2_eq by auto
     have "echelon_form_of_column_k_JNF bezout xa k = (A,i)" 
       unfolding echelon_form_of_column_k_JNF_def using True xa by auto
     moreover have "echelon_form_of_column_k bezout ya k = (A',i')"
       unfolding echelon_form_of_column_k_def Let_def using * ya ii' by simp
     ultimately show ?thesis unfolding xa ya rel_prod.simps using AA' ii' bb' i_le_m by blast    
   next
     case False note not_c1 = False
     hence im': "i<CARD('m)"
       by (metis c1_eq dual_order.order_iff_strict i_le_m nrows_def)
     have *: "(\<forall>m\<in>{i+1..<dim_row A}. A $$ (m,k) = 0) 
       = (\<forall>m>?from_nat_rows i. A' $ m $ ?from_nat_cols k = 0)" (is "?lhs = ?rhs")
     proof 
       assume lhs: "?lhs"
       show "?rhs"
       proof (rule+)    
         fix m 
         assume im: "?from_nat_rows i < m"     
         let ?m' = "mod_type_class.to_nat m"
         have mm'[transfer_rule]: "Mod_Type_Connect.HMA_I ?m' m" 
           by (simp add: Mod_Type_Connect.HMA_I_def)
         from im have "mod_type_class.to_nat (?from_nat_rows i) < ?m'"
           by (simp add: to_nat_mono)
         hence "?m' > i" using im im' by (simp add: mod_type_class.to_nat_from_nat_id)
         hence "?m' \<in> {i+1..<dim_row A}"
           using AA' Mod_Type_Connect.dim_row_transfer_rule mod_type_class.to_nat_less_card by fastforce
         hence "A $$ (?m', k) = 0" using lhs by auto
         moreover have "A $$ (?m', k) = A' $h m $h ?from_nat_cols k" unfolding index_hma_def[symmetric] by transfer_prover
         ultimately show "A' $h m $h ?from_nat_cols k = 0" by simp
       qed
     next
       assume rhs: "?rhs"
       show "?lhs"
       proof (rule)
         fix m assume m: "m \<in> {i+1..<dim_row A}"
         let ?m = "?from_nat_rows m"
         have mm'[transfer_rule]: "Mod_Type_Connect.HMA_I m ?m" 
           by (metis AA' Mod_Type_Connect.HMA_I_def Mod_Type_Connect.dim_row_transfer_rule
               atLeastLessThan_iff m mod_type_class.from_nat_to_nat)
         have m_ge_i: "?m>?from_nat_rows i"
           by (metis Mod_Type_Connect.HMA_I_def One_nat_def add_Suc_right atLeastLessThan_iff from_nat_mono
               le_simps(3) m mm' mod_type_class.to_nat_less_card nat_arith.rule0)
         hence "A' $h ?m $h ?from_nat_cols k = 0" using rhs by auto
         moreover have "A $$ (m, k) = A' $h ?m $h ?from_nat_cols k"
           unfolding index_hma_def[symmetric] by transfer_prover
         ultimately show "A $$ (m, k) = 0" by simp
       qed
     qed
     show ?thesis
     proof (cases "(\<forall>m\<in>{i+1..<dim_row A}. A $$ (m,k) = 0)")
       case True
       have "echelon_form_of_column_k_JNF bezout xa k = (A,i+1)" 
         unfolding echelon_form_of_column_k_JNF_def using True xa not_c1 by auto
       moreover have "echelon_form_of_column_k bezout ya k = (A',i'+1)"
         unfolding echelon_form_of_column_k_def Let_def using ya ii' * True c1_eq c2_eq not_c1 by auto
       ultimately show ?thesis unfolding xa ya rel_prod.simps using AA' ii' bb' i_le_m
         by (metis Mod_Type_Connect.dim_row_transfer_rule le_neq_implies_less le_simps(3) not_c1 semiring_norm(175))      
     next
       case False
       hence *: "\<not> (\<forall>m>?from_nat_rows i. A' $ m $ ?from_nat_cols k = 0)" using * by auto
       have **: "\<not> ((\<forall>m\<ge>?from_nat_rows i. A' $h m $h ?from_nat_cols k = 0) \<or> i = nrows A')"
         using c1_eq c2_eq not_c1 by auto
       define n where "n=(LEAST n. A $$ (n,k) \<noteq> 0 \<and> i \<le> n)"
       define n' where "n'=(LEAST n. A' $ n $ ?from_nat_cols k \<noteq> 0 \<and> ?from_nat_rows i \<le> n)"
       let ?interchange_A = "swaprows i n A"
       let ?interchange_A' = "interchange_rows A' (?from_nat_rows i') n'"      
       have nn'[transfer_rule]: "Mod_Type_Connect.HMA_I n n'"
       proof -
         let ?n' = "mod_type_class.to_nat n'"
         have exist: "\<exists>n. A' $ n $ ?from_nat_cols k \<noteq> 0 \<and> ?from_nat_rows i \<le> n"
           using * by auto
         from this obtain a where c: "A' $ a $ ?from_nat_cols k \<noteq> 0 \<and> ?from_nat_rows i \<le> a" by blast        
         have "n = ?n'"
         proof (unfold n_def, rule Least_equality)
           have n'n'[transfer_rule]: "Mod_Type_Connect.HMA_I ?n' n'"
             by (simp add: Mod_Type_Connect.HMA_I_def)
           have e: "(A' $ n' $ ?from_nat_cols k \<noteq> 0 \<and> ?from_nat_rows i \<le> n')"
             by (metis (mono_tags, lifting) LeastI c2_eq n'_def not_c1) 
           hence  "i \<le> mod_type_class.to_nat n'" 
             using im' mod_type_class.from_nat_to_nat to_nat_mono' by fastforce       
           moreover have "A' $ n' $ ?from_nat_cols k = A $$ (?n', k)" 
             unfolding index_hma_def[symmetric] by (transfer', auto)
           ultimately show "A $$ (?n', k) \<noteq> 0 \<and> i \<le> ?n'"
             using e by auto
           show " \<And>y. A $$ (y, k) \<noteq> 0 \<and> i \<le> y \<Longrightarrow> mod_type_class.to_nat n' \<le> y"
             by (smt AA' Mod_Type_Connect.HMA_M_def Mod_Type_Connect.from_hma\<^sub>m_def assms from_nat_mono
                 from_nat_mono' index_mat(1) linorder_not_less mod_type_class.from_nat_to_nat_id
                 mod_type_class.to_nat_less_card n'_def order.strict_trans prod.simps(2) wellorder_Least_lemma(2))
         qed
         thus ?thesis unfolding Mod_Type_Connect.HMA_I_def by auto
       qed
       have dr1[transfer_rule]: "(nrows A' - 1) = (dim_row A - 1)" unfolding nrows_def
         using AA' Mod_Type_Connect.dim_row_transfer_rule by force
       have ii'2[transfer_rule]: "Mod_Type_Connect.HMA_I i (?from_nat_rows i')"
         by (metis "**" Mod_Type_Connect.HMA_I_def i_le_m ii' le_neq_implies_less
             mod_type_class.to_nat_from_nat_id nrows_def)
       have ii'3[transfer_rule]: "Mod_Type_Connect.HMA_I i' (?from_nat_rows i')" 
         using ii' ii'2 by blast
       let ?BI_JNF = "(bezout_iterate_JNF (?interchange_A) (dim_row A - 1) i k bezout)"
       let ?BI_HA = "(bezout_iterate (?interchange_A') (nrows A' - 1) (?from_nat_rows i) (?from_nat_cols k) bezout)"
       have e_rw: "echelon_form_of_column_k_JNF bezout xa k = (?BI_JNF,i+1)"
         unfolding echelon_form_of_column_k_JNF_def n_def using False xa not_c1 by auto
       have e_rw2: "echelon_form_of_column_k bezout ya k = (?BI_HA,i+1)"
         unfolding echelon_form_of_column_k_def Let_def n'_def using * ya ** ii' by auto
       have s[transfer_rule]: "Mod_Type_Connect.HMA_M (swaprows i' n A) (interchange_rows A' (?from_nat_rows i') n')" 
         by transfer_prover
       have n_CARD: "(nrows A' - 1) < CARD('m)" unfolding nrows_def by auto
       note a[transfer_rule] = HMA_bezout_iterate[OF n_CARD]
       have BI[transfer_rule]:"Mod_Type_Connect.HMA_M ?BI_JNF ?BI_HA" unfolding ii' dr1 
         by (rule HMA_bezout_iterate'[OF _ s ii'3 kk'], insert n_CARD, transfer', simp)
       thus ?thesis using e_rw e_rw2 bb'
         by (metis (mono_tags, lifting) AA' False Mod_Type_Connect.dim_row_transfer_rule 
             atLeastLessThan_iff dual_order.trans order_less_imp_le rel_prod_inject)
     qed
   qed
 qed
 
 corollary HMA_echelon_form_of_column_k'[transfer_rule]: 
   assumes k: "k<CARD('n)" and "i\<le>CARD('m)"
   and "(Mod_Type_Connect.HMA_M :: _ \<Rightarrow> int ^ 'n :: mod_type ^ 'm :: mod_type \<Rightarrow> _) A A'"
   shows "(rel_prod (Mod_Type_Connect.HMA_M) (\<lambda>a b. a=b \<and> a\<le>CARD('m))) 
   (echelon_form_of_column_k_JNF bezout (A,i) k)  
   (echelon_form_of_column_k bezout (A',i) k)"
   using assms HMA_echelon_form_of_column_k[OF k] unfolding rel_fun_def by force
 
 lemma HMA_foldl_echelon_form_of_column_k:
   assumes k: "k\<le>CARD('n)"
   shows "((Mod_Type_Connect.HMA_M :: _ \<Rightarrow> int ^ 'n :: mod_type ^ 'm :: mod_type \<Rightarrow> _) ===> (=)
     ===> (rel_prod (Mod_Type_Connect.HMA_M) (\<lambda>a b. a=b \<and> a\<le>CARD('m)))) 
   (\<lambda>A bezout. (foldl (echelon_form_of_column_k_JNF bezout) (A,0) [0..<k]))  
   (\<lambda>A bezout. (foldl (echelon_form_of_column_k bezout) (A,0) [0..<k]))"
 proof (intro rel_funI, goal_cases)
   case (1 A A' bezout bezout')
   then show ?case using assms
   proof (induct k arbitrary: A A' )
     case 0
     then show ?case by auto
   next
      case (Suc k)
     note AA'[transfer_rule] = "Suc.prems"(1)
     note bb'[transfer_rule] = "Suc.prems"(2)
     note Suc_k_less_m = "Suc.prems"(3)
     let ?foldl_JNF = "foldl (echelon_form_of_column_k_JNF bezout) (A,0)"
     let ?foldl_HA = "foldl (echelon_form_of_column_k bezout') (A',0)"
     have set_rw: "[0..<Suc k] = [0..<k] @ [k]" by auto
     have f_JNF: "?foldl_JNF [0..<Suc k] = echelon_form_of_column_k_JNF bezout (?foldl_JNF [0..<k]) k" 
       by auto
     have f_HA: "?foldl_HA [0..<Suc k] = echelon_form_of_column_k bezout' (?foldl_HA [0..<k]) k" 
       by auto
     have hyp[transfer_rule]: "rel_prod Mod_Type_Connect.HMA_M (\<lambda>a b. a=b \<and> a\<le>CARD('m)) (?foldl_JNF [0..<k]) (?foldl_HA [0..<k])"
       by (rule Suc.hyps[OF AA'], insert Suc.prems, auto)
     show ?case unfolding f_JNF unfolding f_HA bb' using HMA_echelon_form_of_column_k'
       by (smt "1"(2) Suc_k_less_m Suc_le_lessD hyp rel_prod.cases)
   qed
 qed
 
 
 
 lemma HMA_echelon_form_of_upt_k[transfer_rule]:
   assumes k: "k<CARD('n)"
   shows "((Mod_Type_Connect.HMA_M :: _ \<Rightarrow> int ^ 'n :: mod_type ^ 'm :: mod_type \<Rightarrow> _) ===> (=)
     ===> (Mod_Type_Connect.HMA_M)) 
   (\<lambda>A bezout. echelon_form_of_upt_k_JNF A k bezout)  
   (\<lambda>A bezout. echelon_form_of_upt_k A k bezout)
   "
 proof (intro rel_funI, goal_cases)
   case (1 A A' bezout bezout')
   have k': "Suc k \<le> CARD('n)" using k by auto
   have rel_foldl: "(rel_prod (Mod_Type_Connect.HMA_M) (\<lambda>a b. a=b \<and> a\<le>CARD('m))) 
   (foldl (echelon_form_of_column_k_JNF bezout) (A,0) [0..<Suc k])  
   (foldl (echelon_form_of_column_k bezout) (A',0) [0..<Suc k])"
     using HMA_foldl_echelon_form_of_column_k[OF k'] by (smt "1"(1) rel_fun_def)
   then show ?case using assms unfolding echelon_form_of_upt_k_JNF_def echelon_form_of_upt_k_def    
     by (metis (no_types, lifting) "1"(2) prod.collapse rel_prod_inject)
 qed
  
 
 lemma HMA_echelon_form_of[transfer_rule]:
   shows "((Mod_Type_Connect.HMA_M :: _ \<Rightarrow> int ^ 'n :: mod_type ^ 'm :: mod_type \<Rightarrow> _) ===> (=)
     ===> (Mod_Type_Connect.HMA_M)) 
   (\<lambda>A bezout. echelon_form_of_JNF A bezout)  
   (\<lambda>A bezout. echelon_form_of A bezout)
   "
 proof (intro rel_funI, goal_cases)
   case (1 A A' bezout bezout')
   note AA'[transfer_rule] = 1(1)
   note bb'[transfer_rule] = 1(2)
   have *: "(dim_col A - 1) < CARD('n)" using 1
     using Mod_Type_Connect.dim_col_transfer_rule by force
   note **[transfer_rule] = HMA_echelon_form_of_upt_k[OF *]
   have [transfer_rule]: "(ncols A' - 1) = (dim_col A - 1)"
     by (metis "1"(1) Mod_Type_Connect.dim_col_transfer_rule ncols_def)
   have [transfer_rule]: "(dim_col A - 1) = (dim_col A - 1)" ..
   show ?case unfolding echelon_form_of_def echelon_form_of_JNF_def bb'
     by (metis (mono_tags) "**" "1"(1) \<open>ncols A' - 1 = dim_col A - 1\<close> rel_fun_def)
 qed
 end
 
 
 context
 begin
 
 private lemma echelon_form_of_euclidean_invertible_mod_type:
   fixes A::"int mat"
   assumes "A \<in> carrier_mat CARD('m::mod_type) CARD('n::mod_type)"
   shows "\<exists>P. invertible_mat P \<and> P \<in> carrier_mat (CARD('m::mod_type)) (CARD('m::mod_type)) 
     \<and> P * A = echelon_form_of_JNF A euclid_ext2 
     \<and> echelon_form_JNF (echelon_form_of_JNF A euclid_ext2)"
 proof -
   define A' where "A' = (Mod_Type_Connect.to_hma\<^sub>m A :: int ^'n :: mod_type ^'m :: mod_type)"
   have AA'[transfer_rule]: "Mod_Type_Connect.HMA_M A A'"
     unfolding Mod_Type_Connect.HMA_M_def using assms A'_def by auto   
   have [transfer_rule]: "Mod_Type_Connect.HMA_M 
     (echelon_form_of_JNF A euclid_ext2) (echelon_form_of A' euclid_ext2)" 
     by transfer_prover  
   have "\<exists>P. invertible P \<and> P**A' = (echelon_form_of A' euclid_ext2) 
          \<and> echelon_form (echelon_form_of A' euclid_ext2)"
     by (rule echelon_form_of_euclidean_invertible)    
   thus ?thesis by (transfer, auto)
 qed 
 
 
 private lemma echelon_form_of_euclidean_invertible_nontriv_mod_ring:
   fixes A::"int mat"
   assumes "A \<in> carrier_mat CARD('m::nontriv mod_ring) CARD('n::nontriv mod_ring)"
   shows "\<exists>P. invertible_mat P \<and> P \<in> carrier_mat (CARD('m)) (CARD('m)) 
     \<and> P * A = echelon_form_of_JNF A euclid_ext2 
     \<and> echelon_form_JNF (echelon_form_of_JNF A euclid_ext2)"
   using assms echelon_form_of_euclidean_invertible_mod_type by (smt CARD_mod_ring)
 
 (*We internalize both sort constraints in one step*)
 lemmas echelon_form_of_euclidean_invertible_nontriv_mod_ring_internalized = 
   echelon_form_of_euclidean_invertible_nontriv_mod_ring[unfolded CARD_mod_ring, 
       internalize_sort "'m::nontriv", internalize_sort "'b::nontriv"]
 
 context
   fixes m::nat and n::nat
   assumes local_typedef1: "\<exists>(Rep :: ('b \<Rightarrow> int)) Abs. type_definition Rep Abs {0..<m :: int}"
   assumes local_typedef2: "\<exists>(Rep :: ('c \<Rightarrow> int)) Abs. type_definition Rep Abs {0..<n :: int}"
   and m: "m>1"
   and n: "n>1"
 begin
 
 lemma echelon_form_of_euclidean_invertible_nontriv_mod_ring_aux:
   fixes A::"int mat"
   assumes "A \<in> carrier_mat m n"
   shows "\<exists>P. invertible_mat P \<and> P \<in> carrier_mat m m
     \<and> P * A = echelon_form_of_JNF A euclid_ext2 
     \<and> echelon_form_JNF (echelon_form_of_JNF A euclid_ext2)"
  using echelon_form_of_euclidean_invertible_nontriv_mod_ring_internalized
     [OF type_to_set2(1)[OF local_typedef1 local_typedef2] 
         type_to_set1(1)[OF local_typedef1 local_typedef2]]
   using assms 
   using type_to_set1(2) local_typedef1 local_typedef2 n m by metis 
 
 end
 
 
 (*Canceling the first local type definitions*)
 context
 begin
 
 (*Canceling the first*)
 
 private lemma echelon_form_of_euclidean_invertible_cancelled_first:
 "\<exists>Rep Abs. type_definition Rep Abs {0..<int n} \<Longrightarrow> 1 < m \<Longrightarrow> 1 < n \<Longrightarrow>
   A \<in> carrier_mat m n \<Longrightarrow> \<exists>P. invertible_mat P \<and> P \<in> carrier_mat m m
   \<and> P * (A::int mat) = echelon_form_of_JNF A euclid_ext2 \<and> echelon_form_JNF (echelon_form_of_JNF A euclid_ext2)"
   using echelon_form_of_euclidean_invertible_nontriv_mod_ring_aux[cancel_type_definition, of m n A]
   by force  
 
 (*Canceling the second*)
 private lemma echelon_form_of_euclidean_invertible_cancelled_both:
 "1 < m \<Longrightarrow> 1 < n \<Longrightarrow> A \<in> carrier_mat m n \<Longrightarrow> \<exists>P. invertible_mat P \<and> P \<in> carrier_mat m m 
   \<and> P * (A::int mat) = echelon_form_of_JNF A euclid_ext2 \<and> echelon_form_JNF (echelon_form_of_JNF A euclid_ext2)"
   using echelon_form_of_euclidean_invertible_cancelled_first[cancel_type_definition, of n m A]
   by force
 
 (*The final result in JNF*)
 
 lemma echelon_form_of_euclidean_invertible':
  fixes A::"int mat"
   assumes "A \<in> carrier_mat m n" 
   and "1 < m" and "1 < n" (*Required from the mod_type restrictions*)
   shows "\<exists>P. invertible_mat P \<and>
         P \<in> carrier_mat m m \<and> P * A = echelon_form_of_JNF A euclid_ext2 
         \<and> echelon_form_JNF (echelon_form_of_JNF A euclid_ext2)"  
   using echelon_form_of_euclidean_invertible_cancelled_both assms by auto
 end
 end
 
 context mod_operation
 begin
 
 definition "FindPreHNF_rectangular A 
   =   (let m = dim_row A; n = dim_col A in 
   if m < 2 \<or> n = 0 then A else \<comment> \<open> No operations are carried out if m = 1 \<close>
   if n = 1 then 
         let non_zero_positions = filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<dim_row A] in
         if non_zero_positions = [] then A
         else let A' = (if A$$(0,0) \<noteq> 0 then A else let i = non_zero_positions ! 0 in swaprows 0 i A)
             in reduce_below_impl 0 non_zero_positions 0 A'
   else (echelon_form_of_JNF A euclid_ext2))"
 
 text \<open>This is the (non-efficient) HNF algorithm obtained from the echelon form and Hermite normal 
 form AFP entries\<close>
 
 definition "HNF_algorithm_from_HA A 
             = Hermite_of_list_of_rows (FindPreHNF_rectangular A) [0..<(dim_row A)]"
 
 (*
   Now we can combine FindPreHNF_rectangular, FindPreHNF and Hermite_of_list_of_rows to get
   an algorithm to compute the HNF of any matrix (if it is square and invertible, then the HNF is
   computed reducing entries modulo D)
 *)
 
 text \<open>Now we can combine @{text"FindPreHNF_rectangular"}, @{text"FindPreHNF"}
   and @{text"Hermite_of_list_of_rows"} to get an algorithm to compute the HNF of any matrix
   (if it is square and invertible, then the HNF is computed reducing entries modulo D)\<close>
 
 definition "HNF_algorithm abs_flag A = 
   (let m = dim_row A; n = dim_col A in
   if m \<noteq> n then Hermite_of_list_of_rows (FindPreHNF_rectangular A) [0..<m]
   else
     let D = abs (det_int A) in
     if D = 0 then Hermite_of_list_of_rows (FindPreHNF_rectangular A) [0..<m]
     else 
       let A' = A @\<^sub>r D \<cdot>\<^sub>m 1\<^sub>m n;
           E = FindPreHNF abs_flag D A';
           H = Hermite_of_list_of_rows E [0..<m+n]
       in mat_of_rows n (map (Matrix.row H) [0..<m]))"
 
 end
 
 declare mod_operation.FindPreHNF_rectangular_def[code]
 declare mod_operation.HNF_algorithm_from_HA_def[code]
 declare mod_operation.HNF_algorithm_def[code]
 
 context proper_mod_operation
 begin
 
 (*With some work, we could get this lemma for matrices whose elements belong to a Bézout domain*)
 lemma FindPreHNF_rectangular_soundness:
   fixes A::"int mat"
   assumes A: "A \<in> carrier_mat m n" 
   shows "\<exists>P. invertible_mat P \<and> P \<in> carrier_mat m m \<and> P * A = FindPreHNF_rectangular A 
     \<and> echelon_form_JNF (FindPreHNF_rectangular A)"  
 proof (cases "m < 2 \<or> n = 0")
   case True
   then show ?thesis
     by (smt A FindPreHNF_rectangular_def carrier_matD echelon_form_JNF_1xn echelon_form_mx0
         invertible_mat_one left_mult_one_mat one_carrier_mat)
 next
   case False 
   have m1: "m>1" using False by auto
   have n0: "n>0" using False by auto
   show ?thesis
   proof (cases "n=1")
     case True note n1 = True
     let ?nz = "filter (\<lambda>i. A $$ (i,0) \<noteq> 0) [1..<dim_row A]" 
     let ?A' = "(if A$$(0,0) \<noteq> 0 then A else let i = ?nz ! 0 in swaprows 0 i A)"
     have A': "?A' \<in> carrier_mat m n" using A by auto
     have A'00: "?A' $$ (0,0) \<noteq> 0" if "?nz \<noteq> []" 
       by (smt True assms carrier_matD index_mat_swaprows(1) length_greater_0_conv m1
           mem_Collect_eq nat_SN.gt_trans nth_mem set_filter that zero_less_one_class.zero_less_one)
     have e_r: "echelon_form_JNF (reduce_below 0 ?nz 0 ?A')" if nz_not_empty: "?nz \<noteq> []" 
     proof (rule echelon_form_JNF_mx1)
       show "(reduce_below 0 ?nz 0 ?A') \<in> carrier_mat m n"  using A reduce_below by auto
       have "(reduce_below 0 ?nz 0 ?A') $$ (i,0) = 0" if i: "i \<in> {1..<m}" for i
       proof (cases "i \<in> set ?nz")
         case True
         show ?thesis
           by (rule reduce_below_0_D0[OF A' _ _ A'00 True], insert m1 n0 True A nz_not_empty, auto)
       next
         case False
         have "(reduce_below 0 ?nz 0 ?A') $$ (i,0) = ?A' $$ (i,0)" 
           by (rule reduce_below_preserves_D0[OF A' _ _ A'00 False], insert m1 n0 True A i nz_not_empty, auto)
         also have "... = 0" using False n1 assms that by auto
         finally show ?thesis .
       qed
       thus "\<forall>i \<in> {1..<m}. (reduce_below 0 ?nz 0 ?A') $$ (i,0) = 0"
         by simp
     qed (insert True, simp)
     have "\<exists>P. invertible_mat P \<and> P \<in> carrier_mat m m \<and> reduce_below 0 ?nz 0 ?A' = P * ?A'" 
       by (rule reduce_below_invertible_mat_D0[OF A'], insert m1 n0 True A, auto)
     moreover have "\<exists>P. invertible_mat P \<and> P \<in> carrier_mat m m \<and> ?A' = P * A"   if "?nz \<noteq> []"
       using A A'_swaprows_invertible_mat m1 that by blast 
     ultimately have e_inv: "\<exists>P. invertible_mat P \<and> P \<in> carrier_mat m m \<and> reduce_below 0 ?nz 0 ?A' = P * A"
       if "?nz \<noteq> []"
       by (smt that A assoc_mult_mat invertible_mult_JNF mult_carrier_mat)
     have e_r1: "echelon_form_JNF A" if nz_empty: "?nz = []" 
     proof (rule echelon_form_JNF_mx1[OF A])
       show "\<forall>i\<in>{1..<m}. A $$ (i, 0) = 0 " using nz_empty
         by (metis (mono_tags, lifting) A carrier_matD(1) empty_filter_conv set_upt)
     qed (insert n1, simp)
     have e_inv1: "\<exists>P. invertible_mat P \<and> P \<in> carrier_mat m m \<and> A = P * A"
       by (metis A invertible_mat_one left_mult_one_mat one_carrier_mat)
     have "FindPreHNF_rectangular A = (if ?nz = [] then A else reduce_below_impl 0 ?nz 0 ?A')"
       unfolding FindPreHNF_rectangular_def Let_def using m1 n1 A True by auto
     also have "reduce_below_impl 0 ?nz 0 ?A' = reduce_below 0 ?nz 0 ?A'"
       by (rule reduce_below_impl[OF _ _ _ _ A'], insert m1 n0 A, auto)
     finally show ?thesis using e_inv e_r e_r1 e_inv1 by metis
   next
     case False
     have f_rw: "FindPreHNF_rectangular A = echelon_form_of_JNF A euclid_ext2"
       unfolding FindPreHNF_rectangular_def Let_def using m1 n0 A False by auto
     show ?thesis unfolding f_rw 
       by (rule echelon_form_of_euclidean_invertible'[OF A], insert False n0 m1, auto)
   qed
 qed
 
 lemma HNF_algorithm_from_HA_soundness:
   assumes A: "A \<in> carrier_mat m n"
   shows "Hermite_JNF (range ass_function_euclidean) (\<lambda>c. range (res_int c)) (HNF_algorithm_from_HA A)
     \<and> (\<exists>P. P \<in> carrier_mat m m \<and> invertible_mat P \<and> (HNF_algorithm_from_HA A) = P * A)"
 proof -
   have m: "dim_row A = m" using A by auto
   have "(\<exists>P. P \<in> carrier_mat m m \<and> invertible_mat P \<and> (HNF_algorithm_from_HA A) = P * (FindPreHNF_rectangular A))"
     unfolding HNF_algorithm_from_HA_def m
   proof (rule invertible_Hermite_of_list_of_rows)
     show "FindPreHNF_rectangular A \<in> carrier_mat m n"
       by (smt A FindPreHNF_rectangular_soundness mult_carrier_mat)
     show "echelon_form_JNF (FindPreHNF_rectangular A)" 
       using FindPreHNF_rectangular_soundness by blast
   qed
   moreover have "(\<exists>P. P \<in> carrier_mat m m \<and> invertible_mat P \<and> (FindPreHNF_rectangular A) = P * A)"    
     by (metis A FindPreHNF_rectangular_soundness)
   ultimately have "(\<exists>P. P \<in> carrier_mat m m \<and> invertible_mat P \<and> (HNF_algorithm_from_HA A) = P * A)"
     by (smt assms assoc_mult_mat invertible_mult_JNF mult_carrier_mat)
   moreover have "Hermite_JNF (range ass_function_euclidean) (\<lambda>c. range (res_int c)) (HNF_algorithm_from_HA A)"
     by (metis A FindPreHNF_rectangular_soundness HNF_algorithm_from_HA_def m 
         Hermite_Hermite_of_list_of_rows mult_carrier_mat)
   ultimately show ?thesis by simp
 qed
 
 
 text \<open>Soundness theorem for any matrix\<close>
 lemma HNF_algorithm_soundness:
   assumes A: "A \<in> carrier_mat m n"
   shows "Hermite_JNF (range ass_function_euclidean) (\<lambda>c. range (res_int c)) (HNF_algorithm abs_flag A)
     \<and> (\<exists>P. P \<in> carrier_mat m m \<and> invertible_mat P \<and> (HNF_algorithm abs_flag A) = P * A)"
 proof (cases "m\<noteq>n \<or> Determinant.det A = 0")
   case True
   have H_rw: "HNF_algorithm abs_flag A = Hermite_of_list_of_rows (FindPreHNF_rectangular A) [0..<m]"
     using True A unfolding HNF_algorithm_def Let_def by auto
   have "(\<exists>P. P \<in> carrier_mat m m \<and> invertible_mat P \<and> (HNF_algorithm abs_flag A) = P * (FindPreHNF_rectangular A))"
     unfolding H_rw
   proof (rule invertible_Hermite_of_list_of_rows)
     show "FindPreHNF_rectangular A \<in> carrier_mat m n"
       by (smt A FindPreHNF_rectangular_soundness mult_carrier_mat)
     show "echelon_form_JNF (FindPreHNF_rectangular A)" 
       using FindPreHNF_rectangular_soundness by blast
   qed
   moreover have "(\<exists>P. P \<in> carrier_mat m m \<and> invertible_mat P \<and> (FindPreHNF_rectangular A) = P * A)"    
     by (metis A FindPreHNF_rectangular_soundness)
   ultimately have "(\<exists>P. P \<in> carrier_mat m m \<and> invertible_mat P \<and> (HNF_algorithm abs_flag A) = P * A)"
     by (smt assms assoc_mult_mat invertible_mult_JNF mult_carrier_mat)
   moreover have "Hermite_JNF (range ass_function_euclidean) (\<lambda>c. range (res_int c)) (HNF_algorithm abs_flag A)"
     by (metis A FindPreHNF_rectangular_soundness H_rw Hermite_Hermite_of_list_of_rows mult_carrier_mat)
   ultimately show ?thesis by simp
 next
   case False
   hence mn: "m=n" and det_A_not0:"(Determinant.det A) \<noteq> 0" by auto
   have inv_RAT_A: "invertible_mat (map_mat rat_of_int A)"
   proof -
     have "det (map_mat rat_of_int A) \<noteq> 0" using det_A_not0 by auto
     thus ?thesis 
       by (metis False assms dvd_field_iff invertible_iff_is_unit_JNF map_carrier_mat)
   qed
   have "HNF_algorithm abs_flag A = Hermite_mod_det abs_flag A"
     unfolding HNF_algorithm_def Hermite_mod_det_def Let_def using False A by simp    
   then show ?thesis using Hermite_mod_det_soundness[OF mn A inv_RAT_A] by auto
 qed
 end
 
 
 text \<open>New predicate of soundness of a HNF algorithm, without providing explicitly the transformation matrix.\<close>
 
 definition "is_sound_HNF' algorithm associates res 
     = (\<forall>A. let H = algorithm A; m = dim_row A; n = dim_col A in Hermite_JNF associates res H 
         \<and> H \<in> carrier_mat m n \<and> (\<exists>P. P \<in> carrier_mat m m \<and> invertible_mat P \<and> A = P * H))"
 
 lemma is_sound_HNF_conv:
   assumes s: "is_sound_HNF' algorithm associates res"
   shows "is_sound_HNF (\<lambda>A. let H = algorithm A in (SOME P. P \<in> carrier_mat (dim_row A) (dim_row A)
     \<and> invertible_mat P \<and> A = P * H, H)) associates res"
 proof (unfold is_sound_HNF_def Let_def prod.case, rule allI)
   fix A::"'a mat"
   define m where "m = dim_row A"
   obtain P where P: "P \<in> carrier_mat m m \<and> invertible_mat P \<and> A = P * (algorithm A)" 
     using s unfolding is_sound_HNF'_def Let_def m_def by auto
   let ?some_P = "(SOME P. P \<in> carrier_mat m m \<and> invertible_mat P \<and> A = P * algorithm A)"
   have some_P: "?some_P \<in> carrier_mat m m \<and> invertible_mat ?some_P \<and> A = ?some_P * algorithm A"
     by (smt P verit_sko_ex_indirect)
   moreover have "algorithm A \<in> carrier_mat (dim_row A) (dim_col A)"
     and  "Hermite_JNF associates res (algorithm A)" using s unfolding is_sound_HNF'_def Let_def by auto    
   ultimately show "?some_P \<in> carrier_mat m m \<and> algorithm A \<in> carrier_mat m (dim_col A) 
     \<and> invertible_mat ?some_P \<and> A = ?some_P * algorithm A \<and> Hermite_JNF associates res (algorithm A)"
     unfolding is_sound_HNF_def Let_def m_def by (auto split: prod.split)
 qed
 
 context proper_mod_operation
 begin
 corollary is_sound_HNF'_HNF_algorithm:
    "is_sound_HNF' (HNF_algorithm abs_flag) (range ass_function_euclidean) (\<lambda>c. range (res_int c))"  
 proof -
   have "Hermite_JNF (range ass_function_euclidean) (\<lambda>c. range (res_int c)) (HNF_algorithm abs_flag A)" for A
     using HNF_algorithm_soundness by blast
   moreover have "HNF_algorithm abs_flag A \<in> carrier_mat (dim_row A) (dim_col A)" for A
     by (metis HNF_algorithm_soundness carrier_matI mult_carrier_mat)
   moreover have "\<exists>P. P \<in> carrier_mat (dim_row A) (dim_row A) \<and> invertible_mat P \<and> A = P * HNF_algorithm abs_flag A" for A 
   proof -
     have "\<exists>P. P \<in> carrier_mat (dim_row A) (dim_row A) \<and> invertible_mat P \<and> HNF_algorithm abs_flag A = P *  A"
       using HNF_algorithm_soundness by blast
     from this obtain P where P: "P \<in> carrier_mat (dim_row A) (dim_row A)" and inv_P: "invertible_mat P"
       and H_PA: "HNF_algorithm abs_flag A = P *  A" by blast
     obtain P' where PP': "inverts_mat P P'" and P'P: "inverts_mat P' P"
       using inv_P unfolding invertible_mat_def by auto
     have P': "P' \<in> carrier_mat (dim_row A) (dim_row A) "
       by (metis P PP' P'P carrier_matD carrier_mat_triv index_mult_mat(3) index_one_mat(3) inverts_mat_def)
     moreover have inv_P': "invertible_mat P'"
       by (metis P' P'P PP' carrier_matD(1) carrier_matD(2) invertible_mat_def square_mat.simps)
     moreover have "A = P' * HNF_algorithm abs_flag A"
       by (smt H_PA P P'P assoc_mult_mat calculation(1) carrier_matD(1) carrier_matI inverts_mat_def left_mult_one_mat')
     ultimately show ?thesis by auto
   qed
   ultimately show ?thesis
     unfolding is_sound_HNF'_def Let_def by auto
 qed
 
 
 corollary is_sound_HNF'_HNF_algorithm_from_HA:
    "is_sound_HNF' (HNF_algorithm_from_HA) (range ass_function_euclidean) (\<lambda>c. range (res_int c))"  
 proof -
   have "Hermite_JNF (range ass_function_euclidean) (\<lambda>c. range (res_int c)) (HNF_algorithm_from_HA A)" for A
     using HNF_algorithm_from_HA_soundness by blast
   moreover have "HNF_algorithm_from_HA A \<in> carrier_mat (dim_row A) (dim_col A)" for A
     by (metis HNF_algorithm_from_HA_soundness carrier_matI mult_carrier_mat)
   moreover have "\<exists>P. P \<in> carrier_mat (dim_row A) (dim_row A) \<and> invertible_mat P \<and> A = P * HNF_algorithm_from_HA A" for A 
   proof -
     have "\<exists>P. P \<in> carrier_mat (dim_row A) (dim_row A) \<and> invertible_mat P \<and> HNF_algorithm_from_HA A = P *  A"
       using HNF_algorithm_from_HA_soundness by blast
     from this obtain P where P: "P \<in> carrier_mat (dim_row A) (dim_row A)" and inv_P: "invertible_mat P"
       and H_PA: "HNF_algorithm_from_HA A = P *  A" by blast
     obtain P' where PP': "inverts_mat P P'" and P'P: "inverts_mat P' P"
       using inv_P unfolding invertible_mat_def by auto
     have P': "P' \<in> carrier_mat (dim_row A) (dim_row A) "
       by (metis P PP' P'P carrier_matD carrier_mat_triv index_mult_mat(3) index_one_mat(3) inverts_mat_def)
     moreover have inv_P': "invertible_mat P'"
       by (metis P' P'P PP' carrier_matD(1) carrier_matD(2) invertible_mat_def square_mat.simps)
     moreover have "A = P' * HNF_algorithm_from_HA A"
       by (smt H_PA P P'P assoc_mult_mat calculation(1) carrier_matD(1) carrier_matI inverts_mat_def left_mult_one_mat')
     ultimately show ?thesis by auto
   qed
   ultimately show ?thesis
     unfolding is_sound_HNF'_def Let_def by auto
 qed
 end
 
 text \<open>Some work to make the algorithm executable\<close>
 
 definition find_non0' :: "nat \<Rightarrow> nat \<Rightarrow> 'a::comm_ring_1 mat \<Rightarrow> nat option" where
   "find_non0' i k A = (let is = [i ..< dim_row A];
     Ais = filter (\<lambda>j. A $$ (j, k) \<noteq> 0) is
     in case Ais of [] \<Rightarrow> None | _ \<Rightarrow> Some (Ais!0))"
 
 lemma find_non0': 
   assumes A: "A \<in> carrier_mat m n"
   and res: "find_non0' i k A = Some j"
   shows "A $$ (j,k) \<noteq> 0" "i \<le> j" "j < dim_row A"
 proof -
   let ?xs = "filter (\<lambda>j. A $$ (j,k) \<noteq> 0) [i ..< dim_row A]"
   from res[unfolded find_non0'_def Let_def]
   have xs: "?xs \<noteq> []" by (cases ?xs, auto)
   have j_in_xs: "j \<in> set ?xs" using res unfolding find_non0'_def Let_def
     by (metis (no_types, lifting) length_greater_0_conv list.case(2) list.exhaust nth_mem option.simps(1) xs)
   show "A $$ (j,k) \<noteq> 0" "i \<le> j" "j < dim_row A" using j_in_xs by auto+  
 qed
 
 
 lemma find_non0'_w_zero_before: 
   assumes A: "A \<in> carrier_mat m n"
   and res: "find_non0' i k A = Some j"
   shows "\<forall>j'\<in>{i..<j}. A $$ (j',k) = 0"
 proof -
   let ?xs = "filter (\<lambda>j. A $$ (j, k) \<noteq> 0) [i ..< dim_row A]"
   from res[unfolded find_non0'_def Let_def]
   have xs: "?xs \<noteq> []" by (cases ?xs, auto)
   have j_in_xs: "j \<in> set ?xs" using res unfolding find_non0'_def Let_def
     by (metis (no_types, lifting) length_greater_0_conv list.case(2) list.exhaust nth_mem option.simps(1) xs)
   have j_xs0: "j = ?xs ! 0"
     by (smt res[unfolded find_non0'_def Let_def] list.case(2) list.exhaust option.inject xs)
   show "\<forall>j'\<in>{i..<j}. A $$ (j',k) = 0"
   proof (rule+, rule ccontr)
     fix j' assume j': "j' : {i..<j}" and Alj': "A $$ (j',k) \<noteq> 0"
     have j'j: "j'<j" using j' by auto
     have j'_in_xs: "j' \<in> set ?xs" 
       by (metis (mono_tags, lifting) A Alj' Set.member_filter atLeastLessThan_iff filter_set
           find_non0'(3) j' nat_SN.gt_trans res set_upt)
     have l_rw: "[i..<dim_row A] = [i ..<j] @[j..<dim_row A]"
       using assms(1) assms(2) find_non0'(3) j' upt_append 
       by (metis atLeastLessThan_iff le_trans linorder_not_le) 
     have xs_rw: "?xs = filter (\<lambda>j. A $$ (j,k) \<noteq> 0) ([i ..<j] @[j..<dim_row A])"
       using l_rw by auto
     hence "filter (\<lambda>j. A $$ (j,k) \<noteq> 0) [i ..<j] = []" using j_xs0 
       by (metis (no_types, lifting) Set.member_filter atLeastLessThan_iff filter_append filter_set
           length_greater_0_conv nth_append nth_mem order_less_irrefl set_upt)
     thus False using j_xs0 j' j_xs0 
       by (metis Set.member_filter filter_empty_conv filter_set j'_in_xs set_upt)
   qed
 qed
 
 
 lemma find_non0'_LEAST: 
   assumes A: "A \<in> carrier_mat m n"
   and res: "find_non0' i k A = Some j"
 shows "j = (LEAST n. A $$ (n,k) \<noteq> 0 \<and> i\<le>n)"
 proof (rule Least_equality[symmetric])
   show " A $$ (j, k) \<noteq> 0 \<and> i \<le> j" 
     using A res find_non0'[OF A] by auto
   show " \<And>y. A $$ (y, k) \<noteq> 0 \<and> i \<le> y \<Longrightarrow> j \<le> y"
     by (meson A res atLeastLessThan_iff find_non0'_w_zero_before linorder_not_le)
 qed
 
 lemma echelon_form_of_column_k_JNF_code[code]:
   "echelon_form_of_column_k_JNF bezout (A,i) k = 
     (if (i = dim_row A) \<or> (\<forall>m \<in> {i..<dim_row A}. A $$ (m, k) = 0) then (A, i) else 
         if (\<forall>m\<in>{i+1..<dim_row A}. A $$ (m,k) = 0) then (A, i + 1) else
             let n = the (find_non0' i k A); 
                 interchange_A = swaprows i n A
            in
             (bezout_iterate_JNF (interchange_A) (dim_row A - 1) i k bezout, i + 1))"
 proof (cases "\<not> ((i = dim_row A) \<or> (\<forall>m \<in> {i..<dim_row A}. A $$ (m, k) = 0)) 
             \<and> \<not> (\<forall>m\<in>{i+1..<dim_row A}. A $$ (m,k) = 0)")
   case True
   let ?n = "the (find_non0' i k A)"
   let ?interchange_A = "swaprows i ?n A"
   have f_rw: "(the (find_non0' i k A)) = (LEAST n. A $$ (n, k) \<noteq> 0 \<and> i \<le> n)"
   proof (rule find_non0'_LEAST)
     have "find_non0' i k A \<noteq> None" using True unfolding find_non0'_def Let_def
       by (auto split: list.split)
          (metis (mono_tags, lifting) atLeastLessThan_iff atLeastLessThan_upt empty_filter_conv)
     thus "find_non0' i k A = Some (the (find_non0' i k A))" by auto
   qed (auto)
   show ?thesis unfolding echelon_form_of_column_k_JNF_def Let_def f_rw using True by auto
 next
   case False
   then show ?thesis unfolding echelon_form_of_column_k_JNF_def by auto
 qed
 
 
 subsection \<open>Instantiation of the HNF-algorithm with modulo-operation\<close>
 
 text \<open>We currently use a Boolean flag to indicate whether standard-mod or symmetric modulo
   should be used.\<close>
 
 lemma sym_mod: "proper_mod_operation sym_mod sym_div" 
   by (unfold_locales, auto simp: sym_mod_sym_div)
 
 lemma standard_mod: "proper_mod_operation (mod) (div)" 
   by (unfold_locales, auto, intro HOL.nitpick_unfold(7))
 
 definition HNF_algorithm :: "bool \<Rightarrow> int mat \<Rightarrow> int mat" where
   "HNF_algorithm use_sym_mod = (if use_sym_mod 
     then mod_operation.HNF_algorithm sym_mod False else mod_operation.HNF_algorithm (mod) True)" 
 
 definition HNF_algorithm_from_HA :: "bool \<Rightarrow> int mat \<Rightarrow> int mat" where
   "HNF_algorithm_from_HA use_sym_mod = (if use_sym_mod 
     then mod_operation.HNF_algorithm_from_HA sym_mod else mod_operation.HNF_algorithm_from_HA (mod))"
 
 
 corollary is_sound_HNF'_HNF_algorithm:
    "is_sound_HNF' (HNF_algorithm use_sym_mod) (range ass_function_euclidean) (\<lambda>c. range (res_int c))"  
   using proper_mod_operation.is_sound_HNF'_HNF_algorithm[OF sym_mod]
     proper_mod_operation.is_sound_HNF'_HNF_algorithm[OF standard_mod]
   unfolding HNF_algorithm_def by (cases use_sym_mod, auto)
 
 corollary is_sound_HNF'_HNF_algorithm_from_HA:
    "is_sound_HNF' (HNF_algorithm_from_HA use_sym_mod) (range ass_function_euclidean) (\<lambda>c. range (res_int c))"  
   using proper_mod_operation.is_sound_HNF'_HNF_algorithm_from_HA[OF sym_mod]
     proper_mod_operation.is_sound_HNF'_HNF_algorithm_from_HA[OF standard_mod]
   unfolding HNF_algorithm_from_HA_def by (cases use_sym_mod, auto)
 
 
 (*Examples:*)
 (*Rectangular matrix (6x4)*)
 value [code]"let A = mat_of_rows_list 4 (
   [[0,3,1,4],
    [7,1,0,0],
    [8,0,19,16],
    [2,0,0,3::int],
    [9,-3,2,5],
    [6,3,2,4]]) in
   show (HNF_algorithm True A)"
 
 (*Rectangular matrix (4x6)*)
 
 value [code]"let A = mat_of_rows_list 6 (
   [[0,3,1,4,8,7],
    [7,1,0,0,4,1],
    [8,0,19,16,33,5],
    [2,0,0,3::int,-5,8]]) in
   show (HNF_algorithm False A)"
 
 (*Singular matrix*)
 value [code]"let A = mat_of_rows_list 6 (
   [[0,3,1,4,8,7],
    [7,1,0,0,4,1],
    [8,0,19,16,33,5],
    [0,3,1,4,8,7],
    [2,0,0,3::int,-5,8],
    [2,4,6,8,10,12]]) in
   show (Determinant.det A, HNF_algorithm True A)"
 
 (*Invertible matrix*)
 value [code]"let A = mat_of_rows_list 6 (
   [[0,3,1,4,8,7],
    [7,1,0,0,4,1],
    [8,0,19,16,33,5],
    [5,6,1,2,8,7],
    [2,0,0,3::int,-5,8],
    [2,4,6,8,10,12]]) in
   show (Determinant.det A, HNF_algorithm True A)"
 
 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,668 +1,669 @@
 (*  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
+  "Word_Lib.Bit_Comprehension"
+  Code_Int_Integer_Conversion
   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
 
 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 (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
   "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
   "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
     , 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/More_Bits_Int.thy b/thys/Native_Word/Code_Int_Integer_Conversion.thy
rename from thys/Native_Word/More_Bits_Int.thy
rename to thys/Native_Word/Code_Int_Integer_Conversion.thy
--- a/thys/Native_Word/More_Bits_Int.thy
+++ b/thys/Native_Word/Code_Int_Integer_Conversion.thy
@@ -1,127 +1,29 @@
-(*  Title:      Bits_Int.thy
+(*  Title:      Code_Int_Integer_Conversion.thy
     Author:     Andreas Lochbihler, ETH Zurich
 *)
 
-chapter \<open>More bit operations on integers\<close>
+chapter \<open>A special case of a conversion.\<close>
 
-theory More_Bits_Int
+theory Code_Int_Integer_Conversion
 imports
-  "Word_Lib.Bit_Comprehension"
+  Main
 begin
 
-text \<open>Preliminaries\<close>
-
-declare hd_Nil_eq_last [simp]
-
-lemma nat_LEAST_True: "(LEAST _ :: nat. True) = 0"
-  by (rule Least_equality) simp_all
-
 text \<open>
   Use this function to convert numeral @{typ integer}s quickly into @{typ int}s.
   By default, it works only for symbolic evaluation; normally generated code raises
   an exception at run-time. If theory \<open>Code_Target_Bits_Int\<close> is imported,
   it works again, because then @{typ int} is implemented in terms of @{typ integer}
   even for symbolic evaluation.
 \<close>
 
 definition int_of_integer_symbolic :: "integer \<Rightarrow> int"
   where "int_of_integer_symbolic = int_of_integer"
 
 lemma int_of_integer_symbolic_aux_code [code nbe]:
   "int_of_integer_symbolic 0 = 0"
   "int_of_integer_symbolic (Code_Numeral.Pos n) = Int.Pos n"
   "int_of_integer_symbolic (Code_Numeral.Neg n) = Int.Neg n"
   by (simp_all add: int_of_integer_symbolic_def)
 
-
-section \<open>Symbolic bit operations on numerals and @{typ int}s\<close>
-
-fun bitOR_num :: "num \<Rightarrow> num \<Rightarrow> num"
-where
-  "bitOR_num num.One num.One = num.One"
-| "bitOR_num num.One (num.Bit0 n) = num.Bit1 n"
-| "bitOR_num num.One (num.Bit1 n) = num.Bit1 n"
-| "bitOR_num (num.Bit0 m) num.One = num.Bit1 m"
-| "bitOR_num (num.Bit0 m) (num.Bit0 n) = num.Bit0 (bitOR_num m n)"
-| "bitOR_num (num.Bit0 m) (num.Bit1 n) = num.Bit1 (bitOR_num m n)"
-| "bitOR_num (num.Bit1 m) num.One = num.Bit1 m"
-| "bitOR_num (num.Bit1 m) (num.Bit0 n) = num.Bit1 (bitOR_num m n)"
-| "bitOR_num (num.Bit1 m) (num.Bit1 n) = num.Bit1 (bitOR_num m n)"
-
-fun bitAND_num :: "num \<Rightarrow> num \<Rightarrow> num option"
-where
-  "bitAND_num num.One num.One = Some num.One"
-| "bitAND_num num.One (num.Bit0 n) = None"
-| "bitAND_num num.One (num.Bit1 n) = Some num.One"
-| "bitAND_num (num.Bit0 m) num.One = None"
-| "bitAND_num (num.Bit0 m) (num.Bit0 n) = map_option num.Bit0 (bitAND_num m n)"
-| "bitAND_num (num.Bit0 m) (num.Bit1 n) = map_option num.Bit0 (bitAND_num m n)"
-| "bitAND_num (num.Bit1 m) num.One = Some num.One"
-| "bitAND_num (num.Bit1 m) (num.Bit0 n) = map_option num.Bit0 (bitAND_num m n)"
-| "bitAND_num (num.Bit1 m) (num.Bit1 n) = (case bitAND_num m n of None \<Rightarrow> Some num.One | Some n' \<Rightarrow> Some (num.Bit1 n'))"
-
-fun bitXOR_num :: "num \<Rightarrow> num \<Rightarrow> num option"
-where
-  "bitXOR_num num.One num.One = None"
-| "bitXOR_num num.One (num.Bit0 n) = Some (num.Bit1 n)"
-| "bitXOR_num num.One (num.Bit1 n) = Some (num.Bit0 n)"
-| "bitXOR_num (num.Bit0 m) num.One = Some (num.Bit1 m)"
-| "bitXOR_num (num.Bit0 m) (num.Bit0 n) = map_option num.Bit0 (bitXOR_num m n)"
-| "bitXOR_num (num.Bit0 m) (num.Bit1 n) = Some (case bitXOR_num m n of None \<Rightarrow> num.One | Some n' \<Rightarrow> num.Bit1 n')"
-| "bitXOR_num (num.Bit1 m) num.One = Some (num.Bit0 m)"
-| "bitXOR_num (num.Bit1 m) (num.Bit0 n) = Some (case bitXOR_num m n of None \<Rightarrow> num.One | Some n' \<Rightarrow> num.Bit1 n')"
-| "bitXOR_num (num.Bit1 m) (num.Bit1 n) = map_option num.Bit0 (bitXOR_num m n)"
-
-fun bitORN_num :: "num \<Rightarrow> num \<Rightarrow> num"
-where
-  "bitORN_num num.One num.One = num.One"
-| "bitORN_num num.One (num.Bit0 m) = num.Bit1 m"
-| "bitORN_num num.One (num.Bit1 m) = num.Bit1 m"
-| "bitORN_num (num.Bit0 n) num.One = num.Bit0 num.One"
-| "bitORN_num (num.Bit0 n) (num.Bit0 m) = Num.BitM (bitORN_num n m)"
-| "bitORN_num (num.Bit0 n) (num.Bit1 m) = num.Bit0 (bitORN_num n m)"
-| "bitORN_num (num.Bit1 n) num.One = num.One"
-| "bitORN_num (num.Bit1 n) (num.Bit0 m) = Num.BitM (bitORN_num n m)"
-| "bitORN_num (num.Bit1 n) (num.Bit1 m) = Num.BitM (bitORN_num n m)"
-
-fun bitANDN_num :: "num \<Rightarrow> num \<Rightarrow> num option"
-where
-  "bitANDN_num num.One num.One = None"
-| "bitANDN_num num.One (num.Bit0 n) = Some num.One"
-| "bitANDN_num num.One (num.Bit1 n) = None"
-| "bitANDN_num (num.Bit0 m) num.One = Some (num.Bit0 m)"
-| "bitANDN_num (num.Bit0 m) (num.Bit0 n) = map_option num.Bit0 (bitANDN_num m n)"
-| "bitANDN_num (num.Bit0 m) (num.Bit1 n) = map_option num.Bit0 (bitANDN_num m n)"
-| "bitANDN_num (num.Bit1 m) num.One = Some (num.Bit0 m)"
-| "bitANDN_num (num.Bit1 m) (num.Bit0 n) = (case bitANDN_num m n of None \<Rightarrow> Some num.One | Some n' \<Rightarrow> Some (num.Bit1 n'))"
-| "bitANDN_num (num.Bit1 m) (num.Bit1 n) = map_option num.Bit0 (bitANDN_num m n)"
-
-lemma int_numeral_bitOR_num:
-  "numeral n OR numeral m = (numeral (bitOR_num n m) :: int)"
-  by (induction n m rule: bitOR_num.induct) simp_all
-
-lemma int_numeral_bitAND_num:
-  "numeral n AND numeral m = (case bitAND_num n m of None \<Rightarrow> 0 :: int | Some n' \<Rightarrow> numeral n')"
-  by (induction n m rule: bitAND_num.induct) (simp_all split: option.split)
-
-lemma int_numeral_bitXOR_num:
-  "numeral m XOR numeral n = (case bitXOR_num m n of None \<Rightarrow> 0 :: int | Some n' \<Rightarrow> numeral n')"
-  by (induction m n rule: bitXOR_num.induct) (simp_all split: option.split)
-
-lemma int_or_not_bitORN_num:
-  "numeral n OR NOT (numeral m) = (- numeral (bitORN_num n m) :: int)"
-  by (induction n m rule: bitORN_num.induct) (simp_all add: add_One BitM_inc_eq not_int_def)
-
-lemma int_and_not_bitANDN_num:
-  "numeral n AND NOT (numeral m) = (case bitANDN_num n m of None \<Rightarrow> 0 :: int | Some n' \<Rightarrow> numeral n')"
-  by (induction n m rule: bitANDN_num.induct) (simp_all add: add_One BitM_inc_eq not_int_def split: option.split)
-
-lemma int_not_and_bitANDN_num:
-  "NOT (numeral m) AND numeral n = (case bitANDN_num n m of None \<Rightarrow> 0 :: int | Some n' \<Rightarrow> numeral n')"
-  by (simp add: ac_simps flip: int_and_not_bitANDN_num)
-
-code_identifier
-  code_module More_Bits_Int \<rightharpoonup>
-  (SML) Bit_Operations and (OCaml) Bit_Operations and (Haskell) Bit_Operations and (Scala) Bit_Operations
-
 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,123 +1,119 @@
 (*  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"
   "Word_Lib.Bits_Int"
-  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)
+  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.Pos n AND Int.Pos m = (case and_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.Pos n AND Int.Neg (num.Bit0 m) = Num.sub (or_not_num_neg (Num.BitM m) n) num.One"
+  "Int.Pos n AND Int.Neg (num.Bit1 m) = Num.sub (or_not_num_neg (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
+  "Int.Neg (num.Bit0 n) AND Int.Pos m = Num.sub (or_not_num_neg (Num.BitM n) m) num.One"
+  "Int.Neg (num.Bit1 n) AND Int.Pos m = Num.sub (or_not_num_neg (num.Bit0 n) m) num.One"
+  by (simp_all add: and_num_eq_None_iff and_num_eq_Some_iff sub_one_eq_not_neg
+    numeral_or_not_num_eq ac_simps split: option.split)
 
 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.Pos n OR Int.Pos m = Int.Pos (or_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.Pos n OR Int.Neg (num.Bit0 m) = (case and_not_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 and_not_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)
+  "Int.Neg (num.Bit0 n) OR Int.Pos m = (case and_not_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 and_not_num (num.Bit0 n) m of None \<Rightarrow> -1 | Some n' \<Rightarrow> Int.Neg (Num.inc n'))"
+  apply (simp_all add: and_not_num_eq_None_iff and_not_num_eq_Some_iff numeral_or_num_eq
+    sub_one_eq_not_neg add_One ac_simps split: option.split)
+     apply (simp_all add: or_eq_not_not_and minus_numeral_inc_eq)
   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.Pos n XOR Int.Pos m = (case xor_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)
+  by (simp_all add: xor_num_eq_None_iff xor_num_eq_Some_iff sub_one_eq_not_neg split: option.split)
 
 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 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 Bit_Operations.set_bit_int_def unset_bit_int_def)
 
 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: 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_Bits_Int.thy b/thys/Native_Word/Code_Target_Bits_Int.thy
--- a/thys/Native_Word/Code_Target_Bits_Int.thy
+++ b/thys/Native_Word/Code_Target_Bits_Int.thy
@@ -1,92 +1,92 @@
 (*  Title:      Code_Target_Bits_Int.thy
     Author:     Andreas Lochbihler, ETH Zurich
 *)
 
 chapter \<open>Implementation of bit operations on int by target language operations\<close>
 
 theory Code_Target_Bits_Int
-imports
+  imports
   Bits_Integer
   "HOL-Library.Code_Target_Int"
 begin
 
 declare [[code drop:
   "(AND) :: int \<Rightarrow> _" "(OR) :: int \<Rightarrow> _" "(XOR) :: int \<Rightarrow> _" "(NOT) :: int \<Rightarrow> _"
   "lsb :: int \<Rightarrow> _" "set_bit :: int \<Rightarrow> _" "bit :: int \<Rightarrow> _"
   "push_bit :: _ \<Rightarrow> int \<Rightarrow> _" "drop_bit :: _ \<Rightarrow> int \<Rightarrow> _"
   int_of_integer_symbolic
   ]]
 
 declare bitval_bin_last [code_unfold]
 
 lemma [code_unfold]:
   \<open>bit x n \<longleftrightarrow> x AND (push_bit n 1) \<noteq> 0\<close> for x :: int
   by (fact bit_iff_and_push_bit_not_eq_0)
 
 context
 includes integer.lifting
 begin
 
 lemma bit_int_code [code]:
   "bit (int_of_integer x) n = bit x n"
   by transfer simp
 
 lemma and_int_code [code]:
   "int_of_integer i AND int_of_integer j = int_of_integer (i AND j)"
   by transfer simp
 
 lemma or_int_code [code]:
   "int_of_integer i OR int_of_integer j = int_of_integer (i OR j)"
   by transfer simp
 
 lemma xor_int_code [code]:
   "int_of_integer i XOR int_of_integer j = int_of_integer (i XOR j)"
   by transfer simp
 
 lemma not_int_code [code]:
   "NOT (int_of_integer i) = int_of_integer (NOT i)"
   by transfer simp
 
 lemma push_bit_int_code [code]:
   \<open>push_bit n (int_of_integer x) = int_of_integer (push_bit n x)\<close>
   by transfer simp
 
 lemma drop_bit_int_code [code]:
   \<open>drop_bit n (int_of_integer x) = int_of_integer (drop_bit n x)\<close>
   by transfer simp
 
 lemma take_bit_int_code [code]:
   \<open>take_bit n (int_of_integer x) = int_of_integer (take_bit n x)\<close>
   by transfer simp
 
 lemma lsb_int_code [code]:
   "lsb (int_of_integer x) = lsb x"
   by transfer simp
 
 lemma set_bit_int_code [code]:
   "set_bit (int_of_integer x) n b = int_of_integer (set_bit x n b)"
   by transfer simp
 
 lemma int_of_integer_symbolic_code [code]:
   "int_of_integer_symbolic = int_of_integer"
   by (simp add: int_of_integer_symbolic_def)
 
 context
 begin
 
 qualified definition even :: \<open>int \<Rightarrow> bool\<close>
   where [code_abbrev]: \<open>even = Parity.even\<close>
 
 end
 
 lemma [code]:
   \<open>Code_Target_Bits_Int.even i \<longleftrightarrow> i AND 1 = 0\<close>
   by (simp add: Code_Target_Bits_Int.even_def even_iff_mod_2_eq_zero and_one_eq)
 
 lemma bin_rest_code:
   "int_of_integer i div 2 = int_of_integer (bin_rest_integer i)"
   by transfer simp
 
 end
 
 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,396 +1,395 @@
 (*  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 = 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 = "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))
   hence q: "?q = of_nat ?q'" using n m
     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 (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 = push_bit (LENGTH('a) - 1) 1"
   shows "uint (n AND mask1) OR mask2 = uint n"
 proof -
   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 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 "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 (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 \<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 = (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 (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 (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 = push_bit LENGTH('a) 1"
   and index_def: "index = 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 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 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 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 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 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/ROOT b/thys/Native_Word/ROOT
--- a/thys/Native_Word/ROOT
+++ b/thys/Native_Word/ROOT
@@ -1,37 +1,36 @@
 chapter AFP
 
 session "Native_Word" (AFP) = Word_Lib +
   options [timeout = 2400]
   sessions
     "HOL-Imperative_HOL"
   theories
-    Code_Target_Bits_Int
     Uint64
     Uint32
     Uint16
     Uint8
     Uint
     Native_Cast
     Native_Cast_Uint
     Native_Word_Imperative_HOL
     Native_Word_Test_Emu
     Native_Word_Test_PolyML
     Native_Word_Test_PolyML2
     Native_Word_Test_PolyML64
     Native_Word_Test_Scala
   theories [condition = ISABELLE_GHC]
     Native_Word_Test_GHC
   theories [condition = ISABELLE_MLTON]
     Native_Word_Test_MLton
     Native_Word_Test_MLton2
   theories [condition = ISABELLE_OCAMLFIND]
     Native_Word_Test_OCaml
     Native_Word_Test_OCaml2
   theories [condition = ISABELLE_SMLNJ]
     Native_Word_Test_SMLNJ
     Native_Word_Test_SMLNJ2
   theories
     Uint_Userguide
   document_files
     "root.tex"
     "root.bib"
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,1568 +1,1568 @@
 (*
  * 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" "Word_Lib.Most_significant_bit" "Word_Lib.Generic_set_bit"
 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 by (rule bit_eqI)
 
 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 simp
 
 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 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.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 (fact signed_take_bit_int_greater_eq_minus_exp)
 
 lemma sbintr_lt: "(signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n w < 2 ^ n"
   by (fact signed_take_bit_int_less_exp)
 
 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>
 
 instantiation int :: set_bit
 begin
 
 definition set_bit_int :: \<open>int \<Rightarrow> nat \<Rightarrow> bool \<Rightarrow> int\<close>
   where \<open>set_bit_int i n b = (if b then Bit_Operations.set_bit else Bit_Operations.unset_bit) n i\<close>
 
 instance
   by standard (simp_all add: set_bit_int_def bit_simps)
 
 end
 
 abbreviation (input) bin_sc :: \<open>nat \<Rightarrow> bool \<Rightarrow> int \<Rightarrow> int\<close>
   where \<open>bin_sc n b i \<equiv> set_bit i n b\<close>
 
 lemma bin_sc_0 [simp]:
   "bin_sc 0 b w = of_bool b + 2 * (\<lambda>k::int. k div 2) w"
   by (simp add: set_bit_int_def)
 
 lemma bin_sc_Suc [simp]:
   "bin_sc (Suc n) b w = of_bool (odd w) + 2 * bin_sc n b (w div 2)"
   by (simp add: set_bit_int_def set_bit_Suc unset_bit_Suc bin_last_def)
 
 lemma bin_nth_sc [bit_simps]: "bit (bin_sc n b w) n \<longleftrightarrow> b"
   by (simp add: bit_simps)
 
 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>
    apply (simp_all add: fun_eq_iff bit_eq_iff)
   apply (simp_all add: bit_simps bin_nth_sc_gen)
   done
 
 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 (rule bit_eqI)
   apply (cases x)
    apply (auto simp add: bit_simps bin_sc_eq)
   done
 
 lemma bin_clr_le: "bin_sc n False w \<le> w"
   by (simp add: set_bit_int_def unset_bit_less_eq)
 
 lemma bin_set_ge: "bin_sc n True w \<ge> w"
   by (simp add: set_bit_int_def 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: set_bit_int_def 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: set_bit_int_def 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_0 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]]
 
 lemma int_set_bit_0 [simp]: fixes x :: int shows
   "set_bit x 0 b = of_bool b + 2 * (x div 2)"
   by (fact bin_sc_0)
 
 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 (fact bin_sc_Suc)
 
 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 (fact bin_sc_numeral)
 
 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 (smt (z3) Bits_Int.set_bit_int_def bin_sign_def bin_sign_sc msb_int_def)
 
 lemma word_set_bit_def:
   \<open>set_bit a n x = word_of_int (bin_sc n x (uint a))\<close>
   apply (rule bit_word_eqI)
   apply (cases x)
    apply (simp_all add: bit_simps bin_sc_eq)
   done
 
 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 shiftl_int_def:
   "push_bit n x = x * 2 ^ n" for x :: int
   by (fact push_bit_eq_mult)
 
 lemma shiftr_int_def:
   "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]:
+lemma int_not_simps:
   "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)
 
 
 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: "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: "push_bit n 0 = (0 :: int)"
   by (fact push_bit_of_0)
 
 lemma bin_last_shiftl: "odd (push_bit n x) \<longleftrightarrow> n = 0 \<and> (odd :: int \<Rightarrow> bool) x"
   by simp
 
 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_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_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 (push_bit n 1) \<noteq> 0"
   by (fact bit_iff_and_push_bit_not_eq_0)
 
 lemma int_shiftl_numeral [simp]:
   "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]:
   "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 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 shiftl_lt_0: fixes i :: int shows "push_bit n i < 0 \<longleftrightarrow> i < 0"
   by (fact push_bit_negative_int_iff)
 
 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_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]:
   "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]:
   "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 = push_bit n 1"
   and m: "m < n"
   and x: "x < y"
   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 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 (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 (push_bit n 1)"
   by (rule bit_eqI) (auto simp add: bin_sc_eq bit_simps)
 
 
 subsection \<open>More lemmas on words\<close>
 
 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_sc [simp]:
   "msb (bin_sc n b x) \<longleftrightarrow> msb x"
   by (simp add: msb_conv_bin_sign)
 
 lemma msb_word_def:
   \<open>msb a \<longleftrightarrow> bin_sign (signed_take_bit (LENGTH('a) - 1) (uint a)) = - 1\<close>
   for a :: \<open>'a::len word\<close>
   by (simp add: bin_sign_def bit_simps msb_word_iff_bit)
 
 lemma word_msb_def:
   "msb a \<longleftrightarrow> bin_sign (sint a) = - 1"
   by (simp add: msb_word_def sint_uint)
 
 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: "Bit_Operations.set_bit n (numeral bin) = word_of_int (bin_sc n True (numeral bin))"
   by (rule bit_word_eqI) (simp add: bit_simps)
 
 lemma clearBit_no:
   "unset_bit n (numeral bin) = word_of_int (bin_sc n False (numeral bin))"
   by (rule bit_word_eqI) (simp add: bit_simps)
 
 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 (push_bit i m) = push_bit i (take_bit (n - i) m)"
   for m :: int
   by (fact take_bit_push_bit)
 
 lemma uint_shiftl:
   "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: "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 = 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 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"
   by (simp add: take_bit_int_eq_self_iff le_less_trans less_exp)
 
 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)
 
 code_identifier
   code_module Bits_Int \<rightharpoonup>
   (SML) Bit_Operations and (OCaml) Bit_Operations and (Haskell) Bit_Operations and (Scala) Bit_Operations
 
 end