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.
Proof  using Hscl Hs2 Hs1.
unfold M_main. intros ?.
apply Hs1 in H as H%eval_iff. eapply eval_evalIn in H as [? H].
(* edestruct EvalL.SpecT'. 2:eassumption. now eapply closed_compiler_helper. *)
eexists.
hstep. { eapply (projT2 (M_init_SpecT syms_diff _ _ _ _ _)). } 2:reflexivity.
cbn. intros _.
start_TM.
hstep. {hsteps_cbn;cbn. exact (MK_isVoid_multi_SpecT 9). } 2:reflexivity.
cbn;cleanupParamTM. intros _.
hstep. { eapply LiftTapes_SpecT. now smpl_dupfree. cbn. apply @EvalL.SpecT. }
cbn;cleanupParamTM.
intros _.
hstep. now refine (projT2 (M_out_SpecT _ _ _ _ res)).
cbn;cleanupParamTM. intros _.
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. reflexivity.
Unshelve. 3:easy. now eapply closed_compiler_helper.
Qed.
End main.

Theorem compiler_correct {k} (R : Vector.t (list bool) k -> (list bool) -> Prop) :
L_bool_computable_closed R -> TM_bool_computable_hoare' R.