(** 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).(** 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).(** 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.(** I consider only two binary operators [PLUS] and [MINUS]. Their
meaning is given by [eval_binOP] below *)
Inductive binOP: Type := PLUS | MINUS.(** 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.(** I consider only three comparison operators [EQ], [NEQ] and
[LE]. Their meaning is given by [eval_relOP] below *)
Inductive relOP: Type := EQ | NEQ | LE.(** I consider only three comparison operators [EQ], [NEQ] and
[LE]. Their meaning is given by [eval_relOP] below *)
Inductive relOP: Type := EQ | NEQ | LE.(** 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).(** 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).(** 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).(** 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).(** 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.(** * Instantiation of the Hoare logic on this langage. *)
Module HL :=  HoareLogic(Example).(** ** 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: *)
Lemma Zgcd_minus: forall a b d:Z, Zis_gcd a (b - a) d -> Zis_gcd a b d.
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.