(*

  Copyright 2016 Luxembourg University
  Copyright 2017 Luxembourg University
  Copyright 2018 Luxembourg University

  This file is part of Velisarios.

  Velisarios is free software: you can redistribute it and/or modify
  it under the terms of the GNU General Public License as published by
  the Free Software Foundation, either version 3 of the License, or
  (at your option) any later version.

  Velisarios is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License for more details.

  You should have received a copy of the GNU General Public License
  along with Velisarios.  If not, see <http://www.gnu.org/licenses/>.

  Authors: Vincent Rahli
           Ivana Vukotic

*)

Require Export PBFTprops2.
Require Export PBFTwell_formed_log.

Section PBFTcommit_in_log_preserves.

  Local Open Scope eo.
  Local Open Scope proc.

  Context { pbft_context : PBFTcontext      }.
  Context { pbft_auth    : PBFTauth         }.
  Context { pbft_keys    : PBFTinitial_keys }.
  Context { pbft_hash    : PBFThash         }.

  Lemma check_send_replies_preserves_commit_in_log :
    forall com slf view keys entryop state sn msgs state',
      check_send_replies slf view keys entryop state sn = (msgs, state')
      -> commit_in_log com (log state') = true
      -> commit_in_log com (log state) = true.
  Proof.
    pbft_brute_force.
  Qed.
  Hint Resolve check_send_replies_preserves_commit_in_log: pbft.

  Lemma commit_in_log_add_new_pre_prepare2log_log_entry_commits :
    forall com pp d entry L,
      commit_in_log com (add_new_pre_prepare2log pp d L) = commit_in_log com L
      -> similar_entry_and_pre_prepare entry pp d = true
      -> log_entry_commits (change_pre_prepare_info_of_entry pp entry)
         = log_entry_commits entry.
  Proof.
    pbft_brute_force.
  Qed.
  (*Hint Rewrite commit_in_log_add_new_pre_prepare2log_log_entry_commits : pbft.*)

  (* MOVE *)
(*  DO WE NEED THESE??? We have stronger ones below.
  Lemma is_commit_for_entry_true_implies :
    forall entry c,
      is_commit_for_entry entry c = true
      -> log_entry_request_data entry = commit2request_data c.
  Proof.
    introv h.
    unfold is_commit_for_entry, eq_request_data in h.
    dest_cases w.
  Qed.

  Lemma is_commit_for_entry_false_implies :
    forall entry c,
      is_commit_for_entry entry c = false
      -> log_entry_request_data entry <> commit2request_data c.
  Proof.
    introv h.
    unfold is_commit_for_entry, eq_request_data in h.
    dest_cases w.
  Qed.
*)

  Lemma is_commit_for_entry_true_iff :
    forall entry c,
      is_commit_for_entry entry c = true
      <-> log_entry_request_data entry = commit2request_data c.
  Proof.
    introv.
    unfold is_commit_for_entry, eq_request_data;
      destruct entry; simpl in *; pbft_dest_all x; split; tcsp.
  Qed.
  Hint Rewrite is_commit_for_entry_true_iff : pbft.

  Lemma is_commit_for_entry_false_iff :
    forall entry c,
      is_commit_for_entry entry c = false
      <-> log_entry_request_data entry <> commit2request_data c.
  Proof.
    introv.
    unfold is_commit_for_entry, eq_request_data;
      destruct entry; simpl in *; pbft_dest_all x; split; tcsp.
  Qed.
  Hint Rewrite is_commit_for_entry_false_iff : pbft.

  Lemma add_new_pre_prepare2log_preserves_commit_in_log :
    forall com pp s L,
      commit_in_log com (add_new_pre_prepare2log pp s L) =
      commit_in_log com L.
  Proof.
    induction L; simpl in *; smash_pbft.

    {
      pose proof (commit_in_log_add_new_pre_prepare2log_log_entry_commits com pp s a L) as xx.
      apply xx in IHL; [| auto]. clear xx.
      rewrite IHL in *. auto.
    }

(*    {
      allrw is_commit_for_entry_true_iff.
      allrw is_commit_for_entry_false_iff.

      allrw similar_entry_and_pre_prepare_true_iff.

      unfold change_pre_prepare_info_of_entry in *.
      destruct a; simpl in *.
      tcsp.
    }

    {
      allrw is_commit_for_entry_true_iff.
      allrw is_commit_for_entry_false_iff.

      allrw similar_entry_and_pre_prepare_true_iff.

      unfold change_pre_prepare_info_of_entry in *.
      destruct a; simpl in *.
      tcsp.
    }*)
  Qed.
  Hint Rewrite  add_new_pre_prepare2log_preserves_commit_in_log : pbft.

  Lemma decomp_commit :
    forall com,
      request_data_and_rep_toks2commit
        (commit2request_data com)
        (commit2rep_toks com)
      = com.
  Proof.
    destruct com; simpl.
    destruct b; simpl; auto.
  Qed.
  Hint Rewrite decomp_commit : pbft.

  (* MOVE *)
  Lemma rt_rep_commit2rep_toks_as_commit2sender :
    forall com,
      rt_rep (commit2rep_toks com)
      = commit2sender com.
  Proof.
    introv; destruct com, b; simpl; auto.
  Qed.
  Hint Rewrite rt_rep_commit2rep_toks_as_commit2sender: pbft.

  Lemma split_commit :
    forall com,
      com = request_data_and_rep_toks2commit (commit2request_data com) (commit2rep_toks com).
  Proof.
    introv; destruct com, b; simpl; tcsp.
  Qed.

  Lemma add_new_pre_prepare_and_prepare2log_preserves_commit_in_log :
    forall L K pp d Fp Fc giop slf com,
      slf = rt_rep (Fc tt)
      -> add_new_pre_prepare_and_prepare2log slf L pp d Fp Fc = (giop, K)
      -> commit_in_log com K = true
      -> commit_in_log com L = true
         \/
         (
           com = request_data_and_rep_toks2commit (pre_prepare2request_data pp d) (Fc tt)
           /\
           commit_in_log com L = false
           /\
           prepared_log (pre_prepare2request_data pp d) K = true
         ).
  Proof.
    induction L; introv irt h q; repeat (progress (simpl in *; smash_pbft));
      try (complete (unfold is_request_data_for_entry, eq_request_data in *; smash_pbft;
                     allrw similar_entry_and_pre_prepare_true_iff;
                     allrw similar_entry_and_pre_prepare_false_iff;
                     try (rename_hyp_with fill_out_pp_info_with_prepare fill);
                     try (apply fill_out_pp_info_with_prepare_preserves_request_data in fill);
                     congruence)).

    allrw similar_entry_and_pre_prepare_true_iff.
    unfold fill_out_pp_info_with_prepare in *.
    destruct a; simpl in *;[].
    destruct log_entry_pre_prepare_info; ginv; smash_pbft.
    unfold add_commit_if_prepared in *; smash_pbft.

    repndors; tcsp;[].

    match goal with
    | [ |- context[?x = true] ] => remember x as b; destruct b; tcsp; clear Heqb
    end.
    right.

    unfold is_request_data_for_entry in *; simpl in *.
    unfold same_rep_tok in *; smash_pbft.

    rewrite (split_commit com).
    allrw.
    dands; tcsp.
  Qed.
  (*Hint Rewrite add_new_pre_prepare_and_prepare2log_preserves_commit_in_log : pbft.*)

  Lemma add_new_prepare2log_preserves_commit_in_log :
    forall i com new_prep L K gi Fc,
      add_new_prepare2log i L new_prep Fc = (gi, K)
      -> commit_in_log com K = true
      -> commit_in_log com L = true
         \/
         (
           com = request_data_and_rep_toks2commit (prepare2request_data new_prep) (Fc tt)
           /\
           commit_in_log com L = false
           /\
           prepared_log (prepare2request_data new_prep) K = true
         ).
  Proof.
    induction L; introv h q; simpl in *; smash_pbft; tcsp;
      try (simpl in *; smash_pbft);
      try (allrw is_commit_for_entry_false_iff; allrw is_commit_for_entry_true_iff;
           match goal with
           | [ H : add_prepare2entry _ _ _ _ = _, H' : _ <> _ |- _ ] =>
             apply add_prepare2entry_some_implies_log_entry_request_data in H;
             destruct H'; allrw <-; auto
           end).

   {
     hide_hyp IHL.

     allrw is_prepare_for_entry_true_iff.
     unfold is_request_data_for_entry in *.
     unfold eq_request_data in *. smash_pbft.

     unfold add_prepare2entry in *.
     destruct a;[]; simpl in *; ginv; simpl in *; smash_pbft; tcsp.
     unfold add_commit_if_prepared in *.
     smash_pbft.

     allrw same_rep_tok_true_iff.

     repndors; tcsp;[].

     remember (existsb (same_rep_tok (commit2rep_toks com)) log_entry_commits) as b.
     symmetry in Heqb; destruct b; tcsp.
     pose proof (decomp_commit com) as q1. rewrite <- q1. clear q1.
     allrw; dands; auto.
   }

   {
     unfold is_request_data_for_entry in *.
     unfold eq_request_data in *. smash_pbft.
     allrw is_prepare_for_entry_true_iff.

     match goal with
       [H1 :  _ = commit2request_data com , H2 : _ = commit2request_data com |-_ ] =>
       rewrite <- H2 in H1
     end.
     match goal with
       [H1 : log_entry_request_data a = prepare2request_data new_prep , H2 : log_entry_request_data (gi_entry x) = _ |-_ ] =>
       rewrite H1 in H2
     end.
    tcsp.

   }

   {
     allrw is_prepare_for_entry_false_iff.
     unfold is_request_data_for_entry in *.
     unfold eq_request_data in *; smash_pbft.
   }
  Qed.
  (*Hint Rewrite add_new_prepare2log_preserves_commit_in_log : pbft.*)

  Lemma add_commit2entry_some_implies_log_entry_commits_gi_entry_or :
    forall  entry com entry' ,
      add_commit2entry entry com = Some entry'
      -> if in_list_rep_toks (commit2sender com) (log_entry_commits entry)
         then log_entry_commits entry' = log_entry_commits entry
         else log_entry_commits entry' = commit2rep_toks com :: log_entry_commits entry.
  Proof.
    introv h.
    unfold add_commit2entry in h.
    destruct entry; simpl in *.
    smash_pbft.
  Qed.
  Hint Resolve add_commit2entry_some_implies_log_entry_commits_gi_entry_or: pbft.

  Lemma commit2sender_eq_if_request_data_and_rep_toks_equal :
    forall com new_com,
      commit2request_data new_com = commit2request_data com
      -> commit2rep_toks com = commit2rep_toks new_com
      -> commit2sender new_com = commit2sender com.
  Proof.
    introv H1 H2.
    pose proof (decomp_commit com) as q1; rewrite <- q1; clear q1.
    pose proof (decomp_commit new_com) as q2; rewrite <- q2; clear q2.
    allrw. auto.
  Qed.
  Hint Resolve commit2sender_eq_if_request_data_and_rep_toks_equal : pbft.

  Lemma add_new_commit2log_preserves_commit_in_log :
    forall com new_com L gi K,
      add_new_commit2log L new_com = (gi, K)
      -> commit_in_log com K = true
      -> commit_in_log com L = true
         \/
         (
           new_com = com
           /\
           commit_in_log com L = false
(*           /\
           prepared_log (commit2request_data new_com) K = true*)
         ).
  Proof.
    induction L; introv IH1 IH2; repeat (simpl in *; ginv; smash_pbft; tcsp).

    {
      repndors;[|ginv].
      pose proof (decomp_commit com) as q1; rewrite <- q1; clear q1.
      pose proof (decomp_commit new_com) as q2; rewrite <- q2; clear q2.
      allrw same_rep_tok_true_iff.
      allrw; simpl; tcsp.
    }

    {
      match goal with
      | [ H : add_commit2entry _ _ = _ |- _ ] =>
        apply add_commit2entry_some_implies_log_entry_commits_gi_entry_or in H
      end.
      smash_pbft; GC; ginv;[].

      match goal with
      | [ H1 : ?x = _, H2 : existsb _ ?x = _ |- _ ] =>
        rewrite H1 in H2; simpl in H2; pbft_simplifier; repndors; auto;[]
      end.

      match goal with
      | [ H1 : log_entry_request_data ?x = _, H2 : log_entry_request_data _ = _ |- _ ] =>
        rewrite H1 in H2
      end.

      allrw same_rep_tok_true_iff.

      right; dands; tcsp;[|].

      {
        pose proof (decomp_commit com) as q1; rewrite <- q1; clear q1.
        pose proof (decomp_commit new_com) as q2; rewrite <- q2; clear q2.
        allrw; simpl; autorewrite with pbft; tcsp.
      }

      {
        apply in_list_rep_toks_false_implies_existsb_same_rep_toks_false.
        autorewrite with pbft.
        pose proof (commit2sender_eq_if_request_data_and_rep_toks_equal com new_com) as xx.
        autodimp xx hyp.
        autodimp xx hyp.
        rewrite <- xx. auto.
      }
    }

    {
      apply gi_entry_of_add_commit2entry_some in Heqx1.
      allrw is_commit_for_entry_true_iff.
      allrw is_commit_for_entry_false_iff.
      rewrite Heqx1 in Heqx2. tcsp.
    }

    {
      allrw is_commit_for_entry_true_iff.
      allrw is_commit_for_entry_false_iff.

      destruct x;[]; simpl in *.
      unfold add_commit2entry in *.
      destruct a;[]; simpl in *.
      smash_pbft.
    }
  Qed.
  (*Hint Rewrite add_new_commit2log_preserves_commit_in_log : pbft.*)

  Lemma entry_of_commit_in_log :
    forall com L,
      commit_in_log com L = true
      -> exists entry,
        In entry L
        /\ log_entry_request_data entry = commit2request_data com.
  Proof.
    induction L; introv h; simpl in *; tcsp.
    pbft_dest_all x.

    - exists a; dands; tcsp.
      allrw is_commit_for_entry_true_iff; auto.

    - apply IHL in h; exrepnd; exists entry; auto.
  Qed.
  (*Hint Rewrite entry_of_commit_in_log : pbft.*)

  Lemma clear_log_checkpoint_preserves_commit_in_log2 :
    forall com L sn,
      well_formed_log L
      -> commit_in_log com (clear_log_checkpoint L sn) = true
      -> commit_in_log com L = true /\ sn < commit2seq com.
  Proof.
    induction L; simpl in *; introv wf h; tcsp; smash_pbft.

    - inversion wf as [|? ? imp wf1 wf2]; subst; clear wf.
      apply IHL in h; repnd; dands; auto.

      match goal with
      | [ H : commit_in_log _ _ = _ |- _ ] => apply entry_of_commit_in_log in H
      end.
      exrepnd.
      discover.
      unfold entries_have_different_request_data in *; congruence.

    - inversion wf as [|? ? imp wf1 wf2]; subst; clear wf.
      apply IHL in h; auto.

    - inversion wf as [|? ? imp wf1 wf2]; subst; clear wf.
      dands; auto.
      destruct com, b, a; simpl in *; subst; simpl in *; auto.

    - inversion wf as [|? ? imp wf1 wf2]; subst; clear wf.
      apply IHL in h; auto.
  Qed.

  Lemma clear_log_checkpoint_preserves_commit_in_log :
    forall com L sn,
      well_formed_log L
      -> commit_in_log com (clear_log_checkpoint L sn) = true
      -> commit_in_log com L = true.
  Proof.
    introv wf c.
    apply clear_log_checkpoint_preserves_commit_in_log2 in c; tcsp.
  Qed.
  Hint Resolve clear_log_checkpoint_preserves_commit_in_log : pbft.

  Lemma check_stable_preserves_commit_in_log :
    forall slf state entryop state' com,
      well_formed_log (log state)
      -> check_stable slf state entryop = Some state'
      -> commit_in_log com (log state') = true
      -> commit_in_log com (log state) = true.
  Proof.
    introv wf h q.
    unfold check_stable in h.
    pbft_dest_all x;[].
    apply clear_log_checkpoint_preserves_commit_in_log in q; auto.
  Qed.
  Hint Resolve check_stable_preserves_commit_in_log : pbft.

  Lemma add_replies2entry_preserves_log_entry_commits :
    forall entry reps,
      log_entry_commits (add_replies2entry entry reps) = (log_entry_commits entry).
  Proof.
    induction entry; simpl in *; ginv; simpl in *; tcsp.
  Qed.
  Hint Rewrite add_replies2entry_preserves_log_entry_commits : pbft.

  Lemma add_replies2entry_preserves_log_entry_request_data :
    forall entry reps,
      log_entry_request_data (add_replies2entry entry reps) = (log_entry_request_data entry).
  Proof.
    induction entry; simpl in *; ginv; simpl in *; tcsp.
  Qed.
  Hint Rewrite add_replies2entry_preserves_log_entry_request_data : pbft.

  Lemma change_entry_add_replies2entry_preserves_commit_in_log :
    forall com sn entry reps L,
      commit_in_log
        com
        (change_entry L (add_replies2entry entry reps)) = true
      -> find_entry L sn = Some entry
      -> commit_in_log com L = true.
  Proof.
    induction L; introv h fe; simpl in *; tcsp.
    smash_pbft;
      try (complete (applydup entry2seq_if_find_entry in fe as eqsn;
                     match goal with
                     | [ H : similar_entry _ _ = _ |- _ ] =>
                       apply entry2seq_if_similar_entry in H
                     end;
                     match goal with
                     | [ H : _ <> _ |- _ ] => destruct H; allrw; auto
                     end)).

    {
      match goal with
      | [ H : similar_entry _ _ = _ |- _ ] =>
        apply entry2seq_if_similar_entry in H
      end.
      match goal with
      | [ H : find_entry _ _ = _ |- _ ] =>
        apply entry2seq_if_find_entry in H; rewrite H in *; clear H
      end.
      smash_pbft.
    }
  Qed.
  Hint Resolve change_entry_add_replies2entry_preserves_commit_in_log : pbft.

  Lemma change_log_entry_add_replies2entry_preserves_commit_in_log :
    forall com sn entry state reps,
      commit_in_log
        com
        (log
           (change_log_entry
              state
              (add_replies2entry entry reps))) = true
      -> find_entry (log state) sn = Some entry
      -> commit_in_log com (log state) = true.
  Proof.
    introv h fe.
    destruct state; simpl in *.
    eapply change_entry_add_replies2entry_preserves_commit_in_log in h;[|eauto].
    auto.
  Qed.
  Hint Resolve change_log_entry_add_replies2entry_preserves_commit_in_log : pbft.

  Lemma find_and_execute_requests_preserves_commit_in_log :
    forall msg i com st p,
      find_and_execute_requests i (current_view p) (local_keys p) p = (msg, st)
      -> commit_in_log com (log st) = true
      -> commit_in_log com (log p) = true.
  Proof.
    introv H1 H2.

    unfold find_and_execute_requests in *.
    pbft_dest_all x;[].
    rename x1 into st.
    unfold execute_requests in *.
    destruct (ready p); simpl in *;[ inversion Heqx; allrw; tcsp |].

    pbft_dest_all y.

    match goal with
    | [ H : context[reply2requests] |- _ ] => hide_hyp H
    end.

    match goal with
    | [ H : check_broadcast_checkpoint _ _ _ _ _ = _ |- _ ] =>
      apply check_broadcast_checkpoint_preserves_log in H
    end.

    match goal with
    | [ H1 : commit_in_log _ (log ?s) = _, H2 : _ = log ?s |- _ ] =>
      rewrite <- H2 in H1; clear H2
    end.

    pose proof (change_log_entry_add_replies2entry_preserves_commit_in_log
                  com (next_to_execute p) y p y3) as xx.
    apply xx in H2; auto.
  Qed.
  Hint Resolve find_and_execute_requests_preserves_commit_in_log : pbft.

  Lemma add_prepare_to_log_from_new_view_pre_prepare_preserves_commit_in_log :
    forall slf com pp d state state' msgs,
      add_prepare_to_log_from_new_view_pre_prepare slf state (pp,d) = (state', msgs)
      -> commit_in_log com (log state') = true
      -> commit_in_log com (log state) = true
         \/
         (
           com
           = request_data_and_rep_toks2commit
               (pre_prepare2request_data pp d)
               (pre_prepare2rep_toks_of_commit slf (local_keys state) pp d)
           /\ low_water_mark state < pre_prepare2seq pp
           /\ prepared_log (pre_prepare2request_data pp d) (log state') = true
           /\ commit_in_log com (log state) = false).
  Proof.
    introv h q.
    unfold add_prepare_to_log_from_new_view_pre_prepare in h; smash_pbft.

    match goal with
    | [ H : check_send_replies _ _ _ _ _ _ = _ |- _ ] =>
      apply check_send_replies_preserves_log in H; simpl in *; subst
    end.

    match goal with
    | [ H : add_new_pre_prepare_and_prepare2log _ _ _ _ _ _ = _ |- _ ] =>
      eapply add_new_pre_prepare_and_prepare2log_preserves_commit_in_log in H;[ | | eauto]
    end.

    - repndors; auto.
      exrepnd; tcsp.

    - unfold pre_prepare2rep_toks_of_commit.
      autorewrite with pbft.
      destruct pp, b. simpl in *. auto.
  Qed.

  Lemma fill_out_pp_info_with_prepare_preserves_existsb_rep_tok_commit :
    forall i entry pp Fp Fc gi rt,
      fill_out_pp_info_with_prepare i entry pp Fp Fc = Some gi
      -> existsb (same_rep_tok rt) (log_entry_commits entry) = true
      -> existsb (same_rep_tok rt) (log_entry_commits (gi_entry gi)) = true.
  Proof.
    introv h q; unfold fill_out_pp_info_with_prepare in h.
    destruct entry; simpl in *.
    destruct log_entry_pre_prepare_info; ginv.
    smash_pbft.
    unfold add_commit_if_prepared in *. smash_pbft.
  Qed.
  Hint Resolve fill_out_pp_info_with_prepare_preserves_existsb_rep_tok_commit : pbft.

  Lemma add_new_pre_prepare_and_prepare2log_preserves_commit_in_log_forward :
    forall i L pp d Fp Fc giop K com,
      add_new_pre_prepare_and_prepare2log i L pp d Fp Fc = (giop, K)
      -> commit_in_log com L = true
      -> commit_in_log com K = true.
  Proof.
    induction L; introv h q; simpl in *; smash_pbft.

    - allrw is_commit_for_entry_true_iff.
      allrw is_commit_for_entry_false_iff.

      match goal with
      | [ H : fill_out_pp_info_with_prepare _ _ _ _ _ = _ |- _ ] =>
        eapply fill_out_pp_info_with_prepare_preserves_request_data in H
      end.

      rewrite Heqx in Heqx1. tcsp.

    - allrw is_commit_for_entry_true_iff.
      allrw is_commit_for_entry_false_iff.

      match goal with
      | [ H : fill_out_pp_info_with_prepare _ _ _ _ _ = _ |- _ ] =>
        apply fill_out_pp_info_with_prepare_preserves_request_data in H
      end.

      match goal with
      | [ H1 : ?x = ?y, H2 : ?x = ?z |- _ ] => rewrite H2 in H1; tcsp
      end.
  Qed.
  Hint Resolve add_new_pre_prepare_and_prepare2log_preserves_commit_in_log_forward : pbft.

  Lemma check_send_replies_preserves_commit_in_log_forward :
    forall i v keys giop state n msgs state' com,
      check_send_replies i v keys giop state n = (msgs, state')
      -> commit_in_log com (log state) = true
      -> commit_in_log com (log state') = true.
  Proof.
    pbft_brute_force.
  Qed.
  Hint Resolve check_send_replies_preserves_commit_in_log_forward : pbft.

  Lemma add_prepare_to_log_from_new_view_pre_prepare_preserves_commit_in_log_forward :
    forall slf com state pp d state' msgs,
      add_prepare_to_log_from_new_view_pre_prepare slf state (pp, d) = (state', msgs)
      -> commit_in_log com (log state) = true
      -> commit_in_log com (log state') = true.
  Proof.
    introv h q.
    unfold add_prepare_to_log_from_new_view_pre_prepare in h.
    smash_pbft.
  Qed.
  Hint Resolve add_prepare_to_log_from_new_view_pre_prepare_preserves_commit_in_log_forward : pbft.

  Lemma add_prepares_to_log_from_new_view_pre_prepares_preserves_commit_in_log_forward :
    forall slf com pps state state' msgs,
      add_prepares_to_log_from_new_view_pre_prepares slf state pps = (state', msgs)
      -> commit_in_log com (log state) = true
      -> commit_in_log com (log state') = true.
  Proof.
    induction pps; introv h q; simpl in *; smash_pbft; repnd.
    eapply IHpps; eauto with pbft.
  Qed.
  Hint Resolve add_prepares_to_log_from_new_view_pre_prepares_preserves_commit_in_log_forward : pbft.

  Lemma add_prepare_to_log_from_new_view_pre_prepare_preserves_commit_in_log_backward :
    forall slf com state pp d state' msgs,
      add_prepare_to_log_from_new_view_pre_prepare slf state (pp, d) = (state', msgs)
      -> commit_in_log com (log state') = false
      -> commit_in_log com (log state) = false.
  Proof.
    introv h q.
    match goal with
    | [ |- ?a = ?b ] => remember a as pb; symmetry in Heqpb; destruct pb; auto
    end.
    eapply add_prepare_to_log_from_new_view_pre_prepare_preserves_commit_in_log_forward in h;[|eauto].
    rewrite h in q; ginv.
  Qed.
  Hint Resolve add_prepare_to_log_from_new_view_pre_prepare_preserves_commit_in_log_backward : pbft.

  Lemma add_prepares_to_log_from_new_view_pre_prepares_preserves_commit_in_log_backward :
    forall slf com pps state state' msgs,
      add_prepares_to_log_from_new_view_pre_prepares slf state pps = (state', msgs)
      -> commit_in_log com (log state') = false
      -> commit_in_log com (log state) = false.
  Proof.
    introv h q.
    match goal with
    | [ |- ?a = ?b ] => remember a as pb; symmetry in Heqpb; destruct pb; auto
    end.
    eapply add_prepares_to_log_from_new_view_pre_prepares_preserves_commit_in_log_forward in h;[|eauto].
    rewrite h in q; ginv.
  Qed.
  Hint Resolve add_prepares_to_log_from_new_view_pre_prepares_preserves_commit_in_log_backward : pbft.

  Lemma add_prepares_to_log_from_new_view_pre_prepares_preserves_commit_in_log :
    forall slf com pps state state' msgs,
      add_prepares_to_log_from_new_view_pre_prepares slf state pps = (state', msgs)
      -> commit_in_log com (log state') = true
      -> commit_in_log com (log state) = true
         \/
         (
           exists pp d,
             In (pp,d) pps
             /\ com
                = request_data_and_rep_toks2commit
                    (pre_prepare2request_data pp d)
                    (pre_prepare2rep_toks_of_commit slf (local_keys state) pp d)
             /\ low_water_mark state < pre_prepare2seq pp
             /\ commit_in_log com (log state) = false).
  Proof.
    induction pps; introv h q; simpl in *; smash_pbft; repnd;
      match goal with
      | [ H : add_prepares_to_log_from_new_view_pre_prepares _ _ _ = _ |- _ ] =>
        apply IHpps in H;auto;[]
      end;
      repndors; tcsp.

    {
      rename_hyp_with check_send_replies check.
      rename_hyp_with add_new_pre_prepare_and_prepare2log add.
      eapply check_send_replies_preserves_commit_in_log in check;[|eauto]; simpl in *.
      eapply add_new_pre_prepare_and_prepare2log_preserves_commit_in_log in add; eauto; autorewrite with pbft; auto.
      repndors; tcsp.
      repnd; subst; simpl in *.
      right; eexists; eexists; dands; try reflexivity; tcsp.
    }

    {
      exrepnd; subst.
      rename_hyp_with check_send_replies check.
      rename_hyp_with add_new_pre_prepare_and_prepare2log add.
      right.
      applydup check_send_replies_preserves_keys in check; simpl in *.
      applydup check_send_replies_preserves_low_water_mark in check; simpl in *; autorewrite with pbft in *.

      eexists; eexists; dands; try reflexivity; try rewrite check0;
        try rewrite <- check1; try reflexivity; simpl; try omega;
          tcsp; try rewrite <- check0.
      match goal with
      | [ |- ?x = _ ] => remember x as b; symmetry in Heqb; destruct b; auto
      end.
      eapply add_new_pre_prepare_and_prepare2log_preserves_commit_in_log_forward in add;[|eauto].
      eapply check_send_replies_preserves_commit_in_log_forward in check;[|simpl;eauto]; ginv.
    }

    {
      exrepnd; subst.
      right.
      eexists; eexists; dands; try reflexivity; tcsp.
    }
  Qed.
  (*Hint Rewrite add_prepares_to_log_from_new_view_pre_prepares_preserves_commit_in_log : pbft.*)

  Lemma log_pre_prepares_preserves_commit_in_log :
    forall com P L lwm,
      commit_in_log com (log_pre_prepares L lwm P)
      = commit_in_log com L.
  Proof.
    induction P; introv; simpl in *; tcsp; repnd; smash_pbft.
    rewrite IHP.
    apply add_new_pre_prepare2log_preserves_commit_in_log.
  Qed.
  Hint Rewrite log_pre_prepares_preserves_commit_in_log : pbft.

  Lemma update_state_new_view_preserves_commit_in_log2 :
    forall i st nv st' msgs com,
      well_formed_log (log st)
      -> correct_new_view nv = true
      -> update_state_new_view i st nv = (st', msgs)
      -> commit_in_log com (log st') = true
      -> commit_in_log com (log st) = true
         /\ (low_water_mark st < low_water_mark st' -> low_water_mark st' < commit2seq com).
  Proof.
    introv wf cor upd h.
    unfold update_state_new_view in *; smash_pbft;
      try (complete (dands; auto; introv q; try omega));[].

    apply clear_log_checkpoint_preserves_commit_in_log2 in h; eauto 3 with pbft;[].
    repnd.
    unfold log_checkpoint_cert_from_new_view in *; smash_pbft.

    + unfold low_water_mark; simpl; dands; auto.

      rename_hyp_with view_change_cert2max_seq_vc maxs.
      applydup view_change_cert2_max_seq_vc_some_in in maxs.
      applydup sn_of_view_change_cert2max_seq_vc in maxs.
      subst.

      rename_hyp_with extract_seq_and_digest_from_checkpoint_certificate ext.
      eapply extract_seq_and_digest_from_checkpoint_certificate_implies_eq_view_change2seq in ext; eauto 3 with pbft; [].
      subst; auto.

    + rename_hyp_with extract_seq_and_digest_from_checkpoint_certificate ext.
      eapply extract_seq_and_digest_from_checkpoint_certificate_none_implies in ext.
      rewrite ext in *.
      simpl in *; ginv.

    + rename_hyp_with extract_seq_and_digest_from_checkpoint_certificate ext.
      eapply extract_seq_and_digest_from_checkpoint_certificate_implies_eq_view_change2seq in ext; eauto 3 with pbft;[].
      subst.
      unfold low_water_mark; simpl in *.
      dands; auto.

      rename_hyp_with view_change_cert2max_seq_vc maxs.
      applydup view_change_cert2_max_seq_vc_some_in in maxs.
      applydup sn_of_view_change_cert2max_seq_vc in maxs.
      subst; auto.

    + rename_hyp_with extract_seq_and_digest_from_checkpoint_certificate ext.
      apply extract_seq_and_digest_from_checkpoint_certificate_none_implies in ext.
      dands; auto.

      rename_hyp_with view_change_cert2max_seq_vc maxs.
      applydup view_change_cert2_max_seq_vc_some_in in maxs.
      applydup sn_of_view_change_cert2max_seq_vc in maxs.
      subst; auto.

      assert (correct_view_change (new_view2view nv) x2 = true) as cvc by eauto 3 with pbft;[].
      unfold correct_view_change in cvc; smash_pbft.
      rewrite ext in *.
      simpl in *; ginv; try omega.
  Qed.

  Lemma update_state_new_view_preserves_commit_in_log :
    forall i st nv st' msgs com,
      well_formed_log (log st)
      -> update_state_new_view i st nv = (st', msgs)
      -> commit_in_log com (log st') = true
      -> commit_in_log com (log st) = true.
  Proof.
    introv wf upd h.
    unfold update_state_new_view in *; smash_pbft.
    apply clear_log_checkpoint_preserves_commit_in_log in h; eauto 3 with pbft;[].
    unfold log_checkpoint_cert_from_new_view in *; smash_pbft.
  Qed.
  Hint Resolve update_state_new_view_preserves_commit_in_log : pbft.

  Lemma commit_in_log_clear_log_checkpoint_false_implies :
    forall (n : SeqNum) c L,
      n < commit2seq c
      -> commit_in_log c (clear_log_checkpoint L n) = false
      -> commit_in_log c L = false.
  Proof.
    induction L; introv h prep; simpl in *; smash_pbft.
    repeat (autodimp IHL hyp).
    allrw SeqNumLe_true.
    destruct a, c, b, log_entry_request_data; simpl in *; ginv; omega.
  Qed.
  Hint Resolve commit_in_log_clear_log_checkpoint_false_implies : pbft.

  Lemma update_state_new_view_preserves_commit_in_log_false_forward :
    forall c i s1 v s2 msgs,
      correct_new_view v = true
      -> update_state_new_view i s1 v = (s2, msgs)
      -> low_water_mark s2 < commit2seq c
      -> commit_in_log c (log s2) = false
      -> commit_in_log c (log s1) = false.
  Proof.
    introv cor upd h com.

    unfold update_state_new_view in upd; smash_pbft.
    unfold log_checkpoint_cert_from_new_view in *; smash_pbft.

    - unfold update_log_checkpoint_stable, low_water_mark in *; simpl in *.
      apply commit_in_log_clear_log_checkpoint_false_implies in com; eauto 3 with pbft.

      rename_hyp_with view_change_cert2max_seq_vc mseq.
      applydup view_change_cert2_max_seq_vc_some_in in mseq.
      apply sn_of_view_change_cert2max_seq_vc in mseq; subst.

      rename_hyp_with extract_seq_and_digest_from_checkpoint_certificate ext.
      eapply extract_seq_and_digest_from_checkpoint_certificate_implies_eq_view_change2seq in ext; eauto 3 with pbft;[].
      subst; auto.

    - rename_hyp_with view_change_cert2max_seq_vc mseq.
      applydup view_change_cert2_max_seq_vc_some_in in mseq.
      apply sn_of_view_change_cert2max_seq_vc in mseq; subst.

      rename_hyp_with extract_seq_and_digest_from_checkpoint_certificate ext.
      apply extract_seq_and_digest_from_checkpoint_certificate_none_implies in ext.
      rewrite ext in *.
      simpl in *; ginv.

    - unfold update_log_checkpoint_stable, low_water_mark in *; simpl in *.
      apply commit_in_log_clear_log_checkpoint_false_implies in com; eauto 3 with pbft.

      rename_hyp_with view_change_cert2max_seq_vc mseq.
      applydup view_change_cert2_max_seq_vc_some_in in mseq.
      apply sn_of_view_change_cert2max_seq_vc in mseq; subst.

      rename_hyp_with extract_seq_and_digest_from_checkpoint_certificate ext.
      eapply extract_seq_and_digest_from_checkpoint_certificate_implies_eq_view_change2seq in ext; eauto 3 with pbft;[].
      subst; auto.

    - rename_hyp_with view_change_cert2max_seq_vc mseq.
      applydup view_change_cert2_max_seq_vc_some_in in mseq.
      apply sn_of_view_change_cert2max_seq_vc in mseq; subst.

      rename_hyp_with extract_seq_and_digest_from_checkpoint_certificate ext.
      apply extract_seq_and_digest_from_checkpoint_certificate_none_implies in ext.
      rewrite ext in *.
      simpl in *; ginv.

      apply correct_new_view_implies_correct_view_change in mseq0; auto.
      unfold correct_view_change, correct_view_change_cert in *; smash_pbft.
      rewrite ext in *; simpl in *; omega.
  Qed.
  Hint Resolve update_state_new_view_preserves_commit_in_log_false_forward : pbft.

End PBFTcommit_in_log_preserves.

Hint Resolve check_send_replies_preserves_commit_in_log: pbft.
Hint Resolve commit2sender_eq_if_request_data_and_rep_toks_equal : pbft.
Hint Resolve fill_out_pp_info_with_prepare_preserves_existsb_rep_tok_commit : pbft.
Hint Resolve add_new_pre_prepare_and_prepare2log_preserves_commit_in_log_forward : pbft.
Hint Resolve check_send_replies_preserves_commit_in_log_forward : pbft.
Hint Resolve add_prepare_to_log_from_new_view_pre_prepare_preserves_commit_in_log_forward : pbft.
Hint Resolve add_prepares_to_log_from_new_view_pre_prepares_preserves_commit_in_log_forward : pbft.
Hint Resolve add_prepare_to_log_from_new_view_pre_prepare_preserves_commit_in_log_backward : pbft.
Hint Resolve add_prepares_to_log_from_new_view_pre_prepares_preserves_commit_in_log_backward : pbft.
Hint Resolve commit_in_log_clear_log_checkpoint_false_implies : pbft.
Hint Resolve update_state_new_view_preserves_commit_in_log_false_forward : pbft.
Hint Resolve clear_log_checkpoint_preserves_commit_in_log : pbft.
Hint Resolve update_state_new_view_preserves_commit_in_log : pbft.
Hint Resolve check_stable_preserves_commit_in_log : pbft.
Hint Resolve change_entry_add_replies2entry_preserves_commit_in_log : pbft.
Hint Resolve change_log_entry_add_replies2entry_preserves_commit_in_log : pbft.
Hint Resolve find_and_execute_requests_preserves_commit_in_log : pbft.

Hint Rewrite @is_commit_for_entry_true_iff : pbft.
Hint Rewrite @is_commit_for_entry_false_iff : pbft.
Hint Rewrite @add_new_pre_prepare2log_preserves_commit_in_log : pbft.
Hint Rewrite @decomp_commit : pbft.
Hint Rewrite @rt_rep_commit2rep_toks_as_commit2sender: pbft.
Hint Rewrite @add_replies2entry_preserves_log_entry_request_data : pbft.
Hint Rewrite @log_pre_prepares_preserves_commit_in_log : pbft.
Hint Rewrite @add_replies2entry_preserves_log_entry_commits : pbft.
(*Hint Rewrite @commit_in_log_add_new_pre_prepare2log_log_entry_commits : pbft.*)
(*Hint Rewrite @add_new_pre_prepare_and_prepare2log_preserves_commit_in_log : pbft.*)
(*Hint Rewrite @add_new_prepare2log_preserves_commit_in_log : pbft.*)
(*Hint Resolve @add_commit2entry_some_implies_log_entry_commits_gi_entry_or: pbft.*)
(*Hint Rewrite @add_new_commit2log_preserves_commit_in_log : pbft.*)
(*Hint Rewrite @entry_of_commit_in_log : pbft.*)
(*Hint Rewrite @add_prepares_to_log_from_new_view_pre_prepares_preserves_commit_in_log : pbft.*)


Load coql.

(**
    We represent the internal state as a stack.

    Perhaps a stack is not the best data structure
    since at every step of the evaluation of a query we need at most the top element of the stack.

    However, this is an example to show how the underlying state can be represented in arbitrary ways.

    For example, it could be an SQL table or a JSON object.
*)

Record UserRecord := {
  _id: nat;
  name: string;
  surname: string;
  age: nat;
}.

Inductive data: Type :=
  | mkUser: UserRecord -> data
  | mkString: string -> data
  | mkNat: nat -> data.

Definition Stack := list data.

(**
    This function represents a simple database query
*)

Definition findUserById := fun(id: nat) =>
  match id with
    | 1 => Some {| _id := 1; name := "Johnny"; surname := "Hendrix"; age := 27 |}
    | _ => None
  end.

Definition User: ty :=
    TPar
      (TField "name" TBot TString)
      (TPar
        (TField "surname" TBot TString)
        (TField "age" TBot TNat)).

Definition update: UserRecord -> (state Stack unit) := fun(user: UserRecord)(st: Stack) => (tt, mkUser(user)::st).

Definition findUserByIdResolver: resolver(Stack) := fun(t: tm)(st: Stack) =>
  match t with
    | tnat userId =>
      match findUserById(userId) with
        | Some user =>
          let (_, st') := update user st in
            (inl (Some User), st')
        | None => (inl None, st)
      end
    | _ => (inr err, st)
  end.

Definition findUserNameResolver: resolver(Stack) := fun(t: tm)(st: Stack) =>
  match st with
    | x::st' =>
      match x with
        | mkUser(x) => ( inl (Some TString),  mkString(name x)::st)
        | _ => (inr err, st)
      end
    | nil => (inr err, st)
  end.

Definition findUserAgeResolver: resolver(Stack) := fun(t: tm)(st: Stack) =>
  match st with
    | x::st' =>
      match x with
        | mkUser(x) => ( inl (Some TNat),  mkNat(age x)::st)
        | _ => (inr err, st)
      end
    | nil => (inr err, st)
  end.

Definition Schema: schema(Stack) := fun( p: list string ) =>
  match p with
    | "findUserById" :: nil => Some(findUserByIdResolver)
    | "name" :: "findUserById" :: nil => Some( findUserNameResolver )
    | "age" :: "findUserById" :: nil => Some( findUserAgeResolver )
    | _ => None
  end.

Definition Root: ty := TField "findUserById" TNat User.

Definition get: getter(Stack) := fun(st: Stack) =>
  match st with
    | x::st' =>
      match x with
        | mkString(s) => (Some (tstring s), st)
        | mkNat(n) => (Some (tnat n), st)
        | _ => (None, st)
      end
    | nil => (None, st)
  end.

Example res1:
  < Stack ; Schema ; get ; [] ; Root > |=
    tfield "findUserById" (tnat 1)
      (tpar
        (tfield "name" tempty thole)
        (tfield "age" tempty thole) ) / []
      \\ tfieldr "findUserById" (tnat 1)
          (tpar
            (tfieldr "name" tempty (tstring "Johnny"))
            (tfieldr "age" tempty (tnat 27))
          ).
Proof.
  apply E_Field with User findUserByIdResolver [ mkUser {| _id := 1; name := "Johnny"; surname := "Hendrix"; age := 27 |}].
  - trivial.
  - simpl. reflexivity.
  - simpl. reflexivity.
  - apply E_Par.
      apply E_Field with TString findUserNameResolver [ mkString "Johnny" ; mkUser {| _id := 1; name := "Johnny"; surname := "Hendrix"; age := 27 |}].
      trivial.
      simpl. reflexivity.
      trivial.
      apply E_Hole. simpl. reflexivity.
      trivial.
      apply E_Field with TNat findUserAgeResolver [ mkNat 27 ; mkUser {| _id := 1; name := "Johnny"; surname := "Hendrix"; age := 27 |}].
      trivial.
      simpl. reflexivity.
      simpl. reflexivity.
      apply E_Hole. simpl. reflexivity. trivial.
Qed.


(*

  Copyright 2014 Cornell University

  This file is part of VPrl (the Verified Nuprl project).

  VPrl is free software: you can redistribute it and/or modify
  it under the terms of the GNU General Public License as published by
  the Free Software Foundation, either version 3 of the License, or
  (at your option) any later version.

  VPrl is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License for more details.

  You should have received a copy of the GNU General Public License
  along with VPrl.  If not, see <http://www.gnu.org/licenses/>.

  Website: http://nuprl.org/html/verification/
  Authors: Abhishek Anand & Vincent Rahli

*)

Require Import type_sys_useful.
Require Import dest_close.

Lemma close_type_system_pertype {p} :
  forall lib (ts : cts(p))
         T T'
         (eq : per)
         R1 R2 eq1 eq2,
    type_system lib ts
    -> defines_only_universes lib ts
    -> computes_to_valc lib T (mkc_pertype R1)
    -> computes_to_valc lib T' (mkc_pertype R2)
    -> (forall x y : CTerm,
          close lib ts (mkc_apply2 R1 x y) (mkc_apply2 R1 x y) (eq1 x y))
    -> (forall x y : CTerm,
          type_system lib ts
          -> defines_only_universes lib ts
          -> type_sys_props lib (close lib ts)
                            (mkc_apply2 R1 x y)
                            (mkc_apply2 R1 x y)
                            (eq1 x y))
    -> (forall x y : CTerm,
          close lib ts (mkc_apply2 R2 x y) (mkc_apply2 R2 x y) (eq2 x y))
    -> (forall x y : CTerm,
          type_system lib ts
          -> defines_only_universes lib ts
          -> type_sys_props lib (close lib ts)
                            (mkc_apply2 R2 x y)
                            (mkc_apply2 R2 x y)
                            (eq2 x y))
    -> (forall x y : CTerm, inhabited (eq1 x y) <=> inhabited (eq2 x y))
    -> is_per eq1
    -> (forall t t' : CTerm, eq t t' <=> inhabited (eq1 t t'))
    -> per_pertype lib (close lib ts) T T' eq
    -> type_sys_props lib (close lib ts) T T' eq.
Proof.
  introv X X0 c1 c2 cl1 rec1 cl2 rec2 inh isper.
  intros eqiff per.

  rw @type_sys_props_iff_type_sys_props3.
  prove_type_sys_props3 SCase; intros.

  - SCase "uniquely_valued".
    dclose_lr.

    SSCase "CL_pertype".
    clear per.
    allunfold @per_pertype; exrepd.
    unfold eq_term_equals; intros.
    allrw.
    ccomputes_to_eqval.
    rw <- t; rw <- inh.
    generalize (c3 t1 t2); intro clt1.
    generalize (rec1 t1 t2); sp.
    onedtsp uv tys tyt tyst tyvr tes tet tevr tygs tygt dum.
    implies_ts_or (mkc_apply2 R1 t1 t2) clt1.
    apply uv in clt1.
    unfold eq_term_equals in clt1.
    unfold inhabited; split; sp.
    exists t3; rw <- clt1; sp.
    exists t3; rw clt1; sp.

  - SCase "type_symmetric"; repdors; subst; dclose_lr;
    apply CL_pertype;
    clear per;
    allunfold @per_pertype; exrepd;
    unfold per_pertype;
    ccomputes_to_eqval.

    + exists R1 R3 eq1 eq3; sp; spcast; sp.
      rw <- t; rw <- eqiff; rw <- t0; sp.
      allrw <-; sp.

  - SCase "type_value_respecting"; repdors; subst;
    apply CL_pertype; unfold per_pertype.

    (* 1 *)
    apply cequivc_mkc_pertype with (a := R1) in X1; sp.
    exists R1 b eq1 eq1; sp; spcast; sp.
    generalize (cl1 x y); intro clt1.
    generalize (rec1 x y); sp.
    onedtsp uv tys tyt tyst tyvr tes tet tevr tygs tygt tymt.
    generalize (tyvr (mkc_apply2 R1 x y) (mkc_apply2 b x y)); intro imp1.
    repeat (autodimp imp1 hyp).
    repeat (rw @mkc_apply2_eq).
    repeat (apply sp_implies_cequivc_apply); auto.

    generalize (tyt (mkc_apply2 b x y) (eq1 x y)); sp.

    (* 2 *)
    apply @cequivc_mkc_pertype with (a := R2) in X1; sp.
    exists R2 b eq2 eq2; sp; spcast; sp.
    generalize (cl2 x y); intro clt1.
    generalize (rec2 x y); sp.
    onedtsp uv tys tyt tyst tyvr tes tet tevr tygs tygt tymt.
    generalize (tyvr (mkc_apply2 R2 x y) (mkc_apply2 b x y)); intro imp1.
    repeat (autodimp imp1 hyp).
    repeat (rw @mkc_apply2_eq).
    repeat (apply sp_implies_cequivc_apply); auto.

    generalize (tyt (mkc_apply2 b x y) (eq2 x y)); sp.

    apply @is_per_iff with (eq1 := eq1); auto.

    rw eqiff; sp.

  - SCase "term_symmetric".
    unfold term_equality_symmetric; introv eqt.
    rw eqiff in eqt; rw eqiff.
    apply is_per_sym; sp.

  - SCase "term_transitive".
    unfold term_equality_transitive; introv eqt1 eqt2.
    rw eqiff in eqt1; rw eqiff in eqt2; rw eqiff.
    apply is_per_trans with (b := t2); sp.

  - SCase "term_value_respecting".
    unfold term_equality_respecting; introv eqt ceq.
    rw eqiff in eqt; rw eqiff.

    spcast.
    assert (eq_term_equals (eq1 t t') (eq1 t t)) as eqteq.
    generalize (rec1 t t); sp.
    onedtsp uv tys tyt tyst tyvr tes tet tevr tygs tygt tymt.
    generalize (tyvr (mkc_apply2 R1 t t) (mkc_apply2 R1 t t')); intro i; repeat (autodimp i h).
    repeat (rw @mkc_apply2_eq).
    apply implies_cequivc_apply; sp.
    generalize (rec1 t t'); sp.
    onedtsp uv2 tys2 tyt2 tyst2 tyvr2 tes2 tet2 tevr2 tygs2 tygt2 tymt2.
    generalize (tygs (mkc_apply2 R1 t t) (mkc_apply2 R1 t t') (eq1 t t)); intro k; repeat (autodimp k h).
    rw k in i.
    generalize (uv2 (mkc_apply2 R1 t t) (eq1 t t)); intro j; repeat (autodimp j h).

    apply eq_term_equals_implies_inhabited in eqteq.
    rw eqteq; sp.

  - SCase "type_gsymmetric".
    repdors; subst; split; sp; dclose_lr;
    apply CL_pertype;
    clear per;
    allunfold @per_pertype; exrepd;
    ccomputes_to_eqval;
    unfold per_pertype.

    (* 1 *)
    assert (forall x y, eq_term_equals (eq1 x y) (eq0 x y))
           as eqteq1
           by (apply (type_sys_props_pertype_eq_term_equals lib) with (ts := close lib ts) (R := R1); sp).

    exists R3 R1 eq3 eq1; sp; spcast; sp.
    rw <- t.
    apply eq_term_equals_implies_inhabited; sp.
    apply eq_term_equals_sym; sp.

    apply @is_per_iff with (eq1 := eq0); auto.

    rw t0; auto.

    (* 2 *)
    assert (forall x y, eq_term_equals (eq1 x y) (eq3 x y))
           as eqteq1
           by (apply (type_sys_props_pertype_eq_term_equals lib) with (ts := close lib ts) (R := R1); sp).

    exists R1 R0 eq1 eq0; sp; spcast; sp.
    rw t.
    apply eq_term_equals_implies_inhabited; sp.

    rw t0.
    rw t.
    apply eq_term_equals_implies_inhabited; sp.
    apply eq_term_equals_sym; sp.

  - SCase "type_gtransitive"; sp.

  - SCase "type_mtransitive".
    repdors; subst; dclose_lr;
    try (move_term_to_top (per_pertype lib (close lib ts) T T4 eq3));
    try (move_term_to_top (per_pertype lib (close lib ts) T' T4 eq3));
    allunfold @per_pertype; exrepd;
    ccomputes_to_eqval;
    try (assert (forall x y, eq_term_equals (eq1 x y) (eq8 x y))
                as eqteq1
                by (apply (type_sys_props_pertype_eq_term_equals lib) with (ts := close lib ts) (R := R1); sp));
    try (assert (forall x y, eq_term_equals (eq1 x y) (eq7 x y))
                as eqteq2
                by (apply (type_sys_props_pertype_eq_term_equals lib) with (ts := close lib ts) (R := R1); sp));
    try (assert (forall x y, eq_term_equals (eq1 x y) (eq4 x y))
                as eqteq3
                by (apply (type_sys_props_pertype_eq_term_equals lib) with (ts := close lib ts) (R := R1); sp));
    try (assert (forall x y, eq_term_equals (eq2 x y) (eq9 x y))
                as eqteq4
                by (apply (type_sys_props_pertype_eq_term_equals lib) with (ts := close lib ts) (R := R2); sp));
    try (assert (forall x y, eq_term_equals (eq2 x y) (eq7 x y))
                as eqteq5
                by (apply (type_sys_props_pertype_eq_term_equals lib) with (ts := close lib ts) (R := R2); sp));
    try (assert (forall x y, eq_term_equals (eq2 x y) (eq4 x y))
                as eqteq6
                by (apply (type_sys_props_pertype_eq_term_equals lib) with (ts := close lib ts) (R := R2); sp)).

    + dands; apply CL_pertype; unfold per_pertype.

      * exists R4 R3 eq6 eq5; sp; spcast; sp.
        rw <- t; rw t1.
        apply eq_term_equals_implies_inhabited; sp.
        apply @eq_term_equals_trans with (eq2 := eq1 x y); sp.
        apply eq_term_equals_sym; sp.

      * exists R4 R3 eq6 eq5; sp; spcast; sp.
        rw <- t; rw t1.
        apply eq_term_equals_implies_inhabited; sp.
        apply @eq_term_equals_trans with (eq2 := eq1 x y); sp.
        apply eq_term_equals_sym; sp.

        rw t0; rw t1.
        apply eq_term_equals_implies_inhabited; sp.
        apply @eq_term_equals_trans with (eq2 := eq1 t5 t'); sp.
        apply eq_term_equals_sym; sp.

    + dands; apply CL_pertype; unfold per_pertype.

      * exists R4 R3 eq6 eq5; sp; spcast; sp.
        rw <- t; rw t1.
        apply eq_term_equals_implies_inhabited; sp.
        apply @eq_term_equals_trans with (eq2 := eq2 x y); sp.
        apply eq_term_equals_sym; sp.

      * exists R4 R3 eq6 eq5; sp; spcast; sp.
        rw <- t; rw t1.
        apply eq_term_equals_implies_inhabited; sp.
        apply @eq_term_equals_trans with (eq2 := eq2 x y); sp.
        apply eq_term_equals_sym; sp.

        rw t0; rw t1.
        apply eq_term_equals_implies_inhabited; sp.
        apply @eq_term_equals_trans with (eq2 := eq2 t5 t'); sp.
        apply eq_term_equals_sym; sp.
Qed.


(* Skeleton by Edgser for Crowdfunding_Based_On_Scilla.ds *)
Require Import BinPos.
Require Import DeepSpec.Runtime.
Require Import Crowdfunding_Based_On_Scilla.EdsgerIdents.
Require Import Crowdfunding_Based_On_Scilla.DataTypes.
Require Import Crowdfunding_Based_On_Scilla.DataTypeOps.
Require Import Crowdfunding_Based_On_Scilla.DataTypeProofs.
Require Import Crowdfunding_Based_On_Scilla.LayerCROWDFUNDING.

Require Import Additions.Tactics.

Section EdsgerGen.

Existing Instance GlobalLayerSpec.
Existing Instances CROWDFUNDING_overlay_spec.

Context {memModelOps : MemoryModelOps mem}.

Lemma Crowdfunding_constructor_vc me d :
    high_level_invariant d ->
    synth_func_cond Crowdfunding_constructor Crowdfunding_constructor_wf
                    me d.
Proof.
    code_proofs_auto.
Qed.

Lemma Crowdfunding_constructor_oblg me d :
    high_level_invariant d ->
    synth_func_obligation Crowdfunding_constructor Crowdfunding_constructor_wf
                          me d.
Proof.
    code_proofs_auto.
Qed.

Lemma Crowdfunding_donate_vc me d :
    high_level_invariant d ->
    synth_func_cond Crowdfunding_donate Crowdfunding_donate_wf
                    me d.
Proof.
    code_proofs_auto.
Qed.

Lemma Crowdfunding_donate_oblg me d :
    high_level_invariant d ->
    synth_func_obligation Crowdfunding_donate Crowdfunding_donate_wf
                          me d.
Proof.
    code_proofs_auto.
Qed.

Lemma Crowdfunding_getFunds_vc me d :
    high_level_invariant d ->
    synth_func_cond Crowdfunding_getFunds Crowdfunding_getFunds_wf
                    me d.
Proof.
    code_proofs_auto.
Qed.

Lemma Crowdfunding_getFunds_oblg me d :
    high_level_invariant d ->
    synth_func_obligation Crowdfunding_getFunds Crowdfunding_getFunds_wf
                          me d.
Proof.
    code_proofs_auto.
Qed.

Lemma Crowdfunding_claim_vc me d :
    high_level_invariant d ->
    synth_func_cond Crowdfunding_claim Crowdfunding_claim_wf
                    me d.
Proof.
    code_proofs_auto.
Qed.

Lemma Crowdfunding_claim_oblg me d :
    high_level_invariant d ->
    synth_func_obligation Crowdfunding_claim Crowdfunding_claim_wf
                          me d.
Proof.
    code_proofs_auto.
Qed.

End EdsgerGen.


(* *********************************************************************)
(*                                                                     *)
(*              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.     *)
(*                                                                     *)
(* *********************************************************************)

(** Function calling conventions and other conventions regarding the use of
    machine registers and stack slots. *)

Require Import Coqlib.
Require Import AST.
Require Import Events.
Require Import Locations.
Require Archi.

(** * Classification of machine registers *)

(** Machine registers (type [mreg] in module [Locations]) are divided in
  the following groups:
- Temporaries used for spilling, reloading, and parallel move operations.
- Allocatable registers, that can be assigned to RTL pseudo-registers.
  These are further divided into:
-- Callee-save registers, whose value is preserved across a function call.
-- Caller-save registers that can be modified during a function call.

  We follow the ARM application binary interface (EABI) in our choice
  of callee- and caller-save registers.
*)

Definition int_caller_save_regs :=
  R0 :: R1 :: R2 :: R3 :: R12 :: nil.

Definition float_caller_save_regs :=
  F0 :: F1 :: F2 :: F3 :: F4 :: F5 :: F6 :: F7 :: nil.

Definition int_callee_save_regs :=
  R4 :: R5 :: R6 :: R7 :: R8 :: R9 :: R10 :: R11 :: nil.

Definition float_callee_save_regs :=
  F8 :: F9 :: F10 :: F11 :: F12 :: F13 :: F14 :: F15 :: nil.

Definition destroyed_at_call :=
  int_caller_save_regs ++ float_caller_save_regs.

Definition dummy_int_reg := R0.     (**r Used in [Coloring]. *)
Definition dummy_float_reg := F0.   (**r Used in [Coloring]. *)

(** The [index_int_callee_save] and [index_float_callee_save] associate
  a unique positive integer to callee-save registers.  This integer is
  used in [Stacking] to determine where to save these registers in
  the activation record if they are used by the current function. *)

Definition index_int_callee_save (r: mreg) :=
  match r with
  | R4 => 0  | R5 => 1  | R6 => 2  | R7 => 3
  | R8 => 4  | R9 => 5  | R10 => 6 | R11 => 7
  | _ => -1
  end.

Definition index_float_callee_save (r: mreg) :=
  match r with
  | F8 => 0  | F9 => 1  | F10 => 2  | F11 => 3
  | F12 => 4  | F13 => 5  | F14 => 6  | F15 => 7
  | _ => -1
  end.

Ltac ElimOrEq :=
  match goal with
  |  |- (?x = ?y) \/ _ -> _ =>
       let H := fresh in
       (intro H; elim H; clear H;
        [intro H; rewrite <- H; clear H | ElimOrEq])
  |  |- False -> _ =>
       let H := fresh in (intro H; contradiction)
  end.

Ltac OrEq :=
  match goal with
  | |- (?x = ?x) \/ _ => left; reflexivity
  | |- (?x = ?y) \/ _ => right; OrEq
  | |- False => fail
  end.

Ltac NotOrEq :=
  match goal with
  | |- (?x = ?y) \/ _ -> False =>
       let H := fresh in (
       intro H; elim H; clear H; [intro; discriminate | NotOrEq])
  | |- False -> False =>
       contradiction
  end.

Lemma index_int_callee_save_pos:
  forall r, In r int_callee_save_regs -> index_int_callee_save r >= 0.
Proof.
  intro r. simpl; ElimOrEq; unfold index_int_callee_save; omega.
Qed.

Lemma index_float_callee_save_pos:
  forall r, In r float_callee_save_regs -> index_float_callee_save r >= 0.
Proof.
  intro r. simpl; ElimOrEq; unfold index_float_callee_save; omega.
Qed.

Lemma index_int_callee_save_pos2:
  forall r, index_int_callee_save r >= 0 -> In r int_callee_save_regs.
Proof.
  destruct r; simpl; intro; omegaContradiction || OrEq.
Qed.

Lemma index_float_callee_save_pos2:
  forall r, index_float_callee_save r >= 0 -> In r float_callee_save_regs.
Proof.
  destruct r; simpl; intro; omegaContradiction || OrEq.
Qed.

Lemma index_int_callee_save_inj:
  forall r1 r2,
  In r1 int_callee_save_regs ->
  In r2 int_callee_save_regs ->
  r1 <> r2 ->
  index_int_callee_save r1 <> index_int_callee_save r2.
Proof.
  intros r1 r2.
  simpl; ElimOrEq; ElimOrEq; unfold index_int_callee_save;
  intros; congruence.
Qed.

Lemma index_float_callee_save_inj:
  forall r1 r2,
  In r1 float_callee_save_regs ->
  In r2 float_callee_save_regs ->
  r1 <> r2 ->
  index_float_callee_save r1 <> index_float_callee_save r2.
Proof.
  intros r1 r2.
  simpl; ElimOrEq; ElimOrEq; unfold index_float_callee_save;
  intros; congruence.
Qed.

(** The following lemmas show that
    (temporaries, destroyed at call, integer callee-save, float callee-save)
    is a partition of the set of machine registers. *)

Lemma int_float_callee_save_disjoint:
  list_disjoint int_callee_save_regs float_callee_save_regs.
Proof.
  red; intros r1 r2. simpl; ElimOrEq; ElimOrEq; discriminate.
Qed.

Lemma register_classification:
  forall r,
  In r destroyed_at_call \/ In r int_callee_save_regs \/ In r float_callee_save_regs.
Proof.
  destruct r;
  try (left; simpl; OrEq);
  try (right; left; simpl; OrEq);
  try (right; right; simpl; OrEq).
Qed.

Lemma int_callee_save_not_destroyed:
  forall r,
    In r destroyed_at_call -> In r int_callee_save_regs -> False.
Proof.
  intros. revert H0 H. simpl. ElimOrEq; NotOrEq.
Qed.

Lemma float_callee_save_not_destroyed:
  forall r,
    In r destroyed_at_call -> In r float_callee_save_regs -> False.
Proof.
  intros. revert H0 H. simpl. ElimOrEq; NotOrEq.
Qed.

Lemma int_callee_save_type:
  forall r, In r int_callee_save_regs -> mreg_type r = Tany32.
Proof.
  intro. simpl; ElimOrEq; reflexivity.
Qed.

Lemma float_callee_save_type:
  forall r, In r float_callee_save_regs -> mreg_type r = Tany64.
Proof.
  intro. simpl; ElimOrEq; reflexivity.
Qed.

Ltac NoRepet :=
  match goal with
  | |- list_norepet nil =>
      apply list_norepet_nil
  | |- list_norepet (?a :: ?b) =>
      apply list_norepet_cons; [simpl; intuition discriminate | NoRepet]
  end.

Lemma int_callee_save_norepet:
  list_norepet int_callee_save_regs.
Proof.
  unfold int_callee_save_regs; NoRepet.
Qed.

Lemma float_callee_save_norepet:
  list_norepet float_callee_save_regs.
Proof.
  unfold float_callee_save_regs; NoRepet.
Qed.

(** * Function calling conventions *)

(** The functions in this section determine the locations (machine registers
  and stack slots) used to communicate arguments and results between the
  caller and the callee during function calls.  These locations are functions
  of the signature of the function and of the call instruction.
  Agreement between the caller and the callee on the locations to use
  is guaranteed by our dynamic semantics for Cminor and RTL, which demand
  that the signature of the call instruction is identical to that of the
  called function.

  Calling conventions are largely arbitrary: they must respect the properties
  proved in this section (such as no overlapping between the locations
  of function arguments), but this leaves much liberty in choosing actual
  locations.  *)

(** ** Location of function result *)

(** The result value of a function is passed back to the caller in
  registers [R0] or [F0] or [R0,R1], depending on the type of the
  returned value.  We treat a function without result as a function
  with one integer result.

  For the "softfloat" convention, results of FP types should be passed
  in [R0] or [R0,R1].  This doesn't fit the CompCert register model,
  so we have code in [arm/PrintAsm.ml] that inserts additional moves
  to/from [F0]. *)

Definition loc_result (s: signature) : list mreg :=
  match s.(sig_res) with
  | None => R0 :: nil
  | Some (Tint | Tany32) => R0 :: nil
  | Some (Tfloat | Tsingle | Tany64) => F0 :: nil
  | Some Tlong => R1 :: R0 :: nil
  end.

(** The result registers have types compatible with that given in the signature. *)

Lemma loc_result_type:
  forall sig,
  subtype_list (proj_sig_res' sig) (map mreg_type (loc_result sig)) = true.
Proof.
  intros. unfold proj_sig_res', loc_result. destruct (sig_res sig) as [[]|]; auto.
Qed.

(** The result locations are caller-save registers *)

Lemma loc_result_caller_save:
  forall (s: signature) (r: mreg),
  In r (loc_result s) -> In r destroyed_at_call.
Proof.
  intros.
  assert (r = R0 \/ r = R1 \/ r = F0).
    unfold loc_result in H. destruct (sig_res s); [destruct t|idtac]; simpl in H; intuition.
  destruct H0 as [A | [A | A]]; subst r; simpl; OrEq.
Qed.

(** ** Location of function arguments *)

(** For the "hardfloat" configuration, we use the following calling conventions,
    adapted from the ARM EABI-HF:
- The first 4 integer arguments are passed in registers [R0] to [R3].
- The first 2 long integer arguments are passed in an aligned pair of
  two integer registers.
- The first 8 single- and double-precision float arguments are passed
  in registers [F0...F7]
- Extra arguments are passed on the stack, in [Outgoing] slots, consecutively
  assigned (1 word for an integer or single argument, 2 words for a float
  or a long), starting at word offset 0.

This convention is not quite that of the ARM EABI-HF, whereas single float
arguments are passed in 32-bit float registers.  Unfortunately,
this does not fit the data model of CompCert.  In [PrintAsm.ml]
we insert additional code around function calls that moves
data appropriately. *)

Definition int_param_regs :=
  R0 :: R1 :: R2 :: R3 :: nil.

Definition float_param_regs :=
  F0 :: F1 :: F2 :: F3 :: F4 :: F5 :: F6 :: F7 :: nil.

Definition ireg_param (n: Z) : mreg :=
  match list_nth_z int_param_regs n with Some r => r | None => R0 end.

Definition freg_param (n: Z) : mreg :=
  match list_nth_z float_param_regs n with Some r => r | None => F0 end.

Fixpoint loc_arguments_hf
     (tyl: list typ) (ir fr ofs: Z) {struct tyl} : list loc :=
  match tyl with
  | nil => nil
  | (Tint | Tany32) as ty :: tys =>
      if zlt ir 4
      then R (ireg_param ir) :: loc_arguments_hf tys (ir + 1) fr ofs
      else S Outgoing ofs ty :: loc_arguments_hf tys ir fr (ofs + 1)
  | (Tfloat | Tany64) as ty :: tys =>
      if zlt fr 8
      then R (freg_param fr) :: loc_arguments_hf tys ir (fr + 1) ofs
      else let ofs := align ofs 2 in
           S Outgoing ofs ty :: loc_arguments_hf tys ir fr (ofs + 2)
  | Tsingle :: tys =>
      if zlt fr 8
      then R (freg_param fr) :: loc_arguments_hf tys ir (fr + 1) ofs
      else S Outgoing ofs Tsingle :: loc_arguments_hf tys ir fr (ofs + 1)
  | Tlong :: tys =>
      let ir := align ir 2 in
      if zlt ir 4
      then R (ireg_param (ir + 1)) :: R (ireg_param ir) :: loc_arguments_hf tys (ir + 2) fr ofs
      else let ofs := align ofs 2 in
          S Outgoing (ofs + 1) Tint :: S Outgoing ofs Tint :: loc_arguments_hf tys ir fr (ofs + 2)
  end.

(** For the "softfloat" configuration, as well as for variable-argument functions
  in the "hardfloat" configuration, we use the default ARM EABI (not HF)
  calling conventions:
- The first 4 integer arguments are passed in registers [R0] to [R3].
- The first 2 long integer arguments are passed in an aligned pair of
  two integer registers.
- The first 2 double-precision float arguments are passed in [F0] or [F2]
- The first 4 single-precision float arguments are passed in [F0...F3]
- Integer arguments and float arguments are kept in sync so that
  they can all be mapped back to [R0...R3] in [PrintAsm.ml].
- Extra arguments are passed on the stack, in [Outgoing] slots, consecutively
  assigned (1 word for an integer or single argument, 2 words for a float
  or a long), starting at word offset 0.

This convention is not quite that of the ARM EABI, whereas every float
argument are passed in one or two integer registers.  Unfortunately,
this does not fit the data model of CompCert.  In [PrintAsm.ml]
we insert additional code around function calls and returns that moves
data appropriately. *)

Fixpoint loc_arguments_sf
     (tyl: list typ) (ofs: Z) {struct tyl} : list loc :=
  match tyl with
  | nil => nil
  | (Tint|Tany32) as ty :: tys =>
      (if zlt ofs 0 then R (ireg_param (ofs + 4)) else S Outgoing ofs ty)
      :: loc_arguments_sf tys (ofs + 1)
  | (Tfloat|Tany64) as ty :: tys =>
      let ofs := align ofs 2 in
      (if zlt ofs 0 then R (freg_param (ofs + 4)) else S Outgoing ofs ty)
      :: loc_arguments_sf tys (ofs + 2)
  | Tsingle :: tys =>
      (if zlt ofs 0 then R (freg_param (ofs + 4)) else S Outgoing ofs Tsingle)
      :: loc_arguments_sf tys (ofs + 1)
  | Tlong :: tys =>
      let ofs := align ofs 2 in
      (if zlt ofs 0 then R (ireg_param (ofs+1+4)) else S Outgoing (ofs+1) Tint)
      :: (if zlt ofs 0 then R (ireg_param (ofs+4)) else S Outgoing ofs Tint)
      :: loc_arguments_sf tys (ofs + 2)
  end.

(** [loc_arguments s] returns the list of locations where to store arguments
  when calling a function with signature [s].  *)

Definition loc_arguments (s: signature) : list loc :=
  match Archi.abi with
  | Archi.Softfloat =>
      loc_arguments_sf s.(sig_args) (-4)
  | Archi.Hardfloat =>
      if s.(sig_cc).(cc_vararg)
      then loc_arguments_sf s.(sig_args) (-4)
      else loc_arguments_hf s.(sig_args) 0 0 0
  end.

(** [size_arguments s] returns the number of [Outgoing] slots used
  to call a function with signature [s]. *)

Fixpoint size_arguments_hf (tyl: list typ) (ir fr ofs: Z) {struct tyl} : Z :=
  match tyl with
  | nil => ofs
  | (Tint|Tany32) :: tys =>
      if zlt ir 4
      then size_arguments_hf tys (ir + 1) fr ofs
      else size_arguments_hf tys ir fr (ofs + 1)
  | (Tfloat|Tany64) :: tys =>
      if zlt fr 8
      then size_arguments_hf tys ir (fr + 1) ofs
      else size_arguments_hf tys ir fr (align ofs 2 + 2)
  | Tsingle :: tys =>
      if zlt fr 8
      then size_arguments_hf tys ir (fr + 1) ofs
      else size_arguments_hf tys ir fr (ofs + 1)
  | Tlong :: tys =>
      let ir := align ir 2 in
      if zlt ir 4
      then size_arguments_hf tys (ir + 2) fr ofs
      else size_arguments_hf tys ir fr (align ofs 2 + 2)
  end.

Fixpoint size_arguments_sf (tyl: list typ) (ofs: Z) {struct tyl} : Z :=
  match tyl with
  | nil => Zmax 0 ofs
  | (Tint | Tsingle | Tany32) :: tys => size_arguments_sf tys (ofs + 1)
  | (Tfloat | Tlong | Tany64) :: tys => size_arguments_sf tys (align ofs 2 + 2)
  end.

Definition size_arguments (s: signature) : Z :=
  match Archi.abi with
  | Archi.Softfloat =>
      size_arguments_sf s.(sig_args) (-4)
  | Archi.Hardfloat =>
      if s.(sig_cc).(cc_vararg)
      then size_arguments_sf s.(sig_args) (-4)
      else size_arguments_hf s.(sig_args) 0 0 0
  end.

(** Argument locations are either non-temporary registers or [Outgoing]
  stack slots at nonnegative offsets. *)

Definition loc_argument_acceptable (l: loc) : Prop :=
  match l with
  | R r => In r destroyed_at_call
  | S Outgoing ofs ty => ofs >= 0 /\ ty <> Tlong
  | _ => False
  end.

Remark ireg_param_in_params: forall n, In (ireg_param n) int_param_regs.
Proof.
  unfold ireg_param; intros.
  destruct (list_nth_z int_param_regs n) as [r|] eqn:NTH.
  eapply list_nth_z_in; eauto.
  simpl; auto.
Qed.

Remark freg_param_in_params: forall n, In (freg_param n) float_param_regs.
Proof.
  unfold freg_param; intros.
  destruct (list_nth_z float_param_regs n) as [r|] eqn:NTH.
  eapply list_nth_z_in; eauto.
  simpl; auto.
Qed.

Remark loc_arguments_hf_charact:
  forall tyl ir fr ofs l,
  In l (loc_arguments_hf tyl ir fr ofs) ->
  match l with
  | R r => In r int_param_regs \/ In r float_param_regs
  | S Outgoing ofs' ty => ofs' >= ofs /\ ty <> Tlong
  | S _ _ _ => False
  end.
Proof.
  assert (INCR: forall l ofs1 ofs2,
            match l with
            | R r => In r int_param_regs \/ In r float_param_regs
            | S Outgoing ofs' ty => ofs' >= ofs2 /\ ty <> Tlong
            | S _ _ _ => False
            end ->
            ofs1 <= ofs2 ->
            match l with
            | R r => In r int_param_regs \/ In r float_param_regs
            | S Outgoing ofs' ty => ofs' >= ofs1 /\ ty <> Tlong
            | S _ _ _ => False
            end).
  {
    intros. destruct l; auto. destruct sl; auto. intuition omega.
  }
  induction tyl; simpl loc_arguments_hf; intros.
  elim H.
  destruct a.
- (* int *)
  destruct (zlt ir 4); destruct H.
  subst. left; apply ireg_param_in_params.
  eapply IHtyl; eauto.
  subst. split; [omega | congruence].
  eapply INCR. eapply IHtyl; eauto. omega.
- (* float *)
  destruct (zlt fr 8); destruct H.
  subst. right; apply freg_param_in_params.
  eapply IHtyl; eauto.
  subst. split. apply Zle_ge. apply align_le. omega. congruence.
  eapply INCR. eapply IHtyl; eauto.
  apply Zle_trans with (align ofs 2). apply align_le; omega. omega.
- (* long *)
  set (ir' := align ir 2) in *.
  assert (ofs <= align ofs 2) by (apply align_le; omega).
  destruct (zlt ir' 4).
  destruct H. subst l; left; apply ireg_param_in_params.
  destruct H. subst l; left; apply ireg_param_in_params.
  eapply IHtyl; eauto.
  destruct H. subst l; split; [ omega | congruence ].
  destruct H. subst l; split; [ omega | congruence ].
  eapply INCR. eapply IHtyl; eauto. omega.
- (* single *)
  destruct (zlt fr 8); destruct H.
  subst. right; apply freg_param_in_params.
  eapply IHtyl; eauto.
  subst. split; [omega | congruence].
  eapply INCR. eapply IHtyl; eauto. omega.
- (* any32 *)
  destruct (zlt ir 4); destruct H.
  subst. left; apply ireg_param_in_params.
  eapply IHtyl; eauto.
  subst. split; [omega | congruence].
  eapply INCR. eapply IHtyl; eauto. omega.
- (* any64 *)
  destruct (zlt fr 8); destruct H.
  subst. right; apply freg_param_in_params.
  eapply IHtyl; eauto.
  subst. split. apply Zle_ge. apply align_le. omega. congruence.
  eapply INCR. eapply IHtyl; eauto.
  apply Zle_trans with (align ofs 2). apply align_le; omega. omega.
Qed.

Remark loc_arguments_sf_charact:
  forall tyl ofs l,
  In l (loc_arguments_sf tyl ofs) ->
  match l with
  | R r => In r int_param_regs \/ In r float_param_regs
  | S Outgoing ofs' ty => ofs' >= Zmax 0 ofs /\ ty <> Tlong
  | S _ _ _ => False
  end.
Proof.
  assert (INCR: forall l ofs1 ofs2,
            match l with
            | R r => In r int_param_regs \/ In r float_param_regs
            | S Outgoing ofs' ty => ofs' >= Zmax 0 ofs2 /\ ty <> Tlong
            | S _ _ _ => False
            end ->
            ofs1 <= ofs2 ->
            match l with
            | R r => In r int_param_regs \/ In r float_param_regs
            | S Outgoing ofs' ty => ofs' >= Zmax 0 ofs1 /\ ty <> Tlong
            | S _ _ _ => False
            end).
  {
    intros. destruct l; auto. destruct sl; auto. intuition xomega.
  }
  induction tyl; simpl loc_arguments_sf; intros.
  elim H.
  destruct a.
- (* int *)
  destruct H.
  destruct (zlt ofs 0); subst l.
  left; apply ireg_param_in_params.
  split. xomega. congruence.
  eapply INCR. eapply IHtyl; eauto. omega.
- (* float *)
  set (ofs' := align ofs 2) in *.
  assert (ofs <= ofs') by (apply align_le; omega).
  destruct H.
  destruct (zlt ofs' 0); subst l.
  right; apply freg_param_in_params.
  split. xomega. congruence.
  eapply INCR. eapply IHtyl; eauto. omega.
- (* long *)
  set (ofs' := align ofs 2) in *.
  assert (ofs <= ofs') by (apply align_le; omega).
  destruct H.
  destruct (zlt ofs' 0); subst l.
  left; apply ireg_param_in_params.
  split. xomega. congruence.
  destruct H.
  destruct (zlt ofs' 0); subst l.
  left; apply ireg_param_in_params.
  split. xomega. congruence.
  eapply INCR. eapply IHtyl; eauto. omega.
- (* single *)
  destruct H.
  destruct (zlt ofs 0); subst l.
  right; apply freg_param_in_params.
  split. xomega. congruence.
  eapply INCR. eapply IHtyl; eauto. omega.
- (* any32 *)
  destruct H.
  destruct (zlt ofs 0); subst l.
  left; apply ireg_param_in_params.
  split. xomega. congruence.
  eapply INCR. eapply IHtyl; eauto. omega.
- (* any64 *)
  set (ofs' := align ofs 2) in *.
  assert (ofs <= ofs') by (apply align_le; omega).
  destruct H.
  destruct (zlt ofs' 0); subst l.
  right; apply freg_param_in_params.
  split. xomega. congruence.
  eapply INCR. eapply IHtyl; eauto. omega.
Qed.

Lemma loc_arguments_acceptable:
  forall (s: signature) (l: loc),
  In l (loc_arguments s) -> loc_argument_acceptable l.
Proof.
  unfold loc_arguments; intros.
  assert (forall r, In r int_param_regs \/ In r float_param_regs -> In r destroyed_at_call).
  {
    intros. elim H0; simpl; ElimOrEq; OrEq.
  }
  assert (In l (loc_arguments_sf (sig_args s) (-4)) -> loc_argument_acceptable l).
  { intros. red. exploit loc_arguments_sf_charact; eauto. destruct l; auto. }
  assert (In l (loc_arguments_hf (sig_args s) 0 0 0) -> loc_argument_acceptable l).
  { intros. red. exploit loc_arguments_hf_charact; eauto. destruct l; auto. }
  destruct Archi.abi; [ | destruct (cc_vararg (sig_cc s)) ]; auto.
Qed.

Hint Resolve loc_arguments_acceptable: locs.

(** The offsets of [Outgoing] arguments are below [size_arguments s]. *)

Remark size_arguments_hf_above:
  forall tyl ir fr ofs0,
  ofs0 <= size_arguments_hf tyl ir fr ofs0.
Proof.
  induction tyl; simpl; intros.
  omega.
  destruct a.
  destruct (zlt ir 4); eauto. apply Zle_trans with (ofs0 + 1); auto; omega.
  destruct (zlt fr 8); eauto.
  apply Zle_trans with (align ofs0 2). apply align_le; omega.
  apply Zle_trans with (align ofs0 2 + 2); auto; omega.
  set (ir' := align ir 2).
  destruct (zlt ir' 4); eauto.
  apply Zle_trans with (align ofs0 2). apply align_le; omega.
  apply Zle_trans with (align ofs0 2 + 2); auto; omega.
  destruct (zlt fr 8); eauto.
  apply Zle_trans with (ofs0 + 1); eauto. omega.
  destruct (zlt ir 4); eauto. apply Zle_trans with (ofs0 + 1); auto; omega.
  destruct (zlt fr 8); eauto.
  apply Zle_trans with (align ofs0 2). apply align_le; omega.
  apply Zle_trans with (align ofs0 2 + 2); auto; omega.
Qed.

Remark size_arguments_sf_above:
  forall tyl ofs0,
  Zmax 0 ofs0 <= size_arguments_sf tyl ofs0.
Proof.
  induction tyl; simpl; intros.
  omega.
  destruct a; (eapply Zle_trans; [idtac|eauto]).
  xomega.
  assert (ofs0 <= align ofs0 2) by (apply align_le; omega). xomega.
  assert (ofs0 <= align ofs0 2) by (apply align_le; omega). xomega.
  xomega.
  xomega.
  assert (ofs0 <= align ofs0 2) by (apply align_le; omega). xomega.
Qed.

Lemma size_arguments_above:
  forall s, size_arguments s >= 0.
Proof.
  intros; unfold size_arguments. apply Zle_ge.
  assert (0 <= size_arguments_sf (sig_args s) (-4)).
  { change 0 with (Zmax 0 (-4)). apply size_arguments_sf_above. }
  assert (0 <= size_arguments_hf (sig_args s) 0 0 0).
  { apply size_arguments_hf_above. }
  destruct Archi.abi; [ | destruct (cc_vararg (sig_cc s)) ]; auto.
Qed.

Lemma loc_arguments_hf_bounded:
  forall ofs ty tyl ir fr ofs0,
  In (S Outgoing ofs ty) (loc_arguments_hf tyl ir fr ofs0) ->
  ofs + typesize ty <= size_arguments_hf tyl ir fr ofs0.
Proof.
  induction tyl; simpl; intros.
  elim H.
  destruct a.
- (* int *)
  destruct (zlt ir 4); destruct H.
  discriminate.
  eauto.
  inv H. apply size_arguments_hf_above.
  eauto.
- (* float *)
  destruct (zlt fr 8); destruct H.
  discriminate.
  eauto.
  inv H. apply size_arguments_hf_above.
  eauto.
- (* long *)
  destruct (zlt (align ir 2) 4).
  destruct H. discriminate. destruct H. discriminate. eauto.
  destruct H. inv H.
  rewrite <- Zplus_assoc. simpl. apply size_arguments_hf_above.
  destruct H. inv H.
  eapply Zle_trans. 2: apply size_arguments_hf_above. simpl; omega.
  eauto.
- (* float *)
  destruct (zlt fr 8); destruct H.
  discriminate.
  eauto.
  inv H. apply size_arguments_hf_above.
  eauto.
- (* any32 *)
  destruct (zlt ir 4); destruct H.
  discriminate.
  eauto.
  inv H. apply size_arguments_hf_above.
  eauto.
- (* any64 *)
  destruct (zlt fr 8); destruct H.
  discriminate.
  eauto.
  inv H. apply size_arguments_hf_above.
  eauto.
Qed.

Lemma loc_arguments_sf_bounded:
  forall ofs ty tyl ofs0,
  In (S Outgoing ofs ty) (loc_arguments_sf tyl ofs0) ->
  Zmax 0 (ofs + typesize ty) <= size_arguments_sf tyl ofs0.
Proof.
  induction tyl; simpl; intros.
  elim H.
  destruct a.
- (* int *)
  destruct H.
  destruct (zlt ofs0 0); inv H. apply size_arguments_sf_above.
  eauto.
- (* float *)
  destruct H.
  destruct (zlt (align ofs0 2) 0); inv H. apply size_arguments_sf_above.
  eauto.
- (* long *)
  destruct H.
  destruct (zlt (align ofs0 2) 0); inv H.
  rewrite <- Zplus_assoc. simpl. apply size_arguments_sf_above.
  destruct H.
  destruct (zlt (align ofs0 2) 0); inv H.
  eapply Zle_trans. 2: apply size_arguments_sf_above. simpl; xomega.
  eauto.
- (* float *)
  destruct H.
  destruct (zlt ofs0 0); inv H. apply size_arguments_sf_above.
  eauto.
- (* any32 *)
  destruct H.
  destruct (zlt ofs0 0); inv H. apply size_arguments_sf_above.
  eauto.
- (* any64 *)
  destruct H.
  destruct (zlt (align ofs0 2) 0); inv H. apply size_arguments_sf_above.
  eauto.
Qed.

Lemma loc_arguments_bounded:
  forall (s: signature) (ofs: Z) (ty: typ),
  In (S Outgoing ofs ty) (loc_arguments s) ->
  ofs + typesize ty <= size_arguments s.
Proof.
  unfold loc_arguments, size_arguments; intros.
  assert (In (S Outgoing ofs ty) (loc_arguments_sf (sig_args s) (-4)) ->
          ofs + typesize ty <= size_arguments_sf (sig_args s) (-4)).
  { intros. eapply Zle_trans. 2: eapply loc_arguments_sf_bounded; eauto. xomega. }
  assert (In (S Outgoing ofs ty) (loc_arguments_hf (sig_args s) 0 0 0) ->
          ofs + typesize ty <= size_arguments_hf (sig_args s) 0 0 0).
  { intros. eapply loc_arguments_hf_bounded; eauto. }
  destruct Archi.abi; [ | destruct (cc_vararg (sig_cc s)) ]; eauto.
Qed.

Lemma loc_arguments_main:
  loc_arguments signature_main = nil.
Proof.
  unfold loc_arguments.
  destruct Archi.abi; reflexivity.
Qed.