Section M.
Variable (sig : finType).
(* Hypothesis (defX: inhabitedC sigX). *)
(* We use the FinType instance of bool, as it has a Case-machine *)
Context `{retr__list : Retract (sigList bool) sig}
`{retr__Pro : Retract Alphabets.sigPro sig}.
Local Instance retr__nat : Retract sigNat sig := ComposeRetract retr__Pro _.
Local Instance retr__bool : Retract bool sig := ComposeRetract retr__list (Retract_sigList_X _).
(* Check _ : codable sig (list bool). *)
(* Check _ : codable sig bool. *)
(* Tapes: 0: bs (input) 1: result 2: intern (constant for ConcatRepeat [0]) 3: intern (length of bs for concatReepat [1]) *)
Definition Rel : pRel sig^+ unit 4 :=
ignoreParam
(fun tin 'tout =>
forall (bs : list bool),
tin[@Fin0] ≃ bs
-> isVoid tin[@Fin1]
-> isVoid tin[@Fin2]
-> isVoid tin[@Fin3]
-> isVoid tout[@Fin0]
/\ tout[@Fin1]  ≃ compile (Computable.enc (rev bs))
/\ isVoid tout[@Fin2]
/\ isVoid tout[@Fin3]).
(* für step (prepend the bs-dependent symbols) Tapes: 0: bs (input) 1: result 2: head of bs 3: intern (length of bs for concatReepat [1]) *)
Definition M__step : pTM sig^+ (option unit) 4 :=
If (LiftTapes (ChangeAlphabet (CaseList.CaseList _) retr__list) [|Fin0;Fin2|])
(Switch (LiftTapes (ChangeAlphabet CaseBool retr__bool) [|Fin2|])
(fun b => LiftTapes (ChangeAlphabet (WriteValue ( (enc_bool_perElem b))) _) [| Fin2|];;
LiftTapes (ChangeAlphabet (App' _) _) [|Fin2;Fin1|];;
Return (LiftTapes (Reset _) [|Fin2|]) None))
(Return (LiftTapes (Reset _) [|Fin0|]) (Some tt)).
Definition Rel__step : pRel sig^+ (option unit) 4 :=
(fun tin '(yout,tout) =>
forall (bs : list bool) (res : Pro),
tin[@Fin0] ≃ bs
-> tin[@Fin1] ≃ res
-> isVoid tin[@Fin2]
-> match bs,yout with
[],  Some _ => isVoid tout[@Fin0] /\ tout[@Fin1] = tin[@Fin1]
| (b::bs),None => tout[@Fin0] ≃ bs /\ tout[@Fin1] ≃ enc_bool_perElem b++res
| _,_ => False
end
/\ isVoid tout[@Fin2]
/\ tout[@Fin3] = tin[@Fin3]).
Definition Ter' time: tRel sig^+ 4 :=
(fun tin k =>
exists (bs : list bool) (res : Pro),
tin[@Fin0] ≃ bs
/\ tin[@Fin1] ≃ res
/\ isVoid tin[@Fin2]
/\ time (length bs) <= k ).
Definition Terminates__step := projT2 _Terminates__step.
Definition M__loop : pTM sig^+ unit 4 := While M__step.
Definition Rel__loop : pRel sig^+ (unit) 4 :=
(fun tin '(yout,tout) =>
forall (bs : list bool) (res : Pro),
tin[@Fin0] ≃ bs
-> tin[@Fin1] ≃ res
-> isVoid tin[@Fin2]
-> isVoid tout[@Fin0]
/\ tout[@Fin1] ≃ flat_map enc_bool_perElem (rev bs)++res
/\ isVoid tout[@Fin2]
/\ tout[@Fin3] = tin[@Fin3]).
Definition Terminates__loop := projT2 _Terminates__loop.
Definition M : pTM sig^+ unit 4 :=
LiftTapes (Length retr__list retr__nat) [|Fin0;Fin3;Fin1;Fin2|];; (*0: still bs, 3:length bs, 1,2:right *)
LiftTapes (ChangeAlphabet (WriteValue ( ([] : Pro))) retr__Pro) [|Fin1|];; (* 1:res *)
LiftTapes (ChangeAlphabet (WriteValue ( (enc_bool_closing))) retr__Pro) [|Fin2|];; (* 2:const for repeat *)
LiftTapes (ConcatRepeat.M retr__Pro retr__nat) [|Fin2;Fin3;Fin1|];; (* 2:cnst for repeat, 3:length/empty, 1:res *)
LiftTapes (Reset _) [|Fin2|];;(*2: empty*)
LiftTapes (ChangeAlphabet (WriteValue (  (enc_bool_nil))) retr__Pro ) [|Fin2|];;(*2:nil*)
LiftTapes (ChangeAlphabet (App' _) retr__Pro) [|Fin2;Fin1|];;(* 1 : res with nil part *)
LiftTapes (Reset _) [|Fin2|];;(*2: empty*)
M__loop.

Lemma Realise : M ⊨ M.Rel.