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

(*
 * Primitive ops
 *
 *)

theory Prim
imports
  "../Deep_Embedding_Auto"
  "../SpecialisedLemmaTactic"
  "../Cogent_Corres"
  "../Corres_Tac"
  "../TypeProofGen"
  "../Tidy"
  "../Heap_Relation_Generation" "../Type_Relation_Generation"
begin

(* Cogent semantics generated by
  cogent --fml-typing-tree --type-proof=Foo.thy pass_prim-ops.cogent
*)

lemmas abbreviated_type_defs =
  TrueI

definition
  "ops8_type \<equiv> ([], (TPrim (Num U8), TPrim (Num U8)))"

definition
  "ops8 \<equiv> Let (Var 0) (Let (Lit (LU8 1)) (Let (Prim (Plus U8) [Var 1, Var 0]) (Let (Prim (Times U8) [Var 0, Var 2]) (Let (Prim (Minus U8) [Var 0, Var 1]) (Let (Prim (BitOr U8) [Var 0, Var 1]) (Let (Prim (BitAnd U8) [Var 0, Var 1]) (Let (Prim (BitXor U8) [Var 1, Var 2]) (Let (Prim (Complement U8) [Var 0]) (Let (Prim (LShift U8) [Var 1, Var 0]) (Let (Prim (RShift U8) [Var 1, Var 0]) (Let (Prim (Divide U8) [Var 0, Var 1]) (Let (Prim (Mod U8) [Var 1, Var 0]) (Let (Prim (Lt U8) [Var 2, Var 1]) (Let (Prim (Le U8) [Var 2, Var 1]) (Let (Prim (Eq (Num U8)) [Var 4, Var 2]) (Let (Prim Cogent.And [Var 1, Var 0]) (Let (Prim Cogent.And [Var 3, Var 0]) (If (Var 0) (Lit (LU8 0)) (Lit (LU8 1))))))))))))))))))))"

definition
  "ops64_type \<equiv> ([], (TPrim (Num U64), TPrim (Num U64)))"

definition
  "ops64 \<equiv> Let (Var 0) (Let (Lit (LU8 1)) (Let (Cast U64 (Var 0)) (Let (Prim (Plus U64) [Var 2, Var 0]) (Let (Prim (Times U64) [Var 0, Var 3]) (Let (Prim (Minus U64) [Var 0, Var 1]) (Let (Prim (BitOr U64) [Var 0, Var 1]) (Let (Prim (BitAnd U64) [Var 0, Var 1]) (Let (Prim (BitXor U64) [Var 1, Var 0]) (Let (Prim (Complement U64) [Var 0]) (Let (Prim (LShift U64) [Var 1, Var 0]) (Let (Prim (RShift U64) [Var 1, Var 0]) (Let (Prim (Divide U64) [Var 0, Var 1]) (Let (Prim (Mod U64) [Var 1, Var 0]) (Let (Prim (Lt U64) [Var 2, Var 1]) (Let (Prim (Le U64) [Var 2, Var 1]) (Let (Prim (Eq (Num U64)) [Var 4, Var 2]) (Let (Prim Cogent.And [Var 1, Var 0]) (Let (Prim Cogent.And [Var 3, Var 0]) (If (Var 0) (Let (Lit (LU8 0)) (Cast U64 (Var 0))) (Let (Lit (LU8 1)) (Cast U64 (Var 0))))))))))))))))))))))"

definition
  "ops32_type \<equiv> ([], (TPrim (Num U32), TPrim (Num U32)))"

definition
  "ops32 \<equiv> Let (Var 0) (Let (Lit (LU8 1)) (Let (Cast U32 (Var 0)) (Let (Prim (Plus U32) [Var 2, Var 0]) (Let (Prim (Times U32) [Var 0, Var 3]) (Let (Prim (Minus U32) [Var 0, Var 1]) (Let (Prim (BitOr U32) [Var 0, Var 1]) (Let (Prim (BitAnd U32) [Var 0, Var 1]) (Let (Prim (BitXor U32) [Var 1, Var 2]) (Let (Prim (Complement U32) [Var 0]) (Let (Prim (LShift U32) [Var 1, Var 0]) (Let (Prim (RShift U32) [Var 1, Var 0]) (Let (Prim (Divide U32) [Var 0, Var 1]) (Let (Prim (Mod U32) [Var 1, Var 0]) (Let (Prim (Lt U32) [Var 2, Var 1]) (Let (Prim (Le U32) [Var 2, Var 1]) (Let (Prim (Eq (Num U32)) [Var 4, Var 2]) (Let (Prim Cogent.And [Var 1, Var 0]) (Let (Prim Cogent.And [Var 3, Var 0]) (If (Var 0) (Let (Lit (LU8 0)) (Cast U32 (Var 0))) (Let (Lit (LU8 1)) (Cast U32 (Var 0))))))))))))))))))))))"

definition
  "ops16_type \<equiv> ([], (TPrim (Num U16), TPrim (Num U16)))"

definition
  "ops16 \<equiv> Let (Var 0) (Let (Lit (LU8 1)) (Let (Cast U16 (Var 0)) (Let (Prim (Plus U16) [Var 2, Var 0]) (Let (Prim (Times U16) [Var 0, Var 3]) (Let (Prim (Minus U16) [Var 0, Var 1]) (Let (Prim (BitOr U16) [Var 0, Var 1]) (Let (Prim (BitAnd U16) [Var 0, Var 1]) (Let (Prim (BitXor U16) [Var 1, Var 2]) (Let (Prim (Complement U16) [Var 0]) (Let (Prim (LShift U16) [Var 1, Var 0]) (Let (Prim (RShift U16) [Var 1, Var 0]) (Let (Prim (Divide U16) [Var 0, Var 1]) (Let (Prim (Mod U16) [Var 1, Var 0]) (Let (Prim (Lt U16) [Var 2, Var 1]) (Let (Prim (Le U16) [Var 2, Var 1]) (Let (Prim (Eq (Num U16)) [Var 4, Var 2]) (Let (Prim Cogent.And [Var 1, Var 0]) (Let (Prim Cogent.And [Var 3, Var 0]) (If (Var 0) (Let (Lit (LU8 0)) (Cast U16 (Var 0))) (Let (Lit (LU8 1)) (Cast U16 (Var 0))))))))))))))))))))))"

definition
  "bool_ops_type \<equiv> ([], (TPrim (Num U32), TPrim Bool))"

definition
  "bool_ops \<equiv> Let (Var 0) (Let (Lit (LU8 1)) (Let (Cast U32 (Var 0)) (Let (Prim (Plus U32) [Var 2, Var 0]) (Let (Prim (Times U32) [Var 0, Var 3]) (Let (Prim (Lt U32) [Var 4, Var 1]) (Let (Prim (Le U32) [Var 2, Var 1]) (Let (Prim (Eq (Num U32)) [Var 2, Var 6]) (Let (Prim Cogent.And [Var 1, Var 0]) (Let (Prim Cogent.Or [Var 0, Var 1]) (Let (Prim Not [Var 0]) (Let (Lit (LBool True)) (Let (Prim Cogent.Or [Var 1, Var 0]) (Let (Prim Not [Var 0]) (Let (Lit (LBool False)) (Let (Prim Cogent.And [Var 1, Var 0]) (Var 0))))))))))))))))"

ML {*
val Cogent_functions = ["ops8","ops64","ops32","ops16","bool_ops"]
val Cogent_abstract_functions = []
*}

definition
  "\<Xi> func_name' \<equiv> case func_name' of ''ops8'' \<Rightarrow> ops8_type | ''ops64'' \<Rightarrow> ops64_type | ''ops32'' \<Rightarrow> ops32_type | ''ops16'' \<Rightarrow> ops16_type | ''bool_ops'' \<Rightarrow> bool_ops_type"

definition
  "ops8_typetree \<equiv> TyTrSplit (Cons (Some TSK_L) []) [] TyTrLeaf [Some (TPrim (Num U8))] (TyTrSplit (append (replicate 2 None) []) [] TyTrLeaf [Some (TPrim (Num U8))] (TyTrSplit (Cons (Some TSK_L) (Cons (Some TSK_S) (Cons None []))) [] TyTrLeaf [Some (TPrim (Num U8))] (TyTrSplit (Cons (Some TSK_S) (Cons None (Cons (Some TSK_L) (Cons None [])))) [] TyTrLeaf [Some (TPrim (Num U8))] (TyTrSplit (Cons (Some TSK_S) (Cons (Some TSK_L) (append (replicate 3 None) []))) [] TyTrLeaf [Some (TPrim (Num U8))] (TyTrSplit (Cons (Some TSK_S) (Cons (Some TSK_L) (append (replicate 4 None) []))) [] TyTrLeaf [Some (TPrim (Num U8))] (TyTrSplit (Cons (Some TSK_S) (Cons (Some TSK_S) (append (replicate 5 None) []))) [] TyTrLeaf [Some (TPrim (Num U8))] (TyTrSplit (Cons (Some TSK_L) (Cons (Some TSK_L) (Cons (Some TSK_L) (append (replicate 5 None) [])))) [] TyTrLeaf [Some (TPrim (Num U8))] (TyTrSplit (Cons (Some TSK_S) (append (replicate 8 None) [])) [] TyTrLeaf [Some (TPrim (Num U8))] (TyTrSplit (Cons (Some TSK_S) (Cons (Some TSK_L) (append (replicate 8 None) []))) [] TyTrLeaf [Some (TPrim (Num U8))] (TyTrSplit (Cons (Some TSK_S) (Cons (Some TSK_L) (append (replicate 9 None) []))) [] TyTrLeaf [Some (TPrim (Num U8))] (TyTrSplit (Cons (Some TSK_S) (Cons (Some TSK_L) (append (replicate 10 None) []))) [] TyTrLeaf [Some (TPrim (Num U8))] (TyTrSplit (Cons (Some TSK_S) (Cons (Some TSK_S) (append (replicate 11 None) []))) [] TyTrLeaf [Some (TPrim (Num U8))] (TyTrSplit (Cons None (Cons (Some TSK_S) (Cons (Some TSK_S) (append (replicate 11 None) [])))) [] TyTrLeaf [Some (TPrim Bool)] (TyTrSplit (Cons None (Cons (Some TSK_S) (Cons (Some TSK_L) (append (replicate 12 None) [])))) [] TyTrLeaf [Some (TPrim Bool)] (TyTrSplit (append (replicate 2 None) (Cons (Some TSK_L) (Cons None (Cons (Some TSK_L) (append (replicate 11 None) []))))) [] TyTrLeaf [Some (TPrim Bool)] (TyTrSplit (Cons (Some TSK_L) (Cons (Some TSK_L) (append (replicate 15 None) []))) [] TyTrLeaf [Some (TPrim Bool)] (TyTrSplit (Cons (Some TSK_L) (append (replicate 2 None) (Cons (Some TSK_L) (append (replicate 14 None) [])))) [] TyTrLeaf [Some (TPrim Bool)] (TyTrSplit (Cons (Some TSK_L) (append (replicate 18 None) [])) [] TyTrLeaf [] (TyTrSplit (append (replicate 19 None) []) [] TyTrLeaf [] TyTrLeaf)))))))))))))))))))"

definition
  "ops64_typetree \<equiv> TyTrSplit (Cons (Some TSK_L) []) [] TyTrLeaf [Some (TPrim (Num U64))] (TyTrSplit (append (replicate 2 None) []) [] TyTrLeaf [Some (TPrim (Num U8))] (TyTrSplit (Cons (Some TSK_L) (append (replicate 2 None) [])) [] TyTrLeaf [Some (TPrim (Num U64))] (TyTrSplit (Cons (Some TSK_L) (Cons None (Cons (Some TSK_S) (Cons None [])))) [] TyTrLeaf [Some (TPrim (Num U64))] (TyTrSplit (Cons (Some TSK_S) (append (replicate 2 None) (Cons (Some TSK_L) (Cons None [])))) [] TyTrLeaf [Some (TPrim (Num U64))] (TyTrSplit (Cons (Some TSK_S) (Cons (Some TSK_L) (append (replicate 4 None) []))) [] TyTrLeaf [Some (TPrim (Num U64))] (TyTrSplit (Cons (Some TSK_S) (Cons (Some TSK_L) (append (replicate 5 None) []))) [] TyTrLeaf [Some (TPrim (Num U64))] (TyTrSplit (Cons (Some TSK_S) (Cons (Some TSK_L) (append (replicate 6 None) []))) [] TyTrLeaf [Some (TPrim (Num U64))] (TyTrSplit (Cons (Some TSK_L) (Cons (Some TSK_L) (append (replicate 7 None) []))) [] TyTrLeaf [Some (TPrim (Num U64))] (TyTrSplit (Cons (Some TSK_S) (append (replicate 9 None) [])) [] TyTrLeaf [Some (TPrim (Num U64))] (TyTrSplit (Cons (Some TSK_S) (Cons (Some TSK_L) (append (replicate 9 None) []))) [] TyTrLeaf [Some (TPrim (Num U64))] (TyTrSplit (Cons (Some TSK_S) (Cons (Some TSK_L) (append (replicate 10 None) []))) [] TyTrLeaf [Some (TPrim (Num U64))] (TyTrSplit (Cons (Some TSK_S) (Cons (Some TSK_L) (append (replicate 11 None) []))) [] TyTrLeaf [Some (TPrim (Num U64))] (TyTrSplit (Cons (Some TSK_S) (Cons (Some TSK_S) (append (replicate 12 None) []))) [] TyTrLeaf [Some (TPrim (Num U64))] (TyTrSplit (Cons None (Cons (Some TSK_S) (Cons (Some TSK_S) (append (replicate 12 None) [])))) [] TyTrLeaf [Some (TPrim Bool)] (TyTrSplit (Cons None (Cons (Some TSK_S) (Cons (Some TSK_L) (append (replicate 13 None) [])))) [] TyTrLeaf [Some (TPrim Bool)] (TyTrSplit (append (replicate 2 None) (Cons (Some TSK_L) (Cons None (Cons (Some TSK_L) (append (replicate 12 None) []))))) [] TyTrLeaf [Some (TPrim Bool)] (TyTrSplit (Cons (Some TSK_L) (Cons (Some TSK_L) (append (replicate 16 None) []))) [] TyTrLeaf [Some (TPrim Bool)] (TyTrSplit (Cons (Some TSK_L) (append (replicate 2 None) (Cons (Some TSK_L) (append (replicate 15 None) [])))) [] TyTrLeaf [Some (TPrim Bool)] (TyTrSplit (Cons (Some TSK_L) (append (replicate 19 None) [])) [] TyTrLeaf [] (TyTrSplit (append (replicate 20 None) []) [] (TyTrSplit (append (replicate 20 None) []) [] TyTrLeaf [Some (TPrim (Num U8))] TyTrLeaf) [] (TyTrSplit (append (replicate 20 None) []) [] TyTrLeaf [Some (TPrim (Num U8))] TyTrLeaf)))))))))))))))))))))"

definition
  "ops32_typetree \<equiv> TyTrSplit (Cons (Some TSK_L) []) [] TyTrLeaf [Some (TPrim (Num U32))] (TyTrSplit (append (replicate 2 None) []) [] TyTrLeaf [Some (TPrim (Num U8))] (TyTrSplit (Cons (Some TSK_L) (append (replicate 2 None) [])) [] TyTrLeaf [Some (TPrim (Num U32))] (TyTrSplit (Cons (Some TSK_L) (Cons None (Cons (Some TSK_S) (Cons None [])))) [] TyTrLeaf [Some (TPrim (Num U32))] (TyTrSplit (Cons (Some TSK_S) (append (replicate 2 None) (Cons (Some TSK_L) (Cons None [])))) [] TyTrLeaf [Some (TPrim (Num U32))] (TyTrSplit (Cons (Some TSK_S) (Cons (Some TSK_L) (append (replicate 4 None) []))) [] TyTrLeaf [Some (TPrim (Num U32))] (TyTrSplit (Cons (Some TSK_S) (Cons (Some TSK_L) (append (replicate 5 None) []))) [] TyTrLeaf [Some (TPrim (Num U32))] (TyTrSplit (Cons (Some TSK_S) (Cons (Some TSK_S) (append (replicate 6 None) []))) [] TyTrLeaf [Some (TPrim (Num U32))] (TyTrSplit (Cons (Some TSK_L) (Cons (Some TSK_L) (Cons (Some TSK_L) (append (replicate 6 None) [])))) [] TyTrLeaf [Some (TPrim (Num U32))] (TyTrSplit (Cons (Some TSK_S) (append (replicate 9 None) [])) [] TyTrLeaf [Some (TPrim (Num U32))] (TyTrSplit (Cons (Some TSK_S) (Cons (Some TSK_L) (append (replicate 9 None) []))) [] TyTrLeaf [Some (TPrim (Num U32))] (TyTrSplit (Cons (Some TSK_S) (Cons (Some TSK_L) (append (replicate 10 None) []))) [] TyTrLeaf [Some (TPrim (Num U32))] (TyTrSplit (Cons (Some TSK_S) (Cons (Some TSK_L) (append (replicate 11 None) []))) [] TyTrLeaf [Some (TPrim (Num U32))] (TyTrSplit (Cons (Some TSK_S) (Cons (Some TSK_S) (append (replicate 12 None) []))) [] TyTrLeaf [Some (TPrim (Num U32))] (TyTrSplit (Cons None (Cons (Some TSK_S) (Cons (Some TSK_S) (append (replicate 12 None) [])))) [] TyTrLeaf [Some (TPrim Bool)] (TyTrSplit (Cons None (Cons (Some TSK_S) (Cons (Some TSK_L) (append (replicate 13 None) [])))) [] TyTrLeaf [Some (TPrim Bool)] (TyTrSplit (append (replicate 2 None) (Cons (Some TSK_L) (Cons None (Cons (Some TSK_L) (append (replicate 12 None) []))))) [] TyTrLeaf [Some (TPrim Bool)] (TyTrSplit (Cons (Some TSK_L) (Cons (Some TSK_L) (append (replicate 16 None) []))) [] TyTrLeaf [Some (TPrim Bool)] (TyTrSplit (Cons (Some TSK_L) (append (replicate 2 None) (Cons (Some TSK_L) (append (replicate 15 None) [])))) [] TyTrLeaf [Some (TPrim Bool)] (TyTrSplit (Cons (Some TSK_L) (append (replicate 19 None) [])) [] TyTrLeaf [] (TyTrSplit (append (replicate 20 None) []) [] (TyTrSplit (append (replicate 20 None) []) [] TyTrLeaf [Some (TPrim (Num U8))] TyTrLeaf) [] (TyTrSplit (append (replicate 20 None) []) [] TyTrLeaf [Some (TPrim (Num U8))] TyTrLeaf)))))))))))))))))))))"

definition
  "ops16_typetree \<equiv> TyTrSplit (Cons (Some TSK_L) []) [] TyTrLeaf [Some (TPrim (Num U16))] (TyTrSplit (append (replicate 2 None) []) [] TyTrLeaf [Some (TPrim (Num U8))] (TyTrSplit (Cons (Some TSK_L) (append (replicate 2 None) [])) [] TyTrLeaf [Some (TPrim (Num U16))] (TyTrSplit (Cons (Some TSK_L) (Cons None (Cons (Some TSK_S) (Cons None [])))) [] TyTrLeaf [Some (TPrim (Num U16))] (TyTrSplit (Cons (Some TSK_S) (append (replicate 2 None) (Cons (Some TSK_L) (Cons None [])))) [] TyTrLeaf [Some (TPrim (Num U16))] (TyTrSplit (Cons (Some TSK_S) (Cons (Some TSK_L) (append (replicate 4 None) []))) [] TyTrLeaf [Some (TPrim (Num U16))] (TyTrSplit (Cons (Some TSK_S) (Cons (Some TSK_L) (append (replicate 5 None) []))) [] TyTrLeaf [Some (TPrim (Num U16))] (TyTrSplit (Cons (Some TSK_S) (Cons (Some TSK_S) (append (replicate 6 None) []))) [] TyTrLeaf [Some (TPrim (Num U16))] (TyTrSplit (Cons (Some TSK_L) (Cons (Some TSK_L) (Cons (Some TSK_L) (append (replicate 6 None) [])))) [] TyTrLeaf [Some (TPrim (Num U16))] (TyTrSplit (Cons (Some TSK_S) (append (replicate 9 None) [])) [] TyTrLeaf [Some (TPrim (Num U16))] (TyTrSplit (Cons (Some TSK_S) (Cons (Some TSK_L) (append (replicate 9 None) []))) [] TyTrLeaf [Some (TPrim (Num U16))] (TyTrSplit (Cons (Some TSK_S) (Cons (Some TSK_L) (append (replicate 10 None) []))) [] TyTrLeaf [Some (TPrim (Num U16))] (TyTrSplit (Cons (Some TSK_S) (Cons (Some TSK_L) (append (replicate 11 None) []))) [] TyTrLeaf [Some (TPrim (Num U16))] (TyTrSplit (Cons (Some TSK_S) (Cons (Some TSK_S) (append (replicate 12 None) []))) [] TyTrLeaf [Some (TPrim (Num U16))] (TyTrSplit (Cons None (Cons (Some TSK_S) (Cons (Some TSK_S) (append (replicate 12 None) [])))) [] TyTrLeaf [Some (TPrim Bool)] (TyTrSplit (Cons None (Cons (Some TSK_S) (Cons (Some TSK_L) (append (replicate 13 None) [])))) [] TyTrLeaf [Some (TPrim Bool)] (TyTrSplit (append (replicate 2 None) (Cons (Some TSK_L) (Cons None (Cons (Some TSK_L) (append (replicate 12 None) []))))) [] TyTrLeaf [Some (TPrim Bool)] (TyTrSplit (Cons (Some TSK_L) (Cons (Some TSK_L) (append (replicate 16 None) []))) [] TyTrLeaf [Some (TPrim Bool)] (TyTrSplit (Cons (Some TSK_L) (append (replicate 2 None) (Cons (Some TSK_L) (append (replicate 15 None) [])))) [] TyTrLeaf [Some (TPrim Bool)] (TyTrSplit (Cons (Some TSK_L) (append (replicate 19 None) [])) [] TyTrLeaf [] (TyTrSplit (append (replicate 20 None) []) [] (TyTrSplit (append (replicate 20 None) []) [] TyTrLeaf [Some (TPrim (Num U8))] TyTrLeaf) [] (TyTrSplit (append (replicate 20 None) []) [] TyTrLeaf [Some (TPrim (Num U8))] TyTrLeaf)))))))))))))))))))))"

definition
  "bool_ops_typetree \<equiv> TyTrSplit (Cons (Some TSK_L) []) [] TyTrLeaf [Some (TPrim (Num U32))] (TyTrSplit (append (replicate 2 None) []) [] TyTrLeaf [Some (TPrim (Num U8))] (TyTrSplit (Cons (Some TSK_L) (append (replicate 2 None) [])) [] TyTrLeaf [Some (TPrim (Num U32))] (TyTrSplit (Cons (Some TSK_L) (Cons None (Cons (Some TSK_S) (Cons None [])))) [] TyTrLeaf [Some (TPrim (Num U32))] (TyTrSplit (Cons (Some TSK_S) (append (replicate 2 None) (Cons (Some TSK_S) (Cons None [])))) [] TyTrLeaf [Some (TPrim (Num U32))] (TyTrSplit (Cons None (Cons (Some TSK_S) (append (replicate 2 None) (Cons (Some TSK_S) (Cons None []))))) [] TyTrLeaf [Some (TPrim Bool)] (TyTrSplit (Cons (Some TSK_L) (Cons (Some TSK_S) (Cons (Some TSK_L) (append (replicate 4 None) [])))) [] TyTrLeaf [Some (TPrim Bool)] (TyTrSplit (append (replicate 2 None) (Cons (Some TSK_L) (append (replicate 3 None) (Cons (Some TSK_L) (Cons None []))))) [] TyTrLeaf [Some (TPrim Bool)] (TyTrSplit (Cons (Some TSK_S) (Cons (Some TSK_L) (append (replicate 7 None) []))) [] TyTrLeaf [Some (TPrim Bool)] (TyTrSplit (Cons (Some TSK_L) (Cons (Some TSK_L) (append (replicate 8 None) []))) [] TyTrLeaf [Some (TPrim Bool)] (TyTrSplit (Cons (Some TSK_L) (append (replicate 10 None) [])) [] TyTrLeaf [Some (TPrim Bool)] (TyTrSplit (append (replicate 12 None) []) [] TyTrLeaf [Some (TPrim Bool)] (TyTrSplit (Cons (Some TSK_L) (Cons (Some TSK_L) (append (replicate 11 None) []))) [] TyTrLeaf [Some (TPrim Bool)] (TyTrSplit (Cons (Some TSK_L) (append (replicate 13 None) [])) [] TyTrLeaf [Some (TPrim Bool)] (TyTrSplit (append (replicate 15 None) []) [] TyTrLeaf [Some (TPrim Bool)] (TyTrSplit (Cons (Some TSK_L) (Cons (Some TSK_L) (append (replicate 14 None) []))) [] TyTrLeaf [Some (TPrim Bool)] TyTrLeaf)))))))))))))))"

ML {* open TTyping_Tactics *}

ML_quiet {*
val typing_helper_1_script : tac list = [
(RTac @{thm kind_tprim[where k = "{E,S,D}"]})
] *}

lemma typing_helper_1[unfolded abbreviated_type_defs] :
  "kinding [] (TPrim (Num U8)) {E, S, D}"
  apply (unfold abbreviated_type_defs)?
  apply (tactic {* map (fn t => DETERM (interpret_tac t @{context} 1)) typing_helper_1_script |> EVERY *})
  done

ML_quiet {*
val typing_helper_2_script : tac list = [
(RTac @{thm kind_tprim[where k = "{E,S,D}"]})
] *}

lemma typing_helper_2[unfolded abbreviated_type_defs] :
  "kinding [] (TPrim Bool) {E, S, D}"
  apply (unfold abbreviated_type_defs)?
  apply (tactic {* map (fn t => DETERM (interpret_tac t @{context} 1)) typing_helper_2_script |> EVERY *})
  done

ML_quiet {*
val typing_helper_3_script : tac list = [
(RTac @{thm kind_tprim[where k = "{E,S,D}"]})
] *}

lemma typing_helper_3[unfolded abbreviated_type_defs] :
  "kinding [] (TPrim (Num U64)) {E, S, D}"
  apply (unfold abbreviated_type_defs)?
  apply (tactic {* map (fn t => DETERM (interpret_tac t @{context} 1)) typing_helper_3_script |> EVERY *})
  done

ML_quiet {*
val typing_helper_4_script : tac list = [
(RTac @{thm kind_tprim[where k = "{E,S,D}"]})
] *}

lemma typing_helper_4[unfolded abbreviated_type_defs] :
  "kinding [] (TPrim (Num U32)) {E, S, D}"
  apply (unfold abbreviated_type_defs)?
  apply (tactic {* map (fn t => DETERM (interpret_tac t @{context} 1)) typing_helper_4_script |> EVERY *})
  done

ML_quiet {*
val typing_helper_5_script : tac list = [
(RTac @{thm kind_tprim[where k = "{E,S,D}"]})
] *}

lemma typing_helper_5[unfolded abbreviated_type_defs] :
  "kinding [] (TPrim (Num U16)) {E, S, D}"
  apply (unfold abbreviated_type_defs)?
  apply (tactic {* map (fn t => DETERM (interpret_tac t @{context} 1)) typing_helper_5_script |> EVERY *})
  done

ML_quiet {*
val ops8_typecorrect_script : hints list = [
KindingTacs [(RTac @{thm typing_helper_1})],
KindingTacs [(RTac @{thm typing_helper_1})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_1})],
TypingTacs [(RTac @{thm typing_lit'}),(SimpTac ([@{thm empty_def}],[])),(WeakeningTac []),(SimpTac ([],[]))],
KindingTacs [(RTac @{thm typing_helper_1})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_1})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_1})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_1})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_1})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_1})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_1})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_1})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_1})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_1})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_1})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_2})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_2})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_2})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_2})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_2})],
TypingTacs [],
TypingTacs [],
TypingTacs [(RTac @{thm typing_lit'}),(SimpTac ([@{thm empty_def}],[])),(WeakeningTac []),(SimpTac ([],[]))],
TypingTacs [(RTac @{thm typing_lit'}),(SimpTac ([@{thm empty_def}],[])),(WeakeningTac []),(SimpTac ([],[]))]
] *}

ML_quiet {*
val ops8_ttyping_details_future = get_all_typing_details_future @{context} "ops8"
   ops8_typecorrect_script*}

lemma ops8_typecorrect :
  "\<Xi>, fst ops8_type, (ops8_typetree, [Some (fst (snd ops8_type))]) T\<turnstile> ops8 : snd (snd ops8_type)"
  apply (tactic {* resolve_future_typecorrect @{context} ops8_ttyping_details_future *})
  done

ML_quiet {*
val ops64_typecorrect_script : hints list = [
KindingTacs [(RTac @{thm typing_helper_3})],
KindingTacs [(RTac @{thm typing_helper_3})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_1})],
TypingTacs [(RTac @{thm typing_lit'}),(SimpTac ([@{thm empty_def}],[])),(WeakeningTac []),(SimpTac ([],[]))],
KindingTacs [(RTac @{thm typing_helper_3})],
TypingTacs [(RTac @{thm typing_cast}),(RTac @{thm typing_var}),(SimpTac ([@{thm empty_def}],[])),(WeakeningTac [@{thm typing_helper_1}]),(SimpTac ([],[])),(SimpTac ([],[]))],
KindingTacs [(RTac @{thm typing_helper_3})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_3})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_3})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_3})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_3})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_3})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_3})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_3})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_3})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_3})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_3})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_2})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_2})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_2})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_2})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_2})],
TypingTacs [],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_1})],
TypingTacs [(RTac @{thm typing_lit'}),(SimpTac ([@{thm empty_def}],[])),(WeakeningTac []),(SimpTac ([],[]))],
TypingTacs [(RTac @{thm typing_cast}),(RTac @{thm typing_var}),(SimpTac ([@{thm empty_def}],[])),(WeakeningTac [@{thm typing_helper_1}]),(SimpTac ([],[])),(SimpTac ([],[]))],
KindingTacs [(RTac @{thm typing_helper_1})],
TypingTacs [(RTac @{thm typing_lit'}),(SimpTac ([@{thm empty_def}],[])),(WeakeningTac []),(SimpTac ([],[]))],
TypingTacs [(RTac @{thm typing_cast}),(RTac @{thm typing_var}),(SimpTac ([@{thm empty_def}],[])),(WeakeningTac [@{thm typing_helper_1}]),(SimpTac ([],[])),(SimpTac ([],[]))]
] *}

ML_quiet {*
val ops64_ttyping_details_future = get_all_typing_details_future @{context} "ops64"
   ops64_typecorrect_script*}

lemma ops64_typecorrect :
  "\<Xi>, fst ops64_type, (ops64_typetree, [Some (fst (snd ops64_type))]) T\<turnstile> ops64 : snd (snd ops64_type)"
  apply (tactic {* resolve_future_typecorrect @{context} ops64_ttyping_details_future *})
  done

ML_quiet {*
val ops32_typecorrect_script : hints list = [
KindingTacs [(RTac @{thm typing_helper_4})],
KindingTacs [(RTac @{thm typing_helper_4})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_1})],
TypingTacs [(RTac @{thm typing_lit'}),(SimpTac ([@{thm empty_def}],[])),(WeakeningTac []),(SimpTac ([],[]))],
KindingTacs [(RTac @{thm typing_helper_4})],
TypingTacs [(RTac @{thm typing_cast}),(RTac @{thm typing_var}),(SimpTac ([@{thm empty_def}],[])),(WeakeningTac [@{thm typing_helper_1}]),(SimpTac ([],[])),(SimpTac ([],[]))],
KindingTacs [(RTac @{thm typing_helper_4})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_4})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_4})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_4})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_4})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_4})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_4})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_4})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_4})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_4})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_4})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_2})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_2})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_2})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_2})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_2})],
TypingTacs [],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_1})],
TypingTacs [(RTac @{thm typing_lit'}),(SimpTac ([@{thm empty_def}],[])),(WeakeningTac []),(SimpTac ([],[]))],
TypingTacs [(RTac @{thm typing_cast}),(RTac @{thm typing_var}),(SimpTac ([@{thm empty_def}],[])),(WeakeningTac [@{thm typing_helper_1}]),(SimpTac ([],[])),(SimpTac ([],[]))],
KindingTacs [(RTac @{thm typing_helper_1})],
TypingTacs [(RTac @{thm typing_lit'}),(SimpTac ([@{thm empty_def}],[])),(WeakeningTac []),(SimpTac ([],[]))],
TypingTacs [(RTac @{thm typing_cast}),(RTac @{thm typing_var}),(SimpTac ([@{thm empty_def}],[])),(WeakeningTac [@{thm typing_helper_1}]),(SimpTac ([],[])),(SimpTac ([],[]))]
] *}

ML_quiet {*
val ops32_ttyping_details_future = get_all_typing_details_future @{context} "ops32"
   ops32_typecorrect_script*}

lemma ops32_typecorrect :
  "\<Xi>, fst ops32_type, (ops32_typetree, [Some (fst (snd ops32_type))]) T\<turnstile> ops32 : snd (snd ops32_type)"
  apply (tactic {* resolve_future_typecorrect @{context} ops32_ttyping_details_future *})
  done

ML_quiet {*
val ops16_typecorrect_script : hints list = [
KindingTacs [(RTac @{thm typing_helper_5})],
KindingTacs [(RTac @{thm typing_helper_5})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_1})],
TypingTacs [(RTac @{thm typing_lit'}),(SimpTac ([@{thm empty_def}],[])),(WeakeningTac []),(SimpTac ([],[]))],
KindingTacs [(RTac @{thm typing_helper_5})],
TypingTacs [(RTac @{thm typing_cast}),(RTac @{thm typing_var}),(SimpTac ([@{thm empty_def}],[])),(WeakeningTac [@{thm typing_helper_1}]),(SimpTac ([],[])),(SimpTac ([],[]))],
KindingTacs [(RTac @{thm typing_helper_5})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_5})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_5})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_5})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_5})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_5})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_5})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_5})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_5})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_5})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_5})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_2})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_2})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_2})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_2})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_2})],
TypingTacs [],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_1})],
TypingTacs [(RTac @{thm typing_lit'}),(SimpTac ([@{thm empty_def}],[])),(WeakeningTac []),(SimpTac ([],[]))],
TypingTacs [(RTac @{thm typing_cast}),(RTac @{thm typing_var}),(SimpTac ([@{thm empty_def}],[])),(WeakeningTac [@{thm typing_helper_1}]),(SimpTac ([],[])),(SimpTac ([],[]))],
KindingTacs [(RTac @{thm typing_helper_1})],
TypingTacs [(RTac @{thm typing_lit'}),(SimpTac ([@{thm empty_def}],[])),(WeakeningTac []),(SimpTac ([],[]))],
TypingTacs [(RTac @{thm typing_cast}),(RTac @{thm typing_var}),(SimpTac ([@{thm empty_def}],[])),(WeakeningTac [@{thm typing_helper_1}]),(SimpTac ([],[])),(SimpTac ([],[]))]
] *}

ML_quiet {*
val ops16_ttyping_details_future = get_all_typing_details_future @{context} "ops16"
   ops16_typecorrect_script*}

lemma ops16_typecorrect :
  "\<Xi>, fst ops16_type, (ops16_typetree, [Some (fst (snd ops16_type))]) T\<turnstile> ops16 : snd (snd ops16_type)"
  apply (tactic {* resolve_future_typecorrect @{context} ops16_ttyping_details_future *})
  done

ML_quiet {*
val bool_ops_typecorrect_script : hints list = [
KindingTacs [(RTac @{thm typing_helper_4})],
KindingTacs [(RTac @{thm typing_helper_4})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_1})],
TypingTacs [(RTac @{thm typing_lit'}),(SimpTac ([@{thm empty_def}],[])),(WeakeningTac []),(SimpTac ([],[]))],
KindingTacs [(RTac @{thm typing_helper_4})],
TypingTacs [(RTac @{thm typing_cast}),(RTac @{thm typing_var}),(SimpTac ([@{thm empty_def}],[])),(WeakeningTac [@{thm typing_helper_1}]),(SimpTac ([],[])),(SimpTac ([],[]))],
KindingTacs [(RTac @{thm typing_helper_4})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_4})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_2})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_2})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_2})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_2})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_2})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_2})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_2})],
TypingTacs [(RTac @{thm typing_lit'}),(SimpTac ([@{thm empty_def}],[])),(WeakeningTac []),(SimpTac ([],[]))],
KindingTacs [(RTac @{thm typing_helper_2})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_2})],
TypingTacs [],
KindingTacs [(RTac @{thm typing_helper_2})],
TypingTacs [(RTac @{thm typing_lit'}),(SimpTac ([@{thm empty_def}],[])),(WeakeningTac []),(SimpTac ([],[]))],
KindingTacs [(RTac @{thm typing_helper_2})],
TypingTacs [],
TypingTacs []
] *}

ML_quiet {*
val bool_ops_ttyping_details_future = get_all_typing_details_future @{context} "bool_ops"
   bool_ops_typecorrect_script*}

lemma bool_ops_typecorrect :
  "\<Xi>, fst bool_ops_type, (bool_ops_typetree, [Some (fst (snd bool_ops_type))]) T\<turnstile> bool_ops : snd (snd bool_ops_type)"
  apply (tactic {* resolve_future_typecorrect @{context} bool_ops_ttyping_details_future *})
  done

ML_quiet {*
val (_, ops8_typing_tree, ops8_typing_bucket)
= Future.join ops8_ttyping_details_future
*}

ML_quiet {*
val (_, ops64_typing_tree, ops64_typing_bucket)
= Future.join ops64_ttyping_details_future
*}

ML_quiet {*
val (_, ops32_typing_tree, ops32_typing_bucket)
= Future.join ops32_ttyping_details_future
*}

ML_quiet {*
val (_, ops16_typing_tree, ops16_typing_bucket)
= Future.join ops16_ttyping_details_future
*}

ML_quiet {*
val (_, bool_ops_typing_tree, bool_ops_typing_bucket)
= Future.join bool_ops_ttyping_details_future
*}

(* end Cogent semantics *)

(* C semantics, generated by C parser *)
new_C_include_dir "../../cogent/tests"
install_C_file "pass_prim-ops.c"

autocorres [ts_rules=nondet, no_opt, gen_word_heaps, skip_word_abs] "pass_prim-ops.c"

instantiation bool_t_C :: cogent_C_val
begin
definition type_rel_bool_t_C_def:
  "type_rel typ (_ :: bool_t_C itself) \<equiv> (typ = RPrim Bool)"

definition val_rel_bool_t_C_def:
  "val_rel uv (x :: bool_t_C) \<equiv> uv = UPrim (LBool (bool_t_C.boolean_C x \<noteq> 0))"
instance ..
end

(* Relation between Cogent and C data *)
local_setup{* local_setup_val_rel_type_rel_put_them_in_buckets "pass_prim-ops.c" *}

(* Lemma bucket.*)
ML{* TypeRelSimp.get @{context} *}
ML{* ValRelSimp.get @{context} *}

lemmas val_rel_simps[ValRelSimp] = val_rel_word val_rel_ptr_def val_rel_bool_t_C_def
lemmas type_rel_simps[TypeRelSimp] = type_rel_word type_rel_ptr_def type_rel_bool_t_C_def

class cogent_C_heap = cogent_C_val +
  fixes is_valid    :: "lifted_globals \<Rightarrow> 'a ptr \<Rightarrow> bool"
  fixes heap        :: "lifted_globals \<Rightarrow> 'a ptr \<Rightarrow> 'a"
  fixes heap_update :: "(('a ptr \<Rightarrow> 'a) \<Rightarrow> 'a ptr \<Rightarrow> 'a) \<Rightarrow> lifted_globals \<Rightarrow> lifted_globals"

local_setup{* local_setup_instantiate_cogent_C_heaps_store_them_in_buckets "pass_prim-ops.c"*}
ML{* HeapSimp.get @{context}; IsValidSimp.get @{context} *}

locale take_cogent = "pass_prim-ops" + update_sem_init
begin

(* Relation between program heaps *)
definition
  heap_rel_ptr ::
  "(funtyp, abstyp, ptrtyp) store \<Rightarrow> lifted_globals \<Rightarrow>
   ('a :: cogent_C_heap) ptr \<Rightarrow> bool"
where
  "heap_rel_ptr \<sigma> h p \<equiv>
   (\<forall>uv.
     \<sigma> (ptr_val p) = Some uv \<longrightarrow>
     type_rel (uval_repr uv) TYPE('a) \<longrightarrow>
     is_valid h p \<and> val_rel uv (heap h p))"

lemma heap_rel_ptr_meta:
  "heap_rel_ptr = heap_rel_meta is_valid heap"
  by (simp add: heap_rel_ptr_def[abs_def] heap_rel_meta_def[abs_def])

lemmas heap_rel_def = TrueI

definition state_rel :: "((funtyp, abstyp, ptrtyp) store \<times> lifted_globals) set"
where
  "state_rel = {(\<sigma>, h). True}"

(* Preprocess AutoCorres output *)
local_setup {* fold tidy_C_fun_def' Cogent_functions *}

(* Defined here because it relies on bool_t_C *)

lemma corres_if_base:
  assumes split\<Gamma>: "[] \<turnstile> \<Gamma>' \<leadsto> \<Gamma>1 | \<Gamma>2"
  assumes typing_cond: "\<Xi>', [], \<Gamma>1 \<turnstile> Var c : TPrim Bool"
  assumes val_rel_cond: "\<gamma>!c = UPrim (LBool (bool_val' c' \<noteq> (0::word8)))"
  assumes corres_true: "corres srel a a' \<xi> \<gamma> \<Xi>' \<Gamma>2 \<sigma> s"
  assumes corres_false: "corres srel b b' \<xi> \<gamma> \<Xi>' \<Gamma>2 \<sigma> s"
  shows "corres srel (If (Var c) a b)
           (do x \<leftarrow> condition (\<lambda>s. bool_val' c' \<noteq> 0) a' b'; gets (\<lambda>_. x) od)
           \<xi> \<gamma> \<Xi>' \<Gamma>' \<sigma> s"
  apply (clarsimp simp: corres_def snd_condition in_condition)
  apply (rename_tac r w)
  apply (insert typing_cond)
  apply (erule typing_varE)
  apply (frule matches_ptrs_split'[OF split\<Gamma>])
  apply clarsimp
  apply (rename_tac r' w' r'' w'')
  apply (frule_tac \<Gamma>=\<Gamma>1 in matches_ptrs_proj', simp+)
  apply clarsimp
  apply (rename_tac rr')
  apply (insert val_rel_cond[unfolded val_rel_bool_t_C_def])
  apply clarsimp
  apply (cases "bool_val' c'=0")
   apply (insert corres_false[unfolded corres_def])[1]
   apply simp
   apply (erule impE, fast)
   apply clarsimp
   apply (rename_tac v' s')
   apply (erule_tac x=v' in allE)
   apply (erule_tac x=s' in allE )
   apply clarsimp
   apply (rename_tac \<sigma>' v)
   apply (rule_tac x=\<sigma>' in exI)
   apply (rule_tac x=v in exI)
   apply (fastforce intro!: u_sem_if u_sem_var elim: subst split: uval.splits lit.splits)
  apply (insert corres_true[unfolded corres_def])[1]
  apply simp
  apply (erule impE, fast)
  apply clarsimp
  apply (rename_tac v' s')
  apply (erule_tac x=v' in allE)
  apply (erule_tac x=s' in allE )
  apply clarsimp
  apply (rename_tac \<sigma>' v)
  apply (rule_tac x=\<sigma>' in exI)
  apply (rule_tac x=v in exI)
  apply (fastforce intro!: u_sem_if u_sem_var elim: subst split: uval.splits lit.splits)
  done

lemmas corres_if = corres_if_base[where bool_val' = boolean_C,
                     OF _ _ val_rel_bool_t_C_def[THEN meta_eq_to_obj_eq, THEN iffD1]]

(* dummy *)
lemmas corres_nested_let = TrueI

lemma ops32_corres:
  "val_rel a a' \<Longrightarrow> corres state_rel ops32 (ops32' a') \<xi> [a] \<Xi> [Some (fst (snd ops32_type))] \<sigma> s"
  apply (tactic {* corres_tac @{context}
    (peel_two ops32_typing_tree)
    @{thms ops32_def ops32'_def' ops32_type_def abbreviated_type_defs} [] []
    @{thm corres_if} [] @{thms } @{thms } []
    @{thm LETBANG_TRUE_def} @{thms } true *})
  done

lemma ops64_corres:
  "val_rel a a' \<Longrightarrow> corres state_rel ops64 (ops64' a') \<xi> [a] \<Xi> [Some (fst (snd ops64_type))] \<sigma> s"
  apply (tactic {* corres_tac @{context}
    (peel_two ops64_typing_tree)
    @{thms ops64_def ops64'_def' ops64_type_def abbreviated_type_defs} [] []
    @{thm corres_if} [] @{thms } @{thms } []
    @{thm LETBANG_TRUE_def} @{thms } true *})
  done

lemma ops8_corres:
  "val_rel a a' \<Longrightarrow> corres state_rel ops8 (ops8' a') \<xi> [a] \<Xi> [Some (fst (snd ops8_type))] \<sigma> s"
  apply (tactic {* corres_tac @{context}
    (peel_two ops8_typing_tree)
    @{thms ops8_def ops8'_def' ops8_type_def abbreviated_type_defs} [] []
    @{thm corres_if} [] @{thms } @{thms } []
    @{thm LETBANG_TRUE_def} @{thms } true *})
  done

lemma ops16_corres:
  "val_rel a a' \<Longrightarrow> corres state_rel ops16 (ops16' a') \<xi> [a] \<Xi> [Some (fst (snd ops16_type))] \<sigma> s"
  apply (tactic {* corres_tac @{context}
    (peel_two ops16_typing_tree)
    @{thms ops16_def ops16'_def' ops16_type_def abbreviated_type_defs} [] []
    @{thm corres_if} [] @{thms } @{thms } []
    @{thm LETBANG_TRUE_def} @{thms } true *})
  done

lemma bool_ops_corres:
  "val_rel a a' \<Longrightarrow> corres state_rel bool_ops (bool_ops' a') \<xi> [a] \<Xi> [Some (fst (snd bool_ops_type))] \<sigma> s"
  apply (tactic {* corres_tac @{context}
    (peel_two bool_ops_typing_tree)
    @{thms bool_ops_def bool_ops'_def' bool_ops_type_def abbreviated_type_defs} [] []
    @{thm corres_if} [] @{thms } @{thms } []
    @{thm LETBANG_TRUE_def} @{thms } true *})
  done

end
end


(*<*)
(*
 * Copyright 2015, 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 Proofs
imports
  TSO
  Phases
  MarkObject
  StrongTricolour
  Valid_Refs
  Worklists
  Global_Noninterference
  Noninterference
  Initial_Conditions
begin

(*>*)
section\<open>Top-level safety \label{sec:top-level-correctness}\<close>

lemma (in gc) I:
  "\<lbrace> I \<rbrace> gc"
apply (simp add: I_defs)
apply (rule valid_pre)
apply ( rule valid_conj_lift valid_all_lift | fastforce )+
done

lemma (in sys) I:
  "\<lbrace> I \<rbrace> sys"
apply (simp add: I_defs)
apply (rule valid_pre)
apply ( rule valid_conj_lift valid_all_lift | fastforce )+
done

text\<open>

We need to separately treat the two cases of a single mutator and
multiple mutators. In the latter case we have the additional
obligation of showing mutual non-interference amongst mutators.

\<close>

lemma mut_invsL[intro]:
  "\<lbrace>I\<rbrace> mutator m \<lbrace>mut_m.invsL m'\<rbrace>"
proof(cases "m = m'")
  case True
  interpret mut_m m' by unfold_locales
  from True show ?thesis
    apply (simp add: I_defs)
    apply (rule valid_pre)
    apply ( rule valid_conj_lift | fastforce )+
    done
next
  case False
  then interpret mut_m' m' m by unfold_locales blast
  from False show ?thesis
    apply (simp add: I_defs)
    apply (rule valid_pre)
    apply ( rule valid_conj_lift | fastforce )+
    done
qed

(* FIXME split mutators_phase_inv from global invs to local invs. Move to StrongTricolour or similar. note dependence on I *)
lemma mutators_phase_inv[intro]:
  "\<lbrace> I \<rbrace> mutator m  \<lbrace> LSTP (mut_m.mutator_phase_inv m') \<rbrace>"
proof(cases "m = m'")
  case True
  interpret mut_m m' by unfold_locales
  from True show ?thesis
    apply (simp add: I_defs)
    apply (rule valid_pre)
    apply ( rule valid_conj_lift valid_all_lift | fastforce )+
    done
next
  case False
  then interpret mut_m' m' m by unfold_locales blast
  from False show ?thesis
    apply (simp add: I_defs)
    apply (rule valid_pre)
    apply ( rule valid_conj_lift valid_all_lift | fastforce )+
    done
qed

lemma (in mut_m) I:
  "\<lbrace> I \<rbrace> mutator m"
apply (simp add: I_def gc.invsL_def invs_def Local_Invariants.invsL_def)
apply (rule valid_pre)
apply ( rule valid_conj_lift valid_all_lift | fastforce )+
apply (simp add: I_defs)
done

context gc_system
begin

theorem I: "gc_system \<Turnstile>\<^bsub>pre\<^esub> I"
apply (rule VCG)
 apply (rule init_inv)
apply (rename_tac p)
apply (case_tac p, simp_all)
  apply (rule mut_m.I[unfolded valid_proc_def, simplified])
 apply (rule gc.I[unfolded valid_proc_def, simplified])
apply (rule sys.I[unfolded valid_proc_def, simplified])
done

text\<open>

\label{sec:proofs-headline-safety}

Our headline safety result follows directly.

\<close>

corollary safety: "gc_system \<Turnstile>\<^bsub>pre\<^esub> LSTP valid_refs"
using I unfolding I_def invs_def valid_refs_def prerun_valid_def
apply clarsimp
apply (drule_tac x=\<sigma> in spec)
apply (drule (1) mp)
apply (rule alwaysI)
apply (erule_tac i=i in alwaysE)
apply (clarsimp simp: valid_refs_invD(1))
done

end

text\<open>

The GC is correct for the remaining fixed-but-arbitrary initial
conditions.

\<close>

interpretation gc_system_interpretation: gc_system undefined .

(* unused_thms Main Sublist CIMP - *)

section\<open> A concrete system state \label{sec:concrete-system-state} \<close>

text\<open>

We demonstrate that our definitions are not vacuous by exhibiting a
concrete initial state that satisfies the initial conditions. The heap
is shown in Figure~\ref{fig:concrete-heap}. We use Isabelle's notation
for types of a given size.

\begin{figure}
  \centering
  \includegraphics{heap.pdf}
  \caption{A concrete system state.}
  \label{fig:concrete-heap}
\end{figure}

\<close>
(*<*)

end
(*>*)


(*  Title:      HOL/MicroJava/Comp/Index.thy
    Author:     Martin Strecker
*)

(* Index of variable in list of parameter names and local variables *)

theory Index
imports AuxLemmas DefsComp
begin

(*indexing a variable name among all variable declarations in a method body*)
definition index :: "java_mb => vname => nat" where
 "index ==  \<lambda> (pn,lv,blk,res) v.
  if v = This
  then 0
  else Suc (length (takeWhile (\<lambda> z. z~=v) (pn @ map fst lv)))"

lemma index_length_pns: "
  \<lbrakk> i = index (pns,lvars,blk,res) vn;
  wf_java_mdecl G C ((mn,pTs),rT, (pns,lvars,blk,res));
  vn \<in> set pns\<rbrakk>
  \<Longrightarrow> 0 < i \<and> i < Suc (length pns)"
  apply (simp add: wf_java_mdecl_def index_def)
  apply (subgoal_tac "vn \<noteq> This")
   apply (auto intro: length_takeWhile)
  done

lemma index_length_lvars: "
  \<lbrakk> i = index (pns,lvars,blk,res) vn;
  wf_java_mdecl G C ((mn,pTs),rT, (pns,lvars,blk,res));
  vn \<in> set (map fst lvars)\<rbrakk>
  \<Longrightarrow> (length pns) < i \<and> i < Suc((length pns) + (length lvars))"
  apply (simp add: wf_java_mdecl_def index_def)
  apply (subgoal_tac "vn \<noteq> This")
   apply simp
   apply (subgoal_tac "\<forall> x \<in> set pns. (\<lambda>z. z \<noteq> vn) x")
    apply simp
    apply (subgoal_tac "length (takeWhile (\<lambda>z. z \<noteq> vn) (map fst lvars)) < length (map fst lvars)")
     apply simp
    apply (rule length_takeWhile)
    apply simp
   apply (simp add: map_of_in_set)
   apply (intro strip notI)
   apply simp
  apply blast
  done

(***  index  ***)

lemma select_at_index :
  "x \<in> set (gjmb_plns (gmb G C S)) \<or> x = This
  \<Longrightarrow> (the (loc This) # glvs (gmb G C S) loc) ! (index (gmb G C S) x) = the (loc x)"
  apply (simp only: index_def gjmb_plns_def)
  apply (case_tac "gmb G C S" rule: prod.exhaust)
  apply (simp add: galldefs del: set_append map_append)
  apply (rename_tac a b)
  apply (case_tac b, simp add: gmb_def gjmb_lvs_def del: set_append map_append)
  apply (intro strip)
  apply (simp del: set_append map_append)
  apply (frule length_takeWhile)
  apply (frule_tac f = "(the \<circ> loc)" in nth_map)
  apply simp
  done

lemma lift_if: "(f (if b then t else e)) = (if b then (f t) else (f e))"
  by auto

lemma update_at_index: "
  \<lbrakk> distinct (gjmb_plns (gmb G C S));
  x \<in> set (gjmb_plns (gmb G C S)); x \<noteq> This \<rbrakk> \<Longrightarrow>
  (locvars_xstate G C S (Norm (h, l)))[index (gmb G C S) x := val] =
  locvars_xstate G C S (Norm (h, l(x\<mapsto>val)))"
  apply (simp only: locvars_xstate_def locvars_locals_def index_def)
  apply (case_tac "gmb G C S" rule: prod.exhaust, simp)
  apply (rename_tac a b)
  apply (case_tac b, simp)
  apply (rule conjI)
   apply (simp add: gl_def)
  apply (simp add: galldefs del: set_append map_append)
  done

(* !!!! incomprehensible: why can't List.takeWhile_append2 be applied the same
  way in the second case as in the first case ? *)
lemma index_of_var: "\<lbrakk> xvar \<notin> set pns; xvar \<notin> set (map fst zs); xvar \<noteq> This \<rbrakk>
  \<Longrightarrow> index (pns, zs @ ((xvar, xval) # xys), blk, res) xvar = Suc (length pns + length zs)"
  apply (simp add: index_def)
  apply (subgoal_tac "(\<And>x. ((x \<in> (set pns)) \<Longrightarrow> ((\<lambda>z. (z \<noteq> xvar))x)))")
   apply simp
   apply (subgoal_tac "(takeWhile (\<lambda>z. z \<noteq> xvar) (map fst zs @ xvar # map fst xys)) = map fst zs @ (takeWhile (\<lambda>z. z \<noteq> xvar) (xvar # map fst xys))")
    apply simp
   apply (rule List.takeWhile_append2)
   apply auto
  done

(* The following definition should replace the conditions in WellType.thy / wf_java_mdecl
*)
definition disjoint_varnames :: "[vname list, (vname \<times> ty) list] \<Rightarrow> bool" where
  "disjoint_varnames pns lvars \<equiv>
  distinct pns \<and> unique lvars \<and> This \<notin> set pns \<and> This \<notin> set (map fst lvars) \<and>
  (\<forall>pn\<in>set pns. pn \<notin> set (map fst lvars))"

lemma index_of_var2: "
  disjoint_varnames pns (lvars_pre @ (vn, ty) # lvars_post)
  \<Longrightarrow> index (pns, lvars_pre @ (vn, ty) # lvars_post, blk, res) vn =
  Suc (length pns + length lvars_pre)"
  apply (simp add: disjoint_varnames_def index_def unique_def)
  apply (subgoal_tac "vn \<noteq> This", simp)
   apply (subgoal_tac
    "takeWhile (\<lambda>z. z \<noteq> vn) (map fst lvars_pre @ vn # map fst lvars_post) =
    map fst lvars_pre @ takeWhile (\<lambda>z. z \<noteq> vn) (vn # map fst lvars_post)")
    apply simp
   apply (rule List.takeWhile_append2)
   apply auto
  done

lemma wf_java_mdecl_disjoint_varnames:
  "wf_java_mdecl G C (S,rT,(pns,lvars,blk,res))
  \<Longrightarrow> disjoint_varnames pns lvars"
  apply (cases S)
  apply (simp add: wf_java_mdecl_def disjoint_varnames_def  map_of_in_set)
  done

lemma wf_java_mdecl_length_pTs_pns:
  "wf_java_mdecl G C ((mn, pTs), rT, pns, lvars, blk, res)
  \<Longrightarrow> length pTs = length pns"
  by (simp add: wf_java_mdecl_def)

end


(*  Title:      HOL/Auth/n_mutualEx_lemma_inv__5_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_mutualEx Protocol Case Study*}

theory n_mutualEx_lemma_inv__5_on_rules imports n_mutualEx_lemma_on_inv__5
begin
section{*All lemmas on causal relation between inv__5*}
lemma lemma_inv__5_on_rules:
  assumes b1: "r \<in> rules N" and b2: "(\<exists> p__Inv0 p__Inv1. p__Inv0\<le>N\<and>p__Inv1\<le>N\<and>p__Inv0~=p__Inv1\<and>f=inv__5  p__Inv0 p__Inv1)"
  shows "invHoldForRule s f r (invariants N)"
  proof -
  have c1: "(\<exists> i. i\<le>N\<and>r=n_Try  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_Crit  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_Exit  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_Idle  i)"
  apply (cut_tac b1, auto) done
    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_Try  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_TryVsinv__5) done
    }

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

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

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

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

end


theory Simple_Network_Language_Deadlock_Checking
  imports Simple_Network_Language_Model_Checking Deadlock.Deadlock_Checking
begin

context Simple_Network_Impl_nat_ceiling_start_state
begin

context
  fixes \<phi>
  assumes formula_is_false: "formula = formula.EX (not sexp.true)"
begin

lemma F_is_FalseI:
  shows "PR_CONST F = (\<lambda>_. False)"
  by (subst formula_is_false) auto

lemma final_fun_is_False:
  "Fi a = False"
  by (subst formula_is_false) auto

lemmas deadlock_checker_hoare = impl.deadlock_checker_hoare[
    OF final_fun_is_False F_is_FalseI, folded deadlock_start_iff has_deadlock_def]

end

thm impl.is_start_in_states_impl_def
schematic_goal deadlock_checker_alt_def:
  "impl.deadlock_checker \<equiv> ?impl"
  unfolding impl.deadlock_checker_def
  unfolding impl.succs_impl_def
  unfolding impl.check_deadlock_neg_impl_def impl.check_deadlock_impl_def
  apply (abstract_let impl.is_start_in_states_impl is_start)
  unfolding impl.is_start_in_states_impl_def
  apply (abstract_let impl.E_op''_impl E_op''_impl)
  unfolding impl.E_op''_impl_def fw_impl'_int
  apply (abstract_let trans_impl trans_impl)
  unfolding trans_impl_def
  apply (abstract_let int_trans_impl int_trans_impl)
  apply (abstract_let bin_trans_from_impl bin_trans_impl)
  apply (abstract_let broad_trans_from_impl broad_trans_impl)
  unfolding int_trans_impl_def bin_trans_from_impl_def broad_trans_from_impl_def
  apply (abstract_let trans_in_broad_grouped trans_in_broad_grouped)
  apply (abstract_let trans_out_broad_grouped trans_out_broad_grouped)
  apply (abstract_let trans_in_map trans_in_map)
  apply (abstract_let trans_out_map trans_out_map)
  apply (abstract_let int_trans_from_all_impl int_trans_from_all_impl)
  unfolding int_trans_from_all_impl_def
  apply (abstract_let int_trans_from_vec_impl int_trans_from_vec_impl)
  unfolding int_trans_from_vec_impl_def
  apply (abstract_let int_trans_from_loc_impl int_trans_from_loc_impl)
  unfolding int_trans_from_loc_impl_def
  apply (abstract_let trans_i_map trans_i_map)
  unfolding trans_out_broad_grouped_def trans_out_broad_map_def
  unfolding trans_in_broad_grouped_def trans_in_broad_map_def
  unfolding trans_in_map_def trans_out_map_def
  unfolding trans_i_map_def
  apply (abstract_let trans_map trans_map)
  apply (abstract_let "inv_fun :: nat list \<times> int list \<Rightarrow> _" inv_fun)
  unfolding inv_fun_alt_def
  apply (abstract_let invs2 invs)
  unfolding invs2_def
  unfolding k_impl_alt_def
  apply (abstract_let k_i k_i) (* Could be killed *)
  apply (abstract_let n_ps n_ps)
  (* These would need to be moved to a defs locale *)
  unfolding k_i_def impl.state_copy_impl_def impl.a\<^sub>0_impl_def impl.abstr_repair_impl_def
    impl.subsumes_impl_def impl.emptiness_check_impl_def impl.abstra_repair_impl_def
    impl.init_dbm_impl_def
  by (rule Pure.reflexive)

end

concrete_definition deadlock_checker uses
  Simple_Network_Impl_nat_ceiling_start_state.deadlock_checker_alt_def

definition precond_dc where
  "precond_dc
    show_clock show_state broadcast bounds' automata m num_states num_actions k L\<^sub>0 s\<^sub>0 formula \<equiv>
    if Simple_Network_Impl_nat_ceiling_start_state
      broadcast bounds' automata m num_states num_actions k L\<^sub>0 s\<^sub>0 formula
    then
      deadlock_checker
        broadcast bounds' automata m num_states num_actions k L\<^sub>0 s\<^sub>0 show_clock show_state
      \<bind> (\<lambda> x. return (Some x))
    else return None"

theorem deadlock_check:
  "<emp> precond_dc
    show_clock show_state broadcast bounds automata m num_states num_actions k L\<^sub>0 s\<^sub>0
      (formula.EX (not sexp.true))
    <\<lambda> Some r \<Rightarrow> \<up>(
        Simple_Network_Impl_nat_ceiling_start_state
          broadcast bounds automata m num_states num_actions k L\<^sub>0 s\<^sub>0 (formula.EX (not sexp.true)) \<and>
          r = has_deadlock (N broadcast automata bounds) (L\<^sub>0, map_of s\<^sub>0, \<lambda>_ . 0)
        )
     | None \<Rightarrow> \<up>(\<not> Simple_Network_Impl_nat_ceiling_start_state
        broadcast bounds automata m num_states num_actions k L\<^sub>0 s\<^sub>0 (formula.EX (not sexp.true)))
    >\<^sub>t"
proof -
  define A where "A \<equiv> N broadcast automata bounds"
  define check where "check \<equiv> A,(L\<^sub>0, map_of s\<^sub>0, \<lambda>_ . 0) \<Turnstile> (formula.EX (not sexp.true))"
  note [sep_heap_rules] = Simple_Network_Impl_nat_ceiling_start_state.deadlock_checker_hoare[
      OF _ HOL.refl,
      of broadcast bounds automata m num_states num_actions k L\<^sub>0 s\<^sub>0 _,
      unfolded UPPAAL_Reachability_Problem_precompiled_defs.init_def,
      folded A_def
      ]
  show ?thesis
    unfolding A_def[symmetric] precond_dc_def
    by (sep_auto simp: deadlock_checker.refine[symmetric] pure_def has_deadlock_def)
qed

end


theory ProcSendCase
  imports ResMapValid ReduceWTS ProcDef ProcCVars
begin

lemma cancel_strong_leq_use_env: "\<lbrakk> strong_use_env r_x \<rbrakk> \<Longrightarrow> leq_use_env (diff_use_env r_x r_x) r_s"
  apply (simp add: leq_use_env_def)
  apply (simp add: diff_use_env_def)
  apply (simp add: strong_use_env_def)
  apply (auto)
  apply (erule_tac x="x" in allE)
  apply (case_tac "r_x x")
    apply (auto)
  done

lemma sfl_diff_use_env: "\<lbrakk> strong_use_env r_ex; leq_use_env r_ex r_s; is_own r \<rbrakk> \<Longrightarrow> diff_use_env r_s (diff_use_env (lift_use_env r_s r) r_ex) = r_ex"
  apply (case_tac "\<forall> x. diff_use_env r_s (diff_use_env (lift_use_env r_s r) r_ex) x = r_ex x")
   apply (auto)
  apply (simp add: strong_use_env_def)
  apply (simp add: leq_use_env_def)
  apply (simp add: diff_use_env_def)
  apply (simp add: is_own_def)
  apply (erule_tac x="x" in allE)
  apply (erule_tac x="x" in allE)
  apply (case_tac "r_ex x")
    apply (auto)
   apply (case_tac "r_s x")
    apply (auto)
  apply (case_tac "r_s x")
    apply (auto)
  done

    (* the question right now is, how do we make these types line up? *)

lemma safe_val_exp: "\<lbrakk> well_typed env r_s1 (app_hole h (AppExp (AppExp (ConstExp SendConst) (VarExp (LocType a b))) v)) tau r_s2 rx;
  env (Loc a) = Some (ChanTy t SEnd); is_value c; is_value v \<rbrakk> \<Longrightarrow>
  well_typed env (np_dom_use_env env v) v t (np_dom_use_env env v) (np_dom_use_env env v)"
  apply (induct h arbitrary: env r_s1 tau r_s2 rx)
       apply (auto)
    (* base case *)
  apply (case_tac "t \<noteq> t1")
   apply (simp add: pure_fun_def)
  apply (cut_tac env="env" and ?r_s1.0="r_s2a" and e="v" and tau="t" and ?r_s2.0="r_s3" and rx="rx2" in infl_sexp_wp)
    apply (simp)
   apply (rule_tac value_is_sexp)
   apply (auto)
    (* r = rb *)
  apply (case_tac "rb \<noteq> r")
   apply (simp add: pure_fun_def)
    (* the idea is that the infl_sexp_wp requirements are strictly greater than np_dom. since np_dom is strong, there is an exact way of
        subtracting to get to np_dom. (we do cheat a little by lifting rx2). *)
  apply (rule_tac t="np_dom_use_env env v" and s="diff_use_env (comp_use_env (lift_use_env rx2 r) (infl_use_env r_s2a r_s3))
    (diff_use_env (lift_use_env (comp_use_env (lift_use_env rx2 r) (infl_use_env r_s2a r_s3)) rb) (np_dom_use_env env v))" in subst)
   apply (rule_tac sfl_diff_use_env)
     apply (simp add: np_dom_use_env_def)
     apply (rule_tac strong_dom_use_env)
    (* to prove that the infl_sexp_wp reqs are greater than np_dom, we use the fact that any npv must have a permission *)
    apply (simp add: np_dom_use_env_def)
    apply (simp add: dom_use_env_def)
    apply (auto)
   apply (simp add: leq_use_env_def)
   apply (auto)
   apply (case_tac "comp_use_env (lift_use_env rx2 r) (infl_use_env r_s2a r_s3) x \<noteq> OwnPerm")
    apply (case_tac "comp_use_env rx2 (infl_use_env r_s2a r_s3) x = NoPerm")
     apply (cut_tac x="x" and env="env" and e="v" and ?r_s1.0="comp_use_env rx2 (infl_use_env r_s2a r_s3)" in well_typed_no_npv_use)
       apply (auto)
   apply (cut_tac r_sa="lift_use_env rx2 r" and r_sb="infl_use_env r_s2a r_s3" and x="x" in comp_use_no_own_both)
    apply (auto)
   apply (case_tac "rx2 x \<noteq> NoPerm")
    apply (simp add: is_own_def)
   apply (auto)
   apply (case_tac "infl_use_env r_s2a r_s3 x \<noteq> NoPerm")
    apply (simp add: infl_use_env_def)
    apply (case_tac "r_s2a x = OwnPerm \<and> r_s3 x = NoPerm")
     apply (auto)
   apply (cut_tac r_sa="rx2" and r_sb="infl_use_env r_s2a r_s3" and x="x" in comp_use_none)
     apply (auto)
    (* with that in mind, we manipulate until we match the infl sexp lemma *)
  apply (rule_tac well_typed_diff_perms)
   apply (rule_tac rx="comp_use_env rx2 (infl_use_env r_s2a r_s3)" in well_typed_incr_req)
     apply (rule_tac r_s="comp_use_env rx2 (infl_use_env r_s2a r_s3)" in well_typed_incr_simul_perm)
      apply (rule_tac dist_comp_leq_use_env)
       apply (rule_tac comp_leq_use_env1)
       apply (rule_tac self_lift_leq_use_env)
      apply (rule_tac self_comp_leq_use_env2)
     apply (simp)
    apply (rule_tac dist_comp_leq_use_env)
     apply (rule_tac comp_leq_use_env1)
     apply (rule_tac self_lift_leq_use_env)
    apply (rule_tac self_comp_leq_use_env2)
   apply (rule_tac id_leq_use_env)
    (* next, we must show that the differential is actually subtractible, which is true since it removes all non-prim vars *)
  apply (auto)
  apply (case_tac "np_dom_use_env env v x \<noteq> OwnPerm")
   apply (simp add: np_dom_use_env_def)
   apply (simp add: dom_use_env_def)
   apply (cut_tac r_s="lift_use_env (comp_use_env (lift_use_env rx2 r) (infl_use_env r_s2a r_s3)) r" and
       r_ex="np_dom_use_env env v" and x="x" in diff_use_none_ex)
    apply (simp)
  apply (simp add: own_env_vars_def)
  done

lemma safe_recv_exp: "\<lbrakk> well_typed env r_s1 (app_hole h (AppExp (ConstExp RecvConst) (VarExp (LocType a b)))) tau r_s2 rx;
  env (Loc a) = Some (ChanTy t REnd); well_typed env r_x v t r_x r_x; disj_use_env r_s1 r_x;
  strong_use_env r_x; is_value c; is_value v; is_own r \<rbrakk> \<Longrightarrow>
  well_typed env (comp_use_env r_s1 r_x) (app_hole h v) tau r_s2 rx"
  apply (induct h arbitrary: env r_s1 tau r_s2 rx)
       apply (auto)
    (* base case *)
       apply (cut_tac r_sc="r_s2" and r_sb="diff_use_env r_s3 (comp_use_env (comp_use_env rx1 (lift_use_env rx2 ra)) r_exa)" and
          r_sa="r_s1" in trans_leq_use_env)
         apply (rule_tac diff_leq_use_env)
         apply (rule_tac r_sb="diff_use_env r_s2a (comp_use_env (ereq_use_env (Loc b) tau_x) r_ex)" in trans_leq_use_env)
          apply (rule_tac diff_leq_use_env)
          apply (auto)
       apply (rule_tac ?r_s2.0="diff_use_env (comp_use_env r_s1 r_x) r_x"
        and rx="diff_use_env r_x r_x" in well_typed_simul_end_perm)
          apply (rule_tac well_typed_diff_end_perm)
           apply (rule_tac well_typed_comp_perms2)
            apply (simp add: pure_fun_def)
           apply (auto)
          apply (rule_tac comm_disj_use_env)
          apply (simp)
         apply (rule_tac self_comp_leq_use_env2)
        apply (rule_tac disj_diff_leq_use_env)
         apply (rule_tac r_s="r_s1" in disj_leq_use_env2)
          apply (rule_tac comm_disj_use_env)
          apply (simp_all)
        apply (rule_tac comp_leq_use_env1)
        apply (simp)
       apply (rule_tac cancel_strong_leq_use_env)
       apply (simp)
    (* lhs pair case. *)
      apply (rule_tac x="t1" in exI)
      apply (rule_tac x="ra" in exI)
      apply (rule_tac x="aa" in exI)
      apply (rule_tac x="r_s2a" in exI)
      apply (rule_tac x="rx1" in exI)
      apply (auto)
      apply (rule_tac x="rx2" in exI)
      apply (rule_tac x="r_s3" in exI)
      apply (auto)
      apply (rule_tac x="r_ex" in exI)
      apply (auto)
      apply (rule_tac comp_leq_use_env1)
      apply (simp)
    (* rhs pair case. *)
     apply (rule_tac x="t1" in exI)
     apply (rule_tac x="ra" in exI)
     apply (rule_tac x="aa" in exI)
     apply (rule_tac x="comp_use_env r_s2a r_x" in exI)
     apply (rule_tac x="rx1" in exI)
     apply (auto)
      apply (rule_tac well_typed_comp_perms)
       apply (simp_all)
     apply (rule_tac x="rx2" in exI)
     apply (rule_tac x="r_s3" in exI)
     apply (auto)
      apply (cut_tac r_x="r_s2a" and r_s="r_s1" and r_ex="r_x" in disj_leq_use_env1)
        apply (simp)
       apply (rule_tac well_typed_perm_leq)
       apply (auto)
     apply (rule_tac x="r_ex" in exI)
     apply (auto)
     apply (rule_tac comp_leq_use_env1)
     apply (simp)
    (* if case. *)
    apply (rule_tac x="rx'" in exI)
    apply (rule_tac x="r_s2a" in exI)
    apply (auto)
    (* lhs pair case. *)
   apply (rule_tac x="r_s2a" in exI)
   apply (rule_tac x="r_s3" in exI)
   apply (rule_tac x="rx1" in exI)
   apply (auto)
   apply (rule_tac x="rx2" in exI)
   apply (auto)
   apply (rule_tac x="r_ex" in exI)
   apply (auto)
   apply (rule_tac comp_leq_use_env1)
   apply (simp)
    (* rhs pair case. *)
  apply (rule_tac x="comp_use_env r_s2a r_x" in exI)
  apply (rule_tac x="r_s3" in exI)
  apply (rule_tac x="rx1" in exI)
   apply (auto)
   apply (rule_tac well_typed_comp_perms)
    apply (simp_all)
  apply (rule_tac x="rx2" in exI)
   apply (auto)
   apply (cut_tac r_x="r_s2a" and r_s="r_s1" and r_ex="r_x" in disj_leq_use_env1)
     apply (simp)
    apply (rule_tac well_typed_perm_leq)
    apply (auto)
  apply (rule_tac x="r_ex" in exI)
  apply (auto)
  apply (rule_tac comp_leq_use_env1)
  apply (simp)
  done

lemma safe_own_npv_use: "\<lbrakk> well_typed env r_s1 (app_hole h (AppExp f v)) tau r_s2 rx; is_value f; strong_fun f;
  a \<noteq> NoRef; is_value v; x \<in> non_prim_vars env v \<rbrakk> \<Longrightarrow> r_s1 x = OwnPerm"
  apply (induct h arbitrary: env r_s1 r_s2 tau rx)
       apply (auto)
    (* base case *)
    apply (cut_tac f="f" and r="r" in strong_fun_own)
      apply (auto)
    apply (cut_tac env="env" and ?r_s1.0="r_s2a" and e="v" and ?r_s2.0="r_s3" and rx="rx2" in infl_sexp_wp)
      apply (auto)
     apply (rule_tac value_is_sexp)
     apply (simp)
    apply (case_tac "comp_use_env rx2 (infl_use_env r_s2a r_s3) x = NoPerm")
     apply (cut_tac env="env" and x="x" and e="v" and ?r_s1.0="comp_use_env rx2 (infl_use_env r_s2a r_s3)" in well_typed_no_npv_use)
       apply (auto)
    apply (case_tac "rx2 x \<noteq> NoPerm")
     apply (cut_tac r_x="lift_use_env rx2 r" and r_s="r_s1" and x="x" in leq_use_own)
      apply (simp add: is_own_def)
     apply (rule_tac r_sb="comp_use_env rx1 (lift_use_env rx2 r)" in trans_leq_use_env)
      apply (rule_tac r_sb="r_s3" in trans_leq_use_env)
       apply (rule_tac r_sb="r_s2a" in trans_leq_use_env)
        apply (auto)
       apply (rule_tac well_typed_perm_leq)
       apply (auto)
      apply (rule_tac well_typed_perm_leq)
      apply (auto)
     apply (rule_tac self_comp_leq_use_env2)
    apply (case_tac "infl_use_env r_s2a r_s3 x \<noteq> NoPerm")
     apply (simp add: infl_use_env_def)
     apply (case_tac "r_s2a x = OwnPerm \<and> r_s3 x = NoPerm")
      apply (auto)
     apply (rule_tac r_x="r_s2a" in leq_use_own)
      apply (auto)
     apply (rule_tac well_typed_perm_leq)
     apply (auto)
    apply (cut_tac r_sa="rx2" and r_sb="infl_use_env r_s2a r_s3" and x="x" in comp_use_none)
      apply (auto)
    (* rhs induct *)
   apply (rule_tac r_x="r_s2a" in leq_use_own)
    apply (simp)
   apply (rule_tac well_typed_perm_leq)
   apply (auto)
    (* rhs pair *)
  apply (rule_tac r_x="r_s2a" in leq_use_own)
   apply (simp)
  apply (rule_tac well_typed_perm_leq)
  apply (auto)
  done

lemma safe_send_exp_ih: "\<lbrakk> well_typed env r_s1 (app_hole h (AppExp (AppExp (ConstExp SendConst) c) v)) tau r_s2 rx; is_value c; is_value v \<rbrakk> \<Longrightarrow>
  well_typed env r_s1 (app_hole h (ConstExp UnitConst)) tau r_s2 rx"
  apply (induct h arbitrary: env r_s1 tau r_s2 rx)
       apply (auto)
    (* base case *)
        apply (simp add: pure_fun_def)
       apply (rule_tac r_sb="diff_use_env r_s3 (comp_use_env (comp_use_env rx1 (lift_use_env rx2 r)) r_ex)" in trans_leq_use_env)
        apply (rule_tac diff_leq_use_env)
        apply (rule_tac r_sb="r_s2a" in trans_leq_use_env)
         apply (rule_tac r_sb="diff_use_env r_s3a (comp_use_env (comp_use_env rx1a (lift_use_env rx2a ra)) r_exa)" in trans_leq_use_env)
          apply (rule_tac diff_leq_use_env)
          apply (rule_tac r_sb="r_s2b" in trans_leq_use_env)
           apply (simp_all)
        apply (rule_tac well_typed_perm_leq)
        apply (auto)
       apply (rule_tac well_typed_perm_leq)
       apply (auto)
    (* lhs app case *)
      apply (rule_tac x="t1" in exI)
      apply (rule_tac x="r" in exI)
      apply (rule_tac x="a" in exI)
      apply (rule_tac x="r_s2a" in exI)
      apply (rule_tac x="rx1" in exI)
      apply (auto)
    (* rhs app case *)
     apply (rule_tac x="t1" in exI)
     apply (rule_tac x="r" in exI)
     apply (rule_tac x="a" in exI)
     apply (rule_tac x="r_s2a" in exI)
     apply (rule_tac x="rx1" in exI)
     apply (auto)
     apply (rule_tac x="rx2" in exI)
     apply (rule_tac x="r_s3" in exI)
     apply (auto)
    (* if case *)
    apply (rule_tac x="rx'" in exI)
    apply (rule_tac x="r_s2a" in exI)
    apply (auto)
    (* lhs pair case *)
   apply (rule_tac x="r_s2a" in exI)
   apply (rule_tac x="r_s3" in exI)
   apply (rule_tac x="rx1" in exI)
   apply (auto)
    (* rhs pair case *)
  apply (rule_tac x="r_s2a" in exI)
  apply (rule_tac x="r_s3" in exI)
  apply (rule_tac x="rx1" in exI)
  apply (auto)
  apply (rule_tac x="rx2" in exI)
  apply (auto)
  done

lemma safe_send_exp: "\<lbrakk> well_typed env r_s1 (app_hole h (AppExp (AppExp (ConstExp SendConst) (VarExp (LocType a b))) v)) tau r_s2 rx;
  valid_nres_map s rs_map; valid_exp_use_env s rs_map r_s1; wf_hole h; is_value v \<rbrakk> \<Longrightarrow>
  well_typed env (diff_use_env r_s1 (full_dom_use_env env rs_map v)) (app_hole h (ConstExp UnitConst)) tau
    (diff_use_env r_s2 (full_dom_use_env env rs_map v)) (diff_use_env rx (full_dom_use_env env rs_map v))"
  apply (rule_tac well_typed_diff_perms)
   apply (rule_tac c="VarExp (LocType a b)" in safe_send_exp_ih)
     apply (auto)
    (* we want to show that if xa is in the dominator, it is not an np-var in h.
        > if xa is an np-var itself, it cannot be in e by lemma *)
  apply (case_tac "x \<in> non_prim_vars env v")
   apply (cut_tac h="h" and x="x" and e="ConstExp UnitConst" in app_hole_res_vars_rev)
    apply (auto)
    apply (simp add: non_prim_vars_def)
   apply (cut_tac h="h" and x="x" and env="env" and ?r_s1.0="r_s1" and v="VarExp (LocType a b)" and e="v" in safe_send_hole_npv_use)
        apply (auto)
    (* otherwise, xa is in the completion. we identify its ancestor z. *)
  apply (simp add: own_env_vars_def)
  apply (simp add: full_dom_use_env_def)
  apply (simp add: dom_use_env_def)
  apply (case_tac "\<exists>xa. x = Loc xa \<and> (\<exists>l z. Loc z \<in> non_prim_vars env v \<and> path_lookup rs_map z l xa)")
   apply (auto)
    (* we note that z is a np-var of e therefore r_s1 z = Own *)
  apply (cut_tac x="Loc z" and env="env" and f="AppExp (ConstExp SendConst) (VarExp (LocType a b))" in safe_own_npv_use)
        apply (auto)
   apply (simp add: pure_fun_def)
   apply (simp add: is_own_def)
    (* xa then is in the lookup map of some parent y. *)
  apply (cut_tac rs_map="rs_map" and z="z" and x="xa" in path_lookup_parent)
     apply (auto)
    (* with that in mind, by separation, x is disjoint from r_s1. *)
  apply (case_tac "r_s1 (Loc xa) \<noteq> NoPerm")
   apply (simp add: valid_exp_use_env_def)
   apply (simp add: sep_nres_map_def)
   apply (auto)
   apply (erule_tac x="y" in allE)
   apply (simp add: nres_lookup_def)
   apply (simp add: strong_disj_use_env_def)
   apply (erule_tac x="Loc xa" in allE)
   apply (auto)
    (* by extension, x is not in 'h (send c v)' *)
  apply (cut_tac env="env" and ?r_s1.0="r_s1" and x="Loc xa" in well_typed_no_npv_use)
    apply (auto)
  apply (simp add: non_prim_vars_def)
    (* the very last part is showing that x not in 'h (send c v)' implies x not in 'h ()'. *)
  apply (cut_tac x="Loc xa" and h="h" and e="ConstExp UnitConst" in app_hole_res_vars_rev)
   apply (auto)
  apply (cut_tac x="Loc xa" and h="h" and e="AppExp (AppExp (ConstExp SendConst) (VarExp (LocType a b))) v" in app_hole_res_vars2)
   apply (auto)
  done

lemma disj_lift_use_envr_rev: "\<lbrakk> strong_disj_use_env r_s r_x \<rbrakk> \<Longrightarrow> disj_use_env r_s (lift_use_env r_x r)"
  apply (simp add: strong_disj_use_env_def)
  apply (simp add: disj_use_env_def)
  apply (simp add: mini_disj_use_env_def)
  apply (auto)
   apply (erule_tac x="x" in allE)
   apply (auto)
   apply (case_tac r)
     apply (auto)
  apply (erule_tac x="x" in allE)
  apply (auto)
  apply (case_tac r)
    apply (auto)
  done

lemma lift_strong_disj_use_env1: "\<lbrakk> strong_disj_use_env r_x r_s \<rbrakk> \<Longrightarrow> strong_disj_use_env (lift_use_env r_x r) r_s"
  apply (simp add: strong_disj_use_env_def)
  apply (auto)
  apply (erule_tac x="x" in allE)
  apply (auto)
  apply (case_tac r)
    apply (auto)
  done

lemma send_disj_nres_map: "\<lbrakk> disj_nres_map p_map; p_map u1 = Some r_sa; p_map u2 = Some r_sb; is_own r;
  leq_use_env r_xa (lift_use_env r_sa r); leq_use_env r_xb (comp_use_env (lift_use_env r_sa r) (lift_use_env r_sb r));
  strong_disj_use_env r_xa r_xb \<rbrakk> \<Longrightarrow> disj_nres_map (add_env (add_env p_map u1 r_xa) u2 r_xb)"
  apply (rule_tac disj_add_nres_map)
   apply (rule_tac disj_add_nres_map)
    apply (simp)
    (* proving disjointness for the send thread's material *)
   apply (rule_tac r_s="lift_use_env r_sa r" in leq_sep_nres_map)
    apply (simp)
   apply (simp add: disj_nres_map_def)
   apply (simp add: sep_nres_map_def)
   apply (auto)
   apply (case_tac "x = u1")
    apply (simp add: nres_lookup_def)
    apply (simp add: rem_env_def)
    apply (rule_tac empty_strong_disj_use_env2)
   apply (rule_tac lift_strong_disj_use_env1)
   apply (erule_tac x="u1" in allE)
   apply (erule_tac x="x" in allE)
   apply (simp add: nres_lookup_def)
   apply (simp add: rem_env_def)
    (* proving disjointness for the recv thread *)
  apply (simp add: sep_nres_map_def)
  apply (auto)
  apply (case_tac "u2 = x")
   apply (simp add: nres_lookup_def)
   apply (simp add: rem_env_def)
   apply (rule_tac empty_strong_disj_use_env2)
  apply (case_tac "u1 = x")
   apply (simp add: nres_lookup_def)
   apply (simp add: rem_env_def)
   apply (simp add: add_env_def)
   apply (rule_tac comm_strong_disj_use_env)
   apply (simp)
  apply (simp add: nres_lookup_def)
  apply (simp add: rem_env_def)
  apply (simp add: add_env_def)
  apply (simp add: disj_nres_map_def)
  apply (rule_tac r_s="comp_use_env (lift_use_env r_sa r) (lift_use_env r_sb r)" in strong_disj_leq_use_env1)
   apply (rule_tac strong_disj_comp_use_env2)
    apply (rule_tac lift_strong_disj_use_env1)
    apply (erule_tac x="u1" in allE)
    apply (erule_tac x="x" in allE)
    apply (simp add: nres_lookup_def)
   apply (rule_tac lift_strong_disj_use_env1)
   apply (erule_tac x="u2" in allE)
   apply (erule_tac x="x" in allE)
   apply (simp add: nres_lookup_def)
  apply (simp)
  done

fun proper_hole where
  "proper_hole rs_map ExpHole = True"
| "proper_hole rs_map (AppHole1 h e) = (proper_hole rs_map h \<and> proper_exp rs_map e)"
| "proper_hole rs_map (AppHole2 v h) = (proper_exp rs_map v \<and> proper_hole rs_map h)"
| "proper_hole rs_map (IfHole h e1 e2) = (proper_hole rs_map h \<and> proper_exp rs_map e1 \<and> proper_exp rs_map e2)"
| "proper_hole rs_map (PairHole1 h e) = (proper_hole rs_map h \<and> proper_exp rs_map e)"
| "proper_hole rs_map (PairHole2 v h) = (proper_exp rs_map v \<and> proper_hole rs_map h)"

lemma proper_app_hole_split1: "\<lbrakk> proper_exp rs_map (app_hole h e) \<rbrakk> \<Longrightarrow> proper_hole rs_map h"
  apply (induct h)
       apply (auto)
            apply (simp_all add: proper_exp_def)
  done

lemma proper_app_hole_split2: "\<lbrakk> proper_exp rs_map (app_hole h e) \<rbrakk> \<Longrightarrow> proper_exp rs_map e"
  apply (induct h)
       apply (auto)
      apply (simp_all add: proper_exp_def)
  done

lemma proper_app_hole_recon: "\<lbrakk> proper_hole rs_map h; proper_exp rs_map e \<rbrakk> \<Longrightarrow> proper_exp rs_map (app_hole h e)"
  apply (induct h)
       apply (auto)
      apply (simp_all add: proper_exp_def)
  done

lemma proper_app_hole: "\<lbrakk> proper_exp rs_map (app_hole h e1); proper_exp rs_map e2 \<rbrakk> \<Longrightarrow> proper_exp rs_map (app_hole h e2)"
  apply (cut_tac rs_map="rs_map" and h="h" and e="e1" in proper_app_hole_split1)
   apply (auto)
  apply (rule_tac proper_app_hole_recon)
   apply (auto)
  done

lemma srps_send_case: "\<lbrakk>well_typed_system env rs_map p_map s2 ps1; valid_reduct app_red_exp; r_ax = SendAct;
        ps1 u1 = Some (app_hole h1 (AppExp (AppExp (ConstExp SendConst) (VarExp (LocType x_s a_s))) v));
        ps1 u2 = Some (app_hole h2 (AppExp (ConstExp RecvConst) (VarExp (LocType x_r a_r)))); u1 \<noteq> u2; wf_hole h1;
        wf_hole h2; is_value v; s2 x_s = Some ChanSValue;
        s2 x_r = Some (ChanRValue x_s); s1 = s2;
        ps2 = add_env (add_env ps1 u1 (app_hole h1 (ConstExp UnitConst))) u2 (app_hole h2 v)\<rbrakk>
       \<Longrightarrow> \<exists>r_s g_ax.
              (\<exists>p_map'. well_typed_system (red_env env g_ax) (red_nres_map rs_map g_ax) p_map' s2
                         (add_env (add_env ps1 u1 (app_hole h1 (ConstExp UnitConst))) u2 (app_hole h2 v))) \<and>
              safe_act s2 r_s g_ax"
      (* send case. no resources are generated in this step *)
  apply (rule_tac x="empty_use_env" in exI)
  apply (rule_tac x="NoResAct" in exI)
  apply (auto)
  apply (simp add: well_typed_system_def)
  apply (auto)
    (* we have to get the well-typedness statement for h1 [send c v] *)
  apply (case_tac "\<not> (case ps1 u1 of None \<Rightarrow> True | Some e \<Rightarrow> (case p_map u1 of None \<Rightarrow> False | Some r_s \<Rightarrow> \<exists>rx r_s2. well_typed env r_s e UnitTy r_s2 rx \<and> proper_exp rs_map e))")
   apply (simp add: well_typed_proc_set_def)
   apply (auto)
   apply (erule_tac x="u1" in allE)
   apply (erule_tac x="u1" in allE)
   apply (auto)
  apply (case_tac "p_map u1")
   apply (auto)
    (* we also get the well-typedness statement for h2 [recv c v] *)
  apply (case_tac "\<not> (case ps1 u2 of None \<Rightarrow> True | Some e \<Rightarrow> (case p_map u2 of None \<Rightarrow> False | Some r_s \<Rightarrow> \<exists>rx r_s2. well_typed env r_s e UnitTy r_s2 rx \<and> proper_exp rs_map e))")
   apply (simp add: well_typed_proc_set_def)
   apply (auto)
   apply (erule_tac x="u2" in allE)
   apply (erule_tac x="u2" in allE)
   apply (auto)
  apply (case_tac "p_map u2")
   apply (auto)
    (* next we get the send channel's type *)
  apply (case_tac "\<not> (\<exists> t. env (Loc x_s) = Some (ChanTy t SEnd))")
   apply (simp add: well_typed_state_def)
   apply (auto)
   apply (erule_tac x="x_s" in allE)
   apply (erule_tac x="x_s" in allE)
   apply (auto)
   apply (case_tac "env (Loc x_s)")
    apply (auto)
    (* and the recv channel's type *)
  apply (case_tac "\<not> env (Loc x_r) = Some (ChanTy t REnd)")
   apply (simp add: well_typed_state_def)
   apply (auto)
   apply (erule_tac x="x_r" in allE)
   apply (erule_tac x="x_r" in allE)
   apply (auto)
   apply (case_tac "env (Loc x_r)")
    apply (auto)
    (* prelim: we prove the dominator of v \<le> lift a r (the permission map of u1) *)
  apply (cut_tac eq_own)
  apply (auto)
  apply (cut_tac r_sc="np_dom_use_env env v" and r_sb="np_dom_use_env env (app_hole h1 (AppExp (AppExp (ConstExp SendConst) (VarExp (LocType x_s a_s))) v))"
      and r_sa="lift_use_env a r" in trans_leq_use_env)
    apply (rule_tac wt_np_leq_use_env)
     apply (auto)
   apply (simp add: np_dom_use_env_def)
   apply (rule_tac dist_dom_leq_use_env)
   apply (auto)
   apply (simp add: non_prim_vars_def)
   apply (rule_tac app_hole_res_vars)
   apply (auto)
    (* we can generate a type for h1 () *)
  apply (cut_tac env="env" and v="v" and ?r_s1.0="a" and tau="UnitTy" and h="h1" and ?r_s2.0="r_s2" and rx="rx" and s="s2" and rs_map="rs_map" in safe_send_exp)
        apply (auto)
    apply (simp add: well_typed_state_def)
    (* - complete proof that a is still valid *)
   apply (simp add: valid_exp_use_env_def)
   apply (simp add: well_typed_proc_set_def)
   apply (simp add: sub_nres_map_def)
   apply (erule_tac x="u1" in allE)
   apply (erule_tac x="u1" in allE)
   apply (simp add: nres_lookup_def)
    (* we can also generate a type for h2 v, first by getting a type for v, and then by putting it in the hole *)
  apply (cut_tac env="env" and v="v" and h="h1" and a="x_s" and a="a_s" and t="t" in safe_val_exp)
      apply (auto)
  apply (cut_tac env="env" and ?r_s1.0="aa" and h="h2" and r_x="np_dom_use_env env v" in safe_recv_exp)
          apply (auto)
    (* - p_map disjointness proves that the permissions being added are disjoint *)
    apply (rule_tac r_s="lift_use_env a r" in disj_leq_use_env2)
     apply (case_tac "\<forall>x y. x \<noteq> y \<longrightarrow> strong_disj_use_env (nres_lookup p_map x) (nres_lookup p_map y)")
      apply (erule_tac x="u1" in allE)
      apply (erule_tac x="u2" in allE)
      apply (erule_tac x="u1" in allE)
      apply (auto)
     apply (simp add: nres_lookup_def)
     apply (rule_tac disj_lift_use_envr_rev)
     apply (simp)
    apply (simp add: well_typed_proc_set_def)
    apply (simp add: disj_nres_map_def)
    (* - proving the dominator is strong *)
   apply (simp add: np_dom_use_env_def)
   apply (rule_tac strong_dom_use_env)
    (* lastly it remains to prove the new process map is well-formed *)
  apply (rule_tac x="add_env (add_env p_map u1 (diff_use_env a (full_dom_use_env env rs_map v)))
    u2 (comp_use_env aa (np_dom_use_env env v))" in exI)
  apply (simp add: well_typed_proc_set_def)
  apply (auto)
    (* completeness *)
      apply (rule_tac add_full_nres_map)
      apply (rule_tac add_full_nres_map)
      apply (simp)
    (* disjointness, assisted by lemma *)
     apply (rule_tac r_sa="a" and r_sb="aa" in send_disj_nres_map)
           apply (simp_all)
       apply (rule_tac diff_leq_use_env)
       apply (rule_tac self_lift_leq_use_env)
      apply (rule_tac dist_comp_leq_use_env)
       apply (rule_tac comp_leq_use_env2)
       apply (rule_tac self_lift_leq_use_env)
      apply (rule_tac comp_leq_use_env1)
      apply (simp)
     apply (rule_tac strong_disj_comp_use_env1)
      apply (rule_tac r_s="a" in strong_disj_leq_use_env1)
       apply (simp add: disj_nres_map_def)
       apply (erule_tac x="u1" in allE)
       apply (erule_tac x="u1" in allE)
       apply (erule_tac x="u1" in allE)
       apply (erule_tac x="u2" in allE)
       apply (simp add: nres_lookup_def)
      apply (rule_tac self_diff_leq_use_env)
     apply (rule_tac r_s="full_dom_use_env env rs_map v" in strong_disj_leq_use_env2)
      apply (rule_tac diff_strong_disj_use_env)
      apply (simp add: full_dom_use_env_def)
      apply (rule_tac strong_dom_use_env)
     apply (rule_tac full_dom_leq_use_env)
    (* proving that the processes are well-typed *)
    apply (case_tac "u = u1")
     apply (simp add: add_env_def)
     apply (auto)
     apply (rule_tac proper_app_hole)
      apply (simp)
     apply (simp add: proper_exp_def)
    apply (case_tac "u = u2")
     apply (simp add: add_env_def)
     apply (auto)
     apply (rule_tac proper_app_hole)
      apply (simp)
     apply (cut_tac rs_map="rs_map" and h="h1" and e="AppExp (AppExp (ConstExp SendConst) (VarExp (LocType x_s a_s))) v" in proper_app_hole_split2)
      apply (simp)
     apply (simp add: proper_exp_def)
    apply (simp add: add_env_def)
    apply (erule_tac x="u" in allE)
    apply (erule_tac x="u" in allE)
    apply (case_tac "ps1 u")
     apply (auto)
    apply (simp add: add_env_def)
    (* proving res_map element containment *)
   apply (rule_tac add_sub_nres_map1)
    apply (rule_tac add_sub_nres_map1)
     apply (simp)
    apply (rule_tac r_s="a" in trans_sub_use_env)
     apply (simp add: sub_nres_map_def)
     apply (erule_tac x="u1" in allE)
     apply (simp add: nres_lookup_def)
    apply (rule_tac self_diff_leq_use_env)
   apply (rule_tac comp_sub_use_env)
    apply (simp add: sub_nres_map_def)
    apply (erule_tac x="u2" in allE)
    apply (simp add: nres_lookup_def)
   apply (rule_tac r_s="lift_use_env a r" in trans_sub_use_env)
    apply (rule_tac lift_sub_use_env)
    apply (simp add: sub_nres_map_def)
    apply (erule_tac x="u1" in allE)
    apply (simp add: nres_lookup_def)
   apply (simp)
    (* poriving the separation of the new maps *)
  apply (case_tac "u = u1")
   apply (simp add: add_env_def)
   apply (rule_tac r_s="a" in leq_sep_nres_map)
    apply (rule_tac self_diff_leq_use_env)
   apply (erule_tac x="u1" in allE)
   apply (auto)
  apply (case_tac "u = u2")
   apply (simp add: add_env_def)
   apply (rule_tac comp_sep_nres_map)
    apply (erule_tac x="u2" in allE)
    apply (auto)
   apply (erule_tac x="u1" in allE)
   apply (auto)
   apply (rule_tac r_s="lift_use_env a r" in leq_sep_nres_map)
    apply (simp)
   apply (simp add: sep_nres_map_def)
    apply (auto)
   apply (rule_tac lift_strong_disj_use_env1)
   apply (simp)
  apply (simp add: add_env_def)
  done

end