(*
 * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
 *
 * SPDX-License-Identifier: BSD-2-Clause
 *)

theory ML_Goal_Test
imports
  ML_Goal
  ML_Utils.ML_Utils
begin
experiment begin

\<comment>\<open>
  Basic usage.
\<close>
ML_goal test: \<open>
  [@{term "(P \<longrightarrow> Q) \<and> P \<longrightarrow> Q"}]
\<close>
  apply clarsimp
  done

thm test

\<comment>\<open>
  A goal that we definitely don't want to write out by hand.

  In this case, we're going to show that if x is less than 10,
  we "only" need to consider the cases when x = 0, or x = 1, or...
\<close>
ML_goal big_goal: \<open>
  let
    val var_x = Free ("x", @{typ nat});
    val var_P = Free ("P", @{typ bool});
    val max = 10;

    \<comment>\<open>
      @{ML "HOLogic.mk_nat"} produces nested Suc's, which are pretty
      ugly, so we use this instead.
    \<close>
    val mk_nat = HOLogic.mk_number @{typ nat};

    \<comment>\<open>
      Turns (i: int) into @{term "x = i \<Longrightarrow> P"}.
    \<close>
    fun mk_case i =
        let
          val prem = HOLogic.mk_eq (var_x, mk_nat i) |> HOLogic.mk_Trueprop;
          val conc = var_P |> HOLogic.mk_Trueprop;
        in Logic.mk_implies (prem, conc) end

    val x_cases =
        ListExtras.range 0 max
        |> map mk_case;

    val assm =
        HOLogic.mk_binrel @{const_name "less"}
          (var_x,
          (mk_nat max))
        |> HOLogic.mk_Trueprop;

    val goal =
        Logic.list_implies (assm :: x_cases, var_P |> HOLogic.mk_Trueprop)

  in [goal] end
\<close>
  by force

\<comment>\<open>
  Names are optional.
\<close>
ML_goal \<open>
  [@{term "True"}]
\<close>
  by (rule TrueI)

\<comment>\<open>
  Multiple goals are supported, and result in similar
  "list of fact" lemmas
\<close>
ML_goal multiple_goals: \<open>
  [@{term "(P \<Longrightarrow> Q \<Longrightarrow> P)"}, @{term "(P \<Longrightarrow> Q \<Longrightarrow> Q)"}]
\<close>
  by simp+

thm multiple_goals[OF TrueI]

\<comment>\<open>
  Handles mixes of @{typ bool} and @{typ prop}.
\<close>
ML_goal \<open>
  [@{term "PROP A \<Longrightarrow> PROP A"}, @{term "B \<longrightarrow> B"}]
\<close>
  by simp+

\<comment>\<open>
  Turns out a lemma name can refer to nothing as well!
\<close>
ML_goal nothing: \<open>[]\<close>
  done

thm nothing[OF TrueI]

\<comment>\<open>
  Attributes can be applied, just like normal lemmas.
\<close>
definition magic where "magic = (5 :: nat)"

ML_goal declared_with_an_attribute[folded magic_def, simp]: \<open>
  [@{term "(5 :: nat) = 2 + 3"}]
\<close>
  by simp

lemma uses_our_new_magic_simp_rule:
  "magic = 1 + 4"
  by simp

end

end


           (*-------------------------------------------*
            |        CSP-Prover on Isabelle2004         |
            |                    May 2005               |
            |                   June 2005  (modified)   |
            |              September 2005  (modified)   |
            |                                           |
            |        CSP-Prover on Isabelle2005         |
            |               November 2005  (modified)   |
            |                  March 2007  (modified)   |
            |                                           |
            |        Yoshinao Isobe (AIST JAPAN)        |
            *-------------------------------------------*)

theory CSP_F_law_rep_par
imports CSP_F_law_alpha_par CSP_F_op_rep_par CSP_T_law_rep_par
begin

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

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

         1. associativity of [||]:I
         2. commutativity of [||]:I
         3.
         4.

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

(*****************************************************
   replace an index set with another equal index set
 *****************************************************)

(*------------------*
 |      csp law     |
 *------------------*)

lemma cspF_Rep_parallel_index_eq_lm1:
   "[| inj_on f I1 ; ALL i:I1. PXf2 (f i) = PXf1 i |] ==>
    Union {(Yf i Int insert Tick (Ev ` snd (PXf1 i))) |i. i : I1} =
    Union {(Yf (inv_on I1 f i) Int insert Tick (Ev ` snd (PXf2 i))) |i. i : f ` I1}"
apply (rule)

 (* => *)
 apply (rule, simp)
 apply (elim conjE exE)
 apply (rule_tac x="(Yf i) Int insert Tick (Ev ` snd (PXf2 (f i)))" in exI)
 apply (simp)
 apply (rule_tac x="f i" in exI)
 apply (simp add: inv_f_f_on)

 (* <= *)
 apply (rule, simp)
 apply (simp add: image_iff)
 apply (elim conjE exE bexE)
 apply (rule_tac x=
   "(Yf xb) Int insert Tick (Ev ` snd (PXf1 xb))" in exI)
 apply (simp)
 apply (simp add: inv_f_f_on)
 apply (rule_tac x="xb" in exI)
 apply (simp)
done

lemma cspF_Rep_parallel_index_eq_lm2:
   "ALL i:I1. PXf2 (f i) = PXf1 i ==>
    Union {(Yf i Int insert Tick (Ev ` snd (PXf2 i))) |i. i : f ` I1} =
    Union {(Yf (f i) Int insert Tick (Ev ` snd (PXf1 i))) |i. i : I1}"
apply (rule)

 (* => *)
 apply (rule, simp)
 apply (simp add: image_iff)
 apply (elim conjE exE bexE)
 apply (simp)
 apply (rule_tac x="xa" in exI)
 apply (simp)
 apply (rule_tac x="xb" in exI)
 apply (simp)

 (* <= *)
 apply (rule, simp)
 apply (elim conjE exE)
 apply (rule_tac x="xa" in exI)
 apply (simp)
 apply (rule_tac x="f i" in exI)
 apply (simp)
done

(* main *)

lemma cspF_Rep_parallel_index_eq:
   "[| finite I1 ;
       EX f. I2 = f ` I1 & inj_on f I1 &
             (ALL i:I1. PXf2 (f i) = PXf1 i) |]
     ==> [||]:I1 PXf1 =F[M,M] [||]:I2 PXf2"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Rep_parallel_index_eq)
apply (case_tac "I1 = {}", simp)
apply (rule order_antisym)

 (* <= *)
 apply (rule)
 apply (elim conjE exE)
 apply (simp add: in_failures_Rep_parallel)
 apply (subgoal_tac "Union (snd ` PXf2 ` f ` I1) = Union (snd ` PXf1 ` I1)")
 apply (simp)
 apply (elim conjE exE)
 apply (rule_tac x="(%i. Yf (inv_on I1 f i))" in exI)
 apply (simp add: inv_f_f_on)
 apply (simp add: cspF_Rep_parallel_index_eq_lm1)
 apply (simp add: Union_index_fun)

 (* => *)
 apply (rule)
 apply (elim conjE exE)
 apply (simp add: in_failures_Rep_parallel)
 apply (subgoal_tac "Union (snd ` PXf2 ` f ` I1) = Union (snd ` PXf1 ` I1)")
 apply (simp)
 apply (elim conjE exE)
 apply (rule_tac x="(%i. Yf (f i))" in exI)
 apply (simp)
 apply (simp add: cspF_Rep_parallel_index_eq_lm2)
 apply (simp add: Union_index_fun)
done

(*********************************************************
                [||]:I PXf ==> [||] PXs
 *********************************************************)

(*------------------*
 |      csp law     |
 *------------------*)

lemma cspF_Index_to_Inductive_parallel:
  "[| finite I ; Is isListOf I |] ==>
   [||]:I PXf =F[M,M] [||] (map PXf Is)"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Index_to_Inductive_parallel)
apply (case_tac "I = {}", simp)

apply (case_tac "map PXf Is = []")
apply (simp)
apply (rule order_antisym)

 (* <= *)
 apply (rule)
 apply (simp add: in_failures_Rep_parallel)
 apply (simp add: in_failures_Inductive_parallel_nth)
 apply (simp add: isListOf_set_eq)
 apply (elim conjE exE)
  apply (rule_tac x= "map Yf Is" in exI)
  apply (simp)
  apply (rule conjI)
  apply (rule in_failures_Rep_parallel_lm2, simp)
  apply (intro allI impI)
  apply (drule_tac x="Is ! i" in bspec)
  apply (simp add: isListOf_nth_in_index)
  apply (simp)

 (* => *)
 apply (rule)
 apply (simp add: in_failures_Rep_parallel)
 apply (simp add: in_failures_Inductive_parallel_nth)
 apply (simp add: isListOf_set_eq)
 apply (elim conjE exE)
 apply (rule_tac x= "(%i. (Ys!(THE n. (Is!n) = i & n<length Is)))" in exI)
  apply (rule conjI)
  apply (simp add: in_failures_Rep_parallel_lm1)
  apply (rule ballI)

  apply (erule isListOf_index_to_nthE)
  apply (drule_tac x="i" in bspec, simp)
  apply (elim conjE exE, simp)

  apply (drule_tac x="n" in spec, simp)
  apply (rotate_tac 4)
  apply (drule sym)
  apply (simp add: isListOf_THE_nth)
done

(************************************
 |       [||]:I PXf and SKIP        |
 ************************************)

lemma cspF_SKIP_Rep_parallel_right_lm1:
  "I ~= {} ==>
   insert Tick (Union {(Yf i Int insert Tick (Ev ` snd (PXf i))) |i. i : I})
   = Union {(insert Tick (Yf i Int Ev ` snd (PXf i))) |i. i : I}"
by (auto)

(*------------------*
 |      csp law     |
 *------------------*)

lemma cspF_SKIP_Rep_parallel_right:
  "finite I ==>
   (([||]:I PXf) |[Union (snd `  PXf ` I), {}]| SKIP) =F[M,M]
   ([||]:I PXf)"
apply (case_tac "I={}")
apply (simp add: cspF_SKIP_Alpha_parallel)

apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_SKIP_Rep_parallel_right)
apply (rule order_antisym)

(* => *)
 apply (rule)
 apply (simp add: in_failures_Alpha_parallel)
 apply (simp add: in_failures_Rep_parallel)
 apply (elim conjE exE)

  apply (case_tac "Tick ~: Z")
  apply (simp)
  apply (rule_tac x="Yf" in exI)
  apply (rule conjI)
  apply (subgoal_tac "Z Int {Tick} = {}")
  apply (simp (no_asm_simp))
  apply (simp)

  apply (intro ballI)
  apply (drule_tac x="i" in bspec, simp)
  apply (subgoal_tac " snd (PXf i) <= Union (snd ` PXf ` I)")
  apply (simp add: rest_tr_of_rest_tr_subset)
  apply (force)

  apply (simp add: in_failures)
  apply (erule disjE)
  apply (simp add: Evset_def)
  apply (force)

  apply (rule_tac x="(%i. insert Tick (Yf i))" in exI)
  apply (simp)
  apply (subgoal_tac "Z Int {Tick} = {Tick}", simp)
  apply (simp add: cspF_SKIP_Rep_parallel_right_lm1)

  apply (intro ballI)
  apply (drule_tac x="i" in bspec, simp)
  apply (subgoal_tac " snd (PXf i) <= Union (snd ` PXf ` I)")
  apply (simp add: rest_tr_of_rest_tr_subset)

  apply (simp add: rest_tr_Tick_sett)
  apply (elim conjE exE)
  apply (simp)
  apply (rule proc_T2_T3)
  apply (simp)
  apply (simp)
  apply (force)
  apply (force)

(* <= *)
 apply (rule)
 apply (simp add: in_failures_Alpha_parallel)
 apply (rule_tac x="X" in exI)
 apply (rule_tac x="{}" in exI)
 apply (simp)

 apply (simp add: in_failures)
 apply (simp add: rest_tr_empty)
 apply (simp add: in_failures_Rep_parallel)
 apply (elim conjE exE)
 apply (rule_tac x="Yf" in exI)
 apply (simp)
 apply (intro ballI)
 apply (drule_tac x="i" in bspec, simp)

 apply (subgoal_tac " snd (PXf i) <= Union (snd ` PXf ` I)")
 apply (simp add: rest_tr_of_rest_tr_subset)
 apply (force)
done

(************************************
 |        SKIP and [||]:I PXf       |
 ************************************)

(*------------------*
 |      csp law     |
 *------------------*)

lemma cspF_SKIP_Rep_parallel_left:
  "finite I ==>
   (SKIP |[{}, Union (snd ` PXf ` I)]| ([||]:I PXf)) =F[M,M]
   ([||]:I PXf)"
apply (subgoal_tac
    "(SKIP |[{}, Union (snd ` PXf ` I)]| ([||]:I PXf)) =F[M,M]
     (([||]:I PXf) |[Union (snd ` PXf ` I), {}]| SKIP)")
apply (rule cspF_trans)
apply (simp)
apply (simp add: cspF_SKIP_Rep_parallel_right)
apply (simp add: cspF_Alpha_parallel_commut)
done

(*** left and right ***)

lemmas cspF_SKIP_Rep_parallel = cspF_SKIP_Rep_parallel_left
                                  cspF_SKIP_Rep_parallel_right

(************************************
 |          associativity           |
 ************************************)

lemma cspF_Rep_parallel_ass_lm1:
   "Union {(Yf i Int insert Tick (Ev ` snd (PXf i))) |i. i : I} Int
           insert Tick (Ev ` Union (snd ` PXf ` I))
    = Union {(Yf i Int insert Tick (Ev ` snd (PXf i))) |i. i : I}"
by (auto)

lemma cspF_Rep_parallel_ass_lm2:
   "I1 Int I2 = {} ==>
    Union {(Yf1 i Int insert Tick (Ev ` snd (PXf i))) |i. i : I1} Un
    Union {(Yf2 i Int insert Tick (Ev ` snd (PXf i))) |i. i : I2} =
    Union {(if i : I1 then Yf1 i else Yf2 i) Int insert Tick (Ev ` snd (PXf i)) |i.
           i : I1 | i : I2}"
apply (rule)

 apply (rule)
 apply (simp)
 apply (elim disjE conjE exE)

  apply (rule_tac x="Yf1 i Int insert Tick (Ev ` snd (PXf i))" in exI, simp)
  apply (rule_tac x="i" in exI, simp)
  apply (rule_tac x="Yf2 i Int insert Tick (Ev ` snd (PXf i))" in exI, simp)
  apply (rule_tac x="i" in exI, simp)
  apply (force)

 apply (rule)
 apply (simp)
 apply (elim disjE conjE exE)

  apply (rule disjI1)
  apply (rule_tac x="Yf1 i Int insert Tick (Ev ` snd (PXf i))" in exI, simp)
  apply (rule_tac x="i" in exI, simp)
  apply (rule disjI2)
  apply (case_tac "i ~: I1")
  apply (rule_tac x="Yf2 i Int insert Tick (Ev ` snd (PXf i))" in exI, simp)
  apply (rule_tac x="i" in exI, simp)
  apply (force)
done

(*------------------*
 |      csp law     |
 *------------------*)

lemma cspF_Rep_parallel_assoc:
 "[| I1 Int I2 = {} ; finite I1 ; finite I2 |] ==>
  [||]:(I1 Un I2) PXf =F[M,M]
  [||]:I1 PXf |[Union (snd ` PXf ` I1), Union (snd ` PXf ` I2)]| [||]:I2 PXf"

apply (case_tac "I1 = {}")
apply (case_tac "I2 = {}")
apply (rule cspF_sym)
apply (simp add: cspF_SKIP_Alpha_parallel)
apply (rule cspF_sym)
apply (simp add: cspF_SKIP_Rep_parallel)

apply (case_tac "I2 = {}")
apply (rule cspF_sym)
apply (simp add: cspF_SKIP_Rep_parallel)

apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Rep_parallel_assoc)
apply (rule order_antisym)

 (* => *)
 apply (rule)
 apply (simp add: in_failures_Alpha_parallel)
 apply (simp add: in_failures_Rep_parallel)
 apply (elim conjE exE)

 apply (rule_tac x="Union {(Yf i Int insert Tick (Ev ` snd (PXf i))) |i. i : I1}" in exI)
 apply (rule_tac x="Union {(Yf i Int insert Tick (Ev ` snd (PXf i))) |i. i : I2}" in exI)
 apply (simp add: Union_snd_Un)
 apply (rule conjI)
  apply (simp add: cspF_Rep_parallel_ass_lm1)
  apply (blast)

 apply (rule conjI)

  (* I1 *)
  apply (rule_tac x="Yf" in exI)
  apply (simp add: cspF_Rep_parallel_ass_lm1)

  apply (intro ballI)
  apply (drule_tac x="i" in bspec, simp)
  apply (subgoal_tac "snd (PXf i) <= Union (snd ` PXf ` I1)")
  apply (simp add: rest_tr_of_rest_tr_subset)
  apply (force)

  (* I2 *)
  apply (rule_tac x="Yf" in exI)
  apply (simp add: cspF_Rep_parallel_ass_lm1)

  apply (intro ballI)
  apply (drule_tac x="i" in bspec, simp)
  apply (subgoal_tac "snd (PXf i) <= Union (snd ` PXf ` I2)")
  apply (simp add: rest_tr_of_rest_tr_subset)
  apply (force)

 (* <= *)
 apply (rule)
 apply (simp add: in_failures_Alpha_parallel)
 apply (simp add: in_failures_Rep_parallel)
 apply (elim exE conjE)
 apply (simp add: Union_snd_Un)
 apply (rename_tac s X Y Z Yf1 Yf2)

 apply (rule_tac x="(%i. if i:I1 then Yf1 i else Yf2 i)" in exI)
       (* the necessity of the condition "I1 Int I2 = {}" *)
 apply (simp add: cspF_Rep_parallel_ass_lm2)

 apply (intro ballI)
 apply (simp)
 apply (erule disjE)

  apply (drule_tac x="i" in bspec, simp, simp)
  apply (subgoal_tac "snd (PXf i) <= Union (snd ` PXf ` I1)")
  apply (simp add: rest_tr_of_rest_tr_subset)
  apply (force)

  apply (drule_tac x="i" in bspec, simp)
  apply (case_tac "i ~: I1")
  apply (subgoal_tac "snd (PXf i) <= Union (snd ` PXf ` I2)")
  apply (simp add: rest_tr_of_rest_tr_subset)
  apply (force)
  apply (blast)
done

(************************************
 |             induct               |
 ************************************)

(*------------------*
 |     csp law      |
 |   (derivable)    |
 *------------------*)

lemma cspF_Rep_parallel_induct:
 "[| finite I ; i ~: I |] ==>
  [||]:(insert i I) PXf =F[M,M]
  fst (PXf i) |[snd (PXf i), Union (snd ` PXf ` I)]| [||]:I PXf"
apply (insert cspF_Rep_parallel_assoc[of "{i}" I PXf M])
apply (simp add: Rep_parallel_one)
apply (rule cspF_rw_left)
apply (simp)

apply (insert cspF_Alpha_parallel_assoc
  [of "fst (PXf i)" "snd (PXf i)" "{}" "SKIP" "Union (snd ` PXf ` I)" "[||]:I PXf" M])
apply (rule cspF_trans)
apply (simp)

apply (rule cspF_decompo_Alpha_parallel)
apply (simp_all)

apply (simp add: cspF_SKIP_Rep_parallel)
done

(****************** to add them again ******************)
(*
declare Union_image_eq [simp]
declare Inter_image_eq [simp]
*)
declare Sup_image_eq [simp]
declare Inf_image_eq [simp]

end


theory IICF_MS_Array_List
imports
  "../Intf/IICF_List" IICF_Array
begin
  definition "ms_irel M N \<equiv> br (\<lambda>(l,xs). take l xs) (\<lambda>(l,xs). l\<le>N \<and> N = length xs \<and> N<M)"

  definition "ms_empty N \<equiv> RETURN (0::nat,replicate N init)"
  definition "ms_is_empty \<equiv> \<lambda>(l,_). RETURN (l=0)"
  definition "ms_length \<equiv> \<lambda>(l,_). RETURN l"
  definition "ms_push_back \<equiv> \<lambda>(l,xs) x. doN {ASSERT (l < length xs); RETURN (l+1,xs[l:=x])}"
  definition "ms_last \<equiv> \<lambda>(l,xs). doN {ASSERT (0<l \<and> l\<le>length xs); RETURN (xs!(l-1))}"
  definition "ms_butlast \<equiv> \<lambda>(l,xs). doN {ASSERT (l>0); RETURN (l-1,xs)}"
  definition "ms_get \<equiv> \<lambda>(l,xs) i. doN {ASSERT (i<length xs); RETURN (xs!i)}"
  definition "ms_set \<equiv> \<lambda>(l,xs) i x. doN {ASSERT (i<length xs); RETURN (l,xs[i:=x])}"

  context begin

    private method ms_prove_refine =
      (unfold ms_irel_def curry0_def;
        intro nres_relI fun_relI frefI;
        simp?;
        refine_vcg?;
        (auto simp: in_br_conv)
      )

    lemma ms_empty_correct: "N<M \<Longrightarrow> (ms_empty N,mop_list_empty) \<in> \<langle>ms_irel M N\<rangle>nres_rel"
      unfolding ms_empty_def by ms_prove_refine

    lemma ms_is_empty_correct: "(ms_is_empty,mop_list_is_empty) \<in> ms_irel M N \<rightarrow> \<langle>bool_rel\<rangle>nres_rel"
      unfolding ms_is_empty_def by ms_prove_refine

    lemma ms_length_correct: "(ms_length,mop_list_length) \<in> ms_irel M N \<rightarrow> \<langle>nat_rel\<rangle>nres_rel"
      unfolding ms_length_def by ms_prove_refine

    lemma ms_push_back_correct: "(uncurry ms_push_back,uncurry mop_list_append)
      \<in> [\<lambda>(xs,x). length xs < N]\<^sub>f (ms_irel M N \<times>\<^sub>r Id) \<rightarrow> \<langle>ms_irel M N\<rangle>nres_rel"
      unfolding ms_push_back_def
      supply [simp] = take_update_last
      by ms_prove_refine

    lemma ms_last_correct: "(ms_last,mop_list_last)\<in>ms_irel M N \<rightarrow> \<langle>Id\<rangle>nres_rel"
      unfolding ms_last_def supply [simp] = last_take_nth_conv by ms_prove_refine

    lemma ms_butlast_correct: "(ms_butlast,mop_list_butlast)\<in>ms_irel M N \<rightarrow> \<langle>ms_irel M N\<rangle>nres_rel"
      unfolding ms_butlast_def supply [simp] = butlast_take by ms_prove_refine

    lemma ms_get_correct: "(ms_get,mop_list_get)\<in>ms_irel M N \<rightarrow> nat_rel \<rightarrow> \<langle>Id\<rangle>nres_rel"
      unfolding ms_get_def by ms_prove_refine

    lemma ms_set_correct: "(ms_set,mop_list_set)\<in>ms_irel M N \<rightarrow> nat_rel \<rightarrow> Id \<rightarrow> \<langle>ms_irel M N\<rangle>nres_rel"
      unfolding ms_set_def by ms_prove_refine

  end

  type_synonym ('l,'a) marl = "'l word \<times> 'a ptr"

  lemma ms_irel_prenorm:
    assumes "((l,xs),xs')\<in>ms_irel M N"
    shows "length xs = N \<and> l=length xs' \<and> length xs'\<le>N \<and> N < M"
    using assms
    unfolding ms_irel_def
    by (auto simp: in_br_conv)

  context
    fixes M :: nat
    defines "M \<equiv> max_snat (LENGTH ('l::len2))"
    notes [fcomp_prenorm_simps] = ms_irel_prenorm[where M=M]
  begin
    abbreviation "marl2_assn \<equiv> snat_assn' TYPE('l) \<times>\<^sub>a array_assn id_assn"

    sepref_definition marl_empty_impl [llvm_inline] is "ms_empty" :: "(snat_assn' TYPE('l))\<^sup>k \<rightarrow>\<^sub>a marl2_assn"
      unfolding ms_empty_def
      supply [sepref_import_param] = IdI[of init]
      apply (annot_snat_const "TYPE('l)")
      apply (rewrite array_fold_custom_replicate)
      by sepref

    definition [simp]: "marl_empty_aux (N::nat) \<equiv> op_list_empty"

    sepref_decl_op marl_empty: marl_empty_aux :: "nat_rel \<rightarrow> \<langle>A\<rangle>list_rel" .

    lemma ms_empty_correct': "(ms_empty,RETURN o op_marl_empty)
      \<in> [\<lambda>N. N<M]\<^sub>f\<^sub>d nat_rel \<rightarrow> (\<lambda>N. \<langle>ms_irel M N\<rangle>nres_rel)"
      apply (rule frefI) using ms_empty_correct by auto

    (*
    definition "marl_assn' TYPE('l) N A \<equiv> hr_comp (hr_comp marl2_assn (ms_irel (max_snat LENGTH('l)) N))
                                     (\<langle>the_pure A\<rangle>list_rel)"
    *)

    definition "marl_assn' TYPE('l) A N \<equiv> hrr_comp nat_rel
                                    (\<lambda>N _. hr_comp marl2_assn (ms_irel M N))
                                    (\<lambda>_. \<langle>the_pure A\<rangle>list_rel) N ()"

    lemmas [fcomp_norm_unfold] = marl_assn'_def[symmetric, abs_def]

    lemma marl_assn'_fold''[fcomp_norm_unfold]:
      "hrr_comp nat_rel (\<lambda>x _. hr_comp (snat_assn \<times>\<^sub>a array_assn id_assn) (ms_irel M x)) (\<lambda>x. \<langle>the_pure A\<rangle>list_rel)
      = (\<lambda>N _. marl_assn' TYPE('l) A N)"
      unfolding marl_assn'_def
      by auto

    lemma marl_assn'_fold'[fcomp_norm_unfold]:
      "hr_comp (hr_comp (snat_assn \<times>\<^sub>a array_assn id_assn) (ms_irel M N)) (\<langle>the_pure A\<rangle>list_rel)
        = marl_assn' TYPE('l) A N"
      unfolding marl_assn'_def
      unfolding hrr_comp_def
      apply (auto simp: fun_eq_iff sep_algebra_simps pred_lift_extract_simps)
      unfolding non_dep2_def by metis+

    sepref_decl_impl marl_empty: marl_empty_impl.refine[FCOMP ms_empty_correct'] by simp

    sepref_definition marl_is_empty_impl [llvm_inline] is ms_is_empty :: "marl2_assn\<^sup>k \<rightarrow>\<^sub>a bool1_assn"
      unfolding ms_is_empty_def
      apply (annot_snat_const "TYPE('l)")
      apply sepref_dbg_keep
      done

    sepref_decl_impl (ismop) marl_is_empty_impl.refine[FCOMP ms_is_empty_correct[of M]] .

    sepref_definition marl_length_impl [llvm_inline] is ms_length :: "marl2_assn\<^sup>k \<rightarrow>\<^sub>a snat_assn' TYPE('l)"
      unfolding ms_length_def
      by sepref
    sepref_decl_impl (ismop) marl_length_impl.refine[FCOMP ms_length_correct[of M]] .

    sepref_definition marl_push_back_impl [llvm_code] is
      "uncurry ms_push_back" :: "[\<lambda>((l,a),_). length a < M ]\<^sub>a marl2_assn\<^sup>d*\<^sub>aid_assn\<^sup>k \<rightarrow> marl2_assn"
      unfolding ms_push_back_def M_def
      apply (annot_snat_const "TYPE('l)")
      apply sepref_dbg_keep
      done

    sepref_decl_impl (ismop) marl_push_back_impl.refine[FCOMP ms_push_back_correct[where M=M]]
      by (parametricity add: IdI[of N])

    sepref_definition marl_last_impl [llvm_code] is
      "ms_last" :: "marl2_assn\<^sup>k \<rightarrow>\<^sub>a id_assn"
      unfolding ms_last_def M_def
      apply (annot_snat_const "TYPE('l)")
      apply sepref_dbg_keep
      done
    sepref_decl_impl (ismop) marl_last_impl.refine[FCOMP ms_last_correct[where M=M]] .

    sepref_definition marl_butlast_impl [llvm_code] is
      "ms_butlast" :: "marl2_assn\<^sup>d \<rightarrow>\<^sub>a marl2_assn"
      unfolding ms_butlast_def M_def
      apply (annot_snat_const "TYPE('l)")
      apply sepref_dbg_keep
      done
    sepref_decl_impl (ismop) marl_butlast_impl.refine[FCOMP ms_butlast_correct[where M=M]] .

    sepref_definition marl_get_impl [llvm_inline] is
      "uncurry ms_get" :: "marl2_assn\<^sup>k *\<^sub>a (snat_assn' TYPE('l))\<^sup>k \<rightarrow>\<^sub>a id_assn"
      unfolding ms_get_def M_def
      apply sepref_dbg_keep
      done
    sepref_decl_impl (ismop) marl_get_impl.refine[FCOMP ms_get_correct[where M=M]] .

    sepref_definition marl_set_impl [llvm_inline] is
      "uncurry2 ms_set" :: "marl2_assn\<^sup>d *\<^sub>a (snat_assn' TYPE('l))\<^sup>k *\<^sub>a id_assn\<^sup>k \<rightarrow>\<^sub>a marl2_assn"
      unfolding ms_set_def M_def
      apply sepref_dbg_keep
      done
    sepref_decl_impl (ismop) marl_set_impl.refine[FCOMP ms_set_correct[where M=M]] .
  end

  lemma fold_marl_empty:
    "[] = op_marl_empty N"
    "RETURN [] = mop_marl_empty N"
    "op_list_empty = op_marl_empty N"
    "mop_list_empty = mop_marl_empty N"
    by auto

  (* TODO: Move *)

  schematic_goal [sepref_frame_free_rules]: "MK_FREE (marl_assn' TYPE('l::len2) A N) ?f"
    unfolding marl_assn'_fold'[symmetric]
    by sepref_dbg_side

  lemma marl_assn'_boundsD[sepref_bounds_dest]:
     "rdomp (marl_assn' TYPE('l::len2) A N) xs \<Longrightarrow> length xs \<le> N \<and> N < max_snat LENGTH('l)"
    unfolding marl_assn'_def
    supply [sepref_bounds_dest] = ms_irel_prenorm
    by sepref_bounds

  lemma bind_assoc_tagged: "bind$(bind$m$f)$g = bind$m$(\<lambda>\<^sub>2x. bind$(f$x)$g)"
    unfolding autoref_tag_defs by simp

experiment begin

  sepref_definition test is "\<lambda>N. (do {
    let x = op_marl_empty N;
    RETURN (x@[1::nat])
  })" :: "[\<lambda>N. N\<ge>10]\<^sub>a\<^sub>d (snat_assn' TYPE(64))\<^sup>k \<rightarrow> (\<lambda>N _. marl_assn' TYPE(64) (snat_assn' TYPE(64)) N)"
    apply (annot_snat_const "TYPE(64)")
    by sepref

end

end


theory "Ids"
  imports Complex_Main
   "HOL-Library.Code_Target_Int"
   "Syntax"
begin

(*Differential dynamic logic can be defined for any finite types, given a
  few elements of those types (so that we can generate axioms). *)
(*locale ids =
  fixes vid1 :: ident
  fixes vid2 :: ident
  fixes vid3 :: ident
  fixes is_vid1 :: "ident \<Rightarrow> bool"
  fixes fid1 :: ident
  fixes fid2 :: ident
  fixes fid3 :: ident
  fixes pid1 :: ident
  fixes pid2 :: ident
  fixes pid3 :: ident
  fixes pid4 :: ident
  assumes vne12:"vid1 \<noteq> vid2"
  assumes vne23:"vid2 \<noteq> vid3"
  assumes vne13:"vid1 \<noteq> vid3"
  assumes fne12:"fid1 \<noteq> fid2"
  assumes fne23:"fid2 \<noteq> fid3"
  assumes fne13:"fid1 \<noteq> fid3"
  assumes pne12:"pid1 \<noteq> pid2"
  assumes pne23:"pid2 \<noteq> pid3"
  assumes pne13:"pid1 \<noteq> pid3"
  assumes pne14:"pid1 \<noteq> pid4"
  assumes pne24:"pid2 \<noteq> pid4"
  assumes pne34:"pid3 \<noteq> pid4"
context ids begin*)
  lemma vne12:"Ix \<noteq> Iy" apply (auto simp add: Ix_def Iy_def Iz_def Iw_def)using Ix.abs_eq Ix.rep_eq Iy.abs_eq Iy.rep_eq  Iz.abs_eq Iz.rep_eq Iw.abs_eq Iw.rep_eq by auto
  lemma vne23:"Iy \<noteq> Iz" apply (auto simp add: Ix_def Iy_def Iz_def Iw_def)using Ix.abs_eq Ix.rep_eq Iy.abs_eq Iy.rep_eq  Iz.abs_eq Iz.rep_eq Iw.abs_eq Iw.rep_eq by auto
  lemma vne13:"Ix \<noteq> Iz" apply (auto simp add: Ix_def Iy_def Iz_def Iw_def)using Ix.abs_eq Ix.rep_eq Iy.abs_eq Iy.rep_eq  Iz.abs_eq Iz.rep_eq Iw.abs_eq Iw.rep_eq by auto
  lemma fne12:"Ix \<noteq> Iy" apply (auto simp add: Ix_def Iy_def Iz_def Iw_def)using Ix.abs_eq Ix.rep_eq Iy.abs_eq Iy.rep_eq  Iz.abs_eq Iz.rep_eq Iw.abs_eq Iw.rep_eq by auto
  lemma fne23:"Iy \<noteq> Iz" apply (auto simp add: Ix_def Iy_def Iz_def Iw_def)using Ix.abs_eq Ix.rep_eq Iy.abs_eq Iy.rep_eq  Iz.abs_eq Iz.rep_eq Iw.abs_eq Iw.rep_eq by auto
  lemma fne13:"Ix \<noteq> Iz" apply (auto simp add: Ix_def Iy_def Iz_def Iw_def)using Ix.abs_eq Ix.rep_eq Iy.abs_eq Iy.rep_eq  Iz.abs_eq Iz.rep_eq Iw.abs_eq Iw.rep_eq by auto
  lemma pne12:"Ix \<noteq> Iy" apply (auto simp add: Ix_def Iy_def Iz_def Iw_def)using Ix.abs_eq Ix.rep_eq Iy.abs_eq Iy.rep_eq  Iz.abs_eq Iz.rep_eq Iw.abs_eq Iw.rep_eq by auto
  lemma pne23:"Iy \<noteq> Iz" apply (auto simp add: Ix_def Iy_def Iz_def Iw_def)using Ix.abs_eq Ix.rep_eq Iy.abs_eq Iy.rep_eq  Iz.abs_eq Iz.rep_eq Iw.abs_eq Iw.rep_eq by auto
  lemma pne13:"Ix \<noteq> Iz" apply (auto simp add: Ix_def Iy_def Iz_def Iw_def)using Ix.abs_eq Ix.rep_eq Iy.abs_eq Iy.rep_eq  Iz.abs_eq Iz.rep_eq Iw.abs_eq Iw.rep_eq by auto
  lemma pne14:"Ix \<noteq> Iw" apply (auto simp add: Ix_def Iy_def Iz_def Iw_def)using Ix.abs_eq Ix.rep_eq Iy.abs_eq Iy.rep_eq  Iz.abs_eq Iz.rep_eq Iw.abs_eq Iw.rep_eq by auto
  lemma pne24:"Iy \<noteq> Iw" apply (auto simp add: Ix_def Iy_def Iz_def Iw_def)using Ix.abs_eq Ix.rep_eq Iy.abs_eq Iy.rep_eq  Iz.abs_eq Iz.rep_eq Iw.abs_eq Iw.rep_eq by auto
  lemma pne34:"Iz \<noteq> Iw" apply (auto simp add: Ix_def Iy_def Iz_def Iw_def)using Ix.abs_eq Ix.rep_eq Iy.abs_eq Iy.rep_eq  Iz.abs_eq Iz.rep_eq Iw.abs_eq Iw.rep_eq by auto

  lemma id_simps:
    "(Ix = Iy) = False" "(Iy = Iz) = False" "(Ix = Iz) = False"
    "(Ix = Iy) = False" "(Iy = Iz) = False" "(Ix = Iz) = False"
    "(Ix = Iy) = False" "(Iy = Iz) = False" "(Ix = Iz) = False"
    "(Ix = Iw) = False" "(Iy = Iw) = False" "(Iz = Iw) = False"
    "(Iy = Ix) = False" "(Iz = Iy) = False" "(Iz = Ix) = False"
    "(Iy = Ix) = False" "(Iz = Iy) = False" "(Iz = Ix) = False"
    "(Iy = Ix) = False" "(Iz = Iy) = False" "(Iz = Ix) = False"
    "(Iw = Ix) = False" "(Iw = Iy) = False" "(Iw = Iz) = False"
    using vne12 vne23 vne13 fne12 fne23 fne13 pne12 pne23 pne13 pne14 pne24 pne34 by auto

(* Function applied to one argument *)
definition f1::"ident \<Rightarrow> ident \<Rightarrow> trm"
where "f1 f x = Function f (singleton (Var x))"

(* Function applied to zero arguments (simulates a constant symbol given meaning by the interpretation) *)
definition f0::"ident \<Rightarrow> trm"
where "f0 f = Function f empty"

(* Predicate applied to one argument *)
definition p1::"ident \<Rightarrow> ident \<Rightarrow> formula"
where "p1 p x = Prop p (singleton (Var x))"

(* Predicational *)
definition P::"ident \<Rightarrow> formula"
where "P p = Predicational p"

end


section \<open>Lemmas of Picore-SIMP\<close>

theory picore_SIMP_lemma
imports "picore_SIMP_Syntax" "picore_SIMP"

begin

lemma id_belong[simp]: "Id \<subseteq>\<lbrace>\<ordfeminine>x= \<ordmasculine>x\<rbrace>"
  by (simp add: Collect_mono Id_fstsnd_eq)

lemma allpre_eq_pre: "(\<forall>v\<in>U. \<turnstile>\<^sub>I P sat\<^sub>p [{v}, rely, guar, post]) \<longleftrightarrow> \<turnstile>\<^sub>I P sat\<^sub>p [U, rely, guar, post]"
  apply auto using Allprecond apply blast
  using Conseq[of _ _ rely rely guar guar post post P] by auto

lemma sat_pre_imp_allinpre: " \<turnstile>\<^sub>I P sat\<^sub>p [U, rely, guar, post] \<Longrightarrow> v\<in>U \<Longrightarrow> \<turnstile>\<^sub>I P sat\<^sub>p [{v}, rely, guar, post]"
  using Conseq[of _ _ rely rely guar guar post post P] by auto

lemma stable_int_col2: "stable \<lbrace>s\<rbrace> r \<Longrightarrow> stable \<lbrace>t\<rbrace> r \<Longrightarrow> stable \<lbrace>s \<and> t\<rbrace> r"
  by auto

lemma stable_int_col3: "stable \<lbrace>k\<rbrace> r \<Longrightarrow> stable \<lbrace>s\<rbrace> r \<Longrightarrow> stable \<lbrace>t\<rbrace> r \<Longrightarrow> stable \<lbrace>k \<and> s \<and> t\<rbrace> r"
  by auto

lemma stable_int_col4: "stable \<lbrace>m\<rbrace> r \<Longrightarrow> stable \<lbrace>k\<rbrace> r \<Longrightarrow> stable \<lbrace>s\<rbrace> r
  \<Longrightarrow> stable \<lbrace>t\<rbrace> r \<Longrightarrow> stable \<lbrace>m \<and> k \<and> s \<and> t\<rbrace> r"
  by auto

lemma stable_int_col5: "stable \<lbrace>q\<rbrace> r \<Longrightarrow> stable \<lbrace>m\<rbrace> r \<Longrightarrow>  stable \<lbrace>k\<rbrace> r
  \<Longrightarrow> stable \<lbrace>s\<rbrace> r \<Longrightarrow> stable \<lbrace>t\<rbrace> r \<Longrightarrow> stable \<lbrace>q \<and> m \<and> k \<and> s \<and> t\<rbrace> r"
  by auto

lemma stable_un2: "stable s r \<Longrightarrow> stable t r \<Longrightarrow> stable (s \<union> t) r"
  by (simp add: stable_def)

lemma stable_un_R: "stable s r \<Longrightarrow> stable s r' \<Longrightarrow> stable s (r \<union> r')"
  by (meson UnE stable_def)

lemma stable_un_S: "\<forall>t. stable s (P t) \<Longrightarrow> stable s (\<Union>t. P t)"
apply(simp add:stable_def) by auto

lemma stable_un_S2: "\<forall>t x. stable s (P t x) \<Longrightarrow> stable s (\<Union>t x. P t x)"
apply(simp add:stable_def) by auto

lemma pairv_IntI:
"y \<in> \<lbrace>\<acute>(Pair V) \<in> A\<rbrace> \<Longrightarrow> y \<in> \<lbrace>\<acute>(Pair V) \<in> B\<rbrace> \<Longrightarrow> y \<in> \<lbrace>\<acute>(Pair V) \<in> A \<inter> B\<rbrace>"
by auto

lemma pairv_rId:
"y \<in> \<lbrace>\<acute>(Pair V) \<in> A\<rbrace> \<Longrightarrow> y \<in> \<lbrace>\<acute>(Pair V) \<in> A \<union> Id\<rbrace>"
by auto

end


subsection {* Relational Hoare calculus *}

theory utp_hoare_helper
imports utp_hoare_total
begin
named_theorems utp_hoare_hp

subsection {*Try Catch Laws*}

text{*In this section we introduce the algebraic laws of programming related to the assignment
      statement.*}

lemma try_catch_unfold_hoare: (*because seq is assoc*)
  "\<lbrace>p\<rbrace>try  R ;; P catch  Q end\<lbrace>q\<rbrace>\<^sub>A\<^sub>B\<^sub>R =
   \<lbrace>p\<rbrace>R ;; try  P catch Q end\<lbrace>q\<rbrace>\<^sub>A\<^sub>B\<^sub>R"
   apply pred_simp
   apply rel_simp
   apply auto
   apply smt+
done

lemma try_catch_abr_fold_hoare[utp_hoare_hp]: (*because seq is assoc*)
  "\<lbrace>p\<rbrace>R ;; try  P catch Q end \<lbrace>q\<rbrace>\<^sub>A\<^sub>B\<^sub>R =
   \<lbrace>p\<rbrace>try  R ;; P catch  Q end \<lbrace>q\<rbrace>\<^sub>A\<^sub>B\<^sub>R"
   apply pred_simp
   apply rel_simp
   apply auto
   apply smt+
done

lemma try_catch_abr_throw_abr_hoare [utp_hoare_hp]:
  "\<lbrace>p\<rbrace> try THROW\<^sub>A\<^sub>B\<^sub>R  catch Q end\<lbrace>q\<rbrace>\<^sub>A\<^sub>B\<^sub>R =
   \<lbrace>p\<rbrace> Q \<lbrace>q\<rbrace>\<^sub>A\<^sub>B\<^sub>R"
   apply pred_simp
   apply rel_simp
   apply auto
   apply smt+
done

lemma try_catch_abr_skip_abr_hoare [utp_hoare_hp]:
  "\<lbrace>p\<rbrace>try  SKIP\<^sub>A\<^sub>B\<^sub>R catch Q end\<lbrace>q\<rbrace>\<^sub>A\<^sub>B\<^sub>R =
   \<lbrace>p\<rbrace>SKIP\<^sub>A\<^sub>B\<^sub>R\<lbrace>q\<rbrace>\<^sub>A\<^sub>B\<^sub>R"
   apply pred_simp
   apply rel_simp
   apply auto
   apply smt
done

lemma try_catch_abr_assigns_abr_hoare [utp_hoare_hp]:
  "\<lbrace>p\<rbrace>try   \<langle>\<sigma>\<rangle>\<^sub>A\<^sub>B\<^sub>R catch Q end\<lbrace>q\<rbrace>\<^sub>A\<^sub>B\<^sub>R = \<lbrace>p\<rbrace> \<langle>\<sigma>\<rangle>\<^sub>A\<^sub>B\<^sub>R\<lbrace>q\<rbrace>\<^sub>A\<^sub>B\<^sub>R"
   apply pred_simp
   apply rel_simp
   apply auto
   apply smt+
done

subsection {*Examples*}

lemma
  "\<lbrace>p\<rbrace> try THROW\<^sub>A\<^sub>B\<^sub>R ;; SKIP\<^sub>A\<^sub>B\<^sub>R catch Q end\<lbrace>q\<rbrace>\<^sub>A\<^sub>B\<^sub>R = \<lbrace>p\<rbrace>Q\<lbrace>q\<rbrace>\<^sub>A\<^sub>B\<^sub>R"
   by (simp only: utp_hoare_hp  uabr_comp)

lemma
  "\<lbrace>p\<rbrace>THROW\<^sub>A\<^sub>B\<^sub>R ;; try \<langle>\<sigma>\<rangle>\<^sub>A\<^sub>B\<^sub>R catch Q end\<lbrace>q\<rbrace>\<^sub>A\<^sub>B\<^sub>R =
   \<lbrace>p\<rbrace>Q \<lbrace>q\<rbrace>\<^sub>A\<^sub>B\<^sub>R"
  by (simp only: utp_hoare_hp  uabr_comp)

lemma
  "\<lbrace>p\<rbrace>THROW\<^sub>A\<^sub>B\<^sub>R ;; try Simpl\<^sub>A\<^sub>B\<^sub>R P catch Q end\<lbrace>q\<rbrace>\<^sub>A\<^sub>B\<^sub>R = \<lbrace>p\<rbrace>Q\<lbrace>q\<rbrace>\<^sub>A\<^sub>B\<^sub>R"
  by (simp only: utp_hoare_hp  uabr_comp)

lemma
  "\<lbrace>p\<rbrace> try THROW\<^sub>A\<^sub>B\<^sub>R;; Simpl\<^sub>A\<^sub>B\<^sub>R P catch Simpl\<^sub>A\<^sub>B\<^sub>R Q end\<lbrace>q\<rbrace>\<^sub>A\<^sub>B\<^sub>R =
   \<lbrace>p\<rbrace>Simpl\<^sub>A\<^sub>B\<^sub>R Q \<lbrace>q\<rbrace>\<^sub>A\<^sub>B\<^sub>R"
   by (simp only: utp_hoare_hp  uabr_comp)

end


(*<*)

(* Author: Kyndylan Nienhuis *)

theory Examples

imports
  "CHERI-instantiation.CheriInstantiation"
  "TraceProperties"
begin
(*>*)

section \<open>Reference monitor\<close>

definition CapabilityAligned :: "('a::len) word set \<Rightarrow> bool" where
  "CapabilityAligned addresses \<equiv>
   \<forall>a b. (a AND NOT mask 5 = b AND NOT mask 5) \<longrightarrow>
         a \<in> addresses \<longrightarrow>
         b \<in> addresses"

lemma CapabilityAlignedE:
  fixes addresses :: "('a::len) word set"
  assumes "CapabilityAligned addresses"
      and "a AND NOT mask 5 = b AND NOT mask 5"
      and "a \<in> addresses"
  shows "b \<in> addresses"
using assms
unfolding CapabilityAligned_def
by blast

lemma CapabilityAligned_CapAddressE:
  fixes addresses :: "40 word set"
  assumes "CapabilityAligned addresses"
      and "GetCapAddress a = GetCapAddress b"
      and "a \<in> addresses"
  shows "b \<in> addresses"
proof -
  have "a AND NOT mask 5 = b AND NOT mask 5"
    using `GetCapAddress a = GetCapAddress b`
    unfolding GetCapAddress_def
    using slice_eq_imp_and_not_mask_eq[where x=a and y=b and n=5 and 'b=35]
    by auto
  thus ?thesis
    using assms CapabilityAlignedE
    by metis
qed

lemma TranslationCapabilityAligned:
  assumes "CapabilityAligned segment"
  shows "CapabilityAligned (getTranslateAddresses segment t s)"
unfolding CapabilityAligned_def
proof clarify
  fix a b :: PhysicalAddress
  assume aligned: "a AND NOT mask 5 = b AND NOT mask 5"
     and "a \<in> getTranslateAddresses segment t s"
  then obtain virtA where "virtA \<in> segment"
                      and a: "getTranslateAddr (virtA, t) s = Some a"
    by auto
  define virtB where "virtB \<equiv> (virtA AND NOT mask 12) OR ((ucast b) AND mask 12)"
  have virtB_upper: "virtB AND NOT mask 12 = virtA AND NOT mask 12"
    unfolding virtB_def
    by (simp add: word_ao_dist word_bool_alg.conj_assoc)
  have virtB_lower: "ucast virtB AND mask 12 = b AND mask 12"
    unfolding virtB_def
    by (auto simp: word_ao_dist word_bool_alg.conj_assoc ucast_and ucast_or ucast_not)
  have "getTranslateAddr (virtA AND NOT mask 12, t) s = Some (a AND NOT mask 12)"
    using a
    unfolding getTranslateAddr_and_not_mask
    by simp
  hence "getTranslateAddr (virtB AND NOT mask 12, t) s = Some (b AND NOT mask 12)"
    using arg_cong[OF aligned, where f="\<lambda>x. x AND NOT mask 12"]
    by (simp add: virtB_upper)
  hence b: "getTranslateAddr (virtB, t) s = Some b"
    unfolding getTranslateAddr_split[where vAddr=virtB]
    by (auto simp: virtB_lower)
  have "virtA AND NOT mask 5 = virtB AND NOT mask 5"
    proof (intro word_eqI, simp add: word_size, intro impI)
      fix n :: nat
      assume "n < 64"
      thus "(virtA AND NOT mask 5) !! n = (virtB AND NOT mask 5) !! n"
        using word_eqD[OF aligned, where x=n]
        using word_eqD[OF virtB_upper, where x=n]
        using word_eqD[OF getTranslateAddr_ucast12[OF a], where x=n]
        using word_eqD[OF getTranslateAddr_ucast12[OF b], where x=n]
        by (cases "n < 12") (simp_all add: nth_ucast word_ops_nth_size word_size)
     qed
  from CapabilityAlignedE[OF assms this]
  have "virtB \<in> segment"
    using `virtA \<in> segment`
    by auto
  thus "b \<in> getTranslateAddresses segment t s"
    using b
    unfolding getTranslateAddresses_def
    by auto
qed

definition AuthorityOfSegment where
  "AuthorityOfSegment segment types \<equiv>
   \<lparr>SystemRegisterAccess = False,
    ExecutableAddresses = segment,
    LoadableAddresses = segment,
    CapLoadableAddresses = segment,
    StorableAddresses = segment,
    CapStorableAddresses = segment,
    LocalCapStorableAddresses = segment,
    SealableTypes = types,
    UnsealableTypes = types\<rparr>"

lemma AuthorityOfSegment_simp [simp]:
  shows "SystemRegisterAccess (AuthorityOfSegment segment types) = False"
    and "ExecutableAddresses (AuthorityOfSegment segment types) = segment"
    and "LoadableAddresses (AuthorityOfSegment segment types) = segment"
    and "CapLoadableAddresses (AuthorityOfSegment segment types) = segment"
    and "StorableAddresses (AuthorityOfSegment segment types) = segment"
    and "CapStorableAddresses (AuthorityOfSegment segment types) = segment"
    and "LocalCapStorableAddresses (AuthorityOfSegment segment types) = segment"
    and "SealableTypes (AuthorityOfSegment segment types) = types"
    and "UnsealableTypes (AuthorityOfSegment segment types) = types"
unfolding AuthorityOfSegment_def
by simp_all

definition GrantedCaps where
  "GrantedCaps segment s \<equiv>
   {getCapReg r s |r. RegisterIsAlwaysAccessible r} \<union>
   {getMemCap (GetCapAddress a) s |a. a \<in> getTranslateAddresses segment LOAD s}"

lemma ReadableCaps_AuthorityOfSegment:
  shows "ReadableCaps (AuthorityOfSegment segment types) s =
         {cap. cap \<in> GrantedCaps segment s \<and> getTag cap}"
proof (intro equalityI; clarify, (intro conjI)?)
  fix cap
  assume "cap \<in> GrantedCaps segment s"
     and "getTag cap"
  thus "cap \<in> ReadableCaps (AuthorityOfSegment segment types) s"
    unfolding GrantedCaps_def
    proof (elim UnE; clarify)
      fix r
      assume "RegisterIsAlwaysAccessible r"
         and "getTag (getCapReg r s)"
      thus "getCapReg r s \<in> ReadableCaps (AuthorityOfSegment segment types) s"
        by (auto intro!: ReadableCapsI[where loc="LocReg r"])
    next
      fix a
      assume "a \<in> getTranslateAddresses segment LOAD s"
         and "getTag (getMemCap (GetCapAddress a) s)"
      thus "getMemCap (GetCapAddress a) s \<in> ReadableCaps (AuthorityOfSegment segment types) s"
        by (auto intro!: ReadableCapsI[where loc="LocMem (GetCapAddress a)"]
                 simp: getTranslateCapAddresses_def)
    qed
next
  fix cap
  assume readable: "cap \<in> ReadableCaps (AuthorityOfSegment segment types) s"
  thus "getTag cap" by auto
  show "cap \<in> GrantedCaps segment s"
    using readable
    unfolding ReadableCaps_def
    proof clarify
      fix loc
      assume loc: "loc \<in> ReadableLocations (AuthorityOfSegment segment types) s"
         and tag: "getTag (getCap loc s)"
      show "getCap loc s \<in> GrantedCaps segment s"
        proof (cases loc)
          case (LocReg r)
          hence "RegisterIsAlwaysAccessible r"
            using loc
            by auto
          thus ?thesis
            using loc tag LocReg
            unfolding GrantedCaps_def
            by auto
        next
          case (LocMem a)
          then obtain a' where "a = GetCapAddress a'" "a' \<in> getTranslateAddresses segment LOAD s"
            using loc
            by (auto simp: getTranslateCapAddresses_def)
          thus ?thesis
            using loc tag LocMem
            unfolding GrantedCaps_def
            by auto
        qed
    qed
qed

definition UsableCaps where
  "UsableCaps segment types s \<equiv>
   {cap\<in>GrantedCaps segment s.
    getTag cap \<and>
    (\<not> getSealed cap \<or> getType cap \<in> types)}"

definition InvokableCaps where
  "InvokableCaps segment s \<equiv>
   {cap\<in>GrantedCaps segment s.
    getTag cap \<and> Permit_CCall (getPerms cap)}"

lemma Authority_le_AuthorityOfSegment:
  shows "(GetAuthority cap \<le> AuthorityOfSegment segment types) =
         (\<not> getTag cap \<or>
          ((Permit_Seal (getPerms cap) \<or>
            Permit_Unseal (getPerms cap)) \<longrightarrow>
           (\<forall>t. ucast t \<in> RegionOfCap cap \<longrightarrow> t \<in> types)) \<and>
          ((Permit_Execute (getPerms cap) \<or>
            Permit_Load (getPerms cap) \<or>
            Permit_Load_Capability (getPerms cap) \<or>
            Permit_Store (getPerms cap) \<or>
            Permit_Store_Capability (getPerms cap) \<or>
            Permit_Store_Local_Capability (getPerms cap)) \<longrightarrow>
           RegionOfCap cap \<subseteq> segment) \<and>
          \<not> Access_System_Registers (getPerms cap))"
unfolding less_eq_CompartmentAuthority_ext_def
unfolding GetAuthority_accessors
by auto

definition NoSystemRegisterAccess where
  "NoSystemRegisterAccess segment types s \<equiv>
   \<forall>cap. cap \<in> UsableCaps segment types s \<longrightarrow>
    \<not> Access_System_Registers (getPerms cap)"

definition ContainedCapBounds where
  "ContainedCapBounds segment types s \<equiv>
   \<forall>cap. (cap \<in> UsableCaps segment types s \<and>
          (Permit_Execute (getPerms cap) \<or>
           Permit_Load (getPerms cap) \<or>
           Permit_Load_Capability (getPerms cap) \<or>
           Permit_Store (getPerms cap) \<or>
           Permit_Store_Capability (getPerms cap) \<or>
           Permit_Store_Local_Capability (getPerms cap))) \<longrightarrow>
          RegionOfCap cap \<subseteq> segment"

definition ContainedObjectTypes where
  "ContainedObjectTypes segment types s \<equiv>
   \<forall>cap. (cap \<in> UsableCaps segment types s \<and>
          (Permit_Seal (getPerms cap) \<or>
           Permit_Unseal (getPerms cap))) \<longrightarrow>
         (\<forall>t. ucast t \<in> RegionOfCap cap \<longrightarrow> t \<in> types)"

definition InvokableCapsSetup where
  "InvokableCapsSetup segment types exit s ==
   \<forall>cap. cap \<in> InvokableCaps segment s \<longrightarrow>
         getSealed cap \<and> getType cap \<notin> types \<and> getBase cap + getOffset cap \<in> exit"

definition CapabilitySetup where
  "CapabilitySetup segment types exit s \<equiv>
   NoSystemRegisterAccess segment types s \<and>
   ContainedCapBounds segment types s \<and>
   ContainedObjectTypes segment types s \<and>
   InvokableCapsSetup segment types exit s"

definition IsolationGuarantees where
  "IsolationGuarantees segment exit s s' \<equiv>
   (getBase (getPCC s') + getPC s' \<in> exit) \<and>
   (\<forall>a. a \<notin> getTranslateAddresses segment STORE s \<longrightarrow>
        (getMemByte a s' = getMemByte a s \<and>
         getMemTag (GetCapAddress a) s' = getMemTag (GetCapAddress a) s)) \<and>
   (\<forall>cd. (cd \<noteq> 0 \<and> cd \<noteq> 1 \<and> cd \<noteq> 31) \<longrightarrow>
         getSCAPR cd s' = getSCAPR cd s)"

lemma CompartmentIsolation:
  assumes abstraction: "CanBeSimulated sem"
      and valid: "getStateIsValid s"
      and aligned: "CapabilityAligned segment"
      and ex: "ExceptionPCs \<subseteq> exit"
      and caps: "CapabilitySetup segment types exit s"
      and trace: "(step # trace, s') \<in> Traces sem s"
      and intra: "TracePreservesDomain trace"
      and inter: "\<not> PreservesDomain step"
  shows "IsolationGuarantees segment exit s s'"
unfolding IsolationGuarantees_def
proof (intro conjI allI impI)
  have systemreg: "\<forall>cap. cap \<in> UsableCaps segment types s \<longrightarrow>
                   \<not> Access_System_Registers (getPerms cap)"
    using caps
    unfolding CapabilitySetup_def NoSystemRegisterAccess_def
    by simp
  have segment: "\<forall>cap. (cap \<in> UsableCaps segment types s \<and>
                 (Permit_Execute (getPerms cap) \<or>
                  Permit_Load (getPerms cap) \<or>
                  Permit_Load_Capability (getPerms cap) \<or>
                  Permit_Store (getPerms cap) \<or>
                  Permit_Store_Capability (getPerms cap) \<or>
                  Permit_Store_Local_Capability (getPerms cap))) \<longrightarrow>
                 RegionOfCap cap \<subseteq> segment"
    using caps
    unfolding CapabilitySetup_def ContainedCapBounds_def
    by simp
  have types: "\<forall>cap. (cap \<in> UsableCaps segment types s \<and>
              (Permit_Seal (getPerms cap) \<or>
               Permit_Unseal (getPerms cap))) \<longrightarrow>
              (\<forall>t. ucast t \<in> RegionOfCap cap \<longrightarrow> t \<in> types)"
    using caps
    unfolding CapabilitySetup_def ContainedObjectTypes_def
    by simp
  have invokable: "\<forall>cap. cap \<in> InvokableCaps segment s \<longrightarrow>
                         getSealed cap \<and> getType cap \<notin> types \<and> getBase cap + getOffset cap \<in> exit"
    using caps
    unfolding CapabilitySetup_def InvokableCapsSetup_def
    by simp
  define gPerm where "gPerm = AuthorityOfSegment segment types"
  note [simp] = ReadableCaps_AuthorityOfSegment
  have closed: "PermIsClosed gPerm s"
    unfolding gPerm_def PermIsClosed_def ReadableCaps_AuthorityOfSegment
    proof clarsimp
      fix cap
      assume "cap \<in> GrantedCaps segment s"
             "getTag cap"
             "getSealed cap \<longrightarrow> getType cap \<in> types"
      hence "cap \<in> UsableCaps segment types s"
        unfolding UsableCaps_def
        by auto
      thus "GetAuthority cap \<le> AuthorityOfSegment segment types"
        using systemreg[THEN spec[where x=cap]]
        using segment[THEN spec[where x=cap]]
        using types[THEN spec[where x=cap]]
        unfolding Authority_le_AuthorityOfSegment
        by simp
     qed
  note gPerm_def [simp]
  note gperm = AvailableAuthorityInClosedPerm[OF closed]
  have no_sys: "\<not> SystemRegisterAccess (AvailableAuthority s)"
    using SystemRegisterAccess_le[OF gperm]
    by auto
  obtain r where r\<^sub>1: "(trace, r) \<in> Traces sem s"
             and r\<^sub>2: "(step, s') \<in> sem r"
    using trace by auto
  note r_valid = TraceInvarianceStateIsValid[OF abstraction valid r\<^sub>1]
  obtain crossing where [simp]: "step = SwitchDomain crossing"
    using inter by (cases step) auto
  show "getMemByte a s' = getMemByte a s"
  if "a \<notin> getTranslateAddresses segment STORE s" for a
    proof -
      have "a \<notin> StorablePhysAddresses gPerm s"
        using that
        unfolding StorablePhysAddresses_def
        by auto
      hence "a \<notin> StorablePhysAddresses (AvailableAuthority s) s"
        using StorablePhysAddresses_le[OF gperm]
        by auto
      thus ?thesis
        using MemoryInvariant[OF abstraction trace intra inter _ no_sys valid]
        by metis
    qed
  show "getMemTag (GetCapAddress a) s' = getMemTag (GetCapAddress a) s"
  if "a \<notin> getTranslateAddresses segment STORE s" for a
    proof -
      have "GetCapAddress a \<notin> StorablePhysCapAddresses gPerm s"
        proof
          assume "GetCapAddress a \<in> StorablePhysCapAddresses gPerm s"
          then obtain b where "b \<in> getTranslateAddresses segment STORE s"
                          and "GetCapAddress b = GetCapAddress a"
            unfolding StorablePhysCapAddresses_def
            unfolding getTranslateCapAddresses_def
            by auto
          hence "a \<in> getTranslateAddresses segment STORE s"
            using TranslationCapabilityAligned[OF aligned, where s=s and t=STORE]
            using CapabilityAligned_CapAddressE[where a=b and b=a]
            by auto
          thus False
            using that
            by auto
        qed
      hence "GetCapAddress a \<notin> StorablePhysCapAddresses (AvailableAuthority s) s"
        using StorablePhysCapAddresses_le[OF gperm]
        by auto
      hence "getMemCap (GetCapAddress a) s' = getMemCap (GetCapAddress a) s"
        using MemCapInvariant[OF abstraction trace intra inter _ no_sys valid]
        by metis
      thus ?thesis
        unfolding getMemTag_def
        by auto
    qed
  show "getSCAPR cd s' = getSCAPR cd s" if "cd \<noteq> 0 \<and> cd \<noteq> 1 \<and> cd \<noteq> 31" for cd
    using SpecialCapRegisterInvariant[OF abstraction trace intra inter no_sys _ _ _ valid]
    using that
    by metis
  show "getBase (getPCC s') + getPC s' \<in> exit"
    proof (cases crossing)
      case RaiseException
      hence "(SwitchDomain RaiseException, s') \<in> sem r"
        using r\<^sub>2 by auto
      from CanBeSimulatedE_Exception[OF abstraction this _ r_valid]
      have "getBase (getPCC s') + getPC s' \<in> ExceptionPCs"
        by auto
      thus ?thesis
        using ex
        by auto
    next
      case (InvokeCapability cd cd')
      hence "(SwitchDomain (InvokeCapability cd cd'), s') \<in> sem r"
        using r\<^sub>2 by auto
      note invoke = CanBeSimulatedE_InvokeCap[OF abstraction this _ r_valid,
                                              where cd=cd and cd'=cd']
      have "getCAPR cd r \<in> AvailableCaps r"
        using invoke by auto
      hence available: "getCAPR cd r \<in> AvailableCaps s"
        using MonotonicityAvailableCaps[OF abstraction r\<^sub>1 intra no_sys valid]
        by auto
      have "InvokableCapsNotUnsealable gPerm s"
        using invokable
        unfolding gPerm_def InvokableCapsNotUnsealable_def
        unfolding InvokableCaps_def
        by auto
      from InvokableCapsNotUnsealable_le[OF gperm this]
      have "getCAPR cd r \<in> ReadableCaps (AvailableAuthority s) s"
        using AvailableInvokableCapsAreReadable[OF available]
        using invoke
        by metis
      hence "getCAPR cd r \<in> InvokableCaps segment s"
        using ReadableCaps_le[OF gperm] invoke
        unfolding InvokableCaps_def
        by auto
      hence "getBase (getCAPR cd r ) + getOffset (getCAPR cd r ) \<in> exit"
        using invokable
        by auto
      hence "getBase (getPCC s') + getPC s' \<in> exit"
        using invoke
        by auto
      thus ?thesis
        by simp
    qed
qed

(*<*)
end
(*>*)


header {*\subsection{Formulation of a subject-subject communication policy and an information flow
policy, and showing both can be derived from subject-object configuration data}*}

theory Step_policies
  imports Step_configuration
begin

subsubsection {* Specification\label{sect:policy_specification} *}

text {* In order to use CISK, we need an information flow policy @{term ifp}
  relation.
  We also express a static subject-subject @{term sp_spec_subj_obj} and subject-object @{term sp_spec_subj_subj} access control policy
  for the implementation of the model. The following locale summarizes
  all properties we need. *}

locale policy_axioms =
  fixes sp_spec_subj_obj :: "'a \<Rightarrow> obj_id_t \<Rightarrow> mode_t \<Rightarrow> bool"
    and sp_spec_subj_subj :: "'a \<Rightarrow> 'a \<Rightarrow> bool"
    and ifp :: "'a \<Rightarrow> 'a \<Rightarrow> bool"

  assumes sp_spec_file_provider: "\<forall> p1 p2 f m1 m2 .
     sp_spec_subj_obj p1 (FILEP f) m1 \<and>
     sp_spec_subj_obj p2 (FILEP f) m2 \<longrightarrow> sp_spec_subj_subj p1 p2"

  and sp_spec_no_wronly_pages:
    "\<forall> p x . sp_spec_subj_obj p (PAGE x) WRITE \<longrightarrow> sp_spec_subj_obj p (PAGE x) READ"

  and ifp_reflexive:
    "\<forall> p . ifp p p"

  and ifp_compatible_with_sp_spec:
    "\<forall> a b . sp_spec_subj_subj a b \<longrightarrow> ifp a b \<and> ifp b a"

  and ifp_compatible_with_ipc:
    "\<forall> a b c x . (sp_spec_subj_subj a b
                  \<and> sp_spec_subj_obj b (PAGE x) WRITE  \<and> sp_spec_subj_obj c (PAGE x) READ)
                 \<longrightarrow> ifp a c"
begin (* empty *) end

subsubsection {* Derivation *}

text {* The configuration data only consists of a subject-object policy.
We derive the subject-subject policy and the information flow policy from the configuration data and prove that properties we specified in Section~\ref{sect:policy_specification} are satisfied. *}

locale abstract_policy_derivation =
  fixes configuration_subj_obj :: "'a \<Rightarrow> obj_id_t \<Rightarrow> mode_t \<Rightarrow> bool"
begin

  definition "sp_spec_subj_obj a x m \<equiv>
    configuration_subj_obj a x m \<or> (\<exists> y . x = PAGE y \<and> m = READ \<and> configuration_subj_obj a x WRITE)"

  definition "sp_spec_subj_subj a b \<equiv>
    \<exists> f m1 m2 . sp_spec_subj_obj a (FILEP f) m1 \<and> sp_spec_subj_obj b (FILEP f) m2"

  definition "ifp a b \<equiv>
     sp_spec_subj_subj a b
   \<or> sp_spec_subj_subj b a
   \<or> (\<exists> c y . sp_spec_subj_subj a c
            \<and> sp_spec_subj_obj c (PAGE y) WRITE
            \<and> sp_spec_subj_obj b (PAGE y) READ)
   \<or> (a = b)"

text {* Show that the policies specified in Section~\ref{sect:policy_specification} can be derived from the configuration and their definitions. *}

  lemma correct:
    shows "policy_axioms sp_spec_subj_obj sp_spec_subj_subj ifp"
  proof (unfold_locales)
    show sp_spec_file_provider:
      "\<forall> p1 p2 f m1 m2 .
           sp_spec_subj_obj p1 (FILEP f) m1 \<and>
           sp_spec_subj_obj p2 (FILEP f) m2 \<longrightarrow> sp_spec_subj_subj p1 p2"
      unfolding sp_spec_subj_subj_def by auto
    show sp_spec_no_wronly_pages:
      "\<forall> p x . sp_spec_subj_obj p (PAGE x) WRITE \<longrightarrow> sp_spec_subj_obj p (PAGE x) READ"
      unfolding sp_spec_subj_obj_def by auto
    show ifp_reflexive:
      "\<forall> p . ifp p p"
      unfolding ifp_def by auto
    show ifp_compatible_with_sp_spec:
      "\<forall> a b . sp_spec_subj_subj a b \<longrightarrow> ifp a b \<and> ifp b a"
      unfolding ifp_def by auto
    show ifp_compatible_with_ipc:
      "\<forall> a b c x . (sp_spec_subj_subj a b
                  \<and> sp_spec_subj_obj b (PAGE x) WRITE  \<and> sp_spec_subj_obj c (PAGE x) READ)
                 \<longrightarrow> ifp a c"
      unfolding ifp_def by auto
  qed
end

type_synonym sp_subj_subj_t = "partition_id_t \<Rightarrow> partition_id_t \<Rightarrow> bool"
type_synonym sp_subj_obj_t = "partition_id_t \<Rightarrow> obj_id_t \<Rightarrow> mode_t \<Rightarrow> bool"

interpretation Policy: abstract_policy_derivation "configured_subj_obj".
interpretation Policy_properties: policy_axioms Policy.sp_spec_subj_obj Policy.sp_spec_subj_subj Policy.ifp
  using Policy.correct by auto

lemma example_how_to_use_properties_in_proofs:
  shows "\<forall> p . Policy.ifp p p"
  using Policy_properties.ifp_reflexive by auto

end


theory flash11Bra  imports flash11Rev

  begin
lemma onInv11:

   assumes  a1:"iInv1 \<le> N" and  a2:"iInv2 \<le> N" and  a3:"iInv1~=iInv2  " and

     b1:"r \<in> rules N" and b2:"invf=inv11  iInv1  iInv2 "
   shows  "invHoldForRule' s invf r (invariants   N)"
   proof -
have c1:"ex1P N (% iRule1 .  r=NI_Local_GetX_PutX1 N  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_GetX  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Replace  iRule1 )\<or>ex0P N (  r=NI_ShWb N )\<or>ex0P N (  r=PI_Local_GetX_GetX2 )\<or>ex0P N (  r=NI_Local_PutXAcksDone )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_PutX7 N  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Local_Get_Nak2  iRule1 )\<or>ex0P N (  r=NI_ReplaceHomeShrVld )\<or>ex1P N (% iRule1 .  r=NI_Remote_Put  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_PutX5 N  iRule1 )\<or>ex0P N (  r=NI_Wb )\<or>ex1P N (% iRule1 .  r=NI_Local_Get_Get  iRule1 )\<or>ex0P N (  r=PI_Local_Replace )\<or>ex1P N (% iRule1 .  r=NI_ReplaceShrVld  iRule1 )\<or>ex2P N (% iRule1  iRule2 .  r=NI_Local_GetX_PutX8 N  iRule1  iRule2 )\<or>ex1P N (% iRule1 .  r=NI_InvAck_2 N  iRule1 )\<or>ex2P N (% iRule1  iRule2 .  r=NI_Remote_Get_Nak2  iRule1  iRule2 )\<or>ex1P N (% iRule1 .  r=PI_Remote_Replace  iRule1 )\<or>ex0P N (  r=NI_Nak_Home )\<or>ex1P N (% iRule1 .  r=NI_Local_Get_Put2  iRule1 )\<or>ex2P N (% iRule1  iRule2 .  r=NI_InvAck_1  iRule1  iRule2 )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_PutX11 N  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_PutX6 N  iRule1 )\<or>ex2P N (% iRule1  iRule2 .  r=NI_Remote_Get_Put2  iRule1  iRule2 )\<or>ex0P N (  r=PI_Local_Get_Put )\<or>ex0P N (  r=PI_Local_GetX_PutX1 N )\<or>ex1P N (% iRule1 .  r=NI_InvAck_1_Home  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Remote_Get_Nak1  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Local_Get_Nak1  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_Nak2  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_PutX10_home N  iRule1 )\<or>ex1P N (% iRule1 .  r=PI_Remote_Get  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_Nak3  iRule1 )\<or>ex2P N (% iRule1  iRule2 .  r=NI_Local_GetX_PutX10 N  iRule1  iRule2 )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_PutX2 N  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Remote_Get_Put1  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Remote_PutX  iRule1 )\<or>ex1P N (% iRule1 .  r=Store  iRule1 )\<or>ex0P N (  r=NI_FAck )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_PutX3 N  iRule1 )\<or>ex0P N (  r=PI_Local_GetX_PutX3 )\<or>ex2P N (% iRule1  iRule2 .  r=NI_Remote_GetX_PutX  iRule1  iRule2 )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_PutX8_home N  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Local_Get_Put1 N  iRule1 )\<or>ex0P N (  r=PI_Local_GetX_GetX1 )\<or>ex0P N (  r=StoreHome )\<or>ex2P N (% iRule1  iRule2 .  r=NI_Remote_GetX_Nak  iRule1  iRule2 )\<or>ex1P N (% iRule1 .  r=NI_Inv  iRule1 )\<or>ex1P N (% iRule1 .  r=PI_Remote_PutX  iRule1 )\<or>ex0P N (  r=PI_Local_GetX_PutX4 )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_PutX4 N  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Nak  iRule1 )\<or>ex0P N (  r=PI_Local_GetX_PutX2 N )\<or>ex0P N (  r=NI_Local_Put )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_Nak1  iRule1 )\<or>ex0P N (  r=NI_Nak_Clear )\<or>ex0P N (  r=PI_Local_PutX )\<or>ex1P N (% iRule1 .  r=NI_Local_Get_Nak3  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Remote_GetX_Nak_Home  iRule1 )\<or>ex0P N (  r=PI_Local_Get_Get )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_PutX9 N  iRule1 )\<or>ex1P N (% iRule1 .  r=PI_Remote_GetX  iRule1 )\<or>ex0P N (  r=NI_ReplaceHome )\<or>ex1P N (% iRule1 .  r=NI_Remote_GetX_PutX_Home  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Local_Get_Put3  iRule1 )"

        apply(cut_tac  b1)
        apply auto
        done      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX1 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX1 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (NI_Local_GetX_PutX1 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_PutX1VsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_GetX  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_GetX  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (NI_Local_GetX_GetX  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_GetXVsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Replace  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Replace  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (NI_Replace  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_ReplaceVsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= NI_ShWb N )
"

         from c1 have c2:" r= NI_ShWb N "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (NI_ShWb N ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis NI_ShWbVsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex0P N (  r= PI_Local_GetX_GetX2 )
"

         from c1 have c2:" r= PI_Local_GetX_GetX2 "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (PI_Local_GetX_GetX2 ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis PI_Local_GetX_GetX2VsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex0P N (  r= NI_Local_PutXAcksDone )
"

         from c1 have c2:" r= NI_Local_PutXAcksDone "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (NI_Local_PutXAcksDone ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis NI_Local_PutXAcksDoneVsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX7 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX7 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (NI_Local_GetX_PutX7 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_PutX7VsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_Get_Nak2  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_Get_Nak2  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (NI_Local_Get_Nak2  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_Get_Nak2VsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= NI_ReplaceHomeShrVld )
"

         from c1 have c2:" r= NI_ReplaceHomeShrVld "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (NI_ReplaceHomeShrVld ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis NI_ReplaceHomeShrVldVsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Remote_Put  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Remote_Put  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (NI_Remote_Put  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Remote_PutVsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX5 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX5 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (NI_Local_GetX_PutX5 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_PutX5VsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= NI_Wb )
"

         from c1 have c2:" r= NI_Wb "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (NI_Wb ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis NI_WbVsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_Get_Get  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_Get_Get  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (NI_Local_Get_Get  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_Get_GetVsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= PI_Local_Replace )
"

         from c1 have c2:" r= PI_Local_Replace "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (PI_Local_Replace ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis PI_Local_ReplaceVsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_ReplaceShrVld  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_ReplaceShrVld  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (NI_ReplaceShrVld  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_ReplaceShrVldVsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex2P N (% iRule1  iRule2 .  r= NI_Local_GetX_PutX8 N  iRule1  iRule2 )
"

         from c1 obtain  iRule1  iRule2  where c2:"  iRule1~=iRule2    \<and>   iRule1 \<le> N \<and>   iRule2 \<le> N \<and>  r= NI_Local_GetX_PutX8 N  iRule1  iRule2 "
         by (auto simp add: ex2P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (NI_Local_GetX_PutX8 N  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_PutX8VsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_InvAck_2 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_InvAck_2 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (NI_InvAck_2 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_InvAck_2VsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex2P N (% iRule1  iRule2 .  r= NI_Remote_Get_Nak2  iRule1  iRule2 )
"

         from c1 obtain  iRule1  iRule2  where c2:"  iRule1~=iRule2    \<and>   iRule1 \<le> N \<and>   iRule2 \<le> N \<and>  r= NI_Remote_Get_Nak2  iRule1  iRule2 "
         by (auto simp add: ex2P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (NI_Remote_Get_Nak2  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Remote_Get_Nak2VsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= PI_Remote_Replace  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= PI_Remote_Replace  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (PI_Remote_Replace  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis PI_Remote_ReplaceVsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= NI_Nak_Home )
"

         from c1 have c2:" r= NI_Nak_Home "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (NI_Nak_Home ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis NI_Nak_HomeVsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_Get_Put2  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_Get_Put2  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (NI_Local_Get_Put2  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_Get_Put2VsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex2P N (% iRule1  iRule2 .  r= NI_InvAck_1  iRule1  iRule2 )
"

         from c1 obtain  iRule1  iRule2  where c2:"  iRule1~=iRule2    \<and>   iRule1 \<le> N \<and>   iRule2 \<le> N \<and>  r= NI_InvAck_1  iRule1  iRule2 "
         by (auto simp add: ex2P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (NI_InvAck_1  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_InvAck_1VsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX11 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX11 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (NI_Local_GetX_PutX11 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_PutX11VsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX6 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX6 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (NI_Local_GetX_PutX6 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_PutX6VsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex2P N (% iRule1  iRule2 .  r= NI_Remote_Get_Put2  iRule1  iRule2 )
"

         from c1 obtain  iRule1  iRule2  where c2:"  iRule1~=iRule2    \<and>   iRule1 \<le> N \<and>   iRule2 \<le> N \<and>  r= NI_Remote_Get_Put2  iRule1  iRule2 "
         by (auto simp add: ex2P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (NI_Remote_Get_Put2  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Remote_Get_Put2VsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= PI_Local_Get_Put )
"

         from c1 have c2:" r= PI_Local_Get_Put "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (PI_Local_Get_Put ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis PI_Local_Get_PutVsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex0P N (  r= PI_Local_GetX_PutX1 N )
"

         from c1 have c2:" r= PI_Local_GetX_PutX1 N "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (PI_Local_GetX_PutX1 N ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis PI_Local_GetX_PutX1VsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_InvAck_1_Home  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_InvAck_1_Home  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (NI_InvAck_1_Home  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_InvAck_1_HomeVsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Remote_Get_Nak1  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Remote_Get_Nak1  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (NI_Remote_Get_Nak1  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Remote_Get_Nak1VsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_Get_Nak1  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_Get_Nak1  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (NI_Local_Get_Nak1  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_Get_Nak1VsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_Nak2  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_Nak2  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (NI_Local_GetX_Nak2  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_Nak2VsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX10_home N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX10_home N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (NI_Local_GetX_PutX10_home N  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_PutX10_homeVsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= PI_Remote_Get  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= PI_Remote_Get  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (PI_Remote_Get  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis PI_Remote_GetVsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_Nak3  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_Nak3  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (NI_Local_GetX_Nak3  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_Nak3VsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex2P N (% iRule1  iRule2 .  r= NI_Local_GetX_PutX10 N  iRule1  iRule2 )
"

         from c1 obtain  iRule1  iRule2  where c2:"  iRule1~=iRule2    \<and>   iRule1 \<le> N \<and>   iRule2 \<le> N \<and>  r= NI_Local_GetX_PutX10 N  iRule1  iRule2 "
         by (auto simp add: ex2P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (NI_Local_GetX_PutX10 N  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_PutX10VsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX2 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX2 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (NI_Local_GetX_PutX2 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_PutX2VsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Remote_Get_Put1  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Remote_Get_Put1  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (NI_Remote_Get_Put1  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Remote_Get_Put1VsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Remote_PutX  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Remote_PutX  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (NI_Remote_PutX  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Remote_PutXVsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= Store  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= Store  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (Store  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis StoreVsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= NI_FAck )
"

         from c1 have c2:" r= NI_FAck "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (NI_FAck ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis NI_FAckVsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX3 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX3 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (NI_Local_GetX_PutX3 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_PutX3VsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= PI_Local_GetX_PutX3 )
"

         from c1 have c2:" r= PI_Local_GetX_PutX3 "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (PI_Local_GetX_PutX3 ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis PI_Local_GetX_PutX3VsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex2P N (% iRule1  iRule2 .  r= NI_Remote_GetX_PutX  iRule1  iRule2 )
"

         from c1 obtain  iRule1  iRule2  where c2:"  iRule1~=iRule2    \<and>   iRule1 \<le> N \<and>   iRule2 \<le> N \<and>  r= NI_Remote_GetX_PutX  iRule1  iRule2 "
         by (auto simp add: ex2P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (NI_Remote_GetX_PutX  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Remote_GetX_PutXVsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX8_home N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX8_home N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (NI_Local_GetX_PutX8_home N  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_PutX8_homeVsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_Get_Put1 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_Get_Put1 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (NI_Local_Get_Put1 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_Get_Put1VsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= PI_Local_GetX_GetX1 )
"

         from c1 have c2:" r= PI_Local_GetX_GetX1 "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (PI_Local_GetX_GetX1 ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis PI_Local_GetX_GetX1VsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex0P N (  r= StoreHome )
"

         from c1 have c2:" r= StoreHome "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (StoreHome ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis StoreHomeVsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex2P N (% iRule1  iRule2 .  r= NI_Remote_GetX_Nak  iRule1  iRule2 )
"

         from c1 obtain  iRule1  iRule2  where c2:"  iRule1~=iRule2    \<and>   iRule1 \<le> N \<and>   iRule2 \<le> N \<and>  r= NI_Remote_GetX_Nak  iRule1  iRule2 "
         by (auto simp add: ex2P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (NI_Remote_GetX_Nak  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Remote_GetX_NakVsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Inv  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Inv  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (NI_Inv  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_InvVsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= PI_Remote_PutX  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= PI_Remote_PutX  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (PI_Remote_PutX  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis PI_Remote_PutXVsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= PI_Local_GetX_PutX4 )
"

         from c1 have c2:" r= PI_Local_GetX_PutX4 "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (PI_Local_GetX_PutX4 ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis PI_Local_GetX_PutX4VsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX4 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX4 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (NI_Local_GetX_PutX4 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_PutX4VsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Nak  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Nak  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (NI_Nak  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_NakVsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= PI_Local_GetX_PutX2 N )
"

         from c1 have c2:" r= PI_Local_GetX_PutX2 N "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (PI_Local_GetX_PutX2 N ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis PI_Local_GetX_PutX2VsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex0P N (  r= NI_Local_Put )
"

         from c1 have c2:" r= NI_Local_Put "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (NI_Local_Put ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis NI_Local_PutVsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_Nak1  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_Nak1  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (NI_Local_GetX_Nak1  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_Nak1VsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= NI_Nak_Clear )
"

         from c1 have c2:" r= NI_Nak_Clear "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (NI_Nak_Clear ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis NI_Nak_ClearVsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex0P N (  r= PI_Local_PutX )
"

         from c1 have c2:" r= PI_Local_PutX "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (PI_Local_PutX ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis PI_Local_PutXVsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_Get_Nak3  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_Get_Nak3  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (NI_Local_Get_Nak3  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_Get_Nak3VsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Remote_GetX_Nak_Home  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Remote_GetX_Nak_Home  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (NI_Remote_GetX_Nak_Home  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Remote_GetX_Nak_HomeVsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= PI_Local_Get_Get )
"

         from c1 have c2:" r= PI_Local_Get_Get "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (PI_Local_Get_Get ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis PI_Local_Get_GetVsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX9 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX9 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (NI_Local_GetX_PutX9 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_PutX9VsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= PI_Remote_GetX  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= PI_Remote_GetX  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (PI_Remote_GetX  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis PI_Remote_GetXVsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= NI_ReplaceHome )
"

         from c1 have c2:" r= NI_ReplaceHome "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (NI_ReplaceHome ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis NI_ReplaceHomeVsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Remote_GetX_PutX_Home  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Remote_GetX_PutX_Home  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (NI_Remote_GetX_PutX_Home  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Remote_GetX_PutX_HomeVsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_Get_Put3  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_Get_Put3  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv11  iInv1  iInv2 ) (NI_Local_Get_Put3  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_Get_Put3VsInv11 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }ultimately show "invHoldForRule' s invf r (invariants N) "
          by blast
     qed
end


(*  Title:      Jinja/J/JWellForm.thy

    Author:     Tobias Nipkow
    Copyright   2003 Technische Universitaet Muenchen
*)

section \<open>Well-formedness Constraints\<close>

theory JWellForm
imports "../Common/WellForm" WWellForm WellType DefAss
begin

definition wf_J_mdecl :: "J_prog \<Rightarrow> cname \<Rightarrow> J_mb mdecl \<Rightarrow> bool"
where
  "wf_J_mdecl P C  \<equiv>  \<lambda>(M,Ts,T,(pns,body)).
  length Ts = length pns \<and>
  distinct pns \<and>
  this \<notin> set pns \<and>
  (\<exists>T'. P,[this\<mapsto>Class C,pns[\<mapsto>]Ts] \<turnstile> body :: T' \<and> P \<turnstile> T' \<le> T) \<and>
  \<D> body \<lfloor>{this} \<union> set pns\<rfloor>"

lemma wf_J_mdecl[simp]:
  "wf_J_mdecl P C (M,Ts,T,pns,body) \<equiv>
  (length Ts = length pns \<and>
  distinct pns \<and>
  this \<notin> set pns \<and>
  (\<exists>T'. P,[this\<mapsto>Class C,pns[\<mapsto>]Ts] \<turnstile> body :: T' \<and> P \<turnstile> T' \<le> T) \<and>
  \<D> body \<lfloor>{this} \<union> set pns\<rfloor>)"
(*<*)by(simp add:wf_J_mdecl_def)(*>*)

abbreviation
  wf_J_prog :: "J_prog \<Rightarrow> bool" where
  "wf_J_prog == wf_prog wf_J_mdecl"

lemma wf_J_prog_wf_J_mdecl:
  "\<lbrakk> wf_J_prog P; (C, D, fds, mths) \<in> set P; jmdcl \<in> set mths \<rbrakk>
  \<Longrightarrow> wf_J_mdecl P C jmdcl"
(*<*)
apply (simp add: wf_prog_def)
apply (simp add: wf_cdecl_def)
apply (erule conjE)+
apply (drule bspec, assumption)
apply simp
apply (erule conjE)+
apply (drule bspec, assumption)
apply (simp add: wf_mdecl_def split_beta)
done
(*>*)

lemma wf_prog_wwf_prog: "wf_J_prog P \<Longrightarrow> wwf_J_prog P"
(*<*)
apply(simp add:wf_prog_def wf_cdecl_def wf_mdecl_def)
apply(fast intro:wf_mdecl_wwf_mdecl)
done
(*>*)

end


section {*FUNCTION\_\_SDPDA\_TO\_LR1\_STD*}
theory
  FUNCTION__SDPDA_TO_LR1_STD

imports
  PRJ_12_04_06_07__ENTRY

begin

definition F_SDPDA_TO_LR1_STD__SpecInput :: "
  ('nonterminal, 'event, 'stack) epda
  \<Rightarrow> bool"
  where
    "F_SDPDA_TO_LR1_STD__SpecInput G \<equiv>
  valid_simple_dpda G
  \<and> \<not> duplicate_marking G"

definition F_SDPDA_TO_LR1_STD__SpecOutput :: "
  ('state, 'event, 'stack) epda
  \<Rightarrow> ('nonterminal, 'event) cfg option
  \<Rightarrow> bool"
  where
    "F_SDPDA_TO_LR1_STD__SpecOutput Gi Go \<equiv>
  case Go of
    None \<Rightarrow> epdaS.marked_language Gi = {}
    | Some Go \<Rightarrow>
      valid_cfg Go
      \<and> cfgLM.marked_language Go = epdaS.marked_language Gi
      \<and> cfg_LRk Go (Suc 0)"

theorem F_SDPDA_TO_LR1_STD__SOUND: "
  F_SDPDA_TO_LR1_STD__SpecInput G
  \<Longrightarrow> F_SDPDA_TO_LR1_STD__SpecOutput G (F_SDPDA_TO_LR1_STD G)"
  apply(simp add: F_SDPDA_TO_LR1_STD__SpecInput_def F_SDPDA_TO_LR1_STD__SpecOutput_def)
  apply(subgoal_tac "X" for X)
   prefer 2
   apply(rule_tac G="G" in F_SDPDA_TO_CFG_STD__SOUND)
   apply(simp add: F_SDPDA_TO_CFG_STD__SpecInput_def)
  apply(subgoal_tac "X" for X)
   prefer 2
   apply(rule_tac G="F_SDPDA_TO_CFG_STD G" in F_CFG_TRIM__SOUND)
   apply(simp add: F_CFG_TRIM__SpecInput_def F_SDPDA_TO_CFG_STD__SpecOutput_def)
  apply(case_tac "F_SDPDA_TO_LR1_STD G")
   apply(clarsimp)
   apply(simp add: F_SDPDA_TO_LR1_STD_def)
   apply(simp add: F_CFG_TRIM__SpecOutput_def F_CFG_TRIM__SpecInput_def F_SDPDA_TO_CFG_STD__SpecOutput_def)
   apply (metis CFG_lang_lm_lang_equal)
  apply(clarsimp)
  apply(simp add: F_SDPDA_TO_LR1_STD_def)
  apply(simp add: F_CFG_TRIM__SpecOutput_def F_CFG_TRIM__SpecInput_def F_SDPDA_TO_CFG_STD__SpecOutput_def)
  apply(rename_tac Go)
  apply(rule conjI)
   apply (metis CFG_lang_lm_lang_equal)
  apply(rule F_SDPDA_TO_CFG_STD__enforces_cfg_LRk)
      apply(force)
     apply(force)
    apply(force)
   apply(force)
  apply(force)
  done

end