header{* The integration of a new operation in the up-to setting *}
theory Stream_Integrate_New_Op2
imports Stream_Op_Input2
begin
subsection{* The assumptions *}
lemma ρ2_natural: "ρ2 o K2_map (f ** F_map f) = F_map (ΣΣ2_map f) o ρ2"
using ρ2_transfer[of "BNF_Def.Grp UNIV f"]
unfolding F_rel_Grp ΣΣ2.rel_Grp K2.rel_Grp prod.rel_Grp
unfolding Grp_def rel_fun_def by auto
subsection{* The integration *}
definition embL2 :: "'a ΣΣ1 => 'a ΣΣ2" where
"embL2 ≡ ext1 (\<oo>\<pp>2 o Abs_Σ2 o Inl) leaf2"
definition embR2 :: "('a K2) ΣΣ1 => 'a ΣΣ2" where
"embR2 ≡ ext1 (\<oo>\<pp>2 o Abs_Σ2 o Inl) (\<oo>\<pp>2 o Σ2_map leaf2 o Abs_Σ2 o Inr)"
definition Λ2 :: "('a × 'a F) Σ2 => 'a ΣΣ2 F" where
"Λ2 = case_sum (F_map embL2 o Λ1) ρ2 o Rep_Σ2"
lemma embL2_transfer[transfer_rule]:
"(ΣΣ1_rel R ===> ΣΣ2_rel R) embL2 embL2"
unfolding embL2_def ext1_alt by transfer_prover
lemma embR2_transfer[transfer_rule]:
"(ΣΣ1_rel (K2_rel R) ===> ΣΣ2_rel R) embR2 embR2"
unfolding embR2_def ext1_alt by transfer_prover
lemma Λ2_transfer[transfer_rule]:
"(Σ2_rel (rel_prod R (F_rel R)) ===> F_rel (ΣΣ2_rel R)) Λ2 Λ2"
unfolding Λ2_def by transfer_prover
lemma Λ2_natural: "Λ2 o Σ2_map (f ** F_map f) = F_map (ΣΣ2_map f) o Λ2"
using Λ2_transfer[of "BNF_Def.Grp UNIV f"]
unfolding F_rel_Grp ΣΣ2.rel_Grp Σ2.rel_Grp prod.rel_Grp
unfolding Grp_def rel_fun_def by auto
lemma embL2_natural: "embL2 o ΣΣ1_map f = ΣΣ2_map f o embL2"
using embL2_transfer[of "BNF_Def.Grp UNIV f"]
unfolding ΣΣ1.rel_Grp ΣΣ2.rel_Grp
unfolding Grp_def rel_fun_def by auto
lemma embR2_natural: "embR2 o ΣΣ1_map (K2_map f) = ΣΣ2_map f o embR2"
using embR2_transfer[of "BNF_Def.Grp UNIV f"]
unfolding ΣΣ1.rel_Grp K2.rel_Grp ΣΣ2.rel_Grp
unfolding Grp_def rel_fun_def by auto
lemma Λ2_Inl: "Λ2 o Abs_Σ2 o Inl = F_map embL2 o Λ1"
and Λ2_Inr: "Λ2 o Abs_Σ2 o Inr = ρ2"
unfolding Λ2_def o_assoc[symmetric] Rep_Σ2_o_Abs_Σ2 o_id by auto
lemma embL2_leaf1: "embL2 o leaf1 = leaf2"
unfolding embL2_def ext1_comp_leaf1 ..
lemma embL2_\<oo>\<pp>1: "embL2 o \<oo>\<pp>1 = \<oo>\<pp>2 o Abs_Σ2 o Inl o Σ1_map embL2"
unfolding embL2_def ext1_commute ..
lemma embR2_leaf1: "embR2 o leaf1 = \<oo>\<pp>2 o Abs_Σ2 o Inr o K2_map leaf2"
unfolding embR2_def ext1_comp_leaf1
unfolding o_assoc[symmetric] Abs_Σ2_natural map_sum_Inr ..
lemma embR2_\<oo>\<pp>1: "embR2 o \<oo>\<pp>1 = \<oo>\<pp>2 o Abs_Σ2 o Inl o Σ1_map embR2"
unfolding embR2_def ext1_commute ..
end