(******************************************************************************)
(* Project: The Isabelle/UTP Proof System                                     *)
(* File: Architecture_D2_3c.thy                                               *)
(* Authors: Frank Zeyda and Simon Foster (University of York, UK)             *)
(* Emails: frank.zeyda@york.ac.uk and simon.foster@york.ac.uk                 *)
(******************************************************************************)

section {* Railways Architecture *}

theory Architecture_D2_3c
imports fmi
begin recall_syntax

subsection {* Preliminaries *}

subsubsection {* Track Segments *}

definition "CDV1 = (1::fmi2Integer)"
definition "CDV2 = (2::fmi2Integer)"
definition "CDV3 = (3::fmi2Integer)"
definition "CDV4 = (4::fmi2Integer)"
definition "CDV5 = (5::fmi2Integer)"
definition "CDV6 = (6::fmi2Integer)"
definition "CDV7 = (7::fmi2Integer)"
definition "CDV8 = (8::fmi2Integer)"
definition "CDV9 = (9::fmi2Integer)"
definition "CDV10 = (10::fmi2Integer)"
definition "CDV11 = (11::fmi2Integer)"

subsubsection {* Available Routes *}

definition "V1Q1 = (1::fmi2Integer)"
definition "V1Q2 = (2::fmi2Integer)"
definition "Q2V2 = (3::fmi2Integer)"
definition "V1Q3 = (4::fmi2Integer)"
definition "Q3V2 = (5::fmi2Integer)"

subsubsection {* Signal Encoding *}

definition "RED == False"
definition "GREEN == True"

fun signals :: "(bool \<times> bool \<times> bool) \<Rightarrow> fmi2Integer" where
"signals (s1, s2, s3) =
  (if s1 then 1 else 0) +
  (if s2 then 2 else 0) +
  (if s3 then 4 else 0)"

subsubsection {* Switch Encoding *}

definition "STRAIGHT == False"
definition "DIVERGING == True"

fun switches :: "(bool \<times> bool \<times> bool \<times> bool \<times> bool) \<Rightarrow> fmi2Integer" where
"switches (sw1, sw2, sw3, sw4, sw5) =
  (if sw1 then 1 else 0) +
  (if sw2 then 2 else 0) +
  (if sw3 then 4 else 0) +
  (if sw4 then 8 else 0) +
  (if sw5 then 16 else 0)"

subsection {* Model Instantiation *}

subsubsection {* Railways FMUs *}

axiomatization
  train1 :: "FMI2COMP" and
  train2 :: "FMI2COMP" and
  merger :: "FMI2COMP" and
  interlocking :: "FMI2COMP" where
  fmus_distinct: "distinct [train1, train2, merger, interlocking]" and
  FMI2COMP_def: "FMI2COMP = {train1, train2, merger, interlocking}"

overloading
  railways_FMUs \<equiv> "FMUs :: FMI2COMP list"
begin
  definition railways_FMUs :: "FMI2COMP list" where
  "railways_FMUs = [train1, train2, merger, interlocking]"
end

paragraph {* Proof Support *}

lemma fmu_simps [simp]:
"train1 \<noteq> train2"
"train1 \<noteq> merger"
"train1 \<noteq> interlocking"
"train2 \<noteq> train1"
"train2 \<noteq> merger"
"train2 \<noteq> interlocking"
"merger \<noteq> train1"
"merger \<noteq> train2"
"merger \<noteq> interlocking"
"interlocking \<noteq> train1"
"interlocking \<noteq> train2"
"interlocking \<noteq> merger"
using fmus_distinct apply (auto)
done

subsubsection {* Parameters *}

overloading
  railways_parameters \<equiv> "parameters :: (FMI2COMP \<times> VAR \<times> VAL) list"
begin
  definition railways_parameters :: "(FMI2COMP \<times> VAR \<times> VAL) list" where
  "railways_parameters = [
    (train1, $max_speed:{fmi2Real}\<^sub>u, InjU (4.16::real)),
    (train2, $max_speed:{fmi2Real}\<^sub>u, InjU (4.16::real)),
    (train1, $fixed_route:{fmi2Integer}\<^sub>u, InjU V1Q2),
    (train2, $fixed_route:{fmi2Integer}\<^sub>u, InjU Q3V2)]"
end

subsubsection {* Inputs and Outputs *}

overloading
  railways_inputs \<equiv> "inputs :: PORT list"
begin
  definition railways_inputs :: "PORT list" where
  "railways_inputs = [
    (train1, $signals:{fmi2Integer}\<^sub>u),
    (train1, $switches:{fmi2Integer}\<^sub>u),
    (train2, $signals:{fmi2Integer}\<^sub>u),
    (train2, $switches:{fmi2Integer}\<^sub>u),
    (merger, $track_segment1:{fmi2Integer}\<^sub>u),
    (merger, $track_segment2:{fmi2Integer}\<^sub>u),
    (merger, $telecommand1:{fmi2Integer}\<^sub>u),
    (merger, $telecommand2:{fmi2Integer}\<^sub>u),
    (interlocking, $CDV:{fmi2Integer}\<^sub>u),
    (interlocking, $TC:{fmi2Integer}\<^sub>u)]"
end

overloading
  railways_outputs \<equiv> "outputs :: PORT list"
begin
  definition railways_outputs :: "PORT list" where
  "railways_outputs = [
    (train1, $track_segment:{fmi2Integer}\<^sub>u),
    (train1, $telecommand:{fmi2Integer}\<^sub>u),
    (train2, $track_segment:{fmi2Integer}\<^sub>u),
    (train2, $telecommand:{fmi2Integer}\<^sub>u),
    (merger, $CDV:{fmi2Integer}\<^sub>u),
    (merger, $TC:{fmi2Integer}\<^sub>u),
    (merger, $collision:{fmi2Boolean}\<^sub>u),
    (merger, $derailment:{fmi2Boolean}\<^sub>u),
    (interlocking, $signals:{fmi2Integer}\<^sub>u),
    (interlocking, $switches:{fmi2Integer}\<^sub>u)]"
end

subsubsection {* Initial Values *}

text {* The following constants have to be defined as appropriate. *}

definition "initialSignals = InjU (signals (RED, RED, RED))"
definition "initialSwitches =
  InjU (switches (STRAIGHT, STRAIGHT, STRAIGHT, STRAIGHT, STRAIGHT))"
definition "initialTrack1 = InjU CDV3"
definition "initialTrack2 = InjU CDV2"

overloading
  railways_initialValues \<equiv> "initialValues :: (PORT \<times> VAL) list"
begin
  definition railways_initialValues :: "(PORT \<times> VAL) list" where
  "railways_initialValues = [
    ((train1, $signals:{fmi2Integer}\<^sub>u), initialSignals),
    ((train1, $switches:{fmi2Integer}\<^sub>u), initialSwitches),
    ((train2, $signals:{fmi2Integer}\<^sub>u), initialSignals),
    ((train2, $switches:{fmi2Integer}\<^sub>u), initialSwitches),
    ((merger, $track_segment1:{fmi2Integer}\<^sub>u), initialTrack1),
    ((merger, $track_segment2:{fmi2Integer}\<^sub>u), initialTrack2),
    ((merger, $telecommand1:{fmi2Integer}\<^sub>u), undefined),
    ((merger, $telecommand2:{fmi2Integer}\<^sub>u), undefined),
    ((interlocking, $CDV:{fmi2Integer}\<^sub>u), undefined),
    ((interlocking, $TC:{fmi2Integer}\<^sub>u), undefined)]"
end

subsubsection {* Port Dependency Graph (\<open>pdg\<close>) *}

definition pdg :: "(PORT \<times> PORT) list" where
"pdg = [
  ((train1, $track_segment:{fmi2Integer}\<^sub>u), (merger, $track_segment1:{fmi2Integer}\<^sub>u)),
  ((train2, $track_segment:{fmi2Integer}\<^sub>u), (merger, $track_segment2:{fmi2Integer}\<^sub>u)),
  ((train1, $telecommand:{fmi2Integer}\<^sub>u), (merger, $telecommand1:{fmi2Integer}\<^sub>u)),
  ((train2, $telecommand:{fmi2Integer}\<^sub>u), (merger, $telecommand2:{fmi2Integer}\<^sub>u)),
  ((merger, $CDV:{fmi2Integer}\<^sub>u), (interlocking, $CDV:{fmi2Integer}\<^sub>u)),
  ((merger, $TC:{fmi2Integer}\<^sub>u), (interlocking, $TC:{fmi2Integer}\<^sub>u)),
  ((interlocking, $signals:{fmi2Integer}\<^sub>u), (train1, $signals:{fmi2Integer}\<^sub>u)),
  ((interlocking, $signals:{fmi2Integer}\<^sub>u), (train2, $signals:{fmi2Integer}\<^sub>u)),
  ((interlocking, $switches:{fmi2Integer}\<^sub>u), (train1, $switches:{fmi2Integer}\<^sub>u)),
  ((interlocking, $switches:{fmi2Integer}\<^sub>u), (train2, $switches:{fmi2Integer}\<^sub>u))
]"

subsubsection {* Internal Direct Dependencies (\<open>idd\<close>) *}

definition idd :: "(PORT \<times> PORT) list" where
"idd = [
  ((merger, $track_segment1:{fmi2Integer}\<^sub>u), (merger, $CDV:{fmi2Integer}\<^sub>u)),
  ((merger, $track_segment2:{fmi2Integer}\<^sub>u), (merger, $CDV:{fmi2Integer}\<^sub>u)),
  ((merger, $telecommand1:{fmi2Integer}\<^sub>u), (merger, $TC:{fmi2Integer}\<^sub>u)),
  ((merger, $telecommand2:{fmi2Integer}\<^sub>u), (merger, $TC:{fmi2Integer}\<^sub>u)),
  ((interlocking, $CDV:{fmi2Integer}\<^sub>u), (interlocking, $signals:{fmi2Integer}\<^sub>u)),
  ((interlocking, $CDV:{fmi2Integer}\<^sub>u), (interlocking, $switches:{fmi2Integer}\<^sub>u)),
  ((interlocking, $TC:{fmi2Integer}\<^sub>u), (interlocking, $signals:{fmi2Integer}\<^sub>u)),
  ((interlocking, $TC:{fmi2Integer}\<^sub>u), (interlocking, $switches:{fmi2Integer}\<^sub>u))
]"
end


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

header{*The n_germanish Protocol Case Study*}

theory n_germanish_lemma_inv__3_on_rules imports n_germanish_lemma_on_inv__3
begin
section{*All lemmas on causal relation between inv__3*}
lemma lemma_inv__3_on_rules:
  assumes b1: "r \<in> rules N" and b2: "(\<exists> p__Inv0 p__Inv2. p__Inv0\<le>N\<and>p__Inv2\<le>N\<and>p__Inv0~=p__Inv2\<and>f=inv__3  p__Inv0 p__Inv2)"
  shows "invHoldForRule s f r (invariants N)"
  proof -
  have c1: "(\<exists> i. i\<le>N\<and>r=n_t1  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_t2  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_t3  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_t4  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_t5  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_t6 N i)"
  apply (cut_tac b1, auto) done
    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_t1  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_t1Vsinv__3) done
    }

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

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

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

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

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

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

end


section \<open>Arrays with Dynamic Resizing\<close>
theory Dynamic_Array
imports "Refine_Imperative_HOL.IICF_List" "Separation_Logic_Imperative_HOL.Array_Blit" "Refine_Imperative_HOL.IICF_Array" "Refine_Imperative_HOL.IICF_Map"
begin

(* TODO: Move to Array_Blit *)
definition "array_grow' a n x \<equiv> do {
  l\<leftarrow>Array.len a;
  a'\<leftarrow>Array.new (l+n) x;
  blit a 0 a' 0 l;
  return a'
}"

lemma array_grow'_rule[sep_heap_rules]:
  shows "
    < a\<mapsto>\<^sub>ala >
      array_grow' a n x
    <\<lambda>a'. a'\<mapsto>\<^sub>a (la @ replicate n x)>\<^sub>t"
  unfolding array_grow'_def
  by sep_auto

(* TODO: Move to IICF_List *)
sepref_decl_op list_grow:
  "\<lambda>xs n x. xs@replicate n x" :: "\<langle>A\<rangle>list_rel \<rightarrow> nat_rel \<rightarrow> A \<rightarrow> \<langle>A\<rangle>list_rel" .

definition "nff_\<alpha> dflt l i \<equiv> if i<length l then l!i else dflt"
definition "is_nff dflt f a \<equiv> \<exists>\<^sub>Al. a \<mapsto>\<^sub>a l * \<up>(f = nff_\<alpha> dflt l)"

definition [code_unfold]: "dyn_array_new_sz dflt n \<equiv> Array.new n dflt"

lemma dyn_array_new_sz_rl[sep_heap_rules]:
  "<emp> dyn_array_new_sz dflt n <\<lambda>r. is_nff dflt (\<lambda>_. dflt) r>"
  unfolding dyn_array_new_sz_def is_nff_def nff_\<alpha>_def
  by sep_auto

definition "array_get_dyn dflt a i \<equiv> do {
  \<^cancel>\<open>\<open>nth_oo dflt a i\<close>\<close>
  l \<leftarrow> Array.len a;
  if i<l then Array.nth a i else return dflt
  }"

lemma array_get_dyn_rule[sep_heap_rules]: "
  < is_nff dflt f a >
    array_get_dyn dflt a i
  < \<lambda>r. is_nff dflt f a * \<up>(r = f i) >"
  unfolding array_get_dyn_def nth_oo_def
  by (sep_auto simp: nff_\<alpha>_def is_nff_def)

definition "array_set_dyn dflt a i v \<equiv> do {
  l \<leftarrow> Array.len a;
  if i<l then
    Array.upd i v a
  else do {
    let ns = max (2*l) (i+1);
    a \<leftarrow> array_grow a ns dflt;
    Array.upd i v a
  }
}"

lemma nff_\<alpha>_upd: "\<lbrakk>i < length l\<rbrakk> \<Longrightarrow> nff_\<alpha> dflt (l[i := v]) = (nff_\<alpha> dflt l)(i := v)"
  by (auto simp: nff_\<alpha>_def)

lemma array_set_dyn_rule[sep_heap_rules]: "
  < is_nff dflt f a >
    array_set_dyn dflt a i v
  <\<lambda>r. is_nff dflt (f(i:=v)) r >\<^sub>t
  "
  unfolding array_set_dyn_def is_nff_def upd_oo_def
  by (sep_auto simp: nff_\<alpha>_upd nff_\<alpha>_append_default)

end