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.
Definition CaseNat_size (n : nat) : Vector.t (nat->nat) 1 :=
match n with
| O => [|id|]
| S n' => [|S|]
end.

Lemma CaseNat_SpecT_size (y : nat) (ss : Vector.t nat 1) :
TripleT
≃≃([], withSpace  [|Contains _ y |] ss)
CaseNat_steps
CaseNat
(fun yout =>
≃≃([if yout then y <> 0 else y = 0],withSpace ([|Contains _ (pred y)|])
(appSize (CaseNat_size y) ss))).