Section NatConstructor.
Definition S_Rel : Rel (tapes sigNat^+ 1) (unit * tapes sigNat^+ 1) :=
Mk_R_p (ignoreParam (fun tin tout => forall n sn : nat, tin ≃(;sn) n -> tout ≃(;pred sn) S n)).
Definition Constr_S : pTM sigNat^+ unit 1 :=
WriteMove (inr sigNat_S) Lmove;; Write (inl START).
Definition Constr_S_steps := 3.
Definition Constr_O_size := pred >> pred.
Definition O_Rel : Rel (tapes sigNat^+ 1) (unit * tapes sigNat^+ 1) :=
fun tin '(_, tout) => forall sn, isVoid_size tin[@Fin0] sn -> tout[@Fin0] ≃(;Constr_O_size sn) O.
Definition Constr_O : pTM sigNat^+ unit 1 := WriteValue 0.
Goal Constr_O = WriteMove (inl STOP) Lmove;; WriteMove (inr sigNat_O) Lmove;; Write (inl START).
End NatConstructor.
End CaseNat.
(* ** Tactic Support *)
Ltac smpl_TM_CaseNat :=
once lazymatch goal with
| [ |- CaseNat ⊨ _ ] => eapply RealiseIn_Realise; apply CaseNat_Sem
| [ |- CaseNat ⊨c(_) _ ] => apply CaseNat_Sem
| [ |- projT1 (CaseNat) ↓ _ ] => eapply RealiseIn_TerminatesIn; apply CaseNat_Sem
| [ |- Constr_O ⊨ _ ] => eapply RealiseIn_Realise; apply Constr_O_Sem
| [ |- Constr_O ⊨c(_) _ ] => apply Constr_O_Sem
| [ |- projT1 (Constr_O) ↓ _ ] => eapply RealiseIn_TerminatesIn; apply Constr_O_Sem
| [ |- Constr_S ⊨ _ ] => eapply RealiseIn_Realise; apply Constr_S_Sem
| [ |- Constr_S ⊨c(_) _ ] => apply Constr_S_Sem
| [ |- projT1 (Constr_S) ↓ _ ] => eapply RealiseIn_TerminatesIn; apply Constr_S_Sem
end.
Smpl Add smpl_TM_CaseNat : TM_Correct.

Lemma Constr_S_SpecT_size :
forall (y : nat) ss,
TripleT (≃≃(([], withSpace  [|Contains _ y |] ss))) Constr_S_steps Constr_S
(fun _ => ≃≃(([], withSpace  [|Contains _ (S y)|] (appSize [|S|] ss)))).