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.