(* * Implementation of [ϕ] (aka SplitBody) *)
From Undecidability.TM.L Require Import Alphabets CaseCom.
Local Arguments plus : simpl never.
Local Arguments mult : simpl never.
(* The [JumpTarget] machine only operates on programs. Thus we define [JumpTarget] on the alphabet [sigPro^+]. *)
(* This is the only way we can encode [nat] on [sigPro]: as a variable token. *)
Definition retr_nat_prog : Retract sigNat sigPro := Retract_sigList_X _.
(* append a token to the token list *)
Definition App_ACom (t : ACom) : pTM sigPro^+ unit 2 :=
WriteValue [ACom2Com t] @ [|Fin1|];;
App _.
Definition App_ACom_size (t : ACom) (Q : list Tok) : Vector.t (nat->nat) 2 :=
[| id; WriteValue_size [ACom2Com t] |] >>> App_size Q [ACom2Com t].
Definition App_ACom_Rel (t : ACom) : pRel sigPro^+ unit 2 :=
ignoreParam (
fun tin tout =>
forall (Q : list Tok) (s0 s1:nat),
tin[@Fin0] ≃(;s0) Q ->
isVoid_size tin[@Fin1] s1 ->
tout[@Fin0] ≃(;App_ACom_size t Q @>Fin0 s0) Q ++ [ACom2Com t] /\
isVoid_size tout[@Fin1] (App_ACom_size t Q @>Fin1 s1)
).
Arguments App_ACom_size : simpl never.
Definition App_ACom_steps (Q: Pro) (t: ACom) := 1 + WriteValue_steps (size [ACom2Com t]) + App_steps Q [ACom2Com t].
Definition App_ACom_T (t: ACom) : tRel sigPro^+ 2 :=
fun tin k => exists (Q: list Tok), tin[@Fin0] ≃ Q /\ isVoid tin[@Fin1] /\ App_ACom_steps Q t <= k.
(* Add a singleton list of tokes to [Q] *)
Definition App_Com : pTM sigPro^+ (FinType(EqType unit)) 3 :=
Constr_nil _ @ [|Fin2|];;
Constr_cons _@ [|Fin2; Fin1|];;
App _ @ [|Fin0; Fin2|];;
Reset _ @ [|Fin1|].
Definition App_Com_size (Q : list Tok) (t : Tok) : Vector.t (nat->nat) 3 :=
[| App_size Q [t] @>Fin0; Reset_size t; pred >> Constr_cons_size t >> App_size Q [t] @>Fin1 |].
Definition App_Com_Rel : pRel sigPro^+ (FinType(EqType unit)) 3 :=
ignoreParam (
fun tin tout =>
forall (Q : list Tok) (t : Tok) (s0 s1 s2 : nat),
tin[@Fin0] ≃(;s0) Q ->
tin[@Fin1] ≃(;s1) t ->
isVoid_size tin[@Fin2] s2 ->
tout[@Fin0] ≃(;App_Com_size Q t @>Fin0 s0) Q ++ [t] /\
isVoid_size tout[@Fin1] (App_Com_size Q t @>Fin1 s1) /\
isVoid_size tout[@Fin2] (App_Com_size Q t @>Fin2 s2)
).
Arguments App_Com_size : simpl never.
Definition App_Com_steps (Q: Pro) (t:Tok) :=
3 + Constr_nil_steps + Constr_cons_steps t + App_steps Q [t] + Reset_steps t.
Definition App_Com_T : tRel sigPro^+ 3 :=
fun tin k => exists (Q: list Tok) (t: Tok), tin[@Fin0] ≃ Q /\ tin[@Fin1] ≃ t /\ isVoid tin[@Fin2] /\ App_Com_steps Q t <= k.

Lemma App_Com_Terminates : projT1 App_Com ↓ App_Com_T.