
theory Imp

(* identifiers *)

type ident

lemma ident_eq_dec : forall i1 i2:ident. i1=i2 \/ i1 <> i2

function mk_ident int : ident

axiom mk_ident_inj: forall i j:int. mk_ident i = mk_ident j -> i=j

(* expressions *)

type operator = Oplus | Ominus | Omult

type expr =
  | Econst int
  | Evar ident
  | Ebin expr operator expr

(* statements *)

type stmt =
  | Sskip
  | Sassign ident expr
  | Sseq stmt stmt
  | Sif expr stmt stmt
  | Swhile expr stmt

lemma check_skip:
  forall s:stmt. s=Sskip \/ s<>Sskip

(* program states *)

use map.Map as IdMap
use int.Int

type state = IdMap.map ident int

(* semantics of expressions *)

function eval_bin (x:int) (op:operator) (y:int) : int =
  match op with
    | Oplus -> x+y
    | Ominus -> x-y
    | Omult -> x*y
  end

function eval_expr (s:state) (e:expr) : int =
  match e with
    | Econst n -> n
    | Evar x -> IdMap.get s x
    | Ebin e1 op e2 ->
       eval_bin (eval_expr s e1) op (eval_expr s e2)
  end

  use map.Const

  goal Test13 :
    let s = Const.const 0 in
    eval_expr s (Econst 13) = 13

  goal Test42 :
    let x = mk_ident 0 in
    let s = IdMap.set (Const.const 0) x 42 in
    eval_expr s (Evar x) = 42

  goal Test55 :
    let x = mk_ident 0 in
    let s = IdMap.set (Const.const 0) x 42 in
    eval_expr s (Ebin (Evar x) Oplus (Econst 13)) = 55


(* small-steps semantics for statements *)

inductive one_step state stmt state stmt =

  | one_step_assign:
      forall s:state, x:ident, e:expr.
        one_step s (Sassign x e)
                 (IdMap.set s x (eval_expr s e)) Sskip

  | one_step_seq:
      forall s s':state, i1 i1' i2:stmt.
        one_step s i1 s' i1' ->
          one_step s (Sseq i1 i2) s' (Sseq i1' i2)

  | one_step_seq_skip:
      forall s:state, i:stmt.
        one_step s (Sseq Sskip i) s i

  | one_step_if_true:
      forall s:state, e:expr, i1 i2:stmt.
        eval_expr s e <> 0 ->
          one_step s (Sif e i1 i2) s i1

  | one_step_if_false:
      forall s:state, e:expr, i1 i2:stmt.
        eval_expr s e = 0 ->
          one_step s (Sif e i1 i2) s i2

  | one_step_while_true:
      forall s:state, e:expr, i:stmt.
        eval_expr s e <> 0 ->
          one_step s (Swhile e i) s (Sseq i (Swhile e i))

  | one_step_while_false:
      forall s:state, e:expr, i:stmt.
        eval_expr s e = 0 ->
          one_step s (Swhile e i) s Sskip

  goal Ass42 :
    let x = mk_ident 0 in
    let s = Const.const 0 in
    forall s':state.
      one_step s (Sassign x (Econst 42)) s' Sskip ->
        IdMap.get s' x = 42

  goal If42 :
    let x = mk_ident 0 in
    let s = Const.const 0 in
    forall s1 s2:state, i:stmt.
      one_step s
        (Sif (Evar x)
             (Sassign x (Econst 13))
             (Sassign x (Econst 42)))
        s1 i ->
      one_step s1 i s2 Sskip ->
        IdMap.get s2 x = 42

  lemma progress:
    forall s:state, i:stmt.
      i <> Sskip ->
      exists s':state, i':stmt. one_step s i s' i'


 (* many steps of execution *)

 inductive many_steps state stmt state stmt int =
   | many_steps_refl:
     forall s:state, i:stmt. many_steps s i s i 0
   | many_steps_trans:
     forall s1 s2 s3:state, i1 i2 i3:stmt, n:int.
       one_step s1 i1 s2 i2 ->
       many_steps s2 i2 s3 i3 n ->
       many_steps s1 i1 s3 i3 (n+1)

lemma steps_non_neg:
  forall s1 s2:state, i1 i2:stmt, n:int.
    many_steps s1 i1 s2 i2 n -> n >= 0

lemma many_steps_seq:
  forall s1 s3:state, i1 i2:stmt, n:int.
    many_steps s1 (Sseq i1 i2) s3 Sskip n ->
    exists s2:state, n1 n2:int.
      many_steps s1 i1 s2 Sskip n1 /\
      many_steps s2 i2 s3 Sskip n2 /\
      n = 1 + n1 + n2


(* formulas *)

type fmla =
  | Fterm expr
  | Fand fmla fmla
  | Fnot fmla
  | Fimplies fmla fmla

predicate eval_fmla (s:state) (f:fmla) =
  match f with
  | Fterm e -> eval_expr s e <> 0
  | Fand f1 f2 ->  eval_fmla s f1 /\ eval_fmla s f2
  | Fnot f ->  not (eval_fmla s f)
  | Fimplies f1 f2 ->  eval_fmla s f1 -> eval_fmla s f2
  end

(* substitution *)

function subst_expr (e:expr) (x:ident) (t:expr) : expr =
  match e with
  | Econst _ -> e
  | Evar y -> if x=y then t else e
  | Ebin e1 op e2 -> Ebin (subst_expr e1 x t) op (subst_expr e2 x t)
  end

lemma eval_subst_expr:
  forall s:state, e [@induction]:expr, x:ident, t:expr.
    eval_expr s (subst_expr e x t) =
      eval_expr (IdMap.set s x (eval_expr s t)) e

function subst (f:fmla) (x:ident) (t:expr) : fmla =
  match f with
  | Fterm e -> Fterm (subst_expr e x t)
  | Fand f1 f2 -> Fand (subst f1 x t) (subst f2 x t)
  | Fnot f -> Fnot (subst f x t)
  | Fimplies f1 f2 -> Fimplies (subst f1 x t) (subst f2 x t)
  end

lemma eval_subst:
  forall s:state, f:fmla, x:ident, t:expr.
    eval_fmla s (subst f x t) <-> eval_fmla (IdMap.set s x (eval_expr s t)) f

predicate valid_fmla (p:fmla) = forall s:state. eval_fmla s p

(* Hoare triples *)

predicate valid_triple (p:fmla) (i:stmt) (q:fmla) =
    forall s:state. eval_fmla s p ->
      forall s':state, n:int. many_steps s i s' Sskip n ->
        eval_fmla s' q

(* Hoare logic rules *)

lemma skip_rule:
  forall q:fmla. valid_triple q Sskip q

lemma assign_rule:
  forall q:fmla, x:ident, e:expr.
  valid_triple (subst q x e) (Sassign x e) q

lemma seq_rule:
  forall p q r:fmla, i1 i2:stmt.
  valid_triple p i1 r /\ valid_triple r i2 q ->
  valid_triple p (Sseq i1 i2) q

lemma if_rule:
  forall e:expr, p q:fmla, i1 i2:stmt.
  valid_triple (Fand p (Fterm e)) i1 q /\
  valid_triple (Fand p (Fnot (Fterm e))) i2 q ->
  valid_triple p (Sif e i1 i2) q

lemma while_rule:
  forall e:expr, inv:fmla, i:stmt.
  valid_triple (Fand (Fterm e) inv) i inv ->
  valid_triple inv (Swhile e i) (Fand (Fnot (Fterm e)) inv)

lemma consequence_rule:
  forall p p' q q':fmla, i:stmt.
  valid_fmla (Fimplies p' p) ->
  valid_triple p i q ->
  valid_fmla (Fimplies q q') ->
  valid_triple p' i q'

end



(*
Local Variables:
compile-command: "why3ide imp_n.why"
End:
*)
