(*<*)
theory Monitor_Impl
  imports Monitor
    Optimized_MTL
    Event_Data
    "HOL-Library.Code_Target_Nat"
    Containers.Containers
begin
(*>*)

section \<open>Instantiation of the generic algorithm and code setup\<close>

lemma [code_unfold del, symmetric, code_post del]: "card \<equiv> Cardinality.card'" by simp
declare [[code drop: card]] Set_Impl.card_code[code]

instantiation enat :: set_impl begin
definition set_impl_enat :: "(enat, set_impl) phantom" where
  "set_impl_enat = phantom set_RBT"

instance ..
end

derive ccompare Formula.trm
derive (eq) ceq Formula.trm
derive (rbt) set_impl Formula.trm
derive (eq) ceq Monitor.mregex
derive ccompare Monitor.mregex
derive (rbt) set_impl Monitor.mregex
derive (rbt) mapping_impl Monitor.mregex
derive (no) cenum Monitor.mregex
derive (rbt) set_impl event_data
derive (rbt) mapping_impl event_data

definition add_new_mmuaux' :: "args \<Rightarrow> event_data table \<Rightarrow> event_data table \<Rightarrow> ts \<Rightarrow> event_data mmuaux \<Rightarrow>
  event_data mmuaux" where
  "add_new_mmuaux' = add_new_mmuaux"

interpretation muaux valid_mmuaux init_mmuaux add_new_mmuaux' length_mmuaux eval_mmuaux
  using valid_init_mmuaux valid_add_new_mmuaux valid_length_mmuaux valid_eval_mmuaux
  unfolding add_new_mmuaux'_def
  by unfold_locales assumption+

global_interpretation verimon_maux: maux "\<lambda>_ cur (t, aux) auxlist. t = cur \<and> aux = auxlist" "\<lambda>_. (0, [])"
  "\<lambda>args nt (t, auxlist). (nt, filter (\<lambda>(t, rel). enat (nt - t) \<le> right (args_ivl args)) auxlist)"
  "\<lambda>args rel1 (t, auxlist). (t, map (\<lambda>(t, rel). (t, join rel (args_pos args) rel1)) auxlist)"
  "\<lambda>args rel2 (cur, auxlist). (cur, (case auxlist of
    [] => [(cur, rel2)]
  | ((t, y) # ts) \<Rightarrow> if t = cur then (t, y \<union> rel2) # ts else (cur, rel2) # auxlist))"
  "\<lambda>args (cur, auxlist). foldr (\<union>) [rel. (t, rel) \<leftarrow> auxlist, left (args_ivl args) \<le> cur - t] {}"
  "\<lambda>_ cur (t, aux) auxlist. t = cur \<and> aux = auxlist" "\<lambda>_. (0, [])"
  "\<lambda>args rel1 rel2 nt (t, auxlist). (nt, update_until args rel1 rel2 nt auxlist)"
  "\<lambda>_ (_, auxlist). length auxlist"
  "\<lambda>args nt (t, auxlist). (let (res, auxlist') = eval_until (args_ivl args) nt auxlist in (res, (t, auxlist')))"
  by unfold_locales auto

global_interpretation default_maux: maux valid_mmsaux "init_mmsaux :: _ \<Rightarrow> event_data mmsaux" add_new_ts_mmsaux gc_join_mmsaux add_new_table_mmsaux result_mmsaux
  valid_mmuaux "init_mmuaux :: _ \<Rightarrow> event_data mmuaux" add_new_mmuaux' length_mmuaux eval_mmuaux
  defines minit0 = "maux.minit0 (init_mmsaux :: _ \<Rightarrow> event_data mmsaux) (init_mmuaux :: _ \<Rightarrow> event_data mmuaux) :: _ \<Rightarrow> Formula.formula \<Rightarrow> _"
  and minit = "maux.minit (init_mmsaux :: _ \<Rightarrow> event_data mmsaux) (init_mmuaux :: _ \<Rightarrow> event_data mmuaux) :: Formula.formula \<Rightarrow> _"
  and minit_safe = "maux.minit_safe (init_mmsaux :: _ \<Rightarrow> event_data mmsaux) (init_mmuaux :: _ \<Rightarrow> event_data mmuaux) :: Formula.formula \<Rightarrow> _"
  and update_since = "maux.update_since add_new_ts_mmsaux gc_join_mmsaux add_new_table_mmsaux (result_mmsaux :: _ \<Rightarrow> event_data mmsaux \<Rightarrow> event_data table)"
  and meval = "maux.meval add_new_ts_mmsaux gc_join_mmsaux add_new_table_mmsaux (result_mmsaux :: _ \<Rightarrow> event_data mmsaux \<Rightarrow> _) add_new_mmuaux' (eval_mmuaux :: _ \<Rightarrow> _ \<Rightarrow> event_data mmuaux \<Rightarrow> _)"
  and mstep = "maux.mstep add_new_ts_mmsaux gc_join_mmsaux add_new_table_mmsaux (result_mmsaux :: _ \<Rightarrow> event_data mmsaux \<Rightarrow> _) add_new_mmuaux' (eval_mmuaux :: _ \<Rightarrow> _ \<Rightarrow> event_data mmuaux \<Rightarrow> _)"
  and msteps0_stateless = "maux.msteps0_stateless add_new_ts_mmsaux gc_join_mmsaux add_new_table_mmsaux (result_mmsaux :: _ \<Rightarrow> event_data mmsaux \<Rightarrow> _) add_new_mmuaux' (eval_mmuaux :: _ \<Rightarrow> _ \<Rightarrow> event_data mmuaux \<Rightarrow> _)"
  and msteps_stateless = "maux.msteps_stateless add_new_ts_mmsaux gc_join_mmsaux add_new_table_mmsaux (result_mmsaux :: _ \<Rightarrow> event_data mmsaux \<Rightarrow> _) add_new_mmuaux' (eval_mmuaux :: _ \<Rightarrow> _ \<Rightarrow> event_data mmuaux \<Rightarrow> _)"
  and monitor = "maux.monitor init_mmsaux add_new_ts_mmsaux gc_join_mmsaux add_new_table_mmsaux (result_mmsaux :: _ \<Rightarrow> event_data mmsaux \<Rightarrow> _) init_mmuaux add_new_mmuaux' (eval_mmuaux :: _ \<Rightarrow> _ \<Rightarrow> event_data mmuaux \<Rightarrow> _)"
  by unfold_locales

lemma image_these: "f ` Option.these X = Option.these (map_option f ` X)"
  by (force simp: in_these_eq Bex_def image_iff map_option_case split: option.splits)

thm default_maux.meval.simps(2)

lemma meval_MPred: "meval n t db (MPred e ts) =
  (case Mapping.lookup db e of None \<Rightarrow> [{}] | Some Xs \<Rightarrow> map (\<lambda>X. \<Union>v \<in> X.
  (set_option (map_option (\<lambda>f. Table.tabulate f 0 n) (match ts v)))) Xs, MPred e ts)"
  by (force split: option.splits simp: Option.these_def image_iff)

lemmas meval_code[code] = default_maux.meval.simps(1) meval_MPred default_maux.meval.simps(3-)

definition mk_db :: "(Formula.name \<times> event_data list set) list \<Rightarrow> _" where
  "mk_db t = Monitor.mk_db (\<Union>n \<in> set (map fst t). (\<lambda>v. (n, v)) ` the (map_of t n))"

definition rbt_fold :: "_ \<Rightarrow> event_data tuple set_rbt \<Rightarrow> _ \<Rightarrow> _" where
  "rbt_fold = RBT_Set2.fold"

definition rbt_empty :: "event_data list set_rbt" where
  "rbt_empty = RBT_Set2.empty"

definition rbt_insert :: "_ \<Rightarrow> _ \<Rightarrow> event_data list set_rbt" where
  "rbt_insert = RBT_Set2.insert"

lemma saturate_commute:
  assumes "\<And>s. r \<in> g s" "\<And>s. g (insert r s) = g s" "\<And>s. r \<in> s \<Longrightarrow> h s = g s"
  and terminates: "mono g" "\<And>X. X \<subseteq> C \<Longrightarrow> g X \<subseteq> C" "finite C"
shows "saturate g {} = saturate h {r}"
proof (cases "g {} = {r}")
  case True
  with assms have "g {r} = {r}" "h {r} = {r}" by auto
  with True show ?thesis
    by (subst (1 2) saturate_code; subst saturate_code) (simp add: Let_def)
next
  case False
  then show ?thesis
    unfolding saturate_def while_def
    using while_option_finite_subset_Some[OF terminates] assms(1-3)
    by (subst while_option_commute_invariant[of "\<lambda>S. S = {} \<or> r \<in> S" "\<lambda>S. g S \<noteq> S" g "\<lambda>S. h S \<noteq> S" "insert r" h "{}", symmetric])
      (auto 4 4 dest: while_option_stop[of "\<lambda>S. g S \<noteq> S" g "{}"])
qed

definition "RPDs_aux = saturate (\<lambda>S. S \<union> \<Union> (RPD ` S))"

lemma RPDs_aux_code[code]:
  "RPDs_aux S = (let S' = S \<union> Set.bind S RPD in if S' \<subseteq> S then S else RPDs_aux S')"
  unfolding RPDs_aux_def bind_UNION
  by (subst saturate_code) auto

declare RPDs_code[code del]
lemma RPDs_code[code]: "RPDs r = RPDs_aux {r}"
  unfolding RPDs_aux_def RPDs_code
  by (rule saturate_commute[where C="RPDs r"])
     (auto 0 3 simp: mono_def subset_singleton_iff RPDs_refl RPDs_trans finite_RPDs)

definition "LPDs_aux = saturate (\<lambda>S. S \<union> \<Union> (LPD ` S))"

lemma LPDs_aux_code[code]:
  "LPDs_aux S = (let S' = S \<union> Set.bind S LPD in if S' \<subseteq> S then S else LPDs_aux S')"
  unfolding LPDs_aux_def bind_UNION
  by (subst saturate_code) auto

declare LPDs_code[code del]
lemma LPDs_code[code]: "LPDs r = LPDs_aux {r}"
  unfolding LPDs_aux_def LPDs_code
  by (rule saturate_commute[where C="LPDs r"])
     (auto 0 3 simp: mono_def subset_singleton_iff LPDs_refl LPDs_trans finite_LPDs)

lemma is_empty_table_unfold [code_unfold]:
  "X = empty_table \<longleftrightarrow> Set.is_empty X"
  "empty_table = X \<longleftrightarrow> Set.is_empty X"
  "Cardinality.eq_set X empty_table \<longleftrightarrow> Set.is_empty X"
  "Cardinality.eq_set empty_table X \<longleftrightarrow> Set.is_empty X"
  "set_eq X empty_table \<longleftrightarrow> Set.is_empty X"
  "set_eq empty_table X \<longleftrightarrow> Set.is_empty X"
  "X = (set_empty impl) \<longleftrightarrow> Set.is_empty X"
  "(set_empty impl) = X \<longleftrightarrow> Set.is_empty X"
  "Cardinality.eq_set X (set_empty impl) \<longleftrightarrow> Set.is_empty X"
  "Cardinality.eq_set (set_empty impl) X \<longleftrightarrow> Set.is_empty X"
  "set_eq X (set_empty impl) \<longleftrightarrow> Set.is_empty X"
  "set_eq (set_empty impl) X \<longleftrightarrow> Set.is_empty X"
  unfolding set_eq_def set_empty_def empty_table_def Set.is_empty_def Cardinality.eq_set_def by auto

lemma tabulate_rbt_code[code]: "Monitor.mrtabulate (xs :: mregex list) f =
  (case ID CCOMPARE(mregex) of None \<Rightarrow> Code.abort (STR ''tabulate RBT_Mapping: ccompare = None'') (\<lambda>_. Monitor.mrtabulate (xs :: mregex list) f)
  | _ \<Rightarrow> RBT_Mapping (RBT_Mapping2.bulkload (List.map_filter (\<lambda>k. let fk = f k in if fk = empty_table then None else Some (k, fk)) xs)))"
  unfolding mrtabulate.abs_eq RBT_Mapping_def
  by (auto split: option.splits)

lemma combine_Mapping[code]:
  fixes t :: "('a :: ccompare, 'b) mapping_rbt" shows
  "Mapping.combine f (RBT_Mapping t) (RBT_Mapping u) =
  (case ID CCOMPARE('a) of None \<Rightarrow> Code.abort (STR ''combine RBT_Mapping: ccompare = None'') (\<lambda>_. Mapping.combine f (RBT_Mapping t) (RBT_Mapping u))
                     | Some _ \<Rightarrow> RBT_Mapping (RBT_Mapping2.join (\<lambda>_. f) t u))"
  by (auto simp add: Mapping.combine.abs_eq Mapping_inject lookup_join split: option.split)

lemma upd_set_empty[simp]: "upd_set m f {} = m"
  by transfer auto

lemma upd_set_insert[simp]: "upd_set m f (insert x A) = Mapping.update x (f x) (upd_set m f A)"
  by (rule mapping_eqI) (auto simp: Mapping_lookup_upd_set Mapping.lookup_update')

lemma upd_set_fold:
  assumes "finite A"
  shows "upd_set m f A = Finite_Set.fold (\<lambda>a. Mapping.update a (f a)) m A"
proof -
  interpret comp_fun_idem "\<lambda>a. Mapping.update a (f a)"
    by unfold_locales (transfer; auto simp: fun_eq_iff)+
  from assms show ?thesis
    by (induct A arbitrary: m rule: finite.induct) auto
qed

lift_definition upd_cfi :: "('a \<Rightarrow> 'b) \<Rightarrow> ('a, ('a, 'b) mapping) comp_fun_idem"
  is "\<lambda>f a m. Mapping.update a (f a) m"
  by unfold_locales (transfer; auto simp: fun_eq_iff)+

lemma upd_set_code[code]:
  "upd_set m f A = (if finite A then set_fold_cfi (upd_cfi f) m A else Code.abort (STR ''upd_set: infinite'') (\<lambda>_. upd_set m f A))"
  by (transfer fixing: m) (auto simp: upd_set_fold)

lemma lexordp_eq_code[code]: "lexordp_eq xs ys \<longleftrightarrow> (case xs of [] \<Rightarrow> True
  | x # xs \<Rightarrow> (case ys of [] \<Rightarrow> False
    | y # ys \<Rightarrow> if x < y then True else if x > y then False else lexordp_eq xs ys))"
  by (subst lexordp_eq.simps) (auto split: list.split)

definition "filter_set m X t = Mapping.filter (filter_cond X m t) m"

declare [[code drop: shift_end]]
declare shift_end.simps[folded filter_set_def, code]

lemma upd_set'_empty[simp]: "upd_set' m d f {} = m"
  by (rule mapping_eqI) (auto simp add: upd_set'_lookup)

lemma upd_set'_insert: "d = f d \<Longrightarrow> (\<And>x. f (f x) = f x) \<Longrightarrow> upd_set' m d f (insert x A) =
  (let m' = (upd_set' m d f A) in case Mapping.lookup m' x of None \<Rightarrow> Mapping.update x d m'
  | Some v \<Rightarrow> Mapping.update x (f v) m')"
  by (rule mapping_eqI) (auto simp: upd_set'_lookup Mapping.lookup_update' split: option.splits)

lemma upd_set'_aux1: "upd_set' Mapping.empty d f {b. b = k \<or> (a, b) \<in> A} =
  Mapping.update k d (upd_set' Mapping.empty d f {b. (a, b) \<in> A})"
  by (rule mapping_eqI) (auto simp add: Let_def upd_set'_lookup Mapping.lookup_update'
      Mapping.lookup_empty split: option.splits)

lemma upd_set'_aux2: "Mapping.lookup m k = None \<Longrightarrow> upd_set' m d f {b. b = k \<or> (a, b) \<in> A} =
  Mapping.update k d (upd_set' m d f {b. (a, b) \<in> A})"
  by (rule mapping_eqI) (auto simp add: upd_set'_lookup Mapping.lookup_update' split: option.splits)

lemma upd_set'_aux3: "Mapping.lookup m k = Some v \<Longrightarrow> upd_set' m d f {b. b = k \<or> (a, b) \<in> A} =
  Mapping.update k (f v) (upd_set' m d f {b. (a, b) \<in> A})"
  by (rule mapping_eqI) (auto simp add: upd_set'_lookup Mapping.lookup_update' split: option.splits)

lemma upd_set'_aux4: "k \<notin> fst ` A \<Longrightarrow> upd_set' Mapping.empty d f {b. (k, b) \<in> A} = Mapping.empty"
  by (rule mapping_eqI) (auto simp add: upd_set'_lookup Mapping.lookup_update' Domain.DomainI fst_eq_Domain
      split: option.splits)

lemma upd_nested_empty[simp]: "upd_nested m d f {} = m"
  by (rule mapping_eqI) (auto simp add: upd_nested_lookup split: option.splits)

definition upd_nested_step :: "'c \<Rightarrow> ('c \<Rightarrow> 'c) \<Rightarrow> 'a \<times> 'b \<Rightarrow> ('a, ('b, 'c) mapping) mapping \<Rightarrow>
  ('a, ('b, 'c) mapping) mapping" where
  "upd_nested_step d f x m = (case x of (k, k') \<Rightarrow>
    (case Mapping.lookup m k of Some m' \<Rightarrow>
      (case Mapping.lookup m' k' of Some v \<Rightarrow> Mapping.update k (Mapping.update k' (f v) m') m
      | None \<Rightarrow> Mapping.update k (Mapping.update k' d m') m)
    | None \<Rightarrow> Mapping.update k (Mapping.update k' d Mapping.empty) m))"

lemma upd_nested_insert:
  "d = f d \<Longrightarrow> (\<And>x. f (f x) = f x) \<Longrightarrow> upd_nested m d f (insert x A) =
  upd_nested_step d f x (upd_nested m d f A)"
  unfolding upd_nested_step_def
  using upd_set'_aux1[of d f _ _ A] upd_set'_aux2[of _ _ d f _ A] upd_set'_aux3[of _ _ _ d f _ A]
    upd_set'_aux4[of _ A d f]
  by (auto simp add: Let_def upd_nested_lookup upd_set'_lookup Mapping.lookup_update'
      Mapping.lookup_empty split: option.splits prod.splits if_splits intro!: mapping_eqI)

definition upd_nested_max_tstp where
  "upd_nested_max_tstp m d X = upd_nested m d (max_tstp d) X"

lemma upd_nested_max_tstp_fold:
  assumes "finite X"
  shows "upd_nested_max_tstp m d X = Finite_Set.fold (upd_nested_step d (max_tstp d)) m X"
proof -
  interpret comp_fun_idem "upd_nested_step d (max_tstp d)"
    by (unfold_locales; rule ext)
      (auto simp add: comp_def upd_nested_step_def Mapping.lookup_update' Mapping.lookup_empty
       update_update max_tstp_d_d max_tstp_idem' split: option.splits)
  note upd_nested_insert' = upd_nested_insert[of d "max_tstp d",
    OF max_tstp_d_d[symmetric] max_tstp_idem']
  show ?thesis
    using assms
    by (induct X arbitrary: m rule: finite.induct)
       (auto simp add: upd_nested_max_tstp_def upd_nested_insert')
qed

lift_definition upd_nested_max_tstp_cfi ::
  "ts + tp \<Rightarrow> ('a \<times> 'b, ('a, ('b, ts + tp) mapping) mapping) comp_fun_idem"
  is "\<lambda>d. upd_nested_step d (max_tstp d)"
  by (unfold_locales; rule ext)
    (auto simp add: comp_def upd_nested_step_def Mapping.lookup_update' Mapping.lookup_empty
      update_update max_tstp_d_d max_tstp_idem' split: option.splits)

lemma upd_nested_max_tstp_code[code]:
  "upd_nested_max_tstp m d X = (if finite X then set_fold_cfi (upd_nested_max_tstp_cfi d) m X
    else Code.abort (STR ''upd_nested_max_tstp: infinite'') (\<lambda>_. upd_nested_max_tstp m d X))"
  by transfer (auto simp add: upd_nested_max_tstp_fold)

declare [[code drop: add_new_mmuaux']]
declare add_new_mmuaux'_def[unfolded add_new_mmuaux.simps, folded upd_nested_max_tstp_def, code]

lemma filter_set_empty[simp]: "filter_set m {} t = m"
  unfolding filter_set_def
  by transfer (auto simp: fun_eq_iff split: option.splits)

lemma filter_set_insert[simp]: "filter_set m (insert x A) t = (let m' = filter_set m A t in
  case Mapping.lookup m' x of Some u \<Rightarrow> if t = u then Mapping.delete x m' else m' | _ \<Rightarrow> m')"
  unfolding filter_set_def
  by transfer (auto simp: fun_eq_iff Let_def Map_To_Mapping.map_apply_def split: option.splits)

lemma filter_set_fold:
  assumes "finite A"
  shows "filter_set m A t = Finite_Set.fold (\<lambda>a m.
    case Mapping.lookup m a of Some u \<Rightarrow> if t = u then Mapping.delete a m else m | _ \<Rightarrow> m) m A"
proof -
  interpret comp_fun_idem "\<lambda>a m.
    case Mapping.lookup m a of Some u \<Rightarrow> if t = u then Mapping.delete a m else m | _ \<Rightarrow> m"
    by unfold_locales
      (transfer; auto simp: fun_eq_iff Map_To_Mapping.map_apply_def split: option.splits)+
  from assms show ?thesis
    by (induct A arbitrary: m rule: finite.induct) (auto simp: Let_def)
qed

lift_definition filter_cfi :: "'b \<Rightarrow> ('a, ('a, 'b) mapping) comp_fun_idem"
  is "\<lambda>t a m.
    case Mapping.lookup m a of Some u \<Rightarrow> if t = u then Mapping.delete a m else m | _ \<Rightarrow> m"
  by unfold_locales
    (transfer; auto simp: fun_eq_iff Map_To_Mapping.map_apply_def split: option.splits)+

lemma filter_set_code[code]:
  "filter_set m A t = (if finite A then set_fold_cfi (filter_cfi t) m A else Code.abort (STR ''upd_set: infinite'') (\<lambda>_. filter_set m A t))"
  by (transfer fixing: m) (auto simp: filter_set_fold)

lemma filter_Mapping[code]:
  fixes t :: "('a :: ccompare, 'b) mapping_rbt" shows
  "Mapping.filter P (RBT_Mapping t) =
  (case ID CCOMPARE('a) of None \<Rightarrow> Code.abort (STR ''filter RBT_Mapping: ccompare = None'') (\<lambda>_. Mapping.filter P (RBT_Mapping t))
                     | Some _ \<Rightarrow> RBT_Mapping (RBT_Mapping2.filter (case_prod P) t))"
  by (auto simp add: Mapping.filter.abs_eq Mapping_inject split: option.split)

definition "filter_join pos X m = Mapping.filter (join_filter_cond pos X) m"

declare [[code drop: join_mmsaux]]
declare join_mmsaux.simps[folded filter_join_def, code]

lemma filter_join_False_empty: "filter_join False {} m = m"
  unfolding filter_join_def
  by transfer (auto split: option.splits)

lemma filter_join_False_insert: "filter_join False (insert a A) m =
  filter_join False A (Mapping.delete a m)"
proof -
  {
    fix x
    have "Mapping.lookup (filter_join False (insert a A) m) x =
      Mapping.lookup (filter_join False A (Mapping.delete a m)) x"
      by (auto simp add: filter_join_def Mapping.lookup_filter Mapping_lookup_delete
          split: option.splits)
  }
  then show ?thesis
    by (simp add: mapping_eqI)
qed

lemma filter_join_False:
  assumes "finite A"
  shows "filter_join False A m = Finite_Set.fold Mapping.delete m A"
proof -
  interpret comp_fun_idem "Mapping.delete"
    by (unfold_locales; transfer) (fastforce simp add: comp_def)+
  from assms show ?thesis
    by (induction A arbitrary: m rule: finite.induct)
       (auto simp add: filter_join_False_empty filter_join_False_insert fold_fun_left_comm)
qed

lift_definition filter_not_in_cfi :: "('a, ('a, 'b) mapping) comp_fun_idem" is "Mapping.delete"
  by (unfold_locales; transfer) (fastforce simp add: comp_def)+

lemma filter_join_code[code]:
  "filter_join pos A m =
    (if \<not>pos \<and> finite A \<and> card A < Mapping.size m then set_fold_cfi filter_not_in_cfi m A
    else Mapping.filter (join_filter_cond pos A) m)"
  unfolding filter_join_def
  by (transfer fixing: m) (use filter_join_False in \<open>auto simp add: filter_join_def\<close>)

definition set_minus :: "'a set \<Rightarrow> 'a set \<Rightarrow> 'a set" where
  "set_minus X Y = X - Y"

lift_definition remove_cfi :: "('a, 'a set) comp_fun_idem"
  is "\<lambda>b a. a - {b}"
  by unfold_locales auto

lemma set_minus_finite:
  assumes fin: "finite Y"
  shows "set_minus X Y = Finite_Set.fold (\<lambda>a X. X - {a}) X Y"
proof -
  interpret comp_fun_idem "\<lambda>a X. X - {a}"
    by unfold_locales auto
  from assms show ?thesis
    by (induction Y arbitrary: X rule: finite.induct) (auto simp add: set_minus_def)
qed

lemma set_minus_code[code]: "set_minus X Y =
  (if finite Y \<and> card Y < card X then set_fold_cfi remove_cfi X Y else X - Y)"
  by transfer (use set_minus_finite in \<open>auto simp add: set_minus_def\<close>)

declare [[code drop: bin_join]]
declare bin_join.simps[folded set_minus_def, code]

definition remove_Union where
  "remove_Union A X B = A - (\<Union>x \<in> X. B x)"

lemma remove_Union_finite:
  assumes "finite X"
  shows "remove_Union A X B = Finite_Set.fold (\<lambda>x A. A - B x) A X"
proof -
  interpret comp_fun_idem "\<lambda>x A. A - B x"
    by unfold_locales auto
  from assms show ?thesis
    by (induct X arbitrary: A rule: finite_induct) (auto simp: remove_Union_def)
qed

lift_definition remove_Union_cfi :: "('a \<Rightarrow> 'b set) \<Rightarrow> ('a, 'b set) comp_fun_idem" is "\<lambda>B x A. A - B x"
  by unfold_locales auto

lemma remove_Union_code[code]: "remove_Union A X B =
  (if finite X then set_fold_cfi (remove_Union_cfi B) A X else A - (\<Union>x \<in> X. B x))"
  by (transfer fixing: A X B) (use remove_Union_finite[of X A B] in \<open>auto simp add: remove_Union_def\<close>)

lemma tabulate_remdups: "Mapping.tabulate xs f = Mapping.tabulate (remdups xs) f"
  by (transfer fixing: xs f) (auto simp: map_of_map_restrict)

lift_definition clearjunk :: "(char list \<times> event_data list set) list \<Rightarrow> (char list, event_data list set list) alist" is
  "\<lambda>t. List.map_filter (\<lambda>(p, X). if X = {} then None else Some (p, [X])) (AList.clearjunk t)"
  unfolding map_filter_def o_def list.map_comp
  by (subst map_cong[OF refl, of _ _ fst]) (auto simp: map_filter_def distinct_map_fst_filter split: if_splits)

lemma map_filter_snd_map_filter: "List.map_filter (\<lambda>(a, b). if P b then None else Some (f a b)) xs =
    map (\<lambda>(a, b). f a b) (filter (\<lambda>x. \<not> P (snd x)) xs)"
  by (simp add: map_filter_def prod.case_eq_if)

lemma mk_db_code_alist:
  "mk_db t = Assoc_List_Mapping (clearjunk t)"
  unfolding mk_db_def Assoc_List_Mapping_def
  by (transfer' fixing: t)
    (auto simp: map_filter_snd_map_filter fun_eq_iff map_of_map image_iff map_of_clearjunk
      map_of_filter_apply dest: weak_map_of_SomeI intro!: bexI[rotated, OF map_of_SomeD]
      split: if_splits option.splits)

lemma mk_db_code[code]:
  "mk_db t = Mapping.of_alist (List.map_filter (\<lambda>(p, X). if X = {} then None else Some (p, [X])) (AList.clearjunk t))"
  unfolding mk_db_def
  by (transfer' fixing: t) (auto simp: map_filter_snd_map_filter fun_eq_iff map_of_map image_iff
      map_of_clearjunk map_of_filter_apply dest: weak_map_of_SomeI intro!: bexI[rotated, OF map_of_SomeD]
      split: if_splits option.splits)

declare [[code drop: New_max_getIJ_genericJoin New_max_getIJ_wrapperGenericJoin]]
declare New_max.genericJoin.simps[folded remove_Union_def, code]
declare New_max.wrapperGenericJoin.simps[folded remove_Union_def, code]

(*<*)
end
(*>*)


theory Proof_2_6
  imports Requirements VCTheoryLemmas
begin

theorem proof_2_6: "VC6 inv2 s0 requestButtonValue"
  apply(simp only: VC6_def inv2_def  R2_def extraInv_def)
proof
  print_state
  assume " ((toEnvP s0 \<and>
      (\<forall>s1 s2 s3.
          substate s1 s2 \<and>
          substate s2 s3 \<and>
          substate s3 s0 \<and>
          toEnvP s1 \<and>
          toEnvP s2 \<and>
          toEnvP s3 \<and>
          toEnvNum s1 s2 = Ctrl \<and> toEnvNum s2 s3 < T2 \<and> getVarBool s1 minimalRed \<noteq> PRESSED \<and> getVarBool s2 minimalRed = PRESSED \<longrightarrow>
          getVarBool s3 minimalRed = PRESSED)) \<and>
     toEnvP s0 \<and>
     (\<forall>s1. toEnvP s1 \<and> substate s1 s0 \<and> getPstate s1 Ctrl = minimalRed \<longrightarrow> 0 < ltimeEnv s1 Ctrl \<and> ltimeEnv s1 Ctrl \<le> MINIMAL_RED_TIME_LIMIT) \<and>
     (\<forall>s1. toEnvP s1 \<and> substate s1 s0 \<and> getPstate s1 Ctrl = minimalRed \<longrightarrow>
           (\<exists>s2. toEnvP s2 \<and> substate s2 s1 \<and> toEnvNum s2 s1 = ltimeEnv s1 Ctrl \<and> getPstate s2 Ctrl = green \<and> ltimeEnv s2 Ctrl = T2) \<or>
           (\<forall>s2. toEnvP s2 \<and> substate s2 s1 \<longrightarrow> getPstate s2 Ctrl = minimalRed)) \<and>
     (\<forall>s1 s2.
         toEnvP s1 \<and> toEnvP s2 \<and> substate s1 s2 \<and> substate s2 s0 \<and> getPstate s2 Ctrl = minimalRed \<and> toEnvNum s1 s2 < ltimeEnv s2 Ctrl \<longrightarrow>
         getPstate s1 Ctrl = minimalRed) \<and>
     (\<forall>s1 s2.
         toEnvP s1 \<and>
         toEnvP s2 \<and>
         substate s1 s2 \<and> substate s2 s0 \<and> (\<forall>s3. toEnvP s3 \<and> substate s1 s3 \<and> substate s3 s2 \<longrightarrow> getPstate s3 Ctrl = minimalRed) \<longrightarrow>
         toEnvNum s1 s2 = ltimeEnv s2 Ctrl - ltimeEnv s1 Ctrl) \<and>
     (\<forall>s1. toEnvP s1 \<and> substate s1 s0 \<and> getPstate s1 Ctrl = redAfterMinimalRed \<and> getVarBool s1 redAfterMinimalRed = NOT_PRESSED \<longrightarrow>
           (\<exists>s2. toEnvP s2 \<and>
                 substate s2 s1 \<and>
                 getPstate s2 Ctrl = minimalRed \<and>
                 ltimeEnv s2 Ctrl = MINIMAL_RED_TIME_LIMIT \<and>
                 getVarBool s2 redAfterMinimalRed = NOT_PRESSED \<and>
                 (\<forall>s3. toEnvP s3 \<and> substate s2 s3 \<and> substate s3 s1 \<and> s2 \<noteq> s3 \<longrightarrow>
                       getPstate s3 Ctrl = redAfterMinimalRed \<and>
                       getVarBool s3 redAfterMinimalRed = NOT_PRESSED \<and> getVarBool s3 Ctrl = NOT_PRESSED))) \<and>
     (\<forall>s1. toEnvP s1 \<and> substate s1 s0 \<and> getPstate s1 Ctrl = redToGreen \<longrightarrow>
           0 < ltimeEnv s1 Ctrl \<and> ltimeEnv s1 Ctrl \<le> RED_TO_GREEN_TIME_LIMIT) \<and>
     (\<forall>s1. toEnvP s1 \<and> substate s1 s0 \<and> getPstate s1 Ctrl = redToGreen \<longrightarrow>
           (\<exists>s2. toEnvP s2 \<and>
                 substate s2 s1 \<and>
                 toEnvNum s2 s1 = ltimeEnv s1 Ctrl \<and>
                 getPstate s2 Ctrl = redAfterMinimalRed \<and> (getVarBool s2 redAfterMinimalRed = PRESSED \<or> getVarBool s2 Ctrl = PRESSED))) \<and>
     (\<forall>s1 s2.
         toEnvP s1 \<and> toEnvP s2 \<and> substate s1 s2 \<and> substate s2 s0 \<and> toEnvNum s1 s2 < ltimeEnv s2 Ctrl \<and> getPstate s2 Ctrl = redToGreen \<longrightarrow>
         getPstate s1 Ctrl = redToGreen) \<and>
     (\<forall>s1 s2.
         toEnvP s1 \<and>
         toEnvP s2 \<and>
         substate s1 s2 \<and> substate s2 s0 \<and> (\<forall>s3. toEnvP s3 \<and> substate s1 s3 \<and> substate s3 s2 \<longrightarrow> getPstate s3 Ctrl = redToGreen) \<longrightarrow>
         toEnvNum s1 s2 = ltimeEnv s2 Ctrl - ltimeEnv s1 Ctrl) \<and>
     (\<forall>s1. toEnvP s1 \<and> substate s1 s0 \<and> getPstate s1 Ctrl = green \<longrightarrow> 0 < ltimeEnv s1 Ctrl \<and> ltimeEnv s1 Ctrl \<le> T2) \<and>
     (\<forall>s1. toEnvP s1 \<and> substate s1 s0 \<and> getPstate s1 Ctrl = green \<longrightarrow>
           (\<exists>s2. toEnvP s2 \<and>
                 substate s2 s1 \<and>
                 toEnvNum s2 s1 = ltimeEnv s1 Ctrl \<and> getPstate s2 Ctrl = redToGreen \<and> ltimeEnv s2 Ctrl = RED_TO_GREEN_TIME_LIMIT)) \<and>
     (\<forall>s1 s2.
         toEnvP s1 \<and> toEnvP s2 \<and> substate s1 s2 \<and> substate s2 s0 \<and> getPstate s2 Ctrl = green \<and> toEnvNum s1 s2 < ltimeEnv s2 Ctrl \<longrightarrow>
         getPstate s1 Ctrl = green) \<and>
     (\<forall>s1 s2.
         toEnvP s1 \<and>
         toEnvP s2 \<and> substate s1 s2 \<and> substate s2 s0 \<and> (\<forall>s3. toEnvP s3 \<and> substate s1 s3 \<and> substate s3 s2 \<longrightarrow> getPstate s3 Ctrl = green) \<longrightarrow>
         toEnvNum s1 s2 = ltimeEnv s2 Ctrl - ltimeEnv s1 Ctrl) \<and>
     (\<forall>s1. toEnvP s1 \<and> substate s1 s0 \<and> getPstate s1 Ctrl = green \<longrightarrow> getVarBool s1 minimalRed = PRESSED) \<and>
     (\<forall>s1. toEnvP s1 \<and> substate s1 s0 \<and> getPstate s1 Ctrl \<noteq> green \<longrightarrow> getVarBool s1 minimalRed = NOT_PRESSED) \<and>
     (\<forall>s1. toEnvP s1 \<and> substate s1 s0 \<longrightarrow>
           getPstate s1 Ctrl = minimalRed \<or>
           getPstate s1 Ctrl = redAfterMinimalRed \<or> getPstate s1 Ctrl = redToGreen \<or> getPstate s1 Ctrl = green) \<and>
     (\<forall>s1 s2.
         toEnvP s1 \<and>
         toEnvP s2 \<and>
         substate s1 s2 \<and>
         substate s2 s0 \<and>
         toEnvNum s1 s2 < ltimeEnv s2 Ctrl - Ctrl \<and> getPstate s2 Ctrl = minimalRed \<and> getVarBool s2 redAfterMinimalRed = NOT_PRESSED \<longrightarrow>
         getVarBool s1 Ctrl = NOT_PRESSED) \<and>
     (\<forall>s2. toEnvP s2 \<and> substate s2 s0 \<and> getPstate s2 Ctrl = minimalRed \<and> getVarBool s2 redAfterMinimalRed = PRESSED \<longrightarrow>
           (\<exists>s1. toEnvP s1 \<and> substate s1 s2 \<and> toEnvNum s1 s2 < ltimeEnv s2 Ctrl - Ctrl \<and> getVarBool s1 Ctrl = PRESSED)) \<and>
     (\<forall>s1. toEnvP s1 \<and> substate s1 s0 \<and> getPstate s1 Ctrl = redAfterMinimalRed \<and> getVarBool s1 redAfterMinimalRed \<longrightarrow>
           (\<exists>s2. toEnvP s2 \<and>
                 substate s2 s1 \<and>
                 toEnvNum s2 s1 = Ctrl \<and>
                 getPstate s2 Ctrl = minimalRed \<and>
                 ltimeEnv s2 Ctrl = MINIMAL_RED_TIME_LIMIT \<and> (getVarBool s2 redAfterMinimalRed \<or> getVarBool s1 Ctrl = PRESSED))) \<and>
     (\<forall>s1. toEnvP s1 \<and> substate s1 s0 \<and> getPstate s1 Ctrl = green \<longrightarrow> getVarBool s1 redAfterMinimalRed = NOT_PRESSED)) \<and>
    env (setVarAny s0 requestButtonValue) requestButtonValue \<and>
    getPstate (setVarAny s0 requestButtonValue) Ctrl = redAfterMinimalRed \<and>
    (getVarBool (setVarAny s0 requestButtonValue) redAfterMinimalRed \<or> getVarBool (setVarAny s0 requestButtonValue) Ctrl)"
  then obtain reqs0: "(toEnvP s0 \<and>
      (\<forall>s1 s2 s3.
          substate s1 s2 \<and>
          substate s2 s3 \<and>
          substate s3 s0 \<and>
          toEnvP s1 \<and>
          toEnvP s2 \<and>
          toEnvP s3 \<and>
          toEnvNum s1 s2 = Ctrl \<and>
          toEnvNum s2 s3 < T2 \<and> getVarBool s1 minimalRed \<noteq> PRESSED \<and> getVarBool s2 minimalRed = PRESSED \<longrightarrow>
          getVarBool s3 minimalRed = PRESSED))"
and ei0: "toEnvP s0"
and ei1: "(\<forall> s1. toEnvP s1 \<and> substate s1 s0 \<and> getPstate s1 Ctrl = minimalRed \<longrightarrow>
 0<ltimeEnv s1 Ctrl \<and>  ltimeEnv s1 Ctrl \<le> MINIMAL_RED_TIME_LIMIT) "
and ei2: "(\<forall> s1. toEnvP s1 \<and> substate s1 s0 \<and> getPstate s1 Ctrl = minimalRed \<longrightarrow>
 ((\<exists> s2. toEnvP s2 \<and> substate s2 s1 \<and> toEnvNum s2 s1 = ltimeEnv s1 Ctrl  \<and>
 getPstate s2 Ctrl = green \<and> ltimeEnv s2 Ctrl = GREEN_TIME_LIMIT) \<or>
 (\<forall> s2. toEnvP s2 \<and> substate s2 s1 \<longrightarrow> getPstate s2 Ctrl = minimalRed))) "
and ei3: "(\<forall> s1 s2. toEnvP s1 \<and> toEnvP s2 \<and> substate s1 s2 \<and> substate s2 s0 \<and> getPstate s2 Ctrl = minimalRed \<and>
 toEnvNum s1 s2 < ltimeEnv s2 Ctrl \<longrightarrow> getPstate s1 Ctrl = minimalRed) "
and ei4: "\<forall> s1 s2. toEnvP s1 \<and> toEnvP s2 \<and> substate s1 s2 \<and> substate s2 s0 \<and>
(\<forall> s3. toEnvP s3 \<and> substate s1 s3 \<and> substate s3 s2 \<longrightarrow> getPstate s3 Ctrl = minimalRed ) \<longrightarrow>
toEnvNum s1 s2 = ltimeEnv s2 Ctrl - ltimeEnv s1 Ctrl"
and ei5: "\<forall> s1 . toEnvP s1 \<and> substate s1 s0 \<and> getPstate s1 Ctrl = redAfterMinimalRed \<and>
 getVarBool s1 requestButtonPressed = False \<longrightarrow>
(\<exists> s2. toEnvP s2 \<and> substate s2 s1 \<and> getPstate s2 Ctrl = minimalRed \<and> ltimeEnv s2 Ctrl = MINIMAL_RED_TIME_LIMIT \<and>
getVarBool s2 requestButtonPressed = False \<and> (\<forall> s3. toEnvP s3 \<and> substate s2 s3 \<and> substate s3 s1 \<and> s2 \<noteq> s3 \<longrightarrow>
 getPstate s3 Ctrl = redAfterMinimalRed \<and>
getVarBool s3 requestButtonPressed = False \<and> getVarBool s3  requestButton = NOT_PRESSED))"
and ei6: "(\<forall> s1. toEnvP s1 \<and> substate s1 s0 \<and> getPstate s1 Ctrl = redToGreen \<longrightarrow>
0< ltimeEnv s1 Ctrl \<and> ltimeEnv s1 Ctrl \<le> RED_TO_GREEN_TIME_LIMIT) "
and ei7: "(\<forall> s1. toEnvP s1 \<and> substate s1 s0 \<and> getPstate s1 Ctrl = redToGreen \<longrightarrow>
(\<exists> s2. toEnvP s2  \<and> substate s2 s1 \<and>
 toEnvNum s2 s1 = ltimeEnv s1 Ctrl  \<and> getPstate s2 Ctrl = redAfterMinimalRed \<and>
(getVarBool s2 requestButtonPressed = True \<or> getVarBool s2 requestButton = PRESSED)))"
and ei8: "(\<forall> s1 s2. toEnvP s1 \<and> toEnvP s2 \<and> substate s1 s2 \<and> substate s2 s0 \<and> toEnvNum s1 s2 < ltimeEnv s2 Ctrl \<and>
 getPstate s2 Ctrl = redToGreen \<longrightarrow> getPstate s1 Ctrl = redToGreen) "
and ei9: "(\<forall> s1 s2. toEnvP s1 \<and> toEnvP s2 \<and> substate s1 s2 \<and> substate s2 s0 \<and>
(\<forall> s3. toEnvP s3 \<and> substate s1 s3 \<and> substate s3 s2 \<longrightarrow> getPstate s3 Ctrl = redToGreen) \<longrightarrow>
toEnvNum s1 s2 = ltimeEnv s2 Ctrl - ltimeEnv s1 Ctrl) "
and ei10: "(\<forall> s1. toEnvP s1 \<and> substate s1 s0 \<and> getPstate s1 Ctrl = green \<longrightarrow>
0 < ltimeEnv s1 Ctrl \<and> ltimeEnv s1 Ctrl \<le> GREEN_TIME_LIMIT)"
and ei11: "(\<forall> s1. toEnvP s1 \<and> substate s1 s0 \<and> getPstate s1 Ctrl = green \<longrightarrow>
(\<exists> s2. toEnvP s2 \<and> substate s2 s1 \<and> toEnvNum s2 s1 = ltimeEnv s1 Ctrl \<and>
getPstate s2 Ctrl = redToGreen \<and> ltimeEnv s2 Ctrl = RED_TO_GREEN_TIME_LIMIT)) "
and ei12: "(\<forall> s1 s2. toEnvP s1 \<and> toEnvP s2 \<and> substate s1 s2 \<and> substate s2 s0 \<and> getPstate s2 Ctrl = green \<and>
toEnvNum s1 s2 < ltimeEnv s2 Ctrl \<longrightarrow> getPstate s1 Ctrl = green)"
and ei13: "(\<forall> s1 s2. toEnvP s1 \<and> toEnvP s2 \<and> substate s1 s2 \<and> substate s2 s0 \<and>
(\<forall> s3. toEnvP s3 \<and> substate s1 s3 \<and> substate s3 s2 \<longrightarrow> getPstate s3 Ctrl = green) \<longrightarrow>
toEnvNum s1 s2 = ltimeEnv s2 Ctrl - ltimeEnv s1 Ctrl) "
and ei14: "(\<forall> s1. toEnvP s1 \<and> substate s1 s0 \<and> getPstate s1 Ctrl = green \<longrightarrow> getVarBool s1 trafficLight = GREEN) "
and ei15: "(\<forall> s1. toEnvP s1 \<and> substate s1 s0 \<and> getPstate s1 Ctrl \<noteq> green \<longrightarrow> getVarBool s1 trafficLight = RED) "
and ei16: "(\<forall> s1. toEnvP s1 \<and> substate s1 s0 \<longrightarrow>
 getPstate s1 Ctrl = minimalRed \<or> getPstate s1 Ctrl = redAfterMinimalRed \<or>
 getPstate s1 Ctrl = redToGreen \<or> getPstate s1 Ctrl = green)"
and ei17: "(\<forall> s1 s2. toEnvP s1 \<and> toEnvP s2 \<and> substate s1 s2 \<and> substate s2 s0 \<and>
 toEnvNum s1 s2 < ltimeEnv s2 Ctrl - 1 \<and>  getPstate s2 Ctrl = minimalRed \<and>
 getVarBool s2 requestButtonPressed = False \<longrightarrow> getVarBool s1 requestButton = NOT_PRESSED)"
and ei18: "(\<forall> s2. toEnvP s2  \<and> substate s2 s0  \<and>
 getPstate s2 Ctrl = minimalRed \<and> getVarBool s2 requestButtonPressed = True \<longrightarrow>
(\<exists> s1. toEnvP s1 \<and> substate s1 s2 \<and> toEnvNum s1 s2 < ltimeEnv s2 Ctrl - 1 \<and> getVarBool s1 requestButton = PRESSED))"
and ei19: "(\<forall> s1. toEnvP s1 \<and> substate s1 s0 \<and> getPstate s1 Ctrl = redAfterMinimalRed \<and> getVarBool s1 requestButtonPressed \<longrightarrow>
(\<exists> s2. toEnvP s2 \<and> substate s2 s1 \<and> toEnvNum s2 s1 = 1 \<and> getPstate s2 Ctrl = minimalRed \<and>
 ltimeEnv s2 Ctrl = MINIMAL_RED_TIME_LIMIT \<and>
 (getVarBool s2 requestButtonPressed \<or> getVarBool s1 requestButton = PRESSED)))"
and ei20: "(\<forall> s1. toEnvP s1 \<and> substate s1 s0 \<and> getPstate s1 Ctrl = green \<longrightarrow> getVarBool s1 requestButtonPressed = False)"
and vc: "env (setVarAny s0 requestButtonValue) requestButtonValue \<and>
    getPstate (setVarAny s0 requestButtonValue) Ctrl = redAfterMinimalRed \<and>
    (getVarBool (setVarAny s0 requestButtonValue) redAfterMinimalRed \<or> getVarBool (setVarAny s0 requestButtonValue) Ctrl)"
    by fast
  show " (toEnvP (toEnv (setPstate (setVarAny s0 requestButtonValue) Ctrl redToGreen)) \<and>
     (\<forall>s1 s2 s3.
         substate s1 s2 \<and>
         substate s2 s3 \<and>
         substate s3 (toEnv (setPstate (setVarAny s0 requestButtonValue) Ctrl redToGreen)) \<and>
         toEnvP s1 \<and>
         toEnvP s2 \<and>
         toEnvP s3 \<and> toEnvNum s1 s2 = Ctrl \<and> toEnvNum s2 s3 < T2 \<and> getVarBool s1 minimalRed \<noteq> PRESSED \<and> getVarBool s2 minimalRed = PRESSED \<longrightarrow>
         getVarBool s3 minimalRed = PRESSED)) \<and>
    toEnvP (toEnv (setPstate (setVarAny s0 requestButtonValue) Ctrl redToGreen)) \<and>
    (\<forall>s1. toEnvP s1 \<and> substate s1 (toEnv (setPstate (setVarAny s0 requestButtonValue) Ctrl redToGreen)) \<and> getPstate s1 Ctrl = minimalRed \<longrightarrow>
          0 < ltimeEnv s1 Ctrl \<and> ltimeEnv s1 Ctrl \<le> MINIMAL_RED_TIME_LIMIT) \<and>
    (\<forall>s1. toEnvP s1 \<and> substate s1 (toEnv (setPstate (setVarAny s0 requestButtonValue) Ctrl redToGreen)) \<and> getPstate s1 Ctrl = minimalRed \<longrightarrow>
          (\<exists>s2. toEnvP s2 \<and> substate s2 s1 \<and> toEnvNum s2 s1 = ltimeEnv s1 Ctrl \<and> getPstate s2 Ctrl = green \<and> ltimeEnv s2 Ctrl = T2) \<or>
          (\<forall>s2. toEnvP s2 \<and> substate s2 s1 \<longrightarrow> getPstate s2 Ctrl = minimalRed)) \<and>
    (\<forall>s1 s2.
        toEnvP s1 \<and>
        toEnvP s2 \<and>
        substate s1 s2 \<and>
        substate s2 (toEnv (setPstate (setVarAny s0 requestButtonValue) Ctrl redToGreen)) \<and>
        getPstate s2 Ctrl = minimalRed \<and> toEnvNum s1 s2 < ltimeEnv s2 Ctrl \<longrightarrow>
        getPstate s1 Ctrl = minimalRed) \<and>
    (\<forall>s1 s2.
        toEnvP s1 \<and>
        toEnvP s2 \<and>
        substate s1 s2 \<and>
        substate s2 (toEnv (setPstate (setVarAny s0 requestButtonValue) Ctrl redToGreen)) \<and>
        (\<forall>s3. toEnvP s3 \<and> substate s1 s3 \<and> substate s3 s2 \<longrightarrow> getPstate s3 Ctrl = minimalRed) \<longrightarrow>
        toEnvNum s1 s2 = ltimeEnv s2 Ctrl - ltimeEnv s1 Ctrl) \<and>
    (\<forall>s1. toEnvP s1 \<and>
          substate s1 (toEnv (setPstate (setVarAny s0 requestButtonValue) Ctrl redToGreen)) \<and>
          getPstate s1 Ctrl = redAfterMinimalRed \<and> getVarBool s1 redAfterMinimalRed = NOT_PRESSED \<longrightarrow>
          (\<exists>s2. toEnvP s2 \<and>
                substate s2 s1 \<and>
                getPstate s2 Ctrl = minimalRed \<and>
                ltimeEnv s2 Ctrl = MINIMAL_RED_TIME_LIMIT \<and>
                getVarBool s2 redAfterMinimalRed = NOT_PRESSED \<and>
                (\<forall>s3. toEnvP s3 \<and> substate s2 s3 \<and> substate s3 s1 \<and> s2 \<noteq> s3 \<longrightarrow>
                      getPstate s3 Ctrl = redAfterMinimalRed \<and>
                      getVarBool s3 redAfterMinimalRed = NOT_PRESSED \<and> getVarBool s3 Ctrl = NOT_PRESSED))) \<and>
    (\<forall>s1. toEnvP s1 \<and> substate s1 (toEnv (setPstate (setVarAny s0 requestButtonValue) Ctrl redToGreen)) \<and> getPstate s1 Ctrl = redToGreen \<longrightarrow>
          0 < ltimeEnv s1 Ctrl \<and> ltimeEnv s1 Ctrl \<le> RED_TO_GREEN_TIME_LIMIT) \<and>
    (\<forall>s1. toEnvP s1 \<and> substate s1 (toEnv (setPstate (setVarAny s0 requestButtonValue) Ctrl redToGreen)) \<and> getPstate s1 Ctrl = redToGreen \<longrightarrow>
          (\<exists>s2. toEnvP s2 \<and>
                substate s2 s1 \<and>
                toEnvNum s2 s1 = ltimeEnv s1 Ctrl \<and>
                getPstate s2 Ctrl = redAfterMinimalRed \<and> (getVarBool s2 redAfterMinimalRed = PRESSED \<or> getVarBool s2 Ctrl = PRESSED))) \<and>
    (\<forall>s1 s2.
        toEnvP s1 \<and>
        toEnvP s2 \<and>
        substate s1 s2 \<and>
        substate s2 (toEnv (setPstate (setVarAny s0 requestButtonValue) Ctrl redToGreen)) \<and>
        toEnvNum s1 s2 < ltimeEnv s2 Ctrl \<and> getPstate s2 Ctrl = redToGreen \<longrightarrow>
        getPstate s1 Ctrl = redToGreen) \<and>
    (\<forall>s1 s2.
        toEnvP s1 \<and>
        toEnvP s2 \<and>
        substate s1 s2 \<and>
        substate s2 (toEnv (setPstate (setVarAny s0 requestButtonValue) Ctrl redToGreen)) \<and>
        (\<forall>s3. toEnvP s3 \<and> substate s1 s3 \<and> substate s3 s2 \<longrightarrow> getPstate s3 Ctrl = redToGreen) \<longrightarrow>
        toEnvNum s1 s2 = ltimeEnv s2 Ctrl - ltimeEnv s1 Ctrl) \<and>
    (\<forall>s1. toEnvP s1 \<and> substate s1 (toEnv (setPstate (setVarAny s0 requestButtonValue) Ctrl redToGreen)) \<and> getPstate s1 Ctrl = green \<longrightarrow>
          0 < ltimeEnv s1 Ctrl \<and> ltimeEnv s1 Ctrl \<le> T2) \<and>
    (\<forall>s1. toEnvP s1 \<and> substate s1 (toEnv (setPstate (setVarAny s0 requestButtonValue) Ctrl redToGreen)) \<and> getPstate s1 Ctrl = green \<longrightarrow>
          (\<exists>s2. toEnvP s2 \<and>
                substate s2 s1 \<and>
                toEnvNum s2 s1 = ltimeEnv s1 Ctrl \<and> getPstate s2 Ctrl = redToGreen \<and> ltimeEnv s2 Ctrl = RED_TO_GREEN_TIME_LIMIT)) \<and>
    (\<forall>s1 s2.
        toEnvP s1 \<and>
        toEnvP s2 \<and>
        substate s1 s2 \<and>
        substate s2 (toEnv (setPstate (setVarAny s0 requestButtonValue) Ctrl redToGreen)) \<and>
        getPstate s2 Ctrl = green \<and> toEnvNum s1 s2 < ltimeEnv s2 Ctrl \<longrightarrow>
        getPstate s1 Ctrl = green) \<and>
    (\<forall>s1 s2.
        toEnvP s1 \<and>
        toEnvP s2 \<and>
        substate s1 s2 \<and>
        substate s2 (toEnv (setPstate (setVarAny s0 requestButtonValue) Ctrl redToGreen)) \<and>
        (\<forall>s3. toEnvP s3 \<and> substate s1 s3 \<and> substate s3 s2 \<longrightarrow> getPstate s3 Ctrl = green) \<longrightarrow>
        toEnvNum s1 s2 = ltimeEnv s2 Ctrl - ltimeEnv s1 Ctrl) \<and>
    (\<forall>s1. toEnvP s1 \<and> substate s1 (toEnv (setPstate (setVarAny s0 requestButtonValue) Ctrl redToGreen)) \<and> getPstate s1 Ctrl = green \<longrightarrow>
          getVarBool s1 minimalRed = PRESSED) \<and>
    (\<forall>s1. toEnvP s1 \<and> substate s1 (toEnv (setPstate (setVarAny s0 requestButtonValue) Ctrl redToGreen)) \<and> getPstate s1 Ctrl \<noteq> green \<longrightarrow>
          getVarBool s1 minimalRed = NOT_PRESSED) \<and>
    (\<forall>s1. toEnvP s1 \<and> substate s1 (toEnv (setPstate (setVarAny s0 requestButtonValue) Ctrl redToGreen)) \<longrightarrow>
          getPstate s1 Ctrl = minimalRed \<or>
          getPstate s1 Ctrl = redAfterMinimalRed \<or> getPstate s1 Ctrl = redToGreen \<or> getPstate s1 Ctrl = green) \<and>
    (\<forall>s1 s2.
        toEnvP s1 \<and>
        toEnvP s2 \<and>
        substate s1 s2 \<and>
        substate s2 (toEnv (setPstate (setVarAny s0 requestButtonValue) Ctrl redToGreen)) \<and>
        toEnvNum s1 s2 < ltimeEnv s2 Ctrl - Ctrl \<and> getPstate s2 Ctrl = minimalRed \<and> getVarBool s2 redAfterMinimalRed = NOT_PRESSED \<longrightarrow>
        getVarBool s1 Ctrl = NOT_PRESSED) \<and>
    (\<forall>s2. toEnvP s2 \<and>
          substate s2 (toEnv (setPstate (setVarAny s0 requestButtonValue) Ctrl redToGreen)) \<and>
          getPstate s2 Ctrl = minimalRed \<and> getVarBool s2 redAfterMinimalRed = PRESSED \<longrightarrow>
          (\<exists>s1. toEnvP s1 \<and> substate s1 s2 \<and> toEnvNum s1 s2 < ltimeEnv s2 Ctrl - Ctrl \<and> getVarBool s1 Ctrl = PRESSED)) \<and>
    (\<forall>s1. toEnvP s1 \<and>
          substate s1 (toEnv (setPstate (setVarAny s0 requestButtonValue) Ctrl redToGreen)) \<and>
          getPstate s1 Ctrl = redAfterMinimalRed \<and> getVarBool s1 redAfterMinimalRed \<longrightarrow>
          (\<exists>s2. toEnvP s2 \<and>
                substate s2 s1 \<and>
                toEnvNum s2 s1 = Ctrl \<and>
                getPstate s2 Ctrl = minimalRed \<and>
                ltimeEnv s2 Ctrl = MINIMAL_RED_TIME_LIMIT \<and> (getVarBool s2 redAfterMinimalRed \<or> getVarBool s1 Ctrl = PRESSED))) \<and>
    (\<forall>s1. toEnvP s1 \<and> substate s1 (toEnv (setPstate (setVarAny s0 requestButtonValue) Ctrl redToGreen)) \<and> getPstate s1 Ctrl = green \<longrightarrow>
          getVarBool s1 redAfterMinimalRed = NOT_PRESSED)"
    apply(rule conjI)
     apply(rule conjI)
    apply(simp)
  proof(rule allI; rule allI; rule allI)
    fix s1 s2 s3
    show "substate s1 s2 \<and>
         substate s2 s3 \<and>
         substate s3 (toEnv (setPstate (setVarAny s0 requestButtonValue) Ctrl redToGreen)) \<and>
         toEnvP s1 \<and>
         toEnvP s2 \<and>
         toEnvP s3 \<and>
         toEnvNum s1 s2 = Ctrl \<and>
         toEnvNum s2 s3 < T2 \<and> getVarBool s1 minimalRed \<noteq> PRESSED \<and> getVarBool s2 minimalRed = PRESSED \<longrightarrow>
         getVarBool s3 minimalRed = PRESSED"
    proof cases
      assume 1: "s3 = (toEnv (setPstate (setVarAny s0 requestButtonValue) Ctrl redToGreen))"
      show ?thesis
      proof
        print_state
        assume req_prems: "substate s1 s2 \<and>
    substate s2 s3 \<and>
    substate s3 (toEnv (setPstate (setVarAny s0 requestButtonValue) Ctrl redToGreen)) \<and>
    toEnvP s1 \<and>
    toEnvP s2 \<and>
    toEnvP s3 \<and> toEnvNum s1 s2 = Ctrl \<and> toEnvNum s2 s3 < T2 \<and> getVarBool s1 minimalRed \<noteq> PRESSED \<and> getVarBool s2 minimalRed = PRESSED"
        show "getVarBool s3 trafficLight = GREEN"
        proof cases
        assume 2: "getVarBool s0 requestButtonPressed"
        from ei0 substate_refl vc 2 ei19
        have " (\<exists>s2. toEnvP s2 \<and>
           substate s2 s0 \<and>
           toEnvNum s2 s0 = 1 \<and>
           getPstate s2 Ctrl = minimalRed \<and>
           ltimeEnv s2 Ctrl = MINIMAL_RED_TIME_LIMIT \<and> (getVarBool s2 requestButtonPressed \<or> getVarBool s0 requestButton = PRESSED))"
          by auto
        then obtain mr where 3: "toEnvP mr \<and> substate mr s0 \<and>
           toEnvNum mr s0 = 1 \<and>
           getPstate mr Ctrl = minimalRed \<and>
           ltimeEnv mr Ctrl = MINIMAL_RED_TIME_LIMIT \<and> (getVarBool mr requestButtonPressed \<or> getVarBool s0 requestButton = PRESSED)" ..
        show ?thesis
        proof cases
          assume 4: "substate s2 mr"
          from 3 ei2 have "((\<exists> s2. toEnvP s2 \<and> substate s2 mr \<and> toEnvNum s2 mr = MINIMAL_RED_TIME_LIMIT  \<and>
 getPstate s2 Ctrl = green \<and> ltimeEnv s2 Ctrl = GREEN_TIME_LIMIT) \<or>
 (\<forall> s2. toEnvP s2 \<and> substate s2 mr \<longrightarrow> getPstate s2 Ctrl = minimalRed))" by auto
          then show ?thesis
          proof
            assume " \<exists>s2. toEnvP s2 \<and> substate s2 mr \<and> toEnvNum s2 mr = MINIMAL_RED_TIME_LIMIT \<and> getPstate s2 Ctrl = green \<and>
 ltimeEnv s2 Ctrl = T2"
            then obtain g where 5: "toEnvP g \<and> substate g mr \<and> toEnvNum g mr = MINIMAL_RED_TIME_LIMIT \<and> getPstate g Ctrl = green \<and>
 ltimeEnv g Ctrl = T2" ..
            show ?thesis
            proof cases
              assume 6: "substate s2 g"
              with 5 toEnvNum3[of s2 g mr] req_prems have 7: "toEnvNum s2 mr \<ge> MINIMAL_RED_TIME_LIMIT" by auto
              from 6 5 substate_trans have "substate s2 mr" by blast
              with 3 7 toEnvNum3 req_prems have "toEnvNum s2 s0 > MINIMAL_RED_TIME_LIMIT" by auto
              with 1 req_prems show ?thesis by ((simp split: if_splits); auto)
            next
              assume 6: "\<not> substate s2 g"
              with 4 5 substate_total substate_asym have 7:  "substate g s2 \<and> g \<noteq> s2" by auto
              with req_prems 5 gtimeE_inj have "toEnvNum emptyState g \<noteq> toEnvNum  emptyState s2" by blast
              with 7 toEnvNum3[of emptyState g s2] emptyState_substate  have "toEnvNum g s2 > 0" by auto
              with 4 5 7  toEnvNum3 have "toEnvNum s2 mr < MINIMAL_RED_TIME_LIMIT" by auto
              with 4 3 req_prems ei3 have "getPstate s2 Ctrl = minimalRed" by force
              with ei15 req_prems show ?thesis
                by (metis "1" numeral_eq_iff substate.simps(2) substate.simps(6) substate.simps(7) toEnvP.simps(6) toEnvP.simps(7) verit_eq_simplify(14))
            qed
          next
            assume 5: "\<forall>s2. toEnvP s2 \<and> substate s2 mr \<longrightarrow> getPstate s2 Ctrl = minimalRed"
            with 4 req_prems show ?thesis by (metis "3" ei15 numeral_eq_iff semiring_norm(89) substate_trans)
          qed
        next
          assume 4: "\<not> substate s2 mr"
          show ?thesis
          proof cases
            assume "s2 =  toEnv (setPstate (setVarAny s0 requestButtonValue) Ctrl redToGreen)"
            with 1 req_prems show ?thesis by auto
          next
            assume "s2 \<noteq>  toEnv (setPstate (setVarAny s0 requestButtonValue) Ctrl redToGreen)"
            with req_prems 1 have 5: "substate s2 s0"  by (simp  split: if_splits)
            with 3 4 substate_total substate_asym have 6: "substate mr s2 \<and> mr \<noteq> s2" by auto
            from 5 emptyState_substate toEnvNum3  have 7: "toEnvNum emptyState s2 \<le> toEnvNum emptyState s0" by auto
            from 3 6 req_prems gtimeE_inj have "toEnvNum emptyState mr \<noteq> toEnvNum emptyState s2" by blast
            with 6 emptyState_substate toEnvNum3 have 8: "toEnvNum emptyState mr < toEnvNum emptyState s2" by auto
            from 3 emptyState_substate toEnvNum3 have "toEnvNum emptyState s0 = toEnvNum emptyState mr + 1" by auto
            with 8 have "toEnvNum emptyState s2 \<ge> toEnvNum emptyState s0" by auto
            with 7 have "toEnvNum emptyState s2 = toEnvNum emptyState s0" by auto
            with 5 req_prems ei0 gtimeE_inj have "s2 = s0" by blast
            with vc req_prems ei15 show ?thesis
              using "2" "5" ei20 by blast
          qed
        qed
      next
        assume 2: "\<not> getVarBool s0 requestButtonPressed"
        with vc ei0 ei5 substate_refl have "\<exists>s2. toEnvP s2 \<and>
           substate s2 s0 \<and>
           getPstate s2 Ctrl = minimalRed \<and>
           ltimeEnv s2 Ctrl = MINIMAL_RED_TIME_LIMIT \<and>
           getVarBool s2 redAfterMinimalRed = NOT_PRESSED \<and>
           (\<forall>s3. toEnvP s3 \<and> substate s2 s3 \<and> substate s3 s0 \<and> s2 \<noteq> s3 \<longrightarrow>
                 getPstate s3 Ctrl = redAfterMinimalRed \<and> getVarBool s3 redAfterMinimalRed = NOT_PRESSED \<and> getVarBool s3 Ctrl = NOT_PRESSED)"
          by auto
        then obtain mr where 3: "toEnvP mr \<and>
           substate mr s0 \<and>
           getPstate mr Ctrl = minimalRed \<and>
           ltimeEnv mr Ctrl = MINIMAL_RED_TIME_LIMIT \<and>
           getVarBool mr redAfterMinimalRed = NOT_PRESSED \<and>
           (\<forall>s3. toEnvP s3 \<and> substate mr s3 \<and> substate s3 s0 \<and> mr \<noteq> s3 \<longrightarrow>
                 getPstate s3 Ctrl = redAfterMinimalRed \<and> getVarBool s3 redAfterMinimalRed = NOT_PRESSED \<and>
 getVarBool s3 Ctrl = NOT_PRESSED)" ..
        show ?thesis
        proof cases
           assume 4: "substate s2 mr"
          from 3 ei2 have "((\<exists> s2. toEnvP s2 \<and> substate s2 mr \<and> toEnvNum s2 mr = MINIMAL_RED_TIME_LIMIT  \<and>
 getPstate s2 Ctrl = green \<and> ltimeEnv s2 Ctrl = GREEN_TIME_LIMIT) \<or>
 (\<forall> s2. toEnvP s2 \<and> substate s2 mr \<longrightarrow> getPstate s2 Ctrl = minimalRed))" by auto
          then show ?thesis
          proof
            assume " \<exists>s2. toEnvP s2 \<and> substate s2 mr \<and> toEnvNum s2 mr = MINIMAL_RED_TIME_LIMIT \<and> getPstate s2 Ctrl = green \<and>
 ltimeEnv s2 Ctrl = T2"
            then obtain g where 5: "toEnvP g \<and> substate g mr \<and> toEnvNum g mr = MINIMAL_RED_TIME_LIMIT \<and> getPstate g Ctrl = green \<and>
 ltimeEnv g Ctrl = T2" ..
            show ?thesis
            proof cases
              assume 6: "substate s2 g"
              with 5 toEnvNum3[of s2 g mr] req_prems have 7: "toEnvNum s2 mr \<ge> MINIMAL_RED_TIME_LIMIT" by auto
              from 6 5 substate_trans have 8: "substate s2 mr" by blast
              from vc 3 have "mr \<noteq> s0" by auto
              with 3 ei0 gtimeE_inj have "toEnvNum emptyState mr \<noteq> toEnvNum emptyState s0" by auto
              with 3 emptyState_substate toEnvNum3 have "toEnvNum emptyState mr < toEnvNum emptyState s0" by auto
              with 3 7 8  toEnvNum3 req_prems have "toEnvNum s2 s0 > MINIMAL_RED_TIME_LIMIT"
                using emptyState_substate by auto
              with 1 req_prems show ?thesis by ((simp split: if_splits); auto)
            next
              assume 6: "\<not> substate s2 g"
              with 4 5 substate_total substate_asym have 7:  "substate g s2 \<and> g \<noteq> s2" by auto
              with req_prems 5 gtimeE_inj have "toEnvNum emptyState g \<noteq> toEnvNum  emptyState s2" by blast
              with 7 toEnvNum3[of emptyState g s2] emptyState_substate  have "toEnvNum g s2 > 0" by auto
              with 4 5 7  toEnvNum3 have "toEnvNum s2 mr < MINIMAL_RED_TIME_LIMIT" by auto
              with 4 3 req_prems ei3 have "getPstate s2 Ctrl = minimalRed" by force
              with ei15 req_prems show ?thesis
                by (metis "1" numeral_eq_iff substate.simps(2) substate.simps(6) substate.simps(7) toEnvP.simps(6) toEnvP.simps(7) verit_eq_simplify(14))
            qed
          next
            assume 5: "\<forall>s2. toEnvP s2 \<and> substate s2 mr \<longrightarrow> getPstate s2 Ctrl = minimalRed"
            with 4 req_prems show ?thesis by (metis "3" ei15 numeral_eq_iff semiring_norm(89) substate_trans)
          qed
        next
          assume 4: "\<not> substate s2 mr"
          show ?thesis
          proof cases
            assume "s2 =  toEnv (setPstate (setVarAny s0 requestButtonValue) Ctrl redToGreen)"
            with 1 req_prems show ?thesis by auto
          next
            assume "s2 \<noteq>  toEnv (setPstate (setVarAny s0 requestButtonValue) Ctrl redToGreen)"
            with req_prems 1 have 5: "substate s2 s0"  by (simp  split: if_splits)
            with 4 req_prems 3 substate_total substate_asym have "substate mr s2 \<and> mr \<noteq> s2" by blast
            with 3 5 req_prems have "getPstate s2 Ctrl = redAfterMinimalRed" by auto
            with ei15 req_prems show ?thesis
              using "5" by auto
          qed
        qed
      qed
    qed
  next
    assume 1: "s3 \<noteq> toEnv (setPstate (setVarAny s0 requestButtonValue) Ctrl redToGreen)"
    show ?thesis
    proof
      assume req_prems: " substate s1 s2 \<and>
    substate s2 s3 \<and>
    substate s3 (toEnv (setPstate (setVarAny s0 requestButtonValue) Ctrl redToGreen)) \<and>
    toEnvP s1 \<and>
    toEnvP s2 \<and>
    toEnvP s3 \<and> toEnvNum s1 s2 = Ctrl \<and> toEnvNum s2 s3 < T2 \<and> getVarBool s1 minimalRed \<noteq> PRESSED \<and> getVarBool s2 minimalRed = PRESSED"
      with 1 have "substate s3 s0" by (simp split: if_splits)
      with req_prems reqs0
      show " getVarBool s3 minimalRed = PRESSED" by blast
    qed
  qed


(*  Title:      Native_Cast_Uint.thy
    Author:     Andreas Lochbihler, Digital Asset
*)

theory Native_Cast_Uint imports
  Native_Cast
  Uint
begin

lift_definition uint_of_uint8 :: "uint8 \<Rightarrow> uint" is ucast .
lift_definition uint_of_uint16 :: "uint16 \<Rightarrow> uint" is ucast .
lift_definition uint_of_uint32 :: "uint32 \<Rightarrow> uint" is ucast .
lift_definition uint_of_uint64 :: "uint64 \<Rightarrow> uint" is ucast .

lift_definition uint8_of_uint :: "uint \<Rightarrow> uint8" is ucast .
lift_definition uint16_of_uint :: "uint \<Rightarrow> uint16" is ucast .
lift_definition uint32_of_uint :: "uint \<Rightarrow> uint32" is ucast .
lift_definition uint64_of_uint :: "uint \<Rightarrow> uint64" is ucast .

code_printing
  constant uint_of_uint8 \<rightharpoonup>
  (SML) "Word.fromLarge (Word8.toLarge _)" and
  (Haskell) "(Prelude.fromIntegral _ :: Uint.Word)" and
  (Scala) "((_).toInt & 0xFF)"
| constant uint_of_uint16 \<rightharpoonup>
  (SML_word) "Word.fromLarge (Word16.toLarge _)" and
  (Haskell) "(Prelude.fromIntegral _ :: Uint.Word)" and
  (Scala) "(_).toInt"
| constant uint_of_uint32 \<rightharpoonup>
  (SML) "Word.fromLarge (Word32.toLarge _)" and
  (Haskell) "(Prelude.fromIntegral _ :: Uint.Word)" and
  (Scala) "_" and
  (OCaml) "(Int32.to'_int _) land Uint.int'_mask"
| constant uint_of_uint64 \<rightharpoonup>
  (SML) "Word.fromLarge (Uint64.toLarge _)" and
  (Haskell) "(Prelude.fromIntegral _ :: Uint.Word)" and
  (Scala) "(_).toInt" and
  (OCaml) "Int64.to'_int"
| constant uint8_of_uint \<rightharpoonup>
  (SML) "Word8.fromLarge (Word.toLarge _)" and
  (Haskell) "(Prelude.fromIntegral _ :: Uint8.Word8)" and
  (Scala) "(_).toByte"
| constant uint16_of_uint \<rightharpoonup>
  (SML_word) "Word16.fromLarge (Word.toLarge _)" and
  (Haskell) "(Prelude.fromIntegral _ :: Uint16.Word16)" and
  (Scala) "(_).toChar"
| constant uint32_of_uint \<rightharpoonup>
  (SML) "Word32.fromLarge (Word.toLarge _)" and
  (Haskell) "(Prelude.fromIntegral _ :: Uint32.Word32)" and
  (Scala) "_" and
  (OCaml) "Int32.logand (Int32.of'_int _) Uint.int32'_mask"
| constant uint64_of_uint \<rightharpoonup>
  (SML) "Uint64.fromLarge (Word.toLarge _)" and
  (Haskell) "(Prelude.fromIntegral _ :: Uint64.Word64)" and
  (Scala) "((_).toLong & 0xFFFFFFFFL)" and
  (OCaml) "Int64.logand (Int64.of'_int _) Uint.int64'_mask"

lemma uint8_of_uint_code [code]:
  "uint8_of_uint x = Abs_uint8' (ucast (Rep_uint' x))"
  unfolding Rep_uint'_def by transfer simp

lemma uint16_of_uint_code [code]:
  "uint16_of_uint x = Abs_uint16' (ucast (Rep_uint' x))"
  unfolding Rep_uint'_def by transfer simp

lemma uint32_of_uint_code [code]:
  "uint32_of_uint x = Abs_uint32' (ucast (Rep_uint' x))"
  unfolding Rep_uint'_def by transfer simp

lemma uint64_of_uint_code [code]:
  "uint64_of_uint x = Abs_uint64' (ucast (Rep_uint' x))"
  unfolding Rep_uint'_def by transfer simp

lemma uint_of_uint8_code [code]:
  "uint_of_uint8 x = Abs_uint' (ucast (Rep_uint8' x))"
  by transfer simp

lemma uint_of_uint16_code [code]:
  "uint_of_uint16 x = Abs_uint' (ucast (Rep_uint16' x))"
  by transfer simp

lemma uint_of_uint32_code [code]:
  "uint_of_uint32 x = Abs_uint' (ucast (Rep_uint32' x))"
  by transfer simp

lemma uint_of_uint64_code [code]:
  "uint_of_uint64 x = Abs_uint' (ucast (Rep_uint64' x))"
  by transfer simp

end


theory CloseSafe
imports Semantics
begin

lemma closeIdemp_reduceContractStep : "reduceContractStep env fixSta Close = Reduced wa ef sta cont \<Longrightarrow> cont = Close"
  by (auto split:option.splits)

lemma closeIdemp_reductionLoop : "reductionLoop reducedBefore env fixSta Close wa ef = ContractQuiescent reducedAfter reduceWarns pays curState cont \<Longrightarrow> cont = Close"
  apply (induction reducedBefore env fixSta Close wa ef rule:reductionLoop.induct)
  subgoal for reducedBefore env state warnings payments
    apply (simp only:reductionLoop.simps[of reducedBefore env state Close warnings payments])
    apply (auto split:ReduceStepResult.splits simp del:reductionLoop.simps reduceContractStep.simps)
    using closeIdemp_reduceContractStep by blast
  done

lemma closeIdemp_reduceContractUntilQuiescent : "reduceContractUntilQuiescent env fixSta Close = ContractQuiescent reduced reduceWarns pays curState cont \<Longrightarrow> cont = Close"
  apply (simp only:reduceContractUntilQuiescent.simps)
  using closeIdemp_reductionLoop by blast

lemma closeIsSafe_reduceContractStep : "reduceContractStep env fixSta Close = Reduced wa ef sta cont \<Longrightarrow> wa = ReduceNoWarning"
  by (auto split:option.splits)

lemma closeIsSafe_reductionLoop : "wa = [] \<Longrightarrow> reductionLoop reducedBefore env fixSta Close wa ef = ContractQuiescent reducedAfter reduceWarns pays curState cont \<Longrightarrow> reduceWarns = []"
  apply (induction reducedBefore env fixSta Close wa ef rule:reductionLoop.induct)
  subgoal for reducedBefore env state warnings payments
    apply (simp only:reductionLoop.simps[of reducedBefore env state Close warnings payments])
    apply (simp only:reductionLoop.simps[of reducedBefore env state Close "[]" payments])
    apply (auto split:ReduceStepResult.splits simp del:reductionLoop.simps reduceContractStep.simps)
    using closeIdemp_reduceContractStep closeIsSafe_reduceContractStep by fastforce
  done

lemma closeIsSafe_reduceContractUntilQuiescent : "reduceContractUntilQuiescent env fixSta Close = ContractQuiescent reduced reduceWarns pays curState cont \<Longrightarrow> reduceWarns = []"
  by (simp add: closeIsSafe_reductionLoop)

lemma closeIsSafe_applyInput : "applyInput env curState head Close = Applied applyWarn newState cont2 \<Longrightarrow> applyWarn = ApplyNoWarning"
  by simp

lemma closeIsSafe_applyAllInputs : "applyAllInputs env fixSta Close inps = ApplyAllSuccess reduced warnings payments newState cont \<Longrightarrow> warnings = []"
  apply (auto split:ReduceResult.splits
              simp del:applyAllLoop.simps reduceContractUntilQuiescent.simps
              simp add:applyAllLoop.simps [of "False" env fixSta Close inps "[]" "[]"])
  subgoal for reduced reduceWarns pays curState cont
    apply (auto split:list.splits simp del:reduceContractUntilQuiescent.simps applyAllLoop.simps)
    apply (subst closeIsSafe_reduceContractUntilQuiescent[of env fixSta reduced reduceWarns pays newState cont])
    apply simp
    apply simp
    using closeIsSafe_reduceContractUntilQuiescent convertReduceWarnings.simps(1) apply blast
    using closeIdemp_reduceContractUntilQuiescent by force
  done

theorem closeIsSafe : "computeTransaction tra sta Close = TransactionOutput trec \<Longrightarrow> txOutWarnings trec = []"
  apply (simp only:computeTransaction.simps)
  apply (auto split:IntervalResult.splits option.splits ApplyAllResult.splits
              simp del:applyAllLoop.simps simp add:closeIsSafe_applyAllInputs)
  subgoal for env fixSta warnings payments newState cont
    apply (cases "\<not> warnings \<and> accounts sta = []")
    by (auto simp del:applyAllLoop.simps simp add:closeIsSafe_applyAllInputs)
  done

end