(* Define the safey policy we use to build up the hoare tuple *)
Definition immed_safe (pu:program_unit) (st:state) :=
  fst (fst st) = knil \/
  exists st', step' pu st st'.Fixpoint stepn (pu:program_unit) (n:nat) (st1 st2:state) {struct n} : Prop :=
  match n with
  | 0 => st1 = st2
  | S n' => exists st', step' pu st1 st' /\ stepn pu n' st' st2
  end.Program Definition safen (pu:program_unit) (k:ctl) : pred world :=
  fun w => forall n', n' <= fst w ->
    forall st', stepn pu n' ((k,fst (snd w)),snd (snd w)) st' -> immed_safe pu st'.(* Lift a predicate on worlds to a pred on nats.  Then
   'lift P' is true when P holds in all locals and memories.
*)
Program Definition lift (P:pred world) : pred nat :=
  fun n => forall rho m, P (n,(rho,m)).(* Expression evaluation.  Note this is not a tight formula.
   We will almost always use && rather than * to combine eval
   in to a larger formula.
*)
Program Definition eval (e:expr) (v:val) : pred world :=
  fun w => e (fst (snd w)) = Some v.Definition locpred := locals -> Prop.Definition mempred := mem -> Prop.(* Local i has value v *)
Definition hasval (i:ident) (v:val) : locpred :=
  fun rho =>
    LocalsMap.map_val i rho = Some v /\
    LocalsMap.map_share i rho = Share.top /\
    forall i', i <> i' -> LocalsMap.map_val i' rho = None.Definition anylocals : locpred :=
  fun rho => True.(* Address a has value v with share sh. *)
Definition mapsto (a:addr) (sh:Share.t) (v:val) : mempred :=
  fun m =>
    MemMap.map_val a m = Some v /\
    MemMap.map_share a m = sh /\
    forall a', a <> a' -> MemMap.map_val a' m  = None.(* Here we have coercions that turn flat predicates on locals
   or memories into hereditary predicates on worlds.
 *)
Program Definition lift_loc (P:locpred) : pred world :=
  fun x => P (fst (snd x)) /\ identity (snd (snd x)).Program Definition lift_mem (P:mempred) : pred world :=
  fun x => P (snd (snd x)) /\ identity (fst (snd x)).(* "unlifting" operation which requires empty locals and memories *)
Program Definition lift_nat (P:pred nat) : pred world :=
  fun x => P (fst x) /\ identity (fst (snd x)) /\ identity (snd (snd x)).(* We vefify programs by defining function specifications in the usual
   way, by defining pre and postconditions for each function.  We
   use an additional type 'fs_A' to allow information sharing between
   the pre and post.  At call sites, the verifier chooses some appropriate
   element of 'fs_A'.  To allow the pre and post to reasonably hold
   in the contexts of both the caller and the callee, they must not
   judge local variables directly, but rather take direct arguments
   representing the function actual arguments and return value.
 *)
Inductive fun_spec : Type :=
  { fs_A : Type
  ; fs_pre : fs_A -> list val -> pred world
  ; fs_post : fs_A -> val -> pred world
  ; fs_pre_empty_locals :
      forall a vs w, fs_pre a vs w -> identity (fst (snd w))
  ; fs_post_empty_locals :
      forall a v w, fs_post a v w -> identity (fst (snd w))
  }.(* We vefify programs by defining function specifications in the usual
   way, by defining pre and postconditions for each function.  We
   use an additional type 'fs_A' to allow information sharing between
   the pre and post.  At call sites, the verifier chooses some appropriate
   element of 'fs_A'.  To allow the pre and post to reasonably hold
   in the contexts of both the caller and the callee, they must not
   judge local variables directly, but rather take direct arguments
   representing the function actual arguments and return value.
 *)
Inductive fun_spec : Type :=
  { fs_A : Type
  ; fs_pre : fs_A -> list val -> pred world
  ; fs_post : fs_A -> val -> pred world
  ; fs_pre_empty_locals :
      forall a vs w, fs_pre a vs w -> identity (fst (snd w))
  ; fs_post_empty_locals :
      forall a v w, fs_post a v w -> identity (fst (snd w))
  }.(* We vefify programs by defining function specifications in the usual
   way, by defining pre and postconditions for each function.  We
   use an additional type 'fs_A' to allow information sharing between
   the pre and post.  At call sites, the verifier chooses some appropriate
   element of 'fs_A'.  To allow the pre and post to reasonably hold
   in the contexts of both the caller and the callee, they must not
   judge local variables directly, but rather take direct arguments
   representing the function actual arguments and return value.
 *)
Inductive fun_spec : Type :=
  { fs_A : Type
  ; fs_pre : fs_A -> list val -> pred world
  ; fs_post : fs_A -> val -> pred world
  ; fs_pre_empty_locals :
      forall a vs w, fs_pre a vs w -> identity (fst (snd w))
  ; fs_post_empty_locals :
      forall a v w, fs_post a v w -> identity (fst (snd w))
  }.(* We vefify programs by defining function specifications in the usual
   way, by defining pre and postconditions for each function.  We
   use an additional type 'fs_A' to allow information sharing between
   the pre and post.  At call sites, the verifier chooses some appropriate
   element of 'fs_A'.  To allow the pre and post to reasonably hold
   in the contexts of both the caller and the callee, they must not
   judge local variables directly, but rather take direct arguments
   representing the function actual arguments and return value.
 *)
Inductive fun_spec : Type :=
  { fs_A : Type
  ; fs_pre : fs_A -> list val -> pred world
  ; fs_post : fs_A -> val -> pred world
  ; fs_pre_empty_locals :
      forall a vs w, fs_pre a vs w -> identity (fst (snd w))
  ; fs_post_empty_locals :
      forall a v w, fs_post a v w -> identity (fst (snd w))
  }.(* We vefify programs by defining function specifications in the usual
   way, by defining pre and postconditions for each function.  We
   use an additional type 'fs_A' to allow information sharing between
   the pre and post.  At call sites, the verifier chooses some appropriate
   element of 'fs_A'.  To allow the pre and post to reasonably hold
   in the contexts of both the caller and the callee, they must not
   judge local variables directly, but rather take direct arguments
   representing the function actual arguments and return value.
 *)
Inductive fun_spec : Type :=
  { fs_A : Type
  ; fs_pre : fs_A -> list val -> pred world
  ; fs_post : fs_A -> val -> pred world
  ; fs_pre_empty_locals :
      forall a vs w, fs_pre a vs w -> identity (fst (snd w))
  ; fs_post_empty_locals :
      forall a v w, fs_post a v w -> identity (fst (snd w))
  }.(* We vefify programs by defining function specifications in the usual
   way, by defining pre and postconditions for each function.  We
   use an additional type 'fs_A' to allow information sharing between
   the pre and post.  At call sites, the verifier chooses some appropriate
   element of 'fs_A'.  To allow the pre and post to reasonably hold
   in the contexts of both the caller and the callee, they must not
   judge local variables directly, but rather take direct arguments
   representing the function actual arguments and return value.
 *)
Inductive fun_spec : Type :=
  { fs_A : Type
  ; fs_pre : fs_A -> list val -> pred world
  ; fs_post : fs_A -> val -> pred world
  ; fs_pre_empty_locals :
      forall a vs w, fs_pre a vs w -> identity (fst (snd w))
  ; fs_post_empty_locals :
      forall a v w, fs_post a v w -> identity (fst (snd w))
  }.(* A program spec defines specifications for some subset of the
   function identifiers.
*)
Definition prog_spec := ident -> option fun_spec.(* Given a function declaration and a list of actual arguments, this
   function constructs a formula in SL which describes the initial
   local variable environment of a function.
*)
Definition func_start_locals (fd:fun_decl) (vs:list val) : pred world :=
  let xs := combine (fnd_formals fd) vs ++ (fnd_locals fd) in
    fold_right (fun iv P => hasval (fst iv) (snd iv) * P) emp xs.(* The return postcondition for verifying function bodies.  *)
Definition func_post (fs:fun_spec) (a:fs_A fs) : val -> pred world :=
  fun v => fs_post fs a v * anylocals.(* Simultaneous evaluation of a list of expressions *)
Fixpoint list_eval (es:list expr) (vs:list val) : pred world :=
  match es, vs with
  | e::es', v::vs' => eval e v && list_eval es' vs'
  | nil, nil => TT
  | _, _ => FF
  end.

Lemma hoare_straight : forall pu R c P Q n, (forall k rho m F n', n' <= n -> proj1_sig (P * F) (n',(rho,m)) -> exists rho', exists m', step pu k rho m c k rho' m' /\ proj1_sig (Q * F) (n',(rho',m'))) -> hoare_ pu R P c Q n.