(******************************************************************************)
(* Project: The Isabelle/UTP Proof System                                     *)
(* File: Railways_Impl.thy                                                    *)
(* Authors: Frank Zeyda and Simon Foster (University of York, UK)             *)
(* Emails: frank.zeyda@york.ac.uk and simon.foster@york.ac.uk                 *)
(******************************************************************************)
(* LAST REVIEWED: 22 Sep 2017 *)

section {* Railways Implementation *}

theory Railways_Impl
imports Railways_Spec
begin

subsection {* Interlocking FMU *}

subsubsection {* Initialisation *}

definition init_ilock :: "railways_state hrel" where [urel_defs]:
"init_ilock =
  (cdv, tc, relays, signals, switches) := (
    mk_vector\<^sub>u 11 true,
    mk_vector\<^sub>u 4 false,
    mk_vector\<^sub>u 5 false,
    mk_vector\<^sub>u 3 false,
    mk_vector\<^sub>u 5 \<guillemotleft>STRAIGHT\<guillemotright>)"

subsubsection {* Cyclic Behaviour *}

paragraph {* Relay Setting *}

definition set_relays :: "railways_state hrel" where
[urel_defs]: "set_relays =
  ((relays[1] := true) \<triangleleft> TC[4] \<and> \<not> TC[3] \<and> \<not> R2 \<and> \<not> R4 \<and> (*\<not> CDV[3] \<and>*) CDV[4] \<and> CDV[5] \<triangleright>\<^sub>r II) ;;
  ((relays[2] := true) \<triangleleft> TC[3] \<and> \<not> TC[4] \<and> \<not> R1 \<and> \<not> R3 \<and> \<not> R4 \<and> \<not> R5 \<and> (*\<not> CDV[3] \<and>*) CDV[4] \<and> CDV[8] \<and> CDV[9] \<and> CDV[10] \<and> CDV[1] \<triangleright>\<^sub>r II) ;;
  ((relays[4] := true) \<triangleleft> TC[3] \<and> \<not> TC[4] \<and> \<not> R1 \<and> \<not> R2 \<and> \<not> R3 \<and> \<not> R5 \<and> (*\<not> CDV[3] \<and>*) CDV[4] \<and> CDV[8] \<and> CDV[9] \<and> CDV[11] \<and> CDV[2] \<triangleright>\<^sub>r II) ;;
  ((relays[3] := true) \<triangleleft> TC[1] \<and> \<not> R2 \<and> \<not> R4 \<and> \<not> R5 \<and> (*\<not> CDV[1] \<and>*) CDV[10] \<and> CDV[9] \<and> CDV[8] \<and> CDV[7] \<and> CDV[6] \<triangleright>\<^sub>r II) ;;
  ((relays[5] := true) \<triangleleft> TC[2] \<and> \<not> R2 \<and> \<not> R3 \<and> \<not> R4 \<and> (*\<not> CDV[2] \<and>*) CDV[11] \<and> CDV[9] \<and> CDV[8] \<and> CDV[7] \<and> CDV[6] \<triangleright>\<^sub>r II)"

paragraph {* Relay Clearing *}

definition clear_relays :: "railways_state hrel" where
[urel_defs]: "clear_relays =
  ((relays[1] := false) \<triangleleft> R1 \<and> \<not> CDV[5] \<triangleright>\<^sub>r II) ;;
  ((relays[2] := false) \<triangleleft> R2 \<and> \<not> CDV[1] \<triangleright>\<^sub>r II) ;;
  ((relays[3] := false) \<triangleleft> R3 \<and> \<not> CDV[6] \<triangleright>\<^sub>r II) ;;
  ((relays[4] := false) \<triangleleft> R4 \<and> \<not> CDV[2] \<triangleright>\<^sub>r II) ;;
  ((relays[5] := false) \<triangleleft> R5 \<and> \<not> CDV[6] \<triangleright>\<^sub>r II)"

paragraph {* Switch Setting *}

definition set_switches :: "railways_state hrel" where
[urel_defs]: "set_switches = (
  (switches[1] := \<guillemotleft>STRAIGHT\<guillemotright>) ;;
  ((switches[2] := \<guillemotleft>STRAIGHT\<guillemotright>) \<triangleleft> R3 \<or> R5 \<triangleright>\<^sub>r (switches[2] := \<guillemotleft>DIVERGING\<guillemotright>)) ;;
  ((switches[3] := \<guillemotleft>STRAIGHT\<guillemotright>) \<triangleleft> R1 \<triangleright>\<^sub>r (switches[3] := \<guillemotleft>DIVERGING\<guillemotright>)) ;;
  (switches[4] := \<guillemotleft>STRAIGHT\<guillemotright>) ;;
  ((switches[5] := \<guillemotleft>STRAIGHT\<guillemotright>) \<triangleleft> R2 \<or> R3 \<triangleright>\<^sub>r (switches[5] := \<guillemotleft>DIVERGING\<guillemotright>)))"

subsubsection {* Signal Setting *}

definition set_signals :: "railways_state hrel" where
[urel_defs]: "set_signals = (
  (signals[1] := (R3 \<and> SW5 =\<^sub>u \<guillemotleft>STRAIGHT\<guillemotright> \<and> SW2 =\<^sub>u \<guillemotleft>STRAIGHT\<guillemotright> \<and> SW4 =\<^sub>u \<guillemotleft>STRAIGHT\<guillemotright>)) ;;
  (signals[2] := (R5 \<and> SW5 =\<^sub>u \<guillemotleft>DIVERGING\<guillemotright> \<and> SW2 =\<^sub>u \<guillemotleft>STRAIGHT\<guillemotright> \<and> SW4 =\<^sub>u \<guillemotleft>STRAIGHT\<guillemotright>)) ;;
  (signals[3] := ((R1 \<and> SW1 =\<^sub>u \<guillemotleft>STRAIGHT\<guillemotright> \<and> SW3 =\<^sub>u \<guillemotleft>STRAIGHT\<guillemotright>) \<or>
    (R2 \<and> SW1 =\<^sub>u \<guillemotleft>STRAIGHT\<guillemotright> \<and> SW3 =\<^sub>u \<guillemotleft>DIVERGING\<guillemotright> \<and> SW2 =\<^sub>u \<guillemotleft>DIVERGING\<guillemotright> \<and> SW5 =\<^sub>u \<guillemotleft>STRAIGHT\<guillemotright>) \<or>
    (R4 \<and> SW1 =\<^sub>u \<guillemotleft>STRAIGHT\<guillemotright> \<and> SW3 =\<^sub>u \<guillemotleft>DIVERGING\<guillemotright> \<and> SW2 =\<^sub>u \<guillemotleft>DIVERGING\<guillemotright> \<and> SW5 =\<^sub>u \<guillemotleft>DIVERGING\<guillemotright>))))"

paragraph {* Complete Cycle *}

definition ilock_cycle :: "railways_state hrel" where [urel_defs]:
"ilock_cycle = (set_relays ;; clear_relays ;; set_switches ;; set_signals)"

subsubsection {* Invariant Proofs *}

paragraph {* Proof Support *}

lemma relays_excl_inv_extr:
"`relays_excl_inv \<and> P \<Rightarrow> Q` = `relays_excl_inv \<Rightarrow> P \<Rightarrow> Q`"
  by (simp add: impl_alt_def utp_pred_laws.sup.assoc)

text {* Do \<open>,\<close>  and \<open>;\<close> have the same precedence? Are they right-associative? *}

method ilock_relays_excl_inv_tac =
  (hoare_split_inv; (
    (unfold relays_excl_inv_extr)?,
    (unfold relays_excl_inv_cases),
    (rel_simp);
    (unfold valid_relay_states_def),
    (safe; simp)))

paragraph {* Invariant Preservation *}

lemma init_ilock_relays_excl_inv:
"\<lbrace>true\<rbrace>init_ilock\<lbrace>relays_excl_inv\<rbrace>\<^sub>u"
  unfolding init_ilock_def by (rel_simp)

lemma set_relays_relays_excl_inv:
"\<lbrace>relays_excl_inv\<rbrace>set_relays\<lbrace>relays_excl_inv\<rbrace>\<^sub>u"
  unfolding set_relays_def by (ilock_relays_excl_inv_tac)

lemma clear_relays_relays_excl_inv:
"\<lbrace>relays_excl_inv\<rbrace>clear_relays\<lbrace>relays_excl_inv\<rbrace>\<^sub>u"
  unfolding clear_relays_def by (ilock_relays_excl_inv_tac)

lemma set_switches_relays_excl_inv:
"\<lbrace>relays_excl_inv\<rbrace>set_switches\<lbrace>relays_excl_inv\<rbrace>\<^sub>u"
  unfolding set_switches_def by (ilock_relays_excl_inv_tac)

lemma set_signals_relays_excl_inv:
"\<lbrace>relays_excl_inv\<rbrace>set_signals\<lbrace>relays_excl_inv\<rbrace>\<^sub>u"
  unfolding set_signals_def by (ilock_relays_excl_inv_tac)

lemma "\<lbrace>relays_excl_inv\<rbrace>ilock_cycle\<lbrace>relays_excl_inv\<rbrace>\<^sub>u"
apply (unfold ilock_cycle_def)
apply (hoare_split)
apply (rule set_relays_relays_excl_inv)
apply (rule clear_relays_relays_excl_inv)
apply (rule set_switches_relays_excl_inv)
apply (rule set_signals_relays_excl_inv)
done
end


(*  Title:      HOL/NanoJava/State.thy
    Author:     David von Oheimb
    Copyright   2001 Technische Universitaet Muenchen
*)

section "Program State"

theory State imports TypeRel begin

definition body :: "cname \<times> mname => stmt" where
 "body \<equiv> \<lambda>(C,m). bdy (the (method C m))"

text {* Locations, i.e.\ abstract references to objects *}
typedecl loc

datatype val
  = Null        --{* null reference *}
  | Addr loc    --{* address, i.e. location of object *}

type_synonym fields
        = "(fname \<rightharpoonup> val)"

type_synonym
        obj = "cname \<times> fields"

translations
  (type) "fields" \<leftharpoondown> (type) "fname => val option"
  (type) "obj"    \<leftharpoondown> (type) "cname \<times> fields"

definition init_vars :: "('a \<rightharpoonup> 'b) => ('a \<rightharpoonup> val)" where
 "init_vars m == map_option (\<lambda>T. Null) o m"

text {* private: *}
type_synonym heap = "loc   \<rightharpoonup> obj"
type_synonym locals = "vname \<rightharpoonup> val"

text {* private: *}
record  state
        = heap   :: heap
          locals :: locals

translations
  (type) "heap" \<leftharpoondown> (type) "loc => obj option"
  (type) "locals" \<leftharpoondown> (type) "vname => val option"
  (type) "state" \<leftharpoondown> (type) "(|heap :: heap, locals :: locals|)"

definition del_locs :: "state => state" where
 "del_locs s \<equiv> s (| locals := empty |)"

definition init_locs     :: "cname => mname => state => state" where
 "init_locs C m s \<equiv> s (| locals := locals s ++
                         init_vars (map_of (lcl (the (method C m)))) |)"

text {* The first parameter of @{term set_locs} is of type @{typ state}
        rather than @{typ locals} in order to keep @{typ locals} private.*}
definition set_locs :: "state => state => state" where
 "set_locs s s' \<equiv> s' (| locals := locals s |)"

definition get_local     :: "state => vname => val" ("_<_>" [99,0] 99) where
 "get_local s x  \<equiv> the (locals s x)"

--{* local function: *}
definition get_obj       :: "state => loc => obj" where
 "get_obj s a \<equiv> the (heap s a)"

definition obj_class     :: "state => loc => cname" where
 "obj_class s a \<equiv> fst (get_obj s a)"

definition get_field     :: "state => loc => fname => val" where
 "get_field s a f \<equiv> the (snd (get_obj s a) f)"

--{* local function: *}
definition hupd       :: "loc => obj => state => state"   ("hupd'(_|->_')" [10,10] 1000) where
 "hupd a obj s \<equiv> s (| heap   := ((heap   s)(a\<mapsto>obj))|)"

definition lupd       :: "vname => val => state => state" ("lupd'(_|->_')" [10,10] 1000) where
 "lupd x v s   \<equiv> s (| locals := ((locals s)(x\<mapsto>v  ))|)"

notation (xsymbols)
  hupd  ("hupd'(_\<mapsto>_')" [10,10] 1000) and
  lupd  ("lupd'(_\<mapsto>_')" [10,10] 1000)

definition new_obj :: "loc => cname => state => state" where
 "new_obj a C   \<equiv> hupd(a\<mapsto>(C,init_vars (field C)))"

definition upd_obj    :: "loc => fname => val => state => state" where
 "upd_obj a f v s \<equiv> let (C,fs) = the (heap s a) in hupd(a\<mapsto>(C,fs(f\<mapsto>v))) s"

definition new_Addr      :: "state => val" where
 "new_Addr s == SOME v. (\<exists>a. v = Addr a \<and> (heap s) a = None) | v = Null"

subsection "Properties not used in the meta theory"

lemma locals_upd_id [simp]: "s\<lparr>locals := locals s\<rparr> = s"
by simp

lemma lupd_get_local_same [simp]: "lupd(x\<mapsto>v) s<x> = v"
by (simp add: lupd_def get_local_def)

lemma lupd_get_local_other [simp]: "x \<noteq> y \<Longrightarrow> lupd(x\<mapsto>v) s<y> = s<y>"
apply (drule not_sym)
by (simp add: lupd_def get_local_def)

lemma get_field_lupd [simp]:
  "get_field (lupd(x\<mapsto>y) s) a f = get_field s a f"
by (simp add: lupd_def get_field_def get_obj_def)

lemma get_field_set_locs [simp]:
  "get_field (set_locs l s) a f = get_field s a f"
by (simp add: lupd_def get_field_def set_locs_def get_obj_def)

lemma get_field_del_locs [simp]:
  "get_field (del_locs s) a f = get_field s a f"
by (simp add: lupd_def get_field_def del_locs_def get_obj_def)

lemma new_obj_get_local [simp]: "new_obj a C s <x> = s<x>"
by (simp add: new_obj_def hupd_def get_local_def)

lemma heap_lupd [simp]: "heap (lupd(x\<mapsto>y) s) = heap s"
by (simp add: lupd_def)

lemma heap_hupd_same [simp]: "heap (hupd(a\<mapsto>obj) s) a = Some obj"
by (simp add: hupd_def)

lemma heap_hupd_other [simp]: "aa \<noteq> a  \<Longrightarrow> heap (hupd(aa\<mapsto>obj) s) a = heap s a"
apply (drule not_sym)
by (simp add: hupd_def)

lemma hupd_hupd [simp]: "hupd(a\<mapsto>obj) (hupd(a\<mapsto>obj') s) = hupd(a\<mapsto>obj) s"
by (simp add: hupd_def)

lemma heap_del_locs [simp]: "heap (del_locs s) = heap s"
by (simp add: del_locs_def)

lemma heap_set_locs [simp]: "heap (set_locs l s) = heap s"
by (simp add: set_locs_def)

lemma hupd_lupd [simp]:
  "hupd(a\<mapsto>obj) (lupd(x\<mapsto>y) s) = lupd(x\<mapsto>y) (hupd(a\<mapsto>obj) s)"
by (simp add: hupd_def lupd_def)

lemma hupd_del_locs [simp]:
  "hupd(a\<mapsto>obj) (del_locs s) = del_locs (hupd(a\<mapsto>obj) s)"
by (simp add: hupd_def del_locs_def)

lemma new_obj_lupd [simp]:
  "new_obj a C (lupd(x\<mapsto>y) s) = lupd(x\<mapsto>y) (new_obj a C s)"
by (simp add: new_obj_def)

lemma new_obj_del_locs [simp]:
  "new_obj a C (del_locs s) = del_locs (new_obj a C s)"
by (simp add: new_obj_def)

lemma upd_obj_lupd [simp]:
  "upd_obj a f v (lupd(x\<mapsto>y) s) = lupd(x\<mapsto>y) (upd_obj a f v s)"
by (simp add: upd_obj_def Let_def split_beta)

lemma upd_obj_del_locs [simp]:
  "upd_obj a f v (del_locs s) = del_locs (upd_obj a f v s)"
by (simp add: upd_obj_def Let_def split_beta)

lemma get_field_hupd_same [simp]:
 "get_field (hupd(a\<mapsto>(C, fs)) s) a = the \<circ> fs"
apply (rule ext)
by (simp add: get_field_def get_obj_def)

lemma get_field_hupd_other [simp]:
 "aa \<noteq> a  \<Longrightarrow> get_field (hupd(aa\<mapsto>obj) s) a = get_field s a"
apply (rule ext)
by (simp add: get_field_def get_obj_def)

lemma new_AddrD:
"new_Addr s = v \<Longrightarrow> (\<exists>a. v = Addr a \<and> heap s a = None) | v = Null"
apply (unfold new_Addr_def)
apply (erule subst)
apply (rule someI)
apply (rule disjI2)
apply (rule HOL.refl)
done

end


(*
 * Copyright (c) 2020, CleanQ Project - Systems Group, ETH Zurich
 * All rights reserved.
 *
 * This software may be distributed and modified according to the terms of
 * the BSD 2-Clause license. Note that NO WARRANTY is provided.
 *
 * See "LICENSE" for details.
 *
 * SPDX-License-Identifier: BSD-2-Clause
 *)

section \<open>List Model Simpl proofs\<close>

text \<open>
  Due to problems importing both SIMPL and COMPLX we split the files and have all the proofs
  using SIMPL in this file
\<close>

theory CleanQ_ListModel_Simpl
(*<*)
  imports Main "../Simpl/Vcg" CleanQ_ListModel
(*>*)
begin

(* ==================================================================================== *)
subsection \<open>Integration in SIMPL\<close>
(* ==================================================================================== *)

text \<open>
  We now integrate the the CleanQ List Model into SIMPL. For each of the two operations,
  enqueue and dequeue, we specify a Hoare-triple with pre and post conditions, and
  the operation.
\<close>

(* ------------------------------------------------------------------------------------ *)
subsubsection \<open>Enqueue Operation\<close>
(* ------------------------------------------------------------------------------------ *)

text \<open>
  We first show, that we can define a Hoare triple for the enqueue operations from both
  agents X and Y, and that in both cases the invariant is preserved.
\<close>

lemma CleanQ_List_enq_x_preserves_invariants :
  "\<Gamma>\<turnstile> \<lbrace> rb' = \<acute>ListRB \<and> CleanQ_List_Invariants K \<acute>ListRB \<and> b \<in> lSX \<acute>ListRB \<rbrace>
        \<acute>ListRB :== (CleanQ_List_enq_x b \<acute>ListRB)
      \<lbrace> CleanQ_List_Invariants K \<acute>ListRB \<rbrace>"
  by(vcg, simp only: CleanQ_List_enq_x_Invariants)

lemma CleanQ_List_enq_y_preserves_invariants :
  "\<Gamma>\<turnstile> \<lbrace> rb' = \<acute>ListRB \<and> CleanQ_List_Invariants K \<acute>ListRB \<and> b \<in> lSY \<acute>ListRB \<rbrace>
        \<acute>ListRB :== (CleanQ_List_enq_y b \<acute>ListRB)
      \<lbrace> CleanQ_List_Invariants K \<acute>ListRB \<rbrace>"
  by(vcg, simp only: CleanQ_List_enq_y_Invariants)

text \<open>
  The same applies for the multi-step \verb+eneuque_n+ operation.
\<close>

lemma CleanQ_List_enq_n_x_preserves_invariants :
  "\<Gamma>\<turnstile> \<lbrace> rb' = \<acute>ListRB \<and> CleanQ_List_Invariants K \<acute>ListRB
        \<and> (\<forall>b \<in> set B. b \<in> (lSX \<acute>ListRB)) \<and> distinct B \<rbrace>
        \<acute>ListRB :== (CleanQ_List_enq_n_x B \<acute>ListRB)
      \<lbrace> CleanQ_List_Invariants K \<acute>ListRB \<rbrace>"
  apply(vcg) using CleanQ_List_enq_n_x_Invariants by blast

lemma CleanQ_List_enq_n_y_preserves_invariants :
  "\<Gamma>\<turnstile> \<lbrace> rb' = \<acute>ListRB \<and> CleanQ_List_Invariants K \<acute>ListRB
        \<and> (\<forall>b \<in> set B. b \<in> (lSY \<acute>ListRB)) \<and> distinct B \<rbrace>
        \<acute>ListRB :== (CleanQ_List_enq_n_y B \<acute>ListRB)
      \<lbrace> CleanQ_List_Invariants K \<acute>ListRB \<rbrace>"
  apply(vcg) using CleanQ_List_enq_n_y_Invariants by blast

end


(*
 * Copyright 2014, NICTA
 *
 * This software may be distributed and modified according to the terms of
 * the BSD 2-Clause license. Note that NO WARRANTY is provided.
 * See "LICENSE_BSD2.txt" for details.
 *
 * @TAG(NICTA_BSD)
 *)

theory SignedWords
imports "~~/src/HOL/Word/Word"
begin

subsection {* Type definition *}

typedef ('a::len0) signed = "UNIV :: 'a set" ..

lemma card_signed [simp]: "CARD (('a::len0) signed) = CARD('a)"
  unfolding type_definition.card [OF type_definition_signed]
  by simp

instantiation signed :: (len0) len0
begin

definition
  len_signed [simp]: "len_of (x::'a::len0 signed itself) = len_of TYPE('a)"

instance ..

end

instance signed :: (len) len
  by (intro_classes, simp)

type_synonym 'a sword = "('a signed) word"
type_synonym sword8 = "8 sword"
type_synonym sword16 = "16 sword"
type_synonym sword32 = "32 sword"
type_synonym sword64 = "64 sword"

end


(*  Title:       OAWN_Convert.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke
*)

header "Transfer standard invariants into open invariants"

theory OAWN_Convert
imports AWN_SOS_Labels AWN_Invariants
        OAWN_SOS OAWN_Invariants
begin

definition initiali :: "'i \<Rightarrow> (('i \<Rightarrow> 'g) \<times> 'l) set \<Rightarrow> ('g \<times> 'l) set \<Rightarrow> bool"
where "initiali i OI CI \<equiv> ({(\<sigma> i, p)|\<sigma> p. (\<sigma>, p) \<in> OI} = CI)"

lemma initialiI [intro]:
  assumes OICI: "\<And>\<sigma> p. (\<sigma>, p) \<in> OI \<Longrightarrow> (\<sigma> i, p) \<in> CI"
      and CIOI: "\<And>\<xi> p. (\<xi>, p) \<in> CI \<Longrightarrow> \<exists>\<sigma>. \<xi> = \<sigma> i \<and> (\<sigma>, p) \<in> OI"
    shows "initiali i OI CI"
  unfolding initiali_def
  by (intro set_eqI iffI) (auto elim!: OICI CIOI)

lemma open_from_initialiD [dest]:
  assumes "initiali i OI CI"
      and "(\<sigma>, p) \<in> OI"
    shows "\<exists>\<xi>. \<sigma> i = \<xi> \<and> (\<xi>, p) \<in> CI"
  using assms unfolding initiali_def by auto

lemma closed_from_initialiD [dest]:
  assumes "initiali i OI CI"
      and "(\<xi>, p) \<in> CI"
    shows "\<exists>\<sigma>. \<sigma> i = \<xi> \<and> (\<sigma>, p) \<in> OI"
  using assms unfolding initiali_def by auto

definition
  seql :: "'i \<Rightarrow> (('s \<times> 'l) \<Rightarrow> bool) \<Rightarrow> (('i \<Rightarrow> 's) \<times> 'l) \<Rightarrow> bool"
where
  "seql i P \<equiv> (\<lambda>(\<sigma>, p). P (\<sigma> i, p))"

lemma seqlI [intro]:
  "P (fst s i, snd s) \<Longrightarrow> seql i P s"
  by (clarsimp simp: seql_def)

lemma same_seql [elim]:
  assumes "\<forall>j\<in>{i}. \<sigma>' j = \<sigma> j"
      and "seql i P (\<sigma>', s)"
    shows "seql i P (\<sigma>, s)"
  using assms unfolding seql_def by (clarsimp)

lemma seqlsimp:
  "seql i P (\<sigma>, p) = P (\<sigma> i, p)"
  unfolding seql_def by simp

lemma other_steps_resp_local [intro!, simp]: "other_steps (other A I) I"
  by (clarsimp elim!: otherE)

lemma seql_onl_swap:
  "seql i (onl \<Gamma> P) = onl \<Gamma> (seql i P)"
  unfolding seql_def onl_def by simp

lemma oseqp_sos_resp_local_steps [intro!, simp]:
  fixes \<Gamma> :: "'p \<Rightarrow> ('s, 'm, 'p, 'l) seqp"
  shows "local_steps (oseqp_sos \<Gamma> i) {i}"
  proof
    fix \<sigma> \<sigma>' \<zeta> \<zeta>' :: "nat \<Rightarrow> 's" and s a s'
    assume tr: "((\<sigma>, s), a, \<sigma>', s') \<in> oseqp_sos \<Gamma> i"
       and "\<forall>j\<in>{i}. \<zeta> j = \<sigma> j"
    thus "\<exists>\<zeta>'. (\<forall>j\<in>{i}. \<zeta>' j = \<sigma>' j) \<and> ((\<zeta>, s), a, (\<zeta>', s')) \<in> oseqp_sos \<Gamma> i"
    proof induction
      fix \<sigma> \<sigma>' l ms p
      assume "\<sigma>' i = \<sigma> i"
         and "\<forall>j\<in>{i}. \<zeta> j = \<sigma> j"
      hence "((\<zeta>, {l}broadcast(ms).p), broadcast (ms (\<sigma> i)), (\<sigma>', p)) \<in> oseqp_sos \<Gamma> i"
        by (metis obroadcastT singleton_iff)
      with \<open>\<forall>j\<in>{i}. \<zeta> j = \<sigma> j\<close> show "\<exists>\<zeta>'. (\<forall>j\<in>{i}. \<zeta>' j = \<sigma>' j) \<and>
            ((\<zeta>, {l}broadcast(ms).p), broadcast (ms (\<sigma> i)), (\<zeta>', p)) \<in> oseqp_sos \<Gamma> i"
        by blast
    next
      fix \<sigma> \<sigma>' :: "nat \<Rightarrow> 's" and fmsg :: "'m \<Rightarrow> 's \<Rightarrow> 's" and msg l p
      assume *:  "\<sigma>' i = fmsg msg (\<sigma> i)"
         and **: "\<forall>j\<in>{i}. \<zeta> j = \<sigma> j"
      hence "\<forall>j\<in>{i}. (\<zeta>(i := fmsg msg (\<zeta> i))) j = \<sigma>' j" by clarsimp
      moreover from * **
        have "((\<zeta>, {l}receive(fmsg).p), receive msg, (\<zeta>(i := fmsg msg (\<zeta> i)), p)) \<in> oseqp_sos \<Gamma> i"
        by (metis fun_upd_same oreceiveT)
      ultimately show "\<exists>\<zeta>'. (\<forall>j\<in>{i}. \<zeta>' j = \<sigma>' j) \<and>
                            ((\<zeta>, {l}receive(fmsg).p), receive msg, (\<zeta>', p)) \<in> oseqp_sos \<Gamma> i"
        by blast
    next
      fix \<sigma>' \<sigma> l p and fas :: "'s \<Rightarrow> 's"
      assume *:  "\<sigma>' i = fas (\<sigma> i)"
         and **: "\<forall>j\<in>{i}. \<zeta> j = \<sigma> j"
      hence "\<forall>j\<in>{i}. (\<zeta>(i := fas (\<zeta> i))) j = \<sigma>' j" by clarsimp
      moreover from * ** have "((\<zeta>, {l}\<lbrakk>fas\<rbrakk> p), \<tau>, (\<zeta>(i := fas (\<zeta> i)), p)) \<in> oseqp_sos \<Gamma> i"
        by (metis fun_upd_same oassignT)
      ultimately show "\<exists>\<zeta>'. (\<forall>j\<in>{i}. \<zeta>' j = \<sigma>' j) \<and> ((\<zeta>, {l}\<lbrakk>fas\<rbrakk> p), \<tau>, (\<zeta>', p)) \<in> oseqp_sos \<Gamma> i"
        by blast
    next
      fix g :: "'s \<Rightarrow> 's set" and \<sigma> \<sigma>' l p
      assume *:  "\<sigma>' i \<in> g (\<sigma> i)"
         and **: "\<forall>j\<in>{i}. \<zeta> j = \<sigma> j"
      hence "\<forall>j\<in>{i}. (SOME \<zeta>'. \<zeta>' i = \<sigma>' i) j = \<sigma>' j" by simp (metis (lifting, full_types) some_eq_ex)
      moreover with * ** have "((\<zeta>, {l}\<langle>g\<rangle> p), \<tau>, (SOME \<zeta>'. \<zeta>' i = \<sigma>' i, p)) \<in> oseqp_sos \<Gamma> i"
        by simp (metis oguardT step_seq_tau)
      ultimately show "\<exists>\<zeta>'. (\<forall>j\<in>{i}. \<zeta>' j = \<sigma>' j) \<and> ((\<zeta>, {l}\<langle>g\<rangle> p), \<tau>, (\<zeta>', p)) \<in> oseqp_sos \<Gamma> i"
        by blast
    next
      fix \<sigma> pn a \<sigma>' p'
      assume "((\<sigma>, \<Gamma> pn), a, (\<sigma>', p')) \<in> oseqp_sos \<Gamma> i"
         and IH: "\<forall>j\<in>{i}. \<zeta> j = \<sigma> j \<Longrightarrow> \<exists>\<zeta>'. (\<forall>j\<in>{i}. \<zeta>' j = \<sigma>' j) \<and> ((\<zeta>, \<Gamma> pn), a, (\<zeta>', p')) \<in> oseqp_sos \<Gamma> i"
         and "\<forall>j\<in>{i}. \<zeta> j = \<sigma> j"
      then obtain \<zeta>' where "\<forall>j\<in>{i}. \<zeta>' j = \<sigma>' j"
                       and "((\<zeta>, \<Gamma> pn), a, (\<zeta>', p')) \<in> oseqp_sos \<Gamma> i"
        by blast
      thus "\<exists>\<zeta>'. (\<forall>j\<in>{i}. \<zeta>' j = \<sigma>' j) \<and> ((\<zeta>, call(pn)), a, (\<zeta>', p')) \<in> oseqp_sos \<Gamma> i"
        by blast
    next
      fix \<sigma> p a \<sigma>' p' q
      assume "((\<sigma>, p), a, (\<sigma>', p')) \<in> oseqp_sos \<Gamma> i"
         and "\<forall>j\<in>{i}. \<zeta> j = \<sigma> j \<Longrightarrow> \<exists>\<zeta>'. (\<forall>j\<in>{i}. \<zeta>' j = \<sigma>' j) \<and> ((\<zeta>, p), a, (\<zeta>', p')) \<in> oseqp_sos \<Gamma> i"
         and "\<forall>j\<in>{i}. \<zeta> j = \<sigma> j"
      then obtain \<zeta>' where "\<forall>j\<in>{i}. \<zeta>' j = \<sigma>' j"
                       and "((\<zeta>, p), a, (\<zeta>', p')) \<in> oseqp_sos \<Gamma> i"
        by blast
      thus "\<exists>\<zeta>'. (\<forall>j\<in>{i}. \<zeta>' j = \<sigma>' j) \<and> ((\<zeta>, p \<oplus> q), a, (\<zeta>', p')) \<in> oseqp_sos \<Gamma> i"
        by blast
    next
      fix \<sigma> p a \<sigma>' q q'
      assume "((\<sigma>, q), a, (\<sigma>', q')) \<in> oseqp_sos \<Gamma> i"
         and "\<forall>j\<in>{i}. \<zeta> j = \<sigma> j \<Longrightarrow> \<exists>\<zeta>'. (\<forall>j\<in>{i}. \<zeta>' j = \<sigma>' j) \<and> ((\<zeta>, q), a, (\<zeta>', q')) \<in> oseqp_sos \<Gamma> i"
         and "\<forall>j\<in>{i}. \<zeta> j = \<sigma> j"
      then obtain \<zeta>' where "\<forall>j\<in>{i}. \<zeta>' j = \<sigma>' j"
                       and "((\<zeta>, q), a, (\<zeta>', q')) \<in> oseqp_sos \<Gamma> i"
        by blast
      thus "\<exists>\<zeta>'. (\<forall>j\<in>{i}. \<zeta>' j = \<sigma>' j) \<and> ((\<zeta>, p \<oplus> q), a, (\<zeta>', q')) \<in> oseqp_sos \<Gamma> i"
        by blast
    qed (simp_all, (metis ogroupcastT ounicastT onotunicastT osendT odeliverT)+)
  qed

lemma oseqp_sos_subreachable [intro!, simp]:
  assumes "trans OA = oseqp_sos \<Gamma> i"
    shows "subreachable OA (other ANY {i}) {i}"
  by rule (clarsimp simp add: assms(1))+

lemma oseq_step_is_seq_step:
    fixes \<sigma> :: "ip \<Rightarrow> 's"
  assumes "((\<sigma>, p), a :: 'm seq_action, (\<sigma>', p')) \<in> oseqp_sos \<Gamma> i"
      and "\<sigma> i = \<xi>"
    shows "\<exists>\<xi>'. \<sigma>' i = \<xi>' \<and> ((\<xi>, p), a, (\<xi>', p')) \<in> seqp_sos \<Gamma>"
  using assms proof induction
    fix \<sigma> \<sigma>' l ms p
    assume "\<sigma>' i = \<sigma> i"
       and "\<sigma> i = \<xi>"
    hence "\<sigma>' i = \<xi>" by simp
    have "((\<xi>, {l}broadcast(ms).p), broadcast (ms \<xi>), (\<xi>, p)) \<in> seqp_sos \<Gamma>"
      by auto
    with \<open>\<sigma> i = \<xi>\<close> and \<open>\<sigma>' i = \<xi>\<close> show "\<exists>\<xi>'. \<sigma>' i = \<xi>'
             \<and> ((\<xi>, {l}broadcast(ms).p), broadcast (ms (\<sigma> i)), (\<xi>', p)) \<in> seqp_sos \<Gamma>"
       by clarsimp
  next
    fix fmsg :: "'m \<Rightarrow> 's \<Rightarrow> 's" and msg :: 'm and \<sigma>' \<sigma> l p
    assume "\<sigma>' i = fmsg msg (\<sigma> i)"
       and "\<sigma> i = \<xi>"
    have "((\<xi>, {l}receive(fmsg).p), receive msg, (fmsg msg \<xi>, p)) \<in> seqp_sos \<Gamma>"
      by auto
    with \<open>\<sigma>' i = fmsg msg (\<sigma> i)\<close> and \<open>\<sigma> i = \<xi>\<close>
      show "\<exists>\<xi>'. \<sigma>' i = \<xi>' \<and> ((\<xi>, {l}receive(fmsg).p), receive msg, (\<xi>', p)) \<in> seqp_sos \<Gamma>"
         by clarsimp
  qed (simp_all, (metis assignT choiceT1 choiceT2 groupcastT guardT
                        callT unicastT notunicastT sendT deliverT step_seq_tau)+)

lemma reachable_oseq_seqp_sos:
  assumes "(\<sigma>, p) \<in> reachable OA I"
      and "initiali i (init OA) (init A)"
      and spo: "trans OA = oseqp_sos \<Gamma> i"
      and sp: "trans A = seqp_sos \<Gamma>"
      shows "\<exists>\<xi>. \<sigma> i = \<xi> \<and> (\<xi>, p) \<in> reachable A I"
  using assms(1) proof (induction rule: reachable_pair_induct)
    fix \<sigma> p
    assume "(\<sigma>, p) \<in> init OA"
    with \<open>initiali i (init OA) (init A)\<close> obtain \<xi> where "\<sigma> i = \<xi>"
                                                    and "(\<xi>, p) \<in> init A"
      by auto
    from \<open>(\<xi>, p) \<in> init A\<close> have "(\<xi>, p) \<in> reachable A I" ..
    with \<open>\<sigma> i = \<xi>\<close> show "\<exists>\<xi>. \<sigma> i = \<xi> \<and> (\<xi>, p) \<in> reachable A I"
      by auto
  next
    fix \<sigma> p \<sigma>' p' a
    assume "(\<sigma>, p) \<in> reachable OA I"
       and IH: "\<exists>\<xi>. \<sigma> i = \<xi> \<and> (\<xi>, p) \<in> reachable A I"
       and otr: "((\<sigma>, p), a, (\<sigma>', p')) \<in> trans OA"
       and "I a"
    from IH obtain \<xi> where "\<sigma> i = \<xi>"
                       and cr: "(\<xi>, p) \<in> reachable A I"
      by clarsimp
    from otr and spo have "((\<sigma>, p), a, (\<sigma>', p')) \<in> oseqp_sos \<Gamma> i" by simp
    with \<open>\<sigma> i = \<xi>\<close> obtain \<xi>' where "\<sigma>' i = \<xi>'"
                               and "((\<xi>, p), a, (\<xi>', p')) \<in> seqp_sos \<Gamma>"
        by (auto dest!: oseq_step_is_seq_step)
    from this(2) and sp have ctr: "((\<xi>, p), a, (\<xi>', p')) \<in> trans A" by simp
    from \<open>(\<xi>, p) \<in> reachable A I\<close> and ctr and \<open>I a\<close>
      have "(\<xi>', p') \<in> reachable A I" ..
    with \<open>\<sigma>' i = \<xi>'\<close> show "\<exists>\<xi>. \<sigma>' i = \<xi> \<and> (\<xi>, p') \<in> reachable A I"
      by blast
  qed

lemma reachable_oseq_seqp_sos':
  assumes "s \<in> reachable OA I"
      and "initiali i (init OA) (init A)"
      and "trans OA = oseqp_sos \<Gamma> i"
      and "trans A = seqp_sos \<Gamma>"
    shows "\<exists>\<xi>. (fst s) i = \<xi> \<and> (\<xi>, snd s) \<in> reachable A I"
  using assms
  by - (cases s, auto dest: reachable_oseq_seqp_sos)

text \<open>
  Any invariant shown in the (simpler) closed semantics can be transferred to an invariant in
  the open semantics.
\<close>

theorem open_seq_invariant [intro]:
  assumes "A \<TTurnstile> (I \<rightarrow>) P"
      and "initiali i (init OA) (init A)"
      and spo: "trans OA = oseqp_sos \<Gamma> i"
      and sp: "trans A = seqp_sos \<Gamma>"
    shows "OA \<Turnstile> (act I, other ANY {i} \<rightarrow>) (seql i P)"
  proof -
    have "OA \<TTurnstile> (I \<rightarrow>) (seql i P)"
      proof (rule invariant_arbitraryI)
        fix s
        assume "s \<in> reachable OA I"
        with \<open>initiali i (init OA) (init A)\<close> obtain \<xi> where "(fst s) i = \<xi>"
                                                        and "(\<xi>, snd s) \<in> reachable A I"
          by (auto dest: reachable_oseq_seqp_sos' [OF _ _ spo sp])
        with \<open>A \<TTurnstile> (I \<rightarrow>) P\<close> have "P (\<xi>, snd s)" by auto
        with \<open>(fst s) i = \<xi>\<close> show "seql i P s" by auto
      qed
    moreover from spo have "subreachable OA (other ANY {i}) {i}" ..
    ultimately show ?thesis
    proof (rule open_closed_invariant)
      fix \<sigma> \<sigma>' s
      assume "\<forall>j\<in>{i}. \<sigma>' j = \<sigma> j"
         and "seql i P (\<sigma>', s)"
      thus "seql i P (\<sigma>, s)" ..
    qed
  qed

definition
  seqll :: "'i \<Rightarrow> ((('s \<times> 'l) \<times> 'a \<times> ('s \<times> 'l)) \<Rightarrow> bool)
               \<Rightarrow> ((('i \<Rightarrow> 's) \<times> 'l) \<times> 'a \<times> (('i \<Rightarrow> 's) \<times> 'l)) \<Rightarrow> bool"
where
  "seqll i P \<equiv> (\<lambda>((\<sigma>, p), a, (\<sigma>', p')). P ((\<sigma> i, p), a, (\<sigma>' i, p')))"

lemma same_seqll [elim]:
  assumes "\<forall>j\<in>{i}. \<sigma>\<^sub>1' j = \<sigma>\<^sub>1 j"
      and "\<forall>j\<in>{i}. \<sigma>\<^sub>2' j = \<sigma>\<^sub>2 j"
      and "seqll i P ((\<sigma>\<^sub>1', s), a, (\<sigma>\<^sub>2', s'))"
    shows "seqll i P ((\<sigma>\<^sub>1,  s), a, (\<sigma>\<^sub>2,  s'))"
  using assms unfolding seqll_def by (clarsimp)

lemma seqllI [intro!]:
  assumes "P ((\<sigma> i, p), a, (\<sigma>' i, p'))"
    shows "seqll i P ((\<sigma>, p), a, (\<sigma>', p'))"
  using assms unfolding seqll_def by simp

lemma seqllD [dest]:
  assumes "seqll i P ((\<sigma>, p), a, (\<sigma>', p'))"
    shows "P ((\<sigma> i, p), a, (\<sigma>' i, p'))"
  using assms unfolding seqll_def by simp

lemma seqllsimp:
  "seqll i P ((\<sigma>, p), a, (\<sigma>', p')) = P ((\<sigma> i, p), a, (\<sigma>' i, p'))"
  unfolding seqll_def by simp

lemma seqll_onll_swap:
  "seqll i (onll \<Gamma> P) = onll \<Gamma> (seqll i P)"
  unfolding seqll_def onll_def by simp

theorem open_seq_step_invariant [intro]:
  assumes "A \<TTurnstile>\<^sub>A (I \<rightarrow>) P"
      and "initiali i (init OA) (init A)"
      and spo: "trans OA = oseqp_sos \<Gamma> i"
      and sp: "trans A = seqp_sos \<Gamma>"
    shows "OA \<Turnstile>\<^sub>A (act I, other ANY {i} \<rightarrow>) (seqll i P)"
  proof -
    have "OA \<TTurnstile>\<^sub>A (I \<rightarrow>) (seqll i P)"
    proof (rule step_invariant_arbitraryI)
      fix \<sigma> p a \<sigma>' p'
      assume or: "(\<sigma>, p) \<in> reachable OA I"
         and otr: "((\<sigma>, p), a, (\<sigma>', p')) \<in> trans OA"
         and "I a"
      from or \<open>initiali i (init OA) (init A)\<close> spo sp obtain \<xi> where "\<sigma> i = \<xi>"
                                                             and cr: "(\<xi>, p) \<in> reachable A I"
        by - (drule(3) reachable_oseq_seqp_sos', auto)
      from otr and spo have "((\<sigma>, p), a, (\<sigma>', p')) \<in> oseqp_sos \<Gamma> i" by simp
      with \<open>\<sigma> i = \<xi>\<close> obtain \<xi>' where "\<sigma>' i = \<xi>'"
                                 and ctr: "((\<xi>, p), a, (\<xi>', p')) \<in> seqp_sos \<Gamma>"
        by (auto dest!: oseq_step_is_seq_step)
      with sp have "((\<xi>, p), a, (\<xi>', p')) \<in> trans A" by simp
      with \<open>A \<TTurnstile>\<^sub>A (I \<rightarrow>) P\<close> cr have "P ((\<xi>, p), a, (\<xi>', p'))" using \<open>I a\<close> ..
      with \<open>\<sigma> i = \<xi>\<close> and \<open>\<sigma>' i = \<xi>'\<close> have "P ((\<sigma> i, p), a, (\<sigma>' i, p'))" by simp
      thus "seqll i P ((\<sigma>, p), a, (\<sigma>', p'))" ..
    qed
    moreover from spo have "local_steps (trans OA) {i}" by simp
    moreover have "other_steps (other ANY {i}) {i}" ..
    ultimately show ?thesis
    proof (rule open_closed_step_invariant)
      fix \<sigma> \<zeta> a \<sigma>' \<zeta>' s s'
      assume "\<forall>j\<in>{i}. \<sigma> j = \<zeta> j"
         and "\<forall>j\<in>{i}. \<sigma>' j = \<zeta>' j"
         and "seqll i P ((\<sigma>, s), a, (\<sigma>', s'))"
        thus "seqll i P ((\<zeta>, s), a, (\<zeta>', s'))" ..
    qed
  qed

end


(*  Title:       OAWN_Invariants.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke
*)

section "Generic open invariants on sequential AWN processes"

theory OAWN_Invariants
imports Invariants OInvariants
        AWN_Cterms AWN_Labels AWN_Invariants
        OAWN_SOS
begin

subsection "Open invariants via labelled control terms"

lemma oseqp_sos_subterms:
  assumes "wellformed \<Gamma>"
      and "\<exists>pn. p \<in> subterms (\<Gamma> pn)"
      and "((\<sigma>, p), a, (\<sigma>', p')) \<in> oseqp_sos \<Gamma> i"
    shows "\<exists>pn. p' \<in> subterms (\<Gamma> pn)"
  using assms
  proof (induct p)
    fix p1 p2
    assume IH1: "\<exists>pn. p1 \<in> subterms (\<Gamma> pn) \<Longrightarrow>
                      ((\<sigma>, p1), a, (\<sigma>', p')) \<in> oseqp_sos \<Gamma> i \<Longrightarrow>
                      \<exists>pn. p' \<in> subterms (\<Gamma> pn)"
       and IH2: "\<exists>pn. p2 \<in> subterms (\<Gamma> pn) \<Longrightarrow>
                      ((\<sigma>, p2), a, (\<sigma>', p')) \<in> oseqp_sos \<Gamma> i \<Longrightarrow>
                      \<exists>pn. p' \<in> subterms (\<Gamma> pn)"
       and "\<exists>pn. p1 \<oplus> p2 \<in> subterms (\<Gamma> pn)"
       and "((\<sigma>, p1 \<oplus> p2), a, (\<sigma>', p')) \<in> oseqp_sos \<Gamma> i"
    from \<open>\<exists>pn. p1 \<oplus> p2 \<in> subterms (\<Gamma> pn)\<close> obtain pn
                                            where "p1 \<in> subterms (\<Gamma> pn)"
                                              and "p2 \<in> subterms (\<Gamma> pn)" by auto
    from \<open>((\<sigma>, p1 \<oplus> p2), a, (\<sigma>', p')) \<in> oseqp_sos \<Gamma> i\<close>
      have "((\<sigma>, p1), a, (\<sigma>', p')) \<in> oseqp_sos \<Gamma> i
            \<or> ((\<sigma>, p2), a, (\<sigma>', p')) \<in> oseqp_sos \<Gamma> i" by auto
    thus "\<exists>pn. p' \<in> subterms (\<Gamma> pn)"
    proof
      assume "((\<sigma>, p1), a, (\<sigma>', p')) \<in> oseqp_sos \<Gamma> i"
      with \<open>p1 \<in> subterms (\<Gamma> pn)\<close> show ?thesis by (auto intro: IH1)
    next
      assume "((\<sigma>, p2), a, (\<sigma>', p')) \<in> oseqp_sos \<Gamma> i"
      with \<open>p2 \<in> subterms (\<Gamma> pn)\<close> show ?thesis by (auto intro: IH2)
    qed
  qed auto

lemma oreachable_subterms:
  assumes "wellformed \<Gamma>"
      and "control_within \<Gamma> (init A)"
      and "trans A = oseqp_sos \<Gamma> i"
      and "(\<sigma>, p) \<in> oreachable A S U"
    shows "\<exists>pn. p \<in> subterms (\<Gamma> pn)"
  using assms(4)
  proof (induct rule: oreachable_pair_induct)
    fix \<sigma> p
    assume "(\<sigma>, p) \<in> init A"
    with \<open>control_within \<Gamma> (init A)\<close> show "\<exists>pn. p \<in> subterms (\<Gamma> pn)" ..
  next
    fix \<sigma> p a \<sigma>' p'
    assume "(\<sigma>, p) \<in> oreachable A S U"
       and "\<exists>pn. p \<in> subterms (\<Gamma> pn)"
       and 3: "((\<sigma>, p), a, (\<sigma>', p')) \<in> trans A"
       and "S \<sigma> \<sigma>' a"
    moreover from 3 and \<open>trans A = oseqp_sos \<Gamma> i\<close>
      have "((\<sigma>, p), a, (\<sigma>', p')) \<in> oseqp_sos \<Gamma> i" by simp
    ultimately show "\<exists>pn. p' \<in> subterms (\<Gamma> pn)"
    using \<open>wellformed \<Gamma>\<close>
      by (auto elim: oseqp_sos_subterms)
  qed

lemma onl_oinvariantI [intro]:
  assumes init: "\<And>\<sigma> p l. \<lbrakk> (\<sigma>, p) \<in> init A; l \<in> labels \<Gamma> p \<rbrakk> \<Longrightarrow> P (\<sigma>, l)"
      and other: "\<And>\<sigma> \<sigma>' p l. \<lbrakk> (\<sigma>, p) \<in> oreachable A S U;
                                \<forall>l\<in>labels \<Gamma> p. P (\<sigma>, l);
                                U \<sigma> \<sigma>' \<rbrakk> \<Longrightarrow> \<forall>l\<in>labels \<Gamma> p. P (\<sigma>', l)"
      and step: "\<And>\<sigma> p a \<sigma>' p' l'.
                   \<lbrakk> (\<sigma>, p) \<in> oreachable A S U;
                     \<forall>l\<in>labels \<Gamma> p. P (\<sigma>, l);
                     ((\<sigma>, p), a, (\<sigma>', p')) \<in> trans A;
                     l' \<in> labels \<Gamma> p';
                     S \<sigma> \<sigma>' a \<rbrakk> \<Longrightarrow> P (\<sigma>', l')"
    shows "A \<Turnstile> (S, U \<rightarrow>) onl \<Gamma> P"
  proof
    fix \<sigma> p
    assume "(\<sigma>, p) \<in> init A"
    hence "\<forall>l\<in>labels \<Gamma> p. P (\<sigma>, l)" using init by simp
    thus "onl \<Gamma> P (\<sigma>, p)" ..
  next
    fix \<sigma> p a \<sigma>' p'
    assume rp: "(\<sigma>, p) \<in> oreachable A S U"
       and "onl \<Gamma> P (\<sigma>, p)"
       and tr: "((\<sigma>, p), a, (\<sigma>', p')) \<in> trans A"
       and "S \<sigma> \<sigma>' a"
    from \<open>onl \<Gamma> P (\<sigma>, p)\<close> have "\<forall>l\<in>labels \<Gamma> p. P (\<sigma>, l)" ..
    with rp tr \<open>S \<sigma> \<sigma>' a\<close> have "\<forall>l'\<in>labels \<Gamma> p'. P (\<sigma>', l')" by (auto elim: step)
    thus "onl \<Gamma> P (\<sigma>', p')" ..
  next
    fix \<sigma> \<sigma>' p
    assume "(\<sigma>, p) \<in> oreachable A S U"
       and "onl \<Gamma> P (\<sigma>, p)"
       and "U \<sigma> \<sigma>'"
    from \<open>onl \<Gamma> P (\<sigma>, p)\<close> have "\<forall>l\<in>labels \<Gamma> p. P (\<sigma>, l)" by auto
    with \<open>(\<sigma>, p) \<in> oreachable A S U\<close> have "\<forall>l\<in>labels \<Gamma> p. P (\<sigma>', l)"
        using \<open>U \<sigma> \<sigma>'\<close> by (rule other)
    thus "onl \<Gamma> P (\<sigma>', p)" by auto
  qed

lemma global_oinvariantI [intro]:
  assumes init: "\<And>\<sigma> p. (\<sigma>, p) \<in> init A \<Longrightarrow> P \<sigma>"
      and other: "\<And>\<sigma> \<sigma>' p l. \<lbrakk> (\<sigma>, p) \<in> oreachable A S U; P \<sigma>; U \<sigma> \<sigma>' \<rbrakk> \<Longrightarrow> P \<sigma>'"
      and step: "\<And>\<sigma> p a \<sigma>' p'.
                   \<lbrakk> (\<sigma>, p) \<in> oreachable A S U;
                     P \<sigma>;
                     ((\<sigma>, p), a, (\<sigma>', p')) \<in> trans A;
                     S \<sigma> \<sigma>' a \<rbrakk> \<Longrightarrow> P \<sigma>'"
    shows "A \<Turnstile> (S, U \<rightarrow>) (\<lambda>(\<sigma>, _). P \<sigma>)"
  proof
    fix \<sigma> p
    assume "(\<sigma>, p) \<in> init A"
    thus "(\<lambda>(\<sigma>, _). P \<sigma>) (\<sigma>, p)"
      by simp (erule init)
  next
    fix \<sigma> p a \<sigma>' p'
    assume rp: "(\<sigma>, p) \<in> oreachable A S U"
       and "(\<lambda>(\<sigma>, _). P \<sigma>) (\<sigma>, p)"
       and tr: "((\<sigma>, p), a, (\<sigma>', p')) \<in> trans A"
       and "S \<sigma> \<sigma>' a"
    from \<open>(\<lambda>(\<sigma>, _). P \<sigma>) (\<sigma>, p)\<close> have "P \<sigma>" by simp
    with rp have "P \<sigma>'"
      using tr \<open>S \<sigma> \<sigma>' a\<close> by (rule step)
    thus "(\<lambda>(\<sigma>, _). P \<sigma>) (\<sigma>', p')" by simp
  next
    fix \<sigma> \<sigma>' p
    assume "(\<sigma>, p) \<in> oreachable A S U"
       and "(\<lambda>(\<sigma>, _). P \<sigma>) (\<sigma>, p)"
       and "U \<sigma> \<sigma>'"
    hence "P \<sigma>'" by simp (erule other)
    thus "(\<lambda>(\<sigma>, _). P \<sigma>) (\<sigma>', p)" by simp
  qed

lemma onl_oinvariantD [dest]:
  assumes "A \<Turnstile> (S, U \<rightarrow>) onl \<Gamma> P"
      and "(\<sigma>, p) \<in> oreachable A S U"
      and "l \<in> labels \<Gamma> p"
    shows "P (\<sigma>, l)"
  using assms unfolding onl_def by auto

lemma onl_oinvariant_weakenD [dest]:
  assumes "A \<Turnstile> (S', U' \<rightarrow>) onl \<Gamma> P"
      and "(\<sigma>, p) \<in> oreachable A S U"
      and "l \<in> labels \<Gamma> p"
      and weakenS: "\<And>s s' a. S s s' a \<Longrightarrow> S' s s' a"
      and weakenU: "\<And>s s'. U s s' \<Longrightarrow> U' s s'"
    shows "P (\<sigma>, l)"
  proof -
    from \<open>(\<sigma>, p) \<in> oreachable A S U\<close> have "(\<sigma>, p) \<in> oreachable A S' U'"
      by (rule oreachable_weakenE)
         (erule weakenS, erule weakenU)
    with \<open>A \<Turnstile> (S', U' \<rightarrow>) onl \<Gamma> P\<close> show "P (\<sigma>, l)"
      using \<open>l \<in> labels \<Gamma> p\<close> ..
  qed

lemma onl_oinvariant_initD [dest]:
  assumes invP: "A \<Turnstile> (S, U \<rightarrow>) onl \<Gamma> P"
      and init: "(\<sigma>, p) \<in> init A"
      and pnl:  "l \<in> labels \<Gamma> p"
    shows "P (\<sigma>, l)"
  proof -
    from init have "(\<sigma>, p) \<in> oreachable A S U" ..
    with invP show ?thesis using pnl ..
  qed

lemma onl_oinvariant_sterms:
  assumes wf: "wellformed \<Gamma>"
      and il: "A \<Turnstile> (S, U \<rightarrow>) onl \<Gamma> P"
      and rp: "(\<sigma>, p) \<in> oreachable A S U"
      and "p'\<in>sterms \<Gamma> p"
      and "l\<in>labels \<Gamma> p'"
    shows "P (\<sigma>, l)"
  proof -
    from wf \<open>p'\<in>sterms \<Gamma> p\<close> \<open>l\<in>labels \<Gamma> p'\<close> have "l\<in>labels \<Gamma> p"
      by (rule labels_sterms_labels)
    with il rp show "P (\<sigma>, l)" ..
  qed

lemma onl_oinvariant_sterms_weaken:
  assumes wf: "wellformed \<Gamma>"
      and il: "A \<Turnstile> (S', U' \<rightarrow>) onl \<Gamma> P"
      and rp: "(\<sigma>, p) \<in> oreachable A S U"
      and "p'\<in>sterms \<Gamma> p"
      and "l\<in>labels \<Gamma> p'"
      and weakenS: "\<And>\<sigma> \<sigma>' a. S \<sigma> \<sigma>' a \<Longrightarrow> S' \<sigma> \<sigma>' a"
      and weakenU: "\<And>\<sigma> \<sigma>'. U \<sigma> \<sigma>' \<Longrightarrow> U' \<sigma> \<sigma>'"
    shows "P (\<sigma>, l)"
  proof -
    from \<open>(\<sigma>, p) \<in> oreachable A S U\<close> have "(\<sigma>, p) \<in> oreachable A S' U'"
      by (rule oreachable_weakenE)
         (erule weakenS, erule weakenU)
    with assms(1-2) show ?thesis using assms(4-5)
      by (rule onl_oinvariant_sterms)
  qed

lemma otrans_from_sterms:
  assumes "((\<sigma>, p), a, (\<sigma>', q)) \<in> oseqp_sos \<Gamma> i"
      and "wellformed \<Gamma>"
    shows "\<exists>p'\<in>sterms \<Gamma> p. ((\<sigma>, p'), a, (\<sigma>', q)) \<in> oseqp_sos \<Gamma> i"
  using assms by (induction p rule: sterms_pinduct [OF \<open>wellformed \<Gamma>\<close>]) auto

lemma otrans_from_sterms':
  assumes "((\<sigma>, p'), a, (\<sigma>', q)) \<in> oseqp_sos \<Gamma> i"
      and "wellformed \<Gamma>"
      and "p' \<in> sterms \<Gamma> p"
    shows "((\<sigma>, p), a, (\<sigma>', q)) \<in> oseqp_sos \<Gamma> i"
  using assms by (induction p rule: sterms_pinduct [OF \<open>wellformed \<Gamma>\<close>]) auto

lemma otrans_to_dterms:
  assumes "((\<sigma>, p), a, (\<sigma>', q)) \<in> oseqp_sos \<Gamma> i"
      and "wellformed \<Gamma>"
   shows "\<forall>r\<in>sterms \<Gamma> q. r \<in> dterms \<Gamma> p"
  using assms by (induction q) auto

theorem cterms_includes_sterms_of_oseq_reachable:
  assumes "wellformed \<Gamma>"
      and "control_within \<Gamma> (init A)"
      and "trans A = oseqp_sos \<Gamma> i"
    shows "\<Union>(sterms \<Gamma> ` snd ` oreachable A S U) \<subseteq> cterms \<Gamma>"
  proof
    fix qs
    assume "qs \<in> \<Union>(sterms \<Gamma> ` snd ` oreachable A S U)"
    then obtain \<xi> and q where  *: "(\<xi>, q) \<in> oreachable A S U"
                          and **: "qs \<in> sterms \<Gamma> q" by auto
    from * have "\<And>x. x \<in> sterms \<Gamma> q \<Longrightarrow> x \<in> cterms \<Gamma>"
    proof (induction rule: oreachable_pair_induct)
      fix \<sigma> p q
      assume "(\<sigma>, p) \<in> init A"
         and "q \<in> sterms \<Gamma> p"
      from \<open>control_within \<Gamma> (init A)\<close> and \<open>(\<sigma>, p) \<in> init A\<close>
        obtain pn where "p \<in> subterms (\<Gamma> pn)" by auto
      with \<open>wellformed \<Gamma>\<close> show "q \<in> cterms \<Gamma>" using \<open>q\<in>sterms \<Gamma> p\<close>
        by (rule subterms_sterms_in_cterms)
    next
      fix p \<sigma> a \<sigma>' q x
      assume "(\<sigma>, p) \<in> oreachable A S U"
         and IH: "\<And>x. x \<in> sterms \<Gamma> p \<Longrightarrow> x \<in> cterms \<Gamma>"
         and "((\<sigma>, p), a, (\<sigma>', q)) \<in> trans A"
         and "x \<in> sterms \<Gamma> q"
      from this(3) and \<open>trans A = oseqp_sos \<Gamma> i\<close>
        have step: "((\<sigma>, p), a, (\<sigma>', q)) \<in> oseqp_sos \<Gamma> i" by simp
      from step \<open>wellformed \<Gamma>\<close> obtain ps
        where ps: "ps \<in> sterms \<Gamma> p"
          and step': "((\<sigma>, ps), a, (\<sigma>', q)) \<in> oseqp_sos \<Gamma> i"
        by (rule otrans_from_sterms [THEN bexE])
      from ps have "ps \<in> cterms \<Gamma>" by (rule IH)
      moreover from step' \<open>wellformed \<Gamma>\<close> \<open>x \<in> sterms \<Gamma> q\<close> have "x \<in> dterms \<Gamma> ps"
        by (rule otrans_to_dterms [rule_format])
      ultimately show "x \<in> cterms \<Gamma>" by (rule ctermsDI)
    qed
    thus "qs \<in> cterms \<Gamma>" using ** .
  qed

corollary oseq_reachable_in_cterms:
  assumes "wellformed \<Gamma>"
      and "control_within \<Gamma> (init A)"
      and "trans A = oseqp_sos \<Gamma> i"
      and "(\<sigma>, p) \<in> oreachable A S U"
      and "p' \<in> sterms \<Gamma> p"
    shows "p' \<in> cterms \<Gamma>"
  using assms(1-3)
  proof (rule cterms_includes_sterms_of_oseq_reachable [THEN subsetD])
    from assms(4-5) show "p' \<in> \<Union>(sterms \<Gamma> ` snd ` oreachable A S U)"
      by (auto elim!: rev_bexI)
  qed

lemma oseq_invariant_ctermI:
  assumes wf: "wellformed \<Gamma>"
      and cw: "control_within \<Gamma> (init A)"
      and sl: "simple_labels \<Gamma>"
      and sp: "trans A = oseqp_sos \<Gamma> i"
      and init: "\<And>\<sigma> p l. \<lbrakk>
                   (\<sigma>, p) \<in> init A;
                   l\<in>labels \<Gamma> p
                 \<rbrakk> \<Longrightarrow> P (\<sigma>, l)"
      and other: "\<And>\<sigma> \<sigma>' p l. \<lbrakk>
                   (\<sigma>, p) \<in> oreachable A S U;
                   l\<in>labels \<Gamma> p;
                   P (\<sigma>, l);
                   U \<sigma> \<sigma>' \<rbrakk> \<Longrightarrow> P (\<sigma>', l)"
      and local: "\<And>p l \<sigma> a q l' \<sigma>' pp. \<lbrakk>
                 p\<in>cterms \<Gamma>;
                 l\<in>labels \<Gamma> p;
                 P (\<sigma>, l);
                 ((\<sigma>, p), a, (\<sigma>', q)) \<in> oseqp_sos \<Gamma> i;
                 ((\<sigma>, p), a, (\<sigma>', q)) \<in> trans A;
                 l'\<in>labels \<Gamma> q;
                 (\<sigma>, pp)\<in>oreachable A S U;
                 p\<in>sterms \<Gamma> pp;
                 (\<sigma>', q)\<in>oreachable A S U;
                 S \<sigma> \<sigma>' a
               \<rbrakk> \<Longrightarrow> P (\<sigma>', l')"
    shows "A \<Turnstile> (S, U \<rightarrow>) onl \<Gamma> P"
  proof
       fix \<sigma> p l
    assume "(\<sigma>, p) \<in> init A"
       and *: "l \<in> labels \<Gamma> p"
      with init show "P (\<sigma>, l)" by auto
  next
       fix \<sigma> p a \<sigma>' q l'
    assume sr: "(\<sigma>, p) \<in> oreachable A S U"
       and pl: "\<forall>l\<in>labels \<Gamma> p. P (\<sigma>, l)"
       and tr: "((\<sigma>, p), a, (\<sigma>', q)) \<in> trans A"
       and A6: "l' \<in> labels \<Gamma> q"
       and "S \<sigma> \<sigma>' a"
      thus "P (\<sigma>', l')"
    proof -
      from sr and tr and \<open>S \<sigma> \<sigma>' a\<close> have A7: "(\<sigma>', q) \<in> oreachable A S U"
        by - (rule oreachable_local')
      from tr and sp have tr': "((\<sigma>, p), a, (\<sigma>', q)) \<in> oseqp_sos \<Gamma> i" by simp
      then obtain p' where "p' \<in> sterms \<Gamma> p"
                       and A4: "((\<sigma>, p'), a, (\<sigma>', q)) \<in> oseqp_sos \<Gamma> i"
        by (blast dest: otrans_from_sterms [OF _ wf])
      from wf cw sp sr this(1) have A1: "p'\<in>cterms \<Gamma>"
        by (rule oseq_reachable_in_cterms)
      from labels_not_empty [OF wf] obtain ll where A2: "ll\<in>labels \<Gamma> p'"
          by blast
      with \<open>p'\<in>sterms \<Gamma> p\<close> have "ll\<in>labels \<Gamma> p"
        by (rule labels_sterms_labels [OF wf])
      with pl have A3: "P (\<sigma>, ll)" by simp
      from sr \<open>p'\<in>sterms \<Gamma> p\<close>
        obtain pp where A7: "(\<sigma>, pp)\<in>oreachable A S U"
                    and A8: "p'\<in>sterms \<Gamma> pp"
        by auto
      from sr tr \<open>S \<sigma> \<sigma>' a\<close> have A9: "(\<sigma>', q)\<in>oreachable A S U"
        by - (rule oreachable_local')
      from sp and \<open>((\<sigma>, p'), a, (\<sigma>', q)) \<in> oseqp_sos \<Gamma> i\<close>
        have A5: "((\<sigma>, p'), a, (\<sigma>', q)) \<in> trans A" by simp
      from A1 A2 A3 A4 A5 A6 A7 A8 A9 \<open>S \<sigma> \<sigma>' a\<close> show ?thesis by (rule local)
    qed
  next
    fix \<sigma> \<sigma>' p l
    assume sr: "(\<sigma>, p) \<in> oreachable A S U"
       and "\<forall>l\<in>labels \<Gamma> p. P (\<sigma>, l)"
       and "U \<sigma> \<sigma>'"
    show "\<forall>l\<in>labels \<Gamma> p. P (\<sigma>', l)"
    proof
      fix l
      assume "l\<in>labels \<Gamma> p"
      with \<open>\<forall>l\<in>labels \<Gamma> p. P (\<sigma>, l)\<close> have "P (\<sigma>, l)" ..
      with sr and \<open>l\<in>labels \<Gamma> p\<close>
        show "P (\<sigma>', l)" using \<open>U \<sigma> \<sigma>'\<close> by (rule other)
    qed
  qed

lemma oseq_invariant_ctermsI:
  assumes wf: "wellformed \<Gamma>"
      and cw: "control_within \<Gamma> (init A)"
      and sl: "simple_labels \<Gamma>"
      and sp: "trans A = oseqp_sos \<Gamma> i"
      and init: "\<And>\<sigma> p l. \<lbrakk>
                   (\<sigma>, p) \<in> init A;
                   l\<in>labels \<Gamma> p
                 \<rbrakk> \<Longrightarrow> P (\<sigma>, l)"
      and other: "\<And>\<sigma> \<sigma>' p l. \<lbrakk>
                   wellformed \<Gamma>;
                   (\<sigma>, p) \<in> oreachable A S U;
                   l\<in>labels \<Gamma> p;
                   P (\<sigma>, l);
                   U \<sigma> \<sigma>' \<rbrakk> \<Longrightarrow> P (\<sigma>', l)"
      and local: "\<And>p l \<sigma> a q l' \<sigma>' pp pn. \<lbrakk>
                 wellformed \<Gamma>;
                 p\<in>ctermsl (\<Gamma> pn);
                 not_call p;
                 l\<in>labels \<Gamma> p;
                 P (\<sigma>, l);
                 ((\<sigma>, p), a, (\<sigma>', q)) \<in> oseqp_sos \<Gamma> i;
                 ((\<sigma>, p), a, (\<sigma>', q)) \<in> trans A;
                 l'\<in>labels \<Gamma> q;
                 (\<sigma>, pp)\<in>oreachable A S U;
                 p\<in>sterms \<Gamma> pp;
                 (\<sigma>', q)\<in>oreachable A S U;
                 S \<sigma> \<sigma>' a
               \<rbrakk> \<Longrightarrow> P (\<sigma>', l')"
    shows "A \<Turnstile> (S, U \<rightarrow>) onl \<Gamma> P"
  proof (rule oseq_invariant_ctermI [OF wf cw sl sp])
    fix \<sigma> p l
    assume "(\<sigma>, p) \<in> init A"
       and "l \<in> labels \<Gamma> p"
    thus "P (\<sigma>, l)" by (rule init)
  next
    fix \<sigma> \<sigma>' p l
    assume "(\<sigma>, p) \<in> oreachable A S U"
       and "l \<in> labels \<Gamma> p"
       and "P (\<sigma>, l)"
       and "U \<sigma> \<sigma>'"
    with wf show "P (\<sigma>', l)" by (rule other)
  next
    fix p l \<sigma> a q l' \<sigma>' pp
    assume "p \<in> cterms \<Gamma>"
       and otherassms: "l \<in> labels \<Gamma> p"
           "P (\<sigma>, l)"
           "((\<sigma>, p), a, (\<sigma>', q)) \<in> oseqp_sos \<Gamma> i"
           "((\<sigma>, p), a, (\<sigma>', q)) \<in> trans A"
           "l' \<in> labels \<Gamma> q"
           "(\<sigma>, pp) \<in> oreachable A S U"
           "p \<in> sterms \<Gamma> pp"
           "(\<sigma>', q) \<in> oreachable A S U"
           "S \<sigma> \<sigma>' a"
    from this(1) obtain pn where "p \<in> ctermsl(\<Gamma> pn)"
                             and "not_call p"
      unfolding cterms_def' [OF wf] by auto
    with wf show "P (\<sigma>', l')"
      using otherassms by (rule local)
  qed

subsection "Open step invariants via labelled control terms"

lemma onll_ostep_invariantI [intro]:
  assumes *: "\<And>\<sigma> p l a \<sigma>' p' l'. \<lbrakk> (\<sigma>, p)\<in>oreachable A S U;
                                   ((\<sigma>, p), a, (\<sigma>', p')) \<in> trans A;
                                   S \<sigma> \<sigma>' a;
                                   l \<in>labels \<Gamma> p;
                                   l'\<in>labels \<Gamma> p' \<rbrakk>
                                 \<Longrightarrow> P ((\<sigma>, l), a, (\<sigma>', l'))"
    shows "A \<Turnstile>\<^sub>A (S, U \<rightarrow>) onll \<Gamma> P"
  proof
    fix \<sigma> p \<sigma>' p' a
    assume "(\<sigma>, p) \<in> oreachable A S U"
       and "((\<sigma>, p), a, (\<sigma>', p')) \<in> trans A"
       and "S \<sigma> \<sigma>' a"
    hence "\<forall>l\<in>labels \<Gamma> p. \<forall>l'\<in>labels \<Gamma> p'. P ((\<sigma>, l), a, (\<sigma>', l'))" by (auto elim!: *)
    thus "onll \<Gamma> P ((\<sigma>, p), a, (\<sigma>', p'))" ..
  qed

lemma onll_ostep_invariantE [elim]:
  assumes "A \<Turnstile>\<^sub>A (S, U \<rightarrow>) onll \<Gamma> P"
      and "(\<sigma>, p) \<in> oreachable A S U"
      and "((\<sigma>, p), a, (\<sigma>', p')) \<in> trans A"
      and "S \<sigma> \<sigma>' a"
      and lp:  "l \<in>labels \<Gamma> p"
      and lp': "l'\<in>labels \<Gamma> p'"
    shows "P ((\<sigma>, l), a, (\<sigma>', l'))"
  proof -
    from assms(1-4) have "onll \<Gamma> P ((\<sigma>, p), a, (\<sigma>', p'))" ..
    with lp lp' show "P ((\<sigma>, l), a, (\<sigma>', l'))" by auto
  qed

lemma onll_ostep_invariantD [dest]:
  assumes "A \<Turnstile>\<^sub>A (S, U \<rightarrow>) onll \<Gamma> P"
      and "(\<sigma>, p) \<in> oreachable A S U"
      and "((\<sigma>, p), a, (\<sigma>', p')) \<in> trans A"
      and "S \<sigma> \<sigma>' a"
    shows "\<forall>l\<in>labels \<Gamma> p. \<forall>l'\<in>labels \<Gamma> p'. P ((\<sigma>, l), a, (\<sigma>', l'))"
  using assms by auto

lemma onll_ostep_invariant_weakenD [dest]:
  assumes "A \<Turnstile>\<^sub>A (S', U' \<rightarrow>) onll \<Gamma> P"
      and "(\<sigma>, p) \<in> oreachable A S U"
      and "((\<sigma>, p), a, (\<sigma>', p')) \<in> trans A"
      and "S' \<sigma> \<sigma>' a"
      and weakenS: "\<And>s s' a. S s s' a \<Longrightarrow> S' s s' a"
      and weakenU: "\<And>s s'. U s s' \<Longrightarrow> U' s s'"
    shows "\<forall>l\<in>labels \<Gamma> p. \<forall>l'\<in>labels \<Gamma> p'. P ((\<sigma>, l), a, (\<sigma>', l'))"
  proof -
    from \<open>(\<sigma>, p) \<in> oreachable A S U\<close> have "(\<sigma>, p) \<in> oreachable A S' U'"
      by (rule oreachable_weakenE)
         (erule weakenS, erule weakenU)
    with \<open>A \<Turnstile>\<^sub>A (S', U' \<rightarrow>) onll \<Gamma> P\<close> show ?thesis
      using \<open>((\<sigma>, p), a, (\<sigma>', p')) \<in> trans A\<close> and \<open>S' \<sigma> \<sigma>' a\<close> ..
  qed

lemma onll_ostep_to_invariantI [intro]:
  assumes sinv: "A \<Turnstile>\<^sub>A (S, U \<rightarrow>) onll \<Gamma> Q"
      and wf: "wellformed \<Gamma>"
      and init: "\<And>\<sigma> l p. \<lbrakk> (\<sigma>, p) \<in> init A; l\<in>labels \<Gamma> p \<rbrakk> \<Longrightarrow> P (\<sigma>, l)"
      and other: "\<And>\<sigma> \<sigma>' p l.
                    \<lbrakk> (\<sigma>, p) \<in> oreachable A S U;
                      l\<in>labels \<Gamma> p;
                      P (\<sigma>, l);
                      U \<sigma> \<sigma>' \<rbrakk> \<Longrightarrow> P (\<sigma>', l)"
      and local: "\<And>\<sigma> p l \<sigma>' l' a.
                    \<lbrakk> (\<sigma>, p) \<in> oreachable A S U;
                      l\<in>labels \<Gamma> p;
                      P (\<sigma>, l);
                      Q ((\<sigma>, l), a, (\<sigma>', l'));
                      S \<sigma> \<sigma>' a\<rbrakk> \<Longrightarrow> P (\<sigma>', l')"
    shows "A \<Turnstile> (S, U \<rightarrow>) onl \<Gamma> P"
  proof
    fix \<sigma> p l
    assume "(\<sigma>, p) \<in> init A" and "l\<in>labels \<Gamma> p"
      thus "P (\<sigma>, l)" by (rule init)
  next
    fix \<sigma> p a \<sigma>' p' l'
    assume sr: "(\<sigma>, p) \<in> oreachable A S U"
       and lp: "\<forall>l\<in>labels \<Gamma> p. P (\<sigma>, l)"
       and tr: "((\<sigma>, p), a, (\<sigma>', p')) \<in> trans A"
       and "S \<sigma> \<sigma>' a"
       and lp': "l' \<in> labels \<Gamma> p'"
      show "P (\<sigma>', l')"
    proof -
      from lp obtain l where "l\<in>labels \<Gamma> p" and "P (\<sigma>, l)"
        using labels_not_empty [OF wf] by auto
      from sinv sr tr \<open>S \<sigma> \<sigma>' a\<close> this(1) lp' have "Q ((\<sigma>, l), a, (\<sigma>', l'))" ..
      with sr \<open>l\<in>labels \<Gamma> p\<close> \<open>P (\<sigma>, l)\<close> show "P (\<sigma>', l')" using \<open>S \<sigma> \<sigma>' a\<close> by (rule local)
    qed
  next
    fix \<sigma> \<sigma>' p l
    assume "(\<sigma>, p) \<in> oreachable A S U"
       and "\<forall>l\<in>labels \<Gamma> p. P (\<sigma>, l)"
       and "U \<sigma> \<sigma>'"
      show "\<forall>l\<in>labels \<Gamma> p. P (\<sigma>', l)"
    proof
      fix l
      assume "l\<in>labels \<Gamma> p"
      with \<open>\<forall>l\<in>labels \<Gamma> p. P (\<sigma>, l)\<close> have "P (\<sigma>, l)" ..
      with \<open>(\<sigma>, p) \<in> oreachable A S U\<close> and \<open>l\<in>labels \<Gamma> p\<close>
      show "P (\<sigma>', l)" using \<open>U \<sigma> \<sigma>'\<close> by (rule other)
    qed
  qed

lemma onll_ostep_invariant_sterms:
  assumes wf: "wellformed \<Gamma>"
      and si: "A \<Turnstile>\<^sub>A (S, U \<rightarrow>) onll \<Gamma> P"
      and sr: "(\<sigma>, p) \<in> oreachable A S U"
      and sos: "((\<sigma>, p), a, (\<sigma>', q)) \<in> trans A"
      and "S \<sigma> \<sigma>' a"
      and "l'\<in>labels \<Gamma> q"
      and "p'\<in>sterms \<Gamma> p"
      and "l\<in>labels \<Gamma> p'"
    shows "P ((\<sigma>, l), a, (\<sigma>', l'))"
  proof -
    from wf \<open>p'\<in>sterms \<Gamma> p\<close> \<open>l\<in>labels \<Gamma> p'\<close> have "l\<in>labels \<Gamma> p"
      by (rule labels_sterms_labels)
    with si sr sos \<open>S \<sigma> \<sigma>' a\<close> show "P ((\<sigma>, l), a, (\<sigma>', l'))" using \<open>l'\<in>labels \<Gamma> q\<close> ..
  qed

lemma oseq_step_invariant_sterms:
  assumes inv: "A \<Turnstile>\<^sub>A (S, U \<rightarrow>) onll \<Gamma> P"
      and wf: "wellformed \<Gamma>"
      and sp: "trans A = oseqp_sos \<Gamma> i"
      and "l'\<in>labels \<Gamma> q"
      and sr: "(\<sigma>, p) \<in> oreachable A S U"
      and tr: "((\<sigma>, p'), a, (\<sigma>', q)) \<in> trans A"
      and "S \<sigma> \<sigma>' a"
      and "p'\<in>sterms \<Gamma> p"
    shows "\<forall>l\<in>labels \<Gamma> p'. P ((\<sigma>, l), a, (\<sigma>', l'))"
  proof
    from assms(3, 6) have "((\<sigma>, p'), a, (\<sigma>', q)) \<in> oseqp_sos \<Gamma> i" by simp
    hence "((\<sigma>, p), a, (\<sigma>', q)) \<in> oseqp_sos \<Gamma> i"
      using wf \<open>p'\<in>sterms \<Gamma> p\<close>  by (rule otrans_from_sterms')
    with assms(3) have trp: "((\<sigma>, p), a, (\<sigma>', q)) \<in> trans A" by simp
    fix l assume "l \<in> labels \<Gamma> p'"
    with wf inv sr trp \<open>S \<sigma> \<sigma>' a\<close> \<open>l'\<in>labels \<Gamma> q\<close> \<open>p'\<in>sterms \<Gamma> p\<close>
      show "P ((\<sigma>, l), a, (\<sigma>', l'))"
        by - (erule(7) onll_ostep_invariant_sterms)
  qed

lemma oseq_step_invariant_sterms_weaken:
  assumes inv: "A \<Turnstile>\<^sub>A (S, U \<rightarrow>) onll \<Gamma> P"
      and wf: "wellformed \<Gamma>"
      and sp: "trans A = oseqp_sos \<Gamma> i"
      and "l'\<in>labels \<Gamma> q"
      and sr: "(\<sigma>, p) \<in> oreachable A S' U'"
      and tr: "((\<sigma>, p'), a, (\<sigma>', q)) \<in> trans A"
      and "S' \<sigma> \<sigma>' a"
      and "p'\<in>sterms \<Gamma> p"
      and weakenS: "\<And>\<sigma> \<sigma>' a. S' \<sigma> \<sigma>' a \<Longrightarrow> S \<sigma> \<sigma>' a"
      and weakenU: "\<And>\<sigma> \<sigma>'. U' \<sigma> \<sigma>' \<Longrightarrow> U \<sigma> \<sigma>'"
    shows "\<forall>l\<in>labels \<Gamma> p'. P ((\<sigma>, l), a, (\<sigma>', l'))"
  proof -
    from \<open>S' \<sigma> \<sigma>' a\<close> have "S \<sigma> \<sigma>' a" by (rule weakenS)
    from \<open>(\<sigma>, p) \<in> oreachable A S' U'\<close>
      have Ir: "(\<sigma>, p) \<in> oreachable A S U"
        by (rule oreachable_weakenE)
           (erule weakenS, erule weakenU)
    with assms(1-4) show ?thesis
      using tr \<open>S \<sigma> \<sigma>' a\<close> \<open>p'\<in>sterms \<Gamma> p\<close>
      by (rule oseq_step_invariant_sterms)
  qed

lemma onll_ostep_invariant_any_sterms:
  assumes wf: "wellformed \<Gamma>"
      and si: "A \<Turnstile>\<^sub>A (S, U \<rightarrow>) onll \<Gamma> P"
      and sr: "(\<sigma>, p) \<in> oreachable A S U"
      and sos: "((\<sigma>, p), a, (\<sigma>', q)) \<in> trans A"
      and "S \<sigma> \<sigma>' a"
      and "l'\<in>labels \<Gamma> q"
    shows "\<forall>p'\<in>sterms \<Gamma> p. \<forall>l\<in>labels \<Gamma> p'. P ((\<sigma>, l), a, (\<sigma>', l'))"
  by (intro ballI) (rule onll_ostep_invariant_sterms [OF assms])

lemma oseq_step_invariant_ctermI [intro]:
  assumes wf: "wellformed \<Gamma>"
      and cw: "control_within \<Gamma> (init A)"
      and sl: "simple_labels \<Gamma>"
      and sp: "trans A = oseqp_sos \<Gamma> i"
      and local: "\<And>p l \<sigma> a q l' \<sigma>' pp. \<lbrakk>
                   p\<in>cterms \<Gamma>;
                   l\<in>labels \<Gamma> p;
                   ((\<sigma>, p), a, (\<sigma>', q)) \<in> oseqp_sos \<Gamma> i;
                   ((\<sigma>, p), a, (\<sigma>', q)) \<in> trans A;
                   l'\<in>labels \<Gamma> q;
                   (\<sigma>, pp) \<in> oreachable A S U;
                   p\<in>sterms \<Gamma> pp;
                   (\<sigma>', q) \<in> oreachable A S U;
                   S \<sigma> \<sigma>' a
                 \<rbrakk> \<Longrightarrow> P ((\<sigma>, l), a, (\<sigma>', l'))"
    shows "A \<Turnstile>\<^sub>A (S, U \<rightarrow>) onll \<Gamma> P"
  proof
       fix \<sigma> p l a \<sigma>' q l'
    assume sr: "(\<sigma>, p) \<in> oreachable A S U"
       and tr: "((\<sigma>, p), a, (\<sigma>', q)) \<in> trans A"
       and "S \<sigma> \<sigma>' a"
       and pl: "l \<in> labels \<Gamma> p"
       and A5: "l' \<in> labels \<Gamma> q"
    from this(2) and sp have "((\<sigma>, p), a, (\<sigma>', q)) \<in> oseqp_sos \<Gamma> i" by simp
    then obtain p' where "p' \<in> sterms \<Gamma> p"
                     and A3: "((\<sigma>, p'), a, (\<sigma>', q)) \<in> oseqp_sos \<Gamma> i"
      by (blast dest: otrans_from_sterms [OF _ wf])
    from this(2) and sp have A4: "((\<sigma>, p'), a, (\<sigma>', q)) \<in> trans A" by simp
    from wf cw sp sr \<open>p'\<in>sterms \<Gamma> p\<close> have A1: "p'\<in>cterms \<Gamma>"
      by (rule oseq_reachable_in_cterms)
    from sr \<open>p'\<in>sterms \<Gamma> p\<close>
      obtain pp where A6: "(\<sigma>, pp)\<in>oreachable A S U"
                  and A7: "p'\<in>sterms \<Gamma> pp"
      by auto
    from sr tr \<open>S \<sigma> \<sigma>' a\<close> have A8: "(\<sigma>', q)\<in>oreachable A S U"
      by - (erule(2) oreachable_local')
    from wf cw sp sr have "\<exists>pn. p \<in> subterms (\<Gamma> pn)"
      by (rule oreachable_subterms)
    with sl wf have "\<forall>p'\<in>sterms \<Gamma> p. l \<in> labels \<Gamma> p'"
      using pl by (rule simple_labels_in_sterms)
    with \<open>p' \<in> sterms \<Gamma> p\<close> have "l \<in> labels \<Gamma> p'" by simp
    with A1 show "P ((\<sigma>, l), a, (\<sigma>', l'))" using A3 A4 A5 A6 A7 A8 \<open>S \<sigma> \<sigma>' a\<close>
      by (rule local)
  qed

lemma oseq_step_invariant_ctermsI [intro]:
  assumes wf: "wellformed \<Gamma>"
      and "control_within \<Gamma> (init A)"
      and "simple_labels \<Gamma>"
      and "trans A = oseqp_sos \<Gamma> i"
      and local: "\<And>p l \<sigma> a q l' \<sigma>' pp pn. \<lbrakk>
                   wellformed \<Gamma>;
                   p\<in>ctermsl (\<Gamma> pn);
                   not_call p;
                   l\<in>labels \<Gamma> p;
                   ((\<sigma>, p), a, (\<sigma>', q)) \<in> oseqp_sos \<Gamma> i;
                   ((\<sigma>, p), a, (\<sigma>', q)) \<in> trans A;
                   l'\<in>labels \<Gamma> q;
                   (\<sigma>, pp) \<in> oreachable A S U;
                   p\<in>sterms \<Gamma> pp;
                   (\<sigma>', q) \<in> oreachable A S U;
                   S \<sigma> \<sigma>' a
                 \<rbrakk> \<Longrightarrow> P ((\<sigma>, l), a, (\<sigma>', l'))"
    shows "A \<Turnstile>\<^sub>A (S, U \<rightarrow>) onll \<Gamma> P"
  using assms(1-4) proof (rule oseq_step_invariant_ctermI)
    fix p l \<sigma> a q l' \<sigma>' pp
    assume "p \<in> cterms \<Gamma>"
       and otherassms: "l \<in> labels \<Gamma> p"
           "((\<sigma>, p), a, (\<sigma>', q)) \<in> oseqp_sos \<Gamma> i"
           "((\<sigma>, p), a, (\<sigma>', q)) \<in> trans A"
           "l' \<in> labels \<Gamma> q"
           "(\<sigma>, pp) \<in> oreachable A S U"
           "p \<in> sterms \<Gamma> pp"
           "(\<sigma>', q) \<in> oreachable A S U"
           "S \<sigma> \<sigma>' a"
    from this(1) obtain pn where "p \<in> ctermsl(\<Gamma> pn)"
                             and "not_call p"
      unfolding cterms_def' [OF wf] by auto
    with wf show "P ((\<sigma>, l), a, (\<sigma>', l'))"
      using otherassms by (rule local)
 qed

lemma open_seqp_action [elim]:
  assumes "wellformed \<Gamma>"
      and "((\<sigma> i, p), a, (\<sigma>' i, p')) \<in> seqp_sos \<Gamma>"
    shows "((\<sigma>, p), a, (\<sigma>', p')) \<in> oseqp_sos \<Gamma> i"
  proof -
    from assms obtain ps where "ps\<in>sterms \<Gamma> p"
                           and "((\<sigma> i, ps), a, (\<sigma>' i, p')) \<in> seqp_sos \<Gamma>"
      by - (drule trans_from_sterms, auto)
    thus ?thesis
    proof (induction p)
      fix p1 p2
      assume "\<lbrakk> ps \<in> sterms \<Gamma> p1; ((\<sigma> i, ps), a, \<sigma>' i, p') \<in> seqp_sos \<Gamma> \<rbrakk>
              \<Longrightarrow> ((\<sigma>, p1), a, (\<sigma>', p')) \<in> oseqp_sos \<Gamma> i"
         and "\<lbrakk> ps \<in> sterms \<Gamma> p2; ((\<sigma> i, ps), a, \<sigma>' i, p') \<in> seqp_sos \<Gamma> \<rbrakk>
              \<Longrightarrow> ((\<sigma>, p2), a, (\<sigma>', p')) \<in> oseqp_sos \<Gamma> i"
         and "ps \<in> sterms \<Gamma> (p1 \<oplus> p2)"
         and "((\<sigma> i, ps), a, (\<sigma>' i, p')) \<in> seqp_sos \<Gamma>"
      with assms(1) show "((\<sigma>, p1 \<oplus> p2), a, (\<sigma>', p')) \<in> oseqp_sos \<Gamma> i"
        by simp (metis oseqp_sos.ochoiceT1 oseqp_sos.ochoiceT2)
    next
      fix l fip fmsg p1 p2
      assume IH1: "\<lbrakk> ps \<in> sterms \<Gamma> p1; ((\<sigma> i, ps), a, \<sigma>' i, p') \<in> seqp_sos \<Gamma> \<rbrakk>
                    \<Longrightarrow> ((\<sigma>, p1), a, (\<sigma>', p')) \<in> oseqp_sos \<Gamma> i"
         and IH2: "\<lbrakk> ps \<in> sterms \<Gamma> p2; ((\<sigma> i, ps), a, \<sigma>' i, p') \<in> seqp_sos \<Gamma> \<rbrakk>
                    \<Longrightarrow> ((\<sigma>, p2), a, (\<sigma>', p')) \<in> oseqp_sos \<Gamma> i"
         and "ps \<in> sterms \<Gamma> ({l}unicast(fip, fmsg). p1 \<triangleright> p2)"
         and "((\<sigma> i, ps), a, (\<sigma>' i, p')) \<in> seqp_sos \<Gamma>"
      from this(3-4) have "((\<sigma> i, {l}unicast(fip, fmsg). p1 \<triangleright> p2), a, (\<sigma>' i, p')) \<in> seqp_sos \<Gamma>"
        by simp
      thus "((\<sigma>, {l}unicast(fip, fmsg). p1 \<triangleright> p2), a, (\<sigma>', p')) \<in> oseqp_sos \<Gamma> i"
      proof (rule seqp_unicastTE)
        assume "a = unicast (fip (\<sigma> i)) (fmsg (\<sigma> i))"
           and "\<sigma>' i = \<sigma> i"
           and "p' = p1"
        thus ?thesis by auto
      next
        assume "a = \<not>unicast (fip (\<sigma> i))"
           and "\<sigma>' i = \<sigma> i"
           and "p' = p2"
        thus ?thesis by auto
      qed
    next
      fix p
      assume "ps \<in> sterms \<Gamma> (call(p))"
         and "((\<sigma> i, ps), a, (\<sigma>' i, p')) \<in> seqp_sos \<Gamma>"
      with assms(1) have "((\<sigma>, ps), a, (\<sigma>', p')) \<in> oseqp_sos \<Gamma> i"
        by (cases ps) auto
      with assms(1) \<open>ps \<in> sterms \<Gamma> (call(p))\<close> have "((\<sigma>, \<Gamma> p), a, (\<sigma>', p')) \<in> oseqp_sos \<Gamma> i"
        by - (rule otrans_from_sterms', simp_all)
      thus "((\<sigma>, call(p)), a, (\<sigma>', p')) \<in> oseqp_sos \<Gamma> i" by auto
    qed auto
  qed

end


           (*-------------------------------------------*
            |        CSP-Prover on Isabelle2004         |
            |                    May 2005               |
            |                   June 2005  (modified)   |
            |              September 2005  (modified)   |
            |                                           |
            |        CSP-Prover on Isabelle2005         |
            |               November 2005  (modified)   |
            |                  April 2006  (modified)   |
            |                  March 2007  (modified)   |
            |                                           |
            |        Yoshinao Isobe (AIST JAPAN)        |
            *-------------------------------------------*)

theory CSP_F_op_rep_par
imports CSP_F_op_alpha_par CSP_T_op_rep_par
begin

(*  The following simplification rules are deleted in this theory file *)
(*  because they unexpectly rewrite UnionT and InterT.                 *)
(*                  Union (B ` A) = (UN x:A. B x)                      *)
(*                  Inter (B ` A) = (INT x:A. B x)                     *)

(*
declare Union_image_eq [simp del]
declare Inter_image_eq [simp del]
*)

declare Sup_image_eq [simp del]
declare Inf_image_eq [simp del]

(*  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]

(*============================================================*
 |                                                            |
 |            replicated alphabetized parallel                |
 |                                                            |
 *============================================================*)

(*** Inductive_parallel ***)

lemma in_failures_Inductive_parallel_lm1:
       "Y Int insert Tick (Ev ` snd a) Un
        Union {Y Int insert Tick (Ev ` X) |X Y. EX P. ((P, X), Y) : set PXYs} =
          Union {Ya Int insert Tick (Ev ` X) |X Ya.
                 EX P. P = fst a & X = snd a & Ya = Y | ((P, X), Ya) : set PXYs}"
by (auto)

lemma in_failures_Inductive_parallel_lm2:
  "((P, X), Y) : set s ==> X <= Union (snd ` fst ` set s)"
apply (auto)
apply (rule_tac x="((P, X), Y)" in bexI)
by (simp_all)

lemma in_failures_Inductive_parallel_lm3:
   "Union {Y Int insert Tick (Ev ` X) |X Y. EX P. ((P, X), Y) : set zs} <=
    insert Tick (Ev ` Union (snd ` fst ` set zs))"
apply (rule)
apply (simp)
apply (elim conjE exE)
apply (simp)
apply (elim conjE disjE)
apply (simp)
apply (rule disjI2)
apply (auto)
apply (simp add: image_iff)
apply (rule_tac x="((P, X), Y)" in bexI)
apply (auto)
done

lemma in_failures_Inductive_parallel_lm4:
   "Union {Y Int insert Tick (Ev ` X) |X Y. EX P. ((P, X), Y) : set zs} Int
    insert Tick (Ev ` Union (snd ` fst ` set zs))
    = Union {Y Int insert Tick (Ev ` X) |X Y. EX P. ((P, X), Y) : set zs}"
apply (rule Int_subset_eq)
apply (simp add: in_failures_Inductive_parallel_lm3)
done

(* main *)

lemma in_failures_Inductive_parallel_lm:
 "PXs ~= [] --> (ALL f.
   (f :f failures([||] PXs) M) =
         (EX u. (sett(u) <= insert Tick (Ev ` Union (snd ` set PXs)) &
          (EX Z. f = (u, Z) &
          (EX PXYs. map fst PXYs = PXs &
          (Z Int insert Tick (Ev ` Union (snd ` set PXs))
           = Union {(Y Int insert Tick (Ev ` X))|X Y. EX P. ((P,X),Y) : set PXYs} &
          (ALL P X Y. ((P,X),Y) : set PXYs --> ((u rest-tr X), Y) :f failures(P) M)))))))"
apply (induct_tac PXs)

(* case 0 *)
 apply (simp)

(* case 1 *)
 apply (case_tac "list = []")
 apply (simp)
 apply (intro allI)
 apply (simp add: in_failures_Alpha_parallel)
 apply (simp add: in_failures)
 apply (rule iffI)
 (* => *)
  apply (elim conjE exE)
  apply (simp)
  apply (erule disjE)

   apply (rule_tac x="[(a,Y)]" in exI)
   apply (simp)

    apply (rule conjI)
    apply (simp add: Evset_def pair_eq_decompo)
    apply (fast)
    apply (intro allI impI)
    apply (simp add: pair_eq_decompo)

   apply (case_tac "Tick ~: Z")
    apply (rule_tac x="[(a,Y)]" in exI)
    apply (simp add: Evset_def pair_eq_decompo)
(*    apply (fast) *)
   (* Tick : Z *)
    apply (rule_tac x="[(a,insert Tick Y)]" in exI)
    apply (simp)

    apply (simp add: rest_tr_Tick_sett)
    apply (elim conjE exE)
    apply (simp add: pair_eq_decompo)
    apply (rule conjI)
    apply (fast)
    apply (rule proc_T2_T3, simp)
    apply (simp)

 (* <= *)
  apply (elim conjE exE)
  apply (simp)
  apply (subgoal_tac "EX bb. PXYs=[(a,bb)]")
  apply (elim conjE exE)
  apply (subgoal_tac "aa rest-tr {} = <> | aa rest-tr {} = <Tick>")
  apply (erule disjE)

   (* <> *)
   apply (rule_tac x="bb" in exI)
   apply (rule_tac x="{}" in exI)
   apply (simp add: pair_eq_decompo)

   (* <Tick> *)
   apply (rule_tac x="bb" in exI)
   apply (rule_tac x="{}" in exI)
   apply (simp add: pair_eq_decompo)

   apply (simp add: rest_tr_empty)
   apply (force)

(* step case *)
apply (simp add: in_failures_Alpha_parallel)
apply (intro allI impI)
apply (rule iffI)

(* => *)
 apply (elim conjE exE, simp)
 apply (rule_tac x="(a,Y) # PXYs" in exI)
 apply (simp add: pair_eq_decompo)
 apply (simp add: in_failures_Inductive_parallel_lm1)

 apply (intro allI impI)
 apply (drule_tac x="P" in spec)
 apply (drule_tac x="X" in spec)
 apply (drule_tac x="Ya" in spec)
 apply (simp)
 apply (subgoal_tac "X <= Union (snd ` set list)")
 apply (simp add: rest_tr_of_rest_tr_subset)

 apply (rotate_tac -4)
 apply (drule sym)
 apply (simp add: in_failures_Inductive_parallel_lm2)

(* <= *)
 apply (simp)
 apply (elim conjE exE)

 apply (subgoal_tac "EX bb zs. PXYs = (a, bb) # zs & map fst zs = list")
 apply (elim conjE exE)
 apply (rule_tac x="bb" in exI)
 apply (rule_tac x=
    "Union {Y Int insert Tick (Ev ` X) |X Y. EX P. ((P, X), Y) : set zs}" in exI)
 apply (simp)
 apply (rule conjI)
 apply (simp add: pair_eq_decompo)
 apply (rotate_tac -1)
 apply (drule sym)
 apply (simp)
 apply (simp add: in_failures_Inductive_parallel_lm4)
 apply (simp add: in_failures_Inductive_parallel_lm1)

 apply (rule_tac x="zs" in exI)
 apply (rotate_tac -1)
 apply (drule sym)
 apply (simp add: in_failures_Inductive_parallel_lm4)

 apply (intro allI impI)
 apply (subgoal_tac "X <= Union (snd ` set list)")
 apply (simp add: rest_tr_of_rest_tr_subset)
 apply (simp add: in_failures_Inductive_parallel_lm2)
apply (auto)
done

(*** remove ALL ***)

lemma in_failures_Inductive_parallel:
 "PXs ~= [] ==>
   (f :f failures([||] PXs) M) =
         (EX u. (sett(u) <= insert Tick (Ev ` Union (snd ` set PXs)) &
          (EX Z. f = (u, Z) &
          (EX PXYs. map fst PXYs = PXs &
          (Z Int insert Tick (Ev ` Union (snd ` set PXs))
           = Union {(Y Int insert Tick (Ev ` X))|X Y. EX P. ((P,X),Y) : set PXYs} &
          (ALL P X Y. ((P,X),Y) : set PXYs --> ((u rest-tr X), Y) :f failures(P) M))))))"
by (simp add: in_failures_Inductive_parallel_lm)

(*** Semantics for replicated alphabetized parallel on F ***)

lemma failures_Inductive_parallel:
  "PXs ~= []
   ==> failures([||] PXs) M =
      {f. (EX u. (sett(u) <= insert Tick (Ev ` Union (snd ` set PXs)) &
          (EX Z. f = (u, Z) &
          (EX PXYs. map fst PXYs = PXs &
          (Z Int insert Tick (Ev ` Union (snd ` set PXs))
           = Union {(Y Int insert Tick (Ev ` X))|X Y. EX P. ((P,X),Y) : set PXYs} &
          (ALL P X Y. ((P,X),Y) : set PXYs --> ((u rest-tr X), Y) :f failures(P) M))))))}f"
apply (simp add: in_failures_Inductive_parallel[THEN sym])
done

(************************************
 |              traces              |
 ************************************)

lemma sett_in_failures_Inductive_parallel:
  "[| PXs ~= [] ; (t,X) :f failures([||] PXs) M |]
   ==> sett t <= insert Tick (Ev ` Union (snd ` set PXs))"
by (simp add: in_failures_Inductive_parallel)

(*---------------------------------------------------------*
 |        another expression of Inductive_parallel_eval          |
 *---------------------------------------------------------*)

lemma in_failures_Inductive_parallel_nth:
 "PXs ~= [] ==>
   (f :f failures([||] PXs) M) =
         (EX u. (sett(u) <= insert Tick (Ev ` Union (snd ` set PXs)) &
          (EX Z. f = (u, Z) &
          (EX Ys. length PXs = length Ys &
          (Z Int insert Tick (Ev ` Union (snd ` set PXs))
           = Union {((Ys!i) Int insert Tick (Ev ` (snd (PXs!i))))|i. i < length PXs} &
          (ALL i. i < length PXs --> ((u rest-tr (snd (PXs!i))), Ys!i) :f
            failures(fst (PXs!i)) M))))))"
apply (simp add: in_failures_Inductive_parallel)
apply (simp add: set_nth)
apply (rule iffI)

(* => *)
 apply (elim conjE exE)
 apply (simp)
 apply (rule_tac x="map snd PXYs" in exI)
 apply (simp)
 apply (rotate_tac 3)
 apply (drule sym)
 apply (simp)
 apply (rule conjI)
 apply (simp add: pair_eq_decompo)

 apply (rule equalityI)
 (* <= *)
  apply (rule)
  apply (simp)
  apply (elim conjE exE)
  apply (simp)
  apply (elim conjE disjE)
   apply (simp)
   apply (rule_tac x="map snd PXYs ! i Int
                      insert Tick (Ev ` snd (map fst PXYs ! i))" in exI)
   apply (simp)
   apply (rule_tac x="i" in exI)
   apply (simp)

   apply (rule_tac x="map snd PXYs ! i Int
                      insert Tick (Ev ` snd (map fst PXYs ! i))" in exI)
   apply (simp)
   apply (rule_tac x="i" in exI)
   apply (simp)

 (* => *)
  apply (rule)
  apply (simp)
  apply (elim conjE exE)
  apply (simp)
  apply (elim conjE disjE)
   apply (simp)
   apply (rule_tac x=
     "(snd (PXYs ! i)) Int insert Tick (Ev ` snd (fst (PXYs ! i)))" in exI)
   apply (simp)
   apply (rule_tac x="snd (fst (PXYs ! i))" in exI)
   apply (rule_tac x="snd (PXYs ! i)" in exI)
   apply (simp)
   apply (rule_tac x="i" in exI)
   apply (simp)

   apply (rule_tac x=
     "(snd (PXYs ! i)) Int insert Tick (Ev ` snd (fst (PXYs ! i)))" in exI)
   apply (simp)
   apply (rule_tac x="snd (fst (PXYs ! i))" in exI)
   apply (rule_tac x="snd (PXYs ! i)" in exI)
   apply (simp)
   apply (rule_tac x="i" in exI)
   apply (simp)

  apply (intro allI impI)
  apply (drule_tac x="fst (fst (PXYs ! i))" in spec)
  apply (drule_tac x="snd (fst (PXYs ! i))" in spec)
  apply (drule_tac x="snd (PXYs ! i)" in spec)
  apply (simp)
  apply (fast)

 (* => *)
 apply (elim conjE exE)
 apply (simp)
 apply (rule_tac x="zip PXs Ys" in exI)
 apply (simp add: map_fst_zip_eq)

 apply (rule conjI)
 apply (simp add: pair_eq_decompo)

 apply (rule equalityI)
 (* <= *)
  apply (rule)
  apply (simp)
  apply (elim conjE exE)
  apply (simp)
  apply (elim conjE disjE)
   apply (simp)
   apply (rule_tac x="Ys ! i Int insert Tick (Ev ` snd (PXs ! i))" in exI)
   apply (simp)
   apply (rule_tac x="snd (PXs ! i)" in exI)
   apply (rule_tac x="Ys ! i" in exI)
   apply (simp)
   apply (rule_tac x="i" in exI)
   apply (simp)

   apply (rule_tac x="Ys ! i Int insert Tick (Ev ` snd (PXs ! i))" in exI)
   apply (simp)
   apply (rule_tac x="snd (PXs ! i)" in exI)
   apply (rule_tac x="Ys ! i" in exI)
   apply (simp)
   apply (rule_tac x="i" in exI)
   apply (simp)

 (* => *)
  apply (rule)
  apply (simp)
  apply (elim conjE exE)
  apply (simp)
  apply (elim conjE disjE)
   apply (simp)
   apply (rule_tac x="Ys ! i Int insert Tick (Ev ` snd (PXs ! i))" in exI)
   apply (simp)
   apply (rule_tac x="i" in exI)
   apply (simp)

   apply (rule_tac x="Ys ! i Int insert Tick (Ev ` snd (PXs ! i))" in exI)
   apply (simp)
   apply (rule_tac x="i" in exI)
   apply (simp)

  apply (intro allI impI)
  apply (elim conjE exE)
  apply (drule_tac x="i" in spec)
  apply (simp add: pair_eq_decompo)
done

(*============================================================*
 |                                                            |
 |              indexed alphabetized parallel                 |
 |                                                            |
 *============================================================*)

(*** failures Inductive_parallel ***)

lemma in_failures_Rep_parallel_lm1:
  "[| Is isListOf I ; length Ys = length Is |] ==>
    Union {(Ys ! i Int insert Tick (Ev ` snd (map PXf Is ! i))) |i. i < length Ys} =
    Union {(Ys ! (THE n. Is ! n = i & n < length Is) Int
            insert Tick (Ev ` snd (PXf i))) | i. i : I}"
apply (rule)

 (* <= *)
 apply (rule)
 apply (simp)
 apply (elim conjE exE)
 apply (rule_tac x=
   "Ys ! (THE n. Is ! n = (Is ! i) & n < length Is) Int
    insert Tick (Ev ` snd (PXf (Is ! i)))" in exI)
 apply (simp add: isListOf_THE_nth)
 apply (rule_tac x="(Is ! i)" in exI)
 apply (simp add: isListOf_THE_nth)
 apply (simp add: isListOf_nth_in_index)

 (* => *)
 apply (rule)
 apply (simp)
 apply (elim conjE exE)
 apply (simp)
 apply (erule isListOf_index_to_nthE)
 apply (drule_tac x="i" in bspec, simp)
 apply (elim conjE exE, simp)
 apply (simp add: isListOf_THE_nth)
 apply (rule_tac x=
   "Ys ! n Int insert Tick (Ev ` snd (PXf (Is ! n)))" in exI)
 apply (simp)
 apply (rule_tac x="n" in exI)
 apply (simp)
done

lemma in_failures_Rep_parallel_lm2:
  "Is isListOf I ==>
   Union {(Yf i Int insert Tick (Ev ` snd (PXf i))) |i. i : I} =
   Union {(map Yf Is ! i Int insert Tick (Ev ` snd (map PXf Is ! i))) |i. i < length Is}"
apply (rule)

 (* <= *)
 apply (rule)
 apply (simp)
 apply (elim conjE exE)
 apply (erule isListOf_index_to_nthE)
 apply (drule_tac x="i" in bspec, simp)
 apply (elim conjE exE, simp)
 apply (rule_tac x=
   "map Yf Is ! n Int insert Tick (Ev ` snd (map PXf Is ! n))" in exI)
 apply (simp)
 apply (rule_tac x="n" in exI)
 apply (simp)

 (* => *)
 apply (rule)
 apply (simp)
 apply (elim conjE exE)
 apply (rule_tac x= "Yf (Is!i) Int insert Tick (Ev ` snd (PXf (Is!i)))" in exI)
 apply (simp)
 apply (rule_tac x="(Is!i)" in exI)
 apply (simp add: isListOf_nth_in_index)
done

lemma in_failures_Rep_parallel:
  "[| I ~= {} ; finite I |]
   ==> (f :f failures ([||]:I PXf) M) =
         (EX u. (sett(u) <= insert Tick (Ev ` Union (snd ` PXf ` I)) &
          (EX Z. f = (u, Z) &
          (EX Yf.
          (Z Int insert Tick (Ev ` Union (snd ` PXf ` I))
           = Union {((Yf i) Int insert Tick (Ev ` (snd (PXf i))))|i. i : I} &
          (ALL i:I. ((u rest-tr (snd (PXf i))), Yf i) :f failures(fst (PXf i)) M))))))"
apply (simp add: Rep_parallel_def)
apply (subgoal_tac "EX Is. Is isListOf I")
apply (elim conjE exE)
apply (subgoal_tac "(map PXf (SOME Is. Is isListOf I)) ~= []")
apply (simp add: in_failures_Inductive_parallel_nth)
apply (rule someI2)
 apply (simp)
 apply (rule iffI)

  (* => *)
  apply (elim conjE exE)
  apply (rename_tac Is' Is u Z Ys)
  apply (rule_tac x="u" in exI)
  apply (simp add: isListOf_set_eq)
  apply (rule_tac x= "(%i. (Ys!(THE n. (Is!n) = i & n<length Is)))" in exI)
  apply (rule conjI)
  apply (simp add: in_failures_Rep_parallel_lm1)
  apply (rule ballI)

  apply (rotate_tac 4)
  apply (erule isListOf_index_to_nthE)
  apply (drule_tac x="i" in bspec, simp)
  apply (elim conjE exE, simp)

  apply (rotate_tac 2)
  apply (drule sym)
  apply (simp add: isListOf_THE_nth)

  (* <= *)
  apply (elim conjE exE)
  apply (rename_tac Is' Is u Z Yf)
  apply (rule_tac x="u" in exI)
  apply (simp add: isListOf_set_eq)
  apply (rule_tac x= "map Yf Is" in exI)
  apply (simp)
  apply (rule conjI)
  apply (rule in_failures_Rep_parallel_lm2, simp)
  apply (intro allI impI)
  apply (drule_tac x="Is ! i" in bspec)
  apply (simp add: isListOf_nth_in_index)
  apply (simp)

 apply (rule someI2)
 apply (simp)
 apply (simp add: isListOf_nonemptyset)

apply (simp add: isListOf_EX)
done

lemmas in_failures_par = in_failures_Alpha_parallel
                         in_failures_Inductive_parallel
                         in_failures_Rep_parallel

(*** Semantics for indexed alphabetized parallel on F ***)

lemma failures_Rep_parallel:
  "[| I ~= {} ; finite I |]
   ==> failures ([||]:I PXf) M =
      {f. (EX u. (sett(u) <= insert Tick (Ev ` Union (snd ` PXf ` I)) &
          (EX Z. f = (u, Z) &
          (EX Yf.
          (Z Int insert Tick (Ev ` Union (snd ` PXf ` I))
           = Union {((Yf i) Int insert Tick (Ev ` (snd (PXf i))))|i. i : I} &
          (ALL i:I. ((u rest-tr (snd (PXf i))), Yf i) :f failures(fst (PXf i)) M))))))}f"
apply (simp add: in_failures_Rep_parallel[THEN sym])
done

(************************************
 |              traces              |
 ************************************)

lemma sett_in_failures_Rep_parallel:
  "[| I ~= {} ; finite I ; (t,X) :f failures([||]:I PXf) M |]
   ==> sett t <= insert Tick (Ev ` Union (snd ` PXf ` I))"
by (simp add: in_failures_Rep_parallel)

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

declare disj_not1      [simp]
(*
declare Union_image_eq [simp]
declare Inter_image_eq [simp]
*)
declare Sup_image_eq [simp]
declare Inf_image_eq [simp]
end