(* ** Examples *)
Arguments mult : simpl never.
Arguments plus : simpl never.
(* Disable the warnings regarding [Undo]. This is a demonstration file. *)
Set Warnings "-undo-batch-mode,-non-interactive".
(* *** Copy.v *)
Definition CopyValue_sizefun {sigX X : Type} {cX : codable sigX X} (x : X) : Vector.t (nat->nat) 2 := [|id; CopyValue_size x|].
(* Same example, but using the specification language *)
(* Example using the specification language and lifting: Increment two numbers *)
Definition Incr2 : pTM sigNat^+ unit 2 :=
Constr_S@[|Fin0|];; Constr_S@[|Fin1|].
Definition Incr2_steps := 1 + Constr_S_steps + Constr_S_steps.
(* More increments *)
Definition Incr3 : pTM sigNat^+ unit 3 :=
Constr_S@[|Fin0|];; Constr_S@[|Fin1|];; IncrementTwice@[|Fin2|].
Definition Incr3_steps := 2 + Constr_S_steps + Constr_S_steps + IncrementTwice_steps.
(* *** Addition *)
Definition Add_Step : pTM sigNat^+ (option unit) 2 :=
If (CaseNat @ [|Fin1|])
(Return (Constr_S @ [|Fin0|]) None)
(Return Nop (Some tt)).
(* 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_Step_Post : nat*nat -> option unit -> Assert sigNat^+ 2 :=
fun '(a,b) =>
(fun yout =>
≃≃(([yout = if b then Some tt else None]
,[|Contains _ (match b with 0 => a | _ => S a end);Contains _ (pred b)|]))).
Definition Add_Loop : pTM sigNat^+ unit 2 := While Add_Step.
(* 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 ). *)
(* The same with termination! *)
Definition Add_Step_steps : nat := 9.
(* With space *)
Definition Add_Step_size (a b : nat) : Vector.t (nat->nat) 2 :=
match b with
| 0 => [|id; id|]
| S b' => [|S; S|]
end.
Definition Add_Loop_steps b := 9 + 10 * b.
Fixpoint Add_Loop_size (a b : nat) : Vector.t (nat->nat) 2 :=
match b with
| O => Add_Step_size a b
| S b' => Add_Step_size a b >>> Add_Loop_size (S a) b'
end.
Definition Add : 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 *)
LiftTapes (Reset _) [|Fin3|]. (* Reset b *)
Definition Add_steps m n := 98 + 12 * n + 22 * m.
Definition Add_space (a b : nat) : Vector.t (nat->nat) 4 :=
[|(*0*) id; (*1*) id; (*2*) CopyValue_size b >> Add_Loop_size b a @>Fin0;
(*3*) CopyValue_size a >> (Add_Loop_size b a @>Fin1) >> Reset_size 0 |].  (* (* Optional *)
Arguments appSize : simpl never.
*)
(* *** Multiplication *)
Definition Mult_Step : pTM sigNat^+ (option unit) 5 :=
If (LiftTapes CaseNat [|Fin0|])
(Return (
LiftTapes Add [|Fin1; Fin2; Fin3; Fin4|];; (* Add(n, c, c') *)
LiftTapes (MoveValue _) [|Fin3; Fin2|]
) (None)) (* continue *)
(Return Nop (Some tt)). (* break *)
(* (* For comparison: The correctness relation of [Mult_Step] (with space) *)
Definition Mult_Step_Rel : pRel sigNat^+ (option unit) 5 :=
fun tin '(yout, tout) =>
forall (c m' n : nat) (sm sn sc s3 s4 : nat),
tin[@Fin0] ≃(;sm) m' ->
tin[@Fin1] ≃(;sn) n ->
tin[@Fin2] ≃(;sc) c ->
isVoid_size tin[@Fin3] s3 ->
isVoid_size tin[@Fin4] s4 ->
match yout, m' with
| (Some tt), O => (* return *)
tout[@Fin0] ≃(;sm) m' /\
tout[@Fin1] ≃(;sn) n /\
tout[@Fin2] ≃(;sc) c /\
isVoid_size tout[@Fin3] s3 /\
isVoid_size tout[@Fin4] s4
| None, S m'' => (* continue *)
tout[@Fin0] ≃(;S sm) m'' /\
tout[@Fin1] ≃(;sn) n /\
tout[@Fin2] ≃(;sc-n) n + c /\
isVoid_size tout[@Fin3] (2 + n + c + Add_space2 n c s3)  /\
isVoid_size tout[@Fin4] (Add_space3 n s4)
| _, _ => False
end.
*)
Definition Mult_Step_Post : nat*nat*nat -> option unit -> Assert sigNat^+ 5 :=
fun '(m',n,c) =>
(fun yout =>
≃≃([yout = if m' then Some tt else None],
[|Contains _ (pred m'); Contains _ n; Contains _ ( if m' then c else (n + c)); Void; Void|])).
Definition Mult_Step_steps m' n c :=
match m' with
| O => 6
| _ => 168 + 33 * c + 39 * n
end.
Definition Mult_Step_space m' n c : Vector.t (nat->nat) 5 :=
match m' with
| 0 => [|id; id; id; id; id|]
| S m'' => [| (*0*) S;
(*1*) Add_space n c @> Fin0; (* = [id] *)
(*2*) (Add_space n c @> Fin1) >> MoveValue_size_y (n+c) c; (*3*) (Add_space n c @> Fin2) >> MoveValue_size_x (n+c); (*4*) (Add_space n c @>Fin3) |] end.  Lemma Mult_Step_SpecT_size m' n c ss : TripleT (≃≃([],  withSpace ( [|Contains _ m'; Contains _ n; Contains _ c; Void; Void|]) ss)) (Mult_Step_steps m' n c) (Mult_Step) (fun yout => ≃≃([yout = if m' then Some tt else None], withSpace [|Contains _ (pred m'); Contains _ n; Contains _ ( if m' then c else (n + c)); Void; Void|] (appSize (Mult_Step_space m' n c) ss))).    Definition Mult_Loop := While Mult_Step.  Fixpoint Mult_Loop_steps m' n c := match m' with | O => S (Mult_Step_steps m' n c) | S m'' => S (Mult_Step_steps m' n c) + Mult_Loop_steps m'' n (n + c) end.   Lemma Mult_Loop_SpecT m' n c : TripleT (≃≃([], [|Contains _ m'; Contains _ n; Contains _ c; Void; Void|])) (Mult_Loop_steps m' n c) (Mult_Loop) (fun _ => ≃≃([], [|Contains _ 0; Contains _ n; Contains _ (m' * n + c); Void; Void|])).  Fixpoint Mult_Loop_size m' n c := match m' with | 0 => Mult_Step_space m' n c (* [id;...;id] *)
| S m'' => Mult_Step_space m' n c >>> Mult_Loop_size m'' n (n+c)
end.
Definition Mult : pTM sigNat^+ unit 6 :=
LiftTapes (CopyValue _) [|Fin0; Fin5|];; (* m' := m *)
LiftTapes (Constr_O) [|Fin2|];; (* c := 0 *)
LiftTapes Mult_Loop [|Fin5; Fin1; Fin2; Fin3; Fin4|];; (* Main loop *)
LiftTapes (Reset _) [|Fin5|]. (* Reset m'=0 *)
Definition Mult_steps (m n : nat) : nat := 12 * m + Mult_Loop_steps m n 0 + 57.

Lemma Mult_SpecT (m n : nat) :
TripleT
(≃≃([], [|Contains _ m; Contains _ n; Void; Void; Void; Void|]))
(Mult_steps m n)
(Mult)
(fun _ => ≃≃([], [|Contains _ m; Contains _ n; Contains _ (m * n); Void; Void; Void|])).