Require Import Verdi.GhostSimulations.
Require Import VerdiRaft.Raft.
Require Import VerdiRaft.CommonTheorems.
Require Import VerdiRaft.OneLeaderPerTermInterface.

Require Import VerdiRaft.CandidateEntriesInterface.
Require Import VerdiRaft.RaftRefinementInterface.
Require Import VerdiRaft.VotesCorrectInterface.
Require Import VerdiRaft.CroniesCorrectInterface.
Require Import VerdiRaft.RefinementCommonTheorems.

Require Import VerdiRaft.LeaderSublogInterface.

Hint Extern 4 (@BaseParams) => apply base_params : typeclass_instances.
Hint Extern 4 (@MultiParams _) => apply multi_params : typeclass_instances.
Hint Extern 4 (@FailureParams _ _) => apply failure_params : typeclass_instances.

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

  Context {rri : raft_refinement_interface}.
  Context {cei : candidate_entries_interface}.
  Context {vci : votes_correct_interface}.
  Context {cci : cronies_correct_interface}.
  Context {olpti : one_leader_per_term_interface}.

  Ltac prove_in :=
    match goal with
      | [ _ : nwPackets ?net = _,
              _ : In (?p : packet) _ |- _] =>
        assert (In p (nwPackets net)) by (repeat find_rewrite; do_in_app; intuition)
      | [ _ : nwPackets ?net = _,
              _ : pBody ?p = _ |- _] =>
        assert (In p (nwPackets net)) by (repeat find_rewrite; intuition)
    end.

  Notation is_append_entries m :=
    (exists t n prevT prevI entries c,
       m = AppendEntries t n prevT prevI entries c).

  Lemma leader_sublog_invariant_same_state :
    forall net net',
      leader_sublog_host_invariant net ->
      (forall h, log (nwState net h) = log (nwState net' h)) ->
      (forall h, type (nwState net' h) = Leader ->
            type (nwState net h) = Leader /\
            currentTerm (nwState net h) = currentTerm (nwState net' h)) ->
      leader_sublog_host_invariant net'.
  Proof using.
    unfold leader_sublog_host_invariant in *. intros.
    specialize (H leader e h).
    forward H; [apply H1; auto|].
    intuition.
    rewrite H0 in *. specialize (H1 leader). intuition.
    rewrite H7 in *; auto.
    rewrite H0 in *. auto.
  Qed.

  Lemma leader_sublog_invariant_subset :
    forall net net',
      leader_sublog_invariant net ->
      (forall p, is_append_entries (pBody p) -> In p (nwPackets net') -> In p (nwPackets net)) ->
      (forall h, log (nwState net h) = log (nwState net' h)) ->
      (forall h, type (nwState net' h) = Leader ->
            type (nwState net h) = Leader /\
            currentTerm (nwState net h) = currentTerm (nwState net' h)) ->
      leader_sublog_invariant net'.
  Proof using.
    unfold leader_sublog_invariant in *. intros; intuition.
    - eauto using leader_sublog_invariant_same_state.
    - unfold leader_sublog_nw_invariant in *. intros.
      pose proof H1 leader.
      pose proof H2 leader; concludes.
      pose proof H3 leader. intuition.
      symmetry in H13.
      repeat find_rewrite.
      eapply H11; simpl in *; repeat find_rewrite; eauto.
      assert (is_append_entries (pBody p)) by (repeat eexists; eauto).
      eauto.
  Qed.

  Theorem leader_sublog_do_leader :
    raft_net_invariant_do_leader leader_sublog_invariant.
  Proof using.
    unfold raft_net_invariant_do_leader.
    intros.
    unfold doLeader in *.
    break_match; try solve [
                       find_inversion; simpl in *;
                       eapply leader_sublog_invariant_subset;
                       eauto; intuition; simpl in *;
                       repeat find_apply_hyp_hyp; intuition;
                       repeat find_higher_order_rewrite; repeat break_if; subst; intuition].
    break_if.
    - unfold replicaMessage in *. find_inversion. simpl in *.
      unfold leader_sublog_invariant in *; intuition.
      + unfold leader_sublog_host_invariant in *. intros.
        simpl in *. repeat find_higher_order_rewrite.
        repeat break_if; simpl in *; intuition eauto.
      + unfold leader_sublog_nw_invariant in *. intros.
        simpl in *. repeat find_higher_order_rewrite.
        find_apply_hyp_hyp.
        break_if; intuition idtac; simpl in *; subst; intuition eauto;
        simpl in *;
        repeat do_in_map; subst; simpl in *;
        find_inversion; eauto using findGtIndex_in.
    - find_inversion.
      unfold leader_sublog_invariant, leader_sublog_nw_invariant,
      leader_sublog_host_invariant, advanceCommitIndex in *.

      intuition; find_higher_order_rewrite; repeat break_if; simpl in *; subst;
      repeat break_if; simpl in *; eauto;
      find_apply_hyp_hyp; intuition; eauto.
  Qed.

  Lemma leader_sublog_client_request :
    raft_net_invariant_client_request leader_sublog_invariant.
  Proof using olpti.
    unfold raft_net_invariant_client_request.
    intros.
    unfold leader_sublog_invariant, leader_sublog_nw_invariant,
    leader_sublog_host_invariant, handleClientRequest in *. intuition idtac.
    - break_match; find_inversion; simpl in *; repeat find_higher_order_rewrite;
      repeat break_if; subst; simpl in *;
      intuition eauto;
      simpl in *; in_crush_finish; intuition eauto. in_crush; eauto.
      exfalso.
      match goal with
        | H : raft_intermediate_reachable _ |- _ =>
          eapply one_leader_per_term_invariant in H
      end.
      assert (leader = h) by (eapply_prop one_leader_per_term; eauto).
      intuition.
    - break_match; find_inversion; simpl in *; repeat find_higher_order_rewrite;
      repeat break_if; find_apply_hyp_hyp; intuition eauto; subst.
      simpl in *.
      in_crush; eauto.
  Qed.

  Lemma leader_sublog_timeout :
    raft_net_invariant_timeout
      leader_sublog_invariant.
  Proof using.
    unfold raft_net_invariant_timeout. intros.
    unfold leader_sublog_invariant, leader_sublog_nw_invariant,
    leader_sublog_host_invariant, handleTimeout, tryToBecomeLeader in *.
    intuition idtac; simpl in *.
    - repeat find_higher_order_rewrite; repeat break_match; repeat find_inversion;
      subst; simpl in *;
      intuition eauto; solve_by_inversion.
    - repeat find_higher_order_rewrite; repeat break_match; repeat find_inversion;
      subst; simpl in *;
      intuition eauto;
      find_apply_hyp_hyp; intuition eauto; try solve_by_inversion;
      in_crush; repeat find_inversion; discriminate.
  Qed.

  Lemma leader_sublog_append_entries :
    raft_net_invariant_append_entries
      leader_sublog_invariant.
  Proof using.
    unfold raft_net_invariant_append_entries. intros.
    unfold leader_sublog_invariant, leader_sublog_nw_invariant,
    leader_sublog_host_invariant, handleAppendEntries, advanceCurrentTerm in *.
    intuition idtac; simpl in *.
    - repeat find_higher_order_rewrite; repeat break_match; repeat find_inversion;
      subst; simpl in *;
      intuition eauto; try solve_by_inversion;
      do_in_app; intuition; eauto using removeAfterIndex_in.
    - repeat find_higher_order_rewrite; repeat break_match; repeat find_inversion;
      subst; simpl in *;
      intuition eauto;
      find_apply_hyp_hyp; intuition eauto; subst; try discriminate.
  Qed.

  Lemma leader_sublog_append_entries_reply :
    raft_net_invariant_append_entries_reply
      leader_sublog_invariant.
  Proof using.
    unfold raft_net_invariant_append_entries_reply. intros.
    unfold leader_sublog_invariant, leader_sublog_nw_invariant,
    leader_sublog_host_invariant, handleAppendEntriesReply, advanceCurrentTerm in *.
    intuition idtac; simpl in *.
    - repeat find_higher_order_rewrite; repeat break_match; repeat find_inversion;
      subst; simpl in *;
      intuition eauto; try solve_by_inversion.
    - repeat find_higher_order_rewrite; repeat break_match; repeat find_inversion;
      subst; simpl in *;
      intuition eauto;
      find_apply_hyp_hyp; intuition eauto; try discriminate.
  Qed.

  Lemma leader_sublog_request_vote :
    raft_net_invariant_request_vote
      leader_sublog_invariant.
  Proof using.
    unfold raft_net_invariant_request_vote. intros.
    unfold leader_sublog_invariant, leader_sublog_nw_invariant,
    leader_sublog_host_invariant, handleRequestVote, advanceCurrentTerm in *.
    intuition idtac; simpl in *.
    - repeat find_higher_order_rewrite; repeat break_match; repeat find_inversion;
      subst; simpl in *;
      intuition eauto; try solve_by_inversion.
    - repeat find_higher_order_rewrite; repeat break_match; repeat find_inversion;
      subst; simpl in *;
      intuition eauto;
      find_apply_hyp_hyp; intuition eauto; subst; try discriminate.
  Qed.

  Definition CandidateEntriesLowered net e h :=
      currentTerm (nwState net h) = eTerm e ->
      wonElection (dedup name_eq_dec (votesReceived (nwState net h))) = true ->
      type (nwState net h) <> Candidate.

  Lemma candidate_entries_lowered' :
    forall net,
      CandidateEntries net ->
      votes_correct net ->
      cronies_correct net ->
      forall h h' e,
        In e (log (snd (nwState net h'))) ->
        CandidateEntriesLowered (deghost net) e h.
  Proof using rri.
    unfold CandidateEntriesLowered, CandidateEntries, votes_correct, cronies_correct.
    intros. break_and.
    rewrite deghost_spec.

    apply_prop_hyp candidateEntries_host_invariant In.
    eapply candidateEntries_wonElection; auto; repeat find_rewrite_lem deghost_spec; eauto.
  Qed.

  Lemma candidate_entries_lowered :
    forall net,
      raft_intermediate_reachable net ->
      forall h h' e,
        In e (log (nwState net h')) ->
        CandidateEntriesLowered net e h.
  Proof using cci vci cei rri.
    intros net H.
    pattern net.
    apply lower_prop; auto.
    clear H net.
    intros.
    repeat match goal with
           | [ H : _ |- _ ] => rewrite deghost_spec in H
           end.
    eapply candidate_entries_lowered';
      eauto using candidate_entries_invariant, votes_correct_invariant, cronies_correct_invariant.
  Qed.

  Definition CandidateEntriesLowered_rvr net e p :=
    In p (nwPackets net) ->
    pBody p = RequestVoteReply (eTerm e) true ->
    currentTerm (nwState net (pDst p)) = eTerm e ->
    wonElection (dedup name_eq_dec (pSrc p :: votesReceived (nwState net (pDst p)))) = true ->
    type (nwState net (pDst p)) <> Candidate.

  Lemma deghost_packet_exists :
    forall net p,
      In p (nwPackets (deghost net)) ->
      exists (q : packet (params := raft_refined_multi_params (raft_params := raft_params))),
        In q (nwPackets net) /\ p = deghost_packet q.
  Proof using.
    unfold deghost.
    simpl.
    intros.
    do_in_map.
    eauto.
  Qed.

  Lemma candidate_entries_lowered_rvr' :
    forall net,
      CandidateEntries net ->
      votes_correct net ->
      cronies_correct net ->
      forall p h e,
        In e (log (snd (nwState net h))) ->
        CandidateEntriesLowered_rvr (deghost net) e p.
  Proof using rri.
    unfold CandidateEntriesLowered_rvr, CandidateEntries.
    intros. break_and.
    rewrite deghost_spec.

    find_apply_lem_hyp deghost_packet_exists.
    break_exists.  break_and. subst.

    apply_prop_hyp candidateEntries_host_invariant In.
    eapply wonElection_candidateEntries_rvr; auto;
    repeat find_rewrite_lem deghost_spec; eauto.
  Qed.

  Lemma candidate_entries_lowered_rvr :
    forall net,
      raft_intermediate_reachable net ->
      forall p h e,
        In e (log (nwState net h)) ->
        CandidateEntriesLowered_rvr net e p.
  Proof using cci vci cei rri.
    intros net H.
    pattern net.
    apply lower_prop; auto.
    clear H net.
    intros.
    repeat match goal with
           | [ H : _ |- _ ] => rewrite deghost_spec in H
           end.
    eapply candidate_entries_lowered_rvr';
      eauto using candidate_entries_invariant, votes_correct_invariant, cronies_correct_invariant.
  Qed.

  Lemma candidate_entries_lowered_nw' :
    forall net,
      CandidateEntries net ->
      votes_correct net ->
      cronies_correct net ->
      forall h p e t li pli plt es lc,
        pBody p = AppendEntries t li pli plt es lc ->
        In p (nwPackets (deghost net)) ->
        In e es ->
        CandidateEntriesLowered (deghost net) e h.
  Proof using rri.
    unfold CandidateEntriesLowered, CandidateEntries, votes_correct, cronies_correct.
    intros. break_and.
    rewrite deghost_spec.

    find_apply_lem_hyp deghost_packet_exists.
    break_exists. break_and. subst.

    eapply_prop_hyp candidateEntries_nw_invariant In; eauto.
    unfold candidateEntries in *. break_exists. break_and.
    match goal with
    | H : wonElection _ = _ |- _ =>
      eapply wonElection_one_in_common in H; [|clear H; eauto]
    end.
    break_exists. break_and.
    repeat match goal with
           | [ H : _ |- _ ] => rewrite deghost_spec in H
           end.

    intro.
    assert (h = x0).
    {
      eapply_prop one_vote_per_term;
      eapply_prop cronies_votes.
      - eapply_prop votes_received_cronies; eauto.
      - find_reverse_rewrite. auto.
    }
    subst.
    concludes. contradiction.
  Qed.

  Lemma candidate_entries_lowered_nw :
    forall net,
      raft_intermediate_reachable net ->
      forall h p e t li pli plt es lc,
        pBody p = AppendEntries t li pli plt es lc ->
        In p (nwPackets net) ->
        In e es ->
        CandidateEntriesLowered net e h.
  Proof using cci vci cei rri.
    intros net H.
    pattern net.
    apply lower_prop; auto.
    clear H net.
    intros.
    repeat match goal with
           | [ H : _ |- _ ] => rewrite deghost_spec in H
           end.
    eapply candidate_entries_lowered_nw';
      eauto using candidate_entries_invariant, votes_correct_invariant, cronies_correct_invariant.
  Qed.

  Lemma candidate_entries_lowered_nw_rvr' :
    forall net,
      CandidateEntries net ->
      votes_correct net ->
      cronies_correct net ->
      forall p' p e t li pli plt es lc,
        pBody p = AppendEntries t li pli plt es lc ->
        In p (nwPackets (deghost net)) ->
        In e es ->
        CandidateEntriesLowered_rvr (deghost net) e p'.
  Proof using rri.
    unfold CandidateEntriesLowered_rvr, CandidateEntries, votes_correct, cronies_correct.
    intros. break_and.
    rewrite deghost_spec.

    find_apply_lem_hyp deghost_packet_exists.
    find_apply_lem_hyp deghost_packet_exists.
    break_exists.  break_and. subst.
    eapply_prop_hyp votes_nw pBody. concludes.
    eapply_prop_hyp candidateEntries_nw_invariant pBody; auto.

    find_insterU. conclude_using eauto.
    unfold candidateEntries in *.
    break_exists. break_and.

    match goal with
    | H : wonElection _ = _ |- _ =>
      eapply wonElection_one_in_common in H; [|clear H; eauto]
    end.
    break_exists. break_and.
    repeat match goal with
           | [ H : _ |- _ ] => rewrite deghost_spec in H
           end.
    simpl in *.
    break_or_hyp.
    - apply_prop_hyp cronies_votes In.
      assert (pDst x = x1) by (eapply_prop one_vote_per_term; eauto).
      subst. auto.
    - intro.
      assert (pDst x = x1).
      { eapply_prop one_vote_per_term;
        eapply_prop cronies_votes.
        - eapply_prop votes_received_cronies; eauto.
        - repeat find_reverse_rewrite. auto.
      }
      subst.
      concludes. contradiction.
  Qed.

  Lemma candidate_entries_lowered_nw_rvr :
    forall net,
      raft_intermediate_reachable net ->
      forall p' p e t li pli plt es lc,
        pBody p = AppendEntries t li pli plt es lc ->
        In p (nwPackets net) ->
        In e es ->
        CandidateEntriesLowered_rvr net e p'.
  Proof using cci vci cei rri.
    intros net H.
    pattern net.
    apply lower_prop; auto.
    clear H net.
    intros.
    repeat match goal with
           | [ H : _ |- _ ] => rewrite deghost_spec in H
           end.
    eapply candidate_entries_lowered_nw_rvr';
      eauto using candidate_entries_invariant, votes_correct_invariant, cronies_correct_invariant.
  Qed.

  Lemma leader_sublog_request_vote_reply :
    raft_net_invariant_request_vote_reply
      leader_sublog_invariant.
  Proof using cci vci cei rri.
    unfold raft_net_invariant_request_vote_reply.
    unfold leader_sublog_invariant, leader_sublog_nw_invariant,
           leader_sublog_host_invariant, handleRequestVoteReply, advanceCurrentTerm.
    intuition idtac; simpl in *.
    - repeat find_higher_order_rewrite; repeat break_match; repeat find_inversion;
      subst; simpl in *; intuition eauto; try discriminate.
      + exfalso. eapply candidate_entries_lowered; eauto.
      + rewrite dedup_not_in_cons in * by auto.
        exfalso. eapply candidate_entries_lowered_rvr; eauto.
        do_bool.
        find_rewrite.
        f_equal.
        omega.
    - repeat find_higher_order_rewrite; repeat break_match; repeat find_inversion;
      subst; simpl in *; intuition eauto;
      find_apply_hyp_hyp; intuition eauto; subst; try discriminate.
      + exfalso. eapply candidate_entries_lowered_nw; eauto.
      + rewrite dedup_not_in_cons in * by auto.
        exfalso. eapply candidate_entries_lowered_nw_rvr; eauto.
        do_bool.
        find_rewrite.
        f_equal.
        omega.
  Qed.

  Lemma leader_sublog_do_generic_server :
    raft_net_invariant_do_generic_server
      leader_sublog_invariant.
  Proof using.
    unfold raft_net_invariant_do_generic_server.
    intros.
    unfold leader_sublog_invariant, leader_sublog_nw_invariant,
    leader_sublog_host_invariant, doGenericServer in *.
    intuition idtac; simpl in *.
    - repeat find_higher_order_rewrite; repeat break_match; repeat find_inversion;
      use_applyEntries_spec;
      subst; simpl in *;
      intuition eauto;
      try solve_by_inversion.
    - repeat find_higher_order_rewrite; repeat break_match; repeat find_inversion;
      use_applyEntries_spec;
      subst; simpl in *;
      intuition eauto;
      find_apply_hyp_hyp; intuition eauto; subst; try discriminate.
  Qed.

  Lemma leader_sublog_state_same_packet_subset :
    raft_net_invariant_state_same_packet_subset
      leader_sublog_invariant.
  Proof using.
    unfold raft_net_invariant_state_same_packet_subset.
    intros.
    unfold leader_sublog_invariant, leader_sublog_nw_invariant,
    leader_sublog_host_invariant in *. intuition idtac;
      repeat find_reverse_higher_order_rewrite; intuition eauto.
  Qed.

  Lemma leader_sublog_reboot :
    raft_net_invariant_reboot
      leader_sublog_invariant.
  Proof using.
    unfold raft_net_invariant_reboot. intros.
    unfold leader_sublog_invariant, leader_sublog_nw_invariant,
    leader_sublog_host_invariant, reboot in *. intuition idtac.
    - repeat find_higher_order_rewrite.
      simpl in *. repeat break_match; subst; simpl in *; intuition eauto; discriminate.
    - repeat find_higher_order_rewrite.
      simpl in *. repeat find_rewrite.
      repeat break_match; subst; simpl in *;
      intuition eauto; try discriminate.
  Qed.

  Theorem leader_sublog_init :
    raft_net_invariant_init leader_sublog_invariant.
  Proof using.
    unfold raft_net_invariant_init, leader_sublog_invariant,
    leader_sublog_host_invariant, leader_sublog_nw_invariant;
    intuition.
  Qed.

  Theorem leader_sublog_invariant_invariant :
    forall net,
      raft_intermediate_reachable net ->
      leader_sublog_invariant net.
  Proof using olpti cci vci cei rri.
    intros.
    eapply raft_net_invariant; eauto.
    - apply leader_sublog_init.
    - apply leader_sublog_client_request.
    - apply leader_sublog_timeout.
    - apply leader_sublog_append_entries.
    - apply leader_sublog_append_entries_reply.
    - apply leader_sublog_request_vote.
    - apply leader_sublog_request_vote_reply.
    - apply leader_sublog_do_leader.
    - apply leader_sublog_do_generic_server.
    - apply leader_sublog_state_same_packet_subset.
    - apply leader_sublog_reboot.
  Qed.

  Instance lsi : leader_sublog_interface.
  Proof.
    split.
    auto using leader_sublog_invariant_invariant.
  Qed.
End LeaderSublogProof.


Require Import VST.msl.msl_standard.
Require Import VST.veric.base.
Require Import VST.veric.compcert_rmaps.
Require Import VST.veric.tycontext.
Require Import VST.veric.Clight_lemmas.
Require Export VST.veric.expr.

Lemma neutral_cast_lemma: forall t1 t2 v,
  is_neutral_cast t1 t2 = true ->
  tc_val t1 v -> eval_cast t1 t2 v = v.
Proof.
intros.
assert (- two_p (16-1) < Byte.min_signed) by (compute; congruence).
assert (two_p (16-1) > Byte.max_signed) by (compute; congruence).
assert (two_p 16 > Byte.max_unsigned) by (compute; congruence).
assert (- two_p (8-1) = Byte.min_signed) by reflexivity.
assert (two_p (8-1) - 1 = Byte.max_signed) by reflexivity.
assert (two_p 8 - 1 = Byte.max_unsigned) by reflexivity.
 destruct t1 as [ | [ | | | ] [ | ] | | [ | ] | | | | | ],
 t2 as [ | [ | | | ] [ | ] | | [ | ] | | | | | ];
 unfold eval_cast, sem_cast, classify_cast,
  sem_cast_pointer, sem_cast_i2bool, sem_cast_l2bool;
try solve [
 try match goal with |- context [Archi.ptr64] => destruct Archi.ptr64 end;
 inversion H; clear H; try reflexivity;
 destruct v; unfold tc_val, is_int in H0; try contradiction;
 simpl; f_equal;
 try (first [apply sign_ext_inrange| apply zero_ext_inrange];
       try omega;
    match type of H0 with _ \/ _ =>
       destruct H0; subst i; simpl;
       try  rewrite Int.signed_zero;
       try  rewrite Int.unsigned_zero;
       try change (Int.signed Int.one) with 1;
       try change (Int.unsigned Int.one) with 1;
       clear; compute; split; congruence
    end);
 try (destruct H0; subst i; try rewrite Int.eq_true; auto)].
 unfold is_neutral_cast in H.
 rewrite orb_true_iff in H.
 destruct H.
 apply eqb_type_true in H. rewrite <- H in *.
 unfold tc_val in H0.
 rewrite eqb_reflx.
 if_tac in H0; destruct v; inv H0; reflexivity.
 rewrite andb_true_iff in H. destruct H.
 destruct (eqb_type (Tpointer t1 a) int_or_ptr_type); inv H.
 destruct (eqb_type (Tpointer t2 a0) int_or_ptr_type); inv H7.
 simpl.
 unfold tc_val in H0.
 if_tac in H0; destruct v; inv H0; reflexivity.
Qed.

Lemma neutral_cast_subsumption: forall t1 t2 v,
  is_neutral_cast t1 t2 = true ->
  tc_val t1 v -> tc_val t2 v.
Proof.
intros.
assert (- two_p (16-1) < Byte.min_signed) by (compute; congruence).
assert (two_p (16-1) > Byte.max_signed) by (compute; congruence).
assert (two_p 16 > Byte.max_unsigned) by (compute; congruence).
assert (- two_p (8-1) = Byte.min_signed) by reflexivity.
assert (two_p (8-1) - 1 = Byte.max_signed) by reflexivity.
assert (two_p 8 - 1 = Byte.max_unsigned) by reflexivity.
destruct t1 as [ | [ | | | ] [ | ] | | [ | ] | | | | | ],
 t2   as [ | [ | | | ] [ | ] | | [ | ] | | | | | ]; inv H;
 destruct v; try solve [contradiction H0]; try apply I;
 unfold tc_val, is_int in *;
  auto;
 try omega;
 try
    match type of H0 with _ \/ _ =>
       destruct H0; subst i; simpl;
       try  rewrite Int.signed_zero;
       try  rewrite Int.unsigned_zero;
       try change (Int.signed Int.one) with 1;
       try change (Int.unsigned Int.one) with 1;
       clear; compute; try split; congruence
    end;
 try ( if_tac in H0; contradiction H0).
 destruct (eqb_type (Tpointer t2 a0) int_or_ptr_type) eqn:?H.
 apply I.
 apply eqb_type_false in H.
 destruct (eqb_type (Tpointer t1 a) int_or_ptr_type) eqn:?H; auto.
 apply eqb_type_true in H7. inv H7. simpl in *.
 rewrite orb_false_r in H8.
 rewrite andb_true_iff in H8. destruct H8.
 destruct t2; inv H7.
 destruct a0.
 destruct attr_volatile; try solve [inv H8].
 simpl in H8.
 destruct attr_alignas; try solve [inv H8].
 destruct n as [ [ | ] | ]; try solve [inv H8].
 apply Peqb_true_eq in H8. subst p.
 contradiction H. reflexivity.
 destruct (eqb_type (Tpointer t2 a0) int_or_ptr_type) eqn:?H.
 apply I.
 apply I.
Qed.

(** Denotation functions for each of the assertions that can be produced by the typechecker **)

Definition denote_tc_iszero v : mpred :=
         match v with
         | Vint i => prop (is_true (Int.eq i Int.zero))
         | Vlong i => prop (is_true (Int64.eq (Int64.repr (Int64.unsigned i)) Int64.zero))
         | _ => FF
         end.

Definition denote_tc_nonzero v : mpred :=
         match v with
         | Vint i => if negb (Int.eq i Int.zero) then TT else FF
         | Vlong i => if negb (Int64.eq i Int64.zero) then TT else FF
         | _ => FF end.

Definition denote_tc_igt i v : mpred :=
     match v with
     | Vint i1 => prop (is_true (Int.ltu i1 i))
     | _ => FF
     end.

Definition denote_tc_lgt l v : mpred :=
     match v with
     | Vlong l1 => prop (is_true (Int64.ltu l1 l))
     | _ => FF
     end.

Definition Zoffloat (f:float): option Z := (**r conversion to Z *)
  match f with
    | Fappli_IEEE.B754_finite s m (Zpos e) _ =>
       Some (Fcore_Zaux.cond_Zopp s (Zpos m) * Zpower_pos 2 e)
    | Fappli_IEEE.B754_finite s m 0 _ => Some (Fcore_Zaux.cond_Zopp s (Zpos m))
    | Fappli_IEEE.B754_finite s m (Zneg e) _ => Some (Fcore_Zaux.cond_Zopp s (Zpos m / Zpower_pos 2 e))
    | Fappli_IEEE.B754_zero _ => Some 0
    | _ => None
  end.  (* copied from CompCert 2.3, because it's missing in CompCert 2.4 *)

Definition Zofsingle (f: float32): option Z := (**r conversion to Z *)
  match f with
    | Fappli_IEEE.B754_finite s m (Zpos e) _ =>
       Some (Fcore_Zaux.cond_Zopp s (Zpos m) * Zpower_pos 2 e)
    | Fappli_IEEE.B754_finite s m 0 _ => Some (Fcore_Zaux.cond_Zopp s (Zpos m))
    | Fappli_IEEE.B754_finite s m (Zneg e) _ => Some (Fcore_Zaux.cond_Zopp s (Zpos m / Zpower_pos 2 e))
    | Fappli_IEEE.B754_zero _ => Some 0
    | _ => None
  end.  (* copied from CompCert 2.3, because it's missing in CompCert 2.4 *)

Definition denote_tc_Zge z v : mpred :=
          match v with
                     | Vfloat f => match Zoffloat f with
                                    | Some n => prop (is_true (Zge_bool z n))
                                    | None => FF
                                   end
                     | Vsingle f => match Zofsingle f with
                                    | Some n => prop (is_true (Zge_bool z n))
                                    | None => FF
                                   end
                     | _ => FF
                  end.

Definition denote_tc_Zle z v : mpred :=
          match v with
                     | Vfloat f => match Zoffloat f with
                                    | Some n => prop (is_true (Zle_bool z n))
                                    | None => FF
                                   end
                     | Vsingle f => match Zofsingle f with
                                    | Some n => prop (is_true (Zle_bool z n))
                                    | None => FF
                                   end
                     | _ => FF
                  end.

Definition sameblock v1 v2 : bool :=
         match v1, v2 with
          | Vptr b1 _, Vptr b2 _ => peq b1 b2
          | _, _ => false
         end.

Definition denote_tc_samebase v1 v2 : mpred :=
       prop (is_true (sameblock v1 v2)).

(** Case for division of int min by -1, which would cause overflow **)
Definition denote_tc_nodivover v1 v2 : mpred :=
match v1, v2 with
          | Vint n1, Vint n2 => prop (is_true (negb
                                   (Int.eq n1 (Int.repr Int.min_signed)
                                    && Int.eq n2 Int.mone)))
          | Vlong n1, Vlong n2 => prop (is_true (negb
                                   (Int64.eq n1 (Int64.repr Int64.min_signed)
                                    && Int64.eq n2 Int64.mone)))
          | Vint n1, Vlong n2 => TT
          | Vlong n1, Vint n2 => prop (is_true (negb
                                   (Int64.eq n1 (Int64.repr Int64.min_signed)
                                    && Int.eq n2 Int.mone)))
          | _ , _ => FF
        end.

Definition denote_tc_nosignedover (op: Z->Z->Z) v1 v2 : mpred :=
 match v1,v2 with
 | Vint n1, Vint n2 =>
   prop (Int.min_signed <= op (Int.signed n1) (Int.signed n2) <= Int.max_signed)
 | Vlong n1, Vlong n2 =>
   prop (Int64.min_signed <= op (Int64.signed n1) (Int64.signed n2) <= Int64.max_signed)
 | Vint n1, Vlong n2 =>
   prop (Int64.min_signed <= op (Int.signed n1) (Int64.signed n2) <= Int64.max_signed)
 | Vlong n1, Vint n2 =>
   prop (Int64.min_signed <= op (Int64.signed n1) (Int.signed n2) <= Int64.max_signed)
 | _, _ => FF
 end.

Definition denote_tc_initialized id ty rho : mpred :=
    prop (exists v, Map.get (te_of rho) id = Some v
               /\ tc_val ty v).

Definition denote_tc_isptr v : mpred :=
  prop (isptr v).

Definition test_eq_ptrs v1 v2 : mpred :=
  if sameblock v1 v2
  then (andp (weak_valid_pointer v1) (weak_valid_pointer v2))
  else (andp (valid_pointer v1) (valid_pointer v2)).

Definition test_order_ptrs v1 v2 : mpred :=
  if sameblock v1 v2
  then (andp (weak_valid_pointer v1) (weak_valid_pointer v2))
  else FF.

Definition denote_tc_test_eq v1 v2 : mpred :=
 match v1, v2 with
 | Vint i, Vint j =>
     if Archi.ptr64 then FF else andp (prop (i = Int.zero)) (prop (j = Int.zero))
 | Vlong i, Vlong j =>
     if Archi.ptr64 then andp (prop (i = Int64.zero)) (prop (j = Int64.zero)) else FF
 | Vint i, Vptr _ _ =>
      if Archi.ptr64 then FF else andp (prop (i = Int.zero)) (weak_valid_pointer v2)
 | Vlong i, Vptr _ _ =>
      if Archi.ptr64 then andp (prop (i = Int64.zero)) (weak_valid_pointer v2) else FF
 | Vptr _ _, Vint i =>
      if Archi.ptr64 then FF else andp (prop (i = Int.zero)) (weak_valid_pointer v1)
 | Vptr _ _, Vlong i =>
      if Archi.ptr64 then andp (prop (i = Int64.zero)) (weak_valid_pointer v1) else FF
 | Vptr _ _, Vptr _ _ =>
      test_eq_ptrs v1 v2
 | _, _ => FF
 end.

Definition denote_tc_test_order v1 v2 : mpred :=
 match v1, v2 with
 | Vint i, Vint j => if Archi.ptr64 then FF else andp (prop (i = Int.zero)) (prop (j = Int.zero))
 | Vlong i, Vlong j => if Archi.ptr64 then andp (prop (i = Int64.zero)) (prop (j = Int64.zero)) else FF
 | Vptr _ _, Vptr _ _ =>
      test_order_ptrs v1 v2
 | _, _ => FF
 end.

Definition typecheck_error (e: tc_error) : Prop := False.

Fixpoint denote_tc_assert {CS: compspecs}(a: tc_assert) : environ -> mpred :=
  match a with
  | tc_FF msg => `(prop (typecheck_error msg))
  | tc_TT => `TT
  | tc_andp' b c => `andp (denote_tc_assert b) (denote_tc_assert c)
  | tc_orp' b c => `orp (denote_tc_assert b) (denote_tc_assert c)
  | tc_nonzero' e => `denote_tc_nonzero (eval_expr e)
  | tc_isptr e => `denote_tc_isptr (eval_expr e)
  | tc_test_eq' e1 e2 => `denote_tc_test_eq (eval_expr e1) (eval_expr e2)
  | tc_test_order' e1 e2 => `denote_tc_test_order (eval_expr e1) (eval_expr e2)
  | tc_ilt' e i => `(denote_tc_igt i) (eval_expr e)
  | tc_llt' e l => `(denote_tc_lgt l) (eval_expr e)
  | tc_Zle e z => `(denote_tc_Zge z) (eval_expr e)
  | tc_Zge e z => `(denote_tc_Zle z) (eval_expr e)
  | tc_samebase e1 e2 => `denote_tc_samebase (eval_expr e1) (eval_expr e2)
  | tc_nodivover' v1 v2 => `denote_tc_nodivover (eval_expr v1) (eval_expr v2)
  | tc_initialized id ty => denote_tc_initialized id ty
  | tc_iszero' e => `denote_tc_iszero (eval_expr e)
  | tc_nosignedover op e1 e2 => `(denote_tc_nosignedover op) (eval_expr e1) (eval_expr e2)
 end.

Lemma and_False: forall x, (x /\ False) = False.
Proof.
intros; apply prop_ext; intuition.
Qed.

Lemma and_True: forall x, (x /\ True) = x.
Proof.
intros; apply prop_ext; intuition.
Qed.

Lemma True_and: forall x, (True /\ x) = x.
Proof.
intros; apply prop_ext; intuition.
Qed.

Lemma False_and: forall x, (False /\ x) = False.
Proof.
intros; apply prop_ext; intuition.
Qed.

Lemma tc_andp_sound : forall {CS: compspecs} a1 a2 rho m,
    denote_tc_assert  (tc_andp a1 a2) rho m <->
    denote_tc_assert  (tc_andp' a1 a2) rho m.
Proof.
intros.
 unfold tc_andp.
 destruct a1; simpl; unfold_lift;
 repeat first [rewrite False_and | rewrite True_and
                    | rewrite and_False | rewrite and_True ];
  try apply iff_refl;
  destruct a2; simpl in *; unfold_lift;
 repeat first [rewrite False_and | rewrite True_and
                    | rewrite and_False | rewrite and_True ];
  try apply iff_refl.
Qed.

Lemma denote_tc_assert_andp:
  forall {CS: compspecs} a b rho, denote_tc_assert (tc_andp a b) rho =
             andp (denote_tc_assert a rho) (denote_tc_assert b rho).
Proof.
 intros.
 apply pred_ext.
 intro m. rewrite tc_andp_sound. intros [? ?]; split; auto.
 intros m [? ?]. rewrite tc_andp_sound; split; auto.
Qed.

Lemma neutral_isCastResultType:
  forall {CS: compspecs} t t' v rho,
   is_neutral_cast t' t = true ->
   forall m, denote_tc_assert (isCastResultType t' t v) rho m.
Proof.
intros.
  unfold isCastResultType.
  unfold is_neutral_cast in H; simpl classify_cast.
  destruct t'  as [ | [ | | | ] [ | ] | | [ | ] | | | | |],
   t  as [ | [ | | | ] [ | ] | | [ | ] | | | | |];
   try solve [inv H; try apply I; simpl; if_tac; apply I];
  try (rewrite denote_tc_assert_andp; split);
  try solve [unfold eval_cast, sem_cast, classify_cast,
     sem_cast_pointer, sem_cast_i2bool, sem_cast_l2bool;
      destruct Archi.ptr64; simpl; try if_tac; try apply I].
  apply orb_true_iff in H.
  unfold classify_cast.
  destruct (eqb (eqb_type (Tpointer t a0) int_or_ptr_type)
         (eqb_type (Tpointer t' a) int_or_ptr_type)) eqn:J.
  destruct (eqb_type (Tpointer t' a) (Tpointer t a0)) eqn:?H.
  apply I.
  destruct H. inv H.
  apply andb_true_iff in H. destruct H.
  rewrite eqb_true_iff in J.
  unfold is_pointer_type.
  rewrite <- J in *. apply eqb_type_false in H0.
  destruct (eqb_type (Tpointer t a0) int_or_ptr_type); inv H.
  apply I.
  destruct H.
  apply eqb_type_true in H. rewrite <- H in *.
  rewrite eqb_reflx in J. inv J.
  destruct (eqb_type (Tpointer t' a) int_or_ptr_type),
     (eqb_type (Tpointer t a0) int_or_ptr_type); inv H; inv J.
Qed.

Lemma is_true_e: forall b, is_true b -> b=true.
Proof. intros. destruct b; try contradiction; auto.
Qed.

Lemma tc_bool_e: forall {CS: compspecs} b a rho m,
  app_pred (denote_tc_assert (tc_bool b a) rho) m ->
  b = true.
Proof.
intros.
destruct b; simpl in H; auto.
Qed.