Section StepMachine.
Implicit Types H : Heap.
Implicit Types T V : list HClos.
Implicit Types a b c : HAdd.
Implicit Types g : HClos.
Implicit Types (P Q : Pro).
(* The machine operates on lists of closures and on a heap, so we need a closure-list alphabet and a heap alphabet. *)
Variable sigStep : finType.
Variable retr_closures_step : Retract (sigList sigHClos) sigStep.
Variable retr_heap_step : Retract sigHeap sigStep.
Set Default Proof Using "Type".
(* Retracts *)
(* Closures *)
Local Definition retr_clos_step : Retract sigHClos sigStep := ComposeRetract retr_closures_step _.
(* Closure addresses *)
Definition retr_pro_clos : Retract sigPro sigHClos := _.
Local Definition retr_pro_step : Retract sigPro sigStep := ComposeRetract retr_clos_step retr_pro_clos.
Local Definition retr_tok_step : Retract sigCom sigStep := ComposeRetract retr_pro_step _.
Local Definition retr_nat_clos_ad : Retract sigNat sigHClos := Retract_sigPair_X _ (Retract_id _).
Local Definition retr_nat_step_clos_ad : Retract sigNat sigStep := ComposeRetract retr_clos_step retr_nat_clos_ad.
Local Definition retr_nat_clos_var : Retract sigNat sigHClos := Retract_sigPair_Y _ _.
Local Definition retr_nat_step_clos_var : Retract sigNat sigStep := ComposeRetract retr_clos_step retr_nat_clos_var.
(* Instance of the [Lookup] and [JumpTarget] machine *)
Local Definition Step_Lookup := Lookup retr_clos_step retr_heap_step.
(* Cons a closure to a closure list, if the programm of the closure is not empty, and reset the program but not the address of the closure *)
Definition TailRec_size (T : list HClos) (P : Pro) (a : HAdd) : Vector.t (nat->nat) 3 :=
match P with
| nil => [| id; Reset_size P; id|]
| c :: P' => [| (*0*) Constr_cons_size (a,P); (*1*) Constr_pair_size a >> Reset_size (a,P); (*2*) id |]
end.
Definition TailRec_Rel : pRel sigStep^+ unit 3 :=
ignoreParam (
fun tin tout =>
forall T P a (s0 s1 s2 : nat),
tin[@Fin0] ≃(;s0) T ->
tin[@Fin1] ≃(retr_pro_step;s1) P ->
tin[@Fin2] ≃(retr_nat_step_clos_ad;s2) a ->
tout[@Fin0] ≃(;TailRec_size T P a @>Fin0 s0) tailRecursion (a, P) T /\
isVoid_size tout[@Fin1] (TailRec_size T P a @>Fin1 s1) /\
tout[@Fin2] ≃(retr_nat_step_clos_ad; TailRec_size T P a @>Fin2 s2) a
).
Definition TailRec : pTM sigStep^+ unit 3 :=
If (IsNil sigCom_fin ⇑ retr_pro_step @ [|Fin1|])
(Reset _ @ [|Fin1|])
(Constr_pair sigHAdd_fin sigPro_fin ⇑ retr_clos_step @ [|Fin2; Fin1|];;
Constr_cons sigHClos_fin ⇑ _ @ [|Fin0; Fin1|];;
Reset _ @ [|Fin1|]).
Local Arguments TailRec_size : simpl never.
Local Arguments tailRecursion : simpl never.
Definition TailRec_steps P a :=
match P with
| nil => 1 + IsNil_steps + Reset_steps nil
| t::P => 1 + IsNil_steps + 1 + Constr_pair_steps a + 1 + Constr_cons_steps (a,t::P) + Reset_steps (a, t :: P)
end.
Definition TailRec_T : tRel sigStep^+ 3 :=
fun tin k =>
exists T P a, tin[@Fin0] ≃ T /\
tin[@Fin1] ≃(retr_pro_step) P /\
tin[@Fin2] ≃(retr_nat_step_clos_ad) a /\
TailRec_steps P a <= k.
(* Like [TailRec], but doesn't check whether the program is empty, and resets [a] and [Q] *)
Definition ConsClos_size (T : list HClos) (Q : Pro) (a : HAdd) : Vector.t (nat->nat) 3 :=
[| Constr_cons_size (a,Q); Reset_size a; Constr_pair_size a >> Reset_size (a, Q) |].
Definition ConsClos_Rel : pRel sigStep^+ unit 3 :=
ignoreParam (
fun tin tout =>
forall T Q a (s0 s1 s2 : nat),
tin[@Fin0] ≃(;s0) T ->
tin[@Fin1] ≃(retr_nat_step_clos_ad;s1) a ->
tin[@Fin2] ≃(retr_pro_step;s2) Q ->
tout[@Fin0] ≃(;ConsClos_size T Q a @>Fin0 s0) (a, Q) :: T /\
isVoid_size tout[@Fin1] (ConsClos_size T Q a @>Fin1 s1) /\
isVoid_size tout[@Fin2] (ConsClos_size T Q a @>Fin2 s2)
).
Definition ConsClos : pTM sigStep^+ unit 3 :=
Constr_pair sigHAdd_fin sigPro_fin ⇑ retr_clos_step @ [|Fin1; Fin2|];;
Constr_cons sigHClos_fin ⇑ _ @ [|Fin0; Fin2|];;
Reset _ @ [|Fin2|];;
Reset _ @ [|Fin1|].

Lemma ConsClos_Realise : ConsClos ⊨ ConsClos_Rel.