section \<open> Hiding \<close>

theory utp_circus_hiding
imports utp_circus_parallel
begin

subsection \<open> Hiding in peri- and postconditions \<close>

definition hide_rea ("hide\<^sub>r") where
[upred_defs]: "hide\<^sub>r P E = (\<^bold>\<exists> s \<bullet> (P\<lbrakk>$tr^\<^sub>u\<guillemotleft>s\<guillemotright>,(\<guillemotleft>E\<guillemotright>\<union>\<^sub>u$ref\<acute>)/$tr\<acute>,$ref\<acute>\<rbrakk> \<and> $tr\<acute> =\<^sub>u $tr^\<^sub>u(\<guillemotleft>s\<guillemotright>\<restriction>\<^sub>u\<guillemotleft>-E\<guillemotright>)))"

lemma hide_rea_CRR_closed [closure]:
  assumes "P is CRR"
  shows "hide\<^sub>r P E is CRR"
proof -
  have "CRR(hide\<^sub>r (CRR P) E) = hide\<^sub>r (CRR P) E"
    by (rel_auto, fastforce+)
  thus ?thesis
    by (metis Healthy_def' assms)
qed

lemma hide_rea_CDC [closure]:
  assumes "P is CDC"
  shows "hide\<^sub>r P E is CDC"
proof -
  have "CDC(hide\<^sub>r (CDC P) E) = hide\<^sub>r (CDC P) E"
    by (rel_blast)
  thus ?thesis
    by (simp add: Healthy_if Healthy_intro assms)
qed

lemma hide_rea_false [rpred]: "hide\<^sub>r false E = false"
  by (rel_auto)

lemma hide_rea_disj [rpred]: "hide\<^sub>r (P \<or> Q) E = (hide\<^sub>r P E \<or> hide\<^sub>r Q E)"
  by (rel_auto)

lemma hide_rea_csp_enable [rpred]:
  "hide\<^sub>r \<E>(s, t, E) F = \<E>(s \<and> E - \<guillemotleft>F\<guillemotright> =\<^sub>u E, t \<restriction>\<^sub>u \<guillemotleft>-F\<guillemotright>, E)"
  by (rel_auto)

lemma hide_rea_csp_do [rpred]: "hide\<^sub>r \<Phi>(s,\<sigma>,t) E = \<Phi>(s,\<sigma>,t \<restriction>\<^sub>u \<guillemotleft>-E\<guillemotright>)"
  by (rel_auto)

lemma filter_eval [simp]:
  "(bop Cons x xs) \<restriction>\<^sub>u E = (bop Cons x (xs \<restriction>\<^sub>u E) \<triangleleft> x \<in>\<^sub>u E \<triangleright> xs\<restriction>\<^sub>uE)"
  by (rel_simp)

lemma hide_rea_seq [rpred]:
  assumes "P is CRR" "$ref\<acute> \<sharp> P" "Q is CRR"
  shows "hide\<^sub>r (P ;; Q) E = hide\<^sub>r P E ;; hide\<^sub>r Q E"
proof -
  have"hide\<^sub>r (CRR(\<exists> $ref\<acute> \<bullet> P) ;; CRR(Q)) E = hide\<^sub>r (CRR(\<exists> $ref\<acute> \<bullet> P)) E ;; hide\<^sub>r (CRR Q) E"
    apply (simp add: hide_rea_def usubst unrest CRR_seqr_form)
    apply (simp add: CRR_form)
    apply (rel_auto)
    using seq_filter_append apply fastforce
    apply (metis seq_filter_append)
    done
  thus ?thesis
    by (simp add: Healthy_if assms ex_unrest)
qed

lemma hide_rea_true_R1_true [rpred]:
  "hide\<^sub>r (R1 true) A ;; R1 true = R1 true"
  by (rel_auto, metis append_Nil2 seq_filter_Nil)

lemma hide_rea_shEx [rpred]: "hide\<^sub>r (\<^bold>\<exists> i \<bullet> P(i)) cs = (\<^bold>\<exists> i \<bullet> hide\<^sub>r (P i) cs)"
  by (rel_auto)

lemma hide_rea_empty [rpred]:
  assumes "P is RR"
  shows "hide\<^sub>r P {} = P"
proof -
  have "hide\<^sub>r (RR P) {} = (RR P)"
    by (rel_auto; force)
  thus ?thesis
    by (simp add: Healthy_if assms)
qed

lemma hide_rea_twice [rpred]: "hide\<^sub>r (hide\<^sub>r P A) B = hide\<^sub>r P (A \<union> B)"
  apply (rel_auto)
  apply (metis (no_types, opaque_lifting) semilattice_sup_class.sup_assoc)
  apply (metis (no_types, lifting) semilattice_sup_class.sup_assoc seq_filter_twice)
  done

lemma st'_unrest_hide_rea [unrest]: "$st\<acute> \<sharp> P \<Longrightarrow> $st\<acute> \<sharp> hide\<^sub>r P E"
  by (simp add: hide_rea_def unrest)

lemma ref'_unrest_hide_rea [unrest]: "$ref\<acute> \<sharp> P \<Longrightarrow> $ref\<acute> \<sharp> hide\<^sub>r P E"
  by (simp add: hide_rea_def unrest usubst)

subsection \<open> Hiding in preconditions \<close>

definition abs_rea :: "('s, 'e) action \<Rightarrow> 'e set \<Rightarrow> ('s, 'e) action" ("abs\<^sub>r") where
[upred_defs]: "abs\<^sub>r P E = (\<not>\<^sub>r (hide\<^sub>r (\<not>\<^sub>r P) E ;; true\<^sub>r))"

lemma abs_rea_false [rpred]: "abs\<^sub>r false E = false"
  by (rel_simp, metis append.right_neutral seq_filter_Nil)

lemma abs_rea_conj [rpred]: "abs\<^sub>r (P \<and> Q) E = (abs\<^sub>r P E \<and> abs\<^sub>r Q E)"
  by (rel_blast)

lemma abs_rea_true [rpred]: "abs\<^sub>r true\<^sub>r E = true\<^sub>r"
  by (rel_auto)

lemma abs_rea_RC_closed [closure]:
  assumes "P is CRR"
  shows "abs\<^sub>r P E is CRC"
proof -
  have "RC1 (abs\<^sub>r (CRR P) E) = abs\<^sub>r (CRR P) E"
    apply (rel_auto)
    apply (metis order_refl)
    apply blast
    done
  hence "abs\<^sub>r P E is RC1"
    by (simp add: assms Healthy_if Healthy_intro closure)
  thus ?thesis
    by (rule_tac CRC_intro'', simp_all add: abs_rea_def closure assms unrest)
qed

lemma hide_rea_impl_under_abs:
  assumes "P is CRC" "Q is CRR"
  shows "(abs\<^sub>r P A \<Rightarrow>\<^sub>r hide\<^sub>r (P \<Rightarrow>\<^sub>r Q) A) = (abs\<^sub>r P A \<Rightarrow>\<^sub>r hide\<^sub>r Q A)"
  by (simp add: RC1_def abs_rea_def rea_impl_def rpred closure assms unrest)
     (rel_auto, metis order_refl )

lemma abs_rea_not_CRR: "P is CRR \<Longrightarrow> abs\<^sub>r (\<not>\<^sub>r P) E = (\<not>\<^sub>r hide\<^sub>r P E ;; R1 true)"
  by (simp add: abs_rea_def rpred closure)

lemma abs_rea_wpR [rpred]:
  assumes "P is CRR" "$ref\<acute> \<sharp> P" "Q is CRC"
  shows "abs\<^sub>r (P wp\<^sub>r Q) A = (hide\<^sub>r P A) wp\<^sub>r (abs\<^sub>r Q A)"
  by (simp add: wp_rea_def abs_rea_not_CRR hide_rea_seq assms closure)
     (simp add: abs_rea_def rpred closure assms seqr_assoc)

lemma abs_rea_empty [rpred]:
  assumes "P is RC"
  shows "abs\<^sub>r P {} = P"
proof -
  have "abs\<^sub>r (RC P) {} = (RC P)"
    apply (rel_auto)
    apply (metis diff_add_cancel_left' order_refl plus_list_def)
    done
  thus ?thesis
    by (simp add: Healthy_if assms)
qed

lemma abs_rea_twice [rpred]:
  assumes "P is CRC"
  shows "abs\<^sub>r (abs\<^sub>r P A) B = abs\<^sub>r P (A \<union> B)" (is "?lhs = ?rhs")
proof -
  have "?lhs = abs\<^sub>r (\<not>\<^sub>r hide\<^sub>r (\<not>\<^sub>r P) A ;; R1 true) B"
    by (simp add: abs_rea_def)
  thus ?thesis
    by (simp add: abs_rea_def rpred closure unrest seqr_assoc assms)
qed

subsection \<open> Hiding Operator \<close>

text \<open> In common with the UTP book definition of hiding, this definition does not introduce
  divergence if there is an infinite sequence of events that are hidden. For this, we would
  need a more complex precondition which is left for future work. \<close>

definition HideCSP  :: "('s, 'e) action \<Rightarrow> 'e set \<Rightarrow> ('s, 'e) action" (infixl "\\\<^sub>C" 80) where
  [upred_defs]:
  "HideCSP P E = \<^bold>R\<^sub>s(abs\<^sub>r(pre\<^sub>R(P)) E \<turnstile> hide\<^sub>r (peri\<^sub>R(P)) E \<diamondop> hide\<^sub>r (post\<^sub>R(P)) E)"

lemma HideCSP_rdes_def [rdes_def]:
  assumes "P is CRC" "Q is CRR" "R is CRR"
  shows "\<^bold>R\<^sub>s(P \<turnstile> Q \<diamondop> R) \\\<^sub>C A = \<^bold>R\<^sub>s(abs\<^sub>r(P) A \<turnstile> hide\<^sub>r Q A \<diamondop> hide\<^sub>r R A)" (is "?lhs = ?rhs")
proof -
  have "?lhs = \<^bold>R\<^sub>s (abs\<^sub>r P A \<turnstile> hide\<^sub>r (P \<Rightarrow>\<^sub>r Q) A \<diamondop> hide\<^sub>r (P \<Rightarrow>\<^sub>r R) A)"
    by (simp add: HideCSP_def rdes assms closure)
  also have "... = \<^bold>R\<^sub>s (abs\<^sub>r P A \<turnstile> (abs\<^sub>r P A \<Rightarrow>\<^sub>r hide\<^sub>r (P \<Rightarrow>\<^sub>r Q) A) \<diamondop> (abs\<^sub>r P A \<Rightarrow>\<^sub>r hide\<^sub>r (P \<Rightarrow>\<^sub>r R) A))"
    by (metis RHS_tri_design_conj conj_idem utp_pred_laws.sup.idem)
  also have "... = ?rhs"
    by (metis RHS_tri_design_conj assms conj_idem hide_rea_impl_under_abs utp_pred_laws.sup.idem)
  finally show ?thesis .
qed

lemma HideCSP_NCSP_closed [closure]: "P is NCSP \<Longrightarrow> P \\\<^sub>C E is NCSP"
  by (simp add: HideCSP_def closure unrest)

lemma HideCSP_C2_closed [closure]:
  assumes "P is NCSP" "P is C2"
  shows "P \\\<^sub>C E is C2"
  by (rdes_simp cls: assms, simp add: C2_rdes_intro closure unrest assms)

lemma HideCSP_CACT_closed [closure]:
  assumes "P is CACT"
  shows "P \\\<^sub>C E is CACT"
  by (rule CACT_intro, simp_all add: closure assms)

lemma HideCSP_Chaos: "Chaos \\\<^sub>C E = Chaos"
  by (rdes_simp)

lemma HideCSP_Miracle: "Miracle \\\<^sub>C A = Miracle"
  by (rdes_eq)

lemma HideCSP_AssignsCSP:
  "\<langle>\<sigma>\<rangle>\<^sub>C \\\<^sub>C A = \<langle>\<sigma>\<rangle>\<^sub>C"
  by (rdes_eq)

lemma HideCSP_cond:
  assumes "P is NCSP" "Q is NCSP"
  shows "(P \<triangleleft> b \<triangleright>\<^sub>R Q) \\\<^sub>C A = (P \\\<^sub>C A \<triangleleft> b \<triangleright>\<^sub>R Q \\\<^sub>C A) "
  by (rdes_eq cls: assms)

lemma HideCSP_int_choice:
  assumes "P is NCSP" "Q is NCSP"
  shows "(P \<sqinter> Q) \\\<^sub>C A = (P \\\<^sub>C A \<sqinter> Q \\\<^sub>C A) "
  by (rdes_eq cls: assms)

lemma HideCSP_guard:
  assumes "P is NCSP"
  shows "(b &\<^sub>C P) \\\<^sub>C A = b &\<^sub>C (P \\\<^sub>C A)"
  by (rdes_eq cls: assms)

lemma HideCSP_seq:
  assumes "P is NCSP" "Q is NCSP"
  shows "(P ;; Q) \\\<^sub>C A = (P \\\<^sub>C A ;; Q \\\<^sub>C A)"
  by (rdes_eq_split cls: assms)

lemma HideCSP_DoCSP [rdes_def]:
  "do\<^sub>C(a) \\\<^sub>C A = (Skip \<triangleleft> (a \<in>\<^sub>u \<guillemotleft>A\<guillemotright>) \<triangleright>\<^sub>R do\<^sub>C(a))"
  by (rdes_eq)

lemma HideCSP_PrefixCSP:
  assumes "P is NCSP"
  shows "(a \<rightarrow>\<^sub>C P) \\\<^sub>C A = ((P \\\<^sub>C A) \<triangleleft> (a \<in>\<^sub>u \<guillemotleft>A\<guillemotright>) \<triangleright>\<^sub>R (a \<rightarrow>\<^sub>C (P \\\<^sub>C A)))"
  apply (simp add: PrefixCSP_def Healthy_if HideCSP_seq HideCSP_DoCSP closure assms rdes rpred)
  apply (simp add: HideCSP_NCSP_closed Skip_left_unit assms cond_st_distr)
  done

lemma HideCSP_empty:
  assumes "P is NCSP"
  shows "P \\\<^sub>C {} = P"
  by (rdes_eq cls: assms)

lemma HideCSP_twice:
  assumes "P is NCSP"
  shows "P \\\<^sub>C A \\\<^sub>C B = P \\\<^sub>C (A \<union> B)"
  by (rdes_simp cls: assms)

lemma HideCSP_Skip: "Skip \\\<^sub>C A = Skip"
  by (rdes_eq)

lemma HideCSP_Stop: "Stop \\\<^sub>C A = Stop"
  by (rdes_eq)

end


(* module countermem(clk,rst,counter,d,addr,q);
    parameter	    MSBD = 63;
    parameter	    DEPTH = 31;
    parameter	    MSBA = 4;
    input	    clk;
    input           rst;
    input [MSBD:0]  d;
    input [MSBA:0]  addr;
    input	    counter;
    output [MSBD:0] q;

    reg [MSBD:0]    mem[0:DEPTH];
    reg [MSBA:0]    write_addr;
     //wire [MSBA:0]  read_addr;
	integer i;

	initial begin
	for (i = 0; i <= DEPTH; i = i + 1)
	    mem[i] = 0;
 	write_addr = 0;
    end // initial begin

    always @ (posedge clk) begin
	if (rst) write_addr = 0;
	else if (counter) begin
		mem[write_addr] = d;
	    write_addr = write_addr +1;
	end
    end // always @ (posedge clock)

    assign q = mem[write_addr-1-addr];

endmodule // *)
theory counter imports paraGste1
begin
abbreviation rst::"varType" where
"rst \<equiv>  (Ident ''rst'')"

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

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

definition  vertexL::"nat \<Rightarrow> node list" where [simp]:
"vertexL DEPTH  \<equiv>  (map (%i. Vertex  i) (upt 0 ( DEPTH +2)))"

lemma testUpto: "upt 0 2=[0,1]"
  by (simp add: upt_rec)

definition edgeL::"nat \<Rightarrow> edge list" where [simp]:
 "edgeL DEPTH \<equiv>   (Edge (Vertex (DEPTH +1)) (Vertex 1))#
	  (map (%i.  ( Edge (Vertex ( i ))  (Vertex (  i + 1 ))) ) (upt 0  (DEPTH +1) )) "

lemma testUpto1:"upt 1 3=[Suc 0,2]"
by (simp add: upt_rec)

primrec node2Nat::"node \<Rightarrow> nat" where
"node2Nat (Vertex n) = n"

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

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

definition antOfCounterMem::"edge\<Rightarrow>formula" where [simp]:
"antOfCounterMem    edge\<equiv>
  (let from=node2Nat (source edge) in
   let to=node2Nat (sink edge) in
     if (	from = 0) then rstForm	else
      (neg rstForm))"

definition consOfCounterMem::" edge \<Rightarrow>formula" where  [simp]:
"consOfCounterMem     edge \<equiv>
(let from=node2Nat (source edge) in
 let to=node2Nat (sink edge) in
 if 	(from =0 ) then
  chaos
 else
  eqn (IVar last) (Const (index (from - 1)))

  )"

definition counterGsteSpec::" nat\<Rightarrow>gsteSpec" where  [simp]:
"counterGsteSpec DEPTH\<equiv>Graph  vertexI (edgeL  DEPTH )
  (antOfCounterMem  )  (consOfCounterMem )"

definition tagFunOfCounterMem:: " nat\<Rightarrow>nodeTagFuncList" where [simp]:
"tagFunOfCounterMem  DEPTH  n \<equiv>
  let x=node2Nat n in
   if (x = 0) then [] else
        [eqn (IVar last) (Const (index (x - 1)))]
 "

 abbreviation branch1::"generalizeStatement" where
"branch1 \<equiv>
  let S1=assign (last,(Const (index 0))) in
   Parallel [S1]"

abbreviation branch2::"nat\<Rightarrow>generalizeStatement" where
"branch2 DEPTH \<equiv>
  let S1= assign (last,
    iteForm (eqn (IVar last) (Const (index DEPTH)))  (Const (index 0))
    (uif ''+'' [IVar last, (Const (index 1))])) in
   Parallel [S1]"

abbreviation counterMem::" nat\<Rightarrow>generalizeStatement" where
"counterMem  DEPTH\<equiv>
  caseStatement
     [(eqn (IVar rst) HIGH, branch1),
      (neg (eqn (IVar rst) HIGH ), branch2 DEPTH)]
   "

consts J::"  interpretFunType"

axiomatization where axiomOnIAdd [simp,intro]:
" J ''+'' [index m, index (Suc 0)] = index ((m + 1))"

lemma consistencyOfcounterMem:
  assumes a:"0 < DEPTH "
  shows "consistent' (counterMem DEPTH ) (J) (counterGsteSpec DEPTH )
  (tagFunOfCounterMem DEPTH)"
  proof(unfold consistent'_def,rule allI,rule impI)
    fix e
    let ?G=" (counterGsteSpec DEPTH )"
    let ?M="(counterMem DEPTH   )"
    let ?tag="(tagFunOfCounterMem   DEPTH)"
    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))"

    assume a1:"e \<in> edgesOf (counterGsteSpec DEPTH )"

    have "e=Edge vertexI ( Vertex 1) |
          e=Edge  ( Vertex (DEPTH+1)) ( Vertex 1)  |
           (\<exists>i. 1\<le>i \<and> i\<le> DEPTH  \<and>  e=( Edge (Vertex i)  (Vertex (  i+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  )
     done
     }
     moreover
    {assume b1:"e=Edge  ( Vertex (DEPTH+1)) ( Vertex 1)"
     have "?P e"
       apply(cut_tac a b1, simp )
       done

     }
    moreover
    {assume b1:" (\<exists>i. 1\<le>i \<and> i\<le> DEPTH  \<and>  e=( Edge (Vertex i)  (Vertex (  i + 1 ))) )  " (is "\<exists>i. ?asm i")
     from b1 obtain i where b2:"?asm i" by auto

      have "?P e"
        apply(cut_tac a b2 , auto  simp add:   Let_def)
        done
    }
    ultimately show "?P e" by satx
qed

lemma instImply:
assumes a:"G=(counterGsteSpec DEPTH)" and b:"0 < DEPTH "  and c:"tag=tagFunOfCounterMem  DEPTH"
shows
"\<forall> e. e \<in>edgesOf G\<longrightarrow>
tautlogy (implyForm (andForm (antOf G e) (andListForm (tag (source e)))) (consOf G e)) (J)"
proof(rule allI,rule impI,simp,rule allI,rule impI)
  fix e s
  assume a1:"e \<in> edgesOf G " and a2:"
           formEval (J) (antOf G e) s \<and> formEval (J) (andListForm (tag (source e))) s"
  let ?P ="\<lambda>e. formEval (J) (consOf G e) s"
  have "e=Edge vertexI ( Vertex 1) |
          e=Edge  ( Vertex (DEPTH+1)) ( Vertex 1)  |
           (\<exists>i. 1\<le>i \<and> i\<le> DEPTH  \<and>  e=( Edge (Vertex i)  (Vertex (  i+1 ))) ) "
         apply(cut_tac  a a1,auto)   done
    moreover
    {assume b1:"e=Edge vertexI ( Vertex 1)"
     have "?P e"
     apply(cut_tac a b1, auto) done
     }

    moreover
    {assume b1:"e=Edge ( Vertex (DEPTH+1)) ( Vertex 1)"
     have "?P e"
       apply(cut_tac a b c a1 a2 b1, auto)
       done
     }

    moreover
    {assume b1:" (\<exists>i. 1\<le>i \<and> i\<le> DEPTH  \<and>  e=( Edge (Vertex i)  (Vertex (  i+1 ))) )   " (is "\<exists>i. ?asm i")
     from b1 obtain i where b2:"?asm i" by auto

      have "?P e"
      proof(cut_tac a b c a2 b2, auto) qed

    }

    ultimately show "?P e" by satx
  qed

lemma main:
assumes a:"G=(counterGsteSpec DEPTH  )" and b:"0 < DEPTH "
and c:"tag=tagFunOfCounterMem   DEPTH" and
d:"M=(counterMem DEPTH )"
shows " circuitSatGsteSpec M G (J)"
proof(rule mainLemma)
have a1:"consistent' (counterMem DEPTH ) (J ) (counterGsteSpec DEPTH  ) (tagFunOfCounterMem   DEPTH)"
   using b by (rule   consistencyOfcounterMem)
from a c d this show "consistent' M   (J) G tag"
  by simp
next
from a b c show "\<forall>e. e \<in> edgesOf G \<longrightarrow>
        tautlogy (implyForm (andForm (antOf G e) (andListForm (tag (source e)))) (consOf G e)) (J)"
apply(rule instImply) done
next
from a c show "tag (initOf G) = []"
apply auto done
qed
end