theory ASC_Hoare
  imports ASC_Sufficiency "HOL-Hoare.Hoare_Logic"
begin

section {* Correctness of the Adaptive State Counting Algorithm in Hoare-Logic *}

text \<open>
In this section we give an example implementation of the adaptive state counting algorithm in a
simple WHILE-language and prove that this implementation produces a certain output if and only if
input FSM @{verbatim M1} is a reduction of input FSM @{verbatim M2}.
\<close>

lemma atc_io_reduction_on_sets_from_obs :
  assumes "L\<^sub>i\<^sub>n M1 T \<subseteq> L\<^sub>i\<^sub>n M2 T"
  and "(\<Union>io\<in>L\<^sub>i\<^sub>n M1 T. {io} \<times> B M1 io \<Omega>) \<subseteq> (\<Union>io\<in>L\<^sub>i\<^sub>n M2 T. {io} \<times> B M2 io \<Omega>)"
shows "atc_io_reduction_on_sets M1 T \<Omega> M2"
  unfolding atc_io_reduction_on_sets.simps atc_io_reduction_on.simps
proof
  fix iseq assume "iseq \<in> T"
  have "L\<^sub>i\<^sub>n M1 {iseq} \<subseteq> L\<^sub>i\<^sub>n M2 {iseq}"
    by (metis \<open>iseq \<in> T\<close> assms(1) bot.extremum insert_mono io_reduction_on_subset
        mk_disjoint_insert)
  moreover have "\<forall>io\<in>L\<^sub>i\<^sub>n M1 {iseq}. B M1 io \<Omega> \<subseteq> B M2 io \<Omega>"
  proof
    fix io assume "io \<in> L\<^sub>i\<^sub>n M1 {iseq}"
    then have "io \<in> L\<^sub>i\<^sub>n M2 {iseq}"
      using calculation by blast
    show "B M1 io \<Omega> \<subseteq> B M2 io \<Omega> "
    proof
      fix x assume "x \<in> B M1 io \<Omega>"

      have "io \<in> L\<^sub>i\<^sub>n M1 T"
        using \<open>io \<in> L\<^sub>i\<^sub>n M1 {iseq}\<close> \<open>iseq \<in> T\<close> by auto
      moreover have "(io,x) \<in> {io} \<times> B M1 io \<Omega>"
        using \<open>x \<in> B M1 io \<Omega>\<close> by blast
      ultimately have "(io,x) \<in> (\<Union>io\<in>L\<^sub>i\<^sub>n M1 T. {io} \<times> B M1 io \<Omega>)"
        by blast

      then have "(io,x) \<in> (\<Union>io\<in>L\<^sub>i\<^sub>n M2 T. {io} \<times> B M2 io \<Omega>)"
        using assms(2) by blast
      then have "(io,x) \<in> {io} \<times> B M2 io \<Omega>"
        by blast
      then show "x \<in> B M2 io \<Omega>"
        by blast
    qed
  qed
  ultimately show "L\<^sub>i\<^sub>n M1 {iseq} \<subseteq> L\<^sub>i\<^sub>n M2 {iseq}
                    \<and> (\<forall>io\<in>L\<^sub>i\<^sub>n M1 {iseq}. B M1 io \<Omega> \<subseteq> B M2 io \<Omega>)"
    by linarith
qed

lemma atc_io_reduction_on_sets_to_obs :
  assumes "atc_io_reduction_on_sets M1 T \<Omega> M2"
shows "L\<^sub>i\<^sub>n M1 T \<subseteq> L\<^sub>i\<^sub>n M2 T"
  and "(\<Union>io\<in>L\<^sub>i\<^sub>n M1 T. {io} \<times> B M1 io \<Omega>) \<subseteq> (\<Union>io\<in>L\<^sub>i\<^sub>n M2 T. {io} \<times> B M2 io \<Omega>)"
proof
  fix x assume "x \<in> L\<^sub>i\<^sub>n M1 T"
  show "x \<in> L\<^sub>i\<^sub>n M2 T"
    using assms unfolding atc_io_reduction_on_sets.simps atc_io_reduction_on.simps
  proof -
    assume a1: "\<forall>iseq\<in>T. L\<^sub>i\<^sub>n M1 {iseq} \<subseteq> L\<^sub>i\<^sub>n M2 {iseq}
                  \<and> (\<forall>io\<in>L\<^sub>i\<^sub>n M1 {iseq}. B M1 io \<Omega> \<subseteq> B M2 io \<Omega>)"
    have f2: "x \<in> UNION T (language_state_for_input M1 (initial M1))"
      by (metis (no_types) \<open>x \<in> L\<^sub>i\<^sub>n M1 T\<close> language_state_for_inputs_alt_def)
    obtain aas :: "'a list set \<Rightarrow> ('a list \<Rightarrow> ('a \<times> 'b) list set) \<Rightarrow> ('a \<times> 'b) list \<Rightarrow> 'a list"
      where
      "\<forall>x0 x1 x2. (\<exists>v3. v3 \<in> x0 \<and> x2 \<in> x1 v3) = (aas x0 x1 x2 \<in> x0 \<and> x2 \<in> x1 (aas x0 x1 x2))"
      by moura
    then have "\<forall>ps f A. (ps \<notin> UNION A f \<or> aas A f ps \<in> A \<and> ps \<in> f (aas A f ps))
                          \<and> (ps \<in> UNION A f \<or> (\<forall>as. as \<notin> A \<or> ps \<notin> f as))"
      by blast
    then show ?thesis
      using f2 a1 by (metis (no_types) contra_subsetD language_state_for_input_alt_def
                      language_state_for_inputs_alt_def)
  qed
next
  show "(\<Union>io\<in>L\<^sub>i\<^sub>n M1 T. {io} \<times> B M1 io \<Omega>) \<subseteq> (\<Union>io\<in>L\<^sub>i\<^sub>n M2 T. {io} \<times> B M2 io \<Omega>)"
  proof
    fix iox assume "iox \<in> (\<Union>io\<in>L\<^sub>i\<^sub>n M1 T. {io} \<times> B M1 io \<Omega>)"
    then obtain io x where "iox = (io,x)"
      by blast

    have "io \<in> L\<^sub>i\<^sub>n M1 T"
      using \<open>iox = (io, x)\<close> \<open>iox \<in> (\<Union>io\<in>L\<^sub>i\<^sub>n M1 T. {io} \<times> B M1 io \<Omega>)\<close> by blast
    have "(io,x) \<in> {io} \<times> B M1 io \<Omega>"
      using \<open>iox = (io, x)\<close> \<open>iox \<in> (\<Union>io\<in>L\<^sub>i\<^sub>n M1 T. {io} \<times> B M1 io \<Omega>)\<close> by blast
    then have "x \<in> B M1 io \<Omega>"
      by blast

    then have "x \<in> B M2 io \<Omega>"
      using assms unfolding atc_io_reduction_on_sets.simps atc_io_reduction_on.simps
      by (metis (no_types, lifting) UN_E \<open>io \<in> L\<^sub>i\<^sub>n M1 T\<close> language_state_for_input_alt_def
          language_state_for_inputs_alt_def subsetCE)
    then have "(io,x) \<in> {io} \<times>B M2 io \<Omega>"
      by blast
    then have "(io,x) \<in> (\<Union>io\<in>L\<^sub>i\<^sub>n M2 T. {io} \<times> B M2 io \<Omega>)"
      using \<open>io \<in> L\<^sub>i\<^sub>n M1 T\<close> by auto
    then show "iox \<in> (\<Union>io\<in>L\<^sub>i\<^sub>n M2 T. {io} \<times> B M2 io \<Omega>)"
      using \<open>iox = (io, x)\<close> by auto
  qed
qed

lemma atc_io_reduction_on_sets_alt_def :
  shows "atc_io_reduction_on_sets M1 T \<Omega> M2 =
           (L\<^sub>i\<^sub>n M1 T \<subseteq> L\<^sub>i\<^sub>n M2 T
            \<and> (\<Union>io\<in>L\<^sub>i\<^sub>n M1 T. {io} \<times> B M1 io \<Omega>)
                \<subseteq> (\<Union>io\<in>L\<^sub>i\<^sub>n M2 T. {io} \<times> B M2 io \<Omega>))"
  using atc_io_reduction_on_sets_to_obs[of M1 T \<Omega> M2]
  and   atc_io_reduction_on_sets_from_obs[of M1 T M2 \<Omega>]
  by blast

lemma asc_algorithm_correctness:
"VARS tsN cN rmN obs obsI obs\<^sub>\<Omega> obsI\<^sub>\<Omega> iter isReduction
  {
    OFSM M1 \<and> OFSM M2 \<and> asc_fault_domain M2 M1 m \<and> test_tools M2 M1 FAIL PM V \<Omega>
  }
  tsN := {};
  cN  := V;
  rmN := {};
  obs := L\<^sub>i\<^sub>n M2 cN;
  obsI := L\<^sub>i\<^sub>n M1 cN;
  obs\<^sub>\<Omega> := (\<Union>io\<in>L\<^sub>i\<^sub>n M2 cN. {io} \<times> B M2 io \<Omega>);
  obsI\<^sub>\<Omega> := (\<Union>io\<in>L\<^sub>i\<^sub>n M1 cN. {io} \<times> B M1 io \<Omega>);
  iter := 1;
  WHILE (cN \<noteq> {} \<and> obsI \<subseteq> obs \<and> obsI\<^sub>\<Omega> \<subseteq> obs\<^sub>\<Omega>)
  INV {
    0 < iter
    \<and> tsN = TS M2 M1 \<Omega> V m (iter-1)
    \<and> cN = C M2 M1 \<Omega> V m iter
    \<and> rmN = RM M2 M1 \<Omega> V m (iter-1)
    \<and> obs = L\<^sub>i\<^sub>n M2 (tsN \<union> cN)
    \<and> obsI = L\<^sub>i\<^sub>n M1 (tsN \<union> cN)
    \<and> obs\<^sub>\<Omega> = (\<Union>io\<in>L\<^sub>i\<^sub>n M2 (tsN \<union> cN). {io} \<times> B M2 io \<Omega>)
    \<and> obsI\<^sub>\<Omega> = (\<Union>io\<in>L\<^sub>i\<^sub>n M1 (tsN \<union> cN). {io} \<times> B M1 io \<Omega>)
    \<and> OFSM M1 \<and> OFSM M2 \<and> asc_fault_domain M2 M1 m \<and> test_tools M2 M1 FAIL PM V \<Omega>
  }
  DO
    iter := iter + 1;
    rmN := {xs' \<in> cN .
      (\<not> atc_io_reduction_on M1 M2 xs' \<Omega>)
      \<or> (\<forall> io \<in> L\<^sub>i\<^sub>n M1 {xs'} .
          (\<exists> V'' \<in> N io M1 V .
            (\<exists> S1 .
              (\<exists> vs xs .
                io = (vs@xs)
                \<and> mcp (vs@xs) V'' vs
                \<and> S1 \<subseteq> nodes M2
                \<and> (\<forall> s1 \<in> S1 . \<forall> s2 \<in> S1 .
                  s1 \<noteq> s2 \<longrightarrow>
                    (\<forall> io1 \<in> RP M2 s1 vs xs V'' .
                       \<forall> io2 \<in> RP M2 s2 vs xs V'' .
                         B M1 io1 \<Omega> \<noteq> B M1 io2 \<Omega> ))
                \<and> m < LB M2 M1 vs xs (tsN \<union> V) S1 \<Omega> V'' ))))};
    tsN := tsN \<union> cN;
    cN := append_set (cN - rmN) (inputs M2) - tsN;
    obs := obs \<union> L\<^sub>i\<^sub>n M2 cN;
    obsI := obsI \<union> L\<^sub>i\<^sub>n M1 cN;
    obs\<^sub>\<Omega> := obs\<^sub>\<Omega> \<union> (\<Union>io\<in>L\<^sub>i\<^sub>n M2 cN. {io} \<times> B M2 io \<Omega>);
    obsI\<^sub>\<Omega> := obsI\<^sub>\<Omega> \<union> (\<Union>io\<in>L\<^sub>i\<^sub>n M1 cN. {io} \<times> B M1 io \<Omega>)
  OD;
  isReduction := ((obsI \<subseteq> obs) \<and> (obsI\<^sub>\<Omega> \<subseteq> obs\<^sub>\<Omega>))
  {
    isReduction = M1 \<preceq> M2   \<comment>\<open>variable isReduction is used only as a return value,
                               it is true if and only if M1 is a reduction of M2\<close>
  }"
proof (vcg)
  assume precond : "OFSM M1 \<and> OFSM M2 \<and> asc_fault_domain M2 M1 m \<and> test_tools M2 M1 FAIL PM V \<Omega>"
  have "{} = TS M2 M1 \<Omega> V m (1-1)"
       "V = C M2 M1 \<Omega> V m 1"
       "{} = RM M2 M1 \<Omega> V m (1-1)"
       "L\<^sub>i\<^sub>n M2 V = L\<^sub>i\<^sub>n M2 ({} \<union> V)"
       "L\<^sub>i\<^sub>n M1 V = L\<^sub>i\<^sub>n M1 ({} \<union> V)"
       "(\<Union>io\<in>L\<^sub>i\<^sub>n M2 V. {io} \<times> B M2 io \<Omega>)
          = (\<Union>io\<in>L\<^sub>i\<^sub>n M2 ({} \<union> V). {io} \<times> B M2 io \<Omega>)"
       "(\<Union>io\<in>L\<^sub>i\<^sub>n M1 V. {io} \<times> B M1 io \<Omega>)
          = (\<Union>io\<in>L\<^sub>i\<^sub>n M1 ({} \<union> V). {io} \<times> B M1 io \<Omega>)"
    using precond by auto
  moreover have "OFSM M1 \<and> OFSM M2 \<and> asc_fault_domain M2 M1 m \<and> test_tools M2 M1 FAIL PM V \<Omega> "
    using precond by assumption
  ultimately show "0 < (1::nat) \<and>
                   {} = TS M2 M1 \<Omega> V m (1 - 1) \<and>
                   V = C M2 M1 \<Omega> V m 1 \<and>
                   {} = RM M2 M1 \<Omega> V m (1 - 1) \<and>
                   L\<^sub>i\<^sub>n M2 V = L\<^sub>i\<^sub>n M2 ({} \<union> V) \<and>
                   L\<^sub>i\<^sub>n M1 V = L\<^sub>i\<^sub>n M1 ({} \<union> V) \<and>
                   (\<Union>io\<in>L\<^sub>i\<^sub>n M2 V. {io} \<times> B M2 io \<Omega>)
                      = (\<Union>io\<in>L\<^sub>i\<^sub>n M2 ({} \<union> V). {io} \<times> B M2 io \<Omega>) \<and>
                   (\<Union>io\<in>L\<^sub>i\<^sub>n M1 V. {io} \<times> B M1 io \<Omega>)
                      = (\<Union>io\<in>L\<^sub>i\<^sub>n M1 ({} \<union> V). {io} \<times> B M1 io \<Omega>) \<and>
                   OFSM M1 \<and> OFSM M2 \<and> asc_fault_domain M2 M1 m \<and> test_tools M2 M1 FAIL PM V \<Omega>"
    by linarith+
next
  fix tsN cN rmN obs obsI obs\<^sub>\<Omega> obsI\<^sub>\<Omega> iter isReduction
  assume precond : "(0 < iter \<and>
                      tsN = TS M2 M1 \<Omega> V m (iter - 1) \<and>
                      cN = C M2 M1 \<Omega> V m iter \<and>
                      rmN = RM M2 M1 \<Omega> V m (iter - 1) \<and>
                      obs = L\<^sub>i\<^sub>n M2 (tsN \<union> cN) \<and>
                      obsI = L\<^sub>i\<^sub>n M1 (tsN \<union> cN) \<and>
                      obs\<^sub>\<Omega> = (\<Union>io\<in>L\<^sub>i\<^sub>n M2 (tsN \<union> cN). {io} \<times> B M2 io \<Omega>) \<and>
                      obsI\<^sub>\<Omega> = (\<Union>io\<in>L\<^sub>i\<^sub>n M1 (tsN \<union> cN). {io} \<times> B M1 io \<Omega>) \<and>
                      OFSM M1 \<and> OFSM M2 \<and> asc_fault_domain M2 M1 m \<and> test_tools M2 M1 FAIL PM V \<Omega>)
                    \<and> cN \<noteq> {} \<and> obsI \<subseteq> obs \<and> obsI\<^sub>\<Omega> \<subseteq> obs\<^sub>\<Omega>"
  then have "0 < iter"
            "OFSM M1"
            "OFSM M2"
            "asc_fault_domain M2 M1 m"
            "test_tools M2 M1 FAIL PM V \<Omega>"
            "cN \<noteq> {}"
            "obsI \<subseteq> obs"
            "tsN = TS M2 M1 \<Omega> V m (iter-1)"
            "cN = C M2 M1 \<Omega> V m iter"
            "rmN = RM M2 M1 \<Omega> V m (iter-1)"
            "obs = L\<^sub>i\<^sub>n M2 (tsN \<union> cN)"
            "obsI = L\<^sub>i\<^sub>n M1 (tsN \<union> cN)"
            "obs\<^sub>\<Omega> = (\<Union>io\<in>L\<^sub>i\<^sub>n M2 (tsN \<union> cN). {io} \<times> B M2 io \<Omega>)"
            "obsI\<^sub>\<Omega> = (\<Union>io\<in>L\<^sub>i\<^sub>n M1 (tsN \<union> cN). {io} \<times> B M1 io \<Omega>)"
    by linarith+

  obtain k where "iter = Suc k"
    using gr0_implies_Suc[OF \<open>0 < iter\<close>] by blast
  then have "cN = C M2 M1 \<Omega> V m (Suc k)"
            "tsN = TS M2 M1 \<Omega> V m k"
    using \<open>cN = C M2 M1 \<Omega> V m iter\<close> \<open>tsN = TS M2 M1 \<Omega> V m (iter-1)\<close> by auto
  have "TS M2 M1 \<Omega> V m iter = TS M2 M1 \<Omega> V m (Suc k)"
           "C M2 M1 \<Omega> V m iter = C M2 M1 \<Omega> V m (Suc k)"
           "RM M2 M1 \<Omega> V m iter = RM M2 M1 \<Omega> V m (Suc k)"
    using \<open>iter = Suc k\<close> by presburger+

  have rmN_calc[simp] : "{xs' \<in> cN.
        (\<not> atc_io_reduction_on M1 M2 xs' \<Omega>) \<or>
        (\<forall>io\<in>L\<^sub>i\<^sub>n M1 {xs'}.
            \<exists>V''\<in>N io M1 V.
               \<exists>S1 vs xs.
                  io = vs @ xs \<and>
                  mcp (vs @ xs) V'' vs \<and>
                  S1 \<subseteq> nodes M2 \<and>
                  (\<forall>s1\<in>S1.
                      \<forall>s2\<in>S1.
                         s1 \<noteq> s2 \<longrightarrow>
                         (\<forall>io1\<in>RP M2 s1 vs xs V''. \<forall>io2\<in>RP M2 s2 vs xs V''.
                            B M1 io1 \<Omega> \<noteq> B M1 io2 \<Omega>)) \<and>
                  m < LB M2 M1 vs xs (tsN \<union> V) S1 \<Omega> V'')} =
       RM M2 M1 \<Omega> V m iter"
  proof -

    have "{xs' \<in> cN.
          (\<not> atc_io_reduction_on M1 M2 xs' \<Omega>) \<or>
          (\<forall>io\<in>L\<^sub>i\<^sub>n M1 {xs'}.
              \<exists>V''\<in>N io M1 V.
                 \<exists>S1 vs xs.
                    io = vs @ xs \<and>
                    mcp (vs @ xs) V'' vs \<and>
                    S1 \<subseteq> nodes M2 \<and>
                    (\<forall>s1\<in>S1.
                        \<forall>s2\<in>S1.
                           s1 \<noteq> s2 \<longrightarrow>
                           (\<forall>io1\<in>RP M2 s1 vs xs V''. \<forall>io2\<in>RP M2 s2 vs xs V''.
                              B M1 io1 \<Omega> \<noteq> B M1 io2 \<Omega>)) \<and>
                    m < LB M2 M1 vs xs (tsN \<union> V) S1 \<Omega> V'')} =
          {xs' \<in> C M2 M1 \<Omega> V m (Suc k).
          (\<not> atc_io_reduction_on M1 M2 xs' \<Omega>) \<or>
          (\<forall>io\<in>L\<^sub>i\<^sub>n M1 {xs'}.
              \<exists>V''\<in>N io M1 V.
                 \<exists>S1 vs xs.
                    io = vs @ xs \<and>
                    mcp (vs @ xs) V'' vs \<and>
                    S1 \<subseteq> nodes M2 \<and>
                    (\<forall>s1\<in>S1.
                        \<forall>s2\<in>S1.
                           s1 \<noteq> s2 \<longrightarrow>
                           (\<forall>io1\<in>RP M2 s1 vs xs V''. \<forall>io2\<in>RP M2 s2 vs xs V''.
                              B M1 io1 \<Omega> \<noteq> B M1 io2 \<Omega>)) \<and>
                    m < LB M2 M1 vs xs ((TS M2 M1 \<Omega> V m k) \<union> V) S1 \<Omega> V'')}"
      using \<open>cN = C M2 M1 \<Omega> V m (Suc k)\<close> \<open>tsN = TS M2 M1 \<Omega> V m k\<close> by blast

    moreover have "{xs' \<in> C M2 M1 \<Omega> V m (Suc k).
                    (\<not> atc_io_reduction_on M1 M2 xs' \<Omega>) \<or>
                    (\<forall>io\<in>L\<^sub>i\<^sub>n M1 {xs'}.
                        \<exists>V''\<in>N io M1 V.
                           \<exists>S1 vs xs.
                              io = vs @ xs \<and>
                              mcp (vs @ xs) V'' vs \<and>
                              S1 \<subseteq> nodes M2 \<and>
                              (\<forall>s1\<in>S1.
                                  \<forall>s2\<in>S1.
                                     s1 \<noteq> s2 \<longrightarrow>
                                     (\<forall>io1\<in>RP M2 s1 vs xs V''. \<forall>io2\<in>RP M2 s2 vs xs V''.
                                        B M1 io1 \<Omega> \<noteq> B M1 io2 \<Omega>)) \<and>
                              m < LB M2 M1 vs xs ((TS M2 M1 \<Omega> V m k) \<union> V) S1 \<Omega> V'')} =
                    RM M2 M1 \<Omega> V m (Suc k)"
      using RM.simps(2)[of M2 M1 \<Omega> V m k] by blast
    ultimately have "{xs' \<in> cN.
                      (\<not> atc_io_reduction_on M1 M2 xs' \<Omega>) \<or>
                      (\<forall>io\<in>L\<^sub>i\<^sub>n M1 {xs'}.
                          \<exists>V''\<in>N io M1 V.
                             \<exists>S1 vs xs.
                                io = vs @ xs \<and>
                                mcp (vs @ xs) V'' vs \<and>
                                S1 \<subseteq> nodes M2 \<and>
                                (\<forall>s1\<in>S1.
                                    \<forall>s2\<in>S1.
                                       s1 \<noteq> s2 \<longrightarrow>
                                       (\<forall>io1\<in>RP M2 s1 vs xs V''. \<forall>io2\<in>RP M2 s2 vs xs V''.
                                          B M1 io1 \<Omega> \<noteq> B M1 io2 \<Omega>)) \<and>
                                m < LB M2 M1 vs xs (tsN \<union> V) S1 \<Omega> V'')} =
                      RM M2 M1 \<Omega> V m (Suc k)"
      by presburger
    then show ?thesis
      using \<open>iter = Suc k\<close> by presburger
  qed
  moreover have "RM M2 M1 \<Omega> V m iter = RM M2 M1 \<Omega> V m (iter + 1 - 1)" by simp
  ultimately have rmN_calc' : "{xs' \<in> cN.
        (\<not> atc_io_reduction_on M1 M2 xs' \<Omega>) \<or>
        (\<forall>io\<in>L\<^sub>i\<^sub>n M1 {xs'}.
            \<exists>V''\<in>N io M1 V.
               \<exists>S1 vs xs.
                  io = vs @ xs \<and>
                  mcp (vs @ xs) V'' vs \<and>
                  S1 \<subseteq> nodes M2 \<and>
                  (\<forall>s1\<in>S1.
                      \<forall>s2\<in>S1.
                         s1 \<noteq> s2 \<longrightarrow>
                         (\<forall>io1\<in>RP M2 s1 vs xs V''. \<forall>io2\<in>RP M2 s2 vs xs V''.
                            B M1 io1 \<Omega> \<noteq> B M1 io2 \<Omega>)) \<and>
                  m < LB M2 M1 vs xs (tsN \<union> V) S1 \<Omega> V'')} =
       RM M2 M1 \<Omega> V m (iter + 1 - 1)" by presburger

  have "tsN \<union> cN = TS M2 M1 \<Omega> V m (Suc k)"
  proof (cases k)
    case 0
    then show ?thesis
      using \<open>tsN = TS M2 M1 \<Omega> V m k\<close> \<open>cN = C M2 M1 \<Omega> V m (Suc k)\<close> by auto
  next
    case (Suc nat)
    then have "TS M2 M1 \<Omega> V m (Suc k) = TS M2 M1 \<Omega> V m k \<union> C M2 M1 \<Omega> V m (Suc k)"
      using TS.simps(3) by blast
    moreover have "tsN \<union> cN = TS M2 M1 \<Omega> V m k \<union> C M2 M1 \<Omega> V m (Suc k)"
      using \<open>tsN = TS M2 M1 \<Omega> V m k\<close> \<open>cN = C M2 M1 \<Omega> V m (Suc k)\<close> by auto
    ultimately show ?thesis
      by auto
  qed
  then have tsN_calc : "tsN \<union> cN = TS M2 M1 \<Omega> V m iter"
    using \<open>iter = Suc k\<close> by presburger

  have cN_calc : "append_set
        (cN -
         {xs' \<in> cN.
          (\<not> atc_io_reduction_on M1 M2 xs' \<Omega>) \<or>
          (\<forall>io\<in>L\<^sub>i\<^sub>n M1 {xs'}.
              \<exists>V''\<in>N io M1 V.
                 \<exists>S1 vs xs.
                    io = vs @ xs \<and>
                    mcp (vs @ xs) V'' vs \<and>
                    S1 \<subseteq> nodes M2 \<and>
                    (\<forall>s1\<in>S1.
                        \<forall>s2\<in>S1.
                           s1 \<noteq> s2 \<longrightarrow>
                           (\<forall>io1\<in>RP M2 s1 vs xs V''.
                               \<forall>io2\<in>RP M2 s2 vs xs V''. B M1 io1 \<Omega> \<noteq> B M1 io2 \<Omega>)) \<and>
                    m < LB M2 M1 vs xs (tsN \<union> V) S1 \<Omega> V'')})
        (inputs M2) -
       (tsN \<union> cN) =
       C M2 M1 \<Omega> V m (iter + 1)"
  proof -
    have "append_set
          (cN -
           {xs' \<in> cN.
            (\<not> atc_io_reduction_on M1 M2 xs' \<Omega>) \<or>
            (\<forall>io\<in>L\<^sub>i\<^sub>n M1 {xs'}.
                \<exists>V''\<in>N io M1 V.
                   \<exists>S1 vs xs.
                      io = vs @ xs \<and>
                      mcp (vs @ xs) V'' vs \<and>
                      S1 \<subseteq> nodes M2 \<and>
                      (\<forall>s1\<in>S1.
                          \<forall>s2\<in>S1.
                             s1 \<noteq> s2 \<longrightarrow>
                             (\<forall>io1\<in>RP M2 s1 vs xs V''.
                                 \<forall>io2\<in>RP M2 s2 vs xs V''. B M1 io1 \<Omega> \<noteq> B M1 io2 \<Omega>)) \<and>
                      m < LB M2 M1 vs xs (tsN \<union> V) S1 \<Omega> V'')})
          (inputs M2) -
         (tsN \<union> cN) =
         append_set
          ((C M2 M1 \<Omega> V m iter) -
           (RM M2 M1 \<Omega> V m iter))
          (inputs M2) -
         (TS M2 M1 \<Omega> V m iter) "
      using \<open>cN = C M2 M1 \<Omega> V m iter\<close> \<open>tsN \<union> cN = TS M2 M1 \<Omega> V m iter\<close> rmN_calc by presburger
    moreover have "append_set
          ((C M2 M1 \<Omega> V m iter) -
           (RM M2 M1 \<Omega> V m iter))
          (inputs M2) -
         (TS M2 M1 \<Omega> V m iter) = C M2 M1 \<Omega> V m (iter + 1)"
    proof -
      have "C M2 M1 \<Omega> V m (iter + 1) = C M2 M1 \<Omega> V m ((Suc k) + 1)"
        using \<open>iter = Suc k\<close> by presburger+
      moreover have "(Suc k) + 1 = Suc (Suc k)"
        by simp
      ultimately have "C M2 M1 \<Omega> V m (iter + 1) = C M2 M1 \<Omega> V m (Suc (Suc k))"
        by presburger

      have "C M2 M1 \<Omega> V m (Suc (Suc k))
              = append_set (C M2 M1 \<Omega> V m (Suc k) - RM M2 M1 \<Omega> V m (Suc k)) (inputs M2)
                - TS M2 M1 \<Omega> V m (Suc k)"
        using C.simps(3)[of M2 M1 \<Omega> V m k] by linarith
      show ?thesis
        using Suc_eq_plus1
              \<open>C M2 M1 \<Omega> V m (Suc (Suc k))
                = append_set (C M2 M1 \<Omega> V m (Suc k) - RM M2 M1 \<Omega> V m (Suc k)) (inputs M2)
                  - TS M2 M1 \<Omega> V m (Suc k)\<close>
              \<open>iter = Suc k\<close>
        by presburger
    qed

    ultimately show ?thesis
      by presburger
  qed

  have obs_calc : "obs \<union>
       L\<^sub>i\<^sub>n M2
        (append_set
          (cN -
           {xs' \<in> cN.
            (\<not> atc_io_reduction_on M1 M2 xs' \<Omega>) \<or>
            (\<forall>io\<in>L\<^sub>i\<^sub>n M1 {xs'}.
                \<exists>V''\<in>N io M1 V.
                   \<exists>S1 vs xs.
                      io = vs @ xs \<and>
                      mcp (vs @ xs) V'' vs \<and>
                      S1 \<subseteq> nodes M2 \<and>
                      (\<forall>s1\<in>S1.
                          \<forall>s2\<in>S1.
                             s1 \<noteq> s2 \<longrightarrow>
                             (\<forall>io1\<in>RP M2 s1 vs xs V''.
                                 \<forall>io2\<in>RP M2 s2 vs xs V''. B M1 io1 \<Omega> \<noteq> B M1 io2 \<Omega>)) \<and>
                      m < LB M2 M1 vs xs (tsN \<union> V) S1 \<Omega> V'')})
          (inputs M2) -
         (tsN \<union> cN)) =
       L\<^sub>i\<^sub>n M2
        (tsN \<union> cN \<union>
         (append_set
           (cN -
            {xs' \<in> cN.
             (\<not> atc_io_reduction_on M1 M2 xs' \<Omega>) \<or>
             (\<forall>io\<in>L\<^sub>i\<^sub>n M1 {xs'}.
                 \<exists>V''\<in>N io M1 V.
                    \<exists>S1 vs xs.
                       io = vs @ xs \<and>
                       mcp (vs @ xs) V'' vs \<and>
                       S1 \<subseteq> nodes M2 \<and>
                       (\<forall>s1\<in>S1.
                           \<forall>s2\<in>S1.
                              s1 \<noteq> s2 \<longrightarrow>
                              (\<forall>io1\<in>RP M2 s1 vs xs V''.
                                  \<forall>io2\<in>RP M2 s2 vs xs V''. B M1 io1 \<Omega> \<noteq> B M1 io2 \<Omega>)) \<and>
                       m < LB M2 M1 vs xs (tsN \<union> V) S1 \<Omega> V'')})
           (inputs M2) -
          (tsN \<union> cN)))"
  proof -
    have "\<And>A. L\<^sub>i\<^sub>n M2 (tsN \<union> cN \<union> A) = obs \<union> L\<^sub>i\<^sub>n M2 A"
      by (metis (no_types) language_state_for_inputs_union precond)
    then show ?thesis
      by blast
  qed

  have obsI_calc : "obsI \<union>
       L\<^sub>i\<^sub>n M1
        (append_set
          (cN -
           {xs' \<in> cN.
            (\<not> atc_io_reduction_on M1 M2 xs' \<Omega>) \<or>
            (\<forall>io\<in>L\<^sub>i\<^sub>n M1 {xs'}.
                \<exists>V''\<in>N io M1 V.
                   \<exists>S1 vs xs.
                      io = vs @ xs \<and>
                      mcp (vs @ xs) V'' vs \<and>
                      S1 \<subseteq> nodes M2 \<and>
                      (\<forall>s1\<in>S1.
                          \<forall>s2\<in>S1.
                             s1 \<noteq> s2 \<longrightarrow>
                             (\<forall>io1\<in>RP M2 s1 vs xs V''.
                                 \<forall>io2\<in>RP M2 s2 vs xs V''. B M1 io1 \<Omega> \<noteq> B M1 io2 \<Omega>)) \<and>
                      m < LB M2 M1 vs xs (tsN \<union> V) S1 \<Omega> V'')})
          (inputs M2) -
         (tsN \<union> cN)) =
       L\<^sub>i\<^sub>n M1
        (tsN \<union> cN \<union>
         (append_set
           (cN -
            {xs' \<in> cN.
             (\<not> atc_io_reduction_on M1 M2 xs' \<Omega>) \<or>
             (\<forall>io\<in>L\<^sub>i\<^sub>n M1 {xs'}.
                 \<exists>V''\<in>N io M1 V.
                    \<exists>S1 vs xs.
                       io = vs @ xs \<and>
                       mcp (vs @ xs) V'' vs \<and>
                       S1 \<subseteq> nodes M2 \<and>
                       (\<forall>s1\<in>S1.
                           \<forall>s2\<in>S1.
                              s1 \<noteq> s2 \<longrightarrow>
                              (\<forall>io1\<in>RP M2 s1 vs xs V''.
                                  \<forall>io2\<in>RP M2 s2 vs xs V''. B M1 io1 \<Omega> \<noteq> B M1 io2 \<Omega>)) \<and>
                       m < LB M2 M1 vs xs (tsN \<union> V) S1 \<Omega> V'')})
           (inputs M2) -
          (tsN \<union> cN)))"
  proof -
    have "\<And>A. L\<^sub>i\<^sub>n M1 (tsN \<union> cN \<union> A) = obsI \<union> L\<^sub>i\<^sub>n M1 A"
      by (metis (no_types) language_state_for_inputs_union precond)
    then show ?thesis
      by blast
  qed

  have obs\<^sub>\<Omega>_calc : "obs\<^sub>\<Omega> \<union>
       (\<Union>io\<in>L\<^sub>i\<^sub>n M2
              (append_set
                (cN -
                 {xs' \<in> cN.
                  (\<not> atc_io_reduction_on M1 M2 xs' \<Omega>) \<or>
                  (\<forall>io\<in>L\<^sub>i\<^sub>n M1 {xs'}.
                      \<exists>V''\<in>N io M1 V.
                         \<exists>S1 vs xs.
                            io = vs @ xs \<and>
                            mcp (vs @ xs) V'' vs \<and>
                            S1 \<subseteq> nodes M2 \<and>
                            (\<forall>s1\<in>S1.
                                \<forall>s2\<in>S1.
                                   s1 \<noteq> s2 \<longrightarrow>
                                   (\<forall>io1\<in>RP M2 s1 vs xs V''.
                                       \<forall>io2\<in>RP M2 s2 vs xs V''. B M1 io1 \<Omega> \<noteq> B M1 io2 \<Omega>)) \<and>
                            m < LB M2 M1 vs xs (tsN \<union> V) S1 \<Omega> V'')})
                (inputs M2) -
               (tsN \<union> cN)).
           {io} \<times> B M2 io \<Omega>) =
       (\<Union>io\<in>L\<^sub>i\<^sub>n M2
              (tsN \<union> cN \<union>
               (append_set
                 (cN -
                  {xs' \<in> cN.
                   (\<not> atc_io_reduction_on M1 M2 xs' \<Omega>) \<or>
                   (\<forall>io\<in>L\<^sub>i\<^sub>n M1 {xs'}.
                       \<exists>V''\<in>N io M1 V.
                          \<exists>S1 vs xs.
                             io = vs @ xs \<and>
                             mcp (vs @ xs) V'' vs \<and>
                             S1 \<subseteq> nodes M2 \<and>
                             (\<forall>s1\<in>S1.
                                 \<forall>s2\<in>S1.
                                    s1 \<noteq> s2 \<longrightarrow>
                                    (\<forall>io1\<in>RP M2 s1 vs xs V''.
                                        \<forall>io2\<in>RP M2 s2 vs xs V''. B M1 io1 \<Omega> \<noteq> B M1 io2 \<Omega>)) \<and>
                             m < LB M2 M1 vs xs (tsN \<union> V) S1 \<Omega> V'')})
                 (inputs M2) -
                (tsN \<union> cN))).
           {io} \<times> B M2 io \<Omega>)"
    using \<open>obs = L\<^sub>i\<^sub>n M2 (tsN \<union> cN)\<close>
          \<open>obs\<^sub>\<Omega> = (\<Union>io\<in>L\<^sub>i\<^sub>n M2 (tsN \<union> cN). {io} \<times> B M2 io \<Omega>)\<close>
          obs_calc
    by blast

  have obsI\<^sub>\<Omega>_calc : "obsI\<^sub>\<Omega> \<union>
       (\<Union>io\<in>L\<^sub>i\<^sub>n M1
              (append_set
                (cN -
                 {xs' \<in> cN.
                  (\<not> atc_io_reduction_on M1 M2 xs' \<Omega>) \<or>
                  (\<forall>io\<in>L\<^sub>i\<^sub>n M1 {xs'}.
                      \<exists>V''\<in>N io M1 V.
                         \<exists>S1 vs xs.
                            io = vs @ xs \<and>
                            mcp (vs @ xs) V'' vs \<and>
                            S1 \<subseteq> nodes M2 \<and>
                            (\<forall>s1\<in>S1.
                                \<forall>s2\<in>S1.
                                   s1 \<noteq> s2 \<longrightarrow>
                                   (\<forall>io1\<in>RP M2 s1 vs xs V''.
                                       \<forall>io2\<in>RP M2 s2 vs xs V''. B M1 io1 \<Omega> \<noteq> B M1 io2 \<Omega>)) \<and>
                            m < LB M2 M1 vs xs (tsN \<union> V) S1 \<Omega> V'')})
                (inputs M2) -
               (tsN \<union> cN)).
           {io} \<times> B M1 io \<Omega>) =
       (\<Union>io\<in>L\<^sub>i\<^sub>n M1
              (tsN \<union> cN \<union>
               (append_set
                 (cN -
                  {xs' \<in> cN.
                   (\<not> atc_io_reduction_on M1 M2 xs' \<Omega>) \<or>
                   (\<forall>io\<in>L\<^sub>i\<^sub>n M1 {xs'}.
                       \<exists>V''\<in>N io M1 V.
                          \<exists>S1 vs xs.
                             io = vs @ xs \<and>
                             mcp (vs @ xs) V'' vs \<and>
                             S1 \<subseteq> nodes M2 \<and>
                             (\<forall>s1\<in>S1.
                                 \<forall>s2\<in>S1.
                                    s1 \<noteq> s2 \<longrightarrow>
                                    (\<forall>io1\<in>RP M2 s1 vs xs V''.
                                        \<forall>io2\<in>RP M2 s2 vs xs V''. B M1 io1 \<Omega> \<noteq> B M1 io2 \<Omega>)) \<and>
                             m < LB M2 M1 vs xs (tsN \<union> V) S1 \<Omega> V'')})
                 (inputs M2) -
                (tsN \<union> cN))).
           {io} \<times> B M1 io \<Omega>)"
    using \<open>obsI = L\<^sub>i\<^sub>n M1 (tsN \<union> cN)\<close>
          \<open>obsI\<^sub>\<Omega> = (\<Union>io\<in>L\<^sub>i\<^sub>n M1 (tsN \<union> cN). {io} \<times> B M1 io \<Omega>)\<close>
          obsI_calc
    by blast

  have "0 < iter + 1"
    using \<open>0 < iter\<close> by simp
  have "tsN \<union> cN = TS M2 M1 \<Omega> V m (iter + 1 - 1)"
    using tsN_calc by simp

  from \<open>0 < iter + 1\<close>
       \<open>tsN \<union> cN = TS M2 M1 \<Omega> V m (iter + 1 - 1)\<close>
       cN_calc
       rmN_calc'
       obs_calc
       obsI_calc
       obs\<^sub>\<Omega>_calc
       obsI\<^sub>\<Omega>_calc
       \<open>OFSM M1\<close>
       \<open>OFSM M2\<close>
       \<open>asc_fault_domain M2 M1 m\<close>
       \<open>test_tools M2 M1 FAIL PM V \<Omega>\<close>
  show "0 < iter + 1 \<and>
       tsN \<union> cN = TS M2 M1 \<Omega> V m (iter + 1 - 1) \<and>
       append_set
        (cN -
         {xs' \<in> cN.
          (\<not> atc_io_reduction_on M1 M2 xs' \<Omega>) \<or>
          (\<forall>io\<in>L\<^sub>i\<^sub>n M1 {xs'}.
              \<exists>V''\<in>N io M1 V.
                 \<exists>S1 vs xs.
                    io = vs @ xs \<and>
                    mcp (vs @ xs) V'' vs \<and>
                    S1 \<subseteq> nodes M2 \<and>
                    (\<forall>s1\<in>S1.
                        \<forall>s2\<in>S1.
                           s1 \<noteq> s2 \<longrightarrow>
                           (\<forall>io1\<in>RP M2 s1 vs xs V''.
                               \<forall>io2\<in>RP M2 s2 vs xs V''. B M1 io1 \<Omega> \<noteq> B M1 io2 \<Omega>)) \<and>
                    m < LB M2 M1 vs xs (tsN \<union> V) S1 \<Omega> V'')})
        (inputs M2) -
       (tsN \<union> cN) =
       C M2 M1 \<Omega> V m (iter + 1) \<and>
       {xs' \<in> cN.
        (\<not> atc_io_reduction_on M1 M2 xs' \<Omega>) \<or>
        (\<forall>io\<in>L\<^sub>i\<^sub>n M1 {xs'}.
            \<exists>V''\<in>N io M1 V.
               \<exists>S1 vs xs.
                  io = vs @ xs \<and>
                  mcp (vs @ xs) V'' vs \<and>
                  S1 \<subseteq> nodes M2 \<and>
                  (\<forall>s1\<in>S1.
                      \<forall>s2\<in>S1.
                         s1 \<noteq> s2 \<longrightarrow>
                         (\<forall>io1\<in>RP M2 s1 vs xs V''. \<forall>io2\<in>RP M2 s2 vs xs V''.
                            B M1 io1 \<Omega> \<noteq> B M1 io2 \<Omega>)) \<and>
                  m < LB M2 M1 vs xs (tsN \<union> V) S1 \<Omega> V'')} =
       RM M2 M1 \<Omega> V m (iter + 1 - 1) \<and>
       obs \<union>
       L\<^sub>i\<^sub>n M2
        (append_set
          (cN -
           {xs' \<in> cN.
            (\<not> atc_io_reduction_on M1 M2 xs' \<Omega>) \<or>
            (\<forall>io\<in>L\<^sub>i\<^sub>n M1 {xs'}.
                \<exists>V''\<in>N io M1 V.
                   \<exists>S1 vs xs.
                      io = vs @ xs \<and>
                      mcp (vs @ xs) V'' vs \<and>
                      S1 \<subseteq> nodes M2 \<and>
                      (\<forall>s1\<in>S1.
                          \<forall>s2\<in>S1.
                             s1 \<noteq> s2 \<longrightarrow>
                             (\<forall>io1\<in>RP M2 s1 vs xs V''.
                                 \<forall>io2\<in>RP M2 s2 vs xs V''. B M1 io1 \<Omega> \<noteq> B M1 io2 \<Omega>)) \<and>
                      m < LB M2 M1 vs xs (tsN \<union> V) S1 \<Omega> V'')})
          (inputs M2) -
         (tsN \<union> cN)) =
       L\<^sub>i\<^sub>n M2
        (tsN \<union> cN \<union>
         (append_set
           (cN -
            {xs' \<in> cN.
             (\<not> atc_io_reduction_on M1 M2 xs' \<Omega>) \<or>
             (\<forall>io\<in>L\<^sub>i\<^sub>n M1 {xs'}.
                 \<exists>V''\<in>N io M1 V.
                    \<exists>S1 vs xs.
                       io = vs @ xs \<and>
                       mcp (vs @ xs) V'' vs \<and>
                       S1 \<subseteq> nodes M2 \<and>
                       (\<forall>s1\<in>S1.
                           \<forall>s2\<in>S1.
                              s1 \<noteq> s2 \<longrightarrow>
                              (\<forall>io1\<in>RP M2 s1 vs xs V''.
                                  \<forall>io2\<in>RP M2 s2 vs xs V''. B M1 io1 \<Omega> \<noteq> B M1 io2 \<Omega>)) \<and>
                       m < LB M2 M1 vs xs (tsN \<union> V) S1 \<Omega> V'')})
           (inputs M2) -
          (tsN \<union> cN))) \<and>
       obsI \<union>
       L\<^sub>i\<^sub>n M1
        (append_set
          (cN -
           {xs' \<in> cN.
            (\<not> atc_io_reduction_on M1 M2 xs' \<Omega>) \<or>
            (\<forall>io\<in>L\<^sub>i\<^sub>n M1 {xs'}.
                \<exists>V''\<in>N io M1 V.
                   \<exists>S1 vs xs.
                      io = vs @ xs \<and>
                      mcp (vs @ xs) V'' vs \<and>
                      S1 \<subseteq> nodes M2 \<and>
                      (\<forall>s1\<in>S1.
                          \<forall>s2\<in>S1.
                             s1 \<noteq> s2 \<longrightarrow>
                             (\<forall>io1\<in>RP M2 s1 vs xs V''.
                                 \<forall>io2\<in>RP M2 s2 vs xs V''. B M1 io1 \<Omega> \<noteq> B M1 io2 \<Omega>)) \<and>
                      m < LB M2 M1 vs xs (tsN \<union> V) S1 \<Omega> V'')})
          (inputs M2) -
         (tsN \<union> cN)) =
       L\<^sub>i\<^sub>n M1
        (tsN \<union> cN \<union>
         (append_set
           (cN -
            {xs' \<in> cN.
             (\<not> atc_io_reduction_on M1 M2 xs' \<Omega>) \<or>
             (\<forall>io\<in>L\<^sub>i\<^sub>n M1 {xs'}.
                 \<exists>V''\<in>N io M1 V.
                    \<exists>S1 vs xs.
                       io = vs @ xs \<and>
                       mcp (vs @ xs) V'' vs \<and>
                       S1 \<subseteq> nodes M2 \<and>
                       (\<forall>s1\<in>S1.
                           \<forall>s2\<in>S1.
                              s1 \<noteq> s2 \<longrightarrow>
                              (\<forall>io1\<in>RP M2 s1 vs xs V''.
                                  \<forall>io2\<in>RP M2 s2 vs xs V''. B M1 io1 \<Omega> \<noteq> B M1 io2 \<Omega>)) \<and>
                       m < LB M2 M1 vs xs (tsN \<union> V) S1 \<Omega> V'')})
           (inputs M2) -
          (tsN \<union> cN))) \<and>
       obs\<^sub>\<Omega> \<union>
       (\<Union>io\<in>L\<^sub>i\<^sub>n M2
              (append_set
                (cN -
                 {xs' \<in> cN.
                  (\<not> atc_io_reduction_on M1 M2 xs' \<Omega>) \<or>
                  (\<forall>io\<in>L\<^sub>i\<^sub>n M1 {xs'}.
                      \<exists>V''\<in>N io M1 V.
                         \<exists>S1 vs xs.
                            io = vs @ xs \<and>
                            mcp (vs @ xs) V'' vs \<and>
                            S1 \<subseteq> nodes M2 \<and>
                            (\<forall>s1\<in>S1.
                                \<forall>s2\<in>S1.
                                   s1 \<noteq> s2 \<longrightarrow>
                                   (\<forall>io1\<in>RP M2 s1 vs xs V''.
                                       \<forall>io2\<in>RP M2 s2 vs xs V''. B M1 io1 \<Omega> \<noteq> B M1 io2 \<Omega>)) \<and>
                            m < LB M2 M1 vs xs (tsN \<union> V) S1 \<Omega> V'')})
                (inputs M2) -
               (tsN \<union> cN)).
           {io} \<times> B M2 io \<Omega>) =
       (\<Union>io\<in>L\<^sub>i\<^sub>n M2
              (tsN \<union> cN \<union>
               (append_set
                 (cN -
                  {xs' \<in> cN.
                   (\<not> atc_io_reduction_on M1 M2 xs' \<Omega>) \<or>
                   (\<forall>io\<in>L\<^sub>i\<^sub>n M1 {xs'}.
                       \<exists>V''\<in>N io M1 V.
                          \<exists>S1 vs xs.
                             io = vs @ xs \<and>
                             mcp (vs @ xs) V'' vs \<and>
                             S1 \<subseteq> nodes M2 \<and>
                             (\<forall>s1\<in>S1.
                                 \<forall>s2\<in>S1.
                                    s1 \<noteq> s2 \<longrightarrow>
                                    (\<forall>io1\<in>RP M2 s1 vs xs V''.
                                        \<forall>io2\<in>RP M2 s2 vs xs V''. B M1 io1 \<Omega> \<noteq> B M1 io2 \<Omega>)) \<and>
                             m < LB M2 M1 vs xs (tsN \<union> V) S1 \<Omega> V'')})
                 (inputs M2) -
                (tsN \<union> cN))).
           {io} \<times> B M2 io \<Omega>) \<and>
       obsI\<^sub>\<Omega> \<union>
       (\<Union>io\<in>L\<^sub>i\<^sub>n M1
              (append_set
                (cN -
                 {xs' \<in> cN.
                  (\<not> atc_io_reduction_on M1 M2 xs' \<Omega>) \<or>
                  (\<forall>io\<in>L\<^sub>i\<^sub>n M1 {xs'}.
                      \<exists>V''\<in>N io M1 V.
                         \<exists>S1 vs xs.
                            io = vs @ xs \<and>
                            mcp (vs @ xs) V'' vs \<and>
                            S1 \<subseteq> nodes M2 \<and>
                            (\<forall>s1\<in>S1.
                                \<forall>s2\<in>S1.
                                   s1 \<noteq> s2 \<longrightarrow>
                                   (\<forall>io1\<in>RP M2 s1 vs xs V''.
                                       \<forall>io2\<in>RP M2 s2 vs xs V''. B M1 io1 \<Omega> \<noteq> B M1 io2 \<Omega>)) \<and>
                            m < LB M2 M1 vs xs (tsN \<union> V) S1 \<Omega> V'')})
                (inputs M2) -
               (tsN \<union> cN)).
           {io} \<times> B M1 io \<Omega>) =
       (\<Union>io\<in>L\<^sub>i\<^sub>n M1
              (tsN \<union> cN \<union>
               (append_set
                 (cN -
                  {xs' \<in> cN.
                   (\<not> atc_io_reduction_on M1 M2 xs' \<Omega>) \<or>
                   (\<forall>io\<in>L\<^sub>i\<^sub>n M1 {xs'}.
                       \<exists>V''\<in>N io M1 V.
                          \<exists>S1 vs xs.
                             io = vs @ xs \<and>
                             mcp (vs @ xs) V'' vs \<and>
                             S1 \<subseteq> nodes M2 \<and>
                             (\<forall>s1\<in>S1.
                                 \<forall>s2\<in>S1.
                                    s1 \<noteq> s2 \<longrightarrow>
                                    (\<forall>io1\<in>RP M2 s1 vs xs V''.
                                        \<forall>io2\<in>RP M2 s2 vs xs V''. B M1 io1 \<Omega> \<noteq> B M1 io2 \<Omega>)) \<and>
                             m < LB M2 M1 vs xs (tsN \<union> V) S1 \<Omega> V'')})
                 (inputs M2) -
                (tsN \<union> cN))).
           {io} \<times> B M1 io \<Omega>) \<and>
       OFSM M1 \<and> OFSM M2 \<and> asc_fault_domain M2 M1 m \<and> test_tools M2 M1 FAIL PM V \<Omega>"
    by linarith
next
  fix tsN cN rmN obs obsI obs\<^sub>\<Omega> obsI\<^sub>\<Omega> iter isReduction
  assume precond : "(0 < iter \<and>
                    tsN = TS M2 M1 \<Omega> V m (iter - 1) \<and>
                    cN = C M2 M1 \<Omega> V m iter \<and>
                    rmN = RM M2 M1 \<Omega> V m (iter - 1) \<and>
                    obs = L\<^sub>i\<^sub>n M2 (tsN \<union> cN) \<and>
                    obsI = L\<^sub>i\<^sub>n M1 (tsN \<union> cN) \<and>
                    obs\<^sub>\<Omega> = (\<Union>io\<in>L\<^sub>i\<^sub>n M2 (tsN \<union> cN). {io} \<times> B M2 io \<Omega>) \<and>
                    obsI\<^sub>\<Omega> = (\<Union>io\<in>L\<^sub>i\<^sub>n M1 (tsN \<union> cN). {io} \<times> B M1 io \<Omega>) \<and>
                    OFSM M1 \<and> OFSM M2 \<and> asc_fault_domain M2 M1 m \<and> test_tools M2 M1 FAIL PM V \<Omega>) \<and>
                   \<not> (cN \<noteq> {} \<and> obsI \<subseteq> obs \<and> obsI\<^sub>\<Omega> \<subseteq> obs\<^sub>\<Omega>)"
  then have "0 < iter"
            "OFSM M1"
            "OFSM M2"
            "asc_fault_domain M2 M1 m"
            "test_tools M2 M1 FAIL PM V \<Omega>"
            "cN = {} \<or> \<not> obsI \<subseteq> obs \<or> \<not> obsI\<^sub>\<Omega> \<subseteq> obs\<^sub>\<Omega>"
            "tsN = TS M2 M1 \<Omega> V m (iter-1)"
            "cN = C M2 M1 \<Omega> V m iter"
            "rmN = RM M2 M1 \<Omega> V m (iter-1)"
            "obs = L\<^sub>i\<^sub>n M2 (tsN \<union> cN)"
            "obsI = L\<^sub>i\<^sub>n M1 (tsN \<union> cN)"
            "obs\<^sub>\<Omega> = (\<Union>io\<in>L\<^sub>i\<^sub>n M2 (tsN \<union> cN). {io} \<times> B M2 io \<Omega>)"
            "obsI\<^sub>\<Omega> = (\<Union>io\<in>L\<^sub>i\<^sub>n M1 (tsN \<union> cN). {io} \<times> B M1 io \<Omega>)"
    by linarith+

  show "(obsI \<subseteq> obs \<and> obsI\<^sub>\<Omega> \<subseteq> obs\<^sub>\<Omega>) = M1 \<preceq> M2"
  proof (cases "cN = {}")
    case True
    then have "C M2 M1 \<Omega> V m iter = {}"
      using \<open>cN = C M2 M1 \<Omega> V m iter\<close> by auto

    have "is_det_state_cover M2 V"
      using \<open>test_tools M2 M1 FAIL PM V \<Omega>\<close> by auto
    then have "[] \<in> V"
      using det_state_cover_initial[of M2 V] by simp
    then have "V \<noteq> {}"
      by blast
    have "Suc 0 < iter"
    proof (rule ccontr)
      assume "\<not> Suc 0 < iter"
      then have "iter = Suc 0"
        using \<open>0 < iter\<close> by auto
      then have "C M2 M1 \<Omega> V m (Suc 0) = {}"
        using \<open>C M2 M1 \<Omega> V m iter = {}\<close> by auto
      moreover have "C M2 M1 \<Omega> V m (Suc 0) = V"
        by auto
      ultimately show "False"
        using \<open>V \<noteq> {}\<close> by blast
    qed

    obtain k where "iter = Suc k"
      using gr0_implies_Suc[OF \<open>0 < iter\<close>] by blast
    then have "Suc 0 < Suc k"
      using \<open>Suc 0 < iter\<close> by auto
    then have "0 < k"
      by simp
    then obtain k' where "k = Suc k'"
      using gr0_implies_Suc by blast
    have "iter = Suc (Suc k')"
      using \<open>iter = Suc k\<close> \<open>k = Suc k'\<close> by simp

    have "TS M2 M1 \<Omega> V m (Suc (Suc k')) = TS M2 M1 \<Omega> V m (Suc k') \<union> C M2 M1 \<Omega> V m (Suc (Suc k'))"
      using TS.simps(3)[of M2 M1 \<Omega> V m k'] by blast
    then have "TS M2 M1 \<Omega> V m iter = TS M2 M1 \<Omega> V m (Suc k')"
      using True \<open>cN = C M2 M1 \<Omega> V m iter\<close> \<open>iter = Suc (Suc k')\<close> by blast
    moreover have "Suc k' = iter - 1"
      using \<open>iter = Suc (Suc k')\<close> by presburger
    ultimately have "TS M2 M1 \<Omega> V m iter = TS M2 M1 \<Omega> V m (iter - 1)"
      by auto
    then have "tsN = TS M2 M1 \<Omega> V m iter"
      using \<open>tsN = TS M2 M1 \<Omega> V m (iter-1)\<close> by simp

    then  have "TS M2 M1 \<Omega> V m iter = TS M2 M1 \<Omega> V m (iter - 1)"
      using \<open>tsN = TS M2 M1 \<Omega> V m (iter - 1)\<close> by auto
    then have "final_iteration M2 M1 \<Omega> V m (iter-1)"
      using \<open>0 < iter\<close> by auto

    have "M1 \<preceq> M2 = atc_io_reduction_on_sets M1 tsN \<Omega> M2"
      using asc_main_theorem[OF \<open>OFSM M1\<close> \<open>OFSM M2\<close>
                                \<open>asc_fault_domain M2 M1 m\<close>
                                \<open>test_tools M2 M1 FAIL PM V \<Omega>\<close>
                                \<open>final_iteration M2 M1 \<Omega> V m (iter-1)\<close>]
      using \<open>tsN = TS M2 M1 \<Omega> V m (iter - 1)\<close>
      by blast
    moreover have "tsN \<union> cN = tsN"
      using \<open>cN = {}\<close> by blast
    ultimately have "M1 \<preceq> M2 = atc_io_reduction_on_sets M1 (tsN \<union> cN) \<Omega> M2"
      by presburger

    have "obsI \<subseteq> obs \<equiv> L\<^sub>i\<^sub>n M1 (tsN \<union> cN) \<subseteq> L\<^sub>i\<^sub>n M2 (tsN \<union> cN)"
      by (simp add: \<open>obs = L\<^sub>i\<^sub>n M2 (tsN \<union> cN)\<close> \<open>obsI = L\<^sub>i\<^sub>n M1 (tsN \<union> cN)\<close>)

    have "obsI\<^sub>\<Omega> \<subseteq> obs\<^sub>\<Omega> \<equiv> (\<Union>io\<in>L\<^sub>i\<^sub>n M1 (tsN \<union> cN). {io} \<times> B M1 io \<Omega>)
                            \<subseteq> (\<Union>io\<in>L\<^sub>i\<^sub>n M2 (tsN \<union> cN). {io} \<times> B M2 io \<Omega>)"
      by (simp add: \<open>obsI\<^sub>\<Omega> = (\<Union>io\<in>L\<^sub>i\<^sub>n M1 (tsN \<union> cN). {io} \<times> B M1 io \<Omega>)\<close>
                    \<open>obs\<^sub>\<Omega> = (\<Union>io\<in>L\<^sub>i\<^sub>n M2 (tsN \<union> cN). {io} \<times> B M2 io \<Omega>)\<close>)

    have "(obsI \<subseteq> obs \<and> obsI\<^sub>\<Omega> \<subseteq> obs\<^sub>\<Omega>) = atc_io_reduction_on_sets M1 (tsN \<union> cN) \<Omega> M2"
    proof
      assume "obsI \<subseteq> obs \<and> obsI\<^sub>\<Omega> \<subseteq> obs\<^sub>\<Omega>"
      show "atc_io_reduction_on_sets M1 (tsN \<union> cN) \<Omega> M2"
        using atc_io_reduction_on_sets_from_obs[of M1 "tsN \<union> cN" M2 \<Omega>]
        using \<open>obsI \<subseteq> obs \<and> obsI\<^sub>\<Omega> \<subseteq> obs\<^sub>\<Omega>\<close> \<open>obsI \<subseteq> obs \<equiv> L\<^sub>i\<^sub>n M1 (tsN \<union> cN) \<subseteq> L\<^sub>i\<^sub>n M2 (tsN \<union> cN)\<close>
              \<open>obsI\<^sub>\<Omega> \<subseteq> obs\<^sub>\<Omega> \<equiv> (\<Union>io\<in>L\<^sub>i\<^sub>n M1 (tsN \<union> cN). {io} \<times> B M1 io \<Omega>)
                                \<subseteq> (\<Union>io\<in>L\<^sub>i\<^sub>n M2 (tsN \<union> cN). {io} \<times> B M2 io \<Omega>)\<close>
        by linarith
    next
      assume "atc_io_reduction_on_sets M1 (tsN \<union> cN) \<Omega> M2"
      show "obsI \<subseteq> obs \<and> obsI\<^sub>\<Omega> \<subseteq> obs\<^sub>\<Omega>"
        using atc_io_reduction_on_sets_to_obs[of M1 \<open>tsN \<union> cN\<close> \<Omega> M2]
              \<open>atc_io_reduction_on_sets M1 (tsN \<union> cN) \<Omega> M2\<close>
              \<open>obsI \<subseteq> obs \<equiv> L\<^sub>i\<^sub>n M1 (tsN \<union> cN) \<subseteq> L\<^sub>i\<^sub>n M2 (tsN \<union> cN)\<close>
              \<open>obsI\<^sub>\<Omega> \<subseteq> obs\<^sub>\<Omega> \<equiv> (\<Union>io\<in>L\<^sub>i\<^sub>n M1 (tsN \<union> cN). {io} \<times> B M1 io \<Omega>)
                                \<subseteq> (\<Union>io\<in>L\<^sub>i\<^sub>n M2 (tsN \<union> cN). {io} \<times> B M2 io \<Omega>)\<close>
        by blast
    qed
    then show ?thesis
      using \<open>M1 \<preceq> M2 = atc_io_reduction_on_sets M1 (tsN \<union> cN) \<Omega> M2\<close> by linarith
next
    case False

    then have "\<not> obsI \<subseteq> obs \<or> \<not> obsI\<^sub>\<Omega> \<subseteq> obs\<^sub>\<Omega>"
      using \<open>cN = {} \<or> \<not> obsI \<subseteq> obs \<or> \<not> obsI\<^sub>\<Omega> \<subseteq> obs\<^sub>\<Omega>\<close> by auto

    have "\<not> atc_io_reduction_on_sets M1 (tsN \<union> cN) \<Omega> M2"
      using atc_io_reduction_on_sets_to_obs[of M1 "tsN \<union> cN" \<Omega> M2]
            \<open>\<not> obsI \<subseteq> obs \<or> \<not> obsI\<^sub>\<Omega> \<subseteq> obs\<^sub>\<Omega>\<close> precond
      by fastforce

    have "\<not> M1 \<preceq> M2"
    proof
      assume "M1 \<preceq> M2"
      have "atc_io_reduction_on_sets M1 (tsN \<union> cN) \<Omega> M2"
        using asc_soundness[OF \<open>OFSM M1\<close> \<open>OFSM M2\<close>] \<open>M1 \<preceq> M2\<close> by blast
      then show "False"
        using \<open>\<not> atc_io_reduction_on_sets M1 (tsN \<union> cN) \<Omega> M2\<close> by blast
    qed

    then show ?thesis
      using \<open>\<not> obsI \<subseteq> obs \<or> \<not> obsI\<^sub>\<Omega> \<subseteq> obs\<^sub>\<Omega>\<close> by blast

  qed
qed

end


(* Author: Tobias Nipkow *)

section "Denotational Abstract Interpretation"

theory Abs_Int_den0_fun
imports "~~/src/Tools/Permanent_Interpretation" "../Big_Step"
begin

subsection "Orderings"

class preord =
fixes le :: "'a \<Rightarrow> 'a \<Rightarrow> bool" (infix "\<sqsubseteq>" 50)
assumes le_refl[simp]: "x \<sqsubseteq> x"
and le_trans: "x \<sqsubseteq> y \<Longrightarrow> y \<sqsubseteq> z \<Longrightarrow> x \<sqsubseteq> z"

text{* Note: no antisymmetry. Allows implementations where some abstract
element is implemented by two different values @{prop "x \<noteq> y"}
such that @{prop"x \<sqsubseteq> y"} and @{prop"y \<sqsubseteq> x"}. Antisymmetry is not
needed because we never compare elements for equality but only for @{text"\<sqsubseteq>"}.
*}

class SL_top = preord +
fixes join :: "'a \<Rightarrow> 'a \<Rightarrow> 'a" (infixl "\<squnion>" 65)
fixes Top :: "'a"
assumes join_ge1 [simp]: "x \<sqsubseteq> x \<squnion> y"
and join_ge2 [simp]: "y \<sqsubseteq> x \<squnion> y"
and join_least: "x \<sqsubseteq> z \<Longrightarrow> y \<sqsubseteq> z \<Longrightarrow> x \<squnion> y \<sqsubseteq> z"
and top[simp]: "x \<sqsubseteq> Top"
begin

lemma join_le_iff[simp]: "x \<squnion> y \<sqsubseteq> z \<longleftrightarrow> x \<sqsubseteq> z \<and> y \<sqsubseteq> z"
by (metis join_ge1 join_ge2 join_least le_trans)

fun iter :: "nat \<Rightarrow> ('a \<Rightarrow> 'a) \<Rightarrow> 'a \<Rightarrow> 'a" where
"iter 0 f _ = Top" |
"iter (Suc n) f x = (if f x \<sqsubseteq> x then x else iter n f (f x))"

lemma iter_pfp: "f(iter n f x) \<sqsubseteq> iter n f x"
apply (induction n arbitrary: x)
 apply (simp)
apply (simp)
done

abbreviation iter' :: "nat \<Rightarrow> ('a \<Rightarrow> 'a) \<Rightarrow> 'a \<Rightarrow> 'a" where
"iter' n f x0 == iter n (\<lambda>x. x0 \<squnion> f x) x0"

lemma iter'_pfp_above:
  "f(iter' n f x0) \<sqsubseteq> iter' n f x0"  "x0 \<sqsubseteq> iter' n f x0"
using iter_pfp[of "\<lambda>x. x0 \<squnion> f x"] by auto

text{* So much for soundness. But how good an approximation of the post-fixed
point does @{const iter} yield? *}

lemma iter_funpow: "iter n f x \<noteq> Top \<Longrightarrow> \<exists>k. iter n f x = (f^^k) x"
apply(induction n arbitrary: x)
 apply simp
apply (auto)
 apply(metis funpow.simps(1) id_def)
by (metis funpow.simps(2) funpow_swap1 o_apply)

text{* For monotone @{text f}, @{term "iter f n x0"} yields the least
post-fixed point above @{text x0}, unless it yields @{text Top}. *}

lemma iter_least_pfp:
assumes mono: "\<And>x y. x \<sqsubseteq> y \<Longrightarrow> f x \<sqsubseteq> f y" and "iter n f x0 \<noteq> Top"
and "f p \<sqsubseteq> p" and "x0 \<sqsubseteq> p" shows "iter n f x0 \<sqsubseteq> p"
proof-
  obtain k where "iter n f x0 = (f^^k) x0"
    using iter_funpow[OF `iter n f x0 \<noteq> Top`] by blast
  moreover
  { fix n have "(f^^n) x0 \<sqsubseteq> p"
    proof(induction n)
      case 0 show ?case by(simp add: `x0 \<sqsubseteq> p`)
    next
      case (Suc n) thus ?case
        by (simp add: `x0 \<sqsubseteq> p`)(metis Suc assms(3) le_trans mono)
    qed
  } ultimately show ?thesis by simp
qed

end

text{* The interface of abstract values: *}

locale Rep =
fixes rep :: "'a::SL_top \<Rightarrow> 'b set"
assumes le_rep: "a \<sqsubseteq> b \<Longrightarrow> rep a \<subseteq> rep b"
begin

abbreviation in_rep (infix "<:" 50) where "x <: a == x : rep a"

lemma in_rep_join: "x <: a1 \<or> x <: a2 \<Longrightarrow> x <: a1 \<squnion> a2"
by (metis SL_top_class.join_ge1 SL_top_class.join_ge2 le_rep subsetD)

end

locale Val_abs = Rep rep
  for rep :: "'a::SL_top \<Rightarrow> val set" +
fixes num' :: "val \<Rightarrow> 'a"
and plus' :: "'a \<Rightarrow> 'a \<Rightarrow> 'a"
assumes rep_num': "rep(num' n) = {n}"
and rep_plus': "n1 <: a1 \<Longrightarrow> n2 <: a2 \<Longrightarrow> n1+n2 <: plus' a1 a2"

instantiation "fun" :: (type, SL_top) SL_top
begin

definition "f \<sqsubseteq> g = (ALL x. f x \<sqsubseteq> g x)"
definition "f \<squnion> g = (\<lambda>x. f x \<squnion> g x)"
definition "Top = (\<lambda>x. Top)"

lemma join_apply[simp]:
  "(f \<squnion> g) x = f x \<squnion> g x"
by (simp add: join_fun_def)

instance
proof
  case goal2 thus ?case by (metis le_fun_def preord_class.le_trans)
qed (simp_all add: le_fun_def Top_fun_def)

end

subsection "Abstract Interpretation Abstractly"

text{* Abstract interpretation over abstract values. Abstract states are
simply functions. The post-fixed point finder is parameterized over. *}

type_synonym 'a st = "vname \<Rightarrow> 'a"

locale Abs_Int_Fun = Val_abs +
fixes pfp :: "('a st \<Rightarrow> 'a st) \<Rightarrow> 'a st \<Rightarrow> 'a st"
assumes pfp: "f(pfp f x) \<sqsubseteq> pfp f x"
assumes above: "x \<sqsubseteq> pfp f x"
begin

fun aval' :: "aexp \<Rightarrow> 'a st \<Rightarrow> 'a" where
"aval' (N n) _ = num' n" |
"aval' (V x) S = S x" |
"aval' (Plus a1 a2) S = plus' (aval' a1 S) (aval' a2 S)"

abbreviation fun_in_rep (infix "<:" 50) where
"f <: F == \<forall>x. f x <: F x"

lemma fun_in_rep_le: "(s::state) <: S \<Longrightarrow> S \<sqsubseteq> T \<Longrightarrow> s <: T"
by (metis le_fun_def le_rep subsetD)

lemma aval'_sound: "s <: S \<Longrightarrow> aval a s <: aval' a S"
by (induct a) (auto simp: rep_num' rep_plus')

fun AI :: "com \<Rightarrow> 'a st \<Rightarrow> 'a st" where
"AI SKIP S = S" |
"AI (x ::= a) S = S(x := aval' a S)" |
"AI (c1;;c2) S = AI c2 (AI c1 S)" |
"AI (IF b THEN c1 ELSE c2) S = (AI c1 S) \<squnion> (AI c2 S)" |
"AI (WHILE b DO c) S = pfp (AI c) S"

lemma AI_sound: "(c,s) \<Rightarrow> t \<Longrightarrow> s <: S0 \<Longrightarrow> t <: AI c S0"
proof(induction c arbitrary: s t S0)
  case SKIP thus ?case by fastforce
next
  case Assign thus ?case by (auto simp: aval'_sound)
next
  case Seq thus ?case by auto
next
  case If thus ?case by(auto simp: in_rep_join)
next
  case (While b c)
  let ?P = "pfp (AI c) S0"
  { fix s t have "(WHILE b DO c,s) \<Rightarrow> t \<Longrightarrow> s <: ?P \<Longrightarrow> t <: ?P"
    proof(induction "WHILE b DO c" s t rule: big_step_induct)
      case WhileFalse thus ?case by simp
    next
      case WhileTrue thus ?case by(metis While.IH pfp fun_in_rep_le)
    qed
  }
  with fun_in_rep_le[OF `s <: S0` above]
  show ?case by (metis While(2) AI.simps(5))
qed

end

text{* Problem: not executable because of the comparison of abstract states,
i.e. functions, in the post-fixedpoint computation. Need to implement
abstract states concretely. *}

end


(* Copyright 2021 (C) Mihails Milehins *)

section\<open>Smallness for functors\<close>
theory CZH_ECAT_Small_Functor
  imports
    CZH_Foundations.CZH_SMC_Small_Semifunctor
    CZH_ECAT_Functor
    CZH_ECAT_Small_Category
begin

subsection\<open>Functor with tiny maps\<close>

subsubsection\<open>Definition and elementary properties\<close>

locale is_tm_functor = is_functor \<alpha> \<AA> \<BB> \<FF>  for \<alpha> \<AA> \<BB> \<FF> +
  assumes tm_cf_is_semifunctor[slicing_intros]:
    "cf_smcf \<FF> : cat_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> cat_smc \<BB>"

syntax "_is_tm_functor" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
  (\<open>(_ :/ _ \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<index> _)\<close> [51, 51, 51] 51)
translations "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>" \<rightleftharpoons> "CONST is_tm_functor \<alpha> \<AA> \<BB> \<FF>"

abbreviation (input) is_cn_tm_functor :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
  where "is_cn_tm_functor \<alpha> \<AA> \<BB> \<FF> \<equiv> \<FF> : op_dg \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"

syntax "_is_cn_tm_functor" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
  (\<open>(_ :/ _ \<^sub>C\<^sub>.\<^sub>t\<^sub>m\<mapsto>\<mapsto>\<index> _)\<close> [51, 51, 51] 51)
translations "\<FF> : \<AA> \<^sub>C\<^sub>.\<^sub>t\<^sub>m\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>" \<rightharpoonup> "CONST is_cn_tm_functor \<alpha> \<AA> \<BB> \<FF>"

abbreviation all_tm_cfs :: "V \<Rightarrow> V"
  where "all_tm_cfs \<alpha> \<equiv> set {\<FF>. \<exists>\<AA> \<BB>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>}"

abbreviation small_tm_cfs :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
  where "small_tm_cfs \<alpha> \<AA> \<BB> \<equiv> set {\<FF>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>}"

lemma (in is_tm_functor) tm_cf_is_semifunctor':
  assumes "\<alpha>' = \<alpha>"
    and "\<AA>' = cat_smc \<AA>"
    and "\<BB>' = cat_smc \<BB>"
  shows "cf_smcf \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>'\<^esub> \<BB>'"
  unfolding assms by (rule tm_cf_is_semifunctor)

lemmas [slicing_intros] = is_tm_functor.tm_cf_is_semifunctor'

text\<open>Rules.\<close>

lemma (in is_tm_functor) is_tm_functor_axioms'[cat_small_cs_intros]:
  assumes "\<alpha>' = \<alpha>" and "\<AA>' = \<AA>" and "\<BB>' = \<BB>"
  shows "\<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>'\<^esub> \<BB>'"
  unfolding assms by (rule is_tm_functor_axioms)

mk_ide rf is_tm_functor_def[unfolded is_tm_functor_axioms_def]
  |intro is_tm_functorI|
  |dest is_tm_functorD[dest]|
  |elim is_tm_functorE[elim]|

lemmas [cat_small_cs_intros] = is_tm_functorD(1)

text\<open>Slicing.\<close>

context is_tm_functor
begin

interpretation smcf: is_tm_semifunctor \<alpha> \<open>cat_smc \<AA>\<close> \<open>cat_smc \<BB>\<close> \<open>cf_smcf \<FF>\<close>
  by (rule tm_cf_is_semifunctor)

lemmas_with [unfolded slicing_simps]:
  tm_cf_ObjMap_in_Vset[cat_cs_intros] = smcf.tm_smcf_ObjMap_in_Vset
  and tm_cf_ArrMap_in_Vset[cat_cs_intros] = smcf.tm_smcf_ArrMap_in_Vset

end

sublocale is_tm_functor \<subseteq> HomDom: tiny_category \<alpha> \<AA>
proof(rule tiny_categoryI')
  show "\<AA>\<lparr>Obj\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
    by (rule vdomain_in_VsetI[OF tm_cf_ObjMap_in_Vset, unfolded cat_cs_simps])
  show "\<AA>\<lparr>Arr\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
    by (rule vdomain_in_VsetI[OF tm_cf_ArrMap_in_Vset, unfolded cat_cs_simps])
qed (simp add: cat_cs_intros)

text\<open>Further rules.\<close>

lemma is_tm_functorI':
  assumes [simp]: "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
    and [simp]: "\<FF>\<lparr>ObjMap\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
    and [simp]: "\<FF>\<lparr>ArrMap\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
  shows "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
proof(intro is_tm_functorI)
  interpret is_functor \<alpha> \<AA> \<BB> \<FF> by (rule assms(1))
  show "cf_smcf \<FF> : cat_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> cat_smc \<BB>"
    by (intro is_tm_semifunctorI', unfold slicing_simps)
      (auto simp: slicing_intros)
qed simp_all

lemma is_tm_functorD':
  assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
  shows "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
    and "\<FF>\<lparr>ObjMap\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
    and "\<FF>\<lparr>ArrMap\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
proof-
  interpret is_tm_functor \<alpha> \<AA> \<BB> \<FF> by (rule assms(1))
  show "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
    and "\<FF>\<lparr>ObjMap\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
    and "\<FF>\<lparr>ArrMap\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
    by (auto intro: cat_cs_intros)
qed

lemmas [cat_small_cs_intros] = is_tm_functorD'(1)

lemma is_tm_functorE':
  assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
  obtains "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
    and "\<FF>\<lparr>ObjMap\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
    and "\<FF>\<lparr>ArrMap\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
  using is_tm_functorD'[OF assms] by simp

text\<open>Size.\<close>

lemma small_all_tm_cfs[simp]: "small {\<FF>. \<exists>\<AA> \<BB>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>}"
proof(rule down)
  show
    "{\<FF>. \<exists>\<AA> \<BB>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>} \<subseteq>
      elts (set {\<FF>. \<exists>\<AA> \<BB>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>})"
  proof
    (
      simp only: elts_of_set small_all_cfs if_True,
      rule subsetI,
      unfold mem_Collect_eq
    )
    fix \<FF> assume "\<exists>\<AA> \<BB>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
    then obtain \<AA> \<BB> where "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>" by clarsimp
    then interpret is_tm_functor \<alpha> \<AA> \<BB> \<FF> .
    show "\<exists>\<AA> \<BB>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" by (blast intro: is_functor_axioms')
  qed
qed

subsubsection\<open>Opposite functor with tiny maps\<close>

lemma (in is_tm_functor) is_tm_functor_op:
  "op_cf \<FF> : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> op_cat \<BB>"
  by (intro is_tm_functorI', unfold cat_op_simps)
    (cs_concl cs_intro: cat_cs_intros cat_op_intros)

lemma (in is_tm_functor) is_tm_functor_op'[cat_op_intros]:
  assumes "\<AA>' = op_cat \<AA>" and "\<BB>' = op_cat \<BB>" and "\<alpha>' = \<alpha>"
  shows "op_cf \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>'\<^esub> \<BB>'"
  unfolding assms by (rule is_tm_functor_op)

lemmas is_tm_functor_op[cat_op_intros] = is_tm_functor.is_tm_functor_op'

subsubsection\<open>Composition of functors with tiny maps\<close>

lemma cf_comp_is_tm_functor[cat_small_cs_intros]:
  assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
  shows "\<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
proof(rule is_tm_functorI)
  interpret \<FF>: is_tm_functor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
  interpret \<GG>: is_tm_functor \<alpha> \<BB> \<CC> \<GG> by (rule assms(1))
  from \<FF>.tm_cf_is_semifunctor \<GG>.tm_cf_is_semifunctor show
    "cf_smcf (\<GG> \<circ>\<^sub>C\<^sub>F \<FF>) : cat_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> cat_smc \<CC>"
    by (auto simp: smc_small_cs_intros slicing_commute[symmetric])
  show "\<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<CC>" by (auto intro: cat_cs_intros)
qed

subsubsection\<open>Finite categories and functors with tiny maps\<close>

lemma (in is_functor) cf_is_tm_functor_if_HomDom_finite_category:
  assumes "finite_category \<alpha> \<AA>"
  shows "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
proof(intro is_tm_functorI)
  interpret \<AA>: finite_category \<alpha> \<AA> by (rule assms(1))
  show "cf_smcf \<FF> : cat_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> cat_smc \<BB>"
    by
      (
        rule
          is_semifunctor.smcf_is_tm_semifunctor_if_HomDom_finite_semicategory[
            OF cf_is_semifunctor \<AA>.fin_cat_finite_semicategory
            ]
      )
qed (auto intro: cat_cs_intros)

subsubsection\<open>Constant functor with tiny maps\<close>

lemma cf_const_is_tm_functor:
  assumes "tiny_category \<alpha> \<CC>" and "category \<alpha> \<DD>" and "a \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>"
  shows "cf_const \<CC> \<DD> a : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<DD>"
proof(intro is_tm_functorI)
  from assms show "cf_smcf (cf_const \<CC> \<DD> a) : cat_smc \<CC> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> cat_smc \<DD>"
    by
      (
        cs_concl
          cs_simp: slicing_commute[symmetric] slicing_simps cat_cs_simps
          cs_intro: slicing_intros cat_cs_intros smc_small_cs_intros
      )+
  from assms show "cf_const \<CC> \<DD> a : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
    by (cs_concl cs_intro: cat_cs_intros cat_small_cs_intros)
qed

lemma cf_const_is_tm_functor'[cat_small_cs_intros]:
  assumes "tiny_category \<alpha> \<CC>"
    and "category \<alpha> \<DD>"
    and "a \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>"
    and "\<CC>' = \<CC>"
    and "\<DD>' = \<DD>"
  shows "cf_const \<CC> \<DD> a : \<CC>' \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<DD>'"
  using assms(1-3) unfolding assms(4,5) by (rule cf_const_is_tm_functor)

subsection\<open>Tiny functor\<close>

subsubsection\<open>Definition and elementary properties\<close>

locale is_tiny_functor = is_functor \<alpha> \<AA> \<BB> \<FF> for \<alpha> \<AA> \<BB> \<FF> +
  assumes tiny_cf_is_tiny_semifunctor[slicing_intros]:
    "cf_smcf \<FF> : cat_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> cat_smc \<BB>"

syntax "_is_tiny_functor" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
  (\<open>(_ :/ _ \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<index> _)\<close> [51, 51, 51] 51)
translations "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>" \<rightleftharpoons> "CONST is_tiny_functor \<alpha> \<AA> \<BB> \<FF>"

abbreviation (input) is_cn_tiny_cf :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
  where "is_cn_tiny_cf \<alpha> \<AA> \<BB> \<FF> \<equiv> \<FF> : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"

syntax "_is_cn_tiny_cf" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
  (\<open>(_ :/ _ \<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<mapsto>\<mapsto>\<index> _)\<close> [51, 51, 51] 51)
translations "\<FF> : \<AA> \<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<mapsto>\<mapsto>\<^bsub>\<alpha>\<^esub> \<BB>" \<rightharpoonup> "CONST is_cn_cf \<alpha> \<AA> \<BB> \<FF>"

abbreviation all_tiny_cfs :: "V \<Rightarrow> V"
  where "all_tiny_cfs \<alpha> \<equiv> set {\<FF>. \<exists>\<AA> \<BB>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>}"

abbreviation tiny_cfs :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
  where "tiny_cfs \<alpha> \<AA> \<BB> \<equiv> set {\<FF>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>}"

lemmas [slicing_intros] = is_tiny_functor.tiny_cf_is_tiny_semifunctor

text\<open>Rules.\<close>

lemma (in is_tiny_functor) is_tiny_functor_axioms'[cat_small_cs_intros]:
  assumes "\<alpha>' = \<alpha>" and "\<AA>' = \<AA>" and "\<BB>' = \<BB>"
  shows "\<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>'\<^esub> \<BB>'"
  unfolding assms by (rule is_tiny_functor_axioms)

mk_ide rf is_tiny_functor_def[unfolded is_tiny_functor_axioms_def]
  |intro is_tiny_functorI|
  |dest is_tiny_functorD[dest]|
  |elim is_tiny_functorE[elim]|

lemmas [cat_small_cs_intros] = is_tiny_functorD(1)

text\<open>Elementary properties.\<close>

sublocale is_tiny_functor \<subseteq> HomDom: tiny_category \<alpha> \<AA>
proof(intro tiny_categoryI')
  interpret smcf: is_tiny_semifunctor \<alpha> \<open>cat_smc \<AA>\<close> \<open>cat_smc \<BB>\<close> \<open>cf_smcf \<FF>\<close>
    by (rule tiny_cf_is_tiny_semifunctor)
  show "\<AA>\<lparr>Obj\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
    by (rule smcf.HomDom.tiny_smc_Obj_in_Vset[unfolded slicing_simps])
  show "\<AA>\<lparr>Arr\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
    by (rule smcf.HomDom.tiny_smc_Arr_in_Vset[unfolded slicing_simps])
qed (auto simp: cat_cs_intros)

sublocale is_tiny_functor \<subseteq> HomCod: tiny_category \<alpha> \<BB>
proof(intro tiny_categoryI')
  interpret smcf: is_tiny_semifunctor \<alpha> \<open>cat_smc \<AA>\<close> \<open>cat_smc \<BB>\<close> \<open>cf_smcf \<FF>\<close>
    by (rule tiny_cf_is_tiny_semifunctor)
  show "\<BB>\<lparr>Obj\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
    by (rule smcf.HomCod.tiny_smc_Obj_in_Vset[unfolded slicing_simps])
  show "\<BB>\<lparr>Arr\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>"
    by (rule smcf.HomCod.tiny_smc_Arr_in_Vset[unfolded slicing_simps])
qed (auto simp: cat_cs_intros)

sublocale is_tiny_functor \<subseteq> is_tm_functor
proof(intro is_tm_functorI')
  interpret smcf: is_tiny_semifunctor \<alpha> \<open>cat_smc \<AA>\<close> \<open>cat_smc \<BB>\<close> \<open>cf_smcf \<FF>\<close>
    by (rule tiny_cf_is_tiny_semifunctor)
  note Vset[unfolded slicing_simps] =
    smcf.tm_smcf_ObjMap_in_Vset
    smcf.tm_smcf_ArrMap_in_Vset
  show "\<FF>\<lparr>ObjMap\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>" "\<FF>\<lparr>ArrMap\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>" by (intro Vset)+
qed (auto simp: cat_cs_intros)

text\<open>Further rules.\<close>

lemma is_tiny_functorI':
  assumes [simp]: "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
    and "tiny_category \<alpha> \<AA>"
    and "tiny_category \<alpha> \<BB>"
  shows "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"
proof(intro is_tiny_functorI)
  interpret \<FF>: is_functor \<alpha> \<AA> \<BB> \<FF> by (rule assms(1))
  interpret \<AA>: tiny_category \<alpha> \<AA> by (rule assms(2))
  interpret \<BB>: tiny_category \<alpha> \<BB> by (rule assms(3))
  show "cf_smcf \<FF> : cat_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> cat_smc \<BB>"
    by (intro is_tiny_semifunctorI') (auto intro: slicing_intros)
qed (rule assms(1))

lemma is_tiny_functorD':
  assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"
  shows "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
    and "tiny_category \<alpha> \<AA>"
    and "tiny_category \<alpha> \<BB>"
proof-
  interpret is_tiny_functor \<alpha> \<AA> \<BB> \<FF> by (rule assms(1))
  show "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" and "tiny_category \<alpha> \<AA>" and "tiny_category \<alpha> \<BB>"
    by (auto intro: cat_small_cs_intros)
qed

lemmas [cat_small_cs_intros] = is_tiny_functorD'(2,3)

lemma is_tiny_functorE':
  assumes "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"
  obtains "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
    and "tiny_category \<alpha> \<AA>"
    and "tiny_category \<alpha> \<BB>"
  using is_tiny_functorD'[OF assms] by auto

lemma is_tiny_functor_iff:
  "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB> \<longleftrightarrow>
    (\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB> \<and> tiny_category \<alpha> \<AA> \<and> tiny_category \<alpha> \<BB>)"
  by (auto intro: is_tiny_functorI' dest: is_tiny_functorD'(2,3))

text\<open>Size.\<close>

lemma (in is_tiny_functor) tiny_cf_in_Vset: "\<FF> \<in>\<^sub>\<circ> Vset \<alpha>"
proof-
  note [cat_cs_intros] =
    tm_cf_ObjMap_in_Vset
    tm_cf_ArrMap_in_Vset
    HomDom.tiny_cat_in_Vset
    HomCod.tiny_cat_in_Vset
  show ?thesis
    by (subst cf_def)
      (
        cs_concl cs_shallow
          cs_simp: cat_cs_simps cs_intro: cat_cs_intros V_cs_intros
      )
qed

lemma small_all_tiny_cfs[simp]: "small {\<FF>. \<exists>\<AA> \<BB>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>}"
proof(rule down)
  show
    "{\<FF>. \<exists>\<AA> \<BB>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>} \<subseteq>
      elts (set {\<FF>. \<exists>\<AA> \<BB>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>})"
  proof
    (
      simp only: elts_of_set small_all_cfs if_True,
      rule subsetI,
      unfold mem_Collect_eq
    )
    fix \<FF> assume "\<exists>\<AA> \<BB>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"
    then obtain \<AA> \<BB> where "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>" by clarsimp
    then interpret is_tiny_functor \<alpha> \<AA> \<BB> \<FF> by simp
    show "\<exists>\<AA> \<BB>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" by (meson is_functor_axioms)
  qed
qed

lemma small_tiny_cfs[simp]: "small {\<FF>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>}"
  by (rule down[of _ \<open>set {\<FF>. \<exists>\<AA> \<BB>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>}\<close>]) auto

lemma all_tiny_cfs_vsubset_Vset[simp]:
  "set {\<FF>. \<exists>\<AA> \<BB>. \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>} \<subseteq>\<^sub>\<circ> Vset \<alpha>"
proof(rule vsubsetI)
  fix \<FF> assume "\<FF> \<in>\<^sub>\<circ> all_tiny_cfs \<alpha>"
  then obtain \<AA> \<BB> where "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>" by clarsimp
  then show "\<FF> \<in>\<^sub>\<circ> Vset \<alpha>" by (auto simp: is_tiny_functor.tiny_cf_in_Vset)
qed

lemma (in is_functor) cf_is_tiny_functor_if_ge_Limit:
  assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
  shows "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<beta>\<^esub> \<BB>"
proof(intro is_tiny_functorI)
  show "cf_smcf \<FF> : cat_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<beta>\<^esub> cat_smc \<BB>"
    by
      (
        rule is_semifunctor.smcf_is_tiny_semifunctor_if_ge_Limit,
        rule cf_is_semifunctor;
        intro assms
      )
qed (simp add: cf_is_functor_if_ge_Limit assms)

subsubsection\<open>Opposite tiny semifunctor\<close>

lemma (in is_tiny_functor) is_tiny_functor_op:
  "op_cf \<FF> : op_cat \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> op_cat \<BB>"
  by (intro is_tiny_functorI')
    (cs_concl cs_intro: cat_op_intros cat_small_cs_intros)+

lemma (in is_tiny_functor) is_tiny_functor_op'[cat_op_intros]:
  assumes "\<AA>' = op_cat \<AA>" and "\<BB>' = op_cat \<BB>" and "\<alpha>' = \<alpha>"
  shows "op_cf \<FF> : \<AA>' \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>'\<^esub> \<BB>'"
  unfolding assms by (rule is_tiny_functor_op)

lemmas is_tiny_functor_op[cat_op_intros] =
  is_tiny_functor.is_tiny_functor_op'

subsubsection\<open>Composition of tiny functors\<close>

lemma cf_comp_is_tiny_functor[cat_small_cs_intros]:
  assumes "\<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<CC>" and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"
  shows "\<GG> \<circ>\<^sub>C\<^sub>F \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<CC>"
proof-
  interpret \<FF>: is_tiny_functor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
  interpret \<GG>: is_tiny_functor \<alpha> \<BB> \<CC> \<GG> by (rule assms(1))
  show ?thesis by (rule is_tiny_functorI') (auto intro: cat_small_cs_intros)
qed

subsubsection\<open>Tiny constant functor\<close>

lemma cf_const_is_tiny_functor:
  assumes "tiny_category \<alpha> \<CC>" and "tiny_category \<alpha> \<DD>" and "a \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>"
  shows "cf_const \<CC> \<DD> a : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<DD>"
proof(intro is_tiny_functorI')
  from assms show "cf_const \<CC> \<DD> a : \<CC> \<mapsto>\<mapsto>\<^sub>C\<^bsub>\<alpha>\<^esub> \<DD>"
    by (cs_concl cs_intro: cat_small_cs_intros)
qed (auto simp: assms(1,2))

lemma cf_const_is_tiny_functor':
  assumes "tiny_category \<alpha> \<CC>"
    and "tiny_category \<alpha> \<DD>"
    and "a \<in>\<^sub>\<circ> \<DD>\<lparr>Obj\<rparr>"
    and "\<CC>' = \<CC>"
    and "\<DD>' = \<DD>"
  shows "cf_const \<CC> \<DD> a : \<CC>' \<mapsto>\<mapsto>\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<DD>'"
  using assms(1-3) unfolding assms(4,5) by (rule cf_const_is_tiny_functor)

lemmas [cat_small_cs_intros] = cf_const_is_tiny_functor'

text\<open>\newpage\<close>

end


theory T124
imports Main
begin
lemma "(
(\<forall> x::nat. \<forall> y::nat. meet(x, y) = meet(y, x)) &
(\<forall> x::nat. \<forall> y::nat. join(x, y) = join(y, x)) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. meet(x, meet(y, z)) = meet(meet(x, y), z)) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. join(x, join(y, z)) = join(join(x, y), z)) &
(\<forall> x::nat. \<forall> y::nat. meet(x, join(x, y)) = x) &
(\<forall> x::nat. \<forall> y::nat. join(x, meet(x, y)) = x) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. mult(x, join(y, z)) = join(mult(x, y), mult(x, z))) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. mult(join(x, y), z) = join(mult(x, z), mult(y, z))) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. meet(x, over(join(mult(x, y), z), y)) = x) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. meet(y, undr(x, join(mult(x, y), z))) = y) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. join(mult(over(x, y), y), x) = x) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. join(mult(y, undr(y, x)), x) = x) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. mult(x, meet(y, z)) = meet(mult(x, y), mult(x, z))) &
(\<forall> x::nat. \<forall> y::nat. invo(join(x, y)) = meet(invo(x), invo(y))) &
(\<forall> x::nat. \<forall> y::nat. invo(meet(x, y)) = join(invo(x), invo(y))) &
(\<forall> x::nat. invo(invo(x)) = x)
) \<longrightarrow>
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. over(x, meet(y, z)) = join(over(x, y), over(x, z)))
"
nitpick[card nat=4,timeout=86400]
oops
end


theory PermEnv
  imports GenEnv
begin

    (*
      ####################################
        P1. permission definitions
      ####################################
    *)

datatype p_perm = NoPerm | UsePerm | OwnPerm

fun leq_perm where
  "leq_perm UsePerm NoPerm = False"
| "leq_perm OwnPerm NoPerm = False"
| "leq_perm OwnPerm UsePerm = False"
| "leq_perm p1 p2 = True"

fun diff_perm where
  "diff_perm p NoPerm = p"
| "diff_perm p UsePerm = p"
| "diff_perm p OwnPerm = NoPerm"

fun union_perm where
  "union_perm OwnPerm p = OwnPerm"
| "union_perm p OwnPerm = OwnPerm"
| "union_perm NoPerm NoPerm = NoPerm"
| "union_perm p1 p2 = UsePerm"

    (*
      ####################################
        P2.
      ####################################
    *)

type_synonym perm_use_env = "res_id \<Rightarrow> p_perm"

definition empty_use_env where
  "empty_use_env x = NoPerm"

definition add_use_env where
  "add_use_env env x p = (\<lambda> x'. if x = x' then p else env x')"

definition rem_use_env where
  "rem_use_env env x = (\<lambda> x'. if x = x' then NoPerm else env x')"

definition leq_use_env where
  "leq_use_env env1 env2 = (\<forall> x. leq_perm (env1 x) (env2 x))"

   (* shift related functions *)

definition one_use_env where
  "one_use_env x r = (\<lambda> x'. if x = x' then r else NoPerm)"

definition diff_use_env where
  "diff_use_env r_s1 r_s2 = (\<lambda> x. diff_perm (r_s1 x) (r_s2 x))"

definition comp_use_env where
  "comp_use_env r_s1 r_s2 = (\<lambda> x. union_perm (r_s1 x) (r_s2 x))"

definition mini_disj_use_env where
  "mini_disj_use_env r_s r_ex = (\<forall> x. r_s x = OwnPerm \<longrightarrow> r_ex x = NoPerm)"

definition disj_use_env where
  "disj_use_env r_s1 r_s2 = (mini_disj_use_env r_s1 r_s2 \<and> mini_disj_use_env r_s2 r_s1)"

definition weak_use_env where
  "weak_use_env r_s = (\<forall> x. r_s x \<noteq> OwnPerm)"

definition is_own where
  "is_own r = (r = OwnPerm)"

    (* #### no perm lemmas #### *)

    (* - none lemmas *)

lemma leq_use_none: "\<lbrakk> leq_use_env r_x r_s; r_s x = NoPerm \<rbrakk> \<Longrightarrow> r_x x = NoPerm"
  apply (simp add: leq_use_env_def)
  apply (erule_tac x="x" in allE)
  apply (case_tac "r_x x")
    apply (auto)
  done

lemma add_use_none_rev: "\<lbrakk> r_s x = NoPerm ; x \<noteq> y \<rbrakk> \<Longrightarrow> add_use_env r_s y r x = NoPerm"
  apply (simp add: add_use_env_def)
  done

lemma diff_use_none_infer: "\<lbrakk> r_x x = OwnPerm; diff_use_env r_x r_ex x \<noteq> OwnPerm \<rbrakk> \<Longrightarrow> diff_use_env r_s r_ex x = NoPerm"
  apply (simp add: diff_use_env_def)
  apply (case_tac "r_ex x")
    apply (auto)
  done

lemma diff_use_none: "\<lbrakk> r_x x \<noteq> NoPerm; diff_use_env r_x r_ex x = NoPerm \<rbrakk> \<Longrightarrow> diff_use_env r_s r_ex x = NoPerm"
  apply (simp add: diff_use_env_def)
  apply (case_tac "r_ex x")
    apply (auto)
  done

lemma diff_use_none_ex: "\<lbrakk> r_ex x = OwnPerm \<rbrakk> \<Longrightarrow> diff_use_env r_s r_ex x = NoPerm"
  apply (simp add: diff_use_env_def)
  done

lemma comp_use_none: "\<lbrakk> r_sa x = NoPerm; r_sb x = NoPerm \<rbrakk> \<Longrightarrow> comp_use_env r_sa r_sb x = NoPerm"
  apply (simp add: comp_use_env_def)
  done

lemma comp_use_none_both: "\<lbrakk> comp_use_env r_sa r_sb x = NoPerm \<rbrakk> \<Longrightarrow> r_sa x = NoPerm \<and> r_sb x = NoPerm"
  apply (simp add: comp_use_env_def)
  apply (case_tac "r_sa x")
    apply (auto)
   apply (case_tac "r_sb x")
     apply (auto)
  apply (case_tac "r_sb x")
    apply (auto)
  done

    (* - no own lemmas *)

lemma leq_use_no_own: "\<lbrakk> r_s x \<noteq> OwnPerm; leq_use_env r_x r_s \<rbrakk> \<Longrightarrow> r_x x \<noteq> OwnPerm"
  apply (simp add: leq_use_env_def)
  apply (erule_tac x="x" in allE)
  apply (case_tac "r_s x")
    apply (auto)
  done

lemma comp_use_no_own_both: "\<lbrakk> comp_use_env r_sa r_sb x \<noteq> OwnPerm \<rbrakk> \<Longrightarrow> r_sa x \<noteq> OwnPerm \<and> r_sb x \<noteq> OwnPerm"
  apply (simp add: comp_use_env_def)
  apply (auto)
  apply (case_tac "r_sa x")
    apply (auto)
  done

lemma diff_use_no_own: "\<lbrakk> diff_use_env r_s r_ex x \<noteq> NoPerm \<rbrakk> \<Longrightarrow> r_ex x \<noteq> OwnPerm"
  apply (simp add: diff_use_env_def)
  apply (case_tac "r_ex x")
    apply (auto)
  done

    (* - own lemmas *)

lemma leq_use_own: "\<lbrakk> r_x x = OwnPerm; leq_use_env r_x r_s \<rbrakk> \<Longrightarrow> r_s x = OwnPerm"
  apply (simp add: leq_use_env_def)
  apply (erule_tac x="x" in allE)
  apply (auto)
  apply (case_tac "r_s x")
    apply (auto)
  done

lemma diff_use_own: "\<lbrakk> leq_use_env (diff_use_env r_x r_ex) r_s; r_x x \<noteq> NoPerm; r_s x = NoPerm \<rbrakk> \<Longrightarrow> r_ex x = OwnPerm"
  apply (simp add: diff_use_env_def)
  apply (simp add: leq_use_env_def)
  apply (erule_tac x="x" in allE)
  apply (case_tac "r_x x")
    apply (auto)
   apply (case_tac "r_ex x")
     apply (auto)
  apply (case_tac "r_ex x")
    apply (auto)
  done

   (* - eq lemmas *)

lemma diff_use_eq: "\<lbrakk> r_x x \<noteq> OwnPerm \<rbrakk> \<Longrightarrow> diff_use_env r_s r_x x = r_s x"
  apply (simp add: diff_use_env_def)
  apply (case_tac "r_x x")
    apply (auto)
  done

    (* - fundamental lemmas *)

lemma spec_leq_perm: "\<lbrakk> leq_use_env r_x r_s \<rbrakk> \<Longrightarrow> leq_perm (r_x x) (r_s x)"
  apply (simp add: leq_use_env_def)
  done

    (* - leq lemmas *)

lemma trans_leq_perm: "\<lbrakk> leq_perm p q; leq_perm q r \<rbrakk> \<Longrightarrow> leq_perm p r"
  apply (case_tac q)
    apply (auto)
    apply (case_tac p)
      apply (auto)
   apply (case_tac r)
     apply (auto)
  apply (case_tac r)
    apply (auto)
  done

lemma diff_use_leq: "\<lbrakk> r_ex x \<noteq> OwnPerm; leq_use_env (diff_use_env r_x r_ex) r_s \<rbrakk> \<Longrightarrow> leq_perm (r_x x) (r_s x)"
  apply (simp add: leq_use_env_def)
  apply (erule_tac x="x" in allE)
  apply (simp add: diff_use_env_def)
  apply (case_tac "r_x x")
    apply (auto)
   apply (case_tac "r_ex x")
     apply (auto)
  apply (case_tac "r_ex x")
    apply (auto)
  done

lemma diff_use_leq2: "\<lbrakk> leq_use_env r_x (diff_use_env r_s r_ex); r_ex x \<noteq> OwnPerm \<rbrakk> \<Longrightarrow> leq_perm (r_x x) (r_s x)"
  apply (simp add: leq_use_env_def)
  apply (erule_tac x="x" in allE)
  apply (simp add: diff_use_env_def)
  apply (case_tac "r_ex x")
    apply (auto)
  done

lemma dist_union_leq_perm: "\<lbrakk> leq_perm p1 px; leq_perm p2 px \<rbrakk> \<Longrightarrow> leq_perm (union_perm p1 p2) px"
  apply (case_tac px)
    apply (auto)
   apply (case_tac p1)
     apply (auto)
   apply (case_tac p2)
     apply (auto)
  apply (case_tac p1)
    apply (auto)
   apply (case_tac p2)
     apply (auto)
  apply (case_tac p2)
    apply (auto)
  done

lemma union_leq_perm1: "\<lbrakk> leq_perm px p1 \<rbrakk> \<Longrightarrow> leq_perm px (union_perm p1 p2)"
  apply (case_tac px)
    apply (auto)
   apply (case_tac p1)
     apply (auto)
   apply (case_tac p2)
     apply (auto)
  apply (case_tac p1)
    apply (auto)
  done

lemma union_leq_perm2: "\<lbrakk> leq_perm px p2 \<rbrakk> \<Longrightarrow> leq_perm px (union_perm p1 p2)"
  apply (case_tac px)
    apply (auto)
   apply (case_tac p1)
     apply (auto)
    apply (case_tac p2)
      apply (auto)
   apply (case_tac p2)
     apply (auto)
  apply (case_tac p2)
    apply (auto)
  apply (case_tac p1)
    apply (auto)
  done

end


theory Weak_Logical_Equivalence
imports
  Weak_Formula
  Weak_Validity
begin

section \<open>Weak Logical Equivalence\<close>

context indexed_weak_nominal_ts
begin

  text \<open>Two states are weakly logically equivalent if they validate the same weak formulas.\<close>

  definition weakly_logically_equivalent :: "'state \<Rightarrow> 'state \<Rightarrow> bool" where
    "weakly_logically_equivalent P Q \<equiv> (\<forall>x::('idx,'pred,'act) formula. weak_formula x \<longrightarrow> P \<Turnstile> x \<longleftrightarrow> Q \<Turnstile> x)"

  notation weakly_logically_equivalent (infix "\<equiv>\<cdot>" 50)

  lemma weakly_logically_equivalent_eqvt:
    assumes "P \<equiv>\<cdot> Q" shows "p \<bullet> P \<equiv>\<cdot> p \<bullet> Q"
  unfolding weakly_logically_equivalent_def proof (clarify)
    fix x :: "('idx,'pred,'act) formula"
    assume "weak_formula x"
    then have "weak_formula (-p \<bullet> x)"
      by simp
    then show "p \<bullet> P \<Turnstile> x \<longleftrightarrow> p \<bullet> Q \<Turnstile> x"
      using assms by (metis (no_types, lifting) weakly_logically_equivalent_def permute_minus_cancel(2) valid_eqvt)
  qed

end

end