(*
 * Copyright 2017, Data61
 * Commonwealth Scientific and Industrial Research Organisation (CSIRO)
 * ABN 41 687 119 230.
 *
 * 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(DATA61_BSD)
 *)

theory OG_Bare

imports
  "../lib/Hoare_Parallel/OG_Tactics"
  "../lib/Hoare_Parallel/Quote_Antiquote"
  "OG_More"
  No_OG_Syntax

begin

datatype 'a bare_com =
     BareParallel "('a bare_com option) list"
   | BareBasic "('a \<Rightarrow> 'a set)"
   | BareSeq "('a bare_com)"  "('a bare_com)"
   | BareCond1 "('a bexp)"  "('a bare_com)"  "('a bare_com)"
   | BareCond2 "('a bexp)"  "('a bare_com)"
   | BareWhile "('a bexp)"  "('a bare_com)"
   | BareAwait "('a bexp)"  "('a bare_com)"

fun
  extract_ann_prg :: "'a ann_com \<Rightarrow> 'a bare_com" and
  extract_prg :: "'a com \<Rightarrow> 'a bare_com"
where
  "extract_ann_prg (AnnBasic r f) = BareBasic f"
| "extract_ann_prg (AnnSeq c1 c2) = BareSeq (extract_ann_prg c1) (extract_ann_prg c2)"
| "extract_ann_prg (AnnCond1 r b c1 c2) = BareCond1 b (extract_ann_prg c1) (extract_ann_prg c2)"
| "extract_ann_prg (AnnCond2 r b c) = BareCond2 b (extract_ann_prg c)"
| "extract_ann_prg (AnnWhile r b i c) = BareWhile b (extract_ann_prg c)"
| "extract_ann_prg (AnnAwait r b c) = BareAwait b (extract_prg c)"

| "extract_prg (Parallel Ts) = BareParallel (map ((map_option extract_ann_prg)\<circ>fst) Ts)"
| "extract_prg (Basic f) = BareBasic f"
| "extract_prg (Seq c1 c2) = BareSeq (extract_prg c1) (extract_prg c2)"
| "extract_prg (Cond b c1 c2) = BareCond1 b (extract_prg c1) (extract_prg c2)"
| "extract_prg (While b i c) = BareWhile b (extract_prg c)"

  "extract_prg (Parallel Ts) = BareParallel (map ((map_option extract_ann_prg)\<circ>fst) Ts)"
  "extract_prg (Basic f) = BareBasic f"
  "extract_prg (Seq c1 c2) = BareSeq (extract_prg c1) (extract_prg c2)"
  "extract_prg (Cond b c1 c2) = BareCond1 b (extract_prg c1) (extract_prg c2)"
  "extract_prg (While b i c) = BareWhile b (extract_prg c)"
  "extract_prg (Parallel (map (\<lambda>i. (Some (cc i), q)) [j..<k])) =
          BareParallel (map (\<lambda>i. (Some (extract_ann_prg (cc i)))) [j..<k])"
  by simp_all

primrec await_paint :: "'a bexp \<Rightarrow> 'a bare_com \<Rightarrow> 'a bare_com" where
  "await_paint P (BareParallel Ts) = BareParallel (map (map_option (await_paint P)) Ts)"
| "await_paint P (BareBasic f) = (BareAwait P (BareBasic f))"
| "await_paint P (BareSeq c1 c2) =  (BareSeq (await_paint P c1) (await_paint P c2))"
| "await_paint P (BareCond1 bb c1 c2) = (BareCond1 bb (await_paint P c1) (await_paint P c2))"
| "await_paint P (BareCond2 bb c) = (BareCond2 bb (await_paint P c))"
| "await_paint P (BareWhile bb c) = (BareWhile bb (await_paint P c))"
| "await_paint P (BareAwait bb c) = (BareAwait (bb\<inter>P) c)"

definition
  oghoare_bare :: "'a assn \<Rightarrow> 'a assn\<Rightarrow> 'a bare_com \<Rightarrow> 'a assn \<Rightarrow> bool"  ("(\<parallel>-\<^sub>b _// _// _//_)" [60,90] 45)
where
  "\<parallel>-\<^sub>b I p c q \<equiv> \<exists> c'. extract_prg c' = c \<and> \<parallel>-\<^sub>i I p c' q"

lemma extract_ann_prg_add_inv:
  "extract_ann_prg (add_inv_assn_com I' c) = extract_ann_prg c"
  by (induct c) auto

lemma extract_prg_add_inv:
  "extract_prg (add_inv_com I' c) = extract_prg c"
  apply (induct c, simp_all add: add_inv_aux_def)
  apply (clarsimp split: option.splits)
  apply (rule extract_ann_prg_add_inv)
  done

lemma add_inv_assn_com_inter:
  "add_inv_assn_com (I \<inter> I') c =  add_inv_assn_com I (add_inv_assn_com I' c)"
  by (induct c, auto)

lemma add_inv_aux_inter:
  "add_inv_aux (I \<inter> I') c =  add_inv_aux I (add_inv_aux I' c)"
  apply (clarsimp simp: add_inv_aux_def split: option.splits prod.splits)
  apply (auto simp: add_inv_assn_com_inter)
  done

lemma add_inv_com_inter:
  "add_inv_com (I \<inter> I') c =  add_inv_com I (add_inv_com I' c)"
  by (induct c, simp_all add: add_inv_aux_inter)

lemma oghoare_bareI:
   "\<exists> c'. extract_prg c' = c \<and> \<parallel>-\<^sub>i (I\<inter>I') p c' q \<Longrightarrow> \<parallel>-\<^sub>b I p c q"
   apply (clarsimp simp: oghoare_bare_def)
   apply (rule_tac x="add_inv_com I' c'" in exI)
   apply (simp add: extract_prg_add_inv oghoare_inv_def add_inv_com_inter)
   done

text\<open>Syntax for commands and for assertions and boolean expressions in
 commands @{text com} and annotated commands @{text ann_com}.\<close>

abbreviation Skip :: "'a bare_com"  ("SKIP" 63)
  where "SKIP \<equiv> BareBasic (\<lambda>s. {s})"

notation
  BareSeq  ("_,,/ _" [55, 56] 55) and
  BareSeq  ("_;;/ _" [60,61] 60)

syntax
  "_Assign"      :: "idt \<Rightarrow> 'b \<Rightarrow> 'a bare_com"    ("(\<acute>_ :=/ _)" [70, 65] 61)

translations
  "\<acute>x := a" \<rightharpoonup> "CONST BareBasic \<guillemotleft>\<acute>(CONST DETERM (_update_name x (\<lambda>_. a)))\<guillemotright>"

abbreviation
  "update_var_b f S s \<equiv> (\<lambda>v. f (\<lambda>_. v) s) ` S"

syntax
  "_Pick"      :: "idt \<Rightarrow> 'b \<Rightarrow> 'a bare_com"    ("(\<acute>_ :\<in>/ _)" [70, 65] 61)

translations
  "\<acute>x :\<in> S" \<rightharpoonup> "CONST BareBasic \<guillemotleft>\<acute>(CONST update_var_b (_update_name x) S)\<guillemotright>"

syntax
  "_BareAwait"    :: "'a bexp  \<Rightarrow> 'a bare_com \<Rightarrow> 'a bare_com"
                    ("AWAIT _ //THEN /_ /END"  [0,0] 61)
  "_BareAtom"     :: "'a bare_com \<Rightarrow> 'a bare_com"   ("\<langle>_\<rangle>" [0] 61)
  "_BareWait"     :: "'a bexp \<Rightarrow> 'a bare_com"   ("WAIT _ END" [0] 61)

  "_BareCond"     :: "'a bexp \<Rightarrow> 'a bare_com \<Rightarrow> 'a bare_com \<Rightarrow> 'a bare_com"
                    ("IF _ //(2THEN _) //(2ELSE _) /FI" [0, 0, 0] 61)

  "_BareCond2"    :: "'a bexp  \<Rightarrow> 'a bare_com \<Rightarrow> 'a bare_com"
                    ("IF _ //(2THEN _) /FI"  [0,0] 56)
  "_BareWhile"       :: "'a bexp \<Rightarrow> 'a bare_com \<Rightarrow> 'a bare_com"
                    ("(0WHILE _ /(0DO _ /OD))"  [0, 0] 61)

translations
  "IF b THEN c1 ELSE c2 FI" \<rightharpoonup> "CONST BareCond1 \<lbrace>b\<rbrace> c1 c2"
translations
  "IF b THEN c FI" \<rightleftharpoons>  "CONST BareCond2 \<lbrace>b\<rbrace> c"
translations
  "WHILE b DO c OD" \<rightleftharpoons> "CONST BareWhile \<lbrace>b\<rbrace> c"

translations
  "AWAIT b THEN c END" \<rightharpoonup> "CONST BareAwait \<lbrace>b\<rbrace> c"
  "\<langle>c\<rangle>" \<rightleftharpoons> "AWAIT CONST True THEN c END"
  "WAIT b END" \<rightleftharpoons> "AWAIT b THEN OG_Bare.SKIP END"

nonterminal prgs

syntax
  "_PAR" :: "prgs \<Rightarrow> 'a"              ("COBEGIN//_//COEND" [57] 56)
  "_prg" :: "'a \<Rightarrow> prgs"        ("_" [60] 57)
  "_prgs" :: "['a, prgs] \<Rightarrow> prgs"  ("_//\<parallel>//_" [60,57] 57)

  "_prg_scheme" :: "['a, 'a, 'a, 'a] \<Rightarrow> prgs"
                  ("SCHEME [_ \<le> _ < _] _" [0,0,0,60] 57)

translations
  "_prg c" \<rightleftharpoons> "[CONST Some c]"
  "_prgs c ps" \<rightleftharpoons> "(CONST Some c) # ps"
  "_PAR ps" \<rightleftharpoons> "CONST BareParallel ps"

  "_prg_scheme j i k c" \<rightleftharpoons> "CONST map (\<lambda>i. CONST Some c) [j..<k]"

print_translation \<open>
  let
    fun quote_tr' f (t :: ts) =
          Term.list_comb (f $ Syntax_Trans.quote_tr' @{syntax_const "_antiquote"} t, ts)
      | quote_tr' _ _ = raise Match;

    val assert_tr' = quote_tr' (Syntax.const @{syntax_const "_Assert"});

    fun bexp_tr' name ((Const (@{const_syntax Collect}, _) $ t) :: ts) =
          quote_tr' (Syntax.const name) (t :: ts)
      | bexp_tr' _ _ = raise Match;

    fun assign_tr' (Abs (x, _, Const (@{const_syntax DETERM}, _) $ (f $ (Const (@{const_syntax "Map.empty"}, _))) $ Bound 0) :: ts) =
           quote_tr' (Syntax.const @{syntax_const "_Assign"} $ Syntax_Trans.update_name_tr' f)
             (Abs (x, dummyT, Const (@{const_syntax None},dummyT)) :: ts)
      | assign_tr' (t as (Abs (x, _, Const (@{const_syntax DETERM},_) $ (f $ k) $ Bound 0)) :: ts) =
           quote_tr' (Syntax.const @{syntax_const "_Assign"} $ Syntax_Trans.update_name_tr' f)
             (Abs (x, dummyT, Syntax_Trans.const_abs_tr' k) :: ts)
      | assign_tr' (t as (Abs (x, _, Const (@{const_syntax update_var_b},_) $ f $ k $ Bound 0)) :: ts) =
           quote_tr' (Syntax.const @{syntax_const "_Pick"} $ Syntax_Trans.update_name_tr' f)
             (Abs (x, dummyT, k) :: ts)
      | assign_tr' _ = raise Match;

    fun Parallel_PAR [(Const (@{const_syntax Cons}, _) $
            (Const (@{const_syntax Some},_) $ t1 ) $
            Const (@{const_syntax Nil}, _))] = Syntax.const @{syntax_const "_prg"} $ t1
      | Parallel_PAR [(Const (@{const_syntax Cons}, _) $
            (Const (@{const_syntax Some}, _) $ t1) $ ts)] =
          Syntax.const @{syntax_const "_prgs"} $ t1 $ Parallel_PAR [ts]
      | Parallel_PAR _ = raise Match;

    fun Parallel_tr' ts = Syntax.const @{syntax_const "_PAR"} $ Parallel_PAR ts;
  in
   [(@{const_syntax Collect}, K assert_tr'),
    (@{const_syntax BareBasic}, K assign_tr'),
    (@{const_syntax BareCond1}, K (bexp_tr' @{syntax_const "_BareCond"})),
    (@{const_syntax BareCond2}, K (bexp_tr' @{syntax_const "_BareCond2"})),
    (@{const_syntax BareWhile}, K (bexp_tr' @{syntax_const "_BareWhile"})),
    (@{const_syntax BareAwait}, K (bexp_tr' @{syntax_const "_BareAwait"}))]
  end;
\<close>

end


(*
 * Copyright 2016, NICTA
 *
 * This software may be distributed and modified according to the terms of
 * the GNU General Public License version 2. Note that NO WARRANTY is provided.
 * See "LICENSE_GPLv2.txt" for details.
 *
 * @TAG(NICTA_GPL)
 *)

theory TypeProofTest
imports "CogentHelper" "ProofTrace"
begin

definition
  "foo_type \<equiv> Pair Nil (Pair (TRecord (Cons (Pair (TCon ''A'' Nil Writable) False) (Cons (Pair (TCon ''B'' Nil Writable) False) Nil)) Writable) (TRecord (Cons (Pair (TCon ''A'' Nil Writable) False) (Cons (Pair (TCon ''B'' Nil Writable) False) Nil)) Writable))"

definition
  "foo \<equiv> Let (Var 0) (Take (Var 0) 0 (Put (Var 1) 0 (Var 0)))"

definition
  "\<Xi> func_name' \<equiv> case func_name' of ''foo'' \<Rightarrow> foo_type"

lemma
  "\<Xi>, fst foo_type, [Some (fst (snd foo_type))] \<turnstile> foo : snd (snd foo_type)"
  (* proof script generated by Cogent compiler *)
  apply (simp add: foo_type_def foo_def)
  apply (rule typing_let)
  apply (rule split_cons)
  apply (rule split_comp.left)
  apply (tactic {* rtac @{thm kind_trec[where k="{E}"]} 1 *})
  apply (rule kind_record_cons1)
  apply (rule kind_tcon)
  apply (rule kind_all_empty)
  apply simp
  apply (rule kind_record_cons1)
  apply (rule kind_tcon)
  apply (rule kind_all_empty)
  apply simp
  apply (rule kind_record_empty)
  apply simp
  apply (rule split_empty)
  apply (rule typing_var)
  apply (simp add: weakening_def empty_def del: HOL.simp_thms(25) HOL.simp_thms(26))
  apply (rule keep)
  apply (rule_tac k="{E}" in kind_trec)
  apply (rule kind_record_cons1)
  apply (rule kind_tcon)
  apply (rule kind_all_empty)
  apply simp
  apply (rule kind_record_cons1)
  apply (rule kind_tcon)
  apply (rule kind_all_empty)
  apply simp
  apply (rule kind_record_empty)
  apply simp
  apply simp
  apply (rule typing_take)
  apply (rule split_cons)
  apply (rule split_comp.left)
  apply (rule_tac k="{E}" in kind_trec)
  apply (rule kind_record_cons1)
  apply (rule kind_tcon)
  apply (rule kind_all_empty)
  apply simp
  apply (rule kind_record_cons1)
  apply (rule kind_tcon)
  apply (rule kind_all_empty)
  apply simp
  apply (rule kind_record_empty)
  apply simp
  apply (rule split_cons)
  apply (rule split_comp.none)
  apply (rule split_empty)
  apply (rule typing_var)
  apply (simp add: weakening_def empty_def del: HOL.simp_thms(25) HOL.simp_thms(26))
  apply (rule conjI)
  apply (rule keep)
  apply (rule_tac k="{E}" in kind_trec)
  apply (rule kind_record_cons1)
  apply (rule kind_tcon)
  apply (rule kind_all_empty)
  apply simp
  apply (rule kind_record_cons1)
  apply (rule kind_tcon)
  apply (rule kind_all_empty)
  apply simp
  apply (rule kind_record_empty)
  apply simp
  apply (rule none)
  apply simp
  apply simp
  apply simp
  apply simp
  apply (rule_tac k="{E}" in kind_tcon)
  apply (rule kind_all_empty)
  apply simp
  apply (rule_tac Q=True in disjI2)
  apply simp
  apply simp
  apply (rule typing_put_better)
  apply (rule split_cons)
  apply (rule split_comp.right)
  apply (rule_tac k="{E}" in kind_tcon)
  apply (rule kind_all_empty)
  apply simp
  apply (rule split_cons)
  apply (rule split_comp.left)
  apply (rule_tac k="{E}" in kind_trec)
  apply (rule kind_record_cons2)
  apply (rule_tac k="{E}" in kind_tcon)
  apply (rule kind_all_empty)
  apply simp
  apply (rule kind_record_cons1)
  apply (rule kind_tcon)
  apply (rule kind_all_empty)
  apply simp
  apply (rule kind_record_empty)
  apply simp
  apply (rule split_cons)
  apply (rule split_comp.none)
  apply (rule split_cons)
  apply (rule split_comp.none)
  apply (rule split_empty)
  apply (rule typing_var)
  apply (simp add: weakening_def empty_def del: HOL.simp_thms(25) HOL.simp_thms(26))
  apply (rule conjI)
  apply (rule none)
  apply (rule conjI)
  apply (rule keep)
  apply (rule_tac k="{E}" in kind_trec)
  apply (rule kind_record_cons2)
  apply (rule_tac k="{E}" in kind_tcon)
  apply (rule kind_all_empty)
  apply simp
  apply (rule kind_record_cons1)
  apply (rule kind_tcon)
  apply (rule kind_all_empty)
  apply simp
  apply (rule kind_record_empty)
  apply simp
  apply (rule conjI)
  apply (rule none)
  apply (rule none)
  apply simp
  apply simp
  apply simp
  apply simp
  apply (rule_tac k="{E}" in kind_tcon)
  apply (rule kind_all_empty)
  apply simp
  apply (rule_tac Q=True in disjI2)
  apply simp
  apply (rule typing_var)
  apply (simp add: weakening_def empty_def del: HOL.simp_thms(25) HOL.simp_thms(26))
  apply (rule conjI)
  apply (rule keep)
  apply (rule_tac k="{E}" in kind_tcon)
  apply (rule kind_all_empty)
  apply simp
  apply (rule conjI)
  apply (rule none)
  apply (rule conjI)
  apply (rule none)
  apply (rule none)
  apply simp
  apply simp
  done

(* reflected proof script (pass through ParseTypeProof.hs) *)
ML {*
fun tacs ctxt =
[
("asm_full_simp_tac (ctxt addsimps [@{thm \"foo_type_def\"}, @{thm \"foo_def\"}])", asm_full_simp_tac (ctxt addsimps [@{thm "foo_type_def"}, @{thm "foo_def"}]) 1),
("rtac @{thm \"typing_let\"}", rtac @{thm "typing_let"} 1),
("rtac @{thm \"split_cons\"}", rtac @{thm "split_cons"} 1),
("rtac @{thm \"split_comp.left\"}", rtac @{thm "split_comp.left"} 1),
("rtac @{thm \"kind_trec\"[where k = \"{E}\"]}", rtac @{thm "kind_trec"[where k = "{E}"]} 1),
("rtac @{thm \"kind_record_cons1\"}", rtac @{thm "kind_record_cons1"} 1),
("rtac @{thm \"kind_tcon\"}", rtac @{thm "kind_tcon"} 1),
("rtac @{thm \"kind_all_empty\"}", rtac @{thm "kind_all_empty"} 1),
("asm_full_simp_tac ctxt", asm_full_simp_tac ctxt 1),
("rtac @{thm \"kind_record_cons1\"}", rtac @{thm "kind_record_cons1"} 1),
("rtac @{thm \"kind_tcon\"}", rtac @{thm "kind_tcon"} 1),
("rtac @{thm \"kind_all_empty\"}", rtac @{thm "kind_all_empty"} 1),
("asm_full_simp_tac ctxt", asm_full_simp_tac ctxt 1),
("rtac @{thm \"kind_record_empty\"}", rtac @{thm "kind_record_empty"} 1),
("asm_full_simp_tac ctxt", asm_full_simp_tac ctxt 1),
("rtac @{thm \"split_empty\"}", rtac @{thm "split_empty"} 1),
("rtac @{thm \"typing_var\"}", rtac @{thm "typing_var"} 1),
("asm_full_simp_tac ((ctxt delsimps [(nth @{thms \"HOL.simp_thms\"} (25-1)), (nth @{thms \"HOL.simp_thms\"} (26-1))]) addsimps [@{thm \"weakening_def\"}, @{thm \"empty_def\"}])", asm_full_simp_tac ((ctxt delsimps [(nth @{thms "HOL.simp_thms"} (25-1)), (nth @{thms "HOL.simp_thms"} (26-1))]) addsimps [@{thm "weakening_def"}, @{thm "empty_def"}]) 1),
("rtac @{thm \"keep\"}", rtac @{thm "keep"} 1),
("rtac @{thm \"kind_trec\"[where k = \"{E}\"]}", rtac @{thm "kind_trec"[where k = "{E}"]} 1),
("rtac @{thm \"kind_record_cons1\"}", rtac @{thm "kind_record_cons1"} 1),
("rtac @{thm \"kind_tcon\"}", rtac @{thm "kind_tcon"} 1),
("rtac @{thm \"kind_all_empty\"}", rtac @{thm "kind_all_empty"} 1),
("asm_full_simp_tac ctxt", asm_full_simp_tac ctxt 1),
("rtac @{thm \"kind_record_cons1\"}", rtac @{thm "kind_record_cons1"} 1),
("rtac @{thm \"kind_tcon\"}", rtac @{thm "kind_tcon"} 1),
("rtac @{thm \"kind_all_empty\"}", rtac @{thm "kind_all_empty"} 1),
("asm_full_simp_tac ctxt", asm_full_simp_tac ctxt 1),
("rtac @{thm \"kind_record_empty\"}", rtac @{thm "kind_record_empty"} 1),
("asm_full_simp_tac ctxt", asm_full_simp_tac ctxt 1),
("asm_full_simp_tac ctxt", asm_full_simp_tac ctxt 1),
("rtac @{thm \"typing_take\"}", rtac @{thm "typing_take"} 1),
("rtac @{thm \"split_cons\"}", rtac @{thm "split_cons"} 1),
("rtac @{thm \"split_comp.left\"}", rtac @{thm "split_comp.left"} 1),
("rtac @{thm \"kind_trec\"[where k = \"{E}\"]}", rtac @{thm "kind_trec"[where k = "{E}"]} 1),
("rtac @{thm \"kind_record_cons1\"}", rtac @{thm "kind_record_cons1"} 1),
("rtac @{thm \"kind_tcon\"}", rtac @{thm "kind_tcon"} 1),
("rtac @{thm \"kind_all_empty\"}", rtac @{thm "kind_all_empty"} 1),
("asm_full_simp_tac ctxt", asm_full_simp_tac ctxt 1),
("rtac @{thm \"kind_record_cons1\"}", rtac @{thm "kind_record_cons1"} 1),
("rtac @{thm \"kind_tcon\"}", rtac @{thm "kind_tcon"} 1),
("rtac @{thm \"kind_all_empty\"}", rtac @{thm "kind_all_empty"} 1),
("asm_full_simp_tac ctxt", asm_full_simp_tac ctxt 1),
("rtac @{thm \"kind_record_empty\"}", rtac @{thm "kind_record_empty"} 1),
("asm_full_simp_tac ctxt", asm_full_simp_tac ctxt 1),
("rtac @{thm \"split_cons\"}", rtac @{thm "split_cons"} 1),
("rtac @{thm \"split_comp.none\"}", rtac @{thm "split_comp.none"} 1),
("rtac @{thm \"split_empty\"}", rtac @{thm "split_empty"} 1),
("rtac @{thm \"typing_var\"}", rtac @{thm "typing_var"} 1),
("asm_full_simp_tac ((ctxt delsimps [(nth @{thms \"HOL.simp_thms\"} (25-1)), (nth @{thms \"HOL.simp_thms\"} (26-1))]) addsimps [@{thm \"weakening_def\"}, @{thm \"empty_def\"}])", asm_full_simp_tac ((ctxt delsimps [(nth @{thms "HOL.simp_thms"} (25-1)), (nth @{thms "HOL.simp_thms"} (26-1))]) addsimps [@{thm "weakening_def"}, @{thm "empty_def"}]) 1),
("rtac @{thm \"conjI\"}", rtac @{thm "conjI"} 1),
("rtac @{thm \"keep\"}", rtac @{thm "keep"} 1),
("rtac @{thm \"kind_trec\"[where k = \"{E}\"]}", rtac @{thm "kind_trec"[where k = "{E}"]} 1),
("rtac @{thm \"kind_record_cons1\"}", rtac @{thm "kind_record_cons1"} 1),
("rtac @{thm \"kind_tcon\"}", rtac @{thm "kind_tcon"} 1),
("rtac @{thm \"kind_all_empty\"}", rtac @{thm "kind_all_empty"} 1),
("asm_full_simp_tac ctxt", asm_full_simp_tac ctxt 1),
("rtac @{thm \"kind_record_cons1\"}", rtac @{thm "kind_record_cons1"} 1),
("rtac @{thm \"kind_tcon\"}", rtac @{thm "kind_tcon"} 1),
("rtac @{thm \"kind_all_empty\"}", rtac @{thm "kind_all_empty"} 1),
("asm_full_simp_tac ctxt", asm_full_simp_tac ctxt 1),
("rtac @{thm \"kind_record_empty\"}", rtac @{thm "kind_record_empty"} 1),
("asm_full_simp_tac ctxt", asm_full_simp_tac ctxt 1),
("rtac @{thm \"none\"}", rtac @{thm "none"} 1),
("asm_full_simp_tac ctxt", asm_full_simp_tac ctxt 1),
("asm_full_simp_tac ctxt", asm_full_simp_tac ctxt 1),
("asm_full_simp_tac ctxt", asm_full_simp_tac ctxt 1),
("asm_full_simp_tac ctxt", asm_full_simp_tac ctxt 1),
("rtac @{thm \"kind_tcon\"[where k = \"{E}\"]}", rtac @{thm "kind_tcon"[where k = "{E}"]} 1),
("rtac @{thm \"kind_all_empty\"}", rtac @{thm "kind_all_empty"} 1),
("asm_full_simp_tac ctxt", asm_full_simp_tac ctxt 1),
("rtac @{thm \"disjI2\"[where Q = \"True\"]}", rtac @{thm "disjI2"[where Q = "True"]} 1),
("asm_full_simp_tac ctxt", asm_full_simp_tac ctxt 1),
("asm_full_simp_tac ctxt", asm_full_simp_tac ctxt 1),
("rtac @{thm \"typing_put_better\"}", rtac @{thm "typing_put_better"} 1),
("rtac @{thm \"split_cons\"}", rtac @{thm "split_cons"} 1),
("rtac @{thm \"split_comp.right\"}", rtac @{thm "split_comp.right"} 1),
("rtac @{thm \"kind_tcon\"[where k = \"{E}\"]}", rtac @{thm "kind_tcon"[where k = "{E}"]} 1),
("rtac @{thm \"kind_all_empty\"}", rtac @{thm "kind_all_empty"} 1),
("asm_full_simp_tac ctxt", asm_full_simp_tac ctxt 1),
("rtac @{thm \"split_cons\"}", rtac @{thm "split_cons"} 1),
("rtac @{thm \"split_comp.left\"}", rtac @{thm "split_comp.left"} 1),
("rtac @{thm \"kind_trec\"[where k = \"{E}\"]}", rtac @{thm "kind_trec"[where k = "{E}"]} 1),
("rtac @{thm \"kind_record_cons2\"}", rtac @{thm "kind_record_cons2"} 1),
("rtac @{thm \"kind_tcon\"[where k = \"{E}\"]}", rtac @{thm "kind_tcon"[where k = "{E}"]} 1),
("rtac @{thm \"kind_all_empty\"}", rtac @{thm "kind_all_empty"} 1),
("asm_full_simp_tac ctxt", asm_full_simp_tac ctxt 1),
("rtac @{thm \"kind_record_cons1\"}", rtac @{thm "kind_record_cons1"} 1),
("rtac @{thm \"kind_tcon\"}", rtac @{thm "kind_tcon"} 1),
("rtac @{thm \"kind_all_empty\"}", rtac @{thm "kind_all_empty"} 1),
("asm_full_simp_tac ctxt", asm_full_simp_tac ctxt 1),
("rtac @{thm \"kind_record_empty\"}", rtac @{thm "kind_record_empty"} 1),
("asm_full_simp_tac ctxt", asm_full_simp_tac ctxt 1),
("rtac @{thm \"split_cons\"}", rtac @{thm "split_cons"} 1),
("rtac @{thm \"split_comp.none\"}", rtac @{thm "split_comp.none"} 1),
("rtac @{thm \"split_cons\"}", rtac @{thm "split_cons"} 1),
("rtac @{thm \"split_comp.none\"}", rtac @{thm "split_comp.none"} 1),
("rtac @{thm \"split_empty\"}", rtac @{thm "split_empty"} 1),
("rtac @{thm \"typing_var\"}", rtac @{thm "typing_var"} 1),
("asm_full_simp_tac ((ctxt delsimps [(nth @{thms \"HOL.simp_thms\"} (25-1)), (nth @{thms \"HOL.simp_thms\"} (26-1))]) addsimps [@{thm \"weakening_def\"}, @{thm \"empty_def\"}])", asm_full_simp_tac ((ctxt delsimps [(nth @{thms "HOL.simp_thms"} (25-1)), (nth @{thms "HOL.simp_thms"} (26-1))]) addsimps [@{thm "weakening_def"}, @{thm "empty_def"}]) 1),
("rtac @{thm \"conjI\"}", rtac @{thm "conjI"} 1),
("rtac @{thm \"none\"}", rtac @{thm "none"} 1),
("rtac @{thm \"conjI\"}", rtac @{thm "conjI"} 1),
("rtac @{thm \"keep\"}", rtac @{thm "keep"} 1),
("rtac @{thm \"kind_trec\"[where k = \"{E}\"]}", rtac @{thm "kind_trec"[where k = "{E}"]} 1),
("rtac @{thm \"kind_record_cons2\"}", rtac @{thm "kind_record_cons2"} 1),
("rtac @{thm \"kind_tcon\"[where k = \"{E}\"]}", rtac @{thm "kind_tcon"[where k = "{E}"]} 1),
("rtac @{thm \"kind_all_empty\"}", rtac @{thm "kind_all_empty"} 1),
("asm_full_simp_tac ctxt", asm_full_simp_tac ctxt 1),
("rtac @{thm \"kind_record_cons1\"}", rtac @{thm "kind_record_cons1"} 1),
("rtac @{thm \"kind_tcon\"}", rtac @{thm "kind_tcon"} 1),
("rtac @{thm \"kind_all_empty\"}", rtac @{thm "kind_all_empty"} 1),
("asm_full_simp_tac ctxt", asm_full_simp_tac ctxt 1),
("rtac @{thm \"kind_record_empty\"}", rtac @{thm "kind_record_empty"} 1),
("asm_full_simp_tac ctxt", asm_full_simp_tac ctxt 1),
("rtac @{thm \"conjI\"}", rtac @{thm "conjI"} 1),
("rtac @{thm \"none\"}", rtac @{thm "none"} 1),
("rtac @{thm \"none\"}", rtac @{thm "none"} 1),
("asm_full_simp_tac ctxt", asm_full_simp_tac ctxt 1),
("asm_full_simp_tac ctxt", asm_full_simp_tac ctxt 1),
("asm_full_simp_tac ctxt", asm_full_simp_tac ctxt 1),
("asm_full_simp_tac ctxt", asm_full_simp_tac ctxt 1),
("rtac @{thm \"kind_tcon\"[where k = \"{E}\"]}", rtac @{thm "kind_tcon"[where k = "{E}"]} 1),
("rtac @{thm \"kind_all_empty\"}", rtac @{thm "kind_all_empty"} 1),
("asm_full_simp_tac ctxt", asm_full_simp_tac ctxt 1),
("rtac @{thm \"disjI2\"[where Q = \"True\"]}", rtac @{thm "disjI2"[where Q = "True"]} 1),
("asm_full_simp_tac ctxt", asm_full_simp_tac ctxt 1),
("rtac @{thm \"typing_var\"}", rtac @{thm "typing_var"} 1),
("asm_full_simp_tac ((ctxt delsimps [(nth @{thms \"HOL.simp_thms\"} (25-1)), (nth @{thms \"HOL.simp_thms\"} (26-1))]) addsimps [@{thm \"weakening_def\"}, @{thm \"empty_def\"}])", asm_full_simp_tac ((ctxt delsimps [(nth @{thms "HOL.simp_thms"} (25-1)), (nth @{thms "HOL.simp_thms"} (26-1))]) addsimps [@{thm "weakening_def"}, @{thm "empty_def"}]) 1),
("rtac @{thm \"conjI\"}", rtac @{thm "conjI"} 1),
("rtac @{thm \"keep\"}", rtac @{thm "keep"} 1),
("rtac @{thm \"kind_tcon\"[where k = \"{E}\"]}", rtac @{thm "kind_tcon"[where k = "{E}"]} 1),
("rtac @{thm \"kind_all_empty\"}", rtac @{thm "kind_all_empty"} 1),
("asm_full_simp_tac ctxt", asm_full_simp_tac ctxt 1),
("rtac @{thm \"conjI\"}", rtac @{thm "conjI"} 1),
("rtac @{thm \"none\"}", rtac @{thm "none"} 1),
("rtac @{thm \"conjI\"}", rtac @{thm "conjI"} 1),
("rtac @{thm \"none\"}", rtac @{thm "none"} 1),
("rtac @{thm \"none\"}", rtac @{thm "none"} 1),
("asm_full_simp_tac ctxt", asm_full_simp_tac ctxt 1),
("asm_full_simp_tac ctxt", asm_full_simp_tac ctxt 1)
]

*}

(* trace the proof tree *)

declare [[ML_print_depth=99]]
ML {*
fun is_typing t = head_of t |> (fn h => is_const "Cogent.typing" h orelse is_const "Cogent.split" h);
extract_subproofs @{cterm "Trueprop (\<Xi>, fst foo_type, [Some (fst (snd foo_type))] \<turnstile> foo : snd (snd foo_type))"}
  (tacs @{context}) is_typing @{context}
*}

end


(*  Title:      HOL/Auth/n_german_lemma_inv__38_on_rules.thy
    Author:     Yongjian Li and Kaiqiang Duan, State Key Lab of Computer Science, Institute of Software, Chinese Academy of Sciences
    Copyright    2016 State Key Lab of Computer Science, Institute of Software, Chinese Academy of Sciences
*)

header{*The n_german Protocol Case Study*}

theory n_german_lemma_inv__38_on_rules imports n_german_lemma_on_inv__38
begin
section{*All lemmas on causal relation between inv__38*}
lemma lemma_inv__38_on_rules:
  assumes b1: "r \<in> rules N" and b2: "(\<exists> p__Inv2. p__Inv2\<le>N\<and>f=inv__38  p__Inv2)"
  shows "invHoldForRule s f r (invariants N)"
  proof -
  have c1: "(\<exists> i d. i\<le>N\<and>d\<le>N\<and>r=n_Store  i d)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendReqS  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendReqE__part__0  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendReqE__part__1  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvReqS N i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvReqE N i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendInv__part__0  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendInv__part__1  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendInvAck  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvInvAck  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendGntS  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendGntE N i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvGntS  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvGntE  i)"
  apply (cut_tac b1, auto) done
    moreover {
      assume d1: "(\<exists> i d. i\<le>N\<and>d\<le>N\<and>r=n_Store  i d)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_StoreVsinv__38) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_SendReqS  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendReqSVsinv__38) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_SendReqE__part__0  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendReqE__part__0Vsinv__38) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_SendReqE__part__1  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendReqE__part__1Vsinv__38) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_RecvReqS N i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_RecvReqSVsinv__38) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_RecvReqE N i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_RecvReqEVsinv__38) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_SendInv__part__0  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendInv__part__0Vsinv__38) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_SendInv__part__1  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendInv__part__1Vsinv__38) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_SendInvAck  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendInvAckVsinv__38) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_RecvInvAck  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_RecvInvAckVsinv__38) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_SendGntS  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendGntSVsinv__38) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_SendGntE N i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendGntEVsinv__38) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_RecvGntS  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_RecvGntSVsinv__38) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_RecvGntE  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_RecvGntEVsinv__38) done
    }

  ultimately show "invHoldForRule s f r (invariants N)"
  by satx
qed

end


(*  Title:      HOL/HOLCF/IOA/Deadlock.thy
    Author:     Olaf Müller
*)

section \<open>Deadlock freedom of I/O Automata\<close>

theory Deadlock
imports RefCorrectness CompoScheds
begin

text \<open>Input actions may always be added to a schedule.\<close>

lemma scheds_input_enabled:
  "Filter (\<lambda>x. x \<in> act A) \<cdot> sch \<in> schedules A \<Longrightarrow> a \<in> inp A \<Longrightarrow> input_enabled A \<Longrightarrow> Finite sch
    \<Longrightarrow> Filter (\<lambda>x. x \<in> act A) \<cdot> sch @@ a \<leadsto> nil \<in> schedules A"
  apply (simp add: schedules_def has_schedule_def)
  apply auto
  apply (frule inp_is_act)
  apply (simp add: executions_def)
  apply (pair ex)
  apply (rename_tac s ex)
  apply (subgoal_tac "Finite ex")
  prefer 2
  apply (simp add: filter_act_def)
  defer
  apply (rule_tac [2] Map2Finite [THEN iffD1])
  apply (rule_tac [2] t = "Map fst \<cdot> ex" in subst)
  prefer 2
  apply assumption
  apply (erule_tac [2] FiniteFilter)
  text \<open>subgoal 1\<close>
  apply (frule exists_laststate)
  apply (erule allE)
  apply (erule exE)
  text \<open>using input-enabledness\<close>
  apply (simp add: input_enabled_def)
  apply (erule conjE)+
  apply (erule_tac x = "a" in allE)
  apply simp
  apply (erule_tac x = "u" in allE)
  apply (erule exE)
  text \<open>instantiate execution\<close>
  apply (rule_tac x = " (s, ex @@ (a, s2) \<leadsto> nil) " in exI)
  apply (simp add: filter_act_def MapConc)
  apply (erule_tac t = "u" in lemma_2_1)
  apply simp
  apply (rule sym)
  apply assumption
  done

text \<open>
  Deadlock freedom: component B cannot block an out or int action of component
  A in every schedule.

  Needs compositionality on schedule level, input-enabledness, compatibility
  and distributivity of \<open>is_exec_frag\<close> over \<open>@@\<close>.
\<close>

lemma IOA_deadlock_free:
  assumes "a \<in> local A"
    and "Finite sch"
    and "sch \<in> schedules (A \<parallel> B)"
    and "Filter (\<lambda>x. x \<in> act A) \<cdot> (sch @@ a \<leadsto> nil) \<in> schedules A"
    and "compatible A B"
    and "input_enabled B"
  shows "(sch @@ a \<leadsto> nil) \<in> schedules (A \<parallel> B)"
  supply if_split [split del]
  apply (insert assms)
  apply (simp add: compositionality_sch locals_def)
  apply (rule conjI)
  text \<open>\<open>a \<in> act (A \<parallel> B)\<close>\<close>
  prefer 2
  apply (simp add: actions_of_par)
  apply (blast dest: int_is_act out_is_act)

  text \<open>\<open>Filter B (sch @@ [a]) \<in> schedules B\<close>\<close>
  apply (case_tac "a \<in> int A")
  apply (drule intA_is_not_actB)
  apply (assumption) (* \<longrightarrow> a \<notin> act B *)
  apply simp

  text \<open>case \<open>a \<notin> int A\<close>, i.e. \<open>a \<in> out A\<close>\<close>
  apply (case_tac "a \<notin> act B")
  apply simp
  text \<open>case \<open>a \<in> act B\<close>\<close>
  apply simp
  apply (subgoal_tac "a \<in> out A")
  prefer 2
  apply blast
  apply (drule outAactB_is_inpB)
  apply assumption
  apply assumption
  apply (rule scheds_input_enabled)
  apply simp
  apply assumption+
  done

end


(*<*)
theory Preliminaries
imports Abbrevs
begin

record foorecord = fld\<^sub>1 :: nat fld\<^sub>2 ::nat
datatype foodatatype = Foo
notation (latex output)
Foo ("\<^latex>\<open>\\constructor{Foo}\<close>")

(* TODO:
setup {*add_constructor_syntax "latex" "Preliminaries.foodatatype" *}
*)
(*>*)
section \<open>Preliminaries \label{sec:preliminaries}\<close>
text \<open>
The formalization presented in this papaer is mechanized and checked within the generic interactive theorem prover \emph{Isabelle}\<^cite>\<open>"Paulson:IGTP94"\<close>.
Isabelle is called generic as it provides a framework to formalize various \emph{object logics} declared via natural deduction style inference rules.
The object logic that we employ for our formalization is the higher order logic of \emph{Isabelle/HOL}\<^cite>\<open>"Nipkow:IHOL02"\<close>.

This article is written using Isabelle's document generation facilities, which guarantees a close correspondence between the presentation and the actual theory files.
We distinguish formal entities typographically from other text.
We use a sans serif font for types and constants (including functions and predicates), \eg @{term "map"}, a slanted serif font for free variables, \eg @{term "x"}, and a slanted sans serif font for bound variables, \eg @{term "Bind x. x"}.
Small capitals are used for data type constructors, \eg @{term[names_short] "Foo"}, and type variables have a leading tick, \eg  @{typ "'a"}. HOL keywords are typeset in type-writer font, \eg \holkeyword{let}. %We also take the freedom to borrow C notation, \eg @{term "UnsgndT"} when presenting C0.

To group common premises and to support modular reasoning Isabelle provides \emph{locales}\<^cite>\<open>"Ballarin:TYPES03-34" and "Ballarin:MKM06-31"\<close>.
A locale provides a name for a context of fixed parameters and premises, together with an elaborate infrastructure to define new locales by inheriting and extending other locales, prove theorems within locales and interpret (instantiate) locales. In our formalization we employ this infrastructure to separate the memory system from the programming language semantics.

The logical and mathematical notions follow the standard notational conventions with a bias towards functional programming.
We only present the more unconventional parts here.
We prefer curried function application, \eg @{term "f a b"} instead of @{term [mode=uncurry] "f a b"}.
In this setting the latter becomes a function application to \emph{one} argument, which happens to be a pair.

Isabelle/HOL provides a library of standard types like Booleans, natural numbers, integers, total functions, pairs, lists, and sets. Moreover, there are packages to define new data types and records.
Isabelle allows polymorphic types, \eg @{typ "'a list"} is the list type with type variable @{typ "'a"}.
In HOL all functions are total, \eg @{typ "nat \<Rightarrow> nat"} is a total function on natural numbers.
A function update is @{thm fun_upd_def[of f y v]}.
To formalize partial functions the type @{typ "'a option"} is used.
It is a data type with two constructors, one to inject values of the base type, \eg @{term "Some x"}, and the additional element @{term "None"}.
A base value can be projected with the function @{term "the"}, which is defined by the sole equation @{thm option.sel [of x]}.
Since HOL is a total logic the term @{term "the None"} is still a well-defined yet un(der)specified value.
Partial functions are usually represented by the type \<open>\<^latex>\<open>\tfreeify{\<close>'a\<^latex>\<open>}\<close> \<Rightarrow> \<^latex>\<open>\tfreeify{\<close>'b\<^latex>\<open>}\<close> option\<close>, abbreviated as @{typ  "'a \<rightharpoonup> 'b"}.
They are commonly used as \emph{maps}.
%With @{term "map_of xs"} we construct a map from an association list, \ie a list of key~/~value pairs.
We denote the domain of map  @{term "m"} by @{term "dom m"}. % not used: and to its range by @{term "ran m"}.
A map update is written as @{term "m(a := Some v)"}.
%With @{term "m\<^sub>1 ++ m\<^sub>2"} we add the map @{term "m\<^sub>2"} to map @{term "m\<^sub>1"}, where entries of @{term "m\<^sub>1"} are overwritten if necessary.
We can restrict the domain of a map @{term "m"} to a set @{term "A"} by @{term "m |` A"}.
%Subsumption of maps is defined as @{thm "map_le_def" [of m\<^sub>1 m\<^sub>2]} and composition of maps as @{thm "map_comp_def" [of m\<^sub>1 m\<^sub>2]}.

%\paragraph{Lists.}
The syntax and the operations for lists are similar to functional programming languages like ML or Haskell.
The empty list is @{term "[]"}, with @{term "x#xs"} the element @{term "x"} is `consed' to the list @{term "xs"}.%, the head of list @{term "xs"} is @{term "hd xs"} and the remainder, its tail, is @{term "tl xs"}.
With @{term "xs@ys"} list @{term "ys"} is appended to list @{term "xs"}.
With the term @{term "map f xs"} the function @{term "f"} is applied to all elements in @{term "xs"}.
The length of a list is @{term "length xs"}, the @{term n}-th element of a list can be selected with @{term "xs!n"} and can be updated via @{term "xs[n:=v]"}. With @{term "dropWhile P xs"} the prefix for which all elements satisfy predicate @{term "P"} are dropped from list @{term "xs"}.
%With @{term "set xs"} we obtain the set of elements in list @{term "xs"}.
%Filtering those elements from a list for which predicate @{term "P"} holds is achieved by @{term [eta_contract=false] "[x\<in>xs. P x]"}.
%With @{term "replicate n e"} we denote a list that consists of @{term n} elements @{term e}.

%\paragraph{Sets.}
Sets come along with the standard operations like union, \ie @{term "A \<union> B"}, membership, \ie @{term "x \<in> A"} and set inversion, \ie @{term "- A"}.

%intersection, \ie @{term "A \<inter> B"} and
%The set image @{term "f ` A"} yields a new set by applying function @{term "f"} to every element in set @{term "A"}.

%\paragraph{Records.}
%A record is constructed by assigning all of its fields, \eg @{term "\<lparr>fld\<^sub>1 = v\<^sub>1, fld\<^sub>2 = v\<^sub>2\<rparr>"}.
%Field @{term [names_short]"fld\<^sub>1"} of record @{term "r"} is selected by @{term[names_short] "fld\<^sub>1 r"} and updated with a value @{term "x"} via @{term[names_short] "r\<lparr>fld\<^sub>1 := x\<rparr>"}.

%\paragraph{Tuples.}
%The first and second component of a pair can be accessed with the functions @{const fst} and @{const snd}.
Tuples with more than two components are pairs nested to the right.

\<close>
(*<*)
end
(*>*)


(*  Title:      HOL/Auth/n_mutualExFsm_lemma_on_inv__1.thy
    Author:     Yongjian Li and Kaiqiang Duan, State Key Lab of Computer Science, Institute of Software, Chinese Academy of Sciences
    Copyright    2016 State Key Lab of Computer Science, Institute of Software, Chinese Academy of Sciences
*)

header{*The n_mutualExFsm Protocol Case Study*}

theory n_mutualExFsm_lemma_on_inv__1 imports n_mutualExFsm_base
begin
section{*All lemmas on causal relation between inv__1 and some rule r*}
lemma n_fsmVsinv__1:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_fsm  i)" and
a2: "(\<exists> p__Inv0 p__Inv1. p__Inv0\<le>N\<and>p__Inv1\<le>N\<and>p__Inv0~=p__Inv1\<and>f=inv__1  p__Inv0 p__Inv1)"
shows "invHoldForRule s f r (invariants N)" (is "?P1 s \<or> ?P2 s \<or> ?P3 s")
proof -
from a1 obtain i where a1:"i\<le>N\<and>r=n_fsm  i" apply fastforce done
from a2 obtain p__Inv0 p__Inv1 where a2:"p__Inv0\<le>N\<and>p__Inv1\<le>N\<and>p__Inv0~=p__Inv1\<and>f=inv__1  p__Inv0 p__Inv1" apply fastforce done
have "(i=p__Inv0)\<or>(i=p__Inv1)\<or>(i~=p__Inv0\<and>i~=p__Inv1)" apply (cut_tac a1 a2, auto) done
moreover {
  assume b1: "(i=p__Inv0)"
  have "((formEval (eqn (IVar (Para (Ident ''n'') p__Inv0)) (Const I)) s))\<or>((formEval (andForm (andForm (eqn (IVar (Ident ''x'')) (Const true)) (eqn (IVar (Para (Ident ''n'') p__Inv0)) (Const T))) (neg (eqn (IVar (Para (Ident ''n'') p__Inv0)) (Const I)))) s))\<or>((formEval (andForm (andForm (neg (eqn (IVar (Ident ''x'')) (Const true))) (eqn (IVar (Para (Ident ''n'') p__Inv0)) (Const T))) (neg (eqn (IVar (Para (Ident ''n'') p__Inv0)) (Const I)))) s))\<or>((formEval (andForm (andForm (eqn (IVar (Para (Ident ''n'') p__Inv0)) (Const C)) (neg (eqn (IVar (Para (Ident ''n'') p__Inv0)) (Const T)))) (neg (eqn (IVar (Para (Ident ''n'') p__Inv0)) (Const I)))) s))\<or>((formEval (andForm (andForm (neg (eqn (IVar (Para (Ident ''n'') p__Inv0)) (Const C))) (neg (eqn (IVar (Para (Ident ''n'') p__Inv0)) (Const T)))) (neg (eqn (IVar (Para (Ident ''n'') p__Inv0)) (Const I)))) s))" by auto
  moreover {
    assume c1: "((formEval (eqn (IVar (Para (Ident ''n'') p__Inv0)) (Const I)) s))"
    have "?P1 s"
    proof(cut_tac a1 a2 b1 c1, auto) qed
    then have "invHoldForRule s f r (invariants N)" by auto
  }
  moreover {
    assume c1: "((formEval (andForm (andForm (eqn (IVar (Ident ''x'')) (Const true)) (eqn (IVar (Para (Ident ''n'') p__Inv0)) (Const T))) (neg (eqn (IVar (Para (Ident ''n'') p__Inv0)) (Const I)))) s))"
    have "?P3 s"
    apply (cut_tac a1 a2 b1 c1, simp, rule_tac x="(neg (andForm (eqn (IVar (Para (Ident ''n'') p__Inv1)) (Const C)) (eqn (IVar (Ident ''x'')) (Const true))))" in exI, auto) done
    then have "invHoldForRule s f r (invariants N)" by auto
  }
  moreover {
    assume c1: "((formEval (andForm (andForm (neg (eqn (IVar (Ident ''x'')) (Const true))) (eqn (IVar (Para (Ident ''n'') p__Inv0)) (Const T))) (neg (eqn (IVar (Para (Ident ''n'') p__Inv0)) (Const I)))) s))"
    have "?P2 s"
    proof(cut_tac a1 a2 b1 c1, auto) qed
    then have "invHoldForRule s f r (invariants N)" by auto
  }
  moreover {
    assume c1: "((formEval (andForm (andForm (eqn (IVar (Para (Ident ''n'') p__Inv0)) (Const C)) (neg (eqn (IVar (Para (Ident ''n'') p__Inv0)) (Const T)))) (neg (eqn (IVar (Para (Ident ''n'') p__Inv0)) (Const I)))) s))"
    have "?P1 s"
    proof(cut_tac a1 a2 b1 c1, auto) qed
    then have "invHoldForRule s f r (invariants N)" by auto
  }
  moreover {
    assume c1: "((formEval (andForm (andForm (neg (eqn (IVar (Para (Ident ''n'') p__Inv0)) (Const C))) (neg (eqn (IVar (Para (Ident ''n'') p__Inv0)) (Const T)))) (neg (eqn (IVar (Para (Ident ''n'') p__Inv0)) (Const I)))) s))"
    have "?P1 s"
    proof(cut_tac a1 a2 b1 c1, auto) qed
    then have "invHoldForRule s f r (invariants N)" by auto
  }
  ultimately have "invHoldForRule s f r (invariants N)" by satx
}
moreover {
  assume b1: "(i=p__Inv1)"
  have "((formEval (eqn (IVar (Para (Ident ''n'') p__Inv1)) (Const I)) s))\<or>((formEval (andForm (andForm (eqn (IVar (Ident ''x'')) (Const true)) (eqn (IVar (Para (Ident ''n'') p__Inv1)) (Const T))) (neg (eqn (IVar (Para (Ident ''n'') p__Inv1)) (Const I)))) s))\<or>((formEval (andForm (andForm (neg (eqn (IVar (Ident ''x'')) (Const true))) (eqn (IVar (Para (Ident ''n'') p__Inv1)) (Const T))) (neg (eqn (IVar (Para (Ident ''n'') p__Inv1)) (Const I)))) s))\<or>((formEval (andForm (andForm (eqn (IVar (Para (Ident ''n'') p__Inv1)) (Const C)) (neg (eqn (IVar (Para (Ident ''n'') p__Inv1)) (Const T)))) (neg (eqn (IVar (Para (Ident ''n'') p__Inv1)) (Const I)))) s))\<or>((formEval (andForm (andForm (neg (eqn (IVar (Para (Ident ''n'') p__Inv1)) (Const C))) (neg (eqn (IVar (Para (Ident ''n'') p__Inv1)) (Const T)))) (neg (eqn (IVar (Para (Ident ''n'') p__Inv1)) (Const I)))) s))" by auto
  moreover {
    assume c1: "((formEval (eqn (IVar (Para (Ident ''n'') p__Inv1)) (Const I)) s))"
    have "?P1 s"
    proof(cut_tac a1 a2 b1 c1, auto) qed
    then have "invHoldForRule s f r (invariants N)" by auto
  }
  moreover {
    assume c1: "((formEval (andForm (andForm (eqn (IVar (Ident ''x'')) (Const true)) (eqn (IVar (Para (Ident ''n'') p__Inv1)) (Const T))) (neg (eqn (IVar (Para (Ident ''n'') p__Inv1)) (Const I)))) s))"
    have "?P3 s"
    apply (cut_tac a1 a2 b1 c1, simp, rule_tac x="(neg (andForm (eqn (IVar (Para (Ident ''n'') p__Inv0)) (Const C)) (eqn (IVar (Ident ''x'')) (Const true))))" in exI, auto) done
    then have "invHoldForRule s f r (invariants N)" by auto
  }
  moreover {
    assume c1: "((formEval (andForm (andForm (neg (eqn (IVar (Ident ''x'')) (Const true))) (eqn (IVar (Para (Ident ''n'') p__Inv1)) (Const T))) (neg (eqn (IVar (Para (Ident ''n'') p__Inv1)) (Const I)))) s))"
    have "?P2 s"
    proof(cut_tac a1 a2 b1 c1, auto) qed
    then have "invHoldForRule s f r (invariants N)" by auto
  }
  moreover {
    assume c1: "((formEval (andForm (andForm (eqn (IVar (Para (Ident ''n'') p__Inv1)) (Const C)) (neg (eqn (IVar (Para (Ident ''n'') p__Inv1)) (Const T)))) (neg (eqn (IVar (Para (Ident ''n'') p__Inv1)) (Const I)))) s))"
    have "?P1 s"
    proof(cut_tac a1 a2 b1 c1, auto) qed
    then have "invHoldForRule s f r (invariants N)" by auto
  }
  moreover {
    assume c1: "((formEval (andForm (andForm (neg (eqn (IVar (Para (Ident ''n'') p__Inv1)) (Const C))) (neg (eqn (IVar (Para (Ident ''n'') p__Inv1)) (Const T)))) (neg (eqn (IVar (Para (Ident ''n'') p__Inv1)) (Const I)))) s))"
    have "?P1 s"
    proof(cut_tac a1 a2 b1 c1, auto) qed
    then have "invHoldForRule s f r (invariants N)" by auto
  }
  ultimately have "invHoldForRule s f r (invariants N)" by satx
}
moreover {
  assume b1: "(i~=p__Inv0\<and>i~=p__Inv1)"
  have "?P2 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
ultimately show "invHoldForRule s f r (invariants N)" by satx
qed
end


(*
   Title: Psi-calculi
   Author/Maintainer: Jesper Bengtson (jebe@itu.dk), 2012
*)
theory Weak_Cong_Simulation
  imports Weak_Simulation Tau_Chain
begin

context env begin

definition
  "weakCongSimulation" :: "'b \<Rightarrow> ('a, 'b, 'c) psi \<Rightarrow>
                       ('b \<times> ('a, 'b, 'c) psi \<times> ('a, 'b, 'c) psi) set \<Rightarrow>
                       ('a, 'b, 'c) psi \<Rightarrow> bool" ("_ \<rhd> _ \<leadsto>\<guillemotleft>_\<guillemotright> _" [80, 80, 80, 80] 80)
where
  "\<Psi> \<rhd> P \<leadsto>\<guillemotleft>Rel\<guillemotright> Q \<equiv> \<forall>Q'. \<Psi> \<rhd> Q \<longmapsto>\<tau> \<prec> Q' \<longrightarrow> (\<exists>P'. \<Psi> \<rhd> P \<Longrightarrow>\<^sub>\<tau> P' \<and> (\<Psi>, P', Q') \<in> Rel)"

abbreviation
  weakCongSimulationNilJudge ("_ \<leadsto>\<guillemotleft>_\<guillemotright> _" [80, 80, 80] 80) where "P \<leadsto>\<guillemotleft>Rel\<guillemotright> Q \<equiv> SBottom' \<rhd> P \<leadsto>\<guillemotleft>Rel\<guillemotright> Q"

lemma weakCongSimI[case_names cTau]:
  fixes \<Psi>   :: 'b
  and   P   :: "('a, 'b, 'c) psi"
  and   Rel :: "('b \<times> ('a, 'b, 'c) psi \<times> ('a, 'b, 'c) psi) set"
  and   Q   :: "('a, 'b, 'c) psi"
  and   C   :: "'d::fs_name"

  assumes rTau:  "\<And>Q'. \<Psi> \<rhd> Q \<longmapsto>\<tau> \<prec> Q' \<Longrightarrow> \<exists>P'. \<Psi> \<rhd> P \<Longrightarrow>\<^sub>\<tau> P' \<and> (\<Psi>, P', Q') \<in> Rel"

  shows "\<Psi> \<rhd> P \<leadsto>\<guillemotleft>Rel\<guillemotright> Q"
using assms
by(auto simp add: weakCongSimulation_def)

lemma weakCongSimE:
  fixes F   :: 'b
  and   P   :: "('a, 'b, 'c) psi"
  and   Rel :: "('b \<times> ('a, 'b, 'c) psi \<times> ('a, 'b, 'c) psi) set"
  and   Q   :: "('a, 'b, 'c) psi"

  assumes "\<Psi> \<rhd> P \<leadsto>\<guillemotleft>Rel\<guillemotright> Q"
  and "\<Psi> \<rhd> Q \<longmapsto>\<tau> \<prec> Q'"

  obtains P' where "\<Psi> \<rhd> P \<Longrightarrow>\<^sub>\<tau> P'" and "(\<Psi>, P', Q') \<in> Rel"
using assms
by(auto simp add: weakCongSimulation_def)

lemma weakCongSimClosedAux:
  fixes \<Psi>   :: 'b
  and   P   :: "('a, 'b, 'c) psi"
  and   Rel :: "('b \<times> ('a, 'b, 'c) psi \<times> ('a, 'b, 'c) psi) set"
  and   Q   :: "('a, 'b, 'c) psi"
  and   p   :: "name prm"

  assumes EqvtRel: "eqvt Rel"
  and     PSimQ: "\<Psi> \<rhd> P \<leadsto>\<guillemotleft>Rel\<guillemotright> Q"

  shows "(p \<bullet> \<Psi>) \<rhd> (p \<bullet> P) \<leadsto>\<guillemotleft>Rel\<guillemotright> (p \<bullet> Q)"
proof(induct rule: weakCongSimI)
  case(cTau Q')
  from \<open>p \<bullet> \<Psi> \<rhd> p \<bullet> Q \<longmapsto>\<tau> \<prec> Q'\<close>
  have "(rev p \<bullet> p \<bullet> \<Psi>) \<rhd> (rev p \<bullet> p \<bullet> Q) \<longmapsto>(rev p \<bullet> (\<tau> \<prec> Q'))"
    by(blast dest: semantics.eqvt)
  hence "\<Psi> \<rhd> Q \<longmapsto>\<tau> \<prec> (rev p \<bullet> Q')" by(simp add: eqvts)
  with PSimQ obtain P' where PChain: "\<Psi> \<rhd> P \<Longrightarrow>\<^sub>\<tau> P'" and P'RelQ': "(\<Psi>, P', rev p \<bullet> Q') \<in> Rel"
    by(blast dest: weakCongSimE)
  from PChain have "(p \<bullet> \<Psi>) \<rhd> (p \<bullet> P) \<Longrightarrow>\<^sub>\<tau> (p \<bullet> P')" by(rule tauStepChainEqvt)
  moreover from P'RelQ' EqvtRel have "(p \<bullet> (\<Psi>,  P', rev p \<bullet> Q')) \<in> Rel"
    by(simp only: eqvt_def)
  hence "(p \<bullet> \<Psi>, p \<bullet> P', Q') \<in> Rel" by(simp add: eqvts)
  ultimately show ?case
    by blast
qed

lemma weakCongSimClosed:
  fixes \<Psi>   :: 'b
  and   P   :: "('a, 'b, 'c) psi"
  and   Rel :: "('b \<times> ('a, 'b, 'c) psi \<times> ('a, 'b, 'c) psi) set"
  and   Q   :: "('a, 'b, 'c) psi"
  and   p   :: "name prm"

  assumes EqvtRel: "eqvt Rel"

  shows "\<Psi> \<rhd> P \<leadsto>\<guillemotleft>Rel\<guillemotright> Q \<Longrightarrow> (p \<bullet> \<Psi>) \<rhd> (p \<bullet> P) \<leadsto>\<guillemotleft>Rel\<guillemotright> (p \<bullet> Q)"
  and   "P \<leadsto>\<guillemotleft>Rel\<guillemotright> Q \<Longrightarrow> (p \<bullet> P) \<leadsto>\<guillemotleft>Rel\<guillemotright> (p \<bullet> Q)"
using EqvtRel
by(force dest: weakCongSimClosedAux simp add: permBottom)+

lemma weakCongSimReflexive:
  fixes Rel :: "('b \<times> ('a, 'b, 'c) psi \<times> ('a, 'b, 'c) psi) set"
  and   \<Psi>   :: 'b
  and   P   :: "('a, 'b, 'c) psi"

  assumes "{(\<Psi>, P, P) | \<Psi> P. True} \<subseteq> Rel"

  shows "\<Psi> \<rhd> P \<leadsto>\<guillemotleft>Rel\<guillemotright> P"
using assms
by(auto simp add: weakCongSimulation_def dest: rtrancl_into_rtrancl)

lemma weakStepSimTauChain:
  fixes \<Psi>   :: 'b
  and   Q   :: "('a, 'b, 'c) psi"
  and   Q'  :: "('a, 'b, 'c) psi"
  and   P   :: "('a, 'b, 'c) psi"
  and   Rel :: "('b \<times> ('a, 'b, 'c) psi \<times> ('a, 'b, 'c) psi) set"

  assumes "\<Psi> \<rhd> Q \<Longrightarrow>\<^sub>\<tau> Q'"
  and     "\<Psi> \<rhd> P \<leadsto>\<guillemotleft>Rel\<guillemotright> Q"
  and     Sim: "\<And>\<Psi> P Q. (\<Psi>, P, Q) \<in> Rel \<Longrightarrow> \<Psi> \<rhd> P \<leadsto><Rel> Q"

  obtains P' where "\<Psi> \<rhd> P \<Longrightarrow>\<^sub>\<tau> P'" and "(\<Psi>, P', Q') \<in> Rel"
proof -
  assume A: "\<And>P'. \<lbrakk>\<Psi> \<rhd> P \<Longrightarrow>\<^sub>\<tau> P'; (\<Psi>, P', Q') \<in> Rel\<rbrakk> \<Longrightarrow> thesis"
  from \<open>\<Psi> \<rhd> Q \<Longrightarrow>\<^sub>\<tau> Q'\<close> \<open>\<Psi> \<rhd> P \<leadsto>\<guillemotleft>Rel\<guillemotright> Q\<close> A show ?thesis
  proof(induct arbitrary: P thesis rule: tauStepChainInduct)
    case(TauBase Q Q' P)
    with \<open>\<Psi> \<rhd> P \<leadsto>\<guillemotleft>Rel\<guillemotright> Q\<close> \<open>\<Psi> \<rhd> Q \<longmapsto>\<tau> \<prec> Q'\<close> obtain P' where PChain: "\<Psi> \<rhd> P \<Longrightarrow>\<^sub>\<tau> P'" and P'RelQ': "(\<Psi>, P', Q') \<in> Rel"
      by(rule_tac weakCongSimE)
    thus ?case by(rule TauBase)
  next
    case(TauStep Q Q' Q'' P)
    from \<open>\<Psi> \<rhd> P \<leadsto>\<guillemotleft>Rel\<guillemotright> Q\<close> obtain P' where PChain: "\<Psi> \<rhd> P \<Longrightarrow>\<^sub>\<tau> P'" and "(\<Psi>, P', Q') \<in> Rel"
      by(rule TauStep)
    from \<open>(\<Psi>, P', Q') \<in> Rel\<close> have "\<Psi> \<rhd> P' \<leadsto><Rel> Q'" by(rule Sim)
    then obtain P'' where P'Chain: "\<Psi> \<rhd> P' \<Longrightarrow>\<^sup>^\<^sub>\<tau> P''" and "(\<Psi>, P'', Q'') \<in> Rel"
      using \<open>\<Psi> \<rhd> Q' \<longmapsto>\<tau> \<prec> Q''\<close> by(blast dest: weakSimE)
    from PChain P'Chain have "\<Psi> \<rhd> P \<Longrightarrow>\<^sub>\<tau> P''" by simp
    thus ?case using \<open>(\<Psi>, P'', Q'') \<in> Rel\<close> by(rule TauStep)
  qed
qed

lemma weakCongSimTransitive:
  fixes \<Psi>     :: 'b
  and   P      :: "('a, 'b, 'c) psi"
  and   Rel    :: "('b \<times> ('a, 'b, 'c) psi \<times> ('a, 'b, 'c) psi) set"
  and   Q      :: "('a, 'b, 'c) psi"
  and   Rel'   :: "('b \<times> ('a, 'b, 'c) psi \<times> ('a, 'b, 'c) psi) set"
  and   T      :: "('a, 'b, 'c) psi"
  and   Rel''  :: "('b \<times> ('a, 'b, 'c) psi \<times> ('a, 'b, 'c) psi) set"

  assumes PRelQ: "(\<Psi>, P, Q) \<in> Rel"
  and     PSimQ: "\<Psi> \<rhd> P \<leadsto>\<guillemotleft>Rel\<guillemotright> Q"
  and     QSimR: "\<Psi> \<rhd> Q \<leadsto>\<guillemotleft>Rel'\<guillemotright> R"
  and     Set: "{(\<Psi>, P, R) | \<Psi> P R. \<exists>Q. (\<Psi>, P, Q) \<in> Rel \<and> (\<Psi>, Q, R) \<in> Rel'} \<subseteq> Rel''"
  and     Sim: "\<And>\<Psi> P Q. (\<Psi>, P, Q) \<in> Rel \<Longrightarrow> \<Psi> \<rhd> P \<leadsto><Rel> Q"

  shows "\<Psi> \<rhd> P \<leadsto>\<guillemotleft>Rel''\<guillemotright> R"
proof(induct rule: weakCongSimI)
  case(cTau R')
  from QSimR \<open>\<Psi> \<rhd> R \<longmapsto>\<tau> \<prec> R'\<close> obtain Q' where QChain: "\<Psi> \<rhd> Q \<Longrightarrow>\<^sub>\<tau> Q'" and Q'RelR': "(\<Psi>, Q', R') \<in> Rel'"
    by(blast dest: weakCongSimE)
  from QChain PSimQ Sim obtain P' where PChain: "\<Psi> \<rhd> P \<Longrightarrow>\<^sub>\<tau> P'" and P'RelQ': "(\<Psi>, P', Q') \<in> Rel"
    by(rule weakStepSimTauChain)
  moreover from P'RelQ' Q'RelR' Set have "(\<Psi>, P', R') \<in> Rel''" by blast
  ultimately show ?case by blast
qed

lemma weakCongSimStatEq:
  fixes \<Psi>   :: 'b
  and   P   :: "('a, 'b, 'c) psi"
  and   Rel :: "('b \<times> ('a, 'b, 'c) psi \<times> ('a, 'b, 'c) psi) set"
  and   Q   :: "('a, 'b, 'c) psi"
  and   \<Psi>'  :: 'b

  assumes PSimQ: "\<Psi> \<rhd> P \<leadsto>\<guillemotleft>Rel\<guillemotright> Q"
  and     "\<Psi> \<simeq> \<Psi>'"
  and     C1: "\<And>\<Psi> P Q \<Psi>'. \<lbrakk>(\<Psi>, P, Q) \<in> Rel; \<Psi> \<simeq> \<Psi>'\<rbrakk> \<Longrightarrow> (\<Psi>', P, Q) \<in> Rel'"

  shows "\<Psi>' \<rhd> P \<leadsto>\<guillemotleft>Rel'\<guillemotright> Q"
proof(induct rule: weakCongSimI)
  case(cTau Q')
  from \<open>\<Psi>' \<rhd> Q \<longmapsto>\<tau> \<prec> Q'\<close> \<open>\<Psi> \<simeq> \<Psi>'\<close>
  have "\<Psi> \<rhd> Q \<longmapsto>\<tau> \<prec> Q'" by(metis statEqTransition AssertionStatEqSym)
  with PSimQ obtain P' where PChain: "\<Psi> \<rhd> P \<Longrightarrow>\<^sub>\<tau> P'" and P'RelQ': "(\<Psi>, P', Q') \<in> Rel"
    by(blast dest: weakCongSimE)

  from PChain \<open>\<Psi> \<simeq> \<Psi>'\<close> have "\<Psi>' \<rhd> P \<Longrightarrow>\<^sub>\<tau> P'" by(rule tauStepChainStatEq)
  moreover from \<open>(\<Psi>, P', Q') \<in> Rel\<close> \<open>\<Psi> \<simeq> \<Psi>'\<close> have "(\<Psi>', P', Q') \<in> Rel'"
    by(rule C1)
  ultimately show ?case by blast
qed

lemma weakCongSimMonotonic:
  fixes \<Psi> :: 'b
  and   P :: "('a, 'b, 'c) psi"
  and   A :: "('b \<times> ('a, 'b, 'c) psi \<times> ('a, 'b, 'c) psi) set"
  and   Q :: "('a, 'b, 'c) psi"
  and   B :: "('b \<times> ('a, 'b, 'c) psi \<times> ('a, 'b, 'c) psi) set"

  assumes "\<Psi> \<rhd> P \<leadsto>\<guillemotleft>A\<guillemotright> Q"
  and     "A \<subseteq> B"

  shows "\<Psi> \<rhd> P \<leadsto>\<guillemotleft>B\<guillemotright> Q"
using assms
by(simp (no_asm) add: weakCongSimulation_def) (blast dest: weakCongSimE)+

lemma strongSimWeakCongSim:
  fixes \<Psi>   :: 'b
  and   P   :: "('a, 'b, 'c) psi"
  and   Rel :: "('b \<times> ('a, 'b, 'c) psi \<times> ('a, 'b, 'c) psi) set"
  and   Q   :: "('a, 'b, 'c) psi"

  assumes "\<Psi> \<rhd> P \<leadsto>[Rel] Q"
  and     "Rel \<subseteq> Rel'"

  shows "\<Psi> \<rhd> P \<leadsto>\<guillemotleft>Rel'\<guillemotright> Q"
using assms
apply(auto simp add: simulation_def weakCongSimulation_def)
by(erule_tac x=\<tau> in allE) fastforce

end

end