(*  Title:       Category theory using Isar and Locales
    Author:      Greg O'Keefe, June, July, August 2003
    License: LGPL

Define homfunctors, prove that they are functors.
*)

header HomFunctors

theory HomFunctors
imports SetCat Functors
begin

locale into_set = two_cats AA BB
    for AA :: "('o,'a,'m)category_scheme" (structure)
    and BB (structure) +
  fixes U and Set
  defines "U \<equiv> (UNIV::'a set)"
  defines "Set \<equiv> set_cat U"
  assumes BB_Set: "BB = Set"
  fixes homf ("Hom'(_,'_')")
  defines "homf A \<equiv> \<lparr>
  om = (\<lambda>B\<in>Ob. Hom A B),
  am = (\<lambda>f\<in>Ar. \<lparr>set_dom=Hom A (Dom f),set_func=(\<lambda>g\<in>Hom A (Dom f). f \<bullet> g),set_cod=Hom A (Cod f)\<rparr>)
  \<rparr>"

lemma (in into_set) homf_preserves_objects:
 "Hom(A,_)\<^bsub>\<o>\<^esub> : Ob \<rightarrow> ob Set"
proof (rule funcsetI)
  fix B
  assume B: "B \<in> Ob"
  have "Hom(A,_)\<^bsub>\<o>\<^esub> B = Hom A B"
    using B by (simp add: homf_def)
  moreover have "\<dots> \<in> ob Set"
    by (simp add: U_def Set_def set_cat_def)
  ultimately show "Hom(A,_)\<^bsub>\<o>\<^esub> B \<in> ob Set" by simp
qed

lemma (in into_set) homf_preserves_dom:
  assumes f: "f \<in> Ar"
  shows "Hom(A,_)\<^bsub>\<o>\<^esub> (Dom f) = dom Set (Hom(A,_)\<^bsub>\<a>\<^esub> f)"
proof-
  have "Dom f \<in> Ob" using f ..
  hence 1: "Hom(A,_)\<^bsub>\<o>\<^esub> (Dom f) = Hom A (Dom f)"
    using f by (simp add: homf_def)
  have 2: "dom Set (Hom(A,_)\<^bsub>\<a>\<^esub> f) = Hom A (Dom f)"
    using f by (simp add: Set_def homf_def)
  from 1 and 2 show ?thesis by simp
qed

lemma (in into_set) homf_preserves_cod:
  assumes f: "f \<in> Ar"
  shows "Hom(A,_)\<^bsub>\<o>\<^esub> (Cod f) = cod Set (Hom(A,_)\<^bsub>\<a>\<^esub> f)"
proof-
  have "Cod f \<in> Ob" using f ..
  hence 1: "Hom(A,_)\<^bsub>\<o>\<^esub> (Cod f) = Hom A (Cod f)"
    using f by (simp add: homf_def)
  have 2: "cod Set (Hom(A,_)\<^bsub>\<a>\<^esub> f) = Hom A (Cod f)"
    using f by (simp add: Set_def homf_def)
  from 1 and 2 show ?thesis by simp
qed

lemma (in into_set) homf_preserves_id:
  assumes B: "B \<in> Ob"
  shows "Hom(A,_)\<^bsub>\<a>\<^esub> (Id B) = id Set (Hom(A,_)\<^bsub>\<o>\<^esub> B)"
proof-
  have 1: "Id B \<in> Ar" using B ..
  have 2: "Dom (Id B) = B"
    using B by (rule AA.id_dom_cod)
  have 3: "Cod (Id B) = B"
    using B by (rule AA.id_dom_cod)
  have 4: "(\<lambda>g\<in>Hom A B. (Id B) \<bullet> g) = (\<lambda>g\<in>Hom A B. g)"
    by (rule ext) (auto simp add: hom_def)
  have "Hom(A,_)\<^bsub>\<a>\<^esub> (Id B) = \<lparr>
    set_dom=Hom A B,
    set_func=(\<lambda>g\<in>Hom A B. g),
    set_cod=Hom A B\<rparr>"
    by (simp add: homf_def 1 2 3 4)
  also have "\<dots>= id Set (Hom(A,_)\<^bsub>\<o>\<^esub> B)"
    using B by (simp add: Set_def U_def set_cat_def set_id_def homf_def)
  finally show ?thesis .
qed

lemma (in into_set) homf_preserves_comp:
  assumes f: "f \<in> Ar"
    and g: "g \<in> Ar"
    and fg: "Cod f = Dom g"
  shows "Hom(A,_)\<^bsub>\<a>\<^esub> (g \<bullet> f) = (Hom(A,_)\<^bsub>\<a>\<^esub> g) \<odot> (Hom(A,_)\<^bsub>\<a>\<^esub> f)"
proof-
  have 1: "g \<bullet> f \<in> Ar" using assms ..
  have 2: "Dom (g \<bullet> f) = Dom f" using f g fg ..
  have 3: "Cod (g \<bullet> f) = Cod g" using f g fg ..
  have lhs: "Hom(A,_)\<^bsub>\<a>\<^esub> (g \<bullet> f) = \<lparr>
    set_dom=Hom A (Dom f),
    set_func=(\<lambda>h\<in>Hom A (Dom f). (g \<bullet> f) \<bullet> h),
    set_cod=Hom A (Cod g)\<rparr>"
    by (simp add: homf_def 1 2 3)
  have 4: "set_dom ((Hom(A,_)\<^bsub>\<a>\<^esub> g) \<odot> (Hom(A,_)\<^bsub>\<a>\<^esub> f)) = Hom A (Dom f)"
    using f by (simp add: set_comp_def homf_def)
  have 5: "set_cod ((Hom(A,_)\<^bsub>\<a>\<^esub> g) \<odot> (Hom(A,_)\<^bsub>\<a>\<^esub> f)) = Hom A (Cod g)"
    using g by (simp add: set_comp_def homf_def)
  have "set_func ((Hom(A,_)\<^bsub>\<a>\<^esub> g) \<odot> (Hom(A,_)\<^bsub>\<a>\<^esub> f))
      = compose (Hom A (Dom f)) (\<lambda>y\<in>Hom A (Dom g). g \<bullet> y) (\<lambda>x\<in>Hom A (Dom f). f \<bullet> x)"
    using f g by (simp add: set_comp_def homf_def)
  also have "\<dots> = (\<lambda>h\<in>Hom A (Dom f). (g \<bullet> f) \<bullet> h)"
  proof (
      rule extensionalityI,
      rule compose_extensional,
      rule restrict_extensional,
      simp)
    fix h
    assume 10: "h \<in> Hom A (Dom f)"
    hence 11: "f \<bullet> h \<in> Hom A (Dom g)"
    proof-
      from 10 have "h \<in> Ar" by (simp add: hom_def)
      have 100: "(op \<bullet>) : Hom (Dom f) (Dom g) \<rightarrow> Hom A (Dom f) \<rightarrow> Hom A (Dom g)"
        by (rule AA.comp_types)
      have "f \<in> Hom (Dom f) (Cod f)" using f by (simp add: hom_def)
      hence 101: "f \<in> Hom (Dom f) (Dom g)" using fg by simp
      from 100 and 101
      have "(op \<bullet>) f : Hom A (Dom f) \<rightarrow> Hom A (Dom g)"
        by (rule funcset_mem)
      from this and 10
      show "f \<bullet> h \<in> Hom A (Dom g)"
        by (rule funcset_mem)
    qed
    hence "Cod (f \<bullet> h) = Dom g"
      and "Dom (f \<bullet> h) = A"
      and "f \<bullet> h \<in> Ar"
      by (simp_all add: hom_def)
    thus "compose (Hom A (Dom f)) (\<lambda>y\<in>Hom A (Dom g). g \<bullet> y) (\<lambda>x\<in>Hom A (Dom f). f \<bullet> x) h =
        (g \<bullet> f) \<bullet> h"
      using f g fg 10 by (simp add: compose_def 10 11 hom_def)
  qed
  finally have 6: "set_func ((Hom(A,_)\<^bsub>\<a>\<^esub> g) \<odot> (Hom(A,_)\<^bsub>\<a>\<^esub> f))
    = (\<lambda>h\<in>Hom A (Dom f). (g \<bullet> f) \<bullet> h)" .
  from 4 and 5 and 6
  have rhs: "(Hom(A,_)\<^bsub>\<a>\<^esub> g) \<odot> (Hom(A,_)\<^bsub>\<a>\<^esub> f) = \<lparr>
    set_dom=Hom A (Dom f),
    set_func=(\<lambda>h\<in>Hom A (Dom f). (g \<bullet> f) \<bullet> h),
    set_cod=Hom A (Cod g)\<rparr>"
    by simp
  show ?thesis
    by (simp add: lhs rhs)
qed

theorem (in into_set) homf_into_set:
  "Functor Hom(A,_) : AA \<longrightarrow> Set"
proof (intro functor.intro functor_axioms.intro)
  show "Hom(A,_)\<^bsub>\<a>\<^esub> : Ar \<rightarrow> ar Set"
    by (rule homf_preserves_arrows)
  show "Hom(A,_)\<^bsub>\<o>\<^esub> : Ob \<rightarrow> ob Set"
    by (rule homf_preserves_objects)
  show "\<forall>f\<in>Ar. Hom(A,_)\<^bsub>\<o>\<^esub> (Dom f) = dom Set (Hom(A,_)\<^bsub>\<a>\<^esub> f)"
    by (intro ballI) (rule homf_preserves_dom)
  show "\<forall>f\<in>Ar. Hom(A,_)\<^bsub>\<o>\<^esub> (Cod f) = cod Set (Hom(A,_)\<^bsub>\<a>\<^esub> f)"
    by (intro ballI) (rule homf_preserves_cod)
  show "\<forall>B\<in>Ob. Hom(A,_)\<^bsub>\<a>\<^esub> (Id B) = id Set (Hom(A,_)\<^bsub>\<o>\<^esub> B)"
    by (intro ballI) (rule homf_preserves_id)
  show "\<forall>f\<in>Ar. \<forall>g\<in>Ar.
    Cod f = Dom g \<longrightarrow>
    Hom(A,_)\<^bsub>\<a>\<^esub> (g \<bullet> f) = comp Set (Hom(A,_)\<^bsub>\<a>\<^esub> g) (Hom(A,_)\<^bsub>\<a>\<^esub> f)"
    by (intro ballI impI, simp add: Set_def set_cat_def) (rule homf_preserves_comp)
  show "two_cats AA Set"
  proof intro_locales
    show "category Set"
      by (unfold Set_def, rule set_cat_cat)
  qed
qed

end


theory RecursiveFunctionsStudy
imports VDMToolkit
begin

function
  test :: "int \<Rightarrow> int \<Rightarrow> int"
  where
  "test 0 r = r"
| "test (n+1) r = test n (n + 1 + r)"
     apply (metis add.left_inverse group_cancel.add1 small_lazy'.cases verit_sum_simplify)
    apply force
   apply simp_all
  oops (* ah, negative case! *)
function
  test :: "int \<Rightarrow> int \<Rightarrow> int"
  where
  "test n r = r"
| "test (n+1) r = test n (n + 1 + r)"
     apply (meson surj_pair)
    apply fastforce
   apply simp_all
  oops (* still struggling *)

  print_quot_maps
  thm map_VDMToken_def map_pre_VDMToken_def
  print_quotients

(* Going to quotient type doesn't seem to be as useful *)
  thm Rep_Integ_def Abs_Integ_def

(* Perhaps with guards? *)
function
  test :: "int \<Rightarrow> int \<Rightarrow> int"
  where
  "n \<le> 0 \<Longrightarrow> test n r = r"
| "test (n+1) r = test n (n + 1 + r)"
  apply (metis add.left_commute add.left_inverse group_cancel.rule0 old.prod.exhaust)
    apply fastforce
   apply simp_all
  oops (* same story; go look into HOL theories *)

(* Surprisingly few definitions *)
function iterate_upto :: "(natural \<Rightarrow> 'a) \<Rightarrow> natural \<Rightarrow> natural \<Rightarrow> 'a Predicate.pred"
where
  "iterate_upto f n m =
    Predicate.Seq (%u. if n > m then Predicate.Empty
     else Predicate.Insert (f n) (iterate_upto f (n + 1) m))"
by pat_completeness auto

(* Seem to be prefereable to have if-then-else pattern ? *)
function around_zero :: "int \<Rightarrow> int list"
where
  "around_zero i = (if i < 0 then [] else (if i = 0 then [0] else around_zero (i - 1) @ [i, -i]))"
  by pat_completeness auto
termination by (relation "measure nat") auto

definition measureM :: "('a \<Rightarrow> nat) \<Rightarrow> ('a \<times> 'a) set"
  where "measureM = inv_image less_than"

lemma "measureM (\<lambda> a . a+1) = R"
  unfolding measureM_def
  unfolding less_than_def
  unfolding inv_image_def
  unfolding less_than_def pred_nat_def
  apply simp oops

term "(\<lambda> (n, r) . nat n)"
lemma "measure (\<lambda> (n, r) . nat n) = A" oops

(* testInt : nat * nat \<rightarrow> nat
   testInt(n,r) == if n = 0 then r else testInt(n-1, n+1+r)
   measure n;
 *)

function
  testInt :: "int \<Rightarrow> int \<Rightarrow> int"
  where
  "testInt n r = (if n \<le> 0 then r else testInt (n - 1) (n+1+r))"
  by pat_completeness auto
termination
  apply (relation "measure (\<lambda> (n, r) . nat n)")
   apply fastforce
  by simp

(* testSet : set of nat * nat \<rightarrow> nat
   testInt(s,r) == if s = {} then r else let x in set s in testInt(s \ {x}, x+r)
   measure card s;
 *)

function
  testSet :: "int set \<Rightarrow> int \<Rightarrow> int"
  where
  "testSet s r = (if s = {} then r else testSet (s - { x . x \<in> s }) (1+r))"
  by pat_completeness auto
termination
  apply (relation "measure (\<lambda> (s, r) . card s)")
   apply fastforce
  apply (simp add: card_gt_0_iff)
  oops
(* Will need a pretty involved pattern matching process; and in this one x is not part of the result!  *)

lemma l_insert_equals: "insert x xs = insert y ys \<Longrightarrow> xs \<union> {x} = ys \<union> {y}"
  by force

function
  f :: "VDMNat VDMSet \<Rightarrow> VDMNat"
  where
  "f {} = 0"
| "f (insert x s) = x + f s"
     apply (simp_all | blast)+
  oops

  term measures
function
  f :: "VDMNat VDMSet \<Rightarrow> VDMNat"
  where
  "f s = (if s = {} then 0 else (SOME r . r \<in> { x + f (s - {x}) | x . x \<in> s }))"
  by pat_completeness simp
termination

  apply (relation "measure (\<lambda> s . card s)")
   apply simp_all
  apply (subgoal_tac "xb \<in> s") oops

  term fold

function
  sum :: "nat set \<Rightarrow> nat"
  where
  "sum {} = 0"
| "x \<notin> s \<Longrightarrow> sum ({x} \<union> s) = x + (sum s)"
  oops
function
  f' :: "VDMNat VDMSet \<Rightarrow> VDMNat"
  where
  "f' {} = 0"
| "x \<notin> s \<Longrightarrow> f' ({x} \<union> s) = x + (f' s)"
     apply simp_all
   apply (metis equals0I mk_disjoint_insert)
  apply (elim equalityE, simp)
  apply safe
   apply (metis subset_antisym subset_insert)
  apply (case_tac "s = {}", simp_all)
  apply (case_tac "sa = {}", simp_all)
  unfolding insert_compr
  apply (elim subsetCE,simp_all)
     apply (meson all_not_in_conv mk_disjoint_insert)
    apply simp+
  oops

(*
g: set of nat \<rightarrow> nat
g(s) ==
  cases s:
    {} \<rightarrow> 0,
    {x} union xs \<rightarrow> x + g(xs)
  end
*)
function
  g :: "VDMNat VDMSet \<Rightarrow> VDMNat"
  where
  "g {} = 0"
| "g (insert x s) = (if x \<in> s then x + g(s - {x}) else x + g s)"
  apply blast
    apply simp
   apply force
  oops

function
  g :: "nat \<Rightarrow> VDMNat VDMSet \<Rightarrow> VDMNat"
where
  "g 0 s = 0"
| "g (Suc n) (insert v s) = v + (g n (s - {v}))"
     apply simp_all
  oops
end


           (*-------------------------------------------*
            |        CSP-Prover on Isabelle2004         |
            |                  April 2006               |
            |                  March 2007  (modified)   |
            |                                           |
            |        CSP-Prover on Isabelle2009         |
            |                   June 2009  (modified)   |
            |                October 2009  (modified)   |
            |                                           |
            |        Yoshinao Isobe (AIST JAPAN)        |
            *-------------------------------------------*)

theory CSP_F_law_etc
imports CSP_F_law_aux CSP_T_law_etc
begin

(*------------------------*
         |~| --> !!
 *------------------------*)

lemma cspF_Int_choice_to_Rep:
  "(P |~| Q) =F[M,M] (!nat n:{0, (Suc 0)} .. (IF (n = 0) THEN P ELSE Q))"
apply (rule cspF_rw_right)
apply (subgoal_tac
 "(!nat n:{0, (Suc 0)} .. IF (n = 0) THEN P ELSE Q) =F[M,M]
  (!nat n:({0} Un {(Suc 0)}) .. IF (n = 0) THEN P ELSE Q)")
apply (assumption)
apply (rule cspF_decompo)
apply (fast)
apply (simp)
apply (rule cspF_rw_right)
apply (rule cspF_Rep_int_choice_union_Int)
apply (rule cspF_decompo)

apply (rule cspF_rw_right)
apply (rule cspF_Rep_int_choice_singleton)
apply (simp)
apply (rule cspF_rw_right)
apply (rule cspF_IF)
apply (simp)

apply (rule cspF_rw_right)
apply (rule cspF_Rep_int_choice_singleton)
apply (simp)
apply (rule cspF_rw_right)
apply (rule cspF_IF)
apply (simp)
done

(*** cspF_Rep_int_choice_set_input ***)

lemma cspF_Rep_int_choice_sum_set_input:
  "!! c:C .. (!set X:(Xsf c) .. (? :X -> (Pff c)))
   =F[M,M] !set X:(Union {(Xsf c) |c. c : sumset C}) ..
          (? a:X -> (!! c:{c:C. EX X. X:(Xsf c) & a:X}s .. (Pff c a)))"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Rep_int_choice_sum_set_input)
apply (rule order_antisym)

(* <= *)
 apply (rule)
 apply (simp add: in_failures)
 apply (elim disjE conjE bexE exE)
 apply (simp_all)

  apply (rule_tac x="Xsf c" in exI)
  apply (rule conjI)
  apply (force)

  apply (rule_tac x="Xa" in bexI)
  apply (simp)
  apply (simp)

  apply (rule_tac x="Xsf c" in exI)
  apply (rule conjI)
  apply (force)
  apply (rule conjI)
  apply (force)
  apply (force)

(* => *)
 apply (rule)
 apply (simp add: in_failures)
 apply (elim disjE conjE exE bexE)
 apply (simp)
  apply (rule_tac x="c" in bexI)
  apply (rule_tac x="Xa" in bexI)
  apply (simp_all)

  apply (rule_tac x="ca" in bexI)
  apply (simp)
  apply (force)
  apply (simp)
done

lemma cspF_Rep_int_choice_set_input:
  "!nat n:N .. (!set X:(Xsf n) .. (? :X -> (Pff n)))
   =F[M,M] !set X:(Union {(Xsf n) |n. n : N}) ..
          (? a:X -> (!nat n:{n:N. EX X. X:(Xsf n) & a:X} .. (Pff n a)))"
apply (simp add: Rep_int_choice_nat_def)
apply (rule cspF_rw_left)
apply (rule cspF_Rep_int_choice_sum_set_input)
apply (rule cspF_decompo)
apply (force)
apply (simp)
done

(*** cspF_Rep_int_choice_set_set_DIV ***)

lemma cspF_Rep_int_choice_set_set_DIV:
  "[| Xs ~= {} ; Ys ~= {} |] ==>
   !set X:Xs .. (!set Y:Ys .. (? a:(X Un Y) -> DIV))
   =F[M,M] !set Z:{X Un Y |X Y. X:Xs & Y:Ys} .. (? a:Z -> DIV)"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Rep_int_choice_set_set_DIV)
apply (rule order_antisym)

(* <= *)
 apply (rule)
 apply (simp add: in_failures)
 apply (elim conjE bexE exE)
  apply (rule_tac x="Xa Un Xb" in exI)
  apply (force)

(* => *)
 apply (rule)
 apply (simp add: in_failures)
 apply (elim conjE bexE exE)
 apply (simp)

  apply (rule_tac x="Xb" in bexI)
  apply (rule_tac x="Y" in bexI)
  apply (simp_all)
done

(*********************************************************
               (P [+] SKIP) |~| (Q [+] SKIP)
 *********************************************************)

(* p.289 *)

lemma cspF_Int_choice_Ext_choice_SKIP:
  "(P [+] SKIP) |~| (Q [+] SKIP) =F[M,M] (P [+] Q [+] SKIP)"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Int_choice_Ext_choice_SKIP)
apply (rule order_antisym)

(* => *)
 apply (rule, simp add: in_traces in_failures)
 apply (force)

(* <= *)
 apply (rule, simp add: in_traces in_failures)
 apply (force)
done

(*********************************************************
               (P [+] DIV) |~| (Q [+] DIV)
 *********************************************************)

lemma cspF_Int_choice_Ext_choice_DIV:
  "(P [+] DIV) |~| (Q [+] DIV) =F[M,M] (P [+] Q [+] DIV)"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Int_choice_Ext_choice_DIV)
apply (rule order_antisym)

(* => *)
 apply (rule, simp add: in_traces in_failures)
 apply (force)

(* <= *)
 apply (rule, simp add: in_traces in_failures)
 apply (force)
done

(*********************************************************
             (P [+] SKIP) |~| (Q [+] DIV)
 *********************************************************)

lemma cspF_Int_choice_Ext_choice_SKIP_DIV:
  "(P [+] SKIP) |~| (Q [+] DIV) =F[M,M] (P [+] Q [+] SKIP)"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Int_choice_Ext_choice_SKIP_DIV)
apply (rule order_antisym)
apply (rule, simp add: in_traces in_failures, force)+
done

(*********************************************************
             (P [+] DIV) |~| (Q [+] SKIP)
 *********************************************************)

lemma cspF_Int_choice_Ext_choice_DIV_SKIP:
  "(P [+] DIV) |~| (Q [+] SKIP) =F[M,M] (P [+] Q [+] SKIP)"
apply (rule cspF_rw_left)
apply (rule cspF_commut)
apply (rule cspF_rw_left)
apply (rule cspF_Int_choice_Ext_choice_SKIP_DIV)
apply (rule cspF_rw_left)
apply (rule cspF_decompo)
apply (rule cspF_commut)
apply (rule cspF_reflex)
apply (rule cspF_reflex)
done

(*********************************************************
         (P [+] SKIP or DIV) |~| (Q [+] DIV or SKIP)
 *********************************************************)

lemma cspF_Int_choice_Ext_choice_SKIP_or_DIV:
  "[| P2 = SKIP | P2 = DIV ; Q2 = SKIP | Q2 = DIV |] ==>
   (P1 [+] P2) |~| (Q1 [+] Q2) =F[M,M] (P1 [+] Q1 [+] (P2 |~| Q2))"
apply (elim disjE)
apply (simp)
apply (rule cspF_rw_right)
apply (rule cspF_decompo)
apply (rule cspF_reflex)
apply (rule cspF_idem)
apply (simp add: cspF_Int_choice_Ext_choice_SKIP)

apply (simp)
apply (rule cspF_rw_right)
apply (rule cspF_decompo)
apply (rule cspF_reflex)
apply (rule cspF_unit)
apply (simp add: cspF_Int_choice_Ext_choice_SKIP_DIV)

apply (simp)
apply (rule cspF_rw_right)
apply (rule cspF_decompo)
apply (rule cspF_reflex)
apply (rule cspF_unit)
apply (simp add: cspF_Int_choice_Ext_choice_DIV_SKIP)

apply (simp)
apply (rule cspF_rw_right)
apply (rule cspF_decompo)
apply (rule cspF_reflex)
apply (rule cspF_unit)
apply (simp add: cspF_Int_choice_Ext_choice_DIV)
done

(*********************************************************
                    (P [+] DIV) |~| P
 *********************************************************)

lemma cspF_Ext_choice_DIV_Int_choice_Id:
  "(P [+] DIV) |~| P =F[M,M] P"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Ext_choice_DIV_Int_choice_Id)
apply (rule order_antisym)

(* => *)
 apply (rule, simp add: in_failures)
 apply (elim disjE conjE exE)
 apply (simp_all add: in_traces)
 apply (rule memF_F2)
 apply (rule proc_F4)
 apply (simp)
 apply (simp)
 apply (simp)

(* <= *)
 apply (rule, simp add: in_failures)
done

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

lemma cspF_Ext_pre_choice_Renaming_fun_step:
  "(? x:X -> Pf x)[[<rel> f]] =F[M,M]
   (? y:(f ` X) -> (! x:{x:X. y = f x} .. (Pf x[[<rel> f]])))"
apply (rule cspF_rw_left)
apply (rule cspF_step)

apply (rule cspF_decompo)
apply (simp add: fun_to_rel_def)
apply (force)

apply (rule cspF_decompo)
apply (simp add: fun_to_rel_def)
apply (force)
done

(* Act prefix event *)

lemma cspF_Act_prefix_Renaming_fun_step:
  "(a -> P)[[<rel> f]] =F[M,M] f(a) -> P[[<rel> f]]"
apply (rule cspF_rw_left)
apply (rule cspF_decompo)
apply (simp)
apply (rule cspF_step)

apply (rule cspF_rw_left)
apply (rule cspF_Ext_pre_choice_Renaming_fun_step)

apply (rule cspF_rw_right)
apply (rule cspF_step)

apply (rule cspF_decompo)
apply (simp)

apply (simp)
apply (subgoal_tac
  "{x. x = a & f a = f x}={a}")
apply (simp)
apply (rule cspF_rw_left)
apply (rule cspF_Rep_int_choice_const_com_rule)
apply (auto)
apply (rule cspF_rw_left)
apply (rule cspF_IF_split)
apply (auto)
done

lemmas cspF_Renaming_fun_step
     = cspF_Ext_pre_choice_Renaming_fun_step
       cspF_Act_prefix_Renaming_fun_step

(* -------- event -------- *)

(* <--> *)

lemma cspF_Act_prefix_Renaming1_event1_step_in:
  "(a -> P)[[a<-->b]] =F[M,M] b -> P[[a<-->b]]"
apply (simp add: Renaming_event_def Renaming_event_fun_def)
by (rule cspF_rw_left, rule cspF_Act_prefix_Renaming_fun_step, auto)

lemma cspF_Act_prefix_Renaming1_event2_step_in:
  "(a -> P)[[b<-->a]] =F[M,M] b -> P[[b<-->a]]"
by (simp add: cspF_Act_prefix_Renaming1_event1_step_in Renaming_commut)

lemma cspF_Act_prefix_Renaming1_event_step_notin:
  "[| a ~= c ; b ~= c |] ==> (c -> P)[[a<-->b]] =F[M,M] c -> P[[a<-->b]]"
apply (simp add: Renaming_event_def Renaming_event_fun_def)
by (rule cspF_rw_left, rule cspF_Act_prefix_Renaming_fun_step, auto)

lemmas cspF_Act_prefix_Renaming1_event_step =
       cspF_Act_prefix_Renaming1_event1_step_in
       cspF_Act_prefix_Renaming1_event2_step_in
       cspF_Act_prefix_Renaming1_event_step_notin

(* <<- *)

lemma cspF_Act_prefix_Renaming2_set_event_step_in:
  "a:A ==> (a -> P)[[A<<-b]] =F[M,M] b -> P[[A<<-b]]"
apply (simp add: Renaming_event_def Renaming_event_fun_def)
by (rule cspF_rw_left, rule cspF_Act_prefix_Renaming_fun_step, auto)

lemma cspF_Act_prefix_Renaming2_set_event_step_notin:
  "c~:A ==> (c -> P)[[A<<-b]] =F[M,M] c -> P[[A<<-b]]"
apply (simp add: Renaming_event_def Renaming_event_fun_def)
by (rule cspF_rw_left, rule cspF_Act_prefix_Renaming_fun_step, auto)

lemma cspF_Act_prefix_Renaming2_set_event_step:
  "(a -> P)[[A<<-b]] =F[M,M]
   IF (a:A) THEN (b -> P[[A<<-b]])
            ELSE (a -> P[[A<<-b]])"
apply (case_tac "a:A")
apply (rule cspF_rw_left)
apply (rule cspF_Act_prefix_Renaming2_set_event_step_in)
apply (simp)
apply (rule cspF_rw_right)
apply (rule cspF_IF_split)
apply (simp)
apply (rule cspF_rw_left)
apply (rule cspF_Act_prefix_Renaming2_set_event_step_notin)
apply (simp)
apply (rule cspF_rw_right)
apply (rule cspF_IF_split)
apply (simp)
done

lemmas cspF_Act_prefix_Renaming2_set_event_steps =
       cspF_Act_prefix_Renaming2_set_event_step_in
       cspF_Act_prefix_Renaming2_set_event_step_notin

(* <-- *)

lemma cspF_Act_prefix_Renaming2_event_step_in:
  "(a -> P)[[a<--b]] =F[M,M] b -> P[[a<--b]]"
by (simp add: cspF_Act_prefix_Renaming2_set_event_step_in)

lemma cspF_Act_prefix_Renaming2_event_step_notin:
  "a ~= c ==> (c -> P)[[a<--b]] =F[M,M] c -> P[[a<--b]]"
by (simp add: cspF_Act_prefix_Renaming2_set_event_step_notin)

lemmas cspF_Act_prefix_Renaming2_event_step =
       cspF_Act_prefix_Renaming2_event_step_in
       cspF_Act_prefix_Renaming2_event_step_notin

lemmas cspF_Act_prefix_Renaming_event_step =
       cspF_Act_prefix_Renaming1_event_step
       cspF_Act_prefix_Renaming2_event_step

(* -------- channel -------- *)

(* Act prefix channel *)

(* <==> *)

lemma cspF_Act_prefix_Renaming1_channel1_step_in:
  "[| inj f ; ALL x y. f x ~= g y |]
   ==> (f v -> P)[[f<==>g]] =F[M,M] g v -> P[[f<==>g]]"
apply (simp add: Renaming_channel_fun_def Renaming_channel_def)
by (rule cspF_rw_left, rule cspF_Act_prefix_Renaming_fun_step, auto)

lemma cspF_Act_prefix_Renaming1_channel2_step_in:
  "[| inj f ; ALL x y. f x ~= g y |]
   ==> (f v -> P)[[g<==>f]] =F[M,M] g v -> P[[g<==>f]]"
by (simp add: Renaming_commut cspF_Act_prefix_Renaming1_channel1_step_in)

lemma cspF_Act_prefix_Renaming1_channel_step_notin:
  "[| (ALL x. a ~= f x) | a ~: range f ;
      (ALL x. a ~= g x) | a ~: range g |]
   ==> (a -> P)[[f<==>g]] =F[M,M] a -> P[[f<==>g]]"
apply (simp add: Renaming_channel_fun_def Renaming_channel_def)
by (rule cspF_rw_left, rule cspF_Act_prefix_Renaming_fun_step, auto)

lemmas cspF_Act_prefix_Renaming1_channel_step =
       cspF_Act_prefix_Renaming1_channel1_step_in
       cspF_Act_prefix_Renaming1_channel2_step_in
       cspF_Act_prefix_Renaming1_channel_step_notin

(* <== *)

lemma cspF_Act_prefix_Renaming2_channel_step_in:
  "[| inj f ; ALL x y. f x ~= g y |]
   ==> (f v -> P)[[f<==g]] =F[M,M] g v -> P[[f<==g]]"
apply (simp add: Renaming_channel_fun_def Renaming_channel_def)
by (rule cspF_rw_left, rule cspF_Act_prefix_Renaming_fun_step, auto)

lemma cspF_Act_prefix_Renaming2_channel_step_notin:
  "[| (ALL x. a ~= f x) | a ~: range f |]
   ==> (a -> P)[[f<==g]] =F[M,M] a -> P[[f<==g]]"
apply (simp add: Renaming_channel_fun_def Renaming_channel_def)
by (rule cspF_rw_left, rule cspF_Act_prefix_Renaming_fun_step, auto)

lemmas cspF_Act_prefix_Renaming2_channel_step =
       cspF_Act_prefix_Renaming2_channel_step_in
       cspF_Act_prefix_Renaming2_channel_step_notin

lemmas cspF_Act_prefix_Renaming_channel_step =
       cspF_Act_prefix_Renaming1_channel_step
       cspF_Act_prefix_Renaming2_channel_step

(* -------*)

lemmas cspF_Act_prefix_Renaming_step =
       cspF_Act_prefix_Renaming_fun_step
       cspF_Act_prefix_Renaming_event_step
       cspF_Act_prefix_Renaming_channel_step

(* --- Ext_pre_choice_Renaming_even --- *)

(* <--> *)

lemma cspF_Ext_pre_choice_Renaming1_event1_step:
  "a ~= b ==>
     (? x:X -> Pf x)[[a<-->b]] =F[M,M]
     (IF (a:X) THEN (b -> (Pf a)[[a<-->b]]) ELSE STOP) [+]
     (IF (b:X) THEN (a -> (Pf b)[[a<-->b]]) ELSE STOP) [+]
      (? x:(X - {a,b}) -> (Pf x)[[a<-->b]])"
apply (rule cspF_rw_left)
apply (simp add: Renaming_event_def)
apply (rule cspF_Renaming_fun_step)
apply (fold Renaming_event_def)

apply (case_tac "a:X")
 apply (case_tac "b:X")
  apply (simp)
  apply (rule cspF_rw_right)
  apply (rule cspF_decompo)
  apply (rule cspF_decompo)
  apply (rule cspF_IF_split)
  apply (rule cspF_IF_split)
  apply (rule cspF_reflex)
  apply (simp)

  apply (rule cspF_rw_right)
  apply (rule cspF_decompo)
  apply (rule cspF_decompo)
  apply (rule cspF_step)
  apply (rule cspF_step)
  apply (rule cspF_reflex)

  apply (rule cspF_rw_right)
  apply (rule cspF_decompo)
  apply (rule cspF_step)
  apply (rule cspF_reflex)

  apply (rule cspF_rw_right)
  apply (rule cspF_step)
  apply (simp)

  apply (rule cspF_decompo)
  apply (simp add: image_def Renaming_event_fun_def)
  apply (force)

  apply (simp)

   apply (case_tac "aa = a")
   apply (simp)
   apply ((rule cspF_rw_right, rule cspF_IF_split | rule cspF_decompo)| simp)+
   apply (simp add: image_def Renaming_event_fun_def)
   apply (rule cspF_rw_left)
   apply (rule cspF_Rep_int_choice_singleton)
   apply (simp)

   apply (case_tac "aa = b")
   apply (simp)
   apply ((rule cspF_rw_right, rule cspF_IF_split | rule cspF_decompo)| simp)+
   apply (simp add: image_def Renaming_event_fun_def)
   apply (subgoal_tac "{x. x ~= b & (x ~= b --> x = a)}={a}")
   apply (simp)
   apply (rule cspF_Rep_int_choice_singleton)
   apply (force)

   (* etc *)
   apply (simp)
   apply ((rule cspF_rw_right, rule cspF_IF_split | rule cspF_decompo)| simp)+
   apply (simp add: image_def Renaming_event_fun_def)
   apply (subgoal_tac
     "{x. x ~= b & (x ~= b --> x ~= a & (x ~= a --> x : X & aa = x))}={aa}")
   apply (simp)
   apply (rule cspF_Rep_int_choice_singleton)
   apply (force)

 (* b~:X *)
  apply (simp)
  apply (rule cspF_rw_right)
  apply (rule cspF_decompo)
  apply (rule cspF_decompo)
  apply (rule cspF_IF_split)
  apply (rule cspF_IF_split)
  apply (rule cspF_reflex)
  apply (simp)

  apply (rule cspF_rw_right)
  apply (rule cspF_decompo)
  apply (rule cspF_decompo)
  apply (rule cspF_step)
  apply (rule cspF_step)
  apply (rule cspF_reflex)

  apply (rule cspF_rw_right)
  apply (rule cspF_decompo)
  apply (rule cspF_step)
  apply (rule cspF_reflex)
  apply (simp)

  apply (rule cspF_rw_right)
  apply (rule cspF_step)
  apply (simp)

  apply (rule cspF_decompo)
  apply (simp add: image_def Renaming_event_fun_def)
  apply (force)

  apply (simp)

   apply (case_tac "aa = b")
   apply (simp)
   apply ((rule cspF_rw_right, rule cspF_IF_split | rule cspF_decompo)| simp)+
   apply (simp add: image_def Renaming_event_fun_def)
   apply (subgoal_tac "{x. x ~= b & (x ~= b --> x = a)}={a}")
   apply (simp)
   apply (rule cspF_Rep_int_choice_singleton)
   apply (force)

   apply (simp)
   apply ((rule cspF_rw_right, rule cspF_IF_split | rule cspF_decompo)| simp)+
   apply (simp add: image_def Renaming_event_fun_def)
   apply (subgoal_tac
   "{x. x ~= b & (x ~= b --> x ~= a & (x ~= a --> x : X & aa = x))} = {aa}")
   apply (simp)
   apply (rule cspF_Rep_int_choice_singleton)
   apply (force)

(* a~:X *)
 apply (case_tac "b:X")

  apply (simp)
  apply (rule cspF_rw_right)
  apply (rule cspF_decompo)
  apply (rule cspF_decompo)
  apply (rule cspF_IF_split)
  apply (rule cspF_IF_split)
  apply (rule cspF_reflex)
  apply (simp)

  apply (rule cspF_rw_right)
  apply (rule cspF_decompo)
  apply (rule cspF_decompo)
  apply (rule cspF_step)
  apply (rule cspF_step)
  apply (rule cspF_reflex)

  apply (rule cspF_rw_right)
  apply (rule cspF_decompo)
  apply (rule cspF_step)
  apply (rule cspF_reflex)
  apply (simp)

  apply (rule cspF_rw_right)
  apply (rule cspF_step)
  apply (simp)

  apply (rule cspF_decompo)
  apply (simp add: image_def Renaming_event_fun_def)
  apply (force)

  apply (simp)

   apply (case_tac "aa = a")
   apply (simp)
   apply ((rule cspF_rw_right, rule cspF_IF_split | rule cspF_decompo)| simp)+
   apply (simp add: image_def Renaming_event_fun_def)
   apply (rule cspF_Rep_int_choice_singleton)

   apply (simp)
   apply ((rule cspF_rw_right, rule cspF_IF_split | rule cspF_decompo)| simp)+
   apply (simp add: image_def Renaming_event_fun_def)
   apply (subgoal_tac
   "{x. x ~= b & (x ~= b --> x ~= a & (x ~= a --> x : X & aa = x))} = {aa}")
   apply (simp)
   apply (rule cspF_Rep_int_choice_singleton)
   apply (force)

 (* b~:X *)
  apply (simp)
  apply (rule cspF_rw_right)
  apply (rule cspF_decompo)
  apply (rule cspF_decompo)
  apply (rule cspF_IF_split)
  apply (rule cspF_IF_split)
  apply (rule cspF_reflex)
  apply (simp)

  apply (rule cspF_rw_right)
  apply (rule cspF_decompo)
  apply (rule cspF_decompo)
  apply (rule cspF_step)
  apply (rule cspF_step)
  apply (rule cspF_reflex)

  apply (rule cspF_rw_right)
  apply (rule cspF_decompo)
  apply (rule cspF_step)
  apply (rule cspF_reflex)
  apply (simp)

  apply (rule cspF_rw_right)
  apply (rule cspF_step)
  apply (simp)

  apply (rule cspF_decompo)
  apply (simp add: image_def Renaming_event_fun_def)
  apply (force)

   apply ((rule cspF_rw_right, rule cspF_IF_split | rule cspF_decompo)| simp)+
   apply (simp add: image_def Renaming_event_fun_def)
   apply (subgoal_tac
   "{x. x ~= b & (x ~= b --> x ~= a & (x ~= a --> x : X & aa = x))} = {aa}")
   apply (simp)
   apply (rule cspF_Rep_int_choice_singleton)
   apply (force)
done

lemma cspF_Ext_pre_choice_Renaming1_event2_step:
  "a = b ==>
     (? x:X -> Pf x)[[a<-->b]] =F[M,M]
     (IF (a:X) THEN (b -> (Pf a)[[a<-->b]]) ELSE STOP) [+]
     (IF (b:X) THEN (a -> (Pf b)[[a<-->b]]) ELSE STOP) [+]
      (? x:(X - {a,b}) -> (Pf x)[[a<-->b]])"
apply (simp)
apply (rule cspF_rw_left)
apply (simp add: Renaming_event_def)
apply (rule cspF_Renaming_fun_step)
apply (fold Renaming_event_def)

apply (rule cspF_rw_right)
apply (rule cspF_decompo)
apply (rule cspF_idem)
apply (rule cspF_reflex)

 apply (case_tac "b:X")
  apply (simp)
  apply (rule cspF_rw_right)
  apply (rule cspF_decompo)
  apply (rule cspF_IF_split)
  apply (rule cspF_reflex)
  apply (simp)

  apply (rule cspF_rw_right)
  apply (rule cspF_decompo)
  apply (rule cspF_step)
  apply (rule cspF_reflex)

  apply (rule cspF_rw_right)
  apply (rule cspF_step)
  apply (simp)

  apply (rule cspF_decompo)
  apply (simp add: image_def Renaming_event_fun_def)
  apply (force)

  apply (simp)

   apply (case_tac "aa = b")
   apply (simp)
   apply ((rule cspF_rw_right, rule cspF_IF_split | rule cspF_decompo)| simp)+
   apply (simp add: image_def Renaming_event_fun_def)
   apply (rule cspF_Rep_int_choice_singleton)

   apply (simp)
   apply ((rule cspF_rw_right, rule cspF_IF_split | rule cspF_decompo)| simp)+
   apply (simp add: image_def Renaming_event_fun_def)
   apply (subgoal_tac
     "{x. x ~= b & (x ~= b --> x ~= a & (x ~= a --> x : X & aa = x))}={aa}")
   apply (simp)
   apply (rule cspF_Rep_int_choice_singleton)
   apply (force)

 (* b~:X *)
  apply (simp)
  apply (rule cspF_rw_right)
  apply (rule cspF_decompo)
  apply (rule cspF_IF_split)
  apply (rule cspF_reflex)
  apply (simp)

  apply (rule cspF_rw_right)
  apply (rule cspF_decompo)
  apply (rule cspF_step)
  apply (rule cspF_reflex)

  apply (rule cspF_rw_right)
  apply (rule cspF_step)
  apply (simp)

  apply (rule cspF_decompo)
  apply (simp add: image_def Renaming_event_fun_def)
  apply (force)

   apply ((rule cspF_rw_right, rule cspF_IF_split | rule cspF_decompo)| simp)+
   apply (simp add: image_def Renaming_event_fun_def)
   apply (subgoal_tac
   "{x. x ~= b & (x ~= b --> x ~= a & (x ~= a --> x : X & aa = x))} = {aa}")
   apply (simp)
   apply (rule cspF_Rep_int_choice_singleton)
   apply (force)
done

lemma cspF_Ext_pre_choice_Renaming1_event_step:
  "(? x:X -> Pf x)[[a<-->b]] =F[M,M]
     (IF (a:X) THEN (b -> (Pf a)[[a<-->b]]) ELSE STOP) [+]
     (IF (b:X) THEN (a -> (Pf b)[[a<-->b]]) ELSE STOP) [+]
      (? x:(X - {a,b}) -> (Pf x)[[a<-->b]])"
apply (case_tac "a=b")
apply (rule cspF_Ext_pre_choice_Renaming1_event2_step)
apply (simp_all)
apply (rule cspF_Ext_pre_choice_Renaming1_event1_step)
apply (simp_all)
done

(* <<- *)

lemma cspF_Ext_pre_choice_Renaming2_set_event_step_in:
  "X Int A ~= {} ==>
     (? x:X -> Pf x)[[A<<-a]] =F[M,M]
      a -> (! x:(X Int A) .. (Pf x)[[A<<-a]])
     [+] ? x:(X-A) -> (Pf x)[[A<<-a]]"
apply (rule cspF_rw_left)
apply (simp add: Renaming_event_def)
apply (rule cspF_Renaming_fun_step)
apply (fold Renaming_event_def)
apply (simp add: image_def)

apply (rule cspF_rw_right)
apply (rule cspF_decompo)
apply (rule cspF_step)
apply (rule cspF_reflex)
apply (rule cspF_rw_right)
apply (rule cspF_step)

apply (rule cspF_decompo)
apply (simp add: Renaming_event_fun_def)
apply (blast)

apply (simp)

apply (case_tac "aa = a")
 apply (simp)
 apply (case_tac "a : X & a ~: A")
  apply (simp)
  apply (rule cspF_rw_right)
  apply (rule cspF_IF_split)
  apply (simp)
  apply (rule cspF_ref_eq)

  (* <= *)
  apply (rule cspF_Int_choice_right)
   apply (rule cspF_Rep_int_choice_right)
   apply (simp)
   apply (rule cspF_Rep_int_choice_left)
   apply (rule_tac x="aaa" in exI)
   apply (simp)
   apply (simp add: Renaming_event_fun_def)

   apply (rule cspF_Rep_int_choice_left)
   apply (rule_tac x="a" in exI)
   apply (simp)
   apply (simp add: Renaming_event_fun_def)

  (* => *)
   apply (rule cspF_Rep_int_choice_right)
   apply (simp)
   apply (elim conjE bexE)
   apply (simp add: Renaming_event_fun_def)
   apply (case_tac "aaa : A")

    apply (simp)
    apply (rule cspF_Int_choice_left1)
    apply (rule cspF_Rep_int_choice_left)
    apply (simp)
    apply (rule_tac x="aaa" in exI)
    apply (simp)

    apply (simp)
    apply (rule cspF_Int_choice_left2)
    apply (simp)

 (* ~(a : X & a ~: A) *)
  apply (simp (no_asm_simp))
  apply (rule cspF_rw_right)
  apply (rule cspF_IF_split)
  apply (simp)
  apply (rule cspF_rw_right)
  apply (rule cspF_IF_split)
  apply (simp)

  apply (rule cspF_decompo)
  apply (simp add: Renaming_event_fun_def)
  apply (fast)
  apply (simp)

(* aa ~= a *)
 apply (simp)
 apply (rule cspF_rw_right)
 apply (rule cspF_IF_split)
 apply (simp)
 apply (rule cspF_rw_right)
 apply (rule cspF_IF_split)
 apply (simp)
 apply (simp add: Renaming_event_fun_def)
 apply (subgoal_tac "{x. x ~: A & (x ~: A --> x : X & aa = x)}={aa}")
 apply (simp)
 apply (rule cspF_Rep_int_choice_singleton)
 apply (force)
done

lemma cspF_Ext_pre_choice_Renaming2_set_event_step_notin:
  "[| X Int A = {} |] ==>
     (? x:X -> Pf x)[[A<<-b]] =F[M,M] ? x:X -> (Pf x)[[A<<-b]]"
apply (simp add: Renaming_event_def)
apply (rule cspF_rw_left)
apply (rule cspF_Renaming_fun_step)
apply (fold Renaming_event_def)

apply (rule cspF_decompo)
apply (simp add: Image_def image_def)
apply (simp add: Renaming_event_fun_def)
apply (force)
apply (simp add: Renaming_event_fun_def)
apply (subgoal_tac
  "{x. (x : A --> x : X & a = b) & (x ~: A --> x : X & a = x)} = {a}")
apply (simp)
apply (rule cspF_Rep_int_choice_singleton)
apply (force)
done

lemma cspF_Ext_pre_choice_Renaming2_set_event_step:
  "(? x:X -> Pf x)[[A<<-a]] =F[M,M]
  IF (X Int A ~= {})
  THEN (a -> (! x:(X Int A) .. (Pf x)[[A<<-a]])
        [+] ? x:(X-A) -> (Pf x)[[A<<-a]])
  ELSE (? x:X -> (Pf x)[[A<<-a]])"
apply (case_tac "X Int A ~= {}")
apply (rule cspF_rw_left)
apply (rule cspF_Ext_pre_choice_Renaming2_set_event_step_in)
apply (simp)
apply (simp)
apply (rule cspF_rw_right)
apply (rule cspF_IF_split)
apply (simp)
apply (rule cspF_rw_left)
apply (rule cspF_Ext_pre_choice_Renaming2_set_event_step_notin)
apply (simp)
apply (rule cspF_rw_right)
apply (rule cspF_IF_split)
apply (simp)
done

(* <-- *)

lemma cspF_Ext_pre_choice_Renaming2_event_step:
  "(? x:X -> Pf x)[[a<--b]] =F[M,M]
  IF (a : X)
  THEN (b -> (Pf a)[[a<--b]]
        [+] ? x:(X-{a}) -> (Pf x)[[a<--b]])
  ELSE (? x:X -> (Pf x)[[a<--b]])"
apply (rule cspF_rw_left)
apply (rule cspF_Ext_pre_choice_Renaming2_set_event_step)
apply (case_tac "a:X")

 apply (rule cspF_decompo)
 apply (simp)
 apply (rule cspF_decompo)
 apply (rule cspF_decompo)
 apply (simp)
 apply (subgoal_tac "X Int {a} = {a}")
 apply (simp)
 apply (rule cspF_Rep_int_choice_singleton)
 apply (force)
 apply (simp)
 apply (simp)

 apply (simp)
 apply (rule cspF_rw_right)
 apply (rule cspF_IF_split)
 apply (simp)
 apply (rule cspF_rw_left)
 apply (rule cspF_IF_split)
 apply (simp)
done

lemmas cspF_Ext_pre_choice_Renaming_event_step =
       cspF_Ext_pre_choice_Renaming1_event_step
       cspF_Ext_pre_choice_Renaming2_set_event_step
       cspF_Ext_pre_choice_Renaming2_event_step

(* sending -- event -- *)

(* <--> *)

lemma cspF_Send_prefix_Renaming1_event1_step_in:
  "inj f ==> (f!v -> P)[[a<-->f v]] =F[M,M] a -> P[[a<-->f v]]"
apply (simp add: csp_prefix_ss_def)
apply (simp add: cspF_Act_prefix_Renaming_step)
done

lemma cspF_Send_prefix_Renaming1_event2_step_in:
  "inj f ==> (f!v -> P)[[f v<-->a]] =F[M,M] a -> P[[f v<-->a]]"
by (simp add: Renaming_commut cspF_Send_prefix_Renaming1_event1_step_in)

lemma cspF_Send_prefix_Renaming1_event_step_notin:
  "[| a ~= f v | f v ~= a ; b ~= f v | f v ~= b |]
   ==> (f!v -> P)[[a<-->b]] =F[M,M] f!v -> P[[a<-->b]]"
apply (simp add: csp_prefix_ss_def)
apply (simp add: cspF_Act_prefix_Renaming_step)
done

lemmas cspF_Send_prefix_Renaming1_event_step =
       cspF_Send_prefix_Renaming1_event1_step_in
       cspF_Send_prefix_Renaming1_event2_step_in
       cspF_Send_prefix_Renaming1_event_step_notin

(* <<- *)

lemma cspF_Send_prefix_Renaming2_set_event_step_in:
  "f v : A ==> (f!v -> P)[[A<<-a]] =F[M,M] a -> P[[A<<-a]]"
apply (simp add: csp_prefix_ss_def)
apply (simp add: cspF_Act_prefix_Renaming2_set_event_step_in)
done

lemma cspF_Send_prefix_Renaming2_set_event_step_notin:
  "f v ~: A
   ==> (f!v -> P)[[A<<-b]] =F[M,M] f!v -> P[[A<<-b]]"
apply (simp add: csp_prefix_ss_def)
apply (simp add: cspF_Act_prefix_Renaming2_set_event_step_notin)
done

lemma cspF_Send_prefix_Renaming2_set_event_step:
  "(f!v -> P)[[A<<-a]] =F[M,M]
   IF (f v : A) THEN (a -> P[[A<<-a]]) ELSE (f!v -> P[[A<<-a]])"
apply (case_tac "f v : A")
apply (rule cspF_rw_left)
apply (rule cspF_Send_prefix_Renaming2_set_event_step_in)
apply (simp)
apply (rule cspF_rw_right)
apply (rule cspF_IF_split)
apply (simp)
apply (rule cspF_rw_left)
apply (rule cspF_Send_prefix_Renaming2_set_event_step_notin)
apply (simp)
apply (rule cspF_rw_right)
apply (rule cspF_IF_split)
apply (simp)
done

(* <-- *)

lemma cspF_Send_prefix_Renaming2_event_step_in:
  "(f!v -> P)[[f v<--a]] =F[M,M] a -> P[[f v<--a]]"
by (simp add: cspF_Send_prefix_Renaming2_set_event_step_in)

lemma cspF_Send_prefix_Renaming2_event_step_notin:
  "[| a ~= f v | f v ~= a |]
   ==> (f!v -> P)[[a<--b]] =F[M,M] f!v -> P[[a<--b]]"
by (simp add: cspF_Send_prefix_Renaming2_set_event_step_notin)

lemmas cspF_Send_prefix_Renaming2_event_step =
       cspF_Send_prefix_Renaming2_event_step_in
       cspF_Send_prefix_Renaming2_event_step_notin

lemmas cspF_Send_prefix_Renaming_event_step =
       cspF_Send_prefix_Renaming1_event_step
       cspF_Send_prefix_Renaming2_event_step

(* sending -- channel -- *)

(* <==> *)

lemma cspF_Send_prefix_Renaming1_channel1_step_in:
  "[| inj f ; ALL x y. f x ~= g y |]
   ==> (f!v -> P)[[f<==>g]] =F[M,M] g!v -> P[[f<==>g]]"
apply (simp add: csp_prefix_ss_def)
apply (simp add: cspF_Act_prefix_Renaming_step)
done

lemma cspF_Send_prefix_Renaming1_channel2_step_in:
  "[| inj f ; ALL x y. f x ~= g y |]
   ==> (f!v -> P)[[g<==>f]] =F[M,M] g!v -> P[[g<==>f]]"
by (simp add: Renaming_commut cspF_Send_prefix_Renaming1_channel1_step_in)

lemma cspF_Send_prefix_Renaming1_channel_step_notin:
  "[| (ALL x. h v ~= f x) | h v ~: range f ;
      (ALL x. h v ~= g x) | h v ~: range g |]
    ==> (h!v -> P)[[f<==>g]] =F[M,M] h!v -> P[[f<==>g]]"
apply (simp add: csp_prefix_ss_def)
apply (simp add: cspF_Act_prefix_Renaming_step)
done

lemmas cspF_Send_prefix_Renaming1_channel_step =
       cspF_Send_prefix_Renaming1_channel1_step_in
       cspF_Send_prefix_Renaming1_channel2_step_in
       cspF_Send_prefix_Renaming1_channel_step_notin

(* <== *)

lemma cspF_Send_prefix_Renaming2_channel_step_in:
  "[| inj f ; ALL x y. f x ~= g y |]
   ==> (f!v -> P)[[f<==g]] =F[M,M] g!v -> P[[f<==g]]"
apply (simp add: csp_prefix_ss_def)
apply (simp add: cspF_Act_prefix_Renaming_step)
done

lemma cspF_Send_prefix_Renaming2_channel_step_notin:
  "[| (ALL x. h v ~= f x) | h v ~: range f |]
    ==> (h!v -> P)[[f<==g]] =F[M,M] h!v -> P[[f<==g]]"
apply (simp add: csp_prefix_ss_def)
apply (simp add: cspF_Act_prefix_Renaming_step)
done

lemmas cspF_Send_prefix_Renaming2_channel_step =
       cspF_Send_prefix_Renaming2_channel_step_in
       cspF_Send_prefix_Renaming2_channel_step_notin

lemmas cspF_Send_prefix_Renaming_channel_step =
       cspF_Send_prefix_Renaming1_channel_step
       cspF_Send_prefix_Renaming2_channel_step

(* -- *)

lemmas cspF_Send_prefix_Renaming_step =
       cspF_Send_prefix_Renaming_event_step
       cspF_Send_prefix_Renaming_channel_step

(* --- Rec_prefix_Renaming_even --- *)

(* <--> *)

lemma cspF_Rec_prefix_Renaming1_event1_step_in:
  "[| inj f ; v:X ; ALL x:X. a ~= f x |] ==>
     (f ? x:X -> Pf x)[[a<-->f v]] =F[M,M]
     (a -> (Pf v)[[a<-->f v]]) [+] f ? x:(X-{v}) -> (Pf x)[[a<-->f v]]"
apply (simp add: csp_prefix_ss_def)
apply (rule cspF_rw_left)
apply (simp add: Renaming_event_def)
apply (rule cspF_Renaming_fun_step)
apply (fold Renaming_event_def)

apply (rule cspF_rw_right)
apply (rule cspF_decompo)
apply (rule cspF_step)
apply (rule cspF_reflex)
apply (rule cspF_rw_right)
apply (rule cspF_step)

apply (rule cspF_decompo)
apply (simp add: inj_on_def)
apply (simp add: Image_def image_def)
apply (simp add: Renaming_event_fun_def)
apply (blast)

apply (simp)
apply (rule cspF_ref_eq)

(* <= *)
apply (case_tac "aa = a")

 (* aa = a *)
 apply (simp)
 apply (case_tac "a : f ` (X - {v})")
  apply (simp add: image_iff)

  (* a ~: f ` (X - {v})" *)
  apply (simp)
  apply (rule cspF_rw_right)
  apply (rule cspF_IF_split)
  apply (simp)
  apply (rule cspF_rw_right)
  apply (rule cspF_IF_split)
  apply (simp)
  apply (rule cspF_Rep_int_choice_left)
  apply (rule_tac x="f v" in exI)
  apply (simp add: Renaming_event_fun_def)

 (* aa ~= a *)
 apply (simp)

 apply (rule cspF_rw_right)
 apply (rule cspF_IF_split)
 apply (simp)
 apply (rule cspF_rw_right)
 apply (rule cspF_IF_split)
 apply (simp)

 apply (rule cspF_Rep_int_choice_left)
 apply (rule_tac x="aa" in exI)
 apply (simp)

 apply (simp add: image_iff)
 apply (erule bexE)
 apply (simp add: inj_on_def)
 apply (simp add: Renaming_event_fun_def)
 apply (force)

(* => *)
apply (simp add: Renaming_event_fun_def)
apply (case_tac "aa = a")

 (* aa = a *)
 apply (simp)
 apply (case_tac "a : f ` (X - {v})")

  apply (simp add: image_iff)

  (* a ~: f ` (X - {v})" *)
  apply (simp)
  apply (rule cspF_rw_left)
  apply (rule cspF_IF_split)
  apply (simp)
  apply (rule cspF_rw_left)
  apply (rule cspF_IF_split)
  apply (simp)
  apply (rule cspF_Rep_int_choice_right)
  apply (force)

 (* aa ~= a *)
 apply (simp)

 apply (rule cspF_rw_left)
 apply (rule cspF_IF_split)
 apply (simp)
 apply (rule cspF_rw_left)
 apply (rule cspF_IF_split)
 apply (simp)

 apply (rule cspF_Rep_int_choice_right)
 apply (auto)
done

lemma cspF_Rec_prefix_Renaming1_event2_step_in:
  "[| inj f ; v:X ; ALL x:X. a ~= f x |] ==>
     (f ? x:X -> Pf x)[[f v<-->a]] =F[M,M]
     (a -> (Pf v)[[f v<-->a]]) [+] f ? x:(X-{v}) -> (Pf x)[[f v<-->a]]"
apply (simp add: Renaming_commut)
apply (simp add: cspF_Rec_prefix_Renaming1_event1_step_in)
done

lemma cspF_Rec_prefix_Renaming1_event_step_notin:
  "[| (ALL x:X. a ~= f x) | a ~: f ` X ;
      (ALL x:X. b ~= f x) | b ~: f ` X |] ==>
     (f ? x:X -> Pf x)[[a<-->b]] =F[M,M] f ? x:X -> (Pf x)[[a<-->b]]"
apply (simp add: csp_prefix_ss_def)
apply (simp add: Renaming_event_def)
apply (rule cspF_rw_left)
apply (rule cspF_Renaming_fun_step)
apply (fold Renaming_event_def)

apply (rule cspF_decompo)
apply (simp add: Image_def image_def)
apply (simp add: Renaming_event_fun_def)
apply (force)
apply (subgoal_tac
  "{x : f ` X. aa = Renaming1_event_fun a b x} = {aa}")
apply (simp)
apply (rule cspF_Rep_int_choice_singleton)

apply (simp add: Renaming_event_fun_def)
apply (force)
done

lemmas cspF_Rec_prefix_Renaming1_event_step =
       cspF_Rec_prefix_Renaming1_event1_step_in
       cspF_Rec_prefix_Renaming1_event2_step_in
       cspF_Rec_prefix_Renaming1_event_step_notin

(* <<- *)

lemma cspF_Rec_prefix_Renaming2_set_event_step_in:
  "[| inj f ; EX x:X. f x : A |] ==>
     (f ? x:X -> Pf x)[[A<<-a]] =F[M,M]
      a -> (!<f> x:{x:X. f x : A} .. (Pf x)[[A<<-a]])
     [+] f ? x:(X-{x. f x : A}) -> (Pf x)[[A<<-a]]"
apply (simp add: csp_prefix_ss_def)
apply (rule cspF_rw_left)
apply (simp add: Renaming_event_def)
apply (rule cspF_Renaming_fun_step)
apply (fold Renaming_event_def)
apply (simp add: image_def)

apply (rule cspF_rw_right)
apply (rule cspF_decompo)
apply (rule cspF_step)
apply (rule cspF_reflex)
apply (rule cspF_rw_right)
apply (rule cspF_step)

apply (rule cspF_decompo)
apply (simp add: Renaming_event_fun_def)
apply (blast)

apply (simp)

apply (case_tac "aa = a")
 apply (simp)
 apply (case_tac "EX x:X - {x. f x : A}. a = f x")
  apply (simp add: image_iff)
  apply (rule cspF_rw_right)
  apply (rule cspF_IF_split)
  apply (elim conjE bexE)
  apply (simp)

  apply (rule cspF_ref_eq)

  (* <= *)
  apply (rule cspF_Int_choice_right)
   apply (rule cspF_Rep_int_choice_right)
   apply (simp)
   apply (simp)
   apply (rule cspF_Rep_int_choice_left)
   apply (rule_tac x="f aaa" in exI)
   apply (simp)
   apply (simp add: Renaming_event_fun_def)
   apply (fast)

   apply (rule cspF_Rep_int_choice_left)
   apply (rule_tac x="a" in exI)
   apply (simp)
   apply (rule conjI)
    apply (blast)
   apply (simp add: Renaming_event_fun_def)

  (* => *)
   apply (rule cspF_Rep_int_choice_right)
   apply (simp)
   apply (elim conjE bexE)
   apply (simp add: Renaming_event_fun_def)
   apply (case_tac "f xb : A")

    apply (simp)
    apply (rule cspF_Int_choice_left1)
    apply (rule cspF_Rep_int_choice_left)
    apply (simp)
    apply (rule_tac x="xb" in exI)
    apply (simp)

    apply (simp)
    apply (rule cspF_Int_choice_left2)
    apply (simp add: inj_on_def)
    apply (force)

 (* ~(EX x:X - {x. f x : A}. a = f x) *)
  apply (simp)
  apply (rule cspF_rw_right)
  apply (rule cspF_IF_split)
  apply (simp)
  apply (rule cspF_rw_right)
  apply (rule cspF_IF_split)
  apply (simp)

  apply (rule cspF_ref_eq)

  (* <= *)
   apply (rule cspF_Rep_int_choice_right)
   apply (simp)
   apply (simp)
   apply (rule cspF_Rep_int_choice_left)
   apply (rule_tac x="f aaa" in exI)
   apply (simp)
   apply (simp add: Renaming_event_fun_def)
   apply (fast)

  (* => *)
   apply (rule cspF_Rep_int_choice_right)
   apply (simp)
   apply (rule cspF_Rep_int_choice_left)
   apply (simp)
   apply (elim conjE bexE)
   apply (simp add: Renaming_event_fun_def)
   apply (case_tac "f xa : A")

    apply (simp)
    apply (rule_tac x="xa" in exI)
    apply (simp)
    apply (simp)

 (* aa ~= a *)
 apply (simp)

 apply (rule cspF_rw_right)
 apply (rule cspF_IF_split)
 apply (simp)
 apply (rule cspF_rw_right)
 apply (rule cspF_IF_split)
 apply (simp)
 apply (rule cspF_ref_eq)

  (* => *)
  apply (rule cspF_Rep_int_choice_left)
  apply (rule_tac x="aa" in exI)
  apply (simp)
  apply (erule bexE)
  apply (simp add: inj_on_def)
  apply (simp add: Renaming_event_fun_def)
  apply (force)

 (* <= *)
  apply (rule cspF_Rep_int_choice_right)
  apply (simp)
  apply (elim conjE bexE)
  apply (simp add: Renaming_event_fun_def)
   apply (case_tac "f xb : A")
   apply (simp)
   apply (simp add: inj_on_def)
   apply (force)
done

lemma cspF_Rec_prefix_Renaming2_set_event_step_notin:
  "[| (ALL x:X. f x ~: A) | A Int f ` X = {} |] ==>
     (f ? x:X -> Pf x)[[A<<-b]] =F[M,M] f ? x:X -> (Pf x)[[A<<-b]]"
apply (simp add: csp_prefix_ss_def)
apply (simp add: Renaming_event_def)
apply (rule cspF_rw_left)
apply (rule cspF_Renaming_fun_step)
apply (fold Renaming_event_def)

apply (rule cspF_decompo)
apply (simp add: Image_def image_def)
apply (simp add: Renaming_event_fun_def)
apply (force)
apply (subgoal_tac
  "{x : f ` X. a = Renaming2_event_fun A b x} = {a}")
apply (simp)
apply (rule cspF_Rep_int_choice_singleton)

apply (simp add: Renaming_event_fun_def)
apply (force)
done

lemma cspF_Rec_prefix_Renaming2_set_event_step:
  "inj f ==>
  (f ? x:X -> Pf x)[[A<<-a]] =F[M,M]
  IF (EX x:X. f x : A)
  THEN (a -> (!<f> x:{x:X. f x : A} .. (Pf x)[[A<<-a]])
       [+] f ? x:(X-{x. f x : A}) -> (Pf x)[[A<<-a]])
  ELSE (f ? x:X -> (Pf x)[[A<<-a]])"
apply (case_tac "EX x:X. f x : A")
apply (rule cspF_rw_left)
apply (rule cspF_Rec_prefix_Renaming2_set_event_step_in)
apply (simp)
apply (simp)
apply (rule cspF_rw_right)
apply (rule cspF_IF_split)
apply (simp)
apply (rule cspF_rw_left)
apply (rule cspF_Rec_prefix_Renaming2_set_event_step_notin)
apply (simp)
apply (rule cspF_rw_right)
apply (rule cspF_IF_split)
apply (simp)
done

(* <-- *)

lemma cspF_Rec_prefix_Renaming2_event_step_in:
  "[| inj f ; v:X ; ALL x:X. a ~= f x |] ==>
     (f ? x:X -> Pf x)[[f v<--a]] =F[M,M]
     (a -> (Pf v)[[f v<--a]]) [+] f ? x:(X-{v}) -> (Pf x)[[f v<--a]]"
apply (rule cspF_rw_left)
apply (rule cspF_Rec_prefix_Renaming2_set_event_step_in)
apply (simp)
apply (simp)
apply (force)
apply (simp)

apply (rule cspF_decompo)
 apply (rule cspF_decompo)
 apply (simp)
 apply (subgoal_tac "{x : X. f x = f v}={v}")
 apply (simp)
 apply (rule cspF_rw_left)
 apply (rule cspF_Rep_int_choice_singleton)
 apply (simp)
 apply (simp)
 apply (simp add: inj_on_def)
 apply (force)

 apply (subgoal_tac "{x. f x = f v}={v}")
 apply (simp)
 apply (simp add: inj_on_def)
 apply (force)
done

lemma cspF_Rec_prefix_Renaming2_event_step_notin:
  "[| (ALL x:X. a ~= f x) | a ~: f ` X |] ==>
     (f ? x:X -> Pf x)[[a<--b]] =F[M,M] f ? x:X -> (Pf x)[[a<--b]]"
apply (rule cspF_rw_left)
apply (rule cspF_Rec_prefix_Renaming2_set_event_step_notin)
apply (simp)
apply (force)
apply (simp)
done

lemmas cspF_Rec_prefix_Renaming2_event_step =
       cspF_Rec_prefix_Renaming2_event_step_in
       cspF_Rec_prefix_Renaming2_event_step_notin

lemmas cspF_Rec_prefix_Renaming_event_step =
       cspF_Rec_prefix_Renaming1_event_step
       cspF_Rec_prefix_Renaming2_event_step

(* <==> *)

lemma cspF_Rec_prefix_Renaming1_channel1_step_in:
  "[| inj f ; inj g ; ALL x y. f x ~= g y |] ==>
     (f ? x:X -> Pf x)[[f<==>g]] =F[M,M] g ? x:X -> (Pf x)[[f<==>g]]"
apply (simp add: Renaming_channel_def)
apply (simp add: csp_prefix_ss_def)
apply (rule cspF_rw_left)
apply (rule cspF_Renaming_fun_step)
apply (rule cspF_decompo)
apply (simp add: Renaming_channel_fun_simp)
apply (simp add: image_iff)
apply (erule bexE)
apply (simp)
apply (subgoal_tac
  "{xa. (EX x:X. xa = f x) & g x = Renaming1_channel_fun f g xa} = {f x}")
apply (simp)
apply (rule cspF_rw_left)
apply (rule cspF_Rep_int_choice_singleton)
apply (simp)

apply (auto)
apply (simp add: Renaming_channel_fun_simp)
apply (simp add: inj_on_def)
apply (force)
apply (simp add: Renaming_channel_fun_simp)
done

lemma cspF_Rec_prefix_Renaming1_channel2_step_in:
  "[| inj f ; inj g ; ALL x y. f x ~= g y |] ==>
     (f ? x:X -> Pf x)[[g<==>f]] =F[M,M] g ? x:X -> (Pf x)[[g<==>f]]"
apply (simp add: Renaming_commut)
apply (simp add: cspF_Rec_prefix_Renaming1_channel1_step_in)
done

(*
lemma Renaming_channel_fun_h:
   "[| ALL x y. f x ~= g y ; ALL x y. f x ~= h y ; ALL x y. g x ~= h y |]
    ==> Renaming_channel_fun f g (h x) = h x"
by (auto simp add: Renaming_channel_fun_def)

lemma Renaming_channel_fun_map_h:
   "[| (ALL x y. f x ~= h y) ;
       (ALL x y. g x ~= h y) ;
       ALL x y. f x ~= g y |]
    ==> Renaming_channel_fun f g ` h ` X = h ` X"
apply (simp add: image_def)
apply (auto simp add: Renaming_channel_fun_h)
done
*)

lemma cspF_Rec_prefix_Renaming1_channel_step_notin:
  "[| inj h;
      (ALL x y. f x ~= h y) | range f Int range h = {} ;
      (ALL x y. g x ~= h y) | range g Int range h = {} ;
       ALL x y. f x ~= g y |] ==>
    (h ? x:X -> Pf x)[[f<==>g]] =F[M,M] h ? x:X -> (Pf x)[[f<==>g]]"
apply (subgoal_tac "(ALL x y. f x ~= h y) & (ALL x y. g x ~= h y)")
apply (simp add: Renaming_channel_def)
apply (simp add: csp_prefix_ss_def)
apply (rule cspF_rw_left)
apply (rule cspF_Renaming_fun_step)
apply (rule cspF_decompo)
apply (simp add: Renaming_channel_fun_simp)

apply (simp add: image_iff)
apply (erule bexE)
apply (simp)
apply (subgoal_tac
  "{xa. (EX x:X. xa = h x) & h x = Renaming1_channel_fun f g xa} = {h x}")
apply (simp)
apply (rule cspF_rw_left)
apply (rule cspF_Rep_int_choice_singleton)
apply (simp)

apply (auto)
apply (simp add: Renaming_channel_fun_simp)
apply (simp add: Renaming_channel_fun_simp)
apply (blast)+
done

lemmas cspF_Rec_prefix_Renaming1_channel_step =
       cspF_Rec_prefix_Renaming1_channel1_step_in
       cspF_Rec_prefix_Renaming1_channel2_step_in
       cspF_Rec_prefix_Renaming1_channel_step_notin

(* <== *)

lemma cspF_Rec_prefix_Renaming2_channel_step_in:
  "[| inj f ; inj g ; ALL x y. f x ~= g y |] ==>
     (f ? x:X -> Pf x)[[f<==g]] =F[M,M] g ? x:X -> (Pf x)[[f<==g]]"
apply (simp add: Renaming_channel_def)
apply (simp add: csp_prefix_ss_def)
apply (rule cspF_rw_left)
apply (rule cspF_Renaming_fun_step)
apply (rule cspF_decompo)
apply (simp add: Renaming_channel_fun_simp)
apply (simp add: image_iff)
apply (erule bexE)
apply (simp)
apply (subgoal_tac
  "{xa. (EX x:X. xa = f x) & g x = Renaming2_channel_fun f g xa} = {f x}")
apply (simp)
apply (rule cspF_rw_left)
apply (rule cspF_Rep_int_choice_singleton)
apply (simp)

apply (auto)
apply (simp add: Renaming_channel_fun_simp)
apply (simp add: inj_on_def)
apply (force)
apply (simp add: Renaming_channel_fun_simp)
done

lemma cspF_Rec_prefix_Renaming2_channel_step_notin:
  "[| inj h;
      (ALL x y. f x ~= h y) | range f Int range h = {} ;
       ALL x y. f x ~= g y |] ==>
    (h ? x:X -> Pf x)[[f<==g]] =F[M,M] h ? x:X -> (Pf x)[[f<==g]]"
apply (subgoal_tac "(ALL x y. f x ~= h y)")
apply (simp add: Renaming_channel_def)
apply (simp add: csp_prefix_ss_def)
apply (rule cspF_rw_left)
apply (rule cspF_Renaming_fun_step)
apply (rule cspF_decompo)
apply (simp add: Renaming_channel_fun_simp)

apply (simp add: image_iff)
apply (erule bexE)
apply (simp)
apply (subgoal_tac
  "{xa. (EX x:X. xa = h x) & h x = Renaming2_channel_fun f g xa} = {h x}")
apply (simp)
apply (rule cspF_rw_left)
apply (rule cspF_Rep_int_choice_singleton)
apply (simp)

apply (auto)
apply (simp add: Renaming_channel_fun_simp)
apply (simp add: Renaming_channel_fun_simp)
apply (blast)+
done

lemmas cspF_Rec_prefix_Renaming2_channel_step =
       cspF_Rec_prefix_Renaming2_channel_step_in
       cspF_Rec_prefix_Renaming2_channel_step_notin

lemmas cspF_Rec_prefix_Renaming_channel_step =
       cspF_Rec_prefix_Renaming1_channel_step
       cspF_Rec_prefix_Renaming2_channel_step

lemmas cspF_Rec_prefix_Renaming_step =
       cspF_Rec_prefix_Renaming_event_step
       cspF_Rec_prefix_Renaming_channel_step

(* Nondet Sending *)

(* <--> *)

lemma cspF_Nondet_send_prefix_Renaming1_event1_step_in:
  "[| inj f ; v:X ; ALL x. a ~= f x |] ==>
     (f !? x:X -> Pf x)[[a<-->f v]] =F[M,M]
     (a -> (Pf v)[[a<-->f v]]) |~| f !? x:(X-{v}) -> (Pf x)[[a<-->f v]]"
apply (simp add: csp_prefix_ss_def)
apply (rule cspF_rw_left)
apply (rule cspF_Dist)
apply (subgoal_tac "(f ` X) = {f v} Un (f ` (X - {v}))")
apply (simp del: Un_insert_left)
apply (rule cspF_rw_left)
apply (rule cspF_Rep_int_choice_com_union_Int)
apply (rule cspF_decompo)

 (* 1 *)
 apply (rule cspF_rw_left)
 apply (rule cspF_Rep_int_choice_singleton)
 apply (simp add: cspF_Act_prefix_Renaming_event_step)

 (* 2 *)
 apply (rule cspF_decompo)
 apply (simp)
 apply (rule cspF_rw_left)
 apply (rule cspF_Act_prefix_Renaming_event_step)
 apply (auto)
 apply (simp add: inj_on_def)
done

lemma cspF_Nondet_send_prefix_Renaming1_event2_step_in:
  "[| inj f ; v:X ; ALL x. a ~= f x |] ==>
     (f !? x:X -> Pf x)[[f v<-->a]] =F[M,M]
     (a -> (Pf v)[[f v<-->a]]) |~| f !? x:(X-{v}) -> (Pf x)[[f v<-->a]]"
apply (simp add: Renaming_commut)
apply (simp add: cspF_Nondet_send_prefix_Renaming1_event1_step_in)
done

lemma cspF_Nondet_send_prefix_Renaming1_event_step_notin:
  "[| (ALL x. a ~= f x) | a ~: range f ;
      (ALL x. b ~= f x) | b ~: range f |] ==>
   (f !? x:X -> Pf x)[[a<-->b]] =F[M,M] f !? x:X -> (Pf x)[[a<-->b]]"
apply (simp add: csp_prefix_ss_def)
apply (rule cspF_rw_left)
apply (rule cspF_Dist)
apply (rule cspF_decompo)
apply (simp)
 apply (rule cspF_rw_left)
 apply (rule cspF_Act_prefix_Renaming_event_step)
 apply (auto)
done

lemmas cspF_Nondet_send_prefix_Renaming1_event_step =
       cspF_Nondet_send_prefix_Renaming1_event1_step_in
       cspF_Nondet_send_prefix_Renaming1_event2_step_in
       cspF_Nondet_send_prefix_Renaming1_event_step_notin

(* <<- *)

lemma cspF_Nondet_send_prefix_Renaming2_set_event_step_in:
  "[| inj f ; EX x:X. f x : A |] ==>
     (f !? x:X -> Pf x)[[A<<-a]] =F[M,M]
      a -> (!<f> x:{x:X. f x : A} .. (Pf x)[[A<<-a]])
     |~| f !? x:(X-{x. f x : A}) -> (Pf x)[[A<<-a]]"
apply (simp add: csp_prefix_ss_def)
apply (rule cspF_rw_left)
apply (rule cspF_Dist)
apply (rule cspF_rw_left)
apply (rule cspF_decompo)
apply (simp)
apply (rule cspF_decompo)
apply (simp)
apply (rule cspF_step)

apply (rule cspF_rw_left)
apply (rule cspF_decompo)
apply (simp)
apply (rule cspF_step)

apply (subgoal_tac "(f ` X) = (f ` {x : X. f x : A}) Un (f ` (X - {x. f x : A}))") (* 1 *)
 apply (simp del: Un_insert_left)
 apply (rule cspF_rw_left)
 apply (rule cspF_Rep_int_choice_com_union_Int)
 apply (rule cspF_decompo)

 (* left *)
 apply (subgoal_tac
  "a -> (!<f> x:{x : X. f x : A} .. Pf x [[A<<-a]])
   =F[M,M] !<f> x:{x : X. f x : A} .. a -> Pf x [[A<<-a]]")  (* 2 *)

  apply (rule cspF_rw_right)
  apply (assumption)
  apply (simp add: Rep_int_choice_f_def)
  apply (rule cspF_decompo)
  apply (simp)
  apply (simp add: image_iff)
  apply (elim conjE exE bexE)
  apply (simp)

  apply (rule cspF_rw_right)
  apply (rule cspF_step)
  apply (rule cspF_decompo)
  apply (simp add: Renaming_event_def)
  apply (simp add: Renaming_event_fun_def)
  apply (simp add: fun_to_rel_def)
  apply (force)

  apply (rule cspF_ref_eq)

   (* <= *)
   apply (rule cspF_Rep_int_choice_left)
   apply (simp add: Renaming_event_def)
   apply (simp add: Renaming_event_fun_def)
   apply (simp add: fun_to_rel_def)
   (* => *)
   apply (rule cspF_Rep_int_choice_right)
   apply (simp)

 (* 2 *)
  apply (rule cspF_rw_right)
  apply (rule cspF_choice_delay)
  apply (simp)
  apply (subgoal_tac "~(ALL x. x : X --> f x ~: A)")
   apply (simp (no_asm_simp))
   apply (rule cspF_rw_right)
   apply (rule cspF_IF_split)
   apply (simp)
  apply (force)

 (* right *)
 apply (rule cspF_decompo)
 apply (simp)

 apply (rule cspF_rw_right)
 apply (rule cspF_step)
 apply (rule cspF_decompo)
  apply (simp add: Renaming_event_def)
  apply (simp add: Renaming_event_fun_def)
  apply (simp add: fun_to_rel_def)
  apply (force)

 apply (simp)
 apply (rule cspF_ref_eq)

  (* <= *)
  apply (rule cspF_Rep_int_choice_left)
  apply (simp add: Renaming_event_def)
  apply (simp add: Renaming_event_fun_def)
  apply (simp add: fun_to_rel_def)
  apply (force)

  (* => *)
  apply (rule cspF_Rep_int_choice_right)
  apply (simp)

(* 1 *)
apply (auto)
done

lemma cspF_Nondet_send_prefix_Renaming2_set_event_step_notin:
  "[| (ALL x:X. f x ~: A) | A Int f ` X = {} |] ==>
     (f !? x:X -> Pf x)[[A<<-a]] =F[M,M]
      f !? x:X -> (Pf x)[[A<<-a]]"
apply (simp add: csp_prefix_ss_def)
apply (rule cspF_rw_left)
apply (rule cspF_Dist)
apply (rule cspF_decompo)
apply (simp)

apply (rule cspF_rw_left)
apply (rule cspF_decompo)
apply (simp)
apply (rule cspF_step)

apply (rule cspF_rw_left)
apply (rule cspF_step)

apply (rule cspF_rw_right)
apply (rule cspF_step)

apply (rule cspF_decompo)
 apply (simp add: Renaming_event_def)
 apply (simp add: Renaming_event_fun_def)
 apply (simp add: fun_to_rel_def)
 apply (force)

apply (simp)
 apply (rule cspF_ref_eq)

  (* <= *)
  apply (rule cspF_Rep_int_choice_left)
  apply (simp add: Renaming_event_def)
  apply (simp add: Renaming_event_fun_def)
  apply (simp add: fun_to_rel_def)
  apply (force)

  (* => *)
  apply (rule cspF_Rep_int_choice_right)
  apply (simp)
done

lemma cspF_Nondet_send_prefix_Renaming2_set_event_step:
  "inj f ==>
  (f !? x:X -> Pf x)[[A<<-a]] =F[M,M]
   IF (EX x:X. f x : A)
   THEN (a -> (!<f> x:{x:X. f x : A} .. (Pf x)[[A<<-a]])
         |~| f !? x:(X-{x. f x : A}) -> (Pf x)[[A<<-a]])
   ELSE (f !? x:X -> (Pf x)[[A<<-a]])"
apply (case_tac "EX x:X. f x : A")
apply (rule cspF_rw_left)
apply (rule cspF_Nondet_send_prefix_Renaming2_set_event_step_in)
apply (simp)
apply (simp)
apply (rule cspF_rw_right)
apply (rule cspF_IF_split)
apply (simp)
apply (rule cspF_rw_left)
apply (rule cspF_Nondet_send_prefix_Renaming2_set_event_step_notin)
apply (simp)
apply (simp)
apply (rule cspF_rw_right)
apply (rule cspF_IF_split)
apply (simp)
done

(* <-- *)

lemma cspF_Nondet_send_prefix_Renaming2_event_step_in:
  "[| inj f ; v:X ; ALL x. a ~= f x |] ==>
     (f !? x:X -> Pf x)[[f v<--a]] =F[M,M]
     (a -> (Pf v)[[f v<--a]]) |~| f !? x:(X-{v}) -> (Pf x)[[f v<--a]]"
apply (rule cspF_rw_left)
apply (rule cspF_Nondet_send_prefix_Renaming2_set_event_step_in)
apply (simp)
apply (simp)
apply (force)
apply (simp)

apply (rule cspF_decompo)
 apply (rule cspF_decompo)
 apply (simp)
 apply (subgoal_tac "{x : X. f x = f v}={v}")
 apply (simp)
 apply (rule cspF_rw_left)
 apply (rule cspF_Rep_int_choice_singleton)
 apply (simp)
 apply (simp)
 apply (simp add: inj_on_def)
 apply (force)

 apply (subgoal_tac "{x. f x = f v}={v}")
 apply (simp)
 apply (simp add: inj_on_def)
 apply (force)
done

lemma cspF_Nondet_send_prefix_Renaming2_event_step_notin:
  "[| (ALL x. a ~= f x) | a ~: range f |] ==>
   (f !? x:X -> Pf x)[[a<--b]] =F[M,M] f !? x:X -> (Pf x)[[a<--b]]"
apply (rule cspF_rw_left)
apply (rule cspF_Nondet_send_prefix_Renaming2_set_event_step_notin)
apply (simp)
apply (force)
apply (simp)
done

lemmas cspF_Nondet_send_prefix_Renaming2_event_step =
       cspF_Nondet_send_prefix_Renaming2_event_step_in
       cspF_Nondet_send_prefix_Renaming2_event_step_notin

lemmas cspF_Nondet_send_prefix_Renaming_event_step =
       cspF_Nondet_send_prefix_Renaming1_event_step
       cspF_Nondet_send_prefix_Renaming2_event_step

(* <==> *)

lemma cspF_Nondet_send_prefix_Renaming1_channel1_step_in:
  "[| inj f ; inj g ; ALL x y. f x ~= g y |] ==>
   (f !? x:X -> Pf x)[[f<==>g]] =F[M,M] g !? x:X -> (Pf x)[[f<==>g]]"
apply (simp add: csp_prefix_ss_def)
apply (rule cspF_rw_left)
apply (rule cspF_Dist)
apply (rule cspF_ref_eq)

(* <= *)
 apply (rule cspF_Rep_int_choice_right)
 apply (simp add: image_iff)
 apply (erule bexE)
 apply (simp)

 apply (rule cspF_Rep_int_choice_left)
 apply (rule_tac x="f x" in exI)
 apply (simp)
 apply (rule cspF_rw_left)
 apply (rule cspF_Act_prefix_Renaming_channel_step)
 apply (simp_all)

(* => *)
 apply (rule cspF_Rep_int_choice_right)
 apply (simp add: image_iff)
 apply (erule bexE)
 apply (simp)

 apply (rule cspF_Rep_int_choice_left)
 apply (rule_tac x="g x" in exI)
 apply (simp)
 apply (rule cspF_rw_right)
 apply (rule cspF_Act_prefix_Renaming_channel_step)
 apply (simp_all)
done

lemma cspF_Nondet_send_prefix_Renaming1_channel2_step_in:
  "[| inj f ; inj g ; ALL x y. f x ~= g y |] ==>
   (f !? x:X -> Pf x)[[g<==>f]] =F[M,M] g !? x:X -> (Pf x)[[g<==>f]]"
apply (simp add: Renaming_commut)
apply (simp add: cspF_Nondet_send_prefix_Renaming1_channel1_step_in)
done

lemma cspF_Nondet_send_prefix_Renaming1_channel_step_notin:
  "[| (ALL x y. f x ~= h y) | (range f Int range h = {}) ;
      (ALL x y. g x ~= h y) | (range g Int range h = {}) |] ==>
   (h !? x:X -> Pf x)[[f<==>g]] =F[M,M] h !? x:X -> (Pf x)[[f<==>g]]"
apply (simp add: csp_prefix_ss_def)
apply (rule cspF_rw_left)
apply (rule cspF_Dist)
apply (rule cspF_decompo)
apply (simp)

apply (rule cspF_rw_left)
apply (rule cspF_Act_prefix_Renaming_channel_step)
apply (blast)
apply (blast)
apply (simp)
done

lemmas cspF_Nondet_send_prefix_Renaming1_channel_step =
       cspF_Nondet_send_prefix_Renaming1_channel1_step_in
       cspF_Nondet_send_prefix_Renaming1_channel2_step_in
       cspF_Nondet_send_prefix_Renaming1_channel_step_notin

(* <== *)

lemma cspF_Nondet_send_prefix_Renaming2_channel_step_in:
  "[| inj f ; inj g ; ALL x y. f x ~= g y |] ==>
   (f !? x:X -> Pf x)[[f<==g]] =F[M,M] g !? x:X -> (Pf x)[[f<==g]]"
apply (simp add: csp_prefix_ss_def)
apply (rule cspF_rw_left)
apply (rule cspF_Dist)
apply (rule cspF_ref_eq)

(* <= *)
 apply (rule cspF_Rep_int_choice_right)
 apply (simp add: image_iff)
 apply (erule bexE)
 apply (simp)

 apply (rule cspF_Rep_int_choice_left)
 apply (rule_tac x="f x" in exI)
 apply (simp)
 apply (rule cspF_rw_left)
 apply (rule cspF_Act_prefix_Renaming_channel_step)
 apply (simp_all)

(* => *)
 apply (rule cspF_Rep_int_choice_right)
 apply (simp add: image_iff)
 apply (erule bexE)
 apply (simp)

 apply (rule cspF_Rep_int_choice_left)
 apply (rule_tac x="g x" in exI)
 apply (simp)
 apply (rule cspF_rw_right)
 apply (rule cspF_Act_prefix_Renaming_channel_step)
 apply (simp_all)
done

lemma cspF_Nondet_send_prefix_Renaming2_channel_step_notin:
  "[| (ALL x y. f x ~= h y) | (range f Int range h = {}) |] ==>
   (h !? x:X -> Pf x)[[f<==g]] =F[M,M] h !? x:X -> (Pf x)[[f<==g]]"
apply (simp add: csp_prefix_ss_def)
apply (rule cspF_rw_left)
apply (rule cspF_Dist)
apply (rule cspF_decompo)
apply (simp)

apply (rule cspF_rw_left)
apply (rule cspF_Act_prefix_Renaming_channel_step)
apply (blast)
apply (simp)
done

lemmas cspF_Nondet_send_prefix_Renaming2_channel_step =
       cspF_Nondet_send_prefix_Renaming2_channel_step_in
       cspF_Nondet_send_prefix_Renaming2_channel_step_notin

lemmas cspF_Nondet_send_prefix_Renaming_channel_step =
       cspF_Nondet_send_prefix_Renaming1_channel_step
       cspF_Nondet_send_prefix_Renaming2_channel_step

lemmas cspF_Nondet_send_prefix_Renaming_step =
       cspF_Nondet_send_prefix_Renaming_event_step
       cspF_Nondet_send_prefix_Renaming_channel_step

(* ---------------- *
      in or notin
 * ---------------- *)

lemmas cspF_prefix_Renaming_in_step =
       cspF_Act_prefix_Renaming1_event1_step_in
       cspF_Act_prefix_Renaming1_event2_step_in
       cspF_Act_prefix_Renaming1_channel1_step_in
       cspF_Act_prefix_Renaming1_channel2_step_in
       cspF_Send_prefix_Renaming1_event1_step_in
       cspF_Send_prefix_Renaming1_event2_step_in
       cspF_Send_prefix_Renaming1_channel1_step_in
       cspF_Send_prefix_Renaming1_channel2_step_in
       cspF_Rec_prefix_Renaming1_event1_step_in
       cspF_Rec_prefix_Renaming1_event2_step_in
       cspF_Rec_prefix_Renaming1_channel1_step_in
       cspF_Rec_prefix_Renaming1_channel2_step_in
       cspF_Nondet_send_prefix_Renaming1_event1_step_in
       cspF_Nondet_send_prefix_Renaming1_event2_step_in
       cspF_Nondet_send_prefix_Renaming1_channel1_step_in
       cspF_Nondet_send_prefix_Renaming1_channel2_step_in
       cspF_Act_prefix_Renaming2_event_step_in
       cspF_Act_prefix_Renaming2_channel_step_in
       cspF_Send_prefix_Renaming2_event_step_in
       cspF_Send_prefix_Renaming2_channel_step_in
       cspF_Rec_prefix_Renaming2_event_step_in
       cspF_Rec_prefix_Renaming2_channel_step_in
       cspF_Nondet_send_prefix_Renaming2_event_step_in
       cspF_Nondet_send_prefix_Renaming2_channel_step_in

(* notin + <<- + ?X*)

lemmas cspF_prefix_Renaming_notin_step =
       cspF_Act_prefix_Renaming1_event_step_notin
       cspF_Act_prefix_Renaming1_channel_step_notin
       cspF_Send_prefix_Renaming1_event_step_notin
       cspF_Send_prefix_Renaming1_channel_step_notin
       cspF_Rec_prefix_Renaming1_event_step_notin
       cspF_Rec_prefix_Renaming1_channel_step_notin
       cspF_Nondet_send_prefix_Renaming1_event_step_notin
       cspF_Nondet_send_prefix_Renaming1_channel_step_notin
       cspF_Act_prefix_Renaming2_event_step_notin
       cspF_Act_prefix_Renaming2_channel_step_notin
       cspF_Send_prefix_Renaming2_event_step_notin
       cspF_Send_prefix_Renaming2_channel_step_notin
       cspF_Rec_prefix_Renaming2_event_step_notin
       cspF_Rec_prefix_Renaming2_channel_step_notin
       cspF_Nondet_send_prefix_Renaming2_event_step_notin
       cspF_Nondet_send_prefix_Renaming2_channel_step_notin

       cspF_Act_prefix_Renaming2_set_event_step
       cspF_Send_prefix_Renaming2_set_event_step
       cspF_Rec_prefix_Renaming2_set_event_step
       cspF_Nondet_send_prefix_Renaming2_set_event_step

       cspF_Ext_pre_choice_Renaming_event_step

(*
lemmas cspF_prefix_Renaming_in_step =
       cspF_Act_prefix_Renaming_event1_step_in
       cspF_Act_prefix_Renaming_event2_step_in
       cspF_Act_prefix_Renaming_channel1_step_in
       cspF_Act_prefix_Renaming_channel2_step_in
       cspF_Send_prefix_Renaming_event1_step_in
       cspF_Send_prefix_Renaming_event2_step_in
       cspF_Send_prefix_Renaming_channel1_step_in
       cspF_Send_prefix_Renaming_channel2_step_in
       cspF_Rec_prefix_Renaming_event1_step_in
       cspF_Rec_prefix_Renaming_event2_step_in
       cspF_Rec_prefix_Renaming_channel1_step_in
       cspF_Rec_prefix_Renaming_channel2_step_in
       cspF_Nondet_send_prefix_Renaming_event1_step_in
       cspF_Nondet_send_prefix_Renaming_event2_step_in
       cspF_Nondet_send_prefix_Renaming_channel1_step_in
       cspF_Nondet_send_prefix_Renaming_channel2_step_in

lemmas cspF_prefix_Renaming_notin_step =
       cspF_Act_prefix_Renaming_event_step_notin
       cspF_Act_prefix_Renaming_channel_step_notin
       cspF_Send_prefix_Renaming_event_step_notin
       cspF_Send_prefix_Renaming_channel_step_notin
       cspF_Rec_prefix_Renaming_event_step_notin
       cspF_Rec_prefix_Renaming_channel_step_notin
       cspF_Nondet_send_prefix_Renaming_event_step_notin
       cspF_Nondet_send_prefix_Renaming_channel_step_notin
*)

(* ----------------------------------------------------------- *)

end


theory Surprise_Paradox
imports
  Incompleteness.Goedel_I
  Incompleteness.Pseudo_Coding
begin

text \<open>
The Surprise Paradox comes in a few variations, one being the following:

\begin{quote}
A judge sentences a felon to death by hanging, to be executed at noon the next week, Monday to
Friday. As an extra punishment, the judge does not disclose the day of the hanging and promises the
felon that it will come at a surprise.

The felon, probably a logician, then concludes that he cannot be hanged on Friday, as by then it would
not longer be a surprise. Using this fact and similar reasoning, he cannot be hanged on Thursday, and so
on. He reaches the conclusion that he cannot be hanged at all, and contently returns to his cell.

Wednesday, at noon, the hangman comes to the very surprised felon, and executes him.
\end{quote}

Obviously, something is wrong here: Does the felon reason wrongly? It looks about right.
Or is the judge lying? But his prediction became true!

It is an interesting exercise to try to phrase the Surprise Paradox in a rigorous manner, and
see this might clarify things.

In 1964, Frederic Fitch suggested a formulation that refines the notion of ``surprise'' as
``cannot be proven from the given assumptions'' \<^cite>\<open>Fitch\<close>. To formulate that, we need propositions that
reference their own provability, so just as Fitch builds on Gödel's work, we build on Paulson's
formalisation of Gödel's incompleteness theorems in Isabelle \<^cite>\<open>Incompleteness\<close>.
\<close>

section \<open>Excluded or\<close>

text \<open>Although the proof goes through with regular disjunction, Fitch phrases the judge's
proposition using exclusive or, so we add syntax for that.\<close>

abbreviation Xor :: "fm \<Rightarrow> fm \<Rightarrow> fm" (infix "XOR" 120)
 where "Xor A B \<equiv> (A OR B) AND ((Neg A) OR (Neg B))"

section \<open>Formulas with variables\<close>

text \<open>
In Paulson's formalisation of terms and formulas, only terms carry variables. This is sufficient for
his purposes, because the proposition that is being diagonalised needs itself as a parameter to
@{term_type PfP}, which does take a term (which happens to be a quoted formula).

In order to stay close to Fitch, we need the diagonalised proposition to occur deeper in a quotation
of a few logical conjunctions. Therefore, we build a small theory of formulas with variables (``holed''
formulas). These support substituting a formula for a variable, this substitution commutes with
quotation, and closed holed formulas can be converted to regular formulas.

In our application, we do not need holes under an quantifier, which greatly simplifies things here.
In particular, we can use @{command datatype} and @{command fun}.
\<close>

datatype hfm =
   HVar name
 | HFm fm
 | HDisj hfm hfm (infixr "HOR" 130)
 | HNeg  hfm

abbreviation HImp :: "hfm \<Rightarrow> hfm \<Rightarrow> hfm"  (infixr "HIMP" 125)
  where "HImp A B \<equiv> HDisj (HNeg A) B"

definition HConj :: "hfm \<Rightarrow> hfm \<Rightarrow> hfm"   (infixr "HAND" 135)
  where "HConj A B \<equiv> HNeg (HDisj (HNeg A) (HNeg B))"

abbreviation HXor :: "hfm \<Rightarrow> hfm \<Rightarrow> hfm" (infix "HXOR" 120)
 where "HXor A B \<equiv> (A HOR B) HAND (HNeg A HOR HNeg B)"

fun  subst_hfm :: "hfm \<Rightarrow> name \<Rightarrow> fm \<Rightarrow> hfm" ("_'(_:::=_')" [1000, 0, 0] 200)
  where
    "(HVar name)(i:::=x) = (if i = name then HFm x else HVar name)"
  | "(HDisj A B)(i:::=x) = HDisj (A(i:::=x)) (B(i:::=x))"
  | "(HNeg A)(i:::=x) = HNeg (A(i:::=x))"
  | "(HFm A)(i:::=x) = HFm A"

lemma subst_hfml_Conj[simp]:
  "(HConj A B)(i:::=x) = HConj (A(i:::=x)) (B(i:::=x))"
 unfolding HConj_def by simp

instantiation hfm :: quot
begin
fun quot_hfm :: "hfm \<Rightarrow> tm"
  where
   "quot_hfm (HVar name) = (Var name)"
 | "quot_hfm (HFm A) = \<guillemotleft>A\<guillemotright>"
 | "quot_hfm (HDisj A B) = HPair (HTuple 3) (HPair (quot_hfm A) (quot_hfm B))"
 | "quot_hfm (HNeg A) = HPair (HTuple 4) (quot_hfm A)"

instance ..
end

lemma subst_quot_hfm[simp]: "subst i \<guillemotleft>P\<guillemotright> \<guillemotleft>A\<guillemotright> = \<guillemotleft>A(i:::=P)\<guillemotright>"
  by (induction A) auto

fun hfm_to_fm :: "hfm \<Rightarrow> fm"
  where
   "hfm_to_fm (HVar name) = undefined"
 | "hfm_to_fm (HFm A) = A"
 | "hfm_to_fm (HDisj A B) = Disj (hfm_to_fm A) (hfm_to_fm B)"
 | "hfm_to_fm (HNeg A) = Neg (hfm_to_fm A)"

lemma hfm_to_fm_Conj[simp]:
  "hfm_to_fm (HConj A B) = Conj (hfm_to_fm A) (hfm_to_fm B)"
unfolding HConj_def Conj_def by simp

fun closed_hfm  :: "hfm \<Rightarrow> bool"
  where
   "closed_hfm (HVar name) \<longleftrightarrow> False"
 | "closed_hfm (HFm A) \<longleftrightarrow> True"
 | "closed_hfm (HDisj A B) \<longleftrightarrow> closed_hfm A \<and> closed_hfm B"
 | "closed_hfm (HNeg A) \<longleftrightarrow> closed_hfm A"

lemma closed_hfm_Conj[simp]:
  "closed_hfm (HConj A B) \<longleftrightarrow> closed_hfm A \<and> closed_hfm B"
unfolding HConj_def by simp

lemma quot_closed_hfm[simp]: "closed_hfm A \<Longrightarrow> \<guillemotleft>A\<guillemotright> = \<guillemotleft>hfm_to_fm A\<guillemotright>"
  by (induction A) (auto simp add: quot_fm_def)

declare quot_hfm.simps[simp del]

section \<open>Fitch's proof\<close>

text \<open>
For simplicity, Fitch (and we) restrict the week to two days. Propositions \<open>Q\<^sub>1\<close> and \<open>Q\<^sub>2\<close>
represent the propositions that the hanging occurs on the first resp.\@ the second day, but
these can obviously be any propositions.
\<close>

context
  fixes Q\<^sub>1 :: fm and Q\<^sub>2 :: fm
  assumes Q_closed: "supp Q\<^sub>1 = {}" "supp Q\<^sub>2 = {}"
begin

  text \<open>
  In order to define the judge's proposition, which is self-referential, we apply the usual trick
  of defining a proposition with a variable, and then using Gödel's diagonalisation lemma.
  \<close>

  definition H :: fm where
    "H = Q\<^sub>1 AND Neg (PfP \<guillemotleft>HVar X0 HIMP HFm Q\<^sub>1\<guillemotright>) XOR
     Q\<^sub>2 AND Neg (PfP \<guillemotleft>HVar X0 HAND HNeg (HFm Q\<^sub>1) HIMP (HFm Q\<^sub>2)\<guillemotright>)"

  definition P where "P = (SOME P. {} \<turnstile> P IFF H(X0 ::= \<guillemotleft>P\<guillemotright>))"

  lemma P': "{} \<turnstile> P IFF H(X0 ::= \<guillemotleft>P\<guillemotright>)"
  proof-
    from diagonal[where \<alpha> = "H" and i = X0]
    obtain \<delta> where "{} \<turnstile> \<delta> IFF H(X0 ::= \<guillemotleft>\<delta>\<guillemotright>)".
    thus ?thesis  unfolding P_def by (rule someI)
  qed

  text \<open>
  From now on, the lemmas are named after their number in Fitch's paper, and correspond to his
  statements pleasingly closely.
  \<close>

  lemma 7: "{} \<turnstile> P IFF
     (Q\<^sub>1 AND Neg (PfP \<guillemotleft>P IMP Q\<^sub>1\<guillemotright>) XOR
      Q\<^sub>2 AND Neg (PfP \<guillemotleft>P AND Neg Q\<^sub>1 IMP Q\<^sub>2\<guillemotright>))"
    using P' unfolding H_def
    by (simp add: Q_closed forget_subst_fm[unfolded fresh_def])
  lemmas "7_E" = 7[THEN thin0, THEN Iff_MP_left', OF Conj_E, OF thin2]

  lemmas propositional_calculus =
    AssumeH Neg_I Imp_I Conj_E Disj_E ExFalso[OF Neg_E]
    ExFalso[OF rotate2, OF Neg_E] ExFalso[OF rotate3, OF Neg_E]

  lemma 8: "{} \<turnstile> (P AND Neg Q\<^sub>1) IMP Q\<^sub>2"
    by (intro propositional_calculus "7_E")

  lemma 10: "{} \<turnstile> PfP \<guillemotleft>(P AND Neg Q\<^sub>1) IMP Q\<^sub>2\<guillemotright>"
    using 8 by (rule proved_imp_proved_PfP)
  lemmas "10_I" = 10[THEN thin0]

  lemma 11: "{} \<turnstile> P IMP Q\<^sub>1"
    by (intro propositional_calculus "7_E" "10_I")

  lemma 12: "{} \<turnstile> PfP \<guillemotleft>P IMP Q\<^sub>1\<guillemotright>"
    using 11 by (rule proved_imp_proved_PfP)
  lemmas "12_I" = 12[THEN thin0]

  lemma 13: "{} \<turnstile> Neg P"
    by (intro propositional_calculus "7_E" "10_I" "12_I")
end

section \<open>Substitution, quoting and V-quoting\<close>

text \<open>In the end, we did not need the lemma at the end of this section, but it may be useful to
others.\<close>

lemma trans_tm_forgets: "atom ` set is \<sharp>* t \<Longrightarrow> trans_tm is t = trans_tm [] t"
  by (induct t rule: tm.induct)
     (auto simp: lookup_notin fresh_star_def fresh_at_base)

lemma vquot_dbtm_fresh: "atom ` V \<sharp>* t \<Longrightarrow> vquot_dbtm V t = quot_dbtm t"
  by (nominal_induct t rule: dbtm.strong_induct)
     (auto simp add: fresh_star_def fresh_at_base)

lemma subst_vquot_dbtm_trans_tm[simp]:
  "atom i \<sharp> is \<Longrightarrow> atom ` set is \<sharp>* t \<Longrightarrow>
   subst i \<guillemotleft>t\<guillemotright> (vquot_dbtm {i} (trans_tm is t')) =
   quot_dbtm (trans_tm is (subst i t t'))"
  by (nominal_induct t' avoiding: "is" i t rule: tm.strong_induct)
     (auto simp add:  quot_tm_def lookup_notin fresh_imp_notin_env
                      vquot_dbtm_fresh lookup_fresh
           intro: trans_tm_forgets[symmetric])

lemma subst_vquot_dbtm_trans_fm[simp]:
  "atom i \<sharp> is \<Longrightarrow> atom ` set is \<sharp>* t \<Longrightarrow>
   subst i \<guillemotleft>t\<guillemotright> (vquot_dbfm {i} (trans_fm is A)) =
   quot_dbfm (trans_fm is (subst_fm A i t))"
  by (nominal_induct A avoiding: "is" i t rule: fm.strong_induct)
     (auto simp add: quot_fm_def fresh_Cons)

lemma subst_vquot[simp]:
  "subst i \<guillemotleft>t\<guillemotright> \<lfloor>A\<rfloor>{i} = \<guillemotleft>A(i ::= t)\<guillemotright>"
  by (nominal_induct A avoiding: i t rule: fm.strong_induct)
     (auto simp add: vquot_fm_def quot_fm_def fresh_Cons)

end


theory prop_26
imports Main
        "$HIPSTER_HOME/IsaHipster"
begin
  datatype Nat = Z | S "Nat"
  fun plus :: "Nat => Nat => Nat" where
  "plus (Z) y = y"
  | "plus (S z) y = S (plus z y)"
  fun half :: "Nat => Nat" where
  "half (Z) = Z"
  | "half (S (Z)) = Z"
  | "half (S (S z)) = S (half z)"
  (*hipster plus half *)

lemma lemma_a [thy_expl]: "plus x2 Z = x2"
by (hipster_induct_schemes plus.simps)

lemma lemma_aa [thy_expl]: "plus (plus x2 y2) z2 = plus x2 (plus y2 z2)"
by (hipster_induct_schemes plus.simps)

lemma lemma_ab [thy_expl]: "plus x2 (S y2) = S (plus x2 y2)"
by (hipster_induct_schemes plus.simps)

lemma lemma_ac [thy_expl]: "plus x1 (plus y1 x1) = plus y1 (plus x1 x1)"
by (hipster_induct_schemes plus.simps)

lemma lemma_ad [thy_expl]: "plus x2 (plus y2 y2) = plus y2 (plus y2 x2)"
by (hipster_induct_schemes plus.simps)

lemma lemma_ae [thy_expl]: "plus x2 (S y2) = S (plus y2 x2)"
by (hipster_induct_schemes plus.simps)

lemma lemma_af [thy_expl]: "plus (S x2) y2 = S (plus y2 x2)"
by (hipster_induct_schemes plus.simps)

lemma lemma_ag [thy_expl]: "plus (plus x2 y2) (plus x2 z2) =
plus (plus x2 z2) (plus x2 y2)"
by (hipster_induct_schemes plus.simps)

lemma lemma_ah [thy_expl]: "plus (plus x2 y2) (plus z2 x2) = plus (plus z2 x2) (plus x2 y2)"
by (hipster_induct_schemes plus.simps)

lemma lemma_ai [thy_expl]: "plus x2 (plus y2 z2) = plus y2 (plus z2 x2)"
by (hipster_induct_schemes plus.simps)

(*hipster plus half
lemma lemma_aj [thy_expl]: "half (plus x1 x1) = x1"
by (hipster_induct_schemes plus.simps half.simps)*)

  theorem x0 :
    "(half (plus x y)) = (half (plus y x))"
    by (tactic \<open>Subgoal.FOCUS_PARAMS (K (Tactic_Data.hard_tac @{context})) @{context} 1\<close>)
end


theory TwoSum
imports
  TwoProdFMA
  test_utils
  "$AFP/IEEE_Floating_Point/FloatProperty"
begin

subsection \<open>Further operations\<close>

code_printing
  code_module "ULP_Float" \<rightharpoonup> (SML)
  \<open>fun ulp_float x =
  let
    val (m, e) = tomanexp x
  in
    Real.fromManExp {man = 1.0, exp = e}
  end\<close>

definition ulp_float::"float \<Rightarrow> float" where "ulp_float x = undefined"
code_printing constant "ulp_float :: float \<Rightarrow> float" \<rightharpoonup> (SML) "ulp'_float"
declare ulp_float_def[code del]

subsection \<open>Needed Float Properties\<close>

lemma fadd_finite_notIsnan: "Finite a \<Longrightarrow> Finite b \<Longrightarrow> \<not>Isnan (a + b)"
  sorry

subsection \<open>Implementation\<close>

(* s for sum, e for error *)
fun twoSum::"float * float \<Rightarrow> float *float"
  where "twoSum (a, b) =
    (let
      s = a + b;
      an = s - b;
      bn = s - an;
      da = a - an;
      db = b - bn;
      e = da + db
    in (s, e))"

code_thms twoSum
export_code twoSum in SML
subsection \<open>Properties\<close>

lemma twoSum_correct1_eq:
  shows "fst (twoSum (a, b)) = a + b"
  by (metis Pair_inject prod.collapse twoSum.simps)

corollary twoSum_correct1:
  assumes "Finite (a + b)"
  shows "fst (twoSum (a, b)) \<doteq> (a + b)"
  using assms float_eq twoSum_correct1_eq by presburger

corollary s_finite: "Finite (a + b) \<longleftrightarrow> Finite (fst (twoSum(a, b)))"
  using twoSum_correct1_eq by simp

corollary twoSum_swaps:
  assumes "Finite a" and "Finite b"
  assumes "(s, e) = twoSum (a, b)"
  assumes "(s', e') = twoSum (b, a)"
  shows twoSum_swap: "s' = s" (*TODO: and "e' = e" *)
  and twoSum_swap': "s' \<doteq> s" (*TODO: and "e' \<doteq> e" *)
  apply (metis assms float_plus_comm_eq fst_conv twoSum_correct1_eq)
  apply (metis assms float_plus_comm_eq fst_conv twoSum_correct1_eq
    float_eq_refl fadd_finite_notIsnan)
  done

lemma twoSum_correct2:
  assumes "Finite a" and "Finite b" and "Finite (a + b)"
  assumes "(s, e) = twoSum (a, b)"
  shows "Val a + Val b = Val s + Val e"
  sorry

lemma fadd_twoSum_s_e:
  assumes "(s, e) = twoSum (a, b)"
  assumes "Finite a" "Finite b" "Finite s" "Finite e"
  shows "(s + e) \<doteq> s"
  using assms
  sorry

corollary twoSum_idempotent:
  assumes "(s, e) = twoSum (a, b)"
  assumes "(s', e') = twoSum (s, e)"
  assumes "Finite a" "Finite b" "Finite s" "Finite e"
  shows "s' \<doteq> s" (*TODO: and "e' \<doteq> e"*)
  using assms
  apply (metis fadd_twoSum_s_e fst_conv twoSum_correct1_eq)
  done

lemma twoSum_e_le_ulp:
  assumes "(s, e) = twoSum (a, b)"
  assumes "Finite a" "Finite b" "Finite s" "Finite e"
  shows"e \<le> ulp_float s"
  sorry

lemma twoSum_abs_le:
  assumes "(s, e) = twoSum (a, b)"
  assumes "Finite a" "Finite b" "Finite s" "Finite e"
  shows "float_abs e \<le> float_abs s"
  sorry

lemma err:
  assumes "Isnormal a" "Isnormal b" "Isnormal (a + b)"
  shows "abs (Val a + Val b - Val (a + b)) \<le> abs (Val a)" (is "?abs_err \<le> abs (Val a)")
using assms
proof cases
  assume f1: "abs (Val a) \<ge> abs (Val b)"
  have f2: "Finite (a + b)"
    by (simp add: Finite_def assms(3))
  with f1 f2 have f4: "\<forall>fp. abs (Val a + Val b - Val fp) \<ge> ?abs_err"
    sorry
  then have "?abs_err \<le> abs (Val b)"
    by (meson eq_iff order_trans sin_bound_lemma)
  with f1 show ?thesis
    by simp
next
  assume "\<not>abs (Val a) \<ge> abs (Val b)"
  show ?thesis sorry
qed

subsection \<open>regular and safe_bound\<close>

--\<open>Ensure that the multiplication in safe_bound is exact.
  ToDo: find a more sensible constraint using fracwidth\<close>
fun length_ok :: "float list \<Rightarrow> bool" where
  "length_ok [] = True" |
  "length_ok (a # as) \<longleftrightarrow> (let
    n = float_of_int (length as);
    u = ulp_float a
    in Finite (n*u) \<and> Iszero (snd (twoProdFMA n u)))"

fun regular :: "float list \<Rightarrow> bool" where
  "regular [] = True" |
  "regular (a # as) \<longleftrightarrow> Finite a \<and> list_all (\<lambda>y. float_abs y \<le> ulp_float a) as
    \<and> length_ok (a # as)"

--\<open>safe_bound, when applied to a regular multiple precision float x (e.g. as produced by vecSum),
gives a pair (v, b), such that x represents a value in v + [-b; b]\<close>
fun safe_bound :: "float list \<Rightarrow> float \<times> float" where
  "safe_bound [] = (Plus_zero, Plus_zero)" |
  "safe_bound (x # xs) = (x, float_of_int (length xs) * ulp_float(x))"

end