section "Fixed Points"

theory fixedpoints
  imports Main
begin

lemma exists_maximal_element:
  fixes S :: "'a::complete_lattice set"
  assumes "finite S"
    and "S \<noteq> {}"
  shows "\<exists>max. max \<in> S \<and> (\<forall>v\<in>S. \<not>(v>max))"
  using \<open>finite S\<close> \<open>S \<noteq> {}\<close> proof (induct rule: finite_induct)
  case empty
  then show ?case by simp
next
  case (insert x F)
  show ?case
  proof (cases "F = {}")
    case True
    then show ?thesis by simp
  next
    case False
    from this
    obtain F_max where "F_max \<in> F" and "\<forall>v\<in>F. \<not>(v > F_max)"
      using insert.hyps(3) by blast

    show ?thesis
    proof (cases "x > F_max")
      case True
      then show ?thesis
        by (metis \<open>\<forall>v\<in>F. \<not> F_max < v\<close> insert_iff le_less_trans less_le)

    next
      case False
      then show ?thesis
        using \<open>F_max \<in> F\<close> \<open>\<forall>v\<in>F. \<not> F_max < v\<close> by blast
    qed

  qed
qed

lemma exists_fixpoint:
  fixes s :: "nat \<Rightarrow> 'a::{complete_lattice}"
  assumes incr_seq: "\<And>i j. i\<le>j \<Longrightarrow> s i \<le> s j"
    and finite_range: "finite (range s)"
  shows "\<exists>i. \<forall>j\<ge>i. s j = s i"

proof (rule ccontr)
  assume "\<nexists>i. \<forall>j\<ge>i. s j = s i"
  then have ex_bigger: "\<exists>j\<ge>i. s j > s i" for i
    using incr_seq by fastforce

  from \<open>finite (range s)\<close>
  obtain maxVal where "maxVal \<in> range s" and "\<forall>v\<in>range s. \<not>(v > maxVal)"
    by (metis exists_maximal_element finite.emptyI image_is_empty infinite_UNIV_nat)

  from ex_bigger
  obtain maxVal' where "maxVal' \<in> range s" and "maxVal' > maxVal"
    by (metis \<open>maxVal \<in> range s\<close> image_iff rangeI)

  then show False
    using \<open>\<forall>v\<in>range s. \<not> maxVal < v\<close> by blast
qed

lemma exists_fix1:
  fixes f :: "('a \<Rightarrow> bool) \<Rightarrow> 'a \<Rightarrow> bool"
  assumes "mono f"
  shows "\<exists>i. (f ^^ Suc i) bot x = (f ^^ i) bot x"
  by (metis (mono_tags, lifting) assms funpow_decreasing le_Suc_eq rev_predicate1D)

lemma  exists_fix2:
  fixes f :: "('a \<Rightarrow> bool) \<Rightarrow> 'a \<Rightarrow> bool"
  assumes "mono f"
  shows "\<exists>i. \<forall>j\<ge>i. (f ^^ j) bot x = (f ^^ i) bot x"
  by (metis (mono_tags, hide_lams) assms funpow_decreasing rev_predicate1D)

lemma iterate_to_lfp:
  fixes f :: "('a \<Rightarrow> bool) \<Rightarrow> 'a \<Rightarrow> bool"
  assumes "mono f"
    and "(f ^^ i) bot x"
  shows "lfp f x"
  by (metis (mono_tags, lifting) Kleene_iter_lpfp assms(1) assms(2) lfp_greatest rev_predicate1D)

\<comment> \<open>the function f only depends on finitely many values\<close>
definition finite_branching :: "(('a \<Rightarrow> bool) \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> bool" where
"finite_branching f \<equiv> \<forall>f' x. f f' x \<longrightarrow> (\<exists>S. finite S \<and> (\<forall>f''. (\<forall>x\<in>S. f'' x = f' x) \<longrightarrow> f f'' x))"

lemma
  fixes f :: "('a \<Rightarrow> bool) \<Rightarrow> 'a \<Rightarrow> bool"
  assumes "(f ^^ i) bot x"
and "mono f"
shows "f ((f ^^ i) bot) x"
  by (metis (mono_tags, lifting) assms(1) assms(2) bot.extremum funpow_swap1 mono_def mono_pow rev_predicate1D)

datatype check_result = check_fail | check_ok nat | check_ok_infinite

definition [simp]: "less_eq_check_result' x y \<equiv> case x of
   check_fail \<Rightarrow> True
 | check_ok n \<Rightarrow> (case y of check_fail \<Rightarrow> False | check_ok m \<Rightarrow> n \<le> m | check_ok_infinite \<Rightarrow> True)
 | check_ok_infinite \<Rightarrow> y = check_ok_infinite"

definition [simp]: "less_check_result' x y \<equiv> case x of
   check_fail \<Rightarrow> y \<noteq> check_fail
 | check_ok n \<Rightarrow> (case y of check_fail \<Rightarrow> False | check_ok m \<Rightarrow> n < m | check_ok_infinite \<Rightarrow> True)
 | check_ok_infinite \<Rightarrow> False"

definition "is_ok check \<equiv> check \<noteq> check_fail"

instantiation check_result :: linorder begin
definition "less_eq_check_result \<equiv> less_eq_check_result'"
definition "less_check_result \<equiv> less_check_result'"

instance
  by (standard, auto simp add: less_eq_check_result_def less_check_result_def split: check_result.splits)
end

lemma check_ok0_less: "x < check_ok 0 \<longleftrightarrow> x = check_fail"
  by (auto simp add: less_check_result_def split: check_result.splits)

instance check_result :: wellorder
proof

  show "P a"
    if ind: "(\<And>x. (\<And>y. y < x \<Longrightarrow> P y) \<Longrightarrow> P x)"
    for P and a::check_result
  proof -
    have "P check_fail"
    proof (rule ind)
      show "\<And>y. y < check_fail \<Longrightarrow> P y"
        by (simp add: leD less_eq_check_result_def)
    qed

    moreover have "P (check_ok n)" for n
    proof (induct n rule: less_induct)
      case (less m)
      show "P (check_ok m)"
      proof (rule ind)
        show "P y" if "y < check_ok m" for y
        proof (cases y)
          case check_fail
          then show ?thesis
            using \<open>P check_fail\<close> by blast
        next
          case (check_ok i)
          then show ?thesis
            using less.hyps less_check_result_def that by auto
        next
          case check_ok_infinite
          then show ?thesis
            using less_check_result_def that by auto
        qed
      qed
    qed

    moreover have "P check_ok_infinite"
    proof (rule ind)
      show "P y" if "y < check_ok_infinite" for y
      proof (cases y)
        case check_fail
        then show ?thesis
          using \<open>P check_fail\<close> by blast
      next
        case (check_ok i)
        then show ?thesis
          by (simp add: \<open>\<And>n. P (check_ok n)\<close>)
      next
        case check_ok_infinite
        then show ?thesis
          using less_check_result_def that by auto
      qed
    qed

    ultimately
    show "P a"
      by (cases a, auto)
  qed
qed

lemma "(LEAST a::'a::wellorder. a = x \<or> a = y) \<le> x"
  by (simp add: Least_le)

lemma least_check_fail: "A \<noteq> {} \<Longrightarrow> (LEAST x::check_result. x \<in> A) = check_fail \<longleftrightarrow> (check_fail \<in>A)"
  apply auto
  using LeastI apply force
  by (meson Least_le check_ok0_less le_less_trans)

lemma least_check_result: "A \<noteq> {} \<Longrightarrow> (LEAST x::check_result. x \<in> A) = y \<longleftrightarrow> (y\<in>A \<and> (\<forall>y'\<in>A. y \<le> y'))"
  apply auto
  apply (meson LeastI)
  apply (simp add: Least_le)
  by (metis (full_types) LeastI less_le not_less_Least)

lemma least_check_result': "x\<in>A \<Longrightarrow> (LEAST x::check_result. x \<in> A) = y \<longleftrightarrow> (y\<in>A \<and> (\<forall>y'\<in>A. y \<le> y'))"
  by (rule least_check_result, auto)

lemma least_check_result_less_eq: "P a \<Longrightarrow> (z \<le> (LEAST x::check_result. P x)) \<longleftrightarrow> (\<forall>x. P x \<longrightarrow> z \<le> x)"
  by (meson LeastI Least_le order_trans)

lemma least_check_result_not_less_eq: "P a \<Longrightarrow> (\<not> (z \<le> (LEAST x::check_result. P x))) \<longleftrightarrow> (\<exists>x. P x \<and> z > x)"
  by (simp add: least_check_result_less_eq not_le)

lemma check_ok_infinite_max: "z \<le> check_ok_infinite"
  by (simp add: leI less_check_result_def)

lemma GreatestI:
  assumes example: "\<exists>m. P m \<and> Q m \<and> (\<forall>x. P x \<longrightarrow> x \<le> m)"
  shows "Q (Greatest P)"
  apply (unfold Greatest_def)
  apply (rule the1I2)
  using antisym example apply blast
  using dual_order.antisym example by blast

lemma GreatestI_nat2:
  assumes example: "\<exists>m::nat. P m"
    and bound: "\<forall>m. P m \<longrightarrow> m \<le> bound"
    and impl: "\<forall>x. P x \<longrightarrow> Q x"
  shows "Q (Greatest P)"
proof -
  obtain m where "P m"
    using example by auto

  then have "P (Greatest P)"
  proof (rule GreatestI_nat)
    show "\<forall>y. P y \<longrightarrow> y \<le> bound"
      using bound by simp
  qed
  then show "Q (Greatest P)"
    by (simp add: impl)
qed

lemma check_fail_least: "check_fail \<le> x"
  by (simp add: less_eq_check_result_def)

lemma check_fail_least2: "x \<le> check_fail \<longleftrightarrow> x = check_fail"
  by (cases x, auto simp add: less_eq_check_result_def)

lemma check_inf_greatest: "x \<le> check_ok_infinite"
  by (cases x, auto simp add: less_eq_check_result_def)

lemma check_inf_greatest2: "check_ok_infinite \<le> x \<longleftrightarrow> x = check_ok_infinite"
  by (cases x, auto simp add: less_eq_check_result_def)

lemma check_ok_compare: "check_ok x \<le> check_ok y \<longleftrightarrow> x \<le> y"
  by (cases x, auto simp add: less_eq_check_result_def)

lemma GreatestI_check_result:
  assumes example: "\<exists>m::check_result. P m"
    and bound: "\<forall>m. P m \<longrightarrow> m \<le> check_ok bound"
  shows "P (Greatest P)"
proof (cases "\<exists>n. P (check_ok n)")
  case True
  from this obtain k where "P (check_ok k)" by force

  define P' where "P' \<equiv> (\<lambda>x. P (check_ok x))"

  have "P' (Greatest P')"
  proof (rule GreatestI_nat)
    show "P' k"
      by (simp add: P'_def \<open>P (check_ok k)\<close>)
    show "\<forall>y. P' y \<longrightarrow> y \<le> bound"
      using P'_def assms(2) less_eq_check_result_def by auto
  qed

  have "Greatest P = check_ok (Greatest P')"
  proof (subst Greatest_def, rule the_equality, auto)
    show " P (check_ok (Greatest P'))"
      using P'_def \<open>P' (Greatest P')\<close> by auto
    show "P y \<Longrightarrow> y \<le> check_ok (Greatest P')" for y
      apply (cases y, auto simp add: check_fail_least check_inf_greatest2 check_inf_greatest2 check_ok_compare)
       apply (rule Greatest_le_nat[where b=bound])
      using bound by (auto simp add: P'_def check_inf_greatest2 check_ok_compare)
    show "\<And>x. \<lbrakk>P x; \<forall>y. P y \<longrightarrow> y \<le> x\<rbrakk> \<Longrightarrow> x = check_ok (Greatest P')"
      by (simp add: \<open>P (check_ok (Greatest P'))\<close> \<open>\<And>y. P y \<Longrightarrow> y \<le> check_ok (Greatest P')\<close> eq_iff)
  qed

  then show "P (Greatest P)"
    using P'_def \<open>P' (Greatest P')\<close> by auto
next
  case False
  from bound
  have "\<not>P check_ok_infinite"
    using check_inf_greatest2 by blast

  with False
  have "P x \<longleftrightarrow> x = check_fail" for x

    using example proof (cases x, auto, goal_cases G)
    case (G y)
    thus "P check_fail"
      by (cases y, auto)
  qed

  then show ?thesis
    by (metis GreatestI2_order eq_refl)
qed

lemma GreatestI_check_result2:
  assumes example: "\<exists>m::check_result. P m"
    and bound: "\<forall>m. P m \<longrightarrow> m \<le> check_ok bound"
    and impl: "\<forall>x. P x \<longrightarrow> Q x"
  shows "Q (Greatest P)"
proof -
  obtain m where "P m"
    using example by auto

  from example
  have "P (Greatest P)"
  proof (rule GreatestI_check_result)
    show "\<forall>y. P y \<longrightarrow> y \<le> check_ok bound"
      using bound by simp
  qed
  then show "Q (Greatest P)"
    by (simp add: impl)
qed

lemma Greatest_leq:
  assumes example: "\<exists>m. P m \<and> (\<forall>x. P x \<longrightarrow> x \<le> m)"
    and Px: "P x"
  shows "x \<le> (Greatest P)"
  apply (unfold Greatest_def)
  apply (rule the1I2)
  using antisym example apply blast
  using Px by auto

lemma check_fail_smaller: "check_fail \<le> x"
  by (simp add: less_eq_check_result_def)

lemma check_ok_infinite_max': "check_ok_infinite \<le> z \<longleftrightarrow> z = check_ok_infinite"
  by (simp add: dual_order.antisym check_inf_greatest2)

lemma exists_greatest_check_result:
  assumes i_greatest:"\<forall>j>i. check_ok j \<notin> A"
and example: "a \<in> A"
shows "\<exists>m. m \<in> A \<and> (\<forall>x. x \<in> A \<longrightarrow> x \<le> m)"
proof (cases "check_ok_infinite \<in> A")
  case True
  then have "check_ok_infinite \<in> A \<and> (\<forall>x. x \<in> A \<longrightarrow> x \<le> check_ok_infinite)"
    by (simp add: check_inf_greatest)
  then show ?thesis ..
next
  case False
  show ?thesis
  proof (cases "\<exists>i'. check_ok i' \<in> A")
    case True
    then have exists_ok: "\<exists>m. check_ok m \<in> A \<and> m \<le> i"
      using i_greatest not_le_imp_less by blast

    show "\<exists>m. m \<in> A \<and> (\<forall>x. x \<in> A \<longrightarrow> x \<le> m)"
    proof (rule ccontr)
      assume a: "\<nexists>m. m \<in> A \<and> (\<forall>x. x \<in> A \<longrightarrow> x \<le> m)"

      obtain i_max where "check_ok i_max \<in> A" and "i_max \<le> i" and "\<forall>i'. check_ok i' \<in> A \<and> i' \<le> i \<longrightarrow> i' \<le> i_max"
        apply atomize_elim
        apply (rule exI[where x="GREATEST i'. check_ok i' \<in> A \<and> i' \<le> i"])
        apply auto
          apply (rule GreatestI_nat2[where bound=i])
            apply (auto simp add: exists_ok)
         apply (rule GreatestI_nat2[where bound=i])
           apply (auto simp add: exists_ok)
        apply (rule Greatest_le_nat[where b=i])
         apply (auto simp add: exists_ok)
        done

      with a show False
        apply auto
        apply (drule spec[where x="check_ok i_max"])
        apply auto
      proof -

        show "False"
          if c0: "check_ok i_max \<in> A"
            and c1: "i_max \<le> i"
            and c2: "\<forall>i'. check_ok i' \<in> A \<and> i' \<le> i \<longrightarrow> i' \<le> i_max"
            and c3: "x \<in> A"
            and c4: "\<not> x \<le> check_ok i_max"
          for  x
          using that apply (cases x, auto simp add: check_ok_compare check_fail_smaller)
          using i_greatest not_le_imp_less apply blast
          using False by blast
      qed
    qed
  next
    case False
    then show ?thesis
      by (metis check_ok_infinite_max check_result.exhaust check_result.simps(8) example less_eq_check_result'_def less_eq_check_result_def)
  qed
qed

definition [simp]: "Inf_check_result' S \<equiv> if S = {} then check_ok_infinite else LEAST x. x \<in> S"
definition [simp]: "Sup_check_result' S  \<equiv> if S = {} then check_fail else if check_ok_infinite \<in> S \<or> (\<forall>i. \<exists>j>i. check_ok j \<in> S) then check_ok_infinite else GREATEST x. x \<in> S"

instantiation check_result :: complete_lattice begin
  definition "Inf_check_result \<equiv> Inf_check_result'"
  definition "Sup_check_result  \<equiv> Sup_check_result'"
  definition "bot_check_result \<equiv> check_fail"
  definition "sup_check_result (x::check_result) (y::check_result) \<equiv> if y \<le> x then x else y"
  definition "top_check_result \<equiv> check_ok_infinite"
  definition "inf_check_result (x::check_result) (y::check_result) \<equiv> if x \<le> y then x else y"
instance
proof

  fix x y z :: check_result
  show "inf x y \<le> x" and "inf x y \<le> y"
    by (auto simp add: inf_check_result_def less_eq_check_result_def split: check_result.splits)

  show "\<lbrakk>x \<le> y; x \<le> z\<rbrakk> \<Longrightarrow> x \<le> inf y z"
    by (auto simp add: inf_check_result_def less_eq_check_result_def split: check_result.splits)

  show "x \<le> sup x y" "y \<le> sup x y"
    by (auto simp add: sup_check_result_def less_eq_check_result_def split: check_result.splits)

  show "\<lbrakk>y \<le> x; z \<le> x\<rbrakk> \<Longrightarrow> sup y z \<le> x"
    by (auto simp add: sup_check_result_def less_eq_check_result_def split: check_result.splits)

  show "x \<in> A \<Longrightarrow> Inf A \<le> x" for A
    using Inf_check_result'_def Inf_check_result_def Least_le by fastforce

  show "(\<And>x. x \<in> A \<Longrightarrow> z \<le> x) \<Longrightarrow> z \<le> Inf A" for A
    by (auto simp add: Inf_check_result_def least_check_result_not_less_eq leD check_inf_greatest)

  show "x \<in> A \<Longrightarrow> x \<le> Sup A" for A
    apply (auto simp add: Sup_check_result_def check_inf_greatest        )
    apply (erule notE[where P="x \<le> (GREATEST x. x \<in> A)"])
    apply (rule Greatest_leq)
    by (auto simp add: exists_greatest_check_result)

  show "(\<And>x. x \<in> A \<Longrightarrow> x \<le> z) \<Longrightarrow> Sup A \<le> z" for A
    apply (auto simp add: Sup_check_result_def
       check_ok_infinite_max'
    )
    using check_ok_infinite_max' apply blast
     apply (cases z)
       apply (auto simp add: check_fail_least2 check_fail_smaller)
    using check_ok_compare leD apply blast
    apply (erule notE[where P=" (GREATEST x. x \<in> A) \<le> z"])
    apply (cases z)
      apply (auto simp add: check_inf_greatest)
     apply (metis GreatestI_check_result check_fail_least2 le_cases)
    by (metis (full_types) GreatestI_check_result)

qed (auto simp add: Inf_check_result_def top_check_result_def  Sup_check_result_def  bot_check_result_def)
end

\<comment> \<open>if result is false, result depends on a set S of recursive calls -- result is determined by checking conjunction of all recursive calls\<close>
definition tailrec :: "(('a \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> bool)) \<Rightarrow> bool" where
"tailrec F \<equiv> \<forall>g x. \<not>F g x \<longrightarrow> (\<exists>S. \<forall>g'. F g' x \<longleftrightarrow> (\<forall>x'\<in>S. g' x'))"

lemma tailrec_is_mono:
  assumes "tailrec f"
shows "mono f"
proof

  show "f x \<le> f y"
    if c0: "x \<le> y"
    for  x y
    using \<open>tailrec f\<close>
    by (smt le_fun_def order_refl tailrec_def that)
qed

definition even :: "(nat \<Rightarrow> bool) \<Rightarrow> nat \<Rightarrow> bool" where
"even g x \<equiv> if x = 0 then True else if x = 1 then False else g (x - 2)"

lemma f_mono: "mono even"
  by (smt even_def monoI predicate1I rev_predicate1D)

lemma "lfp even 0"
  by (subst lfp_unfold[OF f_mono], auto simp add: even_def)+

lemma "\<not>lfp even 1"
  by (subst lfp_unfold[OF f_mono], auto simp add: even_def)+

lemma "lfp even 10"
  by (subst lfp_unfold[OF f_mono], auto simp add: even_def)+

definition lfp2 :: "(('a \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> bool)) \<Rightarrow> ('a \<Rightarrow> bool)" where
"lfp2 f \<equiv> (\<lambda>x. \<exists>n. (f^^n) bot x)"

lemma lfp2_leq_lfp:
  assumes mono: "mono f"
  shows "lfp2 f \<le> lfp f"
  by (meson iterate_to_lfp lfp2_def mono predicate1I)

end


theory Propositional
    imports Main
begin

text \<open> In this exercise, we will prove some lemmas of propositional
logic with the aid of a calculus of natural deduction.

For the proofs, you may only use

\begin{itemize}
\item the following lemmas: \\
@{text "notI:"}~@{thm notI[of A,no_vars]},\\
@{text "notE:"}~@{thm notE[of A B,no_vars]},\\
@{text "conjI:"}~@{thm conjI[of A B,no_vars]},\\
@{text "conjE:"}~@{thm conjE[of A B C,no_vars]},\\
@{text "disjI1:"}~@{thm disjI1[of A B,no_vars]},\\
@{text "disjI2:"}~@{thm disjI2[of A B,no_vars]},\\
@{text "disjE:"}~@{thm disjE[of A B C,no_vars]},\\
@{text "impI:"}~@{thm impI[of A B,no_vars]},\\
@{text "impE:"}~@{thm impE[of A B C,no_vars]},\\
@{text "mp:"}~@{thm mp[of A B,no_vars]}\\
@{text "iffI:"}~@{thm iffI[of A B,no_vars]}, \\
@{text "iffE:"}~@{thm iffE[of A B C,no_vars]}\\
@{text "classical:"}~@{thm classical[of A,no_vars]}

\item the proof methods @{term rule}, @{term erule} and @{term assumption}.
\end{itemize}

Prove:
\<close>

lemma I: "A \<longrightarrow> A"
  apply (rule impI)
  apply (rule classical)
  by assumption

lemma "A \<and> B \<longrightarrow> B \<and> A"
  apply (rule impI)
  apply (erule conjE)
  apply (rule conjI)
  by assumption

lemma "(A \<and> B) \<longrightarrow> (A \<or> B)"
  apply (rule impI)
  apply (erule conjE)
  apply (rule disjI1)
  by assumption

lemma "((A \<or> B) \<or> C) \<longrightarrow> A \<or> (B \<or> C)"
  apply (rule impI)
  apply (erule disjE)
   apply (erule disjE)
    apply (rule disjI1, assumption)
   apply (rule disjI2, rule disjI1, assumption)
  apply (rule disjI2, rule disjI2, assumption)
  done

lemma "(A \<or> A) = (A \<and> A)"
  apply (rule iffI)
   apply (rule conjI)
    apply (erule disjE)
     apply assumption+
   apply (erule disjE)
    apply assumption+
  apply (erule conjE)
  apply (rule disjI1)
  by assumption

lemma S: "(A \<longrightarrow> B \<longrightarrow> C) \<longrightarrow> (A \<longrightarrow> B) \<longrightarrow> A \<longrightarrow> C"
  apply (rule impI)+
  apply (drule mp, assumption)+
  by assumption

lemma "(A \<longrightarrow> B) \<longrightarrow> (B \<longrightarrow> C) \<longrightarrow> A \<longrightarrow> C"
  apply (rule impI)+
  apply (drule mp, assumption)+
  by assumption

lemma "\<not> \<not> A \<longrightarrow> A"
  apply (rule impI)
  apply (rule classical)
  apply (erule notE, assumption)
  done

lemma "A \<longrightarrow> \<not> \<not> A"
  apply (rule impI)
  apply (rule notI)
  apply (erule notE, assumption)
  done

lemma "(\<not> A \<longrightarrow> B) \<longrightarrow> (\<not> B \<longrightarrow> A)"
  apply (rule impI)+
  apply (rule classical)
  apply (erule impE, assumption)
  by (rule notE)

lemma "((A \<longrightarrow> B) \<longrightarrow> A) \<longrightarrow> A"
  apply (rule impI)
  apply (rule classical)
  apply (erule impE)
    apply (rule impI)
  by (erule notE, assumption)+

lemma "A \<or> \<not> A"
  apply (rule classical)
  apply (rule disjI2)
  apply (rule notI)
  apply (erule notE)
  apply (rule disjI1)
  by assumption

lemma "(\<not> (A \<and> B)) = (\<not> A \<or> \<not> B)"
  apply (rule iffI)
   apply (rule classical)
   apply (rule disjI1)
   apply (rule notI)
   apply (erule notE)
   apply (rule classical)
   apply (rule conjI, assumption)
   apply (rule classical)
   apply (erule notE)
   apply (rule disjI2, assumption)
  apply (rule classical)
  apply (rule notI)
  apply (erule notE)
  apply (erule conjE)
  apply (erule disjE)
  by (erule notE, assumption)+

(*<*) end (*>*)


theory Extras
    imports "Perm" "Graph_Theory.Graph_Theory" "List-Index.List_Index"
begin

section \<open>Appears before\<close>

definition "appears_before l x y \<equiv> y \<in> set (drop (index l x) l)"

lemma appears_before_in:
  assumes "appears_before l x y"
  shows "x \<in> set l" "y \<in> set l"
   apply (metis appears_before_def assms in_set_dropD index_conv_size_if_notin last_index_drop
      last_index_less_size_conv)
  by (meson appears_before_def assms in_set_dropD)

lemma appears_before_empty: "\<not> appears_before [] x y"
  by (metis appears_before_in(1) empty_iff empty_set)

lemma not_appears_before_in: "x \<notin> set l \<or> y \<notin> set l \<Longrightarrow> \<not> appears_before l x y"
  by (meson appears_before_in)

lemma appears_before_id: "appears_before l x x \<longleftrightarrow> x \<in> set l"
  apply (auto simp add: appears_before_in(1))
  by (metis Cons_nth_drop_Suc appears_before_def index_less_size_conv list.set_intros(1) nth_index)

lemma appears_before_cons:
 "appears_before (x#l) y z \<longleftrightarrow>
  (if x = y then z \<in> set (x#l) else appears_before l y z)"
  by (simp add: appears_before_def)

lemma appears_before_append:
  assumes "appears_before p x y \<or> appears_before q x y \<or> x \<in> set p \<and> y \<in> set q"
  shows "appears_before (p@q) x y"
proof -
  {
    assume "appears_before p x y"
    then have "y \<in> set (drop (index p x) p)"
      by (meson appears_before_def)
    also have "index p x = index (p@q) x"
      by (metis \<open>appears_before p x y\<close> appears_before_in(1) index_append)
    then have "set (drop (index p x) p) \<subseteq> set (drop (index (p@q) x) (p@q))"
      by simp
    ultimately have "appears_before (p @ q) x y"
      by (meson appears_before_def in_mono)
  } note 1 = this
  {
    assume "appears_before q x y"
    then have "y \<in> set (drop (index q x) q)"
      by (meson appears_before_def)
    also have "length p + index q x \<ge> index (p@q) x"
      by (simp add: index_append index_le_size trans_le_add1)
    then have "set (drop (index q x) q) \<subseteq> set (drop (index (p@q) x) (p@q))"
      by (metis add_diff_cancel_left' append_Nil drop_all drop_append
          le_add1 set_drop_subset_set_drop)
    ultimately have ?thesis
      by (meson appears_before_def subsetD)
  } note 2 = this
  {
    assume "x \<in> set p" "y \<in> set q"
    then have "set q \<subseteq> set (drop (index (p@q) x) (p@q))"
      by (simp add: index_append index_le_size)
    then have ?thesis
      by (metis \<open>y \<in> set q\<close> appears_before_def subset_iff)
  } note 3 = this
  from 1 2 3 assms show ?thesis by auto
qed

section \<open>Permutations and funpow\<close>
lemma cycles_funpow:
  assumes "z \<in> set_cycle (perm_orbit p x)"
  shows "\<exists>n. (apply_perm p ^^ n) z = x"
proof -
  from assms have "(apply_perm p ^^ n) z \<in> set_cycle (perm_orbit p x)" for n
    by simp
  also have "x \<in> set_cycle (perm_orbit p x)"
    using assms by fastforce
  ultimately show ?thesis
    by (metis apply_perm_power assms funpow_apply_cycle_perm_orbit set_cycle_ex_funpow)
qed

lemma funpow_cycles:
  assumes "(apply_perm p ^^ n) z = x" "z \<noteq> x"
  shows "z \<in> set_cycle (perm_orbit p x)"
  by (metis apply_perm_eq_idI apply_perm_neq_idI apply_perm_power apply_set_perm assms
      funpow_apply_perm_in_perm_orbit_iff set_perm_powerD start_in_perm_orbit_iff)

lemma permutes_perm:
  assumes "finite S" "f permutes S"
  shows "(Perm f) permutes S"
  by (metis (no_types, lifting) Perm_inverse assms mem_Collect_eq permutation permutation_permutes)

lemma size_perm_type_eq_card: "size (perm_type p) = card (cycles_of_perm p)"
  by (simp add: perm_type_def)

lemma perm_orbit_set_comm: "a \<in> set_cycle (perm_orbit p b) \<Longrightarrow> b \<in> set_cycle (perm_orbit p a)"
  by (metis apply_cycle_perm_orbit apply_cycle_same_iff cycles_funpow
      funpow_apply_perm_in_perm_orbit_iff start_in_perm_orbit_iff)

locale perm_on =
  fixes p :: "'a perm" and S :: "'a set"
  assumes permutes_p: "p permutes S"
begin

lemma set_perm_subset:
  shows "set_perm p \<subseteq> S"
  by (meson permutes_not_in apply_perm_neq_idI permutes_p subsetI)

lemma count_cycles_on_eq_card:
 "count_cycles_on S p = card (cycles_of_perm p) + card (S - set_perm p)"
  unfolding count_cycles_on_def by (simp add: perm_type_on_def size_perm_type_eq_card)

lemma count_cycles_on_empty: "S = {} \<Longrightarrow> count_cycles_on S p = 0"
  using count_cycles_on_eq_card set_perm_subset by auto

lemma inverse_permutes: "(inverse p) permutes S"
  by (smt (verit, del_insts) apply_perm_inverse_not_in_set eq_apply_perm_inverse_iff
      perm.inverse_inverse permutes_def permutes_subset set_perm_subset)
end

locale finite_perm_on = perm_on +
  assumes finite_S: "finite S"
begin

lemma count_cycles_on_nonempty:
  assumes "S \<noteq> {}" shows "count_cycles_on S p \<noteq> 0"
  by (simp add: assms count_cycles_on_eq_card finite_S finite_cycles_of_perm)
end

section \<open>Digraph extras\<close>

lemma reachable1:
  assumes "a \<rightarrow>\<^bsub>G\<^esub> b" "a \<in> verts G" "b \<in> verts G"
  shows "a\<rightarrow>\<^sup>*\<^bsub>G\<^esub>b"
  by (metis assms reachable_def rtrancl_on.simps)

definition (in wf_digraph) "connect_sym \<equiv> (\<forall>a b. a \<rightarrow>\<^sup>* b \<longrightarrow> b \<rightarrow>\<^sup>* a)"

lemma (in wf_digraph) reach_sym_arc:
  assumes "connect_sym"
  shows  "a \<rightarrow>\<^bsub>G\<^esub> b \<Longrightarrow> b \<rightarrow>\<^sup>* a"
  using assms connect_sym_def by blast

lemma arc_to_ends_pair [simp]: "arc_to_ends (with_proj g) e = e"
  by simp

lemma vpath_sublist:
  assumes "vpath (p @ q) G"
  shows "p \<noteq> [] \<Longrightarrow> vpath p G"  "q \<noteq> [] \<Longrightarrow> vpath q G"
  by (meson assms distinct_append vpath_def vwalkI_append_l vwalkI_append_r)+

lemma (in wf_digraph) sccs_empty: "verts G = {} \<Longrightarrow> sccs = {}"
  using sccs_verts_conv sccs_verts_conv_scc_of by force

lemma (in wf_digraph) card_sccs_1: "card sccs = 1 \<Longrightarrow> sccs = {G}"
  by (smt (verit, del_insts) card_1_singletonE card_sccs_verts empty_iff image_empty
        in_scc_of_self in_sccs_verts_conv_reachable in_verts_sccsD_sccs induce_eq_iff_induced
        induced_subgraph_refl scc_of_in_sccs_verts sccs_verts_conv_scc_of singleton_iff
        wf_digraph.reachable_in_verts(1) wf_digraph_axioms)

lemma (in wf_digraph) card_sccs_connected: "(card sccs = 1) = strongly_connected G"
  by (metis One_nat_def card.empty card.insert empty_iff finite.emptyI
      strongly_connected_eq_iff card_sccs_1)

lemma (in fin_digraph) finite_sccs: "finite sccs"
  using finite_imageD finite_sccs_verts inj_on_verts_sccs sccs_verts_conv by auto

lemma comm_graph_union: "compatible g h \<Longrightarrow> union g h = union h g"
  by (simp add: Un_commute compatible_head compatible_tail)

definition pair_union :: "'a pair_pre_digraph \<Rightarrow> 'a pair_pre_digraph \<Rightarrow> 'a pair_pre_digraph" where
"pair_union g h \<equiv> \<lparr> pverts = pverts g \<union> pverts h, parcs = parcs g \<union> parcs h\<rparr>"

lemma with_proj_union[simp]: "with_proj (pair_union g h) = union (with_proj g) (with_proj h)"
  by (simp add: pair_union_def)

lemma comm_pair_union: "pair_union g h = pair_union h g"
  unfolding pair_union_def by auto

lemma wf_pair_union:
  assumes "pair_wf_digraph g" "pair_wf_digraph h"
  shows "pair_wf_digraph (pair_union g h)"
  by (metis assms compatibleI_with_proj wellformed_union wf_digraph_wp_iff with_proj_union)

lemma pair_union_arcs_disj: "x\<rightarrow>\<^bsub>pair_union g h\<^esub>y \<longleftrightarrow> x\<rightarrow>\<^bsub>g\<^esub>y \<or> x\<rightarrow>\<^bsub>h\<^esub>y"
  by (simp add: pair_union_def)

lemma arc_in_union: "x\<rightarrow>\<^bsub>with_proj g\<^esub>y \<Longrightarrow> x\<rightarrow>\<^bsub>pair_union g h\<^esub>y"
  by (metis Un_iff arcs_union with_proj_simps(2) with_proj_simps(3) with_proj_union)

lemma reach_in_union:
  assumes "wf_digraph g" "wf_digraph h" "compatible g h" "x\<rightarrow>\<^sup>*\<^bsub>g\<^esub>y"
  shows "x\<rightarrow>\<^sup>*\<^bsub>union g h\<^esub>y"
by (meson assms pre_digraph.reachable_mono rtrancl_subset_rtrancl subgraphs_of_union(1))

definition reverse :: "'a pair_pre_digraph \<Rightarrow> 'a pair_pre_digraph" ("(_\<^sup>R)" [1000] 999) where
"reverse a = \<lparr>pverts = pverts a, parcs = (parcs a)\<inverse>\<rparr>"

lemma (in pair_wf_digraph) wf_reverse: "pair_wf_digraph (G\<^sup>R)"
  unfolding reverse_def by (simp add: in_arcsD1 in_arcsD2 pair_wf_digraph_def)

lemma arc_reverse: "x\<rightarrow>\<^bsub>with_proj g\<^esub>y \<Longrightarrow> y\<rightarrow>\<^bsub>g\<^sup>R\<^esub>x"
  by (simp add: reverse_def)

lemma reach_reverse: "x\<rightarrow>\<^sup>*\<^bsub>with_proj g\<^esub>y \<Longrightarrow> y\<rightarrow>\<^sup>*\<^bsub>g\<^sup>R\<^esub>x"
  by (simp add: reverse_def reachable_def rtrancl_on_converseI)

lemma (in pre_digraph) "scc_of x \<subseteq> verts G"
  using pre_digraph.scc_of_def reachable_in_vertsE by fastforce

end


(*<*)
theory Propositional_Logic
imports Abstract_Completeness
begin
(*>*)

section {* Toy instantiation: Propositional Logic *}

datatype fmla = Atom nat | Neg fmla | Conj fmla fmla

primrec max_depth where
  "max_depth (Atom _) = 0"
| "max_depth (Neg \<phi>) = Suc (max_depth \<phi>)"
| "max_depth (Conj \<phi> \<psi>) = Suc (max (max_depth \<phi>) (max_depth \<psi>))"

lemma max_depth_0: "max_depth \<phi> = 0 = (\<exists>n. \<phi> = Atom n)"
  by (cases \<phi>) auto

lemma max_depth_Suc: "max_depth \<phi> = Suc n = ((\<exists>\<psi>. \<phi> = Neg \<psi> \<and> max_depth \<psi> = n) \<or>
  (\<exists>\<psi>1 \<psi>2. \<phi> = Conj \<psi>1 \<psi>2 \<and> max (max_depth \<psi>1) (max_depth \<psi>2) = n))"
  by (cases \<phi>) auto

abbreviation "atoms \<equiv> smap Atom nats"
abbreviation "depth1 \<equiv>
  sinterleave (smap Neg atoms) (smap (split Conj) (sproduct atoms atoms))"

abbreviation "sinterleaves \<equiv> fold sinterleave"

fun extendLevel where "extendLevel (belowN, N) =
  (let Next = sinterleaves
    (map (smap (split Conj)) [sproduct belowN N, sproduct N belowN, sproduct N N])
    (smap Neg N)
  in (sinterleave belowN N, Next))"

lemma extendLevel_step:
  "\<lbrakk>sset belowN = {\<phi>. max_depth \<phi> < n};
    sset N = {\<phi>. max_depth \<phi> = n}; st = (belowN, N)\<rbrakk> \<Longrightarrow>
  \<exists>belowNext Next. extendLevel st = (belowNext, Next) \<and>
     sset belowNext = {\<phi>. max_depth \<phi> < Suc n} \<and> sset Next = {\<phi>. max_depth \<phi> = Suc n}"
  by (auto simp: sset_sinterleave sset_sproduct stream.set_map
    image_iff max_depth_Suc)

lemma sset_atoms: "sset atoms = {\<phi>. max_depth \<phi> < 1}"
  by (auto simp: stream.set_map max_depth_0)

lemma sset_depth1: "sset depth1 = {\<phi>. max_depth \<phi> = 1}"
  by (auto simp: sset_sinterleave sset_sproduct stream.set_map
    max_depth_Suc max_depth_0 max_def image_iff)

lemma extendLevel_Nsteps:
  "\<lbrakk>sset belowN = {\<phi>. max_depth \<phi> < n}; sset N = {\<phi>. max_depth \<phi> = n}\<rbrakk> \<Longrightarrow>
  \<exists>belowNext Next. (extendLevel ^^ m) (belowN, N) = (belowNext, Next) \<and>
     sset belowNext = {\<phi>. max_depth \<phi> < n + m} \<and> sset Next = {\<phi>. max_depth \<phi> = n + m}"
proof (induction m arbitrary: belowN N n)
  case (Suc m)
  then obtain belowNext Next where "(extendLevel ^^ m) (belowN, N) = (belowNext, Next)"
    "sset belowNext = {\<phi>. max_depth \<phi> < n + m}" "sset Next = {\<phi>. max_depth \<phi> = n + m}"
    by blast
  thus ?case unfolding funpow.simps o_apply add_Suc_right
    by (intro extendLevel_step[of belowNext _ Next])
qed simp

corollary extendLevel:
  "\<exists>belowNext Next. (extendLevel ^^ m) (atoms, depth1) = (belowNext, Next) \<and>
     sset belowNext = {\<phi>. max_depth \<phi> < 1 + m} \<and> sset Next = {\<phi>. max_depth \<phi> = 1 + m}"
  by (rule extendLevel_Nsteps) (auto simp: sset_atoms sset_depth1)

definition "fmlas = sinterleave atoms (smerge (smap snd (siterate extendLevel (atoms, depth1))))"

lemma fmlas_UNIV: "sset fmlas = (UNIV :: fmla set)"
proof (intro equalityI subsetI UNIV_I)
  fix \<phi>
  show "\<phi> \<in> sset fmlas"
  proof (cases "max_depth \<phi>")
    case 0 thus ?thesis unfolding fmlas_def sset_sinterleave stream.set_map
      by (intro UnI1) (auto simp: max_depth_0)
  next
    case (Suc m) thus ?thesis using extendLevel[of m]
    unfolding fmlas_def sset_smerge sset_siterate sset_sinterleave stream.set_map
      by (intro UnI2) (auto, metis (mono_tags) mem_Collect_eq)
  qed
qed

datatype rule = Idle | Ax nat | NegL fmla | NegR fmla | ConjL fmla fmla | ConjR fmla fmla

abbreviation "mkRules f \<equiv> smap f fmlas"
abbreviation "mkRulePairs f \<equiv> smap (split f) (sproduct fmlas fmlas)"

definition rules where
  "rules = Idle ##
     sinterleaves [mkRules NegL, mkRules NegR, mkRulePairs ConjL, mkRulePairs ConjR]
     (smap Ax nats)"

lemma rules_UNIV: "sset rules = (UNIV :: rule set)"
  unfolding rules_def by (auto simp: sset_sinterleave sset_sproduct stream.set_map
    fmlas_UNIV image_iff) (metis rule.exhaust)

type_synonym state = "fmla fset * fmla fset"

fun eff' :: "rule \<Rightarrow> state \<Rightarrow> state fset option" where
  "eff' Idle (\<Gamma>, \<Delta>) = Some {|(\<Gamma>, \<Delta>)|}"
| "eff' (Ax n) (\<Gamma>, \<Delta>) =
    (if Atom n |\<in>| \<Gamma> \<and> Atom n |\<in>| \<Delta> then Some {||} else None)"
| "eff' (NegL \<phi>) (\<Gamma>, \<Delta>) =
    (if Neg \<phi> |\<in>| \<Gamma> then Some {|(\<Gamma> |-| {| Neg \<phi> |}, finsert \<phi> \<Delta>)|} else None)"
| "eff' (NegR \<phi>) (\<Gamma>, \<Delta>) =
    (if Neg \<phi> |\<in>| \<Delta> then Some {|(finsert \<phi> \<Gamma>, \<Delta> |-| {| Neg \<phi> |})|} else None)"
| "eff' (ConjL \<phi> \<psi>) (\<Gamma>, \<Delta>) =
    (if Conj \<phi> \<psi> |\<in>| \<Gamma>
    then Some {|(finsert \<phi> (finsert \<psi> (\<Gamma> |-| {| Conj \<phi> \<psi> |})), \<Delta>)|}
    else None)"
| "eff' (ConjR \<phi> \<psi>) (\<Gamma>, \<Delta>) =
    (if Conj \<phi> \<psi> |\<in>| \<Delta>
    then Some {|(\<Gamma>, finsert \<phi> (\<Delta> |-| {| Conj \<phi> \<psi> |})), (\<Gamma>, finsert \<psi> (\<Delta> |-| {| Conj \<phi> \<psi> |}))|}
    else None)"

abbreviation "Disj \<phi> \<psi> \<equiv> Neg (Conj (Neg \<phi>) (Neg \<psi>))"
abbreviation "Imp \<phi> \<psi> \<equiv> Disj (Neg \<phi>) \<psi>"
abbreviation "Iff \<phi> \<psi> \<equiv> Conj (Imp \<phi> \<psi>) (Imp \<psi> \<phi>)"

definition "thm1 \<equiv> ({|Conj (Atom 0) (Neg (Atom 0))|}, {||})"

declare Stream.smember_code [code del]

interpretation RuleSystem "\<lambda>r s ss. eff' r s = Some ss" rules UNIV
  by unfold_locales (auto simp: rules_UNIV intro: exI[of _ Idle])

interpretation PersistentRuleSystem "\<lambda>r s ss. eff' r s = Some ss" rules UNIV
proof (unfold_locales, unfold enabled_def per_def rules_UNIV, clarsimp)
  fix r \<Gamma> \<Delta> ss r' \<Gamma>' \<Delta>' ss'
  assume "r' \<noteq> r" "eff' r (\<Gamma>, \<Delta>) = Some ss" "eff' r' (\<Gamma>, \<Delta>) = Some ss'" "(\<Gamma>', \<Delta>') |\<in>| ss'"
  then show "\<exists>sl. eff' r (\<Gamma>', \<Delta>') = Some sl"
    by (cases r r' rule: rule.exhaust[case_product rule.exhaust]) (auto split: if_splits)
qed

definition "rho \<equiv> i.fenum rules"
definition "propTree \<equiv> i.mkTree eff' rho"

export_code propTree thm1 in Haskell module_name PropInstance (* file "." *)

(*<*)
end
(*>*)


section \<open>Recursive inseperability\<close>

theory Recursive_Inseparability
  imports "Recursion-Theory-I.RecEnSet"
begin

text \<open>Two sets $A$ and $B$ are recursively inseparable if there is no computable set that
contains $A$ and is disjoint from $B$. In particular, a set is computable if the set and its
complement are recursively inseparable. The terminology was introduced by Smullyan~@{cite R58}.
The underlying idea can be traced back to Rosser, who essentially showed that provable and
disprovable sentences are \emph{arithmetically} inseparable in Peano Arithmetic~@{cite R36};
see also Kleene's symmetric version of Gödel's incompleteness theorem~@{cite K52}.

Here we formalize recursive inseparability on top of the \texttt{Recursion-Theory-I} AFP
entry~@{cite RTI}. Our main result is a version of Rice' theorem that states that the index
sets of any two given recursively enumerable sets are recursively inseparable.\<close>

subsection \<open>Definition and basic facts\<close>

text \<open>Two sets $A$ and $B$ are recursively inseparable if there are no decidable sets $X$ such
that $A$ is a subset of $X$ and $X$ is disjoint from $B$.\<close>

definition rec_inseparable where
  "rec_inseparable A B \<equiv> \<forall>X. A \<subseteq> X \<and> B \<subseteq> - X \<longrightarrow> \<not> computable X"

lemma rec_inseparableI:
  "(\<And>X. A \<subseteq> X \<Longrightarrow> B \<subseteq> - X \<Longrightarrow> computable X \<Longrightarrow> False) \<Longrightarrow> rec_inseparable A B"
  unfolding rec_inseparable_def by blast

lemma rec_inseparableD:
  "rec_inseparable A B \<Longrightarrow> A \<subseteq> X \<Longrightarrow> B \<subseteq> - X \<Longrightarrow> computable X \<Longrightarrow> False"
  unfolding rec_inseparable_def by blast

text \<open>Recursive inseperability is symmetric and enjoys a monotonicity property.\<close>

lemma rec_inseparable_symmetric:
  "rec_inseparable A B \<Longrightarrow> rec_inseparable B A"
  unfolding rec_inseparable_def computable_def by (metis double_compl)

lemma rec_inseparable_mono:
  "rec_inseparable A B \<Longrightarrow> A \<subseteq> A' \<Longrightarrow> B \<subseteq> B' \<Longrightarrow> rec_inseparable A' B'"
  unfolding rec_inseparable_def by (meson subset_trans)

text \<open>Many-to-one reductions apply to recursive inseparability as well.\<close>

lemma rec_inseparable_many_reducible:
  assumes "total_recursive f" "rec_inseparable (f -` A) (f -` B)"
  shows "rec_inseparable A B"
proof (intro rec_inseparableI)
  fix X assume "A \<subseteq> X" "B \<subseteq> - X" "computable X"
  moreover have "many_reducible_to (f -` X) X" using assms(1)
    by (auto simp: many_reducible_to_def many_reducible_to_via_def)
  ultimately have "computable (f -` X)" and "(f -` A) \<subseteq> (f -` X)" and "(f -` B) \<subseteq> - (f -` X)"
    by (auto dest!: m_red_to_comp)
  then show "False" using assms(2) unfolding rec_inseparable_def by blast
qed

text \<open>Recursive inseparability of $A$ and $B$ holds vacuously if $A$ and $B$ are not disjoint.\<close>

lemma rec_inseparable_collapse:
  "A \<inter> B \<noteq> {} \<Longrightarrow> rec_inseparable A B"
  by (auto simp: rec_inseparable_def)

text \<open>Recursive inseparability is intimately connected to non-computability.\<close>

lemma rec_inseparable_non_computable:
  "A \<inter> B = {} \<Longrightarrow> rec_inseparable A B \<Longrightarrow> \<not> computable A"
  by (auto simp: rec_inseparable_def)

lemma computable_rec_inseparable_conv:
  "computable A \<longleftrightarrow> \<not> rec_inseparable A (- A)"
  by (auto simp: computable_def rec_inseparable_def)

subsection \<open>Rice's theorem\<close>

text \<open>We provide a stronger version of Rice's theorem compared to @{cite RTI}.
Unfolding the definition of recursive inseparability, it states that there are no decidable
sets $X$ such that
\begin{itemize}
\item there is a r.e.\ set such that all its indices are elements of $X$; and
\item there is a r.e.\ set such that none of its indices are elements of $X$.
\end{itemize}
This is true even if $X$ is not an index set (i.e., if an index of a r.e.\ set is an element
of $X$, then $X$ contains all indices of that r.e.\ set), which is a requirement of Rice's
theorem in @{cite RTI}.\<close>

lemma Rice_rec_inseparable:
  "rec_inseparable {k. nat_to_ce_set k = nat_to_ce_set n} {k. nat_to_ce_set k = nat_to_ce_set m}"
proof (intro rec_inseparableI, goal_cases)
  case (1 X)
  text \<open>Note that @{thm Rice_2} is not applicable because X may not be an index set.\<close>
  let ?Q = "{q. s_ce q q \<in> X} \<times> nat_to_ce_set m \<union> {q. s_ce q q \<in> - X} \<times> nat_to_ce_set n"
  have "?Q \<in> ce_rels"
    using 1(3) ce_set_lm_5 comp2_1[OF s_ce_is_pr id1_1 id1_1] unfolding computable_def
    by (intro ce_union[of "ce_rel_to_set _" "ce_rel_to_set _", folded ce_rel_lm_32 ce_rel_lm_8]
      ce_rel_lm_29 nat_to_ce_set_into_ce) blast+
  then obtain q where "nat_to_ce_set q = {c_pair q x |q x. (q, x) \<in> ?Q}"
    unfolding ce_rel_lm_8 ce_rel_to_set_def by (metis (no_types, lifting) nat_to_ce_set_srj)
  from eqset_imp_iff[OF this, of "c_pair q _"]
  have "nat_to_ce_set (s_ce q q) = (if s_ce q q \<in> X then nat_to_ce_set m else nat_to_ce_set n)"
    by (auto simp: s_lm c_pair_inj' nat_to_ce_set_def fn_to_set_def pr_conv_1_to_2_def)
  then show ?case using 1(1,2)[THEN subsetD, of "s_ce q q"] by (auto split: if_splits)
qed

end