section "Small-Step Semantics of Commands"

theory Ex78_Small_Step
imports "~~/src/HOL/IMP/Star" "./Ex78_Big_Step" begin

subsection "The transition relation"

inductive
  small_step :: "com * state \<Rightarrow> com * state \<Rightarrow> bool" (infix "\<rightarrow>" 55)
where
Assign:  "(x ::= a, s) \<rightarrow> (SKIP, s(x := aval a s))" |

Seq1:    "(SKIP;;c\<^sub>2,s) \<rightarrow> (c\<^sub>2,s)" |
Seq2:    "(c\<^sub>1,s) \<rightarrow> (c\<^sub>1',s') \<Longrightarrow> (c\<^sub>1;;c\<^sub>2,s) \<rightarrow> (c\<^sub>1';;c\<^sub>2,s')" |

IfTrue:  "bval b s \<Longrightarrow> (IF b THEN c\<^sub>1 ELSE c\<^sub>2,s) \<rightarrow> (c\<^sub>1,s)" |
IfFalse: "\<not>bval b s \<Longrightarrow> (IF b THEN c\<^sub>1 ELSE c\<^sub>2,s) \<rightarrow> (c\<^sub>2,s)" |

While:   "(WHILE b DO c,s) \<rightarrow>
            (IF b THEN c;; WHILE b DO c ELSE SKIP,s)" |

Repeat: "(REPEAT c UNTIL b, s) \<rightarrow> (c;; IF b THEN REPEAT c UNTIL b ELSE SKIP, s)"

abbreviation
  small_steps :: "com * state \<Rightarrow> com * state \<Rightarrow> bool" (infix "\<rightarrow>*" 55)
where "x \<rightarrow>* y == star small_step x y"

subsection\<open>Executability\<close>

code_pred small_step .

values "{(c',map t [''x'',''y'',''z'']) |c' t.
   (''x'' ::= V ''z'';; ''y'' ::= V ''x'',
    <''x'' := 3, ''y'' := 7, ''z'' := 5>) \<rightarrow>* (c',t)}"

subsection\<open>Proof infrastructure\<close>

subsubsection\<open>Induction rules\<close>

text\<open>The default induction rule @{thm[source] small_step.induct} only works
for lemmas of the form \<open>a \<rightarrow> b \<Longrightarrow> \<dots>\<close> where \<open>a\<close> and \<open>b\<close> are
not already pairs \<open>(DUMMY,DUMMY)\<close>. We can generate a suitable variant
of @{thm[source] small_step.induct} for pairs by ``splitting'' the arguments
\<open>\<rightarrow>\<close> into pairs:\<close>
lemmas small_step_induct = small_step.induct[split_format(complete)]

subsubsection\<open>Proof automation\<close>

declare small_step.intros[simp,intro]

text\<open>Rule inversion:\<close>

inductive_cases SkipE[elim!]: "(SKIP,s) \<rightarrow> ct"
thm SkipE
inductive_cases AssignE[elim!]: "(x::=a,s) \<rightarrow> ct"
thm AssignE
inductive_cases SeqE[elim]: "(c1;;c2,s) \<rightarrow> ct"
thm SeqE
inductive_cases IfE[elim!]: "(IF b THEN c1 ELSE c2,s) \<rightarrow> ct"
inductive_cases WhileE[elim]: "(WHILE b DO c, s) \<rightarrow> ct"
inductive_cases RepeatE[elim]: "(REPEAT c UNTIL b, s) \<rightarrow> ct"

text\<open>A simple property:\<close>
lemma deterministic:
  "cs \<rightarrow> cs' \<Longrightarrow> cs \<rightarrow> cs'' \<Longrightarrow> cs'' = cs'"
apply(induction arbitrary: cs'' rule: small_step.induct)
apply blast+
done

subsection "Equivalence with big-step semantics"

lemma star_seq2: "(c1,s) \<rightarrow>* (c1',s') \<Longrightarrow> (c1;;c2,s) \<rightarrow>* (c1';;c2,s')"
proof(induction rule: star_induct)
  case refl thus ?case by simp
next
  case step
  thus ?case by (metis Seq2 star.step)
qed

lemma seq_comp:
  "\<lbrakk> (c1,s1) \<rightarrow>* (SKIP,s2); (c2,s2) \<rightarrow>* (SKIP,s3) \<rbrakk>
   \<Longrightarrow> (c1;;c2, s1) \<rightarrow>* (SKIP,s3)"
by(blast intro: star.step star_seq2 star_trans)

text\<open>The following proof corresponds to one on the board where one would
show chains of \<open>\<rightarrow>\<close> and \<open>\<rightarrow>*\<close> steps.\<close>

lemma big_to_small:
  "cs \<Rightarrow> t \<Longrightarrow> cs \<rightarrow>* (SKIP,t)"
proof (induction rule: big_step.induct)
  fix s show "(SKIP,s) \<rightarrow>* (SKIP,s)" by simp
next
  fix x a s show "(x ::= a,s) \<rightarrow>* (SKIP, s(x := aval a s))" by auto
next
  fix c1 c2 s1 s2 s3
  assume "(c1,s1) \<rightarrow>* (SKIP,s2)" and "(c2,s2) \<rightarrow>* (SKIP,s3)"
  thus "(c1;;c2, s1) \<rightarrow>* (SKIP,s3)" by (rule seq_comp)
next
  fix s::state and b c0 c1 t
  assume "bval b s"
  hence "(IF b THEN c0 ELSE c1,s) \<rightarrow> (c0,s)" by simp
  moreover assume "(c0,s) \<rightarrow>* (SKIP,t)"
  ultimately
  show "(IF b THEN c0 ELSE c1,s) \<rightarrow>* (SKIP,t)" by (metis star.simps)
next
  fix s::state and b c0 c1 t
  assume "\<not>bval b s"
  hence "(IF b THEN c0 ELSE c1,s) \<rightarrow> (c1,s)" by simp
  moreover assume "(c1,s) \<rightarrow>* (SKIP,t)"
  ultimately
  show "(IF b THEN c0 ELSE c1,s) \<rightarrow>* (SKIP,t)" by (metis star.simps)
next
  fix b c and s::state
  assume b: "\<not>bval b s"
  let ?if = "IF b THEN c;; WHILE b DO c ELSE SKIP"
  have "(WHILE b DO c,s) \<rightarrow> (?if, s)" by blast
  moreover have "(?if,s) \<rightarrow> (SKIP, s)" by (simp add: b)
  ultimately show "(WHILE b DO c,s) \<rightarrow>* (SKIP,s)" by(metis star.refl star.step)
next
(* \<And>b s\<^sub>1 c s\<^sub>2 s\<^sub>3.
       bval b s\<^sub>1 \<Longrightarrow>
       (c, s\<^sub>1) \<Rightarrow> s\<^sub>2 \<Longrightarrow>
       (c, s\<^sub>1) \<rightarrow>* (SKIP, s\<^sub>2) \<Longrightarrow>
       (WHILE b DO c, s\<^sub>2) \<Rightarrow> s\<^sub>3 \<Longrightarrow>
       (WHILE b DO c, s\<^sub>2) \<rightarrow>* (SKIP, s\<^sub>3) \<Longrightarrow> (WHILE b DO c, s\<^sub>1) \<rightarrow>* (SKIP, s\<^sub>3) *)
  fix b c s s' t
  let ?w  = "WHILE b DO c"
  let ?if = "IF b THEN c;; ?w ELSE SKIP"
  assume w: "(?w,s') \<rightarrow>* (SKIP,t)"
  assume c: "(c,s) \<rightarrow>* (SKIP,s')"
  assume b: "bval b s"
  have "(?w,s) \<rightarrow> (?if, s)" by blast
  moreover have "(?if, s) \<rightarrow> (c;; ?w, s)" by (simp add: b)
  moreover have "(c;; ?w,s) \<rightarrow>* (SKIP,t)" by(rule seq_comp[OF c w])
  ultimately show "(WHILE b DO c,s) \<rightarrow>* (SKIP,t)" by (metis star.simps)
next
(* \<And>c s\<^sub>1 s\<^sub>2 b s\<^sub>3.
       (c, s\<^sub>1) \<Rightarrow> s\<^sub>2 \<Longrightarrow>
       (c, s\<^sub>1) \<rightarrow>* (SKIP, s\<^sub>2) \<Longrightarrow>
       bval b s\<^sub>2 \<Longrightarrow>
       (REPEAT c UNTIL b, s\<^sub>2) \<Rightarrow> s\<^sub>3 \<Longrightarrow>
       (REPEAT c UNTIL b, s\<^sub>2) \<rightarrow>* (SKIP, s\<^sub>3) \<Longrightarrow>
       (REPEAT c UNTIL b, s\<^sub>1) \<rightarrow>* (SKIP, s\<^sub>3) *)
(* Repeat: "(REPEAT c UNTIL b, s) \<rightarrow> (c;; IF b THEN REPEAT c UNTIL b ELSE SKIP, s)" *)
  fix c s1 s2 b s3
  let ?r = "REPEAT c UNTIL b"
  let ?if = "IF b THEN ?r ELSE SKIP"
  assume r: "(?r, s2) \<rightarrow>* (SKIP, s3)"
  assume c: "(c, s1) \<rightarrow>* (SKIP, s2)"
  assume b: "bval b s2"
  (* assume big_step_ih: "(?r, s1) \<Rightarrow> s2" *)
  have "(?r, s1) \<rightarrow>* (c;;?if, s1)" by simp
  moreover have "(c;;?if, s1) \<rightarrow>* (SKIP;;?if, s2)" by (simp add: c star_seq2)
  moreover have "(SKIP;;?if, s2) \<rightarrow>* (?if, s2)" by blast
  moreover have "(?if, s2) \<rightarrow>* (?r, s2)" by (simp add: b)
  moreover have "(?r, s2) \<rightarrow>* (SKIP, s3)" by (simp add: r)
  ultimately show "(REPEAT c UNTIL b, s1) \<rightarrow>* (SKIP, s3)" by (meson star_trans)
next
(* \<And>c s\<^sub>1 s\<^sub>2 b.
       (c, s\<^sub>1) \<Rightarrow> s\<^sub>2 \<Longrightarrow>
       (c, s\<^sub>1) \<rightarrow>* (SKIP, s\<^sub>2) \<Longrightarrow>
       \<not> bval b s\<^sub>2 \<Longrightarrow> (REPEAT c UNTIL b, s\<^sub>1) \<rightarrow>* (SKIP, s\<^sub>2) *)
  fix c s1 s2 b
  let ?r = "REPEAT c UNTIL b"
  let ?if = "IF b THEN ?r ELSE SKIP"
  assume c: "(c, s1) \<rightarrow>* (SKIP, s2)"
  assume b: "\<not> bval b s2"
  have "(?r, s1) \<rightarrow>* (c;;?if, s1)" by simp
  moreover have "(c;;?if, s1) \<rightarrow>* (SKIP;;?if, s2)" by (simp add: c star_seq2)
  moreover have "(SKIP;;?if, s2) \<rightarrow>* (?if, s2)" by blast
  moreover have "(?if, s2) \<rightarrow> (SKIP, s2)" by (simp add: b)
  then show "(?r, s1) \<rightarrow>* (SKIP, s2)" by (metis (mono_tags, lifting) Repeat calculation(2) calculation(3) star.simps star_trans)
qed

text\<open>Each case of the induction can be proved automatically:\<close>
lemma  "cs \<Rightarrow> t \<Longrightarrow> cs \<rightarrow>* (SKIP,t)"
proof (induction rule: big_step.induct)
  case Skip show ?case by blast
next
  case Assign show ?case by blast
next
  case Seq thus ?case by (blast intro: seq_comp)
next
  case IfTrue thus ?case by (blast intro: star.step)
next
  case IfFalse thus ?case by (blast intro: star.step)
next
  case WhileFalse thus ?case
    by (metis star.step star_step1 small_step.IfFalse small_step.While)
next
  case WhileTrue
  thus ?case
    by(metis While seq_comp small_step.IfTrue star.step[of small_step])
next
  case (RepeatTrue c s\<^sub>1 s\<^sub>2 b s\<^sub>3)
  then show ?case  using big_step.RepeatTrue big_to_small by auto
next
  case (RepeatFalse c s\<^sub>1 s\<^sub>2 b)
  then show ?case by (simp add: big_step.RepeatFalse big_to_small)
qed

lemma small1_big_continue:
  "cs \<rightarrow> cs' \<Longrightarrow> cs' \<Rightarrow> t \<Longrightarrow> cs \<Rightarrow> t"
apply (induction arbitrary: t rule: small_step.induct)
apply auto
done

lemma small_to_big:
  "cs \<rightarrow>* (SKIP,t) \<Longrightarrow> cs \<Rightarrow> t"
apply (induction cs "(SKIP,t)" rule: star.induct)
apply (auto intro: small1_big_continue)
done

text \<open>
  Finally, the equivalence theorem:
\<close>
theorem big_iff_small:
  "cs \<Rightarrow> t = cs \<rightarrow>* (SKIP,t)"
by(metis big_to_small small_to_big)

subsection "Final configurations and infinite reductions"

definition "final cs \<longleftrightarrow> \<not>(\<exists>cs'. cs \<rightarrow> cs')"

lemma finalD: "final (c,s) \<Longrightarrow> c = SKIP"
apply(simp add: final_def)
apply(induction c)
apply blast+
done

lemma final_iff_SKIP: "final (c,s) = (c = SKIP)"
by (metis SkipE finalD final_def)

text\<open>Now we can show that \<open>\<Rightarrow>\<close> yields a final state iff \<open>\<rightarrow>\<close>
terminates:\<close>

lemma big_iff_small_termination:
  "(\<exists>t. cs \<Rightarrow> t) \<longleftrightarrow> (\<exists>cs'. cs \<rightarrow>* cs' \<and> final cs')"
by(simp add: big_iff_small final_iff_SKIP)

text\<open>This is the same as saying that the absence of a big step result is
equivalent with absence of a terminating small step sequence, i.e.\ with
nontermination.  Since \<open>\<rightarrow>\<close> is determininistic, there is no difference
between may and must terminate.\<close>

end


(* This Isabelle theory is produced using the TIP tool offered at the following website:
     https://github.com/tip-org/tools
   This file was originally provided as part of TIP benchmark at the following website:
     https://github.com/tip-org/benchmarks
   Yutaka Nagashima at CIIRC, CTU changed the TIP output theory file slightly
   to make it compatible with Isabelle2017.*)
  theory TIP_nat_boring_min_idem
imports "../../Test_Base"
begin

datatype Nat = Z | S "Nat"

fun le :: "Nat => Nat => bool" where
"le (Z) y = True"
| "le (S z) (Z) = False"
| "le (S z) (S x2) = le z x2"

theorem property0 :
  "((if le x x then x else x) = x)"
  oops

end


(*  Title:      HOL/SPARK/Examples/RIPEMD-160/Hash.thy
    Author:     Fabian Immler, TU Muenchen

Verification of the RIPEMD-160 hash function
*)

theory Hash
imports RMD_Specification
begin

spark_open \<open>rmd/hash\<close>

abbreviation from_chain :: "chain \<Rightarrow> RMD.chain" where
  "from_chain c \<equiv> (
    word_of_int (h0 c),
    word_of_int (h1 c),
    word_of_int (h2 c),
    word_of_int (h3 c),
    word_of_int (h4 c))"

abbreviation to_chain :: "RMD.chain \<Rightarrow> chain" where
  "to_chain c \<equiv>
    (let (h0, h1, h2, h3, h4) = c in
      (|h0 = uint h0,
        h1 = uint h1,
        h2 = uint h2,
        h3 = uint h3,
        h4 = uint h4|))"

abbreviation round' :: "chain \<Rightarrow> block \<Rightarrow> chain" where
  "round' c b == to_chain (round (\<lambda>n. word_of_int (b (int n))) (from_chain c))"

abbreviation rounds' :: "chain \<Rightarrow> int \<Rightarrow> message \<Rightarrow> chain" where
  "rounds' h i X ==
     to_chain (rounds
      (\<lambda>n. \<lambda>m. word_of_int (X (int n) (int m)))
      (from_chain h)
      (nat i))"

abbreviation rmd_hash :: "message \<Rightarrow> int \<Rightarrow> chain" where
  "rmd_hash X i == to_chain (rmd
    (\<lambda>n. \<lambda>m. word_of_int (X (int n) (int m)))
    (nat i))"

spark_proof_functions
  round_spec = round'
  rounds = rounds'
  rmd_hash = rmd_hash

spark_vc function_hash_12
  using H1 H6
  by (simp add:
    rounds_def rmd_body_def round_def
    h_0_def h0_0_def h1_0_def h2_0_def h3_0_def h4_0_def)

lemma rounds_step:
  assumes "0 <= i"
  shows "rounds X b (Suc i) = round (X i) (rounds X b i)"
  by (simp add: rounds_def rmd_body_def)

lemma from_to_id: "from_chain (to_chain C) = C"
proof (cases C)
  fix a b c d e f::word32
  assume "C = (a, b, c, d, e)"
  thus ?thesis by (cases a) simp
qed

lemma steps_to_steps':
  "round X (foldl a b c) = round X (from_chain (to_chain (foldl a b c)))"
  unfolding from_to_id ..

lemma rounds'_step:
  assumes "0 <= i"
  shows "rounds' c (i + 1) x = round' (rounds' c i x) (x i)"
proof -
  have makesuc: "nat (i + 1) = Suc (nat i)" using assms by simp
  show ?thesis using assms
    by (simp add: makesuc rounds_def rmd_body_def steps_to_steps')
qed

spark_vc function_hash_13
proof -
  have loop_suc: "loop__1__i + 2 = (loop__1__i + 1) + 1" by simp
  have "0 <= loop__1__i + 1" using \<open>0 <= loop__1__i\<close> by simp
  show ?thesis
    unfolding loop_suc
    unfolding rounds'_step[OF \<open>0 <= loop__1__i + 1\<close>]
    unfolding H1[symmetric]
    unfolding H18 ..
qed

spark_vc function_hash_17
  unfolding rmd_def H1 rounds_def ..

spark_end

end


(* Author: Andrew Boyton, 2012
   Maintainers: Gerwin Klein <kleing at cse.unsw.edu.au>
                Rafal Kolanski <rafal.kolanski at nicta.com.au>
*)

section "Defining some separation logic maps-to predicates on top of the instantiation."

theory Separation_D
imports Abstract_Separation_D
begin

type_synonym sep_pred = "sep_state \<Rightarrow> bool"

definition
  state_sep_projection :: "cdl_state \<Rightarrow> sep_state"
where
  "state_sep_projection \<equiv> \<lambda>s. SepState (cdl_objects s) (cdl_ghost_state s)"

(* This turns a separation logic predicate into a predicate on the capDL state. *)
abbreviation
  lift' :: "(sep_state \<Rightarrow> 'a) \<Rightarrow> cdl_state \<Rightarrow> 'a" ("<_>")
where
  "<P> s \<equiv> P (state_sep_projection s)"

(* The generalisation of the maps to operator for separation logic. *)
definition
  sep_map_general :: "cdl_object_id \<Rightarrow> cdl_object \<Rightarrow> cdl_components \<Rightarrow> sep_pred"
where
  "sep_map_general p obj gs \<equiv> \<lambda>s. sep_heap s = [p \<mapsto> obj] \<and> sep_ghost_state s p = gs"

(* Alternate definition without the [p \<mapsto> obj] notation. *)
lemma sep_map_general_def2:
  "sep_map_general p obj gs s =
   (dom (sep_heap s) = {p} \<and> ko_at obj p (sep_heap s) \<and> sep_ghost_state s p = gs)"
  apply (clarsimp simp: sep_map_general_def object_at_def)
  apply (rule)
   apply clarsimp
  apply (clarsimp simp: fun_upd_def)
  apply (rule ext)
  apply (fastforce simp: dom_def split:if_split)
  done

(* There is an object there. *)
definition
  sep_map_i :: "cdl_object_id \<Rightarrow> cdl_object \<Rightarrow> sep_pred" ("_ \<mapsto>i _" [76,71] 76)
where
  "p \<mapsto>i obj \<equiv> sep_map_general p obj UNIV"

(* The fields are there (and there are no caps). *)
definition
  sep_map_f :: "cdl_object_id \<Rightarrow> cdl_object \<Rightarrow> sep_pred" ("_ \<mapsto>f _" [76,71] 76)
where
  "p \<mapsto>f obj \<equiv> sep_map_general p (update_slots Map.empty obj) {None}"

(* There is that cap there. *)
definition
  sep_map_c :: "cdl_cap_ref \<Rightarrow> cdl_cap \<Rightarrow> sep_pred" ("_ \<mapsto>c _" [76,71] 76)
where
  "p \<mapsto>c cap \<equiv> \<lambda>s. let (obj_id, slot) = p; heap = sep_heap s in
  \<exists>obj. sep_map_general obj_id obj {Some slot} s \<and> object_slots obj = [slot \<mapsto> cap]"

definition
  sep_any :: "('a \<Rightarrow> 'b \<Rightarrow> sep_pred) \<Rightarrow> ('a \<Rightarrow> sep_pred)" where
  "sep_any m \<equiv> (\<lambda>p s. \<exists>v. (m p v) s)"

abbreviation "sep_any_map_i \<equiv> sep_any sep_map_i"
notation sep_any_map_i ("_ \<mapsto>i -" 76)

abbreviation "sep_any_map_c \<equiv> sep_any sep_map_c"
notation sep_any_map_c ("_ \<mapsto>c -" 76)

end


theory Big_Step_7p10
imports Com_7p10
begin

(* concrete syntax (_,_) \<Rightarrow> _ is possible becasue we declared the transition arrow \<Rightarrow> as an
   infix symbol below with precendence 55 *)

inductive
  big_step :: "com \<times> state \<Rightarrow> com \<times> state \<Rightarrow> bool" (infix "\<Rightarrow>" 55)
where

Skip:       "(SKIP,s) \<Rightarrow> (SKIP, s)" |
Throw:      "(THROW, s) \<Rightarrow> (THROW, s)" |
Assign:     "(x ::= a,s) \<Rightarrow> (SKIP, s(x := aval a s))" |
Seq1:       "\<lbrakk> (c\<^sub>1,s\<^sub>1) \<Rightarrow> (SKIP, s\<^sub>2); (c\<^sub>2,s\<^sub>2) \<Rightarrow> (x, s\<^sub>3) \<rbrakk> \<Longrightarrow> (c\<^sub>1;;c\<^sub>2, s\<^sub>1) \<Rightarrow> (x, s\<^sub>3)" |
Seq2:       "\<lbrakk> (c\<^sub>1,s\<^sub>1) \<Rightarrow> (THROW, s\<^sub>2) \<rbrakk> \<Longrightarrow> (c\<^sub>1;;c\<^sub>2, s\<^sub>1) \<Rightarrow> (THROW, s\<^sub>2)" |
IfTrue:     "\<lbrakk> bval b s;   (c\<^sub>1,s) \<Rightarrow> (x,t) \<rbrakk> \<Longrightarrow> (IF b THEN c\<^sub>1 ELSE c\<^sub>2, s) \<Rightarrow> (x,t)"  |
IfFalse:    "\<lbrakk> \<not>bval b s;  (c\<^sub>2,s) \<Rightarrow> (x,t) \<rbrakk> \<Longrightarrow> (IF b THEN c\<^sub>1 ELSE c\<^sub>2, s) \<Rightarrow> (x,t)" |
WhileFalse: "\<not>bval b s \<Longrightarrow> (WHILE b DO c,s) \<Rightarrow> (SKIP, s)" |
WhileTrue1:  "\<lbrakk> bval b s\<^sub>1;  (c,s\<^sub>1) \<Rightarrow> (SKIP, s\<^sub>2);  (WHILE b DO c, s\<^sub>2) \<Rightarrow> (x,s\<^sub>3) \<rbrakk>
              \<Longrightarrow> (WHILE b DO c, s\<^sub>1) \<Rightarrow> (x,s\<^sub>3)"  |
WhileTrue2:  "\<lbrakk> bval b s\<^sub>1;  (c,s\<^sub>1) \<Rightarrow> (THROW, s\<^sub>2) \<rbrakk> \<Longrightarrow> (WHILE b DO c, s\<^sub>1) \<Rightarrow> (THROW, s\<^sub>2)" |
Try1:        "\<lbrakk> c\<^sub>1 \<noteq> THROW; (c\<^sub>1,s) \<Rightarrow> (x,t) \<rbrakk> \<Longrightarrow> (TRY c\<^sub>1 CATCH c\<^sub>2, s) \<Rightarrow> (x,t)" |
Try2:        "(c\<^sub>2, s) \<Rightarrow> (x,t)                \<Longrightarrow> (TRY THROW CATCH c\<^sub>2, s) \<Rightarrow> (x,t)"

(* `print_theorems` is incredibly useful for seeing what certain
   declarations bring into scope *)
print_theorems

declare big_step.intros [intro]

(* From the textbook:
"This induction schema is almost perfect for our purposes, but
our trick for reusing the tuple syntax means that the induction
schema has two parameters instead of the @{text c}, @{text s},
and @{text s'} that we are likely to encounter. Splitting
the tuple parameter fixes this:"
*)
lemmas big_step_induct = big_step.induct[split_format(complete)]
thm big_step_induct

schematic_goal ex: "(''x'' ::= N 5;; ''y'' ::= V ''x'', s) \<Rightarrow> (SKIP, ?t)"
  apply(rule Seq1)
   apply(rule Assign)
    apply simp
   apply(rule Assign)
done

(* The following command tells Isabelle to generate code for the predicate \<Rightarrow> and thus make the
predicate available in the `values` command, which is similar to `value`, but works on
inductive definitions and computes a set of possible results.  *)

code_pred big_step . (* The period is necessary at the end of this line *)

values "{t. (SKIP, \<lambda>_. 0) \<Rightarrow> t}"

values "{map t [''x'', ''y'']| t. (''x'' ::= N 2;; ''y'' ::= plus (V ''x'') (N 1), \<lambda>_.0) \<Rightarrow> (SKIP, t)}"

(* 7.2.3 Rule Inversion *)

(* Inductive definitions like above bring into scope automatically generated .induct and .cases theorems *)

(* Now we prove a bunch of rule inversions. I've decided not to use inductive_cases as in
   the official solutions and instead prove the rule inversions as they were expressed in
   the textbook.

   I must mention my indebtedness to this particular Isabelle mailing list post:
   https://lists.cam.ac.uk/pipermail/cl-isabelle-users/2013-January/msg00118.html

*)

lemma SkipE[elim!]: "(SKIP, s) \<Rightarrow> (SKIP, t) \<Longrightarrow> t = s"
  by (erule big_step.cases, simp+)

lemma ThrowE[elim!]: "(THROW, s) \<Rightarrow> (THROW, t) \<Longrightarrow> t = s"
  by (erule big_step.cases, simp+)

lemma AssignE[elim!]:  "(x ::= a,s) \<Rightarrow> (SKIP, t) \<Longrightarrow> t = s(x := aval a s)"
  by (erule big_step.cases, simp+)

lemma SeqE[elim!]: "(c1;;c2, s1) \<Rightarrow> (x,s\<^sub>3) \<Longrightarrow> (\<exists>s2. (c1,s1) \<Rightarrow> (SKIP, s2) \<and> (c2,s2) \<Rightarrow> (x, s\<^sub>3))
                                            \<or> (c1,s1) \<Rightarrow> (THROW, s\<^sub>3)"
  by (erule big_step.cases, auto)

lemma IfE[elim!]: "(IF b THEN c1 ELSE c2,s) \<Rightarrow> (x,t) \<Longrightarrow> bval b s \<and> (c1, s) \<Rightarrow> (x,t) \<or> \<not>bval b s \<and> (c2, s) \<Rightarrow> (x, t)"
  by (erule big_step.cases, simp+)

lemma WhileE[elim]:
  "(WHILE b DO c, s) \<Rightarrow> (x,t)
  \<Longrightarrow>   bval b s \<and> (\<exists>s'. (c, s) \<Rightarrow> (SKIP, s') \<and> (WHILE b DO c, s') \<Rightarrow> (x, t))
      \<or> bval b s \<and> (c,s) \<Rightarrow> (THROW, t)
      \<or> \<not>bval b s \<and> t = s"
  by (erule big_step.cases, auto)

lemma TryE[elim!]: "(TRY c\<^sub>1 CATCH c\<^sub>2, s) \<Rightarrow> (x,t) \<Longrightarrow> c\<^sub>1 \<noteq> THROW \<and> (c\<^sub>1, s) \<Rightarrow> (x,t)
                                         \<or> c\<^sub>1 = THROW \<and> (c\<^sub>2, s) \<Rightarrow> (x,t)"
  by (erule big_step.cases, auto)

inductive_cases SkipE2[elim!]: "(SKIP, s) \<Rightarrow> xt"
inductive_cases ThrowE2[elim!]: "(THROW, s) \<Rightarrow> xt"
inductive_cases AssignE2[elim!]: "(x ::= a,s) \<Rightarrow> xt"
inductive_cases SeqE2[elim!]: "(c1;;c2,s1) \<Rightarrow> xs3"
inductive_cases IfE2[elim!]: "(IF b THEN c1 ELSE c2,s) \<Rightarrow> xt"
inductive_cases WhileE2[elim]: "(WHILE b DO c,s) \<Rightarrow> xt"
inductive_cases TryE2[elim!]: "(TRY c\<^sub>1 CATCH c\<^sub>2, s) \<Rightarrow> xt"

(* Lemma 7.2 *)
lemma seq_assoc_l: "(c1;; c2;; c3, s) \<Rightarrow> (x, s') \<Longrightarrow> (c1;; (c2;; c3), s) \<Rightarrow> (x, s')"
 by auto

lemma seq_assoc_r: "(c1;; (c2;; c3), s) \<Rightarrow> (x, s') \<Longrightarrow> (c1;; c2;; c3, s) \<Rightarrow> (x, s')"
  by auto

lemma seq_assoc: "(c1;; c2;; c3, s) \<Rightarrow> s' \<longleftrightarrow> (c1;; (c2;; c3), s) \<Rightarrow> s'"
  by (auto simp: seq_assoc_l seq_assoc_r)

(* Section 7.2.4 *)

abbreviation
  equiv_c :: "com \<Rightarrow> com \<Rightarrow> bool" (infix "\<sim>" 50) where
  "c \<sim> c' \<equiv> (\<forall>s t. (c, s) \<Rightarrow> t = (c', s) \<Rightarrow> t)"

print_theorems

lemma while_if_equiv: "WHILE b DO c \<sim> IF b THEN (c;; WHILE b DO c) ELSE SKIP"
  by blast

lemma if_equiv: "IF b THEN c ELSE c \<sim> c"
  by auto

(* Lemma 7.6 *)
(* Uses advanced rule induction from section 5.4.6 *)

lemma
  assumes "(WHILE b DO c, s) \<Rightarrow> (x,t)"
  assumes "c \<sim> c'"
  shows "(WHILE b DO c', s) \<Rightarrow> (x,t)"
using assms
  apply (induct "(WHILE b DO c, s)" "(x,t)" arbitrary: s)
   apply blast
  apply auto
  done

  (* or you can do *)
lemma  while_equiv_aux: "(WHILE b DO c, s) \<Rightarrow> (x,t) \<Longrightarrow> c \<sim> c' \<Longrightarrow> (WHILE b DO c', s) \<Rightarrow> (x,t)"
  apply(induction "(WHILE b DO c)" s x t arbitrary: b c  rule: big_step_induct)
   apply auto
  done

(*
  I found the unification that was going on with the advance rule induction to be a bit
  mysterious. The following theorem is very close to what we get after:

  apply (induction "(WHILE b DO c, s)" t arbitrary: b c s rule: big_step.induct)
*)

thm big_step.induct[of "(WHILE b DO c, s)" "t" "\<lambda>(c,s1) s2. \<forall>b ca. c = WHILE b DO ca \<longrightarrow> ca \<sim> c' \<longrightarrow> (WHILE b DO c', s1) \<Rightarrow> s2"]

(* Peter Gammie showed me how to get exactly what you get after the induction step in the proofs
   above. Not the use of the `for` construct and the `rule_format` attribute (also known as a
   "directive")
*)

lemmas unified_big_step = big_step.induct[of "(WHILE b DO c, s)" "t"
  "\<lambda>(c,s1) s2. \<forall>b ca. c = WHILE b DO ca \<longrightarrow> ca \<sim> c' \<longrightarrow> (WHILE b DO c', s1) \<Rightarrow> s2", simplified,
    rule_format] for b c c' s t

(* We can now prove the lemma again with this new theorem *)
lemma  "(WHILE b DO c, s) \<Rightarrow> t \<Longrightarrow> c \<sim> c' \<Longrightarrow> (WHILE b DO c', s) \<Rightarrow> t"
  apply (erule unified_big_step)
  apply auto
  done

(* We now use Lemma 7.6 to prove the following *)
lemma while_equiv: "c \<sim> c' \<Longrightarrow> WHILE b DO c \<sim> WHILE b DO c'"
  by (auto simp: while_equiv_aux)

(* Lemma 7.8 *)

lemma sim_refl: "c \<sim> c" by auto
lemma sim_sym: "c \<sim> c' \<Longrightarrow> c' \<sim> c" by auto
lemma sim_trans: "\<lbrakk> c \<sim> c'; c' \<sim> c'' \<rbrakk> \<Longrightarrow> c \<sim> c''" by auto

(* Lemma 7.9 IMP is deterministic*)
lemma imp_deterministic: "\<lbrakk> (c,s) \<Rightarrow> (x,t); (c,s) \<Rightarrow> (x',t') \<rbrakk> \<Longrightarrow> x' = x \<and> t' = t"
  apply (induction c s x t arbitrary: x' t' rule: big_step_induct)
  apply blast+
  done

lemma big_step_to_SKIP_or_THROW: "(c,s) \<Rightarrow> (x,t) \<Longrightarrow>  x = SKIP \<or> x = THROW"
  by (induction c s x t rule: big_step_induct, blast+)

end


theory Prelude_Maybe
imports "$HETS_ISABELLE_LIB/MainHC"
uses "$HETS_ISABELLE_LIB/prelude"
begin

setup "Header.initialize
       [\"NotFalse\", \"NotTrue\", \"AndFalse\", \"AndTrue\", \"AndSym\",
        \"OrDef\", \"OtherwiseDef\", \"NotFalse1\", \"NotTrue1\",
        \"notNot1\", \"notNot2\", \"EqualTDef\", \"EqualSymDef\",
        \"EqualReflex\", \"EqualTransT\", \"DiffDef\", \"DiffSymDef\",
        \"DiffTDef\", \"DiffFDef\", \"TE1\", \"TE2\", \"TE3\", \"TE4\",
        \"IUE1\", \"IUE2\", \"IBE1\", \"IBE2\", \"IBE3\", \"IBE4\",
        \"IBE5\", \"IBE6\", \"IBE7\", \"IBE8\", \"IOE01\", \"IOE02\",
        \"IOE03\", \"IOE04\", \"IOE05\", \"IOE06\", \"IOE07\", \"IOE08\",
        \"IOE09\", \"LeIrreflexivity\", \"LeTAsymmetry\",
        \"LeTTransitive\", \"LeTTotal\", \"GeDef\", \"GeIrreflexivity\",
        \"GeTAsymmetry\", \"GeTTransitive\", \"GeTTotal\", \"LeqDef\",
        \"LeqReflexivity\", \"LeqTTransitive\", \"LeqTTotal\", \"GeqDef\",
        \"GeqReflexivity\", \"GeqTTransitive\", \"GeqTTotal\",
        \"EqTSOrdRel\", \"EqFSOrdRel\", \"EqTOrdRel\", \"EqFOrdRel\",
        \"EqTOrdTSubstE\", \"EqTOrdFSubstE\", \"EqTOrdTSubstD\",
        \"EqTOrdFSubstD\", \"LeTGeFEqFRel\", \"LeFGeTEqTRel\",
        \"LeTGeTRel\", \"LeFGeFRel\", \"LeqTGetTRel\", \"LeqFGetFRel\",
        \"GeTLeTRel\", \"GeFLeFRel\", \"GeqTLeqTRel\", \"GeqFLeqFRel\",
        \"LeqTGeFRel\", \"LeqFGeTRel\", \"GeTLeFEqFRel\", \"GeFLeTEqTRel\",
        \"GeqTLeFRel\", \"GeqFLeTRel\", \"LeqTLeTEqTRel\",
        \"LeqFLeFEqFRel\", \"GeqTGeTEqTRel\", \"GeqFGeFEqFRel\",
        \"LeTGeqFRel\", \"GeTLeqFRel\", \"LeLeqDiff\", \"CmpLTDef\",
        \"CmpEQDef\", \"CmpGTDef\", \"MaxYDef\", \"MaxXDef\", \"MinXDef\",
        \"MinYDef\", \"MaxSym\", \"MinSym\", \"TO1\", \"TO3\", \"TO4\",
        \"TO5\", \"TO6\", \"IUO01\", \"IUO02\", \"IUO03\", \"IUO04\",
        \"IUO05\", \"IUO06\", \"IUO07\", \"IOO13\", \"IOO14\", \"IOO15\",
        \"IOO16\", \"IOO17\", \"IOO18\", \"IOO19\", \"IOO20\", \"IOO21\",
        \"IOO22\", \"IOO23\", \"IOO24\", \"IOO25\", \"IOO26\", \"IOO27\",
        \"IOO28\", \"IOO29\", \"IOO30\", \"IOO31\", \"IOO32\", \"IOO33\",
        \"IBO5\", \"IBO6\", \"IBO7\", \"IBO8\", \"IBO9\", \"IBO10\",
        \"IBO11\", \"IBO12\", \"MaybeJustDef\", \"MaybeNothingDef\",
        \"IME01\", \"IME03\", \"IMO01\", \"IMO02\", \"IME02\", \"IMO03\",
        \"IMO04\", \"IMO05\", \"IMO06\", \"IMO07\", \"IMO08\", \"IMO09\",
        \"IMO10\", \"IMO11\", \"IMO12\"]"

typedecl Bool
typedecl Unit
typedecl X_Nat

datatype Ordering = EQ | GT | LT
datatype 'a Maybe = X_Just "'a partial" ("Just/'(_')" [3] 999) |
                    Nothing

consts
X__XAmpXAmp__X :: "bool => bool => bool" ("(_/ &&/ _)" [54,54] 52)
X__XEqXEq__X :: "'a partial => 'a partial => bool" ("(_/ ==''/ _)" [54,54] 52)
X__XGtXEq__X :: "'a partial => 'a partial => bool" ("(_/ >=''/ _)" [54,54] 52)
X__XGt__X :: "'a partial => 'a partial => bool" ("(_/ >''/ _)" [54,54] 52)
X__XLtXEq__X :: "'a partial => 'a partial => bool" ("(_/ <=''/ _)" [54,54] 52)
X__XLt__X :: "'a partial => 'a partial => bool" ("(_/ <''/ _)" [54,54] 52)
X__XSlashXEq__X :: "'a partial => 'a partial => bool" ("(_/ '/=/ _)" [54,54] 52)
X__XVBarXVBar__X :: "bool => bool => bool" ("(_/ ||/ _)" [54,54] 52)
X_max :: "'a partial => 'a partial => 'a partial"
X_min :: "'a partial => 'a partial => 'a partial"
compare :: "'a partial => 'a partial => Ordering partial"
maybe :: "'b partial => ('a partial => 'b partial) => 'a Maybe partial => 'b partial"
notH__X :: "bool => bool" ("(notH/ _)" [56] 56)
otherwiseH :: "bool"

axioms
NotFalse [rule_format] : "notH False"

NotTrue [rule_format] : "~ notH True"

AndFalse [rule_format] : "ALL (x :: bool). ~ False && x"

AndTrue [rule_format] : "ALL (x :: bool). True && x = x"

AndSym [rule_format] :
"ALL (x :: bool). ALL (y :: bool). x && y = y && x"

OrDef [rule_format] :
"ALL (x :: bool).
 ALL (y :: bool). x || y = notH (notH x && notH y)"

OtherwiseDef [rule_format] : "otherwiseH"

NotFalse1 [rule_format] : "ALL (x :: bool). notH x = (~ x)"

NotTrue1 [rule_format] : "ALL (x :: bool). ~ notH x = x"

notNot1 [rule_format] : "ALL (x :: bool). (~ x) = notH x"

notNot2 [rule_format] : "ALL (x :: bool). (~ ~ x) = (~ notH x)"

EqualTDef [rule_format] :
"ALL (x :: 'a partial). ALL (y :: 'a partial). x = y --> x ==' y"

EqualSymDef [rule_format] :
"ALL (x :: 'a partial). ALL (y :: 'a partial). x ==' y = y ==' x"

EqualReflex [rule_format] : "ALL (x :: 'a partial). x ==' x"

EqualTransT [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial).
 ALL (z :: 'a partial). x ==' y & y ==' z --> x ==' z"

DiffDef [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). x /= y = notH (x ==' y)"

DiffSymDef [rule_format] :
"ALL (x :: 'a partial). ALL (y :: 'a partial). x /= y = y /= x"

DiffTDef [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). x /= y = notH (x ==' y)"

DiffFDef [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). (~ x /= y) = x ==' y"

TE1 [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). ~ x ==' y --> ~ x = y"

TE2 [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). notH (x ==' y) = (~ x ==' y)"

TE3 [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). (~ notH (x ==' y)) = x ==' y"

TE4 [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). (~ x ==' y) = (~ x ==' y)"

IUE1 [rule_format] : "makePartial () ==' makePartial ()"

IUE2 [rule_format] : "~ makePartial () /= makePartial ()"

IBE1 [rule_format] : "makePartial () ==' makePartial ()"

IBE2 [rule_format] : "undefinedOp ==' undefinedOp"

IBE3 [rule_format] : "~ undefinedOp ==' makePartial ()"

IBE4 [rule_format] : "~ makePartial () ==' undefinedOp"

IBE5 [rule_format] : "makePartial () /= undefinedOp"

IBE6 [rule_format] : "undefinedOp /= makePartial ()"

IBE7 [rule_format] : "notH (makePartial () ==' undefinedOp)"

IBE8 [rule_format] : "~ notH notH (makePartial () ==' undefinedOp)"

IOE01 [rule_format] : "makePartial LT ==' makePartial LT"

IOE02 [rule_format] : "makePartial EQ ==' makePartial EQ"

IOE03 [rule_format] : "makePartial GT ==' makePartial GT"

IOE04 [rule_format] : "~ makePartial LT ==' makePartial EQ"

IOE05 [rule_format] : "~ makePartial LT ==' makePartial GT"

IOE06 [rule_format] : "~ makePartial EQ ==' makePartial GT"

IOE07 [rule_format] : "makePartial LT /= makePartial EQ"

IOE08 [rule_format] : "makePartial LT /= makePartial GT"

IOE09 [rule_format] : "makePartial EQ /= makePartial GT"

LeIrreflexivity [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). x ==' y --> ~ x <' y"

LeTAsymmetry [rule_format] :
"ALL (x :: 'a partial). ALL (y :: 'a partial). x <' y --> ~ y <' x"

LeTTransitive [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial).
 ALL (z :: 'a partial). x <' y & y <' z --> x <' z"

LeTTotal [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). (x <' y | y <' x) | x ==' y"

GeDef [rule_format] :
"ALL (x :: 'a partial). ALL (y :: 'a partial). x >' y = y <' x"

GeIrreflexivity [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). x ==' y --> ~ x >' y"

GeTAsymmetry [rule_format] :
"ALL (x :: 'a partial). ALL (y :: 'a partial). x >' y --> ~ y >' x"

GeTTransitive [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial).
 ALL (z :: 'a partial). (x >' y) && (y >' z) --> x >' z"

GeTTotal [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). ((x >' y) || (y >' x)) || (x ==' y)"

LeqDef [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). x <=' y = (x <' y) || (x ==' y)"

LeqReflexivity [rule_format] : "ALL (x :: 'a partial). x <=' x"

LeqTTransitive [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial).
 ALL (z :: 'a partial). (x <=' y) && (y <=' z) --> x <=' z"

LeqTTotal [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). (x <=' y) && (y <=' x) = x ==' y"

GeqDef [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). x >=' y = (x >' y) || (x ==' y)"

GeqReflexivity [rule_format] : "ALL (x :: 'a partial). x >=' x"

GeqTTransitive [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial).
 ALL (z :: 'a partial). (x >=' y) && (y >=' z) --> x >=' z"

GeqTTotal [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). (x >=' y) && (y >=' x) = x ==' y"

EqTSOrdRel [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). x ==' y = (~ x <' y & ~ x >' y)"

EqFSOrdRel [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). (~ x ==' y) = (x <' y | x >' y)"

EqTOrdRel [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). x ==' y = (x <=' y & x >=' y)"

EqFOrdRel [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). (~ x ==' y) = (x <=' y | x >=' y)"

EqTOrdTSubstE [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial).
 ALL (z :: 'a partial). x ==' y & y <' z --> x <' z"

EqTOrdFSubstE [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial).
 ALL (z :: 'a partial). x ==' y & ~ y <' z --> ~ x <' z"

EqTOrdTSubstD [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial).
 ALL (z :: 'a partial). x ==' y & z <' y --> z <' x"

EqTOrdFSubstD [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial).
 ALL (z :: 'a partial). x ==' y & ~ z <' y --> ~ z <' x"

LeTGeFEqFRel [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). x <' y = (~ x >' y & ~ x ==' y)"

LeFGeTEqTRel [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). (~ x <' y) = (x >' y | x ==' y)"

LeTGeTRel [rule_format] :
"ALL (x :: 'a partial). ALL (y :: 'a partial). x <' y = y >' x"

LeFGeFRel [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). (~ x <' y) = (~ y >' x)"

LeqTGetTRel [rule_format] :
"ALL (x :: 'a partial). ALL (y :: 'a partial). x <=' y = y >=' x"

LeqFGetFRel [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). (~ x <=' y) = (~ y >=' x)"

GeTLeTRel [rule_format] :
"ALL (x :: 'a partial). ALL (y :: 'a partial). x >' y = y <' x"

GeFLeFRel [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). (~ x >' y) = (~ y <' x)"

GeqTLeqTRel [rule_format] :
"ALL (x :: 'a partial). ALL (y :: 'a partial). x >=' y = y <=' x"

GeqFLeqFRel [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). (~ x >=' y) = (~ y <=' x)"

LeqTGeFRel [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). x <=' y = (~ x >' y)"

LeqFGeTRel [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). (~ x <=' y) = x >' y"

GeTLeFEqFRel [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). x >' y = (~ x <' y & ~ x ==' y)"

GeFLeTEqTRel [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). (~ x >' y) = (x <' y | x ==' y)"

GeqTLeFRel [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). x >=' y = (~ x <' y)"

GeqFLeTRel [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). (~ x >=' y) = x <' y"

LeqTLeTEqTRel [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). x <=' y = (x <' y | x ==' y)"

LeqFLeFEqFRel [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). (~ x <=' y) = (~ x <' y & ~ x ==' y)"

GeqTGeTEqTRel [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). x >=' y = (x >' y | x ==' y)"

GeqFGeFEqFRel [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). (~ x >=' y) = (~ x >' y & ~ x ==' y)"

LeTGeqFRel [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). x <' y = (~ x >=' y)"

GeTLeqFRel [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). x >' y = (~ x <=' y)"

LeLeqDiff [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). x <' y = (x <=' y) && (x /= y)"

CmpLTDef [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). compare x y ==' makePartial LT = x <' y"

CmpEQDef [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). compare x y ==' makePartial EQ = x ==' y"

CmpGTDef [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). compare x y ==' makePartial GT = x >' y"

MaxYDef [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). X_max x y ==' y = x <=' y"

MaxXDef [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). X_max x y ==' x = y <=' x"

MinXDef [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). X_min x y ==' x = x <=' y"

MinYDef [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). X_min x y ==' y = y <=' x"

MaxSym [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). X_max x y ==' y = X_max y x ==' y"

MinSym [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). X_min x y ==' y = X_min y x ==' y"

TO1 [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). (x ==' y | x <' y) = x <=' y"

TO3 [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). notH notH (x <' y) | notH (x <' y)"

TO4 [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). x <' y --> notH (x ==' y)"

TO5 [rule_format] :
"ALL (w :: 'a partial).
 ALL (x :: 'a partial).
 ALL (y :: 'a partial).
 ALL (z :: 'a partial). (x <' y & y <' z) & z <' w --> x <' w"

TO6 [rule_format] :
"ALL (x :: 'a partial).
 ALL (z :: 'a partial). z <' x --> notH (x <' z)"

IUO01 [rule_format] : "makePartial () <=' makePartial ()"

IUO02 [rule_format] : "~ makePartial () <' makePartial ()"

IUO03 [rule_format] : "makePartial () >=' makePartial ()"

IUO04 [rule_format] : "~ makePartial () >' makePartial ()"

IUO05 [rule_format] :
"X_max (makePartial ()) (makePartial ()) ==' makePartial ()"

IUO06 [rule_format] :
"X_min (makePartial ()) (makePartial ()) ==' makePartial ()"

IUO07 [rule_format] :
"compare (makePartial ()) (makePartial ()) ==' makePartial EQ"

IOO13 [rule_format] : "makePartial LT <' makePartial EQ"

IOO14 [rule_format] : "makePartial EQ <' makePartial GT"

IOO15 [rule_format] : "makePartial LT <' makePartial GT"

IOO16 [rule_format] : "makePartial LT <=' makePartial EQ"

IOO17 [rule_format] : "makePartial EQ <=' makePartial GT"

IOO18 [rule_format] : "makePartial LT <=' makePartial GT"

IOO19 [rule_format] : "makePartial EQ >=' makePartial LT"

IOO20 [rule_format] : "makePartial GT >=' makePartial EQ"

IOO21 [rule_format] : "makePartial GT >=' makePartial LT"

IOO22 [rule_format] : "makePartial EQ >' makePartial LT"

IOO23 [rule_format] : "makePartial GT >' makePartial EQ"

IOO24 [rule_format] : "makePartial GT >' makePartial LT"

IOO25 [rule_format] :
"X_max (makePartial LT) (makePartial EQ) ==' makePartial EQ"

IOO26 [rule_format] :
"X_max (makePartial EQ) (makePartial GT) ==' makePartial GT"

IOO27 [rule_format] :
"X_max (makePartial LT) (makePartial GT) ==' makePartial GT"

IOO28 [rule_format] :
"X_min (makePartial LT) (makePartial EQ) ==' makePartial LT"

IOO29 [rule_format] :
"X_min (makePartial EQ) (makePartial GT) ==' makePartial EQ"

IOO30 [rule_format] :
"X_min (makePartial LT) (makePartial GT) ==' makePartial LT"

IOO31 [rule_format] :
"compare (makePartial LT) (makePartial LT) ==' makePartial EQ"

IOO32 [rule_format] :
"compare (makePartial EQ) (makePartial EQ) ==' makePartial EQ"

IOO33 [rule_format] :
"compare (makePartial GT) (makePartial GT) ==' makePartial EQ"

IBO5 [rule_format] : "undefinedOp <' makePartial ()"

IBO6 [rule_format] : "~ undefinedOp >=' makePartial ()"

IBO7 [rule_format] : "makePartial () >=' undefinedOp"

IBO8 [rule_format] : "~ makePartial () <' undefinedOp"

IBO9 [rule_format] :
"X_max undefinedOp (makePartial ()) ==' makePartial ()"

IBO10 [rule_format] :
"X_min undefinedOp (makePartial ()) ==' undefinedOp"

IBO11 [rule_format] :
"compare (makePartial ()) (makePartial ()) ==' makePartial EQ"

IBO12 [rule_format] :
"compare undefinedOp undefinedOp ==' makePartial EQ"

MaybeJustDef [rule_format] :
"ALL (f :: 'a partial => 'b partial).
 ALL (x :: 'a partial).
 ALL (y :: 'b partial). maybe y f (makePartial (Just(x))) = f x"

MaybeNothingDef [rule_format] :
"ALL (f :: 'a partial => 'b partial).
 ALL (y :: 'b partial). maybe y f (makePartial Nothing) = y"

IME01 [rule_format] :
"ALL (x :: 'e partial).
 ALL (y :: 'e partial).
 makePartial (Just(x)) ==' makePartial (Just(y)) = x ==' y"

IME03 [rule_format] :
"ALL (x :: 'e partial).
 ~ makePartial (Just(x)) ==' makePartial Nothing"

IMO01 [rule_format] :
"ALL (x :: 'o partial).
 makePartial Nothing <' makePartial (Just(x))"

IMO02 [rule_format] :
"ALL (x :: 'o partial).
 ALL (y :: 'o partial).
 makePartial (Just(x)) <' makePartial (Just(y)) = x <' y"

declare NotFalse [simp]
declare NotTrue [simp]
declare AndFalse [simp]
declare AndTrue [simp]
declare OtherwiseDef [simp]
declare NotTrue1 [simp]
declare EqualReflex [simp]
declare IUE1 [simp]
declare IUE2 [simp]
declare IBE1 [simp]
declare IBE2 [simp]
declare IBE3 [simp]
declare IBE4 [simp]
declare IBE5 [simp]
declare IBE6 [simp]
declare IBE7 [simp]
declare IBE8 [simp]
declare IOE01 [simp]
declare IOE02 [simp]
declare IOE03 [simp]
declare IOE04 [simp]
declare IOE05 [simp]
declare IOE06 [simp]
declare IOE07 [simp]
declare IOE08 [simp]
declare IOE09 [simp]
declare LeIrreflexivity [simp]
declare LeTAsymmetry [simp]
declare GeIrreflexivity [simp]
declare GeTAsymmetry [simp]
declare GeTTransitive [simp]
declare GeTTotal [simp]
declare LeqReflexivity [simp]
declare LeqTTransitive [simp]
declare LeqTTotal [simp]
declare GeqReflexivity [simp]
declare GeqTTransitive [simp]
declare GeqTTotal [simp]
declare CmpLTDef [simp]
declare CmpEQDef [simp]
declare CmpGTDef [simp]
declare MaxYDef [simp]
declare MaxXDef [simp]
declare MinXDef [simp]
declare MinYDef [simp]
declare TO4 [simp]
declare TO6 [simp]
declare IUO01 [simp]
declare IUO02 [simp]
declare IUO03 [simp]
declare IUO04 [simp]
declare IUO05 [simp]
declare IUO06 [simp]
declare IUO07 [simp]
declare IOO13 [simp]
declare IOO14 [simp]
declare IOO15 [simp]
declare IOO16 [simp]
declare IOO17 [simp]
declare IOO18 [simp]
declare IOO19 [simp]
declare IOO20 [simp]
declare IOO21 [simp]
declare IOO22 [simp]
declare IOO23 [simp]
declare IOO24 [simp]
declare IOO25 [simp]
declare IOO26 [simp]
declare IOO27 [simp]
declare IOO28 [simp]
declare IOO29 [simp]
declare IOO30 [simp]
declare IOO31 [simp]
declare IOO32 [simp]
declare IOO33 [simp]
declare IBO5 [simp]
declare IBO6 [simp]
declare IBO7 [simp]
declare IBO8 [simp]
declare IBO9 [simp]
declare IBO10 [simp]
declare IBO11 [simp]
declare IBO12 [simp]
declare MaybeJustDef [simp]
declare MaybeNothingDef [simp]
declare IME01 [simp]
declare IME03 [simp]
declare IMO01 [simp]
declare IMO02 [simp]

theorem IME02 : "makePartial Nothing ==' makePartial Nothing"
by (auto)

setup "Header.record \"IME02\""

theorem IMO03 :
"ALL (x :: 'o partial).
 ~ makePartial Nothing >=' makePartial (Just(x))"
apply(rule allI)
apply(simp only: GeqDef)
apply(simp only: GeDef OrDef)
apply(case_tac "makepartial (Just(x)) <' makePartial Nothing")
apply(auto)
done

setup "Header.record \"IMO03\""

theorem IMO04 :
"ALL (x :: 'o partial).
 makePartial (Just(x)) >=' makePartial Nothing"
apply(rule allI)
apply(simp only: GeqDef)
apply(simp only: GeDef OrDef)
apply(case_tac "makePartial Nothing <' makepartial (Just(x))")
apply(auto)
done

setup "Header.record \"IMO04\""

theorem IMO05 :
"ALL (x :: 'o partial).
 ~ makePartial (Just(x)) <' makePartial Nothing"
apply(rule allI)
apply(case_tac "makepartial (Just(x)) <' makePartial Nothing")
apply(auto)
done

setup "Header.record \"IMO05\""

theorem IMO06 :
"ALL (x :: 'o partial).
 compare (makePartial Nothing) (makePartial (Just(x))) =='
 makePartial EQ =
 makePartial Nothing ==' makePartial (Just(x))"
by (auto)

setup "Header.record \"IMO06\""

theorem IMO07 :
"ALL (x :: 'o partial).
 compare (makePartial Nothing) (makePartial (Just(x))) =='
 makePartial LT =
 makePartial Nothing <' makePartial (Just(x))"
by (auto)

setup "Header.record \"IMO07\""

theorem IMO08 :
"ALL (x :: 'o partial).
 compare (makePartial Nothing) (makePartial (Just(x))) =='
 makePartial GT =
 makePartial Nothing >' makePartial (Just(x))"
apply(rule allI)+
apply(simp add: GeDef)
done

setup "Header.record \"IMO08\""

theorem IMO09 :
"ALL (x :: 'o partial).
 makePartial Nothing <=' makePartial (Just(x)) =
 X_max (makePartial Nothing) (makePartial (Just(x))) =='
 makePartial (Just(x))"
apply(rule allI)+
apply(simp add: LeqDef)
done

setup "Header.record \"IMO09\""

theorem IMO10 :
"ALL (x :: 'o partial).
 makePartial (Just(x)) <=' makePartial Nothing =
 X_max (makePartial Nothing) (makePartial (Just(x))) =='
 makePartial Nothing"
apply(rule allI)+
apply(simp add: LeqDef)
done

setup "Header.record \"IMO10\""

theorem IMO11 :
"ALL (x :: 'o partial).
 makePartial Nothing <=' makePartial (Just(x)) =
 X_min (makePartial Nothing) (makePartial (Just(x))) =='
 makePartial Nothing"
apply(rule allI)+
apply(simp add: LeqDef)
done

setup "Header.record \"IMO11\""

theorem IMO12 :
"ALL (x :: 'o partial).
 makePartial (Just(x)) <=' makePartial Nothing =
 X_min (makePartial Nothing) (makePartial (Just(x))) =='
 makePartial (Just(x))"
apply(rule allI)+
apply(simp add: LeqDef)
done

setup "Header.record \"IMO12\""

end


(*******************************************************************************

  Project: Development of Security Protocols by Refinement

  Module:  Refinement/s0g_secrecy.thy (Isabelle/HOL 2016-1)
  ID:      $Id: s0g_secrecy.thy 134924 2017-05-24 17:23:15Z csprenge $
  Author:  Christoph Sprenger, ETH Zurich <sprenger@inf.ethz.ch>

  Key distribution protocols
  Initial Model: Secrecy (global version)

  Copyright (c) 2009-2016 Christoph Sprenger
  Licence: LGPL

*******************************************************************************)

section \<open>Secrecy with Leaking (global version)\<close>

theory s0g_secrecy imports Refinement Agents
begin

text \<open>This model extends the global secrecy model by adding a \<open>leak\<close>
event, which models that the adversary can learn messages through leaks of
some (unspecified) kind.\<close>

text \<open>Proof tool configuration. Avoid annoying automatic unfolding of
\<open>dom\<close>.\<close>

declare domIff [simp, iff del]

(******************************************************************************)
subsection \<open>State\<close>
(******************************************************************************)

text \<open>The only state variable is a knowledge relation, an authorization
relation, and a leakage relation.

@{term "(d, A) \<in> kn s"} means that the agent @{term "A"} knows data @{term "d"}.
@{term "(d, A) \<in> az s"} means that the agent @{term "A"} is authorized to
know data @{term "d"}.
@{term "(d, A) \<in> lk s"} means that data @{term "d"} has leaked to agent
@{term "A"}. Leakage models potential unauthorized knowledge.
\<close>

record 'd s0g_state =
  kn :: "('d \<times> agent) set"
  az :: "('d \<times> agent) set"
  lk :: "'d set"                         \<comment> \<open>leaked data\<close>

type_synonym
  'd s0g_obs = "'d s0g_state"

abbreviation
  "lkr s \<equiv> lk s \<times> UNIV"

(******************************************************************************)
subsection \<open>Invariant definitions\<close>
(******************************************************************************)

text \<open>Global secrecy is stated as an invariant.\<close>

definition
  s0g_secrecy :: "'d s0g_state set"
where
  "s0g_secrecy \<equiv> {s. kn s \<subseteq> az s \<union> lkr s}"

lemmas s0g_secrecyI = s0g_secrecy_def [THEN setc_def_to_intro, rule_format]
lemmas s0g_secrecyE [elim] =
  s0g_secrecy_def [THEN setc_def_to_elim, rule_format]

text \<open>Data that someone is authorized to know and leaked data is known
by someone.\<close>

definition
  s0g_dom :: "'d s0g_state set"
where
  "s0g_dom \<equiv> {s. Domain (az s \<union> lkr s) \<subseteq> Domain (kn s)}"

lemmas s0g_domI = s0g_dom_def [THEN setc_def_to_intro, rule_format]
lemmas s0g_domE [elim] = s0g_dom_def [THEN setc_def_to_elim, rule_format]

(******************************************************************************)
subsection \<open>Events\<close>
(******************************************************************************)

text \<open>New secrets may be generated anytime.\<close>

definition
  s0g_gen :: "['d, agent, agent set] \<Rightarrow> ('d s0g_state \<times> 'd s0g_state) set"
where
  "s0g_gen d A G \<equiv> {(s, s1).
    \<comment> \<open>guards:\<close>
    A \<in> G \<and>
    d \<notin> Domain (kn s) \<and>                      \<comment> \<open>fresh item\<close>

    \<comment> \<open>actions:\<close>
    s1 = s\<lparr>
      kn := insert (d, A) (kn s),
      az := az s \<union> {d} \<times> (if G \<inter> bad = {} then G else UNIV)
    \<rparr>
  }"

text \<open>Learning secrets.\<close>

definition
  s0g_learn ::
    "['d, agent] \<Rightarrow> ('d s0g_state \<times> 'd s0g_state) set"
where
  "s0g_learn d B \<equiv> {(s, s1).
    \<comment> \<open>guards:\<close>
    \<comment> \<open>\<open>d \<in> Domain (kn s) \<and>\<close> someone knows \<open>d\<close> (follows from authorization)\<close>

    \<comment> \<open>check authorization or leakage to preserve secrecy\<close>
    (d, B) \<in> az s \<union> lkr s \<and>

    \<comment> \<open>actions:\<close>
    s1 = s\<lparr> kn := insert (d, B) (kn s) \<rparr>
  }"

text \<open>Leaking secrets.\<close>

definition
  s0g_leak ::
    "'d \<Rightarrow> ('d s0g_state \<times> 'd s0g_state) set"
where
  "s0g_leak d \<equiv> {(s, s1).
    \<comment> \<open>guards:\<close>
    d \<in> Domain (kn s) \<and>       \<comment> \<open>someone knows \<open>d\<close>\<close>

    \<comment> \<open>actions:\<close>
    s1 = s\<lparr> lk := insert d (lk s) \<rparr>
  }"

(******************************************************************************)
subsection \<open>Specification\<close>
(******************************************************************************)

definition
  s0g_init :: "'d s0g_state set"
where
  "s0g_init \<equiv> s0g_secrecy \<inter> s0g_dom"   \<comment> \<open>any state satisfying invariants\<close>

definition
  s0g_trans :: "('d s0g_state \<times> 'd s0g_state) set" where
  "s0g_trans \<equiv> (\<Union>d A B G.
     s0g_gen d A G \<union>
     s0g_learn d B \<union>
     s0g_leak d \<union>
     Id
  )"

definition
  s0g :: "('d s0g_state, 'd s0g_obs) spec" where
  "s0g \<equiv> \<lparr>
    init = s0g_init,
    trans = s0g_trans,
    obs = id
  \<rparr>"

lemmas s0g_defs =
  s0g_def s0g_init_def s0g_trans_def
  s0g_gen_def s0g_learn_def s0g_leak_def

lemma s0g_obs_id [simp]: "obs s0g = id"
by (simp add: s0g_def)

text \<open>All state predicates are trivially observable.\<close>

lemma s0g_anyP_observable [iff]: "observable (obs s0g) P"
by (auto)

(******************************************************************************)
subsection \<open>Invariant proofs\<close>
(******************************************************************************)

subsection \<open>inv1: Secrecy\<close>
(******************************************************************************)

lemma PO_s0g_secrecy_init [iff]:
  "init s0g \<subseteq> s0g_secrecy"
by (auto simp add: s0g_defs intro!: s0g_secrecyI)

lemma PO_s0g_secrecy_trans [iff]:
  "{s0g_secrecy} trans s0g {> s0g_secrecy}"
apply (auto simp add: s0g_defs PO_hoare_defs intro!: s0g_secrecyI)
apply (auto)
done

lemma PO_s0g_secrecy [iff]:"reach s0g \<subseteq> s0g_secrecy"
by (rule inv_rule_basic, auto)

text \<open>As en external invariant.\<close>

lemma PO_s0g_obs_secrecy [iff]:"oreach s0g \<subseteq> s0g_secrecy"
by (rule external_from_internal_invariant) (auto del: subsetI)

subsection \<open>inv2: Authorized and leaked data is known to someone\<close>
(******************************************************************************)

lemma PO_s0g_dom_init [iff]:
  "init s0g \<subseteq> s0g_dom"
by (auto simp add: s0g_defs intro!: s0g_domI)

lemma PO_s0g_dom_trans [iff]:
  "{s0g_dom} trans s0g {> s0g_dom}"
apply (auto simp add: s0g_defs PO_hoare_defs intro!: s0g_domI)
apply (blast)+
done

lemma PO_s0g_dom [iff]: "reach s0g \<subseteq> s0g_dom"
by (rule inv_rule_basic, auto)

text \<open>As en external invariant.\<close>

lemma PO_s0g_obs_dom [iff]: "oreach s0g \<subseteq> s0g_dom"
by (rule external_from_internal_invariant) (auto del: subsetI)

end


(*  Title:      statecharts/SA/Expr.thy

    Author:     Steffen Helke, Software Engineering Group
    Copyright   2010 Technische Universitaet Berlin
*)

header {* Label Expressions *}
theory Expr
imports "Update"
begin

datatype ('s,'e)expr = true
                        | In 's
                        | En 'e
                        | NOT "('s,'e)expr"
                        | And "('s,'e)expr" "('s,'e)expr"
                        | Or  "('s,'e)expr" "('s,'e)expr"

type_synonym 'd guard = "('d data) => bool"
type_synonym ('e,'d)action = "('e set * 'd pupdate)"
type_synonym ('s,'e,'d)label = "(('s,'e)expr * 'd guard * ('e,'d)action)"
type_synonym ('s,'e,'d)trans = "('s * ('s,'e,'d)label * 's)"

primrec
   eval_expr :: "[('s set * 'e set), ('s,'e)expr] \<Rightarrow> bool" where
     "eval_expr sc true          = True"
   | "eval_expr sc (En ev)       = (ev \<in> snd sc)"
   | "eval_expr sc (In st)       = (st \<in> fst sc)"
   | "eval_expr sc (NOT e1)      = (\<not> (eval_expr sc e1))"
   | "eval_expr sc (And e1 e2)   = ((eval_expr sc e1) \<and> (eval_expr sc e2))"
   | "eval_expr sc (Or  e1 e2)   = ((eval_expr sc e1) \<or> (eval_expr sc e2))"

primrec
   ExprEvents :: "('s,'e)expr \<Rightarrow> 'e set" where
      "ExprEvents true        = {}"
   |  "ExprEvents (En ev)     = {ev}"
   |  "ExprEvents (In st)     = {}"
   |  "ExprEvents (NOT e)     = (ExprEvents e)"
   |  "ExprEvents (And e1 e2) = ((ExprEvents e1) \<union> (ExprEvents e2))"
   |  "ExprEvents (Or  e1 e2) = ((ExprEvents e1) \<union> (ExprEvents e2))"

(* atomar propositions for Sequential Automata, will be necessary for CTL-interpretation *)

datatype ('s, 'e, dead 'd)atomar =
                          TRUE
                          | FALSE
                          | IN 's
                          | EN 'e
                          | VAL "'d data => bool"

definition
  source     :: "('s,'e,'d)trans => 's" where
  "source t  = fst t"

definition
   Source     :: "('s,'e,'d)trans set => 's set" where
  "Source T == source ` T"

definition
   target     :: "('s,'e,'d)trans => 's" where
  "target t  = snd(snd t)"

definition
   Target     :: "('s,'e,'d)trans set => 's set" where
  "Target T = target ` T"

definition
   label      :: "('s,'e,'d)trans => ('s,'e,'d)label" where
  "label t  = fst (snd t)"

definition
   Label      :: "('s,'e,'d)trans set => ('s,'e,'d)label set" where
  "Label T = label ` T"

definition
   expr       :: "('s,'e,'d)label => ('s,'e)expr" where
  "expr  = fst"

definition
   action     :: "('s,'e,'d)label  => ('e,'d)action" where
  "action = snd o snd"

definition
   Action     :: "('s,'e,'d)label set => ('e,'d)action set" where
  "Action L = action ` L"

definition
   pupdate     :: "('s,'e,'d)label => 'd pupdate" where
  "pupdate   = snd o action"

definition
  PUpdate     :: "('s,'e,'d)label set => ('d pupdate) set" where
  "PUpdate L = pupdate ` L"

definition
   actevent   :: "('s,'e,'d)label => 'e set" where
  "actevent  = fst o action"

definition
   Actevent   :: "('s,'e,'d)label set => ('e set) set" where
  "Actevent L = actevent ` L"

definition
   guard      :: "('s,'e,'d)label  => 'd guard" where
  "guard = fst o snd"

definition
   Guard      :: "('s,'e,'d)label set => ('d guard) set" where
  "Guard L = guard ` L"

definition
   defaultexpr :: "('s,'e)expr" where
  "defaultexpr = true"

definition
   defaultaction :: "('e,'d)action" where
  "defaultaction = ({},DefaultPUpdate)"

definition
   defaultguard :: "('d guard)" where
  "defaultguard = (\<lambda> d. True)"

definition
   defaultlabel :: "('s,'e,'d)label" where
  "defaultlabel = (defaultexpr, defaultguard, defaultaction)"

definition
   eval :: "[('s set * 'e set * 'd data), ('s,'e,'d)label] => bool"
                                                       ("_ |= _" [91,90]90) where
  "eval scd l = (let (s,e,d) = scd
                 in
                    ((eval_expr (s,e) (expr l)) \<and> ((guard l) d)))"

lemma Source_EmptySet [simp]:
 "Source {} = {}"
by (unfold Source_def, auto)

lemma Target_EmptySet [simp]:
 "Target {} = {}"
by (unfold Target_def, auto)

lemma Label_EmptySet [simp]:
 "Label {} = {}"
by (unfold Label_def, auto)

lemma Action_EmptySet [simp]:
 "Action {} = {}"
by (unfold Action_def, auto)

lemma PUpdate_EmptySet [simp]:
 "PUpdate {} = {}"
by (unfold PUpdate_def, auto)

lemma Actevent_EmptySet [simp]:
 "Actevent {} = {}"
by (unfold Actevent_def, auto)

lemma Union_Actevent_subset:
  "\<lbrakk> m \<in> M; ((\<Union> (Actevent (Label (Union M)))) \<subseteq> (N::'a set)) \<rbrakk> \<Longrightarrow>
   ((\<Union> (Actevent (Label m))) \<subseteq> N)"
by (unfold Actevent_def Label_def, auto)

lemma action_select [simp]:
 "action (a,b,c) = c"
by (unfold action_def, auto)

lemma label_select [simp]:
 "label (a,b,c) = b"
by (unfold label_def, auto)

lemma target_select [simp]:
 "target (a,b,c) = c"
by (unfold target_def, auto)

lemma actevent_select [simp]:
 "actevent (a,b,(c,d)) = c"
by (unfold actevent_def, auto)

lemma pupdate_select [simp]:
 "pupdate (a,b,c,d) = d"
by (unfold pupdate_def, auto)

lemma source_select [simp]:
 "source (a,b) = a"
by (unfold source_def, auto)

lemma finite_PUpdate [simp]:
 "finite S \<Longrightarrow> finite(PUpdate S)"
by (unfold PUpdate_def, auto)

lemma finite_Label [simp]:
 "finite S \<Longrightarrow> finite(Label S)"
by (unfold Label_def, auto)

lemma fst_defaultaction [simp]:
 "fst defaultaction = {}"
by (unfold defaultaction_def, auto)

lemma action_defaultlabel [simp]:
 "(action defaultlabel) = defaultaction"
by (unfold defaultlabel_def action_def, auto)

lemma fst_defaultlabel [simp]:
 "(fst defaultlabel) = defaultexpr"
by (unfold defaultlabel_def, auto)

lemma ExprEvents_defaultexpr [simp]:
 "(ExprEvents defaultexpr) = {}"
by (unfold defaultexpr_def, auto)

lemma defaultlabel_defaultexpr [simp]:
 "expr defaultlabel = defaultexpr"
by (unfold defaultlabel_def expr_def, auto)

lemma target_Target [simp]:
  "t \<in> T \<Longrightarrow> target t \<in> Target T"
by (unfold Target_def, auto)

lemma Source_union : "Source s \<union> Source t = Source (s \<union> t)";
apply (unfold Source_def)
apply auto;
done

lemma Target_union : "Target s \<union> Target t = Target (s \<union> t)";
apply (unfold Target_def)
apply auto
done

end


(*
    This file is a part of IsarMathLib -
    a library of formalized mathematics written for Isabelle/Isar.

    Copyright (C) 2012 Daniel de la Concepcion

    This program is free software; Redistribution and use in source and binary forms,
    with or without modification, are permitted provided that the following conditions are met:

   1. Redistributions of source code must retain the above copyright notice,
   this list of conditions and the following disclaimer.
   2. Redistributions in binary form must reproduce the above copyright notice,
   this list of conditions and the following disclaimer in the documentation and/or
   other materials provided with the distribution.
   3. The name of the author may not be used to endorse or promote products
   derived from this software without specific prior written permission.

THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED
WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. *)

section \<open>Topology - examples\<close>

theory Topology_ZF_examples imports Topology_ZF Cardinal_ZF

begin

text\<open>
  This theory deals with some concrete examples of topologies.
\<close>

subsection\<open>CoCardinal Topology \<close>

text\<open> In this section we define and prove the basic properties of
the co-cardinal topology on a set $X$.\<close>

text\<open>The collection of subsets of a set whose complement
is strictly bounded by a cardinal is a topology given some assumptions
on the cardinal.\<close>

definition
"CoCardinal(X,T) \<equiv> {F\<in>Pow(X). X-F \<prec> T}\<union> {0}"

text\<open>For any set and any infinite cardinal we prove that
\<open>CoCardinal(X,Q)\<close> forms a topology. The proof is done
with an infinite cardinal, but it is obvious that the set \<open>Q\<close>
can be any set equipollent with an infinite cardinal.
It is a topology also if the set where the topology is defined is
too small or the cardinal too large; in this case, as it is later proved the topology
is a discrete topology. And the last case corresponds with \<open>"Q=1"\<close> which translates
in the indiscrete topology.\<close>

lemma CoCar_is_topology:
  assumes "InfCard (Q)"
  shows "CoCardinal(X,Q) {is a topology}"
proof -
  let ?T = "CoCardinal(X,Q)"
  {
    fix M
    assume A:"M\<in>Pow(?T)"
    hence "M\<subseteq>?T" by auto
    then have "M\<subseteq>Pow(X)" using CoCardinal_def by auto
    then have "\<Union>M\<in>Pow(X)" by auto
    moreover
    {
      assume B:"M=0"
      then have "\<Union>M\<in>?T" using CoCardinal_def by auto
    }
    moreover
    {
      assume B:"M={0}"
      then have "\<Union>M\<in>?T" using CoCardinal_def by auto
    }
    moreover
    {
      assume B:"M \<noteq>0" "M\<noteq>{0}"
      from B obtain T where C:"T\<in>M" and "T\<noteq>0" by auto
      with A have D:"X-T \<prec> (Q)" using CoCardinal_def by auto
      from C have "X-\<Union>M\<subseteq>X-T" by blast
      with D have "X-\<Union>M\<prec> (Q)" using subset_imp_lepoll lesspoll_trans1 by blast
    }
    ultimately have "\<Union>M\<in>?T" using CoCardinal_def by auto
  }
  moreover
  {
    fix U and V
    assume "U\<in>?T" and "V\<in>?T"
    then have A:"U=0 \<or> (U\<in>Pow(X) \<and> X-U\<prec> (Q))" and
      B:"V=0 \<or> (V\<in>Pow(X) \<and> X-V\<prec> (Q))" using CoCardinal_def by auto
    hence D:"U\<in>Pow(X)""V\<in>Pow(X)" by auto
    have C:"X-(U \<inter> V)=(X-U)\<union>(X-V)" by fast
    with A B C have "U\<inter>V=0\<or>(U\<inter>V\<in>Pow(X) \<and> X-(U \<inter> V)\<prec> (Q))" using less_less_imp_un_less assms
      by auto
    then have "U\<inter>V\<in>?T" using CoCardinal_def by auto
  }
  ultimately show ?thesis using IsATopology_def by auto
qed

text\<open> We can use theorems proven in \<open>topology0\<close> context for the co-cardinal topology. \<close>

theorem topology0_CoCardinal:
  assumes "InfCard(T)"
  shows "topology0(CoCardinal(X,T))"
  using topology0_def CoCar_is_topology assms by auto

text\<open>It can also be proven that if \<open>CoCardinal(X,T)\<close> is a topology,
\<open> X\<noteq>0, Card(T)\<close> and \<open>T\<noteq>0\<close>; then \<open>T\<close> is an infinite cardinal, \<open> X\<prec>T\<close>
or \<open>T=1\<close>.
It follows from the fact that the union of two closed sets is closed. Choosing the appropriate cardinals, the cofinite and the cocountable topologies
are obtained.

The cofinite topology is a very special topology because it is closely
related to the separation axiom $T_1$. It also appears naturally in algebraic geometry.\<close>

definition
  Cofinite ("CoFinite _" 90) where
  "CoFinite X \<equiv> CoCardinal(X,nat)"

text\<open>Cocountable topology in fact consists of the empty set and all cocountable subsets of $X$.\<close>

definition
  Cocountable ("CoCountable _" 90) where
  "CoCountable X \<equiv> CoCardinal(X,csucc(nat))"

subsection\<open>Total set, Closed sets, Interior, Closure and Boundary\<close>

text\<open>There are several assertions that can be done to the
 \<open>CoCardinal(X,T)\<close> topology. In each case, we will not assume
sufficient conditions for  \<open>CoCardinal(X,T)\<close> to be a topology, but
they will be enough to do the calculations in every posible case.\<close>

text\<open>The topology is defined in the set $X$\<close>

lemma union_cocardinal:
  assumes "T\<noteq>0"
  shows "\<Union> CoCardinal(X,T) = X"
proof-
  have X:"X-X=0" by auto
  have "0 \<lesssim> 0" by auto
  with assms have "0\<prec>1""1 \<lesssim>T" using not_0_is_lepoll_1 lepoll_imp_lesspoll_succ by auto
  then have "0\<prec>T" using lesspoll_trans2  by auto
  with X have "(X-X)\<prec>T" by auto
  then have "X\<in>CoCardinal(X,T)" using CoCardinal_def by auto
  hence "X\<subseteq>\<Union> CoCardinal(X,T)" by blast
  then show  "\<Union> CoCardinal(X,T)=X" using CoCardinal_def by auto
qed

text\<open>The closed sets are the small subsets of $X$ and $X$ itself.\<close>

lemma closed_sets_cocardinal:
  assumes "T\<noteq>0"
  shows "D {is closed in} CoCardinal(X,T) \<longleftrightarrow> (D\<in>Pow(X) \<and> D\<prec>T) \<or> D=X"
proof-
  {
    assume A:"D \<subseteq> X" "X - D \<in> CoCardinal(X,T) "" D \<noteq> X"
    from A(1,3) have "X-(X-D)=D" "X-D\<noteq>0" by auto
    with A(2) have "D\<prec>T" using CoCardinal_def by simp
  }
  with assms have "D {is closed in} CoCardinal(X,T) \<longrightarrow> (D\<in>Pow(X) \<and>  D\<prec>T)\<or> D=X" using IsClosed_def
    union_cocardinal by auto
  moreover
  {
    assume A:"D \<prec> T""D \<subseteq> X"
    from A(2) have "X-(X-D)=D" by blast
    with A(1) have "X-(X-D)\<prec> T" by auto
    then have "X-D\<in> CoCardinal(X,T)" using CoCardinal_def by auto
  }
  with assms have "(D\<in>Pow(X) \<and>  D\<prec>T)\<longrightarrow> D {is closed in} CoCardinal(X,T)" using union_cocardinal
    IsClosed_def by auto
  moreover
  have "X-X=0" by auto
  then have "X-X\<in> CoCardinal(X,T)"using CoCardinal_def by auto
  with assms have "X{is closed in} CoCardinal(X,T)" using union_cocardinal
    IsClosed_def by auto
  ultimately show ?thesis by auto
qed

text\<open>The interior of a set is itself if it is open or \<open>0\<close> if
it isn't open.\<close>

lemma interior_set_cocardinal:
  assumes noC: "T\<noteq>0" and "A\<subseteq>X"
  shows "Interior(A,CoCardinal(X,T))= (if ((X-A) \<prec> T) then A else 0)"
proof-
  from assms(2) have dif_dif:"X-(X-A)=A" by blast
  {
    assume "(X-A) \<prec> T"
    then have "(X-A)\<in>Pow(X) \<and> (X-A) \<prec> T" by auto
    with noC have "(X-A) {is closed in} CoCardinal(X,T)" using closed_sets_cocardinal
      by auto
    with noC have "X-(X-A)\<in>CoCardinal(X,T)" using IsClosed_def union_cocardinal
      by auto
    with dif_dif have "A\<in>CoCardinal(X,T)" by auto
    hence "A\<in>{U\<in>CoCardinal(X,T). U \<subseteq> A}" by auto
    hence a1:"A\<subseteq>\<Union>{U\<in>CoCardinal(X,T). U \<subseteq> A}" by auto
    have a2:"\<Union>{U\<in>CoCardinal(X,T). U \<subseteq> A}\<subseteq>A" by blast
    from a1 a2 have "Interior(A,CoCardinal(X,T))=A" using Interior_def by auto}
  moreover
  {
    assume as:"~((X-A) \<prec> T)"
    {
      fix U
      assume "U \<subseteq>A"
      hence "X-A \<subseteq> X-U" by blast
      then have Q:"X-A \<lesssim> X-U" using subset_imp_lepoll by auto
      {
        assume "X-U\<prec> T"
        with Q have "X-A\<prec> T" using lesspoll_trans1 by auto
        with as have "False"  by auto
      }
      hence "~((X-U) \<prec> T)" by auto
      then have "U\<notin>CoCardinal(X,T)\<or>U=0" using CoCardinal_def by auto
    }
    hence "{U\<in>CoCardinal(X,T). U \<subseteq> A}\<subseteq>{0}" by blast
    then have "Interior(A,CoCardinal(X,T))=0" using Interior_def by auto
  }
  ultimately show ?thesis by auto
qed

text\<open> $X$ is a closed set that contains $A$.
This lemma is necessary because we cannot
use the lemmas proven in the \<open>topology0\<close> context since
\<open> T\<noteq>0"} \<close> is too weak for
 \<open>CoCardinal(X,T)\<close> to be a topology.\<close>

lemma X_closedcov_cocardinal:
  assumes "T\<noteq>0" "A\<subseteq>X"
  shows "X\<in>ClosedCovers(A,CoCardinal(X,T))" using ClosedCovers_def
  using union_cocardinal closed_sets_cocardinal assms by auto

text\<open>The closure of a set is itself if it is closed or \<open>X\<close> if
it isn't closed.\<close>

lemma closure_set_cocardinal:
  assumes "T\<noteq>0""A\<subseteq>X"
  shows "Closure(A,CoCardinal(X,T))=(if (A \<prec> T) then A else X)"
proof-
  {
    assume "A \<prec> T"
    with assms have "A {is closed in} CoCardinal(X,T)" using closed_sets_cocardinal by auto
    with assms(2) have "A\<in> {D \<in> Pow(X). D {is closed in} CoCardinal(X,T) \<and> A\<subseteq>D}" by auto
    with assms(1) have S:"A\<in>ClosedCovers(A,CoCardinal(X,T))" using ClosedCovers_def
      using union_cocardinal by auto
    hence l1:"\<Inter>ClosedCovers(A,CoCardinal(X,T))\<subseteq>A" by blast
    from S have l2:"A \<subseteq> \<Inter>ClosedCovers(A,CoCardinal(X,T))"
      unfolding  ClosedCovers_def by auto
    from l1 l2 have "Closure(A,CoCardinal(X,T))=A" using Closure_def
      by auto
  }
  moreover
  {
    assume as:"\<not> A \<prec> T"
    {
      fix U
      assume "A\<subseteq>U"
      then have Q:"A \<lesssim> U" using subset_imp_lepoll by auto
      {
        assume "U\<prec> T"
        with Q have "A\<prec> T" using lesspoll_trans1 by auto
        with as have "False" by auto
      }
      hence "\<not> U \<prec> T" by auto
      with assms(1) have "\<not>(U {is closed in} CoCardinal(X,T)) \<or> U=X" using closed_sets_cocardinal
      by auto
    }
    with assms(1) have "\<forall>U\<in>Pow(X). U{is closed in}CoCardinal(X,T) \<and> A\<subseteq>U\<longrightarrow>U=X"
      by auto
    with assms(1) have "ClosedCovers(A,CoCardinal(X,T))\<subseteq>{X}"
      using union_cocardinal using ClosedCovers_def by auto
    with assms have "ClosedCovers(A,CoCardinal(X,T))={X}" using X_closedcov_cocardinal
      by auto
    then have " Closure(A,CoCardinal(X,T)) = X " using Closure_def by auto
  }
  ultimately show ?thesis by auto
qed

text\<open>The boundary of a set is empty if $A$ and $X-A$ are closed,
 \<open>X\<close> if not $A$ neither $X-A$ are closed and; if only one is closed,
then the closed one is its boundary.\<close>

lemma boundary_cocardinal:
  assumes "T\<noteq>0""A\<subseteq>X"
  shows "Boundary(A,CoCardinal(X,T)) = (if A\<prec> T then (if  (X-A)\<prec> T then 0 else A) else (if  (X-A)\<prec> T then X-A else X))"
proof-
  from assms(2) have "X-A \<subseteq> X" by auto
  {
    assume AS: "A\<prec>T" "X-A \<prec> T"
    with assms \<open>X-A \<subseteq> X\<close> have
      "Closure(X-A,CoCardinal(X,T)) = X-A" and "Closure(A,CoCardinal(X,T)) = A"
      using closure_set_cocardinal by auto
    with assms(1) have "Boundary(A,CoCardinal(X,T)) = 0"
      using Boundary_def  union_cocardinal by auto
  }
  moreover
  {
    assume AS: "~(A\<prec>T)" "X-A \<prec> T"
    with assms \<open>X-A \<subseteq> X\<close> have
      "Closure(X-A,CoCardinal(X,T)) = X-A" and "Closure(A,CoCardinal(X,T)) = X"
      using closure_set_cocardinal by auto
    with assms(1) have "Boundary(A,CoCardinal(X,T))=X-A" using Boundary_def
      union_cocardinal by auto
  }
  moreover
  {
    assume AS:"~(A\<prec>T)" "~(X-A \<prec> T)"
    with assms \<open>X-A \<subseteq> X\<close> have
      "Closure(X-A,CoCardinal(X,T))=X" and "Closure(A,CoCardinal(X,T))=X"
      using closure_set_cocardinal by auto
    with assms(1) have "Boundary(A,CoCardinal(X,T))=X" using Boundary_def union_cocardinal
      by auto
  }
  moreover
  {
    assume AS:"A\<prec> T" "~(X-A\<prec>T)"
    with assms \<open>X-A \<subseteq> X\<close> have
      "Closure(X-A,CoCardinal(X,T))=X" and "Closure(A,CoCardinal(X,T)) = A"
      using closure_set_cocardinal by auto
    with assms have "Boundary(A,CoCardinal(X,T))=A" using Boundary_def union_cocardinal
      by auto
  }
  ultimately show ?thesis by auto
qed

text\<open>If the set is too small or the cardinal too large, then the topology
is just the discrete topology.\<close>

lemma discrete_cocardinal:
  assumes "X\<prec>T"
  shows "CoCardinal(X,T) = Pow(X)"
proof
  {
    fix U
    assume "U\<in>CoCardinal(X,T)"
    then have "U \<in> Pow(X)" using CoCardinal_def by auto
  }
  then show "CoCardinal(X,T) \<subseteq> Pow(X)" by auto
  {
    fix U
    assume A:"U \<in> Pow(X)"
    then have "X-U \<subseteq> X" by auto
    then have "X-U \<lesssim>X" using subset_imp_lepoll by auto
    then have "X-U\<prec> T" using lesspoll_trans1 assms by auto
    with A have "U\<in>CoCardinal(X,T)" using CoCardinal_def
      by auto
  }
  then show "Pow(X) \<subseteq> CoCardinal(X,T)" by auto
qed

text\<open>If the cardinal is taken as \<open> T=1 \<close> then the topology is indiscrete.\<close>

lemma indiscrete_cocardinal:
  shows "CoCardinal(X,1) = {0,X}"
proof
  {
    fix Q
    assume "Q \<in> CoCardinal(X,1)"
    then have "Q \<in> Pow(X)" and "Q=0 \<or> X-Q\<prec>1" using CoCardinal_def by auto
    then have "Q \<in> Pow(X)" and "Q=0 \<or> X-Q=0" using lesspoll_succ_iff lepoll_0_iff by auto
    then have "Q=0 \<or> Q=X" by blast
  }
  then show "CoCardinal(X,1) \<subseteq> {0, X}" by auto
  have "0 \<in> CoCardinal(X,1)" using CoCardinal_def by auto
  moreover
  have "0\<prec>1" and "X-X=0" using lesspoll_succ_iff by auto
  then have "X\<in>CoCardinal(X,1)" using CoCardinal_def by auto
  ultimately show "{0, X} \<subseteq> CoCardinal(X,1) " by auto
qed

text\<open>The topological subspaces of the \<open>CoCardinal(X,T)\<close> topology
are also CoCardinal topologies.\<close>

lemma subspace_cocardinal:
  shows "CoCardinal(X,T) {restricted to} Y = CoCardinal(Y\<inter>X,T)"
proof
  {
    fix M
    assume "M \<in> (CoCardinal(X,T) {restricted to} Y)"
    then obtain A where A1:"A \<in> CoCardinal(X,T)" "M=Y \<inter> A" using RestrictedTo_def by auto
    then have "M \<in> Pow(X \<inter> Y)" using CoCardinal_def by auto
    moreover
    from A1 have "(Y \<inter> X)-M = (Y \<inter> X)-A" using CoCardinal_def by auto
    with \<open>(Y \<inter> X)-M = (Y \<inter> X)-A\<close> have "(Y \<inter> X)-M\<subseteq> X-A" by auto
    then have "(Y \<inter> X)-M \<lesssim> X-A" using subset_imp_lepoll by auto
    with A1 have "(Y \<inter> X)-M \<prec> T \<or> M=0" using lesspoll_trans1 CoCardinal_def
      by auto
    ultimately have "M \<in> CoCardinal(Y\<inter>X, T)" using CoCardinal_def
      by auto
  }
  then show "CoCardinal(X,T) {restricted to} Y \<subseteq> CoCardinal(Y\<inter>X,T)" by auto
  {
    fix M
    let ?A = "M \<union> (X-Y)"
    assume A:"M \<in> CoCardinal(Y \<inter> X,T)"
    {
      assume "M=0"
      hence "M=0 \<inter> Y" by auto
      then have "M\<in>CoCardinal(X,T) {restricted to} Y" using RestrictedTo_def
        CoCardinal_def by auto
    }
    moreover
    {
      assume AS:"M\<noteq>0"
      from A AS have A1:"(M\<in>Pow(Y \<inter> X) \<and> (Y \<inter> X)-M\<prec>T)" using CoCardinal_def by auto
      hence "?A\<in>Pow(X)" by blast
      moreover
      have "X-?A=(Y \<inter> X)-M" by blast
      with A1 have "X-?A\<prec> T" by auto
      ultimately have "?A\<in>CoCardinal(X,T)" using CoCardinal_def by auto
      then have AT:"Y \<inter> ?A\<in>CoCardinal(X,T) {restricted to} Y" using RestrictedTo_def
        by auto
      have "Y \<inter> ?A=Y \<inter> M" by blast
      also from A1 have "\<dots>=M" by auto
      finally have "Y \<inter> ?A=M" by simp
      with AT have "M\<in>CoCardinal(X,T) {restricted to} Y"
        by auto
    }
    ultimately have "M\<in>CoCardinal(X,T) {restricted to} Y" by auto
  }
  then show "CoCardinal(Y \<inter> X, T) \<subseteq> CoCardinal(X,T) {restricted to} Y" by auto
qed

subsection\<open>Excluded Set Topology\<close>

text\<open>In this section, we consider all the subsets of a set
which have empty intersection with a fixed set.\<close>

text\<open> The excluded set topology consists of subsets of $X$ that are disjoint with a fixed set $U$. \<close>

definition "ExcludedSet(X,U) \<equiv> {F\<in>Pow(X). U \<inter> F=0}\<union> {X}"

text\<open>For any set; we prove that
\<open>ExcludedSet(X,Q)\<close> forms a topology.\<close>

theorem excludedset_is_topology:
  shows "ExcludedSet(X,Q) {is a topology}"
proof-
  {
    fix M
    assume "M \<in> Pow(ExcludedSet(X,Q))"
    then have A:"M\<subseteq>{F\<in>Pow(X). Q \<inter> F=0}\<union> {X}" using ExcludedSet_def by auto
    hence "\<Union>M\<in>Pow(X)" by auto
    moreover
    {
      have B:"Q \<inter>\<Union>M=\<Union>{Q \<inter>T. T\<in>M}" by auto
      {
        assume "X\<notin>M"
        with A have "M\<subseteq>{F\<in>Pow(X). Q \<inter> F=0}" by auto
        with B have "Q \<inter> \<Union>M=0" by auto
      }
      moreover
      {
        assume "X\<in>M"
        with A have "\<Union>M=X" by auto
      }
      ultimately have  "Q \<inter> \<Union>M=0 \<or> \<Union>M=X" by auto
    }
    ultimately have "\<Union>M\<in>ExcludedSet(X,Q)" using ExcludedSet_def by auto
  }
  moreover
  {
    fix U V
    assume "U\<in>ExcludedSet(X,Q)" "V\<in>ExcludedSet(X,Q)"
    then have "U\<in>Pow(X)""V\<in>Pow(X)""U=X\<or> U \<inter> Q=0""V=X\<or> V \<inter> Q=0" using ExcludedSet_def by auto
    hence "U\<in>Pow(X)""V\<in>Pow(X)""(U \<inter> V)=X \<or> Q\<inter>(U \<inter> V)=0" by auto
    then have "(U \<inter> V)\<in>ExcludedSet(X,Q)" using ExcludedSet_def by auto
  }
  ultimately show ?thesis using IsATopology_def by auto
qed

text\<open>We can use \<open>topology0\<close>  when discussing excluded set topology. \<close>

theorem topology0_excludedset:
  shows "topology0(ExcludedSet(X,T))"
  using topology0_def excludedset_is_topology by auto

text\<open>Choosing a singleton set, it is considered a point in excluded topology.\<close>

definition
  "ExcludedPoint(X,p) \<equiv> ExcludedSet(X,{p})"

subsection\<open>Total set, closed sets, interior, closure and boundary\<close>

text\<open>Here we discuss what are closed sets, interior, closure and boundary in excluded set topology.\<close>

text\<open>The topology is defined in the set $X$\<close>

lemma union_excludedset:
  shows "\<Union>ExcludedSet(X,T) = X"
proof-
  have "X \<in>ExcludedSet(X,T)" using ExcludedSet_def by auto
  then show ?thesis using ExcludedSet_def by auto
qed

text\<open>The closed sets are those which contain the set \<open>(X \<inter> T)\<close> and \<open>0\<close>.\<close>

lemma closed_sets_excludedset:
  shows "D {is closed in}ExcludedSet(X,T) \<longleftrightarrow> (D\<in>Pow(X) \<and> (X \<inter> T) \<subseteq> D) \<or> D=0"
proof-
  {
    fix x
    assume A:"D \<subseteq> X" "X-D \<in>ExcludedSet(X,T)" "D\<noteq>0" "x\<in>T" "x\<in>X"
    from A(1) have B:"X-(X-D)=D" by auto
    from A(2) have "T\<inter>(X-D)=0\<or> X-D=X" using ExcludedSet_def by auto
    hence "T\<inter>(X-D)=0\<or> X-(X-D)=X-X" by auto
    with B have "T\<inter>(X-D)=0\<or> D=X-X" by auto
    hence "T\<inter>(X-D)=0\<or> D=0" by auto
    with A(3) have "T\<inter>(X-D)=0" by auto
    with A(4) have "x\<notin>X-D" by auto
    with A(5) have "x\<in>D" by auto
  }
  moreover
  {
    assume A:"X\<inter>T\<subseteq>D" "D\<subseteq>X"
    from A(1) have "X-D\<subseteq>X-(X\<inter>T)" by auto
    also have "\<dots> = X-T" by auto
    finally have "T\<inter>(X-D) = 0" by auto
    moreover
    have "X-D \<in> Pow(X)" by auto
    ultimately have "X-D \<in>ExcludedSet(X,T)" using ExcludedSet_def by auto
  }
  ultimately show ?thesis using IsClosed_def union_excludedset ExcludedSet_def
    by auto
qed

text\<open>The interior of a set is itself if it is \<open>X\<close> or the difference with the set \<open>T\<close>\<close>

lemma interior_set_excludedset:
  assumes "A\<subseteq>X"
  shows "Interior(A,ExcludedSet(X,T)) = (if A=X then X else A-T)"
proof-
  {
    assume A:"A\<noteq>X"
    from assms have "A-T \<in>ExcludedSet(X,T)" using ExcludedSet_def by auto
    then have "A-T\<subseteq>Interior(A,ExcludedSet(X,T))"
    using Interior_def by auto
    moreover
    {
      fix U
      assume "U \<in>ExcludedSet(X,T)" "U\<subseteq>A"
      then have "T\<inter>U=0 \<or> U=X""U\<subseteq>A" using ExcludedSet_def by auto
      with A assms have "T\<inter>U=0""U\<subseteq>A" by auto
      then have "U-T=U""U-T\<subseteq>A-T" by auto
      then have "U\<subseteq>A-T" by auto
    }
    then have "Interior(A,ExcludedSet(X,T))\<subseteq>A-T" using Interior_def by auto
    ultimately have "Interior(A,ExcludedSet(X,T))=A-T" by auto
  }
  moreover
  have "X\<in>ExcludedSet(X,T)" using ExcludedSet_def
  union_excludedset by auto
  then have "Interior(X,ExcludedSet(X,T)) = X" using topology0.Top_2_L3
  topology0_excludedset by auto
  ultimately show ?thesis by auto
qed

text\<open>The closure of a set is itself if it is \<open>0\<close> or
the union with \<open>T\<close>.\<close>

lemma closure_set_excludedset:
  assumes "A\<subseteq>X"
  shows "Closure(A,ExcludedSet(X,T))=(if A=0 then 0 else A \<union>(X\<inter> T))"
proof-
  have "0\<in>ClosedCovers(0,ExcludedSet(X,T))" using ClosedCovers_def
    closed_sets_excludedset by auto
  then have "Closure(0,ExcludedSet(X,T))\<subseteq>0" using Closure_def by auto
  hence "Closure(0,ExcludedSet(X,T))=0" by blast
  moreover
  {
    assume A:"A\<noteq>0"
    with assms have "(A\<union>(X\<inter>T)) {is closed in}ExcludedSet(X,T)" using closed_sets_excludedset
      by blast
    then have "(A \<union>(X\<inter> T))\<in> {D \<in> Pow(X). D {is closed in}ExcludedSet(X,T) \<and> A\<subseteq>D}"
    using assms by auto
    then have "(A \<union>(X\<inter> T))\<in>ClosedCovers(A,ExcludedSet(X,T))" unfolding ClosedCovers_def
    using union_excludedset by auto
    then have l1:"\<Inter>ClosedCovers(A,ExcludedSet(X,T)) \<subseteq> (A \<union>(X\<inter> T))" by blast
    {
      fix U
      assume "U\<in>ClosedCovers(A,ExcludedSet(X,T))"
      then have "U{is closed in}ExcludedSet(X,T)" and "A\<subseteq>U" using ClosedCovers_def
       union_excludedset by auto
      then have "U=0\<or>(X\<inter>T)\<subseteq>U" and "A\<subseteq>U" using closed_sets_excludedset
       by auto
      with A have "(X\<inter>T)\<subseteq>U""A\<subseteq>U" by auto
      hence "(X\<inter>T)\<union>A\<subseteq>U" by auto
    }
    with assms have "(A \<union>(X\<inter> T)) \<subseteq> \<Inter>ClosedCovers(A,ExcludedSet(X,T))"
      using topology0.Top_3_L3 topology0_excludedset union_excludedset
      by auto
    with l1 have "\<Inter>ClosedCovers(A,ExcludedSet(X,T)) = (A\<union>(X\<inter>T))" by auto
    then have "Closure(A, ExcludedSet(X,T)) = A\<union>(X\<inter>T)" using Closure_def
      by auto
  }
  ultimately show ?thesis by auto
qed

text\<open>The boundary of a set is \<open>0\<close> if $A$ is \<open>X\<close> or \<open>0\<close>, and \<open>X\<inter>T\<close> in other case. \<close>

lemma boundary_excludedset:
  assumes "A\<subseteq>X"
  shows "Boundary(A,ExcludedSet(X,T)) = (if A=0\<or>A=X then 0 else X\<inter>T)"
proof-
  {
    have "Closure(0,ExcludedSet(X,T))=0""Closure(X - 0,ExcludedSet(X,T))=X"
    using closure_set_excludedset by auto
    then have "Boundary(0,ExcludedSet(X,T)) = 0"using Boundary_def using
      union_excludedset assms by auto
  }
  moreover
  {
    have "X-X=0" by blast
    then have "Closure(X,ExcludedSet(X,T)) = X" and "Closure(X-X,ExcludedSet(X,T)) = 0"
    using closure_set_excludedset by auto
    then have "Boundary(X,ExcludedSet(X,T)) = 0"unfolding Boundary_def using
      union_excludedset by auto
  }
  moreover
  {
    assume "A\<noteq>0" and "A\<noteq>X"
    then have "X-A\<noteq>0" using assms by auto
    with assms \<open>A\<noteq>0\<close> \<open>A\<subseteq>X\<close> have "Closure(A,ExcludedSet(X,T)) = A \<union> (X\<inter>T)"
      using closure_set_excludedset by simp
    moreover
    from \<open>A\<subseteq>X\<close> have "X-A \<subseteq> X" by blast
    with \<open>X-A\<noteq>0\<close> have "Closure(X-A,ExcludedSet(X,T)) = (X-A) \<union> (X\<inter>T)"
      using closure_set_excludedset by simp
    ultimately have "Boundary(A,ExcludedSet(X,T)) = X\<inter>T"
      using Boundary_def union_excludedset by auto
  }
  ultimately show ?thesis by auto
qed

subsection\<open>Special cases and subspaces\<close>

text\<open>This section provides some miscellaneous facts about excluded set topologies. \<close>

text\<open>The excluded set topology is equal in the sets \<open>T\<close> and \<open>X\<inter>T\<close>.\<close>

lemma smaller_excludedset:
  shows "ExcludedSet(X,T) = ExcludedSet(X,(X\<inter>T))"
proof
  show "ExcludedSet(X,T) \<subseteq> ExcludedSet(X, X\<inter>T)" and "ExcludedSet(X, X\<inter>T) \<subseteq>ExcludedSet(X,T)"
    unfolding ExcludedSet_def by auto
qed

text\<open>If the set which is excluded is disjoint with \<open>X\<close>,
then the topology is discrete.\<close>

lemma empty_excludedset:
  assumes "T\<inter>X=0"
  shows "ExcludedSet(X,T) = Pow(X)"
proof
  from assms show "ExcludedSet(X,T) \<subseteq> Pow(X)"  using smaller_excludedset ExcludedSet_def
    by auto
  from assms show "Pow(X) \<subseteq>ExcludedSet(X,T)" unfolding ExcludedSet_def by blast
qed

text\<open>The topological subspaces of the \<open>ExcludedSet X T\<close> topology
are also ExcludedSet topologies.\<close>

lemma subspace_excludedset:
  shows "ExcludedSet(X,T) {restricted to} Y = ExcludedSet(Y \<inter> X, T)"
proof
  {
    fix M
    assume "M\<in>(ExcludedSet(X,T) {restricted to} Y)"
    then obtain A where A1:"A:ExcludedSet(X,T)" "M=Y \<inter> A" unfolding RestrictedTo_def by auto
    then have "M\<in>Pow(X \<inter> Y)" unfolding ExcludedSet_def by auto
    moreover
    from A1 have "T\<inter>M=0\<or>M=Y\<inter>X" unfolding ExcludedSet_def by blast
    ultimately have "M \<in> ExcludedSet(Y \<inter> X,T)" unfolding ExcludedSet_def
      by auto
  }
  then show "ExcludedSet(X,T) {restricted to} Y \<subseteq> ExcludedSet(Y\<inter>X,T)" by auto
  {
    fix M
    let ?A = "M  \<union> ((X\<inter>Y-T)-Y)"
    assume A:"M \<in> ExcludedSet(Y\<inter>X,T)"
    {
      assume "M = Y \<inter> X"
      then have "M \<in> ExcludedSet(X,T) {restricted to} Y" unfolding RestrictedTo_def
        ExcludedSet_def by auto
    }
    moreover
    {
      assume AS:"M\<noteq>Y \<inter> X"
      from A AS have A1:"(M\<in>Pow(Y \<inter> X) \<and> T\<inter>M=0)" unfolding ExcludedSet_def by auto
      then have "?A\<in>Pow(X)" by blast
      moreover
      have "T\<inter>?A=T\<inter>M" by blast
      with A1 have "T\<inter>?A=0" by auto
      ultimately have "?A \<in>ExcludedSet(X,T)" unfolding ExcludedSet_def by auto
      then have AT:"Y \<inter> ?A \<in>ExcludedSet(X,T) {restricted to} Y" unfolding RestrictedTo_def
        by auto
      have "Y \<inter> ?A=Y \<inter> M" by blast
      also have "\<dots>=M" using A1 by auto
      finally have "Y\<inter>?A = M" by simp
      with AT have "M \<in>ExcludedSet(X,T) {restricted to} Y" by auto
    }
    ultimately have "M \<in>ExcludedSet(X,T) {restricted to} Y" by auto
  }
  then show "ExcludedSet(Y \<inter> X,T) \<subseteq> ExcludedSet(X,T) {restricted to} Y" by auto
qed

subsection\<open>Included Set Topology\<close>

text\<open>In this section we consider the subsets of a set which contain a fixed set.
The family defined in this section and the one in the previous section are
dual; meaning that the closed set of one are the open sets of the other.\<close>

text\<open> We define the included set topology as the collection of supersets of some fixed subset
  of the space $X$. \<close>

definition
  "IncludedSet(X,U) \<equiv> {F\<in>Pow(X). U \<subseteq> F} \<union> {0}"

text\<open> In the next theorem we prove that \<open>IncludedSet X Q\<close> forms a topology.\<close>

theorem includedset_is_topology:
  shows "IncludedSet(X,Q) {is a topology}"
proof-
  {
    fix M
    assume "M \<in> Pow(IncludedSet(X,Q))"
    then have A:"M\<subseteq>{F\<in>Pow(X). Q \<subseteq> F}\<union> {0}" using IncludedSet_def by auto
    then have "\<Union>M\<in>Pow(X)" by auto
    moreover
    have"Q \<subseteq>\<Union>M\<or> \<Union>M=0" using A by blast
    ultimately have "\<Union>M\<in>IncludedSet(X,Q)" using IncludedSet_def by auto
  }
  moreover
  {
    fix U V
    assume "U\<in>IncludedSet(X,Q)" "V\<in>IncludedSet(X,Q)"
    then have "U\<in>Pow(X)""V\<in>Pow(X)""U=0\<or> Q\<subseteq>U""V=0\<or> Q\<subseteq>V" using IncludedSet_def by auto
    then have "U\<in>Pow(X)""V\<in>Pow(X)""(U \<inter> V)=0 \<or> Q\<subseteq>(U \<inter> V)" by auto
    then have "(U \<inter> V)\<in>IncludedSet(X,Q)" using IncludedSet_def by auto
  }
  ultimately show ?thesis using IsATopology_def by auto
qed

text\<open> We can reference the theorems proven in the \<open>topology0\<close> context when discussing
  the included set topology.\<close>

theorem topology0_includedset:
  shows "topology0(IncludedSet(X,T))"
  using topology0_def includedset_is_topology by auto

text\<open>Choosing a singleton set, it is considered a point excluded
  topology. In the following lemmas and theorems, when neccessary
  it will be considered that \<open>T\<noteq>0\<close> and \<open>T\<subseteq>X\<close>.
  These cases will appear in the special cases section.\<close>

definition
  IncludedPoint ("IncludedPoint _ _" 90) where
  "IncludedPoint X p \<equiv> IncludedSet(X,{p})"

subsection\<open>Basic topological notions in included set topology\<close>

text\<open> This section discusses total set, closed sets, interior, closure and boundary
  for included set topology. \<close>

text\<open>The topology is defined in the set $X$.\<close>

lemma union_includedset:
  assumes "T\<subseteq>X "
  shows "\<Union>IncludedSet(X,T) = X"
proof-
  from assms have "X \<in> IncludedSet(X,T)" using IncludedSet_def by auto
  then show "\<Union>IncludedSet(X,T) = X" using IncludedSet_def by auto
qed

text\<open>The closed sets are those which are disjoint with \<open>T\<close>
 and \<open>X\<close>.\<close>

lemma closed_sets_includedset:
  assumes "T\<subseteq>X"
  shows "D {is closed in} IncludedSet(X,T) \<longleftrightarrow> (D\<in>Pow(X) \<and>  (D \<inter> T)=0)\<or> D=X"
proof-
  have "X-X=0" by blast
  then have "X-X\<in>IncludedSet(X,T)" using IncludedSet_def by auto
  moreover
  {
    assume A:"D \<subseteq> X" "X - D \<in> IncludedSet(X,T) "" D \<noteq> X"
    from A(2) have "T\<subseteq>(X-D)\<or> X-D=0" using IncludedSet_def by auto
    with A(1) have "T\<subseteq>(X-D)\<or> D=X" by blast
    with A(3) have "T\<subseteq>(X-D)" by auto
    hence "D\<inter>T=0" by blast
  }
  moreover
  {
    assume A:"D\<inter>T=0""D\<subseteq>X"
    from A(1) assms have "T\<subseteq>(X-D)" by blast
    then have "X-D\<in>IncludedSet(X,T)" using IncludedSet_def by auto
  }
  ultimately show ?thesis using IsClosed_def union_includedset assms by auto
qed

text\<open>The interior of a set is itself if it is open or the empty set if it isn't.\<close>

lemma interior_set_includedset:
  assumes "A\<subseteq>X"
  shows "Interior(A,IncludedSet(X,T))= (if T\<subseteq>A then A else 0)"
proof-
  {
    fix x
    assume A:"Interior(A,IncludedSet(X,T)) \<noteq> 0 ""x\<in>T"
    have "Interior(A,IncludedSet(X,T)) \<in> IncludedSet(X,T)" using
      topology0.Top_2_L2 topology0_includedset by auto
    with A(1) have "T \<subseteq> Interior(A,IncludedSet(X,T))" using IncludedSet_def
      by auto
    with A(2) have "x \<in> Interior(A,IncludedSet(X,T))" by auto
    then have "x\<in>A" using topology0.Top_2_L1 topology0_includedset by auto}
    moreover
  {
    assume "T\<subseteq>A"
    with assms have "A\<in>IncludedSet(X,T)" using IncludedSet_def by auto
    then have "Interior(A,IncludedSet(X,T)) = A" using topology0.Top_2_L3
      topology0_includedset by auto
  }
  ultimately show ?thesis by auto
qed

text\<open>The closure of a set is itself if it is closed or the whole space if it is not.\<close>

lemma closure_set_includedset:
  assumes "A\<subseteq>X" "T\<subseteq>X"
  shows "Closure(A,IncludedSet(X,T)) = (if T\<inter>A=0 then A else X)"
proof-
  {
    assume AS:"T\<inter>A=0"
    then have "A {is closed in} IncludedSet(X,T)" using closed_sets_includedset
      assms by auto
    with assms(1) have "Closure(A,IncludedSet(X,T))=A" using topology0.Top_3_L8
      topology0_includedset union_includedset assms(2) by auto
  }
  moreover
  {
    assume AS:"T\<inter>A \<noteq> 0"
    have "X\<in>ClosedCovers(A,IncludedSet(X,T))" using ClosedCovers_def
      closed_sets_includedset union_includedset assms by auto
    then have l1:"\<Inter>ClosedCovers(A,IncludedSet(X,T))\<subseteq>X" using Closure_def
      by auto
    moreover
    {
      fix U
      assume "U\<in>ClosedCovers(A,IncludedSet(X,T))"
      then have "U{is closed in}IncludedSet(X,T)""A\<subseteq>U" using ClosedCovers_def
        by auto
      then have "U=X\<or>(T\<inter>U)=0""A\<subseteq>U" using closed_sets_includedset assms(2)
        by auto
      then have "U=X\<or>(T\<inter>A)=0" by auto
      then have "U=X" using AS by auto
    }
    then have "X \<subseteq> \<Inter>ClosedCovers(A,IncludedSet(X,T))" using topology0.Top_3_L3
      topology0_includedset union_includedset assms by auto
    ultimately have "\<Inter>ClosedCovers(A,IncludedSet(X,T))=X" by auto
    then have "Closure(A,IncludedSet(X,T)) = X "
      using Closure_def by auto
  }
  ultimately show ?thesis by auto
qed

text\<open>The boundary of a set is \<open>X-A\<close> if $A$ contains \<open>T\<close> completely, is \<open>A\<close> if $X-A$ contains \<open>T\<close>
  completely and \<open>X\<close> if \<open>T\<close> is divided between the two sets.
  The case where \<open>T=0\<close> is considered as a special case.\<close>

lemma boundary_includedset:
  assumes "A\<subseteq>X" "T\<subseteq>X" "T\<noteq>0"
  shows "Boundary(A,IncludedSet(X,T))=(if T\<subseteq>A then X-A else (if T\<inter>A=0 then A else X))"
proof -
  from \<open>A\<subseteq>X\<close> have "X-A \<subseteq> X" by auto
  {
    assume "T\<subseteq>A"
    with assms(2,3) have "T\<inter>A\<noteq>0" and "T\<inter>(X-A)=0" by auto
    with assms(1,2)  \<open>X-A \<subseteq> X\<close>  have
      "Closure(A,IncludedSet(X,T)) = X" and "Closure(X-A,IncludedSet(X,T)) = (X-A)"
      using closure_set_includedset by auto
    with assms(2) have "Boundary(A,IncludedSet(X,T)) = X-A"
      using Boundary_def union_includedset by auto
  }
  moreover
  {
    assume "~(T\<subseteq>A)" and "T\<inter>A=0"
    with assms(2) have "T\<inter>(X-A)\<noteq>0" by auto
    with assms(1,2) \<open>T\<inter>A=0\<close> \<open>X-A \<subseteq> X\<close> have
      "Closure(A,IncludedSet(X,T)) = A" and "Closure(X-A,IncludedSet(X,T)) = X"
      using  closure_set_includedset by auto
    with assms(1,2) have "Boundary(A,IncludedSet(X,T))=A" using Boundary_def union_includedset
      by auto
  }
  moreover
  {
    assume "~(T\<subseteq>A)" and "T\<inter>A \<noteq> 0"
    with assms(1,2) have "T\<inter>(X-A) \<noteq> 0" by auto
    with assms(1,2) \<open>T\<inter>A\<noteq>0\<close>  \<open>X-A \<subseteq> X\<close> have
      "Closure(A,IncludedSet(X,T)) = X" and "Closure(X-A,IncludedSet(X,T)) = X"
      using closure_set_includedset by auto
    with assms(2) have "Boundary(A,IncludedSet(X,T)) = X"
      using Boundary_def union_includedset  by auto
  }
  ultimately show ?thesis by auto
qed

subsection\<open>Special cases and subspaces\<close>

text\<open> In this section we discuss  some corner cases
  when some parameters in our definitions are empty and
  provide some facts about subspaces in included set topologies. \<close>

text\<open>The topology is discrete if \<open> T=0 \<close>\<close>

lemma smaller_includedset:
  shows "IncludedSet(X,0) = Pow(X)"
proof
  show "IncludedSet(X,0) \<subseteq> Pow(X)" and "Pow(X) \<subseteq> IncludedSet(X,0)"
    unfolding IncludedSet_def by auto
qed

text\<open>If the set which is included is not a subset of \<open>X\<close>,
then the topology is trivial.\<close>

lemma empty_includedset:
  assumes "~(T\<subseteq>X)"
  shows "IncludedSet(X,T) = {0}"
proof
  from assms show "IncludedSet(X,T) \<subseteq> {0}" and "{0} \<subseteq> IncludedSet(X,T)"
    unfolding IncludedSet_def by auto
qed

text\<open>The topological subspaces of the \<open>IncludedSet(X,T)\<close> topology
are also IncludedSet topologies. The trivial case does not fit the idea
in the demonstration because if \<open>Y\<subseteq>X\<close>  then \<open>IncludedSet(Y\<inter>X, Y\<inter>T)\<close>
is never trivial. There is no need for a separate proof because
the only subspace of the trivial topology is itself.\<close>

lemma subspace_includedset:
  assumes "T\<subseteq>X"
  shows "IncludedSet(X,T) {restricted to} Y = IncludedSet(Y\<inter>X,Y\<inter>T)"
proof
  {
    fix M
    assume "M \<in> (IncludedSet(X,T) {restricted to} Y)"
    then obtain A where A1:"A:IncludedSet(X,T)" "M = Y\<inter>A" unfolding RestrictedTo_def
      by auto
    then have "M \<in> Pow(X\<inter>Y)" unfolding IncludedSet_def by auto
    moreover
    from A1 have "Y\<inter>T\<subseteq>M \<or> M=0" unfolding IncludedSet_def by blast
    ultimately have "M \<in> IncludedSet(Y\<inter>X, Y\<inter>T)" unfolding IncludedSet_def
      by auto
  }
  then show "IncludedSet(X,T) {restricted to} Y \<subseteq> IncludedSet(Y\<inter>X, Y\<inter>T)"
    by auto
  {
    fix M
    let ?A = "M \<union> T"
    assume A:"M \<in> IncludedSet(Y\<inter>X, Y\<inter>T)"
    {
      assume "M=0"
      then have "M\<in>IncludedSet(X,T) {restricted to} Y" unfolding RestrictedTo_def
        IncludedSet_def by auto
    }
    moreover
    {
      assume AS:"M\<noteq>0"
      from A AS have A1:"M\<in>Pow(Y\<inter>X) \<and> Y\<inter>T\<subseteq>M" unfolding IncludedSet_def by auto
      then have "?A\<in>Pow(X)" using assms by blast
      moreover
      have "T\<subseteq>?A" by blast
      ultimately have "?A \<in> IncludedSet(X,T)" unfolding IncludedSet_def by auto
      then have AT:"Y \<inter> ?A \<in> IncludedSet(X,T) {restricted to} Y"unfolding RestrictedTo_def
        by auto
      from A1 have "Y \<inter> ?A=Y \<inter> M" by blast
      also from A1 have "\<dots>=M" by auto
      finally have "Y\<inter>?A = M" by simp
      with AT have "M \<in> IncludedSet(X,T) {restricted to} Y"
        by auto
    }
    ultimately have "M \<in> IncludedSet(X,T) {restricted to} Y" by auto
  }
  thus "IncludedSet(Y\<inter>X, Y\<inter>T) \<subseteq> IncludedSet(X,T) {restricted to} Y" by auto
qed

end