(** In this file, we develop a logic, based on Hoare logic, for reasoning
about programs. This follows the Software Foundations book fairly
closely. *)
(** Our big-step semantics for IMP as before, with one minor change noted below. *)
Require Import Arith.
Require Import String.
Require Import Bool.
Set Implicit Arguments.
Local Open Scope string_scope.
Definition var : Type := string.
Inductive aexp : Type :=
| AVar : var -> aexp
| ANum : nat -> aexp
| APlus : aexp -> aexp -> aexp
| AMinus : aexp -> aexp -> aexp
| AMult : aexp -> aexp -> aexp.
Inductive bexp : Type :=
| Bool : bool -> bexp (* true, false *)
| Eq : aexp -> aexp -> bexp (* a1 == a2 *)
| Lte : aexp -> aexp -> bexp (* a1 <= a2 *)
| And : bexp -> bexp -> bexp (* b1 && b2 *)
| Or : bexp -> bexp -> bexp. (* b1 || b2 *)
Inductive com : Type :=
| Skip : com (* do nothing *)
| Assign : var -> aexp -> com (* x := a *)
| Seq : com -> com -> com (* c1 ; c2 *)
| If : bexp -> com -> com -> com (* if b then c1 else c2 *)
| While : bexp -> com -> com. (* while b do c *)
Definition state : Type := var -> nat.
Definition lookup(x:var)(s:state) : nat := s x.
Definition update(x:var)(v:nat)(s:state) : state :=
fun y => if string_dec x y then v else s y.
Fixpoint aeval (a:aexp)(s:state) : nat :=
match a with
| AVar x => lookup x s
| ANum n => n
| APlus a1 a2 => (aeval a1 s) + (aeval a2 s)
| AMinus a1 a2 => (aeval a1 s) - (aeval a2 s)
| AMult a1 a2 => (aeval a1 s) * (aeval a2 s)
end.
Fixpoint beval (b:bexp)(s:state) : bool :=
match b with
| Bool x => x
| Eq a1 a2 =>
if eq_nat_dec (aeval a1 s) (aeval a2 s) then true else false
| Lte a1 a2 =>
if le_gt_dec (aeval a1 s) (aeval a2 s) then true else false
| And b1 b2 => (beval b1 s) && (beval b2 s)
| Or b1 b2 => (beval b1 s) || (beval b2 s)
end.
(** I've changed the treatment of [While] here to match Software
Foundations. It actually simplifies some of the proofs in here.
(But you could prove that this semantics is equivalent to the
unrolling semantics!) *)
Inductive ceval : com -> state -> state -> Prop :=
| Ceval_skip :
forall s, ceval Skip s s
| Ceval_assign :
forall x a s, ceval (Assign x a) s (update x (aeval a s) s)
| Ceval_seq :
forall c1 c2 s1 s2 s3,
ceval c1 s1 s2 ->
ceval c2 s2 s3 ->
ceval (Seq c1 c2) s1 s3
| Ceval_if_true :
forall b c1 c2 s1 s2,
beval b s1 = true ->
ceval c1 s1 s2 ->
ceval (If b c1 c2) s1 s2
| Ceval_if_false :
forall b c1 c2 s1 s2,
beval b s1 = false ->
ceval c2 s1 s2 ->
ceval (If b c1 c2) s1 s2
| Ceval_while_false :
forall b c s,
beval b s = false ->
ceval (While b c) s s
| Ceval_while_true :
forall b c s1 s2 s3,
beval b s1 = true ->
ceval c s1 s2 ->
ceval (While b c) s2 s3 ->
ceval (While b c) s1 s3.
(** An [sprop] is a predicate on [state]s *)
Definition sprop := state -> Prop.
(** An [hpct] or Hoare-partial-correctness-triple consists of a
pre-condition, a command, and a post-condition. [hpct P c Q]
holds when for any states [s1] and [s2] such that [s1] satisfies
the pre-condition [P], and when we run [c] in [s1] and get
state [s2], then the post-condition [Q] holds on the final state.
Note that this doesn't say anything about commands that may
diverge. *)
Definition hpct(P:sprop)(c:com)(Q:sprop) :=
forall s1 s2, P s1 -> ceval c s1 s2 -> Q s2.
(** It's useful to define notation to make this a little more readable.
Coq let's you define notation in a fairly intuitive way, except for
guessing the appropriate "level" which determines how tightly the
notation groups when Coq parses. Notice also that I've placed the
notation in a particular scope ([hoare_scope]) so that I can control
when it should be used. I need to open the scope (see below) to
enable it. *)
Notation "{{ P }} c {{ Q }}" := (hpct P c Q) (at level 70) : hoare_scope.
(** An [htct] or Hoare-total-correctness-triple is the same as a
partial correctness triple, except that we require that the
command terminates -- i.e., produces an output state [s2]
satisfying [Q] for any input state [s1] satisfying [P]. *)
Definition htct(P:sprop)(c:com)(Q:sprop) :=
forall s1, P s1 -> exists s2, ceval c s1 s2 /\ Q s2.
Notation "[[ P ]] c [[ Q ]]" := (htct P c Q) (at level 70) : hoare_scope.
(** Open up the [hoare_scope] so that we can use the fancy notation. *)
Local Open Scope hoare_scope.
(** Next, we're going to define some rules for reasoning directly about
Hoare partial correctness triples. Note that each one involves a
relatively simple proof. But once we have a set of proof rules for
reasoning about commands, then we can use them directly to reason
about programs. *)
(** The first rule says that if we run [Skip] in a state satisfying
[P], then if we terminate, we get a state satisfying [P]. *)
Lemma hpct_skip P : {{ P }} Skip {{ P }}.
Proof.
unfold hpct. intros. inversion H0 ; subst. auto.
Qed.
(** Sequencing is pretty straightforward. If we run [c1] in a state
satisfying [P] to get a state satisfying [Q], then if [Q] is the
pre-condition on [c2], we can run it to get a state satisfying
[c2]'s post-condition [R]. *)
Lemma hpct_seq c1 c2 P Q R :
{{ P }} c1 {{ Q }} ->
{{ Q }} c2 {{ R }} ->
{{ P }} Seq c1 c2 {{ R }}.
Proof.
unfold hpct. intros. inversion H2 ; subst ; clear H2. eauto.
Qed.
(** The assignment rule is a little funny. This one is a so-called
"backwards" rule. The way to see this is that if we want to
run [Assign x a] and end up in a state satisfying [P], then we
should start in some state [s] such that if we update [s] at [x]
with [a]'s value, then [P] holds on the resulting state. *)
Lemma hpct_assign P x a :
{{ fun s => P (update x (aeval a s) s) }}
Assign x a
{{ P }}.
Proof.
unfold hpct. intros. inversion H0. subst. auto.
Qed.
(** Personally, I find the forwards version of this rule a little
easier to reason about. It says when we start in a state [s1]
satisfying [P], then we end up in a state [s2] such that
[s2 = update x (aeval a s1) s1] -- that's literally the semantics
of the command. *)
Lemma hpct_assign2 P x a :
{{ P }}
Assign x a
{{ fun s => exists s', P s' /\ s = update x (aeval a s') s' }}.
Proof.
unfold hpct. intros. exists s1. inversion H0. auto.
Qed.
(** Here is one possible rule for reasoning about conditionals.
However, it's not as strong as we can get because it doesn't
take the boolean expression [b] into account. That is, this
is a path-insensitive sort of reasoning rule. *)
Lemma hpct_if_weak b c1 c2 P Q :
{{ P }} c1 {{ Q }} ->
{{ P }} c2 {{ Q }} ->
{{ P }} If b c1 c2 {{ Q }}.
Proof.
unfold hpct. intros. inversion H2 ; subst ; firstorder.
Qed.
(** In contract, this rule is path-sensitive. Notice that each
branch gets to take advantage of the fact that the value of
the boolean is known. *)
Lemma hpct_if b c1 c2 P Q :
{{ fun s => beval b s = true /\ P s }} c1 {{ Q }} ->
{{ fun s => beval b s = false /\ P s }} c2 {{ Q }} ->
{{ P }} If b c1 c2 {{ Q }}.
Proof.
unfold hpct. intros. inversion H2 ; subst ; firstorder.
Qed.
(** The [While] rule requires us to find some invariant [I] such
that [I] holds at the beginning of the loop, and is maintained
each time we execute the body of the loop. Afterwards, we can
conclude [I] still holds, but that the boolean condition is false.
Think about both the case where [b] evaluates to false (in which
case, no state change occurs, so whatever the pre-condition is, it
must hold for the post-condition too.) The really hard part of
any proof using the Hoare rules is coming up with an appropriate
loop invariant... (In fact, the rest can be completely automated!)
*)
Lemma hpct_while b c I :
{{ fun s => beval b s = true /\ I s }} c {{ I }} ->
{{ I }} While b c {{ fun s => beval b s = false /\ I s }}.
Proof.
unfold hpct. intros. remember (While b c) as c0.
induction H1 ; try congruence. injection Heqc0 ; intros ; subst ; tauto.
injection Heqc0. intros ; subst ; clear Heqc0. apply IHceval2.
eapply H. split ; eauto. auto. auto.
Qed.
(** The rule of consequence is the only rule that's not syntax-
directed. It basically says that we can always strengthen
the pre-condition, and weaken the post-condition. It's crucial
for real reasoning, but figuring out when and where to apply it
can be tricky when doing proofs by hand. *)
Lemma hpct_consequence c (P1 Q1 P2 Q2:sprop) :
{{ P1 }} c {{ Q1 }} ->
(forall s, P2 s -> P1 s) ->
(forall s, Q1 s -> Q2 s) ->
{{ P2 }} c {{ Q2 }}.
Proof.
unfold hpct. intros. firstorder.
Qed.
(** This rule is a specialization of consequence that allows us
to strengthen the pre-condition. *)
Lemma hpct_pre (P1 P2 Q:sprop) c :
(forall s, P2 s -> P1 s) ->
{{ P1 }} c {{ Q }} ->
{{ P2 }} c {{ Q }}.
Proof.
intros. apply (@hpct_consequence c P1 Q P2 Q) ; auto.
Qed.
(** And this one allows us to weaken the post-condition. *)
Lemma hpct_post (Q1 P Q2:sprop) c :
(forall s, Q1 s -> Q2 s) ->
{{ P }} c {{ Q1 }} ->
{{ P }} c {{ Q2 }}.
Proof.
intros. apply (@hpct_consequence c P Q1 P Q2) ; auto.
Qed.
(** Now let's use the rules to try to prove that our factorial
command is correct. *)
Definition fact_com :=
Seq (Assign "x" (ANum 1))
(While (Lte (ANum 1) (AVar "n"))
(Seq (Assign "x" (AMult (AVar "x") (AVar "n")))
(Assign "n" (AMinus (AVar "n") (ANum 1))))).
(** To begin with, we need some notion of correctness! So we'll
write a functional version of factorial to use in our specification.
In some sense, verification is a sort of n-version programming,
so if I screw up this definition and the imperative code in the
same way, we could end up successfully proving nonsense... *)
Fixpoint fact(n:nat) : nat :=
match n with
| 0 => 1
| S n => (S n) * (fact n)
end.
(** The [omega] tactic is useful for solving some arithmetic problems.
We're going to need this in our reasoning below. *)
Require Import Omega.
(** Okay, here is our main lemma: It says that if we start in a state where
the variable [n] is equal to the value [m] and run [fact_com], then we
end up in a state where the variable [x] is equal to [fact m]. *)
Lemma fact_corr m : {{ fun s => s "n" = m }} fact_com {{ fun s => s "x" = fact m }}.
Proof.
(** Annoyingly, we will need this... *)
Lemma minus_zero n : n - 0 = n.
omega.
Qed.
(** Another helper lemma. *)
Lemma beval_lte s b : beval (Lte (ANum 1) (AVar "n")) s = b ->
if b then 1 <= s "n" else 1 > s "n".
Proof.
intros.
assert (beval (Lte (ANum 1) (AVar "n")) s = if le_gt_dec 1 (s "n") then true else false).
auto. rewrite H in H0. rewrite H0. destruct (le_gt_dec 1 (s "n")) ; auto.
Qed.
(** A useful fact about factorial. Notice that it only holds when [n > 0]. *)
Lemma fact_unroll n : n > 0 -> n * fact (n - 1) = fact n.
Proof.
induction n ; simpl ; intros. assert False ; [ omega | contradiction ].
rewrite minus_zero. auto.
Qed.
(** A little tactic which breaks apart conjunctions and existentials in
our hypotheses, and simplifies evaluation of our boolean loop guard. *)
Ltac des :=
match goal with
| [ H : _ /\ _ |- _ ] => destruct H
| [ H : exists _, _ |- _] => destruct H
| [ H : beval (Lte (ANum 1) (AVar "n")) ?s = ?b |- _ ] =>
generalize (beval_lte s H) ; clear H ; intro H
end.
(** unfold the definition of [fact_com] *)
unfold fact_com.
(** strengthen the pre-condition by adding "1 = 1" -- why? See below. *)
apply (hpct_pre (P1 := fun s => s "n" = m /\ 1 = 1)) ; auto.
(** use the [hpct_seq] rule to reason about the two commands at the top-level. *)
apply (hpct_seq (Q := fun s => s "n" = m /\ s "x" = 1)).
(** to use the [hpct_assign] rule, we must find an appropriate [P]. Notice that
if you substitute [1] for the variable [x], then you get back our pre-condition. *)
apply (@hpct_assign (fun s => s "n" = m /\ s "x" = 1) "x" (ANum 1)).
(** Once again, strengthen the pre-condition. This time, we're trying to set up a loop
invariant. I've chosen a loop invariant that asserts there's some [i], less than [m]
such that the current value of [n] is [m-i], and [x * (fact (m - i)) = fact m]. It
took me a while to figure out the right invariant so that (a) it really was an
invariant, and (b) it was strong enough to prove our desired post-condition -- that
[x] holds [fact m] when the our condition evaluates to false. *)
apply (hpct_pre (P1 := fun s => exists i, i <= m /\ s "n" = m - i /\ s "x" * fact (m - i) = fact m)).
(** Discharge the strengthening argument. *)
intros. exists 0. des. rewrite H. rewrite H0. rewrite minus_zero. omega.
(** Weaken the post-condition -- it's basically our loop invariant plus the fact that
our loop condition evaluated to false. *)
apply (hpct_post (Q1 := fun s => beval (Lte (ANum 1) (AVar "n")) s = false /\
exists i, i <= m /\ s "n" = m - i /\ s "x" * fact (m - i) = fact m)).
(** Discharge the weakening argument. *)
intros. repeat des. assert (m - x = 0). omega. rewrite H3 in H2. simpl in H2. omega.
(** Now we are set up with an invariant and can use the [hpct_while] rule. *)
apply hpct_while.
(** Here, I'm using [eapply hpct_seq] so that Coq will put in a constraint variable for
the unknown predicate describing the intermediate state. *)
eapply hpct_seq.
(** By using the "forwards" assignment rule, I can get Coq to solve for the unknown predicate. *)
eapply hpct_assign2.
(** I'm going to use the forwards assignment rule again. But I will need to weaken the post-
condition. So again, I use [eapply] to "guess" the right post-condition. *)
eapply hpct_post.
(** Now I'm going to jump to the second goal and use the forwards assignment rule to
constrain the predicate automatically. *)
Focus 2.
eapply hpct_assign2.
(** So we are left showing this beast, which is a pure logical statement not involving
commands, is true. We'll start by simplifying things, and tearing them apart... *)
intros. destruct H. repeat des. subst.
(** We have to determine the new [i] for the next iteration of the loop. A good guess is
[1 + i] or [S i] (the successor of i.) *)
exists (S x1).
(** Do some simplifying and rewriting. *)
simpl. unfold lookup, update. simpl. rewrite H3.
(** Omega can knock off the first two conjuncts for us... *)
split. omega. split. omega. rewrite <- H4.
(** Sadly, it's too stupid to prove this fact for us, so we have to jump through some hoops. *)
assert ((m - x1) * fact ((m - x1) - 1) = fact (m - x1)).
(** Our unrolling lemma for [fact] comes into play here. At least [omega] can knock off the
requirement that [m - x1 > 0]. *)
rewrite fact_unroll ; auto ; omega. rewrite <- H0.
(** Omega is still too stupid to prove this. Grr. *)
assert (m - S x1 = m - x1 - 1). omega.
rewrite H1.
(** And believe it or not, it's still too stupid! *)
rewrite <- mult_assoc.
(** Finally. Bottom line -- Coq needs better arithmetic support! To be fair, if we used
Z (integers) the proof would be easier. The "funky" definition of subtraction on [nat]
messes a lot of reasoning up, making the tactics rather conservative. *)
auto.
Qed.
(** Exercises:
- Prove that [{{ P }} c {{ fun s => True }}] holds for any command [c] and pre-condition [P].
- Prove that [{{ False }} c {{ Q }}] holds for any command [c] and post-condition [Q].
- Prove [{{ True }} While (Bool true) Skip {{ fun s => False }}].
- Add a "do" loop to commands and formulate an appropriate Hoare rule for it.
- Write a command to sum the numbers from 0 to n and use the Hoare rules to prove it correct.
*)