Require Import mailbox.verif_atomics.
Require Import progs.conclib.
Require Import progs.ghost.
Require Import floyd.library.
Require Import floyd.sublist.
Require Import mailbox.lockfree_linsearch.

Set Bullet Behavior "Strict Subproofs".

Instance CompSpecs : compspecs. make_compspecs prog. Defined.
Definition Vprog : varspecs. mk_varspecs prog. Defined.

Definition surely_malloc_spec :=
 DECLARE _surely_malloc
   WITH n:Z
   PRE [ _n OF tuint ]
       PROP (0 <= n <= Int.max_unsigned)
       LOCAL (temp _n (Vint (Int.repr n)))
       SEP ()
    POST [ tptr tvoid ] EX p:_,
       PROP ()
       LOCAL (temp ret_temp p)
       SEP (malloc_token Tsh n p * memory_block Tsh n p).

Definition tentry := Tstruct _entry noattr.

Definition entry_hists entries hists := fold_right_sepcon (map (fun i =>
  let '(hp, e) := (Znth i hists ([], []), Znth i entries Vundef) in
    ghost_hist (fst hp) (field_address tentry [StructField _key] e) *
    ghost_hist (snd hp) (field_address tentry [StructField _value] e)) (upto 20)).

(* In this case, let map be an association list. *)
Fixpoint index_of (m : list (Z * Z)) (k : Z) :=
  match m with
  | [] => None
  | (k1, v1) :: rest => if eq_dec k1 k then Some 0
                        else option_map Z.succ (index_of rest k)
  end.

Lemma index_of_spec : forall k m, match index_of m k with
  | Some i => 0 <= i < Zlength m /\ fst (Znth i m (0, 0)) = k
  | None => ~In k (map fst m) end.
Proof.
  induction m; simpl; auto; intros.
  destruct a.
  rewrite Zlength_cons.
  pose proof (Zlength_nonneg m).
  destruct (eq_dec z k); [split; auto; omega|].
  destruct (index_of m k); simpl.
  - destruct IHm; unfold Z.succ; rewrite Znth_pos_cons, Z.add_simpl_r; [split|]; auto; omega.
  - tauto.
Qed.

Definition set m k v :=
  match index_of m k with
  | Some i => upd_Znth i m (k, v)
  | None => m ++ [(k, v)]
  end.

Definition get m k := option_map (fun i => snd (Znth i m (0, 0))) (index_of m k).

Definition value_of e :=
  match e with
  | Load v => v
  | Store v => v
  | CAS r c w => if eq_dec r c then w else r
  end.

Definition last_value (h : hist) v :=
  (* initial condition *)
  (h = [] /\ v = vint 0) \/
  exists n e, In (n, e) h /\ value_of e = v /\ Forall (fun x => let '(m, _) := x in m <= n)%nat h.

Lemma last_value_new : forall h n e, Forall (fun x => fst x < n)%nat h ->
  last_value (h ++ [(n, e)]) (value_of e).
Proof.
  right.
  do 3 eexists; [rewrite in_app; simpl; eauto|].
  rewrite Forall_app; repeat constructor.
  eapply Forall_impl; [|eauto]; intros.
  destruct a; simpl in *; omega.
Qed.

Definition ordered_hist h := forall i j (Hi : 0 <= i < j) (Hj : j < Zlength h),
  (fst (Znth i h (O, Store (vint 0))) < fst (Znth j h (O, Store (vint 0))))%nat.

Lemma ordered_cons : forall t e h, ordered_hist ((t, e) :: h) ->
  Forall (fun x => let '(m, _) := x in t < m)%nat h /\ ordered_hist h.
Proof.
  unfold ordered_hist; split.
  - rewrite Forall_forall; intros (?, ?) Hin.
    apply In_Znth with (d := (O, Store (vint 0))) in Hin.
    destruct Hin as (j & ? & Hj).
    exploit (H 0 (j + 1)); try omega.
    { rewrite Zlength_cons; omega. }
    rewrite Znth_0_cons, Znth_pos_cons, Z.add_simpl_r, Hj by omega; auto.
  - intros; exploit (H (i + 1) (j + 1)); try omega.
    { rewrite Zlength_cons; omega. }
    rewrite !Znth_pos_cons, !Z.add_simpl_r by omega; auto.
Qed.

Lemma ordered_last : forall t e h (Hordered : ordered_hist h) (Hin : In (t, e) h)
  (Ht : Forall (fun x => let '(m, _) := x in m <= t)%nat h), last h (O, Store (vint 0)) = (t, e).
Proof.
  induction h; [contradiction | simpl; intros].
  destruct a; apply ordered_cons in Hordered; destruct Hordered as (Ha & ?).
  inversion Ht as [|??? Hp]; subst.
  destruct Hin as [Hin | Hin]; [inv Hin|].
  - destruct h; auto.
    inv Ha; inv Hp; destruct p; omega.
  - rewrite IHh; auto.
    destruct h; auto; contradiction.
Qed.

Definition value_of_hist (h : hist) := value_of (snd (last h (O, Store (vint 0)))).

Lemma ordered_last_value : forall h v (Hordered : ordered_hist h), last_value h v <-> value_of_hist h = v.
Proof.
  unfold last_value, value_of_hist; split; intro.
  - destruct H as [(? & ?) | (? & ? & ? & ? & ?)]; subst; auto.
    erewrite ordered_last; eauto; auto.
  - destruct h; [auto | right].
    destruct (last (p :: h) (O, Store (vint 0))) as (t, e) eqn: Hlast.
    exploit (@app_removelast_last _ (p :: h)); [discriminate | intro Heq].
    rewrite Hlast in Heq.
    exists t; exists e; repeat split; auto.
    + rewrite Heq, in_app; simpl; auto.
    + unfold ordered_hist in Hordered.
      rewrite Forall_forall; intros (?, ?) Hin.
      apply In_Znth with (d := (O, Store (vint 0))) in Hin.
      destruct Hin as (i & ? & Hi).
      rewrite <- Znth_last in Hlast.
      destruct (eq_dec i (Zlength (p :: h) - 1)).
      * subst; rewrite Hlast in Hi; inv Hi; auto.
      * exploit (Hordered i (Zlength (p :: h) - 1)); try omega.
        rewrite Hlast, Hi; simpl; omega.
Qed.

Definition wf_map (m : list (Z * Z)) := Forall (fun i => repable_signed i /\ i <> 0) (map fst m).

Definition int_op e :=
  match e with
  | Load v | Store v => tc_val tint v
  | CAS r c w => tc_val tint r /\ tc_val tint c /\ tc_val tint w
  end.

(* Once set, a key is never reset. *)
Definition k_R (h : list hist_el) (v : val) := !!(Forall int_op h /\
  forall e, In e h -> value_of e <> vint 0 -> v = value_of e) && emp.

Definition v_R (h : list hist_el) (v : val) := emp.

Definition atomic_entry sh p := !!(field_compatible tentry [] p) && EX lkey : val, EX lval : val,
  field_at sh tentry [StructField _lkey] lkey p *
  atomic_loc sh lkey (field_address tentry [StructField _key] p) (vint 0) Tsh k_R *
  field_at sh tentry [StructField _lvalue] lval p *
  atomic_loc sh lval (field_address tentry [StructField _value] p) (vint 0) Tsh v_R.

(* Can we comprehend the per-entry histories into a broader history? *)
Definition failed_CAS k (a b : hist * hist) := exists t r, Forall (fun x => fst x < t)%nat (fst a) /\
  fst b = fst a ++ [(t, CAS (Vint r) (vint 0) (vint k))] /\
  r <> Int.zero /\ r <> Int.repr k /\ snd b = snd a /\
  (let v := value_of_hist (fst a) in v <> vint 0 -> v = Vint r).

Definition wf_hists h l := Forall (fun x => ordered_hist (fst x) /\ ordered_hist (snd x) /\
  Forall int_op (map snd (fst x)) /\ Forall int_op (map snd (snd x))) h /\ 0 <= l <= Zlength h /\
    Forall (fun x => value_of_hist (fst x) <> vint 0) (sublist 0 l h) /\
    Forall (fun x => value_of_hist (fst x) = vint 0) (sublist l (Zlength h) h).

Definition make_int v := match v with Vint i => Int.signed i | _ => 0 end.

Lemma make_int_spec : forall v, tc_val tint v -> vint (make_int v) = v.
Proof.
  destruct v; try contradiction; simpl.
  rewrite Int.repr_signed; auto.
Qed.

Fixpoint make_map h :=
  match h with
  | [] => []
  | (hk, hv) :: rest => let k := make_int (value_of_hist hk) in
      if eq_dec k 0 then [] else (k, make_int (value_of_hist hv)) :: make_map rest
  end.

Lemma ordered_snoc : forall h t e, ordered_hist h -> Forall (fun x => fst x < t)%nat h ->
  ordered_hist (h ++ [(t, e)]).
Proof.
  repeat intro.
  rewrite Zlength_app, Zlength_cons, Zlength_nil in Hj.
  rewrite app_Znth1 by omega.
  destruct (eq_dec j (Zlength h)).
  - rewrite Znth_app1; auto.
    apply Forall_Znth; auto; omega.
  - specialize (H i j).
    rewrite app_Znth1 by omega; apply H; auto; omega.
Qed.

Lemma Forall_set : forall P m k v, Forall P m -> P (k, v) -> Forall P (set m k v).
Proof.
  intros; unfold set.
  destruct (index_of m k).
  - apply Forall_upd_Znth; auto.
  - rewrite Forall_app; split; auto.
Qed.

Lemma wf_make_map : forall h, wf_map (make_map h).
Proof.
  unfold wf_map; induction h; simpl; auto.
  destruct a.
  if_tac; simpl; auto.
  constructor; auto.
  split; auto.
  destruct (value_of_hist _); simpl; try (split; computable).
  apply Int.signed_range.
Qed.

Lemma make_map_eq : forall h h', Forall2 (fun a b => value_of_hist (fst a) = value_of_hist (fst b) /\
  value_of_hist (snd a) = value_of_hist (snd b)) h h' -> make_map h = make_map h'.
Proof.
  induction 1; auto; simpl.
  destruct x, y; simpl in *.
  destruct H as (-> & ->); rewrite IHForall2; auto.
Qed.

Lemma int_op_value : forall e, int_op e -> tc_val tint (value_of e).
Proof.
  destruct e; auto; simpl.
  intros (? & ? & ?); destruct (eq_dec r c); auto.
Qed.

Corollary int_op_value_of_hist : forall h, Forall int_op (map snd h) -> tc_val tint (value_of_hist h).
Proof.
  intros; unfold value_of_hist.
  apply Forall_last; simpl; auto.
  rewrite Forall_map in H; eapply Forall_impl; [|eauto].
  simpl; intros; apply int_op_value; auto.
Qed.

Lemma make_map_app : forall h1 h2 (Hnz : Forall (fun x => value_of_hist (fst x) <> vint 0) h1)
  (Hint : Forall (fun x => Forall int_op (map snd (fst x))) h1),
  make_map (h1 ++ h2) = make_map h1 ++ make_map h2.
Proof.
  induction 1; auto; simpl; intros.
  inv Hint.
  destruct x as (h, ?).
  rewrite IHHnz; auto.
  if_tac; auto.
  exploit int_op_value_of_hist; eauto; simpl.
  destruct (value_of_hist h) eqn: Hval; try contradiction; simpl in *.
  contradiction H; rewrite Hval.
  f_equal; apply signed_inj; auto.
Qed.

Lemma make_map_drop : forall h1 h2 (Hz : Forall (fun x => value_of_hist (fst x) = vint 0) h2),
  make_map (h1 ++ h2) = make_map h1.
Proof.
  induction h1; simpl; intros.
  - destruct h2; auto; simpl.
    destruct p as (h, ?).
    if_tac; auto.
    inv Hz.
    contradiction H; simpl in *.
    replace (value_of_hist h) with (vint 0); auto.
  - rewrite IHh1; auto.
Qed.

Lemma index_of_app : forall k m1 m2, index_of (m1 ++ m2) k =
  match index_of m1 k with Some i => Some i | None => option_map (Z.add (Zlength m1)) (index_of m2 k) end.
Proof.
  induction m1; simpl; intros.
  - destruct (index_of m2 k); auto.
  - destruct a.
    destruct (eq_dec z k); auto.
    rewrite IHm1; destruct (index_of m1 k); auto; simpl.
    destruct (index_of m2 k); auto; simpl.
    rewrite Zlength_cons; f_equal; omega.
Qed.

Lemma index_of_out : forall k m, Forall (fun x => fst x <> k) m -> index_of m k = None.
Proof.
  intros.
  pose proof (index_of_spec k m) as Hk.
  destruct (index_of m k); auto.
  destruct Hk; eapply Forall_Znth in H; eauto.
  subst; contradiction H; eauto.
Qed.

Lemma make_map_length : forall h (Hnz : Forall (fun x => value_of_hist (fst x) <> vint 0) h)
  (Hint : Forall (fun x => Forall int_op (map snd (fst x))) h),
  Zlength (make_map h) = Zlength h.
Proof.
  induction h; auto; simpl; intros.
  inv Hnz; inv Hint.
  destruct a as (hk, ?); simpl in *.
  exploit int_op_value_of_hist; eauto.
  destruct (value_of_hist hk); try contradiction; simpl.
  if_tac; [|rewrite !Zlength_cons, IHh; auto].
  absurd (Vint i = vint 0); auto; f_equal; apply signed_inj; auto.
Qed.

Lemma make_map_no_key : forall h k (Hout : Forall (fun x => make_int (value_of_hist (fst x)) <> k) h),
  Forall (fun x => fst x <> k) (make_map h).
Proof.
  induction h; simpl; auto; intros.
  destruct a.
  inv Hout.
  if_tac; auto.
Qed.

Lemma make_map_nil : forall h, Forall (fun x => value_of_hist (fst x) = vint 0) h -> make_map h = [].
Proof.
  destruct h; auto; simpl.
  destruct p.
  intro H; inversion H as [|?? Heq]; subst.
  simpl in *; rewrite Heq; auto.
Qed.

Definition set_item_trace (h : list (hist * hist)) k v i h' := 0 <= i < Zlength h /\
  Forall2 (failed_CAS k) (sublist 0 i h) (sublist 0 i h') /\
  (let '(hk, hv) := Znth i h ([], []) in exists t r tv, Forall (fun x => fst x < t)%nat hk /\
     Forall (fun x => fst x < tv)%nat hv /\
      Znth i h' ([], []) = (hk ++ [(t, CAS r (vint 0) (vint k))], hv ++ [(tv, Store (vint v))]) /\
      (r = vint 0 \/ r = vint k) /\ (let v := value_of_hist hk in v <> vint 0 -> v = r)) /\
  sublist (i + 1) (Zlength h) h = sublist (i + 1) (Zlength h') h'.

Lemma set_item_trace_map : forall h k v i h' l (Hwf : wf_hists h l) (Htrace : set_item_trace h k v i h')
  (Hk : k <> 0) (Hrepk : repable_signed k) (Hrepv : repable_signed v),
  wf_hists h' (Z.max (i + 1) l) /\ let m' := make_map (sublist 0 i h' ++ sublist i (Zlength h) h) in
    wf_map (set m' k v) /\ incl (make_map h) m' /\ make_map h' = set m' k v.
Proof.
  intros.
  destruct Htrace as (Hbounds & Hfail & Hi & Hrest).
  destruct (Znth i h ([], [])) as (hk, hv) eqn: Hhi.
  destruct Hi as (t & r & tv & Ht & Htv & Hi & Hr & Hr0).
  assert (Zlength h' = Zlength h) as Hlen.
  { exploit (Znth_inbounds i h' ([], [])).
    { rewrite Hi; intro X; inversion X as [Heq].
      symmetry in Heq; apply app_cons_not_nil in Heq; auto. }
    intro.
    assert (Zlength (sublist (i + 1) (Zlength h) h) = Zlength (sublist (i + 1) (Zlength h') h')) as Heq
      by (rewrite Hrest; auto).
    rewrite !Zlength_sublist in Heq; omega. }
  assert (i <= Zlength h') by (rewrite Hlen; destruct Hbounds; apply Z.lt_le_incl; auto).
  assert (0 <= i + 1 <= Zlength h').
  { rewrite Hlen; destruct Hbounds; split; [|rewrite <- lt_le_1]; auto; omega. }
  destruct Hwf as (Hwf & ? & Hl1 & Hl2).
  assert (vint k <> vint 0).
  { intro; contradiction Hk; apply repr_inj_signed; auto.
    { split; computable. }
    { congruence. }}
  assert (Forall (fun x => value_of_hist (fst x) <> vint 0) (sublist 0 i h')).
  { rewrite Forall_forall; intros (?, ?) Hin.
    exploit (Forall2_In_r (failed_CAS k)); eauto.
    intros ((?, ?) & ? & ? & r1 & ? & ? & ? & ? & ? & ?); simpl in *; subst.
    unfold value_of_hist; rewrite last_snoc; simpl.
    destruct (eq_dec (Vint r1) (vint 0)); auto. }
  assert (h' = sublist 0 i h' ++ Znth i h' ([], []) :: sublist (i + 1) (Zlength h') h') as Hh'.
  { rewrite <- sublist_next, sublist_rejoin, sublist_same; auto; try omega; rewrite Hlen; auto. }
  assert ((if eq_dec r (vint 0) then vint k else r) = vint k) as Hif.
  { if_tac; auto.
    destruct Hr; [absurd (r = vint 0)|]; auto. }
  assert (value_of_hist (fst (Znth i h' ([], []))) = vint k) as Hk'.
  { unfold value_of_hist; rewrite Hi; simpl; rewrite last_snoc; auto. }
  assert (wf_hists h' (Z.max (i + 1) l)) as Hwf'; [|split; auto; split; [|split]].
  - split.
    + rewrite Hh'; clear Hh'; rewrite Forall_app; split; [|constructor].
      * rewrite Forall_forall; intros (?, ?) Hin.
        exploit (Forall2_In_r (failed_CAS k)); eauto.
        intros ((?, ?) & Hin' & ? & ? & ? & ? & ? & ? & ? & ?); simpl in *; subst.
        apply sublist_In in Hin'; rewrite Forall_forall in Hwf; destruct (Hwf _ Hin') as (? & ? & ? & ?).
        rewrite map_app, Forall_app; repeat constructor; auto; apply ordered_snoc; auto.
      * rewrite Hi; simpl.
        eapply Forall_Znth with (i0 := i) in Hwf; auto.
        rewrite Hhi in Hwf; destruct Hwf as (? & ? & ? & ?); rewrite !map_app, !Forall_app; repeat constructor;
          auto; try (apply ordered_snoc; auto).
        destruct Hr; subst; simpl; auto.
      * rewrite <- Hrest; apply Forall_sublist; auto.
    + assert (0 <= Z.max (i + 1) l <= Zlength h'); [|split; auto].
      { destruct (Z.max_spec (i + 1) l) as [(? & ->) | (? & ->)]; auto; omega. }
      split; [|apply Forall_suffix_max with (l1 := h); auto; omega].
      rewrite Hh'; clear Hh'.
      assert (Zlength h' <= i - 0 + Z.succ (Zlength h' - (i + 1))) by omega.
      assert (0 <= Zlength h' - i) by omega.
      destruct (Z.max_spec (i + 1) l) as [(? & ->) | (? & ->)].
      * rewrite !sublist_app; rewrite ?Zlength_cons, ?Zlength_sublist; auto; try omega.
        rewrite Z.min_l, Z.min_r, Z.max_r, Z.max_l by omega.
        rewrite !Z.sub_0_r.
        rewrite sublist_sublist, !Z.add_0_r by omega.
        rewrite Forall_app; split; auto.
        rewrite sublist_0_cons by omega.
        constructor; [rewrite Hk'; auto|].
        rewrite sublist_sublist by omega.
        rewrite <- Z.sub_add_distr, Z.sub_simpl_r.
        rewrite Z.add_0_l, sublist_parts2; try omega.
        rewrite <- Hrest.
        rewrite <- sublist_parts2 by omega.
        rewrite sublist_parts1 by omega; apply Forall_sublist; auto.
      * rewrite !sublist_app; rewrite ?Zlength_cons, ?Zlength_sublist; auto; try omega.
        rewrite !Z.sub_0_r, Z.min_l, Z.min_r, Z.max_r, Z.max_l; auto; try omega.
        rewrite Z.add_simpl_l.
        rewrite sublist_same, sublist_len_1 with (d := ([], [])), Znth_0_cons;
          rewrite ?Zlength_cons, ?Zlength_sublist; auto; try omega; simpl.
        rewrite Forall_app; split; auto.
        constructor; auto; rewrite Hk'; auto.
  - unfold wf_map; rewrite Forall_map; apply Forall_set; auto.
    rewrite <- Forall_map; apply wf_make_map.
  - clear Hh'; match goal with H : 0 <= l <= _ |- _ => destruct H end.
    assert (Forall2 (fun a b => value_of_hist (fst a) = value_of_hist (fst b) /\
      value_of_hist (snd a) = value_of_hist (snd b)) (sublist 0 (Z.min i l) h) (sublist 0 (Z.min i l) h')) as Heq.
    { rewrite Forall2_eq_upto with (d1 := ([] : hist, [] : hist))(d2 := ([] : hist, [] : hist)).
      assert (0 <= Z.min i l <= Zlength h) as (? & ?).
      { split; [rewrite Z.min_glb_iff | rewrite Z.min_le_iff]; auto; omega. }
      split; [rewrite !Zlength_sublist; auto; omega|].
      rewrite Forall_forall; intros ? Hin.
      rewrite In_upto, Z2Nat.id in Hin by (apply Zlength_nonneg).
      assert (value_of_hist (fst (Znth x (sublist 0 (Z.min i l) h) ([], []))) <> vint 0) as Hnz.
      { apply Forall_Znth; auto.
        rewrite <- sublist_prefix; apply Forall_sublist; auto. }
      rewrite Zlength_sublist, Z.sub_0_r in Hin by (auto; omega).
      assert (x < i).
      { destruct Hin; eapply Z.lt_le_trans; eauto.
        apply Z.le_min_l. }
      exploit (Forall2_Znth _ _ _ ([], []) ([], []) Hfail x); auto.
      { rewrite Zlength_sublist; omega. }
      intros (? & r1 & ? & Heq1 & ? & ? & Heq2 & Hv).
      rewrite !Znth_sublist, Z.add_0_r in Heq1, Heq2, Hv, Hnz; auto; try omega.
      rewrite !Znth_sublist, Z.add_0_r in Heq2 by omega.
      rewrite !Znth_sublist, Z.add_0_r by omega.
      rewrite Heq1, Heq2; simpl; split; auto.
      unfold value_of_hist in *; rewrite last_snoc; simpl.
      destruct (eq_dec (Vint r1) (vint 0)); [absurd (r1 = Int.zero); auto; inv e; auto | auto]. }
    replace h with (sublist 0 l h ++ sublist l (Zlength h) h) at 1
      by (rewrite sublist_rejoin, sublist_same; auto; omega).
    rewrite make_map_drop; auto.
    assert (Forall (fun x => Forall int_op (map snd (fst x))) h').
    { destruct Hwf'; eapply Forall_impl; [|eauto]; tauto. }
    destruct (Z.min_spec i l) as [(? & Hmin) | (? & Hmin)]; rewrite Hmin in *; clear Hmin.
    + assert (Forall (fun x : hist * hist => value_of_hist (fst x) <> vint 0) (sublist 0 i h')).
      { eapply Forall_Forall2; try apply Heq.
        { replace i with (Z.min i l) by (apply Z.min_l; omega).
          rewrite <- sublist_prefix; apply Forall_sublist; auto. }
        intros ??? (<- & _); auto. }
      assert (Forall (fun x => Forall int_op (map snd (fst x))) (sublist 0 i h'))
        by (apply Forall_sublist; auto).
      rewrite make_map_app; auto.
      rewrite sublist_split with (lo := i)(mid := l) by omega.
      rewrite make_map_app, app_assoc.
      apply incl_appl.
      rewrite <- make_map_app; auto.
      erewrite make_map_eq; [apply incl_refl|].
      rewrite sublist_split with (mid := i) by omega.
      apply Forall2_app; auto.
      rewrite Forall2_eq_upto with (d1 := ([] : hist, [] : hist))(d2 := ([] : hist, [] : hist)).
      split; auto; rewrite Forall_forall; intros; auto.
      * rewrite sublist_parts1 by omega; apply Forall_sublist; auto.
      * apply Forall_sublist; eapply Forall_impl, Hwf; tauto.
    + rewrite sublist_split with (mid := l)(hi := i) by omega.
      rewrite <- app_assoc, make_map_app.
      apply incl_appl.
      erewrite make_map_eq; [apply incl_refl | auto].
      * eapply Forall_Forall2; try apply Heq; auto.
        intros ??? (<- & _); auto.
      * apply Forall_sublist; auto.
  - unfold set.
    destruct Hwf' as (? & ? & Hl1' & ?).
    assert (Forall (fun x => Forall int_op (map snd (fst x))) (sublist 0 i h')).
    { eapply Forall_sublist, Forall_impl; [|eauto]; tauto. }
    rewrite Hh' at 1; clear Hh'.
    rewrite make_map_app by auto.
    assert (Forall (fun x => make_int (value_of_hist (fst x)) <> k) (sublist 0 i h')) as Hmiss.
    { rewrite Forall_forall; intros (hk', hv') Hin.
      exploit (Forall2_In_r _ (hk', hv') _ _ Hfail); auto.
      intros (? & ? & ? & r1 & ? & Heqi & ? & ? & ? & ?); subst.
      unfold value_of_hist; rewrite Heqi, last_snoc; simpl.
      destruct (eq_dec (Vint r1) (vint 0)); simpl.
      { absurd (r1 = Int.zero); auto; inv e; auto. }
      intro; absurd (r1 = Int.repr k); subst; auto.
      rewrite Int.repr_signed; auto. }
    rewrite make_map_app at 1 by auto.
    rewrite index_of_app, index_of_out, make_map_length by (auto; apply make_map_no_key; auto); simpl.
    rewrite Hi; simpl.
    unfold value_of_hist; rewrite !last_snoc; simpl.
    rewrite Hif; simpl.
    rewrite !Int.signed_repr; auto.
    destruct (eq_dec k 0); [contradiction Hk; auto|].
    destruct (zlt i l).
    + destruct (eq_dec (value_of_hist hk) (vint 0)).
      { eapply Forall_Znth with (i0 := i) in Hl1; [|rewrite Zlength_sublist; omega].
        rewrite Znth_sublist, Z.add_0_r, Hhi in Hl1 by omega; contradiction Hl1. }
      assert (value_of_hist hk = vint k) as Hik.
      { rewrite Hr0; auto.
        rewrite Hr0 in n0; auto.
        destruct Hr; [contradiction n0; auto | auto]. }
      erewrite sublist_next with (i0 := i), Hhi by omega; simpl.
      rewrite Hik; simpl.
      rewrite Int.signed_repr; auto.
      destruct (eq_dec k 0); [contradiction Hk; auto | simpl].
      rewrite eq_dec_refl; simpl.
      rewrite make_map_app, Z.add_0_r by auto.
      rewrite upd_Znth_app2; rewrite make_map_length; auto.
      rewrite Zminus_diag, upd_Znth0; simpl.
      rewrite Hik; simpl.
      rewrite Int.signed_repr; auto.
      destruct (eq_dec k 0); [contradiction Hk; auto | simpl].
      rewrite sublist_1_cons, Zlength_cons.
      unfold Z.succ; rewrite Z.add_simpl_r.
      rewrite sublist_same with (hi := Zlength (make_map _)), Hrest; auto.
      { pose proof (Zlength_nonneg (make_map ((hk, hv) :: sublist (i + 1) (Zlength h) h))); omega. }
    + erewrite sublist_next with (i0 := i) at 1 by omega; simpl.
      exploit (Forall_Znth (fun x => value_of_hist (fst x) = vint 0) (sublist l (Zlength h) h) (i - l)); auto.
      { rewrite Zlength_sublist; omega. }
      rewrite Znth_sublist, Z.sub_simpl_r, Hhi by omega; simpl.
      rewrite Hhi; intros ->; simpl.
      rewrite make_map_nil with (h := sublist (i + 1) _ _).
      rewrite make_map_drop; auto.
      { replace i with (i - l + l) by (apply Z.sub_simpl_r).
        rewrite <- sublist_suffix by omega; apply Forall_sublist; auto. }
      { rewrite <- Hrest; replace (i + 1) with (i + 1 - l + l) by (apply Z.sub_simpl_r).
        rewrite <- sublist_suffix by omega; apply Forall_sublist; auto. }
Qed.

(* What can a thread know?
   At least certain keys exist, and whatever it did last took effect.
   It can even rely on the indices of known keys. *)
Definition set_item_spec :=
 DECLARE _set_item
  WITH key : Z, value : Z, p : val, sh : share, entries : list val, h : list (hist * hist), l : Z
  PRE [ _key OF tint, _value OF tint ]
   PROP (repable_signed key; repable_signed value; readable_share sh; key <> 0; Forall isptr entries;
         Zlength h = 20; wf_hists h l)
   LOCAL (temp _key (vint key); temp _value (vint value); gvar _m_entries p)
   SEP (data_at sh (tarray (tptr tentry) 20) entries p;
        fold_right_sepcon (map (atomic_entry sh) entries);
        entry_hists entries h)
  POST [ tvoid ]
   EX i : Z, EX h' : list (hist * hist),
   PROP (set_item_trace h key value i h')
   LOCAL ()
   SEP (data_at sh (tarray (tptr tentry) 20) entries p;
        fold_right_sepcon (map (atomic_entry sh) entries);
        entry_hists entries h').
(* set_item_trace_map describes the properties on the resulting map. *)

Definition failed_load k (a b : hist * hist) := exists t r, Forall (fun x => fst x < t)%nat (fst a) /\
  fst b = fst a ++ [(t, Load (Vint r))] /\ r <> Int.zero /\ r <> Int.repr k /\ snd b = snd a /\
  (let v := value_of_hist (fst a) in v <> vint 0 -> v = Vint r).

(* get_item can return 0 in two cases: if the key is not in the map, or if its value is 0.
   In correct use, the latter should only occur if the value has not been initialized.
   Conceptually, this is still linearizable because we could have just checked before the key was added,
   but at a finer-grained level we can tell the difference from the history, so we might as well keep
   this information. *)
Definition get_item_trace (h : list (hist * hist)) k v i h' := 0 <= i < Zlength h /\
  Forall2 (failed_load k) (sublist 0 i h) (sublist 0 i h') /\
  (let '(hk, hv) := Znth i h ([], []) in exists t r, Forall (fun x => fst x < t)%nat hk /\
     fst (Znth i h' ([], [])) = hk ++ [(t, Load (vint r))] /\
     (v = 0 /\ r = 0 /\ snd (Znth i h' ([], [])) = hv \/
      r = k /\ exists tv, Forall (fun x => fst x < tv)%nat hv /\
        snd (Znth i h' ([], [])) = hv ++ [(tv, Load (vint v))]) /\
    (let v := value_of_hist hk in v <> vint 0 -> v = vint r)) /\
  sublist (i + 1) (Zlength h) h = sublist (i + 1) (Zlength h') h'.

Lemma index_of_iff_out : forall m k, index_of m k = None <-> ~In k (map fst m).
Proof.
  split; intro.
  - induction m; auto; simpl in *.
    destruct a.
    destruct (eq_dec z k); [discriminate|].
    destruct (index_of m k); [discriminate|].
    intros [? | ?]; auto.
    contradiction IHm.
  - apply index_of_out.
    rewrite Forall_forall; repeat intro; contradiction H.
    rewrite in_map_iff; eauto.
Qed.

Corollary get_fail_iff : forall m k, get m k = None <-> ~In k (map fst m).
Proof.
  intros; unfold get; rewrite <- index_of_iff_out.
  destruct (index_of m k); simpl; split; auto; discriminate.
Qed.

Lemma Znth_make_map : forall d h i (Hi : 0 <= i < Zlength h)
  (Hnz : Forall (fun x => value_of_hist (fst x) <> vint 0) (sublist 0 (i + 1) h))
  (Hint : Forall (fun x => Forall int_op (map snd (fst x))) (sublist 0 (i + 1) h)),
  Znth i (make_map h) d = (make_int (value_of_hist (fst (Znth i h ([], [])))),
                           make_int (value_of_hist (snd (Znth i h ([], []))))).
Proof.
  induction h; simpl; intros.
  { rewrite Zlength_nil in *; omega. }
  destruct a.
  rewrite Zlength_cons in *.
  rewrite sublist_0_cons, Z.add_simpl_r in Hnz, Hint by omega.
  inv Hnz; inv Hint.
  exploit int_op_value_of_hist; eauto; intro; simpl in *.
  destruct (value_of_hist l) eqn: Hfst; try contradiction; simpl.
  if_tac; [absurd (Vint i0 = vint 0); auto; f_equal; apply signed_inj; auto|].
  destruct (eq_dec i 0).
  - subst; rewrite !Znth_0_cons; simpl; auto.
    rewrite Hfst; auto.
  - rewrite !Znth_pos_cons by omega; apply IHh; rewrite ?Z.sub_simpl_r; auto; omega.
Qed.

Lemma get_item_trace_map : forall h k v i h' l (Hwf : wf_hists h l) (Htrace : get_item_trace h k v i h')
  (Hk : k <> 0) (Hrepk : repable_signed k) (Hrepv : repable_signed v),
  match get (make_map h') k with
  | Some v' => v' = v /\ wf_hists h' (Z.max (i + 1) l) /\ incl (set (make_map h) k v) (make_map h')
  | None => l <= i /\ wf_hists h' i /\ v = 0 /\ incl (make_map h) (make_map h') end.
Proof.
  intros.
  destruct Htrace as (Hbounds & Hfail & Hi & Hrest).
  destruct (Znth i h ([], [])) as (hk, hv) eqn: Hhi.
  destruct Hi as (t & r & Ht & Hi1 & Hi2 & Hr0).
  assert (Zlength h' = Zlength h) as Hlen.
  { exploit (Znth_inbounds i h' ([], [])).
    { destruct (Znth i h' ([], [])) as (hk', hv'); intro X; inv X.
      apply app_cons_not_nil in Hi1; auto. }
    intro.
    assert (Zlength (sublist (i + 1) (Zlength h) h) = Zlength (sublist (i + 1) (Zlength h') h')) as Heq
      by (rewrite Hrest; auto).
    rewrite !Zlength_sublist in Heq; omega. }
  assert (i <= Zlength h') by (rewrite Hlen; destruct Hbounds; apply Z.lt_le_incl; auto).
  assert (0 <= i + 1 <= Zlength h').
  { rewrite Hlen; destruct Hbounds; split; [|rewrite <- lt_le_1]; auto; omega. }
  destruct Hwf as (Hwf & ? & Hl1 & Hl2).
  assert (vint k <> vint 0).
  { intro; contradiction Hk; apply repr_inj_signed; auto.
    { split; computable. }
    { congruence. }}
  assert (Forall (fun x => value_of_hist (fst x) <> vint 0) (sublist 0 i h')).
  { rewrite Forall_forall; intros (?, ?) Hin.
    exploit (Forall2_In_r (failed_load k)); eauto.
    intros ((?, ?) & ? & ? & r1 & ? & ? & ? & ? & ? & ?); simpl in *; subst.
    unfold value_of_hist; rewrite last_snoc; simpl.
    intro X; absurd (r1 = Int.zero); auto; inv X; auto. }
  assert (h' = sublist 0 i h' ++ Znth i h' ([], []) :: sublist (i + 1) (Zlength h') h') as Hh'.
  { rewrite <- sublist_next, sublist_rejoin, sublist_same; auto; try omega; rewrite Hlen; auto. }
  assert (Forall (fun x => ordered_hist (fst x) /\ ordered_hist (snd x) /\ Forall int_op (map snd (fst x)) /\
    Forall int_op (map snd (snd x))) h') as Hwf'.
  { rewrite Hh'; clear Hh'; rewrite Forall_app; split; [|constructor].
    - eapply Forall_Forall2; try apply Hfail; [apply Forall_sublist; auto|].
      intros (?, ?) (?, ?) (? & ? & ? & ?) (? & ? & ? & ? & ? & ? & ? & ?); simpl in *; subst.
      rewrite map_app, Forall_app; repeat constructor; auto; apply ordered_snoc; auto.
    - eapply Forall_Znth with (i0 := i) in Hwf; auto.
      rewrite Hhi in Hwf; destruct Hwf as (? & ? & ? & ?).
      rewrite Hi1; split; [apply ordered_snoc; auto|].
      destruct Hi2 as [(? & ? & ->) | (? & ? & ? & ->)]; rewrite !map_app, !Forall_app;
        repeat constructor; auto; try (apply ordered_snoc; auto).
    - rewrite <- Hrest; apply Forall_sublist; auto. }
  assert (Forall (fun x => Forall int_op (map snd (fst x))) (sublist 0 i h')).
  { eapply Forall_sublist, Forall_impl, Hwf'; tauto. }
  assert (Forall (fun x => make_int (value_of_hist (fst x)) <> k) (sublist 0 i h')) as Hmiss.
  { clear Hh'; rewrite Forall_forall; intros (hk', hv') Hin.
    exploit (Forall2_In_r _ (hk', hv') _ _ Hfail); auto.
    intros (? & ? & ? & r1 & ? & Heqi & ? & ? & ? & ?); subst.
    unfold value_of_hist; rewrite Heqi, last_snoc; simpl.
    intro; absurd (r1 = Int.repr k); subst; auto.
    rewrite Int.repr_signed; auto. }
  unfold get; destruct (index_of (make_map h') k) eqn: Hindex; simpl.
  - rewrite Hh', make_map_app, index_of_app, index_of_out in Hindex
      by (auto; apply make_map_no_key; auto).
    simpl in Hindex.
    destruct (Znth i h' ([], [])) as (hk', hv') eqn: Hhi'; simpl in *; subst hk'.
    unfold value_of_hist in Hindex; rewrite last_snoc in Hindex; simpl in Hindex.
    destruct Hi2 as [(? & ? & ?) | (? & tv & ? & ?)]; subst r hv'; [discriminate|].
    rewrite Int.signed_repr in Hindex by auto.
    destruct (eq_dec k 0); [contradiction Hk; auto|].
    simpl in Hindex.
    rewrite eq_dec_refl in Hindex; simpl in Hindex.
    inversion Hindex; subst z.
    rewrite make_map_length, Zlength_sublist, Z.sub_simpl_r by (auto; omega).
    assert (0 <= Z.max (i + 1) l <= Zlength h' /\
      Forall (fun x => value_of_hist (fst x) <> vint 0) (sublist 0 (Z.max (i + 1) l) h') /\
      Forall (fun x => value_of_hist (fst x) = vint 0) (sublist (Z.max (i + 1) l) (Zlength h') h'))
      as (? & Hl1' & Hl2'); [|split; [|split; [split; auto|]]].
    + assert (0 <= Z.max (i + 1) l <= Zlength h'); [|split; auto].
      { destruct (Z.max_spec (i + 1) l) as [(? & ->) | (? & ->)]; auto; omega. }
      split; [|apply Forall_suffix_max with (l1 := h); auto; omega].
      rewrite Hh'; clear Hh'.
      assert (Zlength h' <= i - 0 + Z.succ (Zlength h' - (i + 1))) by omega.
      assert (0 <= Zlength h' - i) by omega.
      destruct (Z.max_spec (i + 1) l) as [(? & ->) | (? & ->)].
      * rewrite !sublist_app; rewrite ?Zlength_cons, ?Zlength_sublist; auto; try omega.
        rewrite Z.min_l, Z.min_r, Z.max_r, Z.max_l by omega.
        rewrite !Z.sub_0_r.
        rewrite sublist_sublist, !Z.add_0_r by omega.
        rewrite Forall_app; split; auto.
        rewrite sublist_0_cons by omega.
        constructor; [unfold value_of_hist; simpl; rewrite last_snoc; auto|].
        rewrite sublist_sublist by omega.
        rewrite <- Z.sub_add_distr, Z.sub_simpl_r.
        rewrite Z.add_0_l, sublist_parts2; try omega.
        rewrite <- Hrest.
        rewrite <- sublist_parts2 by omega.
        rewrite sublist_parts1 by omega; apply Forall_sublist; auto.
      * rewrite !sublist_app; rewrite ?Zlength_cons, ?Zlength_sublist; auto; try omega.
        rewrite !Z.sub_0_r, Z.min_l, Z.min_r, Z.max_r, Z.max_l; auto; try omega.
        rewrite Z.add_simpl_l.
        rewrite sublist_same, sublist_len_1 with (d := ([], [])), Znth_0_cons;
          rewrite ?Zlength_cons, ?Zlength_sublist; auto; try omega; simpl.
        rewrite Forall_app; split; auto.
        constructor; auto; unfold value_of_hist; simpl; rewrite last_snoc; auto.
    + rewrite Znth_make_map, Hhi'; simpl.
      unfold value_of_hist; rewrite last_snoc; simpl.
      apply Int.signed_repr; auto.
      { omega. }
      { rewrite sublist_split with (mid := i), Forall_app by omega; split; auto.
        erewrite sublist_len_1, Hhi' by omega; repeat constructor; simpl.
        unfold value_of_hist; rewrite last_snoc; auto. }
      { eapply Forall_sublist, Forall_impl, Hwf'; tauto. }
    + unfold set.
      rewrite Hh'; clear Hh'.
      rewrite make_map_app by auto; simpl.
      unfold value_of_hist; rewrite !last_snoc; simpl.
      rewrite !Int.signed_repr by auto.
      destruct (eq_dec k 0); [contradiction Hk; auto|].
      assert (0 <= Z.min i l <= Zlength h) as (? & ?).
      { split; [rewrite Z.min_glb_iff | rewrite Z.min_le_iff]; auto; omega. }
      replace h with (sublist 0 (Z.min i l) h ++ sublist (Z.min i l) (Zlength h) h)
        by (rewrite sublist_rejoin, sublist_same; auto; omega).
      assert (Forall (fun x => value_of_hist (fst x) <> vint 0) (sublist 0 (Z.min i l) h)).
      { rewrite <- sublist_prefix; apply Forall_sublist; auto. }
      assert (Forall (fun x => Forall int_op (map snd (fst x))) (sublist 0 (Z.min i l) h)).
      { eapply Forall_sublist, Forall_impl, Hwf; tauto. }
      rewrite make_map_app, index_of_app, index_of_out; auto.
      assert (incl (make_map (sublist 0 (Z.min i l) h)) (make_map (sublist 0 (Z.min i l) h'))).
      { erewrite make_map_eq; [apply incl_refl|].
        rewrite Forall2_eq_upto with (d1 := ([] : hist, [] : hist))(d2 := ([] : hist, [] : hist)).
        split; [rewrite !Zlength_sublist; auto; omega|].
        rewrite Forall_forall; intros ? Hin.
        rewrite In_upto, Z2Nat.id in Hin by (apply Zlength_nonneg).
        assert (value_of_hist (fst (Znth x (sublist 0 (Z.min i l) h) ([], []))) <> vint 0) as Hnz.
        { apply Forall_Znth; auto. }
        rewrite Zlength_sublist, Z.sub_0_r in Hin by (auto; omega).
        assert (x < i).
        { destruct Hin; eapply Z.lt_le_trans; eauto.
          apply Z.le_min_l. }
        exploit (Forall2_Znth _ _ _ ([], []) ([], []) Hfail x); auto.
        { rewrite Zlength_sublist; omega. }
        intros (? & r1 & ? & Heq1 & ? & ? & Heq2 & Hv).
        rewrite !Znth_sublist, Z.add_0_r in Heq1, Heq2, Hv, Hnz; auto; try omega.
        rewrite !Znth_sublist, Z.add_0_r in Heq1, Heq2 by omega.
        rewrite !Znth_sublist, Z.add_0_r by omega.
        rewrite Heq1, Heq2; simpl; split; auto.
        unfold value_of_hist in *; rewrite last_snoc; simpl.
        destruct (eq_dec (Vint r1) (vint 0)); [absurd (r1 = Int.zero); auto; inv e; auto | auto]. }
      destruct (Z.min_spec i l) as [(? & Hmin) | (? & Hmin)]; rewrite Hmin in *.
      * erewrite sublist_next with (i0 := i) by omega.
        rewrite Hhi; simpl.
        rewrite Hr0; simpl.
        rewrite Int.signed_repr by auto; simpl.
        destruct (eq_dec k 0); [contradiction Hk; auto | simpl].
        rewrite eq_dec_refl; simpl.
        rewrite Z.add_0_r, upd_Znth_app2; rewrite make_map_length; auto.
        rewrite Zminus_diag, upd_Znth0, sublist_1_cons, Zlength_cons.
        unfold Z.succ; rewrite Z.add_simpl_r, sublist_same with (hi := Zlength _) by auto.
        rewrite Hrest; apply incl_app; [apply incl_appl; auto | apply incl_appr, incl_refl].
        { pose proof (Zlength_nonneg
            ((k, make_int (value_of_hist hv)) :: make_map (sublist (i + 1) (Zlength h) h))); omega. }
        { eapply Forall_Znth with (i0 := i) in Hl1; [|rewrite Zlength_sublist; omega].
          rewrite Znth_sublist, Z.add_0_r, Hhi in Hl1 by omega; auto. }
      * rewrite make_map_nil with (h := sublist l _ _), app_nil_r; auto; simpl.
        apply incl_app; [apply incl_appl | apply incl_appr; constructor; simpl in *; tauto].
        rewrite sublist_split with (mid := l)(hi := i) by omega.
        rewrite make_map_app.
        apply incl_appl; auto.
        { replace l with (Z.min l (Z.max (i + 1) l)).
          rewrite <- sublist_prefix; apply Forall_sublist; auto.
          { apply Z.min_l, Zmax_bound_r, Z.le_refl. } }
        { eapply Forall_sublist, Forall_impl, Hwf'; tauto. }
      * apply make_map_no_key.
        rewrite Forall_forall; intros ? Hin.
        rewrite Forall_forall in Hl1; specialize (Hl1 x).
        exploit (Forall2_In_l _ x _ _ Hfail).
        { rewrite Z.min_comm, <- sublist_prefix in Hin; eapply sublist_In; eauto. }
        intros (? & ? & ? & r1 & ? & ? & ? & ? & ? & Heq); simpl in *; subst.
        rewrite Heq; simpl.
        intro; absurd (r1 = Int.repr k); auto.
        apply signed_inj; auto.
        rewrite Int.signed_repr; auto.
        { apply Hl1.
          rewrite <- sublist_prefix in Hin; eapply sublist_In; eauto. }
  - rewrite index_of_iff_out in Hindex.
    destruct Hi2 as [(? & ? & Hi2) | (? & ? & ? & Hi2)]; subst r.
    clear Hh'.
    assert (value_of_hist hk = vint 0) as Hz.
    { destruct (eq_dec (value_of_hist hk) (vint 0)); auto. }
    destruct (zlt i l).
    { eapply Forall_Znth with (i0 := i) in Hl1; [|rewrite Zlength_sublist; omega].
      rewrite Znth_sublist, Z.add_0_r, Hhi in Hl1 by omega; contradiction Hl1. }
    split; [omega|].
    assert (0 <= i <= Zlength h' /\
      Forall (fun x => value_of_hist (fst x) <> vint 0) (sublist 0 i h') /\
      Forall (fun x => value_of_hist (fst x) = vint 0) (sublist i (Zlength h') h'))
      as (? & Hl1' & Hl2'); [|split; split; auto].
    + split; [omega|]; split.
      * rewrite Forall_forall; intros.
        exploit (Forall2_In_r (failed_load k)); eauto.
        intros ((?, ?) & ? & ? & r1 & ? & -> & ? & ? & ? & ?); simpl in *; subst.
        unfold value_of_hist; rewrite last_snoc; simpl.
        intro X; absurd (r1 = Int.zero); auto; inv X; auto.
      * erewrite sublist_next by omega; constructor;
          [rewrite Hi1; unfold value_of_hist; rewrite last_snoc; auto|].
        rewrite <- Hrest.
        replace (i + 1) with (i + 1 - l + l) by (apply Z.sub_simpl_r).
        rewrite <- sublist_suffix by omega; apply Forall_sublist; auto.
    + replace h with (sublist 0 l h ++ sublist l (Zlength h) h)
        by (rewrite sublist_rejoin, sublist_same; auto; omega).
      replace h' with (sublist 0 l h' ++ sublist l (Zlength h') h')
        by (rewrite sublist_rejoin, sublist_same; auto; omega).
      rewrite make_map_drop, make_map_app; auto.
      apply incl_appl; erewrite make_map_eq; [apply incl_refl|].
      rewrite Forall2_eq_upto with (d1 := ([] : hist, [] : hist))(d2 := ([] : hist, [] : hist)).
      split; [rewrite !Zlength_sublist; auto; omega|].
      rewrite Forall_forall; intros ? Hin.
      rewrite In_upto, Z2Nat.id in Hin by (apply Zlength_nonneg).
      assert (value_of_hist (fst (Znth x (sublist 0 l h) ([], []))) <> vint 0) as Hnz.
      { apply Forall_Znth; auto. }
      rewrite Zlength_sublist, Z.sub_0_r in Hin by (auto; omega).
      assert (x < i) by omega.
      exploit (Forall2_Znth _ _ _ ([], []) ([], []) Hfail x); auto.
      { rewrite Zlength_sublist; omega. }
      intros (? & r1 & ? & Heq1 & ? & ? & Heq2 & Hv).
      rewrite !Znth_sublist, Z.add_0_r in Heq1, Heq2, Hv, Hnz; auto; try omega.
      rewrite !Znth_sublist, Z.add_0_r in Heq1, Heq2 by omega.
      rewrite !Znth_sublist, Z.add_0_r by omega.
      rewrite Heq1, Heq2; simpl; split; auto.
      unfold value_of_hist at 2; rewrite last_snoc; auto.
      { replace l with (Z.min l i) by (apply Z.min_l; omega).
        rewrite <- sublist_prefix; apply Forall_sublist; auto. }
      { eapply Forall_sublist, Forall_impl, Hwf'; tauto. }
    + contradiction Hindex.
      assert (Forall (fun x => value_of_hist (fst x) <> vint 0) (sublist 0 i h' ++ [Znth i h' ([], [])])).
      { rewrite Forall_app; split; auto; repeat constructor.
        rewrite Hi1; unfold value_of_hist; rewrite last_snoc; auto. }
      assert (Forall (fun x => Forall int_op (map snd (fst x))) (sublist 0 (i + 1) h')) as Hints.
      { eapply Forall_sublist, Forall_impl, Hwf'; tauto. }
      rewrite in_map_iff; exists (Znth i (make_map h') (0, 0)); split.
      * rewrite Znth_make_map; auto; simpl.
        rewrite Hi1; unfold value_of_hist; rewrite last_snoc; simpl.
        rewrite Int.signed_repr; auto.
        { omega. }
        { erewrite sublist_split with (mid := i), sublist_len_1 by omega; eauto. }
      * apply Znth_In.
        rewrite Hh'.
        change (Znth i h' ([], []) :: _) with ([Znth i h' ([], [])] ++ sublist (i + 1) (Zlength h') h').
        erewrite sublist_split with (mid := i), sublist_len_1 in Hints by omega.
        rewrite app_assoc, make_map_app, Zlength_app, make_map_length, Zlength_app, Zlength_sublist,
          Zlength_cons, Zlength_nil by (eauto; omega).
        pose proof (Zlength_nonneg (make_map (sublist (i + 1) (Zlength h') h'))); omega.
Qed.

(* Read the most recently written value. *)
Definition get_item_spec :=
 DECLARE _get_item
  WITH key : Z, p : val, sh : share, entries : list val, h : list (hist * hist), l : Z
  PRE [ _key OF tint, _value OF tint ]
   PROP (repable_signed key; readable_share sh; key <> 0; Forall isptr entries; Zlength h = 20; wf_hists h l)
   LOCAL (temp _key (vint key); gvar _m_entries p)
   SEP (data_at sh (tarray (tptr tentry) 20) entries p;
        fold_right_sepcon (map (atomic_entry sh) entries);
        entry_hists entries h)
  POST [ tint ]
   EX value : Z, EX i : Z, EX h' : list (hist * hist),
   PROP (repable_signed value; get_item_trace h key value i h')
   LOCAL (temp ret_temp (vint value))
   SEP (data_at sh (tarray (tptr tentry) 20) entries p;
        fold_right_sepcon (map (atomic_entry sh) entries);
        entry_hists entries h').

Definition Gprog : funspecs := ltac:(with_library prog [surely_malloc_spec; atomic_CAS_spec; atomic_load_spec;
  atomic_store_spec; set_item_spec; get_item_spec]).

Lemma body_surely_malloc: semax_body Vprog Gprog f_surely_malloc surely_malloc_spec.
Proof.
  start_function.
  forward_call n.
  Intros p.
  forward_if
  (PROP ( )
   LOCAL (temp _p p)
   SEP (malloc_token Tsh n p * memory_block Tsh n p)).
  - if_tac; entailer!.
  - forward_call tt.
    contradiction.
  - if_tac.
    + forward. subst p. discriminate.
    + Intros. forward. entailer!.
  - forward. Exists p; entailer!.
Qed.

Opaque upto.

Ltac cancel_for_forward_call ::= repeat (rewrite ?sepcon_andp_prop', ?sepcon_andp_prop);
  repeat (apply andp_right; [auto; apply prop_right; auto|]); fast_cancel.

Ltac entailer_for_return ::= go_lower; entailer'.

Lemma apply_int_ops : forall v h i (Hv : verif_atomics.apply_hist (Vint i) h = Some v)
  (Hints : Forall int_op h), tc_val tint v.
Proof.
  induction h; simpl; intros.
  - inv Hv; eauto.
  - inversion Hints as [|?? Ha]; subst.
    destruct a.
    + destruct (eq_dec v0 (Vint i)); [eapply IHh; eauto | discriminate].
    + destruct v0; try contradiction; eapply IHh; eauto.
    + destruct (eq_dec r (Vint i)); [|discriminate].
      destruct Ha as (? & ? & ?).
      destruct w; try contradiction.
      destruct (eq_dec c (Vint i)); eapply IHh; eauto.
Qed.

Lemma failed_CAS_fst : forall v h h', Forall2 (failed_CAS v) h h' -> map snd h' = map snd h.
Proof.
  induction 1; auto.
  destruct H as (? & ? & ? & ? & ? & ? & ? & ?); simpl; f_equal; auto.
Qed.

Lemma body_set_item : semax_body Vprog Gprog f_set_item set_item_spec.
Proof.
  start_function.
  forward.
  eapply semax_pre with (P' := EX i : Z, EX h' : list (hist * hist),
    PROP (0 <= i < 20; Forall2 (failed_CAS key) (sublist 0 i h) (sublist 0 i h');
          sublist i (Zlength h) h = sublist i (Zlength h') h')
    LOCAL (temp _idx (vint i); temp _key (vint key); temp _value (vint value); gvar _m_entries p)
    SEP (data_at sh (tarray (tptr tentry) 20) entries p; fold_right_sepcon (map (atomic_entry sh) entries);
         entry_hists entries h')).
  { Exists 0 h; rewrite sublist_nil; entailer!. }
  eapply semax_loop.
  - Intros i h'; forward.
    assert (Zlength h' = Zlength h) as Hlen.
    { assert (Zlength (sublist i (Zlength h) h) = Zlength (sublist i (Zlength h') h')) as Heq
        by (replace (sublist i (Zlength h) h) with (sublist i (Zlength h') h'); auto).
      rewrite !Zlength_sublist in Heq; try omega.
      destruct (Z_le_dec i (Zlength h')); [omega|].
      unfold sublist in Heq.
      rewrite Z2Nat_neg in Heq by omega.
      simpl in Heq; rewrite Zlength_nil in Heq; omega. }
    assert (i <= Zlength h') by omega.
    assert (map snd h' = map snd h) as Hsnd.
    { erewrite <- sublist_same with (al := h') by eauto.
      erewrite <- sublist_same with (al := h) by eauto.
      rewrite sublist_split with (al := h')(mid := i) by omega.
      rewrite sublist_split with (al := h)(mid := i) by omega.
      rewrite Hlen in *; rewrite !map_app; f_equal; [|congruence].
      eapply failed_CAS_fst; eauto. }
    assert_PROP (Zlength entries = 20) by entailer!.
    assert (0 <= i < Zlength entries) by (replace (Zlength entries) with 20; auto).
    forward.
    { entailer!.
      apply isptr_is_pointer_or_null, Forall_Znth; auto. }
    rewrite extract_nth_sepcon with (i := i), Znth_map with (d' := Vundef); try rewrite Zlength_map; auto.
    unfold entry_hists; erewrite extract_nth_sepcon with (i := i)(l := map _ _), Znth_map, Znth_upto; simpl;
      auto; try omega.
    unfold atomic_entry; Intros lkey lval.
    rewrite atomic_loc_isptr.
    forward.
    forward.
    destruct (Znth i h' ([], [])) as (hki, hvi) eqn: Hhi.
    forward_call (Tsh, sh, field_address tentry [StructField _key] (Znth i entries Vundef), lkey, vint 0,
      vint key, vint 0, hki,
      fun (h : hist) c v => !!(c = vint 0 /\ v = vint key /\ h = hki) && emp,
      k_R,
      fun (h : hist) (v : val) => !!(forall v0, last_value hki v0 -> v0 <> vint 0 -> v = v0) && emp).
(* Given that I have to do this, maybe better to remove the arguments from P. *)
    { entailer!.
      rewrite field_address_offset; simpl.
      rewrite isptr_offset_val_zero; auto.
      { rewrite field_compatible_cons; simpl.
        split; [unfold in_members; simpl|]; auto. } }
    { repeat (split; auto).
      intros ?????????????? Ha.
      unfold k_R in *; simpl in *.
      eapply semax_pre, Ha.
      go_lowerx; entailer!.
      repeat split.
      + rewrite Forall_app; repeat constructor; auto.
        apply apply_int_ops in Hvx; auto.
      + intros ? Hin; rewrite in_app in Hin.
        destruct Hin as [? | [? | ?]]; [| |contradiction].
        * intros.
          replace vx with (value_of e) by (symmetry; auto).
          if_tac; auto; absurd (value_of e = vint 0); auto.
        * subst; simpl; intros.
          if_tac; if_tac; auto; absurd (vx = vint 0); auto.
      + intros ? [(? & ?) | (? & ? & Hin & ? & ?)] Hn; [contradiction Hn; auto|].
        specialize (Hhist _ _ Hin); apply nth_error_In in Hhist; subst; auto.
      + apply andp_right; auto.
        eapply derives_trans, precise_weak_precise, precise_andp2; auto. }
    Intros x; destruct x as (t, v); simpl in *.
    destruct v; try contradiction.
    match goal with |- semax _ (PROP () (LOCALx ?Q (SEPx ?R))) _ _ =>
      forward_if (PROP () (LOCALx (temp _t'2 (vint (if eq_dec i0 Int.zero then 1
        else if eq_dec i0 (Int.repr key) then 1 else 0)) :: Q) (SEPx R))) end.
    { forward.
      subst; rewrite eq_dec_refl; apply drop_tc_environ. }
    { forward.
      destruct (eq_dec i0 Int.zero); [absurd (i0 = Int.repr 0); auto|].
      simpl force_val.
      destruct (eq_dec i0 (Int.repr key)).
      + subst; rewrite Int.eq_true; apply drop_tc_environ.
      + rewrite Int.eq_false; [apply drop_tc_environ | auto]. }
    assert (Znth i h ([], []) = Znth i h' ([], []) /\
      sublist (i + 1) (Zlength h) h = sublist (i + 1) (Zlength h') h') as (Heq & Hi1).
    { match goal with H : sublist _ _ h = sublist _ _ h' |- _ =>
        erewrite sublist_next with (d := ([] : hist, [] : hist)),
                 sublist_next with (l0 := h')(d := ([] : hist, [] : hist)) in H by omega; inv H; auto end. }
    assert (ordered_hist hki).
    { match goal with H : wf_hists h l |- _ => destruct H as (Hwf & _) end.
      eapply Forall_Znth with (i1 := i) in Hwf; [|omega].
      rewrite Heq, Hhi in Hwf; tauto. }
    match goal with |- semax _ (PROP () (LOCALx ?Q (SEPx ?R))) _ _ =>
      forward_if (PROP (i0 <> Int.zero /\ i0 <> Int.repr key) (LOCALx Q (SEPx R))) end.
    + rewrite (atomic_loc_isptr _ lval).
      forward.
      forward.
      forward_call (Tsh, sh, field_address tentry [StructField _value] (Znth i entries Vundef), lval,
        vint value, vint 0, hvi, fun (h : hist) v => !!(v = vint value) && emp,
        v_R, fun (h : hist) => emp).
      { entailer!.
        rewrite field_address_offset; auto.
        { rewrite field_compatible_cons; simpl.
          split; [unfold in_members; simpl|]; auto. } }
      { repeat (split; auto).
        intros ????????????? Ha.
        unfold v_R in *; simpl in *.
        eapply semax_pre, Ha.
        go_lowerx; entailer!.
        apply andp_right; auto.
        eapply derives_trans, precise_weak_precise; auto. }
      Intros t'.
      forward.
      Exists i (upd_Znth i h' (fst (Znth i h' ([], [])) ++ [(t, CAS (Vint i0) (vint 0) (vint key))],
        snd (Znth i h' ([], [])) ++ [(t', Store (vint value))])).
      apply andp_right; auto.
      apply andp_right.
      { apply prop_right; split; auto.
        split; [omega|].
        rewrite Heq, Hhi; simpl.
        split; [rewrite sublist_upd_Znth_l; auto; omega|].
        split.
        - rewrite upd_Znth_same by omega.
          repeat eexists; eauto.
          + destruct (eq_dec i0 Int.zero); subst; auto.
            destruct (eq_dec i0 (Int.repr key)); subst; auto.
            absurd (Int.zero = Int.zero); auto.
          + match goal with H : forall v0, last_value hki v0 -> v0 <> vint 0 -> Vint i0 = v0 |- _ =>
              symmetry; apply H; auto end.
            rewrite ordered_last_value; auto.
        - rewrite upd_Znth_Zlength by omega.
          rewrite sublist_upd_Znth_r; auto; omega. }
      apply andp_right; auto.
      fast_cancel.
      rewrite (sepcon_comm (ghost_hist _ _)).
      rewrite (sepcon_comm (ghost_hist _ _)).
      rewrite !sepcon_assoc, <- 4sepcon_assoc; apply sepcon_derives.
      * rewrite replace_nth_sepcon; apply sepcon_list_derives.
        { rewrite upd_Znth_Zlength; rewrite !Zlength_map; auto. }
        rewrite upd_Znth_Zlength; rewrite !Zlength_map; auto; intros.
        destruct (eq_dec i1 i).
        subst; rewrite upd_Znth_same by (rewrite Zlength_map; auto).
        rewrite Znth_map with (d' := Vundef) by auto.
        unfold atomic_entry.
        Exists lkey lval; entailer!.
        { rewrite upd_Znth_diff; rewrite ?Zlength_map; auto. }
      * rewrite sepcon_comm, replace_nth_sepcon.
        assert (0 <= i < Zlength h') by omega.
        apply sepcon_list_derives.
        { rewrite upd_Znth_Zlength; rewrite !Zlength_map; auto. }
        rewrite upd_Znth_Zlength; rewrite !Zlength_map; auto; intros.
        destruct (eq_dec i1 i).
        subst; rewrite upd_Znth_same by (rewrite Zlength_map; auto).
        erewrite Znth_map, Znth_upto; simpl; auto; try omega.
        rewrite upd_Znth_same, Hhi; auto; simpl.
        { rewrite upd_Znth_diff; auto.
          rewrite Zlength_upto in *.
          erewrite !Znth_map, !Znth_upto; auto; try omega.
          rewrite upd_Znth_diff; auto.
          match goal with H : Zlength h' = _ |- _ => setoid_rewrite H; simpl in *; omega end. }
    + forward.
      destruct (eq_dec i0 Int.zero); [discriminate|].
      destruct (eq_dec i0 (Int.repr key)); [discriminate|].
      entailer!.
    + intros.
      unfold exit_tycon, overridePost.
      destruct (eq_dec ek EK_normal); [subst | apply drop_tc_environ].
      Intros; unfold POSTCONDITION, abbreviate, normal_ret_assert, loop1_ret_assert.
      instantiate (1 := EX i : Z, EX h' : list (hist * hist),
        PROP (0 <= i < 20; Forall2 (failed_CAS key) (sublist 0 (i + 1) h) (sublist 0 (i + 1) h');
              sublist (i + 1) (Zlength h) h = sublist (i + 1) (Zlength h') h')
        LOCAL (temp _idx (vint i); temp _key (vint key); temp _value (vint value); gvar _m_entries p)
        SEP (data_at sh (tarray (tptr tentry) 20) entries p; fold_right_sepcon (map (atomic_entry sh) entries);
             entry_hists entries h')).
      Exists i (upd_Znth i h' (fst (Znth i h' ([], [])) ++ [(t, CAS (Vint i0) (vint 0) (vint key))],
        snd (Znth i h' ([], [])))).
      go_lower.
      apply andp_right.
      { assert (0 <= i < Zlength h') by (rewrite Hlen; omega).
        apply prop_right; repeat (split; auto).
        * erewrite sublist_split, sublist_len_1 with (i1 := i); try omega.
          erewrite sublist_split with (hi := i + 1), sublist_len_1 with (i1 := i)(d := ([] : hist, [] : hist));
            rewrite ?upd_Znth_Zlength; try omega.
          rewrite sublist_upd_Znth_l by omega.
          rewrite upd_Znth_same by omega.
          apply Forall2_app; auto.
          constructor; auto.
          unfold failed_CAS; simpl.
          rewrite Heq, Hhi; repeat eexists; eauto.
          match goal with H : forall v0, last_value hki v0 -> v0 <> vint 0 -> Vint i0 = v0 |- _ =>
            symmetry; apply H; auto end.
          rewrite ordered_last_value; auto.
        * rewrite upd_Znth_Zlength by omega.
          rewrite sublist_upd_Znth_r by omega; auto. }
      apply andp_right; [apply prop_right; auto|].
      fast_cancel.
      rewrite (sepcon_comm (ghost_hist _ _)).
      rewrite !sepcon_assoc, <- 4sepcon_assoc; apply sepcon_derives.
      * rewrite replace_nth_sepcon; apply sepcon_list_derives.
        { rewrite upd_Znth_Zlength; rewrite !Zlength_map; auto. }
        rewrite upd_Znth_Zlength; rewrite !Zlength_map; auto; intros.
        destruct (eq_dec i1 i).
        subst; rewrite upd_Znth_same by (rewrite Zlength_map; auto).
        rewrite Znth_map with (d' := Vundef) by auto.
        unfold atomic_entry.
        Exists lkey lval; entailer!.
        { rewrite upd_Znth_diff; rewrite ?Zlength_map; auto. }
      * rewrite (sepcon_comm _ (ghost_hist _ _)), <- sepcon_assoc, replace_nth_sepcon.
        assert (0 <= i < Zlength h') by omega.
        apply sepcon_list_derives.
        { rewrite upd_Znth_Zlength; rewrite !Zlength_map; auto. }
        rewrite upd_Znth_Zlength; rewrite !Zlength_map; auto; intros.
        destruct (eq_dec i1 i).
        subst; rewrite upd_Znth_same by (rewrite Zlength_map; auto).
        erewrite Znth_map, Znth_upto; simpl; auto; try omega.
        rewrite upd_Znth_same; auto; simpl.
        setoid_rewrite Hhi.
        rewrite sepcon_comm; auto.
        { rewrite upd_Znth_diff; auto.
          rewrite Zlength_upto in *.
          erewrite !Znth_map, !Znth_upto; auto; try omega.
          rewrite upd_Znth_diff; auto.
          setoid_rewrite Hlen; simpl in *; omega. }
  - Intros i h'.
    forward.
    unfold loop2_ret_assert.
    Exists (i + 1) h'; entailer!.
    admit. (* list is long enough *)
Admitted.

Lemma failed_load_fst : forall v h h', Forall2 (failed_load v) h h' -> map snd h' = map snd h.
Proof.
  induction 1; auto.
  destruct H as (? & ? & ? & ? & ? & ? & ? & ?); simpl; f_equal; auto.
Qed.

Lemma body_get_item : semax_body Vprog Gprog f_get_item get_item_spec.
Proof.
  start_function.
  forward.
  eapply semax_pre with (P' := EX i : Z, EX h' : list (hist * hist),
    PROP (0 <= i < 20; Forall2 (failed_load key) (sublist 0 i h) (sublist 0 i h');
          sublist i (Zlength h) h = sublist i (Zlength h') h')
    LOCAL (temp _idx (vint i); temp _key (vint key); gvar _m_entries p)
    SEP (data_at sh (tarray (tptr tentry) 20) entries p; fold_right_sepcon (map (atomic_entry sh) entries);
         entry_hists entries h')).
  { Exists 0 h; rewrite sublist_nil; entailer!. }
  eapply semax_loop.
  - Intros i h'; forward.
    assert_PROP (Zlength entries = 20) by entailer!.
    assert (0 <= i < Zlength entries) by (replace (Zlength entries) with 20; auto).
    forward.
    { entailer!.
      apply isptr_is_pointer_or_null, Forall_Znth; auto. }
    rewrite extract_nth_sepcon with (i := i), Znth_map with (d' := Vundef); try rewrite Zlength_map; auto.
    unfold entry_hists; erewrite extract_nth_sepcon with (i := i)(l := map _ _), Znth_map, Znth_upto; simpl; auto;
      try omega.
    unfold atomic_entry; Intros lkey lval.
    rewrite atomic_loc_isptr.
    forward.
    forward.
    assert (Zlength h' = Zlength h) as Hlen.
    { assert (Zlength (sublist i (Zlength h) h) = Zlength (sublist i (Zlength h') h')) as Heq
        by (replace (sublist i (Zlength h) h) with (sublist i (Zlength h') h'); auto).
      rewrite !Zlength_sublist in Heq; try omega.
      destruct (Z_le_dec i (Zlength h')); [omega|].
      unfold sublist in Heq.
      rewrite Z2Nat_neg in Heq by omega.
      simpl in Heq; rewrite Zlength_nil in Heq; omega. }
    assert (i < Zlength h') by omega.
    assert (map snd h' = map snd h) as Hsnd.
    { erewrite <- sublist_same with (al := h') by eauto.
      erewrite <- sublist_same with (al := h) by eauto.
      rewrite sublist_split with (al := h')(mid := i) by omega.
      rewrite sublist_split with (al := h)(mid := i) by omega.
      rewrite Hlen in *; rewrite !map_app; f_equal; [|congruence].
      eapply failed_load_fst; eauto. }
    destruct (Znth i h' ([], [])) as (hki, hvi) eqn: Hhi.
    forward_call (Tsh, sh, field_address tentry [StructField _key] (Znth i entries Vundef), lkey, vint 0,
      hki, fun h => !!(h = hki) && emp, k_R,
      fun (h : hist) (v : val) => !!(forall v0, last_value hki v0 -> v0 <> vint 0 -> v = v0) && emp).
    { entailer!.
      rewrite field_address_offset; simpl.
      rewrite isptr_offset_val_zero; auto.
      { rewrite field_compatible_cons; simpl.
        split; [unfold in_members; simpl|]; auto. } }
    { repeat (split; auto).
      intros ???????????? Ha.
      unfold k_R in *; simpl in *.
      eapply semax_pre, Ha.
      go_lowerx; entailer!.
      repeat split.
      + rewrite Forall_app; repeat constructor; auto.
        apply apply_int_ops in Hvx; auto.
      + intros ? Hin; rewrite in_app in Hin.
        destruct Hin as [? | [? | ?]]; subst; auto; contradiction.
      + intros ? [(? & ?) | (? & ? & Hin & ? & ?)] Hn; [contradiction Hn; auto|].
        specialize (Hhist _ _ Hin); apply nth_error_In in Hhist; subst; auto.
      + apply andp_right; auto.
        eapply derives_trans, precise_weak_precise, precise_andp2; auto. }
    Intros x; destruct x as (t, v); simpl in *.
    destruct v; try contradiction.
    assert (Zlength h' = Zlength h).
    { assert (Zlength (sublist i (Zlength h) h) = Zlength (sublist i (Zlength h') h')) as Heq
        by (replace (sublist i (Zlength h) h) with (sublist i (Zlength h') h'); auto).
      rewrite !Zlength_sublist in Heq; omega. }
    assert (Znth i h ([], []) = Znth i h' ([], []) /\
      sublist (i + 1) (Zlength h) h = sublist (i + 1) (Zlength h') h') as (Heq & Hi1).
    { match goal with H : sublist _ _ h = sublist _ _ h' |- _ =>
        erewrite sublist_next with (d := ([] : hist, [] : hist)),
                 sublist_next with (l0 := h')(d := ([] : hist, [] : hist)) in H by omega; inv H; auto end. }
    assert (ordered_hist hki).
    { match goal with H : wf_hists h l |- _ => destruct H as (Hwf & _) end.
      eapply Forall_Znth with (i1 := i) in Hwf; [|omega].
      rewrite Heq, Hhi in Hwf; tauto. }
    match goal with |- semax _ (PROP () (LOCALx ?Q (SEPx ?R))) _ _ =>
      forward_if (PROP (i0 <> Int.repr key) (LOCALx Q (SEPx R))) end.
    + rewrite (atomic_loc_isptr _ lval).
      forward.
      forward.
      forward_call (Tsh, sh, field_address tentry [StructField _value] (Znth i entries Vundef), lval, vint 0,
        snd (Znth i h' ([], [])), fun (h : hist) => emp, v_R, fun (h : hist) (v : val) => emp).
      { entailer!.
        rewrite field_address_offset; auto.
        { rewrite field_compatible_cons; simpl.
          split; [unfold in_members; simpl|]; auto. } }
      { rewrite Hhi; fast_cancel. }
      { repeat (split; auto).
        intros ???????????? Ha.
        unfold v_R in *; simpl in *.
        eapply semax_pre, Ha.
        go_lowerx; entailer!.
        apply andp_right; auto.
        eapply derives_trans, precise_weak_precise; auto. }
      Intros x; destruct x as (t', v); simpl in *.
      forward.
      Exists (Int.signed v) i (upd_Znth i h' (fst (Znth i h' ([], [])) ++ [(t, Load (vint key))],
        snd (Znth i h' ([], [])) ++ [(t', Load (Vint v))])).
      apply andp_right.
      { apply prop_right.
        split; [apply Int.signed_range|].
        split; auto.
        split; [omega|].
        split; [|split].
        - rewrite sublist_upd_Znth_l; auto; omega.
        - rewrite upd_Znth_same by omega.
          rewrite Heq, Hhi in *; simpl in *.
          rewrite Int.repr_signed.
          do 3 eexists; eauto.
          split; eauto.
          split; eauto.
          match goal with H : forall v0, last_value hki v0 -> v0 <> vint 0 -> vint key = v0 |- _ =>
            symmetry; apply H; auto end.
          rewrite ordered_last_value; auto.
        - rewrite upd_Znth_Zlength by omega.
          rewrite sublist_upd_Znth_r by omega; auto. }
      apply andp_right; [apply prop_right; rewrite Int.repr_signed; auto|].
      fast_cancel.
      rewrite (sepcon_comm (ghost_hist _ _)).
      rewrite (sepcon_comm (ghost_hist _ _)).
      rewrite !sepcon_assoc, <- 4sepcon_assoc; apply sepcon_derives.
      * rewrite replace_nth_sepcon; apply sepcon_list_derives.
        { rewrite upd_Znth_Zlength; rewrite !Zlength_map; auto. }
        rewrite upd_Znth_Zlength; rewrite !Zlength_map; auto; intros.
        destruct (eq_dec i0 i).
        subst; rewrite upd_Znth_same by (rewrite Zlength_map; auto).
        rewrite Znth_map with (d' := Vundef) by auto.
        unfold atomic_entry.
        Exists lkey lval; entailer!.
        { rewrite upd_Znth_diff; rewrite ?Zlength_map; auto. }
      * rewrite sepcon_comm, replace_nth_sepcon.
        assert (0 <= i < Zlength h') by omega.
        rewrite Hhi; apply sepcon_list_derives.
        { rewrite upd_Znth_Zlength; rewrite !Zlength_map; auto. }
        rewrite upd_Znth_Zlength; rewrite !Zlength_map; auto; intros.
        destruct (eq_dec i0 i).
        subst; rewrite upd_Znth_same by (rewrite Zlength_map; auto).
        erewrite Znth_map, Znth_upto; simpl; auto; try omega.
        rewrite upd_Znth_same; auto; simpl.
        { rewrite upd_Znth_diff; auto.
          rewrite Zlength_upto in *.
          erewrite !Znth_map, !Znth_upto; auto; try omega.
          rewrite upd_Znth_diff; auto.
          simpl in *; omega. }
    + forward.
      entailer!.
    + Intros; match goal with |- semax _ (PROP () (LOCALx ?Q (SEPx ?R))) _ _ =>
        forward_if (PROP (i0 <> Int.zero) (LOCALx Q (SEPx R))) end.
      * forward.
        Exists 0 i (upd_Znth i h' (fst (Znth i h' ([], [])) ++ [(t, Load (vint 0))], snd (Znth i h' ([], [])))).
        apply andp_right.
        { apply prop_right.
          split; [split; computable|].
          split; auto.
          split; [omega|].
          split; [|split].
          * rewrite sublist_upd_Znth_l; auto; omega.
          * rewrite upd_Znth_same by omega.
            rewrite Heq, Hhi in *; simpl in *.
            do 3 eexists; eauto.
            split; eauto.
            split; eauto.
            match goal with H : forall v0, last_value hki v0 -> v0 <> vint 0 -> vint 0 = v0 |- _ =>
              symmetry; apply H; auto end.
            rewrite ordered_last_value; auto.
          * rewrite upd_Znth_Zlength by omega.
            rewrite sublist_upd_Znth_r; auto; omega. }
        apply andp_right; [apply prop_right; auto|].
        fast_cancel.
        rewrite (sepcon_comm (ghost_hist _ _)).
        rewrite (sepcon_comm (ghost_hist _ _)).
        rewrite !sepcon_assoc, <- 4sepcon_assoc; apply sepcon_derives.
        -- rewrite replace_nth_sepcon; apply sepcon_list_derives.
           { rewrite upd_Znth_Zlength; rewrite !Zlength_map; auto. }
           rewrite upd_Znth_Zlength; rewrite !Zlength_map; auto; intros.
           destruct (eq_dec i0 i).
           subst; rewrite upd_Znth_same by (rewrite Zlength_map; auto).
           rewrite Znth_map with (d' := Vundef) by auto.
           unfold atomic_entry.
           Exists lkey lval; entailer!.
           { rewrite upd_Znth_diff; rewrite ?Zlength_map; auto. }
        -- rewrite sepcon_comm, replace_nth_sepcon.
           assert (0 <= i < Zlength h') by omega.
           rewrite Hhi; apply sepcon_list_derives.
           { rewrite upd_Znth_Zlength; rewrite !Zlength_map; auto. }
           rewrite upd_Znth_Zlength; rewrite !Zlength_map; auto; intros.
           destruct (eq_dec i0 i).
           subst; rewrite upd_Znth_same by (rewrite Zlength_map; auto).
           erewrite Znth_map, Znth_upto; simpl; auto; try omega.
           rewrite upd_Znth_same; auto; simpl.
           rewrite sepcon_comm; auto.
           { rewrite upd_Znth_diff; auto.
             rewrite Zlength_upto in *.
             erewrite !Znth_map, !Znth_upto; auto; try omega.
             rewrite upd_Znth_diff; auto.
             simpl in *; omega. }
      * forward.
        entailer!.
      * intros.
        unfold exit_tycon, overridePost.
        destruct (eq_dec ek EK_normal); [subst | apply drop_tc_environ].
        Intros; unfold POSTCONDITION, abbreviate, normal_ret_assert, loop1_ret_assert.
        instantiate (1 := EX i : Z, EX h' : list (hist * hist),
          PROP (0 <= i < 20; Forall2 (failed_load key) (sublist 0 (i + 1) h) (sublist 0 (i + 1) h');
                sublist (i + 1) (Zlength h) h = sublist (i + 1) (Zlength h') h')
          LOCAL (temp _idx (vint i); temp _key (vint key); gvar _m_entries p)
          SEP (data_at sh (tarray (tptr tentry) 20) entries p; fold_right_sepcon (map (atomic_entry sh) entries);
               entry_hists entries h')).
        Exists i (upd_Znth i h' (fst (Znth i h' ([], [])) ++ [(t, Load (Vint i0))], snd (Znth i h' ([], [])))).
        go_lower.
        apply andp_right.
        { apply prop_right; repeat (split; auto).
          * erewrite sublist_split, sublist_len_1 with (i1 := i); try omega.
            erewrite sublist_split with (hi := i + 1), sublist_len_1 with (i1 := i)(d := ([] : hist, [] : hist));
              rewrite ?upd_Znth_Zlength; try omega.
            rewrite sublist_upd_Znth_l by omega.
            rewrite upd_Znth_same by omega.
            apply Forall2_app; auto.
            constructor; auto.
            unfold failed_load; simpl.
            rewrite Heq, Hhi; repeat eexists; eauto.
            match goal with H : forall v0, last_value hki v0 -> v0 <> vint 0 -> Vint i0 = v0 |- _ =>
              symmetry; apply H; auto end.
            rewrite ordered_last_value; auto.
          * rewrite upd_Znth_Zlength by omega.
            rewrite sublist_upd_Znth_r by omega; auto. }
        apply andp_right; [apply prop_right; auto|].
        fast_cancel.
        rewrite (sepcon_comm (ghost_hist _ _)).
        rewrite !sepcon_assoc, <- 4sepcon_assoc; apply sepcon_derives.
        -- rewrite replace_nth_sepcon; apply sepcon_list_derives.
           { rewrite upd_Znth_Zlength; rewrite !Zlength_map; auto. }
          rewrite upd_Znth_Zlength; rewrite !Zlength_map; auto; intros.
          destruct (eq_dec i1 i).
          subst; rewrite upd_Znth_same by (rewrite Zlength_map; auto).
           rewrite Znth_map with (d' := Vundef) by auto.
          unfold atomic_entry.
          Exists lkey lval; entailer!.
          { rewrite upd_Znth_diff; rewrite ?Zlength_map; auto. }
        -- rewrite (sepcon_comm _ (ghost_hist _ _)), <- sepcon_assoc, replace_nth_sepcon.
           assert (0 <= i < Zlength h') by omega.
           rewrite Hhi; apply sepcon_list_derives.
           { rewrite upd_Znth_Zlength; rewrite !Zlength_map; auto. }
           rewrite upd_Znth_Zlength; rewrite !Zlength_map; auto; intros.
           destruct (eq_dec i1 i).
           subst; rewrite upd_Znth_same by (rewrite Zlength_map; auto).
           erewrite Znth_map, Znth_upto; simpl; auto; try omega.
           rewrite upd_Znth_same; auto; simpl.
           rewrite sepcon_comm; auto.
           { rewrite upd_Znth_diff; auto.
             rewrite Zlength_upto in *.
             erewrite !Znth_map, !Znth_upto; auto; try omega.
             rewrite upd_Znth_diff; auto.
             match goal with H : Zlength h' = _ |- _ => setoid_rewrite H; simpl in *; omega end. }
  - Intros i h'.
    forward.
    unfold loop2_ret_assert.
    Exists (i + 1) h'; entailer!.
    admit. (* list is long enough *)
Admitted.


(* Distributed under the terms of the MIT license. *)
Require Import ssreflect Morphisms.
From MetaCoq.Utils Require Import utils.
From MetaCoq.PCUIC Require Import PCUICAst PCUICAstUtils PCUICInduction.
Import Nat.

(** * Commutation lemmas for the lifting and substitution operations.
  Definition of [closedn] (boolean) predicate for checking if
  a term is closed. *)

Derive Signature for Peano.le.

(** Assumptions contexts do not contain let-ins. *)

Inductive assumption_context : context -> Prop :=
| assumption_context_nil : assumption_context []
| assumption_context_vass na t Γ : assumption_context Γ -> assumption_context (vass na t :: Γ).

Derive Signature for assumption_context.

Create HintDb terms.

Ltac arith_congr := repeat (try lia; progress f_equal).

Ltac easy0 :=
  let rec use_hyp H :=
   (match type of H with
    | _ /\ _ => exact H || destruct_hyp H
    | _ * _ => exact H || destruct_hyp H
    | _ => try (solve [ inversion H ])
    end)
  with do_intro := (let H := fresh in
                    intro H; use_hyp H)
  with destruct_hyp H := (case H; clear H; do_intro; do_intro)
  in
  let rec use_hyps :=
   (match goal with
    | H:_ /\ _ |- _ => exact H || (destruct_hyp H; use_hyps)
    | H:_ * _ |- _ => exact H || (destruct_hyp H; use_hyps)
    | H:_ |- _ => solve [ inversion H ]
    | _ => idtac
    end)
  in
  let do_atom := (solve [ trivial with eq_true | reflexivity | symmetry; trivial | contradiction | congruence]) in
  let rec do_ccl := (try do_atom; repeat (do_intro; try do_atom); try arith_congr; (solve [ split; do_ccl ])) in
  (solve [ do_atom | use_hyps; do_ccl ]) || fail "Cannot solve this goal".

#[global]
Hint Extern 10 (_ < _)%nat => lia : terms.
#[global]
Hint Extern 10 (_ <= _)%nat => lia : terms.
#[global]
Hint Extern 10 (@eq nat _ _) => lia : terms.

Ltac easy ::= easy0 || solve [intuition eauto 3 with core terms].

Notation subst_rec N M k := (subst N k M) (only parsing).

Lemma lift_rel_ge :
  forall k n p, p <= n -> lift k p (tRel n) = tRel (k + n).
Proof.
  intros; simpl in |- *.
  now elim (leb_spec p n).
Qed.

Lemma lift_rel_lt : forall k n p, p > n -> lift k p (tRel n) = tRel n.
Proof.
  intros; simpl in |- *.
  now elim (leb_spec p n).
Qed.

Lemma subst_rel_lt : forall u n k, k > n -> subst u k (tRel n) = tRel n.
Proof.
  simpl in |- *; intros.
  elim (leb_spec k n); intro Hcomp; easy.
Qed.

Lemma subst_rel_gt :
  forall u n k, n >= k + length u -> subst u k (tRel n) = tRel (n - length u).
Proof.
  simpl in |- *; intros.
  elim (leb_spec k n). intros. destruct nth_error eqn:Heq.
  assert (n - k < length u) by (apply nth_error_Some; congruence). lia. reflexivity.
  lia.
Qed.

Lemma subst_rel_eq :
  forall (u : list term) n i t p,
    List.nth_error u i = Some t -> p = n + i ->
    subst u n (tRel p) = lift0 n t.
Proof.
  intros; simpl in |- *. subst p.
  elim (leb_spec n (n + i)). intros. assert (n + i - n = i) by lia. rewrite H1 H.
  reflexivity. intros. lia.
Qed.

Ltac nth_leb_simpl :=
  match goal with
    |- context [leb ?k ?n] => elim (leb_spec_Set k n); try lia; simpl
  | |- context [nth_error ?l ?n] => elim (nth_error_spec l n); rewrite -> ?app_length, ?map_length;
                                    try lia; intros; simpl
  | H : context[nth_error (?l ++ ?l') ?n] |- _ =>
    (rewrite -> (nth_error_app_ge l l' n) in H by lia) ||
    (rewrite -> (nth_error_app_lt l l' n) in H by lia)
  | H : nth_error ?l ?n = Some _, H' : nth_error ?l ?n' = Some _ |- _ =>
    replace n' with n in H' by lia; rewrite -> H in H'; injection H'; intros; subst
  | _ => lia || congruence || solve [repeat (f_equal; try lia)]
  end.

Lemma lift0_id : forall M k, lift 0 k M = M.
Proof.
  intros M.
  elim M using term_forall_list_ind; simpl in |- *; intros; try easy ;
    try (try rewrite H; try rewrite H0 ; try rewrite H1 ; easy);
    try (f_equal; auto; solve_all).

  now elim (leb k n).
Qed.

Lemma map_lift0 l : map (lift0 0) l = l.
Proof. induction l; simpl; auto. now rewrite lift0_id. Qed.

Lemma lift0_p : forall M, lift0 0 M = M.
Proof. intro; apply lift0_id. Qed.

Lemma simpl_lift :
  forall M n k p i,
    i <= k + n ->
    k <= i -> lift p i (lift n k M) = lift (p + n) k M.
Proof.
  intros M.
  elim M using term_forall_list_ind;
    intros; simpl; autorewrite with map;
      try (rewrite -> H, ?H0, ?H1; auto); try (f_equal; auto; solve_all).

  elim (leb_spec k n); intros.
  + elim (leb_spec i (n0 + n)); intros; lia.
  + elim (leb_spec i n); intros; lia.
Qed.

Lemma simpl_lift0 : forall M n, lift0 (S n) M = lift0 1 (lift0 n M).
Proof. intros; now rewrite simpl_lift. Qed.

Lemma simpl_lift_ext n k p i :
  i <= k + n -> k <= i ->
  lift p i ∘ lift n k =1 lift (p + n) k.
Proof. intros ? ? ?; now apply simpl_lift. Qed.

#[global]
Hint Rewrite Nat.add_assoc : map.

Lemma permute_lift :
  forall M n k p i,
    i <= k ->
    lift p i (lift n k M) = lift n (k + p) (lift p i M).
Proof.
  intros M.
  elim M using term_forall_list_ind;
    intros; simpl;
      f_equal; try solve [solve_all]; repeat nth_leb_simpl.
Qed.

Lemma permute_lift0 :
  forall M k, lift0 1 (lift 1 k M) = lift 1 (S k) (lift0 1 M).
Proof.
  intros.
  change (lift 1 0 (lift 1 k M) = lift 1 (1 + k) (lift 1 0 M)).
  now rewrite permute_lift.
Qed.

Lemma lift_isApp n k t : ~ isApp t = true -> ~ isApp (lift n k t) = true.
Proof. induction t; auto. Qed.

Lemma isLambda_lift n k (bod : term) :
  isLambda bod = true -> isLambda (lift n k bod) = true.
Proof. now destruct bod. Qed.

#[global]
Hint Resolve lift_isApp map_nil isLambda_lift : all.

Lemma simpl_subst_rec :
  forall M N n p k,
    p <= n + k ->
    k <= p -> subst N p (lift (List.length N + n) k M) = lift n k M.
Proof.
  intros M. induction M using term_forall_list_ind;
    intros; simpl; autorewrite with map;
      try solve [f_equal; auto; solve_all]; repeat nth_leb_simpl.
Qed.

Lemma simpl_subst :
  forall N M n p, p <= n -> subst N p (lift0 (length N + n) M) = lift0 n M.
Proof.
  intros. rewrite simpl_subst_rec; auto.
  now rewrite Nat.add_0_r. lia.
Qed.

Lemma lift_mkApps n k t l :
  lift n k (mkApps t l) = mkApps (lift n k t) (map (lift n k) l).
Proof.
  revert n k t; induction l; intros n k t. auto.
  simpl. rewrite (IHl n k (tApp t a)). reflexivity.
Qed.

Lemma commut_lift_subst_rec M N n p k :
  k <= p -> lift n k (subst N p M) = subst N (p + n) (lift n k M).
Proof.
  revert N n p k; elim M using term_forall_list_ind; intros; cbnr;
    f_equal; auto; solve_all; rewrite ?Nat.add_succ_r -?Nat.add_assoc; eauto with all.

  - repeat nth_leb_simpl.
    rewrite -> simpl_lift by easy. f_equal; lia.
Qed.

Lemma commut_lift_subst M N k :
  subst N (S k) (lift0 1 M) = lift0 1 (subst N k M).
Proof.
  now intros; rewrite commut_lift_subst_rec.
Qed.

Lemma distr_lift_subst_rec M N n p k :
    lift n (p + k) (subst N p M) =
    subst (List.map (lift n k) N) p (lift n (p + length N + k) M).
Proof.
  revert N n p k; elim M using term_forall_list_ind; intros; cbnr;
    f_equal; auto; solve_all.

  - repeat nth_leb_simpl.
    rewrite nth_error_map in e0. rewrite e in e0.
    invs e0. now rewrite (permute_lift x n0 k p 0).
Qed.

Lemma distr_lift_subst M N n k :
  lift n k (subst0 N M) = subst0 (map (lift n k) N) (lift n (length N + k) M).
Proof.
  pattern k at 1 3 in |- *.
  replace k with (0 + k); try easy.
  apply distr_lift_subst_rec.
Qed.

Lemma distr_lift_subst10 M N n k :
  lift n k (subst10 N M) = subst10 (lift n k N) (lift n (S k) M).
Proof.
  intros; unfold subst in |- *.
  pattern k at 1 3 in |- *.
  replace k with (0 + k); try easy.
  apply distr_lift_subst_rec.
Qed.

Lemma subst_mkApps u k t l :
  subst u k (mkApps t l) = mkApps (subst u k t) (map (subst u k) l).
Proof.
  revert u k t; induction l; intros u k t; auto.
  intros. simpl mkApps at 1. simpl subst at 1 2.
  now rewrite IHl.
Qed.

Lemma subst1_mkApps u k t l :
  subst1 u k (mkApps t l) = mkApps (subst1 u k t) (map (subst1 u k) l).
Proof.
  apply subst_mkApps.
Qed.

Lemma distr_subst_rec M N (P : list term) n p :
  subst P (p + n) (subst N p M)
  = subst (map (subst P n) N) p (subst P (p + length N + n) M).
Proof.
  revert N P n p; elim M using term_forall_list_ind; intros;
    match goal with
    | |- context [tRel _] => idtac
    | |- _ => simpl
    end; try reflexivity;
      rewrite -> ?map_map_compose, ?compose_on_snd, ?compose_map_def,
      ?map_length, ?Nat.add_assoc, ?map_predicate_map_predicate;
      try solve [f_equal; auto; solve_all].

  - unfold subst at 2.
    elim (leb_spec p n); intros.
    + destruct (nth_error_spec N (n - p)).
      ++ rewrite -> subst_rel_lt by lia.
         erewrite subst_rel_eq; try easy.
         2:rewrite -> nth_error_map, e; reflexivity.
         now rewrite commut_lift_subst_rec. lia.
      ++ unfold subst at 4.
         elim (leb_spec (p + length N + n0) n); intros; subst; try easy.
         destruct (nth_error_spec P (n - (p + length N + n0))).
         +++ erewrite subst_rel_eq. 2:eauto. 2:lia.
             assert (p + length N + n0 = length (map (subst P n0) N) + (p + n0))
               by (rewrite map_length; lia).
             rewrite H1. rewrite simpl_subst_rec; eauto; try lia.
         +++ rewrite !subst_rel_gt; rewrite ?map_length; try lia. f_equal; lia.
         +++ rewrite subst_rel_lt; try easy.
             rewrite -> subst_rel_gt; rewrite map_length. trivial. lia.
    + rewrite !subst_rel_lt; try easy.
Qed.

Lemma distr_subst P N M k :
  subst P k (subst0 N M) = subst0 (map (subst P k) N) (subst P (length N + k) M).
Proof.
  intros.
  pattern k at 1 3 in |- *.
  change k with (0 + k). hnf.
  apply distr_subst_rec.
Qed.

Lemma lift_closed n k t : closedn k t -> lift n k t = t.
Proof.
  revert k.
  elim t using term_forall_list_ind; intros; try easy;
    rewrite -> ?map_map_compose, ?compose_on_snd, ?compose_map_def, ?map_length,
      ?map_predicate_map_predicate, ?map_branch_map_branch;
    simpl closed in *;
    unfold test_predicate_k, test_def, test_branch_k in *;
    try solve [simpl lift; simpl closed; f_equal; auto; rtoProp; solve_all]; try easy.
  - rewrite lift_rel_lt; auto.
    revert H. elim (Nat.ltb_spec n0 k); intros; try easy.
Qed.

Lemma closed_upwards {k t} k' : closedn k t -> k' >= k -> closedn k' t.
Proof.
  revert k k'.
  elim t using term_forall_list_ind; intros; try lia;
    autorewrite with map;
    simpl closed in *; unfold test_snd, test_def, test_predicate_k, test_branch_k in *;
      try solve [(try f_equal; simpl; repeat (rtoProp; solve_all); eauto)].

  - elim (ltb_spec n k'); auto. intros.
    apply ltb_lt in H. lia.
Qed.

Lemma subst_empty k a : subst [] k a = a.
Proof.
  induction a in k |- * using term_forall_list_ind; simpl; try congruence;
    try solve [f_equal; eauto; solve_all].

  - elim (Nat.compare_spec k n); destruct (Nat.leb_spec k n); intros; try easy.
    subst. rewrite Nat.sub_diag. simpl. rewrite Nat.sub_0_r. reflexivity.
    assert (n - k > 0) by lia.
    assert (exists n', n - k = S n'). exists (pred (n - k)). lia.
    destruct H2. rewrite H2. simpl. now rewrite Nat.sub_0_r.
Qed.

Lemma subst_empty_eq k : subst [] k =1 id.
Proof. intros x; now rewrite subst_empty. Qed.

Lemma lift_to_extended_list_k Γ k : forall k',
    to_extended_list_k Γ (k' + k) = map (lift0 k') (to_extended_list_k Γ k).
Proof.
  unfold to_extended_list_k.
  intros k'. rewrite !reln_alt_eq !app_nil_r.
  induction Γ in k, k' |- *; simpl; auto.
  destruct a as [na [body|] ty].
  now rewrite <- Nat.add_assoc, (IHΓ (k + 1) k').
  simpl. now rewrite <- Nat.add_assoc, (IHΓ (k + 1) k'), map_app.
Qed.

Lemma simpl_subst_k (N : list term) (M : term) :
  forall k p, p = #|N| -> subst N k (lift p k M) = M.
Proof.
  intros. subst p. rewrite <- (Nat.add_0_r #|N|).
  rewrite -> simpl_subst_rec, lift0_id; auto.
Qed.

Lemma subst_app_decomp l l' k t :
  subst (l ++ l') k t = subst l' k (subst (List.map (lift0 (length l')) l) k t).
Proof.
  induction t in k |- * using term_forall_list_ind; simpl; auto;
    rewrite ?subst_mkApps; try change_Sk;
    try (f_equal; rewrite -> ?map_map_compose, ?compose_on_snd, ?compose_map_def,
                  ?map_length, ?map_predicate_map_predicate; eauto; solve_all).

  - repeat nth_leb_simpl.
    rewrite nth_error_map in e0. rewrite e in e0.
    injection e0; intros <-.
    rewrite -> permute_lift by auto.
    rewrite <- (Nat.add_0_r #|l'|).
    rewrite -> simpl_subst_rec, lift0_id; auto with wf; try lia.
Qed.

Lemma subst_app_simpl l l' k t :
  subst (l ++ l') k t = subst l k (subst l' (k + length l) t).
Proof.
  induction t in k |- * using term_forall_list_ind; simpl; eauto;
    rewrite ?subst_mkApps; try change_Sk;
    try (f_equal; rewrite -> ?map_map_compose, ?compose_on_snd, ?compose_map_def,
                  ?map_length, ?Nat.add_assoc, ?map_predicate_map_predicate; solve_all).

  - repeat nth_leb_simpl.
    rewrite -> Nat.add_comm, simpl_subst; eauto.
Qed.

Lemma subst_app_simpl' (l l' : list term) (k : nat) (t : term) n :
  n = #|l| ->
  subst (l ++ l') k t = subst l k (subst l' (k + n) t).
Proof. intros ->; apply subst_app_simpl. Qed.

Lemma isLambda_subst (s : list term) k (bod : term) :
  isLambda bod = true -> isLambda (subst s k bod) = true.
Proof.
  intros. destruct bod; try discriminate. reflexivity.
Qed.

Lemma map_vass_map_def g l n k :
  mapi (fun i d => vass (dname d) (lift0 i (dtype d)))
       (map (map_def (lift n k) g) l)
  = mapi (fun i d => map_decl (lift n (i + k)) d)
         (mapi (fun i (d : def term) => vass (dname d) (lift0 i (dtype d))) l).
Proof.
  rewrite mapi_mapi mapi_map. apply mapi_ext.
  intros. unfold map_decl, vass; simpl; f_equal.
  rewrite -> permute_lift. f_equal; lia. lia.
Qed.

Definition fix_context_gen k mfix :=
  List.rev (mapi_rec (fun (i : nat) (d : def term) => vass (dname d) (lift0 i (dtype d))) mfix k).

Lemma lift_decl0 k d : map_decl (lift 0 k) d = d.
Proof.
  destruct d; destruct decl_body; unfold map_decl; simpl;
  f_equal; now rewrite ?lift0_id.
Qed.

Lemma lift0_context k Γ : lift_context 0 k Γ = Γ.
Proof.
  unfold lift_context, fold_context_k.
  rewrite rev_mapi. rewrite List.rev_involutive.
  unfold mapi. generalize 0 at 2. generalize #|List.rev Γ|.
  induction Γ; intros; simpl; trivial.
  rewrite lift_decl0; f_equal; auto.
Qed.

Lemma lift_context_length n k Γ : #|lift_context n k Γ| = #|Γ|.
Proof. apply fold_context_k_length. Qed.
#[global]
Hint Rewrite lift_context_length : lift len.

Definition lift_context_snoc0 n k Γ d : lift_context n k (d :: Γ) = lift_context n k Γ ,, lift_decl n (#|Γ| + k) d.
Proof. unfold lift_context. now rewrite fold_context_k_snoc0. Qed.
#[global]
Hint Rewrite lift_context_snoc0 : lift.

Lemma lift_context_snoc n k Γ d : lift_context n k (Γ ,, d) = lift_context n k Γ ,, lift_decl n (#|Γ| + k) d.
Proof.
  unfold snoc. apply lift_context_snoc0.
Qed.
#[global]
Hint Rewrite lift_context_snoc : lift.

Lemma lift_context_alt n k Γ :
  lift_context n k Γ =
  mapi (fun k' d => lift_decl n (Nat.pred #|Γ| - k' + k) d) Γ.
Proof.
  unfold lift_context. apply: fold_context_k_alt.
Qed.

Lemma lift_context_app n k Γ Δ :
  lift_context n k (Γ ,,, Δ) = lift_context n k Γ ,,, lift_context n (#|Γ| + k) Δ.
Proof.
  unfold lift_context, fold_context_k, app_context.
  rewrite List.rev_app_distr.
  rewrite mapi_app. rewrite <- List.rev_app_distr. f_equal. f_equal.
  apply mapi_ext. intros. f_equal. rewrite List.rev_length. f_equal. lia.
Qed.

Lemma lift_it_mkProd_or_LetIn n k ctx t :
  lift n k (it_mkProd_or_LetIn ctx t) =
  it_mkProd_or_LetIn (lift_context n k ctx) (lift n (length ctx + k) t).
Proof.
  induction ctx in n, k, t |- *; simpl; try congruence.
  pose (lift_context_snoc n k ctx a). unfold snoc in e. rewrite -> e. clear e.
  simpl. rewrite -> IHctx.
  pose (lift_context_snoc n k ctx a).
  now destruct a as [na [b|] ty].
Qed.

Lemma lift_it_mkLambda_or_LetIn n k ctx t :
  lift n k (it_mkLambda_or_LetIn ctx t) =
  it_mkLambda_or_LetIn (lift_context n k ctx) (lift n (length ctx + k) t).
Proof.
  induction ctx in n, k, t |- *; simpl; try congruence.
  pose (lift_context_snoc n k ctx a). unfold snoc in e. rewrite -> e. clear e.
  simpl. rewrite -> IHctx.
  pose (lift_context_snoc n k ctx a).
  now destruct a as [na [b|] ty].
Qed.

Lemma map_lift_lift n k l : map (fun x => lift0 n (lift0 k x)) l = map (lift0 (n + k)) l.
Proof. apply map_ext => x.
  rewrite simpl_lift; try lia. reflexivity.
Qed.

Lemma simpl_subst' :
  forall N M n p k, k = List.length N -> p <= n -> subst N p (lift0 (k + n) M) = lift0 n M.
Proof.
  intros. subst k. rewrite simpl_subst_rec; auto.
  + now rewrite Nat.add_0_r.
  + lia.
Qed.

Lemma subst_subst_lift (s s' : list term) n t : n = #|s| + #|s'| ->
  subst0 s (subst0 s' (lift0 n t)) = t.
Proof.
  intros ->. rewrite Nat.add_comm simpl_subst' //; try lia.
  now rewrite -(Nat.add_0_r #|s|) simpl_subst' // lift0_id.
Qed.

Lemma map_subst_lift_id s l : map (subst0 s ∘ lift0 #|s|) l = l.
Proof.
  induction l; simpl; auto.
  rewrite -{1}(Nat.add_0_r #|s|) simpl_subst'; auto.
  now rewrite lift0_id IHl.
Qed.

Lemma map_subst_lift_id_eq s l k : k = #|s| -> map (subst0 s ∘ lift0 k) l = l.
Proof. intros ->; apply map_subst_lift_id. Qed.

Lemma map_subst_lift_ext N n p k l :
  k = #|N| -> p <= n ->
  map (subst N p ∘ lift0 (k + n)) l = map (lift0 n) l.
Proof.
  intros -> pn.
  apply map_ext => x. now apply simpl_subst'.
Qed.

Lemma map_subst_subst_lift_lift (s s' : list term) k k' l : k + k' = #|s| + #|s'| ->
  map (fun t => subst0 s (subst0 s' (lift k k' (lift0 k' t)))) l = l.
Proof.
  intros H. eapply All_map_id. eapply All_refl => x.
  rewrite simpl_lift; try lia. rewrite subst_subst_lift //.
Qed.

Lemma nth_error_lift_context:
  forall (Γ' Γ'' : context) (v : nat),
    v < #|Γ'| -> forall nth k,
    nth_error Γ' v = Some nth ->
    nth_error (lift_context #|Γ''| k Γ') v = Some (lift_decl #|Γ''| (#|Γ'| - S v + k) nth).
Proof.
  induction Γ'; intros.
  - easy.
  - simpl. destruct v; rewrite lift_context_snoc0.
    + simpl. repeat f_equal; try lia. simpl in *. congruence.
    + simpl. apply IHΓ'; simpl in *; (lia || congruence).
Qed.

Lemma nth_error_lift_context_eq:
  forall (Γ' Γ'' : context) (v : nat) k,
    nth_error (lift_context #|Γ''| k Γ') v =
    option_map (lift_decl #|Γ''| (#|Γ'| - S v + k)) (nth_error Γ' v).
Proof.
  induction Γ'; intros.
  - simpl. unfold lift_context, fold_context_k; simpl. now rewrite nth_error_nil.
  - simpl. destruct v; rewrite lift_context_snoc0.
    + simpl. repeat f_equal; try lia.
    + simpl. apply IHΓ'; simpl in *; (lia || congruence).
Qed.

#[global]
Hint Rewrite subst_context_length : subst wf.

#[global]
Hint Rewrite subst_context_snoc : subst.

Lemma subst_decl0 k d : map_decl (subst [] k) d = d.
Proof.
  destruct d; destruct decl_body;
    unfold subst_decl, map_decl; simpl in *;
    f_equal; simpl; rewrite subst_empty; intuition trivial.
Qed.

Lemma subst0_context k Γ : subst_context [] k Γ = Γ.
Proof.
  unfold subst_context, fold_context_k.
  rewrite rev_mapi. rewrite List.rev_involutive.
  unfold mapi. generalize 0. generalize #|List.rev Γ|.
  induction Γ; intros; simpl; trivial.
  erewrite subst_decl0; f_equal; eauto.
Qed.

Lemma subst_context_snoc0 s Γ d : subst_context s 0 (Γ ,, d) = subst_context s 0 Γ ,, subst_decl s #|Γ| d.
Proof.
  unfold snoc. now rewrite subst_context_snoc Nat.add_0_r.
Qed.
#[global]
Hint Rewrite subst_context_snoc : subst.

Lemma subst_context_app s k Γ Δ :
  subst_context s k (Γ ,,, Δ) = subst_context s k Γ ,,, subst_context s (#|Γ| + k) Δ.
Proof.
  unfold subst_context, fold_context_k, app_context.
  rewrite List.rev_app_distr.
  rewrite mapi_app. rewrite <- List.rev_app_distr. f_equal. f_equal.
  apply mapi_ext. intros. f_equal. rewrite List.rev_length. f_equal. lia.
Qed.

Lemma distr_lift_subst_context n k s Γ : lift_context n k (subst_context s 0 Γ) =
  subst_context (map (lift n k) s) 0 (lift_context n (#|s| + k) Γ).
Proof.
  rewrite !lift_context_alt !subst_context_alt.
  rewrite !mapi_compose.
  apply mapi_ext.
  intros n' x.
  rewrite /lift_decl /subst_decl !compose_map_decl.
  apply map_decl_ext => y.
  rewrite !mapi_length Nat.add_0_r; autorewrite with len. unf_term.
  rewrite distr_lift_subst_rec; f_equal. f_equal. lia.
Qed.

Lemma skipn_subst_context n s k Γ : skipn n (subst_context s k Γ) =
  subst_context s k (skipn n Γ).
Proof.
  rewrite !subst_context_alt.
  rewrite skipn_mapi_rec. rewrite mapi_rec_add /mapi.
  apply mapi_rec_ext. intros.
  f_equal. rewrite List.skipn_length. lia.
Qed.

Lemma lift_extended_subst (Γ : context) k :
  extended_subst Γ k = map (lift0 k) (extended_subst Γ 0).
Proof.
  induction Γ as [|[? [] ?] ?] in k |- *; simpl; auto; unf_term.
  - rewrite IHΓ. f_equal.
    autorewrite with len.
    rewrite distr_lift_subst. f_equal.
    autorewrite with len. rewrite simpl_lift; lia_f_equal.
  - rewrite Nat.add_0_r; f_equal.
    rewrite IHΓ (IHΓ 1).
    rewrite map_map_compose. apply map_ext => x.
    rewrite simpl_lift; try lia.
    now rewrite Nat.add_1_r.
Qed.

Lemma lift_extended_subst' Γ k k' : extended_subst Γ (k + k') = map (lift0 k) (extended_subst Γ k').
Proof.
  induction Γ as [|[? [] ?] ?] in k |- *; simpl; auto.
  - rewrite IHΓ. f_equal.
    autorewrite with len.
    rewrite distr_lift_subst. f_equal.
    autorewrite with len. rewrite simpl_lift; lia_f_equal.
  - f_equal.
    rewrite (IHΓ (S k)) (IHΓ 1).
    rewrite map_map_compose. apply map_ext => x.
    rewrite simpl_lift; lia_f_equal.
Qed.

Lemma subst_extended_subst_k s Γ k k' : extended_subst (subst_context s k Γ) k' =
  map (subst s (k + context_assumptions Γ + k')) (extended_subst Γ k').
Proof.
  induction Γ as [|[na [b|] ty] Γ]; simpl; auto; rewrite subst_context_snoc /=;
    autorewrite with len; f_equal; auto.
  - rewrite IHΓ.
    rewrite commut_lift_subst_rec; try lia.
    rewrite distr_subst. now len.
  - elim: Nat.leb_spec => //. lia.
  - rewrite (lift_extended_subst' _ 1 k') IHΓ.
    rewrite (lift_extended_subst' _ 1 k').
    rewrite !map_map_compose.
    apply map_ext.
    intros x.
    erewrite (commut_lift_subst_rec); lia_f_equal.
Qed.

Lemma extended_subst_app Γ Γ' :
  extended_subst (Γ ++ Γ') 0 =
  extended_subst (subst_context (extended_subst Γ' 0) 0
   (lift_context (context_assumptions Γ') #|Γ'| Γ)) 0 ++
   extended_subst Γ' (context_assumptions Γ).
Proof.
  induction Γ as [|[na [b|] ty] Γ] in |- *; simpl; auto.
  - autorewrite with len.
    rewrite IHΓ. simpl.  rewrite app_comm_cons.
    f_equal.
    erewrite subst_app_simpl'.
    2:autorewrite with len; reflexivity.
    simpl.
    rewrite lift_context_snoc subst_context_snoc /=.
    len. f_equal. f_equal.
    rewrite -{3}(Nat.add_0_r #|Γ|).
    erewrite <- (simpl_lift _ _ _ _ (#|Γ| + #|Γ'|)). all:try lia.
    rewrite distr_lift_subst_rec. autorewrite with len.
    f_equal. apply lift_extended_subst.
  - rewrite lift_context_snoc  subst_context_snoc /=. lia_f_equal.
    rewrite lift_extended_subst. rewrite IHΓ /=.
    rewrite map_app. rewrite !(lift_extended_subst _ (S _)).
    rewrite (lift_extended_subst _ (context_assumptions Γ)).
    rewrite map_map_compose.
    f_equal. apply map_ext. intros.
    rewrite simpl_lift; lia_f_equal.
Qed.

Lemma subst_context_comm s s' Γ :
  subst_context s 0 (subst_context s' 0 Γ) =
  subst_context (map (subst s 0) s' ++ s) 0 Γ.
Proof.
  intros.
  rewrite !subst_context_alt !mapi_compose.
  apply mapi_ext => i x.
  destruct x as [na [b|] ty] => //.
  - rewrite /subst_decl /map_decl /=; f_equal.
    + rewrite !mapi_length. f_equal. rewrite {2}Nat.add_0_r.
      rewrite subst_app_simpl.
      rewrite distr_subst_rec. rewrite Nat.add_0_r; f_equal; try lia.
      rewrite map_length. f_equal; lia.
    + rewrite mapi_length.
      rewrite subst_app_simpl.
      rewrite {2}Nat.add_0_r.
      rewrite distr_subst_rec. rewrite Nat.add_0_r; f_equal; try lia.
      rewrite map_length. f_equal; lia.
  - rewrite /subst_decl /map_decl /=; f_equal.
    rewrite !mapi_length. rewrite {2}Nat.add_0_r.
    rewrite subst_app_simpl.
    rewrite distr_subst_rec. rewrite Nat.add_0_r; f_equal; try lia.
    rewrite map_length. f_equal. lia.
Qed.

Lemma context_assumptions_subst s n Γ :
  context_assumptions (subst_context s n Γ) = context_assumptions Γ.
Proof. apply context_assumptions_fold. Qed.
#[global]
Hint Rewrite context_assumptions_subst : pcuic.

Lemma subst_app_context s s' Γ : subst_context (s ++ s') 0 Γ = subst_context s 0 (subst_context s' #|s| Γ).
Proof.
  induction Γ; simpl; auto.
  rewrite !subst_context_snoc /= /subst_decl /map_decl /=. simpl.
  rewrite IHΓ. f_equal. f_equal.
  - destruct a as [na [b|] ty]; simpl; auto.
    f_equal. rewrite subst_context_length Nat.add_0_r.
    now rewrite subst_app_simpl.
  - rewrite subst_context_length Nat.add_0_r.
    now rewrite subst_app_simpl.
Qed.

Lemma subst_app_context' (s s' : list term) (Γ : context) n :
  n = #|s| ->
  subst_context (s ++ s') 0 Γ = subst_context s 0 (subst_context s' n Γ).
Proof.
  intros ->; apply subst_app_context.
Qed.

Lemma map_subst_app_simpl l l' k (ts : list term) :
  map (subst l k ∘ subst l' (k + #|l|)) ts =
  map (subst (l ++ l') k) ts.
Proof.
  eapply map_ext. intros.
  now rewrite subst_app_simpl.
Qed.

Lemma simpl_map_lift x n k :
  map (lift0 n ∘ lift0 k) x =
  map (lift k n ∘ lift0 n) x.
Proof.
  apply map_ext => t.
  rewrite simpl_lift => //; try lia.
  rewrite simpl_lift; try lia.
  now rewrite Nat.add_comm.
Qed.

Lemma subst_it_mkProd_or_LetIn n k ctx t :
  subst n k (it_mkProd_or_LetIn ctx t) =
  it_mkProd_or_LetIn (subst_context n k ctx) (subst n (length ctx + k) t).
Proof.
  induction ctx in n, k, t |- *; simpl; try congruence.
  pose (subst_context_snoc n k ctx a). unfold snoc in e. rewrite e. clear e.
  simpl. rewrite -> IHctx.
  pose (subst_context_snoc n k ctx a). simpl. now destruct a as [na [b|] ty].
Qed.

Lemma map_subst_instance_to_extended_list_k u ctx k :
  to_extended_list_k (subst_instance u ctx) k
  = to_extended_list_k ctx k.
Proof.
  unfold to_extended_list_k.
  cut (map (subst_instance u) [] = []); [|reflexivity].
  unf_term. generalize (@nil term); intros l Hl.
  induction ctx in k, l, Hl |- *; cbnr.
  destruct a as [? [] ?]; cbnr; eauto.
Qed.

Lemma to_extended_list_k_subst n k c k' :
  to_extended_list_k (subst_context n k c) k' = to_extended_list_k c k'.
Proof.
  unfold to_extended_list_k. revert k'.
  unf_term. generalize (@nil term) at 1 2.
  induction c in n, k |- *; simpl; intros. 1: reflexivity.
  rewrite subst_context_snoc. unfold snoc. simpl.
  destruct a. destruct decl_body.
  - unfold subst_decl, map_decl. simpl.
    now rewrite IHc.
  - simpl. apply IHc.
Qed.

Lemma it_mkProd_or_LetIn_inj ctx s ctx' s' :
  it_mkProd_or_LetIn ctx (tSort s) = it_mkProd_or_LetIn ctx' (tSort s') ->
  ctx = ctx' /\ s = s'.
Proof.
  move/(f_equal (destArity [])).
  rewrite !destArity_it_mkProd_or_LetIn /=.
  now rewrite !app_context_nil_l => [= -> ->].
Qed.

Lemma destArity_spec ctx T :
  match destArity ctx T with
  | Some (ctx', s) => it_mkProd_or_LetIn ctx T = it_mkProd_or_LetIn ctx' (tSort s)
  | None => True
  end.
Proof.
  induction T in ctx |- *; simpl; try easy.
  - specialize (IHT2 (ctx,, vass na T1)). now destruct destArity.
  - specialize (IHT3 (ctx,, vdef na T1 T2)). now destruct destArity.
Qed.

Lemma destArity_spec_Some ctx T ctx' s :
  destArity ctx T = Some (ctx', s)
  -> it_mkProd_or_LetIn ctx T = it_mkProd_or_LetIn ctx' (tSort s).
Proof.
  pose proof (destArity_spec ctx T) as H.
  intro e; now rewrite e in H.
Qed.

(** Standard substitution lemma for a context with no lets. *)

Inductive nth_error_app_spec {A} (l l' : list A) (n : nat) : option A -> Type :=
| nth_error_app_spec_left x :
  nth_error l n = Some x ->
  n < #|l| ->
  nth_error_app_spec l l' n (Some x)
| nth_error_app_spec_right x :
  nth_error l' (n - #|l|) = Some x ->
  #|l| <= n < #|l| + #|l'| ->
  nth_error_app_spec l l' n (Some x)
| nth_error_app_spec_out : #|l| + #|l'| <= n -> nth_error_app_spec l l' n None.

Lemma nth_error_appP {A} (l l' : list A) (n : nat) : nth_error_app_spec l l' n (nth_error (l ++ l') n).
Proof.
  destruct (Nat.ltb n #|l|) eqn:lt; [apply Nat.ltb_lt in lt|apply Nat.ltb_nlt in lt].
  * rewrite nth_error_app_lt //.
    destruct (snd (nth_error_Some' _ _) lt) as [x eq].
    rewrite eq.
    constructor; auto.
  * destruct (Nat.ltb n (#|l| + #|l'|)) eqn:ltb'; [apply Nat.ltb_lt in ltb'|apply Nat.ltb_nlt in ltb'].
    + rewrite nth_error_app2; try lia.
      destruct nth_error eqn:hnth.
      - constructor 2; auto; try lia.
      - constructor.
        eapply nth_error_None in hnth. lia.
    + case: nth_error_spec => //; try lia.
      { intros. len in l0. lia. }
      len. intros. constructor. lia.
Qed.

Lemma nth_error_app_context (Γ Δ : context) (n : nat) :
  nth_error_app_spec Δ Γ n (nth_error (Γ ,,, Δ) n).
Proof.
  apply nth_error_appP.
Qed.

Lemma expand_lets_k_nil k t : expand_lets_k [] k t = t.
Proof. by rewrite /expand_lets_k /= subst_empty lift0_id. Qed.