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|].
Local Arguments ConsClos_size : simpl never.
Definition ConsClos_steps Q a :=
3 + Constr_pair_steps a + Constr_cons_steps (a,Q) + Reset_steps (a,Q) + Reset_steps a.
Definition ConsClos_T : tRel sigStep^+ 3 :=
fun tin k =>
exists T Q a,
tin[@Fin0] ≃ T /\
tin[@Fin1] ≃(retr_nat_step_clos_ad) a /\
tin[@Fin2] ≃(retr_pro_step) Q /\
ConsClos_steps Q a <= k.
Definition Step_lam_size (T V : list HClos) (H : Heap) (a : HAdd) (P : Pro) : Vector.t (nat->nat) 10 :=
match jumpTarget 0 [] P with
| Some (Q, P') =>
(JumpTarget_size P @>> [|Fin3; Fin6; Fin7; Fin8; Fin9|]) >>> (TailRec_size T P' a @>> [|Fin0; Fin3; Fin4|]) >>> (ConsClos_size V Q a @>> [|Fin1; Fin4; Fin6|])
| _ => default
end.
Definition Step_lam_Rel : pRel sigStep^+ bool 10 :=
fun tin '(yout, tout) =>
forall (T V : list HClos) (H : Heap) (a : HAdd) (P : Pro) (s0 s1 s2 s3 s4 : nat) (sr : Vector.t nat 5),
let size := Step_lam_size T V H a P in
tin[@Fin0] ≃(;s0) T ->
tin[@Fin1] ≃(;s1) V ->
tin[@Fin2] ≃(;s2) H ->
tin[@Fin3] ≃(retr_pro_step;s3) P ->
tin[@Fin4] ≃(retr_nat_step_clos_ad;s4) a ->
(forall i : Fin.t 5, isVoid_size tin[@FinR 5 i] sr[@i]) ->
match yout with
| true =>
exists (P' Q : Pro),
jumpTarget 0 [] P = Some (Q, P') /\
tout[@Fin0] ≃(;size@>Fin0 s0) tailRecursion (a, P') T /\
tout[@Fin1] ≃(;size@>Fin1 s1) (a, Q) :: V /\
tout[@Fin2] ≃(;size@>Fin2 s2) H /\
(forall i : Fin.t 7, isVoid_size tout[@FinR 3 i] (size@>(FinR 3 i) (s3:::s4:::sr)[@i]))
| false => jumpTarget 0 [] P = None
end.
Definition Step_lam : pTM sigStep^+ bool 10 :=
If (JumpTarget ⇑ retr_pro_step @ [|Fin3; Fin6; Fin7; Fin8; Fin9|])
(Return (TailRec @ [|Fin0; Fin3; Fin4|];;
ConsClos @ [|Fin1; Fin4; Fin6|])
true)
(Return Nop false).

Lemma Step_lam_Realise : Step_lam ⊨ Step_lam_Rel.