Require Import Coqlib.
Require Import Maps.

Require Import Classical_Prop.

Require Import Integers.
Require Import LibTactics.
Open Scope Z_scope.
Import ListNotations.

Require Import state.
Require Import language.
Require Import highlang.
Require Import lowlang.
Require Import logic.
Require Import reg_lemma.

Set Implicit Arguments.
Unset Strict Implicit.

Open Scope code_scope.
Open Scope mem_scope.

(*+ The Event Trace Refinement +*)
CoInductive Etr :=
| empEtr : Etr
| abortEtr : Etr
| outEtr : Val -> Etr -> Etr.

Inductive star_tau_step {prog : Type} (step : prog -> msg -> prog -> Prop) :
  prog -> prog -> Prop :=
| zero_tau_step : forall p, star_tau_step step p p
| multi_tau_step : forall (p p' p'' : prog), star_tau_step step p p' -> step p' tau p'' ->
                                             star_tau_step step p p''.

CoInductive Etrace {tprog} (step : tprog -> msg -> tprog -> Prop): tprog -> Etr -> Prop :=
| Etr_tau : forall P P' P'',
    star_tau_step step P P' -> step P' tau P'' ->
    Etrace step P'' empEtr -> Etrace step P empEtr
| Etr_abort : forall P P',
    star_tau_step step P P' -> (~ (exists P'' m, step P' m P'')) -> Etrace step P abortEtr
| Etr_event : forall P P' P'' v etr,
    star_tau_step step P P' -> step P' (out v) P'' ->
    Etrace step P'' etr -> Etrace step P (outEtr v etr).

Definition Etr_Refinement (LP : LProg) (HP : HProg) :=
  forall B, Etrace LP__ LP B -> Etrace HP__ HP B.

(*+ State Relation +*)
Definition TaskCur := (0%Z, $0).

Definition ctxfm R (F F' : FrameList) : Prop :=
  exists w n F2,
    get_R R cwp = Some (W w) /\ get_R R Rwim = Some (W (($ 1) <<ᵢ n)) /\ w <> n /\
    F = F' ++ F2 /\ ($ 0) <=ᵤᵢ w <=ᵤᵢ ($ 7) /\ ($ 0) <=ᵤᵢ n <=ᵤᵢ ($ 7) /\
    length F' = Nat.mul 2%nat (Z.to_nat (Int.unsigned ((N +ᵢ n -ᵢ w -ᵢ ($ 1)) modu N))) /\ length F = 13.

Definition Rinj (LR : RegFile) (HR : HRegFile) :=
  (forall rr : GenReg, exists v, LR rr = Some v /\ HR rr = Some v) /\
  (forall sr : SpReg, exists w, LR sr = Some (W w)) /\ (exists w, LR cwp = Some (W w)) /\
  (exists w, LR n = Some w /\ HR fn = Some w) /\ (exists w, LR z = Some w /\ HR fz = Some w).

Parameter ctx_s ctx_e : int.

Definition DomCtx (l : Address) (t : Tid) (b : Z) :=
  match l with
  | (b', o') => if Z.eq_dec t b' then
                 (* A location marks the name of thread and a set of locations saving context *)
                 o' = $ 0 \/ (int_leu ctx_s o' = true /\ Int.ltu o' ctx_e = true)
               else
                 if Z.eq_dec b b' then
                   int_leu ($ 0) o' = true /\ Int.ltu o' ($64) = true /\ Int.eq (o' modu ($ 4)) ($ 0) = true
                 else
                   False
  end.

Definition set_Mframe' (b : Z) (ofs : Word) (fm : Frame) :=
  set_Mframe empM (b, ofs) (b, ofs +ᵢ ($ 4)) (b, ofs +ᵢ ($ 8)) (b, ofs +ᵢ ($ 12))
             (b, ofs +ᵢ ($ 16)) (b, ofs +ᵢ ($ 20)) (b, ofs +ᵢ ($ 24)) (b, ofs +ᵢ ($ 28)) fm.

Inductive stkRel : Z * FrameList * Memory -> HFrameList -> Prop :=
| LFnilHFnil : forall b, stkRel (b, nil, empM) nil

| LFnilHFcons : forall fm1 fm2 HF M M' b b',
    M = (set_Mframe' b ($ 0) fm1) ⊎ (set_Mframe' b ($ 32) fm2) ⊎ M' ->
    (set_Mframe' b ($ 0) fm1) ⊥ (set_Mframe' b ($ 32) fm2) ->
    ((set_Mframe' b ($ 0) fm1) ⊎ (set_Mframe' b ($ 32) fm2)) ⊥ M' ->
    get_frame_nth fm2 6 = Some (Ptr (b', $ 0)) ->
    stkRel (b', nil, M') HF ->
    stkRel (b, nil, M) ((b, fm1, fm2) :: HF)

| LFconsHFcons : forall fm1 fm2 F HF M M' b b' fm1' fm2',
    M = (set_Mframe' b ($ 0) fm1') ⊎ (set_Mframe' b ($ 32) fm2') ⊎ M' ->
    (set_Mframe' b ($ 0) fm1') ⊥ (set_Mframe' b ($ 32) fm2') ->
    ((set_Mframe' b ($ 0) fm1') ⊎ (set_Mframe' b ($ 32) fm2')) ⊥ M' ->
    get_frame_nth fm2 6 = Some (Ptr (b', $ 0)) ->
    stkRel (b', F, M') HF ->
    stkRel (b, fm1 :: fm2 :: F, M) ((b, fm1, fm2) :: HF).

(** Current Thread State Relation *)
Inductive curTRel : Memory * RState -> Tid * tlocst -> Prop :=
| Cur_TRel : forall M Mctx Mk R F F' t HR b b' HF pc npc,
    (M = Mctx ⊎ Mk /\ Mctx ⊥ Mk) -> (forall l, (indom l Mctx <-> DomCtx l t b) /\ t <> b) ->
    ctxfm R F F' -> stkRel (b', F', Mk) HF -> Rinj R HR ->
    curTRel (M, (R, F)) (t, ((HR, b, HF), pc, npc)).

(** Ready Thread State Relation *)
Inductive rdyTsRel (restoreQ : Memory -> RState -> Prop) : Memory -> ThrdPool -> Prop :=
| thrdRel : forall t K M Q,
    restoreQ M Q -> curTRel (M, Q) (t, K) ->
    rdyTsRel restoreQ M (ThrdMap.set t (Some K) EmpThrdPool)

| thrdsRel : forall T1 T2 T M1 M2 M,
    rdyTsRel restoreQ M1 T1 -> rdyTsRel restoreQ M2 T1 ->
    M1 ⊥ M2 -> T1 ⊥ T2 -> M = M1 ⊎ M2 -> T = T1 ⊎ T2 ->
    rdyTsRel restoreQ M T.

(** Whole Program State Relation *)
Inductive wp_stateRel (restoreQ : Memory -> RState -> Prop) : State -> HState -> Prop :=
| Wp_stateRel : forall (M Mc MT M' : Memory) Q T t K M',
    Mc ⊎ MT ⊎ (MemMap.set TaskCur (Some (Ptr (t, $0))) empM) ⊎ M' = M ->
    Mc ⊥ MT -> (Mc ⊎ MT) ⊥ (MemMap.set TaskCur (Some (Ptr (t, $0))) empM) ->
    (Mc ⊎ MT ⊎ (MemMap.set TaskCur (Some (Ptr (t, $0))) empM)) ⊥ M' ->
    curTRel (Mc, Q) (t, K) ->
    rdyTsRel restoreQ MT (ThrdMap.set t None T) ->
    wp_stateRel restoreQ (M, Q, nil) (T, t, K, M').

Definition get_Hs_pcont (HS : HState) :=
  match HS with
  | (T, t, K, M) =>
    match K with
    | (HQ, pc, npc) => (pc, npc)
    end
  end.

(*+ Primitive Correctness +*)
Definition correct (Cas : XCodeHeap) (PrimSet : apSet) (restoreQ : Memory -> RState -> Prop) :=
  forall C S HS pc npc,
    wp_stateRel restoreQ S HS -> HProgSafe ((C, PrimSet), HS) ->
    get_Hs_pcont HS = (pc, npc) -> C ⊥ Cas ->
    Etr_Refinement (C ⊎ Cas, (S, pc, npc)) ((C, PrimSet), HS).


From cap_machine Require Import rules_base.
From iris.base_logic Require Export invariants gen_heap.
From iris.program_logic Require Export weakestpre ectx_lifting.
From iris.proofmode Require Import tactics.
From iris.algebra Require Import frac.

Section cap_lang_rules.
  Context `{memG Σ, regG Σ, MonRef: MonRefG (leibnizO _) CapR_rtc Σ}.
  Context `{MachineParameters}.
  Implicit Types P Q : iProp Σ.
  Implicit Types σ : ExecConf.
  Implicit Types c : cap_lang.expr.
  Implicit Types a b : Addr.
  Implicit Types r : RegName.
  Implicit Types v : cap_lang.val.
  Implicit Types w : Word.
  Implicit Types reg : gmap RegName Word.
  Implicit Types ms : gmap Addr Word.

  Lemma wp_jmp_success E pc_p pc_g pc_b pc_e pc_a w r w' pc_p':
    decodeInstrW w = Jmp r →
    PermFlows pc_p pc_p' →
     isCorrectPC (inr ((pc_p,pc_g),pc_b,pc_e,pc_a)) →

     {{{ ▷ PC ↦ᵣ inr ((pc_p,pc_g),pc_b,pc_e,pc_a)
         ∗ ▷ pc_a ↦ₐ[pc_p'] w
         ∗ ▷ r ↦ᵣ w' }}}
       Instr Executable @ E
       {{{ RET NextIV;
           PC ↦ᵣ updatePcPerm w'
           ∗ pc_a ↦ₐ[pc_p'] w
           ∗ r ↦ᵣ w' }}}.
  Proof.
    iIntros (Hinstr Hfl Hvpc ϕ) "(>HPC & >Hpc_a & >Hr) Hφ".
    iApply wp_lift_atomic_head_step_no_fork; auto.
    iIntros (σ1 l1 l2 n) "Hσ1 /=". destruct σ1; simpl.
    iDestruct "Hσ1" as "[Hr0 Hm]".
    assert (pc_p' ≠ O).
    { destruct pc_p'; auto. destruct pc_p; inversion Hfl. inversion Hvpc; naive_solver. }
    iDestruct (@gen_heap_valid_cap with "Hm Hpc_a") as %?; auto.
    iDestruct (@gen_heap_valid with "Hr0 HPC") as %?.
    iDestruct (@gen_heap_valid with "Hr0 Hr") as %Hr_r0.
    iModIntro. iSplitR. by iPureIntro; apply normal_always_head_reducible.
    iNext. iIntros (e2 σ2 efs Hpstep).
    apply prim_step_exec_inv in Hpstep as (-> & -> & (c & -> & Hstep)).
    iSplitR; auto. eapply step_exec_inv in Hstep; eauto.

    rewrite /update_reg /= in Hstep. simplify_pair_eq. cbn.
    iMod (@gen_heap_update with "Hr0 HPC") as "[Hr0 HPC]". iFrame.
    iApply "Hφ". iFrame. rewrite /RegLocate Hr_r0. eauto.
  Qed.

  Lemma wp_jmp_successPC E pc_p pc_g pc_b pc_e pc_a w pc_p' :
    decodeInstrW w = Jmp PC →
    PermFlows pc_p pc_p' →
     isCorrectPC (inr ((pc_p,pc_g),pc_b,pc_e,pc_a)) →

     {{{ ▷ PC ↦ᵣ inr ((pc_p,pc_g),pc_b,pc_e,pc_a)
         ∗ ▷ pc_a ↦ₐ[pc_p'] w }}}
       Instr Executable @ E
       {{{ RET NextIV;
           PC ↦ᵣ updatePcPerm (inr ((pc_p,pc_g),pc_b,pc_e,pc_a))
           ∗ pc_a ↦ₐ[pc_p'] w }}}.
  Proof.
    iIntros (Hinstr Hfl Hvpc ϕ) "(>HPC & >Hpc_a) Hφ".
    iApply wp_lift_atomic_head_step_no_fork; auto.
    iIntros (σ1 l1 l2 n) "Hσ1 /=". destruct σ1; cbn.
    iDestruct "Hσ1" as "[Hr0 Hm]".
    assert (pc_p' ≠ O).
    { destruct pc_p'; auto. destruct pc_p; inversion Hfl. inversion Hvpc; naive_solver. }
    iDestruct (@gen_heap_valid_cap with "Hm Hpc_a") as %?; auto.
    iDestruct (@gen_heap_valid with "Hr0 HPC") as %Hr_PC.
    iModIntro. iSplitR. by iPureIntro; apply normal_always_head_reducible.
    iNext. iIntros (e2 σ2 efs Hpstep).
    apply prim_step_exec_inv in Hpstep as (-> & -> & (c & -> & Hstep)).
    iSplitR; auto. eapply step_exec_inv in Hstep; eauto.

    rewrite /update_reg /= in Hstep. simplify_pair_eq. cbn.
    rewrite /RegLocate Hr_PC.
    iMod (@gen_heap_update with "Hr0 HPC") as "[Hr0 HPC]". iFrame.
    iApply "Hφ". by iFrame.
  Qed.

End cap_lang_rules.


Require Import Framework File FileDiskLayer FileDiskNoninterference FileDiskRefinement.
Require Import FunctionalExtensionality Lia Language.

Lemma blocks_allocator_rep_upd:
forall x4 t0 a v1,
DiskAllocator.block_allocator_rep x4 t0 ->
nth_error (value_to_bits (t0 DiskAllocatorParams.bitmap_addr)) a =
Some true ->
a < DiskAllocatorParams.num_of_blocks ->
DiskAllocator.block_allocator_rep (Mem.upd x4 a v1)
(upd t0 (DiskAllocatorParams.bitmap_addr + S a) v1).
Proof.
  unfold DiskAllocator.block_allocator_rep; intros.
  cleanup.
  exists (t0 DiskAllocatorParams.bitmap_addr), (updn x0 a v1).
  intuition eauto.
  rewrite upd_ne; eauto; lia.
  erewrite <- seln_eq_updn_eq with (l:= (value_to_bits (t0 DiskAllocatorParams.bitmap_addr))).
  erewrite <- upd_nop.
  eapply DiskAllocator.valid_bits_upd.
  eauto.
  rewrite value_to_bits_length; eauto.
  rewrite value_to_bits_length; eauto.
  pose proof DiskAllocatorParams.num_of_blocks_in_bounds;
  unfold DiskAllocatorParams.num_of_blocks in *; lia.
  erewrite seln_eq_updn_eq.
  rewrite value_to_bits_to_value.
  rewrite upd_ne; eauto; lia.
  eapply nth_error_nth in H0.
  rewrite nth_seln_eq; eauto.
  eapply nth_error_nth in H0.
  rewrite nth_seln_eq; eauto.
  rewrite updn_length; eauto.
  rewrite Mem.upd_ne; eauto; lia.
  Unshelve.
  all: constructor.
Qed.

Lemma file_map_rep_upd:
forall x inum f off v1 x2 x4 a inode,
file_map_rep x x2 x4  ->
nth_error (Inode.block_numbers inode) off = Some a ->
x inum = Some f ->
x2 inum = Some inode ->
Inode.inode_map_valid x2 ->
file_map_rep (Mem.upd x inum (update_file f off v1)) x2 (Mem.upd x4 a v1).
Proof.
  unfold file_map_rep in *; intros; cleanup.
  split; eauto.
  unfold addrs_match_exactly in *.
  intros.
  destruct (addr_dec inum a0); subst.
  rewrite Mem.upd_eq; eauto.
  intuition congruence.
  rewrite Mem.upd_ne; eauto.

  intros.
  eapply_fresh H4 in H2; eauto.
  destruct (addr_dec inum inum0); subst.
  rewrite Mem.upd_eq in H6; eauto.
  rewrite H2 in H5.
  cleanup.
  unfold file_rep, update_file in *;
  simpl in *; cleanup.
  intuition eauto.
  rewrite updn_length; eauto.
  destruct (addr_dec i off); subst.
  cleanup.
  exists v1.
  erewrite FileInnerSpecs.nth_error_updn_eq; eauto.
  rewrite Mem.upd_eq; eauto.
  eapply_fresh Inode.nth_error_some_lt in H0; lia.
  eapply_fresh H7 in H8; cleanup.
  exists x0.
  erewrite FileInnerSpecs.nth_error_updn_ne; eauto.
  rewrite Mem.upd_ne; eauto.
  destruct (addr_dec block_number a); eauto; subst.
  unfold Inode.inode_map_valid, Inode.inode_valid in *; cleanup.
  eapply H3 in H2; cleanup.
  eapply NoDup_nth_error in H2; eauto.
  eapply nth_error_Some; eauto.
  congruence.
  congruence.
  rewrite Mem.upd_ne in H6; eauto.
  eapply_fresh H4 in H5; eauto.
  unfold file_rep in *; cleanup.
  intuition eauto.
  eapply_fresh H9 in H13; eauto; cleanup.
  eexists; intuition eauto.
  rewrite Mem.upd_ne; eauto.

  destruct (addr_dec block_number a); eauto; subst.
  unfold Inode.inode_map_valid, Inode.inode_valid in *; cleanup.
  eapply H16 in H2; eauto.
  eapply NoDup_nth_error in H2.
  instantiate (1:= i) in H2;
  instantiate (1:= length (Inode.block_numbers inode0) + off) in H2.
  eapply_fresh Inode.nth_error_some_lt in H14; lia.

  rewrite app_length.
  eapply_fresh Inode.nth_error_some_lt in H0; lia.
  rewrite nth_error_app2.
  rewrite nth_error_app1.
  replace (length (Inode.block_numbers inode0) + off -
  length (Inode.block_numbers inode0)) with off.
  congruence.
  lia.
  eapply nth_error_Some; eauto.
  congruence.
  lia.
Qed.

Ltac econstructor_recovery :=
  match goal with
  | [|- recovery_exec _ ?u [?o] _ [] _ _ _ ]=>
    eapply (@ExecFinished _ _ _ _ u o)
  | [|- recovery_exec _ ?u (?o :: _) _ (?rf :: _) _ _ _ ]=>
    eapply (@ExecRecovered _ _ _ _ u o _ _ _ rf)
  end.

  Ltac invert_exec_lift_no_match :=
  match goal with
  | [H: Language.exec' _ _ _ (Op _ (P1 _)) _ |- _ ]=>
    invert_exec'' H
  | [H: Language.exec' _ _ _ (Op _ (P2 _)) _ |- _ ]=>
    invert_exec'' H
  | [H: Language.exec' _ _ _ (_ <- lift_L1 _ _; _) _ |- _ ]=>
    invert_exec'' H
  | [H: Language.exec' _ _ _ (_ <- lift_L2 _ _; _) _ |- _ ]=>
    invert_exec'' H
  | [H: Language.exec' _ _ _ (_ <- Op _ (P1 _); _) _ |- _ ]=>
    invert_exec'' H
  | [H: Language.exec' _ _ _ (_ <- Op _ (P2 _); _) _ |- _ ]=>
    invert_exec'' H
  | _ =>
    try invert_exec_no_match
  end.

  Ltac invert_exec_lift :=
  match goal with
  | [H: Language.exec' _ _ _ (Op _ (P1 _)) _ |- _ ]=>
    invert_exec'' H
  | [H: Language.exec' _ _ _ (Op _ (P2 _)) _ |- _ ]=>
    invert_exec'' H
  | [H: Language.exec' _ _ _ (_ <- lift_L1 _ _; _) _ |- _ ]=>
    invert_exec'' H
  | [H: Language.exec' _ _ _ (_ <- lift_L2 _ _; _) _ |- _ ]=>
    invert_exec'' H
  | [H: Language.exec' _ _ _ (_ <- Op _ (P1 _); _) _ |- _ ]=>
    invert_exec'' H
  | [H: Language.exec' _ _ _ (_ <- Op _ (P2 _); _) _ |- _ ]=>
    invert_exec'' H
  | _ =>
    try invert_exec
  end.

Theorem Termination_Sensitive_recover:
  forall u u' n ex,
      Termination_Sensitive u recover recover recover
          AD_valid_state (AD_related_states u' ex)
          (authenticated_disk_reboot_list n).
Proof.
  induction n; simpl;
  unfold Termination_Sensitive, AD_valid_state,
  AD_related_states, FD_valid_state, FD_related_states,
  refines_valid, refines_related,
  authenticated_disk_reboot_list in *;
  intros; cleanup; simpl in *.
  {
    invert_exec; cleanup.
    unfold recover in *; repeat invert_exec; simpl in *.
    simpl in H11.
    repeat invert_exec_lift_no_match.
    eexists.
    econstructor_recovery.
    repeat econstructor.
  }
  {
    invert_exec; cleanup.
    unfold recover in *; repeat invert_exec; simpl in *.
    repeat invert_exec_lift_no_match.
    repeat cleanup_pairs.
    destruct s2, s1, p; simpl in *.
    edestruct IHn.
    3: apply H15.
    intros; eauto.
    intros; eauto.
    instantiate (2:= (s0, (Empty, (t4, t4)))).
    unfold refines, files_rep in *; simpl in *.
    cleanup; do 2 eexists; intuition eauto.
    eexists.
    econstructor_recovery.
    repeat econstructor; eauto.
    simpl; eauto.
  }
Qed.

Ltac invert_bind :=
match goal with
|[H: exec' _ _ _ (Ret _) _ |- _] =>
invert_exec'' H
|[H: exec' _ _ _ (Op _ (P1 _)) _ |- _] =>
invert_exec'' H
|[H: exec' _ _ _ (Op _ (P2 _)) _ |- _] =>
invert_exec'' H
|[H: exec' _ _ _ (_ <- _ ; _) _ |- _] =>
invert_exec'' H
| _ =>
  try invert_exec
end.

Ltac invert_bind_no_match :=
match goal with
|[H: exec' _ _ _ (Ret _) _ |- _] =>
invert_exec'' H
|[H: exec' _ _ _ (Op _ (P1 _)) _ |- _] =>
invert_exec'' H
|[H: exec' _ _ _ (Op _ (P2 _)) _ |- _] =>
invert_exec'' H
|[H: exec' _ _ _ (_ <- _ ; _) _ |- _] =>
invert_exec'' H
| _ =>
  try invert_exec_no_match
end.

Set Nested Proofs Allowed.
Lemma lt_le_lt:
      forall n m p q,
      n + m < q -> p <= m -> n + p < q.
Proof.  lia. Qed.

Lemma nth_error_None_r :
forall T (l: list T) n,
n >= length l ->
nth_error l n = None.
Proof.
  apply nth_error_None.
Qed.

Lemma bind_reorder_l:
  forall O (L: Language O) T
  (p1: prog L T) T' (p2: T -> prog L T')
  T'' (p3: T' -> prog L T'')
  u o s r,
      exec L u o s (Bind p1 (fun t => Bind (p2 t) p3)) r ->
      exec L u o s (Bind (Bind p1 p2) p3) r.
Proof.  Proof.
eapply bind_reorder.
Qed.

Lemma bind_reorder_r:
  forall O (L: Language O) T
  (p1: prog L T) T' (p2: T -> prog L T')
  T'' (p3: T' -> prog L T'')
  u o s r,
  exec L u o s (Bind (Bind p1 p2) p3) r ->
      exec L u o s (Bind p1 (fun t => Bind (p2 t) p3)) r.

Proof.  Proof.
eapply bind_reorder.
Qed.

Lemma inode_allocations_are_same:
forall u fm1 fm2 s1 s2 t1 t2 inum ex,
refines s1 fm1 ->
refines s2 fm2 ->
same_for_user_except u ex fm1 fm2 ->
inum < Inode.InodeAllocatorParams.num_of_blocks ->
t1 = fst (snd (snd s1)) ->
t2 = fst (snd (snd s2)) ->
nth_error
(value_to_bits
  (t1 Inode.InodeAllocatorParams.bitmap_addr))
inum =
nth_error
  (value_to_bits (t2
  Inode.InodeAllocatorParams.bitmap_addr)) inum.
Proof.
  unfold refines, files_rep,
  files_inner_rep, same_for_user_except; intros.
  cleanup; repeat cleanup_pairs.
  destruct_fresh (x inum).
  {
    eapply_fresh FileInnerSpecs.inode_exists_then_file_exists in D; eauto.
    cleanup.
    destruct_fresh (fm1 inum).
    {
      destruct_fresh (x1 inum).
      unfold Inode.inode_rep,
      Inode.inode_map_rep,
      Inode.InodeAllocator.block_allocator_rep in *.
      cleanup.
      eapply Inode.InodeAllocator.valid_bits_extract with (n:= inum) in H8.
      cleanup; split_ors; cleanup; try congruence.
      rewrite H4, H8 in D; simpl in *; congruence.
      rewrite nth_seln_eq in H3.
      repeat erewrite nth_error_nth'.

      eapply Inode.InodeAllocator.valid_bits_extract with (n:= inum) in H17.
      cleanup; split_ors; cleanup; try congruence.
      rewrite H15, H21 in D1; simpl in *; congruence.
      rewrite nth_seln_eq in H20.
      rewrite H3, H20; eauto.
      all: try rewrite value_to_bits_length;
      unfold Inode.InodeAllocatorParams.num_of_blocks in *;
      pose proof Inode.InodeAllocatorParams.num_of_blocks_in_bounds; try lia.

      unfold file_map_rep in *; cleanup.
      edestruct H7; exfalso.
      apply H11; eauto; congruence.
    }
    {
      edestruct H1; exfalso.
      apply H3; eauto; congruence.
    }
  }
  {
    eapply_fresh FileInnerSpecs.inode_missing_then_file_missing in D; eauto.
    cleanup.
    destruct_fresh (fm1 inum).
    {
      edestruct H1; exfalso.
      apply H; eauto; congruence.
    }
    destruct_fresh (x1 inum).
    {
      unfold file_map_rep in *; cleanup.
      edestruct H3; exfalso.
      apply H10; eauto; congruence.
    }
    {
      unfold Inode.inode_rep,
      Inode.inode_map_rep,
      Inode.InodeAllocator.block_allocator_rep in *.
      cleanup.
      eapply Inode.InodeAllocator.valid_bits_extract with (n:= inum) in H7.
      cleanup; split_ors; cleanup; try congruence.
      rewrite nth_seln_eq in H0.
      repeat erewrite nth_error_nth'.

      eapply Inode.InodeAllocator.valid_bits_extract with (n:= inum) in H16.
      cleanup; split_ors; cleanup; try congruence.
      rewrite nth_seln_eq in H19.
      rewrite H0, H19; eauto.
      rewrite H12, H20 in D1; simpl in *; congruence.
      all: try rewrite value_to_bits_length;
      unfold Inode.InodeAllocatorParams.num_of_blocks in *;
      pose proof Inode.InodeAllocatorParams.num_of_blocks_in_bounds; try lia.
      rewrite H3, H7 in D; simpl in *; congruence.
    }
  }
Qed.

Lemma inode_owners_are_same:
forall u fm1 fm2 s1 s2 inum ex,
refines s1 fm1 ->
refines s2 fm2 ->
same_for_user_except u ex fm1 fm2 ->
inum < Inode.InodeAllocatorParams.num_of_blocks ->
nth_error
(value_to_bits
  (fst (snd (snd s1)) Inode.InodeAllocatorParams.bitmap_addr))
inum = Some true ->
  Inode.owner (Inode.decode_inode
(fst (snd (snd s1)) (Inode.InodeAllocatorParams.bitmap_addr + S inum))) =
  Inode.owner
(Inode.decode_inode
(fst (snd (snd s2)) (Inode.InodeAllocatorParams.bitmap_addr + S inum))).
Proof.
  unfold refines, files_rep,
  files_inner_rep, same_for_user_except; intros.
  cleanup; repeat cleanup_pairs.
  destruct_fresh (x1 inum).
  {
    eapply_fresh FileInnerSpecs.inode_exists_then_file_exists in D; eauto.
    cleanup.
    destruct_fresh (fm2 inum).
    {
      destruct_fresh (x inum).
      eapply_fresh H5 in D0; eauto; cleanup.
      unfold file_map_rep in *; cleanup.
      eapply_fresh H10 in D0; eauto.
      eapply_fresh H14 in D; eauto.
      unfold file_rep in *; cleanup.

      unfold Inode.inode_rep,
      Inode.inode_map_rep,
      Inode.InodeAllocator.block_allocator_rep in *.
      cleanup.
      eapply Inode.InodeAllocator.valid_bits_extract with (n:= inum) in H23.
      cleanup; split_ors; cleanup; try congruence.
      rewrite H21, H23 in D1; simpl in *; congruence.
      rewrite H21, H23 in D1; simpl in *.
      cleanup.

      eapply Inode.InodeAllocator.valid_bits_extract with (n:= inum) in H28.
      cleanup; split_ors; cleanup; try congruence.
      rewrite H26, H32 in D; simpl in *; congruence.
      rewrite H26, H32 in D; simpl in *; cleanup.
      eauto.

      all: try rewrite value_to_bits_length;
      unfold Inode.InodeAllocatorParams.num_of_blocks in *;
      pose proof Inode.InodeAllocatorParams.num_of_blocks_in_bounds; try lia.

      unfold file_map_rep in *; cleanup.
      edestruct H6; exfalso.
      apply H14; eauto; congruence.
    }
    {
      edestruct H1; exfalso.
      apply H0; eauto; congruence.
    }
  }
  {
    unfold Inode.inode_rep,
      Inode.inode_map_rep,
      Inode.InodeAllocator.block_allocator_rep in *.
      cleanup.
      eapply Inode.InodeAllocator.valid_bits_extract with (n:= inum) in H17.
      cleanup; split_ors; cleanup; try congruence.
      eapply nth_error_nth in H3.
      rewrite <- nth_seln_eq in H3.
      rewrite H0 in H3; congruence.
      rewrite H15, H17 in D; simpl in *; congruence.

      all: try rewrite value_to_bits_length;
      unfold Inode.InodeAllocatorParams.num_of_blocks in *;
      pose proof Inode.InodeAllocatorParams.num_of_blocks_in_bounds; try lia.
  }
Qed.

Lemma inode_owners_are_same':
forall u fm1 fm2 s1 s2 t1 t2 inum ex,
refines s1 fm1 ->
refines s2 fm2 ->
same_for_user_except u ex fm1 fm2 ->
inum < Inode.InodeAllocatorParams.num_of_blocks ->
nth_error
(value_to_bits
  (t1 Inode.InodeAllocatorParams.bitmap_addr))
inum = Some true ->
t1 = fst (snd (snd s1)) ->
t2 = fst (snd (snd s2)) ->
  Inode.owner (Inode.decode_inode
(t1 (Inode.InodeAllocatorParams.bitmap_addr + S inum))) =
  Inode.owner
(Inode.decode_inode
(t2 (Inode.InodeAllocatorParams.bitmap_addr + S inum))).
Proof.
  unfold refines, files_rep,
  files_inner_rep, same_for_user_except; intros.
  cleanup; repeat cleanup_pairs.
  destruct_fresh (x1 inum).
  {
    eapply_fresh FileInnerSpecs.inode_exists_then_file_exists in D; eauto.
    cleanup.
    destruct_fresh (fm2 inum).
    {
      destruct_fresh (x inum).
      eapply_fresh H7 in D0; eauto; cleanup.
      unfold file_map_rep in *; cleanup.
      eapply_fresh H8 in D0; eauto.
      eapply_fresh H12 in D; eauto.
      unfold file_rep in *; cleanup.

      unfold Inode.inode_rep,
      Inode.inode_map_rep,
      Inode.InodeAllocator.block_allocator_rep in *.
      cleanup.
      eapply Inode.InodeAllocator.valid_bits_extract with (n:= inum) in H23.
      cleanup; split_ors; cleanup; try congruence.
      rewrite H21, H23 in D1; simpl in *; congruence.
      rewrite H21, H23 in D1; simpl in *.
      cleanup.

      eapply Inode.InodeAllocator.valid_bits_extract with (n:= inum) in H28.
      cleanup; split_ors; cleanup; try congruence.
      rewrite H26, H32 in D; simpl in *; congruence.
      rewrite H26, H32 in D; simpl in *; cleanup.
      eauto.

      all: try rewrite value_to_bits_length;
      unfold Inode.InodeAllocatorParams.num_of_blocks in *;
      pose proof Inode.InodeAllocatorParams.num_of_blocks_in_bounds; try lia.

      unfold file_map_rep in *; cleanup.
      edestruct H4; exfalso.
      apply H12; eauto; congruence.
    }
    {
      edestruct H1; exfalso.
      apply H0; eauto; congruence.
    }
  }
  {
    unfold Inode.inode_rep,
      Inode.inode_map_rep,
      Inode.InodeAllocator.block_allocator_rep in *.
      cleanup.
      eapply Inode.InodeAllocator.valid_bits_extract with (n:= inum) in H17.
      cleanup; split_ors; cleanup; try congruence.
      eapply nth_error_nth in H3.
      rewrite <- nth_seln_eq in H3.
      rewrite H0 in H3; congruence.
      rewrite H13, H17 in D; simpl in *; congruence.

      all: try rewrite value_to_bits_length;
      unfold Inode.InodeAllocatorParams.num_of_blocks in *;
      pose proof Inode.InodeAllocatorParams.num_of_blocks_in_bounds; try lia.
  }
Qed.

Lemma block_numbers_in_length:
forall inum off a s2 d' x x0 u ex,
refines d' x ->
refines s2 x0 ->
same_for_user_except u ex x x0 ->
inum < Inode.InodeAllocatorParams.num_of_blocks ->
nth_error
(value_to_bits
  (fst (snd (snd d')) Inode.InodeAllocatorParams.bitmap_addr))
inum = Some true ->
nth_error
 (Inode.block_numbers
    (Inode.decode_inode
       (fst (snd (snd d')) (Inode.InodeAllocatorParams.bitmap_addr + S inum))))
 off = Some a ->
off <
length
(Inode.block_numbers
(Inode.decode_inode
  (fst (snd (snd s2))
     (Inode.InodeAllocatorParams.bitmap_addr + S inum)))).
Proof.
  unfold refines, files_rep,
  files_inner_rep, same_for_user_except; intros.
  cleanup; repeat cleanup_pairs.
  destruct_fresh (x3 inum).
  {
    eapply_fresh FileInnerSpecs.inode_exists_then_file_exists in D; eauto.
    cleanup.
    destruct_fresh (x0 inum).
    {
      destruct_fresh (x1 inum).
      eapply_fresh H6 in D0; eauto; cleanup.
      unfold file_map_rep in *; cleanup.
      eapply_fresh H11 in D0; eauto.
      eapply_fresh H15 in D; eauto.
      unfold file_rep in *; cleanup.

      unfold Inode.inode_rep,
      Inode.inode_map_rep,
      Inode.InodeAllocator.block_allocator_rep in *.
      cleanup.
      eapply Inode.InodeAllocator.valid_bits_extract with (n:= inum) in H24.
      cleanup; split_ors; cleanup; try congruence.
      rewrite H22, H24 in D1; simpl in *; congruence.
      rewrite H22, H24 in D1; simpl in *.
      cleanup.

      eapply Inode.InodeAllocator.valid_bits_extract with (n:= inum) in H29.
      cleanup; split_ors; cleanup; try congruence.
      rewrite H27, H33 in D; simpl in *; congruence.
      rewrite H27, H33 in D; simpl in *; cleanup.
      eapply nth_error_Some; eauto; congruence.

      all: try rewrite value_to_bits_length;
      unfold Inode.InodeAllocatorParams.num_of_blocks in *;
      pose proof Inode.InodeAllocatorParams.num_of_blocks_in_bounds; try lia.

      unfold file_map_rep in *; cleanup.
      edestruct H7; exfalso.
      apply H15; eauto; congruence.
    }
    {
      edestruct H1; exfalso.
      apply H0; eauto; congruence.
    }
  }
  {
    unfold Inode.inode_rep,
      Inode.inode_map_rep,
      Inode.InodeAllocator.block_allocator_rep in *.
      cleanup.
      eapply Inode.InodeAllocator.valid_bits_extract with (n:= inum) in H18.
      cleanup; split_ors; cleanup; try congruence.
      eapply nth_error_nth in H3.
      rewrite <- nth_seln_eq in H3.
      rewrite H0 in H3; congruence.
      rewrite H16, H18 in D; simpl in *; congruence.

      all: try rewrite value_to_bits_length;
      unfold Inode.InodeAllocatorParams.num_of_blocks in *;
      pose proof Inode.InodeAllocatorParams.num_of_blocks_in_bounds; try lia.
  }
Qed.

Lemma block_numbers_oob:
forall inum off s2 d' x x0 u ex,
refines d' x ->
refines s2 x0 ->
same_for_user_except u ex x x0 ->
inum < Inode.InodeAllocatorParams.num_of_blocks ->
nth_error
(value_to_bits
  (fst (snd (snd d')) Inode.InodeAllocatorParams.bitmap_addr))
inum = Some true ->
nth_error
 (Inode.block_numbers
    (Inode.decode_inode
       (fst (snd (snd d')) (Inode.InodeAllocatorParams.bitmap_addr + S inum))))
 off = None ->
off >=
length
(Inode.block_numbers
(Inode.decode_inode
  (fst (snd (snd s2))
     (Inode.InodeAllocatorParams.bitmap_addr + S inum)))).
     Proof.
      unfold refines, files_rep,
      files_inner_rep, same_for_user_except; intros.
      cleanup; repeat cleanup_pairs.
      destruct_fresh (x3 inum).
      {
        eapply_fresh FileInnerSpecs.inode_exists_then_file_exists in D; eauto.
        cleanup.
        destruct_fresh (x0 inum).
        {
          destruct_fresh (x1 inum).
          eapply_fresh H6 in D0; eauto; cleanup.
          unfold file_map_rep in *; cleanup.
          eapply_fresh H11 in D0; eauto.
          eapply_fresh H15 in D; eauto.
          unfold file_rep in *; cleanup.

          unfold Inode.inode_rep,
          Inode.inode_map_rep,
          Inode.InodeAllocator.block_allocator_rep in *.
          cleanup.
          eapply Inode.InodeAllocator.valid_bits_extract with (n:= inum) in H24.
          cleanup; split_ors; cleanup; try congruence.
          rewrite H22, H24 in D1; simpl in *; congruence.
          rewrite H22, H24 in D1; simpl in *.
          cleanup.

          eapply Inode.InodeAllocator.valid_bits_extract with (n:= inum) in H29.
          cleanup; split_ors; cleanup; try congruence.
          rewrite H27, H33 in D; simpl in *; congruence.
          rewrite H27, H33 in D; simpl in *; cleanup.
          eapply nth_error_None; eauto; congruence.

          all: try rewrite value_to_bits_length;
          unfold Inode.InodeAllocatorParams.num_of_blocks in *;
          pose proof Inode.InodeAllocatorParams.num_of_blocks_in_bounds; try lia.

          unfold file_map_rep in *; cleanup.
          edestruct H7; exfalso.
          apply H15; eauto; congruence.
        }
        {
          edestruct H1; exfalso.
          apply H0; eauto; congruence.
        }
      }
      {
        unfold Inode.inode_rep,
          Inode.inode_map_rep,
          Inode.InodeAllocator.block_allocator_rep in *.
          cleanup.
          eapply Inode.InodeAllocator.valid_bits_extract with (n:= inum) in H18.
          cleanup; split_ors; cleanup; try congruence.
          eapply nth_error_nth in H3.
          rewrite <- nth_seln_eq in H3.
          rewrite H0 in H3; congruence.
          rewrite H16, H18 in D; simpl in *; congruence.

          all: try rewrite value_to_bits_length;
          unfold Inode.InodeAllocatorParams.num_of_blocks in *;
          pose proof Inode.InodeAllocatorParams.num_of_blocks_in_bounds; try lia.
      }
    Qed.

Hint Resolve block_numbers_in_length : core.
Hint Resolve block_numbers_oob : core.

Ltac exec_step:=
  repeat eapply bind_reorder_l;
  rewrite cons_app; econstructor;
  [solve [repeat econstructor; eauto]
  | try solve [repeat econstructor; eauto] ].

Ltac invert_step :=
  simpl in *;
  try match goal with
  |[A: exec _ _ _ _ _ _ |- _] =>
   repeat eapply bind_reorder_r in A
  end;
  repeat invert_bind; simpl in *; cleanup;
  try congruence;
  try solve [unfold Inode.InodeAllocatorParams.bitmap_addr,
        Inode.InodeAllocatorParams.num_of_blocks,
        DiskAllocatorParams.bitmap_addr,
        DiskAllocatorParams.num_of_blocks in *;
        pose proof Inode.InodeAllocatorParams.blocks_fit_in_disk;
        pose proof DiskAllocatorParams.blocks_fit_in_disk;
        lia].

 Ltac invert_step_crash :=
  simpl in *;
  try match goal with
  |[A: exec _ _ _ _ _ _ |- _] =>
   repeat eapply bind_reorder_r in A
  end;
  repeat invert_bind_no_match; simpl in *; try split_ors; cleanup_no_match;
  try congruence;
  try solve [unfold Inode.InodeAllocatorParams.bitmap_addr,
        Inode.InodeAllocatorParams.num_of_blocks,
        DiskAllocatorParams.bitmap_addr,
        DiskAllocatorParams.num_of_blocks in *;
        pose proof Inode.InodeAllocatorParams.blocks_fit_in_disk;
        pose proof DiskAllocatorParams.blocks_fit_in_disk;
        lia].

Lemma block_nums_inbound:
forall inum off s2 fm,
refines s2 fm ->
inum < Inode.InodeAllocatorParams.num_of_blocks ->
nth_error
(value_to_bits
  (fst (snd (snd s2)) Inode.InodeAllocatorParams.bitmap_addr))
inum = Some true ->
(nth off
    (Inode.block_numbers
        (Inode.decode_inode
          (fst (snd (snd s2)) (Inode.InodeAllocatorParams.bitmap_addr + S inum)))) 0)
  < DiskAllocatorParams.num_of_blocks.
  Proof.
    unfold refines, files_rep,
    files_inner_rep, same_for_user_except; intros.
    cleanup; repeat cleanup_pairs.
    destruct_fresh (x inum).
    {
      eapply_fresh FileInnerSpecs.inode_exists_then_file_exists in D; eauto.
      cleanup.

      unfold file_rep in *; cleanup.

        unfold Inode.inode_rep,
        Inode.inode_map_rep,
        Inode.InodeAllocator.block_allocator_rep in *.
        cleanup.

        eapply Inode.InodeAllocator.valid_bits_extract with (n:= inum) in H7.
        cleanup; split_ors; cleanup; try congruence.
        rewrite H3, H10 in D; simpl in *; congruence.

        unfold Inode.inode_map_valid, Inode.inode_valid in *; cleanup.
        eapply_fresh H6 in D; eauto.
        cleanup.
        unfold file_map_rep, file_rep in *; cleanup.
        eapply_fresh H14 in D; eauto; cleanup.

        unfold DiskAllocator.block_allocator_rep in *.
        rewrite H3, H10 in D; simpl in *; cleanup.

        destruct_fresh (nth_error (Inode.block_numbers (Inode.decode_inode (seln x4 inum value0))) off).
        eapply_fresh H17 in D; cleanup.
        eapply nth_error_nth with (d:= 0) in D; rewrite <- D in *.

        destruct (Compare_dec.lt_dec (nth off
        (Inode.block_numbers
           (Inode.decode_inode (seln x4 inum value0))) 0) DiskAllocatorParams.num_of_blocks); eauto.
        rewrite H20 in H21; try congruence; try lia.

        apply nth_error_None in D.
        rewrite <- nth_seln_eq, seln_oob; eauto.
        unfold DiskAllocatorParams.num_of_blocks.
        apply FSParameters.file_blocks_count_nonzero.
        lia.

        all: try rewrite value_to_bits_length;
        unfold Inode.InodeAllocatorParams.num_of_blocks in *;
        pose proof Inode.InodeAllocatorParams.num_of_blocks_in_bounds; try lia.
    }
    {
      unfold file_rep in *; cleanup.
        unfold Inode.inode_rep,
        Inode.inode_map_rep,
        Inode.InodeAllocator.block_allocator_rep in *.
        cleanup.

        eapply Inode.InodeAllocator.valid_bits_extract with (n:= inum) in H6.
        cleanup; split_ors; cleanup; try congruence.
        eapply nth_error_nth in H1.
        rewrite nth_seln_eq in H6; rewrite H6 in H1; congruence.
        rewrite H2, H9 in D; simpl in *; congruence.

        all: try rewrite value_to_bits_length;
        unfold Inode.InodeAllocatorParams.num_of_blocks in *;
        pose proof Inode.InodeAllocatorParams.num_of_blocks_in_bounds; try lia.
    }
  Qed.

Lemma used_blocks_are_allocated:
forall s2 off inum fm,
refines s2 fm ->
inum < Inode.InodeAllocatorParams.num_of_blocks ->
off < length (Inode.block_numbers
(Inode.decode_inode
    (fst (snd (snd s2))
      (Inode.InodeAllocatorParams.bitmap_addr + S inum)))) ->
nth_error
(value_to_bits
  (fst (snd (snd s2)) Inode.InodeAllocatorParams.bitmap_addr))
inum = Some true ->
nth_error
    (value_to_bits
      (fst (snd (snd s2))
          DiskAllocatorParams.bitmap_addr))
    (nth off
      (Inode.block_numbers
          (Inode.decode_inode
            (fst (snd (snd s2))
                (Inode.InodeAllocatorParams.bitmap_addr + S inum)))) 0) = Some true.
Proof.
  unfold refines, files_rep,
  files_inner_rep; intros.
  cleanup; repeat cleanup_pairs.
  destruct_fresh (x inum).
  {
    eapply_fresh FileInnerSpecs.inode_exists_then_file_exists in D; eauto.
    cleanup.

    unfold file_rep in *; cleanup.

      unfold Inode.inode_rep,
      Inode.inode_map_rep,
      Inode.InodeAllocator.block_allocator_rep in *.
      cleanup.

      eapply Inode.InodeAllocator.valid_bits_extract with (n:= inum) in H8.
      cleanup; split_ors; cleanup; try congruence.
      rewrite H4, H11 in D; simpl in *; congruence.

      unfold Inode.inode_map_valid, Inode.inode_valid in *; cleanup.
      eapply_fresh H7 in D; eauto.
      cleanup.
      unfold file_map_rep, file_rep in *; cleanup.
      eapply_fresh H15 in D; eauto; cleanup.

      unfold DiskAllocator.block_allocator_rep in *.
      rewrite H4, H11 in D; simpl in *; cleanup.

      destruct_fresh (nth_error (Inode.block_numbers (Inode.decode_inode (seln x4 inum value0))) off).
      eapply_fresh H18 in D; cleanup.
      eapply nth_error_nth with (d:= 0) in D; rewrite <- D in *.

      eapply DiskAllocator.valid_bits_extract with (n:= (nth off
      (Inode.block_numbers
         (Inode.decode_inode (seln x4 inum value0)))
      0)) in H19.
      cleanup; split_ors; cleanup; try congruence.
      erewrite nth_error_nth'; eauto.
      rewrite <- nth_seln_eq, H23; eauto.

      rewrite value_to_bits_length.
      eapply Forall_forall in H14.
      2: eapply nth_In; eauto.
      instantiate (1:= 0) in H14.
      pose proof DiskAllocatorParams.num_of_blocks_in_bounds.
      eapply PeanoNat.Nat.lt_le_trans; eauto.

      rewrite H20.
      eapply Forall_forall in H14.
      2: eapply nth_In; eauto.
      instantiate (1:= 0) in H14.
      pose proof DiskAllocatorParams.num_of_blocks_in_bounds.
      eapply PeanoNat.Nat.lt_le_trans; eauto.

      rewrite H20, value_to_bits_length.
      apply DiskAllocatorParams.num_of_blocks_in_bounds.

      apply nth_error_None in D; lia.
      lia.

      rewrite H9, value_to_bits_length.
      apply Inode.InodeAllocatorParams.num_of_blocks_in_bounds.
  }
  {
    unfold file_rep in *; cleanup.
      unfold Inode.inode_rep,
      Inode.inode_map_rep,
      Inode.InodeAllocator.block_allocator_rep in *.
      cleanup.

      eapply Inode.InodeAllocator.valid_bits_extract with (n:= inum) in H7.
      cleanup; split_ors; cleanup; try congruence.
      eapply nth_error_nth in H2.
      rewrite nth_seln_eq in H7; rewrite H7 in H2; congruence.
      rewrite H3, H10 in D; simpl in *; congruence.

      all: try rewrite value_to_bits_length;
      unfold Inode.InodeAllocatorParams.num_of_blocks in *;
      pose proof Inode.InodeAllocatorParams.num_of_blocks_in_bounds; try lia.
  }
Qed.

Lemma data_block_inbounds:
forall inum off s2 fm,
refines s2 fm ->
inum < Inode.InodeAllocatorParams.num_of_blocks ->
off < length (Inode.block_numbers
(Inode.decode_inode
    (fst (snd (snd s2))
      (Inode.InodeAllocatorParams.bitmap_addr + S inum)))) ->
nth_error
(value_to_bits
  (fst (snd (snd s2)) Inode.InodeAllocatorParams.bitmap_addr))
inum = Some true ->
DiskAllocatorParams.bitmap_addr +
S
(nth off
(Inode.block_numbers
(Inode.decode_inode
  (fst (snd (snd (fst s2, snd s2)))
    (Inode.InodeAllocatorParams.bitmap_addr + S inum)))) 0) <
FSParameters.data_length.
Proof.
  unfold refines, files_rep,
  files_inner_rep; intros.
  cleanup; repeat cleanup_pairs.
  destruct_fresh (x inum).
  {
    eapply_fresh FileInnerSpecs.inode_exists_then_file_exists in D; eauto.
    cleanup.

    unfold file_rep in *; cleanup.

      unfold Inode.inode_rep,
      Inode.inode_map_rep,
      Inode.InodeAllocator.block_allocator_rep in *.
      cleanup.

      eapply Inode.InodeAllocator.valid_bits_extract with (n:= inum) in H8.
      cleanup; split_ors; cleanup; try congruence.
      rewrite H4, H11 in D; simpl in *; congruence.

      unfold Inode.inode_map_valid, Inode.inode_valid in *; cleanup.
      eapply_fresh H7 in D; eauto.
      cleanup.
      unfold file_map_rep, file_rep in *; cleanup.
      eapply_fresh H15 in D; eauto; cleanup.

      unfold DiskAllocator.block_allocator_rep in *.
      rewrite H4, H11 in D; simpl in *; cleanup.

      destruct_fresh (nth_error (Inode.block_numbers (Inode.decode_inode (seln x4 inum value0))) off).
      eapply_fresh H18 in D; cleanup.
      eapply nth_error_nth with (d:= 0) in D; rewrite <- D in *.

      eapply DiskAllocator.valid_bits_extract with (n:= (nth off
      (Inode.block_numbers
         (Inode.decode_inode (seln x4 inum value0)))
      0)) in H19.
      cleanup; split_ors; cleanup; try congruence.
      pose proof DiskAllocatorParams.blocks_fit_in_disk.
      unfold DiskAllocatorParams.bitmap_addr, DiskAllocatorParams.num_of_blocks in *.

      eapply Forall_forall in H14.
      2: eapply nth_In; eauto.
      instantiate (1:= 0) in H14.
      apply PeanoNat.Nat.le_succ_l in H14.
      eapply lt_le_lt; eauto.

      rewrite H20.
      eapply Forall_forall in H14.
      2: eapply nth_In; eauto.
      instantiate (1:= 0) in H14.
      pose proof DiskAllocatorParams.num_of_blocks_in_bounds.
      eapply PeanoNat.Nat.lt_le_trans; eauto.

      rewrite H20, value_to_bits_length.
      apply DiskAllocatorParams.num_of_blocks_in_bounds.

      apply nth_error_None in D; lia.
      lia.

      rewrite H9, value_to_bits_length.
      apply Inode.InodeAllocatorParams.num_of_blocks_in_bounds.
  }
  {
    unfold file_rep in *; cleanup.
      unfold Inode.inode_rep,
      Inode.inode_map_rep,
      Inode.InodeAllocator.block_allocator_rep in *.
      cleanup.

      eapply Inode.InodeAllocator.valid_bits_extract with (n:= inum) in H7.
      cleanup; split_ors; cleanup; try congruence.
      eapply nth_error_nth in H2.
      rewrite nth_seln_eq in H7; rewrite H7 in H2; congruence.
      rewrite H3, H10 in D; simpl in *; congruence.

      all: try rewrite value_to_bits_length;
      unfold Inode.InodeAllocatorParams.num_of_blocks in *;
      pose proof Inode.InodeAllocatorParams.num_of_blocks_in_bounds; try lia.
  }
Qed.

Hint Resolve data_block_inbounds: core.

Ltac substitute_facts :=
try
  match goal with
  |[A: nth_error (value_to_bits (?t Inode.InodeAllocatorParams.bitmap_addr)) ?n = _
        |- context [nth_error (value_to_bits (?y Inode.InodeAllocatorParams.bitmap_addr)) ?n] ] =>
  erewrite <- inode_allocations_are_same with (t1 := t)(t2:= y);
  [ | | | eauto | | |];
  try match goal with
  | [|- refines _ _ ] =>
  eauto
  end; eauto;
  try solve [repeat cleanup_pairs; simpl; eauto]
  end;
try (match goal with
  |[A: nth_error ?x ?n = _ |- context [nth_error ?x ?n] ] =>
  setoid_rewrite A
  end; simpl);
try match goal with
  |[A: nth_error (Inode.block_numbers _) _ = Some _
  |- context [nth_error (Inode.block_numbers _) _] ] =>
  erewrite nth_error_nth' with (d:= 0)
  end;
try match goal with
  |[A: nth_error (Inode.block_numbers _) ?n = None
  |- context [nth_error (Inode.block_numbers _) ?n] ] =>
  setoid_rewrite nth_error_None_r; eauto
  end;
try match goal with
  |[ A: refines ?s2 _,
  A0: ?inum < Inode.InodeAllocatorParams.num_of_blocks,
A1: nth_error
(value_to_bits
  (fst (snd _) Inode.InodeAllocatorParams.bitmap_addr))
?inum = Some true |- context [Compare_dec.lt_dec
  (nth ?off (Inode.block_numbers (Inode.decode_inode
  (fst (snd (snd (fst ?s2, snd ?s2)))
      (Inode.InodeAllocatorParams.bitmap_addr + S ?inum)))) ?def) ?c] ] =>
      pose proof A1 as A2;
      erewrite inode_allocations_are_same in A2;
      [| | | eauto | | |];
      try match goal with
      | [|- refines _ _ ] =>
      eauto
      end; eauto;
      try solve [repeat cleanup_pairs; simpl; eauto];
      pose proof (block_nums_inbound inum off s2 _ A A0 A2);
  cleanup;
  destruct (Compare_dec.lt_dec
  (nth off (Inode.block_numbers (Inode.decode_inode
  (fst (snd s2)
      (Inode.InodeAllocatorParams.bitmap_addr + S inum)))) def) c) eqn:X;
      [|simpl in *; lia];
      setoid_rewrite X
end;
try match goal with
| [A: refines (_, (_, (?t, _))) ?x,
  A0: refines ?s2 ?x0,
  A1: same_for_user_except _ _ ?x ?x0
  |- exec' (Inode.owner (Inode.decode_inode (?t _))) _ _ _ _ ] =>
  erewrite inode_owners_are_same';
  [| | | eauto | | | |];
  try match goal with
      | [|- refines _ _ ] =>
      eauto
      end; eauto;
  try solve [repeat cleanup_pairs; simpl; eauto]

|[A: refines ?x4 ?x,
  A0: refines ?s2 ?x0,
  A1: same_for_user_except _ _ ?x ?x0
|- context[Some (Inode.owner (Inode.decode_inode
(fst (snd (snd (fst ?s2, snd ?s2))) _)))] ] =>
  erewrite inode_owners_are_same with (s1:= x4)(s2:= s2);
  [| | | eauto | |];
  try match goal with
      | [|- refines _ _ ] =>
      eauto
      end; eauto;
  try solve [repeat cleanup_pairs; simpl; eauto]
end;
try
  match goal with
  |[|- context [nth_error (value_to_bits (_ DiskAllocatorParams.bitmap_addr))
  (nth _ (Inode.block_numbers _) _)] ] =>
  erewrite used_blocks_are_allocated; eauto
  end.

Ltac solve_termination :=
  match goal with
  [H: refines ?s1 ?x,
  H0: refines ?s2 ?x0,
  H1: same_for_user_except _ _ ?x ?x0,
  A : recovery_exec' _ _ _ _ _ _ _ |- _] =>
    eapply Termination_Sensitive_recover in A;
    try instantiate (1:= (fst s2, (Empty, (snd (snd (snd s2)), snd (snd (snd s2)))))) in A;
    unfold AD_valid_state, refines_valid, FD_valid_state;
    intros; eauto
  end;
  repeat match goal with
  |  [A: fst ?x = fst ?y,
  A0: snd ?x = snd ?y |- _] =>
  assert(x = y); [repeat cleanup_pairs; eauto|];
    subst; clear A A0
  end;
  match goal with
  [A : AD_related_states _ _ _ _ ->
  exists _, recovery_exec _ _ _ _ _ _ _ _ |- _] =>
    edestruct A; clear A
  end;
    [ unfold AD_related_states, refines_related, FD_related_states;
      do 2 eexists; intuition eauto;
      simpl in *; unfold refines in *;
      repeat cleanup_pairs;
      unfold files_rep in *;
      cleanup; simpl in *;
      subst; eauto
    |];
  try match goal with
    [A : recovery_exec _ _ _ (fst ?s2, _) _ _ _ ?s2' |- _] =>
      exists (Recovered (extract_state_r s2'));
      econstructor_recovery; [|
        instantiate (1 := s2); eauto ]
    end;
    repeat eapply bind_reorder_l;
    repeat (
      repeat eapply bind_reorder_l;
      repeat exec_step;
      substitute_facts;
      repeat eapply bind_reorder_l;
      repeat exec_step);
    repeat eapply bind_reorder_l;
    try solve[
      eauto;
    repeat (rewrite cons_app;
    eapply ExecBindCrash);
    repeat rewrite app_nil_r;
    repeat cleanup_pairs;
    repeat econstructor; eauto].

Ltac solve_illegal_state :=
try match goal with
|[H: nth_error (Inode.block_numbers _) _ = Some ?a,
H0: nth_error (value_to_bits (_ DiskAllocatorParams.bitmap_addr)) ?a = Some false |- _] =>
eapply nth_error_nth in H as Htemp;
rewrite <- Htemp in *;
erewrite used_blocks_are_allocated in H0;
try congruence; eauto;
[ repeat cleanup_pairs; eauto
| eapply nth_error_Some; eauto;
setoid_rewrite H; congruence]
end;
try match goal with
|[H: nth_error (Inode.block_numbers _) _ = Some ?a,
H0: nth_error (value_to_bits (_ DiskAllocatorParams.bitmap_addr)) ?a = None |- _] =>
eapply nth_error_nth in H as Htemp;
rewrite <- Htemp in *;
erewrite used_blocks_are_allocated in H0;
try congruence; eauto;
[ repeat cleanup_pairs; eauto
| eapply nth_error_Some; eauto;
setoid_rewrite H; congruence]
end;
try match goal with
|[H: ~ ?a < _,
H0: nth_error (Inode.block_numbers _) _ = Some ?a |- _] =>
    exfalso; apply H;
    eapply nth_error_nth in H0;
    rewrite <- H0;
    eapply block_nums_inbound; eauto;
    repeat cleanup_pairs; eauto
end;
match goal with
|[H: ?inum < Inode.InodeAllocatorParams.num_of_blocks,
H0: nth_error (value_to_bits (_ Inode.InodeAllocatorParams.bitmap_addr)) ?inum = None |- _] =>
    apply nth_error_None in H0;
    rewrite value_to_bits_length in H0;
    pose proof Inode.InodeAllocatorParams.num_of_blocks_in_bounds;
    unfold Inode.InodeAllocatorParams.num_of_blocks in *;
    lia
end.

Ltac solve_termination_after_commit:=
match goal with
    [H: refines ?s1 ?x,
    H0: refines ?s2 ?x0,
    H1: same_for_user_except _ _ ?x ?x0,
    A : recovery_exec' _ _ _ _ _ _ _ |- _] =>
      eapply Termination_Sensitive_recover in A;
      try instantiate (1:= (fst s2, (Empty, (fst (snd (snd s2)), fst (snd (snd s2)))))) in A;
      unfold AD_valid_state, refines_valid, FD_valid_state;
      intros; eauto
    end;
    repeat match goal with
    |  [A: fst ?x = fst ?y,
    A0: snd ?x = snd ?y |- _] =>
    assert(x = y); [repeat cleanup_pairs; eauto|];
      subst; clear A A0
    end;
    match goal with
    [A : AD_related_states _ _ _ _ ->
    exists _, recovery_exec _ _ _ _ _ _ _ _ |- _] =>
      edestruct A; clear A
    end;
      [ unfold AD_related_states, refines_related, FD_related_states;
        do 2 eexists; intuition eauto;
        simpl in *; unfold refines in *;
        repeat cleanup_pairs;
        unfold files_rep in *;
        cleanup; simpl in *;
        subst; repeat cleanup_pairs; eauto
      |];
    try match goal with
      [A : recovery_exec _ _ _ ?s2 _ _ _ ?s2' |- _] =>
        exists (Recovered (extract_state_r s2'));
        econstructor_recovery; [|
          instantiate (1 := s2); eauto ]
      end;
      repeat eapply bind_reorder_l;
      repeat (
        repeat eapply bind_reorder_l;
        repeat exec_step;
        repeat substitute_facts;
        repeat eapply bind_reorder_l;
        repeat exec_step);
      repeat eapply bind_reorder_l;
      try solve[
        eauto;
      repeat (rewrite cons_app;
      eapply ExecBindCrash);
      repeat cleanup_pairs;
      repeat econstructor; eauto].

Ltac solve_termination_after_abort :=
match goal with
[H: refines ?s1 ?x,
H0: refines ?s2 ?x0,
H1: same_for_user_except _ _ ?x ?x0,
A : recovery_exec' _ _ _ _ _ _ _ |- _] =>
  eapply Termination_Sensitive_recover in A;
  try instantiate (1:= (fst s2, (Empty, (snd (snd (snd s2)), snd (snd (snd s2)))))) in A;
  unfold AD_valid_state, refines_valid, FD_valid_state;
  intros; eauto
end;
repeat match goal with
|  [A: fst ?x = fst ?y,
A0: snd ?x = snd ?y |- _] =>
assert(x = y); [repeat cleanup_pairs; eauto|];
  subst; clear A A0
end;
match goal with
[A : AD_related_states _ _ _ _ ->
exists _, recovery_exec _ _ _ _ _ _ _ _ |- _] =>
  edestruct A; clear A
end;
  [ unfold AD_related_states, refines_related, FD_related_states;
    do 2 eexists; intuition eauto;
    simpl in *; unfold refines in *;
    repeat cleanup_pairs;
    unfold files_rep in *;
    cleanup; simpl in *;
    subst; eauto
  |];
try match goal with
  [A : recovery_exec _ _ _ (fst ?s2, _) _ _ _ ?s2' |- _] =>
    exists (Recovered (extract_state_r s2'));
    econstructor_recovery; [|
      instantiate (1 := (fst s2, (Empty, (snd (snd (snd s2)), snd (snd (snd s2)))))); eauto ]
  end;
  repeat eapply bind_reorder_l;
  repeat (
    repeat eapply bind_reorder_l;
    repeat exec_step;
    repeat substitute_facts;
    repeat eapply bind_reorder_l;
    repeat exec_step);
  repeat eapply bind_reorder_l;
  try solve[
    eauto;
  repeat (rewrite cons_app;
  eapply ExecBindCrash);
  repeat cleanup_pairs;
  repeat econstructor; eauto].

  Lemma data_block_inbounds_2:
forall inum off s fm im dm inode,
Inode.inode_rep im s ->
File.DiskAllocator.block_allocator_rep dm s ->
File.file_map_rep fm im dm ->
im inum = Some inode ->
off < length (Inode.block_numbers inode) ->
File.DiskAllocatorParams.bitmap_addr +
S (seln (Inode.block_numbers inode) off 0) <
FSParameters.data_length.
Proof.
  intros.
  cleanup; repeat cleanup_pairs.
    eapply_fresh FileInnerSpecs.inode_exists_then_file_exists in H2; eauto.
    cleanup.

      unfold Inode.inode_rep,
      Inode.inode_map_rep,
      Inode.InodeAllocator.block_allocator_rep in *.
      cleanup.

      eapply Inode.InodeAllocator.valid_bits_extract with (n:= inum) in H7.
      cleanup; split_ors; cleanup; try congruence.
      rewrite H5, H10 in H2; simpl in *; congruence.

      unfold Inode.inode_map_valid, Inode.inode_valid in *; cleanup.
      eapply_fresh H6 in H2; eauto.
      cleanup.
      unfold File.file_map_rep, File.file_rep in *; cleanup.
      eapply_fresh H14 in H2; eauto; cleanup.

      unfold File.DiskAllocator.block_allocator_rep in *.
      rewrite H5, H10 in H2; simpl in *; cleanup.

      destruct_fresh (nth_error (Inode.block_numbers (Inode.decode_inode (seln x2 inum value0))) off).
      eapply_fresh H17 in D; cleanup.
      eapply nth_error_nth with (d:= 0) in D; rewrite <- D in *.

      eapply File.DiskAllocator.valid_bits_extract with (n:= (nth off
      (Inode.block_numbers
         (Inode.decode_inode (seln x2 inum value0)))
      0)) in H18.
      cleanup; split_ors; cleanup; try congruence.
      pose proof File.DiskAllocatorParams.blocks_fit_in_disk.
      unfold File.DiskAllocatorParams.bitmap_addr, File.DiskAllocatorParams.num_of_blocks in *.

      eapply Forall_forall in H13.
      2: eapply nth_In; eauto.
      instantiate (1:= 0) in H13.
      apply PeanoNat.Nat.le_succ_l in H13.
      eapply TSCommon.lt_le_lt; eauto.
      rewrite nth_seln_eq; eauto.

      rewrite H19.
      eapply Forall_forall in H13.
      2: eapply nth_In; eauto.
      instantiate (1:= 0) in H13.
      pose proof File.DiskAllocatorParams.num_of_blocks_in_bounds.
      eapply PeanoNat.Nat.lt_le_trans; eauto.

      rewrite H19, value_to_bits_length.
      apply File.DiskAllocatorParams.num_of_blocks_in_bounds.

      apply nth_error_None in D; lia.
      destruct (Compare_dec.lt_dec inum (length x2)); eauto.
      rewrite H5, H9 in H2; simpl in *; try congruence; try lia.

      rewrite H8, value_to_bits_length.
      apply Inode.InodeAllocatorParams.num_of_blocks_in_bounds.
Qed.

Set Nested Proofs Allowed.
Lemma used_blocks_are_allocated_2:
forall s off inum im inode dm fm,
Inode.inode_rep im s ->
File.DiskAllocator.block_allocator_rep
     dm s ->
     File.file_map_rep fm im dm ->
im inum = Some inode ->
off < length (Inode.block_numbers inode) ->
nth_error
  (value_to_bits
    (s File.DiskAllocatorParams.bitmap_addr))
  (seln (Inode.block_numbers inode) off 0) = Some true.
Proof.
intros.
eapply_fresh FileInnerSpecs.inode_exists_then_file_exists in H2; eauto.
cleanup.
unfold Inode.inode_rep, Inode.inode_map_rep,
Inode.inode_map_valid,
Inode.inode_valid,
Inode.InodeAllocator.block_allocator_rep in *; cleanup.
match goal with
     | [H: ?x1 ?inum = Some _,
        H1: forall _ _,
        ?x1 _ = Some _ -> _ /\ _|- _] =>
        eapply_fresh H1 in H; eauto; cleanup
end.

match goal with
| [H: Forall _ (Inode.block_numbers _)|- _] =>
  eapply_fresh Forall_forall in H; [| eapply in_seln; eauto]
end;
unfold File.DiskAllocatorParams.num_of_blocks; intuition eauto.
destruct (Compare_dec.lt_dec inum Inode.InodeAllocatorParams.num_of_blocks).
{
  match goal with
| [H: Inode.InodeAllocator.valid_bits
_ _ (value_to_bits
   (?s1
      Inode.InodeAllocatorParams.bitmap_addr))
?s1 |- _] =>
eapply Inode.InodeAllocator.valid_bits_extract with (n:= inum) in H; eauto
end.
all: try solve [pose proof Inode.InodeAllocatorParams.num_of_blocks_in_bounds;
try rewrite value_to_bits_length;
unfold Inode.InodeAllocatorParams.num_of_blocks in *; try lia].
cleanup; split_ors; cleanup; try congruence.
- rewrite H5, H13 in H2; simpl in *; congruence.
- unfold File.file_map_rep, File.file_rep in *; cleanup.
eapply_fresh a0 in H2; eauto; cleanup.

unfold File.DiskAllocator.block_allocator_rep in *.
cleanup.
rewrite H5, H13 in H2; simpl in *; cleanup.

destruct_fresh (nth_error (Inode.block_numbers (Inode.decode_inode (seln x2 inum value0))) off).
eapply_fresh H15 in D; cleanup.
eapply nth_error_nth with (d:= 0) in D; rewrite <- D in *.

eapply File.DiskAllocator.valid_bits_extract with (n:= (nth off
(Inode.block_numbers
   (Inode.decode_inode (seln x2 inum value0)))
0)) in v.
cleanup; split_ors; cleanup; try congruence.
erewrite nth_error_nth'; eauto.
erewrite <- nth_seln_eq, <- H17; eauto.
repeat rewrite nth_seln_eq; eauto.

rewrite value_to_bits_length.
pose proof File.DiskAllocatorParams.num_of_blocks_in_bounds.
eapply PeanoNat.Nat.lt_le_trans; eauto.

rewrite e0.
rewrite <- nth_seln_eq.
unfold File.DiskAllocatorParams.num_of_blocks in *;
pose proof File.DiskAllocatorParams.num_of_blocks_in_bounds.
eapply PeanoNat.Nat.lt_le_trans; eauto.

rewrite e0, value_to_bits_length.
apply File.DiskAllocatorParams.num_of_blocks_in_bounds.

apply nth_error_None in D; lia.
}
{
  unfold Inode.inode_rep, Inode.inode_map_rep,
    Inode.inode_map_valid,
    Inode.inode_valid,
    Inode.InodeAllocator.block_allocator_rep in *; cleanup.

    rewrite H5, H10 in *;
    simpl in *; try lia; try congruence.
}
Qed.


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

From PromisingLib Require Import Axioms.
From PromisingLib Require Import Basic.
From PromisingLib Require Import Loc.
From PromisingLib Require Import Language.
Require Import Sequential.

From PromisingLib Require Import Event.

Section NOMIX.
  Variable loc_na: Loc.t -> Prop.
  Variable loc_at: Loc.t -> Prop.

  Definition _nomix
             (nomix: forall (lang: language) (st: lang.(Language.state)), Prop)
             (lang: language) (st: lang.(Language.state)): Prop :=
    forall st1 e
           (STEP: lang.(Language.step) e st st1),
      (<<NA: forall l c (NA: is_atomic_event e = false) (ACC: is_accessing e = Some (l, c)), loc_na l>>) /\
        (<<AT: forall l c (AT: is_atomic_event e = true) (ACC: is_accessing e = Some (l, c)), loc_at l>>) /\
        (<<CONT: nomix lang st1>>)
  .

  Definition nomix := paco2 _nomix bot2.
  Arguments nomix: clear implicits.

  Lemma nomix_mon: monotone2 _nomix.
  Proof.
    ii. exploit IN; eauto. i. des. splits.
    { i. hexploit NA; eauto. }
    { i. hexploit AT; eauto. }
    { auto. }
  Qed.
  #[local] Hint Resolve nomix_mon: paco.
End NOMIX.

#[export] Hint Resolve nomix_mon: paco.
#[export] Hint Resolve cpn2_wcompat: paco.


Require Import Kami.Syntax Kami.Compiler.Compiler.
Require Import Kami.Notations.

Section Simple.

  Variable ty : Kind -> Type.
  Variable regMapTy : Type.

  Inductive RmeSimple :=
  | VarRME (v : regMapTy) : RmeSimple
  | UpdRegRME (r : string)(pred : Bool @# ty)(k : FullKind)(val : Expr ty k)(regMap : RmeSimple) : RmeSimple
  | WriteRME (idxNum num : nat) (writePort dataArray : string) (idx  : Bit (Nat.log2_up idxNum) @# ty) (Data : Kind)
             (val : Array num Data @# ty)
             (mask : option (Array num Bool @# ty)) (pred : Bool @# ty) (writeMap readMap : RmeSimple)
             (arr : Array idxNum Data @# ty) : RmeSimple
  | ReadReqRME (idxNum num : nat) (readReq readReg dataArray : string) (idx : Bit (Nat.log2_up idxNum) @# ty) (Data : Kind)
               (isAddr : bool) (pred : Bool @# ty) (writeMap readMap : RmeSimple)
               (arr : Array idxNum Data @# ty) : RmeSimple
  | ReadRespRME (idxNum num : nat) (readResp readReg dataArray writePort : string) (isWriteMask: bool) (Data : Kind)
               (isAddr : bool) (writeMap readMap : RmeSimple) : RmeSimple
  | AsyncReadRME (idxNum num : nat) (readPort dataArray writePort : string) (isWriteMask: bool)
                 (idx : Bit (Nat.log2_up idxNum) @# ty) (pred : Bool @# ty)
                 (k : Kind)(writeMap readMap : RmeSimple) : RmeSimple
  | CompactRME (regMap: RmeSimple): RmeSimple.

  Fixpoint RmeSimple_of_RME(x : RegMapExpr ty regMapTy) : RmeSimple :=
    match x with
    | VarRegMap v => VarRME v
    | UpdRegMap r pred k val regMap => UpdRegRME r pred val (RmeSimple_of_RME regMap)
    | CompactRegMap x' => CompactRME (RmeSimple_of_RME x')
    end.

  Inductive CompActionSimple : Kind -> Type :=
  | CompCall_simple (f : string)(argRetK : Kind * Kind)(pred : Bool @# ty)(arg : fst argRetK @# ty)
                    lret (cont : fullType ty (SyntaxKind (snd argRetK)) -> CompActionSimple lret) : CompActionSimple lret
  | CompLetExpr_simple k (e : Expr ty k) lret (cont : fullType ty k -> CompActionSimple lret) : CompActionSimple lret
  | CompNondet_simple k lret (cont : fullType ty k -> CompActionSimple lret) : CompActionSimple lret
  | CompSys_simple (pred: Bool @# ty) (ls: list (SysT ty)) lret (cont: CompActionSimple lret): CompActionSimple lret
  | CompReadReg_simple (r: string) (k: FullKind) (readMap : RmeSimple) lret
                       (cont: fullType ty k -> CompActionSimple lret): CompActionSimple lret
  | CompRet_simple lret (e: lret @# ty) (newMap: RmeSimple) : CompActionSimple lret
  | CompLetFull_simple k (a: CompActionSimple k) lret (cont: fullType ty (SyntaxKind k) ->
                                                      regMapTy -> CompActionSimple lret): CompActionSimple lret
  | CompWrite_simple (idxNum : nat) (Data : Kind) (writePort dataArray : string) (readMap : RmeSimple) lret
                     (cont : ty (Array idxNum Data) -> CompActionSimple lret) : CompActionSimple lret
  | CompSyncReadReq_simple (idxNum num : nat) (Data : Kind) (readReq readReg dataArray : string) (isAddr : bool)
                           (readMap : RmeSimple) lret
                           (cont : ty (Array idxNum Data) -> CompActionSimple lret) : CompActionSimple lret
  | CompSyncReadRes_simple (idxNum num : nat) (readResp readReg dataArray writePort : string) (isWriteMask: bool) (Data : Kind) (isAddr : bool)
                           (readMap : RmeSimple) lret
                           (cont : fullType ty (SyntaxKind (Array num Data)) -> CompActionSimple lret) : CompActionSimple lret
  | CompAsyncRead_simple (idxNum num : nat) (readPort dataArray writePort : string) (isWriteMask: bool) (idx : Bit (Nat.log2_up idxNum) @# ty)
                         (pred : Bool @# ty)
                         (k : Kind)
                         (readMap : RmeSimple) lret
                         (cont : fullType ty (SyntaxKind (Array num k)) -> CompActionSimple lret) : CompActionSimple lret.

  Fixpoint CompActionSimple_of_CA{k}(a : CompActionT ty regMapTy k) : CompActionSimple k :=
    match a with
    | CompCall f argRetK pred arg lret cont => CompCall_simple f argRetK pred arg (fun x => CompActionSimple_of_CA (cont x))
    | CompLetExpr k e lret cont => CompLetExpr_simple e (fun x => CompActionSimple_of_CA (cont x))
    | CompNondet k lret cont => CompNondet_simple k (fun x => CompActionSimple_of_CA (cont x))
    | CompSys pred ls lret cont => CompSys_simple pred ls (CompActionSimple_of_CA cont)
    | CompRead r k readMap lret cont => CompReadReg_simple r k (RmeSimple_of_RME readMap)
                                                           (fun x => CompActionSimple_of_CA (cont x))
    | CompRet lret e newMap => CompRet_simple e (RmeSimple_of_RME newMap)
    | CompLetFull k a lret cont => CompLetFull_simple (CompActionSimple_of_CA a) (fun x y => CompActionSimple_of_CA (cont x y))
    | CompWrite idxNum num writePort dataArray idx Data val mask pred writeMap readMap lret cont =>
      @CompWrite_simple idxNum Data writePort dataArray (RmeSimple_of_RME readMap) lret
                        (fun arr =>
                           CompLetFull_simple (CompRet_simple (($$ WO)%kami_expr : Void @# ty)
                                                              (@WriteRME idxNum num writePort dataArray idx Data val mask pred
                                                                         (RmeSimple_of_RME writeMap)
                                                                         (RmeSimple_of_RME readMap) (#arr)%kami_expr))
                                              (fun _ y => CompActionSimple_of_CA (cont y)))
    | CompSyncReadReq idxNum num readReq readReg dataArray idx Data isAddr pred writeMap readMap lret cont =>
      @CompSyncReadReq_simple idxNum num Data readReq readReg dataArray isAddr (RmeSimple_of_RME readMap) lret
                              (fun x => CompLetFull_simple (CompRet_simple (($$ WO)%kami_expr : Void @# ty)
                                                                           (@ReadReqRME idxNum num readReq readReg dataArray
                                                                                idx Data isAddr pred
                                                                                (RmeSimple_of_RME writeMap)
                                                                                (RmeSimple_of_RME readMap)
                                                                                (#x)%kami_expr))
                                                           (fun _ y => CompActionSimple_of_CA (cont y)))
    | CompSyncReadRes idxNum num readResp readReg dataArray writePort isWriteMask Data isAddr writeMap readMap lret cont =>
      CompSyncReadRes_simple idxNum readResp readReg dataArray writePort isWriteMask isAddr (RmeSimple_of_RME readMap)
                             (fun x => CompLetFull_simple
                                         (CompRet_simple (($$WO)%kami_expr)
                                                         (@ReadRespRME idxNum num readResp readReg dataArray writePort
                                                                       isWriteMask Data isAddr (RmeSimple_of_RME writeMap)
                                                                       (RmeSimple_of_RME readMap)))
                                         (fun _ y => CompActionSimple_of_CA (cont x y)))
    | CompAsyncRead idxNum num readPort dataArray writePort isWriteMask idx pred k writeMap readMap lret cont =>
      CompAsyncRead_simple idxNum readPort dataArray writePort isWriteMask idx pred (RmeSimple_of_RME readMap)
                           (fun x =>
                              CompLetFull_simple (CompRet_simple (($$ WO)%kami_expr : Void @# ty)
                                                     (AsyncReadRME idxNum num readPort dataArray
                                                                   writePort isWriteMask idx pred
                                                                   k (RmeSimple_of_RME writeMap)
                                                                   (RmeSimple_of_RME readMap)))
                              (fun _ y => CompActionSimple_of_CA (cont x y)))
    end.

  Definition CAS_RulesRf(readMap : regMapTy) (rules : list RuleT) (lrf : list RegFileBase) :=
    CompActionSimple_of_CA (compileRulesRf ty readMap rules lrf).

End Simple.