Section main.
Variable k : nat.
Variable (R : Vector.t (list bool) k -> (list bool) -> Prop).
Variable s : term.
Hypothesis Hscl : closed s.
Variable Hs1 : (forall v, forall m : list bool,
R v m <->
L.eval (Vector.fold_left (fun (s0 : term) (n : list bool) => L.app s0 (encBoolsL n)) s v) (encBoolsL m)).
Variable Hs2 : (forall v, forall o : term,
L.eval (Vector.fold_left (n := k) (fun (s0 : term) (n : list bool) => L.app s0 (encBoolsL n)) s v) o ->
exists m : list bool, o = encBoolsL m).
Definition n_main := 14.
Definition Σ : Type := sigList bool + EvalL.Σintern.
Definition retr_bools : Retract (sigList bool) Σ := (Retract_inl _ _).
Definition retr_intern : Retract EvalL.Σintern Σ := (Retract_inr _ _).
Definition retr_closs : Retract (sigList sigHClos) Σ
:= ComposeRetract retr_intern _.
Definition retr_clos : Retract sigHClos Σ := ComposeRetract retr_closs _.
Definition retr_pro : Retract sigPro Σ := ComposeRetract retr_clos _.
Definition sym_s : Σ^+ := inr (inl (sigList_X true)).
Definition sym_b : Σ^+ := inr (inl (sigList_X false)).
(* auxiliary tapes:  0    : T  *)
Notation aux n := (Fin.L k (Fin.R 1 n)).
Definition garb : Σ^+ := inl UNKNOWN.
Definition M_main : pTM (Σ ^+)  unit (1 + n_main + k):=
M_init sym_s retr_pro retr_bools (1 + n_main - 6) k s ;;
MK_isVoid_multi _ @ [|aux Fin5;aux Fin6;aux Fin7;aux Fin8;aux Fin9;aux Fin10;aux Fin11;aux Fin12;aux Fin13 |] ;;
EvalL.M retr_intern retr_pro @ [| aux Fin0 ; aux Fin1 ; aux Fin2; aux Fin5 ; aux Fin6 ; aux Fin7 ; aux Fin8 ; aux Fin9 ; aux Fin10 ; aux Fin11 ; aux Fin12 |] ;;
M_out sym_s sym_b retr_pro retr_bools @ [|aux Fin0;Fin.L k Fin0;aux Fin7;aux Fin8|].
Proof  using Hscl Hs2 Hs1.
unfold M_main.
hstep. { eapply TripleT_Triple,(projT2 (M_init_SpecT syms_diff _ _ _ _ _)). }
cbn. intros _.
start_TM.
hstep. {hsteps_cbn;cbn. eapply TripleT_Triple. exact (MK_isVoid_multi_SpecT 9). }
cbn;cleanupParamTM. intros _.
hstep. {eapply LiftTapes_Spec_ex. now smpl_dupfree. cbn. refine (EvalL.Spec _ _ _). now eapply closed_compiler_helper. }
cbn;cleanupParamTM.
intros _. eapply Triple_exists_pre. intros s'.
change (fun x => ?f x) with f.
hintros Heval%eval_iff. specialize (Hs2 Heval) as (res&->).
unfold_abbrev.
eapply Triple_exists_con. eexists res.
hstep. { eapply Consequence_pre. eapply TripleT_Triple. refine (projT2 (M_out_SpecT _ _ _ _ res)). cbn. reflexivity. }
cbn;cleanupParamTM. intros _.
apply Hs1 in Heval.
eapply EntailsI. intros tin [[] Hin]%tspecE.
eapply tspecI;cbn. easy.
intros i. specialize (Hin i). destruct_fin i;try exact Logic.I;cbn in *.
now simpl_vector. eassumption.
Qed.

Theorem M_main_SpecT v res:
R v res -> exists k__steps,
TripleT ≃≃([],Vector.const (Custom (eq niltape)) (S n_main) ++ Vector.map (fun bs => Custom (eq (encBoolsTM sym_s sym_b bs))) v)
k__steps M_main
(fun _ => ≃≃([],Custom (eq (encBoolsTM sym_s sym_b res)):::Vector.const (Custom (fun _ => True)) _)).