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

  Project: Refining Authenticated Key Agreement with Strong Adversaries

  Module:  Implem.thy (Isabelle/HOL 2016-1)
  ID:      $Id: Implem.thy 132885 2016-12-23 18:41:32Z csprenge $
  Author:  Joseph Lallemand, INRIA Nancy <joseph.lallemand@loria.fr>
           Christoph Sprenger, ETH Zurich <sprenger@inf.ethz.ch>

  Parametric channel message implementation
  - definition of 'valid' implementations
  - assumptions for channel implementations (formulated as locales)

  Copyright (c) 2015-2016 Joseph Lallemand and Christoph Sprenger
  Licence: LGPL

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

section \<open>Assumptions for Channel Message Implementation\<close>

text \<open>We define a series of locales capturing our assumptions on channel message
implementations.\<close>

theory Implem
imports Channels Payloads
begin

subsection \<open>First step: basic implementation locale\<close>
(**************************************************************************************************)

text \<open>This locale has no assumptions, it only fixes an implementation function and
defines some useful abbreviations (impl*, impl*Set) and \<open>valid\<close>.
\<close>

locale basic_implem =
  fixes implem :: "chan \<Rightarrow> msg"
begin

abbreviation "implInsec A B M \<equiv> implem (Insec A B M)"
abbreviation "implConfid A B M \<equiv> implem (Confid A B M)"
abbreviation "implAuth A B M \<equiv> implem (Auth A B M)"
abbreviation "implSecure A B M \<equiv> implem (Secure A B M)"

abbreviation implInsecSet :: "msg set \<Rightarrow> msg set"
where "implInsecSet G \<equiv> {implInsec A B M | A B M. M \<in> G}"

abbreviation implConfidSet :: "(agent * agent) set \<Rightarrow> msg set \<Rightarrow> msg set"
where "implConfidSet Ag G \<equiv> {implConfid A B M | A B M.  (A, B) \<in> Ag \<and> M \<in> G}"

abbreviation implAuthSet :: "msg set \<Rightarrow> msg set"
where "implAuthSet G \<equiv> {implAuth A B M | A B M. M \<in> G}"

abbreviation implSecureSet :: "(agent * agent) set \<Rightarrow> msg set \<Rightarrow> msg set"
where "implSecureSet Ag G \<equiv> {implSecure A B M | A B M. (A, B) \<in> Ag \<and> M \<in> G}"

definition
  valid :: "msg set"
where
  "valid \<equiv> {implem (Chan x A B M) | x A B M. M \<in> payload}"

lemma validI:
  "M \<in> payload \<Longrightarrow> implem (Chan x A B M) \<in> valid"
by (auto simp add: valid_def)

lemma validE:
  "X \<in> valid \<Longrightarrow> (\<And> x A B M. X = implem (Chan x A B M) \<Longrightarrow> M \<in> payload \<Longrightarrow> P) \<Longrightarrow> P"
by (auto simp add: valid_def)

lemma valid_cases:
fixes X P
assumes "X \<in> valid"
        "(\<And>A B M. X = implInsec A B M \<Longrightarrow> M \<in> payload \<Longrightarrow> P)"
        "(\<And>A B M. X = implConfid A B M \<Longrightarrow> M \<in> payload \<Longrightarrow> P)"
        "(\<And>A B M. X = implAuth A B M \<Longrightarrow> M \<in> payload \<Longrightarrow> P)"
        "(\<And>A B M. X = implSecure A B M \<Longrightarrow> M \<in> payload \<Longrightarrow> P)"
shows "P"
proof -
  from assms have "(\<And> x A B M. X = implem (Chan x A B M) \<Longrightarrow> M \<in> payload \<Longrightarrow> P) \<Longrightarrow> P"
  by (auto elim: validE)
  moreover from assms have "\<And> x A B M. X = implem (Chan x A B M) \<Longrightarrow> M \<in> payload \<Longrightarrow> P"
    proof -
      fix x A B M
      assume "X = implem (Chan x A B M)" "M \<in> payload"
      with assms show "P" by (cases x, auto)
    qed
  ultimately show ?thesis .
qed

end

subsection \<open>Second step: basic and analyze assumptions\<close>
(**************************************************************************************************)

text \<open>This locale contains most of the assumptions on implem, i.e.:
\begin{itemize}
\item \<open>impl_inj\<close>: injectivity
\item \<open>parts_impl_inj\<close>: injectivity through parts
\item \<open>Enc_parts_valid_impl\<close>: if Enc X Y appears in parts of an implem, then it is
  in parts of the payload, or the key is either long term or payload
\item \<open>impl_composed\<close>: the implementations are composed (not nonces, agents, tags etc.)
\item \<open>analz_Un_implXXXSet\<close>: move the impl*Set out of the analz (only keep the payloads)
\item \<open>impl_Impl\<close>: implementations contain implementation material
\item \<open>LtK_parts_impl\<close>: no exposed long term keys in the implementations
  (i.e., they are only used as keys, or under hashes)
\end{itemize}
\<close>

locale semivalid_implem = basic_implem +
\<comment> \<open>injectivity\<close>
assumes impl_inj:
  "implem (Chan x A B M) = implem (Chan x' A' B' M')
   \<longleftrightarrow> x = x' \<and> A = A' \<and> B = B' \<and> M = M'"
\<comment> \<open>implementations and parts\<close>
and parts_impl_inj:
  "M' \<in> payload \<Longrightarrow>
   implem (Chan x A B M) \<in> parts {implem (Chan x' A' B' M')} \<Longrightarrow>
   x = x' \<and> A = A' \<and> B = B' \<and> M = M'"
and Enc_keys_clean_valid: "I \<subseteq> valid \<Longrightarrow> Enc_keys_clean I"
and impl_composed: "composed (implem Z)"
and impl_Impl: "implem (Chan x A B M) \<notin> payload"
\<comment> \<open>no ltk in the parts of an implementation\<close>
and LtK_parts_impl: "X \<in> valid \<Longrightarrow> LtK K \<notin> parts {X}"

\<comment> \<open>analyze assumptions:\<close>
and analz_Un_implInsecSet:
  "\<lbrakk> G \<subseteq> payload; Enc_keys_clean H \<rbrakk>
 \<Longrightarrow> analz (implInsecSet G \<union> H) \<subseteq> synth (analz (G \<union> H)) \<union> -payload"
and analz_Un_implConfidSet:
  "\<lbrakk> G \<subseteq> payload; Enc_keys_clean H \<rbrakk>
 \<Longrightarrow> analz (implConfidSet Ag G \<union> H) \<subseteq> synth (analz (G \<union> H)) \<union> -payload"
and analz_Un_implConfidSet_2:
  "\<lbrakk> G \<subseteq> payload; Enc_keys_clean H; Ag \<inter> broken (parts H \<inter> range LtK) = {} \<rbrakk>
 \<Longrightarrow> analz (implConfidSet Ag G \<union> H) \<subseteq> synth (analz H) \<union> -payload"
and analz_Un_implAuthSet:
  "\<lbrakk> G \<subseteq> payload; Enc_keys_clean H \<rbrakk>
 \<Longrightarrow> analz (implAuthSet G \<union> H) \<subseteq> synth (analz (G \<union> H)) \<union> -payload"
and analz_Un_implSecureSet:
  "\<lbrakk> G \<subseteq> payload; Enc_keys_clean H \<rbrakk>
 \<Longrightarrow> analz (implSecureSet Ag G \<union> H) \<subseteq> synth (analz (G \<union> H)) \<union> -payload"
and analz_Un_implSecureSet_2:
  "\<lbrakk> G \<subseteq> payload; Enc_keys_clean H; Ag \<inter> broken (parts H \<inter> range LtK) = {} \<rbrakk>
 \<Longrightarrow> analz (implSecureSet Ag G \<union> H) \<subseteq> synth (analz H) \<union> -payload"

begin
\<comment> \<open>declare some attributes and abbreviations for the hypotheses\<close>
\<comment> \<open>and prove some simple consequences of the hypotheses\<close>
declare impl_inj [simp]

lemmas parts_implE [elim] = parts_impl_inj [rotated 1]

declare impl_composed [simp, intro]

lemma composed_arg_cong: "X = Y \<Longrightarrow> composed X \<longleftrightarrow> composed Y"
by (rule arg_cong)

lemma implem_Tags_aux: "implem (Chan x A B M) \<notin> Tags" by (cases x, auto dest: composed_arg_cong)
lemma implem_Tags [simp]: "implem x \<notin> Tags" by (cases x, auto simp add: implem_Tags_aux)
lemma implem_LtK_aux: "implem (Chan x A B M) \<noteq> LtK K" by (cases x, auto dest: composed_arg_cong)
lemma implem_LtK [simp]: "implem x \<noteq> LtK K" by (cases x, auto simp add: implem_LtK_aux)
lemma implem_LtK2 [simp]: "implem x \<notin> range LtK" by (cases x, auto simp add: implem_LtK_aux)

declare impl_Impl [simp]

lemma LtK_parts_impl_insert:
  "LtK K \<in> parts (insert (implem (Chan x A B M)) S) \<Longrightarrow> M \<in> payload \<Longrightarrow> LtK K \<in> parts S"
apply (simp add: parts_insert [of _ S], clarify)
apply (auto dest: validI LtK_parts_impl)
done

declare LtK_parts_impl_insert [dest]
declare Enc_keys_clean_valid [simp, intro]

lemma valid_composed [simp,dest]: "M \<in> valid \<Longrightarrow> composed M"
by (auto elim: validE)

\<comment> \<open>lemmas: valid/payload are mutually exclusive\<close>
lemma valid_payload [dest]: "\<lbrakk> X \<in> valid; X \<in> payload \<rbrakk> \<Longrightarrow> P"
by (auto elim!: validE)

\<comment> \<open>valid/LtK are mutually exclusive\<close>
lemma valid_isLtKey [dest]: "\<lbrakk> X \<in> valid; X \<in> range LtK \<rbrakk> \<Longrightarrow> P"
by (auto)

lemma analz_valid:
  "H \<subseteq> payload \<union> valid \<union> range LtK \<union> Tags \<Longrightarrow>
   implem (Chan x A B M) \<in> analz H \<Longrightarrow>
   implem (Chan x A B M) \<in> H"
apply (drule analz_into_parts,
       drule parts_monotone [of _ H "payload \<union> H \<inter> valid \<union> range LtK \<union> Tags"], auto)
apply (drule parts_singleton, auto elim!:validE dest: parts_impl_inj)
done

lemma parts_valid_LtKeys_disjoint:
  "I \<subseteq> valid \<Longrightarrow> parts I \<inter> range LtK = {}"
apply (safe, drule parts_singleton, clarsimp)
apply (auto dest: subsetD LtK_parts_impl)
done

lemma analz_LtKeys:
  "H \<subseteq> payload \<union> valid \<union> range LtK \<union> Tags \<Longrightarrow>
   analz H \<inter> range LtK \<subseteq> H"
apply auto
apply (drule analz_into_parts, drule parts_monotone [of _ H "payload \<union> valid \<union> H \<inter> range LtK \<union> Tags"], auto)
apply (drule parts_singleton, auto elim!:validE dest: parts_impl_inj)
done

end

subsection \<open>Third step: \<open>valid_implem\<close>\<close>
(**************************************************************************************************)

text \<open>This extends @{locale "semivalid_implem"} with four new assumptions, which under certain
  conditions give information on $A$, $B$, $M$ when @{term "implXXX A B M \<in> synth (analz Z)"}.
  These assumptions are separated because interpretations are more easily proved, if the
  conclusions that follow from the @{locale "semivalid_implem"} assumptions are already
  available.
\<close>

locale valid_implem = semivalid_implem +

\<comment> \<open>Synthesize assumptions: conditions on payloads $M$ implied by derivable\<close>
\<comment> \<open>channel messages with payload $M$.\<close>
assumes implInsec_synth_analz:
  "H \<subseteq> payload \<union> valid \<union> range LtK \<union> Tags \<Longrightarrow>
   implInsec A B M \<in> synth (analz H) \<Longrightarrow>
   implInsec A B M \<in> H \<or> M \<in> synth (analz H)"
and implConfid_synth_analz:
  "H \<subseteq> payload \<union> valid \<union> range LtK \<union> Tags \<Longrightarrow>
   implConfid A B M \<in> synth (analz H) \<Longrightarrow>
   implConfid A B M \<in> H \<or> M \<in> synth (analz H)"
and implAuth_synth_analz:
  "H \<subseteq> payload \<union> valid \<union> range LtK \<union> Tags \<Longrightarrow>
   implAuth A B M \<in> synth (analz H) \<Longrightarrow>
   implAuth A B M \<in> H \<or> (M \<in> synth (analz H) \<and> (A, B) \<in> broken H)"
and implSecure_synth_analz:
  "H \<subseteq> payload \<union> valid \<union> range LtK \<union> Tags \<Longrightarrow>
   implSecure A B M \<in> synth (analz H) \<Longrightarrow>
   implSecure A B M \<in> H \<or> (M \<in> synth (analz H) \<and> (A, B) \<in> broken H)"

end


theory flash95Rev imports flashPub
begin
section{*Main defintions*}
lemma NI_FAckVsInv95:
    (*Rule0VsPInv0*)

  shows  "invHoldForRule' s (inv95 ) (NI_FAck ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

      by( auto)

  lemma NI_InvVsInv95:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv95 ) (NI_Inv  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_InvAck_1VsInv95:
    (*Rule2VsPInv0*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iRule2 \<le> N" and  a3:"iRule1~=iRule2  "

  shows  "invHoldForRule' s (inv95 ) (NI_InvAck_1  iRule1  iRule2 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1 a2 a3,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_InvAck_1_HomeVsInv95:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv95 ) (NI_InvAck_1_Home  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_InvAck_2VsInv95:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv95 ) (NI_InvAck_2 N  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Local_GetX_GetXVsInv95:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv95 ) (NI_Local_GetX_GetX  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Local_GetX_Nak1VsInv95:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv95 ) (NI_Local_GetX_Nak1  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Local_GetX_Nak2VsInv95:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv95 ) (NI_Local_GetX_Nak2  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Local_GetX_Nak3VsInv95:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv95 ) (NI_Local_GetX_Nak3  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Local_GetX_PutX1VsInv95:
  (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv95 ) (NI_Local_GetX_PutX1 N  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

      have "?P1 s"

        apply(cut_tac  a1 , auto)

        done

        then  show "?P1 s\<or> ?P2 s\<or> ?P3 s"

       by blast

 qed
lemma NI_Local_GetX_PutX2VsInv95:
  (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv95 ) (NI_Local_GetX_PutX2 N  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

      have "?P1 s"

        apply(cut_tac  a1 , auto)

        done

        then  show "?P1 s\<or> ?P2 s\<or> ?P3 s"

       by blast

 qed
lemma NI_Local_GetX_PutX3VsInv95:
  (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv95 ) (NI_Local_GetX_PutX3 N  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

      have "?P1 s"

        apply(cut_tac  a1 , auto)

        done

        then  show "?P1 s\<or> ?P2 s\<or> ?P3 s"

       by blast

 qed
lemma NI_Local_GetX_PutX4VsInv95:
  (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv95 ) (NI_Local_GetX_PutX4 N  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

      have "?P1 s"

        apply(cut_tac  a1 , auto)

        done

        then  show "?P1 s\<or> ?P2 s\<or> ?P3 s"

       by blast

 qed
lemma NI_Local_GetX_PutX5VsInv95:
  (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv95 ) (NI_Local_GetX_PutX5 N  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

      have "?P1 s"

        apply(cut_tac  a1 , auto)

        done

        then  show "?P1 s\<or> ?P2 s\<or> ?P3 s"

       by blast

 qed
lemma NI_Local_GetX_PutX6VsInv95:
  (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv95 ) (NI_Local_GetX_PutX6 N  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

      have "?P1 s"

        apply(cut_tac  a1 , auto)

        done

        then  show "?P1 s\<or> ?P2 s\<or> ?P3 s"

       by blast

 qed
lemma NI_Local_GetX_PutX7VsInv95:
  (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv95 ) (NI_Local_GetX_PutX7 N  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

      have "?P1 s"

        apply(cut_tac  a1 , auto)

        done

        then  show "?P1 s\<or> ?P2 s\<or> ?P3 s"

       by blast

 qed
lemma NI_Local_GetX_PutX8VsInv95:
  (*Rule2VsPInv0*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iRule2 \<le> N" and  a3:"iRule1~=iRule2  "

  shows  "invHoldForRule' s (inv95 ) (NI_Local_GetX_PutX8 N  iRule1  iRule2 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

      have "?P1 s"

        apply(cut_tac  a1  a2  a3 , auto)

        done

        then  show "?P1 s\<or> ?P2 s\<or> ?P3 s"

       by blast

 qed
lemma NI_Local_GetX_PutX8_homeVsInv95:
  (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv95 ) (NI_Local_GetX_PutX8_home N  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

      have "?P1 s"

        apply(cut_tac  a1 , auto)

        done

        then  show "?P1 s\<or> ?P2 s\<or> ?P3 s"

       by blast

 qed
lemma NI_Local_GetX_PutX9VsInv95:
  (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv95 ) (NI_Local_GetX_PutX9 N  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

      have "?P3 s"

        apply(   cut_tac  a1 , simp)

        apply(rule_tac x=" (neg ( andForm ( eqn ( IVar ( Para ''CacheState'' Home) )  ( Const CACHE_S ))    ( eqn ( IVar ( Global ''Dir_local'') )  ( Const false ))  ) ) " in exI,auto)

        done

       then  show "?P1 s\<or> ?P2 s\<or> ?P3 s"

        by blast

 qed
lemma NI_Local_GetX_PutX10VsInv95:
  (*Rule2VsPInv0*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iRule2 \<le> N" and  a3:"iRule1~=iRule2  "

  shows  "invHoldForRule' s (inv95 ) (NI_Local_GetX_PutX10 N  iRule1  iRule2 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

      have "?P3 s"

        apply(   cut_tac  a1  a2  a3 , simp)

        apply(rule_tac x=" (neg ( andForm ( eqn ( IVar ( Para ''CacheState'' Home) )  ( Const CACHE_S ))    ( eqn ( IVar ( Global ''Dir_local'') )  ( Const false ))  ) ) " in exI,auto)

        done

       then  show "?P1 s\<or> ?P2 s\<or> ?P3 s"

        by blast

 qed
lemma NI_Local_GetX_PutX10_homeVsInv95:
  (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv95 ) (NI_Local_GetX_PutX10_home N  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

      have "?P3 s"

        apply(   cut_tac  a1 , simp)

        apply(rule_tac x=" (neg ( eqn ( IVar ( Para ''Dir_ShrSet'' Home) )  ( Const true )) ) " in exI,auto)

        done

       then  show "?P1 s\<or> ?P2 s\<or> ?P3 s"

        by blast

 qed
lemma NI_Local_GetX_PutX11VsInv95:
  (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv95 ) (NI_Local_GetX_PutX11 N  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

      have "?P1 s"

        apply(cut_tac  a1 , auto)

        done

        then  show "?P1 s\<or> ?P2 s\<or> ?P3 s"

       by blast

 qed
lemma NI_Local_Get_GetVsInv95:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv95 ) (NI_Local_Get_Get  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Local_Get_Nak1VsInv95:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv95 ) (NI_Local_Get_Nak1  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Local_Get_Nak2VsInv95:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv95 ) (NI_Local_Get_Nak2  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Local_Get_Nak3VsInv95:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv95 ) (NI_Local_Get_Nak3  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Local_Get_Put1VsInv95:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv95 ) (NI_Local_Get_Put1 N  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Local_Get_Put2VsInv95:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv95 ) (NI_Local_Get_Put2  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Local_Get_Put3VsInv95:
  (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv95 ) (NI_Local_Get_Put3  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

      have "?P1 s"

        apply(cut_tac  a1 , auto)

        done

        then  show "?P1 s\<or> ?P2 s\<or> ?P3 s"

       by blast

 qed
lemma NI_Local_PutVsInv95:
  (*Rule0VsPInv0*)
  shows  "invHoldForRule' s (inv95 ) (NI_Local_Put ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have allCases:"formEval  ( eqn ( IVar ( Para ''InvMarked'' Home) )  ( Const true ))  s  \<or>formEval   (neg ( eqn ( IVar ( Para ''InvMarked'' Home) )  ( Const true )) )  s  "
	                      by auto

    moreover
                       {assume b1:"formEval ( eqn ( IVar ( Para ''InvMarked'' Home) )  ( Const true ))  s"

      have "?P1 s"

        apply(cut_tac  b1 , auto)

        done

        then  have "?P1 s\<or> ?P2 s \<or> ?P3 s"

       by blast
    }

    moreover
                       {assume b1:"formEval  (neg ( eqn ( IVar ( Para ''InvMarked'' Home) )  ( Const true )) )  s"

      have "?P1 s"

        apply(cut_tac  b1 , auto)

        done

        then  have "?P1 s\<or> ?P2 s \<or> ?P3 s"

       by blast
    }
   ultimately show "?P1 s\<or> ?P2 s\<or> ?P3 s"

	                         by metis

 qed
lemma NI_Local_PutXAcksDoneVsInv95:
  (*Rule0VsPInv0*)
  shows  "invHoldForRule' s (inv95 ) (NI_Local_PutXAcksDone ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

      have "?P1 s"

        apply( auto)

        done

        then  show "?P1 s\<or> ?P2 s\<or> ?P3 s"

       by blast

 qed
lemma NI_NakVsInv95:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv95 ) (NI_Nak  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Nak_ClearVsInv95:
    (*Rule0VsPInv0*)

  shows  "invHoldForRule' s (inv95 ) (NI_Nak_Clear ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

      by( auto)

  lemma NI_Nak_HomeVsInv95:
    (*Rule0VsPInv0*)

  shows  "invHoldForRule' s (inv95 ) (NI_Nak_Home ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

      by( auto)

  lemma NI_Remote_GetX_NakVsInv95:
    (*Rule2VsPInv0*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iRule2 \<le> N" and  a3:"iRule1~=iRule2  "

  shows  "invHoldForRule' s (inv95 ) (NI_Remote_GetX_Nak  iRule1  iRule2 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1 a2 a3,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Remote_GetX_Nak_HomeVsInv95:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv95 ) (NI_Remote_GetX_Nak_Home  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Remote_GetX_PutXVsInv95:
    (*Rule2VsPInv0*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iRule2 \<le> N" and  a3:"iRule1~=iRule2  "

  shows  "invHoldForRule' s (inv95 ) (NI_Remote_GetX_PutX  iRule1  iRule2 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1 a2 a3,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Remote_GetX_PutX_HomeVsInv95:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv95 ) (NI_Remote_GetX_PutX_Home  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Remote_Get_Nak1VsInv95:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv95 ) (NI_Remote_Get_Nak1  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Remote_Get_Nak2VsInv95:
    (*Rule2VsPInv0*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iRule2 \<le> N" and  a3:"iRule1~=iRule2  "

  shows  "invHoldForRule' s (inv95 ) (NI_Remote_Get_Nak2  iRule1  iRule2 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1 a2 a3,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Remote_Get_Put1VsInv95:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv95 ) (NI_Remote_Get_Put1  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Remote_Get_Put2VsInv95:
    (*Rule2VsPInv0*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iRule2 \<le> N" and  a3:"iRule1~=iRule2  "

  shows  "invHoldForRule' s (inv95 ) (NI_Remote_Get_Put2  iRule1  iRule2 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1 a2 a3,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Remote_PutVsInv95:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv95 ) (NI_Remote_Put  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Remote_PutXVsInv95:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv95 ) (NI_Remote_PutX  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_ReplaceVsInv95:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv95 ) (NI_Replace  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_ReplaceHomeVsInv95:
    (*Rule0VsPInv0*)

  shows  "invHoldForRule' s (inv95 ) (NI_ReplaceHome ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

      by( auto)

  lemma NI_ReplaceHomeShrVldVsInv95:
    (*Rule0VsPInv0*)

  shows  "invHoldForRule' s (inv95 ) (NI_ReplaceHomeShrVld ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

      by( auto)

  lemma NI_ReplaceShrVldVsInv95:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv95 ) (NI_ReplaceShrVld  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_ShWbVsInv95:
  (*Rule0VsPInv0*)
  shows  "invHoldForRule' s (inv95 ) (NI_ShWb N ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

      have "?P1 s"

        apply( auto)

        done

        then  show "?P1 s\<or> ?P2 s\<or> ?P3 s"

       by blast

 qed
lemma NI_WbVsInv95:
  (*Rule0VsPInv0*)
  shows  "invHoldForRule' s (inv95 ) (NI_Wb ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

      have "?P1 s"

        apply( auto)

        done

        then  show "?P1 s\<or> ?P2 s\<or> ?P3 s"

       by blast

 qed
lemma PI_Local_GetX_GetX1VsInv95:
    (*Rule0VsPInv0*)

  shows  "invHoldForRule' s (inv95 ) (PI_Local_GetX_GetX1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

      by( auto)

  lemma PI_Local_GetX_GetX2VsInv95:
    (*Rule0VsPInv0*)

  shows  "invHoldForRule' s (inv95 ) (PI_Local_GetX_GetX2 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

      by( auto)

  lemma PI_Local_GetX_PutX1VsInv95:
  (*Rule0VsPInv0*)
  shows  "invHoldForRule' s (inv95 ) (PI_Local_GetX_PutX1 N ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

      have "?P1 s"

        apply( auto)

        done

        then  show "?P1 s\<or> ?P2 s\<or> ?P3 s"

       by blast

 qed
lemma PI_Local_GetX_PutX2VsInv95:
  (*Rule0VsPInv0*)
  shows  "invHoldForRule' s (inv95 ) (PI_Local_GetX_PutX2 N ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

      have "?P1 s"

        apply( auto)

        done

        then  show "?P1 s\<or> ?P2 s\<or> ?P3 s"

       by blast

 qed
lemma PI_Local_GetX_PutX3VsInv95:
  (*Rule0VsPInv0*)
  shows  "invHoldForRule' s (inv95 ) (PI_Local_GetX_PutX3 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

      have "?P1 s"

        apply( auto)

        done

        then  show "?P1 s\<or> ?P2 s\<or> ?P3 s"

       by blast

 qed
lemma PI_Local_GetX_PutX4VsInv95:
  (*Rule0VsPInv0*)
  shows  "invHoldForRule' s (inv95 ) (PI_Local_GetX_PutX4 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

      have "?P1 s"

        apply( auto)

        done

        then  show "?P1 s\<or> ?P2 s\<or> ?P3 s"

       by blast

 qed
lemma PI_Local_Get_GetVsInv95:
    (*Rule0VsPInv0*)

  shows  "invHoldForRule' s (inv95 ) (PI_Local_Get_Get ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

      by( auto)

  lemma PI_Local_Get_PutVsInv95:
  (*Rule0VsPInv0*)
  shows  "invHoldForRule' s (inv95 ) (PI_Local_Get_Put ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have allCases:"formEval  ( eqn ( IVar ( Para ''InvMarked'' Home) )  ( Const true ))  s  \<or>formEval   (neg ( eqn ( IVar ( Para ''InvMarked'' Home) )  ( Const true )) )  s  "
	                      by auto

    moreover
                       {assume b1:"formEval ( eqn ( IVar ( Para ''InvMarked'' Home) )  ( Const true ))  s"

      have "?P1 s"

        apply(cut_tac  b1 , auto)

        done

        then  have "?P1 s\<or> ?P2 s \<or> ?P3 s"

       by blast
    }

    moreover
                       {assume b1:"formEval  (neg ( eqn ( IVar ( Para ''InvMarked'' Home) )  ( Const true )) )  s"

      have "?P1 s"

        apply(cut_tac  b1 , auto)

        done

        then  have "?P1 s\<or> ?P2 s \<or> ?P3 s"

       by blast
    }
   ultimately show "?P1 s\<or> ?P2 s\<or> ?P3 s"

	                         by metis

 qed
lemma PI_Local_PutXVsInv95:
  (*Rule0VsPInv0*)
  shows  "invHoldForRule' s (inv95 ) (PI_Local_PutX ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

      have "?P1 s"

        apply( auto)

        done

        then  show "?P1 s\<or> ?P2 s\<or> ?P3 s"

       by blast

 qed
lemma PI_Local_ReplaceVsInv95:
  (*Rule0VsPInv0*)
  shows  "invHoldForRule' s (inv95 ) (PI_Local_Replace ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

      have "?P1 s"

        apply( auto)

        done

        then  show "?P1 s\<or> ?P2 s\<or> ?P3 s"

       by blast

 qed
lemma PI_Remote_GetVsInv95:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv95 ) (PI_Remote_Get  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma PI_Remote_GetXVsInv95:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv95 ) (PI_Remote_GetX  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma PI_Remote_PutXVsInv95:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv95 ) (PI_Remote_PutX  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma PI_Remote_ReplaceVsInv95:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv95 ) (PI_Remote_Replace  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma StoreVsInv95:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv95 ) (Store  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma StoreHomeVsInv95:
    (*Rule0VsPInv0*)

  shows  "invHoldForRule' s (inv95 ) (StoreHome ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

      by( auto)

  end


subsection "Termination-Sensitive Systems"

theory Sec_TypingT imports Sec_Type_Expr
begin

subsubsection "A Syntax Directed System"

inductive sec_type :: "nat \<Rightarrow> com \<Rightarrow> bool" ("(_/ \<turnstile> _)" [0,0] 50) where
Skip:
  "l \<turnstile> SKIP"  |
Assign:
  "\<lbrakk> sec x \<ge> sec a;  sec x \<ge> l \<rbrakk> \<Longrightarrow> l \<turnstile> x ::= a"  |
Seq:
  "l \<turnstile> c\<^sub>1 \<Longrightarrow> l \<turnstile> c\<^sub>2 \<Longrightarrow> l \<turnstile> c\<^sub>1;;c\<^sub>2"  |
If:
  "\<lbrakk> max (sec b) l \<turnstile> c\<^sub>1;  max (sec b) l \<turnstile> c\<^sub>2 \<rbrakk>
   \<Longrightarrow> l \<turnstile> IF b THEN c\<^sub>1 ELSE c\<^sub>2"  |
While:
  "sec b = 0 \<Longrightarrow> 0 \<turnstile> c \<Longrightarrow> 0 \<turnstile> WHILE b DO c"

code_pred (expected_modes: i => i => bool) sec_type .

inductive_cases [elim!]:
  "l \<turnstile> x ::= a"  "l \<turnstile> c\<^sub>1;;c\<^sub>2"  "l \<turnstile> IF b THEN c\<^sub>1 ELSE c\<^sub>2"  "l \<turnstile> WHILE b DO c"

lemma anti_mono: "l \<turnstile> c \<Longrightarrow> l' \<le> l \<Longrightarrow> l' \<turnstile> c"
apply(induction arbitrary: l' rule: sec_type.induct)
apply (metis sec_type.intros(1))
apply (metis le_trans sec_type.intros(2))
apply (metis sec_type.intros(3))
apply (metis If le_refl sup_mono sup_nat_def)
by (metis While le_0_eq)

lemma confinement: "(c,s) \<Rightarrow> t \<Longrightarrow> l \<turnstile> c \<Longrightarrow> s = t (< l)"
proof(induction rule: big_step_induct)
  case Skip thus ?case by simp
next
  case Assign thus ?case by auto
next
  case Seq thus ?case by auto
next
  case (IfTrue b s c1)
  hence "max (sec b) l \<turnstile> c1" by auto
  hence "l \<turnstile> c1" by (metis max.cobounded2 anti_mono)
  thus ?case using IfTrue.IH by metis
next
  case (IfFalse b s c2)
  hence "max (sec b) l \<turnstile> c2" by auto
  hence "l \<turnstile> c2" by (metis max.cobounded2 anti_mono)
  thus ?case using IfFalse.IH by metis
next
  case WhileFalse thus ?case by auto
next
  case (WhileTrue b s1 c)
  hence "l \<turnstile> c" by auto
  thus ?case using WhileTrue by metis
qed

lemma termi_if_non0: "l \<turnstile> c \<Longrightarrow> l \<noteq> 0 \<Longrightarrow> \<exists> t. (c,s) \<Rightarrow> t"
apply(induction arbitrary: s rule: sec_type.induct)
apply (metis big_step.Skip)
apply (metis big_step.Assign)
apply (metis big_step.Seq)
apply (metis IfFalse IfTrue le0 le_antisym max.cobounded2)
apply simp
done

theorem noninterference: "(c,s) \<Rightarrow> s' \<Longrightarrow> 0 \<turnstile> c \<Longrightarrow>  s = t (\<le> l)
  \<Longrightarrow> \<exists> t'. (c,t) \<Rightarrow> t' \<and> s' = t' (\<le> l)"
proof(induction arbitrary: t rule: big_step_induct)
  case Skip thus ?case by auto
next
  case (Assign x a s)
  have "sec x >= sec a" using \<open>0 \<turnstile> x ::= a\<close> by auto
  have "(x ::= a,t) \<Rightarrow> t(x := aval a t)" by auto
  moreover
  have "s(x := aval a s) = t(x := aval a t) (\<le> l)"
  proof auto
    assume "sec x \<le> l"
    with \<open>sec x \<ge> sec a\<close> have "sec a \<le> l" by arith
    thus "aval a s = aval a t"
      by (rule aval_eq_if_eq_le[OF \<open>s = t (\<le> l)\<close>])
  next
    fix y assume "y \<noteq> x" "sec y \<le> l"
    thus "s y = t y" using \<open>s = t (\<le> l)\<close> by simp
  qed
  ultimately show ?case by blast
next
  case Seq thus ?case by blast
next
  case (IfTrue b s c1 s' c2)
  have "sec b \<turnstile> c1" "sec b \<turnstile> c2" using \<open>0 \<turnstile> IF b THEN c1 ELSE c2\<close> by auto
  obtain t' where t': "(c1, t) \<Rightarrow> t'" "s' = t' (\<le> l)"
    using IfTrue.IH[OF anti_mono[OF \<open>sec b \<turnstile> c1\<close>] \<open>s = t (\<le> l)\<close>] by blast
  show ?case
  proof cases
    assume "sec b \<le> l"
    hence "s = t (\<le> sec b)" using \<open>s = t (\<le> l)\<close> by auto
    hence "bval b t" using \<open>bval b s\<close> by(simp add: bval_eq_if_eq_le)
    thus ?thesis by (metis t' big_step.IfTrue)
  next
    assume "\<not> sec b \<le> l"
    hence 0: "sec b \<noteq> 0" by arith
    have 1: "sec b \<turnstile> IF b THEN c1 ELSE c2"
      by(rule sec_type.intros)(simp_all add: \<open>sec b \<turnstile> c1\<close> \<open>sec b \<turnstile> c2\<close>)
    from confinement[OF big_step.IfTrue[OF IfTrue(1,2)] 1] \<open>\<not> sec b \<le> l\<close>
    have "s = s' (\<le> l)" by auto
    moreover
    from termi_if_non0[OF 1 0, of t] obtain t' where
      t': "(IF b THEN c1 ELSE c2,t) \<Rightarrow> t'" ..
    moreover
    from confinement[OF t' 1] \<open>\<not> sec b \<le> l\<close>
    have "t = t' (\<le> l)" by auto
    ultimately
    show ?case using \<open>s = t (\<le> l)\<close> by auto
  qed
next
  case (IfFalse b s c2 s' c1)
  have "sec b \<turnstile> c1" "sec b \<turnstile> c2" using \<open>0 \<turnstile> IF b THEN c1 ELSE c2\<close> by auto
  obtain t' where t': "(c2, t) \<Rightarrow> t'" "s' = t' (\<le> l)"
    using IfFalse.IH[OF anti_mono[OF \<open>sec b \<turnstile> c2\<close>] \<open>s = t (\<le> l)\<close>] by blast
  show ?case
  proof cases
    assume "sec b \<le> l"
    hence "s = t (\<le> sec b)" using \<open>s = t (\<le> l)\<close> by auto
    hence "\<not> bval b t" using \<open>\<not> bval b s\<close> by(simp add: bval_eq_if_eq_le)
    thus ?thesis by (metis t' big_step.IfFalse)
  next
    assume "\<not> sec b \<le> l"
    hence 0: "sec b \<noteq> 0" by arith
    have 1: "sec b \<turnstile> IF b THEN c1 ELSE c2"
      by(rule sec_type.intros)(simp_all add: \<open>sec b \<turnstile> c1\<close> \<open>sec b \<turnstile> c2\<close>)
    from confinement[OF big_step.IfFalse[OF IfFalse(1,2)] 1] \<open>\<not> sec b \<le> l\<close>
    have "s = s' (\<le> l)" by auto
    moreover
    from termi_if_non0[OF 1 0, of t] obtain t' where
      t': "(IF b THEN c1 ELSE c2,t) \<Rightarrow> t'" ..
    moreover
    from confinement[OF t' 1] \<open>\<not> sec b \<le> l\<close>
    have "t = t' (\<le> l)" by auto
    ultimately
    show ?case using \<open>s = t (\<le> l)\<close> by auto
  qed
next
  case (WhileFalse b s c)
  hence [simp]: "sec b = 0" by auto
  have "s = t (\<le> sec b)" using \<open>s = t (\<le> l)\<close> by auto
  hence "\<not> bval b t" using \<open>\<not> bval b s\<close> by (metis bval_eq_if_eq_le le_refl)
  with WhileFalse.prems(2) show ?case by auto
next
  case (WhileTrue b s c s'' s')
  let ?w = "WHILE b DO c"
  from \<open>0 \<turnstile> ?w\<close> have [simp]: "sec b = 0" by auto
  have "0 \<turnstile> c" using \<open>0 \<turnstile> WHILE b DO c\<close> by auto
  from WhileTrue.IH(1)[OF this \<open>s = t (\<le> l)\<close>]
  obtain t'' where "(c,t) \<Rightarrow> t''" and "s'' = t'' (\<le>l)" by blast
  from WhileTrue.IH(2)[OF \<open>0 \<turnstile> ?w\<close> this(2)]
  obtain t' where "(?w,t'') \<Rightarrow> t'" and "s' = t' (\<le>l)" by blast
  from \<open>bval b s\<close> have "bval b t"
    using bval_eq_if_eq_le[OF \<open>s = t (\<le>l)\<close>] by auto
  show ?case
    using big_step.WhileTrue[OF \<open>bval b t\<close> \<open>(c,t) \<Rightarrow> t''\<close> \<open>(?w,t'') \<Rightarrow> t'\<close>]
    by (metis \<open>s' = t' (\<le> l)\<close>)
qed

subsubsection "The Standard System"

text\<open>The predicate \<^prop>\<open>l \<turnstile> c\<close> is nicely intuitive and executable. The
standard formulation, however, is slightly different, replacing the maximum
computation by an antimonotonicity rule. We introduce the standard system now
and show the equivalence with our formulation.\<close>

inductive sec_type' :: "nat \<Rightarrow> com \<Rightarrow> bool" ("(_/ \<turnstile>'' _)" [0,0] 50) where
Skip':
  "l \<turnstile>' SKIP"  |
Assign':
  "\<lbrakk> sec x \<ge> sec a;  sec x \<ge> l \<rbrakk> \<Longrightarrow> l \<turnstile>' x ::= a"  |
Seq':
  "l \<turnstile>' c\<^sub>1 \<Longrightarrow> l \<turnstile>' c\<^sub>2 \<Longrightarrow> l \<turnstile>' c\<^sub>1;;c\<^sub>2"  |
If':
  "\<lbrakk> sec b \<le> l;  l \<turnstile>' c\<^sub>1;  l \<turnstile>' c\<^sub>2 \<rbrakk> \<Longrightarrow> l \<turnstile>' IF b THEN c\<^sub>1 ELSE c\<^sub>2"  |
While':
  "\<lbrakk> sec b = 0;  0 \<turnstile>' c \<rbrakk> \<Longrightarrow> 0 \<turnstile>' WHILE b DO c"  |
anti_mono':
  "\<lbrakk> l \<turnstile>' c;  l' \<le> l \<rbrakk> \<Longrightarrow> l' \<turnstile>' c"

lemma sec_type_sec_type':
  "l \<turnstile> c \<Longrightarrow> l \<turnstile>' c"
apply(induction rule: sec_type.induct)
apply (metis Skip')
apply (metis Assign')
apply (metis Seq')
apply (metis max.commute max.absorb_iff2 nat_le_linear If' anti_mono')
by (metis While')

lemma sec_type'_sec_type:
  "l \<turnstile>' c \<Longrightarrow> l \<turnstile> c"
apply(induction rule: sec_type'.induct)
apply (metis Skip)
apply (metis Assign)
apply (metis Seq)
apply (metis max.absorb2 If)
apply (metis While)
by (metis anti_mono)

corollary sec_type_eq: "l \<turnstile> c \<longleftrightarrow> l \<turnstile>' c"
by (metis sec_type'_sec_type sec_type_sec_type')

end