(* Title: HOLCF/Tr.thy ID: $Id: Tr.thy,v 1.21 2007/10/21 14:27:43 wenzelm Exp $ Author: Franz Regensburger Introduce infix if_then_else_fi and boolean connectives andalso, orelse. *) header {* The type of lifted booleans *} theory Tr imports Lift begin defaultsort pcpo types tr = "bool lift" translations "tr" <= (type) "bool lift" definition TT :: "tr" where "TT = Def True" definition FF :: "tr" where "FF = Def False" definition trifte :: "'c -> 'c -> tr -> 'c" where ifte_def: "trifte = (Λ t e. FLIFT b. if b then t else e)" abbreviation cifte_syn :: "[tr, 'c, 'c] => 'c" ("(3If _/ (then _/ else _) fi)" 60) where "If b then e1 else e2 fi == trifte·e1·e2·b" definition trand :: "tr -> tr -> tr" where andalso_def: "trand = (Λ x y. If x then y else FF fi)" abbreviation andalso_syn :: "tr => tr => tr" ("_ andalso _" [36,35] 35) where "x andalso y == trand·x·y" definition tror :: "tr -> tr -> tr" where orelse_def: "tror = (Λ x y. If x then TT else y fi)" abbreviation orelse_syn :: "tr => tr => tr" ("_ orelse _" [31,30] 30) where "x orelse y == tror·x·y" definition neg :: "tr -> tr" where "neg = flift2 Not" definition If2 :: "[tr, 'c, 'c] => 'c" where "If2 Q x y = (If Q then x else y fi)" translations "Λ (CONST TT). t" == "CONST trifte·t·⊥" "Λ (CONST FF). t" == "CONST trifte·⊥·t" text {* Exhaustion and Elimination for type @{typ tr} *} lemma Exh_tr: "t = ⊥ ∨ t = TT ∨ t = FF" apply (unfold FF_def TT_def) apply (induct t) apply fast apply fast done lemma trE: "[|p = ⊥ ==> Q; p = TT ==> Q; p = FF ==> Q|] ==> Q" apply (rule Exh_tr [THEN disjE]) apply fast apply (erule disjE) apply fast apply fast done text {* tactic for tr-thms with case split *} lemmas tr_defs = andalso_def orelse_def neg_def ifte_def TT_def FF_def (* fun prover t = prove_goal thy t (fn prems => [ (res_inst_tac [("p","y")] trE 1), (REPEAT(asm_simp_tac (simpset() addsimps [o_def,flift1_def,flift2_def,inst_lift_po]@tr_defs) 1)) ]) *) text {* distinctness for type @{typ tr} *} lemma dist_less_tr [simp]: "¬ TT \<sqsubseteq> ⊥" "¬ FF \<sqsubseteq> ⊥" "¬ TT \<sqsubseteq> FF" "¬ FF \<sqsubseteq> TT" by (simp_all add: tr_defs) lemma dist_eq_tr [simp]: "TT ≠ ⊥" "FF ≠ ⊥" "TT ≠ FF" "⊥ ≠ TT" "⊥ ≠ FF" "FF ≠ TT" by (simp_all add: tr_defs) text {* lemmas about andalso, orelse, neg and if *} lemma ifte_thms [simp]: "If ⊥ then e1 else e2 fi = ⊥" "If FF then e1 else e2 fi = e2" "If TT then e1 else e2 fi = e1" by (simp_all add: ifte_def TT_def FF_def) lemma andalso_thms [simp]: "(TT andalso y) = y" "(FF andalso y) = FF" "(⊥ andalso y) = ⊥" "(y andalso TT) = y" "(y andalso y) = y" apply (unfold andalso_def, simp_all) apply (rule_tac p=y in trE, simp_all) apply (rule_tac p=y in trE, simp_all) done lemma orelse_thms [simp]: "(TT orelse y) = TT" "(FF orelse y) = y" "(⊥ orelse y) = ⊥" "(y orelse FF) = y" "(y orelse y) = y" apply (unfold orelse_def, simp_all) apply (rule_tac p=y in trE, simp_all) apply (rule_tac p=y in trE, simp_all) done lemma neg_thms [simp]: "neg·TT = FF" "neg·FF = TT" "neg·⊥ = ⊥" by (simp_all add: neg_def TT_def FF_def) text {* split-tac for If via If2 because the constant has to be a constant *} lemma split_If2: "P (If2 Q x y) = ((Q = ⊥ --> P ⊥) ∧ (Q = TT --> P x) ∧ (Q = FF --> P y))" apply (unfold If2_def) apply (rule_tac p = "Q" in trE) apply (simp_all) done ML {* val split_If_tac = simp_tac (HOL_basic_ss addsimps [@{thm If2_def} RS sym]) THEN' (split_tac [@{thm split_If2}]) *} subsection "Rewriting of HOLCF operations to HOL functions" lemma andalso_or: "t ≠ ⊥ ==> ((t andalso s) = FF) = (t = FF ∨ s = FF)" apply (rule_tac p = "t" in trE) apply simp_all done lemma andalso_and: "t ≠ ⊥ ==> ((t andalso s) ≠ FF) = (t ≠ FF ∧ s ≠ FF)" apply (rule_tac p = "t" in trE) apply simp_all done lemma Def_bool1 [simp]: "(Def x ≠ FF) = x" by (simp add: FF_def) lemma Def_bool2 [simp]: "(Def x = FF) = (¬ x)" by (simp add: FF_def) lemma Def_bool3 [simp]: "(Def x = TT) = x" by (simp add: TT_def) lemma Def_bool4 [simp]: "(Def x ≠ TT) = (¬ x)" by (simp add: TT_def) lemma If_and_if: "(If Def P then A else B fi) = (if P then A else B)" apply (rule_tac p = "Def P" in trE) apply (auto simp add: TT_def[symmetric] FF_def[symmetric]) done subsection {* Compactness *} lemma compact_TT [simp]: "compact TT" by (rule compact_chfin) lemma compact_FF [simp]: "compact FF" by (rule compact_chfin) end
lemma Exh_tr:
t = UU ∨ t = TT ∨ t = FF
lemma trE:
[| p = UU ==> Q; p = TT ==> Q; p = FF ==> Q |] ==> Q
lemma tr_defs:
trand = (LAM x y. If x then y else FF fi)
tror = (LAM x y. If x then TT else y fi)
neg = flift2 Not
trifte = (LAM t e. FLIFT b. if b then t else e)
TT = Def True
FF = Def False
lemma dist_less_tr:
¬ TT << UU
¬ FF << UU
¬ TT << FF
¬ FF << TT
lemma dist_eq_tr:
TT ≠ UU
FF ≠ UU
TT ≠ FF
UU ≠ TT
UU ≠ FF
FF ≠ TT
lemma ifte_thms:
If UU then e1.0 else e2.0 fi = UU
If FF then e1.0 else e2.0 fi = e2.0
If TT then e1.0 else e2.0 fi = e1.0
lemma andalso_thms:
(TT andalso y) = y
(FF andalso y) = FF
(UU andalso y) = UU
(y andalso TT) = y
(y andalso y) = y
lemma orelse_thms:
(TT orelse y) = TT
(FF orelse y) = y
(UU orelse y) = UU
(y orelse FF) = y
(y orelse y) = y
lemma neg_thms:
neg·TT = FF
neg·FF = TT
neg·UU = UU
lemma split_If2:
P (If2 Q x y) = ((Q = UU --> P UU) ∧ (Q = TT --> P x) ∧ (Q = FF --> P y))
lemma andalso_or:
t ≠ UU ==> ((t andalso s) = FF) = (t = FF ∨ s = FF)
lemma andalso_and:
t ≠ UU ==> ((t andalso s) ≠ FF) = (t ≠ FF ∧ s ≠ FF)
lemma Def_bool1:
(Def x ≠ FF) = x
lemma Def_bool2:
(Def x = FF) = (¬ x)
lemma Def_bool3:
(Def x = TT) = x
lemma Def_bool4:
(Def x ≠ TT) = (¬ x)
lemma If_and_if:
If Def P then A else B fi = (if P then A else B)
lemma compact_TT:
compact TT
lemma compact_FF:
compact FF