(* * Machines on [N] (binary natural numbers) *)
Local Open Scope N_scope.
(* ** Write a number *)
Definition WriteNumber (n : N) : pTM sigN^+ unit 1 := WriteValue n.
Definition WriteNumber_Rel (n : N) : pRel sigN^+ unit 1:=
fun tin '(_, tout) =>
isVoid tin[@Fin0] ->
tout[@Fin0] ≃ n.
Definition WriteNumber_steps (n : N) : nat := 2 * Encode_N_size n + 3.
(* ** Constructor *)
Definition Constr_N0 : pTM sigN^+ unit 1 := WriteNumber 0.
Definition Constr_N0_Rel : pRel sigN^+ unit 1:=
fun tin '(_, tout) =>
isVoid tin[@Fin0] ->
tout[@Fin0] ≃ 0.
Definition Constr_N0_steps : nat := Eval cbn in WriteNumber_steps 0.
Definition Constr_Npos : pTM sigN^+ unit 1 := Constr_Some _.
Definition Constr_Npos_Rel : pRel sigN^+ unit 1 :=
fun tin '(_, tout) =>
forall (x : positive),
tin[@Fin0] ≃ x ->
tout[@Fin0] ≃ Npos x.
Definition Constr_Npos_Sem : Constr_Npos ⊨c(Constr_Some_steps) Constr_Npos_Rel.
(* ** Deconstructor *)
(* Don't reset tape when [x=0], in contrast to [CaseOption] *)
Definition CaseN : pTM sigN^+ bool 1 := If (CaseOption _) (Return Nop true) (Return (WriteNumber 0) false).
Definition CaseN_Rel : pRel sigN^+ bool 1 :=
fun tin '(yout, tout) =>
forall (x : N),
tin[@Fin0] ≃ x ->
match yout, x with
| true, Npos p => tout[@Fin0] ≃ p
| false, N0 => tout[@Fin0] ≃ 0
| _, _ => False
end.
Definition CaseN_steps : nat := 13.
(* ** Increment *)
Definition Increment_N : pTM sigN^+ unit 1 := If (CaseOption _) (Increment ⇑ _;; Constr_Some _) (WriteNumber 1).
Definition Increment_N_Rel : pRel sigN^+ unit 1 :=
fun tin '(_, tout) =>
forall (n : BinNums.N),
tin[@Fin0] ≃ n ->
tout[@Fin0] ≃ N.succ n.
(* ** Addition *)
Definition Add'_N : pTM sigN^+ unit 2 :=
If (CaseOption _ @[|Fin0|])
(If (CaseOption _ @[|Fin1|])
(Add' ⇑ _;; Constr_Some _@[|Fin0|];; Constr_Some _@[|Fin1|])
(Constr_Some _@[|Fin0|];; CopyValue _))
(Constr_None _@[|Fin0|]).
Definition Add'_N_Rel : pRel sigN^+ unit 2 :=
fun tin '(_, tout) =>
forall (x y : N),
tin[@Fin0] ≃ x ->
tin[@Fin1] ≃ y ->
x <= y ->
tout[@Fin0] ≃ x /\
tout[@Fin1] ≃ x + y.
Definition Add_N : pTM sigN^+ unit 3 :=
If (CaseOption _ @[|Fin0|])
(If (CaseOption _ @[|Fin1|])
(Add ⇑ _;; Constr_Some _@[|Fin0|];; Constr_Some _@[|Fin1|];; Constr_Some _@[|Fin2|])
(Constr_Some _@[|Fin0|];; Constr_None _@[|Fin1|];; CopyValue _ @[|Fin0; Fin2|]))
(Constr_None _@[|Fin0|];; CopyValue _@[|Fin1; Fin2|]).
Definition Add_N_Rel : pRel sigN^+ unit 3 :=
fun tin '(_, tout) =>
forall (x y : N),
tin[@Fin0] ≃ x ->
tin[@Fin1] ≃ y ->
isVoid tin[@Fin2] ->
tout[@Fin0] ≃ x /\
tout[@Fin1] ≃ y /\
tout[@Fin2] ≃ x+y.

Lemma Add_N_Realise : Add_N ⊨ Add_N_Rel.