           (*-------------------------------------------*
            |        CSP-Prover on Isabelle2005         |
            |                  April 2006               |
            |                  March 2007  (modified)   |
            |                                           |
            |        Yoshinao Isobe (AIST JAPAN)        |
            *-------------------------------------------*)

theory CSP_F_law_aux
imports CSP_F_law
begin

(*---------------------------------------------------------------*
 |                                                               |
 |           convenient laws, especially for tactics             |
 |                                                               |
 *---------------------------------------------------------------*)

(*****************************************************************
                            Internal
 *****************************************************************)

(*------------------*
 |     singleton    |
 *------------------*)

(*** ! :{a} ***)

lemma cspF_Rep_int_choice_sum1_singleton:
  "!! : type1 {c} .. Pf =F[M,M] Pf (type1 c)"
by (rule cspF_Rep_int_choice_const, auto)

lemma cspF_Rep_int_choice_sum2_singleton:
  "!! : type2 {c} .. Pf =F[M,M] Pf (type2 c)"
by (rule cspF_Rep_int_choice_const, auto)

lemma cspF_Rep_int_choice_nat_singleton:
  "!nat :{n} .. Pf =F[M,M] Pf n"
by (rule cspF_Rep_int_choice_const, auto)

lemma cspF_Rep_int_choice_set_singleton:
  "!set :{X} .. Pf =F[M,M] Pf X"
by (rule cspF_Rep_int_choice_const, auto)

lemma cspF_Rep_int_choice_com_singleton:
  "! :{a} .. Pf =F[M,M] Pf a"
by (rule cspF_Rep_int_choice_const, auto)

lemma cspF_Rep_int_choice_f_singleton:
  "inj f ==> !<f> :{x} .. Pf =F[M,M] Pf x"
by (rule cspF_Rep_int_choice_const, auto)

lemmas cspF_Rep_int_choice_singleton =
       cspF_Rep_int_choice_sum1_singleton
       cspF_Rep_int_choice_sum2_singleton
       cspF_Rep_int_choice_nat_singleton
       cspF_Rep_int_choice_set_singleton
       cspF_Rep_int_choice_com_singleton
       cspF_Rep_int_choice_f_singleton

lemma cspF_Rep_int_choice_const_sum_rule:
  "!! c:C .. P =F[M,M] IF (sumset C={}) THEN DIV ELSE P"
apply (case_tac "sumset C={}")
apply (simp)
apply (rule cspF_rw_right)
apply (rule cspF_IF)
apply (rule cspF_Rep_int_choice_empty)
apply (simp)
apply (simp)
apply (rule cspF_rw_right)
apply (rule cspF_IF)
apply (rule cspF_Rep_int_choice_const)
apply (simp_all)
done

lemma cspF_Rep_int_choice_const_nat_rule:
  "!nat n:N .. P =F[M,M] IF (N={}) THEN DIV ELSE P"
apply (simp add: Rep_int_choice_ss_def)
apply (rule cspF_rw_left)
apply (rule cspF_Rep_int_choice_const_sum_rule)
by (simp)

lemma cspF_Rep_int_choice_const_set_rule:
  "!set X:Xs .. P =F[M,M] IF (Xs={}) THEN DIV ELSE P"
apply (simp add: Rep_int_choice_ss_def)
apply (rule cspF_rw_left)
apply (rule cspF_Rep_int_choice_const_sum_rule)
by (simp)

lemma cspF_Rep_int_choice_const_com_rule:
  "! x:X .. P =F[M,M] IF (X={}) THEN DIV ELSE P"
apply (simp add: Rep_int_choice_com_def)
apply (rule cspF_rw_left)
apply (rule cspF_Rep_int_choice_const_set_rule)
by (simp)

lemma cspF_Rep_int_choice_const_f_rule:
  "!<f> x:X .. P =F[M,M] IF (X={}) THEN DIV ELSE P"
apply (simp add: Rep_int_choice_f_def)
apply (rule cspF_rw_left)
apply (rule cspF_Rep_int_choice_const_com_rule)
by (simp)

lemmas cspF_Rep_int_choice_const_rule =
       cspF_Rep_int_choice_const_sum_rule
       cspF_Rep_int_choice_const_nat_rule
       cspF_Rep_int_choice_const_set_rule
       cspF_Rep_int_choice_const_com_rule
       cspF_Rep_int_choice_const_f_rule

lemmas cspF_Int_choice_rule = cspF_Rep_int_choice_empty
                              cspF_Rep_int_choice_singleton
                              cspF_Int_choice_idem
                              cspF_Rep_int_choice_const_rule

(*****************************************************************
                          External
 *****************************************************************)

(* to make produced process be concrete *)

lemma cspF_Ext_pre_choice_empty_DIV:
   "? :{} -> Pf =F[M1,M2] ? a:{} -> DIV"
apply (rule cspF_rw_left)
apply (rule cspF_STOP_step[THEN cspF_sym])
apply (rule cspF_STOP_step)
done

lemma cspF_Ext_choice_unit_l_hsf:
  "? :{} -> Qf [+] P =F[M,M] P"
apply (rule cspF_rw_left)
apply (rule cspF_decompo)
apply (rule cspF_step[THEN cspF_sym])
apply (rule cspF_reflex)
apply (simp add: cspF_unit)
done

lemma cspF_Ext_choice_unit_r_hsf:
  "P [+] ? :{} -> Qf =F[M,M] P"
apply (rule cspF_rw_left)
apply (rule cspF_commut)
apply (simp add: cspF_Ext_choice_unit_l_hsf)
done

lemmas cspF_Ext_choice_rule = cspF_Ext_pre_choice_empty_DIV
                              cspF_Ext_choice_unit_l
                              cspF_Ext_choice_unit_l_hsf
                              cspF_Ext_choice_unit_r
                              cspF_Ext_choice_unit_r_hsf
                              cspF_Ext_choice_idem

(*-----------------------------*
 |      simp rule for cspF     |
 *-----------------------------*)

lemmas cspF_choice_rule  = cspF_Int_choice_rule cspF_Ext_choice_rule

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

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

(*** <= Timeout ***)

lemma cspF_Timeout_right:
  "[| P <=F[M1,M2] Q1 ; P <=F[M1,M2] Q2 |] ==> P <=F[M1,M2] Q1 [> Q2"
apply (rule cspF_rw_right)
apply (rule cspF_dist)
apply (rule cspF_Int_choice_right)
apply (rule cspF_Ext_choice_right, simp_all)
apply (rule cspF_rw_right)
apply (rule cspF_Ext_choice_unit_l, simp_all)
done

(*** STOP [> P  =  P ***)

lemma cspF_STOP_Timeout:
  "STOP [> P =F[M,M] P"
apply (rule cspF_rw_left)
apply (rule cspF_dist)
apply (rule cspF_rw_left)
apply (rule cspF_Int_choice_idem)
apply (rule cspF_unit)
done

(*================================================*
 |                                                |
 |               auxiliary step laws              |
 |                                                |
 *================================================*)

(* split + resolve *)

lemma cspF_Parallel_Timeout_split_resolve_SKIP_or_DIV:
  "[| P = SKIP | P = DIV ; Q = SKIP | Q = DIV |] ==>
    ((? :Y -> Pf) [+] P) |[X]| ((? :Z -> Qf) [+] Q) =F[M,M]
     (? x:((X Int Y Int Z) Un (Y - X) Un (Z - X))
         -> IF (x : X) THEN (Pf x |[X]| Qf x)
               ELSE IF (x : Y & x : Z) THEN ((Pf x |[X]| ((? x:Z -> Qf x) [+] Q))
                                        |~| (((? x:Y -> Pf x) [+] P) |[X]| Qf x))
               ELSE IF (x : Y) THEN (Pf x |[X]| ((? x:Z -> Qf x) [+] Q))
               ELSE (((? x:Y -> Pf x) [+] P) |[X]| Qf x))
     [> (((P |[X]| ((? :Z -> Qf) [+] Q)) |~|
         (((? :Y -> Pf) [+] P) |[X]| Q)))"
apply (rule cspF_rw_left)
apply (rule cspF_decompo)
apply (simp)
apply (rule cspF_Ext_choice_SKIP_or_DIV_resolve)
apply (simp)
apply (rule cspF_Ext_choice_SKIP_or_DIV_resolve)
apply (simp)

apply (rule cspF_rw_left)
apply (rule cspF_Parallel_Timeout_split)
apply (rule cspF_decompo)
apply (rule cspF_decompo)
apply (rule cspF_decompo)
apply (simp)
apply (rule cspF_decompo)
apply (simp)
apply (simp)
apply (rule cspF_decompo)
apply (simp)
apply (rule cspF_decompo)
apply (rule cspF_decompo)
apply (simp)
apply (simp)
apply (rule cspF_Ext_choice_SKIP_or_DIV_resolve[THEN cspF_sym])
apply (simp)

apply (rule cspF_decompo)
apply (simp)
apply (simp)
apply (rule cspF_Ext_choice_SKIP_or_DIV_resolve[THEN cspF_sym])
apply (simp)
apply (simp)

apply (rule cspF_decompo)
apply (simp)
apply (rule cspF_decompo)
apply (simp)
apply (simp)
apply (rule cspF_Ext_choice_SKIP_or_DIV_resolve[THEN cspF_sym])
apply (simp)
apply (rule cspF_decompo)
apply (simp)
apply (simp)
apply (rule cspF_Ext_choice_SKIP_or_DIV_resolve[THEN cspF_sym])
apply (simp)
apply (simp)
apply (simp)

apply (rule cspF_decompo)
apply (rule cspF_decompo)
apply (simp)
apply (simp)
apply (rule cspF_Ext_choice_SKIP_or_DIV_resolve[THEN cspF_sym])
apply (simp)
apply (rule cspF_decompo)
apply (simp)
apply (rule cspF_Ext_choice_SKIP_or_DIV_resolve[THEN cspF_sym])
apply (simp)
apply (simp)
done

lemma cspF_Parallel_Timeout_split_resolve_SKIP_SKIP:
  "((? :Y -> Pf) [+] SKIP) |[X]| ((? :Z -> Qf) [+] SKIP) =F[M,M]
     (? x:((X Int Y Int Z) Un (Y - X) Un (Z - X))
         -> IF (x : X) THEN (Pf x |[X]| Qf x)
               ELSE IF (x : Y & x : Z) THEN ((Pf x |[X]| ((? x:Z -> Qf x) [+] SKIP))
                                        |~| (((? x:Y -> Pf x) [+] SKIP) |[X]| Qf x))
               ELSE IF (x : Y) THEN (Pf x |[X]| ((? x:Z -> Qf x) [+] SKIP))
               ELSE (((? x:Y -> Pf x) [+] SKIP) |[X]| Qf x))
     [> (((SKIP |[X]| ((? :Z -> Qf) [+] SKIP)) |~|
         (((? :Y -> Pf) [+] SKIP) |[X]| SKIP)))"
by (simp add: cspF_Parallel_Timeout_split_resolve_SKIP_or_DIV)

lemma cspF_Parallel_Timeout_split_resolve_DIV_DIV:
  "((? :Y -> Pf) [+] DIV) |[X]| ((? :Z -> Qf) [+] DIV) =F[M,M]
     (? x:((X Int Y Int Z) Un (Y - X) Un (Z - X))
         -> IF (x : X) THEN (Pf x |[X]| Qf x)
               ELSE IF (x : Y & x : Z) THEN ((Pf x |[X]| ((? x:Z -> Qf x) [+] DIV))
                                        |~| (((? x:Y -> Pf x) [+] DIV) |[X]| Qf x))
               ELSE IF (x : Y) THEN (Pf x |[X]| ((? x:Z -> Qf x) [+] DIV))
               ELSE (((? x:Y -> Pf x) [+] DIV) |[X]| Qf x))
     [> (((DIV |[X]| ((? :Z -> Qf) [+] DIV)) |~|
         (((? :Y -> Pf) [+] DIV) |[X]| DIV)))"
by (simp add: cspF_Parallel_Timeout_split_resolve_SKIP_or_DIV)

lemma cspF_Parallel_Timeout_split_resolve_SKIP_DIV:
  "((? :Y -> Pf) [+] SKIP) |[X]| ((? :Z -> Qf) [+] DIV) =F[M,M]
     (? x:((X Int Y Int Z) Un (Y - X) Un (Z - X))
         -> IF (x : X) THEN (Pf x |[X]| Qf x)
               ELSE IF (x : Y & x : Z) THEN ((Pf x |[X]| ((? x:Z -> Qf x) [+] DIV))
                                        |~| (((? x:Y -> Pf x) [+] SKIP) |[X]| Qf x))
               ELSE IF (x : Y) THEN (Pf x |[X]| ((? x:Z -> Qf x) [+] DIV))
               ELSE (((? x:Y -> Pf x) [+] SKIP) |[X]| Qf x))
     [> (((SKIP |[X]| ((? :Z -> Qf) [+] DIV)) |~|
         (((? :Y -> Pf) [+] SKIP) |[X]| DIV)))"
by (simp add: cspF_Parallel_Timeout_split_resolve_SKIP_or_DIV)

lemma cspF_Parallel_Timeout_split_resolve_DIV_SKIP:
  "((? :Y -> Pf) [+] DIV) |[X]| ((? :Z -> Qf) [+] SKIP) =F[M,M]
     (? x:((X Int Y Int Z) Un (Y - X) Un (Z - X))
         -> IF (x : X) THEN (Pf x |[X]| Qf x)
               ELSE IF (x : Y & x : Z) THEN ((Pf x |[X]| ((? x:Z -> Qf x) [+] SKIP))
                                        |~| (((? x:Y -> Pf x) [+] DIV) |[X]| Qf x))
               ELSE IF (x : Y) THEN (Pf x |[X]| ((? x:Z -> Qf x) [+] SKIP))
               ELSE (((? x:Y -> Pf x) [+] DIV) |[X]| Qf x))
     [> (((DIV |[X]| ((? :Z -> Qf) [+] SKIP)) |~|
         (((? :Y -> Pf) [+] DIV) |[X]| SKIP)))"
by (simp add: cspF_Parallel_Timeout_split_resolve_SKIP_or_DIV)

lemmas cspF_Parallel_Timeout_split_resolve =
       cspF_Parallel_Timeout_split_resolve_SKIP_SKIP
       cspF_Parallel_Timeout_split_resolve_DIV_DIV
       cspF_Parallel_Timeout_split_resolve_SKIP_DIV
       cspF_Parallel_Timeout_split_resolve_DIV_SKIP

(* input + resolve *)

lemma cspF_Parallel_Timeout_input_resolve_SKIP_or_DIV_l:
  "P = SKIP | P = DIV ==>
   ((? :Y -> Pf) [+] P) |[X]| (? :Z -> Qf) =F[M,M]
     (? x:((X Int Y Int Z) Un (Y - X) Un (Z - X))
         -> IF (x : X) THEN (Pf x |[X]| Qf x)
               ELSE IF (x : Y & x : Z) THEN ((Pf x |[X]| (? x:Z -> Qf x))
                                        |~| (((? x:Y -> Pf x) [+] P) |[X]| Qf x))
               ELSE IF (x : Y) THEN (Pf x |[X]| (? x:Z -> Qf x))
               ELSE (((? x:Y -> Pf x) [+] P) |[X]| Qf x))
     [> (((P |[X]| (? :Z -> Qf))))"
apply (rule cspF_rw_left)
apply (rule cspF_decompo)
apply (simp)
apply (rule cspF_Ext_choice_SKIP_or_DIV_resolve)
apply (simp)
apply (rule cspF_reflex)

apply (rule cspF_rw_left)
apply (rule cspF_Parallel_Timeout_input)
apply (rule cspF_decompo)
apply (rule cspF_decompo)
apply (rule cspF_decompo)
apply (simp)
apply (rule cspF_decompo)
apply (simp)
apply (simp)
apply (rule cspF_decompo)
apply (simp)
apply (rule cspF_decompo)
apply (simp)

apply (rule cspF_decompo)
apply (simp)
apply (simp)
apply (rule cspF_Ext_choice_SKIP_or_DIV_resolve[THEN cspF_sym])
apply (simp)
apply (simp)

apply (rule cspF_decompo)
apply (simp)
apply (simp)
apply (rule cspF_decompo)
apply (simp)
apply (simp)
apply (rule cspF_Ext_choice_SKIP_or_DIV_resolve[THEN cspF_sym])
apply (simp)
apply (simp)
apply (simp)

apply (simp)
done

lemma cspF_Parallel_Timeout_input_resolve_SKIP_or_DIV_r:
  "Q = SKIP | Q = DIV ==>
   (? :Y -> Pf) |[X]| ((? :Z -> Qf) [+] Q) =F[M,M]
     (? x:((X Int Y Int Z) Un (Y - X) Un (Z - X))
         -> IF (x : X) THEN (Pf x |[X]| Qf x)
               ELSE IF (x : Y & x : Z) THEN ((Pf x |[X]| ((? x:Z -> Qf x) [+] Q))
                                        |~| ((? x:Y -> Pf x) |[X]| Qf x))
               ELSE IF (x : Y) THEN (Pf x |[X]| ((? x:Z -> Qf x) [+] Q))
               ELSE ((? x:Y -> Pf x) |[X]| Qf x))
     [> ((((? :Y -> Pf) |[X]| Q)))"
apply (rule cspF_rw_left)
apply (rule cspF_decompo)
apply (simp)
apply (rule cspF_reflex)
apply (rule cspF_Ext_choice_SKIP_or_DIV_resolve)
apply (simp)

apply (rule cspF_rw_left)
apply (rule cspF_Parallel_Timeout_input)
apply (rule cspF_decompo)
apply (rule cspF_decompo)
apply (rule cspF_decompo)
apply (simp)
apply (rule cspF_decompo)
apply (simp)
apply (simp)
apply (rule cspF_decompo)
apply (simp)
apply (rule cspF_decompo)
apply (rule cspF_decompo)
apply (simp)
apply (simp)
apply (rule cspF_Ext_choice_SKIP_or_DIV_resolve[THEN cspF_sym])
apply (simp)
apply (simp)

apply (rule cspF_decompo)
apply (simp)
apply (simp)
apply (rule cspF_decompo)
apply (simp)
apply (simp)
apply (rule cspF_Ext_choice_SKIP_or_DIV_resolve[THEN cspF_sym])
apply (simp)
apply (simp)
apply (simp)

apply (simp)
done

lemmas cspF_Parallel_Timeout_input_resolve_SKIP_or_DIV =
       cspF_Parallel_Timeout_input_resolve_SKIP_or_DIV_l
       cspF_Parallel_Timeout_input_resolve_SKIP_or_DIV_r

lemma cspF_Parallel_Timeout_input_resolve_SKIP_l:
  "((? :Y -> Pf) [+] SKIP) |[X]| (? :Z -> Qf) =F[M,M]
     (? x:((X Int Y Int Z) Un (Y - X) Un (Z - X))
         -> IF (x : X) THEN (Pf x |[X]| Qf x)
               ELSE IF (x : Y & x : Z) THEN ((Pf x |[X]| (? x:Z -> Qf x))
                                        |~| (((? x:Y -> Pf x) [+] SKIP) |[X]| Qf x))
               ELSE IF (x : Y) THEN (Pf x |[X]| (? x:Z -> Qf x))
               ELSE (((? x:Y -> Pf x) [+] SKIP) |[X]| Qf x))
     [> (((SKIP |[X]| (? :Z -> Qf))))"
by (simp add: cspF_Parallel_Timeout_input_resolve_SKIP_or_DIV)

lemma cspF_Parallel_Timeout_input_resolve_DIV_l:
  "((? :Y -> Pf) [+] DIV) |[X]| (? :Z -> Qf) =F[M,M]
     (? x:((X Int Y Int Z) Un (Y - X) Un (Z - X))
         -> IF (x : X) THEN (Pf x |[X]| Qf x)
               ELSE IF (x : Y & x : Z) THEN ((Pf x |[X]| (? x:Z -> Qf x))
                                        |~| (((? x:Y -> Pf x) [+] DIV) |[X]| Qf x))
               ELSE IF (x : Y) THEN (Pf x |[X]| (? x:Z -> Qf x))
               ELSE (((? x:Y -> Pf x) [+] DIV) |[X]| Qf x))
     [> (((DIV |[X]| (? :Z -> Qf))))"
by (simp add: cspF_Parallel_Timeout_input_resolve_SKIP_or_DIV)

lemma cspF_Parallel_Timeout_input_resolve_SKIP_r:
  "(? :Y -> Pf) |[X]| ((? :Z -> Qf) [+] SKIP) =F[M,M]
     (? x:((X Int Y Int Z) Un (Y - X) Un (Z - X))
         -> IF (x : X) THEN (Pf x |[X]| Qf x)
               ELSE IF (x : Y & x : Z) THEN ((Pf x |[X]| ((? x:Z -> Qf x) [+] SKIP))
                                        |~| ((? x:Y -> Pf x) |[X]| Qf x))
               ELSE IF (x : Y) THEN (Pf x |[X]| ((? x:Z -> Qf x) [+] SKIP))
               ELSE ((? x:Y -> Pf x) |[X]| Qf x))
     [> ((((? :Y -> Pf) |[X]| SKIP)))"
by (simp add: cspF_Parallel_Timeout_input_resolve_SKIP_or_DIV)

lemma cspF_Parallel_Timeout_input_resolve_DIV_r:
  "(? :Y -> Pf) |[X]| ((? :Z -> Qf) [+] DIV) =F[M,M]
     (? x:((X Int Y Int Z) Un (Y - X) Un (Z - X))
         -> IF (x : X) THEN (Pf x |[X]| Qf x)
               ELSE IF (x : Y & x : Z) THEN ((Pf x |[X]| ((? x:Z -> Qf x) [+] DIV))
                                        |~| ((? x:Y -> Pf x) |[X]| Qf x))
               ELSE IF (x : Y) THEN (Pf x |[X]| ((? x:Z -> Qf x) [+] DIV))
               ELSE ((? x:Y -> Pf x) |[X]| Qf x))
     [> ((((? :Y -> Pf) |[X]| DIV)))"
by (simp add: cspF_Parallel_Timeout_input_resolve_SKIP_or_DIV)

lemmas cspF_Parallel_Timeout_input_resolve =
       cspF_Parallel_Timeout_input_resolve_SKIP_l
       cspF_Parallel_Timeout_input_resolve_SKIP_r
       cspF_Parallel_Timeout_input_resolve_DIV_l
       cspF_Parallel_Timeout_input_resolve_DIV_r

(**************** ;; + resolve ****************)

lemma cspF_SKIP_Seq_compo_step_resolve:
  "((? :X -> Pf) [+] SKIP) ;; Q =F[M,M] (? x:X -> (Pf x ;; Q)) [> Q"
apply (rule cspF_rw_left)
apply (rule cspF_decompo)
apply (rule cspF_Ext_choice_SKIP_or_DIV_resolve)
apply (simp)
apply (rule cspF_reflex)
apply (rule cspF_SKIP_Seq_compo_step)
done

lemma cspF_DIV_Seq_compo_step_resolve:
  "((? :X -> Pf) [+] DIV) ;; Q =F[M,M] (? x:X -> (Pf x ;; Q)) [+] DIV"
apply (rule cspF_rw_left)
apply (rule cspF_decompo)
apply (rule cspF_Ext_choice_SKIP_or_DIV_resolve)
apply (simp)
apply (rule cspF_reflex)

apply (rule cspF_rw_left)
apply (rule cspF_DIV_Seq_compo_step)
apply (rule cspF_Ext_choice_SKIP_DIV_resolve[THEN cspF_sym])
done

lemmas cspF_SKIP_DIV_Seq_compo_step_resolve =
       cspF_SKIP_Seq_compo_step_resolve
       cspF_DIV_Seq_compo_step_resolve

(****** for sequentilising processes with SKIP or DIV ******)

lemmas cspF_SKIP_DIV_resolve =
       cspF_SKIP_DIV
       cspF_Parallel_Timeout_split_resolve
       cspF_Parallel_Timeout_input_resolve
       cspF_SKIP_DIV_Seq_compo_step_resolve

lemmas cspF_SKIP_or_DIV_resolve =
       cspF_Parallel_Timeout_split_resolve_SKIP_or_DIV
       cspF_Parallel_Timeout_input_resolve_SKIP_or_DIV

(*=========================================================*
 |                                                         |
 |   for convenience, especially for fully sequntialising  |
 |                                                         |
 *=========================================================*)

lemma cspF_SKIP_or_DIV_or_STOP_Parallel_Ext_choice_DIV_l:
  "Q = SKIP | Q = DIV | Q = STOP ==>
   (P [+] Q) |[X]| DIV =F[M,M] (P |[X]| DIV)"
apply (erule disjE)
apply (simp)
apply (rule cspF_SKIP_DIV)
apply (erule disjE)
apply (simp)
apply (rule cspF_SKIP_DIV)
apply (simp)
apply (rule cspF_rw_left)
apply (rule cspF_decompo)
apply (simp_all)
apply (rule cspF_unit)
apply (rule cspF_reflex)
apply (rule cspF_reflex)
done

lemma cspF_SKIP_or_DIV_or_STOP_Parallel_Ext_choice_DIV_r:
  "Q = SKIP | Q = DIV | Q = STOP ==>
   DIV |[X]| (P [+] Q) =F[M,M] (DIV |[X]| P)"
apply (rule cspF_rw_left)
apply (rule cspF_commut)
apply (rule cspF_rw_right)
apply (rule cspF_commut)
apply (simp add: cspF_SKIP_or_DIV_or_STOP_Parallel_Ext_choice_DIV_l)
done

lemmas cspF_SKIP_or_DIV_or_STOP_Parallel_Ext_choice_DIV =
       cspF_SKIP_or_DIV_or_STOP_Parallel_Ext_choice_DIV_l
       cspF_SKIP_or_DIV_or_STOP_Parallel_Ext_choice_DIV_r

lemma cspF_SKIP_or_DIV_or_STOP_Parallel_Ext_choice_SKIP_l:
  "Q = SKIP | Q = DIV | Q = STOP ==>
   ((? :Y -> Pf) [+] Q) |[X]| SKIP =F[M,M]
   (? x:(Y - X) -> (Pf x |[X]| SKIP)) [+] Q"
apply (erule disjE)
apply (simp)
apply (rule cspF_SKIP_DIV)
apply (erule disjE)
apply (simp)
apply (rule cspF_SKIP_DIV)

apply (simp)
apply (rule cspF_rw_left)
apply (rule cspF_decompo)
apply (simp_all)
apply (rule cspF_unit)
apply (rule cspF_reflex)

apply (rule cspF_rw_right)
apply (rule cspF_unit)
apply (rule cspF_SKIP_DIV)
done

lemma cspF_SKIP_or_DIV_or_STOP_Parallel_Ext_choice_SKIP_r:
  "Q = SKIP | Q = DIV | Q = STOP ==>
   SKIP |[X]| ((? :Y -> Pf) [+] Q) =F[M,M]
   (? x:(Y - X) -> (SKIP |[X]| Pf x)) [+] Q"
apply (rule cspF_rw_left)
apply (rule cspF_commut)
apply (rule cspF_rw_right)
apply (rule cspF_decompo)
apply (rule cspF_decompo)
apply (simp)
apply (rule cspF_commut)
apply (rule cspF_reflex)
apply (simp add: cspF_SKIP_or_DIV_or_STOP_Parallel_Ext_choice_SKIP_l)
done

lemmas cspF_SKIP_or_DIV_or_STOP_Parallel_Ext_choice_SKIP =
       cspF_SKIP_or_DIV_or_STOP_Parallel_Ext_choice_SKIP_l
       cspF_SKIP_or_DIV_or_STOP_Parallel_Ext_choice_SKIP_r

lemmas cspF_SKIP_or_DIV_or_STOP_Parallel_Ext_choice =
       cspF_SKIP_or_DIV_or_STOP_Parallel_Ext_choice_DIV
       cspF_SKIP_or_DIV_or_STOP_Parallel_Ext_choice_SKIP

(* renaming *)

lemma cspF_SKIP_or_DIV_or_STOP_Renaming_Id:
   "P = SKIP | P = DIV | P = STOP ==> P [[r]] =F[M,M] P"
apply (erule disjE)
apply (simp add: cspF_SKIP_DIV)
apply (erule disjE)
apply (simp add: cspF_SKIP_DIV)

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_decompo)
apply (simp)
apply (rule cspF_Ext_pre_choice_empty_DIV)

apply (rule cspF_rw_left)
apply (rule cspF_step)

apply (rule cspF_rw_right)
apply (rule cspF_step)

apply (rule cspF_decompo)
apply (auto)
done

(* restg *)

lemma cspF_STOP_Depth_rest:
   "STOP |. Suc n =F[M,M] STOP"
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 (auto)
done

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

(*********************************************************
                       P |[X,Y]| Q (aux)
 *********************************************************)

lemma cspF_Alpha_Parallel_step:
  "(? :A -> Pf) |[X,Y]| (? :B -> Qf) =F[M,M]
      ? x:((A Int (X - Y)) Un (B Int (Y - X)) Un (A Int B Int X Int Y))
         -> IF (x : X & x : Y) THEN (Pf x |[X,Y]| Qf x)
            ELSE IF (x : X) THEN (Pf x |[X,Y]| ? x:B -> Qf x)
            ELSE (? x:A -> Pf x |[X,Y]| Qf x)"
apply (simp add: Alpha_parallel_def)

apply (rule cspF_rw_left)
apply (rule cspF_decompo)
apply (simp)
apply (rule cspF_SKIP)
apply (rule cspF_SKIP)

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

apply (simp)
apply (elim disjE)

 apply (simp)
 apply (rule cspF_rw_left, rule cspF_IF)+
 apply (rule cspF_rw_right, rule cspF_IF)+
 apply (rule cspF_decompo)
 apply (simp)+
 apply (rule cspF_rw_right)
 apply (rule cspF_SKIP)
 apply (simp)

 apply (simp)
 apply (rule cspF_rw_left, rule cspF_IF)+
 apply (rule cspF_rw_right, rule cspF_IF)+
 apply (rule cspF_decompo)
 apply (simp)
 apply (rule cspF_rw_right)
 apply (rule cspF_SKIP)
 apply (simp)
 apply (simp)

 apply (simp)
 apply (rule cspF_rw_left, rule cspF_IF)+
 apply (rule cspF_rw_right, rule cspF_IF)+
 apply (simp)
done

(*==============================================================*
 |                                                              |
 |       Associativity and Commutativity for SKIP and DIV       |
 |                    (for sequentialising)                     |
 |                                                              |
 *==============================================================*)

lemma cspF_Ext_pre_choice_SKIP_commut:
  "SKIP [+] (? :X -> Pf) =F[M,M] (? :X -> Pf) [+] SKIP"
by (rule cspF_commut)

lemma cspF_Ext_pre_choice_DIV_commut:
  "DIV [+] (? :X -> Pf) =F[M,M] (? :X -> Pf) [+] DIV"
by (rule cspF_commut)

lemma cspF_Ext_pre_choice_SKIP_assoc:
  "((? :X -> Pf) [+] SKIP) [+] (? :Y -> Qf)
   =F[M,M] ((? :X -> Pf) [+] (? :Y -> Qf)) [+] SKIP"
apply (rule cspF_rw_left)
apply (rule cspF_assoc[THEN cspF_sym])
apply (rule cspF_rw_left)
apply (rule cspF_decompo)
apply (rule cspF_reflex)
apply (rule cspF_commut)
apply (rule cspF_assoc)
done

lemma cspF_Ext_pre_choice_DIV_assoc:
  "((? :X -> Pf) [+] DIV) [+] (? :Y -> Qf)
   =F[M,M] ((? :X -> Pf) [+] (? :Y -> Qf)) [+] DIV"
apply (rule cspF_rw_left)
apply (rule cspF_assoc[THEN cspF_sym])
apply (rule cspF_rw_left)
apply (rule cspF_decompo)
apply (rule cspF_reflex)
apply (rule cspF_commut)
apply (rule cspF_assoc)
done

lemma cspF_Ext_choice_idem_assoc:
  "(P [+] Q) [+] Q =F[M,M] (P [+] Q)"
apply (rule cspF_rw_left)
apply (rule cspF_assoc[THEN cspF_sym])
apply (rule cspF_rw_left)
apply (rule cspF_decompo)
apply (rule cspF_reflex)
apply (rule cspF_idem)
apply (rule cspF_reflex)
done

lemma cspF_Ext_choice_SKIP_DIV_assoc:
  "(P [+] SKIP) [+] DIV =F[M,M] (P [+] SKIP)"
apply (rule cspF_rw_left)
apply (rule cspF_assoc[THEN cspF_sym])
apply (rule cspF_rw_left)
apply (rule cspF_decompo)
apply (rule cspF_reflex)
apply (rule cspF_SKIP_DIV)
apply (rule cspF_reflex)
done

lemma cspF_Ext_choice_DIV_SKIP_assoc:
  "(P [+] DIV) [+] SKIP =F[M,M] (P [+] SKIP)"
apply (rule cspF_rw_left)
apply (rule cspF_assoc[THEN cspF_sym])
apply (rule cspF_rw_left)
apply (rule cspF_decompo)
apply (rule cspF_reflex)
apply (rule cspF_SKIP_DIV)
apply (rule cspF_reflex)
done

lemmas cspF_SKIP_DIV_sort =
       cspF_Ext_choice_assoc
       cspF_Ext_pre_choice_SKIP_commut
       cspF_Ext_pre_choice_DIV_commut
       cspF_Ext_pre_choice_SKIP_assoc
       cspF_Ext_pre_choice_DIV_assoc
       cspF_Ext_choice_idem_assoc
       cspF_Ext_choice_SKIP_DIV_assoc
       cspF_Ext_choice_DIV_SKIP_assoc

(*==============================================================*
 |                                                              |
 |    decompostion control by the flag "Not_Decompo_Flag"       |
 |                                                              |
 *==============================================================*)

(*------------------------------------------------*
 |              trans with Flag                   |
 *------------------------------------------------*)

(*** rewrite (eq) ***)

lemma cspF_rw_flag_left_eq:
  "[| R1 =F[M1,M1] R2 ; Not_Decompo_Flag & R2 =F[M1,M3] R3 |] ==> R1 =F[M1,M3] R3"
by (simp add: eqF_def Not_Decompo_Flag_def)

lemma cspF_rw_flag_left_ref:
  "[| R1 =F[M1,M1] R2 ; Not_Decompo_Flag & R2 <=F[M1,M3] R3 |] ==> R1 <=F[M1,M3] R3"
by (simp add: refF_def eqF_def Not_Decompo_Flag_def)

lemmas cspF_rw_flag_left = cspF_rw_flag_left_eq cspF_rw_flag_left_ref

lemma cspF_rw_flag_right_eq:
  "[| R3 =F[M3,M3] R2 ; Not_Decompo_Flag & R1 =F[M1,M3] R2 |] ==> R1 =F[M1,M3] R3"
by (simp add: eqF_def Not_Decompo_Flag_def)

lemma cspF_rw_flag_right_ref:
  "[| R3 =F[M3,M3] R2 ; Not_Decompo_Flag & R1 <=F[M1,M3] R2 |] ==> R1 <=F[M1,M3] R3"
by (simp add: refF_def eqF_def Not_Decompo_Flag_def)

lemmas cspF_rw_flag_right = cspF_rw_flag_right_eq cspF_rw_flag_right_ref

(*------------------------------------------------*
 |              trans with Flag (ref)             |
 *------------------------------------------------*)

lemma cspF_tr_flag_left_eq:
   "[| P1 =F[M1,M1] P2 ; Not_Decompo_Flag & P2 =F[M1,M3] P3 |] ==> P1 =F[M1,M3] P3"
by (simp add: eqF_def)

lemma cspF_tr_flag_left_ref:
   "[| P1 <=F[M1,M1] P2 ; Not_Decompo_Flag & P2 <=F[M1,M3] P3 |] ==> P1 <=F[M1,M3] P3"
by (simp add: refF_def eqF_def Not_Decompo_Flag_def)

lemmas cspF_tr_flag_left = cspF_tr_flag_left_eq cspF_tr_flag_left_ref

lemma cspF_tr_flag_right_eq:
   "[| P2 =F[M3,M3] P3 ; Not_Decompo_Flag & P1 =F[M1,M3] P2 |] ==> P1 =F[M1,M3] P3"
by (simp add: eqF_def)

lemma cspF_tr_flag_right_ref:
  "[| P2 <=F[M3,M3] P3 ; Not_Decompo_Flag & P1 <=F[M1,M3] P2 |] ==> P1 <=F[M1,M3] P3"
by (simp add: refF_def eqF_def Not_Decompo_Flag_def)

lemmas cspF_tr_flag_right = cspF_tr_flag_right_eq cspF_tr_flag_right_ref

(*------------------------------------------------*
 |           trans with Flag (erule)              |
 *------------------------------------------------*)

(*** rewrite (eq) ***)

lemma cspF_rw_flag_left_eqE:
  "[| P1 =F[M1,M3] P3 ; P1 =F[M1,M1] P2 ;
      [| Not_Decompo_Flag & P2 =F[M1,M3] P3 |] ==> R |] ==> R"
by (simp add: eqF_def Not_Decompo_Flag_def)

lemma cspF_rw_flag_left_refE:
  "[| P1 <=F[M1,M3] P3 ; P1 =F[M1,M1] P2 ;
      [| Not_Decompo_Flag & P2 <=F[M1,M3] P3 |] ==> R |] ==> R"
apply (simp add: Not_Decompo_Flag_def)
apply (subgoal_tac "P2 <=F[M1,M3] P3")
apply (simp)
apply (rule cspF_rw_left)
apply (rule cspF_sym)
apply (simp)
apply (simp)
done

lemmas cspF_rw_flag_leftE =
   cspF_rw_flag_left_eqE    cspF_rw_flag_left_refE

(* right *)

lemma cspF_rw_flag_right_eqE:
  "[| P1 =F[M1,M3] P3 ; P3 =F[M3,M3] P2 ;
      [| Not_Decompo_Flag & P1 =F[M1,M3] P2 |] ==> R |] ==> R"
by (simp add: eqF_def Not_Decompo_Flag_def)

lemma cspF_rw_flag_right_refE:
  "[| P1 <=F[M1,M3] P3 ; P3 =F[M3,M3] P2 ;
      [| Not_Decompo_Flag & P1 <=F[M1,M3] P2 |] ==> R |] ==> R"
apply (simp add: Not_Decompo_Flag_def)
apply (subgoal_tac "P1 <=F[M1,M3] P2")
apply (simp)
apply (rule cspF_rw_right)
apply (rule cspF_sym)
apply (simp)
apply (simp)
done

lemmas cspF_rw_flag_rightE =
   cspF_rw_flag_right_eqE    cspF_rw_flag_right_refE

(*==============================================================*
 |  decompostion of Sequential composition with a flag          |
 |  It is often useful that the second process is not expanded. |
 |                   (until CSP-Prover 4)                       |
 *==============================================================*)

(*
lemma cspF_Seq_compo_mono_flag:
  "[| P1 <=F[M1,M2] Q1 ;
      Not_Decompo_Flag & P2 <=F[M1,M2] Q2 |]
           ==> P1 ;; P2 <=F[M1,M2] Q1 ;; Q2"
by (simp add: cspF_Seq_compo_mono)

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

lemmas cspF_free_mono_flag =
       cspF_Ext_choice_mono cspF_Int_choice_mono cspF_Parallel_mono
       cspF_Hiding_mono cspF_Renaming_mono cspF_Seq_compo_mono_flag
       cspF_Depth_rest_mono

lemmas cspF_free_cong_flag =
       cspF_Ext_choice_cong cspF_Int_choice_cong cspF_Parallel_cong
       cspF_Hiding_cong cspF_Renaming_cong cspF_Seq_compo_cong_flag
       cspF_Depth_rest_cong

lemmas cspF_free_decompo_flag = cspF_free_mono_flag cspF_free_cong_flag
*)

(*===============================================================*
 |  decompostion of Sequential composition with a flag           |
 |  It is often useful that the second process is not rewritten. |
 |                    (since CSP-Prover 5)                       |
 *===============================================================*)

lemma cspF_Seq_compo_mono_flag:
  "[| P1 <=F[M1,M2] Q1 ;
      Not_Rewrite_Flag & P2 <=F[M1,M2] Q2 |]
           ==> P1 ;; P2 <=F[M1,M2] Q1 ;; Q2"
by (simp add: cspF_Seq_compo_mono)

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

lemmas cspF_free_mono_flag =
       cspF_Ext_choice_mono cspF_Int_choice_mono cspF_Parallel_mono
       cspF_Hiding_mono cspF_Renaming_mono cspF_Seq_compo_mono_flag
       cspF_Depth_rest_mono
       cspF_Rep_int_choice_mono_UNIV

       cspF_Alpha_parallel_mono

lemmas cspF_free_cong_flag =
       cspF_Ext_choice_cong cspF_Int_choice_cong cspF_Parallel_cong
       cspF_Hiding_cong cspF_Renaming_cong cspF_Seq_compo_cong_flag
       cspF_Depth_rest_cong
       cspF_Rep_int_choice_cong_UNIV

       cspF_Alpha_parallel_cong

lemmas cspF_free_decompo_flag = cspF_free_mono_flag cspF_free_cong_flag

end


theory Impl_List_Playground_ChairNetwork
imports "../TopoS_Impl"
begin

text{*An example of our chair network [simplified]*}

text{*Our access control view on the network*}
  definition ChairNetwork_empty :: "string list_graph" where
    "ChairNetwork_empty \<equiv> \<lparr> nodesL = [''WebSrv'', ''FilesSrv'', ''PrinterBW'',
                                ''PrinterColor'', ''Students'',
                                ''Employees'', ''EReachable'',
                                ''Internet''],
                      edgesL = [] \<rparr>"

  lemma "wf_list_graph ChairNetwork_empty" by eval

subsection{*Our security requirements*}
  subsubsection{*We have a server with confidential data*}
    definition ConfidentialChairData::"(string SecurityInvariant)" where
      "ConfidentialChairData \<equiv> new_configured_list_SecurityInvariant SINVAR_BLPtrusted_impl.SINVAR_LIB_BLPtrusted \<lparr>
          node_properties = [''FilesSrv'' \<mapsto> \<lparr> security_level = 1, trusted = False \<rparr>,
                             ''Employees'' \<mapsto> \<lparr> security_level = 0, trusted = True \<rparr>,
                             ''EReachable'' \<mapsto> \<lparr> security_level = 0, trusted = True \<rparr>]
          \<rparr> ''confidential data''"

  (*
  subsubsection{*We have a hierarchical printing policy*}
    definition "PrintingHierarchy_nodes=[''Employees''\<mapsto> DN (''ColorPrinting''--Leaf, 0),
                           ''PrinterColor''\<mapsto> DN (''ColorPrinting''--''Printer''--Leaf, 0),
                           ''Students''\<mapsto> DN (''ColorPrinting''--''BwPrinting''--Leaf, 0),
                           ''PrinterBW''\<mapsto> DN (''ColorPrinting''--''BwPrinting''--''Printer''--Leaf, 0)]"
    definition "PrintingHierarchy_tree=Department ''ColorPrinting'' [
              Department ''Printer'' [],
              Department ''BwPrinting'' [
                  Department ''Printer'' []]]"
    definition PrintingHierarchy::"string SecurityInvariant" where
      "PrintingHierarchy \<equiv> new_configured_list_SecurityInvariant SINVAR_DomainHierarchyNG_impl.SINVAR_LIB_DomainHierarchyNG \<lparr>
        node_properties = PrintingHierarchy_nodes
        \<rparr>"  *)
  subsubsection{* The color printer is only accessibly by employees, The black.white printer by employees and students*}
    definition "PrintingACL \<equiv> new_configured_list_SecurityInvariant SINVAR_LIB_CommunicationPartners \<lparr>
          node_properties = [''PrinterColor'' \<mapsto> Master [''Employees'', ''EReachable''],
                             ''PrinterBW'' \<mapsto> Master [''Employees'', ''EReachable'', ''Students''],
                             ''Employees'' \<mapsto> Care,
                             ''EReachable'' \<mapsto> Care,
                             ''Students'' \<mapsto> Care]
          \<rparr> ''printing ACL''"

  subsubsection{* Printers are information sinks *}
    definition "PrintingSink \<equiv> new_configured_list_SecurityInvariant SINVAR_LIB_Sink \<lparr>
          node_properties = [''PrinterColor'' \<mapsto> Sink,
                             ''PrinterBW'' \<mapsto> Sink]
          \<rparr> ''printing sink''"

  subsubsection{*Students may access each other but are not accessible from the outside*}
    definition "StudentSubnet \<equiv> new_configured_list_SecurityInvariant SINVAR_LIB_SubnetsInGW \<lparr>
          node_properties = [''Students'' \<mapsto> Member, ''Employees'' \<mapsto> Member, ''EReachable'' \<mapsto> InboundGateway]
          \<rparr> ''student subnet''"

  subsubsection{* The files server is only accessibly by employees*}
    definition "FilesSrvACL \<equiv> new_configured_list_SecurityInvariant SINVAR_LIB_CommunicationPartners \<lparr>
          node_properties = [''FilesSrv'' \<mapsto> Master [''Employees'', ''EReachable''],
                             ''Employees'' \<mapsto> Care,
                             ''EReachable'' \<mapsto> Care]
          \<rparr> ''file srv acl''"

  subsubsection{*emplyees are reachable from the Internet*}
    (*nothing to do here*)

lemma "implc_sinvar ConfidentialChairData ChairNetwork_empty" by eval
lemma "implc_sinvar PrintingACL ChairNetwork_empty" by eval
lemma "implc_sinvar PrintingSink ChairNetwork_empty" by eval
lemma "implc_sinvar StudentSubnet ChairNetwork_empty" by eval
lemma "implc_sinvar FilesSrvACL ChairNetwork_empty" by eval

definition "ChairSecurityRequirements = [ConfidentialChairData, PrintingACL, PrintingSink, StudentSubnet, FilesSrvACL]"

value "implc_get_offending_flows ChairSecurityRequirements ChairNetwork_empty"
value "generate_valid_topology ChairSecurityRequirements ChairNetwork_empty"

value "List.product (nodesL ChairNetwork_empty) (nodesL ChairNetwork_empty)"

definition "ChairNetwork = generate_valid_topology ChairSecurityRequirements
      \<lparr>nodesL = nodesL ChairNetwork_empty, edgesL = List.product (nodesL ChairNetwork_empty) (nodesL ChairNetwork_empty) \<rparr>"

lemma "all_security_requirements_fulfilled ChairSecurityRequirements ChairNetwork" by eval

value "ChairNetwork"

ML_val{*
visualize_graph @{context} @{term "ChairSecurityRequirements"} @{term "ChairNetwork"};
*}

end


           (*-------------------------------------------*
            |        CSP-Prover on Isabelle2004         |
            |               November 2004               |
            |                   July 2005  (modified)   |
            |                                           |
            |        CSP-Prover on Isabelle2005         |
            |                October 2005  (modified)   |
            |                  April 2006  (modified)   |
            |                                           |
            |        CSP-Prover on Isabelle2009         |
            |                   June 2009  (modified)   |
            |                                           |
            |        CSP-Prover on Isabelle2016         |
            |                    May 2016  (modified)   |
            |                                           |
            |        Yoshinao Isobe (AIST JAPAN)        |
            *-------------------------------------------*)

theory Trace_hide
imports Prefix
begin

(*  The following simplification rules are deleted in this theory file *)
(*  because they unexpectly rewrite (notick | t = <>)                  *)
(*                                                                     *)
(*                  disj_not1: (~ P | Q) = (P --> Q)                   *)

declare disj_not1 [simp del]

(*****************************************************************

         1.
         2.
         3.
         4.

 *****************************************************************)

(* Isablle 2005

consts
  hidex :: "'a set => ('a trace * 'a trace) set"

inductive "hidex X"
intros
hidex_nil:
  "(<>, <>) : hidex X"

hidex_Tick:
  "(<Tick>, <Tick>) : hidex X"

hidex_in:
  "[| (s, t) : hidex X ; a : X |]
   ==> (<Ev a> ^^^ s, t) : hidex X"

hidex_notin:
  "[| (s, t) : hidex X ; a ~: X |]
   ==> (<Ev a> ^^^ s, <Ev a> ^^^ t) : hidex X"
*)

inductive_set
  hidex :: "'a set => ('a trace * 'a trace) set"
  for X :: "'a set"

where
hidex_nil:
  "(<>, <>) : hidex X" |

hidex_Tick:
  "(<Tick>, <Tick>) : hidex X" |

hidex_in:
  "[| (s, t) : hidex X ; a : X |]
   ==> (<Ev a> ^^^ s, t) : hidex X" |

hidex_notin:
  "[| (s, t) : hidex X ; a ~: X |]
   ==> (<Ev a> ^^^ s, <Ev a> ^^^ t) : hidex X"

definition
  hide_tr :: "'a trace => 'a set => 'a trace"  ("_ --tr _" [84,85] 84)
  where
  hide_tr_def :
    "s --tr X == THE t. (s, t) : hidex X"

definition
  rest_tr :: "'a trace => 'a set => 'a trace"  ("_ rest-tr _" [84,85] 84)
  where
  rest_tr_def :
    "s rest-tr X == s --tr (- X)"

(*************************************************************
                       THE hidex
 *************************************************************)

(*** exists ***)

lemma hidex_exists_lm:
  "ALL X s. (EX t. (s, t) : hidex X)"
apply (rule allI)
apply (rule allI)
apply (induct_tac s rule: induct_trace)

apply (simp_all)
apply (rule_tac x="<>" in exI, simp add: hidex.intros)
apply (rule_tac x="<Tick>" in exI, simp add: hidex.intros)

apply (elim exE)
apply (case_tac "a : X")
apply (rule_tac x="t" in exI, simp add: hidex.intros)
apply (rule_tac x="<Ev a> ^^^ t" in exI, simp add: hidex.intros)
done

(*** exists !! ***)

lemma hidex_exists:
  "EX t. (s, t) : hidex X"
by (simp add: hidex_exists_lm)

(*** unique ***)

lemma hidex_unique_lm:
  "ALL X s t u. ((s, t) : hidex X & (s, u) : hidex X)
    --> t = u"
apply (rule allI)
apply (rule allI)
apply (induct_tac s rule: induct_trace)

(* <> *)
apply (intro allI impI)
apply (erule conjE)
apply (erule hidex.cases, simp_all)    (* hidex.elims --2007--> hidex.cases *)
apply (erule hidex.cases, simp_all)

(* <Tick> *)
apply (intro allI impI)
apply (erule conjE)
apply (erule hidex.cases, simp_all)    (* hidex.elims --2007--> hidex.cases *)
apply (erule hidex.cases, simp_all)

(* step *)
apply (intro allI impI)
apply (erule conjE)
apply (case_tac "a : X")
 apply (erule hidex.cases, simp_all)+    (* hidex.elims --2007--> hidex.cases *)
done

lemma hidex_unique:
  "[| (s, t) : hidex X ; (s, u) : hidex X |]
   ==> t = u"
apply (insert hidex_unique_lm)
apply (drule_tac x="X" in spec)
apply (drule_tac x="s" in spec)
apply (drule_tac x="t" in spec)
apply (drule_tac x="u" in spec)
apply (simp)
done

(*************************************************************
                       THE hidex
 *************************************************************)

lemma hidex_to_hide_tr :
    "(s, t) : hidex X = (t = s --tr X)"
apply (simp add: hide_tr_def)
apply (rule iffI)
apply (rule sym)
apply (rule the_equality)
apply (simp)
apply (simp add: hidex_unique)

apply (simp)
apply (insert hidex_exists[of s X])
apply (erule exE)
apply (rule theI[of "(%x. (s, x) : hidex X)"])
apply (simp)
apply (simp add: hidex_unique)
done

lemma hide_tr_to_hidex :
    "(s --tr X = t) = ((s, t) : hidex X)"
apply (simp add: hidex_to_hide_tr)
by (fast)

lemma hide_tr_to_hidex_sym :
    "(t = s --tr X) = ((s, t) : hidex X)"
by (simp add: hidex_to_hide_tr)

lemmas hide_tr_iff = hide_tr_to_hidex hide_tr_to_hidex_sym

(*************************************************************
                         hide_tr
 *************************************************************)

(*------------------*
 |      intros      |
 *------------------*)

lemma hide_tr_nil[simp] : "<> --tr X = <>"
apply (simp add: hide_tr_to_hidex)
by (simp add: hidex.intros)

lemma hide_tr_Tick[simp] : "<Tick> --tr X = <Tick>"
apply (simp add: hide_tr_to_hidex)
by (simp add: hidex.intros)

lemma hide_tr_in_lm :
  "[| a : X ;  t = s --tr X |]
   ==> (<Ev a> ^^^ s) --tr X = t"
apply (simp add: hide_tr_to_hidex_sym)
apply (simp add: hide_tr_to_hidex)
apply (simp add: hidex.intros)
done

lemma hide_tr_in[simp] :
  "a : X ==> (<Ev a> ^^^ s) --tr X = s --tr X"
by (simp add: hide_tr_in_lm)

lemma hide_tr_in_one[simp] :
  "a : X ==> <Ev a> --tr X = <>"
apply (insert hide_tr_in[of a X "<>"])
by (simp)

lemma hide_tr_notin_lm :
  "[| a ~: X ;  t = s --tr X |]
   ==> (<Ev a> ^^^ s) --tr X = <Ev a> ^^^ t"
apply (simp add: hide_tr_to_hidex_sym)
apply (simp add: hide_tr_to_hidex)
apply (simp add: hidex.intros)
done

lemma hide_tr_notin_appt[simp] :
  "a ~: X ==> (<Ev a> ^^^ s) --tr X = <Ev a> ^^^ (s --tr X)"
by (simp add: hide_tr_notin_lm)

lemma hide_tr_notin[simp] :
  "a ~: X ==> <Ev a> --tr X = <Ev a>"
apply (insert hide_tr_notin_appt[of a X "<>"])
by (simp)

(*------------------*
 |      elims       |
 *------------------*)

lemma hide_tr_elims_lm:
  "[| s --tr X = t ;
      (( s = <> & t = <> ) --> P) ;
      (( s = <Tick> & t = <Tick> ) --> P) ;
      ( ALL a s'.
        ((s = <Ev a> ^^^ s' & s' --tr X = t & a : X )
         --> P)) ;
      ( ALL a s' t'.
        ((s = <Ev a> ^^^ s' & t = <Ev a> ^^^ t' & s' --tr X = t' & a ~: X )
         --> P)) |]
   ==> P"
apply (simp add: hide_tr_iff)
apply (erule hidex.cases)
by (auto)

lemma hide_tr_elims:
  "[| s --tr X = t;
      [| s = <> ; t = <> |] ==> P;
      [| s = <Tick> ; t = <Tick> |] ==> P;
   !!a s'.
      [| s = <Ev a> ^^^ s' ; s' --tr X = t; a : X |]
      ==> P;
   !!a s' t'.
      [| s = <Ev a> ^^^ s' ; t = <Ev a> ^^^ t' ; s' --tr X = t' ; a ~: X |]
      ==> P |]
   ==> P"
apply (rule hide_tr_elims_lm[of s X t])
apply (simp_all)
(* for Isabelel 2013
by (force)+
*)
done

(*************************************************************
        a new event is not introduced by HIDE (trace)
 *************************************************************)

lemma hide_tr_in_event[simp]:
  "e : sett (s --tr X) = (e ~: Ev ` X & e : sett s)"
apply (induct_tac s rule: induct_trace)
apply (simp)
apply (simp)
apply (force)

apply (simp)
apply (case_tac "a : X")
apply (simp)
apply (rule iffI, simp, force)
apply (rule iffI, force, force)
done

(*** notick ***)

lemma hide_tr_noTick[simp]: "noTick (s --tr X) = noTick s"
apply (simp add: noTick_def)
by (auto)

(*************************************************************
                  appended traces in hide
 *************************************************************)

lemma hide_tr_appt_noTick_lm:
  "ALL X s e t. noTick s --> ((s ^^^ t) --tr X = (s --tr X) ^^^ (t --tr X))"
apply (rule allI)
apply (rule allI)
apply (induct_tac s rule: induct_trace)
apply (simp_all)

apply (intro allI impI, simp)
apply (case_tac "a : X")
by (simp_all add: appt_assoc)

(*** simp ***)

lemma hide_tr_appt[simp]:
  "noTick s | t = <> ==> (s ^^^ t) --tr X = (s --tr X) ^^^ (t --tr X)"
apply (erule disjE)
apply (simp add: hide_tr_appt_noTick_lm)
by (simp)

(*************************************************************
                 decompose traces in hide
 *************************************************************)

lemma hide_tr_decompo_only_if_lm:
  "ALL X u s t.
      ((noTick s | t = <>) & u --tr X = s ^^^ t)
      --> (EX s' t'. (noTick s' | t' = <>) &
                     u = s' ^^^ t' &
                     s = s' --tr X & t = t' --tr X) "
apply (rule allI)
apply (rule allI)
apply (induct_tac u rule: induct_trace)
apply (intro allI impI)
apply (rule_tac x="<>" in exI)
apply (rule_tac x="<>" in exI)
apply (force)

apply (intro allI impI)
apply (elim conjE disjE)
apply (simp)
apply (elim conjE disjE)
apply (rule_tac x="<Tick>" in exI)
apply (rule_tac x="<>" in exI)
apply (simp)
apply (rule_tac x="<>" in exI)
apply (rule_tac x="<Tick>" in exI)
apply (simp)
apply (rule_tac x="<Tick>" in exI)
apply (rule_tac x="<>" in exI)
apply (drule sym)
apply (simp)

apply (intro allI impI)
apply (erule conjE)
apply (erule hide_tr_elims)
apply (simp_all)

 (* a : X *)
 apply (drule_tac x="sa" in spec)
 apply (drule_tac x="t" in spec)
 apply (simp)
 apply (elim conjE exE)
 apply (simp)

 apply (rule_tac x="<Ev aa> ^^^ s'a" in exI)
 apply (rule_tac x="t'" in exI)
 apply (erule disjE)
 apply (simp add: appt_assoc)
 apply (erule disjE)
 apply (simp add: appt_assoc)
 apply (simp)

 (* a ~: X *)
 apply (insert trace_nil_or_Tick_or_Ev)
 apply (rotate_tac -1)
 apply (drule_tac x="sa" in spec)
 apply (rotate_tac -1)

  (* <> *)
  apply (erule disjE)
  apply (rule_tac x="<>" in exI, simp)

  (* <Tick> *)
  apply (rotate_tac -1)
  apply (erule disjE)
  apply (simp)

  (* <Ev a> ^^^ ... *)
  apply (elim exE)
  apply (simp add: appt_assoc)

  apply (drule_tac x="sb" in spec)
  apply (drule_tac x="t" in spec)
  apply (simp)
  apply (elim conjE exE)

  apply (rule_tac x="<Ev aa> ^^^ s'a" in exI)
  apply (rule_tac x="t'a" in exI)
  apply (simp add: appt_assoc)
done

lemma hide_tr_decompo_only_if:
  "[| noTick s | t = <> ; u --tr X = s ^^^ t |]
   ==> (EX s' t'. (noTick s' | t' = <>) &
                  u = s' ^^^ t' &
                  s = s' --tr X & t = t' --tr X)"
by (simp add: hide_tr_decompo_only_if_lm)

(* if *)

lemma hide_tr_decompo_if:
  "[| noTick s | t = <> ;
      (EX s' t'. (noTick s' | t' = <>) &
                  u = s' ^^^ t' &
                  s = s' --tr X & t = t' --tr X) |]
   ==> u --tr X = s ^^^ t"
apply (elim conjE exE)
by (simp)

(*** iff ***)

lemma hide_tr_decompo:
  "noTick s | t = <>
   ==> u --tr X = s ^^^ t
    = (EX s' t'. (noTick s' | t' = <>) &
                  u = s' ^^^ t' &
                  s = s' --tr X & t = t' --tr X)"
apply (rule iffI)
apply (simp add: hide_tr_decompo_only_if)
apply (rule hide_tr_decompo_if)
by (simp_all)

(*************************************************************
                  hide trace prefix_closed
 *************************************************************)

lemma hide_tr_prefix_only_if_lm:
 "ALL X s u. (prefix u (s --tr X))
    --> (EX t. u = t --tr X & prefix t s)"
apply (rule allI)
apply (rule allI)
apply (induct_tac s rule: induct_trace)
apply (simp_all)

(* Tick *)
apply (force)

(* <Ev a> ^^^ ... *)
apply (intro allI impI)

 apply (case_tac "a : X")
 apply (drule_tac x="u" in spec, simp)
 apply (elim conjE exE)
 apply (rule_tac x="<Ev a> ^^^ t" in exI, simp)

 (* a ~: X *)
 apply (simp)

  (* u = <> *)
  apply (erule disjE)
  apply (drule_tac x="<>" in spec)
  apply (simp)
  apply (elim conjE exE)
  apply (rule_tac x="<>" in exI)
  apply (simp)

  (* u = <Ev a> ^^^ ... *)
  apply (elim conjE exE)
  apply (drule_tac x="v'" in spec, simp)
  apply (elim conjE exE)
  apply (rule_tac x="<Ev a> ^^^ t" in exI, simp)
done

lemma hide_tr_prefix_only_if:
 "prefix u (s --tr X) ==> (EX t. u = t --tr X & prefix t s)"
by (simp add: hide_tr_prefix_only_if_lm)

(*** if ***)

lemma hide_tr_prefix_if:
 "prefix t s ==> prefix (t --tr X) (s --tr X)"
apply (simp add: prefix_def)
apply (erule exE)
apply (simp)
apply (rule_tac x="u --tr X" in exI)
by (auto)

lemma hide_tr_prefix:
 "prefix u (s --tr X) = (EX t. u = t --tr X & prefix t s)"
apply (rule iffI)
apply (simp add: hide_tr_prefix_only_if)
apply (erule exE)
by (simp add: hide_tr_prefix_if)

(*************************************************************
                  hide + alpha lemma
 *************************************************************)

(* rev <> *)

(* only if *)

lemma hide_tr_nilt_sett_only_if_lm:
  "ALL s. s --tr X = <> --> (sett s <= Ev ` X)"
apply (rule allI)
apply (induct_tac s rule: induct_trace)
apply (simp_all)
apply (intro allI impI)
apply (elim conjE exE)
apply (case_tac "a : X")
by (simp_all)

lemma hide_tr_nilt_sett_only_if:
  "s --tr X = <> ==> (sett s <= Ev ` X)"
by (simp add: hide_tr_nilt_sett_only_if_lm)

(* if *)

lemma hide_tr_nilt_sett_if_lm:
  "ALL s. sett s <= Ev ` X --> s --tr X = <>"
apply (rule allI)
apply (induct_tac s rule: induct_trace)
apply (simp_all)
apply (force)
apply (intro allI impI)
apply (elim conjE)
apply (simp)
apply (case_tac "a : X")
by (auto)

lemma hide_tr_nilt_sett_if:
  "sett s <= Ev ` X ==> s --tr X = <>"
by (simp add: hide_tr_nilt_sett_if_lm)

(* iff *)

lemma hide_tr_nilt_sett:
  "(s --tr X = <>) = (sett s <= Ev ` X)"
apply (rule iffI)
apply (simp add: hide_tr_nilt_sett_only_if)
apply (simp add: hide_tr_nilt_sett_if)
done

(*** sett <= sett ***)

lemma hide_tr_sett_subseteq_sett:
  "X <= Y ==> sett (u --tr Y) <= sett (u --tr X)"
apply (induct_tac u rule: induct_trace)
apply (simp_all)
apply (case_tac "a : X")
apply (simp_all)
apply (case_tac "a ~: Y", fast)
apply (simp)

apply (case_tac "a : Y")
apply (auto)
done

(* rev <Tick> *)

(* only if *)

lemma hide_tr_Tick_sett_only_if_lm:
  "ALL s. s --tr X = <Tick>
    --> (EX s'. s = s' ^^^ <Tick> & sett s' <= Ev ` X & noTick s')"
apply (rule allI)
apply (induct_tac s rule: rev_induct_trace)
apply (simp_all)
apply (rule conjI)

 apply (force)

 apply (intro allI impI)
 apply (elim conjE exE)
 apply (rule_tac x="sa" in exI)
 apply (simp)
 apply (insert event_Tick_or_Ev)
 apply (drule_tac x="e" in spec)
 apply (erule disjE)
 apply (simp add: hide_tr_nilt_sett)

 apply (erule exE)
 apply (case_tac "a : X")
 apply (simp_all)
done

lemma hide_tr_Tick_sett_only_if:
  "s --tr X = <Tick>
    ==> (EX s'. s = s' ^^^ <Tick> & sett s' <= Ev ` X & noTick s')"
by (simp add: hide_tr_Tick_sett_only_if_lm)

(* if *)

lemma hide_tr_Tick_sett_if:
  "sett s <= Ev ` X ==> s --tr X = <>"
by (simp add: hide_tr_nilt_sett)

(* iff *)

lemma hide_tr_Tick_sett:
  "(s --tr X = <Tick>)
   = (EX s'. s = s' ^^^ <Tick> & sett s' <= Ev ` X & noTick s')"
apply (rule iffI)
apply (simp add: hide_tr_Tick_sett_only_if)
apply (elim conjE exE)
apply (simp add: hide_tr_Tick_sett_if)
done

(*--------------------------*
 |       commutativity      |
 *--------------------------*)

lemma hide_tr_commute:
  "(u --tr X) --tr Y = (u --tr Y) --tr X"
apply (induct_tac u rule: induct_trace)
apply (simp_all)
apply (case_tac "a:X")
 apply (case_tac "a:Y")
  apply (simp)
  apply (simp)
 apply (case_tac "a:Y")
  apply (simp)
  apply (simp)
done

(*--------------------------------*
 |   used in Inductive_parallel   |
 *--------------------------------*)

lemma hide_tr_of_hide_tr_subset1:
  "X <= Y ==> (u --tr X) --tr Y = u --tr Y"
apply (induct_tac u rule: induct_trace)
apply (simp_all)
apply (case_tac "a:X")
by (auto)

lemma hide_tr_of_hide_tr_subset2:
  "X <= Y ==> (u --tr Y) --tr X = u --tr Y"
apply (simp add: hide_tr_commute)
apply (simp add: hide_tr_of_hide_tr_subset1)
done

lemmas hide_tr_of_hide_tr_subset = hide_tr_of_hide_tr_subset1
                                   hide_tr_of_hide_tr_subset2

lemma hide_tr_UNIV_lm:
  "((u --tr UNIV = <>) | (u --tr UNIV = <Tick>))"
apply (induct_tac u rule: induct_trace)
by (simp_all)

lemma hide_tr_UNIV:
  "((u --tr UNIV = <>) | (u --tr UNIV = <Tick>))"
by (simp add: hide_tr_UNIV_lm)

(*======================================================*
 |                                                      |
 |                        rest-tr                       |
 |                                                      |
 *======================================================*)

(*------------------*
 |      intros      |
 *------------------*)

lemma rest_tr_nil[simp] : "<> rest-tr X = <>"
by (simp add: rest_tr_def)

lemma rest_tr_Tick[simp] : "<Tick> rest-tr X = <Tick>"
by (simp add: rest_tr_def)

lemma rest_tr_notin[simp] :
  "a ~: X ==> (<Ev a> ^^^ s) rest-tr X = s rest-tr X"
by (simp add: rest_tr_def)

lemma rest_tr_notin_one[simp] :
  "a ~: X ==> <Ev a> rest-tr X = <>"
by (simp add: rest_tr_def)

lemma rest_tr_in_appt[simp] :
  "a : X ==> (<Ev a> ^^^ s) rest-tr X = <Ev a> ^^^ (s rest-tr X)"
by (simp add: rest_tr_def)

lemma rest_tr_in[simp] :
  "a : X ==> <Ev a> rest-tr X = <Ev a>"
by (simp add: rest_tr_def)

(*------------------*
 |      elims       |
 *------------------*)

lemma rest_tr_elims:
  "[| s rest-tr X = t;
      [| s = <> ; t = <> |] ==> P;
      [| s = <Tick> ; t = <Tick> |] ==> P;
   !!a s'.
      [| s = <Ev a> ^^^ s' ; s' rest-tr X = t; a ~: X |]
      ==> P;
   !!a s' t'.
      [| s = <Ev a> ^^^ s' ; t = <Ev a> ^^^ t' ; s' rest-tr X = t' ; a : X |]
      ==> P |]
   ==> P"
apply (simp add: rest_tr_def)
apply (erule hide_tr_elims)
apply (simp)
apply (simp)
apply (blast)
apply (blast)
done

(*************************************************************
        a new event is not introduced by rest (trace)
 *************************************************************)

lemma rest_tr_in_event[simp]:
  "e : sett (s rest-tr X) = ((e : Ev ` X | e = Tick) & e : sett s)"
apply (simp add: rest_tr_def)
apply (insert event_Tick_or_Ev)
apply (drule_tac x="e" in spec)
apply (auto)
done

lemma rest_tr_subset_event[simp]:
  "sett (s rest-tr X) <= insert Tick (Ev ` X)"
apply (auto)
done
(*** notick ***)

lemma rest_tr_noTick[simp]: "noTick (s rest-tr X) = noTick s"
by (simp add: noTick_def)

(*************************************************************
                  appended traces in rest
 *************************************************************)

lemma rest_tr_appt[simp]:
  "noTick s | t = <> ==> (s ^^^ t) rest-tr X = (s rest-tr X) ^^^ (t rest-tr X)"
apply (simp add: rest_tr_def)
done

(*************************************************************
                 decompose traces in rest
 *************************************************************)

lemma rest_tr_decompo:
  "noTick s | t = <>
   ==> u rest-tr X = s ^^^ t
    = (EX s' t'. (noTick s' | t' = <>) &
                  u = s' ^^^ t' &
                  s = s' rest-tr X & t = t' rest-tr X)"
apply (simp add: rest_tr_def)
apply (simp add: hide_tr_decompo)
done

(*************************************************************
                  rest trace prefix_closed
 *************************************************************)

lemma rest_tr_prefix:
 "prefix u (s rest-tr X) = (EX t. u = t rest-tr X & prefix t s)"
apply (simp add: rest_tr_def)
apply (simp add: hide_tr_prefix)
done

(*************************************************************
                  rest + alpha lemma
 *************************************************************)

(* rev <> *)

lemma rest_tr_nilt_sett:
  "(s rest-tr X = <>) = (sett s Int (insert Tick (Ev ` X)) = {})"
apply (simp add: rest_tr_def)
apply (simp add: hide_tr_nilt_sett)
apply (auto)
apply (insert event_Tick_or_Ev)
apply (drule_tac x="x" in spec)
apply (auto)
done

(*** sett <= sett ***)

lemma rest_tr_sett_subseteq_sett:
  "X <= Y ==> sett (u rest-tr X) <= sett (u rest-tr Y)"
apply (simp add: rest_tr_def)
by (simp add: hide_tr_sett_subseteq_sett)

(* rev <Tick> *)

lemma rest_tr_Tick_sett:
  "(s rest-tr X = <Tick>)
   = (EX s'. s = s' ^^^ <Tick> & (sett s' Int (Ev ` X) = {})
      & noTick s')"
apply (simp add: rest_tr_def)
apply (simp add: hide_tr_Tick_sett)
apply (auto)
apply (rule_tac x="s'" in exI)
apply (auto)
apply (insert event_Tick_or_Ev)
apply (drule_tac x="x" in spec)
apply (auto simp add: noTick_def)
done

(*--------------------------*
 |       commutativity      |
 *--------------------------*)

lemma rest_tr_commute:
  "(u rest-tr X) rest-tr Y = (u rest-tr Y) rest-tr X"
apply (simp add: rest_tr_def)
apply (simp add: hide_tr_commute)
done

(*--------------------------------*
 |   used in Inductive_parallel   |
 *--------------------------------*)

lemma rest_tr_of_rest_tr_subset1:
  "X <= Y ==> (u rest-tr X) rest-tr Y = u rest-tr X"
apply (simp add: rest_tr_def)
apply (rule hide_tr_of_hide_tr_subset)
by (auto)

lemma rest_tr_of_rest_tr_subset2:
  "X <= Y ==> (u rest-tr Y) rest-tr X = u rest-tr X"
apply (simp add: rest_tr_commute)
apply (simp add: rest_tr_of_rest_tr_subset1)
done

lemmas rest_tr_of_rest_tr_subset = rest_tr_of_rest_tr_subset1
                                   rest_tr_of_rest_tr_subset2

lemma rest_tr_empty:
  "((u rest-tr {} = <>) | (u rest-tr {} = <Tick>))"
apply (simp add: rest_tr_def)
apply (simp add: hide_tr_UNIV)
done

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

(*  rest_tr decompo *)

lemma Ev_rest_tr_decompo:
  "ALL s X a. (a : X &  s rest-tr X = <Ev a>) -->
   (EX s1 s2. s = s1 ^^^ <Ev a> ^^^ s2 & noTick s1 & noTick s2 &
    s1 rest-tr X = <> &
    s2 rest-tr X = <> )"
apply (rule)
apply (rule)
apply (induct_tac s rule: induct_trace)
apply (simp_all)
apply (intro allI impI)
apply (elim conjE disjE)
apply (simp)
apply (case_tac "a:X")
 apply (simp)
 apply (rule_tac x="<>" in exI)
 apply (rule_tac x="sa" in exI)
 apply (simp)
 apply (subgoal_tac "noTick(sa rest-tr X)")
 apply (simp (no_asm_use))
 apply (simp)
 apply (simp)

apply (simp)
apply (elim conjE exE)
apply (simp)
apply (rule_tac x="<Ev a> ^^^ s1" in exI)
apply (rule_tac x="s2" in exI)
apply (simp)
apply (simp add: appt_assoc)
done

(* --- hide_tr --- *)

lemma hide_tr_rest_tr_sett[rule_format]:
  "sett s <= insert Tick (Ev ` Y)
   --> ((s --tr X) = (s rest-tr (Y-X)))"
apply (induct_tac s rule: induct_trace)
apply (simp_all)
apply (intro impI)
apply (simp add: image_iff)
apply (case_tac "a:X")
apply (auto)
done

lemma hide_tr_id[rule_format]:
  "(sett s <= insert Tick (Ev ` Y) & X Int Y = {})
   --> ((s --tr X) = s)"
apply (induct_tac s rule: induct_trace)
apply (simp_all)
apply (intro impI)
apply (simp add: image_iff)
apply (case_tac "a:X")
apply (auto)
done

(* --------------------------------------------------- *
                   semantics for pipe
 * --------------------------------------------------- *)

(* hide & rest *)

lemma hide_tr_of_rest_tr_empty1:
  "X Int Y = {} ==> s --tr X rest-tr Y = s rest-tr Y"
apply (simp add: rest_tr_def)
apply (rule hide_tr_of_hide_tr_subset1)
apply (auto)
done

lemma hide_tr_of_rest_tr_empty2:
  "X Int Y = {} ==> s rest-tr X --tr Y = s rest-tr X"
apply (simp add: rest_tr_def)
apply (rule hide_tr_of_hide_tr_subset2)
apply (auto)
done

lemma noTick_hide_tr_of_rest_tr_empty:
  "[| noTick s ; X <= Y |] ==> s rest-tr X --tr Y = <>"
apply (rule hide_tr_Tick_sett_if)
apply (auto)
apply (simp add: image_iff)
apply (force)
apply (simp add: noTick_def)
done

lemma hide_tr_nohiden[rule_format]:
  "sett s Int Ev ` X = {} --> s --tr X = s"
apply (induct_tac s rule: induct_trace)
apply (simp)
apply (simp)
apply (intro allI impI)
apply (simp add: image_iff)
done

(****************** to add it again ******************)

declare disj_not1 [simp]

end


theory PF_Fixed_Action
  imports PF_Semantics_Ternary
          Iptables_Semantics.List_Misc
begin
(* adapted from Iptables_Semantics.Fixed_Action *)

section\<open>Fixed Action\<close>

text\<open>If firewall rules have the same action, we can focus on the matching only.\<close>

subsection\<open>@{term match_list}\<close>
  text\<open>Reducing the firewall semantics to short-circuit matching evaluation\<close>

  fun match_list :: "('a, 'packet) match_tac \<Rightarrow> 'a match_expr list \<Rightarrow> action \<Rightarrow> decision \<Rightarrow> 'packet \<Rightarrow> bool" where
   "match_list \<gamma> [] a d p = False" |
   "match_list \<gamma> (m#ms) a d p = (if matches \<gamma> m a d p then True else match_list \<gamma> ms a d p)"

  lemma match_list_matches: "match_list \<gamma> ms a d p \<longleftrightarrow> (\<exists>m \<in> set ms. matches \<gamma> m a d p)"
    by(induction ms, simp_all)

lemma match_list_False: "\<not>match_list \<gamma> ms a (unwrap_decision d) p \<Longrightarrow> filter_approx' (map (\<lambda>m. PfRule \<lparr>get_action = a, get_quick = False, pf_rule.get_match = m\<rparr>) ms) \<gamma> p d =
 d"
proof(induction ms)
  case Nil
  then show ?case by (cases d;simp)
next
  case (Cons a ms)
  then show ?case by (cases d;auto)
qed

lemma match_list_True: "match_list \<gamma> ms a d p \<Longrightarrow> filter_approx' (map (\<lambda>m. PfRule \<lparr>get_action = a, get_quick = False, pf_rule.get_match = m\<rparr>) ms) \<gamma> p (Preliminary d) =
 (case a of Pass \<Rightarrow> (Preliminary decision.Accept) | Block \<Rightarrow> (Preliminary decision.Reject) | ActionMatch \<Rightarrow> (Preliminary d))"
proof(induction ms arbitrary:d)
case Nil
  then show ?case by simp
next
  case *:(Cons m ms)
  then show ?case
  proof(cases "matches \<gamma> m a d p")
    case True
    then show ?thesis
    proof(cases "match_list \<gamma> ms a (action_to_decision a d) p")
      case True
      then show ?thesis using * apply(cases a) by auto
    next
      case False
      then show ?thesis using * match_list_False[of \<gamma> ms a "(Preliminary (action_to_decision a d))" p] apply(cases a) by auto
    qed
  next
    case False
    then show ?thesis using * by simp
  qed
qed

  text\<open>The key idea behind @{const match_list}: Reducing semantics to match list\<close>
lemma match_list_semantics:
  assumes match_list:"match_list \<gamma> ms1 a (unwrap_decision d) p \<longleftrightarrow> match_list \<gamma> ms2 a (unwrap_decision d) p"
    shows "filter_approx' (map (\<lambda>m. (PfRule \<lparr>get_action = a, get_quick = False, pf_rule.get_match = m\<rparr>)) ms1) \<gamma> p d = filter_approx' (map (\<lambda>m. (PfRule \<lparr>get_action = a, get_quick = False, pf_rule.get_match = m\<rparr>)) ms2) \<gamma> p d"
proof(cases "match_list \<gamma> ms1 a (unwrap_decision d) p")
    case m1T:True
    then have m2T:"match_list \<gamma> ms2 a (unwrap_decision d) p" using match_list by auto
    show ?thesis using m1T m2T by (cases a;cases d;auto simp add: match_list_True unwrap_decision_cases)
  next
    case m1F:False
    then have m2F:"\<not>match_list \<gamma> ms2 a (unwrap_decision d) p" using match_list by auto
    show ?thesis using m1F m2F by (cases a;cases d;auto simp add: match_list_False unwrap_decision_cases)
  qed

  text\<open>We can exploit de-morgan to get a disjunction in the match expression!\<close>
  (*but we need to normalize afterwards, which is quite slow*)
  fun match_list_to_match_expr :: "'a match_expr list \<Rightarrow> 'a match_expr" where
    "match_list_to_match_expr [] = MatchNot MatchAny" |
    "match_list_to_match_expr (m#ms) = MatchOr m (match_list_to_match_expr ms)"
  text\<open>@{const match_list_to_match_expr} constructs a unwieldy @{typ "'a match_expr"} from a list.
        The semantics of the resulting match expression is the disjunction of the elements of the list.
        This is handy because the normal match expressions do not directly support disjunction.
        Use this function with care because the resulting match expression is very ugly!\<close>
  lemma match_list_to_match_expr_disjunction: "match_list \<gamma> ms a d p \<longleftrightarrow> matches \<gamma> (match_list_to_match_expr ms) a d p"
    apply(induction ms rule: match_list_to_match_expr.induct)
     apply(simp add: bunch_of_lemmata_about_matches; fail)
    apply(simp add: MatchOr)
  done

  lemma match_list_singleton: "match_list \<gamma> [m] a d p \<longleftrightarrow> matches \<gamma> m a d p" by(simp)

  lemma match_list_append: "match_list \<gamma> (m1@m2) a d p \<longleftrightarrow> (\<not> match_list \<gamma> m1 a d p \<longrightarrow> match_list \<gamma> m2 a d p)"
      by(induction m1) simp+

  lemma match_list_helper1: "\<not> matches \<gamma> m2 a d p \<Longrightarrow> match_list \<gamma> (map (\<lambda>x. MatchAnd x m2) m1') a d p \<Longrightarrow> False"
    apply(induction m1')
     apply(simp; fail)
    apply(simp split:if_split_asm)
    by(auto dest: matches_dest)
  lemma match_list_helper2: " \<not> matches \<gamma> m a d p \<Longrightarrow> \<not> match_list \<gamma> (map (MatchAnd m) m2') a d p"
    apply(induction m2')
     apply(simp; fail)
    apply(simp split:if_split_asm)
    by(auto dest: matches_dest)
  lemma match_list_helper3: "matches \<gamma> m a d p \<Longrightarrow> match_list \<gamma> m2' a d p \<Longrightarrow> match_list \<gamma> (map (MatchAnd m) m2') a d p"
    apply(induction m2')
     apply(simp; fail)
    apply(simp split:if_split_asm)
    by (simp add: matches_simps)
  lemma match_list_helper4: "\<not> match_list \<gamma> m2' a d p \<Longrightarrow> \<not> match_list \<gamma> (map (MatchAnd aa) m2') a d p "
    apply(induction m2')
     apply(simp; fail)
    apply(simp split:if_split_asm)
    by(auto dest: matches_dest)
  lemma match_list_helper5: " \<not> match_list \<gamma> m2' a d p \<Longrightarrow> \<not> match_list \<gamma> (concat (map (\<lambda>x. map (MatchAnd x) m2') m1')) a d p "
    apply(induction m2')
     apply(simp add:empty_concat; fail)
    apply(simp split:if_split_asm)
    apply(induction m1')
     apply(simp; fail)
    apply(simp add: match_list_append)
    by(auto dest: matches_dest)
  lemma match_list_helper6: "\<not> match_list \<gamma> m1' a d p \<Longrightarrow> \<not> match_list \<gamma> (concat (map (\<lambda>x. map (MatchAnd x) m2') m1')) a d p "
    apply(induction m2')
     apply(simp add:empty_concat; fail)
    apply(simp split:if_split_asm)
    apply(induction m1')
     apply(simp; fail)
    apply(simp add: match_list_append split: if_split_asm)
    by(auto dest: matches_dest)

  lemmas match_list_helper = match_list_helper1 match_list_helper2 match_list_helper3 match_list_helper4 match_list_helper5 match_list_helper6
  hide_fact match_list_helper1 match_list_helper2 match_list_helper3 match_list_helper4 match_list_helper5 match_list_helper6

  lemma match_list_map_And1: "matches \<gamma> m1 a d p = match_list \<gamma> m1' a d p \<Longrightarrow>
           matches \<gamma> (MatchAnd m1 m2) a d p \<longleftrightarrow> match_list \<gamma>  (map (\<lambda>x. MatchAnd x m2) m1') a d p"
    apply(induction m1')
     apply(auto dest: matches_dest; fail)[1]
    apply(simp split: if_split_asm)
     apply safe
        apply(simp_all add: matches_simps)
      apply(auto dest: match_list_helper(1))[1]
     by(auto dest: matches_dest)

  lemma matches_list_And_concat: "matches \<gamma> m1 a d p = match_list \<gamma> m1' a d p \<Longrightarrow> matches \<gamma> m2 a d p = match_list \<gamma> m2' a d p \<Longrightarrow>
           matches \<gamma> (MatchAnd m1 m2) a d p \<longleftrightarrow> match_list \<gamma> [MatchAnd x y. x <- m1', y <- m2'] a d p"
    apply(induction m1')
     apply(auto dest: matches_dest; fail)[1]
    apply(simp split: if_split_asm)
     prefer 2
     apply(simp add: match_list_append)
     apply(subgoal_tac "\<not> match_list \<gamma> (map (MatchAnd aa) m2') a d p")
      apply(simp; fail)
     apply safe
               apply(simp_all add: matches_simps match_list_append match_list_helper)
    done

  lemma match_list_concat: "match_list \<gamma> (concat lss) a d p \<longleftrightarrow> (\<exists>ls \<in> set lss. match_list \<gamma> ls a d p)"
    apply(induction lss)
     apply(simp; fail)
    by(auto simp add: match_list_append)

end