Load loadpath. Load ssrloadpath.
Set Implicit Arguments.
Unset Strict Implicit.
Definition var := N.
Definition val := N.
Definition addr := N.
Definition label := N.
(** integer and address expressions *)
Inductive abinop : Type :=
| Aplus
| Aminus
| Amult.
Inductive aexpr : Type :=
| AEvar : var -> aexpr
| AEval : val -> aexpr
| AEbinop : abinop -> aexpr -> aexpr -> aexpr.
(** boolean expressions *)
Inductive expr : Type :=
| Etrue
| Efalse
| Eneg : expr -> expr
| Eleq : aexpr -> aexpr -> expr
| Eand : expr -> expr -> expr
| Eor : expr -> expr -> expr
| Eaddr_eq : aexpr -> aexpr -> expr.
(** commands *)
Inductive stmt : Type :=
| Sskip : stmt
| Sassume : expr -> stmt
| Sassert : expr -> stmt
| Sassign : var -> aexpr -> stmt
| Sload : var -> aexpr -> stmt
| Sstore : aexpr -> aexpr -> stmt.
(** continuations *)
Inductive cont : Type :=
| Ksafe
| Kseq : stmt -> cont -> cont
| Kifte : expr -> cont -> cont -> cont
| Kgoto : label -> cont.
(** programs *)
Definition prog := label -> option cont.
(** states *)
Definition store := var -> option val.
Definition heap := addr -> option val.
Inductive state : Type := State : store -> heap -> state.
(** executable semantics *)
Definition eval_abinop (op : abinop) :=
match op with
| Aplus => Nplus
| Aminus => Nminus
| Amult => Nmult
end.
Section eval_aexpr.
Variable (s : store).
Fixpoint eval_aexpr (ae : aexpr) : option val :=
match ae with
| AEvar x => s x
| AEval n => Some n
| AEbinop op e1 e2 =>
obnd (fun n1 => obnd (fun n2 => Some (eval_abinop op n1 n2))
(eval_aexpr e2)) (eval_aexpr e1)
end.
End eval_aexpr.
Section eval_expr.
Variables (s : store) (h : heap).
Fixpoint eval_expr (e : expr) : option bool :=
match e with
| Etrue => Some true
| Efalse => Some false
| Eneg e' => obnd (fun b => Some (negb b)) (eval_expr e')
| Eleq ie1 ie2 =>
obnd (fun n1 => obnd (fun n2 => Some (Nleb n1 n2))
(eval_aexpr s ie1)) (eval_aexpr s ie2)
| Eand e1 e2 =>
obnd (fun b1 => obnd (fun b2 => Some (andb b1 b2))
(eval_expr e1)) (eval_expr e2)
| Eor e1 e2 =>
obnd (fun b1 => obnd (fun b2 => Some (orb b1 b2))
(eval_expr e1)) (eval_expr e2)
| Eaddr_eq ae1 ae2 =>
obnd (fun a1 => obnd (fun a2 => Some (Neqb a1 a2))
(eval_aexpr s ae1)) (eval_aexpr s ae2)
end.
End eval_expr.
Definition store_upd (x : var) (v : val) (s : store) :=
fun y => if Neqb x y then Some v else s y.
Definition heap_upd (a : addr) (v : val) (h : heap) :=
fun b => if Neqb a b then Some v else h b.
Definition prog_upd (l : label) (k : cont) (P : prog) :=
fun l' => if Neqb l l' then Some k else P l'.
Definition empty (_ : var) : option val := None.
Definition empty_prog (_ : var) : option cont := None.
Definition result := option state.
Notation inl := (inl _).
Notation inr := (inr _).
(** we need the bound [n] since programs may in general not terminate *)
Fixpoint eval n (k : cont) (P : prog) (s : store) (h : heap) : result :=
match n with O => None | S n' =>
match k with
| Ksafe => Some (State s h)
| Kseq Sskip k' => eval n' k' P s h
| Kseq (Sassume e) k' =>
obnd (fun b : bool => if b then eval n' k' P s h
else Some (State s h)) (eval_expr s e)
| Kseq (Sassert e) k' =>
obnd (fun b : bool => if b then eval n' k' P s h
else None) (eval_expr s e)
| Kseq (Sassign x e) k' =>
obnd (fun v => eval n' k' P (store_upd x v s) h) (eval_aexpr s e)
| Kseq (Sload x e) k' =>
obnd (fun l => obnd (fun v => eval n' k' P (store_upd x v s) h) (h l))
(eval_aexpr s e)
| Kseq (Sstore e1 e2) k' =>
obnd (fun l => obnd (fun v => eval n' k' P s (heap_upd l v h))
(eval_aexpr s e2)) (eval_aexpr s e1)
| Kifte e k1 k2 =>
obnd (fun b : bool => if b then eval n' k1 P s h
else eval n' k2 P s h) (eval_expr s e)
| Kgoto l => obnd (fun k' => eval n' k' P s h) (P l)
end end.
Definition eval_prog n (P : prog) s h := obnd (fun k => eval n k P s h) (P 0%N).
(** interpret a simple program *)
Module T1.
Local Open Scope N_scope.
Definition x : var := 1.
Definition y : var := 2.
Definition z : var := 3.
Definition h1 : heap :=
heap_upd 4 1 (heap_upd 8 32
(heap_upd 32 2 (heap_upd 36 12
(heap_upd 12 3 (heap_upd 16 0 empty))))).
Definition P1 : prog :=
prog_upd 0
(Kseq (Sassign x (AEval 4)) (Kgoto 1)) (
prog_upd 1
(Kseq (Sload y (AEvar x))
(Kifte (Eaddr_eq (AEvar y) (AEval 0))
(Kseq (Sassert (Eaddr_eq (AEvar y) (AEval 0))) Ksafe)
(Kseq (Sassign x (AEbinop Aplus (AEvar x) (AEval 4)))
(Kgoto 1))))
empty_prog).
Compute obnd (fun st => match st with
| State s h => s y
end) (eval_prog 100 P1 empty h1).
End T1.
(** operational semantics *)
Inductive step {P : prog} : state -> cont -> state -> cont -> Prop :=
| step_Sskip : forall s k, step s (Kseq Sskip k) s k
| step_Sassume1 : forall e s h k,
eval_expr s e = Some false ->
step (State s h) (Kseq (Sassume e) k) (State s h) Ksafe
| step_Sassume2 : forall e s h k,
eval_expr s e = Some true ->
step (State s h) (Kseq (Sassume e) k) (State s h) k
| step_Sassert : forall e s h k,
eval_expr s e = Some true ->
step (State s h) (Kseq (Sassert e) k) (State s h) k
| step_Sassign : forall x e v s h k,
eval_aexpr s e = Some v ->
step (State s h) (Kseq (Sassign x e) k) (State (store_upd x v s) h) k
| step_Sload : forall x e v l s h k,
eval_aexpr s e = Some l -> h l = Some v ->
step (State s h) (Kseq (Sload x e) k) (State (store_upd x v s) h) k
| step_Sstore : forall e1 e2 v l s h k,
eval_aexpr s e2 = Some v -> eval_aexpr s e1 = Some l ->
step (State s h) (Kseq (Sstore e1 e2) k) (State s (heap_upd l v h)) k
| step_Ksafe : forall s, step s Ksafe s Ksafe
| step_Kifte1 : forall e s h k1 k2,
eval_expr s e = Some true ->
step (State s h) (Kifte e k1 k2) (State s h) k1
| step_Kifte2 : forall e s h k1 k2,
eval_expr s e = Some false ->
step (State s h) (Kifte e k1 k2) (State s h) k2
| step_Kgoto : forall l s k, P l = Some k -> step s (Kgoto l) s k.
Implicit Arguments step [].
(** general properties of step relations *)
Section step.
Variable (state cont : Type).
Variable (step : state -> cont -> state -> cont -> Prop).
Inductive star : state -> cont -> state -> cont -> Prop :=
| star_refl s k : star s k s k
| star_step s k s2 k2 s' k' :
step s k s2 k2 -> star s2 k2 s' k' -> star s k s' k'.
Inductive stepN : nat -> state -> cont -> state -> cont -> Prop :=
| stepO s k : stepN O s k s k
| stepS s k s2 k2 s' k' n :
step s k s2 k2 -> stepN n s2 k2 s' k' ->
stepN (S n) s k s' k'.

(* Specifications: *)
Lemma star_stepN s k s' k' :
star s k s' k' <-> exists n, stepN n s k s' k'.