(****************************************************************************)
(* Copyright (c) Facebook, Inc. and its affiliates.                         *)
(*                                                                          *)
(* Licensed under the Apache License, Version 2.0 (the "License");          *)
(* you may not use this file except in compliance with the License.         *)
(* You may obtain a copy of the License at                                  *)
(*                                                                          *)
(*     http://www.apache.org/licenses/LICENSE-2.0                           *)
(*                                                                          *)
(* Unless required by applicable law or agreed to in writing, software      *)
(* distributed under the License is distributed on an "AS IS" BASIS,        *)
(* WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. *)
(* See the License for the specific language governing permissions and      *)
(* limitations under the License.                                           *)
(****************************************************************************)
From mathcomp.ssreflect
Require Import ssreflect ssrbool ssrnat eqtype ssrfun seq.
From mathcomp
Require Import path.
Require Import Eqdep.
Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.

Open Scope seq_scope.
Section Prefixes.

  Variable T : eqType.

Implicit Type bc : seq T.

(* Strict version of the prefix *)
Definition is_strict_prefix bc bc':=
  exists b bc1, bc' = bc ++ (b :: bc1).

Lemma isp_mt bc : ~ is_strict_prefix bc [::].
Proof.    by case=>b[bc1]; case: bc. Qed.

(* The corresponding checker *)
Fixpoint sprefixb {T: eqType} (s1 s2 : seq T) :=
  if s2 is y :: s2' then
    if s1 is x :: s1' then (x == y) && (sprefixb s1' s2')
    else true
  else false.

Notation "'[' bc1 '<<<' bc2 ']'" := (sprefixb bc1 bc2).

Lemma sprefixP bc1 bc2:
  reflect (is_strict_prefix bc1 bc2) [bc1 <<< bc2].
Proof.
elim: bc2 bc1=>//=[|b2 bc2 Hi/=]bc1.
- case:bc1=>//=[|b1 bc1]; constructor 2=>//; apply: isp_mt.
case: bc1=>//[|b1 bc1]/=; first by constructor 1; exists b2, bc2.
case X: (b1 == b2)=>/=; last first.
- constructor 2=>[[p]][bc']; rewrite cat_cons; case=>Z; subst b2.
  by rewrite eqxx in X.
- move/eqP: X=>X; subst b2.
case: Hi=>H; [constructor 1|constructor 2].
- by case:H=>x[xs]->; exists x, xs; rewrite cat_cons.
case=>x[xs]; rewrite cat_cons; case=>Z; subst bc2; apply: H.
by exists x, xs.
Qed.

Lemma bc_spre_nrefl bc : [bc <<< bc] = false.
Proof.
by elim: bc=>[|x xs H] //=; rewrite eqxx H.
Qed.

(* Non-strict prefix *)
Fixpoint prefixb bc1 bc2 :=
  if bc2 is y :: bc2' then
    if bc1 is x :: bc1' then (x == y) && (prefixb bc1' bc2')
    else true
  else bc1 == [::].

Definition is_prefix bc bc' :=
  exists bc1, bc' = bc ++ bc1.

Notation "'[' bc1 '<<=' bc2 ']'" := (prefixb bc1 bc2).

Lemma prefixb0seq bc : [[::] <<= bc]. Proof. by case: bc. Qed.

Lemma prefixbseq0 bc: [bc <<= [::]] = (bc == [::]). Proof. by case bc. Qed.

Lemma bc_pre_refl bc : [bc <<= bc].
Proof.
by elim bc => [|x s IHs] //=; rewrite eqxx IHs.
Qed.

Lemma prefixb_belast bc1 b bc2: [bc1 <<= b :: bc2] = [bc1 <<= (belast b bc2)] || (bc1 == b :: bc2).
Proof.
move: bc1 b bc2; elim=> [b bc2|x s IH b]; first by rewrite 2!prefixb0seq.
elim; first by rewrite prefixbseq0 //= prefixbseq0 eqseq_cons.
by move => x' s' H; rewrite eqseq_cons //= (IH x' s') andb_orr.
Qed.

Lemma prefixP bc1 bc2:
  reflect (is_prefix bc1 bc2) [bc1 <<= bc2].
Proof.
move: bc2 bc1; elim => [|b2 bc2 IH/=] bc1.
- rewrite prefixbseq0 ; apply: (iffP eqP) => [->|] //=; first by exists [::].
  case => [s H]; move: (size_cat bc1 s); rewrite -{}H /=; move/eqP.
  by rewrite eq_sym addn_eq0; move /andP =>[H _]; move/nilP: H.
- move: bc1; case.
  - rewrite prefixb0seq //; apply/(iffP idP)=>//; exists (b2::bc2).
    by rewrite cat0s.
  - move => s l; apply/(iffP idP) => /= [|].
    - move/andP => [Heq]; move/(IH l) => [ss Hss]; exists ss.
      by move/eqP: Heq->; move:Hss ->; rewrite cat_cons.
    - move=> [ss]; rewrite cat_cons; move/eqP; rewrite eqseq_cons eq_sym.
      move/andP => [H H']; rewrite H /=; apply/(IH l).
      by exists ss; move/eqP: H'.
Qed.

Lemma sprefixbseq0 bc: [bc <<< [::]] = false.
Proof. by case bc =>// x s. Qed.

Lemma sprefixb0seq b bc: [[::] <<< b :: bc].
 Proof. by []. Qed.

Lemma sprefix_prefix_belast bc1 b bc2: [bc1 <<< b :: bc2] = [bc1 <<= (belast b bc2)].
Proof.
move: bc2 bc1 b ; elim=>[bc1 b |x s IH bc1 b] /=.
- rewrite prefixbseq0; case bc1 => //[b' s']/=.
  by rewrite (sprefixbseq0 s') andbF eq_sym; apply/negP.
-  case bc1 => [|b' s']; first by rewrite prefixb0seq sprefixb0seq.
   by rewrite //=; move: (IH s' x)->.
Qed.

Lemma bc_spre_trans bc1 bc2 bc3:
  [bc1 <<< bc2] -> [bc2 <<< bc3] -> [bc1 <<< bc3].
Proof.
move/sprefixP => [x][xs] ->; move/sprefixP => [x'][xs']->.
by apply/sprefixP; exists x; exists (xs ++ x' :: xs'); rewrite -catA.
Qed.

Lemma bc_spre_pre bc bc':
  [bc <<< bc'] -> [bc <<= bc'].
Proof. by move/sprefixP=>[] x [] xs=>->; apply/prefixP; exists (x :: xs). Qed.

Lemma bc_pre_spre bc bc':
  [bc <<= bc'] = [bc <<< bc'] || (bc == bc').
Proof.
case bc' => [|x' s']; first by rewrite prefixbseq0 sprefixbseq0.
by rewrite prefixb_belast sprefix_prefix_belast.
Qed.

Lemma bc_spre_irrefl bc1 bc2 :
  [bc1 <<< bc2] && [bc2  <<< bc1] = false.
Proof.
case H: [bc1 <<< bc2]=>//=; case  H': [bc2 <<< bc1] =>//=.
move: (@bc_spre_trans _ _ _ H H'); rewrite bc_spre_nrefl //.
Qed.

(* Decidable fork *)
Definition fork bc1 bc2 :=
  ~~([bc1 <<< bc2] || [bc2 <<< bc1] || (bc1 == bc2)).

Definition fork_rel bc1 bc2 :=
  ~ ((is_prefix bc1 bc2) \/ (is_prefix bc2 bc1)).

Lemma forkP bc1 bc2 :
  reflect (fork_rel bc1 bc2) (fork bc1 bc2).
Proof.
apply/introP; rewrite /fork_rel /fork.
- rewrite orbC; move/norP => [H]; move/norP => [H1 H2].
  case; move/prefixP; rewrite bc_pre_spre; apply/negPn;
  apply/norP; rewrite ?H1 ?H2 ?H; rewrite eq_sym in H; rewrite ?H=> //.
  by move/negPn; move/orP =>[|H]; first move/orP=> [H|H];
  case; [left|right|left]; apply/prefixP; rewrite bc_pre_spre H // orbC //.
Qed.

Lemma bc_fork_neq bc bc' :
  fork bc bc' -> bc != bc'.
Proof.
  move=>H; apply/negbT/negP=>Z; move/eqP:Z=>Z; subst bc'.
by move: H; rewrite /fork eqxx orbC //=.
Qed.

Inductive bc_rel bc bc' : bool-> bool-> bool-> bool-> Set :=
| CmpBcEq of bc == bc' : bc_rel bc bc' true false false false
| CmpBcFork of fork bc bc' : bc_rel bc bc' false true false false
| CmpBcPre12 of sprefixb bc bc' : bc_rel bc bc' false false true false
| CmpBcPre21 of sprefixb bc' bc: bc_rel bc bc' false false false true.

Lemma bc_relP bc bc' :
  bc_rel bc bc' (bc == bc') (fork bc bc') (sprefixb bc bc') (sprefixb bc' bc).
Proof.
case Eq: (bc == bc'); case F: (fork bc bc');
case S12: [bc <<< bc']; case S21: [bc' <<< bc];
try by [constructor|
        contradict Eq; move: (bc_fork_neq F)=>/eqP=>A B; apply A; move/eqP in B |
        contradict F; rewrite /fork Eq S12 S21 //=|
          by move: (bc_spre_irrefl bc bc'); rewrite S12 S21 //=
].
- by move/idP: S12; move/eqP: Eq=>->; rewrite bc_spre_nrefl.
- by move/idP: S21; move/eqP: Eq=>->; rewrite bc_spre_nrefl.
Qed.

End Prefixes.


Require Import Raft.
Require Import RaftRefinementInterface.

Section AllEntriesLeaderSublogInterface.
  Context {orig_base_params : BaseParams}.
  Context {one_node_params : OneNodeParams orig_base_params}.
  Context {raft_params : RaftParams orig_base_params}.

  Definition allEntries_leader_sublog (net : network) :=
    forall leader e h,
      type (snd (nwState net leader)) = Leader ->
      In e (map snd (allEntries (fst (nwState net h)))) ->
      eTerm e = currentTerm (snd (nwState net leader)) ->
      In e (log (snd (nwState net leader))).

  Class allEntries_leader_sublog_interface : Prop :=
    {
      allEntries_leader_sublog_invariant :
        forall net,
          refined_raft_intermediate_reachable net ->
          allEntries_leader_sublog net
    }.

End AllEntriesLeaderSublogInterface.


Require Import VST.floyd.base2.
Require Import VST.floyd.client_lemmas.
Local Open Scope logic.

Definition compute_funspecs_norepeat (l : list (ident*funspec)) :=
  compute_list_norepet (fst (split l)).

Lemma not_in_funspecs_by_id_i {A B} i (l : list (A * B)) l0 l1 :
  split l = (l0,l1) ->
  ~In i l0 ->
  ~In i (map fst l).
Proof.
  revert i l0 l1.
  induction l as [|[a b] l]; intros a' [|a'' la] [|b' lb] E; simpl in *;
    try destruct (split l); congruence || auto.
  injection E; intros; subst; intuition.
  eapply IHl; eauto.
Qed.

Lemma compute_funspecs_norepeat_e l :
  compute_funspecs_norepeat l = true ->
  funspecs_norepeat l.
Proof.
  intros H; hnf.
  rewrite <-semax_call.fst_split.
  apply compute_list_norepet_e, H.
Qed.


From mathcomp
Require Import ssreflect ssrbool ssrnat eqtype seq ssrfun.
From fcsl
Require Import prelude pred pcm unionmap heap.
From HTT
Require Import stmod stsep stlog stlogR.
From SSL
Require Import core.
From Hammer Require Import Hammer.
(* Configure Hammer *)
Set Hammer ATPLimit 60.
Unset Hammer Eprover.
Unset Hammer Vampire.
Add Search Blacklist "fcsl.".
Add Search Blacklist "HTT.".
Add Search Blacklist "Coq.ssr.ssrfun".
Add Search Blacklist "mathcomp.ssreflect.ssrfun".
Add Search Blacklist "mathcomp.ssreflect.bigop".
Add Search Blacklist "mathcomp.ssreflect.choice".
Add Search Blacklist "mathcomp.ssreflect.div".
Add Search Blacklist "mathcomp.ssreflect.finfun".
Add Search Blacklist "mathcomp.ssreflect.fintype".
Add Search Blacklist "mathcomp.ssreflect.path".
Add Search Blacklist "mathcomp.ssreflect.tuple".

Inductive sll (x : ptr) (s : seq nat) (h : heap) : Prop :=
| sll_1 of (x) == (null) of
  (s) == (@nil nat) /\ h = empty
| sll_2 of ~~ ((x) == (null)) of
  exists (v : nat) (s1 : seq nat) (nxt : ptr),
  exists h_sll_nxts1_0,
  (s) == (([:: v]) ++ (s1)) /\ h = x :-> (v) \+ x .+ 1 :-> (nxt) \+ h_sll_nxts1_0 /\ sll nxt s1 h_sll_nxts1_0.


(* Cyclone Semantics using TLC/LN in Coq Version 4 *)
(* "SAFE PROGRAMMING AT THE C LEVEL OF ABSTRACTION".   Daniel Grossman, August 2003 *)
(* Open/Close LN infrastructure. *)
(* Brian Milnes 2016 *)

Set Implicit Arguments.
Require Export Cyclone_Formal_Syntax LibVarPathEnv.

(* Open/Close of variables in binders. *)

(* Open a type binder in a type. *)

Fixpoint open_rec_tau  (k : nat) (t : Tau) (tau : Tau)  {struct tau}  : Tau :=
 match tau with
   | btvar i       => If k = i then t else btvar i
   | ftvar i       => ftvar i
   | cint          => cint
   | cross t0 t1   => cross (open_rec_tau k t t0) (open_rec_tau k t t1)
   | arrow t0 t1   => arrow (open_rec_tau k t t0) (open_rec_tau k t t1)
   | ptype t0      => ptype (open_rec_tau k t t0)
   | utype kp t0   => utype kp (open_rec_tau (S k) t t0)
   | etype p kp t0 => etype p kp (open_rec_tau (S k) t t0)
  end.

Definition open_tau t tau := open_rec_tau 0 t tau.

(* Notation "{ k ~> u } t" := (open_rec_tau k u t) (at level 67). *)
(* Notation "t ^^ u" := (open_tau u t) (at level 67). *)
(* Notation "t ^ x" := (open_tau x t). *)

(* Open a type binder in a term. *)

Definition open_rec_tau_term_v (k : nat) (t : Tau) (v : V)  : V :=
  match v with
    | fevar i => fevar i
    | bevar i => bevar i
  end.

Fixpoint open_rec_tau_term_st  (k : nat) (t : Tau) (s : St)  {struct s}  : St :=
 match s with
    | e_s  e        => e_s      (open_rec_tau_term_e  k t e)
    | retn e        => retn     (open_rec_tau_term_e  k t e)
    | seq s0 s1     => seq      (open_rec_tau_term_st k t s0) (open_rec_tau_term_st k t s1)
    | if_s e s1 s2  => if_s     (open_rec_tau_term_e  k t e)
                                (open_rec_tau_term_st k t s1) (open_rec_tau_term_st k t s2)
    | while e s     => while    (open_rec_tau_term_e  k t e)  (open_rec_tau_term_st k t s)
    | letx e s      => letx     (open_rec_tau_term_e  k t e)  (open_rec_tau_term_st k t s)
    | open e s      => open     (open_rec_tau_term_e  k t e)  (open_rec_tau_term_st k t s)
    | openstar e s  => openstar (open_rec_tau_term_e  k t e)  (open_rec_tau_term_st k t s)
  end
with open_rec_tau_term_e   (k : nat) (t : Tau) (e : E) {struct e}  : E :=
  match e with
    | v_e v         => v_e (open_rec_tau_term_v k t v)
    | i_e i         => i_e i
    | p_e x p       => p_e x p
    | f_e f         => f_e    (open_rec_tau_term_f  k t f)
    | amp e         => amp    (open_rec_tau_term_e  k t e)
    | star e        => star   (open_rec_tau_term_e  k t e)
    | cpair e1 e2   => cpair  (open_rec_tau_term_e  k t e1) (open_rec_tau_term_e k t e2)
    | dot  e ipe    => dot    (open_rec_tau_term_e  k t e) ipe
    | assign e1 e2  => assign (open_rec_tau_term_e  k t e1) (open_rec_tau_term_e k t e2)
    | appl e1 e2    => appl   (open_rec_tau_term_e  k t e1) (open_rec_tau_term_e k t e2)
    | call s        => call   (open_rec_tau_term_st k t s)
    | inst e t'      => inst   (open_rec_tau_term_e  k t e) (open_rec_tau k t t')
    | pack t0 e t1  => pack   (open_rec_tau k t t0) (open_rec_tau_term_e k t e) (open_rec_tau k t t1)
end
with open_rec_tau_term_f   (k : nat) (t : Tau) (f : F) {struct f} : F :=
  match f with
    | dfun tau1 tau2 s => dfun (open_rec_tau k t tau1) (open_rec_tau k t tau2)
                               (open_rec_tau_term_st k t s)
    | ufun k' f        => ufun k' (open_rec_tau_term_f k t f)
  end.

Function open_rec_tau_term  (k : nat) (t : Tau) (T : Term) : Term :=
  match T with
    | term_st s    => term_st (open_rec_tau_term_st k t s)
    | term_e  e    => term_e  (open_rec_tau_term_e  k t e)
    | term_f  f    => term_f  (open_rec_tau_term_f  k t f)
  end.

Definition open_tau_term t T := open_rec_tau_term 0 t T.

(* Notation "{ k ~tt~> u } t" := (open_rec_tau_term k u t) (at level 67). *)
(* Notation "t ^tt^ u" := (open_tau_term t u) (at level 67). *)
(* Notation "t ^tt x" := (open_tau_term x t) (at level 67). *)

(* Open a term binding in a term. *)

Function open_rec_term_v   (k : nat) (v : var) (v' : V) {struct v'} : V :=
  match v' with
    | (bevar i)   => If k = i then (fevar v) else v'
    | _           => v'
end.

Function open_rec_term_p (k : nat) (v : var) (v' : V) {struct v}  : V :=
  match v' with
  | (bevar i) => If k = i then (fevar v) else v'
  | (fevar i) => (fevar i)
end.

Fixpoint open_rec_term_st  (k : nat) (v : var) (s : St)  {struct s}  : St :=
 match s with
    | e_s  e        => e_s      (open_rec_term_e  k v e)
    | retn e        => retn     (open_rec_term_e k v e)
    | seq s0 s1     => seq      (open_rec_term_st k v s0) (open_rec_term_st k v s1)
    | if_s e s1 s2  => if_s     (open_rec_term_e k v e)
                                (open_rec_term_st k v s1) (open_rec_term_st k v s2)
    | while e s     => while    (open_rec_term_e k v e)   (open_rec_term_st k v s)
    | letx e s      => letx     (open_rec_term_e k v e)   (open_rec_term_st (S k) v s)
    | open e s      => open     (open_rec_term_e k v e)   (open_rec_term_st (S k) v s)
    | openstar e s  => openstar (open_rec_term_e k v e)   (open_rec_term_st (S k) v s)
  end
with open_rec_term_e   (k : nat) (v : var) (e : E) {struct e}  : E :=
  match e with
    | v_e v'          => v_e (open_rec_term_v k v v')
    | i_e i           => i_e i
    | p_e x p         => p_e (open_rec_term_p k v x) p
    | f_e f           => f_e    (open_rec_term_f (S k) v f)
    | amp e           => amp    (open_rec_term_e k v e)
    | star e          => star   (open_rec_term_e k v e)
    | cpair e1 e2     => cpair  (open_rec_term_e k v e1) (open_rec_term_e k v e2)
    | dot  e ipe      => dot    (open_rec_term_e k v e) ipe
    | assign e1 e2    => assign (open_rec_term_e k v e1) (open_rec_term_e k v e2)
    | appl e1 e2      => appl   (open_rec_term_e k v e1) (open_rec_term_e k v e2)
    | call s          => call   (open_rec_term_st k v s)
    | inst e t        => inst   (open_rec_term_e k v e) t
    | pack t0 e t1    => pack    t0 (open_rec_term_e k v e) t1
end
with open_rec_term_f   (k : nat) (v : var) (f : F) {struct f} : F :=
  match f with
    | dfun tau1 tau2 s => dfun tau1 tau2 (open_rec_term_st k v s)
    | ufun k' f        => ufun k' (open_rec_term_f k v f)
  end.

Function open_rec_term (k : nat) (v : var) (t : Term) {struct t} : Term :=
  match t with
    | term_st s    => term_st (open_rec_term_st k v s)
    | term_e  e    => term_e  (open_rec_term_e  k v e)
    | term_f  f    => term_f  (open_rec_term_f  k v f)
  end.

Definition open_term v t := open_rec_term 0 v t.

(* Notation "{ k ~t~> u } t" := (open_rec_term k u t) (at level 67). *)
(* Notation "t ^t^ u" := (open_term t u) (at level 67). *)
(* Notation "t ^t x" := (open_term x t) (at level 67). *)

(** Closing a type. *)

Fixpoint close_rec_tau (k : nat) (v : var) (t : Tau) : Tau :=
  match t with
    | btvar i       => t
    | ftvar x       => If x = v then (btvar k) else t
    | cint          => cint
    | cross t0 t1   => cross (close_rec_tau k v t0) (close_rec_tau k v t1)
    | arrow t0 t1   => arrow (close_rec_tau k v t0) (close_rec_tau k v t1)
    | ptype t0      => ptype (close_rec_tau k v t0)
    | utype k' t0   => utype k' (close_rec_tau (S k) v t0)
    | etype p k' t0 => etype p k' (close_rec_tau (S k) v t0)
end.

(* Closing a type variable in a term. *)

Fixpoint close_rec_tau_term_st  (k : nat) (v : var) (s : St)  {struct s}  : St :=
 match s with
    | e_s  e        => e_s      (close_rec_tau_term_e  k v e)
    | retn e        => retn     (close_rec_tau_term_e  k v e)
    | seq s0 s1     => seq      (close_rec_tau_term_st k v s0) (close_rec_tau_term_st k v s1)
    | if_s e s1 s2  => if_s     (close_rec_tau_term_e  k v e)
                                (close_rec_tau_term_st k v s1) (close_rec_tau_term_st k v s2)
    | while e s     => while    (close_rec_tau_term_e  k v e)  (close_rec_tau_term_st k v s)
    | letx e s      => letx     (close_rec_tau_term_e  k v e)  (close_rec_tau_term_st k v s)
    | open e s      => open     (close_rec_tau_term_e  k v e)  (close_rec_tau_term_st k v s)
    | openstar e s  => openstar (close_rec_tau_term_e  k v e)  (close_rec_tau_term_st k v s)
  end
with close_rec_tau_term_e   (k : nat) (v : var) (e : E) {struct e}  : E :=
  match e with
    | v_e _         => e
    | i_e i         => i_e i
    | p_e x p       => p_e x p
    | f_e f         => f_e    (close_rec_tau_term_f  k v f)
    | amp e         => amp    (close_rec_tau_term_e  k v e)
    | star e        => star   (close_rec_tau_term_e  k v e)
    | cpair e1 e2   => cpair  (close_rec_tau_term_e  k v e1) (close_rec_tau_term_e k v e2)
    | dot  e ipe    => dot    (close_rec_tau_term_e  k v e) ipe
    | assign e1 e2  => assign (close_rec_tau_term_e  k v e1) (close_rec_tau_term_e k v e2)
    | appl e1 e2    => appl   (close_rec_tau_term_e  k v e1) (close_rec_tau_term_e k v e2)
    | call s        => call   (close_rec_tau_term_st k v s)
    | inst e t      => inst   (close_rec_tau_term_e  k v e) (close_rec_tau k v t)
    | pack t0 e t1  => pack   (close_rec_tau k v t0)
                              (close_rec_tau_term_e k v e) (close_rec_tau k v t1)
end
with close_rec_tau_term_f   (k : nat) (v : var) (f : F) {struct f} : F :=
  match f with
    | dfun tau1 tau2 s => dfun (close_rec_tau k v tau1) (close_rec_tau k v tau2)
                               (close_rec_tau_term_st k v s)
    | ufun k' f        => ufun k' (close_rec_tau_term_f k v f)
  end.

Fixpoint close_rec_tau_term  (k : nat) (v : var) (t : Term)  {struct t}  : Term :=
  match t with
    | term_st s    => term_st (close_rec_tau_term_st k v s)
    | term_e  e    => term_e  (close_rec_tau_term_e  k v e)
    | term_f  f    => term_f  (close_rec_tau_term_f  k v f)
  end.

Definition close_tau_term v t := close_rec_tau_term 0 v t.

(* Closing a term on a term variable. *)

Function close_rec_term_v (k : nat) (z : var) (v : V) : V :=
  match v with
    | (bevar i) => v
    | (fevar x) => If x = z then (bevar k) else v
  end.

Fixpoint close_rec_term_st (k : nat) (z : var) (s : St) : St :=
  match s with
    | e_s  e       => e_s  (close_rec_term_e k z e)
    | retn e       => retn (close_rec_term_e k z e)
    | seq s0 s1    => seq (close_rec_term_st k z s0) (close_rec_term_st k z s1)
    | if_s e s0 s1 => if_s (close_rec_term_e k z e)
                           (close_rec_term_st k z s0)
                           (close_rec_term_st k z s1)
    | while e s0   => while (close_rec_term_e k z e) (close_rec_term_st k z s0)
    | letx e s     => letx (close_rec_term_e k z e) (close_rec_term_st (S k) z s)
    | open e s     => open (close_rec_term_e k z e) (close_rec_term_st (S k) z s)
    | openstar e s => openstar (close_rec_term_e k z e) (close_rec_term_st (S k) z s)
  end
with close_rec_term_e  (k : nat) (z : var) (e : E) : E :=
  match e with
    | v_e v         => v_e (close_rec_term_v k z v)
    | i_e  i        => i_e i
    | p_e x p       => p_e (close_rec_term_v k z x) p
    | f_e f         => f_e (close_rec_term_f k z f)
    | amp e         => amp (close_rec_term_e k z e)
    | star e        => star (close_rec_term_e k z e)
    | cpair e0 e1   => cpair (close_rec_term_e k z e0) (close_rec_term_e k z e1)
    | dot e ipe     => dot (close_rec_term_e k z e) ipe
    | assign e0 e1  => assign (close_rec_term_e k z e0) (close_rec_term_e k z e1)
    | appl e0 e1    => appl   (close_rec_term_e k z e0) (close_rec_term_e k z e1)
    | call s        => call (close_rec_term_st k z s)
    | inst e t      => inst (close_rec_term_e k z e) t
    | pack t0 e t1  => pack t0 (close_rec_term_e k z e) t1
  end
with close_rec_term_f  (k : nat) (z : var) (f : F) : F :=
  match f with
  | dfun t1 t2 s    => dfun t1 t2 (close_rec_term_st (S k) z s)
  | ufun k' f       => ufun k' (close_rec_term_f k z f)
end.

Fixpoint close_rec_term_term (k : nat) (z : var) (t : Term) : Term :=
  match t with
    | term_st s    => term_st (close_rec_term_st k z s)
    | term_e  e    => term_e  (close_rec_term_e k z e)
    | term_f  f    => term_f  (close_rec_term_f k z f)
  end.

Definition close_term z t := close_rec_term_term 0 z t.


(* Copyright (c) 2012-2015, Robbert Krebbers. *)
(* This file is distributed under the terms of the BSD license. *)
Require Export permissions bits.

Notation pbit K := (tagged perm (@BIndet K)).
Notation PBit := (Tagged (d:=BIndet)).
Global Hint Extern 0 (Separation _) => apply (_ : Separation (pbit _)): core.

Section operations.
  Context `{Env K}.

  Global Instance pbit_valid: Valid (env K * memenv K) (pbit K) := λ ΓΔ γb,
    ✓{ΓΔ} (tagged_tag γb) ∧ sep_valid γb.

  Definition pbit_indetify (γb : pbit K) : pbit K :=
    PBit (tagged_perm γb) BIndet.
  Definition pbit_kind : pbit K → option pkind := perm_kind ∘ tagged_perm.
  Definition pbit_full : pbit K := PBit perm_full BIndet.
  Definition pbit_token : pbit K := PBit perm_token BIndet.
  Definition pbit_locked : pbit K → bool := perm_locked ∘ tagged_perm.
  Definition pbit_lock (γb : pbit K) : pbit K :=
    PBit (perm_lock (tagged_perm γb)) (tagged_tag γb).
  Definition pbit_unlock (γb : pbit K) : pbit K :=
    PBit (perm_unlock (tagged_perm γb)) (tagged_tag γb).
  Definition pbit_unlock_if (γb : pbit K) (β : bool) : pbit K :=
    if β then pbit_unlock γb else γb.
End operations.

Arguments pbit_kind _ !_ /.
Arguments pbit_indetify _ !_ /.
Arguments pbit_locked _ !_ /.
Arguments pbit_lock _ !_ /.
Arguments pbit_unlock _ !_ /.

Section permission_bits.
Context `{EnvSpec K}.
Implicit Types Γ : env K.
Implicit Types Δ : memenv K.
Implicit Types α : bool.
Implicit Types b : bit K.
Implicit Types bs : list (bit K).
Implicit Types γ : perm.
Implicit Types γs : list perm.
Implicit Types γb : pbit K.
Implicit Types γbs : list (pbit K).

Lemma pbits_tag γ bs : tagged_tag <$> (PBit γ <$> bs) = bs.
Proof. induction bs; f_equal'; auto. Qed.
Lemma PBits_perm_tag γbs :
  zip_with PBit (tagged_perm <$> γbs) (tagged_tag <$> γbs) = γbs.
Proof. by induction γbs as [|[]]; f_equal'. Qed.
Lemma pbit_empty_valid Γ Δ : ✓{Γ,Δ} (∅ : pbit K).
Proof. repeat split; auto using BIndet_valid, sep_empty_valid. Qed.
Lemma PBit_valid Γ Δ γ b :
  sep_valid γ → ¬sep_unmapped γ → ✓{Γ,Δ} b → ✓{Γ,Δ} (PBit γ b).
Proof. by repeat split. Qed.
Lemma PBits_valid Γ Δ γs bs :
  Forall sep_valid γs → Forall (not ∘ sep_unmapped) γs →
  ✓{Γ,Δ}* bs → ✓{Γ,Δ}* (zip_with PBit γs bs).
Proof.
  intros Hγs. revert bs. induction Hγs; intros ?? [|????];
    decompose_Forall_hyps; auto using PBit_valid.
Qed.
Lemma pbit_mapped γb : Some Readable ⊆ pbit_kind γb → ¬sep_unmapped γb.
Proof. intros ? [? _]. by apply (perm_mapped (tagged_perm γb)). Qed.
Lemma pbit_perm_mapped γb :
  sep_valid γb → sep_unmapped (tagged_perm γb) → sep_unmapped γb.
Proof. intros [??]; split; auto. Qed.
Lemma pbits_perm_mapped γbs :
  Forall sep_valid γbs → Forall (not ∘ sep_unmapped) γbs →
  Forall (not ∘ sep_unmapped) (tagged_perm <$> γbs).
Proof.
  induction 1; inversion_clear 1; constructor; auto using pbit_perm_mapped.
Qed.
Lemma pbits_perm_mapped' γbs :
  Forall sep_valid γbs → Forall sep_unmapped (tagged_perm <$> γbs) →
  Forall sep_unmapped γbs.
Proof.
  induction 1; inversion_clear 1; constructor; auto using pbit_perm_mapped.
Qed.
Lemma pbits_perm_unshared γbs :
  Forall sep_unshared γbs → Forall sep_unshared (tagged_perm <$> γbs).
Proof. by induction 1; constructor. Qed.
Lemma PBits_mapped γs bs :
  Forall (not ∘ sep_unmapped) γs →
  Forall (not ∘ sep_unmapped) (zip_with PBit γs bs).
Proof.
  intros Hγs. revert bs. induction Hγs; intros [|??]; constructor; auto.
  by intros [??].
Qed.
Lemma pbits_tag_valid Γ Δ γbs :
  ✓{Γ,Δ}* γbs → ✓{Γ,Δ}* (tagged_tag <$> γbs).
Proof. induction 1 as [|?? (?&?&?)]; csimpl; eauto. Qed.
Lemma pbits_valid_perm_valid Γ Δ γbs :
  ✓{Γ,Δ}* γbs → Forall sep_valid (tagged_perm <$> γbs).
Proof. induction 1 as [|?? (?&?&?)]; csimpl; eauto. Qed.
Lemma pbit_valid_weaken Γ1 Γ2 Δ1 Δ2 γb :
  ✓ Γ1 → ✓{Γ1,Δ1} γb → Γ1 ⊆ Γ2 → Δ1 ⇒ₘ Δ2 → ✓{Γ2,Δ2} γb.
Proof. intros ? (?&?&?); repeat split; eauto using bit_valid_weaken. Qed.
Lemma pbit_valid_sep_valid Γ Δ γb  : ✓{Γ,Δ} γb → sep_valid γb.
Proof. by intros (?&?&?); repeat split. Qed.
Lemma pbits_valid_sep_valid Γ Δ γbs  : ✓{Γ,Δ}* γbs → Forall sep_valid γbs.
Proof. induction 1; eauto using pbit_valid_sep_valid. Qed.
Lemma pbit_unlock_valid Γ Δ γb : ✓{Γ,Δ} γb → ✓{Γ,Δ} (pbit_unlock γb).
Proof.
  unfold pbit_unlock; intros (?&?&?); repeat split; naive_solver
    auto using perm_unlock_valid, perm_unlock_mapped.
Qed.
Lemma pbit_unlock_if_empty β : pbit_unlock_if (∅ : pbit K) β = ∅.
Proof. by destruct β. Qed.
Lemma pbit_unlock_unshared γb :
  sep_unshared γb → sep_unshared (pbit_unlock γb).
Proof. apply perm_unlock_unshared. Qed.
Lemma pbits_unlock_unshared γbs βs :
  Forall sep_unshared γbs →
  Forall sep_unshared (zip_with pbit_unlock_if γbs βs).
Proof.
  intros Hγbs. revert βs. induction Hγbs; intros [|[] ?];
    simpl; constructor; auto using pbit_unlock_unshared.
Qed.
Lemma pbit_unlock_unmapped γb : sep_unmapped γb → sep_unmapped (pbit_unlock γb).
Proof.
  destruct γb; sep_unfold; naive_solver auto using perm_unlock_unmapped.
Qed.
Lemma pbit_unlock_mapped γb :
  sep_valid γb → sep_unmapped (pbit_unlock γb) → sep_unmapped γb.
Proof. destruct γb; sep_unfold; naive_solver auto using perm_unlock_mapped. Qed.
Lemma pbits_kind_weaken γbs k1 k2 :
  Forall (λ γb, k2 ⊆ pbit_kind γb) γbs → k1 ⊆ k2 →
  Forall (λ γb, k1 ⊆ pbit_kind γb) γbs.
Proof. intros. eapply Forall_impl; eauto. intros γb ?. by transitivity k2. Qed.
Lemma pbits_mapped γbs :
  Forall (λ γb, Some Readable ⊆ pbit_kind γb) γbs →
  Forall (not ∘ sep_unmapped) γbs.
Proof.
  induction 1 as [|[x b]]; constructor; auto.
  intros [??]; simplify_equality'; eapply perm_mapped; eauto.
Qed.
Lemma PBits_unshared γs bs :
  Forall sep_unshared γs → Forall sep_unshared (zip_with PBit γs bs).
Proof.
  intros Hγs. revert bs. induction Hγs; intros [|??]; constructor; eauto.
Qed.
Lemma pbits_unshared γbs :
  Forall sep_valid γbs → Forall (λ γb, Some Locked ⊆ pbit_kind γb) γbs →
  Forall sep_unshared γbs.
Proof.
  induction 1 as [|[x b] ? [??]]; intros; decompose_Forall_hyps;
    repeat constructor; sep_unfold; auto using perm_unshared.
Qed.
Lemma PBits_indetify γs :
  pbit_indetify <$> (flip PBit (@BIndet K) <$> γs) = flip PBit BIndet <$> γs.
Proof. induction γs; f_equal'; auto. Qed.
Lemma pbit_indetify_valid Γ Δ γb : ✓{Γ,Δ} γb → ✓{Γ,Δ} (pbit_indetify γb).
Proof. destruct γb; intros (?&?&?); repeat split; eauto using BIndet_valid. Qed.
Lemma pbits_indetify_valid Γ Δ γbs :
  ✓{Γ,Δ}* γbs → ✓{Γ,Δ}* (pbit_indetify <$> γbs).
Proof. induction 1; csimpl; auto using pbit_indetify_valid. Qed.
Lemma pbits_indetify_idempotent γbs :
  pbit_indetify <$> (pbit_indetify <$> γbs) = pbit_indetify <$> γbs.
Proof. by induction γbs; f_equal'. Qed.
Lemma pbit_indetify_unmapped γb : sep_unmapped γb → pbit_indetify γb = γb.
Proof. destruct γb; intros [??]; naive_solver. Qed.
Lemma pbit_unmapped_indetify γb :
  sep_unmapped γb → sep_unmapped (pbit_indetify γb).
Proof. destruct γb; intros [??]; split; naive_solver. Qed.
Lemma pbits_unmapped_tag γbs :
  Forall sep_unmapped γbs → tagged_tag <$> γbs = replicate (length γbs) BIndet.
Proof. by induction 1 as [|?? []]; f_equal'. Qed.
Lemma pbit_unmapped_indetify_inv γb :
  sep_valid γb → sep_unmapped (pbit_indetify γb) → sep_unmapped γb.
Proof. destruct γb; intros [??] [??]; split; naive_solver. Qed.
Lemma pbits_unmapped_indetify_inv βs γbs :
  Forall sep_valid γbs →
  Forall sep_unmapped (mask pbit_indetify βs γbs) → Forall sep_unmapped γbs.
Proof.
  intros Hγbs. revert βs. induction Hγbs; intros [|[] ?] ?;
    decompose_Forall_hyps; eauto using pbit_unmapped_indetify_inv.
Qed.
Lemma pbits_indetify_unmapped γbs :
  Forall sep_unmapped γbs → pbit_indetify <$> γbs = γbs.
Proof. induction 1; f_equal'; auto using pbit_indetify_unmapped. Qed.
Lemma pbits_indetify_mask_unmapped βs γbs :
  Forall sep_unmapped γbs → mask pbit_indetify βs γbs = γbs.
Proof.
  intros Hγbs. revert βs. induction Hγbs;
    intros [|[] ?]; f_equal'; auto using pbit_indetify_unmapped.
Qed.
Lemma pbit_indetify_unshared γb :
  sep_unshared γb → sep_unshared (pbit_indetify γb).
Proof. done. Qed.
Lemma pbit_full_valid Γ Δ : ✓{Γ,Δ} pbit_full.
Proof. by apply (bool_decide_unpack _). Qed.
Lemma pbit_full_unshared : sep_unshared (@pbit_full K).
Proof. done. Qed.
Lemma PBits_BIndet_tag γbs :
  Forall sep_unmapped γbs →
  flip PBit BIndet <$> (tagged_perm <$> γbs) = γbs.
Proof. induction 1 as [|[] ? [??]]; simplify_equality'; f_equal; auto. Qed.

Lemma pbit_Readable_locked γb :
  Some Readable ⊆ pbit_kind γb → pbit_locked γb = false.
Proof. by destruct γb; f_equal'; auto using perm_Readable_locked. Qed.
Lemma pbits_Readable_locked γbs i :
  Forall (λ γb, Some Readable ⊆ pbit_kind γb) γbs →
  i < length γbs → pbit_locked <$> γbs !! i = Some false.
Proof.
  intros Hγbs. revert i. induction Hγbs; intros [|?] ?;
    f_equal'; auto using pbit_Readable_locked with lia.
Qed.
Lemma pbits_unlock_sep_valid γbs βs :
  Forall sep_valid γbs → Forall sep_valid (zip_with pbit_unlock_if γbs βs).
Proof.
  sep_unfold; intros Hγbs; revert βs.
  induction Hγbs as [|[]]; intros [|[] ?]; constructor;
    naive_solver eauto using perm_unlock_valid, perm_unlock_mapped.
Qed.
Lemma pbits_locks_unlock βs γbs :
  βs =.>* pbit_locked <$> γbs →
  pbit_locked <$> zip_with pbit_unlock_if γbs βs = (pbit_locked <$> γbs) ∖* βs.
Proof.
  revert βs. induction γbs as [|[[[]|]] ?]; intros [|[] ?] ?;
    decompose_Forall_hyps; f_equal; auto.
Qed.
Lemma pbits_unlock_empty_inv γbs βs :
  Forall (∅ =.) (zip_with pbit_unlock_if γbs βs) → Forall sep_valid γbs →
  length γbs = length βs → Forall (∅ =.) γbs.
Proof.
  assert (∀ γ, sep_valid γ → perm_unlock γ = ∅ → γ = ∅).
  { intros [[]|]; repeat sep_unfold; naive_solver. }
  intros Hγbs Hγbs'. revert βs Hγbs.
  induction Hγbs' as [|[] ? []]; intros [|[] ?]; sep_unfold;
    intros; decompose_Forall_hyps; constructor; eauto.
  f_equal; eauto using eq_sym.
Qed.
Lemma pbits_unlock_mapped γbs βs :
  Forall sep_unmapped (zip_with pbit_unlock_if γbs βs) → Forall sep_valid γbs →
  length γbs = length βs → Forall sep_unmapped γbs.
Proof.
  intros Hγbs Hγbs'. revert βs Hγbs. induction Hγbs' as [|[] ? []]; sep_unfold;
    intros [|[] ?] ??; decompose_Forall_hyps; constructor;
    intuition eauto using perm_unlock_mapped.
Qed.
Lemma pbits_unlock_valid Γ Δ γbs βs :
  ✓{Γ,Δ}* γbs → ✓{Γ,Δ}* (zip_with pbit_unlock_if γbs βs).
Proof.
  intros Hγs. revert βs.
  induction Hγs; intros [|[] ?]; simpl; auto using pbit_unlock_valid.
Qed.
Lemma pbit_indetify_unlock γbs βs :
  pbit_indetify <$> zip_with pbit_unlock_if γbs βs
  = zip_with pbit_unlock_if (pbit_indetify <$> γbs) βs.
Proof. revert βs. induction γbs; intros [|[] ?]; f_equal'; auto. Qed.
Lemma pbits_unlock_orb γbs βs1 βs2 :
  zip_with pbit_unlock_if γbs (βs1 ||* βs2)
  = zip_with pbit_unlock_if (zip_with pbit_unlock_if γbs βs1) βs2.
Proof.
  revert βs1 βs2. induction γbs as [|[]]; intros [|[] ?] [|[] ?];
    f_equal'; auto using perm_unlock_unlock with f_equal.
Qed.
Lemma pbits_lock_mapped γbs :
  Forall (not ∘ sep_unmapped) γbs →
  Forall (not ∘ sep_unmapped) (pbit_lock <$> γbs).
Proof.
  sep_unfold. induction 1; constructor; simpl in *;
    intuition eauto using perm_lock_mapped.
Qed.
Lemma pbit_lock_indetified γb :
  pbit_indetify γb = γb → pbit_indetify (pbit_lock γb) = pbit_lock γb.
Proof. by intros <-. Qed.
Lemma pbits_lock_valid Γ Δ γbs :
  ✓{Γ,Δ}* γbs → Forall (λ γb, Some Writable ⊆ pbit_kind γb) γbs →
  ✓{Γ,Δ}* (pbit_lock <$> γbs).
Proof.
  induction 1 as [|[??] ? (?&?&?)]; repeat constructor; decompose_Forall_hyps;
    eauto using perm_lock_valid, perm_lock_mapped.
Qed.
Lemma pbit_lock_unmapped γb :
  Some Writable ⊆ pbit_kind γb → sep_unmapped γb → sep_unmapped (pbit_lock γb).
Proof. intros ? [??]; split; auto. by apply perm_lock_unmapped. Qed.
Lemma pbit_lock_mapped γb :
  sep_unmapped (pbit_lock γb) → sep_unmapped γb.
Proof. intros [??]; split; auto using perm_lock_mapped. Qed.
Lemma pbit_lock_unshared γb :
  sep_unshared γb → sep_unshared (pbit_lock γb).
Proof. apply perm_lock_unshared. Qed.
Lemma pbits_perm_mask βs γbs :
  tagged_perm <$> mask pbit_indetify βs γbs = tagged_perm <$> γbs.
Proof. revert βs. induction γbs; intros [|[] ?]; f_equal'; auto. Qed.
Lemma pbits_locked_mask βs γbs :
  pbit_locked <$> mask pbit_indetify βs γbs = pbit_locked <$> γbs.
Proof. revert βs. induction γbs; intros [|[] ?]; f_equal'; auto. Qed.
End permission_bits.