Require Import Verdi.TraceRelations.

Require Import VerdiRaft.Raft.
Require Import VerdiRaft.CommonTheorems.
Require Import VerdiRaft.OutputCorrectInterface.
Require Import VerdiRaft.AppliedEntriesMonotonicInterface.
Require Import VerdiRaft.TraceUtil.

Require Import VerdiRaft.StateMachineCorrectInterface.
Require Import VerdiRaft.SortedInterface.
Require Import VerdiRaft.LastAppliedCommitIndexMatchingInterface.
Require Import VerdiRaft.LogMatchingInterface.

Local Arguments update {_} {_} _ _ _ _ _ : simpl never.

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

  Context {aemi : applied_entries_monotonic_interface}.
  Context {smci : state_machine_correct_interface}.
  Context {si : sorted_interface}.
  Context {lacimi : lastApplied_commitIndex_match_interface}.
  Context {lmi : log_matching_interface}.

  Section inner.
  Variable client : clientId.
  Variables id : nat.
  Variable out : output.

  Theorem in_output_trace_dec :
    forall tr : list (name * (raft_input + list raft_output)),
      {in_output_trace client id out tr} + {~ in_output_trace client id out tr}.
  Proof using.
    unfold in_output_trace.
    intros.
    destruct (find (fun p => match snd p with
                               | inr l => match find (is_client_response client id out) l with
                                            | Some x => true
                                            | None => false
                                          end
                               | _ => false
                             end) tr) eqn:?.
    - find_apply_lem_hyp find_some. break_and.
      repeat break_match; try discriminate.
      find_apply_lem_hyp find_some. break_and.
      unfold is_client_response, in_output_list in *.
      break_match; try discriminate. break_if; try discriminate. do_bool. break_and. do_bool. subst.
      left. exists l, (fst p). clean.
      break_and. do_bool.
      break_if; try congruence. subst. intuition.
      find_reverse_rewrite.
      rewrite <- surjective_pairing.
      auto.
    - right. intro. break_exists. break_and.
      eapply find_none in Heqo; eauto.
      simpl in *. break_match; try discriminate.
      unfold in_output_list in *. break_exists.
      find_eapply_lem_hyp find_none; eauto.
      simpl in *. find_apply_lem_hyp Bool.andb_false_elim.
      break_if; repeat (intuition; do_bool).
      break_if; congruence.
  Qed.

  Lemma in_output_changed :
    forall tr o,
      ~ in_output_trace client id out tr ->
      in_output_trace client id out (tr ++ o) ->
      in_output_trace client id out o.
  Proof using.
    intros. unfold in_output_trace in *.
    break_exists_exists.
    intuition. do_in_app; intuition.
    exfalso. eauto.
  Qed.

  Lemma in_output_list_split :
    forall l l',
      in_output_list client id out (l ++ l') ->
      in_output_list client id out l \/ in_output_list client id out l'.
  Proof using.
    intros.
    unfold in_output_list in *.
    break_exists; do_in_app; intuition eauto.
  Qed.

  Lemma in_output_list_empty :
    ~ in_output_list client id out [].
  Proof using.
    intuition.
  Qed.

  Lemma doLeader_key_in_output_list :
    forall st h os st' m,
      doLeader st h = (os, st', m) ->
      ~ in_output_list client id out os.
  Proof using.
    intros. unfold doLeader, advanceCommitIndex in *.
    repeat break_match; find_inversion; intuition eauto using key_in_output_list_empty.
  Qed.

  Lemma handleInput_key_in_output_list :
    forall st h i os st' m,
      handleInput h i st = (os, st', m) ->
      ~ in_output_list client id out os.
  Proof using.
    intros. unfold handleInput, handleTimeout, handleClientRequest, tryToBecomeLeader in *.
    repeat break_match; find_inversion; intuition eauto using in_output_list_empty;
    unfold in_output_list in *; break_exists; simpl in *; intuition; congruence.
  Qed.

  Lemma deduplicate_log'_app :
    forall l l' ks,
      exists l'',
        deduplicate_log' (l ++ l') ks = deduplicate_log' l ks ++ l''.
  Proof using.
    induction l; intros; simpl in *; intuition; eauto.
    repeat break_match; simpl in *; eauto;
    repeat find_insterU; break_exists; eexists; f_equal; eauto.
  Qed.

  Lemma deduplicate_log_app :
    forall l l',
      exists l'',
        deduplicate_log (l ++ l') = deduplicate_log l ++ l''.
  Proof using.
    eauto using deduplicate_log'_app.
  Qed.

  Lemma in_output_trace_not_nil :
      in_output_trace client id out [] -> False.
  Proof using.
    unfold in_output_trace.
    simpl. intros. break_exists. intuition.
  Qed.

  Lemma in_output_trace_singleton_inv :
    forall h l,
      in_output_trace client id out [(h, inr l)] ->
      in_output_list client id out l.
  Proof using.
    unfold in_output_trace.
    intuition.
    break_exists. simpl in *. intuition.
    find_inversion. auto.
  Qed.

  Lemma in_output_list_app_or :
    forall c i o l1 l2,
      in_output_list c i o (l1 ++ l2) ->
      in_output_list c i o l1 \/
      in_output_list c i o l2.
  Proof using.
    unfold in_output_list.
    intuition.
  Qed.

  Lemma in_output_trace_inp_inv :
    forall h i tr,
      in_output_trace client id out ((h, inl i) :: tr) ->
      in_output_trace client id out tr.
  Proof using.
    unfold in_output_trace.
    intuition. break_exists_exists. simpl in *. intuition.
    find_inversion.
  Qed.

  Lemma in_output_list_not_leader_singleton :
    forall a b,
      ~ in_output_list client id out [NotLeader a b].
  Proof using.
    unfold in_output_list. simpl. intuition. discriminate.
  Qed.

  Lemma handleInput_in_output_list :
    forall h i st os st' ms,
      handleInput h i st = (os, st', ms) ->
      ~ in_output_list client id out os.
  Proof using.
    unfold handleInput, handleTimeout, handleInput, tryToBecomeLeader, handleClientRequest.
    intuition.
    repeat break_match; repeat find_inversion; eauto using in_output_trace_not_nil.
    - exfalso. eapply in_output_list_not_leader_singleton; eauto.
    - exfalso. eapply in_output_list_not_leader_singleton; eauto.
  Qed.

  Lemma in_output_list_cons_or :
    forall a b c l,
      in_output_list client id out (ClientResponse a b c :: l) ->
      (a = client /\ b = id /\ c = out) \/
      in_output_list client id out l.
  Proof using.
    unfold in_output_list.
    simpl. intuition.
    find_inversion. auto.
  Qed.

  Lemma assoc_Some_In :
    forall K V (K_eq_dec : forall k k' : K, {k = k'} + {k <> k'}) k v l,
      assoc (V:=V) K_eq_dec l k = Some v ->
      In (k, v) l.
  Proof using.
    induction l; simpl; intros; repeat break_match.
    - discriminate.
    - find_inversion. auto.
    - intuition.
  Qed.

  Lemma getLastId_Some_In :
    forall st c n o,
      getLastId st c = Some (n, o) ->
      In (c, (n, o)) (clientCache st).
  Proof using.
    unfold getLastId.
    eauto using assoc_Some_In.
  Qed.

  Lemma middle_app_assoc :
    forall A xs (y : A) zs,
      xs ++ y :: zs = (xs ++ [y]) ++ zs.
  Proof using.
    induction xs; intros; simpl; auto using f_equal.
  Qed.

  Lemma deduplicate_log'_snoc_drop_keys :
    forall es ks e n,
      assoc clientId_eq_dec ks (eClient e) = Some n ->
      eId e <= n ->
      deduplicate_log' (es ++ [e]) ks = deduplicate_log' es ks.
  Proof using.
    induction es; simpl; intuition; repeat break_match; repeat find_inversion; do_bool.
    - lia.
    - auto.
    - discriminate.
    - f_equal. destruct (clientId_eq_dec (eClient a) (eClient e)).
      + repeat find_rewrite. find_injection.
        eapply IHes with (n := eId a); auto with *.
        now rewrite get_set_same.
      + eapply IHes; eauto.
        rewrite get_set_diff by auto. auto.
    - eauto.
    - f_equal. destruct (clientId_eq_dec (eClient a) (eClient e)).
      + repeat find_rewrite. discriminate.
      + eapply IHes; eauto.
        rewrite get_set_diff by auto. auto.
  Qed.

  Lemma deduplicate_log'_snoc_drop_es :
    forall es ks e e',
      In e' es ->
      eClient e = eClient e' ->
      eId e <= eId e' ->
      deduplicate_log' (es ++ [e]) ks = deduplicate_log' es ks.
  Proof using.
    induction es; simpl; intuition; repeat break_match; eauto using f_equal;
    repeat find_reverse_rewrite.
    - f_equal. subst. eapply deduplicate_log'_snoc_drop_keys; eauto.
      now rewrite get_set_same.
    - subst. do_bool. eapply deduplicate_log'_snoc_drop_keys; eauto; auto with *.
    - f_equal. subst. eapply deduplicate_log'_snoc_drop_keys; eauto.
      now rewrite get_set_same.
  Qed.

  Lemma deduplicate_log_snoc_drop :
    forall es e e',
      In e' es ->
      eClient e = eClient e' ->
      eId e <= eId e' ->
      deduplicate_log (es ++ [e]) = deduplicate_log es.
  Proof using.
    intros. eapply deduplicate_log'_snoc_drop_es; eauto.
  Qed.

  Lemma deduplicate_log'_snoc_split :
    forall es ks e,
      (forall e', In e' es -> eClient e' = eClient e -> eId e' < eId e) ->
      (forall i, assoc clientId_eq_dec ks (eClient e) = Some i -> i < eId e) ->
      deduplicate_log' (es ++ [e]) ks = deduplicate_log' es ks ++ [e].
  Proof using.
    induction es; intros; simpl in *; intuition.
    - break_match; simpl in *; auto.
      break_if; simpl in *; auto.
      do_bool.
      find_insterU. conclude_using eauto. lia.
    - repeat break_match; simpl in *; auto.
      + f_equal. eapply IHes; eauto.
        intros. do_bool.
        destruct (clientId_eq_dec (eClient a) (eClient e)).
        * repeat find_rewrite.
          find_rewrite_lem get_set_same. find_injection.
          find_insterU. conclude_using eauto. intuition.
        * find_erewrite_lem get_set_diff.
          eauto.
      + f_equal. eapply IHes; eauto.
        intros. do_bool.
        destruct (clientId_eq_dec (eClient a) (eClient e)).
        * repeat find_rewrite.
          find_rewrite_lem get_set_same. find_injection.
          match goal with
            | H : forall _, ?x = _ \/ _ -> _ |- _ =>
              specialize (H x)
          end.
          intuition.
        * find_erewrite_lem get_set_diff.
          eauto.
  Qed.

  Lemma deduplicate_log_snoc_split :
    forall es e,
      (forall e', In e' es -> eClient e' = eClient e -> eId e' < eId e) ->
      deduplicate_log (es ++ [e]) = deduplicate_log es ++ [e].
  Proof using.
    intros.
    eapply deduplicate_log'_snoc_split; eauto.
    intros. simpl in *. congruence.
  Qed.

  Lemma execute_log_app :
    forall xs ys,
      execute_log (xs ++ ys) = let (tr, st) := execute_log xs in execute_log' ys st tr.
  Proof using.
    unfold execute_log.
    intros.
    rewrite execute_log'_app. auto.
  Qed.

  Lemma applyEntry_stateMachine_correct :
    forall st e l st' es,
      applyEntry st e = (l, st') ->
      stateMachine st = snd (execute_log (deduplicate_log es)) ->
      (forall e', In e' es -> eClient e' = eClient e -> eId e' < eId e) ->
      stateMachine st' = snd (execute_log (deduplicate_log es ++ [e])).
  Proof using.
    unfold applyEntry.
    intros.
    repeat break_match; repeat find_inversion. simpl.
    rewrite execute_log_app. simpl. repeat break_let.
    simpl in *. congruence.
  Qed.

  Lemma deduplicate_log_cases :
    forall es e,
      (deduplicate_log (es ++ [e]) = deduplicate_log es /\
       exists e', In e' es /\ eClient e' = eClient e /\ eId e <= eId e') \/
      (deduplicate_log (es ++ [e]) = deduplicate_log es ++ [e] /\
       (forall e', In e' es -> eClient e' = eClient e -> eId e' < eId e)).
  Proof using.
    intros.
    destruct (find (fun e' => andb (if clientId_eq_dec (eClient e') (eClient e) then true else false)
                                  (eId e <=? eId e')) es) eqn:?.
    - left. find_apply_lem_hyp find_some.
      break_if; repeat (break_and; do_bool); try congruence.
      intuition eauto using deduplicate_log_snoc_drop.
    - right.
      match goal with
        | |- _ /\ ?P =>
          assert P; [|intuition; eauto using deduplicate_log_snoc_split]
      end.
      intros.
      find_eapply_lem_hyp find_none; eauto.
      simpl in *. break_if; repeat (do_bool; intuition); try congruence.
  Qed.

  (* FIXME: move to StructTact *)
  Lemma assoc_None :
    forall K V K_eq_dec (l : list (K * V)) k v,
      assoc K_eq_dec l k = None ->
      In (k, v) l ->
      False.
  Proof using.
    intros; induction l; simpl in *; intuition.
    - subst. break_if; congruence.
    - break_match. subst. break_if; try congruence.
      auto.
  Qed.

  Lemma getLastId_None :
    forall st c i o,
      getLastId st c = None ->
      In (c, (i, o)) (clientCache st) ->
      False.
  Proof using.
    intros.
    unfold getLastId in *.
    eauto using assoc_None.
  Qed.

  Lemma output_correct_monotonic :
    forall c i o xs ys,
      output_correct c i o xs ->
      output_correct c i o (xs ++ ys).
  Proof using.
    unfold output_correct.
    intros.
    break_exists.
    intuition.
    pose proof (deduplicate_log_app xs ys). break_exists.
    repeat find_rewrite.
    rewrite app_ass in *. simpl in *.
    eexists. eexists. eexists. eexists. eexists.
    intuition eauto.
  Qed.

  Lemma applyEntry_output_correct :
    forall st e l st' o es,
      applyEntry st e = (l, st') ->
      In o l ->
      stateMachine st = snd (execute_log (deduplicate_log es)) ->
      (forall e', In e' es -> eClient e' = eClient e -> eId e' < eId e) ->
      output_correct (eClient e) (eId e) o (es ++ [e]).
  Proof using.
    unfold applyEntry.
    intros.
    repeat break_match; repeat find_inversion.
    simpl in *. intuition.
    subst.
    unfold output_correct.
    rewrite deduplicate_log_snoc_split by auto.
    destruct (execute_log (deduplicate_log es)) eqn:?.
    eexists. eexists. exists []. eexists. eexists. intuition eauto.
    - rewrite execute_log_app. repeat find_rewrite. simpl in *. find_rewrite. eauto.
    - rewrite rev_app_distr. simpl. auto.
  Qed.

  Lemma cacheApplyEntry_output_correct :
    forall e es st l st' o,
      cacheApplyEntry st e = (l, st') ->
      In o l ->
      (forall c i o,
         getLastId st c = Some (i, o) ->
         output_correct c i o es) ->
      stateMachine st = snd (execute_log (deduplicate_log es)) ->
      (forall c i o e',
         getLastId st c = Some (i, o) ->
         In e' es ->
         eClient e' = c ->
         eId e' <= i) ->
      (forall e',
         In e' es ->
         exists i o,
           getLastId st (eClient e') = Some (i, o) /\
           eId e' <= i) ->
      output_correct (eClient e) (eId e) o (es ++ [e]).
  Proof using.
    unfold cacheApplyEntry.
    intros.
    repeat break_match; repeat find_inversion; simpl in *; intuition.
    - do_bool. subst. eauto using output_correct_monotonic, getLastId_Some_In.
    - eapply applyEntry_output_correct; eauto.
      do_bool. assert (n < eId e) by auto with *.
      intros. assert (eId e' <= n) by eauto. lia.
    - eapply applyEntry_output_correct; eauto.
      intros.
      find_apply_hyp_hyp.
      break_exists. break_and.
      repeat find_rewrite. discriminate.
  Qed.

  Lemma cacheApplyEntry_stateMachine_correct :
    forall st e l st' es,
      cacheApplyEntry st e = (l, st') ->
      stateMachine st = snd (execute_log (deduplicate_log es)) ->
      (forall c i o,
         getLastId st c = Some (i, o) ->
         exists e,
           In e es /\
           eClient e = c /\
           eId e = i) ->
      (forall c i o e',
         getLastId st c = Some (i, o) ->
         In e' es ->
         eClient e' = c ->
         eId e' <= i) ->
      (forall e',
         In e' es ->
         exists i o,
           getLastId st (eClient e') = Some (i, o) /\
           eId e' <= i) ->
      stateMachine st' = snd (execute_log (deduplicate_log (es ++ [e]))).
  Proof using.
    intros.
    unfold cacheApplyEntry in *.
    repeat break_match; repeat find_inversion.
    - find_apply_hyp_hyp. break_exists. break_and.
      erewrite deduplicate_log_snoc_drop; eauto.
      do_bool. lia.
    - find_apply_hyp_hyp. break_exists. break_and.
      erewrite deduplicate_log_snoc_drop; eauto.
      do_bool. lia.
    - find_copy_apply_hyp_hyp. break_exists. break_and.
      pose proof (deduplicate_log_cases es e).
      intuition; break_exists; intuition; repeat find_rewrite.
      + do_bool. assert (eId x0 <= n) by eauto. lia.
      + eapply applyEntry_stateMachine_correct; eauto.
    - pose proof (deduplicate_log_cases es e).
      intuition; break_exists; intuition; repeat find_rewrite.
      + eapply_prop_hyp In In. break_exists. break_and.
        repeat find_rewrite. discriminate.
      + eapply applyEntry_stateMachine_correct; eauto.
  Qed.

  Lemma deduplicate_log_In_if :
    forall e l,
      In e (deduplicate_log l) ->
      In e l.
  Proof using.
    unfold deduplicate_log.
    intros. eauto using deduplicate_log'_In_if.
  Qed.

  Lemma applyEntry_clientCache :
    forall st e l st',
      applyEntry st e = (l, st') ->
      let (out, _) := handler (eInput e) (stateMachine st)
      in (clientCache st' = assoc_set clientId_eq_dec (clientCache st) (eClient e) (eId e, out) /\
          In out l).
  Proof using.
    unfold applyEntry.
    intros.
    repeat break_match; repeat find_inversion. intuition.
  Qed.

  Lemma cacheApplyEntry_clientCache :
    forall st e l st',
      cacheApplyEntry st e = (l, st') ->
      (clientCache st' = clientCache st /\
       (exists i o, getLastId st (eClient e) = Some (i, o) /\
                    eId e <= i) ) \/
      ((let (out, _) := handler (eInput e) (stateMachine st)
       in (clientCache st' = assoc_set clientId_eq_dec (clientCache st) (eClient e) (eId e, out) /\
          In out l)) /\ (getLastId st (eClient e) = None \/
                       (exists i o, getLastId st (eClient e) = Some (i, o) /\
                                    i < eId e))).
  Proof using.
    unfold cacheApplyEntry.
    intros.
    repeat break_match_hyp; repeat find_inversion; do_bool; intuition eauto with *;
    right; (split; [solve [apply applyEntry_clientCache; auto]|]); auto.
    right. do_bool. eexists. eexists. intuition eauto. lia.
  Qed.

  Lemma getLastId_ext :
    forall st st' c,
      clientCache st' = clientCache st ->
      getLastId st' c = getLastId st c.
  Proof using.
    unfold getLastId.
    intros.
    congruence.
  Qed.

  Lemma cacheAppliedEntry_clientCache_preserved :
    forall st e l st' c i o,
      cacheApplyEntry st e = (l, st') ->
      getLastId st c = Some (i, o) ->
      exists i' o',
        getLastId st' c = Some (i', o') /\
        i <= i'.
  Proof using.
    intros.
    unfold cacheApplyEntry in *.
    repeat break_match; try find_inversion; simpl in *; repeat find_rewrite; eauto.
    - do_bool.
      unfold applyEntry in *.
      repeat break_match; find_inversion.
      unfold getLastId in *. simpl in *.
      destruct (clientId_eq_dec (eClient e) c); subst.
      + rewrite get_set_same. find_rewrite.
        find_inversion. eauto.
      + rewrite get_set_diff in *; auto.
        repeat find_rewrite. eauto.
    - unfold applyEntry in *.
      repeat break_match; find_inversion.
      unfold getLastId in *. simpl in *.
      destruct (clientId_eq_dec (eClient e) c); subst.
      + repeat find_rewrite.  congruence.
      + rewrite get_set_diff in *; auto.
        repeat find_rewrite. eauto.
  Qed.

  Lemma cacheAppliedEntry_clientCache_nondecreasing :
    forall st e l st' c i o i' o',
      cacheApplyEntry st e = (l, st') ->
      getLastId st c = Some (i, o) ->
      getLastId st' c = Some (i', o') ->
      i <= i'.
  Proof using.
    intros.
    eapply cacheAppliedEntry_clientCache_preserved in H; eauto.
    break_exists. intuition. repeat find_rewrite. find_inversion. auto.
  Qed.

  Lemma applyEntries_output_correct :
    forall l c i o h st os st' es,
      applyEntries h st l = (os, st') ->
      in_output_list c i o os ->
      (stateMachine st = snd (execute_log (deduplicate_log es))) ->
      (forall c i o,
         getLastId st c = Some (i, o) ->
         output_correct c i o es) ->
      (forall c i o e',
         getLastId st c = Some (i, o) ->
         In e' es -> eClient e' = c -> eId e' <= i) ->
      (forall e',
         In e' es ->
         exists i o,
           getLastId st (eClient e') = Some (i, o) /\ eId e' <= i) ->
      output_correct c i o (es ++ l).
  Proof using out id client.
    induction l; intros; simpl in *.
    - find_inversion. exfalso. eapply in_output_list_empty; eauto.
    - repeat break_let. find_inversion.
      find_apply_lem_hyp in_output_list_app_or.
      break_or_hyp.
      + break_if.
        * unfold in_output_list in *.
          do_in_map. find_inversion.
          rewrite middle_app_assoc. apply output_correct_monotonic.
          eapply cacheApplyEntry_output_correct; eauto.
        * exfalso. eapply in_output_list_empty; eauto.
      + rewrite middle_app_assoc. eapply IHl.
        * eauto.
        * auto.
        * eapply cacheApplyEntry_stateMachine_correct; eauto.
          intros.
          find_apply_hyp_hyp. unfold output_correct in *.
          break_exists. break_and.
          eexists. intuition eauto.
          eapply deduplicate_log_In_if.
          eauto with *.
        * find_copy_apply_lem_hyp cacheApplyEntry_clientCache.
          { intros. break_or_hyp.
            - break_and.
              apply output_correct_monotonic.
              unfold getLastId in *. repeat find_rewrite. eauto.
            - break_let. break_and.
              unfold getLastId in *.
              repeat find_rewrite.
              destruct (clientId_eq_dec (eClient a) c0).
              + subst.  rewrite get_set_same in *. find_inversion.
                eapply cacheApplyEntry_output_correct; eauto.
              + rewrite get_set_diff in * by auto. eauto using output_correct_monotonic.
          }
        * intros.
          do_in_app. simpl in *.
          { intuition.
            - eapply_prop_hyp In In. break_exists. break_and. subst.
              eauto using Nat.le_trans, cacheAppliedEntry_clientCache_nondecreasing.
            - subst. find_copy_apply_lem_hyp cacheApplyEntry_clientCache.
              intuition.
              + break_exists. break_and.
                eauto using Nat.le_trans, cacheAppliedEntry_clientCache_nondecreasing.
              + unfold getLastId in *. break_let. break_and. repeat find_rewrite.
                rewrite get_set_same in *. find_inversion. auto.
              + unfold getLastId in *. break_let. break_and.
                repeat find_rewrite.
                rewrite get_set_same in *. find_inversion. auto.
          }
        * intros.
          do_in_app. simpl in *.
          { intuition.
            - eapply_prop_hyp In In. break_exists. break_and.
              find_copy_eapply_lem_hyp cacheAppliedEntry_clientCache_preserved; eauto.
              break_exists_exists. intuition.
            - subst. find_copy_apply_lem_hyp cacheApplyEntry_clientCache.
              intuition.
              + break_exists. break_and.
                find_copy_eapply_lem_hyp cacheAppliedEntry_clientCache_preserved; eauto.
                break_exists_exists. intuition.
              + break_let. break_and. unfold getLastId. repeat find_rewrite.
                eexists. eexists. rewrite get_set_same. intuition eauto.
              + break_let. break_and. unfold getLastId. repeat find_rewrite.
                eexists. eexists. rewrite get_set_same. intuition eauto.
          }
  Qed.

  Lemma cacheApplyEntry_spec :
    forall st a l st',
      cacheApplyEntry st a = (l, st') ->
      log st' = log st /\
      lastApplied st' = lastApplied st /\
      commitIndex st' = commitIndex st.
  Proof using.
    intros. unfold cacheApplyEntry, applyEntry in *.
    repeat break_match; find_inversion; auto.
  Qed.

  Lemma applyEntries_spec :
    forall es h st os st',
      applyEntries h st es = (os, st') ->
      log st' = log st /\
      lastApplied st' = lastApplied st /\
      commitIndex st' = commitIndex st.
  Proof using.
    induction es; intros; simpl in *.
    - find_inversion. auto.
    - repeat break_match; find_inversion;
      find_apply_hyp_hyp;
      find_apply_lem_hyp cacheApplyEntry_spec;
      intuition; repeat find_rewrite; auto.
  Qed.

  Lemma output_correct_prefix :
    forall l1 l2 client id out,
      Prefix l1 l2 ->
      output_correct client id out l1 ->
      output_correct client id out l2.
  Proof using.
    intros.
    find_apply_lem_hyp Prefix_exists_rest.
    break_exists. subst.
    eauto using output_correct_monotonic.
  Qed.

  Lemma entries_contiguous :
    forall net,
      raft_intermediate_reachable net ->
      (forall h, contiguous_range_exact_lo (log (nwState net h)) 0).
  Proof using lmi.
    intros. find_apply_lem_hyp log_matching_invariant.
    unfold log_matching, log_matching_hosts in *.
    intuition.
    unfold contiguous_range_exact_lo. intuition; eauto.
    find_apply_hyp_hyp. lia.
  Qed.

  Lemma doGenericServer_output_correct :
    forall h ps sigma os st' ms,
      raft_intermediate_reachable (mkNetwork ps sigma) ->
      doGenericServer h (sigma h) = (os, st', ms) ->
      in_output_list client id out os ->
      output_correct client id out (applied_entries (update name_eq_dec sigma h st')).
  Proof using lmi lacimi si smci.
    intros.
    find_copy_apply_lem_hyp logs_sorted_invariant.
    pose proof entries_contiguous.
    match goal with
      | H : context [contiguous_range_exact_lo] |- _ =>
        specialize (H ({| nwPackets := ps; nwState := sigma |}))
    end.
    concludes. simpl in *.
    find_copy_apply_lem_hyp state_machine_correct_invariant.
    unfold state_machine_correct in *. intuition.
    unfold logs_sorted in *. intuition.
    unfold doGenericServer in *.
    break_let. find_inversion.
    find_copy_apply_lem_hyp applyEntries_spec. intuition. repeat find_rewrite.
    eapply applyEntries_output_correct
    with (es := rev (removeAfterIndex (log (sigma h)) (lastApplied (sigma h)))) in Heqp; eauto.
    - rewrite <- rev_app_distr in *.
      eapply output_correct_prefix; eauto.
      break_if.
      + do_bool.
        erewrite findGtIndex_removeAfterIndex_i_lt_i' in *; eauto.
        match goal with
          | |- context [applied_entries (update _ ?sigma ?h ?st)] =>
            pose proof applied_entries_update sigma h st
        end. conclude_using intuition.
        intuition; simpl in *;
        unfold raft_data in *; simpl in *; find_rewrite; auto using Prefix_refl.
        unfold applied_entries in *.
        break_exists. intuition. repeat find_rewrite.
        eapply contiguous_sorted_subset_prefix; eauto using removeAfterIndex_contiguous, removeAfterIndex_sorted.
        intros.
        find_copy_apply_lem_hyp removeAfterIndex_In_le; eauto.
        find_apply_lem_hyp removeAfterIndex_in.
        apply removeAfterIndex_le_In; eauto; try lia.
        find_copy_apply_lem_hyp commitIndex_lastApplied_match_invariant.
        unfold commitIndex_lastApplied_match in *. simpl in *.
        match goal with
          | _ : ?x >= ?y |- _ =>
            assert (y <= x) by lia
        end.
        eapply_prop_hyp le le; eauto. intuition.
      + do_bool.
        erewrite findGtIndex_removeAfterIndex_i'_le_i in *; eauto.
        match goal with
          | |- context [applied_entries (update _ ?sigma ?h ?st)] =>
            pose proof applied_entries_update sigma h st
        end. conclude_using intuition.
        intuition; simpl in *;
        unfold raft_data in *; simpl in *; find_rewrite; auto using Prefix_refl.
        unfold applied_entries in *.
        break_exists. intuition. repeat find_rewrite.
        eapply contiguous_sorted_subset_prefix; eauto using removeAfterIndex_contiguous, removeAfterIndex_sorted.
        intros.
        find_copy_apply_lem_hyp removeAfterIndex_In_le; eauto.
        find_apply_lem_hyp removeAfterIndex_in.
        apply removeAfterIndex_le_In; eauto; try lia.
        find_copy_apply_lem_hyp lastApplied_lastApplied_match_invariant.
        unfold lastApplied_lastApplied_match in *. simpl in *.
        match goal with
          | _ : ?x >= ?y |- _ =>
            assert (y <= x) by lia
        end.
        eapply_prop_hyp le le; eauto. intuition.
    - unfold client_cache_complete in *.
      simpl in *.
      intros. subst.
      find_apply_lem_hyp In_rev. find_apply_hyp_hyp.
      break_exists. intuition. repeat find_rewrite.
      match goal with
        | H : Some _ = Some _ |- _ =>
          invcs H
      end. auto.
    - intros. find_apply_lem_hyp In_rev. eauto.
  Qed.

  Ltac intermediate_networks :=
    match goal with
      | Hdgs : doGenericServer ?h ?st' = _,
               Hdl : doLeader ?st ?h = _ |- context [update _ (nwState ?net) ?h ?st''] =>
        replace st with (update name_eq_dec (nwState net) h st h) in Hdl by eauto using update_eq;
          replace st' with (update name_eq_dec (update name_eq_dec (nwState net) h st) h st' h) in Hdgs by eauto using update_eq;
          let H := fresh "H" in
          assert (update name_eq_dec (nwState net) h st'' =
                  update name_eq_dec (update name_eq_dec (update name_eq_dec (nwState net) h st) h st') h st'') by (repeat rewrite update_overwrite; auto); unfold data in *; simpl in *; rewrite H; clear H
    end.

  Lemma in_output_trace_step_output_correct :
    forall failed failed' (net net' : network (params := @multi_params _ _ raft_params)) os,
      in_output_trace client id out os ->
      @raft_intermediate_reachable _ _ raft_params net ->
      step_failure (failed, net) (failed', net') os ->
      output_correct client id out (applied_entries (nwState net')).
  Proof using lmi lacimi si smci.
    intros.
    match goal with
      | [ H : context [ step_failure _ _ _ ] |- _ ] => invcs H
    end.
    - unfold RaftNetHandler in *. repeat break_let. repeat find_inversion.
      find_apply_lem_hyp in_output_trace_singleton_inv.
      find_apply_lem_hyp in_output_list_app_or.
      intuition.
      + exfalso. eapply doLeader_key_in_output_list; eauto.
      + find_copy_eapply_lem_hyp RIR_handleMessage; eauto.
        find_copy_eapply_lem_hyp RIR_doLeader; simpl; rewrite_update; eauto.
        intermediate_networks.
        find_copy_apply_lem_hyp doLeader_appliedEntries.
        eapply doGenericServer_output_correct; eauto.
    - unfold RaftInputHandler in *. repeat break_let. repeat find_inversion.
      find_apply_lem_hyp in_output_trace_inp_inv.
      find_apply_lem_hyp in_output_trace_singleton_inv.
      find_apply_lem_hyp in_output_list_app_or.
      intuition.
      + exfalso. eapply handleInput_in_output_list; eauto.
      + find_apply_lem_hyp in_output_list_app_or.
        intuition.
        * exfalso. eapply doLeader_key_in_output_list; eauto.
          * find_copy_eapply_lem_hyp RIR_handleInput; eauto.
            find_copy_eapply_lem_hyp RIR_doLeader; simpl; rewrite_update; eauto.
            intermediate_networks.
            find_copy_apply_lem_hyp doLeader_appliedEntries.
            eapply doGenericServer_output_correct; eauto.
    - exfalso. eauto using in_output_trace_not_nil.
    - exfalso. eauto using in_output_trace_not_nil.
    - exfalso. eauto using in_output_trace_not_nil.
    - exfalso. eauto using in_output_trace_not_nil.
  Qed.

  Program Instance TR : TraceRelation step_failure :=
    {
      init := step_failure_init;
      T := in_output_trace client id out ;
      T_dec := in_output_trace_dec ;
      R := fun s => let (_, net) := s in
                    output_correct client id out (applied_entries (nwState net))
    }.
  Next Obligation.
    repeat break_let. subst.
    find_eapply_lem_hyp applied_entries_monotonic';
      eauto using step_failure_star_raft_intermediate_reachable.
    unfold output_correct in *.
    break_exists.
    repeat find_rewrite.
    match goal with
    | [ |- context [ deduplicate_log (?l ++ ?l') ] ] =>
      pose proof deduplicate_log_app l l'; break_exists; find_rewrite
    end.
    repeat eexists; intuition eauto; repeat find_rewrite; auto.
    rewrite app_ass. simpl. repeat f_equal.
  Defined.
  Next Obligation.
    unfold in_output_trace in *. intuition.
    break_exists; intuition.
  Defined.
  Next Obligation.
    find_apply_lem_hyp in_output_changed; auto.
    eauto using in_output_trace_step_output_correct, step_failure_star_raft_intermediate_reachable.
  Defined.

  Theorem output_correct :
    forall  failed net tr,
      step_failure_star step_failure_init (failed, net) tr ->
      in_output_trace client id out tr ->
      output_correct client id out (applied_entries (nwState net)).
  Proof using lmi lacimi si smci aemi.
    intros. pose proof (trace_relations_work (failed, net) tr).
    repeat concludes.
    auto.
  Qed.
  End inner.

  Instance oci : output_correct_interface.
  Proof using smci si lmi lacimi aemi.
    split.
    exact output_correct.
  Qed.
End OutputCorrect.


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

From PromisingLib Require Import Basic.
From PromisingLib Require Import Loc.

From PromisingLib Require Import Event.
From PromisingLib Require Import Language.
Require Import View.
Require Import Cell.
Require Import Memory.
Require Import TView.
Require Import Local.
Require Import Thread.
Require Import Configuration.

Set Implicit Arguments.

(* NOTE: We currently consider only finite behaviors of program: we
 * ignore non-terminating executions.  This simplification affects two
 * aspects of the development:
 *
 * - Liveness.  In our definition, the liveness matters only for
 *   non-terminating execution.
 *
 * - Simulation.  We do not introduce simulation index for inftau
 *   behaviors (i.e. infinite loop without system call interactions).
 *
 * We will consider infinite behaviors in the future work.
 *)
(* NOTE: We serialize all the events within a behavior, but it may not
 * be the case.  The *NIX kernels are re-entrant: system calls may
 * race.
 *)

Inductive behaviors
          (step: forall (e:MachineEvent.t) (tid:Ident.t) (c1 c2:Configuration.t), Prop):
  forall (conf:Configuration.t) (b:list Event.t) (f: bool), Prop :=
| behaviors_nil
    c
    (TERMINAL: Configuration.is_terminal c):
    behaviors step c nil true
| behaviors_syscall
    e1 e2 tid c1 c2 beh f
    (STEP: step (MachineEvent.syscall e2) tid c1 c2)
    (NEXT: behaviors step c2 beh f)
    (EVENT: Event.le e1 e2):
    behaviors step c1 (e1::beh) f
| behaviors_failure
    tid c1 c2 beh f
    (STEP: step MachineEvent.failure tid c1 c2):
    behaviors step c1 beh f
| behaviors_tau
    tid c1 c2 beh f
    (STEP: step MachineEvent.silent tid c1 c2)
    (NEXT: behaviors step c2 beh f):
    behaviors step c1 beh f
| behaviors_partial_term
    c:
    behaviors step c [] false
.

Lemma rtc_tau_step_behavior
      step c1 c2 b f
      (STEPS: rtc (union (step MachineEvent.silent)) c1 c2)
      (BEH: behaviors step c2 b f):
  behaviors step c1 b f.
Proof.
  revert BEH. induction STEPS; auto. inv H.
  i. specialize (IHSTEPS BEH). econs 4; eauto.
Qed.

Lemma le_step_behavior_improve
      sem0 sem1
      (STEPLE: sem0 <4= sem1):
  behaviors sem0 <3= behaviors sem1.
Proof.
  i. ginduction PR; i.
  - econs 1; eauto.
  - econs 2; eauto.
  - econs 3; eauto.
  - econs 4; eauto.
  - econs 5; eauto.
Qed.

Inductive behaviors_partial
          (step: forall (e:MachineEvent.t) (tid:Ident.t) (c1 c2:Configuration.t), Prop):
  forall (conf1 conf2:Configuration.t) (b:list Event.t), Prop :=
| behaviors_partial_nil
    c:
    behaviors_partial step c c nil
| behaviors_partial_syscall
    e tid c1 c2 c3 beh
    (STEP: step (MachineEvent.syscall e) tid c1 c2)
    (NEXT: behaviors_partial step c2 c3 beh):
    behaviors_partial step c1 c3 (e::beh)
| behaviors_partial_tau
    tid c1 c2 c3 beh
    (STEP: step MachineEvent.silent tid c1 c2)
    (NEXT: behaviors_partial step c2 c3 beh):
    behaviors_partial step c1 c3 beh
.

Lemma rtc_tau_step_behavior_partial
      step c1 c2 c3 b
      (STEPS: rtc (union (step MachineEvent.silent)) c1 c2)
      (BEH: behaviors_partial step c2 c3 b):
  behaviors_partial step c1 c3 b.
Proof.
  revert BEH. induction STEPS; auto. inv H.
  i. specialize (IHSTEPS BEH). econs 3; eauto.
Qed.

Lemma behaviors_partial_app_partial
      step c1 c2 c3 b1 b2
      (BEH1: behaviors_partial step c1 c2 b1)
      (BEH2: behaviors_partial step c2 c3 b2)
  :
    behaviors_partial step c1 c3 (b1 ++ b2).
Proof.
  induction BEH1.
  - eauto.
  - econs 2; eauto.
  - econs 3; eauto.
Qed.

Lemma behaviors_partial_app
      step c1 c2 b1 b2 f
      (BEH1: behaviors_partial step c1 c2 b1)
      (BEH2: behaviors step c2 b2 f)
  :
    behaviors step c1 (b1 ++ b2) f.
Proof.
  induction BEH1.
  - eauto.
  - econs 2; eauto. refl.
  - econs 4; eauto.
Qed.


Require Import Eqdep Lia Framework FSParameters.
Require Import TransactionCacheLayer TransactionalDiskLayer.
Require Import Transaction TransactionToTransactionalDisk.Definitions.
Require Import ClassicalFacts FunctionalExtensionality Lia.

Set Nested Proofs Allowed.

Local Notation "'imp'" := TransactionCacheLang.
Local Notation "'abs'" := (TDLang data_length).
Local Notation "'refinement'" := TDRefinement.

Definition TC_reboot_f := fun s: imp.(state) => (([]: list (addr * value)), snd s).

Definition TD_reboot_f := fun s: abs.(state) => (Empty, (snd (snd s), snd (snd s))).

  Definition transaction_cache_reboot_list n := repeat (fun s: imp.(state) => (([]: list (addr * value)), snd s)) n.

  Definition transactional_disk_reboot_list n := repeat (fun s : abs.(state) => (Empty, (snd (snd s), snd (snd 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.

  Theorem abstract_oracles_exist_wrt_recover:
    forall n u,
      abstract_oracles_exist_wrt refinement refines_reboot u (|Recover|) (|Recover|) (transaction_cache_reboot_list n).
  Proof.
    unfold abstract_oracles_exist_wrt, refines_reboot; induction n;
    simpl; intros; cleanup; invert_exec.
    {
      exists  [ [OpToken (TDCore data_length) Cont] ]; simpl.
      intuition eauto.
      left; eexists; intuition eauto.
      destruct t.

      eexists; intuition eauto.
      eapply_fresh recover_finished in H7; eauto.
      cleanup.
      eexists; intuition eauto.
      left.
      unfold transaction_reboot_rep, transaction_rep in *;
      simpl in *. cleanup.
      repeat cleanup_pairs; eauto.
    }
    {
      eapply IHn in H11; eauto; cleanup.
      exists ([OpToken (TDCore data_length) CrashBefore]::x0); simpl.
      eapply_fresh recover_crashed in H10; eauto; cleanup.
      repeat split; eauto; try (unify_execs; cleanup).
      eapply recovery_oracles_refine_length in H0; eauto.
      right.
      eexists; repeat split; eauto;
      simpl in *.
      cleanup; eauto.

      eapply_fresh recover_crashed in H10; eauto; cleanup.
      eexists; unfold transaction_reboot_rep in *; simpl; intuition eauto.
      eapply_fresh recover_crashed in H10; eauto; cleanup.
      eexists; unfold transaction_reboot_rep in *; simpl; intuition eauto.
      instantiate (1:= x); cleanup; eauto.
    }
  Qed.

  Theorem abstract_oracles_exist_wrt_recover':
    forall n u,
      abstract_oracles_exist_wrt refinement refines u (|Recover|) (|Recover|) (transaction_cache_reboot_list n).
  Proof.
    unfold abstract_oracles_exist_wrt, refines_reboot; destruct n;
    simpl; intros; cleanup; invert_exec.
    {
      exists  [ [OpToken (TDCore data_length) Cont] ]; simpl.
      intuition eauto.
      left.
      eexists; intuition eauto.
      destruct t.

      eexists; intuition eauto.
      eapply_fresh recover_finished_2 in H7; eauto.
      eexists; intuition eauto.
      left.
      unfold refines, transaction_rep in *; simpl in *; cleanup.
      repeat cleanup_pairs; eauto.
    }
    {
      eapply abstract_oracles_exist_wrt_recover in H11; eauto; cleanup.
      exists ([OpToken (TDCore data_length) CrashBefore]::x0); simpl.
      eapply_fresh recover_crashed in H10; eauto; cleanup.
      repeat split; eauto; try (unify_execs; cleanup).
      eapply recovery_oracles_refine_length in H0; eauto.
      right.
      eexists; repeat split; eauto;
      simpl in *.
      eexists; repeat split; eauto;
      simpl in *.
      cleanup; eauto.

      unfold refines, refines_reboot,
      transaction_rep, transaction_reboot_rep in *;
      simpl in *; cleanup; eauto.

      eapply_fresh recover_crashed in H10; eauto; cleanup.
      eexists; unfold refines, refines_reboot,
               transaction_rep, transaction_reboot_rep in *;
      simpl in *; cleanup; eauto.

      unfold refines, refines_reboot,
      transaction_rep, transaction_reboot_rep in *;
      simpl in *; cleanup; eauto.
    }
  Qed.

  Theorem abstract_oracles_exist_wrt_read:
    forall n a u,
      abstract_oracles_exist_wrt refinement refines u (|Read a|) (|Recover|) (transaction_cache_reboot_list n).
  Proof.
    unfold abstract_oracles_exist_wrt, refines_reboot; destruct n;
    simpl; intros; cleanup; invert_exec.
    {
      exists  [ [OpToken (TDCore data_length) Cont] ]; simpl.
      intuition eauto.
      left.
      eexists; intuition eauto.
      eexists; intuition eauto.
      eapply_fresh read_finished in H7; eauto.
      eexists; intuition eauto.
    }
    {
      eapply abstract_oracles_exist_wrt_recover in H11; eauto; cleanup.
      exists ([OpToken (TDCore data_length) CrashBefore]::x0); simpl.
      eapply_fresh read_crashed in H10; eauto; cleanup.
      repeat split; eauto; try (unify_execs; cleanup).
      eapply recovery_oracles_refine_length in H0; eauto.
      right.
      eexists; repeat split; eauto;
      simpl in *.
      eexists; repeat split; eauto;
      simpl in *.
      cleanup; eauto.

      eapply_fresh read_crashed in H10; eauto; cleanup.
      eexists; unfold refines, refines_reboot,
               transaction_rep, transaction_reboot_rep in *;
      simpl in *; cleanup; eauto.
    }
  Qed.

  Theorem abstract_oracles_exist_wrt_write:
    forall n l_a l_v u,
      abstract_oracles_exist_wrt refinement refines u (|Write l_a l_v|) (|Recover|) (transaction_cache_reboot_list n).
  Proof.
    unfold abstract_oracles_exist_wrt, refines_reboot; destruct n;
    simpl; intros; cleanup; invert_exec.
    {
      eapply_fresh write_finished in H7; eauto.
      split_ors; cleanup.
      {
        exists  [ [OpToken (TDCore data_length) Cont] ]; simpl.
        intuition eauto.
        left.
        eexists; intuition eauto.

        eexists; intuition eauto.
        eexists; split; eauto.
        left.
        do 2 eexists; split; eauto.
        left; intuition eauto.
        unfold refines, transaction_rep in *; simpl in *; cleanup.
        repeat cleanup_pairs; eauto.
        inversion H0; eauto.
      }
      split_ors; cleanup.
      {
        exists  [ [OpToken (TDCore data_length) Cont] ]; simpl.
        split; eauto.
        left.
        do 2 eexists; repeat (split; eauto).
        intros; eexists; repeat (split; eauto).
        left.
        do 2 eexists; repeat (split; eauto).
      }
      {
        exists  [ [OpToken (TDCore data_length) TxnFull] ]; simpl.
        intuition eauto.
        left.
        eexists; intuition eauto.

        eexists; intuition eauto.
        eexists; split; eauto.
        left.
        do 2 eexists; split; eauto.
        right; right; intuition eauto.
      }

    }
    {
      eapply abstract_oracles_exist_wrt_recover in H11; eauto; cleanup.
      exists ([OpToken (TDCore data_length) CrashBefore]::x0); simpl.
      eapply_fresh write_crashed in H10; eauto; cleanup.
      repeat split; eauto; try (unify_execs; cleanup).
      eapply recovery_oracles_refine_length in H0; eauto.
      right.
      eexists; repeat split; eauto;
      simpl in *.
      eexists; repeat split; eauto;
      simpl in *.
      cleanup; eauto.

      eapply_fresh write_crashed in H10; eauto; cleanup.
      eexists; unfold refines, refines_reboot,
               transaction_rep, transaction_reboot_rep in *;
      simpl in *; cleanup; eauto.
    }
    Qed.

    Theorem abstract_oracles_exist_wrt_abort:
    forall n u,
      abstract_oracles_exist_wrt refinement refines u (|Abort|) (|Recover|) (transaction_cache_reboot_list n).
  Proof.
    unfold abstract_oracles_exist_wrt, refines_reboot; destruct n;
    simpl; intros; cleanup; invert_exec.
    {
      exists  [ [OpToken (TDCore data_length) Cont] ]; simpl.
      intuition eauto.
      left.
      eexists; intuition eauto.
      eexists; intuition eauto.
      eexists; intuition eauto.
      left.
      eexists; intuition eauto.

      eapply_fresh abort_finished in H7; eauto.
      eexists; intuition eauto.
      unfold refines, transaction_rep in *; simpl in *; cleanup.
      repeat cleanup_pairs; eauto.
    }
    {
      eapply abstract_oracles_exist_wrt_recover in H11; eauto; cleanup.
      exists ([OpToken (TDCore data_length) CrashBefore]::x0); simpl.
      eapply_fresh abort_crashed in H10; eauto; cleanup.
      repeat split; eauto; try (unify_execs; cleanup).
      eapply recovery_oracles_refine_length in H0; eauto.
      right.
      eexists; repeat split; eauto;
      simpl in *.
      eexists; repeat split; eauto;
      simpl in *.
      cleanup; eauto.

      eapply_fresh abort_crashed in H10; eauto; cleanup.
      eexists; unfold refines, refines_reboot,
               transaction_rep, transaction_reboot_rep in *;
      simpl in *; cleanup; eauto.
    }
  Qed.

  Theorem abstract_oracles_exist_wrt_commit:
    forall n u,
      abstract_oracles_exist_wrt refinement refines u (|Commit|) (|Recover|) (transaction_cache_reboot_list n).
  Proof.
    unfold abstract_oracles_exist_wrt, refines_reboot; destruct n;
    simpl; intros; cleanup; invert_exec.

    {
      eapply_fresh commit_finished in H7; eauto.
      exists  [ [OpToken (TDCore data_length) Cont] ]; simpl.
      intuition eauto.
      left.
      eexists; intuition eauto.
      eexists; intuition eauto.
      eexists; intuition eauto.
      left.
      eexists; intuition eauto.
      eexists; intuition eauto.
      unfold refines, transaction_rep in *; simpl in *; cleanup.
      repeat cleanup_pairs; eauto.
    }
    {
      eapply abstract_oracles_exist_wrt_recover in H11; eauto; cleanup.
      eapply_fresh commit_crashed in H10; eauto; cleanup.
      split_ors.
      {
        exists ([OpToken (TDCore 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;
        simpl in *.
        eexists; repeat split; eauto;
        simpl in *.
        cleanup; eauto.
        right; eexists; repeat split; eauto;
        simpl in *.
        unfold refines, transaction_rep in *;
        cleanup; eauto.
      }
      {
        exists ([OpToken (TDCore data_length) CrashAfter]::x0); simpl.
        repeat split; eauto; try (unify_execs; cleanup).
        eapply recovery_oracles_refine_length in H0; eauto.
        right.
        eexists; repeat split; eauto;
        simpl in *.
        eexists; repeat split; eauto;
        simpl in *.
        cleanup; eauto.
        right; eexists; repeat split; eauto;
        simpl in *.
        unfold refines, transaction_rep in *;
        cleanup; eauto.
      }
      {
        eapply_fresh commit_crashed in H10; eauto; cleanup.
        split_ors;
        unfold refines, refines_reboot,
        transaction_rep, transaction_reboot_rep in *;
        simpl in *; cleanup; eauto.
        exists (Empty, (fst (snd x), fst (snd x))); simpl; eauto.
      }
    }
  Qed.

  Lemma addrs_match_upd:
    forall A AEQ V1 V2 (m1: @mem A AEQ V1) (m2: @mem A AEQ V2) a v,
      addrs_match m1 m2 ->
      m2 a <> None ->
      addrs_match (upd m1 a v) m2.
  Proof.
    unfold addrs_match; intros; simpl.
    destruct (AEQ a a0); subst;
    [rewrite upd_eq in *
    |rewrite upd_ne in *]; eauto.
  Qed.

  Lemma cons_l_neq:
    forall V (l:list V) v,
      ~ v::l = l.
  Proof.
    induction l; simpl; intros; try congruence.
  Qed.

  Lemma mem_union_some_l:
    forall AT AEQ V (m1: @mem AT AEQ V) m2 a v,
      m1 a = Some v ->
      mem_union m1 m2 a = Some v.
  Proof.
    unfold mem_union; simpl; intros.
    cleanup; eauto.
  Qed.

  Lemma mem_union_some_r:
    forall AT AEQ V (m1: @mem AT AEQ V) m2 a,
      m1 a = None ->
      mem_union m1 m2 a = m2 a.
  Proof.
    unfold mem_union; simpl; intros.
    cleanup; eauto.
  Qed.

  Lemma addrs_match_mem_union1 :
    forall A AEQ V (m1 m2: @mem A AEQ V),
      addrs_match m1 (mem_union m1 m2).
  Proof.
    unfold addrs_match; intros.
    destruct_fresh (m1 a); try congruence.
    erewrite mem_union_some_l; eauto.
  Qed.

  Lemma addrs_match_empty_mem:
    forall A AEQ V1 V2 (m: @mem A AEQ V1),
      addrs_match (@empty_mem A AEQ V2) m.
  Proof.
    unfold addrs_match, empty_mem;
    simpl; intros; congruence.
  Qed.

  Lemma empty_mem_some_false:
    forall A AEQ V (m: @mem A AEQ V) a v,
      m = empty_mem ->
      m a <> Some v.
  Proof.
    intros.
    rewrite H.
    unfold empty_mem; simpl; congruence.
  Qed.

Lemma recovery_simulation :
  forall n u,
    SimulationForProgramGeneral _ _ _ _ refinement u _ (|Recover|) (|Recover|)
                         (transaction_cache_reboot_list n)
                         (transactional_disk_reboot_list n)
                         refines_reboot refines.
Proof.
  unfold SimulationForProgramGeneral; induction n; simpl; intros; cleanup.
  {
    destruct l_o_imp; intuition; simpl in *.
    cleanup; intuition.
    invert_exec; simpl in *; cleanup; intuition;
    cleanup; unify_execs; cleanup;
    cleanup; intuition eauto; cleanup; try unify_execs; cleanup.

    eexists; intuition eauto.
    unfold transactional_disk_reboot_list in *; simpl.
    simpl in *; try lia.
    instantiate (1:= RFinished (Empty, (snd (snd s_abs), snd (snd s_abs))) tt).
    repeat econstructor.
    unfold refines, refines_reboot,
    transaction_rep, transaction_reboot_rep in *;
    simpl in *; cleanup; eauto.
    intuition eauto.
    pose proof (addr_list_to_blocks_length_le []); simpl in *; lia.
    pose proof (addr_list_to_blocks_length_le []); simpl in *;
    left; intuition lia.
    simpl; destruct x3; eauto.
    cleanup; intuition.
  }
  {
    invert_exec; simpl in *; cleanup; intuition;
    cleanup; intuition eauto; repeat (unify_execs; cleanup).
    cleanup; intuition eauto; cleanup; try unify_execs; cleanup.
    edestruct IHn.
    eauto.
    instantiate (1:= (Empty, (snd (snd s_abs), snd (snd s_abs)))).
    eauto.
    eauto.

    unfold refines_reboot, transaction_reboot_rep in *; simpl in *; cleanup.
    exists (Recovered (extract_state_r x)).
    unfold transactional_disk_reboot_list in *; simpl in *.
    unfold refines_reboot, transaction_reboot_rep in *; cleanup.
    split; eauto.
    repeat econstructor; eauto.
    repeat cleanup_pairs; eauto.
  }
Qed.

Lemma read_simulation :
  forall a n u,
    SimulationForProgram refinement u (|Read a|) (|Recover|)
                         (transaction_cache_reboot_list n)
                         (transactional_disk_reboot_list n).
Proof.
  unfold transaction_cache_reboot_list, SimulationForProgram,
  SimulationForProgramGeneral; simpl; intros; cleanup.

    invert_exec; simpl in *; cleanup; intuition;
    cleanup; try solve [intuition eauto; try congruence;
                        unify_execs; cleanup].
    {
      intuition cleanup; unify_execs; cleanup.
      cleanup; intuition eauto; cleanup; try unify_execs; cleanup.
      eapply_fresh read_finished in H10; cleanup; eauto.

      destruct n; simpl in *; try congruence; cleanup.
      split_ors; cleanup.
      {
        exists (RFinished s_abs ((fst (snd s_abs)) a));
        simpl; intuition eauto.
        eapply ExecFinished.
        repeat econstructor; eauto.
      }
      {
        exists (RFinished s_abs value0);
        simpl; intuition eauto.
        eapply ExecFinished.
        repeat econstructor; eauto.
      }
    }
    {
      intuition cleanup; unify_execs; cleanup.
      cleanup; intuition eauto; cleanup; try unify_execs; cleanup.
      destruct n; simpl in *; try congruence; cleanup.

      edestruct recovery_simulation; eauto.
      unfold refines, transaction_rep in *; cleanup.
      instantiate (1:=(Empty, (snd (snd s_abs), snd (snd s_abs)))).
      eauto.

      exists (Recovered (extract_state_r x0)); simpl; intuition eauto.
      unfold transactional_disk_reboot_list; simpl.
      eapply ExecRecovered; eauto.
      repeat econstructor.
    }
Qed.

Lemma write_simulation :
  forall a v n u,
    SimulationForProgram refinement u (|Write a v|) (|Recover|)
                         (transaction_cache_reboot_list n)
                         (transactional_disk_reboot_list n).
Proof.
  unfold transaction_cache_reboot_list, SimulationForProgram,
  SimulationForProgramGeneral; simpl; intros; cleanup.

    invert_exec; simpl in *; cleanup; intuition;
    cleanup; try solve [intuition eauto; try congruence;
                        unify_execs; cleanup].
    {
      intuition cleanup; unify_execs; cleanup;
      cleanup; intuition eauto; cleanup; try unify_execs; cleanup;
      destruct n; simpl in *; try congruence; cleanup;
      simpl in *; try lia.

      eapply write_finished in H10; eauto;
      split_ors; cleanup.
      {
        intuition eauto; cleanup; try lia;
        try solve [repeat cleanup_pairs;
        exfalso; eapply cons_l_neq; eauto].
        exists (RFinished (NotEmpty, (upd (fst (snd s_abs)) a v, snd (snd s_abs))) (Some tt));
        simpl; split; eauto.
        eapply ExecFinished.
        repeat econstructor; eauto.
      }
      cleanup.
      repeat split_ors; try logic_clean; try lia.
      {
        cleanup.
        exists (RFinished s_abs None);
        simpl; split; eauto.
        intuition try lia; cleanup.
        eapply ExecFinished.
        repeat econstructor; eauto.
      }
      {
        exfalso; eapply PeanoNat.Nat.lt_nge; eauto.
      }
      {
        cleanup.
        exists (RFinished s_abs None);
        simpl; split; eauto.
        intuition try lia; cleanup.
        eapply ExecFinished.
        do 2 econstructor.
        solve [repeat econstructor; eauto].
      }
    }
    {
      intuition cleanup; unify_execs; cleanup;
      cleanup; intuition eauto; cleanup; try unify_execs; cleanup.
      destruct n; simpl in *; try congruence; cleanup.

      edestruct recovery_simulation; eauto.
      unfold refines, transaction_rep in *; cleanup.
      instantiate (1:= (Empty, (snd (snd s_abs), snd (snd s_abs)))).
      eauto.

      exists (Recovered (extract_state_r x0)); simpl; intuition eauto.
      unfold transactional_disk_reboot_list; simpl.
      eapply ExecRecovered; eauto.
      repeat econstructor.
    }
Qed.

Lemma abort_simulation :
  forall n u,
    SimulationForProgram refinement u (|Abort|) (|Recover|)
                         (transaction_cache_reboot_list n)
                         (transactional_disk_reboot_list n).
Proof.
  unfold transaction_cache_reboot_list, SimulationForProgram,
  SimulationForProgramGeneral; simpl; intros; cleanup.

    invert_exec; simpl in *; cleanup; intuition;
    cleanup; try solve [intuition eauto; try congruence;
                        unify_execs; cleanup].
    {
      intuition cleanup; unify_execs; cleanup;
      cleanup; intuition eauto; cleanup; try unify_execs; cleanup.

      destruct n; simpl in *; try congruence; cleanup.
      {
        exists (RFinished (Empty, (snd (snd s_abs), snd (snd s_abs))) tt);
        simpl; intuition eauto.
        eapply ExecFinished.
        repeat econstructor; eauto.
        unfold refines, transaction_rep in *; simpl in *; cleanup.
        clear H1. intuition eauto.
        pose proof (addr_list_to_blocks_length_le []); simpl in *; lia.
        pose proof (addr_list_to_blocks_length_le []); simpl in *;
        left; intuition lia.
        destruct x3; eauto.
      }
    }
    {
      intuition cleanup; unify_execs; cleanup;
      cleanup; intuition eauto; cleanup; try unify_execs; cleanup.
      destruct n; simpl in *; try congruence; cleanup.

      edestruct recovery_simulation; eauto.
      unfold refines, transaction_rep in *; cleanup.
      instantiate (1:= (Empty, (snd (snd s_abs), snd (snd s_abs)))).
      eauto.

      exists (Recovered (extract_state_r x0)); simpl; intuition eauto.
      unfold transactional_disk_reboot_list; simpl.
      eapply ExecRecovered; eauto.
      repeat econstructor.
    }
Qed.

Lemma commit_simulation :
  forall n u,
    SimulationForProgram refinement u (|Commit|) (|Recover|)
                         (transaction_cache_reboot_list n)
                         (transactional_disk_reboot_list n).
Proof.
  unfold transaction_cache_reboot_list, SimulationForProgram,
  SimulationForProgramGeneral; simpl; intros; cleanup.

    invert_exec; simpl in *; cleanup; intuition;
    cleanup; try solve [intuition eauto; try congruence;
                        unify_execs; cleanup].
    {
      intuition cleanup; unify_execs; cleanup;
      cleanup; intuition eauto; cleanup; try unify_execs; cleanup.

      destruct n; simpl in *; try congruence; cleanup.
      {
        exists (RFinished (Empty, (fst (snd s_abs), fst (snd s_abs))) tt);
        simpl; intuition eauto.
        eapply ExecFinished.
        repeat econstructor; eauto.
        unfold refines, transaction_rep in *; simpl in *; cleanup.
        clear H1; intuition eauto.
        pose proof (addr_list_to_blocks_length_le []); simpl in *; lia.
        pose proof (addr_list_to_blocks_length_le []); simpl in *;
        left; intuition lia.
        destruct x3; eauto.
      }
    }
    {
      intuition cleanup; unify_execs; cleanup;
      cleanup; intuition eauto; cleanup; try unify_execs; cleanup;
      destruct n; simpl in *; try congruence; cleanup.

      {
        edestruct recovery_simulation; eauto.
        unfold refines, transaction_rep in *; cleanup.
        instantiate (1:=(Empty, (snd (snd s_abs), snd (snd s_abs)))).
        eauto.

        exists (Recovered (extract_state_r x0)); simpl; intuition eauto.
        unfold transactional_disk_reboot_list; simpl.
        eapply ExecRecovered; eauto.
        repeat econstructor.
      }
      {
        edestruct recovery_simulation; eauto.
        unfold refines, transaction_rep in *; cleanup.
        instantiate (1:=(Empty, (snd (snd s_abs), snd (snd s_abs)))).
        eauto.

        exists (Recovered (extract_state_r x0)); simpl; intuition eauto.
        unfold transactional_disk_reboot_list; simpl.
        eapply ExecRecovered; eauto.
        repeat econstructor.
      }
      {
        edestruct recovery_simulation; eauto.
        unfold refines, transaction_rep in *; cleanup.
        instantiate (1:=(Empty, (fst (snd s_abs), fst (snd s_abs)))).
        eauto.

        exists (Recovered (extract_state_r x0)); simpl; intuition eauto.
        unfold transactional_disk_reboot_list; simpl.
        eapply ExecRecovered; eauto.
        repeat econstructor.
            simpl; eauto.
      }
      {
        edestruct recovery_simulation; eauto.
        unfold refines, transaction_rep in *; cleanup.
        instantiate (1:=(Empty, (fst (snd s_abs), fst (snd s_abs)))).
        eauto.

        exists (Recovered (extract_state_r x0)); simpl; intuition eauto.
        unfold transactional_disk_reboot_list; simpl.
        eapply ExecRecovered; eauto.
        repeat econstructor.
            simpl; eauto.
      }
    }
Qed.

Lemma TC_to_TD_core_simulation_finished:
forall u (T : Type) (o0 : transactional_disk_prog T)
(s_imp
 s_imp' : HorizontalComposition.state' (ListOperation (addr * value))
            (LoggedDiskOperation log_length data_length))
s_abs (r : T)
(o_imp : oracle' TransactionCacheOperation)
t_abs
(grs : HorizontalComposition.state' (ListOperation (addr * value))
         (LoggedDiskOperation log_length data_length) ->
       HorizontalComposition.state' (ListOperation (addr * value))
         (LoggedDiskOperation log_length data_length)),
exec Definitions.imp u o_imp s_imp
(TransactionToTransactionalDisk.Definitions.compile T o0)
(Finished s_imp' r) ->
refines s_imp s_abs ->
token_refines T u s_imp o0 grs
o_imp t_abs ->
exists s_abs',
exec' data_length u t_abs s_abs o0
  (Finished s_abs' r) /\
refines s_imp' s_abs'.
Proof.
  intros.
  destruct o0; simpl in *; split_ors;
  cleanup; repeat unify_execs; cleanup.

  {
    eapply Transaction.read_finished in H1; cleanup; eauto.
    split_ors; cleanup; eexists; split; eauto;
    econstructor; eauto.
  }
  {
    eapply Transaction.write_finished in H1; cleanup; eauto.
    do 2 split_ors; cleanup;
    try solve [eexists; split; eauto;
    econstructor; eauto].

    split_ors; cleanup;
    try solve [eexists; split; eauto;
    econstructor; eauto].

    destruct s_imp; cleanup.
    exfalso; eapply cons_l_neq; eauto.
    apply H5.

    destruct s_imp; cleanup.
    exfalso; eapply cons_l_neq; eauto.
    apply H6.

    destruct s_imp; cleanup.
    exfalso; eapply cons_l_neq; eauto.
    apply H1.

    do 2 split_ors; cleanup;
    try solve [eexists; split; eauto;
    econstructor; eauto].
  }
  {
    eapply Transaction.commit_finished in H1; cleanup; eauto.
    cleanup; eexists; split; eauto.
    destruct r; econstructor; eauto.
  }
  {
    eapply Transaction.abort_finished in H1; cleanup; eauto.
    cleanup; eexists; split; eauto.
    destruct r; econstructor; eauto.
    unfold refines,
    Transaction.transaction_rep in *; simpl in *; cleanup.
    clear H3; intuition eauto.
    pose proof addr_list_to_blocks_length_le.
    specialize (H []); simpl in *; lia.
    pose proof (addr_list_to_blocks_length_le []); simpl in *;
    left; intuition lia.
  }
  {
    eapply Transaction.recover_finished in H1; cleanup; eauto.
    cleanup; eexists; split; eauto.
    destruct r; econstructor; eauto.
    unfold refines,
    Transaction.transaction_rep,  Transaction.transaction_reboot_rep in *;
    simpl in *; cleanup; eauto.
  }
  {
    eapply Transaction.init_finished in H1; cleanup; eauto.
    cleanup; eexists; split; eauto.
    destruct r; econstructor; eauto.
    unfold refines,
    Transaction.transaction_rep in *; simpl in *; cleanup.
    clear H3; intuition eauto.
    pose proof addr_list_to_blocks_length_le.
    specialize (H []); simpl in *; lia.
    pose proof (addr_list_to_blocks_length_le []); simpl in *;
        left; intuition lia.
  }
Qed.

Lemma TC_to_TD_core_simulation_crashed:
forall u (T : Type) (o0 : operation Definitions.abs_op T)
(s_imp s_imp' : LayerImplementation.state' TransactionCacheOperation)
s_abs (o_imp : oracle' TransactionCacheOperation)
t_abs,
exec Definitions.imp u o_imp s_imp
(compile T o0)
(Crashed s_imp') ->
refines s_imp s_abs ->
token_refines T u s_imp o0
TC_reboot_f o_imp t_abs ->

(forall l, ~ eq_dep Type (operation Definitions.abs_op) T o0 unit (Init l)) ->
exists
s_abs',
Core.exec (TransactionalDiskLayer.TDCore data_length) u
t_abs s_abs o0 (Crashed s_abs') /\
refines_reboot
(TC_reboot_f s_imp') (TD_reboot_f s_abs').
Proof.
  intros.
  destruct o0; simpl in *; split_ors;
  cleanup; repeat unify_execs; cleanup.

  {
    eapply Transaction.read_crashed in H1; cleanup; eauto.
    eexists; split; eauto.
    econstructor; eauto.
    unfold TC_reboot_f, TD_reboot_f; simpl in *.
    unfold refines_reboot , refines,
    Transaction.transaction_rep,  Transaction.transaction_reboot_rep in *;
    simpl in *; cleanup; eauto.
  }
  {
    eapply Transaction.write_crashed in H1; cleanup; eauto.
    eexists; split; eauto.
    econstructor; eauto.
    unfold TC_reboot_f, TD_reboot_f; simpl in *.
    unfold refines_reboot , refines,
    Transaction.transaction_rep,  Transaction.transaction_reboot_rep in *;
    simpl in *; cleanup; eauto.
  }
  {
    eapply Transaction.commit_crashed in H1; cleanup; eauto.
    repeat split_ors; cleanup; eexists; split; eauto;
    try solve [econstructor; eauto].

    unfold TC_reboot_f, TD_reboot_f; simpl in *;
    unfold refines_reboot , refines,
    Transaction.transaction_rep,  Transaction.transaction_reboot_rep in *;
    simpl in *; cleanup_no_match; eauto.

    unfold TC_reboot_f, TD_reboot_f; simpl in *;
    unfold refines_reboot , refines,
    Transaction.transaction_rep,  Transaction.transaction_reboot_rep in *;
    simpl in *; cleanup_no_match; eauto.

    unfold TC_reboot_f, TD_reboot_f; simpl in *;
    unfold refines_reboot , refines,
    Transaction.transaction_rep,  Transaction.transaction_reboot_rep in *;
    simpl in *; logic_clean; rewrite H8; eauto.

    unfold TC_reboot_f, TD_reboot_f; simpl in *;
    unfold refines_reboot , refines,
    Transaction.transaction_rep,  Transaction.transaction_reboot_rep in *;
    simpl in *; cleanup_no_match; eauto.
  }
  {
    eapply Transaction.abort_crashed in H1; cleanup; eauto.
    eexists; split; eauto.
    econstructor; eauto.
    unfold TC_reboot_f, TD_reboot_f; simpl in *.
    unfold refines_reboot , refines,
    Transaction.transaction_rep,  Transaction.transaction_reboot_rep in *;
    simpl in *; cleanup; eauto.
  }
  {
    eapply Transaction.recover_crashed in H1; cleanup; eauto.
    eexists; split; eauto.
    econstructor; eauto.
    unfold TC_reboot_f, TD_reboot_f; simpl in *.
    unfold refines_reboot , refines,
    Transaction.transaction_rep,  Transaction.transaction_reboot_rep in *;
    simpl in *; cleanup; eauto.

    unfold refines_reboot , refines,
    Transaction.transaction_rep,  Transaction.transaction_reboot_rep in *;
    simpl in *; cleanup; eauto.
  }
  {
    exfalso; eapply H2; eauto.
  }
Qed.

Lemma TD_token_refines_finished :
      forall u (T : Type) (op : operation Definitions.abs_op T)
      (x : oracle' TransactionCacheOperation) (r0 : T)
      (s0 s'0 : LayerImplementation.state' TransactionCacheOperation),
    exec Definitions.imp u x s0
      (compile_core Definitions.TDCoreRefinement op)
      (Finished s'0 r0) ->
    (exists s1 : Core.state Definitions.abs_op,
       refines_core Definitions.TDCoreRefinement s0 s1) ->
    exists
      (grs1 : state Definitions.imp -> state Definitions.imp) t,
      token_refines T u s0 op grs1 x t.
      Proof.
      intros; cleanup; destruct op; simpl in *; repeat invert_exec.

      - do 2 eexists; try exact (fst s0); try exact (snd s0);
        left; do 2 eexists; intuition eauto.
        eapply Transaction.read_finished; eauto.

      - eapply_fresh Transaction.write_finished in H; eauto.
        split_ors; cleanup; intuition eauto;
        do 2 eexists; try exact (fst s0); try exact (snd s0);
        left; do 2 eexists; intuition eauto.
        + left; intuition eauto.
          unfold Transaction.transaction_rep in *; simpl in *.
          cleanup.
          inversion H1; eauto.

      - eapply_fresh Transaction.commit_finished in H; eauto;
        cleanup; intuition eauto;
        do 2 eexists; try exact (fst s0); try exact (snd s0);
        left; do 2 eexists; intuition eauto.
        destruct s'0; simpl in *; cleanup.
        unfold refines,
        Transaction.transaction_rep in *; simpl in *.
        cleanup; eauto.

      - eapply_fresh Transaction.abort_finished in H; eauto;
      cleanup; intuition eauto;
      do 2 eexists; try exact (fst s0); try exact (snd s0);
      left; do 2 eexists; intuition eauto.
      destruct s'0; simpl in *; cleanup; eauto.

      - eapply_fresh Transaction.recover_finished in H; eauto;
        cleanup; intuition eauto.
        2: {
          unfold refines,
          Transaction.transaction_rep, Transaction.transaction_reboot_rep in *; simpl in *;
          cleanup; eauto.
        }
        do 2 eexists; try exact (fst s0); try exact (snd s0);
        left; do 2 eexists; intuition eauto.
        destruct s'0; simpl in *; cleanup.
        unfold refines,
        Transaction.transaction_rep in *; simpl in *.
        cleanup; eauto.

      - eapply_fresh Transaction.init_finished in H; eauto;
        cleanup; intuition eauto.
        do 2 eexists; try exact (fst s0); try exact (snd s0);
        left; do 2 eexists; intuition eauto.
        destruct s'0; simpl in *; cleanup; eauto.
      Qed.

      Lemma TD_token_refines_crashed :
      forall u (T : Type) (op : operation Definitions.abs_op T)
  (x : oracle' TransactionCacheOperation)
  (s0 s'0 : LayerImplementation.state' TransactionCacheOperation),
exec Definitions.imp u x s0
  (compile_core Definitions.TDCoreRefinement op)
  (Crashed s'0) ->
(exists s1 : Core.state Definitions.abs_op,
   refines_core Definitions.TDCoreRefinement s0 s1) ->
   (forall l, ~ Logic.EqdepFacts.eq_dep Type (operation Definitions.abs_op)  T op unit (Init l)) ->
   exists
  (grs1 : state Definitions.imp -> state Definitions.imp) t,
  token_refines T u s0 op grs1 x t.
      Proof.
      intros; cleanup; destruct op; simpl in *; repeat invert_exec.

      - do 2 eexists; try exact (fst s0); try exact (snd s0);
        right; eexists; intuition eauto.
        eapply Transaction.read_crashed; eauto.

      - eapply_fresh Transaction.write_crashed in H; eauto.
        do 2 eexists; try exact (fst s0); try exact (snd s0);
        right; eexists; intuition eauto.

      - eapply_fresh Transaction.commit_crashed in H; eauto;
        cleanup; intuition eauto;
        do 2 eexists; try exact (fst s0); try exact (snd s0);
        right; eexists; intuition eauto.
        left; destruct s'0; simpl in *; cleanup.
        unfold refines,
        Transaction.transaction_rep in *; simpl in *.
        cleanup; eauto.

        left; destruct s'0; simpl in *; cleanup.
        unfold refines,
        Transaction.transaction_rep in *; simpl in *.
        cleanup; intuition eauto.

        right; destruct s'0; simpl in *; cleanup.
        unfold refines,
        Transaction.transaction_rep in *; simpl in *.
        cleanup; eauto.

        right; destruct s'0; simpl in *; cleanup.
        unfold refines,
        Transaction.transaction_rep in *; simpl in *.
        cleanup; intuition eauto.

      - eapply_fresh Transaction.abort_crashed in H; eauto;
      cleanup; intuition eauto;
      do 2 eexists; try exact (fst s0); try exact (snd s0);
      right; eexists; intuition eauto.

      - eapply_fresh Transaction.recover_crashed in H; eauto;
        cleanup; intuition eauto.
        2: {
          unfold refines,
          Transaction.transaction_rep, Transaction.transaction_reboot_rep in *; simpl in *;
          cleanup; eauto.
        }
        do 2 eexists; try exact (fst s0); try exact (snd s0);
        right; eexists; intuition eauto.

      - exfalso; eapply H1; eauto.
      Qed.

Lemma TD_token_refines :
      forall u (T : Type) (op : operation Definitions.abs_op T)
  (x : oracle' TransactionCacheOperation)
  (s0 : LayerImplementation.state' TransactionCacheOperation) ret,
exec Definitions.imp u x s0
  (compile_core Definitions.TDCoreRefinement op)
  ret ->
(exists s1 : Core.state Definitions.abs_op,
   refines_core Definitions.TDCoreRefinement s0 s1) ->
   (forall l, ~ Logic.EqdepFacts.eq_dep Type (operation Definitions.abs_op)  T op unit (Init l)) ->
   exists
  (grs1 : state Definitions.imp -> state Definitions.imp) t,
  token_refines T u s0 op grs1 x t.
Proof.
  intros.
  destruct ret.
  eapply TD_token_refines_finished; eauto.
  eapply TD_token_refines_crashed; eauto.
Qed.


From Coq Require Import Bool String List BinPos Compare_dec Lia.
Require Import Equations.Prop.DepElim.
From Equations Require Import Equations.
From MetaCoq Require Import Ast utils Typing.
From Translation Require Import util Sorts SAst SLiftSubst SCommon Equality.

Reserved Notation " Σ ;;; Γ '|-x' t : T " (at level 50, Γ, t, T at next level).
Reserved Notation " Σ ;;; Γ '|-x' t ≡ u : T " (at level 50, Γ, t, u, T at next level).

Open Scope s_scope.

Section XTyping.

Context `{Sort_notion : Sorts.notion}.

Declare Scope x_scope.

Inductive typing (Σ : sglobal_context) (Γ : scontext) : sterm -> sterm -> Type :=
| type_Rel n :
    forall (isdecl : n < List.length Γ),
      Σ ;;; Γ |-x (sRel n) : lift0 (S n) (safe_nth Γ (exist _ n isdecl))

| type_Sort s :
    Σ ;;; Γ |-x (sSort s) : sSort (succ s)

| type_Prod n t b s1 s2 :
    Σ ;;; Γ |-x t : sSort s1 ->
    Σ ;;; Γ ,, t |-x b : sSort s2 ->
    Σ ;;; Γ |-x (sProd n t b) : sSort (Sorts.prod_sort s1 s2)

| type_Lambda n n' t b s1 s2 bty :
    Σ ;;; Γ |-x t : sSort s1 ->
    Σ ;;; Γ ,, t |-x bty : sSort s2 ->
    Σ ;;; Γ ,, t |-x b : bty ->
    Σ ;;; Γ |-x (sLambda n t bty b) : sProd n' t bty

| type_App n s1 s2 t A B u :
    Σ ;;; Γ |-x A : sSort s1 ->
    Σ ;;; Γ ,, A |-x B : sSort s2 ->
    Σ ;;; Γ |-x t : sProd n A B ->
    Σ ;;; Γ |-x u : A ->
    Σ ;;; Γ |-x (sApp t A B u) : B{ 0 := u }

| type_Sum n t b s1 s2 :
    Σ ;;; Γ |-x t : sSort s1 ->
    Σ ;;; Γ ,, t |-x b : sSort s2 ->
    Σ ;;; Γ |-x (sSum n t b) : sSort (Sorts.sum_sort s1 s2)

| type_Pair n A B u v s1 s2 :
    Σ ;;; Γ |-x A : sSort s1 ->
    Σ ;;; Γ ,, A |-x B : sSort s2 ->
    Σ ;;; Γ |-x u : A ->
    Σ ;;; Γ |-x v : B{ 0 := u } ->
    Σ ;;; Γ |-x sPair A B u v : sSum n A B

| type_Pi1 n A B s1 s2 p :
    Σ ;;; Γ |-x p : sSum n A B ->
    Σ ;;; Γ |-x A : sSort s1 ->
    Σ ;;; Γ ,, A |-x B : sSort s2 ->
    Σ ;;; Γ |-x sPi1 A B p : A

| type_Pi2 n A B s1 s2 p :
    Σ ;;; Γ |-x p : sSum n A B ->
    Σ ;;; Γ |-x A : sSort s1 ->
    Σ ;;; Γ ,, A |-x B : sSort s2 ->
    Σ ;;; Γ |-x sPi2 A B p : B{ 0 := sPi1 A B p }

| type_Eq s A u v :
    Σ ;;; Γ |-x A : sSort s ->
    Σ ;;; Γ |-x u : A ->
    Σ ;;; Γ |-x v : A ->
    Σ ;;; Γ |-x sEq A u v : sSort (Sorts.eq_sort s)

| type_Refl s A u :
    Σ ;;; Γ |-x A : sSort s ->
    Σ ;;; Γ |-x u : A ->
    Σ ;;; Γ |-x sRefl A u : sEq A u u

| type_Ax id ty :
    lookup_glob Σ id = Some ty ->
    Σ ;;; Γ |-x sAx id : ty

| type_conv t A B s :
    Σ ;;; Γ |-x t : A ->
    Σ ;;; Γ |-x B : sSort s ->
    Σ ;;; Γ |-x A ≡ B : sSort s ->
    Σ ;;; Γ |-x t : B

where " Σ ;;; Γ '|-x' t : T " := (@typing Σ Γ t T) : x_scope

with eq_term (Σ : sglobal_context) (Γ : scontext) : sterm -> sterm -> sterm -> Type :=
| eq_reflexivity u A :
    Σ ;;; Γ |-x u : A ->
    Σ ;;; Γ |-x u ≡ u : A

| eq_symmetry u v A :
    Σ ;;; Γ |-x u ≡ v : A ->
    Σ ;;; Γ |-x v ≡ u : A

| eq_transitivity u v w A :
    Σ ;;; Γ |-x u ≡ v : A ->
    Σ ;;; Γ |-x v ≡ w : A ->
    Σ ;;; Γ |-x u ≡ w : A

| eq_beta s1 s2 n A B t u :
    Σ ;;; Γ |-x A : sSort s1 ->
    Σ ;;; Γ ,, A |-x B : sSort s2 ->
    Σ ;;; Γ ,, A |-x t : B ->
    Σ ;;; Γ |-x u : A ->
    Σ ;;; Γ |-x sApp (sLambda n A B t) A B u ≡ t{ 0 := u } : B{ 0 := u }

| eq_conv s T1 T2 t1 t2 :
    Σ ;;; Γ |-x t1 ≡ t2 : T1 ->
    Σ ;;; Γ |-x T1 ≡ T2 : sSort s ->
    Σ ;;; Γ |-x t1 ≡ t2 : T2

| cong_Prod n1 n2 A1 A2 B1 B2 s1 s2 :
    Σ ;;; Γ |-x A1 ≡ A2 : sSort s1 ->
    Σ ;;; Γ ,, A1 |-x B1 ≡ B2 : sSort s2 ->
    Σ ;;; Γ ,, A1 |-x B1 : sSort s2 ->
    Σ ;;; Γ ,, A2 |-x B2 : sSort s2 ->
    Σ ;;; Γ |-x (sProd n1 A1 B1) ≡ (sProd n2 A2 B2) :
               sSort (Sorts.prod_sort s1 s2)

| cong_Lambda n1 n2 n' A1 A2 B1 B2 t1 t2 s1 s2 :
    Σ ;;; Γ |-x A1 ≡ A2 : sSort s1 ->
    Σ ;;; Γ ,, A1 |-x B1 ≡ B2 : sSort s2 ->
    Σ ;;; Γ ,, A1 |-x t1 ≡ t2 : B1 ->
    Σ ;;; Γ ,, A1 |-x B1 : sSort s2 ->
    Σ ;;; Γ ,, A2 |-x B2 : sSort s2 ->
    Σ ;;; Γ ,, A1 |-x t1 : B1 ->
    Σ ;;; Γ ,, A2 |-x t2 : B2 ->
    Σ ;;; Γ |-x (sLambda n1 A1 B1 t1) ≡ (sLambda n2 A2 B2 t2) : sProd n' A1 B1

| cong_App n1 n2 s1 s2 t1 t2 A1 A2 B1 B2 u1 u2 :
    Σ ;;; Γ |-x A1 ≡ A2 : sSort s1 ->
    Σ ;;; Γ ,, A1 |-x B1 ≡ B2 : sSort s2 ->
    Σ ;;; Γ |-x t1 ≡ t2 : sProd n1 A1 B1 ->
    Σ ;;; Γ |-x u1 ≡ u2 : A1 ->
    Σ ;;; Γ ,, A1 |-x B1 : sSort s2 ->
    Σ ;;; Γ ,, A2 |-x B2 : sSort s2 ->
    Σ ;;; Γ |-x t1 : sProd n1 A1 B1 ->
    Σ ;;; Γ |-x t2 : sProd n2 A2 B2 ->
    Σ ;;; Γ |-x u1 : A1 ->
    Σ ;;; Γ |-x u2 : A2 ->
    Σ ;;; Γ |-x (sApp t1 A1 B1 u1) ≡ (sApp t2 A2 B2 u2) : B1{ 0 := u1 }

| cong_Sum n1 n2 A1 A2 B1 B2 s1 s2 :
    Σ ;;; Γ |-x A1 ≡ A2 : sSort s1 ->
    Σ ;;; Γ ,, A1 |-x B1 ≡ B2 : sSort s2 ->
    Σ ;;; Γ ,, A1 |-x B1 : sSort s2 ->
    Σ ;;; Γ ,, A2 |-x B2 : sSort s2 ->
    Σ ;;; Γ |-x (sSum n1 A1 B1) ≡ (sSum n2 A2 B2) : sSort (Sorts.sum_sort s1 s2)

| cong_Pair n A1 A2 B1 B2 u1 u2 v1 v2 s1 s2 :
    Σ ;;; Γ |-x A1 ≡ A2 : sSort s1 ->
    Σ ;;; Γ ,, A1 |-x B1 ≡ B2 : sSort s2 ->
    Σ ;;; Γ |-x u1 ≡ u2 : A1 ->
    Σ ;;; Γ |-x v1 ≡ v2 : B1{ 0 := u1 } ->
    Σ ;;; Γ ,, A1 |-x B1 : sSort s2 ->
    Σ ;;; Γ ,, A2 |-x B2 : sSort s2 ->
    Σ ;;; Γ |-x u1 : A1 ->
    Σ ;;; Γ |-x u2 : A2 ->
    Σ ;;; Γ |-x v1 : B1{ 0 := u1 } ->
    Σ ;;; Γ |-x v2 : B2{ 0 := u2 } ->
    Σ ;;; Γ |-x sPair A1 B1 u1 v1 ≡ sPair A2 B2 u2 v2 : sSum n A1 B1

| cong_Pi1 nx ny A1 A2 B1 B2 s1 s2 p1 p2 :
    Σ ;;; Γ |-x p1 ≡ p2 : sSum nx A1 B1 ->
    Σ ;;; Γ |-x A1 ≡ A2 : sSort s1 ->
    Σ ;;; Γ ,, A1 |-x B1 ≡ B2 : sSort s2 ->
    Σ ;;; Γ ,, A1 |-x B1 : sSort s2 ->
    Σ ;;; Γ ,, A2 |-x B2 : sSort s2 ->
    Σ ;;; Γ |-x p1 : sSum nx A1 B1 ->
    Σ ;;; Γ |-x p2 : sSum ny A2 B2 ->
    Σ ;;; Γ |-x sPi1 A1 B1 p1 ≡ sPi1 A2 B2 p2 : A1

| cong_Pi2 nx ny A1 A2 B1 B2 s1 s2 p1 p2 :
    Σ ;;; Γ |-x p1 ≡ p2 : sSum nx A1 B1 ->
    Σ ;;; Γ |-x A1 ≡ A2 : sSort s1 ->
    Σ ;;; Γ ,, A1 |-x B1 ≡ B2 : sSort s2 ->
    Σ ;;; Γ ,, A1 |-x B1 : sSort s2 ->
    Σ ;;; Γ ,, A2 |-x B2 : sSort s2 ->
    Σ ;;; Γ |-x p1 : sSum nx A1 B1 ->
    Σ ;;; Γ |-x p2 : sSum ny A2 B2 ->
    Σ ;;; Γ |-x sPi2 A1 B1 p1 ≡ sPi2 A2 B2 p2 : B1{ 0 := sPi1 A1 B1 p1 }

| cong_Eq s A1 A2 u1 u2 v1 v2 :
    Σ ;;; Γ |-x A1 ≡ A2 : sSort s ->
    Σ ;;; Γ |-x u1 ≡ u2 : A1 ->
    Σ ;;; Γ |-x v1 ≡ v2 : A1 ->
    Σ ;;; Γ |-x sEq A1 u1 v1 ≡ sEq A2 u2 v2 : sSort (Sorts.eq_sort s)

| cong_Refl s A1 A2 u1 u2 :
    Σ ;;; Γ |-x A1 ≡ A2 : sSort s ->
    Σ ;;; Γ |-x u1 ≡ u2 : A1 ->
    Σ ;;; Γ |-x sRefl A1 u1 ≡ sRefl A2 u2 : sEq A1 u1 u1

| reflection A u v e :
    Σ ;;; Γ |-x e : sEq A u v ->
    Σ ;;; Γ |-x u ≡ v : A

| eq_alpha u v A :
    nl u = nl v ->
    Σ ;;; Γ |-x u : A ->
    Σ ;;; Γ |-x u ≡ v : A

where " Σ ;;; Γ '|-x' t ≡ u : T " := (@eq_term Σ Γ t u T) : x_scope.

Delimit Scope x_scope with x.

Open Scope x_scope.

Inductive wf (Σ : sglobal_context) : scontext -> Type :=
| wf_nil :
    wf Σ nil

| wf_snoc Γ A s :
    wf Σ Γ ->
    Σ ;;; Γ |-x A : sSort s ->
    wf Σ (Γ ,, A).

Derive Signature for typing.
Derive Signature for wf.
Derive Signature for eq_term.

End XTyping.

Declare Scope x_scope.

Notation " Σ ;;; Γ '|-x' t : T " :=
  (@typing _ Σ Γ t T) (at level 50, Γ, t, T at next level) : x_scope.
Notation " Σ ;;; Γ '|-x' t ≡ u : T " :=
  (@eq_term _ Σ Γ t u T) (at level 50, Γ, t, u, T at next level) : x_scope.