Require Import Framework File FileDiskLayer FileDiskNoninterference FileDiskRefinement.
Require Import FunctionalExtensionality Lia Language SameRetType TSCommon InodeTS.

Lemma inode_allocations_are_same_2:
forall u im1 im2 fm1 fm2 bm1 bm2 s1 s2 inum ex,
Inode.inode_rep im1 s1 ->
Inode.inode_rep im2 s2 ->
file_map_rep fm1 im1 bm1 ->
file_map_rep fm2 im2 bm2 ->
same_for_user_except u ex fm1 fm2 ->
inum < Inode.InodeAllocatorParams.num_of_blocks ->
nth_error
(value_to_bits
  (s1 Inode.InodeAllocatorParams.bitmap_addr))
inum =
nth_error
  (value_to_bits (s2 Inode.InodeAllocatorParams.bitmap_addr)) inum.
Proof.
  unfold refines, files_rep,
  files_inner_rep, same_for_user_except; intros.
  cleanup; repeat cleanup_pairs.
  destruct_fresh (im1 inum).
  {
    eapply_fresh FileInnerSpecs.inode_exists_then_file_exists in D; eauto.
    cleanup.
    destruct_fresh (fm1 inum).
    {
      destruct_fresh (im2 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 H15.
      cleanup; split_ors; cleanup; try congruence.
      rewrite H13, H7 in D; simpl in *; congruence.
      rewrite nth_seln_eq in H.
      repeat erewrite nth_error_nth'.

      eapply Inode.InodeAllocator.valid_bits_extract with (n:= inum) in H10.
      cleanup; split_ors; cleanup; try congruence.
      rewrite H8, H18 in D1; simpl in *; congruence.
      rewrite nth_seln_eq in H15, H0.
      rewrite H0, H15; 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 H3; edestruct H2; exfalso.
      apply H12; eauto.
      eapply H7; eauto; congruence.
    }
    {
      cleanup.
    }
  }
  {
    eapply_fresh FileInnerSpecs.inode_missing_then_file_missing in D; eauto.
    cleanup.
    destruct_fresh (fm1 inum).
    {
      congruence.
    }
    destruct_fresh (im2 inum).
    {
      unfold file_map_rep in *; cleanup.
      edestruct H1; edestruct H3; exfalso.
      eapply H9; eauto.
      eapply H12; eauto.
      eapply H2; 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 H14.
      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 H9.
      cleanup; split_ors; cleanup; try congruence.
      rewrite nth_seln_eq in H17.
      rewrite H0, H17; eauto.
      rewrite H7, H18 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 H12, H14 in D; simpl in *; congruence.
    }
  }
Qed.

Lemma TS_free_all_blocks:
forall bnl1 bnl2 o s1 s2 ret1 u dm1 dm2,
DiskAllocator.block_allocator_rep dm1 (fst (snd s1)) ->
DiskAllocator.block_allocator_rep dm2 (fst (snd s2)) ->
exec (TransactionalDiskLayer.TDLang FSParameters.data_length) u o s1 (free_all_blocks bnl1) ret1 ->
length bnl1 = length bnl2 ->
Forall (fun a => a < DiskAllocatorParams.num_of_blocks) bnl1 ->
Forall (fun a => a < DiskAllocatorParams.num_of_blocks) bnl2 ->
Forall (fun a => nth_error (value_to_bits (fst (snd s1) DiskAllocatorParams.bitmap_addr)) a = Some true) bnl1 ->
Forall (fun a => nth_error (value_to_bits (fst (snd s2) DiskAllocatorParams.bitmap_addr)) a = Some true) bnl2 ->
NoDup bnl1 ->
NoDup bnl2 ->
exists ret2,
exec (TransactionalDiskLayer.TDLang FSParameters.data_length) u o s2 (free_all_blocks bnl2) ret2 /\
(extract_ret ret1 = None <-> extract_ret ret2 = None).
Proof.
  induction bnl1; simpl; intros; eauto.
  {
    invert_exec;
    destruct bnl2; simpl in *; try lia.
    eexists; split.
    repeat econstructor.
    simpl; intuition.

    eexists; split.
    repeat econstructor.
    simpl; intuition.
  }
  {
   invert_exec;
   destruct bnl2; simpl in *; try lia.
   {
   eapply_fresh TS_free in H1.
   cleanup.
   destruct x2; simpl in *; try solve [intuition congruence].
   eapply_fresh DiskAllocator.free_finished_oracle_eq in H1; eauto.
   destruct o; simpl in *; try solve [intuition congruence].
   eapply_fresh DiskAllocator.free_finished in H1; eauto.
   cleanup; split_ors; cleanup.
   eapply_fresh DiskAllocator.free_finished in H10; only 2: apply H0; eauto.
   cleanup; split_ors; cleanup.

   eapply IHbnl1 in H9.
   cleanup.
   destruct x2; simpl in *; try solve [intuition congruence].
  exists (Finished s3 o); split.
  econstructor.
  eauto.
  simpl; eauto.
  simpl; intuition congruence.
  eauto.
  eauto.
  eauto.
  inversion H3; eauto.
  inversion H4; eauto.
  {
    inversion H3; eauto.
    inversion H5; eauto; cleanup.
    inversion H7; subst.
    repeat cleanup_pairs.
    unfold DiskAllocator.block_allocator_rep in *; cleanup.
    eapply Forall_forall; intros.
    eapply Forall_forall in H22; eauto.
    eapply DiskAllocator.valid_bits_extract with (n:= x1) in H32.
    cleanup.
    eapply DiskAllocator.valid_bits_extract with (n:= x1) in H20.
    cleanup.
    repeat rewrite nth_seln_eq in *.
    eapply Forall_forall in H26; eauto.
    eapply nth_error_nth with (d:= false) in H26.
    setoid_rewrite H26 in H12.
    setoid_rewrite Mem.delete_ne in H20; eauto.
    repeat split_ors; cleanup; try congruence; eauto.
    erewrite nth_error_nth'.
    setoid_rewrite H20; eauto.
    all: try rewrite value_to_bits_length;
    pose proof DiskAllocatorParams.num_of_blocks_in_bounds;
    unfold DiskAllocatorParams.num_of_blocks in *; try lia.
    all: intros Hx; subst; intuition.
  }
  {
    inversion H4; eauto.
    inversion H6; eauto; cleanup.
    inversion H8; subst.
    repeat cleanup_pairs.
    unfold DiskAllocator.block_allocator_rep in *; cleanup.
    eapply Forall_forall; intros.
    eapply Forall_forall in H22; eauto.
    eapply DiskAllocator.valid_bits_extract with (n:= x1) in H29.
    cleanup.
    eapply DiskAllocator.valid_bits_extract with (n:= x1) in H15.
    cleanup.
    repeat rewrite nth_seln_eq in *.
    eapply Forall_forall in H26; eauto.
    eapply nth_error_nth with (d:= false) in H26.
    setoid_rewrite H26 in H12.
    setoid_rewrite Mem.delete_ne in H15; eauto.
    repeat split_ors; cleanup; try congruence; eauto.
    erewrite nth_error_nth'.
    setoid_rewrite H15; eauto.
    all: try rewrite value_to_bits_length;
    pose proof DiskAllocatorParams.num_of_blocks_in_bounds;
    unfold DiskAllocatorParams.num_of_blocks in *; try lia.
    all: intros Hx; subst; intuition.
  }
  inversion H7; eauto.
  inversion H8; eauto.
  inversion H3; inversion H4; subst.
  intuition.
  inversion H5; inversion H6;
  subst; eauto.
  setoid_rewrite H16; eauto.
   }
   {
     invert_step.
    eapply_fresh TS_free in H1.
    cleanup.
    destruct x0; simpl in *; try solve [intuition congruence].
    eapply_fresh DiskAllocator.free_finished_oracle_eq in H1; eauto.
    destruct o; simpl in *; try solve [intuition congruence].
   exists (Finished s0 None); split.
   econstructor.
   eauto.
   simpl; eauto.
   repeat econstructor.
   simpl; intuition congruence.
   inversion H3; inversion H4; subst.
  intuition.
  inversion H5; inversion H6;
  subst; eauto.
  setoid_rewrite H15; eauto.
   }
   {
     repeat invert_step_crash.
     {
        eapply_fresh TS_free in H1.
        cleanup.
        destruct x; simpl in *; try solve [intuition congruence].

        exists (Crashed s0); split.
        eapply ExecBindCrash.
        eauto.
        simpl; intuition congruence.
        inversion H3; inversion H4; subst.
        intuition.
        inversion H5; inversion H6;
        subst; eauto.
        setoid_rewrite H15; eauto.
      }
      {
        eapply_fresh TS_free in H9.
        logic_clean.
        destruct x3; simpl in *; try solve [intuition congruence].
        eapply_fresh DiskAllocator.free_finished_oracle_eq in H9; eauto.
      eapply_fresh DiskAllocator.free_finished in H1; eauto.
      eapply_fresh DiskAllocator.free_finished in H9; only 2: apply H; eauto.
      cleanup; repeat split_ors; cleanup; simpl in *; try solve [intuition congruence].
      {
        eapply IHbnl1 in H10.
   cleanup.
   destruct x0; simpl in *; try solve [intuition congruence].
  exists (Crashed s3); split.
  econstructor.
  eauto.
  simpl; eauto.
  simpl; intuition congruence.
  eauto.
  eauto.
  eauto.
  inversion H3; eauto.
  inversion H4; eauto.
  {
    inversion H3; eauto.
    inversion H5; eauto; cleanup.
    inversion H7; subst.
    repeat cleanup_pairs.
    unfold DiskAllocator.block_allocator_rep in *; cleanup.
    eapply Forall_forall; intros.
    eapply Forall_forall in H22; eauto.
    eapply DiskAllocator.valid_bits_extract with (n:= x) in H32.
    cleanup.
    eapply DiskAllocator.valid_bits_extract with (n:= x) in H15.
    cleanup.
    repeat rewrite nth_seln_eq in *.
    eapply Forall_forall in H26; eauto.
    eapply nth_error_nth with (d:= false) in H26.
    setoid_rewrite H26 in H12.
    setoid_rewrite Mem.delete_ne in H15; eauto.
    repeat split_ors; cleanup; try congruence; eauto.
    erewrite nth_error_nth'.
    setoid_rewrite H15; eauto.
    all: try rewrite value_to_bits_length;
    pose proof DiskAllocatorParams.num_of_blocks_in_bounds;
    unfold DiskAllocatorParams.num_of_blocks in *; try lia.
    all: intros Hx; subst; intuition.
  }
  {
    inversion H4; eauto.
    inversion H6; eauto; cleanup.
    inversion H8; subst.
    repeat cleanup_pairs.
    unfold DiskAllocator.block_allocator_rep in *; cleanup.
    eapply Forall_forall; intros.
    eapply Forall_forall in H22; eauto.
    eapply DiskAllocator.valid_bits_extract with (n:= x) in H29.
    cleanup.
    eapply DiskAllocator.valid_bits_extract with (n:= x) in H20.
    cleanup.
    repeat rewrite nth_seln_eq in *.
    eapply Forall_forall in H26; eauto.
    eapply nth_error_nth with (d:= false) in H26.
    setoid_rewrite H26 in H12.
    setoid_rewrite Mem.delete_ne in H20; eauto.
    repeat split_ors; cleanup; try congruence; eauto.
    erewrite nth_error_nth'.
    setoid_rewrite H20; eauto.
    all: try rewrite value_to_bits_length;
    pose proof DiskAllocatorParams.num_of_blocks_in_bounds;
    unfold DiskAllocatorParams.num_of_blocks in *; try lia.
    all: intros Hx; subst; intuition.
  }
  inversion H7; eauto.
  inversion H8; eauto.
  }
  {
    invert_step.
   exists (Crashed s0); split.
   econstructor.
   eauto.
   simpl; eauto.

   repeat econstructor.
   simpl; intuition congruence.
  }
  inversion H3; inversion H4; subst.
  intuition.
  inversion H5; inversion H6;
  subst; eauto.
  setoid_rewrite H16; eauto.
  }
  }
}
Unshelve.
all: eauto.
Qed.

Lemma TS_delete_inner:
forall o ex fm1 fm2 s1 s2 inum ret1 u u',
same_for_user_except u' ex fm1 fm2 ->
files_inner_rep fm1 (fst (snd s1)) ->
files_inner_rep fm2 (fst (snd s2)) ->
exec (TransactionalDiskLayer.TDLang FSParameters.data_length) u o s1 (delete_inner inum) ret1 ->
exists ret2,
exec (TransactionalDiskLayer.TDLang FSParameters.data_length) u o s2 (delete_inner inum) ret2 /\
(extract_ret ret1 = None <-> extract_ret ret2 = None).
Proof.
Transparent delete_inner.
unfold delete_inner; intros.
invert_step.
{
  eapply_fresh TS_get_all_block_numbers in H2; eauto.
  cleanup.
  destruct x0; simpl in *; try solve [intuition congruence].
  eapply_fresh Inode.get_all_block_numbers_finished_oracle_eq in H2; eauto.
  destruct o; simpl in *; try solve [intuition congruence].
  unfold files_inner_rep in *; cleanup.
  eapply_fresh Inode.get_all_block_numbers_finished in H2; eauto.
  eapply_fresh Inode.get_all_block_numbers_finished in H5; eauto.
  cleanup; repeat split_ors; cleanup.

  eapply_fresh TS_free_all_blocks in H3.
  cleanup.
  destruct x10; simpl in *; try solve [intuition congruence].
  eapply_fresh free_all_blocks_finished_oracle_eq in H3.
  2: apply H7.
  destruct o; simpl in *; try solve [intuition congruence].
  eapply_fresh FileInnerSpecs.free_all_blocks_finished in H3; eauto.
  eapply_fresh FileInnerSpecs.free_all_blocks_finished in H7.
  cleanup; repeat split_ors; cleanup.

  eapply_fresh TS_free_inode in H4.
  cleanup.
  destruct x12; simpl in *; try solve [intuition congruence].
  eapply_fresh Inode.free_finished_oracle_eq in H4; eauto.

  exists (Finished s4 o); split.
  econstructor; eauto.
  simpl; econstructor; eauto.
  simpl; eauto.
  simpl; intuition congruence.
  intuition.
  all: eauto.
  all: try solve[
  eapply DiskAllocator.block_allocator_rep_inbounds_eq;
  eauto; intros; repeat solve_bounds].
  {

    eapply inode_allocations_are_same_2.
    5: eauto.
    all: eauto.
    {
      repeat cleanup_pairs;
      repeat unify_invariants.
      unfold Inode.inode_rep in *; cleanup.
      eexists; split.
      eapply Inode.InodeAllocator.block_allocator_rep_inbounds_eq.
      apply b0.
      intros; repeat solve_bounds.
      eauto.
    }
    {
      repeat cleanup_pairs;
      repeat unify_invariants.
      unfold Inode.inode_rep in *; cleanup.
      eexists; split.
      eapply Inode.InodeAllocator.block_allocator_rep_inbounds_eq.
      apply b.
      intros; repeat solve_bounds.
      eauto.
    }
    {
      repeat cleanup_pairs;
      repeat unify_invariants.
      unfold Inode.inode_rep,
      Inode.InodeAllocator.block_allocator_rep,
      Inode.inode_map_rep in *; cleanup.
      destruct (Compare_dec.lt_dec inum Inode.InodeAllocatorParams.num_of_blocks); eauto.
      rewrite e5, e8 in H23; simpl in *; try lia; try congruence.
    }
  }
  {
    eapply DiskAllocator.block_allocator_rep_inbounds_eq.
    2: intros; repeat solve_bounds.
    eauto.
  }
  {
    eapply SameRetType.all_block_numbers_in_bound.
    2: eauto.
    all: eauto.
  }
  {
    eapply SameRetType.all_block_numbers_in_bound.
    4: eauto.
    all: eauto.
    eapply File.DiskAllocator.block_allocator_rep_inbounds_eq; eauto.
    intros; FileInnerSpecs.solve_bounds.
  }
    {
    eapply DiskAllocator.block_allocator_rep_inbounds_eq.
    2: intros; repeat solve_bounds.
    eauto.
    }
    {
      repeat cleanup_pairs;
      repeat unify_invariants.
      eapply_fresh FileInnerSpecs.inode_exists_then_file_exists in H22; eauto.
      eapply_fresh FileInnerSpecs.inode_exists_then_file_exists in H23; eauto.
      cleanup.
      unfold same_for_user_except in *; cleanup.
      eapply_fresh H17 in H7; eauto; cleanup.
      unfold file_map_rep, file_rep in *; cleanup.
      eapply_fresh H25 in H23; eauto; cleanup.
      eapply_fresh H24 in H22; eauto; cleanup.
      eauto.
    }
    {
    eapply SameRetType.all_block_numbers_in_bound.
    4: eauto.
    all: eauto.
    eapply File.DiskAllocator.block_allocator_rep_inbounds_eq; eauto.
    intros; FileInnerSpecs.solve_bounds.
  }
  {
    eapply SameRetType.all_block_numbers_in_bound.
    4: eauto.
    all: eauto.
    eapply File.DiskAllocator.block_allocator_rep_inbounds_eq; eauto.
    intros; FileInnerSpecs.solve_bounds.
  }
    {
      repeat cleanup_pairs;
      repeat unify_invariants.
      eapply_fresh FileInnerSpecs.inode_exists_then_file_exists in H23; eauto.
      cleanup.
      unfold file_map_rep, file_rep in *; cleanup.
      eapply_fresh H16 in H23; eauto; cleanup.
      eapply Forall_forall; eauto; intros.
      eapply In_nth in H24; cleanup.
      eapply nth_error_Some in H24.
      destruct_fresh (nth_error (Inode.block_numbers x9) x11); try congruence.
      eapply_fresh H21 in D; cleanup.
      unfold DiskAllocator.block_allocator_rep in *; cleanup.
      eapply nth_error_nth in D.
      rewrite H25 in D; subst.
      eapply DiskAllocator.valid_bits_extract with (n:= a) in v0; eauto; cleanup.
      split_ors; cleanup.
      rewrite nth_seln_eq in H11; erewrite nth_error_nth'; eauto.
      rewrite H19, H11; eauto.
      all: try rewrite value_to_bits_length;
      unfold DiskAllocatorParams.num_of_blocks in *;
      pose proof DiskAllocatorParams.num_of_blocks_in_bounds; try lia.
      destruct (Compare_dec.lt_dec a FSParameters.file_blocks_count); try lia.
      rewrite e4 in H27; try congruence; try lia.
      destruct (Compare_dec.lt_dec a FSParameters.file_blocks_count); try lia.
      rewrite e4 in H27; try congruence; try lia.
      setoid_rewrite D in H24; intuition.
    }
    {
      repeat cleanup_pairs;
      repeat unify_invariants.
      eapply_fresh FileInnerSpecs.inode_exists_then_file_exists in H22; eauto.
      cleanup.
      unfold file_map_rep, file_rep in *; cleanup.
      eapply_fresh H15 in H22; eauto; cleanup.
      eapply Forall_forall; eauto; intros.
      eapply In_nth in H24; cleanup.
      eapply nth_error_Some in H24.
      destruct_fresh (nth_error (Inode.block_numbers x8) x11); try congruence.
      eapply_fresh H21 in D; cleanup.
      unfold DiskAllocator.block_allocator_rep in *; cleanup.
      eapply nth_error_nth in D.
      rewrite H25 in D; subst.
      eapply DiskAllocator.valid_bits_extract with (n:= a) in v; eauto; cleanup.
      split_ors; cleanup.
      rewrite nth_seln_eq in H11; erewrite nth_error_nth'; eauto.
      rewrite H14, H11; eauto.
      all: try rewrite value_to_bits_length;
      unfold DiskAllocatorParams.num_of_blocks in *;
      pose proof DiskAllocatorParams.num_of_blocks_in_bounds; try lia.
      destruct (Compare_dec.lt_dec a FSParameters.file_blocks_count); try lia.
      rewrite e1 in H27; try congruence; try lia.
      destruct (Compare_dec.lt_dec a FSParameters.file_blocks_count); try lia.
      rewrite e1 in H27; try congruence; try lia.
      setoid_rewrite D in H24; intuition.
    }
    {
      repeat cleanup_pairs;
      repeat unify_invariants.
      unfold Inode.inode_rep, file_map_rep, file_rep, Inode.inode_map_rep in *; cleanup.
      unfold Inode.inode_map_valid, Inode.inode_valid in *; cleanup.
      eapply H24 in H23; cleanup; eauto.
    }
    {
      repeat cleanup_pairs;
      repeat unify_invariants.
      unfold Inode.inode_rep, file_map_rep, file_rep, Inode.inode_map_rep in *; cleanup.
      unfold Inode.inode_map_valid, Inode.inode_valid in *; cleanup.
      eapply H16 in H22; cleanup; eauto.
    }
}
{
  eapply_fresh TS_get_all_block_numbers in H2; eauto.
  cleanup.
  destruct x0; simpl in *; try solve [intuition congruence].
  eapply_fresh Inode.get_all_block_numbers_finished_oracle_eq in H2; eauto.
  destruct o; simpl in *; try solve [intuition congruence].
  unfold files_inner_rep in *; cleanup.
  eapply_fresh Inode.get_all_block_numbers_finished in H2; eauto.
  eapply_fresh Inode.get_all_block_numbers_finished in H4; eauto.
  cleanup; repeat split_ors; cleanup.

  eapply_fresh TS_free_all_blocks in H3.
  cleanup.
  destruct x8; simpl in *; try solve [intuition congruence].
  eapply_fresh free_all_blocks_finished_oracle_eq in H3.
  2: apply H6.
  destruct o; simpl in *; try solve [intuition congruence].
  eapply_fresh FileInnerSpecs.free_all_blocks_finished in H3; eauto.
  eapply_fresh FileInnerSpecs.free_all_blocks_finished in H6.
  cleanup; repeat split_ors; cleanup.

  exists (Finished s3 None); split.
  econstructor; eauto.
  simpl; econstructor; eauto.
  simpl; eauto.
  repeat econstructor.
  simpl; intuition congruence.
  all: eauto.
  all: try solve[
  eapply DiskAllocator.block_allocator_rep_inbounds_eq;
  eauto; intros; repeat solve_bounds].
  {
    eapply DiskAllocator.block_allocator_rep_inbounds_eq.
    2: intros; repeat solve_bounds.
    eauto.
  }
  {
    eapply SameRetType.all_block_numbers_in_bound.
    4: eauto.
    all: eauto.
    eapply File.DiskAllocator.block_allocator_rep_inbounds_eq; eauto.
    intros; FileInnerSpecs.solve_bounds.
  }
  {
    eapply SameRetType.all_block_numbers_in_bound.
    4: eauto.
    all: eauto.
    eapply File.DiskAllocator.block_allocator_rep_inbounds_eq; eauto.
    intros; FileInnerSpecs.solve_bounds.
  }
    {
    eapply DiskAllocator.block_allocator_rep_inbounds_eq.
    2: intros; repeat solve_bounds.
    eauto.
    }
    {
      repeat cleanup_pairs;
      repeat unify_invariants.
      eapply_fresh FileInnerSpecs.inode_exists_then_file_exists in H22; eauto.
      eapply_fresh FileInnerSpecs.inode_exists_then_file_exists in H21; eauto.
      cleanup.
      unfold same_for_user_except in *; cleanup.
      eapply_fresh H16 in H6; eauto; cleanup.
      unfold file_map_rep, file_rep in *; cleanup.
      eapply_fresh H24 in H22; eauto; cleanup.
      eapply_fresh H23 in H21; eauto; cleanup.
      eauto.
    }

    {
      repeat cleanup_pairs;
      repeat unify_invariants.
      unfold Inode.inode_rep, file_map_rep, file_rep, Inode.inode_map_rep in *; cleanup.
      unfold Inode.inode_map_valid, Inode.inode_valid in *; cleanup.
      eapply H23 in H22; cleanup; eauto.
    }
    {
      repeat cleanup_pairs;
      repeat unify_invariants.
      unfold Inode.inode_rep, file_map_rep, file_rep, Inode.inode_map_rep in *; cleanup.
      unfold Inode.inode_map_valid, Inode.inode_valid in *; cleanup.
      eapply H15 in H21; cleanup; eauto.
  }
    {
      repeat cleanup_pairs;
      repeat unify_invariants.
      eapply_fresh FileInnerSpecs.inode_exists_then_file_exists in H22; eauto.
      cleanup.
      unfold file_map_rep, file_rep in *; cleanup.
      eapply_fresh H15 in H22; eauto; cleanup.
      eapply Forall_forall; eauto; intros.
      eapply In_nth in H23; cleanup.
      eapply nth_error_Some in H23.
      destruct_fresh (nth_error (Inode.block_numbers x7) x9); try congruence.
      eapply_fresh H20 in D; cleanup.
      unfold DiskAllocator.block_allocator_rep in *; cleanup.
      eapply nth_error_nth in D.
      rewrite H24 in D; subst.
      eapply DiskAllocator.valid_bits_extract with (n:= a) in v0; eauto; cleanup.
      split_ors; cleanup.
      rewrite nth_seln_eq in H10; erewrite nth_error_nth'; eauto.
      rewrite H18, H10; eauto.
      all: try rewrite value_to_bits_length;
      unfold DiskAllocatorParams.num_of_blocks in *;
      pose proof DiskAllocatorParams.num_of_blocks_in_bounds; try lia.
      destruct (Compare_dec.lt_dec a FSParameters.file_blocks_count); try lia.
      rewrite e4 in H26; try congruence; try lia.
      destruct (Compare_dec.lt_dec a FSParameters.file_blocks_count); try lia.
      rewrite e4 in H26; try congruence; try lia.
      setoid_rewrite D in H23; intuition.
    }
    {
      repeat cleanup_pairs;
      repeat unify_invariants.
      eapply_fresh FileInnerSpecs.inode_exists_then_file_exists in H21; eauto.
      cleanup.
      unfold file_map_rep, file_rep in *; cleanup.
      eapply_fresh H14 in H21; eauto; cleanup.
      eapply Forall_forall; eauto; intros.
      eapply In_nth in H23; cleanup.
      eapply nth_error_Some in H23.
      destruct_fresh (nth_error (Inode.block_numbers x6) x9); try congruence.
      eapply_fresh H20 in D; cleanup.
      unfold DiskAllocator.block_allocator_rep in *; cleanup.
      eapply nth_error_nth in D.
      rewrite H24 in D; subst.
      eapply DiskAllocator.valid_bits_extract with (n:= a) in v; eauto; cleanup.
      split_ors; cleanup.
      rewrite nth_seln_eq in H10; erewrite nth_error_nth'; eauto.
      rewrite H13, H10; eauto.
      all: try rewrite value_to_bits_length;
      unfold DiskAllocatorParams.num_of_blocks in *;
      pose proof DiskAllocatorParams.num_of_blocks_in_bounds; try lia.
      destruct (Compare_dec.lt_dec a FSParameters.file_blocks_count); try lia.
      rewrite e1 in H26; try congruence; try lia.
      destruct (Compare_dec.lt_dec a FSParameters.file_blocks_count); try lia.
      rewrite e1 in H26; try congruence; try lia.
      setoid_rewrite D in H23; intuition.
    }
    {
      repeat cleanup_pairs;
      repeat unify_invariants.
      unfold Inode.inode_rep, file_map_rep, file_rep, Inode.inode_map_rep in *; cleanup.
      unfold Inode.inode_map_valid, Inode.inode_valid in *; cleanup.
      eapply H23 in H22; cleanup; eauto.
    }
    {
      repeat cleanup_pairs;
      repeat unify_invariants.
      unfold Inode.inode_rep, file_map_rep, file_rep, Inode.inode_map_rep in *; cleanup.
      unfold Inode.inode_map_valid, Inode.inode_valid in *; cleanup.
      eapply H15 in H21; cleanup; eauto.
    }
}
{
  eapply_fresh TS_get_all_block_numbers in H2; eauto.
  cleanup.
  destruct x0; simpl in *; try solve [intuition congruence].
  eapply_fresh Inode.get_all_block_numbers_finished_oracle_eq in H2; eauto.
  destruct o; simpl in *; try solve [intuition congruence].

  exists (Finished s0 None); split.
  econstructor; eauto.
  simpl; econstructor; eauto.
  simpl; intuition congruence.
}
{
  repeat invert_step_crash.
  {
    eapply_fresh TS_get_all_block_numbers in H2; eauto.
    cleanup.
    destruct x; simpl in *; try solve [intuition congruence].

    exists (Crashed s0); split.
    eapply ExecBindCrash; eauto.
    simpl; intuition congruence.
  }
  {
    eapply_fresh TS_get_all_block_numbers in H3; eauto.
    logic_clean.
    destruct x3; simpl in *; try solve [intuition congruence].
    eapply_fresh Inode.get_all_block_numbers_finished_oracle_eq in H3; eauto.
    unfold files_inner_rep in *; logic_clean.
    eapply_fresh Inode.get_all_block_numbers_finished in H3; eauto.
    eapply_fresh Inode.get_all_block_numbers_finished in H2; eauto.
    cleanup; repeat split_ors; cleanup; try solve [intuition congruence].
    {
      repeat invert_step_crash.
      {
        eapply_fresh TS_free_all_blocks in H4.
        cleanup.
        destruct x8; simpl in *; try solve [intuition congruence].

        exists (Crashed s3); split.
        econstructor; eauto.
        simpl;
        eapply ExecBindCrash; eauto.
        simpl; intuition congruence.

        all: eauto.
        all: try solve[
        eapply DiskAllocator.block_allocator_rep_inbounds_eq;
        eauto; intros; repeat solve_bounds].
        {
    eapply DiskAllocator.block_allocator_rep_inbounds_eq.
    2: intros; repeat solve_bounds.
    eauto.
  }
    {
      repeat cleanup_pairs;
      repeat unify_invariants.
      eapply_fresh FileInnerSpecs.inode_exists_then_file_exists in H22; eauto.
      eapply_fresh FileInnerSpecs.inode_exists_then_file_exists in H17; eauto.
      cleanup.
      unfold same_for_user_except in *; cleanup.
      eapply_fresh H16 in H6; eauto; cleanup.
      unfold file_map_rep, file_rep in *; cleanup.
      eapply_fresh H24 in H22; eauto; cleanup.
      eapply_fresh H23 in H17; eauto; cleanup.
      eauto.
    }

    {
      repeat cleanup_pairs;
      repeat unify_invariants.
      unfold Inode.inode_rep, file_map_rep, file_rep, Inode.inode_map_rep in *; cleanup.
      unfold Inode.inode_map_valid, Inode.inode_valid in *; cleanup.
      eapply H23 in H22; cleanup; eauto.
    }
    {
      repeat cleanup_pairs;
      repeat unify_invariants.
      unfold Inode.inode_rep, file_map_rep, file_rep, Inode.inode_map_rep in *; cleanup.
      unfold Inode.inode_map_valid, Inode.inode_valid in *; cleanup.
      eapply H15 in H17; cleanup; eauto.
  }
    {
      repeat cleanup_pairs;
      repeat unify_invariants.
      eapply_fresh FileInnerSpecs.inode_exists_then_file_exists in H22 ; eauto.
      cleanup.
      unfold file_map_rep, file_rep in *; cleanup.
      eapply_fresh H15 in H22; eauto; cleanup.
      eapply Forall_forall; eauto; intros.
      eapply In_nth in H23; cleanup.
      eapply nth_error_Some in H23.
      destruct_fresh (nth_error (Inode.block_numbers x7) x9); try congruence.
      eapply_fresh H21 in D; cleanup.
      unfold DiskAllocator.block_allocator_rep in *; cleanup.
      eapply nth_error_nth in D.
      rewrite H24 in D; subst.
      eapply DiskAllocator.valid_bits_extract with (n:= a) in v0; eauto; cleanup.
      split_ors; cleanup.
      rewrite nth_seln_eq in H10; erewrite nth_error_nth'; eauto.
      rewrite H19, H10; eauto.
      all: try rewrite value_to_bits_length;
      unfold DiskAllocatorParams.num_of_blocks in *;
      pose proof DiskAllocatorParams.num_of_blocks_in_bounds; try lia.
      destruct (Compare_dec.lt_dec a FSParameters.file_blocks_count); try lia.
      rewrite e4 in H26; try congruence; try lia.
      destruct (Compare_dec.lt_dec a FSParameters.file_blocks_count); try lia.
      rewrite e4 in H26; try congruence; try lia.
      setoid_rewrite D in H23; intuition.
    }
    {
      repeat cleanup_pairs;
      repeat unify_invariants.
      eapply_fresh FileInnerSpecs.inode_exists_then_file_exists in H17; eauto.
      cleanup.
      unfold file_map_rep, file_rep in *; cleanup.
      eapply_fresh H12 in H17; eauto; cleanup.
      eapply Forall_forall; eauto; intros.
      eapply In_nth in H23; cleanup.
      eapply nth_error_Some in H23.
      destruct_fresh (nth_error (Inode.block_numbers x0) x9); try congruence.
      eapply_fresh H21 in D; cleanup.
      unfold DiskAllocator.block_allocator_rep in *; cleanup.
      eapply nth_error_nth in D.
      rewrite H24 in D; subst.
      eapply DiskAllocator.valid_bits_extract with (n:= a) in v; eauto; cleanup.
      split_ors; cleanup.
      rewrite nth_seln_eq in H10; erewrite nth_error_nth'; eauto.
      rewrite H14, H10; eauto.
      all: try rewrite value_to_bits_length;
      unfold DiskAllocatorParams.num_of_blocks in *;
      pose proof DiskAllocatorParams.num_of_blocks_in_bounds; try lia.
      destruct (Compare_dec.lt_dec a FSParameters.file_blocks_count); try lia.
      rewrite e1 in H26; try congruence; try lia.
      destruct (Compare_dec.lt_dec a FSParameters.file_blocks_count); try lia.
      rewrite e1 in H26; try congruence; try lia.
      setoid_rewrite D in H23; intuition.
    }
    {
      repeat cleanup_pairs;
      repeat unify_invariants.
      unfold Inode.inode_rep, file_map_rep, file_rep, Inode.inode_map_rep in *; cleanup.
      unfold Inode.inode_map_valid, Inode.inode_valid in *; cleanup.
      eapply H23 in H22; cleanup; eauto.
    }
    {
      repeat cleanup_pairs;
      repeat unify_invariants.
      unfold Inode.inode_rep, file_map_rep, file_rep, Inode.inode_map_rep in *; cleanup.
      unfold Inode.inode_map_valid, Inode.inode_valid in *; cleanup.
      eapply H15 in H17; cleanup; eauto.
    }
      }
      {
        eapply_fresh TS_free_all_blocks in H6.
        logic_clean.
        destruct x2; simpl in *; try solve [intuition congruence].
        eapply_fresh free_all_blocks_finished_oracle_eq in H6.
        2: apply H4.
        eapply_fresh FileInnerSpecs.free_all_blocks_finished in H6; eauto.
        eapply_fresh FileInnerSpecs.free_all_blocks_finished in H4.
        cleanup; repeat split_ors; cleanup; try solve [intuition congruence].
        {
          eapply_fresh TS_free_inode in H12.
          cleanup.
          destruct x9; simpl in *; try solve [intuition congruence].
          exists (Crashed s4); split.
          repeat (econstructor; simpl; eauto).
          simpl; eauto.
          simpl; intuition congruence.
          intuition.
          {

    eapply inode_allocations_are_same_2.
    5: eauto.
    all: eauto.
    {
      repeat cleanup_pairs;
      repeat unify_invariants.
      unfold Inode.inode_rep in *; cleanup.
      eexists; split.
      eapply Inode.InodeAllocator.block_allocator_rep_inbounds_eq.
      apply b0.
      intros; repeat solve_bounds.
      eauto.
    }
    {
      repeat cleanup_pairs;
      repeat unify_invariants.
      unfold Inode.inode_rep in *; cleanup.
      eexists; split.
      eapply Inode.InodeAllocator.block_allocator_rep_inbounds_eq.
      apply b.
      intros; repeat solve_bounds.
      eauto.
    }
    {
      repeat cleanup_pairs;
      repeat unify_invariants.
      unfold Inode.inode_rep,
      Inode.InodeAllocator.block_allocator_rep,
      Inode.inode_map_rep in *; cleanup.
      destruct (Compare_dec.lt_dec inum Inode.InodeAllocatorParams.num_of_blocks); eauto.
      rewrite e5, e8 in H22; simpl in *; try lia; try congruence.
    }
  }
        }
        {
          invert_exec.
          exists (Crashed s3); split.
          repeat (econstructor; simpl; eauto).
          simpl; intuition congruence.
        }
        all: eauto.
        all: try solve[
        eapply DiskAllocator.block_allocator_rep_inbounds_eq;
        eauto; intros; repeat solve_bounds].
        {
    eapply DiskAllocator.block_allocator_rep_inbounds_eq.
    2: intros; repeat solve_bounds.
    eauto.
  }
  {
      repeat cleanup_pairs;
      repeat unify_invariants.
      unfold Inode.inode_rep, file_map_rep, file_rep, Inode.inode_map_rep in *; logic_clean.
      unfold Inode.inode_map_valid, Inode.inode_valid in *; logic_clean.
      eapply H18 in H17; cleanup; eauto.
    }
    {
      repeat cleanup_pairs;
      repeat unify_invariants.
      unfold Inode.inode_rep, file_map_rep, file_rep, Inode.inode_map_rep in *; logic_clean.
      unfold Inode.inode_map_valid, Inode.inode_valid in *; logic_clean.
      eapply H21 in H22; logic_clean; eauto.
  }
  {
    eapply DiskAllocator.block_allocator_rep_inbounds_eq.
    2: intros; repeat solve_bounds.
    eauto.
  }
    {
      repeat cleanup_pairs;
      repeat unify_invariants.
      eapply_fresh FileInnerSpecs.inode_exists_then_file_exists in H22; eauto.
      eapply_fresh FileInnerSpecs.inode_exists_then_file_exists in H17 ; eauto.
      logic_clean.
      clear H6.
      unfold same_for_user_except in *; cleanup_no_match.
      eapply_fresh H16 in H15; eauto; cleanup_no_match.
      unfold file_map_rep, file_rep in *; cleanup_no_match.
      eapply_fresh H24 in H22; eauto; cleanup_no_match.
      eapply_fresh H23 in H17; eauto; cleanup_no_match.
      eauto.
    }

    {
      repeat cleanup_pairs;
      repeat unify_invariants.
      clear H5.
      unfold Inode.inode_rep, file_map_rep, file_rep, Inode.inode_map_rep in *; cleanup_no_match.
      unfold Inode.inode_map_valid, Inode.inode_valid in *; cleanup_no_match.
      eapply H23 in H22; cleanup; eauto.
    }
    {
      repeat cleanup_pairs;
      repeat unify_invariants.
      clear H6.
      unfold Inode.inode_rep, file_map_rep, file_rep, Inode.inode_map_rep in *; cleanup_no_match.
      unfold Inode.inode_map_valid, Inode.inode_valid in *; cleanup_no_match.
      eapply H15 in H17; cleanup; eauto.
  }
    {
      repeat cleanup_pairs;
      repeat unify_invariants.
      clear H6.
      eapply_fresh FileInnerSpecs.inode_exists_then_file_exists in H22; eauto.
      cleanup_no_match.
      unfold file_map_rep, file_rep in *; cleanup_no_match.
      eapply_fresh H15 in H22; eauto; cleanup_no_match.
      eapply Forall_forall; eauto; intros.
      eapply In_nth in H23; cleanup_no_match.
      eapply nth_error_Some in H23.
      destruct_fresh (nth_error (Inode.block_numbers x7) x10); try congruence.
      eapply_fresh H21 in D; cleanup_no_match.
      unfold DiskAllocator.block_allocator_rep in *; cleanup_no_match.
      eapply nth_error_nth in D.
      rewrite H24 in D; subst.
      eapply DiskAllocator.valid_bits_extract with (n:= a) in v0; eauto; cleanup_no_match.
      split_ors; cleanup_no_match.
      rewrite nth_seln_eq in H10; erewrite nth_error_nth'; eauto.
      rewrite H19, H10; eauto.
      all: try rewrite value_to_bits_length;
      unfold DiskAllocatorParams.num_of_blocks in *;
      pose proof DiskAllocatorParams.num_of_blocks_in_bounds; try lia.
      destruct (Compare_dec.lt_dec a FSParameters.file_blocks_count); try lia.
      rewrite e4 in H26; try congruence; try lia.
      destruct (Compare_dec.lt_dec a FSParameters.file_blocks_count); try lia.
      rewrite e4 in H26; try congruence; try lia.
      setoid_rewrite D in H23; intuition.
    }
    {
      repeat cleanup_pairs;
      repeat unify_invariants.
      clear H6.
      eapply_fresh FileInnerSpecs.inode_exists_then_file_exists in H17; eauto.
      cleanup_no_match.
      unfold file_map_rep, file_rep in *; cleanup_no_match.
      eapply_fresh H9 in H17; eauto; cleanup_no_match.
      eapply Forall_forall; eauto; intros.
      eapply In_nth in H23; cleanup_no_match.
      eapply nth_error_Some in H23.
      destruct_fresh (nth_error (Inode.block_numbers x0) x10); try congruence.
      eapply_fresh H21 in D; cleanup_no_match.
      unfold DiskAllocator.block_allocator_rep in *; cleanup_no_match.
      eapply nth_error_nth in D.
      rewrite H24 in D; subst.
      eapply DiskAllocator.valid_bits_extract with (n:= a) in v; eauto; cleanup_no_match.
      split_ors; cleanup_no_match.
      rewrite nth_seln_eq in H10; erewrite nth_error_nth'; eauto.
      rewrite H14, H10; eauto.
      all: try rewrite value_to_bits_length;
      unfold DiskAllocatorParams.num_of_blocks in *;
      pose proof DiskAllocatorParams.num_of_blocks_in_bounds; try lia.
      destruct (Compare_dec.lt_dec a FSParameters.file_blocks_count); try lia.
      rewrite e1 in H26; try congruence; try lia.
      destruct (Compare_dec.lt_dec a FSParameters.file_blocks_count); try lia.
      rewrite e1 in H26; try congruence; try lia.
      setoid_rewrite D in H23; intuition.
    }
    {
      repeat cleanup_pairs;
      repeat unify_invariants.
      clear H6.
      unfold Inode.inode_rep, file_map_rep, file_rep, Inode.inode_map_rep in *; cleanup_no_match.
      unfold Inode.inode_map_valid, Inode.inode_valid in *; cleanup_no_match.
      eapply H23 in H22; cleanup; eauto.
    }
    {
      repeat cleanup_pairs;
      repeat unify_invariants.
      clear H6.
      unfold Inode.inode_rep, file_map_rep, file_rep, Inode.inode_map_rep in *; cleanup_no_match.
      unfold Inode.inode_map_valid, Inode.inode_valid in *; cleanup_no_match.
      eapply H15 in H17; cleanup; eauto.
    }
      }
    }
    {
      invert_exec.
      eapply_fresh TS_get_all_block_numbers in H3; eauto.
      logic_clean.
      destruct x; simpl in *; try solve [intuition congruence].
      eapply_fresh Inode.get_all_block_numbers_finished_oracle_eq in H3; eauto.
      destruct o; simpl in *; try solve [intuition congruence].

      exists (Crashed s3); split.
      repeat (econstructor; simpl; eauto).
      simpl; intuition congruence.

      unfold files_inner_rep; eexists; eauto.
      unfold files_inner_rep; eexists; eauto.
    }
  }
}
Unshelve.
all: eauto.
Qed.
Opaque delete_inner.

Theorem Termination_Sensitive_delete:
  forall u u' m inum ex,
    Termination_Sensitive
      u (delete inum) (delete inum) recover
      AD_valid_state (AD_related_states u' ex)
      (authenticated_disk_reboot_list m).
Proof.
  Opaque change_owner_inner.
  unfold Termination_Sensitive, AD_valid_state,
  AD_related_states, FD_valid_state, FD_related_states,
  refines_valid, refines_related,
  authenticated_disk_reboot_list,
  delete;
  intros; cleanup; simpl in *.
  destruct m; simpl in *.
  {(**write finished **)
   invert_exec.
   eapply TS_auth_then_exec in H11; eauto.
   {
     cleanup.
     destruct x1; simpl in *; try solve [intuition congruence].
     eexists; econstructor_recovery.
     eauto.
   }
   {
     intros.
     eapply_fresh TS_delete_inner in H7.
     3: eauto.
     3: eauto.
     cleanup.
     destruct ret1, x1; simpl in * ; try solve [intuition congruence].
     {
      eapply SameRetType.delete_inner_finished_oracle_eq in H7; eauto.
      cleanup.
      eexists.
      intuition eauto; cleanup; eauto.
     }
     {
      eexists.
      intuition eauto; cleanup; eauto.
     }
     eauto.
   }
  }
  {
    invert_exec.
    eapply_fresh TS_auth_then_exec in H14; eauto.
   {
     cleanup.
     destruct x1; simpl in *; try solve [intuition congruence].
     eapply_fresh FileSpecs.delete_crashed in H14; eauto.
    eapply_fresh FileSpecs.delete_crashed in H1; eauto.
    repeat split_ors; cleanup.
    {
      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 s, (snd (snd s), snd (snd s)))) in A;
          unfold AD_valid_state, refines_valid, FD_valid_state;
          intros; eauto
     end.
     edestruct H15.
     2: eexists; econstructor_recovery; [|eauto]; eauto.
     {
       instantiate (1:= ex).
       unfold AD_related_states, refines_related,
       FD_related_states in *; simpl;
       unfold refines, files_rep, files_crash_rep in *; simpl.
       do 2 eexists; intuition eauto.
     }
   }
   {
      exfalso; eapply delete_crashed_exfalso; eauto.
   }
   {
      exfalso; eapply delete_crashed_exfalso.
      eapply same_for_user_except_symmetry. eauto.
      all: eauto.
   }
   {
      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 s, (snd (snd s), snd (snd s)))) in A;
          unfold AD_valid_state, refines_valid, FD_valid_state;
          intros; eauto
     end.
     edestruct H15.
     2: eexists; econstructor_recovery; [|eauto]; eauto.
     {
       instantiate (1:= ex).
       unfold AD_related_states, refines_related,
       FD_related_states in *; simpl;
       unfold refines, files_rep, files_crash_rep in *; simpl.
       do 2 eexists; intuition eauto.
       {
         unfold same_for_user_except in *; cleanup.
         split; intros.
         unfold addrs_match_exactly in *; intros.
         destruct (addr_dec a1 inum);
         [repeat rewrite Mem.delete_eq; eauto; intuition congruence
         |repeat rewrite Mem.delete_ne; eauto; intuition congruence].
         split; intros.
         {
          destruct (addr_dec inum0 inum);
          [rewrite Mem.delete_eq in H5, H16; eauto; cleanup
         |rewrite Mem.delete_ne in H5, H16; eauto; cleanup].
         }
         {
          destruct (addr_dec inum0 inum);
          [rewrite Mem.delete_eq in H5, H4; eauto; cleanup
         |rewrite Mem.delete_ne in H5, H4; eauto; cleanup].
         }
       }
     }
   }
  }
  {
     intros.
     eapply_fresh TS_delete_inner in H7; eauto.
     cleanup.
     destruct ret1, x1; simpl in * ; try solve [intuition congruence].
     {
      eapply SameRetType.delete_inner_finished_oracle_eq in H7; eauto.
      cleanup.
      eexists.
      intuition eauto; cleanup; eauto.
     }
     {
      eexists.
      intuition eauto; cleanup; eauto.
     }
  }
}
Unshelve.
all: eauto.
Qed.


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

(** Operators and addressing modes.  The abstract syntax and dynamic
  semantics for the CminorSel, RTL, LTL and Mach languages depend on the
  following types, defined in this library:
- [condition]:  boolean conditions for conditional branches;
- [operation]: arithmetic and logical operations;
- [addressing]: addressing modes for load and store operations.

  These types are PowerPC-specific and correspond roughly to what the
  processor can compute in one instruction.  In other terms, these
  types reflect the state of the program after instruction selection.
  For a processor-independent set of operations, see the abstract
  syntax and dynamic semantics of the Cminor language.
*)

Require Import Coqlib.
Require Import AST.
Require Import Integers.
Require Import Floats.
Require Import Values.
Require Import Memory.
Require Import Globalenvs.
Require Import Events.

Set Implicit Arguments.

(** Conditions (boolean-valued operators). *)

Inductive condition : Type :=
  | Ccomp: comparison -> condition      (**r signed integer comparison *)
  | Ccompu: comparison -> condition     (**r unsigned integer comparison *)
  | Ccompimm: comparison -> int -> condition (**r signed integer comparison with a constant *)
  | Ccompuimm: comparison -> int -> condition  (**r unsigned integer comparison with a constant *)
  | Ccompf: comparison -> condition     (**r floating-point comparison *)
  | Cnotcompf: comparison -> condition  (**r negation of a floating-point comparison *)
  | Cmaskzero: int -> condition         (**r test [(arg & constant) == 0] *)
  | Cmasknotzero: int -> condition.     (**r test [(arg & constant) != 0] *)

(** Arithmetic and logical operations.  In the descriptions, [rd] is the
  result of the operation and [r1], [r2], etc, are the arguments. *)

Inductive operation : Type :=
  | Omove: operation                    (**r [rd = r1] *)
  | Ointconst: int -> operation         (**r [rd] is set to the given integer constant *)
  | Ofloatconst: float -> operation     (**r [rd] is set to the given float constant *)
  | Osingleconst: float32 -> operation  (**r [rd] is set to the given float constant *)
  | Oaddrsymbol: ident -> int -> operation (**r [rd] is set to the the address of the symbol plus the offset *)
  | Oaddrstack: int -> operation        (**r [rd] is set to the stack pointer plus the given offset *)
(*c Integer arithmetic: *)
  | Ocast8signed: operation             (**r [rd] is 8-bit sign extension of [r1] *)
  | Ocast16signed: operation            (**r [rd] is 16-bit sign extension of [r1] *)
  | Oadd: operation                     (**r [rd = r1 + r2] *)
  | Oaddimm: int -> operation           (**r [rd = r1 + n] *)
  | Oaddsymbol: ident -> int -> operation (**r [rd = addr(id + ofs) + r1] *)
  | Osub: operation                     (**r [rd = r1 - r2] *)
  | Osubimm: int -> operation           (**r [rd = n - r1] *)
  | Omul: operation                     (**r [rd = r1 * r2] *)
  | Omulimm: int -> operation           (**r [rd = r1 * n] *)
  | Omulhs: operation                   (**r [rd = high part of r1 * r2, signed] *)
  | Omulhu: operation                   (**r [rd = high part of r1 * r2, unsigned] *)
  | Odiv: operation                     (**r [rd = r1 / r2] (signed) *)
  | Odivu: operation                    (**r [rd = r1 / r2] (unsigned) *)
  | Oand: operation                     (**r [rd = r1 & r2] *)
  | Oandimm: int -> operation           (**r [rd = r1 & n] *)
  | Oor: operation                      (**r [rd = r1 | r2] *)
  | Oorimm: int -> operation            (**r [rd = r1 | n] *)
  | Oxor: operation                     (**r [rd = r1 ^ r2] *)
  | Oxorimm: int -> operation           (**r [rd = r1 ^ n] *)
  | Onot: operation                     (**r [rd = ~r1] *)
  | Onand: operation                    (**r [rd = ~(r1 & r2)] *)
  | Onor: operation                     (**r [rd = ~(r1 | r2)] *)
  | Onxor: operation                    (**r [rd = ~(r1 ^ r2)] *)
  | Oandc: operation                    (**r [rd = r1 & ~r2] *)
  | Oorc: operation                     (**r [rd = r1 | ~r2] *)
  | Oshl: operation                     (**r [rd = r1 << r2] *)
  | Oshr: operation                     (**r [rd = r1 >> r2] (signed) *)
  | Oshrimm: int -> operation           (**r [rd = r1 >> n] (signed) *)
  | Oshrximm: int -> operation          (**r [rd = r1 / 2^n] (signed) *)
  | Oshru: operation                    (**r [rd = r1 >> r2] (unsigned) *)
  | Orolm: int -> int -> operation      (**r rotate left and mask *)
  | Oroli: int -> int -> operation      (**r rotate left and insert *)
(*c Floating-point arithmetic: *)
  | Onegf: operation                    (**r [rd = - r1] *)
  | Oabsf: operation                    (**r [rd = abs(r1)] *)
  | Oaddf: operation                    (**r [rd = r1 + r2] *)
  | Osubf: operation                    (**r [rd = r1 - r2] *)
  | Omulf: operation                    (**r [rd = r1 * r2] *)
  | Odivf: operation                    (**r [rd = r1 / r2] *)
  | Onegfs: operation                   (**r [rd = - r1] *)
  | Oabsfs: operation                   (**r [rd = abs(r1)] *)
  | Oaddfs: operation                   (**r [rd = r1 + r2] *)
  | Osubfs: operation                   (**r [rd = r1 - r2] *)
  | Omulfs: operation                   (**r [rd = r1 * r2] *)
  | Odivfs: operation                   (**r [rd = r1 / r2] *)
  | Osingleoffloat: operation           (**r [rd] is [r1] truncated to single-precision float *)
  | Ofloatofsingle: operation           (**r [rd] is [r1] extended to double-precision float *)
(*c Conversions between int and float: *)
  | Ointoffloat: operation              (**r [rd = signed_int_of_float(r1)] *)
  | Ofloatofwords: operation            (**r [rd = float_of_words(r1,r2)] *)
(*c Manipulating 64-bit integers: *)
  | Omakelong: operation                (**r [rd = r1 << 32 | r2] *)
  | Olowlong: operation                 (**r [rd = low-word(r1)] *)
  | Ohighlong: operation                (**r [rd = high-word(r1)] *)
(*c Boolean tests: *)
  | Ocmp: condition -> operation.       (**r [rd = 1] if condition holds, [rd = 0] otherwise. *)

(** Addressing modes.  [r1], [r2], etc, are the arguments to the
  addressing. *)

Inductive addressing: Type :=
  | Aindexed: int -> addressing         (**r Address is [r1 + offset] *)
  | Aindexed2: addressing               (**r Address is [r1 + r2] *)
  | Aglobal: ident -> int -> addressing (**r Address is [symbol + offset] *)
  | Abased: ident -> int -> addressing (**r Address is [symbol + offset + r1] *)
  | Ainstack: int -> addressing.        (**r Address is [stack_pointer + offset] *)

(** Comparison functions (used in module [CSE]). *)

Definition eq_condition (x y: condition) : {x=y} + {x<>y}.
Proof.
  generalize Int.eq_dec; intro.
  assert (forall (x y: comparison), {x=y}+{x<>y}). decide equality.
  decide equality.
Defined.

Definition eq_operation (x y: operation): {x=y} + {x<>y}.
Proof.
  generalize Int.eq_dec; intro.
  generalize Float.eq_dec Float32.eq_dec; intros.
  assert (forall (x y: ident), {x=y}+{x<>y}). exact peq.
  generalize eq_condition; intro.
  decide equality.
Defined.

Definition eq_addressing (x y: addressing) : {x=y} + {x<>y}.
Proof.
  generalize Int.eq_dec; intro.
  assert (forall (x y: ident), {x=y}+{x<>y}). exact peq.
  decide equality.
Defined.

Global Opaque eq_condition eq_addressing eq_operation.

(** * Evaluation functions *)

(** Evaluation of conditions, operators and addressing modes applied
  to lists of values.  Return [None] when the computation can trigger an
  error, e.g. integer division by zero.  [eval_condition] returns a boolean,
  [eval_operation] and [eval_addressing] return a value. *)

Definition eval_condition (cond: condition) (vl: list val) (m: mem): option bool :=
  match cond, vl with
  | Ccomp c, v1 :: v2 :: nil => Val.cmp_bool c v1 v2
  | Ccompu c, v1 :: v2 :: nil => Val.cmpu_bool (Mem.valid_pointer m) c v1 v2
  | Ccompimm c n, v1 :: nil => Val.cmp_bool c v1 (Vint n)
  | Ccompuimm c n, v1 :: nil => Val.cmpu_bool (Mem.valid_pointer m) c v1 (Vint n)
  | Ccompf c, v1 :: v2 :: nil => Val.cmpf_bool c v1 v2
  | Cnotcompf c, v1 :: v2 :: nil => option_map negb (Val.cmpf_bool c v1 v2)
  | Cmaskzero n, v1 :: nil => Val.maskzero_bool v1 n
  | Cmasknotzero n, v1 :: nil => option_map negb (Val.maskzero_bool v1 n)
  | _, _ => None
  end.

Definition eval_operation
             (F V: Type) (genv: Genv.t F V) (sp: val)
             (op: operation) (vl: list val) (m: mem): option val :=
  match op, vl with
  | Omove, v1::nil => Some v1
  | Ointconst n, nil => Some (Vint n)
  | Ofloatconst n, nil => Some (Vfloat n)
  | Osingleconst n, nil => Some (Vsingle n)
  | Oaddrsymbol s ofs, nil => Some (Genv.symbol_address genv s ofs)
  | Oaddrstack ofs, nil => Some (Val.add sp (Vint ofs))
  | Ocast8signed, v1::nil => Some (Val.sign_ext 8 v1)
  | Ocast16signed, v1::nil => Some (Val.sign_ext 16 v1)
  | Oadd, v1::v2::nil => Some (Val.add v1 v2)
  | Oaddimm n, v1::nil => Some (Val.add v1 (Vint n))
  | Oaddsymbol s ofs, v1::nil => Some (Val.add (Genv.symbol_address genv s ofs) v1)
  | Osub, v1::v2::nil => Some (Val.sub v1 v2)
  | Osubimm n, v1::nil => Some (Val.sub (Vint n) v1)
  | Omul, v1::v2::nil => Some (Val.mul v1 v2)
  | Omulimm n, v1::nil => Some (Val.mul v1 (Vint n))
  | Omulhs, v1::v2::nil => Some (Val.mulhs v1 v2)
  | Omulhu, v1::v2::nil => Some (Val.mulhu v1 v2)
  | Odiv, v1::v2::nil => Val.divs v1 v2
  | Odivu, v1::v2::nil => Val.divu v1 v2
  | Oand, v1::v2::nil => Some(Val.and v1 v2)
  | Oandimm n, v1::nil => Some (Val.and v1 (Vint n))
  | Oor, v1::v2::nil => Some(Val.or v1 v2)
  | Oorimm n, v1::nil => Some (Val.or v1 (Vint n))
  | Oxor, v1::v2::nil => Some(Val.xor v1 v2)
  | Oxorimm n, v1::nil => Some (Val.xor v1 (Vint n))
  | Onot, v1::nil => Some(Val.notint v1)
  | Onand, v1::v2::nil => Some (Val.notint (Val.and v1 v2))
  | Onor, v1::v2::nil => Some (Val.notint (Val.or v1 v2))
  | Onxor, v1::v2::nil => Some (Val.notint (Val.xor v1 v2))
  | Oandc, v1::v2::nil => Some (Val.and v1 (Val.notint v2))
  | Oorc, v1::v2::nil => Some (Val.or v1 (Val.notint v2))
  | Oshl, v1::v2::nil => Some (Val.shl v1 v2)
  | Oshr, v1::v2::nil => Some (Val.shr v1 v2)
  | Oshrimm n, v1::nil => Some (Val.shr v1 (Vint n))
  | Oshrximm n, v1::nil => Val.shrx v1 (Vint n)
  | Oshru, v1::v2::nil => Some (Val.shru v1 v2)
  | Orolm amount mask, v1::nil => Some (Val.rolm v1 amount mask)
  | Oroli amount mask, v1::v2::nil =>
      Some(Val.or (Val.and v1 (Vint (Int.not mask))) (Val.rolm v2 amount mask))
  | Onegf, v1::nil => Some(Val.negf v1)
  | Oabsf, v1::nil => Some(Val.absf v1)
  | Oaddf, v1::v2::nil => Some(Val.addf v1 v2)
  | Osubf, v1::v2::nil => Some(Val.subf v1 v2)
  | Omulf, v1::v2::nil => Some(Val.mulf v1 v2)
  | Odivf, v1::v2::nil => Some(Val.divf v1 v2)
  | Onegfs, v1::nil => Some(Val.negfs v1)
  | Oabsfs, v1::nil => Some(Val.absfs v1)
  | Oaddfs, v1::v2::nil => Some(Val.addfs v1 v2)
  | Osubfs, v1::v2::nil => Some(Val.subfs v1 v2)
  | Omulfs, v1::v2::nil => Some(Val.mulfs v1 v2)
  | Odivfs, v1::v2::nil => Some(Val.divfs v1 v2)
  | Osingleoffloat, v1::nil => Some(Val.singleoffloat v1)
  | Ofloatofsingle, v1::nil => Some(Val.floatofsingle v1)
  | Ointoffloat, v1::nil => Val.intoffloat v1
  | Ofloatofwords, v1::v2::nil => Some(Val.floatofwords v1 v2)
  | Omakelong, v1::v2::nil => Some(Val.longofwords v1 v2)
  | Olowlong, v1::nil => Some(Val.loword v1)
  | Ohighlong, v1::nil => Some(Val.hiword v1)
  | Ocmp c, _ => Some(Val.of_optbool (eval_condition c vl m))
  | _, _ => None
  end.

Definition eval_addressing
    (F V: Type) (genv: Genv.t F V) (sp: val)
    (addr: addressing) (vl: list val) : option val :=
  match addr, vl with
  | Aindexed n, v1::nil => Some (Val.add v1 (Vint n))
  | Aindexed2, v1::v2::nil => Some (Val.add v1 v2)
  | Aglobal s ofs, nil => Some (Genv.symbol_address genv s ofs)
  | Abased s ofs, v1::nil => Some (Val.add (Genv.symbol_address genv s ofs) v1)
  | Ainstack ofs, nil => Some(Val.add sp (Vint ofs))
  | _, _ => None
  end.

Ltac FuncInv :=
  match goal with
  | H: (match ?x with nil => _ | _ :: _ => _ end = Some _) |- _ =>
      destruct x; simpl in H; try discriminate; FuncInv
  | H: (match ?v with Vundef => _ | Vint _ => _ | Vlong _ => _ | Vfloat _ => _ | Vptr _ _ => _ end = Some _) |- _ =>
      destruct v; simpl in H; try discriminate; FuncInv
  | H: (Some _ = Some _) |- _ =>
      injection H; intros; clear H; FuncInv
  | _ =>
      idtac
  end.

(** * Static typing of conditions, operators and addressing modes. *)

Definition type_of_condition (c: condition) : list typ :=
  match c with
  | Ccomp _ => Tint :: Tint :: nil
  | Ccompu _ => Tint :: Tint :: nil
  | Ccompimm _ _ => Tint :: nil
  | Ccompuimm _ _ => Tint :: nil
  | Ccompf _ => Tfloat :: Tfloat :: nil
  | Cnotcompf _ => Tfloat :: Tfloat :: nil
  | Cmaskzero _ => Tint :: nil
  | Cmasknotzero _ => Tint :: nil
  end.

Definition type_of_operation (op: operation) : list typ * typ :=
  match op with
  | Omove => (nil, Tint)   (* treated specially *)
  | Ointconst _ => (nil, Tint)
  | Ofloatconst f => (nil, Tfloat)
  | Osingleconst f => (nil, Tsingle)
  | Oaddrsymbol _ _ => (nil, Tint)
  | Oaddrstack _ => (nil, Tint)
  | Ocast8signed => (Tint :: nil, Tint)
  | Ocast16signed => (Tint :: nil, Tint)
  | Oadd => (Tint :: Tint :: nil, Tint)
  | Oaddimm _ => (Tint :: nil, Tint)
  | Oaddsymbol _ _ => (Tint :: nil, Tint)
  | Osub => (Tint :: Tint :: nil, Tint)
  | Osubimm _ => (Tint :: nil, Tint)
  | Omul => (Tint :: Tint :: nil, Tint)
  | Omulimm _ => (Tint :: nil, Tint)
  | Omulhs => (Tint :: Tint :: nil, Tint)
  | Omulhu => (Tint :: Tint :: nil, Tint)
  | Odiv => (Tint :: Tint :: nil, Tint)
  | Odivu => (Tint :: Tint :: nil, Tint)
  | Oand => (Tint :: Tint :: nil, Tint)
  | Oandimm _ => (Tint :: nil, Tint)
  | Oor => (Tint :: Tint :: nil, Tint)
  | Oorimm _ => (Tint :: nil, Tint)
  | Oxor => (Tint :: Tint :: nil, Tint)
  | Oxorimm _ => (Tint :: nil, Tint)
  | Onot => (Tint :: nil, Tint)
  | Onand => (Tint :: Tint :: nil, Tint)
  | Onor => (Tint :: Tint :: nil, Tint)
  | Onxor => (Tint :: Tint :: nil, Tint)
  | Oandc => (Tint :: Tint :: nil, Tint)
  | Oorc => (Tint :: Tint :: nil, Tint)
  | Oshl => (Tint :: Tint :: nil, Tint)
  | Oshr => (Tint :: Tint :: nil, Tint)
  | Oshrimm _ => (Tint :: nil, Tint)
  | Oshrximm _ => (Tint :: nil, Tint)
  | Oshru => (Tint :: Tint :: nil, Tint)
  | Orolm _ _ => (Tint :: nil, Tint)
  | Oroli _ _ => (Tint :: Tint :: nil, Tint)
  | Onegf => (Tfloat :: nil, Tfloat)
  | Oabsf => (Tfloat :: nil, Tfloat)
  | Oaddf => (Tfloat :: Tfloat :: nil, Tfloat)
  | Osubf => (Tfloat :: Tfloat :: nil, Tfloat)
  | Omulf => (Tfloat :: Tfloat :: nil, Tfloat)
  | Odivf => (Tfloat :: Tfloat :: nil, Tfloat)
  | Onegfs => (Tsingle :: nil, Tsingle)
  | Oabsfs => (Tsingle :: nil, Tsingle)
  | Oaddfs => (Tsingle :: Tsingle :: nil, Tsingle)
  | Osubfs => (Tsingle :: Tsingle :: nil, Tsingle)
  | Omulfs => (Tsingle :: Tsingle :: nil, Tsingle)
  | Odivfs => (Tsingle :: Tsingle :: nil, Tsingle)
  | Osingleoffloat => (Tfloat :: nil, Tsingle)
  | Ofloatofsingle => (Tsingle :: nil, Tfloat)
  | Ointoffloat => (Tfloat :: nil, Tint)
  | Ofloatofwords => (Tint :: Tint :: nil, Tfloat)
  | Omakelong => (Tint :: Tint :: nil, Tlong)
  | Olowlong => (Tlong :: nil, Tint)
  | Ohighlong => (Tlong :: nil, Tint)
  | Ocmp c => (type_of_condition c, Tint)
  end.

Definition type_of_addressing (addr: addressing) : list typ :=
  match addr with
  | Aindexed _ => Tint :: nil
  | Aindexed2 => Tint :: Tint :: nil
  | Aglobal _ _ => nil
  | Abased _ _ => Tint :: nil
  | Ainstack _ => nil
  end.

(** Weak type soundness results for [eval_operation]:
  the result values, when defined, are always of the type predicted
  by [type_of_operation]. *)

Section SOUNDNESS.

Variable A V: Type.
Variable genv: Genv.t A V.

Lemma type_of_operation_sound:
  forall op vl sp v m,
  op <> Omove ->
  eval_operation genv sp op vl m = Some v ->
  Val.has_type v (snd (type_of_operation op)).
Proof with (try exact I).
  intros.
  destruct op; simpl in H0; FuncInv; subst; simpl.
  congruence.
  exact I.
  auto.
  auto.
  unfold Genv.symbol_address. destruct (Genv.find_symbol genv i)...
  destruct sp...
  destruct v0...
  destruct v0...
  destruct v0; destruct v1...
  destruct v0...
  unfold Genv.symbol_address. destruct (Genv.find_symbol genv i)... destruct v0...
  destruct v0; destruct v1... simpl. destruct (eq_block b b0)...
  destruct v0...
  destruct v0; destruct v1...
  destruct v0...
  destruct v0; destruct v1...
  destruct v0; destruct v1...
  destruct v0; destruct v1; simpl in *; inv H0.
    destruct (Int.eq i0 Int.zero
         || Int.eq i (Int.repr Int.min_signed) && Int.eq i0 Int.mone); inv H2...
  destruct v0; destruct v1; simpl in *; inv H0. destruct (Int.eq i0 Int.zero); inv H2...
  destruct v0; destruct v1...
  destruct v0...
  destruct v0; destruct v1...
  destruct v0...
  destruct v0; destruct v1...
  destruct v0...
  destruct v0...
  destruct v0; destruct v1...
  destruct v0; destruct v1...
  destruct v0; destruct v1...
  destruct v0; destruct v1...
  destruct v0; destruct v1...
  destruct v0; destruct v1; simpl... destruct (Int.ltu i0 Int.iwordsize)...
  destruct v0; destruct v1; simpl... destruct (Int.ltu i0 Int.iwordsize)...
  destruct v0; simpl... destruct (Int.ltu i Int.iwordsize)...
  destruct v0; simpl in *; inv H0. destruct (Int.ltu i (Int.repr 31)); inv H2...
  destruct v0; destruct v1; simpl... destruct (Int.ltu i0 Int.iwordsize)...
  destruct v0...
  destruct v0; destruct v1...
  destruct v0...
  destruct v0...
  destruct v0; destruct v1...
  destruct v0; destruct v1...
  destruct v0; destruct v1...
  destruct v0; destruct v1...
  destruct v0...
  destruct v0...
  destruct v0; destruct v1...
  destruct v0; destruct v1...
  destruct v0; destruct v1...
  destruct v0; destruct v1...
  destruct v0...
  destruct v0...
  destruct v0; simpl in H0; inv H0. destruct (Float.to_int f); inv H2...
  destruct v0; destruct v1...
  destruct v0; destruct v1...
  destruct v0...
  destruct v0...
  destruct (eval_condition c vl m); simpl... destruct b...
Qed.

End SOUNDNESS.

(** * Manipulating and transforming operations *)

(** Recognition of move operations. *)

Definition is_move_operation
    (A: Type) (op: operation) (args: list A) : option A :=
  match op, args with
  | Omove, arg :: nil => Some arg
  | _, _ => None
  end.

Lemma is_move_operation_correct:
  forall (A: Type) (op: operation) (args: list A) (a: A),
  is_move_operation op args = Some a ->
  op = Omove /\ args = a :: nil.
Proof.
  intros until a. unfold is_move_operation; destruct op;
  try (intros; discriminate).
  destruct args. intros; discriminate.
  destruct args. intros. intuition congruence.
  intros; discriminate.
Qed.

(** [negate_condition cond] returns a condition that is logically
  equivalent to the negation of [cond]. *)

Definition negate_condition (cond: condition): condition :=
  match cond with
  | Ccomp c => Ccomp(negate_comparison c)
  | Ccompu c => Ccompu(negate_comparison c)
  | Ccompimm c n => Ccompimm (negate_comparison c) n
  | Ccompuimm c n => Ccompuimm (negate_comparison c) n
  | Ccompf c => Cnotcompf c
  | Cnotcompf c => Ccompf c
  | Cmaskzero n => Cmasknotzero n
  | Cmasknotzero n => Cmaskzero n
  end.

Lemma eval_negate_condition:
  forall cond vl m,
  eval_condition (negate_condition cond) vl m = option_map negb (eval_condition cond vl m).
Proof.
  intros. destruct cond; simpl.
  repeat (destruct vl; auto). apply Val.negate_cmp_bool.
  repeat (destruct vl; auto). apply Val.negate_cmpu_bool.
  repeat (destruct vl; auto). apply Val.negate_cmp_bool.
  repeat (destruct vl; auto). apply Val.negate_cmpu_bool.
  repeat (destruct vl; auto).
  repeat (destruct vl; auto). destruct (Val.cmpf_bool c v v0); auto. destruct b; auto.
  repeat (destruct vl; auto).
  repeat (destruct vl; auto). destruct (Val.maskzero_bool v i) as [[]|]; auto.
Qed.

(** Shifting stack-relative references.  This is used in [Stacking]. *)

Definition shift_stack_addressing (delta: int) (addr: addressing) :=
  match addr with
  | Ainstack ofs => Ainstack (Int.add delta ofs)
  | _ => addr
  end.

Definition shift_stack_operation (delta: int) (op: operation) :=
  match op with
  | Oaddrstack ofs => Oaddrstack (Int.add delta ofs)
  | _ => op
  end.

Lemma type_shift_stack_addressing:
  forall delta addr, type_of_addressing (shift_stack_addressing delta addr) = type_of_addressing addr.
Proof.
  intros. destruct addr; auto.
Qed.

Lemma type_shift_stack_operation:
  forall delta op, type_of_operation (shift_stack_operation delta op) = type_of_operation op.
Proof.
  intros. destruct op; auto.
Qed.

Lemma eval_shift_stack_addressing:
  forall F V (ge: Genv.t F V) sp addr vl delta,
  eval_addressing ge sp (shift_stack_addressing delta addr) vl =
  eval_addressing ge (Val.add sp (Vint delta)) addr vl.
Proof.
  intros. destruct addr; simpl; auto.
  rewrite Val.add_assoc. simpl. auto.
Qed.

Lemma eval_shift_stack_operation:
  forall F V (ge: Genv.t F V) sp op vl m delta,
  eval_operation ge sp (shift_stack_operation delta op) vl m =
  eval_operation ge (Val.add sp (Vint delta)) op vl m.
Proof.
  intros. destruct op; simpl; auto.
  rewrite Val.add_assoc. simpl. auto.
Qed.

(** Offset an addressing mode [addr] by a quantity [delta], so that
  it designates the pointer [delta] bytes past the pointer designated
  by [addr].  May be undefined, in which case [None] is returned. *)

Definition offset_addressing (addr: addressing) (delta: int) : option addressing :=
  match addr with
  | Aindexed n => Some(Aindexed (Int.add n delta))
  | Aindexed2 => None
  | Aglobal s n => Some(Aglobal s (Int.add n delta))
  | Abased s n => Some(Abased s (Int.add n delta))
  | Ainstack n => Some(Ainstack (Int.add n delta))
  end.

Lemma eval_offset_addressing:
  forall (F V: Type) (ge: Genv.t F V) sp addr args delta addr' v,
  offset_addressing addr delta = Some addr' ->
  eval_addressing ge sp addr args = Some v ->
  eval_addressing ge sp addr' args = Some(Val.add v (Vint delta)).
Proof.
  intros. destruct addr; simpl in H; inv H; simpl in *; FuncInv; subst.
  rewrite Val.add_assoc; auto.
  unfold Genv.symbol_address. destruct (Genv.find_symbol ge i); auto.
  unfold Genv.symbol_address. destruct (Genv.find_symbol ge i); auto.
  rewrite Val.add_assoc. rewrite Val.add_permut. rewrite Val.add_commut. auto.
  rewrite Val.add_assoc. auto.
Qed.

(** Operations that are so cheap to recompute that CSE should not factor them out. *)

Definition is_trivial_op (op: operation) : bool :=
  match op with
  | Omove => true
  | Ointconst _ => true
  | Oaddrsymbol _ _ => true
  | Oaddrstack _ => true
  | _ => false
  end.

(** Operations that depend on the memory state. *)

Definition op_depends_on_memory (op: operation) : bool :=
  match op with
  | Ocmp (Ccompu _) => true
  | _ => false
  end.

Lemma op_depends_on_memory_correct:
  forall (F V: Type) (ge: Genv.t F V) sp op args m1 m2,
  op_depends_on_memory op = false ->
  eval_operation ge sp op args m1 = eval_operation ge sp op args m2.
Proof.
  intros until m2. destruct op; simpl; try congruence.
  destruct c; simpl; auto; discriminate.
Qed.

(** * Invariance and compatibility properties. *)

(** [eval_operation] and [eval_addressing] depend on a global environment
  for resolving references to global symbols.  We show that they give
  the same results if a global environment is replaced by another that
  assigns the same addresses to the same symbols. *)

Section GENV_TRANSF.

Variable F1 F2 V1 V2: Type.
Variable ge1: Genv.t F1 V1.
Variable ge2: Genv.t F2 V2.
Hypothesis agree_on_symbols:
  forall (s: ident), Genv.find_symbol ge2 s = Genv.find_symbol ge1 s.

Remark symbol_address_preserved:
  forall s ofs, Genv.symbol_address ge2 s ofs = Genv.symbol_address ge1 s ofs.
Proof.
  unfold Genv.symbol_address; intros. rewrite agree_on_symbols; auto.
Qed.

Lemma eval_operation_preserved:
  forall sp op vl m,
  eval_operation ge2 sp op vl m = eval_operation ge1 sp op vl m.
Proof.
  intros. destruct op; simpl; auto; rewrite symbol_address_preserved; auto.
Qed.

Lemma eval_addressing_preserved:
  forall sp addr vl,
  eval_addressing ge2 sp addr vl = eval_addressing ge1 sp addr vl.
Proof.
  intros. destruct addr; simpl; auto; rewrite symbol_address_preserved; auto.
Qed.

End GENV_TRANSF.

(** Compatibility of the evaluation functions with value injections. *)

Section EVAL_COMPAT.

Variable F V: Type.
Variable genv: Genv.t F V.
Variable f: meminj.

Hypothesis symbol_address_inj:
  forall id ofs,
  val_inject f (Genv.symbol_address genv id ofs) (Genv.symbol_address genv id ofs).

Variable m1: mem.
Variable m2: mem.

Hypothesis valid_pointer_inj:
  forall b1 ofs b2 delta,
  f b1 = Some(b2, delta) ->
  Mem.valid_pointer m1 b1 (Int.unsigned ofs) = true ->
  Mem.valid_pointer m2 b2 (Int.unsigned (Int.add ofs (Int.repr delta))) = true.

Hypothesis weak_valid_pointer_inj:
  forall b1 ofs b2 delta,
  f b1 = Some(b2, delta) ->
  Mem.weak_valid_pointer m1 b1 (Int.unsigned ofs) = true ->
  Mem.weak_valid_pointer m2 b2 (Int.unsigned (Int.add ofs (Int.repr delta))) = true.

Hypothesis weak_valid_pointer_no_overflow:
  forall b1 ofs b2 delta,
  f b1 = Some(b2, delta) ->
  Mem.weak_valid_pointer m1 b1 (Int.unsigned ofs) = true ->
  0 <= Int.unsigned ofs + Int.unsigned (Int.repr delta) <= Int.max_unsigned.

Hypothesis valid_different_pointers_inj:
  forall b1 ofs1 b2 ofs2 b1' delta1 b2' delta2,
  b1 <> b2 ->
  Mem.valid_pointer m1 b1 (Int.unsigned ofs1) = true ->
  Mem.valid_pointer m1 b2 (Int.unsigned ofs2) = true ->
  f b1 = Some (b1', delta1) ->
  f b2 = Some (b2', delta2) ->
  b1' <> b2' \/
  Int.unsigned (Int.add ofs1 (Int.repr delta1)) <> Int.unsigned (Int.add ofs2 (Int.repr delta2)).

Ltac InvInject :=
  match goal with
  | [ H: val_inject _ (Vint _) _ |- _ ] =>
      inv H; InvInject
  | [ H: val_inject _ (Vfloat _) _ |- _ ] =>
      inv H; InvInject
  | [ H: val_inject _ (Vsingle _) _ |- _ ] =>
      inv H; InvInject
  | [ H: val_inject _ (Vptr _ _) _ |- _ ] =>
      inv H; InvInject
  | [ H: Forall2 (val_inject _) nil _ |- _ ] =>
      inv H; InvInject
  | [ H: Forall2 (val_inject _) (_ :: _) _ |- _ ] =>
      inv H; InvInject
  | _ => idtac
  end.

Lemma eval_condition_inj:
  forall cond vl1 vl2 b,
  Forall2 (val_inject f) vl1 vl2 ->
  eval_condition cond vl1 m1 = Some b ->
  eval_condition cond vl2 m2 = Some b.
Proof.
  intros. destruct cond; simpl in H0; FuncInv; InvInject; simpl; auto.
  inv H3; inv H2; simpl in H0; inv H0; auto.
  eauto 3 using val_cmpu_bool_inject, Mem.valid_pointer_implies.
  inv H3; simpl in H0; inv H0; auto.
  eauto 3 using val_cmpu_bool_inject, Mem.valid_pointer_implies.
  inv H3; inv H2; simpl in H0; inv H0; auto.
  inv H3; inv H2; simpl in H0; inv H0; auto.
  inv H3; try discriminate; auto.
  inv H3; try discriminate; auto.
Qed.

Ltac TrivialExists :=
  match goal with
  | [ |- exists v2, Some ?v1 = Some v2 /\ val_inject _ _ v2 ] =>
      exists v1; split; auto
  | _ => idtac
  end.

Lemma eval_operation_inj:
  forall op sp1 vl1 sp2 vl2 v1,
  val_inject f sp1 sp2 ->
  Forall2 (val_inject f) vl1 vl2 ->
  eval_operation genv sp1 op vl1 m1 = Some v1 ->
  exists v2, eval_operation genv sp2 op vl2 m2 = Some v2 /\ val_inject f v1 v2.
Proof.
  intros. destruct op; simpl in H1; simpl; FuncInv; InvInject; TrivialExists.
  inv H; simpl; econstructor; eauto. repeat rewrite Int.add_assoc. decEq. apply Int.add_commut.
  inv H4; simpl; auto.
  inv H4; simpl; auto.
  apply Values.val_add_inject; auto.
  apply Values.val_add_inject; auto.
  apply Values.val_add_inject; auto.
  inv H4; inv H2; simpl; auto. econstructor; eauto.
    rewrite Int.sub_add_l. auto.
    destruct (eq_block b1 b0); auto. subst. rewrite H1 in H0. inv H0. rewrite dec_eq_true.
    rewrite Int.sub_shifted. auto.
  inv H4; auto.
  inv H4; inv H2; simpl; auto.
  inv H4; simpl; auto.
  inv H4; inv H2; simpl; auto.
  inv H4; inv H2; simpl; auto.
  inv H4; inv H3; simpl in H1; inv H1. simpl.
    destruct (Int.eq i0 Int.zero
         || Int.eq i (Int.repr Int.min_signed) && Int.eq i0 Int.mone); inv H2. TrivialExists.
  inv H4; inv H3; simpl in H1; inv H1. simpl.
    destruct (Int.eq i0 Int.zero); inv H2. TrivialExists.
  inv H4; inv H2; simpl; auto.
  inv H4; simpl; auto.
  inv H4; inv H2; simpl; auto.
  inv H4; simpl; auto.
  inv H4; inv H2; simpl; auto.
  inv H4; simpl; auto.
  inv H4; simpl; auto.
  inv H4; inv H2; simpl; auto.
  inv H4; inv H2; simpl; auto.
  inv H4; inv H2; simpl; auto.
  inv H4; inv H2; simpl; auto.
  inv H4; inv H2; simpl; auto.
  inv H4; inv H2; simpl; auto. destruct (Int.ltu i0 Int.iwordsize); auto.
  inv H4; inv H2; simpl; auto. destruct (Int.ltu i0 Int.iwordsize); auto.
  inv H4; simpl; auto. destruct (Int.ltu i Int.iwordsize); auto.
  inv H4; simpl in *; inv H1. destruct (Int.ltu i (Int.repr 31)); inv H2. econstructor; eauto.
  inv H4; inv H2; simpl; auto. destruct (Int.ltu i0 Int.iwordsize); auto.
  inv H4; simpl; auto.
  inv H4; inv H2; simpl; auto.
  inv H4; simpl; auto.
  inv H4; simpl; auto.
  inv H4; inv H2; simpl; auto.
  inv H4; inv H2; simpl; auto.
  inv H4; inv H2; simpl; auto.
  inv H4; inv H2; simpl; auto.
  inv H4; simpl; auto.
  inv H4; simpl; auto.
  inv H4; inv H2; simpl; auto.
  inv H4; inv H2; simpl; auto.
  inv H4; inv H2; simpl; auto.
  inv H4; inv H2; simpl; auto.
  inv H4; simpl; auto.
  inv H4; simpl; auto.
  inv H4; simpl in H1; inv H1. simpl. destruct (Float.to_int f0); simpl in H2; inv H2.
  exists (Vint i); auto.
  inv H4; inv H2; simpl; auto.
  inv H4; inv H2; simpl; auto.
  inv H4; simpl; auto.
  inv H4; simpl; auto.
  subst. destruct (eval_condition c vl1 m1) eqn:?.
  exploit eval_condition_inj; eauto. intros EQ; rewrite EQ.
  destruct b; simpl; constructor.
  simpl; constructor.
Qed.

Lemma eval_addressing_inj:
  forall addr sp1 vl1 sp2 vl2 v1,
  val_inject f sp1 sp2 ->
  Forall2 (val_inject f) vl1 vl2 ->
  eval_addressing genv sp1 addr vl1 = Some v1 ->
  exists v2, eval_addressing genv sp2 addr vl2 = Some v2 /\ val_inject f v1 v2.
Proof.
  intros. destruct addr; simpl in H1; simpl; FuncInv; InvInject; TrivialExists;
    auto using Values.val_add_inject.
Qed.

End EVAL_COMPAT.

(** Compatibility of the evaluation functions with the ``is less defined'' relation over values. *)

Section EVAL_LESSDEF.

Variable F V: Type.
Variable genv: Genv.t F V.

Remark valid_pointer_extends:
  forall m1 m2, Mem.extends m1 m2 ->
  forall b1 ofs b2 delta,
  Some(b1, 0) = Some(b2, delta) ->
  Mem.valid_pointer m1 b1 (Int.unsigned ofs) = true ->
  Mem.valid_pointer m2 b2 (Int.unsigned (Int.add ofs (Int.repr delta))) = true.
Proof.
  intros. inv H0. rewrite Int.add_zero. eapply Mem.valid_pointer_extends; eauto.
Qed.

Remark weak_valid_pointer_extends:
  forall m1 m2, Mem.extends m1 m2 ->
  forall b1 ofs b2 delta,
  Some(b1, 0) = Some(b2, delta) ->
  Mem.weak_valid_pointer m1 b1 (Int.unsigned ofs) = true ->
  Mem.weak_valid_pointer m2 b2 (Int.unsigned (Int.add ofs (Int.repr delta))) = true.
Proof.
  intros. inv H0. rewrite Int.add_zero. eapply Mem.weak_valid_pointer_extends; eauto.
Qed.

Remark weak_valid_pointer_no_overflow_extends:
  forall m1 b1 ofs b2 delta,
  Some(b1, 0) = Some(b2, delta) ->
  Mem.weak_valid_pointer m1 b1 (Int.unsigned ofs) = true ->
  0 <= Int.unsigned ofs + Int.unsigned (Int.repr delta) <= Int.max_unsigned.
Proof.
  intros. inv H. rewrite Zplus_0_r. apply Int.unsigned_range_2.
Qed.

Remark valid_different_pointers_extends:
  forall m1 b1 ofs1 b2 ofs2 b1' delta1 b2' delta2,
  b1 <> b2 ->
  Mem.valid_pointer m1 b1 (Int.unsigned ofs1) = true ->
  Mem.valid_pointer m1 b2 (Int.unsigned ofs2) = true ->
  Some(b1, 0) = Some (b1', delta1) ->
  Some(b2, 0) = Some (b2', delta2) ->
  b1' <> b2' \/
  Int.unsigned(Int.add ofs1 (Int.repr delta1)) <> Int.unsigned(Int.add ofs2 (Int.repr delta2)).
Proof.
  intros. inv H2; inv H3. auto.
Qed.

Lemma eval_condition_lessdef:
  forall cond vl1 vl2 b m1 m2,
  Forall2 Val.lessdef vl1 vl2 ->
  Mem.extends m1 m2 ->
  eval_condition cond vl1 m1 = Some b ->
  eval_condition cond vl2 m2 = Some b.
Proof.
  intros. eapply eval_condition_inj with (f := fun b => Some(b, 0)) (m1 := m1).
  apply valid_pointer_extends; auto.
  apply weak_valid_pointer_extends; auto.
  apply weak_valid_pointer_no_overflow_extends; auto.
  apply valid_different_pointers_extends; auto.
  rewrite <- val_list_inject_lessdef. eauto. auto.
Qed.

Lemma eval_operation_lessdef:
  forall sp op vl1 vl2 v1 m1 m2,
  Forall2 Val.lessdef vl1 vl2 ->
  Mem.extends m1 m2 ->
  eval_operation genv sp op vl1 m1 = Some v1 ->
  exists v2, eval_operation genv sp op vl2 m2 = Some v2 /\ Val.lessdef v1 v2.
Proof.
  intros. rewrite val_list_inject_lessdef in H.
  assert (exists v2 : val,
          eval_operation genv sp op vl2 m2 = Some v2
          /\ val_inject (fun b => Some(b, 0)) v1 v2).
  eapply eval_operation_inj with (m1 := m1) (sp1 := sp).
  intros. rewrite <- val_inject_lessdef; auto.
  apply valid_pointer_extends; auto.
  apply weak_valid_pointer_extends; auto.
  apply weak_valid_pointer_no_overflow_extends; auto.
  apply valid_different_pointers_extends; auto.
  rewrite <- val_inject_lessdef; auto.
  eauto. auto.
  destruct H2 as [v2 [A B]]. exists v2; split; auto. rewrite val_inject_lessdef; auto.
Qed.

Lemma eval_addressing_lessdef:
  forall sp addr vl1 vl2 v1,
  Forall2 Val.lessdef vl1 vl2 ->
  eval_addressing genv sp addr vl1 = Some v1 ->
  exists v2, eval_addressing genv sp addr vl2 = Some v2 /\ Val.lessdef v1 v2.
Proof.
  intros. rewrite val_list_inject_lessdef in H.
  assert (exists v2 : val,
          eval_addressing genv sp addr vl2 = Some v2
          /\ val_inject (fun b => Some(b, 0)) v1 v2).
  eapply eval_addressing_inj with (sp1 := sp).
  intros. rewrite <- val_inject_lessdef; auto.
  rewrite <- val_inject_lessdef; auto.
  eauto. auto.
  destruct H1 as [v2 [A B]]. exists v2; split; auto. rewrite val_inject_lessdef; auto.
Qed.

End EVAL_LESSDEF.

(** Compatibility of the evaluation functions with memory injections. *)

Section EVAL_INJECT.

Variable F V: Type.
Variable genv: Genv.t F V.
Variable f: meminj.
Hypothesis globals: meminj_preserves_globals genv f.
Variable sp1: block.
Variable sp2: block.
Variable delta: Z.
Hypothesis sp_inj: f sp1 = Some(sp2, delta).

Remark symbol_address_inject:
  forall id ofs, val_inject f (Genv.symbol_address genv id ofs) (Genv.symbol_address genv id ofs).
Proof.
  intros. unfold Genv.symbol_address. destruct (Genv.find_symbol genv id) eqn:?; auto.
  exploit meminj_preserves_symbol; eauto. intros.
  econstructor; eauto. rewrite Int.add_zero; auto.
Qed.

Lemma eval_condition_inject:
  forall cond vl1 vl2 b m1 m2,
  Forall2 (val_inject f) vl1 vl2 ->
  Mem.inject f m1 m2 ->
  eval_condition cond vl1 m1 = Some b ->
  eval_condition cond vl2 m2 = Some b.
Proof.
  intros. eapply eval_condition_inj with (f := f) (m1 := m1); eauto.
  intros; eapply Mem.valid_pointer_inject_val; eauto.
  intros; eapply Mem.weak_valid_pointer_inject_val; eauto.
  intros; eapply Mem.weak_valid_pointer_inject_no_overflow; eauto.
  intros; eapply Mem.different_pointers_inject; eauto.
Qed.

Lemma eval_addressing_inject:
  forall addr vl1 vl2 v1,
  Forall2 (val_inject f) vl1 vl2 ->
  eval_addressing genv (Vptr sp1 Int.zero) addr vl1 = Some v1 ->
  exists v2,
     eval_addressing genv (Vptr sp2 Int.zero) (shift_stack_addressing (Int.repr delta) addr) vl2 = Some v2
  /\ val_inject f v1 v2.
Proof.
  intros.
  rewrite eval_shift_stack_addressing. simpl.
  eapply eval_addressing_inj with (sp1 := Vptr sp1 Int.zero); eauto.
  exact symbol_address_inject.
Qed.

Lemma eval_operation_inject:
  forall op vl1 vl2 v1 m1 m2,
  Forall2 (val_inject f) vl1 vl2 ->
  Mem.inject f m1 m2 ->
  eval_operation genv (Vptr sp1 Int.zero) op vl1 m1 = Some v1 ->
  exists v2,
     eval_operation genv (Vptr sp2 Int.zero) (shift_stack_operation (Int.repr delta) op) vl2 m2 = Some v2
  /\ val_inject f v1 v2.
Proof.
  intros.
  rewrite eval_shift_stack_operation. simpl.
  eapply eval_operation_inj with (sp1 := Vptr sp1 Int.zero) (m1 := m1); eauto.
  exact symbol_address_inject.
  intros; eapply Mem.valid_pointer_inject_val; eauto.
  intros; eapply Mem.weak_valid_pointer_inject_val; eauto.
  intros; eapply Mem.weak_valid_pointer_inject_no_overflow; eauto.
  intros; eapply Mem.different_pointers_inject; eauto.
Qed.

End EVAL_INJECT.

(** * Masks for rotate and mask instructions *)

(** Recognition of integers that are acceptable as immediate operands
  to the [rlwim] PowerPC instruction.  These integers are of the form
  [000011110000] or [111100001111], that is, a run of one bits
  surrounded by zero bits, or conversely.  We recognize these integers by
  running the following automaton on the bits.  The accepting states are
  2, 3, 4, 5, and 6.
<<
               0          1          0
              / \        / \        / \
              \ /        \ /        \ /
        -0--> [1] --1--> [2] --0--> [3]
       /
     [0]
       \
        -1--> [4] --0--> [5] --1--> [6]
              / \        / \        / \
              \ /        \ /        \ /
               1          0          1
>>
*)

Inductive rlw_state: Type :=
  | RLW_S0 : rlw_state
  | RLW_S1 : rlw_state
  | RLW_S2 : rlw_state
  | RLW_S3 : rlw_state
  | RLW_S4 : rlw_state
  | RLW_S5 : rlw_state
  | RLW_S6 : rlw_state
  | RLW_Sbad : rlw_state.

Definition rlw_transition (s: rlw_state) (b: bool) : rlw_state :=
  match s, b with
  | RLW_S0, false => RLW_S1
  | RLW_S0, true  => RLW_S4
  | RLW_S1, false => RLW_S1
  | RLW_S1, true  => RLW_S2
  | RLW_S2, false => RLW_S3
  | RLW_S2, true  => RLW_S2
  | RLW_S3, false => RLW_S3
  | RLW_S3, true  => RLW_Sbad
  | RLW_S4, false => RLW_S5
  | RLW_S4, true  => RLW_S4
  | RLW_S5, false => RLW_S5
  | RLW_S5, true  => RLW_S6
  | RLW_S6, false => RLW_Sbad
  | RLW_S6, true  => RLW_S6
  | RLW_Sbad, _ => RLW_Sbad
  end.

Definition rlw_accepting (s: rlw_state) : bool :=
  match s with
  | RLW_S0 => false
  | RLW_S1 => false
  | RLW_S2 => true
  | RLW_S3 => true
  | RLW_S4 => true
  | RLW_S5 => true
  | RLW_S6 => true
  | RLW_Sbad => false
  end.

Fixpoint is_rlw_mask_rec (n: nat) (s: rlw_state) (x: Z) {struct n} : bool :=
  match n with
  | O =>
      rlw_accepting s
  | S m =>
      is_rlw_mask_rec m (rlw_transition s (Z.odd x)) (Z.div2 x)
  end.

Definition is_rlw_mask (x: int) : bool :=
  is_rlw_mask_rec Int.wordsize RLW_S0 (Int.unsigned x).


Require Import Coq.Sets.Constructive_sets.
Require Import Definitions.
Require Import Operational_Semantics.
Require Import Contracts_Subst.

(*---Well-Formedness of Executions *)
Axiom FW: forall (Ex:Exec), (WF1 Ex) ->(WF2 Ex) ->(WF3 Ex) ->(WF4 Ex) ->(WF5 Ex) ->(WF6 Ex)-> (WF7 Ex) ->(WF Ex).
Axiom WFhelp: forall (Ex:Exec), (WF Ex)->(WF1 Ex)/\(WF2 Ex)/\(WF3 Ex)/\(WF4 Ex)/\(WF5 Ex)/\(WF6 Ex)/\(WF7 Ex).

(*---Freshness of the Newly Generated Effect *)
Axiom Freshness: forall (Θ:Store)(ex1 ex2:Exec) (opk:op_key)(eff:Effect)(r:ReplID),
                   [Θ|-ex1, opk ~r~> ex2, eff] -> forall r, (dom Θ r)-> ~ (Θ r) eff.
Axiom CorrectFreshness: forall(Θ:Store)(ex1 ex2:Exec)(opk:op_key)(eff:Effect)(r:ReplID),
                          [Θ|-ex1, opk ~r~> ex2, eff] -> ~ (ex1-A) eff.

(*---The Definition of Equality of two Session Soups *)
Axiom  Sess_Equal : forall (S S':SessSoup), S=S' <-> forall (I:Soup_Ing), (In Soup_Ing S I <-> In Soup_Ing S' I).

(*---Trivial Facts About Relations*)
Axiom sameobj_trans: forall (Ex:Exec)(a b c: Effect), Ex-sameobj a b -> Ex-sameobj b c -> Ex-sameobj a c.
Axiom Sameobj_Def: forall  (Θ:Store) (Ex Ex':Exec)(opk:op_key) (η:Effect) (r:ReplID) (a b: Effect),
                     [Θ |- Ex, opk ~r~> Ex', η] -> Ex-A a -> Ex-A b -> Ex-sameobj a b.
Axiom SO_Seq_General : forall (Ex:Exec) (a b:Effect), (Ex-so a b) <-> (lt (seq a) (seq b)).

(*---Relating Domain of the Relations to the Universe of Effects*)
Axiom So_Domain :      forall (Ex:Exec)(a:Effect), ((Rel_dom Ex-so a)      -> (Ex-A a)).
Axiom Vis_Domain :     forall (Ex:Exec)(a:Effect), ((Rel_dom Ex-vis a)     -> (Ex-A a)).
Axiom Hbo_Domain :     forall (Ex:Exec)(a:Effect), ((Rel_dom Ex-hbo a)     -> (Ex-A a)).
Axiom Sameobj_Domain : forall (Ex:Exec)(a:Effect), ((Rel_dom Ex-sameobj a) -> (Ex-A a)).

(*---The Conclusion from Equality of Soup Ingredients*)
Axiom Seq_Uniq : forall (i i': SeqNo)(s s': SessID)(σ σ' : session), (<<s , i , σ >>) = (<<s', i' , σ' >>) -> i=i'.

(*--- So only relates effects from the same session*)
Axiom SO_SameSession : forall (Ex:Exec)(eff eff':Effect), Ex-so eff eff' -> (eff.(sess) = eff'.(sess)).

(*---Decidability of Membership of a Soup *)
Axiom Soup_comp : forall (Ex:Exec)(eff:Effect), (Ex-A eff)\/(~ Ex-A eff).

(*---Claimed in the Paper *)
(*3 equal statements to the acyclicity of hb*)
Axiom PaperH8: forall (Ex:Exec)(eff:Effect), ~ (Ex-hb eff eff)-> ((~Ex-vis eff eff) /\ (~ Ex-so eff eff)).

Axiom PaperH8II : forall (Ex:Exec)(eff eff': Effect), ~((Ex-vis eff eff')/\ (Ex-so eff' eff)).

Axiom PaperH8III : forall (Ex:Exec),
                     (forall (eff:Effect), Ex-A eff -> ~ Ex-vis eff eff) ->
                     (forall (eff:Effect), Ex-A eff -> ~ Ex-so  eff eff) ->
                     (forall (eff eff':Effect),Ex-A eff -> Ex-A eff' ->  ~((Ex-vis eff eff')/\ (Ex-so eff' eff))) ->
                     (forall (eff:Effect),~(Ex-hb eff eff)).

(*---Equality if Effect Variables is Reflexive*)
Axiom  Eff_Equi_refl : forall a,  Eff_Equi a a.

(*---Relating Error term, to the domain of the Stores*)
Axiom error_not_domain: forall (r:ReplID)(t:Store),  (t r = St_Dom_Error) <-> (~(dom t) r).

(*---Equaility of ReplIDs is decidable*)
Axiom ReplID_Equality_Decidable: forall (r r':ReplID), (r=r') \/ (r<>r').

(*************************************************************************************************************************)
(*=============================These Were Axioms Before, But Now Are Replaced with Other Axioms and Are Trivially Proved *)

Lemma  SO_NewEff: forall (Θ: Store)(Ex Ex':Exec) (opk:op_key)(η:Effect)(r:ReplID),
                    [Θ|-Ex, opk ~r~> Ex', η] -> (forall a:Effect, Θ r a -> ~ Ex-so η a).
Proof. intuition. apply CorrectFreshness in H. apply WF_Relation with (a:= η) (b:=a) in H1; destruct H1.
       apply So_Domain in H1; auto.
Qed.

Require Import Omega.

Lemma SessionOrder : forall (Ex:Exec)(eff eff':Effect), Ex-so eff eff' -> ((eff.(sess) = eff'.(sess))/\ ((eff.(seq))+1 <= (eff'.(seq)))).
Proof.
  intros Ex a b Hso. split.
  apply SO_SameSession in Hso; auto. apply SO_Seq_General in Hso. intuition.
Qed.

Lemma  SO_Seq : forall (Ex:Exec)(a b c:Effect), Ex-so a b -> seq b = seq c - 1 -> Ex-so a c.
Proof.
  intros Ex a b c. intros Hso Heq. apply SO_Seq_General. apply SO_Seq_General in Hso. intuition.
Qed.

Lemma SO_SeqII' : forall (Ex:Exec)(a b :Effect), (seq b>0)->seq a = seq b -1  -> Ex-so a b.
Proof.
  intros. apply SO_Seq_General. omega.
Qed.

Lemma Eneq_nat_cont : forall i:SeqNo, (i>0)->(i=i-1)\/(i=i+1) -> False.
Proof. intros. omega.
Qed.

Lemma natSeq: forall ss:SeqNo, ~(ss+1 <= (ss-1)).
Proof.
  intros. omega.
Qed.

Lemma  SO_SeqIII : forall (Ex:Exec)(a b c:Effect), Ex-so a b -> Ex-so b c  -> Ex-so a c.
Proof.
  intros.
  apply SO_Seq_General. apply SO_Seq_General in H. apply SO_Seq_General in H0. omega.
Qed.

Lemma Relation_Dom : forall (Ex:Exec) (eff:Effect), (~Ex-A eff ) -> (~Ex-so eff eff).
  Proof.
    intuition. apply WF_Relation with (a:=eff)(b:=eff)(r:=Ex-so) in H0. destruct H0.
    apply So_Domain in H1; auto.
Qed.


Require Import List.
Require Import PeanoNat.
Require Import Orders.
Require Import MSetList.

Require Import sflib.

Require Import DataStructure.
Require Import Basic.
Require Import Loc.

Set Implicit Arguments.

Require Import Integers.
Module Const := Int.

Lemma const_neq_sym:
  forall (x y:Const.t),
    x <> y <-> y <> x.
Proof.
  intros.
  split.
  - intro. intro. rewrite H0 in H. contradiction.
  - intro. intro. rewrite H0 in H. contradiction.
Qed.

Lemma loc_neq_sym:
  forall (x y:Loc.t),
    x <> y <-> y <> x.
Proof.
  intros.
  split.
  - intro. intro. rewrite H0 in H. contradiction.
  - intro. intro. rewrite H0 in H. contradiction.
Qed.

Module Ordering.
  Inductive t :=
  | plain
  | relaxed
  | strong_relaxed
  | acqrel
  | seqcst
  .

  (* loc's access atomicity *)
  Inductive atomicity :=
  | atomic
  | nonatomic
  .

  Definition mem_ord_match (ord: t) (o: atomicity): Prop :=
    match o with
    | nonatomic => ord = plain
    | atomic => (ord = acqrel) \/ (ord = relaxed) \/ (ord = strong_relaxed)
    end
  .

  (** [LocOrdMap]: records predefined atomicity for each location.
      atomic: allow relaxed or stronger access.
      nonatomic: allow plain access.
  *)
  Definition LocOrdMap := Loc.t -> atomicity.

  Definition le (lhs rhs:t): bool :=
    match lhs, rhs with
    | plain, _ => true
    | _, plain => false

    | relaxed, _ => true
    | _, relaxed => false

    | strong_relaxed, _ => true
    | _, strong_relaxed => false

    | acqrel, _ => true
    | _, acqrel => false

    | seqcst, seqcst => true
    end.
  Global Opaque le.

  Global Program Instance le_PreOrder: PreOrder le.
  Next Obligation.
    ii. destruct x; auto.
  Qed.
  Next Obligation.
    ii. destruct x, y, z; auto.
  Qed.
  Hint Resolve le_PreOrder_obligation_2.

  Definition join (lhs rhs:t): t :=
    match lhs, rhs with
    | plain, _ => rhs
    | _, plain => lhs

    | relaxed, _ => rhs
    | _, relaxed => lhs

    | strong_relaxed, _ => rhs
    | _, strong_relaxed => lhs

    | acqrel, _ => rhs
    | _, acqrel => lhs

    | seqcst, _ => rhs
    end.

  Lemma join_comm lhs rhs: join lhs rhs = join rhs lhs.
  Proof. destruct lhs, rhs; ss. Qed.

  Lemma join_assoc a b c: join (join a b) c = join a (join b c).
  Proof. destruct a, b, c; ss. Qed.

  Lemma join_l lhs rhs:
    le lhs (join lhs rhs).
  Proof. destruct lhs, rhs; ss. Qed.

  Lemma join_r lhs rhs:
    le rhs (join lhs rhs).
  Proof. destruct lhs, rhs; ss. Qed.

  Lemma join_spec lhs rhs o
        (LHS: le lhs o)
        (RHS: le rhs o):
    le (join lhs rhs) o.
  Proof. destruct lhs, rhs; ss. Qed.

  Lemma join_cases lhs rhs:
    join lhs rhs = lhs \/ join lhs rhs = rhs.
  Proof. destruct lhs, rhs; auto. Qed.
End Ordering.

(* NOTE (syscall): In fact, syscalls may change the memory, on the
 * contrary to what is currently defined.
 *)
(* NOTE (syscall): we disallow syscalls in the validation of the
 * consistency check, as syscall's results are not predictable.
 *)
Module Event.
  Structure t := mk {
    output: Const.t;
    (* inputs: list Const.t;   *)
  }.
End Event.

(** ** Observable event *)
(** Observable event includes:
    - [output]: for system call;
    - [abort]: for program abort;
    - [done]: for program done. *)
Module VisibleEvent.
  Inductive t :=
  | out (e: Event.t)
  | abort
  | done.
End VisibleEvent.

Module AuxEvent.
  Inductive t :=
  | na
  | prc
  | atm
  | out (e: Event.t)
  | sw
  | tterm
  .
End AuxEvent.

(** ** Program transition event (or machine evet) *)
(** Program transition event includes:
    - [silent]: silent step;
    - [switch]: thread switching;
    - [syscall]: system call (observable event). *)
Module MachineEvent.
  Inductive t :=
  | silent
  | switch
  | syscall (e: Event.t)
  .
End MachineEvent.

Module ProgramEvent.
  Inductive t :=
  | silent
  | read (loc:Loc.t) (val:Const.t) (ord:Ordering.t)
  | write (loc:Loc.t) (val:Const.t) (ord:Ordering.t)
  | update (loc:Loc.t) (valr valw:Const.t) (ordr ordw:Ordering.t)
  | fence (ordr ordw:Ordering.t)
  | syscall (e:Event.t)
  .

  Definition is_reading (e:t): option (Loc.t * Const.t * Ordering.t) :=
    match e with
    | read loc val ord => Some (loc, val, ord)
    | update loc valr _ ordr _ => Some (loc, valr, ordr)
    | _ => None
    end.

  Definition is_writing (e:t): option (Loc.t * Const.t * Ordering.t) :=
    match e with
    | write loc val ord => Some (loc, val, ord)
    | update loc _ valw _ ordw => Some (loc, valw, ordw)
    | _ => None
    end.

  Definition is_updating (e:t): option (Loc.t * Const.t * Ordering.t) :=
    match e with
    | update loc valr _ ordr _ => Some (loc, valr, ordr)
    | _ => None
    end.

End ProgramEvent.