Theory Stream_Op_Input1

theory Stream_Op_Input1
imports Stream_FreeAlg1
theory Stream_Op_Input1
imports Stream_FreeAlg1
begin

abbreviation "PLS1 ≡ \<oo>\<pp>1 o Abs_Σ1 o Inr :: 'a ΣΣ1 K1 => 'a ΣΣ1"

lemma PLS1_transfer[transfer_rule]:
  "(K1_rel (ΣΣ1_rel R) ===> ΣΣ1_rel R) PLS1 PLS1"
  by transfer_prover

(* ρ1 :: "('a × 'a F) K1 => ('a K1) T0 F" *)
definition ρ1 :: "('a × 'a F) K1 => 'a ΣΣ1 F" where
"ρ1 a_m_a'_b_n_b' =
 (let a_m_a' = fst a_m_a'_b_n_b' ; b_n_b' = snd a_m_a'_b_n_b' ;
      a = fst a_m_a' ; m = fst (snd a_m_a') ; a' = snd (snd a_m_a') ;
      b = fst b_n_b' ; n = fst (snd b_n_b') ; b' = snd (snd b_n_b')
  in (m + n, K1_as_ΣΣ1 (a',b')))"

(* The same as:
fun ρ1 :: "('a × 'a F) K1 => 'a ΣΣ1 F"
where "ρ1 ((a,(m,a')), (b,(n,b'))) = (m + n, K1_as_ΣΣ1 (a',b'))"
*)

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



end