Section AlphabetLifting.
Variable (sig tau : Type).
Variable (retr : Retract sig tau).
Definition LiftSpec_single (T : RegSpec sig) : RegSpec tau :=
match T with
| Contains r x => Contains (ComposeRetract retr r) x
| Contains_size r x s => Contains_size (ComposeRetract retr r) x s
| Void => Void
| Void_size s => Void_size s
| Custom p => Custom (fun t => p (surjectTape (Retr_g) (inl UNKNOWN) t))
end.
Variable (n : nat).
Definition LiftSpec (T : SpecV sig n) : SpecV tau n :=
Vector.map LiftSpec_single T.
End AlphabetLifting.
(* Lemma tspec_LiftSpec_withSpace (sig tau : Type) (n : nat) (I : Retract sig tau) P' (P : SpecV sig n) (ss : Vector.t nat n): Entails ≃≃( P',LiftSpec I (withSpace P ss)) ≃≃( P', withSpace (LiftSpec I P) ss).  Lemma ChangeAlphabet_Spec (F : finType) P' (P : SpecV sig n) (pM : pTM sig^+ F n) Q' (Q : F -> SpecV sig n) : Triple (tspec (P',P)) pM (fun yout => tspec (Q' yout,Q yout)) -> Triple (tspec (P',LiftSpec retr P)) (ChangeAlphabet pM retr) (fun yout => tspec (Q' yout,LiftSpec retr (Q yout))).  Lemma ChangeAlphabet_SpecT (F : finType) P' (P : SpecV sig n) (k : nat) (pM : pTM sig^+ F n) Q' (Q : F -> SpecV sig n) : TripleT (tspec (P',P)) k pM (fun yout => tspec (Q' yout, Q yout)) -> TripleT (tspec (P',LiftSpec retr P)) k (ChangeAlphabet pM retr) (fun yout => tspec (Q' yout,LiftSpec retr (Q yout))).    (* We always have to use at least [Consequence_pre], because the premise will never match. *)

Lemma ChangeAlphabet_SpecT_pre_post (F : finType)
P0 (P : SpecV sig n) (P' : SpecV tau n)
(k : nat) (pM : pTM sig^+ F n)
Q0 (Q : F -> SpecV sig n) (Q' : F -> SpecV tau n) :
TripleT (tspec (P0,P)) k pM (fun yout => tspec (Q0 yout, Q yout) ) ->
(Entails ≃≃( P0,P') ≃≃( P0,LiftSpec retr P)) ->
(forall yout, Entails ≃≃( Q0 yout, LiftSpec retr (Q yout)) ≃≃( (Q0 yout,Q' yout))) ->
TripleT (tspec (P0, P')) k (ChangeAlphabet pM retr) (fun yout => tspec (Q0 yout, Q' yout)).