(** * The very classical example of GCD computation in Hoare logic.

 This file is part of the "Tutorial on Hoare Logic". 
 For an introduction to this Coq library, 
 see README #or <a href=index.html>index.html</a>#.

 This file illustrates how to use the Hoare logic described in file
 #<a href="hoarelogicsemantics.html">#[hoarelogicsemantics]#</a>#


 I use here the very classical example of "great common divisor"
 computations through successive subtractions.
*)

Set Implicit Arguments.

Require Import ZArith.
Require Import Znumtheory.
Require Import Bool.
Require Import hoarelogic.
Require Import Zwf.
Require Import Wellfounded.

(** * Implementation of the expression language *)
Module Example <: ExprLang.

(** Here, I use only two global variables [VX] and [VY] of type [Z]
(binary integers). *)
Inductive ExVar: Type -> Type := 
  VX: (ExVar Z) | 
  VY: (ExVar Z). 

Definition Var:=ExVar.

(** An environment is just a pair of integers. First component
represents [VX] and second component represents [VY].  This is
expressed in [upd] and [get] below. *)
Definition Env:= (Z*Z)%type.

Definition upd (A:Type): (ExVar A) -> A -> Env -> Env :=
 fun x => 
   match x in (ExVar A) return A -> Env -> Env with
   | VX => fun vx e => (vx,snd e)
   | VY => fun vy e => (fst e,vy)
   end.

Definition get (A:Type): (ExVar A) -> Env -> A :=
 fun x => 
   match x in (ExVar A) return Env -> A with
   | VX => fun e => fst e
   | VY => fun e => snd e
   end.

(** I consider only two binary operators [PLUS] and [MINUS]. Their
meaning is given by [eval_binOP] below *)
Inductive binOP: Type := PLUS | MINUS.
 
Definition eval_binOP: binOP -> Z -> Z -> Z :=
 fun op => match op with
  | PLUS => Zplus
  | MINUS => Zminus
 end.

(** I consider only three comparison operators [EQ], [NEQ] and
[LE]. Their meaning is given by [eval_relOP] below *)
Inductive relOP: Type := EQ | NEQ | LE.

Definition eval_relOP: relOP -> Z -> Z -> bool :=
 fun op => match op with
  | EQ => Zeq_bool
  | NEQ => Zneq_bool
  | LE => Zle_bool
 end. 

(** Here is the abstract syntax of expressions. The semantics is given
by [eval] below *)
Inductive ExExpr: Type -> Type :=
 | const: forall (A:Type), A -> (ExExpr A)
 | binop: binOP -> (ExExpr Z) -> (ExExpr Z) -> (ExExpr Z)
 | relop: relOP -> (ExExpr Z) -> (ExExpr Z) -> (ExExpr bool)
 | getvar: forall (A:Type), (ExVar A) -> (ExExpr A). 

Definition Expr:= ExExpr.

Fixpoint eval (A:Type) (expr:Expr A) (e:Env) { struct expr } : A :=
 match expr in ExExpr A return A with
 | const A v => v
 | binop op e1 e2 => eval_binOP op (eval e1 e) (eval e2 e)
 | relop op e1 e2 => eval_relOP op (eval e1 e) (eval e2 e)
 | getvar A x => (get x e)
end.

End Example.

(** * Instantiation of the Hoare logic on this langage. *)
Module HL :=  HoareLogic(Example).
Import HL.
Import Example.

(** These coercions makes the abstract syntax more user-friendly *)
Coercion getvar: ExVar >-> ExExpr.
Coercion binop: binOP >-> Funclass.
Coercion relop: relOP >-> Funclass.

(** A last coercion useful for assertions *)
Coercion get: ExVar >-> Funclass.

(** ** A [gcd] computation in this language *)
Definition gcd := 
  (Iwhile (NEQ VX VY)
          (Iif (LE VX VY)
               (Iset VY (MINUS VY VX))
               (Iset VX (MINUS VX VY)))).

(** A small technical lemma on the mathematical notion of gcd (called
[Zis_gcd]) *)
Lemma Zgcd_minus: forall a b d:Z, Zis_gcd a (b - a) d -> Zis_gcd a b d.
Proof.
(* Goal: forall (a b d : Z) (_ : Zis_gcd a (Z.sub b a) d), Zis_gcd a b d *)
  intros a b d H; case H; constructor; intuition (auto with zarith).
(* Goal: Z.divide d b *)
  replace b with (b-a+a)%Z.
(* Goal: Z.divide d (Z.add (Z.sub b a) a) *)
(* Goal: @eq Z (Z.add (Z.sub b a) a) b *)
  auto with zarith.
(* Goal: @eq Z (Z.add (Z.sub b a) a) b *)
  omega.
Qed.

Hint Resolve Zgcd_minus: zarith.

(** Two other lemmas relating [Zneq_bool] function with inequality
relation *)
Lemma Zneq_bool_false: forall x y, Zneq_bool x y=false -> x=y.
Proof.
(* Goal: forall (x y : Z) (_ : @eq bool (Zneq_bool x y) false), @eq Z x y *)
 intros x y H0; apply Zcompare_Eq_eq; generalize H0; clear H0; unfold Zneq_bool. case (x ?= y)%Z; auto; 
 try (intros; discriminate); auto. 
Qed.

Lemma Zneq_bool_true: forall x y, Zneq_bool x y=true -> x<>y.
Proof.
(* Goal: forall (x y : Z) (_ : @eq bool (Zneq_bool x y) true), not (@eq Z x y) *)
 intros x y; unfold Zneq_bool.
(* Goal: forall _ : @eq bool match Z.compare x y with | Eq => false | Lt => true | Gt => true end true, not (@eq Z x y) *)
 intros H H0; subst.
(* Goal: False *)
 rewrite Zcompare_refl in H.
(* Goal: False *)
 discriminate.
Qed.

Hint Resolve Zneq_bool_true Zneq_bool_false Zle_bool_imp_le Zis_gcd_intro: zarith.

(** ** Partial correctness proof of [gcd] *)
Lemma gcd_partial_proof: 
 forall x0 y0, (fun e => (VX e)=x0 /\ (VY e)=y0) 
   |= gcd  {= fun e => (Zis_gcd x0 y0 (VX e)) =}.
Proof.
(* Goal: forall (x0 y0 : Z) (e : Env) (_ : (fun e0 : Env => and (@eq Z (@get Z VX e0) x0) (and (@eq Z (@get Z VY e0) y0) (and (Z.gt x0 Z0) (Z.gt y0 Z0)))) e), wp gcd (fun e0 : E.Env => Zis_gcd x0 y0 (@get Z VX e0)) e *)
 intros x0 y0. 
(* Goal: forall (e : E.Env) (_ : (fun _ : E.Env => True) e), wlp enum_3N (fun _ : E.Env => False) e *)
 apply PHL.soundness.
(* Goal: forall (e : E.Env) (_ : True), PHL.synt_wp enum_3N (fun _ : E.Env => False) e *)
 simpl.
(* Goal: forall (e : E.Env) (_ : and (@eq Z (@fst Z Z e) x0) (and (@eq Z (@snd Z Z e) y0) (and (Z.gt x0 Z0) (Z.gt y0 Z0)))), @ex Pred (fun inv : Pred => @ex (forall (_ : E.Env) (_ : E.Env), Prop) (fun R : forall (_ : E.Env) (_ : E.Env), Prop => and (@well_founded E.Env R) (and (inv e) (and (forall (e' : E.Env) (_ : inv e') (_ : @eq bool (Zneq_bool (@fst Z Z e') (@snd Z Z e')) false), Zis_gcd x0 y0 (@fst Z Z e')) (and (forall (e' : E.Env) (_ : inv e') (_ : @eq bool (Zneq_bool (@fst Z Z e') (@snd Z Z e')) true), and (forall _ : @eq bool (Z.leb (@fst Z Z e') (@snd Z Z e')) true, inv (@pair Z Z (@fst Z Z e') (Z.sub (@snd Z Z e') (@fst Z Z e')))) (forall _ : @eq bool (Z.leb (@fst Z Z e') (@snd Z Z e')) false, inv (@pair Z Z (Z.sub (@fst Z Z e') (@snd Z Z e')) (@snd Z Z e')))) (forall (e0 : E.Env) (_ : inv e0) (_ : @eq bool (Zneq_bool (@fst Z Z e0) (@snd Z Z e0)) true), and (forall _ : @eq bool (Z.leb (@fst Z Z e0) (@snd Z Z e0)) true, R (@pair Z Z (@fst Z Z e0) (Z.sub (@snd Z Z e0) (@fst Z Z e0))) e0) (forall _ : @eq bool (Z.leb (@fst Z Z e0) (@snd Z Z e0)) false, R (@pair Z Z (Z.sub (@fst Z Z e0) (@snd Z Z e0)) (@snd Z Z e0)) e0))))))) *)
 intros e; intuition subst.
 (** after PO generation, I provide the invariant and simplify the goal *) 
 constructor 1 with (x:=fun e'=> 
  forall d, (Zis_gcd (VX e') (VY e') d)
(* Goal: forall (e : E.Env) (_ : True), PHL.synt_wp enum_3N (fun _ : E.Env => False) e *)
              ->(Zis_gcd (VX e) (VY e) d)); simpl.
(* Goal: Z.divide d (Z.add (Z.sub b a) a) *)
(* Goal: @eq Z (Z.add (Z.sub b a) a) b *)
 intuition auto with zarith.
 (** - invariant => postcondition *)
(* Goal: Z.divide d (Z.add (Z.sub b a) a) *)
(* Goal: @eq Z (Z.add (Z.sub b a) a) b *)
 cutrewrite <- ((fst e')=(snd e')) in H; auto with zarith.
Qed.


(** ** Total correctness proof of [gcd] *)

Lemma gcd_total_proof: 
 forall x0 y0, (fun e => (VX e)=x0 /\ (VY e)=y0 /\ x0 > 0 /\ y0 > 0)
  |= gcd  [= fun e => (Zis_gcd x0 y0 (VX e)) =].
Proof.
(* Goal: forall (x0 y0 : Z) (e : Env) (_ : (fun e0 : Env => and (@eq Z (@get Z VX e0) x0) (and (@eq Z (@get Z VY e0) y0) (and (Z.gt x0 Z0) (Z.gt y0 Z0)))) e), wp gcd (fun e0 : E.Env => Zis_gcd x0 y0 (@get Z VX e0)) e *)
 intros x0 y0. 
(* Goal: forall (e : Env) (_ : (fun e0 : Env => and (@eq Z (@get Z VX e0) x0) (and (@eq Z (@get Z VY e0) y0) (and (Z.gt x0 Z0) (Z.gt y0 Z0)))) e), wp gcd (fun e0 : E.Env => Zis_gcd x0 y0 (@get Z VX e0)) e *)
 apply THL.soundness.
(* Goal: forall (e : E.Env) (_ : True), PHL.synt_wp enum_3N (fun _ : E.Env => False) e *)
 simpl.
(* Goal: forall (e : E.Env) (_ : and (@eq Z (@fst Z Z e) x0) (and (@eq Z (@snd Z Z e) y0) (and (Z.gt x0 Z0) (Z.gt y0 Z0)))), @ex Pred (fun inv : Pred => @ex (forall (_ : E.Env) (_ : E.Env), Prop) (fun R : forall (_ : E.Env) (_ : E.Env), Prop => and (@well_founded E.Env R) (and (inv e) (and (forall (e' : E.Env) (_ : inv e') (_ : @eq bool (Zneq_bool (@fst Z Z e') (@snd Z Z e')) false), Zis_gcd x0 y0 (@fst Z Z e')) (and (forall (e' : E.Env) (_ : inv e') (_ : @eq bool (Zneq_bool (@fst Z Z e') (@snd Z Z e')) true), and (forall _ : @eq bool (Z.leb (@fst Z Z e') (@snd Z Z e')) true, inv (@pair Z Z (@fst Z Z e') (Z.sub (@snd Z Z e') (@fst Z Z e')))) (forall _ : @eq bool (Z.leb (@fst Z Z e') (@snd Z Z e')) false, inv (@pair Z Z (Z.sub (@fst Z Z e') (@snd Z Z e')) (@snd Z Z e')))) (forall (e0 : E.Env) (_ : inv e0) (_ : @eq bool (Zneq_bool (@fst Z Z e0) (@snd Z Z e0)) true), and (forall _ : @eq bool (Z.leb (@fst Z Z e0) (@snd Z Z e0)) true, R (@pair Z Z (@fst Z Z e0) (Z.sub (@snd Z Z e0) (@fst Z Z e0))) e0) (forall _ : @eq bool (Z.leb (@fst Z Z e0) (@snd Z Z e0)) false, R (@pair Z Z (Z.sub (@fst Z Z e0) (@snd Z Z e0)) (@snd Z Z e0)) e0))))))) *)
 intros e; intuition subst.
 (** after simplification, I provide the invariant and then the variant *) 
 constructor 1 with (x:=fun e' => (VX e') > 0 /\ (VY e') > 0 /\
  forall d, (Zis_gcd (VX e') (VY e') d)
(* Goal: forall (e : E.Env) (_ : True), PHL.synt_wp enum_3N (fun _ : E.Env => False) e *)
              ->(Zis_gcd (VX e) (VY e) d)); simpl.
(* Goal: @ex (forall (_ : E.Env) (_ : E.Env), Prop) (fun R : forall (_ : E.Env) (_ : E.Env), Prop => and (@well_founded E.Env R) (and (and (Z.gt (@fst Z Z e) Z0) (and (Z.gt (@snd Z Z e) Z0) (forall (d : Z) (_ : Zis_gcd (@fst Z Z e) (@snd Z Z e) d), Zis_gcd (@fst Z Z e) (@snd Z Z e) d))) (and (forall (e' : E.Env) (_ : and (Z.gt (@fst Z Z e') Z0) (and (Z.gt (@snd Z Z e') Z0) (forall (d : Z) (_ : Zis_gcd (@fst Z Z e') (@snd Z Z e') d), Zis_gcd (@fst Z Z e) (@snd Z Z e) d))) (_ : @eq bool (Zneq_bool (@fst Z Z e') (@snd Z Z e')) false), Zis_gcd (@fst Z Z e) (@snd Z Z e) (@fst Z Z e')) (and (forall (e' : E.Env) (_ : and (Z.gt (@fst Z Z e') Z0) (and (Z.gt (@snd Z Z e') Z0) (forall (d : Z) (_ : Zis_gcd (@fst Z Z e') (@snd Z Z e') d), Zis_gcd (@fst Z Z e) (@snd Z Z e) d))) (_ : @eq bool (Zneq_bool (@fst Z Z e') (@snd Z Z e')) true), and (forall _ : @eq bool (Z.leb (@fst Z Z e') (@snd Z Z e')) true, and (Z.gt (@fst Z Z e') Z0) (and (Z.gt (Z.sub (@snd Z Z e') (@fst Z Z e')) Z0) (forall (d : Z) (_ : Zis_gcd (@fst Z Z e') (Z.sub (@snd Z Z e') (@fst Z Z e')) d), Zis_gcd (@fst Z Z e) (@snd Z Z e) d))) (forall _ : @eq bool (Z.leb (@fst Z Z e') (@snd Z Z e')) false, and (Z.gt (Z.sub (@fst Z Z e') (@snd Z Z e')) Z0) (and (Z.gt (@snd Z Z e') Z0) (forall (d : Z) (_ : Zis_gcd (Z.sub (@fst Z Z e') (@snd Z Z e')) (@snd Z Z e') d), Zis_gcd (@fst Z Z e) (@snd Z Z e) d)))) (forall (e0 : E.Env) (_ : and (Z.gt (@fst Z Z e0) Z0) (and (Z.gt (@snd Z Z e0) Z0) (forall (d : Z) (_ : Zis_gcd (@fst Z Z e0) (@snd Z Z e0) d), Zis_gcd (@fst Z Z e) (@snd Z Z e) d))) (_ : @eq bool (Zneq_bool (@fst Z Z e0) (@snd Z Z e0)) true), and (forall _ : @eq bool (Z.leb (@fst Z Z e0) (@snd Z Z e0)) true, R (@pair Z Z (@fst Z Z e0) (Z.sub (@snd Z Z e0) (@fst Z Z e0))) e0) (forall _ : @eq bool (Z.leb (@fst Z Z e0) (@snd Z Z e0)) false, R (@pair Z Z (Z.sub (@fst Z Z e0) (@snd Z Z e0)) (@snd Z Z e0)) e0)))))) *)
 constructor 1 with (x:=fun e1 e0 => Zwf 0 ((VX e1)+(VY e1)) ((VX e0)+(VY e0))).
 (** - proof that my variant is a well_founded relation *) 
(* Goal: and (@well_founded E.Env (fun e1 e0 : Env => Zwf Z0 (Z.add (@get Z VX e1) (@get Z VY e1)) (Z.add (@get Z VX e0) (@get Z VY e0)))) (and (and (Z.gt (@fst Z Z e) Z0) (and (Z.gt (@snd Z Z e) Z0) (forall (d : Z) (_ : Zis_gcd (@fst Z Z e) (@snd Z Z e) d), Zis_gcd (@fst Z Z e) (@snd Z Z e) d))) (and (forall (e' : E.Env) (_ : and (Z.gt (@fst Z Z e') Z0) (and (Z.gt (@snd Z Z e') Z0) (forall (d : Z) (_ : Zis_gcd (@fst Z Z e') (@snd Z Z e') d), Zis_gcd (@fst Z Z e) (@snd Z Z e) d))) (_ : @eq bool (Zneq_bool (@fst Z Z e') (@snd Z Z e')) false), Zis_gcd (@fst Z Z e) (@snd Z Z e) (@fst Z Z e')) (and (forall (e' : E.Env) (_ : and (Z.gt (@fst Z Z e') Z0) (and (Z.gt (@snd Z Z e') Z0) (forall (d : Z) (_ : Zis_gcd (@fst Z Z e') (@snd Z Z e') d), Zis_gcd (@fst Z Z e) (@snd Z Z e) d))) (_ : @eq bool (Zneq_bool (@fst Z Z e') (@snd Z Z e')) true), and (forall _ : @eq bool (Z.leb (@fst Z Z e') (@snd Z Z e')) true, and (Z.gt (@fst Z Z e') Z0) (and (Z.gt (Z.sub (@snd Z Z e') (@fst Z Z e')) Z0) (forall (d : Z) (_ : Zis_gcd (@fst Z Z e') (Z.sub (@snd Z Z e') (@fst Z Z e')) d), Zis_gcd (@fst Z Z e) (@snd Z Z e) d))) (forall _ : @eq bool (Z.leb (@fst Z Z e') (@snd Z Z e')) false, and (Z.gt (Z.sub (@fst Z Z e') (@snd Z Z e')) Z0) (and (Z.gt (@snd Z Z e') Z0) (forall (d : Z) (_ : Zis_gcd (Z.sub (@fst Z Z e') (@snd Z Z e')) (@snd Z Z e') d), Zis_gcd (@fst Z Z e) (@snd Z Z e) d)))) (forall (e0 : E.Env) (_ : and (Z.gt (@fst Z Z e0) Z0) (and (Z.gt (@snd Z Z e0) Z0) (forall (d : Z) (_ : Zis_gcd (@fst Z Z e0) (@snd Z Z e0) d), Zis_gcd (@fst Z Z e) (@snd Z Z e) d))) (_ : @eq bool (Zneq_bool (@fst Z Z e0) (@snd Z Z e0)) true), and (forall _ : @eq bool (Z.leb (@fst Z Z e0) (@snd Z Z e0)) true, Zwf Z0 (Z.add (@get Z VX (@pair Z Z (@fst Z Z e0) (Z.sub (@snd Z Z e0) (@fst Z Z e0)))) (@get Z VY (@pair Z Z (@fst Z Z e0) (Z.sub (@snd Z Z e0) (@fst Z Z e0))))) (Z.add (@get Z VX e0) (@get Z VY e0))) (forall _ : @eq bool (Z.leb (@fst Z Z e0) (@snd Z Z e0)) false, Zwf Z0 (Z.add (@get Z VX (@pair Z Z (Z.sub (@fst Z Z e0) (@snd Z Z e0)) (@snd Z Z e0))) (@get Z VY (@pair Z Z (Z.sub (@fst Z Z e0) (@snd Z Z e0)) (@snd Z Z e0)))) (Z.add (@get Z VX e0) (@get Z VY e0))))))) *)
 constructor 1.
(* Goal: @well_founded E.Env (fun e1 e0 : Env => Zwf Z0 (Z.add (@get Z VX e1) (@get Z VY e1)) (Z.add (@get Z VX e0) (@get Z VY e0))) *)
(* Goal: and (and (Z.gt (@fst Z Z e) Z0) (and (Z.gt (@snd Z Z e) Z0) (forall (d : Z) (_ : Zis_gcd (@fst Z Z e) (@snd Z Z e) d), Zis_gcd (@fst Z Z e) (@snd Z Z e) d))) (and (forall (e' : E.Env) (_ : and (Z.gt (@fst Z Z e') Z0) (and (Z.gt (@snd Z Z e') Z0) (forall (d : Z) (_ : Zis_gcd (@fst Z Z e') (@snd Z Z e') d), Zis_gcd (@fst Z Z e) (@snd Z Z e) d))) (_ : @eq bool (Zneq_bool (@fst Z Z e') (@snd Z Z e')) false), Zis_gcd (@fst Z Z e) (@snd Z Z e) (@fst Z Z e')) (and (forall (e' : E.Env) (_ : and (Z.gt (@fst Z Z e') Z0) (and (Z.gt (@snd Z Z e') Z0) (forall (d : Z) (_ : Zis_gcd (@fst Z Z e') (@snd Z Z e') d), Zis_gcd (@fst Z Z e) (@snd Z Z e) d))) (_ : @eq bool (Zneq_bool (@fst Z Z e') (@snd Z Z e')) true), and (forall _ : @eq bool (Z.leb (@fst Z Z e') (@snd Z Z e')) true, and (Z.gt (@fst Z Z e') Z0) (and (Z.gt (Z.sub (@snd Z Z e') (@fst Z Z e')) Z0) (forall (d : Z) (_ : Zis_gcd (@fst Z Z e') (Z.sub (@snd Z Z e') (@fst Z Z e')) d), Zis_gcd (@fst Z Z e) (@snd Z Z e) d))) (forall _ : @eq bool (Z.leb (@fst Z Z e') (@snd Z Z e')) false, and (Z.gt (Z.sub (@fst Z Z e') (@snd Z Z e')) Z0) (and (Z.gt (@snd Z Z e') Z0) (forall (d : Z) (_ : Zis_gcd (Z.sub (@fst Z Z e') (@snd Z Z e')) (@snd Z Z e') d), Zis_gcd (@fst Z Z e) (@snd Z Z e) d)))) (forall (e0 : E.Env) (_ : and (Z.gt (@fst Z Z e0) Z0) (and (Z.gt (@snd Z Z e0) Z0) (forall (d : Z) (_ : Zis_gcd (@fst Z Z e0) (@snd Z Z e0) d), Zis_gcd (@fst Z Z e) (@snd Z Z e) d))) (_ : @eq bool (Zneq_bool (@fst Z Z e0) (@snd Z Z e0)) true), and (forall _ : @eq bool (Z.leb (@fst Z Z e0) (@snd Z Z e0)) true, Zwf Z0 (Z.add (@get Z VX (@pair Z Z (@fst Z Z e0) (Z.sub (@snd Z Z e0) (@fst Z Z e0)))) (@get Z VY (@pair Z Z (@fst Z Z e0) (Z.sub (@snd Z Z e0) (@fst Z Z e0))))) (Z.add (@get Z VX e0) (@get Z VY e0))) (forall _ : @eq bool (Z.leb (@fst Z Z e0) (@snd Z Z e0)) false, Zwf Z0 (Z.add (@get Z VX (@pair Z Z (Z.sub (@fst Z Z e0) (@snd Z Z e0)) (@snd Z Z e0))) (@get Z VY (@pair Z Z (Z.sub (@fst Z Z e0) (@snd Z Z e0)) (@snd Z Z e0)))) (Z.add (@get Z VX e0) (@get Z VY e0)))))) *)
 apply wf_inverse_image with (f:=fun e=>(VX e)+(VY e)).
(* Goal: @well_founded Z (Zwf Z0) *)
(* Goal: and (and (Z.gt (@fst Z Z e) Z0) (and (Z.gt (@snd Z Z e) Z0) (forall (d : Z) (_ : Zis_gcd (@fst Z Z e) (@snd Z Z e) d), Zis_gcd (@fst Z Z e) (@snd Z Z e) d))) (and (forall (e' : E.Env) (_ : and (Z.gt (@fst Z Z e') Z0) (and (Z.gt (@snd Z Z e') Z0) (forall (d : Z) (_ : Zis_gcd (@fst Z Z e') (@snd Z Z e') d), Zis_gcd (@fst Z Z e) (@snd Z Z e) d))) (_ : @eq bool (Zneq_bool (@fst Z Z e') (@snd Z Z e')) false), Zis_gcd (@fst Z Z e) (@snd Z Z e) (@fst Z Z e')) (and (forall (e' : E.Env) (_ : and (Z.gt (@fst Z Z e') Z0) (and (Z.gt (@snd Z Z e') Z0) (forall (d : Z) (_ : Zis_gcd (@fst Z Z e') (@snd Z Z e') d), Zis_gcd (@fst Z Z e) (@snd Z Z e) d))) (_ : @eq bool (Zneq_bool (@fst Z Z e') (@snd Z Z e')) true), and (forall _ : @eq bool (Z.leb (@fst Z Z e') (@snd Z Z e')) true, and (Z.gt (@fst Z Z e') Z0) (and (Z.gt (Z.sub (@snd Z Z e') (@fst Z Z e')) Z0) (forall (d : Z) (_ : Zis_gcd (@fst Z Z e') (Z.sub (@snd Z Z e') (@fst Z Z e')) d), Zis_gcd (@fst Z Z e) (@snd Z Z e) d))) (forall _ : @eq bool (Z.leb (@fst Z Z e') (@snd Z Z e')) false, and (Z.gt (Z.sub (@fst Z Z e') (@snd Z Z e')) Z0) (and (Z.gt (@snd Z Z e') Z0) (forall (d : Z) (_ : Zis_gcd (Z.sub (@fst Z Z e') (@snd Z Z e')) (@snd Z Z e') d), Zis_gcd (@fst Z Z e) (@snd Z Z e) d)))) (forall (e0 : E.Env) (_ : and (Z.gt (@fst Z Z e0) Z0) (and (Z.gt (@snd Z Z e0) Z0) (forall (d : Z) (_ : Zis_gcd (@fst Z Z e0) (@snd Z Z e0) d), Zis_gcd (@fst Z Z e) (@snd Z Z e) d))) (_ : @eq bool (Zneq_bool (@fst Z Z e0) (@snd Z Z e0)) true), and (forall _ : @eq bool (Z.leb (@fst Z Z e0) (@snd Z Z e0)) true, Zwf Z0 (Z.add (@get Z VX (@pair Z Z (@fst Z Z e0) (Z.sub (@snd Z Z e0) (@fst Z Z e0)))) (@get Z VY (@pair Z Z (@fst Z Z e0) (Z.sub (@snd Z Z e0) (@fst Z Z e0))))) (Z.add (@get Z VX e0) (@get Z VY e0))) (forall _ : @eq bool (Z.leb (@fst Z Z e0) (@snd Z Z e0)) false, Zwf Z0 (Z.add (@get Z VX (@pair Z Z (Z.sub (@fst Z Z e0) (@snd Z Z e0)) (@snd Z Z e0))) (@get Z VY (@pair Z Z (Z.sub (@fst Z Z e0) (@snd Z Z e0)) (@snd Z Z e0)))) (Z.add (@get Z VX e0) (@get Z VY e0)))))) *)
 auto with datatypes.
 (** - other goals *)
(* Goal: and (and (Z.gt (@fst Z Z e) Z0) (and (Z.gt (@snd Z Z e) Z0) (forall (d : Z) (_ : Zis_gcd (@fst Z Z e) (@snd Z Z e) d), Zis_gcd (@fst Z Z e) (@snd Z Z e) d))) (and (forall (e' : E.Env) (_ : and (Z.gt (@fst Z Z e') Z0) (and (Z.gt (@snd Z Z e') Z0) (forall (d : Z) (_ : Zis_gcd (@fst Z Z e') (@snd Z Z e') d), Zis_gcd (@fst Z Z e) (@snd Z Z e) d))) (_ : @eq bool (Zneq_bool (@fst Z Z e') (@snd Z Z e')) false), Zis_gcd (@fst Z Z e) (@snd Z Z e) (@fst Z Z e')) (and (forall (e' : E.Env) (_ : and (Z.gt (@fst Z Z e') Z0) (and (Z.gt (@snd Z Z e') Z0) (forall (d : Z) (_ : Zis_gcd (@fst Z Z e') (@snd Z Z e') d), Zis_gcd (@fst Z Z e) (@snd Z Z e) d))) (_ : @eq bool (Zneq_bool (@fst Z Z e') (@snd Z Z e')) true), and (forall _ : @eq bool (Z.leb (@fst Z Z e') (@snd Z Z e')) true, and (Z.gt (@fst Z Z e') Z0) (and (Z.gt (Z.sub (@snd Z Z e') (@fst Z Z e')) Z0) (forall (d : Z) (_ : Zis_gcd (@fst Z Z e') (Z.sub (@snd Z Z e') (@fst Z Z e')) d), Zis_gcd (@fst Z Z e) (@snd Z Z e) d))) (forall _ : @eq bool (Z.leb (@fst Z Z e') (@snd Z Z e')) false, and (Z.gt (Z.sub (@fst Z Z e') (@snd Z Z e')) Z0) (and (Z.gt (@snd Z Z e') Z0) (forall (d : Z) (_ : Zis_gcd (Z.sub (@fst Z Z e') (@snd Z Z e')) (@snd Z Z e') d), Zis_gcd (@fst Z Z e) (@snd Z Z e) d)))) (forall (e0 : E.Env) (_ : and (Z.gt (@fst Z Z e0) Z0) (and (Z.gt (@snd Z Z e0) Z0) (forall (d : Z) (_ : Zis_gcd (@fst Z Z e0) (@snd Z Z e0) d), Zis_gcd (@fst Z Z e) (@snd Z Z e) d))) (_ : @eq bool (Zneq_bool (@fst Z Z e0) (@snd Z Z e0)) true), and (forall _ : @eq bool (Z.leb (@fst Z Z e0) (@snd Z Z e0)) true, Zwf Z0 (Z.add (@get Z VX (@pair Z Z (@fst Z Z e0) (Z.sub (@snd Z Z e0) (@fst Z Z e0)))) (@get Z VY (@pair Z Z (@fst Z Z e0) (Z.sub (@snd Z Z e0) (@fst Z Z e0))))) (Z.add (@get Z VX e0) (@get Z VY e0))) (forall _ : @eq bool (Z.leb (@fst Z Z e0) (@snd Z Z e0)) false, Zwf Z0 (Z.add (@get Z VX (@pair Z Z (Z.sub (@fst Z Z e0) (@snd Z Z e0)) (@snd Z Z e0))) (@get Z VY (@pair Z Z (Z.sub (@fst Z Z e0) (@snd Z Z e0)) (@snd Z Z e0)))) (Z.add (@get Z VX e0) (@get Z VY e0)))))) *)
  unfold Zwf; simpl; (intuition auto with zarith).
 (** -- invariant => postcondition 
      --- gcd part like in partial correctness proof 
 *)
(* Goal: Z.divide d (Z.add (Z.sub b a) a) *)
(* Goal: @eq Z (Z.add (Z.sub b a) a) b *)
  cutrewrite <- ((fst e')=(snd e')) in H5; auto with zarith.
  (** --- new VY in branch "then" is positive *)
(* Goal: Z.divide d (Z.add (Z.sub b a) a) *)
(* Goal: @eq Z (Z.add (Z.sub b a) a) b *)
  cut ((fst e')<=(snd e')); auto with zarith.
(* Goal: Z.divide d (Z.add (Z.sub b a) a) *)
(* Goal: @eq Z (Z.add (Z.sub b a) a) b *)
  cut ((fst e')<>(snd e')); auto with zarith.
  (** --- new VX in branch "else" is positive *)
(* Goal: Z.divide d (Z.add (Z.sub b a) a) *)
(* Goal: @eq Z (Z.add (Z.sub b a) a) b *)
  cut (~(fst e')<=(snd e')); auto with zarith.
(* Goal: not (Z.le (@fst Z Z e') (@snd Z Z e')) *)
  intros X; rewrite (Zle_imp_le_bool _ _ X) in H4.
(* Goal: False *)
  discriminate.
Qed.

(** ** Another example: infinite loops in partial correctness.

Basic Hoare logic is not well-suited for reasoning about non-terminating programs.
In total correctness, postconditions of non-terminating programs are not provable.
In partial correctness, a non-terminating program satisfies any (unsatisfiable) postcondition.

For example, in an informal "meaning", the program below enumerates all multiples of 3. But this meaning 
can not be expressed here (even in partial correctness).
*)

Definition enum_3N := 
  (Iseq (Iset VX (const 0))
        (Iwhile (const true)
                (Iset VX (PLUS VX (const 3))))).

Lemma enum_3N_stupid: 
 (fun e => True) |= enum_3N  {= fun e => False =}.
Proof.
(* Goal: forall (e : E.Env) (_ : (fun _ : E.Env => True) e), wlp enum_3N (fun _ : E.Env => False) e *)
 apply PHL.soundness.
(* Goal: forall (e : E.Env) (_ : True), PHL.synt_wp enum_3N (fun _ : E.Env => False) e *)
 simpl.
(* Goal: forall (e : E.Env) (_ : True), @ex Pred (fun inv : Pred => and (inv (@pair Z Z Z0 (@snd Z Z e))) (and (forall (e' : E.Env) (_ : inv e') (_ : @eq bool true false), False) (forall (e' : E.Env) (_ : inv e') (_ : @eq bool true true), inv (@pair Z Z (Z.add (@fst Z Z e') (Zpos (xI xH))) (@snd Z Z e'))))) *)
 constructor 1 with (x:=fun _:Env => True).
(* Goal: and True (and (forall (_ : E.Env) (_ : True) (_ : @eq bool true false), False) (forall (_ : E.Env) (_ : True) (_ : @eq bool true true), True)) *)
 intuition (discriminate || auto).
Qed.


(** "Tutorial on Hoare Logic" Library. Copyright 2007 Sylvain Boulme.

This file is distributed under the terms of the 
 "GNU LESSER GENERAL PUBLIC LICENSE" version 3.  
*)
