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

theory IndirectCalls

imports
  "PrettyProgs"

begin

definition
  lookup_proc :: "(string \<Rightarrow> 'proc_addr) \<Rightarrow> ('proc_id \<rightharpoonup> string)
    \<Rightarrow> 'proc_addr \<Rightarrow> 'proc_id"
where
  "lookup_proc symtab naming x
    = (THE pid. naming pid \<noteq> None \<and> symtab (the (naming pid)) = x)"

definition
  lookup_proc_safe :: "(string \<Rightarrow> 'proc_addr) \<Rightarrow> ('proc_id \<rightharpoonup> string)
    \<Rightarrow> 'proc_addr \<Rightarrow> bool"
where
  "lookup_proc_safe symtab naming x
    = (card {pid. naming pid \<noteq> None \<and> symtab (the (naming pid)) = x} = 1)"

definition
  procs_consistent :: "(string \<Rightarrow> 'proc_addr) \<Rightarrow> ('proc_nm \<rightharpoonup> string)
    \<Rightarrow> bool"
where
  "procs_consistent symtab naming
    = (finite (dom naming)
        \<and> (\<forall>x y nm nm'. naming x = Some nm \<and> naming y = Some nm'
            \<and> symtab nm = symtab nm'
                \<longrightarrow> x = y))"

lemma procs_consistent_eq:
  "\<lbrakk> naming proc = Some nm; procs_consistent symtab naming; addr = symtab nm \<rbrakk>
    \<Longrightarrow> lookup_proc symtab naming addr = proc"
  apply (clarsimp simp: procs_consistent_def lookup_proc_def)
  apply (rule the_equality)
   apply clarsimp
  apply clarsimp
  done

lemma procs_consistent_safe:
  "\<lbrakk> naming proc = Some nm; procs_consistent symtab naming; addr = symtab nm \<rbrakk>
    \<Longrightarrow> lookup_proc_safe symtab naming addr"
  apply (clarsimp simp: procs_consistent_def lookup_proc_safe_def)
  apply (rule trans, rule arg_cong[where f=card and y="{proc}"])
   apply auto
  done

lemma hoare_indirect_call_procs_consistent:
  "\<lbrakk> naming proc = Some nm;
        \<Gamma> \<turnstile> P (call initf proc ret c) Q, A \<rbrakk>
    \<Longrightarrow> \<Gamma> \<turnstile> ({s. procs_consistent symtab naming \<and> x_fn s = symtab nm} \<inter> P)
            (dynCall initf (\<lambda>s. lookup_proc symtab naming (x_fn s))
                    ret c) Q, A"
  apply (rule hoare_complete, drule hoare_sound)
  apply (clarsimp simp: cvalid_def HoarePartialDef.valid_def)
  apply (erule exec_dynCall_Normal_elim)
  apply (simp add: procs_consistent_eq)
  apply blast
  done

end


           (*-------------------------------------------*
            |                DFP package                |
            |                   June 2005               |
            |               December 2005  (modified)   |
            |                                           |
            |   DFP on CSP-Prover ver.3.0               |
            |              September 2006  (modified)   |
            |                  April 2007  (modified)   |
            |                                           |
            |        CSP-Prover on Isabelle2017         |
            |                  April 2018  (modified)   |
            |                                           |
            |        Yoshinao Isobe (AIST JAPAN)        |
            *-------------------------------------------*)

theory DFP_Deadlock
imports DFP_Network
begin

(*  The following simplification rules are deleted in this theory file *)
(*  because they unexpectly rewrite UnionT and InterT.                 *)
(*                  Union (B ` A) = (UN x:A. B x)                      *)
(*                  Inter (B ` A) = (INT x:A. B x)                     *)
(*
declare Union_image_eq [simp del]
declare Inter_image_eq [simp del]
*)
(* no simp rules in Isabelle 2017
declare Sup_image_eq [simp del]
declare Inf_image_eq [simp del]
*)

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

declare disj_not1 [simp del]

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

         1.
         2.
         3.
         4.

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

(*********************************************************
                    definitions
 *********************************************************)

definition
  DeadlockFree :: "'a event set => ('p,'a) proc => bool"
                                           ("(0[_]-DeadlockFree _)" [0,55] 55)
  where
  DeadlockFree_def :
    "[X]-DeadlockFree P == (ALL s. (Tick ~: sett(s)) --> (s,X) ~:f failures P MF)"

  (* R is deadlock free with respect to X, thus
     R can always perform an event in X at least *)

definition
  DeadlockFreeNetwork :: "('i,'p,'a) Network => bool"
  where
  DeadlockFreeNetwork_def :
    "DeadlockFreeNetwork V ==
     [Ev ` (ALP V)]-DeadlockFree PAR V"

(*** UNIV deadlockfree ***)

syntax
  "@isDeadlockFree"  :: "('p,'a) proc => bool"
                         ("_ isDeadlockFree" [1000] 1000)

translations
  "P isDeadlockFree"  == "[(CONST UNIV)]-DeadlockFree P"

definition
  isDeadlockStateOf ::
   "('i,'a) net_state => ('i,'a) NetworkF => bool"
                           ("(0_ isDeadlockStateOf _)" [55,55] 55)
  where
  isDeadlockStateOf_def :
   "sigma isDeadlockStateOf VF ==
                sigma isStateOf VF &
                Union {((snd sigma) i) |i. i : fst VF}
                = Ev ` (ALP VF)"

(*********************************************************
           isDeadlockStateOf subset alpha
 *********************************************************)

lemma isDeadlockStateOf_subset_alpha1:
   "[| (I, FXf) isFailureOf (I, PXf) ;
       (t, Yf) isDeadlockStateOf (I, FXf) ;
       i : I ; e : Yf i|]
    ==> e : (Ev ` (snd (PXf i)))"
apply (simp add: isDeadlockStateOf_def)
apply (auto simp add: isStateOf_subset_alpha)
done

lemma isDeadlockStateOf_subset_alpha2:
   "[| (I, FXf) isFailureOf (I, PXf) ;
       (t, Yf) isDeadlockStateOf (I, FXf) ;
       i : I ; e : Yf i|]
    ==> e : (Ev ` (snd (FXf i)))"
apply (simp add: isDeadlockStateOf_def)
apply (auto simp add: isStateOf_subset_alpha)
done

lemmas isDeadlockStateOf_subset_alpha = isDeadlockStateOf_subset_alpha1
                                        isDeadlockStateOf_subset_alpha2

(*********************************************************
             Deadlock and Deadlock freedom
 *********************************************************)

(*** Existency ***)

lemma DeadlockState_notDeadlockFree_only_if_lmEX_lm:
  "[|  ALL s Y.
                 (s, Y) : fst (FXf i) -->
                 (s, Y) :f failures (fst (PXf i)) MF & Y <= Ev ` snd (FXf i);
        (s rest-tr snd (FXf i), Z) : fst (FXf i);
              Yf i Int Ev ` snd (FXf i) <= Z |]
           ==> (s rest-tr snd (FXf i),
                SOME Z.
                   (s rest-tr snd (FXf i), Z) : fst (FXf i) &
                   Yf i Int Ev ` snd (FXf i) <= Z & Z <= Ev ` snd (FXf i))
               : fst (FXf i) &
               Yf i Int Ev ` snd (FXf i)
               <= (SOME Z.
                      (s rest-tr snd (FXf i), Z) : fst (FXf i) &
                      Yf i Int Ev ` snd (FXf i) <= Z & Z <= Ev ` snd (FXf i)) &
               (SOME Z.
                   (s rest-tr snd (FXf i), Z) : fst (FXf i) &
                   Yf i Int Ev ` snd (FXf i) <= Z & Z <= Ev ` snd (FXf i))
               <= Ev ` snd (FXf i)"
apply (rule someI2[of
"(%Z. (s rest-tr snd (FXf i), Z) : fst (FXf i) &
      Yf i Int Ev ` snd (FXf i) <= Z & Z <= Ev ` snd (FXf i))" Z])
apply (rule conjI)
apply (simp)
apply (simp)
apply (simp)
done

lemma DeadlockState_notDeadlockFree_only_if_lmEX:
   "[| (I, FXf) isFailureOf (I, PXf) ;
       ALL i:I. (s rest-tr (snd (PXf i)), Yf i)
                :f failures (fst (PXf i)) MF |]
    ==>
    EX Zf. ALL i:I. (s rest-tr (snd (FXf i)), Zf i) : fst (FXf i) &
                    Yf i Int Ev ` snd (FXf i) <= Zf i &
                    Zf i <= Ev ` snd (FXf i)"
 apply (rule_tac x=
   "(%i. (SOME Z. (s rest-tr (snd (FXf i)), Z) : fst (FXf i) &
                    Yf i Int Ev ` snd (FXf i) <= Z &
                    Z <= Ev ` snd (FXf i)))" in exI)
apply (intro ballI impI)
apply (simp add: isFailureOf_def)
apply (drule_tac x="i" in bspec, simp)
apply (drule_tac x="i" in bspec, simp)
apply (simp add: subseteqEX_restRefusal_iff)
apply (elim conjE exE)
apply (rotate_tac -2)

apply (drule_tac x="s rest-tr snd (FXf i)" in spec)
apply (drule_tac x="Yf i" in spec)
apply (simp)
apply (elim conjE exE)
apply (rule DeadlockState_notDeadlockFree_only_if_lmEX_lm)
apply (simp_all)
apply (force)
done

(* only if part *)

lemma DeadlockState_notDeadlockFree_only_if:
  "[| I ~= {} ; finite I ; (I,FXf) isFailureOf (I,PXf) ;
      ~ DeadlockFreeNetwork (I,PXf) |]
   ==> (EX sigma. (sigma isDeadlockStateOf (I,FXf)))"
apply (simp add: DeadlockFreeNetwork_def)
apply (simp add: DeadlockFree_def)
apply (simp add: isDeadlockStateOf_def)
apply (subgoal_tac "Union (snd ` PXf ` I) = {a. EX i:I. a : snd (FXf i)}")
                                               (* ... sub 1 *)

 apply (elim conjE exE)
 apply (simp add: PAR_def)
 apply (simp add: in_failures_par)
 apply (elim conjE exE)

 apply (subgoal_tac
   "EX Zf. ALL i:I. (s rest-tr (snd (FXf i)), Zf i) :  fst (FXf i) &
           ((Yf i) Int (Ev ` snd (FXf i))) <= Zf i &
           Zf i <= (Ev ` snd (FXf i))")
                                               (* ... sub 2 *)
  apply (elim conjE exE)

 apply (rule_tac x="s" in exI)
 apply (rule_tac x="Zf" in exI)
 apply (rule conjI)

  apply (simp add: isStateOf_def)
  apply (simp add: ALP_def)
  apply (simp add: subset_insert)

  (* set *)
  apply (simp add: ALP_def)
  apply (simp add: isFailureOf_def)
  apply (simp add: Int_insert_eq)
  apply (rule)
   (* <= *)
   apply (rotate_tac -3)
   apply (drule sym)
   apply (simp)
   apply (rule)
   apply (simp)
   apply (elim conjE exE)
   apply (simp)
   apply (rotate_tac 1)
   apply (drule_tac x="i" in bspec, simp)
   apply (elim conjE)

   apply (rule rev_subsetD)
   apply (simp)
   apply (simp)
   apply (rule order_trans)
   apply (simp)

   apply (rule)
   apply (simp add: image_iff)
   apply (elim conjE bexE)
   apply (simp)
   apply (rule_tac x="i" in bexI)
   apply (simp)
   apply (simp)

   (* => *)
   apply (rule)
   apply (simp)
   apply (elim conjE bexE exE)
   apply (simp)
   apply (rule_tac x="Zf i" in exI)
   apply (rule conjI)
   apply (fast)

   apply (elim conjE disjE)
    apply (drule_tac x="i" in bspec, simp)
    apply (simp)
    apply (subgoal_tac
      "Tick : Union {(Yf i Int insert Tick (Ev ` snd (PXf i))) |i. i : I}")
     apply (rotate_tac 5)
     apply (drule sym)
     apply (simp add: image_iff)
    apply (simp)
    apply (rule_tac x="Yf i Int insert Tick (Ev ` snd (PXf i))" in exI, simp)
    apply (rule_tac x="i" in exI, simp)

    apply (rotate_tac -5)
    apply (drule_tac x="i" in bspec, simp)
    apply (elim conjE disjE)
    apply (rule subsetD)
    apply (simp)
    apply (fast)

 (* sub 2 *)
 apply (simp add: DeadlockState_notDeadlockFree_only_if_lmEX)

(* sub 1 *)
apply (simp add: isFailureOf_def)
apply (auto)
done

(*** if part ***)

lemma DeadlockState_notDeadlockFree_if:
  "[| I ~= {} ; finite I ; (I,FXf) isFailureOf (I,PXf) ;
      EX sigma. (sigma isDeadlockStateOf (I,FXf)) |]
   ==> ~ DeadlockFreeNetwork (I,PXf)"
apply (simp add: DeadlockFreeNetwork_def)
apply (simp add: DeadlockFree_def)
apply (simp add: isDeadlockStateOf_def)

apply (elim conjE exE)
apply (simp add: PAR_def)

apply (rule_tac x="a" in exI)
apply (simp add: in_failures_par)
apply (simp add: isStateOf_def ALP_def)

apply (elim conjE exE)
apply (rule conjI)
apply (fast)
apply (rule conjI)

apply (rule order_trans)
apply (simp)
apply (simp add: isFailureOf_def)
apply (fast)

apply (rule_tac x="b" in exI)
apply (rename_tac s Ys)
apply (drule sym)
apply (simp)
apply (subgoal_tac "Union (snd ` PXf ` I) = {a. EX i:I. a : snd (PXf i)}")
apply (simp add: Int_insert_eq)
apply (rule conjI)
 apply (rule)

 (* <= *)
  apply (rule)
   apply (simp add: image_iff)
   apply (elim conjE exE bexE)
   apply (simp)
   apply (subgoal_tac "x : Ev ` {a. EX i:I. a : snd (FXf i)}")

    apply (simp)
    apply (elim conjE exE)
    apply (rule_tac x="Ys ia Int insert Tick (Ev ` snd (PXf ia))" in exI)
    apply (rule conjI)
    apply (fast)

    apply (simp)
    apply (drule_tac x="ia" in bspec, simp)
    apply (simp add: isFailureOf_same_alpha)
    apply (blast)

   apply (simp (no_asm) add: image_iff)
   apply (rule_tac x="xa" in exI)
   apply (simp add: isFailureOf_def)
   apply (force)

 (* => *)
  apply (rule)
   apply (simp)
   apply (elim conjE exE)
   apply (simp add: image_iff)
   apply (elim disjE conjE exE)
    apply (drule_tac x="i" in bspec, simp)
    apply (force)

    apply (elim conjE bexE)
    apply (rule_tac x="xb" in exI, simp)
    apply (rule_tac x="i" in bexI)
    apply (simp)
    apply (simp)

apply (intro ballI)
apply (simp add: isFailureOf_def)
apply (simp add: subseteqEX_restRefusal_iff)

apply (auto)
done

(*** iff ***)

lemma DeadlockState_notDeadlockFree:
  "[| I ~= {} ; finite I ; (I,FXf) isFailureOf (I,PXf) |]
   ==> (~ DeadlockFreeNetwork (I,PXf)) =
       (EX sigma. (sigma isDeadlockStateOf (I,FXf)))"
apply (rule)
apply (rule DeadlockState_notDeadlockFree_only_if, simp_all)
apply (simp add: DeadlockState_notDeadlockFree_if)
done

(*** DeadlockFree ***)

lemma DeadlockFree_notDeadlockState:
  "[| I ~= {} ; finite I ; (I,FXf) isFailureOf (I,PXf) |]
   ==> DeadlockFreeNetwork (I,PXf) =
       (ALL sigma. ~(sigma isDeadlockStateOf (I,FXf)))"
apply (rule iffI)
apply (rotate_tac -1)
apply (erule contrapos_pp)
apply (simp add: DeadlockState_notDeadlockFree)
apply (rotate_tac -1)
apply (erule contrapos_pp)
apply (simp add: DeadlockState_notDeadlockFree)
done

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

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


(*  Title:      JinjaDCI/Compiler/J1.thy
    Author:     Tobias Nipkow, Susannah Mansky
    Copyright   2003 Technische Universitaet Muenchen, 2019-20 UIUC

    Based on the Jinja theory Compiler/J1.thy by Tobias Nipkow
*)

chapter \<open> Compilation \label{cha:comp} \<close>

section \<open> An Intermediate Language \<close>

theory J1 imports "../J/BigStep" begin

type_synonym expr\<^sub>1 = "nat exp"
type_synonym J\<^sub>1_prog = "expr\<^sub>1 prog"
type_synonym state\<^sub>1 = "heap \<times> (val list) \<times> sheap"

definition hp\<^sub>1 :: "state\<^sub>1 \<Rightarrow> heap"
where
  "hp\<^sub>1  \<equiv>  fst"
definition lcl\<^sub>1 :: "state\<^sub>1 \<Rightarrow> val list"
where
  "lcl\<^sub>1  \<equiv>  fst \<circ> snd"
definition shp\<^sub>1 :: "state\<^sub>1 \<Rightarrow> sheap"
where
  "shp\<^sub>1  \<equiv>  snd \<circ> snd"

(*<*)
declare hp\<^sub>1_def[simp] lcl\<^sub>1_def[simp] shp\<^sub>1_def[simp]
(*>*)

primrec
  max_vars :: "'a exp \<Rightarrow> nat"
  and max_varss :: "'a exp list \<Rightarrow> nat"
where
  "max_vars(new C) = 0"
| "max_vars(Cast C e) = max_vars e"
| "max_vars(Val v) = 0"
| "max_vars(e\<^sub>1 \<guillemotleft>bop\<guillemotright> e\<^sub>2) = max (max_vars e\<^sub>1) (max_vars e\<^sub>2)"
| "max_vars(Var V) = 0"
| "max_vars(V:=e) = max_vars e"
| "max_vars(e\<bullet>F{D}) = max_vars e"
| "max_vars(C\<bullet>\<^sub>sF{D}) = 0"
| "max_vars(FAss e\<^sub>1 F D e\<^sub>2) = max (max_vars e\<^sub>1) (max_vars e\<^sub>2)"
| "max_vars(SFAss C F D e\<^sub>2) = max_vars e\<^sub>2"
| "max_vars(e\<bullet>M(es)) = max (max_vars e) (max_varss es)"
| "max_vars(C\<bullet>\<^sub>sM(es)) = max_varss es"
| "max_vars({V:T; e}) = max_vars e + 1"
| "max_vars(e\<^sub>1;;e\<^sub>2) = max (max_vars e\<^sub>1) (max_vars e\<^sub>2)"
| "max_vars(if (e) e\<^sub>1 else e\<^sub>2) =
   max (max_vars e) (max (max_vars e\<^sub>1) (max_vars e\<^sub>2))"
| "max_vars(while (b) e) = max (max_vars b) (max_vars e)"
| "max_vars(throw e) = max_vars e"
| "max_vars(try e\<^sub>1 catch(C V) e\<^sub>2) = max (max_vars e\<^sub>1) (max_vars e\<^sub>2 + 1)"
| "max_vars(INIT C (Cs,b) \<leftarrow> e) = max_vars e"
| "max_vars(RI(C,e);Cs \<leftarrow> e') = max (max_vars e) (max_vars e')"

| "max_varss [] = 0"
| "max_varss (e#es) = max (max_vars e) (max_varss es)"

inductive
  eval\<^sub>1 :: "J\<^sub>1_prog \<Rightarrow> expr\<^sub>1 \<Rightarrow> state\<^sub>1 \<Rightarrow> expr\<^sub>1 \<Rightarrow> state\<^sub>1 \<Rightarrow> bool"
          ("_ \<turnstile>\<^sub>1 ((1\<langle>_,/_\<rangle>) \<Rightarrow>/ (1\<langle>_,/_\<rangle>))" [51,0,0,0,0] 81)
  and evals\<^sub>1 :: "J\<^sub>1_prog \<Rightarrow> expr\<^sub>1 list \<Rightarrow> state\<^sub>1 \<Rightarrow> expr\<^sub>1 list \<Rightarrow> state\<^sub>1 \<Rightarrow> bool"
           ("_ \<turnstile>\<^sub>1 ((1\<langle>_,/_\<rangle>) [\<Rightarrow>]/ (1\<langle>_,/_\<rangle>))" [51,0,0,0,0] 81)
  for P :: J\<^sub>1_prog
where

  New\<^sub>1:
  "\<lbrakk> sh C = Some (sfs, Done); new_Addr h = Some a;
     P \<turnstile> C has_fields FDTs; h' = h(a\<mapsto>blank P C) \<rbrakk>
  \<Longrightarrow> P \<turnstile>\<^sub>1 \<langle>new C,(h,l,sh)\<rangle> \<Rightarrow> \<langle>addr a,(h',l,sh)\<rangle>"
| NewFail\<^sub>1:
  "\<lbrakk> sh C = Some (sfs, Done); new_Addr h = None \<rbrakk> \<Longrightarrow>
  P \<turnstile>\<^sub>1 \<langle>new C, (h,l,sh)\<rangle> \<Rightarrow> \<langle>THROW OutOfMemory,(h,l,sh)\<rangle>"
| NewInit\<^sub>1:
  "\<lbrakk> \<nexists>sfs. sh C = Some (sfs, Done); P \<turnstile>\<^sub>1 \<langle>INIT C ([C],False) \<leftarrow> unit,(h,l,sh)\<rangle> \<Rightarrow> \<langle>Val v',(h',l',sh')\<rangle>;
     new_Addr h' = Some a; P \<turnstile> C has_fields FDTs; h'' = h'(a\<mapsto>blank P C) \<rbrakk>
  \<Longrightarrow> P \<turnstile>\<^sub>1 \<langle>new C,(h,l,sh)\<rangle> \<Rightarrow> \<langle>addr a,(h'',l',sh')\<rangle>"
| NewInitOOM\<^sub>1:
  "\<lbrakk> \<nexists>sfs. sh C = Some (sfs, Done); P \<turnstile>\<^sub>1 \<langle>INIT C ([C],False) \<leftarrow> unit,(h,l,sh)\<rangle> \<Rightarrow> \<langle>Val v',(h',l',sh')\<rangle>;
     new_Addr h' = None; is_class P C \<rbrakk>
  \<Longrightarrow> P \<turnstile>\<^sub>1 \<langle>new C,(h,l,sh)\<rangle> \<Rightarrow> \<langle>THROW OutOfMemory,(h',l',sh')\<rangle>"
| NewInitThrow\<^sub>1:
  "\<lbrakk> \<nexists>sfs. sh C = Some (sfs, Done); P \<turnstile>\<^sub>1 \<langle>INIT C ([C],False) \<leftarrow> unit,(h,l,sh)\<rangle> \<Rightarrow> \<langle>throw a,s'\<rangle>;
     is_class P C \<rbrakk>
  \<Longrightarrow> P \<turnstile>\<^sub>1 \<langle>new C,(h,l,sh)\<rangle> \<Rightarrow> \<langle>throw a,s'\<rangle>"

| Cast\<^sub>1:
  "\<lbrakk> P \<turnstile>\<^sub>1 \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>addr a,(h,l,sh)\<rangle>; h a = Some(D,fs); P \<turnstile> D \<preceq>\<^sup>* C \<rbrakk>
  \<Longrightarrow> P \<turnstile>\<^sub>1 \<langle>Cast C e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>addr a,(h,l,sh)\<rangle>"
| CastNull\<^sub>1:
  "P \<turnstile>\<^sub>1 \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>null,s\<^sub>1\<rangle> \<Longrightarrow>
  P \<turnstile>\<^sub>1 \<langle>Cast C e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>null,s\<^sub>1\<rangle>"
| CastFail\<^sub>1:
  "\<lbrakk> P \<turnstile>\<^sub>1 \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>addr a,(h,l,sh)\<rangle>; h a = Some(D,fs); \<not> P \<turnstile> D \<preceq>\<^sup>* C \<rbrakk>
  \<Longrightarrow> P \<turnstile>\<^sub>1 \<langle>Cast C e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>THROW ClassCast,(h,l,sh)\<rangle>"
| CastThrow\<^sub>1:
  "P \<turnstile>\<^sub>1 \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw e',s\<^sub>1\<rangle> \<Longrightarrow>
  P \<turnstile>\<^sub>1 \<langle>Cast C e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw e',s\<^sub>1\<rangle>"

| Val\<^sub>1:
  "P \<turnstile>\<^sub>1 \<langle>Val v,s\<rangle> \<Rightarrow> \<langle>Val v,s\<rangle>"

| BinOp\<^sub>1:
  "\<lbrakk> P \<turnstile>\<^sub>1 \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<Rightarrow> \<langle>Val v\<^sub>1,s\<^sub>1\<rangle>; P \<turnstile>\<^sub>1 \<langle>e\<^sub>2,s\<^sub>1\<rangle> \<Rightarrow> \<langle>Val v\<^sub>2,s\<^sub>2\<rangle>; binop(bop,v\<^sub>1,v\<^sub>2) = Some v \<rbrakk>
  \<Longrightarrow> P \<turnstile>\<^sub>1 \<langle>e\<^sub>1 \<guillemotleft>bop\<guillemotright> e\<^sub>2,s\<^sub>0\<rangle> \<Rightarrow> \<langle>Val v,s\<^sub>2\<rangle>"
| BinOpThrow\<^sub>1\<^sub>1:
  "P \<turnstile>\<^sub>1 \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw e,s\<^sub>1\<rangle> \<Longrightarrow>
  P \<turnstile>\<^sub>1 \<langle>e\<^sub>1 \<guillemotleft>bop\<guillemotright> e\<^sub>2, s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw e,s\<^sub>1\<rangle>"
| BinOpThrow\<^sub>2\<^sub>1:
  "\<lbrakk> P \<turnstile>\<^sub>1 \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<Rightarrow> \<langle>Val v\<^sub>1,s\<^sub>1\<rangle>; P \<turnstile>\<^sub>1 \<langle>e\<^sub>2,s\<^sub>1\<rangle> \<Rightarrow> \<langle>throw e,s\<^sub>2\<rangle> \<rbrakk>
  \<Longrightarrow> P \<turnstile>\<^sub>1 \<langle>e\<^sub>1 \<guillemotleft>bop\<guillemotright> e\<^sub>2,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw e,s\<^sub>2\<rangle>"

| Var\<^sub>1:
  "\<lbrakk> ls!i = v; i < size ls \<rbrakk> \<Longrightarrow>
  P \<turnstile>\<^sub>1 \<langle>Var i,(h,ls,sh)\<rangle> \<Rightarrow> \<langle>Val v,(h,ls,sh)\<rangle>"

| LAss\<^sub>1:
  "\<lbrakk> P \<turnstile>\<^sub>1 \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>Val v,(h,ls,sh)\<rangle>; i < size ls; ls' = ls[i := v] \<rbrakk>
  \<Longrightarrow> P \<turnstile>\<^sub>1 \<langle>i:= e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>unit,(h,ls',sh)\<rangle>"
| LAssThrow\<^sub>1:
  "P \<turnstile>\<^sub>1 \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw e',s\<^sub>1\<rangle> \<Longrightarrow>
  P \<turnstile>\<^sub>1 \<langle>i:= e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw e',s\<^sub>1\<rangle>"

| FAcc\<^sub>1:
  "\<lbrakk> P \<turnstile>\<^sub>1 \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>addr a,(h,ls,sh)\<rangle>; h a = Some(C,fs);
     P \<turnstile> C has F,NonStatic:t in D;
     fs(F,D) = Some v \<rbrakk>
  \<Longrightarrow> P \<turnstile>\<^sub>1 \<langle>e\<bullet>F{D},s\<^sub>0\<rangle> \<Rightarrow> \<langle>Val v,(h,ls,sh)\<rangle>"
| FAccNull\<^sub>1:
  "P \<turnstile>\<^sub>1 \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>null,s\<^sub>1\<rangle> \<Longrightarrow>
  P \<turnstile>\<^sub>1 \<langle>e\<bullet>F{D},s\<^sub>0\<rangle> \<Rightarrow> \<langle>THROW NullPointer,s\<^sub>1\<rangle>"
| FAccThrow\<^sub>1:
  "P \<turnstile>\<^sub>1 \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw e',s\<^sub>1\<rangle> \<Longrightarrow>
  P \<turnstile>\<^sub>1 \<langle>e\<bullet>F{D},s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw e',s\<^sub>1\<rangle>"
| FAccNone\<^sub>1:
  "\<lbrakk> P \<turnstile>\<^sub>1 \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>addr a,(h,ls,sh)\<rangle>; h a = Some(C,fs);
    \<not>(\<exists>b t. P \<turnstile> C has F,b:t in D) \<rbrakk>
  \<Longrightarrow> P \<turnstile>\<^sub>1 \<langle>e\<bullet>F{D},s\<^sub>0\<rangle> \<Rightarrow> \<langle>THROW NoSuchFieldError,(h,ls,sh)\<rangle>"
| FAccStatic\<^sub>1:
  "\<lbrakk> P \<turnstile>\<^sub>1 \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>addr a,(h,ls,sh)\<rangle>; h a = Some(C,fs);
    P \<turnstile> C has F,Static:t in D \<rbrakk>
  \<Longrightarrow> P \<turnstile>\<^sub>1 \<langle>e\<bullet>F{D},s\<^sub>0\<rangle> \<Rightarrow> \<langle>THROW IncompatibleClassChangeError,(h,ls,sh)\<rangle>"

| SFAcc\<^sub>1:
  "\<lbrakk> P \<turnstile> C has F,Static:t in D;
     sh D = Some (sfs,Done);
     sfs F = Some v \<rbrakk>
  \<Longrightarrow> P \<turnstile>\<^sub>1 \<langle>C\<bullet>\<^sub>sF{D},(h,ls,sh)\<rangle> \<Rightarrow> \<langle>Val v,(h,ls,sh)\<rangle>"
| SFAccInit\<^sub>1:
  "\<lbrakk> P \<turnstile> C has F,Static:t in D;
     \<nexists>sfs. sh D = Some (sfs,Done); P \<turnstile>\<^sub>1 \<langle>INIT D ([D],False) \<leftarrow> unit,(h,ls,sh)\<rangle> \<Rightarrow> \<langle>Val v',(h',ls',sh')\<rangle>;
     sh' D = Some (sfs,i);
     sfs F = Some v \<rbrakk>
  \<Longrightarrow> P \<turnstile>\<^sub>1 \<langle>C\<bullet>\<^sub>sF{D},(h,ls,sh)\<rangle> \<Rightarrow> \<langle>Val v,(h',ls',sh')\<rangle>"
| SFAccInitThrow\<^sub>1:
  "\<lbrakk> P \<turnstile> C has F,Static:t in D;
     \<nexists>sfs. sh D = Some (sfs,Done); P \<turnstile>\<^sub>1 \<langle>INIT D ([D],False) \<leftarrow> unit,(h,ls,sh)\<rangle> \<Rightarrow> \<langle>throw a,s'\<rangle> \<rbrakk>
  \<Longrightarrow> P \<turnstile>\<^sub>1 \<langle>C\<bullet>\<^sub>sF{D},(h,ls,sh)\<rangle> \<Rightarrow> \<langle>throw a,s'\<rangle>"
| SFAccNone\<^sub>1:
  "\<lbrakk> \<not>(\<exists>b t. P \<turnstile> C has F,b:t in D) \<rbrakk>
  \<Longrightarrow> P \<turnstile>\<^sub>1 \<langle>C\<bullet>\<^sub>sF{D},s\<rangle> \<Rightarrow> \<langle>THROW NoSuchFieldError,s\<rangle>"
| SFAccNonStatic\<^sub>1:
  "\<lbrakk> P \<turnstile> C has F,NonStatic:t in D \<rbrakk>
  \<Longrightarrow> P \<turnstile>\<^sub>1 \<langle>C\<bullet>\<^sub>sF{D},s\<rangle> \<Rightarrow> \<langle>THROW IncompatibleClassChangeError,s\<rangle>"

| FAss\<^sub>1:
  "\<lbrakk> P \<turnstile>\<^sub>1 \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<Rightarrow> \<langle>addr a,s\<^sub>1\<rangle>; P \<turnstile>\<^sub>1 \<langle>e\<^sub>2,s\<^sub>1\<rangle> \<Rightarrow> \<langle>Val v,(h\<^sub>2,l\<^sub>2,sh\<^sub>2)\<rangle>;
     h\<^sub>2 a = Some(C,fs); P \<turnstile> C has F,NonStatic:t in D;
     fs' = fs((F,D)\<mapsto>v); h\<^sub>2' = h\<^sub>2(a\<mapsto>(C,fs')) \<rbrakk>
  \<Longrightarrow> P \<turnstile>\<^sub>1 \<langle>e\<^sub>1\<bullet>F{D}:=e\<^sub>2,s\<^sub>0\<rangle> \<Rightarrow> \<langle>unit,(h\<^sub>2',l\<^sub>2,sh\<^sub>2)\<rangle>"
| FAssNull\<^sub>1:
  "\<lbrakk> P \<turnstile>\<^sub>1 \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<Rightarrow> \<langle>null,s\<^sub>1\<rangle>;  P \<turnstile>\<^sub>1 \<langle>e\<^sub>2,s\<^sub>1\<rangle> \<Rightarrow> \<langle>Val v,s\<^sub>2\<rangle> \<rbrakk> \<Longrightarrow>
  P \<turnstile>\<^sub>1 \<langle>e\<^sub>1\<bullet>F{D}:=e\<^sub>2,s\<^sub>0\<rangle> \<Rightarrow> \<langle>THROW NullPointer,s\<^sub>2\<rangle>"
| FAssThrow\<^sub>1\<^sub>1:
  "P \<turnstile>\<^sub>1 \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw e',s\<^sub>1\<rangle> \<Longrightarrow>
  P \<turnstile>\<^sub>1 \<langle>e\<^sub>1\<bullet>F{D}:=e\<^sub>2,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw e',s\<^sub>1\<rangle>"
| FAssThrow\<^sub>2\<^sub>1:
  "\<lbrakk> P \<turnstile>\<^sub>1 \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<Rightarrow> \<langle>Val v,s\<^sub>1\<rangle>; P \<turnstile>\<^sub>1 \<langle>e\<^sub>2,s\<^sub>1\<rangle> \<Rightarrow> \<langle>throw e',s\<^sub>2\<rangle> \<rbrakk>
  \<Longrightarrow> P \<turnstile>\<^sub>1 \<langle>e\<^sub>1\<bullet>F{D}:=e\<^sub>2,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw e',s\<^sub>2\<rangle>"
| FAssNone\<^sub>1:
  "\<lbrakk> P \<turnstile>\<^sub>1 \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<Rightarrow> \<langle>addr a,s\<^sub>1\<rangle>; P \<turnstile>\<^sub>1 \<langle>e\<^sub>2,s\<^sub>1\<rangle> \<Rightarrow> \<langle>Val v,(h\<^sub>2,l\<^sub>2,sh\<^sub>2)\<rangle>;
     h\<^sub>2 a = Some(C,fs); \<not>(\<exists>b t. P \<turnstile> C has F,b:t in D) \<rbrakk>
  \<Longrightarrow> P \<turnstile>\<^sub>1 \<langle>e\<^sub>1\<bullet>F{D}:=e\<^sub>2,s\<^sub>0\<rangle> \<Rightarrow> \<langle>THROW NoSuchFieldError,(h\<^sub>2,l\<^sub>2,sh\<^sub>2)\<rangle>"
| FAssStatic\<^sub>1:
  "\<lbrakk> P \<turnstile>\<^sub>1 \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<Rightarrow> \<langle>addr a,s\<^sub>1\<rangle>; P \<turnstile>\<^sub>1 \<langle>e\<^sub>2,s\<^sub>1\<rangle> \<Rightarrow> \<langle>Val v,(h\<^sub>2,l\<^sub>2,sh\<^sub>2)\<rangle>;
     h\<^sub>2 a = Some(C,fs); P \<turnstile> C has F,Static:t in D \<rbrakk>
  \<Longrightarrow> P \<turnstile>\<^sub>1 \<langle>e\<^sub>1\<bullet>F{D}:=e\<^sub>2,s\<^sub>0\<rangle> \<Rightarrow> \<langle>THROW IncompatibleClassChangeError,(h\<^sub>2,l\<^sub>2,sh\<^sub>2)\<rangle>"

| SFAss\<^sub>1:
  "\<lbrakk> P \<turnstile>\<^sub>1 \<langle>e\<^sub>2,s\<^sub>0\<rangle> \<Rightarrow> \<langle>Val v,(h\<^sub>1,l\<^sub>1,sh\<^sub>1)\<rangle>;
     P \<turnstile> C has F,Static:t in D;
     sh\<^sub>1 D = Some(sfs,Done); sfs' = sfs(F\<mapsto>v); sh\<^sub>1' = sh\<^sub>1(D\<mapsto>(sfs',Done)) \<rbrakk>
  \<Longrightarrow> P \<turnstile>\<^sub>1 \<langle>C\<bullet>\<^sub>sF{D}:=e\<^sub>2,s\<^sub>0\<rangle> \<Rightarrow> \<langle>unit,(h\<^sub>1,l\<^sub>1,sh\<^sub>1')\<rangle>"
| SFAssInit\<^sub>1:
  "\<lbrakk> P \<turnstile>\<^sub>1 \<langle>e\<^sub>2,s\<^sub>0\<rangle> \<Rightarrow> \<langle>Val v,(h\<^sub>1,l\<^sub>1,sh\<^sub>1)\<rangle>;
     P \<turnstile> C has F,Static:t in D;
     \<nexists>sfs. sh\<^sub>1 D = Some(sfs,Done); P \<turnstile>\<^sub>1 \<langle>INIT D ([D],False) \<leftarrow> unit,(h\<^sub>1,l\<^sub>1,sh\<^sub>1)\<rangle> \<Rightarrow> \<langle>Val v',(h',l',sh')\<rangle>;
     sh' D = Some(sfs,i);
     sfs' = sfs(F\<mapsto>v); sh'' = sh'(D\<mapsto>(sfs',i)) \<rbrakk>
  \<Longrightarrow> P \<turnstile>\<^sub>1 \<langle>C\<bullet>\<^sub>sF{D}:=e\<^sub>2,s\<^sub>0\<rangle> \<Rightarrow> \<langle>unit,(h',l',sh'')\<rangle>"
| SFAssInitThrow\<^sub>1:
  "\<lbrakk> P \<turnstile>\<^sub>1 \<langle>e\<^sub>2,s\<^sub>0\<rangle> \<Rightarrow> \<langle>Val v,(h\<^sub>1,l\<^sub>1,sh\<^sub>1)\<rangle>;
     P \<turnstile> C has F,Static:t in D;
     \<nexists>sfs. sh\<^sub>1 D = Some(sfs,Done); P \<turnstile>\<^sub>1 \<langle>INIT D ([D],False) \<leftarrow> unit,(h\<^sub>1,l\<^sub>1,sh\<^sub>1)\<rangle> \<Rightarrow> \<langle>throw a,s'\<rangle> \<rbrakk>
  \<Longrightarrow> P \<turnstile>\<^sub>1 \<langle>C\<bullet>\<^sub>sF{D}:=e\<^sub>2,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw a,s'\<rangle>"
| SFAssThrow\<^sub>1:
  "P \<turnstile>\<^sub>1 \<langle>e\<^sub>2,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw e',s\<^sub>2\<rangle>
  \<Longrightarrow> P \<turnstile>\<^sub>1 \<langle>C\<bullet>\<^sub>sF{D}:=e\<^sub>2,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw e',s\<^sub>2\<rangle>"
| SFAssNone\<^sub>1:
  "\<lbrakk> P \<turnstile>\<^sub>1 \<langle>e\<^sub>2,s\<^sub>0\<rangle> \<Rightarrow> \<langle>Val v,(h\<^sub>2,l\<^sub>2,sh\<^sub>2)\<rangle>;
    \<not>(\<exists>b t. P \<turnstile> C has F,b:t in D) \<rbrakk>
  \<Longrightarrow> P \<turnstile>\<^sub>1 \<langle>C\<bullet>\<^sub>sF{D}:=e\<^sub>2,s\<^sub>0\<rangle> \<Rightarrow> \<langle>THROW NoSuchFieldError,(h\<^sub>2,l\<^sub>2,sh\<^sub>2)\<rangle>"
| SFAssNonStatic\<^sub>1:
  "\<lbrakk> P \<turnstile>\<^sub>1 \<langle>e\<^sub>2,s\<^sub>0\<rangle> \<Rightarrow> \<langle>Val v,(h\<^sub>2,l\<^sub>2,sh\<^sub>2)\<rangle>;
    P \<turnstile> C has F,NonStatic:t in D \<rbrakk>
  \<Longrightarrow> P \<turnstile>\<^sub>1 \<langle>C\<bullet>\<^sub>sF{D}:=e\<^sub>2,s\<^sub>0\<rangle> \<Rightarrow> \<langle>THROW IncompatibleClassChangeError,(h\<^sub>2,l\<^sub>2,sh\<^sub>2)\<rangle>"

| CallObjThrow\<^sub>1:
  "P \<turnstile>\<^sub>1 \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw e',s\<^sub>1\<rangle> \<Longrightarrow>
  P \<turnstile>\<^sub>1 \<langle>e\<bullet>M(es),s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw e',s\<^sub>1\<rangle>"
| CallNull\<^sub>1:
  "\<lbrakk> P \<turnstile>\<^sub>1 \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>null,s\<^sub>1\<rangle>; P \<turnstile>\<^sub>1 \<langle>es,s\<^sub>1\<rangle> [\<Rightarrow>] \<langle>map Val vs,s\<^sub>2\<rangle> \<rbrakk>
  \<Longrightarrow> P \<turnstile>\<^sub>1 \<langle>e\<bullet>M(es),s\<^sub>0\<rangle> \<Rightarrow> \<langle>THROW NullPointer,s\<^sub>2\<rangle>"
| Call\<^sub>1:
  "\<lbrakk> P \<turnstile>\<^sub>1 \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>addr a,s\<^sub>1\<rangle>; P \<turnstile>\<^sub>1 \<langle>es,s\<^sub>1\<rangle> [\<Rightarrow>] \<langle>map Val vs,(h\<^sub>2,ls\<^sub>2,sh\<^sub>2)\<rangle>;
    h\<^sub>2 a = Some(C,fs); P \<turnstile> C sees M,NonStatic:Ts\<rightarrow>T = body in D;
    size vs = size Ts; ls\<^sub>2' = (Addr a) # vs @ replicate (max_vars body) undefined;
    P \<turnstile>\<^sub>1 \<langle>body,(h\<^sub>2,ls\<^sub>2',sh\<^sub>2)\<rangle> \<Rightarrow> \<langle>e',(h\<^sub>3,ls\<^sub>3,sh\<^sub>3)\<rangle> \<rbrakk>
  \<Longrightarrow> P \<turnstile>\<^sub>1 \<langle>e\<bullet>M(es),s\<^sub>0\<rangle> \<Rightarrow> \<langle>e',(h\<^sub>3,ls\<^sub>2,sh\<^sub>3)\<rangle>"
| CallParamsThrow\<^sub>1:
  "\<lbrakk> P \<turnstile>\<^sub>1 \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>Val v,s\<^sub>1\<rangle>; P \<turnstile>\<^sub>1 \<langle>es,s\<^sub>1\<rangle> [\<Rightarrow>] \<langle>es',s\<^sub>2\<rangle>;
     es' = map Val vs @ throw ex # es\<^sub>2 \<rbrakk>
   \<Longrightarrow> P \<turnstile>\<^sub>1 \<langle>e\<bullet>M(es),s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw ex,s\<^sub>2\<rangle>"
| CallNone\<^sub>1:
  "\<lbrakk> P \<turnstile>\<^sub>1 \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>addr a,s\<^sub>1\<rangle>;  P \<turnstile>\<^sub>1 \<langle>ps,s\<^sub>1\<rangle> [\<Rightarrow>] \<langle>map Val vs,(h\<^sub>2,ls\<^sub>2,sh\<^sub>2)\<rangle>;
     h\<^sub>2 a = Some(C,fs); \<not>(\<exists>b Ts T body D. P \<turnstile> C sees M,b:Ts\<rightarrow>T = body in D) \<rbrakk>
  \<Longrightarrow> P \<turnstile>\<^sub>1 \<langle>e\<bullet>M(ps),s\<^sub>0\<rangle> \<Rightarrow> \<langle>THROW NoSuchMethodError,(h\<^sub>2,ls\<^sub>2,sh\<^sub>2)\<rangle>"
| CallStatic\<^sub>1:
  "\<lbrakk> P \<turnstile>\<^sub>1 \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>addr a,s\<^sub>1\<rangle>;  P \<turnstile>\<^sub>1 \<langle>ps,s\<^sub>1\<rangle> [\<Rightarrow>] \<langle>map Val vs,(h\<^sub>2,ls\<^sub>2,sh\<^sub>2)\<rangle>;
     h\<^sub>2 a = Some(C,fs); P \<turnstile> C sees M,Static:Ts\<rightarrow>T = body in D \<rbrakk>
  \<Longrightarrow> P \<turnstile>\<^sub>1 \<langle>e\<bullet>M(ps),s\<^sub>0\<rangle> \<Rightarrow> \<langle>THROW IncompatibleClassChangeError,(h\<^sub>2,ls\<^sub>2,sh\<^sub>2)\<rangle>"

| SCallParamsThrow\<^sub>1:
  "\<lbrakk> P \<turnstile>\<^sub>1 \<langle>es,s\<^sub>0\<rangle> [\<Rightarrow>] \<langle>es',s\<^sub>2\<rangle>; es' = map Val vs @ throw ex # es\<^sub>2 \<rbrakk>
   \<Longrightarrow> P \<turnstile>\<^sub>1 \<langle>C\<bullet>\<^sub>sM(es),s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw ex,s\<^sub>2\<rangle>"
| SCallNone\<^sub>1:
  "\<lbrakk> P \<turnstile>\<^sub>1 \<langle>ps,s\<^sub>0\<rangle> [\<Rightarrow>] \<langle>map Val vs,s\<^sub>2\<rangle>;
     \<not>(\<exists>b Ts T body D. P \<turnstile> C sees M,b:Ts\<rightarrow>T = body in D) \<rbrakk>
  \<Longrightarrow> P \<turnstile>\<^sub>1 \<langle>C\<bullet>\<^sub>sM(ps),s\<^sub>0\<rangle> \<Rightarrow> \<langle>THROW NoSuchMethodError,s\<^sub>2\<rangle>"
| SCallNonStatic\<^sub>1:
  "\<lbrakk> P \<turnstile>\<^sub>1 \<langle>ps,s\<^sub>0\<rangle> [\<Rightarrow>] \<langle>map Val vs,s\<^sub>2\<rangle>;
     P \<turnstile> C sees M,NonStatic:Ts\<rightarrow>T = body in D \<rbrakk>
  \<Longrightarrow> P \<turnstile>\<^sub>1 \<langle>C\<bullet>\<^sub>sM(ps),s\<^sub>0\<rangle> \<Rightarrow> \<langle>THROW IncompatibleClassChangeError,s\<^sub>2\<rangle>"
| SCallInitThrow\<^sub>1:
  "\<lbrakk> P \<turnstile>\<^sub>1 \<langle>ps,s\<^sub>0\<rangle> [\<Rightarrow>] \<langle>map Val vs,(h\<^sub>1,ls\<^sub>1,sh\<^sub>1)\<rangle>;
     P \<turnstile> C sees M,Static:Ts\<rightarrow>T = body in D;
     \<nexists>sfs. sh\<^sub>1 D = Some(sfs,Done); M \<noteq> clinit;
     P \<turnstile>\<^sub>1 \<langle>INIT D ([D],False) \<leftarrow> unit,(h\<^sub>1,ls\<^sub>1,sh\<^sub>1)\<rangle> \<Rightarrow> \<langle>throw a,s'\<rangle> \<rbrakk>
  \<Longrightarrow> P \<turnstile>\<^sub>1 \<langle>C\<bullet>\<^sub>sM(ps),s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw a,s'\<rangle>"
| SCallInit\<^sub>1:
  "\<lbrakk> P \<turnstile>\<^sub>1 \<langle>ps,s\<^sub>0\<rangle> [\<Rightarrow>] \<langle>map Val vs,(h\<^sub>1,ls\<^sub>1,sh\<^sub>1)\<rangle>;
     P \<turnstile> C sees M,Static:Ts\<rightarrow>T = body in D;
     \<nexists>sfs. sh\<^sub>1 D = Some(sfs,Done); M \<noteq> clinit;
     P \<turnstile>\<^sub>1 \<langle>INIT D ([D],False) \<leftarrow> unit,(h\<^sub>1,ls\<^sub>1,sh\<^sub>1)\<rangle> \<Rightarrow> \<langle>Val v',(h\<^sub>2,ls\<^sub>2,sh\<^sub>2)\<rangle>;
     size vs = size Ts; ls\<^sub>2' = vs @ replicate (max_vars body) undefined;
     P \<turnstile>\<^sub>1 \<langle>body,(h\<^sub>2,ls\<^sub>2',sh\<^sub>2)\<rangle> \<Rightarrow> \<langle>e',(h\<^sub>3,ls\<^sub>3,sh\<^sub>3)\<rangle> \<rbrakk>
  \<Longrightarrow> P \<turnstile>\<^sub>1 \<langle>C\<bullet>\<^sub>sM(ps),s\<^sub>0\<rangle> \<Rightarrow> \<langle>e',(h\<^sub>3,ls\<^sub>2,sh\<^sub>3)\<rangle>"
| SCall\<^sub>1:
  "\<lbrakk> P \<turnstile>\<^sub>1 \<langle>ps,s\<^sub>0\<rangle> [\<Rightarrow>] \<langle>map Val vs,(h\<^sub>2,ls\<^sub>2,sh\<^sub>2)\<rangle>;
     P \<turnstile> C sees M,Static:Ts\<rightarrow>T = body in D;
     sh\<^sub>2 D = Some(sfs,Done) \<or> (M = clinit \<and> sh\<^sub>2 D = \<lfloor>(sfs, Processing)\<rfloor>);
     size vs = size Ts; ls\<^sub>2' = vs @ replicate (max_vars body) undefined;
     P \<turnstile>\<^sub>1 \<langle>body,(h\<^sub>2,ls\<^sub>2',sh\<^sub>2)\<rangle> \<Rightarrow> \<langle>e',(h\<^sub>3,ls\<^sub>3,sh\<^sub>3)\<rangle> \<rbrakk>
  \<Longrightarrow> P \<turnstile>\<^sub>1 \<langle>C\<bullet>\<^sub>sM(ps),s\<^sub>0\<rangle> \<Rightarrow> \<langle>e',(h\<^sub>3,ls\<^sub>2,sh\<^sub>3)\<rangle>"

| Block\<^sub>1:
  "P \<turnstile>\<^sub>1 \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>e',s\<^sub>1\<rangle> \<Longrightarrow> P \<turnstile>\<^sub>1 \<langle>Block i T e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>e',s\<^sub>1\<rangle>"

| Seq\<^sub>1:
  "\<lbrakk> P \<turnstile>\<^sub>1 \<langle>e\<^sub>0,s\<^sub>0\<rangle> \<Rightarrow> \<langle>Val v,s\<^sub>1\<rangle>; P \<turnstile>\<^sub>1 \<langle>e\<^sub>1,s\<^sub>1\<rangle> \<Rightarrow> \<langle>e\<^sub>2,s\<^sub>2\<rangle> \<rbrakk>
  \<Longrightarrow> P \<turnstile>\<^sub>1 \<langle>e\<^sub>0;;e\<^sub>1,s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2,s\<^sub>2\<rangle>"
| SeqThrow\<^sub>1:
  "P \<turnstile>\<^sub>1 \<langle>e\<^sub>0,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw e,s\<^sub>1\<rangle> \<Longrightarrow>
  P \<turnstile>\<^sub>1 \<langle>e\<^sub>0;;e\<^sub>1,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw e,s\<^sub>1\<rangle>"

| CondT\<^sub>1:
  "\<lbrakk> P \<turnstile>\<^sub>1 \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>true,s\<^sub>1\<rangle>; P \<turnstile>\<^sub>1 \<langle>e\<^sub>1,s\<^sub>1\<rangle> \<Rightarrow> \<langle>e',s\<^sub>2\<rangle> \<rbrakk>
  \<Longrightarrow> P \<turnstile>\<^sub>1 \<langle>if (e) e\<^sub>1 else e\<^sub>2,s\<^sub>0\<rangle> \<Rightarrow> \<langle>e',s\<^sub>2\<rangle>"
| CondF\<^sub>1:
  "\<lbrakk> P \<turnstile>\<^sub>1 \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>false,s\<^sub>1\<rangle>; P \<turnstile>\<^sub>1 \<langle>e\<^sub>2,s\<^sub>1\<rangle> \<Rightarrow> \<langle>e',s\<^sub>2\<rangle> \<rbrakk>
  \<Longrightarrow> P \<turnstile>\<^sub>1 \<langle>if (e) e\<^sub>1 else e\<^sub>2,s\<^sub>0\<rangle> \<Rightarrow> \<langle>e',s\<^sub>2\<rangle>"
| CondThrow\<^sub>1:
  "P \<turnstile>\<^sub>1 \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw e',s\<^sub>1\<rangle> \<Longrightarrow>
  P \<turnstile>\<^sub>1 \<langle>if (e) e\<^sub>1 else e\<^sub>2, s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw e',s\<^sub>1\<rangle>"

| WhileF\<^sub>1:
  "P \<turnstile>\<^sub>1 \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>false,s\<^sub>1\<rangle> \<Longrightarrow>
  P \<turnstile>\<^sub>1 \<langle>while (e) c,s\<^sub>0\<rangle> \<Rightarrow> \<langle>unit,s\<^sub>1\<rangle>"
| WhileT\<^sub>1:
  "\<lbrakk> P \<turnstile>\<^sub>1 \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>true,s\<^sub>1\<rangle>; P \<turnstile>\<^sub>1 \<langle>c,s\<^sub>1\<rangle> \<Rightarrow> \<langle>Val v\<^sub>1,s\<^sub>2\<rangle>;
    P \<turnstile>\<^sub>1 \<langle>while (e) c,s\<^sub>2\<rangle> \<Rightarrow> \<langle>e\<^sub>3,s\<^sub>3\<rangle> \<rbrakk>
  \<Longrightarrow> P \<turnstile>\<^sub>1 \<langle>while (e) c,s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>3,s\<^sub>3\<rangle>"
| WhileCondThrow\<^sub>1:
  "P \<turnstile>\<^sub>1 \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw e',s\<^sub>1\<rangle> \<Longrightarrow>
  P \<turnstile>\<^sub>1 \<langle>while (e) c,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw e',s\<^sub>1\<rangle>"
| WhileBodyThrow\<^sub>1:
  "\<lbrakk> P \<turnstile>\<^sub>1 \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>true,s\<^sub>1\<rangle>; P \<turnstile>\<^sub>1 \<langle>c,s\<^sub>1\<rangle> \<Rightarrow> \<langle>throw e',s\<^sub>2\<rangle>\<rbrakk>
  \<Longrightarrow> P \<turnstile>\<^sub>1 \<langle>while (e) c,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw e',s\<^sub>2\<rangle>"

| Throw\<^sub>1:
  "P \<turnstile>\<^sub>1 \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>addr a,s\<^sub>1\<rangle> \<Longrightarrow>
  P \<turnstile>\<^sub>1 \<langle>throw e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>Throw a,s\<^sub>1\<rangle>"
| ThrowNull\<^sub>1:
  "P \<turnstile>\<^sub>1 \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>null,s\<^sub>1\<rangle> \<Longrightarrow>
  P \<turnstile>\<^sub>1 \<langle>throw e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>THROW NullPointer,s\<^sub>1\<rangle>"
| ThrowThrow\<^sub>1:
  "P \<turnstile>\<^sub>1 \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw e',s\<^sub>1\<rangle> \<Longrightarrow>
  P \<turnstile>\<^sub>1 \<langle>throw e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw e',s\<^sub>1\<rangle>"

| Try\<^sub>1:
  "P \<turnstile>\<^sub>1 \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<Rightarrow> \<langle>Val v\<^sub>1,s\<^sub>1\<rangle> \<Longrightarrow>
  P \<turnstile>\<^sub>1 \<langle>try e\<^sub>1 catch(C i) e\<^sub>2,s\<^sub>0\<rangle> \<Rightarrow> \<langle>Val v\<^sub>1,s\<^sub>1\<rangle>"
| TryCatch\<^sub>1:
  "\<lbrakk> P \<turnstile>\<^sub>1 \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<Rightarrow> \<langle>Throw a,(h\<^sub>1,ls\<^sub>1,sh\<^sub>1)\<rangle>;
    h\<^sub>1 a = Some(D,fs); P \<turnstile> D \<preceq>\<^sup>* C; i < length ls\<^sub>1;
    P \<turnstile>\<^sub>1 \<langle>e\<^sub>2,(h\<^sub>1,ls\<^sub>1[i:=Addr a],sh\<^sub>1)\<rangle> \<Rightarrow> \<langle>e\<^sub>2',(h\<^sub>2,ls\<^sub>2,sh\<^sub>2)\<rangle> \<rbrakk>
  \<Longrightarrow> P \<turnstile>\<^sub>1 \<langle>try e\<^sub>1 catch(C i) e\<^sub>2,s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2',(h\<^sub>2,ls\<^sub>2,sh\<^sub>2)\<rangle>"
| TryThrow\<^sub>1:
  "\<lbrakk> P \<turnstile>\<^sub>1 \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<Rightarrow> \<langle>Throw a,(h\<^sub>1,ls\<^sub>1,sh\<^sub>1)\<rangle>; h\<^sub>1 a = Some(D,fs); \<not> P \<turnstile> D \<preceq>\<^sup>* C \<rbrakk>
  \<Longrightarrow> P \<turnstile>\<^sub>1 \<langle>try e\<^sub>1 catch(C i) e\<^sub>2,s\<^sub>0\<rangle> \<Rightarrow> \<langle>Throw a,(h\<^sub>1,ls\<^sub>1,sh\<^sub>1)\<rangle>"

| Nil\<^sub>1:
  "P \<turnstile>\<^sub>1 \<langle>[],s\<rangle> [\<Rightarrow>] \<langle>[],s\<rangle>"

| Cons\<^sub>1:
  "\<lbrakk> P \<turnstile>\<^sub>1 \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>Val v,s\<^sub>1\<rangle>; P \<turnstile>\<^sub>1 \<langle>es,s\<^sub>1\<rangle> [\<Rightarrow>] \<langle>es',s\<^sub>2\<rangle> \<rbrakk>
  \<Longrightarrow> P \<turnstile>\<^sub>1 \<langle>e#es,s\<^sub>0\<rangle> [\<Rightarrow>] \<langle>Val v # es',s\<^sub>2\<rangle>"
| ConsThrow\<^sub>1:
  "P \<turnstile>\<^sub>1 \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw e',s\<^sub>1\<rangle> \<Longrightarrow>
  P \<turnstile>\<^sub>1 \<langle>e#es,s\<^sub>0\<rangle> [\<Rightarrow>] \<langle>throw e' # es, s\<^sub>1\<rangle>"

\<comment> \<open> init rules \<close>

| InitFinal\<^sub>1:
  "P \<turnstile>\<^sub>1 \<langle>e,s\<rangle> \<Rightarrow> \<langle>e',s'\<rangle> \<Longrightarrow> P \<turnstile>\<^sub>1 \<langle>INIT C (Nil,b) \<leftarrow> e,s\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>"
| InitNone\<^sub>1:
  "\<lbrakk> sh C = None; P \<turnstile>\<^sub>1 \<langle>INIT C' (C#Cs,False) \<leftarrow> e,(h,l,sh(C \<mapsto> (sblank P C, Prepared)))\<rangle> \<Rightarrow> \<langle>e',s'\<rangle> \<rbrakk>
  \<Longrightarrow> P \<turnstile>\<^sub>1 \<langle>INIT C' (C#Cs,False) \<leftarrow> e,(h,l,sh)\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>"
| InitDone\<^sub>1:
  "\<lbrakk> sh C = Some(sfs,Done); P \<turnstile>\<^sub>1 \<langle>INIT C' (Cs,True) \<leftarrow> e,(h,l,sh)\<rangle> \<Rightarrow> \<langle>e',s'\<rangle> \<rbrakk>
  \<Longrightarrow> P \<turnstile>\<^sub>1 \<langle>INIT C' (C#Cs,False) \<leftarrow> e,(h,l,sh)\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>"
| InitProcessing\<^sub>1:
  "\<lbrakk> sh C = Some(sfs,Processing); P \<turnstile>\<^sub>1 \<langle>INIT C' (Cs,True) \<leftarrow> e,(h,l,sh)\<rangle> \<Rightarrow> \<langle>e',s'\<rangle> \<rbrakk>
  \<Longrightarrow> P \<turnstile>\<^sub>1 \<langle>INIT C' (C#Cs,False) \<leftarrow> e,(h,l,sh)\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>"
| InitError\<^sub>1:
  "\<lbrakk> sh C = Some(sfs,Error);
     P \<turnstile>\<^sub>1 \<langle>RI (C, THROW NoClassDefFoundError);Cs \<leftarrow> e,(h,l,sh)\<rangle> \<Rightarrow> \<langle>e',s'\<rangle> \<rbrakk>
  \<Longrightarrow> P \<turnstile>\<^sub>1 \<langle>INIT C' (C#Cs,False) \<leftarrow> e,(h,l,sh)\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>"
| InitObject\<^sub>1:
  "\<lbrakk> sh C = Some(sfs,Prepared);
     C = Object;
     sh' = sh(C \<mapsto> (sfs,Processing));
     P \<turnstile>\<^sub>1 \<langle>INIT C' (C#Cs,True) \<leftarrow> e,(h,l,sh')\<rangle> \<Rightarrow> \<langle>e',s'\<rangle> \<rbrakk>
  \<Longrightarrow> P \<turnstile>\<^sub>1 \<langle>INIT C' (C#Cs,False) \<leftarrow> e,(h,l,sh)\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>"
| InitNonObject\<^sub>1:
  "\<lbrakk> sh C = Some(sfs,Prepared);
     C \<noteq> Object;
     class P C = Some (D,r);
     sh' = sh(C \<mapsto> (sfs,Processing));
     P \<turnstile>\<^sub>1 \<langle>INIT C' (D#C#Cs,False) \<leftarrow> e,(h,l,sh')\<rangle> \<Rightarrow> \<langle>e',s'\<rangle> \<rbrakk>
  \<Longrightarrow> P \<turnstile>\<^sub>1 \<langle>INIT C' (C#Cs,False) \<leftarrow> e,(h,l,sh)\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>"
| InitRInit\<^sub>1:
  "P \<turnstile>\<^sub>1 \<langle>RI (C,C\<bullet>\<^sub>sclinit([]));Cs \<leftarrow> e,(h,l,sh)\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>
  \<Longrightarrow> P \<turnstile>\<^sub>1 \<langle>INIT C' (C#Cs,True) \<leftarrow> e,(h,l,sh)\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>"

| RInit\<^sub>1:
  "\<lbrakk> P \<turnstile>\<^sub>1 \<langle>e,s\<rangle> \<Rightarrow> \<langle>Val v, (h',l',sh')\<rangle>;
     sh' C = Some(sfs, i); sh'' = sh'(C \<mapsto> (sfs, Done));
     C' = last(C#Cs);
     P \<turnstile>\<^sub>1 \<langle>INIT C' (Cs,True) \<leftarrow> e', (h',l',sh'')\<rangle> \<Rightarrow> \<langle>e\<^sub>1,s\<^sub>1\<rangle> \<rbrakk>
  \<Longrightarrow> P \<turnstile>\<^sub>1 \<langle>RI (C,e);Cs \<leftarrow> e',s\<rangle> \<Rightarrow> \<langle>e\<^sub>1,s\<^sub>1\<rangle>"
| RInitInitFail\<^sub>1:
  "\<lbrakk> P \<turnstile>\<^sub>1 \<langle>e,s\<rangle> \<Rightarrow> \<langle>throw a, (h',l',sh')\<rangle>;
     sh' C = Some(sfs, i); sh'' = sh'(C \<mapsto> (sfs, Error));
     P \<turnstile>\<^sub>1 \<langle>RI (D,throw a);Cs \<leftarrow> e', (h',l',sh'')\<rangle> \<Rightarrow> \<langle>e\<^sub>1,s\<^sub>1\<rangle> \<rbrakk>
  \<Longrightarrow> P \<turnstile>\<^sub>1 \<langle>RI (C,e);D#Cs \<leftarrow> e',s\<rangle> \<Rightarrow> \<langle>e\<^sub>1,s\<^sub>1\<rangle>"
| RInitFailFinal\<^sub>1:
  "\<lbrakk> P \<turnstile>\<^sub>1 \<langle>e,s\<rangle> \<Rightarrow> \<langle>throw a, (h',l',sh')\<rangle>;
     sh' C = Some(sfs, i); sh'' = sh'(C \<mapsto> (sfs, Error)) \<rbrakk>
  \<Longrightarrow> P \<turnstile>\<^sub>1 \<langle>RI (C,e);Nil \<leftarrow> e',s\<rangle> \<Rightarrow> \<langle>throw a, (h',l',sh'')\<rangle>"

(*<*)
lemmas eval\<^sub>1_evals\<^sub>1_induct = eval\<^sub>1_evals\<^sub>1.induct [split_format (complete)]
  and eval\<^sub>1_evals\<^sub>1_inducts = eval\<^sub>1_evals\<^sub>1.inducts [split_format (complete)]
(*>*)

inductive_cases eval\<^sub>1_cases [cases set]:
 "P \<turnstile>\<^sub>1 \<langle>new C,s\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>"
 "P \<turnstile>\<^sub>1 \<langle>Cast C e,s\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>"
 "P \<turnstile>\<^sub>1 \<langle>Val v,s\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>"
 "P \<turnstile>\<^sub>1 \<langle>e\<^sub>1 \<guillemotleft>bop\<guillemotright> e\<^sub>2,s\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>"
 "P \<turnstile>\<^sub>1 \<langle>Var v,s\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>"
 "P \<turnstile>\<^sub>1 \<langle>V:=e,s\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>"
 "P \<turnstile>\<^sub>1 \<langle>e\<bullet>F{D},s\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>"
 "P \<turnstile>\<^sub>1 \<langle>C\<bullet>\<^sub>sF{D},s\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>"
 "P \<turnstile>\<^sub>1 \<langle>e\<^sub>1\<bullet>F{D}:=e\<^sub>2,s\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>"
 "P \<turnstile>\<^sub>1 \<langle>C\<bullet>\<^sub>sF{D}:=e\<^sub>2,s\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>"
 "P \<turnstile>\<^sub>1 \<langle>e\<bullet>M(es),s\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>"
 "P \<turnstile>\<^sub>1 \<langle>C\<bullet>\<^sub>sM(es),s\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>"
 "P \<turnstile>\<^sub>1 \<langle>{V:T;e\<^sub>1},s\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>"
 "P \<turnstile>\<^sub>1 \<langle>e\<^sub>1;;e\<^sub>2,s\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>"
 "P \<turnstile>\<^sub>1 \<langle>if (e) e\<^sub>1 else e\<^sub>2,s\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>"
 "P \<turnstile>\<^sub>1 \<langle>while (b) c,s\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>"
 "P \<turnstile>\<^sub>1 \<langle>throw e,s\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>"
 "P \<turnstile>\<^sub>1 \<langle>try e\<^sub>1 catch(C V) e\<^sub>2,s\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>"
 "P \<turnstile>\<^sub>1 \<langle>INIT C (Cs,b) \<leftarrow> e,s\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>"
 "P \<turnstile>\<^sub>1 \<langle>RI (C,e);Cs \<leftarrow> e\<^sub>0,s\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>"

inductive_cases evals\<^sub>1_cases [cases set]:
 "P \<turnstile>\<^sub>1 \<langle>[],s\<rangle> [\<Rightarrow>] \<langle>e',s'\<rangle>"
 "P \<turnstile>\<^sub>1 \<langle>e#es,s\<rangle> [\<Rightarrow>] \<langle>e',s'\<rangle>"
(*>*)

lemma eval\<^sub>1_final: "P \<turnstile>\<^sub>1 \<langle>e,s\<rangle> \<Rightarrow> \<langle>e',s'\<rangle> \<Longrightarrow> final e'"
 and evals\<^sub>1_final: "P \<turnstile>\<^sub>1 \<langle>es,s\<rangle> [\<Rightarrow>] \<langle>es',s'\<rangle> \<Longrightarrow> finals es'"
(*<*)by(induct rule:eval\<^sub>1_evals\<^sub>1.inducts, simp_all)(*>*)

lemma eval\<^sub>1_final_same:
assumes eval: "P \<turnstile>\<^sub>1 \<langle>e,s\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>" shows "final e \<Longrightarrow> e = e' \<and> s = s'"
(*<*)
proof(erule finalE)
  fix v assume Val: "e = Val v"
  then show ?thesis using eval eval\<^sub>1_cases(3) by blast
next
  fix a assume "e = Throw a"
  then show ?thesis using eval
    by (metis eval\<^sub>1_cases(3,17) exp.distinct(101) exp.inject(3) val.distinct(13))
qed
(*>*)

subsection "Property preservation"

lemma eval\<^sub>1_preserves_len:
  "P \<turnstile>\<^sub>1 \<langle>e\<^sub>0,(h\<^sub>0,ls\<^sub>0,sh\<^sub>0)\<rangle> \<Rightarrow> \<langle>e\<^sub>1,(h\<^sub>1,ls\<^sub>1,sh\<^sub>1)\<rangle> \<Longrightarrow> length ls\<^sub>0 = length ls\<^sub>1"
and evals\<^sub>1_preserves_len:
  "P \<turnstile>\<^sub>1 \<langle>es\<^sub>0,(h\<^sub>0,ls\<^sub>0,sh\<^sub>0)\<rangle> [\<Rightarrow>] \<langle>es\<^sub>1,(h\<^sub>1,ls\<^sub>1,sh\<^sub>1)\<rangle> \<Longrightarrow> length ls\<^sub>0 = length ls\<^sub>1"
(*<*)by (induct rule:eval\<^sub>1_evals\<^sub>1_inducts, simp_all)(*>*)

lemma evals\<^sub>1_preserves_elen:
  "\<And>es' s s'. P \<turnstile>\<^sub>1 \<langle>es,s\<rangle> [\<Rightarrow>] \<langle>es',s'\<rangle> \<Longrightarrow> length es = length es'"
(*<*)by(induct es type:list) (auto elim:evals\<^sub>1.cases)(*>*)

lemma clinit\<^sub>1_loc_pres:
 "P \<turnstile>\<^sub>1 \<langle>C\<^sub>0\<bullet>\<^sub>sclinit([]),(h,l,sh)\<rangle> \<Rightarrow> \<langle>e',(h',l',sh')\<rangle> \<Longrightarrow> l = l'"
 by(auto elim!: eval\<^sub>1_cases(12) evals\<^sub>1_cases(1))

lemma
shows init\<^sub>1_ri\<^sub>1_same_loc: "P \<turnstile>\<^sub>1 \<langle>e,(h,l,sh)\<rangle> \<Rightarrow> \<langle>e',(h',l',sh')\<rangle>
   \<Longrightarrow> (\<And>C Cs b M a. e = INIT C (Cs,b) \<leftarrow> unit \<or> e = C\<bullet>\<^sub>sM([]) \<or> e = RI (C,Throw a) ; Cs \<leftarrow> unit
          \<or> e = RI (C,C\<bullet>\<^sub>sclinit([])) ; Cs \<leftarrow> unit
           \<Longrightarrow> l = l')"
  and "P \<turnstile>\<^sub>1 \<langle>es,(h,l,sh)\<rangle> [\<Rightarrow>] \<langle>es',(h',l',sh')\<rangle> \<Longrightarrow> True"
proof(induct rule: eval\<^sub>1_evals\<^sub>1_inducts)
  case (RInitInitFail\<^sub>1 e h l sh a')
  then show ?case using eval\<^sub>1_final[of _ _ _ "throw a'"]
     by(fastforce dest: eval\<^sub>1_final_same[of _ "Throw a"])
next
  case RInitFailFinal\<^sub>1 then show ?case by(auto dest: eval\<^sub>1_final_same)
qed(auto dest: evals\<^sub>1_cases eval\<^sub>1_cases(17) eval\<^sub>1_final_same)

lemma init\<^sub>1_same_loc: "P \<turnstile>\<^sub>1 \<langle>INIT C (Cs,b) \<leftarrow> unit,(h,l,sh)\<rangle> \<Rightarrow> \<langle>e',(h',l',sh')\<rangle> \<Longrightarrow> l = l'"
 by(simp add: init\<^sub>1_ri\<^sub>1_same_loc)

theorem eval\<^sub>1_hext: "P \<turnstile>\<^sub>1 \<langle>e,(h,l,sh)\<rangle> \<Rightarrow> \<langle>e',(h',l',sh')\<rangle> \<Longrightarrow> h \<unlhd> h'"
and evals\<^sub>1_hext:  "P \<turnstile>\<^sub>1 \<langle>es,(h,l,sh)\<rangle> [\<Rightarrow>] \<langle>es',(h',l',sh')\<rangle> \<Longrightarrow> h \<unlhd> h'"
(*<*)
proof (induct rule: eval\<^sub>1_evals\<^sub>1_inducts)
  case New\<^sub>1 thus ?case
    by(fastforce intro!: hext_new intro:LeastI simp:new_Addr_def
                split:if_split_asm simp del:fun_upd_apply)
next
  case NewInit\<^sub>1 thus ?case
    by (meson hext_new hext_trans new_Addr_SomeD)
next
  case FAss\<^sub>1 thus ?case
    by(auto simp:sym[THEN hext_upd_obj] simp del:fun_upd_apply
            elim!: hext_trans)
qed (auto elim!: hext_trans)
(*>*)

subsection "Initialization"

lemma rinit\<^sub>1_throw:
 "P\<^sub>1 \<turnstile>\<^sub>1 \<langle>RI (D,Throw xa) ; Cs \<leftarrow> e,(h, l, sh)\<rangle> \<Rightarrow> \<langle>e',(h', l', sh')\<rangle>
    \<Longrightarrow> e' = Throw xa"
proof(induct Cs arbitrary: D h l sh h' l' sh')
  case Nil then show ?case
  proof(rule eval\<^sub>1_cases(20)) qed(auto elim: eval\<^sub>1_cases)
next
  case (Cons C Cs) show ?case using Cons.prems
  proof(induct rule: eval\<^sub>1_cases(20))
    case RInit\<^sub>1: 1
    then show ?case using Cons.hyps by(auto elim: eval\<^sub>1_cases)
  next
    case RInitInitFail\<^sub>1: 2
    then show ?case using Cons.hyps eval\<^sub>1_final_same final_def by blast
  next
    case RInitFailFinal\<^sub>1: 3 then show ?case by simp
  qed
qed

lemma rinit\<^sub>1_throwE:
"P \<turnstile>\<^sub>1 \<langle>RI (C,throw e) ; Cs \<leftarrow> e\<^sub>0,s\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>
   \<Longrightarrow> \<exists>a s\<^sub>t. e' = throw a \<and> P \<turnstile>\<^sub>1 \<langle>throw e,s\<rangle> \<Rightarrow> \<langle>throw a,s\<^sub>t\<rangle>"
proof(induct Cs arbitrary: C e s)
  case Nil
  then show ?case
  proof(rule eval\<^sub>1_cases(20)) \<comment> \<open> RI \<close>
    fix v h' l' sh' assume "P \<turnstile>\<^sub>1 \<langle>throw e,s\<rangle> \<Rightarrow> \<langle>Val v,(h', l', sh')\<rangle>"
    then show ?case using eval\<^sub>1_cases(17) by blast
  qed(auto)
next
  case (Cons C' Cs')
  show ?case using Cons.prems(1)
  proof(rule eval\<^sub>1_cases(20)) \<comment> \<open> RI \<close>
    fix v h' l' sh' assume "P \<turnstile>\<^sub>1 \<langle>throw e,s\<rangle> \<Rightarrow> \<langle>Val v,(h', l', sh')\<rangle>"
    then show ?case using eval\<^sub>1_cases(17) by blast
  next
    fix a h' l' sh' sfs i D Cs''
    assume e''step: "P \<turnstile>\<^sub>1 \<langle>throw e,s\<rangle> \<Rightarrow> \<langle>throw a,(h', l', sh')\<rangle>"
       and shC: "sh' C = \<lfloor>(sfs, i)\<rfloor>"
       and riD: "P \<turnstile>\<^sub>1 \<langle>RI (D,throw a) ; Cs'' \<leftarrow> e\<^sub>0,(h', l', sh'(C \<mapsto> (sfs, Error)))\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>"
       and "C' # Cs' = D # Cs''"
    then show ?thesis using Cons.hyps eval\<^sub>1_final eval\<^sub>1_final_same by blast
  qed(simp)
qed

end


theory Pid_Scheduler
imports Gen_Scheduler_Refine Partial_Order_Reduction.Transition_System_Extensions
begin

  lemma system_complete_language_eq_lsystem_accept:
    fixes ex en init int
    defines "S \<equiv> \<lparr> g_V = UNIV, g_E = rel_of_enex (en, ex), g_V0 = {init}, sa_L = int \<rparr>"
    assumes "sa S"
    shows "snth ` transition_system_complete.language ex (\<lambda> a p. a \<in> en p) (\<lambda> p. p = init) int = {w. sa.accept S w}"
  proof -
    interpret jsys?: transition_system_complete ex "\<lambda> a p. a \<in> en p" "\<lambda> p. p = init" int by this
    interpret psys?: sa S by fact
    show ?thesis
    unfolding jsys.language_def
    unfolding psys.accept_def
    proof safe
      fix p w
      assume 1: "run w init"
      show "\<exists> r. is_run r \<and> snth (smap int (init ## trace w init)) = L \<circ> r"
      unfolding is_run_def ipath_def
      unfolding S_def graph_rec.simps sa_rec.simps
      unfolding rel_of_enex_def Let_def prod.case
      proof (intro allI exI conjI)
        fix i
        show "(init ## trace w init) !! 0 \<in> {init}" by simp
        show "snth (smap int (init ## trace w init)) = int \<circ> snth (init ## trace w init)"
          by (metis (full_types) fun_comp_eq_conv smap_alt)
        have 10: "w = stake i w @- [w !! i] @- sdrop (Suc i) w" using id_stake_snth_sdrop by auto
        have 20: "run (stake i w @- [w !! i] @- sdrop (Suc i) w) init" using 1 10 by simp
        have 1: "w !! i \<in> en (target (stake i w) init)" using 20 by auto
        have 2: "ex (w !! i) (target (stake i w) init) = target (stake (Suc i) w) init"
          using 20 unfolding stake_Suc by auto
        show "((init ## trace w init) !! i, (init ## trace w init) !! Suc i) \<in>
          {(s, ex a s) |s a. a \<in> en s}" using 1 2 by force
      qed
    next
      fix r
      assume 1: "is_run r"
      obtain w where 2: "r 0 = init" "\<And> i. w i \<in> en (r i)" "\<And> i. r (Suc i) = ex (w i) (r i)"
        using 1
        unfolding is_run_def ipath_def
        unfolding S_def graph_rec.simps
        unfolding rel_of_enex_def Let_def prod.case
        by simp metis
      have 3: "L \<circ> r = snth (smap int (smap r nats))" unfolding assms(1) by auto
      have 4: "(init ## trace (smap w nats) init) !! i = smap r nats !! i" for i
        using 2 by (induct i) (auto)
      have 5: "smap r nats = init ## trace (smap w nats) init" using eqI_snth 4 by metis
      have 6: "target (stake k (smap w nats)) init = smap r nats !! k" for k
        unfolding sscan_scons_snth 5 by rule
      have 7: "run (smap w nats) init" using 2(2) 6 by (auto intro: snth_run)
      show "L \<circ> r \<in> (!!) ` {smap int (p ## trace w p) |p w. p = init \<and> run w p}"
        unfolding 3 using 5 7 by force
    qed
  qed

  (* TODO: Move *)
  lemma prod_splitE:
    assumes "\<forall>a b. p=(a,b) \<longrightarrow> P a b"
    obtains a b where "p=(a,b)" "P a b"
    using assms
    by (cases p) auto

  lemma sngp_sym_conv: "(\<lambda>p. p=x) = (=) x" by auto

  lemma in_multiset_of_conv_nth: "x \<in># mset l \<longleftrightarrow> (\<exists>i<length l. x = l!i)"
    by (metis in_multiset_in_set in_set_conv_nth)

  lemma multiset_of_em_conv_nth: "mset l = {#x#} + m'
    \<longleftrightarrow> (\<exists>i<length l. x = l!i \<and> m' = mset l - {#x#})"
    by (metis add_diff_cancel_left' in_multiset_of_conv_nth
      insert_DiffM multi_member_this)

  type_synonym pid = nat
  record ('c,'ls,'gs) pid_global_config =
    processes :: "('c,'ls) local_config list"
    state :: 'gs

  definition pidgc_\<alpha>
    :: "('c,'ls,'gs) pid_global_config \<Rightarrow> ('c,'ls,'gs) global_config" where
    "pidgc_\<alpha> pgc \<equiv> \<lparr>
      global_config.processes = mset (pid_global_config.processes pgc),
      global_config.state = pid_global_config.state pgc
    \<rparr>"

  abbreviation pid_valid :: "('c,'ls,'gs) pid_global_config \<Rightarrow> pid \<Rightarrow> bool"
    where
    "pid_valid gc pid \<equiv> pid < length (pid_global_config.processes gc)"

  abbreviation "lc_of_pid gc pid
    \<equiv> pid_global_config.processes gc ! pid"

  abbreviation "cmd_of_pid gc pid
    \<equiv> local_config.command (lc_of_pid gc pid)"

  abbreviation "ls_of_pid gc pid
    \<equiv> local_config.state (lc_of_pid gc pid)"

  context Gen_Scheduler'
  begin

    definition pid_gstep_succ
      :: "('c,'ls,'gs) pid_global_config \<Rightarrow> ('c,'ls,'gs) pid_global_config set"
      where
      "pid_gstep_succ gc \<equiv> do {
        \<comment> \<open> Select process \<close>
        let lcs = pid_global_config.processes gc;
        pid \<leftarrow> {0..<length lcs};
        let lc = lcs!pid;
        \<comment> \<open> Focus state \<close>
        let gs = pid_global_config.state gc;
        let ls = local_config.state lc;

        \<comment> \<open> Select action \<close>
        let cmd = local_config.command lc;
        (a,cmd') \<leftarrow> {(a,cmd'). cstep cmd a cmd'};

        if en (ls,gs) a then {do {
          \<comment> \<open> Execute \<close>
          let (ls,gs) = ex (ls,gs) a;
          \<comment> \<open> Unfocus state. \<close>
          let lc = \<lparr> local_config.command = cmd', local_config.state = ls\<rparr>;
          \<lparr>
            pid_global_config.processes = lcs[pid:=lc],
            pid_global_config.state = gs
          \<rparr>
        }}
      else {}
    }"

    lemma pid_gstep_succE:
      assumes "gc' \<in> pid_gstep_succ gc"
      obtains pid a c' ls' gs' where
        "pid_valid gc pid"
        "cstep (cmd_of_pid gc pid) a c'"
        "en (ls_of_pid gc pid, pid_global_config.state gc) a"
        "ex (ls_of_pid gc pid, pid_global_config.state gc) a = (ls',gs')"
        "gc' = \<lparr>
          pid_global_config.processes = (pid_global_config.processes gc)
            [pid :=
              \<lparr> local_config.command = c', local_config.state = ls'\<rparr>
            ],
          pid_global_config.state = gs'\<rparr>"
      using assms
      unfolding pid_gstep_succ_def
      by (auto
        split: if_split_asm prod.splits
        elim!: prod_splitE
        simp: all_conj_distrib)

  lemma pid_gstep_succI:
    assumes
      "pid_valid gc pid"
      "cstep (cmd_of_pid gc pid) a c'"
      "en (ls_of_pid gc pid, pid_global_config.state gc) a"
      "ex (ls_of_pid gc pid, pid_global_config.state gc) a = (ls',gs')"
    shows "
      \<lparr>
        pid_global_config.processes = (pid_global_config.processes gc)
          [pid :=
            \<lparr> local_config.command = c', local_config.state = ls'\<rparr>
          ],
        pid_global_config.state = gs'
      \<rparr> \<in> pid_gstep_succ gc"
    using assms
    unfolding pid_gstep_succ_def
    by fastforce

  lemma pid_gc_state_eq:
    "pid_global_config.state pgc = global_config.state (pidgc_\<alpha> pgc)"
    unfolding pidgc_\<alpha>_def by auto

  lemma pid_gc_proc_eq:
    assumes "pid_valid gc pid"
    shows "
      global_config.processes (pidgc_\<alpha> gc)
      = {#lc_of_pid gc pid#}
      + (global_config.processes (pidgc_\<alpha> gc) - {#lc_of_pid gc pid#})"
    using assms
    by (auto simp: pidgc_\<alpha>_def multiset_of_em_conv_nth)

  lemma pid_gstep_correct:
    "gstep_succ (pidgc_\<alpha> pgc) = pidgc_\<alpha>`pid_gstep_succ pgc"
    apply safe
    apply (erule gstep_succE)
    apply (clarsimp simp: pidgc_\<alpha>_def multiset_of_em_conv_nth)
    apply (frule (3) pid_gstep_succI)
    apply (erule image_eqI[rotated])
    apply (auto simp: pidgc_\<alpha>_def mset_update add_ac union_mset_add_mset_right) []

    apply (erule pid_gstep_succE)
    apply (clarsimp simp: pidgc_\<alpha>_def mset_update)
    apply (simp add: pid_gc_state_eq)
    apply (frule (2) gstep_succI[rotated])
    apply (rule pid_gc_proc_eq, assumption)
    apply (auto simp: add_ac pidgc_\<alpha>_def union_mset_add_mset_left) []
    done

  abbreviation "pid_gstep \<equiv> rel_of_succ pid_gstep_succ"
  definition "pid_step \<equiv> stutter_extend_edges UNIV pid_gstep"

end

locale Pid_Gen_Scheduler_linit =
  Gen_Scheduler'_linit cstep en ex init label
  for cstep :: "'c \<Rightarrow> 'a \<Rightarrow> 'c \<Rightarrow> bool"
  and en :: "('ls\<times>'gs) \<Rightarrow> 'a \<Rightarrow> bool"
  and ex :: "('ls\<times>'gs) \<Rightarrow> 'a \<Rightarrow> ('ls\<times>'gs)"
  and init :: "('c,'ls,'gs) global_config set"
  and label :: "('c,'ls,'gs) global_config \<Rightarrow> 'l" +
  fixes pid_init :: "('c,'ls,'gs) pid_global_config"
  and pid_label :: "('c,'ls,'gs) pid_global_config \<Rightarrow> 'l"
  assumes pid_init_eq: "gc \<in> init \<longleftrightarrow> (gc=pidgc_\<alpha> pid_init)"
  assumes pid_label_eq: "label (pidgc_\<alpha> pgc) = pid_label pgc"
begin

  definition pid_system_automaton' :: "(('c,'ls,'gs) pid_global_config, 'l) sa_rec"
    where "pid_system_automaton' \<equiv>
      \<lparr> g_V = UNIV, g_E = pid_gstep, g_V0 = {pid_init}, sa_L = pid_label \<rparr>"

  lemma pid_system_automaton'_simps[simp]:
    "g_V pid_system_automaton' = UNIV"
    "g_E pid_system_automaton' = pid_gstep"
    "g_V0 pid_system_automaton' = {pid_init}"
    "sa_L pid_system_automaton' = pid_label"
    unfolding pid_system_automaton'_def by auto

  definition pid_system_automaton :: "(('c,'ls,'gs) pid_global_config, 'l) sa_rec"
    where "pid_system_automaton \<equiv>
      \<lparr> g_V = UNIV, g_E = pid_step, g_V0 = {pid_init}, sa_L = pid_label \<rparr>"

  lemma pid_system_automaton_simps[simp]:
    "g_V pid_system_automaton = UNIV"
    "g_E pid_system_automaton = pid_step"
    "g_V0 pid_system_automaton = {pid_init}"
    "sa_L pid_system_automaton = pid_label"
    unfolding pid_system_automaton_def by auto

  lemma pid_system_automaton_alt_def: "pid_system_automaton = stutter_extend pid_system_automaton'"
    unfolding pid_step_def pid_system_automaton'_def pid_system_automaton_def stutter_extend_def
    by simp

  sublocale pid': sa pid_system_automaton' by unfold_locales auto
  sublocale pid: sa pid_system_automaton
    unfolding pid_system_automaton_alt_def using pid'.stutter_extend_sa by this

  sublocale bisim: lbisimulation "br pidgc_\<alpha> (\<lambda>_. True)" pid_system_automaton system_automaton
  proof -
    interpret bisim: lbisimulation "br pidgc_\<alpha> (\<lambda>_. True)" pid_system_automaton' system_automaton'
      apply unfold_locales
      apply (auto simp: build_rel_def pid_init_eq pid_gstep_correct pid_label_eq)
      done
    interpret bisim: lbisimulation "br pidgc_\<alpha> (\<lambda>_. True)" pid_system_automaton system_automaton
      unfolding system_automaton_alt_def pid_system_automaton_alt_def
      using bisim.lstutter_extend by this
    show "lbisimulation (br pidgc_\<alpha> (\<lambda> _. True)) pid_system_automaton system_automaton"
      by unfold_locales
  qed

  lemma pid_accept_eq: "pid.accept = sa.accept" by (rule bisim.accept_bisim)

  lemma pid_run_conv: "sa.g.is_run r \<longleftrightarrow> (\<exists>r'. r=pidgc_\<alpha> o r' \<and> pid.g.is_run r')"
    by (rule bisim.br_run_conv[OF refl])

  lemma pid_run_sim: "pid.g.is_run r \<Longrightarrow> sa.g.is_run (pidgc_\<alpha> o r)"
    by (rule bisim.s1.br_run_sim[OF refl])

section "Global Actions"

text \<open>
  A global action consists of a PID and a control flow graph edge
\<close>
type_synonym (in -) ('c,'a) global_action = "pid \<times> 'c \<times> 'a \<times> 'c"

abbreviation (in -) "fs_of_pid gc pid \<equiv> (ls_of_pid gc pid,pid_global_config.state gc)"

  definition ga_gen
    :: "('c,'ls,'gs) pid_global_config \<Rightarrow> ('c,'a) global_action set"
  where
    "ga_gen gc \<equiv> { (pid,c,a,c') .
      cstep c a c'
    \<and> pid_valid gc pid
    \<and> c=cmd_of_pid gc pid
    \<and> en (fs_of_pid gc pid) a }"

  definition ga_gex
    :: "('c,'a) global_action \<Rightarrow> ('c,'ls,'gs) pid_global_config \<Rightarrow> ('c,'ls,'gs) pid_global_config"
  where
    "ga_gex ga gc \<equiv> let
      (pid,c,a,c') = ga;
      fs = fs_of_pid gc pid;
      (ls',gs') = ex fs a;
      gc' = \<lparr>
          pid_global_config.processes = (pid_global_config.processes gc)
            [pid :=
              \<lparr> local_config.command = c', local_config.state = ls'\<rparr>
            ],
          pid_global_config.state = gs'\<rparr>
    in
      gc'"

  definition "ga_gstep \<equiv> rel_of_enex (ga_gen,ga_gex)"
  definition "ga_en \<equiv> stutter_extend_en ga_gen"
  definition "ga_ex \<equiv> stutter_extend_ex ga_gex"
  definition "ga_step \<equiv> stutter_extend_edges UNIV ga_gstep"
  lemma ga_step_alt: "ga_step = rel_of_enex (ga_en,ga_ex)"
    unfolding ga_step_def ga_gstep_def ga_en_def ga_ex_def
    by (auto simp: stutter_extend_pred_of_enex_conv)

  lemma some_ga_en_eq:
    "Some a \<in> ga_en gc \<longleftrightarrow> a \<in> ga_gen gc"
    by (auto simp: ga_en_def)
  lemma some_ga_ex_eq:
    "ga_ex (Some a) gc = ga_gex a gc"
    "ga_ex \<circ> Some = ga_gex"
    by (auto simp: ga_ex_def intro!: ext)
  lemma none_ga_en_eq: "None \<in> ga_en gc \<longleftrightarrow> ga_gen gc = {}"
    by (auto simp: ga_en_def stutter_extend_en_def)
  lemma ga_ex_none[simp]: "ga_ex None = id"
    by (auto simp: ga_ex_def)

  lemma ga_gstep_eq: "ga_gstep = pid_gstep"
    apply safe
    apply (auto
      simp: ga_gstep_def ga_gen_def ga_gex_def
      split: prod.splits elim!: prod_splitE
      intro: pid_gstep_succI) []

    apply (fastforce
      simp: pred_of_succ_def ga_gstep_def ga_gen_def ga_gex_def
      split: prod.splits
      elim!: pid_gstep_succE)
    done

  lemma ga_step_eq: "ga_step = pid_step"
    unfolding ga_step_def pid_step_def ga_gstep_eq by rule

  definition ga_automaton :: "(('c,'ls,'gs) pid_global_config, 'l) sa_rec"
    where "ga_automaton \<equiv> \<lparr> g_V = UNIV, g_E = ga_step, g_V0 = {pid_init}, sa_L = pid_label \<rparr>"

  lemma ga_automaton_simps[simp]:
    "g_V ga_automaton = UNIV"
    "g_E ga_automaton = ga_step"
    "g_V0 ga_automaton = {pid_init}"
    "sa_L ga_automaton = pid_label"
    unfolding ga_automaton_def by simp+

  lemma ga_pid_system_automaton: "ga_automaton = pid_system_automaton"
    unfolding ga_automaton_def pid_system_automaton_def ga_step_eq by rule

  sublocale jsys: transition_system ga_ex "\<lambda> a p. a \<in> ga_en p" .
  sublocale ga: sa ga_automaton unfolding ga_pid_system_automaton by unfold_locales

  sublocale ga_bisim: lbisimulation Id ga_automaton pid_system_automaton
    unfolding ga_pid_system_automaton by auto

  lemma ga_accept_eq: "ga.accept = sa.accept"
    by (simp add: ga_bisim.accept_bisim pid_accept_eq)

  lemma ga_run_eq: "pid.g.is_run r = ga.is_run r"
    using ga_bisim.br_run_conv[of id "\<lambda>_. True" r]
    by (auto simp: build_rel_def[abs_def])

  sublocale jsys: transition_system_initial ga_ex "\<lambda> a p. a \<in> ga_en p" "\<lambda> p. p = pid_init" .

  lemma reachable_alt: "jsys.nodes = ga.E\<^sup>* `` ga.V0"
  proof safe
    fix gc
    assume "gc \<in> jsys.nodes"
    thus "gc \<in> ga.E\<^sup>* `` ga.V0"
      unfolding ga_automaton_def ga_step_alt rel_of_enex_def
      by (induct, auto intro: rtrancl_into_rtrancl)
  next
    fix gc gc'
    assume "(gc, gc') \<in> ga.E\<^sup>*" "gc \<in> ga.V0"
    thus "gc' \<in> jsys.nodes" unfolding ga_automaton_def ga_step_alt by induct auto
  qed

  lemma rtrancl_step_exec_word_conv:
    "(gc, gc') \<in> ga_step\<^sup>* \<longleftrightarrow> (\<exists>w. jsys.path w gc \<and> gc' = jsys.target w gc)"
  proof safe
    assume "(gc, gc') \<in> ga_step\<^sup>*"
    thus "\<exists> w. jsys.path w gc \<and> gc' = jsys.target w gc"
      apply induction
      apply force
      apply (force simp: ga_step_alt pred_of_enex_def)
      done
  next
    fix w
    assume "jsys.path w gc"
    thus "(gc, jsys.target w gc) \<in> ga_step\<^sup>*"
      apply induction
      apply (auto simp: ga_step_alt rel_of_enex_def
        intro: converse_rtrancl_into_rtrancl)
      done
  qed

  sublocale jsys: transition_system_complete ga_ex "\<lambda> a p. a \<in> ga_en p" "\<lambda> p. p = pid_init" pid_label .

  lemma accept_eq_lang: "snth ` jsys.language = Collect sa.accept"
    unfolding ga_accept_eq[symmetric]
    unfolding ga_automaton_def
    unfolding ga_step_alt
    apply (rule system_complete_language_eq_lsystem_accept)
    unfolding ga_step_alt[symmetric]
    unfolding ga_automaton_def[symmetric]
    by unfold_locales

end

end


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

section {* Compositionality on Execution level *}

theory CompoExecs
imports Traces
begin

definition
  ProjA2 :: "('a,'s * 't)pairs -> ('a,'s)pairs" where
  "ProjA2 = Map (%x.(fst x,fst(snd x)))"

definition
  ProjA :: "('a,'s * 't)execution => ('a,'s)execution" where
  "ProjA ex = (fst (fst ex), ProjA2$(snd ex))"

definition
  ProjB2 :: "('a,'s * 't)pairs -> ('a,'t)pairs" where
  "ProjB2 = Map (%x.(fst x,snd(snd x)))"

definition
  ProjB :: "('a,'s * 't)execution => ('a,'t)execution" where
  "ProjB ex = (snd (fst ex), ProjB2$(snd ex))"

definition
  Filter_ex2 :: "'a signature => ('a,'s)pairs -> ('a,'s)pairs" where
  "Filter_ex2 sig = Filter (%x. fst x:actions sig)"

definition
  Filter_ex :: "'a signature => ('a,'s)execution => ('a,'s)execution" where
  "Filter_ex sig ex = (fst ex,Filter_ex2 sig$(snd ex))"

definition
  stutter2 :: "'a signature => ('a,'s)pairs -> ('s => tr)" where
  "stutter2 sig = (fix$(LAM h ex. (%s. case ex of
      nil => TT
    | x##xs => (flift1
            (%p.(If Def ((fst p)~:actions sig)
                 then Def (s=(snd p))
                 else TT)
                andalso (h$xs) (snd p))
             $x)
   )))"

definition
  stutter :: "'a signature => ('a,'s)execution => bool" where
  "stutter sig ex = ((stutter2 sig$(snd ex)) (fst ex) ~= FF)"

definition
  par_execs :: "[('a,'s)execution_module,('a,'t)execution_module] => ('a,'s*'t)execution_module" where
  "par_execs ExecsA ExecsB =
      (let exA = fst ExecsA; sigA = snd ExecsA;
           exB = fst ExecsB; sigB = snd ExecsB
       in
       (    {ex. Filter_ex sigA (ProjA ex) : exA}
        Int {ex. Filter_ex sigB (ProjB ex) : exB}
        Int {ex. stutter sigA (ProjA ex)}
        Int {ex. stutter sigB (ProjB ex)}
        Int {ex. Forall (%x. fst x:(actions sigA Un actions sigB)) (snd ex)},
        asig_comp sigA sigB))"

lemmas [simp del] = split_paired_All

section "recursive equations of operators"

(* ---------------------------------------------------------------- *)
(*                               ProjA2                             *)
(* ---------------------------------------------------------------- *)

lemma ProjA2_UU: "ProjA2$UU = UU"
apply (simp add: ProjA2_def)
done

lemma ProjA2_nil: "ProjA2$nil = nil"
apply (simp add: ProjA2_def)
done

lemma ProjA2_cons: "ProjA2$((a,t)>>xs) = (a,fst t) >> ProjA2$xs"
apply (simp add: ProjA2_def)
done

(* ---------------------------------------------------------------- *)
(*                               ProjB2                             *)
(* ---------------------------------------------------------------- *)

lemma ProjB2_UU: "ProjB2$UU = UU"
apply (simp add: ProjB2_def)
done

lemma ProjB2_nil: "ProjB2$nil = nil"
apply (simp add: ProjB2_def)
done

lemma ProjB2_cons: "ProjB2$((a,t)>>xs) = (a,snd t) >> ProjB2$xs"
apply (simp add: ProjB2_def)
done

(* ---------------------------------------------------------------- *)
(*                             Filter_ex2                           *)
(* ---------------------------------------------------------------- *)

lemma Filter_ex2_UU: "Filter_ex2 sig$UU=UU"
apply (simp add: Filter_ex2_def)
done

lemma Filter_ex2_nil: "Filter_ex2 sig$nil=nil"
apply (simp add: Filter_ex2_def)
done

lemma Filter_ex2_cons: "Filter_ex2 sig$(at >> xs) =
             (if (fst at:actions sig)
                  then at >> (Filter_ex2 sig$xs)
                  else        Filter_ex2 sig$xs)"

apply (simp add: Filter_ex2_def)
done

(* ---------------------------------------------------------------- *)
(*                             stutter2                             *)
(* ---------------------------------------------------------------- *)

lemma stutter2_unfold: "stutter2 sig = (LAM ex. (%s. case ex of
       nil => TT
     | x##xs => (flift1
             (%p.(If Def ((fst p)~:actions sig)
                  then Def (s=(snd p))
                  else TT)
                 andalso (stutter2 sig$xs) (snd p))
              $x)
            ))"
apply (rule trans)
apply (rule fix_eq2)
apply (simp only: stutter2_def)
apply (rule beta_cfun)
apply (simp add: flift1_def)
done

lemma stutter2_UU: "(stutter2 sig$UU) s=UU"
apply (subst stutter2_unfold)
apply simp
done

lemma stutter2_nil: "(stutter2 sig$nil) s = TT"
apply (subst stutter2_unfold)
apply simp
done

lemma stutter2_cons: "(stutter2 sig$(at>>xs)) s =
               ((if (fst at)~:actions sig then Def (s=snd at) else TT)
                 andalso (stutter2 sig$xs) (snd at))"
apply (rule trans)
apply (subst stutter2_unfold)
apply (simp add: Consq_def flift1_def If_and_if)
apply simp
done

declare stutter2_UU [simp] stutter2_nil [simp] stutter2_cons [simp]

(* ---------------------------------------------------------------- *)
(*                             stutter                              *)
(* ---------------------------------------------------------------- *)

lemma stutter_UU: "stutter sig (s, UU)"
apply (simp add: stutter_def)
done

lemma stutter_nil: "stutter sig (s, nil)"
apply (simp add: stutter_def)
done

lemma stutter_cons: "stutter sig (s, (a,t)>>ex) =
      ((a~:actions sig --> (s=t)) & stutter sig (t,ex))"
apply (simp add: stutter_def)
done

(* ----------------------------------------------------------------------------------- *)

declare stutter2_UU [simp del] stutter2_nil [simp del] stutter2_cons [simp del]

lemmas compoex_simps = ProjA2_UU ProjA2_nil ProjA2_cons
  ProjB2_UU ProjB2_nil ProjB2_cons
  Filter_ex2_UU Filter_ex2_nil Filter_ex2_cons
  stutter_UU stutter_nil stutter_cons

declare compoex_simps [simp]

(* ------------------------------------------------------------------ *)
(*                      The following lemmata aim for                 *)
(*             COMPOSITIONALITY   on    EXECUTION     Level           *)
(* ------------------------------------------------------------------ *)

(* --------------------------------------------------------------------- *)
(*  Lemma_1_1a : is_ex_fr propagates from A||B to Projections A and B    *)
(* --------------------------------------------------------------------- *)

lemma lemma_1_1a: "!s. is_exec_frag (A||B) (s,xs)
       -->  is_exec_frag A (fst s, Filter_ex2 (asig_of A)$(ProjA2$xs)) &
            is_exec_frag B (snd s, Filter_ex2 (asig_of B)$(ProjB2$xs))"

apply (tactic {* pair_induct_tac @{context} "xs" [@{thm is_exec_frag_def}] 1 *})
(* main case *)
apply (auto simp add: trans_of_defs2)
done

(* --------------------------------------------------------------------- *)
(*  Lemma_1_1b : is_ex_fr (A||B) implies stuttering on Projections       *)
(* --------------------------------------------------------------------- *)

lemma lemma_1_1b: "!s. is_exec_frag (A||B) (s,xs)
       --> stutter (asig_of A) (fst s,ProjA2$xs)  &
           stutter (asig_of B) (snd s,ProjB2$xs)"

apply (tactic {* pair_induct_tac @{context} "xs"
  [@{thm stutter_def}, @{thm is_exec_frag_def}] 1 *})
(* main case *)
apply (auto simp add: trans_of_defs2)
done

(* --------------------------------------------------------------------- *)
(*  Lemma_1_1c : Executions of A||B have only  A- or B-actions           *)
(* --------------------------------------------------------------------- *)

lemma lemma_1_1c: "!s. (is_exec_frag (A||B) (s,xs)
   --> Forall (%x. fst x:act (A||B)) xs)"

apply (tactic {* pair_induct_tac @{context} "xs" [@{thm Forall_def}, @{thm sforall_def},
  @{thm is_exec_frag_def}] 1 *})
(* main case *)
apply auto
apply (simp add: trans_of_defs2 actions_asig_comp asig_of_par)
done

(* ----------------------------------------------------------------------- *)
(*  Lemma_1_2 : ex A, exB, stuttering and forall a:A|B implies ex (A||B)   *)
(* ----------------------------------------------------------------------- *)

lemma lemma_1_2:
"!s. is_exec_frag A (fst s,Filter_ex2 (asig_of A)$(ProjA2$xs)) &
     is_exec_frag B (snd s,Filter_ex2 (asig_of B)$(ProjB2$xs)) &
     stutter (asig_of A) (fst s,(ProjA2$xs)) &
     stutter (asig_of B) (snd s,(ProjB2$xs)) &
     Forall (%x. fst x:act (A||B)) xs
     --> is_exec_frag (A||B) (s,xs)"

apply (tactic {* pair_induct_tac @{context} "xs" [@{thm Forall_def}, @{thm sforall_def},
  @{thm is_exec_frag_def}, @{thm stutter_def}] 1 *})
apply (auto simp add: trans_of_defs1 actions_asig_comp asig_of_par)
done

subsection {* COMPOSITIONALITY on EXECUTION Level -- Main Theorem *}

lemma compositionality_ex:
"(ex:executions(A||B)) =
 (Filter_ex (asig_of A) (ProjA ex) : executions A &
  Filter_ex (asig_of B) (ProjB ex) : executions B &
  stutter (asig_of A) (ProjA ex) & stutter (asig_of B) (ProjB ex) &
  Forall (%x. fst x:act (A||B)) (snd ex))"

apply (simp (no_asm) add: executions_def ProjB_def Filter_ex_def ProjA_def starts_of_par)
apply (tactic {* pair_tac @{context} "ex" 1 *})
apply (rule iffI)
(* ==>  *)
apply (erule conjE)+
apply (simp add: lemma_1_1a lemma_1_1b lemma_1_1c)
(* <==  *)
apply (erule conjE)+
apply (simp add: lemma_1_2)
done

subsection {* COMPOSITIONALITY on EXECUTION Level -- for Modules *}

lemma compositionality_ex_modules:
  "Execs (A||B) = par_execs (Execs A) (Execs B)"
apply (unfold Execs_def par_execs_def)
apply (simp add: asig_of_par)
apply (rule set_eqI)
apply (simp add: compositionality_ex actions_of_par)
done

end


theory Extra14
  imports ExtraInv VCTheoryLemmas
begin

abbreviation s where "s s0 userAtTop_value userAtBottom_value directionSwitch_value alarmButton_value stuck_value \<equiv>
 (toEnv (setVarAny s0 userAtTop_value userAtBottom_value directionSwitch_value alarmButton_value stuck_value))"

theorem extra14: "VC14 extraInv env s0 userAtTop_value userAtBottom_value directionSwitch_value alarmButton_value stuck_value "
  apply(simp only: VC14_def extraInv_def)
  apply(rule impI)
  apply(rule conjI)
   apply simp
  subgoal
    apply((drule conjE[of _ _ ?thesis])+)
                        defer
                        apply assumption+
    subgoal premises prems
      apply(rule conjI)
      using prems(1-7) prems(8) apply simp
      apply(rule conjI)
      using prems(1-7) prems(9) apply simp
      apply(rule conjI)
      using prems(10) apply -[1]
       apply(rule allI)
      subgoal for s1
        apply(cases "s1 = s s0 userAtTop_value userAtBottom_value directionSwitch_value alarmButton_value stuck_value")
         apply(rule impI)
         apply(drule allE[of _ s0])
          prefer 2
          apply assumption
         apply(drule impE)
           prefer 3
           apply assumption
        using prems(1-7) substate_refl apply simp
         apply(drule exE)
          prefer 2
          apply assumption
         apply(drule exE)
          prefer 2
          apply assumption
        subgoal for s2 s3
          apply(rule exI[of _ s2])
          apply(rule exI[of _ s3])
          apply(rule cut_rl[of "s2 \<noteq> s s0 userAtTop_value userAtBottom_value directionSwitch_value alarmButton_value stuck_value"])
           apply auto[1]
          apply(rule cut_rl[of "s2 \<noteq> s0 \<and> substate s0 (s s0 userAtTop_value userAtBottom_value directionSwitch_value alarmButton_value stuck_value)"])
          using substate_trans substate_antisym apply blast
          using prems(1-7) substate_refl apply simp
          by (metis substate_antisym toEnvNum_id)
        using prems(1-7) by simp
      apply(rule conjI)
      using prems(11) apply -[1]
       apply(rule allI)
      subgoal for s3
        apply(cases "s3 = s s0 userAtTop_value userAtBottom_value directionSwitch_value alarmButton_value stuck_value")
         apply(rule impI)
          apply(drule allE[of _ s0])
           prefer 2
        apply assumption
        using prems(1-7) substate_refl toEnvP_ltime apply simp
         apply (metis One_nat_def Suc_less_eq2 diff_Suc_1)
        using prems(1-7) by simp
      apply(rule conjI)
      using prems(1-7) prems(12) apply simp
      apply(rule conjI)
      using prems(1-7) prems(13) apply simp
      apply(rule conjI)
      using prems(1-7) prems(14) apply simp
      apply(rule conjI)
      using prems(1-7)  prems(15) apply simp
      apply(rule conjI)
      using prems(1-7)  prems(16) apply simp
      apply(rule conjI)
      using prems(1-7)  prems(17) apply simp
      apply(rule conjI)
      using prems(1-7)  prems(18) apply simp
      apply(rule conjI)
      using prems(1-7)  prems(19) apply simp
      apply(rule conjI)
      using prems(1-7) prems(20) apply simp
      apply(rule conjI)
      using prems(1-7)  prems(21) apply simp
      apply(rule conjI)
      using prems(1-7)  prems(22) substate_refl apply simp
      apply(rule conjI)
      using prems(1-7) prems(23) apply simp
      using prems(1-7) prems(24) by simp
    done
  done

end