# Library hoare

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
| Eq : aexp -> aexp -> bexp
| Lte : aexp -> aexp -> bexp
| And : bexp -> bexp -> bexp
| Or : bexp -> bexp -> bexp.
Inductive com : Type :=
| Skip : com
| Assign : var -> aexp -> com
| Seq : com -> com -> com
| If : bexp -> com -> com -> com
| While : bexp -> com -> com.
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 states
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.