Theory Stream_Op_Input3

theory Stream_Op_Input3
imports Stream_FreeAlg3
theory Stream_Op_Input3
imports Stream_FreeAlg3
begin

abbreviation "PLS3 ≡ \<oo>\<pp>3 o Abs_Σ3 o Inl o Abs_Σ2 o Inl o Abs_Σ1 o Inr :: 'a ΣΣ3 K1 => 'a ΣΣ3"
abbreviation "PRD3 ≡ \<oo>\<pp>3 o Abs_Σ3 o Inl o Abs_Σ2 o Inr :: 'a ΣΣ3 K2 => 'a ΣΣ3"
abbreviation "EXP3 ≡ \<oo>\<pp>3 o Abs_Σ3 o Inr :: 'a ΣΣ3 K3 => 'a ΣΣ3"

lemma PLS3_transfer[transfer_rule]:
  "(K1_rel (ΣΣ3_rel R) ===> ΣΣ3_rel R) PLS3 PLS3"
  by transfer_prover

lemma PRD3_transfer[transfer_rule]:
  "(K2_rel (ΣΣ3_rel R) ===> ΣΣ3_rel R) PRD3 PRD3"
  by transfer_prover

lemma EXP3_transfer[transfer_rule]:
  "(K3_rel (ΣΣ3_rel R) ===> ΣΣ3_rel R) EXP3 EXP3"
  by transfer_prover

definition exp :: "nat => nat" where "exp n = 2 ^ n"

primrec ρ3 :: "('a × 'a F) K3 => 'a ΣΣ3 F" where
  "ρ3 (I a_m_a') =
    (let a = I (fst a_m_a') ; m = fst (snd a_m_a') ; a' = snd (snd a_m_a')
    in (exp m, PRD3 (leaf3 a', K3_as_ΣΣ3 a)))"

lemma I_transfer[transfer_rule]:
  "(R ===> K3_rel R) I I"
  by auto

lemma rec_K3_transfer[transfer_rule]: "((R ===> S) ===> K3_rel R ===> S) rec_K3 rec_K3"
  apply (rule rel_funI)+
  apply (rename_tac x y)
  apply (case_tac x)
  apply (case_tac y)
  apply (auto elim: rel_funE)
  done

lemma ρ3_transfer[transfer_rule]:
  "(K3_rel (rel_prod R (F_rel R)) ===> F_rel (ΣΣ3_rel R)) ρ3 ρ3"
  unfolding rel_pre_J_def id_apply vimage2p_def BNF_Comp.id_bnf_comp_def ρ3_def[abs_def] Let_def
  by transfer_prover



end