diff --git a/thys/CAVA_Automata/Digraph_Basic.thy b/thys/CAVA_Automata/Digraph_Basic.thy
--- a/thys/CAVA_Automata/Digraph_Basic.thy
+++ b/thys/CAVA_Automata/Digraph_Basic.thy
@@ -1,695 +1,692 @@
 section \<open>Relations interpreted as Directed Graphs\<close>
 theory Digraph_Basic
 imports   
   "Automatic_Refinement.Misc"
   "Automatic_Refinement.Refine_Util"
   "HOL-Library.Omega_Words_Fun"
 begin
 
 text \<open>
   This theory contains some basic graph theory on directed graphs which are 
   modeled as a relation between nodes. 
 
   The theory here is very fundamental, and 
   also used by non-directly graph-related applications like the theory of 
   tail-recursion in the Refinement Framework. Thus, we decided to put it 
   in the basic theories of the refinement framework.
 \<close>
 
 
 text \<open>Directed graphs are modeled as a relation on nodes\<close>
 type_synonym 'v digraph = "('v\<times>'v) set"
 
 locale digraph = fixes E :: "'v digraph"
 
 subsection \<open>Paths\<close>
 text \<open>Path are modeled as list of nodes, the last node of a path is not included
   into the list. This formalization allows for nice concatenation and splitting
   of paths.\<close>
 inductive path :: "'v digraph \<Rightarrow> 'v \<Rightarrow> 'v list \<Rightarrow> 'v \<Rightarrow> bool" for E where
   path0: "path E u [] u"
 | path_prepend: "\<lbrakk> (u,v)\<in>E; path E v l w \<rbrakk> \<Longrightarrow> path E u (u#l) w"
 
 lemma path1: "(u,v)\<in>E \<Longrightarrow> path E u [u] v"
   by (auto intro: path.intros)
 
 lemma path_empty_conv[simp]:
   "path E u [] v \<longleftrightarrow> u=v"
   by (auto intro: path0 elim: path.cases)
 
 inductive_cases path_uncons: "path E u (u'#l) w"
 inductive_simps path_cons_conv: "path E u (u'#l) w"
 
 lemma path_no_edges[simp]: "path {} u p v \<longleftrightarrow> (u=v \<and> p=[])"
   by (cases p) (auto simp: path_cons_conv)
 
 lemma path_conc: 
   assumes P1: "path E u la v" 
   assumes P2: "path E v lb w"
   shows "path E u (la@lb) w"
   using P1 P2 apply induct 
   by (auto intro: path.intros)
   
 lemma path_append:
   "\<lbrakk> path E u l v; (v,w)\<in>E \<rbrakk> \<Longrightarrow> path E u (l@[v]) w"
   using path_conc[OF _ path1] .
 
 lemma path_unconc:
   assumes "path E u (la@lb) w"
   obtains v where "path E u la v" and "path E v lb w"
   using assms 
   thm path.induct
   apply (induct u "la@lb" w arbitrary: la lb rule: path.induct)
   apply (auto intro: path.intros elim!: list_Cons_eq_append_cases)
   done
 
 lemma path_conc_conv: 
   "path E u (la@lb) w \<longleftrightarrow> (\<exists>v. path E u la v \<and> path E v lb w)"
   by (auto intro: path_conc elim: path_unconc)
 
 lemma (in -) path_append_conv: "path E u (p@[v]) w \<longleftrightarrow> (path E u p v \<and> (v,w)\<in>E)"
   by (simp add: path_cons_conv path_conc_conv)
 
 lemmas path_simps = path_empty_conv path_cons_conv path_conc_conv
 
 
 lemmas path_trans[trans] = path_prepend path_conc path_append
 lemma path_from_edges: "\<lbrakk>(u,v)\<in>E; (v,w)\<in>E\<rbrakk> \<Longrightarrow> path E u [u] v" 
   by (auto simp: path_simps)
 
 
 lemma path_edge_cases[case_names no_use split]: 
   assumes "path (insert (u,v) E) w p x"
   obtains 
     "path E w p x" 
   | p1 p2 where "path E w p1 u" "path (insert (u,v) E) v p2 x"
   using assms
   apply induction
   apply simp
   apply (clarsimp)
   apply (metis path_simps path_cons_conv)
   done
 
 lemma path_edge_rev_cases[case_names no_use split]: 
   assumes "path (insert (u,v) E) w p x"
   obtains 
     "path E w p x" 
   | p1 p2 where "path (insert (u,v) E) w p1 u" "path E v p2 x"
   using assms
   apply (induction p arbitrary: x rule: rev_induct)
   apply simp
   apply (clarsimp simp: path_cons_conv path_conc_conv)
   apply (metis path_simps path_append_conv)
   done
 
 
 lemma path_mono: 
   assumes S: "E\<subseteq>E'" 
   assumes P: "path E u p v" 
   shows "path E' u p v"
   using P
   apply induction
   apply simp
   using S
   apply (auto simp: path_cons_conv)
   done
 
 lemma path_is_rtrancl: 
   assumes "path E u l v"
   shows "(u,v)\<in>E\<^sup>*"
   using assms 
   by induct auto
 
 lemma rtrancl_is_path:
   assumes "(u,v)\<in>E\<^sup>*"
   obtains l where "path E u l v"
   using assms 
   by induct (auto intro: path0 path_append)
 
 lemma path_is_trancl: 
   assumes "path E u l v"
   and "l\<noteq>[]"
   shows "(u,v)\<in>E\<^sup>+"
   using assms 
   apply induct
   apply auto []
   apply (case_tac l)
   apply auto
   done
 
 lemma trancl_is_path:
   assumes "(u,v)\<in>E\<^sup>+"
   obtains l where "l\<noteq>[]" and "path E u l v"
   using assms 
   by induct (auto intro: path0 path_append)
 
 lemma path_nth_conv: "path E u p v \<longleftrightarrow> (let p'=p@[v] in
   u=p'!0 \<and>
   (\<forall>i<length p' - 1. (p'!i,p'!Suc i)\<in>E))"
   apply (induct p arbitrary: v rule: rev_induct)
   apply (auto simp: path_conc_conv path_cons_conv nth_append)
   done
 
 lemma path_mapI:
   assumes "path E u p v"
   shows "path (pairself f ` E) (f u) (map f p) (f v)"
   using assms
   apply induction
   apply (simp)
   apply (force simp: path_cons_conv)
   done
 
 lemma path_restrict: 
   assumes "path E u p v" 
   shows "path (E \<inter> set p \<times> insert v (set (tl p))) u p v"
   using assms
 proof induction
   print_cases
   case (path_prepend u v p w)
   from path_prepend.IH have "path (E \<inter> set (u#p) \<times> insert w (set p)) v p w"
     apply (rule path_mono[rotated])
     by (cases p) auto
   thus ?case using \<open>(u,v)\<in>E\<close>
     by (cases p) (auto simp add: path_cons_conv)
 qed auto
 
 lemma path_restrict_closed:
   assumes CLOSED: "E``D \<subseteq> D"
   assumes I: "v\<in>D" and P: "path E v p v'"
   shows "path (E\<inter>D\<times>D) v p v'"
   using P CLOSED I
   by induction (auto simp: path_cons_conv)
 
 
 lemma path_set_induct:
   assumes "path E u p v" and "u\<in>I" and "E``I \<subseteq> I"
   shows "set p \<subseteq> I"
   using assms
   by (induction rule: path.induct) auto
 
 lemma path_nodes_reachable: "path E u p v \<Longrightarrow> insert v (set p) \<subseteq> E\<^sup>*``{u}"
   apply (auto simp: in_set_conv_decomp path_cons_conv path_conc_conv)
   apply (auto dest!: path_is_rtrancl)
   done
 
 lemma path_nodes_edges: "path E u p v \<Longrightarrow> set p \<subseteq> fst`E"
   by (induction rule: path.induct) auto
 
 lemma path_tl_nodes_edges: 
   assumes "path E u p v"
   shows "set (tl p) \<subseteq> fst`E \<inter> snd`E"
 proof -
   from path_nodes_edges[OF assms] have "set (tl p) \<subseteq> fst`E"
     by (cases p) auto
 
   moreover have "set (tl p) \<subseteq> snd`E"
     using assms
     apply (cases)
     apply simp
     apply simp
     apply (erule path_set_induct[where I = "snd`E"])
     apply auto
     done
   ultimately show ?thesis
     by auto
 qed
 
 lemma path_loop_shift: 
   assumes P: "path E u p u"
   assumes S: "v\<in>set p"
   obtains p' where "set p' = set p" "path E v p' v"
 proof -
   from S obtain p1 p2 where [simp]: "p = p1@v#p2" by (auto simp: in_set_conv_decomp)
   from P obtain v' where A: "path E u p1 v" "(v, v') \<in> E" "path E v' p2 u" 
     by (auto simp: path_simps)
   hence "path E v (v#p2@p1) v" by (auto simp: path_simps)
   thus ?thesis using that[of "v#p2@p1"] by auto
 qed
 
 lemma path_hd:
   assumes "p \<noteq> []" "path E v p w"
   shows "hd p = v"
   using assms
   by (auto simp: path_cons_conv neq_Nil_conv)
 
 
 lemma path_last_is_edge:
   assumes "path E x p y"
   and "p \<noteq> []"
   shows "(last p, y) \<in> E"
   using assms
   by (auto simp: neq_Nil_rev_conv path_simps)
 
 lemma path_member_reach_end:
   assumes P: "path E x p y"
   and v: "v \<in> set p"
   shows "(v,y) \<in> E\<^sup>+"
   using assms 
   by (auto intro!: path_is_trancl simp: in_set_conv_decomp path_simps)
 
 lemma path_tl_induct[consumes 2, case_names single step]:
   assumes P: "path E x p y"
   and NE: "x \<noteq> y"
   and S: "\<And>u. (x,u) \<in> E \<Longrightarrow> P x u"
   and ST: "\<And>u v. \<lbrakk>(x,u) \<in> E\<^sup>+; (u,v) \<in> E; P x u\<rbrakk> \<Longrightarrow> P x v"
   shows "P x y \<and> (\<forall> v \<in> set (tl p). P x v)"
 proof -
   from P NE have "p \<noteq> []" by auto
   thus ?thesis using P
   proof (induction p arbitrary: y rule: rev_nonempty_induct)
     case (single u) hence "(x,y) \<in> E" by (simp add: path_cons_conv)
     with S show ?case by simp
   next
     case (snoc u us) hence "path E x us u" by (simp add: path_append_conv)
     with snoc path_is_trancl have 
       "P x u" "(x,u) \<in> E\<^sup>+" "\<forall>v \<in> set (tl us). P x v" 
       by simp_all
     moreover with snoc have "\<forall>v \<in> set (tl (us@[u])). P x v" by simp
     moreover from snoc have "(u,y) \<in> E" by (simp add: path_append_conv)
     ultimately show ?case by (auto intro: ST)
   qed
 qed
 
 
 lemma path_restrict_tl: 
   "\<lbrakk> u\<notin>R; path (E \<inter> UNIV \<times> -R) u p v \<rbrakk> \<Longrightarrow> path (rel_restrict E R) u p v"
   apply (induction p arbitrary: u)
   apply (auto simp: path_simps rel_restrict_def)
   done
 
 lemma path1_restr_conv: "path (E\<inter>UNIV \<times> -R) u (x#xs) v 
   \<longleftrightarrow> (\<exists>w. w\<notin>R \<and> x=u \<and> (u,w)\<in>E \<and> path (rel_restrict E R) w xs v)"
 proof -
   have 1: "rel_restrict E R \<subseteq> E \<inter> UNIV \<times> - R" by (auto simp: rel_restrict_def)
 
   show ?thesis
     by (auto simp: path_simps intro: path_restrict_tl path_mono[OF 1])
 qed
 
 
 
 lemma dropWhileNot_path:
   assumes "p \<noteq> []"
   and "path E w p x"
   and "v \<in> set p"
   and "dropWhile ((\<noteq>) v) p = c"
   shows "path E v c x"
   using assms
 proof (induction arbitrary: w c rule: list_nonempty_induct)
   case (single p) thus ?case by (auto simp add: path_simps)
 next
   case (cons p ps) hence [simp]: "w = p" by (simp add: path_cons_conv)
   show ?case
   proof (cases "p=v")
     case True with cons show ?thesis by simp
   next
     case False with cons have "c = dropWhile ((\<noteq>) v) ps" by simp
     moreover from cons.prems obtain y where "path E y ps x" 
       using path_uncons by metis
     moreover from cons.prems False have "v \<in> set ps" by simp
     ultimately show ?thesis using cons.IH by metis
   qed
 qed
 
 lemma takeWhileNot_path:
   assumes "p \<noteq> []"
   and "path E w p x"
   and "v \<in> set p"
   and "takeWhile ((\<noteq>) v) p = c"
   shows "path E w c v"
   using assms
 proof (induction arbitrary: w c rule: list_nonempty_induct)
   case (single p) thus ?case by (auto simp add: path_simps)
 next
   case (cons p ps) hence [simp]: "w = p" by (simp add: path_cons_conv)
   show ?case
   proof (cases "p=v")
     case True with cons show ?thesis by simp
   next
     case False with cons obtain c' where 
       "c' = takeWhile ((\<noteq>) v) ps" and 
       [simp]: "c = p#c'"
       by simp_all
     moreover from cons.prems obtain y where 
       "path E y ps x" and "(w,y) \<in> E" 
       using path_uncons by metis+
     moreover from cons.prems False have "v \<in> set ps" by simp
     ultimately have "path E y c' v" using cons.IH by metis
     with \<open>(w,y) \<in> E\<close> show ?thesis by (auto simp add: path_cons_conv)
   qed
 qed
 
 
 subsection \<open>Infinite Paths\<close>
 definition ipath :: "'q digraph \<Rightarrow> 'q word \<Rightarrow> bool"
   \<comment> \<open>Predicate for an infinite path in a digraph\<close>
   where "ipath E r \<equiv> \<forall>i. (r i, r (Suc i))\<in>E"
 
 
 lemma ipath_conc_conv: 
   "ipath E (u \<frown> v) \<longleftrightarrow> (\<exists>a. path E a u (v 0) \<and> ipath E v)"
   apply (auto simp: conc_def ipath_def path_nth_conv nth_append)
   apply (metis add_Suc_right diff_add_inverse not_add_less1)
   by (metis Suc_diff_Suc diff_Suc_Suc not_less_eq)
 
 lemma ipath_iter_conv:
   assumes "p\<noteq>[]"
   shows "ipath E (p\<^sup>\<omega>) \<longleftrightarrow> (path E (hd p) p (hd p))"
 proof (cases p)
   case Nil thus ?thesis using assms by simp
 next
   case (Cons u p') hence PLEN: "length p > 0" by simp
   show ?thesis proof 
     assume "ipath E (iter (p))"
     hence "\<forall>i. (iter (p) i, iter (p) (Suc i)) \<in> E"
       unfolding ipath_def by simp
     hence "(\<forall>i<length p. (p!i,(p@[hd p])!Suc i)\<in>E)" 
       apply (simp add: assms)
       apply safe
       apply (drule_tac x=i in spec)
       apply simp
       apply (case_tac "Suc i = length p")
       apply (simp add: Cons)
       apply (simp add: nth_append)
       done
     thus "path E (hd p) p (hd p)"
       by (auto simp: path_nth_conv Cons nth_append nth_Cons')
   next
     assume "path E (hd p) p (hd p)"
     thus "ipath E (iter p)"
       apply (auto simp: path_nth_conv ipath_def assms Let_def)
       apply (drule_tac x="i mod length p" in spec)
       apply (auto simp: nth_append assms split: if_split_asm)
       apply (metis less_not_refl mod_Suc)
       by (metis PLEN diff_self_eq_0 mod_Suc nth_Cons_0 mod_less_divisor)
   qed
 qed
 
 lemma ipath_to_rtrancl:
   assumes R: "ipath E r"
   assumes I: "i1\<le>i2"
   shows "(r i1,r i2)\<in>E\<^sup>*"
   using I
 proof (induction i2)
   case (Suc i2)
   show ?case proof (cases "i1=Suc i2")
     assume "i1\<noteq>Suc i2"
     with Suc have "(r i1,r i2)\<in>E\<^sup>*" by auto
     also from R have "(r i2,r (Suc i2))\<in>E" unfolding ipath_def by auto
     finally show ?thesis .
   qed simp
 qed simp
     
 lemma ipath_to_trancl:
   assumes R: "ipath E r"
   assumes I: "i1<i2"
   shows "(r i1,r i2)\<in>E\<^sup>+"
 proof -
   from R have "(r i1,r (Suc i1))\<in>E"
     by (auto simp: ipath_def)
   also have "(r (Suc i1),r i2)\<in>E\<^sup>*"
     using ipath_to_rtrancl[OF R,of "Suc i1" i2] I by auto
   finally (rtrancl_into_trancl2) show ?thesis .
 qed
 
 lemma run_limit_two_connectedI:
   assumes A: "ipath E r" 
   assumes B: "a \<in> limit r" "b\<in>limit r"
   shows "(a,b)\<in>E\<^sup>+"
 proof -
   from B have "{a,b} \<subseteq> limit r" by simp
   with A show ?thesis
     by (metis ipath_to_trancl two_in_limit_iff)
 qed
 
 
 lemma ipath_subpath:
   assumes P: "ipath E r"
   assumes LE: "l\<le>u"
   shows "path E (r l) (map r [l..<u]) (r u)"
   using LE
 proof (induction "u-l" arbitrary: u l)
   case (Suc n)
   note IH=Suc.hyps(1)
   from \<open>Suc n = u-l\<close> \<open>l\<le>u\<close> obtain u' where [simp]: "u=Suc u'" 
     and A: "n=u'-l" "l \<le> u'" 
     by (cases u) auto
     
   note IH[OF A]
   also from P have "(r u',r u)\<in>E"
     by (auto simp: ipath_def)
   finally show ?case using \<open>l \<le> u'\<close> by (simp add: upt_Suc_append)
 qed auto  
 
 lemma ipath_restrict_eq: "ipath (E \<inter> (E\<^sup>*``{r 0} \<times> E\<^sup>*``{r 0})) r \<longleftrightarrow> ipath E r"
   unfolding ipath_def
   by (auto simp: relpow_fun_conv rtrancl_power)
 lemma ipath_restrict: "ipath E r \<Longrightarrow> ipath (E \<inter> (E\<^sup>*``{r 0} \<times> E\<^sup>*``{r 0})) r"
   by (simp add: ipath_restrict_eq)
 
 
 lemma ipathI[intro?]: "\<lbrakk>\<And>i. (r i, r (Suc i)) \<in> E\<rbrakk> \<Longrightarrow> ipath E r"
   unfolding ipath_def by auto
 
 lemma ipathD: "ipath E r \<Longrightarrow> (r i, r (Suc i)) \<in> E"
   unfolding ipath_def by auto
 
 lemma ipath_in_Domain: "ipath E r \<Longrightarrow> r i \<in> Domain E"
   unfolding ipath_def by auto
 
 lemma ipath_in_Range: "\<lbrakk>ipath E r; i\<noteq>0\<rbrakk> \<Longrightarrow> r i \<in> Range E"
   unfolding ipath_def by (cases i) auto
 
 lemma ipath_suffix: "ipath E r \<Longrightarrow> ipath E (suffix i r)"
   unfolding suffix_def ipath_def by auto
 
 subsection \<open>Strongly Connected Components\<close>
 
 text \<open>A strongly connected component is a maximal mutually connected set 
   of nodes\<close>
 definition is_scc :: "'q digraph \<Rightarrow> 'q set \<Rightarrow> bool"
   where "is_scc E U \<longleftrightarrow> U\<times>U\<subseteq>E\<^sup>* \<and> (\<forall>V. V\<supset>U \<longrightarrow> \<not> (V\<times>V\<subseteq>E\<^sup>*))"
 
 lemma scc_non_empty[simp]: "\<not>is_scc E {}" unfolding is_scc_def by auto
 
 lemma scc_non_empty'[simp]: "is_scc E U \<Longrightarrow> U\<noteq>{}" unfolding is_scc_def by auto
 
 lemma is_scc_closed: 
   assumes SCC: "is_scc E U"
   assumes MEM: "x\<in>U"
   assumes P: "(x,y)\<in>E\<^sup>*" "(y,x)\<in>E\<^sup>*"
   shows "y\<in>U"
 proof -
   from SCC MEM P have "insert y U \<times> insert y U \<subseteq> E\<^sup>*"
     unfolding is_scc_def
     apply clarsimp
     apply rule
     apply clarsimp_all
     apply (erule disjE1)
     apply clarsimp
     apply (metis in_mono mem_Sigma_iff rtrancl_trans)
     apply auto []
-    apply (erule disjE1)
-    apply clarsimp
     apply (metis in_mono mem_Sigma_iff rtrancl_trans)
-    apply auto []
     done
   with SCC show ?thesis unfolding is_scc_def by blast
 qed
 
 lemma is_scc_connected:
   assumes SCC: "is_scc E U"
   assumes MEM: "x\<in>U" "y\<in>U"
   shows "(x,y)\<in>E\<^sup>*"
   using assms unfolding is_scc_def by auto
 
 text \<open>In the following, we play around with alternative characterizations, and
   prove them all equivalent .\<close>
 
 text \<open>A common characterization is to define an equivalence relation 
   ,,mutually connected'' on nodes, and characterize the SCCs as its 
   equivalence classes:\<close>
 
 definition mconn :: "('a\<times>'a) set \<Rightarrow> ('a \<times> 'a) set"
   \<comment> \<open>Mutually connected relation on nodes\<close>
   where "mconn E = E\<^sup>* \<inter> (E\<inverse>)\<^sup>*"
 
 lemma mconn_pointwise:
    "mconn E = {(u,v). (u,v)\<in>E\<^sup>* \<and> (v,u)\<in>E\<^sup>*}"
   by (auto simp add: mconn_def rtrancl_converse)
 
 text \<open>\<open>mconn\<close> is an equivalence relation:\<close>
 lemma mconn_refl[simp]: "Id\<subseteq>mconn E"
   by (auto simp add: mconn_def)
 
 lemma mconn_sym: "mconn E = (mconn E)\<inverse>"
   by (auto simp add: mconn_pointwise)
 
 lemma mconn_trans: "mconn E O mconn E = mconn E"
   by (auto simp add: mconn_def)
 
 lemma mconn_refl': "refl (mconn E)"
   by (auto intro: refl_onI simp: mconn_pointwise)
 
 lemma mconn_sym': "sym (mconn E)"
   by (auto intro: symI simp: mconn_pointwise)
 
 lemma mconn_trans': "trans (mconn E)"
   by (metis mconn_def trans_Int trans_rtrancl)
 
 lemma mconn_equiv: "equiv UNIV (mconn E)"
   using mconn_refl' mconn_sym' mconn_trans'
   by (rule equivI)
 
 
 lemma is_scc_mconn_eqclasses: "is_scc E U \<longleftrightarrow> U \<in> UNIV // mconn E"
   \<comment> \<open>The strongly connected components are the equivalence classes of the 
     mutually-connected relation on nodes\<close>
 proof
   assume A: "is_scc E U"
   then obtain x where "x\<in>U" unfolding is_scc_def by auto
   hence "U = mconn E `` {x}" using A
     unfolding mconn_pointwise is_scc_def
     apply clarsimp
     apply rule
     apply auto []
     apply clarsimp
     by (metis A is_scc_closed)
   thus "U \<in> UNIV // mconn E"
     by (auto simp: quotient_def)
 next
   assume "U \<in> UNIV // mconn E"
   thus "is_scc E U"
     by (auto simp: is_scc_def mconn_pointwise quotient_def)
 qed
 
 (* For presentation in the paper *)
 lemma "is_scc E U \<longleftrightarrow> U \<in> UNIV // (E\<^sup>* \<inter> (E\<inverse>)\<^sup>*)"
   unfolding is_scc_mconn_eqclasses mconn_def by simp
 
 text \<open>We can also restrict the notion of "reachability" to nodes
   inside the SCC
 \<close>
 
 lemma find_outside_node:
   assumes "(u,v)\<in>E\<^sup>*"
   assumes "(u,v)\<notin>(E\<inter>U\<times>U)\<^sup>*"
   assumes "u\<in>U" "v\<in>U"
   shows "\<exists>u'. u'\<notin>U \<and> (u,u')\<in>E\<^sup>* \<and> (u',v)\<in>E\<^sup>*"
   using assms
   apply (induction)
   apply auto []
   apply clarsimp
   by (metis IntI mem_Sigma_iff rtrancl.simps)
 
 lemma is_scc_restrict1:
   assumes SCC: "is_scc E U"
   shows "U\<times>U\<subseteq>(E\<inter>U\<times>U)\<^sup>*"
   using assms
   unfolding is_scc_def
   apply clarsimp
   apply (rule ccontr)
   apply (drule (2) find_outside_node[rotated])
   apply auto []
   by (metis is_scc_closed[OF SCC] mem_Sigma_iff rtrancl_trans subsetD)
 
 lemma is_scc_restrict2:
   assumes SCC: "is_scc E U"
   assumes "V\<supset>U"
   shows "\<not> (V\<times>V\<subseteq>(E\<inter>V\<times>V)\<^sup>*)"
   using assms
   unfolding is_scc_def
   apply clarsimp
   using rtrancl_mono[of "E \<inter> V \<times> V" "E"]
   apply clarsimp
   apply blast
   done
 
 lemma is_scc_restrict3: 
   assumes SCC: "is_scc E U"
   shows "((E\<^sup>*``((E\<^sup>*``U) - U)) \<inter> U = {})"
   apply auto
   by (metis assms is_scc_closed is_scc_connected rtrancl_trans)
   
 lemma is_scc_alt_restrict_path:
   "is_scc E U \<longleftrightarrow> U\<noteq>{} \<and>
     (U\<times>U \<subseteq> (E\<inter>U\<times>U)\<^sup>*) \<and> ((E\<^sup>*``((E\<^sup>*``U) - U)) \<inter> U = {})"
   apply rule
   apply (intro conjI)
   apply simp
   apply (blast dest: is_scc_restrict1)
   apply (blast dest: is_scc_restrict3)
   
   unfolding is_scc_def
   apply rule
   apply clarsimp
   apply (metis (full_types) Int_lower1 in_mono mem_Sigma_iff rtrancl_mono_mp)
   apply blast
   done
 
 lemma is_scc_pointwise:
   "is_scc E U \<longleftrightarrow> 
     U\<noteq>{}
   \<and> (\<forall>u\<in>U. \<forall>v\<in>U. (u,v)\<in>(E\<inter>U\<times>U)\<^sup>*) 
   \<and> (\<forall>u\<in>U. \<forall>v. (v\<notin>U \<and> (u,v)\<in>E\<^sup>*) \<longrightarrow> (\<forall>u'\<in>U. (v,u')\<notin>E\<^sup>*))"
   \<comment> \<open>Alternative, pointwise characterization\<close>
   unfolding is_scc_alt_restrict_path
   by blast  
 
 lemma is_scc_unique:
   assumes SCC: "is_scc E scc" "is_scc E scc'"
   and v: "v \<in> scc" "v \<in> scc'"
   shows "scc = scc'"
 proof -
   from SCC have "scc = scc' \<or> scc \<inter> scc' = {}"
     using quotient_disj[OF mconn_equiv]
     by (simp add: is_scc_mconn_eqclasses)
   with v show ?thesis by auto
 qed
 
 lemma is_scc_ex1:
   "\<exists>!scc. is_scc E scc \<and> v \<in> scc"
 proof (rule ex1I, rule conjI)
   let ?scc = "mconn E `` {v}"
   have "?scc \<in> UNIV // mconn E" by (auto intro: quotientI)
   thus "is_scc E ?scc" by (simp add: is_scc_mconn_eqclasses)
   moreover show "v \<in> ?scc" by (blast intro: refl_onD[OF mconn_refl'])
   ultimately show "\<And>scc. is_scc E scc \<and> v \<in> scc \<Longrightarrow> scc = ?scc"
     by (metis is_scc_unique)
 qed
 
 lemma is_scc_ex:
   "\<exists>scc. is_scc E scc \<and> v \<in> scc"
   by (metis is_scc_ex1)
 
 lemma is_scc_connected':
   "\<lbrakk>is_scc E scc; x \<in> scc; y \<in> scc\<rbrakk> \<Longrightarrow> (x,y)\<in>(Restr E scc)\<^sup>*"
   unfolding is_scc_pointwise
   by blast
 
 definition scc_of :: "('v\<times>'v) set \<Rightarrow> 'v \<Rightarrow> 'v set"
   where
   "scc_of E v = (THE scc. is_scc E scc \<and> v \<in> scc)"
 
 lemma scc_of_is_scc[simp]:
   "is_scc E (scc_of E v)"
   using is_scc_ex1[of E v]
   by (auto dest!: theI' simp: scc_of_def)
 
 lemma node_in_scc_of_node[simp]:
   "v \<in> scc_of E v"
   using is_scc_ex1[of E v]
   by (auto dest!: theI' simp: scc_of_def)
 
 lemma scc_of_unique:
   assumes "w \<in> scc_of E v"
   shows "scc_of E v = scc_of E w"
 proof -
   have "is_scc E (scc_of E v)" by simp
   moreover note assms
   moreover have "is_scc E (scc_of E w)" by simp
   moreover have "w \<in> scc_of E w" by simp
   ultimately show ?thesis using is_scc_unique by metis
 qed
 
 end
diff --git a/thys/First_Order_Terms/Lists_are_Infinite.thy b/thys/First_Order_Terms/Lists_are_Infinite.thy
new file mode 100644
--- /dev/null
+++ b/thys/First_Order_Terms/Lists_are_Infinite.thy
@@ -0,0 +1,15 @@
+(*
+Author:  Christian Sternagel <c.sternagel@gmail.com>
+Author:  René Thiemann <rene.thiemann@uibk.ac.at>
+License: LGPL
+*)
+subsection \<open>Make lists instances of the infinite-class.\<close>
+
+theory Lists_are_Infinite
+  imports Fresh_Identifiers.Fresh
+begin
+
+instance list :: (type) infinite
+  by (intro_classes, rule infinite_UNIV_listI)
+
+end
\ No newline at end of file
diff --git a/thys/First_Order_Terms/ROOT b/thys/First_Order_Terms/ROOT
--- a/thys/First_Order_Terms/ROOT
+++ b/thys/First_Order_Terms/ROOT
@@ -1,21 +1,24 @@
 chapter AFP
 
 session First_Order_Terms = "Abstract-Rewriting" +
   description "First-Order Terms"
   options [timeout = 300]
   sessions
     "HOL-Library"
+    Fresh_Identifiers
   theories
     Transitive_Closure_More
   theories
+    Renaming2_String
+  theories
     Seq_More
     Fun_More
     Option_Monad
   theories
     Matching
-    Unification
+    Unification_String
     Subsumption
     Subterm_and_Context
   document_files
     "root.tex"
     "root.bib"
diff --git a/thys/First_Order_Terms/Renaming2.thy b/thys/First_Order_Terms/Renaming2.thy
new file mode 100644
--- /dev/null
+++ b/thys/First_Order_Terms/Renaming2.thy
@@ -0,0 +1,45 @@
+(*
+Author:  Christian Sternagel <c.sternagel@gmail.com>
+Author:  René Thiemann <rene.thiemann@uibk.ac.at>
+License: LGPL
+*)
+
+subsection \<open>Rename names in two ways.\<close>
+
+theory Renaming2
+  imports 
+    Fresh_Identifiers.Fresh
+begin
+
+typedef ('v :: infinite) renaming2 = "{ (v1 :: 'v \<Rightarrow> 'v, v2 :: 'v \<Rightarrow> 'v) | v1 v2. inj v1 \<and> inj v2 \<and> range v1 \<inter> range v2 = {} }" 
+proof -
+  let ?U = "UNIV :: 'v set" 
+  have inf: "infinite ?U" by (rule infinite_UNIV)
+  have "ordLeq3 (card_of ?U) (card_of ?U)" 
+    using card_of_refl ordIso_iff_ordLeq by blast
+  from card_of_Plus_infinite1[OF inf this, folded card_of_ordIso] 
+  obtain f where bij: "bij_betw f (?U <+> ?U) ?U" by auto
+  hence injf: "inj f" by (simp add: bij_is_inj)
+  define v1 where "v1 = f o Inl" 
+  define v2 where "v2 = f o Inr" 
+  have inj: "inj v1" "inj v2" unfolding v1_def v2_def by (intro inj_compose[OF injf], auto)+
+  have "range v1 \<inter> range v2 = {}" 
+  proof (rule ccontr)
+    assume "\<not> ?thesis" 
+    then obtain x where "v1 x = v2 x" 
+      using injD injf v1_def v2_def by fastforce
+    hence "f (Inl x) = f (Inr x)" unfolding v1_def v2_def by auto
+    with injf show False unfolding inj_on_def by blast
+  qed
+  with inj show ?thesis by blast
+qed
+
+setup_lifting type_definition_renaming2
+
+lift_definition rename_1 :: "'v :: infinite renaming2 \<Rightarrow> 'v \<Rightarrow> 'v" is fst .
+lift_definition rename_2 :: "'v :: infinite renaming2 \<Rightarrow> 'v \<Rightarrow> 'v" is snd .
+
+lemma rename_12: "inj (rename_1 r)" "inj (rename_2 r)" "range (rename_1 r) \<inter> range (rename_2 r) = {}" 
+  by (transfer, auto)+
+
+end
diff --git a/thys/First_Order_Terms/Renaming2_String.thy b/thys/First_Order_Terms/Renaming2_String.thy
new file mode 100644
--- /dev/null
+++ b/thys/First_Order_Terms/Renaming2_String.thy
@@ -0,0 +1,14 @@
+subsection \<open>Renaming strings apart\<close>
+
+theory Renaming2_String
+  imports 
+    Renaming2
+    Lists_are_Infinite
+begin
+
+lift_definition string_rename :: "string renaming2" is "(Cons (CHR ''x''), Cons (CHR ''y''))" 
+  by auto
+
+end
+
+  
diff --git a/thys/First_Order_Terms/Term.thy b/thys/First_Order_Terms/Term.thy
--- a/thys/First_Order_Terms/Term.thy
+++ b/thys/First_Order_Terms/Term.thy
@@ -1,718 +1,749 @@
 (*
 Author:  Christian Sternagel <c.sternagel@gmail.com>
 Author:  René Thiemann <rene.thiemann@uibk.ac.at>
 License: LGPL
 *)
 section \<open>First-Order Terms\<close>
 
 theory Term
   imports 
     Main
     "HOL-Library.Multiset"
 begin
 
 datatype (funs_term : 'f, vars_term : 'v) "term" =
   is_Var: Var (the_Var: 'v) |
   Fun 'f (args : "('f, 'v) term list")
 where
   "args (Var _) = []"
 
 abbreviation "is_Fun t \<equiv> \<not> is_Var t"
 
 lemma is_VarE [elim]:
   "is_Var t \<Longrightarrow> (\<And>x. t = Var x \<Longrightarrow> P) \<Longrightarrow> P"
   by (cases t) auto
 
 lemma is_FunE [elim]:
   "is_Fun t \<Longrightarrow> (\<And>f ts. t = Fun f ts \<Longrightarrow> P) \<Longrightarrow> P"
   by (cases t) auto
 
 lemma inj_on_Var[simp]: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   "inj_on Var A"
   by (rule inj_onI) simp
 
 lemma member_image_the_Var_image_subst: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   assumes is_var_\<sigma>: "\<forall>x. is_Var (\<sigma> x)"
   shows "x \<in> the_Var ` \<sigma> ` V \<longleftrightarrow> Var x \<in> \<sigma> ` V"
   using is_var_\<sigma> image_iff
   by (metis (no_types, opaque_lifting) term.collapse(1) term.sel(1))
 
 lemma image_the_Var_image_subst_renaming_eq: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   assumes is_var_\<sigma>: "\<forall>x. is_Var (\<rho> x)"
   shows "the_Var ` \<rho> ` V = (\<Union>x \<in> V. vars_term (\<rho> x))"
 proof (rule Set.equalityI; rule Set.subsetI)
   from is_var_\<sigma> show "\<And>x. x \<in> the_Var ` \<rho> ` V \<Longrightarrow> x \<in> (\<Union>x\<in>V. vars_term (\<rho> x))"
     using term.set_sel(3) by force
 next
   from is_var_\<sigma> show "\<And>x. x \<in> (\<Union>x\<in>V. vars_term (\<rho> x)) \<Longrightarrow> x \<in> the_Var ` \<rho> ` V"
     by (smt (verit, best) Term.term.simps(17) UN_iff image_eqI singletonD term.collapse(1))
 qed
 
 text \<open>The variables of a term as multiset.\<close>
 fun vars_term_ms :: "('f, 'v) term \<Rightarrow> 'v multiset"
   where
     "vars_term_ms (Var x) = {#x#}" |
     "vars_term_ms (Fun f ts) = \<Sum>\<^sub># (mset (map vars_term_ms ts))"
 
 lemma set_mset_vars_term_ms [simp]:
   "set_mset (vars_term_ms t) = vars_term t"
   by (induct t) auto
 
 
 text \<open>Reorient equations of the form @{term "Var x = t"} and @{term "Fun f ss = t"} to facilitate
   simplification.\<close>
 setup \<open>
   Reorient_Proc.add
     (fn Const (@{const_name Var}, _) $ _ => true | _ => false)
   #> Reorient_Proc.add
     (fn Const (@{const_name Fun}, _) $ _ $ _ => true | _ => false)
 \<close>
 
 simproc_setup reorient_Var ("Var x = t") = \<open>K Reorient_Proc.proc\<close>
 simproc_setup reorient_Fun ("Fun f ss = t") = \<open>K Reorient_Proc.proc\<close>
 
 text \<open>The \emph{root symbol} of a term is defined by:\<close>
 fun root :: "('f, 'v) term \<Rightarrow> ('f \<times> nat) option"
 where
   "root (Var x) = None" |
   "root (Fun f ts) = Some (f, length ts)"
 
 lemma finite_vars_term [simp]:
   "finite (vars_term t)"
   by (induct t) simp_all
 
 lemma finite_Union_vars_term:
   "finite (\<Union>t \<in> set ts. vars_term t)"
   by auto
 
 text \<open>A substitution is a mapping \<open>\<sigma>\<close> from variables to terms. We call a substitution that
   alters the type of variables a generalized substitution, since it does not have all properties
   that are expected of (standard) substitutions (e.g., there is no empty substitution).\<close>
 type_synonym ('f, 'v, 'w) gsubst = "'v \<Rightarrow> ('f, 'w) term"
 type_synonym ('f, 'v) subst  = "('f, 'v, 'v) gsubst"
 
 fun subst_apply_term :: "('f, 'v) term \<Rightarrow> ('f, 'v, 'w) gsubst \<Rightarrow> ('f, 'w) term" (infixl "\<cdot>" 67)
   where
     "Var x \<cdot> \<sigma> = \<sigma> x"
   | "Fun f ss \<cdot> \<sigma> = Fun f (map (\<lambda>t. t \<cdot> \<sigma>) ss)"
 
 definition
   subst_compose :: "('f, 'u, 'v) gsubst \<Rightarrow> ('f, 'v, 'w) gsubst \<Rightarrow> ('f, 'u, 'w) gsubst"
   (infixl "\<circ>\<^sub>s" 75)
   where
     "\<sigma> \<circ>\<^sub>s \<tau> = (\<lambda>x. (\<sigma> x) \<cdot> \<tau>)"
 
 lemma subst_subst_compose [simp]:
   "t \<cdot> (\<sigma> \<circ>\<^sub>s \<tau>) = t \<cdot> \<sigma> \<cdot> \<tau>"
   by (induct t \<sigma> rule: subst_apply_term.induct) (simp_all add: subst_compose_def)
 
 lemma subst_compose_assoc:
   "\<sigma> \<circ>\<^sub>s \<tau> \<circ>\<^sub>s \<mu> = \<sigma> \<circ>\<^sub>s (\<tau> \<circ>\<^sub>s \<mu>)"
 proof (rule ext)
   fix x show "(\<sigma> \<circ>\<^sub>s \<tau> \<circ>\<^sub>s \<mu>) x = (\<sigma> \<circ>\<^sub>s (\<tau> \<circ>\<^sub>s \<mu>)) x"
   proof -
     have "(\<sigma> \<circ>\<^sub>s \<tau> \<circ>\<^sub>s \<mu>) x = \<sigma>(x) \<cdot> \<tau> \<cdot> \<mu>" by (simp add: subst_compose_def)
     also have "\<dots> = \<sigma>(x) \<cdot> (\<tau> \<circ>\<^sub>s \<mu>)" by simp
     finally show ?thesis by (simp add: subst_compose_def)
   qed
 qed
 
 lemma subst_apply_term_empty [simp]:
   "t \<cdot> Var = t"
 proof (induct t)
   case (Fun f ts)
   from map_ext [rule_format, of ts _ id, OF Fun] show ?case by simp
 qed simp
 
 interpretation subst_monoid_mult: monoid_mult "Var" "(\<circ>\<^sub>s)"
   by (unfold_locales) (simp add: subst_compose_assoc, simp_all add: subst_compose_def)
 
 lemma term_subst_eq:
   assumes "\<And>x. x \<in> vars_term t \<Longrightarrow> \<sigma> x = \<tau> x"
   shows "t \<cdot> \<sigma> = t \<cdot> \<tau>"
   using assms by (induct t) (auto)
 
 lemma term_subst_eq_rev:
   "t \<cdot> \<sigma> = t \<cdot> \<tau> \<Longrightarrow> \<forall>x \<in> vars_term t. \<sigma> x = \<tau> x"
   by (induct t) simp_all
 
 lemma term_subst_eq_conv:
   "t \<cdot> \<sigma> = t \<cdot> \<tau> \<longleftrightarrow> (\<forall>x \<in> vars_term t. \<sigma> x = \<tau> x)"
   using term_subst_eq [of t \<sigma> \<tau>] and term_subst_eq_rev [of t \<sigma> \<tau>] by auto
 
 lemma subst_term_eqI:
   assumes "(\<And>t. t \<cdot> \<sigma> = t \<cdot> \<tau>)"
   shows "\<sigma> = \<tau>"
   using assms [of "Var x" for x] by (intro ext) simp
 
 definition subst_domain :: "('f, 'v) subst \<Rightarrow> 'v set"
   where
     "subst_domain \<sigma> = {x. \<sigma> x \<noteq> Var x}"
 
 fun subst_range :: "('f, 'v) subst \<Rightarrow> ('f, 'v) term set"
   where
     "subst_range \<sigma> = \<sigma> ` subst_domain \<sigma>"
 
 lemma vars_term_ms_subst [simp]:
   "vars_term_ms (t \<cdot> \<sigma>) =
     (\<Sum>x\<in>#vars_term_ms t. vars_term_ms (\<sigma> x))" (is "_ = ?V t")
 proof (induct t)
   case (Fun f ts)
   have IH: "map (\<lambda> t. vars_term_ms (t \<cdot> \<sigma>)) ts = map (\<lambda> t. ?V t) ts"
     by (rule map_cong[OF refl Fun])
   show ?case by (simp add: o_def IH, induct ts, auto)
 qed simp
 
 lemma vars_term_ms_subst_mono:
   assumes "vars_term_ms s \<subseteq># vars_term_ms t"
   shows "vars_term_ms (s \<cdot> \<sigma>) \<subseteq># vars_term_ms (t \<cdot> \<sigma>)"
 proof -
   from assms[unfolded mset_subset_eq_exists_conv] obtain u where t: "vars_term_ms t = vars_term_ms s + u" by auto
   show ?thesis unfolding vars_term_ms_subst unfolding t by auto
 qed
 
 
 text \<open>The variables introduced by a substitution.\<close>
 definition range_vars :: "('f, 'v) subst \<Rightarrow> 'v set"
 where
   "range_vars \<sigma> = \<Union>(vars_term ` subst_range \<sigma>)"
 
 lemma mem_range_varsI: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   assumes "\<sigma> x = Var y" and "x \<noteq> y"
   shows "y \<in> range_vars \<sigma>"
   unfolding range_vars_def UN_iff
 proof (rule bexI[of _ "Var y"])
   show "y \<in> vars_term (Var y)"
     by simp
 next
   from assms show "Var y \<in> subst_range \<sigma>"
     by (simp_all add: subst_domain_def)
 qed
 
 lemma subst_domain_Var [simp]:
   "subst_domain Var = {}"
   by (simp add: subst_domain_def)
 
 lemma subst_range_Var[simp]: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   "subst_range Var = {}"
   by simp
 
 lemma range_vars_Var[simp]: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   "range_vars Var = {}"
   by (simp add: range_vars_def)
 
 lemma subst_apply_term_ident: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   "vars_term t \<inter> subst_domain \<sigma> = {} \<Longrightarrow> t \<cdot> \<sigma> = t"
 proof (induction t)
   case (Var x)
   thus ?case
     by (simp add: subst_domain_def)
 next
   case (Fun f ts)
   thus ?case
     by (auto intro: list.map_ident_strong)
 qed
 
 lemma vars_term_subst_apply_term: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   "vars_term (t \<cdot> \<sigma>) = (\<Union>x \<in> vars_term t. vars_term (\<sigma> x))"
   by (induction t) (auto simp add: insert_Diff_if subst_domain_def)
 
 corollary vars_term_subst_apply_term_subset: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   "vars_term (t \<cdot> \<sigma>) \<subseteq> vars_term t - subst_domain \<sigma> \<union> range_vars \<sigma>"
   unfolding vars_term_subst_apply_term
 proof (induction t)
   case (Var x)
   show ?case
     by (cases "\<sigma> x = Var x") (auto simp add: range_vars_def subst_domain_def)
 next
   case (Fun f xs)
   thus ?case by auto
 qed
 
 definition is_renaming :: "('f, 'v) subst \<Rightarrow> bool"
   where
     "is_renaming \<sigma> \<longleftrightarrow> (\<forall>x. is_Var (\<sigma> x)) \<and> inj_on \<sigma> (subst_domain \<sigma>)"
 
 lemma inv_renaming_sound: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   assumes is_var_\<rho>: "\<forall>x. is_Var (\<rho> x)" and "inj \<rho>"
   shows "\<rho> \<circ>\<^sub>s (Var \<circ> (inv (the_Var \<circ> \<rho>))) = Var"
 proof -
   define \<rho>' where "\<rho>' = the_Var \<circ> \<rho>"
   have \<rho>_def: "\<rho> = Var \<circ> \<rho>'"
     unfolding \<rho>'_def using is_var_\<rho> by auto
 
   from is_var_\<rho> \<open>inj \<rho>\<close> have "inj \<rho>'"
     unfolding inj_def \<rho>_def comp_def by fast
   hence "inv \<rho>' \<circ> \<rho>' = id"
     using inv_o_cancel[of \<rho>'] by simp
   hence "Var \<circ> (inv \<rho>' \<circ> \<rho>') = Var"
     by simp
   hence "\<forall>x. (Var \<circ> (inv \<rho>' \<circ> \<rho>')) x = Var x"
     by metis
   hence "\<forall>x. ((Var \<circ> \<rho>') \<circ>\<^sub>s (Var \<circ> (inv \<rho>'))) x = Var x"
     unfolding subst_compose_def by auto
   thus "\<rho> \<circ>\<^sub>s (Var \<circ> (inv \<rho>')) = Var"
     using \<rho>_def by auto
 qed
 
 lemma ex_inverse_of_renaming: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   assumes "\<forall>x. is_Var (\<rho> x)" and "inj \<rho>"
   shows "\<exists>\<tau>. \<rho> \<circ>\<^sub>s \<tau> = Var"
   using inv_renaming_sound[OF assms] by blast
 
 lemma vars_term_subst:
   "vars_term (t \<cdot> \<sigma>) = \<Union>(vars_term ` \<sigma> ` vars_term t)"
   by (induct t) simp_all
 
 lemma range_varsE [elim]:
   assumes "x \<in> range_vars \<sigma>"
     and "\<And>t. x \<in> vars_term t \<Longrightarrow> t \<in> subst_range \<sigma> \<Longrightarrow> P"
   shows "P"
   using assms by (auto simp: range_vars_def)
 
 lemma range_vars_subst_compose_subset:
   "range_vars (\<sigma> \<circ>\<^sub>s \<tau>) \<subseteq> (range_vars \<sigma> - subst_domain \<tau>) \<union> range_vars \<tau>" (is "?L \<subseteq> ?R")
 proof
   fix x
   assume "x \<in> ?L"
   then obtain y where "y \<in> subst_domain (\<sigma> \<circ>\<^sub>s \<tau>)"
     and "x \<in> vars_term ((\<sigma> \<circ>\<^sub>s \<tau>) y)" by (auto simp: range_vars_def)
   then show "x \<in> ?R"
   proof (cases)
     assume "y \<in> subst_domain \<sigma>" and "x \<in> vars_term ((\<sigma> \<circ>\<^sub>s \<tau>) y)"
     moreover then obtain v where "v \<in> vars_term (\<sigma> y)"
       and "x \<in> vars_term (\<tau> v)" by (auto simp: subst_compose_def vars_term_subst)
     ultimately show ?thesis
       by (cases "v \<in> subst_domain \<tau>") (auto simp: range_vars_def subst_domain_def)
   qed (auto simp: range_vars_def subst_compose_def subst_domain_def)
 qed
 
 definition "subst x t = Var (x := t)"
 
 lemma subst_simps [simp]:
   "subst x t x = t"
   "subst x (Var x) = Var"
   by (auto simp: subst_def)
 
 lemma subst_subst_domain [simp]:
   "subst_domain (subst x t) = (if t = Var x then {} else {x})"
 proof -
   { fix y
     have "y \<in> {y. subst x t y \<noteq> Var y} \<longleftrightarrow> y \<in> (if t = Var x then {} else {x})"
       by (cases "x = y", auto simp: subst_def) }
   then show ?thesis by (simp add: subst_domain_def)
 qed
 
 lemma subst_subst_range [simp]:
   "subst_range (subst x t) = (if t = Var x then {} else {t})"
   by (cases "t = Var x") (auto simp: subst_domain_def subst_def)
 
 lemma subst_apply_left_idemp [simp]:
   assumes "\<sigma> x = t \<cdot> \<sigma>"
   shows "s \<cdot> subst x t \<cdot> \<sigma> = s \<cdot> \<sigma>"
   using assms by (induct s) (auto simp: subst_def)
 
 lemma subst_compose_left_idemp [simp]:
   assumes "\<sigma> x = t \<cdot> \<sigma>"
   shows "subst x t \<circ>\<^sub>s \<sigma> = \<sigma>"
   by (rule subst_term_eqI) (simp add: assms)
 
 lemma subst_ident [simp]:
   assumes "x \<notin> vars_term t"
   shows "t \<cdot> subst x u = t"
 proof -
   have "t \<cdot> subst x u = t \<cdot> Var"
     by (rule term_subst_eq) (auto simp: assms subst_def)
   then show ?thesis by simp
 qed
 
 lemma subst_self_idemp [simp]:
   "x \<notin> vars_term t \<Longrightarrow> subst x t \<circ>\<^sub>s subst x t = subst x t"
   by (metis subst_simps(1) subst_compose_left_idemp subst_ident)
 
 type_synonym ('f, 'v) terms = "('f, 'v) term set"
 
 text \<open>Applying a substitution to every term of a given set.\<close>
 abbreviation
   subst_apply_set :: "('f, 'v) terms \<Rightarrow> ('f, 'v, 'w) gsubst \<Rightarrow> ('f, 'w) terms" (infixl "\<cdot>\<^sub>s\<^sub>e\<^sub>t" 60)
   where
     "T \<cdot>\<^sub>s\<^sub>e\<^sub>t \<sigma> \<equiv> (\<lambda>t. t \<cdot> \<sigma>) ` T"
 
 text \<open>Composition of substitutions\<close>
 lemma subst_compose: "(\<sigma> \<circ>\<^sub>s \<tau>) x = \<sigma> x \<cdot> \<tau>" by (auto simp: subst_compose_def)
 
 lemmas subst_subst = subst_subst_compose [symmetric]
 
 lemma subst_apply_eq_Var:
   assumes "s \<cdot> \<sigma> = Var x"
   obtains y where "s = Var y" and "\<sigma> y = Var x"
   using assms by (induct s) auto
 
 lemma subst_domain_subst_compose:
   "subst_domain (\<sigma> \<circ>\<^sub>s \<tau>) =
     (subst_domain \<sigma> - {x. \<exists>y. \<sigma> x = Var y \<and> \<tau> y = Var x}) \<union>
     (subst_domain \<tau> - subst_domain \<sigma>)"
   by (auto simp: subst_domain_def subst_compose_def elim: subst_apply_eq_Var)
 
 
 text \<open>A substitution is idempotent iff the variables in its range are disjoint from its domain.
   (See also "Term Rewriting and All That" \<^cite>\<open>\<open>Lemma 4.5.7\<close> in "AllThat"\<close>.)\<close>
 lemma subst_idemp_iff:
   "\<sigma> \<circ>\<^sub>s \<sigma> = \<sigma> \<longleftrightarrow> subst_domain \<sigma> \<inter> range_vars \<sigma> = {}"
 proof
   assume "\<sigma> \<circ>\<^sub>s \<sigma> = \<sigma>"
   then have "\<And>x. \<sigma> x \<cdot> \<sigma> = \<sigma> x \<cdot> Var" by simp (metis subst_compose_def)
   then have *: "\<And>x. \<forall>y\<in>vars_term (\<sigma> x). \<sigma> y = Var y"
     unfolding term_subst_eq_conv by simp
   { fix x y
     assume "\<sigma> x \<noteq> Var x" and "x \<in> vars_term (\<sigma> y)"
     with * [of y] have False by simp }
   then show "subst_domain \<sigma> \<inter> range_vars \<sigma> = {}"
     by (auto simp: subst_domain_def range_vars_def)
 next
   assume "subst_domain \<sigma> \<inter> range_vars \<sigma> = {}"
   then have *: "\<And>x y. \<sigma> x = Var x \<or> \<sigma> y = Var y \<or> x \<notin> vars_term (\<sigma> y)"
     by (auto simp: subst_domain_def range_vars_def)
   have "\<And>x. \<forall>y\<in>vars_term (\<sigma> x). \<sigma> y = Var y"
   proof
     fix x y
     assume "y \<in> vars_term (\<sigma> x)"
     with * [of y x] show "\<sigma> y = Var y" by auto
   qed
   then show "\<sigma> \<circ>\<^sub>s \<sigma> = \<sigma>"
     by (simp add: subst_compose_def term_subst_eq_conv [symmetric])
 qed
 
 lemma subst_compose_apply_eq_apply_lhs: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   assumes
     "range_vars \<sigma> \<inter> subst_domain \<delta> = {}"
     "x \<notin> subst_domain \<delta>"
   shows "(\<sigma> \<circ>\<^sub>s \<delta>) x = \<sigma> x"
 proof (cases "\<sigma> x")
   case (Var y)
   show ?thesis
   proof (cases "x = y")
     case True
     with Var have \<open>\<sigma> x = Var x\<close>
       by simp
     moreover from \<open>x \<notin> subst_domain \<delta>\<close> have "\<delta> x = Var x"
       by (simp add: disjoint_iff subst_domain_def)
     ultimately show ?thesis
       by (simp add: subst_compose_def)
   next
     case False
     have "y \<in> range_vars \<sigma>"
       unfolding range_vars_def UN_iff
     proof (rule bexI)
       show "y \<in> vars_term (Var y)"
         by simp
     next
       from Var False show "Var y \<in> subst_range \<sigma>"
         by (simp_all add: subst_domain_def)
     qed
     hence "y \<notin> subst_domain \<delta>"
       using \<open>range_vars \<sigma> \<inter> subst_domain \<delta> = {}\<close>
       by (simp add: disjoint_iff)
     with Var show ?thesis
       unfolding subst_compose_def
       by (simp add: subst_domain_def)
   qed
 next
   case (Fun f ys)
   hence "Fun f ys \<in> subst_range \<sigma> \<or> (\<forall>y\<in>set ys. y \<in> subst_range \<sigma>)"
     using subst_domain_def by fastforce
   hence "\<forall>x \<in> vars_term (Fun f ys). x \<in> range_vars \<sigma>"
     by (metis UN_I range_vars_def term.distinct(1) term.sel(4) term.set_cases(2))
   hence "Fun f ys \<cdot> \<delta> = Fun f ys \<cdot> Var"
     unfolding term_subst_eq_conv
     using \<open>range_vars \<sigma> \<inter> subst_domain \<delta> = {}\<close>
     by (simp add: disjoint_iff subst_domain_def)
   hence "Fun f ys \<cdot> \<delta> = Fun f ys"
     by simp
   with Fun show ?thesis
     by (simp add: subst_compose_def)
 qed
 
 lemma subst_apply_term_subst_apply_term_eq_subst_apply_term_lhs: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   assumes "range_vars \<sigma> \<inter> subst_domain \<delta> = {}" and "vars_term t \<inter> subst_domain \<delta> = {}"
   shows "t \<cdot> \<sigma> \<cdot> \<delta> = t \<cdot> \<sigma>"
 proof -
   from assms have "\<And>x. x \<in> vars_term t \<Longrightarrow> (\<sigma> \<circ>\<^sub>s \<delta>) x = \<sigma> x"
     using subst_compose_apply_eq_apply_lhs by fastforce
   hence "t \<cdot> \<sigma> \<circ>\<^sub>s \<delta> = t \<cdot> \<sigma>"
     using term_subst_eq_conv[of t "\<sigma> \<circ>\<^sub>s \<delta>" \<sigma>] by metis
   thus ?thesis
     by simp
 qed
 
 fun num_funs :: "('f, 'v) term \<Rightarrow> nat"
   where
     "num_funs (Var x) = 0" |
     "num_funs (Fun f ts) = Suc (sum_list (map num_funs ts))"
 
 lemma num_funs_0:
   assumes "num_funs t = 0"
   obtains x where "t = Var x"
   using assms by (induct t) auto
 
 lemma num_funs_subst:
   "num_funs (t \<cdot> \<sigma>) \<ge> num_funs t"
   by (induct t) (simp_all, metis comp_apply sum_list_mono)
 
 lemma sum_list_map_num_funs_subst:
   assumes "sum_list (map (num_funs \<circ> (\<lambda>t. t \<cdot> \<sigma>)) ts) = sum_list (map num_funs ts)"
   shows "\<forall>i < length ts. num_funs (ts ! i \<cdot> \<sigma>) = num_funs (ts ! i)"
   using assms
 proof (induct ts)
   case (Cons t ts)
   then have "num_funs (t \<cdot> \<sigma>) + sum_list (map (num_funs \<circ> (\<lambda>t. t \<cdot> \<sigma>)) ts)
     = num_funs t + sum_list (map num_funs ts)" by (simp add: o_def)
   moreover have "num_funs (t \<cdot> \<sigma>) \<ge> num_funs t" by (metis num_funs_subst)
   moreover have "sum_list (map (num_funs \<circ> (\<lambda>t. t \<cdot> \<sigma>)) ts) \<ge> sum_list (map num_funs ts)"
     using num_funs_subst [of _ \<sigma>] by (induct ts) (auto intro: add_mono)
   ultimately show ?case using Cons by (auto) (case_tac i, auto)
 qed simp
 
 lemma is_Fun_num_funs_less:
   assumes "x \<in> vars_term t" and "is_Fun t"
   shows "num_funs (\<sigma> x) < num_funs (t \<cdot> \<sigma>)"
   using assms
 proof (induct t)
   case (Fun f ts)
   then obtain u where u: "u \<in> set ts" "x \<in> vars_term u" by auto
   then have "num_funs (u \<cdot> \<sigma>) \<le> sum_list (map (num_funs \<circ> (\<lambda>t. t \<cdot> \<sigma>)) ts)"
     by (intro member_le_sum_list) simp
   moreover have "num_funs (\<sigma> x) \<le> num_funs (u \<cdot> \<sigma>)"
     using Fun.hyps [OF u] and u  by (cases u; simp)
   ultimately show ?case by simp
 qed simp
 
 lemma finite_subst_domain_subst:
   "finite (subst_domain (subst x y))"
   by simp
 
 lemma subst_domain_compose:
   "subst_domain (\<sigma> \<circ>\<^sub>s \<tau>) \<subseteq> subst_domain \<sigma> \<union> subst_domain \<tau>"
   by (auto simp: subst_domain_def subst_compose_def)
 
 lemma vars_term_disjoint_imp_unifier:
   fixes \<sigma> :: "('f, 'v, 'w) gsubst"
   assumes "vars_term s \<inter> vars_term t = {}"
     and "s \<cdot> \<sigma> = t \<cdot> \<tau>"
   shows "\<exists>\<mu> :: ('f, 'v, 'w) gsubst. s \<cdot> \<mu> = t \<cdot> \<mu>"
 proof -
   let ?\<mu> = "\<lambda>x. if x \<in> vars_term s then \<sigma> x else \<tau> x"
   have "s \<cdot> \<sigma> = s \<cdot> ?\<mu>"
     unfolding term_subst_eq_conv
     by (induct s) (simp_all)
   moreover have "t \<cdot> \<tau> = t \<cdot> ?\<mu>"
     using assms(1)
     unfolding term_subst_eq_conv
     by (induct s arbitrary: t) (auto)
   ultimately have "s \<cdot> ?\<mu> = t \<cdot> ?\<mu>" using assms(2) by simp
   then show ?thesis by blast
 qed
 
 lemma vars_term_subset_subst_eq:
   assumes "vars_term t \<subseteq> vars_term s"
     and "s \<cdot> \<sigma> = s \<cdot> \<tau>"
   shows "t \<cdot> \<sigma> = t \<cdot> \<tau>"
   using assms by (induct t) (induct s, auto)
 
 
 subsection \<open>Restrict the Domain of a Substitution\<close>
 
 definition restrict_subst_domain where \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   "restrict_subst_domain V \<sigma> x \<equiv> (if x \<in> V then \<sigma> x else Var x)"
 
 lemma restrict_subst_domain_empty[simp]: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   "restrict_subst_domain {} \<sigma> = Var"
   unfolding restrict_subst_domain_def by auto
 
 lemma restrict_subst_domain_Var[simp]: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   "restrict_subst_domain V Var = Var"
   unfolding restrict_subst_domain_def by auto
 
 lemma subst_domain_restrict_subst_domain[simp]: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   "subst_domain (restrict_subst_domain V \<sigma>) = V \<inter> subst_domain \<sigma>"
   unfolding restrict_subst_domain_def subst_domain_def by auto
 
 lemma subst_apply_term_restrict_subst_domain: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   "vars_term t \<subseteq> V \<Longrightarrow> t \<cdot> restrict_subst_domain V \<sigma> = t \<cdot> \<sigma>"
   by (rule term_subst_eq) (simp add: restrict_subst_domain_def subsetD)
 
 
 subsection \<open>Rename the Domain of a Substitution\<close>
 
 definition rename_subst_domain where \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   "rename_subst_domain \<rho> \<sigma> x =
     (if Var x \<in> \<rho> ` subst_domain \<sigma> then
       \<sigma> (the_inv \<rho> (Var x))
     else
       Var x)"
 
 lemma rename_subst_domain_Var_lhs[simp]: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   "rename_subst_domain Var \<sigma> = \<sigma>"
   by (rule ext) (simp add: rename_subst_domain_def inj_image_mem_iff the_inv_f_f subst_domain_def)
 
 lemma rename_subst_domain_Var_rhs[simp]: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   "rename_subst_domain \<rho> Var = Var"
   by (rule ext) (simp add: rename_subst_domain_def)
 
 lemma subst_domain_rename_subst_domain_subset: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   assumes is_var_\<rho>: "\<forall>x. is_Var (\<rho> x)"
   shows "subst_domain (rename_subst_domain \<rho> \<sigma>) \<subseteq> the_Var ` \<rho> ` subst_domain \<sigma>"
   by (auto simp add: subst_domain_def rename_subst_domain_def
       member_image_the_Var_image_subst[OF is_var_\<rho>])
 
 lemma subst_range_rename_subst_domain_subset: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   assumes "inj \<rho>"
   shows "subst_range (rename_subst_domain \<rho> \<sigma>) \<subseteq> subst_range \<sigma>"
 proof (intro Set.equalityI Set.subsetI)
   fix t assume "t \<in> subst_range (rename_subst_domain \<rho> \<sigma>)"
   then obtain x where
     t_def: "t = rename_subst_domain \<rho> \<sigma> x" and
     "rename_subst_domain \<rho> \<sigma> x \<noteq> Var x"
     by (auto simp: image_iff subst_domain_def)
 
   show "t \<in> subst_range \<sigma>"
   proof (cases \<open>Var x \<in> \<rho> ` subst_domain \<sigma>\<close>)
     case True
     then obtain x' where "\<rho> x' = Var x" and "x' \<in> subst_domain \<sigma>"
       by auto
     then show ?thesis
       using the_inv_f_f[OF \<open>inj \<rho>\<close>, of x']
       by (simp add: t_def rename_subst_domain_def)
   next
     case False
     hence False
       using \<open>rename_subst_domain \<rho> \<sigma> x \<noteq> Var x\<close>
       by (simp add: t_def rename_subst_domain_def)
     thus ?thesis ..
   qed
 qed
 
 lemma range_vars_rename_subst_domain_subset: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   assumes "inj \<rho>"
   shows "range_vars (rename_subst_domain \<rho> \<sigma>) \<subseteq> range_vars \<sigma>"
   unfolding range_vars_def
   using subst_range_rename_subst_domain_subset[OF \<open>inj \<rho>\<close>]
   by (metis Union_mono image_mono)
 
 lemma renaming_cancels_rename_subst_domain: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   assumes is_var_\<rho>: "\<forall>x. is_Var (\<rho> x)" and "inj \<rho>" and vars_t: "vars_term t \<subseteq> subst_domain \<sigma>"
   shows "t \<cdot> \<rho> \<cdot> rename_subst_domain \<rho> \<sigma> = t \<cdot> \<sigma>"
   unfolding subst_subst
 proof (intro term_subst_eq ballI)
   fix x assume "x \<in> vars_term t"
   with vars_t have x_in: "x \<in> subst_domain \<sigma>"
     by blast
 
   obtain x' where \<rho>_x: "\<rho> x = Var x'"
     using is_var_\<rho> by (meson is_Var_def)
   with x_in have x'_in: "Var x' \<in> \<rho> ` subst_domain \<sigma>"
     by (metis image_eqI)
 
   have "(\<rho> \<circ>\<^sub>s rename_subst_domain \<rho> \<sigma>) x = \<rho> x \<cdot> rename_subst_domain \<rho> \<sigma>"
     by (simp add: subst_compose_def)
   also have "\<dots> = rename_subst_domain \<rho> \<sigma> x'"
     using \<rho>_x by simp
   also have "\<dots> = \<sigma> (the_inv \<rho> (Var x'))"
     by (simp add: rename_subst_domain_def if_P[OF x'_in])
   also have "\<dots> = \<sigma> (the_inv \<rho> (\<rho> x))"
     by (simp add: \<rho>_x)
   also have "\<dots> = \<sigma> x"
     using \<open>inj \<rho>\<close> by (simp add: the_inv_f_f)
   finally show "(\<rho> \<circ>\<^sub>s rename_subst_domain \<rho> \<sigma>) x = \<sigma> x"
     by simp
 qed
 
 
 subsection \<open>Rename the Domain and Range of a Substitution\<close>
 
 definition rename_subst_domain_range where \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   "rename_subst_domain_range \<rho> \<sigma> x =
     (if Var x \<in> \<rho> ` subst_domain \<sigma> then
       ((Var o the_inv \<rho>) \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<rho>) (Var x)
     else
       Var x)"
 
 lemma rename_subst_domain_range_Var_lhs[simp]: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   "rename_subst_domain_range Var \<sigma> = \<sigma>"
   by (rule ext) (simp add: rename_subst_domain_range_def inj_image_mem_iff the_inv_f_f
       subst_domain_def subst_compose_def)
 
 lemma rename_subst_domain_range_Var_rhs[simp]: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   "rename_subst_domain_range \<rho> Var = Var"
   by (rule ext) (simp add: rename_subst_domain_range_def)
 
 lemma subst_compose_renaming_rename_subst_domain_range: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   fixes \<sigma> \<rho> :: "('f, 'v) subst"
   assumes is_var_\<rho>: "\<forall>x. is_Var (\<rho> x)" and "inj \<rho>"
   shows "\<rho> \<circ>\<^sub>s rename_subst_domain_range \<rho> \<sigma> = \<sigma> \<circ>\<^sub>s \<rho>"
 proof (rule ext)
   fix x
   from is_var_\<rho> obtain x' where "\<rho> x = Var x'"
     by (meson is_Var_def is_renaming_def)
   with \<open>inj \<rho>\<close> have inv_\<rho>_x': "the_inv \<rho> (Var x') = x"
     by (metis the_inv_f_f)
 
   show "(\<rho> \<circ>\<^sub>s rename_subst_domain_range \<rho> \<sigma>) x = (\<sigma> \<circ>\<^sub>s \<rho>) x"
   proof (cases "x \<in> subst_domain \<sigma>")
     case True
     hence "Var x' \<in> \<rho> ` subst_domain \<sigma>"
       using \<open>\<rho> x = Var x'\<close> by (metis imageI)
     thus ?thesis
       by (simp add: \<open>\<rho> x = Var x'\<close> rename_subst_domain_range_def subst_compose_def inv_\<rho>_x')
   next
     case False
     hence "Var x' \<notin> \<rho> ` subst_domain \<sigma>"
     proof (rule contrapos_nn)
       assume "Var x' \<in> \<rho> ` subst_domain \<sigma>"
       hence "\<rho> x \<in> \<rho> ` subst_domain \<sigma>"
         unfolding \<open>\<rho> x = Var x'\<close> .
       thus "x \<in> subst_domain \<sigma>"
         unfolding inj_image_mem_iff[OF \<open>inj \<rho>\<close>] .
     qed
     with False \<open>\<rho> x = Var x'\<close> show ?thesis
       by (simp add: subst_compose_def subst_domain_def rename_subst_domain_range_def)
   qed
 qed
 
 corollary subst_apply_term_renaming_rename_subst_domain_range: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   \<comment> \<open>This might be easier to find with @{command find_theorems}.\<close>
   fixes t :: "('f, 'v) term" and \<sigma> \<rho> :: "('f, 'v) subst"
   assumes is_var_\<rho>: "\<forall>x. is_Var (\<rho> x)" and "inj \<rho>"
   shows "t \<cdot> \<rho> \<cdot> rename_subst_domain_range \<rho> \<sigma> = t \<cdot> \<sigma> \<cdot> \<rho>"
   unfolding subst_subst
   unfolding subst_compose_renaming_rename_subst_domain_range[OF assms]
   by (rule refl)
 
 
 text \<open>A term is called \<^emph>\<open>ground\<close> if it does not contain any variables.\<close>
 fun ground :: "('f, 'v) term \<Rightarrow> bool"
   where
     "ground (Var x) \<longleftrightarrow> False" |
     "ground (Fun f ts) \<longleftrightarrow> (\<forall>t \<in> set ts. ground t)"
 
 lemma ground_vars_term_empty:
   "ground t \<longleftrightarrow> vars_term t = {}"
   by (induct t) simp_all
 
 lemma ground_subst [simp]:
   "ground (t \<cdot> \<sigma>) \<longleftrightarrow> (\<forall>x \<in> vars_term t. ground (\<sigma> x))"
   by (induct t) simp_all
 
 lemma ground_subst_apply:
   assumes "ground t"
   shows "t \<cdot> \<sigma> = t"
 proof -
   have "t = t \<cdot> Var" by simp
   also have "\<dots> = t \<cdot> \<sigma>"
     by (rule term_subst_eq, insert assms[unfolded ground_vars_term_empty], auto)
   finally show ?thesis by simp
 qed
 
+text \<open>Just changing the variables in a term\<close>
+
+abbreviation "map_vars_term f \<equiv> term.map_term (\<lambda>x. x) f"
+
+lemma map_vars_term_as_subst:
+  "map_vars_term f t = t \<cdot> (\<lambda> x. Var (f x))"
+  by (induct t) simp_all
+
+lemma map_vars_term_eq:
+  "map_vars_term f s = s \<cdot> (Var \<circ> f)"
+by (induct s) auto
+
+lemma ground_map_vars_term [simp]:
+  "ground (map_vars_term f t) = ground t"
+  by (induct t) simp_all
+
+lemma map_vars_term_subst [simp]:
+  "map_vars_term f (t \<cdot> \<sigma>) = t \<cdot> (\<lambda> x. map_vars_term f (\<sigma> x))"
+  by (induct t) simp_all
+
+lemma map_vars_term_compose:
+  "map_vars_term m1 (map_vars_term m2 t) = map_vars_term (m1 o m2) t"
+  by (induct t) simp_all
+
+lemma map_vars_term_id [simp]:
+  "map_vars_term id t = t"
+  by (induct t) (auto intro: map_idI)
+
+lemma apply_subst_map_vars_term:
+  "map_vars_term m t \<cdot> \<sigma> = t \<cdot> (\<sigma> \<circ> m)"
+  by (induct t) (auto)
 
 
 end
diff --git a/thys/First_Order_Terms/Unification.thy b/thys/First_Order_Terms/Unification.thy
--- a/thys/First_Order_Terms/Unification.thy
+++ b/thys/First_Order_Terms/Unification.thy
@@ -1,704 +1,888 @@
 (*
 Author:  Christian Sternagel <c.sternagel@gmail.com>
 Author:  René Thiemann <rene.thiemann@uibk.ac.at>
 License: LGPL
 *)
 subsection \<open>A Concrete Unification Algorithm\<close>
 
 theory Unification
   imports
     Abstract_Unification
     Option_Monad
+    Renaming2
 begin
 
 definition
   "decompose s t =
     (case (s, t) of
       (Fun f ss, Fun g ts) \<Rightarrow> if f = g then zip_option ss ts else None
     | _ \<Rightarrow> None)"
 
 lemma decompose_same_Fun[simp]: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   "decompose (Fun f ss) (Fun f ss) = Some (zip ss ss)"
   by (simp add: decompose_def)
 
 lemma decompose_Some [dest]:
   "decompose (Fun f ss) (Fun g ts) = Some E \<Longrightarrow>
     f = g \<and> length ss = length ts \<and> E = zip ss ts"
   by (cases "f = g") (auto simp: decompose_def)
 
 lemma decompose_None [dest]:
   "decompose (Fun f ss) (Fun g ts) = None \<Longrightarrow> f \<noteq> g \<or> length ss \<noteq> length ts"
   by (cases "f = g") (auto simp: decompose_def)
 
 text \<open>Applying a substitution to a list of equations.\<close>
 definition
   subst_list :: "('f, 'v) subst \<Rightarrow> ('f, 'v) equation list \<Rightarrow> ('f, 'v) equation list"
   where
     "subst_list \<sigma> ys = map (\<lambda>p. (fst p \<cdot> \<sigma>, snd p \<cdot> \<sigma>)) ys"
 
 lemma mset_subst_list [simp]:
   "mset (subst_list (subst x t) ys) = subst_mset (subst x t) (mset ys)"
   by (auto simp: subst_mset_def subst_list_def)
 
 lemma subst_list_append:
   "subst_list \<sigma> (xs @ ys) = subst_list \<sigma> xs @ subst_list \<sigma> ys"
 by (auto simp: subst_list_def)
 
 function (sequential)
   unify ::
     "('f, 'v) equation list \<Rightarrow> ('v \<times> ('f, 'v) term) list \<Rightarrow> ('v \<times> ('f, 'v) term) list option"
 where
   "unify [] bs = Some bs"
 | "unify ((Fun f ss, Fun g ts) # E) bs =
     (case decompose (Fun f ss) (Fun g ts) of
       None \<Rightarrow> None
     | Some us \<Rightarrow> unify (us @ E) bs)"
 | "unify ((Var x, t) # E) bs =
     (if t = Var x then unify E bs
     else if x \<in> vars_term t then None
     else unify (subst_list (subst x t) E) ((x, t) # bs))"
 | "unify ((t, Var x) # E) bs =
     (if x \<in> vars_term t then None
     else unify (subst_list (subst x t) E) ((x, t) # bs))"
   by pat_completeness auto
 termination
   by (standard, rule wf_inv_image [of "unif\<inverse>" "mset \<circ> fst", OF wf_converse_unif])
      (force intro: UNIF1.intros simp: unif_def union_commute)+
 
 lemma unify_append_prefix_same: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   "(\<forall>e \<in> set es1. fst e = snd e) \<Longrightarrow> unify (es1 @ es2) bs = unify es2 bs"
 proof (induction "es1 @ es2" bs arbitrary: es1 es2 bs rule: unify.induct)
   case (1 bs)
   thus ?case by simp
 next
   case (2 f ss g ts E bs)
   show ?case
   proof (cases es1)
     case Nil
     thus ?thesis by simp
   next
     case (Cons e es1')
     hence e_def: "e = (Fun f ss, Fun g ts)" and E_def: "E = es1' @ es2"
       using "2" by simp_all
     hence "f = g" and "ss = ts"
       using "2.prems" local.Cons by auto
     hence "unify (es1 @ es2) bs = unify ((zip ts ts @ es1') @ es2) bs"
       by (simp add: Cons e_def)
     also have "\<dots> = unify es2 bs"
     proof (rule "2.hyps"(1))
       show "decompose (Fun f ss) (Fun g ts) = Some (zip ts ts)"
         by (simp add: \<open>f = g\<close> \<open>ss = ts\<close>)
     next
       show "zip ts ts @ E = (zip ts ts @ es1') @ es2"
         by (simp add: E_def)
     next
       show "\<forall>e\<in>set (zip ts ts @ es1'). fst e = snd e"
         using "2.prems" by (auto simp: Cons zip_same)
     qed
     finally show ?thesis .
   qed
 next
   case (3 x t E bs)
   show ?case
   proof (cases es1)
     case Nil
     thus ?thesis by simp
   next
     case (Cons e es1')
     hence e_def: "e = (Var x, t)" and E_def: "E = es1' @ es2"
       using 3 by simp_all
     show ?thesis
     proof (cases "t = Var x")
       case True
       show ?thesis
         using 3(1)[OF True E_def]
         using "3.hyps"(3) "3.prems" local.Cons by fastforce
     next
       case False
       thus ?thesis
         using "3.prems" e_def local.Cons by force
     qed
   qed
 next
   case (4 v va x E bs)
   then show ?case
   proof (cases es1)
     case Nil
     thus ?thesis by simp
   next
     case (Cons e es1')
     hence e_def: "e = (Fun v va, Var x)" and E_def: "E = es1' @ es2"
       using 4 by simp_all
     thus ?thesis
       using "4.prems" local.Cons by fastforce
   qed
 qed
 
 corollary unify_Cons_same: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   "fst e = snd e \<Longrightarrow> unify (e # es) bs = unify es bs"
   by (rule unify_append_prefix_same[of "[_]", simplified])
 
 corollary unify_same: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   "(\<forall>e \<in> set es. fst e = snd e) \<Longrightarrow> unify es bs = Some bs"
   by (rule unify_append_prefix_same[of _ "[]", simplified])
 
 definition subst_of :: "('v \<times> ('f, 'v) term) list \<Rightarrow> ('f, 'v) subst"
   where
     "subst_of ss = List.foldr (\<lambda>(x, t) \<sigma>. \<sigma> \<circ>\<^sub>s subst x t) ss Var"
 
 text \<open>Computing the mgu of two terms.\<close>
 definition mgu :: "('f, 'v) term \<Rightarrow> ('f, 'v) term \<Rightarrow> ('f, 'v) subst option" where
   "mgu s t =
     (case unify [(s, t)] [] of
       None \<Rightarrow> None
     | Some res \<Rightarrow> Some (subst_of res))"
 
 lemma subst_of_simps [simp]:
   "subst_of [] = Var"
   "subst_of ((x, Var x) # ss) = subst_of ss"
   "subst_of (b # ss) = subst_of ss \<circ>\<^sub>s subst (fst b) (snd b)"
   by (simp_all add: subst_of_def split: prod.splits)
 
 lemma subst_of_append [simp]:
   "subst_of (ss @ ts) = subst_of ts \<circ>\<^sub>s subst_of ss"
   by (induct ss) (auto simp: ac_simps)
 
 text \<open>The concrete algorithm \<open>unify\<close> can be simulated by the inference
   rules of \<open>UNIF\<close>.\<close>
 lemma unify_Some_UNIF:
   assumes "unify E bs = Some cs"
   shows "\<exists>ds ss. cs = ds @ bs \<and> subst_of ds = compose ss \<and> UNIF ss (mset E) {#}"
 using assms
 proof (induction E bs arbitrary: cs rule: unify.induct)
   case (2 f ss g ts E bs)
   then obtain us where "decompose (Fun f ss) (Fun g ts) = Some us"
     and [simp]: "f = g" "length ss = length ts" "us = zip ss ts"
     and "unify (us @ E) bs = Some cs" by (auto split: option.splits)
   from "2.IH" [OF this(1, 5)] obtain xs ys
     where "cs = xs @ bs"
     and [simp]: "subst_of xs = compose ys"
     and *: "UNIF ys (mset (us @ E)) {#}" by auto
   then have "UNIF (Var # ys) (mset ((Fun f ss, Fun g ts) # E)) {#}"
     by (force intro: UNIF1.decomp simp: ac_simps)
   moreover have "cs = xs @ bs" by fact
   moreover have "subst_of xs = compose (Var # ys)" by simp
   ultimately show ?case by blast
 next
   case (3 x t E bs)
   show ?case
   proof (cases "t = Var x")
     assume "t = Var x"
     then show ?case
       using 3 by auto (metis UNIF.step compose_simps(2) UNIF1.trivial)
   next
     assume "t \<noteq> Var x"
     with 3 obtain xs ys
       where [simp]: "cs = (ys @ [(x, t)]) @ bs"
       and [simp]: "subst_of ys = compose xs"
       and "x \<notin> vars_term t"
       and "UNIF xs (mset (subst_list (subst x t) E)) {#}"
         by (cases "x \<in> vars_term t") force+
     then have "UNIF (subst x t # xs) (mset ((Var x, t) # E)) {#}"
       by (force intro: UNIF1.Var_left simp: ac_simps)
     moreover have "cs = (ys @ [(x, t)]) @ bs" by simp
     moreover have "subst_of (ys @ [(x, t)]) = compose (subst x t # xs)" by simp
     ultimately show ?case by blast
   qed
 next
   case (4 f ss x E bs)
   with 4 obtain xs ys
     where [simp]: "cs = (ys @ [(x, Fun f ss)]) @ bs"
     and [simp]: "subst_of ys = compose xs"
     and "x \<notin> vars_term (Fun f ss)"
     and "UNIF xs (mset (subst_list (subst x (Fun f ss)) E)) {#}"
       by (cases "x \<in> vars_term (Fun f ss)") force+
   then have "UNIF (subst x (Fun f ss) # xs) (mset ((Fun f ss, Var x) # E)) {#}"
     by (force intro: UNIF1.Var_right simp: ac_simps)
   moreover have "cs = (ys @ [(x, Fun f ss)]) @ bs" by simp
   moreover have "subst_of (ys @ [(x, Fun f ss)]) = compose (subst x (Fun f ss) # xs)" by simp
   ultimately show ?case by blast
 qed force
 
 lemma unify_sound:
   assumes "unify E [] = Some cs"
   shows "is_imgu (subst_of cs) (set E)"
 proof -
   from unify_Some_UNIF [OF assms] obtain ss
     where "subst_of cs = compose ss"
     and "UNIF ss (mset E) {#}" by auto
   with UNIF_empty_imp_is_mgu_compose [OF this(2)]
     and UNIF_idemp [OF this(2)]
     show ?thesis
       by (auto simp add: is_imgu_def is_mgu_def)
          (metis subst_compose_assoc)
 qed
 
 lemma mgu_sound:
   assumes "mgu s t = Some \<sigma>"
   shows "is_imgu \<sigma> {(s, t)}"
 proof -
   obtain ss where "unify [(s, t)] [] = Some ss"
     and "\<sigma> = subst_of ss"
     using assms by (auto simp: mgu_def split: option.splits)
   then have "is_imgu \<sigma> (set [(s, t)])" by (metis unify_sound)
   then show ?thesis by simp
 qed
 
 text \<open>If \<open>unify\<close> gives up, then the given set of equations
   cannot be reduced to the empty set by \<open>UNIF\<close>.\<close>
 lemma unify_None:
   assumes "unify E ss = None"
   shows "\<exists>E'. E' \<noteq> {#} \<and> (mset E, E') \<in> unif\<^sup>!"
 using assms
 proof (induction E ss rule: unify.induct)
   case (1 bs)
   then show ?case by simp
 next
   case (2 f ss g ts E bs)
   moreover
   { assume *: "decompose (Fun f ss) (Fun g ts) = None"
     have ?case
     proof (cases "unifiable (set E)")
       case True
       then have "(mset E, {#}) \<in> unif\<^sup>*"
         by (simp add: unifiable_imp_empty)
       from unif_rtrancl_mono [OF this, of "{#(Fun f ss, Fun g ts)#}"] obtain \<sigma>
         where "(mset E + {#(Fun f ss, Fun g ts)#}, {#(Fun f ss \<cdot> \<sigma>, Fun g ts \<cdot> \<sigma>)#}) \<in> unif\<^sup>*"
         by (auto simp: subst_mset_def)
       moreover have "{#(Fun f ss \<cdot> \<sigma>, Fun g ts \<cdot> \<sigma>)#} \<in> NF unif"
         using decompose_None [OF *]
         by (auto simp: single_is_union NF_def unif_def elim!: UNIF1.cases)
            (metis length_map)
       ultimately show ?thesis
         by auto (metis normalizability_I add_mset_not_empty)
     next
       case False
       moreover have "\<not> unifiable {(Fun f ss, Fun g ts)}"
         using * by (auto simp: unifiable_def)
       ultimately have "\<not> unifiable (set ((Fun f ss, Fun g ts) # E))" by (auto simp: unifiable_def unifiers_def)
       then show ?thesis by (simp add: not_unifiable_imp_not_empty_NF)
     qed }
   moreover
   { fix us
     assume *: "decompose (Fun f ss) (Fun g ts) = Some us"
       and "unify (us @ E) bs = None"
     from "2.IH" [OF this] obtain E'
       where "E' \<noteq> {#}" and "(mset (us @ E), E') \<in> unif\<^sup>!" by blast
     moreover have "(mset ((Fun f ss, Fun g ts) # E), mset (us @ E)) \<in> unif"
     proof -
       have "g = f" and "length ss = length ts" and "us = zip ss ts"
         using * by auto
       then show ?thesis
         by (auto intro: UNIF1.decomp simp: unif_def ac_simps)
     qed
     ultimately have ?case by auto }
   ultimately show ?case by (auto split: option.splits)
 next
   case (3 x t E bs)
   { assume [simp]: "t = Var x"
     obtain E' where "E' \<noteq> {#}" and "(mset E, E') \<in> unif\<^sup>!" using 3 by auto
     moreover have "(mset ((Var x, t) # E), mset E) \<in> unif"
       by (auto intro: UNIF1.trivial simp: unif_def)
     ultimately have ?case by auto }
   moreover
   { assume *: "t \<noteq> Var x" "x \<notin> vars_term t"
     then obtain E' where "E' \<noteq> {#}"
       and "(mset (subst_list (subst x t) E), E') \<in> unif\<^sup>!" using 3 by auto
     moreover have "(mset ((Var x, t) # E), mset (subst_list (subst x t) E)) \<in> unif"
       using * by (auto intro: UNIF1.Var_left simp: unif_def)
     ultimately have ?case by auto }
   moreover
   { assume *: "t \<noteq> Var x" "x \<in> vars_term t"
     then have "x \<in> vars_term t" "is_Fun t" by auto
     then have "\<not> unifiable {(Var x, t)}" by (rule in_vars_is_Fun_not_unifiable)
     then have **: "\<not> unifiable {(Var x \<cdot> \<sigma>, t \<cdot> \<sigma>)}" for \<sigma> :: "('b, 'a) subst"
       using subst_set_reflects_unifiable [of \<sigma> "{(Var x, t)}"] by (auto simp: subst_set_def)
     have ?case
     proof (cases "unifiable (set E)")
       case True
       then have "(mset E, {#}) \<in> unif\<^sup>*"
         by (simp add: unifiable_imp_empty)
       from unif_rtrancl_mono [OF this, of "{#(Var x, t)#}"] obtain \<sigma>
         where "(mset E + {#(Var x, t)#}, {#(Var x \<cdot> \<sigma>, t \<cdot> \<sigma>)#}) \<in> unif\<^sup>*"
         by (auto simp: subst_mset_def)
       moreover obtain E' where "E' \<noteq> {#}"
         and "({#(Var x \<cdot> \<sigma>, t \<cdot> \<sigma>)#}, E') \<in> unif\<^sup>!"
         using not_unifiable_imp_not_empty_NF and **
           by (metis set_mset_single)
       ultimately show ?thesis by auto
     next
       case False
       moreover have "\<not> unifiable {(Var x, t)}"
         using * by (force simp: unifiable_def)
       ultimately have "\<not> unifiable (set ((Var x, t) # E))" by (auto simp: unifiable_def unifiers_def)
       then show ?thesis
         by (simp add: not_unifiable_imp_not_empty_NF)
     qed }
   ultimately show ?case by blast
 next
   case (4 f ss x E bs)
   define t where "t = Fun f ss"
   { assume *: "x \<notin> vars_term t"
     then obtain E' where "E' \<noteq> {#}"
       and "(mset (subst_list (subst x t) E), E') \<in> unif\<^sup>!" using 4 by (auto simp: t_def)
     moreover have "(mset ((t, Var x) # E), mset (subst_list (subst x t) E)) \<in> unif"
       using * by (auto intro: UNIF1.Var_right simp: unif_def)
     ultimately have ?case by (auto simp: t_def) }
   moreover
   { assume "x \<in> vars_term t"
     then have *: "x \<in> vars_term t" "t \<noteq> Var x" by (auto simp: t_def)
     then have "x \<in> vars_term t" "is_Fun t" by auto
     then have "\<not> unifiable {(Var x, t)}" by (rule in_vars_is_Fun_not_unifiable)
     then have **: "\<not> unifiable {(Var x \<cdot> \<sigma>, t \<cdot> \<sigma>)}" for \<sigma> :: "('b, 'a) subst"
       using subst_set_reflects_unifiable [of \<sigma> "{(Var x, t)}"] by (auto simp: subst_set_def)
     have ?case
     proof (cases "unifiable (set E)")
       case True
       then have "(mset E, {#}) \<in> unif\<^sup>*"
         by (simp add: unifiable_imp_empty)
       from unif_rtrancl_mono [OF this, of "{#(t, Var x)#}"] obtain \<sigma>
         where "(mset E + {#(t, Var x)#}, {#(t \<cdot> \<sigma>, Var x \<cdot> \<sigma>)#}) \<in> unif\<^sup>*"
         by (auto simp: subst_mset_def)
       moreover obtain E' where "E' \<noteq> {#}"
         and "({#(t \<cdot> \<sigma>, Var x \<cdot> \<sigma>)#}, E') \<in> unif\<^sup>!"
         using not_unifiable_imp_not_empty_NF and **
           by (metis unifiable_insert_swap set_mset_single)
       ultimately show ?thesis by (auto simp: t_def)
     next
       case False
       moreover have "\<not> unifiable {(t, Var x)}"
         using * by (simp add: unifiable_def)
       ultimately have "\<not> unifiable (set ((t, Var x) # E))" by (auto simp: unifiable_def unifiers_def)
       then show ?thesis by (simp add: not_unifiable_imp_not_empty_NF t_def)
     qed }
   ultimately show ?case by blast
 qed
 
 lemma unify_complete:
   assumes "unify E bs = None"
   shows "unifiers (set E) = {}"
 proof -
   from unify_None [OF assms] obtain E'
     where "E' \<noteq> {#}" and "(mset E, E') \<in> unif\<^sup>!" by blast
   then have "\<not> unifiable (set E)"
     using irreducible_reachable_imp_not_unifiable by force
   then show ?thesis
     by (auto simp: unifiable_def)
 qed
 
 corollary ex_unify_if_unifiers_not_empty: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   "unifiers es \<noteq> {} \<Longrightarrow> set xs = es \<Longrightarrow> \<exists>ys. unify xs [] = Some ys"
   using unify_complete by auto
 
 lemma mgu_complete:
   "mgu s t = None \<Longrightarrow> unifiers {(s, t)} = {}"
 proof -
   assume "mgu s t = None"
   then have "unify [(s, t)] [] = None" by (cases "unify [(s, t)] []", auto simp: mgu_def)
   then have "unifiers (set [(s, t)]) = {}" by (rule unify_complete)
   then show ?thesis by simp
 qed
 
 corollary ex_mgu_if_unifiers_not_empty: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   "unifiers {(t,u)} \<noteq> {} \<Longrightarrow> \<exists>\<mu>. mgu t u = Some \<mu>"
   using mgu_complete by auto
 
 corollary ex_mgu_if_subst_apply_term_eq_subst_apply_term: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   fixes t u :: "('f, 'v) Term.term" and \<sigma> :: "('f, 'v) subst"
   assumes t_eq_u: "t \<cdot> \<sigma> = u \<cdot> \<sigma>"
   shows "\<exists>\<mu> :: ('f, 'v) subst. Unification.mgu t u = Some \<mu>"
 proof -
   from t_eq_u have "unifiers {(t, u)} \<noteq> {}"
     unfolding unifiers_def by auto
   thus ?thesis
     by (rule ex_mgu_if_unifiers_not_empty)
 qed
 
 lemma finite_subst_domain_subst_of:
   "finite (subst_domain (subst_of xs))"
 proof (induct xs)
   case (Cons x xs)
   moreover have "finite (subst_domain (subst (fst x) (snd x)))" by (metis finite_subst_domain_subst)
   ultimately show ?case
     using subst_domain_compose [of "subst_of xs" "subst (fst x) (snd x)"]
     by (simp del: subst_subst_domain) (metis finite_subset infinite_Un)
 qed simp
 
 lemma unify_subst_domain: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   assumes unif: "unify E [] = Some xs"
   shows "subst_domain (subst_of xs) \<subseteq> (\<Union>e \<in> set E. vars_term (fst e) \<union> vars_term (snd e))"
 proof -
   from unify_Some_UNIF[OF unif] obtain xs' where
     "subst_of xs = compose xs'" and "UNIF xs' (mset E) {#}"
     by auto
   thus ?thesis
     using UNIF_subst_domain_subset
     by (metis (mono_tags, lifting) multiset.set_map set_mset_mset vars_mset_def)
 qed
 
 lemma mgu_subst_domain:
   assumes "mgu s t = Some \<sigma>"
   shows "subst_domain \<sigma> \<subseteq> vars_term s \<union> vars_term t"
 proof -
   obtain xs where "unify [(s, t)] [] = Some xs" and "\<sigma> = subst_of xs"
     using assms by (simp add: mgu_def split: option.splits)
   thus ?thesis
     using unify_subst_domain by fastforce
 qed
 
 lemma mgu_finite_subst_domain:
   "mgu s t = Some \<sigma> \<Longrightarrow> finite (subst_domain \<sigma>)"
   by (drule mgu_subst_domain) (simp add: finite_subset)
 
 lemma unify_range_vars: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   assumes unif: "unify E [] = Some xs"
   shows "range_vars (subst_of xs) \<subseteq> (\<Union>e \<in> set E. vars_term (fst e) \<union> vars_term (snd e))"
 proof -
   from unify_Some_UNIF[OF unif] obtain xs' where
     "subst_of xs = compose xs'" and "UNIF xs' (mset E) {#}"
     by auto
   thus ?thesis
     using UNIF_range_vars_subset
     by (metis (mono_tags, lifting) multiset.set_map set_mset_mset vars_mset_def)
 qed
 
 lemma mgu_range_vars: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   assumes "mgu s t = Some \<mu>"
   shows "range_vars \<mu> \<subseteq> vars_term s \<union> vars_term t"
 proof -
   obtain xs where "unify [(s, t)] [] = Some xs" and "\<mu> = subst_of xs"
     using assms by (simp add: mgu_def split: option.splits)
   thus ?thesis
     using unify_range_vars by fastforce
 qed
 
 lemma unify_subst_domain_range_vars_disjoint: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   assumes unif: "unify E [] = Some xs"
   shows "subst_domain (subst_of xs) \<inter> range_vars (subst_of xs) = {}"
 proof -
   from unify_Some_UNIF[OF unif] obtain xs' where
     "subst_of xs = compose xs'" and "UNIF xs' (mset E) {#}"
     by auto
   thus ?thesis
     using UNIF_subst_domain_range_vars_Int by metis
 qed
 
 lemma mgu_subst_domain_range_vars_disjoint: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   assumes "mgu s t = Some \<mu>"
   shows "subst_domain \<mu> \<inter> range_vars \<mu> = {}"
 proof -
   obtain xs where "unify [(s, t)] [] = Some xs" and "\<mu> = subst_of xs"
     using assms by (simp add: mgu_def split: option.splits)
   thus ?thesis
     using unify_subst_domain_range_vars_disjoint by metis
 qed
 
 corollary subst_apply_term_eq_subst_apply_term_if_mgu: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   assumes mgu_t_u: "mgu t u = Some \<mu>"
   shows "t \<cdot> \<mu> = u \<cdot> \<mu>"
   using mgu_sound[OF mgu_t_u]
   by (simp add: is_imgu_def unifiers_def)
 
 lemma mgu_same: "mgu t t = Some Var" \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   by (simp add: mgu_def unify_same)
 
 lemma mgu_is_Var_if_not_in_equations: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   fixes \<mu> :: "('f, 'v) subst" and E :: "('f, 'v) equations" and x :: 'v
   assumes
     mgu_\<mu>: "is_mgu \<mu> E" and
     x_not_in: "x \<notin> (\<Union>e\<in>E. vars_term (fst e) \<union> vars_term (snd e))"
   shows "is_Var (\<mu> x)"
 proof -
   from mgu_\<mu> have unif_\<mu>: "\<mu> \<in> unifiers E" and minimal_\<mu>: "\<forall>\<tau> \<in> unifiers E. \<exists>\<gamma>. \<tau> = \<mu> \<circ>\<^sub>s \<gamma>"
     by (simp_all add: is_mgu_def)
 
   define \<tau> :: "('f, 'v) subst" where
     "\<tau> = (\<lambda>x. if x \<in> (\<Union>e \<in> E. vars_term (fst e) \<union> vars_term (snd e)) then \<mu> x else Var x)"
 
   have \<open>\<tau> \<in> unifiers E\<close>
     unfolding unifiers_def mem_Collect_eq
   proof (rule ballI)
     fix e assume "e \<in> E"
     with unif_\<mu> have "fst e \<cdot> \<mu> = snd e \<cdot> \<mu>"
       by blast
     moreover from \<open>e \<in> E\<close> have "fst e \<cdot> \<tau> = fst e \<cdot> \<mu>" and "snd e \<cdot> \<tau> = snd e \<cdot> \<mu>"
       unfolding term_subst_eq_conv
       by (auto simp: \<tau>_def)
     ultimately show "fst e \<cdot> \<tau> = snd e \<cdot> \<tau>"
       by simp
   qed
   with minimal_\<mu> obtain \<gamma> where "\<mu> \<circ>\<^sub>s \<gamma> = \<tau>"
     by auto
   with x_not_in have "(\<mu> \<circ>\<^sub>s \<gamma>) x = Var x"
     by (simp add: \<tau>_def)
   thus "is_Var (\<mu> x)"
     by (metis subst_apply_eq_Var subst_compose term.disc(1))
 qed
 
 corollary mgu_ball_is_Var: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   "is_mgu \<mu> E \<Longrightarrow> \<forall>x \<in> - (\<Union>e\<in>E. vars_term (fst e) \<union> vars_term (snd e)). is_Var (\<mu> x)"
   by (rule ballI) (rule mgu_is_Var_if_not_in_equations[folded Compl_iff])
 
 lemma mgu_inj_on: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   fixes \<mu> :: "('f, 'v) subst" and E :: "('f, 'v) equations"
   assumes mgu_\<mu>: "is_mgu \<mu> E"
   shows "inj_on \<mu> (- (\<Union>e \<in> E. vars_term (fst e) \<union> vars_term (snd e)))"
 proof (rule inj_onI)
   fix x y
   assume
     x_in: "x \<in> - (\<Union>e\<in>E. vars_term (fst e) \<union> vars_term (snd e))" and
     y_in: "y \<in> - (\<Union>e\<in>E. vars_term (fst e) \<union> vars_term (snd e))" and
     "\<mu> x = \<mu> y"
 
   from mgu_\<mu> have unif_\<mu>: "\<mu> \<in> unifiers E" and minimal_\<mu>: "\<forall>\<tau> \<in> unifiers E. \<exists>\<gamma>. \<tau> = \<mu> \<circ>\<^sub>s \<gamma>"
     by (simp_all add: is_mgu_def)
 
   define \<tau> :: "('f, 'v) subst" where
     "\<tau> = (\<lambda>x. if x \<in> (\<Union>e \<in> E. vars_term (fst e) \<union> vars_term (snd e)) then \<mu> x else Var x)"
 
   have \<open>\<tau> \<in> unifiers E\<close>
     unfolding unifiers_def mem_Collect_eq
   proof (rule ballI)
     fix e assume "e \<in> E"
     with unif_\<mu> have "fst e \<cdot> \<mu> = snd e \<cdot> \<mu>"
       by blast
     moreover from \<open>e \<in> E\<close> have "fst e \<cdot> \<tau> = fst e \<cdot> \<mu>" and "snd e \<cdot> \<tau> = snd e \<cdot> \<mu>"
       unfolding term_subst_eq_conv
       by (auto simp: \<tau>_def)
     ultimately show "fst e \<cdot> \<tau> = snd e \<cdot> \<tau>"
       by simp
   qed
   with minimal_\<mu> obtain \<gamma> where "\<mu> \<circ>\<^sub>s \<gamma> = \<tau>"
     by auto
   hence "(\<mu> \<circ>\<^sub>s \<gamma>) x = Var x" and "(\<mu> \<circ>\<^sub>s \<gamma>) y = Var y"
     using ComplD[OF x_in] ComplD[OF y_in]
     by (simp_all add: \<tau>_def)
   with \<open>\<mu> x = \<mu> y\<close> show "x = y"
     by (simp add: subst_compose_def)
 qed
 
 lemma imgu_subst_domain_subset: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   fixes \<mu> :: "('f, 'v) subst" and E :: "('f, 'v) equations" and Evars :: "'v set"
   assumes imgu_\<mu>: "is_imgu \<mu> E" and fin_E: "finite E"
   defines "Evars \<equiv> (\<Union>e \<in> E. vars_term (fst e) \<union> vars_term (snd e))"
   shows "subst_domain \<mu> \<subseteq> Evars"
 proof (intro Set.subsetI)
   from imgu_\<mu> have unif_\<mu>: "\<mu> \<in> unifiers E" and minimal_\<mu>: "\<forall>\<tau> \<in> unifiers E. \<mu> \<circ>\<^sub>s \<tau> = \<tau>"
     by (simp_all add: is_imgu_def)
 
   from fin_E obtain es :: "('f, 'v) equation list" where
     "set es = E"
     using finite_list by auto
   then obtain xs :: "('v \<times> ('f, 'v) Term.term) list" where
     unify_es: "unify es [] = Some xs"
     using unif_\<mu> ex_unify_if_unifiers_not_empty by blast
 
   define \<tau> :: "('f, 'v) subst" where
     "\<tau> = subst_of xs"
 
   have dom_\<tau>: "subst_domain \<tau> \<subseteq> Evars"
     using unify_subst_domain[OF unify_es, unfolded \<open>set es = E\<close>, folded Evars_def \<tau>_def] .
   have range_vars_\<tau>: "range_vars \<tau> \<subseteq> Evars"
     using unify_range_vars[OF unify_es, unfolded \<open>set es = E\<close>, folded Evars_def \<tau>_def] .
 
   have "\<tau> \<in> unifiers E"
     using \<open>set es = E\<close> unify_es \<tau>_def is_imgu_def unify_sound by blast
   with minimal_\<mu> have \<mu>_comp_\<tau>: "\<And>x. (\<mu> \<circ>\<^sub>s \<tau>) x = \<tau> x"
     by auto
 
   fix x :: 'v assume "x \<in> subst_domain \<mu>"
   hence "\<mu> x \<noteq> Var x"
     by (simp add: subst_domain_def)
 
   show "x \<in> Evars"
   proof (cases "x \<in> subst_domain \<tau>")
     case True
     thus ?thesis
       using dom_\<tau> by auto
   next
     case False
     hence "\<tau> x = Var x"
       by (simp add: subst_domain_def)
     hence "\<mu> x \<cdot> \<tau> = Var x"
       using \<mu>_comp_\<tau>[of x] by (simp add: subst_compose)
     thus ?thesis
     proof (rule subst_apply_eq_Var[of "\<mu> x" \<tau> x])
       show "\<And>y. \<mu> x = Var y \<Longrightarrow> \<tau> y = Var x \<Longrightarrow> ?thesis"
         using \<open>\<mu> x \<noteq> Var x\<close> range_vars_\<tau> mem_range_varsI[of \<tau> _ x] by auto
     qed
   qed
 qed
 
 lemma imgu_range_vars_of_equations_vars_subset: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   fixes \<mu> :: "('f, 'v) subst" and E :: "('f, 'v) equations" and Evars :: "'v set"
   assumes imgu_\<mu>: "is_imgu \<mu> E" and fin_E: "finite E"
   defines "Evars \<equiv> (\<Union>e \<in> E. vars_term (fst e) \<union> vars_term (snd e))"
   shows "(\<Union>x \<in> Evars. vars_term (\<mu> x)) \<subseteq> Evars"
 proof (rule Set.subsetI)
   from imgu_\<mu> have unif_\<mu>: "\<mu> \<in> unifiers E" and minimal_\<mu>: "\<forall>\<tau> \<in> unifiers E. \<mu> \<circ>\<^sub>s \<tau> = \<tau>"
     by (simp_all add: is_imgu_def)
 
   from fin_E obtain es :: "('f, 'v) equation list" where
     "set es = E"
     using finite_list by auto
   then obtain xs :: "('v \<times> ('f, 'v) Term.term) list" where
     unify_es: "unify es [] = Some xs"
     using unif_\<mu> ex_unify_if_unifiers_not_empty by blast
 
   define \<tau> :: "('f, 'v) subst" where
     "\<tau> = subst_of xs"
 
   have dom_\<tau>: "subst_domain \<tau> \<subseteq> Evars"
     using unify_subst_domain[OF unify_es, unfolded \<open>set es = E\<close>, folded Evars_def \<tau>_def] .
   have range_vars_\<tau>: "range_vars \<tau> \<subseteq> Evars"
     using unify_range_vars[OF unify_es, unfolded \<open>set es = E\<close>, folded Evars_def \<tau>_def] .
   hence ball_vars_apply_\<tau>_subset: "\<forall>x \<in> subst_domain \<tau>. vars_term (\<tau> x) \<subseteq> Evars"
     unfolding range_vars_def
     by (simp add: SUP_le_iff)
 
   have "\<tau> \<in> unifiers E"
     using \<open>set es = E\<close> unify_es \<tau>_def is_imgu_def unify_sound by blast
   with minimal_\<mu> have \<mu>_comp_\<tau>: "\<And>x. (\<mu> \<circ>\<^sub>s \<tau>) x = \<tau> x"
     by auto
 
   fix y :: 'v assume "y \<in> (\<Union>x \<in> Evars. vars_term (\<mu> x))"
   then obtain x :: 'v where
     x_in: "x \<in> Evars" and y_in: "y \<in> vars_term (\<mu> x)"
     by (auto simp: subst_domain_def)
   have vars_\<tau>_x: "vars_term (\<tau> x) \<subseteq> Evars"
     using ball_vars_apply_\<tau>_subset subst_domain_def x_in by fastforce
 
   show "y \<in> Evars"
   proof (rule ccontr)
     assume "y \<notin> Evars"
     hence "y \<notin> vars_term (\<tau> x)"
       using vars_\<tau>_x by blast
     moreover have "y \<in> vars_term ((\<mu> \<circ>\<^sub>s \<tau>) x)"
     proof -
       have "\<tau> y = Var y"
         using \<open>y \<notin> Evars\<close> dom_\<tau>
         by (auto simp add: subst_domain_def)
       thus ?thesis
         unfolding subst_compose_def vars_term_subst_apply_term UN_iff
         using y_in by force
     qed
     ultimately show False
       using \<mu>_comp_\<tau>[of x] by simp
   qed
 qed
 
 lemma imgu_range_vars_subset: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   fixes \<mu> :: "('f, 'v) subst" and E :: "('f, 'v) equations"
   assumes imgu_\<mu>: "is_imgu \<mu> E" and fin_E: "finite E"
   shows "range_vars \<mu> \<subseteq> (\<Union>e \<in> E. vars_term (fst e) \<union> vars_term (snd e))"
 proof -
   have "range_vars \<mu> = (\<Union>x \<in> subst_domain \<mu>. vars_term (\<mu> x))"
     by (simp add: range_vars_def)
   also have "\<dots> \<subseteq> (\<Union>x \<in> (\<Union>e \<in> E. vars_term (fst e) \<union> vars_term (snd e)). vars_term (\<mu> x))"
     using imgu_subst_domain_subset[OF imgu_\<mu> fin_E] by fast
   also have "\<dots> \<subseteq> (\<Union>e \<in> E. vars_term (fst e) \<union> vars_term (snd e))"
     using imgu_range_vars_of_equations_vars_subset[OF imgu_\<mu> fin_E] by metis
   finally show ?thesis .
 qed
 
+
+definition the_mgu :: "('f, 'v) term \<Rightarrow> ('f, 'v) term \<Rightarrow> ('f ,'v) subst" where
+  "the_mgu s t = (case mgu s t of None \<Rightarrow> Var | Some \<delta> \<Rightarrow> \<delta>)"
+
+lemma the_mgu_is_imgu:
+  fixes \<sigma> :: "('f, 'v) subst"
+  assumes "s \<cdot> \<sigma> = t \<cdot> \<sigma>"
+  shows "is_imgu (the_mgu s t) {(s, t)}"
+proof -
+  from assms have "unifiers {(s, t)} \<noteq> {}" by (force simp: unifiers_def)
+  then obtain \<tau> where "mgu s t = Some \<tau>"
+    and "the_mgu s t = \<tau>"
+    using mgu_complete by (auto simp: the_mgu_def)
+  with mgu_sound show ?thesis by blast
+qed
+
+lemma the_mgu:
+  fixes \<sigma> :: "('f, 'v) subst"
+  assumes "s \<cdot> \<sigma> = t \<cdot> \<sigma>"
+  shows "s \<cdot> the_mgu s t = t \<cdot> the_mgu s t \<and> \<sigma> = the_mgu s t \<circ>\<^sub>s \<sigma>" 
+proof -
+  have *: "\<sigma> \<in> unifiers {(s, t)}" by (force simp: assms unifiers_def)
+  show ?thesis
+  proof (cases "mgu s t")
+    assume "mgu s t = None"
+    then have "unifiers {(s, t)} = {}" by (rule mgu_complete)
+    with * show ?thesis by simp
+  next
+    fix \<tau>
+    assume "mgu s t = Some \<tau>"
+    moreover then have "is_imgu \<tau> {(s, t)}" by (rule mgu_sound)
+    ultimately have "is_imgu (the_mgu s t) {(s, t)}" by (unfold the_mgu_def, simp)
+    with * show ?thesis by (auto simp: is_imgu_def unifiers_def)
+  qed
+qed
+
+subsubsection \<open>Unification of two terms where variables should be considered disjoint\<close>
+
+definition
+  mgu_var_disjoint_generic ::
+    "('v \<Rightarrow> 'u) \<Rightarrow> ('w \<Rightarrow> 'u) \<Rightarrow> ('f, 'v) term \<Rightarrow> ('f, 'w) term \<Rightarrow>
+      (('f, 'v, 'u) gsubst \<times> ('f, 'w, 'u) gsubst) option"
+where
+  "mgu_var_disjoint_generic vu wu s t =
+    (case mgu (map_vars_term vu s) (map_vars_term wu t) of
+      None \<Rightarrow> None 
+    | Some \<gamma> \<Rightarrow> Some (\<gamma> \<circ> vu, \<gamma> \<circ> wu))"
+
+lemma mgu_var_disjoint_generic_sound: 
+  assumes unif: "mgu_var_disjoint_generic vu wu s t = Some (\<gamma>1, \<gamma>2)"
+  shows "s \<cdot> \<gamma>1 = t \<cdot> \<gamma>2"
+proof -
+  from unif[unfolded mgu_var_disjoint_generic_def] obtain \<gamma> where
+    unif2: "mgu (map_vars_term vu s) (map_vars_term wu t) = Some \<gamma>"
+    by (cases "mgu (map_vars_term vu s) (map_vars_term wu t)", auto)
+  from mgu_sound[OF unif2[unfolded mgu_var_disjoint_generic_def], unfolded is_imgu_def unifiers_def]
+  have "map_vars_term vu s \<cdot> \<gamma> = map_vars_term wu t \<cdot> \<gamma>" by auto
+  from this[unfolded apply_subst_map_vars_term] unif[unfolded mgu_var_disjoint_generic_def unif2] 
+  show ?thesis by simp
+qed
+
+(* if terms s and t can become identical via two substitutions \<sigma> and \<delta> 
+   then mgu_var_disjoint yields two more general substitutions \<mu>1 \<mu>2 *)
+lemma mgu_var_disjoint_generic_complete:
+  fixes \<sigma> :: "('f, 'v, 'u) gsubst" and \<tau> :: "('f, 'w, 'u) gsubst" 
+    and vu :: "'v \<Rightarrow> 'u" and wu:: "'w \<Rightarrow> 'u"
+  assumes inj: "inj vu" "inj wu"
+    and vwu: "range vu \<inter> range wu = {}"
+    and unif_disj: "s \<cdot> \<sigma> = t \<cdot> \<tau>"
+  shows "\<exists>\<mu>1 \<mu>2 \<delta>. mgu_var_disjoint_generic vu wu s t = Some (\<mu>1, \<mu>2) \<and> 
+    \<sigma> = \<mu>1 \<circ>\<^sub>s \<delta> \<and>
+    \<tau> = \<mu>2 \<circ>\<^sub>s \<delta> \<and>
+    s \<cdot> \<mu>1 = t \<cdot> \<mu>2"
+proof -
+  note inv1[simp] = the_inv_f_f[OF inj(1)]
+  note inv2[simp] = the_inv_f_f[OF inj(2)]
+  obtain \<gamma> :: "('f,'u)subst" where gamma: "\<gamma> = (\<lambda> x. if x \<in> range vu then \<sigma> (the_inv vu x) else \<tau> (the_inv wu x))" by auto 
+  have ids: "s \<cdot> \<sigma> = map_vars_term vu s \<cdot> \<gamma>" unfolding gamma
+    by (induct s, auto)
+  have idt: "t \<cdot> \<tau> = map_vars_term wu t \<cdot> \<gamma>" unfolding gamma
+    by (induct t, insert vwu, auto)
+  from unif_disj ids idt
+  have unif: "map_vars_term vu s \<cdot> \<gamma> = map_vars_term wu t \<cdot> \<gamma>" (is "?s \<cdot> \<gamma> = ?t \<cdot> \<gamma>") by auto
+  from the_mgu[OF unif] have unif2: "?s \<cdot> the_mgu ?s ?t = ?t \<cdot> the_mgu ?s ?t" and inst: "\<gamma> = the_mgu ?s ?t \<circ>\<^sub>s \<gamma>" by auto
+  have "mgu ?s ?t = Some (the_mgu ?s ?t)" unfolding the_mgu_def
+    using mgu_complete[unfolded unifiers_def] unif
+    by (cases "mgu ?s ?t", auto)
+  with inst obtain \<mu> where mu: "mgu ?s ?t = Some \<mu>" and gamma_mu: "\<gamma> = \<mu> \<circ>\<^sub>s \<gamma>" by auto
+  let ?tau1 = "\<mu> \<circ> vu"
+  let ?tau2 = "\<mu> \<circ> wu"
+  show ?thesis unfolding mgu_var_disjoint_generic_def mu option.simps
+  proof (intro exI conjI, rule refl)
+    show "\<sigma> = ?tau1 \<circ>\<^sub>s \<gamma>"
+    proof (rule ext)
+      fix x
+      have "(?tau1 \<circ>\<^sub>s \<gamma>) x = \<gamma> (vu x)" using fun_cong[OF gamma_mu, of "vu x"] by (simp add: subst_compose_def)
+      also have "... = \<sigma> x" unfolding gamma by simp
+      finally show "\<sigma> x = (?tau1 \<circ>\<^sub>s \<gamma>) x" by simp
+    qed
+  next
+    show "\<tau> = ?tau2 \<circ>\<^sub>s \<gamma>"
+    proof (rule ext)
+      fix x
+      have "(?tau2 \<circ>\<^sub>s \<gamma>) x = \<gamma> (wu x)" using fun_cong[OF gamma_mu, of "wu x"] by (simp add: subst_compose_def)
+      also have "... = \<tau> x" unfolding gamma using vwu by auto
+      finally show "\<tau> x = (?tau2 \<circ>\<^sub>s \<gamma>) x" by simp
+    qed
+  next
+    have "s \<cdot> ?tau1 = map_vars_term vu s \<cdot> \<mu>" unfolding apply_subst_map_vars_term ..
+    also have "... = map_vars_term wu t \<cdot> \<mu>"
+      unfolding unif2[unfolded the_mgu_def mu option.simps] ..
+    also have "... = t \<cdot> ?tau2" unfolding apply_subst_map_vars_term ..
+    finally show "s \<cdot> ?tau1 = t \<cdot> ?tau2" .
+  qed
+qed
+
+abbreviation "mgu_var_disjoint_sum \<equiv> mgu_var_disjoint_generic Inl Inr"
+
+lemma mgu_var_disjoint_sum_sound: 
+  "mgu_var_disjoint_sum s t = Some (\<gamma>1, \<gamma>2) \<Longrightarrow> s \<cdot> \<gamma>1 = t \<cdot> \<gamma>2"
+  by (rule mgu_var_disjoint_generic_sound)
+
+lemma mgu_var_disjoint_sum_complete:
+  fixes \<sigma> :: "('f, 'v, 'v + 'w) gsubst" and \<tau> :: "('f, 'w, 'v + 'w) gsubst"
+  assumes unif_disj: "s \<cdot> \<sigma> = t \<cdot> \<tau>"
+  shows "\<exists>\<mu>1 \<mu>2 \<delta>. mgu_var_disjoint_sum s t = Some (\<mu>1, \<mu>2) \<and> 
+    \<sigma> = \<mu>1 \<circ>\<^sub>s \<delta> \<and>
+    \<tau> = \<mu>2 \<circ>\<^sub>s \<delta> \<and>
+    s \<cdot> \<mu>1 = t \<cdot> \<mu>2"
+  by (rule mgu_var_disjoint_generic_complete[OF _ _ _ unif_disj], auto simp: inj_on_def)
+
+lemma mgu_var_disjoint_sum_instance:
+  fixes \<sigma> :: "('f, 'v) subst" and \<delta> :: "('f, 'v) subst"
+  assumes unif_disj: "s \<cdot> \<sigma> = t \<cdot> \<delta>"
+  shows "\<exists>\<mu>1 \<mu>2 \<tau>. mgu_var_disjoint_sum s t = Some (\<mu>1, \<mu>2) \<and>
+    \<sigma> = \<mu>1 \<circ>\<^sub>s \<tau> \<and>
+    \<delta> = \<mu>2 \<circ>\<^sub>s \<tau> \<and> 
+    s \<cdot> \<mu>1 = t \<cdot> \<mu>2"
+proof -
+  let ?map = "\<lambda> m \<sigma> v. map_vars_term m (\<sigma> v)"
+  let ?m = "?map (Inl :: ('v \<Rightarrow> 'v + 'v))"
+  let ?m' = "?map (case_sum (\<lambda> x. x) (\<lambda> x. x))"
+  from unif_disj have id: "map_vars_term Inl (s \<cdot> \<sigma>) = map_vars_term Inl (t \<cdot> \<delta>)" by simp
+  from mgu_var_disjoint_sum_complete[OF id[unfolded map_vars_term_subst]]
+  obtain \<mu>1 \<mu>2 \<tau> where mgu: "mgu_var_disjoint_sum s t = Some (\<mu>1,\<mu>2)"
+    and \<sigma>: "?m \<sigma> = \<mu>1 \<circ>\<^sub>s \<tau>" 
+    and \<delta>: "?m \<delta> = \<mu>2 \<circ>\<^sub>s \<tau>"
+    and unif: "s \<cdot> \<mu>1 = t \<cdot> \<mu>2" by blast
+  {
+    fix \<sigma> :: "('f, 'v) subst"
+    have "?m' (?m \<sigma>) = \<sigma>" by (simp add: map_vars_term_compose o_def term.map_ident)
+  } note id = this
+  {
+    fix \<mu> :: "('f,'v,'v+'v)gsubst" and \<tau> :: "('f,'v + 'v)subst"
+    have "?m' (\<mu> \<circ>\<^sub>s \<tau>) = \<mu> \<circ>\<^sub>s ?m' \<tau>"
+      by (rule ext, unfold subst_compose_def, simp add: map_vars_term_subst)
+  } note id' = this
+  from arg_cong[OF \<sigma>, of ?m', unfolded id id'] have \<sigma>: "\<sigma> = \<mu>1 \<circ>\<^sub>s ?m' \<tau>" .
+  from arg_cong[OF \<delta>, of ?m', unfolded id id'] have \<delta>: "\<delta> = \<mu>2 \<circ>\<^sub>s ?m' \<tau>" .
+  show ?thesis
+    by (intro exI conjI, rule mgu, rule \<sigma>, rule \<delta>, rule unif)
+qed
+
+subsubsection \<open>A variable disjoint unification algorithm without changing the type\<close>
+
+text \<open>We pass the renaming function as additional argument\<close>
+
+definition mgu_vd :: "'v :: infinite renaming2 \<Rightarrow> _ \<Rightarrow> _" where
+  "mgu_vd r = mgu_var_disjoint_generic (rename_1 r) (rename_2 r)" 
+
+lemma mgu_vd_sound: "mgu_vd r s t = Some (\<gamma>1, \<gamma>2) \<Longrightarrow> s \<cdot> \<gamma>1 = t \<cdot> \<gamma>2"
+  unfolding mgu_vd_def by (rule mgu_var_disjoint_generic_sound)
+
+lemma mgu_vd_complete: 
+  fixes \<sigma> :: "('f, 'v :: infinite) subst" and \<tau> :: "('f, 'v) subst" 
+  assumes unif_disj: "s \<cdot> \<sigma> = t \<cdot> \<tau>"
+  shows "\<exists>\<mu>1 \<mu>2 \<delta>. mgu_vd r s t = Some (\<mu>1, \<mu>2) \<and>
+    \<sigma> = \<mu>1 \<circ>\<^sub>s \<delta> \<and>
+    \<tau> = \<mu>2 \<circ>\<^sub>s \<delta> \<and>
+    s \<cdot> \<mu>1 = t \<cdot> \<mu>2"
+  unfolding mgu_vd_def
+  by (rule mgu_var_disjoint_generic_complete[OF rename_12 unif_disj])
+
 end
diff --git a/thys/First_Order_Terms/Unification_String.thy b/thys/First_Order_Terms/Unification_String.thy
new file mode 100644
--- /dev/null
+++ b/thys/First_Order_Terms/Unification_String.thy
@@ -0,0 +1,27 @@
+subsection \<open>A variable disjoint unification algorithm for terms with string variables\<close>
+
+theory Unification_String
+imports
+  Unification
+  Renaming2_String
+begin
+definition "mgu_vd_string = mgu_vd string_rename" 
+
+lemma mgu_vd_string_code[code]: "mgu_vd_string = mgu_var_disjoint_generic (Cons (CHR ''x'')) (Cons (CHR ''y''))" 
+  unfolding mgu_vd_string_def mgu_vd_def
+  by (transfer, auto)
+
+lemma mgu_vd_string_sound: 
+  "mgu_vd_string s t = Some (\<gamma>1, \<gamma>2) \<Longrightarrow> s \<cdot> \<gamma>1 = t \<cdot> \<gamma>2"
+  unfolding mgu_vd_string_def by (rule mgu_vd_sound)
+
+lemma mgu_vd_string_complete:
+  fixes \<sigma> :: "('f, string) subst" and \<tau> :: "('f, string) subst" 
+  assumes "s \<cdot> \<sigma> = t \<cdot> \<tau>"
+  shows "\<exists>\<mu>1 \<mu>2 \<delta>. mgu_vd_string s t = Some (\<mu>1, \<mu>2) \<and>
+    \<sigma> = \<mu>1 \<circ>\<^sub>s \<delta> \<and>
+    \<tau> = \<mu>2 \<circ>\<^sub>s \<delta> \<and>
+    s \<cdot> \<mu>1 = t \<cdot> \<mu>2"
+  unfolding mgu_vd_string_def
+  by (rule mgu_vd_complete[OF assms])
+end
\ No newline at end of file
diff --git a/thys/Regular_Tree_Relations/Util/Term_Context.thy b/thys/Regular_Tree_Relations/Util/Term_Context.thy
--- a/thys/Regular_Tree_Relations/Util/Term_Context.thy
+++ b/thys/Regular_Tree_Relations/Util/Term_Context.thy
@@ -1,526 +1,525 @@
 section \<open>Preliminaries\<close>
 
 theory Term_Context
   imports First_Order_Terms.Term
     First_Order_Terms.Subterm_and_Context
     Polynomial_Factorization.Missing_List
 begin
 
 subsection \<open>Additional functionality on @{type term} and @{type ctxt}\<close>
 subsubsection \<open>Positions\<close>
 
 type_synonym pos = "nat list"
 context
   notes conj_cong [fundef_cong]
 begin
 
 fun poss :: "('f, 'v) term \<Rightarrow> pos set" where
   "poss (Var x) = {[]}"
 | "poss (Fun f ss) = {[]} \<union> {i # p | i p. i < length ss \<and> p \<in> poss (ss ! i)}"
 end
 
 fun hole_pos where
   "hole_pos \<box> = []"
 | "hole_pos (More f ss D ts) = length ss # hole_pos D"
 
 definition position_less_eq (infixl "\<le>\<^sub>p" 67) where
   "p \<le>\<^sub>p q \<longleftrightarrow> (\<exists> r. p @ r = q)"
 
 abbreviation position_less (infixl "<\<^sub>p" 67) where
   "p <\<^sub>p q \<equiv> p \<noteq> q \<and> p \<le>\<^sub>p q"
 
 definition position_par  (infixl "\<bottom>" 67) where
   "p \<bottom> q \<longleftrightarrow> \<not> (p \<le>\<^sub>p q) \<and> \<not> (q \<le>\<^sub>p p)"
 
 fun remove_prefix where
   "remove_prefix (x # xs) (y # ys) = (if x = y then remove_prefix xs ys else None)"
 | "remove_prefix [] ys = Some ys"
 | "remove_prefix xs [] = None"
 
 definition pos_diff  (infixl "-\<^sub>p" 67) where
   "p -\<^sub>p q = the (remove_prefix q p)"
 
 fun subt_at :: "('f, 'v) term \<Rightarrow> pos \<Rightarrow> ('f, 'v) term" (infixl "|'_" 67) where
   "s |_ [] = s"
 | "Fun f ss |_ (i # p) = (ss ! i) |_ p"
 | "Var x |_ _ = undefined"
 
 fun ctxt_at_pos where
   "ctxt_at_pos s [] = \<box>"
 | "ctxt_at_pos (Fun f ss) (i # p) = More f (take i ss) (ctxt_at_pos (ss ! i) p) (drop (Suc i) ss)"
 | "ctxt_at_pos (Var x) _ = undefined"
 
 fun replace_term_at ("_[_ \<leftarrow> _]" [1000, 0, 0] 1000) where
   "replace_term_at s [] t = t"
 | "replace_term_at (Var x) ps t = (Var x)"
 | "replace_term_at (Fun f ts) (i # ps) t =
     (if i < length ts then Fun f (ts[i:=(replace_term_at (ts ! i) ps t)]) else Fun f ts)"
 
 fun fun_at :: "('f, 'v) term \<Rightarrow> pos \<Rightarrow> ('f + 'v) option" where
   "fun_at (Var x) [] = Some (Inr x)"
 | "fun_at (Fun f ts) [] = Some (Inl f)"
 | "fun_at (Fun f ts) (i # p) = (if i < length ts then fun_at (ts ! i) p else None)"
 | "fun_at _ _ = None"
 
 subsubsection \<open>Computing the signature\<close>
 
 fun funas_term where
   "funas_term (Var x) = {}"
 | "funas_term (Fun f ts) = insert (f, length ts) (\<Union> (set (map funas_term ts)))"
 
 fun funas_ctxt where
   "funas_ctxt \<box> = {}"
 | "funas_ctxt (More f ss C ts) = (\<Union> (set (map funas_term ss))) \<union>
     insert (f, Suc (length ss + length ts)) (funas_ctxt C) \<union> (\<Union> (set (map funas_term ts)))"
 
 subsubsection \<open>Groundness\<close>
 
 fun ground where
   "ground (Var x) = False"
 | "ground (Fun f ts) = (\<forall> t \<in> set ts. ground t)"
 
 fun ground_ctxt where
   "ground_ctxt \<box> \<longleftrightarrow> True"
 | "ground_ctxt (More f ss C ts) \<longleftrightarrow> (\<forall> t \<in> set ss. ground t) \<and> ground_ctxt C \<and> (\<forall> t \<in> set ts. ground t)"
 
 subsubsection \<open>Depth\<close>
 fun depth where
   "depth (Var x) = 0"
 | "depth (Fun f []) = 0"
 | "depth (Fun f ts) = Suc (Max (depth ` set ts))"
 
 subsubsection \<open>Type conversion\<close>
 
 text \<open>We require a function which adapts the type of variables of a term,
    so that states of the automaton and variables in the term language can be
    chosen independently.\<close>
 
-abbreviation "map_vars_term f \<equiv> map_term (\<lambda> x. x) f"
 abbreviation "map_funs_term f \<equiv> map_term f (\<lambda> x. x)"
 abbreviation "map_both f \<equiv> map_prod f f"
 
 definition adapt_vars :: "('f, 'q) term \<Rightarrow> ('f,'v)term" where 
   [code del]: "adapt_vars \<equiv> map_vars_term (\<lambda>_. undefined)"
 
 abbreviation "map_vars_ctxt f \<equiv> map_ctxt (\<lambda>x. x) f"
 definition adapt_vars_ctxt :: "('f,'q)ctxt \<Rightarrow> ('f,'v)ctxt" where
   [code del]: "adapt_vars_ctxt = map_vars_ctxt (\<lambda>_. undefined)"
 
 
 subsection \<open>Properties of @{type pos}\<close>
 
 lemma position_less_eq_induct [consumes 1]:
   assumes "p \<le>\<^sub>p q" and "\<And> p. P p p"
     and "\<And> p q r. p \<le>\<^sub>p q \<Longrightarrow> P p q \<Longrightarrow> P p (q @ r)"
   shows "P p q" using assms
 proof (induct p arbitrary: q)
   case Nil then show ?case
     by (metis append_Nil position_less_eq_def)
 next
   case (Cons a p)
   then show ?case
     by (metis append_Nil2 position_less_eq_def)
 qed
 
 text \<open>We show the correspondence between the function @{const remove_prefix} and
 the order on positions @{const position_less_eq}. Moreover how it can be used to
 compute the difference of positions.\<close>
 
 lemma remove_prefix_Nil [simp]:
   "remove_prefix xs xs = Some []"
   by (induct xs) auto
 
 lemma remove_prefix_Some:
   assumes "remove_prefix xs ys = Some zs"
   shows "ys = xs @ zs" using assms
 proof (induct xs arbitrary: ys)
   case (Cons x xs)
   show ?case using Cons(1)[of "tl ys"] Cons(2)
     by (cases ys) (auto split: if_splits)
 qed auto
 
 lemma remove_prefix_append:
   "remove_prefix xs (xs @ ys) = Some ys"
   by (induct xs) auto
 
 lemma remove_prefix_iff:
   "remove_prefix xs ys = Some zs \<longleftrightarrow> ys = xs @ zs"
   using remove_prefix_Some remove_prefix_append
   by blast
 
 lemma position_less_eq_remove_prefix:
   "p \<le>\<^sub>p q \<Longrightarrow> remove_prefix p q \<noteq> None"
   by (induct rule: position_less_eq_induct) (auto simp: remove_prefix_iff)
 
 text \<open>Simplification rules on @{const position_less_eq}, @{const pos_diff},
   and @{const position_par}.\<close>
 
 lemma position_less_refl [simp]: "p \<le>\<^sub>p p"
   by (auto simp: position_less_eq_def)
 
 lemma position_less_eq_Cons [simp]:
   "(i # ps) \<le>\<^sub>p (j # qs) \<longleftrightarrow> i = j \<and> ps \<le>\<^sub>p qs"
   by (auto simp: position_less_eq_def)
 
 lemma position_less_Nil_is_bot [simp]: "[] \<le>\<^sub>p p"
   by (auto simp: position_less_eq_def)
 
 lemma position_less_Nil_is_bot2 [simp]: "p \<le>\<^sub>p [] \<longleftrightarrow> p = []"
   by (auto simp: position_less_eq_def)
 
 lemma position_diff_Nil [simp]: "q -\<^sub>p [] = q"
   by (auto simp: pos_diff_def)
 
 lemma position_diff_Cons [simp]:
   "(i # ps) -\<^sub>p (i # qs) = ps -\<^sub>p qs"
   by (auto simp: pos_diff_def)
 
 lemma Nil_not_par [simp]:
   "[] \<bottom> p \<longleftrightarrow> False"
   "p \<bottom> [] \<longleftrightarrow> False"
   by (auto simp: position_par_def)
 
 lemma par_not_refl [simp]: "p \<bottom> p \<longleftrightarrow> False"
   by (auto simp: position_par_def)
 
 lemma par_Cons_iff:
   "(i # ps) \<bottom> (j # qs) \<longleftrightarrow> (i \<noteq> j \<or> ps \<bottom> qs)"
   by (auto simp: position_par_def)
 
 
 text \<open>Simplification rules on @{const poss}.\<close>
 
 lemma Nil_in_poss [simp]: "[] \<in> poss t"
   by (cases t) auto
 
 lemma poss_Cons [simp]:
   "i # p \<in> poss t \<Longrightarrow> [i] \<in> poss t"
   by (cases t) auto
 
 lemma poss_Cons_poss:
   "i # q \<in> poss t \<longleftrightarrow> i < length (args t) \<and> q \<in> poss (args t ! i)"
   by (cases t) auto
 
 lemma poss_append_poss:
   "p @ q \<in> poss t \<longleftrightarrow> p \<in> poss t \<and> q \<in> poss (t |_ p)"
 proof (induct p arbitrary: t)
   case (Cons i p)
   from Cons[of "args t ! i"] show ?case
     by (cases t) auto
 qed auto
 
 
 text \<open>Simplification rules on @{const hole_pos}\<close>
 
 lemma hole_pos_map_vars [simp]:
   "hole_pos (map_vars_ctxt f C) = hole_pos C"
   by (induct C) auto
 
 lemma hole_pos_in_ctxt_apply [simp]: "hole_pos C \<in> poss C\<langle>u\<rangle>"
   by (induct C) auto
 
 subsection \<open>Properties of @{const ground} and @{const ground_ctxt}\<close>
 
 lemma ground_vars_term_empty [simp]:
   "ground t \<Longrightarrow> vars_term t = {}"
   by (induct t) auto
 
 lemma ground_map_term [simp]:
   "ground (map_term f h t) = ground t"
   by (induct t) auto
 
 lemma ground_ctxt_apply [simp]:
   "ground C\<langle>t\<rangle> \<longleftrightarrow> ground_ctxt C \<and> ground t"
   by (induct C) auto
 
 lemma ground_ctxt_comp [intro]:
   "ground_ctxt C \<Longrightarrow> ground_ctxt D \<Longrightarrow> ground_ctxt (C \<circ>\<^sub>c D)"
   by (induct C) auto
 
 lemma ctxt_comp_n_pres_ground [intro]:
   "ground_ctxt C \<Longrightarrow> ground_ctxt (C^n)"
   by (induct n arbitrary: C) auto
 
 lemma subterm_eq_pres_ground:
   assumes "ground s" and "s \<unrhd> t"
   shows "ground t" using assms(2,1)
   by (induct) auto
 
 lemma ground_substD:
   "ground (l \<cdot> \<sigma>) \<Longrightarrow> x \<in> vars_term l \<Longrightarrow> ground (\<sigma> x)"
   by (induct l) auto
 
 lemma ground_substI:
   "(\<And> x. x \<in> vars_term s \<Longrightarrow> ground (\<sigma> x)) \<Longrightarrow> ground (s \<cdot> \<sigma>)"
   by (induct s) auto
 
 
 subsection \<open>Properties on signature induced by a term @{type term}/context @{type ctxt}\<close>
 
 lemma funas_ctxt_apply [simp]:
   "funas_term C\<langle>t\<rangle> = funas_ctxt C \<union> funas_term t"
   by (induct C) auto
 
 lemma funas_term_map [simp]:
   "funas_term (map_term f h t) = (\<lambda> (g, n). (f g, n)) ` funas_term t"
   by (induct t) auto
 
 lemma funas_term_subst:
   "funas_term (l \<cdot> \<sigma>) = funas_term l \<union> (\<Union> (funas_term ` \<sigma> ` vars_term l))"
   by (induct l) auto
 
 lemma funas_ctxt_comp [simp]:
   "funas_ctxt (C \<circ>\<^sub>c D) = funas_ctxt C \<union> funas_ctxt D"
   by (induct C) auto
 
 lemma ctxt_comp_n_funas [simp]:
   "(f, v) \<in> funas_ctxt (C^n) \<Longrightarrow> (f, v) \<in> funas_ctxt C"
   by (induct n arbitrary: C) auto
 
 lemma ctxt_comp_n_pres_funas [intro]:
   "funas_ctxt C \<subseteq> \<F> \<Longrightarrow> funas_ctxt (C^n) \<subseteq> \<F>"
   by (induct n arbitrary: C) auto
 
 subsection \<open>Properties on subterm at given position @{const subt_at}\<close>
 
 lemma subt_at_Cons_comp:
   "i # p \<in> poss s \<Longrightarrow> (s |_ [i]) |_ p = s |_ (i # p)"
   by (cases s) auto
 
 lemma ctxt_at_pos_subt_at_pos:
   "p \<in> poss t \<Longrightarrow> (ctxt_at_pos t p)\<langle>u\<rangle> |_ p = u"
 proof (induct p arbitrary: t)
   case (Cons i p)
   then show ?case using id_take_nth_drop
     by (cases t) (auto simp: nth_append)
 qed auto
 
 lemma ctxt_at_pos_subt_at_id:
   "p \<in> poss t \<Longrightarrow> (ctxt_at_pos t p)\<langle>t |_ p\<rangle> = t"
 proof (induct p arbitrary: t)
   case (Cons i p)
   then show ?case using id_take_nth_drop
     by (cases t) force+ 
 qed auto
 
 lemma subst_at_ctxt_at_eq_termD:
   assumes "s = t" "p \<in> poss t"
   shows "s |_ p = t |_ p \<and> ctxt_at_pos s p = ctxt_at_pos t p" using assms
   by auto
 
 lemma subst_at_ctxt_at_eq_termI:
   assumes "p \<in> poss s" "p \<in> poss t"
     and "s |_p = t |_ p"
     and "ctxt_at_pos s p = ctxt_at_pos t p"
   shows "s = t" using assms
   by (metis ctxt_at_pos_subt_at_id)
 
 lemma subt_at_subterm_eq [intro!]:
   "p \<in> poss t \<Longrightarrow> t \<unrhd> t |_ p"
 proof (induct p arbitrary: t)
   case (Cons i p)
   from Cons(1)[of "args t ! i"] Cons(2) show ?case
     by (cases t) force+
 qed auto
 
 lemma subt_at_subterm [intro!]:
   "p \<in> poss t \<Longrightarrow> p \<noteq> [] \<Longrightarrow>  t \<rhd> t |_ p"
 proof (induct p arbitrary: t)
   case (Cons i p)
   from Cons(1)[of "args t ! i"] Cons(2) show ?case
     by (cases t) force+
 qed auto
 
 
 lemma ctxt_at_pos_hole_pos [simp]: "ctxt_at_pos C\<langle>s\<rangle> (hole_pos C) = C"
   by (induct C) auto
 
 subsection \<open>Properties on replace terms at a given position
   @{const replace_term_at}\<close>
 
 lemma replace_term_at_not_poss [simp]:
   "p \<notin> poss s \<Longrightarrow> s[p \<leftarrow> t] = s"
 proof (induct s arbitrary: p)
   case (Var x) then show ?case by (cases p) auto
 next
   case (Fun f ts) show ?case using Fun(1)[OF nth_mem] Fun(2)
     by (cases p) (auto simp: min_def intro!: nth_equalityI)
 qed
 
 lemma replace_term_at_replace_at_conv:
   "p \<in> poss s \<Longrightarrow> (ctxt_at_pos s p)\<langle>t\<rangle> = s[p \<leftarrow> t]"
   by (induct s arbitrary: p) (auto simp: upd_conv_take_nth_drop)
 
 lemma parallel_replace_term_commute [ac_simps]:
   "p \<bottom> q \<Longrightarrow> s[p \<leftarrow> t][q \<leftarrow> u] = s[q \<leftarrow> u][p \<leftarrow> t]"
 proof (induct s arbitrary: p q)
   case (Var x) then show ?case
     by (cases p; cases q) auto
 next
   case (Fun f ts)
   from Fun(2) have "p \<noteq> []" "q \<noteq> []" by auto
   then obtain i j ps qs where [simp]: "p = i # ps" "q = j # qs"
     by (cases p; cases q) auto
   have "i \<noteq> j \<Longrightarrow> (Fun f ts)[p \<leftarrow> t][q \<leftarrow> u] = (Fun f ts)[q \<leftarrow> u][p \<leftarrow> t]"
     by (auto simp: list_update_swap)
   then show ?case using Fun(1)[OF nth_mem, of j ps qs] Fun(2)
     by (cases "i = j") (auto simp: par_Cons_iff)
 qed
 
 lemma replace_term_at_above [simp]:
   "p \<le>\<^sub>p q \<Longrightarrow> s[q \<leftarrow> t][p \<leftarrow> u] = s[p \<leftarrow> u]"
 proof (induct p arbitrary: s q)
   case (Cons i p)
   show ?case using Cons(1)[of "tl q" "args s ! i"] Cons(2)
     by (cases q; cases s) auto
 qed auto
 
 lemma replace_term_at_below [simp]:
   "p <\<^sub>p q \<Longrightarrow> s[p \<leftarrow> t][q \<leftarrow> u] = s[p \<leftarrow> t[q -\<^sub>p p \<leftarrow> u]]"
 proof (induct p arbitrary: s q)
   case (Cons i p)
   show ?case using Cons(1)[of "tl q" "args s ! i"] Cons(2)
     by (cases q; cases s) auto
 qed auto
 
 lemma replace_at_hole_pos [simp]: "C\<langle>s\<rangle>[hole_pos C \<leftarrow> t] = C\<langle>t\<rangle>"
   by (induct C) auto
 
 subsection \<open>Properties on @{const adapt_vars} and @{const adapt_vars_ctxt}\<close>
 
 lemma adapt_vars2:
   "adapt_vars (adapt_vars t) = adapt_vars t"
   by (induct t) (auto simp add: adapt_vars_def)
 
 lemma adapt_vars_simps[code, simp]: "adapt_vars (Fun f ts) = Fun f (map adapt_vars ts)"
   by (induct ts, auto simp: adapt_vars_def)
 
 lemma adapt_vars_reverse: "ground t \<Longrightarrow> adapt_vars t' = t \<Longrightarrow> adapt_vars t = t'"
   unfolding adapt_vars_def 
 proof (induct t arbitrary: t')
   case (Fun f ts)
   then show ?case by (cases t') (auto simp add: map_idI)
 qed auto
 
 lemma ground_adapt_vars [simp]: "ground (adapt_vars t) = ground t"
   by (simp add: adapt_vars_def)
 lemma funas_term_adapt_vars[simp]: "funas_term (adapt_vars t) = funas_term t" by (simp add: adapt_vars_def)
 
 lemma adapt_vars_adapt_vars[simp]: fixes t :: "('f,'v)term"
   assumes g: "ground t"
   shows "adapt_vars (adapt_vars t :: ('f,'w)term) = t"
 proof -
   let ?t' = "adapt_vars t :: ('f,'w)term"
   have gt': "ground ?t'" using g by auto
   from adapt_vars_reverse[OF gt', of t] show ?thesis by blast
 qed
 
 lemma adapt_vars_inj:
   assumes "adapt_vars x = adapt_vars y" "ground x" "ground y"
   shows "x = y"
   using adapt_vars_adapt_vars assms by metis
 
 lemma adapt_vars_ctxt_simps[simp, code]: 
   "adapt_vars_ctxt (More f bef C aft) = More f (map adapt_vars bef) (adapt_vars_ctxt C) (map adapt_vars aft)"
   "adapt_vars_ctxt Hole = Hole" unfolding adapt_vars_ctxt_def adapt_vars_def by auto
 
 lemma adapt_vars_ctxt[simp]: "adapt_vars (C \<langle> t \<rangle> ) = (adapt_vars_ctxt C) \<langle> adapt_vars t \<rangle>"
   by (induct C, auto)
 
 lemma adapt_vars_subst[simp]: "adapt_vars (l \<cdot> \<sigma>) = l \<cdot> (\<lambda> x. adapt_vars (\<sigma> x))"
   unfolding adapt_vars_def
   by (induct l) auto
 
 lemma adapt_vars_gr_map_vars [simp]:
   "ground t \<Longrightarrow> map_vars_term f t = adapt_vars t"
   by (induct t) auto
 
 
 lemma adapt_vars_gr_ctxt_of_map_vars [simp]:
   "ground_ctxt C \<Longrightarrow> map_vars_ctxt f C = adapt_vars_ctxt C"
   by (induct C) auto
 
 subsubsection \<open>Equality on ground terms/contexts by positions and symbols\<close>
 
 lemma fun_at_def':
   "fun_at t p = (if p \<in> poss t then
     (case t |_ p of Var x \<Rightarrow> Some (Inr x) | Fun f ts \<Rightarrow> Some (Inl f)) else None)"
   by (induct t p rule: fun_at.induct) auto
 
 lemma fun_at_None_nposs_iff:
   "fun_at t p = None \<longleftrightarrow> p \<notin> poss t"
   by (auto simp: fun_at_def') (meson term.case_eq_if)
 
 lemma eq_term_by_poss_fun_at:
   assumes "poss s = poss t" "\<And>p. p \<in> poss s \<Longrightarrow> fun_at s p = fun_at t p"
   shows "s = t"
   using assms
 proof (induct s arbitrary: t)
   case (Var x) then show ?case
     by (cases t) simp_all
 next
   case (Fun f ss) note Fun' = this
   show ?case
   proof (cases t)
     case (Var x) show ?thesis using Fun'(3)[of "[]"] by (simp add: Var)
   next
     case (Fun g ts)
     have *: "length ss = length ts"
       using Fun'(3) arg_cong[OF Fun'(2), of "\<lambda>P. card {i |i p. i # p \<in> P}"]
       by (auto simp: Fun exI[of "\<lambda>x. x \<in> poss _", OF Nil_in_poss])
     then have "i < length ss \<Longrightarrow> poss (ss ! i) = poss (ts ! i)" for i
       using arg_cong[OF Fun'(2), of "\<lambda>P. {p. i # p \<in> P}"] by (auto simp: Fun)
     then show ?thesis using * Fun'(2) Fun'(3)[of "[]"] Fun'(3)[of "_ # _ :: pos"]
       by (auto simp: Fun intro!: nth_equalityI Fun'(1)[OF nth_mem, of n "ts ! n" for n])
   qed
 qed
 
 lemma eq_ctxt_at_pos_by_poss:
   assumes "p \<in> poss s" "p \<in> poss t"
     and "\<And> q. \<not> (p \<le>\<^sub>p q) \<Longrightarrow> q \<in> poss s \<longleftrightarrow> q \<in> poss t"
     and "(\<And> q. q \<in> poss s \<Longrightarrow> \<not> (p \<le>\<^sub>p q) \<Longrightarrow> fun_at s q = fun_at t q)"
   shows "ctxt_at_pos s p = ctxt_at_pos t p" using assms
 proof (induct p arbitrary: s t)
   case (Cons i p)
   from Cons(2, 3) Cons(4, 5)[of "[]"] obtain f ss ts where [simp]: "s = Fun f ss" "t = Fun f ts"
     by (cases s; cases t) auto
   have flt: "j < i \<Longrightarrow> j # q \<in> poss s \<Longrightarrow> fun_at s (j # q) = fun_at t (j # q)" for j q
     by (intro Cons(5)) auto
   have fgt: "i < j \<Longrightarrow> j # q \<in> poss s \<Longrightarrow> fun_at s (j # q) = fun_at t (j # q)" for j q
     by (intro Cons(5)) auto
   have lt: "j < i \<Longrightarrow> j # q \<in> poss s \<longleftrightarrow> j # q \<in> poss t" for j q by (intro Cons(4)) auto
   have gt: "i < j \<Longrightarrow> j # q \<in> poss s \<longleftrightarrow> j # q \<in> poss t" for j q by (intro Cons(4)) auto
   from this[of _ "[]"] have "i < j \<Longrightarrow> j < length ss \<longleftrightarrow> j < length ts" for j by auto
   from this Cons(2, 3) have l: "length ss = length ts" by auto (meson nat_neq_iff)
   have "ctxt_at_pos (ss ! i) p = ctxt_at_pos (ts ! i) p" using Cons(2, 3) Cons(4-)[of "i # q" for q] 
     by (intro Cons(1)[of "ss ! i" "ts ! i"]) auto
   moreover have "take i ss = take i ts" using l lt Cons(2, 3) flt
     by (intro nth_equalityI) (auto intro!: eq_term_by_poss_fun_at)
   moreover have "drop (Suc i) ss = drop (Suc i) ts" using l Cons(2, 3) fgt gt[of "Suc i + j" for j]
     by (intro nth_equalityI) (auto simp: nth_map intro!: eq_term_by_poss_fun_at, fastforce+)
   ultimately show ?case by auto
 qed auto
 
 
 subsection \<open>Misc\<close>
 
 lemma fun_at_hole_pos_ctxt_apply [simp]:
   "fun_at C\<langle>t\<rangle> (hole_pos C) = fun_at t []"
   by (induct C) auto
 
 lemma vars_term_ctxt_apply [simp]:
   "vars_term C\<langle>t\<rangle> = vars_ctxt C \<union> vars_term t"
   by (induct C arbitrary: t) auto
 
 lemma map_vars_term_ctxt_apply:
   "map_vars_term f C\<langle>t\<rangle> = (map_vars_ctxt f C)\<langle>map_vars_term f t\<rangle>"
   by (induct C) auto
 
 lemma map_term_replace_at_dist:
   "p \<in> poss s \<Longrightarrow> (map_term f g s)[p \<leftarrow> (map_term f g t)] = map_term f g (s[p \<leftarrow> t])"
 proof (induct p arbitrary: s)
   case (Cons i p) then show ?case
     by (cases s) (auto simp: nth_list_update intro!: nth_equalityI)
 qed auto
 
 end
diff --git a/thys/Statecharts/HAOps.thy b/thys/Statecharts/HAOps.thy
--- a/thys/Statecharts/HAOps.thy
+++ b/thys/Statecharts/HAOps.thy
@@ -1,1117 +1,1111 @@
 (*  Title:      statecharts/HA/HAOps.thy
     Author:     Steffen Helke, Software Engineering Group
     Copyright   2010 Technische Universitaet Berlin
 *)
 
 section \<open>Constructing Hierarchical Automata\<close>
 theory HAOps
 imports HA
 begin
 
 subsection "Constructing a Composition Function for a PseudoHA"
 
 definition
   EmptyMap :: "'s set => ('s \<rightharpoonup> (('s,'e,'d)seqauto) set)" where
   "EmptyMap S = (\<lambda> a . if a \<in> S then Some {} else None)"
 
 lemma EmptyMap_dom [simp]:
   "dom (EmptyMap S) = S"
 by (unfold dom_def EmptyMap_def,auto)
 
 lemma EmptyMap_ran [simp]:
    "S \<noteq> {} \<Longrightarrow> ran (EmptyMap S) = {{}}"
 by (unfold ran_def EmptyMap_def, auto)
 
 lemma EmptyMap_the [simp]:
    "x \<in> S \<Longrightarrow> the ((EmptyMap S) x) = {}"
 by (unfold ran_def EmptyMap_def, auto)
 
 lemma EmptyMap_ran_override:
   "\<lbrakk> S \<noteq> {}; (S \<inter> (dom G)) = {} \<rbrakk> \<Longrightarrow>  
   ran (G ++ EmptyMap S) = insert {} (ran G)"
 apply (subst ran_override)
 apply (simp add: Int_commute)
 apply simp
 done
 
 lemma EmptyMap_Union_ran_override:
  "\<lbrakk> S \<noteq> {};  
     S \<inter> dom G = {} \<rbrakk> \<Longrightarrow>  
   (Union (ran (G ++ (EmptyMap S)))) = (Union (ran G))"
 apply (subst EmptyMap_ran_override)
 apply auto
 done
 
 lemma EmptyMap_Union_ran_override2:
  "\<lbrakk> S \<noteq> {}; S \<inter> dom G1 = {}; 
     dom G1 \<inter> dom G2 = {} \<rbrakk> \<Longrightarrow> 
    \<Union> (ran (G1 ++ EmptyMap S ++ G2)) = (\<Union> (ran G1 \<union> ran G2))"
 apply (unfold Union_eq UNION_eq EmptyMap_def Int_def ran_def)
 apply (simp add: map_add_Some_iff)
 apply (unfold dom_def)
 apply simp
 apply (rule equalityI)
 apply (rule subsetI)
 apply simp
 apply fast
 apply (rule subsetI)
 apply (rename_tac t)
 apply simp
 apply (erule bexE)
 apply (rename_tac U)
 apply simp
 apply (erule disjE)
 apply (erule exE)
 apply (rename_tac v)
 apply (rule_tac x=U in exI)
 apply simp
 apply (rule_tac x=v in exI)
 apply auto
 done
 
 lemma EmptyMap_Root [simp]:
  "Root {SA} (EmptyMap (States SA)) = SA"
 by (unfold Root_def, auto)
 
 lemma EmptyMap_RootEx [simp]:
   "RootEx {SA} (EmptyMap (States SA))"
 by (unfold RootEx_def, auto)
 
 lemma EmptyMap_OneAncestor [simp]:
  "OneAncestor {SA} (EmptyMap (States SA))"
 by (unfold OneAncestor_def, auto)
 
 lemma EmptyMap_NoCycles [simp]:
   "NoCycles {SA} (EmptyMap (States SA))"
 by (unfold NoCycles_def EmptyMap_def , auto)
 
 lemma EmptyMap_IsCompFun [simp]:
  "IsCompFun {SA} (EmptyMap (States SA))"
 by (unfold IsCompFun_def, auto)
 
 lemma EmptyMap_hierauto [simp]:
  "(D,{SA}, SAEvents SA, EmptyMap (States SA)) \<in> hierauto"
 by (unfold hierauto_def HierAuto_def, auto)
 
 subsection "Extending a Composition Function by a SA"
 
 definition
   FAddSA :: "[('s \<rightharpoonup> (('s,'e,'d)seqauto) set), 's * ('s,'e,'d)seqauto]
              => ('s \<rightharpoonup> (('s,'e,'d)seqauto) set)"
            ("(_ [f+]/ _)" [10,11]10) where
   "FAddSA G SSA = (let  (S,SA) = SSA
                    in
                      (if ((S \<in> dom G) \<and> (S \<notin> States SA)) then
                         (G ++ (Map.empty(S \<mapsto> (insert SA (the (G S)))))
                          ++ EmptyMap (States SA))
                       else G))"
 
 lemma FAddSA_dom [simp]:
  "(S \<notin> (dom (A::('a => ('a,'c,'d)seqauto set option)))) \<Longrightarrow>
    ((A [f+] (S,(SA::('a,'c,'d)seqauto))) = A)"
 by (unfold FAddSA_def Let_def, auto)
 
 lemma FAddSA_States [simp]:
  "(S \<in> (States (SA::('a,'c,'d)seqauto))) \<Longrightarrow>
    (((A::('a => ('a,'c,'d)seqauto set option)) [f+] (S,SA)) = A)"
 by (unfold FAddSA_def Let_def, auto)
 
 lemma FAddSA_dom_insert [simp]:
  "\<lbrakk> S \<in> (dom A); S \<notin>  States SA \<rbrakk> \<Longrightarrow> 
    (((A [f+] (S,SA)) S) = Some (insert SA (the (A S))))"
 by (unfold FAddSA_def Let_def restrict_def, auto)
 
 lemma FAddSA_States_neq [simp]:
  "\<lbrakk> S' \<notin> States (SA::('a,'c,'d)seqauto); S \<noteq>  S' \<rbrakk> \<Longrightarrow> 
   ((((A::('a => ('a,'c,'d)seqauto set option)) [f+] (S,SA)) S') = (A S'))"
 apply (case_tac "S \<in> dom A")
 apply (case_tac "S \<in> States SA")
 apply auto
 apply (case_tac "S' \<in> dom A")
 apply (unfold FAddSA_def Let_def)
 apply auto
 apply (simp add: dom_None)
 done
 
 lemma FAddSA_dom_emptyset [simp]:
  "\<lbrakk> S \<in> (dom A); S \<notin> States SA; S' \<in> States (SA::('a,'c,'d)seqauto) \<rbrakk> \<Longrightarrow>  
     ((((A::('a => ('a,'c,'d)seqauto set option))) [f+] (S,SA)) S') = (Some {})"
 apply (unfold FAddSA_def Let_def)
 apply auto
 apply (unfold EmptyMap_def)
 apply auto
 done
 
 lemma FAddSA_dom_dom_States [simp]:
   "\<lbrakk> S \<in> (dom F); S \<notin> States SA \<rbrakk> \<Longrightarrow> 
     (dom ((F::('a \<rightharpoonup> (('a,'b,'d)seqauto) set)) [f+] (S, SA))) = 
     ((dom F) \<union> (States (SA::('a,'b,'d)seqauto)))"
 by (unfold FAddSA_def Let_def, auto)
 
 lemma FAddSA_dom_dom [simp]:
   "S \<notin> (dom F) \<Longrightarrow>   
    (dom ((F::('a \<rightharpoonup> (('a,'b,'d)seqauto) set)) [f+] 
        (S,(SA::('a,'b,'d)seqauto)))) = (dom F)"
 by (unfold FAddSA_def Let_def, auto)
 
 lemma FAddSA_States_dom [simp]:
   "S \<in> (States SA) \<Longrightarrow>  
    (dom ((F::('a \<rightharpoonup> (('a,'b,'d)seqauto) set)) [f+] 
         (S,(SA::('a,'b,'d)seqauto)))) = (dom F)"
 by (unfold FAddSA_def Let_def, auto)
 
 lemma FAddSA_dom_insert_dom_disjunct [simp]:
    "\<lbrakk> S \<in> dom G; States SA \<inter> dom G = {} \<rbrakk> \<Longrightarrow> ((G [f+] (S,SA)) S) = Some (insert SA (the (G S)))"
 apply (rule  FAddSA_dom_insert)
 apply auto
 done
 
 lemma FAddSA_Union_ran:
  "\<lbrakk> S \<in> dom G; (States SA) \<inter> (dom G) = {} \<rbrakk> \<Longrightarrow> 
    (\<Union> (ran (G [f+] (S,SA)))) = (insert SA (\<Union> (ran G)))"
 apply (unfold FAddSA_def Let_def)
 apply simp
 apply (rule conjI)
 prefer 2
 apply (rule impI)
 apply (unfold Int_def)
 apply simp
 apply (fold Int_def)
 apply (rule impI)
 apply (subst EmptyMap_Union_ran_override)
 apply auto
 done
 
 lemma FAddSA_Union_ran2:
  "\<lbrakk> S \<in> dom G1; (States SA) \<inter> (dom G1) = {}; (dom G1 \<inter> dom G2) = {} \<rbrakk> \<Longrightarrow>
    (\<Union> (ran ((G1 [f+] (S,SA)) ++ G2))) = (insert SA (\<Union> ((ran G1) \<union> (ran G2))))"
 apply (unfold FAddSA_def Let_def)
 apply (simp (no_asm_simp))
 apply (rule conjI)
 apply (rule impI)
 apply (subst EmptyMap_Union_ran_override2)
 apply simp
 apply simp
 apply simp
 apply fast
 apply (subst Union_Un_distrib)
 apply (subst Union_ran_override2)
 apply auto
 done
 
 lemma FAddSA_ran:
   "\<lbrakk> \<forall> T \<in> dom G . T \<noteq> S \<longrightarrow> (the (G T) \<inter> the (G S)) = {};  
      S \<in> dom G; (States SA) \<inter>  (dom G) = {} \<rbrakk> \<Longrightarrow>  
     ran (G [f+] (S,SA)) = insert {} (insert (insert SA (the (G S))) (ran G - {the (G S)}))"
 apply (unfold FAddSA_def Let_def)
 apply simp
 apply (rule conjI)
 apply (rule impI)+
 prefer 2
 apply fast
 apply (simp add: EmptyMap_ran_override)
 apply (unfold ran_def)
 apply auto
 apply (rename_tac Y X a xa xb)
 apply (erule_tac x=a in allE)
 apply simp
 apply (erule_tac x=a in allE)
 apply simp
 done
 
 lemma FAddSA_RootEx_def: 
   "\<lbrakk> S \<in> dom G; (States SA) \<inter> (dom G) = {} \<rbrakk> \<Longrightarrow> 
     RootEx F (G [f+] (S,SA)) = (\<exists>! A . A \<in> F \<and> A \<notin> insert SA (\<Union> (ran G)))"
 apply (unfold RootEx_def)
 apply (simp only: FAddSA_Union_ran Int_commute)
 done
 
 lemma FAddSA_RootEx:
   "\<lbrakk> \<Union> (ran G) = F - {Root F G}; 
      dom G = \<Union>(States ` F); 
      (dom G \<inter> States SA) = {}; S \<in> dom G; 
      RootEx F G \<rbrakk> \<Longrightarrow> RootEx (insert SA F) (G [f+] (S,SA))"
 apply (simp add: FAddSA_RootEx_def Int_commute cong: rev_conj_cong)
 apply (auto cong: conj_cong) 
 done
 
 lemma FAddSA_Root_def:
   "\<lbrakk> S \<in> dom G; (States SA) \<inter> (dom G) = {} \<rbrakk>  \<Longrightarrow> 
    (Root F (G [f+] (S,SA)) = (@ A . A \<in> F \<and> A \<notin> insert SA (\<Union> (ran G))))" 
 apply (unfold Root_def)
 apply (simp only: FAddSA_Union_ran Int_commute)
 done
 
 lemma FAddSA_RootEx_Root: 
   "\<lbrakk> Union (ran G) = F - {Root F G};  
      \<Union>(States ` F) = dom G; 
      (dom G \<inter> States SA) = {}; S \<in> dom G;
      RootEx F G \<rbrakk> \<Longrightarrow> (Root (insert SA F) (G [f+] (S,SA))) = (Root F G)"
 apply (simp add: FAddSA_Root_def Int_commute cong: rev_conj_cong)
 apply (simp cong:conj_cong)
 done
 
 lemma FAddSA_OneAncestor:
   "\<lbrakk> \<Union> (ran G) = F - {Root F G}; 
      (dom G \<inter> States SA) = {}; S \<in> dom G; 
      \<Union>(States ` F) = dom G; RootEx F G;
      OneAncestor F G \<rbrakk> \<Longrightarrow> OneAncestor (insert SA F) (G [f+] (S,SA))"
 apply (subst OneAncestor_def)
 apply simp
 apply (rule ballI)
 apply (rename_tac SAA)
 apply (case_tac "SA = SAA")
 apply (rule_tac a=S in ex1I)
 apply (rule conjI)
 apply simp
 apply fast
 apply (subst FAddSA_dom_insert)
 apply simp
 apply (simp add:Int_def)
 apply simp
 apply (rename_tac T)
 apply (erule conjE bexE exE disjE)+
 apply (rename_tac SAAA)
 apply simp
 apply (erule conjE)
 apply (subst not_not [THEN sym])
 apply (rule notI)
 apply (case_tac "T \<in> States SAA")
 apply blast
 apply (drule_tac A=G and S=S and SA=SAA in FAddSA_States_neq)
 apply fast
 apply simp
 apply (case_tac "SAA \<notin> Union (ran G)")
 apply (frule ran_dom_the)
 prefer 2
 apply fast
 apply blast
 apply simp
 apply (erule conjE)
 apply (simp add: States_Int_not_mem)
 apply (unfold OneAncestor_def)
 apply (drule_tac G=G and S=S and SA=SA in FAddSA_RootEx_Root)
 apply simp
 apply simp
 apply simp
 apply simp
 apply (erule_tac x=SAA in ballE)
 prefer 2
 apply simp
 apply simp
 apply (erule conjE bexE ex1E exE disjE)+
 apply (rename_tac T SAAA)
 apply (rule_tac a=T in ex1I)
 apply (rule conjI)
 apply fast
 apply (case_tac "T = S")
 apply simp
 apply (case_tac "S \<notin> States SA")
 apply simp
 apply simp
 apply (subst FAddSA_States_neq)
 apply blast
 apply (rule not_sym)
 apply simp
 apply simp
 apply (rename_tac U)
 apply simp
 apply (erule conjE bexE)+
 apply (rename_tac SAAAA)
 apply simp
 apply (erule conjE disjE)+
 apply (frule FAddSA_dom_emptyset)
 prefer 2
 apply fast
 back
 back
 apply simp
 apply blast
 apply simp
 apply (erule_tac x=U in allE)
 apply (erule impE)
 prefer 2
 apply simp
 apply (rule conjI)
 apply fast
 apply (case_tac "S \<noteq> U")
 apply (subgoal_tac "U \<notin> States SA")
 apply (drule_tac A=G in FAddSA_States_neq)
 apply fast
 apply simp
 apply blast
 apply (drule_tac A=G and SA=SA in FAddSA_dom_insert)
 apply simp
 apply blast
 apply auto
 done
 
 lemma FAddSA_NoCycles:
   "\<lbrakk> (States SA \<inter> dom G) = {}; S \<in> dom G;
      dom G = \<Union>(States ` F); NoCycles F G \<rbrakk> \<Longrightarrow> 
      NoCycles  (insert SA F) (G [f+] (S,SA))"
 apply (unfold NoCycles_def)
 apply (rule ballI impI)+
 apply (rename_tac SAA)
 apply (case_tac "\<exists> s \<in> SAA. s \<in> States SA")
 apply simp
 apply (erule bexE)+
 apply (rename_tac SAAA T)
 apply (rule_tac x=T in bexI)
 apply simp
 apply (subst FAddSA_dom_emptyset)
 apply simp
 apply fast
 apply blast
 apply simp
 apply simp
 apply simp
 apply simp
 apply (erule_tac x=SAA in ballE)
 prefer 2
 apply simp
 apply auto[1]
 apply (unfold UNION_eq Pow_def)
 apply simp
 apply (case_tac "SAA = {}")
 apply fast
 apply simp
 apply (erule bexE)+
 apply (rename_tac SAAA T)
 apply (rule_tac x=T in bexI)
 prefer 2
 apply simp
 apply (case_tac "T=S")
 apply simp
 apply (subst FAddSA_dom_insert)
 apply auto
 done
 
 lemma FAddSA_IsCompFun:
  "\<lbrakk> (States SA \<inter> (\<Union>(States ` F))) = {};
      S \<in> (\<Union>(States ` F)); 
      IsCompFun F G \<rbrakk> \<Longrightarrow>  IsCompFun (insert SA F) (G [f+] (S,SA))"
 apply (unfold IsCompFun_def)
 apply (erule conjE)+
 apply (simp add: Int_commute FAddSA_RootEx_Root FAddSA_RootEx FAddSA_OneAncestor FAddSA_NoCycles)
 apply (rule conjI)
 apply (subst FAddSA_dom_dom_States)
 apply simp
 apply blast
 apply (simp add: Un_commute)
 apply (simp add: FAddSA_Union_ran)
 apply (case_tac "SA = Root F G")
 prefer 2
 apply blast
 apply (subgoal_tac "States (Root F G) \<subseteq>  \<Union>(States ` F)")
 apply simp
 apply (frule subset_lemma)
 apply auto
 done
 
 lemma FAddSA_HierAuto:
   "\<lbrakk> (States SA \<inter> (\<Union>(States ` F))) = {};
       S \<in> (\<Union>(States ` F)); 
       HierAuto D F E G \<rbrakk> \<Longrightarrow> HierAuto D (insert SA F) (E \<union> SAEvents SA) (G [f+] (S,SA))"
 apply (unfold HierAuto_def)
 apply auto
 apply (simp add: MutuallyDistinct_Insert)
 apply (rule FAddSA_IsCompFun)
 apply auto
 done
 
 lemma FAddSA_HierAuto_insert [simp]:
   "\<lbrakk> (States SA \<inter> HAStates HA) = {};
       S \<in> HAStates HA \<rbrakk> \<Longrightarrow> 
     HierAuto (HAInitValue HA)                  
              (insert SA (SAs HA))              
              (HAEvents HA \<union> SAEvents SA)      
              (CompFun HA [f+] (S,SA))"
 apply (unfold HAStates_def)
 apply (rule FAddSA_HierAuto)
 apply auto
 done
 
 subsection "Constructing a PseudoHA" 
 
 definition
   PseudoHA :: "[('s,'e,'d)seqauto,'d data] => ('s,'e,'d)hierauto" where
   "PseudoHA SA D = Abs_hierauto(D,{SA}, SAEvents SA ,EmptyMap (States SA))"
 
 lemma PseudoHA_SAs [simp]:
   "SAs (PseudoHA SA D) = {SA}"
 by (unfold PseudoHA_def SAs_def, simp add: Abs_hierauto_inverse)
 
 lemma PseudoHA_Events [simp]:
   "HAEvents (PseudoHA SA D) = SAEvents SA"
 by (unfold PseudoHA_def HAEvents_def, simp add: Abs_hierauto_inverse)
  
 lemma PseudoHA_CompFun [simp]:
   "CompFun (PseudoHA SA D) = EmptyMap (States SA)"
 by (unfold PseudoHA_def CompFun_def, simp add: Abs_hierauto_inverse)
 
 lemma PseudoHA_HAStates [simp]:
   "HAStates (PseudoHA SA D) = (States SA)"
 by (unfold HAStates_def, auto)
 
 lemma PseudoHA_HAInitValue [simp]:
   "(HAInitValue (PseudoHA SA D)) = D"
 by (unfold PseudoHA_def Let_def HAInitValue_def, simp add: Abs_hierauto_inverse)
  
 lemma PseudoHA_CompFun_the [simp]: 
  "S \<in> States A \<Longrightarrow> (the (CompFun (PseudoHA A D) S)) = {}"
 by simp
 
 lemma PseudoHA_CompFun_ran [simp]:
  "(ran (CompFun (PseudoHA SA D))) = {{}}"
 by auto
 
 lemma PseudoHA_HARoot [simp]:
  "(HARoot (PseudoHA SA D)) = SA"
 by (unfold HARoot_def, auto)
 
 lemma PseudoHA_HAInitState [simp]:
   "HAInitState (PseudoHA A D) = InitState A"
 apply (unfold HAInitState_def)
 apply simp
 done
 
 lemma PseudoHA_HAInitStates [simp]:
   "HAInitStates (PseudoHA A D) = {InitState A}" 
 apply (unfold HAInitStates_def)
 apply simp
 done
 
 lemma PseudoHA_Chi [simp]:
   "S \<in> States A \<Longrightarrow> Chi (PseudoHA A D) S = {}"
 apply (unfold Chi_def restrict_def)
 apply auto
 done
 
 lemma PseudoHA_ChiRel [simp]:
   "ChiRel (PseudoHA A D) = {}"
 apply (unfold ChiRel_def)
 apply simp
 done
 
 lemma PseudoHA_InitConf [simp]:
  "InitConf (PseudoHA A D) = {InitState A}"
 apply (unfold InitConf_def)
 apply simp
 done
 
 subsection \<open>Extending a HA by a SA (\<open>AddSA\<close>)\<close>
 
 definition
   AddSA :: "[('s,'e,'d)hierauto, 's * ('s,'e,'d)seqauto]
              => ('s,'e,'d)hierauto"
            ("(_ [++]/ _)" [10,11]10) where
   "AddSA HA SSA = (let (S,SA) = SSA;
                         DNew = HAInitValue HA;
                         FNew = insert SA (SAs HA);
                         ENew  = HAEvents HA \<union> SAEvents SA;
                         GNew  = CompFun HA [f+] (S,SA)
                    in
                        Abs_hierauto(DNew,FNew,ENew,GNew))"
 
 definition
   AddHA :: "[('s,'e,'d)hierauto, 's * ('s,'e,'d)hierauto]
              => ('s,'e,'d)hierauto"
            ("(_ [**]/ _)" [10,11]10) where
   "AddHA HA1 SHA =
             (let (S,HA2)     = SHA;
                  (D1,F1,E1,G1) = Rep_hierauto (HA1 [++] (S,HARoot HA2));
                  (D2,F2,E2,G2) = Rep_hierauto HA2;
                  FNew       = F1 \<union> F2;
                  ENew       = E1 \<union> E2;
                  GNew       = G1 ++ G2
              in
                  Abs_hierauto(D1,FNew,ENew,GNew))"
 
 lemma AddSA_SAs:
   "\<lbrakk> (States SA \<inter>  HAStates HA) = {}; 
       S \<in> HAStates HA \<rbrakk> \<Longrightarrow> (SAs (HA [++] (S,SA))) = insert SA (SAs HA)"
 apply (unfold Let_def AddSA_def)
 apply (subst SAs_def)
 apply (simp add: hierauto_def Abs_hierauto_inverse)
 done
 
 lemma AddSA_Events:
   "\<lbrakk> (States SA \<inter> HAStates HA) = {}; 
       S \<in> HAStates HA \<rbrakk> \<Longrightarrow>
      HAEvents (HA [++] (S,SA)) = (HAEvents HA) \<union> (SAEvents SA)"
 apply (unfold Let_def AddSA_def)
 apply (subst HAEvents_def)
 apply (simp add: hierauto_def Abs_hierauto_inverse)
 done
 
 lemma AddSA_CompFun:
    "\<lbrakk> (States SA \<inter>  HAStates HA) = {}; 
       S \<in> HAStates HA \<rbrakk> \<Longrightarrow>  
      CompFun (HA [++] (S,SA)) = (CompFun HA [f+] (S,SA))"
 apply (unfold Let_def AddSA_def)
 apply (subst CompFun_def)
 apply (simp add: hierauto_def Abs_hierauto_inverse)
 done
 
 lemma AddSA_HAStates:
    "\<lbrakk> (States SA \<inter> HAStates HA) = {}; 
        S \<in> HAStates HA \<rbrakk> \<Longrightarrow>
       HAStates (HA [++] (S,SA)) = (HAStates HA) \<union> (States SA)"
 apply (unfold HAStates_def)
 apply (subst AddSA_SAs)
 apply (unfold HAStates_def)
 apply auto
 done
 
 lemma AddSA_HAInitValue:
    "\<lbrakk> (States SA \<inter> HAStates HA) = {};
        S \<in> HAStates HA \<rbrakk> \<Longrightarrow>
       (HAInitValue (HA [++] (S,SA))) = (HAInitValue HA)"
 apply (unfold Let_def AddSA_def)
 apply (subst HAInitValue_def)
 apply (simp add: hierauto_def Abs_hierauto_inverse)
 done
 
 lemma AddSA_HARoot:
    "\<lbrakk> (States SA \<inter> HAStates HA) = {};
       S \<in> HAStates HA \<rbrakk> \<Longrightarrow> 
       (HARoot (HA [++] (S,SA))) = (HARoot HA)"
 apply (unfold HARoot_def)
 apply (simp add: AddSA_CompFun AddSA_SAs)
 apply (subst FAddSA_RootEx_Root)
 apply auto
 apply (simp only: HAStates_SA_mem)
 apply (unfold HAStates_def)
 apply fast
 done
 
 lemma AddSA_CompFun_the: 
  "\<lbrakk> (States SA \<inter> HAStates A) = {}; 
     S \<in> HAStates A \<rbrakk> \<Longrightarrow> 
   (the ((CompFun (A [++] (S,SA))) S)) = insert SA (the ((CompFun A) S))"
 by (simp add: AddSA_CompFun)
 
 lemma AddSA_CompFun_the2:
  "\<lbrakk> S' \<in> States (SA::('a,'c,'d)seqauto); 
     (States SA \<inter> HAStates A) = {};
     S \<in> HAStates A \<rbrakk> \<Longrightarrow>
     the ((CompFun (A [++] (S,SA))) S') = {}"
 apply (simp add: AddSA_CompFun)
 apply (subst FAddSA_dom_emptyset)
 apply auto
 done
 
 lemma AddSA_CompFun_the3:
  "\<lbrakk> S' \<notin> States (SA::('a,'c,'d)seqauto); 
     S \<noteq> S'; 
     (States SA \<inter> HAStates A) = {}; 
     S \<in> HAStates A \<rbrakk> \<Longrightarrow> 
    (the ((CompFun (A [++] (S,SA))) S')) = (the ((CompFun A) S'))"
 by (simp add: AddSA_CompFun)
 
 lemma AddSA_CompFun_ran:
  "\<lbrakk> (States SA \<inter> HAStates A) = {};
      S \<in> HAStates A \<rbrakk> \<Longrightarrow> 
    ran (CompFun (A [++] (S,SA))) = 
        insert {} (insert (insert SA (the ((CompFun A) S))) (ran (CompFun A) - {the ((CompFun A) S)}))"
 apply (simp add: AddSA_CompFun)
 apply (subst FAddSA_ran)
 apply auto
 apply (fast dest: CompFun_Int_disjoint) 
 done
 
 lemma AddSA_CompFun_ran2:
  "\<lbrakk> (States SA1 \<inter> HAStates A) = {};
     (States SA2 \<inter> (HAStates A \<union> States SA1)) = {};
      S \<in> HAStates A;
      T \<in> States SA1 \<rbrakk> \<Longrightarrow>
    ran (CompFun ((A [++] (S,SA1)) [++] (T,SA2))) = 
        insert {} (insert {SA2} (ran (CompFun (A  [++] (S,SA1)))))"
 apply (simp add: AddSA_HAStates AddSA_CompFun)
 apply (subst FAddSA_ran)
 apply (rule ballI)
 apply (rule impI)
 apply (subst AddSA_CompFun [THEN sym])
 apply simp
 apply simp
 apply (subst AddSA_CompFun [THEN sym])
 apply simp
 apply simp
 apply (rule CompFun_Int_disjoint)
 apply simp
 apply (simp add: AddSA_HAStates)
 apply (simp add: AddSA_HAStates)
 apply (case_tac "S \<in> States SA1")
 apply simp
 apply (simp only: dom_CompFun [THEN sym])
 apply (frule FAddSA_dom_dom_States)
 apply fast
 apply simp
 apply (case_tac "S \<in> States SA1")
 apply simp
 apply fast
 apply (subst FAddSA_dom_dom_States)
 apply simp
 apply simp
 apply simp
 apply (case_tac "S \<in>  States SA1")
 apply simp
 apply fast
 apply (subst FAddSA_dom_dom_States)
 apply simp
 apply simp
 apply simp
 apply (case_tac "S \<in>  States SA1")
 apply simp
 apply fast
 apply simp
 apply fast
 done
 
 lemma AddSA_CompFun_ran_not_mem:
  "\<lbrakk> States SA2 \<inter> (HAStates A \<union> States SA1) = {};
     States SA1 \<inter> HAStates A = {};
     S \<in> HAStates A \<rbrakk> \<Longrightarrow> 
    {SA2} \<notin> ran (CompFun A [f+] (S, SA1))"
   apply (cut_tac HA="A [++] (S,SA1)" and Sas="{SA2}" in ran_CompFun_is_not_SA)
   apply (metis AddSA_HAStates SA_States_disjunct2 SAs_States_HAStates insert_subset)
    apply (simp add: AddSA_HAStates AddSA_CompFun)
   done
 
 lemma AddSA_CompFun_ran3:
  "\<lbrakk> (States SA1 \<inter> HAStates A) = {};
     (States SA2 \<inter> (HAStates A \<union> States SA1)) = {};
     (States SA3 \<inter> (HAStates A \<union> States SA1 \<union> States SA2)) = {};
      S \<in> HAStates A; 
      T \<in> States SA1 \<rbrakk> \<Longrightarrow> 
     ran (CompFun ((A [++] (S,SA1)) [++] (T,SA2) [++] (T,SA3))) = 
        insert {} (insert {SA3,SA2} (ran (CompFun (A  [++] (S,SA1)))))"
   apply (simp add: AddSA_HAStates AddSA_CompFun)
   apply (subst FAddSA_ran)
   apply (metis AddSA_CompFun AddSA_HAStates CompFun_Int_disjoint UnCI dom_CompFun)
   apply (metis AddSA_CompFun AddSA_HAStates UnCI dom_CompFun)
   apply (metis AddSA_CompFun AddSA_HAStates UnCI dom_CompFun)
 
   apply (subst AddSA_CompFun [THEN sym])
     back
     apply simp
    apply simp
 
   apply (subst AddSA_CompFun [THEN sym])
     back
     apply (simp add: AddSA_HAStates)
    apply (simp add: AddSA_HAStates)
   apply (subst AddSA_CompFun_ran2)
       apply fast
      apply fast
     apply fast
    apply fast
   apply (simp add: AddSA_CompFun)
   apply (subst  FAddSA_dom_insert)
     apply (subst FAddSA_dom_dom_States)
       apply simp
      apply fast
     apply simp
    apply fast
   apply (subst FAddSA_dom_emptyset)
      apply simp
     apply fast
    apply simp
   apply simp
   apply (subst  FAddSA_dom_insert)
     apply (subst FAddSA_dom_dom_States)
       apply simp
      apply fast
     apply simp
    apply fast
   apply (subst FAddSA_dom_emptyset)
      apply simp
     apply fast
    apply simp
   apply simp
   by (simp add: AddSA_CompFun_ran_not_mem insert_Diff_if insert_commute)
 
 lemma AddSA_CompFun_PseudoHA_ran:
   "\<lbrakk> S \<in> States RootSA;
      States RootSA \<inter> States SA = {} \<rbrakk> \<Longrightarrow> 
      (ran (CompFun ((PseudoHA RootSA D) [++] (S,SA)))) = (insert {} {{SA}})"
 apply (subst AddSA_CompFun_ran)
 apply auto
 done
 
 lemma AddSA_CompFun_PseudoHA_ran2:
   "\<lbrakk> States SA1 \<inter> States RootSA = {};
      States SA2 \<inter> (States RootSA \<union> States SA1) = {}; 
      S \<in> States RootSA \<rbrakk> \<Longrightarrow>  
      (ran (CompFun ((PseudoHA RootSA D) [++] (S,SA1) [++] (S,SA2)))) = (insert {} {{SA2,SA1}})"
 apply (subst AddSA_CompFun_ran) 
 prefer 3
 apply (subst AddSA_CompFun_the)
 apply simp
 apply simp
 apply (subst AddSA_CompFun_PseudoHA_ran)
 apply fast
 apply fast
 apply (subst AddSA_CompFun_the)
 apply simp
 apply simp
 apply simp
 apply fast
 apply (simp add: AddSA_HAStates)
 apply (simp add: AddSA_HAStates)
 done
 
 lemma AddSA_HAInitStates [simp]:
  "\<lbrakk> States SA \<inter> HAStates A = {};
     S \<in> HAStates A \<rbrakk> \<Longrightarrow>
    HAInitStates (A [++] (S,SA)) = insert (InitState SA) (HAInitStates A)"
 apply (unfold HAInitStates_def)
 apply (simp add: AddSA_SAs)
 done
 
 lemma AddSA_HAInitState [simp]:
  "\<lbrakk> States SA \<inter> HAStates A = {};
     S \<in> HAStates A \<rbrakk> \<Longrightarrow>
   HAInitState (A [++] (S,SA)) = (HAInitState A)"
 apply (unfold HAInitState_def)
 apply (simp add: AddSA_HARoot)
 done
 
 lemma AddSA_Chi [simp]:
  "\<lbrakk> States SA \<inter> HAStates A = {};
    S \<in> HAStates A \<rbrakk> \<Longrightarrow>  
   Chi (A [++] (S,SA)) S = (States SA) \<union> (Chi A S)"
 apply (unfold Chi_def restrict_def)
 apply (simp add: AddSA_SAs AddSA_HAStates AddSA_CompFun_the)
 apply auto
 done
 
 lemma AddSA_Chi2 [simp]:
  "\<lbrakk> States SA \<inter> HAStates A = {};
     S \<in> HAStates A;  
     T \<in> States SA \<rbrakk> \<Longrightarrow>
     Chi (A [++] (S,SA)) T = {}"
 apply (unfold Chi_def restrict_def)
 apply (simp add: AddSA_SAs AddSA_HAStates AddSA_CompFun_the2)
 done
 
 lemma AddSA_Chi3 [simp]:
  "\<lbrakk> States SA \<inter> HAStates A = {};
     S \<in> HAStates A; 
     T \<notin> States SA; T \<noteq> S \<rbrakk> \<Longrightarrow>
     Chi (A [++] (S,SA)) T = Chi A T"
 apply (unfold Chi_def restrict_def)
 apply (simp add: AddSA_SAs AddSA_HAStates AddSA_CompFun_the3)
 apply auto
 done
 
 lemma AddSA_ChiRel [simp]:
  "\<lbrakk> States SA \<inter> HAStates A = {};
     S \<in> HAStates A \<rbrakk> \<Longrightarrow> 
    ChiRel (A [++] (S,SA)) = { (T,T') . T = S \<and> T' \<in> States SA } \<union> (ChiRel A)" 
 apply (unfold ChiRel_def)
 apply (simp add: AddSA_HAStates)
 apply safe
 apply (rename_tac T U)
 apply (case_tac "T \<in> States SA")
 apply simp
 apply simp
 apply (rename_tac T U)
 apply (case_tac "T \<noteq> S")
 apply (case_tac "T \<in>  States SA")
 apply simp
 apply simp
 apply simp
 apply (rename_tac T U)
 apply (case_tac "T \<in>  States SA")
 apply simp
 apply simp
 apply (cut_tac A=A and T=T in Chi_HAStates)
 apply fast
 apply (case_tac "T \<in> States SA")
 apply simp
 apply simp
 apply (cut_tac A=A and T=T in Chi_HAStates)
 apply fast
 apply fast
 apply (rename_tac T U)
 apply (case_tac "T \<noteq> S")
 apply (case_tac "T \<in> States SA")
 apply simp
 apply simp
 apply simp
 apply (rename_tac T U)
 apply (case_tac "T \<in>  States SA")
 apply auto
 apply (metis AddSA_Chi AddSA_Chi3 Int_iff Un_iff empty_iff)
 done
 
 lemma help_InitConf:
   "\<lbrakk>States SA \<inter> HAStates A = {} \<rbrakk> \<Longrightarrow> {p. fst p \<noteq> InitState SA \<and> snd p \<noteq> InitState SA \<and> 
        p \<in>  insert (InitState SA) (HAInitStates A) \<times> insert (InitState SA) (HAInitStates A) \<and>  
        (p \<in>  {S} \<times> States SA \<or>  p \<in>  ChiRel A)} = 
    (HAInitStates A \<times> HAInitStates A \<inter>  ChiRel A)"    
 apply auto
 apply (cut_tac A=SA in InitState_States)
 apply (cut_tac A=A in HAInitStates_HAStates, fast)
 apply (cut_tac A=SA in InitState_States)
 apply (cut_tac A=A in HAInitStates_HAStates, fast)
 done
  
 lemma AddSA_InitConf [simp]:
  "\<lbrakk> States SA \<inter> HAStates A = {};
     S \<in> InitConf A \<rbrakk> \<Longrightarrow> 
     InitConf (A [++] (S,SA)) = insert (InitState SA) (InitConf A)"
 apply (frule InitConf_HAStates2)
 apply (unfold InitConf_def)
 apply (simp del: insert_Times_insert)
-apply auto
-apply (rename_tac T)
-apply (case_tac "T=S")
-apply auto
-prefer 3
-apply (rule_tac R="(HAInitStates A) \<times> (HAInitStates A) \<inter> ChiRel A" in trancl_subseteq)
-apply auto
-apply (rotate_tac 3)
-apply (frule trancl_collect)
-prefer 2
-apply fast
-apply auto
-apply (cut_tac A=SA in InitState_States)
-apply (frule ChiRel_HAStates)
-apply fast
-apply (frule ChiRel_HAStates)
-apply (cut_tac A=SA in InitState_States)
-apply fast
-apply (frule ChiRel_HAStates)
-apply (cut_tac A=SA in InitState_States)
-apply fast
-apply (subst help_InitConf [THEN sym])
-apply fast
-apply auto
+  apply auto
+  apply (rename_tac T)
+   apply (case_tac "T=S")
+  apply auto
+  prefer 3
+   apply (rule_tac R="(HAInitStates A) \<times> (HAInitStates A) \<inter> ChiRel A" in trancl_subseteq)
+ apply auto
+ apply (rotate_tac 3)
+ apply (frule trancl_collect)
+   prefer 2
+   apply fast
+  apply auto
+   apply (cut_tac A=SA in InitState_States)
+   apply (frule ChiRel_HAStates)
+   apply fast
+  apply (frule ChiRel_HAStates)
+  apply (cut_tac A=SA in InitState_States)
+  apply fast
+ apply (subst help_InitConf [THEN sym])
+  apply fast
+ apply auto
 apply (rule_tac b=S in rtrancl_into_rtrancl)
-apply auto
-prefer 2
-apply (erule rtranclE)
-apply auto
-prefer 2
-apply (erule rtranclE)
-apply auto
-apply (rule_tac R="(HAInitStates A) \<times> (HAInitStates A) \<inter> ChiRel A" in trancl_subseteq)
+ apply auto
+  prefer 2
+  apply (erule rtranclE)
+   apply auto
+ prefer 2
+ apply (erule rtranclE)
+  apply auto
+ apply (rule_tac R="(HAInitStates A) \<times> (HAInitStates A) \<inter> ChiRel A" in trancl_subseteq)
 apply auto
 done
 
 lemma AddSA_InitConf2 [simp]:
  "\<lbrakk> States SA \<inter> HAStates A = {};
     S \<notin> InitConf A;
   S \<in> HAStates A \<rbrakk> \<Longrightarrow>
   InitConf (A [++] (S,SA)) = InitConf A"
 apply (unfold InitConf_def)
 apply simp
 apply auto
-apply (rename_tac T)
-prefer 2
-apply (rule_tac R="(HAInitStates A) \<times> (HAInitStates A) \<inter> ChiRel A" in trancl_subseteq)
-apply auto
+ apply (rename_tac T)
+ prefer 2
+ apply (rule_tac R="(HAInitStates A) \<times> (HAInitStates A) \<inter> ChiRel A" in trancl_subseteq)
+  apply auto
 apply (case_tac "T=InitState SA")
-apply auto
-prefer 2
-apply (rotate_tac 3)
-apply (frule trancl_collect)
-prefer 2
-apply fast
-apply auto
-apply (cut_tac A=SA in InitState_States)
-apply (frule ChiRel_HAStates)
-apply fast
-apply (cut_tac A=SA in InitState_States)
-apply (frule ChiRel_HAStates)
-apply fast
-apply (cut_tac A=SA in InitState_States)
-apply (cut_tac A=A in HAInitStates_HAStates)
-apply fast
-apply (subst help_InitConf [THEN sym])
-apply fast
-apply auto
+ apply auto
+ prefer 2
+ apply (rotate_tac 3)
+ apply (frule trancl_collect)
+   prefer 2
+   apply fast
+  apply auto
+   apply (cut_tac A=SA in InitState_States)
+   apply (frule ChiRel_HAStates)
+   apply fast
+  apply (cut_tac A=SA in InitState_States)
+  apply (frule ChiRel_HAStates)
+ apply fast
+ apply (cut_tac A=SA in InitState_States)
+ apply (cut_tac A=A in HAInitStates_HAStates)
+ apply (subst help_InitConf [THEN sym])
+  apply fast
+ apply auto
 apply (rule_tac b="InitState SA" in rtrancl_induct)
-apply auto
-apply (frule ChiRel_HAStates2)
-apply (cut_tac A=SA in InitState_States)
-apply fast
-prefer 2
-apply (frule ChiRel_HAStates)
-apply (cut_tac A=SA in InitState_States)
-apply fast
+  apply auto
+  apply (frule ChiRel_HAStates2)
+  apply (cut_tac A=SA in InitState_States)
+  apply fast
+ prefer 2
+ apply (frule ChiRel_HAStates)
+ apply (cut_tac A=SA in InitState_States)
+ apply fast
 apply (rule rtrancl_into_rtrancl)
-apply auto
-apply (rule rtrancl_into_rtrancl)
-apply auto
+ apply auto
 done
 
 subsection "Theorems for Calculating Wellformedness of HA"
 
 lemma PseudoHA_HAStates_IFF:
  "(States SA) = X  \<Longrightarrow> (HAStates (PseudoHA SA D)) = X"
 apply simp
 done
 
 lemma AddSA_SAs_IFF:
  "\<lbrakk> States SA \<inter> HAStates HA = {};
     S \<in> HAStates HA;
     (SAs HA) = X \<rbrakk> \<Longrightarrow> (SAs (HA [++] (S, SA))) = (insert SA X)"
 apply (subst AddSA_SAs)
 apply auto
 done
 
 lemma AddSA_Events_IFF:
  "\<lbrakk> States SA \<inter> HAStates HA = {}; 
     S \<in> HAStates HA; 
     (HAEvents HA) = HAE;
     (SAEvents SA) = SAE;  
     (HAE \<union> SAE) = X \<rbrakk> \<Longrightarrow> (HAEvents (HA [++] (S, SA))) = X"
 apply (subst AddSA_Events)
 apply auto
 done
 
 lemma AddSA_CompFun_IFF:
  "\<lbrakk> States SA \<inter>  HAStates HA = {};
     S \<in> HAStates HA;
     (CompFun HA) = HAG;
     (HAG [f+] (S, SA)) = X \<rbrakk> \<Longrightarrow> (CompFun (HA [++] (S, SA))) = X"
 apply (subst AddSA_CompFun)
 apply auto
 done
 
 lemma AddSA_HAStates_IFF: 
  "\<lbrakk> States SA \<inter> HAStates HA = {};
     S \<in> HAStates HA;
     (HAStates HA) = HAS;
     (States SA) = SAS;
     (HAS \<union> SAS) = X \<rbrakk> \<Longrightarrow> (HAStates (HA [++] (S, SA))) = X"
 apply (subst AddSA_HAStates)
 apply auto
 done
 
 lemma AddSA_HAInitValue_IFF:
  "\<lbrakk> States SA \<inter> HAStates HA = {};
     S \<in> HAStates HA;
     (HAInitValue HA) = X \<rbrakk> \<Longrightarrow> (HAInitValue (HA [++] (S, SA))) = X"
 apply (subst AddSA_HAInitValue)
 apply auto
 done
 
 lemma AddSA_HARoot_IFF:
  "\<lbrakk> States SA \<inter> HAStates HA = {};
     S \<in> HAStates HA;
     (HARoot HA) = X \<rbrakk> \<Longrightarrow> (HARoot (HA [++] (S, SA))) = X"
 apply (subst AddSA_HARoot)
 apply auto
 done
 
 lemma AddSA_InitConf_IFF:
  "\<lbrakk> InitConf A = Y;
     States SA \<inter> HAStates A = {};
     S \<in> HAStates A; 
     (if S \<in> Y then insert (InitState SA) Y else Y) = X \<rbrakk> \<Longrightarrow> 
     InitConf (A [++] (S,SA)) = X" 
 apply (case_tac "S \<in> Y")
 apply auto
 done
 
 lemma AddSA_CompFun_ran_IFF:
   "\<lbrakk> (States SA \<inter> HAStates A) = {}; 
      S \<in> HAStates A;
      (insert {} (insert (insert SA (the ((CompFun A) S))) (ran (CompFun A) - {the ((CompFun A) S)}))) = X \<rbrakk> \<Longrightarrow>
      ran (CompFun (A [++] (S,SA))) = X"
 apply (subst  AddSA_CompFun_ran)
 apply auto
 done
 
 lemma AddSA_CompFun_ran2_IFF:
  "\<lbrakk> (States SA1 \<inter> HAStates A) = {}; 
     (States SA2 \<inter> (HAStates A \<union> States SA1)) = {};
     S \<in> HAStates A;
     T \<in> States SA1;
     insert {} (insert {SA2} (ran (CompFun (A  [++] (S,SA1))))) = X \<rbrakk> \<Longrightarrow>
     ran (CompFun ((A [++] (S,SA1)) [++] (T,SA2))) = X"
 apply (subst AddSA_CompFun_ran2)
 apply auto
 done
    
 lemma AddSA_CompFun_ran3_IFF:
  "\<lbrakk> (States SA1 \<inter> HAStates A) = {};
     (States SA2 \<inter> (HAStates A \<union> States SA1)) = {};
     (States SA3 \<inter> (HAStates A \<union> States SA1 \<union> States SA2)) = {};
      S \<in> HAStates A;
      T \<in> States SA1;
      insert {} (insert {SA3,SA2} (ran (CompFun (A  [++] (S,SA1))))) = X \<rbrakk> \<Longrightarrow>
      ran (CompFun ((A [++] (S,SA1)) [++] (T,SA2) [++] (T,SA3))) = X" 
 apply (subst AddSA_CompFun_ran3)
 apply auto
 done
 
 lemma AddSA_CompFun_PseudoHA_ran_IFF:
   "\<lbrakk> S \<in> States RootSA; 
      States RootSA \<inter> States SA = {};
    (insert {} {{SA}}) = X \<rbrakk> \<Longrightarrow> 
    (ran (CompFun ((PseudoHA RootSA D) [++] (S,SA)))) = X"
 apply (subst AddSA_CompFun_PseudoHA_ran)
 apply auto
 done
 
 lemma AddSA_CompFun_PseudoHA_ran2_IFF:
   "\<lbrakk> States SA1 \<inter> States RootSA = {};
      States SA2 \<inter> (States RootSA \<union> States SA1) = {};
      S \<in> States RootSA;
      (insert {} {{SA2,SA1}}) = X \<rbrakk> \<Longrightarrow> 
      (ran (CompFun ((PseudoHA RootSA D) [++] (S,SA1) [++] (S,SA2)))) = X" 
 apply (subst AddSA_CompFun_PseudoHA_ran2)
 apply auto
 done
 
 
 ML \<open>
 
 val AddSA_SAs_IFF = @{thm AddSA_SAs_IFF};
 val AddSA_Events_IFF = @{thm AddSA_Events_IFF};
 val AddSA_CompFun_IFF = @{thm AddSA_CompFun_IFF};
 val AddSA_HAStates_IFF = @{thm AddSA_HAStates_IFF};
 val PseudoHA_HAStates_IFF = @{thm PseudoHA_HAStates_IFF};
 val AddSA_HAInitValue_IFF = @{thm AddSA_HAInitValue_IFF};
 val AddSA_CompFun_ran_IFF = @{thm AddSA_CompFun_ran_IFF};
 val AddSA_HARoot_IFF = @{thm AddSA_HARoot_IFF};
 val insert_inter = @{thm insert_inter};
 val insert_notmem = @{thm insert_notmem};
 val PseudoHA_CompFun = @{thm PseudoHA_CompFun};
 val PseudoHA_Events = @{thm PseudoHA_Events};
 val PseudoHA_SAs = @{thm PseudoHA_SAs};
 val PseudoHA_HARoot = @{thm PseudoHA_HARoot};
 val PseudoHA_HAInitValue = @{thm PseudoHA_HAInitValue};
 val PseudoHA_CompFun_ran = @{thm PseudoHA_CompFun_ran};
 val Un_empty_right = @{thm Un_empty_right};
 val insert_union = @{thm insert_union};
 
 
 fun wellformed_tac ctxt L i =
   FIRST[resolve_tac ctxt [AddSA_SAs_IFF] i,
         resolve_tac ctxt [AddSA_Events_IFF] i,
         resolve_tac ctxt [AddSA_CompFun_IFF] i,
         resolve_tac ctxt [AddSA_HAStates_IFF] i,
         resolve_tac ctxt [PseudoHA_HAStates_IFF] i,
         resolve_tac ctxt [AddSA_HAInitValue_IFF] i,
         resolve_tac ctxt [AddSA_HARoot_IFF] i,
         resolve_tac ctxt [AddSA_CompFun_ran_IFF] i,
         resolve_tac ctxt [insert_inter] i,
         resolve_tac ctxt [insert_notmem] i,
         CHANGED (simp_tac (put_simpset HOL_basic_ss ctxt addsimps
            [PseudoHA_HARoot, PseudoHA_CompFun, PseudoHA_CompFun_ran,PseudoHA_Events,PseudoHA_SAs,insert_union,
             PseudoHA_HAInitValue,Un_empty_right]@ L) i),
         fast_tac ctxt i,
         CHANGED (simp_tac ctxt i)];
 \<close>
 
 method_setup wellformed  = \<open>Attrib.thms >> (fn thms => fn ctxt => (METHOD (fn facts => 
                                        (HEADGOAL (wellformed_tac ctxt (facts @ thms))))))\<close>
 
 end
diff --git a/thys/Topological_Semantics/ROOT b/thys/Topological_Semantics/ROOT
--- a/thys/Topological_Semantics/ROOT
+++ b/thys/Topological_Semantics/ROOT
@@ -1,28 +1,25 @@
 chapter AFP
 
-session "Topological_Semantics" = "HOL" +
+session "Topological_Semantics" (AFP) = "HOL" +
   options [timeout = 600]
   theories
-    sse_boolean_algebra
-    sse_boolean_algebra_quantification
-    sse_operation_positive
-    sse_operation_positive_quantification
-    sse_operation_negative
-    sse_operation_negative_quantification
-    topo_operators_basic
-    topo_operators_derivative
-    topo_alexandrov
-    topo_frontier_algebra
-    topo_negation_conditions
-    topo_negation_fixedpoints
-    ex_LFIs
-    topo_strict_implication
-    ex_subminimal_logics
-    topo_derivative_algebra
-    ex_LFUs
-    topo_border_algebra
-    topo_closure_algebra
-    topo_interior_algebra
+    boolean_algebra
+    boolean_algebra_infinitary
+    boolean_algebra_operators
+    conditions_positive
+    conditions_positive_infinitary
+    conditions_negative
+    conditions_negative_infinitary
+    conditions_relativized
+    conditions_relativized_infinitary
+    logics_consequence
+    logics_operators
+    logics_negation
+    logics_quantifiers
+    logics_quantifiers_example
+    logics_LFI
+    logics_LFU
+
   document_files
     "root.tex"
     "root.bib"
diff --git a/thys/Topological_Semantics/boolean_algebra.thy b/thys/Topological_Semantics/boolean_algebra.thy
new file mode 100644
--- /dev/null
+++ b/thys/Topological_Semantics/boolean_algebra.thy
@@ -0,0 +1,203 @@
+theory boolean_algebra
+  imports Main
+begin
+
+(*-----------------------------------*)
+text\<open>Technical configuration\<close>
+declare[[smt_timeout=30]]
+declare[[show_types]]
+(* declare[[syntax_ambiguity_warning=false]] *)
+sledgehammer_params[isar_proof=false]
+nitpick_params[assms=true, user_axioms=true, show_all, expect=genuine, format=3, atoms=a b c d] (*default Nitpick settings*)
+text\<open>We hide some Isabelle/HOL notation from the libraries (which we don't use) to avoid overloading\<close>
+hide_const(open) List.list.Nil no_notation List.list.Nil ("[]")  (*We have no use for lists... *)
+hide_const(open) Relation.converse no_notation Relation.converse ("(_\<inverse>)" [1000] 999) (*..nor for relations in this work*)
+hide_const(open) Fun.comp no_notation Fun.comp (infixl "\<circ>" 55) (*we redefine function composition below*)
+hide_const(open) Groups.plus_class.plus no_notation Groups.plus_class.plus (infixl "+" 65) (*we don't use this*)
+hide_const(open) Groups.times_class.times no_notation Groups.times_class.times (infixl "*" 70) (*we don't use this*)
+hide_const(open) Groups.minus_class.minus no_notation Groups.minus_class.minus (infixl "-" 65) (*we don't use this*)
+hide_const(open) Groups.uminus_class.uminus no_notation Groups.uminus_class.uminus ("- _" [81] 80) (*we don't use this*)
+(*-----------------------------------*)
+
+section \<open>Shallow semantical embedding of (a logic of) Boolean algebras\<close>
+
+text\<open>We encode Boolean algebras via their (Stone) representation as algebras of sets ('fields of sets').
+This means that each element of (the carrier of) the algebra will be a set of 'points'.
+Inspired by the 'propositions as sets of worlds' paradigm from modal logic, we may think of points 
+as being 'worlds', and thus of the elements of our Boolean algebras as 'propositions'.
+Of course, this is just one among many possible interpretations, and nothing stops us from thinking 
+of points as any other kind of object (e.g., they can be sets, functions, sets of functions, etc.).
+\<close>
+
+text\<open>We utilize a particular naming convention: The type parameter 'w is employed for the
+domain/universe of 'points'. We conveniently introduce the (parametric) type-alias ('w)\<sigma> 
+as shorthand for 'w\<Rightarrow>bool. Hence, the elements of our algebra are objects of type ('w)\<sigma>,
+and thus correspond to (characteristic functions of) sets of 'points'.
+Set-valued (resp. set-domain) functions are thus functions that have sets as their codomain (resp. domain),
+they are basically anything with a (parametric) type 'a\<Rightarrow>('w)\<sigma> (resp. ('w)\<sigma>\<Rightarrow>'a).\<close>
+
+text\<open>Type for (characteristic functions of) sets (of 'points')\<close>
+type_synonym 'w \<sigma> = \<open>'w \<Rightarrow> bool\<close>
+
+text\<open>In the sequel, we will (try to) enforce the following naming convention:\<close>
+
+text\<open>(i) Upper-case latin letters (A, B, D, M, P, S, X, etc.) denote arbitrary sets (type ('w)\<sigma>).
+We will employ lower-case letters (p, q, x, w, etc.) to denote variables playing the role of 'points'.
+In some contexts, the letters S and D will be employed to denote sets/domains of sets (of 'points').\<close>
+
+text\<open>(ii) Greek letters denote arbitrary set-valued functions (type 'a\<Rightarrow>('w)\<sigma>).
+We employ the letters \<phi>, \<psi> and \<eta> to denote arbitrary unary operations
+(with type ('w)\<sigma>\<Rightarrow>('w)\<sigma>).\<close>
+
+text\<open>(iii) Upper-case calligraphic letters (\<B>, \<I>, \<C>, \<F>, etc.) are reserved for unary operations that are
+intended to act as 'topological operators' in the given context.\<close>
+
+subsection \<open>Encoding Boolean operations\<close>
+
+text\<open>Standard inclusion-based order structure on sets.\<close>
+definition subset::"'w \<sigma> \<Rightarrow> 'w \<sigma> \<Rightarrow> bool" (infixr "\<^bold>\<le>" 45) 
+  where "A \<^bold>\<le> B \<equiv> \<forall>p. A p \<longrightarrow> B p"
+definition setequ::"'w \<sigma> \<Rightarrow> 'w \<sigma> \<Rightarrow> bool" (infixr "\<^bold>=" 45) 
+  where "A \<^bold>= B \<equiv> \<forall>p. A p \<longleftrightarrow> B p"
+
+named_theorems order (*to group together order-related definitions*)
+declare setequ_def[order] subset_def[order]
+
+lemma subset_char1: "(A \<^bold>\<le> B) = (\<forall>C. B \<^bold>\<le> C \<longrightarrow> A \<^bold>\<le> C)" by (metis subset_def)
+lemma subset_char2: "(A \<^bold>\<le> B) = (\<forall>C. C \<^bold>\<le> A \<longrightarrow> C \<^bold>\<le> B)" by (metis subset_def)
+
+text\<open>These (trivial) lemmas are intended to help automated tools.\<close>
+lemma setequ_char: "(A \<^bold>= B) = (A \<^bold>\<le> B \<and> B \<^bold>\<le> A)" unfolding order by blast
+lemma setequ_ext: "(A \<^bold>= B) = (A = B)" unfolding order by blast
+
+text\<open>We now encode connectives for (distributive and complemented) bounded lattices, mostly 
+by reusing their counterpart meta-logical HOL connectives.\<close>
+definition meet::"'w \<sigma> \<Rightarrow> 'w \<sigma> \<Rightarrow> 'w \<sigma>" (infixr "\<^bold>\<and>" 54) 
+  where "A \<^bold>\<and> B \<equiv> \<lambda>p. (A p) \<and> (B p)" \<comment>\<open> intersection \<close>
+definition join::"'w \<sigma> \<Rightarrow> 'w \<sigma> \<Rightarrow> 'w \<sigma>" (infixr "\<^bold>\<or>" 53) 
+  where "A \<^bold>\<or> B \<equiv> \<lambda>p. (A p) \<or> (B p)" \<comment>\<open> union \<close>
+definition top::"'w \<sigma>" ("\<^bold>\<top>")    
+  where "\<^bold>\<top> \<equiv> \<lambda>w. True"   \<comment>\<open> universe \<close>
+definition bottom::"'w \<sigma>" ("\<^bold>\<bottom>") 
+  where "\<^bold>\<bottom> \<equiv> \<lambda>w. False"  \<comment>\<open> empty-set \<close>
+
+text\<open>And introduce further operations to obtain a Boolean algebra (of sets).\<close>
+definition compl::"'w \<sigma> \<Rightarrow> 'w \<sigma>" ("\<^bold>\<midarrow>_" [57]58)
+  where "\<^bold>\<midarrow>A  \<equiv> \<lambda>p. \<not>(A p)" \<comment>\<open>  (set-)complement \<close>
+definition impl::"'w \<sigma> \<Rightarrow> 'w \<sigma> \<Rightarrow> 'w \<sigma>" (infixr "\<^bold>\<rightarrow>" 51)
+  where "A \<^bold>\<rightarrow> B \<equiv> \<lambda>p. (A p) \<longrightarrow> (B p)" \<comment>\<open>  (set-)implication \<close>
+definition diff::"'w \<sigma> \<Rightarrow> 'w \<sigma> \<Rightarrow> 'w \<sigma>" (infixr "\<^bold>\<leftharpoonup>" 51) 
+  where "A \<^bold>\<leftharpoonup> B \<equiv> \<lambda>p. (A p) \<and> \<not>(B p)" \<comment>\<open>  (set-)difference \<close>
+definition dimpl::"'w \<sigma> \<Rightarrow> 'w \<sigma> \<Rightarrow> 'w \<sigma>" (infixr "\<^bold>\<leftrightarrow>" 51)
+  where "A \<^bold>\<leftrightarrow> B \<equiv> \<lambda>p. (A p) = (B p)" \<comment>\<open>  double implication \<close>
+definition sdiff::"'w \<sigma> \<Rightarrow> 'w \<sigma> \<Rightarrow> 'w \<sigma>" (infixr "\<^bold>\<triangle>" 51)
+  where "A \<^bold>\<triangle> B \<equiv> \<lambda>p. (A p) \<noteq> (B p)" \<comment>\<open>  symmetric difference (aka. xor)  \<close>
+
+named_theorems conn (*to group together definitions for algebraic connectives*)
+declare meet_def[conn] join_def[conn] top_def[conn] bottom_def[conn]
+        impl_def[conn] dimpl_def[conn] diff_def[conn] sdiff_def[conn] compl_def[conn]
+
+text\<open>Verify characterization for some connectives.\<close>
+lemma compl_char: "\<^bold>\<midarrow>A = A \<^bold>\<rightarrow> \<^bold>\<bottom>" unfolding conn by simp
+lemma impl_char: "A \<^bold>\<rightarrow> B = \<^bold>\<midarrow>A \<^bold>\<or> B" unfolding conn by simp
+lemma dimpl_char: "A \<^bold>\<leftrightarrow> B = (A \<^bold>\<rightarrow> B) \<^bold>\<and> (B \<^bold>\<rightarrow> A)" unfolding conn by blast
+lemma diff_char1: "A \<^bold>\<leftharpoonup> B = A \<^bold>\<and> \<^bold>\<midarrow>B" unfolding conn by simp
+lemma diff_char2: "A \<^bold>\<leftharpoonup> B = \<^bold>\<midarrow>(A \<^bold>\<rightarrow> B)" unfolding conn by simp
+lemma sdiff_char1: "A \<^bold>\<triangle> B = (A \<^bold>\<leftharpoonup> B) \<^bold>\<or> (B \<^bold>\<leftharpoonup> A)" unfolding conn by blast
+lemma sdiff_char2: "A \<^bold>\<triangle> B = \<^bold>\<midarrow>(A \<^bold>\<leftrightarrow> B)" unfolding conn by simp
+
+text\<open>We can verify that (quite trivially) this algebra satisfies some properties of lattices.\<close>
+lemma L1: "A \<^bold>= A \<^bold>\<or> A" unfolding conn order by simp
+lemma L2: "A \<^bold>= A \<^bold>\<and> A" unfolding conn order by simp
+lemma L3: "A \<^bold>\<le> A \<^bold>\<or> B" unfolding conn order by simp
+lemma L4: "A \<^bold>\<and> B \<^bold>\<le> A" unfolding conn order by simp
+lemma L5: "(A \<^bold>\<and> B) \<^bold>\<or> B \<^bold>= B" unfolding setequ_char conn order by simp 
+lemma L6: "A \<^bold>\<and> (A \<^bold>\<or> B) \<^bold>= A" unfolding setequ_char conn order by simp
+lemma L7: "A \<^bold>\<le> C \<and> B \<^bold>\<le> C \<longrightarrow> A \<^bold>\<or> B \<^bold>\<le> C" unfolding conn order by simp 
+lemma L8: "C \<^bold>\<le> A \<and> C \<^bold>\<le> B \<longrightarrow> C \<^bold>\<le> A \<^bold>\<and> B" unfolding conn order by simp
+lemma L9:  "A \<^bold>\<le> B \<longleftrightarrow> (A \<^bold>\<or> B) \<^bold>= B" unfolding setequ_char conn order by simp
+lemma L10: "B \<^bold>\<le> A \<longleftrightarrow> (A \<^bold>\<and> B) \<^bold>= B" unfolding setequ_char conn order by simp
+lemma L11: "A \<^bold>\<le> B \<and> C \<^bold>\<le> D \<longrightarrow> A \<^bold>\<or> C \<^bold>\<le> B \<^bold>\<or> D" unfolding conn order by simp
+lemma L12: "A \<^bold>\<le> B \<and> C \<^bold>\<le> D \<longrightarrow> A \<^bold>\<and> C \<^bold>\<le> B \<^bold>\<and> D" unfolding conn order by simp
+lemma L13: "A \<^bold>\<and> \<^bold>\<top> \<^bold>= A" unfolding conn order by simp
+lemma L14: "A \<^bold>\<or> \<^bold>\<bottom> \<^bold>= A" unfolding conn order by simp
+lemma L15: "A \<^bold>\<le> B \<longleftrightarrow> (\<forall>C. C \<^bold>\<and> A \<^bold>\<le> C \<^bold>\<and> B)" by (metis L3 L4 L5 L8 setequ_char subset_char1)
+lemma L16: "A \<^bold>\<le> B \<longleftrightarrow> (\<forall>C. C \<^bold>\<or> A \<^bold>\<le> C \<^bold>\<or> B)" by (metis L11 L4 L5 setequ_char setequ_ext)
+
+text\<open>These properties below hold in particular also for Boolean algebras.\<close>
+lemma BA_impl: "A \<^bold>\<le> B \<longleftrightarrow> A \<^bold>\<rightarrow> B \<^bold>= \<^bold>\<top>" unfolding conn order by simp
+lemma BA_distr1: "(A \<^bold>\<and> (B \<^bold>\<or> C)) \<^bold>= ((A \<^bold>\<and> B) \<^bold>\<or> (A \<^bold>\<and> C))" unfolding setequ_char conn order by simp
+lemma BA_distr2: "(A \<^bold>\<or> (B \<^bold>\<and> C)) \<^bold>= ((A \<^bold>\<or> B) \<^bold>\<and> (A \<^bold>\<or> C))" unfolding conn order by blast
+lemma BA_cp: "A \<^bold>\<le> B \<longleftrightarrow> \<^bold>\<midarrow>B \<^bold>\<le> \<^bold>\<midarrow>A" unfolding conn order by blast 
+lemma BA_deMorgan1: "\<^bold>\<midarrow>(A \<^bold>\<or> B) \<^bold>= (\<^bold>\<midarrow>A \<^bold>\<and> \<^bold>\<midarrow>B)" unfolding conn order by simp
+lemma BA_deMorgan2: "\<^bold>\<midarrow>(A \<^bold>\<and> B) \<^bold>= (\<^bold>\<midarrow>A \<^bold>\<or> \<^bold>\<midarrow>B)" unfolding conn order by simp
+lemma BA_dn: "\<^bold>\<midarrow>\<^bold>\<midarrow>A \<^bold>= A" unfolding conn order by simp
+lemma BA_cmpl_equ: "(\<^bold>\<midarrow>A \<^bold>= B) = (A \<^bold>= \<^bold>\<midarrow>B)" unfolding conn order by blast
+
+
+text\<open>We conveniently introduce these properties of sets of sets (of points).\<close>
+definition meet_closed::"('w \<sigma>)\<sigma> \<Rightarrow> bool"
+  where "meet_closed S \<equiv>  \<forall>X Y. (S X \<and> S Y) \<longrightarrow> S(X \<^bold>\<and> Y)"
+definition join_closed::"('w \<sigma>)\<sigma> \<Rightarrow> bool"
+  where "join_closed S \<equiv>  \<forall>X Y. (S X \<and> S Y) \<longrightarrow> S(X \<^bold>\<or> Y)"
+
+definition upwards_closed::"('w \<sigma>)\<sigma> \<Rightarrow> bool"
+  where "upwards_closed S \<equiv> \<forall>X Y. S X \<and> X \<^bold>\<le> Y \<longrightarrow> S Y"
+definition downwards_closed::"('w \<sigma>)\<sigma> \<Rightarrow> bool" 
+  where "downwards_closed S \<equiv> \<forall>X Y. S X \<and> Y \<^bold>\<le> X \<longrightarrow> S Y"
+
+
+subsection \<open>Atomicity and primitive equality\<close>
+
+text\<open>We can verify indeed that the algebra is atomic (in three different ways) by relying on the
+presence of primitive equality in HOL.\<close>
+
+lemma atomic1: "\<forall>w. \<exists>Q. Q w \<and> (\<forall>P. P w \<longrightarrow> Q \<^bold>\<le> P)" unfolding order using the_sym_eq_trivial by metis
+
+definition "atom A \<equiv> \<not>(A \<^bold>= \<^bold>\<bottom>) \<and> (\<forall>P. A \<^bold>\<le> P \<or> A \<^bold>\<le> \<^bold>\<midarrow>P)"
+
+lemma atomic2: "\<forall>w. \<exists>Q. Q w \<and> atom Q" unfolding atom_def order conn using the_sym_eq_trivial by metis
+lemma atomic3: "\<forall>P. \<not>(P \<^bold>= \<^bold>\<bottom>) \<longrightarrow> (\<exists>Q. atom Q \<and> Q \<^bold>\<le> P)" unfolding atom_def order conn by fastforce
+
+text\<open>Now with interactive proof:\<close>
+lemma "\<forall>P. \<not>(P \<^bold>= \<^bold>\<bottom>) \<longrightarrow> (\<exists>Q. atom Q \<and> Q \<^bold>\<le> P)"
+proof -
+  { fix P::"'w \<sigma>"
+    { assume "\<not>(P \<^bold>= \<^bold>\<bottom>)"
+      hence "\<exists>v. P v" unfolding conn order by simp
+      then obtain w where 1:"P w" by (rule exE)
+      let ?Q="\<lambda>v. v = w" \<comment>\<open> using HOL primitive equality \<close>
+      have 2: "atom ?Q" unfolding atom_def unfolding conn order by simp
+      have "\<forall>v. ?Q v \<longrightarrow> P v" using 1 by simp
+      hence 3: "?Q \<^bold>\<le> P" unfolding order by simp
+      from 2 3 have "\<exists>Q. atom Q \<and> Q \<^bold>\<le> P" by blast
+    } hence "\<not>(P \<^bold>= \<^bold>\<bottom>) \<longrightarrow> (\<exists>Q. atom Q \<and> Q \<^bold>\<le> P)" by (rule impI)
+  } thus ?thesis by (rule allI)
+qed
+
+subsection \<open>Miscellaneous notions\<close>
+
+text\<open>We add some miscellaneous notions that will be useful later.\<close>
+
+abbreviation "isEmpty S \<equiv> \<forall>x. \<not>S x"
+abbreviation "nonEmpty S \<equiv> \<exists>x. S x"
+
+text\<open>Function composition.\<close>
+definition fun_comp :: "('b \<Rightarrow> 'c) \<Rightarrow> ( 'a \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'c" (infixl "\<circ>" 75) 
+  where "\<phi> \<circ> \<psi> \<equiv> \<lambda>x. \<phi> (\<psi> x)"
+
+text\<open>Inverse projection maps a unary function to a 'projected' binary function wrt. its 1st argument.\<close>
+abbreviation inv_proj::\<open>('a \<Rightarrow> 'c) \<Rightarrow> ('a \<Rightarrow> 'b \<Rightarrow> 'c)\<close> ("(_)\<upharpoonleft>")
+  where "D\<upharpoonleft> \<equiv> \<lambda>A B. D A"
+
+text\<open>Image of a mapping \<phi>, with range as an special case.\<close>
+definition image::"('a \<Rightarrow> 'b) \<Rightarrow> ('a \<Rightarrow> bool) \<Rightarrow> ('b \<Rightarrow> bool)" ("\<lbrakk>_ _\<rbrakk>") 
+  where "\<lbrakk>\<phi> S\<rbrakk> \<equiv> \<lambda>y. \<exists>x. (S x) \<and> (\<phi> x) = y"
+definition range::"('a \<Rightarrow> 'b) \<Rightarrow> ('b \<Rightarrow> bool)" ("\<lbrakk>_'_\<rbrakk>") 
+  where "\<lbrakk>\<phi> _\<rbrakk> \<equiv> \<lambda>Y. \<exists>x. (\<phi> x) = Y"
+lemma range_char1: "\<lbrakk>\<phi> _\<rbrakk> = \<lbrakk>\<phi> (\<lambda>x. True)\<rbrakk>" by (simp add: image_def range_def)
+lemma range_char2: "\<lbrakk>\<phi> _\<rbrakk> = (\<lambda>X. \<exists>S. \<lbrakk>\<phi> S\<rbrakk> X)" unfolding range_def image_def by blast
+
+lemma image_comp: "\<lbrakk>(f \<circ> g) S\<rbrakk> = \<lbrakk>f \<lbrakk>g S\<rbrakk>\<rbrakk>" unfolding fun_comp_def image_def by metis
+
+end
diff --git a/thys/Topological_Semantics/boolean_algebra_infinitary.thy b/thys/Topological_Semantics/boolean_algebra_infinitary.thy
new file mode 100644
--- /dev/null
+++ b/thys/Topological_Semantics/boolean_algebra_infinitary.thy
@@ -0,0 +1,130 @@
+theory boolean_algebra_infinitary
+  imports boolean_algebra_operators
+begin
+
+subsection \<open>Encoding infinitary Boolean operations\<close>
+
+text\<open>Our aim is to encode complete Boolean algebras (of sets) which we can later be used to
+interpret quantified formulas (somewhat in the spirit of Boolean-valued models for set theory).\<close>
+
+text\<open>We start by defining infinite meet (infimum) and infinite join (supremum) operations.\<close>
+definition infimum:: "('w \<sigma>)\<sigma> \<Rightarrow> 'w \<sigma>" ("\<^bold>\<And>_") 
+  where "\<^bold>\<And>S \<equiv> \<lambda>w. \<forall>X. S X \<longrightarrow> X w"
+definition supremum::"('w \<sigma>)\<sigma> \<Rightarrow> 'w \<sigma>" ("\<^bold>\<Or>_") 
+  where "\<^bold>\<Or>S \<equiv> \<lambda>w. \<exists>X. S X  \<and>  X w"
+
+declare infimum_def[conn] supremum_def[conn] (*add infimum and supremum to definition set of algebra connectives*)
+
+text\<open>Infimum and supremum satisfy an infinite variant of the De Morgan laws.\<close>
+lemma iDM_a: "\<^bold>\<midarrow>(\<^bold>\<And>S) \<^bold>= \<^bold>\<Or>(S\<^sup>d\<^sup>-)" unfolding order conn conn2 by force
+lemma iDM_b:" \<^bold>\<midarrow>(\<^bold>\<Or>S) \<^bold>= \<^bold>\<And>(S\<^sup>d\<^sup>-)" unfolding order conn conn2 by force
+
+text\<open>We show that our encoded Boolean algebras are lattice-complete.
+The functions below return the set of upper-/lower-bounds of a set of sets S (wrt. domain D).\<close>
+definition upper_bounds::"('w \<sigma>)\<sigma> \<Rightarrow> ('w \<sigma>)\<sigma>" ("ub")
+  where "ub S \<equiv> \<lambda>U. \<forall>X. S X \<longrightarrow> X \<^bold>\<le> U" 
+definition upper_bounds_restr::"('w \<sigma>)\<sigma> \<Rightarrow> ('w \<sigma>)\<sigma> \<Rightarrow> ('w \<sigma>)\<sigma>" ("ub\<^sup>_")
+  where "ub\<^sup>D S \<equiv> \<lambda>U. D U \<and> (\<forall>X. S X \<longrightarrow> X \<^bold>\<le> U)" 
+definition lower_bounds::"('w \<sigma>)\<sigma> \<Rightarrow> ('w \<sigma>)\<sigma>" ("lb")
+  where "lb S \<equiv> \<lambda>L. \<forall>X. S X \<longrightarrow> L \<^bold>\<le> X"
+definition lower_bounds_restr::"('w \<sigma>)\<sigma> \<Rightarrow> ('w \<sigma>)\<sigma> \<Rightarrow> ('w \<sigma>)\<sigma>" ("lb\<^sup>_")
+  where "lb\<^sup>D S \<equiv> \<lambda>L. D L \<and> (\<forall>X. S X \<longrightarrow> L \<^bold>\<le> X)"
+
+lemma ub_char: "ub S = (let D=\<^bold>\<top> in ub\<^sup>D S) " by (simp add: top_def upper_bounds_def upper_bounds_restr_def)
+lemma lb_char: "lb S = (let D=\<^bold>\<top> in lb\<^sup>D S) " by (simp add: top_def lower_bounds_def lower_bounds_restr_def)
+
+text\<open>Similarly, the functions below return the set of least/greatest upper-/lower-bounds for S (wrt. D).\<close>
+definition lub::"('w \<sigma>)\<sigma> \<Rightarrow> ('w \<sigma>)\<sigma>" ("lub") 
+  where "lub S \<equiv> \<lambda>U. ub S U \<and> (\<forall>X. ub S X \<longrightarrow> U \<^bold>\<le> X)"
+definition lub_restr::"('w \<sigma>)\<sigma> \<Rightarrow> ('w \<sigma>)\<sigma> \<Rightarrow> ('w \<sigma>)\<sigma>" ("lub\<^sup>_") 
+  where "lub\<^sup>D S \<equiv> \<lambda>U. ub\<^sup>D S U \<and> (\<forall>X. ub\<^sup>D S X \<longrightarrow> U \<^bold>\<le> X)"
+definition glb::"('w \<sigma>)\<sigma> \<Rightarrow> ('w \<sigma>)\<sigma>" ("glb")
+  where "glb S \<equiv> \<lambda>L. lb S L \<and> (\<forall>X. lb S X \<longrightarrow> X \<^bold>\<le> L)"
+definition glb_restr::"('w \<sigma>)\<sigma> \<Rightarrow> ('w \<sigma>)\<sigma> \<Rightarrow> ('w \<sigma>)\<sigma>" ("glb\<^sup>_")
+  where "glb\<^sup>D S \<equiv> \<lambda>L. lb\<^sup>D S L \<and> (\<forall>X. lb\<^sup>D S X \<longrightarrow> X \<^bold>\<le> L)"
+
+text\<open>Both pairs of definitions above are suitably related.
+(Note that the term \<top> below denotes the top element in the algebra of sets of sets (i.e. the powerset).)\<close>
+lemma lub_char: "lub S = (let D=\<^bold>\<top> in lub\<^sup>D S) " by (simp add: lub_def lub_restr_def ub_char)
+lemma glb_char: "glb S = (let D=\<^bold>\<top> in glb\<^sup>D S) " by (simp add: glb_def glb_restr_def lb_char)
+
+text\<open>Clearly, the notions of infimum/supremum correspond to least/greatest upper-/lower-bound.\<close>
+lemma sup_lub: "lub S \<^bold>\<Or>S" unfolding lub_def upper_bounds_def supremum_def subset_def by blast
+lemma sup_exist_unique: "\<forall>S. \<exists>!X. lub S X" by (meson lub_def setequ_char setequ_ext sup_lub)
+lemma inf_glb: "glb S \<^bold>\<And>S" unfolding glb_def lower_bounds_def infimum_def subset_def by blast
+lemma inf_exist_unique: "\<forall>S. \<exists>!X. glb S X" by (meson glb_def inf_glb setequ_char setequ_ext)
+
+text\<open>The property of being closed under arbitrary (resp. nonempty) supremum/infimum.\<close>
+definition infimum_closed :: "('w \<sigma>)\<sigma> \<Rightarrow> bool"
+  where "infimum_closed S  \<equiv> \<forall>D. D \<^bold>\<le> S \<longrightarrow> S(\<^bold>\<And>D)" (*observe that D can be empty*)
+definition supremum_closed :: "('w \<sigma>)\<sigma> \<Rightarrow> bool" 
+  where "supremum_closed S \<equiv> \<forall>D. D \<^bold>\<le> S \<longrightarrow> S(\<^bold>\<Or>D)" (*observe that D can be empty*)
+definition infimum_closed' :: "('w \<sigma>)\<sigma> \<Rightarrow> bool" 
+  where"infimum_closed' S  \<equiv> \<forall>D. nonEmpty D \<and> D \<^bold>\<le> S \<longrightarrow> S(\<^bold>\<And>D)"
+definition supremum_closed' :: "('w \<sigma>)\<sigma> \<Rightarrow> bool" 
+  where "supremum_closed' S \<equiv> \<forall>D. nonEmpty D \<and> D \<^bold>\<le> S \<longrightarrow> S(\<^bold>\<Or>D)"
+
+lemma inf_empty: "isEmpty S \<Longrightarrow> \<^bold>\<And>S \<^bold>= \<^bold>\<top>" unfolding order conn by simp
+lemma sup_empty: "isEmpty S \<Longrightarrow> \<^bold>\<Or>S \<^bold>= \<^bold>\<bottom>" unfolding order conn by simp
+
+text\<open>Note that arbitrary infimum- (resp. supremum-) closed sets include the top (resp. bottom) element.\<close>
+lemma "infimum_closed S \<Longrightarrow> S \<^bold>\<top>" unfolding infimum_closed_def conn order by force
+lemma "supremum_closed S \<Longrightarrow> S \<^bold>\<bottom>" unfolding supremum_closed_def conn order by force
+text\<open>However, the above does not hold for non-empty infimum- (resp. supremum-) closed sets.\<close>
+lemma "infimum_closed' S \<Longrightarrow> S \<^bold>\<top>" nitpick oops \<comment>\<open> countermodel \<close>
+lemma "supremum_closed' S \<Longrightarrow> S \<^bold>\<bottom>" nitpick oops  \<comment>\<open> countermodel \<close>
+
+text\<open>We have in fact the following characterizations for the notions above.\<close>
+lemma inf_closed_char: "infimum_closed S = (infimum_closed' S \<and> S \<^bold>\<top>)" 
+  unfolding infimum_closed'_def infimum_closed_def by (metis bottom_def infimum_closed_def infimum_def setequ_char setequ_ext subset_def top_def)
+lemma sup_closed_char: "supremum_closed S = (supremum_closed' S \<and> S \<^bold>\<bottom>)"
+  unfolding supremum_closed'_def supremum_closed_def by (metis (no_types, opaque_lifting) L14 L9 bottom_def setequ_ext subset_def supremum_def)
+
+lemma inf_sup_closed_dc: "infimum_closed S = supremum_closed S\<^sup>d\<^sup>-" by (smt (verit) BA_dn iDM_a iDM_b infimum_closed_def setequ_ext sdfun_dcompl_def subset_def supremum_closed_def)
+lemma inf_sup_closed_dc': "infimum_closed' S = supremum_closed' S\<^sup>d\<^sup>-" by (smt (verit) dualcompl_invol iDM_a infimum_closed'_def sdfun_dcompl_def setequ_ext subset_def supremum_closed'_def)
+
+text\<open>We check some further properties.\<close>
+lemma fp_inf_sup_closed_dual: "infimum_closed (fp \<phi>) = supremum_closed (fp \<phi>\<^sup>d)" 
+  by (simp add: fp_dual inf_sup_closed_dc)
+lemma fp_inf_sup_closed_dual': "infimum_closed' (fp \<phi>) = supremum_closed' (fp \<phi>\<^sup>d)" 
+  by (simp add: fp_dual inf_sup_closed_dc')
+
+text\<open>We verify that being infimum-closed' (resp. supremum-closed') entails being meet-closed (resp. join-closed).\<close>
+lemma inf_meet_closed: "\<forall>S. infimum_closed' S \<longrightarrow> meet_closed S" proof -
+  { fix S::"'w \<sigma> \<Rightarrow> bool"
+    { assume inf_closed: "infimum_closed' S"
+      hence "meet_closed S" proof -
+        { fix X::"'w \<sigma>" and Y::"'w \<sigma>"
+          let ?D="\<lambda>Z. Z=X \<or> Z=Y"
+          { assume "S X \<and> S Y"
+            hence "?D \<^bold>\<le> S" using subset_def by blast
+            moreover have "nonEmpty ?D" by auto
+            ultimately have "S(\<^bold>\<And>?D)" using inf_closed infimum_closed'_def by (smt (z3))
+            hence "S(\<lambda>w. \<forall>Z. (Z=X \<or> Z=Y) \<longrightarrow> Z w)" unfolding infimum_def by simp
+            moreover have "(\<lambda>w. \<forall>Z. (Z=X \<or> Z=Y) \<longrightarrow> Z w) = (\<lambda>w. X w \<and> Y w)" by auto
+            ultimately have "S(\<lambda>w. X w \<and> Y w)" by simp
+          } hence "(S X \<and> S Y) \<longrightarrow> S(X \<^bold>\<and> Y)" unfolding conn by (rule impI)
+        } thus ?thesis unfolding meet_closed_def by simp  qed
+    } hence "infimum_closed' S \<longrightarrow> meet_closed S" by simp
+  } thus ?thesis by (rule allI)
+qed
+lemma sup_join_closed: "\<forall>P. supremum_closed' P \<longrightarrow> join_closed P" proof -
+  { fix S::"'w \<sigma> \<Rightarrow> bool"
+    { assume sup_closed: "supremum_closed' S"
+      hence "join_closed S" proof -
+        { fix X::"'w \<sigma>" and Y::"'w \<sigma>"
+          let ?D="\<lambda>Z. Z=X \<or> Z=Y"
+          { assume "S X \<and> S Y"
+            hence "?D \<^bold>\<le> S" using subset_def by blast
+            moreover have "nonEmpty ?D" by auto
+            ultimately have "S(\<^bold>\<Or>?D)" using sup_closed supremum_closed'_def by (smt (z3))
+            hence "S(\<lambda>w. \<exists>Z. (Z=X \<or> Z=Y) \<and> Z w)" unfolding supremum_def by simp
+            moreover have "(\<lambda>w. \<exists>Z. (Z=X \<or> Z=Y) \<and> Z w) = (\<lambda>w. X w \<or> Y w)" by auto
+            ultimately have "S(\<lambda>w. X w \<or> Y w)" by simp
+          } hence "(S X \<and> S Y) \<longrightarrow> S(X \<^bold>\<or> Y)" unfolding conn by (rule impI)
+        } thus ?thesis unfolding join_closed_def by simp qed
+    } hence "supremum_closed' S \<longrightarrow> join_closed S" by simp
+  } thus ?thesis by (rule allI)
+qed
+
+end
diff --git a/thys/Topological_Semantics/boolean_algebra_operators.thy b/thys/Topological_Semantics/boolean_algebra_operators.thy
new file mode 100644
--- /dev/null
+++ b/thys/Topological_Semantics/boolean_algebra_operators.thy
@@ -0,0 +1,155 @@
+theory boolean_algebra_operators
+  imports boolean_algebra
+begin
+
+subsection \<open>Operations on set-valued functions\<close>
+
+text\<open>Functions with sets in their codomain will be called here 'set-valued functions'.
+  We conveniently define some (2nd-order) Boolean operations on them.\<close>
+
+text\<open>The 'meet' and 'join' of two set-valued functions.\<close>
+definition svfun_meet::"('a \<Rightarrow> 'w \<sigma>) \<Rightarrow> ('a \<Rightarrow> 'w \<sigma>) \<Rightarrow> ('a \<Rightarrow> 'w \<sigma>)" (infixr "\<^bold>\<and>\<^sup>:" 62) 
+  where "\<phi> \<^bold>\<and>\<^sup>: \<psi> \<equiv> \<lambda>x. (\<phi> x) \<^bold>\<and> (\<psi> x)"
+definition svfun_join::"('a \<Rightarrow> 'w \<sigma>) \<Rightarrow> ('a \<Rightarrow> 'w \<sigma>) \<Rightarrow> ('a \<Rightarrow> 'w \<sigma>)" (infixr "\<^bold>\<or>\<^sup>:" 61) 
+  where "\<phi> \<^bold>\<or>\<^sup>: \<psi> \<equiv> \<lambda>x. (\<phi> x) \<^bold>\<or> (\<psi> x)"
+text\<open>Analogously, we can define an 'implication' and a 'complement'.\<close>
+definition svfun_impl::"('a \<Rightarrow> 'w \<sigma>) \<Rightarrow> ('a \<Rightarrow> 'w \<sigma>) \<Rightarrow> ('a \<Rightarrow> 'w \<sigma>)" (infixr "\<^bold>\<rightarrow>\<^sup>:" 61) 
+  where "\<psi> \<^bold>\<rightarrow>\<^sup>: \<phi> \<equiv> \<lambda>x. (\<psi> x) \<^bold>\<rightarrow> (\<phi> x)"
+definition svfun_compl::"('a \<Rightarrow> 'w \<sigma>) \<Rightarrow> ('a \<Rightarrow> 'w \<sigma>)" ("(_\<^sup>-)") 
+  where "\<phi>\<^sup>- \<equiv> \<lambda>x. \<^bold>\<midarrow>(\<phi> x)"
+text\<open>There are two natural 0-ary connectives (aka. constants). \<close>
+definition svfun_top::"'a \<Rightarrow> 'w \<sigma>" ("\<^bold>\<top>\<^sup>:") 
+  where "\<^bold>\<top>\<^sup>: \<equiv> \<lambda>x. \<^bold>\<top>"
+definition svfun_bot::"'a \<Rightarrow> 'w \<sigma>" ("\<^bold>\<bottom>\<^sup>:") 
+  where "\<^bold>\<bottom>\<^sup>: \<equiv> \<lambda>x. \<^bold>\<bottom>"
+
+named_theorems conn2 (*to group together definitions for 2nd-order algebraic connectives*)
+declare svfun_meet_def[conn2] svfun_join_def[conn2] svfun_impl_def[conn2]
+        svfun_compl_def[conn2] svfun_top_def[conn2] svfun_bot_def[conn2]
+
+text\<open>And, of course, set-valued functions are naturally ordered in the expected way:\<close>
+definition svfun_sub::"('a \<Rightarrow> 'w \<sigma>) \<Rightarrow> ('a \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" (infixr "\<^bold>\<le>\<^sup>:" 55) 
+  where "\<psi> \<^bold>\<le>\<^sup>: \<phi> \<equiv> \<forall>x. (\<psi> x) \<^bold>\<le> (\<phi> x)"
+definition svfun_equ::"('a \<Rightarrow> 'w \<sigma>) \<Rightarrow> ('a \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" (infixr "\<^bold>=\<^sup>:" 55) 
+  where "\<psi> \<^bold>=\<^sup>: \<phi> \<equiv> \<forall>x. (\<psi> x) \<^bold>= (\<phi> x)"
+
+named_theorems order2 (*to group together definitions for 2nd-order algebraic connectives*)
+declare svfun_sub_def[order2] svfun_equ_def[order2]
+
+text\<open>These (trivial) lemmas are intended to help automated tools.\<close>
+lemma svfun_sub_char: "(\<psi> \<^bold>\<le>\<^sup>: \<phi>) = (\<psi> \<^bold>\<rightarrow>\<^sup>: \<phi> \<^bold>=\<^sup>: \<^bold>\<top>\<^sup>:)" by (simp add: BA_impl svfun_equ_def svfun_impl_def svfun_sub_def svfun_top_def)
+lemma svfun_equ_char: "(\<psi> \<^bold>=\<^sup>: \<phi>) = (\<psi> \<^bold>\<le>\<^sup>: \<phi> \<and> \<phi> \<^bold>\<le>\<^sup>: \<psi>)" unfolding order2 setequ_char by blast
+lemma svfun_equ_ext: "(\<psi> \<^bold>=\<^sup>: \<phi>) = (\<psi> = \<phi>)" by (meson ext setequ_ext svfun_equ_def)
+
+text\<open>Clearly, set-valued functions form a Boolean algebra. We can prove some interesting relationships:\<close>
+lemma svfun_compl_char: "\<phi>\<^sup>- = (\<phi> \<^bold>\<rightarrow>\<^sup>: \<^bold>\<bottom>\<^sup>:)" unfolding conn conn2 by simp
+lemma svfun_impl_char1: "(\<psi> \<^bold>\<rightarrow>\<^sup>: \<phi>) = (\<psi>\<^sup>- \<^bold>\<or>\<^sup>: \<phi>)" unfolding conn conn2 by simp
+lemma svfun_impl_char2: "(\<psi> \<^bold>\<rightarrow>\<^sup>: \<phi>) = (\<psi> \<^bold>\<and>\<^sup>: (\<phi>\<^sup>-))\<^sup>-" unfolding conn conn2 by simp
+lemma svfun_deMorgan1: "(\<psi> \<^bold>\<and>\<^sup>: \<phi>)\<^sup>- = (\<psi>\<^sup>-) \<^bold>\<or>\<^sup>: (\<phi>\<^sup>-)" unfolding conn conn2 by simp
+lemma svfun_deMorgan2: "(\<psi> \<^bold>\<or>\<^sup>: \<phi>)\<^sup>- = (\<psi>\<^sup>-) \<^bold>\<and>\<^sup>: (\<phi>\<^sup>-)" unfolding conn conn2 by simp
+
+
+subsection \<open>Operators and their transformations\<close>
+
+text\<open>Dual to set-valued functions we can have set-domain functions. For them we can define the 'dual-complement'.\<close>
+definition sdfun_dcompl::"('w \<sigma> \<Rightarrow> 'a) \<Rightarrow> ('w \<sigma> \<Rightarrow> 'a)" ("(_\<^sup>d\<^sup>-)") 
+  where "\<phi>\<^sup>d\<^sup>- \<equiv> \<lambda>X. \<phi>(\<^bold>\<midarrow>X)"
+lemma sdfun_dcompl_char: "\<phi>\<^sup>d\<^sup>- = (\<lambda>X. \<exists>Y. (\<phi> Y) \<and> (X = \<^bold>\<midarrow>Y))" by (metis BA_dn setequ_ext sdfun_dcompl_def)
+
+text\<open>Operators are a particularly important kind of functions. They are both set-valued and set-domain.
+Thus our algebra of operators inherits the connectives defined above plus the ones below. \<close>
+
+text\<open>We conveniently define the 'dual' of an operator.\<close>
+definition op_dual::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> ('w \<sigma> \<Rightarrow> 'w \<sigma>)" ("(_\<^sup>d)") 
+  where "\<phi>\<^sup>d \<equiv> \<lambda>X. \<^bold>\<midarrow>(\<phi>(\<^bold>\<midarrow>X))"
+
+text\<open>The following two 0-ary connectives (i.e. operator 'constants') exist already (but somehow implicitly).
+  We just make them explicit by introducing some convenient notation.\<close>
+definition id_op::"'w \<sigma> \<Rightarrow> 'w \<sigma>" ("\<^bold>e") 
+  where "\<^bold>e \<equiv> \<lambda>X. X" (*introduces notation to refer to 'identity' operator*)
+definition compl_op::"'w \<sigma> \<Rightarrow> 'w \<sigma>" ("\<^bold>n") 
+  where "\<^bold>n \<equiv> \<lambda>X. \<^bold>\<midarrow>X" (*to refer to 'complement' operator*)
+
+declare sdfun_dcompl_def[conn2] op_dual_def[conn2] id_op_def[conn2] compl_op_def[conn2]
+
+text\<open>We now prove some lemmas (some of them might help provers in their hard work).\<close>
+lemma dual_compl_char1: "\<phi>\<^sup>d\<^sup>- = (\<phi>\<^sup>d)\<^sup>-" unfolding conn2 conn order by simp
+lemma dual_compl_char2: "\<phi>\<^sup>d\<^sup>- = (\<phi>\<^sup>-)\<^sup>d" unfolding conn2 conn order by simp
+lemma sfun_compl_invol: "\<phi>\<^sup>-\<^sup>- = \<phi>" unfolding conn2 conn order by simp
+lemma dual_invol: "\<phi>\<^sup>d\<^sup>d = \<phi>" unfolding conn2 conn order by simp
+lemma dualcompl_invol: "(\<phi>\<^sup>d\<^sup>-)\<^sup>d\<^sup>- = \<phi>" unfolding conn2 conn order by simp
+
+lemma op_prop1: "\<^bold>e\<^sup>d = \<^bold>e" unfolding conn2 conn by simp
+lemma op_prop2: "\<^bold>n\<^sup>d = \<^bold>n" unfolding conn2 conn by simp
+lemma op_prop3: "\<^bold>e\<^sup>- = \<^bold>n" unfolding conn2 conn by simp
+lemma op_prop4: "(\<phi> \<^bold>\<or>\<^sup>: \<psi>)\<^sup>d = (\<phi>\<^sup>d) \<^bold>\<and>\<^sup>: (\<psi>\<^sup>d)" unfolding conn2 conn by simp
+lemma op_prop5: "(\<phi> \<^bold>\<or>\<^sup>: \<psi>)\<^sup>- = (\<phi>\<^sup>-) \<^bold>\<and>\<^sup>: (\<psi>\<^sup>-)" unfolding conn2 conn by simp
+lemma op_prop6: "(\<phi> \<^bold>\<and>\<^sup>: \<psi>)\<^sup>d = (\<phi>\<^sup>d) \<^bold>\<or>\<^sup>: (\<psi>\<^sup>d)" unfolding conn2 conn by simp
+lemma op_prop7: "(\<phi> \<^bold>\<and>\<^sup>: \<psi>)\<^sup>- = (\<phi>\<^sup>-) \<^bold>\<or>\<^sup>: (\<psi>\<^sup>-)" unfolding conn2 conn by simp
+lemma op_prop8: "\<^bold>\<top>\<^sup>: = \<^bold>n \<^bold>\<or>\<^sup>: \<^bold>e" unfolding conn2 conn by simp
+lemma op_prop9: "\<^bold>\<bottom>\<^sup>: = \<^bold>n \<^bold>\<and>\<^sup>: \<^bold>e" unfolding conn2 conn by simp
+
+text\<open>The notion of a fixed-point is fundamental. We speak of sets being fixed-points of operators.
+We define a function that given an operator returns the set of all its fixed-points.\<close>
+definition fixpoints::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> ('w \<sigma>)\<sigma>" ("fp") 
+  where "fp \<phi> \<equiv> \<lambda>X. (\<phi> X) \<^bold>= X"
+text\<open>We can in fact 'operationalize' the function above, thus obtaining a 'fixed-point operation'.\<close>
+definition op_fixpoint::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> ('w \<sigma> \<Rightarrow> 'w \<sigma>)" ("(_\<^sup>f\<^sup>p)")
+  where "\<phi>\<^sup>f\<^sup>p \<equiv> \<lambda>X. (\<phi> X) \<^bold>\<leftrightarrow> X"
+
+declare fixpoints_def[conn2] op_fixpoint_def[conn2]
+
+text\<open>Interestingly, the fixed-point operation (or transformation) is definable in terms of the others.\<close>
+lemma op_fixpoint_char: "\<phi>\<^sup>f\<^sup>p = (\<phi> \<^bold>\<and>\<^sup>: \<^bold>e) \<^bold>\<or>\<^sup>: (\<phi>\<^sup>- \<^bold>\<and>\<^sup>: \<^bold>n)" unfolding conn2 order conn by blast
+
+text\<open>Given an operator \<phi> the fixed-points of \<phi>'s dual is the set of complements of \<phi>'s fixed-points.\<close>
+lemma fp_dual: "fp \<phi>\<^sup>d = (fp \<phi>)\<^sup>d\<^sup>-" unfolding order conn conn2 by blast
+text\<open>The fixed-points of \<phi>'s complement is the set of complements of the fixed-points of \<phi>'s dual-complement.\<close>
+lemma fp_compl: "fp \<phi>\<^sup>- = (fp (\<phi>\<^sup>d\<^sup>-))\<^sup>d\<^sup>-" by (simp add: dual_compl_char2 dualcompl_invol fp_dual)
+text\<open>The fixed-points of \<phi>'s dual-complement is the set of complements of the fixed-points of \<phi>'s complement.\<close>
+lemma fp_dcompl: "fp (\<phi>\<^sup>d\<^sup>-) = (fp \<phi>\<^sup>-)\<^sup>d\<^sup>-" by (simp add: dualcompl_invol fp_compl)
+
+text\<open>The fixed-points function and the fixed-point operation are essentially related.\<close>
+lemma fp_rel: "fp \<phi> A \<longleftrightarrow> (\<phi>\<^sup>f\<^sup>p A) \<^bold>= \<^bold>\<top>" unfolding conn2 order conn by simp
+lemma fp_d_rel:  "fp \<phi>\<^sup>d A \<longleftrightarrow> \<phi>\<^sup>f\<^sup>p(\<^bold>\<midarrow>A) \<^bold>= \<^bold>\<top>" unfolding conn2 order conn by blast
+lemma fp_c_rel: "fp \<phi>\<^sup>- A \<longleftrightarrow> \<phi>\<^sup>f\<^sup>p A \<^bold>= \<^bold>\<bottom>" unfolding conn2 order conn by blast
+lemma fp_dc_rel: "fp (\<phi>\<^sup>d\<^sup>-) A \<longleftrightarrow> \<phi>\<^sup>f\<^sup>p(\<^bold>\<midarrow>A) \<^bold>= \<^bold>\<bottom>" unfolding conn2 order conn by simp
+
+text\<open>The fixed-point operation is involutive.\<close>
+lemma ofp_invol: "(\<phi>\<^sup>f\<^sup>p)\<^sup>f\<^sup>p = \<phi>" unfolding conn2 order conn by blast
+text\<open>And commutes the dual with the dual-complement operations.\<close>
+lemma ofp_comm_dc1: "(\<phi>\<^sup>d)\<^sup>f\<^sup>p = (\<phi>\<^sup>f\<^sup>p)\<^sup>d\<^sup>-" unfolding conn2 order conn by blast
+lemma ofp_comm_dc2:"(\<phi>\<^sup>d\<^sup>-)\<^sup>f\<^sup>p = (\<phi>\<^sup>f\<^sup>p)\<^sup>d" unfolding conn2 order conn by simp
+
+text\<open>The fixed-point operation commutes with the complement.\<close>
+lemma ofp_comm_compl: "(\<phi>\<^sup>-)\<^sup>f\<^sup>p = (\<phi>\<^sup>f\<^sup>p)\<^sup>-" unfolding conn2 order conn by blast
+text\<open>The above motivates the following alternative definition for a 'complemented-fixed-point' operation.\<close>
+lemma ofp_fixpoint_compl_def: "\<phi>\<^sup>f\<^sup>p\<^sup>- = (\<lambda>X. (\<phi> X) \<^bold>\<triangle> X)" unfolding conn2 conn by simp
+text\<open>Analogously, the 'complemented fixed-point' operation is also definable in terms of the others.\<close>
+lemma op_fixpoint_compl_char: "\<phi>\<^sup>f\<^sup>p\<^sup>- = (\<phi> \<^bold>\<or>\<^sup>: \<^bold>e) \<^bold>\<and>\<^sup>: (\<phi>\<^sup>- \<^bold>\<or>\<^sup>: \<^bold>n)" unfolding conn2 conn by blast
+
+text\<open>In fact, function composition can be seen as an additional binary connective for operators.
+  We show below some interesting relationships that hold. \<close>
+lemma op_prop10: "\<phi> = (\<^bold>e \<circ> \<phi>)" unfolding conn2 fun_comp_def by simp
+lemma op_prop11: "\<phi> = (\<phi> \<circ> \<^bold>e)" unfolding conn2 fun_comp_def by simp
+lemma op_prop12: "\<^bold>e = (\<^bold>n \<circ> \<^bold>n)" unfolding conn2 conn fun_comp_def by simp
+lemma op_prop13: "\<phi>\<^sup>- = (\<^bold>n \<circ> \<phi>)" unfolding conn2 fun_comp_def by simp
+lemma op_prop14: "\<phi>\<^sup>d\<^sup>- = (\<phi> \<circ> \<^bold>n)" unfolding conn2 fun_comp_def by simp
+lemma op_prop15: "\<phi>\<^sup>d = (\<^bold>n \<circ> \<phi> \<circ> \<^bold>n)" unfolding conn2 fun_comp_def by simp
+
+text\<open>There are also some useful properties regarding the images of operators.\<close>
+lemma im_prop1: "\<lbrakk>\<phi> D\<rbrakk>\<^sup>d\<^sup>-  = \<lbrakk>\<phi>\<^sup>d D\<^sup>d\<^sup>-\<rbrakk>" unfolding image_def op_dual_def sdfun_dcompl_def by (metis BA_dn setequ_ext)
+lemma im_prop2: "\<lbrakk>\<phi>\<^sup>- D\<rbrakk>\<^sup>d\<^sup>- = \<lbrakk>\<phi> D\<rbrakk>" unfolding image_def svfun_compl_def sdfun_dcompl_def by (metis BA_dn setequ_ext)
+lemma im_prop3: "\<lbrakk>\<phi>\<^sup>d D\<rbrakk>\<^sup>d\<^sup>- = \<lbrakk>\<phi> D\<^sup>d\<^sup>-\<rbrakk>" unfolding image_def op_dual_def sdfun_dcompl_def by (metis BA_dn setequ_ext)
+lemma im_prop4: "\<lbrakk>\<phi>\<^sup>d\<^sup>- D\<rbrakk>\<^sup>d\<^sup>- = \<lbrakk>\<phi>\<^sup>d D\<rbrakk>" unfolding image_def op_dual_def sdfun_dcompl_def by (metis BA_dn setequ_ext)
+lemma im_prop5: "\<lbrakk>\<phi>\<^sup>- D\<^sup>d\<^sup>-\<rbrakk>  = \<lbrakk>\<phi>\<^sup>d\<^sup>- D\<rbrakk>\<^sup>d\<^sup>-" unfolding image_def svfun_compl_def sdfun_dcompl_def by (metis (no_types, opaque_lifting) BA_dn setequ_ext)
+lemma im_prop6: "\<lbrakk>\<phi>\<^sup>d\<^sup>- D\<^sup>d\<^sup>-\<rbrakk>  = \<lbrakk>\<phi> D\<rbrakk>" unfolding image_def sdfun_dcompl_def by (metis BA_dn setequ_ext)
+
+
+text\<open>Observe that all results obtained by assuming fixed-point predicates extend to their associated operators.\<close>
+lemma "\<phi>\<^sup>f\<^sup>p(A) \<^bold>\<and> \<Gamma>(A) \<^bold>\<le> \<Delta>(A) \<longrightarrow> (fp \<phi>)(A) \<longrightarrow> \<Gamma>(A) \<^bold>\<le> \<Delta>(A)"
+  by (simp add: fp_rel meet_def setequ_ext subset_def top_def)
+lemma "\<phi>\<^sup>f\<^sup>p(A) \<^bold>\<and> \<phi>\<^sup>f\<^sup>p(B) \<^bold>\<and> (\<Gamma> A B) \<^bold>\<le> (\<Delta> A B) \<longrightarrow> (fp \<phi>)(A) \<and> (fp \<phi>)(B) \<longrightarrow> (\<Gamma> A B) \<^bold>\<le> (\<Delta> A B)"
+  by (simp add: fp_rel meet_def setequ_ext subset_def top_def)
+
+end
diff --git a/thys/Topological_Semantics/conditions_negative.thy b/thys/Topological_Semantics/conditions_negative.thy
new file mode 100644
--- /dev/null
+++ b/thys/Topological_Semantics/conditions_negative.thy
@@ -0,0 +1,149 @@
+theory conditions_negative
+  imports conditions_positive
+begin
+
+subsection \<open>Negative Conditions\<close>
+
+text\<open>We continue defining and interrelating axiomatic conditions on unary operations (operators). 
+  We now move to conditions commonly satisfied by negation-like logical operations.\<close>
+
+text\<open>Anti-tonicity (ANTI).\<close>
+definition ANTI::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("ANTI")
+  where "ANTI \<phi> \<equiv> \<forall>A B. A \<^bold>\<le> B \<longrightarrow> \<phi> B \<^bold>\<le> \<phi> A"
+
+declare ANTI_def[cond]
+
+text\<open>ANTI is self-dual.\<close>
+lemma ANTI_dual: "ANTI \<phi> = ANTI \<phi>\<^sup>d" by (smt (verit) BA_cp ANTI_def dual_invol op_dual_def)
+text\<open>ANTI is the 'complement' of MONO.\<close>
+lemma ANTI_MONO: "MONO \<phi> = ANTI \<phi>\<^sup>-" by (metis ANTI_def BA_cp MONO_def svfun_compl_def)
+
+
+text\<open>Anti-expansive/extensive (nEXPN) and its dual anti-contractive (nCNTR).\<close>
+definition nEXPN::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("nEXPN")
+  where "nEXPN \<phi>  \<equiv> \<forall>A. \<phi> A \<^bold>\<le> \<^bold>\<midarrow>A"
+definition nCNTR::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("nCNTR")
+  where "nCNTR \<phi> \<equiv> \<forall>A. \<^bold>\<midarrow>A \<^bold>\<le> \<phi> A"
+
+declare nEXPN_def[cond] nCNTR_def[cond]
+
+text\<open>nEXPN and nCNTR are dual to each other.\<close>
+lemma nEXPN_nCNTR_dual1: "nEXPN \<phi> = nCNTR \<phi>\<^sup>d" unfolding cond by (metis BA_cp BA_dn op_dual_def setequ_ext)
+lemma nEXPN_nCNTR_dual2: "nCNTR \<phi> = nEXPN \<phi>\<^sup>d" by (simp add: dual_invol nEXPN_nCNTR_dual1)
+
+text\<open>nEXPN and nCNTR are the 'complements' of EXPN and CNTR respectively.\<close>
+lemma nEXPN_CNTR_compl: "EXPN \<phi> = nEXPN \<phi>\<^sup>-" by (metis BA_cp EXPN_def nEXPN_def svfun_compl_def)
+lemma nCNTR_EXPN_compl: "CNTR \<phi> = nCNTR \<phi>\<^sup>-" by (metis EXPN_CNTR_dual2 dual_compl_char1 dual_compl_char2 nEXPN_CNTR_compl nEXPN_nCNTR_dual2)
+
+text\<open>Anti-Normality (nNORM) and its dual (nDNRM).\<close>
+definition nNORM::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("nNORM")
+  where "nNORM \<phi>  \<equiv> (\<phi> \<^bold>\<bottom>) \<^bold>= \<^bold>\<top>"
+definition nDNRM::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("nDNRM")
+  where "nDNRM \<phi> \<equiv> (\<phi> \<^bold>\<top>) \<^bold>= \<^bold>\<bottom>" 
+
+declare nNORM_def[cond] nDNRM_def[cond]
+
+text\<open>nNORM and nDNRM are dual to each other.\<close>
+lemma nNOR_dual1: "nNORM \<phi> = nDNRM \<phi>\<^sup>d" unfolding cond by (simp add: bottom_def compl_def op_dual_def setequ_def top_def)
+lemma nNOR_dual2: "nDNRM \<phi> = nNORM \<phi>\<^sup>d" by (simp add: dual_invol nNOR_dual1) 
+
+text\<open>nNORM and nDNRM are the 'complements' of NORM and DNRM respectively.\<close>
+lemma nNORM_NORM_compl: "NORM \<phi> = nNORM \<phi>\<^sup>-" by (simp add: NORM_def bottom_def compl_def nNORM_def setequ_def svfun_compl_def top_def)
+lemma nDNRM_DNRM_compl: "DNRM \<phi> = nDNRM \<phi>\<^sup>-" by (simp add: DNRM_def bottom_def compl_def nDNRM_def setequ_def svfun_compl_def top_def)
+
+text\<open>nEXPN (nCNTR) entail nDNRM (nNORM).\<close>
+lemma nEXPN_impl_nDNRM: "nEXPN \<phi> \<longrightarrow> nDNRM \<phi>" unfolding cond by (metis bottom_def compl_def setequ_def subset_def top_def)
+lemma nCNTR_impl_nNORM: "nCNTR \<phi> \<longrightarrow> nNORM \<phi>" by (simp add: nEXPN_impl_nDNRM nEXPN_nCNTR_dual2 nNOR_dual1)
+
+
+text\<open>Anti-Idempotence (nIDEM).\<close>
+definition nIDEM::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("nIDEM") 
+  where "nIDEM \<phi>  \<equiv> \<forall>A. \<phi>(\<^bold>\<midarrow>(\<phi> A)) \<^bold>= (\<phi> A)"
+definition nIDEM_a::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("nIDEM\<^sup>a") 
+  where "nIDEM_a \<phi> \<equiv> \<forall>A. (\<phi> A) \<^bold>\<le> \<phi>(\<^bold>\<midarrow>(\<phi> A))"
+definition nIDEM_b::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("nIDEM\<^sup>b") 
+  where "nIDEM_b \<phi> \<equiv> \<forall>A. \<phi>(\<^bold>\<midarrow>(\<phi> A)) \<^bold>\<le> (\<phi> A)"
+
+declare nIDEM_def[cond] nIDEM_a_def[cond] nIDEM_b_def[cond]
+
+text\<open>nIDEM-a and nIDEM-b are dual to each other.\<close>
+lemma nIDEM_dual1: "nIDEM\<^sup>a \<phi> = nIDEM\<^sup>b \<phi>\<^sup>d" unfolding cond by (metis BA_cp BA_dn op_dual_def setequ_ext)
+lemma nIDEM_dual2: "nIDEM\<^sup>b \<phi> = nIDEM\<^sup>a \<phi>\<^sup>d" by (simp add: dual_invol nIDEM_dual1)
+
+lemma nIDEM_char: "nIDEM \<phi> = (nIDEM\<^sup>a \<phi> \<and> nIDEM\<^sup>b \<phi>)" unfolding cond setequ_char by blast
+lemma nIDEM_dual: "nIDEM \<phi> = nIDEM \<phi>\<^sup>d" using nIDEM_char nIDEM_dual1 nIDEM_dual2 by blast
+
+text\<open>nIDEM(a/b) and IDEM(a/b) are the 'complements' each other.\<close>
+lemma nIDEM_a_compl: "IDEM\<^sup>a \<phi> = nIDEM\<^sup>a \<phi>\<^sup>-" by (metis (no_types, lifting) BA_cp IDEM_a_def nIDEM_a_def sfun_compl_invol svfun_compl_def)
+lemma nIDEM_b_compl: "IDEM\<^sup>b \<phi> = nIDEM\<^sup>b \<phi>\<^sup>-" by (metis IDEM_dual2 dual_compl_char1 dual_compl_char2 nIDEM_a_compl nIDEM_dual2)
+lemma nIDEM_compl: "nIDEM \<phi> = IDEM \<phi>\<^sup>-" by (simp add: IDEM_char nIDEM_a_compl nIDEM_b_compl nIDEM_char sfun_compl_invol)
+
+text\<open>nEXPN (nCNTR) entail nIDEM-a (nIDEM-b).\<close>
+lemma nEXPN_impl_nIDEM_a: "nEXPN \<phi> \<longrightarrow> nIDEM\<^sup>b \<phi>" by (metis nEXPN_def nIDEM_b_def sfun_compl_invol svfun_compl_def)
+lemma nCNTR_impl_nIDEM_b: "nCNTR \<phi> \<longrightarrow> nIDEM\<^sup>a \<phi>" by (simp add: nEXPN_impl_nIDEM_a nEXPN_nCNTR_dual2 nIDEM_dual1)
+
+
+text\<open>Anti-distribution over joins or anti-additivity (nADDI) and its dual.\<close>
+definition nADDI::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("nADDI")
+  where "nADDI \<phi>  \<equiv> \<forall>A B. \<phi>(A \<^bold>\<or> B) \<^bold>= (\<phi> A) \<^bold>\<and> (\<phi> B)" 
+definition nADDI_a::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("nADDI\<^sup>a")
+  where "nADDI\<^sup>a \<phi> \<equiv> \<forall>A B. (\<phi> A) \<^bold>\<and> (\<phi> B) \<^bold>\<le> \<phi>(A \<^bold>\<or> B)" 
+definition nADDI_b::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("nADDI\<^sup>b")
+  where "nADDI\<^sup>b \<phi> \<equiv> \<forall>A B. \<phi>(A \<^bold>\<or> B) \<^bold>\<le> (\<phi> A) \<^bold>\<and> (\<phi> B)"
+
+text\<open>Anti-distribution over meets or anti-multiplicativity (nMULT).\<close>
+definition nMULT::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("nMULT") 
+  where "nMULT \<phi>  \<equiv> \<forall>A B. \<phi>(A \<^bold>\<and> B) \<^bold>= (\<phi> A) \<^bold>\<or> (\<phi> B)" 
+definition nMULT_a::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("nMULT\<^sup>a")
+  where "nMULT\<^sup>a \<phi> \<equiv> \<forall>A B. (\<phi> A) \<^bold>\<or> (\<phi> B) \<^bold>\<le> \<phi>(A \<^bold>\<and> B)"
+definition nMULT_b::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("nMULT\<^sup>b")
+  where "nMULT\<^sup>b \<phi> \<equiv> \<forall>A B. \<phi>(A \<^bold>\<and> B) \<^bold>\<le> (\<phi> A) \<^bold>\<or> (\<phi> B)" 
+
+declare nADDI_def[cond] nADDI_a_def[cond] nADDI_b_def[cond]
+        nMULT_def[cond] nMULT_a_def[cond] nMULT_b_def[cond]
+
+lemma nADDI_char: "nADDI \<phi> = (nADDI\<^sup>a \<phi> \<and> nADDI\<^sup>b \<phi>)" unfolding cond using setequ_char by blast
+lemma nMULT_char: "nMULT \<phi> = (nMULT\<^sup>a \<phi> \<and> nMULT\<^sup>b \<phi>)" unfolding cond using setequ_char by blast
+
+text\<open>ANTI, nMULT-a and nADDI-b are equivalent.\<close>
+lemma ANTI_nMULTa: "nMULT\<^sup>a \<phi> = ANTI \<phi>" unfolding cond by (smt (z3) L10 L7 join_def meet_def setequ_ext subset_def)
+lemma ANTI_nADDIb: "nADDI\<^sup>b \<phi> = ANTI \<phi>" unfolding cond by (smt (verit) BA_cp BA_deMorgan1 L10 L3 L5 L8 L9 setequ_char setequ_ext)
+
+text\<open>Below we prove several duality relationships between nADDI(a/b) and nMULT(a/b).\<close>
+
+text\<open>Duality between nMULT-a and nADDI-b (an easy corollary from the self-duality of ANTI).\<close>
+lemma nMULTa_nADDIb_dual1: "nMULT\<^sup>a \<phi> = nADDI\<^sup>b \<phi>\<^sup>d" using ANTI_nADDIb ANTI_nMULTa ANTI_dual by blast
+lemma nMULTa_nADDIb_dual2: "nADDI\<^sup>b \<phi> = nMULT\<^sup>a \<phi>\<^sup>d" by (simp add: dual_invol nMULTa_nADDIb_dual1)
+text\<open>Duality between nADDI-a and nMULT-b.\<close>
+lemma nADDIa_nMULTb_dual1: "nADDI\<^sup>a \<phi> = nMULT\<^sup>b \<phi>\<^sup>d" unfolding cond by (metis (no_types, lifting) BA_cp BA_deMorgan1 BA_dn op_dual_def setequ_ext)
+lemma nADDIa_nMULTb_dual2: "nMULT\<^sup>b \<phi> = nADDI\<^sup>a \<phi>\<^sup>d" by (simp add: dual_invol nADDIa_nMULTb_dual1)
+text\<open>Duality between ADDI and MULT.\<close>
+lemma nADDI_nMULT_dual1: "nADDI \<phi> = nMULT \<phi>\<^sup>d" using nADDI_char nADDIa_nMULTb_dual1 nMULT_char nMULTa_nADDIb_dual2 by blast
+lemma nADDI_nMULT_dual2: "nMULT \<phi> = nADDI \<phi>\<^sup>d" by (simp add: dual_invol nADDI_nMULT_dual1)
+
+text\<open>nADDI and nMULT are the 'complements' of ADDI and MULT respectively.\<close>
+lemma nADDIa_compl: "ADDI\<^sup>a \<phi> = nADDI\<^sup>a \<phi>\<^sup>-" by (metis ADDI_a_def BA_cp BA_deMorgan1 nADDI_a_def setequ_ext svfun_compl_def)
+lemma nADDIb_compl: "ADDI\<^sup>b \<phi> = nADDI\<^sup>b \<phi>\<^sup>-" by (simp add: ANTI_nADDIb ANTI_MONO MONO_ADDIb sfun_compl_invol)
+lemma nADDI_compl: "ADDI \<phi> = nADDI \<phi>\<^sup>-" by (simp add: ADDI_char nADDI_char nADDIa_compl nADDIb_compl)
+lemma nMULTa_compl: "MULT\<^sup>a \<phi> = nMULT\<^sup>a \<phi>\<^sup>-" by (simp add: ANTI_MONO ANTI_nMULTa MONO_MULTa sfun_compl_invol)
+lemma nMULTb_compl: "MULT\<^sup>b \<phi> = nMULT\<^sup>b \<phi>\<^sup>-" by (metis BA_cp BA_deMorgan2 MULT_b_def nMULT_b_def setequ_ext svfun_compl_def)
+lemma nMULT_compl: "MULT \<phi> = nMULT \<phi>\<^sup>-" by (simp add: MULT_char nMULT_char nMULTa_compl nMULTb_compl)
+
+
+text\<open>We verify properties regarding closure over meets/joins for fixed-points.\<close>
+
+text\<open>nMULT for an operator implies join-closedness of the set of fixed-points of its dual-complement.\<close>
+lemma nMULT_joinclosed: "nMULT \<phi> \<Longrightarrow> join_closed (fp (\<phi>\<^sup>d\<^sup>-))" by (smt (verit, del_insts) ADDI_MULT_dual2 ADDI_joinclosed BA_deMorgan1 MULT_def dual_compl_char2 nMULT_def setequ_ext svfun_compl_def)
+lemma "join_closed (fp (\<phi>\<^sup>d\<^sup>-)) \<Longrightarrow> nMULT \<phi>" nitpick oops \<comment>\<open> countermodel found: needs further assumptions \<close>
+lemma joinclosed_nMULT: "ANTI \<phi> \<Longrightarrow> nCNTR \<phi> \<Longrightarrow> nIDEM\<^sup>b \<phi> \<Longrightarrow> join_closed (fp (\<phi>\<^sup>d\<^sup>-)) \<Longrightarrow> nMULT \<phi>" by (metis ANTI_MONO ANTI_dual IDEM_char IDEM_dual dual_compl_char1 dual_compl_char2 joinclosed_ADDI nADDI_compl nADDI_nMULT_dual2 nCNTR_impl_nIDEM_b nEXPN_CNTR_compl nEXPN_nCNTR_dual2 nIDEM_char nIDEM_compl sfun_compl_invol)
+
+text\<open>nADDI for an operator implies meet-closedness of the set of fixed-points of its dual-complement.\<close>
+lemma nADDI_meetclosed: "nADDI \<phi> \<Longrightarrow> meet_closed (fp (\<phi>\<^sup>d\<^sup>-))" by (smt (verit, ccfv_threshold) ADDI_MULT_dual1 ADDI_def BA_deMorgan2 MULT_meetclosed dual_compl_char2 nADDI_def setequ_ext svfun_compl_def)
+lemma "meet_closed (fp (\<phi>\<^sup>d\<^sup>-)) \<Longrightarrow> nADDI \<phi>" nitpick oops \<comment>\<open> countermodel found: needs further assumptions \<close>
+lemma meetclosed_nADDI: "ANTI \<phi> \<Longrightarrow> nEXPN \<phi> \<Longrightarrow> nIDEM\<^sup>a \<phi> \<Longrightarrow> meet_closed (fp (\<phi>\<^sup>d\<^sup>-)) \<Longrightarrow> nADDI \<phi>" by (metis ADDI_MULT_dual2 ADDI_joinclosed ANTI_MONO ANTI_dual dual_compl_char1 dual_compl_char2 joinclosed_nMULT meetclosed_MULT nADDI_nMULT_dual1 nCNTR_EXPN_compl nEXPN_nCNTR_dual1 nIDEM_b_compl nIDEM_dual1 sfun_compl_invol)
+
+text\<open>Assuming ANTI, we have that nEXPN (nCNTR) implies meet-closed (join-closed) for the set of fixed-points.\<close>
+lemma nEXPN_meetclosed: "ANTI \<phi> \<Longrightarrow> nEXPN \<phi> \<Longrightarrow> meet_closed (fp \<phi>)" by (metis (full_types) L10 compl_def fixpoints_def meet_closed_def nEXPN_def setequ_ext subset_def)
+lemma nCNTR_joinclosed: "ANTI \<phi> \<Longrightarrow> nCNTR \<phi> \<Longrightarrow> join_closed (fp \<phi>)" by (smt (verit, ccfv_threshold) BA_impl L9 fixpoints_def impl_char join_closed_def nCNTR_def setequ_char setequ_ext)
+
+end
diff --git a/thys/Topological_Semantics/conditions_negative_infinitary.thy b/thys/Topological_Semantics/conditions_negative_infinitary.thy
new file mode 100644
--- /dev/null
+++ b/thys/Topological_Semantics/conditions_negative_infinitary.thy
@@ -0,0 +1,96 @@
+theory conditions_negative_infinitary
+  imports conditions_negative conditions_positive_infinitary
+begin
+
+subsection \<open>Infinitary Negative Conditions\<close>
+
+text\<open>We define and interrelate infinitary variants for some previously introduced
+ axiomatic conditions on operators.\<close>
+
+text\<open>Anti-distribution over infinite joins (suprema) or infinite anti-additivity (inADDI).\<close>
+definition inADDI::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("inADDI")
+  where "inADDI \<phi>  \<equiv> \<forall>S. \<phi>(\<^bold>\<Or>S) \<^bold>= \<^bold>\<And>\<lbrakk>\<phi> S\<rbrakk>" 
+definition inADDI_a::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("inADDI\<^sup>a")
+  where "inADDI\<^sup>a \<phi> \<equiv> \<forall>S. \<^bold>\<And>\<lbrakk>\<phi> S\<rbrakk> \<^bold>\<le> \<phi>(\<^bold>\<Or>S)  " 
+definition inADDI_b::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("inADDI\<^sup>b")
+  where "inADDI\<^sup>b \<phi> \<equiv> \<forall>S. \<phi>(\<^bold>\<Or>S) \<^bold>\<le> \<^bold>\<And>\<lbrakk>\<phi> S\<rbrakk>"
+
+text\<open>Anti-distribution over infinite meets (infima) or infinite anti-multiplicativity (inMULT).\<close>
+definition inMULT::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("inMULT")
+  where "inMULT \<phi>  \<equiv> \<forall>S. \<phi>(\<^bold>\<And>S) \<^bold>= \<^bold>\<Or>\<lbrakk>\<phi> S\<rbrakk>" 
+definition inMULT_a::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("inMULT\<^sup>a")
+  where "inMULT\<^sup>a \<phi> \<equiv> \<forall>S. \<^bold>\<Or>\<lbrakk>\<phi> S\<rbrakk> \<^bold>\<le> \<phi>(\<^bold>\<And>S)"
+definition inMULT_b::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("inMULT\<^sup>b")
+  where "inMULT\<^sup>b \<phi> \<equiv> \<forall>S. \<phi>(\<^bold>\<And>S) \<^bold>\<le> \<^bold>\<Or>\<lbrakk>\<phi> S\<rbrakk>"
+
+declare inADDI_def[cond] inADDI_a_def[cond] inADDI_b_def[cond]
+        inMULT_def[cond] inMULT_a_def[cond] inMULT_b_def[cond]
+
+lemma inADDI_char: "inADDI \<phi> = (inADDI\<^sup>a \<phi> \<and> inADDI\<^sup>b \<phi>)" unfolding cond using setequ_char by blast
+lemma inMULT_char: "inMULT \<phi> = (inMULT\<^sup>a \<phi> \<and> inMULT\<^sup>b \<phi>)" unfolding cond using setequ_char by blast
+
+text\<open>nADDI-b and inADDI-b are in fact equivalent.\<close>
+lemma inADDIb_equ: "inADDI\<^sup>b \<phi> = nADDI\<^sup>b \<phi>" proof -
+  have lr: "inADDI\<^sup>b \<phi> \<Longrightarrow> nADDI\<^sup>b \<phi>" proof - (*prove as a one-liner by instantiating inADDI_b_def with S=(\<lambda>Z. Z=A \<or> Z=B)*)
+  assume inaddib: "inADDI\<^sup>b \<phi>"
+  { fix A::"'a \<sigma>" and B::"'a \<sigma>" (* for some reason Isabelle doesn't like other letters as type variable. Why?*)
+    let ?S="\<lambda>Z. Z=A \<or> Z=B"
+    have "\<^bold>\<Or>?S = A \<^bold>\<or> B" unfolding supremum_def join_def by blast
+    hence p1: "\<phi>(\<^bold>\<Or>?S) = \<phi>(A \<^bold>\<or> B)" by simp
+    have "\<lbrakk>\<phi> ?S\<rbrakk> = (\<lambda>Z. Z=(\<phi> A) \<or> Z=(\<phi> B))" unfolding image_def by metis
+    hence p2: "\<^bold>\<And>\<lbrakk>\<phi> ?S\<rbrakk> = (\<phi> A) \<^bold>\<and> (\<phi> B)" unfolding infimum_def meet_def by auto
+    have "\<phi>(\<^bold>\<Or>?S) \<^bold>\<le> \<^bold>\<And>\<lbrakk>\<phi> ?S\<rbrakk>" using inaddib inADDI_b_def by blast
+    hence "\<phi>(A \<^bold>\<or> B) \<^bold>\<le> (\<phi> A) \<^bold>\<and> (\<phi> B)" using p1 p2 by simp
+  } thus ?thesis by (simp add: nADDI_b_def) qed
+  have rl: "nADDI\<^sup>b \<phi> \<Longrightarrow> inADDI\<^sup>b \<phi>" unfolding inADDI_b_def ANTI_nADDIb ANTI_def image_def
+    by (smt (verit) glb_def inf_glb lower_bounds_def lub_def sup_lub upper_bounds_def)
+  from lr rl show ?thesis by auto
+qed
+text\<open>nMULT-a and inMULT-a are also equivalent.\<close>
+lemma inMULTa_equ: "inMULT\<^sup>a \<phi> = nMULT\<^sup>a \<phi>" proof -
+  have lr: "inMULT\<^sup>a \<phi> \<Longrightarrow> nMULT\<^sup>a \<phi>" proof - (*prove as a one-liner by instantiating inMULT_a_def with S=(\<lambda>Z. Z=A \<or> Z=B)*)
+  assume inmulta: "inMULT\<^sup>a \<phi>"
+  { fix A::"'a \<sigma>" and B::"'a \<sigma>"
+    let ?S="\<lambda>Z. Z=A \<or> Z=B"
+    have "\<^bold>\<And>?S = A \<^bold>\<and> B" unfolding infimum_def meet_def by blast
+    hence p1: "\<phi>(\<^bold>\<And>?S) = \<phi>(A \<^bold>\<and> B)" by simp
+    have "\<lbrakk>\<phi> ?S\<rbrakk> = (\<lambda>Z. Z=(\<phi> A) \<or> Z=(\<phi> B))" unfolding image_def by metis
+    hence p2: "\<^bold>\<Or>\<lbrakk>\<phi> ?S\<rbrakk> = (\<phi> A) \<^bold>\<or> (\<phi> B)" unfolding supremum_def join_def by auto
+    have "\<^bold>\<Or>\<lbrakk>\<phi> ?S\<rbrakk> \<^bold>\<le> \<phi>(\<^bold>\<And>?S)" using inmulta inMULT_a_def by blast    
+    hence "(\<phi> A) \<^bold>\<or> (\<phi> B) \<^bold>\<le> \<phi>(A \<^bold>\<and> B)" using p1 p2 by simp
+  } thus ?thesis by (simp add: nMULT_a_def) qed
+  have rl: "nMULT\<^sup>a \<phi> \<Longrightarrow> inMULT\<^sup>a \<phi>" unfolding inMULT_a_def ANTI_nMULTa ANTI_def image_def
+    by (smt (verit) glb_def inf_glb lower_bounds_def lub_def sup_lub upper_bounds_def)
+  from lr rl show ?thesis by blast
+qed
+
+text\<open>Thus we have that ANTI, nADDI-b/inADDI-b and nMULT-a/inMULT-a are all equivalent.\<close>
+lemma ANTI_inADDIb: "inADDI\<^sup>b \<phi> = ANTI \<phi>" unfolding ANTI_nADDIb inADDIb_equ by simp
+lemma ANTI_inMULTa: "inMULT\<^sup>a \<phi> = ANTI \<phi>" unfolding ANTI_nMULTa inMULTa_equ by simp
+
+
+text\<open>Below we prove several duality relationships between inADDI(a/b) and inMULT(a/b).\<close>
+
+text\<open>Duality between inMULT-a and inADDI-b (an easy corollary from the previous equivalence).\<close>
+lemma inMULTa_inADDIb_dual1: "inMULT\<^sup>a \<phi> = inADDI\<^sup>b \<phi>\<^sup>d" by (simp add: nMULTa_nADDIb_dual1 inADDIb_equ inMULTa_equ)
+lemma inMULTa_inADDIb_dual2: "inADDI\<^sup>b \<phi> = inMULT\<^sup>a \<phi>\<^sup>d" by (simp add: nMULTa_nADDIb_dual2 inADDIb_equ inMULTa_equ)
+text\<open>Duality between inADDI-a and inMULT-b.\<close>
+lemma inADDIa_inMULTb_dual1: "inADDI\<^sup>a \<phi> = inMULT\<^sup>b \<phi>\<^sup>d" by (smt (z3) BA_cmpl_equ BA_cp dualcompl_invol inADDI_a_def iDM_a inMULT_b_def im_prop1 op_dual_def setequ_ext)
+lemma inADDIa_inMULTb_dual2: "inMULT\<^sup>b \<phi> = inADDI\<^sup>a \<phi>\<^sup>d" by (simp add: dual_invol inADDIa_inMULTb_dual1)
+text\<open>Duality between inADDI and inMULT.\<close>
+lemma inADDI_inMULT_dual1: "inADDI \<phi> = inMULT \<phi>\<^sup>d" using inADDI_char inADDIa_inMULTb_dual1 inMULT_char inMULTa_inADDIb_dual2 by blast
+lemma inADDI_inMULT_dual2: "inMULT \<phi> = inADDI \<phi>\<^sup>d" by (simp add: dual_invol inADDI_inMULT_dual1)
+
+text\<open>inADDI and inMULT are the 'complements' of iADDI and iMULT respectively.\<close>
+lemma inADDIa_compl: "iADDI\<^sup>a \<phi> = inADDI\<^sup>a \<phi>\<^sup>-" by (metis BA_cmpl_equ BA_cp iADDI_a_def iDM_a im_prop2 inADDI_a_def setequ_ext svfun_compl_def)
+lemma inADDIb_compl: "iADDI\<^sup>b \<phi> = inADDI\<^sup>b \<phi>\<^sup>-" by (simp add: ANTI_MONO ANTI_inADDIb MONO_iADDIb)
+lemma inADDI_compl: "iADDI \<phi> = inADDI \<phi>\<^sup>-" by (simp add: iADDI_char inADDI_char inADDIa_compl inADDIb_compl)
+lemma inMULTa_compl: "iMULT\<^sup>a \<phi> = inMULT\<^sup>a \<phi>\<^sup>-" by (simp add: ANTI_MONO ANTI_inMULTa MONO_iMULTa)
+lemma inMULTb_compl: "iMULT\<^sup>b \<phi> = inMULT\<^sup>b \<phi>\<^sup>-" by (metis dual_compl_char1 dual_compl_char2 iADDIa_iMULTb_dual2 inADDIa_compl inADDIa_inMULTb_dual2)
+lemma inMULT_compl: "iMULT \<phi> = inMULT \<phi>\<^sup>-" by (simp add: iMULT_char inMULT_char inMULTa_compl inMULTb_compl)
+
+text\<open>In fact, infinite anti-additivity (anti-multiplicativity) entails (dual) anti-normality:\<close>
+lemma inADDI_nNORM: "inADDI \<phi> \<longrightarrow> nNORM \<phi>" by (metis bottom_def inADDI_def inf_empty image_def nNORM_def setequ_ext sup_empty)
+lemma inMULT_nDNRM: "inMULT \<phi> \<longrightarrow> nDNRM \<phi>" by (simp add: inADDI_inMULT_dual2 inADDI_nNORM nNOR_dual2)
+
+end
diff --git a/thys/Topological_Semantics/conditions_positive.thy b/thys/Topological_Semantics/conditions_positive.thy
new file mode 100644
--- /dev/null
+++ b/thys/Topological_Semantics/conditions_positive.thy
@@ -0,0 +1,140 @@
+theory conditions_positive
+  imports boolean_algebra_operators
+begin
+
+section \<open>Topological Conditions\<close>
+
+text\<open>We define and interrelate some useful axiomatic conditions on unary operations (operators) 
+having a 'w-parametric type ('w)\<sigma>\<Rightarrow>('w)\<sigma>.
+Boolean algebras extended with such operators give us different sorts of topological Boolean algebras.\<close>
+
+subsection \<open>Positive Conditions\<close>
+
+text\<open>Monotonicity (MONO).\<close>
+definition MONO::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("MONO")
+  where "MONO \<phi> \<equiv> \<forall>A B. A \<^bold>\<le> B \<longrightarrow> \<phi> A \<^bold>\<le> \<phi> B"
+
+named_theorems cond (*to group together axiomatic conditions*)
+declare MONO_def[cond]
+
+text\<open>MONO is self-dual.\<close>
+lemma MONO_dual: "MONO \<phi> = MONO \<phi>\<^sup>d" by (smt (verit) BA_cp MONO_def dual_invol op_dual_def)
+
+
+text\<open>Expansive/extensive (EXPN) and its dual contractive (CNTR).\<close>
+definition EXPN::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("EXPN")
+  where "EXPN \<phi>  \<equiv> \<forall>A. A \<^bold>\<le> \<phi> A"
+definition CNTR::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("CNTR")
+  where "CNTR \<phi> \<equiv> \<forall>A. \<phi> A \<^bold>\<le> A"
+
+declare EXPN_def[cond] CNTR_def[cond]
+
+text\<open>EXPN and CNTR are dual to each other.\<close>
+lemma EXPN_CNTR_dual1: "EXPN \<phi> = CNTR \<phi>\<^sup>d" unfolding cond by (metis BA_cp BA_dn op_dual_def setequ_ext)
+lemma EXPN_CNTR_dual2: "CNTR \<phi> = EXPN \<phi>\<^sup>d" by (simp add: EXPN_CNTR_dual1 dual_invol)
+
+
+text\<open>Normality (NORM) and its dual (DNRM).\<close>
+definition NORM::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("NORM")
+  where "NORM \<phi>  \<equiv> (\<phi> \<^bold>\<bottom>) \<^bold>= \<^bold>\<bottom>"
+definition DNRM::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("DNRM")
+  where "DNRM \<phi> \<equiv> (\<phi> \<^bold>\<top>) \<^bold>= \<^bold>\<top>" 
+
+declare NORM_def[cond] DNRM_def[cond]
+
+text\<open>NORM and DNRM are dual to each other.\<close>
+lemma NOR_dual1: "NORM \<phi> = DNRM \<phi>\<^sup>d" unfolding cond by (simp add: bottom_def compl_def op_dual_def setequ_def top_def)
+lemma NOR_dual2: "DNRM \<phi> = NORM \<phi>\<^sup>d" by (simp add: NOR_dual1 dual_invol) 
+
+text\<open>EXPN (CNTR) entails DNRM (NORM).\<close>
+lemma EXPN_impl_DNRM: "EXPN \<phi> \<longrightarrow> DNRM \<phi>" unfolding cond by (simp add: setequ_def subset_def top_def)
+lemma CNTR_impl_NORM: "CNTR \<phi> \<longrightarrow> NORM \<phi>" by (simp add: EXPN_CNTR_dual2 EXPN_impl_DNRM NOR_dual1 dual_invol)
+
+
+text\<open>Idempotence (IDEM).\<close>
+definition IDEM::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("IDEM") 
+  where "IDEM \<phi>  \<equiv> \<forall>A. \<phi>(\<phi> A) \<^bold>= (\<phi> A)"
+definition IDEM_a::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("IDEM\<^sup>a") 
+  where "IDEM\<^sup>a \<phi> \<equiv> \<forall>A. \<phi>(\<phi> A) \<^bold>\<le> (\<phi> A)"
+definition IDEM_b::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("IDEM\<^sup>b") 
+  where "IDEM\<^sup>b \<phi> \<equiv> \<forall>A.  (\<phi> A) \<^bold>\<le> \<phi>(\<phi> A)"
+
+declare IDEM_def[cond] IDEM_a_def[cond] IDEM_b_def[cond]
+
+text\<open>IDEM-a and IDEM-b are dual to each other.\<close>
+lemma IDEM_dual1: "IDEM\<^sup>a \<phi> = IDEM\<^sup>b \<phi>\<^sup>d" unfolding cond by (metis (mono_tags, opaque_lifting) BA_cp BA_dn op_dual_def setequ_ext)
+lemma IDEM_dual2: "IDEM\<^sup>b \<phi> = IDEM\<^sup>a \<phi>\<^sup>d" by (simp add: IDEM_dual1 dual_invol)
+
+lemma IDEM_char: "IDEM \<phi> = (IDEM\<^sup>a \<phi> \<and> IDEM\<^sup>b \<phi>)" unfolding cond setequ_char by blast
+lemma IDEM_dual: "IDEM \<phi> = IDEM \<phi>\<^sup>d" using IDEM_char IDEM_dual1 IDEM_dual2 by blast
+
+
+text\<open>EXPN (CNTR) entail IDEM-b (IDEM-a).\<close>
+lemma EXPN_impl_IDEM_b: "EXPN \<phi> \<longrightarrow> IDEM\<^sup>b \<phi>" by (simp add: EXPN_def IDEM_b_def)
+lemma CNTR_impl_IDEM_a: "CNTR \<phi> \<longrightarrow> IDEM\<^sup>a \<phi>" by (simp add: CNTR_def IDEM_a_def)
+
+text\<open>Moreover, IDEM has some other interesting characterizations. For example, via function composition:\<close>
+lemma IDEM_fun_comp_char: "IDEM \<phi> = (\<phi> = \<phi> \<circ> \<phi>)" unfolding cond fun_comp_def by (metis setequ_ext)
+text\<open>Or having the property of collapsing the range and the set of fixed-points of an operator:\<close>
+lemma IDEM_range_fp_char: "IDEM \<phi> = (\<lbrakk>\<phi> _\<rbrakk> = fp \<phi>)" unfolding cond range_def fixpoints_def by (metis setequ_ext)
+
+text\<open>Distribution over joins or additivity (ADDI).\<close>
+definition ADDI::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("ADDI")
+  where "ADDI \<phi>   \<equiv> \<forall>A B. \<phi>(A \<^bold>\<or> B) \<^bold>= (\<phi> A) \<^bold>\<or> (\<phi> B)" 
+definition ADDI_a::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("ADDI\<^sup>a")
+  where "ADDI\<^sup>a \<phi> \<equiv> \<forall>A B. \<phi>(A \<^bold>\<or> B) \<^bold>\<le> (\<phi> A) \<^bold>\<or> (\<phi> B)"
+definition ADDI_b::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("ADDI\<^sup>b")
+  where "ADDI\<^sup>b \<phi> \<equiv> \<forall>A B.  (\<phi> A) \<^bold>\<or> (\<phi> B) \<^bold>\<le> \<phi>(A \<^bold>\<or> B)" 
+
+text\<open>Distribution over meets or multiplicativity (MULT).\<close>
+definition MULT::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("MULT") 
+  where "MULT \<phi>   \<equiv> \<forall>A B. \<phi>(A \<^bold>\<and> B) \<^bold>= (\<phi> A) \<^bold>\<and> (\<phi> B)" 
+definition MULT_a::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("MULT\<^sup>a")
+  where "MULT\<^sup>a \<phi> \<equiv> \<forall>A B. \<phi>(A \<^bold>\<and> B) \<^bold>\<le> (\<phi> A) \<^bold>\<and> (\<phi> B)" 
+definition MULT_b::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("MULT\<^sup>b")
+  where "MULT\<^sup>b \<phi> \<equiv> \<forall>A B. (\<phi> A) \<^bold>\<and> (\<phi> B) \<^bold>\<le> \<phi>(A \<^bold>\<and> B)"
+
+declare ADDI_def[cond] ADDI_a_def[cond] ADDI_b_def[cond]
+        MULT_def[cond] MULT_a_def[cond] MULT_b_def[cond]
+
+lemma ADDI_char: "ADDI \<phi> = (ADDI\<^sup>a \<phi> \<and> ADDI\<^sup>b \<phi>)" unfolding cond using setequ_char by blast
+lemma MULT_char: "MULT \<phi> = (MULT\<^sup>a \<phi> \<and> MULT\<^sup>b \<phi>)" unfolding cond using setequ_char by blast
+
+text\<open>MONO, MULT-a and ADDI-b are equivalent.\<close>
+lemma MONO_MULTa: "MULT\<^sup>a \<phi> = MONO \<phi>" unfolding cond by (metis L10 L3 L4 L5 L8 setequ_char setequ_ext)
+lemma MONO_ADDIb: "ADDI\<^sup>b \<phi> = MONO \<phi>" unfolding cond by (metis (mono_tags, lifting) L7 L9 join_def setequ_ext subset_def)
+
+text\<open>Below we prove several duality relationships between ADDI(a/b) and MULT(a/b).\<close>
+
+text\<open>Duality between MULT-a and ADDI-b (an easy corollary from the self-duality of MONO).\<close>
+lemma MULTa_ADDIb_dual1: "MULT\<^sup>a \<phi> = ADDI\<^sup>b \<phi>\<^sup>d" by (metis MONO_ADDIb MONO_MULTa MONO_dual)
+lemma MULTa_ADDIb_dual2: "ADDI\<^sup>b \<phi> = MULT\<^sup>a \<phi>\<^sup>d" by (simp add: MULTa_ADDIb_dual1 dual_invol)
+text\<open>Duality between ADDI-a and MULT-b.\<close>
+lemma ADDIa_MULTb_dual1: "ADDI\<^sup>a \<phi> = MULT\<^sup>b \<phi>\<^sup>d" unfolding cond op_dual_def by (metis BA_cp BA_deMorgan1 BA_dn setequ_ext)
+lemma ADDIa_MULTb_dual2: "MULT\<^sup>b \<phi> = ADDI\<^sup>a \<phi>\<^sup>d" by (simp add: ADDIa_MULTb_dual1 dual_invol)
+text\<open>Duality between ADDI and MULT.\<close>
+lemma ADDI_MULT_dual1: "ADDI \<phi> = MULT \<phi>\<^sup>d" using ADDI_char ADDIa_MULTb_dual1 MULT_char MULTa_ADDIb_dual2 by blast
+lemma ADDI_MULT_dual2: "MULT \<phi> = ADDI \<phi>\<^sup>d" by (simp add: ADDI_MULT_dual1 dual_invol)
+
+
+text\<open>We verify properties regarding closure over meets/joins for fixed-points.\<close>
+
+text\<open>MULT implies meet-closedness of the set of fixed-points (the converse requires additional assumptions).\<close>
+lemma MULT_meetclosed: "MULT \<phi> \<Longrightarrow> meet_closed (fp \<phi>)" by (simp add: MULT_def fixpoints_def meet_closed_def setequ_ext)
+lemma "meet_closed (fp \<phi>) \<Longrightarrow> MULT \<phi>" nitpick oops \<comment>\<open> countermodel found: needs further assumptions. \<close>
+lemma meetclosed_MULT: "MONO \<phi> \<Longrightarrow> CNTR \<phi> \<Longrightarrow> IDEM\<^sup>b \<phi> \<Longrightarrow> meet_closed (fp \<phi>) \<Longrightarrow> MULT \<phi>" by (smt (z3) CNTR_def IDEM_b_def MONO_MULTa MONO_def MULT_a_def MULT_def fixpoints_def meet_closed_def meet_def setequ_char setequ_ext subset_def)
+
+text\<open>ADDI implies join-closedness of the set of fixed-points (the converse requires additional assumptions).\<close>
+lemma ADDI_joinclosed: "ADDI \<phi> \<Longrightarrow> join_closed (fp \<phi>)" by (simp add: ADDI_def fixpoints_def join_closed_def setequ_ext)
+lemma "join_closed (fp \<phi>) \<Longrightarrow> ADDI \<phi>" nitpick oops \<comment>\<open> countermodel found: needs further assumptions \<close>
+lemma joinclosed_ADDI: "MONO \<phi> \<Longrightarrow> EXPN \<phi> \<Longrightarrow> IDEM\<^sup>a \<phi> \<Longrightarrow> join_closed (fp \<phi>) \<Longrightarrow> ADDI \<phi>" by (smt (verit, ccfv_threshold) ADDI_MULT_dual1 BA_deMorgan2 EXPN_CNTR_dual1 IDEM_dual1 MONO_dual fp_dual join_closed_def meet_closed_def meetclosed_MULT sdfun_dcompl_def setequ_ext)
+
+text\<open>Assuming MONO, we have that EXPN (CNTR) implies meet-closed (join-closed) for the set of fixed-points.\<close>
+lemma EXPN_meetclosed: "MONO \<phi> \<Longrightarrow> EXPN \<phi> \<Longrightarrow> meet_closed (fp \<phi>)" by (smt (verit) EXPN_def MONO_MULTa MULT_a_def fixpoints_def meet_closed_def setequ_char setequ_ext)
+lemma CNTR_joinclosed: "MONO \<phi> \<Longrightarrow> CNTR \<phi> \<Longrightarrow> join_closed (fp \<phi>)" by (smt (verit, best) ADDI_b_def CNTR_def MONO_ADDIb fixpoints_def join_closed_def setequ_char setequ_ext)
+
+text\<open>Further assuming IDEM the above results can be stated to the whole range of an operator.\<close>
+lemma "MONO \<phi> \<Longrightarrow> EXPN \<phi> \<Longrightarrow> IDEM \<phi> \<Longrightarrow> meet_closed (\<lbrakk>\<phi> _\<rbrakk>)" by (simp add: EXPN_meetclosed IDEM_range_fp_char)
+lemma "MONO \<phi> \<Longrightarrow> CNTR \<phi> \<Longrightarrow> IDEM \<phi> \<Longrightarrow> join_closed (\<lbrakk>\<phi> _\<rbrakk>)" by (simp add: CNTR_joinclosed IDEM_range_fp_char) 
+
+end
diff --git a/thys/Topological_Semantics/conditions_positive_infinitary.thy b/thys/Topological_Semantics/conditions_positive_infinitary.thy
new file mode 100644
--- /dev/null
+++ b/thys/Topological_Semantics/conditions_positive_infinitary.thy
@@ -0,0 +1,248 @@
+theory conditions_positive_infinitary
+  imports conditions_positive boolean_algebra_infinitary
+begin
+
+subsection \<open>Infinitary Positive Conditions\<close>
+
+text\<open>We define and interrelate infinitary variants for some previously introduced
+ axiomatic conditions on operators.\<close>
+
+text\<open>Distribution over infinite joins (suprema) or infinite additivity (iADDI).\<close>
+definition iADDI::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("iADDI")
+  where "iADDI \<phi>   \<equiv> \<forall>S. \<phi>(\<^bold>\<Or>S) \<^bold>= \<^bold>\<Or>\<lbrakk>\<phi> S\<rbrakk>" 
+definition iADDI_a::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("iADDI\<^sup>a")
+  where "iADDI\<^sup>a \<phi> \<equiv> \<forall>S. \<phi>(\<^bold>\<Or>S) \<^bold>\<le> \<^bold>\<Or>\<lbrakk>\<phi> S\<rbrakk>" 
+definition iADDI_b::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("iADDI\<^sup>b")
+  where "iADDI\<^sup>b \<phi> \<equiv> \<forall>S. \<^bold>\<Or>\<lbrakk>\<phi> S\<rbrakk> \<^bold>\<le> \<phi>(\<^bold>\<Or>S)"
+text\<open>Distribution over infinite meets (infima) or infinite multiplicativity (iMULT).\<close>
+definition iMULT::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("iMULT")
+  where "iMULT \<phi>   \<equiv> \<forall>S. \<phi>(\<^bold>\<And>S) \<^bold>= \<^bold>\<And>\<lbrakk>\<phi> S\<rbrakk>" 
+definition iMULT_a::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("iMULT\<^sup>a")
+  where "iMULT\<^sup>a \<phi> \<equiv> \<forall>S. \<phi>(\<^bold>\<And>S) \<^bold>\<le> \<^bold>\<And>\<lbrakk>\<phi> S\<rbrakk>"
+definition iMULT_b::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("iMULT\<^sup>b")
+  where "iMULT\<^sup>b \<phi> \<equiv> \<forall>S. \<^bold>\<And>\<lbrakk>\<phi> S\<rbrakk> \<^bold>\<le> \<phi>(\<^bold>\<And>S)"
+
+declare iADDI_def[cond] iADDI_a_def[cond] iADDI_b_def[cond]
+        iMULT_def[cond] iMULT_a_def[cond] iMULT_b_def[cond]
+
+lemma iADDI_char: "iADDI \<phi> = (iADDI\<^sup>a \<phi> \<and> iADDI\<^sup>b \<phi>)" unfolding cond using setequ_char by blast
+lemma iMULT_char: "iMULT \<phi> = (iMULT\<^sup>a \<phi> \<and> iMULT\<^sup>b \<phi>)" unfolding cond using setequ_char by blast
+
+text\<open>ADDI-b and iADDI-b are in fact equivalent.\<close>
+lemma iADDIb_equ: "iADDI\<^sup>b \<phi> = ADDI\<^sup>b \<phi>" proof -
+  have lr: "iADDI\<^sup>b \<phi> \<Longrightarrow> ADDI\<^sup>b \<phi>" proof -
+  assume iaddib: "iADDI\<^sup>b \<phi>"
+  { fix A::"'a \<sigma>" and B::"'a \<sigma>" (*Isabelle forces us to use 'a as type variable name*)
+    let ?S="\<lambda>Z. Z=A \<or> Z=B"
+    have "\<^bold>\<Or>?S = A \<^bold>\<or> B" unfolding supremum_def join_def by blast
+    hence p1: "\<phi>(\<^bold>\<Or>?S) = \<phi>(A \<^bold>\<or> B)" by simp
+    have "\<lbrakk>\<phi> ?S\<rbrakk> = (\<lambda>Z. Z=(\<phi> A) \<or> Z=(\<phi> B))" unfolding image_def by metis
+    hence p2: "\<^bold>\<Or>\<lbrakk>\<phi> ?S\<rbrakk> = (\<phi> A) \<^bold>\<or> (\<phi> B)" unfolding supremum_def join_def by auto
+    have " \<^bold>\<Or>\<lbrakk>\<phi> ?S\<rbrakk> \<^bold>\<le> \<phi>(\<^bold>\<Or>?S)" using iaddib iADDI_b_def by blast    
+    hence "(\<phi> A) \<^bold>\<or> (\<phi> B) \<^bold>\<le> \<phi>(A \<^bold>\<or> B)" using p1 p2 by simp
+  } thus ?thesis by (simp add: ADDI_b_def) qed
+  have rl: "ADDI\<^sup>b \<phi> \<Longrightarrow> iADDI\<^sup>b \<phi>" unfolding iADDI_b_def by (smt (verit) MONO_ADDIb MONO_def lub_def image_def sup_lub upper_bounds_def) 
+  from lr rl show ?thesis by auto
+qed
+text\<open>MULT-a and iMULT-a are also equivalent.\<close>
+lemma iMULTa_equ: "iMULT\<^sup>a \<phi> = MULT\<^sup>a \<phi>" proof -
+  have lr: "iMULT\<^sup>a \<phi> \<Longrightarrow> MULT\<^sup>a \<phi>" proof -
+  assume imulta: "iMULT\<^sup>a \<phi>"
+  { fix A::"'a \<sigma>" and B::"'a \<sigma>" (*Isabelle forces us to use 'a as type variable name*)
+    let ?S="\<lambda>Z. Z=A \<or> Z=B"
+    have "\<^bold>\<And>?S = A \<^bold>\<and> B" unfolding infimum_def meet_def by blast
+    hence p1: "\<phi>(\<^bold>\<And>?S) = \<phi>(A \<^bold>\<and> B)" by simp
+    have "\<lbrakk>\<phi> ?S\<rbrakk> = (\<lambda>Z. Z=(\<phi> A) \<or> Z=(\<phi> B))" unfolding image_def by metis
+    hence p2: "\<^bold>\<And>\<lbrakk>\<phi> ?S\<rbrakk> = (\<phi> A) \<^bold>\<and> (\<phi> B)" unfolding infimum_def meet_def by auto
+    have "\<phi>(\<^bold>\<And>?S) \<^bold>\<le> \<^bold>\<And>\<lbrakk>\<phi> ?S\<rbrakk>" using imulta iMULT_a_def by blast    
+    hence "\<phi>(A \<^bold>\<and> B) \<^bold>\<le> (\<phi> A) \<^bold>\<and> (\<phi> B)" using p1 p2 by simp
+  } thus ?thesis by (simp add: MULT_a_def) qed
+  have rl: "MULT\<^sup>a \<phi> \<Longrightarrow> iMULT\<^sup>a \<phi>" by (smt (verit) MONO_MULTa MONO_def glb_def iMULT_a_def inf_glb lower_bounds_def image_def)
+  from lr rl show ?thesis by blast
+qed
+
+text\<open>Thus we have that MONO, ADDI-b/iADDI-b and MULT-a/iMULT-a are all equivalent.\<close>
+lemma MONO_iADDIb: "iADDI\<^sup>b \<phi> = MONO \<phi>" unfolding MONO_ADDIb iADDIb_equ by simp
+lemma MONO_iMULTa: "iMULT\<^sup>a \<phi> = MONO \<phi>" unfolding MONO_MULTa iMULTa_equ by simp
+
+
+text\<open>Below we prove several duality relationships between iADDI(a/b) and iMULT(a/b).\<close>
+
+text\<open>Duality between iMULT-a and iADDI-b (an easy corollary from the previous equivalence).\<close>
+lemma iMULTa_iADDIb_dual1: "iMULT\<^sup>a \<phi> = iADDI\<^sup>b \<phi>\<^sup>d" by (simp add: MULTa_ADDIb_dual1 iADDIb_equ iMULTa_equ)
+lemma iMULTa_iADDIb_dual2: "iADDI\<^sup>b \<phi> = iMULT\<^sup>a \<phi>\<^sup>d" by (simp add: MULTa_ADDIb_dual2 iADDIb_equ iMULTa_equ)
+text\<open>Duality between iADDI-a and iMULT-b.\<close>
+lemma iADDIa_iMULTb_dual1: "iADDI\<^sup>a \<phi> = iMULT\<^sup>b \<phi>\<^sup>d" by (smt (z3) BA_cmpl_equ BA_cp dualcompl_invol iADDI_a_def iDM_a iMULT_b_def im_prop1 op_dual_def setequ_ext)
+lemma iADDIa_iMULTb_dual2: "iMULT\<^sup>b \<phi> = iADDI\<^sup>a \<phi>\<^sup>d" by (simp add: dual_invol iADDIa_iMULTb_dual1)
+text\<open>Duality between iADDI and iMULT.\<close>
+lemma iADDI_iMULT_dual1: "iADDI \<phi> = iMULT \<phi>\<^sup>d" using iADDI_char iADDIa_iMULTb_dual1 iMULT_char iMULTa_iADDIb_dual2 by blast
+lemma iADDI_iMULT_dual2: "iMULT \<phi> = iADDI \<phi>\<^sup>d" by (simp add: dual_invol iADDI_iMULT_dual1)
+
+text\<open>In fact, infinite additivity (multiplicativity) entails (dual) normality:\<close>
+lemma iADDI_NORM: "iADDI \<phi> \<longrightarrow> NORM \<phi>" unfolding cond by (metis bottom_def image_def setequ_ext sup_empty)
+lemma iMULT_DNRM: "iMULT \<phi> \<longrightarrow> DNRM \<phi>" by (simp add: NOR_dual2 iADDI_NORM iADDI_iMULT_dual2)
+
+text\<open>Suitable conditions on an operation can make the set of its fixed-points closed under infinite meets/joins.\<close>
+
+lemma fp_sup_closed_cond1: "iADDI \<phi> \<longrightarrow> supremum_closed (fp \<phi>)" unfolding cond order supremum_closed_def fixpoints_def image_def by (smt (verit) supremum_def)
+lemma fp_sup_closed_cond2: "iADDI\<^sup>a \<phi> \<and> EXPN \<phi> \<longrightarrow> supremum_closed (fp \<phi>)" unfolding cond by (smt (z3) fixpoints_def image_def setequ_char subset_def supremum_closed_def supremum_def)
+lemma fp_sup_closed_cond3: "MONO \<phi> \<and> CNTR \<phi> \<longrightarrow> supremum_closed (fp \<phi>)" unfolding cond by (smt (verit, del_insts) fixpoints_def lub_def setequ_char setequ_ext subset_def sup_lub supremum_closed_def upper_bounds_def)
+
+lemma fp_inf_closed_cond1: "iMULT \<phi> \<longrightarrow> infimum_closed (fp \<phi>)" by (metis fp_dual fp_sup_closed_cond1 iADDI_iMULT_dual2 inf_sup_closed_dc)
+lemma fp_inf_closed_cond2: "iMULT\<^sup>b \<phi> \<and> CNTR \<phi> \<longrightarrow> infimum_closed (fp \<phi>)" by (metis EXPN_CNTR_dual2 fp_dual fp_sup_closed_cond2 iADDIa_iMULTb_dual2 inf_sup_closed_dc)
+lemma fp_inf_closed_cond3: "MONO \<phi> \<and> EXPN \<phi> \<longrightarrow> infimum_closed (fp \<phi>)" by (metis EXPN_CNTR_dual1 MONO_dual fp_dual fp_sup_closed_cond3 inf_sup_closed_dc)
+
+text\<open>OTOH, the converse conjectures have (finite) countermodels. They need additional assumptions.\<close>
+lemma "infimum_closed (fp \<phi>) \<longrightarrow> iMULT \<phi>" nitpick oops \<comment>\<open> countermodel found: needs further assumptions \<close>
+lemma "supremum_closed (fp \<phi>) \<longrightarrow> iADDI \<phi>" nitpick oops \<comment>\<open> countermodel found: needs further assumptions \<close>
+lemma fp_inf_closed_iMULT: "MONO \<phi> \<Longrightarrow> CNTR \<phi> \<Longrightarrow> IDEM\<^sup>b \<phi> \<Longrightarrow> infimum_closed (fp \<phi>) \<longrightarrow> iMULT \<phi>"
+proof -
+assume mono: "MONO \<phi>" and cntr: "CNTR \<phi>" and idem:"IDEM\<^sup>b \<phi>" {
+  assume ic:"infimum_closed (fp \<phi>)" {
+    fix S
+    from ic have "\<forall>D. D \<^bold>\<le> (fp \<phi>) \<longrightarrow> (fp \<phi>)(\<^bold>\<And>D)" unfolding infimum_closed_def by simp
+    hence "let D=\<lbrakk>\<phi> S\<rbrakk> in (\<forall>X. D X \<longrightarrow> (X \<^bold>= \<phi> X)) \<longrightarrow> \<^bold>\<And>D \<^bold>= \<phi> \<^bold>\<And>D" by (simp add: fixpoints_def setequ_ext subset_def) 
+    moreover from idem have "(\<forall>X. \<lbrakk>\<phi> S\<rbrakk> X \<longrightarrow> (X \<^bold>= \<phi> X))" by (metis (mono_tags, lifting) CNTR_def IDEM_b_def cntr image_def setequ_char)
+    ultimately have aux: "\<^bold>\<And>(\<lbrakk>\<phi> S\<rbrakk>) \<^bold>= \<phi>(\<^bold>\<And>\<lbrakk>\<phi> S\<rbrakk>)" by meson
+    from cntr have "\<^bold>\<And>\<lbrakk>\<phi> S\<rbrakk> \<^bold>\<le> \<^bold>\<And>S" by (smt (verit, best) CNTR_def image_def infimum_def subset_def)
+    hence "\<phi>(\<^bold>\<And>\<lbrakk>\<phi> S\<rbrakk>) \<^bold>\<le> \<phi>(\<^bold>\<And>S)" using mono by (simp add: MONO_def) 
+    from this aux have "\<^bold>\<And>\<lbrakk>\<phi> S\<rbrakk> \<^bold>\<le> \<phi>(\<^bold>\<And>S)" by (simp add: setequ_ext)
+  } hence "infimum_closed (fp \<phi>) \<longrightarrow> iMULT \<phi>" by (simp add: MONO_iMULTa iMULT_b_def iMULT_char mono)
+} thus ?thesis by simp 
+qed
+lemma fp_sup_closed_iADDI: "MONO \<phi> \<Longrightarrow> EXPN \<phi> \<Longrightarrow> IDEM\<^sup>a \<phi> \<Longrightarrow> supremum_closed (fp \<phi>) \<longrightarrow> iADDI \<phi>" 
+  (* by (metis EXPN_CNTR_dual1 IDEM_dual2 MONO_dual dual_invol fp_inf_closed_iMULT fp_inf_sup_closed_dual iADDI_iMULT_dual1) *)
+proof -
+assume mono: "MONO \<phi>" and expn: "EXPN \<phi>" and idem:"IDEM\<^sup>a \<phi>" {
+  assume sc:"supremum_closed (fp \<phi>)" {
+    fix S
+    from sc have "\<forall>D. D \<^bold>\<le> (fp \<phi>) \<longrightarrow> (fp \<phi>)(\<^bold>\<Or>D)" unfolding supremum_closed_def by simp
+    hence "let D=\<lbrakk>\<phi> S\<rbrakk> in (\<forall>X. D X \<longrightarrow> (X \<^bold>= \<phi> X)) \<longrightarrow> \<^bold>\<Or>D \<^bold>= \<phi> \<^bold>\<Or>D" by (simp add: fixpoints_def setequ_ext subset_def)
+    moreover have "(\<forall>X. \<lbrakk>\<phi> S\<rbrakk> X \<longrightarrow> (X \<^bold>= \<phi> X))" by (metis (mono_tags, lifting) EXPN_def IDEM_a_def expn idem image_def setequ_char)
+    ultimately have aux: "\<^bold>\<Or>(\<lbrakk>\<phi> S\<rbrakk>) \<^bold>= \<phi>(\<^bold>\<Or>\<lbrakk>\<phi> S\<rbrakk>)" by meson
+    have "\<^bold>\<Or>S \<^bold>\<le> \<^bold>\<Or>\<lbrakk>\<phi> S\<rbrakk>" by (metis EXPN_CNTR_dual1 EXPN_def IDEM_dual1 MONO_dual dual_invol expn fp_inf_closed_iMULT fp_inf_sup_closed_dual iADDI_def iADDI_iMULT_dual1 idem mono sc setequ_ext)
+    hence "\<phi>(\<^bold>\<Or>S) \<^bold>\<le> \<phi>(\<^bold>\<Or>\<lbrakk>\<phi> S\<rbrakk>)" using mono by (simp add: MONO_def) 
+    from this aux have "\<phi>(\<^bold>\<Or>S) \<^bold>\<le> \<^bold>\<Or>\<lbrakk>\<phi> S\<rbrakk>" by (metis setequ_ext)
+  } hence "supremum_closed (fp \<phi>) \<longrightarrow> iADDI \<phi>" by (simp add: MONO_ADDIb iADDI_a_def iADDI_char iADDIb_equ mono)
+} thus ?thesis by simp
+qed
+
+section \<open>Alexandrov topologies and (generalized) specialization preorders\<close>
+
+text\<open>A topology is called 'Alexandrov' (after the Russian mathematician Pavel Alexandrov) if the intersection
+(resp. union) of any (finite or infinite) family of open (resp. closed) sets is open (resp. closed);
+in algebraic terms, this means that the set of fixed points of the interior (closure) operation is closed
+under infinite meets (joins). Another common algebraic formulation requires the closure (interior) operation
+to satisfy the infinitary variants of additivity (multiplicativity), i.e. iADDI (iMULT) as introduced before.
+
+In the literature, the well-known Kuratowski conditions for the closure (resp. interior) operation are assumed,
+namely: ADDI, EXPN, NORM, IDEM (resp. MULT, CNTR, DNRM, IDEM). This makes both formulations equivalent.
+However, this is not the case in general if those conditions become negotiable.\<close>
+
+text\<open>Alexandrov topologies have interesting properties relating them to the semantics of modal logic.
+Assuming Kuratowski conditions, Alexandrov topological operations defined on subsets of S are in one-to-one
+correspondence with preorders on S; in topological terms, Alexandrov topologies are uniquely determined by
+their specialization preorders. Since we do not presuppose any Kuratowski conditions to begin with, the
+preorders in question are in general not even transitive. Here we just call them 'reachability relations'.
+We will still call (generalized) closure/interior-like operations as such (for lack of a better name).
+We explore minimal conditions under which some relevant results for the semantics of modal logic obtain.\<close>
+
+text\<open>Closure/interior(-like) operators can be derived from an arbitrary relation (as in modal logic).\<close>
+definition Cl_rel::"('w \<Rightarrow> 'w \<Rightarrow> bool) \<Rightarrow> ('w \<sigma> \<Rightarrow> 'w \<sigma>)" ("\<C>[_]") 
+  where "\<C>[R] \<equiv> \<lambda>A. \<lambda>w. \<exists>v. R w v \<and> A v"
+definition Int_rel::"('w \<Rightarrow> 'w \<Rightarrow> bool) \<Rightarrow> ('w \<sigma> \<Rightarrow> 'w \<sigma>)" ("\<I>[_]") 
+  where "\<I>[R] \<equiv> \<lambda>A. \<lambda>w. \<forall>v. R w v \<longrightarrow> A v"
+
+text\<open>Duality between interior and closure follows directly:\<close>
+lemma dual_CI: "\<C>[R] = \<I>[R]\<^sup>d" by (simp add: Cl_rel_def Int_rel_def compl_def op_dual_def setequ_char)
+
+text\<open>We explore minimal conditions of the reachability relation under which some operation's conditions obtain.\<close> 
+text\<open>Define some relevant properties of relations: \<close>
+abbreviation "serial R  \<equiv> \<forall>x. \<exists>y. R x y"
+abbreviation "reflexive R  \<equiv> \<forall>x. R x x"
+abbreviation "transitive R \<equiv> \<forall>x y z. R x y \<and> R y z \<longrightarrow> R x z"
+abbreviation "antisymmetric R  \<equiv> \<forall>x y. R x y \<and> R y x \<longrightarrow> x = y"
+abbreviation "symmetric R  \<equiv> \<forall>x y. R x y \<longrightarrow> R y x"
+
+lemma rC1: "iADDI \<C>[R]" unfolding iADDI_def Cl_rel_def image_def supremum_def using setequ_def by fastforce
+lemma rC2: "reflexive R = EXPN \<C>[R]" by (metis (full_types) CNTR_def EXPN_CNTR_dual2 Int_rel_def dual_CI subset_def)
+lemma rC3: "NORM \<C>[R]" by (simp add: iADDI_NORM rC1)
+lemma rC4: "transitive R = IDEM\<^sup>a \<C>[R]" proof -
+  have l2r: "transitive R \<longrightarrow> IDEM\<^sup>a \<C>[R]"  by (smt (verit, best) Cl_rel_def IDEM_a_def subset_def)
+  have r2l: "IDEM\<^sup>a \<C>[R] \<longrightarrow> transitive R" unfolding Cl_rel_def IDEM_a_def subset_def using compl_def by force
+  from l2r r2l show ?thesis by blast
+qed
+
+
+text\<open>A reachability (specialization) relation (preorder) can be derived from a given operation (intended as a closure-like operation).\<close>
+definition \<R>::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> ('w \<Rightarrow> 'w \<Rightarrow> bool)" ("\<R>[_]") 
+  where "\<R>[\<phi>] \<equiv> \<lambda>w v. \<phi> (\<lambda>x. x = v) w"
+
+text\<open>Preorder properties of the reachability relation follow from the corresponding operation's conditions.\<close>
+lemma rel_refl: "EXPN \<phi> \<longrightarrow> reflexive \<R>[\<phi>]" by (simp add: EXPN_def \<R>_def subset_def)
+lemma rel_trans: "MONO \<phi> \<and> IDEM\<^sup>a \<phi> \<longrightarrow> transitive \<R>[\<phi>]" by (smt (verit, best) IDEM_a_def MONO_def \<R>_def subset_def)
+lemma "IDEM\<^sup>a \<phi> \<longrightarrow> transitive \<R>[\<phi>]" nitpick oops \<comment>\<open> counterexample \<close>
+
+(*The converse directions do not hold*)
+lemma "reflexive \<R>[\<phi>] \<longrightarrow> EXPN \<phi>" nitpick oops \<comment>\<open> counterexample \<close>
+lemma "transitive \<R>[\<phi>] \<longrightarrow> IDEM\<^sup>a \<phi>" nitpick oops \<comment>\<open> counterexample \<close>
+lemma "transitive \<R>[\<phi>] \<longrightarrow> MONO \<phi>" nitpick oops \<comment>\<open> counterexample \<close>
+
+text\<open>However, we can obtain finite countermodels for antisymmetry and symmetry given all relevant conditions.
+We will revisit this issue later and examine their relation with the topological separation axioms T0 and T1 resp.\<close>
+lemma "iADDI \<phi> \<Longrightarrow> EXPN \<phi> \<Longrightarrow> IDEM\<^sup>a \<phi> \<Longrightarrow> antisymmetric \<R>[\<phi>]" nitpick oops \<comment>\<open> counterexample \<close>
+lemma "iADDI \<phi> \<Longrightarrow> EXPN \<phi> \<Longrightarrow> IDEM\<^sup>a \<phi> \<Longrightarrow> symmetric \<R>[\<phi>]" nitpick oops \<comment>\<open> counterexample \<close>
+
+text\<open>As mentioned previously, Alexandrov closure (and by duality interior) operations correspond to 
+specialization orderings (reachability relations).
+It is worth mentioning that in Alexandrov topologies every point has a minimal/smallest neighborhood,
+namely the set of points related to it by the specialization preorder (reachability relation).
+We examine below  minimal conditions under which these relations obtain.\<close>
+
+lemma Cl_rel'_a:   "MONO \<phi> \<longrightarrow> (\<forall>A. \<C>[\<R>[\<phi>]] A \<^bold>\<le> \<phi> A)" unfolding Cl_rel_def MONO_def \<R>_def by (smt (verit, ccfv_SIG) subset_def)
+lemma Cl_rel'_b: "iADDI\<^sup>a \<phi> \<longrightarrow> (\<forall>A. \<phi> A \<^bold>\<le> \<C>[\<R>[\<phi>]] A)" proof -
+{ assume iaddia: "iADDI\<^sup>a \<phi>"
+  { fix A::"'a \<sigma>"
+    let ?S="\<lambda>B. \<exists>w. A w \<and> B=(\<lambda>u. u=w)"
+    have "A \<^bold>= (\<^bold>\<Or>?S)" unfolding supremum_def setequ_def by auto
+    hence "\<phi>(A) \<^bold>= \<phi>(\<^bold>\<Or>?S)" by (simp add: setequ_ext)
+    moreover have "\<^bold>\<Or>\<lbrakk>\<phi> ?S\<rbrakk> \<^bold>= \<C>[\<R>[\<phi>]] A" by (smt (verit) Cl_rel_def \<R>_def image_def setequ_def supremum_def)
+    moreover from iaddia have "\<phi>(\<^bold>\<Or>?S) \<^bold>\<le> \<^bold>\<Or>\<lbrakk>\<phi> ?S\<rbrakk>" unfolding iADDI_a_def by simp
+    ultimately have "\<phi> A \<^bold>\<le> \<C>[\<R>[\<phi>]] A" by (simp add: setequ_ext)
+} } thus ?thesis by simp
+qed
+lemma Cl_rel': "iADDI \<phi> \<longrightarrow> \<phi> \<^bold>=\<^sup>: \<C>[\<R>[\<phi>]]" by (simp add: MONO_iADDIb iADDI_char setequ_char Cl_rel'_a Cl_rel'_b svfun_equ_def)
+lemma Cl_rel: "iADDI \<phi> \<longleftrightarrow> \<phi> = \<C>[\<R>[\<phi>]]" using Cl_rel' by (metis rC1 svfun_equ_ext)
+
+text\<open>It is instructive to expand the definitions in the above result:\<close>
+lemma "iADDI \<phi> \<longleftrightarrow> (\<forall>A. \<forall>w. (\<phi> A) w \<longleftrightarrow> (\<exists>v. A v \<and> \<phi> (\<lambda>x. x=v) w))" oops
+
+text\<open>Closure (interior) operations derived from relations are thus closed under infinite joins (meets).\<close>
+lemma "supremum_closed (fp \<C>[R])" by (simp add: fp_sup_closed_cond1 rC1)
+lemma "infimum_closed  (fp \<I>[R])" by (metis dual_CI fp_inf_closed_cond1 iADDI_iMULT_dual2 rC1)
+
+
+text\<open>We can now revisit the relationship between (anti)symmetry and the separation axioms T1 and T0.\<close>
+
+text\<open>T0: any two distinct points in the space can be separated by a closed (or open) set (i.e. containing one point and not the other).\<close>
+abbreviation "T0 \<C> \<equiv> (\<forall>p q. p \<noteq> q \<longrightarrow> (\<exists>G. (fp \<C>) G \<and> \<not>(G p \<longleftrightarrow> G q)))"
+text\<open>T1: any two distinct points can be separated by (two not necessarily disjoint) closed (or open) sets.\<close>
+abbreviation "T1 \<C> \<equiv> (\<forall>p q. p \<noteq> q \<longrightarrow> (\<exists>G H. (fp \<C>) G \<and> (fp \<C>) H \<and> G p \<and> \<not>G q \<and> H q \<and> \<not>H p))"
+
+text\<open>We can (sanity) check that T1 entails T0 but not viceversa.\<close>
+lemma "T1 \<C> \<Longrightarrow> T0 \<C>" by meson
+lemma "T0 \<C> \<Longrightarrow> T1 \<C>" nitpick oops \<comment>\<open> counterexample \<close>
+
+
+text\<open>Under appropriate conditions, T0-separation corresponds to antisymmetry of the specialization relation (here an ordering).\<close>
+lemma "T0 \<C> \<longleftrightarrow> antisymmetric \<R>[\<C>]" nitpick oops (*counterexample*)
+lemma T0_antisymm_a: "MONO \<C> \<Longrightarrow> T0 \<C> \<longrightarrow> antisymmetric \<R>[\<C>]" by (smt (verit, best) Cl_rel'_a Cl_rel_def fixpoints_def setequ_ext subset_def)
+lemma T0_antisymm_b: "EXPN \<C> \<Longrightarrow> IDEM\<^sup>a \<C> \<Longrightarrow> antisymmetric \<R>[\<C>] \<longrightarrow> T0 \<C>" by (metis EXPN_impl_IDEM_b IDEM_char IDEM_def \<R>_def fixpoints_def rel_refl)
+lemma T0_antisymm: "MONO \<C> \<Longrightarrow> EXPN \<C> \<Longrightarrow> IDEM\<^sup>a \<C> \<Longrightarrow> T0 \<C> = antisymmetric \<R>[\<C>]" using T0_antisymm_a T0_antisymm_b by fastforce
+
+text\<open>Also, under the appropriate conditions, T1-separation corresponds to symmetry of the specialization relation.\<close>
+lemma T1_symm_a: "MONO \<C> \<Longrightarrow> T1 \<C> \<longrightarrow> symmetric \<R>[\<C>]" by (metis (mono_tags, opaque_lifting) Cl_rel'_a Cl_rel_def fixpoints_def setequ_ext subset_def)
+lemma T1_symm_b: "MONO \<C> \<Longrightarrow> EXPN \<C> \<Longrightarrow> T0 \<C> \<Longrightarrow> symmetric \<R>[\<C>] \<longrightarrow> T1 \<C>" by (smt (verit, ccfv_SIG) T0_antisymm_a \<R>_def fixpoints_def rel_refl setequ_def)
+lemma T1_symm: "MONO \<C> \<Longrightarrow> EXPN \<C> \<Longrightarrow> T0 \<C> \<Longrightarrow> symmetric \<R>[\<C>] = T1 \<C>" using T1_symm_a T1_symm_b by (smt (verit, ccfv_threshold))
+
+end
diff --git a/thys/Topological_Semantics/conditions_relativized.thy b/thys/Topological_Semantics/conditions_relativized.thy
new file mode 100644
--- /dev/null
+++ b/thys/Topological_Semantics/conditions_relativized.thy
@@ -0,0 +1,284 @@
+theory conditions_relativized
+  imports conditions_negative
+begin
+
+subsection \<open>Relativized Conditions\<close>
+
+text\<open>We continue defining and interrelating axiomatic conditions on unary operations (operators). 
+ This time we consider their 'relativized' variants.\<close>
+
+text\<open>Relativized order and equality relations.\<close>
+definition subset_in::\<open>'p \<sigma> \<Rightarrow> 'p \<sigma> \<Rightarrow> 'p \<sigma> \<Rightarrow> bool\<close> ("_\<^bold>\<le>\<^sub>__") 
+  where \<open>A \<^bold>\<le>\<^sub>U B \<equiv> \<forall>x. U x \<longrightarrow> (A x \<longrightarrow> B x)\<close>
+definition subset_out::\<open>'p \<sigma> \<Rightarrow> 'p \<sigma> \<Rightarrow> 'p \<sigma> \<Rightarrow> bool\<close> ("_\<^bold>\<le>\<^sup>__") 
+  where \<open>A \<^bold>\<le>\<^sup>U B \<equiv> \<forall>x. \<not>U x \<longrightarrow> (A x \<longrightarrow> B x)\<close>
+definition setequ_in::\<open>'p \<sigma> \<Rightarrow> 'p \<sigma> \<Rightarrow> 'p \<sigma> \<Rightarrow> bool\<close> ("_\<^bold>=\<^sub>__") 
+  where \<open>A \<^bold>=\<^sub>U B \<equiv> \<forall>x. U x \<longrightarrow> (A x \<longleftrightarrow> B x)\<close>
+definition setequ_out::\<open>'p \<sigma> \<Rightarrow> 'p \<sigma> \<Rightarrow> 'p \<sigma> \<Rightarrow> bool\<close> ("_\<^bold>=\<^sup>__") 
+  where \<open>A \<^bold>=\<^sup>U B \<equiv> \<forall>x. \<not>U x \<longrightarrow> (A x \<longleftrightarrow> B x)\<close>
+
+declare subset_in_def[order] subset_out_def[order] setequ_in_def[order] setequ_out_def[order]
+
+lemma subset_in_out: "(let U=C in (A \<^bold>\<le>\<^sub>U B)) = (let U=\<^bold>\<midarrow>C in (A \<^bold>\<le>\<^sup>U B))" by (simp add: compl_def subset_in_def subset_out_def)
+lemma setequ_in_out: "(let U=C in (A \<^bold>=\<^sub>U B)) = (let U=\<^bold>\<midarrow>C in (A \<^bold>=\<^sup>U B))" by (simp add: compl_def setequ_in_def setequ_out_def)
+
+lemma subset_in_char: "(A \<^bold>\<le>\<^sub>U B) = (U \<^bold>\<and> A \<^bold>\<le> U \<^bold>\<and> B)" unfolding order conn by blast
+lemma subset_out_char: "(A \<^bold>\<le>\<^sup>U B) = (U \<^bold>\<or> A \<^bold>\<le> U \<^bold>\<or> B)" unfolding order conn by blast
+lemma setequ_in_char: "(A \<^bold>=\<^sub>U B) = (U \<^bold>\<and> A \<^bold>= U \<^bold>\<and> B)" unfolding order conn by blast
+lemma setequ_out_char: "(A \<^bold>=\<^sup>U B) = (U \<^bold>\<or> A \<^bold>= U \<^bold>\<or> B)" unfolding order conn by blast
+
+text\<open>Relativization cannot be meaningfully applied to conditions (n)NORM or (n)DNRM.\<close>
+lemma "NORM \<phi>  = (let U = \<^bold>\<top> in ((\<phi> \<^bold>\<bottom>) \<^bold>=\<^sub>U \<^bold>\<bottom>))" by (simp add: NORM_def setequ_def setequ_in_def top_def)
+lemma "(let U = \<^bold>\<bottom> in ((\<phi> \<^bold>\<bottom>) \<^bold>=\<^sub>U \<^bold>\<bottom>))" by (simp add: bottom_def setequ_in_def)
+
+text\<open>Relativization ('in' resp. 'out') leaves (n)EXPN/(n)CNTR unchanged or trivializes them.\<close>
+lemma "EXPN \<phi>  = (\<forall>A. A \<^bold>\<le>\<^sub>A \<phi> A)" by (simp add: EXPN_def subset_def subset_in_def)
+lemma "CNTR \<phi>  = (\<forall>A. (\<phi> A) \<^bold>\<le>\<^sup>A A)" by (metis (mono_tags, lifting) CNTR_def subset_def subset_out_def)
+lemma "\<forall>A. A \<^bold>\<le>\<^sup>A \<phi> A" by (simp add: subset_out_def)
+lemma "\<forall>A. (\<phi> A) \<^bold>\<le>\<^sub>A A" by (simp add: subset_in_def)
+
+
+text\<open>Relativized ADDI variants.\<close>
+definition ADDIr::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("ADDIr")
+  where "ADDIr \<phi>  \<equiv> \<forall>A B. let U = (A \<^bold>\<or> B) in      (\<phi>(A \<^bold>\<or> B) \<^bold>=\<^sup>U (\<phi> A) \<^bold>\<or> (\<phi> B))"
+definition ADDIr_a::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("ADDIr\<^sup>a")
+  where "ADDIr\<^sup>a \<phi> \<equiv> \<forall>A B. let U = (A \<^bold>\<or> B) in      (\<phi>(A \<^bold>\<or> B) \<^bold>\<le>\<^sup>U (\<phi> A) \<^bold>\<or> (\<phi> B))" 
+definition ADDIr_b::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("ADDIr\<^sup>b")
+  where "ADDIr\<^sup>b \<phi> \<equiv> \<forall>A B. let U = (A \<^bold>\<or> B) in ((\<phi> A) \<^bold>\<or> (\<phi> B) \<^bold>\<le>\<^sup>U \<phi>(A \<^bold>\<or> B))"
+ 
+declare ADDIr_def[cond] ADDIr_a_def[cond] ADDIr_b_def[cond]
+
+lemma ADDIr_char: "ADDIr \<phi> = (ADDIr\<^sup>a \<phi> \<and> ADDIr\<^sup>b \<phi>)" unfolding cond by (meson setequ_char setequ_out_char subset_out_char)
+
+lemma ADDIr_a_impl: "ADDI\<^sup>a \<phi> \<longrightarrow> ADDIr\<^sup>a \<phi>" by (simp add: ADDI_a_def ADDIr_a_def subset_def subset_out_def)
+lemma ADDIr_a_equ:  "EXPN \<phi> \<Longrightarrow> ADDIr\<^sup>a \<phi> = ADDI\<^sup>a \<phi>" unfolding cond by (smt (verit, del_insts) join_def subset_def subset_out_def)
+lemma ADDIr_a_equ':"nEXPN \<phi> \<Longrightarrow> ADDIr\<^sup>a \<phi> = ADDI\<^sup>a \<phi>" unfolding cond by (smt (verit, ccfv_threshold) compl_def subset_def subset_out_def)
+
+lemma ADDIr_b_impl: "ADDI\<^sup>b \<phi> \<longrightarrow> ADDIr\<^sup>b \<phi>" by (simp add: ADDI_b_def ADDIr_b_def subset_def subset_out_def)
+lemma "nEXPN \<phi> \<Longrightarrow> ADDIr\<^sup>b \<phi> \<longrightarrow> ADDI\<^sup>b \<phi>" nitpick oops \<comment>\<open> countermodel \<close>
+lemma ADDIr_b_equ: "EXPN \<phi> \<Longrightarrow> ADDIr\<^sup>b \<phi> = ADDI\<^sup>b \<phi>" unfolding cond by (smt (z3) subset_def subset_out_def)
+
+
+text\<open>Relativized MULT variants.\<close>
+definition MULTr::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("MULTr")
+  where "MULTr \<phi>  \<equiv> \<forall>A B. let U = (A \<^bold>\<and> B) in      (\<phi>(A \<^bold>\<and> B) \<^bold>=\<^sub>U (\<phi> A) \<^bold>\<and> (\<phi> B))"
+definition MULTr_a::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("MULTr\<^sup>a")
+  where "MULTr\<^sup>a \<phi> \<equiv> \<forall>A B. let U = (A \<^bold>\<and> B) in      (\<phi>(A \<^bold>\<and> B) \<^bold>\<le>\<^sub>U (\<phi> A) \<^bold>\<and> (\<phi> B))"
+definition MULTr_b::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("MULTr\<^sup>b")
+  where "MULTr\<^sup>b \<phi> \<equiv> \<forall>A B. let U = (A \<^bold>\<and> B) in ((\<phi> A) \<^bold>\<and> (\<phi> B) \<^bold>\<le>\<^sub>U \<phi>(A \<^bold>\<and> B))"
+
+declare MULTr_def[cond] MULTr_a_def[cond] MULTr_b_def[cond]
+
+lemma MULTr_char: "MULTr \<phi> = (MULTr\<^sup>a \<phi> \<and> MULTr\<^sup>b \<phi>)" unfolding cond by (meson setequ_char setequ_in_char subset_in_char)
+
+lemma MULTr_a_impl: "MULT\<^sup>a \<phi> \<longrightarrow> MULTr\<^sup>a \<phi>" by (simp add: MULT_a_def MULTr_a_def subset_def subset_in_def)
+lemma "nCNTR \<phi> \<Longrightarrow> MULTr\<^sup>a \<phi> \<longrightarrow> MULT\<^sup>a \<phi>" nitpick oops \<comment>\<open> countermodel \<close>
+lemma MULTr_a_equ: "CNTR \<phi> \<Longrightarrow> MULTr\<^sup>a \<phi> = MULT\<^sup>a \<phi>" unfolding cond by (smt (verit, del_insts) subset_def subset_in_def)
+
+lemma MULTr_b_impl: "MULT\<^sup>b \<phi> \<longrightarrow> MULTr\<^sup>b \<phi>" by (simp add: MULT_b_def MULTr_b_def subset_def subset_in_def)
+lemma "MULTr\<^sup>b \<phi> \<longrightarrow> MULT\<^sup>b \<phi>" nitpick oops \<comment>\<open> countermodel \<close>
+lemma MULTr_b_equ:  "CNTR \<phi> \<Longrightarrow> MULTr\<^sup>b \<phi> = MULT\<^sup>b \<phi>" unfolding cond by (smt (verit, del_insts) meet_def subset_def subset_in_def)
+lemma MULTr_b_equ':"nCNTR \<phi> \<Longrightarrow> MULTr\<^sup>b \<phi> = MULT\<^sup>b \<phi>" unfolding cond by (smt (z3) compl_def subset_def subset_in_def)
+
+text\<open>Weak variants of monotonicity.\<close>
+definition MONOw1::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("MONOw\<^sup>1") 
+  where "MONOw\<^sup>1 \<phi> \<equiv> \<forall>A B. A \<^bold>\<le> B \<longrightarrow> (\<phi> A) \<^bold>\<le> B \<^bold>\<or> (\<phi> B)"
+definition MONOw2::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("MONOw\<^sup>2")
+  where "MONOw\<^sup>2 \<phi> \<equiv> \<forall>A B. A \<^bold>\<le> B \<longrightarrow> A \<^bold>\<and> (\<phi> A) \<^bold>\<le> (\<phi> B)"
+
+declare MONOw1_def[cond] MONOw2_def[cond]
+
+lemma MONOw1_ADDIr_b: "MONOw\<^sup>1 \<phi> = ADDIr\<^sup>b \<phi>" proof -
+  have l2r: "MONOw\<^sup>1 \<phi> \<longrightarrow> ADDIr\<^sup>b \<phi>"  unfolding cond subset_out_char by (metis (mono_tags, opaque_lifting) L7 join_def subset_def) 
+  have r2l: "ADDIr\<^sup>b \<phi> \<longrightarrow> MONOw\<^sup>1 \<phi>" unfolding cond subset_out_char by (metis (full_types) L9 join_def setequ_ext subset_def)
+  show ?thesis using l2r r2l by blast
+qed
+lemma MONOw2_MULTr_a: "MONOw\<^sup>2 \<phi> = MULTr\<^sup>a \<phi>" proof -
+  have l2r: "MONOw\<^sup>2 \<phi> \<longrightarrow> MULTr\<^sup>a \<phi>" unfolding cond subset_in_char by (meson L4 L5 L8 L9)
+  have r2l:"MULTr\<^sup>a \<phi> \<longrightarrow> MONOw\<^sup>2 \<phi>" unfolding cond subset_in_char by (metis BA_distr1 L2 L5 L6 L9 setequ_ext)
+  show ?thesis using l2r r2l by blast
+qed
+
+lemma MONOw1_impl: "MONO \<phi> \<longrightarrow> MONOw\<^sup>1 \<phi>" by (simp add: ADDIr_b_impl MONO_ADDIb MONOw1_ADDIr_b)
+lemma "MONOw\<^sup>1 \<phi> \<longrightarrow> MONO \<phi>" nitpick oops \<comment>\<open> countermodel \<close>
+lemma MONOw2_impl: "MONO \<phi> \<longrightarrow> MONOw\<^sup>2 \<phi>" by (simp add: MONO_MULTa MONOw2_MULTr_a MULTr_a_impl)
+lemma "MONOw\<^sup>2 \<phi> \<longrightarrow> MONO \<phi>" nitpick oops \<comment>\<open> countermodel \<close>
+
+
+text\<open>We have in fact that (n)CNTR (resp. (n)EXPN) implies MONOw-1/ADDIr-b (resp. MONOw-2/MULTr-a).\<close>
+lemma CNTR_MONOw1_impl: "CNTR \<phi> \<longrightarrow> MONOw\<^sup>1 \<phi>" by (metis CNTR_def L3 MONOw1_def subset_char1)
+lemma nCNTR_MONOw1_impl: "nCNTR \<phi> \<longrightarrow> MONOw\<^sup>1 \<phi>" by (smt (verit, ccfv_threshold) MONOw1_def compl_def join_def nCNTR_def subset_def)
+lemma EXPN_MONOw2_impl: "EXPN \<phi> \<longrightarrow> MONOw\<^sup>2 \<phi>" by (metis EXPN_def L4 MONOw2_def subset_char1)
+lemma nEXPN_MONOw2_impl: "nEXPN \<phi> \<longrightarrow> MONOw\<^sup>2 \<phi>" by (smt (verit) MONOw2_def compl_def meet_def nEXPN_def subset_def)
+
+text\<open>Relativized nADDI variants.\<close>
+definition nADDIr::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("nADDIr")
+  where "nADDIr \<phi>  \<equiv> \<forall>A B. let U = (A \<^bold>\<or> B) in      (\<phi>(A \<^bold>\<or> B) \<^bold>=\<^sup>U (\<phi> A) \<^bold>\<and> (\<phi> B))"
+definition nADDIr_a::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("nADDIr\<^sup>a")
+  where "nADDIr\<^sup>a \<phi> \<equiv> \<forall>A B. let U = (A \<^bold>\<or> B) in ((\<phi> A) \<^bold>\<and> (\<phi> B) \<^bold>\<le>\<^sup>U \<phi>(A \<^bold>\<or> B))" 
+definition nADDIr_b::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("nADDIr\<^sup>b")
+  where "nADDIr\<^sup>b \<phi> \<equiv> \<forall>A B. let U = (A \<^bold>\<or> B) in      (\<phi>(A \<^bold>\<or> B) \<^bold>\<le>\<^sup>U (\<phi> A) \<^bold>\<and> (\<phi> B))"
+ 
+declare nADDIr_def[cond] nADDIr_a_def[cond] nADDIr_b_def[cond]
+
+lemma nADDIr_char: "nADDIr \<phi> = (nADDIr\<^sup>a \<phi> \<and> nADDIr\<^sup>b \<phi>)" unfolding cond by (meson setequ_char setequ_out_char subset_out_char)
+
+lemma nADDIr_a_impl: "nADDI\<^sup>a \<phi> \<longrightarrow> nADDIr\<^sup>a \<phi>" unfolding cond by (simp add: subset_def subset_out_def)
+lemma "nADDIr\<^sup>a \<phi> \<longrightarrow> nADDI\<^sup>a \<phi>" nitpick oops \<comment>\<open> countermodel \<close>
+lemma nADDIr_a_equ:  "EXPN \<phi> \<Longrightarrow> nADDIr\<^sup>a \<phi> = nADDI\<^sup>a \<phi>" unfolding cond by (smt (z3) subset_def subset_out_def)
+lemma nADDIr_a_equ':"nEXPN \<phi> \<Longrightarrow> nADDIr\<^sup>a \<phi> = nADDI\<^sup>a \<phi>" unfolding cond by (smt (z3) compl_def join_def meet_def subset_def subset_out_def)
+
+lemma nADDIr_b_impl: "nADDI\<^sup>b \<phi> \<longrightarrow> nADDIr\<^sup>b \<phi>" by (simp add: nADDI_b_def nADDIr_b_def subset_def subset_out_def)
+lemma "EXPN \<phi> \<Longrightarrow> nADDIr\<^sup>b \<phi> \<longrightarrow> nADDI\<^sup>b \<phi>" nitpick oops \<comment>\<open> countermodel \<close>
+lemma nADDIr_b_equ: "nEXPN \<phi> \<Longrightarrow> nADDIr\<^sup>b \<phi> = nADDI\<^sup>b \<phi>" unfolding cond by (smt (z3) compl_def subset_def subset_out_def)
+
+
+text\<open>Relativized nMULT variants.\<close>
+definition nMULTr::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("nMULTr")
+  where "nMULTr \<phi>  \<equiv> \<forall>A B. let U = (A \<^bold>\<and> B) in      (\<phi>(A \<^bold>\<and> B) \<^bold>=\<^sub>U (\<phi> A) \<^bold>\<or> (\<phi> B))"
+definition nMULTr_a::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("nMULTr\<^sup>a")
+  where "nMULTr\<^sup>a \<phi> \<equiv> \<forall>A B. let U = (A \<^bold>\<and> B) in ((\<phi> A) \<^bold>\<or> (\<phi> B) \<^bold>\<le>\<^sub>U \<phi>(A \<^bold>\<and> B))"
+definition nMULTr_b::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("nMULTr\<^sup>b")
+  where "nMULTr\<^sup>b \<phi> \<equiv> \<forall>A B. let U = (A \<^bold>\<and> B) in      (\<phi>(A \<^bold>\<and> B) \<^bold>\<le>\<^sub>U (\<phi> A) \<^bold>\<or> (\<phi> B))"
+
+declare nMULTr_def[cond] nMULTr_a_def[cond] nMULTr_b_def[cond]
+
+lemma nMULTr_char: "nMULTr \<phi> = (nMULTr\<^sup>a \<phi> \<and> nMULTr\<^sup>b \<phi>)" unfolding cond by (meson setequ_char setequ_in_char subset_in_char)
+
+lemma nMULTr_a_impl: "nMULT\<^sup>a \<phi> \<longrightarrow> nMULTr\<^sup>a \<phi>" by (simp add: nMULT_a_def nMULTr_a_def subset_def subset_in_def)
+lemma "CNTR \<phi> \<Longrightarrow> nMULTr\<^sup>a \<phi> \<longrightarrow> nMULT\<^sup>a \<phi>" nitpick oops \<comment>\<open> countermodel \<close>
+lemma nMULTr_a_equ: "nCNTR \<phi> \<Longrightarrow> nMULTr\<^sup>a \<phi> = nMULT\<^sup>a \<phi>" unfolding cond by (smt (z3) compl_def subset_def subset_in_def)
+
+lemma nMULTr_b_impl: "nMULT\<^sup>b \<phi> \<longrightarrow> nMULTr\<^sup>b \<phi>" by (simp add: nMULT_b_def nMULTr_b_def subset_def subset_in_def)
+lemma "nMULTr\<^sup>b \<phi> \<longrightarrow> nMULT\<^sup>b \<phi>" nitpick oops \<comment>\<open> countermodel \<close>
+lemma nMULTr_b_equ:  "CNTR \<phi> \<Longrightarrow> nMULTr\<^sup>b \<phi> = nMULT\<^sup>b \<phi>" unfolding cond by (smt (z3) compl_def join_def meet_def subset_def subset_in_def)
+lemma nMULTr_b_equ':"nCNTR \<phi> \<Longrightarrow> nMULTr\<^sup>b \<phi> = nMULT\<^sup>b \<phi>" unfolding cond by (smt (z3) compl_def join_def meet_def subset_def subset_in_def)
+
+
+text\<open>Weak variants of antitonicity.\<close>
+definition ANTIw1::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("ANTIw\<^sup>1") 
+  where "ANTIw\<^sup>1 \<phi> \<equiv> \<forall>A B. A \<^bold>\<le> B \<longrightarrow> (\<phi> B) \<^bold>\<le> B \<^bold>\<or> (\<phi> A)"
+definition ANTIw2::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("ANTIw\<^sup>2")
+  where "ANTIw\<^sup>2 \<phi> \<equiv> \<forall>A B. A \<^bold>\<le> B \<longrightarrow> A \<^bold>\<and> (\<phi> B) \<^bold>\<le> (\<phi> A)"
+
+declare ANTIw1_def[cond] ANTIw2_def[cond]
+
+lemma ANTIw1_nADDIr_b: "ANTIw\<^sup>1 \<phi> = nADDIr\<^sup>b \<phi>" proof -
+  have l2r: "ANTIw\<^sup>1 \<phi> \<longrightarrow> nADDIr\<^sup>b \<phi>" unfolding cond subset_out_char by (smt (verit, ccfv_SIG) BA_distr2 L8 join_def setequ_ext subset_def)
+  have r2l: "nADDIr\<^sup>b \<phi> \<longrightarrow> ANTIw\<^sup>1 \<phi>" unfolding cond subset_out_def by (metis (full_types) L9 join_def meet_def setequ_ext subset_def)
+  show ?thesis using l2r r2l by blast
+qed
+lemma ANTIw2_nMULTr_a: "ANTIw\<^sup>2 \<phi> = nMULTr\<^sup>a \<phi>" proof -
+  have l2r: "ANTIw\<^sup>2 \<phi> \<longrightarrow> nMULTr\<^sup>a \<phi>" unfolding cond subset_in_char by (metis BA_distr1 L3 L4 L5 L7 L8 setequ_ext)
+  have r2l: "nMULTr\<^sup>a \<phi> \<longrightarrow> ANTIw\<^sup>2 \<phi>" unfolding cond subset_in_def by (metis (full_types) L10 join_def meet_def setequ_ext subset_def)
+  show ?thesis using l2r r2l by blast
+qed
+
+lemma "ANTI \<phi> \<longrightarrow> ANTIw\<^sup>1 \<phi>" by (simp add: ANTI_nADDIb ANTIw1_nADDIr_b nADDIr_b_impl)
+lemma "ANTIw\<^sup>1 \<phi> \<longrightarrow> ANTI \<phi>" nitpick oops \<comment>\<open> countermodel \<close>
+lemma "ANTI \<phi> \<longrightarrow> ANTIw\<^sup>2 \<phi>" by (simp add: ANTI_nMULTa ANTIw2_nMULTr_a nMULTr_a_impl)
+lemma "ANTIw\<^sup>2 \<phi> \<longrightarrow> ANTI \<phi>" nitpick oops \<comment>\<open> countermodel \<close>
+
+text\<open>We have in fact that (n)CNTR (resp. (n)EXPN) implies ANTIw-1/nADDIr-b (resp. ANTIw-2/nMULTr-a).\<close>
+lemma CNTR_ANTIw1_impl: "CNTR \<phi> \<longrightarrow> ANTIw\<^sup>1 \<phi>" unfolding cond using L3 subset_char1 by blast
+lemma nCNTR_ANTIw1_impl: "nCNTR \<phi> \<longrightarrow> ANTIw\<^sup>1 \<phi>" unfolding cond by (metis (full_types) compl_def join_def subset_def)
+lemma EXPN_ANTIw2_impl: "EXPN \<phi> \<longrightarrow> ANTIw\<^sup>2 \<phi>" unfolding cond using L4 subset_char1 by blast
+lemma nEXPN_ANTIw2_impl: "nEXPN \<phi> \<longrightarrow> ANTIw\<^sup>2 \<phi>" unfolding cond by (metis (full_types) compl_def meet_def subset_def)
+
+text\<open>Dual interrelations.\<close>
+lemma ADDIr_dual1: "ADDIr\<^sup>a \<phi> = MULTr\<^sup>b \<phi>\<^sup>d" unfolding cond subset_in_char subset_out_char by (smt (z3) BA_cp BA_deMorgan1 BA_dn op_dual_def setequ_ext)
+lemma ADDIr_dual2: "ADDIr\<^sup>b \<phi> = MULTr\<^sup>a \<phi>\<^sup>d" unfolding cond subset_in_char subset_out_char by (smt (verit, ccfv_threshold) BA_cp BA_deMorgan1 BA_dn op_dual_def setequ_ext)
+lemma ADDIr_dual:  "ADDIr \<phi> = MULTr \<phi>\<^sup>d" using ADDIr_char ADDIr_dual1 ADDIr_dual2 MULTr_char by blast
+
+lemma nADDIr_dual1: "nADDIr\<^sup>a \<phi> = nMULTr\<^sup>b \<phi>\<^sup>d" unfolding cond subset_in_char subset_out_char by (smt (verit, del_insts) BA_cp BA_deMorgan1 BA_dn op_dual_def setequ_ext)
+lemma nADDIr_dual2: "nADDIr\<^sup>b \<phi> = nMULTr\<^sup>a \<phi>\<^sup>d" by (smt (z3) BA_deMorgan1 BA_dn compl_def nADDIr_b_def nMULTr_a_def op_dual_def setequ_ext subset_in_def subset_out_def)
+lemma nADDIr_dual: "nADDIr \<phi> = nMULTr \<phi>\<^sup>d" using nADDIr_char nADDIr_dual1 nADDIr_dual2 nMULTr_char by blast
+
+
+text\<open>Complement interrelations.\<close>
+lemma ADDIr_a_cmpl: "ADDIr\<^sup>a \<phi> = nADDIr\<^sup>a \<phi>\<^sup>-" unfolding cond by (smt (verit, del_insts) BA_deMorgan1 compl_def setequ_ext subset_out_def svfun_compl_def)
+lemma ADDIr_b_cmpl: "ADDIr\<^sup>b \<phi> = nADDIr\<^sup>b \<phi>\<^sup>-" unfolding cond by (smt (verit, del_insts) BA_deMorgan1 compl_def setequ_ext subset_out_def svfun_compl_def)
+lemma ADDIr_cmpl: "ADDIr \<phi> = nADDIr \<phi>\<^sup>-" by (simp add: ADDIr_a_cmpl ADDIr_b_cmpl ADDIr_char nADDIr_char)
+lemma MULTr_a_cmpl: "MULTr\<^sup>a \<phi> = nMULTr\<^sup>a \<phi>\<^sup>-" unfolding cond by (smt (verit, del_insts) BA_deMorgan2 compl_def setequ_ext subset_in_def svfun_compl_def)
+lemma MULTr_b_cmpl: "MULTr\<^sup>b \<phi> = nMULTr\<^sup>b \<phi>\<^sup>-" unfolding cond by (smt (verit, ccfv_threshold) BA_deMorgan2 compl_def setequ_ext subset_in_def svfun_compl_def)
+lemma MULTr_cmpl: "MULTr \<phi> = nMULTr \<phi>\<^sup>-" by (simp add: MULTr_a_cmpl MULTr_b_cmpl MULTr_char nMULTr_char)
+
+
+text\<open>Fixed-point interrelations.\<close>
+lemma EXPN_fp:  "EXPN \<phi> = EXPN \<phi>\<^sup>f\<^sup>p" by (simp add: EXPN_def dimpl_def op_fixpoint_def subset_def)
+lemma EXPN_fpc: "EXPN \<phi> = nEXPN \<phi>\<^sup>f\<^sup>p\<^sup>-" using EXPN_fp nEXPN_CNTR_compl by blast
+lemma CNTR_fp:  "CNTR \<phi> = nCNTR \<phi>\<^sup>f\<^sup>p" by (metis EXPN_CNTR_dual1 EXPN_fp dual_compl_char2 dual_invol nCNTR_EXPN_compl ofp_comm_dc1 sfun_compl_invol)
+lemma CNTR_fpc: "CNTR \<phi> = CNTR \<phi>\<^sup>f\<^sup>p\<^sup>-" by (metis CNTR_fp nCNTR_EXPN_compl ofp_comm_compl ofp_invol)
+
+lemma nNORM_fp: "NORM \<phi> = nNORM \<phi>\<^sup>f\<^sup>p" by (metis NORM_def fixpoints_def fp_rel nNORM_def)
+lemma NORM_fpc: "NORM \<phi> = NORM \<phi>\<^sup>f\<^sup>p\<^sup>-" by (simp add: NORM_def bottom_def ofp_fixpoint_compl_def sdiff_def)
+lemma DNRM_fp:  "DNRM \<phi> = DNRM \<phi>\<^sup>f\<^sup>p" by (simp add: DNRM_def dimpl_def op_fixpoint_def top_def)
+lemma DNRM_fpc: "DNRM \<phi> = nDNRM \<phi>\<^sup>f\<^sup>p\<^sup>-" using DNRM_fp nDNRM_DNRM_compl by blast
+
+lemma ADDIr_a_fpc: "ADDIr\<^sup>a \<phi> = ADDIr\<^sup>a \<phi>\<^sup>f\<^sup>p\<^sup>-" unfolding cond subset_out_def by (simp add: join_def ofp_fixpoint_compl_def sdiff_def)
+lemma ADDIr_a_fp: "ADDIr\<^sup>a \<phi> = nADDIr\<^sup>a \<phi>\<^sup>f\<^sup>p" by (metis ADDIr_a_cmpl ADDIr_a_fpc sfun_compl_invol)
+lemma ADDIr_b_fpc: "ADDIr\<^sup>b \<phi> = ADDIr\<^sup>b \<phi>\<^sup>f\<^sup>p\<^sup>-" unfolding cond subset_out_def by (simp add: join_def ofp_fixpoint_compl_def sdiff_def)
+lemma ADDIr_b_fp: "ADDIr\<^sup>b \<phi> = nADDIr\<^sup>b \<phi>\<^sup>f\<^sup>p" by (metis ADDIr_b_cmpl ADDIr_b_fpc sfun_compl_invol)
+
+lemma MULTr_a_fp: "MULTr\<^sup>a \<phi> = MULTr\<^sup>a \<phi>\<^sup>f\<^sup>p" unfolding cond subset_in_def by (simp add: dimpl_def meet_def op_fixpoint_def)
+lemma MULTr_a_fpc: "MULTr\<^sup>a \<phi> = nMULTr\<^sup>a \<phi>\<^sup>f\<^sup>p\<^sup>-" using MULTr_a_cmpl MULTr_a_fp by blast
+lemma MULTr_b_fp: "MULTr\<^sup>b \<phi> = MULTr\<^sup>b \<phi>\<^sup>f\<^sup>p" unfolding cond subset_in_def by (simp add: dimpl_def meet_def op_fixpoint_def)
+lemma MULTr_b_fpc: "MULTr\<^sup>b \<phi> = nMULTr\<^sup>b \<phi>\<^sup>f\<^sup>p\<^sup>-" using MULTr_b_cmpl MULTr_b_fp by blast
+
+
+text\<open>Relativized IDEM variants.\<close>
+definition IDEMr_a::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("IDEMr\<^sup>a")
+  where "IDEMr\<^sup>a \<phi> \<equiv> \<forall>A. \<phi>(A \<^bold>\<or> \<phi> A) \<^bold>\<le>\<^sup>A (\<phi> A)"
+definition IDEMr_b::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("IDEMr\<^sup>b") 
+  where "IDEMr\<^sup>b \<phi> \<equiv> \<forall>A. (\<phi> A) \<^bold>\<le>\<^sub>A \<phi>(A \<^bold>\<and> \<phi> A)"
+declare IDEMr_a_def[cond] IDEMr_b_def[cond]
+
+text\<open>Relativized nIDEM variants.\<close>
+definition nIDEMr_a::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("nIDEMr\<^sup>a") 
+  where "nIDEMr\<^sup>a \<phi> \<equiv> \<forall>A. (\<phi> A) \<^bold>\<le>\<^sup>A \<phi>(A \<^bold>\<or> \<^bold>\<midarrow>(\<phi> A))"
+definition nIDEMr_b::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("nIDEMr\<^sup>b") 
+  where "nIDEMr\<^sup>b \<phi> \<equiv> \<forall>A. \<phi>(A \<^bold>\<and> \<^bold>\<midarrow>(\<phi> A)) \<^bold>\<le>\<^sub>A (\<phi> A)"
+
+declare nIDEMr_a_def[cond] nIDEMr_b_def[cond]
+
+
+text\<open>Complement interrelations.\<close>
+lemma IDEMr_a_cmpl: "IDEMr\<^sup>a \<phi> = nIDEMr\<^sup>a \<phi>\<^sup>-" unfolding cond subset_in_def subset_out_def by (metis compl_def sfun_compl_invol svfun_compl_def)
+lemma IDEMr_b_cmpl: "IDEMr\<^sup>b \<phi> = nIDEMr\<^sup>b \<phi>\<^sup>-" unfolding cond subset_in_def subset_out_def by (metis compl_def sfun_compl_invol svfun_compl_def)
+
+text\<open>Dual interrelation.\<close>
+lemma IDEMr_dual: "IDEMr\<^sup>a \<phi> = IDEMr\<^sup>b \<phi>\<^sup>d" unfolding cond subset_in_def subset_out_def op_dual_def by (metis (mono_tags, opaque_lifting) BA_dn compl_def diff_char1 diff_char2 impl_char setequ_ext)
+lemma nIDEMr_dual: "nIDEMr\<^sup>a \<phi> = nIDEMr\<^sup>b \<phi>\<^sup>d" by (metis IDEMr_dual IDEMr_a_cmpl IDEMr_b_cmpl dual_compl_char1 dual_compl_char2 sfun_compl_invol)
+
+text\<open>Fixed-point interrelations.\<close>
+lemma nIDEMr_a_fpc: "nIDEMr\<^sup>a \<phi> = nIDEMr\<^sup>a \<phi>\<^sup>f\<^sup>p\<^sup>-" proof -
+  have "\<forall>A. (\<lambda>p. A p \<or> \<not>\<phi> A p) = (\<lambda>p. A p \<or> \<phi> A p = A p)" by blast
+  thus ?thesis unfolding cond subset_out_def ofp_fixpoint_compl_def conn order by simp
+qed
+lemma IDEMr_a_fp: "IDEMr\<^sup>a \<phi> = nIDEMr\<^sup>a \<phi>\<^sup>f\<^sup>p" by (metis IDEMr_a_cmpl nIDEMr_a_fpc ofp_invol)
+lemma IDEMr_a_fpc: "IDEMr\<^sup>a \<phi> = IDEMr\<^sup>a \<phi>\<^sup>f\<^sup>p\<^sup>-" by (metis IDEMr_a_cmpl nIDEMr_a_fpc ofp_comm_compl)
+lemma IDEMr_b_fp: "IDEMr\<^sup>b \<phi> = IDEMr\<^sup>b \<phi>\<^sup>f\<^sup>p" by (metis IDEMr_a_fpc IDEMr_dual dual_compl_char1 dual_invol ofp_comm_compl ofp_comm_dc2)
+lemma IDEMr_b_fpc: "IDEMr\<^sup>b \<phi> = nIDEMr\<^sup>b \<phi>\<^sup>f\<^sup>p\<^sup>-" using IDEMr_b_fp IDEMr_b_cmpl by blast
+
+
+text\<open>The original border condition B1' (by Zarycki) is equivalent to the conjuntion of nMULTr and CNTR.\<close>
+abbreviation "B1' \<phi> \<equiv> \<forall>A B. \<phi>(A \<^bold>\<and> B) \<^bold>= (A \<^bold>\<and> \<phi> B) \<^bold>\<or> (\<phi> A \<^bold>\<and> B)" 
+
+lemma "B1' \<phi> = (nMULTr \<phi> \<and> CNTR \<phi>)" proof -
+  have l2ra: "B1' \<phi> \<longrightarrow> nMULTr \<phi>" unfolding cond by (smt (z3) join_def meet_def setequ_ext setequ_in_def)
+  have l2rb: "B1' \<phi> \<longrightarrow> CNTR \<phi>" unfolding cond by (metis L2 L4 L5 L7 L9 setequ_ext)
+  have r2l: "(nMULTr \<phi> \<and> CNTR \<phi>) \<longrightarrow> B1' \<phi>" unfolding cond by (smt (z3) L10 join_def meet_def setequ_def setequ_in_char)
+  from l2ra l2rb r2l show ?thesis by blast
+qed
+
+text\<open>Modulo conditions nMULTr and CNTR the border condition B4 is equivalent to nIDEMr-b.\<close>
+abbreviation "B4 \<phi> \<equiv> \<forall>A. \<phi>(\<^bold>\<midarrow>\<phi>(\<^bold>\<midarrow>A)) \<^bold>\<le> A"
+
+lemma "nMULTr \<phi> \<Longrightarrow> CNTR \<phi> \<Longrightarrow> B4 \<phi> = nIDEMr\<^sup>b \<phi>" proof -
+  assume a1: "nMULTr \<phi>" and a2: "CNTR \<phi>"
+  have l2r: "nMULTr\<^sup>b \<phi> \<Longrightarrow> B4 \<phi> \<longrightarrow> nIDEMr\<^sup>b \<phi>" unfolding cond subset_in_char subset_def by (metis BA_deMorgan1 BA_dn compl_def meet_def setequ_ext)
+  have r2l: "nMULTr\<^sup>a \<phi> \<Longrightarrow> CNTR \<phi> \<Longrightarrow> nIDEMr\<^sup>b \<phi> \<longrightarrow> B4 \<phi>" unfolding cond by (smt (verit) compl_def join_def meet_def subset_def subset_in_def)
+  from l2r r2l show ?thesis using a1 a2 nMULTr_char by blast
+qed
+
+end
diff --git a/thys/Topological_Semantics/conditions_relativized_infinitary.thy b/thys/Topological_Semantics/conditions_relativized_infinitary.thy
new file mode 100644
--- /dev/null
+++ b/thys/Topological_Semantics/conditions_relativized_infinitary.thy
@@ -0,0 +1,80 @@
+theory conditions_relativized_infinitary
+  imports conditions_relativized conditions_negative_infinitary
+begin   
+
+subsection \<open>Infinitary Relativized Conditions\<close>
+
+text\<open>We define and interrelate infinitary variants for some previously introduced
+ axiomatic conditions on operators.\<close>
+
+definition iADDIr::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("iADDIr")
+  where "iADDIr \<phi>  \<equiv> \<forall>S. let U=\<^bold>\<Or>S in (\<phi>(\<^bold>\<Or>S) \<^bold>=\<^sup>U \<^bold>\<Or>\<lbrakk>\<phi> S\<rbrakk>)"
+definition iADDIr_a::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("iADDIr\<^sup>a")
+  where "iADDIr\<^sup>a \<phi> \<equiv> \<forall>S. let U=\<^bold>\<Or>S in (\<phi>(\<^bold>\<Or>S) \<^bold>\<le>\<^sup>U \<^bold>\<Or>\<lbrakk>\<phi> S\<rbrakk>)" 
+definition iADDIr_b::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("iADDIr\<^sup>b")
+  where "iADDIr\<^sup>b \<phi> \<equiv> \<forall>S. let U=\<^bold>\<Or>S in (\<^bold>\<Or>\<lbrakk>\<phi> S\<rbrakk> \<^bold>\<le>\<^sup>U \<phi>(\<^bold>\<Or>S))" 
+
+definition inADDIr::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("inADDIr")
+  where "inADDIr \<phi>  \<equiv> \<forall>S. let U=\<^bold>\<Or>S in (\<phi>(\<^bold>\<Or>S) \<^bold>=\<^sup>U \<^bold>\<And>\<lbrakk>\<phi> S\<rbrakk>)"
+definition inADDIr_a::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("inADDIr\<^sup>a")
+  where "inADDIr\<^sup>a \<phi> \<equiv> \<forall>S. let U=\<^bold>\<Or>S in (\<^bold>\<And>\<lbrakk>\<phi> S\<rbrakk> \<^bold>\<le>\<^sup>U \<phi>(\<^bold>\<Or>S))"  
+definition inADDIr_b::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("inADDIr\<^sup>b")
+  where "inADDIr\<^sup>b \<phi> \<equiv> \<forall>S. let U=\<^bold>\<Or>S in (\<phi>(\<^bold>\<Or>S) \<^bold>\<le>\<^sup>U \<^bold>\<And>\<lbrakk>\<phi> S\<rbrakk>)" 
+
+declare iADDIr_def[cond] iADDIr_a_def[cond] iADDIr_b_def[cond]
+        inADDIr_def[cond] inADDIr_a_def[cond] inADDIr_b_def[cond]
+
+definition iMULTr::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("iMULTr")
+  where "iMULTr \<phi>  \<equiv> \<forall>S. let U=\<^bold>\<And>S in (\<phi>(\<^bold>\<And>S) \<^bold>=\<^sub>U \<^bold>\<And>\<lbrakk>\<phi> S\<rbrakk>)"
+definition iMULTr_a::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("iMULTr\<^sup>a")
+  where "iMULTr\<^sup>a \<phi> \<equiv> \<forall>S. let U=\<^bold>\<And>S in (\<phi>(\<^bold>\<And>S) \<^bold>\<le>\<^sub>U \<^bold>\<And>\<lbrakk>\<phi> S\<rbrakk>)"
+definition iMULTr_b::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("iMULTr\<^sup>b")
+  where "iMULTr\<^sup>b \<phi> \<equiv> \<forall>S. let U=\<^bold>\<And>S in (\<^bold>\<And>\<lbrakk>\<phi> S\<rbrakk> \<^bold>\<le>\<^sub>U \<phi>(\<^bold>\<And>S))"
+
+definition inMULTr::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("inMULTr")
+  where "inMULTr \<phi>  \<equiv> \<forall>S. let U=\<^bold>\<And>S in (\<phi>(\<^bold>\<And>S) \<^bold>=\<^sub>U \<^bold>\<Or>\<lbrakk>\<phi> S\<rbrakk>)"
+definition inMULTr_a::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("inMULTr\<^sup>a")
+  where "inMULTr\<^sup>a \<phi> \<equiv> \<forall>S. let U=\<^bold>\<And>S in (\<^bold>\<Or>\<lbrakk>\<phi> S\<rbrakk> \<^bold>\<le>\<^sub>U \<phi>(\<^bold>\<And>S))"
+definition inMULTr_b::"('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool" ("inMULTr\<^sup>b")
+  where "inMULTr\<^sup>b \<phi> \<equiv> \<forall>S. let U=\<^bold>\<And>S in (\<phi>(\<^bold>\<And>S) \<^bold>\<le>\<^sub>U \<^bold>\<Or>\<lbrakk>\<phi> S\<rbrakk>)"
+
+declare iMULTr_def[cond] iMULTr_a_def[cond] iMULTr_b_def[cond]
+        inMULTr_def[cond] inMULTr_a_def[cond] inMULTr_b_def[cond]
+
+lemma iADDIr_char: "iADDIr \<phi> = (iADDIr\<^sup>a \<phi> \<and> iADDIr\<^sup>b \<phi>)" unfolding cond setequ_char setequ_out_char subset_out_char by (meson setequ_char)
+lemma iMULTr_char: "iMULTr \<phi> = (iMULTr\<^sup>a \<phi> \<and> iMULTr\<^sup>b \<phi>)" unfolding cond setequ_char setequ_in_char subset_in_char by (meson setequ_char)
+
+lemma inADDIr_char: "inADDIr \<phi> = (inADDIr\<^sup>a \<phi> \<and> inADDIr\<^sup>b \<phi>)" unfolding cond setequ_char setequ_out_char subset_out_char by (meson setequ_char)
+lemma inMULTr_char: "inMULTr \<phi> = (inMULTr\<^sup>a \<phi> \<and> inMULTr\<^sup>b \<phi>)" unfolding cond setequ_char setequ_in_char subset_in_char by (meson setequ_char)
+
+
+text\<open>Dual interrelations.\<close>
+lemma iADDIr_dual1: "iADDIr\<^sup>a \<phi> = iMULTr\<^sup>b \<phi>\<^sup>d" unfolding cond by (smt (z3) BA_cmpl_equ BA_cp BA_deMorgan2 dual_invol iDM_a iDM_b im_prop1 op_dual_def setequ_ext subset_in_char subset_out_char)
+lemma iADDIr_dual2: "iADDIr\<^sup>b \<phi> = iMULTr\<^sup>a \<phi>\<^sup>d" unfolding cond by (smt (z3) BA_cmpl_equ BA_cp BA_deMorgan2 dual_invol iDM_a iDM_b im_prop1 op_dual_def setequ_ext subset_in_char subset_out_char)
+lemma iADDIr_dual:  "iADDIr \<phi> = iMULTr \<phi>\<^sup>d" using iADDIr_char iADDIr_dual1 iADDIr_dual2 iMULTr_char by blast
+
+lemma inADDIr_dual1: "inADDIr\<^sup>a \<phi> = inMULTr\<^sup>b \<phi>\<^sup>d" unfolding cond by (smt (z3) BA_cmpl_equ compl_def dual_invol iDM_a iDM_b im_prop3 op_dual_def setequ_ext subset_in_def subset_in_out)
+lemma inADDIr_dual2: "inADDIr\<^sup>b \<phi> = inMULTr\<^sup>a \<phi>\<^sup>d" unfolding cond by (smt (z3) BA_cmpl_equ compl_def dual_invol iDM_a iDM_b im_prop3 op_dual_def setequ_ext subset_in_def subset_in_out)
+lemma inADDIr_dual:  "inADDIr \<phi> = inMULTr \<phi>\<^sup>d" using inADDIr_char inADDIr_dual1 inADDIr_dual2 inMULTr_char by blast
+
+text\<open>Complement interrelations.\<close>
+lemma iADDIr_a_cmpl: "iADDIr\<^sup>a \<phi> = inADDIr\<^sup>a \<phi>\<^sup>-" unfolding cond by (smt (z3) compl_def dualcompl_invol iDM_b im_prop2 setequ_ext subset_out_def svfun_compl_def)
+lemma iADDIr_b_cmpl: "iADDIr\<^sup>b \<phi> = inADDIr\<^sup>b \<phi>\<^sup>-" unfolding cond by (smt (z3) compl_def iDM_b im_prop2 setequ_ext sfun_compl_invol subset_out_def svfun_compl_def)
+lemma iADDIr_cmpl: "iADDIr \<phi> = inADDIr \<phi>\<^sup>-" by (simp add: iADDIr_a_cmpl iADDIr_b_cmpl iADDIr_char inADDIr_char)
+
+lemma iMULTr_a_cmpl: "iMULTr\<^sup>a \<phi> = inMULTr\<^sup>a \<phi>\<^sup>-" unfolding cond by (smt (z3) compl_def iDM_b im_prop2 setequ_ext subset_in_def svfun_compl_def)
+lemma iMULTr_b_cmpl: "iMULTr\<^sup>b \<phi> = inMULTr\<^sup>b \<phi>\<^sup>-" unfolding cond by (smt (z3) compl_def dualcompl_invol iDM_a im_prop2 setequ_ext subset_in_def svfun_compl_def)
+lemma iMULTr_cmpl: "MULTr \<phi> = nMULTr \<phi>\<^sup>-" by (simp add: MULTr_a_cmpl MULTr_b_cmpl MULTr_char nMULTr_char)
+
+text\<open>Fixed-point interrelations.\<close>
+lemma iADDIr_a_fpc: "iADDIr\<^sup>a \<phi> = iADDIr\<^sup>a \<phi>\<^sup>f\<^sup>p\<^sup>-" unfolding cond subset_out_def image_def ofp_fixpoint_compl_def supremum_def sdiff_def by (smt (verit))
+lemma iADDIr_a_fp: "iADDIr\<^sup>a \<phi> = inADDIr\<^sup>a \<phi>\<^sup>f\<^sup>p" by (metis iADDIr_a_cmpl iADDIr_a_fpc sfun_compl_invol)
+lemma iADDIr_b_fpc: "iADDIr\<^sup>b \<phi> = iADDIr\<^sup>b \<phi>\<^sup>f\<^sup>p\<^sup>-" unfolding cond subset_out_def image_def ofp_fixpoint_compl_def supremum_def sdiff_def by (smt (verit))
+lemma iADDIr_b_fp: "iADDIr\<^sup>b \<phi> = inADDIr\<^sup>b \<phi>\<^sup>f\<^sup>p" by (metis iADDIr_b_cmpl iADDIr_b_fpc sfun_compl_invol)
+
+lemma iMULTr_a_fp: "iMULTr\<^sup>a \<phi> = iMULTr\<^sup>a \<phi>\<^sup>f\<^sup>p" unfolding cond subset_in_def image_def by (smt (z3) dimpl_def infimum_def ofp_invol op_fixpoint_def)
+lemma iMULTr_a_fpc: "iMULTr\<^sup>a \<phi> = inMULTr\<^sup>a \<phi>\<^sup>f\<^sup>p\<^sup>-" using iMULTr_a_cmpl iMULTr_a_fp by blast
+lemma iMULTr_b_fp: "iMULTr\<^sup>b \<phi> = iMULTr\<^sup>b \<phi>\<^sup>f\<^sup>p" unfolding cond subset_in_def image_def dimpl_def infimum_def op_fixpoint_def by (smt (verit))
+lemma iMULTr_b_fpc: "iMULTr\<^sup>b \<phi> = inMULTr\<^sup>b \<phi>\<^sup>f\<^sup>p\<^sup>-" using iMULTr_b_cmpl iMULTr_b_fp by blast
+
+end
diff --git a/thys/Topological_Semantics/document/root.bib b/thys/Topological_Semantics/document/root.bib
--- a/thys/Topological_Semantics/document/root.bib
+++ b/thys/Topological_Semantics/document/root.bib
@@ -1,149 +1,8 @@
-@article{J23,
-  keywords =	 {Higher Order Logic, Semantic Embedding, Modal
-                  Logics, Henkin Semantics},
-  author =	 {C. Benzm{\"u}ller and L.C. Paulson},
-  title =	 {Quantified Multimodal Logics in Simple Type Theory},
-  journal =	 {Logica Universalis (Special Issue on Multimodal
-                  Logics)},
-  year =	 2013,
-  volume =	 7,
-  number =	 1,
-  pages =	 {7-20},
-  doi =		 {10.1007/s11787-012-0052-y},
-  Note =	 {Preprint: 
-			\url{http://christoph-benzmueller.de/papers/J23.pdf}}
-}
-
-@article{J41,
-  author =	 {Christoph Benzm{\"u}ller},
-  title =	 {Universal (Meta-)Logical Reasoning: Recent
-                  Successes},
-  journal =	 {Science of Computer Programming},
-  year =	 2019,
-  volume =	 172,
-  pages =	 {48-62},
-  Note =	 {Preprint:
-                  \url{http://doi.org/10.13140/RG.2.2.11039.61609/2}},
-  doi =		 {10.1016/j.scico.2018.10.008},
-}
-
-@book{Hausdorff,
-  title={Grundz{\"u}ge der {M}engenlehre},
-  author={Hausdorff, Felix},
-  volume={7},
-  year={1914},
-  publisher={von Veit}
-}
-
-@article{AOT,
-  title={The algebra of topology},
-  author={McKinsey, John Charles Chenoweth and Tarski, Alfred},
-  journal={Annals of mathematics},
-  pages={141--191},
-  year={1944},
-  publisher={JSTOR}
-}
-
-@article{Zarycki1,
-  title={Quelques notions fondamentales de l'Analysis Situs au point de vue de l'Alg{\`e}bre de la Logique},
-  author={Zarycki, Miron},
-  journal={Fundamenta Mathematicae},
-  volume={9},
-  number={1},
-  pages={3--15},
-  year={1927},
-  publisher={Institute of Mathematics Polish Academy of Sciences},
-  Note = {English translation by Mark Bowron:
-                  \url{https://www.researchgate.net/scientific-contributions/Miron-Zarycki-2016157096}}
-}
-
-@article{Zarycki2,
-  title={Allgemeine {E}igenschaften der Cantorschen {K}oh{\"a}renzen},
-  author={Zarycki, Miron},
-  journal={Transactions of the American Mathematical Society},
-  volume={30},
-  number={3},
-  pages={498--506},
-  year={1928},
-  publisher={JSTOR},
-  Note = {English translation by Mark Bowron:
-                  \url{https://www.researchgate.net/scientific-contributions/Miron-Zarycki-2016157096}}
+@article{SemanticalInvestigations,
+  title={Semantical Investigations on Non-Classical Logics with Recovery Operators: Negation},
+  author={David Fuenmayor},
+  journal = {The Logic Journal of the IGPL. Special Issue on Non-classical Modal and Predicate Logics},    
+  year={202X},
+  publisher={Oxford University Press},
+  note = {To appear (preprint: \url{https://arxiv.org/abs/2104.04284})},
 }
-
-@article{Zarycki3,
-  title={Some Properties of the Derived Set Operation in Abstract Spaces.},
-  author={Zarycki, Miron},
-  journal={Nauk. Zap. Ser. Fiz.-Mat.},
-  volume={5},  
-  pages={22-33},
-  year={1947},
-  Note = {English translation by Mark Bowron:
-                  \url{https://www.researchgate.net/scientific-contributions/Miron-Zarycki-2016157096}}
-}
-
-@article{Kuratowski1,
-  title={Sur l'op{\'e}ration \={A} de l'analysis situs},
-  author={Kuratowski, Kazimierz},
-  journal={Fundamenta Mathematicae},
-  volume={3},
-  number={1},
-  pages={182--199},
-  year={1922}
-}
-
-@article{JML,
-  title={Der {M}inimalkalk{\"u}l, ein reduzierter intuitionistischer {F}ormalismus},
-  author={Johansson, Ingebrigt},
-  journal={Compositio mathematica},
-  volume={4},
-  pages={119--136},
-  year={1937}
-}
-
-@book{Kuratowski2,
-  title={Topology: Volume I},
-  author={Kuratowski, Kazimierz},
-  volume={1},
-  year={2014},
-  publisher={Elsevier}
-}
-
-@article{Esakia,
-  title={Intuitionistic logic and modality via topology},
-  author={Esakia, Leo},
-  journal={Annals of Pure and Applied Logic},
-  volume={127},
-  number={1-3},
-  pages={155--170},
-  year={2004},
-  publisher={Elsevier}
-}
-
-@incollection{LFI,
-  title={Logics of formal inconsistency},
-  author={Carnielli, Walter and Coniglio, Marcelo E and Marcos, Joao},
-  booktitle={Handbook of philosophical logic},
-  pages={1--93},
-  year={2007},
-  publisher={Springer}
-}
-
-@article{RLFI,
-      title={Logics of Formal Inconsistency enriched with replacement: an algebraic and modal account}, 
-      author={Walter Carnielli and Marcelo E. Coniglio and David Fuenmayor},
-      year={2020},
-      number={2003.09522},
-      journal={arXiv},
-      volume={math.LO}
-}
-
-@article{LFU,
-  title={Nearly every normal modal logic is paranormal},
-  author={Marcos, Joao},
-  journal={Logique et Analyse},
-  volume={48},
-  number={189/192},
-  pages={279--300},
-  year={2005},
-  publisher={JSTOR}
-}
diff --git a/thys/Topological_Semantics/document/root.tex b/thys/Topological_Semantics/document/root.tex
--- a/thys/Topological_Semantics/document/root.tex
+++ b/thys/Topological_Semantics/document/root.tex
@@ -1,68 +1,69 @@
 \documentclass[11pt,a4paper]{article}
 \usepackage[T1]{fontenc}
 \usepackage{isabelle,isabellesym}
 %\usepackage{a4wide}
 \usepackage{fullpage}
 
 % further packages required for unusual symbols (see also
 % isabellesym.sty), use only when needed
 
 \usepackage{amssymb}
   %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{eufrak}
   %for \<AA> ... \<ZZ>, \<aa> ... \<zz> (also included in amssymb)
 
 %\usepackage{textcomp}
   %for \<onequarter>, \<onehalf>, \<threequarters>, \<degree>, \<cent>,
   %\<currency>
 
 % 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}
 
 
 \begin{document}
 
 \title{Topological semantics for paraconsistent and paracomplete logics}
 \author{David Fuenmayor}
 
 \maketitle
 
 \begin{abstract}
-	We introduce a generalized topological semantics for paraconsistent and paracomplete logics by drawing upon early works on topological Boolean algebras (cf.~works by Kuratowski, Zarycki, McKinsey \& Tarski, etc.). In particular, this work exemplarily illustrates the shallow semantical embeddings approach (SSE) employing the proof assistant Isabelle/HOL. By means of the SSE technique we can effectively harness theorem provers, model finders and `hammers' for reasoning with quantified non-classical logics.
+We investigate mathematical structures that provide natural semantics for families of (quantified) non-classical logics featuring special unary connectives, known as recovery operators, that allow us to 'recover' the properties of classical logic in a controlled manner. These structures are known as topological Boolean algebras, which are Boolean algebras extended with additional operations subject to specific conditions of a topological nature. In this study we focus on the paradigmatic case of negation. We demonstrate how these algebras are well-suited to provide a semantics for some families of paraconsistent Logics of Formal Inconsistency and paracomplete Logics of Formal Undeterminedness. These logics feature recovery operators used to earmark propositions that behave 'classically' when interacting with non-classical negations.
+We refer to the companion paper \cite{SemanticalInvestigations} for more information.
 \end{abstract}
 
 \tableofcontents
 
 \vspace*{40pt}
 % sane default for proof documents
 \parindent 0pt\parskip 0.5ex
 
 % generated text of all theories
 \input{session}
 
 % optional bibliography
 \bibliographystyle{abbrv}
 \bibliography{root}
 
 \end{document}
 
 %%% Local Variables:
 %%% mode: latex
 %%% TeX-master: t
 %%% End:
diff --git a/thys/Topological_Semantics/logics_LFI.thy b/thys/Topological_Semantics/logics_LFI.thy
new file mode 100644
--- /dev/null
+++ b/thys/Topological_Semantics/logics_LFI.thy
@@ -0,0 +1,131 @@
+theory logics_LFI
+  imports logics_consequence conditions_relativized_infinitary
+begin
+
+subsection \<open>Logics of Formal Inconsistency (LFIs)\<close>
+
+text\<open>The LFIs are a family of paraconsistent logics featuring a 'consistency' operator \<circ>
+that can be used to recover some classical properties of negation (in particular ECQ).
+We show a shallow semantical embedding of a family of self-extensional LFIs using the border operator
+as primitive.\<close>
+
+text\<open>Let us assume a concrete type w (for 'worlds' or 'points').\<close>
+typedecl w
+text\<open>Let us assume the following primitive unary operation \<B> (intended as a border operator).\<close>
+consts \<B>::"w \<sigma> \<Rightarrow> w \<sigma>"
+
+text\<open>From the topological cube of opposition we have that:\<close>
+abbreviation "\<C> \<equiv> (\<B>\<^sup>f\<^sup>p)\<^sup>d\<^sup>-" 
+abbreviation "\<I> \<equiv> \<B>\<^sup>f\<^sup>p\<^sup>-" 
+lemma "\<C>\<^sup>d\<^sup>- = \<B>\<^sup>f\<^sup>p" by (simp add: dualcompl_invol)
+
+text\<open>Let us recall that:\<close>
+lemma expn_cntr: "EXPN \<C> = CNTR \<B>" by (metis EXPN_CNTR_dual2 EXPN_fp ofp_comm_dc1)
+
+text\<open>For LFIs we use the negation previously defined as @{text "\<C>\<^sup>d\<^sup>- = \<B>\<^sup>f\<^sup>p"}.\<close>
+abbreviation neg ("\<^bold>\<not>_"[70]71) where "neg \<equiv> \<B>\<^sup>f\<^sup>p"
+
+text\<open>In terms of the border operator the negation looks as follows (under appropriate assumptions):\<close>
+lemma neg_char: "CNTR \<B> \<Longrightarrow> \<^bold>\<not>A = (\<^bold>\<midarrow>A \<^bold>\<or> \<B> A)" unfolding conn by (metis CNTR_def dimpl_def op_fixpoint_def subset_def)
+
+text\<open>This negation is of course boldly paraconsistent (for both local and global consequence).\<close>
+lemma "[a, \<^bold>\<not>a \<turnstile> b]" nitpick oops \<comment>\<open> countermodel \<close>
+lemma "[a, \<^bold>\<not>a \<turnstile> \<^bold>\<not>b]" nitpick oops \<comment>\<open> countermodel \<close>
+lemma "[a, \<^bold>\<not>a \<turnstile>\<^sub>g b]" nitpick oops \<comment>\<open> countermodel \<close> 
+lemma "[a, \<^bold>\<not>a \<turnstile>\<^sub>g \<^bold>\<not>b]" nitpick oops \<comment>\<open> countermodel \<close>
+
+text\<open>We define two pairs of in/consistency operators and show how they relate to each other.
+Using LFIs terminology, the minimal logic so encoded corresponds to RmbC + 'ciw' axiom.\<close>
+abbreviation op_inc_a::"w \<sigma> \<Rightarrow> w \<sigma>" ("\<bullet>\<^sup>A_" [57]58) (* \<bullet> as truth-glut *)
+  where "\<bullet>\<^sup>AA \<equiv> A \<^bold>\<and> \<^bold>\<not>A"
+abbreviation op_con_a::"w \<sigma> \<Rightarrow> w \<sigma>" ("\<circ>\<^sup>A_" [57]58) 
+  where "\<circ>\<^sup>AA \<equiv> \<^bold>\<midarrow>\<bullet>\<^sup>AA"
+abbreviation op_inc_b::"w \<sigma> \<Rightarrow> w \<sigma>" ("\<bullet>\<^sup>B_" [57]58) (* \<bullet> as border *)
+  where "\<bullet>\<^sup>BA \<equiv> \<B> A"
+abbreviation op_con_b::"w \<sigma> \<Rightarrow> w \<sigma>" ("\<circ>\<^sup>B_" [57]58) 
+  where "\<circ>\<^sup>BA \<equiv> \<B>\<^sup>- A"
+
+text\<open>Observe that assumming CNTR \<B> we are allowed to exchange A and B variants.\<close>
+lemma pincAB: "CNTR \<B> \<Longrightarrow> \<bullet>\<^sup>AA = \<bullet>\<^sup>BA" using neg_char by (metis CNTR_def CNTR_fpc L5 L6 L9 dimpl_char impl_char ofp_invol op_fixpoint_def setequ_ext svfun_compl_def)
+lemma pconAB: "CNTR \<B> \<Longrightarrow> \<circ>\<^sup>AA = \<circ>\<^sup>BA" by (metis pincAB setequ_ext svfun_compl_def) 
+
+text\<open>Variants A and B give us slightly different properties (there are countermodels for those not shown).\<close>
+lemma Prop1: "\<circ>\<^sup>BA = \<I>\<^sup>f\<^sup>p A" by (simp add: ofp_comm_compl ofp_invol)
+lemma Prop2: "\<circ>\<^sup>AA = (A \<^bold>\<rightarrow> \<I> A)" by (simp add: compl_def impl_def meet_def svfun_compl_def)
+lemma Prop3: "fp \<C> A \<longleftrightarrow> [\<turnstile> \<circ>\<^sup>B\<^bold>\<midarrow>A]" by (simp add: fp_rel gtrue_def ofp_comm_dc2 ofp_invol op_dual_def svfun_compl_def)
+lemma Prop4a: "fp \<I> A \<longleftrightarrow> [\<turnstile> \<circ>\<^sup>BA]" by (simp add: fp_rel gtrue_def ofp_comm_compl ofp_invol)
+lemma Prop4b: "fp \<I> A  \<longrightarrow> [\<turnstile> \<circ>\<^sup>AA]" by (simp add: Prop2 fixpoints_def impl_def setequ_ext)
+
+text\<open>The 'principle of gentle explosion' works for both variants (both locally and globally).\<close>
+lemma "[\<circ>\<^sup>Aa, a, \<^bold>\<not>a \<turnstile> b]" by (metis (mono_tags, lifting) compl_def meet_def subset_def)
+lemma "[\<circ>\<^sup>Aa, a, \<^bold>\<not>a \<turnstile>\<^sub>g b]" by (metis compl_def meet_def)
+lemma "[\<circ>\<^sup>Ba, a, \<^bold>\<not>a \<turnstile> b]" by (smt (z3) meet_def ofp_fixpoint_compl_def ofp_invol sdiff_def subset_def)
+lemma "[\<circ>\<^sup>Ba, a, \<^bold>\<not>a \<turnstile>\<^sub>g b]" by (metis compl_def fixpoints_def fp_rel gtrue_def setequ_ext svfun_compl_def)
+
+abbreviation "BORDER \<phi> \<equiv> nMULTr \<phi> \<and> CNTR \<phi> \<and> nDNRM \<phi> \<and> nIDEMr\<^sup>b \<phi>"
+
+text\<open>We show how (local) contraposition variants (among others) can be recovered using the
+ consistency operators.\<close>
+lemma "[\<circ>\<^sup>Ab, a \<^bold>\<rightarrow> b \<turnstile> \<^bold>\<not>b \<^bold>\<rightarrow> \<^bold>\<not>a]" nitpick oops \<comment>\<open> countermodel \<close>
+lemma cons_lcop0_A: "CNTR \<B> \<longrightarrow> [\<circ>\<^sup>Ab,  a \<^bold>\<rightarrow> b \<turnstile> \<^bold>\<not>b \<^bold>\<rightarrow> \<^bold>\<not>a]" by (smt (verit, del_insts) neg_char compl_def impl_char join_def meet_def subset_def)
+lemma "[\<circ>\<^sup>Bb, a \<^bold>\<rightarrow> b \<turnstile> \<^bold>\<not>b \<^bold>\<rightarrow> \<^bold>\<not>a]" nitpick oops \<comment>\<open> countermodel \<close>
+lemma cons_lcop0_B: "CNTR \<B> \<longrightarrow> [\<circ>\<^sup>Bb,  a \<^bold>\<rightarrow> b \<turnstile> \<^bold>\<not>b \<^bold>\<rightarrow> \<^bold>\<not>a]" by (metis cons_lcop0_A pconAB)
+lemma "[\<circ>\<^sup>Ab, a \<^bold>\<rightarrow> \<^bold>\<not>b \<turnstile> b \<^bold>\<rightarrow> \<^bold>\<not>a]" nitpick oops \<comment>\<open> countermodel \<close>
+lemma cons_lcop1_A: "CNTR \<B> \<longrightarrow> [\<circ>\<^sup>Ab, a \<^bold>\<rightarrow> \<^bold>\<not>b \<turnstile>  b \<^bold>\<rightarrow> \<^bold>\<not>a]" by (smt (verit, del_insts) neg_char compl_def impl_char join_def meet_def subset_def)
+lemma "[\<circ>\<^sup>Bb, a \<^bold>\<rightarrow> \<^bold>\<not>b \<turnstile> b \<^bold>\<rightarrow> \<^bold>\<not>a]" nitpick oops \<comment>\<open> countermodel \<close>
+lemma cons_lcop1_B: "CNTR \<B> \<longrightarrow> [\<circ>\<^sup>Bb, a \<^bold>\<rightarrow> \<^bold>\<not>b \<turnstile>  b \<^bold>\<rightarrow> \<^bold>\<not>a]" by (metis cons_lcop1_A pconAB)
+lemma "[\<circ>\<^sup>Ab, \<^bold>\<not>a \<^bold>\<rightarrow> b \<turnstile> \<^bold>\<not>b \<^bold>\<rightarrow> a]" nitpick oops \<comment>\<open> countermodel \<close>
+lemma cons_lcop2_A: "CNTR \<B> \<longrightarrow> [\<circ>\<^sup>Ab, \<^bold>\<not>a \<^bold>\<rightarrow> b \<turnstile> \<^bold>\<not>b \<^bold>\<rightarrow> a]" by (smt (verit, del_insts) neg_char compl_def impl_char join_def meet_def subset_def)
+lemma "[\<circ>\<^sup>Bb, \<^bold>\<not>a \<^bold>\<rightarrow> b \<turnstile> \<^bold>\<not>b \<^bold>\<rightarrow> a]" nitpick oops \<comment>\<open> countermodel \<close>
+lemma cons_lcop2_B: "CNTR \<B> \<longrightarrow> [\<circ>\<^sup>Bb, \<^bold>\<not>a \<^bold>\<rightarrow> b \<turnstile> \<^bold>\<not>b \<^bold>\<rightarrow> a]" by (metis cons_lcop2_A pconAB)
+
+text\<open>The following axioms are commonly employed in the literature on LFIs to obtain stronger logics.
+We explore under which conditions they can be assumed while keeping the logic boldly paraconsistent.\<close>
+abbreviation cf where "cf \<equiv> \<forall>P. [\<^bold>\<not>\<^bold>\<not>P \<turnstile> P]"
+abbreviation ce where "ce \<equiv> \<forall>P. [P \<turnstile> \<^bold>\<not>\<^bold>\<not>P]"
+abbreviation ciw_a where "ciw_a \<equiv> \<forall>P. [\<turnstile> \<circ>\<^sup>AP \<^bold>\<or> \<bullet>\<^sup>AP]"
+abbreviation ciw_b where "ciw_b \<equiv> \<forall>P. [\<turnstile> \<circ>\<^sup>BP \<^bold>\<or> \<bullet>\<^sup>BP]"
+abbreviation ci_a  where  "ci_a \<equiv> \<forall>P. [\<^bold>\<not>(\<circ>\<^sup>AP) \<turnstile> \<bullet>\<^sup>AP]"
+abbreviation ci_b  where  "ci_b \<equiv> \<forall>P. [\<^bold>\<not>(\<circ>\<^sup>BP) \<turnstile> \<bullet>\<^sup>BP]"
+abbreviation cl_a  where  "cl_a \<equiv> \<forall>P.  [\<^bold>\<not>(\<bullet>\<^sup>AP) \<turnstile> \<circ>\<^sup>AP]"
+abbreviation cl_b  where  "cl_b \<equiv> \<forall>P.  [\<^bold>\<not>(\<bullet>\<^sup>BP) \<turnstile> \<circ>\<^sup>BP]"
+abbreviation ca_conj_a where "ca_conj_a \<equiv> \<forall>P Q. [\<circ>\<^sup>AP,\<circ>\<^sup>AQ \<turnstile> \<circ>\<^sup>A(P \<^bold>\<and> Q)]"
+abbreviation ca_conj_b where "ca_conj_b \<equiv> \<forall>P Q. [\<circ>\<^sup>BP,\<circ>\<^sup>BQ \<turnstile> \<circ>\<^sup>B(P \<^bold>\<and> Q)]"
+abbreviation ca_disj_a where "ca_disj_a \<equiv> \<forall>P Q. [\<circ>\<^sup>AP,\<circ>\<^sup>AQ \<turnstile> \<circ>\<^sup>A(P \<^bold>\<or> Q)]"
+abbreviation ca_disj_b where "ca_disj_b \<equiv> \<forall>P Q. [\<circ>\<^sup>BP,\<circ>\<^sup>BQ \<turnstile> \<circ>\<^sup>B(P \<^bold>\<or> Q)]"
+abbreviation ca_impl_a where "ca_impl_a \<equiv> \<forall>P Q. [\<circ>\<^sup>AP,\<circ>\<^sup>AQ \<turnstile> \<circ>\<^sup>A(P \<^bold>\<rightarrow> Q)]"
+abbreviation ca_impl_b where "ca_impl_b \<equiv> \<forall>P Q. [\<circ>\<^sup>BP,\<circ>\<^sup>BQ \<turnstile> \<circ>\<^sup>B(P \<^bold>\<rightarrow> Q)]"
+abbreviation ca_a where "ca_a \<equiv> ca_conj_a \<and> ca_disj_a \<and> ca_impl_a"
+abbreviation ca_b where "ca_b \<equiv> ca_conj_b \<and> ca_disj_b \<and> ca_impl_b"
+
+text\<open>cf\<close>
+lemma "BORDER \<B> \<Longrightarrow> cf" nitpick oops \<comment>\<open> countermodel \<close>
+
+text\<open>ce\<close>
+lemma "BORDER \<B> \<Longrightarrow> ce" nitpick oops \<comment>\<open> countermodel \<close>
+
+text\<open>ciw\<close>
+lemma prop_ciw_a: "ciw_a" by (simp add: conn)
+lemma prop_ciw_b: "ciw_b" by (simp add: conn svfun_compl_def)
+
+text\<open>ci\<close>
+lemma "BORDER \<B> \<Longrightarrow> ci_a" nitpick oops \<comment>\<open> countermodel \<close>
+lemma "BORDER \<B> \<Longrightarrow> ci_b" nitpick oops \<comment>\<open> countermodel \<close>
+
+text\<open>cl\<close>
+lemma "BORDER \<B> \<Longrightarrow> cl_a" nitpick oops \<comment>\<open> countermodel \<close>
+lemma "BORDER \<B> \<Longrightarrow> cl_b" nitpick oops \<comment>\<open> countermodel \<close>
+
+text\<open>ca_conj\<close>
+lemma prop_ca_conj_b: "nMULT\<^sup>b \<B> = ca_conj_b" by (metis MULT_b_def nMULTb_compl sfun_compl_invol)
+lemma prop_ca_conj_a: "nMULTr\<^sup>b \<B> = ca_conj_a" unfolding cond op_fixpoint_def by (smt (z3) compl_def dimpl_def join_def meet_def op_fixpoint_def subset_def subset_in_def)
+
+text\<open>ca_disj\<close>
+lemma prop_ca_disj_b: "ADDI\<^sup>a \<B> = ca_disj_b" by (simp add: nADDI_a_def nADDIa_compl)
+lemma prop_ca_disj_a: "nMULTr\<^sup>a \<B> = ca_disj_a" oops (*TODO*)
+
+text\<open>ca_impl\<close>
+lemma "BORDER \<B> \<Longrightarrow> ca_impl_a" nitpick oops \<comment>\<open> countermodel \<close>
+lemma "BORDER \<B> \<Longrightarrow> ca_impl_b" nitpick oops \<comment>\<open> countermodel \<close>
+
+end
diff --git a/thys/Topological_Semantics/logics_LFU.thy b/thys/Topological_Semantics/logics_LFU.thy
new file mode 100644
--- /dev/null
+++ b/thys/Topological_Semantics/logics_LFU.thy
@@ -0,0 +1,81 @@
+theory logics_LFU
+  imports logics_consequence conditions_relativized_infinitary
+begin
+
+subsection \<open>Logics of Formal Undeterminedness (LFUs)\<close>
+
+text\<open>The LFUs are a family of paracomplete logics featuring a 'determinedness' operator \<currency>
+that can be used to recover some classical properties of negation (in particular TND).
+LFUs behave in a sense dually to LFIs. Both can be semantically embedded as extensions of Boolean algebras.
+We show a shallow semantical embedding of a family of self-extensional LFUs using the closure operator
+as primitive.\<close>
+
+(*Let us assume a concrete type w (for 'worlds' or 'points').*)
+typedecl w
+(*Let us assume the following primitive unary operation \<C> (intended as a closure operator).*)
+consts \<C>::"w \<sigma> \<Rightarrow> w \<sigma>"
+
+(*From the topological cube of opposition:*)
+abbreviation "\<I> \<equiv> \<C>\<^sup>d" 
+abbreviation "\<B> \<equiv> (\<C>\<^sup>f\<^sup>p)\<^sup>d" 
+
+(*let us recall that: *)
+lemma "EXPN \<C> = CNTR \<B>" using EXPN_CNTR_dual1 EXPN_fp by blast
+lemma "EXPN \<C> = CNTR \<I>" by (simp add: EXPN_CNTR_dual1)
+
+text\<open>For LFUs we use the negation previously defined as @{text "\<I>\<^sup>d\<^sup>- = \<C>\<^sup>-"}.\<close>
+abbreviation neg ("\<^bold>\<not>_"[70]71) where "neg \<equiv> \<C>\<^sup>-"
+
+text\<open>In terms of the border operator the negation looks as follows:\<close>
+lemma neg_char: "EXPN \<C> \<Longrightarrow> \<^bold>\<not>A = (\<^bold>\<midarrow>A \<^bold>\<and> \<B>\<^sup>d A)" unfolding conn by (metis EXPN_def compl_def dimpl_def dual_invol op_fixpoint_def subset_def svfun_compl_def)
+
+abbreviation "CLOSURE \<phi> \<equiv> ADDI \<phi> \<and> EXPN \<phi> \<and> NORM \<phi> \<and> IDEM \<phi>"
+
+text\<open>This negation is of course paracomplete.\<close>
+lemma "CLOSURE \<C> \<Longrightarrow> [\<turnstile> a \<^bold>\<or> \<^bold>\<not>a]" nitpick oops \<comment>\<open> countermodel \<close>
+
+text\<open>We define two pairs of un/determinedness operators and show how they relate to each other.
+This logic corresponds to the paracomplete dual of the LFI 'RmbC-ciw'.\<close>
+abbreviation op_det_a::"w \<sigma> \<Rightarrow> w \<sigma>" ("\<currency>\<^sup>A_" [57]58) 
+  where "\<currency>\<^sup>AA \<equiv> A \<^bold>\<or> \<^bold>\<not>A"
+abbreviation op_und_a::"w \<sigma> \<Rightarrow> w \<sigma>" ("\<star>\<^sup>A_" [57]58) (* \<star> as truth-gap *)
+  where "\<star>\<^sup>AA \<equiv> \<^bold>\<midarrow>\<currency>\<^sup>AA"
+abbreviation op_det_b::"w \<sigma> \<Rightarrow> w \<sigma>" ("\<currency>\<^sup>B_" [57]58) 
+  where "\<currency>\<^sup>BA \<equiv> \<B>\<^sup>d A"
+abbreviation op_und_b::"w \<sigma> \<Rightarrow> w \<sigma>" ("\<star>\<^sup>B_" [57]58) (* \<star> as border of the complement *)
+  where "\<star>\<^sup>BA \<equiv> \<B>\<^sup>d\<^sup>- A"
+
+
+text\<open>Observe that assumming EXPN \<C> we are allowed to exchange A and B variants.\<close>
+lemma pundAB: "EXPN \<C> \<Longrightarrow> \<star>\<^sup>AA = \<star>\<^sup>BA" using neg_char by (metis BA_deMorgan1 BA_dn L4 L9 dimpl_char impl_char ofp_comm_dc2 op_fixpoint_def sdfun_dcompl_def setequ_ext svfun_compl_def)
+lemma pdetAB: "EXPN \<C> \<Longrightarrow> \<currency>\<^sup>AA = \<currency>\<^sup>BA" by (metis dual_compl_char1 pundAB sfun_compl_invol svfun_compl_def)
+
+text\<open>Variants A and B give us slightly different properties (there are countermodels for those not shown).\<close>
+lemma Prop1: "\<currency>\<^sup>BA = \<C>\<^sup>f\<^sup>p A" by (simp add: dual_invol setequ_ext)
+lemma Prop2: "\<currency>\<^sup>AA = (\<C> A \<^bold>\<rightarrow> A)" unfolding conn by (metis compl_def svfun_compl_def)
+lemma Prop3: "fp \<I> A \<longleftrightarrow> [\<turnstile> \<currency>\<^sup>B\<^bold>\<midarrow>A]" by (simp add: dual_invol fp_d_rel gtrue_def)
+lemma Prop4a: "fp \<C> A \<longleftrightarrow> [\<turnstile> \<currency>\<^sup>BA]" by (simp add: dual_invol fp_rel gtrue_def)
+lemma Prop4b: "fp \<C> A  \<longrightarrow> [\<turnstile> \<currency>\<^sup>AA]" by (simp add: compl_def fixpoints_def join_def setequ_ext svfun_compl_def)
+
+text\<open>Recovering TND works for both variants.\<close>
+lemma "[\<currency>\<^sup>Aa \<turnstile> a, \<^bold>\<not>a]" by (simp add: subset_def)
+lemma "[\<turnstile> \<star>\<^sup>Aa \<^bold>\<or> a \<^bold>\<or> \<^bold>\<not>a]" by (metis compl_def join_def)
+lemma "[\<currency>\<^sup>Ba \<turnstile> a, \<^bold>\<not>a]" by (simp add: compl_def dimpl_def dual_invol join_def op_fixpoint_def subset_def svfun_compl_def)
+lemma "[\<turnstile> \<star>\<^sup>Ba \<^bold>\<or> a \<^bold>\<or> \<^bold>\<not>a]" by (metis dimpl_def dual_compl_char1 dual_invol join_def ofp_comm_compl op_fixpoint_def)
+
+text\<open>We show how (local) contraposition variants (among others) can be recovered using the
+ determinedness operators.\<close>
+lemma "[\<currency>\<^sup>Aa, a \<^bold>\<rightarrow> b \<turnstile> \<^bold>\<not>b \<^bold>\<rightarrow> \<^bold>\<not>a]" nitpick oops
+lemma det_lcop0_A: "EXPN \<C> \<Longrightarrow> [\<currency>\<^sup>Aa,  a \<^bold>\<rightarrow> b \<turnstile> \<^bold>\<not>b \<^bold>\<rightarrow> \<^bold>\<not>a]" using neg_char impl_char unfolding conn order  by fastforce
+lemma "[\<currency>\<^sup>Ba, a \<^bold>\<rightarrow> b \<turnstile> \<^bold>\<not>b \<^bold>\<rightarrow> \<^bold>\<not>a]" nitpick oops
+lemma det_lcop0_B: "EXPN \<C> \<Longrightarrow> [\<currency>\<^sup>Ba,  a \<^bold>\<rightarrow> b \<turnstile> \<^bold>\<not>b \<^bold>\<rightarrow> \<^bold>\<not>a]" by (metis det_lcop0_A pdetAB)
+lemma "[\<currency>\<^sup>Aa, a \<^bold>\<rightarrow> \<^bold>\<not>b \<turnstile> b \<^bold>\<rightarrow> \<^bold>\<not>a]" nitpick oops
+lemma det_lcop1_A: "EXPN \<C> \<Longrightarrow> [\<currency>\<^sup>Aa, a \<^bold>\<rightarrow> \<^bold>\<not>b \<turnstile>  b \<^bold>\<rightarrow> \<^bold>\<not>a]" by (smt (verit, ccfv_SIG) impl_char impl_def join_def meet_def neg_char subset_def)
+lemma "[\<currency>\<^sup>Ba, a \<^bold>\<rightarrow> \<^bold>\<not>b \<turnstile> b \<^bold>\<rightarrow> \<^bold>\<not>a]" nitpick oops
+lemma det_lcop1_B: "EXPN \<C> \<Longrightarrow> [\<currency>\<^sup>Ba, a \<^bold>\<rightarrow> \<^bold>\<not>b \<turnstile>  b \<^bold>\<rightarrow> \<^bold>\<not>a]" by (metis det_lcop1_A pdetAB)
+lemma "[\<currency>\<^sup>Aa, \<^bold>\<not>a \<^bold>\<rightarrow> b \<turnstile> \<^bold>\<not>b \<^bold>\<rightarrow> a]" nitpick oops
+lemma det_lcop2_A: "EXPN \<C> \<Longrightarrow> [\<currency>\<^sup>Aa, \<^bold>\<not>a \<^bold>\<rightarrow> b \<turnstile> \<^bold>\<not>b \<^bold>\<rightarrow> a]" by (smt (verit, del_insts) neg_char compl_def impl_char join_def meet_def subset_def)
+lemma "[\<currency>\<^sup>Ba, \<^bold>\<not>a \<^bold>\<rightarrow> b \<turnstile> \<^bold>\<not>b \<^bold>\<rightarrow> a]" nitpick oops
+lemma det_lcop2_B: "EXPN \<C> \<Longrightarrow> [\<currency>\<^sup>Ba, \<^bold>\<not>a \<^bold>\<rightarrow> b \<turnstile> \<^bold>\<not>b \<^bold>\<rightarrow> a]" by (metis det_lcop2_A pdetAB)
+
+end
diff --git a/thys/Topological_Semantics/logics_consequence.thy b/thys/Topological_Semantics/logics_consequence.thy
new file mode 100644
--- /dev/null
+++ b/thys/Topological_Semantics/logics_consequence.thy
@@ -0,0 +1,33 @@
+theory logics_consequence
+  imports boolean_algebra
+begin
+
+section \<open>Logics based on Topological Boolean Algebras\<close>
+
+subsection \<open>Logical Consequence and Validity\<close>
+
+text\<open>Logical validity can be defined as truth in all points (i.e. as denoting the top element).\<close>
+abbreviation (input) gtrue::"'w \<sigma> \<Rightarrow> bool" ("[\<turnstile> _]") 
+  where  "[\<turnstile> A] \<equiv> \<forall>w. A w"   
+lemma gtrue_def: "[\<turnstile> A] \<equiv> A \<^bold>= \<^bold>\<top>" by (simp add: setequ_def top_def)
+
+text\<open>When defining a logic over an existing algebra we have two choices: a global (truth preserving)
+and a local (degree preserving) notion of logical consequence. For LFIs/LFUs we prefer the latter.\<close>
+abbreviation (input) conseq_global1::"'w \<sigma> \<Rightarrow> 'w \<sigma>\<Rightarrow>bool" ("[_ \<turnstile>\<^sub>g _]") 
+  where "[A \<turnstile>\<^sub>g B] \<equiv> [\<turnstile> A] \<longrightarrow> [\<turnstile> B]"
+abbreviation (input) conseq_global21::"'w \<sigma> \<Rightarrow> 'w \<sigma> \<Rightarrow> 'w \<sigma> \<Rightarrow> bool" ("[_,_ \<turnstile>\<^sub>g _]") 
+  where "[A\<^sub>1, A\<^sub>2 \<turnstile>\<^sub>g B] \<equiv> [\<turnstile> A\<^sub>1] \<and> [\<turnstile> A\<^sub>2] \<longrightarrow> [\<turnstile> B]"
+abbreviation (input) conseq_global31::"'w \<sigma> \<Rightarrow> 'w \<sigma> \<Rightarrow> 'w \<sigma> \<Rightarrow> 'w \<sigma> \<Rightarrow> bool" ("[_,_,_ \<turnstile>\<^sub>g _]") 
+  where "[A\<^sub>1, A\<^sub>2, A\<^sub>3 \<turnstile>\<^sub>g B] \<equiv> [\<turnstile> A\<^sub>1] \<and> [\<turnstile> A\<^sub>2] \<and> [\<turnstile> A\<^sub>3] \<longrightarrow> [\<turnstile> B]"
+
+abbreviation (input) conseq_local1::"'w \<sigma> \<Rightarrow> 'w \<sigma> \<Rightarrow> bool" ("[_ \<turnstile> _]") 
+  where "[A \<turnstile> B] \<equiv> A \<^bold>\<le> B"
+abbreviation (input) conseq_local21::"'w \<sigma> \<Rightarrow> 'w \<sigma> \<Rightarrow> 'w \<sigma> \<Rightarrow> bool" ("[_,_ \<turnstile> _]") 
+  where "[A\<^sub>1, A\<^sub>2 \<turnstile> B] \<equiv> A\<^sub>1 \<^bold>\<and> A\<^sub>2 \<^bold>\<le> B"
+abbreviation (input) conseq_local12::"'w \<sigma> \<Rightarrow> 'w \<sigma> \<Rightarrow> 'w \<sigma> \<Rightarrow> bool" ("[_ \<turnstile> _,_]") 
+  where "[A \<turnstile> B\<^sub>1, B\<^sub>2] \<equiv> A \<^bold>\<le> B\<^sub>1 \<^bold>\<or> B\<^sub>2"
+abbreviation (input) conseq_local31::"'w \<sigma> \<Rightarrow> 'w \<sigma> \<Rightarrow> 'w \<sigma> \<Rightarrow> 'w \<sigma> \<Rightarrow> bool" ("[_,_,_ \<turnstile> _]") 
+  where "[A\<^sub>1, A\<^sub>2, A\<^sub>3 \<turnstile> B] \<equiv> A\<^sub>1 \<^bold>\<and> A\<^sub>2 \<^bold>\<and> A\<^sub>3 \<^bold>\<le> B"
+(*add more as the need arises...*)
+
+end
diff --git a/thys/Topological_Semantics/logics_negation.thy b/thys/Topological_Semantics/logics_negation.thy
new file mode 100644
--- /dev/null
+++ b/thys/Topological_Semantics/logics_negation.thy
@@ -0,0 +1,271 @@
+theory logics_negation
+  imports logics_consequence conditions_relativized
+begin
+
+subsection \<open>Properties of negation(-like) operators\<close>
+
+text\<open>To avoid visual clutter we introduce convenient notation for type for properties of operators.\<close>
+type_synonym 'w \<Omega> = "('w \<sigma> \<Rightarrow> 'w \<sigma>) \<Rightarrow> bool"
+
+named_theorems neg (*to group together definitions for properties of negations*)
+
+
+subsubsection \<open>Principles of excluded middle, contradiction and explosion\<close>
+
+text\<open>TND: tertium non datur, aka. law of excluded middle (resp. strong, weak, minimal).\<close>
+abbreviation pTND  ("TND\<^sup>_  _") where "TND\<^sup>a  \<eta> \<equiv>         [\<turnstile> a \<^bold>\<or> \<eta> a]"
+abbreviation pTNDw ("TNDw\<^sup>_ _") where "TNDw\<^sup>a \<eta> \<equiv> \<forall>b. [\<eta> b \<turnstile> a, \<eta> a]"
+abbreviation pTNDm ("TNDm\<^sup>_ _") where "TNDm\<^sup>a \<eta> \<equiv>     [\<eta> \<^bold>\<bottom> \<turnstile> a, \<eta> a]"
+definition TND ::"'w \<Omega>" where "TND  \<eta> \<equiv> \<forall>\<phi>. TND\<^sup>\<phi>  \<eta>"
+definition TNDw::"'w \<Omega>" where "TNDw \<eta> \<equiv> \<forall>\<phi>. TNDw\<^sup>\<phi> \<eta>"
+definition TNDm::"'w \<Omega>" where "TNDm \<eta> \<equiv> \<forall>\<phi>. TNDm\<^sup>\<phi> \<eta>"
+declare TND_def[neg] TNDw_def[neg] TNDm_def[neg]
+
+text\<open>Explore some (non)entailment relations.\<close>
+lemma "TND  \<eta> \<Longrightarrow> TNDw \<eta>" unfolding neg conn order by simp
+lemma "TNDw \<eta> \<Longrightarrow> TND  \<eta>" nitpick oops \<comment>\<open> counterexample \<close>
+lemma "TNDw \<eta> \<Longrightarrow> TNDm \<eta>" unfolding neg by simp
+lemma "TNDm \<eta> \<Longrightarrow> TNDw \<eta>" nitpick oops \<comment>\<open> counterexample \<close>
+
+text\<open>ECQ: ex contradictione (sequitur) quodlibet (variants: strong, weak, minimal).\<close>
+abbreviation pECQ  ("ECQ\<^sup>_ _")  where "ECQ\<^sup>a  \<eta> \<equiv>     [a, \<eta> a \<turnstile> \<^bold>\<bottom>]"
+abbreviation pECQw ("ECQw\<^sup>_ _") where "ECQw\<^sup>a \<eta> \<equiv> \<forall>b. [a, \<eta> a \<turnstile> \<eta> b]"
+abbreviation pECQm ("ECQm\<^sup>_ _") where "ECQm\<^sup>a \<eta> \<equiv>     [a, \<eta> a \<turnstile> \<eta> \<^bold>\<top>]"
+definition ECQ ::"'w \<Omega>" where  "ECQ \<eta> \<equiv> \<forall>a. ECQ\<^sup>a  \<eta>"
+definition ECQw::"'w \<Omega>" where "ECQw \<eta> \<equiv> \<forall>a. ECQw\<^sup>a \<eta>"
+definition ECQm::"'w \<Omega>" where "ECQm \<eta> \<equiv> \<forall>a. ECQm\<^sup>a \<eta>"
+declare ECQ_def[neg] ECQw_def[neg] ECQm_def[neg]
+
+text\<open>Explore some (non)entailment relations.\<close>
+lemma "ECQ  \<eta> \<Longrightarrow> ECQw \<eta>" unfolding neg conn order by blast
+lemma "ECQw \<eta> \<Longrightarrow> ECQ  \<eta>" nitpick oops \<comment>\<open> counterexample \<close>
+lemma "ECQw \<eta> \<Longrightarrow> ECQm \<eta>" unfolding neg by simp
+lemma "ECQm \<eta> \<Longrightarrow> ECQw \<eta>" nitpick oops \<comment>\<open> counterexample \<close>
+
+text\<open>LNC: law of non-contradiction.\<close>
+abbreviation pLNC  ("LNC\<^sup>_ _")  where "LNC\<^sup>a \<eta> \<equiv> [\<turnstile> \<eta>(a \<^bold>\<and> \<eta> a)]"
+definition LNC::"'w \<Omega>" where "LNC \<eta> \<equiv> \<forall>a. LNC\<^sup>a \<eta>"
+declare LNC_def[neg]
+
+text\<open>ECQ and LNC are in general independent.\<close>
+lemma "ECQ \<eta> \<Longrightarrow> LNC \<eta>" nitpick oops \<comment>\<open> counterexample \<close>
+lemma "LNC \<eta> \<Longrightarrow> ECQm \<eta>" nitpick oops \<comment>\<open> counterexample \<close>
+
+
+subsubsection \<open>Contraposition rules\<close>
+
+text\<open>CoP: contraposition (weak 'rule-like' variants).
+Variant 0 is antitonicity (ANTI). Variants 1-3 are stronger.\<close>
+abbreviation pCoP1 ("CoP1\<^sup>_\<^sup>_ _") where "CoP1\<^sup>a\<^sup>b \<eta> \<equiv> [a \<turnstile> \<eta> b] \<longrightarrow> [b \<turnstile> \<eta> a]"
+abbreviation pCoP2 ("CoP2\<^sup>_\<^sup>_ _") where "CoP2\<^sup>a\<^sup>b \<eta> \<equiv> [\<eta> a \<turnstile> b] \<longrightarrow> [\<eta> b \<turnstile> a]"
+abbreviation pCoP3 ("CoP3\<^sup>_\<^sup>_ _") where "CoP3\<^sup>a\<^sup>b \<eta> \<equiv> [\<eta> a \<turnstile> \<eta> b] \<longrightarrow> [b \<turnstile> a]"
+
+abbreviation CoP0 ::"'w \<Omega>" where "CoP0  \<eta> \<equiv> ANTI \<eta>"
+definition   CoP1 ::"'w \<Omega>" where "CoP1  \<eta> \<equiv> \<forall>a b. CoP1\<^sup>a\<^sup>b \<eta>"
+definition   CoP2 ::"'w \<Omega>" where "CoP2  \<eta> \<equiv> \<forall>a b. CoP2\<^sup>a\<^sup>b \<eta>"
+definition   CoP3 ::"'w \<Omega>" where "CoP3  \<eta> \<equiv> \<forall>a b. CoP3\<^sup>a\<^sup>b \<eta>"
+
+declare CoP1_def[neg] CoP2_def[neg] CoP3_def[neg]
+
+text\<open>Explore some (non)entailment relations.\<close>
+lemma "CoP1 \<eta> \<Longrightarrow> CoP0 \<eta>" unfolding ANTI_def CoP1_def using subset_char1 by blast
+lemma "CoP0 \<eta> \<Longrightarrow> CoP1 \<eta>" nitpick oops \<comment>\<open> counterexample \<close>
+lemma "CoP2 \<eta> \<Longrightarrow> CoP0 \<eta>" unfolding ANTI_def CoP2_def using subset_char1 by blast
+lemma "CoP0 \<eta> \<Longrightarrow> CoP2 \<eta>" nitpick oops \<comment>\<open> counterexample \<close>
+lemma "CoP3 \<eta> \<Longrightarrow> CoP0 \<eta>" oops (*TODO*)
+lemma "CoP0 \<eta> \<Longrightarrow> CoP3 \<eta>" nitpick oops \<comment>\<open> counterexample \<close>
+
+text\<open>All three strong variants are pairwise independent. However, CoP3 follows from CoP1 plus CoP2.\<close>
+lemma CoP123: "CoP1 \<eta> \<Longrightarrow> CoP2 \<eta> \<Longrightarrow> CoP3 \<eta>" unfolding neg order by smt
+text\<open>Taking all CoP together still leaves room for a boldly paraconsistent resp. paracomplete logic.\<close>
+lemma "CoP1 \<eta> \<Longrightarrow> CoP2 \<eta> \<Longrightarrow> ECQm \<eta>" nitpick oops \<comment>\<open> counterexample \<close> 
+lemma "CoP1 \<eta> \<Longrightarrow> CoP2 \<eta> \<Longrightarrow> TNDm \<eta>" nitpick oops \<comment>\<open> counterexample \<close> 
+
+
+subsubsection \<open>Modus tollens rules\<close>
+
+text\<open>MT: modus (tollendo) tollens (weak 'rule-like' variants).\<close>
+abbreviation pMT0 ("MT0\<^sup>_\<^sup>_ _") where "MT0\<^sup>a\<^sup>b \<eta> \<equiv> [a \<turnstile> b] \<and> [\<turnstile> \<eta> b] \<longrightarrow> [\<turnstile> \<eta> a]"
+abbreviation pMT1 ("MT1\<^sup>_\<^sup>_ _") where "MT1\<^sup>a\<^sup>b \<eta> \<equiv> [a \<turnstile> \<eta> b] \<and> [\<turnstile> b] \<longrightarrow> [\<turnstile> \<eta> a]"
+abbreviation pMT2 ("MT2\<^sup>_\<^sup>_ _") where "MT2\<^sup>a\<^sup>b \<eta> \<equiv> [\<eta> a \<turnstile> b] \<and> [\<turnstile> \<eta> b] \<longrightarrow> [\<turnstile> a]"
+abbreviation pMT3 ("MT3\<^sup>_\<^sup>_ _") where "MT3\<^sup>a\<^sup>b \<eta> \<equiv> [\<eta> a \<turnstile> \<eta> b] \<and> [\<turnstile> b] \<longrightarrow> [\<turnstile> a]"
+definition MT0::"'w \<Omega>" where "MT0 \<eta> \<equiv> \<forall>a b. MT0\<^sup>a\<^sup>b \<eta>"
+definition MT1::"'w \<Omega>" where "MT1 \<eta> \<equiv> \<forall>a b. MT1\<^sup>a\<^sup>b \<eta>"
+definition MT2::"'w \<Omega>" where "MT2 \<eta> \<equiv> \<forall>a b. MT2\<^sup>a\<^sup>b \<eta>"
+definition MT3::"'w \<Omega>" where "MT3 \<eta> \<equiv> \<forall>a b. MT3\<^sup>a\<^sup>b \<eta>"
+
+declare MT0_def[neg] MT1_def[neg] MT2_def[neg] MT3_def[neg]
+
+text\<open>Again, all MT variants are pairwise independent. We explore some (non)entailment relations.\<close>
+lemma "CoP0 \<eta> \<Longrightarrow> MT0 \<eta>" unfolding neg order cond conn by blast
+lemma "CoP1 \<eta> \<Longrightarrow> MT1 \<eta>" unfolding neg order conn by blast
+lemma "CoP2 \<eta> \<Longrightarrow> MT2 \<eta>" unfolding neg order conn by blast
+lemma "CoP3 \<eta> \<Longrightarrow> MT3 \<eta>" unfolding neg order conn by blast
+lemma "MT0 \<eta> \<Longrightarrow> MT1 \<eta> \<Longrightarrow> MT2 \<eta> \<Longrightarrow> MT3 \<eta> \<Longrightarrow> CoP0 \<eta>" nitpick oops \<comment>\<open> counterexample \<close>
+lemma "MT0 \<eta> \<Longrightarrow> MT1 \<eta> \<Longrightarrow> MT2 \<eta> \<Longrightarrow> MT3 \<eta> \<Longrightarrow> ECQm \<eta>" nitpick oops \<comment>\<open> counterexample \<close>
+lemma "MT0 \<eta> \<Longrightarrow> MT1 \<eta> \<Longrightarrow> MT2 \<eta> \<Longrightarrow> MT3 \<eta> \<Longrightarrow> TNDm \<eta>" nitpick oops \<comment>\<open> counterexample \<close>
+lemma MT123: "MT1 \<eta> \<Longrightarrow> MT2 \<eta> \<Longrightarrow> MT3 \<eta>"  unfolding neg order conn by metis
+
+
+subsubsection \<open>Double negation introduction and elimination\<close>
+
+text\<open>DNI/DNE: double negation introduction/elimination (strong 'axiom-like' variants).\<close>
+abbreviation pDNI ("DNI\<^sup>_ _") where "DNI\<^sup>a \<eta> \<equiv> [a \<turnstile> \<eta>(\<eta> a)]"
+abbreviation pDNE ("DNE\<^sup>_ _") where "DNE\<^sup>a \<eta> \<equiv> [\<eta>(\<eta> a) \<turnstile> a]"
+definition DNI::"'w \<Omega>" where "DNI \<eta> \<equiv> \<forall>a. DNI\<^sup>a \<eta>"
+definition DNE::"'w \<Omega>" where "DNE \<eta> \<equiv> \<forall>a. DNE\<^sup>a \<eta>"
+declare DNI_def[neg] DNE_def[neg]
+
+text\<open>CoP1 (resp. CoP2) can alternatively be defined as CoPw plus DNI (resp. DNE).\<close>
+lemma "DNI \<eta> \<Longrightarrow> CoP1 \<eta>" nitpick oops \<comment>\<open> counterexample \<close>
+lemma CoP1_def2: "CoP1 \<eta> = (CoP0 \<eta> \<and> DNI \<eta>)" unfolding neg cond using subset_char2 by blast
+lemma "DNE \<eta> \<Longrightarrow>  CoP2 \<eta>" nitpick oops \<comment>\<open> counterexample \<close>
+lemma CoP2_def2: "CoP2 \<eta> = (CoP0 \<eta> \<and> DNE \<eta>)" unfolding neg cond using subset_char1 by blast
+
+text\<open>Explore some non-entailment relations:\<close>
+lemma "DNI \<eta> \<Longrightarrow> DNE \<eta> \<Longrightarrow> CoP0 \<eta>" nitpick oops \<comment>\<open> counterexample \<close>
+lemma "DNI \<eta> \<Longrightarrow> DNE \<eta> \<Longrightarrow> TNDm \<eta>" nitpick oops \<comment>\<open> counterexample \<close>
+lemma "DNI \<eta> \<Longrightarrow> DNE \<eta> \<Longrightarrow> ECQm \<eta>" nitpick oops \<comment>\<open> counterexample \<close>
+lemma "DNI \<eta> \<Longrightarrow> DNE \<eta> \<Longrightarrow> MT0 \<eta>" nitpick oops \<comment>\<open> counterexample \<close>
+lemma "DNI \<eta> \<Longrightarrow> DNE \<eta> \<Longrightarrow> MT1 \<eta>" nitpick oops \<comment>\<open> counterexample \<close>
+lemma "DNI \<eta> \<Longrightarrow> DNE \<eta> \<Longrightarrow> MT2 \<eta>" nitpick oops \<comment>\<open> counterexample \<close>
+lemma "DNI \<eta> \<Longrightarrow> DNE \<eta> \<Longrightarrow> MT3 \<eta>" nitpick oops \<comment>\<open> counterexample \<close>
+
+text\<open>DNI/DNE: double negation introduction/elimination (weak 'rule-like' variants).\<close>
+abbreviation prDNI ("rDNI\<^sup>_ _") where "rDNI\<^sup>a \<eta> \<equiv> [\<turnstile> a] \<longrightarrow> [\<turnstile> \<eta>(\<eta> a)]"
+abbreviation prDNE ("rDNE\<^sup>_ _") where "rDNE\<^sup>a \<eta> \<equiv> [\<turnstile> \<eta>(\<eta> a)] \<longrightarrow> [\<turnstile> a]"
+definition rDNI::"'w \<Omega>" where "rDNI \<eta> \<equiv> \<forall>a. rDNI\<^sup>a \<eta>"
+definition rDNE::"'w \<Omega>" where "rDNE \<eta> \<equiv> \<forall>a. rDNE\<^sup>a \<eta>"
+declare rDNI_def[neg] rDNE_def[neg]
+
+text\<open>The 'rule-like' variants for DNI/DNE are strictly weaker than the 'axiom-like' ones.\<close>
+lemma "DNI \<eta> \<Longrightarrow> rDNI \<eta>" unfolding neg order conn by simp
+lemma "rDNI \<eta> \<Longrightarrow> DNI \<eta>" nitpick oops \<comment>\<open> counterexample \<close>
+lemma "DNE \<eta> \<Longrightarrow> rDNE \<eta>" unfolding neg order conn by blast
+lemma "rDNE \<eta> \<Longrightarrow> DNE \<eta>" nitpick oops \<comment>\<open> counterexample \<close>
+text\<open>The 'rule-like' variants for DNI/DNE follow already from modus tollens.\<close>
+lemma MT1_rDNI: "MT1 \<eta> \<Longrightarrow> rDNI \<eta>" unfolding neg order by blast
+lemma MT2_rDNE: "MT2 \<eta> \<Longrightarrow> rDNE \<eta>" unfolding neg order by blast
+
+
+subsubsection \<open>(Anti)Normality and its dual\<close>
+
+text\<open>nNORM (resp. nDNRM) is entailed by CoP1 (resp. CoP2). \<close>
+lemma CoP1_NORM: "CoP1 \<eta> \<Longrightarrow> nNORM \<eta>" unfolding neg cond conn order by simp
+lemma CoP2_DNRM: "CoP2 \<eta> \<Longrightarrow> nDNRM \<eta>" unfolding neg cond conn by (smt (verit) setequ_char subset_def)
+lemma "DNI \<eta> \<Longrightarrow> nNORM \<eta>" nitpick oops \<comment>\<open> counterexample \<close> 
+lemma "DNE \<eta> \<Longrightarrow> nDNRM \<eta>" nitpick oops \<comment>\<open> counterexample \<close> 
+text\<open>nNORM and nDNRM together entail the rule variant of DNI (rDNI).\<close>
+lemma nDNRM_rDNI: "nNORM \<eta> \<Longrightarrow> nDNRM \<eta> \<Longrightarrow> rDNI \<eta>" unfolding neg cond by (simp add: gtrue_def setequ_ext)
+lemma "nNORM \<eta> \<Longrightarrow> nDNRM \<eta> \<Longrightarrow> rDNE \<eta>" nitpick oops \<comment>\<open> counterexample \<close>
+
+
+subsubsection \<open>De Morgan laws\<close>
+
+text\<open>De Morgan laws correspond to anti-additivity and anti-multiplicativity).\<close>
+
+text\<open>DM3 (resp. DM4) are entailed by CoP0/ANTI together with DNE (resp. DNI).\<close>
+lemma CoP0_DNE_nMULTb: "CoP0 \<eta> \<Longrightarrow> DNE \<eta> \<Longrightarrow> nMULT\<^sup>b \<eta>" unfolding neg cond by (metis ANTI_def ANTI_nADDIb L12 nADDI_b_def subset_char1)
+lemma CoP0_DNI_nADDIa: "CoP0 \<eta> \<Longrightarrow> DNI \<eta> \<Longrightarrow> nADDI\<^sup>a \<eta>" unfolding neg cond by (metis ANTI_def ANTI_nMULTa L11 nMULT_a_def subset_char2)
+
+text\<open>From this follows that DM3 (resp. DM4) is entailed by CoP2 (resp. CoP1).\<close>
+lemma CoP2_nMULTb: "CoP2 \<eta> \<Longrightarrow> nMULT\<^sup>b \<eta>" by (simp add: CoP0_DNE_nMULTb CoP2_def2)
+lemma CoP1_nADDIa: "CoP1 \<eta> \<Longrightarrow> nADDI\<^sup>a \<eta>" by (simp add: CoP0_DNI_nADDIa CoP1_def2)
+   
+text\<open>Explore some non-entailment relations:\<close>
+lemma "CoP0 \<eta> \<Longrightarrow> nADDI\<^sup>a \<eta> \<Longrightarrow> nMULT\<^sup>b \<eta> \<Longrightarrow> nNORM \<eta> \<Longrightarrow> nDNRM \<eta> \<Longrightarrow> DNI \<eta>" nitpick oops \<comment>\<open> counterexample \<close>
+lemma "CoP0 \<eta> \<Longrightarrow> nADDI\<^sup>a \<eta> \<Longrightarrow> nMULT\<^sup>b \<eta> \<Longrightarrow> nNORM \<eta> \<Longrightarrow> nDNRM \<eta> \<Longrightarrow> DNE \<eta>" nitpick oops \<comment>\<open> counterexample \<close> 
+lemma "CoP0 \<eta> \<Longrightarrow> nADDI\<^sup>a \<eta> \<Longrightarrow> nMULT\<^sup>b \<eta> \<Longrightarrow> DNI \<eta> \<Longrightarrow> DNE \<eta> \<Longrightarrow> ECQm \<eta>" nitpick oops \<comment>\<open> counterexample \<close>
+lemma "CoP0 \<eta> \<Longrightarrow> nADDI\<^sup>a \<eta> \<Longrightarrow> nMULT\<^sup>b \<eta> \<Longrightarrow> DNI \<eta> \<Longrightarrow> DNE \<eta> \<Longrightarrow> TNDm \<eta>" nitpick oops \<comment>\<open> counterexample \<close> 
+
+subsubsection \<open>Strong contraposition (axiom-like)\<close>
+text\<open>Observe that the definitions below take implication as an additional parameter: \<iota>.\<close>
+
+text\<open>lCoP: (local) contraposition (strong 'axiom-like' variants, using local consequence).\<close>
+abbreviation plCoP0 ("lCoP0\<^sup>_\<^sup>_ _ _") where "lCoP0\<^sup>a\<^sup>b \<iota> \<eta> \<equiv> [\<iota> a b \<turnstile> \<iota> (\<eta> b) (\<eta> a)]"
+abbreviation plCoP1 ("lCoP1\<^sup>_\<^sup>_ _ _") where "lCoP1\<^sup>a\<^sup>b \<iota> \<eta> \<equiv> [\<iota> a (\<eta> b) \<turnstile> \<iota> b (\<eta> a)]"
+abbreviation plCoP2 ("lCoP2\<^sup>_\<^sup>_ _ _") where "lCoP2\<^sup>a\<^sup>b \<iota> \<eta> \<equiv> [\<iota> (\<eta> a) b \<turnstile> \<iota> (\<eta> b) a]"
+abbreviation plCoP3 ("lCoP3\<^sup>_\<^sup>_ _ _") where "lCoP3\<^sup>a\<^sup>b \<iota> \<eta> \<equiv> [\<iota> (\<eta> a) (\<eta> b) \<turnstile> \<iota> b a]"
+definition lCoP0::"('w \<sigma>\<Rightarrow>'w \<sigma>\<Rightarrow>'w \<sigma>) \<Rightarrow> 'w \<Omega>"  where "lCoP0  \<iota> \<eta> \<equiv> \<forall>a b. lCoP0\<^sup>a\<^sup>b \<iota> \<eta>"
+definition lCoP1::"('w \<sigma>\<Rightarrow>'w \<sigma>\<Rightarrow>'w \<sigma>) \<Rightarrow> 'w \<Omega>"  where "lCoP1  \<iota> \<eta> \<equiv> \<forall>a b. lCoP1\<^sup>a\<^sup>b \<iota> \<eta>"
+definition lCoP2::"('w \<sigma>\<Rightarrow>'w \<sigma>\<Rightarrow>'w \<sigma>) \<Rightarrow> 'w \<Omega>"  where "lCoP2  \<iota> \<eta> \<equiv> \<forall>a b. lCoP2\<^sup>a\<^sup>b \<iota> \<eta>"
+definition lCoP3::"('w \<sigma>\<Rightarrow>'w \<sigma>\<Rightarrow>'w \<sigma>) \<Rightarrow> 'w \<Omega>"  where "lCoP3  \<iota> \<eta> \<equiv> \<forall>a b. lCoP3\<^sup>a\<^sup>b \<iota> \<eta>"
+
+declare lCoP0_def[neg] lCoP1_def[neg] lCoP2_def[neg] lCoP3_def[neg]
+
+text\<open>All these contraposition variants are in general independent from each other.
+However if we employ classical implication we can verify some relationships.\<close>
+
+lemma lCoP1_def2: "lCoP1(\<^bold>\<rightarrow>) \<eta> = (lCoP0(\<^bold>\<rightarrow>) \<eta> \<and> DNI \<eta>)" unfolding neg conn order by metis
+lemma lCoP2_def2: "lCoP2(\<^bold>\<rightarrow>) \<eta> = (lCoP0(\<^bold>\<rightarrow>) \<eta> \<and> DNE \<eta>)" unfolding neg conn order by blast
+lemma "lCoP1(\<^bold>\<rightarrow>) \<eta> \<Longrightarrow> lCoP0(\<^bold>\<rightarrow>) \<eta>" unfolding neg conn order by blast
+lemma "lCoP0(\<^bold>\<rightarrow>) \<eta> \<Longrightarrow> lCoP1(\<^bold>\<rightarrow>) \<eta>" nitpick oops \<comment>\<open> counterexample \<close>
+lemma "lCoP2(\<^bold>\<rightarrow>) \<eta> \<Longrightarrow> lCoP0(\<^bold>\<rightarrow>) \<eta>" unfolding neg conn order by blast
+lemma "lCoP0(\<^bold>\<rightarrow>) \<eta> \<Longrightarrow> lCoP2(\<^bold>\<rightarrow>) \<eta>" nitpick oops \<comment>\<open> counterexample \<close>
+lemma "lCoP3(\<^bold>\<rightarrow>) \<eta> \<Longrightarrow> lCoP0(\<^bold>\<rightarrow>) \<eta>" unfolding neg conn order by blast
+lemma "lCoP0(\<^bold>\<rightarrow>) \<eta> \<Longrightarrow> lCoP3(\<^bold>\<rightarrow>) \<eta>" nitpick oops \<comment>\<open> counterexample \<close>
+lemma lCoP123: "lCoP1(\<^bold>\<rightarrow>) \<eta> \<and> lCoP2(\<^bold>\<rightarrow>) \<eta> \<Longrightarrow> lCoP3(\<^bold>\<rightarrow>) \<eta>" unfolding neg conn order by metis
+
+text\<open>Strong/axiom-like variants imply weak/rule-like ones as expected.\<close>
+lemma "lCoP0(\<^bold>\<rightarrow>) \<eta> \<Longrightarrow> CoP0 \<eta>" unfolding neg cond conn order by blast
+lemma "lCoP1(\<^bold>\<rightarrow>) \<eta> \<Longrightarrow> CoP1 \<eta>" unfolding neg conn order by blast
+lemma "lCoP2(\<^bold>\<rightarrow>) \<eta> \<Longrightarrow> CoP2 \<eta>" unfolding neg conn order by blast
+lemma "lCoP3(\<^bold>\<rightarrow>) \<eta> \<Longrightarrow> CoP3 \<eta>" unfolding neg conn order by blast
+
+text\<open>Explore some (non)entailment relations.\<close>
+lemma lCoP1_TND: "lCoP1(\<^bold>\<rightarrow>) \<eta> \<Longrightarrow> TND \<eta>" unfolding neg conn by (smt (verit, best) setequ_char subset_def)
+lemma "TND \<eta> \<Longrightarrow> lCoP1(\<^bold>\<rightarrow>) \<eta>" nitpick oops \<comment>\<open> counterexample \<close>
+lemma lCoP2_ECQ: "lCoP2(\<^bold>\<rightarrow>) \<eta> \<Longrightarrow> ECQ \<eta>" unfolding neg conn by (smt (verit) setequ_def subset_def)
+lemma "ECQ \<eta> \<Longrightarrow> lCoP2(\<^bold>\<rightarrow>) \<eta>" nitpick oops \<comment>\<open> counterexample \<close>
+
+
+subsubsection \<open>Local modus tollens axioms\<close>
+
+text\<open>lMT: (local) Modus tollens (strong, 'axiom-like' variants, using local consequence).\<close>
+abbreviation plMT0 ("lMT0\<^sup>_\<^sup>_ _ _") where "lMT0\<^sup>a\<^sup>b \<iota> \<eta> \<equiv> [\<iota> a b, \<eta> b \<turnstile> \<eta> a]"
+abbreviation plMT1 ("lMT1\<^sup>_\<^sup>_ _ _") where "lMT1\<^sup>a\<^sup>b \<iota> \<eta> \<equiv> [\<iota> a (\<eta> b), b \<turnstile> \<eta> a]"
+abbreviation plMT2 ("lMT2\<^sup>_\<^sup>_ _ _") where "lMT2\<^sup>a\<^sup>b \<iota> \<eta> \<equiv> [\<iota> (\<eta> a) b, \<eta> b \<turnstile> a]"
+abbreviation plMT3 ("lMT3\<^sup>_\<^sup>_ _ _") where "lMT3\<^sup>a\<^sup>b \<iota> \<eta> \<equiv> [\<iota> (\<eta> a) (\<eta> b), b \<turnstile> a]"
+definition lMT0::"('w \<sigma>\<Rightarrow>'w \<sigma>\<Rightarrow>'w \<sigma>) \<Rightarrow> 'w \<Omega>" where "lMT0 \<iota> \<eta> \<equiv> \<forall>a b. lMT0\<^sup>a\<^sup>b \<iota> \<eta>"
+definition lMT1::"('w \<sigma>\<Rightarrow>'w \<sigma>\<Rightarrow>'w \<sigma>) \<Rightarrow> 'w \<Omega>" where "lMT1 \<iota> \<eta> \<equiv> \<forall>a b. lMT1\<^sup>a\<^sup>b \<iota> \<eta>"
+definition lMT2::"('w \<sigma>\<Rightarrow>'w \<sigma>\<Rightarrow>'w \<sigma>) \<Rightarrow> 'w \<Omega>" where "lMT2 \<iota> \<eta> \<equiv> \<forall>a b. lMT2\<^sup>a\<^sup>b \<iota> \<eta>"
+definition lMT3::"('w \<sigma>\<Rightarrow>'w \<sigma>\<Rightarrow>'w \<sigma>) \<Rightarrow> 'w \<Omega>" where "lMT3 \<iota> \<eta> \<equiv> \<forall>a b. lMT3\<^sup>a\<^sup>b \<iota> \<eta>"
+  
+declare lMT0_def[neg] lMT1_def[neg] lMT2_def[neg] lMT3_def[neg]
+
+text\<open>All these MT variants are in general independent from each other and also from (strong) CoP instances.
+However if we take classical implication we can verify that local MT and CoP are indeed equivalent.\<close>
+lemma "lMT0(\<^bold>\<rightarrow>) \<eta> = lCoP0(\<^bold>\<rightarrow>) \<eta>" unfolding neg conn order by blast
+lemma "lMT1(\<^bold>\<rightarrow>) \<eta> = lCoP1(\<^bold>\<rightarrow>) \<eta>" unfolding neg conn order by blast
+lemma "lMT2(\<^bold>\<rightarrow>) \<eta> = lCoP2(\<^bold>\<rightarrow>) \<eta>" unfolding neg conn order by blast
+lemma "lMT3(\<^bold>\<rightarrow>) \<eta> = lCoP3(\<^bold>\<rightarrow>) \<eta>" unfolding neg conn order by blast
+
+
+subsubsection \<open>Disjunctive syllogism\<close>
+
+text\<open>DS: disjunctive syllogism.\<close>
+abbreviation pDS1 ("DS1\<^sup>_\<^sup>_ _ _") where "DS1\<^sup>a\<^sup>b \<iota> \<eta> \<equiv> [a \<^bold>\<or> b \<turnstile> \<iota> (\<eta> a) b]"
+abbreviation pDS2 ("DS2\<^sup>_\<^sup>_ _ _") where "DS2\<^sup>a\<^sup>b \<iota> \<eta> \<equiv> [\<iota> (\<eta> a) b \<turnstile> a \<^bold>\<or> b]"
+abbreviation pDS3 ("DS3\<^sup>_\<^sup>_ _ _") where "DS3\<^sup>a\<^sup>b \<iota> \<eta> \<equiv> [\<eta> a \<^bold>\<or> b \<turnstile> \<iota> a b]"
+abbreviation pDS4 ("DS4\<^sup>_\<^sup>_ _ _") where "DS4\<^sup>a\<^sup>b \<iota> \<eta> \<equiv> [\<iota> a b \<turnstile> \<eta> a \<^bold>\<or> b]"
+definition DS1::"('w \<sigma>\<Rightarrow>'w \<sigma>\<Rightarrow>'w \<sigma>) \<Rightarrow> 'w \<Omega>" where "DS1 \<iota> \<eta> \<equiv> \<forall>a b. DS1\<^sup>a\<^sup>b \<iota> \<eta>"
+definition DS2::"('w \<sigma>\<Rightarrow>'w \<sigma>\<Rightarrow>'w \<sigma>) \<Rightarrow> 'w \<Omega>" where "DS2 \<iota> \<eta> \<equiv> \<forall>a b. DS2\<^sup>a\<^sup>b \<iota> \<eta>"
+definition DS3::"('w \<sigma>\<Rightarrow>'w \<sigma>\<Rightarrow>'w \<sigma>) \<Rightarrow> 'w \<Omega>" where "DS3 \<iota> \<eta> \<equiv> \<forall>a b. DS3\<^sup>a\<^sup>b \<iota> \<eta>"
+definition DS4::"('w \<sigma>\<Rightarrow>'w \<sigma>\<Rightarrow>'w \<sigma>) \<Rightarrow> 'w \<Omega>" where "DS4 \<iota> \<eta> \<equiv> \<forall>a b. DS4\<^sup>a\<^sup>b \<iota> \<eta>"
+
+declare DS1_def[neg] DS2_def[neg] DS3_def[neg] DS4_def[neg]
+
+text\<open>All DS variants are in general independent from each other. However if we take classical implication
+we can verify that the pairs DS1-DS3 and DS2-DS4 are indeed equivalent. \<close>
+lemma "DS1(\<^bold>\<rightarrow>) \<eta> = DS3(\<^bold>\<rightarrow>) \<eta>" unfolding neg conn order by blast
+lemma "DS2(\<^bold>\<rightarrow>) \<eta> = DS4(\<^bold>\<rightarrow>) \<eta>" unfolding neg conn order by blast
+
+text\<open>Explore some (non)entailment relations.\<close>
+lemma DS1_nDNor: "DS1(\<^bold>\<rightarrow>) \<eta> \<Longrightarrow> nDNRM \<eta>" unfolding neg cond conn order by metis
+lemma DS2_nNor:  "DS2(\<^bold>\<rightarrow>) \<eta> \<Longrightarrow> nNORM \<eta>" unfolding neg cond conn order by metis
+lemma lCoP2_DS1: "lCoP2(\<^bold>\<rightarrow>) \<eta> \<Longrightarrow> DS1(\<^bold>\<rightarrow>) \<eta>" unfolding neg conn order by blast
+lemma lCoP1_DS2: "lCoP1(\<^bold>\<rightarrow>) \<eta> \<Longrightarrow> DS2(\<^bold>\<rightarrow>) \<eta>" unfolding neg conn order by blast
+lemma "CoP2 \<eta> \<Longrightarrow> DS1(\<^bold>\<rightarrow>) \<eta>" nitpick oops \<comment>\<open> counterexample \<close>
+lemma "CoP1 \<eta> \<Longrightarrow> DS2(\<^bold>\<rightarrow>) \<eta>" nitpick oops \<comment>\<open> counterexample \<close>
+
+end
diff --git a/thys/Topological_Semantics/logics_operators.thy b/thys/Topological_Semantics/logics_operators.thy
new file mode 100644
--- /dev/null
+++ b/thys/Topological_Semantics/logics_operators.thy
@@ -0,0 +1,77 @@
+theory logics_operators
+  imports conditions_positive
+begin
+
+subsection \<open>Converting between topological operators\<close>
+
+text\<open>We verify minimal conditions under which operators resulting from conversion functions coincide.\<close>
+
+text\<open>Conversions between interior, closure and exterior are straightforward and hold without restrictions: 
+  Interior and closure are each other duals. Exterior is the complement of closure.
+  We focus here on conversions involving the border and frontier operators.\<close>
+
+text\<open>Interior operator as derived from border.\<close>
+definition Int_br::"('w \<sigma>\<Rightarrow>'w \<sigma>)\<Rightarrow>('w \<sigma>\<Rightarrow>'w \<sigma>)" ("\<I>\<^sub>B") 
+  where "\<I>\<^sub>B \<B> \<equiv> \<lambda>A. A \<^bold>\<leftharpoonup> (\<B> A)"
+text\<open>Interior operator as derived from frontier.\<close>
+definition Int_fr::"('w \<sigma>\<Rightarrow>'w \<sigma>)\<Rightarrow>('w \<sigma>\<Rightarrow>'w \<sigma>)" ("\<I>\<^sub>F") 
+  where "\<I>\<^sub>F \<F> \<equiv> \<lambda>A. A \<^bold>\<leftharpoonup> (\<F> A)"
+text\<open>Closure operator as derived from border.\<close>
+definition Cl_br::"('w \<sigma>\<Rightarrow>'w \<sigma>)\<Rightarrow>('w \<sigma>\<Rightarrow>'w \<sigma>)" ("\<C>\<^sub>B") 
+  where "\<C>\<^sub>B \<B> \<equiv> \<lambda>A. A \<^bold>\<or> \<B>(\<^bold>\<midarrow>A)"
+text\<open>Closure operator as derived from frontier.\<close>
+definition Cl_fr::"('w \<sigma>\<Rightarrow>'w \<sigma>)\<Rightarrow>('w \<sigma>\<Rightarrow>'w \<sigma>)" ("\<C>\<^sub>F") 
+  where "\<C>\<^sub>F \<F> \<equiv> \<lambda>A. A \<^bold>\<or> (\<F> A)"
+text\<open>Frontier operator as derived from interior.\<close>
+definition Fr_int::"('w \<sigma>\<Rightarrow>'w \<sigma>)\<Rightarrow>('w \<sigma>\<Rightarrow>'w \<sigma>)" ("\<F>\<^sub>I") 
+  where "\<F>\<^sub>I \<I> \<equiv> \<lambda>A. \<^bold>\<midarrow>(\<I> A \<^bold>\<or> \<I>(\<^bold>\<midarrow>A))"
+text\<open>Frontier operator as derived from closure.\<close>
+definition Fr_cl::"('w \<sigma>\<Rightarrow>'w \<sigma>)\<Rightarrow>('w \<sigma>\<Rightarrow>'w \<sigma>)" ("\<F>\<^sub>C") 
+  where "\<F>\<^sub>C \<C> \<equiv> \<lambda>A. (\<C> A) \<^bold>\<and> \<C>(\<^bold>\<midarrow>A)"
+text\<open>Frontier operator as derived from border.\<close>
+definition Fr_br::"('w \<sigma>\<Rightarrow>'w \<sigma>)\<Rightarrow>('w \<sigma>\<Rightarrow>'w \<sigma>)" ("\<F>\<^sub>B") 
+  where "\<F>\<^sub>B \<B> \<equiv> \<lambda>A. \<B> A \<^bold>\<or> \<B>(\<^bold>\<midarrow>A)"
+text\<open>Border operator as derived from interior.\<close>
+definition Br_int::"('w \<sigma>\<Rightarrow>'w \<sigma>)\<Rightarrow>('w \<sigma>\<Rightarrow>'w \<sigma>)" ("\<B>\<^sub>I") 
+  where "\<B>\<^sub>I \<I> \<equiv> \<lambda>A. A \<^bold>\<leftharpoonup> (\<I> A)"
+text\<open>Border operator as derived from closure.\<close>
+definition Br_cl::"('w \<sigma>\<Rightarrow>'w \<sigma>)\<Rightarrow>('w \<sigma>\<Rightarrow>'w \<sigma>)" ("\<B>\<^sub>C")  
+  where "\<B>\<^sub>C \<C> \<equiv> \<lambda>A. A \<^bold>\<and> \<C>(\<^bold>\<midarrow>A)"
+text\<open>Border operator as derived from frontier.\<close>
+definition Br_fr::"('w \<sigma>\<Rightarrow>'w \<sigma>)\<Rightarrow>('w \<sigma>\<Rightarrow>'w \<sigma>)" ("\<B>\<^sub>F") 
+  where "\<B>\<^sub>F \<F> \<equiv> \<lambda>A. A \<^bold>\<and> (\<F> A)"
+
+text\<open>Inter-definitions involving border or frontier do not hold without restrictions.\<close>
+lemma "\<B> = \<B>\<^sub>C (\<C>\<^sub>B \<B>)" nitpick oops \<comment>\<open> countermodel \<close>
+lemma "\<B> = \<B>\<^sub>I (\<I>\<^sub>B \<B>)" nitpick oops \<comment>\<open> countermodel \<close>
+lemma "\<B> = \<B>\<^sub>F (\<F>\<^sub>B \<B>)" nitpick oops \<comment>\<open> countermodel \<close>
+lemma "\<F> = \<F>\<^sub>C (\<C>\<^sub>F \<F>)" nitpick oops \<comment>\<open> countermodel \<close>
+lemma "\<F> = \<F>\<^sub>I (\<I>\<^sub>F \<F>)" nitpick oops \<comment>\<open> countermodel \<close>
+lemma "\<F> = \<F>\<^sub>B (\<B>\<^sub>F \<F>)" nitpick oops \<comment>\<open> countermodel \<close>
+
+lemma "\<C> = \<C>\<^sub>B (\<B>\<^sub>C \<C>)" nitpick oops \<comment>\<open> countermodel \<close>
+lemma "\<C> = \<C>\<^sub>F (\<F>\<^sub>C \<C>)" nitpick oops \<comment>\<open> countermodel \<close>
+lemma "\<I> = \<I>\<^sub>B (\<B>\<^sub>C \<I>)" nitpick oops \<comment>\<open> countermodel \<close>
+lemma "\<I> = \<I>\<^sub>F (\<F>\<^sub>C \<I>)" nitpick oops \<comment>\<open> countermodel \<close>
+
+
+text\<open>Inter-definitions involving border or frontier always assume the second Kuratowski condition 
+  (or its respective counterpart: C2, I2, B2 or F2).\<close>
+abbreviation "C2 \<phi> \<equiv> EXPN \<phi>"
+abbreviation "I2 \<phi> \<equiv> CNTR \<phi>"
+abbreviation "B2 \<phi> \<equiv> CNTR \<phi>"
+abbreviation "F2 \<phi> \<equiv> \<forall>A. \<phi>(\<^bold>\<midarrow>A) \<^bold>= \<phi> A"
+
+lemma "B2 \<B> \<Longrightarrow> \<B> = \<B>\<^sub>C (\<C>\<^sub>B \<B>)" unfolding CNTR_def Br_cl_def Cl_br_def conn order by metis
+lemma "B2 \<B> \<Longrightarrow> \<B> = \<B>\<^sub>I (\<I>\<^sub>B \<B>)" unfolding CNTR_def Br_int_def Int_br_def conn order by metis
+lemma "B2 \<B> \<Longrightarrow> \<B> = \<B>\<^sub>F (\<F>\<^sub>B \<B>)" unfolding CNTR_def Br_fr_def Fr_br_def conn order by metis
+lemma "F2 \<F> \<Longrightarrow> \<F> = \<F>\<^sub>C (\<C>\<^sub>F \<F>)" unfolding Cl_fr_def Fr_cl_def conn order by metis
+lemma "F2 \<F> \<Longrightarrow> \<F> = \<F>\<^sub>I (\<I>\<^sub>F \<F>)" unfolding Int_fr_def Fr_int_def conn order by metis
+lemma "F2 \<F> \<Longrightarrow> \<F> = \<F>\<^sub>B (\<B>\<^sub>F \<F>)" unfolding Br_fr_def Fr_br_def conn order by metis
+
+lemma "C2 \<C> \<Longrightarrow> \<C> = \<C>\<^sub>B (\<B>\<^sub>C \<C>)" unfolding EXPN_def Br_cl_def Cl_br_def conn order by metis
+lemma "C2 \<C> \<Longrightarrow> \<C> = \<C>\<^sub>F (\<F>\<^sub>C \<C>)" unfolding EXPN_def Fr_cl_def Cl_fr_def conn order by metis
+lemma "I2 \<I> \<Longrightarrow> \<I> = \<I>\<^sub>B (\<B>\<^sub>I \<I>)" unfolding CNTR_def Int_br_def Br_int_def conn order by metis
+lemma "I2 \<I> \<Longrightarrow> \<I> = \<I>\<^sub>F (\<F>\<^sub>I \<I>)" unfolding CNTR_def Int_fr_def Fr_int_def conn order by metis
+
+end
diff --git a/thys/Topological_Semantics/logics_quantifiers.thy b/thys/Topological_Semantics/logics_quantifiers.thy
new file mode 100644
--- /dev/null
+++ b/thys/Topological_Semantics/logics_quantifiers.thy
@@ -0,0 +1,99 @@
+theory logics_quantifiers
+  imports boolean_algebra_infinitary
+begin
+
+subsection \<open>Quantifiers (restricted and unrestricted)\<close>
+
+text\<open>Introduce pedagogically convenient notation.\<close>
+notation HOL.All ("\<Pi>") notation HOL.Ex ("\<Sigma>")
+
+text\<open>Let us recall that in HOL we have: \<close>
+lemma "(\<forall>x. P) = \<Pi>(\<lambda>x. P)" by simp
+lemma "(\<exists>x. P) = \<Sigma>(\<lambda>x. P)" by simp
+lemma "\<Sigma> = (\<lambda>P. \<not>\<Pi>(\<lambda>x. \<not>P x))" by simp
+
+text\<open>We can introduce their respective 'w-type-lifted variants as follows: \<close>
+definition mforall::"('i\<Rightarrow>'w \<sigma>)\<Rightarrow>'w \<sigma>" ("\<^bold>\<Pi>_")
+  where "\<^bold>\<Pi>\<phi> \<equiv> \<lambda>w. \<forall>X. \<phi> X w"
+definition mexists::"('i\<Rightarrow>'w \<sigma>)\<Rightarrow>'w \<sigma>" ("\<^bold>\<Sigma>_") 
+  where "\<^bold>\<Sigma>\<phi> \<equiv> \<lambda>w. \<exists>X. \<phi> X w"
+
+text\<open>To improve readability, we introduce for them standard binder notation.\<close>
+notation mforall (binder "\<^bold>\<forall>" [48]49)  notation mexists (binder "\<^bold>\<exists>" [48]49) 
+
+text\<open>And thus we obtain the 'w-type-lifted variant of the standard (variable-binding) quantifiers.\<close>
+lemma "(\<^bold>\<forall>X. \<phi>) = \<^bold>\<Pi>(\<lambda>X. \<phi>)" by (simp add: mforall_def)
+lemma "(\<^bold>\<exists>X. \<phi>) = \<^bold>\<Sigma>(\<lambda>X. \<phi>)" by (simp add: mexists_def)
+
+text\<open>Quantifiers are dual to each other in the expected way.\<close>
+lemma "\<^bold>\<Pi>\<phi> = \<^bold>\<midarrow>(\<^bold>\<Sigma>\<phi>\<^sup>-)" by (simp add: compl_def mexists_def mforall_def svfun_compl_def)
+lemma "(\<^bold>\<forall>X. \<phi> X) = \<^bold>\<midarrow>(\<^bold>\<exists>X. \<^bold>\<midarrow>(\<phi> X))" by (simp add: compl_def mexists_def mforall_def)
+
+text\<open>Relationship between quantifiers and the infinitary supremum and infimum operations.\<close>
+lemma mforall_char: "\<^bold>\<Pi>\<phi> = \<^bold>\<And>\<lbrakk>\<phi> _\<rbrakk>" unfolding infimum_def mforall_def range_def by metis
+lemma mexists_char:  "\<^bold>\<Sigma>\<phi> = \<^bold>\<Or>\<lbrakk>\<phi> _\<rbrakk>" unfolding supremum_def mexists_def range_def by metis
+(*Using binder notation:*)
+lemma mforallb_char: "(\<^bold>\<forall>X. \<phi>) = \<^bold>\<And>\<lbrakk>(\<lambda>X. \<phi>) _\<rbrakk>" unfolding infimum_def mforall_def range_def by simp
+lemma mexistsb_char: "(\<^bold>\<exists>X. \<phi>) = \<^bold>\<Or>\<lbrakk>(\<lambda>X. \<phi>) _\<rbrakk>" unfolding supremum_def mexists_def range_def by simp
+
+
+text\<open>We now consider quantification restricted over constant and varying domains.\<close>
+
+text\<open>Constant domains: first generalization of quantifiers above (e.g. free logic).\<close>
+definition mforall_const::"'i \<sigma> \<Rightarrow> ('i \<Rightarrow> 'w \<sigma>) \<Rightarrow> 'w \<sigma>" ("\<^bold>\<Pi>[_]_") 
+  where "\<^bold>\<Pi>[D]\<phi> \<equiv> \<lambda>w. \<forall>X. (D X) \<longrightarrow> (\<phi> X) w" 
+definition mexists_const::"'i \<sigma> \<Rightarrow> ('i \<Rightarrow> 'w \<sigma>) \<Rightarrow> 'w \<sigma>" ("\<^bold>\<Sigma>[_]_") 
+  where "\<^bold>\<Sigma>[D]\<phi> \<equiv> \<lambda>w. \<exists>X. (D X)  \<and>  (\<phi> X) w"
+
+(*Alas! the convenient binder notation cannot be easily introduced for restricted quantifiers.*)
+
+text\<open>Constant-domain quantification generalises its unrestricted counterpart.\<close>
+lemma "\<^bold>\<Pi>\<phi> = \<^bold>\<Pi>[\<^bold>\<top>]\<phi>" by (simp add: mforall_const_def mforall_def top_def)
+lemma "\<^bold>\<Sigma>\<phi> = \<^bold>\<Sigma>[\<^bold>\<top>]\<phi>" by (simp add: mexists_const_def mexists_def top_def)
+
+text\<open>Constant-domain quantification can also be characterised using infimum and supremum.\<close>
+lemma mforall_const_char: "\<^bold>\<Pi>[D]\<phi> = \<^bold>\<And>\<lbrakk>\<phi> D\<rbrakk>" unfolding image_def infimum_def mforall_const_def by metis
+lemma mexists_const_char: "\<^bold>\<Sigma>[D]\<phi> = \<^bold>\<Or>\<lbrakk>\<phi> D\<rbrakk>" unfolding image_def supremum_def mexists_const_def by metis
+
+text\<open>Constant-domain quantifiers also  allow us to nicely characterize the interaction between
+ function composition and (restricted) quantification:\<close>
+lemma mforall_comp: "\<^bold>\<Pi>(\<phi>\<circ>\<psi>) = \<^bold>\<Pi>[\<lbrakk>\<psi> _\<rbrakk>] \<phi>" unfolding fun_comp_def mforall_const_def mforall_def range_def by metis
+lemma mexists_comp: "\<^bold>\<Sigma>(\<phi>\<circ>\<psi>) = \<^bold>\<Sigma>[\<lbrakk>\<psi> _\<rbrakk>] \<phi>" unfolding fun_comp_def mexists_const_def mexists_def range_def by metis
+
+
+text\<open>Varying domains: we can also restrict quantifiers by taking a 'functional domain' as additional parameter.
+The latter is a set-valued mapping each element 'i to a set of points (e.g. where it 'exists').\<close>
+definition mforall_var::"('i \<Rightarrow> 'w \<sigma>) \<Rightarrow> ('i \<Rightarrow> 'w \<sigma>) \<Rightarrow> 'w \<sigma>" ("\<^bold>\<Pi>{_}_") 
+  where "\<^bold>\<Pi>{\<psi>}\<phi> \<equiv> \<lambda>w. \<forall>X. (\<psi> X) w \<longrightarrow> (\<phi> X) w" 
+definition mexists_var::"('i \<Rightarrow> 'w \<sigma>) \<Rightarrow> ('i \<Rightarrow> 'w \<sigma>) \<Rightarrow> 'w \<sigma>" ("\<^bold>\<Sigma>{_}_") 
+  where "\<^bold>\<Sigma>{\<psi>}\<phi> \<equiv> \<lambda>w. \<exists>X. (\<psi> X) w  \<and>  (\<phi> X) w"
+
+text\<open>Varying-domain quantification generalizes its constant-domain counterpart.\<close>
+lemma "\<^bold>\<Pi>[D]\<phi> = \<^bold>\<Pi>{D\<upharpoonleft>}\<phi>" by (simp add: mforall_const_def mforall_var_def)
+lemma "\<^bold>\<Sigma>[D]\<phi> = \<^bold>\<Sigma>{D\<upharpoonleft>}\<phi>" by (simp add: mexists_const_def mexists_var_def)
+
+text\<open>Restricted quantifiers are dual to each other in the expected way.\<close>
+lemma "\<^bold>\<Pi>[D]\<phi> = \<^bold>\<midarrow>(\<^bold>\<Sigma>[D]\<phi>\<^sup>-)" by (metis iDM_b im_prop2 mexists_const_char mforall_const_char setequ_ext)
+lemma "\<^bold>\<Pi>{\<psi>}\<phi> = \<^bold>\<midarrow>(\<^bold>\<Sigma>{\<psi>}\<phi>\<^sup>-)" by (simp add: compl_def mexists_var_def mforall_var_def svfun_compl_def)
+
+text\<open>We can use 2nd-order connectives on set-valued functions to encode restricted quantifiers as unrestricted.\<close>
+lemma "\<^bold>\<Pi>{\<psi>}\<phi> = \<^bold>\<Pi>(\<psi> \<^bold>\<rightarrow>\<^sup>: \<phi>)" by (simp add: impl_def mforall_def mforall_var_def svfun_impl_def)
+lemma "\<^bold>\<Sigma>{\<psi>}\<phi> = \<^bold>\<Sigma>(\<psi> \<^bold>\<and>\<^sup>: \<phi>)" by (simp add: meet_def mexists_def mexists_var_def svfun_meet_def)
+
+text\<open>Observe that using these operators has the advantage of allowing for binder notation.\<close>
+lemma "\<^bold>\<Pi>{\<psi>}\<phi> = (\<^bold>\<forall>X. (\<psi> \<^bold>\<rightarrow>\<^sup>: \<phi>) X)" by (simp add: impl_def mforall_def mforall_var_def svfun_impl_def)
+lemma "\<^bold>\<Sigma>{\<psi>}\<phi> = (\<^bold>\<exists>X. (\<psi> \<^bold>\<and>\<^sup>: \<phi>) X)" by (simp add: meet_def mexists_def mexists_var_def svfun_meet_def)
+
+text\<open>To sumarize: different sorts of restricted quantification can be emulated 
+  by employing 2nd-order operations to adequately relativize predicates.\<close>
+lemma "\<^bold>\<Pi>[D]\<phi> = (\<^bold>\<forall>X. (D\<upharpoonleft> \<^bold>\<rightarrow>\<^sup>: \<phi>) X)" by (simp add: impl_def mforall_const_def mforall_def svfun_impl_def)
+lemma "\<^bold>\<Pi>{\<^bold>\<top>\<^sup>:}\<phi> = (\<^bold>\<forall>X. (\<^bold>\<top>\<^sup>: \<^bold>\<rightarrow>\<^sup>: \<phi>) X)" by (simp add: impl_def mforall_def mforall_var_def svfun_impl_def)
+lemma "\<^bold>\<Pi>\<phi> = \<^bold>\<Pi>{\<^bold>\<top>\<^sup>:}\<phi>" by (simp add: mforall_def mforall_var_def svfun_top_def top_def)
+lemma "(\<^bold>\<forall>X. \<phi> X) = \<^bold>\<Pi>{\<^bold>\<top>\<^sup>:}\<phi>" by (simp add: mforall_def mforall_var_def svfun_top_def top_def)
+
+named_theorems quant (*to group together definitions related to quantification*)
+declare mforall_def[quant] mexists_def[quant]
+        mforall_const_def[quant] mexists_const_def[quant]
+        mforall_var_def[quant] mexists_var_def[quant]
+
+end
diff --git a/thys/Topological_Semantics/logics_quantifiers_example.thy b/thys/Topological_Semantics/logics_quantifiers_example.thy
new file mode 100644
--- /dev/null
+++ b/thys/Topological_Semantics/logics_quantifiers_example.thy
@@ -0,0 +1,64 @@
+theory logics_quantifiers_example
+  imports logics_quantifiers conditions_positive_infinitary
+begin
+
+subsection \<open>Examples on Quantifiers\<close>
+
+text\<open>First-order quantification example.\<close>
+lemma "(\<forall>x. A x \<longrightarrow> (\<exists>y. B x y)) \<longleftrightarrow> (\<forall>x. \<exists>y. A x \<longrightarrow> B x y)" by simp
+lemma "(\<^bold>\<forall>x. A x  \<^bold>\<rightarrow> (\<^bold>\<exists>y. B x y))  \<^bold>= (\<^bold>\<forall>x. \<^bold>\<exists>y. A x  \<^bold>\<rightarrow>  B x y)" by (simp add: impl_def mexists_def setequ_def)
+
+text\<open>Propositional quantification example.\<close>
+lemma "\<forall>A. (\<exists>B. (A \<longleftrightarrow> \<not>B))" by blast
+lemma "(\<^bold>\<forall>A. (\<^bold>\<exists>B. A  \<^bold>\<leftrightarrow> \<^bold>\<midarrow>B)) \<^bold>= \<^bold>\<top>" unfolding mforall_def mexists_def by (smt (verit) compl_def dimpl_def setequ_def top_def)
+
+text\<open>Drinker's principle.\<close>
+lemma "\<^bold>\<exists>x. Drunk x \<^bold>\<rightarrow> (\<^bold>\<forall>y. Drunk y) \<^bold>= \<^bold>\<top>"
+  by (simp add: impl_def mexists_def mforall_def setequ_def top_def)
+
+text\<open>Example in non-classical logics.\<close>
+typedecl w 
+type_synonym \<sigma> = "(w \<sigma>)"
+
+consts \<C>::"\<sigma> \<Rightarrow> \<sigma>"
+abbreviation "\<I> \<equiv> \<C>\<^sup>d"
+abbreviation "CLOSURE \<phi> \<equiv> ADDI \<phi> \<and> EXPN \<phi> \<and> NORM \<phi> \<and> IDEM \<phi>"
+abbreviation "INTERIOR \<phi> \<equiv> MULT \<phi> \<and> CNTR \<phi> \<and> DNRM \<phi> \<and> IDEM \<phi>"
+
+definition mforallInt::"(\<sigma> \<Rightarrow> \<sigma>) \<Rightarrow> \<sigma>" ("\<^bold>\<Pi>\<^sup>I_") 
+  where "\<^bold>\<Pi>\<^sup>I\<phi> \<equiv> \<^bold>\<Pi>[fp \<I>]\<phi>"
+definition mexistsInt::"(\<sigma> \<Rightarrow> \<sigma>) \<Rightarrow> \<sigma>" ("\<^bold>\<Sigma>\<^sup>I_") 
+  where "\<^bold>\<Sigma>\<^sup>I\<phi> \<equiv> \<^bold>\<Sigma>[fp \<I>]\<phi>"
+
+(*To improve readability, we introduce for them standard binder notation.*)
+notation mforallInt (binder "\<^bold>\<forall>\<^sup>I" [48]49) 
+notation mexistsInt (binder "\<^bold>\<exists>\<^sup>I" [48]49) 
+
+abbreviation intneg ("\<^bold>\<not>\<^sup>I_") where "\<^bold>\<not>\<^sup>IA \<equiv> \<I>\<^sup>d\<^sup>- A"
+abbreviation parneg ("\<^bold>\<not>\<^sup>C_") where "\<^bold>\<not>\<^sup>CA \<equiv> \<C>\<^sup>d\<^sup>- A"
+
+lemma "(\<^bold>\<forall>X. (\<^bold>\<exists>B. (X  \<^bold>\<leftrightarrow> \<^bold>\<midarrow>B))) \<^bold>= \<^bold>\<top>" by (smt (verit, del_insts) compl_def dimpl_def mexists_def mforall_def setequ_def top_def)
+lemma "(\<^bold>\<forall>\<^sup>IX. (\<^bold>\<exists>\<^sup>IB. (X  \<^bold>\<leftrightarrow> \<^bold>\<not>\<^sup>IB))) \<^bold>= \<^bold>\<top>" nitpick oops \<comment>\<open> counterexample \<close>
+
+
+subsection \<open>Barcan formula and its converse\<close>
+
+text\<open>The converse Barcan formula follows readily from monotonicity.\<close>
+lemma CBarcan1: "MONO \<phi> \<Longrightarrow> \<forall>\<pi>.  \<phi>(\<^bold>\<forall>x. \<pi> x)  \<^bold>\<le> (\<^bold>\<forall>x. \<phi>(\<pi> x))" by (smt (verit, ccfv_SIG) MONO_def mforall_def subset_def)
+lemma CBarcan2: "MONO \<phi> \<Longrightarrow> \<forall>\<pi>. (\<^bold>\<exists>x. \<phi>(\<pi> x)) \<^bold>\<le> \<phi>(\<^bold>\<exists>x. \<pi> x)" by (smt (verit) MONO_def mexists_def subset_def)
+
+text\<open>However, the Barcan formula requires a stronger assumption (of an infinitary character).\<close>
+lemma Barcan1: "iMULT\<^sup>b \<phi> \<Longrightarrow> \<forall>\<pi>. (\<^bold>\<forall>x. \<phi>(\<pi> x)) \<^bold>\<le> \<phi>(\<^bold>\<forall>x. \<pi> x)" unfolding iMULT_b_def by (smt (verit) infimum_def mforall_char image_def range_char1 subset_def)
+lemma Barcan2: "iADDI\<^sup>a \<phi> \<Longrightarrow> \<forall>\<pi>. \<phi>(\<^bold>\<exists>x. \<pi> x) \<^bold>\<le> (\<^bold>\<exists>x. \<phi>(\<pi> x))" unfolding iADDI_a_def by (smt (verit, ccfv_threshold) mexists_char image_def range_char1 subset_def supremum_def)
+
+text\<open>Converse Barcan Formula and composition.\<close>
+lemma "MONO \<phi> \<Longrightarrow> \<forall>\<pi>.  \<phi>(\<^bold>\<Pi> \<pi>) \<^bold>\<le> \<^bold>\<Pi>(\<phi> \<circ> \<pi>)" by (metis MONO_iMULTa iMULT_a_def mforall_char mforall_comp mforall_const_char)
+lemma "MONO \<phi> \<Longrightarrow> \<forall>\<pi>.  \<phi>(\<^bold>\<Pi>[D] \<pi>) \<^bold>\<le> \<^bold>\<Pi>[D](\<phi> \<circ> \<pi>)"  by (smt (verit) MONO_iMULTa fun_comp_def iMULT_a_def mforall_const_char mforall_const_def image_def subset_def)
+lemma "CNTR \<phi> \<Longrightarrow> iMULT \<phi> \<Longrightarrow> IDEM \<phi> \<Longrightarrow>  \<forall>\<pi>.  \<phi>(\<^bold>\<Pi>{\<psi>} \<pi>) \<^bold>\<le> \<^bold>\<Pi>{\<psi>}(\<phi> \<circ> \<pi>)" nitpick oops \<comment>\<open> counterexample \<close>
+
+text\<open>Barcan Formula and composition.\<close>
+lemma "iMULT\<^sup>b \<phi> \<Longrightarrow> \<forall>\<pi>. \<^bold>\<Pi>(\<phi> \<circ> \<pi>) \<^bold>\<le> \<phi>(\<^bold>\<Pi> \<pi>)" by (metis iMULT_b_def mforall_char mforall_comp mforall_const_char)
+lemma "iMULT\<^sup>b \<phi> \<Longrightarrow> \<forall>\<pi>. \<^bold>\<Pi>[D](\<phi> \<circ> \<pi>) \<^bold>\<le> \<phi>(\<^bold>\<Pi>[D] \<pi>)" by (smt (verit) fun_comp_def iMULT_b_def infimum_def mforall_const_char image_def subset_def)
+lemma "iADDI \<phi> \<Longrightarrow> iMULT \<phi> \<Longrightarrow> \<forall>\<pi>. \<^bold>\<Pi>{\<psi>}(\<phi> \<circ> \<pi>) \<^bold>\<le> \<phi>(\<^bold>\<Pi>{\<psi>} \<pi>)" nitpick oops \<comment>\<open> counterexample \<close>
+
+end