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

(* Specifications: *)
(** 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.
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.
Lemma Zneq_bool_true: forall x y, Zneq_bool x y=true -> x<>y.
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)) =}.