Theory Process_Restriction_Space
section ‹Depth Operator›
theory Process_Restriction_Space
imports "Restriction_Spaces-HOLCF" "HOL-CSP.Basic_CSP_Laws"
begin
subsection ‹Definition›
instantiation process⇩p⇩t⇩i⇩c⇩k :: (type, type) order_restriction_space
begin
lift_definition restriction_process⇩p⇩t⇩i⇩c⇩k ::
‹[('a, 'r) process⇩p⇩t⇩i⇩c⇩k, nat] ⇒ ('a, 'r) process⇩p⇩t⇩i⇩c⇩k›
is ‹λP n. (ℱ P ∪ {(t @ u, X) |t u X. t ∈ 𝒯 P ∧ length t = n ∧ tF t ∧ ftF u},
𝒟 P ∪ { t @ u |t u. t ∈ 𝒯 P ∧ length t = n ∧ tF t ∧ ftF u})›
proof -
show ‹?thesis P n› (is ‹is_process (?f, ?d)›) for P and n
proof (unfold is_process_def FAILURES_def fst_conv DIVERGENCES_def snd_conv, intro conjI impI allI)
show ‹([], {}) ∈ ?f› by (simp add: process_charn)
next
show ‹(t, X) ∈ ?f ⟹ ftF t› for t X
by simp (meson front_tickFree_append is_processT)
next
fix t u
assume ‹(t @ u, {}) ∈ ?f›
then consider ‹(t @ u, {}) ∈ ℱ P›
| t' u' where ‹t @ u = t' @ u'› ‹t' ∈ 𝒯 P› ‹length t' = n› ‹tF t'› ‹ftF u'› by blast
thus ‹(t, {}) ∈ ?f›
proof cases
assume ‹(t @ u, {}) ∈ ℱ P›
with is_processT3 have ‹(t, {}) ∈ ℱ P› by auto
thus ‹(t, {}) ∈ ?f› by fast
next
fix t' u' assume * : ‹t @ u = t' @ u'› ‹t' ∈ 𝒯 P› ‹length t' = n› ‹tF t'› ‹ftF u'›
show ‹(t, {}) ∈ ?f›
proof (cases ‹t ≤ t'›)
assume ‹t ≤ t'›
with "*"(2) is_processT3_TR have ‹t ∈ 𝒯 P› by auto
thus ‹(t, {}) ∈ ?f› by (simp add: T_F)
next
assume ‹¬ t ≤ t'›
with "*"(1) have ‹t = t' @ take (length t - length t') u'›
by (metis (no_types, lifting) Prefix_Order.prefixI append_Nil2
diff_is_0_eq nle_le take_all take_append take_eq_Nil)
with "*"(2, 3, 4, 5) show ‹(t, {}) ∈ ?f›
by simp (metis append_take_drop_id front_tickFree_dw_closed)
qed
qed
next
show ‹(t, Y) ∈ ?f ∧ X ⊆ Y ⟹ (t, X) ∈ ?f› for t X Y
by simp (meson is_processT4)
next
show ‹(t, X) ∈ ?f ∧ (∀c. c ∈ Y ⟶ (t @ [c], {}) ∉ ?f) ⟹ (t, X ∪ Y) ∈ ?f› for t X Y
by (auto simp add: is_processT5)
next
show ‹(t @ [✓(r)], {}) ∈ ?f ⟹ (t, X - {✓(r)}) ∈ ?f› for t r X
by (simp, elim disjE exE, solves ‹simp add: is_processT6›)
(metis append_assoc butlast_snoc front_tickFree_dw_closed
nonTickFree_n_frontTickFree non_tickFree_tick tickFree_append_iff)
next
from front_tickFree_append is_processT7 tickFree_append_iff
show ‹t ∈ ?d ∧ tF t ∧ ftF u ⟹ t @ u ∈ ?d› for t u by fastforce
next
from D_F show ‹t ∈ ?d ⟹ (t, X) ∈ ?f› for t X by blast
next
show ‹t @ [✓(r)] ∈ ?d ⟹ t ∈ ?d› for t r
by simp (metis butlast_append butlast_snoc front_tickFree_iff_tickFree_butlast is_processT9
non_tickFree_tick tickFree_Nil tickFree_append_iff tickFree_imp_front_tickFree)
qed
qed
subsection ‹Projections›
context fixes P :: ‹('a, 'r) process⇩p⇩t⇩i⇩c⇩k› begin
lemma F_restriction_process⇩p⇩t⇩i⇩c⇩k :
‹ℱ (P ↓ n) = ℱ P ∪ {(t @ u, X) |t u X. t ∈ 𝒯 P ∧ length t = n ∧ tF t ∧ ftF u}›
by (simp add: Failures_def FAILURES_def restriction_process⇩p⇩t⇩i⇩c⇩k.rep_eq)
lemma D_restriction_process⇩p⇩t⇩i⇩c⇩k :
‹𝒟 (P ↓ n) = 𝒟 P ∪ {t @ u |t u. t ∈ 𝒯 P ∧ length t = n ∧ tF t ∧ ftF u}›
by (simp add: Divergences_def DIVERGENCES_def restriction_process⇩p⇩t⇩i⇩c⇩k.rep_eq)
lemma T_restriction_process⇩p⇩t⇩i⇩c⇩k :
‹𝒯 (P ↓ n) = 𝒯 P ∪ {t @ u |t u. t ∈ 𝒯 P ∧ length t = n ∧ tF t ∧ ftF u}›
using F_restriction_process⇩p⇩t⇩i⇩c⇩k by (auto simp add: Failures_def Traces_def TRACES_def)
lemmas restriction_process⇩p⇩t⇩i⇩c⇩k_projs = F_restriction_process⇩p⇩t⇩i⇩c⇩k D_restriction_process⇩p⇩t⇩i⇩c⇩k T_restriction_process⇩p⇩t⇩i⇩c⇩k
lemma D_restriction_process⇩p⇩t⇩i⇩c⇩kE:
assumes ‹t ∈ 𝒟 (P ↓ n)›
obtains ‹t ∈ 𝒟 P› and ‹length t ≤ n›
| u v where ‹t = u @ v› ‹u ∈ 𝒯 P› ‹length u = n› ‹tF u› ‹ftF v›
proof -
note assms = that
from ‹t ∈ 𝒟 (P ↓ n)› have ‹ftF t› by (simp add: D_imp_front_tickFree)
from ‹t ∈ 𝒟 (P ↓ n)› consider ‹t ∈ 𝒟 P›
| u v where ‹t = u @ v› ‹u ∈ 𝒯 P› ‹length u = n› ‹tF u› ‹ftF v›
by (simp add: D_restriction_process⇩p⇩t⇩i⇩c⇩k) blast
thus thesis
proof cases
show ‹t = u @ v ⟹ u ∈ 𝒯 P ⟹ length u = n ⟹ tF u ⟹ ftF v ⟹ thesis› for u v
by (fact assms(2))
next
show thesis if ‹t ∈ 𝒟 P›
proof (cases ‹length t ≤ n›)
from ‹t ∈ 𝒟 P› show ‹length t ≤ n ⟹ thesis› by (rule assms(1))
next
show thesis if ‹¬ length t ≤ n›
proof (intro assms(2) exI)
show ‹t = take n t @ drop n t› by simp
next
show ‹take n t ∈ 𝒯 P› by (metis D_T ‹t ∈ 𝒟 P› append_take_drop_id is_processT3_TR_append)
next
show ‹length (take n t) = n› by (simp add: min_def ‹¬ length t ≤ n›)
next
show ‹tF (take n t)› by (metis ‹ftF t› append_take_drop_id drop_eq_Nil2
front_tickFree_append_iff ‹¬ length t ≤ n›)
next
show ‹ftF (drop n t)› by (metis ‹ftF t› append_take_drop_id drop_eq_Nil
front_tickFree_append_iff that)
qed
qed
qed
qed
lemma F_restriction_process⇩p⇩t⇩i⇩c⇩kE :
assumes ‹(t, X) ∈ ℱ (P ↓ n)›
obtains ‹(t, X) ∈ ℱ P› and ‹length t ≤ n›
| u v where ‹t = u @ v› ‹u ∈ 𝒯 P› ‹length u = n› ‹tF u› ‹ftF v›
proof -
from ‹(t, X) ∈ ℱ (P ↓ n)› consider ‹(t, X) ∈ ℱ P› | ‹t ∈ 𝒟 (P ↓ n)›
unfolding restriction_process⇩p⇩t⇩i⇩c⇩k_projs by blast
thus thesis
proof cases
show ‹(t, X) ∈ ℱ P ⟹ thesis›
by (metis F_T F_imp_front_tickFree append_take_drop_id
drop_eq_Nil front_tickFree_nonempty_append_imp
is_processT3_TR_append length_take min_def that)
next
show ‹t ∈ 𝒟 (P ↓ n) ⟹ thesis› by (meson D_restriction_process⇩p⇩t⇩i⇩c⇩kE is_processT8 that)
qed
qed
lemma T_restriction_process⇩p⇩t⇩i⇩c⇩kE :
‹⟦t ∈ 𝒯 (P ↓ n); t ∈ 𝒯 P ⟹ length t ≤ n ⟹ thesis;
⋀u v. t = u @ v ⟹ u ∈ 𝒯 P ⟹ length u = n ⟹ tF u ⟹ ftF v ⟹ thesis⟧ ⟹ thesis›
by (fold T_F_spec, elim F_restriction_process⇩p⇩t⇩i⇩c⇩kE) (simp_all add: T_F)
lemmas restriction_process⇩p⇩t⇩i⇩c⇩k_elims =
F_restriction_process⇩p⇩t⇩i⇩c⇩kE D_restriction_process⇩p⇩t⇩i⇩c⇩kE T_restriction_process⇩p⇩t⇩i⇩c⇩kE
lemma D_restriction_process⇩p⇩t⇩i⇩c⇩kI :
‹t ∈ 𝒟 P ∨ t ∈ 𝒯 P ∧ (length t = n ∧ tF t ∨ n < length t) ⟹ t ∈ 𝒟 (P ↓ n)›
by (simp add: D_restriction_process⇩p⇩t⇩i⇩c⇩k, elim disjE conjE)
(solves simp, use front_tickFree_Nil in blast,
metis (no_types) T_imp_front_tickFree append_self_conv front_tickFree_nonempty_append_imp
id_take_nth_drop is_processT3_TR_append leD length_take min.absorb4 take_all_iff)
lemma F_restriction_process⇩p⇩t⇩i⇩c⇩kI :
‹(t, X) ∈ ℱ P ∨ t ∈ 𝒯 P ∧ (length t = n ∧ tF t ∨ n < length t) ⟹ (t, X) ∈ ℱ (P ↓ n)›
by (metis (mono_tags, lifting) D_restriction_process⇩p⇩t⇩i⇩c⇩kI F_restriction_process⇩p⇩t⇩i⇩c⇩k Un_iff is_processT8)
lemma T_restriction_process⇩p⇩t⇩i⇩c⇩kI :
‹t ∈ 𝒯 P ∨ t ∈ 𝒯 P ∧ (length t = n ∧ tF t ∨ n < length t) ⟹ t ∈ 𝒯 (P ↓ n)›
using F_restriction_process⇩p⇩t⇩i⇩c⇩kI T_F_spec by blast
lemma F_restriction_process⇩p⇩t⇩i⇩c⇩k_Suc_length_iff_F :
‹(t, X) ∈ ℱ (P ↓ Suc (length t)) ⟷ (t, X) ∈ ℱ P›
and D_restriction_process⇩p⇩t⇩i⇩c⇩k_Suc_length_iff_D :
‹t ∈ 𝒟 (P ↓ Suc (length t)) ⟷ t ∈ 𝒟 P›
and T_restriction_process⇩p⇩t⇩i⇩c⇩k_Suc_length_iff_T :
‹t ∈ 𝒯 (P ↓ Suc (length t)) ⟷ t ∈ 𝒯 P›
by (auto simp add: restriction_process⇩p⇩t⇩i⇩c⇩k_projs)
lemma length_less_in_F_restriction_process⇩p⇩t⇩i⇩c⇩k :
‹length t < n ⟹ (t, X) ∈ ℱ (P ↓ n) ⟹ (t, X) ∈ ℱ P›
by (auto elim: F_restriction_process⇩p⇩t⇩i⇩c⇩kE)
lemma length_le_in_T_restriction_process⇩p⇩t⇩i⇩c⇩k :
‹length t ≤ n ⟹ t ∈ 𝒯 (P ↓ n) ⟹ t ∈ 𝒯 P›
by (auto elim: T_restriction_process⇩p⇩t⇩i⇩c⇩kE)
lemma length_less_in_D_restriction_process⇩p⇩t⇩i⇩c⇩k :
‹length t < n ⟹ t ∈ 𝒟 (P ↓ n) ⟹ t ∈ 𝒟 P›
by (auto elim: D_restriction_process⇩p⇩t⇩i⇩c⇩kE)
lemma not_tickFree_in_F_restriction_process⇩p⇩t⇩i⇩c⇩k_iff :
‹length t ≤ n ⟹ ¬ tF t ⟹ (t, X) ∈ ℱ (P ↓ n) ⟷ (t, X) ∈ ℱ P›
by (auto simp add: F_restriction_process⇩p⇩t⇩i⇩c⇩k)
lemma not_tickFree_in_D_restriction_process⇩p⇩t⇩i⇩c⇩k_iff :
‹length t ≤ n ⟹ ¬ tF t ⟹ t ∈ 𝒟 (P ↓ n) ⟷ t ∈ 𝒟 P›
by (auto simp add: D_restriction_process⇩p⇩t⇩i⇩c⇩k)
end
lemma front_tickFreeE :
‹⟦ftF t; tF t ⟹ thesis; ⋀t' r. t = t' @ [✓(r)] ⟹ tF t' ⟹ thesis⟧ ⟹ thesis›
by (metis front_tickFree_append_iff nonTickFree_n_frontTickFree not_Cons_self2)
subsection ‹Proof obligation›
instance
proof intro_classes
fix P Q :: ‹('a, 'r) process⇩p⇩t⇩i⇩c⇩k›
have ‹P ↓ 0 = ⊥› by (simp add: BOT_iff_Nil_D D_restriction_process⇩p⇩t⇩i⇩c⇩k)
thus ‹P ↓ 0 ⊑⇩F⇩D Q ↓ 0› by simp
next
show ‹P ↓ n ↓ m = P ↓ min n m› for P :: ‹('a, 'r) process⇩p⇩t⇩i⇩c⇩k› and n m
proof (rule Process_eq_optimizedI)
show ‹t ∈ 𝒟 (P ↓ n ↓ m) ⟹ t ∈ 𝒟 (P ↓ min n m)› for t
by (elim restriction_process⇩p⇩t⇩i⇩c⇩k_elims)
(auto simp add: D_restriction_process⇩p⇩t⇩i⇩c⇩k intro: front_tickFree_append)
next
show ‹t ∈ 𝒟 (P ↓ min n m) ⟹ t ∈ 𝒟 (P ↓ n ↓ m)› for t
by (elim restriction_process⇩p⇩t⇩i⇩c⇩k_elims)
(auto simp add: restriction_process⇩p⇩t⇩i⇩c⇩k_projs min_def split: if_split_asm)
next
fix t X assume ‹(t, X) ∈ ℱ (P ↓ n ↓ m)› ‹t ∉ 𝒟 (P ↓ n ↓ m)›
hence ‹(t, X) ∈ ℱ P ∧ length t ≤ min n m›
by (elim F_restriction_process⇩p⇩t⇩i⇩c⇩kE) (auto simp add: restriction_process⇩p⇩t⇩i⇩c⇩k_projs)
thus ‹(t, X) ∈ ℱ (P ↓ min n m)› unfolding F_restriction_process⇩p⇩t⇩i⇩c⇩k by blast
next
fix t X assume ‹(t, X) ∈ ℱ (P ↓ min n m)› ‹t ∉ 𝒟 (P ↓ min n m)›
hence ‹(t, X) ∈ ℱ P ∧ length t ≤ min n m›
by (elim F_restriction_process⇩p⇩t⇩i⇩c⇩kE) (auto simp add: restriction_process⇩p⇩t⇩i⇩c⇩k_projs)
thus ‹(t, X) ∈ ℱ (P ↓ n ↓ m)› unfolding F_restriction_process⇩p⇩t⇩i⇩c⇩k by blast
qed
next
show ‹P ⊑⇩F⇩D Q ⟹ P ↓ n ⊑⇩F⇩D Q ↓ n› for P Q :: ‹('a, 'r) process⇩p⇩t⇩i⇩c⇩k› and n
by (simp add: refine_defs restriction_process⇩p⇩t⇩i⇩c⇩k_projs
flip: T_F_spec) blast
next
fix P Q :: ‹('a, 'r) process⇩p⇩t⇩i⇩c⇩k› assume ‹¬ P ⊑⇩F⇩D Q›
then consider t where ‹t ∈ 𝒟 Q› ‹t ∉ 𝒟 P›
| t X where ‹(t, X) ∈ ℱ Q› ‹(t, X) ∉ ℱ P›
unfolding refine_defs by auto
thus ‹∃n. ¬ P ↓ n ⊑⇩F⇩D Q ↓ n›
proof cases
fix t assume ‹t ∈ 𝒟 Q› ‹t ∉ 𝒟 P›
with D_restriction_process⇩p⇩t⇩i⇩c⇩k_Suc_length_iff_D
have ‹t ∈ 𝒟 (Q ↓ Suc (length t)) ∧ t ∉ 𝒟 (P ↓ Suc (length t))› by blast
hence ‹¬ P ↓ Suc (length t) ⊑⇩F⇩D Q ↓ Suc (length t)› unfolding refine_defs by blast
thus ‹∃n. ¬ P ↓ n ⊑⇩F⇩D Q ↓ n› ..
next
fix t X assume ‹(t, X) ∈ ℱ Q› ‹(t, X) ∉ ℱ P›
with F_restriction_process⇩p⇩t⇩i⇩c⇩k_Suc_length_iff_F
have ‹(t, X) ∈ ℱ (Q ↓ Suc (length t)) ∧ (t, X) ∉ ℱ (P ↓ Suc (length t))› by blast
hence ‹¬ P ↓ Suc (length t) ⊑⇩F⇩D Q ↓ Suc (length t)› unfolding refine_defs by blast
thus ‹∃n. ¬ P ↓ n ⊑⇩F⇩D Q ↓ n› ..
qed
qed
corollary ‹OFCLASS(('a, 'r) process⇩p⇩t⇩i⇩c⇩k, restriction_space_class)›
by intro_classes
end
instance process⇩p⇩t⇩i⇩c⇩k :: (type, type) pcpo_restriction_space
proof intro_classes
show ‹P ↓ 0 ⊑ Q ↓ 0› for P Q :: ‹('a, 'r) process⇩p⇩t⇩i⇩c⇩k›
by (metis below_refl restriction_0_related)
next
show ‹P ↓ n ⊑ Q ↓ n› if ‹P ⊑ Q› for P Q :: ‹('a, 'r) process⇩p⇩t⇩i⇩c⇩k› and n
proof (unfold le_approx_def Refusals_after_def, safe)
from ‹P ⊑ Q›[THEN le_approx1] ‹P ⊑ Q›[THEN le_approx2T]
show ‹t ∈ 𝒟 (Q ↓ n) ⟹ t ∈ 𝒟 (P ↓ n)› for t
by (simp add: D_restriction_process⇩p⇩t⇩i⇩c⇩k subset_iff) (metis D_T)
next
from ‹P ⊑ Q›[THEN le_approx2] ‹P ⊑ Q›[THEN le_approx_lemma_T]
show ‹t ∉ 𝒟 (P ↓ n) ⟹ (t, X) ∈ ℱ (P ↓ n) ⟹ (t, X) ∈ ℱ (Q ↓ n)›
and ‹t ∉ 𝒟 (P ↓ n) ⟹ (t, X) ∈ ℱ (Q ↓ n) ⟹ (t, X) ∈ ℱ (P ↓ n)› for t X
by (auto simp add: restriction_process⇩p⇩t⇩i⇩c⇩k_projs)
next
from ‹P ⊑ Q›[THEN le_approx3] ‹P ⊑ Q›[THEN le_approx2T]
show ‹t ∈ min_elems (𝒟 (P ↓ n)) ⟹ t ∈ 𝒯 (Q ↓ n)› for t
by (simp add: min_elems_def restriction_process⇩p⇩t⇩i⇩c⇩k_projs ball_Un subset_iff)
(metis is_processT7)
qed
next
fix P Q :: ‹('a, 'r) process⇩p⇩t⇩i⇩c⇩k›
assume ‹¬ P ⊑ Q›
then consider t where ‹t ∈ 𝒟 Q› ‹t ∉ 𝒟 P›
| t X where ‹t ∉ 𝒟 P› ‹(t, X) ∈ ℱ P ⟷ (t, X) ∉ ℱ Q›
| t where ‹t ∈ min_elems (𝒟 P)› ‹t ∉ 𝒯 Q›
unfolding le_approx_def Refusals_after_def by blast
thus ‹∃n. ¬ P ↓ n ⊑ Q ↓ n›
proof cases
fix t assume ‹t ∈ 𝒟 Q› ‹t ∉ 𝒟 P›
hence ‹t ∈ 𝒟 (Q ↓ Suc (length t))› ‹t ∉ 𝒟 (P ↓ Suc (length t))›
by (simp_all add: D_restriction_process⇩p⇩t⇩i⇩c⇩k_Suc_length_iff_D)
hence ‹¬ P ↓ Suc (length t) ⊑ Q ↓ Suc (length t)›
unfolding le_approx_def by blast
thus ‹∃n. ¬ P ↓ n ⊑ Q ↓ n› ..
next
fix t X assume ‹t ∉ 𝒟 P› ‹(t, X) ∈ ℱ P ⟷ (t, X) ∉ ℱ Q›
hence ‹t ∉ 𝒟 (P ↓ Suc (length t))›
‹(t, X) ∈ ℱ (P ↓ Suc (length t)) ⟷ (t, X) ∉ ℱ (Q ↓ Suc (length t))›
by (simp_all add: D_restriction_process⇩p⇩t⇩i⇩c⇩k_Suc_length_iff_D
F_restriction_process⇩p⇩t⇩i⇩c⇩k_Suc_length_iff_F)
hence ‹¬ P ↓ Suc (length t) ⊑ Q ↓ Suc (length t)›
unfolding le_approx_def Refusals_after_def by blast
thus ‹∃n. ¬ P ↓ n ⊑ Q ↓ n› ..
next
fix t assume ‹t ∈ min_elems (𝒟 P)› ‹t ∉ 𝒯 Q›
hence ‹t ∈ min_elems (𝒟 (P ↓ Suc (length t)))› ‹t ∉ 𝒯 (Q ↓ Suc (length t))›
by (simp_all add: min_elems_def D_restriction_process⇩p⇩t⇩i⇩c⇩k_Suc_length_iff_D
T_restriction_process⇩p⇩t⇩i⇩c⇩k_Suc_length_iff_T)
(meson length_less_in_D_restriction_process⇩p⇩t⇩i⇩c⇩k less_SucI less_length_mono)
hence ‹¬ P ↓ Suc (length t) ⊑ Q ↓ Suc (length t)›
unfolding le_approx_def by blast
thus ‹∃n. ¬ P ↓ n ⊑ Q ↓ n› ..
qed
next
show ‹chain S ⟹ ∃P. range S <<| P› for S :: ‹nat ⇒ ('a, 'r) process⇩p⇩t⇩i⇩c⇩k›
by (simp add: cpo_class.cpo)
next
show ‹∃P :: ('a, 'r) process⇩p⇩t⇩i⇩c⇩k. ∀Q. P ⊑ Q› by blast
qed
setup ‹Sign.add_const_constraint (\<^const_name>‹restriction›, SOME \<^typ>‹('a, 'r) process⇩p⇩t⇩i⇩c⇩k ⇒ nat ⇒ ('a, 'r) process⇩p⇩t⇩i⇩c⇩k›)›
subsection ‹Compatibility with Refinements›
lemma leF_restriction_process⇩p⇩t⇩i⇩c⇩kI: ‹P ↓ n ⊑⇩F Q ↓ n›
if ‹⋀s X. (s, X) ∈ ℱ Q ⟹ length s ≤ n ⟹ (s, X) ∈ ℱ (P ↓ n)›
proof (unfold failure_refine_def, safe)
show ‹(s, X) ∈ ℱ (Q ↓ n) ⟹ (s, X) ∈ ℱ (P ↓ n)› for s X
proof (elim F_restriction_process⇩p⇩t⇩i⇩c⇩kE exE conjE)
show ‹(s, X) ∈ ℱ Q ⟹ length s ≤ n ⟹ (s, X) ∈ ℱ (P ↓ n)›
by (simp add: F_restriction_process⇩p⇩t⇩i⇩c⇩k) (meson F_restriction_process⇩p⇩t⇩i⇩c⇩kE that)
next
fix s' t'
assume ‹s = s' @ t'› ‹s' ∈ 𝒯 Q› ‹length s' = n› ‹tickFree s'› ‹front_tickFree t'›
from ‹s' ∈ 𝒯 Q› ‹length s' = n› have ‹s' ∈ 𝒯 P›
by (metis F_T T_F dual_order.refl length_le_in_T_restriction_process⇩p⇩t⇩i⇩c⇩k that)
with ‹s = s' @ t'› ‹length s' = n› ‹tickFree s'› ‹front_tickFree t'›
show ‹(s, X) ∈ ℱ (P ↓ n)› by (simp add: F_restriction_process⇩p⇩t⇩i⇩c⇩k) blast
qed
qed
lemma leT_restriction_process⇩p⇩t⇩i⇩c⇩kI: ‹P ↓ n ⊑⇩T Q ↓ n›
if ‹⋀s. s ∈ 𝒯 Q ⟹ length s ≤ n ⟹ s ∈ 𝒯 (P ↓ n)›
proof (unfold trace_refine_def, safe)
show ‹s ∈ 𝒯 (Q ↓ n) ⟹ s ∈ 𝒯 (P ↓ n)› for s
proof (elim T_restriction_process⇩p⇩t⇩i⇩c⇩kE exE conjE)
show ‹s ∈ 𝒯 Q ⟹ length s ≤ n ⟹ s ∈ 𝒯 (P ↓ n)›
by (simp add: T_restriction_process⇩p⇩t⇩i⇩c⇩k) (meson T_restriction_process⇩p⇩t⇩i⇩c⇩kE that)
next
fix s' t'
assume ‹s = s' @ t'› ‹s' ∈ 𝒯 Q› ‹length s' = n› ‹tickFree s'› ‹front_tickFree t'›
from ‹s' ∈ 𝒯 Q› ‹length s' = n› have ‹s' ∈ 𝒯 P›
using length_le_in_T_restriction_process⇩p⇩t⇩i⇩c⇩k that by blast
with ‹s = s' @ t'› ‹length s' = n› ‹tickFree s'› ‹front_tickFree t'›
show ‹s ∈ 𝒯 (P ↓ n)› by (simp add: T_restriction_process⇩p⇩t⇩i⇩c⇩k) blast
qed
qed
lemma leDT_restriction_process⇩p⇩t⇩i⇩c⇩kI: ‹P ↓ n ⊑⇩D⇩T Q ↓ n›
if ‹⋀s. s ∈ 𝒯 Q ⟹ length s ≤ n ⟹ s ∈ 𝒯 (P ↓ n)›
and ‹⋀s. length s ≤ n ⟹ s ∈ 𝒟 Q ⟹ s ∈ 𝒟 (P ↓ n)›
proof (rule leD_leT_imp_leDT)
show ‹P ↓ n ⊑⇩T Q ↓ n› by (simp add: leT_restriction_process⇩p⇩t⇩i⇩c⇩kI that(1))
next
show ‹P ↓ n ⊑⇩D Q ↓ n›
proof (unfold divergence_refine_def, rule subsetI)
show ‹s ∈ 𝒟 (Q ↓ n) ⟹ s ∈ 𝒟 (P ↓ n)› for s
proof (elim D_restriction_process⇩p⇩t⇩i⇩c⇩kE exE conjE)
show ‹s ∈ 𝒟 Q ⟹ length s ≤ n ⟹ s ∈ 𝒟 (P ↓ n)›
by (simp add: D_restriction_process⇩p⇩t⇩i⇩c⇩k) (meson D_restriction_process⇩p⇩t⇩i⇩c⇩kE that(2))
next
fix s' t'
assume ‹s = s' @ t'› ‹s' ∈ 𝒯 Q› ‹length s' = n› ‹tickFree s'› ‹front_tickFree t'›
from ‹s' ∈ 𝒯 Q› ‹length s' = n› have ‹s' ∈ 𝒯 P›
using length_le_in_T_restriction_process⇩p⇩t⇩i⇩c⇩k that(1) by blast
with ‹s = s' @ t'› ‹length s' = n› ‹tickFree s'› ‹front_tickFree t'›
show ‹s ∈ 𝒟 (P ↓ n)› by (simp add: D_restriction_process⇩p⇩t⇩i⇩c⇩k) blast
qed
qed
qed
lemma leFD_restriction_process⇩p⇩t⇩i⇩c⇩kI: ‹P ↓ n ⊑⇩F⇩D Q ↓ n›
if ‹⋀s X. (s, X) ∈ ℱ Q ⟹ length s ≤ n ⟹ (s, X) ∈ ℱ (P ↓ n)›
and ‹⋀s. s ∈ 𝒟 Q ⟹ length s ≤ n ⟹ s ∈ 𝒟 (P ↓ n)›
proof (rule leF_leD_imp_leFD)
show ‹P ↓ n ⊑⇩F Q ↓ n› by (simp add: leF_restriction_process⇩p⇩t⇩i⇩c⇩kI that(1))
next
show ‹P ↓ n ⊑⇩D Q ↓ n› by (meson T_F_spec leDT_imp_leD leDT_restriction_process⇩p⇩t⇩i⇩c⇩kI that)
qed
subsection ‹First Laws›
lemma restriction_process⇩p⇩t⇩i⇩c⇩k_0 [simp] : ‹P ↓ 0 = ⊥›
by (simp add: BOT_iff_Nil_D D_restriction_process⇩p⇩t⇩i⇩c⇩k)
lemma restriction_process⇩p⇩t⇩i⇩c⇩k_BOT [simp] : ‹(⊥ :: ('a, 'r) process⇩p⇩t⇩i⇩c⇩k) ↓ n = ⊥›
by (simp add: BOT_iff_Nil_D D_restriction_process⇩p⇩t⇩i⇩c⇩k D_BOT)
lemma restriction_process⇩p⇩t⇩i⇩c⇩k_is_BOT_iff :
‹P ↓ n = ⊥ ⟷ n = 0 ∨ P = ⊥›
by (auto simp add: BOT_iff_Nil_D D_restriction_process⇩p⇩t⇩i⇩c⇩k)
lemma restriction_process⇩p⇩t⇩i⇩c⇩k_STOP [simp] : ‹STOP ↓ n = (if n = 0 then ⊥ else STOP)›
by (simp add: STOP_iff_T T_restriction_process⇩p⇩t⇩i⇩c⇩k T_STOP)
lemma restriction_process⇩p⇩t⇩i⇩c⇩k_is_STOP_iff : ‹P ↓ n = STOP ⟷ n ≠ 0 ∧ P = STOP›
by (simp add: STOP_iff_T T_restriction_process⇩p⇩t⇩i⇩c⇩k set_eq_iff)
(metis (no_types, lifting) append_self_conv2 front_tickFree_single gr0I
less_numeral_extra(3) list.discI list.size(3) tickFree_Nil)
lemma restriction_process⇩p⇩t⇩i⇩c⇩k_SKIP [simp] : ‹SKIP r ↓ n = (if n = 0 then ⊥ else SKIP r)›
by simp (auto simp add: Process_eq_spec restriction_process⇩p⇩t⇩i⇩c⇩k_projs SKIP_projs)
lemma restriction_process⇩p⇩t⇩i⇩c⇩k_is_SKIP_iff : ‹P ↓ n = SKIP r ⟷ n ≠ 0 ∧ P = SKIP r›
proof (intro iffI conjI)
show ‹n ≠ 0 ∧ P = SKIP r ⟹ P ↓ n = SKIP r› by simp
next
show ‹P ↓ n = SKIP r ⟹ n ≠ 0› by (metis restriction_process⇩p⇩t⇩i⇩c⇩k_0 SKIP_neq_BOT)
next
show ‹P ↓ n = SKIP r ⟹ P = SKIP r›
by (simp add: Process_eq_spec set_eq_iff SKIP_projs
restriction_process⇩p⇩t⇩i⇩c⇩k_projs, safe; metis)
qed
lemma restriction_process⇩p⇩t⇩i⇩c⇩k_SKIPS [simp] : ‹SKIPS R ↓ n = (if n = 0 then ⊥ else SKIPS R)›
by simp (auto simp add: Process_eq_spec restriction_process⇩p⇩t⇩i⇩c⇩k_projs SKIPS_projs)
lemma restriction_process⇩p⇩t⇩i⇩c⇩k_is_SKIPS_iff : ‹P ↓ n = SKIPS R ⟷ n ≠ 0 ∧ P = SKIPS R›
proof (cases ‹R = {}›)
show ‹R = {} ⟹ P ↓ n = SKIPS R ⟷ n ≠ 0 ∧ P = SKIPS R›
by (simp add: restriction_process⇩p⇩t⇩i⇩c⇩k_is_STOP_iff)
next
show ‹P ↓ n = SKIPS R ⟷ n ≠ 0 ∧ P = SKIPS R› if ‹R ≠ {}›
proof (intro iffI conjI)
show ‹n ≠ 0 ∧ P = SKIPS R ⟹ P ↓ n = SKIPS R› by simp
next
show ‹P ↓ n = SKIPS R ⟹ n ≠ 0›
by (metis BOT_iff_Nil_D D_SKIPS empty_iff restriction_process⇩p⇩t⇩i⇩c⇩k_0)
next
show ‹P ↓ n = SKIPS R ⟹ P = SKIPS R›
by (simp add: Process_eq_spec ‹R ≠ {}› SKIPS_projs
restriction_process⇩p⇩t⇩i⇩c⇩k_projs, safe; blast)
qed
qed
subsection ‹Monotony›
subsubsection ‹\<^term>‹P ↓ n› is an Approximation of the \<^term>‹P››
lemma restriction_process⇩p⇩t⇩i⇩c⇩k_approx_self : ‹P ↓ n ⊑ P›
proof (unfold le_approx_def Refusals_after_def, safe)
show ‹t ∈ 𝒟 P ⟹ t ∈ 𝒟 (P ↓ n)› for t by (simp add: D_restriction_process⇩p⇩t⇩i⇩c⇩k)
next
show ‹t ∉ 𝒟 (P ↓ n) ⟹ (t, X) ∈ ℱ (P ↓ n) ⟹ (t, X) ∈ ℱ P› for t X
by (auto simp add: D_restriction_process⇩p⇩t⇩i⇩c⇩k elim: F_restriction_process⇩p⇩t⇩i⇩c⇩kE)
next
show ‹t ∉ 𝒟 (P ↓ n) ⟹ (t, X) ∈ ℱ P ⟹ (t, X) ∈ ℱ (P ↓ n)› for t X
by (auto simp add: restriction_process⇩p⇩t⇩i⇩c⇩k_projs)
next
show ‹t ∈ min_elems (𝒟 (P ↓ n)) ⟹ t ∈ 𝒯 P› for t
by (auto simp add: min_elems_def D_restriction_process⇩p⇩t⇩i⇩c⇩k ball_Un D_T)
(metis append.right_neutral front_tickFree_charn less_append nil_less2)
qed
lemma restriction_process⇩p⇩t⇩i⇩c⇩k_FD_self : ‹P ↓ n ⊑⇩F⇩D P›
by (simp add: le_approx_imp_le_ref restriction_process⇩p⇩t⇩i⇩c⇩k_approx_self)
lemma restriction_process⇩p⇩t⇩i⇩c⇩k_F_self : ‹P ↓ n ⊑⇩F P›
by (simp add: restriction_process⇩p⇩t⇩i⇩c⇩k_FD_self leFD_imp_leF)
lemma restriction_process⇩p⇩t⇩i⇩c⇩k_D_self : ‹P ↓ n ⊑⇩D P›
by (simp add: restriction_process⇩p⇩t⇩i⇩c⇩k_FD_self leFD_imp_leD)
lemma restriction_process⇩p⇩t⇩i⇩c⇩k_T_self : ‹P ↓ n ⊑⇩T P›
by (simp add: restriction_process⇩p⇩t⇩i⇩c⇩k_F_self leF_imp_leT)
lemma restriction_process⇩p⇩t⇩i⇩c⇩k_DT_self : ‹P ↓ n ⊑⇩D⇩T P›
by (simp add: restriction_process⇩p⇩t⇩i⇩c⇩k_D_self restriction_process⇩p⇩t⇩i⇩c⇩k_T_self leD_leT_imp_leDT)
subsubsection ‹Monotony of \<^term>‹(↓)››
lemma Suc_right_mono_restriction_process⇩p⇩t⇩i⇩c⇩k : ‹P ↓ n ⊑ P ↓ Suc n›
by (metis restriction_process⇩p⇩t⇩i⇩c⇩k_approx_self restriction_chainD
restriction_chain_restrictions)
lemma Suc_right_mono_restriction_process⇩p⇩t⇩i⇩c⇩k_FD : ‹P ↓ n ⊑⇩F⇩D P ↓ Suc n›
by (simp add: Suc_right_mono_restriction_process⇩p⇩t⇩i⇩c⇩k le_approx_imp_le_ref)
lemma Suc_right_mono_restriction_process⇩p⇩t⇩i⇩c⇩k_F : ‹P ↓ n ⊑⇩F P ↓ Suc n›
by (simp add: Suc_right_mono_restriction_process⇩p⇩t⇩i⇩c⇩k_FD leFD_imp_leF)
lemma Suc_right_mono_restriction_process⇩p⇩t⇩i⇩c⇩k_D : ‹P ↓ n ⊑⇩D P ↓ Suc n›
by (simp add: Suc_right_mono_restriction_process⇩p⇩t⇩i⇩c⇩k_FD leFD_imp_leD)
lemma Suc_right_mono_restriction_process⇩p⇩t⇩i⇩c⇩k_T : ‹P ↓ n ⊑⇩T P ↓ Suc n›
by (simp add: Suc_right_mono_restriction_process⇩p⇩t⇩i⇩c⇩k_FD leFD_imp_leF leF_imp_leT)
lemma Suc_right_mono_restriction_process⇩p⇩t⇩i⇩c⇩k_DT : ‹P ↓ n ⊑⇩D⇩T P ↓ Suc n›
by (simp add: Suc_right_mono_restriction_process⇩p⇩t⇩i⇩c⇩k_D
Suc_right_mono_restriction_process⇩p⇩t⇩i⇩c⇩k_T leD_leT_imp_leDT)
lemma le_right_mono_restriction_process⇩p⇩t⇩i⇩c⇩k : ‹n ≤ m ⟹ P ↓ n ⊑ P ↓ m›
by (metis restriction_process⇩p⇩t⇩i⇩c⇩k_approx_self restriction_chain_def_ter
restriction_chain_restrictions)
lemma le_right_mono_restriction_process⇩p⇩t⇩i⇩c⇩k_FD : ‹n ≤ m ⟹ P ↓ n ⊑⇩F⇩D P ↓ m›
by (simp add: le_approx_imp_le_ref le_right_mono_restriction_process⇩p⇩t⇩i⇩c⇩k)
lemma le_right_mono_restriction_process⇩p⇩t⇩i⇩c⇩k_F : ‹n ≤ m ⟹ P ↓ n ⊑⇩F P ↓ m›
by (simp add: leFD_imp_leF le_right_mono_restriction_process⇩p⇩t⇩i⇩c⇩k_FD)
lemma restriction_process⇩p⇩t⇩i⇩c⇩k_le_right_mono_D : ‹n ≤ m ⟹ P ↓ n ⊑⇩D P ↓ m›
by (simp add: leFD_imp_leD le_right_mono_restriction_process⇩p⇩t⇩i⇩c⇩k_FD)
lemma restriction_process⇩p⇩t⇩i⇩c⇩k_le_right_mono_T : ‹n ≤ m ⟹ P ↓ n ⊑⇩T P ↓ m›
by (simp add: leF_imp_leT le_right_mono_restriction_process⇩p⇩t⇩i⇩c⇩k_F)
lemma restriction_process⇩p⇩t⇩i⇩c⇩k_le_right_mono_DT : ‹n ≤ m ⟹ P ↓ n ⊑⇩D⇩T P ↓ m›
by (simp add: restriction_process⇩p⇩t⇩i⇩c⇩k_le_right_mono_D
restriction_process⇩p⇩t⇩i⇩c⇩k_le_right_mono_T leD_leT_imp_leDT)
subsubsection ‹Interpretations of Refinements›
lemma ex_not_restriction_leD : ‹∃n. ¬ P ↓ n ⊑⇩D Q ↓ n› if ‹¬ P ⊑⇩D Q›
proof -
from ‹¬ P ⊑⇩D Q› obtain t where ‹t ∈ 𝒟 Q› ‹t ∉ 𝒟 P›
unfolding divergence_refine_def by blast
hence ‹t ∈ 𝒟 (Q ↓ Suc (length t))› ‹t ∉ 𝒟 (P ↓ Suc (length t))›
by (simp_all add: D_restriction_process⇩p⇩t⇩i⇩c⇩k_Suc_length_iff_D)
hence ‹¬ P ↓ Suc (length t) ⊑⇩D Q ↓ Suc (length t)›
unfolding divergence_refine_def by blast
thus ‹∃n. ¬ P ↓ n ⊑⇩D Q ↓ n› ..
qed
interpretation PRS_leF : PreorderRestrictionSpace ‹(↓)› ‹(⊑⇩F)›
proof unfold_locales
show ‹P ↓ 0 ⊑⇩F Q ↓ 0› for P Q :: ‹('a, 'r) process⇩p⇩t⇩i⇩c⇩k› by simp
next
show ‹P ⊑⇩F Q ⟹ P ↓ n ⊑⇩F Q ↓ n› for P Q :: ‹('a, 'r) process⇩p⇩t⇩i⇩c⇩k› and n
by (simp add: failure_refine_def F_restriction_process⇩p⇩t⇩i⇩c⇩k
flip: T_F_spec) blast
next
fix P Q :: ‹('a, 'r) process⇩p⇩t⇩i⇩c⇩k› assume ‹¬ P ⊑⇩F Q›
then obtain t X where ‹(t, X) ∈ ℱ Q› ‹(t, X) ∉ ℱ P›
unfolding failure_refine_def by auto
with F_restriction_process⇩p⇩t⇩i⇩c⇩k_Suc_length_iff_F
have ‹(t, X) ∈ ℱ (Q ↓ Suc (length t)) ∧ (t, X) ∉ ℱ (P ↓ Suc (length t))› by blast
hence ‹¬ P ↓ Suc (length t) ⊑⇩F Q ↓ Suc (length t)› unfolding failure_refine_def by blast
thus ‹∃n. ¬ P ↓ n ⊑⇩F Q ↓ n› ..
next
show ‹P ⊑⇩F Q ⟹ Q ⊑⇩F R ⟹ P ⊑⇩F R› for P Q R :: ‹('a, 'r) process⇩p⇩t⇩i⇩c⇩k›
by (fact trans_F)
qed
interpretation PRS_leT : PreorderRestrictionSpace ‹(↓)› ‹(⊑⇩T)›
proof unfold_locales
show ‹P ↓ 0 ⊑⇩T Q ↓ 0› for P Q :: ‹('a, 'r) process⇩p⇩t⇩i⇩c⇩k› by simp
next
show ‹P ⊑⇩T Q ⟹ P ↓ n ⊑⇩T Q ↓ n› for P Q :: ‹('a, 'r) process⇩p⇩t⇩i⇩c⇩k› and n
by (auto simp add: trace_refine_def T_restriction_process⇩p⇩t⇩i⇩c⇩k)
next
fix P Q :: ‹('a, 'r) process⇩p⇩t⇩i⇩c⇩k› assume ‹¬ P ⊑⇩T Q›
then obtain t where ‹t ∈ 𝒯 Q› ‹t ∉ 𝒯 P›
unfolding trace_refine_def by auto
with T_restriction_process⇩p⇩t⇩i⇩c⇩k_Suc_length_iff_T
have ‹t ∈ 𝒯 (Q ↓ Suc (length t)) ∧ t ∉ 𝒯 (P ↓ Suc (length t))› by blast
hence ‹¬ P ↓ Suc (length t) ⊑⇩T Q ↓ Suc (length t)› unfolding trace_refine_def by blast
thus ‹∃n. ¬ P ↓ n ⊑⇩T Q ↓ n› ..
next
show ‹P ⊑⇩T Q ⟹ Q ⊑⇩T R ⟹ P ⊑⇩T R› for P Q R :: ‹('a, 'r) process⇩p⇩t⇩i⇩c⇩k›
by (fact trans_T)
qed
interpretation PRS_leDT : PreorderRestrictionSpace ‹(↓)› ‹(⊑⇩D⇩T)›
proof unfold_locales
show ‹P ↓ 0 ⊑⇩D⇩T Q ↓ 0› for P Q :: ‹('a, 'r) process⇩p⇩t⇩i⇩c⇩k› by simp
next
show ‹P ⊑⇩D⇩T Q ⟹ P ↓ n ⊑⇩D⇩T Q ↓ n› for P Q :: ‹('a, 'r) process⇩p⇩t⇩i⇩c⇩k› and n
by (auto simp add: refine_defs restriction_process⇩p⇩t⇩i⇩c⇩k_projs)
next
fix P Q :: ‹('a, 'r) process⇩p⇩t⇩i⇩c⇩k› assume ‹¬ P ⊑⇩D⇩T Q›
hence ‹¬ P ⊑⇩D Q ∨ ¬ P ⊑⇩T Q› unfolding trace_divergence_refine_def by blast
with ex_not_restriction_leD PRS_leT.ex_not_restriction_related
have ‹(∃n. ¬ P ↓ n ⊑⇩D Q ↓ n) ∨ (∃n. ¬ P ↓ n ⊑⇩T Q ↓ n)› by blast
thus ‹∃n. ¬ P ↓ n ⊑⇩D⇩T Q ↓ n›
unfolding trace_divergence_refine_def by blast
next
show ‹P ⊑⇩D⇩T Q ⟹ Q ⊑⇩D⇩T R ⟹ P ⊑⇩D⇩T R› for P Q R :: ‹('a, 'r) process⇩p⇩t⇩i⇩c⇩k›
by (fact trans_DT)
qed
subsection ‹Continuity›
context begin
private lemma chain_restriction_process⇩p⇩t⇩i⇩c⇩k : ‹chain Y ⟹ chain (λi. Y i ↓ n)›
by (simp add: mono_restriction_below po_class.chain_def)
private lemma cont_prem_restriction_process⇩p⇩t⇩i⇩c⇩k :
‹(⨆ i. Y i) ↓ n = (⨆ i. Y i ↓ n)› (is ‹?lhs = ?rhs›) if ‹chain Y›
proof (rule Process_eq_optimizedI)
show ‹t ∈ 𝒟 ?lhs ⟹ t ∈ 𝒟 ?rhs› for t
by (auto simp add: limproc_is_thelub chain_restriction_process⇩p⇩t⇩i⇩c⇩k
D_restriction_process⇩p⇩t⇩i⇩c⇩k LUB_projs ‹chain Y›)
next
show ‹t ∈ 𝒟 ?rhs ⟹ t ∈ 𝒟 ?lhs› for t
by (simp add: limproc_is_thelub chain_restriction_process⇩p⇩t⇩i⇩c⇩k
D_restriction_process⇩p⇩t⇩i⇩c⇩k LUB_projs ‹chain Y›)
(metis D_T append_eq_append_conv is_processT3_TR_append)
next
show ‹(t, X) ∈ ℱ ?lhs ⟹ (t, X) ∈ ℱ ?rhs› for t X
by (auto simp add: limproc_is_thelub chain_restriction_process⇩p⇩t⇩i⇩c⇩k
F_restriction_process⇩p⇩t⇩i⇩c⇩k LUB_projs ‹chain Y›)
next
show ‹(s, X) ∈ ℱ ?rhs ⟹ (s, X) ∈ ℱ ?lhs› for s X
by (simp add: limproc_is_thelub chain_restriction_process⇩p⇩t⇩i⇩c⇩k
F_restriction_process⇩p⇩t⇩i⇩c⇩k LUB_projs ‹chain Y›)
(metis F_T append_eq_append_conv is_processT3_TR_append)
qed
lemma restriction_process⇩p⇩t⇩i⇩c⇩k_cont [simp] : ‹cont (λx. f x ↓ n)› if ‹cont f›
proof (rule contI2)
show ‹monofun (λx. f x ↓ n)›
by (simp add: cont2monofunE mono_restriction_below monofunI ‹cont f›)
next
show ‹chain Y ⟹ f (⨆i. Y i) ↓ n ⊑ (⨆i. f (Y i) ↓ n)› for Y
by (simp add: ch2ch_cont cont2contlubE cont_prem_restriction_process⇩p⇩t⇩i⇩c⇩k ‹cont f›)
qed
end
subsection ‹Completeness›
text ‹Processes are actually an instance of \<^class>‹complete_restriction_space›.›
lemma chain_restriction_chain :
‹restriction_chain σ ⟹ chain σ› for σ :: ‹nat ⇒ ('a, 'r) process⇩p⇩t⇩i⇩c⇩k›
by (metis po_class.chainI restriction_process⇩p⇩t⇩i⇩c⇩k_approx_self restriction_chainD)
lemma restricted_LUB_restriction_chain_is :
‹(λn. (⨆n. σ n) ↓ n) = σ› if ‹restriction_chain σ›
proof (rule ext)
have ‹chain σ› by (simp add: chain_restriction_chain ‹restriction_chain σ›)
moreover have ‹σ = (λn. σ n ↓ n)›
by (simp add: restricted_restriction_chain_is ‹restriction_chain σ›)
ultimately have ‹chain (λn. σ n ↓ n)› by simp
have ‹length t < n ⟹ t ∈ 𝒟 (σ n) ⟷ (∀i. t ∈ 𝒟 (σ i))› for t n
proof safe
show ‹t ∈ 𝒟 (σ i)› if ‹length t < n› ‹t ∈ 𝒟 (σ n)› for i
proof (cases ‹i ≤ n›)
from ‹t ∈ 𝒟 (σ n)› ‹chain σ› le_approx_def po_class.chain_mono
show ‹i ≤ n ⟹ t ∈ 𝒟 (σ i)› by blast
next
from ‹length t < n› ‹t ∈ 𝒟 (σ n)› show ‹¬ i ≤ n ⟹ t ∈ 𝒟 (σ i)›
by (induct n, simp_all)
(metis ‹restriction_chain σ› length_less_in_D_restriction_process⇩p⇩t⇩i⇩c⇩k
nat_le_linear restriction_chain_def_ter)
qed
next
show ‹∀i. t ∈ 𝒟 (σ i) ⟹ t ∈ 𝒟 (σ n)› by simp
qed
hence * : ‹length t < n ⟹ t ∈ 𝒟 (σ n) ⟷ t ∈ 𝒟 (⨆i. σ i)› for t n
by (simp add: D_LUB ‹chain σ› limproc_is_thelub)
show ‹(⨆n. σ n) ↓ n = σ n› for n
proof (subst (3) ‹σ = (λn. σ n ↓ n)›, rule Process_eq_optimizedI)
show ‹t ∈ 𝒟 ((⨆n. σ n) ↓ n) ⟹ t ∈ 𝒟 (σ n ↓ n)› for t
proof (elim D_restriction_process⇩p⇩t⇩i⇩c⇩kE)
show ‹t ∈ 𝒟 (⨆n. σ n) ⟹ length t ≤ n ⟹ t ∈ 𝒟 (σ n ↓ n)›
by (simp add: ‹chain σ› limproc_is_thelub D_LUB D_restriction_process⇩p⇩t⇩i⇩c⇩k)
next
show ‹⟦t = u @ v; u ∈ 𝒯 (⨆n. σ n); length u = n; tF u; ftF v⟧ ⟹ t ∈ 𝒟 (σ n ↓ n)› for u v
by (auto simp add: ‹chain σ› limproc_is_thelub LUB_projs restriction_process⇩p⇩t⇩i⇩c⇩k_projs)
qed
next
fix t assume ‹t ∈ 𝒟 (σ n ↓ n)›
hence ‹ftF t› by (simp add: D_imp_front_tickFree)
with ‹t ∈ 𝒟 (σ n ↓ n)› consider ‹length t < n› ‹t ∈ 𝒟 (σ n)›
| t' r where ‹t = t' @ [✓(r)]› ‹tF t'› ‹length t' < n› ‹t' ∈ 𝒟 (σ n)›
| u v where ‹t = u @ v› ‹u ∈ 𝒯 (σ n)› ‹length u = n› ‹tF u› ‹ftF v›
by (auto elim!: D_restriction_process⇩p⇩t⇩i⇩c⇩kE)
(metis D_T Suc_le_lessD antisym_conv2 append.right_neutral
front_tickFree_Nil front_tickFree_nonempty_append_imp
is_processT9 length_append_singleton nonTickFree_n_frontTickFree)
thus ‹t ∈ 𝒟 ((⨆n. σ n) ↓ n)›
proof cases
show ‹length t < n ⟹ t ∈ 𝒟 (σ n) ⟹ t ∈ 𝒟 ((⨆n. σ n) ↓ n)›
by (simp add: D_restriction_process⇩p⇩t⇩i⇩c⇩k "*")
next
fix t' r assume ‹t = t' @ [✓(r)]› ‹tF t'› ‹length t' < n› ‹t' ∈ 𝒟 (σ n)›
from ‹length t' < n› ‹t' ∈ 𝒟 (σ n)› have ‹t' ∈ 𝒟 ((⨆n. σ n) ↓ n)›
by (simp add: D_restriction_process⇩p⇩t⇩i⇩c⇩k "*")
thus ‹t ∈ 𝒟 ((⨆n. σ n) ↓ n)›
by (simp add: ‹t = t' @ [✓(r)]› ‹tF t'› is_processT7)
next
fix u v assume ‹t = u @ v› ‹u ∈ 𝒯 (σ n)› ‹length u = n› ‹tF u› ‹ftF v›
from ‹length u = n› ‹u ∈ 𝒯 (σ n)› have ‹u ∈ 𝒯 (σ (Suc n))›
by (metis length_le_in_T_restriction_process⇩p⇩t⇩i⇩c⇩k nat_le_linear
restriction_chainD ‹restriction_chain σ›)
from ‹chain σ› ‹u ∈ 𝒯 (σ (Suc n))› D_T le_approx2T po_class.chain_mono
have ‹i ≤ Suc n ⟹ u ∈ 𝒯 (σ i)› for i by blast
moreover have ‹Suc n < i ⟹ u ∈ 𝒯 (σ i)› for i
by (subst T_restriction_process⇩p⇩t⇩i⇩c⇩k_Suc_length_iff_T[symmetric])
(metis ‹length u = n› ‹u ∈ 𝒯 (σ (Suc n))›
restriction_chain_def_bis ‹restriction_chain σ›)
ultimately have ‹u ∈ 𝒯 (⨆i. σ i)›
by (metis T_LUB_2 ‹chain σ› limproc_is_thelub linorder_not_le)
with ‹ftF v› ‹length u = n› ‹tF u› show ‹t ∈ 𝒟 ((⨆n. σ n) ↓ n)›
by (auto simp add: ‹t = u @ v› D_restriction_process⇩p⇩t⇩i⇩c⇩k)
qed
next
show ‹(t, X) ∈ ℱ ((⨆n. σ n) ↓ n) ⟹ t ∉ 𝒟 ((⨆n. σ n) ↓ n) ⟹ (t, X) ∈ ℱ (σ n ↓ n)› for t X
by (meson ‹chain σ› is_processT8 is_ub_thelub proc_ord2a restriction_process⇩p⇩t⇩i⇩c⇩k_approx_self)
next
fix t X assume ‹(t, X) ∈ ℱ (σ n ↓ n)› ‹t ∉ 𝒟 (σ n ↓ n)›
hence ‹length t ≤ n› ‹(t, X) ∈ ℱ (σ n)› ‹t ∉ 𝒟 (σ n)›
by (auto elim!: F_restriction_process⇩p⇩t⇩i⇩c⇩kE simp add: D_restriction_process⇩p⇩t⇩i⇩c⇩k)
thus ‹(t, X) ∈ ℱ ((⨆i. σ i) ↓ n)›
by (simp add: F_restriction_process⇩p⇩t⇩i⇩c⇩k)
(meson ‹chain σ› is_ub_thelub le_approx2)
qed
qed
instance process⇩p⇩t⇩i⇩c⇩k :: (type, type) complete_restriction_space
proof (intro_classes, rule restriction_convergentI)
show ‹σ ─↓→ (⨆i. σ i)› if ‹restriction_chain σ› for σ :: ‹nat ⇒ ('a, 'b) process⇩p⇩t⇩i⇩c⇩k›
proof (subst restricted_LUB_restriction_chain_is[symmetric])
from ‹restriction_chain σ› show ‹restriction_chain σ› .
next
from restriction_tendsto_restrictions
show ‹(λn. (⨆i. σ i) ↓ n) ─↓→ (⨆i. σ i)› .
qed
qed
text ‹This is a very powerful result. Now we can write fixed-point equations for processes
like \<^term>‹υ X. f X›, providing the fact that \<^term>‹f› is \<^const>‹constructive›.›
setup ‹Sign.add_const_constraint (\<^const_name>‹restriction›, NONE)›
end