(*
Title: WHATandWHERE-Security
Authors: Sylvia Grewe, Alexander Lux, Heiko Mantel, Jens Sauer
*)
theory Type_System_example
imports Type_System "../Strong_Security/Expr" "../Strong_Security/Domain_example"
begin

--"When interpreting, we have to instantiate the type for domains. As an example, we take a type containing 'low' and 'high' as domains."

consts DA :: "('id,Dom) DomainAssignment"
consts BMap :: "'val \<Rightarrow> bool"
consts lH :: "(Dom,('id,'val) Expr) lHatches"

--"redefine all the abbreviations necessary for auxiliary lemmas with the
  correct parameter instantiation"

abbreviation MWLsStepsdet' ::
  "(('id,'val) Expr, 'id, 'val, (('id,'val) Expr,'id) MWLsCom) TLSteps_curry"
("(1\<langle>_,/_\<rangle>) \<rightarrow>\<lhd>_\<rhd>/ (1\<langle>_,/_\<rangle>)" [0,0,0,0,0] 81)
where
"\<langle>c1,m1\<rangle> \<rightarrow>\<lhd>\<alpha>\<rhd> \<langle>c2,m2\<rangle> \<equiv>
  ((c1,m1),\<alpha>,(c2,m2)) \<in> MWLs_semantics.MWLsSteps_det ExprEval BMap"

abbreviation d_equal' :: "('id, 'val) State
  \<Rightarrow> Dom \<Rightarrow> ('id, 'val) State \<Rightarrow> bool"
( "(_ =\<^bsub>_\<^esub> _)" )
where
"m =\<^bsub>d\<^esub> m' \<equiv> WHATWHERE.d_equal DA d m m'"

abbreviation dH_equal' :: "('id, 'val) State \<Rightarrow> Dom
  \<Rightarrow> (Dom,('id,'val) Expr) Hatches
  \<Rightarrow> ('id, 'val) State \<Rightarrow> bool"
( "(_ \<sim>\<^bsub>_,_\<^esub> _)" )
where
"m \<sim>\<^bsub>d,H\<^esub> m' \<equiv> WHATWHERE.dH_equal ExprEval DA d H m m'"

abbreviation NextMem' :: "(('id,'val) Expr, 'id) MWLsCom
  \<Rightarrow> ('id,'val) State \<Rightarrow> ('id,'val) State"
("\<lbrakk>_\<rbrakk>'(_')")
where
"\<lbrakk>c\<rbrakk>(m)
  \<equiv> WHATWHERE.NextMem (MWLs_semantics.MWLsSteps_det ExprEval BMap) c m"

abbreviation dH_indistinguishable' :: "('id,'val) Expr \<Rightarrow> Dom
  \<Rightarrow> (Dom,('id,'val) Expr) Hatches \<Rightarrow> ('id,'val) Expr \<Rightarrow> bool"
( "(_ \<equiv>\<^bsub>_,_\<^esub> _)" )
where
"e1 \<equiv>\<^bsub>d,H\<^esub> e2
  \<equiv> WHATWHERE_Secure_Programs.dH_indistinguishable ExprEval DA d H e1 e2"

abbreviation htchLoc :: "nat \<Rightarrow> (Dom, ('id,'val) Expr) Hatches"
where
"htchLoc \<iota> \<equiv> WHATWHERE.htchLoc lH \<iota>"

-- "Security typing rules for expressions"
inductive
ExprSecTyping :: "(Dom, ('id,'val) Expr) Hatches
  \<Rightarrow> ('id, 'val) Expr \<Rightarrow> Dom \<Rightarrow> bool"
("_ \<turnstile>\<^bsub>\<E>\<^esub> _ : _")
for H :: "(Dom, ('id, 'val) Expr) Hatches"
where
Consts: "H \<turnstile>\<^bsub>\<E>\<^esub> (Const v) : d" |
Vars: "DA x = d \<Longrightarrow> H \<turnstile>\<^bsub>\<E>\<^esub> (Var x) : d" |
Hatch: "(d,e) \<in> H \<Longrightarrow> H \<turnstile>\<^bsub>\<E>\<^esub> e : d" |
Ops: "\<lbrakk> \<forall>i < length arglist. H \<turnstile>\<^bsub>\<E>\<^esub> (arglist!i) : (dl!i) \<and> (dl!i) \<le> d \<rbrakk>
  \<Longrightarrow> H \<turnstile>\<^bsub>\<E>\<^esub> (Op f arglist) : d"

--"function substituting a certain expression with another expression
  in expressions"
primrec Subst :: "('id, 'val) Expr \<Rightarrow> ('id, 'val) Expr
  \<Rightarrow> ('id, 'val) Expr \<Rightarrow> ('id, 'val) Expr"
("_<_\\_>")
and SubstL :: "('id, 'val) Expr list \<Rightarrow> ('id, 'val) Expr
  \<Rightarrow> ('id, 'val) Expr \<Rightarrow> ('id, 'val) Expr list"
where
"(Const v)<e1\\e2> = (if e1=(Const v) then e2 else (Const v))" |
"(Var x)<e1\\e2> = (if e1=(Var x) then e2 else (Var x))" |
"(Op f arglist)<e1\\e2> = (if e1=(Op f arglist) then e2 else
  (Op f (SubstL arglist e1 e2)))" |

"SubstL [] e1 e2 = []" |
"SubstL (e#V) e1 e2 = (e<e1\\e2>)#(SubstL V e1 e2)"

definition SubstClosure :: "'id \<Rightarrow> ('id, 'val) Expr \<Rightarrow> bool"
where
"SubstClosure x e \<equiv> \<forall>(d',e',\<iota>') \<in> lH. (d',e'<(Var x)\\e>,\<iota>') \<in> lH"

definition synAssignSC :: "'id \<Rightarrow> ('id, 'val) Expr \<Rightarrow> nat \<Rightarrow> bool"
where
"synAssignSC x e \<iota> \<equiv> \<exists>d. ((htchLoc \<iota>) \<turnstile>\<^bsub>\<E>\<^esub> e : d \<and> d \<le> DA x)
  \<and> (SubstClosure x e)"

definition synWhileSC :: "('id, 'val) Expr \<Rightarrow> bool"
where
"synWhileSC e \<equiv> (\<exists>d. ({} \<turnstile>\<^bsub>\<E>\<^esub> e : d) \<and> (\<forall>d'. d \<le> d'))"

definition synIfSC :: "('id, 'val) Expr
  \<Rightarrow> (('id, 'val) Expr, 'id) MWLsCom
  \<Rightarrow> (('id, 'val) Expr, 'id) MWLsCom \<Rightarrow> bool"
where
"synIfSC e c1 c2 \<equiv> \<exists>d. ({} \<turnstile>\<^bsub>\<E>\<^esub> e : d \<and> (\<forall>d'. d \<le> d'))"

--"auxiliary lemma for locale interpretation (theorem 7 in original paper)"
lemma ExprTypable_with_smallerd_implies_dH_indistinguishable:
  "\<lbrakk> H \<turnstile>\<^bsub>\<E>\<^esub> e : d'; d' \<le> d \<rbrakk> \<Longrightarrow> e \<equiv>\<^bsub>d,H\<^esub> e"
proof (induct rule: ExprSecTyping.induct,
    simp_all add: WHATWHERE_Secure_Programs.dH_indistinguishable_def
    WHATWHERE.dH_equal_def WHATWHERE.d_equal_def, auto)
  fix dl arglist f m1 m2 d' d
  assume main: "\<forall>i < length arglist.
    (H \<turnstile>\<^bsub>\<E>\<^esub> (arglist!i) : (dl!i)) \<and> (dl!i \<le> d \<longrightarrow>
    (\<forall>m1 m2. (\<forall>x. DA x \<le> d \<longrightarrow> m1 x = m2 x) \<and>
    (\<forall>(d',e)\<in>H. d' \<le> d \<longrightarrow> ExprEval e m1 = ExprEval e m2) \<longrightarrow>
    ExprEval (arglist!i) m1 = ExprEval (arglist!i) m2)) \<and> dl!i \<le> d'"
  assume smaller: "d' \<le> d"
  assume eqeval: "\<forall>(d',e) \<in> H. d' \<le> d \<longrightarrow> ExprEval e m1 = ExprEval e m2"
  assume eqstate: "\<forall>x. DA x \<le> d \<longrightarrow> m1 x = m2 x"

  from main smaller have irangesubst:
    "\<forall>i < length arglist. dl!i \<le> d"
    by (metis order_trans)

  with eqstate eqeval main have
    "\<forall>i < length arglist. ExprEval (arglist!i) m1
       = ExprEval (arglist!i) m2"
    by force

  hence substmap: "(ExprEvalL arglist m1) = (ExprEvalL arglist m2)"
    by (induct arglist, auto, force)

  show "f (ExprEvalL arglist m1) = f (ExprEvalL arglist m2)"
    by (subst substmap, auto)

qed

--"auxiliary lemma about substitutions in expressions and in memories"
lemma substexp_substmem:
"ExprEval e'<Var x\\e> m = ExprEval e' (m(x := ExprEval e m))
  \<and> ExprEvalL (SubstL elist (Var x) e) m
  = ExprEvalL elist (m(x := ExprEval e m))"
by (induct_tac e' and elist rule: ExprEval.induct ExprEvalL.induct, simp_all)

--"another auxiliary lemma for locale interpretation (lemma 8 in original paper)"
lemma SubstClosure_implications:
"\<lbrakk> SubstClosure x e; m \<sim>\<^bsub>d,(htchLoc \<iota>')\<^esub> m';
  \<lbrakk>x :=\<^bsub>\<iota>\<^esub> e\<rbrakk>(m) =\<^bsub>d\<^esub> \<lbrakk>x :=\<^bsub>\<iota>\<^esub> e\<rbrakk>(m') \<rbrakk>
  \<Longrightarrow> \<lbrakk>x :=\<^bsub>\<iota>\<^esub> e\<rbrakk>(m) \<sim>\<^bsub>d,(htchLoc \<iota>')\<^esub> \<lbrakk>x :=\<^bsub>\<iota>\<^esub> e\<rbrakk>(m')"
proof -
  fix m1 m1'
  assume substclosure: "SubstClosure x e"
  assume dequalm2: "\<lbrakk>x :=\<^bsub>\<iota>\<^esub> e\<rbrakk>(m1) =\<^bsub>d\<^esub> \<lbrakk>x :=\<^bsub>\<iota>\<^esub> e\<rbrakk>(m1')"
  assume dhequalm1: "m1 \<sim>\<^bsub>d,(htchLoc \<iota>')\<^esub> m1'"

  from MWLs_semantics.nextmem_exists_and_unique obtain m2 where m1step:
    "(\<exists>p \<alpha>. \<langle>x :=\<^bsub>\<iota>\<^esub> e,m1\<rangle> \<rightarrow>\<lhd>\<alpha>\<rhd> \<langle>p,m2\<rangle>)
    \<and> (\<forall>m''. (\<exists>p \<alpha>. \<langle>x :=\<^bsub>\<iota>\<^esub> e,m1\<rangle> \<rightarrow>\<lhd>\<alpha>\<rhd> \<langle>p,m''\<rangle>) \<longrightarrow> m'' = m2)"
    by force
  hence m2_is_next: "\<lbrakk>x :=\<^bsub>\<iota>\<^esub> e\<rbrakk>(m1) = m2"
    by (simp add: WHATWHERE.NextMem_def, auto)
  from m1step MWLs_semantics.MWLsSteps_det.assign
     [of "ExprEval" "e" "m1" _ "x" "\<iota>" "BMap"]
  have m2eq: "m2 = m1(x := (ExprEval e m1))"
    by auto

  from MWLs_semantics.nextmem_exists_and_unique obtain m2' where m1'step:
    "(\<exists>p \<alpha>. \<langle>x :=\<^bsub>\<iota>\<^esub> e,m1'\<rangle> \<rightarrow>\<lhd>\<alpha>\<rhd> \<langle>p,m2'\<rangle>)
    \<and> (\<forall>m''. (\<exists>p \<alpha>. \<langle>x :=\<^bsub>\<iota>\<^esub> e,m1'\<rangle> \<rightarrow>\<lhd>\<alpha>\<rhd> \<langle>p,m''\<rangle>) \<longrightarrow> m'' = m2')"
    by force
  hence m2'_is_next: "\<lbrakk>x :=\<^bsub>\<iota>\<^esub> e\<rbrakk>(m1') = m2'"
    by (simp add: WHATWHERE.NextMem_def, auto)
  from m1'step MWLs_semantics.MWLsSteps_det.assign
     [of "ExprEval" "e" "m1'" _ "x" "\<iota>" "BMap"]
  have m2'eq: "m2' = m1'(x := (ExprEval e m1'))"
    by auto

  from m2eq substexp_substmem
  have substeval1: "\<forall>e'. ExprEval (e'<Var x\\e>) m1 = ExprEval e' m2"
    by force

  from m2'eq substexp_substmem
  have substeval2: "\<forall>e'. ExprEval e'<Var x\\e> m1' = ExprEval e' m2'"
    by force

  from substclosure have
    "\<forall>(d',e') \<in> htchLoc \<iota>'. (d',e'<Var x\\e>) \<in> (htchLoc \<iota>')"
    by (simp add: SubstClosure_def WHATWHERE.htchLoc_def, auto)

  with dhequalm1 have
    "\<forall>(d',e') \<in> htchLoc \<iota>'.
    d' \<le> d \<longrightarrow> ExprEval e'<Var x\\e> m1 = ExprEval e'<Var x\\e> m1'"
    by (simp add: WHATWHERE.dH_equal_def, auto)

  with substeval1 substeval2 have
    "\<forall>(d',e') \<in> htchLoc \<iota>'.
    d' \<le> d \<longrightarrow> ExprEval e' m2 = ExprEval e' m2'"
    by auto

  with dequalm2 m2_is_next m2'_is_next
  show "\<lbrakk>x :=\<^bsub>\<iota>\<^esub> e\<rbrakk>(m1) \<sim>\<^bsub>d,htchLoc \<iota>'\<^esub> \<lbrakk>x :=\<^bsub>\<iota>\<^esub> e\<rbrakk>(m1')"
    by (simp add: WHATWHERE.dH_equal_def)
qed

--"interpretation of the abstract type system using the above definitions for the side conditions"
interpretation Type_System_example: Type_System ExprEval BMap DA lH
  synAssignSC synWhileSC synIfSC
by (unfold_locales, auto,
  metis ExprTypable_with_smallerd_implies_dH_indistinguishable
  synAssignSC_def,
  metis SubstClosure_implications synAssignSC_def,
  simp add: synWhileSC_def,
  metis ExprTypable_with_smallerd_implies_dH_indistinguishable
  WHATWHERE_Secure_Programs.empH_implies_dHindistinguishable_eq_dindistinguishable,
  simp add: synIfSC_def,
  metis ExprTypable_with_smallerd_implies_dH_indistinguishable
  WHATWHERE_Secure_Programs.empH_implies_dHindistinguishable_eq_dindistinguishable)

end


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

header{*The n_mutualEx Protocol Case Study*}

theory n_mutualEx_lemma_inv__4_on_rules imports n_mutualEx_lemma_on_inv__4
begin
section{*All lemmas on causal relation between inv__4*}
lemma lemma_inv__4_on_rules:
  assumes b1: "r \<in> rules N" and b2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__4  p__Inv4)"
  shows "invHoldForRule s f r (invariants N)"
  proof -
  have c1: "(\<exists> i. i\<le>N\<and>r=n_Try  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_Crit  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_Exit  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_Idle  i)"
  apply (cut_tac b1, auto) done
    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_Try  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_TryVsinv__4) done
    }

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

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

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

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

end


section {* Operational Semantics *}

theory OG_Tran imports OG_Com begin

type_synonym 'a ann_com_op = "('a ann_com) option"
type_synonym 'a ann_triple_op = "('a ann_com_op \<times> 'a assn)"

primrec com :: "'a ann_triple_op \<Rightarrow> 'a ann_com_op" where
  "com (c, q) = c"

primrec post :: "'a ann_triple_op \<Rightarrow> 'a assn" where
  "post (c, q) = q"

definition All_None :: "'a ann_triple_op list \<Rightarrow> bool" where
  "All_None Ts \<equiv> \<forall>(c, q) \<in> set Ts. c = None"

subsection {* The Transition Relation *}

inductive_set
  ann_transition :: "(('a ann_com_op \<times> 'a) \<times> ('a ann_com_op \<times> 'a)) set"
  and transition :: "(('a com \<times> 'a) \<times> ('a com \<times> 'a)) set"
  and ann_transition' :: "('a ann_com_op \<times> 'a) \<Rightarrow> ('a ann_com_op \<times> 'a) \<Rightarrow> bool"
    ("_ -1\<rightarrow> _"[81,81] 100)
  and transition' :: "('a com \<times> 'a) \<Rightarrow> ('a com \<times> 'a) \<Rightarrow> bool"
    ("_ -P1\<rightarrow> _"[81,81] 100)
  and transitions :: "('a com \<times> 'a) \<Rightarrow> ('a com \<times> 'a) \<Rightarrow> bool"
    ("_ -P*\<rightarrow> _"[81,81] 100)
where
  "con_0 -1\<rightarrow> con_1 \<equiv> (con_0, con_1) \<in> ann_transition"
| "con_0 -P1\<rightarrow> con_1 \<equiv> (con_0, con_1) \<in> transition"
| "con_0 -P*\<rightarrow> con_1 \<equiv> (con_0, con_1) \<in> transition\<^sup>*"

| AnnBasic:  "(Some (AnnBasic r f), s) -1\<rightarrow> (None, f s)"

| AnnSeq1: "(Some c0, s) -1\<rightarrow> (None, t) \<Longrightarrow>
               (Some (AnnSeq c0 c1), s) -1\<rightarrow> (Some c1, t)"
| AnnSeq2: "(Some c0, s) -1\<rightarrow> (Some c2, t) \<Longrightarrow>
               (Some (AnnSeq c0 c1), s) -1\<rightarrow> (Some (AnnSeq c2 c1), t)"

| AnnCond1T: "s \<in> b  \<Longrightarrow> (Some (AnnCond1 r b c1 c2), s) -1\<rightarrow> (Some c1, s)"
| AnnCond1F: "s \<notin> b \<Longrightarrow> (Some (AnnCond1 r b c1 c2), s) -1\<rightarrow> (Some c2, s)"

| AnnCond2T: "s \<in> b  \<Longrightarrow> (Some (AnnCond2 r b c), s) -1\<rightarrow> (Some c, s)"
| AnnCond2F: "s \<notin> b \<Longrightarrow> (Some (AnnCond2 r b c), s) -1\<rightarrow> (None, s)"

| AnnWhileF: "s \<notin> b \<Longrightarrow> (Some (AnnWhile r b i c), s) -1\<rightarrow> (None, s)"
| AnnWhileT: "s \<in> b  \<Longrightarrow> (Some (AnnWhile r b i c), s) -1\<rightarrow>
                         (Some (AnnSeq c (AnnWhile i b i c)), s)"

| AnnAwait: "\<lbrakk> s \<in> b; atom_com c; (c, s) -P*\<rightarrow> (Parallel [], t) \<rbrakk> \<Longrightarrow>
                   (Some (AnnAwait r b c), s) -1\<rightarrow> (None, t)"

| Parallel: "\<lbrakk> i<length Ts; Ts!i = (Some c, q); (Some c, s) -1\<rightarrow> (r, t) \<rbrakk>
              \<Longrightarrow> (Parallel Ts, s) -P1\<rightarrow> (Parallel (Ts [i:=(r, q)]), t)"

| Basic:  "(Basic f, s) -P1\<rightarrow> (Parallel [], f s)"

| Seq1:   "All_None Ts \<Longrightarrow> (Seq (Parallel Ts) c, s) -P1\<rightarrow> (c, s)"
| Seq2:   "(c0, s) -P1\<rightarrow> (c2, t) \<Longrightarrow> (Seq c0 c1, s) -P1\<rightarrow> (Seq c2 c1, t)"

| CondT: "s \<in> b \<Longrightarrow> (Cond b c1 c2, s) -P1\<rightarrow> (c1, s)"
| CondF: "s \<notin> b \<Longrightarrow> (Cond b c1 c2, s) -P1\<rightarrow> (c2, s)"

| WhileF: "s \<notin> b \<Longrightarrow> (While b i c, s) -P1\<rightarrow> (Parallel [], s)"
| WhileT: "s \<in> b \<Longrightarrow> (While b i c, s) -P1\<rightarrow> (Seq c (While b i c), s)"

monos "rtrancl_mono"

text {* The corresponding abbreviations are: *}

abbreviation
  ann_transition_n :: "('a ann_com_op \<times> 'a) \<Rightarrow> nat \<Rightarrow> ('a ann_com_op \<times> 'a)
                           \<Rightarrow> bool"  ("_ -_\<rightarrow> _"[81,81] 100)  where
  "con_0 -n\<rightarrow> con_1 \<equiv> (con_0, con_1) \<in> ann_transition ^^ n"

abbreviation
  ann_transitions :: "('a ann_com_op \<times> 'a) \<Rightarrow> ('a ann_com_op \<times> 'a) \<Rightarrow> bool"
                           ("_ -*\<rightarrow> _"[81,81] 100)  where
  "con_0 -*\<rightarrow> con_1 \<equiv> (con_0, con_1) \<in> ann_transition\<^sup>*"

abbreviation
  transition_n :: "('a com \<times> 'a) \<Rightarrow> nat \<Rightarrow> ('a com \<times> 'a) \<Rightarrow> bool"
                          ("_ -P_\<rightarrow> _"[81,81,81] 100)  where
  "con_0 -Pn\<rightarrow> con_1 \<equiv> (con_0, con_1) \<in> transition ^^ n"

subsection {* Definition of Semantics *}

definition ann_sem :: "'a ann_com \<Rightarrow> 'a \<Rightarrow> 'a set" where
  "ann_sem c \<equiv> \<lambda>s. {t. (Some c, s) -*\<rightarrow> (None, t)}"

definition ann_SEM :: "'a ann_com \<Rightarrow> 'a set \<Rightarrow> 'a set" where
  "ann_SEM c S \<equiv> \<Union>(ann_sem c ` S)"

definition sem :: "'a com \<Rightarrow> 'a \<Rightarrow> 'a set" where
  "sem c \<equiv> \<lambda>s. {t. \<exists>Ts. (c, s) -P*\<rightarrow> (Parallel Ts, t) \<and> All_None Ts}"

definition SEM :: "'a com \<Rightarrow> 'a set \<Rightarrow> 'a set" where
  "SEM c S \<equiv> \<Union>(sem c ` S)"

abbreviation Omega :: "'a com"    ("\<Omega>" 63)
  where "\<Omega> \<equiv> While UNIV UNIV (Basic id)"

primrec fwhile :: "'a bexp \<Rightarrow> 'a com \<Rightarrow> nat \<Rightarrow> 'a com" where
    "fwhile b c 0 = \<Omega>"
  | "fwhile b c (Suc n) = Cond b (Seq c (fwhile b c n)) (Basic id)"

subsubsection {* Proofs *}

declare ann_transition_transition.intros [intro]
inductive_cases transition_cases:
    "(Parallel T,s) -P1\<rightarrow> t"
    "(Basic f, s) -P1\<rightarrow> t"
    "(Seq c1 c2, s) -P1\<rightarrow> t"
    "(Cond b c1 c2, s) -P1\<rightarrow> t"
    "(While b i c, s) -P1\<rightarrow> t"

lemma Parallel_empty_lemma [rule_format (no_asm)]:
  "(Parallel [],s) -Pn\<rightarrow> (Parallel Ts,t) \<longrightarrow> Ts=[] \<and> n=0 \<and> s=t"
apply(induct n)
 apply(simp (no_asm))
apply clarify
apply(drule relpow_Suc_D2)
apply(force elim:transition_cases)
done

lemma Parallel_AllNone_lemma [rule_format (no_asm)]:
 "All_None Ss \<longrightarrow> (Parallel Ss,s) -Pn\<rightarrow> (Parallel Ts,t) \<longrightarrow> Ts=Ss \<and> n=0 \<and> s=t"
apply(induct "n")
 apply(simp (no_asm))
apply clarify
apply(drule relpow_Suc_D2)
apply clarify
apply(erule transition_cases,simp_all)
apply(force dest:nth_mem simp add:All_None_def)
done

lemma Parallel_AllNone: "All_None Ts \<Longrightarrow> (SEM (Parallel Ts) X) = X"
apply (unfold SEM_def sem_def)
apply auto
apply(drule rtrancl_imp_UN_relpow)
apply clarify
apply(drule Parallel_AllNone_lemma)
apply auto
done

lemma Parallel_empty: "Ts=[] \<Longrightarrow> (SEM (Parallel Ts) X) = X"
apply(rule Parallel_AllNone)
apply(simp add:All_None_def)
done

text {* Set of lemmas from Apt and Olderog "Verification of sequential
and concurrent programs", page 63. *}

lemma L3_5i: "X\<subseteq>Y \<Longrightarrow> SEM c X \<subseteq> SEM c Y"
apply (unfold SEM_def)
apply force
done

lemma L3_5ii_lemma1:
 "\<lbrakk> (c1, s1) -P*\<rightarrow> (Parallel Ts, s2); All_None Ts;
  (c2, s2) -P*\<rightarrow> (Parallel Ss, s3); All_None Ss \<rbrakk>
 \<Longrightarrow> (Seq c1 c2, s1) -P*\<rightarrow> (Parallel Ss, s3)"
apply(erule converse_rtrancl_induct2)
apply(force intro:converse_rtrancl_into_rtrancl)+
done

lemma L3_5ii_lemma2 [rule_format (no_asm)]:
 "\<forall>c1 c2 s t. (Seq c1 c2, s) -Pn\<rightarrow> (Parallel Ts, t) \<longrightarrow>
  (All_None Ts) \<longrightarrow> (\<exists>y m Rs. (c1,s) -P*\<rightarrow> (Parallel Rs, y) \<and>
  (All_None Rs) \<and> (c2, y) -Pm\<rightarrow> (Parallel Ts, t) \<and>  m \<le> n)"
apply(induct "n")
 apply(force)
apply(safe dest!: relpow_Suc_D2)
apply(erule transition_cases,simp_all)
 apply (fast intro!: le_SucI)
apply (fast intro!: le_SucI elim!: relpow_imp_rtrancl converse_rtrancl_into_rtrancl)
done

lemma L3_5ii_lemma3:
 "\<lbrakk>(Seq c1 c2,s) -P*\<rightarrow> (Parallel Ts,t); All_None Ts\<rbrakk> \<Longrightarrow>
    (\<exists>y Rs. (c1,s) -P*\<rightarrow> (Parallel Rs,y) \<and> All_None Rs
   \<and> (c2,y) -P*\<rightarrow> (Parallel Ts,t))"
apply(drule rtrancl_imp_UN_relpow)
apply(fast dest: L3_5ii_lemma2 relpow_imp_rtrancl)
done

lemma L3_5ii: "SEM (Seq c1 c2) X = SEM c2 (SEM c1 X)"
apply (unfold SEM_def sem_def)
apply auto
 apply(fast dest: L3_5ii_lemma3)
apply(fast elim: L3_5ii_lemma1)
done

lemma L3_5iii: "SEM (Seq (Seq c1 c2) c3) X = SEM (Seq c1 (Seq c2 c3)) X"
apply (simp (no_asm) add: L3_5ii)
done

lemma L3_5iv:
 "SEM (Cond b c1 c2) X = (SEM c1 (X \<inter> b)) Un (SEM c2 (X \<inter> (-b)))"
apply (unfold SEM_def sem_def)
apply auto
apply(erule converse_rtranclE)
 prefer 2
 apply (erule transition_cases,simp_all)
  apply(fast intro: converse_rtrancl_into_rtrancl elim: transition_cases)+
done

lemma  L3_5v_lemma1[rule_format]:
 "(S,s) -Pn\<rightarrow> (T,t) \<longrightarrow> S=\<Omega> \<longrightarrow> (\<not>(\<exists>Rs. T=(Parallel Rs) \<and> All_None Rs))"
apply (unfold UNIV_def)
apply(rule nat_less_induct)
apply safe
apply(erule relpow_E2)
 apply simp_all
apply(erule transition_cases)
 apply simp_all
apply(erule relpow_E2)
 apply(simp add: Id_def)
apply(erule transition_cases,simp_all)
apply clarify
apply(erule transition_cases,simp_all)
apply(erule relpow_E2,simp)
apply clarify
apply(erule transition_cases)
 apply simp+
    apply clarify
    apply(erule transition_cases)
apply simp_all
done

lemma L3_5v_lemma2: "\<lbrakk>(\<Omega>, s) -P*\<rightarrow> (Parallel Ts, t); All_None Ts \<rbrakk> \<Longrightarrow> False"
apply(fast dest: rtrancl_imp_UN_relpow L3_5v_lemma1)
done

lemma L3_5v_lemma3: "SEM (\<Omega>) S = {}"
apply (unfold SEM_def sem_def)
apply(fast dest: L3_5v_lemma2)
done

lemma L3_5v_lemma4 [rule_format]:
 "\<forall>s. (While b i c, s) -Pn\<rightarrow> (Parallel Ts, t) \<longrightarrow> All_None Ts \<longrightarrow>
  (\<exists>k. (fwhile b c k, s) -P*\<rightarrow> (Parallel Ts, t))"
apply(rule nat_less_induct)
apply safe
apply(erule relpow_E2)
 apply safe
apply(erule transition_cases,simp_all)
 apply (rule_tac x = "1" in exI)
 apply(force dest: Parallel_empty_lemma intro: converse_rtrancl_into_rtrancl simp add: Id_def)
apply safe
apply(drule L3_5ii_lemma2)
 apply safe
apply(drule le_imp_less_Suc)
apply (erule allE , erule impE,assumption)
apply (erule allE , erule impE, assumption)
apply safe
apply (rule_tac x = "k+1" in exI)
apply(simp (no_asm))
apply(rule converse_rtrancl_into_rtrancl)
 apply fast
apply(fast elim: L3_5ii_lemma1)
done

lemma L3_5v_lemma5 [rule_format]:
 "\<forall>s. (fwhile b c k, s) -P*\<rightarrow> (Parallel Ts, t) \<longrightarrow> All_None Ts \<longrightarrow>
  (While b i c, s) -P*\<rightarrow> (Parallel Ts,t)"
apply(induct "k")
 apply(force dest: L3_5v_lemma2)
apply safe
apply(erule converse_rtranclE)
 apply simp_all
apply(erule transition_cases,simp_all)
 apply(rule converse_rtrancl_into_rtrancl)
  apply(fast)
 apply(fast elim!: L3_5ii_lemma1 dest: L3_5ii_lemma3)
apply(drule rtrancl_imp_UN_relpow)
apply clarify
apply(erule relpow_E2)
 apply simp_all
apply(erule transition_cases,simp_all)
apply(fast dest: Parallel_empty_lemma)
done

lemma L3_5v: "SEM (While b i c) = (\<lambda>x. (\<Union>k. SEM (fwhile b c k) x))"
apply(rule ext)
apply (simp add: SEM_def sem_def)
apply safe
 apply(drule rtrancl_imp_UN_relpow,simp)
 apply clarify
 apply(fast dest:L3_5v_lemma4)
apply(fast intro: L3_5v_lemma5)
done

section {* Validity of Correctness Formulas *}

definition com_validity :: "'a assn \<Rightarrow> 'a com \<Rightarrow> 'a assn \<Rightarrow> bool" ("(3\<parallel>= _// _//_)" [90,55,90] 50) where
  "\<parallel>= p c q \<equiv> SEM c p \<subseteq> q"

definition ann_com_validity :: "'a ann_com \<Rightarrow> 'a assn \<Rightarrow> bool" ("\<Turnstile> _ _" [60,90] 45) where
  "\<Turnstile> c q \<equiv> ann_SEM c (pre c) \<subseteq> q"

end


           (*-------------------------------------------*
            |        CSP-Prover on Isabelle2004         |
            |               December 2004               |
            |                   July 2005 (modified)    |
            |                 August 2005 (modified)    |
            |                                           |
            |        CSP-Prover on Isabelle2005         |
            |                October 2005  (modified)   |
            |                  March 2007  (modified)   |
            |                 August 2007  (modified)   |
            |                                           |
            |        Yoshinao Isobe (AIST JAPAN)        |
            *-------------------------------------------*)

theory CSP_F_mono
imports CSP_F_domain CSP_T_mono
begin

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

         1. mono check of failuresfun
         2.
         3.
         4.

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

(*--------------------------------*
 |        STOP,SKIP,DIV           |
 *--------------------------------*)

lemma mono_failures_STOP: "mono (failures (STOP))"
by (simp add: mono_def failures_iff)

lemma mono_failures_SKIP: "mono (failures (SKIP))"
by (simp add: mono_def failures_iff)

lemma mono_failures_DIV: "mono (failures (DIV))"
by (simp add: mono_def failures_iff)

(*--------------------------------*
 |          Act_prefix            |
 *--------------------------------*)

lemma mono_failures_Act_prefix:
 "mono (failures P) ==> mono (failures (a -> P))"
apply (simp add: mono_def)
apply (intro allI impI)
apply (drule_tac x="x" in spec)
apply (drule_tac x="y" in spec)
apply (simp)
apply (rule)
apply (simp add: in_failures)
apply (auto)
done

(*--------------------------------*
 |        Ext_pre_choice          |
 *--------------------------------*)

lemma mono_failures_Ext_pre_choice:
 "ALL a. mono (failures (Pf a))
  ==> mono (failures (? a:X -> (Pf a)))"
apply (simp add: mono_def)
apply (intro allI impI)
apply (rule)
apply (simp add: in_failures)
apply (erule disjE, simp)
apply (rule disjI2)
apply (elim conjE exE)
apply (drule_tac x="a" in spec)
apply (drule_tac x="x" in spec)
apply (drule_tac x="y" in spec)
apply (auto)
done

(*--------------------------------*
 |          Ext_choice            |
 *--------------------------------*)

lemma mono_failures_Ext_choice:
 "[| mono (traces P) ; mono (traces Q) ;
     mono (failures P) ; mono (failures Q) |]
  ==> mono (failures (P [+] Q))"
apply (simp add: mono_def)
apply (intro allI impI)
apply (rule)
apply (simp add: in_failures)
apply (drule_tac x="x" in spec)
apply (drule_tac x="x" in spec)
apply (drule_tac x="y" in spec)
apply (drule_tac x="y" in spec)
apply (drule_tac x="(fstF o x)" in spec)
apply (drule_tac x="(fstF o x)" in spec)
apply (drule_tac x="(fstF o y)" in spec)
apply (drule_tac x="(fstF o y)" in spec)
apply (simp add: order_prod_def mono_fstF[simplified mono_def])
apply (elim conjE disjE)
apply (force)+
done

(*--------------------------------*
 |          Int_choice            |
 *--------------------------------*)

lemma mono_failures_Int_choice:
 "[| mono (failures P) ; mono (failures Q) |]
  ==> mono (failures (P |~| Q))"
apply (simp add: mono_def)
apply (intro allI impI)
apply (rule)
apply (simp add: in_failures)
apply (elim disjE)
apply (force)
apply (force)
done

(*--------------------------------*
 |        Rep_int_choice          |
 *--------------------------------*)

lemma mono_failures_Rep_int_choice:
 "ALL c. mono (failures (Pf c))
  ==> mono (failures (!! c:C .. (Pf c)))"
apply (simp add: mono_def)
apply (intro allI impI)
apply (rule)
apply (simp add: in_failures)
apply (elim conjE bexE)
apply (drule_tac x="c" in spec)
apply (drule_tac x="x" in spec)
apply (drule_tac x="y" in spec)
apply (auto)
done

(*--------------------------------*
 |              IF                |
 *--------------------------------*)

lemma mono_failures_IF:
 "[| mono (failures P) ; mono (failures Q) |]
  ==> mono (failures (IF b THEN P ELSE Q))"
apply (simp add: mono_def)
apply (auto simp add: in_failures subsetF_iff)
done

(*--------------------------------*
 |           Parallel             |
 *--------------------------------*)

lemma mono_failures_Parallel:
 "[| mono (failures P) ; mono (failures Q) |]
  ==> mono (failures (P |[X]| Q))"
apply (simp add: mono_def)
apply (intro allI impI)
apply (rule)
apply (simp add: in_failures)
apply (elim conjE exE)
apply (rule_tac x="Y" in exI)
apply (rule_tac x="Z" in exI)
apply (simp)
apply (rule_tac x="sa" in exI)
apply (rule_tac x="t" in exI)
apply (auto simp add: subsetF_iff)
done

(*--------------------------------*
 |            Hiding              |
 *--------------------------------*)

lemma mono_failures_Hiding:
 "mono (failures P)
  ==> mono (failures (P -- X))"
apply (simp add: mono_def)
apply (intro allI impI)
apply (rule)
apply (simp add: in_failures)
apply (elim conjE exE)
apply (rule_tac x="sa" in exI)
apply (auto simp add: subsetF_iff)
done

(*--------------------------------*
 |           Renaming             |
 *--------------------------------*)

lemma mono_failures_Renaming:
 "mono (failures P)
  ==> mono (failures (P [[r]]))"
apply (simp add: mono_def)
apply (intro allI impI)
apply (rule)
apply (simp add: in_failures)
apply (elim conjE exE)
apply (rule_tac x="sa" in exI)
apply (auto simp add: subsetF_iff)
done

(*--------------------------------*
 |           Seq_compo            |
 *--------------------------------*)

lemma mono_failures_Seq_compo:
 "[| mono (failures P) ; mono (failures Q) |]
  ==> mono (failures (P ;; Q))"
apply (simp add: mono_def)
apply (intro allI impI)
apply (rule)
apply (simp add: in_failures)

apply (erule disjE)
apply (simp add: subsetF_iff)
apply (elim conjE exE)
apply (rule disjI2)
apply (rule_tac x="sa" in exI)
apply (rule_tac x="t" in exI)
apply (drule_tac x="x" in spec)
apply (drule_tac x="x" in spec)
apply (drule_tac x="y" in spec)
apply (drule_tac x="y" in spec)
apply (simp)

apply (subgoal_tac "traces P (fstF o x) <= traces P (fstF o y)")
apply (force)
apply (subgoal_tac "fstF o x <= fstF o y")
apply (simp add: mono_traces[simplified mono_def])
apply (simp add: order_prod_def)
apply (rule allI)
apply (drule_tac x="xa" in spec)
apply (simp add: mono_fstF[simplified mono_def])
done

(*--------------------------------*
 |          Depth_rest            |
 *--------------------------------*)

lemma mono_failures_Depth_rest:
 "mono (failures P)
  ==> mono (failures (P |. n))"
apply (simp add: mono_def)
apply (intro allI impI)
apply (rule)
apply (simp add: in_failures)
apply (elim conjE exE disjE)
apply (force)
apply (force)
done

(*--------------------------------*
 |            variable            |
 *--------------------------------*)

lemma mono_failures_variable:
   "mono (failures ($p))"
apply (simp add: mono_def)
apply (intro allI impI)
apply (rule)
apply (simp add: in_failures)
apply (simp add: order_prod_def)
apply (drule_tac x="p" in spec)
apply (insert mono_sndF)
apply (simp add: mono_def)
apply (drule_tac x="x p" in spec)
apply (drule_tac x="y p" in spec)
apply (simp add: subsetF_iff order_prod_def)
done

(*--------------------------------*
 |            Procfun             |
 *--------------------------------*)

lemma mono_failures: "mono (failures P)"
apply (induct_tac P)
apply (simp add: mono_failures_STOP)
apply (simp add: mono_failures_SKIP)
apply (simp add: mono_failures_DIV)
apply (simp add: mono_failures_Act_prefix)
apply (simp add: mono_failures_Ext_pre_choice)
apply (simp add: mono_failures_Ext_choice mono_traces)
apply (simp add: mono_failures_Int_choice)
apply (simp add: mono_failures_Rep_int_choice)
apply (simp add: mono_failures_IF)
apply (simp add: mono_failures_Parallel)
apply (simp add: mono_failures_Hiding)
apply (simp add: mono_failures_Renaming)
apply (simp add: mono_failures_Seq_compo mono_traces)
apply (simp add: mono_failures_Depth_rest)
apply (simp add: mono_failures_variable)
done

(*=============================================================*
 |                         [[P]]Ff                             |
 *=============================================================*)

lemma mono_semFf: "mono [[Pf]]Ff"
apply (simp add: mono_def)
apply (simp add: subdomF_decompo)
apply (intro allI impI)

apply (simp add: mono_failures[simplified mono_def])

apply (subgoal_tac "mono (traces Pf)")
apply (simp add: mono_def)
apply (drule_tac x="fstF o x" in spec)
apply (drule_tac x="fstF o y" in spec)
apply (drule mp)

 apply (simp add: order_prod_def)
 apply (simp add: mono_fstF[simplified mono_def])
 apply (simp)

apply (simp add: mono_traces)
done

(*=============================================================*
 |                         [[P]]Ffun                           |
 *=============================================================*)

lemma mono_semFfun: "mono [[PF]]Ffun"
apply (simp add: prod_mono)
apply (simp add: semFfun_def)
apply (simp add: comp_def)
apply (simp add: proj_fun_def)
apply (simp add: mono_semFf)
done

end


\<^marker>\<open>creator Florian Keßler\<close>

section "IMP-- to SAS++ Correctness"

theory IMP_Minus_Minus_To_SAS_Plus_Plus_Correctness
  imports IMP_Minus_Minus_To_SAS_Plus_Plus_Reduction "../SAS_Plus_Plus"
begin

text \<open> We show correctness for the IMP-- to SAS++ reduction. \<close>

lemma sas_plus_state_to_imp_minus_of_effect:
  assumes "op \<in> set (com_to_operators c1)"
  shows "sas_plus_state_to_imp_minus (imp_minus_state_to_sas_plus (c, is) ++ map_of (effect_of op))
  = (pc_to_com (effect_of op),
  snd (sas_plus_state_to_imp_minus (imp_minus_state_to_sas_plus (c, is) ++ map_of (effect_of op))))"
proof -
  have "fst (sas_plus_state_to_imp_minus
    (imp_minus_state_to_sas_plus (c, is) ++ map_of (effect_of op))) = pc_to_com (effect_of op)"
    using assms by(auto simp: imp_minus_state_to_sas_plus_def sas_plus_state_to_imp_minus_def
                   com_to_operators_variables_distinct)
  moreover have "snd (sas_plus_state_to_imp_minus
    (imp_minus_state_to_sas_plus (c, is) ++ map_of (effect_of op))) a = (is ++ ((\<lambda>x. (case x of
      EV y \<Rightarrow> Some y | _ \<Rightarrow> None)) \<circ>\<^sub>m (map_of (effect_of op)) \<circ>\<^sub>m (\<lambda>x. Some (VN x)))) a"
    for a using assms
    by(auto simp: imp_minus_state_to_sas_plus_def sas_plus_state_to_imp_minus_def
      option.case_eq_if map_comp_def map_add_def com_to_operators_variables_distinct
      split: domain_element.splits)
  moreover then have "snd (sas_plus_state_to_imp_minus
    (imp_minus_state_to_sas_plus (c, is) ++ map_of (effect_of op))) = (is
   ++ ((\<lambda>x. (case x of EV y \<Rightarrow> Some y | _ \<Rightarrow> None)) \<circ>\<^sub>m (map_of (effect_of op)) \<circ>\<^sub>m (\<lambda>x. Some (VN x))))"
    by auto
  ultimately show ?thesis using assms by (metis prod.collapse)
qed

lemma imp_minus_state_to_sas_plus_update_PC[simp]:
  "(imp_minus_state_to_sas_plus (c1, is1))(PC \<mapsto> PCV c2)
  = imp_minus_state_to_sas_plus (c2, is1)"
  by(auto simp: imp_minus_state_to_sas_plus_def option.case_eq_if)

lemma sas_plus_state_to_imp_minus_of_lambda_PC[simp]: "sas_plus_state_to_imp_minus
  (\<lambda>a. if a = PC then Some (PCV c1)
       else ss a)
  = (c1, snd (sas_plus_state_to_imp_minus ss))"
  by (auto simp: imp_minus_state_to_sas_plus_def sas_plus_state_to_imp_minus_def map_comp_def)

lemma sas_plus_state_to_imp_minus_of_PC_updated[simp]:
  "sas_plus_state_to_imp_minus (ss(PC \<mapsto> PCV c))
  = (c, snd (sas_plus_state_to_imp_minus ss))"
  by (auto simp: sas_plus_state_to_imp_minus_def map_comp_def)

lemma imp_minus_state_to_sas_plus_VN_eq_Some_Iff[simp]:
  "(imp_minus_state_to_sas_plus (c, s) (VN x) = Some y)
  \<longleftrightarrow> ((map_option EV (s x)) = Some y)"
  by (simp add: imp_minus_state_to_sas_plus_def map_comp_Some_iff)

lemma imp_minus_state_to_sas_plus_add_effect:
  assumes "op \<in> set (com_to_operators c)"
  shows "imp_minus_state_to_sas_plus (c1, is) ++ map_of (effect_of op)
      = imp_minus_state_to_sas_plus (pc_to_com (effect_of op), is) ++ map_of (effect_of op)"
  using assms com_to_operators_variables_distinct
  by(auto simp: map_add_def imp_minus_state_to_sas_plus_def fun_eq_iff split: option.splits)

lemma imp_minus_state_to_sas_plus_of_effect:
  assumes "op \<in> set (com_to_operators cB)"
  shows "((imp_minus_state_to_sas_plus (c1, s) ++ map_of (effect_of op))(PC \<mapsto> PCV c2) =
    imp_minus_state_to_sas_plus (c2, s')) \<longleftrightarrow> ((s ++ ((\<lambda>x. (case x of EV y \<Rightarrow> Some y | _ \<Rightarrow> None))
    \<circ>\<^sub>m map_of (effect_of op) \<circ>\<^sub>m (\<lambda>x. Some (VN x)))) = s')"
proof
  assume *: "(imp_minus_state_to_sas_plus (c1, s) ++ map_of (effect_of op))(PC \<mapsto> PCV c2)
    = imp_minus_state_to_sas_plus (c2, s')"
  have "\<forall>a. (s ++ ((\<lambda>x. (case x of EV y \<Rightarrow> Some y | _ \<Rightarrow> None))
    \<circ>\<^sub>m map_of (effect_of op) \<circ>\<^sub>m (\<lambda>x. Some (VN x)))) a = s' a"
  proof(rule ccontr)
    assume "\<not>(\<forall>a. (s ++ ((\<lambda>x. (case x of EV y \<Rightarrow> Some y | _ \<Rightarrow> None))
      \<circ>\<^sub>m map_of (effect_of op) \<circ>\<^sub>m (\<lambda>x. Some (VN x)))) a = s' a)"
    then obtain a where "(s ++ ((\<lambda>x. (case x of EV y \<Rightarrow> Some y | _ \<Rightarrow> None))
      \<circ>\<^sub>m map_of (effect_of op) \<circ>\<^sub>m (\<lambda>x. Some (VN x)))) a \<noteq> s' a" by auto
    then have "((imp_minus_state_to_sas_plus (c1, s) ++ map_of (effect_of op))(PC \<mapsto> PCV c2)) (VN a)
      \<noteq> imp_minus_state_to_sas_plus (c2, s') (VN a)"
      by(auto simp: imp_minus_state_to_sas_plus_def map_comp_def map_add_def domD domIff
            split: option.splits)
    then show "False" using * by auto
  qed
  then show "((s ++ ((\<lambda>x. (case x of EV y \<Rightarrow> Some y | _ \<Rightarrow> None))
    \<circ>\<^sub>m map_of (effect_of op) \<circ>\<^sub>m (\<lambda>x. Some (VN x)))) = s')" by auto
next
  assume *: "((s ++ ((\<lambda>x. (case x of EV y \<Rightarrow> Some y | _ \<Rightarrow> None))
    \<circ>\<^sub>m map_of (effect_of op) \<circ>\<^sub>m (\<lambda>x. Some (VN x)))) = s')"
  then have "((imp_minus_state_to_sas_plus (c1, s) ++ map_of (effect_of op))(PC \<mapsto> PCV c2)) a
      = imp_minus_state_to_sas_plus (c2, s') a" for a
    using assms by(cases a) (auto simp: com_to_operators_variables_distinct
        imp_minus_state_to_sas_plus_def map_comp_def map_add_def option.case_eq_if
        split: option.splits domain_element.splits)
  then show "(imp_minus_state_to_sas_plus (c1, s) ++ map_of (effect_of op))(PC \<mapsto> PCV c2)
    = imp_minus_state_to_sas_plus (c2, s')" by auto
qed

lemma imp_minus_state_to_sas_plus_of_effect':
  assumes "op \<in> set (com_to_operators cB)"
  shows "((imp_minus_state_to_sas_plus (c1, s) ++ map_of (effect_of op)) =
    imp_minus_state_to_sas_plus (c2, s')) \<longleftrightarrow> ((pc_to_com (effect_of op) = c2) \<and>
  (s ++ ((\<lambda>x. (case x of EV y \<Rightarrow> Some y | _ \<Rightarrow> None))
    \<circ>\<^sub>m map_of (effect_of op) \<circ>\<^sub>m (\<lambda>x. Some (VN x)))) = s')"
proof -
  have "imp_minus_state_to_sas_plus (c1, s) ++ map_of (effect_of op) =
    ((imp_minus_state_to_sas_plus (c1, s) ++ map_of (effect_of op))
    (PC \<mapsto> PCV (pc_to_com (effect_of op))))"
    using assms com_to_operators_variables_distinct by auto
  moreover have "((imp_minus_state_to_sas_plus (c1, s) ++ map_of (effect_of op))
  (PC \<mapsto> PCV (pc_to_com (effect_of op))) =
    imp_minus_state_to_sas_plus ((pc_to_com (effect_of op)), s'))
    \<longleftrightarrow> ((s ++ ((\<lambda>x. (case x of EV y \<Rightarrow> Some y | _ \<Rightarrow> None))
    \<circ>\<^sub>m map_of (effect_of op) \<circ>\<^sub>m (\<lambda>x. Some (VN x)))) = s')"
    using assms imp_minus_state_to_sas_plus_of_effect by blast
  ultimately show ?thesis using assms imp_minus_state_to_sas_plus_def map_upd_eqD1
    by (metis domain_element.inject fst_conv)
qed

lemma updated_state_is_sane:
  assumes "op \<in> set (com_to_operators c)"
    "sane_sas_plus_state ss1"
  shows "sane_sas_plus_state (ss1 \<then>\<^sub>+ op)"
proof -
  have "\<exists>x. (VN v, EV x) \<in> set (effect_of op) \<or> map_of (effect_of op) (VN v) = None" for v
    using assms variables_in_effect by simp
  then show ?thesis using assms
    apply(auto simp: sane_sas_plus_state_def com_to_operators_variables_distinct
        map_add_Some_iff)
    using in_set_effect by blast
qed

lemma imp_minus_state_to_sas_plus_update_VN[simp]: "(\<lambda>a. if a = PC then Some (PCV c2)
   else (imp_minus_state_to_sas_plus (c1, is1)(VN x \<mapsto> EV y)) a)
    = imp_minus_state_to_sas_plus (c2, is1(x \<mapsto> y))"
proof -
  have "(if a = PC then Some (PCV c2) else ((imp_minus_state_to_sas_plus (c1, is1)(VN x \<mapsto> EV y)) a))
    = (imp_minus_state_to_sas_plus (c2, is1(x \<mapsto> y))) a" for a
    by (auto simp: imp_minus_state_to_sas_plus_def map_comp_def split: variable.splits)
  then show ?thesis by auto
qed

lemma VN_PC_map_le_iff[simp]: "[VN v \<mapsto> y, PC \<mapsto> x] \<subseteq>\<^sub>m (imp_minus_state_to_sas_plus (c1, is))
  = (x = PCV c1 \<and> map_option EV (is v) = Some y)"
  by (auto simp: map_le_def imp_minus_state_to_sas_plus_def option.case_eq_if map_comp_def)

lemma operator_with_PC_updated_applicable_iff[simp]: "op \<in> set (com_to_operators c1) \<Longrightarrow>
  map_of (precondition_of op)(PC \<mapsto> PCV c2) \<subseteq>\<^sub>m imp_minus_state_to_sas_plus (c2, s)
  \<longleftrightarrow>  map_of (precondition_of op) \<subseteq>\<^sub>m imp_minus_state_to_sas_plus (c1, s)"
  by(auto simp: imp_minus_state_to_sas_plus_def map_le_def)

lemma applicable_in_imp_minus_then[simp]:
  "is_operator_applicable_in (imp_minus_state_to_sas_plus (c1, is))
  \<lparr>precondition_of = [(PC, x), (VN v, y)], effect_of = effect\<rparr>
  \<longleftrightarrow> (x = PCV c1 \<and> map_option EV (is v) = Some y)"
  by (auto simp: map_le_def imp_minus_state_to_sas_plus_def option.case_eq_if map_comp_def)

lemma PC_map_le_iff[simp]: "[PC \<mapsto> x] \<subseteq>\<^sub>m (imp_minus_state_to_sas_plus (c1, is))
  = (x = PCV c1)"
  by (auto simp: map_le_def imp_minus_state_to_sas_plus_def)

lemma map_of_list_update: "distinct (map fst l) \<Longrightarrow> length l > 0 \<Longrightarrow> fst (l ! 0) = x  \<Longrightarrow> z \<noteq> x
  \<Longrightarrow> map_of (list_update l 0 (x, y)) z = map_of l z"
  by (induction l) auto

lemma map_of_update_PC_in_effect_of_op[simp]: assumes "op \<in> set (com_to_operators c)"
  shows "map_of (list_update (effect_of op) 0 (PC, y)) = (map_of (effect_of op))(PC \<mapsto> y)"
proof -
  have "map_of (list_update (effect_of op) 0 (PC, y)) x = ((map_of (effect_of op))(PC \<mapsto> y)) x" for x
    using assms com_to_operators_variables_distinct effect_nonempty
      map_of_list_update[where ?l = "effect_of op"]
    by (auto)
      (metis effect_nonempty fst_of_effect map_of_eq_Some_iff set_update_memI update_preserve_distinct)
  then show ?thesis by auto
qed

lemma map_of_update_PC_in_precondition_of_op[simp]: assumes "op \<in> set (com_to_operators c)"
  shows "map_of (list_update (precondition_of op) 0 (PC, y)) = (map_of (precondition_of op))(PC \<mapsto> y)"
proof -
  have "map_of (list_update (precondition_of op) 0 (PC, y)) x = ((map_of (precondition_of op))(PC \<mapsto> y)) x" for x
    using assms com_to_operators_variables_distinct precondition_nonempty
      map_of_list_update[where ?l = "precondition_of op"]
    by (auto)
     (metis precondition_nonempty fst_of_precondition map_of_eq_Some_iff set_update_memI update_preserve_distinct)
  then show ?thesis by auto
qed

lemma pc_of_op:
  assumes "op \<in> set (com_to_operators c2)"
    "ss2 = imp_minus_state_to_sas_plus (c1, is)"
    "ss1 \<then>\<^sub>+ op = ss2"
  shows "pc_to_com (effect_of op) = c1"
proof -
  have "(ss1 \<then>\<^sub>+ op) PC = Some (PCV c1)" using assms by simp
  then show ?thesis using assms com_to_operators_variables_distinct by auto
qed

lemma effect_in_updated[simp]:
  assumes "op' \<in> set (com_to_operators c)"
    "map_of (precondition_of op') = (map_of (precondition_of op))(PC \<mapsto> PCV c)"
    "map_of (effect_of op') = (map_of (effect_of op))(PC \<mapsto> PCV (pc_to_com (effect_of op')))"
    "s \<then>\<^sub>+ op = s'"
  shows "s(PC \<mapsto> PCV c) \<then>\<^sub>+ op' = s'(PC \<mapsto> PCV (pc_to_com (effect_of op')))"
proof -
  have "(s(PC \<mapsto> PCV c)  \<then>\<^sub>+ op') x = (s'(PC \<mapsto> PCV (pc_to_com (effect_of op')))) x" for x
    using assms PC_in_effect_precondition com_to_operators_variables_distinct apply auto
    by (metis fun_upd_other map_add_def)
  then show ?thesis by auto
qed

lemma applicable_in_PC_updated: "m \<subseteq>\<^sub>m s(PC \<mapsto> y) \<Longrightarrow> s PC = Some x \<Longrightarrow> m(PC \<mapsto> x) \<subseteq>\<^sub>m s"
  by (simp add: map_le_def)

text \<open> We first show that every operation in SAS++ corresponds to a single step in IMP-- \<close>

lemma sas_plus_plus_to_imp_minus_minus_single_step:
  "op \<in> set (com_to_operators c1)
  \<Longrightarrow> c1 \<in> set (enumerate_subprograms c) \<Longrightarrow> t > 0
  \<Longrightarrow> is_operator_applicable_in (imp_minus_state_to_sas_plus (c1, is1)) op
  \<Longrightarrow> (c1, is1) \<rightarrow>
  sas_plus_state_to_imp_minus ((imp_minus_state_to_sas_plus (c1, is1)) \<then>\<^sub>+ op)"
proof (induction c1 arbitrary: op is1)
  case (Seq cA cB)
  have "cA = SKIP \<or> cA \<noteq> SKIP" by auto
  then show ?case using Seq
  proof (elim disjE)
    assume "cA \<noteq> SKIP"
    then obtain op' where op'_def: "op' \<in> set (com_to_operators cA)"
      "op = (let c1' = pc_to_com (effect_of op') in
      \<lparr> precondition_of = list_update (precondition_of op') 0 (PC, PCV (cA ;; cB)),
        effect_of = list_update (effect_of op') 0 (PC, PCV (c1' ;; cB))\<rparr>)" using Seq by auto
    let ?c1' = "pc_to_com (effect_of op')"
    let ?ss1' = "(imp_minus_state_to_sas_plus ((cA ;; cB), is1))(PC \<mapsto> PCV cA)"
    let ?ss2' = "((imp_minus_state_to_sas_plus ((cA ;; cB), is1)) \<then>\<^sub>+ op)(PC \<mapsto> PCV ?c1')"
    have "cA \<in> set (enumerate_subprograms c)"
      using \<open>cA;;cB \<in> set (enumerate_subprograms c)\<close> c_in_all_subprograms_c
      by (force intro!: enumerate_subprograms_transitive[where ?c2.0 = "cA;; cB"])
    then have "(cA, is1) \<rightarrow> sas_plus_state_to_imp_minus ?ss2'"
      using \<open>0 < t\<close> op'_def Seq  imp_minus_state_to_sas_plus_add_effect[where ?c1.0="cA;; cB"]
      imp_minus_state_to_sas_plus_add_effect[where ?c1.0="cA"]
      by(auto simp: com_to_operators_variables_distinct fun_upd_idem)
    then show ?thesis using op'_def by auto
  qed auto
qed(auto simp: Let_def map_leq_imp_minus_state_to_sas_plus_iff)

text \<open> Next, we show that a plan in SAS++ corresponds to executing several steps in IMP-- \<close>

lemma sas_plus_plus_to_imp_minus_minus_aux:
  "set ops \<subseteq> set ((imp_minus_minus_to_sas_plus c I G)\<^sub>\<O>\<^sub>+)
  \<Longrightarrow> sane_sas_plus_state ss1
  \<Longrightarrow> execute_serial_plan_sas_plus ss1 ops = ss2
  \<Longrightarrow> (\<exists>t'. t' \<le> length ops
    \<and> sas_plus_state_to_imp_minus ss1 \<rightarrow>\<^bsup>t'\<^esup> sas_plus_state_to_imp_minus ss2)"
proof (induction ops arbitrary: ss1)
  case (Cons op ops)
  let ?c1 = "fst (sas_plus_state_to_imp_minus ss1)"
  let ?is1 = "snd (sas_plus_state_to_imp_minus ss1)"
  let ?ss1' = "ss1 \<then>\<^sub>+ op"
  have "is_operator_applicable_in ss1 op \<or> \<not>(is_operator_applicable_in ss1 op)" by auto
  then show ?case using Cons
  proof (elim disjE)
    assume a: "is_operator_applicable_in ss1 op"
    then have op_in_cto_c1: "op \<in> set (com_to_operators ?c1)" using Cons by auto
    moreover then have "?c1 \<in> set (enumerate_subprograms c)" using Cons a
      apply(auto simp: imp_minus_minus_to_sas_plus_def Let_def coms_to_operators_def)
      by (metis PC_of_precondition domain_element.simps op_in_cto_c1)
    ultimately have c1_to_c1': "(?c1, ?is1) \<rightarrow> sas_plus_state_to_imp_minus
      (imp_minus_state_to_sas_plus (?c1, ?is1) \<then>\<^sub>+ op)"
      apply(rule sas_plus_plus_to_imp_minus_minus_single_step)
      using Cons a op_in_cto_c1 by auto
    moreover then have "execute_serial_plan_sas_plus ?ss1' ops = ss2"
      and "sane_sas_plus_state ?ss1'"
      using Cons a op_in_cto_c1 updated_state_is_sane by auto
    ultimately have "\<exists>t'. t' \<le> length ops \<and> sas_plus_state_to_imp_minus ?ss1'
      \<rightarrow>\<^bsup>t'\<^esup> sas_plus_state_to_imp_minus ss2"
      using Cons by(auto)
    moreover have "imp_minus_state_to_sas_plus (?c1, ?is1) \<then>\<^sub>+ op = ?ss1'" using Cons by auto
    ultimately show ?case using c1_to_c1' by auto
  qed auto
qed auto

lemma all_zero_than_zero_map_le: "\<forall>b\<in>set bs. s b = Some Zero
  \<Longrightarrow> map_of (map (\<lambda>v. (v, Zero)) (remdups bs)) \<subseteq>\<^sub>m s"
  apply(induction bs)
  by(auto simp: map_le_def)

text \<open> For the other direction, we again first show that a single step in IMP-- always
      corresponds to applying one operation in SAS++ \<close>

lemma imp_minus_minus_to_sas_plus_plus_single_step:
   "(c1, is1) \<rightarrow> (c2, is2)
  \<Longrightarrow> c1 \<in> set (enumerate_subprograms c)
  \<Longrightarrow> dom is1 = set (enumerate_variables c)
  \<Longrightarrow> (\<exists>op \<in> set (com_to_operators c1).
      execute_operator_sas_plus (imp_minus_state_to_sas_plus (c1, is1)) op
        =  imp_minus_state_to_sas_plus (c2, is2)
    \<and> is_operator_applicable_in (imp_minus_state_to_sas_plus (c1, is1)) op)"
proof (induction c1 is1 c2 is2 rule: small_step_induct)
  case (Assign x a s)
  thus ?case by auto
next
  case (Seq2 c\<^sub>1 s c\<^sub>1' s' c\<^sub>2)
  have "c\<^sub>1 \<in> set (enumerate_subprograms (c\<^sub>1 ;; c\<^sub>2))" using c_in_all_subprograms_c by auto
  then have "c\<^sub>1 \<in> set (enumerate_subprograms c)" using Seq2 enumerate_subprograms_transitive by blast
  then obtain op' where op'_def: "op' \<in> set (com_to_operators c\<^sub>1) \<and>
    execute_operator_sas_plus (imp_minus_state_to_sas_plus (c\<^sub>1, s)) op'
        =  imp_minus_state_to_sas_plus (c\<^sub>1', s')
    \<and> is_operator_applicable_in (imp_minus_state_to_sas_plus (c\<^sub>1, s)) op'"
    using Seq2 by fastforce
  let ?op = "\<lparr> precondition_of = list_update (precondition_of op') 0 (PC, PCV (c\<^sub>1 ;; c\<^sub>2)),
        effect_of = list_update (effect_of op') 0 (PC, PCV (c\<^sub>1' ;; c\<^sub>2))\<rparr>"
  have "?op \<in> set (com_to_operators (c\<^sub>1 ;; c\<^sub>2))"
    and "execute_operator_sas_plus (imp_minus_state_to_sas_plus ((c\<^sub>1 ;; c\<^sub>2), s)) ?op
        = imp_minus_state_to_sas_plus ((c\<^sub>1' ;; c\<^sub>2), s')"
    and "is_operator_applicable_in (imp_minus_state_to_sas_plus ((c\<^sub>1 ;; c\<^sub>2), s)) ?op"
    using Seq2 op'_def imp_minus_state_to_sas_plus_of_effect imp_minus_state_to_sas_plus_of_effect'
    by auto
  then show ?case using Seq2 by blast
next
  case (IfTrue bs s c\<^sub>1 c\<^sub>2)
  have "set bs \<subseteq> set (enumerate_variables c)"
    using IfTrue enumerate_subprograms_enumerate_variables by fastforce
  hence "\<forall>b \<in> set bs. \<exists>y. s b = Some y" using \<open>dom s = set (enumerate_variables c)\<close> by auto
  then show ?case using IfTrue by (auto simp: Let_def)
next
  case (IfFalse bs s c\<^sub>1 c\<^sub>2)
  hence "set bs \<subseteq> set (enumerate_variables c)"
    using enumerate_subprograms_enumerate_variables by fastforce
  thus ?case using IfFalse
    by(auto simp: Let_def map_leq_imp_minus_state_to_sas_plus_iff all_zero_than_zero_map_le)
next
  case (WhileTrue bs s c1)
  hence "set bs \<subseteq> set (enumerate_variables c)"
    using  enumerate_subprograms_enumerate_variables by fastforce
  then show ?case using WhileTrue
    by(force simp: Let_def map_leq_imp_minus_state_to_sas_plus_iff all_zero_than_zero_map_le)
next
  case (WhileFalse bs s c1)
   hence "set bs \<subseteq> set (enumerate_variables c)"
    using  enumerate_subprograms_enumerate_variables by fastforce
  then show ?case using WhileFalse
    by(force simp: Let_def map_leq_imp_minus_state_to_sas_plus_iff all_zero_than_zero_map_le)
qed auto

text \<open> Next, we show that taking multiple steps in IMP-- corresponds to executing multiple
      operations in SAS++ \<close>

lemma imp_minus_minus_to_sas_plus_plus_aux:
   "(c1, is1) \<rightarrow>\<^bsup>t\<^esup> (c2, is2)
  \<Longrightarrow> c1 \<in> set (enumerate_subprograms c)
  \<Longrightarrow> dom is1 = set (enumerate_variables c)
  \<Longrightarrow> (\<exists>ops. set ops \<subseteq> set ((imp_minus_minus_to_sas_plus c I G)\<^sub>\<O>\<^sub>+)
     \<and> length ops = t
     \<and> (execute_serial_plan_sas_plus (imp_minus_state_to_sas_plus (c1, is1)) ops)
        = imp_minus_state_to_sas_plus (c2, is2))"
proof (induction t arbitrary: c1 is1)
  case (Suc t)
  obtain c1' is1' where c1'_def: "(c1, is1) \<rightarrow> (c1', is1')
    \<and> (c1', is1') \<rightarrow>\<^bsup>t\<^esup> (c2, is2)" using Suc by auto
  then obtain op where op_def: "op \<in> set (com_to_operators c1)
    \<and> execute_operator_sas_plus (imp_minus_state_to_sas_plus (c1, is1)) op
        =  imp_minus_state_to_sas_plus (c1', is1')
    \<and> is_operator_applicable_in (imp_minus_state_to_sas_plus (c1, is1)) op"
    using imp_minus_minus_to_sas_plus_plus_single_step Suc by metis
  then have "dom is1' = set (enumerate_variables c)"
    using c1'_def Suc step_doesnt_add_variables
     apply (auto simp: domIff)
    by (metis domD domIff option.simps(3) step_doesnt_add_variables)+
  moreover have "c1' \<in> set (enumerate_subprograms c)" using c1'_def enumerate_subprograms_transitive
    enumerate_subprograms_complete_step
    using Suc.prems by blast+
  ultimately obtain ops where ops_def: "set ops \<subseteq> set ((imp_minus_minus_to_sas_plus c I G)\<^sub>\<O>\<^sub>+)
     \<and> length ops = t
     \<and> (execute_serial_plan_sas_plus (imp_minus_state_to_sas_plus (c1', is1')) ops)
        = imp_minus_state_to_sas_plus (c2, is2)"
    using Suc c1'_def Suc_lessD by blast
  let ?ops' = "op # ops"
  have "set ?ops' \<subseteq> set ((imp_minus_minus_to_sas_plus c I G)\<^sub>\<O>\<^sub>+)
     \<and> length ?ops' = Suc t
     \<and> (execute_serial_plan_sas_plus (imp_minus_state_to_sas_plus (c1, is1)) ?ops')
        = imp_minus_state_to_sas_plus (c2, is2)"
    using Suc c1'_def op_def ops_def
    by (auto simp: imp_minus_minus_to_sas_plus_def Let_def coms_to_operators_def)
  then show ?case by blast
qed auto

text \<open> In the previous correctness lemmas, we formulated the statements as to permit arbitrary
       initial and final states that could occur sometime during the execution. We now proceed
       to reformulate them in simpler terms, using the initial initial and final states as specified
       in the SAS++ problem translated from IMP--. \<close>

lemma imp_minus_minus_to_sas_plus_plus:
  assumes "(c, is1) \<rightarrow>\<^bsup>t\<^esup> (SKIP, is2)"
   "dom is1 = set (enumerate_variables c)"
   "I \<subseteq>\<^sub>m is1"
   "G \<subseteq>\<^sub>m is2"
   "t \<le> t'"
  shows "(\<exists>plan.
     is_serial_solution_for_problem_sas_plus_plus (imp_minus_minus_to_sas_plus c I G) plan
     \<and> length plan \<le> t')"
proof -
  let ?\<Psi> = "imp_minus_minus_to_sas_plus c I G"
  let ?I' = "imp_minus_state_to_sas_plus (c, is1)"
  obtain plan where plan_def: "set plan \<subseteq> set ((?\<Psi>)\<^sub>\<O>\<^sub>+)
     \<and> length plan = t
     \<and> (execute_serial_plan_sas_plus ?I' plan)
        = imp_minus_state_to_sas_plus (SKIP, is2)"
    using imp_minus_minus_to_sas_plus_plus_aux[OF assms(1)] assms c_in_all_subprograms_c by blast
  moreover then have "(?\<Psi>)\<^sub>G\<^sub>+ \<subseteq>\<^sub>m execute_serial_plan_sas_plus ?I' plan"
    and "dom ?I' = set (((?\<Psi>))\<^sub>\<V>\<^sub>+)"
    and "(\<forall> v \<in> set ((?\<Psi>)\<^sub>\<V>\<^sub>+). the (?I' v) \<in> range_of' ?\<Psi> v)"
    and "((?\<Psi>)\<^sub>I\<^sub>+) \<subseteq>\<^sub>m ?I'"
    using assms plan_def c_in_all_subprograms_c
    apply(auto simp: imp_minus_minus_to_sas_plus_def Let_def
        range_of'_def imp_minus_state_to_sas_plus_def map_comp_def map_le_def)
        apply (auto split: option.splits variable.splits)
    by (metis domIff option.distinct option.inject)+
  ultimately have "is_serial_solution_for_problem_sas_plus_plus ?\<Psi> plan"
    using assms
    by(auto simp: is_serial_solution_for_problem_sas_plus_plus_def Let_def list_all_def ListMem_iff)
  then show ?thesis using plan_def \<open>t \<le> t'\<close>
    by blast
qed

lemma sas_plus_plus_to_imp_minus_minus:
  assumes "is_serial_solution_for_problem_sas_plus_plus (imp_minus_minus_to_sas_plus c I G) plan"
    "EV ` (ran I) \<subseteq> set domain"
    "EV ` (ran G) \<subseteq> set domain"
  shows "\<exists>is1 is2 t. (I|` set (enumerate_variables c)) \<subseteq>\<^sub>m is1 \<and> dom is1 = set (enumerate_variables c)
    \<and> (G|` set (enumerate_variables c)) \<subseteq>\<^sub>m is2 \<and> t \<le> length plan
    \<and> (c, is1) \<rightarrow>\<^bsup>t\<^esup> (SKIP, is2)"
proof -
  let ?\<Psi> = "imp_minus_minus_to_sas_plus c I G"
  obtain I' where I'_def: "((?\<Psi>)\<^sub>I\<^sub>+) \<subseteq>\<^sub>m I' \<and> dom I' = set ((?\<Psi>)\<^sub>\<V>\<^sub>+)
        \<and> (\<forall>v \<in> set ((?\<Psi>)\<^sub>\<V>\<^sub>+). the (I' v) \<in> range_of' ?\<Psi> v)
        \<and> ((?\<Psi>)\<^sub>G\<^sub>+) \<subseteq>\<^sub>m execute_serial_plan_sas_plus I' plan"
    using assms by (auto simp: is_serial_solution_for_problem_sas_plus_plus_def Let_def)
  let ?ss2 = "execute_serial_plan_sas_plus I' plan"
  let ?is1 = "snd (sas_plus_state_to_imp_minus I')"
  let ?is2 = "snd (sas_plus_state_to_imp_minus ?ss2)"
  have "\<forall>v\<in>set (enumerate_variables c). (\<exists>y \<in> set domain. I' (VN v) = Some y)" using I'_def
    apply (auto simp: imp_minus_minus_to_sas_plus_def Let_def range_of'_def)
    by (metis domIff image_insert insertI1 insertI2 mk_disjoint_insert option.collapse)
  then have "sane_sas_plus_state I'" using I'_def assms
    apply (auto simp: sane_sas_plus_state_def imp_minus_minus_to_sas_plus_def Let_def map_le_def
         range_of'_def)
    by (metis domIff insertI1 option.collapse)
  then obtain t where t_def: "t \<le> length plan \<and> sas_plus_state_to_imp_minus I'
    \<rightarrow>\<^bsup>t\<^esup> sas_plus_state_to_imp_minus ?ss2"
    apply - apply(rule exE[OF sas_plus_plus_to_imp_minus_minus_aux[where ?ops=plan]])
    using assms I'_def
    by(auto simp: is_serial_solution_for_problem_sas_plus_plus_def Let_def list_all_def ListMem_iff)

  moreover have "fst (sas_plus_state_to_imp_minus I') = c"
    and "fst (sas_plus_state_to_imp_minus ?ss2) = SKIP"
    using assms I'_def apply(auto simp: imp_minus_minus_to_sas_plus_def Let_def
         sas_plus_state_to_imp_minus_def map_le_def imp_minus_state_to_sas_plus_def
        sane_sas_plus_state_def)
    by (metis (no_types, lifting) domain_element.inject domain_element.simps option.sel
        option.inject variable.simps)+
  ultimately have "((c, ?is1) \<rightarrow>\<^bsup>t\<^esup> (SKIP, ?is2))"
    using I'_def by (metis prod.collapse)
  moreover have "(I|` set (enumerate_variables c)) \<subseteq>\<^sub>m ?is1"
    "(G|` set (enumerate_variables c)) \<subseteq>\<^sub>m ?is2"
    using assms(2) I'_def
    by (auto simp: imp_minus_minus_to_sas_plus_def imp_minus_state_to_sas_plus_map_le_then Let_def
        range_of'_def)
  moreover have "dom ?is1 = set (enumerate_variables c)"
    using \<open>sane_sas_plus_state I'\<close> I'_def by(auto simp: imp_minus_minus_to_sas_plus_def
        dom_snd_sas_plus_state_to_imp_minus Let_def)
  ultimately show ?thesis using I'_def t_def by auto
qed

end


section \<open>Set by Characteristic Function\<close>
theory Impl_Cfun_Set
imports "../Intf/Intf_Set"
begin

definition fun_set_rel where
  fun_set_rel_internal_def:
  "fun_set_rel R \<equiv> (R\<rightarrow>bool_rel) O br Collect (\<lambda>_. True)"

lemma fun_set_rel_def: "\<langle>R\<rangle>fun_set_rel = (R\<rightarrow>bool_rel) O br Collect (\<lambda>_. True)"
  by (simp add: relAPP_def fun_set_rel_internal_def)

lemma fun_set_rel_sv[relator_props]:
  "\<lbrakk>single_valued R; Range R = UNIV\<rbrakk> \<Longrightarrow> single_valued (\<langle>R\<rangle>fun_set_rel)"
  unfolding fun_set_rel_def
  by (tagged_solver (keep))

lemma fun_set_rel_RUNIV[relator_props]:
  assumes SV: "single_valued R"
  shows "Range (\<langle>R\<rangle>fun_set_rel) = UNIV"
proof -
  {
    fix b
    have "\<exists>a. (a,b)\<in>\<langle>R\<rangle>fun_set_rel" unfolding fun_set_rel_def
      apply (rule exI)
      apply (rule relcompI)
    proof -
      show "((\<lambda>x. x\<in>b),b)\<in>br Collect (\<lambda>_. True)" by (auto simp: br_def)
      show "(\<lambda>x'. \<exists>x. (x',x)\<in>R \<and> x\<in>b,\<lambda>x. x \<in> b)\<in>R \<rightarrow> bool_rel"
        by (auto dest: single_valuedD[OF SV])
    qed
  } thus ?thesis by blast
qed

lemmas [autoref_rel_intf] = REL_INTFI[of fun_set_rel i_set]

lemma fs_mem_refine[autoref_rules]: "(\<lambda>x f. f x,(\<in>)) \<in> R \<rightarrow> \<langle>R\<rangle>fun_set_rel \<rightarrow> bool_rel"
  apply (intro fun_relI)
  apply (auto simp add: fun_set_rel_def br_def dest: fun_relD)
  done

lemma fun_set_Collect_refine[autoref_rules]:
  "(\<lambda>x. x, Collect)\<in>(R\<rightarrow>bool_rel) \<rightarrow> \<langle>R\<rangle>fun_set_rel"
  unfolding fun_set_rel_def
  by (auto simp: br_def)

lemma fun_set_empty_refine[autoref_rules]:
  "(\<lambda>_. False,{})\<in>\<langle>R\<rangle>fun_set_rel"
  by (force simp add: fun_set_rel_def br_def)

lemma fun_set_UNIV_refine[autoref_rules]:
  "(\<lambda>_. True,UNIV)\<in>\<langle>R\<rangle>fun_set_rel"
  by (force simp add: fun_set_rel_def br_def)

lemma fun_set_union_refine[autoref_rules]:
  "(\<lambda>a b x. a x \<or> b x,(\<union>))\<in>\<langle>R\<rangle>fun_set_rel \<rightarrow> \<langle>R\<rangle>fun_set_rel \<rightarrow> \<langle>R\<rangle>fun_set_rel"
proof -
  have A: "\<And>a b. (\<lambda>x. x\<in>a \<or> x\<in>b, a \<union> b) \<in> br Collect (\<lambda>_. True)"
    by (auto simp: br_def)

  show ?thesis
    apply (simp add: fun_set_rel_def)
    apply (intro fun_relI)
    apply clarsimp
    apply rule
    defer
    apply (rule A)
    apply (auto simp: br_def dest: fun_relD)
    done
qed

lemma fun_set_inter_refine[autoref_rules]:
  "(\<lambda>a b x. a x \<and> b x,(\<inter>))\<in>\<langle>R\<rangle>fun_set_rel \<rightarrow> \<langle>R\<rangle>fun_set_rel \<rightarrow> \<langle>R\<rangle>fun_set_rel"
proof -
  have A: "\<And>a b. (\<lambda>x. x\<in>a \<and> x\<in>b, a \<inter> b) \<in> br Collect (\<lambda>_. True)"
    by (auto simp: br_def)

  show ?thesis
    apply (simp add: fun_set_rel_def)
    apply (intro fun_relI)
    apply clarsimp
    apply rule
    defer
    apply (rule A)
    apply (auto simp: br_def dest: fun_relD)
    done
qed

lemma fun_set_diff_refine[autoref_rules]:
  "(\<lambda>a b x. a x \<and> \<not>b x,(-))\<in>\<langle>R\<rangle>fun_set_rel \<rightarrow> \<langle>R\<rangle>fun_set_rel \<rightarrow> \<langle>R\<rangle>fun_set_rel"
proof -
  have A: "\<And>a b. (\<lambda>x. x\<in>a \<and> \<not>x\<in>b, a - b) \<in> br Collect (\<lambda>_. True)"
    by (auto simp: br_def)

  show ?thesis
    apply (simp add: fun_set_rel_def)
    apply (intro fun_relI)
    apply clarsimp
    apply rule
    defer
    apply (rule A)
    apply (auto simp: br_def dest: fun_relD)
    done
qed

end


(*  Title:      HOL/MicroJava/BV/Correct.thy

    Author:     Cornelia Pusch, Gerwin Klein
    Copyright   1999 Technische Universitaet Muenchen

The invariant for the type safety proof.
*)

header {* \isaheader{BV Type Safety Invariant} *}

theory BVConform
imports BVSpec "../JVM/JVMExec" "../Common/Conform"
begin

definition confT :: "'c prog \<Rightarrow> heap \<Rightarrow> val \<Rightarrow> ty err \<Rightarrow> bool"
           ("_,_ |- _ :<=T _" [51,51,51,51] 50)
where
  "P,h |- v :<=T E \<equiv> case E of Err \<Rightarrow> True | OK T \<Rightarrow> P,h \<turnstile> v :\<le> T"

notation (xsymbols)
  confT  ("_,_ \<turnstile> _ :\<le>\<^sub>\<top> _" [51,51,51,51] 50)

abbreviation
  confTs :: "'c prog \<Rightarrow> heap \<Rightarrow> val list \<Rightarrow> ty\<^sub>l \<Rightarrow> bool"
            ("_,_ |- _ [:<=T] _" [51,51,51,51] 50) where
  "P,h |- vs [:<=T] Ts \<equiv> list_all2 (confT P h) vs Ts"

notation (xsymbols)
  confTs  ("_,_ \<turnstile> _ [:\<le>\<^sub>\<top>] _" [51,51,51,51] 50)

definition conf_f  :: "jvm_prog \<Rightarrow> heap \<Rightarrow> ty\<^sub>i \<Rightarrow> bytecode \<Rightarrow> frame \<Rightarrow> bool"
where
  "conf_f P h \<equiv> \<lambda>(ST,LT) is (stk,loc,C,M,pc).
  P,h \<turnstile> stk [:\<le>] ST \<and> P,h \<turnstile> loc [:\<le>\<^sub>\<top>] LT \<and> pc < size is"

lemma conf_f_def2:
  "conf_f P h (ST,LT) is (stk,loc,C,M,pc) \<equiv>
  P,h \<turnstile> stk [:\<le>] ST \<and> P,h \<turnstile> loc [:\<le>\<^sub>\<top>] LT \<and> pc < size is"
  by (simp add: conf_f_def)

primrec conf_fs :: "[jvm_prog,heap,ty\<^sub>P,mname,nat,ty,frame list] \<Rightarrow> bool"
where
  "conf_fs P h \<Phi> M\<^sub>0 n\<^sub>0 T\<^sub>0 [] = True"
| "conf_fs P h \<Phi> M\<^sub>0 n\<^sub>0 T\<^sub>0 (f#frs) =
  (let (stk,loc,C,M,pc) = f in
  (\<exists>ST LT Ts T mxs mxl\<^sub>0 is xt.
    \<Phi> C M ! pc = Some (ST,LT) \<and>
    (P \<turnstile> C sees M:Ts \<rightarrow> T = (mxs,mxl\<^sub>0,is,xt) in C) \<and>
    (\<exists>D Ts' T' m D'.
       is!pc = (Invoke M\<^sub>0 n\<^sub>0) \<and> ST!n\<^sub>0 = Class D \<and>
       P \<turnstile> D sees M\<^sub>0:Ts' \<rightarrow> T' = m in D' \<and> P \<turnstile> T\<^sub>0 \<le> T') \<and>
    conf_f P h (ST, LT) is f \<and> conf_fs P h \<Phi> M (size Ts) T frs))"

definition correct_state :: "[jvm_prog,ty\<^sub>P,jvm_state] \<Rightarrow> bool"
                  ("_,_ |- _ [ok]"  [61,0,0] 61)
where
  "correct_state P \<Phi> \<equiv> \<lambda>(xp,h,frs).
  case xp of
     None \<Rightarrow> (case frs of
             [] \<Rightarrow> True
             | (f#fs) \<Rightarrow> P\<turnstile> h\<surd> \<and>
             (let (stk,loc,C,M,pc) = f
              in \<exists>Ts T mxs mxl\<^sub>0 is xt \<tau>.
                    (P \<turnstile> C sees M:Ts\<rightarrow>T = (mxs,mxl\<^sub>0,is,xt) in C) \<and>
                    \<Phi> C M ! pc = Some \<tau> \<and>
                    conf_f P h \<tau> is f \<and> conf_fs P h \<Phi> M (size Ts) T fs))
  | Some x \<Rightarrow> frs = []"

notation (xsymbols)
 correct_state  ("_,_ \<turnstile> _ \<surd>"  [61,0,0] 61)

section {* Values and @{text "\<top>"} *}

lemma confT_Err [iff]: "P,h \<turnstile> x :\<le>\<^sub>\<top> Err"
  by (simp add: confT_def)

lemma confT_OK [iff]:  "P,h \<turnstile> x :\<le>\<^sub>\<top> OK T = (P,h \<turnstile> x :\<le> T)"
  by (simp add: confT_def)

lemma confT_cases:
  "P,h \<turnstile> x :\<le>\<^sub>\<top> X = (X = Err \<or> (\<exists>T. X = OK T \<and> P,h \<turnstile> x :\<le> T))"
  by (cases X) auto

lemma confT_hext [intro?, trans]:
  "\<lbrakk> P,h \<turnstile> x :\<le>\<^sub>\<top> T; h \<unlhd> h' \<rbrakk> \<Longrightarrow> P,h' \<turnstile> x :\<le>\<^sub>\<top> T"
  by (cases T) (blast intro: conf_hext)+

lemma confT_widen [intro?, trans]:
  "\<lbrakk> P,h \<turnstile> x :\<le>\<^sub>\<top> T; P \<turnstile> T \<le>\<^sub>\<top> T' \<rbrakk> \<Longrightarrow> P,h \<turnstile> x :\<le>\<^sub>\<top> T'"
  by (cases T', auto intro: conf_widen)

section {* Stack and Registers *}

lemmas confTs_Cons1 [iff] = list_all2_Cons1 [of "confT P h"] for P h

lemma confTs_confT_sup:
  "\<lbrakk> P,h \<turnstile> loc [:\<le>\<^sub>\<top>] LT; n < size LT; LT!n = OK T; P \<turnstile> T \<le> T' \<rbrakk>
  \<Longrightarrow> P,h \<turnstile> (loc!n) :\<le> T'"
(*<*)
  apply (frule list_all2_lengthD)
  apply (drule list_all2_nthD, simp)
  apply simp
  apply (erule conf_widen, assumption+)
  done
(*>*)

lemma confTs_hext [intro?]:
  "P,h \<turnstile> loc [:\<le>\<^sub>\<top>] LT \<Longrightarrow> h \<unlhd> h' \<Longrightarrow> P,h' \<turnstile> loc [:\<le>\<^sub>\<top>] LT"
  by (fast elim: list_all2_mono confT_hext)

lemma confTs_widen [intro?, trans]:
  "P,h \<turnstile> loc [:\<le>\<^sub>\<top>] LT \<Longrightarrow> P \<turnstile> LT [\<le>\<^sub>\<top>] LT' \<Longrightarrow> P,h \<turnstile> loc [:\<le>\<^sub>\<top>] LT'"
  by (rule list_all2_trans, rule confT_widen)

lemma confTs_map [iff]:
  "\<And>vs. (P,h \<turnstile> vs [:\<le>\<^sub>\<top>] map OK Ts) = (P,h \<turnstile> vs [:\<le>] Ts)"
  by (induct Ts) (auto simp add: list_all2_Cons2)

lemma reg_widen_Err [iff]:
  "\<And>LT. (P \<turnstile> replicate n Err [\<le>\<^sub>\<top>] LT) = (LT = replicate n Err)"
  by (induct n) (auto simp add: list_all2_Cons1)

section {* correct-frames *}

lemmas [simp del] = fun_upd_apply

lemma conf_fs_hext:
  "\<And>M n T\<^sub>r.
  \<lbrakk> conf_fs P h \<Phi> M n T\<^sub>r frs; h \<unlhd> h' \<rbrakk> \<Longrightarrow> conf_fs P h' \<Phi> M n T\<^sub>r frs"
(*<*)
apply (induct frs)
 apply simp
apply clarify
apply (simp (no_asm_use))
apply clarify
apply (unfold conf_f_def)
apply (simp (no_asm_use))
apply clarify
apply (fast elim!: confs_hext confTs_hext)
done
(*>*)

end


(*  Title:      HOL/Auth/Guard/Guard.thy
    Author:     Frederic Blanqui, University of Cambridge Computer Laboratory
    Copyright   2002  University of Cambridge
*)

section\<open>Protocol-Independent Confidentiality Theorem on Nonces\<close>

theory Guard imports Analz Extensions begin

(******************************************************************************
messages where all the occurrences of Nonce n are
in a sub-message of the form Crypt (invKey K) X with K:Ks
******************************************************************************)

inductive_set
  guard :: "nat => key set => msg set"
  for n :: nat and Ks :: "key set"
where
  No_Nonce [intro]: "Nonce n ~:parts {X} ==> X:guard n Ks"
| Guard_Nonce [intro]: "invKey K:Ks ==> Crypt K X:guard n Ks"
| Crypt [intro]: "X:guard n Ks ==> Crypt K X:guard n Ks"
| Pair [intro]: "[| X:guard n Ks; Y:guard n Ks |] ==> \<lbrace>X,Y\<rbrace> \<in> guard n Ks"

subsection\<open>basic facts about @{term guard}\<close>

lemma Key_is_guard [iff]: "Key K:guard n Ks"
by auto

lemma Agent_is_guard [iff]: "Agent A:guard n Ks"
by auto

lemma Number_is_guard [iff]: "Number r:guard n Ks"
by auto

lemma Nonce_notin_guard: "X:guard n Ks ==> X ~= Nonce n"
by (erule guard.induct, auto)

lemma Nonce_notin_guard_iff [iff]: "Nonce n ~:guard n Ks"
by (auto dest: Nonce_notin_guard)

lemma guard_has_Crypt [rule_format]: "X:guard n Ks ==> Nonce n:parts {X}
--> (EX K Y. Crypt K Y:kparts {X} & Nonce n:parts {Y})"
by (erule guard.induct, auto)

lemma Nonce_notin_kparts_msg: "X:guard n Ks ==> Nonce n ~:kparts {X}"
by (erule guard.induct, auto)

lemma Nonce_in_kparts_imp_no_guard: "Nonce n:kparts H
==> EX X. X:H & X ~:guard n Ks"
apply (drule in_kparts, clarify)
apply (rule_tac x=X in exI, clarify)
by (auto dest: Nonce_notin_kparts_msg)

lemma guard_kparts [rule_format]: "X:guard n Ks ==>
Y:kparts {X} --> Y:guard n Ks"
by (erule guard.induct, auto)

lemma guard_Crypt: "[| Crypt K Y:guard n Ks; K ~:invKey`Ks |] ==> Y:guard n Ks"
  by (ind_cases "Crypt K Y:guard n Ks") (auto intro!: image_eqI)

lemma guard_MPair [iff]: "(\<lbrace>X,Y\<rbrace> \<in> guard n Ks) = (X \<in> guard n Ks \<and> Y \<in> guard n Ks)"
by (auto, (ind_cases "\<lbrace>X,Y\<rbrace> \<in> guard n Ks", auto)+)

lemma guard_not_guard [rule_format]: "X:guard n Ks ==>
Crypt K Y:kparts {X} --> Nonce n:kparts {Y} --> Y ~:guard n Ks"
by (erule guard.induct, auto dest: guard_kparts)

lemma guard_extand: "[| X:guard n Ks; Ks <= Ks' |] ==> X:guard n Ks'"
by (erule guard.induct, auto)

subsection\<open>guarded sets\<close>

definition Guard :: "nat => key set => msg set => bool" where
"Guard n Ks H == ALL X. X:H --> X:guard n Ks"

subsection\<open>basic facts about @{term Guard}\<close>

lemma Guard_empty [iff]: "Guard n Ks {}"
by (simp add: Guard_def)

lemma notin_parts_Guard [intro]: "Nonce n ~:parts G ==> Guard n Ks G"
apply (unfold Guard_def, clarify)
apply (subgoal_tac "Nonce n ~:parts {X}")
by (auto dest: parts_sub)

lemma Nonce_notin_kparts [simplified]: "Guard n Ks H ==> Nonce n ~:kparts H"
by (auto simp: Guard_def dest: in_kparts Nonce_notin_kparts_msg)

lemma Guard_must_decrypt: "[| Guard n Ks H; Nonce n:analz H |] ==>
EX K Y. Crypt K Y:kparts H & Key (invKey K):kparts H"
apply (drule_tac P="%G. Nonce n:G" in analz_pparts_kparts_substD, simp)
by (drule must_decrypt, auto dest: Nonce_notin_kparts)

lemma Guard_kparts [intro]: "Guard n Ks H ==> Guard n Ks (kparts H)"
by (auto simp: Guard_def dest: in_kparts guard_kparts)

lemma Guard_mono: "[| Guard n Ks H; G <= H |] ==> Guard n Ks G"
by (auto simp: Guard_def)

lemma Guard_insert [iff]: "Guard n Ks (insert X H)
= (Guard n Ks H & X:guard n Ks)"
by (auto simp: Guard_def)

lemma Guard_Un [iff]: "Guard n Ks (G Un H) = (Guard n Ks G & Guard n Ks H)"
by (auto simp: Guard_def)

lemma Guard_synth [intro]: "Guard n Ks G ==> Guard n Ks (synth G)"
by (auto simp: Guard_def, erule synth.induct, auto)

lemma Guard_analz [intro]: "[| Guard n Ks G; ALL K. K:Ks --> Key K ~:analz G |]
==> Guard n Ks (analz G)"
apply (auto simp: Guard_def)
apply (erule analz.induct, auto)
by (ind_cases "Crypt K Xa:guard n Ks" for K Xa, auto)

lemma in_Guard [dest]: "[| X:G; Guard n Ks G |] ==> X:guard n Ks"
by (auto simp: Guard_def)

lemma in_synth_Guard: "[| X:synth G; Guard n Ks G |] ==> X:guard n Ks"
by (drule Guard_synth, auto)

lemma in_analz_Guard: "[| X:analz G; Guard n Ks G;
ALL K. K:Ks --> Key K ~:analz G |] ==> X:guard n Ks"
by (drule Guard_analz, auto)

lemma Guard_keyset [simp]: "keyset G ==> Guard n Ks G"
by (auto simp: Guard_def)

lemma Guard_Un_keyset: "[| Guard n Ks G; keyset H |] ==> Guard n Ks (G Un H)"
by auto

lemma in_Guard_kparts: "[| X:G; Guard n Ks G; Y:kparts {X} |] ==> Y:guard n Ks"
by blast

lemma in_Guard_kparts_neq: "[| X:G; Guard n Ks G; Nonce n':kparts {X} |]
==> n ~= n'"
by (blast dest: in_Guard_kparts)

lemma in_Guard_kparts_Crypt: "[| X:G; Guard n Ks G; is_MPair X;
Crypt K Y:kparts {X}; Nonce n:kparts {Y} |] ==> invKey K:Ks"
apply (drule in_Guard, simp)
apply (frule guard_not_guard, simp+)
apply (drule guard_kparts, simp)
by (ind_cases "Crypt K Y:guard n Ks", auto)

lemma Guard_extand: "[| Guard n Ks G; Ks <= Ks' |] ==> Guard n Ks' G"
by (auto simp: Guard_def dest: guard_extand)

lemma guard_invKey [rule_format]: "[| X:guard n Ks; Nonce n:kparts {Y} |] ==>
Crypt K Y:kparts {X} --> invKey K:Ks"
by (erule guard.induct, auto)

lemma Crypt_guard_invKey [rule_format]: "[| Crypt K Y:guard n Ks;
Nonce n:kparts {Y} |] ==> invKey K:Ks"
by (auto dest: guard_invKey)

subsection\<open>set obtained by decrypting a message\<close>

abbreviation (input)
  decrypt :: "msg set => key => msg => msg set" where
  "decrypt H K Y == insert Y (H - {Crypt K Y})"

lemma analz_decrypt: "[| Crypt K Y:H; Key (invKey K):H; Nonce n:analz H |]
==> Nonce n:analz (decrypt H K Y)"
apply (drule_tac P="%H. Nonce n:analz H" in ssubst [OF insert_Diff])
apply assumption
apply (simp only: analz_Crypt_if, simp)
done

lemma parts_decrypt: "[| Crypt K Y:H; X:parts (decrypt H K Y) |] ==> X:parts H"
by (erule parts.induct, auto intro: parts.Fst parts.Snd parts.Body)

subsection\<open>number of Crypt's in a message\<close>

fun crypt_nb :: "msg => nat"
where
  "crypt_nb (Crypt K X) = Suc (crypt_nb X)"
| "crypt_nb \<lbrace>X,Y\<rbrace> = crypt_nb X + crypt_nb Y"
| "crypt_nb X = 0" (* otherwise *)

subsection\<open>basic facts about @{term crypt_nb}\<close>

lemma non_empty_crypt_msg: "Crypt K Y:parts {X} ==> crypt_nb X \<noteq> 0"
by (induct X, simp_all, safe, simp_all)

subsection\<open>number of Crypt's in a message list\<close>

primrec cnb :: "msg list => nat"
where
  "cnb [] = 0"
| "cnb (X#l) = crypt_nb X + cnb l"

subsection\<open>basic facts about @{term cnb}\<close>

lemma cnb_app [simp]: "cnb (l @ l') = cnb l + cnb l'"
by (induct l, auto)

lemma mem_cnb_minus: "x \<in> set l ==> cnb l = crypt_nb x + (cnb l - crypt_nb x)"
  by (induct l) auto

lemmas mem_cnb_minus_substI = mem_cnb_minus [THEN ssubst]

lemma cnb_minus [simp]: "x \<in> set l ==> cnb (remove l x) = cnb l - crypt_nb x"
apply (induct l, auto)
apply (erule_tac l=l and x=x in mem_cnb_minus_substI)
apply simp
done

lemma parts_cnb: "Z:parts (set l) ==>
cnb l = (cnb l - crypt_nb Z) + crypt_nb Z"
by (erule parts.induct, auto simp: in_set_conv_decomp)

lemma non_empty_crypt: "Crypt K Y:parts (set l) ==> cnb l \<noteq> 0"
by (induct l, auto dest: non_empty_crypt_msg parts_insert_substD)

subsection\<open>list of kparts\<close>

lemma kparts_msg_set: "EX l. kparts {X} = set l & cnb l = crypt_nb X"
apply (induct X, simp_all)
apply (rename_tac agent, rule_tac x="[Agent agent]" in exI, simp)
apply (rename_tac nat, rule_tac x="[Number nat]" in exI, simp)
apply (rename_tac nat, rule_tac x="[Nonce nat]" in exI, simp)
apply (rename_tac nat, rule_tac x="[Key nat]" in exI, simp)
apply (rename_tac X, rule_tac x="[Hash X]" in exI, simp)
apply (clarify, rule_tac x="l@la" in exI, simp)
by (clarify, rename_tac nat X y, rule_tac x="[Crypt nat X]" in exI, simp)

lemma kparts_set: "EX l'. kparts (set l) = set l' & cnb l' = cnb l"
apply (induct l)
apply (rule_tac x="[]" in exI, simp, clarsimp)
apply (rename_tac a b l')
apply (subgoal_tac "EX l''.  kparts {a} = set l'' & cnb l'' = crypt_nb a", clarify)
apply (rule_tac x="l''@l'" in exI, simp)
apply (rule kparts_insert_substI, simp)
by (rule kparts_msg_set)

subsection\<open>list corresponding to "decrypt"\<close>

definition decrypt' :: "msg list => key => msg => msg list" where
"decrypt' l K Y == Y # remove l (Crypt K Y)"

declare decrypt'_def [simp]

subsection\<open>basic facts about @{term decrypt'}\<close>

lemma decrypt_minus: "decrypt (set l) K Y <= set (decrypt' l K Y)"
by (induct l, auto)

subsection\<open>if the analyse of a finite guarded set gives n then it must also gives
one of the keys of Ks\<close>

lemma Guard_invKey_by_list [rule_format]: "ALL l. cnb l = p
--> Guard n Ks (set l) --> Nonce n:analz (set l)
--> (EX K. K:Ks & Key K:analz (set l))"
apply (induct p)
(* case p=0 *)
apply (clarify, drule Guard_must_decrypt, simp, clarify)
apply (drule kparts_parts, drule non_empty_crypt, simp)
(* case p>0 *)
apply (clarify, frule Guard_must_decrypt, simp, clarify)
apply (drule_tac P="%G. Nonce n:G" in analz_pparts_kparts_substD, simp)
apply (frule analz_decrypt, simp_all)
apply (subgoal_tac "EX l'. kparts (set l) = set l' & cnb l' = cnb l", clarsimp)
apply (drule_tac G="insert Y (set l' - {Crypt K Y})"
and H="set (decrypt' l' K Y)" in analz_sub, rule decrypt_minus)
apply (rule_tac analz_pparts_kparts_substI, simp)
apply (case_tac "K:invKey`Ks")
(* K:invKey`Ks *)
apply (clarsimp, blast)
(* K ~:invKey`Ks *)
apply (subgoal_tac "Guard n Ks (set (decrypt' l' K Y))")
apply (drule_tac x="decrypt' l' K Y" in spec, simp)
apply (subgoal_tac "Crypt K Y:parts (set l)")
apply (drule parts_cnb, rotate_tac -1, simp)
apply (clarify, drule_tac X="Key Ka" and H="insert Y (set l')" in analz_sub)
apply (rule insert_mono, rule set_remove)
apply (simp add: analz_insertD, blast)
(* Crypt K Y:parts (set l) *)
apply (blast dest: kparts_parts)
(* Guard n Ks (set (decrypt' l' K Y)) *)
apply (rule_tac H="insert Y (set l')" in Guard_mono)
apply (subgoal_tac "Guard n Ks (set l')", simp)
apply (rule_tac K=K in guard_Crypt, simp add: Guard_def, simp)
apply (drule_tac t="set l'" in sym, simp)
apply (rule Guard_kparts, simp, simp)
apply (rule_tac B="set l'" in subset_trans, rule set_remove, blast)
by (rule kparts_set)

lemma Guard_invKey_finite: "[| Nonce n:analz G; Guard n Ks G; finite G |]
==> EX K. K:Ks & Key K:analz G"
apply (drule finite_list, clarify)
by (rule Guard_invKey_by_list, auto)

lemma Guard_invKey: "[| Nonce n:analz G; Guard n Ks G |]
==> EX K. K:Ks & Key K:analz G"
by (auto dest: analz_needs_only_finite Guard_invKey_finite)

subsection\<open>if the analyse of a finite guarded set and a (possibly infinite) set of keys
gives n then it must also gives Ks\<close>

lemma Guard_invKey_keyset: "[| Nonce n:analz (G Un H); Guard n Ks G; finite G;
keyset H |] ==> EX K. K:Ks & Key K:analz (G Un H)"
apply (frule_tac P="%G. Nonce n:G" and G=G in analz_keyset_substD, simp_all)
apply (drule_tac G="G Un (H Int keysfor G)" in Guard_invKey_finite)
by (auto simp: Guard_def intro: analz_sub)

end