Theory Tr

Up to index of Isabelle/HOLCF

theory Tr
imports Lift
begin

(*  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 = UUt = TTt = 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))

Rewriting of HOLCF operations to HOL functions

lemma andalso_or:

  t  UU ==> ((t andalso s) = FF) = (t = FFs = FF)

lemma andalso_and:

  t  UU ==> ((t andalso s)  FF) = (t  FFs  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)

Compactness

lemma compact_TT:

  compact TT

lemma compact_FF:

  compact FF