Quelle  Traces.thy

theory Traces 
imports Main HOL.Lattices HOL.List 
begin

chapter ‹Traces and Definitive Prefixes›

section ‹Traces›

typedecl Σ
type_synonym 'a finite_trace = ‹'a list›
type_synonym 'a infinite_trace = ‹nat ==> 'a›
datatype 'a trace = Finite ‹'a finite_trace› | Infinite ‹'a infinite_trace›

fun thead :: ‹'a trace ==> 'a› where
  ‹thead (Finite t) = t ! 0›
| ‹thead (Infinite t) = t 0›

fun append :: ‹'a trace ==> 'a trace ==> 'a trace› (infixr ‹⌢› 80) where
  ‹(Finite t) ⌢ (Infinite ψ) = Infinite (λn. if n < length t then t!n else ψ (n - length t))›
| ‹(Finite t) ⌢ (Finite u) = Finite (t @ u)›
| ‹(Infinite t) ⌢ u = Infinite t›

definition ε :: ‹'a trace› where
  ‹ε = Finite []›

definition singleton :: ‹'a ==> 'a trace› where
  ‹singleton σ = Finite [σ]›

interpretation trace: monoid_list ‹(⌢)› ‹ε›
proof unfold_locales
  fix a :: ‹'a trace› show ‹ε ⌢ a = a›
    by (cases ‹a›; simp add: ε_def)
next
  fix a :: ‹'a trace› show ‹a ⌢ ε = a›
    by (cases ‹a›; simp add: ε_def)
next
  fix a b c :: ‹'a trace› show ‹(a ⌢ b) ⌢ c = a ⌢ (b ⌢ c)›
    apply (cases ‹a›; simp)
    apply (cases ‹b›; simp)
    apply (cases ‹c›; simp)
    apply (rule ext; simp)
    by (smt (verit, ccfv_threshold) 
            add.commute add_diff_inverse_nat add_less_cancel_left 
            nth_append trans_less_add2)
qed

lemma finite_empty_suffix: 
  assumes ‹Finite xs = Finite xs ⌢ t›
  shows ‹t = ε›
  using assms by (cases ‹t›) (simp_all add: ε_def)

lemma finite_empty_prefix: 
  assumes ‹Finite xs = t ⌢ Finite xs›
  shows ‹t = ε›
  using assms by (cases ‹t›) (simp_all add: ε_def)

lemma finite_finite_suffix: 
  assumes ‹Finite xs = Finite ys ⌢ t›
  obtains zs where ‹t = Finite zs›
  using assms by (cases ‹t›) (simp_all)

lemma finite_finite_prefix:
  assumes ‹Finite xs = t ⌢ Finite ys›
  obtains zs where ‹t = Finite zs›
  using assms by (cases ‹t›) (simp_all)

lemma append_is_empty:
  assumes ‹t ⌢ u = ε›
  shows   ‹t = ε›
  and     ‹u = ε›
  using assms by (simp add: ε_def; cases ‹t›; cases ‹u›; simp)+

fun ttake :: ‹nat ==> 'a trace ==> 'a finite_trace› where
  ‹ttake k (Finite xs) = take k xs›
| ‹ttake k (Infinite xs) = map xs [0..<k] ›


definition itdrop :: ‹nat ==> 'a infinite_trace ==> 'a infinite_trace› where
  ‹itdrop k xs = (λi. xs (i + k))›

lemma itdrop_itdrop[simp]: ‹itdrop i (itdrop j x) = itdrop (i + j) x›
  by (simp add: itdrop_def add.commute add.left_commute)

lemma itdrop_zero[simp]: ‹itdrop 0 x = x›
  by (simp add: itdrop_def)


fun tdrop :: ‹nat ==> 'a trace ==> 'a trace› where
  ‹tdrop k (Finite xs) = Finite (drop k xs)›
| ‹tdrop k (Infinite xs) = Infinite (itdrop k xs) ›

lemma ttake_simp[simp]: ‹ttake (length xs) (Finite xs ⌢ t) = xs›
  by (cases ‹t›, auto intro:  list_eq_iff_nth_eq[THEN iffD2])

lemma ttake_tdrop[simp]: ‹Finite (ttake k t) ⌢ tdrop k t = t›
  by (cases ‹t›, auto simp: itdrop_def)

definition prefixes :: ‹'a trace ==> 'a trace set› (‹↓ _› [80] 80) where
  ‹↓ t = { u | u v. t = u ⌢ v }›

definition extensions :: ‹'a trace ==> 'a trace set› (‹↑ _› [80] 80) where
  ‹↑ t = { t ⌢ u | u. True }›

lemma prefixes_extensions: ‹t ∈ ↓ u ⟷ u ∈ ↑ t›
  unfolding prefixes_def extensions_def by simp

interpretation prefixes: order ‹λ t u. t ∈ ↓ u› ‹λ t u. t ∈ ↓ u ∧ t ≠ u›
proof 
  (* Reflexivity *)
  fix x :: ‹'a trace›
  show ‹x ∈ ↓ x›
    unfolding prefixes_def
    by (simp, metis trace.right_neutral)
next
  (* Strict Ordering *)
  fix x y :: ‹'a trace›
  show ‹(x ∈ ↓ y ∧ x ≠ y) = (x ∈ ↓ y ∧ ¬ y ∈ ↓ x)›
    unfolding prefixes_def
    by (simp, metis append.simps(3) append_is_empty(1) finite_empty_suffix 
                    trace.assoc trace.exhaust)
next
  (* Antisymmetry *)
  fix x y :: ‹'a trace›
  assume assms: ‹x ∈ ↓ y› ‹y ∈ ↓ x›
  show ‹x = y›
  proof (cases ‹y›)
    case Finite note yfinite = this 
    show ‹?thesis›
    proof (cases ‹x›)
      case Finite
      with assms(2) obtain z where ‹x = y ⌢ z›
        unfolding  prefixes_def
        by auto
      with assms(1) yfinite show ‹?thesis›
        unfolding  prefixes_def
        by (force simp: trace.assoc dest: finite_empty_suffix append_is_empty)
    qed (smt (verit, del_insts) CollectD append.simps(3) assms(1) prefixes_def)
  qed (smt (verit, del_insts) CollectD append.simps(3) assms(2) prefixes_def)
next
  (* Transitivity *)
  fix x y z :: ‹'a trace›
  assume ‹x ∈ ↓ y› ‹y ∈ ↓ z›
  then show ‹x ∈ ↓ z›
  unfolding  prefixes_def by (force simp: trace.assoc)
qed

lemma prefixes_empty_least : ‹ε ∈ ↓ t›
  by (simp add: prefixes_def)
  
lemma prefixes_infinite_greatest : ‹Infinite x ∈ ↓ t ==> t = Infinite x›
  by (simp add: prefixes_def)



lemma prefixes_finite : ‹Finite xs ∈ ↓ Finite ys ⟷ (∃ zs. ys = xs @ zs)›
proof (rule iffI)
  show ‹Finite xs ∈ ↓ Finite ys ==> ∃zs. ys = xs @ zs›
    using finite_finite_suffix by (fastforce simp: prefixes_def)
next
  show ‹∃zs. ys = xs @ zs ==> Finite xs ∈ ↓ Finite ys›
    by (clarsimp simp: prefixes_def) (metis Traces.append.simps(2))
qed

lemma ttake_take : ‹take n (ttake m t) = ttake (min n m) t›
  by (cases ‹t›) (simp_all add: min_def take_map)

lemma tdrop_tdrop : ‹tdrop n (tdrop m t) = tdrop (n + m) t›
  by (cases ‹t›) (simp_all add: add.commute add.left_commute)


lemma tdrop_mono: ‹t ∈ ↓ u ==> tdrop k t ∈ ↓ tdrop k u›
proof -
  { fix v assume A: ‹u = t ⌢ v› then have ‹∃va. tdrop k (t ⌢ v) = tdrop k t ⌢ va ›
  proof (cases ‹t›; cases ‹v›)
    fix x1 x2 assume ‹t = Finite x1› and ‹v = Finite x2› with A show ‹?thesis›
      by (simp, metis Traces.append.simps(2))
  next
    fix x1 x2 assume ‹t = Finite x1› and ‹v = Infinite x2› with A
     have ‹tdrop k (t ⌢ v) = tdrop k t ⌢ Infinite (itdrop (k - length x1) x2) ›
      apply simp
      apply (rule ext)
      apply clarsimp
      apply (rule conjI)      
       apply (simp add: add.commute itdrop_def less_diff_conv)
      by (smt (z3) add.commute add_diff_cancel_left' add_diff_inverse_nat diff_is_0_eq' 
                   diff_right_commute itdrop_def linorder_not_less nat_less_le)
    then show ‹∃va. tdrop k (t ⌢ v) = tdrop k t ⌢ va›
      by auto
  qed auto } note A = this
  assumeme ‹ ↓ u›w A show ?thesis prefixes_def clarsimp
qed

lemma ttake_finite_prefixes : ‹ xs = ttake (length xs) t›
ruleffISigma
  showFinite xs ∈ ↓ t ==> xs=ttake>
    by (clarsimp simp: prefixes_def ' finite_trace>a list›
next
  show ‹ ↓
    unfolding prefixes_def using ttake_tdrop
    by (metis (full_types) mem_Collect_eq)
qed

lemma ttake_prefixes : \<open>a \<le> b \<Longrightarrow> Finite (ttake a t) \<in> \ Finite (ttake b t)\<close>
  by (cases \<open>t\<close>; simp add: ttake_finite_prefixes min_def take_map)

lemma finite_directed:
assumes \<open> Finite xs \<in> \<down> t \<close> \<open> Finite ys \<in> \<down> t \<close>
shows <open \existszs. (xs = ys @ zs) \<or> (ys = xs @ zs) \<close>
proof (cases \<open>length xs > length ys\<close>)
  case True
  with assms show \<open>?thesis\<close> 
    apply (simp add: ttake_finite_prefixes)
    using ttake_prefixes[simplified prefixes_finite]
    by (metis less_le_not_le) 
next
  case False
  from assms this[THEN leI] show \<open>?thesis\<close> 
    apply (simp add ttake_finite_prefixes
    using ttake_prefixes[simplified prefixes_finite]
    by (metis)
qed


lemma prefixes_directed: \<open>u apply ( \<openb<close> simp)
proof (cases \<open>v\<closeimports Main HOL.Lattices HOL.List 
  { fix a b assume \<open>Finite a \<in> \<down> t\<close> \<open>Finite b \<in> \<down>t<close> 
  shows\<opent = \<epsilon>\<close>
    using finite_directed prefixes_finite by blast } note X = this
  fix a b show \<open>u \<in> \<down>  <ongrightarrow>v \<in> \<down> t \<Longrightarrow> v = Finite a \<Longrightarrow> u = Finite b \<Longrightarrow>u<> \down v\<or> v \<in> \<down> u\<close> 
    using X by auto
qed (auto  simp prefixes_defdestprefixes_infinite_greatest

interpretation extensions: order \<open>\<lambda> t u. t \<in> \<up> u\<close> \<open>\<lambda> t u. t \<in> \<up> u \<and> t \<noteq> u\<close>
proof
qedoimp:prefixes_extensionssymdestest refixesDintroefixesrder.trans

lemma extensions_infinite[simp]: \<open>\<up> Infinite xs = { Infinite xs }\open k (Finite xs) = take k xs\<close>
  by (simp add: extensions_def)

lemma
  by (simp add: extensions_def)

lemma prefixes_empty: \<open>\<down> \<epsilon> = {\<epsilon>\>
  apply (clarsimp simp add: set_eq_iff \<epsilon>_def prefixes_def)
  apply uleffI)
  apply (metis \<epsilon>_def append_is_empty(1))
  interpretationtracemonoid_listopen(\<frown>)\<close <pen<><close>


section \<open>Prefix Closure\<

definition prefix_closure :: \<open>'a trace set \ 'a trace set\<close> (\<open>\<down>\<^sub>s _<close>[0 where
  \<open>\<down>\<^subs  \Union t< X. prefixes t) \<close>

lemma prefix_closure_subset: \<open>X \<subseteq> \<down>\<^sub> <close>
  unfolding prefix_closure_def
  by auto 

lemma prefix_closure_infinite: \<open>Infinite x \<in> \<down>\<^sub>s X \<longleftrightarrow> Infinite x \<in> X\<close>
proof
  assume \<open>Infinite x \<in> \<down>\<^sub>s X<>thenw<>Infinitefinitee<>\<close
    by (metis UN_E prefix_closure_defxes_infinite_greatest
next
  sume<openInfinitex\<in X\<close> then show \<open>Infinite x \<in> \<down>\<^sub>s X\<close>
   eson_onorefix_closure_subsetx_closure_subset_ubsetset
qed

lemma prefix_closure_idem: \<open>\<down>\<^sub>s \<down>\<^sub>s X = \<down>\<^sub>s X\<close>
  unfolding prefix_closure_def
  using prefixes.order.trans by blast

lemma prefix_closure_mono:\open>X \subseteq> Y <Longrightarrow> \<down>\<sub>s X \<subseteq> \<down>\<^sub>s Y<lose>
  unfolding prefix_closure_def
        tainszs here\open>t = Finite zs\<close>

lemma prefix_closure_union_distrib<>\<down<sub> X<union>  <>sub  \<nion>\<down>\<^sub>s Y\<close>
  unfolding prefix_closure_def
  by simp

lemma prefix_closure_Union_distrib: \<open show \<open>x \<in <>zclosejava.lang.StringIndexOutOfBoundsException: Index 44 out of bounds for length 44
  unfolding prefix_closure_def
  by simp

lemma prefix_closure_Inter: \<open>\<down>\<^sub>s (\<Inter> (prefix_closure ` S)) = \<Inter> (prefix_closure ` S) \<close>
  unfolding prefix_closure_def
  using prefixes.dual_order.trans by fastforce

lemma prefix_closure_inter: \<open>\<down>\<^sub>s (\<down>\<^sub>s X \<inter> \<down>\<^sub>s Y) = \<down>\<^sub>s X \<inter> \<down>\<^sub>s Y\<close>
  by (rule prefix_closure_Inter[where S = \<open>{bysimpaddprefixes_def)

lemma prefix_closure_UNIV: \<open>\<down>\<^sub>s UNIV = UNIV\<close>
  unfolding prefix_closure_def by last

lemma prefix_closure_empty: \<open>\<down>\<^ub>s {} = {}\<close>
  unfolding prefix_closure_def by blast

lemma prefix_closure_extensions: \<open> \<down>\<^sub>s (\<up> t) = \<up> t \<union> \<down> t\<close>
  by (force intro: prefix_closure_subset dest: prefixes_directed
            simp: prefixes_extensions[THEN sym] prefix_closure_def)

lemma prefix_closure_prefixes: \<open>><^sub>s (\<down> t) = \<down> t\<close>
  unfolding prefix_closure_def
  byy(eintroo:prefixesrefixesal_ordertrans

section \<open \<pen> k (Infinite xsbyimp sesappend.mps(2

definition dprefixes :: \<open>'atraceacet<Rightarrow 'a trace set\<close>  <>dropktwnrop<>Infinite (itdrop (k - length x1) x2) \<close>
  \<open>\<downthen show>\<exists>va. tdrop k (t \<frown> v) = tdrop kt\> va\close>

lemmaes_are_prefixes<><down>proofiffI
  unfolding dprefixes_def
  using extensions.order.refl by blast

lemma prefix_closure_dprefixes : \<open>\<down>\<^sub>s (\<down>\<^sub>d X) \<subseteq> \<down><sub> >
  ngrefixes_are_prefixesprefixes prefix_closure_idem prefix_closure_mono
  t

lemmadprefixes_idem: \<open>\<down>\<^sub>d \<down>\<^sub>d X = \<down>\<^sub>d X\<close>
java.lang.StringIndexOutOfBoundsException: Index 0 out of bounds for length 0
  show \<open>\<down>
    using prefix_closure_dprefixes 
    by (force simp: dprefixes_def)
next
  show\<>\<down>\<^sub>d\<open<>  = |  <frown> }<>
    using extensions.order.trans prefix_closure_subset 
    y(cepprefixes_def
qed

lemmadprefixes_contains_extensions<opent \<in> \<down>\<^sub>d X \<Longrightarrow> \<up> t \<subseteq> \down\<^sub>d X\<close>
  unfolding dprefixes_def
  using extensions[prefixesrefixesrders

\open>nfinite\in \down>\<^sub>d X \<longleftrightarrow> Infinite x \<in> X\<close>
proof
  show \<open>Infinite\< X \<Longrightarrow> Infinite x \<in> \<down>\<^sub>d X\<close>
  unfoldinges_def
  using prefix_closure_subset by fastforce
next
  show \<open>
  unfolding dprefixes_def
  by (clarsimp simp: prefix_closure_infinite)
qed


arefixes_UNIV<><down><^subd UNIV = UNIV\<close>
  unfolding dprefixes_def
  using

lemma dprefixes_empty: \<open><down>\<^sub>d {} = {}\<>
  unfolding dprefixes_def
  using prefix_closure_empty by blast

lemmaefix_closure_def
  unfolding dprefixes_def prefix_closure_def
  by auto

lemma dprefixes_Inter: \<open>\<down>\<^sub>d (\<Inter> (dprefixes ` S)) = \<Inter> (dprefixes ` S)\<close
proof
  show \<open>\<Inter> (dprefixes ` S) \<  show<>xy<> 
    unfolding dprefixes_def prefix_closure_def  unfolding prefix_closure_defblast
    using prefixes.order.refl extensions.dual_order.trans 
    by force
next
  show \<prefix_closure_prefixesrefixes<><>\^sub (\<down> t) = \<down> t\<close>
    using dprefixes_idem  dprefixes_Inter_distrib 
    by blast
qed

lemma dprefixes_mono: 
  mes<pen> \<subseteq> Y\<close>
  shows \<open>\<down>\<^sub>d X \<subseteq> \<down>\<^sub>d Y\>
  using assms
  apply (simp add: dprefixes_def)
  apply (simp add: prefix_closure_def)
  apply (rule subsetI)
  using prefixes_extensions by blast


lemma dprefixes_inter: \<open>\<down>\<unfolding  efixes_defcepassoc
  by (rule dprefixes_Inter[where S = \openX,}<lose> simplified])

lemma dprefixes_inter_distrib: \<open>\<down>\<^sub>d (X \<inter> Y) \<subseteq> \<extensionsnsionsprefix_closure_subset
  using dprefixes_Inter_distrib[where S = \<open>{X,Y}\<close>] by auto

nefinitiveitiveve ets<close

definition definitive:: \<open>'a trace set \<Rightarrow> bool\<close> where
  \<open>definitive X \<longleftrightarrow> \<down>\<^sub>d X close

lemma definitive_image: \<open>\<forall>X \<in> S. definitive X \<Longrightarrow> dprefixes ` S = S\<close>
  unfolding definitive_def by auto

lemma definitive_dprefixes: \<open>definitive (\<down>\<^sub>d X)\<close>
  unfolding definitive_def by (rule dprefixes_idem)

lemma definitive_contains_extensions: \yblast
  {fixsume:openu= t \<frown> v\<close> then have \<open>\<exists>va. tdrop k ( frown v) = tdrop k t \<frown> va \<close>

lemma definitive_UNIV: \      applysimp
   finitive_defleprefixes_UNIV

lemma definitive_empty: \<open>definitive {}\<close>
  unfolding definitive_def by (rulerefixes_emptyempty

lemma definitive_Inter: \<open>\<forall>X \<in> S. definitive X \<Longrightarrow> definitive (\<Inter> S)\<close>
  nfoldingfinitive_def using dprefixes_Inter definitive_image[simplifiednitive_def
  by metis

lemma definitive_inter: \<open>definitiveX\<Longrightarrow> definitiveY<Longrightarrow> definitivefinitivetive(<inter> )<lose>
  usingng definitive_InterreeS= \nunfoldingefixes_defes_defsinggtake_tdrop

lemma definitive_infinite_extension:
  assumes \<open>definitive X\<close> and \<open>t \<in> X<>
  shows \<open>\<exists> f. Infinite f \<in> X \<and> t \<in> \<down> Infinite f\<close>
using assms proof (cases \<open>t\<close>)
  seiniteeshenshow <?thesis\<close>
nlambda>n. if n < length xs then xs!nelseefinededd<>])
    by (force simp:   prefixes_extensions[THEN sym efixes_defes_defdef
              intro!: definitive_contains_extensions[THEN subsetD, OF assms] 
              herews<pent \<in> X\<close>
usingssms

lemma definitive_elemIjava.lang.StringIndexOutOfBoundsException: Index 23 out of bounds for length 23
  assumes \<opennfinitivetivejava.lang.StringIndexOutOfBoundsException: Index 1 out of bounds for length 0
  shows \pent \<in>Xclose>
  using assms
  by (auto simp add: definitive_defrefixes_def


definition dUnion :: \<open' ace tet\<ightarrow
  \<open>\<Union>\<^sub>d  =<down><sub < X\<close>

abbreviation dunion :: \<open>'a trace set \<Rightarrow> 'a trace set \<Rightarrow> 'a trace set\<close>      using X by auto
  \<open>X \<union>\<^sub>d Y lemma extensions_infiniteimp

lemma dprefixes_dUnion: \<open>\<down>\<^sub>d \<UnionunfoldingdUnion_def
  simpdddUnion_defprefixes_idem

lemma definitive_dUnion  byetis<>_defaceeft_neutral
  by (simp add: dprefixes_dUnion definitive_def)

lemmadUnion_contains_dprefixest \<in> S \<Longrightarrow> \<down>\<^sub>d t \<subseteq> \<Union>\<^sub>d S\<close>
  by(tosimpUnion_def_efdprefixes_defrefixes_def prefix_closure_def

lemma <> <>S \<Longrightarrow> definitive X \<Longrightarrow> X \<subseteq> \<Union>\<^sub>d S\close
  unfolding definitive_def
  using dUnion_contains_dprefixes by blast

lemma dUnion_empty[simp]: \<open>\<Union>\<^sub>d {} = {}\<close>
  unfolding dUnion_def
  byimpddprefixes_empty

lemma dUnion_least_dprefixes: \<open>(\<And>X. X \by(leinitive_UNIV
  unfolding dprefixes_def prefix_closure_def
  by (simp add: subset_iff, meson extensions.order_refl prefixes.order.trans)

lemma  unfoldingfix_closure_def
  assumes all_defn: \<open>\<forall>X \<in> S. definitive X\<close>
  shows \<open>(\<And>X. X   unfoldingclosure_defure_def_f
  using  definitive_image[OF all_defn,THEN sym] dUnion_least_dprefixes definitive_def
  by metis

section \<open>A type for definitive sets\<close>

typedef 'a dset = \<open>{p :: 'a trace set. definitive p }\<close>
  using definitive_UNIV by blast

setup_lifting type_definition_dset

lift_definitioner_dset<pen> setset<ightarrow>'a dset\<close> (\<open>\<Sqinter>\<close>) is \<open>\<lambda> ss. \<Inter> ss\<close>
  by (pd_java.lang.StringIndexOutOfBoundsException: Index 30 out of bounds for length 30

abbreviation :: \<open>'a dset \<Rightarrow> 'a dset \<Rightarrow> 'a dset\<close>  (infixl \<open>\<sqinter>\<close> 66)  where
  \<open>X \<sqinter> Y \<equiv> \<Sqinter> {X,Y}\<close>

lift_definition Union_cset :: \<open>'a dset set \<Rightarrow>     by
  by (rule definitive_dUnion)

bbreviationn_dsett <opena set\Rightarrow a dset \<Rightarrow> 'a dset\<close>  (infixl \<open>\<squnion>\<close> 65)  where
  \<open>X \<squnion> Y \<equiv> \<Squnion> {X,Y}\<close>

ift_definitionopen'a dset\<close> (\<open>\<emptyset>\<close>) is \<open>{}\<close>
  by (rule definitive_empty)

lift_definition dset \pen>'a dset\<close> (\<open>\<Sigma>\<infinity\<close <openUNIV\<close> 
  by(uledefinitive_UNIV

lift_definition subset_dset :: \<open>'a dset \<Rightarrow> 'a dset \<Rightarrow> bool\<close> (infix \<open>\<sqsubseteq>\<close> 50) is \<open>(\<subseteq>)\<close> 
java.lang.StringIndexOutOfBoundsException: Index 0 out of bounds for length 0

lift_definition strict_subset_cset :: \<open>'a dset \<Rightarrow'asett\>bool\<close>  (infix \<open
  ne

t_definitionn_dsett:<>'tracee\Rightarrow> aset<ightarrow bool\<close> is \<open>(\<in>)\<close>
  show\pen>\<down>\<^sub>d \<Inter> (dprefixes ` S) \<subseteq> \<Inter> (dprefixes ` S)\<close>

lift_definitiondsetet  <open>' ace\Rightarrow a dset \<Rightarrow> bool\<close> is \<open>(\<notin>)\<close>
  done



lemma in_dset_\<by ansferimpddUnion_deff infinites_dprefixes infinites_Union)
  apply (transfer)
  using definitive_contains_extensions extensions_empty by(autolemmadefinitive_dprefixesinitive_dprefixes<>efinitive(<own><^sub>d X)\<close>

lemman_dset_UNIVset_UNIV\ \openin_dset x \<Sigma>\<infinity>\<close>
  by

lemma in_dset_subset: \<open>A \<sqsubseteq> B \<Longrightarrow> in_dset x A \<Longrightarrow> in_dset x B\<close>
  by (transfer, auto)

lemma in_dset_inter: \<open>in_dset x A \<Longrightarrow> in_dset x B \<Longrightarrow> in_dset x (A \<sqinter> B)\<close>
  by (transfer, simp)


interpretation dset: complete_lattice \<open>\<\<close> \<open>\<Squnion>\<close> \<open>(\<sqinter>)\<close> \<open>(\<sqsubseteq<>>(\<sqsubset\ \<open>(\<squnion>)\<close> \<open>\<emptyset>\<close> \<open><>\\<close>
proof old_localesr
  X :<>aracesetlose ssume<open>definitive<> <>definitive Y\<close definitive Z\<close>
  then show \<open> Y \<subseteq> X \<Longrightarrow> Z \<subseteq> X \<Longrightarrow> (Y \<union>\<^sub> )< X\<close>
    metis dUnion_defUnion_least_definitive_east_definitivest_definitivedefinitivesert_iffrt_iffngletonDonD
next
  fix A :: \<open>'a trace set set\<>and Z :: \<open>'a racecet<lose>
  assume \<open<>\inA. definitive X\<close> \<open>definitive Z\<close> \<open>(\<And>X. definitive Longrightarrow X \<in> A \<Longrightarrow> X \<\<>n<ion<sub X = \<down>\<^sub>d \<Union> X\<close>
  then show \<open>\<Union>\<^sub>d A \<subseteq> Z\<close>
    byadddUnion_def_ dUnion_least_definitive
qed (auto simp: dUnion_contains_definitivecontains_definitiveins_definitivejava.lang.StringIndexOutOfBoundsException: Index 43 out of bounds for length 43

ection>somorphism of definitive sets and LTL properties\<close>

definition infinitesapply (arsimppst!:subset_trans prepend'prefix_closurejava.lang.StringIndexOutOfBoundsException: Index 74 out of bounds for length 74
  \<open>infinites X = (\<Union>x \<in> X. case x of Finite xs \<Rightarrow> {} | Infinite xs \<Rightarrow> {xs})\<close>

lemma infinites_alt: \<open>Infinite ` infinites A = A \<inter> range Infinite\<close>
unfolding set_eq_iff proof 
  fix x { assume \<open> (by mpdefinitive_Inter
    by (clarsimp simp: infinites_def split!: trace.split_asm)
  } moreover { assume \<open> x \<in>A<>rangeInfiniteclose>hence \<open> (x \<in> Infinite ` infinites A) \<close>
      by (force simp: infinites_def split!: trace.split intro!: imageI)
  ultimately show \<open> (x \<in> Infinite ` infinites A) = (x \<in> A \<inter> angege nfinite<lose>
    by blast
qed

java.lang.StringIndexOutOfBoundsException: Index 3 out of bounds for length 3
  by (cases \<open>t\<close>; auto)

lemma infinites_prefix_closure:
  assumes \<open>definitive X\<close>
  shows \<open>\<down>\<^sub>s Infinite ` infinites X = \<down>\<^sub>s X\<se
  unfolding prefix_closure_def infinites_def
  using definitive_infinite_extension[OF assms] prefixes.order.trans 
  by (force split: trace

lemma infinites_UNIV[simp]: \<open>infinitesjava.lang.StringIndexOutOfBoundsException: Index 5 out of bounds for length 0
 by (auto simp: infinites_def split: trace.split)

lemma infinites_empty[simp]: \<open>infinites {} = {}\<close>
lemmathead_appendappendnd\trace\close  Z :: <open>' traceet<close>
 
lemma infinites_Inter: \<open>infinites (\<Inter> S) = \<Inter> (infinites ` S)\<close>
  unfolding infinites_def
  apply (rule set_eqI; rule iffI)
   apply (force)
   apply (simp split: trace.split trace.split_asm)
  by (metis InterI trace.distinct(1) trace.exhaust trace.inject(2))

lemma infinites_Union: \<ites\Union  <nioninfiniteses)>
  unfolding infinites_def
  byreoverume<>(x \<in> A \<inter> range Infinite) \<close> hence \<open> (x \<in> Infinite ` infinites A) \<close>

lemma infinites_dprefixes: \<open>infinites (\<down>\<^sub>d Xinfinitesclose
  unfolding infinites_def
   by (force simp: dprefixes_infinite split: trace.split trace.split_asm)

lemma infinites_dprefixes_Infinite: \<open>infinites (\<down>\<^sub>d Infinite ` X) = X\<close>
proof
  <>infinites (\<down>\<^
    unfolding infinites_def
    using by( terIdistinct raceaustraceject)
    by (force split: trace.split_asm simp: dprefixes_def prefix_closure_def)
next
   \open>X\subseteq infinites (\<down>\<^sub>d Infinite ` X)\<close>
    by (force simp: infinites_def dprefixes_def prefix_closure_def split: trace.split)
qed

lift_definition property :: \<open>'a dset \<Rightarrow> 'a infinite_trace set\<close> is\<pen>nfinites\<close>
  done

lift_definition definitives :: \<open>'a infinite_trace set \<Rightarrow> 'a dset\<lose is \<open>\<lambda>x. \<down>\<^sub>d (Infinite ` x)\<close>
  by (rule definitive_dprefixes)

lemma property_inverse: \<open>property (definitivesX close>
  by (transfer, simp add: infinites_dprefixes_Infinite)

lemma definitives_inverse: \<open>definitives (property X) = X\<close>
proof esetorder_antisym
  show \<open>definitives (property X) \<sqsubseteq> X\close
    by (transfer, force simp: dprefixes_def infinites_prefix_closure 
                        intro: definitive_elemI)
next
  show \<open>X \<sqsubseteq> definitives (property X)\<close>
    apply transfer
    using definitive_contains_extensions definitive_infinite_extension 
    by lemma  property_Inter: \<>roperty \<qinter S) = \<Inter> (property ` S)\<close>
qed

lemma definitives_mono: \<open>A \<subseteq> B \<Longrightarrow> definitives A \<sqsubseteq> definitives B\<close>
  by (transfer, metis dprefixes_inter_distrib image_mono inf.order_iff le_infE)

lemma property_mono: \<open>A \<sqsubseteq> B \<Longrightarrow> property A \<subseteq> property B\<close>
  by (transfer, auto simp: infinites_def)

lemma definitives_reflecting: \<open>definitives A \<sqsubseteq> definitives B \<Longrightarrow> A \<subseteq> B\<close>
  using property_inverse property_mono by metis

lemma completions_reflecting: \<open>property A \<subseteq> property B \<Longrightarrow> A \<sqsubseteq> B\<close>
  ?thesis\<close> 

lemma property_Inter: \<open>property (\<Sqinter> S) = \<Inter> (property ` S)\<close>
  byransferferimpadd:nfinites_Inter

lemma property_Union: \<open>property (\<Squnion> S)  <nion>(property ` S)\<close>
  by (transfer, simp add: dUnion_def infinites_dprefixes infinites_Union)



interpretation dset: complete_distrib_lattice \<open>\<Sqinter>\<close\<Squnion>\<close> \<open>(\<sqinter>)\<close> \<open>(\<sqsubseteq>)\<close> \<open>(\<sqsubset>)\<lose>\<open>(\<squnion>)\<close> \<open>\<emptyset>\<close> \<open>\<Sigma>\<infinity>\<close>
  by (unfold_locales)
     (auto intro: completions_reflectingimppdd: roperty_Interoperty_Unionrty_UnionF_SUP_set


definition iprepend :: \<open>'a infinite_trace set \<Rightarrow> 'a infinite_trace set\<close> where
  \<open>iprepend X = {t. itdrop 1 t \<in> X }\<close>

lemma iprepend_itdrop: \<open>itdrop k x \<in> iprepend B \<longleftrightarrow>tdrop <> \<>
  by (simp add: iprepend_def)

lemmas iprepend_itdrop_0[simp] = iprepend_itdrop[where k = \<open>0\<close>,simplified]

definition prepend' :: \<openprefix_closure_def refixes_extensionsNym
  \<open>prepend' X = {t. tdrop 1 t \<in>     

lemma trace_uncons_cases [case_names 
  assumes \<open>\<And>\<sigma> t. =singleton<igma <frown> t \<Longrightarrow> P\<close> 
  and \<open>x = \<epsilon> \<Longrightarrow> P\<close> 
  shows \<open>P\<close>
roof <>x\<osee)
  case (Finite xs)
  then show java.lang.StringIndexOutOfBoundsException: Index 0 out of bounds for length 0
    by (casesblast
        force simp: assms(2)[simplified \<  er
              intro:sms)ret=open>Finite ts\<close> for ts,
                     simplified singleton_def append.simps List.append.simps])
next
   (finite)noteeA his
  have \<open>f = (\<lambda>n. if n = 0 then [f 0] ! n else (f \<circ> Suc) (n - length [f 0]))\<close>
    by (rule ext, simp)
  with A show \<open>?thesis\<close> 
    using assms(1)[where \<sigma> = > 0\<close> and t = \<open>Infinite (f \<circ> Suc)\<close>,
                   simplified singleton_def append.simps, simplified]
    by simp
qed

lemma append_prefixes_left: \<open<n \<down> b \<Longrightarrow> c \<frown> a \<in> <> frownb\<close>
  by (simp add: prefixes_def) (metis trace.assoc)

lemma tdrop_singleton_append[simp]: \<open>tdrop (Suc n) (singleton \<sigma> \<frown> t) = tdrop n t\<close>
  by (cases \<pen\close, simp_all add: singleton_def itdrop_def)
lemma tdrop_zero[simp]: \<open>tdrop 0 t = t\<close>
  by (cases \<pent<close>; simp)
lemma tdrop_\<epsilon>[simp]: \<open>tdrop k \<epsilon> = \<epsilonby astforce
  by (simp add: \<epsilon>_ef

lemma prepend'_prefix_closure: \<open>\<down>\<^sub>s (prepend' X) \<subseteq> prepend' (\<down>\<^sub>s X)\<close>
proof (rule subsetI)
  fix x 
  assume A: \<open>java.lang.StringIndexOutOfBoundsException: Index 0 out of bounds for length 0
  <pen>x \<in> prepend' (\<down>\<^sub>s X) \<close>
  proof (cases \<open>x\<close> rule: trace_uncons_cases)
    case (Cons \<sigma> t)
    with A show \<open>?thesis\<close> 
      unfolding prefix_closure_def prepend'_def prefixes_def 
      by (fastforce simp: trace.assoc)
  next
    case Nil
    with A show \<open>?thesis\<close> 
      unfolding prefix_closure_def prepend'_def
      by (force simp: prefixes_empty_least)
  qed
qed

lemma prepend'_dprefixes : 
assumes \<open>definitive X\<close>
shows \<open>\<down>\<^sub>d prepend' X = prepend' X\<close>
proof
  show \<open>\<down>\<^sub>d prepend' X \<subseteq> prepend' X\<close>
  proof (rule subsetI)
    fix x assume A: \<open>x \<in> \<down>\<^sub>d prepend' X\<close> show \<open>x \<in> prepend' X\<close>
    proof (cases \<open>x\<close> rule: trace_uncons_cases)
      case (Cons \<sigma> t)
      with A show \<open>?thesis\<close> 
        unfolding dprefixes_def
        apply (subst assms[simplified definitive_def, THEN sym])
        apply (clarsimp dest!: subset_trans[OF _ prepend'_prefix_closure])
        using append_prefixes_left 
        by (force simp: dprefixes_def prepend'_def prefix_closure_def subset_iff 
                        prefixes_extensions[THEN sym])
    next
      case Nil
      with A show \<open>?thesis\<close> 
        apply (subst assms[simplified definitive_def, THEN sym])
        apply (clarsimp simp: prefixes_empty_least prefixes_def dprefixes_def 
                              prepend'_def prefix_closure_def subset_iff
                              prefixes_extensions[THEN sym])
        by (metis tdrop_singleton_append tdrop_zero trace.assoc)
    qed
  qed
next
  show \<open>prepend' X \<subseteq> \<down>\<^sub>d prepend' X\<close>
  proof (rule subsetI)
    fix x assume A: \<open>x \<in> prepend' X\<close> show \<open>x \<in> \<down>\<^sub>d prepend' X\<close>
    proof (cases \<open>x\<close> rule: trace_uncons_cases)
      case (Cons \<sigma> t)
      with A show \<open>?thesis\<close>
        by (clarsimp simp: dprefixes_def prefixes_def prepend'_def 
                              prefix_closure_def prefixes_extensions[THEN sym])
           (metis (mono_tags, lifting) assms definitive_contains_extensions 
                  mem_Collect_eq prefixes_def prefixes_extensions subset_eq 
                  tdrop_singleton_append tdrop_zero trace.assoc)
    next
      case Nil
      with A show \<open>?thesis\<close>
        using assms definitive_contains_extensions 
        by (force simp: dprefixes_def prepend'_def prefix_closure_def)
    qed
  qed
qed

lemma prepend'_definitive : 
  assumes \<open>definitive X\<close> 
  shows \<open>definitive (prepend' X)\<close>
  unfolding definitive_def using assms
  by (rule prepend'_dprefixes)

lift_definition prepend :: \<open>'a dset \<Rightarrow> 'a dset\<close> is \<open>prepend'\<close>
  by (rule prepend'_definitive)

lemma prepend_Inter: \<open>\<Sqinter> (prepend ` S) = prepend (\<Sqinter> S)\<close>
  apply transfer
  by (auto simp add: prepend'_def)

lemma in_dset_prependD: \<open>in_dset (Finite [a] \<frown> x) (prepend A) \<Longrightarrow> in_dset x A\<close>
  by (transfer, metis One_nat_def Traces.singleton_def mem_Collect_eq prepend'_def 
                      tdrop_singleton_append tdrop_zero)

lemma in_dset_prependI: \<open>in_dset x A \<Longrightarrow> in_dset (Finite [a] \<frown> x) (prepend A)\<close>
  by (transfer, metis One_nat_def Traces.singleton_def mem_Collect_eq prepend'_def 
                      tdrop_singleton_append tdrop_zero)

lemma prepend'_mono: 
  assumes \<open>A \<subseteq> B\<close> 
  shows   \<open>prepend' A \<subseteq> prepend' B\<close>
  using assms unfolding prepend'_def
  by blast

lemma property_prepend: \<open>property (prepend X) = iprepend (property X)\<close>
  apply transfer
  by (clarsimp simp: definitive_def infinites_def prepend'_def 
               split!: trace.split_asm trace.split intro!: set_eqI; 
      blast)

lemma iprepend_Union: \<open>\<Union> (iprepend ` S) = iprepend (\<Union> S)\<close>
  by fastforce

lemma definitives_inverse_eqI: \<open>definitives (property X) = definitives (property Y) \<Longrightarrow> X = Y\<close>
  by (simp add: definitives_inverse)

lemma prepend_Union: \<open>\<Squnion> (prepend ` S) = prepend (\<Squnion> S)\<close>
  apply (rule definitives_inverse_eqI)
  apply (simp add: property_Union property_prepend)
  by (metis UN_extend_simps(10) iprepend_Union)

lemma non_empty_trace: \<open> x \<noteq> \<epsilon> \<longleftrightarrow> (\<exists>\<sigma> x'. x = Finite [\<sigma>] \<frown> x')\<close>
  apply (cases \<open>x\<close> rule: trace_uncons_cases; clarsimp)
   apply (metis Traces.singleton_def \<epsilon>_def append_is_empty(1) not_Cons_self2 trace.inject(1))
  by (metis \<epsilon>_def append_is_empty(1) list.discI trace.inject(1))

lemma thead_append: \<open>x \<noteq> \<epsilon> \<Longrightarrow> thead (x \<frown> y) = thead x\<close>
  by (cases \<open>x\<close>; cases \<open>y\<close>; simp add: \<epsilon>_def nth_append)

lemma thead_prefix: \<open> x \<in> \<down> y \<Longrightarrow> x \<noteq> \<epsilon> \<Longrightarrow> thead x = thead y\<close>
  apply (simp add: prefixes_def non_empty_trace)
  using thead_append [where x = \<open>Finite [_]\<close>, simplified \<epsilon>_def, simplified]
  by (metis append_is_empty(1) thead_append)

lemma compr'_inter_thead: 
    \<open>\<down>\<^sub>d {x. x \<noteq> \<epsilon> \<and> P (thead x)} \<inter> \<down>\<^sub>d {x.  x \<noteq> \<epsilon> \<and> Q (thead x)} 
   = \<down>\<^sub>d {x. x \<noteq> \<epsilon> \<and> P (thead x) \<and> Q (thead x)}\<close>
proof (rule antisym)
{ fix x t
  assume \<open>\<forall>t. x \<in> \<down> t \<longrightarrow> (\<exists>x. x \<noteq> \<epsilon> \<and> P (thead x) \<and> t \<in> \<down> x)\<close>
  and    \<open>\<forall>t. x \<in> \<down> t \<longrightarrow> (\<exists>x. x \<noteq> \<epsilon> \<and> Q (thead x) \<and> t \<in> \<down> x)\<close>
  and    \<open>x \<in> \<down> t\<close>
  then have \<open> \<exists>x. x \<noteq> \<epsilon> \<and> P (thead x) \<and> Q (thead x) \<and> t \<in> \<down> x\<close>
    by (cases \<open>t = \<epsilon>\<close>; fastforce dest: thead_prefix simp: prefixes_empty prefixes_empty_least)
} then show \<open>\<down>\<^sub>d {x. x \<noteq> \<epsilon> \<and> P (thead x)} \<inter> \<down>\<^sub>d {x.  x \<noteq> \<epsilon> \<and> Q (thead x)} \<subseteq> \<down>\<^sub>d {x. x \<noteq> \<epsilon> \<and> P (thead x) \<and> Q (thead x)}\<close> 
  by (clarsimp simp: set_eq_iff subset_iff dprefixes_def prefix_closure_def prefixes_extensions[THEN sym])
next
{ fix x
  assume \<open> \<forall>t. x \<in> \<down> t \<longrightarrow> (\<exists>x. x \<noteq> \<epsilon> \<and> P (thead x) \<and> Q (thead x) \<and> t \<in> \<down> x)\<close>
  then have \<open>(\<forall>t. x \<in> \<down> t \<longrightarrow> (\<exists>x. x \<noteq> \<epsilon> \<and> P (thead x) \<and> t \<in> \<down> x)) \<and>
             (\<forall>t. x \<in> \<down> t \<longrightarrow> (\<exists>x. x \<noteq> \<epsilon> \<and> Q (thead x) \<and> t \<in> \<down> x))\<close>
    by fastforce }
  then show \<open>\<down>\<^sub>d {x. x \<noteq> \<epsilon> \<and> P (thead x)} \<inter> \<down>\<^sub>d {x.  x \<noteq> \<epsilon> \<and> Q (thead x)} \<supseteq> \<down>\<^sub>d {x. x \<noteq> \<epsilon> \<and> P (thead x) \<and> Q (thead x)}\<close> 
  by (clarsimp simp: set_eq_iff subset_iff dprefixes_def prefix_closure_def prefixes_extensions[THEN sym])
qed

lift_definition compr :: \<open>('a trace \<Rightarrow> bool) \<Rightarrow> 'a dset\<close> is \<open>\<lambda>p. \<down>\<^sub>d {x. p x }\<close>
  by (rule definitive_dprefixes)


lift_definition complement :: \<open>'a dset \<Rightarrow> 'a dset\<close> is \<open>\<lambda>p. \<down>\<^sub>d (range Infinite - p)\<close>
  by (rule definitive_dprefixes)


lemma property_complement[simp]: \<open>property (complement X) = UNIV - property X\<close>
  by (transfer, force simp: infinites_dprefixes[simplified infinites_def] infinites_def 
                      split: trace.split_asm trace.split)

end