(* 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.

(* Specifications: *)
Lemma make_locals_func_start_locals : forall fd vs n m, identity m -> func_start_locals fd vs (n,(make_locals vs fd,m)).
Lemma defined_update : forall i P n rho m v, (defined i * P)%pred (n,(rho,m)) -> exists rho', LocalsMap.map_upd i v rho = Some rho' /\ (hasval i v * P)%pred (n,(rho',m)).
Lemma mapsto_val : forall a sh v P n rho m, (mapsto a sh v * P )%pred(n,(rho,m)) -> MemMap.map_val a m = Some v.
Lemma mapsto_update : forall a v v' P n rho m, (mapsto a Share.top v * P)%pred (n,(rho,m)) -> exists m', MemMap.map_upd a v' m = Some m' /\ (mapsto a Share.top v' * P)%pred (n,(rho,m')).
Lemma rguards_unwind : forall pu R F k1 k2 w1 w2, unwind_return k1 = unwind_return k2 -> necR w1 w2 -> rguards pu R F k1 w1 -> rguards pu R F k2 w2.
Lemma list_eval_join_sub : forall es vs w1 w2, join_sub w1 w2 -> list_eval es vs w1 -> list_eval es vs w2.
Lemma list_eval_evaluate_exprs : forall es vs w, list_eval es vs w -> evaluate_exprs (fst (snd w)) es vs.
Lemma validate_finished : forall ps pu, validate ps pu ps -> forall n, satisfies_spec pu ps n.
Lemma validate_empty : forall pu ps, validate pu ps (fun _ => None).
Lemma validate_correct : forall pu ps n i f fs rho m args vals a, satisfies_spec pu ps n -> ps f = Some fs -> evaluate_exprs rho args vals -> (fs_pre fs a vals * TT)%pred (n,(rho,m)) -> LocalsMap.map_share i rho = Share.top -> safen pu (kseq (call i f args) knil) (n,(rho,m)).
Lemma hoare_ex : forall ps R A (P:A->pred world) c Q, hoare_ ps R (exp P) c Q = (All x:A, hoare_ ps R (P x) c Q).
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.
Lemma hoare_frame : forall pu R c P Q F n, hoare_ pu R P c Q n -> hoare_ pu (fun v => R v * F) (P * F) c (Q * F) n.
Lemma hoare_skip : forall ps R Q n, hoare_ ps R Q skip Q n.
Lemma hoare_ret : forall ps R e Q n, hoare_ ps R (EX v:val, eval e v && R v) (ret e) Q n.
Lemma hoare_seq : forall ps R P1 c1 P2 c2 P3 n, hoare_ ps R P1 c1 P2 n -> hoare_ ps R P2 c2 P3 n -> hoare_ ps R P1 (seq c1 c2) P3 n.