(* Title: HOLCF/Adm.thy ID: $Id: Adm.thy,v 1.22 2008/05/07 08:59:51 berghofe Exp $ Author: Franz Regensburger and Brian Huffman *) header {* Admissibility and compactness *} theory Adm imports Ffun begin defaultsort cpo subsection {* Definitions *} definition adm :: "('a::cpo => bool) => bool" where "adm P = (∀Y. chain Y --> (∀i. P (Y i)) --> P (\<Squnion>i. Y i))" lemma admI: "(!!Y. [|chain Y; ∀i. P (Y i)|] ==> P (\<Squnion>i. Y i)) ==> adm P" unfolding adm_def by fast lemma admD: "[|adm P; chain Y; !!i. P (Y i)|] ==> P (\<Squnion>i. Y i)" unfolding adm_def by fast lemma triv_admI: "∀x. P x ==> adm P" by (rule admI, erule spec) text {* improved admissibility introduction *} lemma admI2: "(!!Y. [|chain Y; ∀i. P (Y i); ∀i. ∃j>i. Y i ≠ Y j ∧ Y i \<sqsubseteq> Y j|] ==> P (\<Squnion>i. Y i)) ==> adm P" apply (rule admI) apply (erule (1) increasing_chain_adm_lemma) apply fast done subsection {* Admissibility on chain-finite types *} text {* for chain-finite (easy) types every formula is admissible *} lemma adm_chfin: "adm (P::'a::chfin => bool)" by (rule admI, frule chfin, auto simp add: maxinch_is_thelub) subsection {* Admissibility of special formulae and propagation *} lemma adm_not_free: "adm (λx. t)" by (rule admI, simp) lemma adm_conj: "[|adm P; adm Q|] ==> adm (λx. P x ∧ Q x)" by (fast intro: admI elim: admD) lemma adm_all: "(!!y. adm (P y)) ==> adm (λx. ∀y. P y x)" by (fast intro: admI elim: admD) lemma adm_ball: "(!!y. y ∈ A ==> adm (P y)) ==> adm (λx. ∀y∈A. P y x)" by (fast intro: admI elim: admD) text {* Admissibility for disjunction is hard to prove. It takes 5 Lemmas *} lemma adm_disj_lemma1: "[|chain (Y::nat => 'a::cpo); ∀i. ∃j≥i. P (Y j)|] ==> chain (λi. Y (LEAST j. i ≤ j ∧ P (Y j)))" apply (rule chainI) apply (erule chain_mono) apply (rule Least_le) apply (rule LeastI2_ex) apply simp_all done lemmas adm_disj_lemma2 = LeastI_ex [of "λj. i ≤ j ∧ P (Y j)", standard] lemma adm_disj_lemma3: "[|chain (Y::nat => 'a::cpo); ∀i. ∃j≥i. P (Y j)|] ==> (\<Squnion>i. Y i) = (\<Squnion>i. Y (LEAST j. i ≤ j ∧ P (Y j)))" apply (frule (1) adm_disj_lemma1) apply (rule antisym_less) apply (rule lub_mono, assumption+) apply (erule chain_mono) apply (simp add: adm_disj_lemma2) apply (rule lub_range_mono, fast, assumption+) done lemma adm_disj_lemma4: "[|adm P; chain Y; ∀i. ∃j≥i. P (Y j)|] ==> P (\<Squnion>i. Y i)" apply (subst adm_disj_lemma3, assumption+) apply (erule admD) apply (simp add: adm_disj_lemma1) apply (simp add: adm_disj_lemma2) done lemma adm_disj_lemma5: "∀n::nat. P n ∨ Q n ==> (∀i. ∃j≥i. P j) ∨ (∀i. ∃j≥i. Q j)" apply (erule contrapos_pp) apply (clarsimp, rename_tac a b) apply (rule_tac x="max a b" in exI) apply simp done lemma adm_disj: "[|adm P; adm Q|] ==> adm (λx. P x ∨ Q x)" apply (rule admI) apply (erule adm_disj_lemma5 [THEN disjE]) apply (erule (2) adm_disj_lemma4 [THEN disjI1]) apply (erule (2) adm_disj_lemma4 [THEN disjI2]) done lemma adm_imp: "[|adm (λx. ¬ P x); adm Q|] ==> adm (λx. P x --> Q x)" by (subst imp_conv_disj, rule adm_disj) lemma adm_iff: "[|adm (λx. P x --> Q x); adm (λx. Q x --> P x)|] ==> adm (λx. P x = Q x)" by (subst iff_conv_conj_imp, rule adm_conj) lemma adm_not_conj: "[|adm (λx. ¬ P x); adm (λx. ¬ Q x)|] ==> adm (λx. ¬ (P x ∧ Q x))" by (simp add: adm_imp) text {* admissibility and continuity *} declare range_composition [simp del] lemma adm_less: "[|cont u; cont v|] ==> adm (λx. u x \<sqsubseteq> v x)" apply (rule admI) apply (simp add: cont2contlubE) apply (rule lub_mono) apply (erule (1) ch2ch_cont) apply (erule (1) ch2ch_cont) apply (erule spec) done lemma adm_eq: "[|cont u; cont v|] ==> adm (λx. u x = v x)" by (simp add: po_eq_conv adm_conj adm_less) lemma adm_subst: "[|cont t; adm P|] ==> adm (λx. P (t x))" apply (rule admI) apply (simp add: cont2contlubE) apply (erule admD) apply (erule (1) ch2ch_cont) apply (erule spec) done lemma adm_not_less: "cont t ==> adm (λx. ¬ t x \<sqsubseteq> u)" apply (rule admI) apply (drule_tac x=0 in spec) apply (erule contrapos_nn) apply (erule rev_trans_less) apply (erule cont2mono [THEN monofunE]) apply (erule is_ub_thelub) done subsection {* Compactness *} definition compact :: "'a::cpo => bool" where "compact k = adm (λx. ¬ k \<sqsubseteq> x)" lemma compactI: "adm (λx. ¬ k \<sqsubseteq> x) ==> compact k" unfolding compact_def . lemma compactD: "compact k ==> adm (λx. ¬ k \<sqsubseteq> x)" unfolding compact_def . lemma compactI2: "(!!Y. [|chain Y; x \<sqsubseteq> lub (range Y)|] ==> ∃i. x \<sqsubseteq> Y i) ==> compact x" unfolding compact_def adm_def by fast lemma compactD2: "[|compact x; chain Y; x \<sqsubseteq> lub (range Y)|] ==> ∃i. x \<sqsubseteq> Y i" unfolding compact_def adm_def by fast lemma compact_chfin [simp]: "compact (x::'a::chfin)" by (rule compactI [OF adm_chfin]) lemma compact_imp_max_in_chain: "[|chain Y; compact (\<Squnion>i. Y i)|] ==> ∃i. max_in_chain i Y" apply (drule (1) compactD2, simp) apply (erule exE, rule_tac x=i in exI) apply (rule max_in_chainI) apply (rule antisym_less) apply (erule (1) chain_mono) apply (erule (1) trans_less [OF is_ub_thelub]) done text {* admissibility and compactness *} lemma adm_compact_not_less: "[|compact k; cont t|] ==> adm (λx. ¬ k \<sqsubseteq> t x)" unfolding compact_def by (rule adm_subst) lemma adm_neq_compact: "[|compact k; cont t|] ==> adm (λx. t x ≠ k)" by (simp add: po_eq_conv adm_imp adm_not_less adm_compact_not_less) lemma adm_compact_neq: "[|compact k; cont t|] ==> adm (λx. k ≠ t x)" by (simp add: po_eq_conv adm_imp adm_not_less adm_compact_not_less) lemma compact_UU [simp, intro]: "compact ⊥" by (rule compactI, simp add: adm_not_free) lemma adm_not_UU: "cont t ==> adm (λx. t x ≠ ⊥)" by (simp add: adm_neq_compact) text {* Any upward-closed predicate is admissible. *} lemma adm_upward: assumes P: "!!x y. [|P x; x \<sqsubseteq> y|] ==> P y" shows "adm P" by (rule admI, drule spec, erule P, erule is_ub_thelub) lemmas adm_lemmas [simp] = adm_not_free adm_conj adm_all adm_ball adm_disj adm_imp adm_iff adm_less adm_eq adm_not_less adm_compact_not_less adm_compact_neq adm_neq_compact adm_not_UU end
lemma admI:
(!!Y. [| chain Y; ∀i. P (Y i) |] ==> P (LUB i. Y i)) ==> adm P
lemma admD:
[| adm P; chain Y; !!i. P (Y i) |] ==> P (LUB i. Y i)
lemma triv_admI:
∀x. P x ==> adm P
lemma admI2:
(!!Y. [| chain Y; ∀i. P (Y i); ∀i. ∃j>i. Y i ≠ Y j ∧ Y i << Y j |]
==> P (LUB i. Y i))
==> adm P
lemma adm_chfin:
adm P
lemma adm_not_free:
adm (λx. t)
lemma adm_conj:
[| adm P; adm Q |] ==> adm (λx. P x ∧ Q x)
lemma adm_all:
(!!y. adm (P y)) ==> adm (λx. ∀y. P y x)
lemma adm_ball:
(!!y. y ∈ A ==> adm (P y)) ==> adm (λx. ∀y∈A. P y x)
lemma adm_disj_lemma1:
[| chain Y; ∀i. ∃j≥i. P (Y j) |] ==> chain (λi. Y (LEAST j. i ≤ j ∧ P (Y j)))
lemma adm_disj_lemma2:
∃x≥i. P (Y x)
==> i ≤ (LEAST j. i ≤ j ∧ P (Y j)) ∧ P (Y (LEAST j. i ≤ j ∧ P (Y j)))
lemma adm_disj_lemma3:
[| chain Y; ∀i. ∃j≥i. P (Y j) |]
==> (LUB i. Y i) = (LUB i. Y (LEAST j. i ≤ j ∧ P (Y j)))
lemma adm_disj_lemma4:
[| adm P; chain Y; ∀i. ∃j≥i. P (Y j) |] ==> P (LUB i. Y i)
lemma adm_disj_lemma5:
∀n. P n ∨ Q n ==> (∀i. ∃j≥i. P j) ∨ (∀i. ∃j≥i. Q j)
lemma adm_disj:
[| adm P; adm Q |] ==> adm (λx. P x ∨ Q x)
lemma adm_imp:
[| adm (λx. ¬ P x); adm Q |] ==> adm (λx. P x --> Q x)
lemma adm_iff:
[| adm (λx. P x --> Q x); adm (λx. Q x --> P x) |] ==> adm (λx. P x = Q x)
lemma adm_not_conj:
[| adm (λx. ¬ P x); adm (λx. ¬ Q x) |] ==> adm (λx. ¬ (P x ∧ Q x))
lemma adm_less:
[| cont u; cont v |] ==> adm (λx. u x << v x)
lemma adm_eq:
[| cont u; cont v |] ==> adm (λx. u x = v x)
lemma adm_subst:
[| cont t; adm P |] ==> adm (λx. P (t x))
lemma adm_not_less:
cont t ==> adm (λx. ¬ t x << u)
lemma compactI:
adm (λx. ¬ k << x) ==> compact k
lemma compactD:
compact k ==> adm (λx. ¬ k << x)
lemma compactI2:
(!!Y. [| chain Y; x << Lub Y |] ==> ∃i. x << Y i) ==> compact x
lemma compactD2:
[| compact x; chain Y; x << Lub Y |] ==> ∃i. x << Y i
lemma compact_chfin:
compact x
lemma compact_imp_max_in_chain:
[| chain Y; compact (LUB i. Y i) |] ==> ∃i. max_in_chain i Y
lemma adm_compact_not_less:
[| compact k; cont t |] ==> adm (λx. ¬ k << t x)
lemma adm_neq_compact:
[| compact k; cont t |] ==> adm (λx. t x ≠ k)
lemma adm_compact_neq:
[| compact k; cont t |] ==> adm (λx. k ≠ t x)
lemma compact_UU:
compact UU
lemma adm_not_UU:
cont t ==> adm (λx. t x ≠ UU)
lemma adm_upward:
(!!x y. [| P x; x << y |] ==> P y) ==> adm P
lemma adm_lemmas:
adm (λx. t)
[| adm P; adm Q |] ==> adm (λx. P x ∧ Q x)
(!!y. adm (P y)) ==> adm (λx. ∀y. P y x)
(!!y. y ∈ A ==> adm (P y)) ==> adm (λx. ∀y∈A. P y x)
[| adm P; adm Q |] ==> adm (λx. P x ∨ Q x)
[| adm (λx. ¬ P x); adm Q |] ==> adm (λx. P x --> Q x)
[| adm (λx. P x --> Q x); adm (λx. Q x --> P x) |] ==> adm (λx. P x = Q x)
[| cont u; cont v |] ==> adm (λx. u x << v x)
[| cont u; cont v |] ==> adm (λx. u x = v x)
cont t ==> adm (λx. ¬ t x << u)
[| compact k; cont t |] ==> adm (λx. ¬ k << t x)
[| compact k; cont t |] ==> adm (λx. k ≠ t x)
[| compact k; cont t |] ==> adm (λx. t x ≠ k)
cont t ==> adm (λx. t x ≠ UU)