theory ringBufFifoModi imports paraGste1
begin
abbreviation rst::"expType" where
"rst \<equiv> IVar (Ident ''rst'')"

abbreviation push::"expType" where
"push \<equiv> IVar (Ident ''push'')"

abbreviation pop::"expType" where
"pop \<equiv> IVar (Ident ''pop'')"

abbreviation dataIn::"expType" where
"dataIn \<equiv> IVar (Ident ''dataIn'' )"

abbreviation LOW::"expType" where
"LOW \<equiv> Const (boolV False)"
abbreviation HIGH::"expType" where
" HIGH \<equiv> Const (boolV True)"

abbreviation emptyFifo::"expType" where
" emptyFifo \<equiv> IVar (Ident ''empty'' ) "

abbreviation tail::"expType" where
" tail \<equiv> IVar (Ident ''tail'' ) "

abbreviation head::"expType" where
" head \<equiv> IVar (Ident ''head'' ) "

abbreviation full::"expType" where
" full \<equiv> IVar (Ident ''full'' ) "

definition fullForm::"formula" where [simp]:
" fullForm \<equiv> eqn full HIGH "

abbreviation mem::"varType" where
"mem \<equiv>  ( (Ident ''mem'') )"

type_synonym paraExpType="nat \<Rightarrow>expType"

abbreviation dataOut::"nat\<Rightarrow>expType" where
"dataOut DEPTH \<equiv> read (Ident ''mem'') DEPTH (IVar (Ident ''head'' ))"

abbreviation rstForm::"formula" where
"rstForm  \<equiv>  (eqn rst HIGH)"

abbreviation emptyForm::"formula" where
"emptyForm  \<equiv>  (eqn emptyFifo HIGH)"

abbreviation pushForm::"formula" where
"pushForm \<equiv> andForm (andForm (eqn rst LOW) (eqn push HIGH)) (eqn pop LOW)"

abbreviation popForm::"formula" where
"popForm \<equiv> andForm (andForm (eqn rst LOW) (eqn push LOW)) (eqn pop HIGH)"

abbreviation nPushPopForm::"formula" where
"nPushPopForm \<equiv> andForm (andForm (eqn rst LOW) (eqn push LOW)) (eqn pop LOW)"

abbreviation pushDataForm::"nat \<Rightarrow>formula" where
" pushDataForm D \<equiv>andForm pushForm  (eqn dataIn (Const (index D)))"

abbreviation popDataForm::"nat\<Rightarrow>nat \<Rightarrow>formula" where
" popDataForm DEPTH D \<equiv>  (eqn (dataOut DEPTH) (Const (index D)))"

abbreviation nFullForm::"formula" where
"nFullForm \<equiv>  neg (fullForm )"

abbreviation nEmptyForm::"formula" where
"nEmptyForm \<equiv> neg emptyForm "

definition  vertexI::"node" where [simp]:
"vertexI \<equiv>Vertex  0"

(*DEPTH=LAST + 1*)
definition  vertexL::"nat \<Rightarrow> node list" where [simp]:
"vertexL LAST  \<equiv>  vertexI # (map (%i. Vertex  i) (down LAST))"

definition edgeL::"nat \<Rightarrow> edge list" where [simp]:
 "edgeL LAST \<equiv> [Edge vertexI ( Vertex 1)]
    @ [Edge  ( Vertex 1) ( Vertex 3)]
    @ [Edge  ( Vertex 1) ( Vertex 4)]

		@(map (%i.  ( Edge (Vertex ( 2*i+1 ))  (Vertex (  2*i+1 ))) ) (upt 0  (LAST+2) ))  (* self-loop*)
	  @(map (%i.  ( Edge (Vertex ( 2*i+2 ))  (Vertex (  2*i+2 ))) ) (upt 1 (LAST+2) ))  (* self-loop*)

		@(map (%i.   ( Edge (Vertex (2 * i + 1))  (Vertex (2 * i + 3))) ) ( upt 1 (LAST+1)))
		@(map (%i.   ( Edge (Vertex (2 * i + 1))  (Vertex (2 * i + 4))) ) ( upt 1 (LAST+1)))

		@(map (%i.   ( Edge (Vertex (2 * i + 3))  (Vertex (2 * i + 1))) ) (  upt 0 (LAST+1) ))
		@(map (%i.   ( Edge (Vertex (2 * i + 4))  (Vertex (2 * i +2 ))) ) (  upt 1 (LAST+1) ))
		@[ Edge (Vertex 4) (Vertex 1)]
	 "

(*
edgeL LAST \<equiv> [Edge vertexI ( Vertex 1)]
    @ [Edge  ( Vertex 1) ( Vertex 3)]
    @ [Edge  ( Vertex 1) ( Vertex 4)]

		@(map (%i.  ( Edge (Vertex ( 2*i+1 ))  (Vertex (  2*i+1 ))) ) (upt 0  (LAST+2) ))  (* self-loop*)
	  @(map (%i.  ( Edge (Vertex ( 2*i+2 ))  (Vertex (  2*i+2 ))) ) (upt 1  (LAST+2) ))  (* self-loop*)

		@(map (%i.   ( Edge (Vertex (2 * i + 1))  (Vertex (2 * i + 3))) ) ( upt 1 (LAST+1)))
		@(map (%i.   ( Edge (Vertex (2 * i + 1))  (Vertex (2 * i + 4))) ) ( upt 1 (LAST+1)))

		@(map (%i.   ( Edge (Vertex (2 * i + 3))  (Vertex (2 * i + 1))) ) (  upt 0 (LAST+1) ))
		@(map (%i.   ( Edge (Vertex (2 * i + 4))  (Vertex (2 * i + 2))) ) (  upt 1 (LAST+1) ))
		@[Edge  ( Vertex 4) ( Vertex 1)]
;*)
primrec node2Nat::"node \<Rightarrow> nat" where
"node2Nat (Vertex n) = n"

definition antOfRbFifo::"nat\<Rightarrow>edge\<Rightarrow>formula" where [simp]:
"antOfRbFifo  D  edge\<equiv>
  (let from=node2Nat (source edge) in
   let to=node2Nat (sink edge) in
  ( if (	from = 0) then rstForm	else
     if (from=to) then nPushPopForm else
   ( if ((from mod 2) =1) then
     (
       if ((from + 2)=to) then ( pushForm ) else
       if (from=(to + 2)) then popForm else
       pushDataForm D )   else
     popForm)))"

(*definition antOfRbFifo::"nat\<Rightarrow>edge\<Rightarrow>formula" where [simp]:
"antOfRbFifo  D  edge\<equiv>
  (let from=node2Nat (source edge) in
   let to=node2Nat (sink edge) in
   if (from = 0) then rstForm	else
   if (from=to) then nPushPopForm else
      (if ((from mod 2) =1) then
        (
          if ((from + 2)=to) then ( pushForm ) else
          if (from=(to + 2)) then popForm else
          pushDataForm D )
       else popForm))"

definition consOfRbFifo::"nat\<Rightarrow>nat\<Rightarrow>edge \<Rightarrow>formula" where  [simp]:
"consOfRbFifo   D LAST edge \<equiv>
(let from=node2Nat (source edge) in
 let to=node2Nat (sink edge) in
 if 	(((from mod 2) = 1) \<and> ((to mod 2) = 1)) then
    (if  from =1 then (andForm  emptyForm (nFullForm LAST))
     else if    (from = (2*LAST+3)) then (andForm nEmptyForm (fullForm LAST))
     else andForm nEmptyForm (nFullForm LAST))
 else if (from=4 \<and> to = 1) then popDataForm LAST D
 else if (from = (2*LAST+4)) then (andForm nEmptyForm (fullForm LAST))
 else if (from =1 )  then (andForm emptyForm (nFullForm LAST))
 else if (from \<noteq>0)   then (andForm nEmptyForm (nFullForm LAST))
 else chaos)"

let cons aEdge =
	val (Edge (Vertex from) (Vertex to)) = aEdge
in
	((from%2) = 1) AND ((to%2) = 1) =>
		(from = 1) => TAndList [empty,nFull]		//FIFO is empty
	|	(from = (2*DEPTH+1)) => TAndList [nEmpty,full]	//FIFO is full
	|	TAndList [nEmpty,nFull]					//FIFO of other size
|	(to = 2) => popData vOfDataIn					//read the write data
| 	TAndList []
;*)

definition consOfRbFifo::"nat\<Rightarrow>nat\<Rightarrow>edge \<Rightarrow>formula" where  [simp]:
"consOfRbFifo   D LAST edge \<equiv>
let from=node2Nat (source edge) in
let to=node2Nat (sink edge) in
 (if 	(((from mod 2) = 1) \<and> ((to mod 2) = 1)) then
  (if  from =1 then (andForm  emptyForm (nFullForm))
  else if    (from = (2*LAST+3)) then (andForm nEmptyForm (fullForm ))
  else andForm nEmptyForm (nFullForm ))
 else if (from=4 \<and> to = 1) then popDataForm LAST D
 else if (from = (2*LAST+4)) then (andForm nEmptyForm (fullForm))
 else if (from =1 )  then (andForm emptyForm (nFullForm ))
 else if (from \<noteq>0)   then (andForm nEmptyForm (nFullForm))
 else chaos)"

definition rbFifoGsteSpec::" nat\<Rightarrow>nat\<Rightarrow>gsteSpec" where  [simp]:
"rbFifoGsteSpec LAST  data\<equiv>Graph  vertexI (edgeL  LAST ) (antOfRbFifo data )  (consOfRbFifo data  LAST)"

primrec applyPlusN::"expType\<Rightarrow>nat \<Rightarrow>expType" where
"applyPlusN e 0=e" |
"applyPlusN e (Suc N) = uif ''+'' [applyPlusN e N, Const (index 1)]"

definition tagFunOfRingBufFifo:: " nat\<Rightarrow>nat\<Rightarrow>nodeTagFuncList" where [simp]:
"tagFunOfRingBufFifo DATA LAST  n \<equiv>
  let x=node2Nat n in
   let DataE=(Const (index DATA)) in
   let LASTE=(Const (index LAST)) in
   let TwiceLASTPlus3=(Const (index (2*LAST +3))) in
   let tailPlus=uif ''+'' [tail, (Const (index 1))] in
   let headPlus=uif ''+'' [head, (Const (index 1))] in
   if (x = 0) then [] else
    (if ((x mod 2) = 1) then
      (if (x =1) then
        [eqn tail head, eqn  emptyFifo HIGH,
        eqn full LOW,uip ''le'' [head,LASTE]]
       else
       (if (x=2*LAST+3) then
        [eqn tail (applyPlusN head (x div 2  )),
        eqn  emptyFifo LOW,
        (*eqn emptyFifo (iteForm (eqn tail  headPlus)  HIGH emptyFifo),
        eqn full (iteForm (eqn tailPlus  head)  HIGH full),*)
        eqn full  HIGH,
        uip ''le'' [head,LASTE]
        ]
        else
         [eqn tail (applyPlusN head (x div 2  )),
         eqn  emptyFifo LOW,
         eqn full LOW,uip ''le'' [head,LASTE]]
         (* eqn emptyFifo (iteForm (eqn tail  headPlus)  HIGH emptyFifo),
          eqn full (iteForm (eqn tailPlus  head)  HIGH full),*)
        (* uip ''le'' [head,LASTE]]*) ) )
    else
    ((*if (x = 2) then []
     else *)
        (if (x=2*LAST+4) then
        [eqn tail (applyPlusN head (x div 2 - 1 ) ),
        eqn emptyFifo LOW,
        eqn full HIGH,uip ''le'' [head,LASTE],
        eqn (read mem LAST (applyPlusN head (x div 2  - 2))) DataE ]
        else
         [eqn tail (applyPlusN head (x div 2  - 1)), eqn  emptyFifo LOW,
         eqn full LOW, uip ''le'' [head,LASTE],

          eqn (read mem LAST (applyPlusN head (x div 2  - 2))) DataE ]))
     )

 "

 abbreviation branch1::"generalizeStatement" where
"branch1 \<equiv>
  (let S1=assign (Ident ''head'',(Const (index 0))) in
   let S2=assign (Ident ''tail'',(Const (index 0))) in
   let S3=assign (Ident ''empty'',HIGH) in
   let S4=assign (Ident ''full'',LOW) in
   Parallel [S1,S2,S3,S4])"

abbreviation branch2::"nat\<Rightarrow>generalizeStatement" where
"branch2 LAST \<equiv>
  (let S1=map (\<lambda>i. assign ((Para (Ident ''mem'') i),
    iteForm (eqn tail (Const (index i)))  dataIn
    (IVar (Para (Ident ''mem'')  i)))) (down LAST ) in
   let tailPlus=uif ''+'' [tail, (Const (index 1))] in
   let S2=assign (Ident ''tail'', tailPlus ) in
   let S3=assign (Ident ''empty'',LOW) in
   let S4=assign (Ident ''full'',iteForm (eqn tailPlus  head)  HIGH full) in
   (* Parallel (S1@[S2,S3]))*)
   Parallel ([S2,S3,S4]@S1))"

abbreviation branch3::"generalizeStatement" where
"branch3 \<equiv>
  (let headPlus=uif ''+'' [head, (Const (index 1))] in
    Parallel [
    assign (Ident ''empty'',iteForm (eqn tail  headPlus)  HIGH emptyFifo),
    assign (Ident ''full'', LOW),
    assign (Ident ''head'',  headPlus)] )
    "

abbreviation ringBuffifo::" nat\<Rightarrow>generalizeStatement" where
"ringBuffifo  LAST\<equiv>
  caseStatement
     [(eqn rst HIGH, branch1),
      (andForm (eqn push HIGH) (nFullForm), branch2 LAST),
      (andForm (eqn pop HIGH) (eqn emptyFifo LOW), branch3)]
   "

consts J::"nat \<Rightarrow> interpretFunType"

axiomatization where axiomOnIAdd [simp,intro]:
"  J LAST ''+'' [index m,   index (Suc 0)] = index ((m + 1) mod (Suc LAST  ))"
(* (if m=LAST  then (index 0) else (index (m +1 )))"
index ((m + 1) mod (Suc LAST  )) " *)

axiomatization where axiomOnLe [simp,intro]:
"  J LAST  ''le'' [index m, index n]  = boolV (m \<le> n)"

axiomatization where headIsIndex[simp,intro]:"\<exists>i. ((s (Ident ''head'') ) = (index i)) "

lemma test0: "formEval (J LAST) (eqn (Var tail) (applyPlusN head i) ) s  \<longrightarrow>
formEval (J LAST) (eqn (uif ''+''  [Var tail, Const (index 1)]) (applyPlusN head (i+1)) ) s"
apply(auto) done

lemma auxOnReadWrite[simp]:
"expEval I e s=expEval I e' s \<and>expEval I e s=index i\<and> i\<le> LAST \<longrightarrow>(\<forall>j. Para mem j \<notin>set (varOfExp e'))\<longrightarrow>

        expEval I  (substExp (caseExp (map (\<lambda>i. (eqn e' (Const (index i)), IVar (Para mem i))) (down LAST)))
            (map (\<lambda>i. (Para mem i, iteForm (eqn e (Const (index i))) e'' (IVar (Para mem i))))
              (down LAST)))
          s = expEval I e'' s "   (is "?P LAST")
proof(induct_tac LAST)
  show "?P 0"
  proof(rule impI)+
  assume a1:" expEval I e s = expEval I e' s \<and> expEval I e s = index i \<and> i \<le> 0" and
   a2:" \<forall>j. Para mem j \<notin> set (varOfExp e')"
   have a3:"(Para mem 0) \<notin> set (varOfExp e')"
    by(cut_tac a2,auto)
  show " expEval I
     (substExp (caseExp (map (\<lambda>i. (eqn e' (Const (index i)), IVar (Para mem i))) (down 0)))
       (map (\<lambda>i. (Para mem i, iteForm (eqn e (Const (index i))) e'' (IVar (Para mem i)))) (down 0)))
     s =
    expEval I e'' s"
   using a1 a3 noEffectSubstExp proof(cut_tac a1,auto)qed
   qed
  next
  fix n
  assume a0:  "?P n"
  show "?P (Suc n)"
  proof(rule impI)+
  assume a1:" expEval I e s = expEval I e' s \<and> expEval I e s = index i \<and> i \<le> Suc n" and
   a2:" \<forall>j. Para mem j \<notin> set (varOfExp e')"
   have a3:"(Para mem  (Suc n)) \<notin> set (varOfExp e')"
    by(cut_tac a2,auto)
   show "expEval I
     (substExp (caseExp (map (\<lambda>i. (eqn e' (Const (index i)), IVar (Para mem i))) (down (Suc n))))
       (map (\<lambda>i. (Para mem i, iteForm (eqn e (Const (index i))) e'' (IVar (Para mem i)))) (down (Suc n))))
     s =
    expEval I e'' s" (is "?LHS (Suc n) =?RHS")
   proof(case_tac "i \<le> n")
     assume b1:"i \<le> n"
     have b2:" (Para mem (Suc n)) \<notin> set (varOfExp
     (caseExp (map (\<lambda>i. (eqn e' (Const (index i)), IVar (Para mem i))) (down n))))"
      apply(auto)
      apply (simp add: SucnIsNotInDownn)
      by (simp add: a3)

     have b3:"?LHS (Suc n) =?LHS n"
     using a1 a2 a3 b1 b2 by auto
     have b4:"?LHS n =   expEval I e'' s"
     using a1 b1 a2 a0 apply auto  done
     show "?LHS (Suc n) =?RHS"
     using b4 b3 by auto
   next
    assume b1:"\<not>i \<le> n"
    have b2:"i=Suc n"
    using b1 a1 by auto
    show "?LHS (Suc n) =?RHS"
     using b1 b2 a1 a2 a3  apply auto done
  qed
qed
qed

lemma caseExpCong:
  assumes a:"tautlogy (eqn e e') I"
  shows "expEval I   (caseExp (map (\<lambda>i. (eqn e (Const (index i)), IVar (Para mem i))) (down LAST))) s
  =expEval I  (caseExp (map (\<lambda>i. (eqn e' (Const (index i)), IVar (Para mem i))) (down LAST))) s"
proof(induct_tac LAST,(cut_tac a,simp)+)qed

lemma caseExpCong1:
  assumes a:"formEval I (eqn e e') s "
  shows "expEval I   (caseExp (map (\<lambda>i. (eqn e (Const (index i)), IVar (Para mem i))) (down LAST))) s
  =expEval I  (caseExp (map (\<lambda>i. (eqn e' (Const (index i)), IVar (Para mem i))) (down LAST))) s"
proof(induct_tac LAST,(cut_tac a,simp)+)qed

lemma readWrite[simp,intro!]:
assumes a1:"expEval I e s=expEval I e' s " and a2:"expEval I e s=index i" and a3:" i\<le> LAST " and
a2:"(\<forall>j. Para mem j \<notin>set (varOfExp e'))"

shows " expEval I  (substExp (caseExp (map (\<lambda>i. (eqn e' (Const (index i)), IVar (Para mem i))) (down LAST)))
            (map (\<lambda>i. (Para mem i, iteForm (eqn e (Const (index i))) e'' (IVar (Para mem i))))
              (down LAST)))
          s = expEval I e'' s "
using a2 a3 assms(2) auxOnReadWrite local.a1 by blast

lemma varOfApplyPlus[simp]:
  "varOfExp (applyPlusN head i) = [(Ident ''head'' )]"
  apply(induct_tac i,auto) done

lemma onApplyPlusI[simp]:"i \<le> LAST \<longrightarrow>
  j \<le> LAST \<longrightarrow> s (Ident ''head'') = index j \<longrightarrow>
  expEval (J LAST) (applyPlusN head i) s = index ((j + i) mod (Suc LAST))  "
  proof(induct_tac i,auto,arith) qed

lemma onApplyPlusII[simp]:"0<i\<longrightarrow>i\<le> LAST \<longrightarrow>
  j \<le> LAST \<longrightarrow> s (Ident ''head'') = index j \<longrightarrow>
expEval (J LAST) (applyPlusN (uif ''+'' [head, Const (index (Suc 0))]) (i - Suc 0)) s = index ((j + i) mod (Suc LAST))" (is "?P i")
  proof(induct_tac i,simp,case_tac "n=0",simp)
    fix n
    assume a:"?P n" and b:"~n=0"
    show "?P (Suc n)"
    proof(rule impI)+
      assume c1:"0< Suc n" and c2:"Suc n \<le> LAST" and c3:"j \<le> LAST" and c4:"s (Ident ''head'') = index j"
      show "
      expEval (J LAST) (applyPlusN (uif ''+'' [head, Const (index (Suc 0))]) (Suc n - Suc 0)) s = index ((j + Suc n) mod Suc LAST)"
      (is "?LHS =?RHS")
      proof -
      have d1:"0<n" by(cut_tac b,simp)
      have d2:"n <LAST" by(cut_tac c2,simp)
      have d3:"(applyPlusN (uif ''+'' [head, Const (index (Suc 0))]) (Suc n - Suc 0)) =
      uif ''+'' [(applyPlusN (uif ''+'' [head, Const (index (Suc 0))]) (n -Suc 0)), Const (index (Suc 0))]"
      by (metis One_nat_def Suc_pred applyPlusN.simps(2) d1 diff_Suc_1)
      have d4:"expEval (J LAST) (applyPlusN (uif ''+'' [head, Const (index (Suc 0))]) (n - Suc 0)) s=index ((j + n) mod (Suc LAST))"
        apply(cut_tac a d1 d2 d3 c3 c4,simp) done

      show "?LHS=?RHS"
      apply(cut_tac d3 d4,simp)
      using mod_Suc_eq_Suc_mod by auto
    qed
   qed
qed

lemma test1[simp]: " (expEval (J LAST) (applyPlusN head (Suc i)) s) = J LAST ''+'' [expEval (J LAST) (applyPlusN head i) s, index (Suc 0)]"
  apply simp done

lemma test2[simp]:"Suc j \<le> LAST \<longrightarrow> (Suc j + (Suc LAST)) mod (Suc LAST) =Suc ((j + (Suc LAST)) mod (Suc LAST))" (is "?P j")
by (metis Divides.mod_less le_less_trans lessI less_trans mod_add_self2)

lemma test3:"j \<le> LAST \<longrightarrow> (j + (Suc LAST)) mod (Suc LAST) =j" (is "?P j")
by (metis Divides.mod_less le_imp_less_Suc mod_add_self2)

lemma test4[simp]:"0<LAST \<longrightarrow>i < Suc LAST \<longrightarrow> 0 < i \<longrightarrow>
  j \<le> LAST \<longrightarrow> ((j + i) mod (Suc LAST)) =
  (if (j+i)< (Suc LAST) then j+i else (j+i -(Suc LAST)))"  (is "?P LAST")
using le_mod_geq by force

lemma test5Aux[simp]:"0<LAST \<longrightarrow>i < Suc LAST \<longrightarrow> 0 < i \<longrightarrow>
  j \<le> LAST \<longrightarrow> ((j + i) mod (Suc LAST)) \<noteq> j"
using nat_neq_iff not_less by auto

lemma test5:
  assumes a1:" 0 < LAST " and a2:" i < Suc LAST" and a3:" 0 < i " and
  a4:"j \<le> LAST"
  shows " ((j + i) mod (Suc LAST)) \<noteq> j"
      using a1 a2 a3 a4 test5Aux by auto

lemma  iPlus1IsNotI:
  assumes a1:"0 < LAST" and
  a2:"J LAST ''+'' [s (Ident ''head''), index (Suc 0)] = s (Ident ''head'')"
  (*and *a3:" scalar2Bool (J LAST ''le'' [s (Ident ''head''), index LAST])"*)
  shows False
  proof -
    have "\<exists>i. ((s (Ident ''head'') ) = (index i))"
      using headIsIndex by auto
    then obtain i where b1:"((s (Ident ''head'') ) = (index i))"
      by blast
   (* have b2:"i\<le> LAST"
     using a1 a3 b1 axiomOnLe  apply auto        done*)
    show False
       apply(cut_tac a1 a2 b1 ,case_tac "i=LAST",auto)
       by (metis mod_Suc mod_mod_trivial n_not_Suc_n nat.inject)

  qed

lemma iPlusSucLatIsi:
  assumes a:" scalar2Bool (J LAST ''le'' [s (Ident ''head''), index LAST])"
  shows "J LAST ''+'' [expEval (J LAST) (applyPlusN head LAST) s, index (Suc 0)]=  s (Ident ''head'')"
   proof -
    have "\<exists>i. ((s (Ident ''head'') ) = (index i))"
      using headIsIndex by auto
    then obtain i where b1:"((s (Ident ''head'') ) = (index i))"
      by blast
    have b2:"i\<le> LAST"
     using a b1 axiomOnLe  apply auto   done
    show ?thesis
    apply(cut_tac b1 b2,simp)
    by (metis (full_types) Divides.mod_less add.commute add_Suc le_imp_less_Suc mod_Suc_eq_Suc_mod mod_add_self1)
qed

lemma  iPlusjPLUSIsNotj:
  assumes a1:"0 < LAST"  and a4:"i < LAST" and
  a3:" scalar2Bool (J LAST ''le'' [s (Ident ''head''), index LAST])"

  shows "J LAST ''+'' [expEval (J LAST) (applyPlusN head i) s, index (Suc 0)]\<noteq>s (Ident ''head'')"
proof -
    have "\<exists>i. ((s (Ident ''head'') ) = (index i))"
      using headIsIndex by auto
    then obtain j where b1:"((s (Ident ''head'') ) = (index j))"
      by blast
    have b2:"j\<le> LAST"
     using a1 a3 b1 axiomOnLe  apply auto        done
    have b3: "J LAST ''+'' [expEval (J LAST) (applyPlusN head i) s, index (Suc 0)]  =index ((j + Suc i) mod (Suc LAST))"
    by (metis Suc_eq_plus1 a4 b1 b2 discrete le_Suc_eq onApplyPlusI test1)

    have b4:"Suc i< Suc LAST"
    by (simp add: a4)  thm test5
    have b5:"((j + (Suc i)) mod (Suc LAST)) \<noteq>j"
    apply (cut_tac a1  b2 b4 ,rule test5,auto)
    done
    with b3 show "J LAST ''+'' [expEval (J LAST) (applyPlusN head i) s, index (Suc 0)] \<noteq> s (Ident ''head'')"
    by (simp add: b1)

qed
lemma substApplyHead[simp]:
  "substExp (applyPlusN head n) [(Ident ''head'', uif ''+'' [head, Const (index (Suc 0))])] =
         applyPlusN (uif ''+'' [head, Const (index (Suc 0))]) n"
proof(induct_tac n,auto)qed

lemma applyIPlusIsPlusI:
"J LAST ''+'' [expEval (J LAST) (applyPlusN head i) s, index (Suc 0)] =
         expEval (J LAST) (substExp (applyPlusN head i)
         [(Ident ''head'', uif ''+'' [head, Const (index (Suc 0))])]) s"
proof(induct_tac i,auto)qed

lemma substCaseExp:
  "substExp
   (caseExp
     (map (\<lambda>i. (g i,e i)) (down LAST)))
      subst0 =
    caseExp
      (map (\<lambda>i. (substForm (g i) subst0, substExp (e i) subst0))
      (down LAST))"        (is "?P LAST")
proof(induct_tac LAST,simp)
  fix n
  assume b:"?P n"
  show "?P (Suc n)" (is "substExp (?caseExp (Suc n)) subst0= caseExp (?list (Suc n))")
  proof -
  have c1:"substExp (?caseExp (Suc n)) subst0=
          substExp (caseExp ((g (Suc n), e (Suc n))#(map (\<lambda>i. (g i,e i)) (down n)))) subst0" (is "?LHS =?RHS1")
    apply (simp only:downSuc ,auto) done
  have c2:"?RHS1 =iteForm (substForm (g (Suc n)) subst0) (substExp (e (Suc n)) subst0) (caseExp (?list n))"
      (is "?RHS1=?RHS2")
      by (simp add: b)
  have c3:"?RHS2=caseExp ((substForm (g (Suc n)) subst0,substExp (e (Suc n)) subst0)#(?list n))"
      (is "?RHS2=?RHS3")
    by(simp )
  have c4:"?RHS3=caseExp (?list (Suc n))"
    by simp
    with c1 c2 c3 show "?P (Suc n)"
    by presburger
  qed
qed

lemma substCaseExp1:
  "substExp
   (caseExp
     (map (\<lambda>i. (eqn (applyPlusN head (j - Suc 0)) (Const (index i)), IVar (Para mem i))) (down LAST)))
      [(Ident ''head'', uif ''+'' [head, Const (index (Suc 0))])] =
    caseExp
      (map (\<lambda>i. (eqn (applyPlusN (uif ''+'' [head, Const (index (Suc 0))]) (j - Suc 0)) (Const (index i)), IVar (Para mem i)))
      (down LAST))"        (is "?P LAST")
using substCaseExp by auto

lemma consistencyOfRbfifo0:
  assumes a:"LAST=0 "
  shows "consistent' (ringBuffifo LAST ) (J LAST) (rbFifoGsteSpec LAST  data)
  (tagFunOfRingBufFifo  data LAST)"
  proof(unfold consistent'_def,rule allI,rule impI)
    fix e
    let ?G=" (rbFifoGsteSpec LAST  data)"
    let ?M="(ringBuffifo LAST )"
    let ?tag="(tagFunOfRingBufFifo  data LAST)"
    let ?P ="\<lambda>e.
    (let f=andListForm (?tag (sink e)) in
    let f'=andListForm (?tag (source e)) in
    tautlogy (implyForm (andForm f' (antOf ?G e)) (preCond1  f  ( ?M))) (J LAST))"

    assume a1:"e \<in> edgesOf (rbFifoGsteSpec LAST  data)"

    have "e=Edge vertexI ( Vertex 1) |
          e=Edge  ( Vertex 1) ( Vertex 3) |
          e=Edge  ( Vertex 1) ( Vertex 4)|
           (\<exists>i. 0\<le>i \<and> i\<le> LAST + 1 \<and>  e=( Edge (Vertex ( 2*i+1 ))  (Vertex (  2*i+1 ))) )   |
            (\<exists>i. 1\<le>i \<and> i\<le> LAST + 1 \<and>  e=( Edge (Vertex ( 2*i+2 ))  (Vertex (  2*i+2 ))) ) |

           e=Edge  ( Vertex 3) ( Vertex 1) |
           e=Edge (Vertex 4) (Vertex 1)"
      apply(cut_tac a a1,auto)  done
   moreover
    {assume b1:"e=Edge vertexI ( Vertex 1)"
     have "?P e"
     apply(cut_tac b1, simp add:antOfRbFifo_def)
     done
     }
    moreover
    {assume b1:" (\<exists>i. 0\<le>i \<and> i\<le> LAST +1  \<and>  e=( Edge (Vertex (2* i + 1))  (Vertex (  2*i + 1))) )  " (is "\<exists>i. ?asm i")
     from b1 obtain i where b2:"?asm i" by auto
      have "?P e"
       apply(cut_tac b2, simp add:antOfRbFifo_def substNIl) done
    }
    moreover
    {assume b1:" (\<exists>i. 1\<le>i \<and> i\<le> LAST+1 \<and>  e=( Edge (Vertex (2* i + 2))  (Vertex (  2*i + 2))) )  " (is "\<exists>i. ?asm i")
     from b1 obtain i where b2:"?asm i" by auto
      have "?P e"
       apply(cut_tac b2, simp add:antOfRbFifo_def substNIl) done
    }
     moreover
    {assume b1:" e=Edge  ( Vertex 1) ( Vertex 3) "

       let ?P' ="\<lambda>e.
       (let f=andListForm (?tag (sink e)) in
       let f'=andListForm (?tag (source e)) in
       tautlogy (implyForm (andForm f' (antOf ?G e)) (preCond1  f  (branch2 LAST))) (J LAST))"

        let ?P1="\<lambda>e.
       (let f=andListForm (?tag (sink e)) in
       let f'=andListForm (?tag (source e)) in
       let tailPlus=uif ''+'' [tail, (Const (index 1))] in
       let f1=andListForm [eqn tailPlus (applyPlusN head 1), eqn  LOW LOW,
         eqn full LOW, uip ''le'' [head,LASTE]] in
       tautlogy (implyForm (andForm f' (antOf ?G e)) f1) (J LAST))"
       have c1:"?P e= ?P' e"
        by (simp add: a b1 del:tautlogy_def,auto)

      (* have c2:"?P' e=?P1 e"
        apply (cut_tac a b1,simp del:tautlogy_def add:Let_def)
        apply(rule onIfExpPos)
        apply*)
        have "?P e "
       proof(cut_tac a b1,auto simp add:Let_def )
       fix s
       assume c1:"scalar2Bool (J 0 ''le'' [s (Ident ''head''), index 0]) " and
       c2:" J 0 ''+'' [s (Ident ''head''), index (Suc 0)] \<noteq> s (Ident ''head'')"
       have "\<exists>i. ((s (Ident ''head'') ) = (index i))"
       using headIsIndex by auto
       then obtain i where b1:"((s (Ident ''head'') ) = (index i))"
          by blast
       have b2:"i=0"
       using a c1 b1 axiomOnLe  apply auto        done
       show False
       apply(cut_tac b1 b2 c2 , auto) done

       qed

    }

     moreover
    {assume b1:" e=Edge  ( Vertex 1) ( Vertex 4) "
      let ?f="andForm (neg (eqn rst HIGH)) (andForm (eqn push HIGH) nFullForm ) "
       have "?P e "
       proof(cut_tac a b1,auto simp add:Let_def)
          fix s::state
          assume c1:"s (Ident ''head'') \<noteq> index 0 " and
          c2:"scalar2Bool (J 0 ''le'' [s (Ident ''head''), index 0])"
          have "\<exists>i. ((s (Ident ''head'') ) = (index i))"
             using headIsIndex by auto
          then obtain i where b1:"((s (Ident ''head'') ) = (index i))"
             by blast
          have b2:"i=0"
            using a c2 b1 axiomOnLe  apply auto        done
          show False
          apply(cut_tac b1 b2 c1 , auto) done
       qed
    }
    moreover
    {assume b1:"e=Edge  ( Vertex 3) ( Vertex 1)"

     have b3:"varOfExp (applyPlusN head i) =[Ident ''head'']"
        by simp
     have "?P e"
     proof(cut_tac a b1 b3,auto simp add:antOfRbFifo_def Let_def)
     fix s
     assume c1:" scalar2Bool (J 0 ''le'' [s (Ident ''head''), index 0])"
     have "\<exists>i. ((s (Ident ''head'') ) = (index i))"
        using headIsIndex by auto
     then obtain i where b1:"((s (Ident ''head'') ) = (index i))"
        by blast
     have b2:"i=0"
        using a c1 b1 axiomOnLe  apply auto        done
     show "scalar2Bool (J 0 ''le'' [J 0 ''+'' [s (Ident ''head''), index (Suc 0)], index 0])"
      apply(cut_tac b1 b2,auto)
     done
     qed
     }
    moreover
    {assume b1:"e=Edge  ( Vertex 4) ( Vertex 1)"

     have b3:"varOfExp (applyPlusN head i) =[Ident ''head'']"
        by simp
     have "?P e"
     proof(cut_tac a b1 b3,auto simp add:antOfRbFifo_def Let_def)
     qed
     }
    ultimately show "?P e" by satx
qed

lemma consistencyOfRbfifo:
  assumes a:"0 < LAST "
  shows "consistent' (ringBuffifo LAST ) (J LAST) (rbFifoGsteSpec LAST  data)
  (tagFunOfRingBufFifo  data LAST)"
  proof(unfold consistent'_def,rule allI,rule impI)
    fix e
    let ?G=" (rbFifoGsteSpec LAST  data)"
    let ?M="(ringBuffifo LAST )"
    let ?tag="(tagFunOfRingBufFifo  data LAST)"
    let ?P ="\<lambda>e.
    (let f=andListForm (?tag (sink e)) in
    let f'=andListForm (?tag (source e)) in
    tautlogy (implyForm (andForm f' (antOf ?G e)) (preCond1  f  ( ?M))) (J LAST))"

    assume a1:"e \<in> edgesOf (rbFifoGsteSpec LAST  data)"

    have "e=Edge vertexI ( Vertex 1) |
          e=Edge  ( Vertex 1) ( Vertex 3) |
          e=Edge  ( Vertex 1) ( Vertex 4)|
           (\<exists>i. 0\<le>i \<and> i\<le> LAST+1 \<and>  e=( Edge (Vertex ( 2*i+1 ))  (Vertex (  2*i+1 ))) )   |
            (\<exists>i. 1\<le>i \<and> i\<le> LAST+1 \<and>  e=( Edge (Vertex ( 2*i+2 ))  (Vertex (  2*i+2 ))) ) |

           (\<exists>i. 1\<le>i \<and> i\<le> LAST  \<and> e=( Edge (Vertex (2 * i + 1))  (Vertex (2 * i + 3))) ) |
           (\<exists>i. 1\<le>i \<and> i\<le> LAST  \<and> e=( Edge (Vertex (2 * i + 1))  (Vertex (2 * i + 4))) )  |

           (\<exists>i. 0\<le>i \<and> i\<le> LAST  \<and>  e= ( Edge (Vertex (2 * i + 3))  (Vertex (2 * i + 1))) ) |
           (\<exists>i. 1\<le>i \<and> i\<le> LAST   \<and> e=( Edge (Vertex(2 * i + 4))  (Vertex(2 *i+ 2))))|
           e=Edge (Vertex 4) (Vertex 1)"
      apply(cut_tac a a1,auto)  done
    moreover
    {assume b1:"e=Edge vertexI ( Vertex 1)"
     have "?P e"
     apply(cut_tac b1, simp add:antOfRbFifo_def)
     done
     }
    moreover
    {assume b1:" (\<exists>i. 0\<le>i \<and> i\<le> LAST+1  \<and>  e=( Edge (Vertex (2* i + 1))  (Vertex (  2*i + 1))) )  " (is "\<exists>i. ?asm i")
     from b1 obtain i where b2:"?asm i" by auto
      have "?P e"
       apply(cut_tac b2, simp add:antOfRbFifo_def substNIl) done
    }
    moreover
    {assume b1:" (\<exists>i. 1\<le>i \<and> i\<le> LAST+1  \<and>  e=( Edge (Vertex (2* i + 2))  (Vertex (  2*i + 2))) )  " (is "\<exists>i. ?asm i")
     from b1 obtain i where b2:"?asm i" by auto
      have "?P e"
       apply(cut_tac b2, simp add:antOfRbFifo_def substNIl) done
    }
     moreover
    {assume b1:" e=Edge  ( Vertex 1) ( Vertex 3) "

       let ?P' ="\<lambda>e.
       (let f=andListForm (?tag (sink e)) in
       let f'=andListForm (?tag (source e)) in
       tautlogy (implyForm (andForm f' (antOf ?G e)) (preCond1  f  (branch2 LAST))) (J LAST))"

        let ?P1="\<lambda>e.
       (let f=andListForm (?tag (sink e)) in
       let f'=andListForm (?tag (source e)) in
       let tailPlus=uif ''+'' [tail, (Const (index 1))] in
       let f1=andListForm [eqn tailPlus (applyPlusN head 1), eqn  LOW LOW,
         eqn full LOW, uip ''le'' [head,LASTE]] in
       tautlogy (implyForm (andForm f' (antOf ?G e)) f1) (J LAST))"
       have c1:"?P e= ?P' e"
        by (simp add: a b1 del:tautlogy_def,auto)

        have "?P e "
       proof(cut_tac a b1,auto simp add:Let_def )
       fix s
       assume c1:"0 <LAST" and
       c2:" J LAST ''+'' [s (Ident ''head''), index (Suc 0)] = s (Ident ''head'')"

       show False
       apply(cut_tac c1 c2 , blast intro:  iPlus1IsNotI ) done

       qed

    }

     moreover
    {assume b1:" e=Edge  ( Vertex 1) ( Vertex 4) "
      let ?f="andForm (neg (eqn rst HIGH)) (andForm (eqn push HIGH) nFullForm ) "
      have b2:"2*LAST +4 \<noteq> 4" apply(cut_tac a,arith) done
       have "?P e "
       proof(cut_tac a b1 b2,auto simp add:Let_def)
          fix s::state
          assume a1:"0 <LAST" and
          a2:"J LAST ''+'' [s (Ident ''head''), index (Suc 0)] = s (Ident ''head'')"

          show False
          apply(cut_tac a a2 , blast intro:  iPlus1IsNotI ) done
        next
          fix s
          assume a1:"s (Ident ''tail'') = s (Ident ''head'')" and
          a2:" scalar2Bool (J LAST ''le'' [s (Ident ''head''), index LAST])" and
          a3:"s (Ident ''dataIn'') = index data"
          have "\<exists>i. ((s (Ident ''head'') ) = (index i))"
          using headIsIndex by auto
          then obtain i where b1:"((s (Ident ''head'') ) = (index i))"
          by blast
          have b2:"i\<le> LAST"
          using a1 a2 b1 axiomOnLe  apply auto        done
          have b3:"
          expEval (J LAST)
          (substExp
            (caseExp (map (\<lambda>i. (eqn head (Const (index i)), IVar (Para mem i))) (down LAST)))
            (map (\<lambda>i. (Para mem i,
                       iteForm (eqn tail (Const (index i))) dataIn (IVar (Para mem i))))
              (down LAST)))
          s =
         expEval (J LAST) dataIn s" thm auxOnReadWrite
          using a1 a2 b1 b2  by auto
          show "
          expEval (J LAST)
          (substExp
            (caseExp (map (\<lambda>i. (eqn head (Const (index i)), IVar (Para mem i))) (down LAST)))
            (map (\<lambda>i. (Para mem i,
                       iteForm (eqn tail (Const (index i))) dataIn (IVar (Para mem i))))
              (down LAST)))
          s =
         index data"
          using a3 b3  by auto
     qed
    }

    moreover
    {assume b1:" \<exists>i. 1\<le>i \<and> i \<le>LAST \<and> e=Edge  ( Vertex (2*i + 1)) ( Vertex (2*i + 3))"     (is "\<exists>i. ?Q i")
      from b1 obtain i where b1:"?Q i" by blast
      have b2:"i - 1 < LAST" by(cut_tac a b1,auto)
      have b3:"varOfExp (applyPlusN head i) =[Ident ''head'']" by auto
      have "i=LAST \<or> i <LAST" by(cut_tac b1 ,auto)
      moreover
      {assume b4:"i =LAST"
      have "?P e "
      proof(cut_tac  a b1  b3 b4,auto simp add: antOfRbFifo_def assms Let_def)
        fix s
        assume  a1:"J LAST ''+'' [expEval (J LAST) (applyPlusN head LAST) s, index (Suc 0)] \<noteq> s (Ident ''head'')" and
          a2:" scalar2Bool (J LAST ''le'' [s (Ident ''head''), index LAST])"

          have b1:"J LAST ''+'' [expEval (J LAST) (applyPlusN head LAST) s, index (Suc 0)]= s (Ident ''head'')"
          by (simp add: a2 iPlusSucLatIsi)
          with a1 b1 show False by auto
      qed
      }
      moreover
      {assume b4:" i <LAST"
      have "?P e "
      proof(cut_tac  a b1 b3 b4,auto simp add: antOfRbFifo_def assms Let_def)
        fix s
        assume c1:" Suc 0 \<le> i " and c2:" i < LAST " and c3:"
        J LAST ''+'' [expEval (J LAST) (applyPlusN head i) s, index (Suc 0)] = s (Ident ''head'')"
        and c4:"scalar2Bool (J LAST ''le'' [s (Ident ''head''), index LAST]) "
        have c1:"0< i" by(cut_tac c1,simp)
        have c5:"J LAST ''+'' [expEval (J LAST) (applyPlusN head i) s, index (Suc 0)] \<noteq> s (Ident ''head'')"
        using assms c1 c2 c4 iPlusjPLUSIsNotj by blast

        with c3 show False by simp

      qed
      }
      ultimately have "?P e " by satx

     }

    moreover
    {assume b1:" \<exists>i. 1\<le>i \<and> i\<le> LAST \<and> e=Edge  ( Vertex (2*i + 1)) ( Vertex (2*i+4))    "(is "\<exists>i. ?Q i")
     from b1 obtain i where b1:"?Q i" by blast
      have b2:"i - 1 < LAST" by(cut_tac a b1,auto)
      have b3:"varOfExp (applyPlusN head i) =[Ident ''head'']"
        by simp
      have "i=LAST \<or> i <LAST" by(cut_tac b1 ,auto)
      moreover
      {assume b4:"i =LAST"
      have "?P e "
      proof(cut_tac  a b1  b3 b4,auto simp add:  assms Let_def)
        fix s
        assume  a1:"J LAST ''+'' [expEval (J LAST) (applyPlusN head LAST) s, index (Suc 0)] \<noteq> s (Ident ''head'')" and
          a2:" scalar2Bool (J LAST ''le'' [s (Ident ''head''), index LAST])"

          have b1:"J LAST ''+'' [expEval (J LAST) (applyPlusN head LAST) s, index (Suc 0)]= s (Ident ''head'')"
          by (simp add: a2 iPlusSucLatIsi)
          with a1 b1 show False by auto
      next
         fix s
          assume
          a4:"s (Ident ''tail'') = expEval (J LAST) (applyPlusN head LAST) s" and
          a2:" scalar2Bool (J LAST ''le'' [s (Ident ''head''), index LAST])" and
          a3:"s (Ident ''dataIn'') = index data"

          have "\<exists>i. ((s (Ident ''head'') ) = (index i))"
          using headIsIndex by auto
          then obtain j where b1:"((s (Ident ''head'') ) = (index j))"
          by blast
          have b2:"j\<le> LAST"
          using  a2 b1 axiomOnLe  apply auto        done
          (*have a0:"s (Ident ''tail'') = s (Ident ''head'')"*)
          have b3:"
          expEval (J LAST)
          (substExp
            (caseExp (map (\<lambda>i. (eqn (applyPlusN head LAST) (Const (index i)), IVar (Para mem i))) (down LAST)))
            (map (\<lambda>i. (Para mem i,
                       iteForm (eqn tail (Const (index i))) dataIn (IVar (Para mem i))))
              (down LAST)))
          s =
         expEval (J LAST) dataIn s" thm auxOnReadWrite
          using a4 a2 b1 b2  by auto
          show "
          expEval (J LAST)
          (substExp
            (caseExp (map (\<lambda>i. (eqn (applyPlusN head LAST) (Const (index i)), IVar (Para mem i))) (down LAST)))
            (map (\<lambda>i. (Para mem i,
                       iteForm (eqn tail (Const (index i))) dataIn (IVar (Para mem i))))
              (down LAST)))
          s =
         index data"
          using a3 b3  by auto
     qed

      }
      moreover
      {assume b4:" i <LAST"
      have "?P e "
      proof(cut_tac  a b1 b3 b4,auto simp add: antOfRbFifo_def assms Let_def)
        fix s
        assume c1:" Suc 0 \<le> i " and c2:" i < LAST " and c3:"
        J LAST ''+'' [expEval (J LAST) (applyPlusN head i) s, index (Suc 0)] = s (Ident ''head'')"
        and c4:"scalar2Bool (J LAST ''le'' [s (Ident ''head''), index LAST]) "

        have c1:"0< i" by(cut_tac c1,simp)
        have c5:"J LAST ''+'' [expEval (J LAST) (applyPlusN head i) s, index (Suc 0)] \<noteq> s (Ident ''head'')"
        using assms c1 c2 c4 iPlusjPLUSIsNotj by blast

        with c3 show False by simp

      next
        fix s
        assume
          a4:"s (Ident ''tail'') = expEval (J LAST) (applyPlusN head i) s" and
          a2:" scalar2Bool (J LAST ''le'' [s (Ident ''head''), index LAST])" and
          a3:"s (Ident ''dataIn'') = index data"

          have "\<exists>i. ((s (Ident ''head'') ) = (index i))"
          using headIsIndex by auto
          then obtain j where b1:"((s (Ident ''head'') ) = (index j))"
          by blast
          have b2:"j\<le> LAST"
          using  a2 b1 axiomOnLe  apply auto        done
          have b3:"expEval (J LAST) tail s = index ((j +i) mod (Suc LAST))"
            apply(cut_tac a4,simp)
            by (simp add: b1 b2 b4 less_or_eq_imp_le)
          have b4:"(j +i) mod (Suc LAST) \<le> LAST"   by simp
          (*have a0:"s (Ident ''tail'') = s (Ident ''head'')"*)

          have b5:"expEval (J LAST)
          (substExp
            (caseExp (map (\<lambda>i'. (eqn (applyPlusN head i) (Const (index i')), IVar (Para mem i'))) (down LAST)))
            (map (\<lambda>i'. (Para mem i',
                       iteForm (eqn tail (Const (index i'))) dataIn (IVar (Para mem i'))))
              (down LAST)))
          s =
         expEval (J LAST) dataIn s" thm readWrite
            apply(cut_tac b3 b4,  rule readWrite,auto)
            by (simp add: a4)
          show "expEval (J LAST)
          (substExp
            (caseExp (map (\<lambda>i'. (eqn (applyPlusN head i) (Const (index i')), IVar (Para mem i'))) (down LAST)))
            (map (\<lambda>i'. (Para mem i',
                       iteForm (eqn tail (Const (index i'))) dataIn (IVar (Para mem i'))))
              (down LAST)))
          s =
         index data"
          using a3 b5  by auto
      qed
      }
      ultimately have "?P e " by satx

     }

     moreover
    {assume b1:"\<exists>i. 0\<le>i \<and> i\<le> LAST \<and>  e=Edge  ( Vertex (2*i + 3)) ( Vertex (2*i + 1))   " (is "\<exists>i. ?Q i")
       from b1 obtain i where b1:"?Q i" by blast
      have b2:"i - 1 < LAST" by(cut_tac a b1,auto)
      have b3:"varOfExp (applyPlusN head i) =[Ident ''head'']"
        by simp
      have "i=LAST \<or> i <LAST" by(cut_tac b1 ,auto)
      moreover
      {assume b4:"i =LAST"
      have "?P e "
      proof(cut_tac  a b1  b3 b4,auto simp add:  assms Let_def)
        fix s
        assume b5:" LAST = 0"
        with a show "scalar2Bool (J 0 ''le'' [J 0 ''+'' [s (Ident ''head''), index (Suc 0)], index 0])" by simp
      next
        fix s
        assume c1:"J LAST ''+'' [expEval (J LAST) (applyPlusN head LAST) s, index (Suc 0)]
          = J LAST ''+'' [s (Ident ''head''), index (Suc 0)]" and
        c2:"scalar2Bool (J LAST ''le'' [s (Ident ''head''), index LAST])"
        have d1:"J LAST ''+'' [expEval (J LAST) (applyPlusN head LAST) s, index (Suc 0)]= s (Ident ''head'')"
          by (simp add: c2 iPlusSucLatIsi)

        have d2:"J LAST ''+'' [expEval (J LAST) (applyPlusN head 0) s, index (Suc 0)] =
        J LAST ''+'' [s (Ident ''head''), index (Suc 0)] "
        apply(simp) done thm iPlusjPLUSIsNotj
        have d3:"J LAST ''+'' [expEval (J LAST) (applyPlusN head 0) s, index (Suc 0)]\<noteq> s (Ident ''head'')"
        apply(cut_tac a c2,rule  iPlusjPLUSIsNotj,auto)  done
        with d1 d2 c1 show False
        by simp
      next
        fix s
        show "  J LAST ''+'' [expEval (J LAST) (applyPlusN head LAST) s, index (Suc 0)] =
         expEval (J LAST) (applyPlusN (uif ''+'' [head, Const (index (Suc 0))]) LAST) s"
         using applyIPlusIsPlusI by auto
      next
        fix s

          have "\<exists>i. ((s (Ident ''head'') ) = (index i))"
            using headIsIndex by auto
          then obtain j where b1:"((s (Ident ''head'') ) = (index j))"
            by blast
          show "scalar2Bool (J LAST ''le'' [J LAST ''+'' [s (Ident ''head''), index (Suc 0)], index LAST])"
          apply(cut_tac b1,auto) done
      qed
     }
     moreover
      {assume b4:"i <LAST"
      have "?P e "
      proof(cut_tac  a b1  b3 b4,auto simp add:  assms Let_def)
      fix s
      have "\<exists>i. ((s (Ident ''head'') ) = (index i))"
            using headIsIndex by auto
          then obtain j where b1:"((s (Ident ''head'') ) = (index j))"
            by blast
      show "scalar2Bool (J LAST ''le'' [J LAST ''+'' [s (Ident ''head''), index (Suc 0)], index LAST])"
        apply(cut_tac b1,auto) done

     next
      fix s
      assume c1:" J LAST ''+'' [expEval (J LAST) (applyPlusN head i) s, index (Suc 0)] =
      J LAST ''+'' [s (Ident ''head''), index (Suc 0)]" and
      c2:" scalar2Bool (J LAST ''le'' [s (Ident ''head''), index LAST])" and c3:"0<i"
       have "\<exists>i. ((s (Ident ''head'') ) = (index i))"
            using headIsIndex by auto
          then obtain j where e1:"((s (Ident ''head'') ) = (index j))"
            by blast
        have e2:"j\<le> LAST"
          using  c2 e1 axiomOnLe  apply auto        done thm  onApplyPlusI
        have e3:"expEval (J LAST) (applyPlusN head i) s= index ((j +i) mod Suc LAST)"
          by (simp add: e1 e2 b4 less_imp_le_nat)

        show False
       apply(cut_tac a b1 e1 e2 e3 c1 c3, simp)
       by (smt Divides.mod_less le_imp_less_Suc le_mod_geq mod_Suc nat.distinct(1) nat.inject neq0_conv not_less test5)
     next
      fix s
      have "\<exists>i. ((s (Ident ''head'') ) = (index i))"
            using headIsIndex by auto
          then obtain j where b1:"((s (Ident ''head'') ) = (index j))"
            by blast
      show " scalar2Bool (J LAST ''le'' [J LAST ''+'' [s (Ident ''head''), index (Suc 0)], index LAST])"
        apply(cut_tac b1,auto) done
     next
      fix s
        show "J LAST ''+'' [expEval (J LAST) (applyPlusN head i) s, index (Suc 0)] =
         expEval (J LAST) (applyPlusN (uif ''+'' [head, Const (index (Suc 0))]) i) s"
         by (simp add: applyIPlusIsPlusI)
    qed
    }
   ultimately have "?P e " by satx
   }

     moreover
    {assume b1:"\<exists>i.  1\<le>i \<and> i\<le> LAST \<and> e=Edge  ( Vertex (2*i + 4)) ( Vertex (2*i+2 ))   " (is "\<exists>i. ?Q i")
      from b1 obtain i where b1:"?Q i" by blast

      have b3:"varOfExp (applyPlusN head i) =[Ident ''head'']"
        by simp
      have "i=LAST \<or> i <LAST" by(cut_tac b1 ,auto)
      moreover
      {assume b4:"i =LAST"
      have "?P e "
      proof(cut_tac  a b1  b3 b4,auto simp add:  assms Let_def)
        fix s

        assume c1:" J LAST ''+'' [expEval (J LAST) (applyPlusN head LAST) s, index (Suc 0)] =
        J LAST ''+'' [s (Ident ''head''), index (Suc 0)]" and
        c2:" scalar2Bool (J LAST ''le'' [s (Ident ''head''), index LAST])"
        have "\<exists>i. ((s (Ident ''head'') ) = (index i))"
            using headIsIndex by auto
        then obtain j where e1:"((s (Ident ''head'') ) = (index j))"
            by blast
        have e2:"j\<le> LAST"
          using  c2 e1 axiomOnLe  apply auto        done thm  onApplyPlusI
        have e3:"J LAST ''+'' [expEval (J LAST) (applyPlusN head LAST) s, index (Suc 0)]= index j"
          by (metis c2 e1 iPlusSucLatIsi)

        have e4:"J LAST ''+'' [s (Ident ''head''), index (Suc 0)] = index ((j +1) mod Suc LAST) "
          by (simp add: e1)
        show False
          apply(cut_tac c1 e3 e4 a, simp)
          by (metis e1 iPlus1IsNotI)
      next
        fix s
        show "  J LAST ''+'' [expEval (J LAST) (applyPlusN head LAST) s, index (Suc 0)] =
          expEval (J LAST) (applyPlusN (uif ''+'' [head, Const (index (Suc 0))]) LAST) s"
          using applyIPlusIsPlusI by auto
      next
        fix s

          have "\<exists>i. ((s (Ident ''head'') ) = (index i))"
            using headIsIndex by auto
          then obtain j where b1:"((s (Ident ''head'') ) = (index j))"
            by blast
          show "scalar2Bool (J LAST ''le'' [J LAST ''+'' [s (Ident ''head''), index (Suc 0)], index LAST])"
          apply(cut_tac b1,auto) done
      next
        fix s
        assume
          a2:" scalar2Bool (J LAST ''le'' [s (Ident ''head''), index LAST])" and
          a4:"expEval (J LAST) (caseExp (map (\<lambda>i. (eqn (applyPlusN head LAST) (Const (index i)), IVar (Para mem i))) (down LAST))) s =
         index data"
          have "\<exists>i. ((s (Ident ''head'') ) = (index i))"
          using headIsIndex by auto
          then obtain j where b1:"((s (Ident ''head'') ) = (index j))"
          by blast
          have b2:"j\<le> LAST"
          using  a2 b1 axiomOnLe  apply auto        done
          (*have a0:"s (Ident ''tail'') = s (Ident ''head'')"*)
          have b20:"tautlogy (eqn (applyPlusN (uif ''+'' [head, Const (index (Suc 0))]) (LAST - Suc 0))
                              (applyPlusN (uif ''+'' [head, Const (index (Suc 0))]) (LAST - Suc 0))) (J LAST)"
                  apply(induct_tac LAST, auto) done
          have b3:"
          expEval (J LAST)
          (substExp
            (caseExp
              (map (\<lambda>i. (eqn (applyPlusN head (LAST - Suc 0)) (Const (index i)), IVar (Para mem i))) (down LAST)))
            [(Ident ''head'', uif ''+'' [head, Const (index (Suc 0))])])
          s   =
           expEval (J LAST)
          (caseExp
            (map (\<lambda>i. (eqn (applyPlusN (uif ''+'' [head, Const (index (Suc 0))]) (LAST - Suc 0)) (Const (index i)), IVar (Para mem i)))
            (down LAST))) s"
            using substCaseExp1 by auto

         have b4:" expEval (J LAST)
          ((caseExp (map (\<lambda>i. (eqn (applyPlusN (uif ''+'' [head, Const (index (Suc 0))]) (LAST - Suc 0)) (Const (index i)),
          IVar (Para mem i))) (down LAST)))
            )
          s =
         expEval (J LAST) (caseExp (map (\<lambda>i. (eqn (applyPlusN head LAST) (Const (index i)), IVar (Para mem i))) (down LAST))) s"
         proof(rule caseExpCong1,simp)

            have "\<exists>i. ((s (Ident ''head'') ) = (index i))"
            using headIsIndex by auto
            then obtain j where b1:"((s (Ident ''head'') ) = (index j))"
              by blast
            have b2:"j\<le> LAST"
            using  a2 b1 axiomOnLe  apply auto        done
            show "expEval (J LAST) (applyPlusN (uif ''+'' [head, Const (index (Suc 0))]) (LAST - Suc 0)) s
            = expEval (J LAST) (applyPlusN head LAST) s"
            apply(cut_tac a b1 b2,auto) done
          qed

          show "expEval (J LAST)
          (substExp (caseExp (map (\<lambda>i. (eqn (applyPlusN head (LAST - Suc 0)) (Const (index i)), IVar (Para mem i))) (down LAST)))
            [(Ident ''head'', uif ''+'' [head, Const (index (Suc 0))])])
          s =
         index data"
         by (simp add: a4 b3 b4)

      qed
     }
    moreover
    {assume b4:"i <LAST"
      have "?P e "
      proof(cut_tac  a b1  b3 b4,auto simp add:  assms Let_def)
      fix s
      have "\<exists>i. ((s (Ident ''head'') ) = (index i))"
            using headIsIndex by auto
          then obtain j where b1:"((s (Ident ''head'') ) = (index j))"
            by blast
      show "scalar2Bool (J LAST ''le'' [J LAST ''+'' [s (Ident ''head''), index (Suc 0)], index LAST])"
        apply(cut_tac b1,auto) done

     next
      fix s
      assume c1:" J LAST ''+'' [expEval (J LAST) (applyPlusN head i) s, index (Suc 0)] =
      J LAST ''+'' [s (Ident ''head''), index (Suc 0)]" and
      c2:" scalar2Bool (J LAST ''le'' [s (Ident ''head''), index LAST])" and c3:"Suc 0 \<le> i"
       have "\<exists>i. ((s (Ident ''head'') ) = (index i))"
            using headIsIndex by auto
          then obtain j where e1:"((s (Ident ''head'') ) = (index j))"
            by blast
        have e2:"j\<le> LAST"
          using  c2 e1 axiomOnLe  apply auto        done thm  onApplyPlusI
        have e3:"expEval (J LAST) (applyPlusN head i) s= index ((j +i) mod Suc LAST)"
          by (simp add: e1 e2 b4 less_imp_le_nat)

        show False
       apply(cut_tac a b1 e1 e2 e3 c1 c3, simp)
       by (smt Divides.mod_less le_imp_less_Suc le_mod_geq mod_Suc nat.distinct(1) nat.inject neq0_conv not_less test5)
     next
      fix s
      assume d1:"i <LAST" and d2:"Suc 0 \<le> i"
        show "J LAST ''+'' [expEval (J LAST) (applyPlusN head i) s, index (Suc 0)] =
         expEval (J LAST) (applyPlusN (uif ''+'' [head, Const (index (Suc 0))]) i) s"
         by (simp add: applyIPlusIsPlusI)
      next
       fix s
        assume
          a1:"Suc 0 \<le> i" and
          a2:" scalar2Bool (J LAST ''le'' [s (Ident ''head''), index LAST])" and
          a4:"expEval (J LAST) (caseExp (map (\<lambda>ia. (eqn (applyPlusN head i) (Const (index ia)), IVar (Para mem ia))) (down LAST))) s =
         index data"
          have "\<exists>i. ((s (Ident ''head'') ) = (index i))"
          using headIsIndex by auto
          then obtain j where b1:"((s (Ident ''head'') ) = (index j))"
          by blast
          have b2:"j\<le> LAST"
          using  a2 b1 axiomOnLe  apply auto        done
          (*have a0:"s (Ident ''tail'') = s (Ident ''head'')"*)
          have b20:"tautlogy (eqn (applyPlusN (uif ''+'' [head, Const (index (Suc 0))]) (LAST - Suc 0))
                              (applyPlusN (uif ''+'' [head, Const (index (Suc 0))]) (LAST - Suc 0))) (J LAST)"
                  apply(induct_tac LAST, auto) done
          have b3:"
          expEval (J LAST)
          (substExp
            (caseExp
              (map (\<lambda>ia. (eqn (applyPlusN head (i - Suc 0)) (Const (index ia)), IVar (Para mem ia))) (down LAST)))
            [(Ident ''head'', uif ''+'' [head, Const (index (Suc 0))])])
          s   =
           expEval (J LAST)
          (caseExp
            (map (\<lambda>ia. (eqn (applyPlusN (uif ''+'' [head, Const (index (Suc 0))]) (i - Suc 0)) (Const (index ia)), IVar (Para mem ia)))
            (down LAST))) s"
            using substCaseExp1 by auto

         have c4:" expEval (J LAST)
          ((caseExp (map (\<lambda>ia. (eqn (applyPlusN (uif ''+'' [head, Const (index (Suc 0))]) (i - Suc 0)) (Const (index ia)),
          IVar (Para mem ia))) (down LAST)))
            )
          s =
         expEval (J LAST) (caseExp (map (\<lambda>ia. (eqn (applyPlusN head i) (Const (index ia)), IVar (Para mem ia))) (down LAST))) s"
         proof(rule caseExpCong1,simp)

            have "\<exists>i. ((s (Ident ''head'') ) = (index i))"
            using headIsIndex by auto
            then obtain j where b1:"((s (Ident ''head'') ) = (index j))"
              by blast
            have b2:"j\<le> LAST"
            using  a2 b1 axiomOnLe  apply auto        done
            show "expEval (J LAST) (applyPlusN (uif ''+'' [head, Const (index (Suc 0))]) (i - Suc 0)) s
            = expEval (J LAST) (applyPlusN head i) s"
            apply(cut_tac a b1 b2 b4 a1,auto)
            done
          qed

          show "expEval (J LAST)
          (substExp (caseExp (map (\<lambda>ia. (eqn (applyPlusN head (i - Suc 0)) (Const (index ia)), IVar (Para mem ia))) (down LAST)))
            [(Ident ''head'', uif ''+'' [head, Const (index (Suc 0))])])
          s =
         index data"
         by (simp add: a4 b3 c4)

      qed
    }
    ultimately have "?P e" by satx
    }
    moreover
    {assume b1:"e=Edge (Vertex 4) ( Vertex 1)"
     have "?P e"
     proof(cut_tac a b1, simp add:antOfRbFifo_def Let_def,auto)
     fix s
     assume c2:" scalar2Bool (J LAST ''le'' [s (Ident ''head''), index LAST])"
       have "\<exists>i. ((s (Ident ''head'') ) = (index i))"
            using headIsIndex by auto
          then obtain j where e1:"((s (Ident ''head'') ) = (index j))"
            by blast
        have e2:"j\<le> LAST"
         using  c2 e1 axiomOnLe  apply auto        done
        show " scalar2Bool (J LAST ''le'' [J LAST ''+'' [s (Ident ''head''), index (Suc 0)], index LAST]) "
        apply(cut_tac e1 e2,auto) done
     qed
     }
ultimately show "?P e" by satx
qed
lemma testAux[simp]:

shows "(expEval I e s =index i \<longrightarrow>
i \<le> LAST\<longrightarrow>expEval I (caseExp ((map (\<lambda>i. (eqn e (Const (index i)), me i)) (down LAST)@S))) s
=expEval  I  (me i) s) \<and>
(expEval I e s =index i \<longrightarrow>
 LAST < i\<longrightarrow>expEval I (caseExp ((map (\<lambda>i. (eqn e (Const (index i)),me i)) (down LAST)@S))) s
=expEval  I  (caseExp S) s)"  (is "?P LAST")
proof(induct_tac LAST,auto )qed

lemma test[simp]:
shows "(expEval I e s =index i \<longrightarrow>
i \<le> LAST\<longrightarrow>expEval I (caseExp ((map (\<lambda>i. (eqn e (Const (index i)), me i)) (down LAST)))) s
=expEval  I  (me i) s)"
proof -
have a:"(expEval I e s =index i \<longrightarrow>
i \<le> LAST\<longrightarrow>expEval I (caseExp ((map (\<lambda>i. (eqn e (Const (index i)), me i)) (down LAST)@[]))) s
=expEval  I  (me i) s)"
apply(cut_tac testAux  [where I="I" and S="[]" and i="i" and e="e" and s="s" and LAST="LAST" and me="me"])
apply simp
done
then show ?thesis by auto
qed

lemma instImply:
assumes a:"G=(rbFifoGsteSpec LAST  data)"   and c:"tag=tagFunOfRingBufFifo  data LAST"
shows
"\<forall> e. e \<in>edgesOf G\<longrightarrow>
tautlogy (implyForm (andForm (antOf G e) (andListForm (tag (source e)))) (consOf G e)) I"
proof(rule allI,rule impI,simp,rule allI,rule impI)
  fix e s
  assume a1:"e \<in> edgesOf G " and a2:"
           formEval I (antOf G e) s \<and> formEval I (andListForm (tag (source e))) s"
  let ?P ="\<lambda>e. formEval I (consOf G e) s"
  have "e=Edge vertexI ( Vertex 1) |
          e=Edge  ( Vertex 1) ( Vertex 3) |
          e=Edge  ( Vertex 1) ( Vertex 4)|
           (\<exists>i. 0\<le>i \<and> i\<le> LAST+1 \<and>  e=( Edge (Vertex ( 2*i+1 ))  (Vertex (  2*i+1 ))) )   |
            (\<exists>i. 1\<le>i \<and> i\<le> LAST+1 \<and>  e=( Edge (Vertex ( 2*i+2 ))  (Vertex (  2*i+2 ))) ) |

           (\<exists>i. 1\<le>i \<and> i\<le> LAST  \<and> e=( Edge (Vertex (2 * i + 1))  (Vertex (2 * i + 3))) ) |
           (\<exists>i. 1\<le>i \<and> i\<le> LAST  \<and> e=( Edge (Vertex (2 * i + 1))  (Vertex (2 * i + 4))) )  |

           (\<exists>i. 0\<le>i \<and> i\<le> LAST  \<and>  e= ( Edge (Vertex (2 * i + 3))  (Vertex (2 * i + 1))) ) |
           (\<exists>i. 1\<le>i \<and> i\<le> LAST   \<and> e=( Edge (Vertex(2 * i + 4))  (Vertex(2 *i+ 2))))|
           e=Edge (Vertex 4) (Vertex 1)"
      apply(cut_tac a a1,auto)  done

    moreover
    {assume b1:"e=Edge vertexI ( Vertex 1)"
     have "?P e"
     apply(cut_tac a b1, simp add:antOfRbFifo_def) done
     }
    moreover
    {assume b1:" (\<exists>i. 0\<le>i \<and> i\<le> LAST +1  \<and>  e=( Edge (Vertex (2* i + 1))  (Vertex (  2*i + 1))) )  " (is "\<exists>i. ?asm i")
     from b1 obtain i where b2:"?asm i" by auto
      have "?P e"
       apply(cut_tac a  c a2 b2, auto) done
    }
    moreover
    {assume b1:" (\<exists>i. 1\<le>i \<and> i\<le> LAST+1  \<and>  e=( Edge (Vertex (2* i + 2))  (Vertex (  2*i + 2))) )  " (is "\<exists>i. ?asm i")
     from b1 obtain i where b2:"?asm i" by auto
      have "?P e"
       apply(cut_tac  a  c a2 b2,auto) done
    }
     moreover
    {assume b1:" e=Edge  ( Vertex 1) ( Vertex 3) "

       have "?P e"
        apply(cut_tac a  c a2 b1,auto ) done
    }

     moreover
    {assume b1:" e=Edge  ( Vertex 1) ( Vertex 4) "
      let ?f="andForm (neg (eqn rst HIGH)) (andForm (eqn push HIGH) (neg (eqn tail (Const (index LAST )))) ) "

       have "?P e "
        apply(cut_tac a a1 a2 b1 ,auto simp add: antOfRbFifo_def assms) done
    }

    moreover
    {assume b1:" \<exists>i. 1\<le>i \<and> i\<le> LAST \<and> e=Edge  ( Vertex (2*i + 1)) ( Vertex (2*i + 3))"     (is "\<exists>i. ?Q i")
      from b1 obtain i where b1:"?Q i" by blast
      have "?P e "
        by(cut_tac  a  c a2 b1 ,auto simp add: antOfRbFifo_def assms )
     }

    moreover
    {assume b1:" \<exists>i. 1\<le>i \<and> i\<le> LAST \<and> e=Edge  ( Vertex (2*i + 1)) ( Vertex (2*i+4))    "(is "\<exists>i. ?Q i")
      from b1 obtain i where b1:"?Q i" by blast
      have "?P e "
        by(cut_tac a b1 a1 a2,auto simp add: antOfRbFifo_def assms)
     }

     moreover
    {assume b1:"\<exists>i. 0\<le>i \<and> i\<le> LAST \<and>  e=Edge  ( Vertex (2*i + 3)) ( Vertex (2*i + 1))   " (is "\<exists>i. ?Q i")
       from b1 obtain i where b1:"?Q i" by blast
       have "?P e "
        by(cut_tac   a  c a2 b1 ,auto simp add:Let_def antOfRbFifo_def assms )
     }

     moreover
    {assume b1:"\<exists>i.  1\<le>i \<and> i\<le> LAST \<and> e=Edge  ( Vertex (2*i + 4)) ( Vertex (2*i +2))   " (is "\<exists>i. ?Q i")
      from b1 obtain i where b1:"?Q i" by blast
      have "?P e "
         by(cut_tac  a   a2 b1 ,auto simp add: Let_def antOfRbFifo_def assms)

     }
    moreover
    {assume b1:"e=Edge (Vertex 4) ( Vertex 1)"
     have "?P e"
     apply(cut_tac  a  c a2 b1 ,case_tac "LAST=0",auto  simp add: Let_def antOfRbFifo_def assms) done
     }
    ultimately show "?P e" by satx
  qed

lemma main:
assumes a:"G=(rbFifoGsteSpec LAST  data)"
and c:"tag=tagFunOfRingBufFifo  data LAST" and
d:"M=(ringBuffifo  LAST )"
shows " circuitSatGsteSpec M G (J LAST) "
proof(rule mainLemma)
have a1:"consistent' (ringBuffifo LAST ) (J LAST) (rbFifoGsteSpec LAST  data) (tagFunOfRingBufFifo  data LAST)"
   apply (case_tac "LAST=0",rule consistencyOfRbfifo0,simp)
   apply(rule   consistencyOfRbfifo,arith) done
from a c d this show "consistent' M   (J LAST) G tag"
  by simp
next
from a  c show "\<forall>e. e \<in> edgesOf G \<longrightarrow>
        tautlogy (implyForm (andForm (antOf G e) (andListForm (tag (source e)))) (consOf G e)) (J LAST)"
apply(rule instImply) done
next
from a c show "tag (initOf G) = []"
apply auto done
qed
end


section \<open> RoboChart Meta-Model \<close>

theory MetaModel
  imports Actions
begin

subsection \<open> State Machine Syntax \<close>

text \<open> All state machine statespace types extend the following type which provides a state control variable \<close>

type_synonym ID = String.literal

alphabet robochart_ctrl =
  rc_ctrl :: ID

type_synonym 's rcst = "'s robochart_ctrl_scheme"
type_synonym ('s, 'e) RoboAction = "('s robochart_ctrl_scheme, 'e) Actions.Action"
type_synonym 's RoboPred = "'s robochart_ctrl_scheme upred"

translations
  (type) "'s rcst" <= (type) "'s robochart_ctrl_scheme"
  (type) "('s, 'e) RoboAction" <= (type) "('s rcst, 'e) Action"
  (type) "'s RoboPred" <= (type) "'s rcst upred"

abbreviation "rc_state \<equiv> robochart_ctrl.more\<^sub>L"

notation rc_state ("\<^bold>r")

syntax
  "_svid_rc_state"  :: "svid" ("\<^bold>r")

translations
  "_svid_rc_state" == "CONST rc_state"
  "_svid_dot \<^bold>r x" <= "x ;\<^sub>L \<^bold>r"

record ('s, 'e) Transition =
  tn_source    :: ID
  tn_target    :: ID
  tn_trigger   :: "('s, 'e) Actions.Action option"
  tn_condition :: "'s upred"
  tn_action    :: "('s, 'e) Actions.Action"

declare Transition.defs [simp]

record ('s, 'e) Node =
  n_name   :: "ID"
  n_entry  :: "('s, 'e) Action"
  n_during :: "('s, 'e) Action"
  n_exit   :: "('s, 'e) Action"

declare Node.defs [simp]

record ('s, 'e) StateMachine =
  sm_initial     :: "String.literal" ("init\<index>")
  sm_finals      :: "String.literal list" ("finals\<index>")
  sm_nodes       :: "('s, 'e) Node list" ("nodes\<index>")
  sm_transitions :: "('s, 'e) Transition list" ("\<^bold>T\<index>")

declare StateMachine.defs [simp]

thm set_map

definition sm_node_names :: "('s, 'e) StateMachine \<Rightarrow> String.literal set" ("nnames\<index>") where
"sm_node_names sm \<equiv> n_name ` set(sm_nodes sm)"

definition sm_inters :: "('s, 'e) StateMachine \<Rightarrow> ('s, 'e) Node list" where
"sm_inters sm = filter (\<lambda> n. n_name n \<notin> set(sm_finals sm)) (sm_nodes sm)"

definition sm_inter_names ("inames\<index>") where
"sm_inter_names sm \<equiv> n_name ` set (sm_inters sm)"

abbreviation sm_final_names ("fnames\<index>") where
"sm_final_names M \<equiv> set (finals\<^bsub>M\<^esub>)"

definition sm_node_map :: "('s, 'e) StateMachine \<Rightarrow> (ID \<rightharpoonup> ('s, 'e) Node)" ("nmap\<index>") where
"sm_node_map M = map_of (map (\<lambda> n. (n_name n, n)) (sm_nodes M))"

definition sm_trans_map :: "('s, 'e) StateMachine \<Rightarrow> (ID \<rightharpoonup> ('s, 'e) Transition list)" ("tmap\<index>") where
"sm_trans_map M = map_of (map (\<lambda> n. (n_name n, filter (\<lambda> t. tn_source t = n_name n) (sm_transitions M))) (sm_nodes M))"

lemma dom_sm_node_map: "dom(nmap\<^bsub>M\<^esub>) = nnames\<^bsub>M\<^esub>"
  using image_iff by (force simp add: sm_node_map_def sm_node_names_def dom_map_of_conv_image_fst)

lemma dom_sm_trans_map: "dom(tmap\<^bsub>M\<^esub>) = nnames\<^bsub>M\<^esub>"
  using image_iff by (force simp add: sm_trans_map_def sm_node_names_def dom_map_of_conv_image_fst)

lemma nnames_finite: "finite(nnames\<^bsub>M\<^esub>)"
  by (force simp add: sm_node_names_def)

abbreviation sm_init_node :: "('s, 'e) StateMachine \<Rightarrow> ('s, 'e) Node" ("ninit\<index>") where
"sm_init_node M \<equiv> the (sm_node_map M (sm_initial M))"

subsection \<open> Well-Formedness \<close>

locale WfStateMachine =
  fixes M :: "('s, 'm) StateMachine" (structure)
  \<comment> \<open> The list of nnames is a set \<close>
  assumes nnames_distinct: "distinct (map n_name (nodes\<^bsub>M\<^esub>))"
  and init_is_state: "init \<in> nnames"
  and init_not_final: "init \<notin> fnames"
  and trans_wf: " \<And> t. t \<in> set(\<^bold>T) \<Longrightarrow> tn_source t \<in> inames \<and> tn_target t \<in> nnames"
begin
  lemma init_is_inter: "init \<in> inames"
    using init_is_state init_not_final by (auto simp add: sm_inters_def sm_inter_names_def sm_node_names_def)

  lemma nmap_init: "nmap init = Some ninit"
    by (metis domIff dom_sm_node_map init_is_state option.exhaust_sel)

  lemma n_name_init: "n_name ninit = init"
  proof (simp add: sm_node_map_def)
    have "map_of (map (\<lambda>n. (n_name n, n)) (sm_nodes M)) init = Some (the (map_of (map (\<lambda>n. (n_name n, n)) (sm_nodes M)) init))"
      by (metis (no_types) nmap_init sm_node_map_def)
    then show "n_name (the (map_of (map (\<lambda>n. (n_name n, n)) (sm_nodes M)) init)) = init"
      using map_of_SomeD by force
  qed

  lemma nmap_name:
    assumes "n \<in> set(sm_nodes M)"
    shows "nmap (n_name n) = Some n"
  proof -
    have "distinct (map fst (map (\<lambda>n. (n_name n, n)) (sm_nodes M)))"
      by (simp add: comp_def nnames_distinct)
    with assms show ?thesis
      by (simp add: sm_node_map_def)
  qed

  lemma ninit_is_node: "ninit \<in> set(sm_nodes M)"
    using init_is_state nmap_name by (auto simp add: sm_node_names_def)

  lemma tmap_node_in_trans:
    assumes "n \<in> nnames" "ts \<in> ran(tmap)"
    shows "set(ts) \<subseteq> set(\<^bold>T)"
    using assms by (auto simp add: sm_trans_map_def ran_distinct nnames_distinct comp_def)

  lemma node_tran_exists:
    assumes "n \<in> nnames" "t \<in> set(the(tmap n))"
    shows "t \<in> set(\<^bold>T)"
    by (metis (mono_tags, hide_lams) assms(1) assms(2) domIff dom_sm_trans_map in_mono init_is_state option.collapse ranI tmap_node_in_trans)

end

method check_machine uses defs =
  (unfold_locales,
   simp_all add: defs sm_node_names_def sm_inter_names_def sm_inters_def, safe, simp_all)

subsection \<open> State Machine Semantics \<close>

abbreviation "trigger_semantics t null_event \<equiv>
  (case tn_trigger t of Some e \<Rightarrow> if productive e then e else sync null_event | None \<Rightarrow> sync null_event)"

no_utp_lift tn_condition

definition tr_semantics :: "('s, 'e) Transition \<Rightarrow> (unit, 'e) chan \<Rightarrow> ('s, 'e) RoboAction" ("\<lbrakk>_\<rbrakk>\<^sub>T") where
"tr_semantics t null_event \<equiv>
  tn_condition t \<oplus>\<^sub>p rc_state \<^bold>&
  rc_state:[trigger_semantics t null_event ; tn_action t]\<^sub>A\<^sup>+ ; rc_ctrl := \<guillemotleft>tn_target t\<guillemotright>"

definition node_semantics ::
  "('s, 'e) StateMachine \<Rightarrow> (unit, 'e) chan \<Rightarrow> ('s, 'e) Node \<Rightarrow> ('s, 'e) RoboAction" ("_;_ \<turnstile> \<lbrakk>_\<rbrakk>\<^sub>N" [10,0,0] 10) where
  "node_semantics M null_event node  =
  (rc_state:[n_entry node]\<^sub>A\<^sup>+ ;
   (foldr (\<box>) (map (\<lambda> t. \<lbrakk>t\<rbrakk>\<^sub>T null_event) (the (tmap\<^bsub>M\<^esub> (n_name node)))) stop) ;
   rc_state:[n_exit node]\<^sub>A\<^sup>+)"

definition sm_semantics :: "('s, 'e) StateMachine \<Rightarrow> (unit, 'e) chan \<Rightarrow> ('s, 'e) RoboAction" ("\<lbrakk>_\<rbrakk>\<^sub>M") where
"sm_semantics M null_event =
    (rc_ctrl := \<guillemotleft>sm_initial M\<guillemotright> ;
    iteration (map (\<lambda> n. (&rc_ctrl =\<^sub>u \<guillemotleft>n_name n\<guillemotright>, M;null_event \<turnstile> \<lbrakk>n\<rbrakk>\<^sub>N)) (sm_inters M)))"

lemmas sm_sem_def = sm_semantics_def node_semantics_def sm_inters_def sm_inter_names_def

lemma tr_semantics_subst_ctrl: "[&rc_ctrl \<mapsto>\<^sub>s \<guillemotleft>k\<guillemotright>] \<dagger> (\<lbrakk>a\<rbrakk>\<^sub>T null_event) = \<lbrakk>a\<rbrakk>\<^sub>T null_event"
  by (simp add: tr_semantics_def action_simp usubst unrest frame_asubst)

lemma tr_choice_subst_ctrl:
  "[&rc_ctrl \<mapsto>\<^sub>s \<guillemotleft>k\<guillemotright>] \<dagger> foldr (\<box>) (map (\<lambda>t. \<lbrakk>t\<rbrakk>\<^sub>T null_event) ts) stop = foldr (\<box>) (map (\<lambda>t. \<lbrakk>t\<rbrakk>\<^sub>T null_event) ts) stop"
  by (induct ts, simp_all add: action_simp usubst tr_semantics_subst_ctrl)

lemma sm_semantics_subst_ctrl:
  "[&rc_ctrl \<mapsto>\<^sub>s \<guillemotleft>k\<guillemotright>] \<dagger> node_semantics M null_event node = node_semantics M null_event node"
  by (simp add: node_semantics_def action_simp frame_asubst tr_choice_subst_ctrl unrest)

subsection \<open> Theorems \<close>

lemma productive_tr_semantics [closure]: "productive (\<lbrakk>t\<rbrakk>\<^sub>T null_event)"
  by (cases "tn_trigger t", auto simp add: tr_semantics_def action_rep_eq closure unrest)

lemma productive_node_semantics:
  "productive (M;null_event \<turnstile> \<lbrakk>node\<rbrakk>\<^sub>N)"
proof -
  have "\<And> ts. productive (foldr (\<box>) (map (\<lambda> t. \<lbrakk>t\<rbrakk>\<^sub>T null_event) ts) stop)"
    by (rename_tac ts, induct_tac ts, auto simp add: action_rep_eq closure, simp add: closure productive_Productive)
  hence "productive (foldr (\<box>) (map (\<lambda> t. \<lbrakk>t\<rbrakk>\<^sub>T null_event) (the (tmap\<^bsub>M\<^esub> (n_name node)))) stop)"
    by blast
  thus ?thesis
    by (simp add: action_rep_eq closure node_semantics_def)
qed

lemma Sup_Collect_as_UINF:
  "\<Sqinter> {P x | x. x \<in> A} = (\<Sqinter> x \<in> A \<bullet> P x)"
  apply (simp add: UINF_as_Sup[THEN sym], rel_simp)
  apply (rule cong[of Sup Sup])
   apply (auto)
  done

lemma Sup_Collect_2_as_UINF:
  "\<Sqinter> {P x y | x y. (x, y) \<in> A} = (\<Sqinter> (x, y) \<in> A \<bullet> P x y)"
  apply (simp add: UINF_as_Sup[THEN sym], rel_simp)
  apply (rule cong[of Sup Sup])
   apply (auto)
  done

lemma UINF_Collect: "(\<Sqinter> b \<in> {F(x)| x . x \<in> A} \<bullet> b) = (\<Sqinter> x \<in> A \<bullet> F(x))"
  by (simp add: Sup_Collect_as_UINF UINF_as_Sup)

lemma ueq_literlise [lit_simps]:
  "(\<guillemotleft>x = y\<guillemotright>) = (\<guillemotleft>x\<guillemotright> =\<^sub>u \<guillemotleft>y\<guillemotright>)"
  by (rel_auto)

lemma seq_refine_mono:
  fixes P\<^sub>1 P\<^sub>2 Q\<^sub>1 Q\<^sub>2 :: "('s, 'e) Action"
  assumes "P\<^sub>1 \<sqsubseteq> Q\<^sub>1" "P\<^sub>2 \<sqsubseteq> Q\<^sub>2"
  shows "P\<^sub>1 ; P\<^sub>2 \<sqsubseteq> Q\<^sub>1 ; Q\<^sub>2"
  using assms
  by (simp add: action_rep_eq seqr_mono)

lemma StateMachine_refine_intro:
  fixes
    S :: "('s, 'e) RoboAction" and
    M :: "('s, 'e) StateMachine"
  assumes
    "WfStateMachine M"
    "S \<sqsubseteq> (M;null_event \<turnstile> \<lbrakk>ninit\<^bsub>M\<^esub>\<rbrakk>\<^sub>N)"
    "\<And> n. n \<in> inames\<^bsub>M\<^esub> \<Longrightarrow> S \<sqsubseteq> S ; (M;null_event \<turnstile> \<lbrakk>the(nmap\<^bsub>M\<^esub> n)\<rbrakk>\<^sub>N)"
  shows "S \<sqsubseteq> \<lbrakk>M\<rbrakk>\<^sub>M null_event"
proof -
  interpret wf: WfStateMachine M
    by (simp add: assms)
  have 1: "\<And>n. n \<in> set(sm_inters M) \<Longrightarrow> productive (M;null_event \<turnstile> \<lbrakk>n\<rbrakk>\<^sub>N)"
    by (simp add: productive_node_semantics)
  have 2: "S \<sqsubseteq> rc_ctrl := \<guillemotleft>init\<^bsub>M\<^esub>\<guillemotright> ; [\<not> (\<Sqinter> (b, P) \<in> (\<lambda>n. (&rc_ctrl =\<^sub>u \<guillemotleft>n_name n\<guillemotright>, M;null_event \<turnstile> \<lbrakk>n\<rbrakk>\<^sub>N)) ` set(sm_inters M) \<bullet> b)]\<^sub>A"
  proof -
    have a:"(\<lambda> n. (&rc_ctrl =\<^sub>u \<guillemotleft>n_name n\<guillemotright> :: 's RoboPred, M;null_event \<turnstile> \<lbrakk>n\<rbrakk>\<^sub>N)) ` set(sm_inters M) =
             {(&rc_ctrl =\<^sub>u \<guillemotleft>n_name n\<guillemotright>, M;null_event \<turnstile> \<lbrakk>n\<rbrakk>\<^sub>N)| n . n \<in> set(sm_inters M)}"
      by (auto)
    have b: "(\<guillemotleft>init\<^bsub>M\<^esub>\<guillemotright> \<notin>\<^sub>u \<guillemotleft>inames\<^bsub>M\<^esub>\<guillemotright>) = false"
      by (literalise, metis (full_types) false_alt_def true_alt_def utp_pred_laws.compl_top_eq wf.init_is_inter)
    have "(\<Sqinter> (b, P) \<in> (\<lambda>n. (&rc_ctrl =\<^sub>u \<guillemotleft>n_name n\<guillemotright> :: 's RoboPred, M;null_event \<turnstile> \<lbrakk>n\<rbrakk>\<^sub>N)) ` set(sm_inters M) \<bullet> b) =
           (\<Sqinter> (b, P) \<in> {(&rc_ctrl =\<^sub>u \<guillemotleft>n_name n\<guillemotright>, M;null_event \<turnstile> \<lbrakk>n\<rbrakk>\<^sub>N)| n . n \<in> set(sm_inters M)} \<bullet> b)"
      by (simp add: a)
    also have "...  = (\<Sqinter> b \<in> {&rc_ctrl =\<^sub>u \<guillemotleft>n_name n\<guillemotright>| n . n \<in> set(sm_inters M)} \<bullet> b)"
      by (rel_auto)
    also have "... = (&rc_ctrl \<in>\<^sub>u \<guillemotleft>inames\<^bsub>M\<^esub>\<guillemotright>)"
      apply (simp add: UINF_Collect, rel_auto)
      apply (simp add: sm_inter_names_def sm_sem_def(3))
      using sm_inter_names_def apply fastforce
      done
    finally show ?thesis
      by (simp add: action_simp usubst b miracle_top)
  qed
  have 3: "S \<sqsubseteq> rc_ctrl := \<guillemotleft>init\<^bsub>M\<^esub>\<guillemotright> ; [\<not> (&rc_ctrl \<in>\<^sub>u \<guillemotleft>inames\<^bsub>M\<^esub>\<guillemotright>)]\<^sub>A" (is "?lhs \<sqsubseteq> ?rhs")
  proof -
    have "?rhs = [\<guillemotleft>init\<^bsub>M\<^esub>\<guillemotright> \<notin>\<^sub>u \<guillemotleft>inames\<^bsub>M\<^esub>\<guillemotright>]\<^sub>A ; rc_ctrl := \<guillemotleft>init\<^bsub>M\<^esub>\<guillemotright>"
      by (simp add: action_simp usubst)
    also have "... = [false]\<^sub>A ; rc_ctrl := \<guillemotleft>init\<^bsub>M\<^esub>\<guillemotright>"
      by (literalise, simp add: wf.init_is_inter)
    also have "... = miracle"
      by (simp add: action_simp)
    finally
    show ?thesis by (simp add: miracle_top)
  qed
  have 4:"\<And>n. n \<in> set(sm_inters M) \<Longrightarrow> S \<sqsubseteq> rc_ctrl := \<guillemotleft>init\<^bsub>M\<^esub>\<guillemotright> ; [&rc_ctrl =\<^sub>u \<guillemotleft>n_name n\<guillemotright>]\<^sub>A ; (M;null_event \<turnstile> \<lbrakk>n\<rbrakk>\<^sub>N)"
  proof -
    fix n
    assume a:"n \<in> set(sm_inters M)"
    show "S \<sqsubseteq> rc_ctrl := \<guillemotleft>init\<^bsub>M\<^esub>\<guillemotright> ; [&rc_ctrl =\<^sub>u \<guillemotleft>n_name n\<guillemotright>]\<^sub>A ; (M;null_event \<turnstile> \<lbrakk>n\<rbrakk>\<^sub>N)"
    proof (cases "n=ninit\<^bsub>M\<^esub>")
      case True
      hence "[&rc_ctrl \<mapsto>\<^sub>s \<guillemotleft>init\<^bsub>M\<^esub>\<guillemotright>] \<dagger> (M;null_event \<turnstile> \<lbrakk>ninit\<^bsub>M\<^esub>\<rbrakk>\<^sub>N) = (M;null_event \<turnstile> \<lbrakk>ninit\<^bsub>M\<^esub>\<rbrakk>\<^sub>N)"
        by (simp add: sm_semantics_subst_ctrl)
      with True assms(2) show ?thesis
        by (simp add: action_simp usubst wf.n_name_init)
    next
      case False
      with a have "(init\<^bsub>M\<^esub> = n_name n) = False"
      proof -
        have "n \<in> {n. n \<in> set(sm_nodes M) \<and> \<not> n_name n \<in> set(finals\<^bsub>M\<^esub>)}"
          by (metis a set_filter sm_sem_def(3))
        then have "nmap\<^bsub>M\<^esub> (n_name n) = Some n"
          using WfStateMachine.nmap_name wf.WfStateMachine_axioms by blast
        then show ?thesis
          using False by fastforce
      qed
      hence "((\<guillemotleft>init\<^bsub>M\<^esub>\<guillemotright> =\<^sub>u \<guillemotleft>n_name n\<guillemotright>) :: 's RoboPred) = false"
        by (rel_auto)
      thus ?thesis
        by (simp add: action_simp usubst miracle_top)
    qed
  qed
  have 5: "\<And>n. n \<in> set(sm_inters M) \<Longrightarrow> S \<sqsubseteq> S ; [&rc_ctrl =\<^sub>u \<guillemotleft>n_name n\<guillemotright>]\<^sub>A ; (M;null_event \<turnstile> \<lbrakk>n\<rbrakk>\<^sub>N)"
  proof -
    fix n
    assume a:"n \<in> set(sm_inters M)"
    have "S \<sqsubseteq> S ; (M;null_event \<turnstile> \<lbrakk>n\<rbrakk>\<^sub>N)"
    proof -
      have f1: "{n. (n::('s, 'e) Node) \<in> set(sm_nodes M) \<and> \<not> n_name n \<in> set(finals\<^bsub>M\<^esub>)} = set(sm_inters M)"
        by (simp add: sm_sem_def(3))
      then have "n_name n \<in> n_name ` {n. (n::('s, 'e) Node) \<in> set(sm_nodes M) \<and> \<not> n_name n \<in> set(finals\<^bsub>M\<^esub>)}"
        using a by force
      then have "n_name n \<in> inames\<^bsub>M\<^esub>"
        by (simp add: sm_inter_names_def sm_sem_def(3))
      then show ?thesis
        using f1 a assms(3) wf.nmap_name by fastforce
    qed
    moreover have "S ; (M;null_event \<turnstile> \<lbrakk>n\<rbrakk>\<^sub>N) \<sqsubseteq> S ; [&rc_ctrl =\<^sub>u \<guillemotleft>n_name n\<guillemotright>]\<^sub>A ; (M;null_event \<turnstile> \<lbrakk>n\<rbrakk>\<^sub>N)"
      by (rule seq_refine_mono, simp_all add: asm_pre_refine)
    ultimately show "S \<sqsubseteq> S ; [&rc_ctrl =\<^sub>u \<guillemotleft>n_name n\<guillemotright>]\<^sub>A ; (M;null_event \<turnstile> \<lbrakk>n\<rbrakk>\<^sub>N)"
      using dual_order.trans by blast
  qed

  show ?thesis
    apply (simp add: sm_semantics_def)
    apply (rule iterate_refine_intro)
    apply (simp_all)
    apply (auto simp add: 1 2 3 4 5)
    done
qed
(*
lemma StateMachine_sinv_refine_intro:
  fixes
    S :: "('s, 'e) RoboAction" and
    M :: "('s, 'e) StateMachine"
  assumes
    "WfStateMachine M"
    "sinv\<^sub>A(s) \<sqsubseteq> (M;null_event \<turnstile> \<lbrakk>ninit\<^bsub>M\<^esub>\<rbrakk>\<^sub>N)"
    "\<And> n. n \<in> inames\<^bsub>M\<^esub> \<Longrightarrow> S \<sqsubseteq> S ; (M;null_event \<turnstile> \<lbrakk>the(nmap\<^bsub>M\<^esub> n)\<rbrakk>\<^sub>N)"
  shows "S \<sqsubseteq> \<lbrakk>M\<rbrakk>\<^sub>M null_event"
*)

(*
lemma "sinv\<^sub>A (&rc_ctrl \<in>\<^sub>u \<guillemotleft>nnames\<^bsub>M\<^esub>\<guillemotright>) \<sqsubseteq> r:[P]\<^sub>A\<^sup>+"
  apply (simp add: action_rep_eq, safe)
   apply (rdes_refine_split)
  apply (rel_simp)

lemma
  assumes "WfStateMachine M"
  shows "sinv\<^sub>A(&rc_ctrl \<in>\<^sub>u \<guillemotleft>nnames\<^bsub>M\<^esub>\<guillemotright>) \<sqsubseteq> \<lbrakk>M\<rbrakk>\<^sub>M null_event"
proof (rule StateMachine_refine_intro[OF assms])
  show "sinv\<^sub>A(&rc_ctrl \<in>\<^sub>u \<guillemotleft>nnames\<^bsub>M\<^esub>\<guillemotright>) \<sqsubseteq> (M;null_event \<turnstile> \<lbrakk>ninit\<^bsub>M\<^esub>\<rbrakk>\<^sub>N)"
    apply (simp add: node_semantics_def)
*)

subsection \<open> Divergence Freedom \<close>

locale DivFreeSM = WfStateMachine +
  assumes
    n_entry_divf: "\<And> n. n \<in> set(nodes) \<Longrightarrow> divf \<sqsubseteq> n_entry n" and
    n_during_divf: "\<And> n. n \<in> set(nodes) \<Longrightarrow> divf \<sqsubseteq> n_exit n" and
    n_exit_divf: "\<And> n. n \<in> set(nodes) \<Longrightarrow> divf \<sqsubseteq> n_exit n" and
    tn_trigger_divf: "\<And> t e. \<lbrakk> t \<in> set(\<^bold>T); tn_trigger t = Some e \<rbrakk> \<Longrightarrow> divf \<sqsubseteq> e" and
    tn_action_divf: "\<And> t. t \<in> set(\<^bold>T) \<Longrightarrow> divf \<sqsubseteq> tn_action t"

lemma DivFreeSM_divf:
  assumes "DivFreeSM M"
  shows "divf \<sqsubseteq> \<lbrakk>M\<rbrakk>\<^sub>M \<epsilon>"
proof (rule StateMachine_refine_intro)
  interpret dvs: DivFreeSM M
    by (simp add: assms)
  show "WfStateMachine M"
    by (simp add: dvs.WfStateMachine_axioms)
  have "\<And> n t. \<lbrakk> n \<in> nnames\<^bsub>M\<^esub>; t \<in> set(the (tmap\<^bsub>M\<^esub> n)) \<rbrakk> \<Longrightarrow> divf \<sqsubseteq> \<lbrakk>t\<rbrakk>\<^sub>T \<epsilon>"
  proof -
    fix n t
    assume a: "n \<in> nnames\<^bsub>M\<^esub>" "t \<in> set(the (tmap\<^bsub>M\<^esub> n))"
    have "divf \<sqsubseteq> trigger_semantics t \<epsilon>"
    proof (cases "tn_trigger t")
      case None
      then show ?thesis by (simp add: divf_sync)
    next
      case (Some a)
      then show ?thesis
        using a(1) a(2) divf_sync dvs.node_tran_exists dvs.tn_trigger_divf by fastforce
    qed
    thus "divf \<sqsubseteq> \<lbrakk>t\<rbrakk>\<^sub>T \<epsilon>"
      apply (simp add: tr_semantics_def)
      apply (rule divf_guard)
      apply (rule divf_seq_refine)
       apply (rule divf_seq_refine)
        apply (rule divf_frame_ext)
        apply (simp)
       apply (rule divf_frame_ext)
      using a(1) a(2) dvs.node_tran_exists dvs.tn_action_divf apply blast
      apply (simp add: divf_assigns)
      done
  qed
  hence b:"\<And> n. n \<in> inames\<^bsub>M\<^esub> \<Longrightarrow> divf \<sqsubseteq> (M;\<epsilon> \<turnstile> \<lbrakk>the (nmap\<^bsub>M\<^esub> n)\<rbrakk>\<^sub>N)"
    apply (simp add: node_semantics_def)
    apply (rule divf_seq_refine)
    apply (rule divf_frame_ext)
    apply (smt dvs.n_entry_divf dvs.nmap_name filter_is_subset imageE option.sel sm_inter_names_def sm_inters_def subset_eq)
    apply (rule divf_seq_refine)
     apply (rule divf_extchoice_fold_refine)
    apply (auto)
    apply (smt dvs.nmap_name filter_is_subset image_iff option.sel sm_inter_names_def sm_inters_def sm_node_names_def subset_code(1))
    apply (rule divf_frame_ext)
    apply (smt dvs.n_exit_divf dvs.nmap_name filter_is_subset imageE option.sel sm_inter_names_def sm_inters_def subset_eq)
    done
  show "divf \<sqsubseteq> (M;\<epsilon> \<turnstile> \<lbrakk>ninit\<^bsub>M\<^esub>\<rbrakk>\<^sub>N)"
    by (simp add: b dvs.init_is_inter)
  show "\<And>n. n \<in> inames\<^bsub>M\<^esub> \<Longrightarrow> divf \<sqsubseteq> divf ; (M;\<epsilon> \<turnstile> \<lbrakk>the (nmap\<^bsub>M\<^esub> n)\<rbrakk>\<^sub>N)"
    by (simp add: b divf_seq_refine)
qed

subsection \<open> Transition and State Parsers \<close>

syntax
  "_transition" :: "id \<Rightarrow> id \<Rightarrow> raction \<Rightarrow> logic \<Rightarrow> raction \<Rightarrow> logic"
  ("from _ to _ trigger _ condition _ action _" [0,0,0,0,10] 10)

  "_transition_action" :: "id \<Rightarrow> id \<Rightarrow> logic \<Rightarrow> logic"
  ("from _ to _ action _" [0,0,10] 10)

  "_transition_condition" :: "id \<Rightarrow> id \<Rightarrow> logic \<Rightarrow> logic"
  ("from _ to _ condition _" [0,0,10] 10)

  "_transition_condition_action" :: "id \<Rightarrow> id \<Rightarrow> logic \<Rightarrow> raction \<Rightarrow> logic"
  ("from _ to _ condition _ action _" [0,0,0,10] 10)

  "_transition_trigger" :: "id \<Rightarrow> id \<Rightarrow> raction \<Rightarrow> logic"
  ("from _ to _ trigger _" [0,0,10] 10)

  "_transition_trigger_action" :: "id \<Rightarrow> id \<Rightarrow> raction \<Rightarrow> raction \<Rightarrow> logic"
  ("from _ to _ trigger _ action _" [0,0,0,10] 10)

  "_transition_trigger_condition" :: "id \<Rightarrow> id \<Rightarrow> raction \<Rightarrow> logic \<Rightarrow> logic"
  ("from _ to _ trigger _ condition _" [0,0,0,10] 10)

  "_state" :: "raction \<Rightarrow> raction \<Rightarrow> raction \<Rightarrow> logic"
  ("entry _ during _ exit _" [0,0,10] 10)

  "_state_entry" :: "raction \<Rightarrow> logic"
  ("entry _" [10] 10)

translations
  "_transition s1 s2 e b a" =>
  "CONST Transition.make IDLIT(s1) IDLIT(s2) (CONST Some e) b a"

  "_transition_action s1 s2 a" => "CONST Transition.make IDLIT(s1) IDLIT(s2) (CONST None) true a"

  "_transition_condition s1 s2 b" => "CONST Transition.make IDLIT(s1) IDLIT(s2) (CONST None) b (CONST Actions.skips)"

  "_transition_condition_action s1 s2 b a" => "CONST Transition.make IDLIT(s1) IDLIT(s2) (CONST None) b a"

  "_transition_trigger s1 s2 t" => "CONST Transition.make IDLIT(s1) IDLIT(s2) (CONST Some t) true (CONST Actions.skips)"

  "_transition_trigger_action s1 s2 t a" => "CONST Transition.make IDLIT(s1) IDLIT(s2) (CONST Some t) true a"

  "_transition_trigger_condition s1 s2 t b" => "CONST Transition.make IDLIT(s1) IDLIT(s2) (CONST Some t) b (CONST Actions.skips)"

  "_state e d x" => "CONST Node.make (CONST undefined) e d x"

  "_state_entry e" => "CONST Node.make (CONST undefined) e skip skip"

utp_lift_notation Transition.make (0 1 2 4)

term "from s1 to s2 trigger y := 1 ; x?(y) ; z!(1) condition b action a"
term "from s1 to s2 action x := []"
term "from s1 to s2 trigger e"
term "entry e during d exit x"
term "entry e"

term "entry skip during skip exit skip"

subsection \<open> Proof Tactics \<close>

method sm_induct uses simps wf = auto intro!: StateMachine_refine_intro[OF wf] dlockf_refine_intro simp add: simps
method sm_calc uses simps = simp_all add: simps sm_sem_def, simp_all add: action_simp usubst alpha

end


(*  File:       Borda_Rule_Ref.thy
    Copyright   2023  Karlsruhe Institute of Technology (KIT)
*)
\<^marker>\<open>creator "Valentin Springsklee, Karlsruhe Institute of Technology (KIT)"\<close>

theory Borda_Rule_Ref
  imports "Verified_Voting_Rule_Construction.Borda_Rule"
          "Compositional_Structures/Basic_Modules/Borda_Module_Ref"
          "Compositional_Structures/Elect_Composition_Ref"
begin

sepref_definition borda_rule_sep_direct is "uncurry (elector_opt borda)"
  :: "elec_mod_seprel nat_assn"
  unfolding elector_opt_def hs.fold_custom_empty
  by sepref

lemma borda_rule_direct_correct:
  shows "(uncurry borda_rule_sep_direct, uncurry (RETURN oo (borda_rule)))
  \<in> elec_mod_seprel nat_assn"
  using borda_rule_sep_direct.refine
    unfolding borda_rule.simps elector_opt_eq .

declare borda_rule_direct_correct [sepref_fr_rules]

export_code convert_list_to_hash_set clist borda_rule_sep_direct in Scala_imp

end


theory Proofs5
  imports Requirements VCTheoryLemmas
begin

definition inv5 where "inv5 s \<equiv> R5 s \<and> extraInv s"

thm extraInv_def

lemma minimalOpened_R5: "toEnvP s1 \<and> toEnvP s2 \<and> toEnvP s0 \<and> substate s1 s2 \<and> substate s2 s0 \<and> substate s0 s \<and>
toEnvNum s1 s2 = 1 \<and> toEnvNum s2 s0 < 9 \<and> getPstate s0 Controller' = Controller'minimalOpened' \<and>
ltime s0 Controller' = 10  \<and>
(\<forall>s1. toEnvP s1 \<and> substate s1 s \<and> getPstate s1 Init'init' = Controller'minimalOpened' \<longrightarrow> ltime s1 Init'init' \<le> 10) \<and>
(\<forall>s2. toEnvP s2 \<and> substate s2 s \<and> getPstate s2 Init'init' = Controller'minimalOpened' \<longrightarrow>
      (\<forall>s1. toEnvP s1 \<and> substate s1 s2 \<and> toEnvNum s1 s2 < ltime s2 Init'init' \<longrightarrow>
            getPstate s1 Init'init' = Controller'minimalOpened')) \<and>
(\<forall>s1. toEnvP s1 \<and>
      substate s1 s \<and> (getPstate s1 Init'init' = Controller'isOpened' \<or> getPstate s1 Init'init' = Controller'minimalOpened') \<longrightarrow>
      getVarBool s1 Controller'minimalOpened')
\<longrightarrow> \<not> (\<not> getVarBool s1 open' \<and> getVarBool s2 open')"
  using substate_trans
  by (smt (verit, ccfv_SIG) BitM_inc_eq eval_nat_numeral(2) inc.simps(2) nat_add_left_cancel_less plus_1_eq_Suc toEnvNum3)

lemma isOpened_timeout_R5: "toEnvP s1 \<and> toEnvP s2 \<and> toEnvP s0 \<and> substate s1 s2 \<and> substate s2 s0 \<and> substate s0 s \<and>
toEnvNum s1 s2 = 1 \<and> toEnvNum s2 s0 < 9 \<and> getPstate s0 Controller' = Controller'isOpened' \<and>
ltime s0 Controller' = 90  \<and>
(\<forall>s1. toEnvP s1 \<and> substate s1 s \<and> getPstate s1 Init'init' = Controller'isOpened' \<longrightarrow> ltime s1 Init'init' \<le> 90) \<and>
(\<forall>s3. toEnvP s3 \<and> substate s3 s \<and> getPstate s3 Init'init' = Controller'isOpened' \<longrightarrow>
      (\<forall>s1. toEnvP s1 \<and> substate s1 s3 \<and> toEnvNum s1 s3 < ltime s3 Init'init' \<longrightarrow> getPstate s1 Init'init' = Controller'isOpened') \<and>
      (\<forall>s2. toEnvP s2 \<and> substate s2 s3 \<and> toEnvNum s2 s3 + 1 < ltime s3 Init'init' \<longrightarrow> \<not> getVarBool s2 Init')) \<and>
(\<forall>s1. toEnvP s1 \<and>
      substate s1 s \<and> (getPstate s1 Init'init' = Controller'isOpened' \<or> getPstate s1 Init'init' = Controller'minimalOpened') \<longrightarrow>
      getVarBool s1 Controller'minimalOpened')
\<longrightarrow>  \<not>(\<not> getVarBool s1 open' \<and> getVarBool s2 open')"
  apply(rule impI)
  apply(rule cut_rl[of "toEnvNum s1 s0 < ltime s0 Controller'"])
  using substate_trans
   apply meson
  using toEnvNum3 by auto

lemma isOpened_R5: "toEnvP s1 \<and> toEnvP s2 \<and> toEnvP s0 \<and> substate s1 s2 \<and> substate s2 s0 \<and> substate s0 s \<and>
toEnvNum s1 s2 = 1 \<and> toEnvNum s2 s0 < 9 \<and> getPstate s0 Controller' = Controller'isOpened' \<and>
(\<forall>s1. toEnvP s1 \<and> substate s1 s \<and> getPstate s1 Init'init' = Controller'minimalOpened' \<longrightarrow> ltime s1 Init'init' \<le> 10) \<and>
(\<forall>s2. toEnvP s2 \<and> substate s2 s \<and> getPstate s2 Init'init' = Controller'minimalOpened' \<longrightarrow>
      (\<forall>s1. toEnvP s1 \<and> substate s1 s2 \<and> toEnvNum s1 s2 < ltime s2 Init'init' \<longrightarrow>
            getPstate s1 Init'init' = Controller'minimalOpened')) \<and>
(\<forall>s1. toEnvP s1 \<and>
      substate s1 s \<and> (getPstate s1 Init'init' = Controller'isOpened' \<or> getPstate s1 Init'init' = Controller'minimalOpened') \<longrightarrow>
      getVarBool s1 Controller'minimalOpened') \<and>
(\<forall>s1. toEnvP s1 \<and> substate s1 s \<and> getPstate s1 Init'init' = Controller'isOpened' \<longrightarrow> ltime s1 Init'init' \<le> 90) \<and>
(\<forall>s1. toEnvP s1 \<and> substate s1 s \<and> getPstate s1 Init'init' = Controller'isOpened' \<longrightarrow>
      (\<exists>s2 s3.
          toEnvP s2 \<and>
          toEnvP s3 \<and>
          substate s2 s3 \<and>
          substate s3 s1 \<and>
          toEnvNum s2 s3 = 1 \<and>
          toEnvNum s2 s1 = ltime s1 Init'init' \<and>
          getPstate s2 Init'init' = Controller'minimalOpened' \<and>
          ltime s2 Init'init' = 10 \<and> \<not> getVarBool s3 EntranceController'isOpened')) \<and>
(\<forall>s3. toEnvP s3 \<and> substate s3 s \<and> getPstate s3 Init'init' = Controller'isOpened' \<longrightarrow>
      (\<forall>s1. toEnvP s1 \<and> substate s1 s3 \<and> toEnvNum s1 s3 < ltime s3 Init'init' \<longrightarrow> getPstate s1 Init'init' = Controller'isOpened') \<and>
      (\<forall>s2. toEnvP s2 \<and> substate s2 s3 \<and> toEnvNum s2 s3 + 1 < ltime s3 Init'init' \<longrightarrow> \<not> getVarBool s2 Init'))
\<longrightarrow> \<not> (\<not> getVarBool s1 open' \<and> getVarBool s2 open')"
  apply(rule impI)
  apply(cases "toEnvNum s1 s0 < ltime s0 Controller'")
  using substate_trans
   apply meson
  apply(rule exE[of " (\<lambda> s2. \<exists> s3.
          toEnvP s2 \<and>
          toEnvP s3 \<and>
          substate s2 s3 \<and>
          substate s3 s0 \<and>
          toEnvNum s2 s3 = 1 \<and>
          toEnvNum s2 s0 = ltime s0 Init'init' \<and>
          getPstate s2 Init'init' = Controller'minimalOpened' \<and> ltime s2 Init'init' = 10  \<and> \<not> getVarBool s3 EntranceController'isOpened')"])
apply blast
  apply(drule exE)
   prefer 2
   apply assumption
  subgoal for s3 s4
    apply(rule cut_rl[of "substate s3 s0"])
    apply(cases "substate s2 s3")
     apply(rule impE[OF minimalOpened_R5[of s1 s2 s3 s]])
    using substate_trans toEnvNum3
       apply (smt (verit) leD le_neq_implies_less le_trans less_or_eq_imp_le toEnvNum_substate1)
      apply assumption
     apply(rule cut_rl[of "s1=s3"])
    using substate_trans
      apply meson
     apply(rule cut_rl[of "toEnvNum s1 s0 = toEnvNum s3 s0"])
    using toEnvNum_eq_imp_eq2 substate_trans
      apply meson
     apply(rule le_antisym)
      apply(rule cut_rl[of "substate s3 s2 \<and> s2 \<noteq> s3"])
    using toEnvNum_substate2  toEnvNum_eq_imp_eq2 toEnvNum3[of s1 s2 s0]
       apply (metis Suc_leI order.order_iff_strict plus_1_eq_Suc)
    using substate_linear substate_refl
      apply meson
     apply arith
    using substate_trans by meson
  done

theorem proof_5_1: "VC1 inv5 s0"
  apply(unfold VC1_def inv5_def R5_def extraInv_def)
  by auto

theorem proof_5_2: "VC2 R5 env s0 PdOut_value paid_value opened_value"
  apply(unfold VC2_def)
  apply simp
  apply(unfold R5_def)
  apply(rule impI)
  apply(rule conjI)
   apply simp
  subgoal premises vc_prems
   apply((rule allI)+)
    apply(rule impI)
    apply(simp split: if_splits)
using vc_prems
  by (metis One_nat_def)
  done

theorem proof_5_500: "VC500 R5 env s0 PdOut_value paid_value opened_value"
  apply(unfold VC500_def)
  apply simp
  apply(unfold R5_def)
  apply(rule impI)
  apply(rule conjI)
   apply simp
  subgoal premises vc_prems
    apply((rule allI)+)
    apply(rule impI)
    apply(simp split: if_splits)
    subgoal for s1 s2
      apply(rule cut_rl[of "toEnvNum s2 s0 <10"])
      using vc_prems substate_refl apply(metis One_nat_def)
      by simp
    using vc_prems by(metis One_nat_def)
  done

end


section \<open>Generic Block Allocator\<close>
theory Sep_Block_Allocator
imports "../../lib/Monad"
begin

  text \<open>This theory specifies the concepts of memory allocation and deallocation.
    It is parameterized over the actual type of blocks.
  \<close>

  subsection \<open>Memory and Addresses\<close>

  text \<open>A memory is a list of allocated or already freed blocks.
    Allocated blocks are modeled by @{term \<open>Some blk\<close>},
    freed blocks are modeled by @{term \<open>None\<close>}
  \<close>
  datatype 'blk memory = MEMORY (the_memory: "'blk option list")
  define_lenses memory

  text \<open>An address indexes a block, and then addresses into the value of this block.\<close>
  datatype 'baddr addr = ADDR nat 'baddr

  text \<open>A pointer is either \<open>null\<close>, or an address\<close>
  datatype 'addr rptr = RP_NULL | RP_ADDR (the_addr: "'addr")
  hide_const (open) the_addr

  text \<open>Type-class to model that there is a base address.\<close>
  (* TODO: Remove from semantics, move to reasoning infrastructure? *)
  class this_addr = fixes this_addr :: 'a

  text \<open>We immediately show that the typeclass is not empty.
    This avoids confusion of the code generator with lemmas depending on this typeclass.\<close>
  typedecl this_addr_witness
  instantiation this_addr_witness :: this_addr begin
    instance ..
  end

  subsection \<open>Memory Functions\<close>

  text \<open>
    We specify the standard functions \<open>alloc\<close>, \<open>free\<close>, \<open>load\<close>, and \<open>store\<close>.
    They are parameterized over load and store functions for blocks.

    Additionally, we specify a \<open>check_ptr\<close> function, that asserts that a pointer is valid,
    i.e., is either \<open>null\<close>, or points to an allocated block, and its block address is valid
    for this block.
  \<close>

  locale block_allocator1 =
    fixes static_err :: 'err
      and mem_err :: 'err
      and bload :: "'baddr::this_addr \<Rightarrow> ('val,_,'block,'err) M"
      and bstore :: "'val \<Rightarrow> 'baddr \<Rightarrow> (unit,_,'block,'err) M"
      and bcheck_addr :: "'baddr \<Rightarrow> (unit,_,'block,'err) M"
  begin

    text \<open>Allocate a new block, and a pointer to its start\<close>
    definition alloc :: "'block \<Rightarrow> ('baddr addr rptr,_,'block memory,'err) M"
    where "alloc init \<equiv> zoom (lift_lens static_err the_memory\<^sub>L) (doM {
      blocks \<leftarrow> Monad.get;
      let bi = length blocks;
      let blocks = blocks @ [Some init];
      Monad.set blocks;
      return (RP_ADDR (ADDR bi this_addr))
    })"

    text \<open>Free a block, specified by a pointer to its start\<close>
    definition free :: "'baddr addr rptr \<Rightarrow> (unit,_,'block memory,'err) M"
    where "free \<equiv>
      \<lambda>RP_ADDR (ADDR bi ba) \<Rightarrow> doM {
          fcheck mem_err (ba=this_addr);
          \<comment>\<open> TODO: Use load here! \<close>
          let L = lift_lens static_err the_memory\<^sub>L \<bullet> (lift_lens mem_err (idx\<^sub>L bi));
          blk \<leftarrow> use L;
          fcheck mem_err (blk \<noteq> None);
          L ::= None
        }
      | _ \<Rightarrow> fail mem_err"

    text \<open>We define a lens that focuses a block index. \<close>
    (* TODO: Can we define lenses to focus addresses/pointers instead? *)
    definition "lens_of_bi bi \<equiv> the_memory\<^sub>L \<bullet>\<^sub>L idx\<^sub>L bi \<bullet>\<^sub>L the\<^sub>L"
    abbreviation "elens_of_bi bi \<equiv> lift_lens mem_err (lens_of_bi bi)"
    lemma lens_of_bi[simp, intro!]: "hlens (lens_of_bi bi)"
      unfolding lens_of_bi_def by auto

    text \<open>Load from an address\<close>
    definition "load \<equiv> \<lambda>RP_ADDR (ADDR bi ba) \<Rightarrow> zoom (elens_of_bi bi) (bload ba) | _ \<Rightarrow> fail mem_err"
    text \<open>Store at an address\<close>
    definition "store \<equiv> \<lambda>x. \<lambda>RP_ADDR (ADDR bi ba) \<Rightarrow> zoom (elens_of_bi bi) (bstore x ba) | _ \<Rightarrow> fail mem_err"

    text \<open>Check that pointer is valid\<close>
    definition "check_ptr \<equiv> \<lambda>RP_NULL \<Rightarrow> return () | RP_ADDR (ADDR bi ba) \<Rightarrow> zoom (elens_of_bi bi) (bcheck_addr ba)"

    text \<open>The empty memory\<close>
    definition "empty_memory \<equiv> MEMORY []"

  end

  subsection \<open>Isabelle Code Generator Setup\<close>
  text \<open>Setup to make the semantics executable inside Isabelle/HOL\<close>

  lemmas block_allocator1_code[code] =
    block_allocator1.alloc_def
    block_allocator1.free_def
    block_allocator1.lens_of_bi_def
    block_allocator1.load_def
    block_allocator1.store_def
    block_allocator1.check_ptr_def
    block_allocator1.empty_memory_def

end