(*+ 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.Inductive C : Set :=
  | acquire : val -> C -> C
  | release : val -> C -> C
  | normal : C' -> C.Inductive C : Set :=
  | acquire : val -> C -> C
  | release : val -> C -> C
  | normal : C' -> C.Inductive C : Set :=
  | acquire : val -> C -> C
  | release : val -> C -> C
  | normal : C' -> C.Inductive C : Set :=
  | acquire : val -> C -> C
  | release : val -> C -> C
  | normal : C' -> C.Definition M := val -> option nat.Definition Z := list M.Record ext : Type := mkext {
    ext_type : Type;
    Pre : ext_type -> Z -> M -> Prop;
    Post : ext_type -> Z -> M -> Prop
  }.Record ext : Type := mkext {
    ext_type : Type;
    Pre : ext_type -> Z -> M -> Prop;
    Post : ext_type -> Z -> M -> Prop
  }.Record ext : Type := mkext {
    ext_type : Type;
    Pre : ext_type -> Z -> M -> Prop;
    Post : ext_type -> Z -> M -> Prop
  }.Record ext : Type := mkext {
    ext_type : Type;
    Pre : ext_type -> Z -> M -> Prop;
    Post : ext_type -> Z -> M -> Prop
  }.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.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.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.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.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.

Lemma safeN_oracle_step_ n m l k R mlock : islock l R m -> R mlock -> (forall Ω, safeN_ oracle_at_ext_old (S n) Ω (acquire l k) m) -> forall m', Hrel n m m' -> (forall Ω, safeN_ oracle_at_ext_old n Ω k m').