From sflib Require Import sflib.
From Paco Require Import paco.

From PromisingLib Require Import Axioms.
From PromisingLib Require Import Basic.
From PromisingLib Require Import DataStructure.
From PromisingLib Require Import DenseOrder.
From PromisingLib Require Import Loc.
From PromisingLib Require Import Language.

From PromisingLib Require Import Event.
Require Import Time.
Require Import View.
Require Import Cell.
Require Import Memory.
Require Import MemoryFacts.
Require Import TView.
Require Import Local.
Require Import Thread.

Set Implicit Arguments.

Lemma closed_timemap_max_ts
      loc tm mem
      (CLOSED: Memory.closed_timemap tm mem):
  Time.le (tm loc) (Memory.max_ts loc mem).
Proof.
  specialize (CLOSED loc). des.
  eapply Memory.max_ts_spec. eauto.
Qed.

Lemma closed_timemap_max_concrete_ts
      loc tm mem mts
      (CLOSED: Memory.closed_timemap tm mem)
      (MAX: Memory.max_concrete_ts mem loc mts):
  Time.le (tm loc) mts.
Proof.
  specialize (CLOSED loc). des.
  eapply Memory.max_concrete_ts_spec; eauto.
Qed.

Lemma progress_promise_step
      lc1 sc1 mem1
      loc to val releasedm ord
      (LT: Time.lt (Memory.max_ts loc mem1) to)
      (WF1: Local.wf lc1 mem1)
      (MEM1: Memory.closed mem1)
      (SC1: Memory.closed_timemap sc1 mem1)
      (WF_REL: View.opt_wf releasedm)
      (CLOSED_REL: Memory.closed_opt_view releasedm mem1):
  exists promises2 mem2,
    Local.promise_step lc1 mem1 loc (Memory.max_ts loc mem1) to
                       (Message.concrete val (TView.write_released (Local.tview lc1) sc1 loc to releasedm ord))
                       (Local.mk (Local.tview lc1) promises2) mem2 Memory.op_kind_add.
Proof.
  exploit (@Memory.add_exists_max_ts
             mem1 loc to
             (Message.concrete val (TView.write_released (Local.tview lc1) sc1 loc to releasedm ord))); eauto.
  { econs. eapply TViewFacts.write_future0; eauto. apply WF1. }
  i. des.
  exploit Memory.add_exists_le; try apply WF1; eauto. i. des.
  hexploit Memory.add_inhabited; try apply x0; [viewtac|]. i. des.
  esplits. econs; eauto.
  - econs; eauto; try congr.
    + econs. unfold TView.write_released.
      viewtac; repeat (condtac; viewtac);
        (try by apply Time.bot_spec);
        (try by unfold TimeMap.singleton, LocFun.add; condtac; [refl|congr]);
        (try by left; eapply TimeFacts.le_lt_lt; [|eauto];
         eapply closed_timemap_max_ts; apply WF1).
      left. eapply TimeFacts.le_lt_lt; [|eauto].
      eapply closed_timemap_max_ts. apply Memory.unwrap_closed_opt_view; viewtac.
    + i. inv x0. inv ADD. clear DISJOINT MSG_WF CELL2.
      exploit Memory.get_ts; try exact GET. i. des.
      { subst. inv TO. }
      exploit Memory.max_ts_spec; try exact GET. i. des.
      eapply Time.lt_strorder. etrans; try exact TO.
      eapply TimeFacts.lt_le_lt; eauto.
  - econs. unfold TView.write_released. condtac; econs.
    viewtac;
      repeat condtac; viewtac;
        (try eapply Memory.add_closed_view; eauto);
        (try apply WF1).
    + viewtac.
    + erewrite Memory.add_o; eauto. condtac; eauto. ss. des; congr.
    + erewrite Memory.add_o; eauto. condtac; eauto. ss. des; congr.
Qed.

Lemma progress_read_step
      lc1 mem1
      loc ord
      (WF1: Local.wf lc1 mem1)
      (MEM1: Memory.closed mem1):
  exists val released lc2 mts,
    <<MAX: Memory.max_concrete_ts mem1 loc mts>> /\
    <<READ: Local.read_step lc1 mem1 loc mts val released ord lc2>>.
Proof.
  dup MEM1. inv MEM0.
  exploit (Memory.max_concrete_ts_exists); eauto. i. des.
  exploit (Memory.max_concrete_ts_spec); eauto. i. des.
  esplits; eauto. econs; eauto; try refl.
  econs; i; eapply Memory.max_concrete_ts_spec2; eauto; apply WF1.
Qed.

Lemma progress_read_step_cur
      lc1 mem1
      loc ord
      (WF1: Local.wf lc1 mem1)
      (MEM1: Memory.closed mem1):
  exists val released lc2,
    <<READ: Local.read_step lc1 mem1 loc ((TView.cur (Local.tview lc1)).(View.rlx) loc) val released ord lc2>>.
Proof.
  dup WF1. inv WF0. inv TVIEW_CLOSED. inv CUR.
  specialize (RLX loc). des.
  esplits. econs; eauto; try refl.
  econs; try apply TVIEW_WF; try refl.
Qed.

Lemma progress_write_step
      lc1 sc1 mem1
      loc to val releasedm ord
      (LT: Time.lt (Memory.max_ts loc mem1) to)
      (WF1: Local.wf lc1 mem1)
      (SC1: Memory.closed_timemap sc1 mem1)
      (MEM1: Memory.closed mem1)
      (WF_REL: View.opt_wf releasedm)
      (CLOSED_REL: Memory.closed_opt_view releasedm mem1)
      (PROMISES1: Ordering.le Ordering.strong_relaxed ord -> Memory.nonsynch_loc loc (Local.promises lc1)):
  exists released lc2 sc2 mem2,
    Local.write_step lc1 sc1 mem1 loc (Memory.max_ts loc mem1) to val releasedm released ord lc2 sc2 mem2 Memory.op_kind_add.
Proof.
  exploit progress_promise_step; eauto. i. des.
  exploit Local.promise_step_future; eauto. i. des. inv x0.
  exploit Memory.remove_exists; eauto.
  { inv PROMISE. erewrite Memory.add_o; try eexact PROMISES.
    condtac; eauto. ss. des; exfalso; apply o; eauto.
  }
  i. des.
  esplits. econs; eauto.
  econs; i; (try eapply TimeFacts.le_lt_lt; [|eauto]).
  apply Memory.max_ts_spec2. apply WF1.
Qed.

Lemma progress_write_step_split
      lc1 sc1 mem1
      loc from to msg val releasedm ord
      (GET: Memory.get loc to (Local.promises lc1) = Some (from, msg))
      (CONS: Time.lt ((TView.cur (Local.tview lc1)).(View.rlx) loc) to)
      (WF1: Local.wf lc1 mem1)
      (SC1: Memory.closed_timemap sc1 mem1)
      (MEM1: Memory.closed mem1)
      (WF_REL: View.opt_wf releasedm)
      (TS_REL: Time.le ((View.rlx (View.unwrap releasedm)) loc) from)
      (CLOSED_REL: Memory.closed_opt_view releasedm mem1)
      (PROMISES1: Ordering.le Ordering.strong_relaxed ord -> Memory.nonsynch_loc loc lc1.(Local.promises))
      (RESERVE: msg <> Message.reserve):
  exists released lc2 sc2 mem2,
    Local.write_step lc1 sc1 mem1 loc from (Time.middle from to) val releasedm
                     released ord lc2 sc2 mem2 (Memory.op_kind_split to msg).
Proof.
  exploit Memory.get_ts; try exact GET. i. des.
  { subst. inv WF1. rewrite BOT in GET. ss. }
  exploit (@Memory.split_exists
             (Local.promises lc1) loc from (Time.middle from to) to
             (Message.concrete val (TView.write_released (Local.tview lc1) sc1 loc (Time.middle from to) releasedm ord))
             msg);
    try apply Time.middle_spec; auto.
  { econs. eapply TViewFacts.write_future0; eauto. apply WF1. }
  i. des.
  exploit Memory.split_exists_le; try apply WF1; eauto. i. des.
  exploit Memory.split_get0; try exact x1. i. des.
  exploit Memory.remove_exists; try exact GET2. i. des.
  clear GET0 GET1 GET2 GET3.
  assert (TS: Time.le ((TView.cur (Local.tview lc1)).(View.rlx) loc) from).
  { destruct (TimeFacts.le_lt_dec ((TView.cur (Local.tview lc1)).(View.rlx) loc) from); ss.
    inv WF1. inv TVIEW_CLOSED. inv CUR.
    specialize (RLX loc). des.
    clear REL ACQ PLN.
    exploit PROMISES; try exact GET. intros x.
    exploit Memory.get_ts; try exact RLX. i. des.
    { subst. rewrite x4 in l. inv l. }
    exploit Memory.get_disjoint; [exact RLX|exact x|..]. i. des.
    { subst. timetac. }
    exfalso.
    eapply x6; econs; [|refl|..]; ss. econs. ss.
  }
  esplits. econs; eauto.
  - econs; ss.
    eapply TimeFacts.le_lt_lt; eauto.
    apply Time.middle_spec. ss.
  - econs; eauto. econs; eauto; ss.
    econs. unfold TView.write_released. ss.
    condtac; ss; try by unfold TimeMap.bot; apply Time.bot_spec.
    unfold LocFun.add. condtac; ss.
    unfold TimeMap.join. condtac; ss.
    + unfold TimeMap.join, TimeMap.singleton.
      unfold LocFun.add, LocFun.init, LocFun.find.
      condtac; ss.
      repeat apply Time.join_spec; ss; try refl.
      * etrans; eauto. econs. apply Time.middle_spec; ss.
      * etrans; eauto. econs. apply Time.middle_spec; ss.
    + unfold TimeMap.join, TimeMap.singleton.
      unfold LocFun.add, LocFun.init, LocFun.find.
      condtac; ss.
      repeat apply Time.join_spec; ss; try refl.
      * etrans; eauto. econs. apply Time.middle_spec; ss.
      * inv WF1. inv TVIEW_WF. etrans; try eapply REL_CUR.
        etrans; eauto. econs. apply Time.middle_spec; ss.
Qed.

Lemma progress_fence_step
      lc1 sc1
      ordr ordw
      (PROMISES1: Ordering.le Ordering.strong_relaxed ordw -> Memory.nonsynch (Local.promises lc1))
      (PROMISES2: ordw = Ordering.seqcst -> (Local.promises lc1) = Memory.bot):
  exists lc2 sc2,
    Local.fence_step lc1 sc1 ordr ordw lc2 sc2.
Proof.
  esplits. econs; eauto.
Qed.


Require Import Framework TotalMem FSParameters CachedDiskLayer.
Require Import Log Log.RepImplications Specs LogCache LoggedDiskLayer LogCacheToLoggedDisk.Definitions.
Require Import ClassicalFacts FunctionalExtensionality Lia Eqdep.

Set Nested Proofs Allowed.

Local Notation "'imp'" := CachedDiskLang.
Local Notation "'abs'" := (LoggedDiskLang log_length data_length).
Local Notation "'refinement'" := LoggedDiskRefinement.

  Definition cached_disk_reboot_list l_selector : list (imp.(state) -> imp.(state)) :=
    (map (fun selector (s: imp.(state)) =>
            (empty_mem, (fst (snd s), select_total_mem selector (snd (snd s)))))
         l_selector).

  Definition logged_disk_reboot_list n := repeat (fun s : abs.(state) => s) n.

  Ltac unify_execs :=
    match goal with
    |[H : exec_with_recovery ?u ?x ?y ?z ?a ?b ?c _,
      H0 : exec_with_recovery ?u ?x ?y ?z ?a ?b ?c _ |- _ ] =>
     eapply exec_with_recovery_deterministic_wrt_reboot_state in H; [| apply H0]
    | [ H: exec ?u ?x ?y ?z ?a _,
        H0: exec ?u ?x ?y ?z ?a _ |- _ ] =>
      eapply exec_deterministic_wrt_oracle in H; [| apply H0]
    | [ H: exec' ?u ?x ?y ?z _,
        H0: exec' ?u ?x ?y ?z _ |- _ ] =>
      eapply exec_deterministic_wrt_oracle in H; [| apply H0]
    | [ H: exec _ ?u ?x ?y ?z _,
        H0: LayerImplementation.exec' ?u ?x ?y ?z _ |- _ ] =>
      eapply exec_deterministic_wrt_oracle in H; [| apply H0]
    end.

  Lemma recovery_oracles_refine_length:
    forall O_imp O_abs (L_imp: Layer O_imp) (L_abs: Layer O_abs) (ref: Refinement L_imp L_abs)
      l_o_imp l_o_abs T (u: user) s (p1: L_abs.(prog) T) rec l_rf u,
      recovery_oracles_refine ref u s p1 rec l_rf l_o_imp l_o_abs ->
      length l_o_imp = length l_o_abs.
  Proof.
    induction l_o_imp; simpl; intros; eauto.
    tauto.
    destruct l_o_abs; try tauto; eauto.
  Qed.

  Lemma select_mem_synced:
    forall A AEQ V (m: @mem A AEQ (V * list V)) selector (a: A) vs,
      select_mem selector m a = Some vs ->
      snd vs = nil.
  Proof.
    unfold select_mem; intros.
    destruct (m a); try congruence.
    inversion H; simpl; eauto.
  Qed.

  Lemma map_addr_list_eq_map_map:
    forall txns s hdr_state log_state valid_part hdr hdr_blockset log_blocksets,
      log_rep_explicit hdr_state log_state valid_part hdr txns hdr_blockset log_blocksets s ->
      map addr_list txns =
      map (map (Init.Nat.add data_start))
          (map (map (fun a => a - data_start)) (map addr_list txns)).
  Proof.
    intros.
    repeat rewrite map_map.
    apply map_ext_in.
    intros.
    rewrite map_map.
    rewrite map_noop; eauto.
    intros.
    unfold log_rep_explicit, log_rep_inner, txns_valid in *;
    simpl in *; cleanup_no_match.
    eapply Forall_forall in H9; eauto.
    unfold txn_well_formed in H9; simpl in *; cleanup_no_match.
    eapply Forall_forall in H13; eauto; lia.
  Qed.

  Lemma sumbool_agree_addr_dec:
    forall n x y,
      sumbool_agree (addr_dec x y) (addr_dec (n + x) (n + y)).
  Proof.
    unfold sumbool_agree; intros; intuition eauto.
    destruct (addr_dec x y);
    destruct (addr_dec (n + x) (n + y)); eauto;
    try congruence; try lia.
  Qed.

  Theorem abstract_oracles_exist_wrt_recover:
    forall l_selector u,
      abstract_oracles_exist_wrt refinement refines_reboot u (|Recover|) (|Recover|) (cached_disk_reboot_list l_selector).
  Proof.
    unfold abstract_oracles_exist_wrt, refines_reboot; induction l_selector;
    simpl; intros; cleanup; invert_exec.
    {
      exists  [ [OpToken (LoggedDiskOperation log_length data_length) Cont] ]; simpl.
      intuition eauto.
      left.
      eexists; intuition eauto.
      destruct t.
      eexists; intuition eauto.
      eexists; intuition eauto.
      left.
      eexists; intuition eauto.
      eapply_fresh recover_finished in H8; eauto.
    }
    {
      eapply IHl_selector in H12; eauto; cleanup.
      exists ([OpToken (LoggedDiskOperation log_length data_length) CrashBefore]::x0); simpl.
      repeat split; eauto; try (unify_execs; cleanup).
      eapply recovery_oracles_refine_length in H0; eauto.
      right.
      eexists; repeat split; eauto.
      eexists; repeat split; eauto.
      right.
      eexists; repeat split; eauto.
      intros.
      eapply_fresh recover_crashed in H11; eauto.
      logic_clean; eauto.
      eauto.

      eapply_fresh recover_crashed in H11; eauto.
      cleanup; repeat split_ors;
      simpl in *; unfold cached_log_reboot_rep in H0;
      cleanup;
      try eapply reboot_rep_to_reboot_rep in H0;
      try eapply crash_rep_recover_to_reboot_rep in H0;
      try eapply log_rep_to_reboot_rep in H0;
      eexists; unfold cached_log_reboot_rep; simpl;
      eexists; intuition eauto;
      match goal with
      |[H: select_total_mem _ _ _ = _ |- _ ]=>
       eapply select_total_mem_synced in H
      end; eauto.
    }
  Qed.

  Theorem abstract_oracles_exist_wrt_recover':
    forall l_selector u,
      abstract_oracles_exist_wrt refinement refines u (|Recover|) (|Recover|) (cached_disk_reboot_list l_selector).
  Proof.
    unfold abstract_oracles_exist_wrt, refines_reboot; induction l_selector;
    simpl; intros; cleanup; invert_exec.
    {
      exists  [ [OpToken (LoggedDiskOperation log_length data_length) Cont] ]; simpl.
      intuition eauto.
      destruct t.
      left.
      eexists; intuition eauto.
      eexists; intuition eauto.
      eexists; intuition eauto.
      unfold refines, cached_log_reboot_rep in *; cleanup.
      left.
      eexists; intuition eauto.
      eapply recover_finished in H7; eauto.
    }
    {
      unfold refines, cached_log_rep in *.
      cleanup.
      eapply log_rep_to_reboot_rep_same in H0.

      eapply abstract_oracles_exist_wrt_recover in H11; eauto; cleanup.
      exists ([OpToken (LoggedDiskOperation log_length data_length) CrashBefore]::x); simpl.
      repeat split; eauto;
      intros; simpl in *; try unify_execs; cleanup.
      eapply recovery_oracles_refine_length in H1; eauto.
      right.
      eexists; repeat split; eauto.
      eexists; repeat split; eauto.
      right.
      eexists; repeat split; eauto.
      intros.

      eapply_fresh recover_crashed in H10; eauto.
      logic_clean; eauto.
      eauto.

      eapply_fresh recover_crashed in H10; eauto;
      [|
        unfold cached_log_reboot_rep;
        eexists; intuition eauto
      ].
      cleanup; repeat split_ors;
      simpl in *; unfold cached_log_reboot_rep in H1;
      cleanup;
      try eapply reboot_rep_to_reboot_rep in H1;
      try eapply crash_rep_recover_to_reboot_rep in H1;
      try eapply log_rep_to_reboot_rep in H1;
      eexists; unfold refines_reboot, cached_log_reboot_rep; simpl;
      eexists; intuition eauto;
      match goal with
      |[H: select_total_mem _ _ _ = _ |- _ ]=>
       eapply select_total_mem_synced in H
      end; eauto.
    }
  Qed.

  Theorem abstract_oracles_exist_wrt_read:
    forall l_selector a u,
      abstract_oracles_exist_wrt refinement refines u (|Read a|) (|Recover|) (cached_disk_reboot_list l_selector).
  Proof.
    unfold abstract_oracles_exist_wrt, refines_reboot; induction l_selector;
    simpl; intros; cleanup; invert_exec.
    {
      exists  [ [OpToken (LoggedDiskOperation log_length data_length) Cont] ]; simpl.
      intuition eauto; simpl in *; try unify_execs; cleanup.
      left.
      eexists; intuition eauto.
      eexists; intuition eauto.
      eexists; intuition eauto.

      left.
      eexists; intuition eauto.
      eexists; intuition eauto.
      eapply_fresh read_finished in H7; eauto; cleanup.
      cleanup; eauto.
    }
    {
      unfold refines, cached_log_rep in *.
      cleanup.
      eapply_fresh log_rep_to_reboot_rep_same in H0.

      eapply abstract_oracles_exist_wrt_recover in H11; eauto; cleanup.
      exists ([OpToken (LoggedDiskOperation log_length data_length) CrashBefore]::x); simpl.
      repeat split; eauto; intros; simpl in *; try (unify_execs; cleanup).
      eapply recovery_oracles_refine_length in H1; eauto.

      right; eexists; intuition eauto.
      eexists; intuition eauto.
      eapply_fresh read_crashed in H10; cleanup; eauto.
      eauto.
      {
        eapply_fresh read_crashed in H10; cleanup; eauto.
        eapply reboot_rep_to_reboot_rep in Hx.
        eexists; unfold cached_log_reboot_rep; simpl.
        eexists; simpl; intuition eauto.
        unfold cached_log_reboot_rep; simpl.
        eexists; intuition eauto.
        simpl in *.
        eapply select_total_mem_synced in H1; eauto.
      }
    }
  Qed.

  Arguments cached_log_rep: simpl never.
  Arguments cached_log_crash_rep: simpl never.

  Fixpoint non_colliding_selector_rec {T}
u (R: state CachedDiskLang -> T -> Prop)
l_selector (rec: prog CachedDiskLang unit) l_o s1 :=
  match l_selector with
  | nil => True
  | selector :: ls =>
    match l_o with
    | nil => True
    | o::lo =>
    forall s1',
    (exists s2, R s1 s2) ->
    exec CachedDiskLang u o s1 rec (Crashed s1') ->
    non_colliding_selector selector (snd s1') /\
    non_colliding_selector_rec u R ls rec lo
    (empty_mem, (fst (snd s1'),
    select_total_mem selector (snd (snd s1'))))
    end
  end.

Definition non_colliding_selector_list {T T'}
u (R: state CachedDiskLang -> T -> Prop)
(Rc: state CachedDiskLang -> T -> Prop)
l_selector
(p: prog CachedDiskLang T')
(rec: prog CachedDiskLang unit) l_o s1 :=
match l_selector with
  | nil => True
  | selector :: ls =>
    match l_o with
    | nil => True
    | o::lo =>
    forall s1',
    (exists s2, R s1 s2) ->
    exec CachedDiskLang u o s1 p (Crashed s1') ->
    non_colliding_selector selector (snd s1') /\
    non_colliding_selector_rec u Rc ls rec lo
    (empty_mem, (fst (snd s1'),
    select_total_mem selector (snd (snd s1'))))
    end
  end.

  Theorem abstract_oracles_exist_wrt_write:
    forall l_selector l_a l_v u l_o s1 s1',

    non_colliding_selector_list
    u refines refines_reboot l_selector
    (refinement.(Simulation.Definitions.compile) (|Write l_a l_v|))
    (refinement.(Simulation.Definitions.compile) (|Recover|))
      l_o s1 ->

      abstract_oracles_exist_wrt_explicit refinement refines u
      (|Write l_a l_v|) (|Recover|) (cached_disk_reboot_list l_selector)
      l_o s1 s1'.
  Proof.
    unfold abstract_oracles_exist_wrt_explicit, refines_reboot; induction l_selector;
    simpl; intros; cleanup; invert_exec.
    {
      exists  [ [OpToken (LoggedDiskOperation log_length data_length) Cont] ]; simpl.
      intuition eauto; try unify_execs; cleanup.
      left.
      eexists; intuition eauto.
      eexists; intuition eauto.
      eexists; intuition eauto.
      left.
      eexists; intuition eauto.
      eexists; intuition eauto.
      eapply_fresh write_finished in H8; eauto.
      unfold refines, cached_log_rep in *;
      cleanup; eauto.
      split_ors; cleanup.
      {
        clear H5.
        left; eexists; intuition eauto.
        rewrite <- H9.
        setoid_rewrite H0 in H2.
        repeat rewrite total_mem_map_shift_comm.
        repeat rewrite total_mem_map_fst_list_upd_batch_set.
        erewrite empty_mem_list_upd_batch_eq_list_upd_batch_total; eauto.
        eapply log_rep_forall2_txns_length_match; eauto.
        eexists; eauto.
        eapply log_rep_forall2_txns_length_match; eauto.
      }
      {
        right; eexists; intuition eauto.
        rewrite <- H12.
        setoid_rewrite H0 in H2.
        repeat rewrite total_mem_map_shift_comm.
        repeat rewrite total_mem_map_fst_list_upd_batch_set.
        erewrite empty_mem_list_upd_batch_eq_list_upd_batch_total; eauto.
        eapply log_rep_forall2_txns_length_match; eauto.
        eexists; eauto.
        eapply log_rep_forall2_txns_length_match; eauto.
      }
    }
    {
      unfold refines, cached_log_rep in *.
      cleanup.
      unfold log_rep in *; cleanup.
      eapply_fresh write_crashed_oracle in H11; eauto.

      eapply abstract_oracles_exist_wrt_recover in H13; eauto; cleanup.
      repeat split_ors.
      cleanup.
      {
        exists ([OpToken (LoggedDiskOperation log_length data_length) CrashBefore]::x1); simpl.
        repeat split; eauto; intros; try unify_execs; cleanup.
        eapply recovery_oracles_refine_length in H2; eauto.
        right.
        eexists; repeat split; eauto.
        eexists; repeat split; eauto.
        right.
        eexists; left.
        repeat split; eauto.
        unfold cached_log_rep in H4; cleanup.
        left.
        unfold cached_log_rep in *; simpl in *; cleanup.
        repeat split; eauto.
        eexists; repeat split; eauto.
        rewrite <- H12.
        repeat rewrite total_mem_map_shift_comm.
        repeat rewrite total_mem_map_fst_list_upd_batch_set.
        erewrite empty_mem_list_upd_batch_eq_list_upd_batch_total; eauto.
        eapply log_rep_forall2_txns_length_match; eauto.
        eexists; eauto.
        eapply log_rep_forall2_txns_length_match; eauto.
        eexists; eauto.
        {
          unfold log_header_rep, log_rep_general,
          log_rep_explicit, log_header_block_rep in *; cleanup.
          eauto.
        }
      }
      unfold cached_log_crash_rep in *; cleanup.
      split_ors; cleanup.
      split_ors; cleanup.
      {
        exists ([OpToken (LoggedDiskOperation log_length data_length) CrashBefore]::x1); simpl.
        repeat split; eauto; intros; try unify_execs; cleanup.
        eapply recovery_oracles_refine_length in H2; eauto.
        right.
        eexists; repeat split; eauto; try unify_execs; cleanup.
        eexists; repeat split; eauto; try unify_execs; cleanup.
        right.
        eexists; right; repeat split; eauto.
        right.
        unfold cached_log_crash_rep; simpl.
        repeat split; eauto.
        unfold cached_log_rep in *; cleanup.
        left; eexists; repeat split; eauto.
        eexists; repeat split; eauto.
        setoid_rewrite H0 in H13.
        setoid_rewrite <- H9.
        repeat rewrite total_mem_map_shift_comm.
        repeat rewrite total_mem_map_fst_list_upd_batch_set.
        erewrite empty_mem_list_upd_batch_eq_list_upd_batch_total; eauto.
        eapply log_rep_forall2_txns_length_match; eauto.
        unfold log_rep; eauto.
        eapply log_rep_forall2_txns_length_match; eauto.
        unfold log_rep; eauto.

        {
          unfold log_header_rep, log_rep_general,
          log_rep_explicit, log_header_block_rep in *; cleanup.
          eauto.
        }
        (*
        unfold cached_log_rep in *; cleanup.
        left; intuition eauto.
        eapply crash_rep_log_write_to_reboot_rep in H3.
        unfold cached_log_reboot_rep.
        eexists; intuition eauto.
        simpl.

        unfold log_rep, log_reboot_rep, log_rep_general in *.
        logic_clean.
        erewrite map_addr_list_eq_map_map; eauto.
        rewrite shift_list_upd_batch_set_comm; eauto.
        setoid_rewrite map_addr_list_eq_map_map at 2; eauto.
        rewrite shift_list_upd_batch_set_comm; eauto.
        rewrite shift_select_total_mem_synced.
        eapply empty_mem_list_upd_batch_eq_list_upd_batch_total in H11; eauto.
        repeat rewrite <- shift_list_upd_batch_set_comm.
        repeat erewrite <- map_addr_list_eq_map_map; eauto.
        repeat rewrite total_mem_map_shift_comm in *.
        repeat rewrite total_mem_map_fst_list_upd_batch_set in *.
        setoid_rewrite <- H11; eauto.

        all: try apply sumbool_agree_addr_dec.
        all: try eapply log_rep_forall2_txns_length_match; eauto.
        all: unfold log_rep, log_rep_general; eauto.
        intros; apply H9; lia.
        *)
      }
      {
        eapply_fresh crash_rep_header_write_to_reboot_rep' in H4.
        split_ors.
        {
          exists ([OpToken (LoggedDiskOperation log_length data_length) CrashBefore]::x1); simpl.
          repeat split; eauto; intros; try unify_execs; cleanup.
          eapply recovery_oracles_refine_length in H2; eauto.
          right.
          eexists; repeat split; eauto; try unify_execs; cleanup.
          eexists; repeat split; eauto; try unify_execs; cleanup.
          right.
          eexists; right; repeat split; eauto.
          right.
          unfold cached_log_crash_rep; simpl.
          repeat split; eauto.
          unfold cached_log_rep in *; cleanup.
          right; do 2 eexists; repeat split; eauto;
          repeat rewrite <- sync_list_upd_batch_set in *.
          setoid_rewrite <- H12.
          setoid_rewrite <- H13.
          setoid_rewrite H0 in H19.
          repeat rewrite total_mem_map_shift_comm.
          repeat rewrite total_mem_map_fst_list_upd_batch_set.
          erewrite empty_mem_list_upd_batch_eq_list_upd_batch_total; eauto.
          eapply log_rep_forall2_txns_length_match; eauto.
          unfold log_rep; eauto.
          eapply log_rep_forall2_txns_length_match; eauto.
          unfold log_rep; eauto.

          setoid_rewrite <- H13.
          setoid_rewrite H0 in H19.
          repeat rewrite total_mem_map_shift_comm.
          repeat rewrite total_mem_map_fst_list_upd_batch_set.
          erewrite empty_mem_list_upd_batch_eq_list_upd_batch_total; eauto.
          eapply log_rep_forall2_txns_length_match; eauto.
          unfold log_rep; eauto.
          eapply log_rep_forall2_txns_length_match; eauto.
          unfold log_rep; eauto.

          {
            unfold log_header_rep, log_rep_general,
            log_rep_explicit, log_header_block_rep in *; cleanup.
            intuition eauto.
          }

          unfold cached_log_rep in *; cleanup.
          left; repeat split; eauto.
          unfold cached_log_reboot_rep_explicit_part.
          do 2 eexists; repeat split; eauto.
          simpl; eexists; repeat split; eauto.

          unfold log_rep, log_header_rep,
          log_reboot_rep_explicit_part, log_rep_general in *.
          logic_clean.
          erewrite map_addr_list_eq_map_map; eauto.
          rewrite shift_list_upd_batch_set_comm; eauto.
          setoid_rewrite map_addr_list_eq_map_map at 2; eauto.
          rewrite shift_list_upd_batch_set_comm; eauto.
          rewrite shift_select_total_mem_synced.

          repeat rewrite <- shift_list_upd_batch_set_comm.
          repeat erewrite <- map_addr_list_eq_map_map; eauto.
          repeat rewrite total_mem_map_shift_comm in *.
          repeat rewrite total_mem_map_fst_list_upd_batch_set in *.
          setoid_rewrite <- H13; eauto.
          setoid_rewrite H0 in H19.
          repeat rewrite total_mem_map_shift_comm.
          repeat rewrite total_mem_map_fst_list_upd_batch_set.
          erewrite empty_mem_list_upd_batch_eq_list_upd_batch_total; eauto.

          all: try apply sumbool_agree_addr_dec.
          all: try solve [eapply log_rep_forall2_txns_length_match; unfold log_rep, log_rep_general; eauto].
          intros; apply H14; lia.
          unfold select_total_mem.
          setoid_rewrite H9; simpl.
          unfold select_for_addr; cleanup; eauto.
          erewrite addr_list_to_blocks_length_eq; eauto.
          rewrite map_length; eauto.
        }
        split_ors; cleanup.
        {
          exists ([OpToken (LoggedDiskOperation log_length data_length) CrashBefore]::x1); simpl.
          repeat split; eauto; intros; try unify_execs; cleanup.
          eapply recovery_oracles_refine_length in H2; eauto.
          right.
          eexists; repeat split; eauto; try unify_execs; cleanup.
          eexists; repeat split; eauto; try unify_execs; cleanup.
          right.
          eexists; right; repeat split; eauto.
          right.
          unfold cached_log_crash_rep; simpl.
          repeat split; eauto.
          unfold cached_log_rep in *; cleanup.
          right; do 2 eexists; repeat split; eauto;
          repeat rewrite <- sync_list_upd_batch_set in *.
          setoid_rewrite <- H12.
          setoid_rewrite <- H13.
          setoid_rewrite H0 in H22.
          repeat rewrite total_mem_map_shift_comm.
          repeat rewrite total_mem_map_fst_list_upd_batch_set.
          erewrite empty_mem_list_upd_batch_eq_list_upd_batch_total; eauto.
          eapply log_rep_forall2_txns_length_match; eauto.
          unfold log_rep; eauto.
          eapply log_rep_forall2_txns_length_match; eauto.
          unfold log_rep; eauto.

          setoid_rewrite <- H13.
          setoid_rewrite H0 in H22.
          repeat rewrite total_mem_map_shift_comm.
          repeat rewrite total_mem_map_fst_list_upd_batch_set.
          erewrite empty_mem_list_upd_batch_eq_list_upd_batch_total; eauto.
          eapply log_rep_forall2_txns_length_match; eauto.
          unfold log_rep; eauto.
          eapply log_rep_forall2_txns_length_match; eauto.
          unfold log_rep; eauto.

          {
            unfold log_header_rep, log_rep_general,
            log_rep_explicit, log_header_block_rep in *; cleanup.
            intuition eauto.
          }

          unfold cached_log_rep in *; cleanup.
          right; left; repeat split; eauto.
          unfold cached_log_reboot_rep_explicit_part.
          do 2 eexists; repeat split; eauto.
          simpl; eexists; repeat split; eauto.

          unfold log_rep, log_header_rep,
          log_reboot_rep_explicit_part, log_rep_general in *.
          logic_clean.
          erewrite map_addr_list_eq_map_map; eauto.
          rewrite shift_list_upd_batch_set_comm; eauto.
          setoid_rewrite map_addr_list_eq_map_map at 2; eauto.
          rewrite shift_list_upd_batch_set_comm; eauto.
          rewrite shift_select_total_mem_synced.

          repeat rewrite <- shift_list_upd_batch_set_comm.
          repeat erewrite <- map_addr_list_eq_map_map; eauto.
          repeat rewrite total_mem_map_shift_comm in *.
          repeat rewrite total_mem_map_fst_list_upd_batch_set in *.
          setoid_rewrite <- H13; eauto.
          setoid_rewrite H0 in H22.
          repeat rewrite total_mem_map_shift_comm.
          repeat rewrite total_mem_map_fst_list_upd_batch_set.
          erewrite empty_mem_list_upd_batch_eq_list_upd_batch_total; eauto.

          all: try apply sumbool_agree_addr_dec.
          all: try solve [eapply log_rep_forall2_txns_length_match; unfold log_rep, log_rep_general; eauto].
          intros; apply H14; lia.
          {
            split_ors; cleanup.
            {
              unfold log_header_rep, log_rep_general,
              log_rep_explicit, log_header_block_rep in *; cleanup.
              left; intuition eauto.
              exists (x6 - count (current_part (decode_header (fst (snd (snd s1) hdr_block_num))))).

              unfold log_crash_rep,
              log_reboot_rep_explicit_part,
              log_rep_explicit, log_header_block_rep in *; logic_clean.
              simpl in *; rewrite H41 in H9; inversion H9.
              subst.
              repeat rewrite encode_decode_header in *.
              rewrite H4 in *.

              unfold log_reboot_rep_explicit_part,
              log_rep_explicit, log_rep_inner,
              header_part_is_valid, txns_valid in *;
              simpl in *; logic_clean.

              repeat match goal with
              |[H: count (_ _) = _|- _] =>
                rewrite H in *
              end.

              repeat match goal with
              |[H: map _ _ = records (_ _)|- _] =>
                rewrite <- H in *
              end.
              repeat rewrite map_map in *.
              repeat rewrite map_app in *; simpl in *.
              rewrite fold_left_app in H19; simpl in *.

              match goal with
              |[H: Forall _ (_ ++ [_]) |- _] =>
                eapply forall_app_l in H;
                inversion H; subst
              end.
              unfold txn_well_formed in *; logic_clean.
              match goal with
              |[H: addr_count _ = _,
                H0: data_count _ = _,
                H1: addr_blocks _ = _ |- _] =>
                rewrite H, H0, H1 in *
              end.
              erewrite addr_list_to_blocks_length_eq in H19.
              2: apply map_length.

              repeat rewrite <- PeanoNat.Nat.add_assoc.
              repeat rewrite Minus.le_plus_minus_r by lia.
              unfold select_total_mem in *; simpl in *.
              repeat split; eauto.
              lia.
              intros Hx.
              apply H21.
              rewrite Hx.
              edestruct H25; eauto.
              instantiate (1:= x6 -
              fold_left PeanoNat.Nat.add
          (map (fun x : txn => addr_count (record x) + data_count (record x))
             x2) 0).
              lia.
              repeat rewrite <- PeanoNat.Nat.add_assoc in *.
              repeat rewrite Minus.le_plus_minus_r in * by lia.
              eauto.
            }
            {
              unfold log_header_rep, log_rep_general,
              log_rep_explicit, log_header_block_rep in *; cleanup.
              right; intuition eauto.
              exists x6.

              unfold log_crash_rep,
              log_reboot_rep_explicit_part,
              log_rep_explicit, log_header_block_rep in *; logic_clean.
              simpl in *; rewrite H41 in H9; inversion H9.
              subst.
              repeat rewrite encode_decode_header in *.
              rewrite H4 in *.

              unfold log_reboot_rep_explicit_part,
              log_rep_explicit, log_rep_inner,
              header_part_is_valid, txns_valid in *;
              simpl in *; logic_clean.

              repeat match goal with
              |[H: count (_ _) = _|- _] =>
                rewrite H in *
              end.

              rewrite <- H64, <- H70 in *; simpl in *.

              match goal with
              |[H: Forall _ [_] |- _] =>
                inversion H; subst
              end.
              unfold txn_well_formed in *; logic_clean.
              match goal with
              |[H: addr_count _ = _,
                H0: data_count _ = _,
                H1: addr_blocks _ = _ |- _] =>
                rewrite H, H0, H1 in *
              end.
              erewrite addr_list_to_blocks_length_eq in H19.
              2: apply map_length.

              repeat rewrite <- PeanoNat.Nat.add_assoc.
              repeat rewrite Minus.le_plus_minus_r by lia.
              unfold select_total_mem in *; simpl in *.
              repeat split; eauto.
              intros Hx.
              apply H21.
              rewrite Hx.
              edestruct H25; eauto.
            }
          }
          erewrite addr_list_to_blocks_length_eq; eauto.
          rewrite map_length; eauto.
        }
        {
          exists ([OpToken (LoggedDiskOperation log_length data_length) CrashAfter]::x1); simpl.
          repeat split; eauto; intros; try unify_execs; cleanup.
          eapply recovery_oracles_refine_length in H2; eauto.
          right.
          eexists; repeat split; eauto; try unify_execs; cleanup.
          eexists; repeat split; eauto; try unify_execs; cleanup.
          right.
          eexists; right; repeat split; eauto.
          right.
          unfold cached_log_crash_rep; simpl.
          repeat split; eauto.
          unfold cached_log_rep in *; cleanup.
          right; do 2 eexists; repeat split; eauto;

          repeat rewrite <- sync_list_upd_batch_set in *.
          setoid_rewrite <- H12.
          setoid_rewrite <- H13.
          setoid_rewrite H0 in H20.
          repeat rewrite total_mem_map_shift_comm.
          repeat rewrite total_mem_map_fst_list_upd_batch_set.
          erewrite empty_mem_list_upd_batch_eq_list_upd_batch_total; eauto.
          eapply log_rep_forall2_txns_length_match; eauto.
          unfold log_rep; eauto.
          eapply log_rep_forall2_txns_length_match; eauto.
          unfold log_rep; eauto.

          setoid_rewrite <- H13.
          setoid_rewrite H0 in H20.
          repeat rewrite total_mem_map_shift_comm.
          repeat rewrite total_mem_map_fst_list_upd_batch_set.
          erewrite empty_mem_list_upd_batch_eq_list_upd_batch_total; eauto.
          eapply log_rep_forall2_txns_length_match; eauto.
          unfold log_rep; eauto.
          eapply log_rep_forall2_txns_length_match; eauto.
          unfold log_rep; eauto.
          {
            unfold log_header_rep, log_rep_general,
            log_rep_explicit, log_header_block_rep in *; cleanup.
            intuition eauto.
          }

          unfold cached_log_rep in *; cleanup.
          right; right; repeat split; eauto.
          unfold cached_log_reboot_rep_explicit_part.
          do 2 eexists; repeat split; eauto.
          simpl; eexists; repeat split; eauto.

          unfold log_rep, log_header_rep,
          log_reboot_rep_explicit_part, log_rep_general in *.
          logic_clean.
          erewrite map_addr_list_eq_map_map; eauto.
          rewrite shift_list_upd_batch_set_comm; eauto.
          setoid_rewrite map_addr_list_eq_map_map at 2; eauto.
          rewrite shift_list_upd_batch_set_comm; eauto.
          rewrite shift_select_total_mem_synced.

          repeat rewrite <- shift_list_upd_batch_set_comm.
          repeat erewrite <- map_addr_list_eq_map_map; eauto.
          repeat rewrite total_mem_map_shift_comm in *.
          repeat rewrite total_mem_map_fst_list_upd_batch_set in *.
          setoid_rewrite <- H12; eauto.
          setoid_rewrite <- H13; eauto.
          setoid_rewrite H0 in H20.
          repeat rewrite total_mem_map_shift_comm.
          repeat rewrite total_mem_map_fst_list_upd_batch_set.
          erewrite empty_mem_list_upd_batch_eq_list_upd_batch_total; eauto.

          all: try apply sumbool_agree_addr_dec.
          all: try solve [eapply log_rep_forall2_txns_length_match; unfold log_rep, log_rep_general; eauto].
          intros; apply H14; lia.
          {
            unfold select_total_mem in *.
            setoid_rewrite H9.
            rewrite select_for_addr_not_1_latest; simpl; eauto.
          }
          {
            split_ors; cleanup.
            {
              unfold log_header_rep, log_rep_general,
            log_rep_explicit, log_header_block_rep in *; cleanup.
              left; intuition eauto.
              edestruct H23; eauto.
              erewrite <- H21.
              setoid_rewrite <- H19; fold Nat.add; try lia.
              unfold select_total_mem; simpl; eauto.

              unfold log_crash_rep,
              log_reboot_rep_explicit_part,
              log_rep_explicit, log_header_block_rep in *; logic_clean.
              simpl in *; rewrite H42 in H9; inversion H9.
              subst.
              repeat rewrite encode_decode_header in *.
              rewrite H4.

              unfold log_reboot_rep_explicit_part,
              log_rep_explicit, log_rep_inner,
              header_part_is_valid, txns_valid in *;
              simpl in *; logic_clean.

              repeat match goal with
              |[H: count (_ _) = _|- _] =>
                setoid_rewrite H
              end.

              repeat match goal with
              |[H: map _ _ = records (_ _)|- _] =>
                setoid_rewrite <- H
              end.
              repeat rewrite map_map in *.
              repeat rewrite map_app in *; simpl.
              setoid_rewrite fold_left_app; simpl.

              match goal with
              |[H: Forall _ (_ ++ [_]) |- _] =>
                eapply forall_app_l in H;
                inversion H; subst
              end.
              unfold txn_well_formed in *; logic_clean.
              match goal with
              |[H: addr_count _ = _,
                H0: data_count _ = _,
                H1: addr_blocks _ = _ |- _] =>
                rewrite H, H0, H1
              end.
              erewrite addr_list_to_blocks_length_eq.
              2: apply map_length.
              lia.
            }
            {
              unfold log_header_rep, log_rep_general,
            log_rep_explicit, log_header_block_rep in *; cleanup.
              right; intuition eauto.
              edestruct H23; eauto.
              erewrite <- H21.
              setoid_rewrite <- H19; fold Nat.add; try lia.
              unfold select_total_mem; simpl; eauto.

              unfold log_crash_rep,
              log_reboot_rep_explicit_part,
              log_rep_explicit, log_header_block_rep in *; logic_clean.
              simpl in *; rewrite H42 in H9; inversion H9.
              subst.
              repeat rewrite encode_decode_header in *.

              unfold log_reboot_rep_explicit_part,
              log_rep_explicit, log_rep_inner,
              header_part_is_valid, txns_valid in *;
              simpl in *; logic_clean.

              repeat match goal with
              |[H: count (_ _) = _|- _] =>
                setoid_rewrite H
              end.

              rewrite <- H59.
              simpl.

              match goal with
              |[H: Forall _ [_] |- _] =>
                inversion H; subst
              end.
              unfold txn_well_formed in *; logic_clean.
              match goal with
              |[H: addr_count _ = _,
                H0: data_count _ = _,
                H1: addr_blocks _ = _ |- _] =>
                rewrite H, H0, H1
              end.
              erewrite addr_list_to_blocks_length_eq.
              2: apply map_length.
              lia.

              unfold log_crash_rep,
              log_reboot_rep_explicit_part,
              log_rep_explicit, log_header_block_rep in *; logic_clean.
              simpl in *; rewrite H42 in H9; inversion H9.
              subst.
              repeat rewrite encode_decode_header in *.
              rewrite H4.

              unfold log_reboot_rep_explicit_part,
              log_rep_explicit, log_rep_inner,
              header_part_is_valid, txns_valid in *;
              simpl in *; logic_clean.

              repeat match goal with
              |[H: count (_ _) = _|- _] =>
                setoid_rewrite H
              end.

              rewrite <- H71.
              simpl; lia.
            }
          }
          erewrite addr_list_to_blocks_length_eq; eauto.
          rewrite map_length; eauto.
        }
        {
          edestruct H; eauto.
          do 2 eexists; intuition eauto.
        }
        all: eauto.
      }
      split_ors; cleanup.
      {
        exists ([OpToken (LoggedDiskOperation log_length data_length) CrashAfter]::x1); simpl.
        repeat split; eauto; intros; try unify_execs; cleanup.
        eapply recovery_oracles_refine_length in H2; eauto.
        right.
        eexists; repeat split; eauto; try unify_execs; cleanup.
        eexists; repeat split; eauto; try unify_execs; cleanup.
        right.
        eexists; right; repeat split; eauto.
        left.
        unfold cached_log_crash_rep in *; simpl; cleanup.
        repeat split; eauto.
        unfold cached_log_rep in *; cleanup.
        eexists; repeat split; eauto.
        repeat rewrite <- sync_list_upd_batch_set in *.
        setoid_rewrite <- H10.
        setoid_rewrite H0 in e.
        repeat rewrite total_mem_map_shift_comm.
        repeat rewrite total_mem_map_fst_list_upd_batch_set.
        erewrite empty_mem_list_upd_batch_eq_list_upd_batch_total; eauto.
        eapply log_rep_forall2_txns_length_match; eauto.
        unfold log_rep; eauto.
        eapply log_rep_forall2_txns_length_match; eauto.
        unfold log_rep; eauto.
        erewrite addr_list_to_blocks_length_eq; eauto.
        rewrite map_length; eauto.
        {
            unfold log_header_rep, log_rep_general,
            log_rep_explicit, log_header_block_rep in *; cleanup.
            setoid_rewrite H7.
            intuition eauto.
        }
      }
      split_ors; cleanup.
      {
        exists ([OpToken (LoggedDiskOperation log_length data_length) CrashBefore]::x1); simpl.
        repeat split; eauto; intros; try unify_execs; cleanup.
        eapply recovery_oracles_refine_length in H2; eauto.
        right.
        eexists; repeat split; eauto; try unify_execs; cleanup.
        eexists; repeat split; eauto.
        right.
        eexists; left; repeat split; eauto.
        {

          unfold cached_log_rep in *; cleanup.
          right; left; eauto.
          unfold cached_log_crash_rep in *;
          simpl in *; cleanup.
          repeat split; eauto.
          eexists; repeat split; eauto.
          cleanup.
          setoid_rewrite <- H13.
          repeat rewrite total_mem_map_shift_comm.
          repeat rewrite total_mem_map_fst_list_upd_batch_set.
          erewrite empty_mem_list_upd_batch_eq_list_upd_batch_total; eauto.
          eapply log_rep_forall2_txns_length_match; eauto.
          unfold log_rep; eauto.
          eapply log_rep_forall2_txns_length_match; eauto.
          unfold log_rep; eauto.
          {
              unfold log_header_rep, log_rep_general,
              log_rep_explicit, log_header_block_rep in *; cleanup.
              eauto.
          }

          {
              unfold log_header_rep, log_rep_general,
              log_rep_explicit, log_header_block_rep in *; cleanup.
              eauto.
          }
          unfold log_header_rep, log_rep_general,
              log_rep_explicit, log_header_block_rep in *; cleanup.
          erewrite addr_list_to_blocks_length_eq; eauto.
        }
      }
      {
        exists ([OpToken (LoggedDiskOperation log_length data_length) CrashBefore]::x1); simpl.
        repeat split; eauto; intros; try unify_execs; cleanup.
        eapply recovery_oracles_refine_length in H2; eauto.
        right.
        eexists; repeat split; eauto; try unify_execs; cleanup.
        eexists; repeat split; eauto.
        right.
        eexists; left; intuition eauto.
        unfold cached_log_rep in H12; cleanup.
        right; right; eauto.
        unfold cached_log_crash_rep in *;
        simpl in *; cleanup.
        eexists; intuition eauto.
        setoid_rewrite <- H13.
        repeat rewrite total_mem_map_shift_comm.
        repeat rewrite total_mem_map_fst_list_upd_batch_set.
        erewrite empty_mem_list_upd_batch_eq_list_upd_batch_total; eauto.
        eapply log_rep_forall2_txns_length_match; eauto.
        unfold log_rep; eauto.
        eapply log_rep_forall2_txns_length_match; eauto.
        unfold log_rep; eauto.
        {
          unfold log_header_rep, log_rep_general,
          log_rep_explicit, log_header_block_rep in *; cleanup.
          lia.
        }
        unfold log_header_rep, log_rep_general,
            log_rep_explicit, log_header_block_rep in *; cleanup.
        erewrite addr_list_to_blocks_length_eq; eauto.
      }
      {
        repeat split_ors.
        {
          unfold cached_log_rep in *; cleanup; eauto;
          try eapply log_rep_to_reboot_rep in H5;
          eexists; unfold refines_reboot, cached_log_reboot_rep; simpl;
          eexists; repeat split; eauto;
            eapply select_total_mem_synced; eauto.
        }
        {
          unfold cached_log_crash_rep in *; cleanup; eauto.
          split_ors; cleanup.
          split_ors; cleanup.
          {
            eapply crash_rep_log_write_to_reboot_rep in H2.
            eexists; unfold refines_reboot, cached_log_reboot_rep; simpl;
            eexists; repeat split; eauto;
            eapply select_total_mem_synced; eauto.
          }
          {
            eapply crash_rep_header_write_to_reboot_rep in H2.
            split_ors;
            eexists; unfold refines_reboot, cached_log_reboot_rep; simpl;
            eexists; repeat split; eauto;
            eapply select_total_mem_synced; eauto.
            edestruct H; eauto.
            do 2 eexists; intuition eauto.
          }
          split_ors; cleanup.
          {
            eapply log_rep_to_reboot_rep in H2.
            eexists; unfold refines_reboot, cached_log_reboot_rep; simpl;
            eexists; repeat split; eauto;
            eapply select_total_mem_synced; eauto.
          }
          split_ors; cleanup.
          {
            split_ors.
            {
              cleanup.
            eapply crash_rep_apply_to_reboot_rep in H2.
            split_ors;
            eexists; unfold refines_reboot, cached_log_reboot_rep; simpl;
            eexists; repeat split; eauto;
            eapply select_total_mem_synced; eauto.
            }
                {
              eapply log_rep_to_reboot_rep in H2.
            eexists; unfold refines_reboot, cached_log_reboot_rep; simpl;
                eexists; repeat split; eauto;
            eapply select_total_mem_synced; eauto.
            }
          }
          {
            eapply log_rep_to_reboot_rep in H2.
            eexists; unfold refines_reboot, cached_log_reboot_rep; simpl;
            eexists; repeat split; eauto;
            eapply select_total_mem_synced; eauto.
          }
        }
      }
    }
Qed.

  Fixpoint not_init {T} (p_abs: abs.(prog) T) :=
    match p_abs with
    |Op _ o =>
     match o with
     | Init _ => False
     | _ => True
     end
    |Ret _ => True
    |Bind p1 p2 =>
     not_init p1 /\ (forall r, not_init (p2 r))
    end.

    (*
  Theorem abstract_oracles_exists_logged_disk:
    forall T (p_abs: abs.(prog) T) l_selector u l_o s1 s1',
      not_init p_abs ->
      (forall T p,
      eq_dep _ _ T p _ (|Write l_a l_v|) ->
        non_colliding_selector_list
    u refines refines_reboot l_selector
    (refinement.(Simulation.Definitions.compile) p)
    (refinement.(Simulation.Definitions.compile) (|Recover|))
      l_o s1) ->
      abstract_oracles_exist_wrt_explicit refinement
      refines u p_abs (|Recover|)
      (cached_disk_reboot_list l_selector) l_o s1 s1'.
  Proof.
    unfold abstract_oracles_exist_wrt_explicit; induction p_abs;
    simpl; intros; cleanup_no_match.
    {(** OPS **)
      destruct o; intuition.
      eapply abstract_oracles_exist_wrt_read; eauto.
      eapply abstract_oracles_exist_wrt_write; eauto.
      eapply H0; eauto.
      eapply abstract_oracles_exist_wrt_recover'; eauto.
    }
    {
      repeat invert_exec; cleanup.
      {
        rewrite <- H3; simpl.
        exists [[Layer.Cont (LoggedDiskOperation log_length data_length)]]; simpl; intuition.
        left.
        eexists; repeat split; eauto; try unify_execs; cleanup.
        eexists; repeat split; eauto; try unify_execs; cleanup.
      }
      {
        destruct l_selector; simpl in *; try congruence; cleanup.
        repeat invert_exec.
        invert_exec'' H10.
        eapply abstract_oracles_exist_wrt_recover in H12; eauto.
        cleanup.
        exists ([Layer.Crash (LoggedDiskOperation log_length data_length)]::x0);
        simpl; intuition eauto.
        apply recovery_oracles_refine_length in H2; eauto.
        right.
        eexists; repeat split; eauto; try unify_execs; cleanup.
        econstructor.
        left; eexists; intuition eauto.
        econstructor.
        unfold refines, cached_log_rep in *.
        cleanup.
        eapply log_rep_to_reboot_rep in H2.
        unfold refines_reboot, cached_log_reboot_rep.
        do 2 eexists; intuition eauto.
        eapply select_total_mem_synced in H3; eauto.
      }
    }
    {
      repeat invert_exec.
      {
        invert_exec'' H13.
        edestruct IHp_abs; eauto.
        instantiate (2:= []); simpl.
        eauto.
        eapply ExecFinished; eauto.
        edestruct H.
        eauto.
        {
          simpl in *.
          edestruct H1; eauto.
        }
        2: {
          instantiate (3:= []); simpl.
          eapply ExecFinished; eauto.
        }
        eapply exec_compiled_preserves_refinement_finished in H10; eauto.
        simpl in *; cleanup; try tauto.
        simpl in *.
        exists ([o0 ++ o]); split; eauto.
        repeat split_ors; cleanup;
        repeat unify_execs; cleanup.
        left.
        cleanup.
        do 2 eexists; repeat split; eauto.
        econstructor; eauto.
        right; simpl; repeat eexists; intuition eauto.
      }
      {
        destruct l_selector; simpl in *; try congruence; cleanup.
        invert_exec'' H11.
        {
          edestruct IHp_abs; eauto.
          instantiate (2:= []); simpl.
          instantiate (1:= RFinished d1' r).
          eapply ExecFinished; eauto.
          edestruct H.
          eauto.
          2: {
            instantiate (3:= t::l_selector); simpl.
            instantiate (1:= Recovered (extract_state_r ret)).
            econstructor; eauto.
          }
          eapply exec_compiled_preserves_refinement_finished in H9; eauto.
          simpl in *; cleanup; try tauto.
          simpl in *.
          exists ((o0 ++ o)::l); split; eauto.
          repeat split_ors; cleanup;
          repeat unify_execs; cleanup.
          right.
          eexists; intuition eauto.
          econstructor; eauto.
          right; simpl; repeat eexists; intuition eauto.
        }
        {
          edestruct IHp_abs; eauto.
          instantiate (2:= t::l_selector); simpl.
          instantiate (1:= Recovered (extract_state_r ret)).
          econstructor; eauto.
          simpl in *; cleanup; try tauto.
          simpl in *.
          eexists (_::l); split; eauto.
          repeat split_ors;
            cleanup; repeat (unify_execs; cleanup).
            right.
            eexists; intuition eauto.
            solve [econstructor; eauto].
        }
      }
    }
  Qed.
*)


(* *********************************************************************)
(*                                                                     *)
(*              The Compcert verified compiler                         *)
(*                                                                     *)
(*          Xavier Leroy, INRIA Paris-Rocquencourt                     *)
(*                                                                     *)
(*  Copyright Institut National de Recherche en Informatique et en     *)
(*  Automatique.  All rights reserved.  This file is distributed       *)
(*  under the terms of the INRIA Non-Commercial License Agreement.     *)
(*                                                                     *)
(* *********************************************************************)

(** Recognition of combined operations, addressing modes and conditions
  during the [CSE] phase. *)

Require Import Coqlib.
Require Import AST.
Require Import Integers.
Require Import Op.
Require Import CSEdomain.

Definition valnum := positive.

Section COMBINE.

Variable get: valnum -> option rhs.

Function combine_compimm_ne_0 (x: valnum) : option(condition * list valnum) :=
  match get x with
  | Some(Op (Ocmp c) ys) => Some (c, ys)
  | Some(Op (Oandimm n) ys) => Some (Cmasknotzero n, ys)
  | _ => None
  end.

Function combine_compimm_eq_0 (x: valnum) : option(condition * list valnum) :=
  match get x with
  | Some(Op (Ocmp c) ys) => Some (negate_condition c, ys)
  | Some(Op (Oandimm n) ys) => Some (Cmaskzero n, ys)
  | _ => None
  end.

Function combine_compimm_eq_1 (x: valnum) : option(condition * list valnum) :=
  match get x with
  | Some(Op (Ocmp c) ys) => Some (c, ys)
  | _ => None
  end.

Function combine_compimm_ne_1 (x: valnum) : option(condition * list valnum) :=
  match get x with
  | Some(Op (Ocmp c) ys) => Some (negate_condition c, ys)
  | _ => None
  end.

Function combine_cond (cond: condition) (args: list valnum) : option(condition * list valnum) :=
  match cond, args with
  | Ccompimm Cne n, x::nil =>
      if Int.eq_dec n Int.zero then combine_compimm_ne_0 x
      else if Int.eq_dec n Int.one then combine_compimm_ne_1 x
      else None
  | Ccompimm Ceq n, x::nil =>
      if Int.eq_dec n Int.zero then combine_compimm_eq_0 x
      else if Int.eq_dec n Int.one then combine_compimm_eq_1 x
      else None
  | Ccompuimm Cne n, x::nil =>
      if Int.eq_dec n Int.zero then combine_compimm_ne_0 x
      else if Int.eq_dec n Int.one then combine_compimm_ne_1 x
      else None
  | Ccompuimm Ceq n, x::nil =>
      if Int.eq_dec n Int.zero then combine_compimm_eq_0 x
      else if Int.eq_dec n Int.one then combine_compimm_eq_1 x
      else None
  | _, _ => None
  end.

Function combine_addr (addr: addressing) (args: list valnum) : option(addressing * list valnum) :=
  match addr, args with
  | Aindexed n, x::nil =>
      match get x with
      | Some(Op (Olea a) ys) => Some(offset_addressing_total a n, ys)
      | _ => None
      end
  | _, _ => None
  end.

Function combine_op (op: operation) (args: list valnum) : option(operation * list valnum) :=
  match op, args with
  | Olea addr, _ =>
      match combine_addr addr args with
      | Some(addr', args') => Some(Olea addr', args')
      | None => None
      end
  | Oandimm n, x :: nil =>
      match get x with
      | Some(Op (Oandimm m) ys) => Some(Oandimm (Int.and m n), ys)
      | _ => None
      end
  | Oorimm n, x :: nil =>
      match get x with
      | Some(Op (Oorimm m) ys) => Some(Oorimm (Int.or m n), ys)
      | _ => None
      end
  | Oxorimm n, x :: nil =>
      match get x with
      | Some(Op (Oxorimm m) ys) => Some(Oxorimm (Int.xor m n), ys)
      | _ => None
      end
  | Ocmp cond, _ =>
      match combine_cond cond args with
      | Some(cond', args') => Some(Ocmp cond', args')
      | None => None
      end
  | _, _ => None
  end.

End COMBINE.


From iris.algebra Require Import auth agree excl gmap frac.
From iris.proofmode Require Import proofmode.
From iris.base_logic Require Import invariants.
From iris.program_logic Require Import adequacy.
Require Import Eqdep_dec.
From cap_machine Require Import stdpp_extra iris_extra cap_lang
     region rules_base rules rules_binary rules_binary_base.
From cap_machine.examples Require Import disjoint_regions_tactics.

Definition mkregion (r_start r_end: Addr) (contents: list Word): gmap Addr Word :=
  list_to_map (zip (finz.seq_between r_start r_end) contents).

Definition mbkregion (r_start r_end: Addr) (contents: list Word) (contents_spec: list Word): gmap Addr (Word * Word) :=
  list_to_map (zip (finz.seq_between r_start r_end) (zip contents contents_spec)).

Lemma zip_seq_between_lookup {A} (b e a : Addr) (l : list A) x :
  (b + length l = Some e)%a →
  (a, x) ∈ zip (finz.seq_between b e) l ↔ ∃ (i:nat), a = (b ^+ i)%a ∧ l !! i = Some x.
Proof.
  revert b e a x. induction l as [| x l].
  { intros * Hl. cbn.
    rewrite (_: b = e). 2: solve_addr.
    rewrite finz_seq_between_empty //. 2: solve_addr. cbn.
    split. by inversion 1. intros [? [? ?] ].  rewrite lookup_nil in H0. congruence. }
  { intros * Hl. cbn in *.
    rewrite finz_seq_between_cons. 2: solve_addr. cbn.
    split.
    { intros [HH|HH]%elem_of_cons.
      { simplify_eq. exists 0. split. solve_addr. constructor. }
      { eapply IHl in HH as [i [? ?] ].
        { exists (S i). split; solve_addr. }
        { solve_addr. } } }
    { intros [i [? H2] ]. destruct i.
      { cbn in H2. simplify_eq. rewrite (_: b ^+ 0%nat = b)%a. constructor. solve_addr. }
      { constructor. cbn in H2. apply IHl. solve_addr. exists i.
        split; solve_addr. } } }
Qed.

Lemma list_to_map_app {A} `{EqDecision A, Countable A} {B} (l1 l2: list (A * B)) :
  (list_to_map (l1 ++ l2) : gmap A B) = list_to_map l1 ∪ list_to_map l2.
Proof.
  revert l2. induction l1.
  { intros l2. rewrite /= left_id_L //. }
  { intros l2. rewrite /= IHl1 insert_union_l //. }
Qed.

Lemma mkregion_app l1 l2 b e :
  (b + length (l1 ++ l2))%a = Some e →
  mkregion b e (l1 ++ l2) =
  mkregion b (b ^+ length l1)%a l1 ∪ mkregion (b ^+ length l1)%a e l2.
Proof.
  rewrite /mkregion. rewrite app_length. intros HH.
  rewrite (finz_seq_between_split _ (b ^+ length l1)%a). 2: split; solve_addr.
  rewrite zip_app. 2: rewrite finz_seq_between_length /finz.dist; solve_addr.
  rewrite list_to_map_app //.
Qed.

Lemma mkregion_lookup (b e a : Addr) l x :
  (b + length l = Some e)%a →
  mkregion b e l !! a = Some x ↔ ∃ (i:nat), a = (b ^+ i)%a ∧ l !! i = Some x.
Proof.
  intros Hl. rewrite /mkregion.
  rewrite -elem_of_list_to_map. apply zip_seq_between_lookup; auto.
  rewrite fst_zip. apply finz_seq_between_NoDup.
  rewrite finz_seq_between_length /finz.dist. solve_addr.
Qed.

Lemma dom_mkregion_incl a e l:
  dom (mkregion a e l) ⊆ list_to_set (finz.seq_between a e).
Proof.
  rewrite /mkregion. generalize (finz.seq_between a e). induction l.
  { intros. rewrite zip_with_nil_r /=. rewrite dom_empty_L. apply empty_subseteq. }
  { intros ll. destruct ll as [| x ll].
    - cbn. rewrite dom_empty_L. done.
    - cbn [list_to_set zip zip_with list_to_map foldr fst snd]. rewrite dom_insert_L.
      set_solver. }
Qed.

Lemma dom_mkregion_incl_rev a e l:
  (a + length l = Some e)%a →
  list_to_set (finz.seq_between a e) ⊆ dom (mkregion a e l).
Proof.
  rewrite /mkregion. intros Hl.
  assert (length (finz.seq_between a e) = length l) as Hl'.
  { rewrite finz_seq_between_length /finz.dist. solve_addr. }
  clear Hl. revert Hl'. generalize (finz.seq_between a e). induction l.
  { intros. rewrite zip_with_nil_r /=. rewrite dom_empty_L.
    destruct l; [| inversion Hl']. cbn. apply empty_subseteq. }
  { intros ll Hll. destruct ll as [| x ll]; [by inversion Hll|].
    cbn [list_to_set zip zip_with list_to_map foldr fst snd].
    rewrite dom_insert_L. cbn in Hll. apply Nat.succ_inj in Hll.
    specialize (IHl ll Hll). set_solver. }
Qed.

Lemma dom_mkregion_eq a e l:
  (a + length l = Some e)%a →
  dom (mkregion a e l) = list_to_set (finz.seq_between a e).
Proof.
  intros Hlen. apply (anti_symm subseteq).
  - apply dom_mkregion_incl.
  - by apply dom_mkregion_incl_rev.
Qed.

Lemma in_dom_mkregion a e l k:
  k ∈ dom (mkregion a e l) →
  k ∈ finz.seq_between a e.
Proof.
  intros H.
  pose proof (dom_mkregion_incl a e l) as HH.
  rewrite elem_of_subseteq in HH.
  specialize (HH _ H). eapply @elem_of_list_to_set; eauto.
  typeclasses eauto.
Qed.

Lemma in_dom_mkregion' a e l k:
  (a + length l = Some e)%a →
  k ∈ finz.seq_between a e →
  k ∈ dom (mkregion a e l).
Proof.
  intros. rewrite dom_mkregion_eq // elem_of_list_to_set //.
Qed.

Ltac disjoint_map_to_list :=
  rewrite (@map_disjoint_dom _ _ (gset Addr)) ?dom_union_L;
  eapply disjoint_mono_l;
  rewrite ?dom_list_to_map_singleton;
  repeat (
    try lazymatch goal with
        | |- _ ∪ _ ⊆ _ =>
          etransitivity; [ eapply union_mono_l | eapply union_mono_r ]
        end;
    [ first [ apply dom_mkregion_incl | reflexivity ] |..]
  );
  try match goal with |- _ ## dom (mkregion _ _ _) =>
    eapply disjoint_mono_r; [ apply dom_mkregion_incl |] end;
  rewrite -?list_to_set_app_L ?dom_list_to_map_singleton;
  apply stdpp_extra.list_to_set_disj.

Lemma mkregion_sepM_to_sepL2 `{Σ: gFunctors} (a e: Addr) l (φ: Addr → Word → iProp Σ) :
  (a + length l)%a = Some e →
  ⊢ ([∗ map] k↦v ∈ mkregion a e l, φ k v) -∗ ([∗ list] k;v ∈ (finz.seq_between a e); l, φ k v).
Proof.
  rewrite /mkregion. revert a e. induction l as [| x l].
  { cbn. intros. rewrite zip_with_nil_r /=. assert (a = e) as -> by solve_addr.
    rewrite /finz.seq_between finz_dist_0. 2: solve_addr. cbn. eauto. }
  { cbn. intros a e Hlen. rewrite finz_seq_between_cons. 2: solve_addr.
    cbn. iIntros "H". iDestruct (big_sepM_insert with "H") as "[? H]".
    { rewrite -not_elem_of_list_to_map /=.
      intros [ [? ?] [-> [? ?]%elem_of_zip_l%elem_of_finz_seq_between] ]%elem_of_list_fmap.
      solve_addr. }
    iFrame. iApply (IHl with "H"). solve_addr. }
Qed.

Lemma mkregion_prepare `{memG Σ} (a e: Addr) l :
  (a + length l)%a = Some e →
  ⊢ ([∗ map] k↦v ∈ mkregion a e l, k ↦ₐ v) ==∗ ([∗ list] k;v ∈ (finz.seq_between a e); l, k ↦ₐ v).
Proof.
  iIntros (?) "H". iDestruct (mkregion_sepM_to_sepL2 with "H") as "H"; auto.
Qed.

Lemma mkregion_prepare_spec `{cfgSG Σ} (a e: Addr) l :
  (a + length l)%a = Some e →
  ⊢ ([∗ map] k↦v ∈ mkregion a e l, k ↣ₐ v) ==∗ ([∗ list] k;v ∈ (finz.seq_between a e); l, k ↣ₐ v).
Proof.
  iIntros (?) "H". iDestruct (mkregion_sepM_to_sepL2 with "H") as "H"; auto.
Qed.

Lemma mkregion_sepM_to_sepL2_zip `{Σ: gFunctors} (a e: Addr) l l' (φ φ': Addr → Word → iProp Σ) :
  (a + length l)%a = Some e →
  (a + length l')%a = Some e →
  ([∗ map] k↦v ∈ mkregion a e l, φ k v) -∗
    ([∗ map] k↦v ∈ mkregion a e l', φ' k v) -∗
    ([∗ map] k↦v ∈ mbkregion a e l l', φ k v.1 ∗ φ' k v.2).
Proof.
  rewrite /mkregion. revert a e l'. induction l as [| x l].
  { cbn. intros. rewrite zip_with_nil_r /=. assert (a = e) as -> by solve_addr.
    rewrite /finz.seq_between /finz.dist /=. assert ((Z.to_nat (e - e)) = 0) as ->. lia. simpl.
    rewrite /mbkregion. rewrite finz_seq_between_empty;[|solve_addr]. eauto. }
  { cbn. intros a e l' Hlen Hlen'.
    assert (length l' = S (length l)) as Hleneq.
    { solve_addr. }
    destruct l';[inversion Hleneq|]. simpl in *.
    rewrite finz_seq_between_cons. 2: solve_addr.
    rewrite /mbkregion /=.
    cbn. iIntros "H H'". iDestruct (big_sepM_insert with "H") as "[? H]".
    { rewrite -not_elem_of_list_to_map /=.
      intros [ [? ?] [-> [? ?]%elem_of_zip_l%elem_of_finz_seq_between] ]%elem_of_list_fmap.
      solve_addr. }
    iDestruct (big_sepM_insert with "H'") as "[? H']".
    { rewrite -not_elem_of_list_to_map /=.
      intros [ [? ?] [-> [? ?]%elem_of_zip_l%elem_of_finz_seq_between] ]%elem_of_list_fmap.
      solve_addr. }
    rewrite (finz_seq_between_cons a). 2: solve_addr. simpl.
    iApply big_sepM_insert.
    { rewrite -not_elem_of_list_to_map /=.
      intros [ [? ?] [-> [? ?]%elem_of_zip_l%elem_of_finz_seq_between] ]%elem_of_list_fmap.
      solve_addr. }
    iFrame. iApply (IHl with "H H'"). solve_addr. solve_addr. }
Qed.

Lemma mbkregion_prepare `{memG Σ, cfgSG Σ} (a e : Addr) l l' :
  (a + length l)%a = Some e →
  (a + length l')%a = Some e →
  ([∗ map] k↦v ∈ mkregion a e l, k ↦ₐ v) -∗
  ([∗ map] k↦v ∈ mkregion a e l', k ↣ₐ v) ==∗
  ([∗ map] k↦v ∈ mbkregion a e l l', k ↦ₐ v.1 ∗ k ↣ₐ v.2).
Proof.
  iIntros (? ?) "H H'". iDestruct (mkregion_sepM_to_sepL2_zip with "H H'") as "H"; auto.
Qed.


(** * LogRel.TypeConstructorsInj: injectivity and no-confusion of type constructors, and many consequences, including subject reduction. *)
From Coq Require Import CRelationClasses.
From LogRel.AutoSubst Require Import core unscoped Ast Extra.
From LogRel Require Import Utils BasicAst Notations Context NormalForms Weakening UntypedReduction
  GenericTyping DeclarativeTyping DeclarativeInstance AlgorithmicTyping.
From LogRel Require Import LogicalRelation Validity Fundamental DeclarativeSubst.
From LogRel.LogicalRelation Require Import Escape Neutral Induction.
From LogRel.Substitution Require Import Escape.

Set Printing Primitive Projection Parameters.

Import DeclarativeTypingProperties.

Section TypeConstructors.

  Definition type_hd_view (Γ : context) {T T' : term} (nfT : isType T) (nfT' : isType T') : Type :=
    match nfT, nfT' with
      | @UnivType s, @UnivType s' => s = s'
      | @ProdType A B, @ProdType A' B' => [Γ |- A' ≅ A] × [Γ,, A' |- B ≅ B']
      | NatType, NatType => True
      | EmptyType, EmptyType => True
      | NeType _, NeType _ => [Γ |- T ≅ T' : U]
      | _, _ => False
    end.

  Lemma red_ty_complete : forall (Γ : context) (T T' : term),
    isType T ->
    [Γ |- T ≅ T'] ->
    ∑ T'', [Γ |- T' ⇒* T''] × isType T''.
  Proof.
    intros * tyT Hconv.
    eapply Fundamental in Hconv as [HΓ HT HT' Hconv].
    eapply reducibleTyEq in Hconv.
    set (HTred := reducibleTy _ HT) in *.
    clearbody HTred.
    clear HT.
    destruct HTred as [[] lr] ; cbn in *.
    destruct lr.
    - destruct Hconv as [[]].
      eexists ; split; tea.
      constructor.
    - destruct Hconv as [? red].
      eexists ; split.
      1: apply red.
      apply ty_ne_whne in ne.
      now constructor.
    - destruct Hconv as [?? red].
      eexists ; split.
      1: apply red.
      now constructor.
    - destruct Hconv as [red].
      eexists ; split.
      1: apply red.
      now constructor.
    - destruct Hconv as [red].
      eexists ; split.
      1: apply red.
      now constructor.
  Qed.

  Lemma ty_conv_inj : forall (Γ : context) (T T' : term) (nfT : isType T) (nfT' : isType T'),
    [Γ |- T ≅ T'] ->
    type_hd_view Γ nfT nfT'.
  Proof.
    intros * Hconv.
    eapply Fundamental in Hconv as [HΓ HT HT' Hconv].
    eapply reducibleTyEq in Hconv.
    set (HTred := reducibleTy _ HT) in *.
    clearbody HTred.
    clear HT.
    eapply reducibleTy in HT'.
    destruct HTred as [[] lrT].
    cbn in *.
    inversion lrT ; subst ; clear lrT.
    - subst.
      destruct Hconv as [].
      assert (T' = U) as HeqT' by (eapply redtywf_whnf ; gen_typing); subst.
      destruct H.
      assert (T = U) as HeqU by (eapply redtywf_whnf ; gen_typing).
      destruct nfT ; inversion HeqU ; subst.
      2: now exfalso ; gen_typing.
      clear HeqU.
      remember U as T eqn:HeqU in nfT' |- * at 2.
      destruct nfT' ; inversion HeqU ; subst.
      2: now exfalso ; gen_typing.
      now reflexivity.
    - destruct neA as [nT ? ne], Hconv as [nT' ? ne'] ; cbn in *.
      assert (T = nT) as <- by
        (apply red_whnf ; gen_typing).
      assert (T' = nT') as <- by
        (apply red_whnf ; gen_typing).
      destruct nfT.
      + apply ty_ne_whne in ne, ne'; exfalso ; gen_typing.
      + apply ty_ne_whne in ne, ne'; exfalso ; gen_typing.
      + apply ty_ne_whne in ne, ne'; inversion ne.
      + destruct nfT'.
        * apply ty_ne_whne in ne, ne'; exfalso ; gen_typing.
        * apply ty_ne_whne in ne, ne'; exfalso ; gen_typing.
        * apply ty_ne_whne in ne, ne'; inversion ne'.
        * apply ty_ne_whne in ne, ne'; inversion ne'; gen_typing.
        * apply ty_ne_whne in ne, ne'. inversion ne.
      + destruct nfT'.
        * apply ty_ne_whne in ne, ne'; exfalso ; gen_typing.
        * apply ty_ne_whne in ne, ne'; exfalso ; gen_typing.
        * apply ty_ne_whne in ne, ne'; inversion ne'.
        * apply ty_ne_whne in ne, ne'; inversion ne'; gen_typing.
        * apply ty_ne_whne in ne, ne'. cbn. gen_typing.
    - assert [|- Γ] by (apply escape in HT' ; boundary).
      rewrite <- (PiRedTyPack.pack_beta ΠA ΠAad) in *.
      remember (PiRedTyPack.pack ΠA ΠAad) as ΠA' eqn:Heq in *.
      clear ΠA ΠAad Heq.
      destruct ΠA' as [dom cod red], Hconv as [dom' cod' red'] ; cbn in *.
      assert (T = tProd dom cod) as HeqT by (apply red_whnf ; gen_typing).
      assert (T' = tProd dom' cod') as HeqT' by (apply red_whnf ; gen_typing).
      destruct nfT.
      1,3,4: congruence.
      2: subst ; exfalso ; gen_typing.
      destruct nfT'.
      1,3,4: congruence.
      2: subst ; exfalso ; gen_typing.
      inversion HeqT ; inversion HeqT' ; subst ; clear HeqT HeqT'.
      cbn.
      assert [Γ |-[ de ] dom' ≅ dom].
      {
        symmetry.
        replace dom with (dom⟨wk_id (Γ := Γ)⟩) by now bsimpl.
        replace dom' with (dom'⟨wk_id (Γ := Γ)⟩) by now bsimpl.
        now unshelve now eapply LogicalRelation.Escape.escapeEq.
      }
      split ; tea.
      replace cod with (cod[tRel 0 .: (wk1 (Γ := Γ) dom') >> tRel ])
        by (bsimpl ; rewrite scons_eta' ; now bsimpl).
      replace cod' with (cod'[tRel 0 .: (wk1 (Γ := Γ) dom') >> tRel ])
        by (bsimpl ; rewrite scons_eta' ; now bsimpl).
      assert [ |-[ de ] Γ,, dom'].
      {
        econstructor ; tea.
        eapply prod_ty_inv.
        now gen_typing.
      }
      (unshelve now eapply LogicalRelation.Escape.escapeEq) ; tea.
      apply neuTerm.
      1: econstructor; reflexivity.
      2: econstructor.
      1,2: eapply wfTermConv.
      2,4: eapply typing_wk; tea.
      1,2: rewrite wk1_ren_on; constructor; tea; constructor.
    - destruct Hconv.
      assert (T' = tNat) as HeqT' by (eapply redtywf_whnf ; gen_typing).
      assert (T = tNat) as HeqT by (destruct NA; eapply redtywf_whnf ; gen_typing).
      destruct nfT; inversion HeqT.
      + destruct nfT'; inversion HeqT'.
        * constructor.
        * exfalso; subst; inversion w.
      + exfalso; subst; inversion w.
    - destruct Hconv.
      assert (T' = tEmpty) as HeqT' by (eapply redtywf_whnf ; gen_typing).
      assert (T = tEmpty) as HeqT by (destruct NA; eapply redtywf_whnf ; gen_typing).
      destruct nfT; inversion HeqT.
      + destruct nfT'; inversion HeqT'.
        * econstructor.
        * exfalso; subst; inversion w.
      + exfalso; subst; inversion w.
  Qed.

  Corollary red_ty_compl_univ_l Γ T :
    [Γ |- U ≅ T] ->
    [Γ |- T ⇒* U].
  Proof.
    intros HT.
    pose proof HT as HT'.
    unshelve eapply red_ty_complete in HT' as (T''&[? nfT]).
    2: econstructor.
    enough (T'' = U) as -> by easy.
    assert [Γ |- U ≅ T''] as Hconv by
      (etransitivity ; [eassumption|now eapply RedConvTyC]).
    unshelve eapply ty_conv_inj in Hconv.
    1: econstructor.
    1: eassumption.
    now destruct nfT, Hconv.
  Qed.

  Corollary red_ty_compl_univ_r Γ T :
    [Γ |- T ≅ U] ->
    [Γ |- T ⇒* U].
  Proof.
    intros.
    eapply red_ty_compl_univ_l.
    now symmetry.
  Qed.

  Corollary red_ty_compl_nat_l Γ T :
    [Γ |- tNat ≅ T] ->
    [Γ |- T ⇒* tNat].
  Proof.
    intros HT.
    pose proof HT as HT'.
    unshelve eapply red_ty_complete in HT' as (T''&[? nfT]).
    2: econstructor.
    enough (T'' = tNat) as -> by easy.
    assert [Γ |- tNat ≅ T''] as Hconv by
      (etransitivity ; [eassumption|now eapply RedConvTyC]).
    unshelve eapply ty_conv_inj in Hconv.
    1: econstructor.
    1: eassumption.
    now destruct nfT, Hconv.
  Qed.

  Corollary red_ty_compl_nat_r Γ T :
    [Γ |- T ≅ tNat] ->
    [Γ |- T ⇒* tNat].
  Proof.
    intros.
    eapply red_ty_compl_nat_l.
    now symmetry.
  Qed.

  Corollary red_ty_compl_empty_l Γ T :
    [Γ |- tEmpty ≅ T] ->
    [Γ |- T ⇒* tEmpty].
  Proof.
    intros HT.
    pose proof HT as HT'.
    unshelve eapply red_ty_complete in HT' as (T''&[? nfT]).
    2: econstructor.
    enough (T'' = tEmpty) as -> by easy.
    assert [Γ |- tEmpty ≅ T''] as Hconv by
      (etransitivity ; [eassumption|now eapply RedConvTyC]).
    unshelve eapply ty_conv_inj in Hconv.
    1: econstructor.
    1: eassumption.
    now destruct nfT, Hconv.
  Qed.

  Corollary red_ty_compl_empty_r Γ T :
    [Γ |- T ≅ tEmpty] ->
    [Γ |- T ⇒* tEmpty].
  Proof.
    intros.
    eapply red_ty_compl_empty_l.
    now symmetry.
  Qed.

  Corollary red_ty_compl_prod_l Γ A B T :
    [Γ |- tProd A B ≅ T] ->
    ∑ A' B', [× [Γ |- T ⇒* tProd A' B'], [Γ |- A' ≅ A] & [Γ,, A' |- B ≅ B']].
  Proof.
    intros HT.
    pose proof HT as HT'.
    unshelve eapply red_ty_complete in HT as (T''&[? nfT]).
    2: econstructor.
    assert [Γ |- tProd A B ≅ T''] as Hconv by
      (etransitivity ; [eassumption|now eapply RedConvTyC]).
    unshelve eapply ty_conv_inj in Hconv.
    1: constructor.
    1: assumption.
    destruct nfT, Hconv.
    do 2 eexists ; split.
    all: eassumption.
  Qed.

  Corollary prod_ty_inj Γ A B  A' B' :
    [Γ |- tProd A B ≅ tProd A' B'] ->
    [Γ |- A' ≅ A] × [Γ,, A' |- B ≅ B'].
  Proof.
    intros Hty.
    unshelve eapply ty_conv_inj in Hty.
    1-2: constructor.
    now eassumption.
  Qed.

End TypeConstructors.

Section Boundary.

  Lemma in_ctx_wf Γ n decl :
    [|- Γ] ->
    in_ctx Γ n decl ->
    [Γ |- decl].
  Proof.
    intros HΓ Hin.
    induction Hin.
    - inversion HΓ ; subst ; cbn in * ; refold.
      renToWk.
      now apply typing_wk.
    - inversion HΓ ; subst ; cbn in * ; refold.
      renToWk.
      now eapply typing_wk.
  Qed.

  Let PCon (Γ : context) := True.
  Let PTy (Γ : context) (A : term) := True.
  Let PTm (Γ : context) (A t : term) := [Γ |- A].
  Let PTyEq (Γ : context) (A B : term) := [Γ |- A] × [Γ |- B].
  Let PTmEq (Γ : context) (A t u : term) := [× [Γ |- A], [Γ |- t : A] & [Γ |- u : A]].

  Lemma boundary : WfDeclInductionConcl PCon PTy PTm PTyEq PTmEq.
  Proof.
    subst PCon PTy PTm PTyEq PTmEq.
    apply WfDeclInduction.
    all: try easy.
    - intros.
      now eapply in_ctx_wf.
    - intros.
      now econstructor.
    - intros.
      now eapply typing_subst1, prod_ty_inv.
    - intros; gen_typing.
    - intros; gen_typing.
    - intros.
      now eapply typing_subst1.
    - intros; gen_typing.
    - intros.
      now eapply typing_subst1.
    - intros * ? _ ? [] ? [].
      split.
      all: constructor ; tea.
      eapply stability1.
      3: now symmetry.
      all: eassumption.
    - intros * ? [].
      split.
      all: now econstructor.
    - intros.
      split.
      + now eapply typing_subst1.
      + econstructor ; tea.
        now econstructor.
      + now eapply typing_subst1.
    - intros * ? _ ? [] ? [].
      split.
      + easy.
      + now econstructor.
      + econstructor ; tea.
        eapply stability1.
        4: eassumption.
        all: econstructor ; tea.
        now symmetry.
    - intros * ? [] ? [].
      split.
      + eapply typing_subst1.
        1: eassumption.
        now eapply prod_ty_inv.
      + now econstructor.
      + econstructor.
        1: now econstructor.
        eapply typing_subst1.
        1: now symmetry.
        econstructor.
        now eapply prod_ty_inv.
    - intros * ? []; split; gen_typing.
    - intros * ? [] ? [] ? [] ? []; split.
      + now eapply typing_subst1.
      + gen_typing.
      + eapply ty_conv.
        assert [Γ |-[de] tNat ≅ tNat] by now constructor.
        1: eapply ty_natElim; tea; eapply ty_conv; tea.
        * eapply typing_subst1; tea; do 2 constructor; boundary.
        * eapply elimSuccHypTy_conv ; tea.
          now boundary.
        * symmetry; now eapply typing_subst1.
    - intros **; split; tea.
      eapply ty_natElim; tea; constructor; boundary.
    - intros **.
      assert [Γ |- tSucc n : tNat] by now constructor.
      assert [Γ |- P[(tSucc n)..]] by now eapply typing_subst1.
      split; tea.
      2: eapply ty_simple_app.
      1,5: now eapply ty_natElim.
      2: tea.
      1: now eapply typing_subst1.
      replace (arr _ _) with (arr P P[tSucc (tRel 0)]⇑)[n..] by now bsimpl.
      eapply ty_app; tea.
    - intros * ? [] ? []; split.
      + now eapply typing_subst1.
      + gen_typing.
      + eapply ty_conv.
        assert [Γ |-[de] tEmpty ≅ tEmpty] by now constructor.
        1: eapply ty_emptyElim; tea; eapply ty_conv; tea.
        * symmetry; now eapply typing_subst1.
    - intros * ? [] ? [].
      split ; gen_typing.
    - intros * ? [].
      split ; gen_typing.
    - intros * ? [] ? [].
      split ; gen_typing.
  Qed.

End Boundary.

Corollary boundary_tm Γ A t : [Γ |- t : A] -> [Γ |- A].
Proof.
  now intros ?%boundary.
Qed.

Corollary boundary_ty_conv_l Γ A B : [Γ |- A ≅ B] -> [Γ |- A].
Proof.
  now intros ?%boundary.
Qed.

Corollary boundary_ty_conv_r Γ A B : [Γ |- A ≅ B] -> [Γ |- B].
Proof.
  now intros ?%boundary.
Qed.

Corollary boundary_ored_ty_r Γ A B : [Γ |- A ⇒ B] -> [Γ |- B].
Proof.
  now intros ?%RedConvTy%boundary.
Qed.

Corollary boundary_red_ty_r Γ A B : [Γ |- A ⇒* B] -> [Γ |- B].
Proof.
  now intros ?%RedConvTyC%boundary.
Qed.

Corollary boundary_tm_conv_l Γ A t u : [Γ |- t ≅ u : A] -> [Γ |- t : A].
Proof.
  now intros []%boundary.
Qed.

Corollary boundary_tm_conv_r Γ A t u : [Γ |- t ≅ u : A] -> [Γ |- u : A].
Proof.
  now intros []%boundary.
Qed.

Corollary boundary_tm_conv_ty Γ A t u : [Γ |- t ≅ u : A] -> [Γ |- A].
Proof.
  now intros []%boundary.
Qed.

Corollary boundary_ored_tm_l Γ A t u : [Γ |- t ⇒ u : A] -> [Γ |- t : A].
Proof.
  now intros []%RedConvTe%boundary.
Qed.

Corollary boundary_ored_tm_r Γ A t u : [Γ |- t ⇒ u : A] -> [Γ |- u : A].
Proof.
  now intros []%RedConvTe%boundary.
Qed.

Corollary boundary_ored_tm_ty Γ A t u : [Γ |- t ⇒ u : A] -> [Γ |- A].
Proof.
  now intros []%RedConvTe%boundary.
Qed.

Corollary boundary_red_tm_r Γ A t u : [Γ |- t ⇒* u : A] -> [Γ |- u : A].
Proof.
  now intros []%RedConvTeC%boundary.
Qed.

Corollary boundary_red_tm_ty Γ A t u : [Γ |- t ⇒* u : A] -> [Γ |- A].
Proof.
  now intros []%RedConvTeC%boundary.
Qed.

#[export] Hint Resolve
  boundary_tm boundary_ty_conv_l boundary_ty_conv_r
  boundary_tm_conv_l boundary_tm_conv_r boundary_tm_conv_ty
  boundary_ored_tm_l boundary_ored_tm_r boundary_ored_tm_ty
  boundary_red_tm_l boundary_red_tm_r boundary_red_tm_ty
  boundary_ored_ty_r boundary_red_ty_r : boundary.

Lemma boundary_ctx_conv_l (Γ Δ : context) :
  [ |- Γ ≅ Δ] ->
  [|- Γ].
Proof.
  destruct 1.
  all: econstructor ; boundary.
Qed.

#[export] Hint Resolve boundary_ctx_conv_l : boundary.

Corollary conv_ctx_refl_l (Γ Δ : context) :
[ |- Γ ≅ Δ] ->
[|- Γ ≅ Γ].
Proof.
  intros.
  eapply ctx_refl ; boundary.
Qed.

Lemma typing_eta' (Γ : context) A B f :
  [Γ |- f : tProd A B] ->
  [Γ,, A |- eta_expand f : B].
Proof.
  intros Hf.
  eapply typing_eta ; tea.
  - eapply prod_ty_inv.
    boundary.
  - eapply prod_ty_inv.
    boundary.
Qed.

Corollary red_ty_compl_prod_r Γ A B T :
  [Γ |- T ≅ tProd A B] ->
  ∑ A' B', [× [Γ |- T ⇒* tProd A' B'], [Γ |- A ≅ A'] & [Γ,, A |- B' ≅ B]].
Proof.
  intros HT.
  symmetry in HT.
  eapply red_ty_compl_prod_l in HT as (?&?&[HA ? HB]).
  do 2 eexists ; split ; tea.
  1: now symmetry.
  symmetry.
  eapply stability1 ; tea.
  1-2: now boundary.
  now symmetry.
Qed.

Section Stability.

  Lemma conv_well_subst (Γ Δ : context) :
    [ |- Γ ≅ Δ] ->
    [Γ |-s tRel : Δ].
  Proof.
    induction 1 as [| * ? HA].
    - now econstructor.
    - assert [Γ |- A] by boundary.
      assert [|- Γ,, A] by
        (econstructor ; boundary).
      econstructor ; tea.
      + eapply well_subst_ext, well_subst_up ; tea.
        reflexivity.
      + eapply wfTermConv.
        1: econstructor; [gen_typing| now econstructor].
        rewrite <- rinstInst'_term; do 2 erewrite <- wk1_ren_on.
        now eapply typing_wk.
  Qed.

  Let PCon (Γ : context) := True.
  Let PTy (Γ : context) (A : term) := forall Δ,
    [|- Δ ≅ Γ] -> [Δ |- A].
  Let PTm (Γ : context) (A t : term) := forall Δ,
    [|- Δ ≅ Γ] -> [Δ |- t : A].
  Let PTyEq (Γ : context) (A B : term) := forall Δ,
    [|- Δ ≅ Γ] -> [Δ |- A ≅ B].
  Let PTmEq (Γ : context) (A t u : term) := forall Δ,
    [|- Δ ≅ Γ] -> [Δ |- t ≅ u : A].

  Theorem stability : WfDeclInductionConcl PCon PTy PTm PTyEq PTmEq.
  Proof.
    red.
    repeat match goal with |- _ × _ => split end.
    1: now unfold PCon.
    all: intros * Hty Δ HΔ.
    all: pose proof (boundary_ctx_conv_l _ _ HΔ).
    all: eapply conv_well_subst in HΔ.
    all: pose proof (subst_refl _ _ _ HΔ).
    all: eapply typing_subst in Hty ; tea.
    all: asimpl ; repeat (rewrite idSubst_term in Hty ; [..|reflexivity]).
    all: try eassumption.
  Qed.

  #[global] Instance ConvCtxSym : Symmetric ConvCtx.
  Proof.
    intros Γ Δ.
    induction 1.
    all: constructor ; tea.
    eapply stability ; tea.
    now symmetry.
  Qed.

  Corollary conv_ctx_refl_r (Γ Δ : context) :
    [ |- Γ ≅ Δ] ->
    [|- Δ ≅ Δ].
  Proof.
    intros H.
    symmetry in H.
    now eapply ctx_refl ; boundary.
  Qed.

  #[global] Instance ConvCtxTrans : Transitive ConvCtx.
  Proof.
    intros Γ1 Γ2 Γ3 H1 H2.
    induction H1 in Γ3, H2 |- *.
    all: inversion H2 ; subst ; clear H2.
    all: constructor.
    1: eauto.
    etransitivity ; tea.
    now eapply stability.
  Qed.

End Stability.

Lemma termGen' Γ t A :
[Γ |- t : A] ->
∑ A', (termGenData Γ t A') × [Γ |- A' ≅ A].
Proof.
intros * H.
destruct (termGen _ _ _ H) as [? [? [->|]]].
2: now eexists.
eexists ; split ; tea.
econstructor.
boundary.
Qed.

Theorem subject_reduction_one Γ t t' A :
    [Γ |- t : A] ->
    [t ⇒ t'] ->
    [Γ |- t ⇒ t' : A].
Proof.
  intros Hty Hred.
  induction Hred in Hty, A |- *.
  - apply termGen' in Hty as (?&((?&?&[-> Hty])&Heq)).
    apply termGen' in Hty as (?&((?&[->])&Heq')).
    eapply prod_ty_inj in Heq' as [? HeqB].
    econstructor.
    1: econstructor ; gen_typing.
    etransitivity ; tea.
    eapply typing_subst1 ; tea.
    now econstructor.
  - apply termGen' in Hty as (?&((?&?&[->])&Heq)).
    econstructor ; tea.
    econstructor.
    1: now eapply IHHred.
    refold ; gen_typing.
  - apply termGen' in Hty as [?[[->]?]].
    econstructor; tea.
    econstructor; tea.
    now eapply IHHred.
  - apply termGen' in Hty as [?[[->]?]].
    econstructor; tea; econstructor; tea.
  - apply termGen' in Hty as [?[[-> ??? hsn] Heq]].
    econstructor; tea; econstructor; tea.
    now apply termGen' in hsn as [? [[]?]].
  - apply termGen' in Hty as [?[[->]?]].
    econstructor; tea.
    econstructor; tea.
    now eapply IHHred.
Qed.

Theorem subject_reduction Γ t t' A :
  [Γ |- t : A] ->
  [t ⇒* t'] ->
  [Γ |- t ⇒* t' : A].
Proof.
  intros Hty.
  induction 1 as [| ? ? ? o red] in A, Hty |- *.
  1: now econstructor.
  eapply subject_reduction_one in o ; tea.
  etransitivity.
  2: eapply IHred.
  1: now constructor.
  boundary.
Qed.

Lemma subject_reduction_one_type Γ A A' :
  [Γ |- A] ->
  [A ⇒ A'] ->
  [Γ |- A ⇒ A'].
Proof.
  intros Hty.
  inversion 1 ; subst.
  all: inversion Hty ; subst ; clear Hty.
  all: econstructor.
  all: now eapply subject_reduction_one.
Qed.

Theorem subject_reduction_type Γ A A' :
[Γ |- A] ->
[A ⇒* A'] ->
[Γ |- A ⇒* A'].
Proof.
  intros Hty.
  induction 1 as [| ? ? ? o red] in Hty |- *.
  1: now econstructor.
  eapply subject_reduction_one_type in o ; tea.
  etransitivity.
  2: eapply IHred.
  1: now constructor.
  boundary.
Qed.

Corollary conv_red_l Γ A A' A'' : [Γ |-[de] A' ≅ A''] -> [A' ⇒* A] -> [Γ |-[de] A ≅ A''].
Proof.
  intros Hconv **.
  etransitivity ; tea.
  symmetry.
  eapply RedConvTyC, subject_reduction_type ; tea.
  boundary.
Qed.