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

theory CSP_F_law_decompo
imports CSP_F_domain CSP_T_law_decompo
begin

(*------------------------------------------------*
 |                                                |
 |      laws for monotonicity and congruence      |
 |                                                |
 *------------------------------------------------*)

(*********************************************************
                        Act_prefix mono
 *********************************************************)

(*------------------*
 |      csp law     |
 *------------------*)

lemma cspF_Act_prefix_mono:
  "[| a = b ; P <=F[M1,M2] Q |] ==> a -> P <=F[M1,M2] b -> Q"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Act_prefix_mono)
apply (simp add: subsetF_iff)
apply (intro allI impI)
apply (simp add: in_failures)
apply (fast)
done

lemma cspF_Act_prefix_cong:
  "[| a = b ; P =F[M1,M2] Q |] ==> a -> P =F[M1,M2] b -> Q"
apply (simp add: cspF_eq_ref_iff)
apply (simp add: cspF_Act_prefix_mono)
done

(*********************************************************
                   Ext_pre_choice mono
 *********************************************************)

(*------------------*
 |      csp law     |
 *------------------*)

lemma cspF_Ext_pre_choice_mono:
  "[| X = Y ; !! a. a:Y ==> Pf a <=F[M1,M2] Qf a |]
    ==> ? :X -> Pf <=F[M1,M2] ? :Y -> Qf"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Ext_pre_choice_mono)
apply (simp add: subsetF_iff)
apply (intro allI impI)
apply (simp add: in_failures)
apply (fast)
done

lemma cspF_Ext_pre_choice_cong:
  "[| X = Y ; !! a. a:Y ==> Pf a =F[M1,M2] Qf a |]
    ==> ? :X -> Pf =F[M1,M2] ? :Y -> Qf"
by (simp add: cspF_eq_ref_iff cspF_Ext_pre_choice_mono)

(*********************************************************
                      Ext choice mono
 *********************************************************)

(*------------------*
 |      csp law     |
 *------------------*)

lemma cspF_Ext_choice_mono:
  "[| P1 <=F[M1,M2] Q1 ; P2 <=F[M1,M2] Q2 |] ==> P1 [+] P2 <=F[M1,M2] Q1 [+] Q2"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Ext_choice_mono)
apply (simp add: cspT_semantics)
apply (simp add: subdomT_iff)
apply (simp add: subsetF_iff)
apply (intro allI impI)
apply (simp add: in_failures)
apply (elim conjE disjE)
apply (force)+
done

lemma cspF_Ext_choice_cong:
  "[| P1 =F[M1,M2] Q1 ; P2 =F[M1,M2] Q2 |] ==> P1 [+] P2 =F[M1,M2] Q1 [+] Q2"
by (simp add: cspF_eq_ref_iff cspF_Ext_choice_mono)

(*********************************************************
                      Int choice mono
 *********************************************************)

(*------------------*
 |      csp law     |
 *------------------*)

lemma cspF_Int_choice_mono:
  "[| P1 <=F[M1,M2] Q1 ; P2 <=F[M1,M2] Q2 |] ==> P1 |~| P2 <=F[M1,M2] Q1 |~| Q2"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Int_choice_mono)
apply (simp add: subsetF_iff)
apply (intro allI impI)
apply (simp add: in_failures)
apply (fast)
done

lemma cspF_Int_choice_cong:
  "[| P1 =F[M1,M2] Q1 ; P2 =F[M1,M2] Q2 |] ==> P1 |~| P2 =F[M1,M2] Q1 |~| Q2"
by (simp add: cspF_eq_ref_iff cspF_Int_choice_mono)

(*********************************************************
               replicated internal choice
 *********************************************************)

(*------------------*
 |      csp law     |
 *------------------*)

(* mono *)

lemma cspF_Rep_int_choice_mono_sum:
  "[| C1 = C2 ; !! c. c: sumset C1 ==> Pf c <=F[M1,M2] Qf c |]
      ==> !! :C1 .. Pf <=F[M1,M2] !! :C2 .. Qf"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Rep_int_choice_mono_sum)
apply (simp add: subsetF_iff)
apply (intro allI impI)
apply (simp add: in_failures)
apply (fast)
done

lemma cspF_Rep_int_choice_mono_nat:
  "[| N1 = N2 ; !! n. n:N2 ==> Pf n <=F[M1,M2] Qf n |]
      ==> !nat :N1 .. Pf <=F[M1,M2] !nat :N2 .. Qf"
apply (simp add: Rep_int_choice_ss_def)
by (rule cspF_Rep_int_choice_mono_sum, auto)

lemma cspF_Rep_int_choice_mono_set:
  "[| Xs1 = Xs2 ; !! X. X:Xs2 ==> Pf X <=F[M1,M2] Qf X |]
      ==> !set :Xs1 .. Pf <=F[M1,M2] !set :Xs2 .. Qf"
apply (simp add: Rep_int_choice_ss_def)
by (rule cspF_Rep_int_choice_mono_sum, auto)

lemma cspF_Rep_int_choice_mono_com:
  "[| X1 = X2 ; !! x. x:X2 ==> Pf x <=F[M1,M2] Qf x |]
      ==> ! :X1 .. Pf <=F[M1,M2] ! :X2 .. Qf"
apply (simp add: Rep_int_choice_com_def)
by (rule cspF_Rep_int_choice_mono_set, auto)

lemma cspF_Rep_int_choice_mono_f:
  "[| inj f ; X1 = X2 ; !! x. x:X2 ==> Pf x <=F[M1,M2] Qf x |]
      ==> !<f> :X1 .. Pf <=F[M1,M2] !<f> :X2 .. Qf"
apply (simp add: Rep_int_choice_f_def)
by (rule cspF_Rep_int_choice_mono_com, auto)

lemmas cspF_Rep_int_choice_mono = cspF_Rep_int_choice_mono_sum
                                  cspF_Rep_int_choice_mono_nat
                                  cspF_Rep_int_choice_mono_set
                                  cspF_Rep_int_choice_mono_com
                                  cspF_Rep_int_choice_mono_f

(* cong *)

lemma cspF_Rep_int_choice_cong_sum:
  "[| C1 = C2 ; !! c. c: sumset C1 ==> Pf c =F[M1,M2] Qf c |]
      ==> !! :C1 .. Pf =F[M1,M2] !! :C2 .. Qf"
by (simp add: cspF_eq_ref_iff cspF_Rep_int_choice_mono)

lemma cspF_Rep_int_choice_cong_nat:
  "[| N1 = N2 ; !! n. n:N2 ==> Pf n =F[M1,M2] Qf n |]
      ==> !nat :N1 .. Pf =F[M1,M2] !nat :N2 .. Qf"
by (simp add: cspF_eq_ref_iff cspF_Rep_int_choice_mono)

lemma cspF_Rep_int_choice_cong_set:
  "[| Xs1 = Xs2 ; !! X. X:Xs2 ==> Pf X =F[M1,M2] Qf X |]
      ==> !set :Xs1 .. Pf =F[M1,M2] !set :Xs2 .. Qf"
by (simp add: cspF_eq_ref_iff cspF_Rep_int_choice_mono)

lemma cspF_Rep_int_choice_cong_com:
  "[| X1 = X2 ; !! x. x:X2 ==> Pf x =F[M1,M2] Qf x |]
      ==> ! :X1 .. Pf =F[M1,M2] ! :X2 .. Qf"
by (simp add: cspF_eq_ref_iff cspF_Rep_int_choice_mono)

lemma cspF_Rep_int_choice_cong_f:
  "[| inj f ; X1 = X2 ; !! x. x:X2 ==> Pf x =F[M1,M2] Qf x |]
      ==> !<f> :X1 .. Pf =F[M1,M2] !<f> :X2 .. Qf"
by (simp add: cspF_eq_ref_iff cspF_Rep_int_choice_mono)

lemmas cspF_Rep_int_choice_cong = cspF_Rep_int_choice_cong_sum
                                  cspF_Rep_int_choice_cong_nat
                                  cspF_Rep_int_choice_cong_set
                                  cspF_Rep_int_choice_cong_com
                                  cspF_Rep_int_choice_cong_f

(*********************************************************
                   IF mono
 *********************************************************)

(*------------------*
 |      csp law     |
 *------------------*)

lemma cspF_IF_mono:
  "[| b1 = b2 ; P1 <=F[M1,M2] Q1 ; P2 <=F[M1,M2] Q2 |]
           ==> IF b1 THEN P1 ELSE P2 <=F[M1,M2]
               IF b2 THEN Q1 ELSE Q2"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_IF_mono)
apply (simp add: subsetF_iff)
apply (intro allI impI)
apply (simp add: in_failures)
done

lemma cspF_IF_cong:
  "[| b1 = b2 ; P1 =F[M1,M2] Q1 ;  P2 =F[M1,M2] Q2 |]
           ==> IF b1 THEN P1 ELSE P2 =F[M1,M2]
               IF b2 THEN Q1 ELSE Q2"
by (simp add: cspF_eq_ref_iff cspF_IF_mono)

(*********************************************************
                     Parallel mono
 *********************************************************)

(*------------------*
 |      csp law     |
 *------------------*)

lemma cspF_Parallel_mono:
  "[| X = Y ; P1 <=F[M1,M2] Q1 ; P2 <=F[M1,M2] Q2 |]
           ==> P1 |[X]| P2 <=F[M1,M2] Q1 |[Y]| Q2"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Parallel_mono)
apply (simp add: subsetF_iff)
apply (intro allI impI)
apply (simp add: in_failures)
apply (fast)
done

lemma cspF_Parallel_cong:
  "[| X = Y ; P1 =F[M1,M2] Q1 ; P2 =F[M1,M2] Q2 |]
           ==> P1 |[X]| P2 =F[M1,M2] Q1 |[Y]| Q2"
by (simp add: cspF_eq_ref_iff cspF_Parallel_mono)

(*********************************************************
                        Hiding mono
 *********************************************************)

(*------------------*
 |      csp law     |
 *------------------*)

lemma cspF_Hiding_mono:
  "[| X = Y ; P <=F[M1,M2] Q |] ==> P -- X <=F[M1,M2] Q -- Y"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Hiding_mono)
apply (simp add: subsetF_iff)
apply (intro allI impI)
apply (simp add: in_failures)
apply (fast)
done

lemma cspF_Hiding_cong:
  "[| X = Y ; P =F[M1,M2] Q |] ==> P -- X =F[M1,M2] Q -- Y"
by (simp add: cspF_eq_ref_iff cspF_Hiding_mono)

(*********************************************************
                        Renaming mono
 *********************************************************)

(*------------------*
 |      csp law     |
 *------------------*)

lemma cspF_Renaming_mono:
  "[| r1 = r2 ; P <=F[M1,M2] Q |] ==> P [[r1]] <=F[M1,M2] Q [[r2]]"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Renaming_mono)
apply (simp add: subsetF_iff)
apply (intro allI impI)
apply (simp add: in_failures)
apply (fast)
done

lemma cspF_Renaming_cong:
  "[| r1 = r2 ; P =F[M1,M2] Q |] ==> P [[r1]] =F[M1,M2] Q [[r2]]"
by (simp add: cspF_eq_ref_iff cspF_Renaming_mono)

(*********************************************************
               Sequential composition mono
 *********************************************************)

(*------------------*
 |      csp law     |
 *------------------*)

lemma cspF_Seq_compo_mono:
  "[| P1 <=F[M1,M2] Q1 ; P2 <=F[M1,M2] Q2 |]
           ==> P1 ;; P2 <=F[M1,M2] Q1 ;; Q2"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Seq_compo_mono)
apply (simp add: cspT_semantics)
apply (simp add: subdomT_iff)
apply (simp add: subsetF_iff)
apply (intro allI impI)
apply (simp add: in_failures)
apply (fast)
done

lemma cspF_Seq_compo_cong:
  "[| P1 =F[M1,M2] Q1 ; P2 =F[M1,M2] Q2 |] ==> P1 ;; P2 =F[M1,M2] Q1 ;; Q2"
by (simp add: cspF_eq_ref_iff cspF_Seq_compo_mono)

(*********************************************************
                       Depth_rest mono
 *********************************************************)

(*------------------*
 |      csp law     |
 *------------------*)

lemma cspF_Depth_rest_mono:
  "[| n1 = n2 ; P <=F[M1,M2] Q |] ==> P |. n1 <=F[M1,M2] Q |. n2"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Depth_rest_mono)
apply (simp add: subsetF_iff)
apply (intro allI impI)
apply (simp add: in_failures)
done

lemma cspF_Depth_rest_cong:
  "[| n1 = n2 ; P =F[M1,M2] Q |] ==> P |. n1 =F[M1,M2] Q |. n2"
by (simp add: cspF_eq_ref_iff cspF_Depth_rest_mono)

(*********************************************************
                        Timeout mono
 *********************************************************)

(*------------------*
 |      csp law     |
 *------------------*)

lemma cspF_Timeout_mono:
  "[| P1 <=F[M1,M2] Q1 ; P2 <=F[M1,M2] Q2 |]
      ==> P1 [> P2 <=F[M1,M2] Q1 [> Q2"
apply (rule cspF_Ext_choice_mono)
apply (rule cspF_Int_choice_mono)
by (simp_all)

lemma cspF_Timeout_cong:
  "[| P1 =F[M1,M2] Q1 ; P2 =F[M1,M2] Q2 |]
      ==> P1 [> P2 =F[M1,M2] Q1 [> Q2"
by (simp add: cspF_eq_ref_iff cspF_Timeout_mono)

(*------------------------------------------------------*
 |                       alias                          |
 *------------------------------------------------------*)

lemmas cspF_free_mono =
   cspF_Ext_choice_mono cspF_Int_choice_mono cspF_Parallel_mono
   cspF_Hiding_mono cspF_Renaming_mono cspF_Seq_compo_mono
   cspF_Depth_rest_mono

lemmas cspF_mono = cspF_free_mono
   cspF_Act_prefix_mono cspF_Ext_pre_choice_mono
   cspF_Rep_int_choice_mono cspF_IF_mono

lemmas cspF_free_cong =
   cspF_Ext_choice_cong cspF_Int_choice_cong cspF_Parallel_cong
   cspF_Hiding_cong cspF_Renaming_cong cspF_Seq_compo_cong
   cspF_Depth_rest_cong

lemmas cspF_cong = cspF_free_cong
   cspF_Act_prefix_cong cspF_Ext_pre_choice_cong
   cspF_Rep_int_choice_cong cspF_IF_cong

lemmas cspF_free_decompo = cspF_free_mono cspF_free_cong
lemmas cspF_decompo = cspF_mono cspF_cong

lemmas cspF_rm_head_mono = cspF_Act_prefix_mono cspF_Ext_pre_choice_mono
lemmas cspF_rm_head_cong = cspF_Act_prefix_cong cspF_Ext_pre_choice_cong
lemmas cspF_rm_head      = cspF_rm_head_mono cspF_rm_head_cong

(*-------------------------------------------------------*
 |            decomposition with ALL and EX              |
 *-------------------------------------------------------*)

(*** Rep_int_choice ***)

lemma cspF_Rep_int_choice_sum_decompo_ALL_EX_ref:
  "ALL c2: sumset C2. EX c1: sumset C1. (Pf c1) <=F[M1,M2] (Qf c2)
   ==> !! :C1 .. Pf <=F[M1,M2] !! :C2 .. Qf"
apply (simp add: cspF_cspT_semantics)
apply (rule conjI)
apply (rule cspT_Rep_int_choice_decompo_ALL_EX)
apply (force)
apply (rule, simp add: in_failures)
apply (erule bexE)
apply (drule_tac x="c" in bspec, simp)
apply (erule bexE)
apply (rule_tac x="c1" in bexI)
apply (force)
apply (simp)
done

lemma cspF_Rep_int_choice_nat_decompo_ALL_EX_ref:
  "ALL n2:N2. EX n1:N1. (Pf n1) <=F[M1,M2] (Qf n2)
   ==> !nat :N1 .. Pf <=F[M1,M2] !nat :N2 .. Qf"
apply (simp add: Rep_int_choice_ss_def)
apply (rule cspF_Rep_int_choice_sum_decompo_ALL_EX_ref)
apply (auto)
apply (drule_tac x="a" in bspec, simp)
apply (auto)
done

lemma cspF_Rep_int_choice_set_decompo_ALL_EX_ref:
  "ALL X2:Xs2. EX X1:Xs1. (Pf X1) <=F[M1,M2] (Qf X2)
   ==> !set :Xs1 .. Pf <=F[M1,M2] !set :Xs2 .. Qf"
apply (simp add: Rep_int_choice_ss_def)
apply (rule cspF_Rep_int_choice_sum_decompo_ALL_EX_ref)
apply (auto)
apply (drule_tac x="a" in bspec, simp)
apply (auto)
done

lemmas cspF_Rep_int_choice_decompo_ALL_EX_ref =
       cspF_Rep_int_choice_sum_decompo_ALL_EX_ref
       cspF_Rep_int_choice_nat_decompo_ALL_EX_ref
       cspF_Rep_int_choice_set_decompo_ALL_EX_ref

lemma cspF_Rep_int_choice_sum_decompo_ALL_EX_eq:
  "[| ALL c1: sumset C1. EX c2: sumset C2. (Pf c1) =F[M1,M2] (Qf c2) ;
      ALL c2: sumset C2. EX c1: sumset C1. (Pf c1) =F[M1,M2] (Qf c2) |]
   ==> !! :C1 .. Pf =F[M1,M2] !! :C2 .. Qf"
apply (simp add: cspF_eq_ref_iff)
apply (rule conjI)
apply (rule cspF_Rep_int_choice_decompo_ALL_EX_ref)
apply (force)
apply (rule cspF_Rep_int_choice_decompo_ALL_EX_ref)
apply (force)
done

lemma cspF_Rep_int_choice_nat_decompo_ALL_EX_eq:
  "[| ALL n1:N1. EX n2:N2. (Pf n1) =F[M1,M2] (Qf n2) ;
      ALL n2:N2. EX n1:N1. (Pf n1) =F[M1,M2] (Qf n2) |]
   ==> !nat :N1 .. Pf =F[M1,M2] !nat :N2 .. Qf"
apply (simp add: cspF_eq_ref_iff)
apply (rule conjI)
apply (rule cspF_Rep_int_choice_decompo_ALL_EX_ref)
apply (force)
apply (rule cspF_Rep_int_choice_decompo_ALL_EX_ref)
apply (force)
done

lemma cspF_Rep_int_choice_set_decompo_ALL_EX_eq:
  "[| ALL X1:Xs1. EX X2:Xs2. (Pf X1) =F[M1,M2] (Qf X2) ;
      ALL X2:Xs2. EX X1:Xs1. (Pf X1) =F[M1,M2] (Qf X2) |]
   ==> !set :Xs1 .. Pf =F[M1,M2] !set :Xs2 .. Qf"
apply (simp add: cspF_eq_ref_iff)
apply (rule conjI)
apply (rule cspF_Rep_int_choice_decompo_ALL_EX_ref)
apply (force)
apply (rule cspF_Rep_int_choice_decompo_ALL_EX_ref)
apply (force)
done

lemmas cspF_Rep_int_choice_decompo_ALL_EX_eq =
       cspF_Rep_int_choice_sum_decompo_ALL_EX_eq
       cspF_Rep_int_choice_nat_decompo_ALL_EX_eq
       cspF_Rep_int_choice_set_decompo_ALL_EX_eq

lemmas cspF_Rep_int_choice_decompo_ALL_EX
     = cspF_Rep_int_choice_decompo_ALL_EX_ref
       cspF_Rep_int_choice_decompo_ALL_EX_eq

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

(*********************************************************
                        Act_prefix mono
 *********************************************************)

(*------------------*
 |      csp law     |
 *------------------*)

(** mono **)

lemma cspF_Send_prefix_mono:
  "[| a = b ; P <=F[M1,M2] Q |] ==> a ! v -> P <=F[M1,M2] b ! v -> Q"
apply (simp add: csp_prefix_ss_def)
apply (simp add: cspF_decompo)
done

lemma cspF_Rec_prefix_mono:
  "[| inj a; a = b ; X = Y ;
      !! x. x:Y ==> Pf x <=F[M1,M2] Qf x |]
    ==> a ? x:X -> Pf x <=F[M1,M2] b ? x:Y -> Qf x"
apply (simp add: csp_prefix_ss_def)
apply (rule cspF_Ext_pre_choice_mono)
apply (simp)
apply (simp add: image_iff)
apply (erule bexE)
apply (simp)
done

lemma cspF_Int_pre_choice_mono:
  "[| X = Y ;
      !! x. x:Y ==> Pf x <=F[M1,M2] Qf x |]
    ==> ! :X -> Pf <=F[M1,M2] ! :Y -> Qf"
apply (simp add: csp_prefix_ss_def)
apply (simp add: cspF_decompo)
done

lemma cspF_Nondet_send_prefix_mono:
  "[| inj a; a = b ; X = Y ;
      !! x. x:Y ==> Pf x <=F[M1,M2] Qf x |]
    ==> a !? x:X -> Pf x <=F[M1,M2] b !? x:Y -> Qf x"
apply (simp add: csp_prefix_ss_def)
apply (rule cspF_mono)
apply (simp)
apply (rule cspF_mono)
apply (simp)
apply (simp add: image_iff)
apply (erule bexE)
apply (simp)
done

(** cong **)

lemma cspF_Send_prefix_cong:
  "[| a = b ; P =F[M1,M2] Q |] ==> a ! v -> P =F[M1,M2] b ! v -> Q"
apply (simp add: csp_prefix_ss_def)
apply (simp add: cspF_decompo)
done

lemma cspF_Rec_prefix_cong:
  "[| inj a; a = b ; X = Y ;
      !! x. x:Y ==> Pf x =F[M1,M2] Qf x |]
    ==> a ? x:X -> Pf x =F[M1,M2] b ? x:Y -> Qf x"
by (simp add: cspF_eq_ref_iff cspF_Rec_prefix_mono)

lemma cspF_Int_pre_choice_cong:
  "[| X = Y ;
      !! x. x:Y ==> Pf x =F[M1,M2] Qf x |]
    ==> ! :X -> Pf =F[M1,M2] ! :Y -> Qf"
apply (simp add: csp_prefix_ss_def)
apply (simp add: cspF_decompo)
done

lemma cspF_Nondet_send_prefix_cong:
  "[| inj a; a = b ; X = Y ;
      !! x. x:Y ==> Pf x =F[M1,M2] Qf x |]
    ==> a !? x:X -> Pf x =F[M1,M2] b !? x:Y -> Qf x"
by (simp add: cspF_eq_ref_iff cspF_Nondet_send_prefix_mono)

lemmas cspF_prefix_ss_mono = cspF_Send_prefix_mono
                             cspF_Rec_prefix_mono
                             cspF_Int_pre_choice_mono
                             cspF_Nondet_send_prefix_mono

lemmas cspF_prefx_ss_cong = cspF_Send_prefix_cong
                            cspF_Rec_prefix_cong
                            cspF_Int_pre_choice_cong
                            cspF_Nondet_send_prefix_cong

(* ------------------------------------------------------ *
                 decomposition with ss
 * ------------------------------------------------------ *)

lemmas cspF_mono_ss = cspF_mono  cspF_prefix_ss_mono
lemmas cspF_cong_ss = cspF_cong  cspF_prefx_ss_cong
lemmas cspF_decompo_ss = cspF_mono_ss cspF_cong_ss

(*********************************************************
             Rep_internal_choice for UNIV
              this is useful for tactic
 *********************************************************)

(*------------------*
 |      csp law     |
 *------------------*)

(* mono_UNIV *)

lemma cspF_Rep_int_choice_mono_UNIV_nat:
  "[| !! n. Pf n <=F[M1,M2] Qf n |]
      ==> !nat n .. Pf n <=F[M1,M2] !nat n .. Qf n"
by (simp add: cspF_Rep_int_choice_mono)

lemma cspF_Rep_int_choice_mono_UNIV_set:
  "[| !! X. Pf X <=F[M1,M2] Qf X |]
      ==> !set X .. Pf X <=F[M1,M2] !set X .. Qf X"
by (simp add: cspF_Rep_int_choice_mono)

lemma cspF_Rep_int_choice_mono_UNIV_com:
  "[| !! x. Pf x <=F[M1,M2] Qf x |]
      ==> ! x .. Pf x <=F[M1,M2] ! x .. Qf x"
by (simp add: cspF_Rep_int_choice_mono)

lemma cspF_Rep_int_choice_mono_UNIV_f:
  "[| inj f ; !! x. Pf x <=F[M1,M2] Qf x |]
      ==> !<f> x .. Pf x <=F[M1,M2] !<f> x .. Qf x"
by (simp add: cspF_Rep_int_choice_mono)

lemmas cspF_Rep_int_choice_mono_UNIV =
      cspF_Rep_int_choice_mono_UNIV_nat
      cspF_Rep_int_choice_mono_UNIV_set
      cspF_Rep_int_choice_mono_UNIV_com
      cspF_Rep_int_choice_mono_UNIV_f

(* cong *)

lemma cspF_Rep_int_choice_cong_UNIV_nat:
  "[| !! n. Pf n =F[M1,M2] Qf n |]
      ==> !nat n .. Pf n =F[M1,M2] !nat n .. Qf n"
by (simp add: cspF_Rep_int_choice_cong)

lemma cspF_Rep_int_choice_cong_UNIV_set:
  "[| !! X. Pf X =F[M1,M2] Qf X |]
      ==> !set X .. Pf X =F[M1,M2] !set X .. Qf X"
by (simp add: cspF_Rep_int_choice_cong)

lemma cspF_Rep_int_choice_cong_UNIV_com:
  "[| !! x. Pf x =F[M1,M2] Qf x |]
      ==> ! x .. Pf x =F[M1,M2] ! x .. Qf x"
by (simp add: cspF_Rep_int_choice_cong)

lemma cspF_Rep_int_choice_cong_UNIV_f:
  "[| inj f ; !! x. Pf x =F[M1,M2] Qf x |]
      ==> !<f> x .. Pf x =F[M1,M2] !<f> x .. Qf x"
by (simp add: cspF_Rep_int_choice_cong)

lemmas cspF_Rep_int_choice_cong_UNIV =
      cspF_Rep_int_choice_cong_UNIV_nat
      cspF_Rep_int_choice_cong_UNIV_set
      cspF_Rep_int_choice_cong_UNIV_com
      cspF_Rep_int_choice_cong_UNIV_f

end


header{*Inductive Study of Confidentiality against Dolev-Yao*}

theory ConfidentialityDY imports NS_Public_Bad begin

section{*Existing study - fully spelled out*}

text{*In order not to leave hidden anything of the line of reasoning, we cancel some relevant lemmas that were installed previously*}

declare Spy_see_priEK [simp del]
        Spy_analz_priEK [simp del]
        image_eq_UN [simp del]
        analz_into_parts [rule del]

subsection{*On static secrets*}

lemma Spy_see_priEK:
      "evs \<in> ns_public \<Longrightarrow> (Key (priEK A) \<in> parts (spies evs)) = (A \<in> bad)"
apply (erule ns_public.induct, simp_all)
(*Fake: screenshot1*)
apply (cases "A:bad")
thm ccontr
(*apply (rule ccontr) apply simp*)
apply blast (*Spy knows bad agents' keys since start*)
apply clarify (*screenshot2*)
thm Fake_parts_insert [THEN subsetD]
apply (drule Fake_parts_insert [THEN subsetD], simp)(*screenshot3*)
apply (blast dest: analz_into_parts)
done

lemma Spy_analz_priEK:
      "evs \<in> ns_public \<Longrightarrow> (Key (priEK A) \<in> analz (spies evs)) = (A \<in> bad)"
(*apply (auto simp: Spy_see_priEK dest: analz_into_parts)*)
apply (erule ns_public.induct, simp_all)
(*Nil*)
thm analz_image_freshK_simps
apply (simp add: analz_image_freshK_simps)
(*Fake*)
(*apply spy_analz would close, alternatively:*)
apply (cases "A:bad")
apply clarify apply simp
apply blast (*Spy knows bad agents' keys since start*)
apply clarsimp
apply (drule Fake_analz_insert [THEN subsetD], simp)
apply clarsimp
done

subsection{*On dynamic secrets*}

lemma Spy_not_see_NA:
"\<lbrakk>Says A B (Crypt(pubEK B) \<lbrace>Nonce NA, Agent A\<rbrace>) \<in> set evs;
  A \<notin> bad;  B \<notin> bad;  evs \<in> ns_public\<rbrakk>
  \<Longrightarrow> Nonce NA \<notin> analz (spies evs)"
apply (erule rev_mp, erule ns_public.induct)
apply (simp_all add: Spy_analz_priEK)
(*screenshot1*)
thm conjI
apply (rule conjI)
apply clarify
apply clarify
(*screenshot2*)
apply (drule Fake_analz_insert [THEN subsetD], simp)
(*screenshot3*)
apply simp
apply (blast dest: unique_NA analz_into_parts intro: no_nonce_NS1_NS2)+
done

lemma Spy_not_see_NB:
"\<lbrakk>Says B A (Crypt (pubEK A) \<lbrace>Nonce NA, Nonce NB\<rbrace>) \<in> set evs;
 \<forall>C. Says A C (Crypt (pubEK C) (Nonce NB)) \<notin> set evs;
 A \<notin> bad;  B \<notin> bad;  evs \<in> ns_public\<rbrakk>
 \<Longrightarrow> Nonce NB \<notin> analz (spies evs)"
apply (erule rev_mp, erule rev_mp)
apply (erule ns_public.induct)
apply (simp_all add: Spy_analz_priEK)
txt{*apply @{term spy_analz}
   is replaced here with the following list...*}
apply (rule ccontr)
apply clarsimp
apply (erule disjE)
apply simp
apply simp
apply clarify
apply (drule Fake_analz_insert [THEN subsetD], simp)
apply simp
txt{*...of commands!*}
apply (simp_all add: all_conj_distrib) txt{*speeds up next*}
apply (blast dest: analz_into_parts intro: no_nonce_NS1_NS2)+
done

section{*Novel study*}

text{*Generalising over all initial secrets the existing treatment, which is limited to private encryption keys*}

definition staticSecret :: "agent \<Rightarrow> msg set" where
 [simp]: "staticSecret A \<equiv> {Key (priEK A), Key (priSK A), Key (shrK A)}"

subsection{*Protocol independent study*}

text{*Converse doesn't hold because something that is said or noted is not necessarily an initial secret*}
lemma staticSecret_parts_Spy:
"\<lbrakk>m \<in> parts (knows Spy evs); m \<in> staticSecret A\<rbrakk>  \<Longrightarrow>
 A \<in> bad \<or>
 (\<exists>C B X. Says C B X \<in> set evs \<and> m \<in> parts{X}) \<or>
 (\<exists>C Y. Notes C Y \<in> set evs \<and> C \<in> bad \<and> m \<in> parts{Y})"
apply (erule rev_mp)
apply (induct_tac "evs")
apply force
apply (induct_tac "a")
txt{*Says*}
txt{*@{subgoals [display,indent=1]}*}
apply (rule impI)
apply simp
txt{*@{subgoals [display,indent=1]}*}
apply (drule parts_insert [THEN equalityD1, THEN subsetD])
txt{*@{subgoals [display,indent=1]}*}
apply blast
txt{*Gets*}
apply simp
txt{*Notes*}
apply (rule impI)
apply simp
apply (rename_tac agent msg)
apply (case_tac "agent\<notin>bad")
apply simp apply blast
apply simp
apply (drule parts_insert [THEN equalityD1, THEN subsetD])
apply blast
done

lemma staticSecret_analz_Spy:
"\<lbrakk>m \<in> analz (knows Spy evs); m \<in> staticSecret A\<rbrakk>  \<Longrightarrow>
 A \<in> bad \<or>
 (\<exists>C B X. Says C B X \<in> set evs \<and> m \<in> parts{X}) \<or>
 (\<exists>C Y. Notes C Y \<in> set evs \<and> C \<in> bad \<and> m \<in> parts{Y})"
by (drule analz_into_parts [THEN staticSecret_parts_Spy])

lemma secret_parts_Spy:
"m \<in> parts (knows Spy evs)  \<Longrightarrow>
 m \<in> initState Spy \<or>
 (\<exists>C B X. Says C B X \<in> set evs \<and> m \<in> parts{X}) \<or>
 (\<exists>C Y. Notes C Y \<in> set evs \<and> C \<in> bad \<and> m \<in> parts{Y})"
apply (erule rev_mp)
apply (induct_tac "evs")
apply simp
apply (induct_tac "a")
txt{*Says*}
apply (rule impI)
apply (simp del: initState_Spy)
apply (drule parts_insert [THEN equalityD1, THEN subsetD])
apply (simp only: Un_iff)
apply blast
txt{*Gets*}
apply simp
txt{*Notes*}
apply (rule impI)
apply (simp del: initState_Spy)
apply (rename_tac agent msg)
apply (case_tac "agent\<notin>bad")
apply (simp del: initState_Spy)
apply blast
apply (simp del: initState_Spy)
apply (drule parts_insert [THEN equalityD1, THEN subsetD])
apply blast
done

lemma secret_parts_Spy_converse:
" m \<in> initState Spy \<or>
 (\<exists>C B X. Says C B X \<in> set evs \<and> m \<in> parts{X}) \<or>
 (\<exists>C Y. Notes C Y \<in> set evs \<and> C \<in> bad \<and> m \<in> parts{Y})
 \<Longrightarrow> m \<in> parts(knows Spy evs)"
apply (erule disjE)
apply force
apply (erule disjE)
apply (blast dest: Says_imp_knows_Spy [THEN parts.Inj] parts_trans)
 apply (blast dest: Notes_imp_knows_Spy [THEN parts.Inj] parts_trans)
done

lemma secret_analz_Spy:
"m \<in> analz (knows Spy evs)  \<Longrightarrow>
 m \<in> initState Spy \<or>
 (\<exists>C B X. Says C B X \<in> set evs \<and> m \<in> parts{X}) \<or>
 (\<exists>C Y. Notes C Y \<in> set evs \<and> C \<in> bad \<and> m \<in> parts{Y})"
by (blast dest: analz_into_parts secret_parts_Spy)

subsection{*Protocol-dependent study*}

text{*Proving generalised version of @{thm Spy_see_priEK} using same strategy, the "direct" strategy*}

lemma NS_Spy_see_staticSecret:
 "\<lbrakk>m \<in> staticSecret A; evs \<in> ns_public\<rbrakk> \<Longrightarrow>
   m \<in> parts(knows Spy evs) = (A \<in> bad)"
apply (erule ns_public.induct)
apply simp_all
prefer 2
apply (cases "A:bad")
apply blast (*Spy knows bad agents' keys since start*)
apply clarify
apply (drule Fake_parts_insert [THEN subsetD], simp)
txt{*@{subgoals [display,indent=1,goals_limit=1]}*}
apply (blast dest: analz_into_parts)
apply force+
done

text{*Seeking a proof of @{thm NS_Spy_see_staticSecret} using an alternative, "specialisation" strategy*}

lemma NS_no_Notes:
 "evs \<in> ns_public \<Longrightarrow> Notes A X \<notin> set evs"
apply (erule ns_public.induct)
apply simp_all
done

lemma NS_staticSecret_parts_Spy_weak:
"\<lbrakk>m \<in> parts (knows Spy evs); m \<in> staticSecret A;
  evs \<in> ns_public\<rbrakk> \<Longrightarrow> A \<in> bad \<or>
 (\<exists>C B X. Says C B X \<in> set evs \<and> m \<in> parts{X})"
apply (blast dest: staticSecret_parts_Spy NS_no_Notes)
done

lemma NS_Says_staticSecret:
 "\<lbrakk>Says A B X \<in> set evs; m \<in> staticSecret C; m \<in> parts{X};
   evs \<in> ns_public\<rbrakk> \<Longrightarrow> A=Spy"
apply (erule rev_mp)
apply (erule ns_public.induct)
apply force+
done

text{*This generalises @{thm Key_synth_eq}*}
lemma staticSecret_synth_eq:
"m \<in> staticSecret A \<Longrightarrow> (m \<in> synth H) = (m \<in> H)"
apply force
done

lemma NS_Says_Spy_staticSecret:
 "\<lbrakk>Says Spy B X \<in> set evs; m \<in> parts{X};
   m \<in> staticSecret A; evs \<in> ns_public\<rbrakk> \<Longrightarrow> A \<in> bad"
(*
txt{*Alternative start to appreciate that it reduces to @{thm NS_Spy_see_staticSecret}*}
apply (erule rev_mp, erule ns_public.induct)
apply (simp_all del: staticSecret_def)
apply clarify
txt{*@{subgoals [display,indent=1,goals_limit=1]}*}
apply (drule Fake_parts_sing [THEN subsetD], simp)
txt{*@{subgoals [display,indent=1,goals_limit=1]}*}
apply (simp del: staticSecret_def add: staticSecret_synth_eq)
txt{*@{subgoals [display,indent=1,goals_limit=1]}*}
oops
*)
apply (drule Says_imp_knows_Spy [THEN parts.Inj])
txt{*@{subgoals [display,indent=1,goals_limit=1]}*}
apply (drule parts_trans, simp)
apply (rotate_tac -1)
txt{*@{subgoals [display,indent=1,goals_limit=1]}*}
apply (erule rev_mp)
apply (erule ns_public.induct)
apply simp_all
prefer 2
apply (cases "A:bad")
apply blast (*Spy knows bad agents' keys since start*)
apply clarsimp
apply (drule Fake_parts_insert [THEN subsetD], simp)
apply (blast dest: analz_into_parts)
apply force+
done

text{*Here's the specialised version of @{thm staticSecret_parts_Spy}*}
lemma NS_staticSecret_parts_Spy:
"\<lbrakk>m \<in> parts (knows Spy evs); m \<in> staticSecret A;
  evs \<in> ns_public\<rbrakk> \<Longrightarrow> A \<in> bad"
apply (drule staticSecret_parts_Spy)
apply assumption
txt{*@{subgoals  [display,indent=1]}*}
apply (erule disjE)
(*Case A bad*)
apply assumption
apply (erule disjE)
(*Case: Says*)
apply (erule exE)+
txt{*@{subgoals  [display,indent=1]}*}
apply (case_tac "C=Spy")
apply (blast dest: NS_Says_Spy_staticSecret)
apply (blast dest: NS_Says_staticSecret)
apply (blast dest: NS_no_Notes)
done

text{*Concluding the specialisation proof strategy...*}
lemma NS_Spy_see_staticSecret_spec:
"\<lbrakk>m \<in> staticSecret A; evs \<in> ns_public\<rbrakk> \<Longrightarrow>
 m \<in> parts (knows Spy evs) = (A \<in> bad)"
txt{*one line proof:
apply (force dest: @{term NS_staticSecret_parts_Spy})
*}
apply safe
apply (blast dest: NS_staticSecret_parts_Spy)
txt{*one line proof: force*}
apply simp
apply (erule disjE)
apply clarify
apply (drule_tac b=Encryption and evs=evs in Spy_spies_bad_privateKey)
apply (drule parts.Inj, assumption)
apply (erule disjE)
apply clarify
apply (drule_tac b=Signature and evs=evs in Spy_spies_bad_privateKey)
apply (drule parts.Inj, assumption)
apply clarify
apply (drule_tac evs=evs in Spy_spies_bad_shrK)
apply (drule parts.Inj, assumption)
done

lemma NS_staticSecret_subset_parts_knows_Spy:
"evs \<in> ns_public \<Longrightarrow>
 staticSecret A \<subseteq> parts (knows Spy evs) = (A \<in> bad)"
apply (force dest: NS_staticSecret_parts_Spy)
done

lemma NS_staticSecret_subset_analz_knows_Spy:
"evs \<in> ns_public \<Longrightarrow>
 staticSecret A \<subseteq> analz (knows Spy evs) = (A \<in> bad)"
apply (force dest: analz_into_parts NS_staticSecret_parts_Spy)
done

end


section \<open>Set Interface\<close>
theory IICF_Set
imports "../../Sepref"
begin

subsection \<open>Operations\<close>
definition [simp]: "op_set_is_empty s \<equiv> s={}"
lemma op_set_is_empty_param[param]: "(op_set_is_empty,op_set_is_empty)\<in>\<langle>A\<rangle>set_rel \<rightarrow> bool_rel" by auto

context
  notes [simp] = IS_LEFT_UNIQUE_def (* Argh, the set parametricity lemmas use single_valued (K\<inverse>) here. *)
begin

find_theorems card
definition op_set_copy :: "'a set \<Rightarrow> 'a set" where [simp]:  "op_set_copy s \<equiv> s"
sepref_decl_op (no_def) set_copy: "op_set_copy" :: "\<langle>A\<rangle>set_rel \<rightarrow> \<langle>A\<rangle>set_rel" where "A = Id" .
sepref_decl_op set_empty: "{}" :: "\<langle>A\<rangle>set_rel" .
sepref_decl_op (no_def) set_is_empty: op_set_is_empty :: "\<langle>A\<rangle>set_rel \<rightarrow> bool_rel" .
sepref_decl_op set_member: "(\<in>)" :: "A \<rightarrow> \<langle>A\<rangle>set_rel \<rightarrow> bool_rel" where "IS_LEFT_UNIQUE A" "IS_RIGHT_UNIQUE A" .
sepref_decl_op set_insert: Set.insert :: "A \<rightarrow> \<langle>A\<rangle>set_rel \<rightarrow> \<langle>A\<rangle>set_rel" where "IS_RIGHT_UNIQUE A" .
sepref_decl_op set_delete: "\<lambda>x s. s - {x}" :: "A \<rightarrow> \<langle>A\<rangle>set_rel \<rightarrow> \<langle>A\<rangle>set_rel"
  where "IS_LEFT_UNIQUE A" "IS_RIGHT_UNIQUE A" .
sepref_decl_op set_union: "(\<union>)" :: "\<langle>A\<rangle>set_rel \<rightarrow> \<langle>A\<rangle>set_rel \<rightarrow> \<langle>A\<rangle>set_rel" .
sepref_decl_op set_inter: "(\<inter>)" :: "\<langle>A\<rangle>set_rel \<rightarrow> \<langle>A\<rangle>set_rel \<rightarrow> \<langle>A\<rangle>set_rel" where "IS_LEFT_UNIQUE A"  "IS_RIGHT_UNIQUE A" .
sepref_decl_op set_diff: "(-) ::_ set \<Rightarrow> _" :: "\<langle>A\<rangle>set_rel \<rightarrow> \<langle>A\<rangle>set_rel \<rightarrow> \<langle>A\<rangle>set_rel" where "IS_LEFT_UNIQUE A"  "IS_RIGHT_UNIQUE A" .
sepref_decl_op set_subseteq: "(\<subseteq>)" :: "\<langle>A\<rangle>set_rel \<rightarrow> \<langle>A\<rangle>set_rel \<rightarrow> bool_rel" where "IS_LEFT_UNIQUE A"  "IS_RIGHT_UNIQUE A" .
sepref_decl_op set_subset: "(\<subset>)" :: "\<langle>A\<rangle>set_rel \<rightarrow> \<langle>A\<rangle>set_rel \<rightarrow> bool_rel" where "IS_LEFT_UNIQUE A" "IS_RIGHT_UNIQUE A" .
sepref_decl_op set_size: "(card)" :: "\<langle>A\<rangle>set_rel \<rightarrow> nat_rel"  where "IS_LEFT_UNIQUE A" "IS_RIGHT_UNIQUE A"
proof standard
  fix x :: "'a set"
  fix  y :: "'b set"
  assume xyrel: "(x, y) \<in> \<langle>A\<rangle>set_rel"
  assume luA: "IS_LEFT_UNIQUE A"
  assume svA: "single_valued A"
  show "((RETURN \<circ> card) x, (RETURN \<circ> card) y) \<in> \<langle>nat_rel\<rangle>nres_rel"
    apply refine_vcg
    apply auto
  proof (cases "finite x")
    case cc: True
    from cc have finx: "finite x" by simp
    from cc svA luA xyrel have finy: "finite y"
    using finite_set_rel_transfer by blast
    from finx xyrel show "card x = card y"
    proof (induction arbitrary: y rule: finite_psubset_induct)
      case cps: (psubset xa)
      then show ?case
      proof (cases "xa \<noteq> {}")
        assume xarel: "(xa, y) \<in> \<langle>A\<rangle>set_rel"
        case nempxa: True
         from this obtain elemx where xmemb: "elemx \<in> xa" by auto
      from this obtain subx where stepx: "subx = xa - {elemx}" by auto
      from this xmemb have subp: "subx \<subset> xa" by blast
      from cps(3) nempxa have nempy : "y \<noteq> {}" by force
      from nempy xarel obtain elemy where ymemb: "elemy \<in> y \<and> (elemx, elemy) \<in> A"
        using xmemb set_relD1 by force
      from this have inrelA: "(elemx, elemy) \<in> A" by simp
      from ymemb obtain suby where stepy: "suby = y - {elemy}"
        by auto
      from this ymemb have "suby \<subset> y" by force
      from stepx stepy xmemb xarel inrelA ymemb   luA svA  have subrel: "(subx, suby) \<in> \<langle>A\<rangle>set_rel"
        unfolding set_rel_def apply simp
        by (metis Diff_iff converseI insert_Diff insert_iff single_valued_def)
      from stepx stepy  have cardincx: "card xa = card subx + 1"
        by (metis One_nat_def add.right_neutral add_Suc_right card_Suc_Diff1 cps.hyps xmemb)
      from stepy svA xarel ymemb have cardincy: "card y = card suby + 1"
        by (metis Suc_eq_plus1 card.remove cps.hyps finite_set_rel_transfer)
      from subp subrel cps(1) cps(2)[where B = subx and y = suby] cps(3) cardincx cardincy
        show "card xa = card y" by fastforce
      next
        assume xarel: "(xa, y) \<in> \<langle>A\<rangle>set_rel"
        case False
        from this have xaemp: "xa = {}" by simp
        from this xarel have yemp: "y = {}"
          by simp
        from xaemp have "card xa = 0" by simp
        from yemp have "card y = 0" by simp
        from xaemp yemp show ?thesis by simp
      qed
    qed
  next
    case infx:  False
    from this have cardx0: "card x = 0" by simp
    from xyrel luA svA infx have "infinite y" unfolding set_rel_def
      by (auto, metis finite_set_rel_transfer_back xyrel)
    from this have cardy0: "card y = 0" by simp
    from cardx0 cardy0 show "card x = card y" by simp
  qed
qed

(* TODO: We may want different operations here: pick with predicate returning option,
  pick with remove, ... *)
sepref_decl_op set_pick: "RES" :: "[\<lambda>s. s\<noteq>{}]\<^sub>f \<langle>K\<rangle>set_rel \<rightarrow> K" by auto

end

(* TODO: Set-pick. Move from where it is already defined! *)

subsection \<open>Patterns\<close>
lemma pat_set[def_pat_rules]:
  "{} \<equiv> op_set_empty"
  "(\<in>) \<equiv> op_set_member"
  "Set.insert \<equiv> op_set_insert"
  "(\<union>) \<equiv> op_set_union"
  "(\<inter>) \<equiv> op_set_inter"
  "(-) \<equiv> op_set_diff"
  "(\<subseteq>) \<equiv> op_set_subseteq"
  "(\<subset>) \<equiv> op_set_subset"
  "card \<equiv> op_set_size"
  by (auto intro!: eq_reflection)

lemma pat_set2[pat_rules]:
  "(=) $s${} \<equiv> op_set_is_empty$s"
  "(=) ${}$s \<equiv> op_set_is_empty$s"

  "(-) $s$(Set.insert$x${}) \<equiv> op_set_delete$x$s"
  "SPEC$(\<lambda>\<^sub>2x. (\<in>) $x$s) \<equiv> op_set_pick s"
  "RES$s \<equiv> op_set_pick s"
  by (auto intro!: eq_reflection)

locale set_custom_empty =
  fixes empty and op_custom_empty :: "'a set"
  assumes op_custom_empty_def: "op_custom_empty = op_set_empty"
begin
  sepref_register op_custom_empty :: "'ax set"

  lemma fold_custom_empty:
    "{} = op_custom_empty"
    "op_set_empty = op_custom_empty"
    "mop_set_empty = RETURN op_custom_empty"
    unfolding op_custom_empty_def by simp_all
end

end


(*  Title:      ZF/UNITY/Union.thy
    Author:     Sidi O Ehmety, Computer Laboratory
    Copyright   2001  University of Cambridge

Unions of programs

Partly from Misra's Chapter 5 \<in> Asynchronous Compositions of Programs

Theory ported form HOL..

*)

theory Union imports SubstAx FP
begin

definition
  (*FIXME: conjoin Init(F) \<inter> Init(G) \<noteq> 0 *)
  ok :: "[i, i] => o"     (infixl "ok" 65)  where
    "F ok G == Acts(F) \<subseteq> AllowedActs(G) &
               Acts(G) \<subseteq> AllowedActs(F)"

definition
  (*FIXME: conjoin (\<Inter>i \<in> I. Init(F(i))) \<noteq> 0 *)
  OK  :: "[i, i=>i] => o"  where
    "OK(I,F) == (\<forall>i \<in> I. \<forall>j \<in> I-{i}. Acts(F(i)) \<subseteq> AllowedActs(F(j)))"

definition
  JOIN  :: "[i, i=>i] => i"  where
  "JOIN(I,F) == if I = 0 then SKIP else
                 mk_program(\<Inter>i \<in> I. Init(F(i)), \<Union>i \<in> I. Acts(F(i)),
                 \<Inter>i \<in> I. AllowedActs(F(i)))"

definition
  Join :: "[i, i] => i"    (infixl "Join" 65)  where
  "F Join G == mk_program (Init(F) \<inter> Init(G), Acts(F) \<union> Acts(G),
                                AllowedActs(F) \<inter> AllowedActs(G))"
definition
  (*Characterizes safety properties.  Used with specifying AllowedActs*)
  safety_prop :: "i => o"  where
  "safety_prop(X) == X\<subseteq>program &
      SKIP \<in> X & (\<forall>G \<in> program. Acts(G) \<subseteq> (\<Union>F \<in> X. Acts(F)) \<longrightarrow> G \<in> X)"

notation (xsymbols)
  SKIP  ("\<bottom>") and
  Join  (infixl "\<squnion>" 65)

syntax
  "_JOIN1"     :: "[pttrns, i] => i"         ("(3JN _./ _)" 10)
  "_JOIN"      :: "[pttrn, i, i] => i"       ("(3JN _ \<in> _./ _)" 10)
syntax (xsymbols)
  "_JOIN1"  :: "[pttrns, i] => i"     ("(3\<Squnion> _./ _)" 10)
  "_JOIN"   :: "[pttrn, i, i] => i"   ("(3\<Squnion> _ \<in> _./ _)" 10)

translations
  "JN x \<in> A. B"   == "CONST JOIN(A, (%x. B))"
  "JN x y. B"   == "JN x. JN y. B"
  "JN x. B"     == "CONST JOIN(CONST state,(%x. B))"

subsection{*SKIP*}

lemma reachable_SKIP [simp]: "reachable(SKIP) = state"
by (force elim: reachable.induct intro: reachable.intros)

text{*Elimination programify from ok and Join*}

lemma ok_programify_left [iff]: "programify(F) ok G \<longleftrightarrow> F ok G"
by (simp add: ok_def)

lemma ok_programify_right [iff]: "F ok programify(G) \<longleftrightarrow> F ok G"
by (simp add: ok_def)

lemma Join_programify_left [simp]: "programify(F) Join G = F Join G"
by (simp add: Join_def)

lemma Join_programify_right [simp]: "F Join programify(G) = F Join G"
by (simp add: Join_def)

subsection{*SKIP and safety properties*}

lemma SKIP_in_constrains_iff [iff]: "(SKIP \<in> A co B) \<longleftrightarrow> (A\<subseteq>B & st_set(A))"
by (unfold constrains_def st_set_def, auto)

lemma SKIP_in_Constrains_iff [iff]: "(SKIP \<in> A Co B)\<longleftrightarrow> (state \<inter> A\<subseteq>B)"
by (unfold Constrains_def, auto)

lemma SKIP_in_stable [iff]: "SKIP \<in> stable(A) \<longleftrightarrow> st_set(A)"
by (auto simp add: stable_def)

lemma SKIP_in_Stable [iff]: "SKIP \<in> Stable(A)"
by (unfold Stable_def, auto)

subsection{*Join and JOIN types*}

lemma Join_in_program [iff,TC]: "F Join G \<in> program"
by (unfold Join_def, auto)

lemma JOIN_in_program [iff,TC]: "JOIN(I,F) \<in> program"
by (unfold JOIN_def, auto)

subsection{*Init, Acts, and AllowedActs of Join and JOIN*}
lemma Init_Join [simp]: "Init(F Join G) = Init(F) \<inter> Init(G)"
by (simp add: Int_assoc Join_def)

lemma Acts_Join [simp]: "Acts(F Join G) = Acts(F) \<union> Acts(G)"
by (simp add: Int_Un_distrib2 cons_absorb Join_def)

lemma AllowedActs_Join [simp]: "AllowedActs(F Join G) =
  AllowedActs(F) \<inter> AllowedActs(G)"
apply (simp add: Int_assoc cons_absorb Join_def)
done

subsection{*Join's algebraic laws*}

lemma Join_commute: "F Join G = G Join F"
by (simp add: Join_def Un_commute Int_commute)

lemma Join_left_commute: "A Join (B Join C) = B Join (A Join C)"
apply (simp add: Join_def Int_Un_distrib2 cons_absorb)
apply (simp add: Un_ac Int_ac Int_Un_distrib2 cons_absorb)
done

lemma Join_assoc: "(F Join G) Join H = F Join (G Join H)"
by (simp add: Un_ac Join_def cons_absorb Int_assoc Int_Un_distrib2)

subsection{*Needed below*}
lemma cons_id [simp]: "cons(id(state), Pow(state * state)) = Pow(state*state)"
by auto

lemma Join_SKIP_left [simp]: "SKIP Join F = programify(F)"
apply (unfold Join_def SKIP_def)
apply (auto simp add: Int_absorb cons_eq)
done

lemma Join_SKIP_right [simp]: "F Join SKIP =  programify(F)"
apply (subst Join_commute)
apply (simp add: Join_SKIP_left)
done

lemma Join_absorb [simp]: "F Join F = programify(F)"
by (rule program_equalityI, auto)

lemma Join_left_absorb: "F Join (F Join G) = F Join G"
by (simp add: Join_assoc [symmetric])

subsection{*Join is an AC-operator*}
lemmas Join_ac = Join_assoc Join_left_absorb Join_commute Join_left_commute

subsection{*Eliminating programify form JN and OK expressions*}

lemma OK_programify [iff]: "OK(I, %x. programify(F(x))) \<longleftrightarrow> OK(I, F)"
by (simp add: OK_def)

lemma JN_programify [iff]: "JOIN(I, %x. programify(F(x))) = JOIN(I, F)"
by (simp add: JOIN_def)

subsection{*JN*}

lemma JN_empty [simp]: "JOIN(0, F) = SKIP"
by (unfold JOIN_def, auto)

lemma Init_JN [simp]:
     "Init(\<Squnion>i \<in> I. F(i)) = (if I=0 then state else (\<Inter>i \<in> I. Init(F(i))))"
by (simp add: JOIN_def INT_extend_simps del: INT_simps)

lemma Acts_JN [simp]:
     "Acts(JOIN(I,F)) = cons(id(state), \<Union>i \<in> I.  Acts(F(i)))"
apply (unfold JOIN_def)
apply (auto simp del: INT_simps UN_simps)
apply (rule equalityI)
apply (auto dest: Acts_type [THEN subsetD])
done

lemma AllowedActs_JN [simp]:
     "AllowedActs(\<Squnion>i \<in> I. F(i)) =
      (if I=0 then Pow(state*state) else (\<Inter>i \<in> I. AllowedActs(F(i))))"
apply (unfold JOIN_def, auto)
apply (rule equalityI)
apply (auto elim!: not_emptyE dest: AllowedActs_type [THEN subsetD])
done

lemma JN_cons [simp]: "(\<Squnion>i \<in> cons(a,I). F(i)) = F(a) Join (\<Squnion>i \<in> I. F(i))"
by (rule program_equalityI, auto)

lemma JN_cong [cong]:
    "[| I=J;  !!i. i \<in> J ==> F(i) = G(i) |] ==>
     (\<Squnion>i \<in> I. F(i)) = (\<Squnion>i \<in> J. G(i))"
by (simp add: JOIN_def)

subsection{*JN laws*}
lemma JN_absorb: "k \<in> I ==>F(k) Join (\<Squnion>i \<in> I. F(i)) = (\<Squnion>i \<in> I. F(i))"
apply (subst JN_cons [symmetric])
apply (auto simp add: cons_absorb)
done

lemma JN_Un: "(\<Squnion>i \<in> I \<union> J. F(i)) = ((\<Squnion>i \<in> I. F(i)) Join (\<Squnion>i \<in> J. F(i)))"
apply (rule program_equalityI)
apply (simp_all add: UN_Un INT_Un)
apply (simp_all del: INT_simps add: INT_extend_simps, blast)
done

lemma JN_constant: "(\<Squnion>i \<in> I. c) = (if I=0 then SKIP else programify(c))"
by (rule program_equalityI, auto)

lemma JN_Join_distrib:
     "(\<Squnion>i \<in> I. F(i) Join G(i)) = (\<Squnion>i \<in> I. F(i))  Join  (\<Squnion>i \<in> I. G(i))"
apply (rule program_equalityI)
apply (simp_all add: INT_Int_distrib, blast)
done

lemma JN_Join_miniscope: "(\<Squnion>i \<in> I. F(i) Join G) = ((\<Squnion>i \<in> I. F(i) Join G))"
by (simp add: JN_Join_distrib JN_constant)

text{*Used to prove guarantees_JN_I*}
lemma JN_Join_diff: "i \<in> I==>F(i) Join JOIN(I - {i}, F) = JOIN(I, F)"
apply (rule program_equalityI)
apply (auto elim!: not_emptyE)
done

subsection{*Safety: co, stable, FP*}

(*Fails if I=0 because it collapses to SKIP \<in> A co B, i.e. to A\<subseteq>B.  So an
  alternative precondition is A\<subseteq>B, but most proofs using this rule require
  I to be nonempty for other reasons anyway.*)

lemma JN_constrains:
 "i \<in> I==>(\<Squnion>i \<in> I. F(i)) \<in> A co B \<longleftrightarrow> (\<forall>i \<in> I. programify(F(i)) \<in> A co B)"

apply (unfold constrains_def JOIN_def st_set_def, auto)
prefer 2 apply blast
apply (rename_tac j act y z)
apply (cut_tac F = "F (j) " in Acts_type)
apply (drule_tac x = act in bspec, auto)
done

lemma Join_constrains [iff]:
     "(F Join G \<in> A co B) \<longleftrightarrow> (programify(F) \<in> A co B & programify(G) \<in> A co B)"
by (auto simp add: constrains_def)

lemma Join_unless [iff]:
     "(F Join G \<in> A unless B) \<longleftrightarrow>
    (programify(F) \<in> A unless B & programify(G) \<in> A unless B)"
by (simp add: Join_constrains unless_def)

(*Analogous weak versions FAIL; see Misra [1994] 5.4.1, Substitution Axiom.
  reachable (F Join G) could be much bigger than reachable F, reachable G
*)

lemma Join_constrains_weaken:
     "[| F \<in> A co A';  G \<in> B co B' |]
      ==> F Join G \<in> (A \<inter> B) co (A' \<union> B')"
apply (subgoal_tac "st_set (A) & st_set (B) & F \<in> program & G \<in> program")
prefer 2 apply (blast dest: constrainsD2, simp)
apply (blast intro: constrains_weaken)
done

(*If I=0, it degenerates to SKIP \<in> state co 0, which is false.*)
lemma JN_constrains_weaken:
  assumes major: "(!!i. i \<in> I ==> F(i) \<in> A(i) co A'(i))"
      and minor: "i \<in> I"
  shows "(\<Squnion>i \<in> I. F(i)) \<in> (\<Inter>i \<in> I. A(i)) co (\<Union>i \<in> I. A'(i))"
apply (cut_tac minor)
apply (simp (no_asm_simp) add: JN_constrains)
apply clarify
apply (rename_tac "j")
apply (frule_tac i = j in major)
apply (frule constrainsD2, simp)
apply (blast intro: constrains_weaken)
done

lemma JN_stable:
     "(\<Squnion>i \<in> I. F(i)) \<in>  stable(A) \<longleftrightarrow> ((\<forall>i \<in> I. programify(F(i)) \<in> stable(A)) & st_set(A))"
apply (auto simp add: stable_def constrains_def JOIN_def)
apply (cut_tac F = "F (i) " in Acts_type)
apply (drule_tac x = act in bspec, auto)
done

lemma initially_JN_I:
  assumes major: "(!!i. i \<in> I ==>F(i) \<in> initially(A))"
      and minor: "i \<in> I"
  shows  "(\<Squnion>i \<in> I. F(i)) \<in> initially(A)"
apply (cut_tac minor)
apply (auto elim!: not_emptyE simp add: Inter_iff initially_def)
apply (frule_tac i = x in major)
apply (auto simp add: initially_def)
done

lemma invariant_JN_I:
  assumes major: "(!!i. i \<in> I ==> F(i) \<in> invariant(A))"
      and minor: "i \<in> I"
  shows "(\<Squnion>i \<in> I. F(i)) \<in> invariant(A)"
apply (cut_tac minor)
apply (auto intro!: initially_JN_I dest: major simp add: invariant_def JN_stable)
apply (erule_tac V = "i \<in> I" in thin_rl)
apply (frule major)
apply (drule_tac [2] major)
apply (auto simp add: invariant_def)
apply (frule stableD2, force)+
done

lemma Join_stable [iff]:
     " (F Join G \<in> stable(A)) \<longleftrightarrow>
      (programify(F) \<in> stable(A) & programify(G) \<in>  stable(A))"
by (simp add: stable_def)

lemma initially_JoinI [intro!]:
     "[| F \<in> initially(A); G \<in> initially(A) |] ==> F Join G \<in> initially(A)"
by (unfold initially_def, auto)

lemma invariant_JoinI:
     "[| F \<in> invariant(A); G \<in> invariant(A) |]
      ==> F Join G \<in> invariant(A)"
apply (subgoal_tac "F \<in> program&G \<in> program")
prefer 2 apply (blast dest: invariantD2)
apply (simp add: invariant_def)
apply (auto intro: Join_in_program)
done

(* Fails if I=0 because \<Inter>i \<in> 0. A(i) = 0 *)
lemma FP_JN: "i \<in> I ==> FP(\<Squnion>i \<in> I. F(i)) = (\<Inter>i \<in> I. FP (programify(F(i))))"
by (auto simp add: FP_def Inter_def st_set_def JN_stable)

subsection{*Progress: transient, ensures*}

lemma JN_transient:
     "i \<in> I ==>
      (\<Squnion>i \<in> I. F(i)) \<in> transient(A) \<longleftrightarrow> (\<exists>i \<in> I. programify(F(i)) \<in> transient(A))"
apply (auto simp add: transient_def JOIN_def)
apply (unfold st_set_def)
apply (drule_tac [2] x = act in bspec)
apply (auto dest: Acts_type [THEN subsetD])
done

lemma Join_transient [iff]:
     "F Join G \<in> transient(A) \<longleftrightarrow>
      (programify(F) \<in> transient(A) | programify(G) \<in> transient(A))"
apply (auto simp add: transient_def Join_def Int_Un_distrib2)
done

lemma Join_transient_I1: "F \<in> transient(A) ==> F Join G \<in> transient(A)"
by (simp add: Join_transient transientD2)

lemma Join_transient_I2: "G \<in> transient(A) ==> F Join G \<in> transient(A)"
by (simp add: Join_transient transientD2)

(*If I=0 it degenerates to (SKIP \<in> A ensures B) = False, i.e. to ~(A\<subseteq>B) *)
lemma JN_ensures:
     "i \<in> I ==>
      (\<Squnion>i \<in> I. F(i)) \<in> A ensures B \<longleftrightarrow>
      ((\<forall>i \<in> I. programify(F(i)) \<in> (A-B) co (A \<union> B)) &
      (\<exists>i \<in> I. programify(F(i)) \<in> A ensures B))"
by (auto simp add: ensures_def JN_constrains JN_transient)

lemma Join_ensures:
     "F Join G \<in> A ensures B  \<longleftrightarrow>
      (programify(F) \<in> (A-B) co (A \<union> B) & programify(G) \<in> (A-B) co (A \<union> B) &
       (programify(F) \<in>  transient (A-B) | programify(G) \<in> transient (A-B)))"

apply (unfold ensures_def)
apply (auto simp add: Join_transient)
done

lemma stable_Join_constrains:
    "[| F \<in> stable(A);  G \<in> A co A' |]
     ==> F Join G \<in> A co A'"
apply (unfold stable_def constrains_def Join_def st_set_def)
apply (cut_tac F = F in Acts_type)
apply (cut_tac F = G in Acts_type, force)
done

(*Premise for G cannot use Always because  F \<in> Stable A  is
   weaker than G \<in> stable A *)
lemma stable_Join_Always1:
     "[| F \<in> stable(A);  G \<in> invariant(A) |] ==> F Join G \<in> Always(A)"
apply (subgoal_tac "F \<in> program & G \<in> program & st_set (A) ")
prefer 2 apply (blast dest: invariantD2 stableD2)
apply (simp add: Always_def invariant_def initially_def Stable_eq_stable)
apply (force intro: stable_Int)
done

(*As above, but exchanging the roles of F and G*)
lemma stable_Join_Always2:
     "[| F \<in> invariant(A);  G \<in> stable(A) |] ==> F Join G \<in> Always(A)"
apply (subst Join_commute)
apply (blast intro: stable_Join_Always1)
done

lemma stable_Join_ensures1:
     "[| F \<in> stable(A);  G \<in> A ensures B |] ==> F Join G \<in> A ensures B"
apply (subgoal_tac "F \<in> program & G \<in> program & st_set (A) ")
prefer 2 apply (blast dest: stableD2 ensures_type [THEN subsetD])
apply (simp (no_asm_simp) add: Join_ensures)
apply (simp add: stable_def ensures_def)
apply (erule constrains_weaken, auto)
done

(*As above, but exchanging the roles of F and G*)
lemma stable_Join_ensures2:
     "[| F \<in> A ensures B;  G \<in> stable(A) |] ==> F Join G \<in> A ensures B"
apply (subst Join_commute)
apply (blast intro: stable_Join_ensures1)
done

subsection{*The ok and OK relations*}

lemma ok_SKIP1 [iff]: "SKIP ok F"
by (auto dest: Acts_type [THEN subsetD] simp add: ok_def)

lemma ok_SKIP2 [iff]: "F ok SKIP"
by (auto dest: Acts_type [THEN subsetD] simp add: ok_def)

lemma ok_Join_commute:
     "(F ok G & (F Join G) ok H) \<longleftrightarrow> (G ok H & F ok (G Join H))"
by (auto simp add: ok_def)

lemma ok_commute: "(F ok G) \<longleftrightarrow>(G ok F)"
by (auto simp add: ok_def)

lemmas ok_sym = ok_commute [THEN iffD1]

lemma ok_iff_OK: "OK({<0,F>,<1,G>,<2,H>}, snd) \<longleftrightarrow> (F ok G & (F Join G) ok H)"
by (simp add: ok_def Join_def OK_def Int_assoc cons_absorb
                 Int_Un_distrib2 Ball_def,  safe, force+)

lemma ok_Join_iff1 [iff]: "F ok (G Join H) \<longleftrightarrow> (F ok G & F ok H)"
by (auto simp add: ok_def)

lemma ok_Join_iff2 [iff]: "(G Join H) ok F \<longleftrightarrow> (G ok F & H ok F)"
by (auto simp add: ok_def)

(*useful?  Not with the previous two around*)
lemma ok_Join_commute_I: "[| F ok G; (F Join G) ok H |] ==> F ok (G Join H)"
by (auto simp add: ok_def)

lemma ok_JN_iff1 [iff]: "F ok JOIN(I,G) \<longleftrightarrow> (\<forall>i \<in> I. F ok G(i))"
by (force dest: Acts_type [THEN subsetD] elim!: not_emptyE simp add: ok_def)

lemma ok_JN_iff2 [iff]: "JOIN(I,G) ok F   \<longleftrightarrow>  (\<forall>i \<in> I. G(i) ok F)"
apply (auto elim!: not_emptyE simp add: ok_def)
apply (blast dest: Acts_type [THEN subsetD])
done

lemma OK_iff_ok: "OK(I,F) \<longleftrightarrow> (\<forall>i \<in> I. \<forall>j \<in> I-{i}. F(i) ok (F(j)))"
by (auto simp add: ok_def OK_def)

lemma OK_imp_ok: "[| OK(I,F); i \<in> I; j \<in> I; i\<noteq>j|] ==> F(i) ok F(j)"
by (auto simp add: OK_iff_ok)

lemma OK_0 [iff]: "OK(0,F)"
by (simp add: OK_def)

lemma OK_cons_iff:
     "OK(cons(i, I), F) \<longleftrightarrow>
      (i \<in> I & OK(I, F)) | (i\<notin>I & OK(I, F) & F(i) ok JOIN(I,F))"
apply (simp add: OK_iff_ok)
apply (blast intro: ok_sym)
done

subsection{*Allowed*}

lemma Allowed_SKIP [simp]: "Allowed(SKIP) = program"
by (auto dest: Acts_type [THEN subsetD] simp add: Allowed_def)

lemma Allowed_Join [simp]:
     "Allowed(F Join G) =
   Allowed(programify(F)) \<inter> Allowed(programify(G))"
apply (auto simp add: Allowed_def)
done

lemma Allowed_JN [simp]:
     "i \<in> I ==>
   Allowed(JOIN(I,F)) = (\<Inter>i \<in> I. Allowed(programify(F(i))))"
apply (auto simp add: Allowed_def, blast)
done

lemma ok_iff_Allowed:
     "F ok G \<longleftrightarrow> (programify(F) \<in> Allowed(programify(G)) &
   programify(G) \<in> Allowed(programify(F)))"
by (simp add: ok_def Allowed_def)

lemma OK_iff_Allowed:
     "OK(I,F) \<longleftrightarrow>
  (\<forall>i \<in> I. \<forall>j \<in> I-{i}. programify(F(i)) \<in> Allowed(programify(F(j))))"
apply (auto simp add: OK_iff_ok ok_iff_Allowed)
done

subsection{*safety_prop, for reasoning about given instances of "ok"*}

lemma safety_prop_Acts_iff:
     "safety_prop(X) ==> (Acts(G) \<subseteq> cons(id(state), (\<Union>F \<in> X. Acts(F)))) \<longleftrightarrow> (programify(G) \<in> X)"
apply (simp (no_asm_use) add: safety_prop_def)
apply clarify
apply (case_tac "G \<in> program", simp_all, blast, safe)
prefer 2 apply force
apply (force simp add: programify_def)
done

lemma safety_prop_AllowedActs_iff_Allowed:
     "safety_prop(X) ==>
  (\<Union>G \<in> X. Acts(G)) \<subseteq> AllowedActs(F) \<longleftrightarrow> (X \<subseteq> Allowed(programify(F)))"
apply (simp add: Allowed_def safety_prop_Acts_iff [THEN iff_sym]
                 safety_prop_def, blast)
done

lemma Allowed_eq:
     "safety_prop(X) ==> Allowed(mk_program(init, acts, \<Union>F \<in> X. Acts(F))) = X"
apply (subgoal_tac "cons (id (state), \<Union>(RepFun (X, Acts)) \<inter> Pow (state * state)) = \<Union>(RepFun (X, Acts))")
apply (rule_tac [2] equalityI)
  apply (simp del: UN_simps add: Allowed_def safety_prop_Acts_iff safety_prop_def, auto)
apply (force dest: Acts_type [THEN subsetD] simp add: safety_prop_def)+
done

lemma def_prg_Allowed:
     "[| F == mk_program (init, acts, \<Union>F \<in> X. Acts(F)); safety_prop(X) |]
      ==> Allowed(F) = X"
by (simp add: Allowed_eq)

(*For safety_prop to hold, the property must be satisfiable!*)
lemma safety_prop_constrains [iff]:
     "safety_prop(A co B) \<longleftrightarrow> (A \<subseteq> B & st_set(A))"
by (simp add: safety_prop_def constrains_def st_set_def, blast)

(* To be used with resolution *)
lemma safety_prop_constrainsI [iff]:
     "[| A\<subseteq>B; st_set(A) |] ==>safety_prop(A co B)"
by auto

lemma safety_prop_stable [iff]: "safety_prop(stable(A)) \<longleftrightarrow> st_set(A)"
by (simp add: stable_def)

lemma safety_prop_stableI: "st_set(A) ==> safety_prop(stable(A))"
by auto

lemma safety_prop_Int [simp]:
     "[| safety_prop(X) ; safety_prop(Y) |] ==> safety_prop(X \<inter> Y)"
apply (simp add: safety_prop_def, safe, blast)
apply (drule_tac [2] B = "\<Union>(RepFun (X \<inter> Y, Acts))" and C = "\<Union>(RepFun (Y, Acts))" in subset_trans)
apply (drule_tac B = "\<Union>(RepFun (X \<inter> Y, Acts))" and C = "\<Union>(RepFun (X, Acts))" in subset_trans)
apply blast+
done

(* If I=0 the conclusion becomes safety_prop(0) which is false *)
lemma safety_prop_Inter:
  assumes major: "(!!i. i \<in> I ==>safety_prop(X(i)))"
      and minor: "i \<in> I"
  shows "safety_prop(\<Inter>i \<in> I. X(i))"
apply (simp add: safety_prop_def)
apply (cut_tac minor, safe)
apply (simp (no_asm_use) add: Inter_iff)
apply clarify
apply (frule major)
apply (drule_tac [2] i = xa in major)
apply (frule_tac [4] i = xa in major)
apply (auto simp add: safety_prop_def)
apply (drule_tac B = "\<Union>(RepFun (\<Inter>(RepFun (I, X)), Acts))" and C = "\<Union>(RepFun (X (xa), Acts))" in subset_trans)
apply blast+
done

lemma def_UNION_ok_iff:
"[| F == mk_program(init,acts, \<Union>G \<in> X. Acts(G)); safety_prop(X) |]
      ==> F ok G \<longleftrightarrow> (programify(G) \<in> X & acts \<inter> Pow(state*state) \<subseteq> AllowedActs(G))"
apply (unfold ok_def)
apply (drule_tac G = G in safety_prop_Acts_iff)
apply (cut_tac F = G in AllowedActs_type)
apply (cut_tac F = G in Acts_type, auto)
done

end