(*File: ContextOBJ.thy*)
(*Authors: Lennart Beringer and Martin Hofmann, LMU Munich 2008*)
theory ContextOBJ imports VS_OBJ begin
subsection{*Contextual closure*}

text{*\label{sec:contextObj}We first define contexts with multiple holes.*}

datatype CtxtProg =
  Ctxt_Here
| Ctxt_Skip
| Ctxt_Assign Var Expr
| Ctxt_New Var Class
| Ctxt_Get Var Var Field
| Ctxt_Put Var Field Expr
| Ctxt_Comp CtxtProg CtxtProg
| Ctxt_If BExpr CtxtProg CtxtProg
| Ctxt_While BExpr CtxtProg
| Ctxt_Call

text{*The definition of a procedure body with holes.*}

consts Ctxt_Body::CtxtProg

text{*Next, the substitution of a command into a context:*}

primrec Fill::"CtxtProg \<Rightarrow> OBJ \<Rightarrow> OBJ"
where
"Fill Ctxt_Here J = J" |
"Fill Ctxt_Skip J = Skip" |
"Fill (Ctxt_Assign x e) J = Assign x e" |
"Fill (Ctxt_New x c) J = New x c" |
"Fill (Ctxt_Get x y f) J = Get x y f" |
"Fill (Ctxt_Put x f e) J = Put x f e" |
"Fill (Ctxt_Comp C D) J = Comp (Fill C J) (Fill D J)" |
"Fill (Ctxt_If b C D) J = Iff b (Fill C J) (Fill D J)" |
"Fill (Ctxt_While b C) J = While b (Fill C J)" |
"Fill Ctxt_Call J = Call"

text{*The variables mentioned by an expression:*}

primrec EVars::"Expr \<Rightarrow> Var set"
where
"EVars (varE x) = {x}" |
"EVars (valE v) = {}" |
"EVars (opE f e1 e2) = EVars e1 \<union> EVars e2"

primrec BVars::"BExpr \<Rightarrow> Var set"
where
"BVars (compB f e1 e2) = EVars e1 \<union> EVars e2"

text{*The variables possibly read from during the evaluation of $I$
are denoted by $\mathit{Vars\; I}$.*}

primrec Vars::"OBJ \<Rightarrow> Var set"
where
"Vars Skip = {}" |
"Vars (Assign x e) = EVars e" |
"Vars (New x C) = {}" |
"Vars (Get x y f) = {y}" |
"Vars (Put x f e) = EVars e" |
"Vars (Comp I J) = Vars I \<union> Vars J" |
"Vars (While b I) = BVars b \<union> Vars I" |
"Vars (Iff b I J) = BVars b \<union> Vars I \<union> Vars J" |
"Vars Call = {}"

(*<*)
lemma Secure_comp: "\<lbrakk>secure C; secure D\<rbrakk> \<Longrightarrow> secure (Comp C D)"
apply (unfold secure_def)
apply (rule, rule, rule, rule)
apply (rule, rule, rule, rule)
apply (unfold Sem_def)
apply (erule exE)+
apply (erule Sem_eval_cases)
apply (erule Sem_eval_cases)
apply (erule_tac x=s in allE, rotate_tac -1)
apply (erule_tac x=ss in allE, rotate_tac -1)
apply (erule_tac x=r in allE, rotate_tac -1)
apply (erule_tac x=ra in allE, rotate_tac -1)
apply (erule_tac x=\<beta> in allE)
apply (erule impE, assumption)
apply (erule impE, rule, assumption)
apply (erule impE, rule, assumption)
apply (erule exE, erule conjE)
apply (erule_tac x=r in allE, rotate_tac -1)
apply (erule_tac x=ra in allE, rotate_tac -1)
apply (erule_tac x=t in allE, rotate_tac -1)
apply (erule_tac x=tt in allE, rotate_tac -1)
apply (erule_tac x=\<gamma> in allE)
apply (erule impE, assumption)
apply (erule impE, rule, assumption)
apply (erule impE, rule, assumption)
apply (erule exE, erule conjE)
apply (rule, rule, assumption)
apply (erule Pbij_extends_transitive, assumption)
done

lemma Secure_iff:
" \<lbrakk>secure C; secure D;
   \<forall> s t \<beta>. s \<equiv>\<^sub>\<beta> t \<longrightarrow> evalB b (fst s) = evalB b (fst t)\<rbrakk>
  \<Longrightarrow> secure (Iff b C D)"
apply (unfold secure_def)
apply (rule, rule, rule, rule)
apply (rule, rule, rule, rule)
apply (unfold Sem_def)
apply (erule exE)+
apply (erule_tac x=s in allE, erule_tac x=ss in allE, erule_tac x=\<beta> in allE, erule impE, assumption)
apply (erule Sem_eval_cases)
apply (erule Sem_eval_cases)
apply (erule_tac x=s in allE, rotate_tac -1)
apply (erule_tac x=ss in allE, rotate_tac -1)
apply (erule_tac x=t in allE, rotate_tac -1)
apply (erule_tac x=tt in allE, rotate_tac -1)
apply (erule_tac x=\<beta> in allE)
apply (erule impE, assumption)
apply (erule impE, rule, assumption)
apply (erule impE, rule, assumption)
apply assumption
apply fast
apply (erule Sem_eval_cases)
apply fast
apply (erule thin_rl)
apply (erule_tac x=s in allE, rotate_tac -1)
apply (erule_tac x=ss in allE, rotate_tac -1)
apply (erule_tac x=t in allE, rotate_tac -1)
apply (erule_tac x=tt in allE, rotate_tac -1)
apply (erule_tac x=\<beta> in allE)
apply (erule impE, assumption)
apply (erule impE, rule, assumption)
apply (erule impE, rule, assumption)
apply assumption
done

lemma secure_while_aux[rule_format]:
"\<forall> n m . n \<le> k \<longrightarrow> m \<le> k \<longrightarrow>
  (\<forall> s t ss tt . (s , While b C \<rightarrow>\<^sub>n  ss) \<longrightarrow>
                 (t , While b C \<rightarrow>\<^sub>m  tt) \<longrightarrow>
                 secure C \<longrightarrow>
                 (\<forall>s ss \<beta>. s \<equiv>\<^sub>\<beta> ss \<longrightarrow> evalB b (fst s) = evalB b (fst ss)) \<longrightarrow>
                 (\<forall> \<beta> . s \<equiv>\<^sub>\<beta> t \<longrightarrow>
                     (\<exists> \<gamma> . ss \<equiv>\<^sub>\<gamma> tt \<and> Pbij_extends \<gamma> \<beta>)))"
apply (induct k)
apply clarsimp apply (drule Sem_no_zero_height_derivs, clarsimp)
apply (rule, rule, rule)
apply (rule, rule, rule)
apply (rule, rule, rule)
apply (rule, rule, rule)
apply (rule, rule)
  apply (subgoal_tac "evalB b (fst s) = evalB b (fst t)")
  prefer 2 apply (erule thin_rl, fast)
  apply (erule Sem_eval_cases)
  apply (erule Sem_eval_cases) prefer 2 apply simp
    apply (subgoal_tac "\<exists>\<gamma>. r \<equiv>\<^sub>\<gamma> ra \<and> Pbij_extends \<gamma> \<beta>")
      apply (erule exE, erule conjE)
      apply (erule_tac x=ma in allE, erule_tac x=mb in allE)
      apply (erule impE, simp)
      apply (erule impE, simp)
      apply (rotate_tac -1, erule_tac x=r in allE)
      apply (rotate_tac -1, erule_tac x=ra in allE)
      apply (rotate_tac -1, erule_tac x=ss in allE)
      apply (rotate_tac -1, erule_tac x=tt in allE)
      apply (erule impE, assumption)
      apply (erule impE, assumption)
      apply (erule impE, assumption)
      apply (erule impE, assumption)
      apply (rotate_tac -1, erule_tac x=\<gamma> in allE)
      apply (erule impE, assumption)
      apply (erule exE, erule conjE)
      apply (rule, rule, assumption)
      apply (erule Pbij_extends_transitive, assumption)
      defer 1
  apply (erule thin_rl)
  apply (erule Sem_eval_cases) apply simp
  apply clarify apply (rule, rule, assumption) apply (rule Pbij_extends_reflexive)
apply (erule thin_rl, unfold secure_def Sem_def) apply fast
done

lemma Secure_while:
" \<lbrakk>secure C;
   \<forall> s t \<beta>. s \<equiv>\<^sub>\<beta> t \<longrightarrow> evalB b (fst s) = evalB b (fst t)\<rbrakk>
  \<Longrightarrow> secure (While b C)"
apply (unfold secure_def)
apply (rule, rule, rule, rule)
apply (rule, rule, rule, rule)
apply (unfold Sem_def) apply (erule exE)+
apply (rule secure_while_aux)
prefer 3 apply assumption
prefer 6 apply assumption
prefer 3 apply assumption
prefer 3 apply (unfold secure_def Sem_def) apply assumption
prefer 3 apply fast
apply (subgoal_tac "n \<le> n + na", assumption) apply (simp, simp)
done
(*>*)

text{*An abbreviating definition saying when a value is not a constant
location.*}

definition ValIsNoLoc ::"Val => bool"
where "ValIsNoLoc v = (v = RVal Nullref \<or> (\<exists> i . v = IVal i))"

text{*Expressions satisfying the following predicate are guaranteed
not to return a state-independent location.*}

primrec Expr_noLoc::"Expr \<Rightarrow> bool"
where
"Expr_noLoc (varE x) = True" |
"Expr_noLoc (valE v) = ValIsNoLoc v" |
"Expr_noLoc (opE f e1 e2) =
   (Expr_noLoc e1 \<and> Expr_noLoc e2 \<and> opEGood f)"

primrec BExpr_noLoc::"BExpr \<Rightarrow> bool"
where
"BExpr_noLoc (compB f e1 e2) =
   (Expr_noLoc e1 \<and> Expr_noLoc e2 \<and> compBGood f)"

text{*By induction on $e$ one may show the following three properties.*}

lemma Expr_lemma1[rule_format]:
  "Expr_noLoc e \<longrightarrow> EVars e \<subseteq> X \<longrightarrow>
   (\<forall>x. x \<in> X \<longrightarrow> CONTEXT x = low) \<longrightarrow> Expr_low e"
(*<*)
apply (induct e)
apply (simp_all add:Expr_low_def)
(*VarE*)
apply (simp add: twiddleStore_def)
(*ValE*)
apply (simp add: ValIsNoLoc_def)
apply rule
  apply clarsimp apply (rule twiddleVal_Null)
  apply clarsimp apply (rule twiddleVal_IVal) apply simp
(*opE*)
apply clarsimp
  apply (erule_tac x=s in allE, erule_tac x=t in allE, erule_tac x=\<beta> in allE, clarsimp)
  apply (erule_tac x=s in allE, erule_tac x=t in allE, erule_tac x=\<beta> in allE, clarsimp)
  apply (simp add: opEGood_def)
done
(*>*)

lemma Expr_lemma2[rule_format]:
  "noLowDPs (s, h) \<longrightarrow>
       EVars e \<subseteq> X \<longrightarrow>  Expr_noLoc e \<longrightarrow>
       (\<forall>x. x \<in> X \<longrightarrow> CONTEXT x = low) \<longrightarrow>
       s \<approx>\<^sub>\<beta> t \<longrightarrow> twiddleHeap \<beta> h k \<longrightarrow>
       noLowDPs (\<lambda>y. if x = y then evalE e s else s y, h)"
(*<*)
apply (induct e)
(*VarE*)
apply (simp add: noLowDPs_def) apply clarsimp
  apply (rename_tac Var l)
  apply (erule_tac x=Var in allE, erule impE, assumption)
  apply (erule_tac x=Var in allE, erule impE, assumption)
  apply (erule_tac x=l in allE, erule mp, assumption)
(*ValE*)
apply (simp add: ValIsNoLoc_def noLowDPs_def) apply clarsimp
(*opE*)
apply clarsimp
apply (simp add: noLowDPs_def)
 apply clarsimp
apply (drule Expr_lemma1) apply assumption apply fast
apply (drule Expr_lemma1) apply assumption apply fast
apply (subgoal_tac "(\<beta>,evalE e1 s,evalE e1 t): twiddleVal")
prefer 2 apply (simp add: Expr_low_def)
apply (subgoal_tac "(\<beta>,evalE e2 s,evalE e2 t): twiddleVal")
prefer 2 apply (simp add: Expr_low_def)
apply (simp add: opEGood_def)
apply (erule_tac x=\<beta> in allE, erule_tac x="evalE e1 s" in allE, erule_tac x="evalE e1 t" in allE, erule impE, assumption)
apply (erule_tac x="evalE e2 s" in allE, erule_tac x="evalE e2 t" in allE, erule impE, assumption)
apply clarsimp apply (rotate_tac -1, erule twiddleVal.cases, simp_all) apply clarsimp
apply (simp add: twiddleHeap_def Pbij_Dom_def) apply clarsimp apply fast
done
(*>*)

lemma Expr_lemma3[rule_format]:
 "noLowDPs (s,h) \<longrightarrow>  EVars e \<subseteq> X \<longrightarrow> Expr_noLoc e \<longrightarrow>
   lookup h l = Some (C, Flds) \<longrightarrow>
   (\<forall>x. x \<in> X \<longrightarrow> CONTEXT x = low) \<longrightarrow>
   s \<approx>\<^sub>\<beta> t \<longrightarrow> twiddleHeap \<beta> h k \<longrightarrow>
   noLowDPs (s, (l, C, (f, evalE e s) # Flds) # h)"
(*<*)
apply (induct e)
(*VarE*)
apply (simp add: noLowDPs_def) apply clarsimp
  apply (rule, clarsimp) apply (simp add: Dom_def)
  apply (rule, rule, clarsimp)
    apply (rule, clarsimp) apply (rename_tac Var la) apply (erule_tac x=Var in allE, clarsimp) apply (simp add: Dom_def)
    apply clarsimp  apply (erule_tac x=l in allE, clarsimp) apply (erule_tac x=fa in allE, clarsimp)
     apply (simp add: Dom_def)
  apply clarsimp apply (erule_tac x=ll in allE, clarsimp) apply (erule_tac x=fa in allE, clarsimp) apply (simp add: Dom_def)
(*ValE*)
apply (simp add: ValIsNoLoc_def noLowDPs_def) apply clarsimp
  apply (rule,clarsimp)
    apply (rule, clarsimp) apply (simp add: Dom_def)
    apply (rule, rule, clarsimp) apply (simp add: Dom_def)
    apply (simp add: Dom_def)
  apply clarsimp
    apply (rule, clarsimp) apply (simp add: Dom_def)
    apply (rule, rule, clarsimp) apply (simp add: Dom_def)
    apply (simp add: Dom_def)
(*opE*)
apply clarsimp
apply (simp add: noLowDPs_def)
apply (rule, clarsimp) apply (simp add: Dom_def)
apply clarsimp
apply (rule, clarsimp)
  apply (rule, clarsimp)
    apply (subgoal_tac "la:Dom h", simp add: Dom_def)
    apply (drule Expr_lemma1) apply assumption apply fast
    apply (drule Expr_lemma1) apply assumption apply fast
    apply (subgoal_tac "(\<beta>,evalE e1 s,evalE e1 t): twiddleVal")
    prefer 2 apply (simp add: Expr_low_def)
    apply (subgoal_tac "(\<beta>,evalE e2 s,evalE e2 t): twiddleVal")
    prefer 2 apply (simp add: Expr_low_def)
    apply (simp add: opEGood_def)
    apply (erule_tac x=\<beta> in allE, erule_tac x="evalE e1 s" in allE, erule_tac x="evalE e1 t" in allE, erule impE, assumption)
    apply (erule_tac x="evalE e2 s" in allE, erule_tac x="evalE e2 t" in allE, erule impE, assumption)
    apply clarsimp apply (rotate_tac -1, erule twiddleVal.cases, simp_all) apply clarsimp
    apply (simp add: twiddleHeap_def,clarsimp) apply (subgoal_tac "l1:Pbij_Dom \<beta>") apply fast
                                               apply(simp add:Pbij_Dom_def, rule, assumption)
  apply clarsimp apply (erule_tac x=l in allE, clarsimp)
    apply (erule_tac x=fa in allE, clarsimp) apply (simp add: Dom_def)
apply clarsimp apply (erule_tac x=ll in allE, clarsimp)
  apply (erule_tac x=fa in allE, clarsimp)
  apply (simp add: Dom_def)
done
(*>*)

text{*The first of these can be lifted to boolean expressions.*}

lemma BExpr_lemma:
"\<lbrakk>BVars b \<subseteq> X; \<forall>x. x \<in> X \<longrightarrow> CONTEXT x = low; BExpr_noLoc b\<rbrakk> \<Longrightarrow> BExpr_low b"
(*<*)
apply (case_tac b, clarsimp)
apply (drule Expr_lemma1, assumption) apply fast
apply (drule Expr_lemma1, assumption) apply fast
apply (simp add: BExpr_low_def Expr_low_def compBGood_def, clarsimp) apply fast
done
(*>*)

text{*For contexts, we define when a set $X$ of variables is an upper
bound for the variables read from. In addition, the @{text noLoc}
condition is imposed on expressions occurring in assignments and field
modifications in order to express that if these expressions evaluate
to locations then these must stem from lookup operations in the
state.*}

primrec CtxtVars::"Var set \<Rightarrow> CtxtProg \<Rightarrow> bool"
where
"CtxtVars X Ctxt_Here = True" |
"CtxtVars X Ctxt_Skip = True" |
"CtxtVars X (Ctxt_Assign x e) = (EVars e \<subseteq> X \<and> Expr_noLoc e)" |
"CtxtVars X (Ctxt_New x c) = True" |
"CtxtVars X (Ctxt_Get x y f) = (y : X \<and> GAMMA f = low)" |
"CtxtVars X (Ctxt_Put x f e) =
   (EVars e \<subseteq> X \<and> CONTEXT x = low \<and> Expr_noLoc e)" |
"CtxtVars X (Ctxt_Comp C D) = (CtxtVars X C \<and> CtxtVars X D)" |
"CtxtVars X (Ctxt_If b C D) =
   (BVars b \<subseteq> X \<and> CtxtVars X C \<and> CtxtVars X D \<and> BExpr_noLoc b)" |
"CtxtVars X (Ctxt_While b C) =
   (BVars b \<subseteq> X \<and> CtxtVars X C \<and> BExpr_noLoc b)" |
"CtxtVars X Ctxt_Call = True"

text{*A context is "obviously" low if all accessed variables are
(contained in a set $X$ whose members are) low.*}

definition LOW::"Var set \<Rightarrow> CtxtProg \<Rightarrow> bool"
where "LOW X C = (CtxtVars X C \<and> (\<forall> x . x : X \<longrightarrow> CONTEXT x = low))"

(*<*)
lemma secureI_secureFillI_Aux[rule_format]:
"\<forall> n m . n \<le> k \<longrightarrow> m \<le> k \<longrightarrow>
       (\<forall> C J s t ss tt \<beta> X . (s , J \<rightarrow>\<^sub>n t) \<longrightarrow>
                          (ss , J \<rightarrow>\<^sub>m  tt) \<longrightarrow>
                          s \<equiv>\<^sub>\<beta> ss \<longrightarrow>
                          J = Fill C I \<longrightarrow>
                          LOW X C \<longrightarrow>
                          LOW X Ctxt_Body \<longrightarrow>
                          body = Fill Ctxt_Body I \<longrightarrow> secure I \<longrightarrow>
                          (\<exists> \<gamma> . t \<equiv>\<^sub>\<gamma> tt \<and> Pbij_extends \<gamma> \<beta>))"
apply (induct k)
apply clarsimp apply (drule Sem_no_zero_height_derivs, clarsimp)
apply (rule, rule, rule, rule)
apply (rule, rule, rule, rule)
apply (rule, rule, rule, rule)
apply (rule, rule, rule, rule)
apply (rule, rule, rule, rule)
apply (case_tac C)
(*Ctxt_Here*)
  apply (unfold secure_def Sem_def)
  apply (erule thin_rl)
  apply simp apply fast
(*Ctxt_Skip*)
apply clarsimp
  apply (erule thin_rl)
  apply (erule Sem_eval_cases)+ apply clarsimp apply (rule, rule,  assumption)
  apply (rule Pbij_extends_reflexive)
(*Ctxt_Assign*)
apply clarsimp
  apply (erule thin_rl) apply (rotate_tac -1, erule thin_rl)
  apply (erule Sem_eval_cases)+ apply clarsimp
  apply (simp add: update_def twiddle_def) apply clarsimp
    apply (rule, simp only: LOW_def, clarsimp) apply (erule Expr_lemma2, assumption+) apply fast apply assumption+
    apply (rule, simp only: LOW_def, clarsimp) apply (erule Expr_lemma2, assumption+) apply fast
      apply (erule twiddleStore_inverse) apply (erule twiddleHeap_inverse)
    apply (rule, rule)
    prefer 2 apply (rule, assumption) apply (rule Pbij_extends_reflexive)
    apply (simp (no_asm_simp) add: twiddleStore_def)
    apply rule
    apply (simp add: LOW_def) apply clarsimp
      apply (rule, clarsimp) apply (rename_tac Expr x) apply (subgoal_tac "Expr_low Expr") apply (simp add: Expr_low_def)
                             apply (erule Expr_lemma1) apply assumption+ apply fast
      apply clarsimp apply (simp add: twiddleStore_def)
(*New*)
  apply (erule thin_rl, clarsimp)
  apply (rotate_tac -1, erule thin_rl)
  apply (erule Sem_eval_cases)
  apply (erule Sem_eval_cases)
  apply clarsimp
  apply (rule_tac x="{(l,la)} \<union> \<beta>" in exI)
  apply rule
    prefer 2
      apply (simp add: Pbij_extends_def twiddle_def twiddleHeap_def) apply clarsimp
    apply (frule isPBij)
    apply (simp add: twiddle_def)
    apply (rule, simp add: noLowDPs_def update_def)
      apply (rule, clarsimp)
        apply (rule, simp add: Dom_def)
        apply clarsimp apply (erule_tac x=x in allE, erule impE, assumption)
                       apply (erule_tac x=lb in allE, erule impE, assumption)
                       apply (simp add: Dom_def)
        apply clarsimp apply (erule_tac x=ll in allE, clarsimp)
                       apply (erule_tac x=f in allE, clarsimp)
                       apply (simp add: Dom_def)
    apply (rule, simp add: noLowDPs_def update_def)
      apply (rule, clarsimp)
        apply (rule, simp add: Dom_def)
        apply clarsimp apply (erule_tac x=x in allE, erule impE, assumption,
                              erule_tac x=lb in allE, erule impE, assumption)
                       apply (simp add: Dom_def)
        apply clarsimp apply (erule_tac x=ll in allE, erule_tac x=c in allE, erule_tac x=F in allE, erule impE, assumption,
                              erule_tac x=f in allE, clarsimp)
                       apply (simp add: Dom_def)
    apply rule
      apply (simp add: twiddleStore_def)
       apply clarsimp apply (simp add: update_def)
         apply rule apply clarsimp apply (rule twiddleVal_Loc) apply simp
         apply clarsimp apply (rotate_tac -4, erule_tac x=x in allE, clarsimp)
           apply (erule twiddleVal_betaExtend) apply (simp add: Pbij_extends_def) apply fast
     apply (simp add: twiddleHeap_def)
     apply (rule, simp add: Pbij_def) apply clarsimp apply (rule, clarsimp) apply (simp add: Pbij_Dom_def Pbij_Rng_def) apply (rotate_tac -2, erule thin_rl) apply rule apply fast apply fast
        apply clarsimp apply (simp add: Pbij_Dom_def Pbij_Rng_def) apply rule apply fast apply fast
     apply (rule, simp add: Pbij_Dom_def Dom_def) apply fast
     apply (rule, simp add: Pbij_Rng_def Dom_def) apply fast
     apply clarsimp
     apply rule apply clarsimp
       apply (simp add: twiddleObj_def)
     apply clarsimp
     apply rule apply (simp add: Pbij_Dom_def) apply fast
                apply (simp add: Pbij_Dom_def) apply fast
     apply clarsimp
     apply rule apply clarsimp apply (simp add: Pbij_Rng_def) apply fast
     apply clarsimp
       apply (erule_tac x=lb in allE, erule_tac x=ll in allE, clarsimp)
       apply (erule twiddleObj_betaExtend)
       apply (simp add: Pbij_extends_def) apply fast
(*Get*)
  apply (erule thin_rl, clarsimp)
  apply (rotate_tac -1, erule thin_rl)
  apply (erule Sem_eval_cases)
  apply (erule Sem_eval_cases)
  apply clarsimp
  apply (rule, rule)
  prefer 2 apply (rule Pbij_extends_reflexive)
  apply (simp add: twiddle_def)
  apply (rule, simp add: noLowDPs_def update_def LOW_def, clarsimp)
  apply (rule, simp add: noLowDPs_def update_def LOW_def, clarsimp)
  apply (simp add: twiddleStore_def)
  apply clarsimp apply (simp add: update_def, clarsimp)
  apply (simp add: twiddleHeap_def, clarsimp)
  apply (rotate_tac 4, rename_tac Var2 x53 l C Flds v la Ca Fldsa va x, erule_tac x=Var2 in allE,
    simp add: LOW_def) apply clarsimp
  apply (erule twiddleVal.cases) apply clarsimp prefer 2 apply clarsimp apply clarsimp
  apply (erule_tac x=l1 in allE)
  apply (erule_tac x=l2 in allE)
  apply clarsimp apply (simp add: twiddleObj_def)
(*Put*)
 apply (rename_tac Var Field Expr)
 apply (erule thin_rl, clarsimp)
  apply (rotate_tac -1, erule thin_rl)
  apply (erule Sem_eval_cases)
  apply (erule Sem_eval_cases)
  apply clarsimp
  apply (rule, rule)
  prefer 2 apply (rule Pbij_extends_reflexive)
  apply (simp add: update_def twiddle_def, clarsimp)
    apply (rule, simp only: LOW_def, clarsimp) apply (erule  Expr_lemma3, assumption+) apply fast apply assumption+
    apply (rule, simp only: LOW_def, clarsimp) apply (erule  Expr_lemma3, assumption+) apply fast
      apply (erule twiddleStore_inverse) apply (erule twiddleHeap_inverse)
  apply (simp add: twiddleHeap_def)
  apply clarsimp
  apply rule apply (rotate_tac -1, erule thin_rl) apply (simp add: Dom_def) apply fast
  apply rule apply (rotate_tac -1, erule thin_rl) apply (simp add: Dom_def) apply fast
  apply clarsimp
  apply rule apply clarsimp
    apply rule apply clarsimp apply (erule_tac x=lb in allE, erule_tac x=ll in allE, clarsimp)
      apply (simp add: twiddleObj_def)
      apply rule apply clarsimp apply (rotate_tac -1, erule thin_rl) apply (simp add: LowDom_def)
        apply rule apply fastforce apply fastforce
      apply (simp add: LOW_def, clarsimp)
        apply (subgoal_tac "Expr_low Expr") apply (simp add: Expr_low_def)
        apply (erule Expr_lemma1) apply assumption apply fast
    apply clarsimp
      apply (simp add: LOW_def twiddleStore_def) apply clarsimp
      apply (erule_tac x=Var in allE, clarsimp)
      apply (erule twiddleVal.cases) apply clarsimp prefer 2 apply clarsimp apply clarsimp
      apply (simp add: Pbij_def)
      apply (erule_tac x=l1 in allE)
      apply (rotate_tac -1, erule_tac x=ll in allE, erule impE, assumption)
      apply (rotate_tac -1, erule_tac x=l1 in allE)
      apply (rotate_tac -1, erule_tac x=l2 in allE, erule impE, assumption)
      apply clarsimp
  apply clarsimp
    apply (simp add: LOW_def twiddleStore_def) apply (erule_tac x=Var in allE, clarsimp)
    apply (erule twiddleVal.cases) apply clarsimp prefer 2 apply clarsimp apply clarsimp
       apply (drule Pbij_injective) apply (rotate_tac -1, erule_tac x=l2 in allE)
         apply (rotate_tac -1, erule_tac x=l1 in allE)
         apply (rotate_tac -1, erule_tac x=lb in allE, clarsimp)
(*Ctxt_Comp*)
apply (rename_tac CtxtProg1 CtxtProg2)
apply clarsimp apply (erule Sem_eval_cases) apply (erule Sem_eval_cases) apply clarsimp
  apply (subgoal_tac "\<exists> \<gamma> . (ad,bd) \<equiv>\<^sub>\<gamma> (ae,be) \<and> Pbij_extends \<gamma> \<beta>")
  prefer 2
           apply (erule_tac x=na in allE, clarsimp)
           apply (erule_tac x=nb in allE, clarsimp)
           apply (erule_tac x=CtxtProg1 in allE)
           apply (erule_tac x="Fill CtxtProg1 I" in allE, clarsimp)
           apply (rotate_tac -1, erule_tac x=a in allE)
           apply (rotate_tac -1, erule_tac x=b in allE)
           apply (rotate_tac -1, erule_tac x=ad in allE)
           apply (rotate_tac -1, erule_tac x=bd in allE, clarsimp)
           apply (rotate_tac -1, erule_tac x=ab in allE)
           apply (rotate_tac -1, erule_tac x=bb in allE)
           apply (rotate_tac -1, erule_tac x=ae in allE)
           apply (rotate_tac -1, erule_tac x=be in allE, clarsimp)
           apply (rotate_tac -1, erule_tac x=\<beta> in allE, erule impE, assumption)
           apply (rotate_tac -1, erule_tac x=X in allE, clarsimp) apply (simp add: LOW_def)
        apply clarsimp
           apply (erule_tac x=ma in allE, clarsimp)
           apply (erule_tac x=mb in allE, clarsimp)
           apply (erule_tac x=CtxtProg2 in allE)
           apply (erule_tac x="Fill CtxtProg2 I" in allE, clarsimp)
           apply (rotate_tac -1, erule_tac x=ad in allE)
           apply (rotate_tac -1, erule_tac x=bd in allE)
           apply (rotate_tac -1, erule_tac x=aa in allE)
           apply (rotate_tac -1, erule_tac x=ba in allE, clarsimp)
           apply (rotate_tac -1, erule_tac x=ae in allE)
           apply (rotate_tac -1, erule_tac x=be in allE)
           apply (rotate_tac -1, erule_tac x=ac in allE)
           apply (rotate_tac -1, erule_tac x=bc in allE, clarsimp)
           apply (rotate_tac -1, erule_tac x=\<gamma> in allE, erule impE, assumption)
           apply (rotate_tac -1, erule_tac x=X in allE, clarsimp)  apply (simp add: LOW_def, clarsimp)
        apply (rule, rule) prefer 2 apply (rule Pbij_extends_transitive) prefer 2 apply assumption apply assumption apply assumption
(*Ctxt_If*)
apply (rename_tac BExpr CtxtProg1 CtxtProg2)
apply clarsimp
  apply (subgoal_tac "evalB BExpr a = evalB BExpr ab")
  prefer 2 apply (erule thin_rl) apply (rotate_tac -1, erule thin_rl)
           apply (simp add: LOW_def, clarsimp)
           apply (drule BExpr_lemma) apply assumption apply assumption
           apply (simp add: BExpr_low_def twiddle_def, clarsimp)
           apply (erule_tac x=a in allE, erule_tac x=ab in allE, erule mp) apply (rule, assumption)
  apply (erule Sem_eval_cases) apply (erule Sem_eval_cases) prefer 2 apply clarsimp apply clarsimp
           apply (erule_tac x=na in allE, clarsimp)
           apply (erule_tac x=nb in allE, clarsimp)
           apply (erule_tac x=CtxtProg1 in allE)
           apply (erule_tac x="Fill CtxtProg1 I" in allE, clarsimp)
           apply (rotate_tac -1, erule_tac x=a in allE)
           apply (rotate_tac -1, erule_tac x=b in allE)
           apply (rotate_tac -1, erule_tac x=aa in allE)
           apply (rotate_tac -1, erule_tac x=ba in allE, clarsimp)
           apply (rotate_tac -1, erule_tac x=ab in allE)
           apply (rotate_tac -1, erule_tac x=bb in allE)
           apply (rotate_tac -1, erule_tac x=ac in allE)
           apply (rotate_tac -1, erule_tac x=bc in allE, clarsimp)
           apply (rotate_tac -1, erule_tac x=\<beta> in allE, clarsimp)
           apply (rotate_tac -1, erule_tac x=X in allE, clarsimp) apply (simp add: LOW_def)
         apply (erule Sem_eval_cases) apply clarsimp apply clarsimp
           apply (erule_tac x=na in allE, clarsimp)
           apply (erule_tac x=nb in allE, clarsimp)
           apply (erule_tac x=CtxtProg2 in allE)
           apply (erule_tac x="Fill CtxtProg2 I" in allE, clarsimp)
           apply (rotate_tac -1, erule_tac x=a in allE)
           apply (rotate_tac -1, erule_tac x=b in allE)
           apply (rotate_tac -1, erule_tac x=aa in allE)
           apply (rotate_tac -1, erule_tac x=ba in allE, clarsimp)
           apply (rotate_tac -1, erule_tac x=ab in allE)
           apply (rotate_tac -1, erule_tac x=bb in allE)
           apply (rotate_tac -1, erule_tac x=ac in allE)
           apply (rotate_tac -1, erule_tac x=bc in allE, clarsimp)
           apply (rotate_tac -1, erule_tac x=\<beta> in allE, clarsimp)
           apply (rotate_tac -1, erule_tac x=X in allE, clarsimp) apply (simp add: LOW_def)
(*Ctxt_While*)
apply (rename_tac BExpr CtxtProg)
apply clarsimp
  apply (subgoal_tac "evalB BExpr a = evalB BExpr ab")
  prefer 2 apply (erule thin_rl) apply (rotate_tac -1, erule thin_rl)
           apply (simp add: LOW_def, clarsimp)
           apply (drule BExpr_lemma) apply assumption apply assumption
           apply (simp add: BExpr_low_def twiddle_def, clarsimp)
           apply (erule_tac x=a in allE, erule_tac x=ab in allE, erule mp) apply (rule, assumption)
  apply (erule Sem_eval_cases)
    apply (erule Sem_eval_cases) prefer 2 apply clarsimp
    apply (subgoal_tac "\<exists> \<gamma> . r \<equiv>\<^sub>\<gamma> ra \<and> Pbij_extends \<gamma> \<beta>")
    prefer 2 apply (erule_tac x=na in allE, clarsimp)
             apply (erule_tac x=nb in allE, clarsimp)
             apply (erule_tac x=CtxtProg in allE)
             apply (erule_tac x="Fill CtxtProg I" in allE, clarsimp)
             apply (rotate_tac 4, erule thin_rl)
             apply (rotate_tac -3, erule_tac x=a in allE)
             apply (rotate_tac -1, erule_tac x=b in allE)
             apply (rotate_tac -1, erule_tac x=ad in allE)
             apply (rotate_tac -1, erule_tac x=bd in allE, clarsimp)
             apply (rotate_tac -1, erule_tac x=ab in allE)
             apply (rotate_tac -1, erule_tac x=bb in allE)
             apply (rotate_tac -1, erule_tac x=ae in allE)
             apply (rotate_tac -1, erule_tac x=be in allE, clarsimp)
             apply (rotate_tac -1, erule_tac x=\<beta> in allE, clarsimp)
             apply (rotate_tac -1, erule_tac x=X in allE, clarsimp, simp add: LOW_def)
    apply clarsimp
    apply (erule_tac x=ma in allE, clarsimp)
    apply (erule_tac x=mb in allE, clarsimp)
    apply (erule_tac x="Ctxt_While BExpr CtxtProg" in allE)
    apply (erule_tac x="While BExpr (Fill CtxtProg I)" in allE, clarsimp)
    apply (rotate_tac 4, erule thin_rl)
    apply (rotate_tac -3, erule_tac x=ad in allE)
    apply (rotate_tac -1, erule_tac x=bd in allE)
    apply (rotate_tac -1, erule_tac x=aa in allE)
    apply (rotate_tac -1, erule_tac x=ba in allE, clarsimp)
    apply (rotate_tac -1, erule_tac x=ae in allE)
    apply (rotate_tac -1, erule_tac x=be in allE)
    apply (rotate_tac -1, erule_tac x=ac in allE)
    apply (rotate_tac -1, erule_tac x=bc in allE, clarsimp)
    apply (rotate_tac -1, erule_tac x=\<gamma> in allE, clarsimp)
    apply (rotate_tac -1, erule_tac x=X in allE, clarsimp, simp add: LOW_def)
    apply (rule_tac x=\<gamma>' in exI, simp) apply (erule Pbij_extends_transitive) apply assumption
  apply clarsimp apply (erule Sem_eval_cases) apply clarsimp apply clarsimp
    apply (rule_tac x=\<beta> in exI, simp) apply (rule Pbij_extends_reflexive)
(*Ctxt_Call*)
apply clarsimp apply (erule Sem_eval_cases) apply (erule Sem_eval_cases)
  apply (erule_tac x=na in allE, clarsimp)
done
(*>*)

text{*Finally, we obtain the following result by induction on an upper
bound on the derivation heights of the two executions of $Fill\ C\
I$.*}

theorem secureI_secureFillI:
 "\<lbrakk>secure I; LOW X C; LOW X Ctxt_Body; body = Fill Ctxt_Body I\<rbrakk>
 \<Longrightarrow> secure (Fill C I)"
(*<*)
apply (unfold secure_def Sem_def)
apply (rule, rule, rule, rule)
apply (rule, rule, rule, rule)
apply (erule exE)+
apply (rule secureI_secureFillI_Aux)
prefer 3 apply assumption
prefer 4 apply assumption
prefer 3 apply assumption
apply (subgoal_tac "n \<le> n+na", assumption)
apply (erule thin_rl, simp)
apply (erule thin_rl, simp)
apply (erule thin_rl,fastforce)
apply assumption
apply assumption
apply assumption
apply (simp add: secure_def Sem_def)
done
(*>*)

text{*For a variable*}

consts res::Var

text{*representing the output of the attacking context, the result specialises to*}

theorem SecureForAttackingContext:
 "\<lbrakk> secure I; LOW X C;  LOW X Ctxt_Body; s \<equiv>\<^sub>\<beta> ss;
    s,(Fill C I)\<Down>t; ss,(Fill C I)\<Down>tt; body = Fill Ctxt_Body I;
    CONTEXT res = low\<rbrakk>
  \<Longrightarrow> \<exists> \<gamma>. (\<gamma>,(fst t) res,(fst tt) res):twiddleVal \<and> Pbij_extends \<gamma> \<beta>"
(*<*)
apply (drule secureI_secureFillI) apply assumption apply assumption apply assumption
apply (unfold secure_def)
apply (erule_tac x=s in allE, erule_tac x=ss in allE)
apply (erule_tac x=t in allE, erule_tac x=tt in allE)
apply (erule_tac x=\<beta> in allE, clarsimp)
apply (simp add: twiddle_def twiddleStore_def) apply fast
done
(*>*)

text{*End of theory ContextObj*}
end


(*
 * Copyright 2014, NICTA
 *
 * This software may be distributed and modified according to the terms of
 * the BSD 2-Clause license. Note that NO WARRANTY is provided.
 * See "LICENSE_BSD2.txt" for details.
 *
 * @TAG(NICTA_BSD)
 *)

theory ArraysMemInstance
imports Arrays CompoundCTypes
begin

primrec
  array_tag_n :: "nat \<Rightarrow> ('a::c_type,'b::finite) array typ_info"
where
  atn_base:
  "array_tag_n 0 = ((empty_typ_info (typ_name (typ_uinfo_t TYPE('a)) @ ''_array_'' @
      nat_to_bin_string (CARD('b::finite))))::('a::c_type,'b) array
          typ_info)"
| atn_rec:
  "array_tag_n (Suc n) = ((ti_typ_combine TYPE('a::c_type)
      (\<lambda>x. index x n) (\<lambda>x f. update f n x) (replicate n CHR ''1'')
          (array_tag_n n))::('a,'b::finite) array typ_info)"

definition array_tag :: "('a::c_type,'b::finite) array itself \<Rightarrow> ('a,'b) array typ_info" where
  "array_tag t \<equiv> array_tag_n (CARD('b))"

instance array :: (c_type,finite) c_type ..

overloading typ_info_array \<equiv> typ_info_t begin
definition typ_info_array: "typ_info_array (w::('a::c_type,'b::finite) array itself) \<equiv> array_tag w"
end

lemma field_names_array_tag_length [rule_format]:
  "x \<in> set (field_names_list (array_tag_n n)) \<longrightarrow> length x < n"
  by (induct n) auto

lemma replicate_mem_field_names_array_tag [simp]:
  "replicate n x \<notin> set (field_names_list (array_tag_n n))"
  by (fastforce dest: field_names_array_tag_length)

lemma aggregate_array_tag [simp]:
  "aggregate (array_tag_n n)"
  by (cases n; simp)

lemma wf_desc_array_tag [simp]:
  "wf_desc ((array_tag_n n)::('a::mem_type,'b::finite) array typ_info)"
  by (induct n; simp) (fastforce elim: wf_desc_ti_typ_combine)

lemma wf_size_desc_array_tag [simp]:
  "0 < n \<Longrightarrow> wf_size_desc ((array_tag_n n)::('a::mem_type,'b::finite) array typ_info)"
  apply(induct n; simp)
  apply(case_tac "n=0"; simp)
  apply(rule wf_size_desc_ti_typ_combine)
  apply simp
  done

lemma g_ind_array_tag_udpate [simp]:
  "\<lbrakk> n \<le> m; n \<le> CARD('b) \<rbrakk> \<Longrightarrow>
   g_ind (lf_set ((array_tag_n n)::('a::mem_type,'b::finite) array typ_info) []) (\<lambda>x f. update f m x)"
  by (induct n; fastforce elim: g_ind_ti_typ_combine)

lemma fc_array_tag_udpate [simp]:
  "\<lbrakk> n \<le> m; n \<le> CARD('b) \<rbrakk> \<Longrightarrow>
   fu_commutes (update_ti_t ((array_tag_n n)::('a::mem_type,'b::finite) array typ_info)) (\<lambda>x f. update f m x)"
  by (induct n; fastforce elim: fc_ti_typ_combine simp: fg_cons_def)

lemma f_ind_array_tag_udpate [simp]:
  "\<lbrakk> n \<le> m; m < CARD('b) \<rbrakk> \<Longrightarrow>
   f_ind (\<lambda>x. index x m) (lf_fd ` lf_set ((array_tag_n n)::('a::mem_type,'b::finite) array typ_info) [])"
  by (induct n; fastforce elim: f_ind_ti_typ_combine)

lemma fa_fu_g_array_tag_udpate [simp]:
  "\<lbrakk> n \<le> m; m < CARD('b) \<rbrakk> \<Longrightarrow>
   fa_ind (lf_fd ` lf_set ((array_tag_n n)::('a::mem_type,'b::finite) array typ_info) []) (\<lambda>x f. update f m x)"
  by (induct n; fastforce elim: fa_ind_ti_typ_combine)

lemma wf_fdp_array_tag [simp]:
  "n \<le> CARD('b) \<Longrightarrow> wf_lf (lf_set ((array_tag_n n)::('a::mem_type,'b::finite) array typ_info) [])"
  by (induct n; fastforce elim: wf_lf_ti_typ_combine)

lemma upd_local_update [simp]:
  "upd_local (\<lambda>x f. update f n x)"
  unfolding upd_local_def
  by (metis update_update)

lemma fu_eq_mask_array_tag [simp, rule_format]:
  "n \<le> CARD('b) \<longrightarrow> (\<forall>m. (\<forall>k v. k < CARD('b) \<longrightarrow>
      index ((m v)::('a,'b) array) k = (if n \<le> k then
          index (undefined::('a::mem_type,'b::finite) array) k
          else index v k)) \<longrightarrow> fu_eq_mask (array_tag_n n) m)"
  apply(induct n; clarsimp)
   apply(rule fu_eq_mask_empty_typ_info)
   apply(clarsimp simp: array_index_eq)
  apply(rule fu_eq_mask_ti_typ_combine; clarsimp?)
   apply(drule_tac x="\<lambda>v. update (m v) n (index undefined n)" in spec)
   apply(erule impE)
    apply clarsimp
    apply(case_tac "k=n"; simp)
   apply(subgoal_tac "\<forall>v bs. m (update v n bs) = update (m v) n bs"; clarsimp)
   apply(clarsimp simp: array_index_eq)
   apply(case_tac "i=n"; clarsimp)
   apply(case_tac "Suc n \<le> i"; clarsimp)
  apply(clarsimp simp: fg_cons_def)
  done

lemma size_td_array_tag [simp]:
  "size_td (((array_tag_n n)::('a,'b::finite) array typ_info)) =
      n * size_of TYPE('a::c_type)"
  by (induct n; simp add: size_td_lt_ti_typ_combine size_of_def)

lemma align_td_array_tag:
  "0 < n \<Longrightarrow>
   align_td ((array_tag_n n)::('a,'b::finite) array typ_info) = (align_td (typ_info_t (TYPE('a::c_type))))"
  by (induct n; clarsimp)
     (case_tac "n = 0"; clarsimp simp: align_of_def max_def)

lemma align_field_array [simp]:
  "align_field ((array_tag_n n)::('a::mem_type,'b::finite) array typ_info)"
  by (induct_tac n; clarsimp)
     (metis align_field_ti_typ_combine align_of_def align_size_of dvd_mult size_td_array_tag)

instance array :: (mem_type,finite) mem_type_sans_size
  apply intro_classes
       apply(simp_all add: typ_info_array array_tag_def size_of_def norm_bytes_def)
   apply clarsimp
   apply(rule fu_eq_mask)
    apply(simp add: size_of_def)
   apply(rule fu_eq_mask_array_tag; simp)
  apply (clarsimp simp: align_of_def typ_info_array array_tag_def align_td_array_tag)
  apply (metis align_of_def align_size_of dvd_mult size_of_def)
  done

declare atn_base [simp del]
declare atn_rec [simp del]

lemma size_of_array [simp]:
  "size_of TYPE(('a,'b::finite) array) = CARD('b) * size_of TYPE('a::c_type)"
  by (simp add: size_of_def typ_info_array array_tag_def)

lemma size_td_array:
  "size_td (typ_info_t TYPE(('a,'b::finite) array)) = CARD('b) * size_of TYPE('a::c_type)"
  by (simp add: size_of_def typ_info_array array_tag_def)

lemma align_td_array:
  "2^align_td (typ_info_t TYPE(('a,'b::finite) array)) = align_of TYPE('a::c_type)"
  by (simp add: align_of_def typ_info_array array_tag_def align_td_array_tag)

end


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

(* License: BSD, terms see file ./LICENSE *)

(* FIXME: rename this theory, it's not about 32 any more *)
theory Vanilla32_Preliminaries
imports CTypes
begin

section "Words and Pointers"

instantiation unit :: c_type
begin
instance ..
end

definition "unit_tag \<equiv> TypDesc (TypScalar 1 0
      (\<lparr> field_access = (\<lambda>v bs. [0]), field_update = (\<lambda>bs v. ())\<rparr>)) ''unit''"

declare unit_tag_def [simp]

overloading typ_info_unit \<equiv> typ_info_t begin
  definition typ_info_unit [simp]: "typ_info_unit (x::unit itself) \<equiv> unit_tag"
end

instantiation unit :: mem_type
begin
  definition
    to_bytes_unit :: "unit \<Rightarrow> byte list" where
    "to_bytes_unit a \<equiv> [0]"

  definition
    from_bytes_unit :: "byte list \<Rightarrow> unit" where
    "from_bytes_unit bs \<equiv> ()"

  definition
    size_of_unit :: "unit itself \<Rightarrow> nat" where
    "size_of_unit x \<equiv> 0"

  definition
    align_of_unit :: "unit itself \<Rightarrow> nat" where
    "align_of_unit x \<equiv> 1"

  instance
    apply intro_classes
    apply (auto simp: size_of_def align_of_def align_field_def addr_card
                      wf_lf_def fd_cons_desc_def
                      fd_cons_double_update_def fd_cons_update_access_def
                      fd_cons_access_update_def fd_cons_length_def)
  done
end

definition
  "bogus_log2lessthree (n::nat) ==
             if n = 128 then 4
             else if n = 64 then (3::nat)
             else if n = 32 then 2
             else if n = 16 then 1
             else if n = 8 then 0
             else undefined"
definition
  "len_exp (x::('a::len) itself) \<equiv> bogus_log2lessthree (len_of TYPE('a))"

lemma lx8' [simp] : "len_exp (x::8 itself) = 0"
by (simp add: len_exp_def bogus_log2lessthree_def)

lemma lx16' [simp]: "len_exp (x::16 itself) = 1"
by (simp add: len_exp_def bogus_log2lessthree_def)

lemma lx32' [simp]: "len_exp (x::32 itself) = 2"
by (simp add: len_exp_def bogus_log2lessthree_def)

lemma lx64' [simp]: "len_exp (x::64 itself) = 3"
by (simp add: len_exp_def bogus_log2lessthree_def)

lemma lx_signed' [simp]: "len_exp (x::('a::len) signed itself) = len_exp (TYPE('a))"
  by (simp add: len_exp_def)

class len8 = len +
  (* this constraint gives us (in the most convoluted way possible) that we're only
     interested in words with a length that is divisible by 8 *)
  assumes len8_bytes: "len_of TYPE('a::len) = 8 * (2^len_exp TYPE('a))"
  (* len8_len class gives us that the words are \<le> than 128 bits.
     This is a wacky restriction really, but we're really only interested in words
     up to 64 bits, so who cares. *)
  assumes len8_width: "len_of TYPE('a::len) \<le> 128"
begin

lemma len8_size:
  "len_of TYPE('a) div 8 < addr_card"
  apply(subgoal_tac "len_of TYPE('a) \<le> 128")
   apply(simp add: addr_card)
  apply(rule len8_width)
  done

lemma len8_dv8:
  "8 dvd len_of TYPE('a)"
  by (simp add: len8_bytes)

lemma len8_pow:
  "\<exists>k. len_of TYPE('a) div 8 = 2^k"
  by (simp add: len8_bytes)

end

fun
  nat_to_bin_string :: "nat \<Rightarrow> char list"
  where
  ntbs: "nat_to_bin_string n = (if (n = 0) then ''0'' else (if n mod 2 = 1 then CHR ''1'' else CHR ''0'') # nat_to_bin_string (n div 2))"

declare nat_to_bin_string.simps [simp del]

lemma nat_to_bin_string_simps:
  "nat_to_bin_string 0 = ''0''"
  "n > 0 \<Longrightarrow> nat_to_bin_string n =
      (if n mod 2 = 1 then CHR ''1'' else CHR ''0'') # nat_to_bin_string (n div 2)"
  apply (induct n, auto simp: nat_to_bin_string.simps)
  done

instantiation word :: (len8) c_type
begin
instance ..
end

instance signed :: (len8) len8
  apply intro_classes
   apply (metis len8_bytes len_exp_def len_signed)
  apply (metis len8_width len_signed)
  done

end


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

header{*The n_german Protocol Case Study*}

theory n_german_lemma_inv__8_on_rules imports n_german_lemma_on_inv__8
begin
section{*All lemmas on causal relation between inv__8*}
lemma lemma_inv__8_on_rules:
  assumes b1: "r \<in> rules N" and b2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__8  p__Inv4)"
  shows "invHoldForRule s f r (invariants N)"
  proof -
  have c1: "(\<exists> j. j\<le>N\<and>r=n_SendReqS  j)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendReqEI  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendReqES  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvReq N i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendInvE  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendInvS  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendInvAck  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvInvAck  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendGntS  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendGntE N i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvGntS  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvGntE  i)\<or>
    (\<exists> i d. i\<le>N\<and>d\<le>N\<and>r=n_Store  i d)"
  apply (cut_tac b1, auto) done
    moreover {
      assume d1: "(\<exists> j. j\<le>N\<and>r=n_SendReqS  j)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendReqSVsinv__8) done
    }

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

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

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

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

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

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

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

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

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

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

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

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

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

end


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

header{*The n_german Protocol Case Study*}

theory n_german_lemma_inv__1_on_rules imports n_german_lemma_on_inv__1
begin
section{*All lemmas on causal relation between inv__1*}
lemma lemma_inv__1_on_rules:
  assumes b1: "r \<in> rules N" and b2: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__1  p__Inv3 p__Inv4)"
  shows "invHoldForRule s f r (invariants N)"
  proof -
  have c1: "(\<exists> j. j\<le>N\<and>r=n_SendReqS  j)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendReqEI  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendReqES  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvReq N i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendInvE  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendInvS  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendInvAck  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvInvAck  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendGntS  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendGntE N i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvGntS  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvGntE  i)\<or>
    (\<exists> i d. i\<le>N\<and>d\<le>N\<and>r=n_Store  i d)"
  apply (cut_tac b1, auto) done
    moreover {
      assume d1: "(\<exists> j. j\<le>N\<and>r=n_SendReqS  j)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendReqSVsinv__1) done
    }

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

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

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

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

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

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

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

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

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

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

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

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

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

end