Browse Source

Initial import from AFP.

main
Achim D. Brucker 9 months ago
commit
a7c68b6777
  1. 649
      Extended_Finite_State_Machines/AExp.thy
  2. 171
      Extended_Finite_State_Machines/AExp_Lexorder.thy
  3. 1495
      Extended_Finite_State_Machines/EFSM.thy
  4. 281
      Extended_Finite_State_Machines/EFSM_LTL.thy
  5. 341
      Extended_Finite_State_Machines/FSet_Utils.thy
  6. 837
      Extended_Finite_State_Machines/GExp.thy
  7. 253
      Extended_Finite_State_Machines/GExp_Lexorder.thy
  8. 2
      Extended_Finite_State_Machines/README.md
  9. 30
      Extended_Finite_State_Machines/ROOT
  10. 188
      Extended_Finite_State_Machines/Transition.thy
  11. 30
      Extended_Finite_State_Machines/Transition_Lexorder.thy
  12. 281
      Extended_Finite_State_Machines/Trilean.thy
  13. 44
      Extended_Finite_State_Machines/VName.thy
  14. 99
      Extended_Finite_State_Machines/Value.thy
  15. 41
      Extended_Finite_State_Machines/Value_Lexorder.thy
  16. 70
      Extended_Finite_State_Machines/document/root.bib
  17. 148
      Extended_Finite_State_Machines/document/root.tex
  18. 282
      Extended_Finite_State_Machines/examples/Drinks_Machine.thy
  19. 222
      Extended_Finite_State_Machines/examples/Drinks_Machine_2.thy
  20. 342
      Extended_Finite_State_Machines/examples/Drinks_Machine_LTL.thy

649
Extended_Finite_State_Machines/AExp.thy

@ -0,0 +1,649 @@
section \<open>Arithmetic Expressions\<close>
text\<open>
This theory defines a language of arithmetic expressions over variables and literal values. Here,
values are limited to integers and strings. Variables may be either inputs or registers. We also
limit ourselves to a simple arithmetic of addition, subtraction, and multiplication as a proof of
concept.
\<close>
theory AExp
imports Value_Lexorder VName FinFun.FinFun "HOL-Library.Option_ord"
begin
declare One_nat_def [simp del]
unbundle finfun_syntax
type_synonym registers = "nat \<Rightarrow>f value option"
type_synonym 'a datastate = "'a \<Rightarrow> value option"
text_raw\<open>\snip{aexptype}{1}{2}{%\<close>
datatype 'a aexp = L "value" | V 'a | Plus "'a aexp" "'a aexp" | Minus "'a aexp" "'a aexp" | Times "'a aexp" "'a aexp"
text_raw\<open>}%endsnip\<close>
fun is_lit :: "'a aexp \<Rightarrow> bool" where
"is_lit (L _) = True" |
"is_lit _ = False"
lemma aexp_induct_separate_V_cases [case_names L I R Plus Minus Times]:
"(\<And>x. P (L x)) \<Longrightarrow>
(\<And>x. P (V (I x))) \<Longrightarrow>
(\<And>x. P (V (R x))) \<Longrightarrow>
(\<And>x1a x2a. P x1a \<Longrightarrow> P x2a \<Longrightarrow> P (Plus x1a x2a)) \<Longrightarrow>
(\<And>x1a x2a. P x1a \<Longrightarrow> P x2a \<Longrightarrow> P (Minus x1a x2a)) \<Longrightarrow>
(\<And>x1a x2a. P x1a \<Longrightarrow> P x2a \<Longrightarrow> P (Times x1a x2a)) \<Longrightarrow>
P a"
by (metis aexp.induct vname.exhaust)
fun aval :: "'a aexp \<Rightarrow> 'a datastate \<Rightarrow> value option" where
"aval (L x) s = Some x" |
"aval (V x) s = s x" |
"aval (Plus a1 a2) s = value_plus (aval a1 s)(aval a2 s)" |
"aval (Minus a1 a2) s = value_minus (aval a1 s) (aval a2 s)" |
"aval (Times a1 a2) s = value_times (aval a1 s) (aval a2 s)"
lemma aval_plus_symmetry: "aval (Plus x y) s = aval (Plus y x) s"
by (simp add: value_plus_symmetry)
text \<open>A little syntax magic to write larger states compactly:\<close>
definition null_state ("<>") where
"null_state \<equiv> (K$ bot)"
no_notation finfun_update ("_'(_ $:= _')" [1000, 0, 0] 1000)
nonterminal fupdbinds and fupdbind
syntax
"_fupdbind" :: "'a \<Rightarrow> 'a \<Rightarrow> fupdbind" ("(2_ $:=/ _)")
"" :: "fupdbind \<Rightarrow> fupdbinds" ("_")
"_fupdbinds":: "fupdbind \<Rightarrow> fupdbinds \<Rightarrow> fupdbinds" ("_,/ _")
"_fUpdate" :: "'a \<Rightarrow> fupdbinds \<Rightarrow> 'a" ("_/'((_)')" [1000, 0] 900)
"_State" :: "fupdbinds => 'a" ("<_>")
translations
"_fUpdate f (_fupdbinds b bs)" \<rightleftharpoons> "_fUpdate (_fUpdate f b) bs"
"f(x$:=y)" \<rightleftharpoons> "CONST finfun_update f x y"
"_State ms" == "_fUpdate <> ms"
"_State (_updbinds b bs)" <= "_fUpdate (_State b) bs"
lemma empty_None: "<> = (K$ None)"
by (simp add: null_state_def bot_option_def)
lemma apply_empty_None [simp]: "<> $ x2 = None"
by (simp add: null_state_def bot_option_def)
definition input2state :: "value list \<Rightarrow> registers" where
"input2state n = fold (\<lambda>(k, v) f. f(k $:= Some v)) (enumerate 0 n) (K$ None)"
primrec input2state_prim :: "value list \<Rightarrow> nat \<Rightarrow> registers" where
"input2state_prim [] _ = (K$ None)" |
"input2state_prim (v#t) k = (input2state_prim t (k+1))(k $:= Some v)"
lemma input2state_append:
"input2state (i @ [a]) = (input2state i)(length i $:= Some a)"
apply (simp add: eq_finfun_All_ext finfun_All_def finfun_All_except_def)
apply clarify
by (simp add: input2state_def enumerate_eq_zip)
lemma input2state_out_of_bounds:
"i \<ge> length ia \<Longrightarrow> input2state ia $ i = None"
proof(induct ia rule: rev_induct)
case Nil
then show ?case
by (simp add: input2state_def)
next
case (snoc a as)
then show ?case
by (simp add: input2state_def enumerate_eq_zip)
qed
lemma input2state_within_bounds:
"input2state i $ x = Some a \<Longrightarrow> x < length i"
by (metis input2state_out_of_bounds not_le_imp_less option.distinct(1))
lemma input2state_empty: "input2state [] $ x1 = None"
by (simp add: input2state_out_of_bounds)
lemma input2state_nth:
"i < length ia \<Longrightarrow> input2state ia $ i = Some (ia ! i)"
proof(induct ia rule: rev_induct)
case Nil
then show ?case
by simp
next
case (snoc a ia)
then show ?case
apply (simp add: input2state_def enumerate_eq_zip)
by (simp add: finfun_upd_apply nth_append)
qed
lemma input2state_some:
"i < length ia \<Longrightarrow>
ia ! i = x \<Longrightarrow>
input2state ia $ i = Some x"
by (simp add: input2state_nth)
lemma input2state_take: "x1 < A \<Longrightarrow>
A \<le> length i \<Longrightarrow>
x = vname.I x1 \<Longrightarrow>
input2state i $ x1 = input2state (take A i) $ x1"
proof(induct i)
case Nil
then show ?case
by simp
next
case (Cons a i)
then show ?case
by (simp add: input2state_nth)
qed
lemma input2state_not_None:
"(input2state i $ x \<noteq> None) \<Longrightarrow> (x < length i)"
using input2state_within_bounds by blast
lemma input2state_Some:
"(\<exists>v. input2state i $ x = Some v) = (x < length i)"
apply standard
using input2state_within_bounds apply blast
by (simp add: input2state_nth)
lemma input2state_cons: "x1 > 0 \<Longrightarrow>
x1 < length ia \<Longrightarrow>
input2state (a # ia) $ x1 = input2state ia $ (x1-1)"
by (simp add: input2state_nth)
lemma input2state_cons_shift:
"input2state i $ x1 = Some a \<Longrightarrow> input2state (b # i) $ (Suc x1) = Some a"
proof(induct i rule: rev_induct)
case Nil
then show ?case
by (simp add: input2state_def)
next
case (snoc x xs)
then show ?case
using input2state_within_bounds[of xs x1 a]
using input2state_cons[of "Suc x1" "xs @ [x]" b]
apply simp
apply (case_tac "x1 < length xs")
apply simp
by (metis finfun_upd_apply input2state_append input2state_nth length_Cons length_append_singleton lessI list.sel(3) nth_tl)
qed
lemma input2state_exists: "\<exists>i. input2state i $ x1 = Some a"
proof(induct x1)
case 0
then show ?case
apply (rule_tac x="[a]" in exI)
by (simp add: input2state_def)
next
case (Suc x1)
then show ?case
apply clarify
apply (rule_tac x="a#i" in exI)
by (simp add: input2state_cons_shift)
qed
primrec repeat :: "nat \<Rightarrow> 'a \<Rightarrow> 'a list" where
"repeat 0 _ = []" |
"repeat (Suc m) a = a#(repeat m a)"
lemma length_repeat: "length (repeat n a) = n"
proof(induct n)
case 0
then show ?case
by simp
next
case (Suc a)
then show ?case
by simp
qed
lemma length_append_repeat: "length (i@(repeat a y)) \<ge> length i"
by simp
lemma length_input2state_repeat:
"input2state i $ x = Some a \<Longrightarrow> y < length (i @ repeat y a)"
by (metis append.simps(1) append_eq_append_conv input2state_within_bounds length_append length_repeat list.size(3) neqE not_add_less2 zero_order(3))
lemma input2state_double_exists:
"\<exists>i. input2state i $ x = Some a \<and> input2state i $ y = Some a"
apply (insert input2state_exists[of x a])
apply clarify
apply (case_tac "x \<ge> y")
apply (rule_tac x="list_update i y a" in exI)
apply (metis (no_types, lifting) input2state_within_bounds input2state_nth input2state_out_of_bounds le_trans length_list_update not_le_imp_less nth_list_update_eq nth_list_update_neq)
apply (rule_tac x="list_update (i@(repeat y a)) y a" in exI)
apply (simp add: not_le)
by (metis length_input2state_repeat input2state_nth input2state_out_of_bounds le_trans length_append_repeat length_list_update not_le_imp_less nth_append nth_list_update_eq nth_list_update_neq option.distinct(1))
lemma input2state_double_exists_2:
"x \<noteq> y \<Longrightarrow> \<exists>i. input2state i $ x = Some a \<and> input2state i $ y = Some a'"
apply (insert input2state_exists[of x a])
apply clarify
apply (case_tac "x \<ge> y")
apply (rule_tac x="list_update i y a'" in exI)
apply (metis (no_types, lifting) input2state_within_bounds input2state_nth input2state_out_of_bounds le_trans length_list_update not_le_imp_less nth_list_update_eq nth_list_update_neq)
apply (rule_tac x="list_update (i@(repeat y a')) y a'" in exI)
apply (simp add: not_le)
apply standard
apply (metis input2state_nth input2state_within_bounds le_trans length_append_repeat length_list_update linorder_not_le nth_append nth_list_update_neq order_refl)
by (metis input2state_nth length_append length_input2state_repeat length_list_update length_repeat nth_list_update_eq)
definition join_ir :: "value list \<Rightarrow> registers \<Rightarrow> vname datastate" where
"join_ir i r \<equiv> (\<lambda>x. case x of
R n \<Rightarrow> r $ n |
I n \<Rightarrow> (input2state i) $ n
)"
lemmas datastate = join_ir_def input2state_def
lemma join_ir_empty [simp]: "join_ir [] <> = (\<lambda>x. None)"
apply (rule ext)
apply (simp add: join_ir_def)
apply (case_tac x)
apply (simp add: input2state_def)
by (simp add: empty_None)
lemma join_ir_R [simp]: "(join_ir i r) (R n) = r $ n"
by (simp add: join_ir_def)
lemma join_ir_double_exists:
"\<exists>i r. join_ir i r v = Some a \<and> join_ir i r v' = Some a"
proof(cases v)
case (I x1)
then show ?thesis
apply (simp add: join_ir_def)
apply (cases v')
apply (simp add: input2state_double_exists input2state_exists)
using input2state_exists by auto
next
case (R x2)
then show ?thesis
apply (simp add: join_ir_def)
apply (cases v')
using input2state_exists apply force
using input2state_double_exists by fastforce
qed
lemma join_ir_double_exists_2:
"v \<noteq> v' \<Longrightarrow> \<exists>i r. join_ir i r v = Some a \<and> join_ir i r v' = Some a'"
proof(cases v)
case (I x1)
assume "v \<noteq> v'"
then show ?thesis using I input2state_exists
by (cases v', auto simp add: join_ir_def input2state_double_exists_2)
next
case (R x2)
assume "v \<noteq> v'"
then show ?thesis
apply (simp add: join_ir_def)
apply (cases v')
apply simp
using R input2state_exists apply auto[1]
apply (simp add: R)
apply (rule_tac x="<x2 $:= Some a,x2a $:= Some a'>" in exI)
by simp
qed
lemma exists_join_ir_ext: "\<exists>i r. join_ir i r v = s v"
apply (simp add: join_ir_def)
apply (case_tac "s v")
apply (cases v)
apply (rule_tac x="[]" in exI)
apply (simp add: input2state_out_of_bounds)
apply simp
apply (rule_tac x="<>" in exI)
apply simp
apply simp
apply (cases v)
apply simp
apply (simp add: input2state_exists)
apply simp
apply (rule_tac x="<x2 $:= Some a>" in exI)
apply simp
done
lemma join_ir_nth [simp]:
"i < length is \<Longrightarrow> join_ir is r (I i) = Some (is ! i)"
by (simp add: join_ir_def input2state_nth)
fun aexp_constrains :: "'a aexp \<Rightarrow> 'a aexp \<Rightarrow> bool" where
"aexp_constrains (L l) a = (L l = a)" |
"aexp_constrains (V v) v' = (V v = v')" |
"aexp_constrains (Plus a1 a2) v = ((Plus a1 a2) = v \<or> (Plus a1 a2) = v \<or> (aexp_constrains a1 v \<or> aexp_constrains a2 v))" |
"aexp_constrains (Minus a1 a2) v = ((Minus a1 a2) = v \<or> (aexp_constrains a1 v \<or> aexp_constrains a2 v))" |
"aexp_constrains (Times a1 a2) v = ((Times a1 a2) = v \<or> (aexp_constrains a1 v \<or> aexp_constrains a2 v))"
fun aexp_same_structure :: "'a aexp \<Rightarrow> 'a aexp \<Rightarrow> bool" where
"aexp_same_structure (L v) (L v') = True" |
"aexp_same_structure (V v) (V v') = True" |
"aexp_same_structure (Plus a1 a2) (Plus a1' a2') = (aexp_same_structure a1 a1' \<and> aexp_same_structure a2 a2')" |
"aexp_same_structure (Minus a1 a2) (Minus a1' a2') = (aexp_same_structure a1 a1' \<and> aexp_same_structure a2 a2')" |
"aexp_same_structure _ _ = False"
fun enumerate_aexp_inputs :: "vname aexp \<Rightarrow> nat set" where
"enumerate_aexp_inputs (L _) = {}" |
"enumerate_aexp_inputs (V (I n)) = {n}" |
"enumerate_aexp_inputs (V (R n)) = {}" |
"enumerate_aexp_inputs (Plus v va) = enumerate_aexp_inputs v \<union> enumerate_aexp_inputs va" |
"enumerate_aexp_inputs (Minus v va) = enumerate_aexp_inputs v \<union> enumerate_aexp_inputs va" |
"enumerate_aexp_inputs (Times v va) = enumerate_aexp_inputs v \<union> enumerate_aexp_inputs va"
lemma enumerate_aexp_inputs_list: "\<exists>l. enumerate_aexp_inputs a = set l"
proof(induct a)
case (L x)
then show ?case
by simp
next
case (V x)
then show ?case
apply (cases x)
apply (metis empty_set enumerate_aexp_inputs.simps(2) list.simps(15))
by simp
next
case (Plus a1 a2)
then show ?case
by (metis enumerate_aexp_inputs.simps(4) set_append)
next
case (Minus a1 a2)
then show ?case
by (metis enumerate_aexp_inputs.simps(5) set_append)
next
case (Times a1 a2)
then show ?case
by (metis enumerate_aexp_inputs.simps(6) set_append)
qed
fun enumerate_regs :: "vname aexp \<Rightarrow> nat set" where
"enumerate_regs (L _) = {}" |
"enumerate_regs (V (R n)) = {n}" |
"enumerate_regs (V (I _)) = {}" |
"enumerate_regs (Plus v va) = enumerate_regs v \<union> enumerate_regs va" |
"enumerate_regs (Minus v va) = enumerate_regs v \<union> enumerate_regs va" |
"enumerate_regs (Times v va) = enumerate_regs v \<union> enumerate_regs va"
lemma finite_enumerate_regs: "finite (enumerate_regs a)"
by(induct a rule: aexp_induct_separate_V_cases, auto)
lemma no_variables_aval: "enumerate_aexp_inputs a = {} \<Longrightarrow>
enumerate_regs a = {} \<Longrightarrow>
aval a s = aval a s'"
by (induct a rule: aexp_induct_separate_V_cases, auto)
lemma enumerate_aexp_inputs_not_empty:
"(enumerate_aexp_inputs a \<noteq> {}) = (\<exists>b c. enumerate_aexp_inputs a = set (b#c))"
using enumerate_aexp_inputs_list by fastforce
lemma aval_ir_take: "A \<le> length i \<Longrightarrow>
enumerate_regs a = {} \<Longrightarrow>
enumerate_aexp_inputs a \<noteq> {} \<Longrightarrow>
Max (enumerate_aexp_inputs a) < A \<Longrightarrow>
aval a (join_ir (take A i) r) = aval a (join_ir i ra)"
proof(induct a)
case (L x)
then show ?case
by simp
next
case (V x)
then show ?case
apply (cases x)
apply (simp add: join_ir_def input2state_nth)
by simp
next
case (Plus a1 a2)
then show ?case
apply (simp only: enumerate_aexp_inputs_not_empty[of "Plus a1 a2"])
apply (erule exE)+
apply (simp only: neq_Nil_conv List.linorder_class.Max.set_eq_fold)
apply (case_tac "fold max c b \<le> length i")
apply simp
apply (metis List.finite_set Max.union Plus.prems(4) enumerate_aexp_inputs.simps(4) enumerate_aexp_inputs_not_empty max_less_iff_conj no_variables_aval sup_bot.left_neutral sup_bot.right_neutral)
by simp
next
case (Minus a1 a2)
then show ?case
apply (simp only: enumerate_aexp_inputs_not_empty[of "Minus a1 a2"])
apply (erule exE)+
apply (simp only: neq_Nil_conv List.linorder_class.Max.set_eq_fold)
apply (case_tac "fold max c b \<le> length i")
apply simp
apply (metis List.finite_set Max.union Minus.prems(4) enumerate_aexp_inputs.simps(5) enumerate_aexp_inputs_not_empty max_less_iff_conj no_variables_aval sup_bot.left_neutral sup_bot.right_neutral)
by simp
next
case (Times a1 a2)
then show ?case
apply (simp only: enumerate_aexp_inputs_not_empty[of "Times a1 a2"])
apply (erule exE)+
apply (simp only: neq_Nil_conv List.linorder_class.Max.set_eq_fold)
apply (case_tac "fold max c b \<le> length i")
apply simp
apply (metis List.finite_set Max.union Times.prems(4) enumerate_aexp_inputs.simps(6) enumerate_aexp_inputs_not_empty max_less_iff_conj no_variables_aval sup_bot.left_neutral sup_bot.right_neutral)
by simp
qed
definition max_input :: "vname aexp \<Rightarrow> nat option" where
"max_input g = (let inputs = (enumerate_aexp_inputs g) in if inputs = {} then None else Some (Max inputs))"
definition max_reg :: "vname aexp \<Rightarrow> nat option" where
"max_reg g = (let regs = (enumerate_regs g) in if regs = {} then None else Some (Max regs))"
lemma max_reg_V_I: "max_reg (V (I n)) = None"
by (simp add: max_reg_def)
lemma max_reg_V_R: "max_reg (V (R n)) = Some n"
by (simp add: max_reg_def)
lemmas max_reg_V = max_reg_V_I max_reg_V_R
lemma max_reg_Plus: "max_reg (Plus a1 a2) = max (max_reg a1) (max_reg a2)"
apply (simp add: max_reg_def Let_def max_absorb2)
by (metis Max.union bot_option_def finite_enumerate_regs max_bot2 sup_Some sup_max)
lemma max_reg_Minus: "max_reg (Minus a1 a2) = max (max_reg a1) (max_reg a2)"
apply (simp add: max_reg_def Let_def max_absorb2)
by (metis Max.union bot_option_def finite_enumerate_regs max_bot2 sup_Some sup_max)
lemma max_reg_Times: "max_reg (Times a1 a2) = max (max_reg a1) (max_reg a2)"
apply (simp add: max_reg_def Let_def max_absorb2)
by (metis Max.union bot_option_def finite_enumerate_regs max_bot2 sup_Some sup_max)
lemma no_reg_aval_swap_regs:
"max_reg a = None \<Longrightarrow> aval a (join_ir i r) = aval a (join_ir i r')"
proof(induct a)
case (V x)
then show ?case
apply (cases x)
apply (simp add: join_ir_def)
by (simp add: join_ir_def max_reg_def)
next
case (Plus a1 a2)
then show ?case
by (metis (no_types, lifting) aval.simps(3) max.absorb2 max.cobounded2 max_reg_Plus sup_None_2 sup_max)
next
case (Minus a1 a2)
then show ?case
by (metis (no_types, lifting) aval.simps(4) max.cobounded2 max_def_raw max_reg_Minus sup_None_2 sup_max)
next
case (Times a1 a2)
then show ?case
proof -
have "bot = max_reg a2"
by (metis (no_types) Times.prems bot_option_def max.left_commute max_bot2 max_def_raw max_reg_Times)
then show ?thesis
by (metis Times.hyps(1) Times.hyps(2) Times.prems aval.simps(5) bot_option_def max_bot2 max_reg_Times)
qed
qed auto
lemma aval_reg_some_superset:
"\<forall>a. (r $ a \<noteq> None) \<longrightarrow> r $ a = r' $ a \<Longrightarrow>
aval a (join_ir i r) = Some v \<Longrightarrow>
aval a (join_ir i r') = Some v"
proof(induct a arbitrary: v rule: aexp_induct_separate_V_cases)
case (I x)
then show ?case
by (simp add: join_ir_def)
next
case (Plus x1a x2a)
then show ?case
apply simp
by (metis maybe_arith_int_not_None option.simps(3) value_plus_def)
next
case (Minus x1a x2a)
then show ?case
apply simp
by (metis maybe_arith_int_not_None option.simps(3) value_minus_def)
next
case (Times x1a x2a)
then show ?case
apply simp
by (metis maybe_arith_int_not_None option.simps(3) value_times_def)
qed auto
lemma aval_reg_none_superset:
"\<forall>a. (r $ a \<noteq> None) \<longrightarrow> r $ a = r' $ a \<Longrightarrow>
aval a (join_ir i r') = None \<Longrightarrow>
aval a (join_ir i r) = None"
proof(induct a)
case (V x)
then show ?case
apply (cases x)
apply (simp add: join_ir_def)
by auto
next
case (Plus a1 a2)
then show ?case
apply simp
by (metis (no_types, lifting) maybe_arith_int_None Plus.prems(1) aval_reg_some_superset value_plus_def)
next
case (Minus a1 a2)
then show ?case
apply simp
by (metis (no_types, lifting) maybe_arith_int_None Minus.prems(1) aval_reg_some_superset value_minus_def)
next
case (Times a1 a2)
then show ?case
apply simp
by (metis (no_types, lifting) maybe_arith_int_None Times.prems(1) aval_reg_some_superset value_times_def)
qed auto
lemma enumerate_regs_empty_reg_unconstrained:
"enumerate_regs a = {} \<Longrightarrow> \<forall>r. \<not> aexp_constrains a (V (R r))"
by (induct a rule: aexp_induct_separate_V_cases, auto)
lemma enumerate_aexp_inputs_empty_input_unconstrained:
"enumerate_aexp_inputs a = {} \<Longrightarrow> \<forall>r. \<not> aexp_constrains a (V (I r))"
by (induct a rule: aexp_induct_separate_V_cases, auto)
lemma input_unconstrained_aval_input_swap:
"\<forall>i. \<not> aexp_constrains a (V (I i)) \<Longrightarrow>
aval a (join_ir i r) = aval a (join_ir i' r)"
using join_ir_def
by (induct a rule: aexp_induct_separate_V_cases, auto)
lemma input_unconstrained_aval_register_swap:
"\<forall>i. \<not> aexp_constrains a (V (R i)) \<Longrightarrow>
aval a (join_ir i r) = aval a (join_ir i r')"
using join_ir_def
by (induct a rule: aexp_induct_separate_V_cases, auto)
lemma unconstrained_variable_swap_aval:
"\<forall>i. \<not> aexp_constrains a (V (I i)) \<Longrightarrow>
\<forall>r. \<not> aexp_constrains a (V (R r)) \<Longrightarrow>
aval a s = aval a s'"
by (induct a rule: aexp_induct_separate_V_cases, auto)
lemma max_input_I: "max_input (V (vname.I i)) = Some i"
by (simp add: max_input_def)
lemma max_input_Plus:
"max_input (Plus a1 a2) = max (max_input a1) (max_input a2)"
apply (simp add: max_input_def Let_def max.commute max_absorb2)
by (metis List.finite_set Max.union enumerate_aexp_inputs_list sup_Some sup_max)
lemma max_input_Minus:
"max_input (Minus a1 a2) = max (max_input a1) (max_input a2)"
apply (simp add: max_input_def Let_def max.commute max_absorb2)
by (metis List.finite_set Max.union enumerate_aexp_inputs_list sup_Some sup_max)
lemma max_input_Times:
"max_input (Times a1 a2) = max (max_input a1) (max_input a2)"
apply (simp add: max_input_def Let_def max.commute max_absorb2)
by (metis List.finite_set Max.union enumerate_aexp_inputs_list sup_Some sup_max)
lemma aval_take:
"max_input x < Some a \<Longrightarrow>
aval x (join_ir i r) = aval x (join_ir (take a i) r)"
proof(induct x rule: aexp_induct_separate_V_cases)
case (I x)
then show ?case
by (metis aval.simps(2) input2state_take join_ir_def le_cases less_option_Some max_input_I take_all vname.simps(5))
next
case (R x)
then show ?case
by (simp add: join_ir_def)
next
case (Plus x1a x2a)
then show ?case
by (simp add: max_input_Plus)
next
case (Minus x1a x2a)
then show ?case
by (simp add: max_input_Minus)
next
case (Times x1a x2a)
then show ?case
by (simp add: max_input_Times)
qed auto
lemma aval_no_reg_swap_regs: "max_input x < Some a \<Longrightarrow>
max_reg x = None \<Longrightarrow>
aval x (join_ir i ra) = aval x (join_ir (take a i) r)"
proof(induct x)
case (V x)
then show ?case
apply (cases x)
apply (metis aval_take enumerate_regs.simps(3) enumerate_regs_empty_reg_unconstrained input_unconstrained_aval_register_swap)
by (simp add: max_reg_def)
next
case (Plus x1 x2)
then show ?case
by (metis aval_take no_reg_aval_swap_regs)
next
case (Minus x1 x2)
then show ?case
by (metis aval_take no_reg_aval_swap_regs)
next
case (Times x1 x2)
then show ?case
by (metis aval_take no_reg_aval_swap_regs)
qed auto
fun enumerate_aexp_strings :: "'a aexp \<Rightarrow> String.literal set" where
"enumerate_aexp_strings (L (Str s)) = {s}" |
"enumerate_aexp_strings (L (Num s)) = {}" |
"enumerate_aexp_strings (V _) = {}" |
"enumerate_aexp_strings (Plus a1 a2) = enumerate_aexp_strings a1 \<union> enumerate_aexp_strings a2" |
"enumerate_aexp_strings (Minus a1 a2) = enumerate_aexp_strings a1 \<union> enumerate_aexp_strings a2" |
"enumerate_aexp_strings (Times a1 a2) = enumerate_aexp_strings a1 \<union> enumerate_aexp_strings a2"
fun enumerate_aexp_ints :: "'a aexp \<Rightarrow> int set" where
"enumerate_aexp_ints (L (Str s)) = {}" |
"enumerate_aexp_ints (L (Num s)) = {s}" |
"enumerate_aexp_ints (V _) = {}" |
"enumerate_aexp_ints (Plus a1 a2) = enumerate_aexp_ints a1 \<union> enumerate_aexp_ints a2" |
"enumerate_aexp_ints (Minus a1 a2) = enumerate_aexp_ints a1 \<union> enumerate_aexp_ints a2" |
"enumerate_aexp_ints (Times a1 a2) = enumerate_aexp_ints a1 \<union> enumerate_aexp_ints a2"
definition enumerate_vars :: "vname aexp \<Rightarrow> vname set" where
"enumerate_vars a = (image I (enumerate_aexp_inputs a)) \<union> (image R (enumerate_regs a))"
fun rename_regs :: "(nat \<Rightarrow> nat) \<Rightarrow> vname aexp \<Rightarrow> vname aexp" where
"rename_regs _ (L l) = (L l)" |
"rename_regs f (V (R r)) = (V (R (f r)))" |
"rename_regs _ (V v) = (V v)" |
"rename_regs f (Plus a b) = Plus (rename_regs f a) (rename_regs f b)" |
"rename_regs f (Minus a b) = Minus (rename_regs f a) (rename_regs f b)" |
"rename_regs f (Times a b) = Times (rename_regs f a) (rename_regs f b)"
definition eq_upto_rename :: "vname aexp \<Rightarrow> vname aexp \<Rightarrow> bool" where
"eq_upto_rename a1 a2 = (\<exists>f. bij f \<and> rename_regs f a1 = a2)"
end

171
Extended_Finite_State_Machines/AExp_Lexorder.thy

@ -0,0 +1,171 @@
subsection\<open>AExp Lexorder\<close>
text\<open>This theory defines a lexicographical ordering on arithmetic expressions such that we can build
orderings for guards and, subsequently, transitions. We make use of the previously established
orderings on variable names and values.\<close>
theory AExp_Lexorder
imports AExp Value_Lexorder
begin
text_raw\<open>\snip{height}{1}{2}{%\<close>
fun height :: "'a aexp \<Rightarrow> nat" where
"height (L l2) = 1" |
"height (V v2) = 1" |
"height (Plus e1 e2) = 1 + max (height e1) (height e2)" |
"height (Minus e1 e2) = 1 + max (height e1) (height e2)" |
"height (Times e1 e2) = 1 + max (height e1) (height e2)"
text_raw\<open>}%endsnip\<close>
instantiation aexp :: (linorder) linorder begin
fun less_aexp_aux :: "'a aexp \<Rightarrow> 'a aexp \<Rightarrow> bool" where
"less_aexp_aux (L l1) (L l2) = (l1 < l2)" |
"less_aexp_aux (L l1) _ = True" |
"less_aexp_aux (V v1) (L l1) = False" |
"less_aexp_aux (V v1) (V v2) = (v1 < v2)" |
"less_aexp_aux (V v1) _ = True" |
"less_aexp_aux (Plus e1 e2) (L l2) = False" |
"less_aexp_aux (Plus e1 e2) (V v2) = False" |
"less_aexp_aux (Plus e1 e2) (Plus e1' e2') = ((less_aexp_aux e1 e1') \<or> ((e1 = e1') \<and> (less_aexp_aux e2 e2')))"|
"less_aexp_aux (Plus e1 e2) _ = True" |
"less_aexp_aux (Minus e1 e2) (Minus e1' e2') = ((less_aexp_aux e1 e1') \<or> ((e1 = e1') \<and> (less_aexp_aux e2 e2')))" |
"less_aexp_aux (Minus e1 e2) (Times e1' e2') = True" |
"less_aexp_aux (Minus e1 e2) _ = False" |
"less_aexp_aux (Times e1 e2) (Times e1' e2') = ((less_aexp_aux e1 e1') \<or> ((e1 = e1') \<and> (less_aexp_aux e2 e2')))" |
"less_aexp_aux (Times e1 e2) _ = False"
definition less_aexp :: "'a aexp \<Rightarrow> 'a aexp \<Rightarrow> bool" where
"less_aexp a1 a2 = (
let
h1 = height a1;
h2 = height a2
in
if h1 = h2 then
less_aexp_aux a1 a2
else
h1 < h2
)"
definition less_eq_aexp :: "'a aexp \<Rightarrow> 'a aexp \<Rightarrow> bool"
where "less_eq_aexp e1 e2 \<equiv> (e1 < e2) \<or> (e1 = e2)"
declare less_aexp_def [simp]
lemma less_aexp_aux_antisym: "less_aexp_aux x y = (\<not>(less_aexp_aux y x) \<and> (x \<noteq> y))"
by (induct x y rule: less_aexp_aux.induct, auto)
lemma less_aexp_antisym: "(x::'a aexp) < y = (\<not>(y < x) \<and> (x \<noteq> y))"
apply (simp add: Let_def)
apply standard
using less_aexp_aux_antisym apply blast
apply (simp add: not_less)
apply clarify
by (induct x, auto)
lemma less_aexp_aux_trans: "less_aexp_aux x y \<Longrightarrow> less_aexp_aux y z \<Longrightarrow> less_aexp_aux x z"
proof (induct x y arbitrary: z rule: less_aexp_aux.induct)
case (1 l1 l2)
then show ?case by (cases z, auto)
next
case ("2_1" l1 v)
then show ?case by (cases z, auto)
next
case ("2_2" l1 v va)
then show ?case by (cases z, auto)
next
case ("2_3" l1 v va)
then show ?case by (cases z, auto)
next
case ("2_4" l1 v va)
then show ?case by (cases z, auto)
next
case (3 v1 l1)
then show ?case by (cases z, auto)
next
case (4 v1 v2)
then show ?case by (cases z, auto)
next
case ("5_1" v1 v va)
then show ?case by (cases z, auto)
next
case ("5_2" v1 v va)
then show ?case by (cases z, auto)
next
case ("5_3" v1 v va)
then show ?case by (cases z, auto)
next
case (6 e1 e2 l2)
then show ?case by (cases z, auto)
next
case (7 e1 e2 v2)
then show ?case by (cases z, auto)
next
case (8 e1 e2 e1' e2')
then show ?case by (cases z, auto)
next
case ("9_1" e1 e2 v va)
then show ?case by (cases z, auto)
next
case ("9_2" e1 e2 v va)
then show ?case by (cases z, auto)
next
case (10 e1 e2 e1' e2')
then show ?case by (cases z, auto)
next
case (11 e1 e2 e1' e2')
then show ?case by (cases z, auto)
next
case ("12_1" e1 e2 v)
then show ?case by (cases z, auto)
next
case ("12_2" e1 e2 v)
then show ?case by (cases z, auto)
next
case ("12_3" e1 e2 v va)
then show ?case by (cases z, auto)
next
case (13 e1 e2 e1' e2')
then show ?case by (cases z, auto)
next
case ("14_1" e1 e2 v)
then show ?case by (cases z, auto)
next
case ("14_2" e1 e2 v)
then show ?case by (cases z, auto)
next
case ("14_3" e1 e2 v va)
then show ?case by (cases z, auto)
next
case ("14_4" e1 e2 v va)
then show ?case by (cases z, auto)
qed
lemma less_aexp_trans: "(x::'a aexp) < y \<Longrightarrow> y < z \<Longrightarrow> x < z"
apply (simp add: Let_def)
apply standard
apply (metis AExp_Lexorder.less_aexp_aux_trans dual_order.asym)
by presburger
instance proof
fix x y z :: "'a aexp"
show "(x < y) = (x \<le> y \<and> \<not> y \<le> x)"
by (metis less_aexp_antisym less_eq_aexp_def)
show "(x \<le> x)"
by (simp add: less_eq_aexp_def)
show "x \<le> y \<Longrightarrow> y \<le> z \<Longrightarrow> x \<le> z"
by (metis less_aexp_trans less_eq_aexp_def)
show "x \<le> y \<Longrightarrow> y \<le> x \<Longrightarrow> x = y"
unfolding less_eq_aexp_def using less_aexp_antisym by blast
show "x \<le> y \<or> y \<le> x"
unfolding less_eq_aexp_def using less_aexp_antisym by blast
qed
end
lemma smaller_height: "height a1 < height a2 \<Longrightarrow> a1 < a2"
by simp
end

1495
Extended_Finite_State_Machines/EFSM.thy

File diff suppressed because it is too large

281
Extended_Finite_State_Machines/EFSM_LTL.thy

@ -0,0 +1,281 @@
section\<open>LTL for EFSMs\<close>
text\<open>This theory builds off the \texttt{Linear\_Temporal\_Logic\_on\_Streams} theory from the HOL
library and defines functions to ease the expression of LTL properties over EFSMs. Since the LTL
operators effectively act over traces of models we must find a way to express models as streams.\<close>
theory EFSM_LTL
imports "Extended_Finite_State_Machines.EFSM" "HOL-Library.Linear_Temporal_Logic_on_Streams"
begin
text_raw\<open>\snip{statedef}{1}{2}{%\<close>
record state =
statename :: "nat option"
datastate :: registers
action :: action
"output" :: outputs
text_raw\<open>}%endsnip\<close>
text_raw\<open>\snip{whitebox}{1}{2}{%\<close>
type_synonym whitebox_trace = "state stream"
text_raw\<open>}%endsnip\<close>
type_synonym property = "whitebox_trace \<Rightarrow> bool"
abbreviation label :: "state \<Rightarrow> String.literal" where
"label s \<equiv> fst (action s)"
abbreviation inputs :: "state \<Rightarrow> value list" where
"inputs s \<equiv> snd (action s)"
text_raw\<open>\snip{ltlStep}{1}{2}{%\<close>
fun ltl_step :: "transition_matrix \<Rightarrow> cfstate option \<Rightarrow> registers \<Rightarrow> action \<Rightarrow> (nat option \<times> outputs \<times> registers)" where
"ltl_step _ None r _ = (None, [], r)" |
"ltl_step e (Some s) r (l, i) = (let possibilities = possible_steps e s r l i in
if possibilities = {||} then (None, [], r)
else
let (s', t) = Eps (\<lambda>x. x |\<in>| possibilities) in
(Some s', (evaluate_outputs t i r), (evaluate_updates t i r))
)"
text_raw\<open>}%endsnip\<close>
lemma ltl_step_singleton:
"\<exists>t. possible_steps e n r (fst v) (snd v) = {|(aa, t)|} \<and> evaluate_outputs t (snd v) r = b \<and> evaluate_updates t (snd v) r = c\<Longrightarrow>
ltl_step e (Some n) r v = (Some aa, b, c)"
apply (cases v)
by auto
lemma ltl_step_none: "possible_steps e s r a b = {||} \<Longrightarrow> ltl_step e (Some s) r (a, b) = (None, [], r)"
by simp
lemma ltl_step_none_2: "possible_steps e s r (fst ie) (snd ie) = {||} \<Longrightarrow> ltl_step e (Some s) r ie = (None, [], r)"
by (metis ltl_step_none prod.exhaust_sel)
lemma ltl_step_alt: "ltl_step e (Some s) r t = (
let possibilities = possible_steps e s r (fst t) (snd t) in
if possibilities = {||} then
(None, [], r)
else
let (s', t') = Eps (\<lambda>x. x |\<in>| possibilities) in
(Some s', (apply_outputs (Outputs t') (join_ir (snd t) r)), (apply_updates (Updates t') (join_ir (snd t) r) r))
)"
by (case_tac t, simp add: Let_def)
lemma ltl_step_some:
assumes "possible_steps e s r l i = {|(s', t)|}"
and "evaluate_outputs t i r = p"
and "evaluate_updates t i r = r'"
shows "ltl_step e (Some s) r (l, i) = (Some s', p, r')"
by (simp add: assms)
lemma ltl_step_cases:
assumes invalid: "P (None, [], r)"
and valid: "\<forall>(s', t) |\<in>| (possible_steps e s r l i). P (Some s', (evaluate_outputs t i r), (evaluate_updates t i r))"
shows "P (ltl_step e (Some s) r (l, i))"
apply simp
apply (case_tac "possible_steps e s r l i")
apply (simp add: invalid)
apply simp
subgoal for x S'
apply (case_tac "SOME xa. xa = x \<or> xa |\<in>| S'")
apply simp
apply (insert assms(2))
apply (simp add: fBall_def Ball_def fmember_def)
by (metis (mono_tags, lifting) fst_conv prod.case_eq_if snd_conv someI_ex)
done
text\<open>The \texttt{make\_full\_observation} function behaves similarly to \texttt{observe\_execution}
from the \texttt{EFSM} theory. The main difference in behaviour is what is recorded. While the
observe execution function simply observes an execution of the EFSM to produce the corresponding
output for each action, the intention here is to record every detail of execution, including the
values of internal variables.
Thinking of each action as a step forward in time, there are five components which characterise
a given point in the execution of an EFSM. At each point, the model has a current control state and
data state. Each action has a label and some input parameters, and its execution may produce
some observableoutput. It is therefore sufficient to provide a stream of 5-tuples containing the
current control state, data state, the label and inputs of the action, and computed output. The
make full observation function can then be defined as in Figure 9.1, with an additional
function watch defined on top of this which starts the make full observation off in the
initial control state with the empty data state.
Careful inspection of the definition reveals another way that \texttt{make\_full\_observation}
differs from \texttt{observe\_execution}. Rather than taking a cfstate, it takes a cfstate option.
The reason for this is that we need to make our EFSM models complete. That is, we need them to be
able to respond to every action from every state like a DFA. If a model does not recognise a given
action in a given state, we cannot simply stop processing because we are working with necessarily
infinite traces. Since these traces are generated by observing action sequences, the make full
observation function must keep processing whether there is a viable transition or not.
To support this, the make full observation adds an implicit ``sink state'' to every EFSM it
processes by lifting control flow state indices from \texttt{nat} to \texttt{nat option} such that
state $n$ is seen as state \texttt{Some} $n$. The control flow state \texttt{None} represents a sink
state. If a model is unable to recognise a particular action from its current state, it moves into
the \texttt{None} state. From here, the behaviour is constant for the rest of the time --- the
control flow state remains None; the data state does not change, and no output is produced.\<close>
text_raw\<open>\snip{makeFullObservation}{1}{2}{%\<close>
primcorec make_full_observation :: "transition_matrix \<Rightarrow> cfstate option \<Rightarrow> registers \<Rightarrow> outputs \<Rightarrow> action stream \<Rightarrow> whitebox_trace" where
"make_full_observation e s d p i = (
let (s', o', d') = ltl_step e s d (shd i) in
\<lparr>statename = s, datastate = d, action=(shd i), output = p\<rparr>##(make_full_observation e s' d' o' (stl i))
)"
text_raw\<open>}%endsnip\<close>
text_raw\<open>\snip{watch}{1}{2}{%\<close>
abbreviation watch :: "transition_matrix \<Rightarrow> action stream \<Rightarrow> whitebox_trace" where
"watch e i \<equiv> (make_full_observation e (Some 0) <> [] i)"
text_raw\<open>}%endsnip\<close>
subsection\<open>Expressing Properties\<close>
text\<open>In order to simplify the expression and understanding of properties, this theory defines a
number of named functions which can be used to express certain properties of EFSMs.\<close>
subsubsection\<open>State Equality\<close>
text\<open>The \textsc{state\_eq} takes a cfstate option representing a control flow state index and
returns true if this is the control flow state at the head of the full observation.\<close>
abbreviation state_eq :: "cfstate option \<Rightarrow> whitebox_trace \<Rightarrow> bool" where
"state_eq v s \<equiv> statename (shd s) = v"
lemma state_eq_holds: "state_eq s = holds (\<lambda>x. statename x = s)"
apply (rule ext)
by (simp add: holds_def)
lemma state_eq_None_not_Some: "state_eq None s \<Longrightarrow> \<not> state_eq (Some n) s"
by simp
subsubsection\<open>Label Equality\<close>
text\<open>The \textsc{label\_eq} function takes a string and returns true if this is equal to the label
at the head of the full observation.\<close>
abbreviation "label_eq v s \<equiv> fst (action (shd s)) = (String.implode v)"
lemma watch_label: "label_eq l (watch e t) = (fst (shd t) = String.implode l)"
by (simp add: )
subsubsection\<open>Input Equality\<close>
text\<open>The \textsc{input\_eq} function takes a value list and returns true if this is equal to the
input at the head of the full observation.\<close>
abbreviation "input_eq v s \<equiv> inputs (shd s) = v"
subsubsection\<open>Action Equality\<close>
text\<open>The \textsc{action\_eq} function takes a (label, value list) pair and returns true if this is
equal to the action at the head of the full observation. This effectively combines
\texttt{label\_eq} and \texttt{input\_eq} into one function.\<close>
abbreviation "action_eq e \<equiv> label_eq (fst e) aand input_eq (snd e)"
subsubsection\<open>Output Equality\<close>
text\<open>The \textsc{output\_eq} function takes a takes a value option list and returns true if this is
equal to the output at the head of the full observation.\<close>
abbreviation "output_eq v s \<equiv> output (shd s) = v"
text_raw\<open>\snip{ltlVName}{1}{2}{%\<close>
datatype ltl_vname = Ip nat | Op nat | Rg nat
text_raw\<open>}%endsnip\<close>
subsubsection\<open>Checking Arbitrary Expressions\<close>
text\<open>The \textsc{check\_exp} function takes a guard expression and returns true if the guard
expression evaluates to true in the given state.\<close>
type_synonym ltl_gexp = "ltl_vname gexp"
definition join_iro :: "value list \<Rightarrow> registers \<Rightarrow> outputs \<Rightarrow> ltl_vname datastate" where
"join_iro i r p = (\<lambda>x. case x of
Rg n \<Rightarrow> r $ n |
Ip n \<Rightarrow> Some (i ! n) |
Op n \<Rightarrow> p ! n
)"
lemma join_iro_R [simp]: "join_iro i r p (Rg n) = r $ n"
by (simp add: join_iro_def)
abbreviation "check_exp g s \<equiv> (gval g (join_iro (snd (action (shd s))) (datastate (shd s)) (output (shd s))) = trilean.true)"
lemma alw_ev: "alw f = not (ev (\<lambda>s. \<not>f s))"
by simp
lemma alw_state_eq_smap:
"alw (state_eq s) ss = alw (\<lambda>ss. shd ss = s) (smap statename ss)"
apply standard
apply (simp add: alw_iff_sdrop )
by (simp add: alw_mono alw_smap )
subsection\<open>Sink State\<close>
text\<open>Once the sink state is entered, it cannot be left and there are no outputs or updates
henceforth.\<close>
lemma shd_state_is_none: "(state_eq None) (make_full_observation e None r p t)"
by (simp add: )
lemma unfold_observe_none: "make_full_observation e None d p t = (\<lparr>statename = None, datastate = d, action=(shd t), output = p\<rparr>##(make_full_observation e None d [] (stl t)))"
by (simp add: stream.expand)
lemma once_none_always_none_aux:
assumes "\<exists> p r i. j = (make_full_observation e None r p) i"
shows "alw (state_eq None) j"
using assms apply coinduct
apply simp
by fastforce
lemma once_none_always_none: "alw (state_eq None) (make_full_observation e None r p t)"
using once_none_always_none_aux by blast
lemma once_none_nxt_always_none: "alw (nxt (state_eq None)) (make_full_observation e None r p t)"
using once_none_always_none
by (simp add: alw_iff_sdrop del: sdrop.simps)
lemma snth_sconst: "(\<forall>i. s !! i = h) = (s = sconst h)"
by (metis funpow_code_def id_funpow sdrop_simps(1) sdrop_siterate siterate.simps(1) smap_alt smap_sconst snth.simps(1) stream.map_id)
lemma alw_sconst: "(alw (\<lambda>xs. shd xs = h) t) = (t = sconst h)"
by (simp add: snth_sconst[symmetric] alw_iff_sdrop)
lemma smap_statename_None: "smap statename (make_full_observation e None r p i) = sconst None"
by (meson EFSM_LTL.alw_sconst alw_state_eq_smap once_none_always_none)
lemma alw_not_some: "alw (\<lambda>xs. statename (shd xs) \<noteq> Some s) (make_full_observation e None r p t)"
by (metis (mono_tags, lifting) alw_mono once_none_always_none option.distinct(1) )
lemma state_none: "((state_eq None) impl nxt (state_eq None)) (make_full_observation e s r p t)"
by (simp add: )
lemma state_none_2:
"(state_eq None) (make_full_observation e s r p t) \<Longrightarrow>
(state_eq None) (make_full_observation e s r p (stl t))"
by (simp add: )
lemma no_output_none_aux:
assumes "\<exists> p r i. j = (make_full_observation e None r []) i"
shows "alw (output_eq []) j"
using assms apply coinduct
apply simp
by fastforce
lemma no_output_none: "nxt (alw (output_eq [])) (make_full_observation e None r p t)"
using no_output_none_aux by auto
lemma nxt_alw: "nxt (alw P) s \<Longrightarrow> alw (nxt P) s"
by (simp add: alw_iff_sdrop)
lemma no_output_none_nxt: "alw (nxt (output_eq [])) (make_full_observation e None r p t)"
using nxt_alw no_output_none by blast
lemma no_output_none_if_empty: "alw (output_eq []) (make_full_observation e None r [] t)"
by (metis (mono_tags, lifting) alw_nxt make_full_observation.simps(1) no_output_none state.select_convs(4))
lemma no_updates_none_aux:
assumes "\<exists> p i. j = (make_full_observation e None r p) i"
shows "alw (\<lambda>x. datastate (shd x) = r) j"
using assms apply coinduct
by fastforce
lemma no_updates_none: "alw (\<lambda>x. datastate (shd x) = r) (make_full_observation e None r p t)"
using no_updates_none_aux by blast
lemma action_components: "(label_eq l aand input_eq i) s = (action (shd s) = (String.implode l, i))"
by (metis fst_conv prod.collapse snd_conv)
end

341
Extended_Finite_State_Machines/FSet_Utils.thy

@ -0,0 +1,341 @@
section\<open>FSet Utilities\<close>
text\<open>This theory provides various additional lemmas, definitions, and syntax over the fset data type.\<close>
theory FSet_Utils
imports "HOL-Library.FSet"
begin
notation (latex output)
"FSet.fempty" ("\<emptyset>") and
"FSet.fmember" ("\<in>")
syntax (ASCII)
"_fBall" :: "pttrn \<Rightarrow> 'a fset \<Rightarrow> bool \<Rightarrow> bool" ("(3ALL (_/:_)./ _)" [0, 0, 10] 10)
"_fBex" :: "pttrn \<Rightarrow> 'a fset \<Rightarrow> bool \<Rightarrow> bool" ("(3EX (_/:_)./ _)" [0, 0, 10] 10)
"_fBex1" :: "pttrn \<Rightarrow> 'a fset \<Rightarrow> bool \<Rightarrow> bool" ("(3EX! (_/:_)./ _)" [0, 0, 10] 10)
syntax (input)
"_fBall" :: "pttrn \<Rightarrow> 'a fset \<Rightarrow> bool \<Rightarrow> bool" ("(3! (_/:_)./ _)" [0, 0, 10] 10)
"_fBex" :: "pttrn \<Rightarrow> 'a fset \<Rightarrow> bool \<Rightarrow> bool" ("(3? (_/:_)./ _)" [0, 0, 10] 10)
"_fBex1" :: "pttrn \<Rightarrow> 'a fset \<Rightarrow> bool \<Rightarrow> bool" ("(3?! (_/:_)./ _)" [0, 0, 10] 10)
syntax
"_fBall" :: "pttrn \<Rightarrow> 'a fset \<Rightarrow> bool \<Rightarrow> bool" ("(3\<forall>(_/|\<in>|_)./ _)" [0, 0, 10] 10)
"_fBex" :: "pttrn \<Rightarrow> 'a fset \<Rightarrow> bool \<Rightarrow> bool" ("(3\<exists>(_/|\<in>|_)./ _)" [0, 0, 10] 10)
"_fBnex" :: "pttrn \<Rightarrow> 'a fset \<Rightarrow> bool \<Rightarrow> bool" ("(3\<nexists>(_/|\<in>|_)./ _)" [0, 0, 10] 10)
"_fBex1" :: "pttrn \<Rightarrow> 'a fset \<Rightarrow> bool \<Rightarrow> bool" ("(3\<exists>!(_/|\<in>|_)./ _)" [0, 0, 10] 10)
translations
"\<forall>x|\<in>|A. P" \<rightleftharpoons> "CONST fBall A (\<lambda>x. P)"
"\<exists>x|\<in>|A. P" \<rightleftharpoons> "CONST fBex A (\<lambda>x. P)"
"\<nexists>x|\<in>|A. P" \<rightleftharpoons> "CONST fBall A (\<lambda>x. \<not>P)"
"\<exists>!x|\<in>|A. P" \<rightharpoonup> "\<exists>!x. x |\<in>| A \<and> P"
lemma fset_of_list_remdups [simp]: "fset_of_list (remdups l) = fset_of_list l"
apply (induct l)
apply simp
by (simp add: finsert_absorb fset_of_list_elem)
definition "fSum \<equiv> fsum (\<lambda>x. x)"
lemma fset_both_sides: "(Abs_fset s = f) = (fset (Abs_fset s) = fset f)"
by (simp add: fset_inject)
lemma Abs_ffilter: "(ffilter f s = s') = ({e \<in> (fset s). f e} = (fset s'))"
by (simp add: ffilter_def fset_both_sides Abs_fset_inverse Set.filter_def)
lemma size_ffilter_card: "size (ffilter f s) = card ({e \<in> (fset s). f e})"
by (simp add: ffilter_def fset_both_sides Abs_fset_inverse Set.filter_def)
lemma ffilter_empty [simp]: "ffilter f {||} = {||}"
by auto
lemma ffilter_finsert:
"ffilter f (finsert a s) = (if f a then finsert a (ffilter f s) else (ffilter f s))"
apply simp
apply standard
apply (simp add: ffilter_def fset_both_sides Abs_fset_inverse)
apply auto[1]
apply (simp add: ffilter_def fset_both_sides Abs_fset_inverse)
by auto
lemma fset_equiv: "(f1 = f2) = (fset f1 = fset f2)"
by (simp add: fset_inject)
lemma finsert_equiv: "(finsert e f = f') = (insert e (fset f) = (fset f'))"
by (simp add: finsert_def fset_both_sides Abs_fset_inverse)
lemma filter_elements:
"x |\<in>| Abs_fset (Set.filter f (fset s)) = (x \<in> (Set.filter f (fset s)))"
by (metis ffilter.rep_eq fset_inverse notin_fset)
lemma sorted_list_of_fempty [simp]: "sorted_list_of_fset {||} = []"
by (simp add: sorted_list_of_fset_def)
lemma fmember_implies_member: "e |\<in>| f \<Longrightarrow> e \<in> fset f"
by (simp add: fmember_def)
lemma fold_union_ffUnion: "fold (|\<union>|) l {||} = ffUnion (fset_of_list l)"
by(induct l rule: rev_induct, auto)
lemma filter_filter:
"ffilter P (ffilter Q xs) = ffilter (\<lambda>x. Q x \<and> P x) xs"
by auto
lemma fsubset_strict:
"x2 |\<subset>| x1 \<Longrightarrow> \<exists>e. e |\<in>| x1 \<and> e |\<notin>| x2"
by auto
lemma fsubset:
"x2 |\<subset>| x1 \<Longrightarrow> \<nexists>e. e |\<in>| x2 \<and> e |\<notin>| x1"
by auto
lemma size_fsubset_elem:
assumes "\<exists>e. e |\<in>| x1 \<and> e |\<notin>| x2"
and "\<nexists>e. e |\<in>| x2 \<and> e |\<notin>| x1"
shows "size x2 < size x1"
using assms
apply (simp add: fmember_def)
by (metis card_seteq finite_fset linorder_not_le subsetI)
lemma size_fsubset: "x2 |\<subset>| x1 \<Longrightarrow> size x2 < size x1"
by (metis fsubset fsubset_strict size_fsubset_elem)
definition fremove :: "'a \<Rightarrow> 'a fset \<Rightarrow> 'a fset"
where [code_abbrev]: "fremove x A = A - {|x|}"
lemma arg_cong_ffilter:
"\<forall>e |\<in>| f. p e = p' e \<Longrightarrow> ffilter p f = ffilter p' f"
by auto
lemma ffilter_singleton: "f e \<Longrightarrow> ffilter f {|e|} = {|e|}"
apply (simp add: ffilter_def fset_both_sides Abs_fset_inverse)
by auto
lemma fset_eq_alt: "(x = y) = (x |\<subseteq>| y \<and> size x = size y)"
by (metis exists_least_iff le_less size_fsubset)
lemma ffold_empty [simp]: "ffold f b {||} = b"
by (simp add: ffold_def)
lemma sorted_list_of_fset_sort:
"sorted_list_of_fset (fset_of_list l) = sort (remdups l)"
by (simp add: fset_of_list.rep_eq sorted_list_of_fset.rep_eq sorted_list_of_set_sort_remdups)
lemma fMin_Min: "fMin (fset_of_list l) = Min (set l)"
by (simp add: fMin.F.rep_eq fset_of_list.rep_eq)
lemma sorted_hd_Min:
"sorted l \<Longrightarrow>
l \<noteq> [] \<Longrightarrow>
hd l = Min (set l)"
by (metis List.finite_set Min_eqI eq_iff hd_Cons_tl insertE list.set_sel(1) list.simps(15) sorted.simps(2))
lemma hd_sort_Min: "l \<noteq> [] \<Longrightarrow> hd (sort l) = Min (set l)"
by (metis sorted_hd_Min set_empty set_sort sorted_sort)
lemma hd_sort_remdups: "hd (sort (remdups l)) = hd (sort l)"
by (metis hd_sort_Min remdups_eq_nil_iff set_remdups)
lemma exists_fset_of_list: "\<exists>l. f = fset_of_list l"
using exists_fset_of_list by fastforce
lemma hd_sorted_list_of_fset:
"s \<noteq> {||} \<Longrightarrow> hd (sorted_list_of_fset s) = (fMin s)"
apply (insert exists_fset_of_list[of s])
apply (erule exE)
apply simp
apply (simp add: sorted_list_of_fset_sort fMin_Min hd_sort_remdups)
by (metis fset_of_list_simps(1) hd_sort_Min)
lemma fminus_filter_singleton:
"fset_of_list l |-| {|x|} = fset_of_list (filter (\<lambda>e. e \<noteq> x) l)"
by auto
lemma card_minus_fMin:
"s \<noteq> {||} \<Longrightarrow> card (fset s - {fMin s}) < card (fset s)"
by (metis Min_in bot_fset.rep_eq card_Diff1_less fMin.F.rep_eq finite_fset fset_equiv)
(* Provides a deterministic way to fold fsets similar to List.fold that works with the code generator *)
function ffold_ord :: "(('a::linorder) \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> 'a fset \<Rightarrow> 'b \<Rightarrow> 'b" where
"ffold_ord f s b = (
if s = {||} then
b
else
let
h = fMin s;
t = s - {|h|}
in
ffold_ord f t (f h b)
)"
by auto
termination
apply (relation "measures [\<lambda>(a, s, ab). size s]")
apply simp
by (simp add: card_minus_fMin)
lemma sorted_list_of_fset_Cons:
"\<exists>h t. (sorted_list_of_fset (finsert s ss)) = h#t"
apply (simp add: sorted_list_of_fset_def)
by (cases "insort s (sorted_list_of_set (fset ss - {s}))", auto)
lemma list_eq_hd_tl:
"l \<noteq> [] \<Longrightarrow>
hd l = h \<Longrightarrow>
tl l = t \<Longrightarrow>
l = (h#t)"
by auto
lemma fset_of_list_sort: "fset_of_list l = fset_of_list (sort l)"
by (simp add: fset_of_list.abs_eq)
lemma exists_sorted_distinct_fset_of_list:
"\<exists>l. sorted l \<and> distinct l \<and> f = fset_of_list l"
by (metis distinct_sorted_list_of_set sorted_list_of_fset.rep_eq sorted_list_of_fset_simps(2) sorted_sorted_list_of_set)
lemma fset_of_list_empty [simp]: "(fset_of_list l = {||}) = (l = [])"
by (metis fset_of_list.rep_eq fset_of_list_simps(1) set_empty)
lemma ffold_ord_cons: assumes sorted: "sorted (h#t)"
and distinct: "distinct (h#t)"
shows "ffold_ord f (fset_of_list (h#t)) b = ffold_ord f (fset_of_list t) (f h b)"
proof-
have h_is_min: "h = fMin (fset_of_list (h#t))"
by (metis sorted fMin_Min list.sel(1) list.simps(3) sorted_hd_Min)
have remove_min: "fset_of_list t = (fset_of_list (h#t)) - {|h|}"
using distinct fset_of_list_elem by force
show ?thesis
apply (simp only: ffold_ord.simps[of f "fset_of_list (h#t)"])
by (metis h_is_min remove_min fset_of_list_empty list.distinct(1))
qed
lemma sorted_distinct_ffold_ord: assumes "sorted l"
and "distinct l"
shows "ffold_ord f (fset_of_list l) b = fold f l b"
using assms
apply (induct l arbitrary: b)
apply simp
by (metis distinct.simps(2) ffold_ord_cons fold_simps(2) sorted.simps(2))
lemma ffold_ord_fold_sorted: "ffold_ord f s b = fold f (sorted_list_of_fset s) b"
by (metis exists_sorted_distinct_fset_of_list sorted_distinct_ffold_ord distinct_remdups_id sorted_list_of_fset_sort sorted_sort_id)
context includes fset.lifting begin
lift_definition fprod :: "'a fset \<Rightarrow> 'b fset \<Rightarrow> ('a \<times> 'b) fset " (infixr "|\<times>|" 80) is "\<lambda>a b. fset a \<times> fset b"
by simp
lift_definition fis_singleton :: "'a fset \<Rightarrow> bool" is "\<lambda>A. is_singleton (fset A)".
end
lemma fprod_empty_l: "{||} |\<times>| a = {||}"
using bot_fset_def fprod.abs_eq by force
lemma fprod_empty_r: "a |\<times>| {||} = {||}"
by (simp add: fprod_def bot_fset_def Abs_fset_inverse)
lemmas fprod_empty = fprod_empty_l fprod_empty_r
lemma fprod_finsert: "(finsert a as) |\<times>| (finsert b bs) =
finsert (a, b) (fimage (\<lambda>b. (a, b)) bs |\<union>| fimage (\<lambda>a. (a, b)) as |\<union>| (as |\<times>| bs))"
apply (simp add: fprod_def fset_both_sides Abs_fset_inverse)
by auto
lemma fprod_member:
"x |\<in>| xs \<Longrightarrow>
y |\<in>| ys \<Longrightarrow>
(x, y) |\<in>| xs |\<times>| ys"
by (simp add: fmember_def fprod_def Abs_fset_inverse)
lemma fprod_subseteq:
"x |\<subseteq>| x' \<and> y |\<subseteq>| y' \<Longrightarrow> x |\<times>| y |\<subseteq>| x' |\<times>| y'"
apply (simp add: fprod_def less_eq_fset_def Abs_fset_inverse)
by auto
lemma fimage_fprod:
"(a, b) |\<in>| A |\<times>| B \<Longrightarrow> f a b |\<in>| (\<lambda>(x, y). f x y) |`| (A |\<times>| B)"
by force
lemma fprod_singletons: "{|a|} |\<times>| {|b|} = {|(a, b)|}"
apply (simp add: fprod_def)
by (metis fset_inverse fset_simps(1) fset_simps(2))
lemma fprod_equiv:
"(fset (f |\<times>| f') = s) = (((fset f) \<times> (fset f')) = s)"
by (simp add: fprod_def Abs_fset_inverse)
lemma fis_singleton_alt: "fis_singleton f = (\<exists>e. f = {|e|})"
by (metis fis_singleton.rep_eq fset_inverse fset_simps(1) fset_simps(2) is_singleton_def)
lemma singleton_singleton [simp]: "fis_singleton {|a|}"
by (simp add: fis_singleton_def)
lemma not_singleton_empty [simp]: "\<not> fis_singleton {||}"
apply (simp add: fis_singleton_def)
by (simp add: is_singleton_altdef)
lemma fis_singleton_fthe_elem:
"fis_singleton A \<longleftrightarrow> A = {|fthe_elem A|}"
by (metis fis_singleton_alt fthe_felem_eq)
lemma fBall_ffilter:
"\<forall>x |\<in>| X. f x \<Longrightarrow> ffilter f X = X"
by auto
lemma fBall_ffilter2:
"X = Y \<Longrightarrow>
\<forall>x |\<in>| X. f x \<Longrightarrow>
ffilter f X = Y"
by auto
lemma size_fset_of_list: "size (fset_of_list l) = length (remdups l)"
apply (induct l)
apply simp
by (simp add: fset_of_list.rep_eq insert_absorb)
lemma size_fsingleton: "(size f = 1) = (\<exists>e. f = {|e|})"
apply (insert exists_fset_of_list[of f])
apply clarify
apply (simp only: size_fset_of_list)
apply (simp add: fset_of_list_def fset_both_sides Abs_fset_inverse)
by (metis List.card_set One_nat_def card.insert card_1_singletonE card_empty empty_iff finite.intros(1))
lemma ffilter_mono: "(ffilter X xs = f) \<Longrightarrow> \<forall>x |\<in>| xs. X x = Y x \<Longrightarrow> (ffilter Y xs = f)"
by auto
lemma size_fimage: "size (fimage f s) \<le> size s"
apply (induct s)
apply simp
by (simp add: card_insert_if)
lemma size_ffilter: "size (ffilter P f) \<le> size f"
apply (induct f)
apply simp
apply (simp only: ffilter_finsert)
apply (case_tac "P x")
apply (simp add: fmember.rep_eq)
by (simp add: card_insert_if)
lemma fimage_size_le: "\<And>f s. size s \<le> n \<Longrightarrow> size (fimage f s) \<le> n"
using le_trans size_fimage by blast
lemma ffilter_size_le: "\<And>f s. size s \<le> n \<Longrightarrow> size (ffilter f s) \<le> n"
using dual_order.trans size_ffilter by blast
lemma set_membership_eq: "A = B \<longleftrightarrow> (\<lambda>x. Set.member x A) = (\<lambda>x. Set.member x B)"
apply standard
apply simp
by (meson equalityI subsetI)
lemmas ffilter_eq_iff = Abs_ffilter set_membership_eq fun_eq_iff
lemma size_le_1: "size f \<le> 1 = (f = {||} \<or> (\<exists>e. f = {|e|}))"
apply standard
apply (metis bot.not_eq_extremum gr_implies_not0 le_neq_implies_less less_one size_fsingleton size_fsubset)
by auto
lemma size_gt_1: "1 < size f \<Longrightarrow> \<exists>e1 e2 f'. e1 \<noteq> e2 \<and> f = finsert e1 (finsert e2 f')"
apply (induct f)
apply simp
apply (rule_tac x=x in exI)
by (metis finsertCI leD not_le_imp_less size_le_1)
end

837
Extended_Finite_State_Machines/GExp.thy

@ -0,0 +1,837 @@
subsection \<open>Guards Expressions\<close>
text\<open>
This theory defines the guard language of EFSMs which can be translated directly to and from
contexts. Boolean values true and false respectively represent the guards which are always and never
satisfied. Guards may test for (in)equivalence of two arithmetic expressions or be connected using
\textsc{nor} logic into compound expressions. The use of \textsc{nor} logic reduces the number of
subgoals when inducting over guard expressions.
We also define syntax hacks for the relations less than, less than or equal to, greater than or
equal to, and not equal to as well as the expression of logical conjunction, disjunction, and
negation in terms of nor logic.\<close>
theory GExp
imports AExp Trilean
begin
text_raw\<open>\snip{gexptype}{1}{2}{%\<close>
datatype 'a gexp = Bc bool | Eq "'a aexp" "'a aexp" | Gt "'a aexp" "'a aexp" | In 'a "value list" | Nor "'a gexp" "'a gexp"
text_raw\<open>}%endsnip\<close>
fun gval :: "'a gexp \<Rightarrow> 'a datastate \<Rightarrow> trilean" where
"gval (Bc True) _ = true" |
"gval (Bc False) _ = false" |
"gval (Gt a1 a2) s = value_gt (aval a1 s) (aval a2 s)" |
"gval (Eq a1 a2) s = value_eq (aval a1 s) (aval a2 s)" |
"gval (In v l) s = (case s v of None \<Rightarrow> invalid | Some vv \<Rightarrow> if vv \<in> set l then true else false)" |
"gval (Nor a1 a2) s = \<not>? ((gval a1 s) \<or>? (gval a2 s))"
text_raw\<open>\snip{connectives}{1}{2}{%\<close>
definition gNot :: "'a gexp \<Rightarrow> 'a gexp" where
"gNot g \<equiv> Nor g g"
definition gOr :: "'a gexp \<Rightarrow> 'a gexp \<Rightarrow> 'a gexp" (*infix "\<or>" 60*) where
"gOr v va \<equiv> Nor (Nor v va) (Nor v va)"
definition gAnd :: "'a gexp \<Rightarrow> 'a gexp \<Rightarrow> 'a gexp" (*infix "\<and>" 60*) where
"gAnd v va \<equiv> Nor (Nor v v) (Nor va va)"
definition gImplies :: "'a gexp \<Rightarrow> 'a gexp \<Rightarrow> 'a gexp" where
"gImplies p q \<equiv> gOr (gNot p) q"
definition Lt :: "'a aexp \<Rightarrow> 'a aexp \<Rightarrow> 'a gexp" (*infix "<" 60*) where
"Lt a b \<equiv> Gt b a"
definition Le :: "'a aexp \<Rightarrow> 'a aexp \<Rightarrow> 'a gexp" (*infix "\<le>" 60*) where
"Le v va \<equiv> gNot (Gt v va)"
definition Ge :: "'a aexp \<Rightarrow> 'a aexp \<Rightarrow> 'a gexp" (*infix "\<ge>" 60*) where
"Ge v va \<equiv> gNot (Lt v va)"
definition Ne :: "'a aexp \<Rightarrow> 'a aexp \<Rightarrow> 'a gexp" (*infix "\<noteq>" 60*) where
"Ne v va \<equiv> gNot (Eq v va)"
text_raw\<open>}%endsnip\<close>
lemma gval_Lt [simp]:
"gval (Lt a1 a2) s = value_gt (aval a2 s) (aval a1 s)"
by (simp add: Lt_def)
lemma gval_Le [simp]:
"gval (Le a1 a2) s = \<not>? (value_gt (aval a1 s) (aval a2 s))"
by (simp add: Le_def value_gt_def gNot_def maybe_or_idempotent)
lemma gval_Ge [simp]:
"gval (Ge a1 a2) s = \<not>? (value_gt (aval a2 s) (aval a1 s))"
by (simp add: Ge_def value_gt_def gNot_def maybe_or_idempotent)
lemma gval_Ne [simp]:
"gval (Ne a1 a2) s = \<not>? (value_eq (aval a1 s) (aval a2 s))"
by (simp add: Ne_def value_gt_def gNot_def maybe_or_idempotent)
lemmas connectives = gAnd_def gOr_def gNot_def Lt_def Le_def Ge_def Ne_def
lemma gval_gOr [simp]: "gval (gOr x y) r = (gval x r) \<or>? (gval y r)"
by (simp add: maybe_double_negation maybe_or_idempotent gOr_def)
lemma gval_gNot [simp]: "gval (gNot x) s = \<not>? (gval x s)"
by (simp add: maybe_or_idempotent gNot_def)
lemma gval_gAnd [simp]:
"gval (gAnd g1 g2) s = (gval g1 s) \<and>? (gval g2 s)"
by (simp add: de_morgans_1 maybe_double_negation maybe_or_idempotent gAnd_def)
lemma gAnd_commute: "gval (gAnd a b) s = gval (gAnd b a) s"
by (simp add: times_trilean_commutative)
lemma gOr_commute: "gval (gOr a b) s = gval (gOr b a) s"
by (simp add: plus_trilean_commutative gOr_def)
lemma gval_gAnd_True:
"(gval (gAnd g1 g2) s = true) = ((gval g1 s = true) \<and> gval g2 s = true)"
by (simp add: maybe_and_true)
lemma nor_equiv: "gval (gNot (gOr a b)) s = gval (Nor a b) s"
by simp
definition satisfiable :: "vname gexp \<Rightarrow> bool" where
"satisfiable g \<equiv> (\<exists>i r. gval g (join_ir i r) = true)"
definition "satisfiable_list l = satisfiable (fold gAnd l (Bc True))"
lemma unsatisfiable_false: "\<not> satisfiable (Bc False)"
by (simp add: satisfiable_def)
lemma satisfiable_true: "satisfiable (Bc True)"
by (simp add: satisfiable_def)
definition valid :: "vname gexp \<Rightarrow> bool" where
"valid g \<equiv> (\<forall>s. gval g s = true)"
lemma valid_true: "valid (Bc True)"
by (simp add: valid_def)
fun gexp_constrains :: "'a gexp \<Rightarrow> 'a aexp \<Rightarrow> bool" where
"gexp_constrains (Bc _) _ = False" |
"gexp_constrains (Eq a1 a2) a = (aexp_constrains a1 a \<or> aexp_constrains a2 a)" |
"gexp_constrains (Gt a1 a2) a = (aexp_constrains a1 a \<or> aexp_constrains a2 a)" |
"gexp_constrains (Nor g1 g2) a = (gexp_constrains g1 a \<or> gexp_constrains g2 a)" |
"gexp_constrains (In v l) a = aexp_constrains (V v) a"
fun contains_bool :: "'a gexp \<Rightarrow> bool" where
"contains_bool (Bc _) = True" |
"contains_bool (Nor g1 g2) = (contains_bool g1 \<or> contains_bool g2)" |
"contains_bool _ = False"
fun gexp_same_structure :: "'a gexp \<Rightarrow> 'a gexp \<Rightarrow> bool" where
"gexp_same_structure (Bc b) (Bc b') = (b = b')" |
"gexp_same_structure (Eq a1 a2) (Eq a1' a2') = (aexp_same_structure a1 a1' \<and> aexp_same_structure a2 a2')" |
"gexp_same_structure (Gt a1 a2) (Gt a1' a2') = (aexp_same_structure a1 a1' \<and> aexp_same_structure a2 a2')" |
"gexp_same_structure (Nor g1 g2) (Nor g1' g2') = (gexp_same_structure g1 g1' \<and> gexp_same_structure g2 g2')" |
"gexp_same_structure (In v l) (In v' l') = (v = v' \<and> l = l')" |
"gexp_same_structure _ _ = False"
lemma gval_foldr_true:
"(gval (foldr gAnd G (Bc True)) s = true) = (\<forall>g \<in> set G. gval g s = true)"
proof(induct G)
case (Cons a G)
then show ?case
apply (simp only: foldr.simps comp_def gval_gAnd maybe_and_true)
by simp
qed auto
fun enumerate_gexp_inputs :: "vname gexp \<Rightarrow> nat set" where
"enumerate_gexp_inputs (Bc _) = {}" |
"enumerate_gexp_inputs (Eq v va) = enumerate_aexp_inputs v \<union> enumerate_aexp_inputs va" |
"enumerate_gexp_inputs (Gt v va) = enumerate_aexp_inputs v \<union> enumerate_aexp_inputs va" |
"enumerate_gexp_inputs (In v va) = enumerate_aexp_inputs (V v)" |
"enumerate_gexp_inputs (Nor v va) = enumerate_gexp_inputs v \<union> enumerate_gexp_inputs va"
lemma enumerate_gexp_inputs_list: "\<exists>l. enumerate_gexp_inputs g = set l"
proof(induct g)
case (Eq x1a x2)
then show ?case
by (metis enumerate_aexp_inputs_list enumerate_gexp_inputs.simps(2) set_append)
next
case (Gt x1a x2)
then show ?case
by (metis enumerate_aexp_inputs_list enumerate_gexp_inputs.simps(3) set_append)
next
case (In x1a x2)
then show ?case
by (simp add: enumerate_aexp_inputs_list)
next
case (Nor g1 g2)
then show ?case
by (metis enumerate_gexp_inputs.simps(5) set_append)
qed auto
definition max_input :: "vname gexp \<Rightarrow> nat option" where
"max_input g = (let inputs = (enumerate_gexp_inputs g) in if inputs = {} then None else Some (Max inputs))"
definition max_input_list :: "vname gexp list \<Rightarrow> nat option" where
"max_input_list g = fold max (map (\<lambda>g. max_input g) g) None"
lemma max_input_list_cons:
"max_input_list (a # G) = max (max_input a) (max_input_list G)"
apply (simp add: max_input_list_def)
apply (cases "max_input a")
apply (simp add: max_def_raw)
by (metis (no_types, lifting) List.finite_set Max.insert Max.set_eq_fold fold_simps(1) list.set(2) max.assoc set_empty)
fun enumerate_regs :: "vname gexp \<Rightarrow> nat set" where
"enumerate_regs (Bc _) = {}" |
"enumerate_regs (Eq v va) = AExp.enumerate_regs v \<union> AExp.enumerate_regs va" |
"enumerate_regs (Gt v va) = AExp.enumerate_regs v \<union> AExp.enumerate_regs va" |
"enumerate_regs (In v va) = AExp.enumerate_regs (V v)" |
"enumerate_regs (Nor v va) = enumerate_regs v \<union> enumerate_regs va"
lemma finite_enumerate_regs: "finite (enumerate_regs g)"
using AExp.finite_enumerate_regs by (induct g, auto)
definition max_reg :: "vname gexp \<Rightarrow> nat option" where
"max_reg g = (let regs = (enumerate_regs g) in if regs = {} then None else Some (Max regs))"
lemma max_reg_gNot: "max_reg (gNot x) = max_reg x"
by (simp add: max_reg_def gNot_def)
lemma max_reg_Eq: "max_reg (Eq a b) = max (AExp.max_reg a) (AExp.max_reg b)"
apply (simp add: max_reg_def AExp.max_reg_def Let_def max_absorb2)
by (metis AExp.finite_enumerate_regs Max.union bot_option_def max_bot2 sup_Some sup_max)
lemma max_reg_Gt: "max_reg (Gt a b) = max (AExp.max_reg a) (AExp.max_reg b)"
apply (simp add: max_reg_def AExp.max_reg_def Let_def max_absorb2)
by (metis AExp.finite_enumerate_regs Max.union bot_option_def max_bot2 sup_Some sup_max)
lemma max_reg_Nor: "max_reg (Nor a b) = max (max_reg a) (max_reg b)"
apply (simp add: max_reg_def AExp.max_reg_def Let_def max_absorb2)
by (metis GExp.finite_enumerate_regs Max.union bot_option_def max_bot2 sup_Some sup_max)
lemma gval_In_cons:
"gval (In v (a # as)) s = (gval (Eq (V v) (L a)) s \<or>? gval (In v as) s)"
by (cases "s v", auto)
lemma possible_to_be_in: "s \<noteq> [] \<Longrightarrow> satisfiable (In v s)"
proof-
assume "s \<noteq> []"
have aux: "\<exists>v' i r. join_ir i r v = Some v' \<and> v' \<in> set s \<Longrightarrow>
\<exists>i r. (case join_ir i r v of None \<Rightarrow> false | Some v \<Rightarrow> if v \<in> set s then true else false) = true"
by (metis (mono_tags, lifting) option.simps(5))
show ?thesis
apply (simp add: satisfiable_def gval_In_cons)
apply (cases s)
apply (simp add: \<open>s \<noteq> []\<close>)
apply (cases v)
apply (case_tac "\<exists>(i::value list). length i > x1 \<and> i ! x1 = a")
apply clarsimp
subgoal for _ _ i by (rule exI[of _ i], intro exI, simp)
apply (metis gt_ex length_list_update length_repeat nth_list_update_eq)
apply (rule_tac exI)
apply (case_tac "\<exists>r. r $ x2 = Some a")
apply clarsimp
subgoal for _ _ _ r by (rule exI[of _ r], simp)
by (metis join_ir_R join_ir_double_exists)
qed
definition max_reg_list :: "vname gexp list \<Rightarrow> nat option" where
"max_reg_list g = (fold max (map (\<lambda>g. max_reg g) g) None)"
lemma max_reg_list_cons:
"max_reg_list (a # G) = max (max_reg a) (max_reg_list G)"
apply (simp add: max_reg_list_def)
by (metis (no_types, lifting) List.finite_set Max.insert Max.set_eq_fold fold.simps(1) id_apply list.simps(15) max.assoc set_empty)
lemma max_reg_list_append_singleton:
"max_reg_list (as@[bs]) = max (max_reg_list as) (max_reg_list [bs])"
apply (simp add: max_reg_list_def)
by (metis max.commute sup_None_2 sup_max)
lemma max_reg_list_append:
"max_reg_list (as@bs) = max (max_reg_list as) (max_reg_list bs)"
proof(induct bs rule: rev_induct)
case Nil
then show ?case
by (metis append_Nil2 fold_simps(1) list.simps(8) max_reg_list_def sup_None_2 sup_max)
next
case (snoc x xs)
then show ?case
by (metis append_assoc max.assoc max_reg_list_append_singleton)
qed
definition apply_guards :: "vname gexp list \<Rightarrow> vname datastate \<Rightarrow> bool" where
"apply_guards G s = (\<forall>g \<in> set (map (\<lambda>g. gval g s) G). g = true)"
lemma apply_guards_singleton[simp]: "(apply_guards [g] s) = (gval g s = true)"
by (simp add: apply_guards_def)
lemma apply_guards_empty [simp]: "apply_guards [] s"
by (simp add: apply_guards_def)
lemma apply_guards_cons:
"apply_guards (a # G) c = (gval a c = true \<and> apply_guards G c)"
by (simp add: apply_guards_def)
lemma apply_guards_double_cons:
"apply_guards (y # x # G) s = (gval (gAnd y x) s = true \<and> apply_guards G s)"
using apply_guards_cons gval_gAnd_True by blast
lemma apply_guards_append:
"apply_guards (a@a') s = (apply_guards a s \<and> apply_guards a' s)"
using apply_guards_def by auto
lemma apply_guards_foldr:
"apply_guards G s = (gval (foldr gAnd G (Bc True)) s = true)"
proof(induct G)
case Nil
then show ?case
by (simp add: apply_guards_def)
next
case (Cons a G)
then show ?case
by (metis apply_guards_cons foldr.simps(2) gval_gAnd_True o_apply)
qed
lemma rev_apply_guards: "apply_guards (rev G) s = apply_guards G s"
by (simp add: apply_guards_def)
lemma apply_guards_fold:
"apply_guards G s = (gval (fold gAnd G (Bc True)) s = true)"
using rev_apply_guards[symmetric]
by (simp add: foldr_conv_fold apply_guards_foldr)
lemma fold_apply_guards:
"(gval (fold gAnd G (Bc True)) s = true) = apply_guards G s"
by (simp add: apply_guards_fold)
lemma foldr_apply_guards:
"(gval (foldr gAnd G (Bc True)) s = true) = apply_guards G s"
by (simp add: apply_guards_foldr)
lemma apply_guards_subset:
"set g' \<subseteq> set g \<Longrightarrow> apply_guards g c \<longrightarrow> apply_guards g' c"
proof(induct g)
case (Cons a g)
then show ?case
using apply_guards_def by auto
qed auto
lemma apply_guards_subset_append:
"set G \<subseteq> set G' \<Longrightarrow> apply_guards (G @ G') s = apply_guards (G') s"
using apply_guards_append apply_guards_subset by blast
lemma apply_guards_rearrange:
"x \<in> set G \<Longrightarrow> apply_guards G s = apply_guards (x#G) s"
using apply_guards_def by auto
lemma apply_guards_condense: "\<exists>g. apply_guards G s = (gval g s = true)"
using apply_guards_fold by blast
lemma apply_guards_false_condense: "\<exists>g. (\<not>apply_guards G s) = (gval g s = false)"
using foldr_apply_guards gval.simps(2) not_true by blast
lemma max_input_Bc: "max_input (Bc x) = None"
by (simp add: max_input_def)
lemma max_input_Eq:
"max_input (Eq a1 a2) = max (AExp.max_input a1) (AExp.max_input a2)"
apply (simp add: AExp.max_input_def max_input_def Let_def max_absorb2)
by (metis List.finite_set Max.union bot_option_def enumerate_aexp_inputs_not_empty max_bot2 sup_Some sup_max)
lemma max_input_Gt:
"max_input (Gt a1 a2) = max (AExp.max_input a1) (AExp.max_input a2)"
apply (simp add: AExp.max_input_def max_input_def Let_def max_absorb2)
by (metis List.finite_set Max.union bot_option_def enumerate_aexp_inputs_not_empty max_bot2 sup_Some sup_max)
lemma gexp_max_input_Nor:
"max_input (Nor g1 g2) = max (max_input g1) (max_input g2)"
apply (simp add: AExp.max_input_def max_input_def Let_def max_absorb2)
by (metis List.finite_set Max.union enumerate_gexp_inputs_list less_eq_option_Some_None max_def sup_Some sup_max)
lemma gexp_max_input_In: "max_input (In v l) = AExp.max_input (V v)"
by (simp add: AExp.max_input_def GExp.max_input_def)
lemma gval_foldr_gOr_invalid:
"(gval (fold gOr l g) s = invalid) = (\<exists>g' \<in> (set (g#l)). gval g' s = invalid)"
proof(induct l rule: rev_induct)
case (snoc x xs)
then show ?case
by (simp, metis gval_gOr maybe_or_invalid)
qed auto
lemma gval_foldr_gOr_true:
"(gval (fold gOr l g) s = true) = ((\<exists>g' \<in> (set (g#l)). gval g' s = true) \<and> (\<forall>g' \<in> (set (g#l)). gval g' s \<noteq> invalid))"
proof(induct l rule: rev_induct)
case (snoc x xs)
then show ?case
apply (simp add: maybe_or_true)
using gval_foldr_gOr_invalid by auto
qed auto
lemma gval_foldr_gOr_false:
"(gval (fold gOr l g) s = false) = (\<forall>g' \<in> (set (g#l)). gval g' s = false)"
proof(induct l rule: rev_induct)
case (snoc x xs)
then show ?case
by (auto simp add: maybe_or_false)
qed auto
lemma gval_fold_gOr_rev: "gval (fold gOr (rev l) g) s = gval (fold gOr l g) s"
apply (cases "gval (fold gOr l g) s")
apply (simp, simp add: gval_foldr_gOr_true)
apply (simp, simp add: gval_foldr_gOr_false)
by (simp, simp add: gval_foldr_gOr_invalid)
lemma gval_fold_gOr_foldr: "gval (fold gOr l g) s = gval (foldr gOr l g) s"
by (simp add: foldr_conv_fold gval_fold_gOr_rev)
lemma gval_fold_gOr:
"gval (fold gOr (a # l) g) s = (gval a s \<or>? gval (fold gOr l g) s)"
by (simp only: gval_fold_gOr_foldr foldr.simps comp_def gval_gOr)
lemma gval_In_fold:
"gval (In v l) s = (if s v = None then invalid else gval (fold gOr (map (\<lambda>x. Eq (V v) (L x)) l) (Bc False)) s)"
proof(induct l)
case Nil
then show ?case
apply simp
apply (cases "s v")
apply simp
by auto
next
case (Cons a l)
then show ?case
apply (simp only: gval_In_cons)
apply (cases "s v")
apply simp
by (simp add: gval_fold_gOr del: fold.simps)
qed
fun fold_In :: "'a \<Rightarrow> value list \<Rightarrow> 'a gexp" where
"fold_In _ [] = Bc False" |
"fold_In v (l#t) = gOr (Eq (V v) (L l)) (fold_In v t)"
lemma gval_fold_In: "l \<noteq> [] \<Longrightarrow> gval (In v l) s = gval (fold_In v l) s"
proof(induct l)
next
case (Cons a l)
then show ?case
apply (case_tac "s v")
apply simp
apply simp
apply safe
apply simp
apply (metis fold_In.simps(1) gval.simps(2) plus_trilean.simps(4) plus_trilean.simps(5))
apply fastforce
apply fastforce
by fastforce
qed auto
lemma fold_maybe_or_invalid_base: "fold (\<or>?) l invalid = invalid"
proof(induct l)
case (Cons a l)
then show ?case
by (metis fold_simps(2) maybe_or_valid)
qed auto
lemma fold_maybe_or_true_base_never_false:
"fold (\<or>?) l true \<noteq> false"
proof(induct l)
case (Cons a l)
then show ?case
by (metis fold_maybe_or_invalid_base fold_simps(2) maybe_not.cases maybe_or_valid plus_trilean.simps(4) plus_trilean.simps(6))
qed auto
lemma fold_true_fold_false_not_invalid:
"fold (\<or>?) l true = true \<Longrightarrow>
fold (\<or>?) (rev l) false \<noteq> invalid"
proof(induct l)
case (Cons a l)
then show ?case
apply simp
by (metis fold_maybe_or_invalid_base maybe_or_invalid maybe_or_true)
qed auto
lemma fold_true_invalid_fold_rev_false_invalid:
"fold (\<or>?) l true = invalid \<Longrightarrow>
fold (\<or>?) (rev l) false = invalid"
proof(induct l)
case (Cons a l)
then show ?case
apply simp
by (metis maybe_or_true maybe_or_valid)
qed auto
lemma fold_maybe_or_rev:
"fold (\<or>?) l b = fold (\<or>?) (rev l) b"
proof(induct l)
case (Cons a l)
then show ?case
proof(induction a b rule: plus_trilean.induct)
case (1 uu)
then show ?case
by (simp add: fold_maybe_or_invalid_base)
next
case "2_1"