(*  Title:      HOL/MicroJava/J/State.thy

    Author:     David von Oheimb
    Copyright   1999 Technische Universitaet Muenchen
*)

header {* \isaheader{Objects and the Heap} *}

theory Objects imports TypeRel Value begin

subsection{* Objects *}

type_synonym
  fields = "vname \<times> cname \<rightharpoonup> val"  -- "field name, defining class, value"
type_synonym
  obj = "cname \<times> fields"    -- "class instance with class name and fields"

definition obj_ty  :: "obj \<Rightarrow> ty"
where
  "obj_ty obj  \<equiv>  Class (fst obj)"

definition init_fields :: "((vname \<times> cname) \<times> ty) list \<Rightarrow> fields"
where
  "init_fields  \<equiv>  map_of \<circ> map (\<lambda>(F,T). (F,default_val T))"

  -- "a new, blank object with default values in all fields:"
definition blank :: "'m prog \<Rightarrow> cname \<Rightarrow> obj"
where
  "blank P C  \<equiv>  (C,init_fields (fields P C))"

subsection{* Heap *}

type_synonym heap  = "addr \<rightharpoonup> obj"

abbreviation
  cname_of :: "heap \<Rightarrow> addr \<Rightarrow> cname" where
  "cname_of hp a == fst (the (hp a))"

definition new_Addr  :: "heap \<Rightarrow> addr option"
where
  "new_Addr h  \<equiv>  if \<exists>a. h a = None then Some(LEAST a. h a = None) else None"

definition cast_ok :: "'m prog \<Rightarrow> cname \<Rightarrow> heap \<Rightarrow> val \<Rightarrow> bool"
where
  "cast_ok P C h v  \<equiv>  v = Null \<or> P \<turnstile> cname_of h (the_Addr v) \<preceq>\<^sup>* C"

definition hext :: "heap \<Rightarrow> heap \<Rightarrow> bool" ("_ \<unlhd> _" [51,51] 50)
where
  "h \<unlhd> h'  \<equiv>  \<forall>a C fs. h a = Some(C,fs) \<longrightarrow> (\<exists>fs'. h' a = Some(C,fs'))"

primrec typeof_h :: "heap \<Rightarrow> val \<Rightarrow> ty option"  ("typeof\<^bsub>_\<^esub>")
where
  "typeof\<^bsub>h\<^esub>  Unit    = Some Void"
| "typeof\<^bsub>h\<^esub>  Null    = Some NT"
| "typeof\<^bsub>h\<^esub> (Bool b) = Some Boolean"
| "typeof\<^bsub>h\<^esub> (Intg i) = Some Integer"
| "typeof\<^bsub>h\<^esub> (Addr a) = (case h a of None \<Rightarrow> None | Some(C,fs) \<Rightarrow> Some(Class C))"

lemma new_Addr_SomeD:
  "new_Addr h = Some a \<Longrightarrow> h a = None"
 (*<*)by(fastforce simp add:new_Addr_def split:if_splits intro:LeastI)(*>*)

lemma [simp]: "(typeof\<^bsub>h\<^esub> v = Some Boolean) = (\<exists>b. v = Bool b)"
 (*<*)by(induct v) auto(*>*)

lemma [simp]: "(typeof\<^bsub>h\<^esub> v = Some Integer) = (\<exists>i. v = Intg i)"
(*<*)by(cases v) auto(*>*)

lemma [simp]: "(typeof\<^bsub>h\<^esub> v = Some NT) = (v = Null)"
 (*<*)by(cases v) auto(*>*)

lemma [simp]: "(typeof\<^bsub>h\<^esub> v = Some(Class C)) = (\<exists>a fs. v = Addr a \<and> h a = Some(C,fs))"
 (*<*)by(cases v) auto(*>*)

lemma [simp]: "h a = Some(C,fs) \<Longrightarrow> typeof\<^bsub>(h(a\<mapsto>(C,fs')))\<^esub> v = typeof\<^bsub>h\<^esub> v"
 (*<*)by(induct v) (auto simp:fun_upd_apply)(*>*)

text{* For literal values the first parameter of @{term typeof} can be
set to @{term empty} because they do not contain addresses: *}

abbreviation
  typeof :: "val \<Rightarrow> ty option" where
  "typeof v == typeof_h empty v"

lemma typeof_lit_typeof:
  "typeof v = Some T \<Longrightarrow> typeof\<^bsub>h\<^esub> v = Some T"
 (*<*)by(cases v) auto(*>*)

lemma typeof_lit_is_type:
  "typeof v = Some T \<Longrightarrow> is_type P T"
 (*<*)by (induct v) (auto simp:is_type_def)(*>*)

section {* Heap extension @{text"\<unlhd>"} *}

lemma hextI: "\<forall>a C fs. h a = Some(C,fs) \<longrightarrow> (\<exists>fs'. h' a = Some(C,fs')) \<Longrightarrow> h \<unlhd> h'"
(*<*)
apply (unfold hext_def)
apply auto
done
(*>*)

lemma hext_objD: "\<lbrakk> h \<unlhd> h'; h a = Some(C,fs) \<rbrakk> \<Longrightarrow> \<exists>fs'. h' a = Some(C,fs')"
(*<*)
apply (unfold hext_def)
apply (force)
done
(*>*)

lemma hext_refl [iff]: "h \<unlhd> h"
(*<*)
apply (rule hextI)
apply (fast)
done
(*>*)

lemma hext_new [simp]: "h a = None \<Longrightarrow> h \<unlhd> h(a\<mapsto>x)"
(*<*)
apply (rule hextI)
apply (auto simp:fun_upd_apply)
done
(*>*)

lemma hext_trans: "\<lbrakk> h \<unlhd> h'; h' \<unlhd> h'' \<rbrakk> \<Longrightarrow> h \<unlhd> h''"
(*<*)
apply (rule hextI)
apply (fast dest: hext_objD)
done
(*>*)

lemma hext_upd_obj: "h a = Some (C,fs) \<Longrightarrow> h \<unlhd> h(a\<mapsto>(C,fs'))"
(*<*)
apply (rule hextI)
apply (auto simp:fun_upd_apply)
done
(*>*)

lemma hext_typeof_mono: "\<lbrakk> h \<unlhd> h'; typeof\<^bsub>h\<^esub> v = Some T \<rbrakk> \<Longrightarrow> typeof\<^bsub>h'\<^esub> v = Some T"
(*<*)
apply(cases v)
    apply simp
   apply simp
  apply simp
 apply simp
apply(fastforce simp:hext_def)
done
(*>*)

text {* Code generator setup for @{term "new_Addr"} *}

definition gen_new_Addr :: "heap \<Rightarrow> addr \<Rightarrow> addr option"
where "gen_new_Addr h n \<equiv> if \<exists>a. a \<ge> n \<and> h a = None then Some(LEAST a. a \<ge> n \<and> h a = None) else None"

lemma new_Addr_code_code [code]:
  "new_Addr h = gen_new_Addr h 0"
by(simp add: new_Addr_def gen_new_Addr_def split del: split_if cong: if_cong)

lemma gen_new_Addr_code [code]:
  "gen_new_Addr h n = (if h n = None then Some n else gen_new_Addr h (Suc n))"
apply(simp add: gen_new_Addr_def)
apply(rule impI)
apply(rule conjI)
 apply safe[1]
  apply(fastforce intro: Least_equality)
 apply(rule arg_cong[where f=Least])
 apply(rule ext)
 apply(case_tac "n = ac")
  apply simp
 apply(auto)[1]
apply clarify
apply(subgoal_tac "a = n")
 apply simp
 apply(rule Least_equality)
 apply auto[2]
apply(rule ccontr)
apply(erule_tac x="a" in allE)
apply simp
done

end


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

theory Lookups_D
imports
  "../../spec/capDL/Syscall_D"
  "../../lib/Monad_WP/OptionMonadND"
begin

type_synonym 'a lookup = "cdl_state \<Rightarrow> 'a option"

definition
  opt_cnode :: "cdl_object_id \<Rightarrow> cdl_cnode lookup"
where
  "opt_cnode p \<equiv> DO
      t \<leftarrow> opt_object p;
      case t of
        CNode cnode \<Rightarrow> oreturn cnode
      | _ \<Rightarrow> ofail
   OD"

function resolve_cap ::
  "cdl_cap \<Rightarrow> cdl_cptr \<Rightarrow> nat \<Rightarrow> (cdl_fault_error + cdl_cap_ref \<times> nat) lookup"
where
  "resolve_cap cnode_cap cap_ptr remaining_size =
  (if is_cnode_cap cnode_cap
  then DO
    (* Fetch the next level CNode. *)
    cnode \<leftarrow> opt_cnode $ cap_object cnode_cap;
    radix_size \<leftarrow> oreturn $ cdl_cnode_size_bits cnode;
    guard_size \<leftarrow> oreturn $ cap_guard_size cnode_cap;
    cap_guard  \<leftarrow> oreturn $ cap_guard cnode_cap;
    level_size \<leftarrow> oreturn (radix_size + guard_size);
    oassert (level_size \<noteq> 0);

    (* Ensure the guard matches up. *)
    guard \<leftarrow> oreturn $ (cap_ptr >> (remaining_size-guard_size)) && (mask guard_size);
    if \<not>(guard_size \<le> remaining_size \<and> guard = cap_guard) \<or>
       level_size > remaining_size
    then othrow FaultError
    else DO
      (* Find the next slot. *)
      offset \<leftarrow> oreturn $ (cap_ptr >> (remaining_size-level_size)) && (mask radix_size);
      slot \<leftarrow> oreturn (cap_object cnode_cap, unat offset);
      size_left \<leftarrow> oreturn (remaining_size - level_size);
      if size_left = 0 then
        oreturnOk (slot, 0)
      else DO
        next_cap \<leftarrow> opt_cap slot;
        if is_cnode_cap next_cap then
          resolve_cap next_cap cap_ptr size_left
        else
          oreturnOk (slot, size_left)
      OD
    OD
  OD
  else othrow FaultError)"
  by auto

termination
  by (relation "measure (\<lambda>(a,b,c). c)") auto

declare resolve_cap.simps [simp del]

declare resolve_address_bits.simps [simp del]

lemma throwError_FaultError [simp]:
  "throwError FaultError = throw"
  apply (cases "undefined::cdl_fault_error")
  apply simp
  done

lemma gets_the_get_cnode:
  "gets_the (opt_cnode r) = get_cnode r"
  apply (simp add: get_cnode_def opt_cnode_def)
  apply (rule bind_cong, rule refl)
  apply (clarsimp split: cdl_object.splits)
  done

lemma gets_the_resolve_cap:
  "gets_the (resolve_cap cnode_cap cap_ptr remaining_size) =
   resolve_address_bits cnode_cap cap_ptr remaining_size"
  apply (induct cnode_cap cap_ptr remaining_size rule: resolve_cap.induct [simplified])
  apply (subst resolve_cap.simps)
  apply (subst resolve_address_bits.simps)
  apply (clarsimp simp: unlessE_def liftE_bindE assertE_liftE gets_the_get_cnode)
  apply (rule bind_cong, rule refl)
  apply (rule bind_apply_cong, rule refl)
  apply (clarsimp simp: liftE_bindE)
  apply (rule bind_apply_cong, rule refl)
  apply (clarsimp simp: in_monad gets_the_get_cnode [symmetric])
  done

definition resolve_address_bits' ::
  "cdl_cap \<Rightarrow> cdl_cptr \<Rightarrow> nat \<Rightarrow> (cdl_cap_ref \<times> nat) lookup"
where
  "resolve_address_bits' cap cptr n \<equiv> odrop $  resolve_cap cap cptr n"

definition
  lookup_slot' :: "cdl_object_id \<Rightarrow> cdl_cptr \<Rightarrow> cdl_cap_ref lookup"
where
  "lookup_slot' thread cptr \<equiv>
    DO
      cspace_root \<leftarrow> opt_cap (thread, tcb_cspace_slot);
      (slot, _) \<leftarrow> resolve_address_bits' cspace_root cptr word_bits;
      oreturn slot
    OD"

definition
  lookup_cap' :: "cdl_object_id \<Rightarrow> cdl_cptr \<Rightarrow> cdl_cap lookup"
where
  "lookup_cap' thread cptr \<equiv>
    DO
      slot \<leftarrow> lookup_slot' thread cptr;
      opt_cap slot
    OD"

definition
  lookup_cap_and_slot' :: "cdl_object_id \<Rightarrow> cdl_cptr \<Rightarrow> (cdl_cap \<times> cdl_cap_ref) lookup"
where
  "lookup_cap_and_slot' thread cptr \<equiv>
    DO
      slot \<leftarrow> lookup_slot' thread cptr;
      cap \<leftarrow> opt_cap slot;
      oreturn (cap, slot)
    OD"

definition
  lookup_object :: "cdl_object_id \<Rightarrow> cdl_cptr \<Rightarrow> cdl_object_id lookup"
where
  "lookup_object thread cptr \<equiv>
    DO
      cap \<leftarrow> lookup_cap' thread cptr;
      oreturn $ cap_object cap
    OD"

definition
  lookup_extra_caps' :: "cdl_object_id \<Rightarrow> cdl_cptr list \<Rightarrow> (cdl_cap \<times> cdl_cap_ref) list lookup"
where
  "lookup_extra_caps' thread cptrs \<equiv>
     omap (\<lambda>cptr. lookup_cap_and_slot' thread cptr) cptrs"

end


(*  Title:      HOL/TLA/Memory/RPC.thy
    Author:     Stephan Merz, University of Munich
*)

section {* RPC-Memory example: RPC specification *}

theory RPC
imports RPCParameters ProcedureInterface Memory
begin

type_synonym rpcSndChType = "(rpcOp,Vals) channel"
type_synonym rpcRcvChType = "memChType"
type_synonym rpcStType = "(PrIds => rpcState) stfun"

consts
  (* state predicates *)
  RPCInit      :: "rpcRcvChType => rpcStType => PrIds => stpred"

  (* actions *)
  RPCFwd     :: "rpcSndChType => rpcRcvChType => rpcStType => PrIds => action"
  RPCReject  :: "rpcSndChType => rpcRcvChType => rpcStType => PrIds => action"
  RPCFail    :: "rpcSndChType => rpcRcvChType => rpcStType => PrIds => action"
  RPCReply   :: "rpcSndChType => rpcRcvChType => rpcStType => PrIds => action"
  RPCNext    :: "rpcSndChType => rpcRcvChType => rpcStType => PrIds => action"

  (* temporal *)
  RPCIPSpec   :: "rpcSndChType => rpcRcvChType => rpcStType => PrIds => temporal"
  RPCISpec   :: "rpcSndChType => rpcRcvChType => rpcStType => temporal"

defs
  RPCInit_def:       "RPCInit rcv rst p == PRED ((rst!p = #rpcA) & ~Calling rcv p)"

  RPCFwd_def:        "RPCFwd send rcv rst p == ACT
                         $(Calling send p)
                         & $(rst!p) = # rpcA
                         & IsLegalRcvArg<arg<$(send!p)>>
                         & Call rcv p RPCRelayArg<arg<send!p>>
                         & (rst!p)$ = # rpcB
                         & unchanged (rtrner send!p)"

  RPCReject_def:     "RPCReject send rcv rst p == ACT
                           $(rst!p) = # rpcA
                         & ~IsLegalRcvArg<arg<$(send!p)>>
                         & Return send p #BadCall
                         & unchanged ((rst!p), (caller rcv!p))"

  RPCFail_def:       "RPCFail send rcv rst p == ACT
                           ~$(Calling rcv p)
                         & Return send p #RPCFailure
                         & (rst!p)$ = #rpcA
                         & unchanged (caller rcv!p)"

  RPCReply_def:      "RPCReply send rcv rst p == ACT
                           ~$(Calling rcv p)
                         & $(rst!p) = #rpcB
                         & Return send p res<rcv!p>
                         & (rst!p)$ = #rpcA
                         & unchanged (caller rcv!p)"

  RPCNext_def:       "RPCNext send rcv rst p == ACT
                        (  RPCFwd send rcv rst p
                         | RPCReject send rcv rst p
                         | RPCFail send rcv rst p
                         | RPCReply send rcv rst p)"

  RPCIPSpec_def:     "RPCIPSpec send rcv rst p == TEMP
                           Init RPCInit rcv rst p
                         & [][ RPCNext send rcv rst p ]_(rst!p, rtrner send!p, caller rcv!p)
                         & WF(RPCNext send rcv rst p)_(rst!p, rtrner send!p, caller rcv!p)"

  RPCISpec_def:      "RPCISpec send rcv rst == TEMP (ALL p. RPCIPSpec send rcv rst p)"

lemmas RPC_action_defs =
  RPCInit_def RPCFwd_def RPCReject_def RPCFail_def RPCReply_def RPCNext_def

lemmas RPC_temp_defs = RPCIPSpec_def RPCISpec_def

(* The RPC component engages in an action for process p only if there is an outstanding,
   unanswered call for that process.
*)

lemma RPCidle: "|- ~$(Calling send p) --> ~RPCNext send rcv rst p"
  by (auto simp: Return_def RPC_action_defs)

lemma RPCbusy: "|- $(Calling rcv p) & $(rst!p) = #rpcB --> ~RPCNext send rcv rst p"
  by (auto simp: RPC_action_defs)

(* RPC failure actions are visible. *)
lemma RPCFail_vis: "|- RPCFail send rcv rst p -->
    <RPCNext send rcv rst p>_(rst!p, rtrner send!p, caller rcv!p)"
  by (auto dest!: Return_changed [temp_use] simp: angle_def RPCNext_def RPCFail_def)

lemma RPCFail_Next_enabled: "|- Enabled (RPCFail send rcv rst p) -->
    Enabled (<RPCNext send rcv rst p>_(rst!p, rtrner send!p, caller rcv!p))"
  by (force elim!: enabled_mono [temp_use] RPCFail_vis [temp_use])

(* Enabledness of some actions *)
lemma RPCFail_enabled: "!!p. basevars (rtrner send!p, caller rcv!p, rst!p) ==>
    |- ~Calling rcv p & Calling send p --> Enabled (RPCFail send rcv rst p)"
  by (tactic {* action_simp_tac (@{context} addsimps [@{thm RPCFail_def},
    @{thm Return_def}, @{thm caller_def}, @{thm rtrner_def}]) [exI]
    [@{thm base_enabled}, @{thm Pair_inject}] 1 *})

lemma RPCReply_enabled: "!!p. basevars (rtrner send!p, caller rcv!p, rst!p) ==>
      |- ~Calling rcv p & Calling send p & rst!p = #rpcB
         --> Enabled (RPCReply send rcv rst p)"
  by (tactic {* action_simp_tac (@{context} addsimps [@{thm RPCReply_def},
    @{thm Return_def}, @{thm caller_def}, @{thm rtrner_def}]) [exI]
    [@{thm base_enabled}, @{thm Pair_inject}] 1 *})

end


\<comment>\<open> ********************************************************************
 * Project         : CSP-RefTK - A Refinement Toolkit for HOL-CSP
 * Version         : 1.0
 *
 * Author          : Burkhart Wolff, Safouan Taha, Lina Ye.
 *
 * This file       : Theorems on DF and LF
 *
 * Copyright (c) 2020 Université Paris-Saclay, France
 *
 * All rights reserved.
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions are
 * met:
 *
 *     * Redistributions of source code must retain the above copyright
 *       notice, this list of conditions and the following disclaimer.
 *
 *     * Redistributions in binary form must reproduce the above
 *       copyright notice, this list of conditions and the following
 *       disclaimer in the documentation and/or other materials provided
 *       with the distribution.
 *
 *     * Neither the name of the copyright holders nor the names of its
 *       contributors may be used to endorse or promote products derived
 *       from this software without specific prior written permission.
 *
 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
 * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
 * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
 * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
 * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
 * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
 * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
 * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
 * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
 * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 ******************************************************************************\<close>

theory Properties
  imports "Assertions_ext"
begin

section \<open>Deadlock Free\<close>

thm deadlock_free_def

lemma deadlock_free_implies_div_free: "deadlock_free P \<Longrightarrow> D P = {}"
  by (simp add: deadlock_free_def div_free_DF failure_divergence_refine_def le_ref_def)

lemma deadlock_free_implies_non_terminating: "deadlock_free (P::'a process) \<Longrightarrow> \<forall>s\<in>T P. tickFree s"
  unfolding deadlock_free_def apply(drule FD_F, drule le_F_T) unfolding trace_refine_def
  using DF_all_tickfree_traces1[of "(UNIV::'a set)"] tickFree_def by fastforce

definition deadlock_free_v2 :: "'a process \<Rightarrow> bool"
  where   "deadlock_free_v2 P \<equiv> DF\<^sub>S\<^sub>K\<^sub>I\<^sub>P UNIV \<sqsubseteq>\<^sub>F P"

lemma deadlock_free_v2_is_right:
  "deadlock_free_v2 (P::'a process) \<longleftrightarrow> (\<forall>s\<in>T P. tickFree s \<longrightarrow> (s, UNIV::'a event set) \<notin> F P)"
proof
  assume a:"deadlock_free_v2 P"
  have "tickFree s \<longrightarrow> (s, UNIV) \<notin> F (DF\<^sub>S\<^sub>K\<^sub>I\<^sub>P UNIV)" for s::"'a event list"
  proof(induct s)
    case Nil
    then show ?case by (subst DF\<^sub>S\<^sub>K\<^sub>I\<^sub>P_unfold, simp add:F_mndet write0_def F_Mprefix F_ndet F_SKIP)
  next
    case (Cons a s)
    then show ?case
      by (subst DF\<^sub>S\<^sub>K\<^sub>I\<^sub>P_unfold, simp add:F_mndet write0_def F_Mprefix F_ndet F_SKIP)
  qed
  with a show "\<forall>s\<in>T P. tickFree s \<longrightarrow> (s, UNIV) \<notin> F P"
    using deadlock_free_v2_def failure_refine_def by blast
next
  assume as1:"\<forall>s\<in>T P. tickFree s \<longrightarrow> (s, UNIV) \<notin> F P"
  have as2:"front_tickFree s \<Longrightarrow> (\<exists>aa \<in> UNIV. ev aa \<notin> b) \<Longrightarrow> (s, b) \<in> F (DF\<^sub>S\<^sub>K\<^sub>I\<^sub>P (UNIV::'a set))"
       for s b
  proof(induct s)
    case Nil
    then show ?case
      by (subst DF\<^sub>S\<^sub>K\<^sub>I\<^sub>P_unfold, auto simp add:F_mndet write0_def F_Mprefix F_ndet F_SKIP)
  next
    case (Cons hda tla)
    then show ?case
    proof(simp add:DF\<^sub>S\<^sub>K\<^sub>I\<^sub>P_def fix_def)
      define Y where "Y \<equiv> \<lambda>i. iterate i\<cdot>(\<Lambda> x. (\<sqinter>xa\<in>(UNIV::'a set) \<rightarrow>  x) \<sqinter> SKIP)\<cdot>\<bottom>"
      assume a:"front_tickFree (hda # tla)" and b:"front_tickFree tla \<Longrightarrow> (tla, b) \<in> F (\<Squnion>i. Y i)"
             and c:"\<exists>aa. ev aa \<notin> b"
      from Y_def have cc:"chain Y" by simp
      from b have d:"front_tickFree tla \<Longrightarrow> \<exists>aa\<in>UNIV. ev aa \<notin> b \<Longrightarrow>(tla, b) \<in> F (Y i)" for i
        using F_LUB[OF cc] limproc_is_thelub[OF cc] by simp
      from Y_def have e:"F(mndet UNIV (\<lambda>x. Y i) \<sqinter> SKIP) \<subseteq> F (Y (Suc i))" for i by(simp)
      from a have f:"tla \<noteq> [] \<Longrightarrow> hda \<noteq> tick" "front_tickFree tla"
        apply (metis butlast.simps(2) butlast_snoc front_tickFree_charn
                      list.distinct(1) tickFree_Cons)
        by (metis a append_Cons append_Nil front_tickFree_Nil front_tickFree_mono)
      have g:"(hda#tla, b) \<in> F (Y (Suc i))" for i
        using f c e[of i] d[of i]
        by (auto simp: F_mndet write0_def F_Mprefix Y_def F_ndet F_SKIP) (metis event.exhaust)+
      have h:"(hda#tla, b) \<in> F (Y 0)"
        using NF_ND cc g po_class.chainE proc_ord2a by blast
      from a b c show "(hda#tla, b) \<in> F (\<Squnion>i. Y i)"
        using F_LUB[OF cc] is_ub_thelub[OF cc]
        by (metis D_LUB_2 cc g limproc_is_thelub po_class.chainE proc_ord2a process_charn)
    qed
  qed
  show "deadlock_free_v2 P"
  proof(auto simp add:deadlock_free_v2_def failure_refine_def)
    fix s b
    assume as3:"(s, b) \<in> F P"
    hence a1:"s \<in> T P" "front_tickFree s"
       using F_T apply blast
      using as3 is_processT2 by blast
    show "(s, b) \<in> F (DF\<^sub>S\<^sub>K\<^sub>I\<^sub>P UNIV)"
    proof(cases "tickFree s")
      case FT_True:True
      hence a2:"(s, UNIV) \<notin> F P"
        using a1 as1 by blast
      then show ?thesis
        by (metis FT_True UNIV_I UNIV_eq_I a1(2) as2 as3 emptyE event.exhaust
                  is_processT6_S1 tickFree_implies_front_tickFree_single)
    next
      case FT_False: False
      then show ?thesis
        by (meson T_F_spec UNIV_witness a1(2) append_single_T_imp_tickFree
                  as2 emptyE is_processT5_S7)
    qed
  qed
qed

lemma deadlock_free_v2_implies_div_free: "deadlock_free_v2 P \<Longrightarrow> D P = {}"
  by (metis F_T append_single_T_imp_tickFree deadlock_free_v2_is_right ex_in_conv
            nonTickFree_n_frontTickFree process_charn)

corollary deadlock_free_v2_FD: "deadlock_free_v2 P = DF\<^sub>S\<^sub>K\<^sub>I\<^sub>P UNIV \<sqsubseteq>\<^sub>F\<^sub>D P"
  unfolding deadlock_free_v2_def
  using deadlock_free_v2_implies_div_free FD_F F_D_FD deadlock_free_v2_def divergence_refine_def
  by fastforce

lemma all_events_refusal:
                        "(s, {tick} \<union> ev ` (events_of P)) \<in> F P \<Longrightarrow> (s, UNIV::'a event set) \<in> F P"
proof -
  assume a1:"(s, {tick} \<union> ev ` events_of P) \<in> F P"
  { assume "(s, UNIV) \<notin> F P"
    then obtain c where "c \<notin> {tick} \<union> ev ` events_of P \<and> s @ [c] \<in> T P"
      using is_processT5_S1[of s "{tick} \<union> ev ` events_of P" P
            "UNIV - ({tick} \<union> ev ` events_of P)", simplified] F_T a1 by auto
    hence False by (simp add:events_of_def, cases c) fastforce+
  }
  with a1 show "(s, UNIV) \<in> F P" by blast
qed

corollary deadlock_free_v2_is_right_wrt_events:
  "deadlock_free_v2 (P::'a process) \<longleftrightarrow>
                                  (\<forall>s\<in>T P. tickFree s \<longrightarrow> (s, {tick} \<union> ev ` (events_of P)) \<notin> F P)"
  unfolding deadlock_free_v2_is_right using all_events_refusal apply auto
  using is_processT4 by blast

lemma deadlock_free_is_deadlock_free_v2:
  "deadlock_free P \<Longrightarrow> deadlock_free_v2 P"
  using DF\<^sub>S\<^sub>K\<^sub>I\<^sub>P_DF_refine_FD deadlock_free_def deadlock_free_v2_FD trans_FD by blast

section \<open>Non-terminating Runs\<close>

definition non_terminating  :: "'a process \<Rightarrow> bool"
  where   "non_terminating P \<equiv> RUN UNIV \<sqsubseteq>\<^sub>T P"

corollary non_terminating_refine_DF: "non_terminating P = DF UNIV \<sqsubseteq>\<^sub>T P"
  and non_terminating_refine_CHAOS: "non_terminating P = CHAOS UNIV \<sqsubseteq>\<^sub>T P"
  by (simp_all add: DF_all_tickfree_traces1 RUN_all_tickfree_traces1 CHAOS_all_tickfree_traces1
                    non_terminating_def trace_refine_def)

lemma non_terminating_is_right: "non_terminating (P::'a process) \<longleftrightarrow> (\<forall>s\<in>T P. tickFree s)"
  apply (rule iffI)
  by (auto simp add:non_terminating_def trace_refine_def tickFree_def RUN_all_tickfree_traces1)[1]
     (auto simp add:non_terminating_def trace_refine_def RUN_all_tickfree_traces2)

lemma nonterminating_implies_div_free: "non_terminating P \<Longrightarrow> D P = {}"
  unfolding non_terminating_is_right
  by (metis NT_ND equals0I front_tickFree_charn process_charn tickFree_Cons tickFree_append)

lemma non_terminating_implies_F: "non_terminating P \<Longrightarrow> CHAOS UNIV \<sqsubseteq>\<^sub>F P"
  apply(auto simp add: non_terminating_is_right failure_refine_def)
  using CHAOS_has_all_tickFree_failures F_T by blast

corollary non_terminating_F: "non_terminating P = CHAOS UNIV \<sqsubseteq>\<^sub>F P"
  by (auto simp add:non_terminating_implies_F non_terminating_refine_CHAOS le_F_T)

corollary non_terminating_FD: "non_terminating P = CHAOS UNIV \<sqsubseteq>\<^sub>F\<^sub>D P"
  unfolding non_terminating_F
  using div_free_CHAOS nonterminating_implies_div_free FD_F F_D_FD divergence_refine_def
        non_terminating_F by fastforce

section \<open>Lifelock Freeness\<close>

thm lifelock_free_def

corollary lifelock_free_is_non_terminating: "lifelock_free P = non_terminating P"
  unfolding lifelock_free_def non_terminating_FD by rule

lemma div_free_divergence_refine:
  "D P = {} \<longleftrightarrow> CHAOS\<^sub>S\<^sub>K\<^sub>I\<^sub>P UNIV \<sqsubseteq>\<^sub>D P"
  "D P = {} \<longleftrightarrow> CHAOS UNIV \<sqsubseteq>\<^sub>D P"
  "D P = {} \<longleftrightarrow> RUN UNIV \<sqsubseteq>\<^sub>D P"
  "D P = {} \<longleftrightarrow> DF\<^sub>S\<^sub>K\<^sub>I\<^sub>P UNIV \<sqsubseteq>\<^sub>D P"
  "D P = {} \<longleftrightarrow> DF UNIV \<sqsubseteq>\<^sub>D P"
  by (simp_all add: div_free_CHAOS\<^sub>S\<^sub>K\<^sub>I\<^sub>P div_free_CHAOS div_free_RUN div_free_DF div_free_DF\<^sub>S\<^sub>K\<^sub>I\<^sub>P
                    divergence_refine_def)

definition lifelock_free_v2 :: "'a process \<Rightarrow> bool"
  where   "lifelock_free_v2 P \<equiv> CHAOS\<^sub>S\<^sub>K\<^sub>I\<^sub>P UNIV \<sqsubseteq>\<^sub>F\<^sub>D P"

lemma div_free_is_lifelock_free_v2: "lifelock_free_v2 P \<longleftrightarrow> D P = {}"
  using CHAOS\<^sub>S\<^sub>K\<^sub>I\<^sub>P_has_all_failures_Un FD_D F_D_FD div_free_divergence_refine(1) lifelock_free_v2_def
  by blast

lemma lifelock_free_is_lifelock_free_v2: "lifelock_free P \<Longrightarrow> lifelock_free_v2 P"
  by (simp add: FD_D div_free_divergence_refine(2) div_free_is_lifelock_free_v2 lifelock_free_def)

corollary deadlock_free_v2_is_lifelock_free_v2: "deadlock_free_v2 P \<Longrightarrow> lifelock_free_v2 P"
  by (simp add: deadlock_free_v2_implies_div_free div_free_is_lifelock_free_v2)

section \<open>New laws\<close>

lemma non_terminating_seq: "non_terminating P \<Longrightarrow> (P `;` Q) = P"
  apply(auto simp add: non_terminating_is_right Process_eq_spec D_seq F_seq F_T is_processT7)
      using process_charn apply blast
    using process_charn apply blast
   using F_T is_processT5_S2a apply fastforce
  using D_T front_tickFree_Nil by blast

lemma non_terminating_inter: "non_terminating P \<Longrightarrow> lifelock_free_v2 Q \<Longrightarrow> non_terminating (P \<lbrakk>C\<rbrakk> Q)"
  apply(auto simp add: non_terminating_is_right div_free_is_lifelock_free_v2 T_sync)
  apply (metis equals0D ftf_syn1 ftf_syn21 insertI1 tickFree_def)
  apply (meson NT_ND is_processT7_S tickFree_append)
  by (metis D_T empty_iff ftf_syn1 ftf_syn21 insertI1 tickFree_def)

end