diff --git a/thys/PAC_Checker/Duplicate_Free_Multiset.thy b/thys/PAC_Checker/Duplicate_Free_Multiset.thy
new file mode 100644
--- /dev/null
+++ b/thys/PAC_Checker/Duplicate_Free_Multiset.thy
@@ -0,0 +1,157 @@
+(*
+  File:         Duplicate_Free_Multiset.thy
+  Author:       Mathias Fleury, Daniela Kaufmann, JKU
+  Maintainer:   Mathias Fleury, JKU
+*)
+theory Duplicate_Free_Multiset
+imports Nested_Multisets_Ordinals.Multiset_More
+begin
+
+
+section \<open>Duplicate Free Multisets\<close>
+
+(* TODO Move Multiset_More *)
+lemma remove_diff_multiset[simp]: \<open>x13 \<notin># A \<Longrightarrow> A - add_mset x13 B = A - B\<close>
+  by (metis diff_intersect_left_idem inter_add_right1)
+
+
+text \<open>Duplicate free multisets are isomorphic to finite sets, but it can be useful to reason about
+  duplication to speak about intermediate execution steps in the refinements.
+\<close>
+lemma distinct_mset_remdups_mset_id: \<open>distinct_mset C \<Longrightarrow> remdups_mset C = C\<close>
+  by (induction C)  auto
+
+lemma notin_add_mset_remdups_mset:
+  \<open>a \<notin># A \<Longrightarrow> add_mset a (remdups_mset A) = remdups_mset (add_mset a A)\<close>
+  by auto
+
+lemma distinct_mset_image_mset:
+  \<open>distinct_mset (image_mset f (mset xs)) \<longleftrightarrow> distinct (map f xs)\<close>
+  apply (subst mset_map[symmetric])
+  apply (subst distinct_mset_mset_distinct)
+  ..
+
+lemma distinct_mset_mono: \<open>D' \<subseteq># D \<Longrightarrow> distinct_mset D \<Longrightarrow> distinct_mset D'\<close>
+  by (metis distinct_mset_union subset_mset.le_iff_add)
+
+lemma distinct_mset_mono_strict: \<open>D' \<subset># D \<Longrightarrow> distinct_mset D \<Longrightarrow> distinct_mset D'\<close>
+  using distinct_mset_mono by auto
+
+lemma distinct_set_mset_eq_iff:
+  assumes \<open>distinct_mset M\<close> \<open>distinct_mset N\<close>
+  shows \<open>set_mset M = set_mset N \<longleftrightarrow> M = N\<close>
+  using assms distinct_mset_set_mset_ident by fastforce
+
+lemma distinct_mset_union2:
+  \<open>distinct_mset (A + B) \<Longrightarrow> distinct_mset B\<close>
+  using distinct_mset_union[of B A]
+  by (auto simp: ac_simps)
+
+lemma distinct_mset_mset_set: \<open>distinct_mset (mset_set A)\<close>
+  unfolding distinct_mset_def count_mset_set_if by (auto simp: not_in_iff)
+
+lemma distinct_mset_inter_remdups_mset:
+  assumes dist: \<open>distinct_mset A\<close>
+  shows \<open>A \<inter># remdups_mset B = A \<inter># B\<close>
+proof -
+  have [simp]: \<open>A' \<inter># remove1_mset a (remdups_mset Aa) = A' \<inter># Aa\<close>
+    if
+      \<open>A' \<inter># remdups_mset Aa = A' \<inter># Aa\<close> and
+      \<open>a \<notin># A'\<close> and
+      \<open>a \<in># Aa\<close>
+    for A' Aa :: \<open>'a multiset\<close> and a
+  by (metis insert_DiffM inter_add_right1 set_mset_remdups_mset that)
+
+  show ?thesis
+    using dist
+    apply (induction A)
+    subgoal by auto
+     subgoal for a A'
+       by (cases \<open>a \<in># B\<close>)
+         (use multi_member_split[of a \<open>B\<close>]  multi_member_split[of a \<open>A\<close>] in
+           \<open>auto simp: mset_set.insert_remove\<close>)
+    done
+qed
+
+lemma finite_mset_set_inter:
+  \<open>finite A \<Longrightarrow> finite B \<Longrightarrow> mset_set (A \<inter> B) = mset_set A \<inter># mset_set B\<close>
+  apply (induction A rule: finite_induct)
+  subgoal by auto
+  subgoal for a A
+    by (cases \<open>a \<in> B\<close>; cases \<open>a \<in># mset_set B\<close>)
+      (use multi_member_split[of a \<open>mset_set B\<close>] in
+        \<open>auto simp: mset_set.insert_remove\<close>)
+  done
+
+lemma removeAll_notin: \<open>a \<notin># A \<Longrightarrow> removeAll_mset a A = A\<close>
+  using count_inI by force
+
+lemma same_mset_distinct_iff:
+  \<open>mset M = mset M' \<Longrightarrow> distinct M \<longleftrightarrow> distinct M'\<close>
+  by (auto simp: distinct_mset_mset_distinct[symmetric] simp del: distinct_mset_mset_distinct)
+
+
+subsection \<open>More Lists\<close>
+lemma in_set_conv_iff:
+  \<open>x \<in> set (take n xs) \<longleftrightarrow> (\<exists>i < n. i < length xs \<and> xs ! i = x)\<close>
+  apply (induction n)
+  subgoal by auto
+  subgoal for n
+    apply (cases \<open>Suc n < length xs\<close>)
+    subgoal by (auto simp: take_Suc_conv_app_nth less_Suc_eq dest: in_set_takeD)
+    subgoal
+      apply (cases \<open>n < length xs\<close>)
+      subgoal
+        apply (auto simp: in_set_conv_nth)
+        by (rename_tac i, rule_tac x=i in exI; auto; fail)+
+      subgoal
+        apply (auto simp: take_Suc_conv_app_nth dest: in_set_takeD)
+        by (rename_tac i, rule_tac x=i in exI; auto; fail)+
+      done
+    done
+  done
+
+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 in_set_remove1D:
+  \<open>a \<in> set (remove1 x xs) \<Longrightarrow> a \<in> set xs\<close>
+  by (meson notin_set_remove1)
+
+
+subsection \<open>Generic Multiset\<close>
+
+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)
+  show ?case
+    apply (cases a)
+    using Cons[of 0] Cons by (auto simp: nth_Cons drop_Cons H mset_case_Suc *)
+qed
+
+
+subsection \<open>Other\<close>
+
+text \<open>I believe this should be added to the simplifier by default...\<close>
+lemma Collect_eq_comp': \<open> {(x, y). P x y} O {(c, a). c = f a} = {(x, a). P x (f a)}\<close>
+  by auto
+
+end
diff --git a/thys/PAC_Checker/Finite_Map_Multiset.thy b/thys/PAC_Checker/Finite_Map_Multiset.thy
new file mode 100644
--- /dev/null
+++ b/thys/PAC_Checker/Finite_Map_Multiset.thy
@@ -0,0 +1,227 @@
+(*
+  File:         Finite_Map_Multiset.thy
+  Author:       Mathias Fleury, Daniela Kaufmann, JKU
+  Maintainer:   Mathias Fleury, JKU
+*)
+theory Finite_Map_Multiset
+imports "HOL-Library.Finite_Map" Duplicate_Free_Multiset
+begin
+
+notation image_mset (infixr "`#" 90)
+
+section \<open>Finite maps and multisets\<close>
+
+subsection \<open>Finite sets and multisets\<close>
+
+abbreviation mset_fset :: \<open>'a fset \<Rightarrow> 'a multiset\<close> where
+  \<open>mset_fset N \<equiv> mset_set (fset N)\<close>
+
+definition fset_mset :: \<open>'a multiset \<Rightarrow> 'a fset\<close> where
+  \<open>fset_mset N \<equiv> Abs_fset (set_mset N)\<close>
+
+lemma fset_mset_mset_fset: \<open>fset_mset (mset_fset N) = N\<close>
+  by (auto simp: fset.fset_inverse fset_mset_def)
+
+lemma mset_fset_fset_mset[simp]:
+  \<open>mset_fset (fset_mset N) = remdups_mset N\<close>
+  by (auto simp: fset.fset_inverse fset_mset_def Abs_fset_inverse remdups_mset_def)
+
+lemma in_mset_fset_fmember[simp]: \<open>x \<in># mset_fset N \<longleftrightarrow> x |\<in>| N\<close>
+  by (auto simp: fmember.rep_eq)
+
+lemma in_fset_mset_mset[simp]: \<open>x |\<in>| fset_mset N \<longleftrightarrow> x \<in># N\<close>
+  by (auto simp: fmember.rep_eq fset_mset_def Abs_fset_inverse)
+
+
+subsection \<open>Finite map and multisets\<close>
+
+text \<open>Roughly the same as \<^term>\<open>ran\<close> and \<^term>\<open>dom\<close>, but with duplication in the content (unlike their
+  finite sets counterpart) while still working on finite domains (unlike a function mapping).
+  Remark that \<^term>\<open>dom_m\<close> (the keys) does not contain duplicates, but we keep for symmetry (and for
+  easier use of multiset operators as in the definition of \<^term>\<open>ran_m\<close>).
+\<close>
+definition dom_m where
+  \<open>dom_m N = mset_fset (fmdom N)\<close>
+
+definition ran_m where
+  \<open>ran_m N = the `# fmlookup N `# dom_m N\<close>
+
+lemma dom_m_fmdrop[simp]: \<open>dom_m (fmdrop C N) = remove1_mset C (dom_m N)\<close>
+  unfolding dom_m_def
+  by (cases \<open>C |\<in>| fmdom N\<close>)
+    (auto simp: mset_set.remove fmember.rep_eq)
+
+lemma dom_m_fmdrop_All: \<open>dom_m (fmdrop C N) = removeAll_mset C (dom_m N)\<close>
+  unfolding dom_m_def
+  by (cases \<open>C |\<in>| fmdom N\<close>)
+    (auto simp: mset_set.remove fmember.rep_eq)
+
+lemma dom_m_fmupd[simp]: \<open>dom_m (fmupd k C N) = add_mset k (remove1_mset k (dom_m N))\<close>
+  unfolding dom_m_def
+  by (cases \<open>k |\<in>| fmdom N\<close>)
+    (auto simp: mset_set.remove fmember.rep_eq mset_set.insert_remove)
+
+lemma distinct_mset_dom: \<open>distinct_mset (dom_m N)\<close>
+  by (simp add: distinct_mset_mset_set dom_m_def)
+
+lemma in_dom_m_lookup_iff: \<open>C \<in># dom_m N' \<longleftrightarrow> fmlookup N' C \<noteq> None\<close>
+  by (auto simp: dom_m_def fmdom.rep_eq fmlookup_dom'_iff)
+
+lemma in_dom_in_ran_m[simp]: \<open>i \<in># dom_m N \<Longrightarrow> the (fmlookup N i) \<in># ran_m N\<close>
+  by (auto simp: ran_m_def)
+
+lemma fmupd_same[simp]:
+  \<open>x1 \<in># dom_m x1aa \<Longrightarrow> fmupd x1 (the (fmlookup x1aa x1)) x1aa = x1aa\<close>
+  by (metis fmap_ext fmupd_lookup in_dom_m_lookup_iff option.collapse)
+
+lemma ran_m_fmempty[simp]: \<open>ran_m fmempty = {#}\<close> and
+    dom_m_fmempty[simp]: \<open>dom_m fmempty = {#}\<close>
+  by (auto simp: ran_m_def dom_m_def)
+
+lemma fmrestrict_set_fmupd:
+  \<open>a \<in> xs \<Longrightarrow> fmrestrict_set xs (fmupd a C N) = fmupd a C (fmrestrict_set xs N)\<close>
+  \<open>a \<notin> xs \<Longrightarrow> fmrestrict_set xs (fmupd a C N) = fmrestrict_set xs N\<close>
+  by (auto simp: fmfilter_alt_defs)
+
+lemma fset_fmdom_fmrestrict_set:
+  \<open>fset (fmdom (fmrestrict_set xs N)) = fset (fmdom N) \<inter> xs\<close>
+  by (auto simp: fmfilter_alt_defs)
+
+lemma dom_m_fmrestrict_set: \<open>dom_m (fmrestrict_set (set xs) N) = mset xs \<inter># dom_m N\<close>
+  using fset_fmdom_fmrestrict_set[of \<open>set xs\<close> N] distinct_mset_dom[of N]
+  distinct_mset_inter_remdups_mset[of \<open>mset_fset (fmdom N)\<close> \<open>mset xs\<close>]
+  by (auto simp: dom_m_def fset_mset_mset_fset finite_mset_set_inter multiset_inter_commute
+    remdups_mset_def)
+
+lemma dom_m_fmrestrict_set': \<open>dom_m (fmrestrict_set xs N) = mset_set (xs \<inter> set_mset (dom_m N))\<close>
+  using fset_fmdom_fmrestrict_set[of \<open>xs\<close> N] distinct_mset_dom[of N]
+  by (auto simp: dom_m_def fset_mset_mset_fset finite_mset_set_inter multiset_inter_commute
+    remdups_mset_def)
+
+lemma indom_mI: \<open>fmlookup m x = Some y \<Longrightarrow> x \<in># dom_m m\<close>
+  by (drule fmdomI)  (auto simp: dom_m_def fmember.rep_eq)
+
+lemma fmupd_fmdrop_id:
+  assumes \<open>k |\<in>| fmdom N'\<close>
+  shows \<open>fmupd k (the (fmlookup N' k)) (fmdrop k N') = N'\<close>
+proof -
+  have [simp]: \<open>map_upd k (the (fmlookup N' k))
+       (\<lambda>x. if x \<noteq> k then fmlookup N' x else None) =
+     map_upd k (the (fmlookup N' k))
+       (fmlookup N')\<close>
+    by (auto intro!: ext simp: map_upd_def)
+  have [simp]: \<open>map_upd k (the (fmlookup N' k)) (fmlookup N') = fmlookup N'\<close>
+    using assms
+    by (auto intro!: ext simp: map_upd_def)
+  have [simp]: \<open>finite (dom (\<lambda>x. if x = k then None else fmlookup N' x))\<close>
+    by (subst dom_if) auto
+  show ?thesis
+    apply (auto simp: fmupd_def fmupd.abs_eq[symmetric])
+    unfolding fmlookup_drop
+    apply (simp add: fmlookup_inverse)
+    done
+qed
+
+lemma fm_member_split: \<open>k |\<in>| fmdom N' \<Longrightarrow> \<exists>N'' v. N' = fmupd k v N'' \<and> the (fmlookup N' k) = v \<and>
+    k |\<notin>| fmdom N''\<close>
+  by (rule exI[of _ \<open>fmdrop k N'\<close>])
+    (auto simp: fmupd_fmdrop_id)
+
+lemma \<open>fmdrop k (fmupd k va N'') = fmdrop k N''\<close>
+  by (simp add: fmap_ext)
+
+lemma fmap_ext_fmdom:
+  \<open>(fmdom N = fmdom N') \<Longrightarrow> (\<And> x. x |\<in>| fmdom N \<Longrightarrow> fmlookup N x = fmlookup N' x) \<Longrightarrow>
+       N = N'\<close>
+  by (rule fmap_ext)
+    (case_tac \<open>x |\<in>| fmdom N\<close>, auto simp: fmdom_notD)
+
+lemma fmrestrict_set_insert_in:
+  \<open>xa  \<in> fset (fmdom N) \<Longrightarrow>
+    fmrestrict_set (insert xa l1) N = fmupd xa (the (fmlookup N xa)) (fmrestrict_set l1 N)\<close>
+  apply (rule fmap_ext_fmdom)
+   apply (auto simp: fset_fmdom_fmrestrict_set fmember.rep_eq notin_fset; fail)[]
+  apply (auto simp: fmlookup_dom_iff; fail)
+  done
+
+lemma fmrestrict_set_insert_notin:
+  \<open>xa  \<notin> fset (fmdom N) \<Longrightarrow>
+    fmrestrict_set (insert xa l1) N = fmrestrict_set l1 N\<close>
+  by (rule fmap_ext_fmdom)
+     (auto simp: fset_fmdom_fmrestrict_set fmember.rep_eq notin_fset)
+
+lemma fmrestrict_set_insert_in_dom_m[simp]:
+  \<open>xa  \<in># dom_m N \<Longrightarrow>
+    fmrestrict_set (insert xa l1) N = fmupd xa (the (fmlookup N xa)) (fmrestrict_set l1 N)\<close>
+  by (simp add: fmrestrict_set_insert_in dom_m_def)
+
+lemma fmrestrict_set_insert_notin_dom_m[simp]:
+  \<open>xa  \<notin># dom_m N \<Longrightarrow>
+    fmrestrict_set (insert xa l1) N = fmrestrict_set l1 N\<close>
+  by (simp add: fmrestrict_set_insert_notin dom_m_def)
+
+lemma fmlookup_restrict_set_id: \<open>fset (fmdom N) \<subseteq> A \<Longrightarrow> fmrestrict_set A N = N\<close>
+  by (metis fmap_ext fmdom'_alt_def fmdom'_notD fmlookup_restrict_set subset_iff)
+
+lemma fmlookup_restrict_set_id': \<open>set_mset (dom_m N) \<subseteq> A \<Longrightarrow> fmrestrict_set A N = N\<close>
+  by (rule fmlookup_restrict_set_id)
+    (auto simp: dom_m_def)
+
+lemma ran_m_mapsto_upd:
+  assumes
+    NC: \<open>C \<in># dom_m N\<close>
+  shows \<open>ran_m (fmupd C C' N) = add_mset C' (remove1_mset (the (fmlookup N C)) (ran_m N))\<close>
+proof -
+  define N' where
+    \<open>N' = fmdrop C N\<close>
+  have N_N': \<open>dom_m N = add_mset C (dom_m N')\<close>
+    using NC unfolding N'_def by auto
+  have \<open>C \<notin># dom_m N'\<close>
+    using NC distinct_mset_dom[of N] unfolding N_N' by auto
+  then show ?thesis
+    by (auto simp: N_N' ran_m_def mset_set.insert_remove image_mset_remove1_mset_if
+      intro!: image_mset_cong)
+qed
+
+lemma ran_m_mapsto_upd_notin:
+  assumes NC: \<open>C \<notin># dom_m N\<close>
+  shows \<open>ran_m (fmupd C C' N) = add_mset C' (ran_m N)\<close>
+  using NC
+  by (auto simp: ran_m_def mset_set.insert_remove image_mset_remove1_mset_if
+      intro!: image_mset_cong split: if_splits)
+
+lemma image_mset_If_eq_notin:
+   \<open>C \<notin># A \<Longrightarrow> {#f (if x = C then a x else b x). x \<in># A#} = {# f(b x). x \<in># A #}\<close>
+  by (induction A) auto
+
+lemma filter_mset_cong2:
+  "(\<And>x. x \<in># M \<Longrightarrow> f x = g x) \<Longrightarrow> M = N \<Longrightarrow> filter_mset f M = filter_mset g N"
+  by (hypsubst, rule filter_mset_cong, simp)
+
+lemma ran_m_fmdrop:
+  \<open>C \<in># dom_m N \<Longrightarrow>  ran_m (fmdrop C N) = remove1_mset (the (fmlookup N C)) (ran_m N)\<close>
+  using distinct_mset_dom[of N]
+  by (cases \<open>fmlookup N C\<close>)
+    (auto simp: ran_m_def image_mset_If_eq_notin[of C _ \<open>\<lambda>x. fst (the x)\<close>]
+     dest!: multi_member_split
+     intro!: filter_mset_cong2 image_mset_cong2)
+
+lemma ran_m_fmdrop_notin:
+  \<open>C \<notin># dom_m N \<Longrightarrow> ran_m (fmdrop C N) = ran_m N\<close>
+  using distinct_mset_dom[of N]
+  by (auto simp: ran_m_def image_mset_If_eq_notin[of C _ \<open>\<lambda>x. fst (the x)\<close>]
+    dest!: multi_member_split
+    intro!: filter_mset_cong2 image_mset_cong2)
+
+lemma ran_m_fmdrop_If:
+  \<open>ran_m (fmdrop C N) = (if C \<in># dom_m N then remove1_mset (the (fmlookup N C)) (ran_m N) else ran_m N)\<close>
+  using distinct_mset_dom[of N]
+  by (auto simp: ran_m_def image_mset_If_eq_notin[of C _ \<open>\<lambda>x. fst (the x)\<close>]
+    dest!: multi_member_split
+    intro!: filter_mset_cong2 image_mset_cong2)
+
+lemma dom_m_empty_iff[iff]:
+  \<open>dom_m NU = {#} \<longleftrightarrow> NU = fmempty\<close>
+  by (cases NU) (auto simp: dom_m_def mset_set.insert_remove)
+
+end
\ No newline at end of file
diff --git a/thys/PAC_Checker/More_Loops.thy b/thys/PAC_Checker/More_Loops.thy
new file mode 100644
--- /dev/null
+++ b/thys/PAC_Checker/More_Loops.thy
@@ -0,0 +1,128 @@
+(*
+  File:         More_Loops.thy
+  Author:       Mathias Fleury, Daniela Kaufmann, JKU
+  Maintainer:   Mathias Fleury, JKU
+*)
+theory More_Loops
+imports
+  "Refine_Monadic.Refine_While"
+  "Refine_Monadic.Refine_Foreach"
+  "HOL-Library.Rewrite"
+begin
+
+subsection \<open>More Theorem about Loops\<close>
+
+text \<open>Most theorem below have a counterpart in the Refinement Framework that is weaker (by missing
+  assertions for example that are critical for code generation).
+\<close>
+lemma Down_id_eq:
+  \<open>\<Down>Id x = x\<close>
+  by auto
+
+lemma while_upt_while_direct1:
+  "b \<ge> a \<Longrightarrow>
+  do {
+    (_,\<sigma>) \<leftarrow> WHILE\<^sub>T (FOREACH_cond c) (\<lambda>x. do {ASSERT (FOREACH_cond c x); FOREACH_body f x})
+      ([a..<b],\<sigma>);
+    RETURN \<sigma>
+  } \<le> do {
+    (_,\<sigma>) \<leftarrow> WHILE\<^sub>T (\<lambda>(i, x). i < b \<and> c x) (\<lambda>(i, x). do {ASSERT (i < b);  \<sigma>'\<leftarrow>f i x; RETURN (i+1,\<sigma>')
+}) (a,\<sigma>);
+    RETURN \<sigma>
+  }"
+  apply (rewrite at \<open>_ \<le> \<hole>\<close> Down_id_eq[symmetric])
+  apply (refine_vcg WHILET_refine[where R = \<open>{((l, x'), (i::nat, x::'a)). x= x' \<and> i \<le> b \<and> i \<ge> a \<and>
+     l = drop (i-a) [a..<b]}\<close>])
+  subgoal by auto
+  subgoal by (auto simp: FOREACH_cond_def)
+  subgoal by (auto simp: FOREACH_body_def intro!: bind_refine[OF Id_refine])
+  subgoal by auto
+  done
+
+lemma while_upt_while_direct2:
+  "b \<ge> a \<Longrightarrow>
+  do {
+    (_,\<sigma>) \<leftarrow> WHILE\<^sub>T (FOREACH_cond c) (\<lambda>x. do {ASSERT (FOREACH_cond c x); FOREACH_body f x})
+      ([a..<b],\<sigma>);
+    RETURN \<sigma>
+  } \<ge> do {
+    (_,\<sigma>) \<leftarrow> WHILE\<^sub>T (\<lambda>(i, x). i < b \<and> c x) (\<lambda>(i, x). do {ASSERT (i < b);  \<sigma>'\<leftarrow>f i x; RETURN (i+1,\<sigma>')
+}) (a,\<sigma>);
+    RETURN \<sigma>
+  }"
+  apply (rewrite at \<open>_ \<le> \<hole>\<close> Down_id_eq[symmetric])
+  apply (refine_vcg WHILET_refine[where R = \<open>{((i::nat, x::'a), (l, x')). x= x' \<and> i \<le> b \<and> i \<ge> a \<and>
+    l = drop (i-a) [a..<b]}\<close>])
+  subgoal by auto
+  subgoal by (auto simp: FOREACH_cond_def)
+  subgoal by (auto simp: FOREACH_body_def intro!: bind_refine[OF Id_refine])
+  subgoal by (auto simp: FOREACH_body_def intro!: bind_refine[OF Id_refine])
+  subgoal by auto
+  done
+
+lemma while_upt_while_direct:
+  "b \<ge> a \<Longrightarrow>
+  do {
+    (_,\<sigma>) \<leftarrow> WHILE\<^sub>T (FOREACH_cond c) (\<lambda>x. do {ASSERT (FOREACH_cond c x); FOREACH_body f x})
+      ([a..<b],\<sigma>);
+    RETURN \<sigma>
+  } = do {
+    (_,\<sigma>) \<leftarrow> WHILE\<^sub>T (\<lambda>(i, x). i < b \<and> c x) (\<lambda>(i, x). do {ASSERT (i < b);  \<sigma>'\<leftarrow>f i x; RETURN (i+1,\<sigma>')
+}) (a,\<sigma>);
+    RETURN \<sigma>
+  }"
+  using while_upt_while_direct1[of a b] while_upt_while_direct2[of a b]
+  unfolding order_class.eq_iff by fast
+
+lemma while_nfoldli:
+  "do {
+    (_,\<sigma>) \<leftarrow> WHILE\<^sub>T (FOREACH_cond c) (\<lambda>x. do {ASSERT (FOREACH_cond c x); FOREACH_body f x}) (l,\<sigma>);
+    RETURN \<sigma>
+  } \<le> nfoldli l c f \<sigma>"
+  apply (induct l arbitrary: \<sigma>)
+  apply (subst WHILET_unfold)
+  apply (simp add: FOREACH_cond_def)
+
+  apply (subst WHILET_unfold)
+  apply (auto
+    simp: FOREACH_cond_def FOREACH_body_def
+    intro: bind_mono Refine_Basic.bind_mono(1))
+ done
+lemma nfoldli_while: "nfoldli l c f \<sigma>
+          \<le>
+         (WHILE\<^sub>T\<^bsup>I\<^esup>
+           (FOREACH_cond c) (\<lambda>x. do {ASSERT (FOREACH_cond c x); FOREACH_body f x}) (l, \<sigma>) \<bind>
+          (\<lambda>(_, \<sigma>). RETURN \<sigma>))"
+proof (induct l arbitrary: \<sigma>)
+  case Nil thus ?case by (subst WHILEIT_unfold) (auto simp: FOREACH_cond_def)
+next
+  case (Cons x ls)
+  show ?case
+  proof (cases "c \<sigma>")
+    case False thus ?thesis
+      apply (subst WHILEIT_unfold)
+      unfolding FOREACH_cond_def
+      by simp
+  next
+    case [simp]: True
+    from Cons show ?thesis
+      apply (subst WHILEIT_unfold)
+      unfolding FOREACH_cond_def FOREACH_body_def
+      apply clarsimp
+      apply (rule Refine_Basic.bind_mono)
+      apply simp_all
+      done
+  qed
+qed
+
+lemma while_eq_nfoldli: "do {
+    (_,\<sigma>) \<leftarrow> WHILE\<^sub>T (FOREACH_cond c) (\<lambda>x. do {ASSERT (FOREACH_cond c x); FOREACH_body f x}) (l,\<sigma>);
+    RETURN \<sigma>
+  } = nfoldli l c f \<sigma>"
+  apply (rule antisym)
+  apply (rule while_nfoldli)
+  apply (rule order_trans[OF nfoldli_while[where I="\<lambda>_. True"]])
+  apply (simp add: WHILET_def)
+  done
+
+end
\ No newline at end of file
diff --git a/thys/PAC_Checker/PAC_Assoc_Map_Rel.thy b/thys/PAC_Checker/PAC_Assoc_Map_Rel.thy
new file mode 100644
--- /dev/null
+++ b/thys/PAC_Checker/PAC_Assoc_Map_Rel.thy
@@ -0,0 +1,152 @@
+theory PAC_Assoc_Map_Rel
+  imports PAC_Map_Rel
+begin
+
+section \<open>Hash Map as association list\<close>
+
+type_synonym ('k, 'v) hash_assoc = \<open>('k \<times> 'v) list\<close>
+
+definition hassoc_map_rel_raw :: \<open>(('k, 'v) hash_assoc \<times> _) set\<close> where
+  \<open>hassoc_map_rel_raw = br map_of (\<lambda>_. True)\<close>
+
+abbreviation hassoc_map_assn :: \<open>('k \<Rightarrow> 'v option) \<Rightarrow> ('k, 'v) hash_assoc \<Rightarrow> assn\<close> where
+  \<open>hassoc_map_assn \<equiv> pure (hassoc_map_rel_raw)\<close>
+
+lemma hassoc_map_rel_raw_empty[simp]:
+  \<open>([], m) \<in> hassoc_map_rel_raw \<longleftrightarrow> m = Map.empty\<close>
+  \<open>(p, Map.empty) \<in> hassoc_map_rel_raw \<longleftrightarrow> p = []\<close>
+  \<open>hassoc_map_assn Map.empty [] = emp\<close>
+  by (auto simp: hassoc_map_rel_raw_def br_def pure_def)
+
+definition hassoc_new :: \<open>('k, 'v) hash_assoc Heap\<close>where
+  \<open>hassoc_new = return []\<close>
+
+  lemma precise_hassoc_map_assn: \<open>precise hassoc_map_assn\<close>
+    by (auto intro!: precise_pure)
+     (auto simp: single_valued_def hassoc_map_rel_raw_def
+      br_def)
+
+  definition hassoc_isEmpty :: "('k \<times> 'v) list \<Rightarrow> bool Heap" where
+   "hassoc_isEmpty ht \<equiv> return (length ht = 0)"
+
+
+ interpretation hassoc: bind_map_empty hassoc_map_assn hassoc_new
+    by unfold_locales
+     (auto intro: precise_hassoc_map_assn
+         simp: ent_refl_true hassoc_new_def
+       intro!: return_cons_rule)
+
+
+  interpretation hassoc: bind_map_is_empty hassoc_map_assn hassoc_isEmpty
+    by unfold_locales
+      (auto simp: precise_hassoc_map_assn hassoc_isEmpty_def ent_refl_true
+       intro!: precise_pure return_cons_rule)
+
+  definition "op_assoc_empty \<equiv> IICF_Map.op_map_empty"
+
+  interpretation hassoc: map_custom_empty op_assoc_empty
+    by unfold_locales (simp add: op_assoc_empty_def)
+
+
+  lemmas [sepref_fr_rules] = hassoc.empty_hnr[folded op_assoc_empty_def]
+
+  definition hassoc_update :: "'k \<Rightarrow> 'v \<Rightarrow> ('k, 'v) hash_assoc \<Rightarrow> ('k, 'v) hash_assoc Heap" where
+   "hassoc_update k v ht = return ((k, v ) # ht)"
+
+  lemma hassoc_map_assn_Cons:
+     \<open>hassoc_map_assn (m) (p) \<Longrightarrow>\<^sub>A hassoc_map_assn (m(k \<mapsto> v)) ((k, v) # p) * true\<close>
+     by (auto simp: hassoc_map_rel_raw_def pure_def br_def)
+
+  interpretation hassoc: bind_map_update hassoc_map_assn hassoc_update
+    by unfold_locales
+     (auto intro!: return_cons_rule
+      simp: hassoc_update_def hassoc_map_assn_Cons)
+
+
+  definition hassoc_delete :: \<open>'k \<Rightarrow> ('k, 'v) hash_assoc \<Rightarrow> ('k, 'v) hash_assoc Heap\<close> where
+    \<open>hassoc_delete k ht = return (filter (\<lambda>(a, b). a \<noteq> k) ht)\<close>
+
+  lemma hassoc_map_of_filter_all:
+    \<open>map_of p |` (- {k}) = map_of (filter (\<lambda>(a, b). a \<noteq> k) p)\<close>
+    apply (induction p)
+    apply (auto simp: restrict_map_def fun_eq_iff split: if_split)
+    apply presburger+
+    done
+
+  lemma hassoc_map_assn_hassoc_delete: \<open><hassoc_map_assn m p> hassoc_delete k p <hassoc_map_assn (m |` (- {k}))>\<^sub>t\<close>
+   by (auto simp: hassoc_delete_def hassoc_map_rel_raw_def pure_def br_def
+           hassoc_map_of_filter_all
+         intro!: return_cons_rule)
+
+  interpretation hassoc: bind_map_delete hassoc_map_assn hassoc_delete
+    by unfold_locales
+     (auto intro: hassoc_map_assn_hassoc_delete)
+
+
+  definition hassoc_lookup :: \<open>'k \<Rightarrow> ('k, 'v) hash_assoc \<Rightarrow> 'v option Heap\<close> where
+    \<open>hassoc_lookup k ht = return (map_of ht k)\<close>
+
+  lemma hassoc_map_assn_hassoc_lookup:
+    \<open><hassoc_map_assn m p> hassoc_lookup k p <\<lambda>r. hassoc_map_assn m p * \<up> (r = m k)>\<^sub>t\<close>
+     by (auto simp: hassoc_lookup_def hassoc_map_rel_raw_def pure_def br_def
+             hassoc_map_of_filter_all
+           intro!: return_cons_rule)
+
+  interpretation hassoc: bind_map_lookup hassoc_map_assn hassoc_lookup
+    by unfold_locales
+     (rule hassoc_map_assn_hassoc_lookup)
+
+  setup Locale_Code.open_block
+  interpretation hassoc: gen_contains_key_by_lookup hassoc_map_assn hassoc_lookup
+    by unfold_locales
+  setup Locale_Code.close_block
+
+  interpretation hassoc: bind_map_contains_key hassoc_map_assn hassoc.contains_key
+    by unfold_locales
+
+
+subsection \<open>Conversion from assoc to other map\<close>
+
+definition hash_of_assoc_map where
+\<open>hash_of_assoc_map xs = fold (\<lambda>(k, v) m. if m k \<noteq> None then m else m(k \<mapsto> v)) xs Map.empty\<close>
+
+lemma map_upd_map_add_left:
+  \<open>m(a  \<mapsto> b) ++ m' = m ++ (if a \<notin> dom m' then m'(a  \<mapsto> b) else m')\<close>
+proof -
+  have \<open>m' a = Some y \<Longrightarrow> m(a \<mapsto> b) ++ m' = m ++ m'\<close> for y
+    by (metis (no_types) fun_upd_triv fun_upd_upd map_add_assoc map_add_empty map_add_upd
+        map_le_iff_map_add_commute)
+  then show ?thesis
+    by auto
+qed
+
+lemma fold_map_of_alt:
+  \<open>fold (\<lambda>(k, v) m. if m k \<noteq> None then m else m(k \<mapsto> v)) xs m' = map_of xs ++ m'\<close>
+  by (induction xs arbitrary: m')
+    (auto simp: map_upd_map_add_left)
+
+lemma map_of_alt_def:
+  \<open>map_of xs = hash_of_assoc_map xs\<close>
+  using fold_map_of_alt[of xs Map.empty]
+  unfolding hash_of_assoc_map_def
+  by auto
+
+definition hashmap_conv where
+  [simp]: \<open>hashmap_conv x = x\<close>
+
+lemma hash_of_assoc_map_id:
+  \<open>(hash_of_assoc_map, hashmap_conv) \<in> hassoc_map_rel_raw \<rightarrow> Id\<close>
+  by (auto intro!: fun_relI simp: hassoc_map_rel_raw_def br_def map_of_alt_def)
+
+definition hassoc_map_rel where
+  hassoc_map_rel_internal_def:
+  \<open>hassoc_map_rel K V = hassoc_map_rel_raw O \<langle>K,V\<rangle>map_rel\<close>
+
+lemma hassoc_map_rel_def:
+  \<open>\<langle>K,V\<rangle> hassoc_map_rel = hassoc_map_rel_raw O \<langle>K,V\<rangle>map_rel\<close>
+  unfolding relAPP_def hassoc_map_rel_internal_def
+  by auto
+
+
+end
+
diff --git a/thys/PAC_Checker/PAC_Checker.thy b/thys/PAC_Checker/PAC_Checker.thy
new file mode 100644
--- /dev/null
+++ b/thys/PAC_Checker/PAC_Checker.thy
@@ -0,0 +1,1381 @@
+(*
+  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
+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))
+
+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: 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)
+    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 (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
+      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
new file mode 100644
--- /dev/null
+++ b/thys/PAC_Checker/PAC_Checker_Init.thy
@@ -0,0 +1,886 @@
+(*
+  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)
+
+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
+        lexord_code lexordp_eq_conv_lexord)
+qed
+
+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
+    lexord_code lexordp_eq_conv_lexord
+    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))
+  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)
+
+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
+    lexord_code 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_MLton.thy b/thys/PAC_Checker/PAC_Checker_MLton.thy
new file mode 100644
--- /dev/null
+++ b/thys/PAC_Checker/PAC_Checker_MLton.thy
@@ -0,0 +1,34 @@
+(*
+  File:         PAC_Checker_MLton.thy
+  Author:       Mathias Fleury, Daniela Kaufmann, JKU
+  Maintainer:   Mathias Fleury, JKU
+*)
+theory PAC_Checker_MLton
+  imports PAC_Checker_Synthesis
+begin
+
+export_code PAC_checker_l_impl PAC_update_impl PAC_empty_impl the_error is_cfailed is_cfound
+  int_of_integer Del Add Mult nat_of_integer String.implode remap_polys_l_impl
+  fully_normalize_poly_impl union_vars_poly_impl empty_vars_impl
+  full_checker_l_impl check_step_impl CSUCCESS
+  Extension hashcode_literal' version
+  in SML_imp module_name PAC_Checker
+  file_prefix "checker"
+
+text \<open>Here is how to compile it:\<close>
+compile_generated_files _
+  external_files
+    \<open>code/parser.sml\<close>
+    \<open>code/pasteque.sml\<close>
+    \<open>code/pasteque.mlb\<close>
+  where \<open>fn dir =>
+    let
+      val exec = Generated_Files.execute (Path.append dir (Path.basic "code"));
+      val _ =
+        exec \<open>Compilation\<close>
+          (File.bash_path \<^path>\<open>$ISABELLE_MLTON\<close> ^ " " ^
+            "-const 'MLton.safe false' -verbose 1 -default-type int64 -output pasteque " ^
+            "-codegen native -inline 700 -cc-opt -O3 pasteque.mlb");
+    in () end\<close>
+
+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
new file mode 100644
--- /dev/null
+++ b/thys/PAC_Checker/PAC_Checker_Relation.thy
@@ -0,0 +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
+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>
+
+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
+
+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 (transfer, auto)+
+
+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> bintrunc b n = n\<close>
+  unfolding uint32_of_nat_def
+  by (simp add: no_bintr_alt1)
+
+lemma nat_of_uint64_uint64_of_nat_id: \<open>n < 2^64 \<Longrightarrow> nat_of_uint64 (uint64_of_nat n) = n\<close>
+  unfolding uint64_of_nat_def
+  apply simp
+  apply transfer
+  apply (auto simp: unat_def)
+  apply transfer
+  by (auto simp: less_upper_bintrunc_id)
+
+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)
+    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: lexord_code 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: lexord_code 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
new file mode 100644
--- /dev/null
+++ b/thys/PAC_Checker/PAC_Checker_Specification.thy
@@ -0,0 +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)+
+
+  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_Checker_Synthesis.thy b/thys/PAC_Checker/PAC_Checker_Synthesis.thy
new file mode 100644
--- /dev/null
+++ b/thys/PAC_Checker/PAC_Checker_Synthesis.thy
@@ -0,0 +1,924 @@
+(*
+  File:         PAC_Checker_Synthesis.thy
+  Author:       Mathias Fleury, Daniela Kaufmann, JKU
+  Maintainer:   Mathias Fleury, JKU
+*)
+theory PAC_Checker_Synthesis
+  imports PAC_Checker WB_Sort PAC_Checker_Relation
+    PAC_Checker_Init More_Loops PAC_Version
+begin
+
+section \<open>Code Synthesis of the Complete Checker\<close>
+
+text \<open>We here combine refine the full checker, using the initialisation provided in another file and
+adding more efficient data structures (mostly replacing the set of variables by a more efficient
+hash map).\<close>
+
+abbreviation vars_assn where
+  \<open>vars_assn \<equiv> hs.assn string_assn\<close>
+
+fun vars_of_monom_in where
+  \<open>vars_of_monom_in [] _ = True\<close> |
+  \<open>vars_of_monom_in (x # xs) \<V> \<longleftrightarrow> x \<in> \<V> \<and> vars_of_monom_in xs \<V>\<close>
+
+fun vars_of_poly_in where
+  \<open>vars_of_poly_in [] _ = True\<close> |
+  \<open>vars_of_poly_in ((x, _) # xs) \<V> \<longleftrightarrow> vars_of_monom_in x \<V> \<and> vars_of_poly_in xs \<V>\<close>
+
+lemma vars_of_monom_in_alt_def:
+  \<open>vars_of_monom_in xs \<V> \<longleftrightarrow> set xs \<subseteq> \<V>\<close>
+  by (induction xs)
+   auto
+
+lemma vars_llist_alt_def:
+  \<open>vars_llist xs \<subseteq> \<V> \<longleftrightarrow> vars_of_poly_in xs \<V>\<close>
+  by (induction xs)
+   (auto simp: vars_llist_def vars_of_monom_in_alt_def)
+
+lemma vars_of_monom_in_alt_def2:
+  \<open>vars_of_monom_in xs \<V> \<longleftrightarrow> fold (\<lambda>x b. b \<and> x \<in> \<V>) xs True\<close>
+  apply (subst foldr_fold[symmetric])
+  subgoal by auto
+  subgoal by (induction xs) auto
+  done
+
+sepref_definition vars_of_monom_in_impl
+  is \<open>uncurry (RETURN oo vars_of_monom_in)\<close>
+  :: \<open>(list_assn string_assn)\<^sup>k *\<^sub>a vars_assn\<^sup>k \<rightarrow>\<^sub>a bool_assn\<close>
+  unfolding vars_of_monom_in_alt_def2
+  by sepref
+
+declare vars_of_monom_in_impl.refine[sepref_fr_rules]
+
+lemma vars_of_poly_in_alt_def2:
+  \<open>vars_of_poly_in xs \<V> \<longleftrightarrow> fold (\<lambda>(x, _) b. b \<and> vars_of_monom_in x \<V>) xs True\<close>
+  apply (subst foldr_fold[symmetric])
+  subgoal by auto
+  subgoal by (induction xs) auto
+  done
+
+
+sepref_definition vars_of_poly_in_impl
+  is \<open>uncurry (RETURN oo vars_of_poly_in)\<close>
+  :: \<open>(poly_assn)\<^sup>k *\<^sub>a vars_assn\<^sup>k \<rightarrow>\<^sub>a bool_assn\<close>
+  unfolding vars_of_poly_in_alt_def2
+  by sepref
+
+declare vars_of_poly_in_impl.refine[sepref_fr_rules]
+
+
+definition union_vars_monom :: \<open>string list \<Rightarrow> string set \<Rightarrow> string set\<close> where
+\<open>union_vars_monom xs \<V> = fold insert xs \<V>\<close>
+
+definition union_vars_poly :: \<open>llist_polynomial \<Rightarrow> string set \<Rightarrow> string set\<close> where
+\<open>union_vars_poly xs \<V> = fold (\<lambda>(xs, _) \<V>. union_vars_monom xs \<V>) xs \<V>\<close>
+
+lemma union_vars_monom_alt_def:
+  \<open>union_vars_monom xs \<V> = \<V> \<union> set xs\<close>
+  unfolding union_vars_monom_def
+  apply (subst foldr_fold[symmetric])
+  subgoal for x y
+    by (cases x; cases y) auto
+  subgoal
+    by (induction xs) auto
+  done
+
+lemma union_vars_poly_alt_def:
+  \<open>union_vars_poly xs \<V> = \<V> \<union> vars_llist xs\<close>
+  unfolding union_vars_poly_def
+  apply (subst foldr_fold[symmetric])
+  subgoal for x y
+    by (cases x; cases y)
+      (auto simp: union_vars_monom_alt_def)
+  subgoal
+    by (induction xs)
+     (auto simp: vars_llist_def union_vars_monom_alt_def)
+   done
+
+sepref_definition union_vars_monom_impl
+  is \<open>uncurry (RETURN oo union_vars_monom)\<close>
+  :: \<open>monom_assn\<^sup>k *\<^sub>a vars_assn\<^sup>d \<rightarrow>\<^sub>a vars_assn\<close>
+  unfolding union_vars_monom_def
+  by sepref
+
+declare union_vars_monom_impl.refine[sepref_fr_rules]
+
+sepref_definition union_vars_poly_impl
+  is \<open>uncurry (RETURN oo union_vars_poly)\<close>
+  :: \<open>poly_assn\<^sup>k *\<^sub>a vars_assn\<^sup>d \<rightarrow>\<^sub>a vars_assn\<close>
+  unfolding union_vars_poly_def
+  by sepref
+
+declare union_vars_poly_impl.refine[sepref_fr_rules]
+
+
+hide_const (open) Autoref_Fix_Rel.CONSTRAINT
+
+fun status_assn where
+  \<open>status_assn _ CSUCCESS CSUCCESS = emp\<close> |
+  \<open>status_assn _ CFOUND CFOUND = emp\<close> |
+  \<open>status_assn R (CFAILED a) (CFAILED b) = R a b\<close> |
+  \<open>status_assn _ _ _ = false\<close>
+
+lemma SUCCESS_hnr[sepref_fr_rules]:
+  \<open>(uncurry0 (return CSUCCESS), uncurry0 (RETURN CSUCCESS)) \<in> unit_assn\<^sup>k \<rightarrow>\<^sub>a status_assn R\<close>
+  by (sepref_to_hoare)
+    sep_auto
+
+lemma FOUND_hnr[sepref_fr_rules]:
+  \<open>(uncurry0 (return CFOUND), uncurry0 (RETURN CFOUND)) \<in> unit_assn\<^sup>k \<rightarrow>\<^sub>a status_assn R\<close>
+  by (sepref_to_hoare)
+    sep_auto
+
+lemma is_success_hnr[sepref_fr_rules]:
+  \<open>CONSTRAINT is_pure R \<Longrightarrow>
+  ((return o is_cfound), (RETURN o is_cfound)) \<in> (status_assn R)\<^sup>k \<rightarrow>\<^sub>a bool_assn\<close>
+  apply (sepref_to_hoare)
+  apply (rename_tac xi x; case_tac xi; case_tac x)
+  apply sep_auto+
+  done
+
+lemma is_cfailed_hnr[sepref_fr_rules]:
+  \<open>CONSTRAINT is_pure R \<Longrightarrow>
+  ((return o is_cfailed), (RETURN o is_cfailed)) \<in> (status_assn R)\<^sup>k \<rightarrow>\<^sub>a bool_assn\<close>
+  apply (sepref_to_hoare)
+  apply (rename_tac xi x; case_tac xi; case_tac x)
+  apply  sep_auto+
+  done
+
+lemma merge_cstatus_hnr[sepref_fr_rules]:
+  \<open>CONSTRAINT is_pure R \<Longrightarrow>
+  (uncurry (return oo merge_cstatus), uncurry (RETURN oo merge_cstatus)) \<in>
+    (status_assn R)\<^sup>k *\<^sub>a  (status_assn R)\<^sup>k \<rightarrow>\<^sub>a status_assn R\<close>
+  apply (sepref_to_hoare)
+  by (case_tac b; case_tac bi; case_tac a; case_tac ai; sep_auto simp: is_pure_conv pure_app_eq)
+
+sepref_definition add_poly_impl
+  is \<open>add_poly_l\<close>
+  :: \<open>(poly_assn \<times>\<^sub>a poly_assn)\<^sup>k \<rightarrow>\<^sub>a poly_assn\<close>
+  supply [[goals_limit=1]]
+  unfolding add_poly_l_def
+    HOL_list.fold_custom_empty
+    term_order_rel'_def[symmetric]
+    term_order_rel'_alt_def
+  by sepref
+
+
+declare add_poly_impl.refine[sepref_fr_rules]
+
+
+sepref_register mult_monomials
+lemma mult_monoms_alt_def:
+  \<open>(RETURN oo mult_monoms) x y = REC\<^sub>T
+    (\<lambda>f (p, q).
+      case (p, q) of
+        ([], _) \<Rightarrow> RETURN q
+       | (_, []) \<Rightarrow> RETURN p
+       | (x # p, y # q) \<Rightarrow>
+        (if x = y then do {
+          pq \<leftarrow> f (p, q);
+           RETURN (x # pq)}
+        else if (x, y) \<in> var_order_rel
+        then do {
+          pq \<leftarrow> f (p, y # q);
+          RETURN (x # pq)}
+        else do {
+          pq \<leftarrow>  f (x # p, q);
+          RETURN (y # pq)}))
+     (x, y)\<close>
+  apply (subst eq_commute)
+  apply (induction x y rule: mult_monoms.induct)
+  subgoal for p
+    by (subst RECT_unfold, refine_mono) (auto split: list.splits)
+  subgoal for p
+    by (subst RECT_unfold, refine_mono) (auto split: list.splits)
+  subgoal for x p y q
+    by (subst RECT_unfold, refine_mono) (auto split: list.splits simp: let_to_bind_conv)
+  done
+
+
+sepref_definition mult_monoms_impl
+  is \<open>uncurry (RETURN oo mult_monoms)\<close>
+  :: \<open>(monom_assn)\<^sup>k *\<^sub>a (monom_assn)\<^sup>k \<rightarrow>\<^sub>a (monom_assn)\<close>
+  supply [[goals_limit=1]]
+  unfolding mult_poly_raw_def
+    HOL_list.fold_custom_empty
+    var_order'_def[symmetric]
+    term_order_rel'_alt_def
+    mult_monoms_alt_def
+    var_order_rel_var_order
+  by sepref
+
+declare mult_monoms_impl.refine[sepref_fr_rules]
+
+sepref_definition mult_monomials_impl
+  is \<open>uncurry (RETURN oo mult_monomials)\<close>
+  :: \<open>(monomial_assn)\<^sup>k *\<^sub>a (monomial_assn)\<^sup>k \<rightarrow>\<^sub>a (monomial_assn)\<close>
+  supply [[goals_limit=1]]
+  unfolding mult_monomials_def
+    HOL_list.fold_custom_empty
+    term_order_rel'_def[symmetric]
+    term_order_rel'_alt_def
+  by sepref
+
+
+lemma map_append_alt_def2:
+  \<open>(RETURN o (map_append f b)) xs = REC\<^sub>T
+    (\<lambda>g xs. case xs of [] \<Rightarrow> RETURN b
+      | x # xs \<Rightarrow> do {
+           y \<leftarrow> g xs;
+           RETURN (f x # y)
+     }) xs\<close>
+   apply (subst eq_commute)
+  apply (induction f b xs rule: map_append.induct)
+  subgoal by (subst RECT_unfold, refine_mono) auto
+  subgoal by (subst RECT_unfold, refine_mono) auto
+  done
+
+
+definition map_append_poly_mult where
+  \<open>map_append_poly_mult x = map_append (mult_monomials x)\<close>
+
+declare mult_monomials_impl.refine[sepref_fr_rules]
+
+sepref_definition map_append_poly_mult_impl
+  is \<open>uncurry2 (RETURN ooo map_append_poly_mult)\<close>
+  :: \<open>monomial_assn\<^sup>k *\<^sub>a poly_assn\<^sup>k *\<^sub>a poly_assn\<^sup>k \<rightarrow>\<^sub>a poly_assn\<close>
+  unfolding map_append_poly_mult_def
+    map_append_alt_def2
+  by sepref
+
+declare map_append_poly_mult_impl.refine[sepref_fr_rules]
+
+text \<open>TODO @{thm map_by_foldl} is the worst possible implementation of map!\<close>
+sepref_definition mult_poly_raw_impl
+  is \<open>uncurry (RETURN oo mult_poly_raw)\<close>
+  :: \<open>poly_assn\<^sup>k *\<^sub>a poly_assn\<^sup>k \<rightarrow>\<^sub>a poly_assn\<close>
+  supply [[goals_limit=1]]
+  supply [[eta_contract = false, show_abbrevs=false]]
+  unfolding mult_poly_raw_def
+    HOL_list.fold_custom_empty
+    term_order_rel'_def[symmetric]
+    term_order_rel'_alt_def
+    foldl_conv_fold
+    fold_eq_nfoldli
+    map_append_poly_mult_def[symmetric]
+    map_append_alt_def[symmetric]
+  by sepref
+
+declare mult_poly_raw_impl.refine[sepref_fr_rules]
+
+
+sepref_definition mult_poly_impl
+  is \<open>uncurry mult_poly_full\<close>
+  :: \<open>poly_assn\<^sup>k *\<^sub>a poly_assn\<^sup>k \<rightarrow>\<^sub>a poly_assn\<close>
+  supply [[goals_limit=1]]
+  unfolding mult_poly_full_def
+    HOL_list.fold_custom_empty
+    term_order_rel'_def[symmetric]
+    term_order_rel'_alt_def
+  by sepref
+
+declare mult_poly_impl.refine[sepref_fr_rules]
+
+lemma inverse_monomial:
+  \<open>monom_rel\<inverse> \<times>\<^sub>r int_rel = (monom_rel \<times>\<^sub>r int_rel)\<inverse>\<close>
+  by (auto)
+
+lemma eq_poly_rel_eq[sepref_import_param]:
+  \<open>((=), (=)) \<in> poly_rel \<rightarrow> poly_rel \<rightarrow> bool_rel\<close>
+  using list_rel_sv[of \<open>monomial_rel\<close>, OF single_valued_monomial_rel]
+  using list_rel_sv[OF single_valued_monomial_rel'[unfolded IS_LEFT_UNIQUE_def inv_list_rel_eq]]
+  unfolding inv_list_rel_eq[symmetric]
+  by (auto intro!: frefI simp:
+      rel2p_def single_valued_def p2rel_def
+    simp del: inv_list_rel_eq)
+
+sepref_definition weak_equality_l_impl
+  is \<open>uncurry weak_equality_l\<close>
+  :: \<open>poly_assn\<^sup>k *\<^sub>a poly_assn\<^sup>k \<rightarrow>\<^sub>a bool_assn\<close>
+  supply [[goals_limit=1]]
+  unfolding weak_equality_l_def
+  by sepref
+
+declare weak_equality_l_impl.refine[sepref_fr_rules]
+sepref_register add_poly_l mult_poly_full
+
+abbreviation raw_string_assn :: \<open>string \<Rightarrow> string \<Rightarrow> assn\<close> where
+  \<open>raw_string_assn \<equiv> list_assn id_assn\<close>
+
+definition show_nat :: \<open>nat \<Rightarrow> string\<close> where
+  \<open>show_nat i = show i\<close>
+
+lemma [sepref_import_param]:
+  \<open>(show_nat, show_nat) \<in> nat_rel \<rightarrow> \<langle>Id\<rangle>list_rel\<close>
+  by (auto intro: fun_relI)
+
+lemma status_assn_pure_conv:
+  \<open>status_assn (id_assn) a b = id_assn a b\<close>
+  by (cases a; cases b)
+    (auto simp: pure_def)
+
+
+lemma [sepref_fr_rules]:
+  \<open>(uncurry3 (\<lambda>x y. return oo (error_msg_not_equal_dom x y)), uncurry3 check_not_equal_dom_err) \<in>
+  poly_assn\<^sup>k *\<^sub>a poly_assn\<^sup>k *\<^sub>a poly_assn\<^sup>k *\<^sub>a poly_assn\<^sup>k \<rightarrow>\<^sub>a raw_string_assn\<close>
+  unfolding show_nat_def[symmetric] list_assn_pure_conv
+    prod_assn_pure_conv check_not_equal_dom_err_def
+  by (sepref_to_hoare; sep_auto simp: error_msg_not_equal_dom_def)
+
+
+
+lemma [sepref_fr_rules]:
+  \<open>(return o (error_msg_notin_dom o nat_of_uint64), RETURN o error_msg_notin_dom)
+   \<in> uint64_nat_assn\<^sup>k \<rightarrow>\<^sub>a raw_string_assn\<close>
+  \<open>(return o (error_msg_reused_dom o nat_of_uint64), RETURN o error_msg_reused_dom)
+    \<in> uint64_nat_assn\<^sup>k \<rightarrow>\<^sub>a raw_string_assn\<close>
+  \<open>(uncurry (return oo (\<lambda>i. error_msg (nat_of_uint64 i))), uncurry (RETURN oo error_msg))
+    \<in> uint64_nat_assn\<^sup>k *\<^sub>a raw_string_assn\<^sup>k  \<rightarrow>\<^sub>a status_assn raw_string_assn\<close>
+  \<open>(uncurry (return oo  error_msg), uncurry (RETURN oo error_msg))
+   \<in> nat_assn\<^sup>k *\<^sub>a raw_string_assn\<^sup>k  \<rightarrow>\<^sub>a status_assn raw_string_assn\<close>
+  unfolding error_msg_notin_dom_def list_assn_pure_conv list_rel_id_simp
+  unfolding status_assn_pure_conv
+  unfolding show_nat_def[symmetric]
+  by (sepref_to_hoare; sep_auto simp: uint64_nat_rel_def br_def; fail)+
+
+sepref_definition check_addition_l_impl
+  is \<open>uncurry6 check_addition_l\<close>
+  :: \<open>poly_assn\<^sup>k *\<^sub>a polys_assn\<^sup>k *\<^sub>a vars_assn\<^sup>k *\<^sub>a uint64_nat_assn\<^sup>k *\<^sub>a uint64_nat_assn\<^sup>k *\<^sub>a
+        uint64_nat_assn\<^sup>k *\<^sub>a poly_assn\<^sup>k  \<rightarrow>\<^sub>a status_assn raw_string_assn\<close>
+  supply [[goals_limit=1]]
+  unfolding mult_poly_full_def
+    HOL_list.fold_custom_empty
+    term_order_rel'_def[symmetric]
+    term_order_rel'_alt_def
+    check_addition_l_def
+    in_dom_m_lookup_iff
+    fmlookup'_def[symmetric]
+    vars_llist_alt_def
+  by sepref
+
+declare check_addition_l_impl.refine[sepref_fr_rules]
+
+sepref_register check_mult_l_dom_err
+
+definition check_mult_l_dom_err_impl where
+  \<open>check_mult_l_dom_err_impl pd p ia i =
+    (if pd then ''The polynomial with id '' @ show (nat_of_uint64 p) @ '' was not found'' else '''') @
+    (if ia then ''The id of the resulting id '' @ show (nat_of_uint64 i) @ '' was already given'' else '''')\<close>
+
+definition check_mult_l_mult_err_impl where
+  \<open>check_mult_l_mult_err_impl p q pq r =
+    ''Multiplying '' @ show p @ '' by '' @ show q @ '' gives '' @ show pq @ '' and not '' @ show r\<close>
+
+lemma [sepref_fr_rules]:
+  \<open>(uncurry3 ((\<lambda>x y. return oo (check_mult_l_dom_err_impl x y))),
+   uncurry3 (check_mult_l_dom_err)) \<in> bool_assn\<^sup>k *\<^sub>a uint64_nat_assn\<^sup>k *\<^sub>a bool_assn\<^sup>k *\<^sub>a uint64_nat_assn\<^sup>k \<rightarrow>\<^sub>a raw_string_assn\<close>
+   unfolding check_mult_l_dom_err_def check_mult_l_dom_err_impl_def list_assn_pure_conv
+   apply sepref_to_hoare
+   apply sep_auto
+   done
+
+lemma [sepref_fr_rules]:
+  \<open>(uncurry3 ((\<lambda>x y. return oo (check_mult_l_mult_err_impl x y))),
+   uncurry3 (check_mult_l_mult_err)) \<in> poly_assn\<^sup>k *\<^sub>a poly_assn\<^sup>k *\<^sub>a poly_assn\<^sup>k *\<^sub>a poly_assn\<^sup>k \<rightarrow>\<^sub>a raw_string_assn\<close>
+   unfolding check_mult_l_mult_err_def check_mult_l_mult_err_impl_def list_assn_pure_conv
+   apply sepref_to_hoare
+   apply sep_auto
+   done
+
+sepref_definition check_mult_l_impl
+  is \<open>uncurry6 check_mult_l\<close>
+  :: \<open>poly_assn\<^sup>k *\<^sub>a polys_assn\<^sup>k *\<^sub>a vars_assn\<^sup>k *\<^sub>a uint64_nat_assn\<^sup>k *\<^sub>a poly_assn\<^sup>k *\<^sub>a uint64_nat_assn\<^sup>k *\<^sub>a poly_assn\<^sup>k  \<rightarrow>\<^sub>a status_assn raw_string_assn\<close>
+  supply [[goals_limit=1]]
+  unfolding check_mult_l_def
+    HOL_list.fold_custom_empty
+    term_order_rel'_def[symmetric]
+    term_order_rel'_alt_def
+    in_dom_m_lookup_iff
+    fmlookup'_def[symmetric]
+    vars_llist_alt_def
+  by sepref
+
+declare check_mult_l_impl.refine[sepref_fr_rules]
+
+definition check_ext_l_dom_err_impl :: \<open>uint64 \<Rightarrow> _\<close>  where
+  \<open>check_ext_l_dom_err_impl p =
+    ''There is already a polynomial with index '' @ show (nat_of_uint64 p)\<close>
+
+lemma [sepref_fr_rules]:
+  \<open>(((return o (check_ext_l_dom_err_impl))),
+    (check_extension_l_dom_err)) \<in> uint64_nat_assn\<^sup>k \<rightarrow>\<^sub>a raw_string_assn\<close>
+   unfolding check_extension_l_dom_err_def check_ext_l_dom_err_impl_def list_assn_pure_conv
+   apply sepref_to_hoare
+   apply sep_auto
+   done
+
+
+definition check_extension_l_no_new_var_err_impl :: \<open>_ \<Rightarrow> _\<close>  where
+  \<open>check_extension_l_no_new_var_err_impl p =
+    ''No new variable could be found in polynomial '' @ show p\<close>
+
+lemma [sepref_fr_rules]:
+  \<open>(((return o (check_extension_l_no_new_var_err_impl))),
+    (check_extension_l_no_new_var_err)) \<in> poly_assn\<^sup>k \<rightarrow>\<^sub>a raw_string_assn\<close>
+   unfolding check_extension_l_no_new_var_err_impl_def check_extension_l_no_new_var_err_def
+     list_assn_pure_conv
+   apply sepref_to_hoare
+   apply sep_auto
+   done
+
+definition check_extension_l_side_cond_err_impl :: \<open>_ \<Rightarrow> _\<close>  where
+  \<open>check_extension_l_side_cond_err_impl v p r s =
+    ''Error while checking side conditions of extensions polynow, var is '' @ show v @
+    '' polynomial is '' @ show p @ ''side condition p*p - p = '' @ show s @ '' and should be 0''\<close>
+
+lemma [sepref_fr_rules]:
+  \<open>((uncurry3 (\<lambda>x y. return oo (check_extension_l_side_cond_err_impl x y))),
+    uncurry3 (check_extension_l_side_cond_err)) \<in> string_assn\<^sup>k *\<^sub>a poly_assn\<^sup>k *\<^sub>a poly_assn\<^sup>k *\<^sub>a poly_assn\<^sup>k \<rightarrow>\<^sub>a raw_string_assn\<close>
+   unfolding check_extension_l_side_cond_err_impl_def check_extension_l_side_cond_err_def
+     list_assn_pure_conv
+   apply sepref_to_hoare
+   apply sep_auto
+   done
+
+definition check_extension_l_new_var_multiple_err_impl :: \<open>_ \<Rightarrow> _\<close>  where
+  \<open>check_extension_l_new_var_multiple_err_impl v p =
+    ''Error while checking side conditions of extensions polynow, var is '' @ show v @
+    '' but it either appears at least once in the polynomial or another new variable is created '' @
+    show p @ '' but should not.''\<close>
+
+lemma [sepref_fr_rules]:
+  \<open>((uncurry (return oo (check_extension_l_new_var_multiple_err_impl))),
+    uncurry (check_extension_l_new_var_multiple_err)) \<in> string_assn\<^sup>k *\<^sub>a poly_assn\<^sup>k \<rightarrow>\<^sub>a raw_string_assn\<close>
+   unfolding check_extension_l_new_var_multiple_err_impl_def
+     check_extension_l_new_var_multiple_err_def
+     list_assn_pure_conv
+   apply sepref_to_hoare
+   apply sep_auto
+   done
+
+
+sepref_register check_extension_l_dom_err fmlookup'
+  check_extension_l_side_cond_err check_extension_l_no_new_var_err
+  check_extension_l_new_var_multiple_err
+
+definition uminus_poly :: \<open>llist_polynomial \<Rightarrow> llist_polynomial\<close> where
+  \<open>uminus_poly p' = map (\<lambda>(a, b). (a, - b)) p'\<close>
+
+sepref_register uminus_poly
+lemma [sepref_import_param]:
+  \<open>(map (\<lambda>(a, b). (a, - b)), uminus_poly) \<in> poly_rel \<rightarrow> poly_rel\<close>
+  unfolding uminus_poly_def
+  apply (intro fun_relI)
+  subgoal for p p'
+    by (induction p p' rule: list_rel_induct)
+     auto
+  done
+
+sepref_register vars_of_poly_in
+  weak_equality_l
+
+lemma [safe_constraint_rules]:
+  \<open>Sepref_Constraints.CONSTRAINT single_valued (the_pure monomial_assn)\<close> and
+  single_valued_the_monomial_assn:
+    \<open>single_valued (the_pure monomial_assn)\<close>
+    \<open>single_valued ((the_pure monomial_assn)\<inverse>)\<close>
+  unfolding IS_LEFT_UNIQUE_def[symmetric]
+  by (auto simp: step_rewrite_pure single_valued_monomial_rel single_valued_monomial_rel' Sepref_Constraints.CONSTRAINT_def)
+
+sepref_definition check_extension_l_impl
+  is \<open>uncurry5 check_extension_l\<close>
+  :: \<open>poly_assn\<^sup>k *\<^sub>a polys_assn\<^sup>k *\<^sub>a vars_assn\<^sup>k *\<^sub>a uint64_nat_assn\<^sup>k *\<^sub>a string_assn\<^sup>k *\<^sub>a poly_assn\<^sup>k \<rightarrow>\<^sub>a
+     status_assn raw_string_assn\<close>
+  supply option.splits[split] single_valued_the_monomial_assn[simp]
+  supply [[goals_limit=1]]
+  unfolding
+    HOL_list.fold_custom_empty
+    term_order_rel'_def[symmetric]
+    term_order_rel'_alt_def
+    in_dom_m_lookup_iff
+    fmlookup'_def[symmetric]
+    vars_llist_alt_def
+    check_extension_l_def
+    not_not
+    option.case_eq_if
+    uminus_poly_def[symmetric]
+    HOL_list.fold_custom_empty
+  by sepref
+
+
+declare check_extension_l_impl.refine[sepref_fr_rules]
+
+sepref_definition check_del_l_impl
+  is \<open>uncurry2 check_del_l\<close>
+  :: \<open>poly_assn\<^sup>k *\<^sub>a polys_assn\<^sup>k *\<^sub>a uint64_nat_assn\<^sup>k \<rightarrow>\<^sub>a status_assn raw_string_assn\<close>
+  supply [[goals_limit=1]]
+  unfolding check_del_l_def
+    in_dom_m_lookup_iff
+    fmlookup'_def[symmetric]
+  by sepref
+
+lemmas [sepref_fr_rules] = check_del_l_impl.refine
+
+abbreviation pac_step_rel where
+  \<open>pac_step_rel \<equiv> p2rel (\<langle>Id, \<langle>monomial_rel\<rangle>list_rel, Id\<rangle> pac_step_rel_raw)\<close>
+
+sepref_register PAC_Polynomials_Operations.normalize_poly
+  pac_src1 pac_src2 new_id pac_mult case_pac_step check_mult_l
+  check_addition_l check_del_l check_extension_l
+
+lemma pac_step_rel_assn_alt_def2:
+  \<open>hn_ctxt (pac_step_rel_assn nat_assn poly_assn id_assn) b bi =
+       hn_val
+        (p2rel
+          (\<langle>nat_rel, poly_rel, Id :: (string \<times> _) set\<rangle>pac_step_rel_raw)) b bi\<close>
+  unfolding poly_assn_list hn_ctxt_def
+  by (induction nat_assn poly_assn \<open>id_assn :: string \<Rightarrow> _\<close> b bi rule: pac_step_rel_assn.induct)
+   (auto simp: p2rel_def hn_val_unfold pac_step_rel_raw.simps relAPP_def
+    pure_app_eq)
+
+
+lemma is_AddD_import[sepref_fr_rules]:
+  assumes \<open>CONSTRAINT is_pure K\<close>  \<open>CONSTRAINT is_pure V\<close>
+  shows
+    \<open>(return o pac_res, RETURN o pac_res) \<in> [\<lambda>x. is_Add x \<or> is_Mult x \<or> is_Extension x]\<^sub>a
+       (pac_step_rel_assn K V R)\<^sup>k \<rightarrow> V\<close>
+    \<open>(return o pac_src1, RETURN o pac_src1) \<in> [\<lambda>x. is_Add x \<or> is_Mult x \<or> is_Del x]\<^sub>a (pac_step_rel_assn K V R)\<^sup>k \<rightarrow> K\<close>
+    \<open>(return o new_id, RETURN o new_id) \<in> [\<lambda>x. is_Add x \<or> is_Mult x \<or> is_Extension x]\<^sub>a (pac_step_rel_assn K V R)\<^sup>k \<rightarrow> K\<close>
+    \<open>(return o is_Add, RETURN o is_Add) \<in>  (pac_step_rel_assn K V R)\<^sup>k \<rightarrow>\<^sub>a bool_assn\<close>
+    \<open>(return o is_Mult, RETURN o is_Mult) \<in> (pac_step_rel_assn K V R)\<^sup>k \<rightarrow>\<^sub>a bool_assn\<close>
+    \<open>(return o is_Del, RETURN o is_Del) \<in> (pac_step_rel_assn K V R)\<^sup>k \<rightarrow>\<^sub>a bool_assn\<close>
+    \<open>(return o is_Extension, RETURN o is_Extension) \<in> (pac_step_rel_assn K V R)\<^sup>k \<rightarrow>\<^sub>a bool_assn\<close>
+  using assms
+  by (sepref_to_hoare; sep_auto simp: pac_step_rel_assn_alt_def is_pure_conv ent_true_drop pure_app_eq
+      split: pac_step.splits; fail)+
+
+lemma [sepref_fr_rules]:
+  \<open>CONSTRAINT is_pure K \<Longrightarrow>
+  (return o pac_src2, RETURN o pac_src2) \<in> [\<lambda>x. is_Add x]\<^sub>a (pac_step_rel_assn K V R)\<^sup>k \<rightarrow> K\<close>
+  \<open>CONSTRAINT is_pure V \<Longrightarrow>
+  (return o pac_mult, RETURN o pac_mult) \<in> [\<lambda>x. is_Mult x]\<^sub>a (pac_step_rel_assn K V R)\<^sup>k \<rightarrow> V\<close>
+  \<open>CONSTRAINT is_pure R \<Longrightarrow>
+  (return o new_var, RETURN o new_var) \<in> [\<lambda>x. is_Extension x]\<^sub>a (pac_step_rel_assn K V R)\<^sup>k \<rightarrow> R\<close>
+  by (sepref_to_hoare; sep_auto simp: pac_step_rel_assn_alt_def is_pure_conv ent_true_drop pure_app_eq
+      split: pac_step.splits; fail)+
+
+lemma is_Mult_lastI:
+  \<open>\<not> is_Add b \<Longrightarrow> \<not>is_Mult b \<Longrightarrow> \<not>is_Extension b \<Longrightarrow> is_Del b\<close>
+  by (cases b) auto
+
+sepref_register is_cfailed is_Del
+
+definition PAC_checker_l_step' ::  _ where
+  \<open>PAC_checker_l_step' a b c d = PAC_checker_l_step a (b, c, d)\<close>
+
+lemma PAC_checker_l_step_alt_def:
+  \<open>PAC_checker_l_step a bcd e = (let (b,c,d) = bcd in PAC_checker_l_step' a b c d e)\<close>
+  unfolding PAC_checker_l_step'_def by auto
+
+sepref_decl_intf ('k) acode_status is "('k) code_status"
+sepref_decl_intf ('k, 'b, 'lbl) apac_step is "('k, 'b, 'lbl) pac_step"
+
+sepref_register merge_cstatus full_normalize_poly new_var is_Add
+
+lemma poly_rel_the_pure:
+  \<open>poly_rel = the_pure poly_assn\<close> and
+  nat_rel_the_pure:
+  \<open>nat_rel = the_pure nat_assn\<close> and
+ WTF_RF: \<open>pure (the_pure nat_assn) = nat_assn\<close>
+  unfolding poly_assn_list
+  by auto
+
+lemma [safe_constraint_rules]:
+    \<open>CONSTRAINT IS_LEFT_UNIQUE uint64_nat_rel\<close> and
+  single_valued_uint64_nat_rel[safe_constraint_rules]:
+    \<open>CONSTRAINT single_valued uint64_nat_rel\<close>
+  by (auto simp: IS_LEFT_UNIQUE_def single_valued_def uint64_nat_rel_def br_def)
+
+sepref_definition check_step_impl
+  is \<open>uncurry4 PAC_checker_l_step'\<close>
+  :: \<open>poly_assn\<^sup>k *\<^sub>a (status_assn raw_string_assn)\<^sup>d *\<^sub>a vars_assn\<^sup>d *\<^sub>a polys_assn\<^sup>d *\<^sub>a (pac_step_rel_assn (uint64_nat_assn) poly_assn (string_assn :: string \<Rightarrow> _))\<^sup>d \<rightarrow>\<^sub>a
+    status_assn raw_string_assn \<times>\<^sub>a vars_assn \<times>\<^sub>a polys_assn\<close>
+  supply [[goals_limit=1]] is_Mult_lastI[intro] single_valued_uint64_nat_rel[simp]
+  unfolding PAC_checker_l_step_def PAC_checker_l_step'_def
+    pac_step.case_eq_if Let_def
+     is_success_alt_def[symmetric]
+    uminus_poly_def[symmetric]
+    HOL_list.fold_custom_empty
+  by sepref
+
+
+declare check_step_impl.refine[sepref_fr_rules]
+
+sepref_register PAC_checker_l_step PAC_checker_l_step' fully_normalize_poly_impl
+
+definition PAC_checker_l' where
+  \<open>PAC_checker_l' p \<V> A status steps = PAC_checker_l p (\<V>, A) status steps\<close>
+
+lemma PAC_checker_l_alt_def:
+  \<open>PAC_checker_l p \<V>A status steps =
+    (let (\<V>, A) = \<V>A in PAC_checker_l' p \<V> A status steps)\<close>
+  unfolding PAC_checker_l'_def by auto
+
+sepref_definition PAC_checker_l_impl
+  is \<open>uncurry4 PAC_checker_l'\<close>
+  :: \<open>poly_assn\<^sup>k *\<^sub>a vars_assn\<^sup>d *\<^sub>a polys_assn\<^sup>d *\<^sub>a (status_assn raw_string_assn)\<^sup>d *\<^sub>a
+       (list_assn (pac_step_rel_assn (uint64_nat_assn) poly_assn string_assn))\<^sup>k \<rightarrow>\<^sub>a
+     status_assn raw_string_assn \<times>\<^sub>a vars_assn \<times>\<^sub>a polys_assn\<close>
+  supply [[goals_limit=1]] is_Mult_lastI[intro]
+  unfolding PAC_checker_l_def is_success_alt_def[symmetric] PAC_checker_l_step_alt_def
+    nres_bind_let_law[symmetric] PAC_checker_l'_def
+  apply (subst nres_bind_let_law)
+  by sepref
+
+declare PAC_checker_l_impl.refine[sepref_fr_rules]
+
+abbreviation polys_assn_input where
+  \<open>polys_assn_input \<equiv> iam_fmap_assn nat_assn poly_assn\<close>
+
+definition remap_polys_l_dom_err_impl :: \<open>_\<close>  where
+  \<open>remap_polys_l_dom_err_impl =
+    ''Error during initialisation. Too many polynomials where provided. If this happens,'' @
+    ''please report the example to the authors, because something went wrong during '' @
+    ''code generation (code generation to arrays is likely to be broken).''\<close>
+
+lemma [sepref_fr_rules]:
+  \<open>((uncurry0 (return (remap_polys_l_dom_err_impl))),
+    uncurry0 (remap_polys_l_dom_err)) \<in> unit_assn\<^sup>k \<rightarrow>\<^sub>a raw_string_assn\<close>
+   unfolding remap_polys_l_dom_err_def
+     remap_polys_l_dom_err_def
+     list_assn_pure_conv
+   by sepref_to_hoare sep_auto
+
+text \<open>MLton is not able to optimise the calls to pow.\<close>
+lemma pow_2_64: \<open>(2::nat) ^ 64 = 18446744073709551616\<close>
+  by auto
+
+sepref_register upper_bound_on_dom op_fmap_empty
+
+sepref_definition remap_polys_l_impl
+  is \<open>uncurry2 remap_polys_l2\<close>
+  :: \<open>poly_assn\<^sup>k *\<^sub>a vars_assn\<^sup>d *\<^sub>a polys_assn_input\<^sup>d \<rightarrow>\<^sub>a
+    status_assn raw_string_assn \<times>\<^sub>a vars_assn \<times>\<^sub>a polys_assn\<close>
+  supply [[goals_limit=1]] is_Mult_lastI[intro] indom_mI[dest]
+  unfolding remap_polys_l2_def op_fmap_empty_def[symmetric] while_eq_nfoldli[symmetric]
+    while_upt_while_direct pow_2_64
+    in_dom_m_lookup_iff
+    fmlookup'_def[symmetric]
+    union_vars_poly_alt_def[symmetric]
+  apply (rewrite at \<open>fmupd \<hole>\<close> uint64_of_nat_conv_def[symmetric])
+  apply (subst while_upt_while_direct)
+  apply simp
+  apply (rewrite at \<open>op_fmap_empty\<close> annotate_assn[where A=\<open>polys_assn\<close>])
+  by sepref
+
+lemma remap_polys_l2_remap_polys_l:
+  \<open>(uncurry2 remap_polys_l2, uncurry2 remap_polys_l) \<in> (Id \<times>\<^sub>r \<langle>Id\<rangle>set_rel) \<times>\<^sub>r Id \<rightarrow>\<^sub>f \<langle>Id\<rangle>nres_rel\<close>
+  apply (intro frefI fun_relI nres_relI)
+  using remap_polys_l2_remap_polys_l by auto
+
+lemma [sepref_fr_rules]:
+   \<open>(uncurry2 remap_polys_l_impl,
+     uncurry2 remap_polys_l) \<in> poly_assn\<^sup>k *\<^sub>a vars_assn\<^sup>d *\<^sub>a polys_assn_input\<^sup>d \<rightarrow>\<^sub>a
+       status_assn raw_string_assn \<times>\<^sub>a vars_assn \<times>\<^sub>a polys_assn\<close>
+   using hfcomp_tcomp_pre[OF remap_polys_l2_remap_polys_l remap_polys_l_impl.refine]
+   by (auto simp: hrp_comp_def hfprod_def)
+
+sepref_register remap_polys_l
+
+sepref_definition full_checker_l_impl
+  is \<open>uncurry2 full_checker_l\<close>
+  :: \<open>poly_assn\<^sup>k *\<^sub>a polys_assn_input\<^sup>d *\<^sub>a (list_assn (pac_step_rel_assn (uint64_nat_assn) poly_assn string_assn))\<^sup>k \<rightarrow>\<^sub>a
+    status_assn raw_string_assn \<times>\<^sub>a vars_assn \<times>\<^sub>a polys_assn\<close>
+  supply [[goals_limit=1]] is_Mult_lastI[intro]
+  unfolding full_checker_l_def hs.fold_custom_empty
+    union_vars_poly_alt_def[symmetric]
+    PAC_checker_l_alt_def
+  by sepref
+
+sepref_definition PAC_update_impl
+  is \<open>uncurry2 (RETURN ooo fmupd)\<close>
+  :: \<open>nat_assn\<^sup>k *\<^sub>a poly_assn\<^sup>k *\<^sub>a (polys_assn_input)\<^sup>d \<rightarrow>\<^sub>a polys_assn_input\<close>
+  unfolding comp_def
+  by sepref
+
+sepref_definition PAC_empty_impl
+  is \<open>uncurry0 (RETURN fmempty)\<close>
+  :: \<open>unit_assn\<^sup>k \<rightarrow>\<^sub>a polys_assn_input\<close>
+  unfolding op_iam_fmap_empty_def[symmetric] pat_fmap_empty
+  by sepref
+
+sepref_definition empty_vars_impl
+  is \<open>uncurry0 (RETURN {})\<close>
+  :: \<open>unit_assn\<^sup>k \<rightarrow>\<^sub>a vars_assn\<close>
+  unfolding hs.fold_custom_empty
+  by sepref
+
+text \<open>This is a hack for performance. There is no need to recheck that that a char is valid when
+  working on chars coming from strings... It is not that important in most cases, but in our case
+  the preformance difference is really large.\<close>
+
+
+definition unsafe_asciis_of_literal :: \<open>_\<close> where
+  \<open>unsafe_asciis_of_literal xs = String.asciis_of_literal xs\<close>
+
+definition unsafe_asciis_of_literal' :: \<open>_\<close> where
+  [simp, symmetric, code]: \<open>unsafe_asciis_of_literal' = unsafe_asciis_of_literal\<close>
+
+code_printing
+  constant unsafe_asciis_of_literal' \<rightharpoonup>
+    (SML) "!(List.map (fn c => let val k = Char.ord c in IntInf.fromInt k end) /o String.explode)"
+
+text \<open>
+  Now comes the big and ugly and unsafe hack.
+
+  Basically, we try to avoid the conversion to IntInf when calculating the hash. The performance
+  gain is roughly 40\%, which is a LOT and definitively something we need to do. We are aware that the
+  SML semantic encourages compilers to optimise conversions, but this does not happen here,
+  corroborating our early observation on the verified SAT solver IsaSAT.x
+\<close>
+definition raw_explode where
+  [simp]: \<open>raw_explode = String.explode\<close>
+code_printing
+  constant raw_explode \<rightharpoonup>
+    (SML) "String.explode"
+
+definition \<open>hashcode_literal' s \<equiv>
+    foldl (\<lambda>h x. h * 33 + uint32_of_int (of_char x)) 5381
+     (raw_explode s)\<close>
+
+lemmas [code] =
+  hashcode_literal_def[unfolded String.explode_code
+    unsafe_asciis_of_literal_def[symmetric]]
+
+definition uint32_of_char where
+  [symmetric, code_unfold]: \<open>uint32_of_char x = uint32_of_int (int_of_char x)\<close>
+
+
+code_printing
+  constant uint32_of_char \<rightharpoonup>
+    (SML) "!(Word32.fromInt /o (Char.ord))"
+
+lemma [code]: \<open>hashcode s = hashcode_literal' s\<close>
+  unfolding hashcode_literal_def hashcode_list_def
+  apply (auto simp: unsafe_asciis_of_literal_def hashcode_list_def
+     String.asciis_of_literal_def hashcode_literal_def hashcode_literal'_def)
+  done
+
+text \<open>We compile Pastèque in \<^file>\<open>PAC_Checker_MLton.thy\<close>.\<close>
+export_code PAC_checker_l_impl PAC_update_impl PAC_empty_impl the_error is_cfailed is_cfound
+  int_of_integer Del Add Mult nat_of_integer String.implode remap_polys_l_impl
+  fully_normalize_poly_impl union_vars_poly_impl empty_vars_impl
+  full_checker_l_impl check_step_impl CSUCCESS
+  Extension hashcode_literal' version
+  in SML_imp module_name PAC_Checker
+
+
+section \<open>Correctness theorem\<close>
+
+context poly_embed
+begin
+
+definition full_poly_assn where
+  \<open>full_poly_assn = hr_comp poly_assn (fully_unsorted_poly_rel O mset_poly_rel)\<close>
+
+definition full_poly_input_assn where
+  \<open>full_poly_input_assn = hr_comp
+        (hr_comp polys_assn_input
+          (\<langle>nat_rel, fully_unsorted_poly_rel O mset_poly_rel\<rangle>fmap_rel))
+        polys_rel\<close>
+
+definition fully_pac_assn where
+  \<open>fully_pac_assn = (list_assn
+        (hr_comp (pac_step_rel_assn uint64_nat_assn poly_assn string_assn)
+          (p2rel
+            (\<langle>nat_rel,
+             fully_unsorted_poly_rel O
+             mset_poly_rel, var_rel\<rangle>pac_step_rel_raw))))\<close>
+
+definition code_status_assn where
+  \<open>code_status_assn = hr_comp (status_assn raw_string_assn)
+                            code_status_status_rel\<close>
+
+definition full_vars_assn where
+  \<open>full_vars_assn = hr_comp (hs.assn string_assn)
+                              (\<langle>var_rel\<rangle>set_rel)\<close>
+
+lemma polys_rel_full_polys_rel:
+  \<open>polys_rel_full = Id \<times>\<^sub>r polys_rel\<close>
+  by (auto simp: polys_rel_full_def)
+
+definition full_polys_assn :: \<open>_\<close> where
+\<open>full_polys_assn = hr_comp (hr_comp polys_assn
+                              (\<langle>nat_rel,
+                               sorted_poly_rel O mset_poly_rel\<rangle>fmap_rel))
+                            polys_rel\<close>
+
+text \<open>
+
+Below is the full correctness theorems. It basically states that:
+
+  \<^enum> assuming that the input polynomials have no duplicate variables
+
+
+Then:
+
+\<^enum> if the checker returns \<^term>\<open>CFOUND\<close>, the spec is in the ideal
+  and the PAC file is correct
+
+\<^enum> if the checker returns \<^term>\<open>CSUCCESS\<close>, the PAC file is correct (but
+there is no information on the spec, aka checking failed)
+
+\<^enum> if the checker return \<^term>\<open>CFAILED err\<close>, then checking failed (and
+\<^term>\<open>err\<close> \<^emph>\<open>might\<close> give you an indication of the error, but the correctness
+theorem does not say anything about that).
+
+
+The input parameters are:
+
+\<^enum> the specification polynomial represented as a list
+
+\<^enum> the input polynomials as hash map (as an array of option polynomial)
+
+\<^enum> a represention of the PAC proofs.
+
+\<close>
+
+lemma PAC_full_correctness: (* \htmllink{PAC-full-correctness} *)
+  \<open>(uncurry2 full_checker_l_impl,
+     uncurry2 (\<lambda>spec A _. PAC_checker_specification spec A))
+    \<in> (full_poly_assn)\<^sup>k *\<^sub>a (full_poly_input_assn)\<^sup>d *\<^sub>a (fully_pac_assn)\<^sup>k \<rightarrow>\<^sub>a hr_comp
+      (code_status_assn \<times>\<^sub>a full_vars_assn \<times>\<^sub>a hr_comp polys_assn
+                              (\<langle>nat_rel, sorted_poly_rel O mset_poly_rel\<rangle>fmap_rel))
+                            {((st, G), st', G').
+                             st = st' \<and> (st \<noteq> FAILED \<longrightarrow> (G, G') \<in> Id \<times>\<^sub>r polys_rel)}\<close>
+  using
+    full_checker_l_impl.refine[FCOMP full_checker_l_full_checker',
+      FCOMP full_checker_spec',
+      unfolded full_poly_assn_def[symmetric]
+        full_poly_input_assn_def[symmetric]
+        fully_pac_assn_def[symmetric]
+        code_status_assn_def[symmetric]
+        full_vars_assn_def[symmetric]
+        polys_rel_full_polys_rel
+        hr_comp_prod_conv
+        full_polys_assn_def[symmetric]]
+      hr_comp_Id2
+   by auto
+
+text \<open>
+
+It would be more efficient to move the parsing to Isabelle, as this
+would be more memory efficient (and also reduce the TCB). But now
+comes the fun part: It cannot work. A stream (of a file) is consumed
+by side effects. Assume that this would work. The code could look like:
+
+\<^term>\<open>
+  let next_token = read_file file
+  in f (next_token)
+\<close>
+
+This code is equal to (in the HOL sense of equality):
+\<^term>\<open>
+  let _ = read_file file;
+      next_token = read_file file
+  in f (next_token)
+\<close>
+
+However, as an hypothetical \<^term>\<open>read_file\<close> changes the underlying stream, we would get the next
+token. Remark that this is already a weird point of ML compilers. Anyway, I see currently two
+solutions to this problem:
+
+\<^enum> The meta-argument: use it only in the Refinement Framework in a setup where copies are
+disallowed. Basically, this works because we can express the non-duplication constraints on the type
+level. However, we cannot forbid people from expressing things directly at the HOL level.
+
+\<^enum> On the target language side, model the stream as the stream and the position. Reading takes two
+arguments. First, the position to read. Second, the stream (and the current position) to read. If
+the position to read does not match the current position, return an error. This would fit the
+correctness theorem of the code generation (roughly ``if it terminates without exception, the answer
+is the same''), but it is still unsatisfactory.
+\<close>
+
+end
+
+definition \<phi> :: \<open>string \<Rightarrow> nat\<close> where
+  \<open>\<phi> = (SOME \<phi>. bij \<phi>)\<close>
+
+lemma bij_\<phi>: \<open>bij \<phi>\<close>
+  using someI[of \<open>\<lambda>\<phi> :: string \<Rightarrow> nat. bij \<phi>\<close>]
+  unfolding \<phi>_def[symmetric]
+  using poly_embed_EX
+  by auto
+
+global_interpretation PAC: poly_embed where
+  \<phi> = \<phi>
+  apply standard
+  apply (use bij_\<phi> in \<open>auto simp: bij_def\<close>)
+  done
+
+
+text \<open>The full correctness theorem is @{thm PAC.PAC_full_correctness}.\<close>
+
+end
diff --git a/thys/PAC_Checker/PAC_Map_Rel.thy b/thys/PAC_Checker/PAC_Map_Rel.thy
new file mode 100644
--- /dev/null
+++ b/thys/PAC_Checker/PAC_Map_Rel.thy
@@ -0,0 +1,321 @@
+(*
+  File:         PAC_Map_Rel.thy
+  Author:       Mathias Fleury, Daniela Kaufmann, JKU
+  Maintainer:   Mathias Fleury, JKU
+*)
+theory PAC_Map_Rel
+  imports
+    Refine_Imperative_HOL.IICF Finite_Map_Multiset
+begin
+
+
+section \<open>Hash-Map for finite mappings\<close>
+
+text \<open>
+
+This function declares hash-maps for \<^typ>\<open>('a, 'b)fmap\<close>, that are nicer
+to use especially here where everything is finite.
+
+\<close>
+definition fmap_rel where
+  [to_relAPP]:
+  "fmap_rel K V \<equiv> {(m1, m2).
+     (\<forall>i j. i |\<in>| fmdom m2 \<longrightarrow> (j, i) \<in> K \<longrightarrow> (the (fmlookup m1 j), the (fmlookup m2 i)) \<in> V) \<and>
+     fset (fmdom m1) \<subseteq> Domain K \<and> fset (fmdom m2) \<subseteq> Range K \<and>
+     (\<forall>i j. (i, j) \<in> K \<longrightarrow> j |\<in>| fmdom m2 \<longleftrightarrow> i |\<in>| fmdom m1)}"
+
+
+lemma fmap_rel_alt_def:
+  \<open>\<langle>K, V\<rangle>fmap_rel \<equiv>
+     {(m1, m2).
+      (\<forall>i j. i \<in># dom_m m2 \<longrightarrow>
+             (j, i) \<in> K \<longrightarrow> (the (fmlookup m1 j), the (fmlookup m2 i)) \<in> V) \<and>
+      fset (fmdom m1) \<subseteq> Domain K \<and>
+      fset (fmdom m2) \<subseteq> Range K \<and>
+      (\<forall>i j. (i, j) \<in> K \<longrightarrow> (j \<in># dom_m m2) = (i \<in># dom_m m1))}
+\<close>
+  unfolding fmap_rel_def dom_m_def fmember.rep_eq
+  by auto
+
+lemma fmdom_empty_fmempty_iff[simp]: \<open>fmdom m = {||} \<longleftrightarrow> m = fmempty\<close>
+  by (metis fmdom_empty fmdrop_fset_fmdom fmdrop_fset_null)
+
+lemma fmap_rel_empty1_simp[simp]:
+  "(fmempty,m)\<in>\<langle>K,V\<rangle>fmap_rel \<longleftrightarrow> m=fmempty"
+  apply (cases \<open>fmdom m = {||}\<close>)
+   apply (auto simp: fmap_rel_def)[]
+  by (auto simp add: fmember.rep_eq fmap_rel_def simp del: fmdom_empty_fmempty_iff)
+
+lemma fmap_rel_empty2_simp[simp]:
+  "(m,fmempty)\<in>\<langle>K,V\<rangle>fmap_rel \<longleftrightarrow> m=fmempty"
+  apply (cases \<open>fmdom m = {||}\<close>)
+   apply (auto simp: fmap_rel_def)[]
+  by (fastforce simp add: fmember.rep_eq fmap_rel_def simp del: fmdom_empty_fmempty_iff)
+
+sepref_decl_intf ('k,'v) f_map is "('k, 'v) fmap"
+
+lemma [synth_rules]: "\<lbrakk>INTF_OF_REL K TYPE('k); INTF_OF_REL V TYPE('v)\<rbrakk>
+  \<Longrightarrow> INTF_OF_REL (\<langle>K,V\<rangle>fmap_rel) TYPE(('k,'v) f_map)" by simp
+
+
+subsection \<open>Operations\<close>
+sepref_decl_op fmap_empty: "fmempty" :: "\<langle>K,V\<rangle>fmap_rel" .
+
+
+sepref_decl_op fmap_is_empty: "(=) fmempty" :: "\<langle>K,V\<rangle>fmap_rel \<rightarrow> bool_rel"
+  apply (rule fref_ncI)
+  apply parametricity
+  apply (rule fun_relI; auto)
+  done
+
+
+lemma fmap_rel_fmupd_fmap_rel:
+  \<open>(A, B) \<in> \<langle>K, R\<rangle>fmap_rel \<Longrightarrow> (p, p') \<in> K \<Longrightarrow> (q, q') \<in> R \<Longrightarrow>
+   (fmupd p q A, fmupd p' q' B) \<in> \<langle>K, R\<rangle>fmap_rel\<close>
+  if "single_valued K" "single_valued (K\<inverse>)"
+  using that
+  unfolding fmap_rel_alt_def
+  apply (case_tac \<open>p' \<in># dom_m B\<close>)
+  apply (auto simp add: all_conj_distrib IS_RIGHT_UNIQUED dest!: multi_member_split)
+  done
+
+sepref_decl_op fmap_update: "fmupd" :: "K \<rightarrow> V \<rightarrow> \<langle>K,V\<rangle>fmap_rel \<rightarrow> \<langle>K,V\<rangle>fmap_rel"
+  where "single_valued K" "single_valued (K\<inverse>)"
+  apply (rule fref_ncI)
+  apply parametricity
+  apply (intro fun_relI)
+  by (rule fmap_rel_fmupd_fmap_rel)
+
+lemma remove1_mset_eq_add_mset_iff:
+   \<open>remove1_mset a A = add_mset a A' \<longleftrightarrow> A = add_mset a (add_mset a A')\<close>
+  by (metis add_mset_add_single add_mset_diff_bothsides diff_zero remove1_mset_eqE)
+
+lemma fmap_rel_fmdrop_fmap_rel:
+  \<open>(fmdrop p A, fmdrop p' B) \<in> \<langle>K, R\<rangle>fmap_rel\<close>
+  if single: "single_valued K" "single_valued (K\<inverse>)" and
+    H0: \<open>(A, B) \<in> \<langle>K, R\<rangle>fmap_rel\<close> \<open>(p, p') \<in> K\<close>
+proof -
+  have H: \<open>\<And>Aa j.
+       \<forall>i. i \<in># dom_m B \<longrightarrow> (\<forall>j. (j, i) \<in> K \<longrightarrow> (the (fmlookup A j), the (fmlookup B i)) \<in> R) \<Longrightarrow>
+       remove1_mset p' (dom_m B) = add_mset p' Aa \<Longrightarrow> (j, p') \<in> K \<Longrightarrow> False\<close>
+    by (metis dom_m_fmdrop fmlookup_drop in_dom_m_lookup_iff union_single_eq_member)
+  have H2: \<open>\<And>i Aa j.
+       (p, p') \<in> K \<Longrightarrow>
+       \<forall>i. i \<in># dom_m B \<longrightarrow> (\<forall>j. (j, i) \<in> K \<longrightarrow> (the (fmlookup A j), the (fmlookup B i)) \<in> R) \<Longrightarrow>
+       \<forall>i j. (i, j) \<in> K \<longrightarrow> (j \<in># dom_m B) = (i \<in># dom_m A) \<Longrightarrow>
+       remove1_mset p' (dom_m B) = add_mset i Aa \<Longrightarrow>
+       (j, i) \<in> K \<Longrightarrow>
+            (the (fmlookup A j), the (fmlookup B i)) \<in> R \<and> j \<in># remove1_mset p (dom_m A) \<and>
+        i \<in># remove1_mset p' (dom_m B)\<close>
+    \<open>\<And>i j Aa.
+       (p, p') \<in> K \<Longrightarrow>
+       single_valued K \<Longrightarrow>
+       single_valued (K\<inverse>) \<Longrightarrow>
+       \<forall>i. i \<in># dom_m B \<longrightarrow> (\<forall>j. (j, i) \<in> K \<longrightarrow> (the (fmlookup A j), the (fmlookup B i)) \<in> R) \<Longrightarrow>
+       fset (fmdom A) \<subseteq> Domain K \<Longrightarrow>
+       fset (fmdom B) \<subseteq> Range K \<Longrightarrow>
+       \<forall>i j. (i, j) \<in> K \<longrightarrow> (j \<in># dom_m B) = (i \<in># dom_m A) \<Longrightarrow>
+       (i, j) \<in> K \<Longrightarrow> remove1_mset p (dom_m A) = add_mset i Aa \<Longrightarrow> j \<in># remove1_mset p' (dom_m B)\<close>
+    using single
+    by (metis IS_RIGHT_UNIQUED converse.intros dom_m_fmdrop fmlookup_drop in_dom_m_lookup_iff
+        union_single_eq_member)+
+  show \<open>(fmdrop p A, fmdrop p' B) \<in> \<langle>K, R\<rangle>fmap_rel\<close>
+    using that
+    unfolding fmap_rel_alt_def
+    by (auto simp add: all_conj_distrib IS_RIGHT_UNIQUED
+        dest!: multi_member_split dest: H H2)
+qed
+
+sepref_decl_op fmap_delete: "fmdrop" :: "K \<rightarrow> \<langle>K,V\<rangle>fmap_rel \<rightarrow> \<langle>K,V\<rangle>fmap_rel"
+  where "single_valued K" "single_valued (K\<inverse>)"
+  apply (rule fref_ncI)
+  apply parametricity
+  by (auto simp add: fmap_rel_fmdrop_fmap_rel)
+
+lemma fmap_rel_nat_the_fmlookup[intro]:
+  \<open>(A, B) \<in> \<langle>S, R\<rangle>fmap_rel \<Longrightarrow> (p, p') \<in> S \<Longrightarrow> p' \<in># dom_m B \<Longrightarrow>
+     (the (fmlookup A p), the (fmlookup B p')) \<in> R\<close>
+  by (auto simp: fmap_rel_alt_def distinct_mset_dom)
+
+lemma fmap_rel_in_dom_iff:
+  \<open>(aa, a'a) \<in> \<langle>K, V\<rangle>fmap_rel \<Longrightarrow>
+    (a, a') \<in> K \<Longrightarrow>
+    a' \<in># dom_m a'a \<longleftrightarrow>
+    a \<in># dom_m aa\<close>
+  unfolding fmap_rel_alt_def
+  by auto
+
+lemma fmap_rel_fmlookup_rel:
+  \<open>(a, a') \<in> K \<Longrightarrow> (aa, a'a) \<in> \<langle>K, V\<rangle>fmap_rel \<Longrightarrow>
+         (fmlookup aa a, fmlookup a'a a') \<in> \<langle>V\<rangle>option_rel\<close>
+  using fmap_rel_nat_the_fmlookup[of aa a'a K V a a']
+    fmap_rel_in_dom_iff[of aa a'a K V a a']
+    in_dom_m_lookup_iff[of a' a'a]
+    in_dom_m_lookup_iff[of a aa]
+  by (cases \<open>a' \<in># dom_m a'a\<close>)
+    (auto simp del: fmap_rel_nat_the_fmlookup)
+
+
+sepref_decl_op fmap_lookup: "fmlookup" :: "\<langle>K,V\<rangle>fmap_rel \<rightarrow> K \<rightarrow>  \<langle>V\<rangle>option_rel"
+  apply (rule fref_ncI)
+  apply parametricity
+  apply (intro fun_relI)
+  apply (rule fmap_rel_fmlookup_rel; assumption)
+  done
+
+lemma in_fdom_alt: "k\<in>#dom_m m \<longleftrightarrow> \<not>is_None (fmlookup m k)"
+  apply (auto split: option.split intro: fmdom_notI simp: dom_m_def fmember.rep_eq)
+   apply (meson fmdom_notI notin_fset)
+  using notin_fset by fastforce
+
+sepref_decl_op fmap_contains_key: "\<lambda>k m. k\<in>#dom_m m" :: "K \<rightarrow> \<langle>K,V\<rangle>fmap_rel \<rightarrow> bool_rel"
+  unfolding in_fdom_alt
+  apply (rule fref_ncI)
+  apply parametricity
+  apply (rule fmap_rel_fmlookup_rel; assumption)
+  done
+
+
+subsection \<open>Patterns\<close>
+
+lemma pat_fmap_empty[pat_rules]: "fmempty \<equiv> op_fmap_empty" by simp
+
+lemma pat_map_is_empty[pat_rules]:
+  "(=) $m$fmempty \<equiv> op_fmap_is_empty$m"
+  "(=) $fmempty$m \<equiv> op_fmap_is_empty$m"
+  "(=) $(dom_m$m)${#} \<equiv> op_fmap_is_empty$m"
+  "(=) ${#}$(dom_m$m) \<equiv> op_fmap_is_empty$m"
+  unfolding atomize_eq
+  by (auto dest: sym)
+
+lemma op_map_contains_key[pat_rules]:
+  "(\<in>#) $ k $ (dom_m$m) \<equiv> op_fmap_contains_key$'k$'m"
+  by (auto intro!: eq_reflection)
+
+
+subsection \<open>Mapping to Normal Hashmaps\<close>
+
+abbreviation map_of_fmap :: \<open>('k \<Rightarrow> 'v option) \<Rightarrow> ('k, 'v) fmap\<close> where
+  \<open>map_of_fmap h \<equiv> Abs_fmap h\<close>
+
+definition map_fmap_rel where
+  \<open>map_fmap_rel = br map_of_fmap (\<lambda>a. finite (dom a))\<close>
+
+lemma fmdrop_set_None:
+  \<open>(op_map_delete, fmdrop) \<in> Id \<rightarrow> map_fmap_rel \<rightarrow> map_fmap_rel\<close>
+  apply (auto simp: map_fmap_rel_def br_def)
+  apply (subst fmdrop.abs_eq)
+   apply (auto simp: eq_onp_def fmap.Abs_fmap_inject
+      map_drop_def map_filter_finite
+      intro!: ext)
+   apply (auto simp: map_filter_def)
+  done
+
+lemma map_upd_fmupd:
+  \<open>(op_map_update, fmupd) \<in> Id \<rightarrow> Id \<rightarrow> map_fmap_rel \<rightarrow> map_fmap_rel\<close>
+  apply (auto simp: map_fmap_rel_def br_def)
+  apply (subst fmupd.abs_eq)
+   apply (auto simp: eq_onp_def fmap.Abs_fmap_inject
+      map_drop_def map_filter_finite map_upd_def
+      intro!: ext)
+  done
+
+
+text \<open>Technically @{term op_map_lookup} has the arguments in the wrong direction.\<close>
+definition fmlookup' where
+  [simp]: \<open>fmlookup' A k = fmlookup k A\<close>
+
+
+lemma [def_pat_rules]:
+  \<open>((\<in>#)$k$(dom_m$A)) \<equiv> Not$(is_None$(fmlookup'$k$A))\<close>
+  by (simp add: fold_is_None in_fdom_alt)
+
+lemma op_map_lookup_fmlookup:
+  \<open>(op_map_lookup, fmlookup') \<in> Id \<rightarrow> map_fmap_rel \<rightarrow> \<langle>Id\<rangle>option_rel\<close>
+  by (auto simp: map_fmap_rel_def br_def fmap.Abs_fmap_inverse)
+
+
+abbreviation hm_fmap_assn where
+  \<open>hm_fmap_assn K V \<equiv> hr_comp (hm.assn K V) map_fmap_rel\<close>
+
+lemmas fmap_delete_hnr [sepref_fr_rules] =
+  hm.delete_hnr[FCOMP fmdrop_set_None]
+
+lemmas fmap_update_hnr [sepref_fr_rules] =
+  hm.update_hnr[FCOMP map_upd_fmupd]
+
+
+lemmas fmap_lookup_hnr [sepref_fr_rules] =
+  hm.lookup_hnr[FCOMP op_map_lookup_fmlookup]
+
+lemma fmempty_empty:
+  \<open>(uncurry0 (RETURN op_map_empty), uncurry0 (RETURN fmempty)) \<in> unit_rel \<rightarrow>\<^sub>f \<langle>map_fmap_rel\<rangle>nres_rel\<close>
+  by (auto simp: map_fmap_rel_def br_def fmempty_def frefI nres_relI)
+
+lemmas [sepref_fr_rules] =
+  hm.empty_hnr[FCOMP fmempty_empty, unfolded op_fmap_empty_def[symmetric]]
+
+abbreviation iam_fmap_assn where
+  \<open>iam_fmap_assn K V \<equiv> hr_comp (iam.assn K V) map_fmap_rel\<close>
+
+lemmas iam_fmap_delete_hnr [sepref_fr_rules] =
+  iam.delete_hnr[FCOMP fmdrop_set_None]
+
+lemmas iam_ffmap_update_hnr [sepref_fr_rules] =
+  iam.update_hnr[FCOMP map_upd_fmupd]
+
+
+lemmas iam_ffmap_lookup_hnr [sepref_fr_rules] =
+  iam.lookup_hnr[FCOMP op_map_lookup_fmlookup]
+
+definition op_iam_fmap_empty where
+  \<open>op_iam_fmap_empty = fmempty\<close>
+
+lemma iam_fmempty_empty:
+  \<open>(uncurry0 (RETURN op_map_empty), uncurry0 (RETURN op_iam_fmap_empty)) \<in> unit_rel \<rightarrow>\<^sub>f \<langle>map_fmap_rel\<rangle>nres_rel\<close>
+  by (auto simp: map_fmap_rel_def br_def fmempty_def frefI nres_relI op_iam_fmap_empty_def)
+
+lemmas [sepref_fr_rules] =
+  iam.empty_hnr[FCOMP fmempty_empty, unfolded op_iam_fmap_empty_def[symmetric]]
+
+definition upper_bound_on_dom where
+  \<open>upper_bound_on_dom A = SPEC(\<lambda>n. \<forall>i \<in>#(dom_m A). i < n)\<close>
+
+lemma [sepref_fr_rules]:
+  \<open>((Array.len), upper_bound_on_dom) \<in> (iam_fmap_assn nat_assn V)\<^sup>k \<rightarrow>\<^sub>a nat_assn\<close>
+proof -
+  have [simp]: \<open>finite (dom b) \<Longrightarrow> i \<in> fset (fmdom (map_of_fmap b)) \<longleftrightarrow> i \<in> dom b\<close> for i b
+    by (subst fmdom.abs_eq)
+      (auto simp: eq_onp_def fset.Abs_fset_inverse)
+  have 2: \<open>nat_rel = the_pure (nat_assn)\<close> and
+    3: \<open>nat_assn = pure nat_rel\<close>
+    by auto
+  have [simp]: \<open>the_pure (\<lambda>a c :: nat. \<up> (c = a)) = nat_rel\<close>
+    apply (subst 2)
+    apply (subst 3)
+    apply (subst pure_def)
+    apply auto
+    done
+
+  have [simp]: \<open>(iam_of_list l, b) \<in> the_pure (\<lambda>a c :: nat. \<up> (c = a)) \<rightarrow> \<langle>the_pure V\<rangle>option_rel \<Longrightarrow>
+       b i = Some y \<Longrightarrow> i < length l\<close>  for i b l y
+    by (auto dest!: fun_relD[of _ _ _ _ i i] simp: option_rel_def
+        iam_of_list_def split: if_splits)
+  show ?thesis
+    by sepref_to_hoare
+      (sep_auto simp: upper_bound_on_dom_def hr_comp_def iam.assn_def map_rel_def
+        map_fmap_rel_def is_iam_def br_def dom_m_def)
+qed
+
+
+lemma fmap_rel_nat_rel_dom_m[simp]:
+  \<open>(A, B) \<in> \<langle>nat_rel, R\<rangle>fmap_rel \<Longrightarrow> dom_m A = dom_m B\<close>
+  by (subst distinct_set_mset_eq_iff[symmetric])
+    (auto simp: fmap_rel_alt_def distinct_mset_dom
+      simp del: fmap_rel_nat_the_fmlookup)
+
+lemma ref_two_step':
+  \<open>A \<le> B \<Longrightarrow>  \<Down> R A \<le> \<Down> R B\<close>
+  using ref_two_step by auto
+
+end
diff --git a/thys/PAC_Checker/PAC_More_Poly.thy b/thys/PAC_Checker/PAC_More_Poly.thy
new file mode 100644
--- /dev/null
+++ b/thys/PAC_Checker/PAC_More_Poly.thy
@@ -0,0 +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, hide_lams) 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'
+          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 add: )
+  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)
+  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)+
+  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, hide_lams) 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, hide_lams) 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)
+  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_Polynomials.thy b/thys/PAC_Checker/PAC_Polynomials.thy
new file mode 100644
--- /dev/null
+++ b/thys/PAC_Checker/PAC_Polynomials.thy
@@ -0,0 +1,490 @@
+theory PAC_Polynomials
+  imports PAC_Specification Finite_Map_Multiset
+begin
+
+
+section \<open>Polynomials of strings\<close>
+
+text \<open>
+
+  Isabelle's definition of polynomials only work with variables of type
+  \<^typ>\<open>nat\<close>. Therefore, we introduce a version that uses strings by using an injective function
+  that converts a string to a natural number. It exists because strings are countable. Remark that
+  the whole development is independent of the function.
+
+\<close>
+
+subsection \<open>Polynomials and Variables\<close>
+
+lemma poly_embed_EX:
+  \<open>\<exists>\<phi>. bij (\<phi> :: string \<Rightarrow> nat)\<close>
+  by (rule countableE_infinite[of \<open>UNIV :: string set\<close>])
+     (auto intro!: infinite_UNIV_listI)
+
+text \<open>Using a multiset instead of a list has some advantage from an abstract point of view. First,
+  we can have monomials that appear several times  and the coefficient can also be zero. Basically,
+  we can represent un-normalised polynomials, which is very useful to talk about intermediate states
+  in our program.
+\<close>
+type_synonym term_poly = \<open>string multiset\<close>
+type_synonym mset_polynomial =
+  \<open>(term_poly * int) multiset\<close>
+
+definition normalized_poly :: \<open>mset_polynomial \<Rightarrow> bool\<close> where
+  \<open>normalized_poly p \<longleftrightarrow>
+     distinct_mset (fst `# p) \<and>
+     0 \<notin># snd `# p\<close>
+
+lemma normalized_poly_simps[simp]:
+  \<open>normalized_poly {#}\<close>
+  \<open>normalized_poly (add_mset t p) \<longleftrightarrow> snd t \<noteq> 0 \<and>
+    fst t \<notin># fst `# p \<and> normalized_poly p\<close>
+  by (auto simp: normalized_poly_def)
+
+lemma normalized_poly_mono:
+  \<open>normalized_poly B \<Longrightarrow> A \<subseteq># B \<Longrightarrow> normalized_poly A\<close>
+  unfolding normalized_poly_def
+  by (auto intro: distinct_mset_mono image_mset_subseteq_mono)
+
+definition mult_poly_by_monom :: \<open>term_poly * int \<Rightarrow> mset_polynomial \<Rightarrow> mset_polynomial\<close> where
+  \<open>mult_poly_by_monom  = (\<lambda>ys q. image_mset (\<lambda>xs. (fst xs + fst ys, snd ys * snd xs)) q)\<close>
+
+
+definition mult_poly_raw :: \<open>mset_polynomial \<Rightarrow> mset_polynomial \<Rightarrow> mset_polynomial\<close> where
+  \<open>mult_poly_raw p q =
+    (sum_mset ((\<lambda>y. mult_poly_by_monom y q) `# p))\<close>
+
+
+definition remove_powers :: \<open>mset_polynomial \<Rightarrow> mset_polynomial\<close> where
+  \<open>remove_powers xs =  image_mset (apfst remdups_mset) xs\<close>
+
+
+definition all_vars_mset :: \<open>mset_polynomial \<Rightarrow> string multiset\<close> where
+  \<open>all_vars_mset p = \<Union># (fst `# p)\<close>
+
+abbreviation all_vars :: \<open>mset_polynomial \<Rightarrow> string set\<close> where
+  \<open>all_vars p \<equiv> set_mset (all_vars_mset p)\<close>
+
+definition add_to_coefficient :: \<open>_ \<Rightarrow> mset_polynomial \<Rightarrow> mset_polynomial\<close>  where
+  \<open>add_to_coefficient = (\<lambda>(a, n) b. {#(a', _) \<in># b. a' \<noteq> a#} +
+             (if n + sum_mset (snd `# {#(a', _) \<in># b. a' = a#}) = 0 then {#}
+               else {#(a, n + sum_mset (snd `# {#(a', _) \<in># b. a' = a#}))#}))\<close>
+
+definition normalize_poly :: \<open>mset_polynomial \<Rightarrow> mset_polynomial\<close> where
+  \<open>normalize_poly p = fold_mset add_to_coefficient {#} p\<close>
+
+lemma add_to_coefficient_simps:
+  \<open>n + sum_mset (snd `# {#(a', _) \<in># b. a' = a#}) \<noteq> 0 \<Longrightarrow>
+    add_to_coefficient (a, n) b = {#(a', _) \<in># b. a' \<noteq> a#} +
+             {#(a, n + sum_mset (snd `# {#(a', _) \<in># b. a' = a#}))#}\<close>
+  \<open>n + sum_mset (snd `# {#(a', _) \<in># b. a' = a#}) = 0 \<Longrightarrow>
+    add_to_coefficient (a, n) b = {#(a', _) \<in># b. a' \<noteq> a#}\<close> and
+  add_to_coefficient_simps_If:
+  \<open>add_to_coefficient (a, n) b = {#(a', _) \<in># b. a' \<noteq> a#} +
+             (if n + sum_mset (snd `# {#(a', _) \<in># b. a' = a#}) = 0 then {#}
+               else {#(a, n + sum_mset (snd `# {#(a', _) \<in># b. a' = a#}))#})\<close>
+  by (auto simp: add_to_coefficient_def)
+
+interpretation comp_fun_commute \<open>add_to_coefficient\<close>
+proof -
+  have [simp]:
+    \<open>a \<noteq> aa \<Longrightarrow>
+    ((case x of (a', _) \<Rightarrow> a' \<noteq> aa) \<and> (case x of (a', _) \<Rightarrow> a' = a)) \<longleftrightarrow>
+    (case x of (a', _) \<Rightarrow> a' = a)\<close> for a' aa a x
+    by auto
+  show \<open>comp_fun_commute add_to_coefficient\<close>
+    unfolding add_to_coefficient_def
+    by standard
+      (auto intro!: ext simp: filter_filter_mset ac_simps add_eq_0_iff
+      intro: filter_mset_cong)
+qed
+
+lemma normalized_poly_normalize_poly[simp]:
+  \<open>normalized_poly (normalize_poly p)\<close>
+  unfolding normalize_poly_def
+  apply (induction p)
+  subgoal by auto
+  subgoal for x p
+    by (cases x)
+      (auto simp: add_to_coefficient_simps_If
+      intro: normalized_poly_mono)
+  done
+
+
+subsection \<open>Addition\<close>
+
+inductive add_poly_p :: \<open>mset_polynomial \<times> mset_polynomial \<times> mset_polynomial \<Rightarrow> mset_polynomial \<times> mset_polynomial \<times> mset_polynomial \<Rightarrow> bool\<close> where
+add_new_coeff_r:
+    \<open>add_poly_p (p, add_mset x q, r) (p, q, add_mset x r)\<close> |
+add_new_coeff_l:
+    \<open>add_poly_p (add_mset x p, q, r) (p, q, add_mset x r)\<close> |
+add_same_coeff_l:
+    \<open>add_poly_p (add_mset (x, n) p, q, add_mset (x, m) r) (p, q, add_mset (x, n + m) r)\<close> |
+add_same_coeff_r:
+    \<open>add_poly_p (p, add_mset (x, n) q, add_mset (x, m) r) (p, q, add_mset (x, n + m) r)\<close> |
+rem_0_coeff:
+    \<open>add_poly_p (p, q, add_mset (x, 0) r) (p, q, r)\<close>
+
+inductive_cases add_poly_pE: \<open>add_poly_p S T\<close>
+
+lemmas add_poly_p_induct =
+  add_poly_p.induct[split_format(complete)]
+
+lemma add_poly_p_empty_l:
+  \<open>add_poly_p\<^sup>*\<^sup>* (p, q, r) ({#}, q, p + r)\<close>
+  apply (induction p arbitrary: r)
+  subgoal by auto
+  subgoal
+    by (metis (no_types, lifting) add_new_coeff_l r_into_rtranclp
+      rtranclp_trans union_mset_add_mset_left union_mset_add_mset_right)
+  done
+
+lemma add_poly_p_empty_r:
+  \<open>add_poly_p\<^sup>*\<^sup>* (p, q, r) (p, {#}, q + r)\<close>
+  apply (induction q arbitrary: r)
+  subgoal by auto
+  subgoal
+    by (metis (no_types, lifting) add_new_coeff_r r_into_rtranclp
+      rtranclp_trans union_mset_add_mset_left union_mset_add_mset_right)
+  done
+
+lemma add_poly_p_sym:
+  \<open>add_poly_p (p, q, r) (p', q', r') \<longleftrightarrow> add_poly_p (q, p, r) (q', p', r')\<close>
+  apply (rule iffI)
+  subgoal
+    by (cases rule: add_poly_p.cases, assumption)
+      (auto intro: add_poly_p.intros)
+  subgoal
+    by (cases rule: add_poly_p.cases, assumption)
+      (auto intro: add_poly_p.intros)
+  done
+
+lemma wf_if_measure_in_wf:
+  \<open>wf R \<Longrightarrow> (\<And>a b. (a, b) \<in> S \<Longrightarrow> (\<nu> a, \<nu> b)\<in>R) \<Longrightarrow> wf S\<close>
+  by (metis in_inv_image wfE_min wfI_min wf_inv_image)
+
+lemma lexn_n:
+  \<open>n > 0 \<Longrightarrow> (x # xs, y # ys) \<in> lexn r n \<longleftrightarrow>
+  (length xs = n-1 \<and> length ys = n-1) \<and> ((x, y) \<in> r \<or> (x = y \<and> (xs, ys) \<in> lexn r (n - 1)))\<close>
+  apply (cases n)
+   apply simp
+  by (auto simp: map_prod_def image_iff lex_prod_def)
+
+lemma wf_add_poly_p:
+  \<open>wf {(x, y). add_poly_p y x}\<close>
+  by (rule wf_if_measure_in_wf[where R = \<open>lexn less_than 3\<close> and
+     \<nu> = \<open>\<lambda>(a,b,c). [size a , size b, size c]\<close>])
+    (auto simp: add_poly_p.simps wf_lexn
+     simp: lexn_n simp del: lexn.simps(2))
+
+lemma mult_poly_by_monom_simps[simp]:
+  \<open>mult_poly_by_monom t {#} = {#}\<close>
+  \<open>mult_poly_by_monom t (ps + qs) =  mult_poly_by_monom t ps + mult_poly_by_monom t qs\<close>
+  \<open>mult_poly_by_monom a (add_mset p ps) = add_mset (fst a + fst p, snd a * snd p) (mult_poly_by_monom a ps)\<close>
+proof -
+  interpret comp_fun_commute \<open>(\<lambda>xs. add_mset (xs + t))\<close> for t
+    by standard auto
+  show
+    \<open>mult_poly_by_monom t (ps + qs) =  mult_poly_by_monom t ps + mult_poly_by_monom t qs\<close> for t
+    by (induction ps)
+      (auto simp: mult_poly_by_monom_def)
+  show
+    \<open>mult_poly_by_monom a (add_mset p ps) = add_mset (fst a + fst p, snd a * snd p) (mult_poly_by_monom a ps)\<close>
+    \<open>mult_poly_by_monom t {#} = {#}\<close>for t
+    by (auto simp: mult_poly_by_monom_def)
+qed
+
+inductive mult_poly_p :: \<open>mset_polynomial \<Rightarrow> mset_polynomial \<times> mset_polynomial \<Rightarrow> mset_polynomial \<times> mset_polynomial \<Rightarrow> bool\<close>
+  for q :: mset_polynomial where
+mult_step:
+    \<open>mult_poly_p q (add_mset (xs, n) p, r) (p, (\<lambda>(ys, m). (remdups_mset (xs + ys), n * m)) `# q + r)\<close>
+
+
+lemmas mult_poly_p_induct = mult_poly_p.induct[split_format(complete)]
+
+subsection \<open>Normalisation\<close>
+
+inductive normalize_poly_p :: \<open>mset_polynomial \<Rightarrow> mset_polynomial \<Rightarrow> bool\<close>where
+rem_0_coeff[simp, intro]:
+    \<open>normalize_poly_p p q \<Longrightarrow> normalize_poly_p (add_mset (xs, 0) p) q\<close> |
+merge_dup_coeff[simp, intro]:
+    \<open>normalize_poly_p p q \<Longrightarrow> normalize_poly_p (add_mset (xs, m) (add_mset (xs, n) p)) (add_mset (xs, m + n) q)\<close> |
+same[simp, intro]:
+    \<open>normalize_poly_p p p\<close> |
+keep_coeff[simp, intro]:
+    \<open>normalize_poly_p p q \<Longrightarrow> normalize_poly_p (add_mset x p) (add_mset x q)\<close>
+
+
+subsection \<open>Correctness\<close>
+text \<open>
+  This locales maps string polynomials to real polynomials.
+\<close>
+locale poly_embed =
+  fixes \<phi> :: \<open>string \<Rightarrow> nat\<close>
+  assumes \<phi>_inj: \<open>inj \<phi>\<close>
+begin
+
+definition poly_of_vars :: "term_poly \<Rightarrow> ('a :: {comm_semiring_1}) mpoly" where
+  \<open>poly_of_vars xs = fold_mset (\<lambda>a b. Var (\<phi> a) * b) (1 :: 'a mpoly) xs\<close>
+
+lemma poly_of_vars_simps[simp]:
+  shows
+    \<open>poly_of_vars (add_mset x xs) = Var (\<phi> x) * (poly_of_vars xs :: ('a :: {comm_semiring_1}) mpoly)\<close> (is ?A) and
+    \<open>poly_of_vars (xs + ys) = poly_of_vars xs * (poly_of_vars ys :: ('a :: {comm_semiring_1}) mpoly)\<close> (is ?B)
+proof -
+  interpret comp_fun_commute \<open>(\<lambda>a b. (b :: 'a :: {comm_semiring_1} mpoly) * Var (\<phi> a))\<close>
+    by standard
+      (auto simp: algebra_simps ac_simps
+         Var_def times_monomial_monomial intro!: ext)
+
+  show ?A
+    by (auto simp: poly_of_vars_def comp_fun_commute_axioms fold_mset_fusion
+      ac_simps)
+  show ?B
+    apply (auto simp: poly_of_vars_def ac_simps)
+    by (simp add: local.comp_fun_commute_axioms local.fold_mset_fusion
+      semiring_normalization_rules(18))
+qed
+
+
+definition mononom_of_vars where
+  \<open>mononom_of_vars \<equiv> (\<lambda>(xs, n). (+) (Const n * poly_of_vars xs))\<close>
+
+interpretation comp_fun_commute \<open>mononom_of_vars\<close>
+  by standard
+    (auto simp: algebra_simps ac_simps mononom_of_vars_def
+       Var_def times_monomial_monomial intro!: ext)
+
+lemma [simp]:
+  \<open>poly_of_vars {#} = 1\<close>
+  by (auto simp: poly_of_vars_def)
+
+lemma mononom_of_vars_add[simp]:
+  \<open>NO_MATCH 0 b \<Longrightarrow> mononom_of_vars xs b = Const (snd xs) * poly_of_vars (fst xs) + b\<close>
+  by (cases xs)
+    (auto simp: ac_simps mononom_of_vars_def)
+
+definition polynomial_of_mset :: \<open>mset_polynomial \<Rightarrow> _\<close> where
+  \<open>polynomial_of_mset p = sum_mset (mononom_of_vars `# p) 0\<close>
+
+lemma polynomial_of_mset_append[simp]:
+  \<open>polynomial_of_mset (xs + ys) = polynomial_of_mset xs + polynomial_of_mset ys\<close>
+  by (auto simp: ac_simps Const_def polynomial_of_mset_def)
+
+lemma polynomial_of_mset_Cons[simp]:
+  \<open>polynomial_of_mset (add_mset x ys) = Const (snd x) * poly_of_vars (fst x) + polynomial_of_mset ys\<close>
+  by (cases x)
+    (auto simp: ac_simps polynomial_of_mset_def mononom_of_vars_def)
+
+lemma polynomial_of_mset_empty[simp]:
+  \<open>polynomial_of_mset {#} = 0\<close>
+  by (auto simp: polynomial_of_mset_def)
+
+lemma polynomial_of_mset_mult_poly_by_monom[simp]:
+  \<open>polynomial_of_mset (mult_poly_by_monom x ys) =
+       (Const (snd x) * poly_of_vars (fst x) * polynomial_of_mset ys)\<close>
+ by (induction ys)
+   (auto simp: Const_mult algebra_simps)
+
+lemma polynomial_of_mset_mult_poly_raw[simp]:
+  \<open>polynomial_of_mset (mult_poly_raw xs ys) = polynomial_of_mset xs * polynomial_of_mset ys\<close>
+  unfolding mult_poly_raw_def
+  by (induction xs arbitrary: ys)
+   (auto simp: Const_mult algebra_simps)
+
+lemma polynomial_of_mset_uminus:
+  \<open>polynomial_of_mset {#case x of (a, b) \<Rightarrow> (a, - b). x \<in># za#} =
+    - polynomial_of_mset za\<close>
+  by (induction za)
+    auto
+
+
+lemma X2_X_polynomial_bool_mult_in:
+  \<open>Var (x1) * (Var (x1) * p) -  Var (x1) * p \<in> More_Modules.ideal polynomial_bool\<close>
+  using ideal_mult_right_in[OF  X2_X_in_pac_ideal[of x1 \<open>{}\<close>, unfolded pac_ideal_def], of p]
+  by (auto simp: right_diff_distrib ac_simps power2_eq_square)
+
+
+lemma polynomial_of_list_remove_powers_polynomial_bool:
+  \<open>(polynomial_of_mset xs) - polynomial_of_mset (remove_powers xs) \<in> ideal polynomial_bool\<close>
+proof (induction xs)
+  case empty
+  then show \<open>?case\<close> by (auto simp: remove_powers_def ideal.span_zero)
+next
+  case (add x xs)
+  have H1: \<open>x1 \<in># x2 \<Longrightarrow>
+       Var (\<phi> x1) * poly_of_vars x2 - p \<in> More_Modules.ideal polynomial_bool \<longleftrightarrow>
+       poly_of_vars x2 - p \<in> More_Modules.ideal polynomial_bool
+       \<close> for x1 x2 p
+    apply (subst (2) ideal.span_add_eq[symmetric,
+      of \<open>Var (\<phi> x1) * poly_of_vars x2 - poly_of_vars x2\<close>])
+    apply (drule multi_member_split)
+    apply (auto simp: X2_X_polynomial_bool_mult_in)
+    done
+
+  have diff: \<open>poly_of_vars (x) - poly_of_vars (remdups_mset (x)) \<in> ideal polynomial_bool\<close> for x
+    by (induction x)
+     (auto simp: remove_powers_def ideal.span_zero H1
+      simp flip: right_diff_distrib intro!: ideal.span_scale)
+  have [simp]: \<open>polynomial_of_mset xs -
+    polynomial_of_mset (apfst remdups_mset `# xs)
+    \<in> More_Modules.ideal polynomial_bool \<Longrightarrow>
+    poly_of_vars ys * poly_of_vars ys -
+    poly_of_vars ys * poly_of_vars (remdups_mset ys)
+    \<in> More_Modules.ideal polynomial_bool \<Longrightarrow>
+    polynomial_of_mset xs + Const y * poly_of_vars ys -
+    (polynomial_of_mset (apfst remdups_mset `# xs) +
+    Const y * poly_of_vars (remdups_mset ys))
+    \<in> More_Modules.ideal polynomial_bool\<close> for y ys
+    by (metis add_diff_add diff ideal.scale_right_diff_distrib ideal.span_add ideal.span_scale)
+  show ?case
+    using add
+    apply (cases x)
+    subgoal for ys y
+      using ideal_mult_right_in2[OF diff, of \<open>poly_of_vars ys\<close> ys]
+      by (auto simp: remove_powers_def right_diff_distrib
+        ideal.span_diff ideal.span_add field_simps)
+    done
+qed
+
+lemma add_poly_p_polynomial_of_mset:
+  \<open>add_poly_p (p, q, r) (p', q', r') \<Longrightarrow>
+    polynomial_of_mset r + (polynomial_of_mset p + polynomial_of_mset q) =
+    polynomial_of_mset r' + (polynomial_of_mset p' + polynomial_of_mset q')\<close>
+  apply (induction rule: add_poly_p_induct)
+  subgoal
+    by auto
+  subgoal
+    by auto
+  subgoal
+    by (auto simp: algebra_simps Const_add)
+  subgoal
+    by (auto simp: algebra_simps Const_add)
+  subgoal
+    by (auto simp: algebra_simps Const_add)
+  done
+
+lemma rtranclp_add_poly_p_polynomial_of_mset:
+  \<open>add_poly_p\<^sup>*\<^sup>* (p, q, r) (p', q', r') \<Longrightarrow>
+    polynomial_of_mset r + (polynomial_of_mset p + polynomial_of_mset q) =
+    polynomial_of_mset r' + (polynomial_of_mset p' + polynomial_of_mset q')\<close>
+  by (induction rule: rtranclp_induct[of add_poly_p \<open>(_, _, _)\<close> \<open>(_, _, _)\<close>, split_format(complete), of for r])
+    (auto dest: add_poly_p_polynomial_of_mset)
+
+
+lemma rtranclp_add_poly_p_polynomial_of_mset_full:
+  \<open>add_poly_p\<^sup>*\<^sup>* (p, q, {#}) ({#}, {#}, r') \<Longrightarrow>
+    polynomial_of_mset r' = (polynomial_of_mset p + polynomial_of_mset q)\<close>
+  by (drule rtranclp_add_poly_p_polynomial_of_mset)
+    (auto simp: ac_simps add_eq_0_iff)
+
+lemma poly_of_vars_remdups_mset:
+  \<open>poly_of_vars (remdups_mset (xs)) - (poly_of_vars xs)
+    \<in> More_Modules.ideal polynomial_bool\<close>
+  apply (induction xs)
+  subgoal by (auto simp: ideal.span_zero)
+  subgoal for x xs
+    apply (cases \<open>x \<in># xs\<close>)
+     apply (metis (no_types, lifting) X2_X_polynomial_bool_mult_in diff_add_cancel diff_diff_eq2
+        ideal.span_diff insert_DiffM poly_of_vars_simps(1) remdups_mset_singleton_sum)
+    by (metis (no_types, lifting) ideal.span_scale poly_of_vars_simps(1) remdups_mset_singleton_sum
+        right_diff_distrib)
+  done
+
+lemma polynomial_of_mset_mult_map:
+  \<open>polynomial_of_mset
+     {#case x of (ys, n) \<Rightarrow> (remdups_mset (ys + xs), n * m). x \<in># q#} -
+    Const m * (poly_of_vars xs * polynomial_of_mset q)
+    \<in> More_Modules.ideal polynomial_bool\<close>
+  (is \<open>?P q \<in> _\<close>)
+proof (induction q)
+  case empty
+  then show ?case by (auto simp: algebra_simps ideal.span_zero)
+next
+  case (add x q)
+  then have uP:  \<open>-?P q \<in> More_Modules.ideal polynomial_bool\<close>
+    using ideal.span_neg by blast
+  have \<open> Const b * (Const m * poly_of_vars (remdups_mset (a + xs))) -
+           Const b * (Const m * (poly_of_vars a * poly_of_vars xs))
+           \<in> More_Modules.ideal polynomial_bool\<close> for a b
+    by (auto simp: Const_mult simp flip: right_diff_distrib' poly_of_vars_simps
+        intro!: ideal.span_scale poly_of_vars_remdups_mset)
+  then show ?case
+    apply (subst ideal.span_add_eq2[symmetric, OF uP])
+    apply (cases x)
+    apply (auto simp: field_simps Const_mult  simp flip:
+        intro!: ideal.span_scale poly_of_vars_remdups_mset)
+    done
+qed
+
+lemma mult_poly_p_mult_ideal:
+  \<open>mult_poly_p q (p, r) (p', r') \<Longrightarrow>
+     (polynomial_of_mset p' * polynomial_of_mset q + polynomial_of_mset r') - (polynomial_of_mset p * polynomial_of_mset q + polynomial_of_mset r)
+       \<in> ideal polynomial_bool\<close>
+proof (induction rule: mult_poly_p_induct)
+  case (mult_step xs n p r)
+  show ?case
+    by (auto simp: algebra_simps polynomial_of_mset_mult_map)
+qed
+
+lemma rtranclp_mult_poly_p_mult_ideal:
+  \<open>(mult_poly_p q)\<^sup>*\<^sup>* (p, r) (p', r') \<Longrightarrow>
+     (polynomial_of_mset p' * polynomial_of_mset q + polynomial_of_mset r') - (polynomial_of_mset p * polynomial_of_mset q + polynomial_of_mset r)
+       \<in> ideal polynomial_bool\<close>
+  apply (induction p' r' rule: rtranclp_induct[of \<open>mult_poly_p q\<close> \<open>(p, r)\<close> \<open>(p', q')\<close> for p' q', split_format(complete)])
+  subgoal
+    by (auto simp: ideal.span_zero)
+  subgoal for a b aa ba
+    apply (drule mult_poly_p_mult_ideal)
+    apply (drule ideal.span_add)
+    apply assumption
+    by (auto simp: group_add_class.diff_add_eq_diff_diff_swap
+        add.inverse_distrib_swap ac_simps add_diff_eq
+      simp flip:  diff_add_eq_diff_diff_swap)
+  done
+
+lemma rtranclp_mult_poly_p_mult_ideal_final:
+  \<open>(mult_poly_p q)\<^sup>*\<^sup>* (p, {#}) ({#}, r) \<Longrightarrow>
+    (polynomial_of_mset r) - (polynomial_of_mset p * polynomial_of_mset q)
+       \<in> ideal polynomial_bool\<close>
+  by (drule rtranclp_mult_poly_p_mult_ideal) auto
+
+lemma normalize_poly_p_poly_of_mset:
+  \<open>normalize_poly_p p q \<Longrightarrow> polynomial_of_mset p = polynomial_of_mset q\<close>
+  apply (induction rule: normalize_poly_p.induct)
+  apply (auto simp: Const_add algebra_simps)
+  done
+
+
+lemma rtranclp_normalize_poly_p_poly_of_mset:
+  \<open>normalize_poly_p\<^sup>*\<^sup>* p q \<Longrightarrow> polynomial_of_mset p = polynomial_of_mset q\<close>
+  by (induction rule: rtranclp_induct)
+    (auto simp: normalize_poly_p_poly_of_mset)
+
+end
+
+
+text \<open>It would be nice to have the property in the other direction too, but this requires a deep
+dive into the definitions of polynomials.\<close>
+locale poly_embed_bij = poly_embed +
+  fixes V N
+  assumes \<phi>_bij: \<open>bij_betw \<phi> V N\<close>
+begin
+
+definition \<phi>' :: \<open>nat \<Rightarrow> string\<close> where
+  \<open>\<phi>' = the_inv_into V \<phi>\<close>
+
+lemma \<phi>'_\<phi>[simp]:
+  \<open>x \<in> V \<Longrightarrow> \<phi>' (\<phi> x) = x\<close>
+  using \<phi>_bij unfolding \<phi>'_def
+  by (meson bij_betw_imp_inj_on the_inv_into_f_f)
+
+lemma \<phi>_\<phi>'[simp]:
+  \<open>x \<in> N \<Longrightarrow> \<phi> (\<phi>' x) = x\<close>
+  using \<phi>_bij unfolding \<phi>'_def
+  by (meson f_the_inv_into_f_bij_betw)
+
+end
+
+end
+
diff --git a/thys/PAC_Checker/PAC_Polynomials_Operations.thy b/thys/PAC_Checker/PAC_Polynomials_Operations.thy
new file mode 100644
--- /dev/null
+++ b/thys/PAC_Checker/PAC_Polynomials_Operations.thy
@@ -0,0 +1,1261 @@
+theory PAC_Polynomials_Operations
+  imports PAC_Polynomials_Term PAC_Checker_Specification
+begin
+
+subsection \<open>Addition\<close>
+
+text \<open>In this section, we refine the polynomials to list. These lists will be used in our checker
+to represent the polynomials and execute operations.
+
+There is one \<^emph>\<open>key\<close> difference between the list representation and the usual representation: in the
+former, coefficients can be zero and monomials can appear several times. This makes it easier to
+reason on intermediate representation where this has not yet been sanitized.
+\<close>
+
+fun add_poly_l' :: \<open>llist_polynomial \<times> llist_polynomial \<Rightarrow> llist_polynomial\<close> where
+  \<open>add_poly_l' (p, []) = p\<close> |
+  \<open>add_poly_l' ([], q) = q\<close> |
+  \<open>add_poly_l' ((xs, n) # p, (ys, m) # q) =
+            (if xs = ys then if n + m = 0 then add_poly_l' (p, q) else
+                 let pq = add_poly_l' (p, q) in
+                 ((xs, n + m) # pq)
+            else if (xs, ys) \<in> term_order_rel
+              then
+                 let pq = add_poly_l' (p, (ys, m) # q) in
+                 ((xs, n) # pq)
+            else
+                 let pq = add_poly_l' ((xs, n) # p, q) in
+                 ((ys, m) # pq)
+            )\<close>
+
+definition add_poly_l :: \<open>llist_polynomial \<times> llist_polynomial \<Rightarrow> llist_polynomial nres\<close> where
+  \<open>add_poly_l = REC\<^sub>T
+      (\<lambda>add_poly_l (p, q).
+        case (p,q) of
+          (p, []) \<Rightarrow> RETURN p
+        | ([], q) \<Rightarrow> RETURN q
+        | ((xs, n) # p, (ys, m) # q) \<Rightarrow>
+            (if xs = ys then if n + m = 0 then add_poly_l (p, q) else
+               do {
+                 pq \<leftarrow> add_poly_l (p, q);
+                 RETURN ((xs, n + m) # pq)
+             }
+            else if (xs, ys) \<in> term_order_rel
+              then do {
+                 pq \<leftarrow> add_poly_l (p, (ys, m) # q);
+                 RETURN ((xs, n) # pq)
+            }
+            else do {
+                 pq \<leftarrow> add_poly_l ((xs, n) # p, q);
+                 RETURN ((ys, m) # pq)
+            }))\<close>
+
+definition nonzero_coeffs where
+  \<open>nonzero_coeffs a \<longleftrightarrow> 0 \<notin># snd `# a\<close>
+
+lemma nonzero_coeffs_simps[simp]:
+  \<open>nonzero_coeffs {#}\<close>
+  \<open>nonzero_coeffs (add_mset (xs, n) a) \<longleftrightarrow> nonzero_coeffs a \<and> n \<noteq> 0\<close>
+  by (auto simp: nonzero_coeffs_def)
+
+lemma nonzero_coeffsD:
+  \<open>nonzero_coeffs a \<Longrightarrow> (x, n) \<in># a \<Longrightarrow> n \<noteq> 0\<close>
+  by (auto simp: nonzero_coeffs_def)
+
+lemma sorted_poly_list_rel_ConsD:
+  \<open>((ys, n) # p, a) \<in> sorted_poly_list_rel S \<Longrightarrow> (p, remove1_mset (mset ys, n) a) \<in> sorted_poly_list_rel S \<and>
+    (mset ys, n) \<in># a \<and> (\<forall>x \<in> set p. S ys (fst x)) \<and> sorted_wrt (rel2p var_order_rel) ys \<and>
+    distinct ys \<and> ys \<notin> set (map fst p) \<and> n \<noteq> 0 \<and> nonzero_coeffs a\<close>
+  unfolding sorted_poly_list_rel_wrt_def prod.case mem_Collect_eq
+    list_rel_def
+  apply (clarsimp)
+  apply (subst (asm) list.rel_sel)
+  apply (intro conjI)
+  apply (rename_tac y, rule_tac b = \<open>tl y\<close> in relcompI)
+  apply (auto simp: sorted_poly_list_rel_wrt_def list_mset_rel_def br_def
+    list.tl_def term_poly_list_rel_def nonzero_coeffs_def split: list.splits)
+  done
+
+lemma sorted_poly_list_rel_Cons_iff:
+  \<open>((ys, n) # p, a) \<in> sorted_poly_list_rel S \<longleftrightarrow> (p, remove1_mset (mset ys, n) a) \<in> sorted_poly_list_rel S \<and>
+    (mset ys, n) \<in># a \<and> (\<forall>x \<in> set p. S ys (fst x)) \<and> sorted_wrt (rel2p var_order_rel) ys \<and>
+    distinct ys \<and> ys \<notin> set (map fst p) \<and> n \<noteq> 0 \<and> nonzero_coeffs a\<close>
+  apply (rule iffI)
+  subgoal
+    by (auto dest!: sorted_poly_list_rel_ConsD)
+  subgoal
+    unfolding sorted_poly_list_rel_wrt_def prod.case mem_Collect_eq
+      list_rel_def
+    apply (clarsimp)
+    apply (intro conjI)
+    apply (rename_tac y; rule_tac b = \<open>(mset ys, n) # y\<close> in relcompI)
+    by (auto simp: sorted_poly_list_rel_wrt_def list_mset_rel_def br_def
+        term_poly_list_rel_def add_mset_eq_add_mset eq_commute[of _ \<open>mset _\<close>]
+        nonzero_coeffs_def
+      dest!: multi_member_split)
+    done
+
+
+
+lemma sorted_repeat_poly_list_rel_ConsD:
+  \<open>((ys, n) # p, a) \<in> sorted_repeat_poly_list_rel S \<Longrightarrow> (p, remove1_mset (mset ys, n) a) \<in> sorted_repeat_poly_list_rel S \<and>
+    (mset ys, n) \<in># a \<and> (\<forall>x \<in> set p. S ys (fst x)) \<and> sorted_wrt (rel2p var_order_rel) ys \<and>
+    distinct ys \<and> n \<noteq> 0 \<and> nonzero_coeffs a\<close>
+  unfolding sorted_repeat_poly_list_rel_wrt_def prod.case mem_Collect_eq
+    list_rel_def
+  apply (clarsimp)
+  apply (subst (asm) list.rel_sel)
+  apply (intro conjI)
+  apply (rename_tac y, rule_tac b = \<open>tl y\<close> in relcompI)
+  apply (auto simp: sorted_poly_list_rel_wrt_def list_mset_rel_def br_def
+    list.tl_def term_poly_list_rel_def nonzero_coeffs_def split: list.splits)
+  done
+
+lemma sorted_repeat_poly_list_rel_Cons_iff:
+  \<open>((ys, n) # p, a) \<in> sorted_repeat_poly_list_rel S \<longleftrightarrow> (p, remove1_mset (mset ys, n) a) \<in> sorted_repeat_poly_list_rel S \<and>
+    (mset ys, n) \<in># a \<and> (\<forall>x \<in> set p. S ys (fst x)) \<and> sorted_wrt (rel2p var_order_rel) ys \<and>
+    distinct ys \<and> n \<noteq> 0 \<and> nonzero_coeffs a\<close>
+  apply (rule iffI)
+  subgoal
+    by (auto dest!: sorted_repeat_poly_list_rel_ConsD)
+  subgoal
+    unfolding sorted_repeat_poly_list_rel_wrt_def prod.case mem_Collect_eq
+      list_rel_def
+    apply (clarsimp)
+    apply (intro conjI)
+    apply (rename_tac y, rule_tac b = \<open>(mset ys, n) # y\<close> in relcompI)
+    by (auto simp: sorted_repeat_poly_list_rel_wrt_def list_mset_rel_def br_def
+        term_poly_list_rel_def add_mset_eq_add_mset eq_commute[of _ \<open>mset _\<close>]
+        nonzero_coeffs_def
+      dest!: multi_member_split)
+    done
+
+
+lemma add_poly_p_add_mset_sum_0:
+   \<open>n + m = 0 \<Longrightarrow>add_poly_p\<^sup>*\<^sup>* (A, Aa, {#}) ({#}, {#}, r) \<Longrightarrow>
+           add_poly_p\<^sup>*\<^sup>*
+            (add_mset (mset ys, n) A, add_mset (mset ys, m) Aa, {#})
+            ({#}, {#}, r)\<close>
+  apply (rule converse_rtranclp_into_rtranclp)
+  apply (rule add_poly_p.add_new_coeff_r)
+  apply (rule converse_rtranclp_into_rtranclp)
+  apply (rule add_poly_p.add_same_coeff_l)
+  apply (rule converse_rtranclp_into_rtranclp)
+  apply (auto intro: add_poly_p.rem_0_coeff)
+  done
+
+lemma monoms_add_poly_l'D:
+  \<open>(aa, ba) \<in> set (add_poly_l' x) \<Longrightarrow> aa \<in> fst ` set (fst x) \<or> aa \<in> fst ` set (snd x)\<close>
+  by (induction x rule: add_poly_l'.induct)
+    (auto split: if_splits)
+
+lemma add_poly_p_add_to_result:
+  \<open>add_poly_p\<^sup>*\<^sup>* (A, B, r) (A', B', r') \<Longrightarrow>
+       add_poly_p\<^sup>*\<^sup>*
+        (A, B, p + r) (A', B', p + r')\<close>
+  apply (induction rule: rtranclp_induct[of add_poly_p \<open>(_, _, _)\<close> \<open>(_, _, _)\<close>, split_format(complete), of for r])
+  subgoal by auto
+  by (elim add_poly_pE)
+   (metis (no_types, lifting) Pair_inject add_poly_p.intros rtranclp.simps union_mset_add_mset_right)+
+
+lemma add_poly_p_add_mset_comb:
+  \<open>add_poly_p\<^sup>*\<^sup>* (A, Aa, {#}) ({#}, {#}, r) \<Longrightarrow>
+       add_poly_p\<^sup>*\<^sup>*
+        (add_mset (xs, n) A, Aa, {#})
+        ({#}, {#}, add_mset (xs, n) r)\<close>
+  apply (rule converse_rtranclp_into_rtranclp)
+  apply (rule add_poly_p.add_new_coeff_l)
+  using add_poly_p_add_to_result[of A Aa \<open>{#}\<close> \<open>{#}\<close> \<open>{#}\<close> r \<open>{#(xs, n)#}\<close>]
+  by auto
+
+lemma add_poly_p_add_mset_comb2:
+  \<open>add_poly_p\<^sup>*\<^sup>* (A, Aa, {#}) ({#}, {#}, r) \<Longrightarrow>
+       add_poly_p\<^sup>*\<^sup>*
+        (add_mset (ys, n) A, add_mset (ys, m) Aa, {#})
+        ({#}, {#}, add_mset (ys, n + m) r)\<close>
+  apply (rule converse_rtranclp_into_rtranclp)
+  apply (rule add_poly_p.add_new_coeff_r)
+  apply (rule converse_rtranclp_into_rtranclp)
+  apply (rule add_poly_p.add_same_coeff_l)
+  using add_poly_p_add_to_result[of A Aa \<open>{#}\<close> \<open>{#}\<close> \<open>{#}\<close> r \<open>{#(ys, n+m)#}\<close>]
+  by auto
+
+
+lemma add_poly_p_add_mset_comb3:
+  \<open>add_poly_p\<^sup>*\<^sup>* (A, Aa, {#}) ({#}, {#}, r) \<Longrightarrow>
+       add_poly_p\<^sup>*\<^sup>*
+        (A, add_mset (ys, m) Aa, {#})
+        ({#}, {#}, add_mset (ys, m) r)\<close>
+  apply (rule converse_rtranclp_into_rtranclp)
+  apply (rule add_poly_p.add_new_coeff_r)
+  using add_poly_p_add_to_result[of A Aa \<open>{#}\<close> \<open>{#}\<close> \<open>{#}\<close> r \<open>{#(ys, m)#}\<close>]
+  by auto
+
+lemma total_on_lexord:
+  \<open>Relation.total_on UNIV R \<Longrightarrow> Relation.total_on UNIV (lexord R)\<close>
+  apply (auto simp: Relation.total_on_def)
+  by (meson lexord_linear)
+
+lemma antisym_lexord:
+  \<open>antisym R \<Longrightarrow> irrefl R \<Longrightarrow> antisym (lexord R)\<close>
+  by (auto simp: antisym_def lexord_def irrefl_def
+    elim!: list_match_lel_lel)
+
+lemma less_than_char_linear:
+  \<open>(a, b) \<in> less_than_char \<or>
+           a = b \<or> (b, a) \<in> less_than_char\<close>
+  by (auto simp: less_than_char_def)
+
+lemma total_on_lexord_less_than_char_linear:
+  \<open>xs \<noteq> ys \<Longrightarrow> (xs, ys) \<notin> lexord (lexord less_than_char) \<longleftrightarrow>
+       (ys, xs) \<in> lexord (lexord less_than_char)\<close>
+   using lexord_linear[of \<open>lexord less_than_char\<close> xs ys]
+   using lexord_linear[of \<open>less_than_char\<close>] less_than_char_linear
+   using lexord_irrefl[OF irrefl_less_than_char]
+     antisym_lexord[OF antisym_lexord[OF antisym_less_than_char irrefl_less_than_char]]
+   apply (auto simp: antisym_def Relation.total_on_def)
+   done
+
+lemma sorted_poly_list_rel_nonzeroD:
+  \<open>(p, r) \<in> sorted_poly_list_rel term_order \<Longrightarrow>
+       nonzero_coeffs (r)\<close>
+  \<open>(p, r) \<in> sorted_poly_list_rel (rel2p (lexord (lexord less_than_char))) \<Longrightarrow>
+       nonzero_coeffs (r)\<close>
+  by (auto simp: sorted_poly_list_rel_wrt_def nonzero_coeffs_def)
+
+
+lemma add_poly_l'_add_poly_p:
+  assumes \<open>(pq, pq') \<in> sorted_poly_rel \<times>\<^sub>r sorted_poly_rel\<close>
+  shows \<open>\<exists>r. (add_poly_l' pq, r) \<in> sorted_poly_rel \<and>
+                        add_poly_p\<^sup>*\<^sup>* (fst pq', snd pq', {#}) ({#}, {#}, r)\<close>
+  supply [[goals_limit=1]]
+  using assms
+  apply (induction \<open>pq\<close> arbitrary: pq' rule: add_poly_l'.induct)
+  subgoal for p pq'
+    using add_poly_p_empty_l[of \<open>fst pq'\<close> \<open>{#}\<close> \<open>{#}\<close>]
+    by (cases pq') (auto intro!: exI[of _ \<open>fst pq'\<close>])
+  subgoal for x p pq'
+    using add_poly_p_empty_r[of  \<open>{#}\<close> \<open>snd pq'\<close> \<open>{#}\<close>]
+    by (cases pq')  (auto intro!: exI[of _ \<open>snd pq'\<close>])
+  subgoal premises p for xs n p ys m q pq'
+    apply (cases pq') \<comment> \<open>Isabelle does a completely stupid case distinction here\<close>
+    apply (cases \<open>xs = ys\<close>)
+    subgoal
+      apply (cases \<open>n + m = 0\<close>)
+      subgoal
+        using p(1)[of \<open>(remove1_mset (mset xs, n) (fst pq'), remove1_mset (mset ys, m)  (snd pq'))\<close>] p(5-)
+        apply (auto dest!: sorted_poly_list_rel_ConsD multi_member_split
+           )
+      using add_poly_p_add_mset_sum_0 by blast
+    subgoal
+        using p(2)[of \<open>(remove1_mset (mset xs, n) (fst pq'), remove1_mset (mset ys, m)  (snd pq'))\<close>] p(5-)
+        apply (auto dest!: sorted_poly_list_rel_ConsD multi_member_split)
+        apply (rule_tac x = \<open>add_mset (mset ys, n + m) r\<close> in exI)
+        apply (fastforce dest!: monoms_add_poly_l'D simp: sorted_poly_list_rel_Cons_iff rel2p_def
+           sorted_poly_list_rel_nonzeroD var_order_rel_def
+          intro: add_poly_p_add_mset_comb2)
+        done
+     done
+    subgoal
+      apply (cases \<open>(xs, ys) \<in> term_order_rel\<close>)
+      subgoal
+        using p(3)[of \<open>(remove1_mset (mset xs, n) (fst pq'), (snd pq'))\<close>] p(5-)
+        apply (auto dest!: multi_member_split simp: sorted_poly_list_rel_Cons_iff rel2p_def)
+        apply (rule_tac x = \<open>add_mset (mset xs, n) r\<close> in exI)
+        apply (auto dest!: monoms_add_poly_l'D)
+        apply (auto intro: lexord_trans add_poly_p_add_mset_comb simp: lexord_transI var_order_rel_def)
+        apply (rule lexord_trans)
+        apply assumption
+        apply (auto intro: lexord_trans add_poly_p_add_mset_comb simp: lexord_transI
+          sorted_poly_list_rel_nonzeroD var_order_rel_def)
+        using total_on_lexord_less_than_char_linear by fastforce
+
+      subgoal
+        using p(4)[of \<open>(fst pq', remove1_mset (mset ys, m) (snd pq'))\<close>] p(5-)
+        apply (auto dest!: multi_member_split simp: sorted_poly_list_rel_Cons_iff rel2p_def
+           var_order_rel_def)
+        apply (rule_tac x = \<open>add_mset (mset ys, m) r\<close> in exI)
+        apply (auto dest!: monoms_add_poly_l'D
+          simp: total_on_lexord_less_than_char_linear)
+        apply (auto intro: lexord_trans add_poly_p_add_mset_comb  simp: lexord_transI
+          total_on_lexord_less_than_char_linear var_order_rel_def)
+        apply (rule lexord_trans)
+        apply assumption
+        apply (auto intro: lexord_trans add_poly_p_add_mset_comb3 simp: lexord_transI
+          sorted_poly_list_rel_nonzeroD var_order_rel_def)
+        using total_on_lexord_less_than_char_linear by fastforce
+      done
+   done
+  done
+
+
+lemma add_poly_l_add_poly:
+  \<open>add_poly_l x = RETURN (add_poly_l' x)\<close>
+  unfolding add_poly_l_def
+  by (induction x rule: add_poly_l'.induct)
+    (solves \<open>subst RECT_unfold, refine_mono, simp split: list.split\<close>)+
+
+lemma add_poly_l_spec:
+  \<open>(add_poly_l, uncurry (\<lambda>p q. SPEC(\<lambda>r. add_poly_p\<^sup>*\<^sup>* (p, q, {#}) ({#}, {#}, r)))) \<in>
+    sorted_poly_rel \<times>\<^sub>r sorted_poly_rel \<rightarrow>\<^sub>f \<langle>sorted_poly_rel\<rangle>nres_rel\<close>
+  unfolding add_poly_l_add_poly
+  apply (intro nres_relI frefI)
+  apply (drule add_poly_l'_add_poly_p)
+  apply (auto simp: conc_fun_RES)
+  done
+
+definition sort_poly_spec :: \<open>llist_polynomial \<Rightarrow> llist_polynomial nres\<close> where
+\<open>sort_poly_spec p =
+  SPEC(\<lambda>p'. mset p = mset p' \<and> sorted_wrt (rel2p (Id \<union> term_order_rel)) (map fst p'))\<close>
+
+lemma sort_poly_spec_id:
+  assumes \<open>(p, p') \<in> unsorted_poly_rel\<close>
+  shows \<open>sort_poly_spec p \<le> \<Down> (sorted_repeat_poly_rel) (RETURN p')\<close>
+proof -
+  obtain y where
+    py: \<open>(p, y) \<in> \<langle>term_poly_list_rel \<times>\<^sub>r int_rel\<rangle>list_rel\<close> and
+    p'_y: \<open>p' = mset y\<close> and
+    zero: \<open>0 \<notin># snd `# p'\<close>
+    using assms
+    unfolding sort_poly_spec_def poly_list_rel_def sorted_poly_list_rel_wrt_def
+    by (auto simp: list_mset_rel_def br_def)
+  then have [simp]: \<open>length y = length p\<close>
+    by (auto simp: list_rel_def list_all2_conv_all_nth)
+  have H: \<open>(x, p')
+        \<in> \<langle>term_poly_list_rel \<times>\<^sub>r int_rel\<rangle>list_rel O list_mset_rel\<close>
+     if px: \<open>mset p = mset x\<close> and \<open>sorted_wrt (rel2p (Id \<union> lexord var_order_rel)) (map fst x)\<close>
+     for x :: \<open>llist_polynomial\<close>
+  proof -
+    obtain f where
+      f: \<open>bij_betw f {..<length x} {..<length p}\<close> and
+      [simp]: \<open>\<And>i. i<length x \<Longrightarrow> x ! i = p ! (f i)\<close>
+      using px apply - apply (subst (asm)(2) eq_commute)  unfolding mset_eq_perm
+      by (auto dest!: permutation_Ex_bij)
+    let ?y = \<open>map (\<lambda>i. y ! f i) [0 ..< length x]\<close>
+    have \<open>i < length y \<Longrightarrow> (p ! f i, y ! f i) \<in> term_poly_list_rel \<times>\<^sub>r int_rel\<close> for i
+      using list_all2_nthD[of _ p y
+         \<open>f i\<close>, OF py[unfolded list_rel_def mem_Collect_eq prod.case]]
+         mset_eq_length[OF px] f
+      by (auto simp: list_rel_def list_all2_conv_all_nth bij_betw_def)
+    then have \<open>(x, ?y) \<in> \<langle>term_poly_list_rel \<times>\<^sub>r int_rel\<rangle>list_rel\<close> and
+      xy: \<open>length x = length y\<close>
+      using py list_all2_nthD[of \<open>rel2p (term_poly_list_rel \<times>\<^sub>r int_rel)\<close> p y
+         \<open>f i\<close> for i, simplified] mset_eq_length[OF px]
+      by (auto simp: list_rel_def list_all2_conv_all_nth)
+    moreover {
+      have f: \<open>mset_set {0..<length x} = f `# mset_set {0..<length x}\<close>
+        using f mset_eq_length[OF px]
+        by (auto simp: bij_betw_def lessThan_atLeast0 image_mset_mset_set)
+      have \<open>mset y = {#y ! f x. x \<in># mset_set {0..<length x}#}\<close>
+        by (subst drop_0[symmetric], subst mset_drop_upto, subst xy[symmetric], subst f)
+          auto
+      then have \<open>(?y, p') \<in> list_mset_rel\<close>
+        by (auto simp: list_mset_rel_def br_def p'_y)
+    }
+    ultimately show ?thesis
+      by (auto intro!: relcompI[of _ ?y])
+  qed
+  show ?thesis
+    using zero
+    unfolding sort_poly_spec_def poly_list_rel_def sorted_repeat_poly_list_rel_wrt_def
+    by refine_rcg (auto intro: H)
+qed
+
+
+subsection \<open>Multiplication\<close>
+
+fun mult_monoms :: \<open>term_poly_list \<Rightarrow> term_poly_list \<Rightarrow> term_poly_list\<close> where
+  \<open>mult_monoms p [] = p\<close> |
+  \<open>mult_monoms [] p = p\<close> |
+  \<open>mult_monoms (x # p) (y # q) =
+    (if x = y then x # mult_monoms p q
+     else if (x, y) \<in> var_order_rel then x # mult_monoms p (y # q)
+      else y # mult_monoms (x # p) q)\<close>
+
+lemma term_poly_list_rel_empty_iff[simp]:
+  \<open>([], q') \<in> term_poly_list_rel \<longleftrightarrow> q' = {#}\<close>
+  by (auto simp: term_poly_list_rel_def)
+
+lemma mset_eqD_set_mset: \<open>mset xs = A \<Longrightarrow> set xs = set_mset A\<close>
+  by auto
+
+lemma term_poly_list_rel_Cons_iff:
+  \<open>(y # p, p') \<in> term_poly_list_rel \<longleftrightarrow>
+    (p, remove1_mset y p') \<in> term_poly_list_rel \<and>
+    y \<in># p' \<and> y \<notin> set p \<and> y \<notin># remove1_mset y p' \<and>
+  (\<forall>x\<in>#mset p. (y, x) \<in> var_order_rel)\<close>
+  by (auto simp: term_poly_list_rel_def rel2p_def dest!: multi_member_split mset_eqD_set_mset)
+
+lemma var_order_rel_antisym[simp]:
+  \<open>(y, y) \<notin> var_order_rel\<close>
+  by (simp add: less_than_char_def lexord_irreflexive var_order_rel_def)
+
+lemma term_poly_list_rel_remdups_mset:
+  \<open>(p, p') \<in> term_poly_list_rel \<Longrightarrow>
+    (p, remdups_mset p') \<in> term_poly_list_rel\<close>
+  by (auto simp: term_poly_list_rel_def distinct_mset_remdups_mset_id simp flip: distinct_mset_mset_distinct)
+
+lemma var_notin_notin_mult_monomsD:
+  \<open>y \<in> set (mult_monoms p q) \<Longrightarrow> y \<in> set p \<or> y \<in> set q\<close>
+  by (induction p q arbitrary: p' q' rule: mult_monoms.induct) (auto split: if_splits)
+
+lemma term_poly_list_rel_set_mset:
+  \<open>(p, q) \<in> term_poly_list_rel \<Longrightarrow> set p = set_mset q\<close>
+  by (auto simp: term_poly_list_rel_def)
+
+
+lemma mult_monoms_spec:
+  \<open>(mult_monoms, (\<lambda>a b. remdups_mset (a + b))) \<in> term_poly_list_rel \<rightarrow> term_poly_list_rel \<rightarrow> term_poly_list_rel\<close>
+proof -
+  have [dest]: \<open>remdups_mset (A + Aa) = add_mset y Ab \<Longrightarrow> y \<notin># A \<Longrightarrow>
+       y \<notin># Aa \<Longrightarrow>
+       False\<close> for Aa Ab y A
+    by (metis set_mset_remdups_mset union_iff union_single_eq_member)
+  show ?thesis
+  apply (intro fun_relI)
+  apply (rename_tac p p' q q')
+  subgoal for p p' q q'
+    apply (induction p q arbitrary: p' q' rule: mult_monoms.induct)
+    subgoal by (auto simp: term_poly_list_rel_Cons_iff rel2p_def term_poly_list_rel_remdups_mset)
+    subgoal for x p p' q'
+      by (auto simp: term_poly_list_rel_Cons_iff rel2p_def term_poly_list_rel_remdups_mset
+      dest!: multi_member_split[of _ q'])
+    subgoal premises p for x p y q p' q'
+      apply (cases \<open>x = y\<close>)
+      subgoal
+        using p(1)[of \<open>remove1_mset y p'\<close> \<open>remove1_mset y q'\<close>] p(4-)
+        by (auto simp: term_poly_list_rel_Cons_iff rel2p_def
+          dest!: var_notin_notin_mult_monomsD
+          dest!: multi_member_split)
+     apply (cases \<open>(x, y) \<in> var_order_rel\<close>)
+     subgoal
+        using p(2)[of \<open>remove1_mset x p'\<close> \<open>q'\<close>] p(4-)
+        apply (auto simp: term_poly_list_rel_Cons_iff
+            term_poly_list_rel_set_mset rel2p_def var_order_rel_def
+          dest!: multi_member_split[of _ p'] multi_member_split[of _ q']
+            var_notin_notin_mult_monomsD
+          split: if_splits)
+       apply (meson lexord_cons_cons list.inject total_on_lexord_less_than_char_linear)
+       apply (meson lexord_cons_cons list.inject total_on_lexord_less_than_char_linear)
+       apply (meson lexord_cons_cons list.inject total_on_lexord_less_than_char_linear)
+       using lexord_trans trans_less_than_char var_order_rel_antisym
+       unfolding var_order_rel_def apply blast+
+       done
+     subgoal
+        using p(3)[of \<open>p'\<close> \<open>remove1_mset y q'\<close>] p(4-)
+        apply (auto simp: term_poly_list_rel_Cons_iff rel2p_def
+            term_poly_list_rel_set_mset rel2p_def var_order_rel_antisym
+          dest!: multi_member_split[of _ p'] multi_member_split[of _ q']
+            var_notin_notin_mult_monomsD
+          split: if_splits)
+       using lexord_trans trans_less_than_char var_order_rel_antisym
+       unfolding var_order_rel_def apply blast
+       apply (meson lexord_cons_cons list.inject total_on_lexord_less_than_char_linear)
+       by (meson less_than_char_linear lexord_linear lexord_trans trans_less_than_char)
+       done
+    done
+  done
+qed
+
+definition mult_monomials :: \<open>term_poly_list \<times> int \<Rightarrow> term_poly_list \<times> int \<Rightarrow> term_poly_list \<times> int\<close> where
+  \<open>mult_monomials = (\<lambda>(x, a) (y, b). (mult_monoms x y, a * b))\<close>
+
+definition mult_poly_raw :: \<open>llist_polynomial \<Rightarrow> llist_polynomial \<Rightarrow> llist_polynomial\<close> where
+  \<open>mult_poly_raw p q = foldl (\<lambda>b x. map (mult_monomials x) q @ b) [] p\<close>
+
+
+fun map_append where
+  \<open>map_append f b [] = b\<close> |
+  \<open>map_append f b (x # xs) = f x # map_append f b xs\<close>
+
+lemma map_append_alt_def:
+  \<open>map_append f b xs = map f xs @ b\<close>
+  by (induction f b xs rule: map_append.induct)
+   auto
+
+lemma foldl_append_empty:
+  \<open>NO_MATCH [] xs \<Longrightarrow> foldl (\<lambda>b x. f x @ b) xs p = foldl (\<lambda>b x. f x @ b) [] p @ xs\<close>
+  apply (induction p arbitrary: xs)
+   apply simp
+  by (metis (mono_tags, lifting) NO_MATCH_def append.assoc append_self_conv foldl_Cons)
+
+
+lemma poly_list_rel_empty_iff[simp]:
+  \<open>([], r) \<in> poly_list_rel R \<longleftrightarrow> r = {#}\<close>
+  by (auto simp: poly_list_rel_def list_mset_rel_def br_def)
+
+lemma mult_poly_raw_simp[simp]:
+  \<open>mult_poly_raw [] q = []\<close>
+  \<open>mult_poly_raw (x # p) q = mult_poly_raw p q @ map (mult_monomials x) q\<close>
+  subgoal by (auto simp: mult_poly_raw_def)
+  subgoal by (induction p) (auto simp: mult_poly_raw_def foldl_append_empty)
+  done
+
+lemma sorted_poly_list_relD:
+  \<open>(q, q') \<in> sorted_poly_list_rel R \<Longrightarrow> q' = (\<lambda>(a, b). (mset a, b)) `# mset q\<close>
+  apply (induction q arbitrary: q')
+  apply (auto simp: sorted_poly_list_rel_wrt_def list_mset_rel_def br_def
+    list_rel_split_right_iff)
+  apply (subst (asm)(2) term_poly_list_rel_def)
+  apply (simp add: relcomp.relcompI)
+  done
+
+lemma list_all2_in_set_ExD:
+  \<open>list_all2 R p q \<Longrightarrow> x \<in> set p \<Longrightarrow> \<exists>y \<in> set q. R x y\<close>
+  by (induction p q rule: list_all2_induct)
+    auto
+
+inductive_cases mult_poly_p_elim: \<open>mult_poly_p q (A, r) (B, r')\<close>
+
+lemma mult_poly_p_add_mset_same:
+  \<open>(mult_poly_p q')\<^sup>*\<^sup>* (A, r) (B, r') \<Longrightarrow> (mult_poly_p q')\<^sup>*\<^sup>* (add_mset x A, r) (add_mset x B, r')\<close>
+  apply (induction rule: rtranclp_induct[of \<open>mult_poly_p q'\<close> \<open>(_, r)\<close> \<open>(p', q'')\<close> for p' q'', split_format(complete)])
+  subgoal by simp
+  apply (rule rtranclp.rtrancl_into_rtrancl)
+   apply assumption
+  by (auto elim!: mult_poly_p_elim intro: mult_poly_p.intros
+      intro: rtranclp.rtrancl_into_rtrancl simp: add_mset_commute[of x])
+
+lemma mult_poly_raw_mult_poly_p:
+  assumes \<open>(p, p') \<in> sorted_poly_rel\<close> and \<open>(q, q') \<in> sorted_poly_rel\<close>
+  shows \<open>\<exists>r. (mult_poly_raw p q, r) \<in> unsorted_poly_rel \<and> (mult_poly_p q')\<^sup>*\<^sup>* (p', {#}) ({#}, r)\<close>
+proof -
+  have H: \<open>(q, q') \<in> sorted_poly_list_rel term_order \<Longrightarrow> n < length q \<Longrightarrow>
+    distinct aa \<Longrightarrow> sorted_wrt var_order aa \<Longrightarrow>
+    (mult_monoms aa (fst (q ! n)),
+           mset (mult_monoms aa (fst (q ! n))))
+          \<in> term_poly_list_rel\<close> for aa n
+    using mult_monoms_spec[unfolded fun_rel_def, simplified] apply -
+    apply (drule bspec[of _ _ \<open>(aa, (mset aa))\<close>])
+     apply (auto simp: term_poly_list_rel_def)[]
+    unfolding prod.case sorted_poly_list_rel_wrt_def
+    apply clarsimp
+    subgoal for y
+      apply (drule bspec[of _ _ \<open>(fst (q ! n), mset (fst (q ! n)))\<close>])
+      apply (cases \<open>q ! n\<close>; cases \<open>y ! n\<close>)
+      using param_nth[of n y n q \<open>term_poly_list_rel \<times>\<^sub>r int_rel\<close>]
+      by (auto simp: list_rel_imp_same_length term_poly_list_rel_def)
+    done
+
+  have H': \<open>(q, q') \<in> sorted_poly_list_rel term_order \<Longrightarrow>
+    distinct aa \<Longrightarrow> sorted_wrt var_order aa \<Longrightarrow>
+     (ab, ba) \<in> set q \<Longrightarrow>
+       remdups_mset (mset aa + mset ab) = mset (mult_monoms aa ab)\<close> for aa n ab ba
+    using mult_monoms_spec[unfolded fun_rel_def, simplified] apply -
+    apply (drule bspec[of _ _ \<open>(aa, (mset aa))\<close>])
+    apply (auto simp: term_poly_list_rel_def)[]
+    unfolding prod.case sorted_poly_list_rel_wrt_def
+    apply clarsimp
+    subgoal for y
+      apply (drule bspec[of _ _ \<open>(ab, mset ab)\<close>])
+      apply (auto simp: list_rel_imp_same_length term_poly_list_rel_def list_rel_def
+        dest: list_all2_in_set_ExD)
+    done
+    done
+
+  have  H: \<open>(q, q') \<in> sorted_poly_list_rel term_order \<Longrightarrow>
+       a = (aa, b) \<Longrightarrow>
+       (pq, r) \<in> unsorted_poly_rel \<Longrightarrow>
+       p' = add_mset (mset aa, b) A \<Longrightarrow>
+       \<forall>x\<in>set p. term_order aa (fst x) \<Longrightarrow>
+       sorted_wrt var_order aa \<Longrightarrow>
+       distinct aa \<Longrightarrow> b\<noteq> 0 \<Longrightarrow>
+       (\<And>aaa. (aaa, 0) \<notin># q') \<Longrightarrow>
+       (pq @
+        map (mult_monomials (aa, b)) q,
+        {#case x of (ys, n) \<Rightarrow> (remdups_mset (mset aa + ys), n * b)
+        . x \<in># q'#} +
+        r)
+       \<in> unsorted_poly_rel\<close> for a p p' pq aa b r
+   apply (auto simp: poly_list_rel_def)
+   apply (rule_tac b = \<open>y @ map (\<lambda>(a,b). (mset a, b)) (map (mult_monomials (aa, b)) q)\<close> in relcompI)
+   apply (auto simp: list_rel_def list_all2_append list_all2_lengthD H
+     list_mset_rel_def br_def mult_monomials_def case_prod_beta intro!: list_all2_all_nthI
+     simp: sorted_poly_list_relD)
+     apply (subst sorted_poly_list_relD[of q q' term_order])
+     apply (auto simp: case_prod_beta H' intro!: image_mset_cong)
+   done
+
+  show ?thesis
+    using assms
+    apply (induction p arbitrary: p')
+    subgoal
+      by auto
+    subgoal premises p for a p p'
+      using p(1)[of \<open>remove1_mset (mset (fst a), snd a) p'\<close>] p(2-)
+      apply (cases a)
+      apply (auto simp: sorted_poly_list_rel_Cons_iff
+        dest!: multi_member_split)
+      apply (rule_tac x = \<open>(\<lambda>(ys, n). (remdups_mset (mset (fst a) + ys), n * snd a)) `# q' + r\<close> in exI)
+      apply (auto 5 3 intro: mult_poly_p.intros simp: intro!: H
+        dest: sorted_poly_list_rel_nonzeroD nonzero_coeffsD)
+      apply (rule rtranclp_trans)
+      apply (rule mult_poly_p_add_mset_same)
+      apply assumption
+      apply (rule converse_rtranclp_into_rtranclp)
+      apply (auto intro!: mult_poly_p.intros simp: ac_simps)
+      done
+    done
+qed
+
+fun merge_coeffs :: \<open>llist_polynomial \<Rightarrow> llist_polynomial\<close> where
+  \<open>merge_coeffs [] = []\<close> |
+  \<open>merge_coeffs [(xs, n)] = [(xs, n)]\<close> |
+  \<open>merge_coeffs ((xs, n) # (ys, m) # p) =
+    (if xs = ys
+    then if n + m \<noteq> 0 then merge_coeffs ((xs, n + m) # p) else merge_coeffs p
+    else (xs, n) # merge_coeffs ((ys, m) # p))\<close>
+
+abbreviation  (in -)mononoms :: \<open>llist_polynomial \<Rightarrow> term_poly_list set\<close> where
+  \<open>mononoms p \<equiv> fst `set p\<close>
+
+
+lemma fst_normalize_polynomial_subset:
+  \<open>mononoms (merge_coeffs p) \<subseteq> mononoms p\<close>
+  by (induction p rule: merge_coeffs.induct)  auto
+
+
+lemma fst_normalize_polynomial_subsetD:
+  \<open>(a, b) \<in> set (merge_coeffs p) \<Longrightarrow> a \<in> mononoms p\<close>
+  apply (induction p rule: merge_coeffs.induct)
+  subgoal
+    by auto
+  subgoal
+    by auto
+  subgoal
+    by (auto split: if_splits)
+  done
+
+lemma distinct_merge_coeffs:
+  assumes \<open>sorted_wrt R (map fst xs)\<close> and \<open>transp R\<close> \<open>antisymp R\<close>
+  shows \<open>distinct (map fst (merge_coeffs xs))\<close>
+  using assms
+  by (induction xs rule: merge_coeffs.induct)
+    (auto 5 4 dest: antisympD dest!: fst_normalize_polynomial_subsetD)
+
+lemma in_set_merge_coeffsD:
+  \<open>(a, b) \<in> set (merge_coeffs p) \<Longrightarrow>\<exists>b. (a, b) \<in> set p\<close>
+  by  (auto dest!: fst_normalize_polynomial_subsetD)
+
+lemma rtranclp_normalize_poly_add_mset:
+  \<open>normalize_poly_p\<^sup>*\<^sup>* A r \<Longrightarrow> normalize_poly_p\<^sup>*\<^sup>* (add_mset x A) (add_mset x r)\<close>
+  by (induction rule: rtranclp_induct)
+    (auto dest: normalize_poly_p.keep_coeff[of _ _ x])
+
+lemma nonzero_coeffs_diff:
+  \<open>nonzero_coeffs A \<Longrightarrow> nonzero_coeffs (A - B)\<close>
+  by (auto simp: nonzero_coeffs_def dest: in_diffD)
+
+
+lemma merge_coeffs_is_normalize_poly_p:
+  \<open>(xs, ys) \<in> sorted_repeat_poly_rel \<Longrightarrow> \<exists>r. (merge_coeffs xs, r) \<in> sorted_poly_rel \<and> normalize_poly_p\<^sup>*\<^sup>* ys r\<close>
+  apply (induction xs arbitrary: ys rule: merge_coeffs.induct)
+  subgoal by (auto simp: sorted_repeat_poly_list_rel_wrt_def sorted_poly_list_rel_wrt_def)
+  subgoal
+    by (auto simp: sorted_repeat_poly_list_rel_wrt_def sorted_poly_list_rel_wrt_def)
+  subgoal premises p for xs n ys m p ysa
+    apply (cases \<open>xs = ys\<close>, cases \<open>m+n \<noteq> 0\<close>)
+    subgoal
+      using p(1)[of \<open>add_mset (mset ys, m+n) ysa - {#(mset ys, m), (mset ys, n)#}\<close>] p(4-)
+      apply (auto simp: sorted_poly_list_rel_Cons_iff ac_simps add_mset_commute
+        remove1_mset_add_mset_If nonzero_coeffs_diff sorted_repeat_poly_list_rel_Cons_iff)
+      apply (rule_tac x = \<open>r\<close> in exI)
+      using normalize_poly_p.merge_dup_coeff[of \<open>ysa -  {#(mset ys, m), (mset ys, n)#}\<close> \<open>ysa -  {#(mset ys, m), (mset ys, n)#}\<close> \<open>mset ys\<close> m n]
+      by (auto dest!: multi_member_split simp del: normalize_poly_p.merge_dup_coeff
+        simp: add_mset_commute
+        intro: converse_rtranclp_into_rtranclp)
+   subgoal
+      using p(2)[of \<open>ysa - {#(mset ys, m), (mset ys, n)#}\<close>] p(4-)
+      apply (auto simp: sorted_poly_list_rel_Cons_iff ac_simps add_mset_commute
+        remove1_mset_add_mset_If nonzero_coeffs_diff sorted_repeat_poly_list_rel_Cons_iff)
+      apply (rule_tac x = \<open>r\<close> in exI)
+      using normalize_poly_p.rem_0_coeff[of \<open>add_mset (mset ys, m +n) ysa -  {#(mset ys, m), (mset ys, n)#}\<close> \<open>add_mset (mset ys, m +n) ysa -  {#(mset ys, m), (mset ys, n)#}\<close> \<open>mset ys\<close>]
+      using normalize_poly_p.merge_dup_coeff[of \<open>ysa -  {#(mset ys, m), (mset ys, n)#}\<close> \<open>ysa -  {#(mset ys, m), (mset ys, n)#}\<close> \<open>mset ys\<close> m n]
+      by (force intro: add_mset_commute[of \<open>(mset ys, n)\<close> \<open>(mset ys, -n)\<close>]
+          converse_rtranclp_into_rtranclp
+        dest!: multi_member_split
+        simp del: normalize_poly_p.rem_0_coeff
+        simp: add_eq_0_iff2
+        intro: normalize_poly_p.rem_0_coeff)
+   subgoal
+      using p(3)[of \<open>add_mset (mset ys, m) ysa - {#(mset xs, n), (mset ys, m)#}\<close>] p(4-)
+    apply (auto simp: sorted_poly_list_rel_Cons_iff ac_simps add_mset_commute
+      remove1_mset_add_mset_If sorted_repeat_poly_list_rel_Cons_iff)
+    apply (rule_tac x = \<open>add_mset (mset xs, n) r\<close> in exI)
+    apply (auto dest!: in_set_merge_coeffsD)
+    apply (auto intro: normalize_poly_p.intros rtranclp_normalize_poly_add_mset
+      simp: rel2p_def var_order_rel_def
+      dest!: multi_member_split
+      dest: sorted_poly_list_rel_nonzeroD)
+     using total_on_lexord_less_than_char_linear apply fastforce
+     using total_on_lexord_less_than_char_linear apply fastforce
+    done
+  done
+done
+
+
+subsection \<open>Normalisation\<close>
+
+definition normalize_poly where
+  \<open>normalize_poly p = do {
+     p \<leftarrow> sort_poly_spec p;
+     RETURN (merge_coeffs p)
+}\<close>
+definition sort_coeff :: \<open>string list \<Rightarrow> string list nres\<close> where
+\<open>sort_coeff ys = SPEC(\<lambda>xs. mset xs = mset ys \<and> sorted_wrt (rel2p (Id \<union> var_order_rel)) xs)\<close>
+
+lemma distinct_var_order_Id_var_order:
+  \<open>distinct a \<Longrightarrow> sorted_wrt (rel2p (Id \<union> var_order_rel)) a \<Longrightarrow>
+          sorted_wrt var_order a\<close>
+  by (induction a) (auto simp: rel2p_def)
+
+definition sort_all_coeffs :: \<open>llist_polynomial \<Rightarrow> llist_polynomial nres\<close> where
+\<open>sort_all_coeffs xs = monadic_nfoldli xs (\<lambda>_. RETURN True) (\<lambda>(a, n) b. do {a \<leftarrow> sort_coeff a; RETURN ((a, n) # b)}) []\<close>
+
+lemma sort_all_coeffs_gen:
+  assumes \<open>(\<forall>xs \<in> mononoms xs'. sorted_wrt (rel2p (var_order_rel)) xs)\<close> and
+    \<open>\<forall>x \<in> mononoms (xs @ xs'). distinct x\<close>
+  shows \<open>monadic_nfoldli xs (\<lambda>_. RETURN True) (\<lambda>(a, n) b. do {a \<leftarrow> sort_coeff a; RETURN ((a, n) # b)}) xs' \<le>
+     \<Down>Id (SPEC(\<lambda>ys. map (\<lambda>(a,b). (mset a, b)) (rev xs @ xs') = map (\<lambda>(a,b). (mset a, b)) (ys) \<and>
+     (\<forall>xs \<in> mononoms ys. sorted_wrt (rel2p (var_order_rel)) xs)))\<close>
+proof -
+  have H: \<open>
+       \<forall>x\<in>set xs'. sorted_wrt var_order (fst x) \<Longrightarrow>
+       sorted_wrt (rel2p (Id \<union> var_order_rel)) x \<Longrightarrow>
+       (aaa, ba) \<in> set xs' \<Longrightarrow>
+       sorted_wrt (rel2p (Id \<union> var_order_rel)) aaa\<close> for xs  xs' ba aa b x aaa
+    by (metis UnCI fst_eqD rel2p_def sorted_wrt_mono_rel)
+  show ?thesis
+    using assms
+    unfolding sort_all_coeffs_def sort_coeff_def
+    apply (induction xs arbitrary: xs')
+    subgoal
+      using assms
+      by auto
+    subgoal premises p for a xs
+      using p(2-)
+      apply (cases a, simp only: monadic_nfoldli_simp bind_to_let_conv Let_def if_True Refine_Basic.nres_monad3
+        intro_spec_refine_iff prod.case)
+      by (auto 5 3 simp: intro_spec_refine_iff image_Un
+        dest: same_mset_distinct_iff
+        intro!: p(1)[THEN order_trans] distinct_var_order_Id_var_order
+        simp: H)
+    done
+qed
+
+definition shuffle_coefficients where
+  \<open>shuffle_coefficients xs = (SPEC(\<lambda>ys. map (\<lambda>(a,b). (mset a, b)) (rev xs) = map (\<lambda>(a,b). (mset a, b)) ys \<and>
+     (\<forall>xs \<in> mononoms ys. sorted_wrt (rel2p (var_order_rel)) xs)))\<close>
+
+lemma sort_all_coeffs:
+  \<open>\<forall>x \<in> mononoms xs. distinct x \<Longrightarrow>
+  sort_all_coeffs xs \<le> \<Down> Id (shuffle_coefficients xs)\<close>
+  unfolding sort_all_coeffs_def shuffle_coefficients_def
+  by (rule sort_all_coeffs_gen[THEN order_trans])
+   auto
+
+lemma unsorted_term_poly_list_rel_mset:
+  \<open>(ys, aa) \<in> unsorted_term_poly_list_rel \<Longrightarrow> mset ys = aa\<close>
+  by (auto simp: unsorted_term_poly_list_rel_def)
+
+lemma RETURN_map_alt_def:
+  \<open>RETURN o (map f) =
+    REC\<^sub>T (\<lambda>g xs.
+      case xs of
+        [] \<Rightarrow> RETURN []
+      | x # xs \<Rightarrow> do {xs \<leftarrow> g xs; RETURN (f x # xs)})\<close>
+  unfolding comp_def
+  apply (subst eq_commute)
+  apply (intro ext)
+  apply (induct_tac x)
+  subgoal
+    apply (subst RECT_unfold)
+    apply refine_mono
+    apply auto
+    done
+  subgoal
+    apply (subst RECT_unfold)
+    apply refine_mono
+    apply auto
+    done
+  done
+
+
+lemma fully_unsorted_poly_rel_Cons_iff:
+  \<open>((ys, n) # p, a) \<in> fully_unsorted_poly_rel \<longleftrightarrow>
+    (p, remove1_mset (mset ys, n) a) \<in> fully_unsorted_poly_rel \<and>
+    (mset ys, n) \<in># a \<and> distinct ys\<close>
+  apply (auto simp: poly_list_rel_def list_rel_split_right_iff list_mset_rel_def br_def
+     unsorted_term_poly_list_rel_def
+     nonzero_coeffs_def fully_unsorted_poly_list_rel_def dest!: multi_member_split)
+  apply blast
+  apply (rule_tac b = \<open>(mset ys, n) # y\<close> in relcompI)
+  apply auto
+  done
+
+lemma map_mset_unsorted_term_poly_list_rel:
+  \<open>(\<And>a. a \<in> mononoms s \<Longrightarrow> distinct a) \<Longrightarrow> \<forall>x \<in> mononoms s. distinct x \<Longrightarrow>
+    (\<forall>xs \<in> mononoms s. sorted_wrt (rel2p (Id \<union> var_order_rel)) xs) \<Longrightarrow>
+    (s, map (\<lambda>(a, y). (mset a, y)) s)
+          \<in> \<langle>term_poly_list_rel \<times>\<^sub>r int_rel\<rangle>list_rel\<close>
+  by (induction s) (auto simp: term_poly_list_rel_def
+    distinct_var_order_Id_var_order)
+
+lemma list_rel_unsorted_term_poly_list_relD:
+  \<open>(p, y) \<in> \<langle>unsorted_term_poly_list_rel \<times>\<^sub>r int_rel\<rangle>list_rel \<Longrightarrow>
+   mset y = (\<lambda>(a, y). (mset a, y)) `# mset p \<and> (\<forall>x \<in> mononoms p. distinct x)\<close>
+  by (induction p arbitrary: y)
+   (auto simp: list_rel_split_right_iff
+    unsorted_term_poly_list_rel_def)
+
+lemma shuffle_terms_distinct_iff:
+  assumes \<open>map (\<lambda>(a, y). (mset a, y)) p = map (\<lambda>(a, y). (mset a, y)) s\<close>
+  shows \<open>(\<forall>x\<in>set p. distinct (fst x)) \<longleftrightarrow> (\<forall>x\<in>set s. distinct (fst x))\<close>
+proof -
+  have  \<open>\<forall>x\<in>set s. distinct (fst x)\<close>
+    if m:  \<open>map (\<lambda>(a, y). (mset a, y)) p = map (\<lambda>(a, y). (mset a, y)) s\<close> and
+      dist: \<open>\<forall>x\<in>set p. distinct (fst x)\<close>
+    for s p
+  proof standard+
+    fix x
+    assume x: \<open>x \<in> set s\<close>
+    obtain v n where [simp]: \<open>x = (v, n)\<close> by (cases x)
+    then have \<open>(mset v, n) \<in> set (map (\<lambda>(a, y). (mset a, y)) p)\<close>
+      using x unfolding m by auto
+    then obtain v' where
+      \<open>(v', n) \<in> set p\<close> and
+      \<open>mset v' = mset v\<close>
+      by (auto simp: image_iff)
+    then show \<open>distinct (fst x)\<close>
+      using dist by (metis \<open>x = (v, n)\<close> distinct_mset_mset_distinct fst_conv)
+  qed
+  from this[of p s] this[of s p]
+  show \<open>?thesis\<close>
+    unfolding assms
+    by blast
+qed
+
+lemma
+  \<open>(p, y) \<in> \<langle>unsorted_term_poly_list_rel \<times>\<^sub>r int_rel\<rangle>list_rel \<Longrightarrow>
+       (a, b) \<in> set p \<Longrightarrow>  distinct a\<close>
+   using list_rel_unsorted_term_poly_list_relD by fastforce
+
+lemma sort_all_coeffs_unsorted_poly_rel_with0:
+  assumes \<open>(p, p') \<in> fully_unsorted_poly_rel\<close>
+  shows \<open>sort_all_coeffs p \<le> \<Down> (unsorted_poly_rel_with0) (RETURN p')\<close>
+proof -
+  have H: \<open>(map (\<lambda>(a, y). (mset a, y)) (rev p)) =
+          map (\<lambda>(a, y). (mset a, y)) s \<longleftrightarrow>
+          (map (\<lambda>(a, y). (mset a, y)) p) =
+          map (\<lambda>(a, y). (mset a, y)) (rev s)\<close> for s
+    by (auto simp flip: rev_map simp: eq_commute[of \<open>rev (map _ _)\<close> \<open>map _ _\<close>])
+  have 1: \<open>\<And>s y. (p, y) \<in> \<langle>unsorted_term_poly_list_rel \<times>\<^sub>r int_rel\<rangle>list_rel \<Longrightarrow>
+           p' = mset y \<Longrightarrow>
+           map (\<lambda>(a, y). (mset a, y)) (rev p) = map (\<lambda>(a, y). (mset a, y)) s \<Longrightarrow>
+           \<forall>x\<in>set s. sorted_wrt var_order (fst x) \<Longrightarrow>
+           (s, map (\<lambda>(a, y). (mset a, y)) s)
+           \<in> \<langle>term_poly_list_rel \<times>\<^sub>r int_rel\<rangle>list_rel\<close>
+    by (auto 4 4 simp: rel2p_def
+        dest!: list_rel_unsorted_term_poly_list_relD
+        dest: shuffle_terms_distinct_iff["THEN" iffD1]
+        intro!: map_mset_unsorted_term_poly_list_rel
+        sorted_wrt_mono_rel[of _ \<open>rel2p (var_order_rel)\<close> \<open>rel2p (Id \<union> var_order_rel)\<close>])
+  have 2: \<open>\<And>s y. (p, y) \<in> \<langle>unsorted_term_poly_list_rel \<times>\<^sub>r int_rel\<rangle>list_rel \<Longrightarrow>
+           p' = mset y \<Longrightarrow>
+           map (\<lambda>(a, y). (mset a, y)) (rev p) = map (\<lambda>(a, y). (mset a, y)) s \<Longrightarrow>
+           \<forall>x\<in>set s. sorted_wrt var_order (fst x) \<Longrightarrow>
+           mset y = {#case x of (a, x) \<Rightarrow> (mset a, x). x \<in># mset s#}\<close>
+    by (metis (no_types, lifting) list_rel_unsorted_term_poly_list_relD mset_map mset_rev)
+  show ?thesis
+    apply (rule sort_all_coeffs[THEN order_trans])
+    using assms
+    by (auto simp: shuffle_coefficients_def poly_list_rel_def
+        RETURN_def fully_unsorted_poly_list_rel_def list_mset_rel_def
+        br_def dest: list_rel_unsorted_term_poly_list_relD
+        intro!: RES_refine relcompI[of _  \<open>map (\<lambda>(a, y). (mset a, y)) (rev p)\<close>]
+        1 2)
+qed
+
+lemma sort_poly_spec_id':
+  assumes \<open>(p, p') \<in> unsorted_poly_rel_with0\<close>
+  shows \<open>sort_poly_spec p \<le> \<Down> (sorted_repeat_poly_rel_with0) (RETURN p')\<close>
+proof -
+  obtain y where
+    py: \<open>(p, y) \<in> \<langle>term_poly_list_rel \<times>\<^sub>r int_rel\<rangle>list_rel\<close> and
+    p'_y: \<open>p' = mset y\<close>
+    using assms
+    unfolding fully_unsorted_poly_list_rel_def poly_list_rel_def sorted_poly_list_rel_wrt_def
+    by (auto simp: list_mset_rel_def br_def)
+  then have [simp]: \<open>length y = length p\<close>
+    by (auto simp: list_rel_def list_all2_conv_all_nth)
+  have H: \<open>(x, p')
+        \<in> \<langle>term_poly_list_rel \<times>\<^sub>r int_rel\<rangle>list_rel O list_mset_rel\<close>
+     if px: \<open>mset p = mset x\<close> and \<open>sorted_wrt (rel2p (Id \<union> lexord var_order_rel)) (map fst x)\<close>
+     for x :: \<open>llist_polynomial\<close>
+  proof -
+    obtain f where
+      f: \<open>bij_betw f {..<length x} {..<length p}\<close> and
+      [simp]: \<open>\<And>i. i<length x \<Longrightarrow> x ! i = p ! (f i)\<close>
+      using px apply - apply (subst (asm)(2) eq_commute)  unfolding mset_eq_perm
+      by (auto dest!: permutation_Ex_bij)
+    let ?y = \<open>map (\<lambda>i. y ! f i) [0 ..< length x]\<close>
+    have \<open>i < length y \<Longrightarrow> (p ! f i, y ! f i) \<in> term_poly_list_rel \<times>\<^sub>r int_rel\<close> for i
+      using list_all2_nthD[of _ p y
+         \<open>f i\<close>, OF py[unfolded list_rel_def mem_Collect_eq prod.case]]
+         mset_eq_length[OF px] f
+      by (auto simp: list_rel_def list_all2_conv_all_nth bij_betw_def)
+    then have \<open>(x, ?y) \<in> \<langle>term_poly_list_rel \<times>\<^sub>r int_rel\<rangle>list_rel\<close> and
+      xy: \<open>length x = length y\<close>
+      using py list_all2_nthD[of \<open>rel2p (term_poly_list_rel \<times>\<^sub>r int_rel)\<close> p y
+         \<open>f i\<close> for i, simplified] mset_eq_length[OF px]
+      by (auto simp: list_rel_def list_all2_conv_all_nth)
+    moreover {
+      have f: \<open>mset_set {0..<length x} = f `# mset_set {0..<length x}\<close>
+        using f mset_eq_length[OF px]
+        by (auto simp: bij_betw_def lessThan_atLeast0 image_mset_mset_set)
+      have \<open>mset y = {#y ! f x. x \<in># mset_set {0..<length x}#}\<close>
+        by (subst drop_0[symmetric], subst mset_drop_upto, subst xy[symmetric], subst f)
+          auto
+      then have \<open>(?y, p') \<in> list_mset_rel\<close>
+        by (auto simp: list_mset_rel_def br_def p'_y)
+    }
+    ultimately show ?thesis
+      by (auto intro!: relcompI[of _ ?y])
+  qed
+  show ?thesis
+    unfolding sort_poly_spec_def poly_list_rel_def sorted_repeat_poly_list_rel_with0_wrt_def
+    by refine_rcg (auto intro: H)
+qed
+
+
+fun merge_coeffs0 :: \<open>llist_polynomial \<Rightarrow> llist_polynomial\<close> where
+  \<open>merge_coeffs0 [] = []\<close> |
+  \<open>merge_coeffs0 [(xs, n)] = (if n = 0 then [] else [(xs, n)])\<close> |
+  \<open>merge_coeffs0 ((xs, n) # (ys, m) # p) =
+    (if xs = ys
+    then if n + m \<noteq> 0 then merge_coeffs0 ((xs, n + m) # p) else merge_coeffs0 p
+    else if n = 0 then merge_coeffs0 ((ys, m) # p)
+      else(xs, n) # merge_coeffs0 ((ys, m) # p))\<close>
+
+
+lemma sorted_repeat_poly_list_rel_with0_wrt_ConsD:
+  \<open>((ys, n) # p, a) \<in> sorted_repeat_poly_list_rel_with0_wrt S term_poly_list_rel \<Longrightarrow>
+     (p, remove1_mset (mset ys, n) a) \<in> sorted_repeat_poly_list_rel_with0_wrt S term_poly_list_rel \<and>
+    (mset ys, n) \<in># a \<and> (\<forall>x \<in> set p. S ys (fst x)) \<and> sorted_wrt (rel2p var_order_rel) ys \<and>
+    distinct ys\<close>
+  unfolding sorted_repeat_poly_list_rel_with0_wrt_def prod.case mem_Collect_eq
+    list_rel_def
+  apply (clarsimp)
+  apply (subst (asm) list.rel_sel)
+  apply (intro conjI)
+  apply (rule_tac b = \<open>tl y\<close> in relcompI)
+  apply (auto simp: sorted_poly_list_rel_wrt_def list_mset_rel_def br_def)
+  apply (case_tac \<open>lead_coeff y\<close>; case_tac y)
+  apply (auto simp: term_poly_list_rel_def)
+  apply (case_tac \<open>lead_coeff y\<close>; case_tac y)
+  apply (auto simp: term_poly_list_rel_def)
+  apply (case_tac \<open>lead_coeff y\<close>; case_tac y)
+  apply (auto simp: term_poly_list_rel_def)
+  apply (case_tac \<open>lead_coeff y\<close>; case_tac y)
+  apply (auto simp: term_poly_list_rel_def)
+  done
+
+lemma sorted_repeat_poly_list_rel_with0_wrtl_Cons_iff:
+  \<open>((ys, n) # p, a) \<in> sorted_repeat_poly_list_rel_with0_wrt S term_poly_list_rel \<longleftrightarrow>
+    (p, remove1_mset (mset ys, n) a) \<in> sorted_repeat_poly_list_rel_with0_wrt S term_poly_list_rel \<and>
+    (mset ys, n) \<in># a \<and> (\<forall>x \<in> set p. S ys (fst x)) \<and> sorted_wrt (rel2p var_order_rel) ys \<and>
+    distinct ys\<close>
+  apply (rule iffI)
+  subgoal
+    by (auto dest!: sorted_repeat_poly_list_rel_with0_wrt_ConsD)
+  subgoal
+    unfolding sorted_poly_list_rel_wrt_def prod.case mem_Collect_eq
+      list_rel_def sorted_repeat_poly_list_rel_with0_wrt_def
+    apply (clarsimp)
+    apply (rule_tac b = \<open>(mset ys, n) # y\<close> in relcompI)
+    by (auto simp: sorted_poly_list_rel_wrt_def list_mset_rel_def br_def
+        term_poly_list_rel_def add_mset_eq_add_mset eq_commute[of _ \<open>mset _\<close>]
+        nonzero_coeffs_def
+      dest!: multi_member_split)
+    done
+
+lemma fst_normalize0_polynomial_subsetD:
+  \<open>(a, b) \<in> set (merge_coeffs0 p) \<Longrightarrow> a \<in> mononoms p\<close>
+  apply (induction p rule: merge_coeffs0.induct)
+  subgoal
+    by auto
+  subgoal
+    by (auto split: if_splits)
+  subgoal
+    by (auto split: if_splits)
+  done
+
+lemma in_set_merge_coeffs0D:
+  \<open>(a, b) \<in> set (merge_coeffs0 p) \<Longrightarrow>\<exists>b. (a, b) \<in> set p\<close>
+  by  (auto dest!: fst_normalize0_polynomial_subsetD)
+
+
+lemma merge_coeffs0_is_normalize_poly_p:
+  \<open>(xs, ys) \<in> sorted_repeat_poly_rel_with0 \<Longrightarrow> \<exists>r. (merge_coeffs0 xs, r) \<in> sorted_poly_rel \<and> normalize_poly_p\<^sup>*\<^sup>* ys r\<close>
+  apply (induction xs arbitrary: ys rule: merge_coeffs0.induct)
+  subgoal by (auto simp: sorted_repeat_poly_list_rel_wrt_def sorted_poly_list_rel_wrt_def
+    sorted_repeat_poly_list_rel_with0_wrt_def list_mset_rel_def br_def)
+  subgoal for xs n ys
+    by (force simp: sorted_repeat_poly_list_rel_wrt_def sorted_poly_list_rel_wrt_def
+      sorted_repeat_poly_list_rel_with0_wrt_def list_mset_rel_def br_def
+      list_rel_split_right_iff)
+  subgoal premises p for xs n ys m p ysa
+    apply (cases \<open>xs = ys\<close>, cases \<open>m+n \<noteq> 0\<close>)
+    subgoal
+      using p(1)[of \<open>add_mset (mset ys, m+n) ysa - {#(mset ys, m), (mset ys, n)#}\<close>] p(5-)
+      apply (auto simp: sorted_repeat_poly_list_rel_with0_wrtl_Cons_iff ac_simps add_mset_commute
+        remove1_mset_add_mset_If nonzero_coeffs_diff sorted_repeat_poly_list_rel_Cons_iff)
+      apply (auto intro: normalize_poly_p.intros add_mset_commute add_mset_commute
+         converse_rtranclp_into_rtranclp dest!: multi_member_split
+        simp del: normalize_poly_p.merge_dup_coeff)
+      apply (rule_tac x = \<open>r\<close> in exI)
+      using normalize_poly_p.merge_dup_coeff[of \<open>ysa -  {#(mset ys, m), (mset ys, n)#}\<close> \<open>ysa -  {#(mset ys, m), (mset ys, n)#}\<close> \<open>mset ys\<close> m n]
+      by (auto intro: normalize_poly_p.intros 
+         converse_rtranclp_into_rtranclp dest!: multi_member_split
+         simp: add_mset_commute[of \<open>(mset ys, n)\<close> \<open>(mset ys, m)\<close>]
+         simp del: normalize_poly_p.merge_dup_coeff)
+   subgoal
+      using p(2)[of \<open>ysa - {#(mset ys, m), (mset ys, n)#}\<close>] p(5-)
+      apply (auto simp: sorted_repeat_poly_list_rel_with0_wrtl_Cons_iff ac_simps add_mset_commute
+        remove1_mset_add_mset_If nonzero_coeffs_diff sorted_repeat_poly_list_rel_Cons_iff)
+      apply (rule_tac x = \<open>r\<close> in exI)
+      using normalize_poly_p.rem_0_coeff[of \<open>add_mset (mset ys, m +n) ysa -  {#(mset ys, m), (mset ys, n)#}\<close> \<open>add_mset (mset ys, m +n) ysa -  {#(mset ys, m), (mset ys, n)#}\<close> \<open>mset ys\<close>]
+      using normalize_poly_p.merge_dup_coeff[of \<open>ysa -  {#(mset ys, m), (mset ys, n)#}\<close> \<open>ysa -  {#(mset ys, m), (mset ys, n)#}\<close> \<open>mset ys\<close> m n]
+      by (force intro: normalize_poly_p.intros converse_rtranclp_into_rtranclp
+          dest!: multi_member_split
+        simp del: normalize_poly_p.rem_0_coeff
+         simp: add_mset_commute[of \<open>(mset ys, n)\<close> \<open>(mset ys, m)\<close>])
+   apply (cases \<open>n = 0\<close>)
+   subgoal
+      using p(3)[of \<open>add_mset (mset ys, m) ysa - {#(mset xs, n), (mset ys, m)#}\<close>] p(4-)
+    apply (auto simp: sorted_repeat_poly_list_rel_with0_wrtl_Cons_iff ac_simps add_mset_commute
+      remove1_mset_add_mset_If sorted_repeat_poly_list_rel_Cons_iff)
+    apply (rule_tac x = \<open>r\<close> in exI)
+    apply (auto dest!: in_set_merge_coeffsD)
+    by (force intro: rtranclp_normalize_poly_add_mset converse_rtranclp_into_rtranclp
+      simp: rel2p_def var_order_rel_def sorted_poly_list_rel_Cons_iff
+      dest!: multi_member_split
+      dest: sorted_poly_list_rel_nonzeroD)
+   subgoal
+      using p(4)[of \<open>add_mset (mset ys, m) ysa - {#(mset xs, n), (mset ys, m)#}\<close>] p(5-)
+    apply (auto simp: sorted_repeat_poly_list_rel_with0_wrtl_Cons_iff ac_simps add_mset_commute
+      remove1_mset_add_mset_If sorted_repeat_poly_list_rel_Cons_iff)
+    apply (rule_tac x = \<open>add_mset (mset xs, n) r\<close> in exI)
+    apply (auto dest!: in_set_merge_coeffs0D)
+    apply (auto intro: normalize_poly_p.intros rtranclp_normalize_poly_add_mset
+      simp: rel2p_def var_order_rel_def sorted_poly_list_rel_Cons_iff
+      dest!: multi_member_split
+      dest: sorted_poly_list_rel_nonzeroD)
+      using in_set_merge_coeffs0D total_on_lexord_less_than_char_linear apply fastforce
+      using in_set_merge_coeffs0D total_on_lexord_less_than_char_linear apply fastforce
+      done
+    done
+  done
+
+definition full_normalize_poly where
+  \<open>full_normalize_poly p = do {
+     p \<leftarrow> sort_all_coeffs p;
+     p \<leftarrow> sort_poly_spec p;
+     RETURN (merge_coeffs0 p)
+  }\<close>
+
+fun sorted_remdups where
+  \<open>sorted_remdups (x # y # zs) =
+    (if x = y then sorted_remdups (y # zs) else x # sorted_remdups (y # zs))\<close> |
+  \<open>sorted_remdups zs = zs\<close>
+
+lemma set_sorted_remdups[simp]:
+  \<open>set (sorted_remdups xs) = set xs\<close>
+  by (induction xs rule: sorted_remdups.induct)
+   auto
+
+lemma distinct_sorted_remdups:
+  \<open>sorted_wrt R xs \<Longrightarrow> transp R \<Longrightarrow> Restricted_Predicates.total_on R UNIV \<Longrightarrow>
+    antisymp R \<Longrightarrow> distinct (sorted_remdups xs)\<close>
+  by (induction xs rule: sorted_remdups.induct)
+    (auto dest: antisympD)
+
+lemma full_normalize_poly_normalize_poly_p:
+  assumes \<open>(p, p') \<in> fully_unsorted_poly_rel\<close>
+  shows \<open>full_normalize_poly p \<le> \<Down> (sorted_poly_rel) (SPEC (\<lambda>r. normalize_poly_p\<^sup>*\<^sup>* p' r))\<close>
+  (is \<open>?A \<le> \<Down> ?R ?B\<close>)
+proof -
+  have 1: \<open>?B = do {
+     p' \<leftarrow> RETURN p';
+     p' \<leftarrow> RETURN p';
+     SPEC (\<lambda>r. normalize_poly_p\<^sup>*\<^sup>* p' r)
+    }\<close>
+    by auto
+  have [refine0]: \<open>sort_all_coeffs p \<le> SPEC(\<lambda>p. (p, p') \<in> unsorted_poly_rel_with0)\<close>
+    by (rule sort_all_coeffs_unsorted_poly_rel_with0[OF assms, THEN order_trans])
+      (auto simp: conc_fun_RES RETURN_def)
+  have [refine0]: \<open>sort_poly_spec p \<le> SPEC (\<lambda>c. (c, p') \<in> sorted_repeat_poly_rel_with0)\<close>
+    if \<open>(p, p') \<in> unsorted_poly_rel_with0\<close>
+    for p p'
+    by (rule sort_poly_spec_id'[THEN order_trans, OF that])
+      (auto simp: conc_fun_RES RETURN_def)
+  show ?thesis
+    apply (subst 1)
+    unfolding full_normalize_poly_def
+    by (refine_rcg)
+     (auto intro!: RES_refine
+        dest!: merge_coeffs0_is_normalize_poly_p
+        simp: RETURN_def)
+qed
+
+definition mult_poly_full :: \<open>_\<close> where
+\<open>mult_poly_full p q = do {
+  let pq = mult_poly_raw p q;
+  normalize_poly pq
+}\<close>
+
+lemma normalize_poly_normalize_poly_p:
+  assumes \<open>(p, p') \<in> unsorted_poly_rel\<close>
+  shows \<open>normalize_poly p \<le> \<Down> (sorted_poly_rel) (SPEC (\<lambda>r. normalize_poly_p\<^sup>*\<^sup>* p' r))\<close>
+proof -
+  have 1: \<open>SPEC (\<lambda>r. normalize_poly_p\<^sup>*\<^sup>* p' r) = do {
+      p' \<leftarrow> RETURN p';
+      SPEC (\<lambda>r. normalize_poly_p\<^sup>*\<^sup>* p' r)
+   }\<close>
+   by auto
+  show ?thesis
+    unfolding normalize_poly_def
+    apply (subst 1)
+    apply (refine_rcg sort_poly_spec_id[OF assms]
+      merge_coeffs_is_normalize_poly_p)
+    subgoal
+      by (drule merge_coeffs_is_normalize_poly_p)
+        (auto intro!: RES_refine simp: RETURN_def)
+    done
+qed
+
+
+subsection \<open>Multiplication and normalisation\<close>
+
+definition mult_poly_p' :: \<open>_\<close> where
+\<open>mult_poly_p' p' q' = do {
+  pq \<leftarrow> SPEC(\<lambda>r. (mult_poly_p q')\<^sup>*\<^sup>* (p', {#}) ({#}, r));
+  SPEC (\<lambda>r. normalize_poly_p\<^sup>*\<^sup>* pq r)
+}\<close>
+
+lemma unsorted_poly_rel_fully_unsorted_poly_rel:
+  \<open>unsorted_poly_rel \<subseteq> fully_unsorted_poly_rel\<close>
+proof -
+  have \<open>term_poly_list_rel  \<times>\<^sub>r int_rel \<subseteq> unsorted_term_poly_list_rel \<times>\<^sub>r int_rel\<close>
+    by (auto simp: unsorted_term_poly_list_rel_def term_poly_list_rel_def)
+  from list_rel_mono[OF this]
+  show ?thesis
+    unfolding poly_list_rel_def fully_unsorted_poly_list_rel_def
+    by (auto simp:)
+qed
+
+lemma mult_poly_full_mult_poly_p':
+  assumes \<open>(p, p') \<in> sorted_poly_rel\<close> \<open>(q, q') \<in> sorted_poly_rel\<close>
+  shows \<open>mult_poly_full p q \<le> \<Down> (sorted_poly_rel) (mult_poly_p' p' q')\<close>
+  unfolding mult_poly_full_def mult_poly_p'_def
+  apply (refine_rcg full_normalize_poly_normalize_poly_p
+    normalize_poly_normalize_poly_p)
+  apply (subst RETURN_RES_refine_iff)
+  apply (subst Bex_def)
+  apply (subst mem_Collect_eq)
+  apply (subst conj_commute)
+  apply (rule mult_poly_raw_mult_poly_p[OF assms(1,2)])
+  subgoal
+    by blast
+  done
+
+definition add_poly_spec :: \<open>_\<close> where
+\<open>add_poly_spec p q = SPEC (\<lambda>r. p + q - r \<in> ideal polynomial_bool)\<close>
+
+definition add_poly_p' :: \<open>_\<close> where
+\<open>add_poly_p' p q = SPEC(\<lambda>r. add_poly_p\<^sup>*\<^sup>* (p, q, {#}) ({#}, {#}, r))\<close>
+
+lemma add_poly_l_add_poly_p':
+  assumes \<open>(p, p') \<in> sorted_poly_rel\<close> \<open>(q, q') \<in> sorted_poly_rel\<close>
+  shows \<open>add_poly_l (p, q) \<le> \<Down> (sorted_poly_rel) (add_poly_p' p' q')\<close>
+  unfolding add_poly_p'_def
+  apply (refine_rcg add_poly_l_spec[THEN fref_to_Down_curry_right, THEN order_trans, of _ p' q'])
+  subgoal by auto
+  subgoal using assms by auto
+  subgoal
+    by auto
+  done
+
+
+subsection \<open>Correctness\<close>
+
+context poly_embed
+begin
+
+definition mset_poly_rel where
+  \<open>mset_poly_rel = {(a, b). b = polynomial_of_mset a}\<close>
+
+definition var_rel where
+  \<open>var_rel = br \<phi> (\<lambda>_. True)\<close>
+
+lemma normalize_poly_p_normalize_poly_spec:
+  \<open>(p, p') \<in> mset_poly_rel \<Longrightarrow>
+    SPEC (\<lambda>r. normalize_poly_p\<^sup>*\<^sup>* p r) \<le> \<Down>mset_poly_rel (normalize_poly_spec p')\<close>
+  by (auto simp: mset_poly_rel_def rtranclp_normalize_poly_p_poly_of_mset ideal.span_zero
+    normalize_poly_spec_def intro!: RES_refine)
+
+
+lemma mult_poly_p'_mult_poly_spec:
+  \<open>(p, p') \<in> mset_poly_rel \<Longrightarrow> (q, q') \<in> mset_poly_rel \<Longrightarrow>
+  mult_poly_p' p q \<le> \<Down>mset_poly_rel (mult_poly_spec p' q')\<close>
+  unfolding mult_poly_p'_def mult_poly_spec_def
+  apply refine_rcg
+  apply (auto simp: mset_poly_rel_def dest!: rtranclp_mult_poly_p_mult_ideal_final)
+  apply (intro RES_refine)
+  using ideal.span_add_eq2 ideal.span_zero
+  by (fastforce dest!: rtranclp_normalize_poly_p_poly_of_mset intro: ideal.span_add_eq2)
+
+
+lemma add_poly_p'_add_poly_spec:
+  \<open>(p, p') \<in> mset_poly_rel \<Longrightarrow> (q, q') \<in> mset_poly_rel \<Longrightarrow>
+  add_poly_p' p q \<le> \<Down>mset_poly_rel (add_poly_spec p' q')\<close>
+  unfolding add_poly_p'_def add_poly_spec_def
+  apply (auto simp: mset_poly_rel_def dest!: rtranclp_add_poly_p_polynomial_of_mset_full)
+  apply (intro RES_refine)
+  apply (auto simp: rtranclp_add_poly_p_polynomial_of_mset_full ideal.span_zero)
+  done
+
+end
+
+
+definition weak_equality_l :: \<open>llist_polynomial \<Rightarrow> llist_polynomial \<Rightarrow> bool nres\<close> where
+  \<open>weak_equality_l p q = RETURN (p = q)\<close>
+
+definition weak_equality :: \<open>int mpoly \<Rightarrow> int mpoly \<Rightarrow> bool nres\<close> where
+  \<open>weak_equality p q = SPEC (\<lambda>r. r \<longrightarrow> p = q)\<close>
+
+definition weak_equality_spec :: \<open>mset_polynomial \<Rightarrow> mset_polynomial \<Rightarrow> bool nres\<close> where
+  \<open>weak_equality_spec p q = SPEC (\<lambda>r. r \<longrightarrow> p = q)\<close>
+
+lemma term_poly_list_rel_same_rightD:
+  \<open>(a, aa) \<in> term_poly_list_rel \<Longrightarrow> (a, ab) \<in> term_poly_list_rel \<Longrightarrow> aa = ab\<close>
+    by (auto simp: term_poly_list_rel_def)
+
+lemma list_rel_term_poly_list_rel_same_rightD:
+  \<open>(xa, y) \<in> \<langle>term_poly_list_rel \<times>\<^sub>r int_rel\<rangle>list_rel \<Longrightarrow>
+   (xa, ya) \<in> \<langle>term_poly_list_rel \<times>\<^sub>r int_rel\<rangle>list_rel \<Longrightarrow>
+    y = ya\<close>
+  by (induction xa arbitrary: y ya)
+    (auto simp: list_rel_split_right_iff
+      dest: term_poly_list_rel_same_rightD)
+
+lemma weak_equality_l_weak_equality_spec:
+  \<open>(uncurry weak_equality_l, uncurry weak_equality_spec) \<in>
+    sorted_poly_rel \<times>\<^sub>r sorted_poly_rel \<rightarrow>\<^sub>f \<langle>bool_rel\<rangle>nres_rel\<close>
+  by (intro frefI nres_relI)
+   (auto simp: weak_equality_l_def weak_equality_spec_def
+      sorted_poly_list_rel_wrt_def list_mset_rel_def br_def
+    dest: list_rel_term_poly_list_rel_same_rightD)
+
+end
+
diff --git a/thys/PAC_Checker/PAC_Polynomials_Term.thy b/thys/PAC_Checker/PAC_Polynomials_Term.thy
new file mode 100644
--- /dev/null
+++ b/thys/PAC_Checker/PAC_Polynomials_Term.thy
@@ -0,0 +1,190 @@
+(*
+  File:         PAC_Polynomials_Term.thy
+  Author:       Mathias Fleury, Daniela Kaufmann, JKU
+  Maintainer:   Mathias Fleury, JKU
+*)
+theory PAC_Polynomials_Term
+  imports PAC_Polynomials
+    Refine_Imperative_HOL.IICF
+begin
+
+
+section \<open>Terms\<close>
+
+text \<open>We define some helper functions.\<close>
+
+subsection \<open>Ordering\<close>
+
+(*Taken from WB_More_Refinement*)
+lemma fref_to_Down_curry_left:
+  fixes f:: \<open>'a \<Rightarrow> 'b \<Rightarrow> 'c nres\<close> and
+    A::\<open>(('a \<times> 'b) \<times> 'd) set\<close>
+  shows
+    \<open>(uncurry f, g) \<in> [P]\<^sub>f A \<rightarrow> \<langle>B\<rangle>nres_rel \<Longrightarrow>
+      (\<And>a b x'. P x' \<Longrightarrow> ((a, b), x') \<in> A \<Longrightarrow> f a b \<le> \<Down> B (g x'))\<close>
+  unfolding fref_def uncurry_def nres_rel_def
+  by auto
+
+lemma fref_to_Down_curry_right:
+  fixes g :: \<open>'a \<Rightarrow> 'b \<Rightarrow> 'c nres\<close> and f :: \<open>'d \<Rightarrow> _ nres\<close> and
+    A::\<open>('d \<times> ('a \<times> 'b)) set\<close>
+  shows
+    \<open>(f, uncurry g) \<in> [P]\<^sub>f A \<rightarrow> \<langle>B\<rangle>nres_rel \<Longrightarrow>
+      (\<And>a b x'. P (a,b) \<Longrightarrow> (x', (a, b)) \<in> A \<Longrightarrow> f x' \<le> \<Down> B (g a b))\<close>
+  unfolding fref_def uncurry_def nres_rel_def
+  by auto
+
+type_synonym term_poly_list = \<open>string list\<close>
+type_synonym llist_polynomial = \<open>(term_poly_list \<times> int) list\<close>
+
+
+text \<open>We instantiate the characters with typeclass linorder to be able to talk abourt sorted and
+  so on.\<close>
+
+definition less_eq_char :: \<open>char \<Rightarrow> char \<Rightarrow> bool\<close> where
+  \<open>less_eq_char c d = (((of_char c) :: nat) \<le> of_char d)\<close>
+
+definition less_char :: \<open>char \<Rightarrow> char \<Rightarrow> bool\<close> where
+  \<open>less_char c d = (((of_char c) :: nat) < of_char d)\<close>
+
+global_interpretation char: linorder less_eq_char less_char
+  using linorder_char
+  unfolding linorder_class_def class.linorder_def
+    less_eq_char_def[symmetric] less_char_def[symmetric]
+    class.order_def order_class_def
+    class.preorder_def preorder_class_def
+    ord_class_def
+  apply auto
+  done
+
+abbreviation less_than_char :: \<open>(char \<times> char) set\<close> where
+  \<open>less_than_char \<equiv> p2rel less_char\<close>
+
+lemma less_than_char_def:
+  \<open>(x,y) \<in> less_than_char \<longleftrightarrow> less_char x y\<close>
+  by (auto simp: p2rel_def)
+
+lemma trans_less_than_char[simp]:
+    \<open>trans less_than_char\<close> and
+  irrefl_less_than_char:
+    \<open>irrefl less_than_char\<close> and
+  antisym_less_than_char:
+    \<open>antisym less_than_char\<close>
+  by (auto simp: less_than_char_def trans_def irrefl_def antisym_def)
+
+
+subsection \<open>Polynomials\<close>
+
+definition var_order_rel :: \<open>(string \<times> string) set\<close> where
+  \<open>var_order_rel \<equiv> lexord less_than_char\<close>
+
+abbreviation var_order :: \<open>string \<Rightarrow> string \<Rightarrow> bool\<close> where
+  \<open>var_order \<equiv> rel2p var_order_rel\<close>
+
+abbreviation term_order_rel :: \<open>(term_poly_list \<times> term_poly_list) set\<close> where
+  \<open>term_order_rel \<equiv> lexord var_order_rel\<close>
+
+abbreviation term_order :: \<open>term_poly_list \<Rightarrow> term_poly_list \<Rightarrow> bool\<close> where
+  \<open>term_order \<equiv> rel2p term_order_rel\<close>
+
+definition term_poly_list_rel :: \<open>(term_poly_list \<times> term_poly) set\<close> where
+  \<open>term_poly_list_rel = {(xs, ys).
+     ys = mset xs \<and>
+     distinct xs \<and>
+     sorted_wrt (rel2p var_order_rel) xs}\<close>
+
+definition unsorted_term_poly_list_rel :: \<open>(term_poly_list \<times> term_poly) set\<close> where
+  \<open>unsorted_term_poly_list_rel = {(xs, ys).
+     ys = mset xs \<and> distinct xs}\<close>
+
+definition poly_list_rel :: \<open>_ \<Rightarrow> (('a \<times> int) list \<times> mset_polynomial) set\<close> where
+  \<open>poly_list_rel R = {(xs, ys).
+     (xs, ys) \<in> \<langle>R \<times>\<^sub>r int_rel\<rangle>list_rel O list_mset_rel \<and>
+     0 \<notin># snd `# ys}\<close>
+
+definition sorted_poly_list_rel_wrt :: \<open>('a \<Rightarrow> 'a \<Rightarrow> bool)
+     \<Rightarrow> ('a \<times> string multiset) set \<Rightarrow> (('a \<times> int) list \<times> mset_polynomial) set\<close> where
+  \<open>sorted_poly_list_rel_wrt S R = {(xs, ys).
+     (xs, ys) \<in> \<langle>R \<times>\<^sub>r int_rel\<rangle>list_rel O list_mset_rel \<and>
+     sorted_wrt S (map fst xs) \<and>
+     distinct (map fst xs) \<and>
+     0 \<notin># snd `# ys}\<close>
+
+abbreviation sorted_poly_list_rel where
+  \<open>sorted_poly_list_rel R \<equiv> sorted_poly_list_rel_wrt R term_poly_list_rel\<close>
+
+abbreviation sorted_poly_rel where
+  \<open>sorted_poly_rel \<equiv> sorted_poly_list_rel term_order\<close>
+
+
+definition sorted_repeat_poly_list_rel_wrt :: \<open>('a \<Rightarrow> 'a \<Rightarrow> bool)
+     \<Rightarrow> ('a \<times> string multiset) set \<Rightarrow> (('a \<times> int) list \<times> mset_polynomial) set\<close> where
+  \<open>sorted_repeat_poly_list_rel_wrt S R = {(xs, ys).
+     (xs, ys) \<in> \<langle>R \<times>\<^sub>r int_rel\<rangle>list_rel O list_mset_rel \<and>
+     sorted_wrt S (map fst xs) \<and>
+     0 \<notin># snd `# ys}\<close>
+
+abbreviation sorted_repeat_poly_list_rel where
+  \<open>sorted_repeat_poly_list_rel R \<equiv> sorted_repeat_poly_list_rel_wrt R term_poly_list_rel\<close>
+
+abbreviation sorted_repeat_poly_rel where
+  \<open>sorted_repeat_poly_rel \<equiv> sorted_repeat_poly_list_rel (rel2p (Id \<union> lexord var_order_rel))\<close>
+
+
+abbreviation unsorted_poly_rel where
+  \<open>unsorted_poly_rel \<equiv> poly_list_rel term_poly_list_rel\<close>
+
+lemma sorted_poly_list_rel_empty_l[simp]:
+  \<open>([], s') \<in> sorted_poly_list_rel_wrt S T \<longleftrightarrow> s' = {#}\<close>
+  by (cases s')
+    (auto simp: sorted_poly_list_rel_wrt_def list_mset_rel_def br_def)
+
+
+definition fully_unsorted_poly_list_rel :: \<open>_ \<Rightarrow> (('a \<times> int) list \<times> mset_polynomial) set\<close> where
+  \<open>fully_unsorted_poly_list_rel R = {(xs, ys).
+     (xs, ys) \<in> \<langle>R \<times>\<^sub>r int_rel\<rangle>list_rel O list_mset_rel}\<close>
+
+abbreviation fully_unsorted_poly_rel where
+  \<open>fully_unsorted_poly_rel \<equiv> fully_unsorted_poly_list_rel unsorted_term_poly_list_rel\<close>
+
+
+lemma fully_unsorted_poly_list_rel_empty_iff[simp]:
+  \<open>(p, {#}) \<in> fully_unsorted_poly_list_rel R \<longleftrightarrow> p = []\<close>
+  \<open>([], p') \<in> fully_unsorted_poly_list_rel R \<longleftrightarrow> p' = {#}\<close>
+  by (auto simp: fully_unsorted_poly_list_rel_def list_mset_rel_def br_def)
+
+definition poly_list_rel_with0 :: \<open>_ \<Rightarrow> (('a \<times> int) list \<times> mset_polynomial) set\<close> where
+  \<open>poly_list_rel_with0 R = {(xs, ys).
+     (xs, ys) \<in> \<langle>R \<times>\<^sub>r int_rel\<rangle>list_rel O list_mset_rel}\<close>
+
+abbreviation unsorted_poly_rel_with0 where
+  \<open>unsorted_poly_rel_with0 \<equiv> fully_unsorted_poly_list_rel term_poly_list_rel\<close>
+
+lemma poly_list_rel_with0_empty_iff[simp]:
+  \<open>(p, {#}) \<in> poly_list_rel_with0 R \<longleftrightarrow> p = []\<close>
+  \<open>([], p') \<in> poly_list_rel_with0 R \<longleftrightarrow> p' = {#}\<close>
+  by (auto simp: poly_list_rel_with0_def list_mset_rel_def br_def)
+
+
+definition sorted_repeat_poly_list_rel_with0_wrt :: \<open>('a \<Rightarrow> 'a \<Rightarrow> bool)
+     \<Rightarrow> ('a \<times> string multiset) set \<Rightarrow> (('a \<times> int) list \<times> mset_polynomial) set\<close> where
+  \<open>sorted_repeat_poly_list_rel_with0_wrt S R = {(xs, ys).
+     (xs, ys) \<in> \<langle>R \<times>\<^sub>r int_rel\<rangle>list_rel O list_mset_rel \<and>
+     sorted_wrt S (map fst xs)}\<close>
+
+abbreviation sorted_repeat_poly_list_rel_with0 where
+  \<open>sorted_repeat_poly_list_rel_with0 R \<equiv> sorted_repeat_poly_list_rel_with0_wrt R term_poly_list_rel\<close>
+
+abbreviation sorted_repeat_poly_rel_with0 where
+  \<open>sorted_repeat_poly_rel_with0 \<equiv> sorted_repeat_poly_list_rel_with0 (rel2p (Id \<union> lexord var_order_rel))\<close>
+
+lemma term_poly_list_relD:
+  \<open>(xs, ys) \<in> term_poly_list_rel \<Longrightarrow> distinct xs\<close>
+  \<open>(xs, ys) \<in> term_poly_list_rel \<Longrightarrow> ys = mset xs\<close>
+  \<open>(xs, ys) \<in> term_poly_list_rel \<Longrightarrow> sorted_wrt (rel2p var_order_rel) xs\<close>
+  \<open>(xs, ys) \<in> term_poly_list_rel \<Longrightarrow> sorted_wrt (rel2p (Id \<union> var_order_rel)) xs\<close>
+  apply (auto simp: term_poly_list_rel_def; fail)+
+  by (metis (mono_tags, lifting) CollectD UnI2 rel2p_def sorted_wrt_mono_rel split_conv
+    term_poly_list_rel_def)
+
+end
diff --git a/thys/PAC_Checker/PAC_Specification.thy b/thys/PAC_Checker/PAC_Specification.thy
new file mode 100644
--- /dev/null
+++ b/thys/PAC_Checker/PAC_Specification.thy
@@ -0,0 +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, hide_lams) 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)
+      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, hide_lams) 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/PAC_Version.thy b/thys/PAC_Checker/PAC_Version.thy
new file mode 100644
--- /dev/null
+++ b/thys/PAC_Checker/PAC_Version.thy
@@ -0,0 +1,24 @@
+(*
+  File:         PAC_Version.thy
+  Author:       Mathias Fleury, Daniela Kaufmann, JKU
+  Maintainer:   Mathias Fleury, JKU
+*)
+theory PAC_Version
+  imports Main
+begin
+
+text \<open>This code was taken from IsaFoR. However, for the AFP, we use the version name \<^text>\<open>AFP\<close>,
+instead of a mercurial version. \<close>
+local_setup \<open>
+  let
+    val version = "AFP"
+  in
+    Local_Theory.define
+      ((\<^binding>\<open>version\<close>, NoSyn),
+        ((\<^binding>\<open>version_def\<close>, []), HOLogic.mk_literal version)) #> #2
+  end
+\<close>
+
+declare version_def [code]
+
+end
diff --git a/thys/PAC_Checker/ROOT b/thys/PAC_Checker/ROOT
new file mode 100644
--- /dev/null
+++ b/thys/PAC_Checker/ROOT
@@ -0,0 +1,38 @@
+chapter AFP
+
+session PAC_Checker (AFP) = "Sepref_IICF" +
+  description \<open>PAC proof checker\<close>
+  options
+    [timeout = 2700]
+  sessions
+    "HOL-Library"
+    "HOL-Algebra"
+    "Polynomials"
+    Nested_Multisets_Ordinals
+  theories
+    PAC_More_Poly
+    Duplicate_Free_Multiset
+    Finite_Map_Multiset
+    WB_Sort
+    More_Loops
+    PAC_Specification
+    PAC_Map_Rel
+    PAC_Checker_Specification
+    PAC_Checker_Relation
+    PAC_Polynomials
+    PAC_Polynomials_Term
+    PAC_Polynomials_Operations
+    PAC_Assoc_Map_Rel
+    PAC_Map_Rel
+    PAC_Checker
+    PAC_Checker_Init
+    PAC_Version
+    PAC_Checker_Synthesis
+  theories [condition=ISABELLE_MLTON]
+    PAC_Checker_MLton
+  document_files
+    "root.tex"
+    "root.bib"
+  export_files (in "code") [1]
+    "PAC_Checker.PAC_Checker_MLton:**"
+
diff --git a/thys/PAC_Checker/WB_Sort.thy b/thys/PAC_Checker/WB_Sort.thy
new file mode 100644
--- /dev/null
+++ b/thys/PAC_Checker/WB_Sort.thy
@@ -0,0 +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" 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)
+
+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>
+  apply (induction xs)
+   apply simp
+  by (meson in_set_conv_iff less_le_trans)
+
+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 *)
+
+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)
+
+
+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: nth_rev)
+
+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))
+  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))
+  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
diff --git a/thys/PAC_Checker/code/parser.sml b/thys/PAC_Checker/code/parser.sml
new file mode 100644
--- /dev/null
+++ b/thys/PAC_Checker/code/parser.sml
@@ -0,0 +1,396 @@
+structure PAC_Parser =
+struct
+(*
+fun hashList hashA l = 
+    case l
+     of nil => 0wx0
+      | [a] => 0w1 + hashA a
+      | a1::a2::_ => 0w2 + 0w3853 * hashA a1 + 0wx1327 * hashA a2
+val hashChar = Word.fromInt o ord
+
+fun hashString s =
+    let val res = ref 0wx0;
+        val i = ref 0;
+    in
+      while !i < String.size s
+      do
+      (res := !res + hashChar (String.sub(s,!i));
+       res := !res * 0wx3853;
+       i := !i+1);
+      !res
+    end
+
+
+val hash : (string list, string list) HashTable.t ref = ref (HashTable.new {hash = hashList hashString, equals = op=});
+val hashvar : (string, string) HashTable.t ref = ref (HashTable.new {hash = hashString, equals = op=});
+val num_vars = ref 0;
+
+fun share_var t =
+    case HashTable.peek (!hashvar, t) of
+        SOME t => t
+      | NONE =>
+        let val new = Int.toString (!num_vars) in
+          (num_vars := 1 + !num_vars;
+           ignore (HashTable.insertIfNew(!hashvar, t, fn () => new, ignore));
+           new)
+        end
+
+
+fun share_term t =
+    case HashTable.peek (!hash, t) of
+        SOME t => t
+      | NONE => 
+        (case t of
+             [] => []
+           | x :: xs =>
+             (let
+               val xs' = share_term xs;
+               val x = share_var x; 
+              in
+                ignore (HashTable.insertIfNew(!hash, t, fn () => x::xs, ignore));
+                x :: xs'
+              end
+        ));
+
+
+val share_term = map share_var;
+*)
+
+val share_var = fn x => x
+val share_term = fn x => x;
+
+                                                            
+exception Parser_Error of string
+
+  fun is_digit c = c >= #"0" andalso c <= #"9";
+  fun is_zero c = (c = #"0");
+  fun digit_of_char c = Char.ord c - Char.ord #"0";
+
+  fun is_alpha c =
+      c >= #"a" andalso c <= #"z"
+      orelse c >= #"A" andalso c <= #"Z";
+
+  fun is_space c =
+      c = #" " orelse c = #"\t" orelse c = #"\n" orelse c = #"\r";
+
+  fun is_separator c =
+      c = #"*" orelse c = #"," orelse c = #";" orelse c = #"+" orelse c = #"-";
+
+  fun print2 a = ();
+  fun rev2 a = rev a;
+
+  fun skip_spaces istream =
+      (print2 "skip space";
+       if TextIO.lookahead(istream) = SOME #" "
+      then (TextIO.input1(istream); skip_spaces istream)
+      else ())
+
+
+  (* string_num is a very imperative to do the parser. We use is for 'string' until we need real
+  'strings'. Once we need them (to convert them to a number), we convert them via slices.
+
+   Compared to a string, it could also avoid allocating memory, although that does not seem to
+   happen.
+  *)
+  val resizable_str = ref (ArraySlice.slice(Array.tabulate (10, fn _ => #" "), 0, NONE));
+  fun double_string_size () =
+      let
+        fun new_val c =  if c >= ArraySlice.length (!resizable_str) then #" " else ArraySlice.sub(!resizable_str, c)
+        val c = ArraySlice.slice(Array.tabulate(2*ArraySlice.length (!resizable_str), new_val),0,NONE)
+      in
+        resizable_str := c
+      end
+  fun extract (arr, s, l) = ArraySlice.vector (ArraySlice.subslice (arr, s, l))
+  fun parse_natural istream =
+      let
+        val _ = print2 "parse_number\n"
+        val i = ref (0);
+        val seen_one_digit = ref false;
+        fun parse_aux () =
+            let val c = TextIO.lookahead istream
+            in
+              if (is_space (valOf c) orelse is_separator (valOf c) orelse not (is_digit (valOf c)))
+              then (print2 ("number sep = '" ^ String.implode [(valOf c)] ^"'"))
+              else
+                case TextIO.input1(istream) of
+                    NONE => raise Parser_Error "no number found"
+                  | SOME c =>
+                    ( (*print2 (String.implode [c] ^ " to be put at position" ^ Int.toString (!i));*)
+                     seen_one_digit := true;
+                     if !i < ArraySlice.length (!resizable_str) - 1
+                     then () else double_string_size ();
+                     ArraySlice.update(!resizable_str, !i, c);
+                     i := !i + 1;
+                     parse_aux ())
+            end
+      in
+        (parse_aux ();
+         if !seen_one_digit = false
+         then raise Parser_Error ("no number digit")
+         else
+           (print2 (extract(!resizable_str, 0, SOME (!i)) ^"\n");
+            (valOf (IntInf.fromString ((extract(!resizable_str, 0, SOME (!i))))))))
+      end
+
+  fun parse_nat istream =
+      let
+        val _ = print2 "parse_nat\n"
+        val num = ref 0;
+        val seen_one_digit = ref false;
+        fun parse_aux () =
+            let val c = TextIO.lookahead istream
+            in
+              if (is_space (valOf c) orelse is_separator (valOf c))
+              then (print2 ("number sep = '" ^ String.implode [(valOf c)] ^ "'"))
+              else
+                case TextIO.input1(istream) of
+                    NONE => raise Parser_Error "no number found"
+                  | SOME c =>
+                    if is_digit c
+                    then (seen_one_digit := true;
+                          num := !num* 10 + digit_of_char c;
+                          parse_aux ())
+                    else raise Parser_Error ("no number found, found " ^ String.implode [c])
+            end
+      in
+        (parse_aux ();
+         if !seen_one_digit = false
+         then raise Parser_Error ("no number digit")
+         else Uint64.fromInt (IntInf.fromInt(!num)))
+      end
+
+  fun parse_var istream =
+      let
+        val _ = print2 "parse_var\n"
+        val i = ref 0;
+        fun parse_aux () =
+            let val c = TextIO.lookahead istream
+            in
+              if (is_space (valOf c) orelse is_separator (valOf c))
+              then (print2 ("var sep = '" ^ String.implode [(valOf c)] ^ "'"))
+              else
+                case TextIO.input1(istream) of
+                    NONE => raise Parser_Error "no char found"
+                  | SOME c =>
+                     (if !i < ArraySlice.length (!resizable_str) - 1
+                     then () else double_string_size ();
+                     ArraySlice.update(!resizable_str, !i, c);
+                     i := !i + 1;
+                     parse_aux ())
+            end
+      in
+        (parse_aux ();
+         if !i = 0
+         then raise Parser_Error "no variable found"
+         else
+           (print2 (extract(!resizable_str, 0, SOME (!i)));
+             (extract(!resizable_str, 0, SOME (!i)))))
+      end;
+
+  fun parse_vars_only_monom istream = (* can start with /*/ *)
+      let
+        val _ = print2 "parse_vars_only_monom\n"
+        val vars = ref [];
+        fun parse_aux () =
+            let
+              val _ = skip_spaces istream;
+            in
+              if TextIO.lookahead(istream) = SOME #"," orelse TextIO.lookahead(istream) = SOME #";"
+                 orelse TextIO.lookahead(istream) = SOME #"-" orelse TextIO.lookahead(istream) = SOME #"+"
+              then (print2 ("parse_vars_only_monom, sep =" ^ String.implode [valOf (TextIO.lookahead(istream))] ^ "\n"))
+              else if TextIO.lookahead(istream) = SOME #"*"
+              then
+                (ignore (TextIO.input1(istream));
+                 vars := parse_var istream :: (!vars);
+                 parse_aux ())
+              else
+                (vars := parse_var istream :: (!vars);
+                 parse_aux ())
+            end
+      in
+        parse_aux ();
+        share_term (rev2 (!vars))
+      end;
+
+  fun parse_full_monom istream =
+      let
+        val _ = print2 "parse_full_monom\n"
+        val num = ref 1;
+        val vars = ref [];
+        val next_token = ref NONE;
+        val _ = skip_spaces istream;
+      in
+        (
+          next_token := TextIO.lookahead(istream);
+          print2 ("parse_full_monom/next token 1 = '" ^String.implode [valOf (!next_token)] ^ "'\n");
+          (case !next_token of
+               SOME #"-" =>
+               (ignore (TextIO.input1 istream);
+                num := ~1)
+             | SOME #"+" => ignore (TextIO.input1 istream)
+             | _ => ());
+          skip_spaces istream;
+          next_token := TextIO.lookahead(istream);
+          print2 ("parse_full_monom/next token 2 = '" ^String.implode [valOf (!next_token)] ^ "'\n");
+          if !next_token <> NONE andalso is_digit (valOf (!next_token))
+          then num := !num * parse_natural istream
+          else ();
+          vars := parse_vars_only_monom istream;
+          next_token := TextIO.lookahead(istream);
+          print2 ("parse_full_monom/next token 3 = '" ^String.implode [valOf (!next_token)] ^ "'\n");
+          (!vars, !num)
+        )
+      end;
+
+  fun parse_comma istream () =
+      let
+        val c1 = TextIO.input1(istream);
+        val c2 = skip_spaces istream;
+      in
+        if valOf c1 <> #","
+        then raise Parser_Error ("unrecognised ',', found '" ^ String.implode [valOf c1] ^ "'")
+        else ()
+      end
+
+          
+  fun parse_polynom istream : (string list * IntInf.int) list =
+      let
+        val _ = print2 "parse_poly\n"
+        val monoms = ref [];
+        fun parse_aux () =
+            if TextIO.lookahead(istream) = SOME #"," orelse TextIO.lookahead(istream) = SOME #";"
+            then print2 ("parse_poly finished"  ^ String.implode [valOf (TextIO.lookahead(istream))] ^ "\n")
+            else (monoms := parse_full_monom istream :: !monoms;
+                 parse_aux ())
+      in
+        (parse_aux ();
+        rev2 (!monoms))
+      end
+
+  fun parse_rule istream =
+      let val del = ref false;
+          val _ = skip_spaces istream;
+      in
+        case TextIO.input1(istream) of
+            SOME #"d" => (print2 "rule d:\n"; "d")
+          | SOME #"+" =>
+            (ignore (TextIO.input1 istream); print2 "rule +:\n"; "+:")
+          | SOME #"*" =>
+            (ignore (TextIO.input1 istream); print2 "rule *:\n";"*:")
+          | SOME #"=" =>
+            (print2 "rule =\n"; "=")
+          | SOME c => raise Parser_Error ("unrecognised rule '" ^ String.implode [c] ^ "'")
+      end
+
+  fun parse_EOL istream () =
+      let
+        val c1 = TextIO.input1(istream);
+        val _ = skip_spaces istream;
+        val c2 = TextIO.input1(istream);
+        fun f () =
+          (case TextIO.lookahead istream of
+               SOME #"\n" => (ignore (TextIO.input1 istream); f ())
+             | _ => ())
+      in
+        if c1 <> NONE andalso c2 <> NONE andalso (valOf c1 <> #";" orelse valOf c2 <> #"\n")
+        then raise Parser_Error ("unrecognised EOL '" ^ String.implode [valOf c1, valOf c2] ^ "'")
+        else f ()
+      end
+ 
+  fun parse_step istream =
+      let
+        val lbl = parse_nat istream;
+        val _ = print2 ("label = " ^ IntInf.toString (Uint64.toInt lbl));
+        val rule = parse_rule istream;
+        val _ = print2 ("rule = " ^ rule);
+      in
+        if  rule = "+:"
+        then
+          let
+            val _ = skip_spaces istream;
+            val src1 = parse_natural istream;
+            val _ = parse_comma istream ();
+            val src2 = parse_natural istream;
+            val _ = parse_comma istream ();
+            val poly = parse_polynom istream;
+            val _ = parse_EOL istream ();
+          in
+            (PAC_Checker.Add (src1, src2,
+                                   lbl,
+                                   (map (fn (a,b) => (a, PAC_Checker.Int_of_integer b)) poly)))
+          end
+        else if rule = "*:"
+        then
+          let
+            val _ = skip_spaces istream;
+            val src1 = parse_natural istream;
+            val _ = parse_comma istream ();
+            val src2 = parse_polynom istream;
+            val _ = parse_comma istream ();
+            val poly = parse_polynom istream;
+            val _ = parse_EOL istream ();
+          in
+           (PAC_Checker.Mult (src1,
+                                       (map (fn (a,b) => (a, PAC_Checker.Int_of_integer b)) src2),
+                                  lbl,
+                                  (map (fn (a,b) => (a, PAC_Checker.Int_of_integer b)) poly)))
+          end
+        else if rule = "d"
+        then
+          let
+            val _ = skip_spaces istream;
+            val _ = parse_EOL istream ();
+          in
+            (PAC_Checker.Del (lbl))
+          end
+        else if rule = "="
+        then
+          let
+            val _ = skip_spaces istream;
+            val var = parse_var istream;
+            val _ = parse_comma istream ();
+            val ext = parse_polynom istream;
+            val _ = parse_EOL istream ();
+          in
+           (PAC_Checker.Extension (lbl, var,
+                                       (map (fn (a,b) => (a, PAC_Checker.Int_of_integer b)) ext)))
+          end
+        else raise Parser_Error ("unrecognised rule '" ^ rule ^ "'")
+      end
+
+  fun step_polys istream =
+      let
+        val polys = ref [];
+        fun parse_aux () =
+            if TextIO.lookahead(istream) = NONE
+            then rev (!polys)
+            else (polys := parse_step istream :: (!polys);
+                  skip_spaces istream;
+                  parse_EOL istream;
+                  skip_spaces istream;
+                  parse_aux ())
+      in
+        parse_aux ()
+      end
+
+  fun input_poly istream : IntInf.int * (string list * IntInf.int) list =
+      let val a = parse_natural istream
+          val _ = skip_spaces istream
+          val b = (parse_polynom istream)
+          val _ = print2 ("parsed " ^ IntInf.toString a ^"\n")
+      in (a,b) end
+
+  fun input_polys istream =
+      let
+        val polys = ref [];
+        fun parse_aux () =
+            if TextIO.lookahead(istream) = NONE
+            then rev (!polys)
+            else (polys := input_poly istream :: (!polys);
+                  parse_EOL istream ();
+                  parse_aux ())
+      in
+        parse_aux ()
+      end
+
+end
diff --git a/thys/PAC_Checker/code/pasteque.mlb b/thys/PAC_Checker/code/pasteque.mlb
new file mode 100644
--- /dev/null
+++ b/thys/PAC_Checker/code/pasteque.mlb
@@ -0,0 +1,18 @@
+$(SML_LIB)/basis/basis.mlb
+$(SML_LIB)/basis/mlton.mlb 
+
+
+local
+  checker.ML
+in
+structure PAC_Checker
+structure Uint64
+end
+
+local
+  parser.sml
+in
+structure PAC_Parser
+end
+
+pasteque.sml
diff --git a/thys/PAC_Checker/code/pasteque.sml b/thys/PAC_Checker/code/pasteque.sml
new file mode 100644
--- /dev/null
+++ b/thys/PAC_Checker/code/pasteque.sml
@@ -0,0 +1,181 @@
+fun println x = print (x ^ "\n")
+
+
+fun print_help () = (
+  println ("Usage: pactrim [option] <file.polys> <file.pac> <file.spec>\n" ^
+           "    or pactrim --version\n" ^
+           "\n" ^
+           "Prints\n" ^
+           "s SUCCESSFULL: if everything worked\n" ^
+           "s FAILED, but correct PAC: if the PAC file is correct, but\n" ^
+           "\tthe spec was not derived\n" ^
+           "s PAC FAILED: if the PAC file is incorrect\n" ^
+           "\n" ^
+           "\n" ^
+           "Option:\n" ^
+           "--uloop (unsafe loop): use the non-verified loop instead of \n" ^
+           "\tthe verified loop. This is faster because the file does not\n" ^
+           "\t have to be parsed upfront.")
+)
+
+fun readfile istream =
+    let val a = TextIO.inputLine istream
+    in if a = NONE then [] else valOf a :: readfile istream
+    end
+
+
+fun print_poly [] = (print " + 0")
+  | print_poly ((i, m) :: xs) =
+    (print (IntInf.toString i ^" * ");
+     map print m;
+    print_poly xs)
+fun print_input_poly (lbl, poly) =
+    (println (Int.toString lbl); print_poly poly)
+
+fun parse_polys_file file_name = let
+  val istream = TextIO.openIn file_name
+  val a = map (fn x =>
+                  let val (lbl, poly) = x
+                  in
+                    (PAC_Checker.nat_of_integer lbl,
+                         map (fn (a,b) => (a, PAC_Checker.Int_of_integer b)) poly)
+                  end)
+              (PAC_Parser.input_polys istream)
+  val _ = TextIO.closeIn istream
+in
+  foldl (fn ((lbl, a), b) => PAC_Checker.pAC_update_impl lbl a b ()) (PAC_Checker.pAC_empty_impl ()) a
+end
+
+fun parse_pac_file file_name = let
+  val istream = TextIO.openIn file_name
+  val a = PAC_Parser.step_polys istream
+  val _ = TextIO.closeIn istream
+in
+  a
+end
+
+fun parse_spec_file file_name = let
+  val istream = TextIO.openIn file_name
+  val poly = PAC_Parser.parse_polynom istream
+  val _ = TextIO.closeIn istream
+in
+  map(fn (a,b) => (a, PAC_Checker.Int_of_integer b)) poly
+end
+
+fun print_stat polys_timer pac_timer end_of_init end_of_processing full =
+  let
+    fun print_timer d t = print ("c " ^ d ^ " (nonGC): " ^
+          Time.toString (Time.+ (#usr (#nongc t), #sys (#nongc t))) ^ " s = " ^
+          Time.toString (#usr (#nongc t)) ^ " s (usr) " ^
+          Time.toString (#sys (#nongc t)) ^ " s (sys)\n");
+    fun print_timer_GC d t = print ("c " ^ d ^ ": " ^
+          Time.toString (Time.+ (#usr (#gc t), #sys (#gc t))) ^ " s = " ^
+          Time.toString (#usr (#gc t)) ^ " s (usr) " ^
+          Time.toString (#sys (#gc t)) ^ " s (sys)\n");
+    fun print_full_timer d t = print ("c " ^ d ^ "(full): " ^
+                                      Time.toString (Time.+(Time.+ (#usr (#gc t), #sys (#gc t)),
+                                                      (Time.+ (#usr (#nongc t), #sys (#nongc t))))) ^ " s\n" );
+    val clock = Time.toSeconds (#usr (#nongc end_of_processing)) + Time.toSeconds (#sys (#nongc end_of_processing));
+     val _ = print "c\nc\nc ***** stats *****\n"
+     val _ = print_timer "parsing polys file init" polys_timer
+     val _ = print_timer "parsing pac file init" pac_timer
+     val _ = print_timer "full init" end_of_init
+     val _ = print_timer "time solving" end_of_processing
+     val _ = print_timer_GC "time GC" end_of_processing
+     val _ = print_full_timer "time solving" end_of_processing
+     val _ = print_timer "Overall" full
+     val _ = print_timer_GC "overall GC" full
+     val _ = print_full_timer "Overall" full
+  in
+   ()
+  end
+
+fun first (a, b) = a
+fun second (a, b) = b
+
+fun inside_loop [polys, pac, spec] =
+    let
+      val init_timer = Timer.startCPUTimer ();
+      val problem = parse_polys_file polys;
+      val polys_timer = Timer.checkCPUTimes init_timer;
+      val timer = Timer.startCPUTimer ();
+      val _ = println "c polys parsed\nc ******************"
+      val timer = Timer.startCPUTimer ();
+      val (spec0 : ((string list * PAC_Checker.int) list)) = parse_spec_file spec;
+      val _ = println "c spec parsed";
+      val end_of_init = Timer.checkCPUTimes init_timer;
+      val timer = Timer.startCPUTimer ();
+      val _ = println "c Now checking";
+      val spec = PAC_Checker.fully_normalize_poly_impl spec0 ();
+      val vars = PAC_Checker.empty_vars_impl ();
+      val (b, (vars, polys)) = PAC_Checker.remap_polys_l_impl spec vars problem ();
+      val vars = PAC_Checker.union_vars_poly_impl spec0 vars ()
+      val state = ref (b, (vars, polys))
+      val istream = TextIO.openIn pac
+      val _ =
+          while (TextIO.lookahead(istream) <> NONE andalso PAC_Checker.is_cfailed (first (!state)) = false)
+                do
+                let
+                  val st = PAC_Parser.parse_step istream;
+                  val (b, (vars, a)) = !state;
+                in
+                  state := PAC_Checker.check_step_impl spec b vars a st ()
+                end;
+      val (b, _) = !state;
+      val _ = if PAC_Checker.is_cfound b then println "s SUCCESSFULL"
+              else if (PAC_Checker.is_cfailed b) = false then println "s FAILED, but correct PAC"
+              else (println "s PAC FAILED"; println (PAC_Checker.implode (PAC_Checker.the_error b)))
+      val end_of_processing = Timer.checkCPUTimes timer
+      val full = Timer.checkCPUTimes init_timer
+  val _ = print_stat polys_timer polys_timer end_of_init end_of_processing full
+    in ()
+    end
+
+fun checker [polys, pac, spec] = let
+  val init_timer = Timer.startCPUTimer ();
+  val problem = parse_polys_file polys;
+  val polys_timer = Timer.checkCPUTimes init_timer;
+  val timer = Timer.startCPUTimer ();
+  val _ = println "c polys parsed\nc ******************"
+  val pac : (((string list * PAC_Checker.int) list, string, Uint64.uint64) PAC_Checker.pac_step) list = parse_pac_file pac;
+(*  val _ = MLton.share pac; *)
+  val _ = println "c pac parsed"
+  val pac_timer = Timer.checkCPUTimes timer;
+  val timer = Timer.startCPUTimer ();
+  val (spec : ((string list * PAC_Checker.int) list)) = parse_spec_file spec;
+  val _ = println "c spec parsed";
+  val end_of_init = Timer.checkCPUTimes init_timer;
+  val timer = Timer.startCPUTimer ();
+  val _ = println "c Now checking";
+  val (b, _) = PAC_Checker.full_checker_l_impl spec problem pac ();
+  val _ = if PAC_Checker.is_cfound b then println "s SUCCESSFULL"
+          else if (PAC_Checker.is_cfailed b) = false then println "s FAILED, but correct PAC"
+          else (println "s PAC FAILED"; println (PAC_Checker.implode (PAC_Checker.the_error b)))
+  val end_of_processing = Timer.checkCPUTimes timer
+  val full = Timer.checkCPUTimes init_timer
+  val _ = print_stat polys_timer pac_timer end_of_init end_of_processing full
+  in
+    ()
+end
+  handle PAC_Parser.Parser_Error err => print("parsing failed with error: " ^ err)
+
+fun process_args [arg, polys, pac, spec] =
+    if arg = "--iloop" orelse arg = "--uloop"
+    then inside_loop [polys, pac, spec]
+    else print_help()
+  | process_args [polys, pac, spec] =
+    checker [polys, pac, spec]
+  | process_args [arg] =
+    if arg = "--version" orelse arg = "-v" orelse arg = "-version"
+    then println (PAC_Checker.version)
+    else print_help()
+  | process_args [] = print_help()
+
+fun main () = let
+  val args = CommandLine.arguments ();
+in
+  process_args args
+end
+
+
+val _ = if MLton.isMLton then main() else ()
diff --git a/thys/PAC_Checker/document/root.bib b/thys/PAC_Checker/document/root.bib
new file mode 100644
--- /dev/null
+++ b/thys/PAC_Checker/document/root.bib
@@ -0,0 +1,10 @@
+@inproceedings{KaufmannFleuryBiere-FMCAD20,
+  author    = {Daniela Kaufmann and Mathias Fleury and
+               Armin Biere},
+  editor    = {Ofer Strichman and Alexander Ivrii},
+  title     = {The Proof Checkers Pacheck and Pasteque for the Practical Algebraic Calculus},
+  booktitle = {Formal Methods in Computer-Aided Design, {FMCAD} 2020, September 21-24, 2020.},
+  publisher = {IEEE},
+  year      = {2020},
+}
+}
diff --git a/thys/PAC_Checker/document/root.tex b/thys/PAC_Checker/document/root.tex
new file mode 100644
--- /dev/null
+++ b/thys/PAC_Checker/document/root.tex
@@ -0,0 +1,109 @@
+%Some LaTeX checking: no bad pratices
+%\RequirePackage[l2tabu, orthodox]{nag}
+%\RequirePackage[all,error]{onlyamsmath}
+\RequirePackage{fixltx2e}
+
+\documentclass[11pt,a4paper]{article}
+\usepackage{isabelle,isabellesym}
+
+% further packages required for unusual symbols (see also
+% isabellesym.sty), use only when needed
+
+% lualatex
+%\usepackage{spelling}
+\usepackage{fullpage}
+\usepackage{graphicx}
+\usepackage{comment}
+
+
+\usepackage{mdframed}
+%% Saisie en UTF-8
+\usepackage[utf8]{inputenc}
+\usepackage[T1]{fontenc}
+\usepackage{lmodern}
+\usepackage{subcaption}
+
+%% Pour composer des mathématiques
+\usepackage{amsmath,amssymb, amsthm}
+\usepackage{nicefrac}
+\usepackage{tikz}
+\usetikzlibrary{decorations, arrows, shapes, automata, mindmap, trees}
+  %for \<leadsto>, \<box>, \<diamond>, \<sqsupset>, \<mho>, \<Join>,
+  %\<lhd>, \<lesssim>, \<greatersim>, \<lessapprox>, \<greaterapprox>,
+  %\<triangleq>, \<yen>, \<lozenge>
+
+%\usepackage{eurosym}
+  %for \<euro>
+
+\usepackage[only,bigsqcap]{stmaryrd}
+  %for \<Sqinter>
+\usepackage{wasysym}
+
+%\usepackage{eufrak}
+  %for \<AA> ... \<ZZ>, \<aa> ... \<zz> (also included in amssymb)
+
+%\usepackage{textcomp}
+  %for \<onequarter>, \<onehalf>, \<threequarters>, \<degree>, \<cent>,
+  %\<currency>
+
+\usepackage[english]{babel}
+% this should be the last package used
+\usepackage{pdfsetup}
+
+% urls in roman style, theory text in math-similar italics
+\urlstyle{rm}
+\isabellestyle{it}
+
+% for uniform font size
+%\renewcommand{\isastyle}{\isastyleminor}
+\let\set\mathbb
+\newcommand{\mailto}[1]{\href{mailto:#1}{#1}}
+
+\newcommand{\shortrules}[3]{#2$\Rightarrow^{\text{#1}}$ #3}
+\newcommand{\isasymRes}{\ensuremath{\text{Res}}} 
+
+\begin{document}
+
+
+
+\title{PAC Checker}
+\author{Mathias Fleury and Daniela Kaufmann}
+\maketitle
+
+\begin{abstract}
+  Generating and checking proof certificates is important to
+  increase the trust in automated reasoning tools. In recent years
+  formal verification using computer algebra became more important and
+  is heavily used in automated circuit verification.  An existing
+  proof format which covers algebraic reasoning and allows efficient
+  proof checking is the practical algebraic calculus. In this
+  development, we present the verified checker Pastèque that is
+  obtained by synthesis via the Refinement Framework.
+
+  This is the formalization going with our FMCAD'20 tool presentation~\cite{KaufmannFleuryBiere-FMCAD20}.
+\end{abstract}
+
+\tableofcontents
+
+% sane default for proof documents
+\parindent 0pt\parskip 0.5ex
+
+% generated text of all theories
+\input{session}
+
+
+{\section*{Acknowledgment}
+This work is supported by Austrian Science Fund (FWF), NFN S11408-N23
+(RiSE), and LIT AI Lab funded by the State of Upper Austria.
+}
+
+% optional bibliography
+\bibliographystyle{abbrv}
+\bibliography{root}
+
+\end{document}
+
+%%% Local Variables:
+%%% mode: latex
+%%% TeX-master: t
+%%% End:
diff --git a/thys/ROOTS b/thys/ROOTS
--- a/thys/ROOTS
+++ b/thys/ROOTS
@@ -1,551 +1,552 @@
 ADS_Functor
 AODV
 AVL-Trees
 AWN
 Abortable_Linearizable_Modules
 Abs_Int_ITP2012
 Abstract-Hoare-Logics
 Abstract-Rewriting
 Abstract_Completeness
 Abstract_Soundness
 Adaptive_State_Counting
 Affine_Arithmetic
 Aggregation_Algebras
 Akra_Bazzi
 Algebraic_Numbers
 Algebraic_VCs
 Allen_Calculus
 Amicable_Numbers
 Amortized_Complexity
 AnselmGod
 Applicative_Lifting
 Approximation_Algorithms
 Architectural_Design_Patterns
 Aristotles_Assertoric_Syllogistic
 Arith_Prog_Rel_Primes
 ArrowImpossibilityGS
 Attack_Trees
 Auto2_HOL
 Auto2_Imperative_HOL
 AutoFocus-Stream
 Automated_Stateful_Protocol_Verification
 Automatic_Refinement
 AxiomaticCategoryTheory
 BDD
 BNF_CC
 BNF_Operations
 Banach_Steinhaus
 Bell_Numbers_Spivey
 Berlekamp_Zassenhaus
 Bernoulli
 Bertrands_Postulate
 Bicategory
 BinarySearchTree
 Binding_Syntax_Theory
 Binomial-Heaps
 Binomial-Queues
 Bondy
 Boolean_Expression_Checkers
 Bounded_Deducibility_Security
 Buchi_Complementation
 Budan_Fourier
 Buffons_Needle
 Buildings
 BytecodeLogicJmlTypes
 C2KA_DistributedSystems
 CAVA_Automata
 CAVA_LTL_Modelchecker
 CCS
 CISC-Kernel
 CRDT
 CYK
 CakeML
 CakeML_Codegen
 Call_Arity
 Card_Equiv_Relations
 Card_Multisets
 Card_Number_Partitions
 Card_Partitions
 Cartan_FP
 Case_Labeling
 Catalan_Numbers
 Category
 Category2
 Category3
 Cauchy
 Cayley_Hamilton
 Certification_Monads
 Chandy_Lamport
 Chord_Segments
 Circus
 Clean
 ClockSynchInst
 Closest_Pair_Points
 CofGroups
 Coinductive
 Coinductive_Languages
 Collections
 Comparison_Sort_Lower_Bound
 Compiling-Exceptions-Correctly
 Complete_Non_Orders
 Completeness
 Complex_Geometry
 Complx
 ComponentDependencies
 ConcurrentGC
 ConcurrentIMP
 Concurrent_Ref_Alg
 Concurrent_Revisions
 Consensus_Refined
 Constructive_Cryptography
 Constructor_Funs
 Containers
 CoreC++
 Core_DOM
 Count_Complex_Roots
 CryptHOL
 CryptoBasedCompositionalProperties
 DFS_Framework
 DPT-SAT-Solver
 DataRefinementIBP
 Datatype_Order_Generator
 Decl_Sem_Fun_PL
 Decreasing-Diagrams
 Decreasing-Diagrams-II
 Deep_Learning
 Density_Compiler
 Dependent_SIFUM_Refinement
 Dependent_SIFUM_Type_Systems
 Depth-First-Search
 Derangements
 Deriving
 Descartes_Sign_Rule
 Dict_Construction
 Differential_Dynamic_Logic
 Differential_Game_Logic
 Dijkstra_Shortest_Path
 Diophantine_Eqns_Lin_Hom
 Dirichlet_L
 Dirichlet_Series
 DiscretePricing
 Discrete_Summation
 DiskPaxos
 DynamicArchitectures
 Dynamic_Tables
 E_Transcendental
 Echelon_Form
 EdmondsKarp_Maxflow
 Efficient-Mergesort
 Elliptic_Curves_Group_Law
 Encodability_Process_Calculi
 Epistemic_Logic
 Ergodic_Theory
 Error_Function
 Euler_MacLaurin
 Euler_Partition
 Example-Submission
 FFT
 FLP
 FOL-Fitting
 FOL_Harrison
 FOL_Seq_Calc1
 Factored_Transition_System_Bounding
 Falling_Factorial_Sum
 Farkas
 FeatherweightJava
 Featherweight_OCL
 Fermat3_4
 FileRefinement
 FinFun
 Finger-Trees
 Finite_Automata_HF
 First_Order_Terms
 First_Welfare_Theorem
 Fishburn_Impossibility
 Fisher_Yates
 Flow_Networks
 Floyd_Warshall
 Flyspeck-Tame
 FocusStreamsCaseStudies
 Forcing
 Formal_SSA
 Formula_Derivatives
 Fourier
 Free-Boolean-Algebra
 Free-Groups
 FunWithFunctions
 FunWithTilings
 Functional-Automata
 Functional_Ordered_Resolution_Prover
 Furstenberg_Topology
 GPU_Kernel_PL
 Gabow_SCC
 Game_Based_Crypto
 Gauss-Jordan-Elim-Fun
 Gauss_Jordan
 Gauss_Sums
 Gaussian_Integers
 GenClock
 General-Triangle
 Generalized_Counting_Sort
 Generic_Deriving
 Generic_Join
 GewirthPGCProof
 Girth_Chromatic
 GoedelGod
 Goodstein_Lambda
 GraphMarkingIBP
 Graph_Saturation
 Graph_Theory
 Green
 Groebner_Bases
 Groebner_Macaulay
 Gromov_Hyperbolicity
 Group-Ring-Module
 HOL-CSP
 HOLCF-Prelude
 HRB-Slicing
 Heard_Of
 Hello_World
 HereditarilyFinite
 Hermite
 Hidden_Markov_Models
 Higher_Order_Terms
 Hoare_Time
 HotelKeyCards
 Huffman
 Hybrid_Logic
 Hybrid_Multi_Lane_Spatial_Logic
 Hybrid_Systems_VCs
 HyperCTL
 IEEE_Floating_Point
 IMAP-CRDT
 IMO2019
 IMP2
 IMP2_Binary_Heap
 IP_Addresses
 Imperative_Insertion_Sort
 Impossible_Geometry
 Incompleteness
 Incredible_Proof_Machine
 Inductive_Confidentiality
 InfPathElimination
 InformationFlowSlicing
 InformationFlowSlicing_Inter
 Integration
 Interval_Arithmetic_Word32
 Iptables_Semantics
 Irrational_Series_Erdos_Straus
 Irrationality_J_Hancl
 Isabelle_C
 Isabelle_Meta_Model
 Jacobson_Basic_Algebra
 Jinja
 JinjaThreads
 JiveDataStoreModel
 Jordan_Hoelder
 Jordan_Normal_Form
 KAD
 KAT_and_DRA
 KBPs
 KD_Tree
 Key_Agreement_Strong_Adversaries
 Kleene_Algebra
 Knot_Theory
 Knuth_Bendix_Order
 Knuth_Morris_Pratt
 Koenigsberg_Friendship
 Kruskal
 Kuratowski_Closure_Complement
 LLL_Basis_Reduction
 LLL_Factorization
 LOFT
 LTL
 LTL_Master_Theorem
 LTL_Normal_Form
 LTL_to_DRA
 LTL_to_GBA
 Lam-ml-Normalization
 LambdaAuth
 LambdaMu
 Lambda_Free_EPO
 Lambda_Free_KBOs
 Lambda_Free_RPOs
 Lambert_W
 Landau_Symbols
 Laplace_Transform
 Latin_Square
 LatticeProperties
 Launchbury
 Lazy-Lists-II
 Lazy_Case
 Lehmer
 Lifting_Definition_Option
 LightweightJava
 LinearQuantifierElim
 Linear_Inequalities
 Linear_Programming
 Linear_Recurrences
 Liouville_Numbers
 List-Index
 List-Infinite
 List_Interleaving
 List_Inversions
 List_Update
 LocalLexing
 Localization_Ring
 Locally-Nameless-Sigma
 Lowe_Ontological_Argument
 Lower_Semicontinuous
 Lp
 Lucas_Theorem
 MFMC_Countable
 MFODL_Monitor_Optimized
 MFOTL_Monitor
 MSO_Regex_Equivalence
 Markov_Models
 Marriage
 Mason_Stothers
 Matrices_for_ODEs
 Matrix
 Matrix_Tensor
 Matroids
 Max-Card-Matching
 Median_Of_Medians_Selection
 Menger
 Mersenne_Primes
 MiniML
 Minimal_SSA
 Minkowskis_Theorem
 Minsky_Machines
 Modal_Logics_for_NTS
 Modular_Assembly_Kit_Security
 Monad_Memo_DP
 Monad_Normalisation
 MonoBoolTranAlgebra
 MonoidalCategory
 Monomorphic_Monad
 MuchAdoAboutTwo
 Multi_Party_Computation
 Multirelations
 Myhill-Nerode
 Name_Carrying_Type_Inference
 Nash_Williams
 Nat-Interval-Logic
 Native_Word
 Nested_Multisets_Ordinals
 Network_Security_Policy_Verification
 Neumann_Morgenstern_Utility
 No_FTL_observers
 Nominal2
 Noninterference_CSP
 Noninterference_Concurrent_Composition
 Noninterference_Generic_Unwinding
 Noninterference_Inductive_Unwinding
 Noninterference_Ipurge_Unwinding
 Noninterference_Sequential_Composition
 NormByEval
 Nullstellensatz
 Octonions
 OpSets
 Open_Induction
 Optics
 Optimal_BST
 Orbit_Stabiliser
 Order_Lattice_Props
 Ordered_Resolution_Prover
 Ordinal
 Ordinal_Partitions
 Ordinals_and_Cardinals
 Ordinary_Differential_Equations
 PCF
 PLM
 POPLmark-deBruijn
 PSemigroupsConvolution
+PAC_Checker
 Pairing_Heap
 Paraconsistency
 Parity_Game
 Partial_Function_MR
 Partial_Order_Reduction
 Password_Authentication_Protocol
 Pell
 Perfect-Number-Thm
 Perron_Frobenius
 Pi_Calculus
 Pi_Transcendental
 Planarity_Certificates
 Poincare_Bendixson
 Poincare_Disc
 Polynomial_Factorization
 Polynomial_Interpolation
 Polynomials
 Pop_Refinement
 Posix-Lexing
 Possibilistic_Noninterference
 Power_Sum_Polynomials
 Pratt_Certificate
 Presburger-Automata
 Prim_Dijkstra_Simple
 Prime_Distribution_Elementary
 Prime_Harmonic_Series
 Prime_Number_Theorem
 Priority_Queue_Braun
 Priority_Search_Trees
 Probabilistic_Noninterference
 Probabilistic_Prime_Tests
 Probabilistic_System_Zoo
 Probabilistic_Timed_Automata
 Probabilistic_While
 Program-Conflict-Analysis
 Projective_Geometry
 Promela
 Proof_Strategy_Language
 PropResPI
 Propositional_Proof_Systems
 Prpu_Maxflow
 PseudoHoops
 Psi_Calculi
 Ptolemys_Theorem
 QHLProver
 QR_Decomposition
 Quantales
 Quaternions
 Quick_Sort_Cost
 RIPEMD-160-SPARK
 ROBDD
 RSAPSS
 Ramsey-Infinite
 Random_BSTs
 Random_Graph_Subgraph_Threshold
 Randomised_BSTs
 Randomised_Social_Choice
 Rank_Nullity_Theorem
 Real_Impl
 Recursion-Addition
 Recursion-Theory-I
 Refine_Imperative_HOL
 Refine_Monadic
 RefinementReactive
 Regex_Equivalence
 Regular-Sets
 Regular_Algebras
 Relation_Algebra
 Relational-Incorrectness-Logic
 Relational_Disjoint_Set_Forests
 Relational_Paths
 Rep_Fin_Groups
 Residuated_Lattices
 Resolution_FOL
 Rewriting_Z
 Ribbon_Proofs
 Robbins-Conjecture
 Root_Balanced_Tree
 Routing
 Roy_Floyd_Warshall
 SATSolverVerification
 SDS_Impossibility
 SIFPL
 SIFUM_Type_Systems
 SPARCv8
 Safe_Distance
 Safe_OCL
 Saturation_Framework
 Secondary_Sylow
 Security_Protocol_Refinement
 Selection_Heap_Sort
 SenSocialChoice
 Separata
 Separation_Algebra
 Separation_Logic_Imperative_HOL
 SequentInvertibility
 Shivers-CFA
 ShortestPath
 Show
 Sigma_Commit_Crypto
 Signature_Groebner
 Simpl
 Simple_Firewall
 Simplex
 Skew_Heap
 Skip_Lists
 Slicing
 Sliding_Window_Algorithm
 Smith_Normal_Form
 Smooth_Manifolds
 Sort_Encodings
 Source_Coding_Theorem
 Special_Function_Bounds
 Splay_Tree
 Sqrt_Babylonian
 Stable_Matching
 Statecharts
 Stateful_Protocol_Composition_and_Typing
 Stellar_Quorums
 Stern_Brocot
 Stewart_Apollonius
 Stirling_Formula
 Stochastic_Matrices
 Stone_Algebras
 Stone_Kleene_Relation_Algebras
 Stone_Relation_Algebras
 Store_Buffer_Reduction
 Stream-Fusion
 Stream_Fusion_Code
 Strong_Security
 Sturm_Sequences
 Sturm_Tarski
 Stuttering_Equivalence
 Subresultants
 Subset_Boolean_Algebras
 SumSquares
 SuperCalc
 Surprise_Paradox
 Symmetric_Polynomials
 Szpilrajn
 TESL_Language
 TLA
 Tail_Recursive_Functions
 Tarskis_Geometry
 Taylor_Models
 Timed_Automata
 Topology
 TortoiseHare
 Transcendence_Series_Hancl_Rucki
 Transformer_Semantics
 Transition_Systems_and_Automata
 Transitive-Closure
 Transitive-Closure-II
 Treaps
 Tree-Automata
 Tree_Decomposition
 Triangle
 Trie
 Twelvefold_Way
 Tycon
 Types_Tableaus_and_Goedels_God
 UPF
 UPF_Firewall
 UTP
 Universal_Turing_Machine
 UpDown_Scheme
 Valuation
 VectorSpace
 VeriComp
 Verified-Prover
 VerifyThis2018
 VerifyThis2019
 Vickrey_Clarke_Groves
 VolpanoSmith
 WHATandWHERE_Security
 WOOT_Strong_Eventual_Consistency
 WebAssembly
 Weight_Balanced_Trees
 Well_Quasi_Orders
 Winding_Number_Eval
 Word_Lib
 WorkerWrapper
 XML
 ZFC_in_HOL
 Zeta_3_Irrational
 Zeta_Function
 pGCL