section {* Abstract syntax for Hybrid CSP. *}

theory HHL
  imports  HCSP_Com
begin

consts
spec :: "fform => proc => fform => fform => prop"   ("{_}_{_;_}" 80)
specP2 :: "fform => fform => proc => fform => fform => fform  => fform => prop"   ("{_, _}_{_, _ ; _, _}" 80)
specP3 :: "fform => fform => fform => proc => fform => fform => fform => fform => fform => fform => prop"("{_,_,_}_{_,_,_; _,_,_}" 80)
specP4 :: "fform => fform => fform => fform => proc => fform => fform => fform => fform => fform  => fform => fform  => fform => prop"   ("{_,_,_,_}_{_,_,_,_ ; _,_,_,_}" 80)
specP5 :: "fform => fform => fform => fform => fform => proc => fform => fform => fform => fform => fform => fform  => fform => fform  => fform => fform  => prop"   ("{_,_,_,_,_}_{_,_,_,_,_ ; _,_,_,_,_}" 80)
specP6 :: "fform => fform => fform => fform => fform => fform => proc => fform => fform => fform => fform => fform => fform => fform  => fform => fform => fform => fform => fform  => prop"   ("{_,_,_,_,_,_}_{_,_,_,_,_,_ ; _,_,_,_,_,_}" 80)

(*Skip rule*)
axiomatization where
Skip : "|- ((l [=] (Real 0)) [-->] G) ==> {p} Skip {p; G}"

(*Assignment rule*)
axiomatization where
Assign  :" [| ~inPairForm ([(e, f)], q); |-(p [-->] (substF ([(e, f)]) (q)))
        [&]   ((l [=] (Real 0)) [-->] G)|] ==>
       {p} (e := f) {q; G}"

(*Example*)
lemma "{WTrue} (RVar ''x'') := (Real 2) {((RVar ''x'') [=] (Real 2)); (l [=] (Real 0))}"
apply (cut_tac p = "WTrue" and e = "(RVar ''x'')" and f = "(Real 2)" and
                q = "((RVar ''x'') [=] (Real 2))" and G = "(l [=] (Real 0))" in Assign, auto)
apply (rule Trans,auto)
done

(*Continuous rule*)
axiomatization where
Continue : "|- (Init [-->] FF)
           [&] ((p [&] close(FF) [&] close([~]b)) [-->] q)
           [&] ((((l [=] Real 0) [|] (high (close(FF) [&] p [&] close(b)))) [&] Rg) [-->] G)
           ==> {Init [&] p} <FF&&b> : Rg {q; G}" and
ContinueT : "|- (Init[&]p [-->]FF[&]b)
           [&] ((p [&] close(FF) [&] close(b) [&] close([~]b)) [-->] q)
           [&] ((((l [=] Real 0) [|] (high (close(FF) [&] p [&] close(b)))) [&] Rg) [-->] G)
           ==> {Init [&] p} <FF&&(b)> : Rg {q; G}" and
ContinueF : "|- (p[-->][~]b) [&] (p[-->]q) [&] ((l[=](Real 0))[-->]G)
           ==> {p} <FF&&b> : Rg {q; G}"

(*Continuous rule 2*)
(*The pb in the domain refers to the discrete variables.*)
axiomatization where
Continue2 : "|- (Init [-->] FF)
           [&] ((p [&] pb [&] close(FF) [&] close([~]b)) [-->] q)
           [&] ((((l [=] Real 0) [|] (high (close(FF) [&] p [&] pb [&] close(b)))) [&] Rg) [-->] G)
[&] (exeFlow (D,b,F1) [-->]FF)
           ==> {Init [&] p} <D&&FF&&(pb[&]b)> : Rg {q; G}"  and
Continue2T : "|- (Init[&]p [-->] FF[&]b)
           [&] ((p [&] pb [&] close(FF) [&] close(b) [&] close([~]b)) [-->] q)
           [&] ((((l [=] Real 0) [|] (high (close(FF) [&] p [&] pb [&] close(b)))) [&] Rg) [-->] G)
[&](exeFlow (D,b,FF) [-->]FF)
           ==> {Init [&] p} <D&&FF&&(pb[&]b)> : Rg {q; G}" and
Continue2F : "|- (p[&] pb[-->][~]b) [&] (p[&] pb[-->]q) [&] ((l[=](Real 0))[-->]G)
           ==> {p} <D&&FF&&(pb[&]b)> : Rg {q; G}"

(*Sequential rule*)
axiomatization where
Sequence : "[| {p} P {m; H}; {m} Q {q; G} |] ==>
             {p} P; (m, H); Q {q; H [^] G}"
(*The following rule for the case that the annotation M is discarded in the proof.*)
axiomatization where
Sequence1 : "[| {p} P {m; H}; {m} Q {q; G} |] ==>
             {p} P; M; Q {q; H [^] G}"

(*Case rule*)
axiomatization where
Case : "[| {p [&] b} P {q; G}; {p [&] ([~]b)} P {q; G}|]
             ==> {p} P {q; G}"

(*Conditional rule*)
axiomatization where
ConditionF : " [| |-(p [-->] [~] b); |- (p [-->] q); |- ((l [=] Real 0) [-->] G) |]
             ==> {p} IF b P {q; G}"
and
ConditionT :  "[| |-(p [-->] b); {p} P {q; G} |]
             ==> {p} IF b P {q; G}"
and
Condition : "[| {p [&] b} IF b P {q; G}; {p [&] ([~]b)} IF b P {q; G}|]
             ==> {p} IF b P {q; G}"

(*Nondeterministic rule*)
axiomatization where
Nondeterministic :
"{p [&] b} P {q;G}
  ==> {p} NON i x : b P {q; G}"

(*Communication rule*)
(*H in the rule denotes the common interval range.*)
axiomatization where
Communication : "[| ~inPairForm ([(x, e)], ry);
                    {px, py} (Px || Py) {qx, qy; Hx, Hy};
                    |- (qx [-->] rx) [&] (qy [-->] (substF ([(x, e)]) (ry)));
                    |- ((Hx [^] (high (qx))) [-->] Gx) [&] ((Hy [^] (high (qy))) [-->] Gy);
                    |- ((((Hx [^] (high (qx))) [&] Hy) [|]((Hy [^] (high (qy))) [&] Hx)) [-->] H)
                 |]
              ==>   {px, py} ((Px; (qx, Hx); ch !! e) || (Py; (qy, Hy); ch ?? x)) {rx, ry;
                    Gx [&] H, Gy [&] H}"

(*Communication interrupt rule*)
primrec contain :: "proc => proc => bool" where
"contain (Skip,p) = False" |
"contain (Stop,p) = False" |
"contain (x:=e,p) = False" |
"contain ((Ch!!e),p) = ((Ch!!e)=p)" |
"contain ((Ch??x),p) = ((Ch??x)=p)" |
"contain ((q;m;r),p) = False" |
"contain ((IF b q),p) = False" |
"contain ((NON i x : b q),p) = False" |
"contain ((q [[ r),p) = (if contain(q,p) then True else contain(r,p))" |
"contain ((q << r),p) = False" |
"contain ((q || r),p) = False" |
"contain ((q*),p) = False" |
"contain ((q**n),p) = False" |
"contain ((<F1 && b> : g),p) = False" |
"contain ((<D &&F1 && b> : g),p) = False" |
"contain ((q |> b r),p) = False" |
"contain ((q [[> r),p) = False"

(**)
axiomatization where
CommunicationI1 : "[| ~inPairForm ([(x, e)], ry);
                    |- Hy [-->] H;
                    |- rg [-->] H[^]WTrue;
                    {px, py} (Px || Py) {qx, qy; Hx, Hy};
                    |- Init [&] pre [<->] qx;
                    |- pre [&] Init [&] b [-->] F1;
                    |- (pre [&] close(F1) [&] close(b)) [-->] rx;
                    |- (qy [&] pre [&] close(F1) [&] close(b)) [-->] (substF ([(x, e)]) (ry));
                    |- (Hx [^] ((((l [=] Real 0) [|] (high (close(F1) [&] pre [&] close(b)))) [&] H)) [-->] Gx);
                    |- Hy [-->] Gy;
                    |- Hx [-->] Hxm;
                    |- Hy [-->] Hym;
                    contain(P,(ch !! e))
                 |]
              ==>   {px, py} (( Px; (qx, Hxm); (<F1 && b> :rg) [[> P) || (Py; (qy, Hym); ch ?? x))
                    {rx, ry; Gx, Gy}"
axiomatization where
CommunicationI2 : "[| ~inPairForm ([(x, e)], ry);
                    |- Hy [-->] H;
                    |- rg [-->] H[^]WTrue;
                    {px, py} (Px || Py) {qx, qy; Hx, Hy};
                    |- Init [&] pre [<->] qx;
                    |- pre [&] Init [&] b [-->] F1;
                    |- (qy [&] pre [&] close(F1) [&] close(b)) [-->] (substF ([(x, e)]) (rx));
                    |- qy [-->] ry;
                    |- Hx [^] ((((l [=] Real 0) [|] (high (close(F1) [&] pre [&] close(b)))) [&] H)) [-->] Gx;
                    |- Hy [-->] Gy;
                    |- Hx [-->] Hxm;
                    |- Hy [-->] Hym;
                    contain(P,(ch ?? x))
                 |]
              ==>   {px, py} (( Px; (qx, Hxm); (<F1 && b> :rg) [[> P) || (Py; (qy, Hym); ch !! e))
                    {rx, ry; Gx, Gy}"

(*Parallel rule*)
(*It is valid only when there are not communications occurring in P3 and P4.*)
axiomatization where
Parallel1: "[| {px, py} (Px || Py) {qx, qy; Hx, Hy}; {qx} Qx {rx; Gx}; {qy} Qy {ry; Gy} |]
           ==>  {px, py} ((Px; (qx, Hx); Qx) || (Py; (qy, Hy); Qy)) {rx, ry; Hx [^] Gx, Hy [^] Gy}"

(*It is valid only when there are no communications occurring in P1 and P2.*)
axiomatization where
Parallel2: "[| {px} Px {qx; Hx}; {py} Py {qy; Hy}|]
           ==> {px, py} (Px || Py) {qx, qy; Hx, Hy}"
(*It is valid in any case*)
axiomatization where
Parallel3: "[| {px, py} (Px || Py) {qx, qy; Hx[&](l[=](Real m)), Hy[&](l[=](Real m))};
               {qx, qy} (Qx || Qy) {rx, ry; Mx, My};
               |- (Hx[&](l[=](Real m))) [-->] HL;
               |- (Hy[&](l[=](Real m))) [-->] HR;
               |- ((Hx[&](l[=](Real m))) [^] Mx) [-->] Gx;
               |- ((Hy[&](l[=](Real m))) [^] My) [-->] Gy
            |]
           ==> {px, py} (Px;(qx,HL);Qx) || (Py;(qy,HR);Qy) {rx, ry; Gx, Gy}"

(*Repetition rule*)
axiomatization where
Rep : "[| {px} (Px) {px; Hx}; |- Hx [^] Hx [-->] Hx|]
           ==>  {px} (Px*) {px; Hx} "
axiomatization where
Repetition : "[| {px, py} (Px || Py) {qx, qy; Hx, Hy};
                 |- Hx [^] Hx [-->] Hx; |- Hy [^] Hy [-->] Hy|]
           ==>  {px, py} ((Px*) || (Py*)) {qx, qy; Hx, Hy} "

(*Consequence rule*)
axiomatization where
ConsequenceS : "[| {px} P {qx; Hx}; |- ((p [-->] px) [&] (qx [-->] q) [&] (Hx [-->] H))|]
            ==> {p} P {q; H}"
and
ConsequenceP : "[| {px, py} (Px || Py) {qx, qy; Hx, Hy};
                   |- ((p [-->] px) [&] (r [-->] py) [&] (qx [-->] q) [&] (qy [-->] s)
                       [&] (Hx [-->] H) [&] (Hy [-->] G))|]
            ==> {p, r} (Px || Py) {q, s; H, G}"

end


(*  Title:       AWN_Term_Graph.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke
*)
theory AWN_Term_Graph
imports AWN_Cterms
begin

datatype ('p, 'l) node =
    RootNode 'p
  | InternalNode 'l

datatype ('p, 'l) link =
    ILink "('p, 'l) node" "('p, 'l) node"
  | ELink "('p, 'l) node" "('p, 'l) node"

definition gseqp'_fails where "gseqp'_fails = []"
code_abort gseqp'_fails

fun gseqp'
  :: "('s, 'm, 'p, 'l) seqp_env \<Rightarrow> ('s, 'm, 'p, 'l) seqp \<Rightarrow> ('p, 'l) node list"
where
    "gseqp' \<Gamma> ({l}\<langle>_\<rangle> _)                = [InternalNode l]"
  | "gseqp' \<Gamma> ({l}\<lbrakk>_\<rbrakk> _)                = [InternalNode l]"
  | "gseqp' \<Gamma> ({l}unicast(_, _)._ \<triangleright> _) = [InternalNode l]"
  | "gseqp' \<Gamma> ({l}broadcast(_). _)     = [InternalNode l]"
  | "gseqp' \<Gamma> ({l}groupcast(_, _). _)  = [InternalNode l]"
  | "gseqp' \<Gamma> ({l}send(_)._)           = [InternalNode l]"
  | "gseqp' \<Gamma> ({l}deliver(_)._)        = [InternalNode l]"
  | "gseqp' \<Gamma> ({l}receive(_)._)        = [InternalNode l]"
  | "gseqp' \<Gamma> (p1 \<oplus> p2)                = gseqp' \<Gamma> p1 @ gseqp' \<Gamma> p2"
  | "gseqp' \<Gamma> (call(pn))               = gseqp'_fails"
(*
(* It would be better to define this function for all wellformed \<Gamma>, as shown
   below, but I can't get the code generator to work smoothly with the
   conditional simp rules. *)

  | "gseqp' \<Gamma> (call(pn))               = gseqp' \<Gamma> (\<Gamma> pn)"
  by pat_completeness auto

lemma gseqp'_termination:
  assumes "wellformed \<Gamma>"
    shows "gseqp'_dom (\<Gamma>, p)"
  proof -
    have gseqp'_rel':
      "gseqp'_rel = (\<lambda>gq gp. (gq, gp) \<in> {((\<Gamma>, q), (\<Gamma>', p)). \<Gamma> = \<Gamma>' \<and> p \<leadsto>\<^bsub>\<Gamma>\<^esub> q})"
      by (rule ext)+ (auto simp: gseqp'_rel.simps elim: microstep.cases)

    from assms have "\<forall>x. x \<in> acc {(q, p). p \<leadsto>\<^bsub>\<Gamma>\<^esub> q}"
      unfolding wellformed_def by (simp add: wf_acc_iff)
    hence "p \<in> acc {(q, p). p \<leadsto>\<^bsub>\<Gamma>\<^esub> q}" ..

    hence "(\<Gamma>, p) \<in> acc {((\<Gamma>, q), (\<Gamma>', p)). \<Gamma> = \<Gamma>' \<and> p \<leadsto>\<^bsub>\<Gamma>\<^esub> q}"
      by (rule acc_induct) (auto intro: accI)

    thus "gseqp'_dom (\<Gamma>, p)" unfolding gseqp'_rel' accp_acc_eq .
  qed

declare gseqp'.psimps [simp, code del]
lemmas gseqp'_psimps[simp] = gseqp'.psimps [OF gseqp'_termination]
   and gseqp'_pinduct = gseqp'.pinduct [OF gseqp'_termination]
*)

fun gseqp :: "('s, 'm, 'p, 'l) seqp_env \<Rightarrow> ('s, 'm, 'p, 'l) seqp
              \<Rightarrow> ('p, 'l) node list * ('p, 'l) node list * ('p, 'l) link list"
where
    "gseqp \<Gamma> ({l}\<langle>_\<rangle> p)                = (let me = InternalNode l in
                                          let (next, acc, links) = gseqp \<Gamma> p in
                                          ([me], me # acc, map (ILink me) next @ links))"
  | "gseqp \<Gamma> ({l}\<lbrakk>_\<rbrakk> p)                = (let me = InternalNode l in
                                          let (next, acc, links) = gseqp \<Gamma> p in
                                          ([me], me # acc, map (ILink me) next @ links))"
  | "gseqp \<Gamma> (p1 \<oplus> p2)                = (let (next1, acc1, links1) = gseqp \<Gamma> p1 in
                                          let (next2, acc2, links2) = gseqp \<Gamma> p2 in
                                          (next1 @ next2, acc1 @ acc2, links1 @ links2))"
  | "gseqp \<Gamma> ({l}unicast(_, _).p \<triangleright> q) = (let me = InternalNode l in
                                          let (next1, acc1, links1) = gseqp \<Gamma> p in
                                          let (next2, acc2, links2) = gseqp \<Gamma> q in
                                          ([me], me # acc1 @ acc2,
                                        map (ELink me) (next1 @ next2) @ links1 @ links2))"
  | "gseqp \<Gamma> ({l}broadcast(_). p)     = (let me = InternalNode l in
                                          let (next, acc, links) = gseqp \<Gamma> p in
                                         ([me], me # acc, map (ELink me) next @ links))"
  | "gseqp \<Gamma> ({l}groupcast(_, _). p)  = (let me = InternalNode l in
                                          let (next, acc, links) = gseqp \<Gamma> p in
                                          ([me], me # acc, map (ELink me) next @ links))"
  | "gseqp \<Gamma> ({l}send(_).p)           = (let me = InternalNode l in
                                          let (next, acc, links) = gseqp \<Gamma> p in
                                          ([me], me # acc, map (ELink me) next @ links))"
  | "gseqp \<Gamma> ({l}deliver(_).p)        = (let me = InternalNode l in
                                          let (next, acc, links) = gseqp \<Gamma> p in
                                          ([me], me # acc, map (ELink me) next @ links))"
  | "gseqp \<Gamma> ({l}receive(_).p)        = (let me = InternalNode l in
                                          let (next, acc, links) = gseqp \<Gamma> p in
                                          ([me], me # acc, map (ELink me) next @ links))"
  | "gseqp \<Gamma> (call(pn))               = (gseqp' \<Gamma> (\<Gamma> pn), [], [])"

definition graph_of_other :: "('s, 'm, 'p, 'l) seqp_env
                              \<Rightarrow> (('p, 'l) node list * ('p, 'l) link list)
                              \<Rightarrow> 'p
                              \<Rightarrow> ('p, 'l) node list * ('p, 'l) link list"
where
  "graph_of_other \<Gamma> r pn = (let (next, acc, links) = gseqp \<Gamma> (\<Gamma> pn) in
                            (acc @ fst r, links @ snd r))"

definition graph_of_root :: "('s, 'm, 'p, 'l) seqp_env
                             \<Rightarrow> (('p, 'l) node list * ('p, 'l) link list)
                             \<Rightarrow> 'p
                             \<Rightarrow> ('p, 'l) node list * ('p, 'l) link list"
where
  "graph_of_root \<Gamma> r pn = (let me = RootNode pn in
                           let (next, acc, links) = gseqp \<Gamma> (\<Gamma> pn) in
                           (acc @ fst r @ [me], map (ILink me) next @ links @ snd r))"

definition graph_of_seqp :: "('s, 'm, 'p, 'l) seqp_env
                             \<Rightarrow> 'p list
                             \<Rightarrow> ('p, 'l) node list * ('p, 'l) link list"
where
  "graph_of_seqp \<Gamma> pns = map_pair (rev \<circ> remdups) remdups
                           (foldl (graph_of_other \<Gamma>) (graph_of_root \<Gamma> ([], []) (hd pns)) (tl pns))"

definition graph_of_seqps :: "('s, 'm, 'p, 'l) seqp_env
                              \<Rightarrow> 'p list
                              \<Rightarrow> ('p, 'l) node list * ('p, 'l) link list"
where
  "graph_of_seqps \<Gamma> pns = map_pair (rev \<circ> remdups) remdups (foldl (graph_of_root \<Gamma>) ([], [])
                                   (List.rev pns))"

end