Theory Automata

(*  Title:      HOL/HOLCF/IOA/Automata.thy
    Author:     Olaf Müller, Konrad Slind, Tobias Nipkow
*)

section ‹The I/O automata of Lynch and Tuttle in HOLCF›

theory Automata
imports Asig
begin

default_sort type

type_synonym ('a, 's) transition = "'s × 'a × 's"
type_synonym ('a, 's) ioa =
  "'a signature × 's set × ('a, 's)transition set × 'a set set × 'a set set"


subsection ‹IO automata›

definition asig_of :: "('a, 's) ioa  'a signature"
  where "asig_of = fst"

definition starts_of :: "('a, 's) ioa  's set"
  where "starts_of = fst  snd"

definition trans_of :: "('a, 's) ioa  ('a, 's) transition set"
  where "trans_of = fst  snd  snd"

abbreviation trans_of_syn  ("_ __ _" [81, 81, 81, 81] 100)
  where "s aA t  (s, a, t)  trans_of A"

definition wfair_of :: "('a, 's) ioa  'a set set"
  where "wfair_of = fst  snd  snd  snd"

definition sfair_of :: "('a, 's) ioa  'a set set"
  where "sfair_of = snd  snd  snd  snd"

definition is_asig_of :: "('a, 's) ioa  bool"
  where "is_asig_of A = is_asig (asig_of A)"

definition is_starts_of :: "('a, 's) ioa  bool"
  where "is_starts_of A  starts_of A  {}"

definition is_trans_of :: "('a, 's) ioa  bool"
  where "is_trans_of A 
    (triple. triple  trans_of A  fst (snd triple)  actions (asig_of A))"

definition input_enabled :: "('a, 's) ioa  bool"
  where "input_enabled A 
    (a. a  inputs (asig_of A)  (s1. s2. (s1, a, s2)  trans_of A))"

definition IOA :: "('a, 's) ioa  bool"
  where "IOA A 
    is_asig_of A 
    is_starts_of A 
    is_trans_of A 
    input_enabled A"

abbreviation "act A  actions (asig_of A)"
abbreviation "ext A  externals (asig_of A)"
abbreviation int where "int A  internals (asig_of A)"
abbreviation "inp A  inputs (asig_of A)"
abbreviation "out A  outputs (asig_of A)"
abbreviation "local A  locals (asig_of A)"


text ‹invariants›

inductive reachable :: "('a, 's) ioa  's  bool" for C :: "('a, 's) ioa"
where
  reachable_0:  "s  starts_of C  reachable C s"
| reachable_n:  "reachable C s  (s, a, t)  trans_of C  reachable C t"

definition invariant :: "[('a, 's) ioa, 's  bool]  bool"
  where "invariant A P  (s. reachable A s  P s)"


subsection ‹Parallel composition›

subsubsection ‹Binary composition of action signatures and automata›

definition compatible :: "('a, 's) ioa  ('a, 't) ioa  bool"
  where "compatible A B 
    out A  out B = {} 
    int A  act B = {} 
    int B  act A = {}"

definition asig_comp :: "'a signature  'a signature  'a signature"
  where "asig_comp a1 a2 =
     (((inputs a1  inputs a2) - (outputs a1  outputs a2),
       (outputs a1  outputs a2),
       (internals a1  internals a2)))"

definition par :: "('a, 's) ioa  ('a, 't) ioa  ('a, 's * 't) ioa"  (infixr "" 10)
  where "(A  B) =
    (asig_comp (asig_of A) (asig_of B),
     {pr. fst pr  starts_of A  snd pr  starts_of B},
     {tr.
        let
          s = fst tr;
          a = fst (snd tr);
          t = snd (snd tr)
        in
          (a  act A  a  act B) 
          (if a  act A then (fst s, a, fst t)  trans_of A
           else fst t = fst s) 
          (if a  act B then (snd s, a, snd t)  trans_of B
           else snd t = snd s)},
      wfair_of A  wfair_of B,
      sfair_of A  sfair_of B)"


subsection ‹Hiding›

subsubsection ‹Hiding and restricting›

definition restrict_asig :: "'a signature  'a set  'a signature"
  where "restrict_asig asig actns =
    (inputs asig  actns,
     outputs asig  actns,
     internals asig  (externals asig - actns))"

text ‹
  Notice that for wfair_of› and sfair_of› nothing has to be changed, as
  changes from the outputs to the internals does not touch the locals as a
  whole, which is of importance for fairness only.
›
definition restrict :: "('a, 's) ioa  'a set  ('a, 's) ioa"
  where "restrict A actns =
    (restrict_asig (asig_of A) actns,
     starts_of A,
     trans_of A,
     wfair_of A,
     sfair_of A)"

definition hide_asig :: "'a signature  'a set  'a signature"
  where "hide_asig asig actns =
    (inputs asig - actns,
     outputs asig - actns,
     internals asig  actns)"

definition hide :: "('a, 's) ioa  'a set  ('a, 's) ioa"
  where "hide A actns =
    (hide_asig (asig_of A) actns,
     starts_of A,
     trans_of A,
     wfair_of A,
     sfair_of A)"


subsection ‹Renaming›

definition rename_set :: "'a set  ('c  'a option)  'c set"
  where "rename_set A ren = {b. x. Some x = ren b  x  A}"

definition rename :: "('a, 'b) ioa  ('c  'a option)  ('c, 'b) ioa"
  where "rename ioa ren =
    ((rename_set (inp ioa) ren,
      rename_set (out ioa) ren,
      rename_set (int ioa) ren),
     starts_of ioa,
     {tr.
        let
          s = fst tr;
          a = fst (snd tr);
          t = snd (snd tr)
        in x. Some x = ren a  s xioa t},
     {rename_set s ren | s. s  wfair_of ioa},
     {rename_set s ren | s. s  sfair_of ioa})"


subsection ‹Fairness›

subsubsection ‹Enabledness of actions and action sets›

definition enabled :: "('a, 's) ioa  'a  's  bool"
  where "enabled A a s  (t. s aA t)"

definition Enabled :: "('a, 's) ioa  'a set  's  bool"
  where "Enabled A W s  (w  W. enabled A w s)"


text ‹Action set keeps enabled until probably disabled by itself.›

definition en_persistent :: "('a, 's) ioa  'a set  bool"
  where "en_persistent A W 
    (s a t. Enabled A W s  a  W  s aA t  Enabled A W t)"


text ‹Post conditions for actions and action sets.›

definition was_enabled :: "('a, 's) ioa  'a  's  bool"
  where "was_enabled A a t  (s. s aA t)"

definition set_was_enabled :: "('a, 's) ioa  'a set  's  bool"
  where "set_was_enabled A W t  (w  W. was_enabled A w t)"


text ‹Constraints for fair IOA.›

definition fairIOA :: "('a, 's) ioa  bool"
  where "fairIOA A  (S  wfair_of A. S  local A)  (S  sfair_of A. S  local A)"

definition input_resistant :: "('a, 's) ioa  bool"
  where "input_resistant A 
    (W  sfair_of A. s a t.
      reachable A s  reachable A t  a  inp A 
      Enabled A W s  s aA t  Enabled A W t)"


declare split_paired_Ex [simp del]

lemmas ioa_projections = asig_of_def starts_of_def trans_of_def wfair_of_def sfair_of_def


subsection "asig_of›, starts_of›, trans_of›"

lemma ioa_triple_proj:
  "asig_of (x, y, z, w, s) = x 
   starts_of (x, y, z, w, s) = y 
   trans_of (x, y, z, w, s) = z 
   wfair_of (x, y, z, w, s) = w 
   sfair_of (x, y, z, w, s) = s"
  by (simp add: ioa_projections)

lemma trans_in_actions: "is_trans_of A  s1 aA s2  a  act A"
  by (auto simp add: is_trans_of_def actions_def is_asig_def)

lemma starts_of_par: "starts_of (A  B) = {p. fst p  starts_of A  snd p  starts_of B}"
  by (simp add: par_def ioa_projections)

lemma trans_of_par:
  "trans_of(A  B) =
    {tr.
      let
        s = fst tr;
        a = fst (snd tr);
        t = snd (snd tr)
      in
        (a  act A  a  act B) 
        (if a  act A then (fst s, a, fst t)  trans_of A
         else fst t = fst s) 
        (if a  act B then (snd s, a, snd t)  trans_of B
         else snd t = snd s)}"
  by (simp add: par_def ioa_projections)


subsection actions› and par›

lemma actions_asig_comp: "actions (asig_comp a b) = actions a  actions b"
  by (auto simp add: actions_def asig_comp_def asig_projections)

lemma asig_of_par: "asig_of(A  B) = asig_comp (asig_of A) (asig_of B)"
  by (simp add: par_def ioa_projections)

lemma externals_of_par: "ext (A1  A2) = ext A1  ext A2"
  by (auto simp add: externals_def asig_of_par asig_comp_def
    asig_inputs_def asig_outputs_def Un_def set_diff_eq)

lemma actions_of_par: "act (A1  A2) = act A1  act A2"
  by (auto simp add: actions_def asig_of_par asig_comp_def
    asig_inputs_def asig_outputs_def asig_internals_def Un_def set_diff_eq)

lemma inputs_of_par: "inp (A1  A2) = (inp A1  inp A2) - (out A1  out A2)"
  by (simp add: actions_def asig_of_par asig_comp_def
    asig_inputs_def asig_outputs_def Un_def set_diff_eq)

lemma outputs_of_par: "out (A1  A2) = out A1  out A2"
  by (simp add: actions_def asig_of_par asig_comp_def
    asig_outputs_def Un_def set_diff_eq)

lemma internals_of_par: "int (A1  A2) = int A1  int A2"
  by (simp add: actions_def asig_of_par asig_comp_def
    asig_inputs_def asig_outputs_def asig_internals_def Un_def set_diff_eq)


subsection ‹Actions and compatibility›

lemma compat_commute: "compatible A B = compatible B A"
  by (auto simp add: compatible_def Int_commute)

lemma ext1_is_not_int2: "compatible A1 A2  a  ext A1  a  int A2"
  by (auto simp add: externals_def actions_def compatible_def)

(*just commuting the previous one: better commute compatible*)
lemma ext2_is_not_int1: "compatible A2 A1  a  ext A1  a  int A2"
  by (auto simp add: externals_def actions_def compatible_def)

lemmas ext1_ext2_is_not_act2 = ext1_is_not_int2 [THEN int_and_ext_is_act]
lemmas ext1_ext2_is_not_act1 = ext2_is_not_int1 [THEN int_and_ext_is_act]

lemma intA_is_not_extB: "compatible A B  x  int A  x  ext B"
  by (auto simp add: externals_def actions_def compatible_def)

lemma intA_is_not_actB: "compatible A B  a  int A  a  act B"
  by (auto simp add: externals_def actions_def compatible_def is_asig_def asig_of_def)

(*the only one that needs disjointness of outputs and of internals and _all_ acts*)
lemma outAactB_is_inpB: "compatible A B  a  out A  a  act B  a  inp B"
  by (auto simp add: asig_outputs_def asig_internals_def actions_def asig_inputs_def
      compatible_def is_asig_def asig_of_def)

(*needed for propagation of input_enabledness from A, B to A ∥ B*)
lemma inpAAactB_is_inpBoroutB:
  "compatible A B  a  inp A  a  act B  a  inp B  a  out B"
  by (auto simp add: asig_outputs_def asig_internals_def actions_def asig_inputs_def
      compatible_def is_asig_def asig_of_def)


subsection ‹Input enabledness and par›

(*ugly case distinctions. Heart of proof:
    1. inpAAactB_is_inpBoroutB ie. internals are really hidden.
    2. inputs_of_par: outputs are no longer inputs of par. This is important here.*)
lemma input_enabled_par:
  "compatible A B  input_enabled A  input_enabled B  input_enabled (A  B)"
  apply (unfold input_enabled_def)
  apply (simp add: Let_def inputs_of_par trans_of_par)
  apply (tactic "safe_tac (Context.raw_transfer theory theory_contextFun)")
  apply (simp add: inp_is_act)
  prefer 2
  apply (simp add: inp_is_act)
  text a ∈ inp A›
  apply (case_tac "a  act B")
  text a ∈ inp B›
  apply (erule_tac x = "a" in allE)
  apply simp
  apply (drule inpAAactB_is_inpBoroutB)
  apply assumption
  apply assumption
  apply (erule_tac x = "a" in allE)
  apply simp
  apply (erule_tac x = "aa" in allE)
  apply (erule_tac x = "b" in allE)
  apply (erule exE)
  apply (erule exE)
  apply (rule_tac x = "(s2, s2a)" in exI)
  apply (simp add: inp_is_act)
  text a ∉ act B›
  apply (simp add: inp_is_act)
  apply (erule_tac x = "a" in allE)
  apply simp
  apply (erule_tac x = "aa" in allE)
  apply (erule exE)
  apply (rule_tac x = " (s2,b) " in exI)
  apply simp

  text a ∈ inp B›
  apply (case_tac "a  act A")
  text a ∈ act A›
  apply (erule_tac x = "a" in allE)
  apply (erule_tac x = "a" in allE)
  apply (simp add: inp_is_act)
  apply (frule_tac A1 = "A" in compat_commute [THEN iffD1])
  apply (drule inpAAactB_is_inpBoroutB)
  back
  apply assumption
  apply assumption
  apply simp
  apply (erule_tac x = "aa" in allE)
  apply (erule_tac x = "b" in allE)
  apply (erule exE)
  apply (erule exE)
  apply (rule_tac x = "(s2, s2a)" in exI)
  apply (simp add: inp_is_act)
  text a ∉ act B›
  apply (simp add: inp_is_act)
  apply (erule_tac x = "a" in allE)
  apply (erule_tac x = "a" in allE)
  apply simp
  apply (erule_tac x = "b" in allE)
  apply (erule exE)
  apply (rule_tac x = "(aa, s2)" in exI)
  apply simp
  done


subsection ‹Invariants›

lemma invariantI:
  assumes "s. s  starts_of A  P s"
    and "s t a. reachable A s  P s  (s, a, t)  trans_of A  P t"
  shows "invariant A P"
  using assms
  apply (unfold invariant_def)
  apply (rule allI)
  apply (rule impI)
  apply (rule_tac x = "s" in reachable.induct)
  apply assumption
  apply blast
  apply blast
  done

lemma invariantI1:
  assumes "s. s  starts_of A  P s"
    and "s t a. reachable A s  P s  (s, a, t)  trans_of A  P t"
  shows "invariant A P"
  using assms by (blast intro: invariantI)

lemma invariantE: "invariant A P  reachable A s  P s"
  unfolding invariant_def by blast


subsection restrict›

lemmas reachable_0 = reachable.reachable_0
  and reachable_n = reachable.reachable_n

lemma cancel_restrict_a:
  "starts_of (restrict ioa acts) = starts_of ioa 
   trans_of (restrict ioa acts) = trans_of ioa"
  by (simp add: restrict_def ioa_projections)

lemma cancel_restrict_b: "reachable (restrict ioa acts) s = reachable ioa s"
  apply (rule iffI)
  apply (erule reachable.induct)
  apply (simp add: cancel_restrict_a reachable_0)
  apply (erule reachable_n)
  apply (simp add: cancel_restrict_a)
  text ⟵›
  apply (erule reachable.induct)
  apply (rule reachable_0)
  apply (simp add: cancel_restrict_a)
  apply (erule reachable_n)
  apply (simp add: cancel_restrict_a)
  done

lemma acts_restrict: "act (restrict A acts) = act A"
  by (auto simp add: actions_def asig_internals_def
    asig_outputs_def asig_inputs_def externals_def asig_of_def restrict_def restrict_asig_def)

lemma cancel_restrict:
  "starts_of (restrict ioa acts) = starts_of ioa 
   trans_of (restrict ioa acts) = trans_of ioa 
   reachable (restrict ioa acts) s = reachable ioa s 
   act (restrict A acts) = act A"
  by (simp add: cancel_restrict_a cancel_restrict_b acts_restrict)


subsection rename›

lemma trans_rename: "s a(rename C f) t  (x. Some x = f a  s xC t)"
  by (simp add: Let_def rename_def trans_of_def)

lemma reachable_rename: "reachable (rename C g) s  reachable C s"
  apply (erule reachable.induct)
  apply (rule reachable_0)
  apply (simp add: rename_def ioa_projections)
  apply (drule trans_rename)
  apply (erule exE)
  apply (erule conjE)
  apply (erule reachable_n)
  apply assumption
  done


subsection trans_of (A ∥ B)›

lemma trans_A_proj:
  "(s, a, t)  trans_of (A  B)  a  act A  (fst s, a, fst t)  trans_of A"
  by (simp add: Let_def par_def trans_of_def)

lemma trans_B_proj:
  "(s, a, t)  trans_of (A  B)  a  act B  (snd s, a, snd t)  trans_of B"
  by (simp add: Let_def par_def trans_of_def)

lemma trans_A_proj2: "(s, a, t)  trans_of (A  B)  a  act A  fst s = fst t"
  by (simp add: Let_def par_def trans_of_def)

lemma trans_B_proj2: "(s, a, t)  trans_of (A  B)  a  act B  snd s = snd t"
  by (simp add: Let_def par_def trans_of_def)

lemma trans_AB_proj: "(s, a, t)  trans_of (A  B)  a  act A  a  act B"
  by (simp add: Let_def par_def trans_of_def)

lemma trans_AB:
  "a  act A  a  act B 
  (fst s, a, fst t)  trans_of A 
  (snd s, a, snd t)  trans_of B 
  (s, a, t)  trans_of (A  B)"
  by (simp add: Let_def par_def trans_of_def)

lemma trans_A_notB:
  "a  act A  a  act B 
  (fst s, a, fst t)  trans_of A 
  snd s = snd t 
  (s, a, t)  trans_of (A  B)"
  by (simp add: Let_def par_def trans_of_def)

lemma trans_notA_B:
  "a  act A  a  act B 
  (snd s, a, snd t)  trans_of B 
  fst s = fst t 
  (s, a, t)  trans_of (A  B)"
  by (simp add: Let_def par_def trans_of_def)

lemmas trans_of_defs1 = trans_AB trans_A_notB trans_notA_B
  and trans_of_defs2 = trans_A_proj trans_B_proj trans_A_proj2 trans_B_proj2 trans_AB_proj


lemma trans_of_par4:
  "(s, a, t)  trans_of (A  B  C  D) 
    ((a  actions (asig_of A)  a  actions (asig_of B)  a  actions (asig_of C) 
      a  actions (asig_of D)) 
     (if a  actions (asig_of A)
      then (fst s, a, fst t)  trans_of A
      else fst t = fst s) 
     (if a  actions (asig_of B)
      then (fst (snd s), a, fst (snd t))  trans_of B
      else fst (snd t) = fst (snd s)) 
     (if a  actions (asig_of C)
      then (fst (snd (snd s)), a, fst (snd (snd t)))  trans_of C
      else fst (snd (snd t)) = fst (snd (snd s))) 
     (if a  actions (asig_of D)
      then (snd (snd (snd s)), a, snd (snd (snd t)))  trans_of D
      else snd (snd (snd t)) = snd (snd (snd s))))"
  by (simp add: par_def actions_asig_comp prod_eq_iff Let_def ioa_projections)


subsection ‹Proof obligation generator for IOA requirements›

(*without assumptions on A and B because is_trans_of is also incorporated in par_def*)
lemma is_trans_of_par: "is_trans_of (A  B)"
  by (simp add: is_trans_of_def Let_def actions_of_par trans_of_par)

lemma is_trans_of_restrict: "is_trans_of A  is_trans_of (restrict A acts)"
  by (simp add: is_trans_of_def cancel_restrict acts_restrict)

lemma is_trans_of_rename: "is_trans_of A  is_trans_of (rename A f)"
  apply (unfold is_trans_of_def restrict_def restrict_asig_def)
  apply (simp add: Let_def actions_def trans_of_def asig_internals_def
    asig_outputs_def asig_inputs_def externals_def asig_of_def rename_def rename_set_def)
  apply blast
  done

lemma is_asig_of_par: "is_asig_of A  is_asig_of B  compatible A B  is_asig_of (A  B)"
  apply (simp add: is_asig_of_def asig_of_par asig_comp_def compatible_def
    asig_internals_def asig_outputs_def asig_inputs_def actions_def is_asig_def)
  apply (simp add: asig_of_def)
  apply auto
  done

lemma is_asig_of_restrict: "is_asig_of A  is_asig_of (restrict A f)"
  apply (unfold is_asig_of_def is_asig_def asig_of_def restrict_def restrict_asig_def
    asig_internals_def asig_outputs_def asig_inputs_def externals_def o_def)
  apply simp
  apply auto
  done

lemma is_asig_of_rename: "is_asig_of A  is_asig_of (rename A f)"
  apply (simp add: is_asig_of_def rename_def rename_set_def asig_internals_def
    asig_outputs_def asig_inputs_def actions_def is_asig_def asig_of_def)
  apply auto
  apply (drule_tac [!] s = "Some _" in sym)
  apply auto
  done

lemmas [simp] = is_asig_of_par is_asig_of_restrict
  is_asig_of_rename is_trans_of_par is_trans_of_restrict is_trans_of_rename


lemma compatible_par: "compatible A B  compatible A C  compatible A (B  C)"
  by (auto simp add: compatible_def internals_of_par outputs_of_par actions_of_par)

(*better derive by previous one and compat_commute*)
lemma compatible_par2: "compatible A C  compatible B C  compatible (A  B) C"
  by (auto simp add: compatible_def internals_of_par outputs_of_par actions_of_par)

lemma compatible_restrict:
  "compatible A B  (ext B - S)  ext A = {}  compatible A (restrict B S)"
  by (auto simp add: compatible_def ioa_triple_proj asig_triple_proj externals_def
    restrict_def restrict_asig_def actions_def)

declare split_paired_Ex [simp]

end