theory func_cor_OSMboxAccept
  imports func_cor_lemma
begin

lemma OSMboxAccept_pre_stable:" stable (OSMboxAccept_pre t) (OSMboxAccept_rely t) "
  by(simp add:OSMboxAccept_pre_def OSMboxAccept_rely_def stable_def gvars_conf_stable_def gvars_conf_def)

lemma OSMboxAccept_pre_stable1:" stable (OSMboxAccept_pre t \<inter> \<lbrace>pevent \<in> \<acute>OSMailBoxs\<rbrace>) (OSMboxAccept_rely t) "
  by(simp add:OSMboxAccept_pre_def OSMboxAccept_rely_def stable_def gvars_conf_stable_def gvars_conf_def)

lemma OSMboxAccept_post_stable:" stable (OSMboxAccept_post t) (OSMboxAccept_rely t) "
  by(simp add:OSMboxAccept_post_def OSMboxAccept_rely_def stable_def)

lemma mylist_nhd_in_tl: "dist_list l \<Longrightarrow> hd l \<notin> set (tl l) "
  by (meson dist_hd_nin_tl distinct_conv_nth)

lemma mylist_hd_in_list: "l \<noteq> [] \<Longrightarrow>hd l \<in> set l"
  by auto

lemma OSMboxAccept_satRG_h1:"
   \<turnstile>\<^sub>I (W\<acute>get_msg := \<acute>get_msg(t := msgPtr (\<acute>OSMailbox_info pevent));;
               \<acute>OSMailbox_info := \<acute>OSMailbox_info
               (pevent :=
                  msgPtr_update Map.empty
                   (\<acute>OSMailbox_info
                     pevent))) sat\<^sub>p [OSMboxAccept_pre t \<inter> \<lbrace>pevent \<in> \<acute>OSMailBoxs\<rbrace> \<inter> \<lbrace>\<acute>cur = Some t\<rbrace> \<inter>
                                      {V}, {(x, y). x = y}, UNIV, \<lbrace>\<acute>(Pair V) \<in> OSMboxAccept_guar t\<rbrace> \<inter> OSMboxAccept_post t]"

apply(case_tac "OSMboxAccept_pre t \<inter> \<lbrace>pevent \<in> \<acute>OSMailBoxs\<rbrace> \<inter> \<lbrace>\<acute>cur = Some t\<rbrace> \<inter>
                                      {V} = {}")
   apply auto
     apply(simp add:Emptyprecond)
    apply(simp add:Emptyprecond)
   apply(simp add:Emptyprecond)

  apply(rule Seq[where mid = "{V\<lparr>get_msg := (get_msg V)(t := msgPtr (OSMailbox_info V pevent))\<rparr>}"])
   apply(rule Basic)
      apply auto
    apply(simp add:stable_id2)
  apply(simp add:stable_id2)
  apply(rule Basic)
  apply auto
     apply(simp add:OSMboxAccept_pre_def OSMboxAccept_guar_def gvars_conf_stable_def gvars_conf_def)
  apply auto
  apply(simp add:inv_def inv_cur_def inv_thd_waitq_def)
      apply auto[1]
     apply(simp add:lvars_nochange_def)
    apply(simp add:OSMboxAccept_post_def inv_def inv_cur_def inv_thd_waitq_def OSMboxAccept_pre_def)
    apply auto
  apply(simp add:stable_id2)
  apply(simp add:stable_id2)
  done

lemma OSMboxAccept_satRG: "\<Gamma> (OSMboxAccept t pevent) \<turnstile> OSMboxAccept_RGCond t"
  apply (simp add:Evt_sat_RG_def)
  apply (simp add:OSMboxAccept_def OSMboxAccept_RGCond_def)
  apply(simp add:body_def Pre\<^sub>f_def Post\<^sub>f_def guard_def
                 Rely\<^sub>f_def Guar\<^sub>f_def getrgformula_def)
  apply(unfold stm_def)
  apply (rule BasicEvt)
     apply(simp add:body_def guard_def)
    apply(rule Await)
      apply(simp add:OSMboxAccept_pre_stable1)
     apply(simp add: OSMboxAccept_post_stable)
    apply auto
         apply(rule Await)
    apply(simp add:stable_id2)
  apply(simp add:stable_id2)
    apply auto
apply(case_tac "{V} \<inter> {Va}={}")
   apply auto
     apply(simp add:Emptyprecond)      (* satRG_h1*)
    apply(simp add:OSMboxAccept_satRG_h1)
   apply(simp add:OSMboxAccept_pre_stable)
  apply(simp add:OSMboxAccept_guar_def)
  done

end


theory SmallStep
imports
  "~~/src/HOL/IMP/Star"
  "~~/src/HOL/Library/While_Combinator"
  Stack CFG
begin

  definition lift :: "(valuation \<Rightarrow> memory \<hookrightarrow> memory) \<Rightarrow> state \<hookrightarrow> state"
    where "lift f \<equiv> \<lambda>(stk,\<gamma>,\<mu>). do {
      let ev = comp_evs stk \<gamma>;
      \<mu> \<leftarrow> f ev \<mu>;
      return (stk,\<gamma>,\<mu>)
    }"

  definition lift' :: "(valuation \<Rightarrow> memory \<hookrightarrow> 'a) \<Rightarrow> state \<hookrightarrow> 'a"
    where "lift' f \<equiv> \<lambda>(stk,\<gamma>,\<mu>). f (comp_evs stk \<gamma>) \<mu>"

  definition to_rval' :: "state \<Rightarrow> res \<hookrightarrow> val" where
    "to_rval' \<equiv> \<lambda>(stk,\<gamma>,\<mu>) r. to_rval \<mu> r"

  definition to_bool_aux' :: "state \<Rightarrow> val \<hookrightarrow> bool" where
    "to_bool_aux' \<equiv> \<lambda>(stk,\<gamma>,\<mu>) r. to_bool_aux \<mu> r"

  definition eval_exp' :: "state \<Rightarrow> exp \<hookrightarrow> res" where
    "eval_exp' \<equiv> \<lambda>s e. lift' (\<lambda>ev \<mu>. eval_exp ev \<mu> e) s"

  lemma eval_exp'_alt: "eval_exp' = (\<lambda>(stk,\<gamma>,\<mu>) e. eval_exp (comp_evs stk \<gamma>) \<mu> e)"
    by (auto simp: eval_exp'_def lift'_def)

  primrec basic_effect :: "bcom \<Rightarrow> valuation \<Rightarrow> memory \<hookrightarrow> memory" where
    "basic_effect (bcom.Assign l r) ev \<mu> = do {
      l \<leftarrow> eval_exp ev \<mu> l;
      l \<leftarrow> to_lval l;
      r \<leftarrow> eval_exp ev \<mu> r;
      r \<leftarrow> to_rval \<mu> r;
      \<mu> \<leftarrow> eset (l_addr l) r \<mu>;
      return \<mu>
    }"
  | "basic_effect (bcom.Malloc e1 T e2) ev \<mu> = do {
      e1 \<leftarrow> eval_exp ev \<mu> e1;
      e1 \<leftarrow> to_lval e1;
      e2 \<leftarrow> eval_exp ev \<mu> e2;
      e2 \<leftarrow> to_int \<mu> e2;
      let e2 = sint e2;
      assert (e2\<ge>0) overflow_error;  (* Note: calloc asserts positive size *)
      (addr,\<mu>) \<leftarrow> calloc T False (nat e2) \<mu>;
      \<mu> \<leftarrow> eset (l_addr e1) (val.Addr addr) \<mu>;
      return \<mu>
    }"
  | "basic_effect (bcom.Free e) ev \<mu> = do {
      e \<leftarrow> eval_exp ev \<mu> e;
      e \<leftarrow> to_ptr \<mu> e;
      \<mu> \<leftarrow> free False e \<mu>;
      return \<mu>
    }"

  term eval_exp

  definition lookup_fun :: "program \<Rightarrow> fname \<hookrightarrow> fun_decl" where
    "lookup_fun p f \<equiv> elookup (\<lambda>_. type_error) (mk_fun_map p) f"

  definition eval_args :: "exp list \<Rightarrow> valuation \<Rightarrow> memory \<hookrightarrow> val list" where
    "eval_args args ev \<mu> \<equiv> emap (eval_exp ev \<mu> #> to_rval \<mu>) args"

  abbreviation "eval_args' args \<equiv> lift' (eval_args args)"

  primrec func_effect :: "program \<Rightarrow> fcom \<Rightarrow> state \<hookrightarrow> state" where
    "func_effect p (fcom.Return e) s = do {
      e \<leftarrow> eval_exp' s e;
      op_return (Some e) s
    }"
  | "func_effect p (fcom.Returnv) s = do {
      op_return None s
    }"
  | "func_effect p (fcom.Callfun e f args) s = do {
      fd \<leftarrow> lookup_fun p f;
      e \<leftarrow> eval_exp' s e;
      e \<leftarrow> to_lval e;
      args \<leftarrow> eval_args' args s;
      op_call (Some e) fd args s
    }"
  | "func_effect p (fcom.Callfunv f args) s = do {
      fd \<leftarrow> lookup_fun p f;
      args \<leftarrow> eval_args' args s;
      op_call None fd args s
    }"

  primrec effect :: "program \<Rightarrow> effect \<Rightarrow> state \<hookrightarrow> state" where
    "effect p (effect.Basic c) s = lift (basic_effect c) s"
  | "effect p (effect.Func c) s = func_effect p c s"
  | "effect p (effect.Skip) s = return s"

  primrec eval_guard :: "guard \<Rightarrow> state \<hookrightarrow> bool" where
    "eval_guard (guard.Pos e) s = do {
      b \<leftarrow> eval_exp' s e;
      b \<leftarrow> (to_rval' s #> to_bool_aux' s) b;
      return b
    }"
  | "eval_guard (guard.Neg e) s = do {
      b \<leftarrow> eval_exp' s e;
      b \<leftarrow> (to_rval' s #> to_bool_aux' s) b;
      return (\<not>b)
    }"

  fun com_of :: "state \<Rightarrow> com option" where
    "com_of ((_,c,_,_)#_,_,_) = Some c"
  | "com_of _ = None"

  fun upd_com :: "com \<Rightarrow> state \<Rightarrow> state" where
    "upd_com c ((fd,_,l,r)#stk,\<gamma>,\<mu>) = ((fd,c,l,r)#stk,\<gamma>,\<mu>)"
  | "upd_com c ([],_,_) = undefined"

  inductive small_step :: "program \<Rightarrow> state \<Rightarrow> state ce \<Rightarrow> bool" for p where
    ss_effect: "\<lbrakk> com_of s = Some c; cfg c (label.Effect e) c'; s' = effect p e (upd_com c' s) \<rbrakk> \<Longrightarrow> small_step p s s'"
  | ss_guard: "\<lbrakk> com_of s = Some c; cfg c (label.Guard g) c'; eval_guard g s = return True \<rbrakk> \<Longrightarrow> small_step p s (return ((upd_com c' s)))"
  | ss_failed_guard: "\<lbrakk> com_of s = Some c; cfg c (label.Guard g) c'; eval_guard g s = EAssert e \<rbrakk> \<Longrightarrow> small_step p s (EAssert e)"
  | ss_return_void: "\<lbrakk> com_of s = Some com.Skip; s' = op_return None s \<rbrakk> \<Longrightarrow> small_step p s s'"

  lemma [simp]: "is_nonterm (eset (l1 o\<^sub>l l2) b a) \<longleftrightarrow> is_nonterm (eget l1 a) \<or>
    (\<exists>y. is_res (eget l1 a) y \<and> (is_nonterm (eset l2 b y) \<or> (\<exists>ya. is_res (eset l2 b y) ya \<and>
        is_nonterm (eset l1 ya a))))"
    unfolding ecompose_def
    by auto

  lemma no_nonterm_espec_conv: "\<not>is_nonterm m \<longleftrightarrow> e_spec (\<lambda>_. True) (\<lambda>_. True) False m"
    by (simp add: pw_espec_iff)

  lemma [simp]: "\<not>is_nonterm (eget (l_C1_lens isC theC C e) v)"
    unfolding l_C1_lens_def by auto

  lemma [simp]: "\<not>is_nonterm (eset (l_C1_lens isC theC C e) b a)"
    unfolding l_C1_lens_def by auto

  lemma [simp]: "\<not>is_nonterm (cnv_array_to_eptr \<mu> addr)"
    by (auto simp: cnv_array_to_eptr_def split: prod.splits)

  lemma [simp]: "\<not>is_nonterm (to_rval \<mu> v)" by (cases v) (auto)

  lemma [simp]: "\<not>is_nonterm (to_int_aux x)"
    by (cases x) auto

  lemma [simp]: "\<not>is_nonterm (to_bool_aux \<mu> x)"
    by (cases x) auto

  lemma [simp]: "\<not>is_nonterm (to_int \<mu> x)"
    by (auto simp: to_int_def)

  lemma [simp]: "\<not>is_nonterm (ref_op x)"
    by (cases x) auto

  lemma [simp]: "\<not>is_nonterm (elookup E m x)"
    by (auto simp: elookup_def split: option.split)

  lemma [simp]: "\<not>is_nonterm (memb_op \<mu> name r)"
    by (cases "(name,r)" rule: memb_op.cases)
    (auto simp: memb_addr_def l_raw_mem_def l_nth_def
      memb_subpath_def Let_def)

  lemma [simp]: "\<not>is_nonterm (to_ptr \<mu> v)"
    by (auto simp: to_ptr_def split: val.splits)

  lemma [simp]: "\<not>is_nonterm (deref_op ev y)"
    by (auto simp: deref_op_def split: val.splits)

  lemma [simp]: "\<not>is_nonterm (membp_op \<mu> name r)"
    by (auto simp: memb_addr_def l_raw_mem_def l_nth_def
      memb_subpath_def Let_def membp_op_def)

  lemma [simp]: "\<not>is_nonterm (eval1 ev op1 x1)"
    apply (induction op1)
    apply (auto split: option.splits
      simp: un_arith_op_def iop_uminus_def iop_Not_def iop_BNot_def)
    done

  lemma [simp]: "\<not>is_nonterm (index_addr \<mu> i addr)"
    by (auto simp: index_addr_def l_raw_mem_def l_nth_def
      index_subpath_def resolve_subpath_array_def l_last_def l_butlast_def Let_def
        split: split_if_asm prod.splits)

  lemma [simp]: "\<not>is_nonterm (plus_op \<mu> x1 x2)"
    apply (cases "(x1,x2)" rule: plus_op.cases)
    apply (auto simp: iop_plus_def)
    done

  lemma [simp]: "\<not>is_nonterm (minus_op \<mu> x1 x2)"
    apply (cases "(x1,x2)" rule: minus_op.cases)
    apply (auto simp: l_raw_mem_def l_nth_def
      index_subpath_def resolve_subpath_array_def l_last_def l_butlast_def Let_def
        iop_minus_def diff_addr_def diff_subpath_def
        split: split_if_asm)
    done

  lemma [simp]: "\<not>is_nonterm (index_op ev x1 x2)"
    by (auto simp: index_op_def split: res.splits val.splits)

  lemma [simp]: "\<not>is_nonterm (compare_addr \<mu> x1 x2)"
    by (auto simp: compare_addr_def split: prod.splits list.splits subscript.splits)

  lemma [simp]: "\<not>is_nonterm (less_op \<mu> x1 x2)"
    apply (induction x1 x2 rule: less_op.induct)
    apply (auto simp: addr_less_def iop_less_def split: ptr_comp_res.splits)
    done

  lemma [simp]: "\<not>is_nonterm (le_op \<mu> x1 x2)"
    apply (induction x1 x2 rule: le_op.induct)
    apply (auto simp: addr_leq_def iop_le_def split: ptr_comp_res.splits)
    done

  lemma [simp]: "\<not>is_nonterm (eq_op \<mu> x1 x2)"
    apply (induction x1 x2 rule: eq_op.induct)
    apply (auto simp: iop_eq_def addr_eq_def split: split_if_asm ptr_comp_res.splits)
    done

  lemma [simp]: "\<not>is_nonterm (eval2 ev op2 x1 x2)"
    apply (induction op2)
    apply (auto split: option.splits
      simp: rvop2_def bin_arith_op_def
      simp: iop_mult_def iop_div_def iop_mod_def iop_less_def iop_le_def iop_eq_def
      iop_And_def iop_Or_def iop_BAnd_def iop_BOr_def iop_BXor_def)
    done

  lemma [simp]: "\<not>is_nonterm (eval_exp ev \<mu> e)"
    apply (induction e)
    apply auto
    done

  lemma [simp]: "\<not>is_nonterm (to_lval x)"
    by (cases x) (auto)

  lemma [simp]: "\<not>is_nonterm (free allow_static addr \<mu>)"
    by (auto simp: Let_def free_def raw_free_def split: prod.splits)

  lemma [simp]: "\<not>is_nonterm (alloc T static \<mu>)"
    by (auto simp: alloc_def raw_alloc_def)

  lemma [simp]: "\<not>is_nonterm (calloc T static n \<mu>)"
    by (auto simp: calloc_def raw_alloc_def)

  lemma effect_term[simp]: "\<not>is_nonterm (effect p e s)"
    apply (cases e; simp)
    apply (rename_tac be; case_tac be; auto simp add: lift_def Let_def split: prod.splits)
    apply (rename_tac fe; case_tac fe; auto simp: eval_exp'_def
      simp: op_return_def lookup_fun_def Let_def assign_return_value_def
      simp: destroy_frame_def to_rval'_def op_call_def create_frame_def
        alloc_params_def cp_alloc_def raw_alloc_def alloc_vdecls_def lift'_def eval_args_def
      dest!: efold_nontermD emap_nontermD
      split: prod.splits option.splits)
    done

  fun is_empty_stack :: "state \<Rightarrow> bool" where
    "is_empty_stack (stk,_) \<longleftrightarrow> stk=[]"

  lemma eval_guard_conv: "eval_guard (guard.Pos b) s = return bv
      \<longleftrightarrow> eval_guard (guard.Neg b) s = return (\<not>bv)"
    apply (simp add: eval_guard_def)
    apply (simp split: Error_Monad.bind_split)
    done

  lemma small_step_stuck_empty_aux:
    "\<exists>s'. small_step p ((fd,c,l,r)#stk,\<gamma>,\<mu>) s'" (is "\<exists>_. small_step p ?s _")
  proof (cases c rule: cfg_outgoing_cases[case_names Skip Effect Guard])
    case Skip thus ?thesis by (auto intro!: ss_return_void)
  next
    case (Effect e c')
    hence C: "cfg c (label.Effect e) c'"
      by (auto simp: cfg_outgoing_def)
    from ss_effect[OF _ C refl] show ?thesis by force
  next
    case (Guard b c1 c2)
    hence CP: "cfg c (label.Guard (guard.Pos b)) c1" and
      CN: "cfg c (label.Guard (guard.Neg b)) c2"
      by (auto simp: cfg_outgoing_def)

    show ?thesis proof (cases "eval_guard (guard.Pos b) ?s")
      case (return bv)
      show ?thesis proof (cases bv)
        case True
        from ss_guard[OF _ CP return[simplified True]]
        show ?thesis by auto
      next
        case False
        with return have "eval_guard (guard.Neg b) ?s = return True"
          by (simp add: eval_guard_conv del: eval_guard.simps)
        from ss_guard[OF _ CN this]
        show ?thesis by auto
      qed
    next
      case (EAssert e)
      from ss_failed_guard[OF _ CP this]
      show ?thesis by auto
    next
      case ENonterm hence "is_nonterm (eval_guard (guard.Pos b) ?s)" by simp
      hence False by (auto simp: eval_guard_def eval_exp'_alt to_rval'_def to_bool_aux'_def)
      thus ?thesis ..
    qed
  qed

  theorem ss_stuck_empty: "\<not>(\<exists>s'. small_step p s s') \<longleftrightarrow> is_empty_stack s"
    -- \<open>Execution only gets stuck at empty stack\<close>
    apply (cases s rule: com_of.cases)
    apply (auto elim: small_step.cases simp: small_step_stuck_empty_aux)
    done

  corollary ss_imp_no_empty: "small_step \<pi> s s' \<Longrightarrow> \<not>is_empty_stack s"
    using ss_stuck_empty[of \<pi> s] by auto

  definition ss_step :: "program \<Rightarrow> state \<hookrightarrow> state" where
    "ss_step p s \<equiv> do {
      let c = the (com_of s);
      if c=com.Skip then
        op_return None s
      else
        case cfg_step c of
          edge.Effect e c' \<Rightarrow> do {
            let s = upd_com c' s;
            s \<leftarrow> effect p e s;
            return s
          }
        | (edge.Cond b c1 c2) \<Rightarrow> do {
            b \<leftarrow> eval_exp' s b;
            b \<leftarrow> (to_rval' s #> to_bool_aux' s) b;
            if b then return (upd_com c1 s) else return (upd_com c2 s)
          }
    }"

  lemma [simp]: "eval_exp' s e \<noteq> ENonterm"
    by (simp add: pw_nt_iff eval_exp'_alt split: prod.splits)

  lemma [simp]: "to_rval' s v \<noteq> ENonterm"
    by (simp add: pw_nt_iff to_rval'_def split: prod.splits)

  lemma [simp]: "to_int_aux v \<noteq> ENonterm"
    by (simp add: pw_nt_iff split: prod.splits)

  lemma [simp]: "to_bool_aux \<mu> v \<noteq> ENonterm"
    by (simp add: pw_nt_iff split: prod.splits)

  lemma small_step_iff_ss_step: "\<not>is_empty_stack s \<Longrightarrow> small_step p s s' \<longleftrightarrow> ss_step p s = s'"
    apply (rule iffI)
    apply (auto elim!: cfg2step small_step.cases) []
    apply (auto simp: ss_step_def) []
    apply (simp add: ss_step_def pw_eq_iff; metis) []
    apply (simp add: ss_step_def pw_eq_iff; metis) []
    apply (simp add: ss_step_def pw_eq_iff; metis) []
    apply (simp add: ss_step_def pw_eq_iff; metis) []
    apply (auto simp: ss_step_def) []

    apply hypsubst
    apply (thin_tac "s'=_")
    apply (cases s rule: com_of.cases; simp)
    apply (clarsimp simp: ss_step_def
      simp del: cfg_step.simps
      split: edge.splits; safe)
    apply (auto simp del: cfg_step.simps intro: ss_return_void) []
    apply (auto simp del: cfg_step.simps intro: ss_effect step2cfg1) []
    apply (auto simp del: cfg_step.simps intro: ss_return_void) []

    apply (drule (1) step2cfg2; clarsimp)
    apply (auto simp: small_step.simps to_bool_aux'_def split: Error_Monad.bind_splits)
    done

  export_code ss_step checking SML

  subsection \<open>Executions\<close>
  context fixes p :: program begin

  text \<open>We lift our definition of small step to state option in order to be able to take
    more than one step in the semantics.\<close>
  inductive
    small_step' :: "(state) ce \<Rightarrow> (state) ce \<Rightarrow> bool"
  where
    "small_step p s s' \<Longrightarrow> small_step' (return s) s'"

  abbreviation
    small_steps :: "(state) ce \<Rightarrow> (state) ce \<Rightarrow> bool"
      where "small_steps x y == star small_step' x y"

  text \<open>A state is considered final if the stack in that state is empty or if it's an error state.\<close>
  fun is_term :: "state ce \<Rightarrow> bool" where
    "is_term (return s) = is_empty_stack s"
  | "is_term _ = True"

  text \<open>Final states are exactly the states where the semantics is stuck\<close>
  lemma is_term_no_step: "is_term s \<longleftrightarrow> \<not>(\<exists>s'. small_step' s s')"
    apply (cases s)
    using ss_stuck_empty[symmetric]
    apply (auto simp: small_step'.simps)
    done

  lemma not_is_term_conv: "\<not>is_term ss \<longleftrightarrow> (\<exists>s. ss=return s \<and> \<not>is_empty_stack s)"
    apply (cases ss) by auto

  definition yields :: "state \<Rightarrow> state ce \<Rightarrow> bool"
    -- \<open>Final state of execution from start state\<close>
  where
    "yields s s' \<equiv> small_steps (return s) s' \<and> is_term s'"

  definition terminates :: "state \<Rightarrow> bool" where
    "terminates s \<equiv> \<exists>s'. yields s s'"

  partial_function (error) interp where "
    interp s = (
      if is_term (return s) then
        return s
      else do {
        s \<leftarrow> ss_step p s;
        interp s
      }
    )"

  lemmas [code] = interp.simps

  lemma [simp]: "small_steps (EAssert e) s' \<longleftrightarrow> s'=EAssert e"
    by (auto elim: star.cases simp: small_step'.simps)

  lemma [simp]: "\<not>is_nonterm (op_return v s)"
    by (auto simp:
      simp: op_return_def Let_def assign_return_value_def
      simp: destroy_frame_def to_rval'_def
      dest!: efold_nontermD
      split: prod.splits option.splits edge.splits)

  lemma [simp]: "\<not>is_nonterm (ss_step p s)"
    by (auto simp: ss_step_def eval_exp'_alt
      simp: lookup_fun_def Let_def
      simp:  to_rval'_def op_call_def create_frame_def
        alloc_params_def cp_alloc_def raw_alloc_def alloc_vdecls_def
        to_bool_aux'_def
      split: prod.splits option.splits edge.splits)

  lemma [simp]: "ss_step p s \<noteq> ENonterm"
    by (simp add: pw_nt_iff)

  lemma yields_interp_aux: "yields s s' \<Longrightarrow> interp s = s'"
  proof -
    assume "yields s s'"
    hence "small_steps (return s) s'" "is_term s'" unfolding yields_def by auto
    thus "interp s = s'"
      apply (induction "(return s)::_ ce" s' arbitrary: s rule: star.induct)
      apply (subst interp.simps; simp)
      apply (subst interp.simps; auto simp: small_step'.simps)
      apply (meson is_empty_stack.simps is_term.simps(1) is_term_no_step small_step'.intros)
      apply (subst (asm) small_step_iff_ss_step; simp)
      apply (auto split: Error_Monad.bind_splits)
      done
  qed

  lemma yields_interp: "terminates s \<Longrightarrow> yields s s' \<longleftrightarrow> s' = interp s"
    unfolding terminates_def
    by (auto dest: yields_interp_aux)

  lemma terminates_empty: "is_empty_stack s \<Longrightarrow> terminates s"
    unfolding terminates_def yields_def
    by auto

  lemma terminates_step_err:
    "\<lbrakk>\<not> is_empty_stack s; ss_step p s = EAssert e\<rbrakk>
    \<Longrightarrow> terminates s"
    unfolding terminates_def yields_def
    apply (auto simp: small_step_iff_ss_step[symmetric])
    using SmallStep.small_step'.intros is_term.simps(2) by blast

  lemma terminates_step_ret:
    "\<lbrakk>\<not> is_empty_stack s; ss_step p s = return s'; terminates s'\<rbrakk>
    \<Longrightarrow> terminates s"
    unfolding terminates_def yields_def
    apply (auto simp: small_step_iff_ss_step[symmetric])
    by (meson small_step'.intros star.step)

  lemma nonterm_interp: "\<not>terminates s \<Longrightarrow> interp s = ENonterm"
  proof (rule ccontr)
    {
      fix t
      assume "interp s = ETerm t"
      hence "local.terminates s"
        apply (rule interp.raw_induct[rotated])
        apply (auto
          split: split_if_asm Error_Monad.bind_splits
          simp: terminates_empty terminates_step_err terminates_step_ret)
        done
    } moreover assume "\<not> local.terminates s" "local.interp s \<noteq> ENonterm"
    ultimately show False by (cases "local.interp s") auto
  qed

  lemma small_steps_preserve_nonterm:
    assumes "\<not>is_nonterm s"
    assumes "small_steps s s'"
    shows "\<not>is_nonterm s'"
    using assms(2,1)
    apply (induction rule: star.induct)
    by (auto simp: small_step'.simps small_step.simps)

  lemma yields_no_nonterm: "yields s s' \<Longrightarrow> \<not>is_nonterm s'"
    unfolding yields_def using small_steps_preserve_nonterm[of "return s" s']
    by auto

  lemma interp_nonterm: "interp s = ENonterm \<Longrightarrow> \<not>terminates s"
    using yields_no_nonterm[of s]
    by (auto simp: terminates_def pw_nt_iff dest: yields_interp_aux)

  theorem interp_correct:
    "interp s = ENonterm \<longleftrightarrow> \<not>terminates s"
    "interp s \<noteq> ENonterm \<longleftrightarrow> yields s (interp s)"
    using nonterm_interp[of s] interp_nonterm[of s]
    apply blast
    by (metis nonterm_interp yields_interp_aux yields_no_nonterm
      is_nonterm.simps(1) terminates_def)

end

export_code interp checking SML

end


subsection \<open>Graph Rewriting\<close>

theory
  Rewrites
imports
  Stuttering
begin

fun replace_usages :: "ID \<Rightarrow> ID \<Rightarrow> IRGraph \<Rightarrow> IRGraph" where
  "replace_usages nid nid' g = replace_node nid (RefNode nid', stamp g nid') g"

lemma replace_usages_effect:
  assumes "g' = replace_usages nid nid' g"
  shows "kind g' nid = RefNode nid'"
  using assms replace_node_lookup replace_usages.simps
  by (metis IRNode.distinct(2755))

lemma replace_usages_changeonly:
  assumes "nid \<in> ids g"
  assumes "g' = replace_usages nid nid' g"
  shows "changeonly {nid} g g'"
  using assms unfolding replace_usages.simps
  by (metis add_changed add_node_def replace_node_def)

lemma replace_usages_unchanged:
  assumes "nid \<in> ids g"
  assumes "g' = replace_usages nid nid' g"
  shows "unchanged (ids g - {nid}) g g'"
  using assms unfolding replace_usages.simps
  using assms(2) disjoint_change replace_usages_changeonly by presburger

fun nextNid :: "IRGraph \<Rightarrow> ID" where
  "nextNid g = (Max (ids g)) + 1"

lemma max_plus_one:
  fixes c :: "ID set"
  shows "\<lbrakk>finite c; c \<noteq> {}\<rbrakk> \<Longrightarrow> (Max c) + 1 \<notin> c"
  by (meson Max_gr_iff less_add_one less_irrefl)

lemma ids_finite:
  "finite (ids g)"
  by simp

lemma nextNidNotIn:
  "ids g \<noteq> {} \<longrightarrow> nextNid g \<notin> ids g"
  unfolding nextNid.simps
  using ids_finite max_plus_one by blast

fun bool_to_val_width1 :: "bool \<Rightarrow> Value" where
  "bool_to_val_width1 True = (IntVal 1 1)" |
  "bool_to_val_width1 False = (IntVal 1 0)"

fun constantCondition :: "bool \<Rightarrow> ID \<Rightarrow> IRNode \<Rightarrow> IRGraph \<Rightarrow> IRGraph" where
  "constantCondition val nid (IfNode cond t f) g =
    replace_node nid (IfNode (nextNid g) t f, stamp g nid)
      (add_node (nextNid g) ((ConstantNode (bool_to_val_width1 val)), constantAsStamp (bool_to_val_width1 val)) g)" |
  "constantCondition cond nid _ g = g"

lemma constantConditionTrue:
  assumes "kind g ifcond = IfNode cond t f"
  assumes "g' = constantCondition True ifcond (kind g ifcond) g"
  shows "g', p \<turnstile> (ifcond, m, h) \<rightarrow> (t, m, h)"
proof -
  have ifn: "\<And> c t f. IfNode c t f \<noteq> NoNode"
    by simp
  then have if': "kind g' ifcond = IfNode (nextNid g) t f"
    using assms(1) assms(2) constantCondition.simps(1) replace_node_lookup
    by presburger
  have truedef: "bool_to_val True = (IntVal 32 1)"
    by auto
  from ifn have "ifcond \<noteq> (nextNid g)"
    by (metis assms(1) emptyE ids_some nextNidNotIn)
  moreover have "\<And> c. ConstantNode c \<noteq> NoNode" by simp
  ultimately have "kind g' (nextNid g) = ConstantNode (bool_to_val_width1 True)"
    using add_changed add_node_def assms(1) assms(2) constantCondition.simps(1) not_in_g other_node_unchanged replace_node_def replace_node_lookup singletonD
    by (smt (z3) find_new_kind replace_node_unchanged)
  then have c': "kind g' (nextNid g) = ConstantNode (IntVal 1 1)"
    using truedef by simp
  have "valid_value (IntVal 1 1) (constantAsStamp (IntVal 1 1))"
    unfolding constantAsStamp.simps valid_value.simps
    using nat_numeral by force
  then have "[g', m, p] \<turnstile> nextNid g \<mapsto> IntVal 1 1"
    using ConstantExpr ConstantNode Value.distinct(1) \<open>kind g' (nextNid g) = ConstantNode (bool_to_val_width1 True)\<close> encodeeval_def truedef
    by (metis bool_to_val_width1.simps(1) wf_value_def)
  from if' c' show ?thesis using IfNode
    by (metis (no_types, opaque_lifting) val_to_bool.simps(1) \<open>[g',m,p] \<turnstile> nextNid g \<mapsto> IntVal 1 1\<close> encodeeval_def zero_neq_one)
qed

lemma constantConditionFalse:
  assumes "kind g ifcond = IfNode cond t f"
  assumes "g' = constantCondition False ifcond (kind g ifcond) g"
  shows "g', p \<turnstile> (ifcond, m, h) \<rightarrow> (f, m, h)"
proof -
  have ifn: "\<And> c t f. IfNode c t f \<noteq> NoNode"
    by simp
  then have if': "kind g' ifcond = IfNode (nextNid g) t f"
    by (metis assms(1) assms(2) constantCondition.simps(1) replace_node_lookup)
  have falsedef: "bool_to_val False = (IntVal 32 0)"
    by auto
  from ifn have "ifcond \<noteq> (nextNid g)"
    by (metis assms(1) equals0D ids_some nextNidNotIn)
  moreover have "\<And> c. ConstantNode c \<noteq> NoNode" by simp
  ultimately have "kind g' (nextNid g) = ConstantNode (bool_to_val_width1 False)"
    by (smt (z3) add_changed add_node_def assms(1) assms(2) constantCondition.simps(1) find_new_kind not_in_g other_node_unchanged replace_node_def singletonD)
  then have c': "kind g' (nextNid g) = ConstantNode (IntVal 1 0)"
    using falsedef by simp
  have "valid_value (IntVal 1 0) (constantAsStamp (IntVal 1 0))"
    unfolding constantAsStamp.simps valid_value.simps
    using nat_numeral by force
  then have "[g', m, p] \<turnstile> nextNid g \<mapsto> IntVal 1 0"
    by (meson ConstantExpr ConstantNode c' encodeeval_def wf_value_def)
  from if' c' show ?thesis using IfNode
    by (metis (no_types, opaque_lifting) val_to_bool.simps(1) \<open>[g',m,p] \<turnstile> nextNid g \<mapsto> IntVal 1 0\<close> encodeeval_def)
qed

lemma diff_forall:
  assumes "\<forall>n\<in>ids g - {nid}. cond n"
  shows "\<forall>n. n \<in> ids g \<and> n \<notin> {nid} \<longrightarrow> cond n"
  by (meson Diff_iff assms)

lemma replace_node_changeonly:
  assumes "g' = replace_node nid node g"
  shows "changeonly {nid} g g'"
  using assms replace_node_unchanged
  unfolding changeonly.simps using diff_forall
  by (metis add_changed add_node_def changeonly.simps replace_node_def)

lemma add_node_changeonly:
  assumes "g' = add_node nid node g"
  shows "changeonly {nid} g g'"
  by (metis Rep_IRGraph_inverse add_node.rep_eq assms replace_node.rep_eq replace_node_changeonly)

lemma constantConditionNoEffect:
  assumes "\<not>(is_IfNode (kind g nid))"
  shows "g = constantCondition b nid (kind g nid) g"
  using assms apply (cases "kind g nid")
  using constantCondition.simps
  apply presburger+
  apply (metis is_IfNode_def)
  using constantCondition.simps
  by presburger+

lemma constantConditionIfNode:
  assumes "kind g nid = IfNode cond t f"
  shows "constantCondition val nid (kind g nid) g =
    replace_node nid (IfNode (nextNid g) t f, stamp g nid)
     (add_node (nextNid g) ((ConstantNode (bool_to_val_width1 val)), constantAsStamp (bool_to_val_width1 val)) g)"
  using constantCondition.simps
  by (simp add: assms)

lemma constantCondition_changeonly:
  assumes "nid \<in> ids g"
  assumes "g' = constantCondition b nid (kind g nid) g"
  shows "changeonly {nid} g g'"
proof (cases "is_IfNode (kind g nid)")
  case True
  have "nextNid g \<notin> ids g"
    using nextNidNotIn by (metis emptyE)
  then show ?thesis using assms
    using replace_node_changeonly add_node_changeonly unfolding changeonly.simps
    using True constantCondition.simps(1) is_IfNode_def
    by (metis (no_types, lifting) insert_iff)
next
  case False
  have "g = g'"
    using constantConditionNoEffect
    using False assms(2) by blast
  then show ?thesis by simp
qed

lemma constantConditionNoIf:
  assumes "\<forall>cond t f. kind g ifcond \<noteq> IfNode cond t f"
  assumes "g' = constantCondition val ifcond (kind g ifcond) g"
  shows "\<exists>nid' .(g m p h \<turnstile> ifcond \<leadsto> nid') \<longleftrightarrow> (g' m p h \<turnstile> ifcond \<leadsto> nid')"
proof -
  have "g' = g"
    using assms(2) assms(1)
    using constantConditionNoEffect
    by (metis IRNode.collapse(11))
  then show ?thesis by simp
qed

lemma constantConditionValid:
  assumes "kind g ifcond = IfNode cond t f"
  assumes "[g, m, p] \<turnstile> cond \<mapsto> v"
  assumes "const = val_to_bool v"
  assumes "g' = constantCondition const ifcond (kind g ifcond) g"
  shows "\<exists>nid' .(g m p h \<turnstile> ifcond \<leadsto> nid') \<longleftrightarrow> (g' m p h \<turnstile> ifcond \<leadsto> nid')"
proof (cases "const")
  case True
  have ifstep: "g, p \<turnstile> (ifcond, m, h) \<rightarrow> (t, m, h)"
    by (meson IfNode True assms(1) assms(2) assms(3) encodeeval_def)
  have ifstep': "g', p \<turnstile> (ifcond, m, h) \<rightarrow> (t, m, h)"
    using constantConditionTrue
    using True assms(1) assms(4) by presburger
  from ifstep ifstep' show ?thesis
    using StutterStep by blast
next
  case False
  have ifstep: "g, p \<turnstile> (ifcond, m, h) \<rightarrow> (f, m, h)"
    by (meson IfNode False assms(1) assms(2) assms(3) encodeeval_def)
  have ifstep': "g', p \<turnstile> (ifcond, m, h) \<rightarrow> (f, m, h)"
    using constantConditionFalse
    using False assms(1) assms(4) by presburger
  from ifstep ifstep' show ?thesis
    using StutterStep by blast
qed

end


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

header{*The n_german Protocol Case Study*}

theory n_german_lemma_on_inv__25 imports n_german_base
begin
section{*All lemmas on causal relation between inv__25 and some rule r*}
lemma n_SendInvEVsinv__25:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_SendInvE  i)" and
a2: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__25  p__Inv3 p__Inv4)"
shows "invHoldForRule s f r (invariants N)" (is "?P1 s \<or> ?P2 s \<or> ?P3 s")
proof -
from a1 obtain i where a1:"i\<le>N\<and>r=n_SendInvE  i" apply fastforce done
from a2 obtain p__Inv3 p__Inv4 where a2:"p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__25  p__Inv3 p__Inv4" apply fastforce done
have "(i=p__Inv4)\<or>(i=p__Inv3)\<or>(i~=p__Inv3\<and>i~=p__Inv4)" apply (cut_tac a1 a2, auto) done
moreover {
  assume b1: "(i=p__Inv4)"
  have "?P1 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i=p__Inv3)"
  have "?P1 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i~=p__Inv3\<and>i~=p__Inv4)"
  have "?P2 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
ultimately show "invHoldForRule s f r (invariants N)" by satx
qed

lemma n_SendInvSVsinv__25:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_SendInvS  i)" and
a2: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__25  p__Inv3 p__Inv4)"
shows "invHoldForRule s f r (invariants N)" (is "?P1 s \<or> ?P2 s \<or> ?P3 s")
proof -
from a1 obtain i where a1:"i\<le>N\<and>r=n_SendInvS  i" apply fastforce done
from a2 obtain p__Inv3 p__Inv4 where a2:"p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__25  p__Inv3 p__Inv4" apply fastforce done
have "(i=p__Inv4)\<or>(i=p__Inv3)\<or>(i~=p__Inv3\<and>i~=p__Inv4)" apply (cut_tac a1 a2, auto) done
moreover {
  assume b1: "(i=p__Inv4)"
  have "?P1 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i=p__Inv3)"
  have "?P1 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i~=p__Inv3\<and>i~=p__Inv4)"
  have "?P2 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
ultimately show "invHoldForRule s f r (invariants N)" by satx
qed

lemma n_SendInvAckVsinv__25:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_SendInvAck  i)" and
a2: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__25  p__Inv3 p__Inv4)"
shows "invHoldForRule s f r (invariants N)" (is "?P1 s \<or> ?P2 s \<or> ?P3 s")
proof -
from a1 obtain i where a1:"i\<le>N\<and>r=n_SendInvAck  i" apply fastforce done
from a2 obtain p__Inv3 p__Inv4 where a2:"p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__25  p__Inv3 p__Inv4" apply fastforce done
have "(i=p__Inv4)\<or>(i=p__Inv3)\<or>(i~=p__Inv3\<and>i~=p__Inv4)" apply (cut_tac a1 a2, auto) done
moreover {
  assume b1: "(i=p__Inv4)"
  have "?P1 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i=p__Inv3)"
  have "?P1 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i~=p__Inv3\<and>i~=p__Inv4)"
  have "?P2 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
ultimately show "invHoldForRule s f r (invariants N)" by satx
qed

lemma n_SendGntSVsinv__25:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_SendGntS  i)" and
a2: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__25  p__Inv3 p__Inv4)"
shows "invHoldForRule s f r (invariants N)" (is "?P1 s \<or> ?P2 s \<or> ?P3 s")
proof -
from a1 obtain i where a1:"i\<le>N\<and>r=n_SendGntS  i" apply fastforce done
from a2 obtain p__Inv3 p__Inv4 where a2:"p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__25  p__Inv3 p__Inv4" apply fastforce done
have "(i=p__Inv4)\<or>(i=p__Inv3)\<or>(i~=p__Inv3\<and>i~=p__Inv4)" apply (cut_tac a1 a2, auto) done
moreover {
  assume b1: "(i=p__Inv4)"
  have "?P3 s"
  apply (cut_tac a1 a2 b1, simp, rule_tac x="(neg (andForm (eqn (IVar (Ident ''ExGntd'')) (Const false)) (eqn (IVar (Field (Para (Ident ''Chan2'') p__Inv3) ''Cmd'')) (Const GntE))))" in exI, auto) done
  then have "invHoldForRule s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i=p__Inv3)"
  have "?P1 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i~=p__Inv3\<and>i~=p__Inv4)"
  have "?P2 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
ultimately show "invHoldForRule s f r (invariants N)" by satx
qed

lemma n_SendGntEVsinv__25:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_SendGntE N i)" and
a2: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__25  p__Inv3 p__Inv4)"
shows "invHoldForRule s f r (invariants N)" (is "?P1 s \<or> ?P2 s \<or> ?P3 s")
proof -
from a1 obtain i where a1:"i\<le>N\<and>r=n_SendGntE N i" apply fastforce done
from a2 obtain p__Inv3 p__Inv4 where a2:"p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__25  p__Inv3 p__Inv4" apply fastforce done
have "(i=p__Inv4)\<or>(i=p__Inv3)\<or>(i~=p__Inv3\<and>i~=p__Inv4)" apply (cut_tac a1 a2, auto) done
moreover {
  assume b1: "(i=p__Inv4)"
  have "?P1 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i=p__Inv3)"
  have "?P3 s"
  apply (cut_tac a1 a2 b1, simp, rule_tac x="(neg (andForm (eqn (IVar (Field (Para (Ident ''Chan2'') p__Inv4) ''Cmd'')) (Const GntS)) (eqn (IVar (Para (Ident ''ShrSet'') p__Inv4)) (Const false))))" in exI, auto) done
  then have "invHoldForRule s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i~=p__Inv3\<and>i~=p__Inv4)"
  have "?P2 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
ultimately show "invHoldForRule s f r (invariants N)" by satx
qed

lemma n_RecvGntSVsinv__25:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_RecvGntS  i)" and
a2: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__25  p__Inv3 p__Inv4)"
shows "invHoldForRule s f r (invariants N)" (is "?P1 s \<or> ?P2 s \<or> ?P3 s")
proof -
from a1 obtain i where a1:"i\<le>N\<and>r=n_RecvGntS  i" apply fastforce done
from a2 obtain p__Inv3 p__Inv4 where a2:"p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__25  p__Inv3 p__Inv4" apply fastforce done
have "(i=p__Inv4)\<or>(i=p__Inv3)\<or>(i~=p__Inv3\<and>i~=p__Inv4)" apply (cut_tac a1 a2, auto) done
moreover {
  assume b1: "(i=p__Inv4)"
  have "?P1 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i=p__Inv3)"
  have "?P1 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i~=p__Inv3\<and>i~=p__Inv4)"
  have "?P2 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
ultimately show "invHoldForRule s f r (invariants N)" by satx
qed

lemma n_RecvGntEVsinv__25:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_RecvGntE  i)" and
a2: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__25  p__Inv3 p__Inv4)"
shows "invHoldForRule s f r (invariants N)" (is "?P1 s \<or> ?P2 s \<or> ?P3 s")
proof -
from a1 obtain i where a1:"i\<le>N\<and>r=n_RecvGntE  i" apply fastforce done
from a2 obtain p__Inv3 p__Inv4 where a2:"p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__25  p__Inv3 p__Inv4" apply fastforce done
have "(i=p__Inv4)\<or>(i=p__Inv3)\<or>(i~=p__Inv3\<and>i~=p__Inv4)" apply (cut_tac a1 a2, auto) done
moreover {
  assume b1: "(i=p__Inv4)"
  have "?P1 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i=p__Inv3)"
  have "?P1 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i~=p__Inv3\<and>i~=p__Inv4)"
  have "?P2 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
ultimately show "invHoldForRule s f r (invariants N)" by satx
qed

lemma n_StoreVsinv__25:
  assumes a1: "\<exists> i d. i\<le>N\<and>d\<le>N\<and>r=n_Store  i d" and
  a2: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__25  p__Inv3 p__Inv4)"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_SendReqESVsinv__25:
  assumes a1: "\<exists> i. i\<le>N\<and>r=n_SendReqES  i" and
  a2: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__25  p__Inv3 p__Inv4)"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_RecvInvAckVsinv__25:
  assumes a1: "\<exists> i. i\<le>N\<and>r=n_RecvInvAck  i" and
  a2: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__25  p__Inv3 p__Inv4)"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_RecvReqVsinv__25:
  assumes a1: "\<exists> i. i\<le>N\<and>r=n_RecvReq N i" and
  a2: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__25  p__Inv3 p__Inv4)"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_SendReqSVsinv__25:
  assumes a1: "\<exists> j. j\<le>N\<and>r=n_SendReqS  j" and
  a2: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__25  p__Inv3 p__Inv4)"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_SendReqEIVsinv__25:
  assumes a1: "\<exists> i. i\<le>N\<and>r=n_SendReqEI  i" and
  a2: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__25  p__Inv3 p__Inv4)"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

end


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

theory n_mutualEx_lemma_on_inv__5 imports n_mutualEx_base
begin
section{*All lemmas on causal relation between inv__5 and some rule r*}
lemma n_TryVsinv__5:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_Try  i)" and
a2: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__5  p__Inv3 p__Inv4)"
shows "invHoldForRule Interp s f r (invariants N)" (is "?P1 s \<or> ?P2 s \<or> ?P3 s")
proof -
from a1 obtain i where a1:"i\<le>N\<and>r=n_Try  i" apply fastforce done
from a2 obtain p__Inv3 p__Inv4 where a2:"p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__5  p__Inv3 p__Inv4" apply fastforce done
have "(i=p__Inv4)\<or>(i=p__Inv3)\<or>(i~=p__Inv3\<and>i~=p__Inv4)" apply (cut_tac a1 a2, auto) done
moreover {
  assume b1: "(i=p__Inv4)"
  have "?P1 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule Interp s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i=p__Inv3)"
  have "?P1 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule Interp s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i~=p__Inv3\<and>i~=p__Inv4)"
  have "?P2 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule Interp s f r (invariants N)" by auto
}
ultimately show "invHoldForRule Interp s f r (invariants N)" by satx
qed

lemma n_CritVsinv__5:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_Crit  i)" and
a2: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__5  p__Inv3 p__Inv4)"
shows "invHoldForRule Interp s f r (invariants N)" (is "?P1 s \<or> ?P2 s \<or> ?P3 s")
proof -
from a1 obtain i where a1:"i\<le>N\<and>r=n_Crit  i" apply fastforce done
from a2 obtain p__Inv3 p__Inv4 where a2:"p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__5  p__Inv3 p__Inv4" apply fastforce done
have "(i=p__Inv4)\<or>(i=p__Inv3)\<or>(i~=p__Inv3\<and>i~=p__Inv4)" apply (cut_tac a1 a2, auto) done
moreover {
  assume b1: "(i=p__Inv4)"
  have "?P1 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule Interp s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i=p__Inv3)"
  have "?P1 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule Interp s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i~=p__Inv3\<and>i~=p__Inv4)"
  have "?P2 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule Interp s f r (invariants N)" by auto
}
ultimately show "invHoldForRule Interp s f r (invariants N)" by satx
qed

lemma n_ExitVsinv__5:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_Exit  i)" and
a2: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__5  p__Inv3 p__Inv4)"
shows "invHoldForRule Interp s f r (invariants N)" (is "?P1 s \<or> ?P2 s \<or> ?P3 s")
proof -
from a1 obtain i where a1:"i\<le>N\<and>r=n_Exit  i" apply fastforce done
from a2 obtain p__Inv3 p__Inv4 where a2:"p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__5  p__Inv3 p__Inv4" apply fastforce done
have "(i=p__Inv4)\<or>(i=p__Inv3)\<or>(i~=p__Inv3\<and>i~=p__Inv4)" apply (cut_tac a1 a2, auto) done
moreover {
  assume b1: "(i=p__Inv4)"
  have "?P3 s"
  apply (cut_tac a1 a2 b1, simp, rule_tac x="(neg (andForm (eqn (IVar (Para (Ident ''n'') p__Inv4)) (Const C)) (eqn (IVar (Para (Ident ''n'') p__Inv3)) (Const E))))" in exI, auto) done
  then have "invHoldForRule Interp s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i=p__Inv3)"
  have "?P3 s"
  apply (cut_tac a1 a2 b1, simp, rule_tac x="(neg (andForm (eqn (IVar (Para (Ident ''n'') p__Inv3)) (Const C)) (eqn (IVar (Para (Ident ''n'') p__Inv4)) (Const E))))" in exI, auto) done
  then have "invHoldForRule Interp s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i~=p__Inv3\<and>i~=p__Inv4)"
  have "?P2 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule Interp s f r (invariants N)" by auto
}
ultimately show "invHoldForRule Interp s f r (invariants N)" by satx
qed

lemma n_IdleVsinv__5:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_Idle  i)" and
a2: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__5  p__Inv3 p__Inv4)"
shows "invHoldForRule Interp s f r (invariants N)" (is "?P1 s \<or> ?P2 s \<or> ?P3 s")
proof -
from a1 obtain i where a1:"i\<le>N\<and>r=n_Idle  i" apply fastforce done
from a2 obtain p__Inv3 p__Inv4 where a2:"p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__5  p__Inv3 p__Inv4" apply fastforce done
have "(i=p__Inv4)\<or>(i=p__Inv3)\<or>(i~=p__Inv3\<and>i~=p__Inv4)" apply (cut_tac a1 a2, auto) done
moreover {
  assume b1: "(i=p__Inv4)"
  have "?P1 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule Interp s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i=p__Inv3)"
  have "?P1 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule Interp s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i~=p__Inv3\<and>i~=p__Inv4)"
  have "?P2 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule Interp s f r (invariants N)" by auto
}
ultimately show "invHoldForRule Interp s f r (invariants N)" by satx
qed
end


(*  Title:      JinjaThreads/Framework/FWLockingThread.thy
    Author:     Andreas Lochbihler
*)

section \<open>Semantics of the thread action ReleaseAcquire for the thread state\<close>

theory FWLockingThread
imports
  FWLocking
begin

fun upd_threadR :: "nat \<Rightarrow> 't lock \<Rightarrow> 't \<Rightarrow> lock_action \<Rightarrow> nat"
where
  "upd_threadR n l t ReleaseAcquire = n + has_locks l t"
| "upd_threadR n l t _ = n"

primrec upd_threadRs :: "nat \<Rightarrow> 't lock \<Rightarrow> 't \<Rightarrow> lock_action list \<Rightarrow> nat"
where
  "upd_threadRs n l t [] = n"
| "upd_threadRs n l t (la # las) = upd_threadRs (upd_threadR n l t la) (upd_lock l t la) t las"

lemma upd_threadRs_append [simp]:
  "upd_threadRs n l t (las @ las') = upd_threadRs (upd_threadRs n l t las) (upd_locks l t las) t las'"
by(induct las arbitrary: n l, auto)

definition redT_updLns :: "('l,'t) locks \<Rightarrow> 't \<Rightarrow> ('l \<Rightarrow>f nat) \<Rightarrow> 'l lock_actions \<Rightarrow> ('l \<Rightarrow>f nat)"
where "\<And>ln. redT_updLns ls t ln las = (\<lambda>(l, n, la). upd_threadRs n l t la) \<circ>$ ($ls, ($ln, las$)$)"

lemma redT_updLns_iff [simp]:
  "\<And>ln. redT_updLns ls t ln las $ l = upd_threadRs (ln $ l) (ls $ l) t (las $ l)"
by(simp add: redT_updLns_def)

lemma upd_threadRs_comp_empty [simp]: "(\<lambda>(l, n, las). upd_threadRs n l t las) \<circ>$ ($ls, ($lns, K$ []$)$) = lns"
by(auto intro!: finfun_ext)

lemma redT_updLs_empty [simp]: "redT_updLs ls t (K$ []) = ls"
by(simp add: redT_updLs_def)

end


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

header{*The n_german Protocol Case Study*}

theory n_german_lemma_on_inv__8 imports n_german_base
begin
section{*All lemmas on causal relation between inv__8 and some rule r*}
lemma n_SendInvEVsinv__8:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_SendInvE  i)" and
a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__8  p__Inv4)"
shows "invHoldForRule s f r (invariants N)" (is "?P1 s \<or> ?P2 s \<or> ?P3 s")
proof -
from a1 obtain i where a1:"i\<le>N\<and>r=n_SendInvE  i" apply fastforce done
from a2 obtain p__Inv4 where a2:"p__Inv4\<le>N\<and>f=inv__8  p__Inv4" apply fastforce done
have "(i=p__Inv4)\<or>(i~=p__Inv4)" apply (cut_tac a1 a2, auto) done
moreover {
  assume b1: "(i=p__Inv4)"
  have "?P1 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i~=p__Inv4)"
  have "?P2 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
ultimately show "invHoldForRule s f r (invariants N)" by satx
qed

lemma n_SendInvSVsinv__8:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_SendInvS  i)" and
a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__8  p__Inv4)"
shows "invHoldForRule s f r (invariants N)" (is "?P1 s \<or> ?P2 s \<or> ?P3 s")
proof -
from a1 obtain i where a1:"i\<le>N\<and>r=n_SendInvS  i" apply fastforce done
from a2 obtain p__Inv4 where a2:"p__Inv4\<le>N\<and>f=inv__8  p__Inv4" apply fastforce done
have "(i=p__Inv4)\<or>(i~=p__Inv4)" apply (cut_tac a1 a2, auto) done
moreover {
  assume b1: "(i=p__Inv4)"
  have "?P1 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i~=p__Inv4)"
  have "?P2 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
ultimately show "invHoldForRule s f r (invariants N)" by satx
qed

lemma n_SendInvAckVsinv__8:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_SendInvAck  i)" and
a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__8  p__Inv4)"
shows "invHoldForRule s f r (invariants N)" (is "?P1 s \<or> ?P2 s \<or> ?P3 s")
proof -
from a1 obtain i where a1:"i\<le>N\<and>r=n_SendInvAck  i" apply fastforce done
from a2 obtain p__Inv4 where a2:"p__Inv4\<le>N\<and>f=inv__8  p__Inv4" apply fastforce done
have "(i=p__Inv4)\<or>(i~=p__Inv4)" apply (cut_tac a1 a2, auto) done
moreover {
  assume b1: "(i=p__Inv4)"
  have "?P1 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i~=p__Inv4)"
  have "?P2 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
ultimately show "invHoldForRule s f r (invariants N)" by satx
qed

lemma n_SendGntSVsinv__8:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_SendGntS  i)" and
a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__8  p__Inv4)"
shows "invHoldForRule s f r (invariants N)" (is "?P1 s \<or> ?P2 s \<or> ?P3 s")
proof -
from a1 obtain i where a1:"i\<le>N\<and>r=n_SendGntS  i" apply fastforce done
from a2 obtain p__Inv4 where a2:"p__Inv4\<le>N\<and>f=inv__8  p__Inv4" apply fastforce done
have "(i=p__Inv4)\<or>(i~=p__Inv4)" apply (cut_tac a1 a2, auto) done
moreover {
  assume b1: "(i=p__Inv4)"
  have "?P1 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i~=p__Inv4)"
  have "?P2 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
ultimately show "invHoldForRule s f r (invariants N)" by satx
qed

lemma n_SendGntEVsinv__8:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_SendGntE N i)" and
a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__8  p__Inv4)"
shows "invHoldForRule s f r (invariants N)" (is "?P1 s \<or> ?P2 s \<or> ?P3 s")
proof -
from a1 obtain i where a1:"i\<le>N\<and>r=n_SendGntE N i" apply fastforce done
from a2 obtain p__Inv4 where a2:"p__Inv4\<le>N\<and>f=inv__8  p__Inv4" apply fastforce done
have "(i=p__Inv4)\<or>(i~=p__Inv4)" apply (cut_tac a1 a2, auto) done
moreover {
  assume b1: "(i=p__Inv4)"
  have "?P3 s"
  apply (cut_tac a1 a2 b1, simp, rule_tac x="(neg (andForm (eqn (IVar (Ident ''ExGntd'')) (Const false)) (neg (eqn (IVar (Ident ''MemData'')) (IVar (Ident ''AuxData''))))))" in exI, auto) done
  then have "invHoldForRule s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i~=p__Inv4)"
  have "?P2 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
ultimately show "invHoldForRule s f r (invariants N)" by satx
qed

lemma n_RecvGntSVsinv__8:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_RecvGntS  i)" and
a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__8  p__Inv4)"
shows "invHoldForRule s f r (invariants N)" (is "?P1 s \<or> ?P2 s \<or> ?P3 s")
proof -
from a1 obtain i where a1:"i\<le>N\<and>r=n_RecvGntS  i" apply fastforce done
from a2 obtain p__Inv4 where a2:"p__Inv4\<le>N\<and>f=inv__8  p__Inv4" apply fastforce done
have "(i=p__Inv4)\<or>(i~=p__Inv4)" apply (cut_tac a1 a2, auto) done
moreover {
  assume b1: "(i=p__Inv4)"
  have "?P1 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i~=p__Inv4)"
  have "?P2 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
ultimately show "invHoldForRule s f r (invariants N)" by satx
qed

lemma n_RecvGntEVsinv__8:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_RecvGntE  i)" and
a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__8  p__Inv4)"
shows "invHoldForRule s f r (invariants N)" (is "?P1 s \<or> ?P2 s \<or> ?P3 s")
proof -
from a1 obtain i where a1:"i\<le>N\<and>r=n_RecvGntE  i" apply fastforce done
from a2 obtain p__Inv4 where a2:"p__Inv4\<le>N\<and>f=inv__8  p__Inv4" apply fastforce done
have "(i=p__Inv4)\<or>(i~=p__Inv4)" apply (cut_tac a1 a2, auto) done
moreover {
  assume b1: "(i=p__Inv4)"
  have "?P1 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i~=p__Inv4)"
  have "?P2 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
ultimately show "invHoldForRule s f r (invariants N)" by satx
qed

lemma n_StoreVsinv__8:
assumes a1: "(\<exists> i d. i\<le>N\<and>d\<le>N\<and>r=n_Store  i d)" and
a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__8  p__Inv4)"
shows "invHoldForRule s f r (invariants N)" (is "?P1 s \<or> ?P2 s \<or> ?P3 s")
proof -
from a1 obtain i d where a1:"i\<le>N\<and>d\<le>N\<and>r=n_Store  i d" apply fastforce done
from a2 obtain p__Inv4 where a2:"p__Inv4\<le>N\<and>f=inv__8  p__Inv4" apply fastforce done
have "(i=p__Inv4)\<or>(i~=p__Inv4)" apply (cut_tac a1 a2, auto) done
moreover {
  assume b1: "(i=p__Inv4)"
  have "?P3 s"
  apply (cut_tac a1 a2 b1, simp, rule_tac x="(neg (andForm (eqn (IVar (Field (Para (Ident ''Chan2'') p__Inv4) ''Cmd'')) (Const GntE)) (eqn (IVar (Field (Para (Ident ''Cache'') p__Inv4) ''State'')) (Const E))))" in exI, auto) done
  then have "invHoldForRule s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i~=p__Inv4)"
  have "?P3 s"
  apply (cut_tac a1 a2 b1, simp, rule_tac x="(neg (andForm (eqn (IVar (Field (Para (Ident ''Cache'') i) ''State'')) (Const E)) (eqn (IVar (Field (Para (Ident ''Chan2'') p__Inv4) ''Cmd'')) (Const GntE))))" in exI, auto) done
  then have "invHoldForRule s f r (invariants N)" by auto
}
ultimately show "invHoldForRule s f r (invariants N)" by satx
qed

lemma n_SendReqESVsinv__8:
  assumes a1: "\<exists> i. i\<le>N\<and>r=n_SendReqES  i" and
  a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__8  p__Inv4)"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_RecvInvAckVsinv__8:
  assumes a1: "\<exists> i. i\<le>N\<and>r=n_RecvInvAck  i" and
  a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__8  p__Inv4)"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_RecvReqVsinv__8:
  assumes a1: "\<exists> i. i\<le>N\<and>r=n_RecvReq N i" and
  a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__8  p__Inv4)"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_SendReqSVsinv__8:
  assumes a1: "\<exists> j. j\<le>N\<and>r=n_SendReqS  j" and
  a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__8  p__Inv4)"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_SendReqEIVsinv__8:
  assumes a1: "\<exists> i. i\<le>N\<and>r=n_SendReqEI  i" and
  a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__8  p__Inv4)"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

end


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

context weak
begin

definition weakenTransition :: "'b \<Rightarrow> ('a, 'b, 'c) psi \<Rightarrow> 'a action \<Rightarrow> ('a, 'b, 'c) psi \<Rightarrow> bool" ("_ \<rhd> _ \<Longrightarrow>_ \<prec> _" [80, 80, 80, 80] 80)
where
  "\<Psi> \<rhd> P \<Longrightarrow>\<alpha> \<prec> P' \<equiv> (\<exists>P''' P''. \<Psi> \<rhd> P \<Longrightarrow>\<^sup>^\<^sub>\<tau> P''' \<and> \<Psi> \<rhd> P''' \<longmapsto>\<alpha> \<prec> P'' \<and> \<Psi> \<rhd> P'' \<Longrightarrow>\<^sup>^\<^sub>\<tau> P') \<or> (P = P' \<and> \<alpha> = \<tau>)"

lemma weakenTransitionCases[consumes 1, case_names cBase cStep]:
  assumes "\<Psi> \<rhd> P \<Longrightarrow>\<alpha> \<prec> P'"
  and "Prop (\<tau>) P"
  and "\<And>P''' P''. \<lbrakk>\<Psi> \<rhd> P \<Longrightarrow>\<^sup>^\<^sub>\<tau> P'''; \<Psi> \<rhd> P''' \<longmapsto>\<alpha> \<prec> P''; \<Psi> \<rhd> P'' \<Longrightarrow>\<^sup>^\<^sub>\<tau> P'\<rbrakk> \<Longrightarrow> Prop \<alpha> P'"

  shows "Prop \<alpha> P'"
using assms
by(auto simp add: weakenTransition_def)

lemma statImpTauChainDerivative:
  fixes \<Psi>   :: 'b
  and   P    :: "('a, 'b, 'c) psi"
  and   P'   :: "('a, 'b, 'c) psi"

  assumes "\<Psi> \<rhd> P \<Longrightarrow>\<^sup>^\<^sub>\<tau> P'"

  shows "insertAssertion (extractFrame P) \<Psi> \<hookrightarrow>\<^sub>F insertAssertion (extractFrame P') \<Psi>"
using assms
by(induct rule: tauChainInduct) (auto intro: statImpTauDerivative dest: FrameStatImpTrans)

lemma weakenTauChain:
  fixes \<Psi>  :: 'b
  and   P  :: "('a, 'b, 'c) psi"
  and   P' :: "('a, 'b, 'c) psi"
  and   \<Psi>' :: 'b

  assumes "\<Psi> \<rhd> P \<Longrightarrow>\<^sup>^\<^sub>\<tau> P'"
  shows "\<Psi> \<otimes> \<Psi>' \<rhd> P \<Longrightarrow>\<^sup>^\<^sub>\<tau> P'"
using assms
proof(induct rule: tauChainInduct)
  case(TauBase P)
  thus ?case by simp
next
  case(TauStep P P' P'')
  note `\<Psi> \<otimes> \<Psi>' \<rhd> P \<Longrightarrow>\<^sup>^\<^sub>\<tau> P'`
  moreover from `\<Psi> \<rhd> P' \<longmapsto>\<tau> \<prec> P''` have "\<Psi> \<otimes> \<Psi>' \<rhd> P' \<longmapsto>\<tau> \<prec> P''" by(rule weakenTransition)
  ultimately show ?case by(auto dest: tauActTauChain)
qed

end

end


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

header{*The n_mutualExFsm Protocol Case Study*}

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


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

(*header{*The n_german Protocol Case Study*}*)

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

end


section \<open>Stamp Typing\<close>

theory Stamp
  imports Values
begin

text \<open>
The GraalVM compiler uses the Stamp class to store range and type information
for a given node in the IR graph.
We model the Stamp class as a datatype, Stamp, and provide a number of functions
on the datatype which correspond to the class methods within the compiler.

Stamp information is used in a variety of ways in optimizations, and so, we
additionally provide a number of lemmas which help to prove future optimizations.
\<close>

datatype Stamp =
  VoidStamp
  | IntegerStamp (stp_bits: nat) (stpi_lower: int) (stpi_upper: int)
  (* | FloatStamp (stp_bits: nat) (stpf_lower: float) (stpf_upper: float) *)
  | KlassPointerStamp (stp_nonNull: bool) (stp_alwaysNull: bool)
  | MethodCountersPointerStamp (stp_nonNull: bool) (stp_alwaysNull: bool)
  | MethodPointersStamp (stp_nonNull: bool) (stp_alwaysNull: bool)
  | ObjectStamp (stp_type: string) (stp_exactType: bool) (stp_nonNull: bool) (stp_alwaysNull: bool)
  | RawPointerStamp (stp_nonNull: bool) (stp_alwaysNull: bool)
  | IllegalStamp

fun is_stamp_empty :: "Stamp \<Rightarrow> bool" where
  "is_stamp_empty (IntegerStamp b lower upper) = (upper < lower)" |
  (* "is_stamp_empty (FloatStamp b lower upper) = (upper < lower)" | *)
  "is_stamp_empty x = False"

text \<open>Just like the IntegerStamp class, we need to know that our lo/hi bounds
  fit into the given number of bits (either signed or unsigned).
  Our integer stamps have infinite lo/hi bounds, so if the lower
  bound is non-negative, we can assume that all values are positive,
  and the integer bits of a related value can be interpreted as unsigned.
  This is similar (but slightly more general) to what IntegerStamp.java
  does with its test: if (sameSignBounds()) in the unsignedUpperBound() method.

  Note that this is a bit different and more accurate than what
  StampFactory.forUnsignedInteger does (it widens large unsigned ranges to the
  max signed range to allow all bit patterns) because its lo/hi values are only 64-bit.
\<close>
(* TODO: should we have tight bounds for empty stamp, or just hi<lo?
   We could have: (lo = snd (bit_bounds bits) \<and> hi = fst (bit_bounds bits)
 *)
fun valid_stamp :: "Stamp \<Rightarrow> bool" where
  "valid_stamp (IntegerStamp bits lo hi) =
     (0 < bits \<and> bits \<le> 64 \<and>
     fst (bit_bounds bits) \<le> lo \<and> lo \<le> snd (bit_bounds bits) \<and>
     fst (bit_bounds bits) \<le> hi \<and> hi \<le> snd (bit_bounds bits))" |
  "valid_stamp s = True"

(* Note: we could support 32/64-bit unsigned values by relaxing this definition to:
     (is_stamp_empty (IntegerStamp bits lo hi)
     \<or> lo < 0 \<and> fst (bit_bounds bits) \<le> lo \<and> lo \<le> hi \<and> hi \<le> snd (bit_bounds bits)
     \<or> 0 \<le> lo \<and> lo \<le> hi \<and> hi < 2 ^ bits))"
*)

experiment begin
corollary "bit_bounds 1 = (-1, 0)" by simp  (* this matches the compiler stamps. *)
end

(* NOTE: the FloatStamp has been commented out to allow use of code generation facilities *)
(*
definition pos_infinity :: "float" where
  "pos_infinity = float_of (0 * 2 powr 255)"

definition neg_infinity :: "float" where
  "neg_infinity = -pos_infinity"
*)

\<comment> \<open>A stamp which includes the full range of the type\<close>
fun unrestricted_stamp :: "Stamp \<Rightarrow> Stamp" where
  "unrestricted_stamp VoidStamp = VoidStamp" |
  "unrestricted_stamp (IntegerStamp bits lower upper) = (IntegerStamp bits (fst (bit_bounds bits)) (snd (bit_bounds bits)))" |
  (* "unrestricted_stamp (FloatStamp bits lower upper) = (FloatStamp bits neg_infinity pos_infinity)" |  *)
  "unrestricted_stamp (KlassPointerStamp nonNull alwaysNull) = (KlassPointerStamp False False)" |
  "unrestricted_stamp (MethodCountersPointerStamp nonNull alwaysNull) = (MethodCountersPointerStamp False False)" |
  "unrestricted_stamp (MethodPointersStamp nonNull alwaysNull) = (MethodPointersStamp False False)" |
  "unrestricted_stamp (ObjectStamp type exactType nonNull alwaysNull) = (ObjectStamp '''' False False False)" |
  "unrestricted_stamp _ = IllegalStamp"

fun is_stamp_unrestricted :: "Stamp \<Rightarrow> bool" where
  "is_stamp_unrestricted s = (s = unrestricted_stamp s)"

\<comment> \<open>A stamp which provides type information but has an empty range of values\<close>
fun empty_stamp :: "Stamp \<Rightarrow> Stamp" where
  "empty_stamp VoidStamp = VoidStamp" |
  "empty_stamp (IntegerStamp bits lower upper) = (IntegerStamp bits (snd (bit_bounds bits)) (fst (bit_bounds bits)))" |
  (* "empty_stamp (FloatStamp bits lower upper) = (FloatStamp bits pos_infinity neg_infinity)" | *)
  "empty_stamp (KlassPointerStamp nonNull alwaysNull) = (KlassPointerStamp nonNull alwaysNull)" |
  "empty_stamp (MethodCountersPointerStamp nonNull alwaysNull) = (MethodCountersPointerStamp nonNull alwaysNull)" |
  "empty_stamp (MethodPointersStamp nonNull alwaysNull) = (MethodPointersStamp nonNull alwaysNull)" |
  "empty_stamp (ObjectStamp type exactType nonNull alwaysNull) = (ObjectStamp '''' True True False)" |
  "empty_stamp stamp = IllegalStamp"

\<comment> \<open>Calculate the meet stamp of two stamps\<close>
fun meet :: "Stamp \<Rightarrow> Stamp \<Rightarrow> Stamp" where
  "meet VoidStamp VoidStamp = VoidStamp" |
  "meet (IntegerStamp b1 l1 u1) (IntegerStamp b2 l2 u2) = (
    if b1 \<noteq> b2 then IllegalStamp else
    (IntegerStamp b1 (min l1 l2) (max u1 u2))
  )" |
  (* "meet (FloatStamp b1 l1 u1) (FloatStamp b2 l2 u2) = (
    if b1 \<noteq> b2 then IllegalStamp else
    (FloatStamp b1 (min l1 l2) (max u1 u2))
  )" | *)
  "meet (KlassPointerStamp nn1 an1) (KlassPointerStamp nn2 an2) = (
    KlassPointerStamp (nn1 \<and> nn2) (an1 \<and> an2)
  )" |
  "meet (MethodCountersPointerStamp nn1 an1) (MethodCountersPointerStamp nn2 an2) = (
    MethodCountersPointerStamp (nn1 \<and> nn2) (an1 \<and> an2)
  )" |
  "meet (MethodPointersStamp nn1 an1) (MethodPointersStamp nn2 an2) = (
    MethodPointersStamp (nn1 \<and> nn2) (an1 \<and> an2)
  )" |
  "meet s1 s2 = IllegalStamp"

\<comment> \<open>Calculate the join stamp of two stamps\<close>
fun join :: "Stamp \<Rightarrow> Stamp \<Rightarrow> Stamp" where
  "join VoidStamp VoidStamp = VoidStamp" |
  "join (IntegerStamp b1 l1 u1) (IntegerStamp b2 l2 u2) = (
    if b1 \<noteq> b2 then IllegalStamp else
    (IntegerStamp b1 (max l1 l2) (min u1 u2))
  )" |
  (* "join (FloatStamp b1 l1 u1) (FloatStamp b2 l2 u2) = (
    if b1 \<noteq> b2 then IllegalStamp else
    (FloatStamp b1 (max l1 l2) (min u1 u2))
  )" | *)
  "join (KlassPointerStamp nn1 an1) (KlassPointerStamp nn2 an2) = (
    if ((nn1 \<or> nn2) \<and> (an1 \<or> an2))
    then (empty_stamp (KlassPointerStamp nn1 an1))
    else (KlassPointerStamp (nn1 \<or> nn2) (an1 \<or> an2))
  )" |
  "join (MethodCountersPointerStamp nn1 an1) (MethodCountersPointerStamp nn2 an2) = (
    if ((nn1 \<or> nn2) \<and> (an1 \<or> an2))
    then (empty_stamp (MethodCountersPointerStamp nn1 an1))
    else (MethodCountersPointerStamp (nn1 \<or> nn2) (an1 \<or> an2))
  )" |
  "join (MethodPointersStamp nn1 an1) (MethodPointersStamp nn2 an2) = (
    if ((nn1 \<or> nn2) \<and> (an1 \<or> an2))
    then (empty_stamp (MethodPointersStamp nn1 an1))
    else (MethodPointersStamp (nn1 \<or> nn2) (an1 \<or> an2))
  )" |
  "join s1 s2 = IllegalStamp"

\<comment> \<open>
In certain circumstances a stamp provides enough information to evaluate a value as a stamp,
the asConstant function converts the stamp to a value where one can be inferred.
\<close>
(* NOTE: we could also add a 32-bit version of this if needed. *)
fun asConstant :: "Stamp \<Rightarrow> Value" where
  "asConstant (IntegerStamp b l h) = (if l = h then IntVal b (word_of_int l) else UndefVal)" |
  "asConstant _ = UndefVal"

\<comment> \<open>Determine if two stamps never have value overlaps i.e. their join is empty\<close>
fun alwaysDistinct :: "Stamp \<Rightarrow> Stamp \<Rightarrow> bool" where
  "alwaysDistinct stamp1 stamp2 = is_stamp_empty (join stamp1 stamp2)"

\<comment> \<open>Determine if two stamps must always be the same value i.e. two equal constants\<close>
fun neverDistinct :: "Stamp \<Rightarrow> Stamp \<Rightarrow> bool" where
  "neverDistinct stamp1 stamp2 = (asConstant stamp1 = asConstant stamp2 \<and> asConstant stamp1 \<noteq> UndefVal)"

fun constantAsStamp :: "Value \<Rightarrow> Stamp" where
  "constantAsStamp (IntVal b v) = (IntegerStamp b (int_signed_value b v) (int_signed_value b v))" |
  (* TODO: float *)
  "constantAsStamp _ = IllegalStamp"

\<comment> \<open>Define when a runtime value is valid for a stamp.
    The stamp bounds must be valid, and val must be zero-extended.\<close>
fun valid_value :: "Value \<Rightarrow> Stamp \<Rightarrow> bool" where
  "valid_value (IntVal b1 val) (IntegerStamp b l h) =
     (if b1 = b then
       valid_stamp (IntegerStamp b l h) \<and>
       take_bit b val = val \<and>
       l \<le> int_signed_value b val \<and> int_signed_value b val \<le> h
      else False)" |
  (* "valid_value (FloatStamp b1 l h) (FloatVal b2 v) = ((b1 = b2) \<and> (v \<ge> l) \<and> (v \<le> h))" | *)
  "valid_value (ObjRef ref) (ObjectStamp klass exact nonNull alwaysNull) =
     ((alwaysNull \<longrightarrow> ref = None) \<and> (ref=None \<longrightarrow> \<not> nonNull))" |
  "valid_value stamp val = False"
(* NOTE: we could allow for unsigned interpretations too, like this:
       (if l < 0
        then (l \<le> int_signed_value b val \<and> int_signed_value b val \<le> h)
        else (l \<le> int_unsigned_value b val \<and> int_unsigned_value b val \<le> h))
   but that is only necessary for handling unsigned long, so we take the
   simpler always-signed approach here.  In Java, the only unsigned stamps
   we see are for char, but they are 32-bit: IntegerStamp 32 0 65535.
*)
(* TODO: add the other stamps:
  | KlassPointerStamp (stp_nonNull: bool) (stp_alwaysNull: bool)
  | MethodCountersPointerStamp (stp_nonNull: bool) (stp_alwaysNull: bool)
  | MethodPointersStamp (stp_nonNull: bool) (stp_alwaysNull: bool)
  | RawPointerStamp (stp_nonNull: bool) (stp_alwaysNull: bool)
*)

(* A preferable wf_value definition
fun wf_value :: "Value \<Rightarrow> bool" where
  "wf_value (IntVal b v) = (0 < b \<and> b \<le> 64 \<and> take_bit b v = v
    \<and> sint v \<le> snd (bit_bounds b)
    \<and> fst (bit_bounds b) \<le> sint v)" |
  "wf_value _ = False"
*)

definition wf_value :: "Value \<Rightarrow> bool" where
  "wf_value v = valid_value v (constantAsStamp v)"

lemma unfold_wf_value[simp]:
  "wf_value v \<Longrightarrow> valid_value v (constantAsStamp v)"
  using wf_value_def by auto

fun compatible :: "Stamp \<Rightarrow> Stamp \<Rightarrow> bool" where
  "compatible (IntegerStamp b1 lo1 hi1) (IntegerStamp b2 lo2 hi2) =
     (b1 = b2 \<and> valid_stamp (IntegerStamp b1 lo1 hi1) \<and> valid_stamp (IntegerStamp b2 lo2 hi2))" |
  "compatible (VoidStamp) (VoidStamp) = True" |
  "compatible _ _ = False"

fun stamp_under :: "Stamp \<Rightarrow> Stamp \<Rightarrow> bool" where
  "stamp_under (IntegerStamp b1 lo1 hi1) (IntegerStamp b2 lo2 hi2) = (hi1 < lo2)" |
  "stamp_under _ _ = False"

\<comment> \<open>
The most common type of stamp within the compiler (apart from the VoidStamp) is a 32 bit
integer stamp with an unrestricted range. We use @{text default_stamp} as it is a frequently used stamp.
\<close>
definition default_stamp :: "Stamp" where
  "default_stamp = (unrestricted_stamp (IntegerStamp 32 0 0))"

value "valid_value (IntVal 8 (255)) (IntegerStamp 8 (-128) 127)"
end


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

(*header{*The n_german Protocol Case Study*}*)

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

end


           (*-------------------------------------------------*
            |                 (a part of) ep2                 |
            |                  September 2004                 |
            |                   December 2004 (modified)      |
            |                   November 2005 (modified)      |
            |                      April 2006 (modified)      |
            |                      March 2007  (modified)     |
            |                                                 |
            |        CSP-Prover on Isabelle2009               |
            |                       June 2009  (modified)     |
            |                                                 |
            |        CSP-Prover on Isabelle2012               |
            |                   November 2012  (modified)     |
            |                                                 |
            |        CSP-Prover on Isabelle2016               |
            |                        May 2016  (modified)     |
            |                                                 |
            |  Markus Roggenbach (Univ of Wales Swansea, UK)  |
            |  Yoshinao Isobe    (AIST, Japan)                |
            *-------------------------------------------------*)

theory ep2_acl
imports CSP_F
begin

(*********************************************************
          automatic unfolding syntactic-sugar
 *********************************************************)

declare csp_prefix_ss_def [simp]

(*********************************************************
              data type passed on channels
 *********************************************************)

typedecl D_SI_Init_SessionStart
typedecl D_SI_Init_SessionEnd
typedecl D_SI_Init_ConfigDataRequest
typedecl D_SI_Init_ConfigDataResponse
typedecl D_SI_Init_ConfigDataNotification
typedecl D_SI_Init_ConfigDataAcknowledge
typedecl D_SI_Init_RemoveConfigDataNotification
typedecl D_SI_Init_RemoveConfigDataAcknowledge
typedecl D_SI_Init_ActivateConfigDataNotification
typedecl D_SI_Init_ActivateConfigDataAcknowledge

datatype D_SI_Init =
     SStart D_SI_Init_SessionStart
   | SEnd   D_SI_Init_SessionEnd
   | CDReq  D_SI_Init_ConfigDataRequest
   | CDRes  D_SI_Init_ConfigDataResponse
   | CDN    D_SI_Init_ConfigDataNotification
   | CDA    D_SI_Init_ConfigDataAcknowledge
   | RCDN   D_SI_Init_RemoveConfigDataNotification
   | RCDA   D_SI_Init_RemoveConfigDataAcknowledge
   | ACDN   D_SI_Init_ActivateConfigDataNotification
   | ACDA   D_SI_Init_ActivateConfigDataAcknowledge

typedecl TerminalState
typedecl Trigger
typedecl Message

(*********************************************************
                     event (channel)
 *********************************************************)

datatype Event = C_SI_Init D_SI_Init
               | C_TerminalDisplay Message
               | PairTT "TerminalState * Trigger"

(*********************************************************
         abstract component description level
 *********************************************************)

datatype ACName = TInit
                | TConfigurationManagement
                | AcquirerInit
                | ConfigurationManagement

primrec
  ACfun :: "ACName => (ACName, Event) proc"
where
  "ACfun (TInit)
    = C_SI_Init !? x: (range SStart)
      -> $(TConfigurationManagement)"

 |"ACfun (TConfigurationManagement)
    = C_SI_Init ? x ->
       IF (x:range CDReq)
       THEN (C_SI_Init !? y: (range CDRes)
            -> $(TConfigurationManagement))

       ELSE IF (x:range CDN)
       THEN (C_SI_Init !? y: (range CDA)
            -> $(TConfigurationManagement))

       ELSE IF (x:range RCDN)
       THEN (C_SI_Init !? y: (range RCDA)
            -> $(TConfigurationManagement))

       ELSE IF (x:range ACDN)
       THEN (C_SI_Init !? y: (range ACDA)
            -> $(TConfigurationManagement))

       ELSE IF (x:range SEnd)
       THEN SKIP
       ELSE STOP"

 |"ACfun (AcquirerInit)
    = C_SI_Init ? sessionStart: (range SStart)
      -> $(ConfigurationManagement)"

 |"ACfun (ConfigurationManagement)
    =     C_SI_Init !? sessionEnd:(range SEnd) -> SKIP
      |~| C_SI_Init !? request:(range CDReq)
          -> C_SI_Init ? response:(range CDRes)
          -> $(ConfigurationManagement)
      |~| C_SI_Init !? notification:(range CDN)
          -> C_SI_Init ? acknowledge:(range CDA)
          -> $(ConfigurationManagement)
      |~| C_SI_Init !? notification:(range RCDN)
          -> C_SI_Init ? acknowledge:(range RCDA)
          -> $(ConfigurationManagement)
      |~| C_SI_Init !? notification:(range ACDN)
          -> C_SI_Init ? acknowledge:(range ACDA)
          -> $(ConfigurationManagement)"
(*
defs (overloaded)
  Set_ACfun_def [simp]: "PNfun == ACfun"
*)
overloading Set_ACfun ==
  "PNfun :: (ACName, Event) pnfun"
begin
  definition "PNfun == ACfun"
end
declare Set_ACfun_def [simp]

definition
  AC :: "(ACName, Event) proc"
  where
  AC_def: "AC == ($TInit |[range C_SI_Init]| $AcquirerInit)"

(*********************************************************
              gProc lemmas (routine work)
 *********************************************************)

lemma guarded_AC[simp]:
      "guardedfun ACfun"
by (simp add: guardedfun_def, rule allI, induct_tac p, simp_all)+

(*********************************************************
               abstract level (deadlock free)
 *********************************************************)

abbreviation REQs :: "D_SI_Init set"
where "REQs == (range CDReq) Un (range CDN) Un
               (range RCDN)  Un (range ACDN)"

abbreviation RESs :: "D_SI_Init set"
where "RESs == (range CDRes) Un (range CDA) Un
               (range RCDA)  Un (range ACDA)"

datatype AbsName = Abstract | Loop

fun
  Absfun :: "AbsName => (AbsName, Event) proc"
where
  "Absfun (Abstract)
          = C_SI_Init !? init:(range SStart) -> $(Loop)"

| "Absfun (Loop)
          = C_SI_Init !? exit:(range SEnd) -> SKIP
            |~|
            C_SI_Init !? request:REQs
              -> C_SI_Init !? response:RESs
                -> $(Loop)"
(*
defs (overloaded)
  Set_Absfun_def [simp]: "PNfun == Absfun"
*)

overloading Set_Absfun ==
  "PNfun :: (AbsName, Event) pnfun"
begin
  definition "PNfun == Absfun"
end

declare Set_Absfun_def [simp]

definition
  Abs :: "(AbsName, Event) proc"
  where
  Abs_def: "Abs == $(Abstract)"

(*********************************************************
               gProc lemmas (routine work)
 *********************************************************)

lemma guarded_Abs[simp]:
      "guardedfun Absfun"
by (simp add: guardedfun_def, rule allI, induct_tac p, simp_all)+

(*********************************************************
        relating function between AbsName and ACName
 *********************************************************)

primrec
  Abs_to_AC :: "AbsName => (ACName,Event) proc"
where
  "Abs_to_AC (Abstract)
          = ($TInit |[range C_SI_Init]| $AcquirerInit)"

 |"Abs_to_AC (Loop)
          = ($TConfigurationManagement |[range C_SI_Init]|
             $ConfigurationManagement)"

(*********************************************************
           a theorem for verifying Abs <=F AC
               (i.e. AC is deadlock-free)
 *********************************************************)

overloading FPmode ==
  "FPmode :: fpmode"
begin
  definition "FPmode == CMSmode"
end

declare FPmode_def [simp]
(*
defs FPmode_def [simp]: "FPmode == CMSmode"
*)

(*** CMS-based approach ***)

declare inj_on_def       [simp]

theorem ep2_abs: "Abs <=F AC"
apply (simp add: Abs_def AC_def)

  (***** by fixed point induction *****)
apply (rule cspF_fp_induct_left[of _ "Abs_to_AC"])

  (***** check guarded and no hiding operators *****)
apply (simp_all)
apply (simp)

   (*** recursion ***)
apply (induct_tac p)
apply (simp_all)

(*** initializing ***)

apply (cspF_unwind)
apply (cspF_dist)

apply (cspF_simp)
apply (auto)
apply (cspF_step)+
apply (rule cspF_decompo_subset)

apply (auto)
apply (cspF_simp)

(*** main loop ***)

apply (cspF_unwind)
apply (cspF_dist)+
apply (auto)

 (*** skip ***)
apply (cspF_step)+
apply (rule cspF_Int_choice_left1)
apply (rule cspF_decompo_subset)
apply (auto)
apply (simp add: image_iff)
apply (cspF_step)+

 (*** C_SI_Init ? ***)
apply (rule cspF_Int_choice_left2)
apply (rule cspF_decompo_subset)
apply (auto)
apply (simp add: image_iff)
apply (cspF_simp)+

apply (cspF_dist)
apply (cspF_simp)
apply (rule cspF_decompo_subset)
apply (auto)
apply (cspF_step)+
apply (auto)
apply (cspF_simp)

 (*** CD req res ***)
apply (rule cspF_Int_choice_left2)
apply (cspF_step)+
apply (rule cspF_decompo_subset)
apply (auto)
apply (simp add: image_iff)
apply (cspF_simp)+

apply (cspF_dist)
apply (cspF_simp)
apply (rule cspF_decompo_subset)
apply (auto)
apply (cspF_step)+
apply (auto)
apply (cspF_simp)

 (*** RCD ***)
apply (rule cspF_Int_choice_left2)
apply (cspF_step)+
apply (rule cspF_decompo_subset)
apply (auto)
apply (simp add: image_iff)
apply (cspF_simp)+

apply (cspF_dist)
apply (cspF_simp)
apply (rule cspF_decompo_subset)
apply (auto)
apply (cspF_step)+
apply (auto)
apply (cspF_simp)

 (*** ACD ***)
apply (rule cspF_Int_choice_left2)
apply (cspF_step)+
apply (rule cspF_decompo_subset)
apply (auto)
apply (simp add: image_iff)
apply (cspF_simp)+

apply (cspF_dist)
apply (cspF_simp)
apply (rule cspF_decompo_subset)
apply (auto)
apply (cspF_step)+
apply (auto)
apply (cspF_simp)
done

declare inj_on_def [simp del]

end