           (*-------------------------------------------*
            |        CSP-Prover on Isabelle2005         |
            |               December 2005               |
            |                  April 2006  (modified)   |
            |                  March 2007  (modified)   |
            |                                           |
            |        Yoshinao Isobe (AIST JAPAN)        |
            *-------------------------------------------*)

theory CSP_F_law_DIV
imports CSP_F_law_basic CSP_T.CSP_T_law_DIV
begin

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

         1. DIV |[X]| DIV
         2. DIV |[X]| P
         3. P |[X]| DIV
         4. DIV -- X
         5. DIV [[r]]
         6. DIV ;; P
         7. P ;; DIV
         8. DIV |. n

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

(*********************************************************
                       DIV |[X]| DIV
 *********************************************************)

lemma cspF_DIV_Parallel:
   "DIV |[X]| DIV =F[M1,M2] DIV"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_DIV_Parallel)
apply (rule order_antisym)
apply (rule, simp add: in_failures)+
done

(*********************************************************
                       DIV |[X]| P
 *********************************************************)

lemma cspF_DIV_Parallel_step_l:
   "DIV |[X]| (? :Y -> Qf) =F[M,M] (? x:(Y-X) -> (DIV |[X]| Qf x)) [+] DIV"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_DIV_Parallel_step_l)
apply (rule order_antisym)

(* => *)
 apply (rule)
 apply (simp add: in_failures)

(* <= *)
 apply (rule)
 apply (simp add: in_failures)
 apply (elim conjE exE disjE)
 apply (simp_all add: in_traces)
done

lemma cspF_DIV_Parallel_step_r:
   "(? :Y -> Qf) |[X]| DIV =F[M,M] (? x:(Y-X) -> (Qf x |[X]| DIV)) [+] DIV"
apply (rule cspF_rw_left)
apply (rule cspF_commut)
apply (rule cspF_rw_right)
apply (rule cspF_decompo)
apply (rule cspF_decompo)
apply (simp)
apply (rule cspF_commut)
apply (rule cspF_reflex)
apply (rule cspF_DIV_Parallel_step_l)
done

lemmas cspF_DIV_Parallel_step =
       cspF_DIV_Parallel_step_l cspF_DIV_Parallel_step_r

(*********************************************************
                      DIV and Parallel
 *********************************************************)

lemma cspF_DIV_Parallel_Ext_choice_DIV_l:
  "(P [+] DIV) |[X]| DIV =F[M,M] (P |[X]| DIV)"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_DIV_Parallel_Ext_choice_DIV_l)
apply (rule order_antisym)

(* => *)
 apply (rule, simp add: in_failures)

(* <= *)
 apply (rule, simp add: in_failures)
done

lemma cspF_DIV_Parallel_Ext_choice_DIV_r:
  "DIV |[X]| (P [+] DIV) =F[M,M] (DIV |[X]| P)"
apply (rule cspF_rw_left)
apply (rule cspF_commut)
apply (rule cspF_rw_left)
apply (rule cspF_DIV_Parallel_Ext_choice_DIV_l)
apply (rule cspF_commut)
done

lemmas cspF_DIV_Parallel_Ext_choice_DIV =
       cspF_DIV_Parallel_Ext_choice_DIV_l
       cspF_DIV_Parallel_Ext_choice_DIV_r

(*********************************************************
                      DIV -- X
 *********************************************************)

lemma cspF_DIV_Hiding_Id:
   "DIV -- X =F[M1,M2] DIV"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_DIV_Hiding_Id)
apply (rule order_antisym)

(* => *)
 apply (rule)
 apply (simp add: in_failures)

(* <= *)
 apply (rule)
 apply (simp add: in_failures)
done

(*** div-hide-step ***)

lemma cspF_DIV_Hiding_step:
  "((? :Y -> Pf) [+] DIV) -- X =F[M,M]
   (((? x:(Y-X) -> (Pf x -- X)) [+] DIV) |~| (! x:(Y Int X) .. (Pf x -- X)))"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_DIV_Hiding_step)
apply (rule order_antisym)

(* => *)
 apply (rule, simp add: in_failures)
 apply (elim conjE exE disjE)
 apply (simp_all)
 apply (simp_all add: in_traces)

  apply (case_tac "a : X")
  apply (simp)
  apply (blast)
  apply (force)

(* <= *)
 apply (rule)
  apply (simp add: in_failures)
  apply (elim conjE exE bexE disjE)
  apply (simp_all)

   apply (rule_tac x="<Ev a> ^^^ sb" in exI)
   apply (simp)

   apply (simp add: in_traces)

   apply (rule_tac x="<>" in exI)
   apply (simp add: Evset_def)
   apply (fast)

   apply (rule_tac x="<Ev a> ^^^ sa" in exI)
   apply (simp)
done

(*********************************************************
                      DIV [[r]]
 *********************************************************)

lemma cspF_DIV_Renaming_Id:
   "DIV [[r]] =F[M1,M2] DIV"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_DIV_Renaming_Id)
apply (rule order_antisym)

(* => *)
 apply (rule)
 apply (simp add: in_failures)

(* <= *)
 apply (rule)
 apply (simp add: in_failures)
done

(*********************************************************
                       DIV ;; P
 *********************************************************)

lemma cspF_DIV_Seq_compo: "DIV ;; P =F[M1,M2] DIV"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_DIV_Seq_compo)
apply (rule order_antisym)

(* => *)
 apply (rule, simp add: in_failures)
 apply (elim conjE exE)
 apply (simp add: in_traces)

(* <= *)
 apply (rule, simp add: in_failures)
done

(*********************************************************
               DIV and Sequential composition
 *********************************************************)

lemma cspF_DIV_Seq_compo_step:
  "((? :X -> Pf) [> DIV) ;; Q =F[M,M] (? x:X -> (Pf x ;; Q)) [> DIV"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_DIV_Seq_compo_step)
apply (rule order_antisym)

(* => *)
 apply (rule, simp add: in_failures in_traces)
 apply (elim conjE exE disjE)
 apply (simp_all)

 apply (insert trace_nil_or_Tick_or_Ev)
 apply (drule_tac x="sa" in spec)

 apply (elim disjE conjE exE)
  apply (simp_all)
  apply (simp add: appt_assoc)
  apply (rule disjI2)
  apply (rule_tac x="sc" in exI)
  apply (rule_tac x="t" in exI)
  apply (simp)

(* <= *)
 apply (rule, simp add: in_failures in_traces)
 apply (elim conjE exE disjE)
 apply (simp_all)

  apply (rule disjI2)
  apply (rule_tac x="<Ev a> ^^^ sb" in exI)
  apply (rule_tac x="t" in exI)
  apply (simp add: appt_assoc)
done

(*********************************************************
                      DIV |. n
 *********************************************************)

lemma cspF_DIV_Depth_rest:
   "DIV |. n =F[M1,M2] DIV"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_DIV_Depth_rest)
apply (rule order_antisym)

(* => *)
 apply (rule)
 apply (simp add: in_failures)

(* <= *)
 apply (rule)
 apply (simp add: in_failures)
done

(*********************************************************
                      cspF_DIV
 *********************************************************)

lemmas cspF_DIV =
       cspF_DIV_Parallel
       cspF_DIV_Parallel_step
       cspF_DIV_Parallel_Ext_choice_DIV
       cspF_DIV_Hiding_Id
       cspF_DIV_Hiding_step
       cspF_DIV_Renaming_Id
       cspF_DIV_Seq_compo
       cspF_DIV_Seq_compo_step
       cspF_DIV_Depth_rest

(*********************************************************
                       P [+] DIV
 *********************************************************)

lemma cspF_Ext_choice_DIV_resolve: "P [+] DIV =F[M,M] P [> DIV"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Ext_choice_DIV_resolve)
apply (rule order_antisym)

(* => *)
 apply (rule, simp add: in_failures)
 apply (simp add: in_traces)
 apply (force)

(* <= *)
 apply (rule, simp add: in_traces in_failures)
 apply (force)
done

end


(*  Title:      statecharts/SA/Expr.thy

    Author:     Steffen Helke, Software Engineering Group
    Copyright   2010 Technische Universitaet Berlin
*)

section \<open>Label Expressions\<close>
theory Expr
imports Update
begin

datatype ('s,'e)expr = true
                        | In 's
                        | En 'e
                        | NOT "('s,'e)expr"
                        | And "('s,'e)expr" "('s,'e)expr"
                        | Or  "('s,'e)expr" "('s,'e)expr"

type_synonym 'd guard = "('d data) => bool"
type_synonym ('e,'d)action = "('e set * 'd pupdate)"
type_synonym ('s,'e,'d)label = "(('s,'e)expr * 'd guard * ('e,'d)action)"
type_synonym ('s,'e,'d)trans = "('s * ('s,'e,'d)label * 's)"

primrec
   eval_expr :: "[('s set * 'e set), ('s,'e)expr] \<Rightarrow> bool" where
     "eval_expr sc true          = True"
   | "eval_expr sc (En ev)       = (ev \<in> snd sc)"
   | "eval_expr sc (In st)       = (st \<in> fst sc)"
   | "eval_expr sc (NOT e1)      = (\<not> (eval_expr sc e1))"
   | "eval_expr sc (And e1 e2)   = ((eval_expr sc e1) \<and> (eval_expr sc e2))"
   | "eval_expr sc (Or  e1 e2)   = ((eval_expr sc e1) \<or> (eval_expr sc e2))"

primrec
   ExprEvents :: "('s,'e)expr \<Rightarrow> 'e set" where
      "ExprEvents true        = {}"
   |  "ExprEvents (En ev)     = {ev}"
   |  "ExprEvents (In st)     = {}"
   |  "ExprEvents (NOT e)     = (ExprEvents e)"
   |  "ExprEvents (And e1 e2) = ((ExprEvents e1) \<union> (ExprEvents e2))"
   |  "ExprEvents (Or  e1 e2) = ((ExprEvents e1) \<union> (ExprEvents e2))"

(* atomar propositions for Sequential Automata, will be necessary for CTL-interpretation *)

datatype ('s, 'e, dead 'd)atomar =
                          TRUE
                          | FALSE
                          | IN 's
                          | EN 'e
                          | VAL "'d data => bool"

definition
  source     :: "('s,'e,'d)trans => 's" where
  "source t  = fst t"

definition
   Source     :: "('s,'e,'d)trans set => 's set" where
  "Source T == source ` T"

definition
   target     :: "('s,'e,'d)trans => 's" where
  "target t  = snd(snd t)"

definition
   Target     :: "('s,'e,'d)trans set => 's set" where
  "Target T = target ` T"

definition
   label      :: "('s,'e,'d)trans => ('s,'e,'d)label" where
  "label t  = fst (snd t)"

definition
   Label      :: "('s,'e,'d)trans set => ('s,'e,'d)label set" where
  "Label T = label ` T"

definition
   expr       :: "('s,'e,'d)label => ('s,'e)expr" where
  "expr  = fst"

definition
   action     :: "('s,'e,'d)label  => ('e,'d)action" where
  "action = snd o snd"

definition
   Action     :: "('s,'e,'d)label set => ('e,'d)action set" where
  "Action L = action ` L"

definition
   pupdate     :: "('s,'e,'d)label => 'd pupdate" where
  "pupdate   = snd o action"

definition
  PUpdate     :: "('s,'e,'d)label set => ('d pupdate) set" where
  "PUpdate L = pupdate ` L"

definition
   actevent   :: "('s,'e,'d)label => 'e set" where
  "actevent  = fst o action"

definition
   Actevent   :: "('s,'e,'d)label set => ('e set) set" where
  "Actevent L = actevent ` L"

definition
   guard      :: "('s,'e,'d)label  => 'd guard" where
  "guard = fst o snd"

definition
   Guard      :: "('s,'e,'d)label set => ('d guard) set" where
  "Guard L = guard ` L"

definition
   defaultexpr :: "('s,'e)expr" where
  "defaultexpr = true"

definition
   defaultaction :: "('e,'d)action" where
  "defaultaction = ({},DefaultPUpdate)"

definition
   defaultguard :: "('d guard)" where
  "defaultguard = (\<lambda> d. True)"

definition
   defaultlabel :: "('s,'e,'d)label" where
  "defaultlabel = (defaultexpr, defaultguard, defaultaction)"

definition
   eval :: "[('s set * 'e set * 'd data), ('s,'e,'d)label] => bool"
                                                       ("_ |= _" [91,90]90) where
  "eval scd l = (let (s,e,d) = scd
                 in
                    ((eval_expr (s,e) (expr l)) \<and> ((guard l) d)))"

lemma Source_EmptySet [simp]:
 "Source {} = {}"
by (unfold Source_def, auto)

lemma Target_EmptySet [simp]:
 "Target {} = {}"
by (unfold Target_def, auto)

lemma Label_EmptySet [simp]:
 "Label {} = {}"
by (unfold Label_def, auto)

lemma Action_EmptySet [simp]:
 "Action {} = {}"
by (unfold Action_def, auto)

lemma PUpdate_EmptySet [simp]:
 "PUpdate {} = {}"
by (unfold PUpdate_def, auto)

lemma Actevent_EmptySet [simp]:
 "Actevent {} = {}"
by (unfold Actevent_def, auto)

lemma Union_Actevent_subset:
  "\<lbrakk> m \<in> M; ((\<Union> (Actevent (Label (Union M)))) \<subseteq> (N::'a set)) \<rbrakk> \<Longrightarrow>
   ((\<Union> (Actevent (Label m))) \<subseteq> N)"
by (unfold Actevent_def Label_def, auto)

lemma action_select [simp]:
 "action (a,b,c) = c"
by (unfold action_def, auto)

lemma label_select [simp]:
 "label (a,b,c) = b"
by (unfold label_def, auto)

lemma target_select [simp]:
 "target (a,b,c) = c"
by (unfold target_def, auto)

lemma actevent_select [simp]:
 "actevent (a,b,(c,d)) = c"
by (unfold actevent_def, auto)

lemma pupdate_select [simp]:
 "pupdate (a,b,c,d) = d"
by (unfold pupdate_def, auto)

lemma source_select [simp]:
 "source (a,b) = a"
by (unfold source_def, auto)

lemma finite_PUpdate [simp]:
 "finite S \<Longrightarrow> finite(PUpdate S)"
by (unfold PUpdate_def, auto)

lemma finite_Label [simp]:
 "finite S \<Longrightarrow> finite(Label S)"
by (unfold Label_def, auto)

lemma fst_defaultaction [simp]:
 "fst defaultaction = {}"
by (unfold defaultaction_def, auto)

lemma action_defaultlabel [simp]:
 "(action defaultlabel) = defaultaction"
by (unfold defaultlabel_def action_def, auto)

lemma fst_defaultlabel [simp]:
 "(fst defaultlabel) = defaultexpr"
by (unfold defaultlabel_def, auto)

lemma ExprEvents_defaultexpr [simp]:
 "(ExprEvents defaultexpr) = {}"
by (unfold defaultexpr_def, auto)

lemma defaultlabel_defaultexpr [simp]:
 "expr defaultlabel = defaultexpr"
by (unfold defaultlabel_def expr_def, auto)

lemma target_Target [simp]:
  "t \<in> T \<Longrightarrow> target t \<in> Target T"
by (unfold Target_def, auto)

lemma Source_union : "Source s \<union> Source t = Source (s \<union> t)"
apply (unfold Source_def)
apply auto
done

lemma Target_union : "Target s \<union> Target t = Target (s \<union> t)"
apply (unfold Target_def)
apply auto
done

end


(*
Copyright 2009-2014 Christian Sternagel, René Thiemann

This file is part of IsaFoR/CeTA.

IsaFoR/CeTA is free software: you can redistribute it and/or modify it under the
terms of the GNU Lesser General Public License as published by the Free Software
Foundation, either version 3 of the License, or (at your option) any later
version.

IsaFoR/CeTA is distributed in the hope that it will be useful, but WITHOUT ANY
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
PARTICULAR PURPOSE.  See the GNU Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public License along
with IsaFoR/CeTA. If not, see <http://www.gnu.org/licenses/>.
*)

section \<open>Instances of the Show Class for Standard Types\<close>

theory Old_Show_Instances
imports
  Old_Show_Generator
  HOL.Rat
begin

text \<open>
  For several types, we just derive the show function.
\<close>

derive "show" bool option sum

text \<open>
  The derive-command is not used for @{type unit}, @{type prod}, and numbers: for @{type unit} and
  @{type prod}, we do not want to display ``Unity'' and ``Pair''; for @{type nat}, we do not want to
  display ``Suc (Suc ... Suc (0))''; and neither @{type int} nor @{type rat} are datatypes.
\<close>

instantiation unit :: "show"
begin

definition "shows_prec d (x::unit) = shows_string ''()''"

lemma assoc_unit:
  "shows_prec d (x::unit) r @ s = shows_prec d x (r @ s)"
  by (simp add: shows_prec_unit_def)

standard_shows_list assoc_unit

end

instantiation prod :: ("show", "show") "show"
begin

definition "shows_prec d (p :: 'a \<times> 'b) = shows_paren (shows (fst p) +@+ '','' +#+ shows (snd p))"

lemma assoc_prod:
  "shows_prec d (p::('a::show \<times> 'b::show)) r @ s = shows_prec d p (r @ s)"
  by (cases p) (simp add: shows_prec_prod_def show_defs)

standard_shows_list assoc_prod

end

instantiation nat :: "show"
begin

fun
  digit2string :: "nat \<Rightarrow> string"
where
  "digit2string n = (
    if n = 0 then ''0''
    else if n = 1 then ''1''
    else if n = 2 then ''2''
    else if n = 3 then ''3''
    else if n = 4 then ''4''
    else if n = 5 then ''5''
    else if n = 6 then ''6''
    else if n = 7 then ''7''
    else if n = 8 then ''8''
    else ''9'')"

fun shows_nat :: "nat \<Rightarrow> shows"
where
  "shows_nat (n::nat) = (
    if n < 10 then shows_string (digit2string n)
    else shows_nat (n div 10) \<circ> shows_string (digit2string (n mod 10)))"

definition "shows_prec (d::nat) (n::nat) = shows_nat n"

lemma assoc_nat: "shows_prec d (n::nat) r @ s = shows_prec d n (r @ s)"
proof (induct n arbitrary: r s rule: nat_less_induct)
  case (1 n)
  show ?case
  proof (cases "n < 10")
    case True thus ?thesis unfolding shows_prec_nat_def by simp
  next
    let ?m = "n div 10"
    case False
    hence "?m < n" by simp
    with 1 have "\<And>s t. shows_prec d ?m s @ t = shows_prec d ?m (s @ t)" by simp
    thus ?thesis unfolding shows_prec_nat_def by auto
  qed
qed

standard_shows_list assoc_nat

end

instantiation int :: "show"
begin

definition "shows_prec (d::nat) (i::int) = (
  if i < 0 then shows (CHR ''-'') \<circ> shows (nat (- i))
  else shows (nat i))"

lemma assoc_int:
  "shows_prec d (i::int) r @ s = shows_prec d i (r @ s)"
  by (simp add: shows_prec_int_def)

standard_shows_list assoc_int

end

instantiation rat :: "show"
begin

definition "shows_prec (d::nat) (x::rat) =
  (case quotient_of x of
    Pair den num \<Rightarrow>
    if num = 1 then shows den else shows den \<circ> shows (CHR ''/'') \<circ> shows num)"

lemma assoc_rat:
  "shows_prec d (x::rat) r @ s = shows_prec d x (r @ s)"
  unfolding shows_prec_rat_def by (cases "quotient_of x") auto

standard_shows_list assoc_rat

end

end


theory Scratch
imports Main

begin

theorem A: "A \<longrightarrow> A \<or> B"
apply (rule impI)
apply (rule disjI1)
apply assumption
done

theorem B: "A \<or> B \<longrightarrow> B \<or> A"
apply (rule impI)
apply (erule disjE)
apply (rule disjI2)
apply assumption
apply (rule disjI1)
apply assumption
done

\<lbrakk> \<rbrakk>
\<not>
\<longrightarrow>
\<longleftrightarrow>
\<rightarrow>
\<Rightarrow>

\<forall>
\<exists>
\<and> \<or> \<Longrightarrow>
\<rightleftharpoons>

end


header {* \isaheader{Dynamic data dependence} *}

theory DynDataDependence imports CFG_wf begin

context CFG_wf begin

definition dyn_data_dependence ::
  "'node \<Rightarrow> 'var \<Rightarrow> 'node \<Rightarrow> 'edge list \<Rightarrow> bool" ("_ influences _ in _ via _" [51,0,0])
where "n influences V in n' via as \<equiv>
    ((V \<in> Def n) \<and> (V \<in> Use n') \<and> (n -as\<rightarrow>* n') \<and>
     (\<exists>a' as'. (as = a'#as') \<and> (\<forall>n'' \<in> set (sourcenodes as'). V \<notin> Def n'')))"

lemma dyn_influence_Cons_source:
  "n influences V in n' via a#as \<Longrightarrow> sourcenode a = n"
  by(simp add:dyn_data_dependence_def,auto elim:path.cases)

lemma dyn_influence_source_notin_tl_edges:
  assumes "n influences V in n' via a#as"
  shows "n \<notin> set (sourcenodes as)"
proof(rule ccontr)
  assume "\<not> n \<notin> set (sourcenodes as)"
  hence "n \<in> set (sourcenodes as)" by simp
  from `n influences V in n' via a#as` have "\<forall>n'' \<in> set (sourcenodes as). V \<notin> Def n''"
    and "V \<in> Def n" by(simp_all add:dyn_data_dependence_def)
  from `\<forall>n'' \<in> set (sourcenodes as). V \<notin> Def n''`
    `n \<in> set (sourcenodes as)` have "V \<notin> Def n" by simp
  with `V \<in> Def n` show False by simp
qed

lemma dyn_influence_only_first_edge:
  assumes "n influences V in n' via a#as" and "preds (kinds (a#as)) s"
  shows "state_val (transfers (kinds (a#as)) s) V =
         state_val (transfer (kind a) s) V"
proof -
  from `preds (kinds (a#as)) s` have "preds (kinds as) (transfer (kind a) s)"
    by(simp add:kinds_def)
  from `n influences V in n' via a#as` have "n -a#as\<rightarrow>* n'"
    and "\<forall>n'' \<in> set (sourcenodes as). V \<notin> Def n''"
    by(simp_all add:dyn_data_dependence_def)
  from `n -a#as\<rightarrow>* n'` have "n = sourcenode a" and "targetnode a -as\<rightarrow>* n'"
    by(auto elim:path_split_Cons)
  from `n influences V in n' via a#as` `n = sourcenode a`
  have "sourcenode a \<notin> set (sourcenodes as)"
    by(fastforce intro!:dyn_influence_source_notin_tl_edges)
  { fix n'' assume "n'' \<in> set (sourcenodes as)"
    with `sourcenode a \<notin> set (sourcenodes as)` `n = sourcenode a`
    have "n'' \<noteq> n" by(fastforce simp:sourcenodes_def)
    with `\<forall>n'' \<in> set (sourcenodes as). V \<notin> Def n''` `n'' \<in> set (sourcenodes as)`
    have "V \<notin> Def n''" by(auto simp:sourcenodes_def) }
  hence "\<forall>n'' \<in> set (sourcenodes as). V \<notin> Def n''" by simp
  with `targetnode a -as\<rightarrow>* n'` `preds (kinds as) (transfer (kind a) s)`
  have "state_val (transfers (kinds as) (transfer (kind a) s)) V =
        state_val (transfer (kind a) s) V"
    by -(rule CFG_path_no_Def_equal)
  thus ?thesis by(auto simp:kinds_def)
qed

end

end


theory IBC
  imports Refinement
begin

datatype action = scan | eval |submit
typedecl actor
type_synonym identity = string
consts Actor :: "string => actor"
type_synonym policy = "((actor => bool) * action set)"

type_synonym data = string
  (* Inspired by Myers DLM mode: first is the owner of a data item, second is the
     set of all actors that may access the data item *)
type_synonym dlm = "identity * identity set"

(* type of functions that preserves the security labeling *)
typedef label_fun = "{f :: dlm * data \<Rightarrow> dlm * data.
                        \<forall> x:: dlm * data. fst x = fst (f x)}"
proof (auto)
  show "\<exists>x::(identity \<times> identity set) \<times> string \<Rightarrow> (identity \<times> identity set) \<times> string.
       \<forall>(a::identity) (b::identity set) ba::string. (a, b) = fst (x ((a, b), ba))"
  by (rule_tac x = id in exI, simp)
qed

datatype node = Node nat

(* In this efficient modeling of ledger (cf older versions), we have a unique
(dlm * node set) for each data -- if it is defined --, that is, a data has a unique label and
one set of locations where it occurs.
There is redundancy in this representation compared to the above one:
the fact that there is no label assigned to a data item may be
recorded as lg(d) = None or lg(d) = (l,{}) for any label l.
I don't see why this should cause confusion.
*)
type_synonym ledger = \<open>data \<Rightarrow> (dlm \<times> node set)option\<close>

lemma ledger_def_prop: "\<forall> lg:: ledger. \<forall> d:: data.
     lg d = None | (\<exists>! lL. lg d = Some(lL))"
  by force

lemma prod_exu: \<open>\<forall> p:: ('a * 'b). \<exists>! a. \<exists>! b. p = (a,b)\<close>
  by auto

lemma ledger_def_prop'[rule_format]: "\<forall> lg:: ledger. \<forall> d:: data.
     lg d = None | (\<exists>! l. (\<exists>! L. lg d = Some(l, L)))"
  apply (rule allI)+
  apply (case_tac "lg d")
   apply (erule disjI1)
  apply(rule disjI2)
  by (auto simp: ledger_def_prop prod_exu)

thm dom_def inj_on_def
typedef label_fun' = \<open>{f:: data \<Rightarrow> data. inj f}\<close>
by auto

typedef label_funl = \<open>{fl:: ((data \<Rightarrow> data) \<times> ledger). (\<forall> x. (snd fl)((fst fl) x) = snd fl x)}\<close>
by auto

(*  the data function of the label preserving ledger function*)
definition dfunl :: "label_funl \<Rightarrow> (data \<Rightarrow> data)"
  where "dfunl fl = (fst (Rep_label_funl fl))"

definition lgfunl :: "label_funl \<Rightarrow> ledger"
  where "lgfunl fl = (snd (Rep_label_funl fl))"

(* apply a label preserving function to a ledger to change the ledger*)
definition label_funl_ledger_app :: "label_funl \<Rightarrow> ledger \<Rightarrow> ledger" ("_ \<lozenge> _" 50)
  where "f \<lozenge> l \<equiv> l \<circ> (dfunl f)"

lemma funl_appl: "x \<in> dom(lgfunl fl) \<Longrightarrow> (lgfunl fl x) = lgfunl fl ((dfunl fl) x)"
  using Rep_label_funl dfunl_def lgfunl_def by auto

(* functions in a smart contract can be such that they change the labelled data
   or not *)
datatype sc_fun = Nochange "label_funl" | Change "dlm * data \<Rightarrow> dlm * data" |
                  Send "identity * identity * dlm * data" |
                  Receive "identity * identity * dlm * data"

type_synonym transaction_record = "sc_fun list"

datatype igraph = Lgraph "(node * node)set" "node \<Rightarrow> identity set"
                         "actor \<Rightarrow> (string set * string set)"  "node \<Rightarrow> string"
                         "ledger" "node \<Rightarrow> transaction_record"
datatype infrastructure =
         Infrastructure "igraph"
                        "[igraph ,node] \<Rightarrow> policy set"
primrec loc :: "node \<Rightarrow> nat"
where  "loc(Node n) = n"
primrec gra :: "igraph \<Rightarrow> (node * node)set"
where  "gra(Lgraph g a c l ld tr) = g"
primrec agra :: "igraph \<Rightarrow> (node \<Rightarrow> identity set)"
where  "agra(Lgraph g a c l ld tr) = a"
primrec cgra :: "igraph \<Rightarrow> (actor \<Rightarrow> string set * string set)"
where  "cgra(Lgraph g a c l ld tr) = c"
primrec lgra :: "igraph \<Rightarrow> (node \<Rightarrow> string)"
  where  "lgra(Lgraph g a c l ld tr) = l"
primrec ledgra :: "igraph \<Rightarrow> ledger"
  where  "ledgra(Lgraph g a c l ld tr) = ld"
primrec trec :: "igraph \<Rightarrow> node \<Rightarrow> transaction_record"
  where "trec(Lgraph g a c l ld tr) = tr"

definition nodes :: "igraph \<Rightarrow> node set"
where "nodes g == { x. (? y. ((x,y): gra g) | ((y,x): gra g))}"

definition actors_graph :: "igraph \<Rightarrow> identity set"
where  "actors_graph g == {x. ? y. y : nodes g \<and> x \<in> (agra g y)}"

primrec graphI :: "infrastructure \<Rightarrow> igraph"
where "graphI (Infrastructure g d) = g"
primrec delta :: "[infrastructure, igraph, node] \<Rightarrow> policy set"
where "delta (Infrastructure g d) = d"
primrec tspace :: "[infrastructure, actor ] \<Rightarrow> string set * string set"
  where "tspace (Infrastructure g d) = cgra g"
primrec lspace :: "[infrastructure, node ] \<Rightarrow> string"
where "lspace (Infrastructure g d) = lgra g"
definition credentials :: "string set * string set \<Rightarrow> string set"
  where  "credentials lxl \<equiv> (fst lxl)"
definition has :: "[igraph, actor * string] \<Rightarrow> bool"
  where "has G ac \<equiv> snd ac \<in> credentials(cgra G (fst ac))"
definition roles :: "string set * string set \<Rightarrow> string set"
  where  "roles lxl \<equiv> (snd lxl)"
definition role :: "[igraph, actor * string] \<Rightarrow> bool"
  where "role G ac \<equiv> snd ac \<in> roles(cgra G (fst ac))"

definition isin :: "[igraph,node, string] \<Rightarrow> bool"
  where "isin G l s \<equiv> s = (lgra G l)"

definition owner :: "dlm * data \<Rightarrow> identity" where "owner d \<equiv> fst(fst d)"

definition owns :: "[igraph, node, identity, dlm * data] \<Rightarrow> bool"
  where "owns G l a d \<equiv> owner d = a"

definition readers :: "dlm * data \<Rightarrow> identity set"
  where "readers d \<equiv> snd (fst d)"

definition has_access :: "[igraph, node, identity, dlm * data] \<Rightarrow> bool"
where "has_access G l a d \<equiv> owns G l a d \<or> a \<in> readers d"

definition atI :: "[identity, igraph, node] \<Rightarrow> bool" ("_ @\<^bsub>(_)\<^esub> _" 50)
where "a @\<^bsub>G\<^esub> l \<equiv> a \<in> (agra G l)"

definition enables :: "[infrastructure, node, actor, action] \<Rightarrow> bool"
where
"enables I l a a' \<equiv>  (\<exists> (p,e) \<in> delta I (graphI I) l. a' \<in> e \<and> p a)"

(*
datatype inter_trans = Intra "infrastructure" "sc_fun"
                     | Inter "infrastructure" "infrastructure" "sc_fun"

datatype ibc_protocol = Protocol "inter_trans list set"
*)
datatype ibc_protocol = Protocol "sc_fun list set"

datatype blockchainset = Infs "ibc_protocol" "infrastructure list" "infrastructure"

primrec the_ibc :: "blockchainset \<Rightarrow> ibc_protocol"
  where
"the_ibc (Infs ibc Il rl) = ibc"

(* primrec the_prot :: "ibc_protocol \<Rightarrow> inter_trans list set" *)
primrec the_prot :: "ibc_protocol \<Rightarrow> sc_fun list set"
  where
"the_prot (Protocol evs) = evs"

primrec the_Il :: "blockchainset \<Rightarrow> infrastructure list"
  where
"the_Il (Infs ibc Il rl) = Il"

definition upd_ld
  where "upd_ld d lN I =
(Infrastructure (Lgraph (gra (graphI I))(agra (graphI I))(cgra (graphI I))(lgra (graphI I))
                          ((ledgra (graphI I))(d := Some lN))(trec (graphI I)))
                   (delta I))"

primrec upd_Il :: "data \<Rightarrow> dlm * node set \<Rightarrow> infrastructure list \<Rightarrow> infrastructure list"
  where
  upd_Il_start: "upd_Il d lN [] =  []" |
  upd_Il_step: "upd_Il d lN (I # Il) = (upd_ld d lN I) # (upd_Il d lN Il)"

(* definition trcs :: "blockchainset \<Rightarrow> inter_trans list set" *)
definition trcs :: "blockchainset \<Rightarrow> sc_fun list set"
  where
"trcs bc = the_prot(the_ibc bc)"

primrec relayer :: "blockchainset \<Rightarrow> infrastructure"
  where
"relayer (Infs ibc Il rl) = rl"

definition bc_upd
  where \<open>bc_upd d lN bcs = Infs (the_ibc bcs)(upd_Il d lN (the_Il bcs))
                                             (upd_ld d lN (relayer bcs))\<close>

primrec replace :: "infrastructure \<Rightarrow> infrastructure \<Rightarrow> blockchainset \<Rightarrow> blockchainset"
  where
replace_def: "replace I' I (Infs ibc Il rl) =
               (Infs ibc (if (I \<notin> set Il) then Il
                          else (I' # (remove1 I Il))
                         ) rl)"
(*              (Infs ibc (case Il of
                          [] \<Rightarrow> []
                        | _  \<Rightarrow> (I' # (remove1 I Il))
                        ) rl)"
*)

primrec inbc :: "infrastructure \<Rightarrow> blockchainset \<Rightarrow> bool"
  where
inbc_def: "inbc I (Infs ibc Il rl) = (I \<in> (set Il))"

(* definition insertp :: "inter_trans list \<Rightarrow> blockchainset \<Rightarrow> blockchainset" *)
definition insertp :: "sc_fun list \<Rightarrow> blockchainset \<Rightarrow> blockchainset"
  where
"insertp l bc \<equiv> Infs (Protocol(insert l (the_prot (the_ibc bc))))(the_Il bc)(relayer bc)"

primrec replrel :: "infrastructure \<Rightarrow> blockchainset \<Rightarrow> blockchainset"
  where
replrel_def: "replrel rl' (Infs ibc Il rl) = Infs ibc Il rl'"

definition relrole
  where "relrole I a = role (graphI I) (a, ''relayer'')"

(* abstract constant to express consensus about the successor state*)
consts Consensus :: "infrastructure \<Rightarrow> blockchainset \<Rightarrow> blockchainset"

definition global_consistency
  where
 "global_consistency Il \<equiv> (\<forall> I I'. inbc I Il \<longrightarrow> inbc I' Il \<longrightarrow>
       (\<forall> d. (ledgra (graphI I') d) = (ledgra (graphI I) d)))"

lemma glob_con_dom_eq: \<open>global_consistency Il \<Longrightarrow> inbc I Il \<Longrightarrow> inbc I' Il \<Longrightarrow>
                        dom (ledgra (graphI I)) = dom (ledgra (graphI I'))\<close>
  by (metis global_consistency_def map_le_antisym map_le_def)

lemma updIl_lem0: "d \<notin> dom (ledgra (graphI I)) \<Longrightarrow>
        (I \<in> set(upd_Il d lN il)) \<Longrightarrow> (I \<in> set il)" unfolding upd_Il_def upd_ld_def
proof (induction il)
  case Nil
then show ?case
  by simp
next
  case (Cons a il)
  then show ?case
    by auto
qed

lemma updIl_lem1: "d \<notin> dom (ledgra (graphI I)) \<Longrightarrow>
        inbc I (Infs p (upd_Il d lN (the_Il Il)) r) \<Longrightarrow> inbc I (Infs p (the_Il Il) r)"
  using inbc.inbc_def updIl_lem0 by blast

lemma d_dom_ledgra: "(d \<notin> dom (ledgra (graphI I))) \<Longrightarrow>
                     inbc I (Infs (the_ibc Il) (upd_Il d lN (the_Il Il)) (upd_ld d lN (relayer Il))) \<Longrightarrow>
                     inbc I Il"
  by (metis blockchainset.exhaust inbc.inbc_def the_Il.simps updIl_lem1)

lemma upd_lem3a: \<open>I \<in> set (upd_Il d lN il)
    \<Longrightarrow> ledgra (graphI I) d = Some lN\<close>
unfolding upd_Il_def upd_ld_def
proof (induction il)
case Nil
then show ?case
  by simp
next
  case (Cons a il)
  then show ?case
    by auto
qed

lemma upd_lem3: \<open>inbc I (Infs (the_ibc Il) (upd_Il d lN (the_Il Il)) (upd_ld d lN (relayer Il)))
    \<Longrightarrow> ledgra (graphI I) d = Some lN\<close>
by (rule upd_lem3a, simp add: upd_Il_def upd_ld_def)

lemma upd_lem4a:
  assumes "I \<in> set (upd_Il d lN il)"
  shows "\<exists>I0. I = upd_ld d lN I0 \<and> I0 \<in> (set il)"
  using assms
proof (induction il)
  case Nil
  then show ?case
    by simp
next
  case (Cons a il)
  then show ?case
    by auto
qed

lemma upd_lem4: "inbc I (Infs (the_ibc Il) (upd_Il d lN (the_Il Il)) (upd_ld d lN (relayer Il)))
     \<Longrightarrow> \<exists> I0. I = upd_ld d lN I0 \<and> inbc I0 Il"
  by (metis blockchainset.exhaust inbc.inbc_def the_Il.simps upd_lem4a)

lemma bc_upd_inv:
  assumes \<open>global_consistency Il\<close>
  shows \<open>global_consistency (bc_upd d lN Il)\<close>
  unfolding global_consistency_def bc_upd_def
proof (clarify)
  fix I I' da
  assume p0 : "inbc I (Infs (the_ibc Il) (upd_Il d lN (the_Il Il)) (upd_ld d lN (relayer Il)))"
    and p1: "inbc I' (Infs (the_ibc Il) (upd_Il d lN (the_Il Il)) (upd_ld d lN (relayer Il)))"
  obtain I0 where \<open>I = upd_ld d lN I0\<close>  and "inbc I0 Il" using assms upd_lem4 p0
    by blast
  obtain I1 where \<open>I' = upd_ld d lN I1\<close>  and "inbc I1 Il" using assms upd_lem4 p1
    by blast
  have prem0: "\<forall> d. ledgra (graphI I0) d = ledgra (graphI I1) d"
    using \<open>inbc I0 Il\<close> \<open>inbc I1 Il\<close> assms global_consistency_def by blast
  show "inbc I (Infs (the_ibc Il) (upd_Il d lN (the_Il Il)) (upd_ld d lN (relayer Il))) \<Longrightarrow>
       inbc I' (Infs (the_ibc Il) (upd_Il d lN (the_Il Il)) (upd_ld d lN (relayer Il))) \<Longrightarrow>
       ledgra (graphI I') da = ledgra (graphI I) da"
    using assms
    by (simp add: \<open>I = upd_ld d lN I0\<close> \<open>I' = upd_ld d lN I1\<close> \<open>inbc I0 Il\<close> \<open>inbc I1 Il\<close> global_consistency_def upd_ld_def)
qed

lemma firstcase: "\<not> inbc I' (Infs ibc Il rl) \<longrightarrow> replace I I' (Infs ibc Il rl) = (Infs ibc Il rl)"
  unfolding replace_def
proof (induction Il)
  case Nil
  then show ?case by simp
next
  case (Cons a Il)
  then show ?case by simp
qed

lemma trec_upd_inv:
 \<open>global_consistency (Infs ibc Il rl) \<longrightarrow>  ledgra (graphI I) = ledgra (graphI I')
    \<longrightarrow> global_consistency (replace I I' (Infs ibc Il rl))\<close>
  unfolding global_consistency_def
proof -
obtain ii :: infrastructure and iia :: infrastructure where
"(\<exists>v0 v1. (inbc v0 (replace I I' (Infs ibc Il rl)) \<and> inbc v1 (replace I I' (Infs ibc Il rl))) \<and> (\<exists>v2. ledgra (graphI v1) v2 \<noteq> ledgra (graphI v0) v2)) = ((inbc ii (replace I I' (Infs ibc Il rl)) \<and> inbc iia (replace I I' (Infs ibc Il rl))) \<and> (\<exists>v2. ledgra (graphI iia) v2 \<noteq> ledgra (graphI ii) v2))"
  by metis
  then obtain ccs :: "char list" where
    f1: "(\<exists>i ia. (inbc i (replace I I' (Infs ibc Il rl)) \<and> inbc ia (replace I I' (Infs ibc Il rl))) \<and> (\<exists>cs. ledgra (graphI ia) cs \<noteq> ledgra (graphI i) cs)) = ((inbc ii (replace I I' (Infs ibc Il rl)) \<and> inbc iia (replace I I' (Infs ibc Il rl))) \<and> ledgra (graphI iia) ccs \<noteq> ledgra (graphI ii) ccs)"
    by auto
  have f2: "\<forall>i ia ib is ic. if ia \<in> set is then replace i ia (Infs ib is ic) = Infs ib (i # remove1 ia is) ic else replace i ia (Infs ib is ic) = Infs ib is ic"
    by simp
  have f3: "\<forall>i ia is. (i::infrastructure) \<notin> set (ia # is) \<or> i = ia \<or> i \<in> set is"
    by (meson set_ConsD)
  { assume "ledgra (graphI iia) ccs \<noteq> ledgra (graphI ii) ccs"
    have "I' \<in> set Il \<and> ii \<in> set (I # remove1 I' Il) \<and> iia \<in> set Il \<longrightarrow> (((\<exists>i ia. (inbc i (Infs ibc Il rl) \<and> inbc ia (Infs ibc Il rl)) \<and> (\<exists>cs. ledgra (graphI ia) cs \<noteq> ledgra (graphI i) cs)) \<or> ledgra (graphI I) \<noteq> ledgra (graphI I')) \<or> (\<forall>i ia. (\<not> inbc i (replace I I' (Infs ibc Il rl)) \<or> \<not> inbc ia (replace I I' (Infs ibc Il rl))) \<or> (\<forall>cs. ledgra (graphI ia) cs = ledgra (graphI i) cs))) \<or> (\<not> inbc ii (replace I I' (Infs ibc Il rl)) \<or> \<not> inbc iia (replace I I' (Infs ibc Il rl)) \<or> ledgra (graphI iia) ccs = ledgra (graphI ii) ccs) \<or> (\<exists>i ia. inbc i (Infs ibc Il rl) \<and> inbc ia (Infs ibc Il rl) \<and> (\<exists>cs. ledgra (graphI ia) cs \<noteq> ledgra (graphI i) cs))"
      using f3 by (metis inbc.inbc_def notin_set_remove1)
    moreover
    { assume "iia \<notin> set Il"
      { assume "iia \<noteq> I \<and> iia \<notin> set (remove1 I' Il)"
        then have "replace I I' (Infs ibc Il rl) = Infs ibc (I # remove1 I' Il) rl \<longrightarrow> \<not> inbc ii (replace I I' (Infs ibc Il rl)) \<or> \<not> inbc iia (replace I I' (Infs ibc Il rl)) \<or> ledgra (graphI iia) ccs = ledgra (graphI ii) ccs"
          using f3 by (metis (no_types) inbc.inbc_def) }
      then have "I' \<in> set Il \<and> replace I I' (Infs ibc Il rl) = Infs ibc (I # remove1 I' Il) rl \<and> ii \<in> set (I # remove1 I' Il) \<longrightarrow> (((\<exists>i ia. (inbc i (Infs ibc Il rl) \<and> inbc ia (Infs ibc Il rl)) \<and> (\<exists>cs. ledgra (graphI ia) cs \<noteq> ledgra (graphI i) cs)) \<or> ledgra (graphI I) \<noteq> ledgra (graphI I')) \<or> (\<forall>i ia. (\<not> inbc i (replace I I' (Infs ibc Il rl)) \<or> \<not> inbc ia (replace I I' (Infs ibc Il rl))) \<or> (\<forall>cs. ledgra (graphI ia) cs = ledgra (graphI i) cs))) \<or> (\<not> inbc ii (replace I I' (Infs ibc Il rl)) \<or> \<not> inbc iia (replace I I' (Infs ibc Il rl)) \<or> ledgra (graphI iia) ccs = ledgra (graphI ii) ccs) \<or> (\<exists>i ia. inbc i (Infs ibc Il rl) \<and> inbc ia (Infs ibc Il rl) \<and> (\<exists>cs. ledgra (graphI ia) cs \<noteq> ledgra (graphI i) cs))"
        using f3 by (metis (no_types) inbc.inbc_def notin_set_remove1) }
        ultimately have "I' \<in> set Il \<and> replace I I' (Infs ibc Il rl) = Infs ibc (I # remove1 I' Il) rl \<and> ii \<in> set (I # remove1 I' Il) \<longrightarrow> (((\<exists>i ia. (inbc i (Infs ibc Il rl) \<and> inbc ia (Infs ibc Il rl)) \<and> (\<exists>cs. ledgra (graphI ia) cs \<noteq> ledgra (graphI i) cs)) \<or> ledgra (graphI I) \<noteq> ledgra (graphI I')) \<or> (\<forall>i ia. (\<not> inbc i (replace I I' (Infs ibc Il rl)) \<or> \<not> inbc ia (replace I I' (Infs ibc Il rl))) \<or> (\<forall>cs. ledgra (graphI ia) cs = ledgra (graphI i) cs))) \<or> (\<not> inbc ii (replace I I' (Infs ibc Il rl)) \<or> \<not> inbc iia (replace I I' (Infs ibc Il rl)) \<or> ledgra (graphI iia) ccs = ledgra (graphI ii) ccs) \<or> (\<exists>i ia. inbc i (Infs ibc Il rl) \<and> inbc ia (Infs ibc Il rl) \<and> (\<exists>cs. ledgra (graphI ia) cs \<noteq> ledgra (graphI i) cs))"
by satx
  moreover
  { assume "ii \<notin> set (I # remove1 I' Il)"
      then have "replace I I' (Infs ibc Il rl) = Infs ibc (I # remove1 I' Il) rl \<longrightarrow> \<not> inbc ii (replace I I' (Infs ibc Il rl)) \<or> \<not> inbc iia (replace I I' (Infs ibc Il rl)) \<or> ledgra (graphI iia) ccs = ledgra (graphI ii) ccs"
    using inbc.inbc_def by presburger }
  moreover
  { assume "replace I I' (Infs ibc Il rl) = Infs ibc Il rl"
    then have "(\<exists>i ia. inbc i (Infs ibc Il rl) \<and> inbc ia (Infs ibc Il rl) \<and> (\<exists>cs. ledgra (graphI ia) cs \<noteq> ledgra (graphI i) cs)) \<or> \<not> inbc ii (replace I I' (Infs ibc Il rl)) \<or> \<not> inbc iia (replace I I' (Infs ibc Il rl)) \<or> ledgra (graphI iia) ccs = ledgra (graphI ii) ccs"
      by auto }
  ultimately have "(\<not> inbc ii (replace I I' (Infs ibc Il rl)) \<or> \<not> inbc iia (replace I I' (Infs ibc Il rl)) \<or> ledgra (graphI iia) ccs = ledgra (graphI ii) ccs) \<or> ((\<exists>i ia. (inbc i (Infs ibc Il rl) \<and> inbc ia (Infs ibc Il rl)) \<and> (\<exists>cs. ledgra (graphI ia) cs \<noteq> ledgra (graphI i) cs)) \<or> ledgra (graphI I) \<noteq> ledgra (graphI I')) \<or> (\<forall>i ia. (\<not> inbc i (replace I I' (Infs ibc Il rl)) \<or> \<not> inbc ia (replace I I' (Infs ibc Il rl))) \<or> (\<forall>cs. ledgra (graphI ia) cs = ledgra (graphI i) cs))"
    using f2 by meson }
  then show "(\<forall>i ia. inbc i (Infs ibc Il rl) \<longrightarrow> inbc ia (Infs ibc Il rl) \<longrightarrow> (\<forall>cs. ledgra (graphI ia) cs = ledgra (graphI i) cs)) \<longrightarrow> ledgra (graphI I) = ledgra (graphI I') \<longrightarrow> (\<forall>i ia. inbc i (replace I I' (Infs ibc Il rl)) \<longrightarrow> inbc ia (replace I I' (Infs ibc Il rl)) \<longrightarrow> (\<forall>cs. ledgra (graphI ia) cs = ledgra (graphI i) cs))"
    using f1 by blast
qed

inductive state_transition_in :: "[blockchainset, blockchainset] \<Rightarrow> bool" ("(_ \<rightarrow>\<^sub>n _)" 50)
where
 scan : "inbc I Il \<Longrightarrow> G = graphI I \<Longrightarrow> a @\<^bsub>G\<^esub> n \<Longrightarrow> n \<in> nodes G \<Longrightarrow>
         R = graphI (relayer Il) \<Longrightarrow> r @\<^bsub>R\<^esub> n' \<Longrightarrow> n' \<in> nodes R \<Longrightarrow>
         relrole (relayer Il) (Actor r) \<Longrightarrow> enables I n (Actor r) scan \<Longrightarrow>
         ledgra G d = Some ((a, as), N) \<Longrightarrow> r \<in> as \<Longrightarrow>
         R' = Infrastructure
                   (Lgraph (gra R)(agra R)(cgra R)(lgra R)
                           ((ledgra R)(d := Some((a, as),N)))
                           (trec R))
                   (delta (relayer Il)) \<Longrightarrow>
         l \<in> trcs Il \<Longrightarrow> Consensus I Il = Il' \<Longrightarrow>
         Il' = insertp ((Send(a,b,(a,as), d)) # l) (replrel R' Il)
         \<Longrightarrow> Il \<rightarrow>\<^sub>n Il'"
| submit : "G = graphI I \<Longrightarrow> inbc I Il \<Longrightarrow> a @\<^bsub>G\<^esub> n \<Longrightarrow> n \<in> nodes G \<Longrightarrow>
            ledgra G d = Some ((a, as), N) \<Longrightarrow>
            H = graphI J \<Longrightarrow> inbc J Il \<Longrightarrow> b @\<^bsub>H\<^esub> n' \<Longrightarrow> n' \<in> nodes H \<Longrightarrow>
            ledgra H d = Some ((a, as), N) \<Longrightarrow>
            R = graphI (relayer Il) \<Longrightarrow> r @\<^bsub>R\<^esub> n'' \<Longrightarrow> n'' \<in> nodes R \<Longrightarrow>
            relrole (relayer Il) (Actor r) \<Longrightarrow> enables J n' (Actor r) submit \<Longrightarrow>
           r \<in> as \<Longrightarrow>
            R' = Infrastructure
                   (Lgraph (gra R)(agra R)(cgra R)(lgra R)
                           ((ledgra R)(d := Some((b, bs),N)))
                           (trec R))
                  (delta (relayer Il))  \<Longrightarrow>
            Il' = insertp (Receive(a,b,(a,as),d)# l) (replrel R' (bc_upd d ((b,as), N) Il)) \<Longrightarrow>
            Consensus J Il = Il'
            \<Longrightarrow> Il \<rightarrow>\<^sub>n Il'" |
 internal_Send : "inbc I Il \<Longrightarrow> G = graphI I \<Longrightarrow> a \<in> actors G \<Longrightarrow> n \<in> nodes G \<Longrightarrow>
         ledgra G d = Some ((a, as), N) \<Longrightarrow>
         I' = Infrastructure
                   (Lgraph (gra G)(agra G)(cgra G)(lgra G)
                           (ledgra G)
                           ((trec G)(n := (Send(a,b,(a,as), d)) # (trec G n))))
                   (delta I) \<Longrightarrow>
         Il' = replace I' I Il
         \<Longrightarrow> Il \<rightarrow>\<^sub>n Il'"|
 internal_Receive : "inbc I Il \<Longrightarrow> G = graphI I \<Longrightarrow> a \<in> actors G \<Longrightarrow> n \<in> nodes G \<Longrightarrow>
         ledgra G d = Some ((a, as), N) \<Longrightarrow>
         I' = Infrastructure
                   (Lgraph (gra G)(agra G)(cgra G)(lgra G)
                           (ledgra G)
                           ((trec G)(n := (Receive(a,b,(a,as), d)) # (trec G n))))
                   (delta I) \<Longrightarrow>
         Il' = replace I' I Il
         \<Longrightarrow> Il \<rightarrow>\<^sub>n Il'"

instantiation blockchainset :: state
begin

definition
   state_transition_infra_def: "(i \<rightarrow>\<^sub>i i') =  (i \<rightarrow>\<^sub>n (i' :: blockchainset))"

instance
  by (rule MC.class.MC.state.of_class.intro)

definition state_transition_in_refl ("(_ \<rightarrow>\<^sub>n* _)" 50)
where "s \<rightarrow>\<^sub>n* s' \<equiv> ((s,s') \<in> {(x,y). state_transition_in x y}\<^sup>*)"

end

lemma cons_lemma: "global_consistency Il \<Longrightarrow>
R = graphI (relayer Il) \<Longrightarrow>
R' = Infrastructure
                   (Lgraph (gra R)(agra R)(cgra R)(lgra R)
                           ((ledgra R)(d := Some((a', as),N)))
                           (\<lambda> n. (Send(a,b,(a,as), d)) # (trec R n)))
                   (delta I) \<Longrightarrow>
Il' = insertp ((Send(a,b,(a,as), d)) # l) (replrel R' Il)
\<Longrightarrow> global_consistency Il'"
  by (metis (no_types, hide_lams) blockchainset.exhaust global_consistency_def inbc.inbc_def insertp_def replrel.replrel_def the_Il.simps)

theorem consistency_preservation:
   "global_consistency Il \<Longrightarrow> (Il \<rightarrow>\<^sub>n Il') \<Longrightarrow> global_consistency Il'"
proof (erule state_transition_in.cases, simp_all)
  show \<open>\<And>I Ila G a n R r n' d as N R' a' l Il'a b.
       global_consistency Ila \<Longrightarrow>
       Il = Ila \<Longrightarrow>
       Il' =
       insertp (Send (a, b, (a, as), d) # l)
        (replrel
          (Infrastructure
            (Lgraph (gra (graphI (relayer Ila))) (agra (graphI (relayer Ila)))
              (cgra (graphI (relayer Ila))) (lgra (graphI (relayer Ila)))
              (ledgra (graphI (relayer Ila))(d \<mapsto> ((a', as), N))) (trec (graphI (relayer Ila))))
            (delta (relayer Ila)))
          Ila) \<Longrightarrow>
       inbc I Ila \<Longrightarrow>
       G = graphI I \<Longrightarrow>
       a @\<^bsub>graphI I\<^esub> n \<Longrightarrow>
       n \<in> nodes (graphI I) \<Longrightarrow>
       R = graphI (relayer Ila) \<Longrightarrow>
       r @\<^bsub>graphI (relayer Ila)\<^esub> n' \<Longrightarrow>
       n' \<in> nodes (graphI (relayer Ila)) \<Longrightarrow>
       relrole (relayer Ila) (Actor r) \<Longrightarrow>
       enables I n (Actor r) scan \<Longrightarrow>
       ledgra (graphI I) d = Some ((a, as), N) \<Longrightarrow>
       r \<in> as \<Longrightarrow>
       R' =
       Infrastructure
        (Lgraph (gra (graphI (relayer Ila))) (agra (graphI (relayer Ila))) (cgra (graphI (relayer Ila)))
          (lgra (graphI (relayer Ila))) (ledgra (graphI (relayer Ila))(d \<mapsto> ((a', as), N)))
          (trec (graphI (relayer Ila))))
        (delta (relayer Ila)) \<Longrightarrow>
       l \<in> trcs Ila \<Longrightarrow>
       Consensus I Ila =
       insertp (Send (a, b, (a, as), d) # l)
        (replrel
          (Infrastructure
            (Lgraph (gra (graphI (relayer Ila))) (agra (graphI (relayer Ila)))
              (cgra (graphI (relayer Ila))) (lgra (graphI (relayer Ila)))
              (ledgra (graphI (relayer Ila))(d \<mapsto> ((a', as), N))) (trec (graphI (relayer Ila))))
            (delta (relayer Ila)))
          Ila) \<Longrightarrow>
       Il'a =
       insertp (Send (a, b, (a, as), d) # l)
        (replrel
          (Infrastructure
            (Lgraph (gra (graphI (relayer Ila))) (agra (graphI (relayer Ila)))
              (cgra (graphI (relayer Ila))) (lgra (graphI (relayer Ila)))
              (ledgra (graphI (relayer Ila))(d \<mapsto> ((a', as), N))) (trec (graphI (relayer Ila))))
            (delta (relayer Ila)))
          Ila) \<Longrightarrow>
       global_consistency
        (insertp (Send (a, b, (a, as), d) # l)
          (replrel
            (Infrastructure
              (Lgraph (gra (graphI (relayer Ila))) (agra (graphI (relayer Ila)))
                (cgra (graphI (relayer Ila))) (lgra (graphI (relayer Ila)))
                (ledgra (graphI (relayer Ila))(d \<mapsto> ((a', as), N))) (trec (graphI (relayer Ila))))
              (delta (relayer Ila)))
            Ila))\<close>
    by (smt blockchainset.exhaust global_consistency_def inbc.inbc_def insertp_def replrel.replrel_def the_Il.simps)
next show \<open>\<And>G I Ila a n d as N H J b n' R r n'' R' bs Il'a l.
       global_consistency Ila \<Longrightarrow>
       Il = Ila \<Longrightarrow>
       Il' =
       insertp (Receive (a, b, (a, as), d) # l)
        (replrel
          (Infrastructure
            (Lgraph (gra (graphI (relayer Ila))) (agra (graphI (relayer Ila)))
              (cgra (graphI (relayer Ila))) (lgra (graphI (relayer Ila)))
              (ledgra (graphI (relayer Ila))(d \<mapsto> ((b, bs), N))) (trec (graphI (relayer Ila))))
            (delta (relayer Ila)))
          (bc_upd d ((b, as), N) Ila)) \<Longrightarrow>
       G = graphI I \<Longrightarrow>
       inbc I Ila \<Longrightarrow>
       a @\<^bsub>graphI I\<^esub> n \<Longrightarrow>
       n \<in> nodes (graphI I) \<Longrightarrow>
       ledgra (graphI I) d = Some ((a, as), N) \<Longrightarrow>
       H = graphI J \<Longrightarrow>
       inbc J Ila \<Longrightarrow>
       b @\<^bsub>graphI J\<^esub> n' \<Longrightarrow>
       n' \<in> nodes (graphI J) \<Longrightarrow>
       ledgra (graphI J) d = Some ((a, as), N) \<Longrightarrow>
       R = graphI (relayer Ila) \<Longrightarrow>
       r @\<^bsub>graphI (relayer Ila)\<^esub> n'' \<Longrightarrow>
       n'' \<in> nodes (graphI (relayer Ila)) \<Longrightarrow>
       relrole (relayer Ila) (Actor r) \<Longrightarrow>
       enables J n' (Actor r) submit \<Longrightarrow>
       r \<in> as \<Longrightarrow>
       R' =
       Infrastructure
        (Lgraph (gra (graphI (relayer Ila))) (agra (graphI (relayer Ila))) (cgra (graphI (relayer Ila)))
          (lgra (graphI (relayer Ila))) (ledgra (graphI (relayer Ila))(d \<mapsto> ((b, bs), N)))
          (trec (graphI (relayer Ila))))
        (delta (relayer Ila)) \<Longrightarrow>
       Il'a =
       insertp (Receive (a, b, (a, as), d) # l)
        (replrel
          (Infrastructure
            (Lgraph (gra (graphI (relayer Ila))) (agra (graphI (relayer Ila)))
              (cgra (graphI (relayer Ila))) (lgra (graphI (relayer Ila)))
              (ledgra (graphI (relayer Ila))(d \<mapsto> ((b, bs), N))) (trec (graphI (relayer Ila))))
            (delta (relayer Ila)))
          (bc_upd d ((b, as), N) Ila)) \<Longrightarrow>
       Consensus J Ila =
       insertp (Receive (a, b, (a, as), d) # l)
        (replrel
          (Infrastructure
            (Lgraph (gra (graphI (relayer Ila))) (agra (graphI (relayer Ila)))
              (cgra (graphI (relayer Ila))) (lgra (graphI (relayer Ila)))
              (ledgra (graphI (relayer Ila))(d \<mapsto> ((b, bs), N))) (trec (graphI (relayer Ila))))
            (delta (relayer Ila)))
          (bc_upd d ((b, as), N) Ila)) \<Longrightarrow>
       global_consistency
        (insertp (Receive (a, b, (a, as), d) # l)
          (replrel
            (Infrastructure
              (Lgraph (gra (graphI (relayer Ila))) (agra (graphI (relayer Ila)))
                (cgra (graphI (relayer Ila))) (lgra (graphI (relayer Ila)))
                (ledgra (graphI (relayer Ila))(d \<mapsto> ((b, bs), N))) (trec (graphI (relayer Ila))))
              (delta (relayer Ila)))
            (bc_upd d ((b, as), N) Ila)))\<close>
    by (smt bc_upd_def bc_upd_inv global_consistency_def inbc.inbc_def insertp_def replrel.replrel_def the_Il.simps)
next show \<open> \<And>I Ila G a actors n d as N I' b Il'a.
       global_consistency Ila \<Longrightarrow>
       Il = Ila \<Longrightarrow>
       Il' =
       replace
        (Infrastructure
          (Lgraph (gra (graphI I)) (agra (graphI I)) (cgra (graphI I)) (lgra (graphI I))
            (ledgra (graphI I)) ((trec (graphI I))(n := Send (a, b, (a, as), d) # trec (graphI I) n)))
          (delta I))
        I Ila \<Longrightarrow>
       inbc I Ila \<Longrightarrow>
       G = graphI I \<Longrightarrow>
       a \<in> actors (graphI I) \<Longrightarrow>
       n \<in> nodes (graphI I) \<Longrightarrow>
       ledgra (graphI I) d = Some ((a, as), N) \<Longrightarrow>
       I' =
       Infrastructure
        (Lgraph (gra (graphI I)) (agra (graphI I)) (cgra (graphI I)) (lgra (graphI I)) (ledgra (graphI I))
          ((trec (graphI I))(n := Send (a, b, (a, as), d) # trec (graphI I) n)))
        (delta I) \<Longrightarrow>
       Il'a =
       replace
        (Infrastructure
          (Lgraph (gra (graphI I)) (agra (graphI I)) (cgra (graphI I)) (lgra (graphI I))
            (ledgra (graphI I)) ((trec (graphI I))(n := Send (a, b, (a, as), d) # trec (graphI I) n)))
          (delta I))
        I Ila \<Longrightarrow>
       global_consistency
        (replace
          (Infrastructure
            (Lgraph (gra (graphI I)) (agra (graphI I)) (cgra (graphI I)) (lgra (graphI I))
              (ledgra (graphI I)) ((trec (graphI I))(n := Send (a, b, (a, as), d) # trec (graphI I) n)))
            (delta I))
          I Ila)\<close>
    by (metis blockchainset.exhaust graphI.simps ledgra.simps trec_upd_inv)
next show \<open>\<And>I Ila G a actors n d as N I' b Il'a.
       global_consistency Ila \<Longrightarrow>
       Il = Ila \<Longrightarrow>
       Il' =
       replace
        (Infrastructure
          (Lgraph (gra (graphI I)) (agra (graphI I)) (cgra (graphI I)) (lgra (graphI I))
            (ledgra (graphI I)) ((trec (graphI I))(n := Receive (a, b, (a, as), d) # trec (graphI I) n)))
          (delta I))
        I Ila \<Longrightarrow>
       inbc I Ila \<Longrightarrow>
       G = graphI I \<Longrightarrow>
       a \<in> actors (graphI I) \<Longrightarrow>
       n \<in> nodes (graphI I) \<Longrightarrow>
       ledgra (graphI I) d = Some ((a, as), N) \<Longrightarrow>
       I' =
       Infrastructure
        (Lgraph (gra (graphI I)) (agra (graphI I)) (cgra (graphI I)) (lgra (graphI I)) (ledgra (graphI I))
          ((trec (graphI I))(n := Receive (a, b, (a, as), d) # trec (graphI I) n)))
        (delta I) \<Longrightarrow>
       Il'a =
       replace
        (Infrastructure
          (Lgraph (gra (graphI I)) (agra (graphI I)) (cgra (graphI I)) (lgra (graphI I))
            (ledgra (graphI I)) ((trec (graphI I))(n := Receive (a, b, (a, as), d) # trec (graphI I) n)))
          (delta I))
        I Ila \<Longrightarrow>
       global_consistency
        (replace
          (Infrastructure
            (Lgraph (gra (graphI I)) (agra (graphI I)) (cgra (graphI I)) (lgra (graphI I))
              (ledgra (graphI I)) ((trec (graphI I))(n := Receive (a, b, (a, as), d) # trec (graphI I) n)))
            (delta I))
          I Ila) \<close>
    by (metis blockchainset.exhaust graphI.simps ledgra.simps trec_upd_inv)
  qed

locale ConsensusExample =

fixes cons_algo_aux :: \<open>infrastructure \<Rightarrow> blockchainset \<Rightarrow> sc_fun\<close>
defines cons_algo_aux_def: "cons_algo_aux I Il \<equiv>
          (SOME x. x \<in> {x. \<exists> n. n \<in> nodes (graphI I) \<and> x = hd(trec (graphI I) n)})"

fixes cons_algo :: \<open>infrastructure \<Rightarrow> blockchainset \<Rightarrow> infrastructure\<close>
defines cons_algo_def: "cons_algo I Il \<equiv>
           Infrastructure
                   (Lgraph (gra (graphI I))(agra (graphI I))(cgra (graphI I))
                           (lgra (graphI I))(ledgra (graphI I))
                            ((\<lambda> n. (cons_algo_aux I Il) # (trec (graphI I) n))))
                   (delta I)"

fixes Consensus :: \<open>infrastructure \<Rightarrow> blockchainset \<Rightarrow> blockchainset\<close>
defines Consensus_def:
  "Consensus I Il \<equiv> replace (cons_algo I Il) I Il"

begin
end

end