diff --git a/thys/PAC_Checker/PAC_Checker.thy b/thys/PAC_Checker/PAC_Checker.thy
--- a/thys/PAC_Checker/PAC_Checker.thy
+++ b/thys/PAC_Checker/PAC_Checker.thy
@@ -1,1383 +1,1383 @@
 (*
   File:         PAC_Checker.thy
   Author:       Mathias Fleury, Daniela Kaufmann, JKU
   Maintainer:   Mathias Fleury, JKU
 *)
 theory PAC_Checker
   imports PAC_Polynomials_Operations
     PAC_Checker_Specification
     PAC_Map_Rel
     Show.Show
     Show.Show_Instances
     PAC_Misc
 begin
 
 section \<open>Executable Checker\<close>
 
 text \<open>In this layer we finally refine the checker to executable code.\<close>
 
 subsection \<open>Definitions\<close>
 
 text \<open>Compared to the previous layer, we add an error message when an error is discovered. We do not
   attempt to prove anything on the error message (neither that there really is an error, nor that the
   error message is correct).
 \<close>
 
 paragraph \<open>Extended error message\<close>
 
 datatype 'a code_status =
   is_cfailed: CFAILED (the_error: 'a) |
   CSUCCESS |
   is_cfound: CFOUND
 
 text \<open>In the following function, we merge errors. We will never merge an error message with an
   another error message; hence we do not attempt to concatenate error messages.
 \<close>
 fun merge_cstatus where
   \<open>merge_cstatus (CFAILED a) _ = CFAILED a\<close> |
   \<open>merge_cstatus _ (CFAILED a) = CFAILED a\<close> |
   \<open>merge_cstatus CFOUND _ = CFOUND\<close> |
   \<open>merge_cstatus _ CFOUND = CFOUND\<close> |
   \<open>merge_cstatus _ _ = CSUCCESS\<close>
 
 definition code_status_status_rel :: \<open>('a code_status \<times> status) set\<close> where
 \<open>code_status_status_rel =
   {(CFOUND, FOUND), (CSUCCESS, SUCCESS)} \<union>
   {(CFAILED a, FAILED)| a. True}\<close>
 
 lemma in_code_status_status_rel_iff[simp]:
   \<open>(CFOUND, b) \<in> code_status_status_rel \<longleftrightarrow> b = FOUND\<close>
   \<open>(a, FOUND) \<in> code_status_status_rel \<longleftrightarrow> a = CFOUND\<close>
   \<open>(CSUCCESS, b) \<in> code_status_status_rel \<longleftrightarrow> b = SUCCESS\<close>
   \<open>(a, SUCCESS) \<in> code_status_status_rel \<longleftrightarrow> a = CSUCCESS\<close>
   \<open>(a, FAILED) \<in> code_status_status_rel \<longleftrightarrow> is_cfailed a\<close>
   \<open>(CFAILED C, b) \<in> code_status_status_rel \<longleftrightarrow> b = FAILED\<close>
   by (cases a; cases b; auto simp: code_status_status_rel_def; fail)+
 
 
 paragraph \<open>Refinement relation\<close>
 
 fun pac_step_rel_raw :: \<open>('olbl \<times> 'lbl) set \<Rightarrow> ('a \<times> 'b) set \<Rightarrow> ('c \<times> 'd) set \<Rightarrow> ('a, 'c, 'olbl) pac_step \<Rightarrow> ('b, 'd, 'lbl) pac_step \<Rightarrow> bool\<close> where
 \<open>pac_step_rel_raw R1 R2 R3 (Add p1 p2 i r) (Add p1' p2' i' r') \<longleftrightarrow>
    (p1, p1') \<in> R1 \<and> (p2, p2') \<in> R1 \<and> (i, i') \<in> R1 \<and>
    (r, r') \<in> R2\<close> |
 \<open>pac_step_rel_raw R1 R2 R3 (Mult p1 p2 i r) (Mult p1' p2' i' r') \<longleftrightarrow>
    (p1, p1') \<in> R1 \<and> (p2, p2') \<in> R2 \<and> (i, i') \<in> R1 \<and>
    (r, r') \<in> R2\<close> |
 \<open>pac_step_rel_raw R1 R2 R3 (Del p1) (Del p1') \<longleftrightarrow>
    (p1, p1') \<in> R1\<close> |
 \<open>pac_step_rel_raw R1 R2 R3 (Extension i x p1) (Extension j x' p1') \<longleftrightarrow>
    (i, j) \<in> R1 \<and> (x, x') \<in> R3 \<and> (p1, p1') \<in> R2\<close> |
 \<open>pac_step_rel_raw R1 R2 R3 _ _ \<longleftrightarrow> False\<close>
 
 fun pac_step_rel_assn :: \<open>('olbl \<Rightarrow> 'lbl \<Rightarrow> assn) \<Rightarrow> ('a \<Rightarrow> 'b \<Rightarrow> assn) \<Rightarrow> ('c \<Rightarrow> 'd \<Rightarrow> assn) \<Rightarrow> ('a, 'c, 'olbl) pac_step \<Rightarrow> ('b, 'd, 'lbl) pac_step \<Rightarrow> assn\<close> where
 \<open>pac_step_rel_assn R1 R2 R3 (Add p1 p2 i r) (Add p1' p2' i' r') =
    R1 p1 p1' * R1 p2 p2' * R1 i i' *
    R2 r r'\<close> |
 \<open>pac_step_rel_assn R1 R2 R3 (Mult p1 p2 i r) (Mult p1' p2' i' r') =
    R1 p1 p1' * R2 p2 p2' * R1 i i' *
    R2 r r'\<close> |
 \<open>pac_step_rel_assn R1 R2 R3 (Del p1) (Del p1') =
    R1 p1 p1'\<close> |
 \<open>pac_step_rel_assn R1 R2 R3 (Extension i x p1) (Extension i' x' p1') =
    R1 i i' * R3 x x' * R2 p1 p1'\<close> |
 \<open>pac_step_rel_assn R1 R2 _ _ _ = false\<close>
 
 lemma pac_step_rel_assn_alt_def:
   \<open>pac_step_rel_assn R1 R2 R3 x y = (
   case (x, y) of
       (Add p1 p2 i r, Add p1' p2' i' r') \<Rightarrow>
         R1 p1 p1' * R1 p2 p2' * R1 i i' * R2 r r'
     | (Mult p1 p2 i r, Mult p1' p2' i' r') \<Rightarrow>
         R1 p1 p1' * R2 p2 p2' * R1 i i' * R2 r r'
     | (Del p1, Del p1') \<Rightarrow> R1 p1 p1'
     | (Extension i x p1, Extension i' x' p1') \<Rightarrow> R1 i i' * R3 x x' * R2 p1 p1'
     | _ \<Rightarrow> false)\<close>
     by (auto split: pac_step.splits)
 
 
 paragraph \<open>Addition checking\<close>
 
 definition error_msg where
   \<open>error_msg i msg = CFAILED (''s CHECKING failed at line '' @ show i @ '' with error '' @ msg)\<close>
 
 definition error_msg_notin_dom_err where
   \<open>error_msg_notin_dom_err = '' notin domain''\<close>
 
 definition error_msg_notin_dom :: \<open>nat \<Rightarrow> string\<close> where
   \<open>error_msg_notin_dom i = show i @ error_msg_notin_dom_err\<close>
 
 definition error_msg_reused_dom where
   \<open>error_msg_reused_dom i = show i @ '' already in domain''\<close>
 
 
 definition error_msg_not_equal_dom where
   \<open>error_msg_not_equal_dom p q pq r = show p @ '' + '' @ show q @ '' = '' @ show pq @ '' not equal'' @ show r\<close>
 
 
 definition check_not_equal_dom_err :: \<open>llist_polynomial \<Rightarrow> llist_polynomial \<Rightarrow> llist_polynomial \<Rightarrow> llist_polynomial \<Rightarrow> string nres\<close> where
   \<open>check_not_equal_dom_err p q pq r = SPEC (\<lambda>_. True)\<close>
 
 
 definition vars_llist :: \<open>llist_polynomial \<Rightarrow> string set\<close> where
 \<open>vars_llist  xs = \<Union>(set ` fst ` set xs)\<close>
 
 
 definition check_addition_l :: \<open>_ \<Rightarrow> _ \<Rightarrow> string set \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> llist_polynomial \<Rightarrow> string code_status nres\<close> where
 \<open>check_addition_l spec A \<V> p q i r = do {
    let b = p \<in># dom_m A \<and> q \<in># dom_m A \<and> i \<notin># dom_m A \<and> vars_llist r \<subseteq> \<V>;
    if \<not>b
    then RETURN (error_msg i ((if p \<notin># dom_m A then error_msg_notin_dom p else []) @ (if q \<notin># dom_m A then error_msg_notin_dom p else []) @
       (if i \<in># dom_m A then error_msg_reused_dom p else [])))
    else do {
      ASSERT (p \<in># dom_m A);
      let p = the (fmlookup A p);
      ASSERT (q \<in># dom_m A);
      let q = the (fmlookup A q);
      pq \<leftarrow> add_poly_l (p, q);
      b \<leftarrow> weak_equality_l pq r;
      b' \<leftarrow> weak_equality_l r spec;
      if b then (if b' then RETURN CFOUND else RETURN CSUCCESS)
      else do {
        c \<leftarrow> check_not_equal_dom_err p q pq r;
        RETURN (error_msg i c)}
    }
 }\<close>
 
 
 paragraph \<open>Multiplication checking\<close>
 
 definition check_mult_l_dom_err :: \<open>bool \<Rightarrow> nat \<Rightarrow> bool \<Rightarrow> nat \<Rightarrow> string nres\<close> where
   \<open>check_mult_l_dom_err p_notin p i_already i = SPEC (\<lambda>_. True)\<close>
 
 
 definition check_mult_l_mult_err :: \<open>llist_polynomial \<Rightarrow> llist_polynomial \<Rightarrow> llist_polynomial \<Rightarrow> llist_polynomial \<Rightarrow> string nres\<close> where
   \<open>check_mult_l_mult_err p q pq r = SPEC (\<lambda>_. True)\<close>
 
 
 definition check_mult_l :: \<open>_ \<Rightarrow> _ \<Rightarrow> _ \<Rightarrow> nat \<Rightarrow>llist_polynomial \<Rightarrow>  nat \<Rightarrow> llist_polynomial \<Rightarrow> string code_status nres\<close> where
 \<open>check_mult_l spec A \<V> p q i r = do {
     let b = p \<in># dom_m A \<and> i \<notin># dom_m A \<and> vars_llist q \<subseteq> \<V>\<and> vars_llist r \<subseteq> \<V>;
     if \<not>b
     then do {
       c \<leftarrow> check_mult_l_dom_err (p \<notin># dom_m A) p (i \<in># dom_m A) i;
       RETURN (error_msg i c)}
     else do {
        ASSERT (p \<in># dom_m A);
        let p = the (fmlookup A p);
        pq \<leftarrow> mult_poly_full p q;
        b \<leftarrow> weak_equality_l pq r;
        b' \<leftarrow> weak_equality_l r spec;
        if b then (if b' then RETURN CFOUND else RETURN CSUCCESS) else do {
          c \<leftarrow> check_mult_l_mult_err p q pq r;
          RETURN (error_msg i c)
        }
      }
   }\<close>
 
 
 paragraph \<open>Deletion checking\<close>
 
 definition check_del_l :: \<open>_ \<Rightarrow> _ \<Rightarrow> nat \<Rightarrow> string code_status nres\<close> where
 \<open>check_del_l spec A p = RETURN CSUCCESS\<close>
 
 
 paragraph \<open>Extension checking\<close>
 
 definition check_extension_l_dom_err :: \<open>nat \<Rightarrow> string nres\<close> where
   \<open>check_extension_l_dom_err p = SPEC (\<lambda>_. True)\<close>
 
 
 definition check_extension_l_no_new_var_err :: \<open>llist_polynomial \<Rightarrow> string nres\<close> where
   \<open>check_extension_l_no_new_var_err p = SPEC (\<lambda>_. True)\<close>
 
 definition check_extension_l_new_var_multiple_err :: \<open>string \<Rightarrow> llist_polynomial \<Rightarrow> string nres\<close> where
   \<open>check_extension_l_new_var_multiple_err v p = SPEC (\<lambda>_. True)\<close>
 
 definition check_extension_l_side_cond_err
   :: \<open>string \<Rightarrow> llist_polynomial \<Rightarrow> llist_polynomial \<Rightarrow> llist_polynomial \<Rightarrow> string nres\<close>
 where
   \<open>check_extension_l_side_cond_err v p p' q = SPEC (\<lambda>_. True)\<close>
 
 definition check_extension_l
   :: \<open>_ \<Rightarrow> _ \<Rightarrow> string set \<Rightarrow> nat \<Rightarrow> string \<Rightarrow> llist_polynomial \<Rightarrow> (string code_status) nres\<close>
 where
 \<open>check_extension_l spec A \<V> i v p = do {
   let b = i \<notin># dom_m A \<and> v \<notin> \<V> \<and> ([v], -1) \<in> set p;
   if \<not>b
   then do {
     c \<leftarrow> check_extension_l_dom_err i;
     RETURN (error_msg i c)
   } else do {
       let p' = remove1 ([v], -1) p;
       let b = vars_llist p' \<subseteq> \<V>;
       if \<not>b
       then do {
         c \<leftarrow> check_extension_l_new_var_multiple_err v p';
         RETURN (error_msg i c)
       }
       else do {
          p2 \<leftarrow> mult_poly_full p' p';
          let p' = map (\<lambda>(a,b). (a, -b)) p';
          q \<leftarrow> add_poly_l (p2, p');
          eq \<leftarrow> weak_equality_l q [];
          if eq then do {
            RETURN (CSUCCESS)
          } else do {
           c \<leftarrow> check_extension_l_side_cond_err v p p' q;
           RETURN (error_msg i c)
         }
       }
     }
   }\<close>
 
 
 lemma check_extension_alt_def:
   \<open>check_extension A \<V> i v p \<ge> do {
     b \<leftarrow> SPEC(\<lambda>b. b \<longrightarrow> i \<notin># dom_m A \<and> v \<notin> \<V>);
     if \<not>b
     then RETURN (False)
     else do {
          p' \<leftarrow> RETURN (p + Var v);
          b \<leftarrow> SPEC(\<lambda>b. b \<longrightarrow> vars p' \<subseteq> \<V>);
          if \<not>b
          then RETURN (False)
          else do {
            pq \<leftarrow> mult_poly_spec p' p';
            let p' = - p';
            p \<leftarrow> add_poly_spec pq p';
            eq \<leftarrow> weak_equality p 0;
            if eq then RETURN(True)
            else RETURN (False)
        }
      }
    }\<close>
 proof -
   have [intro]: \<open>ab \<notin> \<V> \<Longrightarrow>
        vars ba \<subseteq> \<V> \<Longrightarrow>
        MPoly_Type.coeff (ba + Var ab) (monomial (Suc 0) ab) = 1\<close> for ab ba
     by (subst coeff_add[symmetric], subst not_in_vars_coeff0)
       (auto simp flip: coeff_add monom.abs_eq
         simp: not_in_vars_coeff0 MPoly_Type.coeff_def
           Var.abs_eq Var\<^sub>0_def lookup_single_eq monom.rep_eq)
   have [simp]: \<open>MPoly_Type.coeff p (monomial (Suc 0) ab) = -1\<close>
      if \<open>vars (p + Var ab) \<subseteq> \<V>\<close>
        \<open>ab \<notin> \<V>\<close>
      for ab
    proof -
      define q where \<open>q \<equiv> p + Var ab\<close>
      then have p: \<open>p = q - Var ab\<close>
        by auto
      show ?thesis
        unfolding p
        apply (subst coeff_minus[symmetric], subst not_in_vars_coeff0)
        using that unfolding q_def[symmetric]
        by (auto simp flip: coeff_minus simp: not_in_vars_coeff0
            Var.abs_eq Var\<^sub>0_def simp flip: monom.abs_eq
            simp: not_in_vars_coeff0 MPoly_Type.coeff_def
            Var.abs_eq Var\<^sub>0_def lookup_single_eq monom.rep_eq)
   qed
   have [simp]: \<open>vars (p - Var ab) = vars (Var ab - p)\<close> for ab
     using vars_uminus[of \<open>p - Var ab\<close>]
     by simp
   show ?thesis
     unfolding check_extension_def
     apply (auto 5 5 simp: check_extension_def weak_equality_def
       mult_poly_spec_def field_simps
       add_poly_spec_def power2_eq_square cong: if_cong
       intro!: intro_spec_refine[where R=Id, simplified]
       split: option.splits dest: ideal.span_add)
    done
 qed
 
 (* Copy of WB_More_Refinement *)
 lemma RES_RES_RETURN_RES: \<open>RES A \<bind> (\<lambda>T. RES (f T)) = RES (\<Union>(f ` A))\<close>
   by (auto simp: pw_eq_iff refine_pw_simps)
 
 
 lemma check_add_alt_def:
   \<open>check_add A \<V> p q i r \<ge>
     do {
      b \<leftarrow> SPEC(\<lambda>b. b \<longrightarrow> p \<in># dom_m A \<and> q \<in># dom_m A \<and> i \<notin># dom_m A \<and> vars r \<subseteq> \<V>);
      if \<not>b
      then RETURN False
      else do {
        ASSERT (p \<in># dom_m A);
        let p = the (fmlookup A p);
        ASSERT (q \<in># dom_m A);
        let q = the (fmlookup A q);
        pq \<leftarrow> add_poly_spec p q;
        eq \<leftarrow> weak_equality pq r;
        RETURN eq
      }
   }\<close> (is \<open>_ \<ge> ?A\<close>)
 proof -
   have check_add_alt_def: \<open>check_add A \<V> p q i r = do {
      b \<leftarrow> SPEC(\<lambda>b. b \<longrightarrow> p \<in># dom_m A \<and> q \<in># dom_m A \<and> i \<notin># dom_m A \<and> vars r \<subseteq> \<V>);
      if \<not>b then SPEC(\<lambda>b. b \<longrightarrow> p \<in># dom_m A \<and> q \<in># dom_m A \<and> i \<notin># dom_m A \<and> vars r \<subseteq> \<V> \<and>
             the (fmlookup A p) + the (fmlookup A q) - r \<in>  ideal polynomial_bool)
      else
        SPEC(\<lambda>b. b \<longrightarrow> p \<in># dom_m A \<and> q \<in># dom_m A \<and> i \<notin># dom_m A \<and> vars r \<subseteq> \<V> \<and>
             the (fmlookup A p) + the (fmlookup A q) - r \<in>  ideal polynomial_bool)}\<close>
    (is \<open>_ = ?B\<close>)
     by (auto simp: check_add_def RES_RES_RETURN_RES)
    have \<open>?A \<le> \<Down> Id (check_add A \<V> p q i r)\<close>
      apply refine_vcg
      apply ((auto simp: check_add_alt_def weak_equality_def
         add_poly_spec_def RES_RES_RETURN_RES summarize_ASSERT_conv
       cong: if_cong
       intro!: ideal.span_zero;fail)+)
       done
    then show ?thesis
      unfolding check_add_alt_def[symmetric]
      by simp
 qed
 
 lemma check_mult_alt_def:
   \<open>check_mult A \<V> p q i r \<ge>
     do {
      b \<leftarrow> SPEC(\<lambda>b. b \<longrightarrow> p \<in># dom_m A \<and> i \<notin># dom_m A \<and> vars q \<subseteq> \<V>  \<and> vars r \<subseteq> \<V>);
      if \<not>b
      then RETURN False
      else do {
        ASSERT (p \<in># dom_m A);
        let p = the (fmlookup A p);
        pq \<leftarrow> mult_poly_spec p q;
        p \<leftarrow> weak_equality pq r;
        RETURN p
      }
   }\<close>
   unfolding check_mult_def
   apply (rule refine_IdD)
   by refine_vcg
    (auto simp: check_mult_def weak_equality_def
       mult_poly_spec_def RES_RES_RETURN_RES
     intro!:  ideal.span_zero
       exI[of _ \<open>the (fmlookup A p) * q\<close>])
 
 primrec insort_key_rel :: "('b \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> 'b \<Rightarrow> 'b list \<Rightarrow> 'b list" where
 "insort_key_rel f x [] = [x]" |
 "insort_key_rel f x (y#ys) =
   (if f x y then (x#y#ys) else y#(insort_key_rel f x ys))"
 
 lemma set_insort_key_rel[simp]: \<open>set (insort_key_rel R x xs) = insert x (set xs)\<close>
   by (induction xs)
    auto
 
 lemma sorted_wrt_insort_key_rel:
    \<open>total_on R (insert x (set xs)) \<Longrightarrow> transp R \<Longrightarrow> reflp R \<Longrightarrow>
     sorted_wrt R xs \<Longrightarrow> sorted_wrt R (insort_key_rel R x xs)\<close>
   by (induction xs)
    (auto dest: transpD reflpD simp: Restricted_Predicates.total_on_def)
 
 lemma sorted_wrt_insort_key_rel2:
    \<open>total_on R (insert x (set xs)) \<Longrightarrow> transp R \<Longrightarrow> x \<notin> set xs \<Longrightarrow>
     sorted_wrt R xs \<Longrightarrow> sorted_wrt R (insort_key_rel R x xs)\<close>
   by (induction xs)
    (auto dest: transpD simp: Restricted_Predicates.total_on_def in_mono)
 
 
 paragraph \<open>Step checking\<close>
 
 definition PAC_checker_l_step ::  \<open>_ \<Rightarrow> string code_status \<times> string set \<times> _ \<Rightarrow> (llist_polynomial, string, nat) pac_step \<Rightarrow> _\<close> where
   \<open>PAC_checker_l_step = (\<lambda>spec (st', \<V>, A) st. case st of
      Add _ _ _ _ \<Rightarrow>
        do {
          r \<leftarrow> full_normalize_poly (pac_res st);
         eq \<leftarrow> check_addition_l spec A \<V> (pac_src1 st) (pac_src2 st) (new_id st) r;
         let _ = eq;
         if \<not>is_cfailed eq
         then RETURN (merge_cstatus st' eq,
           \<V>, fmupd (new_id st) r A)
         else RETURN (eq, \<V>, A)
    }
    | Del _ \<Rightarrow>
        do {
         eq \<leftarrow> check_del_l spec A (pac_src1 st);
         let _ = eq;
         if \<not>is_cfailed eq
         then RETURN (merge_cstatus st' eq, \<V>, fmdrop (pac_src1 st) A)
         else RETURN (eq, \<V>, A)
    }
    | Mult _ _ _ _ \<Rightarrow>
        do {
          r \<leftarrow> full_normalize_poly (pac_res st);
          q \<leftarrow> full_normalize_poly (pac_mult st);
         eq \<leftarrow> check_mult_l spec A \<V> (pac_src1 st) q (new_id st) r;
         let _ = eq;
         if \<not>is_cfailed eq
         then RETURN (merge_cstatus st' eq,
           \<V>, fmupd (new_id st) r A)
         else RETURN (eq, \<V>, A)
    }
    | Extension _ _ _ \<Rightarrow>
        do {
          r \<leftarrow> full_normalize_poly (([new_var st], -1) # (pac_res st));
         (eq) \<leftarrow> check_extension_l spec A \<V> (new_id st) (new_var st) r;
         if \<not>is_cfailed eq
         then do {
           RETURN (st',
             insert (new_var st) \<V>, fmupd (new_id st) r A)}
         else RETURN (eq, \<V>, A)
    }
  )\<close>
 
 lemma pac_step_rel_raw_def:
   \<open>\<langle>K, V, R\<rangle> pac_step_rel_raw = pac_step_rel_raw K V R\<close>
   by (auto intro!: ext simp: relAPP_def)
 
 definition mononoms_equal_up_to_reorder where
   \<open>mononoms_equal_up_to_reorder xs ys \<longleftrightarrow>
      map (\<lambda>(a, b).  (mset a, b)) xs = map (\<lambda>(a, b). (mset a, b)) ys\<close>
 
 
  definition normalize_poly_l where
   \<open>normalize_poly_l p = SPEC (\<lambda>p'.
      normalize_poly_p\<^sup>*\<^sup>* ((\<lambda>(a, b). (mset a, b)) `# mset p) ((\<lambda>(a, b). (mset a, b)) `# mset p') \<and>
      0 \<notin># snd `# mset p' \<and>
      sorted_wrt (rel2p (term_order_rel \<times>\<^sub>r int_rel)) p' \<and>
      (\<forall> x \<in> mononoms p'. sorted_wrt (rel2p var_order_rel) x))\<close>
 
 
 definition remap_polys_l_dom_err :: \<open>string nres\<close> where
   \<open>remap_polys_l_dom_err = SPEC (\<lambda>_. True)\<close>
 
 
 definition remap_polys_l :: \<open>llist_polynomial \<Rightarrow> string set \<Rightarrow> (nat, llist_polynomial) fmap \<Rightarrow>
    (_ code_status \<times> string set \<times> (nat, llist_polynomial) fmap) nres\<close> where
   \<open>remap_polys_l spec = (\<lambda>\<V> A. do{
    dom \<leftarrow> SPEC(\<lambda>dom. set_mset (dom_m A) \<subseteq> dom \<and> finite dom);
    failed \<leftarrow> SPEC(\<lambda>_::bool. True);
    if failed
    then do {
       c \<leftarrow> remap_polys_l_dom_err;
       RETURN (error_msg (0 :: nat) c, \<V>, fmempty)
    }
    else do {
      (b, \<V>, A) \<leftarrow> FOREACH dom
        (\<lambda>i (b, \<V>,  A').
           if i \<in># dom_m A
           then  do {
             p \<leftarrow> full_normalize_poly (the (fmlookup A i));
             eq \<leftarrow> weak_equality_l p spec;
             \<V> \<leftarrow> RETURN(\<V> \<union> vars_llist (the (fmlookup A i)));
             RETURN(b \<or> eq, \<V>, fmupd i p A')
           } else RETURN (b, \<V>, A'))
        (False, \<V>, fmempty);
      RETURN (if b then CFOUND else CSUCCESS, \<V>, A)
  }})\<close>
 
 definition PAC_checker_l where
   \<open>PAC_checker_l spec A b st = do {
     (S, _) \<leftarrow> WHILE\<^sub>T
        (\<lambda>((b, A), n). \<not>is_cfailed b \<and> n \<noteq> [])
        (\<lambda>((bA), n). do {
           ASSERT(n \<noteq> []);
           S \<leftarrow> PAC_checker_l_step spec bA (hd n);
           RETURN (S, tl n)
         })
       ((b, A), st);
     RETURN S
   }\<close>
 
 
 subsection \<open>Correctness\<close>
 
 text \<open>We now enter the locale to reason about polynomials directly.\<close>
 
 context poly_embed
 begin
 
 abbreviation pac_step_rel where
   \<open>pac_step_rel \<equiv> p2rel (\<langle>Id, fully_unsorted_poly_rel O mset_poly_rel, var_rel\<rangle> pac_step_rel_raw)\<close>
 
 abbreviation fmap_polys_rel where
   \<open>fmap_polys_rel \<equiv> \<langle>nat_rel, sorted_poly_rel O mset_poly_rel\<rangle>fmap_rel\<close>
 
 lemma
   \<open>normalize_poly_p s0 s \<Longrightarrow>
         (s0, p) \<in> mset_poly_rel \<Longrightarrow>
         (s, p) \<in> mset_poly_rel\<close>
   by (auto simp: mset_poly_rel_def normalize_poly_p_poly_of_mset)
 
 lemma vars_poly_of_vars:
   \<open>vars (poly_of_vars a :: int mpoly) \<subseteq> (\<phi> ` set_mset a)\<close>
   by (induction a)
    (auto simp: vars_mult_Var)
 
 lemma vars_polynomial_of_mset:
   \<open>vars (polynomial_of_mset za) \<subseteq> \<Union>(image \<phi> ` (set_mset o fst) ` set_mset za)\<close>
   apply (induction za)
   using vars_poly_of_vars
   by (fastforce elim!: in_vars_addE simp: vars_mult_Const split: if_splits)+
 
 lemma fully_unsorted_poly_rel_vars_subset_vars_llist:
   \<open>(A, B) \<in> fully_unsorted_poly_rel O mset_poly_rel \<Longrightarrow> vars B \<subseteq> \<phi> ` vars_llist A\<close>
   by (auto simp: fully_unsorted_poly_list_rel_def mset_poly_rel_def
       set_rel_def var_rel_def br_def vars_llist_def list_rel_append2 list_rel_append1
       list_rel_split_right_iff list_mset_rel_def image_iff
       unsorted_term_poly_list_rel_def list_rel_split_left_iff
     dest!: set_rev_mp[OF _ vars_polynomial_of_mset] split_list
     dest: multi_member_split
     dest: arg_cong[of \<open>mset _\<close> \<open>add_mset _ _\<close> set_mset])
 
 lemma fully_unsorted_poly_rel_extend_vars:
   \<open>(A, B) \<in> fully_unsorted_poly_rel O mset_poly_rel \<Longrightarrow>
   (x1c, x1a) \<in> \<langle>var_rel\<rangle>set_rel \<Longrightarrow>
    RETURN (x1c \<union> vars_llist A)
     \<le> \<Down> (\<langle>var_rel\<rangle>set_rel)
        (SPEC ((\<subseteq>) (x1a \<union> vars (B))))\<close>
   using fully_unsorted_poly_rel_vars_subset_vars_llist[of A B]
   apply (subst RETURN_RES_refine_iff)
   apply clarsimp
   apply (rule exI[of _ \<open>x1a \<union> \<phi> ` vars_llist A\<close>])
   apply (auto simp: set_rel_def var_rel_def br_def
     dest: fully_unsorted_poly_rel_vars_subset_vars_llist)
   done
 
 lemma remap_polys_l_remap_polys:
   assumes
     AB: \<open>(A, B) \<in> \<langle>nat_rel, fully_unsorted_poly_rel O mset_poly_rel\<rangle>fmap_rel\<close> and
     spec: \<open>(spec, spec') \<in> sorted_poly_rel O mset_poly_rel\<close> and
     V: \<open>(\<V>, \<V>') \<in> \<langle>var_rel\<rangle>set_rel\<close>
   shows \<open>remap_polys_l spec \<V> A \<le>
      \<Down>(code_status_status_rel \<times>\<^sub>r \<langle>var_rel\<rangle>set_rel \<times>\<^sub>r fmap_polys_rel) (remap_polys spec' \<V>' B)\<close>
   (is \<open>_ \<le> \<Down> ?R _\<close>)
 proof -
   have 1: \<open>inj_on id (dom :: nat set)\<close> for dom
     by auto
   have H: \<open>x \<in># dom_m A \<Longrightarrow>
      (\<And>p. (the (fmlookup A x), p) \<in> fully_unsorted_poly_rel \<Longrightarrow>
        (p, the (fmlookup B x)) \<in> mset_poly_rel \<Longrightarrow> thesis) \<Longrightarrow>
      thesis\<close> for x thesis
      using fmap_rel_nat_the_fmlookup[OF AB, of x x] fmap_rel_nat_rel_dom_m[OF AB] by auto
   have full_normalize_poly: \<open>full_normalize_poly (the (fmlookup A x))
        \<le> \<Down> (sorted_poly_rel O mset_poly_rel)
           (SPEC
             (\<lambda>p. the (fmlookup B x') - p \<in> More_Modules.ideal polynomial_bool \<and>
                  vars p \<subseteq> vars (the (fmlookup B x'))))\<close>
       if x_dom: \<open>x \<in># dom_m A\<close> and \<open>(x, x') \<in> Id\<close> for x x'
       apply (rule H[OF x_dom])
       subgoal for p
       apply (rule full_normalize_poly_normalize_poly_p[THEN order_trans])
       apply assumption
       subgoal
         using that(2) apply -
         unfolding conc_fun_chain[symmetric]
         by (rule ref_two_step', rule RES_refine)
          (auto simp: rtranclp_normalize_poly_p_poly_of_mset
           mset_poly_rel_def ideal.span_zero)
       done
       done
 
   have H': \<open>(p, pa) \<in> sorted_poly_rel O mset_poly_rel \<Longrightarrow>
      weak_equality_l p spec \<le> SPEC (\<lambda>eqa. eqa \<longrightarrow> pa = spec')\<close> for p pa
     using spec by (auto simp: weak_equality_l_def weak_equality_spec_def
         list_mset_rel_def br_def mset_poly_rel_def
       dest: list_rel_term_poly_list_rel_same_rightD sorted_poly_list_relD)
 
   have emp: \<open>(\<V>, \<V>') \<in> \<langle>var_rel\<rangle>set_rel \<Longrightarrow>
     ((False, \<V>, fmempty), False, \<V>', fmempty) \<in> bool_rel \<times>\<^sub>r \<langle>var_rel\<rangle>set_rel \<times>\<^sub>r fmap_polys_rel\<close> for \<V> \<V>'
     by auto
   show ?thesis
     using assms
     unfolding remap_polys_l_def remap_polys_l_dom_err_def
       remap_polys_def prod.case
     apply (refine_rcg full_normalize_poly fmap_rel_fmupd_fmap_rel)
     subgoal
       by auto
     subgoal
       by auto
     subgoal
       by (auto simp: error_msg_def)
     apply (rule 1)
     subgoal by auto
     apply (rule emp)
     subgoal
       using V by auto
     subgoal by auto
     subgoal by auto
     subgoal by (rule H')
     apply (rule fully_unsorted_poly_rel_extend_vars)
     subgoal by (auto intro!: fmap_rel_nat_the_fmlookup)
     subgoal by (auto intro!: fmap_rel_fmupd_fmap_rel)
     subgoal by (auto intro!: fmap_rel_fmupd_fmap_rel)
     subgoal by auto
     subgoal by auto
     done
 qed
 
 
 lemma fref_to_Down_curry:
   \<open>(uncurry f, uncurry g) \<in> [P]\<^sub>f A \<rightarrow> \<langle>B\<rangle>nres_rel \<Longrightarrow>
      (\<And>x x' y y'. P (x', y') \<Longrightarrow> ((x, y), (x', y')) \<in> A \<Longrightarrow> f x y \<le> \<Down> B (g x' y'))\<close>
   unfolding fref_def uncurry_def nres_rel_def
   by auto
 
 lemma weak_equality_spec_weak_equality:
   \<open>(p, p') \<in> mset_poly_rel \<Longrightarrow>
     (r, r') \<in> mset_poly_rel \<Longrightarrow>
     weak_equality_spec p r \<le> weak_equality p' r'\<close>
   unfolding weak_equality_spec_def weak_equality_def
   by (auto simp: mset_poly_rel_def)
 
 
 lemma weak_equality_l_weak_equality_l'[refine]:
   \<open>weak_equality_l p q \<le> \<Down> bool_rel (weak_equality p' q')\<close>
   if \<open>(p, p') \<in> sorted_poly_rel O mset_poly_rel\<close>
     \<open>(q, q') \<in> sorted_poly_rel O mset_poly_rel\<close>
   for p p' q q'
   using that
   by (auto intro!: weak_equality_l_weak_equality_spec[THEN fref_to_Down_curry, THEN order_trans]
          ref_two_step'
          weak_equality_spec_weak_equality
       simp flip: conc_fun_chain)
 
 lemma error_msg_ne_SUCCES[iff]:
   \<open>error_msg i m \<noteq> CSUCCESS\<close>
   \<open>error_msg i m \<noteq> CFOUND\<close>
   \<open>is_cfailed (error_msg i m)\<close>
   \<open>\<not>is_cfound (error_msg i m)\<close>
   by (auto simp: error_msg_def)
 
 lemma sorted_poly_rel_vars_llist:
   \<open>(r, r') \<in> sorted_poly_rel O mset_poly_rel \<Longrightarrow>
    vars r' \<subseteq> \<phi> ` vars_llist r\<close>
   apply (auto simp: mset_poly_rel_def
       set_rel_def var_rel_def br_def vars_llist_def list_rel_append2 list_rel_append1
       list_rel_split_right_iff list_mset_rel_def image_iff sorted_poly_list_rel_wrt_def
     dest!: set_rev_mp[OF _ vars_polynomial_of_mset]
     dest!: split_list)
     apply (auto dest!: multi_member_split simp: list_rel_append1
       term_poly_list_rel_def eq_commute[of _ \<open>mset _\<close>]
       list_rel_split_right_iff list_rel_append2 list_rel_split_left_iff
       dest: arg_cong[of \<open>mset _\<close> \<open>add_mset _ _\<close> set_mset])
     done
 
 
 lemma check_addition_l_check_add:
   assumes \<open>(A, B) \<in> fmap_polys_rel\<close> and \<open>(r, r') \<in> sorted_poly_rel O mset_poly_rel\<close>
     \<open>(p, p') \<in> Id\<close> \<open>(q, q') \<in> Id\<close> \<open>(i, i') \<in> nat_rel\<close>
     \<open>(\<V>', \<V>) \<in> \<langle>var_rel\<rangle>set_rel\<close>
   shows
     \<open>check_addition_l spec A \<V>' p q i r \<le> \<Down> {(st, b). (\<not>is_cfailed st \<longleftrightarrow> b) \<and>
        (is_cfound st \<longrightarrow> spec = r)} (check_add B \<V> p' q' i' r')\<close>
 proof -
   have [refine]:
     \<open>add_poly_l (p, q) \<le> \<Down> (sorted_poly_rel O mset_poly_rel) (add_poly_spec p' q')\<close>
     if \<open>(p, p') \<in> sorted_poly_rel O mset_poly_rel\<close>
       \<open>(q, q') \<in> sorted_poly_rel O mset_poly_rel\<close>
     for p p' q q'
     using that
     by (auto intro!: add_poly_l_add_poly_p'[THEN order_trans] ref_two_step'
          add_poly_p'_add_poly_spec
       simp flip: conc_fun_chain)
 
   show ?thesis
     using assms
     unfolding check_addition_l_def
       check_not_equal_dom_err_def apply -
     apply (rule order_trans)
     defer
     apply (rule ref_two_step')
     apply (rule check_add_alt_def)
     apply refine_rcg
     subgoal
       by (drule sorted_poly_rel_vars_llist)
        (auto simp: set_rel_def var_rel_def br_def)
     subgoal
       by auto
     subgoal
       by auto
     subgoal
       by auto
     subgoal
       by auto
     subgoal
       by auto
     subgoal
       by auto
     subgoal
       by (auto simp: weak_equality_l_def bind_RES_RETURN_eq)
     done
 qed
 
 lemma check_del_l_check_del:
   \<open>(A, B) \<in> fmap_polys_rel \<Longrightarrow> (x3, x3a) \<in> Id \<Longrightarrow> check_del_l spec A (pac_src1 (Del x3))
     \<le> \<Down> {(st, b). (\<not>is_cfailed st \<longleftrightarrow> b) \<and> (b \<longrightarrow> st = CSUCCESS)} (check_del B (pac_src1 (Del x3a)))\<close>
   unfolding check_del_l_def check_del_def
   by (refine_vcg lhs_step_If RETURN_SPEC_refine)
     (auto simp: fmap_rel_nat_rel_dom_m bind_RES_RETURN_eq)
 
 lemma check_mult_l_check_mult:
   assumes \<open>(A, B) \<in> fmap_polys_rel\<close> and \<open>(r, r') \<in> sorted_poly_rel O mset_poly_rel\<close> and
     \<open>(q, q') \<in> sorted_poly_rel O mset_poly_rel\<close>
     \<open>(p, p') \<in> Id\<close> \<open>(i, i') \<in> nat_rel\<close> \<open>(\<V>, \<V>') \<in> \<langle>var_rel\<rangle>set_rel\<close>
   shows
     \<open>check_mult_l spec A \<V> p q i r \<le> \<Down>  {(st, b). (\<not>is_cfailed st \<longleftrightarrow> b) \<and>
        (is_cfound st \<longrightarrow> spec = r)} (check_mult B \<V>' p' q' i' r')\<close>
 proof -
   have [refine]:
     \<open>mult_poly_full p q \<le> \<Down> (sorted_poly_rel O mset_poly_rel) (mult_poly_spec p' q')\<close>
     if \<open>(p, p') \<in> sorted_poly_rel O mset_poly_rel\<close>
       \<open>(q, q') \<in> sorted_poly_rel O mset_poly_rel\<close>
     for p p' q q'
     using that
     by (auto intro!: mult_poly_full_mult_poly_p'[THEN order_trans] ref_two_step'
          mult_poly_p'_mult_poly_spec
       simp flip: conc_fun_chain)
 
   show ?thesis
     using assms
     unfolding check_mult_l_def
       check_mult_l_mult_err_def check_mult_l_dom_err_def apply -
     apply (rule order_trans)
     defer
     apply (rule ref_two_step')
     apply (rule check_mult_alt_def)
     apply refine_rcg
     subgoal
       by (drule sorted_poly_rel_vars_llist)+
         (fastforce simp: set_rel_def var_rel_def br_def)
     subgoal
       by auto
     subgoal
       by auto
     subgoal
       by auto
     subgoal
       by auto
     subgoal
       by (auto simp: weak_equality_l_def bind_RES_RETURN_eq)
     done
 qed
 
 
 lemma normalize_poly_normalize_poly_spec:
   assumes \<open>(r, t) \<in> unsorted_poly_rel O mset_poly_rel\<close>
   shows
     \<open>normalize_poly r \<le> \<Down>(sorted_poly_rel O mset_poly_rel) (normalize_poly_spec t)\<close>
 proof -
   obtain s where
     rs: \<open>(r, s) \<in> unsorted_poly_rel\<close> and
     st: \<open>(s, t) \<in> mset_poly_rel\<close>
     using assms by auto
   show ?thesis
     by (rule normalize_poly_normalize_poly_p[THEN order_trans, OF rs])
      (use st in \<open>auto dest!: rtranclp_normalize_poly_p_poly_of_mset
       intro!: ref_two_step' RES_refine exI[of _ t]
       simp: normalize_poly_spec_def ideal.span_zero mset_poly_rel_def
       simp flip: conc_fun_chain\<close>)
 qed
 
 lemma remove1_list_rel:
   \<open>(xs, ys) \<in> \<langle>R\<rangle> list_rel \<Longrightarrow>
   (a, b) \<in> R \<Longrightarrow>
   IS_RIGHT_UNIQUE R \<Longrightarrow>
   IS_LEFT_UNIQUE R \<Longrightarrow>
   (remove1 a xs, remove1 b ys) \<in> \<langle>R\<rangle>list_rel\<close>
   by (induction xs ys rule: list_rel_induct)
    (auto simp: single_valued_def IS_LEFT_UNIQUE_def)
 
 lemma remove1_list_rel2:
   \<open>(xs, ys) \<in> \<langle>R\<rangle> list_rel \<Longrightarrow>
   (a, b) \<in> R \<Longrightarrow>
   (\<And>c. (a, c) \<in> R \<Longrightarrow> c = b) \<Longrightarrow>
   (\<And>c. (c, b) \<in> R \<Longrightarrow> c = a) \<Longrightarrow>
   (remove1 a xs, remove1 b ys) \<in> \<langle>R\<rangle>list_rel\<close>
   apply (induction xs ys rule: list_rel_induct)
    apply (solves \<open>simp (no_asm)\<close>)
-  by (smt list_rel_simp(4) remove1.simps(2))
+  by (smt (verit) list_rel_simp(4) remove1.simps(2))
 
 lemma remove1_sorted_poly_rel_mset_poly_rel:
   assumes
     \<open>(r, r') \<in> sorted_poly_rel O mset_poly_rel\<close> and
     \<open>([a], 1) \<in> set r\<close>
   shows
     \<open>(remove1 ([a], 1) r, r' - Var (\<phi> a))
           \<in> sorted_poly_rel O mset_poly_rel\<close>
 proof -
    have [simp]: \<open>([a], {#a#}) \<in> term_poly_list_rel\<close>
      \<open>\<And>aa. ([a], aa) \<in> term_poly_list_rel \<longleftrightarrow> aa = {#a#}\<close>
      by (auto simp: term_poly_list_rel_def)
   have H:
     \<open>\<And>aa. ([a], aa) \<in> term_poly_list_rel \<Longrightarrow> aa = {#a#}\<close>
      \<open>\<And>aa. (aa, {#a#}) \<in> term_poly_list_rel \<Longrightarrow> aa = [a]\<close>
      by (auto simp: single_valued_def IS_LEFT_UNIQUE_def
        term_poly_list_rel_def)
 
   have [simp]: \<open>Const (1 :: int) = (1 :: int mpoly)\<close>
     by (simp add: Const.abs_eq Const\<^sub>0_one one_mpoly.abs_eq)
   have [simp]: \<open>sorted_wrt term_order (map fst r) \<Longrightarrow>
          sorted_wrt term_order (map fst (remove1 ([a], 1) r))\<close>
     by (induction r) auto
   have [intro]: \<open>distinct (map fst r) \<Longrightarrow> distinct (map fst (remove1 x r))\<close> for x
     by (induction r) (auto dest: notin_set_remove1)
   have [simp]: \<open>(r, ya) \<in> \<langle>term_poly_list_rel \<times>\<^sub>r int_rel\<rangle>list_rel \<Longrightarrow>
          polynomial_of_mset (mset ya) -  Var (\<phi> a) =
          polynomial_of_mset (remove1_mset ({#a#}, 1) (mset ya))\<close> for ya
     using assms
      by (auto simp: list_rel_append1 list_rel_split_right_iff
        dest!: split_list)
 
   show ?thesis
     using assms
     apply (elim relcompEpair)
     apply (rename_tac za, rule_tac b = \<open>remove1_mset ({#a#}, 1) za\<close> in relcompI)
     apply (auto simp: mset_poly_rel_def sorted_poly_list_rel_wrt_def Collect_eq_comp'
       intro!: relcompI[of _ \<open>remove1 ({#a#}, 1) ya\<close>
         for ya :: \<open>(string multiset \<times> int) list\<close>]  remove1_list_rel2 intro: H
       simp: list_mset_rel_def br_def
       dest: in_diffD)
     done
 qed
 
 lemma remove1_sorted_poly_rel_mset_poly_rel_minus:
   assumes
     \<open>(r, r') \<in> sorted_poly_rel O mset_poly_rel\<close> and
     \<open>([a], -1) \<in> set r\<close>
   shows
     \<open>(remove1 ([a], -1) r, r' + Var (\<phi> a))
           \<in> sorted_poly_rel O mset_poly_rel\<close>
 proof -
    have [simp]: \<open>([a], {#a#}) \<in> term_poly_list_rel\<close>
      \<open>\<And>aa. ([a], aa) \<in> term_poly_list_rel \<longleftrightarrow> aa = {#a#}\<close>
      by (auto simp: term_poly_list_rel_def)
   have H:
     \<open>\<And>aa. ([a], aa) \<in> term_poly_list_rel \<Longrightarrow> aa = {#a#}\<close>
      \<open>\<And>aa. (aa, {#a#}) \<in> term_poly_list_rel \<Longrightarrow> aa = [a]\<close>
      by (auto simp: single_valued_def IS_LEFT_UNIQUE_def
        term_poly_list_rel_def)
 
   have [simp]: \<open>Const (1 :: int) = (1 :: int mpoly)\<close>
     by (simp add: Const.abs_eq Const\<^sub>0_one one_mpoly.abs_eq)
   have [simp]: \<open>sorted_wrt term_order (map fst r) \<Longrightarrow>
          sorted_wrt term_order (map fst (remove1 ([a], -1) r))\<close>
     by (induction r) auto
   have [intro]: \<open>distinct (map fst r) \<Longrightarrow> distinct (map fst (remove1 x r))\<close> for x
     apply (induction r) apply auto
     by (meson img_fst in_set_remove1D)
   have [simp]: \<open>(r, ya) \<in> \<langle>term_poly_list_rel \<times>\<^sub>r int_rel\<rangle>list_rel \<Longrightarrow>
          polynomial_of_mset (mset ya) +  Var (\<phi> a) =
          polynomial_of_mset (remove1_mset ({#a#}, -1) (mset ya))\<close> for ya
     using assms
      by (auto simp: list_rel_append1 list_rel_split_right_iff
        dest!: split_list)
 
   show ?thesis
     using assms
     apply (elim relcompEpair)
     apply (rename_tac za, rule_tac b = \<open>remove1_mset ({#a#}, -1) za\<close> in relcompI)
     by (auto simp: mset_poly_rel_def sorted_poly_list_rel_wrt_def Collect_eq_comp'
        dest: in_diffD
        intro!: relcompI[of _ \<open>remove1 ({#a#}, -1) ya\<close>
          for ya :: \<open>(string multiset \<times> int) list\<close>]  remove1_list_rel2 intro: H
       simp: list_mset_rel_def br_def)
 qed
 
 
 lemma insert_var_rel_set_rel:
   \<open>(\<V>, \<V>') \<in> \<langle>var_rel\<rangle>set_rel \<Longrightarrow>
   (yb, x2) \<in> var_rel \<Longrightarrow>
   (insert yb \<V>, insert x2 \<V>') \<in> \<langle>var_rel\<rangle>set_rel\<close>
   by (auto simp: var_rel_def set_rel_def)
 
 lemma var_rel_set_rel_iff:
   \<open>(\<V>, \<V>') \<in> \<langle>var_rel\<rangle>set_rel \<Longrightarrow>
   (yb, x2) \<in> var_rel \<Longrightarrow>
   yb \<in> \<V> \<longleftrightarrow> x2 \<in>  \<V>'\<close>
   using \<phi>_inj inj_eq by (fastforce simp: var_rel_def set_rel_def br_def)
 
 
 lemma check_extension_l_check_extension:
   assumes \<open>(A, B) \<in> fmap_polys_rel\<close> and \<open>(r, r') \<in> sorted_poly_rel O mset_poly_rel\<close> and
     \<open>(i, i') \<in> nat_rel\<close> \<open>(\<V>, \<V>') \<in> \<langle>var_rel\<rangle>set_rel\<close> \<open>(x, x') \<in> var_rel\<close>
   shows
     \<open>check_extension_l spec A \<V> i x r \<le>
       \<Down>{((st), (b)).
         (\<not>is_cfailed st \<longleftrightarrow> b) \<and>
        (is_cfound st \<longrightarrow> spec = r)} (check_extension B \<V>' i' x' r')\<close>
 proof -
   have \<open>x' = \<phi> x\<close>
     using assms(5) by (auto simp: var_rel_def br_def)
   have [refine]:
     \<open>mult_poly_full p q \<le> \<Down> (sorted_poly_rel O mset_poly_rel) (mult_poly_spec p' q')\<close>
     if \<open>(p, p') \<in> sorted_poly_rel O mset_poly_rel\<close>
       \<open>(q, q') \<in> sorted_poly_rel O mset_poly_rel\<close>
     for p p' q q'
     using that
     by (auto intro!: mult_poly_full_mult_poly_p'[THEN order_trans] ref_two_step'
          mult_poly_p'_mult_poly_spec
       simp flip: conc_fun_chain)
   have [refine]:
     \<open>add_poly_l (p, q) \<le> \<Down> (sorted_poly_rel O mset_poly_rel) (add_poly_spec p' q')\<close>
     if \<open>(p, p') \<in> sorted_poly_rel O mset_poly_rel\<close>
       \<open>(q, q') \<in> sorted_poly_rel O mset_poly_rel\<close>
     for p p' q q'
     using that
     by (auto intro!: add_poly_l_add_poly_p'[THEN order_trans] ref_two_step'
          add_poly_p'_add_poly_spec
       simp flip: conc_fun_chain)
 
   have [simp]: \<open>(l, l') \<in> \<langle>term_poly_list_rel \<times>\<^sub>r int_rel\<rangle>list_rel \<Longrightarrow>
        (map (\<lambda>(a, b). (a, - b)) l, map (\<lambda>(a, b). (a, - b)) l')
        \<in> \<langle>term_poly_list_rel \<times>\<^sub>r int_rel\<rangle>list_rel\<close> for l l'
      by (induction l l'  rule: list_rel_induct)
         (auto simp: list_mset_rel_def br_def)
 
   have [intro!]:
     \<open>(x2c, za) \<in> \<langle>term_poly_list_rel \<times>\<^sub>r int_rel\<rangle>list_rel O list_mset_rel \<Longrightarrow>
      (map (\<lambda>(a, b). (a, - b)) x2c,
         {#case x of (a, b) \<Rightarrow> (a, - b). x \<in># za#})
        \<in> \<langle>term_poly_list_rel \<times>\<^sub>r int_rel\<rangle>list_rel O list_mset_rel\<close> for x2c za
      apply (auto)
      subgoal for y
        apply (induction x2c y  rule: list_rel_induct)
        apply (auto simp: list_mset_rel_def br_def)
        apply (rename_tac a ba aa l l', rule_tac b = \<open>(aa, - ba) # map (\<lambda>(a, b). (a, - b)) l'\<close> in relcompI)
        by auto
      done
   have [simp]: \<open>(\<lambda>x. fst (case x of (a, b) \<Rightarrow> (a, - b))) = fst\<close>
     by (auto intro: ext)
 
   have uminus: \<open>(x2c, x2a) \<in> sorted_poly_rel O mset_poly_rel \<Longrightarrow>
        (map (\<lambda>(a, b). (a, - b)) x2c,
         - x2a)
        \<in> sorted_poly_rel O mset_poly_rel\<close> for x2c x2a x1c x1a
      apply (clarsimp simp: sorted_poly_list_rel_wrt_def
       mset_poly_rel_def)
     apply (rule_tac b = \<open>(\<lambda>(a, b). (a, - b)) `# za\<close> in relcompI)
     by (auto simp: sorted_poly_list_rel_wrt_def
       mset_poly_rel_def comp_def polynomial_of_mset_uminus)
    have [simp]: \<open>([], 0) \<in> sorted_poly_rel O mset_poly_rel\<close>
      by (auto simp: sorted_poly_list_rel_wrt_def
       mset_poly_rel_def list_mset_rel_def br_def
       intro!: relcompI[of _ \<open>{#}\<close>])
    show ?thesis
      unfolding check_extension_l_def
        check_extension_l_dom_err_def
        check_extension_l_no_new_var_err_def
        check_extension_l_new_var_multiple_err_def
        check_extension_l_side_cond_err_def
       apply (rule order_trans)
       defer
       apply (rule ref_two_step')
       apply (rule check_extension_alt_def)
       apply (refine_vcg )
       subgoal using assms(1,3,4,5)
         by (auto simp: var_rel_set_rel_iff)
       subgoal using assms(1,3,4,5)
         by (auto simp: var_rel_set_rel_iff)
       subgoal by auto
       subgoal by auto
       apply (subst \<open>x' = \<phi> x\<close>, rule remove1_sorted_poly_rel_mset_poly_rel_minus)
       subgoal using assms by auto
       subgoal using assms by auto
       subgoal using sorted_poly_rel_vars_llist[of \<open>r\<close> \<open>r'\<close>] assms
         by (force simp: set_rel_def var_rel_def br_def
           dest!: sorted_poly_rel_vars_llist)
       subgoal by auto
       subgoal by auto
       subgoal using assms by auto
       subgoal using assms by auto
       apply (rule uminus)
       subgoal using assms by auto
       subgoal using assms by auto
       subgoal using assms by auto
       subgoal using assms by auto
       subgoal using assms by auto
       done
 qed
 
 
 lemma full_normalize_poly_diff_ideal:
   fixes dom
   assumes \<open>(p, p') \<in> fully_unsorted_poly_rel O mset_poly_rel\<close>
   shows
     \<open>full_normalize_poly p
     \<le> \<Down> (sorted_poly_rel O mset_poly_rel)
        (normalize_poly_spec p')\<close>
 proof -
   obtain q where
     pq: \<open>(p, q) \<in> fully_unsorted_poly_rel\<close>  and qp':\<open>(q, p') \<in> mset_poly_rel\<close>
     using assms by auto
    show ?thesis
      unfolding normalize_poly_spec_def
      apply (rule full_normalize_poly_normalize_poly_p[THEN order_trans])
      apply (rule pq)
      unfolding conc_fun_chain[symmetric]
      by (rule ref_two_step', rule RES_refine)
        (use qp' in \<open>auto dest!: rtranclp_normalize_poly_p_poly_of_mset
             simp: mset_poly_rel_def ideal.span_zero\<close>)
 qed
 
 lemma insort_key_rel_decomp:
    \<open>\<exists>ys zs. xs = ys @ zs \<and> insort_key_rel R x xs = ys @ x # zs\<close>
   apply (induction xs)
   subgoal by auto
   subgoal for a xs
     by (force intro: exI[of _ \<open>a # _\<close>])
   done
 
 lemma list_rel_append_same_length:
    \<open>length xs = length xs' \<Longrightarrow> (xs @ ys, xs' @ ys') \<in> \<langle>R\<rangle>list_rel \<longleftrightarrow> (xs, xs') \<in> \<langle>R\<rangle>list_rel \<and> (ys, ys') \<in> \<langle>R\<rangle>list_rel\<close>
   by (auto simp: list_rel_def list_all2_append2 dest: list_all2_lengthD)
 
 lemma term_poly_list_rel_list_relD: \<open>(ys, cs) \<in> \<langle>term_poly_list_rel \<times>\<^sub>r int_rel\<rangle>list_rel \<Longrightarrow>
        cs = map (\<lambda>(a, y). (mset a, y)) ys\<close>
   by (induction ys arbitrary: cs)
    (auto simp: term_poly_list_rel_def list_rel_def list_all2_append list_all2_Cons1 list_all2_Cons2)
 
 lemma term_poly_list_rel_single: \<open>([x32], {#x32#}) \<in> term_poly_list_rel\<close>
   by (auto simp: term_poly_list_rel_def)
 
 lemma unsorted_poly_rel_list_rel_list_rel_uminus:
    \<open>(map (\<lambda>(a, b). (a, - b)) r, yc)
        \<in> \<langle>unsorted_term_poly_list_rel \<times>\<^sub>r int_rel\<rangle>list_rel \<Longrightarrow>
        (r, map (\<lambda>(a, b). (a, - b)) yc)
        \<in> \<langle>unsorted_term_poly_list_rel \<times>\<^sub>r int_rel\<rangle>list_rel\<close>
   by (induction r arbitrary: yc)
    (auto simp: elim!: list_relE3)
 
 lemma mset_poly_rel_minus: \<open>({#(a, b)#}, v') \<in> mset_poly_rel \<Longrightarrow>
        (mset yc, r') \<in> mset_poly_rel \<Longrightarrow>
        (r, yc)
        \<in> \<langle>unsorted_term_poly_list_rel \<times>\<^sub>r int_rel\<rangle>list_rel \<Longrightarrow>
        (add_mset (a, b) (mset yc),
         v' + r')
        \<in> mset_poly_rel\<close>
   by (induction r arbitrary: r')
     (auto simp: mset_poly_rel_def polynomial_of_mset_uminus)
 
 lemma fully_unsorted_poly_rel_diff:
    \<open>([v], v') \<in> fully_unsorted_poly_rel O mset_poly_rel \<Longrightarrow>
    (r, r') \<in> fully_unsorted_poly_rel O mset_poly_rel \<Longrightarrow>
     (v # r,
      v' + r')
     \<in> fully_unsorted_poly_rel O mset_poly_rel\<close>
   apply auto
   apply (rule_tac b = \<open>y + ya\<close> in relcompI)
   apply (auto simp: fully_unsorted_poly_list_rel_def list_mset_rel_def br_def)
   apply (rule_tac b = \<open>yb @ yc\<close> in relcompI)
   apply (auto elim!: list_relE3 simp: unsorted_poly_rel_list_rel_list_rel_uminus mset_poly_rel_minus)
   done
 
 lemma PAC_checker_l_step_PAC_checker_step:
   assumes
     \<open>(Ast, Bst) \<in> code_status_status_rel \<times>\<^sub>r \<langle>var_rel\<rangle>set_rel \<times>\<^sub>r fmap_polys_rel\<close> and
     \<open>(st, st') \<in> pac_step_rel\<close> and
     spec: \<open>(spec, spec') \<in> sorted_poly_rel O mset_poly_rel\<close>
   shows
     \<open>PAC_checker_l_step spec Ast st \<le> \<Down> (code_status_status_rel \<times>\<^sub>r \<langle>var_rel\<rangle>set_rel \<times>\<^sub>r fmap_polys_rel) (PAC_checker_step spec' Bst st')\<close>
 proof -
   obtain A \<V> cst B \<V>' cst' where
    Ast: \<open>Ast = (cst, \<V>, A)\<close> and
    Bst: \<open>Bst = (cst', \<V>', B)\<close> and
    \<V>[intro]: \<open>(\<V>, \<V>') \<in>  \<langle>var_rel\<rangle>set_rel\<close>  and
    AB: \<open>(A, B) \<in> fmap_polys_rel\<close>
      \<open>(cst, cst') \<in> code_status_status_rel\<close>
     using assms(1)
     by (cases Ast; cases Bst; auto)
   have [refine]: \<open>(r, ra) \<in> sorted_poly_rel O mset_poly_rel \<Longrightarrow>
        (eqa, eqaa)
        \<in> {(st, b). (\<not> is_cfailed st \<longleftrightarrow> b) \<and> (is_cfound st \<longrightarrow> spec = r)} \<Longrightarrow>
        RETURN eqa
        \<le> \<Down> code_status_status_rel
           (SPEC
             (\<lambda>st'. (\<not> is_failed st' \<and>
                    is_found st' \<longrightarrow>
                     ra - spec' \<in> More_Modules.ideal polynomial_bool)))\<close>
      for r ra eqa eqaa
      using spec
      by (cases eqa)
        (auto intro!: RETURN_RES_refine dest!: sorted_poly_list_relD
          simp: mset_poly_rel_def ideal.span_zero)
   have [simp]: \<open>(eqa, st'a) \<in> code_status_status_rel \<Longrightarrow>
        (merge_cstatus cst eqa, merge_status cst' st'a)
        \<in> code_status_status_rel\<close> for eqa st'a
      using AB
      by (cases eqa; cases st'a)
        (auto simp: code_status_status_rel_def)
   have [simp]: \<open>(merge_cstatus cst CSUCCESS, cst') \<in> code_status_status_rel\<close>
     using AB
     by (cases st)
       (auto simp: code_status_status_rel_def)
   have [simp]: \<open>(x32, x32a) \<in> var_rel \<Longrightarrow>
         ([([x32], -1::int)], -Var x32a) \<in> fully_unsorted_poly_rel O mset_poly_rel\<close> for x32 x32a
    by (auto simp: mset_poly_rel_def fully_unsorted_poly_list_rel_def list_mset_rel_def br_def
          unsorted_term_poly_list_rel_def var_rel_def Const_1_eq_1
        intro!: relcompI[of _ \<open>{#({#x32#}, -1 :: int)#}\<close>]
          relcompI[of _ \<open>[({#x32#}, -1)]\<close>])
   have H3: \<open>p - Var a = (-Var a) + p\<close> for p :: \<open>int mpoly\<close> and a
     by auto
   show ?thesis
     using assms(2)
     unfolding PAC_checker_l_step_def PAC_checker_step_def Ast Bst prod.case
     apply (cases st; cases st'; simp only: p2rel_def pac_step.case
       pac_step_rel_raw_def mem_Collect_eq prod.case pac_step_rel_raw.simps)
     subgoal
       apply (refine_rcg normalize_poly_normalize_poly_spec
         check_mult_l_check_mult check_addition_l_check_add
         full_normalize_poly_diff_ideal)
       subgoal using AB by auto
       subgoal using AB by auto
       subgoal by auto
       subgoal by auto
       subgoal by auto
       subgoal by (auto intro: \<V>)
       apply assumption+
       subgoal
         by (auto simp: code_status_status_rel_def)
       subgoal
         by (auto intro!: fmap_rel_fmupd_fmap_rel
           fmap_rel_fmdrop_fmap_rel AB)
       subgoal using AB by auto
       done
     subgoal
       apply (refine_rcg normalize_poly_normalize_poly_spec
         check_mult_l_check_mult check_addition_l_check_add
         full_normalize_poly_diff_ideal[unfolded normalize_poly_spec_def[symmetric]])
       subgoal using AB by auto
       subgoal using AB by auto
       subgoal using AB by auto
       subgoal by auto
       subgoal by auto
       subgoal by auto
       apply assumption+
       subgoal
         by (auto simp: code_status_status_rel_def)
       subgoal
         by (auto intro!: fmap_rel_fmupd_fmap_rel
           fmap_rel_fmdrop_fmap_rel AB)
       subgoal using AB by auto
       done
     subgoal
       apply (refine_rcg full_normalize_poly_diff_ideal
         check_extension_l_check_extension)
       subgoal using AB by (auto intro!: fully_unsorted_poly_rel_diff[of _ \<open>-Var _ :: int mpoly\<close>, unfolded H3[symmetric]] simp: comp_def case_prod_beta)
       subgoal using AB by auto
       subgoal using AB by auto
       subgoal by auto
       subgoal by auto
       subgoal
         by (auto simp: code_status_status_rel_def)
       subgoal
         by (auto simp: AB
           intro!: fmap_rel_fmupd_fmap_rel insert_var_rel_set_rel)
       subgoal
         by (auto simp: code_status_status_rel_def AB
           code_status.is_cfailed_def)
       done
     subgoal
       apply (refine_rcg normalize_poly_normalize_poly_spec
         check_del_l_check_del check_addition_l_check_add
         full_normalize_poly_diff_ideal[unfolded normalize_poly_spec_def[symmetric]])
       subgoal using AB by auto
       subgoal using AB by auto
       subgoal
         by (auto intro!: fmap_rel_fmupd_fmap_rel
           fmap_rel_fmdrop_fmap_rel code_status_status_rel_def AB)
       subgoal
         by (auto intro!: fmap_rel_fmupd_fmap_rel
           fmap_rel_fmdrop_fmap_rel AB)
       done
     done
 qed
 
 lemma code_status_status_rel_discrim_iff:
   \<open>(x1a, x1c) \<in> code_status_status_rel \<Longrightarrow> is_cfailed x1a \<longleftrightarrow> is_failed x1c\<close>
   \<open>(x1a, x1c) \<in> code_status_status_rel \<Longrightarrow> is_cfound x1a \<longleftrightarrow> is_found x1c\<close>
   by (cases x1a; cases x1c; auto; fail)+
 
 lemma PAC_checker_l_PAC_checker:
   assumes
     \<open>(A, B) \<in> \<langle>var_rel\<rangle>set_rel \<times>\<^sub>r fmap_polys_rel\<close> and
     \<open>(st, st') \<in> \<langle>pac_step_rel\<rangle>list_rel\<close> and
     \<open>(spec, spec') \<in> sorted_poly_rel O mset_poly_rel\<close> and
     \<open>(b, b') \<in> code_status_status_rel\<close>
   shows
     \<open>PAC_checker_l spec A b st \<le> \<Down> (code_status_status_rel \<times>\<^sub>r \<langle>var_rel\<rangle>set_rel \<times>\<^sub>r fmap_polys_rel) (PAC_checker spec' B b' st')\<close>
 proof -
   have [refine0]: \<open>(((b, A), st), (b', B), st') \<in> ((code_status_status_rel \<times>\<^sub>r \<langle>var_rel\<rangle>set_rel \<times>\<^sub>r fmap_polys_rel) \<times>\<^sub>r  \<langle>pac_step_rel\<rangle>list_rel)\<close>
     using assms by (auto simp: code_status_status_rel_def)
   show ?thesis
     using assms
     unfolding PAC_checker_l_def PAC_checker_def
     apply (refine_rcg PAC_checker_l_step_PAC_checker_step
       WHILEIT_refine[where R = \<open>((bool_rel \<times>\<^sub>r \<langle>var_rel\<rangle>set_rel \<times>\<^sub>r fmap_polys_rel) \<times>\<^sub>r \<langle>pac_step_rel\<rangle>list_rel)\<close>])
     subgoal by (auto simp: code_status_status_rel_discrim_iff)
     subgoal by auto
     subgoal by (auto simp: neq_Nil_conv)
     subgoal by (auto simp: neq_Nil_conv intro!: param_nth)
     subgoal by (auto simp: neq_Nil_conv)
     subgoal by auto
     done
 qed
 
 end
 
 lemma less_than_char_of_char[code_unfold]:
   \<open>(x, y) \<in> less_than_char \<longleftrightarrow> (of_char x :: nat) < of_char y\<close>
   by (auto simp: less_than_char_def less_char_def)
 
 
 lemmas [code] =
   add_poly_l'.simps[unfolded var_order_rel_def]
 
 export_code add_poly_l' in SML module_name test
 
 definition full_checker_l
   :: \<open>llist_polynomial \<Rightarrow> (nat, llist_polynomial) fmap \<Rightarrow> (_, string, nat) pac_step list \<Rightarrow>
     (string code_status \<times> _) nres\<close>
 where
   \<open>full_checker_l spec A st = do {
     spec' \<leftarrow> full_normalize_poly spec;
     (b, \<V>, A) \<leftarrow> remap_polys_l spec' {} A;
     if is_cfailed b
     then RETURN (b, \<V>, A)
     else do {
       let \<V> = \<V> \<union> vars_llist spec;
       PAC_checker_l spec' (\<V>, A) b st
     }
   }\<close>
 
 
 context poly_embed
 begin
 
 
 term normalize_poly_spec
 thm full_normalize_poly_diff_ideal[unfolded normalize_poly_spec_def[symmetric]]
 abbreviation unsorted_fmap_polys_rel where
   \<open>unsorted_fmap_polys_rel \<equiv> \<langle>nat_rel, fully_unsorted_poly_rel O mset_poly_rel\<rangle>fmap_rel\<close>
 
 lemma full_checker_l_full_checker:
  assumes
     \<open>(A, B) \<in> unsorted_fmap_polys_rel\<close> and
     \<open>(st, st') \<in> \<langle>pac_step_rel\<rangle>list_rel\<close> and
     \<open>(spec, spec') \<in> fully_unsorted_poly_rel O mset_poly_rel\<close>
   shows
     \<open>full_checker_l spec A st \<le> \<Down> (code_status_status_rel \<times>\<^sub>r \<langle>var_rel\<rangle>set_rel \<times>\<^sub>r fmap_polys_rel) (full_checker spec' B st')\<close>
 proof -
   have [refine]:
     \<open>(spec, spec') \<in> sorted_poly_rel O mset_poly_rel \<Longrightarrow>
     (\<V>, \<V>') \<in> \<langle>var_rel\<rangle>set_rel \<Longrightarrow>
     remap_polys_l spec \<V> A \<le> \<Down>(code_status_status_rel \<times>\<^sub>r \<langle>var_rel\<rangle>set_rel \<times>\<^sub>r fmap_polys_rel)
         (remap_polys_change_all spec' \<V>' B)\<close> for spec spec' \<V> \<V>'
     apply (rule remap_polys_l_remap_polys[THEN order_trans, OF assms(1)])
     apply assumption+
     apply (rule ref_two_step[OF order.refl])
     apply(rule remap_polys_spec[THEN order_trans])
     by (rule remap_polys_polynomial_bool_remap_polys_change_all)
 
   show ?thesis
     unfolding full_checker_l_def full_checker_def
     apply (refine_rcg remap_polys_l_remap_polys
        full_normalize_poly_diff_ideal[unfolded normalize_poly_spec_def[symmetric]]
        PAC_checker_l_PAC_checker)
     subgoal
       using assms(3) .
     subgoal by auto
     subgoal by (auto simp: is_cfailed_def is_failed_def)
     subgoal by auto
     apply (rule fully_unsorted_poly_rel_extend_vars)
     subgoal using assms(3) .
     subgoal by auto
     subgoal by auto
     subgoal
       using assms(2) by (auto simp: p2rel_def)
     subgoal by auto
     done
 qed
 
 
 lemma full_checker_l_full_checker':
   \<open>(uncurry2 full_checker_l, uncurry2 full_checker) \<in>
   ((fully_unsorted_poly_rel O mset_poly_rel) \<times>\<^sub>r unsorted_fmap_polys_rel) \<times>\<^sub>r \<langle>pac_step_rel\<rangle>list_rel \<rightarrow>\<^sub>f
     \<langle>(code_status_status_rel \<times>\<^sub>r \<langle>var_rel\<rangle>set_rel \<times>\<^sub>r fmap_polys_rel)\<rangle>nres_rel\<close>
   apply (intro frefI nres_relI)
   using full_checker_l_full_checker by force
 
 end
 
 definition remap_polys_l2 :: \<open>llist_polynomial \<Rightarrow> string set \<Rightarrow> (nat, llist_polynomial) fmap \<Rightarrow> _ nres\<close> where
   \<open>remap_polys_l2 spec = (\<lambda>\<V> A. do{
    n \<leftarrow> upper_bound_on_dom A;
    b \<leftarrow> RETURN (n \<ge> 2^64);
    if b
    then do {
      c \<leftarrow> remap_polys_l_dom_err;
      RETURN (error_msg (0 ::nat) c, \<V>, fmempty)
    }
    else do {
        (b, \<V>, A) \<leftarrow> nfoldli ([0..<n]) (\<lambda>_. True)
        (\<lambda>i (b, \<V>, A').
           if i \<in># dom_m A
           then do {
             ASSERT(fmlookup A i \<noteq> None);
             p \<leftarrow> full_normalize_poly (the (fmlookup A i));
             eq \<leftarrow> weak_equality_l p spec;
             \<V> \<leftarrow> RETURN (\<V> \<union> vars_llist (the (fmlookup A i)));
             RETURN(b \<or> eq, \<V>, fmupd i p A')
           } else RETURN (b, \<V>, A')
         )
        (False, \<V>, fmempty);
      RETURN (if b then CFOUND else CSUCCESS, \<V>, A)
     }
  })\<close>
 
 lemma remap_polys_l2_remap_polys_l:
   \<open>remap_polys_l2 spec \<V> A \<le> \<Down> Id (remap_polys_l spec \<V> A)\<close>
 proof -
   have [refine]: \<open>(A, A') \<in> Id \<Longrightarrow> upper_bound_on_dom A
     \<le> \<Down> {(n, dom). dom = set [0..<n]} (SPEC (\<lambda>dom. set_mset (dom_m A') \<subseteq> dom \<and> finite dom))\<close> for A A'
     unfolding upper_bound_on_dom_def
     apply (rule RES_refine)
     apply (auto simp: upper_bound_on_dom_def)
     done
   have 1: \<open>inj_on id dom\<close> for dom
     by auto
   have 2: \<open>x \<in># dom_m A \<Longrightarrow>
        x' \<in># dom_m A' \<Longrightarrow>
        (x, x') \<in> nat_rel \<Longrightarrow>
        (A, A') \<in> Id \<Longrightarrow>
        full_normalize_poly (the (fmlookup A x))
        \<le> \<Down> Id
           (full_normalize_poly (the (fmlookup A' x')))\<close>
        for A A' x x'
        by (auto)
   have 3: \<open>(n, dom) \<in> {(n, dom). dom = set [0..<n]} \<Longrightarrow>
        ([0..<n], dom) \<in> \<langle>nat_rel\<rangle>list_set_rel\<close> for n dom
   by (auto simp: list_set_rel_def br_def)
   have 4: \<open>(p,q) \<in> Id \<Longrightarrow>
     weak_equality_l p spec \<le> \<Down>Id (weak_equality_l q spec)\<close> for p q spec
     by auto
 
   have 6: \<open>a = b \<Longrightarrow> (a, b) \<in> Id\<close> for a b
     by auto
   show ?thesis
     unfolding remap_polys_l2_def remap_polys_l_def
     apply (refine_rcg LFO_refine[where R= \<open>Id \<times>\<^sub>r \<langle>Id\<rangle>set_rel \<times>\<^sub>r Id\<close>])
     subgoal by auto
     subgoal by auto
     subgoal by auto
     apply (rule 3)
     subgoal by auto
     subgoal by (simp add: in_dom_m_lookup_iff)
     subgoal by (simp add: in_dom_m_lookup_iff)
     apply (rule 2)
     subgoal by auto
     subgoal by auto
     subgoal by auto
     subgoal by auto
     apply (rule 4; assumption)
     apply (rule 6)
     subgoal by auto
     subgoal by auto
     subgoal by auto
     subgoal by auto
     subgoal by auto
     done
 qed
 
 end
diff --git a/thys/PAC_Checker/PAC_Checker_Init.thy b/thys/PAC_Checker/PAC_Checker_Init.thy
--- a/thys/PAC_Checker/PAC_Checker_Init.thy
+++ b/thys/PAC_Checker/PAC_Checker_Init.thy
@@ -1,892 +1,892 @@
 (*
   File:         PAC_Checker_Init.thy
   Author:       Mathias Fleury, Daniela Kaufmann, JKU
   Maintainer:   Mathias Fleury, JKU
 *)
 theory PAC_Checker_Init
   imports  PAC_Checker WB_Sort PAC_Checker_Relation
 begin
 
 section \<open>Initial Normalisation of Polynomials\<close>
 
 subsection \<open>Sorting\<close>
 
 text \<open>Adapted from the theory \<^text>\<open>HOL-ex.MergeSort\<close> by Tobias Nipkow. We did not change much, but
    we refine it to executable code and try to improve efficiency.
 \<close>
 
 fun merge :: "_ \<Rightarrow>  'a list \<Rightarrow> 'a list \<Rightarrow> 'a list"
 where
   "merge f (x#xs) (y#ys) =
          (if f x y then x # merge f xs (y#ys) else y # merge f (x#xs) ys)"
 | "merge f xs [] = xs"
 | "merge f [] ys = ys"
 
 lemma mset_merge [simp]:
   "mset (merge f xs ys) = mset xs + mset ys"
   by (induct f xs ys rule: merge.induct) (simp_all add: ac_simps)
 
 lemma set_merge [simp]:
   "set (merge f xs ys) = set xs \<union> set ys"
   by (induct f xs ys rule: merge.induct) auto
 
 lemma sorted_merge:
   "transp f \<Longrightarrow> (\<And>x y. f x y \<or> f y x) \<Longrightarrow>
    sorted_wrt f (merge f xs ys) \<longleftrightarrow> sorted_wrt f xs \<and> sorted_wrt f ys"
   apply (induct f xs ys rule: merge.induct)
   apply (auto simp add: ball_Un not_le less_le dest: transpD)
   apply blast
   apply (blast dest: transpD)
   done
 
 fun msort :: "_ \<Rightarrow> 'a list \<Rightarrow> 'a list"
 where
   "msort f [] = []"
 | "msort f [x] = [x]"
 | "msort f xs = merge f
                       (msort f (take (size xs div 2) xs))
                       (msort f (drop (size xs div 2) xs))"
 
 fun swap_ternary :: \<open>_\<Rightarrow>nat\<Rightarrow>nat\<Rightarrow> ('a \<times> 'a \<times> 'a) \<Rightarrow> ('a \<times> 'a \<times> 'a)\<close> where
   \<open>swap_ternary f m n  =
     (if (m = 0 \<and> n = 1)
     then (\<lambda>(a, b, c). if f a b then (a, b, c)
       else (b,a,c))
     else if (m = 0 \<and> n = 2)
     then (\<lambda>(a, b, c). if f a c then (a, b, c)
       else (c,b,a))
     else if (m = 1 \<and> n = 2)
     then (\<lambda>(a, b, c). if f b c then (a, b, c)
       else (a,c,b))
     else (\<lambda>(a, b, c). (a,b,c)))\<close>
 
 fun msort2 :: "_ \<Rightarrow> 'a list \<Rightarrow> 'a list"
 where
   "msort2 f [] = []"
 | "msort2 f [x] = [x]"
 | "msort2 f [x,y] = (if f x y then [x,y] else [y,x])"
 | "msort2 f xs = merge f
                       (msort f (take (size xs div 2) xs))
                       (msort f (drop (size xs div 2) xs))"
 
 lemmas [code del] =
   msort2.simps
 
 declare msort2.simps[simp del]
 lemmas [code] =
   msort2.simps[unfolded swap_ternary.simps, simplified]
 
 declare msort2.simps[simp]
 
 lemma msort_msort2:
   fixes xs :: \<open>'a :: linorder list\<close>
   shows \<open>msort (\<le>) xs = msort2 (\<le>) xs\<close>
   apply (induction  \<open>(\<le>) :: 'a \<Rightarrow> 'a \<Rightarrow> bool\<close> xs rule: msort2.induct)
   apply (auto dest: transpD)
   done
 
 lemma sorted_msort:
   "transp f \<Longrightarrow> (\<And>x y. f x y \<or> f y x) \<Longrightarrow>
    sorted_wrt f (msort f xs)"
   by (induct f xs rule: msort.induct) (simp_all add: sorted_merge)
 
 lemma mset_msort[simp]:
   "mset (msort f xs) = mset xs"
   by (induction f xs rule: msort.induct)
     (simp_all add: union_code)
 
 
 subsection \<open>Sorting applied to monomials\<close>
 
 lemma merge_coeffs_alt_def:
   \<open>(RETURN o merge_coeffs) p =
    REC\<^sub>T(\<lambda>f p.
      (case p of
        [] \<Rightarrow> RETURN []
      | [_] => RETURN p
      | ((xs, n) # (ys, m) # p) \<Rightarrow>
       (if xs = ys
        then if n + m \<noteq> 0 then f ((xs, n + m) # p) else f p
        else do {p \<leftarrow> f ((ys, m) # p); RETURN ((xs, n) # p)})))
     p\<close>
   apply (induction p rule: merge_coeffs.induct)
   subgoal by (subst RECT_unfold, refine_mono) auto
   subgoal by (subst RECT_unfold, refine_mono) auto
   subgoal for x p y q
     by (subst RECT_unfold, refine_mono)
      (smt case_prod_conv list.simps(5) merge_coeffs.simps(3) nres_monad1
       push_in_let_conv(2))
   done
 
 lemma hn_invalid_recover:
   \<open>is_pure R \<Longrightarrow> hn_invalid R = (\<lambda>x y. R x y * true)\<close>
   \<open>is_pure R \<Longrightarrow> invalid_assn R = (\<lambda>x y. R x y * true)\<close>
   by (auto simp: is_pure_conv invalid_pure_recover hn_ctxt_def intro!: ext)
 
 lemma safe_poly_vars:
   shows
     [safe_constraint_rules]:
       "is_pure (poly_assn)" and
     [safe_constraint_rules]:
       "is_pure (monom_assn)" and
     [safe_constraint_rules]:
       "is_pure (monomial_assn)" and
     [safe_constraint_rules]:
       "is_pure string_assn"
   by (auto intro!: pure_prod list_assn_pure simp: prod_assn_pure_conv)
 
 lemma invalid_assn_distrib:
   \<open>invalid_assn monom_assn \<times>\<^sub>a invalid_assn int_assn = invalid_assn (monom_assn \<times>\<^sub>a int_assn)\<close>
     apply (simp add: invalid_pure_recover hn_invalid_recover
       safe_constraint_rules)
     apply (subst hn_invalid_recover)
     apply (rule safe_poly_vars(2))
     apply (subst hn_invalid_recover)
     apply (rule safe_poly_vars)
     apply (auto intro!: ext)
     done
 
 lemma WTF_RF_recover:
   \<open>hn_ctxt (invalid_assn monom_assn \<times>\<^sub>a invalid_assn int_assn) xb
         x'a \<or>\<^sub>A
        hn_ctxt monomial_assn xb x'a \<Longrightarrow>\<^sub>t
        hn_ctxt (monomial_assn) xb x'a\<close>
   by (smt assn_aci(5) hn_ctxt_def invalid_assn_distrib invalid_pure_recover is_pure_conv
     merge_thms(4) merge_true_star reorder_enttI safe_poly_vars(3) star_aci(2) star_aci(3))
 
 lemma WTF_RF:
   \<open>hn_ctxt (invalid_assn monom_assn \<times>\<^sub>a invalid_assn int_assn) xb x'a *
        (hn_invalid poly_assn la l'a * hn_invalid int_assn a2' a2 *
         hn_invalid monom_assn a1' a1 *
         hn_invalid poly_assn l l' *
         hn_invalid monomial_assn xa x' *
         hn_invalid poly_assn ax px) \<Longrightarrow>\<^sub>t
        hn_ctxt (monomial_assn) xb x'a *
        hn_ctxt poly_assn
         la l'a *
        hn_ctxt poly_assn l l' *
        (hn_invalid int_assn a2' a2 *
         hn_invalid monom_assn a1' a1 *
         hn_invalid monomial_assn xa x' *
         hn_invalid poly_assn ax px)\<close>
   \<open>hn_ctxt (invalid_assn monom_assn \<times>\<^sub>a invalid_assn int_assn) xa x' *
        (hn_ctxt poly_assn l l' * hn_invalid poly_assn ax px) \<Longrightarrow>\<^sub>t
        hn_ctxt (monomial_assn) xa x' *
        hn_ctxt poly_assn l l' *
        hn_ctxt poly_assn ax px *
        emp\<close>
   by sepref_dbg_trans_step+
 
 text \<open>The refinement frameword is completely lost here when synthesizing the constants -- it does
   not understant what is pure (actually everything) and what must be destroyed.\<close>
 sepref_definition merge_coeffs_impl
   is \<open>RETURN o merge_coeffs\<close>
   :: \<open>poly_assn\<^sup>d \<rightarrow>\<^sub>a poly_assn\<close>
   supply [[goals_limit=1]]
   unfolding merge_coeffs_alt_def
     HOL_list.fold_custom_empty poly_assn_alt_def
   apply (rewrite in \<open>_\<close> annotate_assn[where A=\<open>poly_assn\<close>])
   apply sepref_dbg_preproc
   apply sepref_dbg_cons_init
   apply sepref_dbg_id
   apply sepref_dbg_monadify
   apply sepref_dbg_opt_init
   apply (rule WTF_RF | sepref_dbg_trans_step)+
   apply sepref_dbg_opt
   apply sepref_dbg_cons_solve
   apply sepref_dbg_cons_solve
   apply sepref_dbg_constraints
   done
 
 definition full_quicksort_poly where
   \<open>full_quicksort_poly = full_quicksort_ref (\<lambda>x y. x = y \<or> (x, y) \<in> term_order_rel) fst\<close>
 
 lemma down_eq_id_list_rel: \<open>\<Down>(\<langle>Id\<rangle>list_rel) x = x\<close>
   by auto
 
 definition quicksort_poly:: \<open>nat \<Rightarrow> nat \<Rightarrow> llist_polynomial \<Rightarrow> (llist_polynomial) nres\<close> where
   \<open>quicksort_poly x y  z = quicksort_ref (\<le>) fst (x, y, z)\<close>
 
 term partition_between_ref
 
 definition partition_between_poly :: \<open>nat \<Rightarrow> nat \<Rightarrow> llist_polynomial \<Rightarrow> (llist_polynomial \<times> nat) nres\<close> where
   \<open>partition_between_poly = partition_between_ref (\<le>) fst\<close>
 
 definition partition_main_poly :: \<open>nat \<Rightarrow> nat \<Rightarrow> llist_polynomial \<Rightarrow> (llist_polynomial \<times> nat) nres\<close> where
   \<open>partition_main_poly = partition_main (\<le>)  fst\<close>
 
 lemma string_list_trans:
   \<open>(xa ::char list list, ya) \<in> lexord (lexord {(x, y). x < y}) \<Longrightarrow>
   (ya, z) \<in> lexord (lexord {(x, y). x < y}) \<Longrightarrow>
     (xa, z) \<in> lexord (lexord {(x, y). x < y})\<close>
-  by (smt less_char_def char.less_trans less_than_char_def lexord_partial_trans p2rel_def)
+  by (smt (verit) less_char_def char.less_trans less_than_char_def lexord_partial_trans p2rel_def)
 
 lemma full_quicksort_sort_poly_spec:
   \<open>(full_quicksort_poly, sort_poly_spec) \<in> \<langle>Id\<rangle>list_rel \<rightarrow>\<^sub>f \<langle>\<langle>Id\<rangle>list_rel\<rangle>nres_rel\<close>
 proof -
   have xs: \<open>(xs, xs) \<in> \<langle>Id\<rangle>list_rel\<close> and \<open>\<Down>(\<langle>Id\<rangle>list_rel) x = x\<close> for x xs
     by auto
   show ?thesis
     apply (intro frefI nres_relI)
     unfolding full_quicksort_poly_def
     apply (rule full_quicksort_ref_full_quicksort[THEN fref_to_Down_curry, THEN order_trans])
     subgoal
       by (auto simp: rel2p_def var_order_rel_def p2rel_def Relation.total_on_def
         dest: string_list_trans)
     subgoal
       using total_on_lexord_less_than_char_linear[unfolded var_order_rel_def]
       apply (auto simp: rel2p_def var_order_rel_def p2rel_def Relation.total_on_def less_char_def)
       done
     subgoal by fast
     apply (rule xs)
     apply (subst down_eq_id_list_rel)
     unfolding sorted_wrt_map sort_poly_spec_def
     apply (rule full_quicksort_correct_sorted[where R = \<open>(\<lambda>x y. x = y \<or> (x, y) \<in> term_order_rel)\<close> and h = \<open>fst\<close>,
        THEN order_trans])
     subgoal
       by (auto simp: rel2p_def var_order_rel_def p2rel_def Relation.total_on_def dest: string_list_trans)
     subgoal for x y
       using total_on_lexord_less_than_char_linear[unfolded var_order_rel_def]
       apply (auto simp: rel2p_def var_order_rel_def p2rel_def Relation.total_on_def
         less_char_def)
       done
    subgoal
     by (auto simp: rel2p_def p2rel_def)
    done
 qed
 
 
 subsection \<open>Lifting to polynomials\<close>
 
 definition merge_sort_poly :: \<open>_\<close> where
 \<open>merge_sort_poly = msort (\<lambda>a b. fst a \<le> fst b)\<close>
 
 definition merge_monoms_poly :: \<open>_\<close> where
 \<open>merge_monoms_poly = msort (\<le>)\<close>
 
 definition merge_poly :: \<open>_\<close> where
 \<open>merge_poly = merge (\<lambda>a b. fst a \<le> fst b)\<close>
 
 definition merge_monoms :: \<open>_\<close> where
 \<open>merge_monoms = merge (\<le>)\<close>
 
 definition msort_poly_impl :: \<open>(String.literal list \<times> int) list \<Rightarrow> _\<close> where
 \<open>msort_poly_impl = msort (\<lambda>a b. fst a \<le> fst b)\<close>
 
 definition msort_monoms_impl :: \<open>(String.literal list) \<Rightarrow> _\<close> where
 \<open>msort_monoms_impl = msort (\<le>)\<close>
 
 lemma msort_poly_impl_alt_def:
   \<open>msort_poly_impl xs =
     (case xs of
       [] \<Rightarrow> []
      | [a] \<Rightarrow> [a]
      | [a,b] \<Rightarrow> if fst a \<le> fst b then [a,b]else [b,a]
      | xs \<Rightarrow> merge_poly
                       (msort_poly_impl (take ((length xs) div 2) xs))
                       (msort_poly_impl (drop ((length xs) div 2) xs)))\<close>
    unfolding msort_poly_impl_def
   apply (auto split: list.splits simp: merge_poly_def)
   done
 
 lemma le_term_order_rel':
   \<open>(\<le>) = (\<lambda>x y. x = y \<or>  term_order_rel' x y)\<close>
   apply (intro ext)
   apply (auto simp add: less_list_def less_eq_list_def
     lexordp_eq_conv_lexord lexordp_def)
   using term_order_rel'_alt_def_lexord term_order_rel'_def apply blast
   using term_order_rel'_alt_def_lexord term_order_rel'_def apply blast
   done
 
 fun lexord_eq where
   \<open>lexord_eq [] _ = True\<close> |
   \<open>lexord_eq (x # xs) (y # ys) = (x < y \<or> (x = y \<and> lexord_eq xs ys))\<close> |
   \<open>lexord_eq _ _ = False\<close>
 
 lemma [simp]:
   \<open>lexord_eq [] [] = True\<close>
   \<open>lexord_eq (a # b)[] = False\<close>
   \<open>lexord_eq [] (a # b) = True\<close>
   apply auto
   done
 
 lemma var_order_rel':
   \<open>(\<le>) = (\<lambda>x y. x = y \<or> (x,y) \<in> var_order_rel)\<close>
   by (intro ext)
    (auto simp add: less_list_def less_eq_list_def
     lexordp_eq_conv_lexord lexordp_def var_order_rel_def
     lexordp_conv_lexord p2rel_def)
 
 
 lemma var_order_rel'':
   \<open>(x,y) \<in> var_order_rel \<longleftrightarrow> x < y\<close>
   by (metis leD less_than_char_linear lexord_linear neq_iff var_order_rel' var_order_rel_antisym
       var_order_rel_def)
 
 lemma lexord_eq_alt_def1:
   \<open>a \<le> b = lexord_eq a b\<close> for a b :: \<open>String.literal list\<close>
   unfolding le_term_order_rel'
   apply (induction a b rule: lexord_eq.induct)
   apply (auto simp: var_order_rel'' less_eq_list_def)
   done
 
 lemma lexord_eq_alt_def2:
   \<open>(RETURN oo lexord_eq) xs ys =
      REC\<^sub>T (\<lambda>f (xs, ys).
         case (xs, ys) of
            ([], _) \<Rightarrow> RETURN True
          | (x # xs, y # ys) \<Rightarrow>
             if x < y then RETURN True
             else if x = y then f (xs, ys) else RETURN False
         | _ \<Rightarrow> RETURN False)
         (xs, ys)\<close>
   apply (subst eq_commute)
   apply (induction xs ys rule: lexord_eq.induct)
   subgoal by (subst RECT_unfold, refine_mono) auto
   subgoal by (subst RECT_unfold, refine_mono) auto
   subgoal by (subst RECT_unfold, refine_mono) auto
   done
 
 
 definition var_order' where
   [simp]: \<open>var_order' = var_order\<close>
 
 lemma var_order_rel[def_pat_rules]:
   \<open>(\<in>)$(x,y)$var_order_rel \<equiv> var_order'$x$y\<close>
   by (auto simp: p2rel_def rel2p_def)
 
 lemma var_order_rel_alt_def:
   \<open>var_order_rel = p2rel char.lexordp\<close>
   apply (auto simp: p2rel_def char.lexordp_conv_lexord var_order_rel_def)
   using char.lexordp_conv_lexord apply auto
   done
 
 lemma var_order_rel_var_order:
   \<open>(x, y) \<in> var_order_rel \<longleftrightarrow> var_order x y\<close>
   by (auto simp: rel2p_def)
 
 lemma var_order_string_le[sepref_import_param]:
   \<open>((<), var_order') \<in> string_rel \<rightarrow> string_rel \<rightarrow> bool_rel\<close>
   apply (auto intro!: frefI simp: string_rel_def String.less_literal_def
      rel2p_def linorder.lexordp_conv_lexord[OF char.linorder_axioms,
       unfolded less_eq_char_def] var_order_rel_def
       p2rel_def
       simp flip: PAC_Polynomials_Term.less_char_def)
   using char.lexordp_conv_lexord apply auto
   done
 
 lemma [sepref_import_param]:
   \<open>( (\<le>), (\<le>)) \<in> monom_rel \<rightarrow> monom_rel \<rightarrow>bool_rel\<close>
   apply (intro fun_relI)
   using list_rel_list_rel_order_iff by fastforce
 
 lemma [sepref_import_param]:
   \<open>( (<), (<)) \<in> string_rel \<rightarrow> string_rel \<rightarrow>bool_rel\<close>
 proof -
   have [iff]: \<open>ord.lexordp (<) (literal.explode a) (literal.explode aa) \<longleftrightarrow>
        List.lexordp (<) (literal.explode a) (literal.explode aa)\<close> for a aa
     apply (rule iffI)
      apply (metis PAC_Checker_Relation.less_char_def char.lexordp_conv_lexord less_list_def
         p2rel_def var_order_rel'' var_order_rel_def)
     apply (metis PAC_Checker_Relation.less_char_def char.lexordp_conv_lexord less_list_def
         p2rel_def var_order_rel'' var_order_rel_def)
     done
   show ?thesis
     unfolding string_rel_def less_literal.rep_eq less_than_char_def
       less_eq_list_def PAC_Polynomials_Term.less_char_def[symmetric]
     by (intro fun_relI)
      (auto simp: string_rel_def less_literal.rep_eq
         less_list_def char.lexordp_conv_lexord lexordp_eq_refl
         lexordp_eq_conv_lexord)
 qed
 
 
 lemma lexordp_char_char: \<open>ord_class.lexordp = char.lexordp\<close>
   unfolding char.lexordp_def ord_class.lexordp_def
   by (rule arg_cong[of _ _ lfp])
     (auto intro!: ext)
 
 lemma [sepref_import_param]:
   \<open>( (\<le>), (\<le>)) \<in> string_rel \<rightarrow> string_rel \<rightarrow>bool_rel\<close>
   unfolding string_rel_def less_eq_literal.rep_eq less_than_char_def
     less_eq_list_def PAC_Polynomials_Term.less_char_def[symmetric]
   by (intro fun_relI)
    (auto simp: string_rel_def less_eq_literal.rep_eq less_than_char_def
     less_eq_list_def char.lexordp_eq_conv_lexord lexordp_eq_refl
     lexordp_eq_conv_lexord lexordp_char_char
     simp flip: less_char_def[abs_def])
 
 sepref_register lexord_eq
 sepref_definition lexord_eq_term
   is \<open>uncurry (RETURN oo lexord_eq)\<close>
   :: \<open>monom_assn\<^sup>k *\<^sub>a monom_assn\<^sup>k \<rightarrow>\<^sub>a bool_assn\<close>
   supply[[goals_limit=1]]
   unfolding lexord_eq_alt_def2
   by sepref
 
 declare lexord_eq_term.refine[sepref_fr_rules]
 
 
 lemmas [code del] = msort_poly_impl_def msort_monoms_impl_def
 lemmas [code] =
   msort_poly_impl_def[unfolded lexord_eq_alt_def1[abs_def]]
   msort_monoms_impl_def[unfolded msort_msort2]
 
 lemma term_order_rel_trans:
   \<open>(a, aa) \<in> term_order_rel \<Longrightarrow>
        (aa, ab) \<in> term_order_rel \<Longrightarrow> (a, ab) \<in> term_order_rel\<close>
   by (metis PAC_Checker_Relation.less_char_def p2rel_def string_list_trans var_order_rel_def)
 
 lemma merge_sort_poly_sort_poly_spec:
   \<open>(RETURN o merge_sort_poly, sort_poly_spec) \<in> \<langle>Id\<rangle>list_rel \<rightarrow>\<^sub>f \<langle>\<langle>Id\<rangle>list_rel\<rangle>nres_rel\<close>
   unfolding sort_poly_spec_def merge_sort_poly_def
   apply (intro frefI nres_relI)
   using total_on_lexord_less_than_char_linear var_order_rel_def
   by (auto intro!: sorted_msort simp: sorted_wrt_map rel2p_def
     le_term_order_rel' transp_def dest: term_order_rel_trans)
 
 lemma msort_alt_def:
   \<open>RETURN o (msort f) =
      REC\<^sub>T (\<lambda>g xs.
         case xs of
           [] \<Rightarrow> RETURN []
         | [x] \<Rightarrow> RETURN [x]
         | _ \<Rightarrow> do {
            a \<leftarrow> g (take (size xs div 2) xs);
            b \<leftarrow> g (drop (size xs div 2) xs);
            RETURN (merge f a b)})\<close>
   apply (intro ext)
   unfolding comp_def
   apply (induct_tac f x rule: msort.induct)
   subgoal by (subst RECT_unfold, refine_mono) auto
   subgoal by (subst RECT_unfold, refine_mono) auto
   subgoal
     by (subst RECT_unfold, refine_mono)
-     (smt let_to_bind_conv list.simps(5) msort.simps(3))
+     (smt (verit) let_to_bind_conv list.simps(5) msort.simps(3))
   done
 
 lemma monomial_rel_order_map:
   \<open>(x, a, b) \<in> monomial_rel \<Longrightarrow>
        (y, aa, bb) \<in> monomial_rel \<Longrightarrow>
        fst x \<le> fst y \<longleftrightarrow> a \<le> aa\<close>
   apply (cases x; cases y)
   apply auto
   using list_rel_list_rel_order_iff by fastforce+
 
 
 lemma step_rewrite_pure:
   fixes K :: \<open>('olbl \<times> 'lbl) set\<close>
   shows
     \<open>pure (p2rel (\<langle>K, V, R\<rangle>pac_step_rel_raw)) = pac_step_rel_assn (pure K) (pure V) (pure R)\<close>
     \<open>monomial_assn = pure (monom_rel \<times>\<^sub>r int_rel)\<close> and
   poly_assn_list:
     \<open>poly_assn = pure (\<langle>monom_rel \<times>\<^sub>r int_rel\<rangle>list_rel)\<close>
   subgoal
     apply (intro ext)
     apply (case_tac x; case_tac xa)
     apply (auto simp: relAPP_def p2rel_def pure_def)
     done
   subgoal H
     apply (intro ext)
     apply (case_tac x; case_tac xa)
     by (simp add: list_assn_pure_conv)
   subgoal
     unfolding H
     by (simp add: list_assn_pure_conv relAPP_def)
   done
 
 lemma safe_pac_step_rel_assn[safe_constraint_rules]:
   "is_pure K \<Longrightarrow> is_pure V \<Longrightarrow> is_pure R \<Longrightarrow> is_pure (pac_step_rel_assn K V R)"
   by (auto simp: step_rewrite_pure(1)[symmetric] is_pure_conv)
 
 
 lemma merge_poly_merge_poly:
   \<open>(merge_poly, merge_poly)
    \<in> poly_rel \<rightarrow> poly_rel \<rightarrow> poly_rel\<close>
    unfolding merge_poly_def
   apply (intro fun_relI)
   subgoal for a a' aa a'a
     apply (induction \<open>(\<lambda>(a :: String.literal list \<times> int)
       (b :: String.literal list \<times> int). fst a \<le> fst b)\<close> a aa
       arbitrary: a' a'a
       rule: merge.induct)
     subgoal
       by (auto elim!: list_relE3 list_relE4 list_relE list_relE2
         simp: monomial_rel_order_map)
     subgoal
       by (auto elim!: list_relE3 list_relE)
     subgoal
       by (auto elim!: list_relE3 list_relE4 list_relE list_relE2)
     done
   done
 
 lemmas [fcomp_norm_unfold] =
   poly_assn_list[symmetric]
   step_rewrite_pure(1)
 
 lemma merge_poly_merge_poly2:
   \<open>(a, b) \<in> poly_rel \<Longrightarrow> (a', b') \<in> poly_rel \<Longrightarrow>
     (merge_poly a a', merge_poly b b') \<in> poly_rel\<close>
   using merge_poly_merge_poly
   unfolding fun_rel_def
   by auto
 
 lemma list_rel_takeD:
   \<open>(a, b) \<in> \<langle>R\<rangle>list_rel \<Longrightarrow> (n, n')\<in> Id \<Longrightarrow> (take n a, take n' b) \<in> \<langle>R\<rangle>list_rel\<close>
   by (simp add: list_rel_eq_listrel listrel_iff_nth relAPP_def)
 
 lemma list_rel_dropD:
   \<open>(a, b) \<in> \<langle>R\<rangle>list_rel \<Longrightarrow> (n, n')\<in> Id \<Longrightarrow> (drop n a, drop n' b) \<in> \<langle>R\<rangle>list_rel\<close>
   by (simp add: list_rel_eq_listrel listrel_iff_nth relAPP_def)
 
 lemma merge_sort_poly[sepref_import_param]:
   \<open>(msort_poly_impl, merge_sort_poly)
    \<in> poly_rel \<rightarrow> poly_rel\<close>
    unfolding merge_sort_poly_def msort_poly_impl_def
   apply (intro fun_relI)
   subgoal for a a'
     apply (induction \<open>(\<lambda>(a :: String.literal list \<times> int)
       (b :: String.literal list \<times> int). fst a \<le> fst b)\<close> a
       arbitrary: a'
       rule: msort.induct)
     subgoal
       by auto
     subgoal
       by (auto elim!: list_relE3 list_relE)
     subgoal premises p
       using p
       by (auto elim!: list_relE3 list_relE4 list_relE list_relE2
         simp: merge_poly_def[symmetric]
         intro!: list_rel_takeD list_rel_dropD
         intro!: merge_poly_merge_poly2 p(1)[simplified] p(2)[simplified],
         auto simp: list_rel_imp_same_length)
     done
   done
 
 
 
 lemmas [sepref_fr_rules] = merge_sort_poly[FCOMP merge_sort_poly_sort_poly_spec]
 
 sepref_definition partition_main_poly_impl
   is \<open>uncurry2 partition_main_poly\<close>
   :: \<open>nat_assn\<^sup>k *\<^sub>a nat_assn\<^sup>k *\<^sub>a poly_assn\<^sup>k \<rightarrow>\<^sub>a prod_assn poly_assn nat_assn \<close>
   unfolding partition_main_poly_def partition_main_def
     term_order_rel'_def[symmetric]
     term_order_rel'_alt_def
     le_term_order_rel'
   by sepref
 
 declare partition_main_poly_impl.refine[sepref_fr_rules]
 
 sepref_definition partition_between_poly_impl
   is \<open>uncurry2 partition_between_poly\<close>
   :: \<open>nat_assn\<^sup>k *\<^sub>a nat_assn\<^sup>k *\<^sub>a poly_assn\<^sup>k \<rightarrow>\<^sub>a prod_assn poly_assn nat_assn \<close>
   unfolding partition_between_poly_def partition_between_ref_def
     partition_main_poly_def[symmetric]
   unfolding choose_pivot3_def
     term_order_rel'_def[symmetric]
     term_order_rel'_alt_def choose_pivot_def
     lexord_eq_alt_def1
   by sepref
 
 declare partition_between_poly_impl.refine[sepref_fr_rules]
 
 sepref_definition quicksort_poly_impl
   is \<open>uncurry2 quicksort_poly\<close>
   :: \<open>nat_assn\<^sup>k *\<^sub>a nat_assn\<^sup>k *\<^sub>a poly_assn\<^sup>k \<rightarrow>\<^sub>a poly_assn\<close>
   unfolding partition_main_poly_def quicksort_ref_def quicksort_poly_def
     partition_between_poly_def[symmetric]
   by sepref
 
 lemmas [sepref_fr_rules] = quicksort_poly_impl.refine
 
 sepref_register quicksort_poly
 sepref_definition full_quicksort_poly_impl
   is \<open>full_quicksort_poly\<close>
   :: \<open>poly_assn\<^sup>k \<rightarrow>\<^sub>a poly_assn\<close>
   unfolding full_quicksort_poly_def full_quicksort_ref_def
     quicksort_poly_def[symmetric]
     le_term_order_rel'[symmetric]
     term_order_rel'_def[symmetric]
     List.null_def
   by sepref
 
 
 lemmas sort_poly_spec_hnr =
   full_quicksort_poly_impl.refine[FCOMP full_quicksort_sort_poly_spec]
 
 declare merge_coeffs_impl.refine[sepref_fr_rules]
 
 sepref_definition normalize_poly_impl
   is \<open>normalize_poly\<close>
   :: \<open>poly_assn\<^sup>k \<rightarrow>\<^sub>a poly_assn\<close>
   supply [[goals_limit=1]]
   unfolding normalize_poly_def
   by sepref
 
 declare normalize_poly_impl.refine[sepref_fr_rules]
 
 
 definition full_quicksort_vars where
   \<open>full_quicksort_vars = full_quicksort_ref (\<lambda>x y. x = y \<or> (x, y) \<in> var_order_rel) id\<close>
 
 
 definition quicksort_vars:: \<open>nat \<Rightarrow> nat \<Rightarrow> string list \<Rightarrow> (string list) nres\<close> where
   \<open>quicksort_vars x y  z = quicksort_ref (\<le>) id (x, y, z)\<close>
 
 
 definition partition_between_vars :: \<open>nat \<Rightarrow> nat \<Rightarrow> string list \<Rightarrow> (string list \<times> nat) nres\<close> where
   \<open>partition_between_vars = partition_between_ref (\<le>) id\<close>
 
 definition partition_main_vars :: \<open>nat \<Rightarrow> nat \<Rightarrow> string list \<Rightarrow> (string list \<times> nat) nres\<close> where
   \<open>partition_main_vars = partition_main (\<le>) id\<close>
 
 lemma total_on_lexord_less_than_char_linear2:
   \<open>xs \<noteq> ys \<Longrightarrow> (xs, ys) \<notin> lexord (less_than_char) \<longleftrightarrow>
        (ys, xs) \<in> lexord less_than_char\<close>
    using lexord_linear[of \<open>less_than_char\<close> xs ys]
    using lexord_linear[of \<open>less_than_char\<close>] less_than_char_linear
    apply (auto simp: Relation.total_on_def)
    using lexord_irrefl[OF irrefl_less_than_char]
      antisym_lexord[OF antisym_less_than_char irrefl_less_than_char]
    apply (auto simp: antisym_def)
    done
 
 lemma string_trans:
   \<open>(xa, ya) \<in> lexord {(x::char, y::char). x < y} \<Longrightarrow>
   (ya, z) \<in> lexord {(x::char, y::char). x < y} \<Longrightarrow>
   (xa, z) \<in> lexord {(x::char, y::char). x < y}\<close>
-  by (smt less_char_def char.less_trans less_than_char_def lexord_partial_trans p2rel_def)
+  by (smt (verit) less_char_def char.less_trans less_than_char_def lexord_partial_trans p2rel_def)
 
 lemma full_quicksort_sort_vars_spec:
   \<open>(full_quicksort_vars, sort_coeff) \<in> \<langle>Id\<rangle>list_rel \<rightarrow>\<^sub>f \<langle>\<langle>Id\<rangle>list_rel\<rangle>nres_rel\<close>
 proof -
   have xs: \<open>(xs, xs) \<in> \<langle>Id\<rangle>list_rel\<close> and \<open>\<Down>(\<langle>Id\<rangle>list_rel) x = x\<close> for x xs
     by auto
   show ?thesis
     apply (intro frefI nres_relI)
     unfolding full_quicksort_vars_def
     apply (rule full_quicksort_ref_full_quicksort[THEN fref_to_Down_curry, THEN order_trans])
     subgoal
       by (auto simp: rel2p_def var_order_rel_def p2rel_def Relation.total_on_def
         dest: string_trans)
     subgoal
       using total_on_lexord_less_than_char_linear2[unfolded var_order_rel_def]
       apply (auto simp: rel2p_def var_order_rel_def p2rel_def Relation.total_on_def less_char_def)
       done
     subgoal by fast
     apply (rule xs)
     apply (subst down_eq_id_list_rel)
     unfolding sorted_wrt_map sort_coeff_def
     apply (rule full_quicksort_correct_sorted[where R = \<open>(\<lambda>x y. x = y \<or> (x, y) \<in> var_order_rel)\<close> and h = \<open>id\<close>,
        THEN order_trans])
     subgoal
       by (auto simp: rel2p_def var_order_rel_def p2rel_def Relation.total_on_def dest: string_trans)
     subgoal for x y
       using total_on_lexord_less_than_char_linear2[unfolded var_order_rel_def]
       by (auto simp: rel2p_def var_order_rel_def p2rel_def Relation.total_on_def
         less_char_def)
    subgoal
     by (auto simp: rel2p_def p2rel_def rel2p_def[abs_def])
    done
 qed
 
 
 sepref_definition partition_main_vars_impl
   is \<open>uncurry2 partition_main_vars\<close>
   :: \<open>nat_assn\<^sup>k *\<^sub>a nat_assn\<^sup>k *\<^sub>a (monom_assn)\<^sup>k \<rightarrow>\<^sub>a prod_assn (monom_assn) nat_assn\<close>
   unfolding partition_main_vars_def partition_main_def
     var_order_rel_var_order
     var_order'_def[symmetric]
     term_order_rel'_alt_def
     le_term_order_rel'
     id_apply
     by sepref
 
 declare partition_main_vars_impl.refine[sepref_fr_rules]
 
 sepref_definition partition_between_vars_impl
   is \<open>uncurry2 partition_between_vars\<close>
   :: \<open>nat_assn\<^sup>k *\<^sub>a nat_assn\<^sup>k *\<^sub>a monom_assn\<^sup>k \<rightarrow>\<^sub>a prod_assn monom_assn nat_assn \<close>
   unfolding partition_between_vars_def partition_between_ref_def
     partition_main_vars_def[symmetric]
   unfolding choose_pivot3_def
     term_order_rel'_def[symmetric]
     term_order_rel'_alt_def choose_pivot_def
     le_term_order_rel' id_apply
   by sepref
 
 declare partition_between_vars_impl.refine[sepref_fr_rules]
 
 sepref_definition quicksort_vars_impl
   is \<open>uncurry2 quicksort_vars\<close>
   :: \<open>nat_assn\<^sup>k *\<^sub>a nat_assn\<^sup>k *\<^sub>a monom_assn\<^sup>k \<rightarrow>\<^sub>a monom_assn\<close>
   unfolding partition_main_vars_def quicksort_ref_def quicksort_vars_def
     partition_between_vars_def[symmetric]
   by sepref
 
 lemmas [sepref_fr_rules] = quicksort_vars_impl.refine
 
 sepref_register quicksort_vars
 
 
 lemma le_var_order_rel:
   \<open>(\<le>) = (\<lambda>x y. x = y \<or> (x, y) \<in> var_order_rel)\<close>
   by (intro ext)
    (auto simp add: less_list_def less_eq_list_def rel2p_def
       p2rel_def lexordp_conv_lexord p2rel_def var_order_rel_def
     lexordp_eq_conv_lexord lexordp_def)
 
 sepref_definition full_quicksort_vars_impl
   is \<open>full_quicksort_vars\<close>
   :: \<open>monom_assn\<^sup>k \<rightarrow>\<^sub>a monom_assn\<close>
   unfolding full_quicksort_vars_def full_quicksort_ref_def
     quicksort_vars_def[symmetric]
     le_var_order_rel[symmetric]
     term_order_rel'_def[symmetric]
     List.null_def
   by sepref
 
 
 lemmas sort_vars_spec_hnr =
   full_quicksort_vars_impl.refine[FCOMP full_quicksort_sort_vars_spec]
 
 lemma string_rel_order_map:
   \<open>(x, a) \<in> string_rel \<Longrightarrow>
        (y, aa) \<in> string_rel \<Longrightarrow>
        x \<le> y \<longleftrightarrow> a \<le> aa\<close>
   unfolding string_rel_def less_eq_literal.rep_eq less_than_char_def
     less_eq_list_def PAC_Polynomials_Term.less_char_def[symmetric]
   by (auto simp: string_rel_def less_eq_literal.rep_eq less_than_char_def
     less_eq_list_def char.lexordp_eq_conv_lexord lexordp_eq_refl
     lexordp_char_char lexordp_eq_conv_lexord
     simp flip: less_char_def[abs_def])
 
 lemma merge_monoms_merge_monoms:
   \<open>(merge_monoms, merge_monoms) \<in> monom_rel \<rightarrow> monom_rel \<rightarrow> monom_rel\<close>
    unfolding merge_monoms_def
   apply (intro fun_relI)
   subgoal for a a' aa a'a
     apply (induction \<open>(\<lambda>(a :: String.literal)
       (b :: String.literal). a \<le> b)\<close> a aa
       arbitrary: a' a'a
       rule: merge.induct)
     subgoal
       by (auto elim!: list_relE3 list_relE4 list_relE list_relE2
         simp: string_rel_order_map)
     subgoal
       by (auto elim!: list_relE3 list_relE)
     subgoal
       by (auto elim!: list_relE3 list_relE4 list_relE list_relE2)
     done
   done
 
 lemma merge_monoms_merge_monoms2:
   \<open>(a, b) \<in> monom_rel \<Longrightarrow> (a', b') \<in> monom_rel \<Longrightarrow>
     (merge_monoms a a', merge_monoms b b') \<in> monom_rel\<close>
   using merge_monoms_merge_monoms
   unfolding fun_rel_def merge_monoms_def
   by auto
 
 
 lemma msort_monoms_impl:
   \<open>(msort_monoms_impl, merge_monoms_poly)
    \<in> monom_rel \<rightarrow> monom_rel\<close>
    unfolding msort_monoms_impl_def merge_monoms_poly_def
   apply (intro fun_relI)
   subgoal for a a'
     apply (induction \<open>(\<lambda>(a :: String.literal)
       (b :: String.literal). a \<le> b)\<close> a
       arbitrary: a'
       rule: msort.induct)
     subgoal
       by auto
     subgoal
       by (auto elim!: list_relE3 list_relE)
     subgoal premises p
       using p
       by (auto elim!: list_relE3 list_relE4 list_relE list_relE2
         simp: merge_monoms_def[symmetric] intro!: list_rel_takeD list_rel_dropD
         intro!: merge_monoms_merge_monoms2 p(1)[simplified] p(2)[simplified])
         (simp_all add: list_rel_imp_same_length)
     done
   done
 
 lemma merge_sort_monoms_sort_monoms_spec:
   \<open>(RETURN o merge_monoms_poly, sort_coeff) \<in> \<langle>Id\<rangle>list_rel \<rightarrow>\<^sub>f \<langle>\<langle>Id\<rangle>list_rel\<rangle>nres_rel\<close>
   unfolding merge_monoms_poly_def sort_coeff_def
   by (intro frefI nres_relI)
     (auto intro!: sorted_msort simp: sorted_wrt_map rel2p_def
      le_term_order_rel' transp_def rel2p_def[abs_def]
      simp flip: le_var_order_rel)
 
 sepref_register sort_coeff
 lemma  [sepref_fr_rules]:
   \<open>(return o msort_monoms_impl, sort_coeff) \<in> monom_assn\<^sup>k \<rightarrow>\<^sub>a monom_assn\<close>
   using msort_monoms_impl[sepref_param, FCOMP merge_sort_monoms_sort_monoms_spec]
   by auto
 
 sepref_definition sort_all_coeffs_impl
   is \<open>sort_all_coeffs\<close>
   :: \<open>poly_assn\<^sup>k \<rightarrow>\<^sub>a poly_assn\<close>
   unfolding sort_all_coeffs_def
     HOL_list.fold_custom_empty
   by sepref
 
 declare sort_all_coeffs_impl.refine[sepref_fr_rules]
 
 lemma merge_coeffs0_alt_def:
   \<open>(RETURN o merge_coeffs0) p =
    REC\<^sub>T(\<lambda>f p.
      (case p of
        [] \<Rightarrow> RETURN []
      | [p] => if snd p = 0 then RETURN [] else RETURN [p]
      | ((xs, n) # (ys, m) # p) \<Rightarrow>
       (if xs = ys
        then if n + m \<noteq> 0 then f ((xs, n + m) # p) else f p
        else if n = 0 then
           do {p \<leftarrow> f ((ys, m) # p);
             RETURN p}
        else do {p \<leftarrow> f ((ys, m) # p);
             RETURN ((xs, n) # p)})))
     p\<close>
   apply (subst eq_commute)
   apply (induction p rule: merge_coeffs0.induct)
   subgoal by (subst RECT_unfold, refine_mono) auto
   subgoal by (subst RECT_unfold, refine_mono) auto
   subgoal by (subst RECT_unfold, refine_mono) (auto simp: let_to_bind_conv)
   done
 
 text \<open>Again, Sepref does not understand what is going here.\<close>
 sepref_definition merge_coeffs0_impl
   is \<open>RETURN o merge_coeffs0\<close>
   :: \<open>poly_assn\<^sup>k \<rightarrow>\<^sub>a poly_assn\<close>
   supply [[goals_limit=1]]
   unfolding merge_coeffs0_alt_def
     HOL_list.fold_custom_empty
   apply sepref_dbg_preproc
   apply sepref_dbg_cons_init
   apply sepref_dbg_id
   apply sepref_dbg_monadify
   apply sepref_dbg_opt_init
   apply (rule WTF_RF | sepref_dbg_trans_step)+
   apply sepref_dbg_opt
   apply sepref_dbg_cons_solve
   apply sepref_dbg_cons_solve
   apply sepref_dbg_constraints
   done
 
 
 declare merge_coeffs0_impl.refine[sepref_fr_rules]
 
 sepref_definition fully_normalize_poly_impl
   is \<open>full_normalize_poly\<close>
   :: \<open>poly_assn\<^sup>k \<rightarrow>\<^sub>a poly_assn\<close>
   supply [[goals_limit=1]]
   unfolding full_normalize_poly_def
   by sepref
 
 declare fully_normalize_poly_impl.refine[sepref_fr_rules]
 
 
 end
\ No newline at end of file
diff --git a/thys/PAC_Checker/PAC_Checker_Relation.thy b/thys/PAC_Checker/PAC_Checker_Relation.thy
--- a/thys/PAC_Checker/PAC_Checker_Relation.thy
+++ b/thys/PAC_Checker/PAC_Checker_Relation.thy
@@ -1,389 +1,389 @@
 (*
   File:         PAC_Checker_Relation.thy
   Author:       Mathias Fleury, Daniela Kaufmann, JKU
   Maintainer:   Mathias Fleury, JKU
 *)
 theory PAC_Checker_Relation
   imports PAC_Checker WB_Sort "Native_Word.Uint64"
 begin
 
 section \<open>Various Refinement Relations\<close>
 
 text \<open>When writing this, it was not possible to share the definition with the IsaSAT version.\<close>
 definition uint64_nat_rel :: "(uint64 \<times> nat) set" where
  \<open>uint64_nat_rel = br nat_of_uint64 (\<lambda>_. True)\<close>
 
 abbreviation uint64_nat_assn where
   \<open>uint64_nat_assn \<equiv> pure uint64_nat_rel\<close>
 
 instantiation uint32 :: hashable
 begin
 definition hashcode_uint32 :: \<open>uint32 \<Rightarrow> uint32\<close> where
   \<open>hashcode_uint32 n = n\<close>
 
 definition def_hashmap_size_uint32 :: \<open>uint32 itself \<Rightarrow> nat\<close> where
   \<open>def_hashmap_size_uint32 = (\<lambda>_. 16)\<close>
   \<comment> \<open>same as @{typ nat}\<close>
 instance
   by standard (simp add: def_hashmap_size_uint32_def)
 end
 
 instantiation uint64 :: hashable
 begin
 
 context
   includes bit_operations_syntax
 begin
 
 definition hashcode_uint64 :: \<open>uint64 \<Rightarrow> uint32\<close> where
   \<open>hashcode_uint64 n = (uint32_of_nat (nat_of_uint64 ((n) AND ((2 :: uint64)^32 -1))))\<close>
 
 end
 
 definition def_hashmap_size_uint64 :: \<open>uint64 itself \<Rightarrow> nat\<close> where
   \<open>def_hashmap_size_uint64 = (\<lambda>_. 16)\<close>
   \<comment> \<open>same as @{typ nat}\<close>
 instance
   by standard (simp add: def_hashmap_size_uint64_def)
 end
 
 lemma word_nat_of_uint64_Rep_inject[simp]: \<open>nat_of_uint64 ai = nat_of_uint64 bi \<longleftrightarrow> ai = bi\<close>
   by transfer (simp add: word_unat_eq_iff)
 
 instance uint64 :: heap
   by standard (auto simp: inj_def exI[of _ nat_of_uint64])
 
 instance uint64 :: semiring_numeral
   by standard
 
 lemma nat_of_uint64_012[simp]: \<open>nat_of_uint64 0 = 0\<close> \<open>nat_of_uint64 2 = 2\<close> \<open>nat_of_uint64 1 = 1\<close>
   by (simp_all add: nat_of_uint64.rep_eq zero_uint64.rep_eq one_uint64.rep_eq)
 
 definition uint64_of_nat_conv where
   [simp]: \<open>uint64_of_nat_conv (x :: nat) = x\<close>
 
 lemma less_upper_bintrunc_id: \<open>n < 2 ^b \<Longrightarrow> n \<ge> 0 \<Longrightarrow> take_bit b n = n\<close> for n :: int
   by (rule take_bit_int_eq_self)
 
 lemma nat_of_uint64_uint64_of_nat_id: \<open>n < 2^64 \<Longrightarrow> nat_of_uint64 (uint64_of_nat n) = n\<close>
   by transfer (simp add: take_bit_nat_eq_self unsigned_of_nat)
 
 lemma [sepref_fr_rules]:
   \<open>(return o uint64_of_nat, RETURN o uint64_of_nat_conv) \<in> [\<lambda>a. a < 2 ^64]\<^sub>a nat_assn\<^sup>k \<rightarrow> uint64_nat_assn\<close>
   by sepref_to_hoare
    (sep_auto simp: uint64_nat_rel_def br_def nat_of_uint64_uint64_of_nat_id)
 
 definition string_rel :: \<open>(String.literal \<times> string) set\<close> where
   \<open>string_rel = {(x, y). y = String.explode x}\<close>
 
 abbreviation string_assn :: \<open>string \<Rightarrow> String.literal \<Rightarrow> assn\<close> where
   \<open>string_assn \<equiv> pure string_rel\<close>
 
 lemma eq_string_eq:
   \<open>((=), (=)) \<in> string_rel \<rightarrow> string_rel \<rightarrow> bool_rel\<close>
  by (auto intro!: frefI simp: string_rel_def String.less_literal_def
     less_than_char_def rel2p_def literal.explode_inject)
 
 lemmas eq_string_eq_hnr =
    eq_string_eq[sepref_import_param]
 
 definition string2_rel :: \<open>(string \<times> string) set\<close> where
   \<open>string2_rel \<equiv> \<langle>Id\<rangle>list_rel\<close>
 
 abbreviation string2_assn :: \<open>string \<Rightarrow> string \<Rightarrow> assn\<close> where
   \<open>string2_assn \<equiv> pure string2_rel\<close>
 
 abbreviation monom_rel where
   \<open>monom_rel \<equiv> \<langle>string_rel\<rangle>list_rel\<close>
 
 abbreviation monom_assn where
   \<open>monom_assn \<equiv> list_assn string_assn\<close>
 
 abbreviation monomial_rel where
   \<open>monomial_rel \<equiv> monom_rel \<times>\<^sub>r int_rel\<close>
 
 abbreviation monomial_assn where
   \<open>monomial_assn \<equiv> monom_assn \<times>\<^sub>a int_assn\<close>
 
 abbreviation poly_rel where
   \<open>poly_rel \<equiv> \<langle>monomial_rel\<rangle>list_rel\<close>
 
 
 abbreviation poly_assn where
   \<open>poly_assn \<equiv> list_assn monomial_assn\<close>
 
 lemma poly_assn_alt_def:
   \<open>poly_assn = pure poly_rel\<close>
   by (simp add: list_assn_pure_conv)
 
 abbreviation polys_assn where
   \<open>polys_assn \<equiv> hm_fmap_assn uint64_nat_assn poly_assn\<close>
 
 lemma string_rel_string_assn:
   \<open>(\<up> ((c, a) \<in> string_rel)) = string_assn a c\<close>
   by (auto simp: pure_app_eq)
 
 lemma single_valued_string_rel:
    \<open>single_valued string_rel\<close>
    by (auto simp: single_valued_def string_rel_def)
 
 lemma IS_LEFT_UNIQUE_string_rel:
    \<open>IS_LEFT_UNIQUE string_rel\<close>
    by (auto simp: IS_LEFT_UNIQUE_def single_valued_def string_rel_def
      literal.explode_inject)
 
 lemma IS_RIGHT_UNIQUE_string_rel:
    \<open>IS_RIGHT_UNIQUE string_rel\<close>
    by (auto simp: single_valued_def string_rel_def
      literal.explode_inject)
 
 lemma single_valued_monom_rel: \<open>single_valued monom_rel\<close>
   by (rule list_rel_sv)
     (auto intro!: frefI simp: string_rel_def
     rel2p_def single_valued_def p2rel_def)
 
 lemma single_valued_monomial_rel:
   \<open>single_valued monomial_rel\<close>
   using single_valued_monom_rel
   by (auto intro!: frefI simp:
     rel2p_def single_valued_def p2rel_def)
 
 lemma single_valued_monom_rel': \<open>IS_LEFT_UNIQUE monom_rel\<close>
   unfolding IS_LEFT_UNIQUE_def inv_list_rel_eq string2_rel_def
   by (rule list_rel_sv)+
    (auto intro!: frefI simp: string_rel_def
     rel2p_def single_valued_def p2rel_def literal.explode_inject)
 
 
 lemma single_valued_monomial_rel':
   \<open>IS_LEFT_UNIQUE monomial_rel\<close>
   using single_valued_monom_rel'
   unfolding IS_LEFT_UNIQUE_def inv_list_rel_eq
   by (auto intro!: frefI simp:
     rel2p_def single_valued_def p2rel_def)
 
 lemma [safe_constraint_rules]:
   \<open>Sepref_Constraints.CONSTRAINT single_valued string_rel\<close>
   \<open>Sepref_Constraints.CONSTRAINT IS_LEFT_UNIQUE string_rel\<close>
   by (auto simp: CONSTRAINT_def single_valued_def
     string_rel_def IS_LEFT_UNIQUE_def literal.explode_inject)
 
 lemma eq_string_monom_hnr[sepref_fr_rules]:
   \<open>(uncurry (return oo (=)), uncurry (RETURN oo (=))) \<in> monom_assn\<^sup>k *\<^sub>a monom_assn\<^sup>k \<rightarrow>\<^sub>a bool_assn\<close>
   using single_valued_monom_rel' single_valued_monom_rel
   unfolding list_assn_pure_conv
   by sepref_to_hoare
    (sep_auto simp: list_assn_pure_conv string_rel_string_assn
        single_valued_def IS_LEFT_UNIQUE_def
      dest!: mod_starD
      simp flip: inv_list_rel_eq)
 
 
 definition term_order_rel' where
   [simp]: \<open>term_order_rel' x y = ((x, y) \<in> term_order_rel)\<close>
 
 lemma term_order_rel[def_pat_rules]:
   \<open>(\<in>)$(x,y)$term_order_rel \<equiv> term_order_rel'$x$y\<close>
   by auto
 
 lemma term_order_rel_alt_def:
   \<open>term_order_rel = lexord (p2rel char.lexordp)\<close>
   by (auto simp: p2rel_def char.lexordp_conv_lexord var_order_rel_def intro!: arg_cong[of _ _ lexord])
 
 
 instantiation char :: linorder
 begin
   definition less_char where [symmetric, simp]: "less_char = PAC_Polynomials_Term.less_char"
   definition less_eq_char where [symmetric, simp]: "less_eq_char = PAC_Polynomials_Term.less_eq_char"
 instance
   apply standard
   using char.linorder_axioms
   by (auto simp: class.linorder_def class.order_def class.preorder_def
        less_eq_char_def less_than_char_def class.order_axioms_def
        class.linorder_axioms_def p2rel_def less_char_def)
 end
 
 
 instantiation list :: (linorder) linorder
 begin
   definition less_list where  "less_list = lexordp (<)"
   definition less_eq_list where "less_eq_list = lexordp_eq"
 
 instance
 proof standard
   have [dest]: \<open>\<And>x y :: 'a :: linorder list. (x, y) \<in> lexord {(x, y). x < y} \<Longrightarrow>
            lexordp_eq y x \<Longrightarrow> False\<close>
     by (metis lexordp_antisym lexordp_conv_lexord lexordp_eq_conv_lexord)
   have [simp]: \<open>\<And>x y :: 'a :: linorder list. lexordp_eq x y \<Longrightarrow>
            \<not> lexordp_eq y x \<Longrightarrow>
            (x, y) \<in> lexord {(x, y). x < y}\<close>
     using lexordp_conv_lexord lexordp_conv_lexordp_eq by blast
   show
    \<open>(x < y) = Restricted_Predicates.strict (\<le>) x y\<close>
    \<open>x \<le> x\<close>
    \<open>x \<le> y \<Longrightarrow> y \<le> z \<Longrightarrow> x \<le> z\<close>
    \<open>x \<le> y \<Longrightarrow> y \<le> x \<Longrightarrow> x = y\<close>
    \<open>x \<le> y \<or> y \<le> x\<close>
    for x y z :: \<open>'a :: linorder list\<close>
     by (auto simp: less_list_def less_eq_list_def List.lexordp_def
     lexordp_conv_lexord lexordp_into_lexordp_eq lexordp_antisym
     antisym_def lexordp_eq_refl lexordp_eq_linear intro: lexordp_eq_trans
     dest: lexordp_eq_antisym)
 qed
 
 end
 
 
 lemma term_order_rel'_alt_def_lexord:
     \<open>term_order_rel' x y = ord_class.lexordp x y\<close> and
   term_order_rel'_alt_def:
     \<open>term_order_rel' x y \<longleftrightarrow> x < y\<close>
 proof -
   show
     \<open>term_order_rel' x y = ord_class.lexordp x y\<close>
     \<open>term_order_rel' x y \<longleftrightarrow> x < y\<close>
     unfolding less_than_char_of_char[symmetric, abs_def]
     by (auto simp: lexordp_conv_lexord less_eq_list_def
          less_list_def lexordp_def var_order_rel_def
          rel2p_def term_order_rel_alt_def p2rel_def)
 qed
 
 lemma list_rel_list_rel_order_iff:
   assumes \<open>(a, b) \<in> \<langle>string_rel\<rangle>list_rel\<close> \<open>(a', b') \<in> \<langle>string_rel\<rangle>list_rel\<close>
   shows \<open>a < a' \<longleftrightarrow> b < b'\<close>
 proof
   have H: \<open>(a, b) \<in> \<langle>string_rel\<rangle>list_rel \<Longrightarrow>
        (a, cs) \<in> \<langle>string_rel\<rangle>list_rel \<Longrightarrow> b = cs\<close> for cs
      using single_valued_monom_rel' IS_RIGHT_UNIQUE_string_rel
      unfolding string2_rel_def
      by (subst (asm)list_rel_sv_iff[symmetric])
        (auto simp: single_valued_def)
   assume \<open>a < a'\<close>
   then consider
     u u' where \<open>a' = a @ u # u'\<close> |
     u aa v w aaa where \<open>a = u @ aa # v\<close> \<open>a' = u @ aaa # w\<close> \<open>aa < aaa\<close>
     by (subst (asm) less_list_def)
      (auto simp: lexord_def List.lexordp_def
       list_rel_append1 list_rel_split_right_iff)
   then show \<open>b < b'\<close>
   proof cases
     case 1
     then show \<open>b < b'\<close>
       using assms
       by (subst less_list_def)
         (auto simp: lexord_def List.lexordp_def
         list_rel_append1 list_rel_split_right_iff dest: H)
   next
     case 2
     then obtain u' aa' v' w' aaa' where
        \<open>b = u' @ aa' # v'\<close> \<open>b' = u' @ aaa' # w'\<close>
        \<open>(aa, aa') \<in> string_rel\<close>
        \<open>(aaa, aaa') \<in> string_rel\<close>
       using assms
-      by (smt list_rel_append1 list_rel_split_right_iff single_valued_def single_valued_monom_rel)
+      by (smt (verit) list_rel_append1 list_rel_split_right_iff single_valued_def single_valued_monom_rel)
     with \<open>aa < aaa\<close> have \<open>aa' < aaa'\<close>
       by (auto simp: string_rel_def less_literal.rep_eq less_list_def
         lexordp_conv_lexord lexordp_def char.lexordp_conv_lexord
           simp flip: less_char_def PAC_Polynomials_Term.less_char_def)
     then show \<open>b < b'\<close>
       using \<open>b = u' @ aa' # v'\<close> \<open>b' = u' @ aaa' # w'\<close>
       by (subst less_list_def)
         (fastforce simp: lexord_def List.lexordp_def
         list_rel_append1 list_rel_split_right_iff)
   qed
 next
   have H: \<open>(a, b) \<in> \<langle>string_rel\<rangle>list_rel \<Longrightarrow>
        (a', b) \<in> \<langle>string_rel\<rangle>list_rel \<Longrightarrow> a = a'\<close> for a a' b
      using single_valued_monom_rel'
      by (auto simp: single_valued_def IS_LEFT_UNIQUE_def
        simp flip: inv_list_rel_eq)
   assume \<open>b < b'\<close>
   then consider
     u u' where \<open>b' = b @ u # u'\<close> |
     u aa v w aaa where \<open>b = u @ aa # v\<close> \<open>b' = u @ aaa # w\<close> \<open>aa < aaa\<close>
     by (subst (asm) less_list_def)
      (auto simp: lexord_def List.lexordp_def
       list_rel_append1 list_rel_split_right_iff)
   then show \<open>a < a'\<close>
   proof cases
     case 1
     then show \<open>a < a'\<close>
       using assms
       by (subst less_list_def)
         (auto simp: lexord_def List.lexordp_def
         list_rel_append2 list_rel_split_left_iff dest: H)
   next
     case 2
     then obtain u' aa' v' w' aaa' where
        \<open>a = u' @ aa' # v'\<close> \<open>a' = u' @ aaa' # w'\<close>
        \<open>(aa', aa) \<in> string_rel\<close>
        \<open>(aaa', aaa) \<in> string_rel\<close>
       using assms
       by (auto simp: lexord_def List.lexordp_def
         list_rel_append2 list_rel_split_left_iff dest: H)
     with \<open>aa < aaa\<close> have \<open>aa' < aaa'\<close>
       by (auto simp: string_rel_def less_literal.rep_eq less_list_def
         lexordp_conv_lexord lexordp_def char.lexordp_conv_lexord
           simp flip: less_char_def PAC_Polynomials_Term.less_char_def)
     then show \<open>a < a'\<close>
       using \<open>a = u' @ aa' # v'\<close> \<open>a' = u' @ aaa' # w'\<close>
       by (subst less_list_def)
         (fastforce simp: lexord_def List.lexordp_def
         list_rel_append1 list_rel_split_right_iff)
   qed
 qed
 
 
 lemma string_rel_le[sepref_import_param]:
   shows \<open>((<), (<)) \<in> \<langle>string_rel\<rangle>list_rel \<rightarrow>  \<langle>string_rel\<rangle>list_rel \<rightarrow> bool_rel\<close>
   by (auto intro!: fun_relI simp: list_rel_list_rel_order_iff)
 
 (* TODO Move *)
 lemma [sepref_import_param]:
   assumes \<open>CONSTRAINT IS_LEFT_UNIQUE R\<close>  \<open>CONSTRAINT IS_RIGHT_UNIQUE R\<close>
   shows \<open>(remove1, remove1) \<in> R \<rightarrow> \<langle>R\<rangle>list_rel \<rightarrow> \<langle>R\<rangle>list_rel\<close>
   apply (intro fun_relI)
   subgoal premises p for x y xs ys
     using p(2) p(1) assms
     by (induction xs ys rule: list_rel_induct)
       (auto simp: IS_LEFT_UNIQUE_def single_valued_def)
   done
 
 instantiation pac_step :: (heap, heap, heap) heap
 begin
 
 instance
 proof standard
   obtain f :: \<open>'a \<Rightarrow> nat\<close> where
     f: \<open>inj f\<close>
     by blast
   obtain g :: \<open>nat \<times> nat \<times> nat \<times> nat \<times> nat \<Rightarrow> nat\<close> where
     g: \<open>inj g\<close>
     by blast
   obtain h :: \<open>'b \<Rightarrow> nat\<close> where
     h: \<open>inj h\<close>
     by blast
   obtain i :: \<open>'c \<Rightarrow> nat\<close> where
     i: \<open>inj i\<close>
     by blast
   have [iff]: \<open>g a = g b \<longleftrightarrow> a = b\<close>\<open>h a'' = h b'' \<longleftrightarrow> a'' = b''\<close>  \<open>f a' = f b' \<longleftrightarrow> a' = b'\<close>
     \<open>i a''' = i b''' \<longleftrightarrow> a''' = b'''\<close>  for a b a' b' a'' b'' a''' b'''
     using f g h i unfolding inj_def by blast+
   let ?f = \<open>\<lambda>x :: ('a, 'b, 'c) pac_step.
      g (case x of
         Add a b c d \<Rightarrow>     (0, i a,  i b,  i c, f d)
       | Del a  \<Rightarrow>          (1, i a,    0,   0,   0)
       | Mult a b c d \<Rightarrow>    (2, i a, f b, i c, f d)
       | Extension a b c \<Rightarrow> (3, i a, f c, 0, h b))\<close>
    have \<open>inj ?f\<close>
      apply (auto simp: inj_def)
      apply (case_tac x; case_tac y)
      apply auto
      done
    then show \<open>\<exists>f :: ('a, 'b, 'c) pac_step \<Rightarrow> nat. inj f\<close>
      by blast
 qed
 
 end
 
 end
\ No newline at end of file
diff --git a/thys/PAC_Checker/PAC_Checker_Specification.thy b/thys/PAC_Checker/PAC_Checker_Specification.thy
--- a/thys/PAC_Checker/PAC_Checker_Specification.thy
+++ b/thys/PAC_Checker/PAC_Checker_Specification.thy
@@ -1,853 +1,853 @@
 (*
   File:         PAC_Checker_Specification.thy
   Author:       Mathias Fleury, Daniela Kaufmann, JKU
   Maintainer:   Mathias Fleury, JKU
 *)
 theory PAC_Checker_Specification
   imports PAC_Specification
     Refine_Imperative_HOL.IICF
     Finite_Map_Multiset
 begin
 
 section \<open>Checker Algorithm\<close>
 
 
 text \<open>
 
 In this level of refinement, we define the first level of the
 implementation of the checker, both with the specification as
 on ideals and the first version of the loop.
 
 \<close>
 
 subsection \<open>Specification\<close>
 
 datatype status =
   is_failed: FAILED |
   is_success: SUCCESS |
   is_found: FOUND
 
 lemma is_success_alt_def:
   \<open>is_success a \<longleftrightarrow> a = SUCCESS\<close>
   by (cases a) auto
 
 datatype ('a, 'b, 'lbls) pac_step =
   Add (pac_src1: 'lbls) (pac_src2: 'lbls) (new_id: 'lbls) (pac_res: 'a) |
   Mult (pac_src1: 'lbls) (pac_mult: 'a) (new_id: 'lbls) (pac_res: 'a) |
   Extension (new_id: 'lbls) (new_var: 'b) (pac_res: 'a) |
   Del (pac_src1: 'lbls)
 
 type_synonym  pac_state = \<open>(nat set \<times> int_poly multiset)\<close>
 
 definition PAC_checker_specification
   :: \<open>int_poly \<Rightarrow> int_poly multiset \<Rightarrow> (status \<times> nat set \<times> int_poly multiset) nres\<close>
 where
   \<open>PAC_checker_specification spec A = SPEC(\<lambda>(b, \<V>, B).
       (\<not>is_failed b \<longrightarrow> restricted_ideal_to\<^sub>I (\<Union>(vars ` set_mset A) \<union> vars spec) B \<subseteq> restricted_ideal_to\<^sub>I (\<Union>(vars ` set_mset A) \<union> vars spec) A) \<and>
       (is_found b \<longrightarrow> spec \<in> pac_ideal (set_mset A)))\<close>
 
 definition PAC_checker_specification_spec
   ::  \<open>int_poly \<Rightarrow> pac_state \<Rightarrow> (status \<times> pac_state) \<Rightarrow> bool\<close>
 where
   \<open>PAC_checker_specification_spec spec = (\<lambda>(\<V>, A) (b, B). (\<not>is_failed b \<longrightarrow> \<Union>(vars ` set_mset A) \<subseteq> \<V>) \<and>
        (is_success b \<longrightarrow> PAC_Format\<^sup>*\<^sup>* (\<V>, A) B) \<and>
        (is_found b \<longrightarrow> PAC_Format\<^sup>*\<^sup>* (\<V>, A) B \<and> spec \<in> pac_ideal (set_mset A)))\<close>
 
 abbreviation PAC_checker_specification2
   ::  \<open>int_poly \<Rightarrow> (nat set \<times> int_poly multiset) \<Rightarrow> (status \<times> (nat set \<times> int_poly multiset)) nres\<close>
 where
   \<open>PAC_checker_specification2 spec A \<equiv> SPEC(PAC_checker_specification_spec spec A)\<close>
 
 
 definition PAC_checker_specification_step_spec
   ::  \<open>pac_state \<Rightarrow> int_poly \<Rightarrow> pac_state \<Rightarrow> (status \<times> pac_state) \<Rightarrow> bool\<close>
 where
   \<open>PAC_checker_specification_step_spec = (\<lambda>(\<V>\<^sub>0, A\<^sub>0) spec (\<V>, A) (b, B).
        (is_success b \<longrightarrow>
          \<Union>(vars ` set_mset A\<^sub>0) \<subseteq> \<V>\<^sub>0 \<and>
           \<Union>(vars ` set_mset A) \<subseteq> \<V> \<and> PAC_Format\<^sup>*\<^sup>* (\<V>\<^sub>0, A\<^sub>0) (\<V>, A) \<and> PAC_Format\<^sup>*\<^sup>* (\<V>, A) B) \<and>
        (is_found b \<longrightarrow>
           \<Union>(vars ` set_mset A\<^sub>0) \<subseteq> \<V>\<^sub>0 \<and>
           \<Union>(vars ` set_mset A) \<subseteq> \<V> \<and> PAC_Format\<^sup>*\<^sup>* (\<V>\<^sub>0, A\<^sub>0) (\<V>, A) \<and> PAC_Format\<^sup>*\<^sup>* (\<V>, A) B \<and>
          spec \<in> pac_ideal (set_mset A\<^sub>0)))\<close>
 
 abbreviation PAC_checker_specification_step2
   ::  \<open>pac_state \<Rightarrow> int_poly \<Rightarrow> pac_state \<Rightarrow> (status \<times> pac_state) nres\<close>
 where
   \<open>PAC_checker_specification_step2 A\<^sub>0 spec A \<equiv> SPEC(PAC_checker_specification_step_spec A\<^sub>0  spec A)\<close>
 
 
 definition normalize_poly_spec :: \<open>_\<close> where
   \<open>normalize_poly_spec p = SPEC (\<lambda>r. p - r \<in> ideal polynomial_bool \<and> vars r \<subseteq> vars p)\<close>
 
 lemma normalize_poly_spec_alt_def:
   \<open>normalize_poly_spec p = SPEC (\<lambda>r. r - p \<in> ideal polynomial_bool \<and> vars r \<subseteq> vars p)\<close>
   unfolding normalize_poly_spec_def
   by (auto dest: ideal.span_neg)
 
 definition mult_poly_spec :: \<open>int mpoly \<Rightarrow> int mpoly \<Rightarrow> int mpoly nres\<close> where
   \<open>mult_poly_spec p q = SPEC (\<lambda>r. p * q - r \<in> ideal polynomial_bool)\<close>
 
 definition check_add :: \<open>(nat, int mpoly) fmap \<Rightarrow> nat set \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> int mpoly \<Rightarrow> bool nres\<close> where
   \<open>check_add A \<V> p q i r =
      SPEC(\<lambda>b. b \<longrightarrow> p \<in># dom_m A \<and> q \<in># dom_m A \<and> i \<notin># dom_m A \<and> vars r \<subseteq> \<V> \<and>
             the (fmlookup A p) + the (fmlookup A q) - r \<in>  ideal polynomial_bool)\<close>
 
 definition check_mult :: \<open>(nat, int mpoly) fmap \<Rightarrow> nat set \<Rightarrow> nat \<Rightarrow> int mpoly \<Rightarrow> nat \<Rightarrow> int mpoly \<Rightarrow> bool nres\<close> where
   \<open>check_mult A \<V> p q i r =
      SPEC(\<lambda>b. b \<longrightarrow> p \<in># dom_m A \<and>i \<notin># dom_m A \<and> vars q \<subseteq> \<V> \<and> vars r \<subseteq> \<V> \<and>
             the (fmlookup A p) * q - r \<in>  ideal polynomial_bool)\<close>
 
 definition check_extension :: \<open>(nat, int mpoly) fmap \<Rightarrow> nat set \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> int mpoly \<Rightarrow> (bool) nres\<close> where
   \<open>check_extension A \<V> i v p =
      SPEC(\<lambda>b. b \<longrightarrow> (i \<notin># dom_m A \<and>
      (v \<notin> \<V> \<and>
            (p+Var v)\<^sup>2 - (p+Var v) \<in> ideal polynomial_bool \<and>
             vars (p+Var v) \<subseteq> \<V>)))\<close>
 
 fun merge_status where
   \<open>merge_status (FAILED) _ = FAILED\<close> |
   \<open>merge_status _ (FAILED) = FAILED\<close> |
   \<open>merge_status FOUND _ = FOUND\<close> |
   \<open>merge_status _ FOUND = FOUND\<close> |
   \<open>merge_status _ _ = SUCCESS\<close>
 
 type_synonym fpac_step = \<open>nat set \<times> (nat, int_poly) fmap\<close>
 
 definition check_del :: \<open>(nat, int mpoly) fmap \<Rightarrow> nat \<Rightarrow> bool nres\<close> where
   \<open>check_del A p =
      SPEC(\<lambda>b. b \<longrightarrow> True)\<close>
 
 
 subsection \<open>Algorithm\<close>
 
 definition PAC_checker_step
   ::  \<open>int_poly \<Rightarrow> (status \<times> fpac_step) \<Rightarrow> (int_poly, nat, nat) pac_step \<Rightarrow>
     (status \<times> fpac_step) nres\<close>
 where
   \<open>PAC_checker_step = (\<lambda>spec (stat, (\<V>, A)) st. case st of
      Add _ _ _ _ \<Rightarrow>
        do {
          r \<leftarrow> normalize_poly_spec (pac_res st);
         eq \<leftarrow> check_add A \<V> (pac_src1 st) (pac_src2 st) (new_id st) r;
         st' \<leftarrow> SPEC(\<lambda>st'. (\<not>is_failed st' \<and> is_found st' \<longrightarrow> r - spec \<in> ideal polynomial_bool));
         if eq
         then RETURN (merge_status stat st',
           \<V>, fmupd (new_id st) r A)
         else RETURN (FAILED, (\<V>, A))
    }
    | Del _ \<Rightarrow>
        do {
         eq \<leftarrow> check_del A (pac_src1 st);
         if eq
         then RETURN (stat, (\<V>, fmdrop (pac_src1 st) A))
         else RETURN (FAILED, (\<V>, A))
    }
    | Mult _ _ _ _ \<Rightarrow>
        do {
          r \<leftarrow> normalize_poly_spec (pac_res st);
          q \<leftarrow> normalize_poly_spec (pac_mult st);
         eq \<leftarrow> check_mult A \<V> (pac_src1 st) q (new_id st) r;
         st' \<leftarrow> SPEC(\<lambda>st'. (\<not>is_failed st' \<and> is_found st' \<longrightarrow> r - spec \<in> ideal polynomial_bool));
         if eq
         then RETURN (merge_status stat st',
           \<V>, fmupd (new_id st) r A)
         else RETURN (FAILED, (\<V>, A))
    }
    | Extension _ _ _ \<Rightarrow>
        do {
          r \<leftarrow> normalize_poly_spec (pac_res st - Var (new_var st));
         (eq) \<leftarrow> check_extension A \<V> (new_id st) (new_var st) r;
         if eq
         then do {
          RETURN (stat,
           insert (new_var st) \<V>, fmupd (new_id st) (r) A)}
         else RETURN (FAILED, (\<V>, A))
    }
  )\<close>
 
 definition polys_rel :: \<open>((nat, int mpoly)fmap \<times> _) set\<close> where
 \<open>polys_rel = {(A, B). B = (ran_m A)}\<close>
 
 definition polys_rel_full :: \<open>((nat set \<times> (nat, int mpoly)fmap) \<times> _) set\<close> where
   \<open>polys_rel_full = {((\<V>, A), (\<V>' , B)). (A, B) \<in> polys_rel \<and> \<V> = \<V>'}\<close>
 
 lemma polys_rel_update_remove:
   \<open>x13 \<notin>#dom_m A \<Longrightarrow> x11 \<in># dom_m A \<Longrightarrow> x12 \<in># dom_m A \<Longrightarrow> x11 \<noteq> x12 \<Longrightarrow> (A,B) \<in> polys_rel \<Longrightarrow>
    (fmupd x13 r (fmdrop x11 (fmdrop x12 A)),
         add_mset r B - {#the (fmlookup A x11), the (fmlookup A x12)#})
        \<in> polys_rel\<close>
   \<open>x13 \<notin>#dom_m A \<Longrightarrow> x11 \<in># dom_m A \<Longrightarrow> (A,B) \<in> polys_rel \<Longrightarrow>
    (fmupd x13 r (fmdrop x11 A),add_mset r B - {#the (fmlookup A x11)#})
        \<in> polys_rel\<close>
   \<open>x13 \<notin>#dom_m A \<Longrightarrow> (A,B) \<in> polys_rel \<Longrightarrow>
    (fmupd x13 r A, add_mset r B) \<in> polys_rel\<close>
   \<open>x13 \<in>#dom_m A \<Longrightarrow> (A,B) \<in> polys_rel \<Longrightarrow>
    (fmdrop x13 A, remove1_mset (the (fmlookup A x13)) B) \<in> polys_rel\<close>
   using distinct_mset_dom[of A]
   apply (auto simp: polys_rel_def ran_m_mapsto_upd ran_m_mapsto_upd_notin
     ran_m_fmdrop)
   apply (subst ran_m_mapsto_upd_notin)
   apply (auto dest: in_diffD dest!: multi_member_split simp: ran_m_fmdrop ran_m_fmdrop_If distinct_mset_remove1_All ran_m_def
       add_mset_eq_add_mset removeAll_notin
     split: if_splits intro!: image_mset_cong)
   done
 
 lemma polys_rel_in_dom_inD:
   \<open>(A, B) \<in> polys_rel \<Longrightarrow>
     x12 \<in># dom_m A \<Longrightarrow>
     the (fmlookup A x12) \<in># B\<close>
   by (auto simp: polys_rel_def)
 
 lemma PAC_Format_add_and_remove:
   \<open>r - x14 \<in> More_Modules.ideal polynomial_bool \<Longrightarrow>
        (A, B) \<in> polys_rel \<Longrightarrow>
        x12 \<in># dom_m A \<Longrightarrow>
        x13 \<notin># dom_m A \<Longrightarrow>
        vars r \<subseteq> \<V> \<Longrightarrow>
        2 * the (fmlookup A x12) - r \<in> More_Modules.ideal polynomial_bool \<Longrightarrow>
        PAC_Format\<^sup>*\<^sup>* (\<V>, B) (\<V>, remove1_mset (the (fmlookup A x12)) (add_mset r B))\<close>
    \<open>r - x14 \<in> More_Modules.ideal polynomial_bool \<Longrightarrow>
        (A, B) \<in> polys_rel \<Longrightarrow>
        the (fmlookup A x11) + the (fmlookup A x12) - r \<in> More_Modules.ideal polynomial_bool \<Longrightarrow>
        x11 \<in># dom_m A \<Longrightarrow>
        x12 \<in># dom_m A \<Longrightarrow>
        vars r \<subseteq> \<V> \<Longrightarrow>
        PAC_Format\<^sup>*\<^sup>* (\<V>, B) (\<V>, add_mset r B)\<close>
    \<open>r - x14 \<in> More_Modules.ideal polynomial_bool \<Longrightarrow>
        (A, B) \<in> polys_rel \<Longrightarrow>
        x11 \<in># dom_m A \<Longrightarrow>
        x12 \<in># dom_m A \<Longrightarrow>
        the (fmlookup A x11) + the (fmlookup A x12) - r \<in> More_Modules.ideal polynomial_bool \<Longrightarrow>
        vars r \<subseteq> \<V> \<Longrightarrow>
        x11 \<noteq> x12 \<Longrightarrow>
        PAC_Format\<^sup>*\<^sup>* (\<V>, B)
         (\<V>, add_mset r B - {#the (fmlookup A x11), the (fmlookup A x12)#})\<close>
    \<open>(A, B) \<in> polys_rel \<Longrightarrow>
        r - x34 \<in> More_Modules.ideal polynomial_bool \<Longrightarrow>
        x11 \<in># dom_m A \<Longrightarrow>
        the (fmlookup A x11) * x32 - r \<in> More_Modules.ideal polynomial_bool \<Longrightarrow>
        vars x32 \<subseteq> \<V> \<Longrightarrow>
        vars r \<subseteq> \<V> \<Longrightarrow>
        PAC_Format\<^sup>*\<^sup>* (\<V>, B) (\<V>, add_mset r B)\<close>
    \<open>(A, B) \<in> polys_rel \<Longrightarrow>
        r - x34 \<in> More_Modules.ideal polynomial_bool \<Longrightarrow>
        x11 \<in># dom_m A \<Longrightarrow>
        the (fmlookup A x11) * x32 - r \<in> More_Modules.ideal polynomial_bool \<Longrightarrow>
        vars x32 \<subseteq> \<V> \<Longrightarrow>
        vars r \<subseteq> \<V> \<Longrightarrow>
        PAC_Format\<^sup>*\<^sup>* (\<V>, B) (\<V>, remove1_mset (the (fmlookup A x11)) (add_mset r B))\<close>
   \<open>(A, B) \<in> polys_rel \<Longrightarrow>
        x12 \<in># dom_m A \<Longrightarrow>
        PAC_Format\<^sup>*\<^sup>* (\<V>, B) (\<V>, remove1_mset (the (fmlookup A x12)) B)\<close>
    \<open>(A, B) \<in> polys_rel \<Longrightarrow>
        (p' + Var x)\<^sup>2 - (p' + Var x) \<in> ideal polynomial_bool \<Longrightarrow>
        x \<notin> \<V> \<Longrightarrow>
        x \<notin> vars(p' + Var x) \<Longrightarrow>
        vars(p' + Var x) \<subseteq> \<V> \<Longrightarrow>
        PAC_Format\<^sup>*\<^sup>* (\<V>, B)
          (insert x \<V>, add_mset p' B)\<close>
    subgoal
      apply (rule converse_rtranclp_into_rtranclp)
      apply (rule PAC_Format.add[of \<open>the (fmlookup A x12)\<close> B \<open>the (fmlookup A x12)\<close>])
      apply (auto dest: polys_rel_in_dom_inD)
      apply (rule converse_rtranclp_into_rtranclp)
      apply (rule PAC_Format.del[of \<open>the (fmlookup A x12)\<close>])
      apply (auto dest: polys_rel_in_dom_inD)
      done
   subgoal H2
     apply (rule converse_rtranclp_into_rtranclp)
     apply (rule PAC_Format.add[of \<open>the (fmlookup A x11)\<close> B \<open>the (fmlookup A x12)\<close>])
     apply (auto dest: polys_rel_in_dom_inD)
     done
   subgoal
     apply (rule rtranclp_trans)
     apply (rule H2; assumption)
     apply (rule converse_rtranclp_into_rtranclp)
     apply (rule PAC_Format.del[of \<open>the (fmlookup A x12)\<close>])
     apply (auto dest: polys_rel_in_dom_inD)
     apply (rule converse_rtranclp_into_rtranclp)
     apply (rule PAC_Format.del[of \<open>the (fmlookup A x11)\<close>])
     apply (auto dest: polys_rel_in_dom_inD)
     apply (auto simp: polys_rel_def ran_m_def add_mset_eq_add_mset dest!: multi_member_split)
     done
  subgoal H2
     apply (rule converse_rtranclp_into_rtranclp)
     apply (rule PAC_Format.mult[of \<open>the (fmlookup A x11)\<close> B \<open>x32\<close> r])
     apply (auto dest: polys_rel_in_dom_inD)
     done
   subgoal
     apply (rule rtranclp_trans)
     apply (rule H2; assumption)
     apply (rule converse_rtranclp_into_rtranclp)
     apply (rule PAC_Format.del[of \<open>the (fmlookup A x11)\<close>])
     apply (auto dest: polys_rel_in_dom_inD)
     done
   subgoal
     apply (rule converse_rtranclp_into_rtranclp)
     apply (rule PAC_Format.del[of \<open>the (fmlookup A x12)\<close> B])
     apply (auto dest: polys_rel_in_dom_inD)
     done
   subgoal
     apply (rule converse_rtranclp_into_rtranclp)
     apply (rule PAC_Format.extend_pos[of \<open>p' + Var x\<close> _ x])
     using coeff_monomila_in_varsD[of \<open>p' - Var x\<close> x]
     apply (auto dest: polys_rel_in_dom_inD simp: vars_in_right_only vars_subst_in_left_only)
     apply (subgoal_tac \<open>\<V> \<union> {x' \<in> vars (p'). x' \<notin> \<V>} = insert x \<V>\<close>)
     apply simp
     using coeff_monomila_in_varsD[of p' x]
     apply (auto dest: vars_add_Var_subset vars_minus_Var_subset polys_rel_in_dom_inD simp: vars_subst_in_left_only_iff)
     using vars_in_right_only vars_subst_in_left_only by force
   done
 
 
 abbreviation status_rel :: \<open>(status \<times> status) set\<close> where
   \<open>status_rel \<equiv> Id\<close>
 
 lemma is_merge_status[simp]:
   \<open>is_failed (merge_status a st') \<longleftrightarrow> is_failed a \<or> is_failed st'\<close>
   \<open>is_found (merge_status a st') \<longleftrightarrow> \<not>is_failed a \<and> \<not>is_failed st' \<and> (is_found a \<or> is_found st')\<close>
   \<open>is_success (merge_status a st') \<longleftrightarrow> (is_success a \<and> is_success st')\<close>
   by (cases a; cases st'; auto; fail)+
 
 lemma status_rel_merge_status:
   \<open>(merge_status a b, SUCCESS) \<notin> status_rel \<longleftrightarrow>
     (a = FAILED) \<or> (b = FAILED) \<or>
     a = FOUND \<or> (b = FOUND)\<close>
   by (cases a; cases b; auto)
 
 lemma Ex_status_iff:
   \<open>(\<exists>a. P a) \<longleftrightarrow> P SUCCESS \<or> P FOUND \<or> (P (FAILED))\<close>
   apply auto
   apply (case_tac a; auto)
   done
 
 lemma is_failed_alt_def:
   \<open>is_failed st' \<longleftrightarrow> \<not>is_success st' \<and> \<not>is_found st'\<close>
   by (cases st') auto
 
 lemma merge_status_eq_iff[simp]:
   \<open>merge_status a SUCCESS = SUCCESS \<longleftrightarrow> a = SUCCESS\<close>
   \<open>merge_status a SUCCESS = FOUND \<longleftrightarrow> a = FOUND\<close>
   \<open>merge_status SUCCESS a = SUCCESS \<longleftrightarrow> a = SUCCESS\<close>
   \<open>merge_status SUCCESS a = FOUND \<longleftrightarrow> a = FOUND\<close>
   \<open>merge_status SUCCESS a = FAILED \<longleftrightarrow> a = FAILED\<close>
   \<open>merge_status a SUCCESS = FAILED \<longleftrightarrow> a = FAILED\<close>
   \<open>merge_status FOUND a = FAILED \<longleftrightarrow> a = FAILED\<close>
   \<open>merge_status a FOUND = FAILED \<longleftrightarrow> a = FAILED\<close>
   \<open>merge_status a FOUND = SUCCESS \<longleftrightarrow> False\<close>
   \<open>merge_status a b = FOUND \<longleftrightarrow> (a = FOUND \<or> b = FOUND) \<and> (a \<noteq> FAILED \<and> b \<noteq> FAILED)\<close>
   apply (cases a; auto; fail)+
   apply (cases a; cases b; auto; fail)+
   done
 
 lemma fmdrop_irrelevant: \<open>x11 \<notin># dom_m A \<Longrightarrow> fmdrop x11 A = A\<close>
   by (simp add: fmap_ext in_dom_m_lookup_iff)
 
 lemma PAC_checker_step_PAC_checker_specification2:
   fixes a :: \<open>status\<close>
   assumes AB: \<open>((\<V>, A),(\<V>\<^sub>B, B)) \<in> polys_rel_full\<close> and
     \<open>\<not>is_failed a\<close> and
     [simp,intro]: \<open>a = FOUND \<Longrightarrow> spec \<in> pac_ideal (set_mset A\<^sub>0)\<close> and
     A\<^sub>0B: \<open>PAC_Format\<^sup>*\<^sup>* (\<V>\<^sub>0, A\<^sub>0) (\<V>, B)\<close> and
     spec\<^sub>0: \<open>vars spec \<subseteq> \<V>\<^sub>0\<close>  and
     vars_A\<^sub>0: \<open>\<Union> (vars ` set_mset A\<^sub>0) \<subseteq> \<V>\<^sub>0\<close>
   shows \<open>PAC_checker_step spec (a, (\<V>, A)) st \<le> \<Down> (status_rel \<times>\<^sub>r polys_rel_full) (PAC_checker_specification_step2 (\<V>\<^sub>0, A\<^sub>0) spec (\<V>, B))\<close>
 proof -
   have
     \<open>\<V>\<^sub>B = \<V>\<close>and
     [simp, intro]:\<open>(A, B) \<in> polys_rel\<close>
     using AB
     by (auto simp: polys_rel_full_def)
   have H0: \<open>2 * the (fmlookup A x12) - r \<in> More_Modules.ideal polynomial_bool \<Longrightarrow>
           r \<in> pac_ideal
                 (insert (the (fmlookup A x12))
                   ((\<lambda>x. the (fmlookup A x)) ` set_mset Aa))\<close> for x12 r Aa
     by (metis (no_types, lifting) ab_semigroup_mult_class.mult.commute 
          diff_in_polynomial_bool_pac_idealI
        ideal.span_base pac_idealI3 set_image_mset set_mset_add_mset_insert union_single_eq_member)+
   then have H0': \<open>\<And>Aa. 2 * the (fmlookup A x12) - r \<in> More_Modules.ideal polynomial_bool \<Longrightarrow>
           r - spec \<in> More_Modules.ideal polynomial_bool \<Longrightarrow>
           spec \<in> pac_ideal (insert (the (fmlookup A x12)) ((\<lambda>x. the (fmlookup A x)) ` set_mset Aa))\<close>
     for r x12
     by (metis (no_types, lifting) diff_in_polynomial_bool_pac_idealI)
 
   have H1: \<open> x12 \<in># dom_m A \<Longrightarrow>
        2 * the (fmlookup A x12) - r \<in> More_Modules.ideal polynomial_bool \<Longrightarrow>
        r - spec \<in> More_Modules.ideal polynomial_bool \<Longrightarrow>
        vars spec \<subseteq> vars r \<Longrightarrow>
        spec \<in> pac_ideal (set_mset B)\<close> for x12 r
      using \<open>(A,B) \<in> polys_rel\<close>
       ideal.span_add[OF ideal.span_add[OF ideal.span_neg ideal.span_neg,
          of \<open>the (fmlookup A x12)\<close> _  \<open>the (fmlookup A x12)\<close>],
       of \<open>set_mset B \<union> polynomial_bool\<close> \<open>2 * the (fmlookup A x12) - r\<close>]
      unfolding polys_rel_def
      by (auto dest!: multi_member_split simp: ran_m_def 
          intro: H0')
    have H2': \<open>the (fmlookup A x11) + the (fmlookup A x12) - r \<in> More_Modules.ideal polynomial_bool \<Longrightarrow>
        B = add_mset (the (fmlookup A x11)) {#the (fmlookup A x). x \<in># Aa#} \<Longrightarrow>
        (the (fmlookup A x11) + the (fmlookup A x12) - r
         \<in> More_Modules.ideal
             (insert (the (fmlookup A x11))
               ((\<lambda>x. the (fmlookup A x)) ` set_mset Aa \<union> polynomial_bool)) \<Longrightarrow>
         - r
         \<in> More_Modules.ideal
             (insert (the (fmlookup A x11))
               ((\<lambda>x. the (fmlookup A x)) ` set_mset Aa \<union> polynomial_bool))) \<Longrightarrow>
        r \<in> pac_ideal (insert (the (fmlookup A x11)) ((\<lambda>x. the (fmlookup A x)) ` set_mset Aa))\<close>
      for r x12 x11 A Aa
      by (metis (mono_tags, lifting) Un_insert_left diff_diff_eq2 diff_in_polynomial_bool_pac_idealI diff_zero
        ideal.span_diff ideal.span_neg minus_diff_eq pac_idealI1 pac_ideal_def set_image_mset
        set_mset_add_mset_insert union_single_eq_member)
    have H2: \<open>x11 \<in># dom_m A \<Longrightarrow>
        x12 \<in># dom_m A \<Longrightarrow>
        the (fmlookup A x11) + the (fmlookup A x12) - r
        \<in> More_Modules.ideal polynomial_bool \<Longrightarrow>
        r - spec \<in> More_Modules.ideal polynomial_bool \<Longrightarrow>
        spec \<in> pac_ideal (set_mset B)\<close>  for x12 r x11
      using \<open>(A,B) \<in> polys_rel\<close>
       ideal.span_add[OF ideal.span_add[OF ideal.span_neg ideal.span_neg,
          of \<open>the (fmlookup A x11)\<close> _  \<open>the (fmlookup A x12)\<close>],
       of \<open>set_mset B \<union> polynomial_bool\<close> \<open>the (fmlookup A x11) + the (fmlookup A x12) - r\<close>]
      unfolding polys_rel_def
      by (subgoal_tac \<open>r \<in> pac_ideal (set_mset B)\<close>)
        (auto dest!: multi_member_split simp: ran_m_def ideal.span_base 
          intro: diff_in_polynomial_bool_pac_idealI simp: H2')
 
    have H3': \<open>the (fmlookup A x12) * q - r \<in> More_Modules.ideal polynomial_bool \<Longrightarrow>
           r - spec \<in> More_Modules.ideal polynomial_bool \<Longrightarrow>
           r \<in> pac_ideal (insert (the (fmlookup A x12)) ((\<lambda>x. the (fmlookup A x)) ` set_mset Aa))\<close>
      for Aa x12 r q
      by (metis (no_types, lifting) ab_semigroup_mult_class.mult.commute diff_in_polynomial_bool_pac_idealI
        ideal.span_base pac_idealI3 set_image_mset set_mset_add_mset_insert union_single_eq_member)
 
   have H3: \<open>x12 \<in># dom_m A \<Longrightarrow>
        the (fmlookup A x12) * q - r \<in> More_Modules.ideal polynomial_bool \<Longrightarrow>
        r - spec \<in> More_Modules.ideal polynomial_bool \<Longrightarrow>
        spec \<in> pac_ideal (set_mset B)\<close> for x12 r q
      using \<open>(A,B) \<in> polys_rel\<close>
       ideal.span_add[OF ideal.span_add[OF ideal.span_neg ideal.span_neg,
          of \<open>the (fmlookup A x12)\<close> _  \<open>the (fmlookup A x12)\<close>],
       of \<open>set_mset B \<union> polynomial_bool\<close> \<open>2 * the (fmlookup A x12) - r\<close>]
      unfolding polys_rel_def
      by (subgoal_tac \<open>r \<in> pac_ideal (set_mset B)\<close>)
        (auto dest!: multi_member_split simp: ran_m_def H3'
          intro: diff_in_polynomial_bool_pac_idealI)
 
   have [intro]: \<open>spec \<in> pac_ideal (set_mset B) \<Longrightarrow> spec \<in> pac_ideal (set_mset A\<^sub>0)\<close> and
     vars_B: \<open>\<Union> (vars ` set_mset B) \<subseteq> \<V>\<close>and
     vars_B: \<open>\<Union> (vars ` set_mset (ran_m A)) \<subseteq> \<V>\<close>
     using rtranclp_PAC_Format_subset_ideal[OF A\<^sub>0B  vars_A\<^sub>0] spec\<^sub>0 \<open>(A, B) \<in> polys_rel\<close>[unfolded polys_rel_def, simplified]
-    by (smt in_mono mem_Collect_eq restricted_ideal_to_def)+
+    by (smt (verit) in_mono mem_Collect_eq restricted_ideal_to_def)+
 
   have eq_successI: \<open>st' \<noteq> FAILED \<Longrightarrow>
        st' \<noteq> FOUND \<Longrightarrow> st' = SUCCESS\<close> for st'
     by (cases st') auto
   have vars_diff_inv: \<open>vars (Var x2 - r) = vars (r - Var x2 :: int mpoly)\<close> for x2 r
     using vars_uminus[of \<open>Var x2 - r\<close>]
     by (auto simp del: vars_uminus)
   have vars_add_inv: \<open>vars (Var x2 + r) = vars (r + Var x2 :: int mpoly)\<close> for x2 r
     unfolding add.commute[of \<open>Var x2\<close> r] ..
 
   have [iff]: \<open>a \<noteq> FAILED\<close> and
     [intro]: \<open>a \<noteq> SUCCESS \<Longrightarrow> a = FOUND\<close> and
     [simp]: \<open>merge_status a FOUND = FOUND\<close>
     using assms(2) by (cases a; auto)+
   note [[goals_limit=1]]
   show ?thesis
     unfolding PAC_checker_step_def PAC_checker_specification_step_spec_def
       normalize_poly_spec_alt_def check_mult_def check_add_def
       check_extension_def polys_rel_full_def
     apply (cases st)
     apply clarsimp_all
     subgoal for x11 x12 x13 x14
       apply (refine_vcg lhs_step_If)
       subgoal for r eqa st'
         using assms vars_B apply -
         apply (rule RETURN_SPEC_refine)
         apply (rule_tac x = \<open>(merge_status a st',\<V>,add_mset r B)\<close> in exI)
         by (auto simp: polys_rel_update_remove ran_m_mapsto_upd_notin
           intro: PAC_Format_add_and_remove H2 dest: rtranclp_PAC_Format_subset_ideal)
       subgoal
         by (rule RETURN_SPEC_refine)
          (auto simp: Ex_status_iff dest: rtranclp_PAC_Format_subset_ideal)
       done
     subgoal for x11 x12 x13 x14
       apply (refine_vcg lhs_step_If)
       subgoal for r q eqa st'
         using assms vars_B apply -
         apply (rule RETURN_SPEC_refine)
         apply (rule_tac x = \<open>(merge_status a st',\<V>,add_mset r B)\<close> in exI)
         by (auto intro: polys_rel_update_remove intro: PAC_Format_add_and_remove(3-) H3
            dest: rtranclp_PAC_Format_subset_ideal)
       subgoal
         by (rule RETURN_SPEC_refine)
           (auto simp: Ex_status_iff)
       done
     subgoal for x31 x32 x34
       apply (refine_vcg lhs_step_If)
       subgoal for r x
         using assms vars_B apply -
         apply (rule RETURN_SPEC_refine)
         apply (rule_tac x = \<open>(a,insert x32 \<V>, add_mset r B)\<close> in exI)
         apply (auto simp: intro!: polys_rel_update_remove PAC_Format_add_and_remove(5-)
            dest: rtranclp_PAC_Format_subset_ideal)
         done
       subgoal
         by (rule RETURN_SPEC_refine)
           (auto simp: Ex_status_iff)
       done
     subgoal for x11
       unfolding check_del_def
       apply (refine_vcg lhs_step_If)
       subgoal for eq
         using assms vars_B apply -
         apply (rule RETURN_SPEC_refine)
         apply (cases \<open>x11 \<in># dom_m A\<close>)
         subgoal
           apply (rule_tac x = \<open>(a,\<V>, remove1_mset (the (fmlookup A x11)) B)\<close> in exI)
           apply (auto simp: polys_rel_update_remove PAC_Format_add_and_remove
                is_failed_def is_success_def is_found_def
             dest!: eq_successI
             split: if_splits
             dest: rtranclp_PAC_Format_subset_ideal
             intro: PAC_Format_add_and_remove H3)
           done
         subgoal
           apply (rule_tac x = \<open>(a,\<V>, B)\<close> in exI)
           apply (auto simp: fmdrop_irrelevant
                is_failed_def is_success_def is_found_def
             dest!: eq_successI
             split: if_splits
             dest: rtranclp_PAC_Format_subset_ideal
             intro: PAC_Format_add_and_remove)
           done
         done
       subgoal
         by (rule RETURN_SPEC_refine)
           (auto simp: Ex_status_iff)
       done
     done
 qed
 
 
 definition PAC_checker
   :: \<open>int_poly \<Rightarrow> fpac_step \<Rightarrow> status \<Rightarrow> (int_poly, nat, nat) pac_step list \<Rightarrow>
     (status \<times> fpac_step) nres\<close>
 where
   \<open>PAC_checker spec A b st = do {
     (S, _) \<leftarrow> WHILE\<^sub>T
        (\<lambda>((b :: status, A :: fpac_step), st). \<not>is_failed b \<and> st \<noteq> [])
        (\<lambda>((bA), st). do {
           ASSERT(st \<noteq> []);
           S \<leftarrow> PAC_checker_step spec (bA) (hd st);
           RETURN (S, tl st)
         })
       ((b, A), st);
     RETURN S
   }\<close>
 
 
 lemma PAC_checker_specification_spec_trans:
   \<open>PAC_checker_specification_spec spec A (st, x2) \<Longrightarrow>
     PAC_checker_specification_step_spec A spec x2 (st', x1a) \<Longrightarrow>
     PAC_checker_specification_spec spec A (st', x1a)\<close>
  unfolding PAC_checker_specification_spec_def
    PAC_checker_specification_step_spec_def
  apply auto
 using is_failed_alt_def apply blast+
 done
 
 lemma RES_SPEC_eq:
   \<open>RES \<Phi> = SPEC(\<lambda>P. P \<in> \<Phi>)\<close>
   by auto
 
 lemma is_failed_is_success_completeD:
   \<open>\<not> is_failed x \<Longrightarrow> \<not>is_success x \<Longrightarrow> is_found x\<close>
   by (cases x) auto
 
 lemma PAC_checker_PAC_checker_specification2:
   \<open>(A, B) \<in>  polys_rel_full \<Longrightarrow>
     \<not>is_failed a \<Longrightarrow>
     (a = FOUND \<Longrightarrow> spec \<in> pac_ideal (set_mset (snd B))) \<Longrightarrow>
     \<Union>(vars ` set_mset (ran_m (snd A))) \<subseteq> fst B \<Longrightarrow>
     vars spec \<subseteq> fst B \<Longrightarrow>
   PAC_checker spec A a st \<le> \<Down> (status_rel \<times>\<^sub>r polys_rel_full) (PAC_checker_specification2 spec B)\<close>
   unfolding PAC_checker_def conc_fun_RES
   apply (subst RES_SPEC_eq)
   apply (refine_vcg WHILET_rule[where
       I = \<open>\<lambda>((bB), st). bB \<in> (status_rel \<times>\<^sub>r polys_rel_full)\<inverse> ``
                       Collect (PAC_checker_specification_spec spec B)\<close>
     and R = \<open>measure (\<lambda>(_, st).  Suc (length st))\<close>])
   subgoal by auto
   subgoal apply (auto simp: PAC_checker_specification_spec_def)
     apply (cases B; cases A)
     apply (auto simp:polys_rel_def polys_rel_full_def Image_iff)
     done
   subgoal by auto
   subgoal
     apply auto
     apply (rule
      PAC_checker_step_PAC_checker_specification2[of _ _ _ _ _ _ _ \<open>fst B\<close>, THEN order_trans])
      apply assumption
      apply assumption
      apply (auto intro: PAC_checker_specification_spec_trans simp: conc_fun_RES)
      apply (auto simp: PAC_checker_specification_spec_def polys_rel_full_def polys_rel_def
        dest: PAC_Format_subset_ideal
        dest: is_failed_is_success_completeD; fail)+
     by (auto simp: Image_iff intro: PAC_checker_specification_spec_trans
         simp: polys_rel_def polys_rel_full_def)
   subgoal
     by auto
   done
 
 definition remap_polys_polynomial_bool :: \<open>int mpoly \<Rightarrow> nat set \<Rightarrow> (nat, int_poly) fmap \<Rightarrow> (status \<times> fpac_step) nres\<close> where
 \<open>remap_polys_polynomial_bool spec = (\<lambda>\<V> A.
    SPEC(\<lambda>(st, \<V>', A'). (\<not>is_failed st \<longrightarrow>
       dom_m A = dom_m A' \<and>
       (\<forall>i \<in># dom_m A. the (fmlookup A i) - the (fmlookup A' i) \<in> ideal polynomial_bool) \<and>
       \<Union>(vars ` set_mset (ran_m A)) \<subseteq> \<V>' \<and>
       \<Union>(vars ` set_mset (ran_m A')) \<subseteq> \<V>') \<and>
     (st = FOUND \<longrightarrow> spec \<in># ran_m A')))\<close>
 
 definition remap_polys_change_all :: \<open>int mpoly \<Rightarrow> nat set \<Rightarrow> (nat, int_poly) fmap \<Rightarrow> (status \<times> fpac_step) nres\<close> where
 \<open>remap_polys_change_all spec = (\<lambda>\<V> A. SPEC (\<lambda>(st, \<V>', A').
     (\<not>is_failed st \<longrightarrow>
       pac_ideal (set_mset (ran_m A)) = pac_ideal (set_mset (ran_m A')) \<and>
       \<Union>(vars ` set_mset (ran_m A)) \<subseteq> \<V>' \<and>
       \<Union>(vars ` set_mset (ran_m A')) \<subseteq> \<V>') \<and>
     (st = FOUND \<longrightarrow> spec \<in># ran_m A')))\<close>
 
 lemma fmap_eq_dom_iff:
   \<open>A = A' \<longleftrightarrow> dom_m A = dom_m A' \<and> (\<forall>i \<in># dom_m A. the (fmlookup A i) = the (fmlookup A' i))\<close>
   by (metis fmap_ext in_dom_m_lookup_iff option.expand)
 
 lemma ideal_remap_incl:
   \<open>finite A' \<Longrightarrow> (\<forall>a'\<in>A'. \<exists>a\<in>A. a-a' \<in> B) \<Longrightarrow> ideal (A' \<union> B) \<subseteq> ideal (A \<union> B)\<close>
   apply (induction A' rule: finite_induct)
   apply (auto intro: ideal.span_mono)
   using ideal.span_mono sup_ge2 apply blast
   proof -
     fix x :: 'a and F :: "'a set" and xa :: 'a and a :: 'a
     assume a1: "a \<in> A"
     assume a2: "a - x \<in> B"
     assume a3: "xa \<in> More_Modules.ideal (insert x (F \<union> B))"
     assume a4: "More_Modules.ideal (F \<union> B) \<subseteq> More_Modules.ideal (A \<union> B)"
     have "x \<in> More_Modules.ideal (A \<union> B)"
       using a2 a1 by (metis (no_types, lifting) Un_upper1 Un_upper2 add_diff_cancel_left' diff_add_cancel
         ideal.module_axioms ideal.span_diff in_mono module.span_superset)
     then show "xa \<in> More_Modules.ideal (A \<union> B)"
       using a4 a3 ideal.span_insert_subset by blast
   qed
 
 lemma pac_ideal_remap_eq:
   \<open>dom_m b = dom_m ba \<Longrightarrow>
        \<forall>i\<in>#dom_m ba.
           the (fmlookup b i) - the (fmlookup ba i)
           \<in> More_Modules.ideal polynomial_bool \<Longrightarrow>
      pac_ideal ((\<lambda>x. the (fmlookup b x)) ` set_mset (dom_m ba)) = pac_ideal ((\<lambda>x. the (fmlookup ba x)) ` set_mset (dom_m ba))\<close>
   unfolding pac_ideal_alt_def
   apply standard
   subgoal
     apply (rule ideal_remap_incl)
     apply (auto dest!: multi_member_split
       dest: ideal.span_neg)
     apply (drule ideal.span_neg)
     apply auto
     done
   subgoal
     by (rule ideal_remap_incl)
      (auto dest!: multi_member_split)
   done
 
 lemma remap_polys_polynomial_bool_remap_polys_change_all:
   \<open>remap_polys_polynomial_bool spec \<V> A \<le> remap_polys_change_all spec \<V> A\<close>
   unfolding remap_polys_polynomial_bool_def remap_polys_change_all_def
   apply (simp add: ideal.span_zero fmap_eq_dom_iff ideal.span_eq)
   apply (auto dest: multi_member_split simp: ran_m_def ideal.span_base pac_ideal_remap_eq
     add_mset_eq_add_mset
     eq_commute[of \<open>add_mset _ _\<close> \<open>dom_m (A :: (nat, int mpoly)fmap)\<close> for A])
   done
 
 
 definition remap_polys :: \<open>int mpoly \<Rightarrow> nat set \<Rightarrow> (nat, int_poly) fmap \<Rightarrow> (status \<times> fpac_step) nres\<close> where
   \<open>remap_polys spec = (\<lambda>\<V> A. do{
    dom \<leftarrow> SPEC(\<lambda>dom. set_mset (dom_m A) \<subseteq> dom \<and> finite dom);
 
    failed \<leftarrow> SPEC(\<lambda>_::bool. True);
    if failed
    then do {
       RETURN (FAILED, \<V>, fmempty)
    }
    else do {
      (b, N) \<leftarrow> FOREACH dom
        (\<lambda>i (b, \<V>, A').
           if i \<in># dom_m A
           then do {
             p \<leftarrow> SPEC(\<lambda>p. the (fmlookup A i) - p \<in> ideal polynomial_bool \<and> vars p \<subseteq> vars (the (fmlookup A i)));
             eq \<leftarrow> SPEC(\<lambda>eq. eq \<longrightarrow> p = spec);
             \<V> \<leftarrow> SPEC(\<lambda>\<V>'. \<V> \<union> vars (the (fmlookup A i)) \<subseteq> \<V>');
             RETURN(b \<or> eq, \<V>, fmupd i p A')
           } else RETURN (b, \<V>, A'))
        (False, \<V>, fmempty);
        RETURN (if b then FOUND else SUCCESS, N)
      }
    })\<close>
 
 lemma remap_polys_spec:
   \<open>remap_polys spec \<V> A \<le> remap_polys_polynomial_bool spec \<V> A\<close>
   unfolding remap_polys_def remap_polys_polynomial_bool_def
   apply (refine_vcg FOREACH_rule[where
     I = \<open>\<lambda>dom (b, \<V>, A').
       set_mset (dom_m A') =  set_mset (dom_m A) - dom \<and>
       (\<forall>i \<in> set_mset (dom_m A) - dom. the (fmlookup A i) - the (fmlookup A' i) \<in> ideal polynomial_bool) \<and>
      \<Union>(vars ` set_mset (ran_m (fmrestrict_set (set_mset (dom_m A')) A))) \<subseteq> \<V> \<and>
      \<Union>(vars ` set_mset (ran_m A')) \<subseteq> \<V> \<and>
       (b \<longrightarrow> spec \<in># ran_m A')\<close>])
   subgoal by auto
   subgoal by auto
   subgoal by auto
   subgoal by auto
   subgoal by auto
   subgoal by auto
   subgoal by auto
   subgoal
     by auto
   subgoal by auto
   subgoal using ideal.span_add by auto
   subgoal by auto
   subgoal by auto
   subgoal by clarsimp auto
    subgoal
      supply[[goals_limit=1]]
      by (auto simp add: ran_m_mapsto_upd_notin dom_m_fmrestrict_set' subset_eq)
    subgoal
      supply[[goals_limit=1]]
      by (auto simp add: ran_m_mapsto_upd_notin dom_m_fmrestrict_set' subset_eq)
    subgoal
      by (auto simp: ran_m_mapsto_upd_notin)
    subgoal
      by auto
    subgoal
      by auto
    subgoal
      by (auto simp add: ran_m_mapsto_upd_notin dom_m_fmrestrict_set' subset_eq)
    subgoal
      by (auto simp add: ran_m_mapsto_upd_notin dom_m_fmrestrict_set' subset_eq)
    subgoal
      by auto
    subgoal
      by (auto simp: distinct_set_mset_eq_iff[symmetric] distinct_mset_dom)
    subgoal
      by (auto simp: distinct_set_mset_eq_iff[symmetric] distinct_mset_dom)
    subgoal
      by (auto simp add: ran_m_mapsto_upd_notin dom_m_fmrestrict_set' subset_eq
        fmlookup_restrict_set_id')
    subgoal
      by (auto simp add: ran_m_mapsto_upd_notin dom_m_fmrestrict_set' subset_eq)
    subgoal
      by (auto simp add: ran_m_mapsto_upd_notin dom_m_fmrestrict_set' subset_eq
        fmlookup_restrict_set_id')
    done
 
 
 subsection \<open>Full Checker\<close>
 
 definition full_checker
   :: \<open>int_poly \<Rightarrow> (nat, int_poly) fmap \<Rightarrow> (int_poly, nat,nat) pac_step list \<Rightarrow> (status \<times> _) nres\<close>
  where
   \<open>full_checker spec0 A pac = do {
      spec \<leftarrow> normalize_poly_spec spec0;
      (st, \<V>, A) \<leftarrow> remap_polys_change_all spec {} A;
      if is_failed st then
      RETURN (st, \<V>, A)
      else do {
        \<V> \<leftarrow> SPEC(\<lambda>\<V>'. \<V> \<union> vars spec0 \<subseteq> \<V>');
        PAC_checker spec (\<V>, A) st pac
     }
 }\<close>
 
 lemma restricted_ideal_to_mono:
   \<open>restricted_ideal_to\<^sub>I \<V> I \<subseteq> restricted_ideal_to\<^sub>I \<V>' J \<Longrightarrow>
   \<U> \<subseteq> \<V> \<Longrightarrow>
    restricted_ideal_to\<^sub>I \<U> I \<subseteq> restricted_ideal_to\<^sub>I \<U>  J\<close>
   by (auto simp: restricted_ideal_to_def)
 
 lemma pac_ideal_idemp: \<open>pac_ideal (pac_ideal A) = pac_ideal A\<close>
   by (metis dual_order.antisym ideal.span_subset_spanI ideal.span_superset le_sup_iff pac_ideal_def)
 
 lemma full_checker_spec:
   assumes \<open>(A, A') \<in> polys_rel\<close>
   shows
       \<open>full_checker spec A pac \<le> \<Down>{((st, G), (st', G')). (st, st') \<in> status_rel \<and>
            (st \<noteq> FAILED \<longrightarrow> (G, G') \<in> polys_rel_full)}
         (PAC_checker_specification spec (A'))\<close>
 proof -
   have H: \<open>set_mset b \<subseteq> pac_ideal (set_mset (ran_m A)) \<Longrightarrow>
        x \<in> pac_ideal (set_mset b) \<Longrightarrow> x \<in> pac_ideal (set_mset A')\<close> for b x
     using assms apply -
     by (drule pac_ideal_mono) (auto simp: polys_rel_def pac_ideal_idemp)
   have 1: \<open>x \<in> {(st, \<V>', A').
           ( \<not> is_failed st \<longrightarrow> pac_ideal (set_mset (ran_m x2)) =
               pac_ideal (set_mset (ran_m A')) \<and>
               \<Union> (vars ` set_mset (ran_m ABC)) \<subseteq> \<V>' \<and>
               \<Union> (vars ` set_mset (ran_m A')) \<subseteq> \<V>') \<and>
             (st = FOUND \<longrightarrow> speca \<in># ran_m A')} \<Longrightarrow>
          x = (st, x') \<Longrightarrow> x' = (\<V>, Aa) \<Longrightarrow>((\<V>', Aa), \<V>', ran_m Aa) \<in> polys_rel_full\<close> for Aa speca x2 st x \<V>' \<V> x' ABC
     by (auto simp: polys_rel_def polys_rel_full_def)
   have H1: \<open>\<And>a aa b xa x x1a x1 x2 speca.
        vars spec \<subseteq> x1b \<Longrightarrow>
        \<Union> (vars ` set_mset (ran_m A)) \<subseteq> x1b \<Longrightarrow>
        \<Union> (vars ` set_mset (ran_m x2a)) \<subseteq> x1b \<Longrightarrow>
        restricted_ideal_to\<^sub>I x1b b \<subseteq> restricted_ideal_to\<^sub>I x1b (ran_m x2a) \<Longrightarrow>
        xa \<in> restricted_ideal_to\<^sub>I (\<Union> (vars ` set_mset (ran_m A)) \<union> vars spec) b \<Longrightarrow>
        xa \<in> restricted_ideal_to\<^sub>I (\<Union> (vars ` set_mset (ran_m A)) \<union> vars spec) (ran_m x2a)\<close>
     for x1b b xa x2a
     by (drule restricted_ideal_to_mono[of _ _ _ _ \<open>\<Union> (vars ` set_mset (ran_m A)) \<union> vars spec\<close>])
       auto
   have H2: \<open>\<And>a aa b speca x2 x1a x1b x2a.
        spec - speca \<in> More_Modules.ideal polynomial_bool \<Longrightarrow>
        vars spec \<subseteq> x1b \<Longrightarrow>
        \<Union> (vars ` set_mset (ran_m A)) \<subseteq> x1b \<Longrightarrow>
        \<Union> (vars ` set_mset (ran_m x2a)) \<subseteq> x1b \<Longrightarrow>
        speca \<in> pac_ideal (set_mset (ran_m x2a)) \<Longrightarrow>
        restricted_ideal_to\<^sub>I x1b b \<subseteq> restricted_ideal_to\<^sub>I x1b (ran_m x2a) \<Longrightarrow>
        spec \<in> pac_ideal (set_mset (ran_m x2a))\<close>
     by (metis (no_types, lifting) group_eq_aux ideal.span_add ideal.span_base in_mono
         pac_ideal_alt_def sup.cobounded2)
 
   show ?thesis
     supply[[goals_limit=1]]
     unfolding full_checker_def normalize_poly_spec_def
       PAC_checker_specification_def remap_polys_change_all_def
     apply (refine_vcg PAC_checker_PAC_checker_specification2[THEN order_trans, of _ _]
       lhs_step_If)
     subgoal by (auto simp: is_failed_def RETURN_RES_refine_iff)
     apply (rule 1; assumption)
     subgoal
       using fmap_ext assms by (auto simp: polys_rel_def ran_m_def)
     subgoal
       by auto
     subgoal
       by auto
     subgoal for speca x1 x2 x x1a x2a x1b
       apply (rule ref_two_step[OF conc_fun_R_mono])
        apply auto[]
       using assms
       by (auto simp add: PAC_checker_specification_spec_def conc_fun_RES polys_rel_def H1 H2
           polys_rel_full_def
           dest!: rtranclp_PAC_Format_subset_ideal dest: is_failed_is_success_completeD)
     done
 qed
 
 
 lemma full_checker_spec':
   shows
     \<open>(uncurry2 full_checker, uncurry2 (\<lambda>spec A _. PAC_checker_specification spec A)) \<in>
        (Id \<times>\<^sub>r polys_rel) \<times>\<^sub>r Id \<rightarrow>\<^sub>f \<langle>{((st, G), (st', G')). (st, st') \<in> status_rel \<and>
            (st \<noteq> FAILED \<longrightarrow> (G, G') \<in> polys_rel_full)}\<rangle>nres_rel\<close>
   using full_checker_spec
   by (auto intro!: frefI nres_relI)
 
 end
 
diff --git a/thys/PAC_Checker/PAC_More_Poly.thy b/thys/PAC_Checker/PAC_More_Poly.thy
--- a/thys/PAC_Checker/PAC_More_Poly.thy
+++ b/thys/PAC_Checker/PAC_More_Poly.thy
@@ -1,926 +1,926 @@
 (*
   File:         PAC_More_Poly.thy
   Author:       Mathias Fleury, Daniela Kaufmann, JKU
   Maintainer:   Mathias Fleury, JKU
 *)
 theory PAC_More_Poly
   imports "HOL-Library.Poly_Mapping" "HOL-Algebra.Polynomials" "Polynomials.MPoly_Type_Class"
   "HOL-Algebra.Module" "HOL-Library.Countable_Set"
 begin
 
 
 section \<open>Overview\<close>
 
 text \<open>
 
 One solution to check circuit of multipliers is to use algebraic method, like producing proofs on
 polynomials.  We are here interested in checking PAC proofs on the Boolean ring. The idea is the
 following: each variable represents an input or the output of a gate and we want to prove the
 bitwise multiplication of the input bits yields the output, namely the bitwise representation of the
 multiplication of the input (modulo \<^term>\<open>(2::nat)^n\<close> where \<^term>\<open>n::nat\<close> is the number of bits of the
 circuit).
 
 Algebraic proof systems typically reason over polynomials in a ring $\set K[X]$,
 where the variables $X$ represent Boolean values.
 The aim of an algebraic proof is to derive whether a polynomial $f$ can be derived from a given set of polynomials
 $G = \{g_1,\dots,g_l\} \subseteq \set K[X]$ together with the Boolean value constraints
 $B(X) = \{x^2_i-x_i \mid x_i \in X\}$. In algebraic terms this means to show that the polynomial \<^latex>\<open>\(f \in \langle G \cup B(X)\rangle\)\<close>.
 
 In our setting we set $\set K = \set Z$ and we treat the Boolean value constraints implicitly, i.e.,
 we consider proofs in the ring \<^latex>\<open>\(\set Z[X]/\langle B(X)\rangle\)\<close> to admit shorter proofs
 
 
 
 The checker takes as input 3 files:
   \<^enum> an input file containing all polynomials that are initially present;
   \<^enum> a target (or specification) polynomial ;
   \<^enum> a ``proof'' file to check that contains the proof in PAC format that shows that the specification
   is in the ideal generated by the polynomials present initially.
 
 
 Each step of the proof is either an addition of two polynomials previously derived, a multiplication
 from a previously derived polynomial and an arbitrary polynomial, and the deletion a derived
 polynomial.
 
 One restriction on the proofs compared to generic PAC proofs is that \<^term>\<open>(x::nat)^2 = x\<close> in the
 Boolean ring we are considering.
 
 The checker can produce two outputs: valid (meaning that each derived polynomial in the proof has
 been correctly derived and the specification polynomial was also derived at some point [either in
 the proof or as input]) or invalid (without proven information what went wrong).
 
 
 The development is organised as follows:
   \<^item> \<^file>\<open>PAC_Specification.thy\<close> (this file) contains the specification as described above on ideals
   without any peculiarities on the PAC proof format
   \<^item> \<^file>\<open>PAC_Checker_Specification.thy\<close> specialises to the PAC format and enters the nondeterminism
   monad to prepare the subsequent refinements.
   \<^item> \<^file>\<open>PAC_Checker.thy\<close> contains the refined version where polynomials are represented as lists.
   \<^item> \<^file>\<open>PAC_Checker_Synthesis.thy\<close> contains the efficient implementation with imperative data
   structure like a hash set.
   \<^item> \<^file>\<open>PAC_Checker_MLton.thy\<close> contains the code generation and the command to compile the file with
   the ML compiler MLton.
 
 
 Here is an example of a proof and an input file (taken from the appendix of our FMCAD
 paper~\cite{KaufmannFleuryBiere-FMCAD20}, available at \<^url>\<open>http://fmv.jku.at/pacheck_pasteque\<close>):
 \<^verbatim>\<open>
 <res.input>      <res.proof>
  1 x*y;           3  = fz, -z+1;
  2 y*z-y-z+1;     4  *  3,  y-1, -fz*y+fz-y*z+y+z-1;
                   5  +  2,    4, -fz*y+fz;
                   2  d;
                   4  d;
 <res.target>      6  *  1,   fz, fz*x*y;
  -x*z+x;          1  d;
                   7  *  5,    x, -fz*x*y+fz*x;
                   8  +  6,    7, fz*x;
                   9  *  3,    x, -fz*x-x*z+x;
                  10  +  8,    9, -x*z+x;
 \<close>
 
 Each line starts with a number that is used to index the (conclusion) polynomial. In the proof,
 there are four kind of steps:
   \<^enum> \<^verbatim>\<open>3 = fz, -z+1;\<close> is an extension that introduces a new variable (in this case \<^verbatim>\<open>fz\<close>);
   \<^enum> \<^verbatim>\<open>4  *  3,  y-1, -fz*y+fz-y*z+y+z-1;\<close> is a multiplication of the existing polynomial with
   index 3 by the arbitrary polynomial \<^verbatim>\<open>y-1\<close> and generates the new polynomial
   \<^verbatim>\<open>-fz*y+fz-y*z+y+z-1\<close> with index 4;
   \<^enum> \<^verbatim>\<open>5  +  2,    4, -fz*y+fz;\<close> is an addition of the existing polynomials with
   index 2 and 4 and generates the new polynomial \<^verbatim>\<open>-fz*y+fz\<close> with index 5;
   \<^enum> \<^verbatim>\<open>1  d;\<close> deletes the polynomial with index 1 and it cannot be reused in subsequent steps.
 
 
 
 Remark that unlike DRAT checker, we do forward checking and check every derived polynomial. The
 target polynomial can also be part of the input file.
 \<close>
 
 section \<open>Libraries\<close>
 
 subsection \<open>More Polynomials\<close>
 
 text \<open>
 
   Here are more theorems on polynomials. Most of these facts are
   extremely trivial and should probably be generalised and moved to
   the Isabelle distribution.
 \<close>
 
 lemma Const\<^sub>0_add:
   \<open>Const\<^sub>0 (a + b) = Const\<^sub>0 a + Const\<^sub>0 b\<close>
   by transfer
    (simp add: Const\<^sub>0_def single_add)
 
 lemma Const_mult:
   \<open>Const (a * b) = Const a * Const b\<close>
   by transfer (simp add: Const\<^sub>0_def times_monomial_monomial)
 
 lemma Const\<^sub>0_mult:
   \<open>Const\<^sub>0 (a * b) = Const\<^sub>0 a * Const\<^sub>0 b\<close>
   by transfer (simp add: Const\<^sub>0_def times_monomial_monomial)
 
 lemma Const0[simp]:
   \<open>Const 0 = 0\<close>
   by transfer (simp add: Const\<^sub>0_def)
 
 lemma (in -) Const_uminus[simp]:
   \<open>Const (-n) = - Const n\<close>
   by transfer (auto simp: Const\<^sub>0_def monomial_uminus)
 
 lemma [simp]: \<open>Const\<^sub>0 0 = 0\<close>
   \<open>MPoly 0 = 0\<close>
   by (auto simp: Const\<^sub>0_def zero_mpoly_def)
 
 lemma Const_add:
   \<open>Const (a + b) = Const a + Const b\<close>
   by transfer (simp add: Const\<^sub>0_def single_add)
 
 instance mpoly :: (comm_semiring_1) comm_semiring_1
   by standard
 
 lemma degree_uminus[simp]:
   \<open>degree (-A) x' = degree A x'\<close>
   by (auto simp: degree_def uminus_mpoly.rep_eq)
 
 lemma degree_sum_notin:
   \<open>x' \<notin> vars B \<Longrightarrow> degree (A + B) x' = degree A x'\<close>
   apply (auto simp: degree_def)
   apply (rule arg_cong[of _ _ Max])
   apply standard+
   apply (auto simp: plus_mpoly.rep_eq UN_I UnE image_iff in_keys_iff subsetD vars_def lookup_add
     dest: keys_add intro: in_keys_plusI1 cong: ball_cong_simp)
   done
 
 lemma degree_notin_vars:
   \<open>x \<notin> (vars B) \<Longrightarrow> degree (B :: 'a :: {monoid_add} mpoly) x = 0\<close>
   using degree_sum_notin[of x B 0]
   by auto
 
 lemma not_in_vars_coeff0:
   \<open>x \<notin> vars p \<Longrightarrow> MPoly_Type.coeff p (monomial (Suc 0) x) = 0\<close>
   by (subst not_not[symmetric], subst coeff_keys[symmetric])
     (auto simp: vars_def)
 
 lemma keys_add':
   "p \<in> keys (f + g) \<Longrightarrow> p \<in> keys f \<union> keys g"
   by transfer auto
 
 lemma keys_mapping_sum_add:
   \<open>finite A \<Longrightarrow> keys (mapping_of (\<Sum>v \<in> A. f v)) \<subseteq> \<Union>(keys ` mapping_of ` f ` UNIV)\<close>
   by (induction A rule: finite_induct)
    (auto simp add: zero_mpoly.rep_eq plus_mpoly.rep_eq
      keys_plus_ninv_comm_monoid_add dest: keys_add')
 
 lemma vars_sum_vars_union:
   fixes f :: \<open>int mpoly \<Rightarrow> int mpoly\<close>
   assumes \<open>finite {v. f v \<noteq> 0}\<close>
   shows \<open>vars (\<Sum>v | f v \<noteq> 0. f v * v) \<subseteq> \<Union>(vars ` {v. f v \<noteq> 0}) \<union> \<Union>(vars ` f ` {v. f v \<noteq> 0})\<close>
     (is \<open>?A \<subseteq> ?B\<close>)
 proof
   fix p
   assume \<open>p \<in> vars (\<Sum>v | f v \<noteq> 0. f v * v)\<close>
   then obtain x where \<open>x \<in> keys (mapping_of (\<Sum>v | f v \<noteq> 0. f v * v))\<close> and
     p: \<open>p \<in> keys x\<close>
     by (auto simp: vars_def times_mpoly.rep_eq simp del: keys_mult)
   then have \<open>x \<in> (\<Union>x. keys (mapping_of (f x) * mapping_of x))\<close>
     using keys_mapping_sum_add[of \<open>{v. f v \<noteq> 0}\<close> \<open>\<lambda>x. f x * x\<close>] assms
     by (auto simp: vars_def times_mpoly.rep_eq)
   then have \<open>x \<in> (\<Union>x. {a+b| a b. a \<in> keys (mapping_of (f x)) \<and> b \<in> keys (mapping_of x)})\<close>
     using Union_mono[OF ] keys_mult by fast
   then show \<open>p \<in> ?B\<close>
     using p by (force simp: vars_def zero_mpoly.rep_eq dest!: keys_add')
 qed
 
 
 lemma vars_in_right_only:
   "x \<in> vars q \<Longrightarrow> x \<notin> vars p \<Longrightarrow> x \<in> vars (p+q)"
   unfolding  vars_def keys_def plus_mpoly.rep_eq lookup_plus_fun
   apply clarify
   subgoal for xa
     by (auto simp: vars_def keys_def plus_mpoly.rep_eq
       lookup_plus_fun intro!: exI[of _ xa] dest!: spec[of _ xa])
   done
 
 lemma [simp]:
   \<open>vars 0 = {}\<close>
   by (simp add: vars_def zero_mpoly.rep_eq)
 
 
 lemma vars_Un_nointer:
   \<open>keys (mapping_of p) \<inter>  keys (mapping_of q) = {} \<Longrightarrow> vars (p + q) = vars p \<union> vars q\<close>
   by (auto simp: vars_def plus_mpoly.rep_eq simp flip: More_MPoly_Type.keys_add dest!: keys_add')
 
 lemmas [simp] = zero_mpoly.rep_eq
 
 lemma polynomial_sum_monoms:
   fixes p :: \<open>'a :: {comm_monoid_add,cancel_comm_monoid_add} mpoly\<close>
   shows
      \<open>p = (\<Sum>x\<in>keys (mapping_of p). MPoly_Type.monom x (MPoly_Type.coeff p x))\<close>
      \<open>keys (mapping_of p) \<subseteq> I \<Longrightarrow> finite I \<Longrightarrow> p = (\<Sum>x\<in>I. MPoly_Type.monom x (MPoly_Type.coeff p x))\<close>
 proof -
   define J where \<open>J \<equiv> keys (mapping_of p)\<close>
   define a where \<open>a x \<equiv> coeff p x\<close> for x
   have \<open>finite (keys (mapping_of p))\<close>
     by auto
   have \<open>p = (\<Sum>x\<in>I. MPoly_Type.monom x (MPoly_Type.coeff p x))\<close>
     if \<open>finite I\<close> and \<open>keys (mapping_of p) \<subseteq> I\<close>
     for I
     using that
     unfolding a_def
    proof (induction I arbitrary: p rule: finite_induct)
       case empty
       then have \<open>p = 0\<close>
         using empty coeff_all_0 coeff_keys by blast
       then show ?case using empty by (auto simp: zero_mpoly.rep_eq)
     next
       case (insert x F) note fin = this(1) and xF = this(2) and IH = this(3) and
         incl = this(4)
       let ?p = \<open>p - MPoly_Type.monom x (MPoly_Type.coeff p x)\<close>
       have H: \<open>\<And>xa. x \<notin> F \<Longrightarrow> xa \<in> F \<Longrightarrow>
         MPoly_Type.monom xa (MPoly_Type.coeff (p - MPoly_Type.monom x (MPoly_Type.coeff p x)) xa) =
          MPoly_Type.monom xa (MPoly_Type.coeff p xa)\<close>
         by (metis (mono_tags, opaque_lifting) add_diff_cancel_right' remove_term_coeff
           remove_term_sum when_def)
       have \<open>?p = (\<Sum>xa\<in>F. MPoly_Type.monom xa (MPoly_Type.coeff ?p xa))\<close>
         apply (rule IH)
         using incl apply -
-        by standard (smt Diff_iff Diff_insert_absorb add_diff_cancel_right'
+        by standard (smt (verit) Diff_iff Diff_insert_absorb add_diff_cancel_right'
           remove_term_keys remove_term_sum subsetD xF)
       also have \<open>... = (\<Sum>xa\<in>F. MPoly_Type.monom xa (MPoly_Type.coeff p xa))\<close>
         by (use xF in \<open>auto intro!: sum.cong simp: H\<close>)
       finally show ?case
         apply (subst (asm) remove_term_sum[of x p, symmetric])
         apply (subst remove_term_sum[of x p, symmetric])
         using xF fin by (auto simp: ac_simps)
     qed
     from this[of I] this[of J] show
      \<open>p = (\<Sum>x\<in>keys (mapping_of p). MPoly_Type.monom x (MPoly_Type.coeff p x))\<close>
      \<open>keys (mapping_of p) \<subseteq> I \<Longrightarrow> finite I \<Longrightarrow> p = (\<Sum>x\<in>I. MPoly_Type.monom x (MPoly_Type.coeff p x))\<close>
      by (auto simp: J_def)
 qed
 
 
 lemma vars_mult_monom:
   fixes p :: \<open>int mpoly\<close>
   shows \<open>vars (p * (monom (monomial (Suc 0) x') 1)) = (if p = 0 then {} else insert x' (vars p))\<close>
 proof -
 
   let ?v = \<open>monom (monomial (Suc 0) x') 1\<close>
   have
     p: \<open>p = (\<Sum>x\<in>keys (mapping_of p). MPoly_Type.monom x (MPoly_Type.coeff p x))\<close> (is \<open>_ = (\<Sum>x \<in> ?I. ?f x)\<close>)
     using polynomial_sum_monoms(1)[of p] .
   have pv: \<open>p * ?v = (\<Sum>x \<in> ?I. ?f x * ?v)\<close>
     by (subst p) (auto simp:  field_simps sum_distrib_left)
   define I where \<open>I \<equiv> ?I\<close>
   have in_keysD: \<open>x \<in> keys (mapping_of (\<Sum>x\<in>I. MPoly_Type.monom x (h x)))  \<Longrightarrow> x \<in> I\<close>
    if \<open>finite I\<close> for I and h :: \<open>_ \<Rightarrow> int\<close> and x
    using that by (induction rule: finite_induct)
     (force simp: monom.rep_eq empty_iff insert_iff keys_single coeff_monom
      simp: coeff_keys simp flip: coeff_add
      simp del: coeff_add)+
   have in_keys: \<open>keys (mapping_of (\<Sum>x\<in>I. MPoly_Type.monom x (h x))) = (\<Union>x \<in> I. (if h x  = 0 then {} else {x}))\<close>
    if \<open>finite I\<close> for I and h :: \<open>_ \<Rightarrow> int\<close> and x
    supply in_keysD[dest]
    using that by (induction rule: finite_induct)
      (auto simp: plus_mpoly.rep_eq MPoly_Type_Class.keys_plus_eqI)
 
   have H[simp]: \<open>vars ((\<Sum>x\<in>I. MPoly_Type.monom x (h x))) = (\<Union>x\<in>I. (if h x  = 0 then {} else keys x))\<close>
    if \<open>finite I\<close> for I and h :: \<open>_ \<Rightarrow> int\<close>
    using that by (auto simp: vars_def in_keys)
 
   have sums: \<open>(\<Sum>x\<in>I.
         MPoly_Type.monom (x + a') (c x)) =
        (\<Sum>x\<in> (\<lambda>x. x + a') ` I.
         MPoly_Type.monom x (c (x - a')))\<close>
     if \<open>finite I\<close> for I a' c q
     using that apply (induction rule: finite_induct)
     subgoal by auto
     subgoal
       unfolding image_insert by (subst sum.insert) auto
     done
   have non_zero_keysEx: \<open>p \<noteq> 0 \<Longrightarrow> \<exists>a. a \<in> keys (mapping_of p)\<close> for p :: \<open>int mpoly\<close>
      using mapping_of_inject by (fastforce simp add: ex_in_conv)
   have \<open>finite I\<close> \<open>keys (mapping_of p) \<subseteq> I\<close>
     unfolding I_def by auto
   then show
     \<open>vars (p * (monom (monomial (Suc 0) x') 1)) = (if p = 0 then {} else insert x' (vars p))\<close>
     apply (subst pv, subst I_def[symmetric], subst mult_monom)
     apply (auto simp: mult_monom sums I_def)
     using Poly_Mapping.keys_add vars_def apply fastforce
      apply (auto dest!: non_zero_keysEx)
      apply (rule_tac x= \<open>a + monomial (Suc 0) x'\<close> in bexI)
       apply (auto simp: coeff_keys)
      apply (simp add: in_keys_iff lookup_add)
     apply (auto simp: vars_def)
     apply (rule_tac x= \<open>xa + monomial (Suc 0) x'\<close> in bexI)
      apply (auto simp: coeff_keys)
     apply (simp add: in_keys_iff lookup_add)
     done
 qed
 
 
   term \<open>(x', u, lookup u x', A)\<close>
 lemma in_mapping_mult_single:
   \<open>x \<in> (\<lambda>x. lookup x x') ` keys (A * (Var\<^sub>0 x' :: (nat \<Rightarrow>\<^sub>0 nat) \<Rightarrow>\<^sub>0 'b :: {monoid_mult,zero_neq_one,semiring_0})) \<longleftrightarrow>
   x > 0 \<and> x - 1 \<in> (\<lambda>x. lookup x x') ` keys (A)\<close>
   apply (standard+; clarify)
   subgoal
     apply (auto  elim!: in_keys_timesE simp: lookup_add)
     apply (auto simp: keys_def lookup_times_monomial_right Var\<^sub>0_def lookup_single image_iff)
     done
   subgoal
     apply (auto  elim!: in_keys_timesE simp: lookup_add)
     apply (auto simp: keys_def lookup_times_monomial_right Var\<^sub>0_def lookup_single image_iff)
     done
   subgoal for  xa
     apply (auto  elim!: in_keys_timesE simp: lookup_add)
     apply (auto simp: keys_def lookup_times_monomial_right Var\<^sub>0_def lookup_single image_iff lookup_add
       intro!: exI[of _ \<open>xa + Poly_Mapping.single x' 1\<close>])
     done
   done
 
 lemma Max_Suc_Suc_Max:
   \<open>finite A \<Longrightarrow> A \<noteq> {} \<Longrightarrow> Max (insert 0 (Suc ` A)) =
     Suc (Max (insert 0 A))\<close>
   by (induction rule: finite_induct)
    (auto simp: hom_Max_commute)
 
 lemma [simp]:
   \<open>keys (Var\<^sub>0 x' :: ('a \<Rightarrow>\<^sub>0 nat) \<Rightarrow>\<^sub>0 'b :: {zero_neq_one}) = {Poly_Mapping.single x' 1}\<close>
   by (auto simp: Var\<^sub>0_def)
 
 
 lemma degree_mult_Var:
   \<open>degree (A * Var x') x' = (if A = 0 then 0 else Suc (degree A x'))\<close> for A :: \<open>int mpoly\<close>
 proof -
   have [simp]: \<open>A \<noteq> 0 \<Longrightarrow>
     Max (insert 0 ((\<lambda>x. Suc (lookup x x')) ` keys (mapping_of A))) =
     Max (insert (Suc 0) ((\<lambda>x. Suc (lookup x x')) ` keys (mapping_of A)))\<close>
     unfolding image_image[of Suc \<open>\<lambda>x. lookup x x'\<close>, symmetric] image_insert[symmetric]
     by (subst Max_Suc_Suc_Max, use mapping_of_inject in fastforce, use mapping_of_inject in fastforce)+
       (simp add: Max.hom_commute)
   have \<open>A \<noteq> 0 \<Longrightarrow>
     Max (insert 0
     ((\<lambda>x. lookup x x') `
     keys (mapping_of A * mapping_of (Var x')))) =
     Suc (Max (insert 0 ((\<lambda>m. lookup m x') ` keys (mapping_of A))))\<close>
     by (subst arg_cong[of _ \<open>insert 0
       (Suc ` ((\<lambda>x. lookup x x') ` keys (mapping_of A)))\<close> Max])
      (auto simp: image_image Var.rep_eq lookup_plus_fun in_mapping_mult_single
       hom_Max_commute Max_Suc_Suc_Max
       elim!: in_keys_timesE  split: if_splits)
   then show ?thesis
     by (auto simp: degree_def times_mpoly.rep_eq
       intro!: arg_cong[of _ \<open>insert 0
       (Suc ` ((\<lambda>x. lookup x x') ` keys (mapping_of A)))\<close> Max])
 qed
 
 lemma degree_mult_Var':
   \<open>degree (Var x' * A) x' = (if A = 0 then 0 else Suc (degree A x'))\<close> for A :: \<open>int mpoly\<close>
  by (simp add: degree_mult_Var semiring_normalization_rules(7))
 
 lemma degree_times_le:
   \<open>degree (A * B) x \<le> degree A x + degree B x\<close>
   by (auto simp: degree_def times_mpoly.rep_eq
        max_def lookup_add add_mono
     dest!: set_rev_mp[OF _ Poly_Mapping.keys_add]
     elim!: in_keys_timesE)
 
 lemma monomial_inj:
   "monomial c s = monomial (d::'b::zero_neq_one) t \<longleftrightarrow> (c = 0 \<and> d = 0) \<or> (c = d \<and> s = t)"
   by (fastforce simp add: monomial_inj Poly_Mapping.single_def
     poly_mapping.Abs_poly_mapping_inject when_def fun_eq_iff
     cong: if_cong
     split: if_splits)
 
 lemma MPoly_monomial_power':
   \<open>MPoly (monomial 1 x') ^ (n+1) =  MPoly (monomial (1) (((\<lambda>x. x + x') ^^ n) x'))\<close>
   by (induction n)
    (auto simp: times_mpoly.abs_eq mult_single ac_simps)
 
 lemma MPoly_monomial_power:
   \<open>n > 0 \<Longrightarrow> MPoly (monomial 1 x') ^ (n) =  MPoly (monomial (1) (((\<lambda>x. x + x') ^^ (n - 1)) x'))\<close>
   using MPoly_monomial_power'[of _ \<open>n-1\<close>]
   by auto
 
 
 lemma vars_uminus[simp]:
   \<open>vars (-p) = vars p\<close>
   by (auto simp: vars_def uminus_mpoly.rep_eq)
 
 lemma coeff_uminus[simp]:
   \<open>MPoly_Type.coeff (-p) x = -MPoly_Type.coeff p x\<close>
   by (auto simp: coeff_def uminus_mpoly.rep_eq)
 
 definition decrease_key::"'a \<Rightarrow> ('a \<Rightarrow>\<^sub>0 'b::{monoid_add, minus,one}) \<Rightarrow> ('a \<Rightarrow>\<^sub>0 'b)" where
   "decrease_key k0 f = Abs_poly_mapping (\<lambda>k. if k = k0 \<and> lookup f k \<noteq> 0 then lookup f k - 1 else lookup f k)"
 
 lemma remove_key_lookup:
   "lookup (decrease_key k0 f) k = (if k = k0 \<and> lookup f k \<noteq> 0 then lookup f k - 1 else lookup f k)"
   unfolding decrease_key_def using finite_subset apply simp
   apply (subst lookup_Abs_poly_mapping)
   apply (auto intro: finite_subset[of _ \<open>{x. lookup f x \<noteq> 0}\<close>])
   apply (subst lookup_Abs_poly_mapping)
   apply (auto intro: finite_subset[of _ \<open>{x. lookup f x \<noteq> 0}\<close>])
   done
 
 lemma polynomial_split_on_var:
   fixes p :: \<open>'a :: {comm_monoid_add,cancel_comm_monoid_add,semiring_0,comm_semiring_1} mpoly\<close>
   obtains q r where
     \<open>p = monom (monomial (Suc 0) x') 1 * q + r\<close> and
     \<open>x' \<notin> vars r\<close>
 proof -
   have [simp]: \<open>{x \<in> keys (mapping_of p). x' \<in> keys x} \<union>
         {x \<in> keys (mapping_of p). x' \<notin> keys x} = keys (mapping_of p)\<close>
     by auto
   have
     \<open>p = (\<Sum>x\<in>keys (mapping_of p). MPoly_Type.monom x (MPoly_Type.coeff p x))\<close> (is \<open>_ = (\<Sum>x \<in> ?I. ?f x)\<close>)
     using polynomial_sum_monoms(1)[of p] .
   also have \<open>... = (\<Sum>x\<in> {x \<in> ?I. x' \<in> keys x}. ?f x) + (\<Sum>x\<in> {x \<in> ?I. x' \<notin> keys x}. ?f x)\<close> (is \<open>_ = ?pX + ?qX\<close>)
     by (subst comm_monoid_add_class.sum.union_disjoint[symmetric]) auto
   finally have 1: \<open>p = ?pX + ?qX\<close> .
   have H: \<open>0 < lookup x x' \<Longrightarrow> (\<lambda>k. (if x' = k then Suc 0 else 0) +
           (if k = x' \<and> 0 < lookup x k then lookup x k - 1
            else lookup x k)) = lookup x\<close> for x x'
     by auto
   have [simp]: \<open>finite {x. 0 < (Suc 0 when x' = x)}\<close> for x' :: nat and x
-    by (smt bounded_nat_set_is_finite lessI mem_Collect_eq neq0_conv when_cong when_neq_zero)
+    by (smt (verit) bounded_nat_set_is_finite lessI mem_Collect_eq neq0_conv when_cong when_neq_zero)
   have H: \<open>x' \<in> keys x \<Longrightarrow> monomial (Suc 0) x' + Abs_poly_mapping (\<lambda>k. if k = x' \<and> 0 < lookup x k then lookup x k - 1 else lookup x k) = x\<close>
     for x and x' :: nat
     apply (simp only: keys_def single.abs_eq)
     apply (subst plus_poly_mapping.abs_eq)
     by (auto simp: eq_onp_def when_def H
         intro!: finite_subset[of \<open>{xa. (xa = x' \<and> 0 < lookup x xa \<longrightarrow> Suc 0 < lookup x x') \<and>
            (xa \<noteq> x' \<longrightarrow> 0 < lookup x xa)}\<close> \<open>{xa. 0 < lookup x xa}\<close>])
 
   have [simp]: \<open>x' \<in> keys x \<Longrightarrow>
         MPoly_Type.monom (monomial (Suc 0) x' + decrease_key x' x) n =
         MPoly_Type.monom x n\<close> for x n and x'
     apply (subst mpoly.mapping_of_inject[symmetric], subst poly_mapping.lookup_inject[symmetric])
     unfolding mapping_of_monom lookup_single
     apply (auto intro!: ext simp: decrease_key_def when_def H)
     done
   have pX: \<open>?pX = monom (monomial (Suc 0) x') 1 * (\<Sum>x\<in> {x \<in> ?I. x' \<in> keys x}. MPoly_Type.monom (decrease_key x' x) (MPoly_Type.coeff p x))\<close>
     (is \<open>_ = _ * ?pX'\<close>)
     by (subst sum_distrib_left, subst mult_monom)
      (auto intro!: sum.cong)
   have \<open>x' \<notin> vars ?qX\<close>
     using vars_setsum[of \<open>{x. x \<in> keys (mapping_of p) \<and> x' \<notin> keys x}\<close> \<open>?f\<close>]
     by (auto dest!: vars_monom_subset[unfolded subset_eq Ball_def, rule_format])
   then show ?thesis
     using that[of ?pX' ?qX]
     unfolding pX[symmetric] 1[symmetric]
     by blast
 qed
 
 
 lemma polynomial_split_on_var2:
   fixes p :: \<open>int mpoly\<close>
   assumes \<open>x' \<notin> vars s\<close>
   obtains q r where
     \<open>p = (monom (monomial (Suc 0) x') 1 - s) * q + r\<close> and
     \<open>x' \<notin> vars r\<close>
 proof -
   have eq[simp]: \<open>monom (monomial (Suc 0) x') 1 = Var x'\<close>
     by (simp add: Var.abs_eq Var\<^sub>0_def monom.abs_eq)
   have \<open>\<forall>m \<le> n. \<forall>P::int mpoly. degree P x' < m \<longrightarrow> (\<exists>A B. P = (Var x' - s) * A + B \<and> x' \<notin> vars B)\<close> for n
   proof (induction n)
     case 0
     then show ?case by auto
   next
     case (Suc n)
     then have IH: \<open>m\<le>n \<Longrightarrow> MPoly_Type.degree P x' < m \<Longrightarrow>
               (\<exists>A B. P = (Var x' - s) * A + B \<and> x' \<notin> vars B)\<close> for m P
       by fast
     show ?case
     proof (intro allI impI)
      fix m and P :: \<open>int mpoly\<close>
      assume \<open>m \<le> Suc n\<close> and deg: \<open>MPoly_Type.degree P x' < m\<close>
      consider
        \<open>m \<le> n\<close> |
        \<open>m = Suc n\<close>
        using \<open>m \<le> Suc n\<close> by linarith
      then show \<open>\<exists>A B. P = (Var x' - s) * A + B \<and> x' \<notin> vars B\<close>
      proof cases
        case 1
        then show \<open>?thesis\<close>
          using Suc deg by blast
      next
        case [simp]: 2
        obtain A B where
          P: \<open>P = Var x' * A + B\<close> and
          \<open>x' \<notin> vars B\<close>
          using polynomial_split_on_var[of P x'] unfolding eq by blast
        have P': \<open>P = (Var x' - s) * A + (s * A + B)\<close>
          by (auto simp: field_simps P)
        have \<open>A = 0 \<or> degree (s * A) x' < degree P x'\<close>
          using deg \<open>x' \<notin> vars B\<close> \<open>x' \<notin> vars s\<close> degree_times_le[of s A x'] deg
          unfolding P
          by (auto simp: degree_sum_notin degree_mult_Var' degree_mult_Var degree_notin_vars
            split: if_splits)
        then obtain A' B' where
          sA: \<open>s*A = (Var x' - s) * A' + B'\<close> and
          \<open>x' \<notin> vars B'\<close>
          using IH[of \<open>m-1\<close> \<open>s*A\<close>] deg \<open>x' \<notin> vars B\<close> that[of 0 0]
          by (cases \<open>0 < n\<close>) (auto dest!: vars_in_right_only)
        have \<open>P = (Var x' - s) * (A + A') + (B' + B)\<close>
          unfolding P' sA by (auto simp: field_simps)
        moreover have \<open>x' \<notin> vars (B' + B)\<close>
          using \<open>x' \<notin> vars B'\<close>  \<open>x' \<notin> vars B\<close>
          by (meson UnE subset_iff vars_add)
        ultimately show ?thesis
          by fast
      qed
    qed
   qed
   then show ?thesis
     using that unfolding eq
     by blast
 qed
 
 lemma finit_whenI[intro]:
   \<open>finite  {x. (0 :: nat) < (y x)} \<Longrightarrow> finite {x. 0 < (y x when x \<noteq> x')}\<close>
   apply (rule finite_subset)
     defer apply assumption
   apply (auto simp: when_def)
   done
 
 lemma polynomial_split_on_var_diff_sq2:
  fixes p :: \<open>int mpoly\<close>
   obtains q r s where
     \<open>p = monom (monomial (Suc 0) x') 1 * q + r + s * (monom (monomial (Suc 0) x') 1^2 - monom (monomial (Suc 0) x') 1)\<close> and
     \<open>x' \<notin> vars r\<close> and
     \<open>x' \<notin> vars q\<close>
 proof -
   let ?v = \<open>monom (monomial (Suc 0) x') 1 :: int mpoly\<close>
   have H: \<open>n < m \<Longrightarrow> n > 0 \<Longrightarrow> \<exists>q. ?v^n = ?v + q * (?v^2 - ?v)\<close> for n m :: nat
   proof (induction m arbitrary: n)
     case 0
     then show ?case by auto
   next
     case (Suc m n) note IH = this(1-)
     consider
       \<open>n < m\<close> |
       \<open>m = n\<close> \<open>n > 1\<close> |
       \<open>n = 1\<close>
       using IH
       by (cases \<open>n < m\<close>; cases n) auto
     then show ?case
     proof cases
       case 1
       then show ?thesis using IH by auto
     next
       case 2
       have eq: \<open>?v^(n) = ((?v :: int mpoly) ^ (n-2)) * (?v^2-?v) + ?v^(n-1)\<close>
         using 2 by (auto simp: field_simps power_eq_if
           ideal.scale_right_diff_distrib)
       obtain q where
         q: \<open>?v^(n-1) = ?v + q * (?v^2 - ?v)\<close>
         using IH(1)[of \<open>n-1\<close>] 2
         by auto
       show ?thesis
         using q unfolding eq
         by (auto intro!: exI[of _ \<open>?v ^ (n - 2) + q\<close>] simp: distrib_right)
     next
       case 3
       then show \<open>?thesis\<close>
         by auto
     qed
   qed
   have H: \<open>n>0 \<Longrightarrow> \<exists>q. ?v^n = ?v + q * (?v^2-?v)\<close> for n
     using H[of n \<open>n+1\<close>]
     by auto
   obtain qr :: \<open>nat \<Rightarrow> int mpoly\<close> where
      qr: \<open>n > 0 \<Longrightarrow> ?v^n = ?v + qr n * (?v^2-?v)\<close> for n
    using H by metis
   have vn: \<open>(if lookup x x' = 0 then 1 else Var x' ^ lookup x x') =
     (if lookup x x' = 0 then 1 else ?v) + (if lookup x x' = 0 then 0 else 1) * qr (lookup x x') * (?v^2-?v)\<close> for x
     by (simp add: qr[symmetric] Var_def Var\<^sub>0_def monom.abs_eq[symmetric] cong: if_cong)
 
   have q: \<open>p = (\<Sum>x\<in>keys (mapping_of p). MPoly_Type.monom x (MPoly_Type.coeff p x))\<close>
     by (rule polynomial_sum_monoms(1)[of p])
   have [simp]:
     \<open>lookup x x' = 0 \<Longrightarrow>
     Abs_poly_mapping (\<lambda>k. lookup x k when k \<noteq> x') = x\<close> for x
     by (cases x, auto simp: poly_mapping.Abs_poly_mapping_inject)
       (auto intro!: ext simp: when_def)
   have [simp]: \<open>finite {x. 0 < (a when x' = x)}\<close> for a :: nat
     by (metis (no_types, lifting) infinite_nat_iff_unbounded less_not_refl lookup_single lookup_single_not_eq mem_Collect_eq)
 
   have [simp]: \<open>((\<lambda>x. x + monomial (Suc 0) x') ^^ (n))
      (monomial (Suc 0) x') = Abs_poly_mapping (\<lambda>k. (if k = x' then n+1 else 0))\<close> for n
     by (induction n)
      (auto simp: single_def Abs_poly_mapping_inject plus_poly_mapping.abs_eq eq_onp_def cong:if_cong)
   have [simp]: \<open>0 < lookup x x' \<Longrightarrow>
     Abs_poly_mapping (\<lambda>k. lookup x k when k \<noteq> x') +
     Abs_poly_mapping (\<lambda>k. if k = x' then lookup x x' - Suc 0 + 1 else 0) =
     x\<close> for x
     apply (cases x, auto simp: poly_mapping.Abs_poly_mapping_inject plus_poly_mapping.abs_eq eq_onp_def)
     apply (subst plus_poly_mapping.abs_eq)
     apply (auto simp: poly_mapping.Abs_poly_mapping_inject plus_poly_mapping.abs_eq eq_onp_def)
     apply (subst Abs_poly_mapping_inject)
     apply auto
     done
   define f where
     \<open>f x = (MPoly_Type.monom (remove_key x' x) (MPoly_Type.coeff p x)) *
       (if lookup x x' = 0 then 1 else Var x' ^ (lookup x x'))\<close> for x
   have f_alt_def: \<open>f x = MPoly_Type.monom x (MPoly_Type.coeff p x)\<close> for x
     by (auto simp: f_def monom_def remove_key_def Var_def MPoly_monomial_power Var\<^sub>0_def
       mpoly.MPoly_inject monomial_inj times_mpoly.abs_eq
       times_mpoly.abs_eq mult_single)
   have p: \<open>p = (\<Sum>x\<in>keys (mapping_of p).
        MPoly_Type.monom (remove_key x' x) (MPoly_Type.coeff p x) *
        (if lookup x x' = 0 then 1 else ?v)) +
           (\<Sum>x\<in>keys (mapping_of p).
        MPoly_Type.monom (remove_key x' x) (MPoly_Type.coeff p x) *
        (if lookup x x' = 0 then 0
         else 1) * qr (lookup x x')) *
              (?v\<^sup>2 - ?v)\<close>
     (is \<open>_ = ?a + ?v2v\<close>)
     apply (subst q)
     unfolding f_alt_def[symmetric, abs_def] f_def vn semiring_class.distrib_left
       comm_semiring_1_class.semiring_normalization_rules(18) semiring_0_class.sum_distrib_right
     by (simp add: semiring_class.distrib_left
       sum.distrib)
 
   have I: \<open>keys (mapping_of p) = {x \<in> keys (mapping_of p). lookup x x' = 0} \<union> {x \<in> keys (mapping_of p). lookup x x' \<noteq> 0}\<close>
     by auto
 
   have \<open>p = (\<Sum>x | x \<in> keys (mapping_of p) \<and> lookup x x' = 0.
        MPoly_Type.monom x (MPoly_Type.coeff p x)) +
     (\<Sum>x | x \<in> keys (mapping_of p) \<and> lookup x x' \<noteq> 0.
        MPoly_Type.monom (remove_key x' x) (MPoly_Type.coeff p x)) *
        (MPoly_Type.monom (monomial (Suc 0) x') 1) +
      (\<Sum>x | x \<in> keys (mapping_of p) \<and> lookup x x' \<noteq> 0.
         MPoly_Type.monom (remove_key x' x) (MPoly_Type.coeff p x) *
         qr (lookup x x')) *
              (?v\<^sup>2 - ?v)\<close>
     (is \<open>p = ?A + ?B * _ + ?C * _\<close>)
     unfolding semiring_0_class.sum_distrib_right[of _ _ \<open>(MPoly_Type.monom (monomial (Suc 0) x') 1)\<close>]
     apply (subst p)
     apply (subst (2)I)
     apply (subst I)
     apply (subst comm_monoid_add_class.sum.union_disjoint)
     apply auto[3]
     apply (subst comm_monoid_add_class.sum.union_disjoint)
     apply auto[3]
     apply (subst (4) sum.cong[OF refl, of _ _ \<open>\<lambda>x. MPoly_Type.monom (remove_key x' x) (MPoly_Type.coeff p x) *
         qr (lookup x x')\<close>])
     apply (auto; fail)
     apply (subst (3) sum.cong[OF refl, of _ _ \<open>\<lambda>x. 0\<close>])
     apply (auto; fail)
     apply (subst (2) sum.cong[OF refl, of _ _ \<open>\<lambda>x. MPoly_Type.monom (remove_key x' x) (MPoly_Type.coeff p x) *
        (MPoly_Type.monom (monomial (Suc 0) x') 1)\<close>])
     apply (auto; fail)
     apply (subst (1) sum.cong[OF refl, of _ _ \<open>\<lambda>x. MPoly_Type.monom x (MPoly_Type.coeff p x)\<close>])
     by (auto simp: f_def simp flip: f_alt_def)
 
   moreover have \<open>x' \<notin> vars ?A\<close>
     using vars_setsum[of \<open>{x \<in> keys (mapping_of p). lookup x x' = 0}\<close>
       \<open>\<lambda>x. MPoly_Type.monom x (MPoly_Type.coeff p x)\<close>]
     apply auto
     apply (drule set_rev_mp, assumption)
     apply (auto dest!: lookup_eq_zero_in_keys_contradict)
     by (meson lookup_eq_zero_in_keys_contradict subsetD vars_monom_subset)
   moreover have \<open>x' \<notin> vars ?B\<close>
     using vars_setsum[of \<open>{x \<in> keys (mapping_of p). lookup x x' \<noteq> 0}\<close>
       \<open>\<lambda>x. MPoly_Type.monom (remove_key x' x) (MPoly_Type.coeff p x)\<close>]
     apply auto
     apply (drule set_rev_mp, assumption)
     apply (auto dest!: lookup_eq_zero_in_keys_contradict)
     apply (drule subsetD[OF vars_monom_subset])
     apply (auto simp: remove_key_keys[symmetric])
     done
   ultimately show ?thesis apply -
     apply (rule that[of ?B ?A ?C])
     apply (auto simp: ac_simps)
     done
 qed
 
 
 lemma polynomial_decomp_alien_var:
   fixes q A b :: \<open>int mpoly\<close>
   assumes
     q: \<open>q = A * (monom (monomial (Suc 0) x') 1) + b\<close> and
     x: \<open>x' \<notin> vars q\<close> \<open>x' \<notin> vars b\<close>
   shows
     \<open>A = 0\<close> and
     \<open>q = b\<close>
 proof -
   let ?A = \<open>A * (monom (monomial (Suc 0) x') 1)\<close>
   have \<open>?A = q - b\<close>
     using arg_cong[OF q, of \<open>\<lambda>a. a - b\<close>]
     by auto
   moreover have \<open>x' \<notin> vars (q - b)\<close>
     using x vars_in_right_only
     by fastforce
   ultimately have \<open>x' \<notin> vars (?A)\<close>
     by simp
   then have \<open>?A = 0\<close>
     by (auto simp: vars_mult_monom split: if_splits)
   moreover have \<open>?A = 0 \<Longrightarrow> A = 0\<close>
     by (metis empty_not_insert mult_zero_left vars_mult_monom)
   ultimately show \<open>A = 0\<close>
     by blast
   then show \<open>q = b\<close>
     using q by auto
 qed
 
 lemma polynomial_decomp_alien_var2:
   fixes q A b :: \<open>int mpoly\<close>
   assumes
     q: \<open>q = A * (monom (monomial (Suc 0) x') 1 + p) + b\<close> and
     x: \<open>x' \<notin> vars q\<close> \<open>x' \<notin> vars b\<close> \<open>x' \<notin> vars p\<close>
   shows
     \<open>A = 0\<close> and
     \<open>q = b\<close>
 proof -
   let ?x = \<open>monom (monomial (Suc 0) x') 1\<close>
   have x'[simp]: \<open>?x = Var x'\<close>
     by (simp add: Var.abs_eq Var\<^sub>0_def monom.abs_eq)
   have \<open>\<exists>n Ax A'. A = ?x * Ax + A' \<and> x' \<notin> vars A' \<and> degree Ax x' = n\<close>
     using polynomial_split_on_var[of A x'] by metis
   from wellorder_class.exists_least_iff[THEN iffD1, OF this] obtain Ax A' n where
     A: \<open>A = Ax * ?x + A'\<close> and
     \<open>x' \<notin> vars A'\<close> and
     n: \<open>MPoly_Type.degree Ax x' = n\<close> and
     H: \<open>\<And>m Ax A'. m < n \<longrightarrow>
                    A \<noteq> Ax * MPoly_Type.monom (monomial (Suc 0) x') 1 + A' \<or>
                    x' \<in> vars A' \<or> MPoly_Type.degree Ax x' \<noteq> m\<close>
     unfolding wellorder_class.exists_least_iff[of \<open>\<lambda>n. \<exists>Ax A'. A = Ax * ?x + A' \<and> x' \<notin> vars A' \<and>
       degree Ax x' = n\<close>]
     by (auto simp: field_simps)
 
   have \<open>q = (A + Ax * p) * monom (monomial (Suc 0) x') 1 + (p * A' + b)\<close>
     unfolding q A by (auto simp: field_simps)
   moreover have \<open>x' \<notin> vars q\<close> \<open>x' \<notin> vars (p * A' + b)\<close>
     using x \<open>x' \<notin> vars A'\<close>
-    by (smt UnE add.assoc add.commute calculation subset_iff vars_in_right_only vars_mult)+
+    by (smt (verit) UnE add.assoc add.commute calculation subset_iff vars_in_right_only vars_mult)+
   ultimately have \<open>A + Ax * p = 0\<close> \<open>q = p * A' + b\<close>
     by (rule polynomial_decomp_alien_var)+
 
   have A': \<open>A' = -Ax * ?x - Ax * p\<close>
     using \<open>A + Ax * p = 0\<close> unfolding A
     by (metis (no_types, lifting) add_uminus_conv_diff eq_neg_iff_add_eq_0 minus_add_cancel
         mult_minus_left)
 
   have \<open>A = - (Ax * p)\<close>
     using A unfolding A'
     apply auto
     done
 
   obtain Axx Ax' where
     Ax: \<open>Ax = ?x * Axx + Ax'\<close> and
     \<open>x' \<notin> vars Ax'\<close>
     using polynomial_split_on_var[of Ax x'] by metis
 
   have \<open>A = ?x * (- Axx * p) + (- Ax' * p)\<close>
     unfolding \<open>A = - (Ax * p)\<close> Ax
     by (auto simp: field_simps)
 
   moreover have \<open>x' \<notin> vars (-Ax' * p)\<close>
     using \<open>x' \<notin> vars Ax'\<close> by (metis (no_types, opaque_lifting) UnE add.right_neutral
       add_minus_cancel assms(4) subsetD vars_in_right_only vars_mult)
    moreover have \<open>Axx \<noteq> 0 \<Longrightarrow> MPoly_Type.degree (- Axx * p) x' < degree Ax x'\<close>
      using degree_times_le[of Axx p x'] x
      by (auto simp: Ax degree_sum_notin \<open>x' \<notin> vars Ax'\<close> degree_mult_Var'
        degree_notin_vars)
    ultimately have [simp]: \<open>Axx = 0\<close>
      using H[of \<open>MPoly_Type.degree (- Axx * p) x'\<close> \<open>- Axx * p\<close> \<open>- Ax' * p\<close>]
      by (auto simp: n)
   then have [simp]: \<open>Ax' = Ax\<close>
     using Ax by auto
 
   show \<open>A = 0\<close>
     using A \<open>A = - (Ax * p)\<close> \<open>x' \<notin> vars (- Ax' * p)\<close> \<open>x' \<notin> vars A'\<close> polynomial_decomp_alien_var(1) by force
   then show \<open>q = b\<close>
     using q by auto
 qed
 
 lemma vars_unE: \<open>x \<in> vars (a * b) \<Longrightarrow> (x \<in> vars a \<Longrightarrow> thesis) \<Longrightarrow> (x \<in> vars b \<Longrightarrow> thesis) \<Longrightarrow> thesis\<close>
    using vars_mult[of a b] by auto
 
 
 lemma in_keys_minusI1:
   assumes "t \<in> keys p" and "t \<notin> keys q"
   shows "t \<in> keys (p - q)"
   using assms unfolding in_keys_iff lookup_minus by simp
 
 lemma in_keys_minusI2:
   fixes t :: \<open>'a\<close> and q :: \<open>'a \<Rightarrow>\<^sub>0 'b :: {cancel_comm_monoid_add,group_add}\<close>
   assumes "t \<in> keys q" and "t \<notin> keys p"
   shows "t \<in> keys (p - q)"
   using assms unfolding in_keys_iff lookup_minus by simp
 
 
 lemma in_vars_addE:
   \<open>x \<in> vars (p + q) \<Longrightarrow> (x \<in> vars p \<Longrightarrow> thesis) \<Longrightarrow> (x \<in> vars q \<Longrightarrow> thesis) \<Longrightarrow> thesis\<close>
   by (meson UnE in_mono vars_add)
 
 lemma lookup_monomial_If:
   \<open>lookup (monomial v k) = (\<lambda>k'. if k = k' then v else 0)\<close>
   by (intro ext) (auto simp: lookup_single_not_eq)
 
 lemma vars_mult_Var:
   \<open>vars (Var x * p) = (if p = 0 then {} else insert x (vars p))\<close> for p :: \<open>int mpoly\<close>
 proof -
   have \<open>p \<noteq> 0 \<Longrightarrow>
     \<exists>xa. (\<exists>k. xa = monomial (Suc 0) x + k) \<and>
          lookup (mapping_of p) (xa - monomial (Suc 0) x) \<noteq> 0 \<and>
          0 < lookup xa x\<close>
    by (metis (no_types, opaque_lifting) One_nat_def ab_semigroup_add_class.add.commute
      add_diff_cancel_right' aux lookup_add lookup_single_eq mapping_of_inject
      neq0_conv one_neq_zero plus_eq_zero_2 zero_mpoly.rep_eq)
   then show ?thesis
     apply (auto simp: vars_def times_mpoly.rep_eq Var.rep_eq
     elim!: in_keys_timesE dest: keys_add')
     apply (auto simp: keys_def lookup_times_monomial_left Var.rep_eq Var\<^sub>0_def adds_def
       lookup_add eq_diff_eq'[symmetric])
     done
 qed
 
 lemma keys_mult_monomial:
   \<open>keys (monomial (n :: int) k * mapping_of a) = (if n = 0 then {} else ((+) k) ` keys (mapping_of a))\<close>
 proof -
   have [simp]: \<open>(\<Sum>aa. (if k = aa then n else 0) *
                (\<Sum>q. lookup (mapping_of a) q when k + xa = aa + q)) =
         (\<Sum>aa. (if k = aa then n * (\<Sum>q. lookup (mapping_of a) q when k + xa = aa + q) else 0))\<close>
       for xa
-    by (smt Sum_any.cong mult_not_zero)
+    by (smt (verit) Sum_any.cong mult_not_zero)
   show ?thesis
     apply (auto simp: vars_def times_mpoly.rep_eq Const.rep_eq times_poly_mapping.rep_eq
       Const\<^sub>0_def elim!: in_keys_timesE split: if_splits)
     apply (auto simp: lookup_monomial_If prod_fun_def
       keys_def times_poly_mapping.rep_eq)
     done
 qed
 
 lemma vars_mult_Const:
   \<open>vars (Const n * a) = (if n = 0 then {} else vars a)\<close> for a :: \<open>int mpoly\<close>
   by (auto simp: vars_def times_mpoly.rep_eq Const.rep_eq keys_mult_monomial
     Const\<^sub>0_def elim!: in_keys_timesE split: if_splits)
 
 lemma coeff_minus: "coeff p m - coeff q m = coeff (p-q) m"
   by (simp add: coeff_def lookup_minus minus_mpoly.rep_eq)
 
 lemma Const_1_eq_1: \<open>Const (1 :: int) = (1 :: int mpoly)\<close>
   by (simp add: Const.abs_eq Const\<^sub>0_one one_mpoly.abs_eq)
 
 lemma [simp]:
   \<open>vars (1 :: int mpoly) = {}\<close>
   by (auto simp: vars_def one_mpoly.rep_eq Const_1_eq_1)
 
 
 subsection \<open>More Ideals\<close>
 
 lemma
   fixes A :: \<open>(('x \<Rightarrow>\<^sub>0 nat) \<Rightarrow>\<^sub>0 'a::comm_ring_1) set\<close>
   assumes \<open>p \<in> ideal A\<close>
   shows \<open>p * q \<in> ideal A\<close>
   by (metis assms ideal.span_scale semiring_normalization_rules(7))
 
 
 text \<open>The following theorem is very close to @{thm ideal.span_insert}, except that it
 is more useful if we need to take an element of \<^term>\<open>More_Modules.ideal (insert a S)\<close>.\<close>
 lemma ideal_insert':
   \<open>More_Modules.ideal (insert a S) = {y. \<exists>x k. y = x + k * a \<and> x \<in> More_Modules.ideal S}\<close>
     apply (auto simp: ideal.span_insert
       intro: exI[of _ \<open>_ - k * a\<close>])
    apply (rule_tac x = \<open>x - k * a\<close> in exI)
    apply auto
    apply (rule_tac x = \<open>k\<close> in exI)
    apply auto
    done
 
 lemma ideal_mult_right_in:
   \<open>a \<in> ideal A \<Longrightarrow> a * b \<in> More_Modules.ideal A\<close>
   by (metis ideal.span_scale mult.commute)
 
 lemma ideal_mult_right_in2:
   \<open>a \<in> ideal A \<Longrightarrow> b * a \<in> More_Modules.ideal A\<close>
   by (metis ideal.span_scale)
 
 
 lemma [simp]: \<open>vars (Var x :: 'a :: {zero_neq_one} mpoly) = {x}\<close>
   by (auto simp: vars_def Var.rep_eq  Var\<^sub>0_def)
 
 lemma vars_minus_Var_subset:
   \<open>vars (p' - Var x :: 'a :: {ab_group_add,one,zero_neq_one} mpoly) \<subseteq>  \<V> \<Longrightarrow> vars p' \<subseteq> insert x \<V>\<close>
   using vars_add[of \<open>p' - Var x\<close> \<open>Var x\<close>]
   by auto
 
 lemma vars_add_Var_subset:
   \<open>vars (p' + Var x :: 'a :: {ab_group_add,one,zero_neq_one} mpoly) \<subseteq>  \<V> \<Longrightarrow> vars p' \<subseteq> insert x \<V>\<close>
   using vars_add[of \<open>p' + Var x\<close> \<open>-Var x\<close>]
   by auto
 
 lemma coeff_monomila_in_varsD:
   \<open>coeff p (monomial (Suc 0) x) \<noteq> 0 \<Longrightarrow> x \<in> vars (p :: int mpoly)\<close>
   by (auto simp: coeff_def vars_def keys_def
     intro!: exI[of _ \<open>monomial (Suc 0) x\<close>])
 
 lemma coeff_MPoly_monomial[simp]:
   \<open>(MPoly_Type.coeff (MPoly (monomial a m)) m) = a\<close>
   by (metis MPoly_Type.coeff_def lookup_single_eq monom.abs_eq monom.rep_eq)
 
 end
\ No newline at end of file
diff --git a/thys/PAC_Checker/PAC_Specification.thy b/thys/PAC_Checker/PAC_Specification.thy
--- a/thys/PAC_Checker/PAC_Specification.thy
+++ b/thys/PAC_Checker/PAC_Specification.thy
@@ -1,575 +1,575 @@
 (*
   File:         PAC_Specification.thy
   Author:       Mathias Fleury, Daniela Kaufmann, JKU
   Maintainer:   Mathias Fleury, JKU
 *)
 theory PAC_Specification
   imports PAC_More_Poly
 begin
 
 
 section \<open>Specification of the PAC checker\<close>
 
 subsection \<open>Ideals\<close>
 
 type_synonym int_poly = \<open>int mpoly\<close>
 definition polynomial_bool :: \<open>int_poly set\<close> where
   \<open>polynomial_bool = (\<lambda>c. Var c ^ 2 - Var c) ` UNIV\<close>
 
 definition pac_ideal where
   \<open>pac_ideal A \<equiv> ideal (A \<union> polynomial_bool)\<close>
 
 lemma X2_X_in_pac_ideal:
   \<open>Var c ^ 2 - Var c \<in> pac_ideal A\<close>
   unfolding polynomial_bool_def pac_ideal_def
   by (auto intro: ideal.span_base)
 
 lemma pac_idealI1[intro]:
   \<open>p \<in> A \<Longrightarrow> p \<in> pac_ideal A\<close>
   unfolding pac_ideal_def
   by (auto intro: ideal.span_base)
 
 lemma pac_idealI2[intro]:
   \<open>p \<in> ideal A \<Longrightarrow> p \<in> pac_ideal A\<close>
   using ideal.span_subspace_induct pac_ideal_def by blast
 
 lemma pac_idealI3[intro]:
   \<open>p \<in> ideal A \<Longrightarrow> p*q \<in> pac_ideal A\<close>
   by (metis ideal.span_scale mult.commute pac_idealI2)
 
 lemma pac_ideal_Xsq2_iff:
   \<open>Var c ^ 2 \<in> pac_ideal A \<longleftrightarrow> Var c \<in> pac_ideal A\<close>
   unfolding pac_ideal_def
   apply (subst (2) ideal.span_add_eq[symmetric, OF X2_X_in_pac_ideal[of c, unfolded pac_ideal_def]])
   apply auto
   done
 
 lemma diff_in_polynomial_bool_pac_idealI:
    assumes a1: "p \<in> pac_ideal A"
    assumes a2: "p - p' \<in> More_Modules.ideal polynomial_bool"
    shows \<open>p' \<in> pac_ideal A\<close>
  proof -
    have "insert p polynomial_bool \<subseteq> pac_ideal A"
      using a1 unfolding pac_ideal_def by (meson ideal.span_superset insert_subset le_sup_iff)
    then show ?thesis
      using a2 unfolding pac_ideal_def by (metis (no_types) ideal.eq_span_insert_eq ideal.span_subset_spanI ideal.span_superset insert_subset subsetD)
 qed
 
 lemma diff_in_polynomial_bool_pac_idealI2:
    assumes a1: "p \<in> A"
    assumes a2: "p - p' \<in> More_Modules.ideal polynomial_bool"
    shows \<open>p' \<in> pac_ideal A\<close>
    using diff_in_polynomial_bool_pac_idealI[OF _ assms(2), of A] assms(1)
    by (auto simp: ideal.span_base)
 
 lemma pac_ideal_alt_def:
   \<open>pac_ideal A = ideal (A \<union> ideal polynomial_bool)\<close>
   unfolding pac_ideal_def
   by (meson ideal.span_eq ideal.span_mono ideal.span_superset le_sup_iff subset_trans sup_ge2)
 
 text \<open>
 
   The equality on ideals is restricted to polynomials whose variable
   appear in the set of ideals. The function restrict sets:
 
 \<close>
 definition restricted_ideal_to where
   \<open>restricted_ideal_to B A = {p \<in> A. vars p  \<subseteq> B}\<close>
 
 abbreviation restricted_ideal_to\<^sub>I where
   \<open>restricted_ideal_to\<^sub>I B A \<equiv> restricted_ideal_to B (pac_ideal (set_mset A))\<close>
 
 abbreviation restricted_ideal_to\<^sub>V where
   \<open>restricted_ideal_to\<^sub>V B \<equiv> restricted_ideal_to (\<Union>(vars ` set_mset B))\<close>
 
 abbreviation restricted_ideal_to\<^sub>V\<^sub>I where
   \<open>restricted_ideal_to\<^sub>V\<^sub>I B A \<equiv> restricted_ideal_to (\<Union>(vars ` set_mset B)) (pac_ideal (set_mset A))\<close>
 
 
 lemma restricted_idealI:
   \<open>p \<in> pac_ideal (set_mset A) \<Longrightarrow> vars p \<subseteq> C \<Longrightarrow> p \<in> restricted_ideal_to\<^sub>I C A\<close>
   unfolding restricted_ideal_to_def
   by auto
 
 lemma pac_ideal_insert_already_in:
   \<open>pq \<in> pac_ideal (set_mset A) \<Longrightarrow> pac_ideal (insert pq (set_mset A)) = pac_ideal (set_mset A)\<close>
   by (auto simp: pac_ideal_alt_def ideal.span_insert_idI)
 
 lemma pac_ideal_add:
   \<open>p \<in># A \<Longrightarrow> q \<in># A \<Longrightarrow> p + q \<in> pac_ideal (set_mset A)\<close>
   by (simp add: ideal.span_add ideal.span_base pac_ideal_def)
 lemma pac_ideal_mult:
   \<open>p \<in># A \<Longrightarrow> p * q \<in> pac_ideal (set_mset A)\<close>
   by (simp add: ideal.span_base pac_idealI3)
 
 lemma pac_ideal_mono:
   \<open>A \<subseteq> B \<Longrightarrow> pac_ideal A \<subseteq> pac_ideal B\<close>
   using ideal.span_mono[of \<open>A \<union> _\<close> \<open>B \<union> _\<close>]
   by (auto simp: pac_ideal_def intro: ideal.span_mono)
 
 
 subsection \<open>PAC Format\<close>
 
 text \<open>The PAC format contains three kind of steps:
   \<^item> \<^verbatim>\<open>add\<close> that adds up two polynomials that are known.
   \<^item> \<^verbatim>\<open>mult\<close> that multiply a known polynomial with another one.
   \<^item> \<^verbatim>\<open>del\<close> that removes a polynomial that cannot be reused anymore.
 
 To model the simplification that happens, we add the \<^term>\<open>p - p' \<in> polynomial_bool\<close>
 stating that \<^term>\<open>p\<close> and  \<^term>\<open>p'\<close> are equivalent.
 \<close>
 
 type_synonym pac_st = \<open>(nat set \<times> int_poly multiset)\<close>
 
 inductive PAC_Format :: \<open>pac_st \<Rightarrow> pac_st \<Rightarrow> bool\<close> where
 add:
   \<open>PAC_Format (\<V>, A) (\<V>, add_mset p' A)\<close>
 if
    \<open>p \<in># A\<close> \<open>q \<in># A\<close>
    \<open>p+q - p' \<in> ideal polynomial_bool\<close>
    \<open>vars p' \<subseteq> \<V>\<close> |
 mult:
   \<open>PAC_Format (\<V>, A) (\<V>, add_mset p' A)\<close>
 if
    \<open>p \<in># A\<close>
    \<open>p*q - p' \<in> ideal polynomial_bool\<close>
    \<open>vars p' \<subseteq> \<V>\<close>
    \<open>vars q \<subseteq> \<V>\<close> |
 del:
    \<open>p \<in># A \<Longrightarrow> PAC_Format (\<V>, A) (\<V>, A - {#p#})\<close> |
 extend_pos:
   \<open>PAC_Format (\<V>, A) (\<V> \<union> {x' \<in> vars (-Var x + p'). x' \<notin> \<V>}, add_mset (-Var x + p') A)\<close>
   if
     \<open>(p')\<^sup>2 - p' \<in> ideal polynomial_bool\<close>
     \<open>vars p' \<subseteq> \<V>\<close>
     \<open>x \<notin> \<V>\<close>
 
 text  \<open>
   In the PAC format above, we have a technical condition on the
   normalisation: \<^term>\<open>vars p' \<subseteq> vars (p + q)\<close> is here to ensure that
   we don't normalise \<^term>\<open>0 :: int mpoly\<close> to  \<^term>\<open>Var x^2 - Var x :: int mpoly\<close>
   for a new variable \<^term>\<open>x :: nat\<close>. This is completely obvious for the normalisation
   process we have in mind when we write the specification, but we must add it
   explicitly because we are too general.
 \<close>
 
 lemmas  PAC_Format_induct_split =
    PAC_Format.induct[split_format(complete), of V A V' A' for V A V' A']
 
 lemma PAC_Format_induct[consumes 1, case_names add mult del ext]:
   assumes
     \<open>PAC_Format (\<V>, A) (\<V>', A')\<close> and
     cases:
       \<open>\<And>p q p'  A \<V>. p \<in># A \<Longrightarrow> q \<in># A \<Longrightarrow> p+q - p' \<in> ideal polynomial_bool \<Longrightarrow> vars p' \<subseteq> \<V> \<Longrightarrow> P \<V> A \<V> (add_mset p' A)\<close>
       \<open>\<And>p q p' A \<V>. p \<in># A \<Longrightarrow> p*q - p' \<in> ideal polynomial_bool \<Longrightarrow> vars p' \<subseteq> \<V> \<Longrightarrow> vars q \<subseteq> \<V> \<Longrightarrow>
         P \<V> A \<V> (add_mset p' A)\<close>
       \<open>\<And>p A \<V>. p \<in># A \<Longrightarrow> P \<V> A \<V> (A - {#p#})\<close>
       \<open>\<And>p' x r.
         (p')^2 - (p') \<in> ideal polynomial_bool \<Longrightarrow> vars p' \<subseteq> \<V> \<Longrightarrow>
         x \<notin> \<V> \<Longrightarrow> P \<V> A (\<V> \<union> {x' \<in> vars (p' - Var x). x' \<notin> \<V>}) (add_mset (p' -Var x) A)\<close>
   shows
      \<open>P \<V> A \<V>' A'\<close>
   using assms(1) apply -
   by (induct V\<equiv>\<V> A\<equiv>A \<V>' A' rule: PAC_Format_induct_split)
    (auto intro: assms(1) cases)
 
 
 text \<open>
 
 The theorem below (based on the proof ideal by Manuel Kauers) is the
 correctness theorem of extensions. Remark that the assumption \<^term>\<open>vars
 q \<subseteq> \<V>\<close> is only used to show that \<^term>\<open>x' \<notin> vars q\<close>.
 
 \<close>
 lemma extensions_are_safe:
   assumes \<open>x' \<in> vars p\<close> and
     x': \<open>x' \<notin> \<V>\<close> and
     \<open>\<Union> (vars ` set_mset A) \<subseteq> \<V>\<close> and
     p_x_coeff: \<open>coeff p (monomial (Suc 0) x') = 1\<close> and
     vars_q: \<open>vars q \<subseteq> \<V>\<close> and
     q: \<open>q \<in> More_Modules.ideal (insert p (set_mset A \<union> polynomial_bool))\<close> and
     leading: \<open>x' \<notin> vars (p - Var x')\<close> and
     diff: \<open>(Var x' - p)\<^sup>2 - (Var x' - p) \<in> More_Modules.ideal polynomial_bool\<close>
   shows
     \<open>q \<in> More_Modules.ideal (set_mset A \<union> polynomial_bool)\<close>
 proof -
   define p' where \<open>p' \<equiv> p - Var x'\<close>
   let ?v = \<open>Var x' :: int mpoly\<close>
   have p_p': \<open>p = ?v + p'\<close>
     by (auto simp: p'_def)
   define q' where \<open>q' \<equiv> Var x' - p\<close>
   have q_q': \<open>p = ?v - q'\<close>
     by (auto simp: q'_def)
   have diff: \<open>q'^2 - q' \<in> More_Modules.ideal polynomial_bool\<close>
     using diff unfolding q_q' by auto
 
   have [simp]: \<open>vars ((Var c)\<^sup>2 - Var c :: int mpoly) = {c}\<close> for c
     apply (auto simp: vars_def Var_def Var\<^sub>0_def mpoly.MPoly_inverse keys_def lookup_minus_fun
       lookup_times_monomial_right single.rep_eq split: if_splits)
     apply (auto simp: vars_def Var_def Var\<^sub>0_def mpoly.MPoly_inverse keys_def lookup_minus_fun
       lookup_times_monomial_right single.rep_eq when_def ac_simps adds_def lookup_plus_fun
       power2_eq_square times_mpoly.rep_eq minus_mpoly.rep_eq split: if_splits)
     apply (rule_tac x = \<open>(2 :: nat \<Rightarrow>\<^sub>0 nat) * monomial (Suc 0) c\<close> in exI)
     apply (auto dest: monomial_0D simp: plus_eq_zero_2 lookup_plus_fun mult_2)
     by (meson Suc_neq_Zero monomial_0D plus_eq_zero_2)
 
 
   have eq: \<open>More_Modules.ideal (insert p (set_mset A \<union> polynomial_bool)) =
       More_Modules.ideal (insert p (set_mset A \<union> (\<lambda>c. Var c ^ 2 - Var c) ` {c. c \<noteq> x'}))\<close>
       (is \<open>?A = ?B\<close> is \<open>_ = More_Modules.ideal ?trimmed\<close>)
   proof -
      let ?C = \<open>insert p (set_mset A \<union> (\<lambda>c. Var c ^ 2 - Var c) ` {c. c \<noteq> x'})\<close>
      let ?D = \<open>(\<lambda>c. Var c ^ 2 - Var c) ` {c. c \<noteq> x'}\<close>
      have diff: \<open>q'^2 - q' \<in> More_Modules.ideal ?D\<close> (is \<open>?q \<in> _\<close>)
      proof -
        obtain r t where
          q: \<open>?q = (\<Sum>a\<in>t. r a * a)\<close> and
          fin_t: \<open>finite t\<close> and
          t: \<open>t \<subseteq> polynomial_bool\<close>
          using diff unfolding ideal.span_explicit
          by auto
        show ?thesis
        proof (cases \<open>?v^2-?v \<notin> t\<close>)
          case True
          then show \<open>?thesis\<close>
            using q fin_t t unfolding ideal.span_explicit
            by (auto intro!: exI[of _ \<open>t - {?v^2 -?v}\<close>] exI[of _ r]
              simp: polynomial_bool_def sum_diff1)
         next
           case False
           define t' where \<open>t' = t - {?v^2 - ?v}\<close>
           have t_t': \<open>t = insert (?v^2 - ?v) t'\<close> and
             notin: \<open>?v^2 - ?v \<notin> t'\<close> and
             \<open>t' \<subseteq> (\<lambda>c. Var c ^ 2 - Var c) ` {c. c \<noteq> x'}\<close>
             using False t unfolding t'_def polynomial_bool_def by auto
           have mon: \<open>monom (monomial (Suc 0) x') 1 = Var x'\<close>
             by (auto simp: coeff_def minus_mpoly.rep_eq Var_def Var\<^sub>0_def monom_def
               times_mpoly.rep_eq lookup_minus lookup_times_monomial_right mpoly.MPoly_inverse)
           then have \<open>\<forall>a. \<exists>g h. r a = ?v * g + h \<and> x' \<notin> vars h\<close>
             using polynomial_split_on_var[of \<open>r _\<close> x']
             by metis
           then obtain g h where
             r: \<open>r a = ?v * g a + h a\<close> and
             x'_h: \<open>x' \<notin> vars (h a)\<close> for a
             using polynomial_split_on_var[of \<open>r a\<close> x']
             by metis
           have  \<open>?q = ((\<Sum>a\<in>t'. g a * a) + r (?v^2-?v) * (?v - 1)) * ?v + (\<Sum>a\<in>t'. h a * a)\<close>
             using fin_t notin unfolding t_t' q r
             by (auto simp: field_simps comm_monoid_add_class.sum.distrib
               power2_eq_square ideal.scale_left_commute sum_distrib_left)
           moreover have \<open>x' \<notin> vars ?q\<close>
             by (metis (no_types, opaque_lifting) Groups.add_ac(2) Un_iff add_diff_cancel_left'
               diff_minus_eq_add in_mono leading q'_def semiring_normalization_rules(29)
               vars_in_right_only vars_mult)
           moreover {
             have \<open>x' \<notin> (\<Union>m\<in>t' - {?v^2-?v}. vars (h m * m))\<close>
               using fin_t x'_h vars_mult[of \<open>h _\<close>] \<open>t \<subseteq> polynomial_bool\<close>
               by (auto simp: polynomial_bool_def t_t' elim!: vars_unE)
             then have \<open>x' \<notin> vars (\<Sum>a\<in>t'. h a * a)\<close>
               using vars_setsum[of \<open>t'\<close> \<open>\<lambda>a. h a * a\<close>] fin_t x'_h t notin
               by (auto simp: t_t')
           }
           ultimately have \<open>?q = (\<Sum>a\<in>t'. h a * a)\<close>
             unfolding mon[symmetric]
             by (rule polynomial_decomp_alien_var(2)[unfolded])
           then show ?thesis
             using t fin_t \<open>t' \<subseteq> (\<lambda>c. Var c ^ 2 - Var c) ` {c. c \<noteq> x'}\<close>
             unfolding ideal.span_explicit t_t'
             by auto
        qed
     qed
     have eq1: \<open>More_Modules.ideal (insert p (set_mset A \<union> polynomial_bool)) =
       More_Modules.ideal (insert (?v^2 - ?v) ?C)\<close>
       (is \<open>More_Modules.ideal _ = More_Modules.ideal (insert _ ?C)\<close>)
       by (rule arg_cong[of _ _ More_Modules.ideal])
        (auto simp: polynomial_bool_def)
     moreover have \<open>?v^2 - ?v \<in> More_Modules.ideal ?C\<close>
     proof -
       have \<open>?v - q' \<in> More_Modules.ideal ?C\<close>
         by (auto simp: q_q' ideal.span_base)
       from ideal.span_scale[OF this, of \<open>?v + q' - 1\<close>] have \<open>(?v - q') * (?v + q' - 1) \<in> More_Modules.ideal ?C\<close>
         by (auto simp: field_simps)
       moreover have \<open>q'^2 - q' \<in> More_Modules.ideal ?C\<close>
-        using diff by (smt Un_insert_right ideal.span_mono insert_subset subsetD sup_ge2)
+        using diff by (smt (verit) Un_insert_right ideal.span_mono insert_subset subsetD sup_ge2)
       ultimately have \<open>(?v - q') * (?v + q' - 1) + (q'^2 - q') \<in> More_Modules.ideal ?C\<close>
         by (rule ideal.span_add)
       moreover have \<open>?v^2 - ?v = (?v - q') * (?v + q' - 1) + (q'^2 - q')\<close>
         by (auto simp: p'_def q_q' field_simps power2_eq_square)
       ultimately show ?thesis by simp
     qed
     ultimately show ?thesis
       using ideal.span_insert_idI by blast
   qed
 
   have \<open>n < m \<Longrightarrow> n > 0 \<Longrightarrow> \<exists>q. ?v^n = ?v + q * (?v^2 - ?v)\<close> for n m :: nat
   proof (induction m arbitrary: n)
     case 0
     then show ?case by auto
   next
     case (Suc m n) note IH = this(1-)
     consider
       \<open>n < m\<close> |
       \<open>m = n\<close> \<open>n > 1\<close> |
       \<open>n = 1\<close>
       using IH
       by (cases \<open>n < m\<close>; cases n) auto
     then show ?case
     proof cases
       case 1
       then show ?thesis using IH by auto
     next
       case 2
       have eq: \<open>?v^(n) = ((?v :: int mpoly) ^ (n-2)) * (?v^2-?v) + ?v^(n-1)\<close>
         using 2 by (auto simp: field_simps power_eq_if
           ideal.scale_right_diff_distrib)
       obtain q where
         q: \<open>?v^(n-1) = ?v + q * (?v^2 - ?v)\<close>
         using IH(1)[of \<open>n-1\<close>] 2
         by auto
       show ?thesis
         using q unfolding eq
         by (auto intro!: exI[of _ \<open>Var x' ^ (n - 2) + q\<close>] simp: distrib_right)
     next
       case 3
       then show \<open>?thesis\<close>
         by auto
     qed
   qed
 
   obtain r t where
     q: \<open>q = (\<Sum>a\<in>t. r a * a)\<close> and
     fin_t: \<open>finite t\<close> and
     t: \<open>t \<subseteq> ?trimmed\<close>
     using q unfolding eq unfolding ideal.span_explicit
     by auto
 
 
   define t' where \<open>t' \<equiv> t - {p}\<close>
   have t': \<open>t = (if p \<in> t then insert p t' else t')\<close> and
     t''[simp]: \<open>p \<notin> t'\<close>
     unfolding t'_def by auto
   show ?thesis
   proof (cases \<open>r p = 0 \<or> p \<notin> t\<close>)
     case True
     have
       q: \<open>q = (\<Sum>a\<in>t'. r a * a)\<close> and
      fin_t: \<open>finite t'\<close> and
       t: \<open>t' \<subseteq> set_mset A \<union> polynomial_bool\<close>
       using q fin_t t True t''
       apply (subst (asm) t')
       apply (auto intro: sum.cong simp: sum.insert_remove t'_def)
       using q fin_t t True t''
       apply (auto intro: sum.cong simp: sum.insert_remove t'_def polynomial_bool_def)
       done
     then show ?thesis
       by (auto simp: ideal.span_explicit)
   next
     case False
     then have \<open>r p \<noteq> 0\<close> and \<open>p \<in> t\<close>
       by auto
     then have t: \<open>t = insert p t'\<close>
       by (auto simp: t'_def)
 
    have \<open>x' \<notin> vars (- p')\<close>
      using leading p'_def vars_in_right_only by fastforce
    have mon: \<open>monom (monomial (Suc 0) x') 1 = Var x'\<close>
      by (auto simp:coeff_def minus_mpoly.rep_eq Var_def Var\<^sub>0_def monom_def
        times_mpoly.rep_eq lookup_minus lookup_times_monomial_right mpoly.MPoly_inverse)
    then have \<open>\<forall>a. \<exists>g h. r a = (?v + p') * g + h \<and> x' \<notin> vars h\<close>
      using polynomial_split_on_var2[of x' \<open>-p'\<close> \<open>r _\<close>]  \<open>x' \<notin> vars (- p')\<close>
      by (metis diff_minus_eq_add)
    then obtain g h where
      r: \<open>r a = p * g a + h a\<close> and
      x'_h: \<open>x' \<notin> vars (h a)\<close> for a
      using polynomial_split_on_var2[of x' p' \<open>r a\<close>] unfolding p_p'[symmetric]
      by metis
 
 
   have ISABLLE_come_on: \<open>a * (p * g a) = p * (a * g a)\<close> for a
     by auto
   have q1: \<open>q = p * (\<Sum>a\<in>t'. g a * a) + (\<Sum>a\<in>t'. h a * a) + p * r p\<close>
     (is \<open>_ = _ + ?NOx' + _\<close>)
     using fin_t t'' unfolding q t ISABLLE_come_on r
     apply (subst semiring_class.distrib_right)+
     apply (auto simp: comm_monoid_add_class.sum.distrib semigroup_mult_class.mult.assoc
       ISABLLE_come_on simp flip: semiring_0_class.sum_distrib_right
          semiring_0_class.sum_distrib_left)
     by (auto simp: field_simps)
   also have \<open>... = ((\<Sum>a\<in>t'. g a * a) + r p) * p + (\<Sum>a\<in>t'. h a * a)\<close>
     by (auto simp: field_simps)
   finally have q_decomp: \<open>q = ((\<Sum>a\<in>t'. g a * a) + r p) * p + (\<Sum>a\<in>t'. h a * a)\<close>
     (is \<open>q = ?X * p + ?NOx'\<close>).
 
 
    have [iff]: \<open>monomial (Suc 0) c = 0 - monomial (Suc 0) c = False\<close> for c
      by (metis One_nat_def diff_is_0_eq' le_eq_less_or_eq less_Suc_eq_le monomial_0_iff single_diff zero_neq_one)
   have \<open>x \<in> t' \<Longrightarrow> x' \<in> vars x \<Longrightarrow> False\<close> for x
     using  \<open>t \<subseteq> ?trimmed\<close> t assms(2,3)
     apply (auto simp: polynomial_bool_def dest!: multi_member_split)
     apply (frule set_rev_mp)
     apply assumption
     apply (auto dest!: multi_member_split)
     done
    then have \<open>x' \<notin> (\<Union>m\<in>t'. vars (h m * m))\<close>
      using fin_t x'_h vars_mult[of \<open>h _\<close>]
      by (auto simp: t elim!: vars_unE)
    then have \<open>x' \<notin> vars ?NOx'\<close>
      using vars_setsum[of \<open>t'\<close> \<open>\<lambda>a. h a * a\<close>] fin_t x'_h
      by (auto simp: t)
 
   moreover {
     have \<open>x' \<notin> vars p'\<close>
       using assms(7)
       unfolding p'_def
       by auto
     then have \<open>x' \<notin> vars (h p * p')\<close>
       using vars_mult[of \<open>h p\<close> p'] x'_h
       by auto
   }
   ultimately have
     \<open>x' \<notin> vars q\<close>
     \<open>x' \<notin> vars ?NOx'\<close>
     \<open>x' \<notin> vars p'\<close>
     using x' vars_q vars_add[of \<open>h p * p'\<close> \<open>\<Sum>a\<in>t'. h a * a\<close>] x'_h
       leading p'_def
     by auto
   then have \<open>?X = 0\<close> and q_decomp: \<open>q = ?NOx'\<close>
     unfolding mon[symmetric] p_p'
     using polynomial_decomp_alien_var2[OF q_decomp[unfolded p_p' mon[symmetric]]]
     by auto
 
   then have \<open>r p = (\<Sum>a\<in>t'. (- g a) * a)\<close>
     (is \<open>_ = ?CL\<close>)
     unfolding add.assoc add_eq_0_iff equation_minus_iff
     by (auto simp: sum_negf ac_simps)
 
 
   then have q2: \<open>q = (\<Sum>a\<in>t'. a * (r a - p * g a))\<close>
     using fin_t unfolding q
     apply (auto simp: t r q
          comm_monoid_add_class.sum.distrib[symmetric]
          sum_distrib_left
          sum_distrib_right
          left_diff_distrib
         intro!: sum.cong)
     apply (auto simp: field_simps)
     done
   then show \<open>?thesis\<close>
     using t fin_t \<open>t \<subseteq> ?trimmed\<close> unfolding ideal.span_explicit
     by (auto intro!: exI[of _ t'] exI[of _ \<open>\<lambda>a. r a - p * g a\<close>]
       simp: field_simps polynomial_bool_def)
   qed
 qed
 
 lemma extensions_are_safe_uminus:
   assumes \<open>x' \<in> vars p\<close> and
     x': \<open>x' \<notin> \<V>\<close> and
     \<open>\<Union> (vars ` set_mset A) \<subseteq> \<V>\<close> and
     p_x_coeff: \<open>coeff p (monomial (Suc 0) x') = -1\<close> and
     vars_q: \<open>vars q \<subseteq> \<V>\<close> and
     q: \<open>q \<in> More_Modules.ideal (insert p (set_mset A \<union> polynomial_bool))\<close> and
     leading: \<open>x' \<notin> vars (p + Var x')\<close> and
     diff: \<open>(Var x' + p)^2 - (Var x' + p) \<in> More_Modules.ideal polynomial_bool\<close>
   shows
     \<open>q \<in> More_Modules.ideal (set_mset A \<union> polynomial_bool)\<close>
 proof -
   have \<open>q \<in> More_Modules.ideal (insert (- p) (set_mset A \<union> polynomial_bool))\<close>
     by (metis ideal.span_breakdown_eq minus_mult_minus q)
 
   then show ?thesis
     using extensions_are_safe[of x' \<open>-p\<close> \<V> A q] assms
     using vars_in_right_only by force
 qed
 
 text \<open>This is the correctness theorem of a PAC step: no polynomials are
 added to the ideal.\<close>
 
 lemma vars_subst_in_left_only:
   \<open>x \<notin> vars p \<Longrightarrow> x \<in> vars (p - Var x)\<close> for p :: \<open>int mpoly\<close>
   by (metis One_nat_def Var.abs_eq Var\<^sub>0_def group_eq_aux monom.abs_eq mult_numeral_1 polynomial_decomp_alien_var(1) zero_neq_numeral)
 
 lemma vars_subst_in_left_only_diff_iff:
   fixes p :: \<open>int mpoly\<close>
   assumes \<open>x \<notin> vars p\<close>
   shows \<open>vars (p - Var x) = insert x (vars p)\<close>
 proof -
   have \<open>\<And>xa. x \<notin> vars p \<Longrightarrow> xa \<in> vars (p - Var x) \<Longrightarrow> xa \<notin> vars p \<Longrightarrow> xa = x\<close>
     by (metis (no_types, opaque_lifting) diff_0_right diff_minus_eq_add empty_iff in_vars_addE insert_iff
       keys_single minus_diff_eq monom_one mult.right_neutral one_neq_zero single_zero
       vars_monom_keys vars_mult_Var vars_uminus)
   moreover have \<open>\<And>xa. x \<notin> vars p \<Longrightarrow> xa \<in> vars p \<Longrightarrow> xa \<in> vars (p - Var x)\<close>
     by (metis add.inverse_inverse diff_minus_eq_add empty_iff insert_iff keys_single minus_diff_eq
       monom_one mult.right_neutral one_neq_zero single_zero vars_in_right_only vars_monom_keys
       vars_mult_Var vars_uminus)
   ultimately show ?thesis
     using assms
     by (auto simp: vars_subst_in_left_only)
 qed
 
 lemma vars_subst_in_left_only_iff:
   \<open>x \<notin> vars p \<Longrightarrow> vars (p + Var x) = insert x (vars p)\<close> for p :: \<open>int mpoly\<close>
   using vars_subst_in_left_only_diff_iff[of x \<open>-p\<close>]
   by (metis diff_0 diff_diff_add vars_uminus)
 
 lemma coeff_add_right_notin:
   \<open>x \<notin> vars p \<Longrightarrow> MPoly_Type.coeff (Var x - p) (monomial (Suc 0) x) = 1\<close>
   apply (auto simp flip: coeff_minus simp: not_in_vars_coeff0)
   by (simp add: MPoly_Type.coeff_def Var.rep_eq Var\<^sub>0_def)
 
 lemma coeff_add_left_notin:
   \<open>x \<notin> vars p \<Longrightarrow> MPoly_Type.coeff (p - Var x) (monomial (Suc 0) x) = -1\<close> for p :: \<open>int mpoly\<close>
   apply (auto simp flip: coeff_minus simp: not_in_vars_coeff0)
   by (simp add: MPoly_Type.coeff_def Var.rep_eq Var\<^sub>0_def)
 
 lemma ideal_insert_polynomial_bool_swap: \<open>r - s \<in> ideal polynomial_bool \<Longrightarrow>
   More_Modules.ideal (insert r  (A \<union> polynomial_bool)) = More_Modules.ideal (insert s (A \<union> polynomial_bool))\<close>
   apply auto
   using ideal.eq_span_insert_eq ideal.span_mono sup_ge2 apply blast+
   done
 
 lemma PAC_Format_subset_ideal:
   \<open>PAC_Format (\<V>, A) (\<V>', B) \<Longrightarrow> \<Union>(vars ` set_mset A) \<subseteq> \<V> \<Longrightarrow>
      restricted_ideal_to\<^sub>I \<V> B \<subseteq> restricted_ideal_to\<^sub>I \<V> A \<and> \<V> \<subseteq> \<V>' \<and> \<Union>(vars ` set_mset B) \<subseteq> \<V>'\<close>
   unfolding restricted_ideal_to_def
   apply (induction rule:PAC_Format_induct)
   subgoal for p q pq A \<V>
     using vars_add
     by (force simp: ideal.span_add_eq ideal.span_base pac_ideal_insert_already_in[OF diff_in_polynomial_bool_pac_idealI[of \<open>p + q\<close> \<open>_\<close> pq]]
         pac_ideal_add
       intro!: diff_in_polynomial_bool_pac_idealI[of \<open>p + q\<close> \<open>_\<close> pq])
   subgoal for p q pq
     using vars_mult[of p q]
     by (force simp: ideal.span_add_eq ideal.span_base pac_ideal_mult
       pac_ideal_insert_already_in[OF diff_in_polynomial_bool_pac_idealI[of \<open>p*q\<close> \<open>_\<close> pq]])
   subgoal for p A
     using pac_ideal_mono[of \<open>set_mset (A - {#p#})\<close> \<open>set_mset A\<close>]
     by (auto dest: in_diffD)
   subgoal for p x' r'
     apply (subgoal_tac \<open>x' \<notin> vars p\<close>)
     using extensions_are_safe_uminus[of x' \<open>-Var x' + p\<close> \<V> A] unfolding pac_ideal_def
     apply (auto simp: vars_subst_in_left_only coeff_add_left_notin)
     done
   done
 
 
 text \<open>
   In general, if deletions are disallowed, then the stronger \<^term>\<open>B = pac_ideal A\<close> holds.
 \<close>
 lemma restricted_ideal_to_restricted_ideal_to\<^sub>ID:
   \<open>restricted_ideal_to \<V> (set_mset A) \<subseteq> restricted_ideal_to\<^sub>I \<V> A\<close>
    by (auto simp add: Collect_disj_eq pac_idealI1 restricted_ideal_to_def)
 
 
 lemma rtranclp_PAC_Format_subset_ideal:
   \<open>rtranclp PAC_Format (\<V>, A) (\<V>', B) \<Longrightarrow> \<Union>(vars ` set_mset A) \<subseteq> \<V> \<Longrightarrow>
      restricted_ideal_to\<^sub>I \<V> B \<subseteq> restricted_ideal_to\<^sub>I \<V> A \<and> \<V> \<subseteq> \<V>' \<and> \<Union>(vars ` set_mset B) \<subseteq> \<V>'\<close>
   apply (induction rule:rtranclp_induct[of PAC_Format \<open>(_, _)\<close> \<open>(_, _)\<close>, split_format(complete)])
   subgoal
     by (simp add: restricted_ideal_to_restricted_ideal_to\<^sub>ID)
   subgoal
     by (drule PAC_Format_subset_ideal)
       (auto simp: restricted_ideal_to_def Collect_mono_iff)
   done
 
 
 end
\ No newline at end of file
diff --git a/thys/PAC_Checker/WB_Sort.thy b/thys/PAC_Checker/WB_Sort.thy
--- a/thys/PAC_Checker/WB_Sort.thy
+++ b/thys/PAC_Checker/WB_Sort.thy
@@ -1,1688 +1,1688 @@
 (*
   File:         WB_Sort.thy
   Author:       Mathias Fleury, Daniela Kaufmann, JKU
   Author:       Maximilian Wuttke, Saarland University
   Maintainer:   Mathias Fleury, JKU
 
 Correctness proof contributed by Maximilian Wuttke *)
 theory WB_Sort
   imports
     Refine_Imperative_HOL.IICF
     "HOL-Library.Rewrite"
     Nested_Multisets_Ordinals.Duplicate_Free_Multiset
 begin
 
 text \<open>This a complete copy-paste of the IsaFoL version because sharing is too hard.\<close>
 
 text \<open>Every element between \<^term>\<open>lo\<close> and \<^term>\<open>hi\<close> can be chosen as pivot element.\<close>
 definition choose_pivot :: \<open>('b \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> 'a list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat nres\<close> where
   \<open>choose_pivot _ _ _ lo hi = SPEC(\<lambda>k. k \<ge> lo \<and> k \<le> hi)\<close>
 
 text \<open>The element at index \<open>p\<close> partitions the subarray \<open>lo..hi\<close>. This means that every element \<close>
 definition isPartition_wrt :: \<open>('b \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> 'b list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> bool\<close> where
   \<open>isPartition_wrt R xs lo hi p \<equiv> (\<forall> i. i \<ge> lo \<and> i < p \<longrightarrow> R (xs!i) (xs!p)) \<and> (\<forall> j. j > p \<and> j \<le> hi \<longrightarrow> R (xs!p) (xs!j))\<close>
 
 lemma isPartition_wrtI:
   \<open>(\<And> i. \<lbrakk>i \<ge> lo; i < p\<rbrakk> \<Longrightarrow> R (xs!i) (xs!p)) \<Longrightarrow> (\<And> j. \<lbrakk>j > p; j \<le> hi\<rbrakk> \<Longrightarrow> R (xs!p) (xs!j)) \<Longrightarrow> isPartition_wrt R xs lo hi p\<close>
   by (simp add: isPartition_wrt_def)
 
 definition isPartition :: \<open>'a :: order list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> bool\<close> where
   \<open>isPartition xs lo hi p \<equiv> isPartition_wrt (\<le>) xs lo hi p\<close>
 
 abbreviation isPartition_map :: \<open>('b \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> 'a list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> bool\<close> where
   \<open>isPartition_map R h xs i j k \<equiv> isPartition_wrt (\<lambda>a b. R (h a) (h b)) xs i j k\<close>
 
 lemma isPartition_map_def':
   \<open>lo \<le> p \<Longrightarrow> p \<le> hi \<Longrightarrow> hi < length xs \<Longrightarrow> isPartition_map R h xs lo hi p = isPartition_wrt R (map h xs) lo hi p\<close>
   by (auto simp add: isPartition_wrt_def conjI)
 
 
 text \<open>Example: 6 is the pivot element (with index 4); \<^term>\<open>7\<close> is equal to the \<^term>\<open>length xs - 1\<close>.\<close>
 lemma \<open>isPartition [0,5,3,4,6,9,8,10::nat] 0 7 4\<close>
   by (auto simp add: isPartition_def isPartition_wrt_def nth_Cons')
 
 
 
 definition sublist :: \<open>'a list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> 'a list\<close> where
 \<open>sublist xs i j \<equiv> take (Suc j - i) (drop i xs)\<close>
 
 (*take from HashMap *)
 lemma take_Suc0:
   "l\<noteq>[] \<Longrightarrow> take (Suc 0) l = [l!0]"
   "0 < length l \<Longrightarrow> take (Suc 0) l = [l!0]"
   "Suc n \<le> length l \<Longrightarrow> take (Suc 0) l = [l!0]"
   by (cases l, auto)+
 
 lemma sublist_single: \<open>i < length xs \<Longrightarrow> sublist xs i i = [xs!i]\<close>
   by (cases xs) (auto simp add: sublist_def take_Suc0)
 
 lemma insert_eq: \<open>insert a b = b \<union> {a}\<close>
   by auto
 
 lemma sublist_nth: \<open>\<lbrakk>lo \<le> hi; hi < length xs; k+lo \<le> hi\<rbrakk> \<Longrightarrow> (sublist xs lo hi)!k = xs!(lo+k)\<close>
   by (simp add: sublist_def)
 
 lemma sublist_length: \<open>\<lbrakk>i \<le> j; j < length xs\<rbrakk> \<Longrightarrow> length (sublist xs i j) = 1 + j - i\<close>
   by (simp add: sublist_def)
 
 lemma sublist_not_empty: \<open>\<lbrakk>i \<le> j; j < length xs; xs \<noteq> []\<rbrakk> \<Longrightarrow> sublist xs i j \<noteq> []\<close>
   apply simp
   apply (rewrite List.length_greater_0_conv[symmetric])
   apply (rewrite sublist_length)
   by auto
 
 
 
 lemma sublist_app: \<open>\<lbrakk>i1 \<le> i2; i2 \<le> i3\<rbrakk> \<Longrightarrow> sublist xs i1 i2 @ sublist xs (Suc i2) i3 = sublist xs i1 i3\<close>
   unfolding sublist_def
-  by (smt Suc_eq_plus1_left Suc_le_mono append.assoc le_SucI le_add_diff_inverse le_trans same_append_eq take_add)
+  by (smt (verit) Suc_eq_plus1_left Suc_le_mono append.assoc le_SucI le_add_diff_inverse le_trans same_append_eq take_add)
 
 definition sorted_sublist_wrt :: \<open>('b \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> 'b list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> bool\<close> where
   \<open>sorted_sublist_wrt R xs lo hi = sorted_wrt R (sublist xs lo hi)\<close>
 
 definition sorted_sublist :: \<open>'a :: linorder list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> bool\<close> where
   \<open>sorted_sublist xs lo hi = sorted_sublist_wrt (\<le>) xs lo hi\<close>
 
 abbreviation sorted_sublist_map :: \<open>('b \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> 'a list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> bool\<close> where
   \<open>sorted_sublist_map R h xs lo hi \<equiv> sorted_sublist_wrt (\<lambda>a b. R (h a) (h b)) xs lo hi\<close>
 
 lemma sorted_sublist_map_def':
   \<open>lo < length xs \<Longrightarrow> sorted_sublist_map R h xs lo hi \<equiv> sorted_sublist_wrt R (map h xs) lo hi\<close>
   apply (simp add: sorted_sublist_wrt_def)
   by (simp add: drop_map sorted_wrt_map sublist_def take_map)
 
 lemma sorted_sublist_wrt_refl: \<open>i < length xs \<Longrightarrow> sorted_sublist_wrt R xs i i\<close>
   by (auto simp add: sorted_sublist_wrt_def sublist_single)
 
 lemma sorted_sublist_refl: \<open>i < length xs \<Longrightarrow> sorted_sublist xs i i\<close>
   by (auto simp add: sorted_sublist_def sorted_sublist_wrt_refl)
 
 lemma sublist_map: \<open>sublist (map f xs) i j = map f (sublist xs i j)\<close>
   apply (auto simp add: sublist_def)
   by (simp add: drop_map take_map)
 
 
 lemma take_set: \<open>j \<le> length xs \<Longrightarrow> x \<in> set (take j xs) \<equiv> (\<exists> k. k < j \<and> xs!k = x)\<close>
   by (rule eq_reflection) (auto simp add: take_set)
 
 lemma drop_set: \<open>j \<le> length xs \<Longrightarrow> x \<in> set (drop j xs) \<equiv> (\<exists>k. j\<le>k\<and>k<length xs \<and> xs!k=x)\<close>
-  by (smt Misc.in_set_drop_conv_nth) (* lemma found by sledgehammer *)
+  by (smt (verit) Misc.in_set_drop_conv_nth) (* lemma found by sledgehammer *)
 
 lemma sublist_el: \<open>i \<le> j \<Longrightarrow> j < length xs \<Longrightarrow> x \<in> set (sublist xs i j) \<equiv> (\<exists> k. k < Suc j-i \<and> xs!(i+k)=x)\<close>
   by (auto simp add: take_set sublist_def)
 
 lemma sublist_el': \<open>i \<le> j \<Longrightarrow> j < length xs \<Longrightarrow> x \<in> set (sublist xs i j) \<equiv> (\<exists> k. i\<le>k\<and>k\<le>j \<and> xs!k=x)\<close>
   apply (subst sublist_el, assumption, assumption)
-  by (smt Groups.add_ac(2) le_add1 le_add_diff_inverse less_Suc_eq less_diff_conv nat_less_le order_refl)
+  by (smt (verit) Groups.add_ac(2) le_add1 le_add_diff_inverse less_Suc_eq less_diff_conv nat_less_le order_refl)
 
 
 lemma sublist_lt: \<open>hi < lo \<Longrightarrow> sublist xs lo hi = []\<close>
   by (auto simp add: sublist_def)
 
 lemma nat_le_eq_or_lt: \<open>(a :: nat) \<le> b = (a = b \<or> a < b)\<close>
   by linarith
 
 
 lemma sorted_sublist_wrt_le: \<open>hi \<le> lo \<Longrightarrow> hi < length xs \<Longrightarrow> sorted_sublist_wrt R xs lo hi\<close>
   apply (auto simp add: nat_le_eq_or_lt)
   unfolding sorted_sublist_wrt_def
   subgoal apply (rewrite sublist_single) by auto
   subgoal by (auto simp add: sublist_lt)
   done
 
 text \<open>Elements in a sorted sublists are actually sorted\<close>
 lemma sorted_sublist_wrt_nth_le:
   assumes \<open>sorted_sublist_wrt R xs lo hi\<close> and \<open>lo \<le> hi\<close> and \<open>hi < length xs\<close> and
     \<open>lo \<le> i\<close> and \<open>i < j\<close> and \<open>j \<le> hi\<close>
   shows \<open>R (xs!i) (xs!j)\<close>
 proof -
   have A: \<open>lo < length xs\<close> using assms(2) assms(3) by linarith
   obtain i' where I: \<open>i = lo + i'\<close> using assms(4) le_Suc_ex by auto
   obtain j' where J: \<open>j = lo + j'\<close> by (meson assms(4) assms(5) dual_order.trans le_iff_add less_imp_le_nat)
   show ?thesis
     using assms(1) apply (simp add: sorted_sublist_wrt_def I J)
     apply (rewrite sublist_nth[symmetric, where k=i', where lo=lo, where hi=hi])
     using assms apply auto subgoal using I by linarith
     apply (rewrite sublist_nth[symmetric, where k=j', where lo=lo, where hi=hi])
     using assms apply auto subgoal using J by linarith
     apply (rule sorted_wrt_nth_less)
     apply auto
     subgoal using I J nat_add_left_cancel_less by blast
     subgoal apply (simp add: sublist_length) using J by linarith
     done
 qed
 
 text \<open>We can make the assumption \<^term>\<open>i < j\<close> weaker if we have a reflexivie relation.\<close>
 lemma sorted_sublist_wrt_nth_le':
   assumes ref: \<open>\<And> x. R x x\<close>
     and \<open>sorted_sublist_wrt R xs lo hi\<close> and \<open>lo \<le> hi\<close> and \<open>hi < length xs\<close>
     and \<open>lo \<le> i\<close> and \<open>i \<le> j\<close> and \<open>j \<le> hi\<close>
   shows \<open>R (xs!i) (xs!j)\<close>
 proof -
   have \<open>i < j \<or> i = j\<close> using \<open>i \<le> j\<close> by linarith
   then consider (a) \<open>i < j\<close> |
                 (b) \<open>i = j\<close> by blast
   then show ?thesis
   proof cases
     case a
     then show ?thesis
       using assms(2-5,7) sorted_sublist_wrt_nth_le by blast
   next
     case b
     then show ?thesis
       by (simp add: ref)
   qed
 qed
 
 
 
 (*
 lemma sorted_sublist_map_nth_le:
   assumes \<open>sorted_sublist_map R h xs lo hi\<close> and \<open>lo \<le> hi\<close> and \<open>hi < length xs\<close> and
     \<open>lo \<le> i\<close> and \<open>i < j\<close> and \<open>j \<le> hi\<close>
   shows \<open>R (h (xs!i)) (h (xs!j))\<close>
 proof -
   show ?thesis
     using assms by (rule sorted_sublist_wrt_nth_le)
 qed
 *)
 
 
 
 lemma sorted_sublist_le: \<open>hi \<le> lo \<Longrightarrow> hi < length xs \<Longrightarrow> sorted_sublist xs lo hi\<close>
   by (auto simp add: sorted_sublist_def sorted_sublist_wrt_le)
 
 lemma sorted_sublist_map_le: \<open>hi \<le> lo \<Longrightarrow> hi < length xs \<Longrightarrow> sorted_sublist_map R h xs lo hi\<close>
   by (auto simp add: sorted_sublist_wrt_le)
 
 lemma sublist_cons: \<open>lo < hi \<Longrightarrow> hi < length xs \<Longrightarrow> sublist xs lo hi = xs!lo # sublist xs (Suc lo) hi\<close>
   by (metis Cons_eq_appendI append_self_conv2 less_imp_le_nat less_or_eq_imp_le less_trans
       sublist_app sublist_single)
 
 lemma sorted_sublist_wrt_cons':
   \<open>sorted_sublist_wrt R xs (lo+1) hi \<Longrightarrow> lo \<le> hi \<Longrightarrow> hi < length xs \<Longrightarrow> (\<forall>j. lo<j\<and>j\<le>hi \<longrightarrow> R (xs!lo) (xs!j)) \<Longrightarrow> sorted_sublist_wrt R xs lo hi\<close>
   apply (auto simp add: nat_le_eq_or_lt sorted_sublist_wrt_def)
   apply (auto 5 4 simp add: sublist_cons sublist_el less_diff_conv add.commute[of _ lo]
       dest: Suc_lessI sublist_single)
   done
 
 lemma sorted_sublist_wrt_cons:
   assumes trans: \<open>(\<And> x y z. \<lbrakk>R x y; R y z\<rbrakk> \<Longrightarrow> R x z)\<close> and
     \<open>sorted_sublist_wrt R xs (lo+1) hi\<close> and
     \<open>lo \<le> hi\<close> and \<open>hi < length xs \<close> and \<open>R (xs!lo) (xs!(lo+1))\<close>
   shows \<open>sorted_sublist_wrt R xs lo hi\<close>
 proof -
   show ?thesis
     apply (rule sorted_sublist_wrt_cons') using assms apply auto
     subgoal premises assms' for j
     proof -
       have A: \<open>j=lo+1 \<or> j>lo+1\<close> using assms'(5) by linarith
       show ?thesis
         using A proof
         assume A: \<open>j=lo+1\<close> show ?thesis
           by (simp add: A assms')
       next
         assume A: \<open>j>lo+1\<close> show ?thesis
           apply (rule trans)
           apply (rule assms(5))
           apply (rule sorted_sublist_wrt_nth_le[OF assms(2), where i=\<open>lo+1\<close>, where j=j])
           subgoal using A assms'(6) by linarith
           subgoal using assms'(3) less_imp_diff_less by blast
           subgoal using assms'(5) by auto
           subgoal using A by linarith
           subgoal by (simp add: assms'(6))
           done
       qed
     qed
     done
 qed
 
 lemma sorted_sublist_map_cons:
   \<open>(\<And> x y z. \<lbrakk>R (h x) (h y); R (h y) (h z)\<rbrakk> \<Longrightarrow> R (h x) (h z)) \<Longrightarrow>
     sorted_sublist_map R h xs (lo+1) hi \<Longrightarrow> lo \<le> hi \<Longrightarrow> hi < length xs \<Longrightarrow> R (h (xs!lo)) (h (xs!(lo+1))) \<Longrightarrow> sorted_sublist_map R h xs lo hi\<close>
   by (blast intro: sorted_sublist_wrt_cons)
 
 
 lemma sublist_snoc: \<open>lo < hi \<Longrightarrow> hi < length xs \<Longrightarrow> sublist xs lo hi = sublist xs lo (hi-1) @ [xs!hi]\<close>
   apply (simp add: sublist_def)
 proof -
   assume a1: "lo < hi"
   assume "hi < length xs"
   then have "take lo xs @ take (Suc hi - lo) (drop lo xs) = (take lo xs @ take (hi - lo) (drop lo xs)) @ [xs ! hi]"
     using a1 by (metis (no_types) Suc_diff_le add_Suc_right hd_drop_conv_nth le_add_diff_inverse less_imp_le_nat take_add take_hd_drop)
   then show "take (Suc hi - lo) (drop lo xs) = take (hi - lo) (drop lo xs) @ [xs ! hi]"
     by simp
 qed
 
 lemma sorted_sublist_wrt_snoc':
   \<open>sorted_sublist_wrt R xs lo (hi-1) \<Longrightarrow> lo \<le> hi \<Longrightarrow> hi < length xs \<Longrightarrow> (\<forall>j. lo\<le>j\<and>j<hi \<longrightarrow> R (xs!j) (xs!hi)) \<Longrightarrow> sorted_sublist_wrt R xs lo hi\<close>
   apply (simp add: sorted_sublist_wrt_def)
   apply (auto simp add: nat_le_eq_or_lt)
   subgoal by (simp add: sublist_single)
   by (auto simp add: sublist_snoc sublist_el sorted_wrt_append add.commute[of lo] less_diff_conv
       simp: leI simp flip:nat_le_eq_or_lt)
 
 
 lemma sorted_sublist_wrt_snoc:
   assumes trans: \<open>(\<And> x y z. \<lbrakk>R x y; R y z\<rbrakk> \<Longrightarrow> R x z)\<close> and
     \<open>sorted_sublist_wrt R xs lo (hi-1)\<close> and
     \<open>lo \<le> hi\<close> and \<open>hi < length xs\<close> and \<open>(R (xs!(hi-1)) (xs!hi))\<close>
   shows \<open>sorted_sublist_wrt R xs lo hi\<close>
 proof -
   show ?thesis
     apply (rule sorted_sublist_wrt_snoc') using assms apply auto
     subgoal premises assms' for j
     proof -
       have A: \<open>j=hi-1 \<or> j<hi-1\<close> using assms'(6) by linarith
       show ?thesis
         using A proof
         assume A: \<open>j=hi-1\<close> show ?thesis
           by (simp add: A assms')
       next
         assume A: \<open>j<hi-1\<close> show ?thesis
           apply (rule trans)
            apply (rule sorted_sublist_wrt_nth_le[OF assms(2), where i=j, where j=\<open>hi-1\<close>])
                prefer 6
                apply (rule assms(5))
               apply auto
           subgoal using A assms'(5) by linarith
           subgoal using assms'(3) less_imp_diff_less by blast
           subgoal using assms'(5) by auto
           subgoal using A by linarith
           done
       qed
     qed
     done
 qed
 
 lemma sublist_split: \<open>lo \<le> hi \<Longrightarrow> lo < p \<Longrightarrow> p < hi \<Longrightarrow> hi < length xs \<Longrightarrow> sublist xs lo p @ sublist xs (p+1) hi = sublist xs lo hi\<close>
   by (simp add: sublist_app)
 
 lemma sublist_split_part: \<open>lo \<le> hi \<Longrightarrow> lo < p \<Longrightarrow> p < hi \<Longrightarrow> hi < length xs \<Longrightarrow> sublist xs lo (p-1) @ xs!p # sublist xs (p+1) hi = sublist xs lo hi\<close>
   by (auto simp add: sublist_split[symmetric] sublist_snoc[where xs=xs,where lo=lo,where hi=p])
 
 
 text \<open>A property for partitions (we always assume that \<^term>\<open>R\<close> is transitive.\<close>
 lemma isPartition_wrt_trans:
 \<open>(\<And> x y z. \<lbrakk>R x y; R y z\<rbrakk> \<Longrightarrow> R x z) \<Longrightarrow>
   isPartition_wrt R xs lo hi p \<Longrightarrow>
   (\<forall>i j. lo \<le> i \<and> i < p \<and> p < j \<and> j \<le> hi \<longrightarrow> R (xs!i) (xs!j))\<close>
   by (auto simp add: isPartition_wrt_def)
 
 lemma isPartition_map_trans:
 \<open>(\<And> x y z. \<lbrakk>R (h x) (h y); R (h y) (h z)\<rbrakk> \<Longrightarrow> R (h x) (h z)) \<Longrightarrow>
   hi < length xs \<Longrightarrow>
   isPartition_map R h xs lo hi p \<Longrightarrow>
   (\<forall>i j. lo \<le> i \<and> i < p \<and> p < j \<and> j \<le> hi \<longrightarrow> R (h (xs!i)) (h (xs!j)))\<close>
   by (auto simp add: isPartition_wrt_def)
 
 
 lemma merge_sorted_wrt_partitions_between':
   \<open>lo \<le> hi \<Longrightarrow> lo < p \<Longrightarrow> p < hi \<Longrightarrow> hi < length xs \<Longrightarrow>
     isPartition_wrt R xs lo hi p \<Longrightarrow>
     sorted_sublist_wrt R xs lo (p-1) \<Longrightarrow> sorted_sublist_wrt R xs (p+1) hi \<Longrightarrow>
     (\<forall>i j. lo \<le> i \<and> i < p \<and> p < j \<and> j \<le> hi \<longrightarrow> R (xs!i) (xs!j)) \<Longrightarrow>
     sorted_sublist_wrt R xs lo hi\<close>
   apply (auto simp add: isPartition_def isPartition_wrt_def sorted_sublist_def sorted_sublist_wrt_def sublist_map)
   apply (simp add: sublist_split_part[symmetric])
   apply (auto simp add: List.sorted_wrt_append)
   subgoal by (auto simp add: sublist_el)
   subgoal by (auto simp add: sublist_el)
   subgoal by (auto simp add: sublist_el')
   done
 
 lemma merge_sorted_wrt_partitions_between:
   \<open>(\<And> x y z. \<lbrakk>R x y; R y z\<rbrakk> \<Longrightarrow> R x z) \<Longrightarrow>
     isPartition_wrt R xs lo hi p \<Longrightarrow>
     sorted_sublist_wrt R xs lo (p-1) \<Longrightarrow> sorted_sublist_wrt R xs (p+1) hi \<Longrightarrow>
     lo \<le> hi \<Longrightarrow> hi < length xs \<Longrightarrow> lo < p \<Longrightarrow> p < hi \<Longrightarrow> hi < length xs \<Longrightarrow>
     sorted_sublist_wrt R xs lo hi\<close>
   by (simp add: merge_sorted_wrt_partitions_between' isPartition_wrt_trans)
 
 
 (*
 lemma merge_sorted_map_partitions_between:
   \<open>(\<And> x y z. \<lbrakk>R (h x) (h y); R (h y) (h z)\<rbrakk> \<Longrightarrow> R (h x) (h z)) \<Longrightarrow>
     isPartition_map R h xs lo hi p \<Longrightarrow>
     sorted_sublist_map R h xs lo (p-1) \<Longrightarrow> sorted_sublist_map R h xs (p+1) hi \<Longrightarrow>
     lo \<le> hi \<Longrightarrow> hi < length xs \<Longrightarrow> lo < p \<Longrightarrow> p < hi \<Longrightarrow> hi < length xs \<Longrightarrow>
     sorted_sublist_map R h xs lo hi\<close>
   by (simp add: merge_sorted_wrt_partitions_between' isPartition_map_trans)
 *)
 
 
 
 
 text \<open>The main theorem to merge sorted lists\<close>
 lemma merge_sorted_wrt_partitions:
   \<open>isPartition_wrt R xs lo hi p \<Longrightarrow>
     sorted_sublist_wrt R xs lo (p - Suc 0) \<Longrightarrow> sorted_sublist_wrt R xs (Suc p) hi \<Longrightarrow>
     lo \<le> hi \<Longrightarrow> lo \<le> p \<Longrightarrow> p \<le> hi \<Longrightarrow> hi < length xs \<Longrightarrow>
     (\<forall>i j. lo \<le> i \<and> i < p \<and> p < j \<and> j \<le> hi \<longrightarrow> R (xs!i) (xs!j)) \<Longrightarrow>
     sorted_sublist_wrt R xs lo hi\<close>
   subgoal premises assms
   proof -
     have C: \<open>lo=p\<and>p=hi \<or> lo=p\<and>p<hi \<or> lo<p\<and>p=hi \<or> lo<p\<and>p<hi\<close>
       using assms by linarith
     show ?thesis
       using C apply auto
       subgoal \<comment> \<open>lo=p=hi\<close>
         apply (rule sorted_sublist_wrt_refl)
         using assms by auto
       subgoal \<comment> \<open>lo=p<hi\<close>
         using assms by (simp add: isPartition_def isPartition_wrt_def sorted_sublist_wrt_cons')
       subgoal \<comment> \<open>lo<p=hi\<close>
         using assms by (simp add: isPartition_def isPartition_wrt_def sorted_sublist_wrt_snoc')
       subgoal \<comment> \<open>lo<p<hi\<close>
         using assms
         apply (rewrite merge_sorted_wrt_partitions_between'[where p=p])
         by auto
       done
   qed
   done
 
 theorem merge_sorted_map_partitions:
   \<open>(\<And> x y z. \<lbrakk>R (h x) (h y); R (h y) (h z)\<rbrakk> \<Longrightarrow> R (h x) (h z)) \<Longrightarrow>
     isPartition_map R h xs lo hi p \<Longrightarrow>
     sorted_sublist_map R h xs lo (p - Suc 0) \<Longrightarrow> sorted_sublist_map R h xs (Suc p) hi \<Longrightarrow>
     lo \<le> hi \<Longrightarrow> lo \<le> p \<Longrightarrow> p \<le> hi \<Longrightarrow> hi < length xs \<Longrightarrow>
     sorted_sublist_map R h xs lo hi\<close>
   apply (rule merge_sorted_wrt_partitions) apply auto
   by (simp add: merge_sorted_wrt_partitions isPartition_map_trans)
 
 
 lemma partition_wrt_extend:
   \<open>isPartition_wrt R xs lo' hi' p \<Longrightarrow>
   hi < length xs \<Longrightarrow>
   lo \<le> lo' \<Longrightarrow> lo' \<le> hi \<Longrightarrow> hi' \<le> hi \<Longrightarrow>
   lo' \<le> p \<Longrightarrow> p \<le> hi' \<Longrightarrow>
   (\<And> i. lo\<le>i \<Longrightarrow> i <lo' \<Longrightarrow> R (xs!i) (xs!p)) \<Longrightarrow>
   (\<And> j. hi'<j \<Longrightarrow> j\<le>hi \<Longrightarrow> R (xs!p) (xs!j)) \<Longrightarrow>
   isPartition_wrt R xs lo hi p\<close>
   unfolding isPartition_wrt_def
   apply (intro conjI)
   subgoal
     by (force simp: not_le)
   subgoal
     using leI by blast
   done
 
 lemma partition_map_extend:
   \<open>isPartition_map R h xs lo' hi' p \<Longrightarrow>
   hi < length xs \<Longrightarrow>
   lo \<le> lo' \<Longrightarrow> lo' \<le> hi \<Longrightarrow> hi' \<le> hi \<Longrightarrow>
   lo' \<le> p \<Longrightarrow> p \<le> hi' \<Longrightarrow>
   (\<And> i. lo\<le>i \<Longrightarrow> i <lo' \<Longrightarrow> R (h (xs!i)) (h (xs!p))) \<Longrightarrow>
   (\<And> j. hi'<j \<Longrightarrow> j\<le>hi \<Longrightarrow> R (h (xs!p)) (h (xs!j))) \<Longrightarrow>
   isPartition_map R h xs lo hi p\<close>
   by (auto simp add: partition_wrt_extend)
 
 
 lemma isPartition_empty:
   \<open>(\<And> j. \<lbrakk>lo < j; j \<le> hi\<rbrakk> \<Longrightarrow> R (xs ! lo) (xs ! j)) \<Longrightarrow>
   isPartition_wrt R xs lo hi lo\<close>
   by (auto simp add: isPartition_wrt_def)
 
 
 
 lemma take_ext:
   \<open>(\<forall>i<k. xs'!i=xs!i) \<Longrightarrow>
   k < length xs \<Longrightarrow> k < length xs' \<Longrightarrow>
   take k xs' = take k xs\<close>
   by (simp add: nth_take_lemma)
 
 lemma drop_ext':
   \<open>(\<forall>i. i\<ge>k \<and> i<length xs \<longrightarrow> xs'!i=xs!i) \<Longrightarrow>
    0<k \<Longrightarrow> xs\<noteq>[] \<Longrightarrow> \<comment> \<open>These corner cases will be dealt with in the next lemma\<close>
    length xs'=length xs \<Longrightarrow>
    drop k xs' = drop k xs\<close>
   apply (rewrite in \<open>drop _ \<hole> = _\<close> List.rev_rev_ident[symmetric])
   apply (rewrite in \<open>_ = drop _ \<hole>\<close> List.rev_rev_ident[symmetric])
   apply (rewrite in \<open>\<hole> = _\<close> List.drop_rev)
   apply (rewrite in \<open>_ = \<hole>\<close> List.drop_rev)
   apply simp
   apply (rule take_ext)
   by (auto simp add: rev_nth)
 
 lemma drop_ext:
 \<open>(\<forall>i. i\<ge>k \<and> i<length xs \<longrightarrow> xs'!i=xs!i) \<Longrightarrow>
    length xs'=length xs \<Longrightarrow>
    drop k xs' = drop k xs\<close>
   apply (cases xs)
    apply auto
   apply (cases k)
   subgoal  by (simp add: nth_equalityI)
   subgoal apply (rule drop_ext') by auto
   done
 
 
 lemma sublist_ext':
   \<open>(\<forall>i. lo\<le>i\<and>i\<le>hi \<longrightarrow> xs'!i=xs!i) \<Longrightarrow>
    length xs' = length xs \<Longrightarrow>
    lo \<le> hi \<Longrightarrow> Suc hi < length xs \<Longrightarrow>
    sublist xs' lo hi = sublist xs lo hi\<close>
   apply (simp add: sublist_def)
   apply (rule take_ext)
   by auto
 
 
 lemma lt_Suc: \<open>(a < b) = (Suc a = b \<or> Suc a < b)\<close>
   by auto
 
 lemma sublist_until_end_eq_drop: \<open>Suc hi = length xs \<Longrightarrow> sublist xs lo hi = drop lo xs\<close>
   by (simp add: sublist_def)
 
 lemma sublist_ext:
   \<open>(\<forall>i. lo\<le>i\<and>i\<le>hi \<longrightarrow> xs'!i=xs!i) \<Longrightarrow>
    length xs' = length xs \<Longrightarrow>
    lo \<le> hi \<Longrightarrow> hi < length xs \<Longrightarrow>
    sublist xs' lo hi = sublist xs lo hi\<close>
   apply (auto simp add: lt_Suc[where a=hi])
   subgoal by (auto simp add: sublist_until_end_eq_drop drop_ext)
   subgoal by (auto simp add: sublist_ext')
   done
 
 lemma sorted_wrt_lower_sublist_still_sorted:
   assumes \<open>sorted_sublist_wrt R xs lo (lo' - Suc 0)\<close> and
     \<open>lo \<le> lo'\<close> and \<open>lo' < length xs\<close> and
     \<open>(\<forall> i. lo\<le>i\<and>i<lo' \<longrightarrow> xs'!i=xs!i)\<close> and \<open>length xs' = length xs\<close>
   shows \<open>sorted_sublist_wrt R xs' lo (lo' - Suc 0)\<close>
 proof -
   have l: \<open>lo < lo' - 1 \<or> lo \<ge> lo'-1\<close>
     by linarith
   show ?thesis
     using l apply auto
     subgoal \<comment> \<open>lo < lo' - 1\<close>
       apply (auto simp add: sorted_sublist_wrt_def)
       apply (rewrite sublist_ext[where xs=xs])
       using assms by (auto simp add: sorted_sublist_wrt_def)
     subgoal \<comment> \<open>lo >= lo' - 1\<close>
       using assms by (auto simp add: sorted_sublist_wrt_le)
     done
 qed
 
 lemma sorted_map_lower_sublist_still_sorted:
   assumes \<open>sorted_sublist_map R h xs lo (lo' - Suc 0)\<close> and
     \<open>lo \<le> lo'\<close> and \<open>lo' < length xs\<close> and
     \<open>(\<forall> i. lo\<le>i\<and>i<lo' \<longrightarrow> xs'!i=xs!i)\<close> and \<open>length xs' = length xs\<close>
   shows \<open>sorted_sublist_map R h xs' lo (lo' - Suc 0)\<close>
   using assms by (rule sorted_wrt_lower_sublist_still_sorted)
 
 lemma sorted_wrt_upper_sublist_still_sorted:
   assumes \<open>sorted_sublist_wrt R xs (hi'+1) hi\<close> and
     \<open>lo \<le> lo'\<close> and \<open>hi < length xs\<close> and
     \<open>\<forall> j. hi'<j\<and>j\<le>hi \<longrightarrow> xs'!j=xs!j\<close> and \<open>length xs' = length xs\<close>
   shows \<open>sorted_sublist_wrt R xs' (hi'+1) hi\<close>
 proof -
   have l: \<open>hi' + 1 < hi \<or> hi' + 1 \<ge> hi\<close>
     by linarith
   show ?thesis
     using l apply auto
     subgoal \<comment> \<open>hi' + 1 < h\<close>
       apply (auto simp add: sorted_sublist_wrt_def)
       apply (rewrite sublist_ext[where xs=xs])
       using assms by (auto simp add: sorted_sublist_wrt_def)
     subgoal \<comment> \<open>\<^term>\<open>hi' + 1 \<ge> hi\<close>\<close>
       using assms by (auto simp add: sorted_sublist_wrt_le)
     done
 qed
 
 lemma sorted_map_upper_sublist_still_sorted:
   assumes \<open>sorted_sublist_map R h xs (hi'+1) hi\<close> and
     \<open>lo \<le> lo'\<close> and \<open>hi < length xs\<close> and
     \<open>\<forall> j. hi'<j\<and>j\<le>hi \<longrightarrow> xs'!j=xs!j\<close> and \<open>length xs' = length xs\<close>
   shows \<open>sorted_sublist_map R h xs' (hi'+1) hi\<close>
   using assms by (rule sorted_wrt_upper_sublist_still_sorted)
 
 
 
 
 
 
 
 text \<open>The specification of the partition function\<close>
 definition partition_spec :: \<open>('b \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> 'a list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> 'a list \<Rightarrow> nat \<Rightarrow> bool\<close> where
   \<open>partition_spec R h xs lo hi xs' p \<equiv>
     mset xs' = mset xs \<and> \<comment> \<open>The list is a permutation\<close>
     isPartition_map R h xs' lo hi p \<and> \<comment> \<open>We have a valid partition on the resulting list\<close>
     lo \<le> p \<and> p \<le> hi \<and> \<comment> \<open>The partition index is in bounds\<close>
     (\<forall> i. i<lo \<longrightarrow> xs'!i=xs!i) \<and> (\<forall> i. hi<i\<and>i<length xs' \<longrightarrow> xs'!i=xs!i)\<close> \<comment> \<open>Everything else is unchanged.\<close>
 
 lemma in_set_take_conv_nth:
   \<open>x \<in> set (take n xs) \<longleftrightarrow> (\<exists>m<min n (length xs). xs ! m = x)\<close>
   by (metis in_set_conv_nth length_take min.commute min.strict_boundedE nth_take)
 
 lemma mset_drop_upto: \<open>mset (drop a N) = {#N!i. i \<in># mset_set {a..<length N}#}\<close>
 proof (induction N arbitrary: a)
   case Nil
   then show ?case by simp
 next
   case (Cons c N)
   have upt: \<open>{0..<Suc (length N)} = insert 0 {1..<Suc (length N)}\<close>
     by auto
   then have H: \<open>mset_set {0..<Suc (length N)} = add_mset 0 (mset_set {1..<Suc (length N)})\<close>
     unfolding upt by auto
   have mset_case_Suc: \<open>{#case x of 0 \<Rightarrow> c | Suc x \<Rightarrow> N ! x . x \<in># mset_set {Suc a..<Suc b}#} =
     {#N ! (x-1) . x \<in># mset_set {Suc a..<Suc b}#}\<close> for a b
     by (rule image_mset_cong) (auto split: nat.splits)
   have Suc_Suc: \<open>{Suc a..<Suc b} = Suc ` {a..<b}\<close> for a b
     by auto
   then have mset_set_Suc_Suc: \<open>mset_set {Suc a..<Suc b} = {#Suc n. n \<in># mset_set {a..<b}#}\<close> for a b
     unfolding Suc_Suc by (subst image_mset_mset_set[symmetric]) auto
   have *: \<open>{#N ! (x-Suc 0) . x \<in># mset_set {Suc a..<Suc b}#} = {#N ! x . x \<in># mset_set {a..<b}#}\<close>
     for a b
     by (auto simp add: mset_set_Suc_Suc multiset.map_comp comp_def)
   show ?case
     apply (cases a)
     using Cons[of 0] Cons by (auto simp: nth_Cons drop_Cons H mset_case_Suc *)
 qed
 
 (* Actually, I only need that \<open>set (sublist xs' lo hi) = set (sublist xs lo hi)\<close> *)
 lemma mathias:
   assumes
         Perm: \<open>mset xs' = mset xs\<close>
     and I: \<open>lo\<le>i\<close> \<open>i\<le>hi\<close> \<open>xs'!i=x\<close>
     and Bounds: \<open>hi < length xs\<close>
     and Fix: \<open>\<And> i. i<lo \<Longrightarrow> xs'!i = xs!i\<close> \<open>\<And> j. \<lbrakk>hi<j; j<length xs\<rbrakk> \<Longrightarrow> xs'!j = xs!j\<close>
   shows \<open>\<exists>j. lo\<le>j\<and>j\<le>hi \<and> xs!j = x\<close>
 proof -
   define xs1 xs2 xs3 xs1' xs2' xs3' where
      \<open>xs1 = take lo xs\<close> and
      \<open>xs2 = take (Suc hi - lo) (drop lo xs)\<close> and
      \<open>xs3 = drop (Suc hi) xs\<close> and
      \<open>xs1' = take lo xs'\<close> and
      \<open>xs2' = take (Suc hi - lo) (drop lo xs')\<close> and
      \<open>xs3' = drop (Suc hi) xs'\<close>
   have [simp]: \<open>length xs' = length xs\<close>
     using Perm by (auto dest: mset_eq_length)
   have [simp]: \<open>mset xs1 = mset xs1'\<close>
     using Fix(1) unfolding xs1_def xs1'_def
     by (metis Perm le_cases mset_eq_length nth_take_lemma take_all)
   have [simp]: \<open>mset xs3 = mset xs3'\<close>
     using Fix(2) unfolding xs3_def xs3'_def mset_drop_upto
     by (auto intro: image_mset_cong)
   have \<open>xs = xs1 @ xs2 @ xs3\<close> \<open>xs' = xs1' @ xs2' @ xs3'\<close>
     using I unfolding xs1_def xs2_def xs3_def xs1'_def xs2'_def xs3'_def
     by (metis append.assoc append_take_drop_id le_SucI le_add_diff_inverse order_trans take_add)+
   moreover have \<open>xs ! i = xs2 ! (i - lo)\<close> \<open>i \<ge> length xs1\<close>
     using I Bounds unfolding xs2_def xs1_def by (auto simp: nth_take min_def)
   moreover have  \<open>x \<in> set xs2'\<close>
     using I Bounds unfolding xs2'_def
     by (auto simp: in_set_take_conv_nth
        intro!: exI[of _ \<open>i - lo\<close>])
   ultimately have \<open>x \<in> set xs2\<close>
     using Perm I by (auto dest: mset_eq_setD)
   then obtain j where \<open>xs ! (lo + j) = x\<close> \<open>j \<le> hi - lo\<close>
     unfolding in_set_conv_nth xs2_def
     by auto
   then show ?thesis
     using Bounds I
     by (auto intro: exI[of _ \<open>lo+j\<close>])
 qed
 
 
 text \<open>If we fix the left and right rest of two permutated lists, then the sublists are also permutations.\<close>
 text \<open>But we only need that the sets are equal.\<close>
 lemma mset_sublist_incl:
   assumes Perm: \<open>mset xs' = mset xs\<close>
     and Fix: \<open>\<And> i. i<lo \<Longrightarrow> xs'!i = xs!i\<close> \<open>\<And> j. \<lbrakk>hi<j; j<length xs\<rbrakk> \<Longrightarrow> xs'!j = xs!j\<close>
     and bounds: \<open>lo \<le> hi\<close> \<open>hi < length xs\<close>
   shows \<open>set (sublist xs' lo hi) \<subseteq> set (sublist xs lo hi)\<close>
 proof
   fix x
   assume \<open>x \<in> set (sublist xs' lo hi)\<close>
   then have \<open>\<exists>i. lo\<le>i\<and>i\<le>hi \<and> xs'!i=x\<close>
     by (metis assms(1) bounds(1) bounds(2) size_mset sublist_el')
   then obtain i where I: \<open>lo\<le>i\<close> \<open>i\<le>hi\<close> \<open>xs'!i=x\<close> by blast
   have \<open>\<exists>j. lo\<le>j\<and>j\<le>hi \<and> xs!j=x\<close>
     using Perm I bounds(2) Fix by (rule mathias, auto)
   then show \<open>x \<in> set (sublist xs lo hi)\<close>
     by (simp add: bounds(1) bounds(2) sublist_el')
 qed
 
 
 lemma mset_sublist_eq:
   assumes \<open>mset xs' = mset xs\<close>
     and \<open>\<And> i. i<lo \<Longrightarrow> xs'!i = xs!i\<close>
     and \<open>\<And> j. \<lbrakk>hi<j; j<length xs\<rbrakk> \<Longrightarrow> xs'!j = xs!j\<close>
     and bounds: \<open>lo \<le> hi\<close> \<open>hi < length xs\<close>
   shows \<open>set (sublist xs' lo hi) = set (sublist xs lo hi)\<close>
 proof
   show \<open>set (sublist xs' lo hi) \<subseteq> set (sublist xs lo hi)\<close>
     apply (rule mset_sublist_incl)
     using assms by auto
   show \<open>set (sublist xs lo hi) \<subseteq> set (sublist xs' lo hi)\<close>
     by (rule mset_sublist_incl) (metis assms size_mset)+
 qed
 
 
 
 text \<open>Our abstract recursive quicksort procedure. We abstract over a partition procedure.\<close>
 definition quicksort :: \<open>('b \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> nat \<times> nat \<times> 'a list \<Rightarrow> 'a list nres\<close> where
 \<open>quicksort R h = (\<lambda>(lo,hi,xs0). do {
   RECT (\<lambda>f (lo,hi,xs). do {
       ASSERT(lo \<le> hi \<and> hi < length xs \<and> mset xs = mset xs0); \<comment> \<open>Premise for a partition function\<close>
       (xs, p) \<leftarrow> SPEC(uncurry (partition_spec R h xs lo hi)); \<comment> \<open>Abstract partition function\<close>
       ASSERT(mset xs = mset xs0);
       xs \<leftarrow> (if p-1\<le>lo then RETURN xs else f (lo, p-1, xs));
       ASSERT(mset xs = mset xs0);
       if hi\<le>p+1 then RETURN xs else f (p+1, hi, xs)
     }) (lo,hi,xs0)
   })\<close>
 
 text \<open>As premise for quicksor, we only need that the indices are ok.\<close>
 definition quicksort_pre :: \<open>('b \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> 'a list \<Rightarrow>  nat \<Rightarrow> nat \<Rightarrow> 'a list \<Rightarrow> bool\<close> where
   \<open>quicksort_pre R h xs0 lo hi xs \<equiv> lo \<le> hi \<and> hi < length xs \<and> mset xs = mset xs0\<close>
 
 definition quicksort_post :: \<open>('b \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> 'a list \<Rightarrow> 'a list \<Rightarrow> bool\<close> where
   \<open>quicksort_post R h lo hi xs xs' \<equiv>
     mset xs' = mset xs \<and>
     sorted_sublist_map R h xs' lo hi \<and>
     (\<forall> i. i<lo \<longrightarrow> xs'!i = xs!i) \<and>
     (\<forall> j. hi<j\<and>j<length xs \<longrightarrow> xs'!j = xs!j)\<close>
 
 text \<open>Convert Pure to HOL\<close>
 lemma quicksort_postI:
   \<open>\<lbrakk>mset xs' = mset xs; sorted_sublist_map R h xs' lo hi; (\<And> i. \<lbrakk>i<lo\<rbrakk> \<Longrightarrow> xs'!i = xs!i); (\<And> j. \<lbrakk>hi<j; j<length xs\<rbrakk> \<Longrightarrow> xs'!j = xs!j)\<rbrakk> \<Longrightarrow> quicksort_post R h lo hi xs xs'\<close>
   by (auto simp add: quicksort_post_def)
 
 
 text \<open>The first case for the correctness proof of (abstract) quicksort: We assume that we called the partition function, and we have \<^term>\<open>p-1\<le>lo\<close> and \<^term>\<open>hi\<le>p+1\<close>.\<close>
 lemma quicksort_correct_case1:
   assumes trans: \<open>\<And> x y z. \<lbrakk>R (h x) (h y); R (h y) (h z)\<rbrakk> \<Longrightarrow> R (h x) (h z)\<close> and lin: \<open>\<And>x y. x \<noteq> y \<Longrightarrow> R (h x) (h y) \<or> R (h y) (h x)\<close>
     and pre: \<open>quicksort_pre R h xs0 lo hi xs\<close>
     and part: \<open>partition_spec R h xs lo hi xs' p\<close>
     and ifs: \<open>p-1 \<le> lo\<close> \<open>hi \<le> p+1\<close>
   shows \<open>quicksort_post R h lo hi xs xs'\<close>
 proof -
   text \<open>First boilerplate code step: 'unfold' the HOL definitions in the assumptions and convert them to Pure\<close>
   have pre: \<open>lo \<le> hi\<close> \<open>hi < length xs\<close>
     using pre by (auto simp add: quicksort_pre_def)
 (*
   have part_perm: \<open>set (sublist xs' lo hi) = set (sublist xs lo hi)\<close>
     using part partition_spec_set_sublist pre(1) pre(2) by blast
 *)
   have part: \<open>mset xs' = mset xs\<close> True
     \<open>isPartition_map R h xs' lo hi p\<close> \<open>lo \<le> p\<close> \<open>p \<le> hi\<close>
     \<open>\<And> i. i<lo \<Longrightarrow> xs'!i=xs!i\<close> \<open>\<And> i. \<lbrakk>hi<i; i<length xs'\<rbrakk> \<Longrightarrow> xs'!i=xs!i\<close>
     using part by (auto simp add: partition_spec_def)
 
 
   have sorted_lower: \<open>sorted_sublist_map R h xs' lo (p - Suc 0)\<close>
   proof -
     show ?thesis
       apply (rule sorted_sublist_wrt_le)
       subgoal using ifs(1) by auto
       subgoal using ifs(1) mset_eq_length part(1) pre(1) pre(2) by fastforce
       done
   qed
 
   have sorted_upper: \<open>sorted_sublist_map R h xs' (Suc p) hi\<close>
   proof -
     show ?thesis
       apply (rule sorted_sublist_wrt_le)
       subgoal using ifs(2) by auto
       subgoal using ifs(1) mset_eq_length part(1) pre(1) pre(2) by fastforce
       done
   qed
 
   have sorted_middle: \<open>sorted_sublist_map R h xs' lo hi\<close>
   proof -
     show ?thesis
       apply (rule merge_sorted_map_partitions[where p=p])
       subgoal by (rule trans)
       subgoal by (rule part)
       subgoal by (rule sorted_lower)
       subgoal by (rule sorted_upper)
       subgoal using pre(1) by auto
       subgoal by (simp add: part(4))
       subgoal by (simp add: part(5))
       subgoal by (metis part(1) pre(2) size_mset)
       done
   qed
 
   show ?thesis
   proof (intro quicksort_postI)
     show \<open>mset xs' = mset xs\<close>
       by (simp add: part(1))
   next
     show \<open>sorted_sublist_map R h xs' lo hi\<close>
       by (rule sorted_middle)
   next
       show \<open>\<And>i. i < lo \<Longrightarrow> xs' ! i = xs ! i\<close>
       using part(6) by blast
   next
     show \<open>\<And>j. \<lbrakk>hi < j; j < length xs\<rbrakk> \<Longrightarrow> xs' ! j = xs ! j\<close>
       by (metis part(1) part(7) size_mset)
   qed
 qed
 
 
 text \<open>In the second case, we have to show that the precondition still holds for (p+1, hi, x') after the partition.\<close>
 lemma quicksort_correct_case2:
   assumes
         pre: \<open>quicksort_pre R h xs0 lo hi xs\<close>
     and part: \<open>partition_spec R h xs lo hi xs' p\<close>
     and ifs: \<open>\<not> hi \<le> p + 1\<close>
   shows \<open>quicksort_pre R h xs0 (Suc p) hi xs'\<close>
 proof -
   text \<open>First boilerplate code step: 'unfold' the HOL definitions in the assumptions and convert them to Pure\<close>
   have pre: \<open>lo \<le> hi\<close> \<open>hi < length xs\<close> \<open>mset xs = mset xs0\<close>
     using pre by (auto simp add: quicksort_pre_def)
   have part: \<open>mset xs' = mset xs\<close> True
     \<open>isPartition_map R h xs' lo hi p\<close> \<open>lo \<le> p\<close> \<open>p \<le> hi\<close>
     \<open>\<And> i. i<lo \<Longrightarrow> xs'!i=xs!i\<close> \<open>\<And> i. \<lbrakk>hi<i; i<length xs'\<rbrakk> \<Longrightarrow> xs'!i=xs!i\<close>
     using part by (auto simp add: partition_spec_def)
   show ?thesis
     unfolding quicksort_pre_def
   proof (intro conjI)
     show \<open>Suc p \<le> hi\<close>
       using ifs by linarith
     show \<open>hi < length xs'\<close>
       by (metis part(1) pre(2) size_mset)
     show \<open>mset xs' = mset xs0\<close>
       using pre(3) part(1) by (auto dest: mset_eq_setD)
   qed
 qed
 
 
 
 lemma quicksort_post_set:
   assumes \<open>quicksort_post R h lo hi xs xs'\<close>
     and bounds: \<open>lo \<le> hi\<close> \<open>hi < length xs\<close>
   shows \<open>set (sublist xs' lo hi) = set (sublist xs lo hi)\<close>
 proof -
   have \<open>mset xs' = mset xs\<close> \<open>\<And> i. i<lo \<Longrightarrow> xs'!i = xs!i\<close> \<open>\<And> j. \<lbrakk>hi<j; j<length xs\<rbrakk> \<Longrightarrow> xs'!j = xs!j\<close>
     using assms by (auto simp add: quicksort_post_def)
   then show ?thesis
     using bounds by (rule mset_sublist_eq, auto)
 qed
 
 
 text \<open>In the third case, we have run quicksort recursively on (p+1, hi, xs') after the partition, with hi<=p+1 and p-1<=lo.\<close>
 lemma quicksort_correct_case3:
   assumes trans: \<open>\<And> x y z. \<lbrakk>R (h x) (h y); R (h y) (h z)\<rbrakk> \<Longrightarrow> R (h x) (h z)\<close> and lin: \<open>\<And>x y. x \<noteq> y \<Longrightarrow> R (h x) (h y) \<or> R (h y) (h x)\<close>
     and pre: \<open>quicksort_pre R h xs0 lo hi xs\<close>
     and part: \<open>partition_spec R h xs lo hi xs' p\<close>
     and ifs: \<open>p - Suc 0 \<le> lo\<close> \<open>\<not> hi \<le> Suc p\<close>
     and IH1': \<open>quicksort_post R h (Suc p) hi xs' xs''\<close>
   shows \<open>quicksort_post R h lo hi xs xs''\<close>
 proof -
   text \<open>First boilerplate code step: 'unfold' the HOL definitions in the assumptions and convert them to Pure\<close>
   have pre: \<open>lo \<le> hi\<close> \<open>hi < length xs\<close> \<open>mset xs = mset xs0\<close>
     using pre by (auto simp add: quicksort_pre_def)
   have part: \<open>mset xs' = mset xs\<close> True
     \<open>isPartition_map R h xs' lo hi p\<close> \<open>lo \<le> p\<close> \<open>p \<le> hi\<close>
     \<open>\<And> i. i<lo \<Longrightarrow> xs'!i=xs!i\<close> \<open>\<And> i. \<lbrakk>hi<i; i<length xs'\<rbrakk> \<Longrightarrow> xs'!i=xs!i\<close>
     using part by (auto simp add: partition_spec_def)
   have IH1: \<open>mset xs'' = mset xs'\<close> \<open>sorted_sublist_map R h xs'' (Suc p) hi\<close>
       \<open>\<And> i. i<Suc p \<Longrightarrow> xs'' ! i = xs' ! i\<close> \<open>\<And> j. \<lbrakk>hi < j; j < length xs'\<rbrakk> \<Longrightarrow> xs'' ! j = xs' ! j\<close>
     using IH1' by (auto simp add: quicksort_post_def)
   note IH1_perm = quicksort_post_set[OF IH1']
 
   have still_partition: \<open>isPartition_map R h xs'' lo hi p\<close>
   proof(intro isPartition_wrtI)
     fix i assume \<open>lo \<le> i\<close> \<open>i < p\<close>
     show \<open>R (h (xs'' ! i)) (h (xs'' ! p))\<close>
       text \<open>This holds because this part hasn't changed\<close>
       using IH1(3) \<open>i < p\<close> \<open>lo \<le> i\<close> isPartition_wrt_def part(3) by fastforce
     next
       fix j assume \<open>p < j\<close> \<open>j \<le> hi\<close>
       text \<open>Obtain the position \<^term>\<open>posJ\<close> where \<^term>\<open>xs''!j\<close> was stored in \<^term>\<open>xs'\<close>.\<close>
       have \<open>xs''!j \<in> set (sublist xs'' (Suc p) hi)\<close>
         by (metis IH1(1) Suc_leI \<open>j \<le> hi\<close> \<open>p < j\<close> less_le_trans mset_eq_length part(1) pre(2) sublist_el')
       then have \<open>xs''!j \<in> set (sublist xs' (Suc p) hi)\<close>
         by (metis IH1_perm ifs(2) nat_le_linear part(1) pre(2) size_mset)
       then have \<open>\<exists> posJ. Suc p\<le>posJ\<and>posJ\<le>hi \<and> xs''!j = xs'!posJ\<close>
         by (metis Suc_leI \<open>j \<le> hi\<close> \<open>p < j\<close> less_le_trans part(1) pre(2) size_mset sublist_el')
       then obtain posJ :: nat where PosJ: \<open>Suc p\<le>posJ\<close> \<open>posJ\<le>hi\<close> \<open>xs''!j = xs'!posJ\<close> by blast
 
       then show \<open>R (h (xs'' ! p)) (h (xs'' ! j))\<close>
         by (metis IH1(3) Suc_le_lessD isPartition_wrt_def lessI part(3))
   qed
 
   have sorted_lower: \<open>sorted_sublist_map R h xs'' lo (p - Suc 0)\<close>
   proof -
     show ?thesis
       apply (rule sorted_sublist_wrt_le)
       subgoal by (simp add: ifs(1))
       subgoal using IH1(1) mset_eq_length part(1) part(5) pre(2) by fastforce
       done
   qed
 
   note sorted_upper = IH1(2)
 
   have sorted_middle: \<open>sorted_sublist_map R h xs'' lo hi\<close>
   proof -
     show ?thesis
       apply (rule merge_sorted_map_partitions[where p=p])
       subgoal by (rule trans)
       subgoal by (rule still_partition)
       subgoal by (rule sorted_lower)
       subgoal by (rule sorted_upper)
       subgoal using pre(1) by auto
       subgoal by (simp add: part(4))
       subgoal by (simp add: part(5))
       subgoal by (metis IH1(1) part(1) pre(2) size_mset)
       done
   qed
 
 
   show ?thesis
   proof (intro quicksort_postI)
     show \<open>mset xs'' = mset xs\<close>
       using part(1) IH1(1) by auto \<comment> \<open>I was faster than sledgehammer :-)\<close>
   next
     show \<open>sorted_sublist_map R h xs'' lo hi\<close>
       by (rule sorted_middle)
   next
     show \<open>\<And>i. i < lo \<Longrightarrow> xs'' ! i = xs ! i\<close>
       using IH1(3) le_SucI part(4) part(6) by auto
   next show \<open>\<And>j. hi < j \<Longrightarrow> j < length xs \<Longrightarrow> xs'' ! j = xs ! j\<close>
       by (metis IH1(4) part(1) part(7) size_mset)
   qed
 qed
 
 
 text \<open>In the 4th case, we have to show that the premise holds for \<^term>\<open>(lo,p-1,xs')\<close>, in case \<^term>\<open>\<not>p-1\<le>lo\<close>\<close>
 text \<open>Analogous to case 2.\<close>
 lemma quicksort_correct_case4:
   assumes
         pre: \<open>quicksort_pre R h xs0 lo hi xs\<close>
     and part: \<open>partition_spec R h xs lo hi xs' p\<close>
     and ifs: \<open>\<not> p - Suc 0 \<le> lo \<close>
   shows \<open>quicksort_pre R h xs0 lo (p-Suc 0) xs'\<close>
 proof -
   text \<open>First boilerplate code step: 'unfold' the HOL definitions in the assumptions and convert them to Pure\<close>
   have pre: \<open>lo \<le> hi\<close> \<open>hi < length xs\<close> \<open>mset xs0 = mset xs\<close>
     using pre by (auto simp add: quicksort_pre_def)
   have part: \<open>mset xs' = mset xs\<close> True
     \<open>isPartition_map R h xs' lo hi p\<close> \<open>lo \<le> p\<close> \<open>p \<le> hi\<close>
     \<open>\<And> i. i<lo \<Longrightarrow> xs'!i=xs!i\<close> \<open>\<And> i. \<lbrakk>hi<i; i<length xs'\<rbrakk> \<Longrightarrow> xs'!i=xs!i\<close>
     using part by (auto simp add: partition_spec_def)
 
   show ?thesis
     unfolding quicksort_pre_def
   proof (intro conjI)
     show \<open>lo \<le> p - Suc 0\<close>
       using ifs by linarith
     show \<open>p - Suc 0 < length xs'\<close>
       using mset_eq_length part(1) part(5) pre(2) by fastforce
     show \<open>mset xs' = mset xs0\<close>
       using pre(3) part(1) by (auto dest: mset_eq_setD)
   qed
 qed
 
 
 text \<open>In the 5th case, we have run quicksort recursively on (lo, p-1, xs').\<close>
 lemma quicksort_correct_case5:
   assumes trans: \<open>\<And> x y z. \<lbrakk>R (h x) (h y); R (h y) (h z)\<rbrakk> \<Longrightarrow> R (h x) (h z)\<close> and lin: \<open>\<And>x y. x \<noteq> y \<Longrightarrow> R (h x) (h y) \<or> R (h y) (h x)\<close>
     and pre: \<open>quicksort_pre R h xs0 lo hi xs\<close>
     and part: \<open>partition_spec R h xs lo hi xs' p\<close>
     and ifs:  \<open>\<not> p - Suc 0 \<le> lo\<close> \<open>hi \<le> Suc p\<close>
     and IH1': \<open>quicksort_post R h lo (p - Suc 0) xs' xs''\<close>
   shows \<open>quicksort_post R h lo hi xs xs''\<close>
 proof -
   text \<open>First boilerplate code step: 'unfold' the HOL definitions in the assumptions and convert them to Pure\<close>
   have pre: \<open>lo \<le> hi\<close> \<open>hi < length xs\<close>
     using pre by (auto simp add: quicksort_pre_def)
   have part: \<open>mset xs' = mset xs\<close> True
     \<open>isPartition_map R h xs' lo hi p\<close> \<open>lo \<le> p\<close> \<open>p \<le> hi\<close>
     \<open>\<And> i. i<lo \<Longrightarrow> xs'!i=xs!i\<close> \<open>\<And> i. \<lbrakk>hi<i; i<length xs'\<rbrakk> \<Longrightarrow> xs'!i=xs!i\<close>
     using part by (auto simp add: partition_spec_def)
   have IH1: \<open>mset xs'' = mset xs'\<close> \<open>sorted_sublist_map R h xs'' lo (p - Suc 0)\<close>
     \<open>\<And> i. i<lo \<Longrightarrow> xs''!i = xs'!i\<close> \<open>\<And> j. \<lbrakk>p-Suc 0<j; j<length xs'\<rbrakk> \<Longrightarrow> xs''!j = xs'!j\<close>
     using IH1' by (auto simp add: quicksort_post_def)
   note IH1_perm = quicksort_post_set[OF IH1']
 
 
  have still_partition: \<open>isPartition_map R h xs'' lo hi p\<close>
   proof(intro isPartition_wrtI)
     fix i assume \<open>lo \<le> i\<close> \<open>i < p\<close>
       text \<open>Obtain the position \<^term>\<open>posI\<close> where \<^term>\<open>xs''!i\<close> was stored in \<^term>\<open>xs'\<close>.\<close>
       have \<open>xs''!i \<in> set (sublist xs'' lo (p-Suc 0))\<close>
         by (metis (no_types, lifting) IH1(1) Suc_leI Suc_pred \<open>i < p\<close> \<open>lo \<le> i\<close> le_less_trans less_imp_diff_less mset_eq_length not_le not_less_zero part(1) part(5) pre(2) sublist_el')
       then have \<open>xs''!i \<in> set (sublist xs' lo (p-Suc 0))\<close>
         by (metis IH1_perm ifs(1) le_less_trans less_imp_diff_less mset_eq_length nat_le_linear part(1) part(5) pre(2))
       then have \<open>\<exists> posI. lo\<le>posI\<and>posI\<le>p-Suc 0 \<and> xs''!i = xs'!posI\<close>
       proof - \<comment> \<open>sledgehammer\<close>
         have "p - Suc 0 < length xs"
           by (meson diff_le_self le_less_trans part(5) pre(2))
         then show ?thesis
           by (metis (no_types) \<open>xs'' ! i \<in> set (sublist xs' lo (p - Suc 0))\<close> ifs(1) mset_eq_length nat_le_linear part(1) sublist_el')
       qed
       then obtain posI :: nat where PosI: \<open>lo\<le>posI\<close> \<open>posI\<le>p-Suc 0\<close> \<open>xs''!i = xs'!posI\<close> by blast
       then show \<open>R (h (xs'' ! i)) (h (xs'' ! p))\<close>
         by (metis (no_types, lifting) IH1(4) \<open>i < p\<close> diff_Suc_less isPartition_wrt_def le_less_trans mset_eq_length not_le not_less_eq part(1) part(3) part(5) pre(2) zero_less_Suc)
     next
       fix j assume \<open>p < j\<close> \<open>j \<le> hi\<close>
       then show \<open>R (h (xs'' ! p)) (h (xs'' ! j))\<close>
       text \<open>This holds because this part hasn't changed\<close>
-      by (smt IH1(4) add_diff_cancel_left' add_diff_inverse_nat diff_Suc_eq_diff_pred diff_le_self ifs(1) isPartition_wrt_def le_less_Suc_eq less_le_trans mset_eq_length nat_less_le part(1) part(3) part(4) plus_1_eq_Suc pre(2))
+      by (smt (verit) IH1(4) add_diff_cancel_left' add_diff_inverse_nat diff_Suc_eq_diff_pred diff_le_self ifs(1) isPartition_wrt_def le_less_Suc_eq less_le_trans mset_eq_length nat_less_le part(1) part(3) part(4) plus_1_eq_Suc pre(2))
   qed
 
 
   note sorted_lower = IH1(2)
 
   have sorted_upper: \<open>sorted_sublist_map R h xs'' (Suc p) hi\<close>
   proof -
     show ?thesis
       apply (rule sorted_sublist_wrt_le)
       subgoal by (simp add: ifs(2))
       subgoal using IH1(1) mset_eq_length part(1) part(5) pre(2) by fastforce
       done
   qed
 
 
   have sorted_middle: \<open>sorted_sublist_map R h xs'' lo hi\<close>
   proof -
     show ?thesis
       apply (rule merge_sorted_map_partitions[where p=p])
       subgoal by (rule trans)
       subgoal by (rule still_partition)
       subgoal by (rule sorted_lower)
       subgoal by (rule sorted_upper)
       subgoal using pre(1) by auto
       subgoal by (simp add: part(4))
       subgoal by (simp add: part(5))
       subgoal by (metis IH1(1) part(1) pre(2) size_mset)
       done
   qed
 
 
   show ?thesis
   proof (intro quicksort_postI)
     show \<open>mset xs'' = mset xs\<close>
       by (simp add: IH1(1) part(1))
   next
     show \<open>sorted_sublist_map R h xs'' lo hi\<close>
       by (rule sorted_middle)
   next
     show \<open>\<And>i. i < lo \<Longrightarrow> xs'' ! i = xs ! i\<close>
       by (simp add: IH1(3) part(6))
   next
     show \<open>\<And>j. hi < j \<Longrightarrow> j < length xs \<Longrightarrow> xs'' ! j = xs ! j\<close>
       by (metis IH1(4) diff_le_self dual_order.strict_trans2 mset_eq_length part(1) part(5) part(7))
   qed
 qed
 
 
 text \<open>In the 6th case, we have run quicksort recursively on (lo, p-1, xs'). We show the precondition on the second call on (p+1, hi, xs'')\<close>
 lemma quicksort_correct_case6:
   assumes
         pre: \<open>quicksort_pre R h xs0 lo hi xs\<close>
     and part: \<open>partition_spec R h xs lo hi xs' p\<close>
     and ifs:  \<open>\<not> p - Suc 0 \<le> lo\<close> \<open>\<not> hi \<le> Suc p\<close>
     and IH1: \<open>quicksort_post R h lo (p - Suc 0) xs' xs''\<close>
   shows \<open>quicksort_pre R h xs0 (Suc p) hi xs''\<close>
 proof -
   text \<open>First boilerplate code step: 'unfold' the HOL definitions in the assumptions and convert them to Pure\<close>
   have pre: \<open>lo \<le> hi\<close> \<open>hi < length xs\<close> \<open>mset xs0 = mset xs\<close>
     using pre by (auto simp add: quicksort_pre_def)
   have part: \<open>mset xs' = mset xs\<close> True
     \<open>isPartition_map R h xs' lo hi p\<close> \<open>lo \<le> p\<close> \<open>p \<le> hi\<close>
     \<open>\<And> i. i<lo \<Longrightarrow> xs'!i=xs!i\<close> \<open>\<And> i. \<lbrakk>hi<i; i<length xs'\<rbrakk> \<Longrightarrow> xs'!i=xs!i\<close>
     using part by (auto simp add: partition_spec_def)
   have IH1: \<open>mset xs'' = mset xs'\<close> \<open>sorted_sublist_map R h xs'' lo (p - Suc 0)\<close>
     \<open>\<And> i. i<lo \<Longrightarrow> xs''!i = xs'!i\<close> \<open>\<And> j. \<lbrakk>p-Suc 0<j; j<length xs'\<rbrakk> \<Longrightarrow> xs''!j = xs'!j\<close>
     using IH1 by (auto simp add: quicksort_post_def)
 
   show ?thesis
     unfolding quicksort_pre_def
   proof (intro conjI)
     show \<open>Suc p \<le> hi\<close>
       using ifs(2) by linarith
     show \<open>hi < length xs''\<close>
       using IH1(1) mset_eq_length part(1) pre(2) by fastforce
     show \<open>mset xs'' = mset xs0\<close>
       using pre(3) part(1) IH1(1) by (auto dest: mset_eq_setD)
   qed
 qed
 
 
 text \<open>In the 7th (and last) case, we have run quicksort recursively on (lo, p-1, xs'). We show the postcondition on the second call on (p+1, hi, xs'')\<close>
 lemma quicksort_correct_case7:
   assumes trans: \<open>\<And> x y z. \<lbrakk>R (h x) (h y); R (h y) (h z)\<rbrakk> \<Longrightarrow> R (h x) (h z)\<close> and lin: \<open>\<And>x y. x \<noteq> y \<Longrightarrow> R (h x) (h y) \<or> R (h y) (h x)\<close>
     and pre: \<open>quicksort_pre R h xs0 lo hi xs\<close>
     and part: \<open>partition_spec R h xs lo hi xs' p\<close>
     and ifs:  \<open>\<not> p - Suc 0 \<le> lo\<close> \<open>\<not> hi \<le> Suc p\<close>
     and IH1': \<open>quicksort_post R h lo (p - Suc 0) xs' xs''\<close>
     and IH2': \<open>quicksort_post R h (Suc p) hi xs'' xs'''\<close>
   shows \<open>quicksort_post R h lo hi xs xs'''\<close>
 proof -
   text \<open>First boilerplate code step: 'unfold' the HOL definitions in the assumptions and convert them to Pure\<close>
   have pre: \<open>lo \<le> hi\<close> \<open>hi < length xs\<close>
     using pre by (auto simp add: quicksort_pre_def)
   have part: \<open>mset xs' = mset xs\<close> True
     \<open>isPartition_map R h xs' lo hi p\<close> \<open>lo \<le> p\<close> \<open>p \<le> hi\<close>
     \<open>\<And> i. i<lo \<Longrightarrow> xs'!i=xs!i\<close> \<open>\<And> i. \<lbrakk>hi<i; i<length xs'\<rbrakk> \<Longrightarrow> xs'!i=xs!i\<close>
     using part by (auto simp add: partition_spec_def)
   have IH1: \<open>mset xs'' = mset xs'\<close> \<open>sorted_sublist_map R h xs'' lo (p - Suc 0)\<close>
     \<open>\<And> i. i<lo \<Longrightarrow> xs''!i = xs'!i\<close> \<open>\<And> j. \<lbrakk>p-Suc 0<j; j<length xs'\<rbrakk> \<Longrightarrow> xs''!j = xs'!j\<close>
     using IH1' by (auto simp add: quicksort_post_def)
   note IH1_perm = quicksort_post_set[OF IH1']
   have IH2: \<open>mset xs''' = mset xs''\<close> \<open>sorted_sublist_map R h xs''' (Suc p) hi\<close>
     \<open>\<And> i. i<Suc p \<Longrightarrow> xs'''!i = xs''!i\<close> \<open>\<And> j. \<lbrakk>hi<j; j<length xs''\<rbrakk> \<Longrightarrow> xs'''!j = xs''!j\<close>
     using IH2' by (auto simp add: quicksort_post_def)
   note IH2_perm = quicksort_post_set[OF IH2']
 
 
   text \<open>We still have a partition after the first call (same as in case 5)\<close>
   have still_partition1: \<open>isPartition_map R h xs'' lo hi p\<close>
   proof(intro isPartition_wrtI)
     fix i assume \<open>lo \<le> i\<close> \<open>i < p\<close>
       text \<open>Obtain the position \<^term>\<open>posI\<close> where \<^term>\<open>xs''!i\<close> was stored in \<^term>\<open>xs'\<close>.\<close>
       have \<open>xs''!i \<in> set (sublist xs'' lo (p-Suc 0))\<close>
         by (metis (no_types, lifting) IH1(1) Suc_leI Suc_pred \<open>i < p\<close> \<open>lo \<le> i\<close> le_less_trans less_imp_diff_less mset_eq_length not_le not_less_zero part(1) part(5) pre(2) sublist_el')
       then have \<open>xs''!i \<in> set (sublist xs' lo (p-Suc 0))\<close>
         by (metis IH1_perm ifs(1) le_less_trans less_imp_diff_less mset_eq_length nat_le_linear part(1) part(5) pre(2))
       then have \<open>\<exists> posI. lo\<le>posI\<and>posI\<le>p-Suc 0 \<and> xs''!i = xs'!posI\<close>
       proof - \<comment> \<open>sledgehammer\<close>
         have "p - Suc 0 < length xs"
           by (meson diff_le_self le_less_trans part(5) pre(2))
         then show ?thesis
           by (metis (no_types) \<open>xs'' ! i \<in> set (sublist xs' lo (p - Suc 0))\<close> ifs(1) mset_eq_length nat_le_linear part(1) sublist_el')
       qed
       then obtain posI :: nat where PosI: \<open>lo\<le>posI\<close> \<open>posI\<le>p-Suc 0\<close> \<open>xs''!i = xs'!posI\<close> by blast
       then show \<open>R (h (xs'' ! i)) (h (xs'' ! p))\<close>
         by (metis (no_types, lifting) IH1(4) \<open>i < p\<close> diff_Suc_less isPartition_wrt_def le_less_trans mset_eq_length not_le not_less_eq part(1) part(3) part(5) pre(2) zero_less_Suc)
     next
       fix j assume \<open>p < j\<close> \<open>j \<le> hi\<close>
       then show \<open>R (h (xs'' ! p)) (h (xs'' ! j))\<close>
       text \<open>This holds because this part hasn't changed\<close>
-      by (smt IH1(4) add_diff_cancel_left' add_diff_inverse_nat diff_Suc_eq_diff_pred diff_le_self ifs(1) isPartition_wrt_def le_less_Suc_eq less_le_trans mset_eq_length nat_less_le part(1) part(3) part(4) plus_1_eq_Suc pre(2))
+      by (smt (verit) IH1(4) add_diff_cancel_left' add_diff_inverse_nat diff_Suc_eq_diff_pred diff_le_self ifs(1) isPartition_wrt_def le_less_Suc_eq less_le_trans mset_eq_length nat_less_le part(1) part(3) part(4) plus_1_eq_Suc pre(2))
   qed
 
 
   text \<open>We still have a partition after the second call (similar as in case 3)\<close>
   have still_partition2: \<open>isPartition_map R h xs''' lo hi p\<close>
   proof(intro isPartition_wrtI)
     fix i assume \<open>lo \<le> i\<close> \<open>i < p\<close>
     show \<open>R (h (xs''' ! i)) (h (xs''' ! p))\<close>
       text \<open>This holds because this part hasn't changed\<close>
       using IH2(3) \<open>i < p\<close> \<open>lo \<le> i\<close> isPartition_wrt_def still_partition1 by fastforce
     next
       fix j assume \<open>p < j\<close> \<open>j \<le> hi\<close>
       text \<open>Obtain the position \<^term>\<open>posJ\<close> where \<^term>\<open>xs'''!j\<close> was stored in \<^term>\<open>xs'''\<close>.\<close>
       have \<open>xs'''!j \<in> set (sublist xs''' (Suc p) hi)\<close>
         by (metis IH1(1) IH2(1) Suc_leI \<open>j \<le> hi\<close> \<open>p < j\<close> ifs(2) nat_le_linear part(1) pre(2) size_mset sublist_el')
       then have \<open>xs'''!j \<in> set (sublist xs'' (Suc p) hi)\<close>
         by (metis IH1(1) IH2_perm ifs(2) mset_eq_length nat_le_linear part(1) pre(2))
       then have \<open>\<exists> posJ. Suc p\<le>posJ\<and>posJ\<le>hi \<and> xs'''!j = xs''!posJ\<close>
         by (metis IH1(1) ifs(2) mset_eq_length nat_le_linear part(1) pre(2) sublist_el')
       then obtain posJ :: nat where PosJ: \<open>Suc p\<le>posJ\<close> \<open>posJ\<le>hi\<close> \<open>xs'''!j = xs''!posJ\<close> by blast
 
       then show \<open>R (h (xs''' ! p)) (h (xs''' ! j))\<close>
       proof - \<comment> \<open>sledgehammer\<close>
         have "\<forall>n na as p. (p (as ! na::'a) (as ! posJ) \<or> posJ \<le> na) \<or> \<not> isPartition_wrt p as n hi na"
           by (metis (no_types) PosJ(2) isPartition_wrt_def not_less)
         then show ?thesis
           by (metis IH2(3) PosJ(1) PosJ(3) lessI not_less_eq_eq still_partition1)
       qed
   qed
 
 
   text \<open>We have that the lower part is sorted after the first recursive call\<close>
   note sorted_lower1 = IH1(2)
 
   text \<open>We show that it is still sorted after the second call.\<close>
   have sorted_lower2: \<open>sorted_sublist_map R h xs''' lo (p-Suc 0)\<close>
   proof -
     show ?thesis
       using sorted_lower1 apply (rule sorted_wrt_lower_sublist_still_sorted)
       subgoal by (rule part)
       subgoal
         using IH1(1) mset_eq_length part(1) part(5) pre(2) by fastforce
       subgoal
         by (simp add: IH2(3))
       subgoal
         by (metis IH2(1) size_mset)
       done
   qed
 
   text \<open>The second IH gives us the the upper list is sorted after the second recursive call\<close>
   note sorted_upper2 = IH2(2)
 
   text \<open>Finally, we have to show that the entire list is sorted after the second recursive call.\<close>
   have sorted_middle: \<open>sorted_sublist_map R h xs''' lo hi\<close>
   proof -
     show ?thesis
       apply (rule merge_sorted_map_partitions[where p=p])
       subgoal by (rule trans)
       subgoal by (rule still_partition2)
       subgoal by (rule sorted_lower2)
       subgoal by (rule sorted_upper2)
       subgoal using pre(1) by auto
       subgoal by (simp add: part(4))
       subgoal by (simp add: part(5))
       subgoal by (metis IH1(1) IH2(1) part(1) pre(2) size_mset)
       done
   qed
 
   show ?thesis
   proof (intro quicksort_postI)
     show \<open>mset xs''' = mset xs\<close>
       by (simp add: IH1(1) IH2(1) part(1))
   next
     show \<open>sorted_sublist_map R h xs''' lo hi\<close>
       by (rule sorted_middle)
   next
     show \<open>\<And>i. i < lo \<Longrightarrow> xs''' ! i = xs ! i\<close>
       using IH1(3) IH2(3) part(4) part(6) by auto
   next
     show \<open>\<And>j. hi < j \<Longrightarrow> j < length xs \<Longrightarrow> xs''' ! j = xs ! j\<close>
       by (metis IH1(1) IH1(4) IH2(4) diff_le_self ifs(2) le_SucI less_le_trans nat_le_eq_or_lt not_less part(1) part(7) size_mset)
   qed
 
 qed
 
 
 
 text \<open>We can now show the correctness of the abstract quicksort procedure, using the refinement framework and the above case lemmas.\<close>
 lemma quicksort_correct:
   assumes trans: \<open>\<And> x y z. \<lbrakk>R (h x) (h y); R (h y) (h z)\<rbrakk> \<Longrightarrow> R (h x) (h z)\<close> and lin: \<open>\<And>x y. x \<noteq> y \<Longrightarrow> R (h x) (h y) \<or> R (h y) (h x)\<close>
      and Pre: \<open>lo0 \<le> hi0\<close> \<open>hi0 < length xs0\<close>
   shows \<open>quicksort R h (lo0,hi0,xs0) \<le> \<Down> Id (SPEC(\<lambda>xs. quicksort_post R h lo0 hi0 xs0 xs))\<close>
 proof -
   have wf: \<open>wf (measure (\<lambda>(lo, hi, xs). Suc hi - lo))\<close>
     by auto
   define pre where \<open>pre = (\<lambda>(lo,hi,xs). quicksort_pre R h xs0 lo hi xs)\<close>
   define post where \<open>post = (\<lambda>(lo,hi,xs). quicksort_post R h lo hi xs)\<close>
   have pre: \<open>pre (lo0,hi0,xs0)\<close>
     unfolding quicksort_pre_def pre_def by (simp add: Pre)
 
   text \<open>We first generalize the goal a over all states.\<close>
   have \<open>WB_Sort.quicksort R h (lo0,hi0,xs0) \<le> \<Down> Id (SPEC (post (lo0,hi0,xs0)))\<close>
     unfolding quicksort_def prod.case
     apply (rule RECT_rule)
        apply (refine_mono)
       apply (rule wf)
     apply (rule pre)
     subgoal premises IH for f x
       apply (refine_vcg ASSERT_leI)
       unfolding pre_def post_def
 
       subgoal \<comment> \<open>First premise (assertion) for partition\<close>
         using IH(2) by (simp add: quicksort_pre_def pre_def)
       subgoal \<comment> \<open>Second premise (assertion) for partition\<close>
         using IH(2) by (simp add: quicksort_pre_def pre_def)
       subgoal
         using IH(2) by (auto simp add: quicksort_pre_def pre_def dest: mset_eq_setD)
 
 	text \<open>Termination case: \<^term>\<open>(p-1 \<le> lo')\<close> and \<^term>\<open>(hi' \<le> p+1)\<close>; directly show postcondition\<close>
       subgoal unfolding partition_spec_def by (auto dest: mset_eq_setD)
       subgoal \<comment> \<open>Postcondition (after partition)\<close>
         apply -
         using IH(2) unfolding pre_def apply (simp, elim conjE, split prod.splits)
         using trans lin apply (rule quicksort_correct_case1) by auto
 
       text \<open>Case \<^term>\<open>(p-1 \<le> lo')\<close> and \<^term>\<open>(hi' < p+1)\<close> (Only second recursive call)\<close>
       subgoal
         apply (rule IH(1)[THEN order_trans])
 
         text \<open>Show that the invariant holds for the second recursive call\<close>
         subgoal
           using IH(2) unfolding pre_def apply (simp, elim conjE, split prod.splits)
           apply (rule quicksort_correct_case2) by auto
 
         text \<open>Wellfoundness (easy)\<close>
         subgoal by (auto simp add: quicksort_pre_def partition_spec_def)
 
         text \<open>Show that the postcondition holds\<close>
         subgoal
           apply (simp add: Misc.subset_Collect_conv post_def, intro allI impI, elim conjE)
           using trans lin apply (rule quicksort_correct_case3)
           using IH(2) unfolding pre_def by auto
         done
 
       text \<open>Case: At least the first recursive call\<close>
       subgoal
         apply (rule IH(1)[THEN order_trans])
 
         text \<open>Show that the precondition holds for the first recursive call\<close>
         subgoal
           using IH(2) unfolding pre_def post_def apply (simp, elim conjE, split prod.splits) apply auto
           apply (rule quicksort_correct_case4) by auto
 
         text \<open>Wellfoundness for first recursive call (easy)\<close>
         subgoal by (auto simp add: quicksort_pre_def partition_spec_def)
 
         text \<open>Simplify some refinement suff...\<close>
         apply (simp add: Misc.subset_Collect_conv ASSERT_leI, intro allI impI conjI, elim conjE)
         apply (rule ASSERT_leI)
         apply (simp_all add: Misc.subset_Collect_conv ASSERT_leI)
         subgoal unfolding quicksort_post_def pre_def post_def by (auto dest: mset_eq_setD)
         text \<open>Only the first recursive call: show postcondition\<close>
         subgoal
           using trans lin apply (rule quicksort_correct_case5)
           using IH(2) unfolding pre_def post_def by auto
 
         apply (rule ASSERT_leI)
         subgoal unfolding quicksort_post_def pre_def post_def by (auto dest: mset_eq_setD)
 
         text \<open>Both recursive calls.\<close>
         subgoal
           apply (rule IH(1)[THEN order_trans])
 
           text \<open>Show precondition for second recursive call (after the first call)\<close>
           subgoal
             unfolding pre_def post_def
             apply auto
             apply (rule quicksort_correct_case6)
             using IH(2) unfolding pre_def post_def  by auto
 
           text \<open>Wellfoundedness for second recursive call (easy)\<close>
           subgoal by (auto simp add: quicksort_pre_def partition_spec_def)
 
           text \<open>Show that the postcondition holds (after both recursive calls)\<close>
           subgoal
             apply (simp add: Misc.subset_Collect_conv, intro allI impI, elim conjE)
             using trans lin apply (rule quicksort_correct_case7)
             using IH(2) unfolding pre_def post_def by auto
           done
         done
       done
     done
 
   text \<open>Finally, apply the generalized lemma to show the thesis.\<close>
   then show ?thesis unfolding post_def  by auto
 qed
 
 
 
 (* TODO: Show that our (abstract) partition satisifies the specification *)
 
 
 definition partition_main_inv :: \<open>('b \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> 'a list \<Rightarrow> (nat\<times>nat\<times>'a list) \<Rightarrow> bool\<close> where
   \<open>partition_main_inv R h lo hi xs0 p \<equiv>
     case p of (i,j,xs) \<Rightarrow>
     j < length xs \<and> j \<le> hi \<and> i < length xs \<and> lo \<le> i \<and> i \<le> j \<and> mset xs = mset xs0 \<and>
     (\<forall>k. k \<ge> lo \<and> k < i \<longrightarrow> R (h (xs!k)) (h (xs!hi))) \<and> \<comment> \<open>All elements from \<^term>\<open>lo\<close> to \<^term>\<open>i-1\<close> are smaller than the pivot\<close>
     (\<forall>k. k \<ge> i \<and> k < j \<longrightarrow>  R (h (xs!hi)) (h (xs!k))) \<and> \<comment> \<open>All elements from \<^term>\<open>i\<close> to \<^term>\<open>j-1\<close> are greater than the pivot\<close>
     (\<forall>k. k < lo \<longrightarrow> xs!k = xs0!k) \<and> \<comment> \<open>Everything below \<^term>\<open>lo\<close> is unchanged\<close>
     (\<forall>k. k \<ge> j \<and> k < length xs \<longrightarrow> xs!k = xs0!k) \<comment> \<open>All elements from \<^term>\<open>j\<close> are unchanged (including everyting above \<^term>\<open>hi\<close>)\<close>
   \<close>
 
 text \<open>The main part of the partition function. The pivot is assumed to be the last element. This is
 exactly the "Lomuto partition scheme" partition function from Wikipedia.\<close>
 definition partition_main :: \<open>('b \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> 'a list \<Rightarrow> ('a list \<times> nat) nres\<close> where
   \<open>partition_main R h lo hi xs0 = do {
     ASSERT(hi < length xs0);
     pivot \<leftarrow> RETURN (h (xs0 ! hi));
     (i,j,xs) \<leftarrow> WHILE\<^sub>T\<^bsup>partition_main_inv R h lo hi xs0\<^esup> \<comment> \<open>We loop from \<^term>\<open>j=lo\<close> to \<^term>\<open>j=hi-1\<close>.\<close>
       (\<lambda>(i,j,xs). j < hi)
       (\<lambda>(i,j,xs). do {
         ASSERT(i < length xs \<and> j < length xs);
       	if R (h (xs!j)) pivot
       	then RETURN (i+1, j+1, swap xs i j)
       	else RETURN (i,   j+1, xs)
       })
       (lo, lo, xs0); \<comment> \<open>i and j are both initialized to lo\<close>
     ASSERT(i < length xs \<and> j = hi \<and> lo \<le> i \<and> hi < length xs \<and> mset xs = mset xs0);
     RETURN (swap xs i hi, i)
   }\<close>
 
 (*
 definition partition_spec :: \<open>('b \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> 'a list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> 'a list \<Rightarrow> nat \<Rightarrow> bool\<close> where
   \<open>partition_spec R h xs lo hi xs' p \<equiv>
     mset xs' = mset xs \<and> \<comment> \<open>The list is a permutation\<close>
     isPartition_map R h xs' lo hi p \<and> \<comment> \<open>We have a valid partition on the resulting list\<close>
     lo \<le> p \<and> p \<le> hi \<and> \<comment> \<open>The partition index is in bounds\<close>
     (\<forall> i. i<lo \<longrightarrow> xs'!i=xs!i) \<and> (\<forall> i. hi<i\<and>i<length xs' \<longrightarrow> xs'!i=xs!i)\<close> \<comment> \<open>Everything else is unchanged.\<close>
 *)
 
 lemma partition_main_correct:
   assumes bounds: \<open>hi < length xs\<close> \<open>lo \<le> hi\<close> and
     trans: \<open>\<And> x y z. \<lbrakk>R (h x) (h y); R (h y) (h z)\<rbrakk> \<Longrightarrow> R (h x) (h z)\<close> and lin: \<open>\<And>x y. R (h x) (h y) \<or> R (h y) (h x)\<close>
   shows \<open>partition_main R h lo hi xs \<le> SPEC(\<lambda>(xs', p). mset xs = mset xs' \<and>
      lo \<le> p \<and> p \<le> hi \<and> isPartition_map R h xs' lo hi p \<and> (\<forall> i. i<lo \<longrightarrow> xs'!i=xs!i) \<and> (\<forall> i. hi<i\<and>i<length xs' \<longrightarrow> xs'!i=xs!i))\<close>
 proof -
   have K: \<open>b \<le> hi - Suc n \<Longrightarrow> n > 0 \<Longrightarrow> Suc n \<le> hi \<Longrightarrow> Suc b \<le> hi - n\<close> for b hi n
     by auto
   have L: \<open>~ R (h x) (h y) \<Longrightarrow> R (h y) (h x)\<close> for x y \<comment> \<open>Corollary of linearity\<close>
     using assms by blast
   have M: \<open>a < Suc b \<equiv> a = b \<or> a < b\<close> for a b
     by linarith
   have N: \<open>(a::nat) \<le> b \<equiv> a = b \<or> a < b\<close> for a b
     by arith
 
   show ?thesis
     unfolding partition_main_def choose_pivot_def
     apply (refine_vcg WHILEIT_rule[where R = \<open>measure(\<lambda>(i,j,xs). hi-j)\<close>])
     subgoal using assms by blast \<comment> \<open>We feed our assumption to the assertion\<close>
     subgoal by auto \<comment> \<open>WF\<close>
     subgoal \<comment> \<open>Invariant holds before the first iteration\<close>
       unfolding partition_main_inv_def
       using assms apply simp by linarith
     subgoal unfolding partition_main_inv_def by simp
     subgoal unfolding partition_main_inv_def by simp
     subgoal
       unfolding partition_main_inv_def
       apply (auto dest: mset_eq_length)
       done
     subgoal unfolding partition_main_inv_def by (auto dest: mset_eq_length)
     subgoal
       unfolding partition_main_inv_def apply (auto dest: mset_eq_length)
       by (metis L M mset_eq_length nat_le_eq_or_lt)
 
     subgoal unfolding partition_main_inv_def by simp \<comment> \<open>assertions, etc\<close>
     subgoal unfolding partition_main_inv_def by simp
     subgoal unfolding partition_main_inv_def by (auto dest: mset_eq_length)
     subgoal unfolding partition_main_inv_def by simp
     subgoal unfolding partition_main_inv_def by (auto dest: mset_eq_length)
     subgoal unfolding partition_main_inv_def by (auto dest: mset_eq_length)
     subgoal unfolding partition_main_inv_def by (auto dest: mset_eq_length)
     subgoal unfolding partition_main_inv_def by simp
     subgoal unfolding partition_main_inv_def by simp
 
     subgoal \<comment> \<open>After the last iteration, we have a partitioning! :-)\<close>
       unfolding partition_main_inv_def by (auto simp add: isPartition_wrt_def)
     subgoal \<comment> \<open>And the lower out-of-bounds parts of the list haven't been changed\<close>
       unfolding partition_main_inv_def by auto
     subgoal \<comment> \<open>And the upper out-of-bounds parts of the list haven't been changed\<close>
       unfolding partition_main_inv_def by auto
     done
 qed
 
 
 definition partition_between :: \<open>('b \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> 'a list \<Rightarrow> ('a list \<times> nat) nres\<close> where
   \<open>partition_between R h lo hi xs0 = do {
     ASSERT(hi < length xs0 \<and> lo \<le> hi);
     k \<leftarrow> choose_pivot R h xs0 lo hi; \<comment> \<open>choice of pivot\<close>
     ASSERT(k < length xs0);
     xs \<leftarrow> RETURN (swap xs0 k hi); \<comment> \<open>move the pivot to the last position, before we start the actual loop\<close>
     ASSERT(length xs = length xs0);
     partition_main R h lo hi xs
   }\<close>
 
 
 lemma partition_between_correct:
   assumes \<open>hi < length xs\<close> and \<open>lo \<le> hi\<close> and
   \<open>\<And> x y z. \<lbrakk>R (h x) (h y); R (h y) (h z)\<rbrakk> \<Longrightarrow> R (h x) (h z)\<close> and \<open>\<And>x y. R (h x) (h y) \<or> R (h y) (h x)\<close>
   shows \<open>partition_between R h lo hi xs \<le> SPEC(uncurry (partition_spec R h xs lo hi))\<close>
 proof -
   have K: \<open>b \<le> hi - Suc n \<Longrightarrow> n > 0 \<Longrightarrow> Suc n \<le> hi \<Longrightarrow> Suc b \<le> hi - n\<close> for b hi n
     by auto
   show ?thesis
     unfolding partition_between_def choose_pivot_def
     apply (refine_vcg partition_main_correct)
     using assms apply (auto dest: mset_eq_length simp add: partition_spec_def)
     by (metis dual_order.strict_trans2 less_imp_not_eq2 mset_eq_length swap_nth)
 qed
 
 
 
 text \<open>We use the median of the first, the middle, and the last element.\<close>
 definition choose_pivot3 where
   \<open>choose_pivot3 R h xs lo (hi::nat) = do {
     ASSERT(lo < length xs);
     ASSERT(hi < length xs);
     let k' = (hi - lo) div 2;
     let k = lo + k';
     ASSERT(k < length xs);
     let start = h (xs ! lo);
     let mid = h (xs ! k);
     let end = h (xs ! hi);
     if (R start mid \<and> R mid end) \<or> (R end mid \<and> R mid start) then RETURN k
     else if (R start end \<and> R end mid) \<or> (R mid end \<and> R end start) then RETURN hi
     else RETURN lo
 }\<close>
 
 \<comment> \<open>We only have to show that this procedure yields a valid index between \<open>lo\<close> and \<open>hi\<close>.\<close>
 lemma choose_pivot3_choose_pivot:
   assumes \<open>lo < length xs\<close> \<open>hi < length xs\<close> \<open>hi \<ge> lo\<close>
   shows \<open>choose_pivot3 R h xs lo hi \<le> \<Down> Id (choose_pivot R h xs lo hi)\<close>
   unfolding choose_pivot3_def choose_pivot_def
   using assms by (auto intro!: ASSERT_leI simp: Let_def)
 
 text \<open>The refined partion function: We use the above pivot function and fold instead of non-deterministic iteration.\<close>
 definition partition_between_ref
   :: \<open>('b \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> 'a list \<Rightarrow> ('a list \<times> nat) nres\<close>
 where
   \<open>partition_between_ref R h lo hi xs0 = do {
     ASSERT(hi < length xs0 \<and> hi < length xs0 \<and> lo \<le> hi);
     k \<leftarrow> choose_pivot3 R h xs0 lo hi; \<comment> \<open>choice of pivot\<close>
     ASSERT(k < length xs0);
     xs \<leftarrow> RETURN (swap xs0 k hi); \<comment> \<open>move the pivot to the last position, before we start the actual loop\<close>
     ASSERT(length xs = length xs0);
     partition_main R h lo hi xs
   }\<close>
 
 
 lemma partition_main_ref':
   \<open>partition_main R h lo hi xs
     \<le> \<Down> ((\<lambda> a b c d. Id) a b c d) (partition_main R h lo hi xs)\<close>
   by auto
 
 
 (*TODO already exists somewhere*)
 lemma Down_id_eq:
   \<open>\<Down>Id x = x\<close>
   by auto
 
 lemma partition_between_ref_partition_between:
   \<open>partition_between_ref R h lo hi xs \<le> (partition_between R h lo hi xs)\<close>
 proof -
   have swap: \<open>(swap xs k hi, swap xs ka hi) \<in> Id\<close> if \<open>k = ka\<close>
     for k ka
     using that by auto
   have [refine0]: \<open>(h (xsa ! hi), h (xsaa ! hi)) \<in> Id\<close>
     if \<open>(xsa, xsaa) \<in> Id\<close>
     for xsa xsaa
     using that by auto
 
   show ?thesis
     apply (subst (2) Down_id_eq[symmetric])
     unfolding partition_between_ref_def
       partition_between_def
       OP_def
     apply (refine_vcg choose_pivot3_choose_pivot swap partition_main_correct)
     subgoal by auto
     subgoal by auto
     subgoal by auto
     subgoal by auto
     subgoal by auto
     subgoal by auto
     subgoal by auto
     subgoal by auto
     subgoal by auto
     by (auto intro: Refine_Basic.Id_refine dest: mset_eq_length)
 qed
 
 text \<open>Technical lemma for sepref\<close>
 
 lemma partition_between_ref_partition_between':
   \<open>(uncurry2 (partition_between_ref R h), uncurry2 (partition_between R h)) \<in>
     (nat_rel \<times>\<^sub>r nat_rel) \<times>\<^sub>r \<langle>Id\<rangle>list_rel \<rightarrow>\<^sub>f \<langle>\<langle>Id\<rangle>list_rel \<times>\<^sub>r nat_rel\<rangle>nres_rel\<close>
   by (intro frefI nres_relI)
     (auto intro: partition_between_ref_partition_between)
 
 text \<open>Example instantiation for pivot\<close>
 definition choose_pivot3_impl where
   \<open>choose_pivot3_impl = choose_pivot3 (\<le>) id\<close>
 
 
 lemma partition_between_ref_correct:
   assumes trans: \<open>\<And> x y z. \<lbrakk>R (h x) (h y); R (h y) (h z)\<rbrakk> \<Longrightarrow> R (h x) (h z)\<close> and lin: \<open>\<And>x y. R (h x) (h y) \<or> R (h y) (h x)\<close>
     and bounds: \<open>hi < length xs\<close> \<open>lo \<le> hi\<close>
   shows \<open>partition_between_ref R h lo hi xs \<le> SPEC (uncurry (partition_spec R h xs lo hi))\<close>
 proof -
   show ?thesis
     apply (rule partition_between_ref_partition_between[THEN order_trans])
     using bounds apply (rule partition_between_correct[where h=h])
     subgoal by (rule trans)
     subgoal by (rule lin)
     done
 qed
 
 
 text \<open>Refined quicksort algorithm: We use the refined partition function.\<close>
 definition quicksort_ref :: \<open>_ \<Rightarrow> _ \<Rightarrow> nat \<times> nat \<times> 'a list \<Rightarrow> 'a list nres\<close> where
 \<open>quicksort_ref R h = (\<lambda>(lo,hi,xs0).
   do {
   RECT (\<lambda>f (lo,hi,xs). do {
       ASSERT(lo \<le> hi \<and> hi < length xs0 \<and> mset xs = mset xs0);
       (xs, p) \<leftarrow> partition_between_ref R h lo hi xs; \<comment> \<open>This is the refined partition function. Note that we need the premises (trans,lin,bounds) here.\<close>
       ASSERT(mset xs = mset xs0 \<and> p \<ge> lo \<and> p < length xs0);
       xs \<leftarrow> (if p-1\<le>lo then RETURN xs else f (lo, p-1, xs));
       ASSERT(mset xs = mset xs0);
       if hi\<le>p+1 then RETURN xs else f (p+1, hi, xs)
     }) (lo,hi,xs0)
   })\<close>
 
 
 (*TODO share*)
 lemma fref_to_Down_curry2:
   \<open>(uncurry2 f, uncurry2 g) \<in> [P]\<^sub>f A \<rightarrow> \<langle>B\<rangle>nres_rel \<Longrightarrow>
      (\<And>x x' y y' z z'. P ((x', y'), z') \<Longrightarrow> (((x, y), z), ((x', y'), z')) \<in> A\<Longrightarrow>
          f x y z \<le> \<Down> B (g x' y' z'))\<close>
   unfolding fref_def uncurry_def nres_rel_def
   by auto
 
 lemma fref_to_Down_curry:
   \<open>(f, g) \<in> [P]\<^sub>f A \<rightarrow> \<langle>B\<rangle>nres_rel \<Longrightarrow>
      (\<And>x x' . P x' \<Longrightarrow> (x, x') \<in> A\<Longrightarrow>
          f x  \<le> \<Down> B (g x'))\<close>
   unfolding fref_def uncurry_def nres_rel_def
   by auto
 
 
 
 lemma quicksort_ref_quicksort:
   assumes bounds: \<open>hi < length xs\<close> \<open>lo \<le> hi\<close> and
     trans: \<open>\<And> x y z. \<lbrakk>R (h x) (h y); R (h y) (h z)\<rbrakk> \<Longrightarrow> R (h x) (h z)\<close> and lin: \<open>\<And>x y. R (h x) (h y) \<or> R (h y) (h x)\<close>
   shows \<open>quicksort_ref R h x0 \<le> \<Down> Id (quicksort R h x0)\<close>
 proof -
   have wf: \<open>wf (measure (\<lambda>(lo, hi, xs). Suc hi - lo))\<close>
     by auto
   have pre: \<open>x0 = x0' \<Longrightarrow> (x0, x0') \<in> Id \<times>\<^sub>r Id \<times>\<^sub>r \<langle>Id\<rangle>list_rel\<close> for x0 x0' :: \<open>nat \<times> nat \<times> 'b list\<close>
     by auto
   have [refine0]: \<open>(x1e = x1d) \<Longrightarrow> (x1e,x1d) \<in> Id\<close> for x1e x1d :: \<open>'b list\<close>
     by auto
 
   show ?thesis
     unfolding quicksort_def quicksort_ref_def
     apply (refine_vcg pre partition_between_ref_partition_between'[THEN fref_to_Down_curry2])
 
     text \<open>First assertion (premise for partition)\<close>
     subgoal
       by auto
     text \<open>First assertion (premise for partition)\<close>
     subgoal
       by auto
     subgoal
       by (auto dest: mset_eq_length)
     subgoal
       by (auto dest: mset_eq_length mset_eq_setD)
 
     text \<open>Correctness of the concrete partition function\<close>
     subgoal
       apply (simp, rule partition_between_ref_correct)
       subgoal by (rule trans)
       subgoal by (rule lin)
       subgoal by auto \<comment> \<open>first premise\<close>
       subgoal by auto \<comment> \<open>second premise\<close>
       done
     subgoal
       by (auto dest: mset_eq_length mset_eq_setD)
     subgoal by (auto simp: partition_spec_def isPartition_wrt_def)
     subgoal by (auto simp: partition_spec_def isPartition_wrt_def dest: mset_eq_length)
     subgoal
       by (auto dest: mset_eq_length mset_eq_setD)
     subgoal
       by (auto dest: mset_eq_length mset_eq_setD)
     subgoal
       by (auto dest: mset_eq_length mset_eq_setD)
     subgoal
       by (auto dest: mset_eq_length mset_eq_setD)
 
     by simp+
 qed
 
 \<comment> \<open>Sort the entire list\<close>
 definition full_quicksort where
   \<open>full_quicksort R h xs \<equiv> if xs = [] then RETURN xs else quicksort R h (0, length xs - 1, xs)\<close>
 
 definition full_quicksort_ref where
   \<open>full_quicksort_ref R h xs \<equiv>
     if List.null xs then RETURN xs
     else quicksort_ref R h (0, length xs - 1, xs)\<close>
 
 definition full_quicksort_impl :: \<open>nat list \<Rightarrow> nat list nres\<close> where
   \<open>full_quicksort_impl xs = full_quicksort_ref (\<le>) id xs\<close>
 
 lemma full_quicksort_ref_full_quicksort:
   assumes trans: \<open>\<And> x y z. \<lbrakk>R (h x) (h y); R (h y) (h z)\<rbrakk> \<Longrightarrow> R (h x) (h z)\<close> and lin: \<open>\<And>x y. R (h x) (h y) \<or> R (h y) (h x)\<close>
   shows \<open>(full_quicksort_ref R h, full_quicksort R h) \<in>
           \<langle>Id\<rangle>list_rel \<rightarrow>\<^sub>f \<langle> \<langle>Id\<rangle>list_rel\<rangle>nres_rel\<close>
 proof -
   show ?thesis
     unfolding full_quicksort_ref_def full_quicksort_def
     apply (intro frefI nres_relI)
     apply (auto intro!: quicksort_ref_quicksort[unfolded Down_id_eq] simp: List.null_def)
     subgoal by (rule trans)
     subgoal using lin by blast
     done
 qed
 
 
 lemma sublist_entire:
   \<open>sublist xs 0 (length xs - 1) = xs\<close>
   by (simp add: sublist_def)
 
 
 lemma sorted_sublist_wrt_entire:
   assumes \<open>sorted_sublist_wrt R xs 0 (length xs - 1)\<close>
   shows \<open>sorted_wrt R xs\<close>
 proof -
   have \<open>sorted_wrt R (sublist xs 0 (length xs - 1))\<close>
     using assms by (simp add: sorted_sublist_wrt_def )
   then show ?thesis
     by (metis sublist_entire)
 qed
 
 lemma sorted_sublist_map_entire:
   assumes \<open>sorted_sublist_map R h xs 0 (length xs - 1)\<close>
   shows \<open>sorted_wrt (\<lambda> x y. R (h x) (h y)) xs\<close>
 proof -
   show ?thesis
     using assms by (rule sorted_sublist_wrt_entire)
 qed
 
 
 text \<open>Final correctness lemma\<close>
 theorem full_quicksort_correct_sorted:
   assumes
     trans: \<open>\<And>x y z. \<lbrakk>R (h x) (h y); R (h y) (h z)\<rbrakk> \<Longrightarrow> R (h x) (h z)\<close> and lin: \<open>\<And>x y. x \<noteq> y \<Longrightarrow> R (h x) (h y) \<or> R (h y) (h x)\<close>
   shows \<open>full_quicksort R h xs \<le> \<Down> Id (SPEC(\<lambda>xs'. mset xs' = mset xs \<and> sorted_wrt (\<lambda> x y. R (h x) (h y)) xs'))\<close>
 proof -
   show ?thesis
     unfolding full_quicksort_def
     apply (refine_vcg)
     subgoal by simp \<comment> \<open>case xs=[]\<close>
     subgoal by simp \<comment> \<open>case xs=[]\<close>
 
     apply (rule quicksort_correct[THEN order_trans])
     subgoal by (rule trans)
     subgoal by (rule lin)
     subgoal by linarith
     subgoal by simp
 
     apply (simp add: Misc.subset_Collect_conv, intro allI impI conjI)
     subgoal
       by (auto simp add: quicksort_post_def)
     subgoal
       apply (rule sorted_sublist_map_entire)
       by (auto simp add: quicksort_post_def dest: mset_eq_length)
     done
 qed
 
 lemma full_quicksort_correct:
   assumes
     trans: \<open>\<And>x y z. \<lbrakk>R (h x) (h y); R (h y) (h z)\<rbrakk> \<Longrightarrow> R (h x) (h z)\<close> and
     lin: \<open>\<And>x y. R (h x) (h y) \<or> R (h y) (h x)\<close>
   shows \<open>full_quicksort R h xs \<le> \<Down> Id (SPEC(\<lambda>xs'. mset xs' = mset xs))\<close>
   by (rule order_trans[OF full_quicksort_correct_sorted])
     (use assms in auto)
 
 end