Theory Generat

theory Generat
imports Misc Countable_Set
theory Generat imports 
  Main
  Misc
  "~~/src/HOL/Library/Countable_Set"
begin

subsubsection {* Single-step generative *}

datatype (generat_pures: 'a, generat_outs: 'b, generat_conts: 'c) generat 
  = Pure (result: 'a)
  | IO ("output": 'b) (continuation: "'c")

datatype_compat generat

lemma IO_code_cong: "out = out' ⟹ IO out c = IO out' c" by simp
setup {* Code_Simp.map_ss (Simplifier.add_cong @{thm IO_code_cong}) *}

lemma is_Pure_map_generat [simp]: "is_Pure (map_generat f g h x) = is_Pure x"
by(cases x) simp_all

lemma result_map_generat [simp]: "is_Pure x ⟹ result (map_generat f g h x) = f (result x)"
by(cases x) simp_all

lemma output_map_generat [simp]: "¬ is_Pure x ⟹ output (map_generat f g h x) = g (output x)"
by(cases x) simp_all

lemma continuation_map_generat [simp]: "¬ is_Pure x ⟹ continuation (map_generat f g h x) = h (continuation x)"
by(cases x) simp_all

lemma rel_generatI:
  "⟦ is_Pure x ⟷ is_Pure y;
     ⟦ is_Pure x; is_Pure y ⟧ ⟹ A (result x) (result y);
     ⟦ ¬ is_Pure x; ¬ is_Pure y ⟧ ⟹ Out (output x) (output y) ∧ R (continuation x) (continuation y) ⟧
  ⟹ rel_generat A Out R x y"
by(cases x y rule: generat.exhaust[case_product generat.exhaust]) simp_all

lemma rel_generatD':
  "rel_generat A Out R x y
  ⟹ (is_Pure x ⟷ is_Pure y) ∧ 
     (is_Pure x ⟶ is_Pure y ⟶ A (result x) (result y)) ∧ 
     (¬ is_Pure x ⟶ ¬ is_Pure y ⟶ Out (output x) (output y) ∧ R (continuation x) (continuation y))"
by(cases x y rule: generat.exhaust[case_product generat.exhaust]) simp_all

lemma rel_generatD:
  assumes "rel_generat A Out R x y"
  shows rel_generat_is_PureD: "is_Pure x ⟷ is_Pure y"
  and rel_generat_resultD: "is_Pure x ∨ is_Pure y ⟹ A (result x) (result y)"
  and rel_generat_outputD: "¬ is_Pure x ∨ ¬ is_Pure y ⟹ Out (output x) (output y)"
  and rel_generat_continuationD: "¬ is_Pure x ∨ ¬ is_Pure y ⟹ R (continuation x) (continuation y)"
using rel_generatD'[OF assms] by simp_all

lemma rel_generat_mono:
  "⟦ rel_generat A B C x y; ⋀x y. A x y ⟹ A' x y; ⋀x y. B x y ⟹ B' x y; ⋀x y. C x y ⟹ C' x y ⟧
  ⟹ rel_generat A' B' C' x y"
using generat.rel_mono[of A A' B B' C C'] by(auto simp add: le_fun_def)

lemma rel_generat_mono' [mono]:
  "⟦ ⋀x y. A x y ⟶ A' x y; ⋀x y. B x y ⟶ B' x y; ⋀x y. C x y ⟶ C' x y ⟧
  ⟹ rel_generat A B C x y ⟶ rel_generat A' B' C' x y"
by(blast intro: rel_generat_mono)

lemma rel_generat_same:
  "rel_generat A B C r r ⟷ 
  (∀x ∈ generat_pures r. A x x) ∧
  (∀out ∈ generat_outs r. B out out) ∧
  (∀c ∈generat_conts r. C c c)"
by(cases r)(auto simp add: rel_fun_def)

lemma rel_generat_reflI:
  "⟦ ⋀y. y ∈ generat_pures x ⟹ A y y; 
     ⋀out. out ∈ generat_outs x ⟹ B out out;
     ⋀cont. cont ∈ generat_conts x ⟹ C cont cont ⟧
  ⟹ rel_generat A B C x x"
by(cases x) auto

lemma reflp_rel_generat [simp]: "reflp (rel_generat A B C) ⟷ reflp A ∧ reflp B ∧ reflp C"
by(auto 4 3 intro!: reflpI rel_generatI dest: reflpD reflpD[where x="Pure _"] reflpD[where x="IO _ _"])

lemma transp_rel_generatI:
  assumes "transp A" "transp B" "transp C"
  shows "transp (rel_generat A B C)"
by(rule transpI)(auto 6 5 dest: rel_generatD' intro!: rel_generatI intro: assms[THEN transpD] simp add: rel_fun_def)

lemma rel_generat_inf:
  "inf (rel_generat A B C) (rel_generat A' B' C') = rel_generat (inf A A') (inf B B') (inf C C')"
  (is "?lhs = ?rhs")
proof(rule antisym)
  show "?lhs ≤ ?rhs"
    by(auto elim!: generat.rel_cases simp add: rel_fun_def)
qed(auto elim: rel_generat_mono)

lemma rel_generat_Pure1: "rel_generat A B C (Pure x) = (λr. ∃y. r = Pure y ∧ A x y)"
by(rule ext)(case_tac r, simp_all)

lemma rel_generat_IO1: "rel_generat A B C (IO out c) = (λr. ∃out' c'. r = IO out' c' ∧ B out out' ∧ C c c')"
by(rule ext)(case_tac r, simp_all)

lemma not_is_Pure_conv: "¬ is_Pure r ⟷ (∃out c. r = IO out c)"
by(cases r) auto

lemma finite_generat_outs [simp]: "finite (generat_outs generat)"
by(cases generat) auto

lemma countable_generat_outs [simp]: "countable (generat_outs generat)"
by(simp add: countable_finite)

lemma case_map_generat:
  "case_generat pure io (map_generat a b d r) = 
   case_generat (pure ∘ a) (λout. io (b out) ∘ d) r"
by(cases r) simp_all

lemma continuation_in_generat_conts:
  "¬ is_Pure r ⟹ continuation r ∈ generat_conts r"
by(cases r) auto


fun dest_IO :: "('a, 'out, 'c) generat ⇒ ('out × 'c) option"
where
  "dest_IO (Pure _) = None"
| "dest_IO (IO out c) = Some (out, c)"

lemma dest_IO_eq_Some_iff [simp]: "dest_IO generat = Some (out, c) ⟷ generat = IO out c"
by(cases generat) simp_all

lemma dest_IO_eq_None_iff [simp]: "dest_IO generat = None ⟷ is_Pure generat"
by(cases generat) simp_all

lemma dest_IO_comp_Pure [simp]: "dest_IO ∘ Pure = (λ_. None)"
by(simp add: fun_eq_iff)

lemma dom_dest_IO: "dom dest_IO = {x. ¬ is_Pure x}"
by(auto simp add: not_is_Pure_conv)


definition generat_lub :: "('a set ⇒ 'b) ⇒ ('out set ⇒ 'out') ⇒ ('cont set ⇒ 'cont') 
  ⇒ ('a, 'out, 'cont) generat set ⇒ ('b, 'out', 'cont') generat"
where
  "generat_lub lub1 lub2 lub3 A =
  (if ∃x∈A. is_Pure x then Pure (lub1 (result ` (A ∩ {f. is_Pure f})))
   else IO (lub2 (output ` (A ∩ {f. ¬ is_Pure f}))) (lub3 (continuation ` (A ∩ {f. ¬ is_Pure f}))))"

lemma is_Pure_generat_lub [simp]:
  "is_Pure (generat_lub lub1 lub2 lub3 A) ⟷ (∃x∈A. is_Pure x)"
by(simp add: generat_lub_def)

lemma result_generat_lub [simp]:
  "∃x∈A. is_Pure x ⟹ result (generat_lub lub1 lub2 lub3 A) = lub1 (result ` (A ∩ {f. is_Pure f}))"
by(simp add: generat_lub_def)

lemma output_generat_lub: 
  "∀x∈A. ¬ is_Pure x ⟹ output (generat_lub lub1 lub2 lub3 A) = lub2 (output ` (A ∩ {f. ¬ is_Pure f}))"
by(simp add: generat_lub_def)

lemma continuation_generat_lub:
  "∀x∈A. ¬ is_Pure x ⟹ continuation (generat_lub lub1 lub2 lub3 A) = lub3 (continuation ` (A ∩ {f. ¬ is_Pure f}))"
by(simp add: generat_lub_def)

lemma generat_lub_map [simp]:
  "generat_lub lub1 lub2 lub3 (map_generat f g h ` A) = generat_lub (lub1 ∘ op ` f) (lub2 ∘ op ` g) (lub3 ∘ op ` h) A"
by(auto 4 3 simp add: generat_lub_def intro: arg_cong[where f=lub1] arg_cong[where f=lub2] arg_cong[where f=lub3] rev_image_eqI intro!: ext)

lemma map_generat_lub [simp]:
  "map_generat f g h (generat_lub lub1 lub2 lub3 A) = generat_lub (f ∘ lub1) (g ∘ lub2) (h ∘ lub3) A"
by(simp add: generat_lub_def o_def)


abbreviation generat_lub' :: "('cont set ⇒ 'cont') ⇒ ('a, 'out, 'cont) generat set ⇒ ('a, 'out, 'cont') generat"
where "generat_lub' ≡ generat_lub (λA. THE x. x ∈ A) (λA. THE x. x ∈ A)"

end