Section Univ.
(* Actually, we build a Universal Turing Machine for each alphabet [sigM] *)
Variable (sigM : finType).
Notation sigGraph := (sigList (sigPair (sigPair (option sigM) sigState) (sigPair (option sigM * move) sigState))).
(* The alphabet of [Univ] *)
Variable (sig : finType).
Variable (retr_sigGraph_sig : Retract sigGraph sig).
Variable (retr_sigTape_sig : Retract sigM sig).
(* Encoding of the current state number *)
Local Definition retr_sigCurrentStateNumber_sigGraph : Retract sigNat sigGraph :=
Retract_sigList_X (Retract_sigPair_X _ (Retract_sigPair_Y _ (Retract_sigPair_Y _ _))).
Local Definition retr_sigCurrentStateNumber_sig : Retract sigNat sig :=
ComposeRetract retr_sigGraph_sig retr_sigCurrentStateNumber_sigGraph.
(* Encoding of the current state (= halt bit + number) *)
Local Definition retr_sigCurrentState_sigGraph : Retract sigState sigGraph :=
Retract_sigList_X (Retract_sigPair_X _ (Retract_sigPair_Y _ (Retract_id _))).
Local Definition retr_sigCurrentState_sig : Retract sigState sig := ComposeRetract retr_sigGraph_sig retr_sigCurrentState_sigGraph.
(* Encoding of final bit of the current state *)
Local Definition retr_sigCurrentStateFinal_sigGraph : Retract bool sigGraph :=
Retract_sigList_X (Retract_sigPair_X _ (Retract_sigPair_Y _ (Retract_sigPair_X _ _))).
Local Definition retr_sigCurrentStateFinal_sig : Retract bool sig := ComposeRetract retr_sigGraph_sig retr_sigCurrentStateFinal_sigGraph.
(* Encoding of the next state *)
Local Definition retr_sigNextState_sigGraph : Retract sigState sigGraph := Retract_sigList_X (Retract_sigPair_Y _ _).
Local Definition retr_sigNextState_sig : Retract sigState sig := ComposeRetract retr_sigGraph_sig retr_sigNextState_sigGraph.
(* Encoding the current symbol *)
Local Definition retr_sigCurrentSymbol_sigGraph : Retract (option sigM) sigGraph := Retract_sigList_X (Retract_sigPair_X _ (Retract_sigPair_X _ _)).
Local Definition retr_sigCurrentSymbol_sig: Retract (option sigM) sig := ComposeRetract retr_sigGraph_sig retr_sigCurrentSymbol_sigGraph.
(* Encoding of actions *)
Local Definition retr_act_sigGraph : Retract (option sigM * move) sigGraph := _.
Local Definition retr_act_sig : Retract (option sigM * move) sig := ComposeRetract retr_sigGraph_sig retr_act_sigGraph.
(* Encoding of the keys for [Lookup] ([option sig * Q]) *)
Local Definition retr_key_sigGraph : Retract _ sigGraph := Retract_sigList_X (Retract_sigPair_X _ (Retract_id _)).
Local Definition retr_key_sig : Retract _ sig := ComposeRetract retr_sigGraph_sig retr_key_sigGraph.
(* Encoding of the value for [Lookup] ([option sig * Q]) *)
Local Definition retr_value_sigGraph : Retract _ sigGraph := Retract_sigList_X (Retract_sigPair_Y _ (Retract_id _)).
Local Definition retr_value_sig : Retract _ sig := ComposeRetract retr_sigGraph_sig retr_value_sigGraph.
(* One tape is the working tape of the simulated machine. *)
Definition containsWorkingTape (t : tape sig^+) (tp : tape sigM) :=
t = mapTape (fun s => inr (Retr_f (Retract := retr_sigTape_sig) s)) tp.

Lemma containsWorkingTape_current t tp :
containsWorkingTape t tp ->
current t = map_opt (fun s => inr (Retr_f s)) (current tp).