section \<open>Terms with sequential pattern matching\<close>

theory Sterm
imports Strong_Term
begin

datatype sterm =
  Sconst name |
  Svar name |
  Sabs (clauses: "(term \<times> sterm) list") |
  Sapp sterm sterm (infixl "$\<^sub>s" 70)

datatype_compat sterm

derive linorder sterm

abbreviation Sabs_single ("\<Lambda>\<^sub>s _. _" [0, 50] 50) where
"Sabs_single x rhs \<equiv> Sabs [(Free x, rhs)]"

type_synonym sclauses = "(term \<times> sterm) list"

lemma sterm_induct[case_names Sconst Svar Sabs Sapp]:
  assumes "\<And>x. P (Sconst x)"
  assumes "\<And>x. P (Svar x)"
  assumes "\<And>cs. (\<And>pat t. (pat, t) \<in> set cs \<Longrightarrow> P t) \<Longrightarrow> P (Sabs cs)"
  assumes "\<And>t u. P t \<Longrightarrow> P u \<Longrightarrow> P (t $\<^sub>s u)"
  shows "P t"
using assms
  apply induction_schema
    apply pat_completeness
   apply lexicographic_order
  done

instantiation sterm :: pre_term begin

definition app_sterm where
"app_sterm t u = t $\<^sub>s u"

fun unapp_sterm where
"unapp_sterm (t $\<^sub>s u) = Some (t, u)" |
"unapp_sterm _ = None"

definition const_sterm where
"const_sterm = Sconst"

fun unconst_sterm where
"unconst_sterm (Sconst name) = Some name" |
"unconst_sterm _ = None"

fun unfree_sterm where
"unfree_sterm (Svar name) = Some name" |
"unfree_sterm _ = None"

definition free_sterm where
"free_sterm = Svar"

fun frees_sterm where
"frees_sterm (Svar name) = {|name|}" |
"frees_sterm (Sconst _) = {||}" |
"frees_sterm (Sabs cs) = ffUnion (fset_of_list (map (\<lambda>(pat, rhs). frees_sterm rhs - frees pat) cs))" |
"frees_sterm (t $\<^sub>s u) = frees_sterm t |\<union>| frees_sterm u"

fun subst_sterm where
"subst_sterm (Svar s) env = (case fmlookup env s of Some t \<Rightarrow> t | None \<Rightarrow> Svar s)" |
"subst_sterm (t\<^sub>1 $\<^sub>s t\<^sub>2) env = subst_sterm t\<^sub>1 env $\<^sub>s subst_sterm t\<^sub>2 env" |
"subst_sterm (Sabs cs) env = Sabs (map (\<lambda>(pat, rhs). (pat, subst_sterm rhs (fmdrop_fset (frees pat) env))) cs)" |
"subst_sterm t env = t"

fun consts_sterm :: "sterm \<Rightarrow> name fset" where
"consts_sterm (Svar _) = {||}" |
"consts_sterm (Sconst name) = {|name|}" |
"consts_sterm (Sabs cs) = ffUnion (fset_of_list (map (\<lambda>(_, rhs). consts_sterm rhs) cs))" |
"consts_sterm (t $\<^sub>s u) = consts_sterm t |\<union>| consts_sterm u"

instance
by standard
   (auto
      simp: app_sterm_def const_sterm_def free_sterm_def
      elim: unapp_sterm.elims unconst_sterm.elims unfree_sterm.elims
      split: option.splits)

end

instantiation sterm :: "term" begin

definition abs_pred_sterm :: "(sterm \<Rightarrow> bool) \<Rightarrow> sterm \<Rightarrow> bool" where
[code del]: "abs_pred P t \<longleftrightarrow> (\<forall>cs. t = Sabs cs \<longrightarrow> (\<forall>pat t. (pat, t) \<in> set cs \<longrightarrow> P t) \<longrightarrow> P t)"

lemma abs_pred_stermI[intro]:
  assumes "\<And>cs. (\<And>pat t. (pat, t) \<in> set cs \<Longrightarrow> P t) \<Longrightarrow> P (Sabs cs)"
  shows "abs_pred P t"
using assms unfolding abs_pred_sterm_def by auto

instance proof (standard, goal_cases)
  case (1 P t)
  then show ?case
    by (induction t) (auto simp: const_sterm_def free_sterm_def app_sterm_def abs_pred_sterm_def)
next
  case (2 t)
  show ?case
    apply rule
    apply auto
    apply (subst (3) list.map_id[symmetric])
    apply (rule list.map_cong0)
    apply auto
    by blast
next
  case (3 x t)
  show ?case
    apply rule
    apply clarsimp
    subgoal for cs env pat rhs
      apply (cases "x |\<in>| frees pat")
      subgoal
        apply (rule arg_cong[where f = "subst rhs"])
        by (auto intro: fmap_ext)
      subgoal premises prems[rule_format]
        apply (subst (2) prems(1)[symmetric, where pat = pat])
        subgoal by fact
        subgoal
          using prems
          unfolding ffUnion_alt_def
          by (auto simp add: fmember.rep_eq fset_of_list.rep_eq elim!: fBallE)
        subgoal
          apply (rule arg_cong[where f = "subst rhs"])
          by (auto intro: fmap_ext)
        done
      done
    done
next
  case (4 t)
  show ?case
    apply rule
    apply clarsimp
    subgoal premises prems[rule_format]
      apply (rule prems(1)[OF prems(4)])
      subgoal using prems by auto
      subgoal using prems unfolding fdisjnt_alt_def by auto
      done
    done
next
  case 5
  show ?case
    proof (intro abs_pred_stermI allI impI, goal_cases)
      case (1 cs env)
      show ?case
        proof safe
          fix name
          assume "name |\<in>| frees (subst (Sabs cs) env)"
          then obtain pat rhs
            where "(pat, rhs) \<in> set cs"
              and "name |\<in>| frees (subst rhs (fmdrop_fset (frees pat) env))"
              and "name |\<notin>| frees pat"
            by (auto simp: fset_of_list_elem case_prod_twice comp_def ffUnion_alt_def)

          hence "name |\<in>| frees rhs |-| fmdom (fmdrop_fset (frees pat) env)"
            using 1 by (simp add: fmpred_drop_fset)

          hence "name |\<in>| frees rhs |-| frees pat"
            using \<open>name |\<notin>| frees pat\<close> by blast

          show "name |\<in>| frees (Sabs cs)"
            apply (simp add: ffUnion_alt_def)
            apply (rule fBexI[where x = "(pat, rhs)"])
            unfolding prod.case
             apply (fact \<open>name |\<in>| frees rhs |-| frees pat\<close>)
            unfolding fset_of_list_elem
            by fact

          assume "name |\<in>| fmdom env"
          thus False
            using \<open>name |\<in>| frees rhs |-| fmdom (fmdrop_fset (frees pat) env)\<close> \<open>name |\<notin>| frees pat\<close>
            by fastforce
        next
          fix name
          assume "name |\<in>| frees (Sabs cs)" "name |\<notin>| fmdom env"

          then obtain pat rhs
            where "(pat, rhs) \<in> set cs" "name |\<in>| frees rhs" "name |\<notin>| frees pat"
            by (auto simp: fset_of_list_elem ffUnion_alt_def)

          moreover hence "name |\<in>| frees rhs |-| fmdom (fmdrop_fset (frees pat) env) |-| frees pat"
            using \<open>name |\<notin>| fmdom env\<close> by fastforce

          ultimately have "name |\<in>| frees (subst rhs (fmdrop_fset (frees pat) env)) |-| frees pat"
            using 1 by (simp add: fmpred_drop_fset)

          show "name |\<in>| frees (subst (Sabs cs) env)"
            apply (simp add: case_prod_twice comp_def)
            unfolding ffUnion_alt_def
            apply (rule fBexI)
             apply (fact \<open>name |\<in>| frees (subst rhs (fmdrop_fset (frees pat) env)) |-| frees pat\<close>)
            apply (subst fimage_iff)
            apply (rule fBexI[where x = "(pat, rhs)"])
             apply simp
            using \<open>(pat, rhs) \<in> set cs\<close>
            by (auto simp: fset_of_list_elem)
        qed
    qed
next
  case 6
  show ?case
    proof (intro abs_pred_stermI allI impI, goal_cases)
      case (1 cs env)

      \<comment> \<open>some property on various operations that is only useful in here\<close>
      have *: "fbind (fmimage m (fbind A g)) f = fbind A (\<lambda>x. fbind (fmimage m (g x)) f)"
        for m A f g
        including fset.lifting fmap.lifting
        by transfer' force

      have "consts (subst (Sabs cs) env) = fbind (fset_of_list cs) (\<lambda>(pat, rhs). consts rhs |\<union>| ffUnion (consts |`| fmimage (fmdrop_fset (frees pat) env) (frees rhs)))"
        apply (simp add: funion_image_bind_eq)
        apply (rule fbind_cong[OF refl])
        apply (clarsimp split: prod.splits)
        apply (subst 1)
         apply (subst (asm) fset_of_list_elem, assumption)
        apply simp
        by (simp add: funion_image_bind_eq)
      also have "\<dots> = fbind (fset_of_list cs) (consts \<circ> snd) |\<union>| fbind (fset_of_list cs) (\<lambda>(pat, rhs). ffUnion (consts |`| fmimage (fmdrop_fset (frees pat) env) (frees rhs)))"
        apply (subst fbind_fun_funion[symmetric])
        apply (rule fbind_cong[OF refl])
        by auto
      also have "\<dots> = consts (Sabs cs) |\<union>| fbind (fset_of_list cs) (\<lambda>(pat, rhs). ffUnion (consts |`| fmimage (fmdrop_fset (frees pat) env) (frees rhs)))"
        apply (rule cong[OF cong, OF refl _ refl, where f1 = "funion"])
        apply (subst funion_image_bind_eq[symmetric])
        unfolding consts_sterm.simps
        apply (rule arg_cong[where f = ffUnion])
        apply (subst fset_of_list_map)
        apply (rule fset.map_cong[OF refl])
        by auto
      also have "\<dots> = consts (Sabs cs) |\<union>| fbind (fmimage env (fbind (fset_of_list cs) (\<lambda>(pat, rhs). frees rhs |-| frees pat))) consts"
        apply (subst funion_image_bind_eq)
        apply (subst fmimage_drop_fset)
        apply (rule cong[OF cong, OF refl refl, where f1 = "funion"])
        apply (subst *)
        apply (rule fbind_cong[OF refl])
        by auto
      also have "\<dots> = consts (Sabs cs) |\<union>| ffUnion (consts |`| fmimage env (frees (Sabs cs)))"
        by (simp only: frees_sterm.simps fset_of_list_map  fmimage_Union funion_image_bind_eq)

      finally show ?case .
    qed
qed (auto simp: abs_pred_sterm_def)

end

lemma no_abs_abs[simp]: "\<not> no_abs (Sabs cs)"
by (subst no_abs.simps) (auto simp: term_cases_def)

lemma closed_except_simps:
  "closed_except (Svar x) S \<longleftrightarrow> x |\<in>| S"
  "closed_except (t\<^sub>1 $\<^sub>s t\<^sub>2) S \<longleftrightarrow> closed_except t\<^sub>1 S \<and> closed_except t\<^sub>2 S"
  "closed_except (Sabs cs) S \<longleftrightarrow> list_all (\<lambda>(pat, t). closed_except t (S |\<union>| frees pat)) cs"
  "closed_except (Sconst name) S \<longleftrightarrow> True"
proof goal_cases
  case 3
  show ?case
    proof (standard, goal_cases)
      case 1
      then show ?case
        apply (auto simp: list_all_iff ffUnion_alt_def fset_of_list_elem closed_except_def)
        apply (drule ffUnion_least_rev)
        apply auto
        by (smt case_prod_conv fbspec fimageI fminusI fset_of_list_elem fset_rev_mp)
    next
      case 2
      then show ?case
        by (fastforce simp: list_all_iff ffUnion_alt_def fset_of_list_elem closed_except_def)
    qed
qed (auto simp: ffUnion_alt_def closed_except_def)

lemma closed_except_sabs:
  assumes "closed (Sabs cs)" "(pat, rhs) \<in> set cs"
  shows "closed_except rhs (frees pat)"
using assms unfolding closed_except_def
apply auto
by (metis bot.extremum_uniqueI fempty_iff ffUnion_subset_elem fimageI fminusI fset_of_list_elem old.prod.case)

instantiation sterm :: strong_term  begin

fun wellformed_sterm :: "sterm \<Rightarrow> bool" where
"wellformed_sterm (t\<^sub>1 $\<^sub>s t\<^sub>2) \<longleftrightarrow> wellformed_sterm t\<^sub>1 \<and> wellformed_sterm t\<^sub>2" |
"wellformed_sterm (Sabs cs) \<longleftrightarrow> list_all (\<lambda>(pat, t). linear pat \<and> wellformed_sterm t) cs \<and> distinct (map fst cs) \<and> cs \<noteq> []" |
"wellformed_sterm _ \<longleftrightarrow> True"

primrec all_frees_sterm :: "sterm \<Rightarrow> name fset" where
"all_frees_sterm (Svar x) = {|x|}" |
"all_frees_sterm (t\<^sub>1 $\<^sub>s t\<^sub>2) = all_frees_sterm t\<^sub>1 |\<union>| all_frees_sterm t\<^sub>2" |
"all_frees_sterm (Sabs cs) = ffUnion (fset_of_list (map (\<lambda>(P, T). P |\<union>| T) (map (map_prod frees all_frees_sterm) cs)))" |
"all_frees_sterm (Sconst _) = {||}"

instance proof (standard, goal_cases)
  case (7 t)
  show ?case
    apply (intro abs_pred_stermI allI impI)
    apply simp
    apply (rule ffUnion_least)
    apply (rule fBallI)
    apply auto
    apply (subst ffUnion_alt_def)
    apply simp
    apply (rule_tac x = "(a, b)" in fBexI)
    by (auto simp: fset_of_list_elem)
next
  case (8 t)
  show ?case
    apply (intro abs_pred_stermI allI impI)
    apply (simp add: list.pred_map comp_def case_prod_twice, safe)
    subgoal
      apply (subst list_all_iff)
      apply (rule ballI)
      apply safe[1]
       apply (fastforce simp: list_all_iff)
      subgoal premises prems[rule_format]
        apply (rule prems)
          apply (fact prems)
        using prems apply (fastforce simp: list_all_iff)
        using prems by force
      done
    subgoal
      apply (subst map_cong[OF refl])
      by auto
    done
qed (auto simp: const_sterm_def free_sterm_def app_sterm_def)

end

lemma match_sabs[simp]: "\<not> is_free t \<Longrightarrow> match t (Sabs cs) = None"
by (cases t) auto

context pre_constants begin

lemma welldefined_sabs: "welldefined (Sabs cs) \<longleftrightarrow> list_all (\<lambda>(_, t). welldefined t) cs"
apply (auto simp: list_all_iff ffUnion_alt_def dest!: ffUnion_least_rev)
 apply (subst (asm) list_all_iff_fset[symmetric])
 apply (auto simp: list_all_iff fset_of_list_elem)
done

lemma shadows_consts_sterm_simps[simp]:
  "shadows_consts (t\<^sub>1 $\<^sub>s t\<^sub>2) \<longleftrightarrow> shadows_consts t\<^sub>1 \<or> shadows_consts t\<^sub>2"
  "shadows_consts (Svar name) \<longleftrightarrow> name |\<in>| all_consts"
  "shadows_consts (Sabs cs) \<longleftrightarrow> list_ex (\<lambda>(pat, t). \<not> fdisjnt all_consts (frees pat) \<or> shadows_consts t) cs"
  "shadows_consts (Sconst name) \<longleftrightarrow> False"
proof (goal_cases)
  case 3
  show ?case
    unfolding shadows_consts_def list_ex_iff
    apply rule
    subgoal
      by (force simp: ffUnion_alt_def fset_of_list_elem fdisjnt_alt_def elim!: ballE)
    subgoal
      apply (auto simp: fset_of_list_elem fdisjnt_alt_def)
      by (auto simp: fset_eq_empty_iff ffUnion_alt_def fset_of_list_elem elim!: allE fBallE)
    done
qed (auto simp: shadows_consts_def fdisjnt_alt_def)

(* FIXME derive from axioms? *)
lemma subst_shadows:
  assumes "\<not> shadows_consts (t::sterm)" "not_shadows_consts_env \<Gamma>"
  shows "\<not> shadows_consts (subst t \<Gamma>)"
using assms proof (induction t arbitrary: \<Gamma> rule: sterm_induct)
  case (Sabs cs)
  show ?case
    apply (simp add: list_ex_iff case_prod_twice)
    apply (rule ballI)
    subgoal for c
      apply (cases c, hypsubst_thin, simp)
      apply (rule conjI)
      subgoal using Sabs(2) by (fastforce simp: list_ex_iff)
      apply (rule Sabs(1))
        apply assumption
      subgoal using Sabs(2) by (fastforce simp: list_ex_iff)
      subgoal using Sabs(3) by force
      done
    done
qed (auto split: option.splits)

end

end


           (*-------------------------------------------*
            |        CSP-Prover on Isabelle2005         |
            |                January 2006               |
            |                                           |
            |        CSP-Prover on Isabelle2009         |
            |                   June 2009  (modified)   |
            |                                           |
            |        Yoshinao Isobe (AIST JAPAN)        |
            *-------------------------------------------*)

theory Infra_HOL
imports Infra_common
begin

(*--------------------------*
 |  exchange order in ALL   |
 *--------------------------*)

lemma exchange_forall_orderE:
  "[| ALL x y. P x y ; ALL y x. P x y ==> R |] ==> R"
by (simp)

lemma exchange_forall_order3E:
  "[| ALL x y z. P x y z ; ALL y z x. P x y z ==> R |] ==> R"
by (simp)

lemma exchange_ALL_BALL:
   "(ALL x:X. ALL y. P x y) = (ALL y. ALL x:X. P x y)"
apply (auto)
done

lemma ALL_BALL_fun:
   "(ALL y. ALL x:X. P x y) = (ALL f. ALL x:X. P x (f x))"
apply (auto)
done

lemma ALL_BALL_funE:
   "[| ALL y. ALL x:X. P x y ; (ALL f. ALL x:X. P x (f x)) ==> S |] ==> S"
apply (auto)
done

(*-------------------------------*
 |  distribution of ALL on conj  |
 *-------------------------------*)

lemma dist_ALL_conjI:
  "ALL x. (P x & Q x) ==> (ALL x. P x) & (ALL x. Q x)"
by (simp)

lemma dist_ALL_conjE:
  "[| ALL x. (P x & Q x) ; [| ALL x. P x ; ALL x. Q x |] ==> R |] ==> R"
by (simp)

lemma dist_ALL_conj: "(ALL x. P x & Q x) = ((ALL x. P x) & (ALL x. Q x)) "
by (auto)

lemma dist_ALL_conj2I:
  "ALL x y. (P x y & Q x y) ==> (ALL x y. P x y) & (ALL x y. Q x y)"
by (simp)

lemma dist_ALL_conj2E:
  "[| ALL x y. (P x y & Q x y) ; [| ALL x y. P x y ; ALL x y. Q x y |] ==> R |] ==> R"
by (simp)

lemma dist_ALL_conj2: "(ALL x y. P x y & Q x y) = ((ALL x y. P x y) & (ALL x y. Q x y)) "
by (auto)

(* BALL *)

lemma dist_BALL_conjI:
  "ALL x:X. (P x & Q x) ==> (ALL x:X. P x) & (ALL x:X. Q x)"
by (simp)

lemma dist_BALL_conjE:
  "[| ALL x:X. (P x & Q x) ;
      [| ALL x:X. P x ; ALL x:X. Q x |] ==> S
   |] ==> S"
by (simp)

lemma dist_BALL_conj2I:
  "ALL x:X. ALL y:(Y x). (P x y & Q x y) ==>
   (ALL x:X. ALL y:(Y x). P x y) &
   (ALL x:X. ALL y:(Y x). Q x y)"
by (simp)

lemma dist_BALL_conj2E:
  "[| ALL x:X. ALL y:(Y x). (P x y & Q x y) ;
      [| ALL x:X. ALL y:(Y x). P x y ;
         ALL x:X. ALL y:(Y x). Q x y |] ==> S
   |] ==> S"
by (simp)

lemma dist_ALL_imply_conjE:
  "(ALL x. (b x) --> (P x & Q x))
   = ((ALL x. (b x) --> P x) & (ALL x. (b x) --> Q x))"
apply (auto)
done

(*****************************************************
                   ALL EX --> EX ALL
 *****************************************************)

(*** ALL ***)

lemma choice_ALL_EX_only_if:
  "ALL P. (ALL x. EX y. P x y) --> (EX f. ALL x. P x (f x))"
apply (intro allI impI)
apply (rule_tac x="(%x. SOME y. P x y)" in exI)
apply (rule allI)
apply (drule_tac x="x" in spec)
apply (erule exE)
apply (rule someI2)
apply (simp)
apply (simp)
done

lemma choice_ALL_EX:
  "(ALL x. EX y. P x y) = (EX f. ALL x. P x (f x))"
apply (rule)
apply (simp add: choice_ALL_EX_only_if)
apply (elim exE)
apply (rule allI)
apply (drule_tac x="x" in spec)
apply (rule_tac x="f x" in exI)
apply (simp)
done

(*** imply ***)

lemma choice_ALL_imply_EX_only_if:
  "ALL b P. (ALL x. (b x) --> (EX y. P x y)) --> (EX f. ALL x. (b x) --> P x (f x))"
apply (intro allI impI)
apply (rule_tac x="(%x. if (b x) then (SOME y. P x y) else (SOME y. True))" in exI)
apply (rule allI)
apply (drule_tac x="x" in spec)
apply (intro impI)
apply (simp)
apply (erule exE)
apply (rule someI2)
apply (simp)
apply (simp)
done

lemma choice_ALL_imply_EX:
  "(ALL x. (b x) --> (EX y. P x y)) = (EX f. ALL x. (b x) --> P x (f x))"
apply (rule)
apply (simp add: choice_ALL_imply_EX_only_if)
apply (elim exE)
apply (rule allI)
apply (drule_tac x="x" in spec)
apply (intro impI)
apply (rule_tac x="f x" in exI)
apply (simp)
done

(*** BALL ***)

lemma choice_BALL_EX:
  "(ALL x:X. EX y. P x y) = (EX f. ALL x:X. P x (f x))"
apply (simp add: Ball_def)
apply (simp add: choice_ALL_imply_EX)
done

(*****************************************************
                        EX!
 *****************************************************)

lemma ex1_implies_exE:
  "[| EX! x. P x ; EX x. P x ==> S |] ==> S"
by (auto)

(*** 1 ***)

lemma EX1_1I:
    "((EX X1. P X1 & (ALL Y1. P Y1 --> (Y1 = X1))))
 ==> (EX! X1. P X1)"
apply (simp add: Ex1_def)
done

(*** 2 ***)

lemma EX1_2I:
   "(EX X1 X2. P X1 X2 & (ALL Y1 Y2. P Y1 Y2 --> ((Y1 = X1) & (Y2 = X2))))
    ==> (EX! X1. EX! X2. P X1 X2)"
(* modified syntax for Isabelle 2017 *)
apply (simp add: Ex1_def)
apply (auto)
done

(*** 3 ***)

lemma EX1_3I:
   "(EX X1 X2 X3. P X1 X2 X3 &
   (ALL Y1 Y2 Y3. P Y1 Y2 Y3 --> ((Y1 = X1) & (Y2 = X2) & (Y3 = X3))))
    ==> (EX! X1. EX! X2. EX! X3. P X1 X2 X3)"
apply (rule EX1_2I)
apply (elim conjE exE)
apply (rule_tac x="X1" in exI)
apply (rule_tac x="X2" in exI)
apply (rule conjI)
apply (rule EX1_1I)
apply (rule_tac x="X3" in exI)

apply (rule conjI)
apply (assumption)
apply (intro allI impI)
apply (drule_tac x="X1" in spec)
apply (drule_tac x="X2" in spec)
apply (drule_tac x="Y1" in spec)
apply (simp)

apply (intro allI impI)
apply (erule ex1E)
apply (drule_tac x="Y1" in spec)
apply (drule_tac x="Y2" in spec)
apply (drule_tac x="X3a" in spec)
apply (drule_tac x="X3a" in spec)
apply (simp)
done

(*** 4 ***)

lemma EX1_4I:
   "(EX X1 X2 X3 X4. P X1 X2 X3 X4 &
   (ALL Y1 Y2 Y3 Y4. P Y1 Y2 Y3 Y4
    --> ((Y1 = X1) & (Y2 = X2) & (Y3 = X3) & (Y4 = X4))))
    ==> (EX! X1. EX! X2. EX! X3. EX! X4. P X1 X2 X3 X4)"
apply (rule EX1_3I)
apply (elim conjE exE)
apply (rule_tac x="X1" in exI)
apply (rule_tac x="X2" in exI)
apply (rule_tac x="X3" in exI)
apply (rule conjI)
apply (rule EX1_1I)
apply (rule_tac x="X4" in exI)

apply (rule conjI)
apply (assumption)
apply (intro allI impI)
apply (drule_tac x="X1" in spec)
apply (drule_tac x="X2" in spec)
apply (drule_tac x="X3" in spec)
apply (drule_tac x="Y1" in spec)
apply (simp)

apply (intro allI impI)
apply (erule ex1E)
apply (drule_tac x="Y1" in spec)
apply (drule_tac x="Y2" in spec)
apply (drule_tac x="Y3" in spec)
apply (drule_tac x="X4a" in spec)
apply (drule_tac x="X4a" in spec)
apply (simp)
done

(*** 5 ***)

lemma EX1_5I:
   "(EX X1 X2 X3 X4 X5. P X1 X2 X3 X4 X5 &
   (ALL Y1 Y2 Y3 Y4 Y5. P Y1 Y2 Y3 Y4 Y5
    --> ((Y1 = X1) & (Y2 = X2) & (Y3 = X3) & (Y4 = X4) & (Y5 = X5))))
    ==> (EX! X1. EX! X2. EX! X3. EX! X4. EX! X5. P X1 X2 X3 X4 X5)"
apply (rule EX1_4I)
apply (elim conjE exE)
apply (rule_tac x="X1" in exI)
apply (rule_tac x="X2" in exI)
apply (rule_tac x="X3" in exI)
apply (rule_tac x="X4" in exI)
apply (rule conjI)
apply (rule EX1_1I)
apply (rule_tac x="X5" in exI)

apply (rule conjI)
apply (assumption)
apply (intro allI impI)
apply (drule_tac x="X1" in spec)
apply (drule_tac x="X2" in spec)
apply (drule_tac x="X3" in spec)
apply (drule_tac x="X4" in spec)
apply (drule_tac x="Y1" in spec)
apply (simp)

apply (intro allI impI)
apply (erule ex1E)
apply (drule_tac x="Y1" in spec)
apply (drule_tac x="Y2" in spec)
apply (drule_tac x="Y3" in spec)
apply (drule_tac x="Y4" in spec)
apply (drule_tac x="X5a" in spec)
apply (drule_tac x="X5a" in spec)
apply (simp)
done

(*** 6 ***)

lemma EX1_6I:
   "(EX X1 X2 X3 X4 X5 X6. P X1 X2 X3 X4 X5 X6 &
   (ALL Y1 Y2 Y3 Y4 Y5 Y6. P Y1 Y2 Y3 Y4 Y5 Y6
    --> ((Y1 = X1) & (Y2 = X2) & (Y3 = X3) &
         (Y4 = X4) & (Y5 = X5) & (Y6 = X6))))
    ==> (EX! X1. EX! X2. EX! X3. EX! X4. EX! X5. EX! X6.
         P X1 X2 X3 X4 X5 X6)"
apply (rule EX1_5I)
apply (elim conjE exE)
apply (rule_tac x="X1" in exI)
apply (rule_tac x="X2" in exI)
apply (rule_tac x="X3" in exI)
apply (rule_tac x="X4" in exI)
apply (rule_tac x="X5" in exI)
apply (rule conjI)
apply (rule EX1_1I)
apply (rule_tac x="X6" in exI)

apply (rule conjI)
apply (assumption)
apply (intro allI impI)
apply (drule_tac x="X1" in spec)
apply (drule_tac x="X2" in spec)
apply (drule_tac x="X3" in spec)
apply (drule_tac x="X4" in spec)
apply (drule_tac x="X5" in spec)
apply (drule_tac x="Y1" in spec)
apply (simp)

apply (intro allI impI)
apply (erule ex1E)
apply (drule_tac x="Y1" in spec)
apply (drule_tac x="Y2" in spec)
apply (drule_tac x="Y3" in spec)
apply (drule_tac x="Y4" in spec)
apply (drule_tac x="Y5" in spec)
apply (drule_tac x="X6a" in spec)
apply (drule_tac x="X6a" in spec)
apply (simp)
done

(* =================================================== *
 |             addition for CSP-Prover 5               |
 * =================================================== *)

(* -----------
      no eq
 * ----------- *)

lemma add_not_eq_sym_funE:
  "[| ALL x y. f x ~= g y ;
      [| (ALL x y. f x ~= g y) & (ALL x y. g x ~= f y) |] ==> R |]
   ==> R"
apply (auto)
apply (subgoal_tac "(ALL x y. f x ~= g y) = (ALL x y. g x ~= f y)")
apply (auto)
apply (rotate_tac -1)
apply (drule sym)
apply (simp)
done

lemma add_not_eq_sym_cons_funE:
  "[| ALL x. a ~= f x ;
      [| (ALL x. a ~= f x) & (ALL x. f x ~= a) |] ==> R |]
   ==> R"
by (auto)

lemma add_not_eq_sym_consE:
  "[| a ~= b ;
      [| a ~= b & b ~= a |] ==> R |]
   ==> R"
by (auto)

lemmas add_not_eq_symE =
       add_not_eq_sym_funE
       add_not_eq_sym_cons_funE
       add_not_eq_sym_consE

lemma not_eq_fun_range_Int:
  "(ALL x y. f x ~= g y) = (range f Int range g = {})"
by (auto)

lemma not_eq_fun_range_Int_only_if:
  "(ALL x y. f x ~= g y) ==> range f Int range g = {}"
by (auto)

lemma not_eq_fun_range_Int_if:
  "range f Int range g = {} ==> (ALL x y. f x ~= g y)"
by (auto)

end