section \<open>The Unification Theorem\<close>

theory Unification_Theorem imports
  First_Order_Terms.Unification Resolution
begin

definition set_to_list :: "'a set \<Rightarrow> 'a list" where
  "set_to_list \<equiv> inv set"

lemma set_set_to_list: "finite xs \<Longrightarrow> set (set_to_list xs) = xs"
proof (induction rule: finite.induct)
  case (emptyI)
  have "set [] = {}" by auto
  then show ?case unfolding set_to_list_def inv_into_def by auto
next
  case (insertI A a)
  then have "set (a#set_to_list A) = insert a A" by auto
  then show ?case unfolding set_to_list_def inv_into_def by (metis (mono_tags, lifting) UNIV_I someI)
qed

fun iterm_to_fterm :: "(fun_sym, var_sym) term \<Rightarrow> fterm" where
  "iterm_to_fterm (Term.Var x) = Var x"
| "iterm_to_fterm (Term.Fun f ts) = Fun f (map iterm_to_fterm ts)"

fun fterm_to_iterm :: "fterm \<Rightarrow> (fun_sym, var_sym) term" where
  "fterm_to_iterm (Var x) = Term.Var x"
| "fterm_to_iterm (Fun f ts) = Term.Fun f (map fterm_to_iterm ts)"

lemma iterm_to_fterm_cancel[simp]: "iterm_to_fterm (fterm_to_iterm t) = t"
  by (induction t) (auto simp add: map_idI)

lemma fterm_to_iterm_cancel[simp]: "fterm_to_iterm (iterm_to_fterm t) = t"
  by (induction t) (auto simp add: map_idI)

abbreviation(input) fsub_to_isub :: "substitution \<Rightarrow> (fun_sym, var_sym) subst" where
  "fsub_to_isub \<sigma> \<equiv> \<lambda>x. fterm_to_iterm (\<sigma> x)"

abbreviation(input) isub_to_fsub :: "(fun_sym, var_sym) subst \<Rightarrow> substitution" where
  "isub_to_fsub \<sigma> \<equiv> \<lambda>x. iterm_to_fterm (\<sigma> x)"

lemma iterm_to_fterm_subt: "(iterm_to_fterm t1) \<cdot>\<^sub>t \<sigma> = iterm_to_fterm (t1 \<cdot> (\<lambda>x. fterm_to_iterm (\<sigma> x)))"
  by (induction t1) auto

lemma unifiert_unifiers:
  assumes "unifier\<^sub>t\<^sub>s \<sigma> ts"
  shows "fsub_to_isub \<sigma> \<in> unifiers (fterm_to_iterm ` ts \<times> fterm_to_iterm ` ts)"
proof -
  have "\<forall>t1 \<in> fterm_to_iterm ` ts. \<forall>t2 \<in> fterm_to_iterm ` ts. t1 \<cdot> (fsub_to_isub \<sigma>) = t2 \<cdot> (fsub_to_isub \<sigma>)"
    proof (rule ballI;rule ballI)
      fix t1 t2
      assume t1_p: "t1 \<in> fterm_to_iterm ` ts" assume t2_p: "t2 \<in> fterm_to_iterm ` ts"
      from t1_p t2_p have "iterm_to_fterm t1 \<in> ts \<and> iterm_to_fterm t2 \<in> ts" by auto
      then have "(iterm_to_fterm t1) \<cdot>\<^sub>t \<sigma> = (iterm_to_fterm t2) \<cdot>\<^sub>t \<sigma>" using assms unfolding unifier\<^sub>t\<^sub>s_def by auto
      then have "iterm_to_fterm (t1 \<cdot> fsub_to_isub \<sigma>) = iterm_to_fterm (t2 \<cdot> fsub_to_isub \<sigma>)" using iterm_to_fterm_subt by auto
      then have "fterm_to_iterm (iterm_to_fterm (t1 \<cdot> fsub_to_isub \<sigma>)) = fterm_to_iterm (iterm_to_fterm (t2 \<cdot> fsub_to_isub \<sigma>))" by auto
      then show "t1 \<cdot> fsub_to_isub \<sigma> = t2 \<cdot> fsub_to_isub \<sigma>" using fterm_to_iterm_cancel by auto
    qed
  then have "\<forall>p\<in>fterm_to_iterm ` ts \<times> fterm_to_iterm ` ts. fst p \<cdot> fsub_to_isub \<sigma> = snd p \<cdot> fsub_to_isub \<sigma>" by (metis mem_Times_iff)
  then show ?thesis unfolding unifiers_def by blast
qed

abbreviation(input) get_mgut :: "fterm list \<Rightarrow> substitution option" where
  "get_mgut ts \<equiv> map_option (isub_to_fsub \<circ> subst_of) (unify (List.product (map fterm_to_iterm ts) (map fterm_to_iterm ts)) [])"

lemma unify_unification:
  assumes "\<sigma> \<in> unifiers (set E)"
  shows "\<exists>\<theta>. is_imgu \<theta> (set E)"
proof -
  from assms have "\<exists>cs. unify E [] = Some cs" using unify_complete by auto
  then show ?thesis using unify_sound by auto
qed

lemma fterm_to_iterm_subst: "(fterm_to_iterm t1) \<cdot> \<sigma> =fterm_to_iterm (t1 \<cdot>\<^sub>t isub_to_fsub \<sigma>)"
  by (induction t1) auto

lemma unifiers_unifiert:
  assumes "\<sigma> \<in> unifiers (fterm_to_iterm ` ts \<times> fterm_to_iterm ` ts)"
  shows "unifier\<^sub>t\<^sub>s (isub_to_fsub \<sigma>) ts"
proof (cases "ts={}")
  assume "ts = {}"
  then show "unifier\<^sub>t\<^sub>s (isub_to_fsub \<sigma>) ts" unfolding unifier\<^sub>t\<^sub>s_def by auto
next
  assume "ts \<noteq> {}"
  then obtain t' where t'_p: "t' \<in> ts" by auto

  have "\<forall>t\<^sub>1\<in>ts. \<forall>t\<^sub>2\<in>ts. t\<^sub>1 \<cdot>\<^sub>t isub_to_fsub \<sigma> = t\<^sub>2 \<cdot>\<^sub>t isub_to_fsub \<sigma>"
    proof (rule ballI ; rule ballI)
      fix t\<^sub>1 t\<^sub>2
      assume "t\<^sub>1 \<in> ts" "t\<^sub>2 \<in> ts"
      then have "fterm_to_iterm t\<^sub>1 \<in> fterm_to_iterm ` ts" "fterm_to_iterm t\<^sub>2 \<in> fterm_to_iterm ` ts" by auto
      then have "(fterm_to_iterm t\<^sub>1, fterm_to_iterm t\<^sub>2) \<in> (fterm_to_iterm ` ts \<times> fterm_to_iterm ` ts)" by auto
      then have "(fterm_to_iterm t\<^sub>1) \<cdot> \<sigma> = (fterm_to_iterm t\<^sub>2) \<cdot> \<sigma>" using assms unfolding unifiers_def
         by (metis (no_types, lifting) assms fst_conv in_unifiersE snd_conv)
      then have "fterm_to_iterm (t\<^sub>1 \<cdot>\<^sub>t isub_to_fsub \<sigma>) = fterm_to_iterm (t\<^sub>2 \<cdot>\<^sub>t isub_to_fsub \<sigma>)" using fterm_to_iterm_subst by auto
      then have "iterm_to_fterm (fterm_to_iterm (t\<^sub>1 \<cdot>\<^sub>t (isub_to_fsub \<sigma>))) = iterm_to_fterm (fterm_to_iterm (t\<^sub>2 \<cdot>\<^sub>t isub_to_fsub \<sigma>))" by auto
      then show "t\<^sub>1 \<cdot>\<^sub>t isub_to_fsub \<sigma> = t\<^sub>2 \<cdot>\<^sub>t isub_to_fsub \<sigma>" by auto
    qed
  then have "\<forall>t\<^sub>2\<in>ts. t' \<cdot>\<^sub>t isub_to_fsub \<sigma> = t\<^sub>2 \<cdot>\<^sub>t isub_to_fsub \<sigma>" using t'_p by blast
  then show "unifier\<^sub>t\<^sub>s (isub_to_fsub \<sigma>) ts" unfolding unifier\<^sub>t\<^sub>s_def by metis
qed

lemma icomp_fcomp: "\<theta> \<circ>\<^sub>s i = fsub_to_isub (isub_to_fsub \<theta> \<cdot> isub_to_fsub i)"
  unfolding composition_def subst_compose_def
proof
  fix x
  show "\<theta> x \<cdot> i = fterm_to_iterm (iterm_to_fterm (\<theta> x) \<cdot>\<^sub>t (\<lambda>x. iterm_to_fterm (i x)))" using iterm_to_fterm_subt by auto
qed

lemma is_mgu_mgu\<^sub>t\<^sub>s:
  assumes "finite ts"
  assumes "is_imgu \<theta> (fterm_to_iterm ` ts \<times> fterm_to_iterm ` ts)"
  shows "mgu\<^sub>t\<^sub>s (isub_to_fsub \<theta>) ts"
proof -
  from assms have "unifier\<^sub>t\<^sub>s (isub_to_fsub \<theta>) ts" unfolding is_imgu_def using unifiers_unifiert by auto
  moreover have "\<forall>u. unifier\<^sub>t\<^sub>s u ts \<longrightarrow> (\<exists>i. u = (isub_to_fsub \<theta>) \<cdot> i)"
    proof (rule allI; rule impI)
      fix u
      assume "unifier\<^sub>t\<^sub>s u ts"
      then have "fsub_to_isub u \<in> unifiers (fterm_to_iterm ` ts \<times> fterm_to_iterm ` ts)" using unifiert_unifiers by auto
      then have "\<exists>i. fsub_to_isub u = \<theta> \<circ>\<^sub>s i" using assms unfolding is_imgu_def by auto
      then obtain i where "fsub_to_isub u = \<theta> \<circ>\<^sub>s i" by auto
      then have "fsub_to_isub u =  fsub_to_isub (isub_to_fsub \<theta> \<cdot> isub_to_fsub i)" using icomp_fcomp by auto
      then have "isub_to_fsub (fsub_to_isub u) = isub_to_fsub (fsub_to_isub (isub_to_fsub \<theta> \<cdot> isub_to_fsub i))" by metis
      then have "u = isub_to_fsub \<theta> \<cdot> isub_to_fsub i" by auto
      then show "\<exists>i. u = isub_to_fsub \<theta> \<cdot> i" by metis
    qed
  ultimately show ?thesis unfolding mgu\<^sub>t\<^sub>s_def by auto
qed

lemma unification':
  assumes "finite ts"
  assumes  "unifier\<^sub>t\<^sub>s \<sigma> ts"
  shows "\<exists>\<theta>. mgu\<^sub>t\<^sub>s \<theta> ts"
proof -
  let ?E = "fterm_to_iterm ` ts \<times> fterm_to_iterm ` ts"
  let ?lE = "set_to_list ?E"
  from assms have "fsub_to_isub \<sigma> \<in> unifiers ?E" using unifiert_unifiers by auto
  then have "\<exists>\<theta>. is_imgu \<theta> ?E"
    using unify_unification[of "fsub_to_isub \<sigma>" ?lE] assms by (simp add: set_set_to_list)
  then obtain \<theta> where "is_imgu \<theta> ?E" unfolding set_to_list_def by auto
  then have "mgu\<^sub>t\<^sub>s (isub_to_fsub \<theta>) ts" using assms is_mgu_mgu\<^sub>t\<^sub>s by auto
  then show ?thesis by auto
qed

fun literal_to_term :: "fterm literal \<Rightarrow> fterm" where
  "literal_to_term (Pos p ts) = Fun ''Pos'' [Fun p ts]"
| "literal_to_term (Neg p ts) = Fun ''Neg'' [Fun p ts]"

fun term_to_literal :: "fterm \<Rightarrow> fterm literal" where
  "term_to_literal (Fun s [Fun p ts]) = (if s=''Pos'' then Pos else Neg) p ts"

lemma term_to_literal_cancel[simp]: "term_to_literal (literal_to_term l) = l"
  by (cases l) auto

lemma literal_to_term_sub: "literal_to_term (l \<cdot>\<^sub>l \<sigma>) = (literal_to_term l) \<cdot>\<^sub>t \<sigma>"
  by (induction l) auto

lemma unifier\<^sub>l\<^sub>s_unifier\<^sub>t\<^sub>s:
  assumes "unifier\<^sub>l\<^sub>s \<sigma> L"
  shows "unifier\<^sub>t\<^sub>s \<sigma> (literal_to_term `  L)"
proof -
  from assms obtain l' where "\<forall>l\<in>L. l \<cdot>\<^sub>l \<sigma> = l'" unfolding unifier\<^sub>l\<^sub>s_def by auto
  then have "\<forall>l\<in>L. literal_to_term (l \<cdot>\<^sub>l \<sigma>) = literal_to_term l'" by auto
  then have "\<forall>l\<in>L. (literal_to_term l) \<cdot>\<^sub>t \<sigma> = literal_to_term l'" using literal_to_term_sub by auto
  then have "\<forall>t\<in>literal_to_term ` L. t \<cdot>\<^sub>t \<sigma> = literal_to_term l'" by auto
  then show ?thesis unfolding unifier\<^sub>t\<^sub>s_def by auto
qed

lemma unifiert_unifier\<^sub>l\<^sub>s:
  assumes "unifier\<^sub>t\<^sub>s \<sigma> (literal_to_term `  L)"
  shows "unifier\<^sub>l\<^sub>s \<sigma> L"
proof -
  from assms obtain t' where "\<forall>t\<in>literal_to_term ` L. t \<cdot>\<^sub>t \<sigma> = t'" unfolding unifier\<^sub>t\<^sub>s_def by auto
  then have "\<forall>t\<in>literal_to_term ` L. term_to_literal (t \<cdot>\<^sub>t \<sigma>) = term_to_literal t'"  by auto
  then have "\<forall>l\<in> L. term_to_literal ((literal_to_term l) \<cdot>\<^sub>t \<sigma>) = term_to_literal t'" by auto
  then have "\<forall>l\<in> L. term_to_literal ((literal_to_term (l \<cdot>\<^sub>l \<sigma>))) = term_to_literal t'" using literal_to_term_sub by auto
  then have "\<forall>l\<in> L. l \<cdot>\<^sub>l \<sigma> = term_to_literal t'" by auto
  then show ?thesis unfolding unifier\<^sub>l\<^sub>s_def by auto
qed

lemma mgu\<^sub>t\<^sub>s_mgu\<^sub>l\<^sub>s:
  assumes "mgu\<^sub>t\<^sub>s \<theta> (literal_to_term `  L)"
  shows "mgu\<^sub>l\<^sub>s \<theta> L"
proof -
  from assms have "unifier\<^sub>t\<^sub>s \<theta> (literal_to_term `  L)" unfolding mgu\<^sub>t\<^sub>s_def by auto
  then have "unifier\<^sub>l\<^sub>s \<theta> L" using unifiert_unifier\<^sub>l\<^sub>s by auto
  moreover
  {
    fix u
    assume "unifier\<^sub>l\<^sub>s u L"
    then have "unifier\<^sub>t\<^sub>s u (literal_to_term `  L)" using unifier\<^sub>l\<^sub>s_unifier\<^sub>t\<^sub>s by auto
    then have "\<exists>i. u = \<theta> \<cdot> i" using assms unfolding mgu\<^sub>t\<^sub>s_def by auto
  }
  ultimately show ?thesis unfolding mgu\<^sub>l\<^sub>s_def by auto
qed

theorem unification:
  assumes fin: "finite L"
  assumes uni: "unifier\<^sub>l\<^sub>s \<sigma> L"
  shows "\<exists>\<theta>. mgu\<^sub>l\<^sub>s \<theta> L"
proof -
  from uni have "unifier\<^sub>t\<^sub>s \<sigma> (literal_to_term `  L)" using unifier\<^sub>l\<^sub>s_unifier\<^sub>t\<^sub>s by auto
  then obtain \<theta> where "mgu\<^sub>t\<^sub>s \<theta> (literal_to_term `  L)" using fin unification' by blast
  then have "mgu\<^sub>l\<^sub>s \<theta> L" using mgu\<^sub>t\<^sub>s_mgu\<^sub>l\<^sub>s by auto
  then show ?thesis by auto
qed

end


theory Counterexample
  imports MainRLT
begin

lemma bij_upto_surjE:
  "bij_upto P Q f \<Longrightarrow> Q y y \<Longrightarrow> \<exists>x. P x x \<and> Q y (f x)"
  unfolding bij_upto_def by blast

(* Next is a formalization of the paper's Example 6,
showing a type definition of a type \<tau> that, not being wide, cannot support
a suitable relativization infrastructure on the defined type.

As explained in the paper, the root cause for this
is that the defining predicate t has smaller cardinality than
its relativized version t_rlt, even after quotienting t_rlt to the
PER relational interpretation on the host type 'a \<sigma>.

To exhibit this problem, we take 'a \<sigma> to be ind\<Rightarrow>'a and we prove that,
for a large enough instance of 'a, namely ind\<Rightarrow>bool and a small
enough PER R on 'a (one given by a small enough set A), we have the following:
-- t is a singleton, whereas
-- the set of RIN(ind\<Rightarrow>bool)-classes that satisfy t_rlt has at least
two elements.*)

definition t :: "(ind \<Rightarrow> 'a) \<Rightarrow> bool" where
  "t \<equiv> \<lambda>f. (\<forall>x. \<exists>i. f i = x) \<or> (\<forall>i. f i = (SOME x. True))"

typedef 'a \<tau> = "{f::ind \<Rightarrow>'a. t f}"
  unfolding t_def by auto

(* The extension of the predicate t is a singleton for large enough types 'a,
for example taking 'a to be ind\<Rightarrow>bool: *)
lemma t_singl:
  fixes f::"ind\<Rightarrow>(ind\<Rightarrow>bool)"
  shows "t f \<longleftrightarrow> f = (\<lambda>i. (SOME x. True))"
proof -
  { assume "\<forall>x. \<exists>i. f i = x"
    then have "range (Collect \<circ> f) = Pow UNIV"
      unfolding image_def by auto (metis Collect_mem_eq)
    then have False using Cantors_paradox by blast
  }
  thus ?thesis unfolding t_def by auto
qed

(* Hence the newly defined type is also a singleton for that instance: *)

lemma \<tau>_singl: "(x :: (ind\<Rightarrow>bool) \<tau>) = Abs_\<tau> (\<lambda>i. SOME f. True)"
  by (cases x) (auto simp: t_singl)

(* We use the RLCST command to perform the relativization of t: *)
local_setup \<open>RLCST @{term t}\<close>

lemma t_rlt_alt: "neper R \<Longrightarrow> t_rlt R f \<longleftrightarrow> (\<forall>x. R x x \<longrightarrow> (\<exists>i. R (f i) x) \<or> (\<forall>x. R (f x) (SOME a. R a a)))"
  unfolding t_rlt_def by (auto simp: Eps_rlt_True)

(* Now we are ready to show that \<tau> cannot have a relational interpretation
in such a way that a basic sanity property is satisfied:
the relativized version of the typedef theorem holds. *)

(* Indeed, let us assume that such a relational interpretation rel_\<tau> existed: *)
consts rel_\<tau> :: "('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> 'a \<tau> \<Rightarrow> 'a \<tau> \<Rightarrow> bool"
(* ... and satisfied the aforementioned property: *)
axiomatization where
  bij_upto_\<tau>: "\<And>R. neper R \<Longrightarrow> \<exists>f. bij_upto (rel_\<tau> R) (restr (rel_fun (=) R) (t_rlt R)) (f R)"

(* That would yield a contradiction (a proof of False). The proof encodes
the aforementioned cardinality mismatch argument, after instantiating 'a to ind\<Rightarrow>bool  *)
lemma False
proof -
  define T where "T \<equiv> (\<lambda>_ :: ind. True)"
  define F where "F \<equiv> (\<lambda>_ :: ind. False)"
  define A where "A \<equiv> {T,F}"

  define R where "R \<equiv> perOfSet A"
  let ?RLT = "restr (rel_fun (=) R) (t_rlt R)"
  have neper[simp]: "neper R"
    unfolding R_def A_def
    by (meson insertI1 neper_def perOfSet_def per_perOfSet)
  from bij_upto_\<tau>[OF neper] obtain f where bij_upto: "bij_upto (rel_\<tau> R) ?RLT (f R)"
    by blast
  note surjE = bij_upto_surjE[where Q = ?RLT, OF bij_upto]

  have [simp]: "(SOME a. a \<in> A) \<in> A"
  	 by (metis A_def insertI1 someI)

  have 0: "rel_fun (=) R u u' \<longleftrightarrow> (u = u' \<and> (\<forall> i::ind. u i \<in> A))" for u u'
    unfolding  rel_fun_def R_def perOfSet_def by auto

  have 1: "?RLT u u' \<longleftrightarrow> u = u' \<and> (range u = A \<or> u = (\<lambda>i. SOME a. a \<in> A))" for u u'
    unfolding 0 unfolding t_rlt_alt[OF neper] unfolding R_def restr_def perOfSet_def image_def
    by fastforce

  have disj: "Eps (\<lambda>a. a \<in> A) = T \<or> Eps (\<lambda>a. a \<in> A) = F"
    unfolding A_def by (metis insert_iff singletonD some_in_eq)
  then have "?RLT (\<lambda>_. Eps (\<lambda>a. a \<in> A)) (\<lambda>_. Eps (\<lambda>a. a \<in> A))"
    unfolding restr_def t_rlt_alt[OF neper] unfolding R_def rel_fun_def perOfSet_def by auto
  from surjE[OF this] obtain x where "rel_\<tau> R x x" "f R x = (\<lambda>_. Eps (\<lambda>a. a \<in> A))"
    by (auto simp: 1)

  moreover

  let ?u = "\<lambda>z. if z = Zero_Rep then T else F"
  from Suc_Rep_not_Zero_Rep have "?RLT ?u ?u"
    unfolding t_rlt_alt[OF neper] unfolding restr_def R_def A_def rel_fun_def perOfSet_def by auto
  from surjE[OF this] obtain y where "rel_\<tau> R y y" "f R y = ?u"
    by (auto simp: 1)

  moreover from disj Suc_Rep_not_Zero_Rep have "?u \<noteq> (\<lambda>_. Eps (\<lambda>a. a \<in> A))"
    by (auto simp: fun_eq_iff T_def F_def)

  ultimately show False
    by (auto simp: eq_onp_def \<tau>_singl[of x] \<tau>_singl[of y])
qed

end


theory Sound
imports op HHL
begin

no_notation FForm ("F _")
no_notation EExp ("E _")

(*The definition for the soundness of sequtial process*)
definition Valid :: "fform => proc => fform => fform => bool" ("Valid _ _ _ _")
where "Valid p Q q H =
         (ALL f d f' d'. (evalP (Q, f, d) = (Skip, f', d')) --> evalF (last(f(d)), p)
           --> (evalF (last(f'(d')), q) & ievalF (f', H, d, d')))"

(*The definition for the soundness of parallel process*)
definition ValidP :: "fform => fform => proc => proc => fform => fform => fform => fform => bool"
("ValidP _ _ _ _ _ _ _ _")
where "ValidP p1 p2 P Q q1 q2 H1 H2 =
         (ALL f g f' g' d d1 d2. (evalPP (P||Q,f,g,d) = (Skip,f',g',d1,d2))
            --> evalF (last(f(d)), p1) --> evalF (last(g(d)), p2)
              --> (evalF (last(f'(d1)), q1) & evalF (last(g'(d2)), q2) &
                     ievalF (f', H1, d, d1)& ievalF (g', H2, d, d2)))"

(*soundness for consequence rule of sequtial*)
lemma ConsequenceS_sound: "Valid px P qx Hx
        --> (ALL f1 d1. evalF (last(f1(d1)),(p [-->] px)))
        --> (ALL f1 d1. evalF (last(f1(d1)),(qx [-->] q)))
        --> (ALL f1 d1 d2. ievalF (f1,(Hx [-->] H),d1,d2))
        --> Valid p P q H"
apply (simp add: Imply_eval)
apply (unfold Valid_def,auto)
apply (subgoal_tac "evalF(last(f'(d')), qx)",auto)
apply (subgoal_tac "evalF(last(f(d)), px)",auto)
apply (subgoal_tac "ievalF(f', Hx, d, d')",auto)
apply (subgoal_tac "evalF(last(f(d)), px)",auto)
done

(*soundness for consequence rule of parallel*)
lemma ConsequenceP_sound: "ValidP px py Px Py qx qy Hx Hy
        --> (ALL f1 d1. evalF (last(f1(d1)),(p [-->] px)))
        --> (ALL f1 d1. evalF (last(f1(d1)),(r [-->] py)))
        --> (ALL f1 d1. evalF (last(f1(d1)),(qx [-->] q)))
        --> (ALL f1 d1. evalF (last(f1(d1)),(qy [-->] s)))
        --> (ALL f1 d1 d2. ievalF (f1,(Hx [-->] H),d1,d2))
        --> (ALL f1 d1 d2. ievalF (f1,(Hy [-->] G),d1,d2))
        --> ValidP p r Px Py q s H G"
apply (simp add: Imply_eval)
apply (unfold ValidP_def,auto)
apply blast
apply (subgoal_tac "evalF(last(g'(d2)), qy)",auto)
apply (subgoal_tac "evalF(last(f(d)), px)",auto)
apply (subgoal_tac "evalF(last(g(d)), py)",auto)
apply (subgoal_tac "ievalF(f', Hx, d, d1)",auto)
apply (subgoal_tac "evalF(last(f(d)), px)",auto)
apply (subgoal_tac "evalF(last(g(d)), py)",auto)
apply (subgoal_tac "ievalF(g', Hy, d, d2)",auto)
apply (subgoal_tac "evalF(last(f(d)), px)",auto)
apply (subgoal_tac "evalF(last(g(d)), py)",auto)
done

(*The following rules from substR_fact1 to substR are for syntatical substitution,
  and are used for proving soundness of assignment rule and communiction rule.*)
lemma substR_fact1 : " ALL f. evalE(f, substE([(RVar x, e)], v))
        = evalE(%y i. if y = x & i = R then evalE(f, e) else f(y, i), v)"
apply (induct v, auto)
apply (case_tac "evalE(%y i. if y = x & i = R then evalE(f, e) else f(y, i), v1)", auto)+
  done
  sorry

lemma substR_fact2: "substE([], e) = e"
apply (induct "e", auto)
done

lemma substR_fact3: "substF([], q) = q"
apply (induct "q", auto)
apply (simp add:substR_fact2)+
done

lemma substR_fact4: " ~ inPairForm([(RVar x, e)], WALL list q)
        ==> ((substF([(RVar x, e)], WALL list q)) = (WALL list (substF ([(RVar x, e)], q))))"
apply (simp add:inPairForm_def)
done

lemma substR_fact5 : "~inExp(list, e)
        ==> ALL f v. evalE(f, e) = evalE(%a i. if a = list then RR(v) else f(a, i), e)"
apply (induct e, auto)
apply (case_tac "evalE(f, e1)", auto)+
  done
  sorry

lemma substR_ALL : " [| ~ inPairForm([(RVar x, e)], q)
        ==> ALL f. evalF(f, substF([(RVar x, e)], q))
                 = evalF(%y i. if y = x & i = R then evalE(f, e) else f(y, i), q);
        ~ inPairForm([(RVar x, e)], WALL list q ) |]
        ==> ALL f. evalF(f, substF([(RVar x, e)], WALL list q ))
                 = evalF(%y i. if y = x & i = R then evalE(f, e) else f(y, i), WALL list q )"
apply (rule allI)
apply (cut_tac x = x and e = e and q = q and list = "list" in substR_fact4, simp)
apply (subgoal_tac "evalF(f, substF([(RVar x, e)], WALL list q ))
         = evalF (f, (WALL list substF([(RVar x, e)], q)))")
defer apply simp
apply (subgoal_tac "evalF(f, substF([(RVar x, e)], WALL list q ))
         = (ALL (v::real). (evalF((%a. %i. (if (a=list) then (RR (v)) else (f(a, i))))
              , substF([(RVar x, e)], q))))")
defer apply simp
apply (subgoal_tac "evalF(%y i. if y = x & i = R  then evalE(f, e) else f(y, i), WALL list q) =
         (let f1 = (%y i. if y = x & i = R  then evalE(f, e) else f(y, i)) in
         (ALL (v::real). (evalF((%a. %i. (if (a=list) then (RR (v)) else (f1(a, i)))), q))))")
defer apply simp
apply (subgoal_tac "~ inPairForm([(RVar x, e)], q)")
defer apply simp
apply (subgoal_tac "ALL v. let f2 = %a i. if a = list then RR(v) else f(a, i) in
         (evalF(f2, substF([(RVar x, e)], q))
         = evalF(%y i. if y = x & i = R  then evalE(f2, e) else f2(y, i), q))")
defer apply simp
apply (subgoal_tac "(let f1 = %y i. if y = x & i = R  then evalE(f, e) else f(y, i) in
         ALL v. evalF(%a i. if a = list then RR(v) else f1(a, i), q)) =
         (ALL v. let f2 = %a i. if a = list then RR(v) else f(a, i) in
           evalF(%y i. if y = x & i = R  then evalE(f2, e) else f2(y, i), q))", simp)
apply (subgoal_tac "~x=list")
apply (simp add:Let_def)
apply (subgoal_tac "ALL v t. evalE(f, e) = evalE(%a i. if a = list then RR(v) else f(a, i), e)")
apply (subgoal_tac "ALL v. (%a i. if a = list then RR(v) else if a = x & i = R then evalE(f, e) else f(a, i))
         = (%y i. if y = x & i = R  then evalE(%a i. if a = list then RR(v) else f(a, i), e)
         else if y = list then RR(v) else f(y, i))", simp)
apply (simp add:fun_eq_iff)
apply (cut_tac list = "list" and e =  e in substR_fact5, auto)
done

lemma substR_fact6: " ~ inPairForm([(RVar x, e)], WEX list q) ==>
        ((substF([(RVar x, e)], WEX list q)) = (WEX list (substF ([(RVar x, e)], q))))"
apply (simp add:inPairForm_def)
done

lemma substR_EX : "[| ~ inPairForm([(RVar x, e)], q)
        ==> ALL f. evalF(f, substF([(RVar x, e)], q))
                 = evalF(%y i. if y = x & i = R then evalE(f, e) else f(y, i), q);
        ~ inPairForm([(RVar x, e)], WEX list q) |]
        ==> ALL f. evalF(f, substF([(RVar x, e)], WEX list q))
                 = evalF(%y i. if y = x & i = R then evalE(f, e) else f(y, i), WEX list q)"
apply (rule allI)
apply (cut_tac x = x and e = e and q = q and list = "list" in substR_fact6, simp)
apply (subgoal_tac "evalF(f, substF([(RVar x, e)], WEX list q ))
                  = evalF ( f, (WEX list substF([(RVar x, e)], q)))")
defer apply simp
apply (subgoal_tac "evalF(f, substF([(RVar x, e)], WEX list q ))
         = (EX (v::real). (evalF((%a. %i. (if (a=list) then (RR (v)) else (f(a, i))))
              , substF([(RVar x, e)], q))))")
defer apply simp
apply (subgoal_tac "evalF(%y i. if y = x & i = R  then evalE(f, e) else f(y, i), WEX list q)
         = (let f1 = (%y i. if y = x & i = R  then evalE(f, e) else f(y, i)) in
             (EX (v::real) .  (evalF((%a. %i. (if (a=list) then (RR (v)) else (f1(a, i)))), q))))")
defer apply simp
apply (subgoal_tac "~ inPairForm([(RVar x, e)], q)")
defer apply simp
apply (subgoal_tac "EX v. let f2 = %a i. if a = list then RR(v) else f(a, i) in
         (evalF(f2, substF([(RVar x, e)], q))
         = evalF(%y i. if y = x & i = R  then evalE(f2, e) else f2(y, i), q))")
defer apply simp
apply (subgoal_tac "(let f1 = %y i. if y = x & i = R  then evalE(f, e) else f(y, i)
         in EX v. evalF(%a i. if a = list then RR(v) else f1(a, i), q)) =
         (EX v. let f2 = %a i. if a = list then RR(v) else f(a, i)
         in  evalF(%y i. if y = x & i = R  then evalE(f2, e) else f2(y, i), q))", simp)
apply (subgoal_tac "~x=list")
apply (simp add:Let_def)
apply (subgoal_tac "ALL v. evalE(f, e) = evalE(%a i. if a = list then RR(v) else f(a, i), e)")
apply (subgoal_tac "ALL v. (%a i. if a = list then RR(v) else if a = x & i = R   then evalE(f, e) else f(a, i))
         = (%y i. if y = x & i = R then evalE(%a i. if a = list then RR(v) else f(a, i), e)
           else if y = list then RR(v) else f(y, i))", auto)
apply (simp add:fun_eq_iff)
apply (cut_tac list = "list" and e =  e in substR_fact5, auto)
done

(*lemma used for proving the soundness of assignment rule and communication rule.
  This lemma means that the substitution for a variable is equivlant to change the state.*)
lemma substR: "~inPairForm ([(RVar x, e)], q) ==> ALL f. evalF(f, substF([(RVar x, e)], q)) =
              evalF(%y i. if y = x & i = R then evalE(f, e) else f(y, i), q)"
apply (induct q)
apply simp
apply simp
defer defer defer
apply simp
apply simp
apply simp
apply simp
apply simp
defer defer
apply (simp add:substF_def)
apply (cut_tac x = x and e=e and v = "exp1" in substR_fact1)
apply (cut_tac x = x and e=e and v = "exp2" in substR_fact1)
apply (rule allI)
apply (case_tac "evalE(%y i. if y = x & i = R then evalE(f, e) else f(y, i), exp1)")
apply simp
apply simp
apply simp
apply simp
apply (simp add:substF_def)
apply (cut_tac  x = x and e=e and v = "exp1" in substR_fact1)
apply (cut_tac  x = x and e=e and v = "exp2" in substR_fact1)
apply (rule allI)
apply (case_tac "evalE(%y i. if y = x & i = R then evalE(f, e) else f(y, i), exp1)")
apply simp
apply simp
apply simp
apply simp
apply (simp add:substF_def)
apply (cut_tac  x = x and e=e and v = "exp1" in substR_fact1)
apply (cut_tac  x = x and e=e and v = "exp2" in substR_fact1)
apply (rule allI)
apply (case_tac "evalE(%y i. if y = x & i = R then evalE(f, e) else f(y, i), exp1)")
apply simp
apply simp
apply simp
apply simp
apply (cut_tac x =  x and e = e and q = q and list = "list" in substR_ALL, simp)
apply simp
apply simp
apply (cut_tac x =  x and e = e and q = q and list = "list" in substR_EX, auto)
  done
  sorry

(*soundness for assign rule of real variable, others are in the end of this file*)
lemma AssignR_sound: "~inPairForm ([(RVar x, e)], q) &
        (ALL f. evalF (f, p [-->] (substF ([((RVar (x)), e)]) (q))))
        &   (ALL f d1 d2. ievalF (f, (l [=] (Real 0)) [-->] G, d1, d2)) --> Valid p (RVar (x)):=e q G"
apply (simp add:Imply_eval)
apply (unfold Valid_def, auto)
(*1st*)
apply (cut_tac x = "x" and e = "e" and f = "f" and d = "d" in assignR,auto)
apply (cut_tac x = x and e = e and q = q  in substR,auto)
(*2nd*)
apply (cut_tac x = "x" and e = "e" and f = "f" and d = "d" in assignR,simp)
apply (subgoal_tac "ievalF(f', l [=] Real 0, d', d')",auto)
apply (cut_tac L=0 in L_eval,auto)
done

(*soundness for continue rule*)
lemma continue_sound: "(ALL f1 d1 d2. evalF (last(f1(d1)),Init [-->] F))
        & (ALL f1 d1 d2. evalF (last(f1(d1)),((p [&] close(F) [&] close([~]b)) [-->] q)))
        & (ALL f1 d1 d2. ievalF (f1,((((l [=] Real 0) [|] (high (close(F) [&] p [&] close(b)))) [&] Rg) [-->] G),d1,d2))
        & (disj (p, F))
        --> Valid (Init [&] p) (<F&&b> : Rg) q G"
apply (unfold Valid_def, auto)
(*1st*)
apply (cut_tac F = F and b = b and  Rg = "Rg" and f = f and d = d and f' = "f'" and d' = "d'" in continue, auto)
apply (subgoal_tac "evalF(last(f'(d')), p) & evalF(last(f'(d')), close(F)) & evalF(last(f'(d')), NotForm(b))",auto)
apply (cut_tac f = "last(f'(d'))" and b = d and c = "d'" and p = F in close_fact1, auto)
apply (cut_tac f = "last(f'(d'))" and b = d and c = "d'" and p = b in close_fact2, auto)
(*2nd*)
apply (simp add:Imply_eval And_eval Or_eval)
apply (cut_tac F = F and b = b and  Rg = "Rg" and f = f and d = d and f' = "f'" and d' = "d'" in continue, auto)
apply (subgoal_tac "( ((ievalF(f', (l [=] Real 0), d, d')) | (ievalF(f', (high (close(F) [&] p [&] close(b))), d, d')) ) &
             (ievalF(f', Rg, d, d')) ) --> (ievalF(f',G,d,d'))")
prefer 2
apply simp
apply (subgoal_tac "( ((ievalF(f', (l [=] Real 0), d, d')) | (ievalF(f', (high (close(F) [&] p [&] close(b))), d, d')) ) &
             (ievalF(f', Rg, d, d')) )",simp)
apply auto
apply (case_tac "d=d'",auto)
apply (cut_tac L=0 in L_eval,auto)
apply (subgoal_tac "ievalF(f', high (close(F) [&] p [&] close(b)), d, d')",simp)
apply (simp add: high_eval And_eval,auto)
apply (subgoal_tac "evalFP(f', F [&] b, ka)",auto)
apply (simp add: evalFP_def And_eval)
apply (rule allI)
apply (subgoal_tac "inList(s, f'(ka)) --> evalF(s, F) & evalF(s, b)")
defer
apply blast
apply (rule impI)
apply (subgoal_tac "evalF(s, F) & evalF(s, b)")
defer
apply blast
apply (rule conjI)
apply (cut_tac s=s and p=F in close_fact3,simp)
apply assumption
apply (rule conjI)
defer
apply (cut_tac s=s and p=b in close_fact3,simp)
apply assumption
apply blast
done

(*soundness for sequence rule*)
lemma Sequence_sound: "(Valid p P m H
        & Valid m Q q G)
        --> Valid p (P;(m,H);Q) q H[^]G"
apply (simp add:Valid_def, auto)
apply (cut_tac P = P and mid = "(m, H)" and Q = Q and f = f and
               d = d and F = "f'" and D = "d'" in sequence, auto)
apply blast
apply (cut_tac P = P and mid = "(m, H)" and Q = Q and f = f and
               d = d and F = "f'" and D = "d'" in sequence, auto)
apply (cut_tac f = "f'" and P = H and Q = G and c = d and d = "d'" in chop_eval1, auto)
apply blast
done

(*soundness for condition rule in case b is false,
  later it is used to prove the soundness of condition rule*)
lemma ConditionF_sound: "(ALL f1 d1 d2. evalF (last(f1(d1)),(p [-->] [~] b))
        & evalF (last(f1(d1)),(p [-->] q))
        & ievalF (f1,((l [=] Real 0) [-->] G),d1,d2))
        --> Valid p (IF b P) q G"
apply (simp add:Imply_eval)
apply (simp add:Valid_def, auto)
apply (simp add:conditionF)+
apply (subgoal_tac " ievalF(f', l[=]Real 0, d', d')",auto)
apply (simp add:L_eval)
done

(*soundness for condition rule in case b is true,
  later it is used to prove the soundness of condition rule*)
lemma ConditionT_sound: "(ALL f1 d1 d2. evalF (last(f1(d1)),(p [-->] b))
        & Valid p P q G)
        --> Valid p (IF b P) q G"
apply (simp add:Imply_eval)
apply (simp add:Valid_def, auto)
apply (cut_tac f = f and be = b and d = d and P = P and f' = "f'" and d' = "d'" in conditionT, auto)
apply (blast)
apply (cut_tac f = f and be = b and d = d and P = P and f' = "f'" and d' = "d'" in conditionT, auto)
apply blast
done

(*soundness for condition rule*)
lemma Condition_sound: "(Valid (p [&] b) (IF b P) q G
        & Valid (p [&] ([~]b)) (IF b P) q G)
        --> Valid p (IF b P) q G"
apply (simp add:Valid_def, auto)
apply blast+
done

(*soundness for nondeterministic rule of real variable*)
lemma NondeterministicR_sound: "Valid (p [&] b) P q G
        --> Valid p (NON R x : b P) q G"
apply (simp add:Valid_def,auto)
apply (cut_tac f = f and d = d and b = b and x = x and P = P and f' = "f'" and d' = "d'" in nondeterR, auto)+
done

(*soundness for nondeterministic rule of string variable*)
lemma NondeterministicS_sound: "Valid (p [&] b) P q G
        --> Valid p (NON S x : b P) q G"
apply (simp add:Valid_def,auto)
apply (cut_tac f = f and d = d and b = b and x = x and P = P and f' = "f'" and d' = "d'" in nondeterS, auto)+
done

(*soundness for nondeterministic rule of bool variable*)
lemma NondeterministicB_sound: "Valid (p [&] b) P q G
        --> Valid p (NON B x : b P) q G"
apply (simp add:Valid_def,auto)
apply (cut_tac f = f and d = d and b = b and x = x and P = P and f' = "f'" and d' = "d'" in nondeterB, auto)+
done

(*soundness for communication rule of real variable, others are in the end of this file.*)
lemma CommR_sound: "(ValidP px py Px Py qx qy Hx Hy)
        --> ~inPairForm([(RVar x, e)], ry)
        --> (ALL f g d. EX F G Da Db. evalPP(Px||Py,f,g,d) = (Skip,F,G,Da,Db))
        --> (ALL f1 d1. evalF (last(f1(d1)),(qx [-->] rx) [&] (qy [-->] (substF ([(RVar(x), e)]) (ry)))))
        --> (ALL f1 d1 d2. ievalF (f1,((Hx [^] (high (qx))) [-->] Gx) [&] ((Hy [^] (high(qy))) [-->] Gy),d1,d2))
        --> (ALL f1 f2 d1 d2. (ievalF(f1,(Hx[^](high (qx))),d1,d2) & ievalF(f2,Hy[^](l[=]Real 0),d1,d2)) |
                (ievalF(f2,(Hy[^](high (qy))),d1,d2) & ievalF(f1,Hx,d1,d2)) -->
                (ievalF(f1,H,d1,d2) & ievalF(f2,H,d1,d2)))
        --> ValidP px py (Px;m;ch!!e) (Py;M;ch??(RVar(x))) rx ry (Gx[&]H) (Gy[&]H)"
apply (simp add:Imply_eval And_eval)
apply (unfold ValidP_def,auto)
(*Proving for the 1st postcondition*)
apply (subgoal_tac "EX F G Da Db. evalPP(Px||Py, f, g, d) = (Skip, F, G, Da, Db)")
prefer 2
apply simp
apply (erule exE)+
apply (subgoal_tac "evalF(last(F(Da)), qx) & evalF(last(G(Db)), qy) & ievalF(F, Hx, d, Da) & ievalF(G, Hy, d, Db)")
prefer 2
apply simp
apply (cut_tac Px=Px and Py=Py and f=f and g=g and d=d and ch=ch and e=e and x=x and
               F=F and G=G and Da=Da and Db=Db and m=m and M=M in communicationR,auto)
(*Proving for the 2nd postcondition*)
apply (subgoal_tac "EX F G Da Db. evalPP(Px||Py, f, g, d) = (Skip, F, G, Da, Db)")
prefer 2
apply simp
apply (erule exE)+
apply (subgoal_tac "evalF(last(F(Da)), qx) & evalF(last(G(Db)), qy) & ievalF(F, Hx, d, Da) & ievalF(G, Hy, d, Db)")
prefer 2
apply simp
apply (cut_tac Px=Px and Py=Py and f=f and g=g and d=d and ch=ch and e=e and x=x and
               F=F and G=G and Da=Da and Db=Db and m=m and M=M in communicationR,auto)
apply (case_tac "Db < Da",auto)
apply (cut_tac x = x and e = e and q = ry in substR,auto)
apply (subgoal_tac "evalF(last(G(Db)), substF([(RVar x, e)], ry))")
prefer 2
apply (subgoal_tac "evalF(last(G(Db)), qy) --> evalF(last(G(Db)), substF([(RVar x, e)], ry))",simp)
apply blast
apply (cut_tac x=x and e=e and q=ry in substR,auto)
(*Proving for the 1st history, it is a conjunction of two formulae Gx and H*)
(*Start to prove Gx*)
apply (subgoal_tac "EX F G Da Db. evalPP(Px||Py, f, g, d) = (Skip, F, G, Da, Db)")
prefer 2
apply simp
apply (erule exE)+
apply (simp add:And_eval Imply_eval)
apply (subgoal_tac "ievalF(f', Hx [^] high qx, d, d1)")
apply simp
prefer 2
apply (cut_tac Px=Px and Py=Py and f=f and g=g and d=d and ch=ch and e=e and x=x and
               F=F and G=G and Da=Da and Db=Db and m=m and M=M in communicationR,auto)
(*start for the 1st case "Da < Db"*)
apply (cut_tac f = "%t. if Da < t & t <= Db then [last(F(Da))] else F(t)" and
               P = Hx and Q = "high qx" and c = d and d = Db in chop_eval1, auto)
apply (cut_tac x=Da in exI,auto)
apply (subgoal_tac "ievalF(%t. if Da < t & t <= Db then [last(F(Da))] else F(t), Hx, d, Da)
             = ievalF(F,Hx,d,Da)",simp)
apply (subgoal_tac "evalPP(Px||Py, f, g, d) = (Skip, F, G, Da, Db) -->
             evalF(last(f(d)), px) --> evalF(last(g(d)), py) -->
             evalF(last(F(Da)), qx) & evalF(last(G(Db)), qy) & ievalF(F, Hx, d, Da) & ievalF(G, Hy, d, Db)",simp)
apply blast
apply (cut_tac c=d and d=Da and f="%t. if Da < t & t <= Db then [last(F(Da))] else F(t)" and
               g=F and P=Hx in chop_interval,auto)
apply (cut_tac f="%t. if Da < t & t <= Db then [last(F(Da))] else F(t)" and P=qx and c=Da and d=Db in high_eval,auto)
apply (subgoal_tac "evalPP(Px||Py, f, g, d) = (Skip, F, G, Da, Db) -->
             evalF(last(f(d)), px) --> evalF(last(g(d)), py) -->
             evalF(last(F(Da)), qx) & evalF(last(G(Db)), qy) & ievalF(F, Hx, d, Da) & ievalF(G, Hy, d, Db)",simp)
prefer 2
apply blast
apply (simp add: evalFP_def)
(*start for the 2nd case "Db < Da"*)
apply (cut_tac f = F and P = Hx and Q = "high qx" and c = d and d = Da in chop_eval1, auto)
apply (cut_tac x=Da in exI,auto)
apply (subgoal_tac "evalPP(Px||Py, f, g, d) = (Skip, F, G, Da, Db) -->
             evalF(last(f(d)), px) --> evalF(last(g(d)), py) -->
             evalF(last(F(Da)), qx) & evalF(last(G(Db)), qy) & ievalF(F, Hx, d, Da) & ievalF(G, Hy, d, Db)",simp)
apply blast
apply (simp add: high_eval,auto)
(*start for the 2nd case "Db = Da"*)
apply (cut_tac f = F and P = Hx and Q = "high qx" and c = d and d = Da in chop_eval1, auto)
apply (cut_tac x=Da in exI,auto)
apply blast
apply (subgoal_tac "evalPP(Px||Py, f, g, d) = (Skip, F, G, Da, Db) -->
             evalF(last(f(d)), px) --> evalF(last(g(d)), py) -->
             evalF(last(F(Da)), qx) & evalF(last(G(Db)), qy) & ievalF(F, Hx, d, Da) & ievalF(G, Hy, d, Db)",simp)
prefer 2
apply blast
apply (cut_tac f=F and P=qx and c=Da and d=Da in high_eval,auto) (*end for Gx*)
(*For proving H, we first prove "(Hy[^] high (qy))"*)
apply (subgoal_tac "ievalF(g', (Hy [^] high(qy)), d, d1)")
prefer 2
apply (cut_tac Px=Px and Py=Py and f=f and g=g and d=d and ch=ch and e=e and x=x and
               F=F and G=G and Da=Da and Db=Db and m=m and M=M in communicationR,auto) (*1*)
(*start for the 1st case "Db < Da"*)
apply (cut_tac f = "%t. if t = Da
                      then [last(G(Db)),
                            %y i. if y = x & i = R then evalE(last(G(Db)), e) else last(G(Db), y, i)]
                      else if t < Da & Db < t then [last(G(Db))] else G(t)" and P = Hy and Q = "high qy" and
               c = d and d = Da in chop_eval1, auto)
apply (cut_tac x=Db in exI,auto) (*1a*)
apply (subgoal_tac "ievalF(%t. if t = Da
                      then [last(G(Db)),
                            %y i. if y = x & i = R then evalE(last(G(Db)), e) else last(G(Db), y, i)]
                      else if t < Da & Db < t then [last(G(Db))] else G(t),Hy, d, Db)
             = ievalF(G,Hy,d,Db)",simp)
apply (subgoal_tac "evalPP(Px||Py, f, g, d) = (Skip, F, G, Da, Db) -->
             evalF(last(f(d)), px) --> evalF(last(g(d)), py) -->
             evalF(last(F(Da)), qx) & evalF(last(G(Db)), qy) & ievalF(F, Hx, d, Da) & ievalF(G, Hy, d, Db)",simp)
apply blast
apply (cut_tac c=d and d=Db and f="%t. if t = Da
                      then [last(G(Db)),
                            %y i. if y = x & i = R then evalE(last(G(Db)), e) else last(G(Db), y, i)]
                      else if t < Da & Db < t then [last(G(Db))] else G(t)" and
               g=G and P=Hy in chop_interval,simp)
apply (cut_tac f = "%t. if t = Db then []
                      else if t = Da
                           then [last(G(Db)),
                                 %y i. if y = x & i = R then evalE(last(G(Db)), e) else last(G(Db), y, i)]
                           else if t < Da & Db < t then [last(G(Db))] else G(t)" and P = "high qy" and
               Q = "l [=] Real 0" and c = Db and d = Da in chop_eval,simp)
apply (cut_tac f="%t. if t = Da
                      then [last(G(Db)),
                            %y i. if y = x & i = R then evalE(last(G(Db)), e) else last(G(Db), y, i)]
                      else if t < Da & Db < t then [last(G(Db))] else G(t)" and
               P=qy and c=Db and d=Da in high_eval,auto)
apply (simp add: evalFP_def)
apply (subgoal_tac "evalPP(Px||Py, f, g, d) = (Skip, F, G, Da, Db) -->
             evalF(last(f(d)), px) --> evalF(last(g(d)), py) -->
             evalF(last(F(Da)), qx) & evalF(last(G(Db)), qy) & ievalF(F, Hx, d, Da) & ievalF(G, Hy, d, Db)",simp)
apply blast
(*start for the 2nd case "Db >= Da"*)
apply (simp add: chop_eval)
apply (cut_tac x=Db in exI,auto)
apply (cut_tac x="G(Db)" in exI,auto)
apply (cut_tac c=d and d=Db and f="%t. if t = Db then G(Db)
                      else if t = Db
                           then G(Db) @
                                [%y i. if y = x & i = R then evalE(last(G(Db)), e) else last(G(Db), y, i)]
                           else G(t)" and
               g=G and P=Hy in chop_interval,auto)
apply (subgoal_tac "evalPP(Px||Py, f, g, d) = (Skip, F, G, Da, Db) -->
             evalF(last(f(d)), px) --> evalF(last(g(d)), py) -->
             evalF(last(F(Da)), qx) & evalF(last(G(Db)), qy) & ievalF(F, Hx, d, Da) & ievalF(G, Hy, d, Db)",simp)
apply blast
apply (cut_tac f="%t. if t = Db
                      then [%y i. if y = x & i = R then evalE(last(G(Db)), e) else last(G(Db), y, i)]
                      else if t = Db
                           then G(Db) @
                                [%y i. if y = x & i = R then evalE(last(G(Db)), e) else last(G(Db), y, i)]
                           else G(t)" and P=qy and c=Db and d=Db in high_eval,auto)
(*start for H*)
apply (subgoal_tac "ievalF(g', Hy[^](l[=]Real 0), d, d1) | ievalF(f', Hx, d, d1)",auto)
apply (cut_tac Px=Px and Py=Py and f=f and g=g and d=d and ch=ch and e=e and x=x and
               F=F and G=G and Da=Da and Db=Db and m=m and M=M in communicationR,auto)
(*start for the 1st case Db < Da*)
apply (subgoal_tac "ievalF(F, Hx, d, Da)")
apply blast
apply (subgoal_tac "evalPP(Px||Py, f, g, d) = (Skip, F, G, Da, Db) -->
             evalF(last(f(d)), px) --> evalF(last(g(d)), py) -->
             evalF(last(F(Da)), qx) & evalF(last(G(Db)), qy) & ievalF(F, Hx, d, Da) & ievalF(G, Hy, d, Db)",simp)
apply blast
(*start for the 2nd case Db >= Da*)
apply (case_tac "d=Db",auto) (*2a*)
apply (simp add: chop_eval)
apply (cut_tac x=Db in exI,auto)
apply (cut_tac x="G(Db)" in exI,auto)
apply (cut_tac c=Db and d=Db and f="%t. if t = Db then G(Db)
                      else if t = Db
                           then G(Db) @
                                [%y i. if y = x & i = R then evalE(last(G(Db)), e) else last(G(Db), y, i)]
                           else G(t)" and
               g=G and P=Hy in chop_interval,auto)
apply (subgoal_tac "evalPP(Px||Py, f, g, Db) = (Skip, F, G, Da, Db) -->
             evalF(last(f(Db)), px) --> evalF(last(g(Db)), py) -->
             evalF(last(F(Da)), qx) & evalF(last(G(Db)), qy) & ievalF(F, Hx, Db, Da) & ievalF(G, Hy, Db, Db)",simp)
apply blast
apply (cut_tac L=0 in L_eval,auto) (*2b*)
apply (cut_tac f = "%t. if t = Db
                      then G(Db) @
                           [%y i. if y = x & i = R then evalE(last(G(Db)), e) else last(G(Db), y, i)]
                      else G(t)" and P = Hy and Q = "l [=] Real 0" and c = d and d = Db in chop_eval, auto)
apply (cut_tac x=Db in exI,auto)
apply (cut_tac x="G(Db)" in exI,auto)
apply (subgoal_tac "evalPP(Px||Py, f, g, d) = (Skip, F, G, Da, Db) -->
             evalF(last(f(d)), px) --> evalF(last(g(d)), py) -->
             evalF(last(F(Da)), qx) & evalF(last(G(Db)), qy) & ievalF(F, Hx, d, Da) & ievalF(G, Hy, d, Db)",simp)
prefer 2
apply blast
apply (cut_tac c=d and d=Db and f="%t. if t = Db then G(Db)
                      else if t = Db
                           then G(Db) @
                                [%y i. if y = x & i = R then evalE(last(G(Db)), e) else last(G(Db), y, i)]
                           else G(t)" and
               g=G and P=Hy in chop_interval,auto)
apply (cut_tac L=0 in L_eval,auto)
apply (cut_tac x=Db in exI,auto)
apply (cut_tac x="G(Db)" in exI,auto)
apply (subgoal_tac "evalPP(Px||Py, f, g, d) = (Skip, F, G, Da, Db) -->
             evalF(last(f(d)), px) --> evalF(last(g(d)), py) -->
             evalF(last(F(Da)), qx) & evalF(last(G(Db)), qy) & ievalF(F, Hx, d, Da) & ievalF(G, Hy, d, Db)",simp)
prefer 2
apply blast
apply (cut_tac c=d and d=Db and f="%t. if t = Db then G(Db)
                      else if t = Db
                           then G(Db) @
                                [%y i. if y = x & i = R then evalE(last(G(Db)), e) else last(G(Db), y, i)]
                           else G(t)" and
               g=G and P=Hy in chop_interval,auto)
apply (cut_tac L=0 in L_eval,auto)
(*Proving for the 1st history, it is a conjunction of two formulae Gx and H*)
(*Start to prove Gx*)
apply (subgoal_tac "EX F G Da Db. evalPP(Px||Py, f, g, d) = (Skip, F, G, Da, Db)")
prefer 2
apply simp
apply (erule exE)+
apply (simp add:And_eval Imply_eval)
apply (subgoal_tac "ievalF(g', (Hy [^] high(qy)), d, d2)")
prefer 2
apply (cut_tac Px=Px and Py=Py and f=f and g=g and d=d and ch=ch and e=e and x=x and
               F=F and G=G and Da=Da and Db=Db and m=m and M=M in communicationR,auto) (*1*)
(*start for the 1st case "Db < Da"*)
apply (cut_tac f = "%t. if t = Da
                      then [last(G(Db)),
                            %y i. if y = x & i = R then evalE(last(G(Db)), e) else last(G(Db), y, i)]
                      else if t < Da & Db < t then [last(G(Db))] else G(t)" and P = Hy and Q = "high qy" and
               c = d and d = Da in chop_eval1, auto)
apply (cut_tac x=Db in exI,auto) (*1a*)
apply (subgoal_tac "ievalF(%t. if t = Da
                      then [last(G(Db)),
                            %y i. if y = x & i = R then evalE(last(G(Db)), e) else last(G(Db), y, i)]
                      else if t < Da & Db < t then [last(G(Db))] else G(t),Hy, d, Db)
             = ievalF(G,Hy,d,Db)",simp)
apply (subgoal_tac "evalPP(Px||Py, f, g, d) = (Skip, F, G, Da, Db) -->
             evalF(last(f(d)), px) --> evalF(last(g(d)), py) -->
             evalF(last(F(Da)), qx) & evalF(last(G(Db)), qy) & ievalF(F, Hx, d, Da) & ievalF(G, Hy, d, Db)",simp)
apply blast
apply (cut_tac c=d and d=Db and f="%t. if t = Da
                      then [last(G(Db)),
                            %y i. if y = x & i = R then evalE(last(G(Db)), e) else last(G(Db), y, i)]
                      else if t < Da & Db < t then [last(G(Db))] else G(t)" and
               g=G and P=Hy in chop_interval,simp)
apply (cut_tac f = "%t. if t = Db then []
                      else if t = Da
                           then [last(G(Db)),
                                 %y i. if y = x & i = R then evalE(last(G(Db)), e) else last(G(Db), y, i)]
                           else if t < Da & Db < t then [last(G(Db))] else G(t)" and P = "high qy" and
               Q = "l [=] Real 0" and c = Db and d = Da in chop_eval,simp)
apply (cut_tac f="%t. if t = Da
                      then [last(G(Db)),
                            %y i. if y = x & i = R then evalE(last(G(Db)), e) else last(G(Db), y, i)]
                      else if t < Da & Db < t then [last(G(Db))] else G(t)" and
               P=qy and c=Db and d=Da in high_eval,auto)
apply (simp add: evalFP_def)
apply (subgoal_tac "evalPP(Px||Py, f, g, d) = (Skip, F, G, Da, Db) -->
             evalF(last(f(d)), px) --> evalF(last(g(d)), py) -->
             evalF(last(F(Da)), qx) & evalF(last(G(Db)), qy) & ievalF(F, Hx, d, Da) & ievalF(G, Hy, d, Db)",simp)
apply blast
(*start for the 2nd case "Db >= Da"*)
apply (simp add: chop_eval)
apply (cut_tac x=Db in exI,auto)
apply (cut_tac x="G(Db)" in exI,auto)
apply (cut_tac c=d and d=Db and f="%t. if t = Db then G(Db)
                      else if t = Db
                           then G(Db) @
                                [%y i. if y = x & i = R then evalE(last(G(Db)), e) else last(G(Db), y, i)]
                           else G(t)" and
               g=G and P=Hy in chop_interval,auto)
apply (subgoal_tac "evalPP(Px||Py, f, g, d) = (Skip, F, G, Da, Db) -->
             evalF(last(f(d)), px) --> evalF(last(g(d)), py) -->
             evalF(last(F(Da)), qx) & evalF(last(G(Db)), qy) & ievalF(F, Hx, d, Da) & ievalF(G, Hy, d, Db)",simp)
apply blast
apply (cut_tac f="%t. if t = Db
                      then [%y i. if y = x & i = R then evalE(last(G(Db)), e) else last(G(Db), y, i)]
                      else if t = Db
                           then G(Db) @
                                [%y i. if y = x & i = R then evalE(last(G(Db)), e) else last(G(Db), y, i)]
                           else G(t)" and P=qy and c=Db and d=Db in high_eval,auto)
(*For proving H, we first prove "(Hx[^] high (qx))"*)
apply (subgoal_tac "ievalF(f', Hx [^] high qx, d, d2)")
prefer 2
apply (cut_tac Px=Px and Py=Py and f=f and g=g and d=d and ch=ch and e=e and x=x and
               F=F and G=G and Da=Da and Db=Db and m=m and M=M in communicationR,auto)
(*start for the 1st case "Da < Db"*)
apply (cut_tac f = "%t. if Da < t & t <= Db then [last(F(Da))] else F(t)" and
               P = Hx and Q = "high qx" and c = d and d = Db in chop_eval1, auto)
apply (cut_tac x=Da in exI,auto)
apply (subgoal_tac "ievalF(%t. if Da < t & t <= Db then [last(F(Da))] else F(t), Hx, d, Da)
             = ievalF(F,Hx,d,Da)",simp)
apply (subgoal_tac "evalPP(Px||Py, f, g, d) = (Skip, F, G, Da, Db) -->
             evalF(last(f(d)), px) --> evalF(last(g(d)), py) -->
             evalF(last(F(Da)), qx) & evalF(last(G(Db)), qy) & ievalF(F, Hx, d, Da) & ievalF(G, Hy, d, Db)",simp)
apply blast
apply (cut_tac c=d and d=Da and f="%t. if Da < t & t <= Db then [last(F(Da))] else F(t)" and
               g=F and P=Hx in chop_interval,auto)
apply (cut_tac f="%t. if Da < t & t <= Db then [last(F(Da))] else F(t)" and P=qx and c=Da and d=Db in high_eval,auto)
apply (subgoal_tac "evalPP(Px||Py, f, g, d) = (Skip, F, G, Da, Db) -->
             evalF(last(f(d)), px) --> evalF(last(g(d)), py) -->
             evalF(last(F(Da)), qx) & evalF(last(G(Db)), qy) & ievalF(F, Hx, d, Da) & ievalF(G, Hy, d, Db)",simp)
prefer 2
apply blast
apply (simp add: evalFP_def)
(*start for the 2nd case "Db < Da"*)
apply (cut_tac f = F and P = Hx and Q = "high qx" and c = d and d = Da in chop_eval1, auto)
apply (cut_tac x=Da in exI,auto)
apply (subgoal_tac "evalPP(Px||Py, f, g, d) = (Skip, F, G, Da, Db) -->
             evalF(last(f(d)), px) --> evalF(last(g(d)), py) -->
             evalF(last(F(Da)), qx) & evalF(last(G(Db)), qy) & ievalF(F, Hx, d, Da) & ievalF(G, Hy, d, Db)",simp)
apply blast
apply (simp add: high_eval,auto)
(*start for the 2nd case "Db = Da"*)
apply (cut_tac f = F and P = Hx and Q = "high qx" and c = d and d = Da in chop_eval1, auto)
apply (cut_tac x=Da in exI,auto)
apply blast
apply (subgoal_tac "evalPP(Px||Py, f, g, d) = (Skip, F, G, Da, Db) -->
             evalF(last(f(d)), px) --> evalF(last(g(d)), py) -->
             evalF(last(F(Da)), qx) & evalF(last(G(Db)), qy) & ievalF(F, Hx, d, Da) & ievalF(G, Hy, d, Db)",simp)
prefer 2
apply blast
apply (cut_tac f=F and P=qx and c=Da and d=Da in high_eval,auto) (*end for Gx*)
(*start for H*)
apply (subgoal_tac "ievalF(g', Hy[^](l[=]Real 0), d, d2) | ievalF(f', Hx, d, d2)",auto)
apply (cut_tac Px=Px and Py=Py and f=f and g=g and d=d and ch=ch and e=e and x=x and
               F=F and G=G and Da=Da and Db=Db and m=m and M=M in communicationR,auto)
(*start for the 1st case Db < Da*)
apply (subgoal_tac "ievalF(F, Hx, d, Da)")
apply blast
apply (subgoal_tac "evalPP(Px||Py, f, g, d) = (Skip, F, G, Da, Db) -->
             evalF(last(f(d)), px) --> evalF(last(g(d)), py) -->
             evalF(last(F(Da)), qx) & evalF(last(G(Db)), qy) & ievalF(F, Hx, d, Da) & ievalF(G, Hy, d, Db)",simp)
apply blast
(*start for the 2nd case Db >= Da*)
apply (case_tac "d=Db",auto) (*2a*)
apply (simp add: chop_eval)
apply (cut_tac x=Db in exI,auto)
apply (cut_tac x="G(Db)" in exI,auto)
apply (cut_tac c=Db and d=Db and f="%t. if t = Db then G(Db)
                      else if t = Db
                           then G(Db) @
                                [%y i. if y = x & i = R then evalE(last(G(Db)), e) else last(G(Db), y, i)]
                           else G(t)" and
               g=G and P=Hy in chop_interval,auto)
apply (subgoal_tac "evalPP(Px||Py, f, g, Db) = (Skip, F, G, Da, Db) -->
             evalF(last(f(Db)), px) --> evalF(last(g(Db)), py) -->
             evalF(last(F(Da)), qx) & evalF(last(G(Db)), qy) & ievalF(F, Hx, Db, Da) & ievalF(G, Hy, Db, Db)",simp)
apply blast
apply (cut_tac L=0 in L_eval,auto) (*2b*)
apply (cut_tac f = "%t. if t = Db
                      then G(Db) @
                           [%y i. if y = x & i = R then evalE(last(G(Db)), e) else last(G(Db), y, i)]
                      else G(t)" and P = Hy and Q = "l [=] Real 0" and c = d and d = Db in chop_eval, auto)
apply (cut_tac x=Db in exI,auto)
apply (cut_tac x="G(Db)" in exI,auto)
apply (subgoal_tac "evalPP(Px||Py, f, g, d) = (Skip, F, G, Da, Db) -->
             evalF(last(f(d)), px) --> evalF(last(g(d)), py) -->
             evalF(last(F(Da)), qx) & evalF(last(G(Db)), qy) & ievalF(F, Hx, d, Da) & ievalF(G, Hy, d, Db)",simp)
prefer 2
apply blast
apply (cut_tac c=d and d=Db and f="%t. if t = Db then G(Db)
                      else if t = Db
                           then G(Db) @
                                [%y i. if y = x & i = R then evalE(last(G(Db)), e) else last(G(Db), y, i)]
                           else G(t)" and
               g=G and P=Hy in chop_interval,auto)
apply (cut_tac L=0 in L_eval,auto)
apply (cut_tac x=Db in exI,auto)
apply (cut_tac x="G(Db)" in exI,auto)
apply (subgoal_tac "evalPP(Px||Py, f, g, d) = (Skip, F, G, Da, Db) -->
             evalF(last(f(d)), px) --> evalF(last(g(d)), py) -->
             evalF(last(F(Da)), qx) & evalF(last(G(Db)), qy) & ievalF(F, Hx, d, Da) & ievalF(G, Hy, d, Db)",simp)
prefer 2
apply blast
apply (cut_tac c=d and d=Db and f="%t. if t = Db then G(Db)
                      else if t = Db
                           then G(Db) @
                                [%y i. if y = x & i = R then evalE(last(G(Db)), e) else last(G(Db), y, i)]
                           else G(t)" and
               g=G and P=Hy in chop_interval,auto)
apply (cut_tac L=0 in L_eval,auto)
done

(*soundness for 1st paralle rule*)
lemma Parallel1_sound: "ValidP px py Px Py qx qy Hx Hy
        --> Valid qx Qx rx Gx
        --> Valid qy Qy ry Gy
        --> ValidP px py (Px; m; Qx) (Py; M; Qy) rx ry (Hx [^] Gx) (Hy [^] Gy)"
apply (simp add: ValidP_def Valid_def)
apply auto
(*1st*)
apply (cut_tac Px=Px and Py=Py and Qx=Qx and Qy=Qy and f=f and g=g and d=d and f'=f' and
               g'=g' and d'=d1 and D'=d2 and f''=f'' and g''=g'' and d''=d'' and D''=D'' and
               m=m and M=M in parallelN2,auto)
apply (subgoal_tac "evalP(Qx, f'', d'') = (Skip, f', d1) --> evalF(last(f''(d'')), qx) --> evalF(last(f'(d1)), rx)")
apply blast
apply auto
(*2nd*)
apply (cut_tac Px=Px and Py=Py and Qx=Qx and Qy=Qy and f=f and g=g and d=d and f'=f' and
               g'=g' and d'=d1 and D'=d2 and f''=f'' and g''=g'' and d''=d'' and D''=D'' and
               m=m and M=M in parallelN2,auto)
apply (subgoal_tac "evalP(Qy, f'', d'') = (Skip, g', d2) --> evalF(last(f''(d'')), qy) --> evalF(last(g'(d2)), ry)")
apply blast
apply auto
(*3rd*)
apply (cut_tac Px=Px and Py=Py and Qx=Qx and Qy=Qy and f=f and g=g and d=d and f'=f' and
               g'=g' and d'=d1 and D'=d2 and f''=f'' and g''=g'' and d''=d'' and D''=D'' and
               m=m and M=M in parallelN2,auto)
apply (subgoal_tac "ievalF(f', Hx, d, d'') & ievalF(f', Gx, d'', d1)",auto)
apply (cut_tac f=f' and P=Hx and Q=Gx and c=d and d=d1 in chop_eval1,auto)
apply (subgoal_tac "evalPP(Px||Py, f, g, d) = (Skip, f'', g'', d'', D'') -->
             evalF(last(f(d)), px) --> evalF(last(g(d)), py) --> ievalF(f'', Hx, d, d'')")
apply blast
apply auto
apply (subgoal_tac "evalP(Qx, f'', d'') = (Skip, f', d1) -->
             evalF(last(f''(d'')), qx) --> evalF(last(f'(d1)), rx) & ievalF(f', Gx, d'', d1)")
apply blast
apply auto
(*4th*)
apply (cut_tac Px=Px and Py=Py and Qx=Qx and Qy=Qy and f=f and g=g and d=d and f'=f' and
               g'=g' and d'=d1 and D'=d2 and f''=f'' and g''=g'' and d''=d'' and D''=D'' and
               m=m and M=M and H=Hx and G=Hy in parallelN2,auto)
apply (subgoal_tac "ievalF(g', Hy, d, D'') & ievalF(g', Gy, D'', d2)",auto)
apply (cut_tac f=g' and P=Hy and Q=Gy and c=d and d=d2 in chop_eval1,auto)
apply (subgoal_tac "evalPP(Px||Py, f, g, d) = (Skip, f'', g'', d'', D'') -->
             evalF(last(f(d)), px) --> evalF(last(g(d)), py) --> ievalF(g'', Hy, d, D'')")
apply blast
apply auto
apply (subgoal_tac "evalP(Qy, g'', D'') = (Skip, g', d2) -->
             evalF(last(g''(D'')), qy) --> evalF(last(g'(d2)), ry) & ievalF(g', Gy, D'', d2)")
apply blast
apply auto
done

(*soundness for 2nd paralle rule*)
lemma Parallel2_sound: "Valid px Px qx Hx
        --> Valid py Py qy Hy
        --> ValidP px py Px Py qx qy Hx Hy"
apply (simp add: ValidP_def Valid_def)
apply auto
apply (cut_tac P=Px and Q=Py and d'="d1" and d''=d2 in parallelN1,auto)
apply (cut_tac P=Px and Q=Py and f=f and g=g and d=d and f'="f'" and g'=g'
           and d'="d1" and d''=d2 in parallelN1,auto)
apply (subgoal_tac "evalP(Py, g, d) = (Skip, g', d2) --> evalF(last(g(d)), py) --> evalF(last(g'(d2)), qy) & ievalF(g', Hy, d, d2)")
apply blast
apply auto
apply (cut_tac P=Px and Q=Py and d'="d1" and d''=d2 in parallelN1,auto)
apply (cut_tac P=Px and Q=Py and f=f and g=g and d=d and f'="f'" and g'=g'
           and d'="d1" and d''=d2 in parallelN1,auto)
apply (subgoal_tac "evalP(Py, g, d) = (Skip, g', d2) --> evalF(last(g(d)), py) --> evalF(last(g'(d2)), qy) & ievalF(g', Hy, d, d2)")
apply blast
apply auto
done

(*assists for proving the soundness of repetition rule*)
lemma Repetition_assist1: "[| ALL f1 d1 d2. ievalF(f1, Hx [^] Hx, d1, d2) --> ievalF(f1, Hx, d1, d2);
          ievalF(F(Suc(na)), l [=] Real 0 [|] Hx, D(0), D(na)) &
          ievalF(F(Suc(na)), l [=] Real 0 [|] Hx, D(na), D(Suc(na))) |]
            ==> ievalF(F(Suc(na)), l [=] Real 0 [|] Hx, D(0), D(Suc(na)))"
apply (simp add: Or_eval L_eval,auto)
apply (subgoal_tac "ievalF(F(Suc(na)), Hx [^] Hx, D(0), D(Suc(na))) --> ievalF(F(Suc(na)), Hx, D(0), D(Suc(na)))",auto)
apply (subgoal_tac "ievalF(F(Suc(na)), Hx [^] Hx, D(0), D(Suc(na)))",simp)
apply (rule chop_eval1,auto)
done

(*soundness for repetition rule*)
lemma Repetition_sound: "Valid px Px px Hx
        --> (ALL f1 d1 d2. ievalF (f1,(Hx [^] Hx [-->] Hx),d1,d2))
        --> Valid px (Px*) px ((l [=] Real 0) [|] Hx)"
apply (simp add: Imply_eval)
apply (unfold Valid_def,auto)
(*1st*)
apply (cut_tac P = Px and f = f and d = d and f' = "f'" and d' = "d'" and F=F and D=D and
               H = "l [=] Real 0 [|] Hx" in repetition,auto)
apply (subgoal_tac "(ALL k<n. evalP(Px, F(k), D(k)) = (Skip, F(Suc(k)), D(Suc(k)))) --> evalF(last(F(n)(D(n))), px)")
apply blast
apply (induct_tac n,auto)
(*2nd*)
apply (cut_tac P = Px and f = f and d = d and f' = "f'" and d' = "d'" and F=F and D=D and
               H = "l [=] Real 0 [|] Hx" in repetition,auto)
apply (subgoal_tac "(ALL k<n. evalP(Px, F(k), D(k)) = (Skip, F(Suc(k)), D(Suc(k))) &
                    (ievalF(F(k), l [=] Real 0 [|] Hx, D(0), D(k)) -->
                    ievalF(F(Suc(k)), l [=] Real 0 [|] Hx, D(0), D(k))))
                      --> evalF(last(F(n)(D(n))), px) & ievalF(F(n), l [=] Real 0 [|] Hx, D(0), D(n))")
apply blast
apply (induct_tac n,auto)
apply (simp add: Or_eval,auto)
apply (cut_tac f="F(0)" and L=0 and c="D(0)" and d="D(0)" in L_eval,auto)
apply (subgoal_tac "ievalF(F(Suc(na)), l [=] Real 0 [|] Hx, D(0), D(na)) &
               ievalF(F(Suc(na)), l [=] Real 0 [|] Hx, D(na), D(Suc(na)))")
apply (rule Repetition_assist1,auto)
apply (subgoal_tac "ievalF(F(Suc(na)), Hx, D(na), D(Suc(na)))")
apply (cut_tac f="F(Suc(na))" and F="l [=] Real 0" and G="Hx" and c="D(na)" and d="D(Suc(na))" in Or_eval,auto)
  done
  sorry

end


theory nanoCoP2 imports Main
begin

primrec member where
  \<open>member _ [] = False\<close> |
  \<open>member m (n # A) = (m = n \<or> member m A)\<close>

lemma member_iff [iff]: \<open>member m A \<longleftrightarrow> m \<in> set A\<close>
  by (induct A) simp_all

primrec common where
  \<open>common _ [] = False\<close> |
  \<open>common A (m # B) = (member m A \<or> common A B)\<close>

lemma common_iff [iff]: \<open>common A B \<longleftrightarrow> set A \<inter> set B \<noteq> {}\<close>
  by (induct B) simp_all

datatype ('a) clause_elem
  = LitM "bool" 'a
  | Matrix "'a matrix_elem list"
and ('a) matrix_elem
  = LitC "bool" 'a
  | Clause \<open>'a clause_elem list\<close>

fun ext where
  \<open>ext ys [] = True\<close> |
  \<open>ext ys (x # xs) = (member x ys \<and> ext ys xs)\<close>

lemma ext_iff: \<open>ext ys xs \<longleftrightarrow> (\<forall> x \<in> set xs. x \<in> set ys)\<close>
  by (induct xs) auto

abbreviation \<open>perm xs ys \<equiv> ext xs ys \<and> ext ys xs\<close>

lemma perm_iff [iff]: \<open>perm xs ys \<longleftrightarrow> set xs = set ys\<close>
  using ext_iff by (induct xs) auto

(*LitC rules and PathAxiom are necessary because of the way we define the path semantics*)
inductive nanoCoP where
  Axiom:
    \<open>nanoCoP (Clause [] # Mat) Path\<close> |
  PathAxiom:
    \<open>nanoCoP Mat Path\<close> if
    \<open>member (True,prp) Path\<close> and
    \<open>member (False,prp) Path\<close>|
  ExtMat:
    \<open>nanoCoP Mat2 Path\<close> if
    \<open>ext Mat2 Mat1\<close> and
    \<open>nanoCoP Mat1 Path\<close> |
  ExtCls:
    \<open>nanoCoP (Clause Cls2 # Mat) Path\<close> if
    \<open>ext Cls1 Cls2\<close> and
    \<open>nanoCoP (Clause Cls1 # Mat) Path\<close> |
  ExtensionLit:
    \<open>nanoCoP (Clause (LitM pol prp # Cls) # Mat) Path\<close> if
    \<open>nanoCoP Mat ((pol, prp) # Path)\<close> and
    \<open>nanoCoP (Clause Cls # Mat) Path\<close> |
  ExtensionLitC:
    \<open>nanoCoP (LitC pol prp # Mat) Path\<close> if
    \<open>nanoCoP Mat ((pol, prp) # Path)\<close> |
  ExtensionMat:
    \<open>nanoCoP (Clause (Matrix mat # Cls) # Mat) Path\<close> if
    \<open>nanoCoP (mat @ Mat) Path\<close> and
    \<open>nanoCoP (Clause Cls # Mat) Path\<close>

lemma ReductionLit:
  \<open>nanoCoP (Clause (LitM pol prp # Cls) # Mat) Path\<close> if
  \<open>member (\<not>pol, prp) Path\<close> and
  \<open>nanoCoP (Clause Cls # Mat) Path\<close>
  by (smt (verit, best) ExtensionLit PathAxiom nanoCoP2.member.simps(2) that(1) that(2))

lemma ReductionLitC:
  \<open>nanoCoP (LitC pol prp # Mat) Path\<close> if
  \<open>member (\<not>pol, prp) Path\<close>
  by (smt (verit) ExtensionLitC PathAxiom nanoCoP2.member.simps(2) that)

(*Example proofs*)
context begin
private datatype props = P | Q | R

private lemma \<open>nanoCoP
  [
    Clause [Matrix [LitC True P]],
    Clause [Matrix [LitC False P]]
  ]
  []\<close>
proof-
  have \<open>nanoCoP
  [
    Clause [Matrix [LitC False P]],
    LitC True P
  ]
  []\<close> by (simp add: ExtensionLitC ReductionLitC Axiom ExtensionMat)
  then have \<open>nanoCoP
  [
    LitC True P,
    Clause [Matrix [LitC False P]]
  ]
  []\<close> using ExtMat by force
  then show ?thesis
    by (simp add: Axiom ExtensionMat)
qed

(*Way more steps are required than in the original
Part of this is because of the replacement with beta-clauses, which is a permissible rule*)
private lemma \<open>nanoCoP
  [
    Clause [LitM False P],
    Clause [
      Matrix [Clause [LitM True P],Clause [LitM False Q]],
      Matrix [Clause [LitM True Q],Clause [LitM False Q,LitM True R],Clause [LitM False R]]
    ],
    Clause [LitM True Q]
  ]
  []\<close>
proof-
  from ExtensionLit have ?thesis if \<open>nanoCoP
    [
      Clause [
        Matrix [Clause [LitM True P],Clause [LitM False Q]],
        Matrix [Clause [LitM True Q],Clause [LitM False Q,LitM True R],Clause [LitM False R]]
      ],
      Clause [LitM True Q]
    ]
  [(False, P)]\<close> and \<open>nanoCoP
    [
      Clause [],
      Clause [
        Matrix [Clause [LitM True P],Clause [LitM False Q]],
        Matrix [Clause [LitM True Q],Clause [LitM False Q,LitM True R],Clause [LitM False R]]
      ],
      Clause [LitM True Q]
    ]
  []\<close> using that by fast
  with Axiom have ?thesis if \<open>nanoCoP
    [
      Clause [
        Matrix [Clause [LitM True P],Clause [LitM False Q]],
        Matrix [Clause [LitM True Q],Clause [LitM False Q,LitM True R],Clause [LitM False R]]
      ],
      Clause [LitM True Q]
    ]
  [(False, P)]\<close> using that by fast
  with ExtensionMat have ?thesis if \<open>nanoCoP
    [Clause [LitM True P],Clause [LitM False Q],Clause [LitM True Q]]
    [(False, P)]\<close> and \<open>nanoCoP
    [
      Clause [
        Matrix [Clause [LitM True Q],Clause [LitM False Q,LitM True R],Clause [LitM False R]]
      ],
      Clause [LitM True Q]
    ]
  [(False, P)]\<close> using that by (metis append.left_neutral append_Cons)
  with ExtensionMat have ?thesis if \<open>nanoCoP
    [Clause [LitM True P],Clause [LitM False Q],Clause [LitM True Q]]
    [(False, P)]\<close> and \<open>nanoCoP
    [
      Clause [LitM True Q],
      Clause [LitM False Q,LitM True R],
      Clause [LitM False R],
      Clause [LitM True Q]]
    [(False, P)]\<close> and \<open>nanoCoP
    [
      Clause [],
      Clause [LitM True Q]]
  [(False, P)]\<close> using that by (metis append.left_neutral append_Cons)
  with ReductionLit have ?thesis if \<open>nanoCoP
    [
      Clause [],Clause [LitM False Q],Clause [LitM True Q]]
    [(False, P)]\<close> and \<open>nanoCoP
    [
      Clause [LitM True Q],
      Clause [LitM False Q,LitM True R],
      Clause [LitM False R],
      Clause [LitM True Q]]
    [(False, P)]\<close> and \<open>nanoCoP
    [
      Clause [],
      Clause [LitM True Q]]
  [(False, P)]\<close> using that by (smt (verit, best) member.simps(2))
  with Axiom have ?thesis if \<open>nanoCoP
    [
      Clause [LitM True Q],
      Clause [LitM False Q,LitM True R],
      Clause [LitM False R],
      Clause [LitM True Q]]
    [(False, P)]\<close> using that by fast
  with ExtensionLit have ?thesis if \<open>nanoCoP
    [Clause [LitM False Q,LitM True R],Clause [LitM False R],Clause [LitM True Q]]
  [(True, Q),(False, P)]\<close> and \<open>nanoCoP
    [Clause [],Clause [LitM False Q,LitM True R],Clause [LitM False R],Clause [LitM True Q]]
  [(False, P)]\<close> using that by fast
  with Axiom have ?thesis if \<open>nanoCoP
    [Clause [LitM False Q,LitM True R],Clause [LitM False R],Clause [LitM True Q]]
  [(True, Q),(False, P)]\<close> using that by fast
  with ReductionLit have ?thesis if \<open>nanoCoP
    [Clause [LitM True R],Clause [LitM False R],Clause [LitM True Q]]
  [(True, Q),(False, P)]\<close> using that member.simps(2) by (smt (verit, best))
  with ExtensionLit have ?thesis if \<open>nanoCoP
    [Clause [LitM False R],Clause [LitM True Q]]
  [(True, R),(True, Q),(False, P)]\<close> and \<open>nanoCoP
    [Clause [],Clause [LitM False R],Clause [LitM True Q]]
  [(True, Q),(False, P)]\<close> using that by fastforce
  with ReductionLit have ?thesis if \<open>nanoCoP
    [Clause [],Clause [LitM True Q]]
  [(True, R),(True, Q),(False, P)]\<close> and \<open>nanoCoP
    [Clause [],Clause [LitM False R],Clause [LitM True Q]]
  [(True, Q), (False, P)]\<close> using that member.simps(2) by (smt (verit, best))
  with Axiom show ?thesis by fast
qed

(*could also be done with sledgehammer:*)
private lemma \<open>nanoCoP
  [
    Clause [LitM False P],
    Clause [
      Matrix [Clause [LitM True P],Clause [LitM False Q]],
      Matrix [Clause [LitM True Q],Clause [LitM False Q,LitM True R],Clause [LitM False R]]
    ],
    Clause [LitM True Q]
  ]
  []\<close>
  by (simp add: Axiom ExtensionLit ReductionLit ExtensionMat)
end

abbreviation \<open>evalLit i pol prp \<equiv> ((pol \<and> \<not>i prp) \<or> (\<not>pol \<and> i prp))\<close>

fun semanticsMat semanticsCls where
  \<open>semanticsMat i (LitM pol prp) = evalLit i pol prp\<close> |
  \<open>semanticsMat i (Matrix []) = False\<close> |
  \<open>semanticsMat i (Matrix (cls # mat)) =
    (semanticsCls i cls \<or> semanticsMat i (Matrix mat))\<close> |
  \<open>semanticsCls i (LitC pol prp) = evalLit i pol prp\<close> |
  \<open>semanticsCls i (Clause []) = True\<close> |
  \<open>semanticsCls i (Clause (mat # cls)) =
    (semanticsMat i mat \<and> semanticsCls i (Clause cls))\<close>

fun pathMat pathCls where
  \<open>pathMat path (LitM pol prp) = member (pol,prp) path\<close> |
  \<open>pathMat path (Matrix []) = True\<close> |
  \<open>pathMat path (Matrix (cls # mat)) = (pathCls path cls \<and> pathMat path (Matrix mat))\<close> |
  \<open>pathCls path (LitC pol prp) = member (pol,prp) path\<close> |
  \<open>pathCls path (Clause []) = False\<close> |
  \<open>pathCls path (Clause (mat # cls)) = (pathMat path mat \<or> pathCls path (Clause cls))\<close>

(*Weird equality thing needed to get induction correct*)
lemma prefixPath:
  \<open>pathMat path mat \<Longrightarrow> path' = (prefix @ path) \<Longrightarrow> pathMat path' mat\<close>
  \<open>pathCls path cls \<Longrightarrow> path' = (prefix @ path) \<Longrightarrow> pathCls path' cls\<close>
  by (induct mat and cls rule: pathMat_pathCls.induct) auto

lemma suffixPath:
  \<open>pathMat path mat \<Longrightarrow> path' = (path @ suffix) \<Longrightarrow> pathMat path' mat\<close>
  \<open>pathCls path cls \<Longrightarrow> path' = (path @ suffix) \<Longrightarrow> pathCls path' cls\<close>
  by (induct mat and cls rule: pathMat_pathCls.induct) auto+

(* Quantifier semantics:*)
fun semanticsMatQ semanticsClsQ where
  \<open>semanticsMatQ i (LitM pol prp) = evalLit i pol prp\<close> |
  \<open>semanticsMatQ i (Matrix mat) = (\<exists> cls \<in> set mat. semanticsClsQ i cls)\<close> |
  \<open>semanticsClsQ i (LitC pol prp) = evalLit i pol prp\<close> |
  \<open>semanticsClsQ i (Clause cls) = (\<forall> cls_elem \<in> set cls. semanticsMatQ i cls_elem)\<close>

lemma semantics_implies_semanticsQ:
  \<open>semanticsMat i mat \<Longrightarrow> semanticsMatQ i mat\<close>
  \<open>semanticsCls i cls \<Longrightarrow> semanticsClsQ i cls\<close>
proof (induct mat and cls)
  case (Matrix x)
  then show ?case
    by (induct x) auto
next
  case (Clause x)
  then show ?case
    by (induct x) auto
qed simp_all

lemma semanticsQ_implies_semantics:
  \<open>semanticsMatQ i mat \<Longrightarrow> semanticsMat i mat\<close>
  \<open>semanticsClsQ i cls \<Longrightarrow> semanticsCls i cls\<close>
proof (induct mat and cls)
  case (Matrix x)
  then show ?case
    by (induct x) auto
next
  case (Clause x)
  then show ?case
    by (induct x) auto
qed simp_all

fun pathMatQ pathClsQ where
  \<open>pathMatQ path (LitM pol prp) = member (pol, prp) path\<close> |
  \<open>pathMatQ path (Matrix mat) = (\<forall> cls \<in> set mat. pathClsQ path cls)\<close> |
  \<open>pathClsQ path (LitC pol prp) = member (pol, prp) path\<close> |
  \<open>pathClsQ path (Clause cls) = (\<exists> cls_elem \<in> set cls. pathMatQ path cls_elem)\<close>

lemma path_implies_pathQ:
  \<open>pathMat path mat \<Longrightarrow> pathMatQ path mat\<close>
  \<open>pathCls path cls \<Longrightarrow> pathClsQ path cls\<close>
proof (induct mat and cls)
  case (Matrix x)
  then show ?case
    by (induct x) auto
next
  case (Clause x)
  then show ?case
    by (induct x) auto
qed simp_all

lemma pathQ_implies_path:
  \<open>pathMatQ path mat \<Longrightarrow> pathMat path mat\<close>
  \<open>pathClsQ path cls \<Longrightarrow> pathCls path cls\<close>
proof (induct mat and cls)
  case (Matrix x)
  then show ?case
    by (induct x) auto
next
  case (Clause x)
  then show ?case
    by (induct x) auto
qed simp_all

primrec sum where
  \<open>sum [] = (0 :: nat)\<close> |
  \<open>sum (x # xs) = x + sum xs\<close>

lemma sum_append: \<open>sum (xs @ ys) = sum xs + sum ys\<close>
  by (induct xs) auto

fun nodesMat nodesCls where
  \<open>nodesMat (LitM _ _) = (0 :: nat)\<close> |
  \<open>nodesMat (Matrix []) = 0\<close> |
  \<open>nodesMat (Matrix (cls # mat)) = 1 + sum (map nodesCls (cls # mat))\<close> |
  \<open>nodesCls (LitC _ _) = 0\<close> |
  \<open>nodesCls (Clause []) = 0\<close> |
  \<open>nodesCls (Clause (mat # cls)) = 1 + sum (map nodesMat (mat # cls))\<close>

lemma add_clause_preserves_nodes: \<open>
  x < nodesMat (Matrix mat) \<Longrightarrow> x < nodesMat (Matrix (cls # mat))\<close>
proof-
  assume a:\<open>x < nodesMat (Matrix mat)\<close>
  moreover have \<open>... = 1 + sum  (map nodesCls mat)\<close>
    by (metis calculation clause_elem.inject(2) less_nat_zero_code nodesMat.elims)
  moreover have \<open>... \<le>  1 + sum  (map nodesCls (cls # mat))\<close>
    by simp
  ultimately show ?thesis
    using a by auto
qed

lemma nodes_in_non_empty_cls:\<open>
  \<exists> cls \<in> set mat. cls = Clause (h # t) \<Longrightarrow> 1 < nodesMat (Matrix mat)\<close>
proof (induct mat arbitrary: h t)
  case Nil
  then show ?case
    by simp
next
  case (Cons cls mat)
  consider \<open>cls = Clause []\<close> | \<open>\<exists> pol prp. cls = LitC pol prp\<close> | \<open>\<exists> h t. cls = Clause (h # t)\<close>
    by (meson nodesCls.cases)
  then show ?case
  proof cases
    case 1
    then show ?thesis
      by (metis Cons.hyps Cons.prems add_clause_preserves_nodes list.distinct(1)
          matrix_elem.inject(2) set_ConsD)
  next
    case 2
    then show ?thesis
      by (metis Cons.hyps Cons.prems add_clause_preserves_nodes matrix_elem.distinct(1) set_ConsD)
  next
    case 3
    then show ?thesis by auto
  qed
qed

lemma nodes_imply_non_empty_cls:\<open>
  nodesMat (Matrix mat) > 1 \<Longrightarrow> \<exists> h t. \<exists> cls \<in> set mat. cls = Clause (h # t)\<close>
proof (induct mat)
  case Nil
  then show ?case by simp
next
  case (Cons cls mat)
  consider \<open>(\<exists> pol prp. cls = LitC pol prp) \<or> cls = Clause []\<close> | \<open>\<exists> h t. cls = Clause (h # t)\<close>
    by (metis nodesCls.cases)
  then show ?case
  proof cases
    case 1
    then have \<open>nodesCls cls = 0\<close>
      by auto
    moreover have \<open>nodesMat (Matrix (cls # mat)) = 1 + nodesCls cls + (sum (map nodesCls mat))\<close>
      by simp
    ultimately show ?thesis
      by (metis Cons.hyps Cons.prems add_0_iff canonically_ordered_monoid_add_class.lessE
          clause_elem.distinct(1) clause_elem.inject(2) list.set_intros(2) list.simps(8)
          sum.simps(1) nodesMat.elims)
  next
    case 2
    then show ?thesis
      by auto
  qed
qed

lemma extPath:
  \<open>pathMat path mata \<Longrightarrow> mata = Matrix mat1 \<Longrightarrow> matb = Matrix mat2 \<Longrightarrow> ext mat1 mat2 \<Longrightarrow>
    pathMat path matb\<close>
  \<open>pathCls path clsa \<Longrightarrow> clsa = Clause cls1 \<Longrightarrow> clsb = Clause cls2 \<Longrightarrow> ext cls2 cls1 \<Longrightarrow>
    pathCls path clsb\<close>
   apply (meson ext_iff pathMatQ.simps(2) pathQ_implies_path(1) path_implies_pathQ(1))
  by (meson ext_iff pathClsQ.simps(2) pathQ_implies_path(2) path_implies_pathQ(2))

lemma permPath:
  \<open>pathMat path mata \<Longrightarrow> mata = Matrix mat1 \<Longrightarrow> matb = Matrix mat2 \<Longrightarrow> perm mat1 mat2 \<Longrightarrow>
    pathMat path matb\<close>
  \<open>pathCls path clsa \<Longrightarrow> clsa = Clause cls1 \<Longrightarrow> clsb = Clause cls2 \<Longrightarrow> perm cls1 cls2 \<Longrightarrow>
    pathCls path clsb\<close>
  by (meson extPath)+

lemma extSemantics:
  \<open>semanticsMat i mata \<Longrightarrow> mata = Matrix mat1 \<Longrightarrow> matb = Matrix mat2 \<Longrightarrow> ext mat2 mat1 \<Longrightarrow>
    semanticsMat i matb\<close>
  \<open>semanticsCls i clsa \<Longrightarrow> clsa = Clause cls1 \<Longrightarrow> clsb = Clause cls2 \<Longrightarrow> ext cls1 cls2 \<Longrightarrow>
    semanticsCls i clsb\<close>
   apply (metis ext_iff semanticsMatQ.simps(2) semanticsQ_implies_semantics(1)
          semantics_implies_semanticsQ(1))
  by (metis ext_iff semanticsClsQ.simps(2) semanticsQ_implies_semantics(2)
      semantics_implies_semanticsQ(2))

lemma permSemantics:
  \<open>semanticsMat i mata \<Longrightarrow> mata = Matrix mat1 \<Longrightarrow> matb = Matrix mat2 \<Longrightarrow> perm mat1 mat2 \<Longrightarrow>
    semanticsMat i matb\<close>
  \<open>semanticsCls i clsa \<Longrightarrow> clsa = Clause cls1 \<Longrightarrow> clsb = Clause cls2 \<Longrightarrow> perm cls1 cls2 \<Longrightarrow>
    semanticsCls i clsb\<close>
  by (meson extSemantics)+

lemma move_to_front_perm:
  \<open>cls \<in> set mat \<Longrightarrow> perm mat (cls # remove1 cls mat)\<close>
  using in_set_remove1 by fastforce

lemma move_to_front_sum_mat:
  \<open>cls \<in> set mat \<Longrightarrow> sum (map nodesCls mat) = sum (map nodesCls (cls # remove1 cls mat))\<close>
  by (induct mat) auto

lemma move_to_front_sum_cls:
  \<open>mat \<in> set cls \<Longrightarrow> sum (map nodesMat cls) = sum (map nodesMat (mat # remove1 mat cls))\<close>
  by (induct cls) auto

lemma split_matrix_preserves_semantics: \<open>
  semanticsMat i (Matrix (mat1 @ mat2)) \<longleftrightarrow>
  semanticsMat i (Matrix mat1) \<or> semanticsMat i (Matrix mat2)\<close>
  by (induct mat1) simp_all

primrec unwrap where
  \<open>unwrap (LitM pol prp) = [LitC pol prp]\<close> |
  \<open>unwrap (Matrix mat) = mat\<close>

lemma pick_mat_semantics: \<open>
  (\<forall> i. semanticsMat i (Matrix ((Clause cls) # mat))) \<longleftrightarrow>
  (\<forall> mat' \<in> set cls. \<forall> i.
    semanticsMat i (Matrix ((unwrap mat') @ mat)))\<close> (is \<open>?cls \<longleftrightarrow> ?uwmat\<close>)
proof (rule iffI, rule_tac [1] ballI, rule_tac [!] allI)
  fix i mat'
  assume asm1:\<open>mat' \<in> set cls\<close>
  assume asm2:?cls
  then have \<open>semanticsMat i (Matrix ((Clause cls) # mat))\<close>
    by simp
  then consider \<open>semanticsCls i (Clause cls)\<close> | \<open>semanticsMat i (Matrix mat)\<close>
    by auto
  then show \<open>semanticsMat i (Matrix (unwrap mat' @ mat))\<close>
  proof cases
    case 1
    then have \<open>semanticsMat i mat'\<close>
      by (metis asm1 ext.simps(2) member_iff permSemantics(2) perm_iff semanticsCls.simps(3))
    then show ?thesis
      by (smt (verit, del_insts) list.inject not_Cons_self2 semanticsCls.simps(1)
          semanticsMat.elims(2) semanticsMat.elims(3) split_matrix_preserves_semantics
          unwrap.simps(1) unwrap.simps(2))
  next
    case 2
    then show ?thesis
      by (simp add: split_matrix_preserves_semantics)
  qed
next
  fix i
  assume asm1:?uwmat
  have \<open>\<forall> mat' \<in> set cls. semanticsMat i mat' \<or> semanticsMat i (Matrix mat)\<close>
  proof (rule ccontr)
    assume asm2: \<open>\<not> (\<forall>mat'\<in>set cls. semanticsMat i mat' \<or> semanticsMat i (Matrix mat))\<close>
    then obtain mat' where mat'_def:\<open>mat' \<in> set cls \<and> \<not>semanticsMat i mat'\<close>
      by auto
    then have \<open>\<not>semanticsMat i (Matrix (unwrap mat'))\<close>
    proof (cases mat')
    qed auto
    then show False
      using asm1 asm2 mat'_def split_matrix_preserves_semantics by blast
  qed
  then consider \<open>\<forall> mat' \<in> set cls. semanticsMat i mat'\<close> | \<open>semanticsMat i (Matrix mat)\<close>
    by fast
  then show \<open>semanticsMat i (Matrix (Clause cls # mat))\<close>
  proof cases
    case 1
    then have \<open>semanticsClsQ i (Clause cls)\<close>
      by (simp add: semantics_implies_semanticsQ(1))
    then show ?thesis
      by (simp add: semanticsQ_implies_semantics(2))
  next
    case 2
    then show ?thesis
      by simp
  qed
qed

lemma split_matrix_preserves_path:\<open>
  pathMat path (Matrix (mat1 @ mat2)) \<longleftrightarrow> pathMat path (Matrix mat1) \<and> pathMat path (Matrix mat2)\<close>
  by (induct mat1) simp_all

lemma pick_mat_paths: \<open>
  (
    \<forall> path. pathMat path (Matrix ((Clause cls) # mat)) \<longrightarrow>
    (\<exists> prp. (False,prp) \<in> set path \<and> (True,prp) \<in> set path)
  ) \<longleftrightarrow>
  (
    \<forall> mat' \<in> set cls.
       \<forall> path. pathMat path (Matrix ((unwrap mat') @ mat)) \<longrightarrow>
      (\<exists> prp. (False,prp) \<in> set path \<and> (True,prp) \<in> set path)
  )\<close> (is \<open>?cls \<longleftrightarrow> ?uwmat\<close>)
proof (rule iffI, rule_tac [1] ballI, rule_tac [!] allI, rule_tac[!] impI)
  fix path mat'
  assume asm1: ?cls
  assume asm2:\<open>mat' \<in> set cls\<close>
  assume asm3:\<open>pathMat path (Matrix (unwrap mat' @ mat))\<close>
  have \<open>pathMat path (Matrix ((Clause cls) # mat))\<close>
  proof (cases mat')
    case (LitM pol prp)
    then show ?thesis
      using asm2 asm3 clause_elem.inject(1) pathCls.simps(1) pathQ_implies_path(2) by force
  next
    case (Matrix matI')
    then show ?thesis
      by (metis asm2 asm3 pathClsQ.simps(2) pathMat.simps(3) pathQ_implies_path(2)
          path_implies_pathQ(1) split_matrix_preserves_path unwrap.simps(2))
  qed
  then show \<open>\<exists>prp. (False, prp) \<in> set path \<and> (True, prp) \<in> set path\<close>
    by (simp add: asm1)
next
  fix path
  assume asm1: \<open>
    \<forall>mat'\<in>set cls. \<forall>path.
       pathMat path (Matrix (unwrap mat' @ mat)) \<longrightarrow>
       (\<exists>prp. (False, prp) \<in> set path \<and> (True, prp) \<in> set path)\<close>
  assume asm2: \<open>pathMat path (Matrix (Clause cls # mat))\<close>
  then obtain mat' where mat'_def: \<open>mat' \<in> set cls \<and> pathMat path mat'\<close>
    by (meson list.set_intros(1) pathClsQ.simps(2) pathMatQ.simps(2) pathQ_implies_path(1)
        path_implies_pathQ(1))
  have \<open>pathMat path (Matrix (unwrap mat' @ mat))\<close>
  proof (cases mat')
    case (LitM pol prp)
    then show ?thesis
      using asm2 mat'_def by auto
  next
    case (Matrix matI')
    then show ?thesis
      using asm2 mat'_def split_matrix_preserves_path by auto
  qed
  then show \<open>
    (\<exists>prp. (False, prp) \<in> set path \<and> (True, prp) \<in> set path)\<close>
    using mat'_def asm1 by blast
qed

lemma pick_mat_nodes: \<open>
  mat' \<in> set cls \<Longrightarrow>
    nodesMat (Matrix ((Clause cls) # mat)) > nodesMat (Matrix ((unwrap mat') @ mat))\<close>
  (is \<open>?mat \<Longrightarrow> ?nodes\<close>)
proof-
  assume mat'_def: ?mat
  have cls_mat_nodes:\<open>
    nodesMat (Matrix ((Clause cls) # mat)) =
    1 + nodesCls (Clause cls) + sum (map nodesCls mat)\<close>
    by simp
  have cls_nodes:\<open>
    nodesCls (Clause cls) = 1 + nodesMat mat' + sum (map nodesMat (remove1 mat' cls))\<close>
    using mat'_def move_to_front_sum_cls
    by (smt (verit, ccfv_threshold) ab_semigroup_add_class.add_ac(1) list.set_cases list.simps(9)
        sum.simps(2) nodesCls.simps(3))
  consider \<open>\<exists> pol prp. mat' = LitM pol prp\<close> | \<open>\<exists> matI'. mat' = Matrix matI'\<close>
    by (meson clause_elem.exhaust)
  then show ?nodes
  proof cases
    case 1
    then show ?thesis
      using append_eq_append_conv2 cls_nodes by auto
  next
    case 2
    consider (21)\<open>unwrap mat' @ mat = []\<close> | (22)\<open>unwrap mat' @ mat \<noteq> []\<close>
      by fast
    then show ?thesis
    proof cases
      case 21
      then show ?thesis
        by simp
    next
      case 22
      then have \<open>
        nodesMat (Matrix (unwrap mat' @ mat)) =
        1 + sum (map nodesCls (unwrap mat')) + sum (map nodesCls mat)\<close>
        using sum_append
        by (metis clause_elem.distinct(1) clause_elem.inject(2) group_cancel.add1 map_append
            nodesMat.elims)
      then show ?thesis
        by (metis "2" add.commute add_strict_right_mono clause_elem.distinct(1) cls_mat_nodes
            cls_nodes less_add_same_cancel1 list.simps(8) sum.simps(1) nodesMat.elims
            trans_less_add1 unwrap.simps(2) zero_less_one)
    qed
  qed
qed

primrec lit_to_path_elem where
  \<open>lit_to_path_elem (LitC pol prp) = (pol,prp)\<close> |
  \<open>lit_to_path_elem (Clause mat) = undefined\<close>

lemma flat_matrix_syntactic_to_semantic: \<open>
  \<forall> cls \<in> set mat. \<exists> pol prp. cls = LitC pol prp \<Longrightarrow>
    (
      \<forall> path. pathMat path (Matrix mat) \<longrightarrow>
      (\<exists> prp. (False,prp) \<in> set path \<and> (True,prp) \<in> set path)
    ) \<longleftrightarrow>
    (\<forall> i. semanticsMat i (Matrix mat))\<close> (is \<open>?flat \<Longrightarrow> ?paths \<longleftrightarrow> ?valid\<close>)
proof-
  assume asm1:?flat
  then have all_paths:\<open>
    \<forall> path. \<forall> cls \<in> set mat.
      pathMat path (Matrix mat) \<longrightarrow>
      (\<exists> pol prp. cls = LitC pol prp \<and> (pol,prp) \<in> set path)\<close>
    by (metis member_iff pathClsQ.simps(1) pathMatQ.simps(2) path_implies_pathQ(1))
  show \<open>?paths \<longleftrightarrow> ?valid\<close>
  proof (rule iffI, rule_tac [!] allI)
    fix i
    assume asm2:?paths
    have \<open>\<exists> prp. LitC True prp \<in> set mat \<and> LitC False prp \<in> set mat\<close>
    proof (rule ccontr)
      assume asm3:\<open>\<nexists> prp. LitC True prp \<in> set mat \<and> LitC False prp \<in> set mat\<close>
      obtain path where path_def:\<open>path = map lit_to_path_elem mat\<close>
        by simp
      have lit_in_path_in_mat:
        \<open>\<forall> lit \<in> set path. \<exists> pol prp. lit = (pol,prp) \<and> LitC pol prp \<in> set mat\<close>
      proof
        fix lit
        assume asm4:\<open>lit \<in> set path\<close>
        obtain pol prp where lit_def:\<open>lit = (pol,prp)\<close>
          by fastforce
        then obtain cls where cls_def: \<open>cls \<in> set mat \<and> lit = lit_to_path_elem cls\<close>
          using asm4 path_def by auto
        then have \<open>cls = LitC pol prp\<close>
          using lit_def asm1 by (metis Pair_inject lit_to_path_elem.simps(1))
        then show \<open>\<exists> pol prp. lit = (pol,prp) \<and> LitC pol prp \<in> set mat\<close>
          using cls_def by auto
      qed
      then have \<open>\<nexists> prp. (True, prp) \<in> set path \<and> (False, prp) \<in> set path\<close>
        using asm1 asm3 by blast
      moreover have \<open>pathMat path (Matrix mat)\<close>
        using lit_in_path_in_mat
        by (metis asm1 in_set_conv_nth length_map lit_to_path_elem.simps(1) matrix_elem.distinct(1)
            member_iff nth_map pathClsQ.elims(3) pathMatQ.simps(2) pathQ_implies_path(1) path_def)
      ultimately show False
        using asm2 by blast
    qed
    then show \<open>semanticsMat i (Matrix mat)\<close>
      by (metis move_to_front_perm permSemantics(1) semanticsCls.simps(1) semanticsMat.simps(3))
  next
    fix path
    assume asm2:?valid
    show \<open>pathMat path (Matrix mat) \<longrightarrow> (\<exists>prp. (False, prp) \<in> set path \<and> (True, prp) \<in> set path)\<close>
    proof (rule impI, rule ccontr)
      assume asm3:\<open>pathMat path (Matrix mat)\<close>
      assume asm4:\<open>\<nexists>prp. (False, prp) \<in> set path \<and> (True, prp) \<in> set path\<close>
      then have nexi_prp:\<open>\<nexists>prp. LitC True prp \<in> set mat \<and> LitC False prp \<in> set mat\<close>
        using all_paths asm3 by blast
      obtain i where i_def:\<open>i = (\<lambda> prp. LitC True prp \<in> set mat)\<close>
        by simp
      have \<open>\<not>semanticsMatQ i (Matrix mat)\<close>
        using asm1 i_def nexi_prp by fastforce
      then have \<open>\<not>semanticsMat i (Matrix mat)\<close>
        using semantics_implies_semanticsQ(1) by blast
      then show False
        using asm2 by simp
    qed
  qed
qed

lemma one_node_implies_flat: \<open>
  nodesMat mat = 1 \<Longrightarrow>
  \<exists> matI. mat = Matrix matI \<and>
  (\<forall> cls \<in> set matI. cls = Clause [] \<or> (\<exists> pol prp. cls = LitC pol prp))\<close> (is \<open>?nds \<Longrightarrow> ?matI\<close>)
proof-
  assume asm1: \<open>nodesMat mat = 1\<close>
  then obtain matI where mat_def: \<open>mat = Matrix matI\<close>
    by (metis clause_elem.exhaust nodesMat.simps(1) zero_neq_one)
  moreover have \<open>\<forall> cls \<in> set matI. cls = Clause [] \<or> (\<exists> pol prp. cls = LitC pol prp)\<close>
    by (metis asm1 less_numeral_extra(4) mat_def nodesCls.cases nodes_in_non_empty_cls)
  ultimately show ?matI
    by simp
qed

theorem syntactic_equals_semantic_validity:\<open>
  (\<forall> path. pathMat path mat \<longrightarrow> (\<exists> prp. (False,prp) \<in> set path \<and> (True,prp) \<in> set path)) \<longleftrightarrow>
  (\<forall> i. semanticsMat i mat)\<close>
proof (induct \<open>nodesMat mat\<close> arbitrary: mat rule: less_induct)
  case less
  consider (0)\<open>nodesMat mat = 0\<close> | (1)\<open>nodesMat mat = 1\<close> | (n)\<open>1 < nodesMat mat\<close>
    by linarith
  then show ?case
  proof cases
    case 0
    then consider \<open>\<exists> pol prp. mat = LitM pol prp\<close> | \<open>mat = Matrix []\<close>
      by (metis add_eq_0_iff_both_eq_0 nodesMat.elims zero_neq_one)
    then show ?thesis
    proof cases
      case 1
      then obtain pol prp where mat_def: \<open>mat = LitM pol prp\<close>
        by auto
      moreover obtain i where \<open>i prp = pol\<close>
        by simp
      moreover have \<open>pathMat [(pol,prp)] mat\<close>
        by (simp add: mat_def)
      ultimately show ?thesis
        using mat_def
        by (metis Pair_inject list.distinct(1) list.set_cases semanticsMat.simps(1) set_ConsD)
    next
      case 2
      then show ?thesis
        by (meson in_set_member member_rec(2) pathMat.simps(2) semanticsMat.simps(2))
    qed
  next
    case 1
    then obtain matI where mat_def:\<open>
      mat = Matrix matI \<and> (\<forall> cls \<in> set matI. cls = Clause [] \<or> (\<exists> pol prp. cls = LitC pol prp))\<close>
      using one_node_implies_flat by blast
    then consider
      (ex)\<open>\<exists> cls \<in> set matI. cls = Clause []\<close> |
      (al)\<open>\<forall> cls \<in> set matI. (\<exists> pol prp. cls = LitC pol prp)\<close>
      by blast
    then show ?thesis
    proof cases
      case ex
      then have \<open>perm matI (Clause [] # remove1 (Clause []) matI)\<close>
        by (meson move_to_front_perm)
      then show ?thesis
        by (metis mat_def pathCls.simps(2) pathMat.simps(3) permPath(1) permSemantics(1)
            semanticsCls.simps(2) semanticsMat.simps(3))
    next
      case al
      then show ?thesis
        by (simp add: flat_matrix_syntactic_to_semantic mat_def)
    qed
  next
    case n
    then obtain matI where mat_def:\<open>mat = Matrix matI\<close>
      by (metis clause_elem.exhaust less_nat_zero_code nodesMat.simps(1))
    then obtain clsh clst where cls_def:\<open>Clause (clsh # clst) \<in> set matI\<close>
      using nodes_imply_non_empty_cls n by blast

    let ?cls = \<open>Clause (clsh # clst)\<close>
    let ?paths_cls_in_front = \<open>
      (
        \<forall>path. pathMat path (Matrix (?cls # remove1 ?cls matI)) \<longrightarrow>
        (\<exists>prp. (False, prp) \<in> set path \<and> (True, prp) \<in> set path)
      )\<close>
    let ?semantics_cls_in_front = \<open>(\<forall>i. semanticsMat i (Matrix (?cls # remove1 ?cls matI)))\<close>

    have unwrapped_nodes: \<open>\<forall> mat' \<in> set (clsh # clst).
        nodesMat (Matrix (unwrap mat' @ remove1 ?cls matI)) < nodesMat mat\<close>
      by (metis cls_def mat_def move_to_front_sum_mat n nodesMat.elims nodesMat.simps(3)
          not_one_less_zero pick_mat_nodes unwrap.simps(2))
    have \<open>
      ?paths_cls_in_front \<longleftrightarrow>
      (
        \<forall> mat' \<in> set (clsh # clst).
           \<forall> path. pathMat path (Matrix (unwrap mat' @ remove1 ?cls matI)) \<longrightarrow>
        (\<exists> prp. (False,prp) \<in> set path \<and> (True,prp) \<in> set path)
      )\<close>
      using pick_mat_paths by fast
    moreover have \<open>
      ... \<longleftrightarrow>
      (
        \<forall> mat' \<in> set (clsh # clst).
          \<forall> i. semanticsMat i (Matrix (unwrap mat' @ remove1 ?cls matI))
      )\<close>
        using less unwrapped_nodes by fastforce
    moreover have \<open>
      ... \<longleftrightarrow> ?semantics_cls_in_front\<close>
      using pick_mat_semantics by blast
    ultimately have \<open>?paths_cls_in_front \<longleftrightarrow> ?semantics_cls_in_front\<close>
      by blast
    then show ?thesis
      using mat_def move_to_front_perm by (metis cls_def permPath(1) permSemantics(1))
  qed
qed

theorem path_soundness: \<open>
  nanoCoP mat path \<Longrightarrow>
    \<forall> path'. ext path' path \<longrightarrow> pathMat path' (Matrix mat) \<longrightarrow>
    (\<exists> prp. (False,prp) \<in> set path' \<and> (True,prp) \<in> set path')\<close>
proof (induct rule: nanoCoP.induct)
  case (Axiom Mat Path)
  then show ?case
    by simp
next
  case (PathAxiom prp Path Mat)
  then show ?case
    by (metis (full_types) ext_iff member_iff)
next
  case (ExtMat Mat1 Path Mat2)
  then show ?case
    using extPath(1) by blast
next
  case (ExtCls Cls1 Cls2 Mat Path)
  then show ?case
    by (meson extPath(2) pathMat.simps(3))
next
  case (ExtensionLit Mat pol prp Path Cls)
  then show ?case
    by (metis ext.simps(2) pathCls.simps(3) pathMat.simps(1) pathMat.simps(3))
next
  case (ExtensionMat mat Mat Path Cls)
  then show ?case
    by (metis pathCls.simps(3) pathMat.simps(3) split_matrix_preserves_path)
next
  case (ExtensionLitC Mat pol prp Path)
  then show ?case
    by simp
qed

theorem soundness: \<open>nanoCoP mat [] \<Longrightarrow> \<forall> i. semanticsMat i (Matrix mat)\<close>
  by (meson ext.simps(1) syntactic_equals_semantic_validity path_soundness)

fun sizeM sizeC where
  \<open>sizeM (LitM pol prp) = 1\<close> |
  \<open>sizeM (Matrix mat) = 1 + sum (map sizeC mat)\<close> |
  \<open>sizeC (LitC pol prp) = 1\<close> |
  \<open>sizeC (Clause cls) = 1 + sum (map sizeM cls)\<close>

lemma shuffle_size_mat: \<open>
  cls \<in> set mat \<Longrightarrow> sizeM (Matrix mat) = sizeM (Matrix (cls # remove1 cls mat))\<close>
  by (induct mat) auto

lemma shuffle_size_cls: \<open>
  mat \<in> set cls \<Longrightarrow> sizeC (Clause cls) = sizeC (Clause (mat # remove1 mat cls))\<close>
  by (induct cls) auto

lemma unwrap_size_mat: \<open>
  sizeM mat \<ge> sum (map sizeC (unwrap mat))\<close>
  by (cases mat) auto

lemma pick_mat_size: \<open>
  mat' \<in> set cls \<Longrightarrow>
    sizeM (Matrix ((Clause cls) # mat)) > sizeM (Matrix ((unwrap mat') @ mat))\<close> (is \<open>?asm \<Longrightarrow> ?cnc\<close>)
proof-
  assume ?asm
  then have \<open>sizeC (Clause cls) = sizeC (Clause (mat' # remove1 mat' cls))\<close>
    by (metis shuffle_size_cls)
  moreover have \<open>sum (map sizeM (mat' # remove1 mat' cls)) \<ge> sum (map sizeC (unwrap mat'))\<close>
    by (metis (no_types, lifting) add_leE list.simps(9) nanoCoP2.sum.simps(2) nle_le
        unwrap_size_mat)
  ultimately show ?cnc
    using sum_append by auto
qed

lemma size_not_0_mat: \<open>sizeM mat > 0\<close>
proof (rule ccontr)
  assume \<open>\<not>sizeM mat > 0\<close>
  moreover have \<open>(\<exists> pol prp. mat = LitM pol prp) \<or> (\<exists> matI. mat = Matrix matI)\<close>
    by (meson sizeM.cases)
  ultimately show False by force
qed

lemma size_not_0_cls: \<open>sizeC cls > 0\<close>
proof (rule ccontr)
  assume \<open>\<not>sizeC cls > 0\<close>
  moreover have \<open>(\<exists> pol prp. cls = LitC pol prp) \<or> (\<exists> clsI. cls = Clause clsI)\<close>
    by (meson sizeC.cases)
  ultimately show False by force
qed

lemma perm_path:
  \<open>ext p2 p1 \<Longrightarrow> pathMat p1 mat \<Longrightarrow> pathMat p2 mat\<close>
  \<open>ext p2 p1 \<Longrightarrow> pathCls p1 cls \<Longrightarrow> pathCls p2 cls\<close>
proof (induct mat and cls)
  case (LitM x1 x2)
  then show ?case
    using ext_iff by force
next
  case (Matrix x)
  then show ?case
    by (meson pathMatQ.simps(2) pathQ_implies_path(1) pathQ_implies_path(2) path_implies_pathQ(1)
        path_implies_pathQ(2))
next
  case (LitC x1 x2)
  then show ?case
    using ext_iff by force
next
  case (Clause x)
  then show ?case
    by (meson pathClsQ.simps(2) pathQ_implies_path(1) pathQ_implies_path(2) path_implies_pathQ(1)
        path_implies_pathQ(2))
qed

theorem path_completeness: \<open>
  \<forall> path'. ext path' Path \<longrightarrow> pathMat path' (Matrix Mat) \<longrightarrow>
    (\<exists> prp. (False,prp) \<in> set path' \<and> (True,prp) \<in> set path') \<Longrightarrow>
  nanoCoP Mat Path\<close>
proof (induct \<open>sizeM (Matrix Mat)\<close> arbitrary: Mat Path rule: less_induct)
  case less
  consider
    (Mat_empty)\<open>Mat = []\<close> |
    (Map_has_cls)\<open>\<exists> cls MatI. Mat = cls # MatI\<close>
    by (meson list.exhaust)
  then show ?case
  proof cases
    case Mat_empty
    then show ?thesis
      using PathAxiom less.prems by (metis member_iff pathMat.simps(2) perm_iff)
  next
    case Map_has_cls
    then obtain cls MatI where Mat_def:\<open>Mat = cls # MatI\<close>
      by auto
    consider
      (cls_is_lit)\<open>\<exists> pol prp. cls = LitC pol prp\<close> |
      (cls_empty)\<open>cls = Clause []\<close> |
      (cls_has_mat)\<open>\<exists> mat clsI. cls = Clause (mat # clsI)\<close>
      by (meson nodesCls.cases)
    then show ?thesis
    proof cases
      case cls_is_lit
      have \<open>sizeM (Matrix (cls # MatI)) > sizeM (Matrix MatI)\<close>
          using size_not_0_cls by auto
      then show ?thesis
        by (metis ExtensionLitC Mat_def cls_is_lit ext.simps(2) less.hyps less.prems
            pathCls.simps(1) pathMat.simps(3))
    next
      case cls_empty
      then show ?thesis
        by (simp add: Axiom Mat_def)
    next
      case cls_has_mat
      then obtain mat clsI where cls_def: \<open>cls = Clause (mat # clsI)\<close>
        by auto
      then have rm_mat:\<open>nanoCoP (Clause clsI # MatI) Path\<close>
      proof-
        have \<open>
          \<forall> p. pathMat p (Matrix ((Clause clsI) # MatI)) \<longrightarrow> ext p Path \<longrightarrow>
            pathMat p (Matrix Mat)\<close>
          by (simp add: Mat_def cls_def)
        then have \<open>
          \<forall> p. pathMat p (Matrix ((Clause clsI) # MatI)) \<longrightarrow> ext p Path \<longrightarrow> (
          \<exists> prp. (True,prp) \<in> set p \<and> (False,prp) \<in> set p)\<close>
          using less.prems by blast
        moreover have \<open>
          sizeM (Matrix ((Clause clsI) # MatI)) < sizeM (Matrix Mat)\<close>
          using size_not_0_mat Mat_def cls_def by simp
        ultimately show ?thesis
          using size_not_0_mat Mat_def cls_def less by fast
      qed
      consider
        (mat_is_lit) \<open>\<exists> pol prp. mat = LitM pol prp\<close> |
        (mat_is_matrix) \<open>\<exists> matI. mat = Matrix matI\<close>
        by (meson sizeM.cases)
      then show ?thesis
      proof cases
        case mat_is_lit
        then show ?thesis
          using Mat_def cls_def less
          by (auto simp add: ExtensionLit)
      next
        case mat_is_matrix
        then show ?thesis
          using ExtensionMat Mat_def cls_def rm_mat less
          by (metis list.set_intros(1) pathCls.simps(3) pathMat.simps(3) pick_mat_size
              split_matrix_preserves_path unwrap.simps(2))
      qed
    qed
  qed
qed

theorem completeness: \<open>
  \<forall> i. semanticsMat i (Matrix mat) \<Longrightarrow> nanoCoP mat []\<close>
  by (simp add: path_completeness syntactic_equals_semantic_validity)

theorem main: \<open>nanoCoP mat [] \<longleftrightarrow> (\<forall> i. semanticsMat i (Matrix mat))\<close>
  using completeness soundness by auto

end