(* * Constructors and Deconstructors for Pair Types *)
Local Arguments plus : simpl never. Local Arguments mult : simpl never.
Local Arguments size : simpl never.
Definition CasePair_steps {sigX X : Type} {cX : codable sigX X} (x : X) :=
34 + 16 * size x.
Definition CasePair_T : tRel sigPair^+ 2 :=
fun tin k => exists (p : X * Y), tin[@Fin0] ≃ p /\ CasePair_steps (fst p) <= k.
(* ** Constructor *)
Definition Constr_pair_size {sigX X : Type} {cX : codable sigX X} (x : X) (s1 : nat) := s1 - size x.
Definition Constr_pair_Rel : pRel sigPair^+ unit 2 :=
ignoreParam (
fun tin tout =>
forall (x : X) (y : Y) (s0 s1 : nat),
tin[@Fin0] ≃(;s0) x ->
tin[@Fin1] ≃(;s1) y ->
tout[@Fin0] ≃(;s0) x /\
tout[@Fin1] ≃(;Constr_pair_size x s1) (x, y)
).
Definition Constr_pair : pTM sigPair^+ unit 2 :=
LiftTapes (MoveRight _;; Move Lmove) [|Fin0|];;
CopySymbols_L stopAtStart.
Definition Constr_pair_steps {sigX X : Type} {cX : codable sigX X} (x : X) : nat := 19 + 12 * size x.
Definition Constr_pair_T : tRel sigPair^+ 2 :=
fun tin k => exists (x : X), tin[@Fin0] ≃ x /\ Constr_pair_steps x <= k.
(* [Snd] simply discard the first element *)
Definition Snd_size {sigX X : Type} {cX : codable sigX X} (x : X) (s : nat) := s + size x.
Definition Snd_Rel : pRel sigPair^+ unit 1 :=
ignoreParam (fun tin tout => forall (p : X*Y) (s : nat), tin[@Fin0] ≃(;s) p -> tout[@Fin0] ≃(; Snd_size (fst p) s) snd p).
Definition Snd : pTM sigPair^+ unit 1 :=
MoveToSymbol stopAfterFirst id;;
Move Lmove;;
Write (inl START).

Lemma Snd_Realise : Snd ⊨ Snd_Rel.