(*+ Reasoning about oracular safety *)
(* In this file, we use the same notion as safety as in the rest of VST and we define oracular specifications (specifications that can reason about the oracle) to simulate, in term of safety, the bad/good oracle rules, through the WITH variable (x, below).  Because those are too complicated to reason about in the program logic, we also define "clean" specifications (that require nothing about the oracle).  Because the "dirty" specifications are only using the oracle in a "optimist" way, oracular safety is actually easier to prove, which can be stated through the theorem "clean safety => dirty safety". (which one should read as "safety for oracular-aware specifications" is less strong than regular safety) *)
Definition val := nat.
Variable C' : Set.
Inductive C : Set :=
| acquire : val -> C -> C
| release : val -> C -> C
| normal : C' -> C.
Definition M := val -> option nat.
Variable corestep : C' -> M -> C' -> M -> Prop.
Variable islock : val -> (M -> Prop) -> M -> Prop.
Variable islock_inj : forall v R1 R2 m, islock v R1 m -> islock v R2 m -> R1 = R2.
Definition Z := list M.
Record ext : Type := mkext {
ext_type : Type;
Pre : ext_type -> Z -> M -> Prop;
Post : ext_type -> Z -> M -> Prop
}.
Definition good_oracle (Ω : list M) (R : M -> Prop) := exists m Ω', Ω = cons m Ω' /\ R m.
Definition good_oracle_old (Ω : list M) (m : M) (v : val) :=
exists R, islock v R m /\ exists mlock Ω', Ω = cons mlock Ω' /\ R mlock.
Definition tail {A} (l : list A) := match l with nil => None | cons _ l => Some l end.
(*+ "Oracular" specifications of acquire/release *)
Definition acquire_spec_old l : ext :=
mkext
(Prop * val * list M * (M -> Prop))
(fun x Ω m =>
match x with
| (okx, lx, Ωx, Rx) =>
lx = l /\
islock l Rx m /\
(match Ω with
| nil => ~okx
| cons mlock Ω' => Ω' = Ωx /\ (Rx mlock <-> okx)
end)
end)
(fun x Ω m =>
match x with
| (okx, lx, Ωx, Rx) =>
Ω = Ωx /\
okx /\
islock lx Rx m
end).
Definition acquire_spec l : ext :=
mkext
(val * list M * (M -> Prop))
(fun x Ω m =>
match x with
| (lx, Ωx, Rx) =>
lx = l /\
islock l Rx m /\
Ω = Ωx
end)
(fun x Ω m =>
match x with
| (lx, Ωx, Rx) =>
(match Ωx with
| nil => False
| cons phi Ωx' => Ω = Ωx' /\ Rx phi
end) /\
islock lx Rx m
end).
Definition release_spec l : ext :=
mkext
(val * list M * (M -> Prop))
(fun x Ω m =>
match x with
| (lx, Ωx, Rx) =>
lx = l /\
islock l Rx m /\
Ω = Ωx
end)
(fun x Ω m =>
match x with
| (lock, Ωx, Rx) =>
Ω = Ωx /\
islock lock Rx m
end).
(*+ Definition of safety *)
Definition oracle_at_ext_old : C -> option ext :=
fun c =>
match c with
| acquire l _ => Some (acquire_spec_old l)
| release l _ => Some (release_spec l)
| _ => None
end.
Definition oracle_at_ext : C -> option ext :=
fun c =>
match c with
| acquire l _ => Some (acquire_spec l)
| release l _ => Some (release_spec l)
| _ => None
end.
Definition after_external : C -> option C :=
fun c =>
match c with
| acquire _ k => Some k
| release _ k => Some k
| _ => None
end.
Variable Hrel : nat -> M -> M -> Prop.
Variable Hrel_islock : forall n m m' R v, Hrel n m m' -> islock v R m -> islock v R m'.
Inductive safeN_ (at_ext : C -> option ext) : nat -> Z -> C -> M -> Prop :=
safeN_0 : forall (z : Z) (c : C) (m : M), safeN_ at_ext 0 z c m
| safeN_step : forall (n : nat) (z : Z) (c c' : C') (m m' : M),
corestep c m c' m' ->
safeN_ at_ext n z (normal c') m' ->
safeN_ at_ext (S n) z (normal c) m
| safeN_external : forall (n : nat) (z : Z) (c : C) (m : M) (e : ext) (x : ext_type e),
at_ext c = Some e ->
Pre e x z m ->
(forall (m' : M) (z' : Z) (n' : nat),
n' <= n ->
Hrel n' m m' ->
Post e x z' m' ->
exists c' : C,
after_external c = Some c' /\
safeN_ at_ext n' z' c' m') ->
safeN_ at_ext (S n) z c m.

(* Specifications: *)
Lemma safeN_S at_ext n z c m : safeN_ at_ext (S n) z c m -> safeN_ at_ext n z c m.
(*+ New way of writing specs *)
Lemma strong_nat_ind (P : nat -> Prop) (IH : forall n, (forall i, i < n -> P i) -> P n) n : P n.
Theorem old_new n Ω c m :
safeN_ oracle_at_ext_old  n Ω c m ->
safeN_ oracle_at_ext n Ω c m.
Theorem new_old n Ω c m :
safeN_ oracle_at_ext  n Ω c m ->
safeN_ oracle_at_ext_old n Ω c m.