Commit 410635e3 authored by charguer's avatar charguer

tutorial cfml cleanup

parent 4c566616
...@@ -34,7 +34,8 @@ CFML tactics: ...@@ -34,7 +34,8 @@ CFML tactics:
- [xcf] - [xcf]
- [xsimpl], or [xsimpl X1 .. X2] (to instantiate Hexists) - [xsimpl], or [xsimpl X1 .. X2] (to instantiate Hexists)
- [xpull] - [xpull]
- [xret], or [xapps] for substitution/simplification - [xclean] sometimes needed to do simplifications
- [xret], or [xrets] for substitution/simplification
- [xapp], or [xapps] for substitution - [xapp], or [xapps] for substitution
- [xfor_inv (fun i => H)] - [xfor_inv (fun i => H)]
- [xwhile_inv_basic (fun b k => [b = isTrue(..)] \* H) (downto n)] - [xwhile_inv_basic (fun b k => [b = isTrue(..)] \* H) (downto n)]
...@@ -113,59 +114,69 @@ Hint Rewrite math_plus_one_twice math_minus_same ...@@ -113,59 +114,69 @@ Hint Rewrite math_plus_one_twice math_minus_same
(** Basic operations *) (** Basic operations *)
(*---------------------------------------------------------------------*) (*---------------------------------------------------------------------*)
(*----
let example_let n = (**
let a = n+1 in [[
let b = n-1 in let example_let n =
a + b let a = n+1 in
----*) let b = n-1 in
a + b
]]
*)
Lemma example_let_spec : forall n, Lemma example_let_spec : forall n,
app example_let [n] app example_let [n]
PRE \[] PRE \[]
POST (fun (v:int) => \[v = 2*n]). (* POST \[= (2 * n)] *) POST (fun (v:int) => \[v = 2*n]).
(* post-condition also written: POST \[= (2 * n)] *)
Proof using. Proof using.
dup 2. (* Hint: the proof uses [xcf], [xret], [xsimpl], [math].
{ xcf. [xlet] is optional; if used then [xpull] is also needed. *)
dup 3.
{ (* detailed proof *)
xcf.
xlet. xret. simpl. xpull. intros Ha. xlet. xret. simpl. xpull. intros Ha.
xlet. xret. simpl. xpull. intros Hb. xlet. xret. simpl. xpull. intros Hb.
xret. (*hnf.*) xsimpl. math. } xret. (*hnf.*) xsimpl. math. }
{ xcf. xret ;=> Ha. xret. intros Hb. xret. xsimpl. math. } { (* shorter proof *)
(* use: [xcf], [xret], [xsimpl], [math]; xcf. xret ;=> Ha. xret ;=> Hb. xret. xsimpl. math. }
[xlet] is optional; if used then [xpull] is also needed. *) { (* real proof *)
xcf. xrets. xrets. xrets. math. }
Qed. Qed.
(*---------------------------------------------------------------------*) (*---------------------------------------------------------------------*)
(*----
let example_incr r =
r := !r + 1
let example_incr r =
let x0__ := get r in
set r (x0__ + 1)
----*) (**
[[
let example_incr r =
r := !r + 1
]]
normalized to:
[[
let example_incr r =
let x0__ := get r in
set r (x0__ + 1)
]]
*)
Lemma example_incr_spec : forall r n, Lemma example_incr_spec : forall r n,
app example_incr [r] app example_incr [r]
PRE (r ~~> n) PRE (r ~~> n)
POST (fun (_:unit) => (r ~~> (n+1))). (* POST (# r ~~> (n+1)). *) POST (fun (_:unit) => (r ~~> (n+1))).
(* post-condition also written: POST (# r ~~> (n+1)). *)
Proof using. Proof using.
(* Hint: the proof uses [xcf], [xapp].
[xapps] is a shortand for [xapp] followed with [subst]. *)
dup 3. dup 3.
{ xcf. xlet. xapp. simpl. xpull. intros. subst. xapp. } { xcf. xlet. xapp. simpl. xpull. intros. subst. xapp. }
{ xcf. xapp. intros. subst. xapp. } { xcf. xapp. intros. subst. xapp. }
{ xcf. xapps. xapp. } { xcf. xapps. xapp. }
(* use: [xcf], [xapp];
[xapps] is a shortand for [xapp] followed with [subst] *)
Qed. Qed.
(* (* Note: recall the specifications of get and set from Pervasives_proof:
Let x0__ := app get [r] in
app set [r (x0__ + 1)]
*)
(* Remark: here are the specifications of get and set from Pervasives_proof.
Lemma get_spec : forall A (v:A) r, Lemma get_spec : forall A (v:A) r,
app get [r] app get [r]
...@@ -178,7 +189,9 @@ Qed. ...@@ -178,7 +189,9 @@ Qed.
*) *)
(*---------------------------------------------------------------------*) (*---------------------------------------------------------------------*)
(*----
(**
[[
let example_two_ref n = let example_two_ref n =
let i = ref 0 in let i = ref 0 in
let r = ref n in let r = ref n in
...@@ -186,70 +199,60 @@ let example_two_ref n = ...@@ -186,70 +199,60 @@ let example_two_ref n =
incr i; incr i;
r := !i + !r; r := !i + !r;
!i + !r !i + !r
----*) ]]
*)
Lemma example_two_ref_spec : forall n: int, Lemma example_two_ref_spec : forall n: int,
(* <EXO> *) (* <EXO> *)
app example_two_ref [n] app example_two_ref [n]
PRE \[] PRE \[]
POST (fun x: int => \[ x = n+1 ]). POST (fun x: int => \[ x = n+1 ]).
(* </EXO *)
Proof using. Proof using.
(* (* Hint: the proof uses [xcf], [xapp], [xapps], and [xret] or [xrets]. *)
dup 3. dup 3.
{xcf. xlet. xapp. simpl. xpull. intros. { (* detailed proof *)
xapp. xcf.
xapp. xapp. (* details: xlet. xapp. simpl. *)
xapp. xapp. xapp. xapp.
xapps. xapps. xapps. xapps. xapps. xret. xsimpl. math. xapps. (* details: xapp. intro. subst. *)
} xapps. xapps. xapps. xapps.
{xcf. xgo. subst. math. } xrets. (* details: xret. xsimpl. *)
*)
xcf. xapp. xapp. xapp. xapp. xapps. xapps. xapps. xapps. xapps. xret. xsimpl. math.
Qed.
(*
app example_two_ref [n]
PRE \[]
POST (fun (v:int) => \[v = n+1]).
(* </EXO> *)
Proof using.
(* <EXO> *)
dup.
{ xcf.
xapps.
xapps.
xapps.
xapps.
xapps.
xapps.
xapps.
xapps.
xapps.
xret.
xsimpl.
math. } math. }
{ xcf. xgo~. } { (* shorter proof, not recommended for nontrivial code *)
(* </EXO> *) xcf. xgo. subst. math. }
{ (* real proof *)
xcf. xgo~. }
Qed. Qed.
*)
(***********************************************************************) (***********************************************************************)
(** For loops *) (** For loops *)
(*---------------------------------------------------------------------*) (*---------------------------------------------------------------------*)
(*----
let facto_for n = (**
let r = ref 1 in [[
for i = 1 to n do let facto_for n =
r := !r * i; let r = ref 1 in
done; for i = 1 to n do
!r r := !r * i;
----*) done;
!r
]]
*)
(* Reasoning principle for the loop [for i = a to b to t done] when [b+1>=a]
implemented by tactic [xfor_inv I].
I a initial invariant
I i -> I (i+1) when executing [t] on some [i] in the range from [a] to [b]
I (b+1) final invariant
*)
Lemma facto_for_spec : forall n, Lemma facto_for_spec : forall n,
n >= 1 -> n >= 1 ->
...@@ -262,79 +265,46 @@ Proof using. ...@@ -262,79 +265,46 @@ Proof using.
{ math. } { math. }
{ xsimpl. forwards: facto_zero. easy. } { xsimpl. forwards: facto_zero. easy. }
{ =>> Hi. xapps. xapps. xsimpl. { =>> Hi. xapps. xapps. xsimpl.
rew_maths. rewrite (@facto_succ i). ring. math. } rew_maths. rewrite (@facto_succ i). ring. math. }
xapps. xsimpl. rew_maths. auto. xapps. xsimpl. rew_maths. auto.
Qed. Qed.
(* Remark: reasoning principle for the loop [for i = a to b to t done] when [b+1>=a]
I a initial invariant
I i -> I (i+1) when executing [t] on some [i] in the range from [a] to [b]
I (b+1) final invariant (*---------------------------------------------------------------------*)
(**
[[
let fib_for n =
let a = ref 0 in
let b = ref 1 in
for i = 0 to n-1 do
let c = !a + !b in
a := !b;
b := c;
done;
!a
]]
*) *)
(*---------------------------------------------------------------------*)
(*----
let fib_for n =
let a = ref 0 in
let b = ref 1 in
for i = 0 to n-1 do
let c = !a + !b in
a := !b;
b := c;
done;
!a
----*)
Lemma fib_for_spec : forall n, Lemma fib_for_spec : forall n,
n >= 1 -> n >= 1 ->
app fib_for [n] app fib_for [n]
PRE \[] PRE \[]
POST (fun (v:int) => \[v = fib n]). POST (fun (v:int) => \[v = fib n]).
Proof using. Proof using.
(* Hint: follow the pattern from the previous example *)
(* <EXO> *) (* <EXO> *)
=>> Hn. xcf. xapps. xapps. =>> Hn. xcf. xapps. xapps.
xfor_inv (fun i => a ~~> (fib i) \* b ~~> (fib (i+1)) ). xfor_inv (fun i => a ~~> (fib i) \* b ~~> (fib (i+1)) ).
{ math. } { math. }
{ xsimpl. rewrite fib_base. math. math. rewrite~ fib_base. (*math. math.*) } { xsimpl.
rewrite~ fib_base. (* details: math. math. rewrite fib_base. *)
rewrite~ fib_base. }
{ =>> Hi. xapps. xapps. xrets. xapps. xapps. xapps. xsimpl. { =>> Hi. xapps. xapps. xrets. xapps. xapps. xapps. xsimpl.
rew_maths. rewrite~ (@fib_succ (i+2)). rew_maths. math_rewrite ((i + 2)-1 = i+1). math. } rew_maths. rewrite~ (@fib_succ (i+2)). rew_maths.
xapps. xsimpl~. math_rewrite ((i + 2)-1 = i+1). math. }
xapps. xsimpl~.
(* </EXO> *) (* </EXO> *)
Qed. Qed.
...@@ -358,16 +328,37 @@ Qed. ...@@ -358,16 +328,37 @@ Qed.
(** While loops *) (** While loops *)
(*---------------------------------------------------------------------*) (*---------------------------------------------------------------------*)
(*----
let example_while n = (**
let i = ref 0 in [[
let r = ref 0 in let example_while n =
while !i < n do let i = ref 0 in
incr i; let r = ref 0 in
incr r; while !i < n do
done; incr i;
!r incr r;
----*) done;
!r
]]
*)
(* Reasoning principle for the loop [while t1 do t2] using an invariant
implemented by tactic [xwhile_inv_basic J W].
J b i true for some boolean [b] and some initial index [k]
J b i when executing [t1] on some [i]
->
J b' i
J true i when executing [t2] on some [i], should restablish the
-> invariant for some [b'] and some [i'] smaller than [i]
J b' i' w.r.t. [W], that is [W i' i].
J false i for some [i] describes the final state
*)
Lemma example_while_spec : forall n, Lemma example_while_spec : forall n,
n >= 0 -> n >= 0 ->
...@@ -389,16 +380,19 @@ Qed. ...@@ -389,16 +380,19 @@ Qed.
(*---------------------------------------------------------------------*) (*---------------------------------------------------------------------*)
(*----
let facto_while n = (**
let r = ref 1 in [[
let i = ref 1 in let facto_while n =
while !i <= n do let r = ref 1 in
r := !i * !r; let i = ref 1 in
incr i; while !i <= n do
done; r := !i * !r;
!r incr i;
----*) done;
!r
]]
*)
Lemma facto_while_spec : forall n, Lemma facto_while_spec : forall n,
n >= 2 -> n >= 2 ->
...@@ -406,6 +400,7 @@ Lemma facto_while_spec : forall n, ...@@ -406,6 +400,7 @@ Lemma facto_while_spec : forall n,
PRE \[] PRE \[]
POST (fun (v:int) => \[v = facto n]). POST (fun (v:int) => \[v = facto n]).
Proof using. Proof using.
(* Hint: follow the pattern from previous example *)
(* <EXO> *) (* <EXO> *)
introv Hn. xcf. xapps. xapps. introv Hn. xcf. xapps. xapps.
xwhile_inv_basic (fun b k => \[b = isTrue (k <= n)] \* \[2 <= k <= n+1] xwhile_inv_basic (fun b k => \[b = isTrue (k <= n)] \* \[2 <= k <= n+1]
...@@ -424,17 +419,24 @@ Qed. ...@@ -424,17 +419,24 @@ Qed.
(*---------------------------------------------------------------------*) (*---------------------------------------------------------------------*)
(*----
let is_prime n = (* TODO: add demos using the other xfor and xwhile approach *)
let i = ref 2 in
let p = ref true in (*---------------------------------------------------------------------*)
while !p && (!i * !i <= n) do
if (n mod !i) = 0 (**
then p := false; [[
incr i; let is_prime n =
done; let i = ref 2 in
!p let p = ref true in
----*) while !p && (!i * !i <= n) do
if (n mod !i) = 0
then p := false;
incr i;
done;
!p
]]
*)
Require Import Psatz. Require Import Psatz.
Tactic Notation "math_nia" := math_setup; nia. Tactic Notation "math_nia" := math_setup; nia.
...@@ -458,11 +460,13 @@ Proof using. ...@@ -458,11 +460,13 @@ Proof using.
{ xapps. xapps. xrets*. } { xapps. xapps. xrets*. }
{ xsimpl*. } } { xsimpl*. } }
{ => k. xpull ;=> vp Hb Hp Hk. { => k. xpull ;=> vp Hb Hp Hk.
(* TODO: xclean. *) xclean. destruct Hb as (Hvp&Hkk). xclean. (* cleans up results of boolean tests *)
destruct Hb as (Hvp&Hkk).
xapps. xapps. math. xapps. xapps. math.
xrets. xseq. xif (# Hexists (vp':bool), i ~~> k \* p ~~> vp' \* xrets.
xseq. (* TODO: later try to change xif to remove xseq *)
xif (# Hexists (vp':bool), i ~~> k \* p ~~> vp' \*
\[if vp' then (forall d, 1 < d < (k+1) -> Z.rem n d <> 0) else (~ prime n)]). \[if vp' then (forall d, 1 < d < (k+1) -> Z.rem n d <> 0) else (~ prime n)]).
(* TODO: remove xseq *)
{ xapps. xsimpl. applys~ divide_not_prime. math_nia. } { xapps. xsimpl. applys~ divide_not_prime. math_nia. }
{ xrets. rewrite Hvp in *. =>> Hd. tests: (d = k). auto. applys~ Hp. } { xrets. rewrite Hvp in *. =>> Hd. tests: (d = k). auto. applys~ Hp. }
xpull ;=> vp' Hvp'. xapps. xsimpl. xpull ;=> vp' Hvp'. xapps. xsimpl.
...@@ -481,12 +485,15 @@ Qed. ...@@ -481,12 +485,15 @@ Qed.
(** Recursion *) (** Recursion *)
(*---------------------------------------------------------------------*) (*---------------------------------------------------------------------*)
(*----
let rec facto_rec n = (**
if n <= 1 [[
then 1 let rec facto_rec n =
else n * facto_rec(n-1) if n <= 1
----*) then 1
else n * facto_rec(n-1)
]]
*)
Lemma facto_rec_spec : forall n, Lemma facto_rec_spec : forall n,
n >= 1 -> n >= 1 ->
...@@ -497,18 +504,21 @@ Proof using. ...@@ -497,18 +504,21 @@ Proof using.
=> n. induction_wf IH: (downto 0) n. unfolds downto. => Hn. => n. induction_wf IH: (downto 0) n. unfolds downto. => Hn.
xcf. xif. xcf. xif.
{ xrets. math_rewrite (n=1). rewrite~ facto_one. } { xrets. math_rewrite (n=1). rewrite~ facto_one. }
{ xapps. math. math. (* could be written [xapps~] *) { xapps. math. math. (* optimization: could be written [xapps~] *)
xrets. rewrite~ (@facto_succ n). } xrets. rewrite~ (@facto_succ n). }
Qed. Qed.
(*---------------------------------------------------------------------*) (*---------------------------------------------------------------------*)
(*----
let rec fib_rec n = (**
if n <= 1 [[
then 1 let rec fib_rec n =
else fib_rec(n-1) + fib_rec(n-2) if n <= 1
----*) then 1
else fib_rec(n-1) + fib_rec(n-2)
]]
*)
Lemma fib_rec_spec : forall n, Lemma fib_rec_spec : forall n,
n >= 0 -> n >= 0 ->
...@@ -516,6 +526,7 @@ Lemma fib_rec_spec : forall n, ...@@ -516,6 +526,7 @@ Lemma fib_rec_spec : forall n,
PRE \[] PRE \[]
POST (fun (v:int) => \[v = fib n]). POST (fun (v:int) => \[v = fib n]).
Proof using. Proof using.
(* Hint: follow the pattern for the previous example *)
(* <EXO> *) (* <EXO> *)
=> n. induction_wf IH: (downto 0) n. => Hn. => n. induction_wf IH: (downto 0) n. => Hn.
xcf. xif. xcf. xif.
...@@ -530,42 +541,46 @@ Qed. ...@@ -530,42 +541,46 @@ Qed.
(** Stack *) (** Stack *)
(*---------------------------------------------------------------------*) (*---------------------------------------------------------------------*)
(*----
module StackList = struct
type 'a t = { (*
mutable items : 'a list; [[
mutable size : int } module StackList = struct
type 'a t = {
mutable items : 'a list;
mutable size : int }
let create () = let create () =
{ items = []; { items = [];
size = 0 } size = 0 }
let size s = let size s =
s.size s.size
let is_empty s = let is_empty s =
s.size = 0 s.size = 0
let push x s = let push x s =
s.items <- x :: s.items; s.items <- x :: s.items;
s.size <- s.size + 1 s.size <- s.size + 1
let pop s = let pop s =
match s.items with match s.items with
| hd::tl -> | hd::tl ->
s.items <- tl; s.items <- tl;
s.size <- s.size - 1; s.size <- s.size - 1;
hd hd
| [] -> assert false