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]).

Lemma Realise__loop : M__loop ⊨ Rel__loop .