# 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.

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.

| 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

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.

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.

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.

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.

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.

{{ 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.

{{ 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.

{{ 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.

{{ 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.

{{ 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.

{{ 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.

{{ 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.

(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.

(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))))).

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...

The omega tactic is useful for solving some arithmetic problems.
We're going to need this in our reasoning below.

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.

Annoyingly, we will need this...

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.

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.

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.

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.

use the hpct_seq rule to reason about the two commands at the top-level.

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.

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.

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)).

exists i, i <= m /\ s "n" = m - i /\ s "x" * fact (m - i) = fact m)).

Discharge the weakening argument.

Now we are set up with an invariant and can use the hpct_while rule.

Here, I'm using eapply hpct_seq so that Coq will put in a constraint variable for
the unknown predicate describing the intermediate state.

By using the "forwards" assignment rule, I can get Coq to solve for the unknown predicate.

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.

Now I'm going to jump to the second goal and use the forwards assignment rule to
constrain the predicate automatically.

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.)

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.

Our unrolling lemma for fact comes into play here. At least omega can knock off the
requirement that m - x1 > 0.

Omega is still too stupid to prove this. Grr.

And believe it or not, it's still too stupid!

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.

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.