theory "C-restr" imports C "C-Meet" "HOLCF-Utils" begin subsubsection {* The demand of a $C$-function *} text {* The demand is the least amount of resources required to produce a non-bottom element, if at all. *} definition demand :: "(C → 'a::pcpo) ⇒ C" where "demand f = (if f⋅C⇧∞ ≠ ⊥ then C⇗(LEAST n. f⋅C⇗n⇖ ≠ ⊥)⇖ else C⇧∞)" text {* Because of continuity, a non-bottom value can always be obtained with finite resources. *} lemma finite_resources_suffice: assumes "f⋅C⇧∞ ≠ ⊥" obtains n where "f⋅C⇗n⇖ ≠ ⊥" proof- { assume "∀n. f⋅(C⇗n⇖) = ⊥" hence "f⋅C⇧∞ ⊑ ⊥" by (auto intro: lub_below[OF ch2ch_Rep_cfunR[OF chain_iterate]] simp add: Cinf_def fix_def2 contlub_cfun_arg[OF chain_iterate]) with assms have False by simp } thus ?thesis using that by blast qed text {* Because of monotonicity, a non-bottom value can always be obtained with more resources. *} lemma more_resources_suffice: assumes "f⋅r ≠ ⊥" and "r ⊑ r'" shows "f⋅r' ≠ ⊥" using assms(1) monofun_cfun_arg[OF assms(2), where f = f] by auto lemma infinite_resources_suffice: shows "f⋅r ≠ ⊥ ⟹ f⋅C⇧∞ ≠ ⊥" by (erule more_resources_suffice[OF _ below_Cinf]) lemma demand_suffices: assumes "f⋅C⇧∞ ≠ ⊥" shows "f⋅(demand f) ≠ ⊥" apply (simp add: assms demand_def) apply (rule finite_resources_suffice[OF assms]) apply (rule LeastI) apply assumption done lemma not_bot_demand: "f⋅r ≠ ⊥ ⟷ demand f ≠ C⇧∞ ∧ demand f ⊑ r" proof(intro iffI) assume "f⋅r ≠ ⊥" thus "demand f ≠ C⇧∞ ∧ demand f ⊑ r" apply (cases r rule:C_cases) apply (auto intro: Least_le simp add: demand_def dest: infinite_resources_suffice) done next assume *: "demand f ≠ C⇧∞ ∧ demand f ⊑ r" then have "f⋅C⇧∞ ≠ ⊥" by (auto intro: Least_le simp add: demand_def dest: infinite_resources_suffice) hence "f⋅(demand f) ≠ ⊥" by (rule demand_suffices) moreover from * have "demand f ⊑ r".. ultimately show "f⋅r ≠ ⊥" by (rule more_resources_suffice) qed lemma infinity_bot_demand: "f⋅C⇧∞ = ⊥ ⟷ demand f = C⇧∞" by (metis below_Cinf not_bot_demand) lemma demand_suffices': assumes "demand f = C⇗n⇖" shows "f⋅(demand f) ≠ ⊥" by (metis C_eq_Cinf assms demand_suffices infinity_bot_demand) lemma demand_Suc_Least: assumes [simp]: "f⋅⊥ = ⊥" assumes "demand f ≠ C⇧∞" shows "demand f = C⇗(Suc (LEAST n. f⋅C⇗Suc n⇖ ≠ ⊥))⇖" proof- from assms have "demand f = C⇗(LEAST n. f⋅C⇗n⇖ ≠ ⊥)⇖" by (auto simp add: demand_def) also then obtain n where "f⋅C⇗n⇖ ≠ ⊥" by (metis demand_suffices') hence "(LEAST n. f⋅C⇗n⇖ ≠ ⊥) = Suc (LEAST n. f⋅C⇗Suc n⇖ ≠ ⊥)" apply (rule Least_Suc) by simp finally show ?thesis. qed lemma demand_C_case[simp]: "demand (C_case⋅f) = C ⋅ (demand f)" proof(cases "demand (C_case⋅f) = C⇧∞") case True then have "C_case⋅f⋅C⇧∞ = ⊥" by (metis infinity_bot_demand) with True show ?thesis apply auto by (metis infinity_bot_demand) next case False hence "demand (C_case⋅f) = C⇗Suc (LEAST n. (C_case⋅f)⋅C⇗Suc n⇖ ≠ ⊥)⇖" by (rule demand_Suc_Least[OF C.case_rews(1)]) also have "… = C⋅C⇗LEAST n. f⋅C⇗n⇖ ≠ ⊥⇖" by simp also have "… = C⋅(demand f)" using False unfolding demand_def by auto finally show ?thesis. qed lemma demand_contravariant: assumes "f ⊑ g" shows "demand g ⊑ demand f" proof(cases "demand f" rule:C_cases) fix n assume "demand f = C⇗n⇖" hence "f⋅(demand f) ≠ ⊥" by (metis demand_suffices') also note monofun_cfun_fun[OF assms] finally have "g⋅(demand f) ≠ ⊥" by this (intro cont2cont) thus "demand g ⊑ demand f" unfolding not_bot_demand by auto qed auto subsubsection {* Restricting functions with domain C *} fixrec C_restr :: "C → (C → 'a::pcpo) → (C → 'a)" where "C_restr⋅r⋅f⋅r' = (f⋅(r ⊓ r'))" abbreviation C_restr_syn :: "(C → 'a::pcpo) ⇒ C ⇒ (C → 'a)" ( "_|⇘_⇙" [111,110] 110) where "f|⇘r⇙ ≡ C_restr⋅r⋅f" lemma [simp]: "⊥|⇘r⇙ = ⊥" by fixrec_simp lemma [simp]: "f⋅⊥ = ⊥ ⟹ f|⇘⊥⇙ = ⊥" by fixrec_simp lemma C_restr_C_restr[simp]: "(v|⇘r'⇙)|⇘r⇙ = v|⇘(r' ⊓ r)⇙" by (rule cfun_eqI) simp lemma C_restr_eqD: assumes "f|⇘r⇙ = g|⇘r⇙" assumes "r' ⊑ r" shows "f⋅r' = g⋅r'" by (metis C_restr.simps assms below_refl is_meetI) lemma C_restr_eq_lower: assumes "f|⇘r⇙ = g|⇘r⇙" assumes "r' ⊑ r" shows "f|⇘r'⇙ = g|⇘r'⇙" by (metis C_restr_C_restr assms below_refl is_meetI) lemma C_restr_below[intro, simp]: "x|⇘r⇙ ⊑ x" apply (rule cfun_belowI) apply simp by (metis below_refl meet_below2 monofun_cfun_arg) lemma C_restr_below_cong: "(⋀ r'. r' ⊑ r ⟹ f ⋅ r' ⊑ g ⋅ r') ⟹ f|⇘r⇙ ⊑ g|⇘r⇙" apply (rule cfun_belowI) apply simp by (metis below_refl meet_below1) lemma C_restr_cong: "(⋀ r'. r' ⊑ r ⟹ f ⋅ r' = g ⋅ r') ⟹ f|⇘r⇙ = g|⇘r⇙" apply (intro below_antisym C_restr_below_cong ) by (metis below_refl)+ lemma C_restr_C_cong: "(⋀ r'. r' ⊑ r ⟹ f ⋅ (C⋅r') = g ⋅ (C⋅r')) ⟹ f⋅⊥=g⋅⊥ ⟹ f|⇘C⋅r⇙ = g|⇘C⋅r⇙" apply (rule C_restr_cong) by (case_tac r', auto) lemma C_restr_C_case[simp]: "(C_case⋅f)|⇘C⋅r⇙ = C_case⋅(f|⇘r⇙)" apply (rule cfun_eqI) apply simp apply (case_tac x) apply simp apply simp done lemma C_restr_bot_demand: assumes "C⋅r ⊑ demand f" shows "f|⇘r⇙ = ⊥" proof(rule cfun_eqI) fix r' have "f⋅(r ⊓ r') = ⊥" proof(rule classical) have "r ⊑ C ⋅ r" by (rule below_C) also note assms also assume *: "f⋅(r ⊓ r') ≠ ⊥" hence "demand f ⊑ (r ⊓ r')" unfolding not_bot_demand by auto hence "demand f ⊑ r" by (metis below_refl meet_below1 below_trans) finally (below_antisym) have "r = demand f" by this (intro cont2cont) with assms have "demand f = C⇧∞" by (cases "demand f" rule:C_cases) (auto simp add: iterate_Suc[symmetric] simp del: iterate_Suc) thus "f⋅(r ⊓ r') = ⊥" by (metis not_bot_demand) qed thus "(f|⇘r⇙)⋅r' = ⊥⋅r'" by simp qed subsubsection {* Restricting maps of C-ranged functions *} definition env_C_restr :: "C → ('var::type ⇒ (C → 'a::pcpo)) → ('var ⇒ (C → 'a))" where "env_C_restr = (Λ r f. cfun_comp⋅(C_restr⋅r)⋅f)" abbreviation env_C_restr_syn :: "('var::type ⇒ (C → 'a::pcpo)) ⇒ C ⇒ ('var ⇒ (C → 'a))" ( "_|⇧∘⇘_⇙" [111,110] 110) where "f|⇧∘⇘r⇙ ≡ env_C_restr⋅r⋅f" lemma env_C_restr_upd[simp]: "(ρ(x := v))|⇧∘⇘r⇙ = (ρ|⇧∘⇘r⇙)(x := v|⇘r⇙)" unfolding env_C_restr_def by simp lemma env_C_restr_lookup[simp]: "(ρ|⇧∘⇘r⇙) v = ρ v|⇘r⇙" unfolding env_C_restr_def by simp lemma env_C_restr_bot[simp]: " ⊥|⇧∘⇘r⇙ = ⊥" unfolding env_C_restr_def by auto lemma env_C_restr_restr_below[intro]: "ρ|⇧∘⇘r⇙ ⊑ ρ" by (auto intro: fun_belowI) lemma env_C_restr_env_C_restr[simp]: "(v|⇧∘⇘r'⇙)|⇧∘⇘r⇙ = v|⇧∘⇘(r' ⊓ r)⇙" unfolding env_C_restr_def by auto lemma env_C_restr_cong: "(⋀ x r'. r' ⊑ r ⟹ f x ⋅ r' = g x ⋅ r') ⟹ f|⇧∘⇘r⇙ = g|⇧∘⇘r⇙" unfolding env_C_restr_def by (rule ext) (auto intro: C_restr_cong) end