Section bla.
(* Most likely: we need to make Z__case return domains... *)
(*Polymorphic Lemma leUpToC_finCases_nary domain (Y:FinTypes.finType) Z__case (cases : forall (y:Y), Z__case y -> Rtuple domain) (f : Rarrow domain nat) (F : Rtuple domain -> nat) : (forall x, exists y (z : Z__case y), cases y z = x) -> (forall y, (fun z => App f (cases y z)) <=c (fun z => F (cases y z))) -> Uncurry f <=c F.  Polymorphic Lemma leUpToC_clean domain (f F: Rtuple domain -> nat): Fun' f <=c Fun' F -> f <=c F. End bla.  Module ConcatRepeat. Section concatRepeat.  Variable sig sigX : finType. Variable (X : Type) (cX : codable sigX X). Variable (retr1 : Retract (sigList sigX) sig) (retr2 : Retract sigNat sig).   (* Tapes: t0: list to repeat t1: n t2: res *)
Definition Rel__step : pRel sig^+ (option unit) 3 :=
fun tin '(yout,tout) =>
forall (cs : list X) (n:nat) ( xs : list X) ,
tin[@Fin0] ≃ cs ->
tin[@Fin1] ≃ n ->
tin[@Fin2] ≃ xs ->
match yout, n with
| (Some tt), 0 => (* break *)
tout[@Fin0] ≃ cs /\
isVoid tout[@Fin1] /\
tout[@Fin2] ≃ xs
| None, S n => (* continue *)
tout[@Fin0] ≃ cs /\
tout[@Fin1] ≃ n /\
tout[@Fin2] ≃ cs++xs
| _, _ => False
end.
Definition M__step : pTM sig^+ (option unit) 3 :=
If (LiftTapes (ChangeAlphabet CaseNat _) [|Fin1|])
(Return (LiftTapes (ChangeAlphabet (App' _) _) [|Fin0; Fin2|]) None)
(Return (LiftTapes (Reset _) [|Fin1|]) (Some tt)).
Definition Rel : pRel sig^+ unit 3 :=
ignoreParam (
fun tin tout =>
forall (cs : list X) (n:nat) ( xs : list X) ,
tin[@Fin0] ≃ cs ->
tin[@Fin1] ≃ n ->
tin[@Fin2] ≃ xs ->
tout[@Fin0] ≃ cs /\
isVoid tout[@Fin1] /\
tout[@Fin2] ≃ concat (repeat cs n)++xs
).
Definition M : pTM sig^+ unit 3 := While M__step.

Lemma Realise : M ⊨ Rel .