(* * Machines that compte natural functions *)
(* Don't simplify [skipn (S n) xs]; only, if the number and the lists are constructors *)
Local Arguments skipn { A } !n !l.
Local Arguments Encode_nat : simpl never.
(* Lemma nat_encode_length (n : nat) : | encode n : list bool | = S n.  Lemma max_max_le (m n : nat) : max (max m n) n = max m n. *)
(* ** Addition *)
(* * Step machine * * if (b--) { *   a++; *   continue; * } else { *   break; * } * * Tapes: * t0: a * t1: b *)
Definition Add_Step : pTM sigNat^+ (option unit) 2 :=
If (LiftTapes CaseNat [|Fin1|])
(Return (LiftTapes Constr_S [|Fin0|]) None)
(Return Nop (Some tt)).
Definition Add_Loop : pTM sigNat^+ unit 2 := While Add_Step.
(* * Full machine in pseudocode: * a := n * b := m * while (b--) { // Loop *   a++; * } * reset b; * return a; * * Tapes: * INP t0: m * INP t1: n * OUT t2: a * INT t3: b *)
(* Everything, but not reset *)
Definition Add_Main : pTM sigNat^+ unit 4 :=
LiftTapes (CopyValue _) [|Fin1; Fin2|];; (* copy n to a *)
LiftTapes (CopyValue _) [|Fin0; Fin3|];; (* copy m to b *)
LiftTapes Add_Loop [|Fin2; Fin3|]. (* Main loop *)
(* * Finally, reset tape b. * For technical reasons, it is convienient to define the machine for this last step seperately, * because it makes prooving the termination easier. *)
Definition Add :=
Add_Main;; (* Initialisation and main loop *)
LiftTapes (Reset _) [|Fin3|]. (* Reset b *)
(* *** Correctness of [Add] *)
Definition Add_Step_Rel : pRel sigNat^+ (option unit) 2 :=
fun tin '(yout, tout) =>
forall a b sa sb,
tin [@Fin0] ≃(;sa) a ->
tin [@Fin1] ≃(;sb) b ->
match yout, b with
| Some tt, O => (* break *)
tout[@Fin0] ≃(;sa) a /\
tout[@Fin1] ≃(;sb) b
| None, S b' =>
tout[@Fin0] ≃(;pred sa) S a /\
tout[@Fin1] ≃(;S sb) b'
| _, _ => False
end.
Definition Add_Loop_Rel : pRel sigNat^+ unit 2 :=
ignoreParam (
fun tin tout =>
forall a b sa sb,
tin [@Fin0] ≃(;sa) a ->
tin [@Fin1] ≃(;sb) b ->
tout[@Fin0] ≃(;sa-b) b + a /\
tout[@Fin1] ≃(;sb+b) 0
).
(* Everything, but reset *)
Definition Add_Main_Rel : pRel sigNat^+ unit 4 :=
ignoreParam (
fun tin tout =>
forall m n sm sn s2 s3,
tin [@Fin0] ≃(;sm) m ->
tin [@Fin1] ≃(;sn) n ->
isVoid_size tin[@Fin2] s2 ->
isVoid_size tin[@Fin3] s3 ->
tout[@Fin0] ≃(;sm) m /\
tout[@Fin1] ≃(;sn) n /\
tout[@Fin2] ≃(; s2 - (S (size n)) - m) m + n /\
tout[@Fin3] ≃(; s3 - (2 + m) + m) 0
).
Goal forall (x m : nat), x - m + m >= x. intros. lia. Qed.
Definition Add_space2 (m n : nat) (so : nat) := so + m - n - 2.
Definition Add_space3 (m : nat) (s3 : nat) := 2 + (s3 - (2 + m) + m).
Definition Add_Rel : pRel sigNat^+ unit 4 :=
ignoreParam
(fun tin tout =>
forall (m : nat) (n : nat) (sx sy so s3 : nat),
tin[@Fin0] ≃(;sx) m ->
tin[@Fin1] ≃(;sy) n ->
isVoid_size tin[@Fin2] so ->
isVoid_size tin[@Fin3] s3 ->
tout[@Fin0] ≃(;sx) m /\ (* First input value stayes unchanged *)
tout[@Fin1] ≃(;sy) n /\ (* Second input value stayes unchanged *)
tout[@Fin2] ≃(;Add_space2 m n so) (m + n) /\
isVoid_size tout[@Fin3] (Add_space3 m s3)
).

Lemma Add_Computes : Add ⊨ Add_Rel.