(** * Structures/CountingBloomFilter/CountingBloomFilter_Definitions.v
-----------------

Provides the definitions and deterministic operations of a Counting
Bloom Filter and uses them to instantiate the AMQ interface.

This file is a good example of how to construct the modules required
by AMQReduction interface. See [BloomFilterReduction]  *)

From mathcomp.ssreflect
     Require Import ssreflect ssrbool ssrnat eqtype fintype choice ssrfun seq path bigop finfun .

From mathcomp.ssreflect
     Require Import tuple.

From mathcomp
     Require Import path.

Require Import Coq.Logic.ProofIrrelevance.
Require Import Coq.Logic.FunctionalExtensionality.

Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.

From ProbHash.Computation
     Require Import Comp Notationv1.

From ProbHash.Core
     Require Import Hash HashVec FixedList AMQ AMQHash AMQReduction.

From ProbHash.Utils
     Require Import seq_ext.

From ProbHash.BloomFilter
     Require Import BloomFilter_Definitions BloomFilter_Probability.

Module CountingBloomFilterDefinitions (Spec:HashSpec).

  Module BloomFilterProbability := (BloomFilterProbability Spec).
  Export BloomFilterProbability.

  (** A fomalization of a counting bloom filter structure and properties *)
  Section CountingBloomFilter.
    (**    k - number of hashes *)
    Variable k: nat.
    (** n - maximum number of hashes supported *)
    Variable n: nat.

    Lemma Hngt0: n.+1 > 0.
    Proof. by []. Qed.

    Variable Hkgt0: k >0.
    (**
     list of hash functions used in the bloom filter
     *)
    Definition CountVector := (Hash_size.+1).-tuple 'I_n.+1.

    Record CountingBloomFilter := mkCountingBloomFilter {
                                      counting_bloomfilter_state: CountVector
                                    }.

    Definition Countingbloomfilter_prod (bf: CountingBloomFilter) :=
      (counting_bloomfilter_state bf).

    Definition prod_Countingbloomfilter  pair := let: (state) := pair in @mkCountingBloomFilter state.

    Lemma countingbloomfilter_cancel : cancel (Countingbloomfilter_prod) (prod_Countingbloomfilter).
    Proof.
        by case.
    Qed.

    Definition countingbloomfilter_eqMixin :=
      CanEqMixin countingbloomfilter_cancel .

    Canonical countingbloomfilter_eqType  :=
      Eval hnf in EqType CountingBloomFilter  countingbloomfilter_eqMixin .

    Definition countingbloomfilter_choiceMixin :=
      CanChoiceMixin countingbloomfilter_cancel.

    Canonical countingbloomfilter_choiceType  :=
      Eval hnf in ChoiceType CountingBloomFilter  countingbloomfilter_choiceMixin.

    Definition countingbloomfilter_countMixin :=
      CanCountMixin countingbloomfilter_cancel.

    Canonical countingbloomfilter_countType :=
      Eval hnf in CountType CountingBloomFilter  countingbloomfilter_countMixin.

    Definition countingbloomfilter_finMixin :=
      CanFinMixin countingbloomfilter_cancel .

    Canonical countingbloomfilter_finType :=
      Eval hnf in FinType CountingBloomFilter  countingbloomfilter_finMixin.

    Definition incr_bit (value: 'I_n.+1) : 'I_n.+1 :=
      (if value.+1 < n.+1 as b return ((value.+1 < n.+1) = b -> 'I_n.+1)
       then (fun b0 => Ordinal b0)
       else (fun _ => value)) (erefl (value.+1 < n.+1)).

    Lemma decr_bitP m : m.+1 < n.+1 -> m < n.+1.
    Proof. by rewrite -{1}addn1 => /InvMisc.addr_ltn. Qed.

    Definition decr_bit (value: 'I_n.+1) : 'I_n.+1 :=
      match value with
        Ordinal 0 Hm => Ordinal Hm
      | Ordinal m.+1 Hm => Ordinal (decr_bitP Hm)
      end.

    Definition countingbloomfilter_set_bit (value: 'I_(Hash_size.+1)) bf : CountingBloomFilter :=
      mkCountingBloomFilter
        (set_tnth (counting_bloomfilter_state bf)
                  (incr_bit (tnth (counting_bloomfilter_state bf) value))
                  value).

    Definition countingbloomfilter_unset_bit (value: 'I_(Hash_size.+1)) bf : CountingBloomFilter :=
      mkCountingBloomFilter
        (set_tnth (counting_bloomfilter_state bf)
                  (decr_bit (tnth (counting_bloomfilter_state bf) value))
                  value).

    Definition countingbloomfilter_get_bit (value: 'I_(Hash_size.+1)) bf : bool :=
      (tnth (counting_bloomfilter_state bf) value) > 0.

    Fixpoint countingbloomfilter_add_internal (items: seq 'I_(Hash_size.+1)) bf : CountingBloomFilter :=
      match items with
        h::t => countingbloomfilter_add_internal t (countingbloomfilter_set_bit h bf)
      | [::]   => bf
      end.

    Fixpoint countingbloomfilter_remove_internal (items: seq 'I_(Hash_size.+1)) bf : CountingBloomFilter :=
      match items with
        h::t => countingbloomfilter_remove_internal t (countingbloomfilter_unset_bit h bf)
      | [::]   => bf
      end.

    Definition countingbloomfilter_add (value: B) (hashes: k.-tuple (HashState n)) (bf: CountingBloomFilter) : Comp [finType of (k.-tuple (HashState n)) * CountingBloomFilter] :=
      hash_res <-$ (hash_vec_int value hashes);
        let (new_hashes, hash_vec) := hash_res in
        let new_bf := countingbloomfilter_add_internal (tval hash_vec) bf in
        ret (new_hashes, new_bf).

    Definition countingbloomfilter_remove (value: hash_keytype) (hashes: k.-tuple (HashState n)) (bf: CountingBloomFilter) : Comp [finType of (k.-tuple (HashState n)) * CountingBloomFilter] :=
      hash_res <-$ (hash_vec_int value hashes);
        let (new_hashes, hash_vec) := hash_res in
        let new_bf := countingbloomfilter_remove_internal (tval hash_vec) bf in
        ret (new_hashes, new_bf).

    Definition countingbloomfilter_query_internal (items: seq 'I_(Hash_size.+1)) bf : bool :=
      all (fun h => countingbloomfilter_get_bit h bf) items.

    Definition countingbloomfilter_query (value: hash_keytype) (hashes: k.-tuple (HashState n)) (bf: CountingBloomFilter) : Comp [finType of (k.-tuple (HashState n)) * bool ] :=
      hash_res <-$ (hash_vec_int value hashes);
        let (new_hashes, hash_vec) := hash_res in
        let qres := countingbloomfilter_query_internal (tval hash_vec) bf in
        ret (new_hashes, qres).

    Definition countingbloomfilter_bitcount (bf: CountingBloomFilter) : nat :=
      (foldr (fun a b => (nat_of_ord a) + b) 0 (tval (counting_bloomfilter_state bf))).

    Definition countingbloomfilter_free_capacity (bf: CountingBloomFilter) l :=
      all (fun a => (nat_of_ord a) + l < n.+1) (tval (counting_bloomfilter_state bf)).

    Definition countingbloomfilter_used_capacity (bf: CountingBloomFilter) l :=
      all (fun a => l < (nat_of_ord a)) (tval (counting_bloomfilter_state bf)).

    Definition countingbloomfilter_new :  CountingBloomFilter.
      apply mkCountingBloomFilter.
      apply Tuple with (nseq Hash_size.+1 (Ordinal Hngt0)).
        by rewrite size_nseq.
    Defined.

    Definition countingbloomfilter_add_multiple  hsh_0 bf_0 values :=
      @foldr B (Comp [finType of k.-tuple (HashState n) * CountingBloomFilter])
             (fun val hsh_bf =>
                res_1 <-$ hsh_bf;
                  let (hsh, bf) := res_1 in
                  countingbloomfilter_add val hsh bf) (ret (hsh_0, bf_0)) values.

    Lemma countingbloomfilter_new_empty_bitcount (Hngt0: n.+1 > 0):
      countingbloomfilter_bitcount (countingbloomfilter_new) = 0.
    Proof.
      rewrite/countingbloomfilter_bitcount //=; rewrite add0n.
        by elim: Hash_size => [//=| m IHm] //=.
    Qed.

    Lemma incr_bit_valid ind (Hngt0: n > 0):
      0 < incr_bit ind.
    Proof.
      rewrite /incr_bit.
      move: n  ind Hngt0 => [//=[]//=|//= ];clear n.
      move=> n [m Hm].
      move: (erefl _ ) => //=.
      case Hltn: (m < n.+1).
      - {
          have Hltn': (m.+1 < n.+2); first by apply InvMisc.ltn_SnnP.
            by rewrite {2 3}Hltn' //=.
        }
      - {
          have Hltn': (m.+1 < n.+2) = false;
          first by case Hltn'': (_ < _) => //=;move/InvMisc.ltn_SnnP: Hltn'' Hltn ->.
          rewrite {2 3}Hltn' //= => _.
          move/Bool.negb_true_iff: Hltn; rewrite leqNgt Bool.negb_involutive => Hn.
            by move: (InvMisc.ltnSn_eq _ _ Hm Hn)=>/eqP ->.
        }
    Qed.

    Lemma countingbloomfilter_bitcount_incr l bf ind:
      countingbloomfilter_free_capacity bf l.+1 ->
      countingbloomfilter_bitcount bf + l.+1 =
      countingbloomfilter_bitcount (countingbloomfilter_set_bit ind bf) + l.
    Proof.
      move: bf => []; rewrite/CountVector //=.
      rewrite/countingbloomfilter_free_capacity
             /countingbloomfilter_set_bit
             /countingbloomfilter_bitcount/counting_bloomfilter_state.
      elim: (Hash_size) ind => [| m Im].
      - {
          move=> [ind Hind] [[//=|b [|//=]] Hbf] /allP Hbits //=.
          rewrite //= addn0.
          case: ind Hind => //= Hind.
          - {
              rewrite addn0; have ->: (tnth (Tuple Hbf) (Ordinal Hind)) = b; first by [].
              have H1: (b \in Tuple (Hbf)); first by rewrite mem_seq1 eq_refl.
              move: (Hbits b H1).
              rewrite addnS -addSn => /InvMisc.addr_ltn H2.
              rewrite/incr_bit; move: (erefl _ ) => //=.
                by rewrite {2 3}H2 //=.
            }
        }
      - {
          move=> [[|ind] Hind] [[//=| x xs] Hxs] //=/andP [Hltn Hallltn].
          - {
              have H1: (0 < m.+1); first by [].
              rewrite -addnA.
              have Hxs': size xs == m.+1; first by move/eqP: Hxs => //= [->] //=.
              have->: (tnth (Tuple Hxs) (Ordinal Hind)) = x; first by [].
              move: Hltn; rewrite addnS -addSn => /InvMisc.addr_ltn H2.
              rewrite/incr_bit; move: (erefl _ ) => //=.
              rewrite {2 3}H2 //= =>_.
                by rewrite addnS addnS -addSn addnA.
            }
          - {
              have H1: (ind < m.+1); first by move/InvMisc.ltn_Snn: Hind.
              have H2: size xs == m.+1; first by move/eqP: Hxs => //= [->] //=.
              rewrite -addnA; move: (Im (Ordinal H1) (Tuple H2))=> //= -> //=.
              have->: (ntuple_head (Tuple Hxs)) = x; first by [].
              rewrite -addnA; apply f_equal.
              rewrite addnC [foldr _ _ _ + _]addnC; apply f_equal => //=.
              move: (erefl _ ) => //= H3.
              apply f_equal=>//=.
              case: ind Hind H1 H3 => //=; intros.
              {
                have->: (Tuple H2) = (behead_tuple (Tuple Hxs)).
                {
                  rewrite/behead_tuple; move: (behead_tupleP _) => //= H2'.
                    by rewrite (proof_irrelevance _ H2 H2').
                }
                rewrite tnth_behead //=.
                have->: (inord 1) = (Ordinal Hind).
                {
                  rewrite/inord/insubd/odflt/oapp //=.
                  move: (insubT (fun i => i < m.+2)) ->.
                    by rewrite/Sub//=.
                }
                  by [].

              }
              {
                rewrite/ntuple_tail.
                move: (behead_tupleP _) => //= H4.
                move: (behead_tupleP _) => //= H5.
                move: (behead_tupleP _) => //= H6.
                rewrite (proof_irrelevance _ H2 H5); clear H2.
                rewrite (proof_irrelevance _ H4 H6); clear H4.
                do? apply f_equal.
                have->: (Tuple H5) = (behead_tuple (Tuple Hxs)).
                {
                  rewrite/behead_tuple; move: (behead_tupleP _) => //= H2'.
                    by rewrite (proof_irrelevance _ H5 H2').
                }
                rewrite tnth_behead //=.
                have->: (inord n0.+2) = (Ordinal Hind).
                {
                  rewrite/inord/insubd/odflt/oapp //=.
                  move: (insubT (fun i => i < m.+2)) ->.
                    by rewrite/Sub//=.
                }
                  by [].
              }
            }
        }

    Qed.

    Lemma countingbloomfilter_add_capacity_decr l bf ind val:
      countingbloomfilter_free_capacity bf l.+1 ->
      val \in counting_bloomfilter_state (countingbloomfilter_set_bit ind bf) ->
              val + l < n.+1.
    Proof.
      case: bf; rewrite/CountVector=> bf; case: ind => ind Hind.
      rewrite/countingbloomfilter_free_capacity/counting_bloomfilter_state/countingbloomfilter_set_bit//.
      have->: (set_tnth (counting_bloomfilter_state {| counting_bloomfilter_state := bf |})
                        (incr_bit
                           (tnth (counting_bloomfilter_state {| counting_bloomfilter_state := bf |}) (Ordinal Hind)))
                        (Ordinal Hind)) =
      (set_tnth bf (incr_bit (tnth bf (Ordinal Hind))) (Ordinal Hind)
      ); first by [].
      elim: Hash_size bf ind Hind => [|m IHm] bf.
      - {
          move=> [|//=] Hind  /allP Hall //=.
          rewrite in_cons =>/orP [].
          - {
              move=>/eqP ->.
              move: (Hall _ (mem_tnth (Ordinal Hind) bf)).
              rewrite addnS -addSn => /InvMisc.addr_ltn H2.
              rewrite/incr_bit; move: (erefl _ ) => //=.
              rewrite {2 3}H2 //= =>_.
                by rewrite addSn -addnS; apply Hall; apply mem_tnth.
            }
          - {
              move=>/(mem_behead )/Hall; rewrite addnS -{1}(addn1 (val + l)).
                by move => /InvMisc.addr_ltn.
            }
        }
      - {
          move=>[|ind] Hind /allP Hall.
          rewrite in_cons =>/orP [].
          - {
              move=>/eqP ->.
              move: (Hall _ (mem_tnth (Ordinal Hind) bf)).
              rewrite addnS -addSn => /InvMisc.addr_ltn H2.
              rewrite/incr_bit; move: (erefl _ ) => //=.
              rewrite {2 3}H2 //= =>_.
                by rewrite addSn -addnS; apply Hall; apply mem_tnth.
            }
          - {
              move=>/(mem_behead )/Hall; rewrite addnS -{1}(addn1 (val + l)).
                by move => /InvMisc.addr_ltn.
            }
            have Hind' : ind < m.+1; first by move: Hind=>/InvMisc.ltn_Snn.
            move: bf Hall => [[//=| b bf] Hbf] Hall.
            have Hbf': (size bf) == m.+1; first by move: (Hbf) =>/eqP //=.
            have->: (set_tnth (Tuple Hbf)
                              (incr_bit (tnth (Tuple Hbf) (Ordinal Hind)))
                              (Ordinal Hind)) = (
              [tuple of b ::
                     (set_tnth (Tuple Hbf') ((incr_bit (tnth (Tuple Hbf') (Ordinal Hind')))) (Ordinal Hind'))]
            ).
            {
              move=> //=.
              have->: (ntuple_head (Tuple Hbf)) = b; first by [].
              case: ind Hind Hind' => [|ind] Hind Hind'.
              - {

                  have Heq: (Tuple Hbf') = (behead_tuple (Tuple Hbf)).
                  {
                    rewrite/behead_tuple; move: (behead_tupleP _) => //= H2'.
                      by rewrite (proof_irrelevance _ Hbf' H2').
                  }
                  have->:  (tnth (Tuple Hbf) (Ordinal Hind)) = (tnth (Tuple Hbf') (Ordinal Hind')).
                  {
                    have->: (Tuple Hbf') = [tuple of behead (Tuple Hbf)]; first by [].
                    rewrite tnth_behead.
                    have->: (inord (Ordinal Hind').+1) = (Ordinal Hind).
                    {
                      rewrite/inord/insubd/odflt/oapp //=.
                      move: (insubT (fun i => i < m.+2)) ->.
                        by rewrite/Sub//=.
                    }
                      by [].
                  }
                  move=>//=.
                  rewrite 2!/[tuple of _].
                  rewrite/ntuple_tail.
                  move: (behead_tupleP (Tuple Hbf)) => //= H1.
                  move: (behead_tupleP (Tuple H1)) => //= H2.
                  move: (behead_tupleP (Tuple Hbf')) => //= H3.
                  rewrite (proof_irrelevance _ H2 H3); clear H2.
                    by move: (valP _) => //= H2.
                }
              - {
                  rewrite/ntuple_tail.
                  move: (behead_tupleP (Tuple Hbf)) => //= H1.
                  move: (behead_tupleP (Tuple H1)) => //= H2.
                  move: (behead_tupleP (Tuple Hbf')) => //= H3.
                  rewrite (proof_irrelevance _ H2 H3); clear H2.
                  have->:  (tnth (Tuple Hbf) (Ordinal Hind)) = (tnth (Tuple Hbf') (Ordinal Hind')).
                  {
                    have->: (Tuple Hbf') = [tuple of behead (Tuple Hbf)].
                    {
                      rewrite /[tuple of _] //=.
                      move: (behead_tupleP _) => //= H4.
                      rewrite (proof_irrelevance _ H4 Hbf') => //=.
                    }
                    rewrite tnth_behead.
                    have->: (inord (Ordinal Hind').+1) = (Ordinal Hind).
                    {
                      rewrite/inord/insubd/odflt/oapp //=.
                      move: (insubT (fun i => i < m.+2)) ->.
                        by rewrite/Sub//=.
                    }
                      by [].
                  }
                    by rewrite (proof_irrelevance _ H1 Hbf') //=; clear H1.
                }
            }

            rewrite in_cons =>/orP [].
          - {
              move=>/eqP ->.
              have H1: (b \in (Tuple Hbf)); first by rewrite (tuple_eta (Tuple Hbf)) //= in_cons eq_refl.
              move: (Hall _ H1); rewrite addnS -{1}(addn1 (_ + l)).
                by move => /InvMisc.addr_ltn.
            }
          - {
              move=>/IHm IHm'; apply/IHm'; apply/allP=> b' Hb'.
              have H1: (b' \in (Tuple Hbf));
                first by rewrite (tuple_eta (Tuple Hbf)) //= in_cons Hb' Bool.orb_true_r.
                by move: (Hall _ H1).
            }
        }
    Qed.

    Lemma countingbloomfilter_add_internal_incr l (bf: CountingBloomFilter) (inds: seq 'I_(Hash_size.+1)):
      length inds == l ->
      countingbloomfilter_free_capacity bf l ->
      countingbloomfilter_bitcount bf + l =
      countingbloomfilter_bitcount (countingbloomfilter_add_internal inds bf).
    Proof.
      elim: l bf inds => [| l IHl] bf .
      - by move=> [|//=] _ _ //=; rewrite addn0.
      - {
          move=> [//=| ind inds] Hlen Hfree //= .
          rewrite -IHl.
          apply  countingbloomfilter_bitcount_incr =>//=.
          - by move/eqP:Hlen => //= [->].
          - {
              apply/allP => val Hval; move: Hfree Hval; clear.
                by apply countingbloomfilter_add_capacity_decr.
            }
        }
    Qed.

    Lemma countingbloomfilter_add_internal_decr m l (bf: CountingBloomFilter) (inds: seq 'I_(Hash_size.+1)):
      length inds == l ->
      countingbloomfilter_free_capacity bf l ->
      countingbloomfilter_used_capacity bf (m + l) ->
      countingbloomfilter_used_capacity (countingbloomfilter_add_internal inds bf) m.
    Proof.
      elim: l m bf inds => [| l IHl] m bf .
      - by move=> [|//=] _ _ //=; rewrite addn0.
      - {
          move=> [//=| ind inds] Hlen Hfree Hused //= .
          apply IHl => //=.
          - rewrite/countingbloomfilter_free_capacity; apply/allP => v Hv.
              by apply (@countingbloomfilter_add_capacity_decr l bf ind ) => //=.
          - rewrite/countingbloomfilter_used_capacity; apply/allP => v Hv.
            move: Hv; move=>/tnthP [v_ind ->]; clear v.

            case Hvind: (v_ind == ind); last first.
            {
              move/Bool.negb_true_iff: Hvind => Hvind; rewrite tnth_set_nth_neq //=.
              move/allP: Hused => Hused; move: (Hused _ (mem_tnth v_ind (counting_bloomfilter_state bf)) ).
              by rewrite addnS -addn1 =>/InvMisc.addr_ltn.
            }
            {
              move/eqP: Hvind => ->; rewrite tnth_set_nth_eq; clear v_ind.
              rewrite/incr_bit; move: (erefl _); case: {2 3}(_ < _) => //= Htnth.
              move/allP: Hused => Hused; move: (Hused _ (mem_tnth ind (counting_bloomfilter_state bf)) ).
                by rewrite addnS -addn1 =>/InvMisc.addr_ltn/(ltn_addr 1); rewrite addn1.
              move/allP: Hused => Hused; move: (Hused _ (mem_tnth ind (counting_bloomfilter_state bf)) ).
                by rewrite addnS -addn1 =>/InvMisc.addr_ltn.
               by [].
            }
        }
    Qed.

    Lemma countingbloomfilter_new_capacity l :
      l < n.+1 -> countingbloomfilter_free_capacity (countingbloomfilter_new ) l.
    Proof.
      move=> Hlen; rewrite/countingbloomfilter_new/countingbloomfilter_free_capacity//=.
      rewrite add0n; apply/andP; split => //=.
      apply/allP => val.
        by rewrite mem_nseq =>/andP [Hgt0 /eqP ->] //=.
    Qed.

    Lemma countingbloomfilter_add_capacity_change m l bf values:
      length values == m ->
      countingbloomfilter_free_capacity bf (m  + l) ->
      @countingbloomfilter_free_capacity (countingbloomfilter_add_internal values bf) l.
    Proof.
      rewrite /countingbloomfilter_free_capacity//=.
      move: values bf m k  ; clear k Hkgt0.
      elim => [//=| val vals Hvals] bf [//=|].
      - by move=> n' k' Hk' /eqP.
      - {
          move=> m k Hlen Hall //=.
          apply (@Hvals _ m k).
          - by move/eqP: Hlen => [->].
          - apply/allP => ind.
            move: Hall.
            move: (@countingbloomfilter_add_capacity_decr (m + l) bf val ind).
              by rewrite /countingbloomfilter_free_capacity//=.
        }
    Qed.

    Lemma countingbloomfilter_set_exchange bf ind ind':
      countingbloomfilter_set_bit ind'
                                  (countingbloomfilter_set_bit ind bf) =
      countingbloomfilter_set_bit ind
                                  (countingbloomfilter_set_bit ind' bf).
      Proof.

        have H v: (counting_bloomfilter_state ({| counting_bloomfilter_state := v |})) = v; first by [].
        case Hindeq: (ind == ind'); first by move/eqP: Hindeq <-; clear ind'.
        move/Bool.negb_true_iff: Hindeq => Hindeq.
        rewrite/countingbloomfilter_set_bit !H; rewrite !tnth_set_nth_neq; try by []; try by rewrite eq_sym.
        apply f_equal.
        apply eq_from_tnth => pos.
        case Hpos: (pos == ind').
        - {
            move/eqP:Hpos ->; clear pos.
            rewrite tnth_set_nth_eq; try by []; rewrite tnth_set_nth_neq; try by []; try by rewrite eq_sym.
            rewrite tnth_set_nth_eq; try by []; try by rewrite eq_sym.
          }
        case Hpos': (pos == ind).
        - {
            move/eqP:Hpos' Hpos ->; clear pos => _.
            rewrite tnth_set_nth_neq; try by []; rewrite tnth_set_nth_eq; try by []; rewrite tnth_set_nth_eq; try by [].
          }
          move/Bool.negb_true_iff: Hpos => Hpos; move/Bool.negb_true_iff: Hpos' => Hpos'.
          by do !(rewrite tnth_set_nth_neq; try by []).
      Qed.

    Lemma countingbloomfilter_add_internal_set_exchange (bf: CountingBloomFilter) ind inds:
      countingbloomfilter_add_internal inds (countingbloomfilter_set_bit ind bf) =
           (countingbloomfilter_set_bit  ind (countingbloomfilter_add_internal inds bf)).
    Proof.
      elim: inds bf ind => [| ind' inds Hinds] bf ind //=.
      by rewrite 3!Hinds countingbloomfilter_set_exchange.
    Qed.
    Lemma countingbloomfilter_set_unset_idempotent (bf: CountingBloomFilter) (ind: 'I_(Hash_size.+1)):
      (tnth  (counting_bloomfilter_state bf) ind).+1 < n.+1 ->
      countingbloomfilter_unset_bit ind (countingbloomfilter_set_bit ind bf) = bf.
    Proof.
      have H v: (counting_bloomfilter_state ({| counting_bloomfilter_state := v |})) = v; first by [].
      move: bf => [bf]; rewrite/countingbloomfilter_unset_bit/countingbloomfilter_set_bit !H => Htnth; apply f_equal.
      rewrite tnth_set_nth_eq; try by [].
      apply eq_from_tnth => pos.
      case Hposeq: (pos == ind).
      - {
          move/eqP:Hposeq => ->; clear pos.
          rewrite tnth_set_nth_eq; try by [].
          rewrite/incr_bit/decr_bit //=; move: (erefl _ ) => //=.
          case Heq: {-}((tnth bf ind).+1 < n.+1) => //=.
          - {
              rewrite {2 3}Heq => He.
              by move: (decr_bitP He); case: (tnth bf ind) => //= i H1 H2; rewrite (proof_irrelevance _ H1 H2).
            }
          - {
              rewrite {2 3}Heq => //=.
              by case: (tnth bf ind) Heq Htnth => //= [[| m] ] //= Hm ->.
            }
        }
      - by move/Bool.negb_true_iff: Hposeq => Hposeq; do !(rewrite tnth_set_nth_neq; try by []).
    Qed.

    Lemma countingbloomfilter_add_remove_idempotent l (bf: CountingBloomFilter) (inds: seq 'I_(Hash_size.+1)):
      length inds == l ->
      countingbloomfilter_free_capacity bf l ->
      bf = countingbloomfilter_remove_internal inds (countingbloomfilter_add_internal inds bf).
    Proof.
      move=>/eqP <-; elim: inds bf => [ //= | ind inds IHinds] bf //= /allP Hin.
      rewrite countingbloomfilter_add_internal_set_exchange.
      rewrite countingbloomfilter_set_unset_idempotent; first
        by rewrite -IHinds //=; apply/allP => v Hv; move: (Hin v Hv); rewrite addnS -addn1 => /InvMisc.addr_ltn.

      move: (@countingbloomfilter_add_capacity_change (length inds) 1 bf inds (eq_refl (length inds))).
      rewrite/countingbloomfilter_free_capacity addn1; move/allP: Hin => Hin /(_ Hin)/allP Hin'.
      by move: (Hin' _ (mem_tnth ind _)); rewrite addn1.
    Qed.

    Lemma countingbloomfilter_add_preserve (bf: CountingBloomFilter) (inds inds': seq 'I_(Hash_size.+1)): (n > 0) ->
      countingbloomfilter_query_internal inds bf ->
      countingbloomfilter_query_internal inds
         (countingbloomfilter_add_internal inds' bf).
    Proof.
      have H v: (counting_bloomfilter_state ({| counting_bloomfilter_state := v |})) = v; first by [].
      move=> Hngt0; rewrite/countingbloomfilter_query_internal => /allP Hall; elim: inds' => [//=|]; first by move/allP: Hall.
      move=> ind' inds' Hinds' //=; apply/allP => v Hv.
      rewrite  countingbloomfilter_add_internal_set_exchange.
      rewrite/countingbloomfilter_get_bit/countingbloomfilter_set_bit !H.
      case Hvind: ( v == ind').
      - by rewrite tnth_set_nth_eq //=; apply incr_bit_valid.
      - {
          move/Bool.negb_true_iff: Hvind => Hvind; rewrite tnth_set_nth_neq //=.
          by move/allP: Hinds' => /(_ v Hv).
        }
    Qed.

    Lemma countingbloomfilter_add_base (cbf:CountingBloomFilter) (inds: seq 'I_(Hash_size.+1)): n > 0 ->
      countingbloomfilter_query_internal inds (countingbloomfilter_add_internal inds cbf).
    Proof.
      move=> Hngt0; elim: inds cbf => [//=|ind inds Hinds] cbf //=.
      rewrite Hinds Bool.andb_true_r countingbloomfilter_add_internal_set_exchange.
      rewrite/countingbloomfilter_get_bit/countingbloomfilter_set_bit.
      by rewrite tnth_set_nth_eq //=; apply incr_bit_valid.
    Qed.

    Lemma countingbloomfilter_add_exchange (cbf: CountingBloomFilter) inds inds':
        countingbloomfilter_add_internal inds (countingbloomfilter_add_internal inds' cbf) =
        countingbloomfilter_add_internal inds' (countingbloomfilter_add_internal inds cbf).
    Proof.
      elim: inds inds' cbf => [| ind inds Hinds] inds' cbf //=.
        by rewrite !countingbloomfilter_add_internal_set_exchange Hinds.
    Qed.

    Section OfBloomFilter.

      Variable Hngt0 : n > 0.

      Definition toBitVector (vec: CountVector) : BitVector.
        generalize vec; unfold CountVector; intro vec'.
        apply (map_tuple (fun (cnt:'I_n.+1) => cnt > 0) vec').
      Defined.

      Definition toBloomFilter (cbf: CountingBloomFilter) : BloomFilter :=
        mkBloomFilter (toBitVector (counting_bloomfilter_state cbf)).

      Lemma countingbloomfilter_bloomfilter_query_eq cbf inds :
        countingbloomfilter_query_internal inds cbf = bloomfilter_query_internal  inds (toBloomFilter cbf).
      Proof.
        rewrite/countingbloomfilter_query_internal/bloomfilter_query_internal.
        apply eq_in_all => ind Hind.
        rewrite /countingbloomfilter_get_bit/bloomfilter_get_bit/toBloomFilter.
          by rewrite tnth_map.
      Qed.

      Lemma countingbloomfilter_bloomfilter_set_bitC cbf ind:
        toBloomFilter (countingbloomfilter_set_bit ind cbf) = bloomfilter_set_bit ind (toBloomFilter cbf).
      Proof.
        rewrite/toBloomFilter/bloomfilter_set_bit; apply f_equal.
        apply eq_from_tnth => ind'; rewrite tnth_map.
        case Heqind': (ind' == ind).
        - rewrite tnth_set_nth_eq //= /countingbloomfilter_set_bit/countingbloomfilter_set_bit.
          rewrite tnth_set_nth_eq //=.
            by apply incr_bit_valid.
        - move/Bool.negb_true_iff:Heqind' =>Heqind'; rewrite tnth_set_nth_neq //=.
          rewrite /countingbloomfilter_set_bit/countingbloomfilter_set_bit tnth_set_nth_neq //=.
            by rewrite tnth_map //=.
      Qed.

      Lemma countingbloomfilter_bloomfilter_add_internalC cbf inds :
        toBloomFilter (countingbloomfilter_add_internal inds cbf) =
        (bloomfilter_add_internal inds (toBloomFilter cbf)).
      Proof.
        elim: inds cbf => [//=| ind inds Hinds cbf //=].
        rewrite Hinds; apply f_equal => //=; clear Hinds inds.
          by rewrite countingbloomfilter_bloomfilter_set_bitC.
      Qed.

      Lemma counting_bloomfilter_new_bloomfilter_eq:
        (toBloomFilter (countingbloomfilter_new)) = bloomfilter_new.
      Proof.
        rewrite/toBloomFilter/countingbloomfilter_new/bloomfilter_new //=; apply f_equal.
        rewrite/toBitVector //=.
        move: (eq_ind_r _ _ _) (eq_ind_r _ _ _) => //= H1 H2.
        rewrite/map_tuple; move: (map_tupleP _ _ ) => //=.
        rewrite map_nseq.
        have ->: ((0 < Ordinal (Hngt0))) = false; first by []; move=>H3.
          by rewrite (proof_irrelevance _ H1 H3).
      Qed.

    End OfBloomFilter.

  End CountingBloomFilter.

  Module AMQ <: AMQ BasicHashVec.

    Inductive AMQStateParamsInt :=
    | mkStateParams (n:nat) of  n > 0.

    Definition AMQStateParams := AMQStateParamsInt.

    Definition AMQStateParamsToNat params :=
      match params with
      | mkStateParams n Hn => n
      end.

    Definition AMQState (n: AMQStateParams) : finType :=
      [finType of CountingBloomFilterDefinitions.CountingBloomFilter (AMQStateParamsToNat n)].

    Section AMQ.
      Variable p: AMQStateParams.
      Variable h: BasicHashVec.AMQHashParams.

      Definition AMQ_add_internal
                 (amq: AMQState p)
                 (inds: BasicHashVec.AMQHashValue h) : AMQState p :=
        CountingBloomFilterDefinitions.countingbloomfilter_add_internal
          inds amq.

      Definition AMQ_query_internal
                 (amq: AMQState p) (inds: BasicHashVec.AMQHashValue h) : bool :=

        CountingBloomFilterDefinitions.countingbloomfilter_query_internal
          inds amq.

      Definition AMQ_available_capacity (amq: AMQState p) (l:nat) : bool :=
        CountingBloomFilterDefinitions.countingbloomfilter_free_capacity
          amq (l * h.2.+1).

      Definition AMQ_valid (amq: AMQState p) : bool := true.

      Definition AMQ_new: AMQState p :=
        CountingBloomFilterDefinitions.countingbloomfilter_new (AMQStateParamsToNat p).

      Lemma AMQ_new_nqueryE: forall vals, ~~ AMQ_query_internal  AMQ_new vals.
      Proof.
        move=> //= vals.
        apply/allPn; exists (thead vals); first by apply mem_tnth.
        rewrite/AMQ_new/countingbloomfilter_new.
        move: (eq_ind_r _ _ _) => H1.
        move: (@tnth_nseq_eq _ Hash_size.+1  (Ordinal (Hngt0 (AMQStateParamsToNat p))) (thead vals)).
        rewrite/nseq_tuple.
        move: (nseq_tupleP _ _) => H2.
        rewrite (proof_irrelevance _ H1 H2); clear H1.
        rewrite/countingbloomfilter_get_bit //= => -> //=.
      Qed.

      Lemma AMQ_new_validT: AMQ_valid AMQ_new.
      Proof.
          by [].
      Qed.

      Section DeterministicProperties.
        Variable amq: AMQState p.

        Lemma AMQ_available_capacityW: forall  n m,
            AMQ_valid amq -> m <= n ->
            AMQ_available_capacity amq n ->
            AMQ_available_capacity amq m.
        Proof.
          move=> n m _ Hmn /allP Hcfb; apply/allP => v Hv.
          move: (Hcfb v Hv).
          move: Hmn; rewrite leq_eqVlt => /orP[/eqP -> | Hlmn] //=.
          apply ltn_trans.
          rewrite ltn_add2l ltn_mul2r //=.
        Qed.

        Lemma AMQ_add_query_base: forall (amq: AMQState p) inds,
            AMQ_valid amq -> AMQ_available_capacity amq 1 ->
            AMQ_query_internal (AMQ_add_internal amq inds) inds.
        Proof.
          move=> //= amq' inds _ Hcap.
          rewrite/  AMQ_query_internal/AMQ_add_internal.
          apply countingbloomfilter_add_base.
          move: inds => [inds Hinds] //=.
          rewrite/AMQ_query_internal/AMQ_add_internal//=; clear Hinds.
            by case: p => //=.
        Qed.

        Lemma AMQ_add_valid_preserve: forall (amq: AMQState p) inds,
            AMQ_valid amq -> AMQ_available_capacity amq 1 ->
            AMQ_valid (AMQ_add_internal amq inds).
        Proof.
            by [].
        Qed.

        Lemma AMQ_add_query_preserve: forall (amq: AMQState p) inds inds',
            AMQ_valid amq -> AMQ_available_capacity amq 1 -> AMQ_query_internal amq inds ->
            AMQ_query_internal (AMQ_add_internal amq inds') inds.
        Proof.
          move=> amq' inds inds' _ _.
          apply countingbloomfilter_add_preserve.
            by case p.
        Qed.

        Lemma AMQ_add_capacity_decr: forall (amq: AMQState p) inds l,
            AMQ_valid amq -> AMQ_available_capacity amq l.+1 ->
            AMQ_available_capacity (AMQ_add_internal amq inds) l.
        Proof.
          rewrite/AMQ_available_capacity/AMQ_add_internal.
          move=> amq' [inds Hinds] l _.
          move:(@countingbloomfilter_add_capacity_change
                  0 _ h.2.+1 (l * h.2.+1) amq' inds Hinds
               ).
            by rewrite -mulSn => H /H //=.
        Qed.

        Lemma AMQ_query_valid_preserve: forall (amq: AMQState p) inds,
            AMQ_valid amq -> AMQ_valid (AMQ_add_internal amq inds).
        Proof.
            by [].
        Qed.

        Lemma AMQ_query_capacity_preserve: forall (amq: AMQState p) inds l,
            AMQ_valid amq -> AMQ_available_capacity amq l.+1 -> AMQ_available_capacity (AMQ_add_internal amq inds) l.
        Proof.
          apply AMQ_add_capacity_decr.
        Qed.

      End DeterministicProperties.
    End AMQ.
  End AMQ.

  (** Defines a mapping from Counting Bloom Filters to Bloom Filters
  (by treating all counters with values greater than 0 as raised) *)
  Module BloomFilterReduction : AMQMAP (BasicHashVec) (AMQ) (BloomFilterProbability.BloomfilterAMQ).

    Definition AMQ_param_map: AMQ.AMQStateParams -> BloomFilterProbability.BloomfilterAMQ.AMQStateParams :=
    (fun _ => I).

    Definition AMQ_state_map  {p: AMQ.AMQStateParams} (cbf: AMQ.AMQState p) :
      BloomFilterProbability.BloomfilterAMQ.AMQState (AMQ_param_map p) :=
      toBloomFilter cbf.

  Section Map.

    Variable p: AMQ.AMQStateParams.
    Variable h: BasicHashVec.AMQHashParams.

    Lemma AMQ_map_validE: forall (a: AMQ.AMQState p), AMQ.AMQ_valid a ->
                                                      BloomFilterProbability.BloomfilterAMQ.AMQ_valid
                                                        (AMQ_state_map a).
    Proof.
      by rewrite/BloomfilterAMQ.AMQ_valid//=.
    Qed.

    Lemma AMQ_map_capacityE: forall (a: AMQ.AMQState p) l, AMQ.AMQ_available_capacity h a l ->
                                                           BloomFilterProbability.BloomfilterAMQ.AMQ_available_capacity
                                                             h (AMQ_state_map a) l.
    Proof.
      by rewrite/BloomfilterAMQ.AMQ_available_capacity //=.
    Qed.

    Lemma AMQ_map_add_internalE: forall (a: AMQ.AMQState p) val, AMQ.AMQ_valid a ->
                                                                 AMQ.AMQ_available_capacity h a 1 ->
                                                                 BloomFilterProbability.BloomfilterAMQ.AMQ_add_internal (AMQ_state_map a) val = AMQ_state_map (@AMQ.AMQ_add_internal _ h   a val).
    Proof.
      move=> s value Hvalid Hcap.
      rewrite/BloomfilterAMQ.AMQ_add_internal/AMQ_state_map/AMQ.AMQ_add_internal.
      rewrite countingbloomfilter_bloomfilter_add_internalC //=.
      by case: p => //=.
    Qed.

    Lemma AMQ_map_query_internalE: forall (a: AMQ.AMQState p) val, AMQ.AMQ_valid a ->
                                                                   AMQ.AMQ_available_capacity h a 1 ->
                                                                 BloomFilterProbability.BloomfilterAMQ.AMQ_query_internal (AMQ_state_map a) val = @AMQ.AMQ_query_internal _ h a val.
    Proof.
      move=> s value Hvalid Hcap.
      rewrite/BloomfilterAMQ.AMQ_add_internal/AMQ_state_map/AMQ.AMQ_query_internal.
      rewrite countingbloomfilter_bloomfilter_query_eq //= .
    Qed.

    Lemma AMQ_map_newE: forall (a: AMQ.AMQState p),
        BloomFilterProbability.BloomfilterAMQ.AMQ_new (AMQ_param_map p)  = AMQ_state_map (AMQ.AMQ_new p).
    Proof.
      move=> s.
      rewrite/BloomfilterAMQ.AMQ_new/AMQ_state_map/AMQ.AMQ_new.
      rewrite counting_bloomfilter_new_bloomfilter_eq //=.
      by case: p.
    Qed.
  End Map.
  End  BloomFilterReduction.

End CountingBloomFilterDefinitions.


Require Import Coq.ZArith.ZArith.
Require Import Coq.Strings.String.
Require Import Coq.micromega.Lia.
Require Import Crypto.Bedrock.Field.Common.Types.
Require Import Crypto.Bedrock.Field.Synthesis.Generic.WordByWordMontgomery.
Require Import Crypto.Bedrock.Field.Synthesis.Specialized.WordByWordMontgomery.
Require Import Crypto.Bedrock.Field.Synthesis.Specialized.Tactics.
Require Import bedrock2.string2ident.
Require Import Crypto.Arithmetic.WordByWordMontgomery.
Require Import bedrock2.Map.SeparationLogic.
Require Import coqutil.Tactics.syntactic_unify.
Require Import coqutil.Tactics.letexists.
Require Import Bedrock.Util.Tactics.
Require Import Bedrock.Util.Word.
Require Import bedrock2.Lift1Prop.
Require Import coqutil.Map.Properties.
Require Import bedrock2.WeakestPrecondition.
Require Import bedrock2.ptsto_bytes.
Require Import coqutil.Datatypes.HList.
Require Import coqutil.Byte.
Require Import Bedrock.Util.Bignum.
Require Import Bedrock.Util.Bignum.
Require Import Bedrock.Util.Util.
Require Import Coq.Lists.List.
Require Import Crypto.Bedrock.Field.Translation.Parameters.Defaults64.
Require Import bedrock2.NotationsCustomEntry.
Require Import bedrock2.Syntax.
Require Import Coq.Lists.List.
Require Import bedrock2.Array.
Require Import bedrock2.ProgramLogic.
Require Import bedrock2.Syntax.
Require Import bedrock2.Map.Separation.
Require Import coqutil.Word.Interface.
Require Import coqutil.Tactics.Tactics.
Require Import Crypto.COperationSpecifications.
Require Import Crypto.UnsaturatedSolinasHeuristics.
Require Import Crypto.Util.ZUtil.Tactics.PullPush.Modulo.
Require Import bedrock2.Semantics.
Require Import Crypto.Bedrock.Field.Synthesis.Specialized.ReifiedOperation.
Require Import Crypto.Bedrock.Field.Common.Names.VarnameGenerator.
Require Import Coq.Lists.List.
Require Import bedrock2.Array.
Require Import bedrock2.ProgramLogic.
Require Import bedrock2.Syntax.
Require Import bedrock2.Map.Separation.
Require Import coqutil.Word.Interface.
Require Import coqutil.Tactics.Tactics.
Require Import Crypto.Spec.MxDH.
Require Import Crypto.Arithmetic.Core.
Require Import Crypto.Bedrock.Field.Translation.Parameters.Defaults.
Require Import Crypto.Bedrock.Field.Common.Tactics.
Require Import Crypto.Bedrock.Field.Synthesis.Generic.Bignum.
Require Import Crypto.Bedrock.Field.Synthesis.Generic.Operation.
Require Import Crypto.Bedrock.Field.Translation.Parameters.SelectParameters.
Require Import Crypto.COperationSpecifications.
Require Import Crypto.Util.ZUtil.Tactics.PullPush.Modulo.
Require Import bedrock2.Semantics.
Require Import Theory.Fields.QuadraticFieldExtensions.
Require Import Theory.WordByWordMontgomery.MontgomeryRingTheory.

Import ListNotations.
Import Syntax.Coercions.

Section Spec.
  Local Open Scope Z_scope.

  (*Parameters to be changed: specify prime and import reification from cache.*)
      Require Import Bedrock.Field.bls12prime.
      Require Import Bedrock.Examples.felem_copy_64.
      Local Notation m := bls12prime.m.
      Local Definition prefix := bls12prime.prefix. (* placed before function names *)
      Local Definition felem_suffix := felem_copy_64.aff.

      Existing Instances Defaults64.default_parameters bls12_bedrock2_funcs
      bls12_bedrock2_specs bls12_bedrock2_correctness.

      (*We check that the specified prime modulus does indeed satisfy the relevant properties:
        TODO: test for primality*)
      Lemma m_valid : m mod 4 = 3.
      Proof.
        cbv; tryif (reflexivity) then auto else (fail "prime not valid, must be 3 mod 4").
      Qed.

  (*  We require that the prime specified here is the same that was used for reification:
      Change names to match reification cache.*)
  (*  We instantiate specs of all imported bedrock2 functions.
      This needs to be done for typeclass inference to work properly.*)

    Instance spec_of_reified_mul :
    spec_of (append prefix "mul") := spec_of_mul.

    Instance spec_of_reified_square :
    spec_of (append prefix "square") := spec_of_square.

    Instance spec_of_reified_add :
    spec_of (append prefix "add") := spec_of_add.

    Instance spec_of_reified_sub :
    spec_of (append prefix "sub") := spec_of_sub.

    Instance spec_of_reified_opp :
    spec_of (append prefix "opp") := spec_of_opp.

    Instance spec_of_reified_to_montgomery :
    spec_of (append prefix "to_montgomery") := spec_of_to_montgomery.

    Instance spec_of_reified_from_montgomery :
    spec_of (append prefix "from_montgomery") := spec_of_from_montgomery.

    Instance spec_of_reified_nonzero :
    spec_of (append prefix "nonzero") := spec_of_nonzero.

    Instance spec_of_reified_selectznz :
    spec_of (append prefix "selectznz") := spec_of_selectznz.

    Instance spec_of_reified_to_bytes :
    spec_of (append prefix "to_bytes") := spec_of_to_bytes.

    Instance spec_of_reified_from_bytes :
    spec_of (append prefix "from_bytes") := spec_of_from_bytes.
  (*Instantiation done.*)

  (*Initializing parameters; do not touch*)
  Local Notation bw := (@width (semantics)).
  Local Notation m' := (@WordByWordMontgomery.m' m bw).
  Local Notation n := (WordByWordMontgomery.n m bw).
  Local Notation eval := (@WordByWordMontgomery.eval bw n).
  Local Notation valid := (@WordByWordMontgomery.valid bw n m).
  Local Notation from_mont := (@WordByWordMontgomery.from_montgomerymod bw n m m').
  Local Notation r := (WordByWordMontgomery.r bw).
  Local Notation r' := (WordByWordMontgomery.r' m bw).
  Local Definition num_bytes := Eval compute in (Z.of_nat (((Z.to_nat bw * n) / 8)%nat)).
  Local Notation evfst x := (eval (from_mont (fst x))).
  Local Notation evsnd x := (eval (from_mont (snd x))).

  (*Proofs of necessary properties of parameters for Montgomery arithmetic*)
  Lemma r_equiv : r = MontgomeryRingTheory.r bw.
  Proof.
    cbv. auto.
  Qed.

  Lemma r'_correct : (MontgomeryRingTheory.r bw * r') mod m = 1.
  Proof. cbv; auto. Qed.

  Lemma m'_correct : m * m' mod MontgomeryRingTheory.r bw = (-1) mod MontgomeryRingTheory.r bw.
  Proof. cbv; auto. Qed.

  Lemma bw_big : 0 < bw.
  Proof. cbv; auto. Qed.

  Lemma n_nz : n <> 0%nat.
  Proof. cbv; intros; discriminate. Qed.

  Lemma m_big : m < MontgomeryRingTheory.r bw ^ (Z.of_nat n).
  Proof. cbv; auto. Qed.

  Lemma m_small : 1 < m.
  Proof. cbv; auto. Qed.

  (*Some notation and tactics*)
  Notation N aw := (word.add (word.of_Z word_size_in_bytes) aw).
  Local Notation valid_mod := (@valid_mod m bw n r' m' r'_correct m'_correct bw_big n_nz m_big m_small).

  Local Notation montsub a b c :=
    ((eval (from_mont (a))) mod m =
        (eval (from_mont (b)) -
        eval (from_mont (c))) mod m).

  Local Notation montadd a b c :=
    ((eval (from_mont (a))) mod m =
        (eval (from_mont (b)) +
        eval (from_mont (c))) mod m).

  Local Notation montmul a b c :=
    ((eval (from_mont (a))) mod m =
        (eval (from_mont (b)) *
        eval (from_mont (c))) mod m).

  Local Definition num_bytes_word := Eval compute in (Z.of_nat (n * Z.to_nat word_size_in_bytes)).

  Lemma numbytes_correct : num_bytes_word = (Z.of_nat (n * Z.to_nat word_size_in_bytes)).
  Proof. auto. Qed.

  Ltac postcondition_pre := repeat (split; [solve [reflexivity]| ]); repeat (
    lazymatch goal with
    | |- exists _, _ => eexists
    | _ => fail
    end); repeat ( split; [| ecancel_assumption]).

  Ltac copy_next R fR thism pX1 wX1 RX1 a H := straightline_call; [subst R; remember fR as thisP;
  eassert (thisH : ((fun m => (Bignum n pX1 wX1 * RX1)%sep m /\ thisP m) * Bignum n a _ * _)%sep thism) by (subst thisP; ecancel_assumption); subst thisP; apply thisH |]; clear H; repeat straightline.

  (*Gallina Specifications of functions.*)
  Definition Fp2_add_Gallina_spec in1 in2 out :=
      valid (fst out) /\ valid (snd out) /\
      evfst out = (evfst in1 + evfst in2) mod m /\
      evsnd out = (evsnd in1 + evsnd in2) mod m.

  Definition Fp2_sub_Gallina_spec in1 in2 out :=
    valid (fst out) /\ valid (snd out) /\
    evfst out = (evfst in1 - evfst in2) mod m /\
    evsnd out = (evsnd in1 - evsnd in2) mod m.

  Definition Fp2_mul_Gallina_spec in1 in2 out :=
      valid (fst out) /\ valid (snd out) /\
      evfst out = (evfst in1 * evfst in2 - evsnd in1 * evsnd in2) mod m /\
      evsnd out = (evfst in1 * evsnd in2 + evfst in2 * evsnd in1) mod m.

  Definition Fp2_square_Gallina_spec inp out :=
    valid (fst out) /\ valid (snd out) /\
    evfst out = ((evfst inp + evsnd inp) * (evfst inp - evsnd inp) ) mod m /\
    evsnd out = (2 * (evfst inp * evsnd inp)) mod m.

  (*Bedrock2 functions*)
  Definition Fp2_add : Syntax.func :=
    let outr := "outr" in
    let outi := "outi" in
    let xr := "xr" in
    let xi := "xi" in
    let yr := "yr" in
    let yi := "yi" in
    let add := (append prefix "add") in
    ("Fp2_add", (
      [outr; outi; xr; xi; yr; yi], [],
      bedrock_func_body:(
      add (outr, yr, xr);
      add (outi, yi, xi)
      )
    )).

  Definition Fp2_mul : Syntax.func :=
    let outr := "outr" in
    let outi := "outi" in
    let xr := "xr" in
    let xi := "xi" in
    let yr := "yr" in
    let yi := "yi" in
    let v0 := "v0" in
    let v1 := "v1" in
    let v2 := "v2" in
    let add := (append prefix "add") in
    let mul := (append prefix "mul") in
    let sub := (append prefix "sub") in
    ("Fp2_mul", (
      [outr; outi; xr; xi; yr; yi], [],
      bedrock_func_body:(
      stackalloc num_bytes as v0 {
        stackalloc num_bytes as v1 {
          stackalloc num_bytes as v2 {
            mul (v0, xr, yr);
            mul (v1, xi, yi);
            sub (outr, v0, v1);
            add (v2, xr, xi);
            add (outi, yr, yi);
            mul (outi, v2, outi);
            sub (outi, outi, v0);
            sub (outi, outi, v1)
          }
        }
      }
      )
    )).

  Definition Fp2_sub : Syntax.func :=
    let outr := "outr" in
    let outi := "outi" in
    let xr := "xr" in
    let xi := "xi" in
    let yr := "yr" in
    let yi := "yi" in
    let add := (append prefix "add") in
    ("Fp2_sub", (
      [outr; outi; xr; xi; yr; yi], [],
      bedrock_func_body:(
      sub (outr, xr, yr);
      sub (outi, xi, yi)
      )
    )).

  Definition Fp2_square : Syntax.func :=
    let outr := "outr" in
    let outi := "outi" in
    let inr := "inr" in
    let ini := "ini" in
    let v := "v" in
    let add := (append prefix "add") in
    let mul := (append prefix "mul") in
    let sub := (append prefix "sub") in
    ("Fp2_square", (
      [outr; outi; inr; ini], [],
      bedrock_func_body:(
        stackalloc num_bytes as v {
          add(v, inr, ini);
          sub(outr, inr, ini);
          mul(outr, outr, v);
          mul(outi, inr, ini);
          add(outi, outi, outi)
        }
      )
    )).

  (*Bedrock specs of functions*)
  Local Open Scope string_scope.
  Local Infix "*" := sep : sep_scope.
  Delimit Scope sep_scope with sep.

  Instance spec_of_my_add: spec_of Fp2_add :=
  fun functions : list (string * (list string * list string * cmd)) =>
      forall (wxr wxi wyr wyi : list Interface.word.rep)
      (pxr pxi pyr pyi poutr pouti : Interface.word.rep)
      (wold_outr wold_outi : list Interface.word.rep) (t : Semantics.trace)
      (m0 : Interface.map.rep) (Rout : Interface.map.rep -> Prop),
      (*typeclass isntead of valid?*)
      valid (List.map Interface.word.unsigned wxr) /\
      valid (List.map Interface.word.unsigned wxi) /\
      valid (List.map Interface.word.unsigned wyr) /\
      valid (List.map Interface.word.unsigned wyi) ->
      (((Bignum n pxr wxr) ) *
      ((Bignum n pxi wxi) ) *
      ((Bignum n pyr wyr) ) *
      ((Bignum n pyi wyi) ) *
      (Bignum n poutr wold_outr) * (Bignum n pouti wold_outi) * Rout)%sep m0 ->
      WeakestPrecondition.call functions ( "Fp2_add") t m0
      ([poutr; pouti; pxr; pxi; pyr; pyi])
      (fun (t' : Semantics.trace) (m' : Interface.map.rep)
          (rets : list Interface.word.rep) =>
      t = t' /\
      rets = nil /\
      (exists (woutr wouti : list Interface.word.rep),
          (
                  (Fp2_add_Gallina_spec (List.map Interface.word.unsigned wxr, List.map Interface.word.unsigned wxi)
                  (List.map Interface.word.unsigned wyr, List.map Interface.word.unsigned wyi)
                  (List.map Interface.word.unsigned woutr, List.map Interface.word.unsigned wouti) /\
                  valid (List.map Interface.word.unsigned woutr) /\
                  valid (List.map Interface.word.unsigned wouti)) /\
              ((Bignum n poutr woutr) * (Bignum n pouti wouti) * (Bignum n pxr wxr)
                * (Bignum n pxi wxi) * (Bignum n pyr wyr) * (Bignum n pyi wyi) * Rout)%sep m'))).

  Instance spec_of_my_sub: spec_of Fp2_sub :=
  fun functions : list (string * (list string * list string * cmd)) =>
      forall (wxr wxi wyr wyi : list Interface.word.rep)
      (pxr pxi pyr pyi poutr pouti : Interface.word.rep)
      (wold_outr wold_outi : list Interface.word.rep) (t : Semantics.trace)
      (m0 : Interface.map.rep) (Rout : Interface.map.rep -> Prop),
      valid (List.map Interface.word.unsigned wxr) /\
      valid (List.map Interface.word.unsigned wxi) /\
      valid (List.map Interface.word.unsigned wyr) /\
      valid (List.map Interface.word.unsigned wyi) ->
      (((Bignum n pxr wxr) ) *
      ((Bignum n pxi wxi) ) *
      ((Bignum n pyr wyr) ) *
      ((Bignum n pyi wyi) ) *
      (Bignum n poutr wold_outr) * (Bignum n pouti wold_outi) * Rout)%sep m0 ->
      WeakestPrecondition.call functions ( "Fp2_sub") t m0
      ([poutr; pouti; pxr; pxi; pyr; pyi])
      (fun (t' : Semantics.trace) (m' : Interface.map.rep)
          (rets : list Interface.word.rep) =>
      t = t' /\
      rets = nil /\
      (exists (woutr wouti : list Interface.word.rep),
          (
                  (Fp2_sub_Gallina_spec (List.map Interface.word.unsigned wxr, List.map Interface.word.unsigned wxi)
                  (List.map Interface.word.unsigned wyr, List.map Interface.word.unsigned wyi)
                  (List.map Interface.word.unsigned woutr, List.map Interface.word.unsigned wouti) /\
                  valid (List.map Interface.word.unsigned woutr) /\
                  valid (List.map Interface.word.unsigned wouti)) /\
              ((Bignum n poutr woutr) * (Bignum n pouti wouti) *
                  (Bignum n pxr wxr) * (Bignum n pxi wxi) *
                  (Bignum n pyr wyr) * (Bignum n pyi wyi) * Rout)%sep m'))).

  Instance spec_of_my_mul: spec_of Fp2_mul :=
  fun functions : list (string * (list string * list string * cmd)) =>
      forall (wxr wxi wyr wyi : list Interface.word.rep)
      (pxr pxi pyr pyi poutr pouti : Interface.word.rep)
      (wold_outr wold_outi : list Interface.word.rep) (t : Semantics.trace)
      (m0 : Interface.map.rep) (Rout : Interface.map.rep -> Prop),
      valid (List.map Interface.word.unsigned wxr) /\
      valid (List.map Interface.word.unsigned wxi) /\
      valid (List.map Interface.word.unsigned wyr) /\
      valid (List.map Interface.word.unsigned wyi) ->
      (((Bignum n pxr wxr) ) *
      ((Bignum n pxi wxi) ) *
      ((Bignum n pyr wyr) ) *
      ((Bignum n pyi wyi) ) *
      (Bignum n poutr wold_outr) * (Bignum n pouti wold_outi) * Rout)%sep m0 ->
      WeakestPrecondition.call functions ( "Fp2_mul") t m0
      ([poutr; pouti; pxr; pxi; pyr; pyi])
      (fun (t' : Semantics.trace) (m' : Interface.map.rep)
          (rets : list Interface.word.rep) =>
      t = t' /\
      rets = nil /\
      (exists (woutr wouti : list Interface.word.rep) Routnew,
          (
                  (Fp2_mul_Gallina_spec (List.map Interface.word.unsigned wxr, List.map Interface.word.unsigned wxi)
                  (List.map Interface.word.unsigned wyr, List.map Interface.word.unsigned wyi)
                  (List.map Interface.word.unsigned woutr, List.map Interface.word.unsigned wouti) /\
                  valid (List.map Interface.word.unsigned woutr) /\
                  valid (List.map Interface.word.unsigned wouti)) /\
              ((Bignum n poutr woutr) * (Bignum n pouti wouti) *
              (Bignum n pxr wxr) * (Bignum n pxi wxi) *
              (Bignum n pyr wyr) * (Bignum n pyi wyi) * Rout * Routnew)%sep m'))).

  Instance spec_of_my_square: spec_of Fp2_square :=
  fun functions : list (string * (list string * list string * cmd)) =>
      forall (winr wini : list Interface.word.rep)
      (pinr pini poutr pouti : Interface.word.rep)
      (wold_outr wold_outi : list Interface.word.rep) (t : Semantics.trace)
      (m0 : Interface.map.rep) (Rout : Interface.map.rep -> Prop),
      valid (List.map Interface.word.unsigned winr) /\
      valid (List.map Interface.word.unsigned wini) ->
      (((Bignum n pinr winr) ) *
      ((Bignum n pini wini) ) *
      (Bignum n poutr wold_outr) * (Bignum n pouti wold_outi) * Rout)%sep m0 ->
      WeakestPrecondition.call functions ( "Fp2_square") t m0
      ([poutr; pouti; pinr; pini])
      (fun (t' : Semantics.trace) (m' : Interface.map.rep)
          (rets : list Interface.word.rep) =>
      t = t' /\
      rets = nil /\
      (exists (woutr wouti : list Interface.word.rep) Rout,
          (
                  (Fp2_square_Gallina_spec (List.map Interface.word.unsigned winr, List.map Interface.word.unsigned wini)
                  (List.map Interface.word.unsigned woutr, List.map Interface.word.unsigned wouti) /\
              ((Bignum n poutr woutr) * (Bignum n pouti wouti) *
              (Bignum n pinr winr) * (Bignum n pini wini) * Rout)%sep m')))).

  (*Correctness proofs*)
  Theorem Fp2_add_ok: program_logic_goal_for_function! Fp2_add.
  Proof.
      (*Initializing*)
      straightline_init_with_change.
      repeat straightline.

      (*function calls*)
      do 2 (handle_call; [eauto ..|]).

      (*Prove Postcondition*)
      postcondition_pre.

      split; [split; [eauto| split; [eauto| split]]| split; eauto].
          + rewrite !Prod.fst_pair, Z.add_comm.
            apply valid_mod in H8. rewrite <- H8. assumption.
          + rewrite !Prod.snd_pair, Z.add_comm.
            apply valid_mod in H11. rewrite <- H11. assumption.
  Qed.

  Theorem Fp2_sub_ok: program_logic_goal_for_function! Fp2_sub.
  Proof.
      (*Initializing*)
      straightline_init_with_change.
      repeat straightline.

      (*function calls*)
      do 2 (handle_call; [eauto ..|]).

      (*Prove postcondition*)
      postcondition_pre.
      split; [split; [eauto| split; [eauto| split]]| split; eauto].
      - rewrite !Prod.fst_pair; apply valid_mod in H8; rewrite <- H8; assumption.
      - rewrite !Prod.snd_pair; apply valid_mod in H11; rewrite <- H11; assumption.
  Qed.

  Lemma postcond_from_precond xr xi yr yi resr resi x1 x2 x3 x4 x5 x6:
    montsub resi x1 x2 -> valid resi -> valid x1 -> valid x2
    -> montsub x1 x3 x4 -> montmul x3 x5 x6 -> valid x3 -> valid x6
    -> montadd x6 yr yi -> valid x5 -> montadd x5 xr xi -> valid resr
    -> montsub resr x4 x2 -> montmul x2 xi yi -> valid x4 -> montmul x4 xr yr
    -> valid xr -> valid xi -> valid yr -> valid yi
  -> Fp2_mul_Gallina_spec (xr, xi) (yr, yi) (resr, resi).
  Proof.
    intros. unfold Fp2_mul_Gallina_spec.
    split; [auto|].
    split; [auto|]. split.
                      - rewrite !Prod.fst_pair, !Prod.snd_pair.
                        rewrite (valid_mod H10) in H11; rewrite H11.
                        rewrite (valid_mod H13) in H14; rewrite H14.
                        rewrite (valid_mod H2) in H12; rewrite H12.
                        rewrite <- Zminus_mod. reflexivity.
                      - rewrite !Prod.fst_pair, !Prod.snd_pair.
                        rewrite (valid_mod H0) in H; rewrite H.
                        rewrite (valid_mod H1) in H3; rewrite H3.
                        rewrite (valid_mod H5) in H4; rewrite H4.
                        rewrite (valid_mod H8) in H9; rewrite H9.
                        rewrite (valid_mod H6) in H7; rewrite H7.
                        rewrite (valid_mod H13) in H14; rewrite H14.
                        rewrite (valid_mod H2) in H12; rewrite H12.
                        rewrite <- Z.mul_mod; [| cbv; intros; discriminate].
                        remember (eval (from_mont xr)) as xr'.
                        remember (eval (from_mont yr)) as yr'.
                        remember (eval (from_mont xi)) as xi'.
                        remember (eval (from_mont yi)) as yi'.
                        pull_Zmod. apply (f_equal (fun y => (y mod m))). ring.
  Qed.

    Ltac straightline' :=
      lazymatch goal with
      | [Hminit : ?mcond (?minit)
          |- forall (_ : @word.rep _ _)
                    (_ _ : @Interface.map.rep _ _ _),
              anybytes _ ?numbytes _ -> msplit _ ?minit _ -> _ ] =>
          let a := (fresh "a") in
          let mStack := (fresh "mStack") in
          let mnew := (fresh "mnew") in
          let Hany := (fresh "Hany") in
          let HanyBignum := (fresh "HanyBignum") in
          let anyval := (fresh "anyval") in
          let Hsplit := (fresh "Hsplit") in
          let Hmnew := (fresh "Hmnew") in
          let R := (fresh "R") in
          intros a mStack mnew Hany Hsplit; destruct (anybytes_Bignum n mStack numbytes a numbytes_correct Hany) as [anyval HanyBignum];
          destruct (alloc_seps_alt mnew minit mStack mcond (Bignum _ _ _) Hsplit (empty_frame mcond minit Hminit) (empty_frame (Bignum _ _ _) mStack HanyBignum)) as [R Hmnew];
          clear Hany Hsplit HanyBignum
      | _ => straightline
      end.

      Ltac defrag_in_context := lazymatch goal with
  | [
      |- exists (_ _ : @Interface.map.rep _ _ _),
        (anybytes ?addr _ _) /\ (msplit ?mem _ _) /\ _ ] =>
        repeat lazymatch goal with
        | [ H : (?Rl * ((Bignum _ addr ?aval) * ?Rr))%sep mem |- _ ] =>
          let Ha := (fresh "Ha") in
          let m := fresh "m" in
          let mStack := fresh "mStack" in
          assert (Ha : ((Bignum n addr aval) * (Rl * Rr))%sep mem) by ecancel_assumption;
          destruct Ha as [mStack [m [? []]]];
          exists m; exists mStack; split; [ eapply Bignum_anybytes; [apply numbytes_correct |eassumption] | split; [apply Properties.map.split_comm; auto|]]
        | [ H : (((Bignum _ addr ?aval) * ?Rr))%sep mem |- _ ] =>
          let Ha := (fresh "Ha") in
          let m := fresh "m" in
          let mStack := fresh "mStack" in
          assert (Ha : ((Bignum n addr aval) * (Rr))%sep mem) by ecancel_assumption;
          destruct Ha as [mStack [m [? []]]];
          exists m; exists mStack; split; [ eapply Bignum_anybytes; [apply numbytes_correct |eassumption] | split; [apply Properties.map.split_comm; auto|]]

        | [ H : _ mem |- _ ] => apply (sep_assoc_proj2 mem) in H
        end
  end.

  Ltac defrag_in_context' := lazymatch goal with
  | [
      |- exists (_ _ : @Interface.map.rep _ _ _),
        (anybytes ?addr _ _) /\ (msplit ?mem _ _) /\ _ ] =>
        match goal with
        | [ H : _ mem |- _ ] => cleanup_hyp H mem
        end
      end; defrag_in_context.

  Theorem Fp2_mul_ok: program_logic_goal_for_function! Fp2_mul.
  Proof.
    (*Handle parts of function up until function calls.
      We use a modified version of Bedrock2's straightline tactic.
      This version  undoes the fragmentation of memory in the context
      done by stack allocation.*)
      repeat (straightline').

      (*Handle function calls.
      Note that the use of the "auto" tactic here is to handle preconditions af callees.
      In this case auto is sufficient, but for more complicated functions
      this should be done manually.*)
      repeat (handle_call; [auto| auto| ]).

    (*Fragmentation of the memory after function body is necessary for stack allocation
      to ensure that output and intermediate variables are stored correctly in memory
      TODO: find a better name for this tactic.*)
      cleanup_hyp H28 a5.
      repeat defrag_in_context'.

      (* Handle parts of function up until proving the postcondition*)
      repeat (straightline').

    (*Postcondition is proved. Trivial subgoals are handled by tactic postcondition_pre*)
      postcondition_pre.
      split; [split; [eauto| split; [eauto|]]| split; eauto].

    (*We have proved that the Gallina specification is met in a separate lemma: postcond_from_precond.
      A more natural approach would be to prove the precondition directly here.
      We use a lemma to illustrate the fact that proving the non-Bedrock2 specific parts of
      the postcondition is separated from the Bedrock2 specific parts, which are mostly automated.*)
    apply (postcond_from_precond (map word.unsigned wxr) (map word.unsigned wxi) (map word.unsigned wyr) (map word.unsigned wyi) (map word.unsigned x1) (map word.unsigned x6)
    (map word.unsigned x5) (map word.unsigned x0) (map word.unsigned x4) (map word.unsigned x)
    (map word.unsigned x2) (map word.unsigned x3)
    ); auto.
    Qed.

    Theorem Fp2_square_ok: program_logic_goal_for_function! Fp2_square.
    Proof.
      (*Handle parts of function up until function calls.
        We use a modified version of Bedrock2's straightline tactic.
        This version  undoes the fragmentation of memory in the context
        done by stack allocation.*)
      repeat (straightline').
      (*Handle function calls.
        Note that the use of the "auto" tactic here is to handle preconditions af callees.
        In this case auto is sufficient, but for more complicated function calls
        this should be done manually.*)
      repeat (handle_call; [auto| auto| ]).

      (*Fragmentation of the memory after function body is necessary for stack allocation
        to ensure that output and intermediate variables are stored correctly in memory
        TODO: find a better name for this tactic.*)
      repeat defrag_in_context'.

      (* Handle parts of function up until proving the postcondition*)
      repeat (straightline').

      (*Postcondition is proved
        reflexivity solves first part; which will always be the case when no complicated
        reasoning about separation logic is needed, i.e. when the seperating conjuction is
        used only as a means of referencing memory. *)
        postcondition_pre.

      (*Postcondition*)
      do 2 (split; [auto|]).
      split.
        - rewrite !Prod.snd_pair, !Prod.fst_pair.
          rewrite (valid_mod H12) in H9; rewrite H9.
          rewrite (valid_mod H8) in H5; rewrite H5.
          rewrite (valid_mod H10) in H7; rewrite H7.
          remember (eval (from_mont (map word.unsigned winr))) as inr.
          remember (eval (from_mont (map word.unsigned wini))) as ini.
          pull_Zmod; rewrite Z.mul_comm; reflexivity.
        - rewrite !Prod.snd_pair, !Prod.fst_pair.
          remember (eval (from_mont (map word.unsigned winr))) as inr.
          remember (eval (from_mont (map word.unsigned wini))) as ini.
          rewrite (valid_mod H18) in H16; rewrite H16.
          rewrite (valid_mod H15) in H13; rewrite H13.
          pull_Zmod. apply (f_equal (fun y => y mod Spec.m)). ring.
      Qed.

  (*Alternative functions that allow overlapping inputs/outputs*)

  Definition Fp2_add_alt2 : Syntax.func :=
    let outr := "outr" in
    let outi := "outi" in
    let xr := "xr" in
    let xi := "xi" in
    let yr := "yr" in
    let yi := "yi" in
    let xrsep := "xrsep" in
    let xisep := "xisep" in
    let yrsep := "yrsep" in
    let yisep := "yisep" in
    let add := (append prefix "add") in
    let felem_copy := ("felem_copy" ++ felem_suffix) in
    ("Fp2_add_alt2", (
      [outr; outi; xr; xi; yr; yi], [],
      bedrock_func_body:(
        stackalloc num_bytes as xrsep {
          stackalloc num_bytes as xisep {
            stackalloc num_bytes as yrsep {
              stackalloc num_bytes as yisep {
                (*Copies real part of first operand*)
                felem_copy (xrsep, xr);
                felem_copy (yrsep, yr);
                felem_copy (xisep, xi);
                felem_copy (yisep, yi);

                Fp2_add (outr, outi, xrsep, xisep, yrsep, yisep)
              }
            }
          }
        }
      )
    )).

  Instance spec_of_my_add_alt2: spec_of Fp2_add_alt2 :=
  fun functions : list (string * (list string * list string * Syntax.cmd)) =>
      forall (wxr wxi wyr wyi : list Interface.word.rep)
      (pxr pxi pyr pyi poutr pouti : Interface.word.rep)
      (wold_outr wold_outi : list Interface.word.rep) (t : Semantics.trace)
      (m0 : Interface.map.rep) (Rxr Rxi Ryr Ryi Rout : Interface.map.rep -> Prop),
      valid (List.map Interface.word.unsigned wxr) /\
      valid (List.map Interface.word.unsigned wxi) /\
      valid (List.map Interface.word.unsigned wyr) /\
      valid (List.map Interface.word.unsigned wyi) ->
      ((Bignum n pxr wxr) * Rxr)%sep m0 ->
      ((Bignum n pxi wxi) * Rxi)%sep m0 ->
      ((Bignum n pyr wyr) * Ryr)%sep m0 ->
      ((Bignum n pyi wyi) * Ryi)%sep m0 ->
      ((Bignum n poutr wold_outr) * (Bignum n pouti wold_outi) * Rout)%sep m0 ->
      WeakestPrecondition.call functions ( "Fp2_add_alt2") t m0
      ([poutr; pouti; pxr; pxi; pyr; pyi])
      (fun (t' : Semantics.trace) (m' : Interface.map.rep)
          (rets : list Interface.word.rep) =>
      t = t' /\
      rets = nil /\
      (exists (woutr wouti : list Interface.word.rep) Routnew,
          (
                  (Fp2_add_Gallina_spec (List.map Interface.word.unsigned wxr, List.map Interface.word.unsigned wxi)
                  (List.map Interface.word.unsigned wyr, List.map Interface.word.unsigned wyi)
                  (List.map Interface.word.unsigned woutr, List.map Interface.word.unsigned wouti) /\
                  valid (List.map Interface.word.unsigned woutr) /\
                  valid (List.map Interface.word.unsigned wouti)) /\
              ((Bignum n poutr woutr) * (Bignum n pouti wouti) * Rout * Routnew)%sep m'))).

  Theorem Fp2_add_alt2_okay: program_logic_goal_for_function! Fp2_add_alt2.
  Proof.
    do 7 straightline'.

    (*Assert single hypothesis for stackallocation.*)
    remember (Bignum n pxr wxr * Rxr)%sep as Rxr'.
    remember (Bignum n pyr wyr * Ryr)%sep as Ryr'.
    remember (Bignum n pxi wxi * Rxi)%sep as Rxi'.
    remember (Bignum n pyi wyi * Ryi)%sep as Ryi'.
    remember ((Bignum n poutr wold_outr * Bignum n pouti wold_outi * Rout)%sep) as Rout'.

    assert (
        id (fun m => (Rxr' m /\ Ryr' m /\ Rxi' m /\ Ryi' m /\ Rout' m)) m0).
    {
      cbv [id]. split; auto.
    }

    (*Allocate memory on stack. *)
    repeat straightline'. clear H1 Hmnew Hmnew0 Hmnew1. cbv [id] in *.

  (*Handle calls to felem_copy*)

    copy_next Rxr' (fun m => Ryr' m /\ Rxi' m /\ Ryi' m /\ Rout' m) mnew2 pxr wxr Rxr a Hmnew2.
    copy_next Ryr' (fun m => Rxi' m /\ Ryi' m /\ Rout' m) a4 pyr wyr Ryr a1 H15.
    copy_next Rxi' (fun m => Ryi' m /\ Rout' m) a6 pxi wxi Rxi a0 H15.
    copy_next Ryi' (fun m => Rout' m) a4 pyi wyi Ryi a2 H15.

  (*Handle function call*)
  repeat straightline.
  straightline_call.
  2:
  {
    assert (Hnumlimbs : n = num_limbs) by auto.
    repeat rewrite Hnumlimbs. repeat rewrite Hnumlimbs in H15. ecancel_assumption.
  }
  1: split; auto.

  (*Defragment memory in context after stack allocation. *)
  repeat straightline.
  repeat defrag_in_context'.

  (*Postcondition*)
  postcondition_pre.
  split; [auto| split; auto].
  Qed.

  Definition Fp2_sub_alt2 : Syntax.func :=
    let outr := "outr" in
    let outi := "outi" in
    let xr := "xr" in
    let xi := "xi" in
    let yr := "yr" in
    let yi := "yi" in
    let xrsep := "xrsep" in
    let xisep := "xisep" in
    let yrsep := "yrsep" in
    let yisep := "yisep" in
    let add := (append prefix "add") in
    let felem_copy := ("felem_copy" ++ felem_suffix) in
    ("Fp2_sub_alt2", (
      [outr; outi; xr; xi; yr; yi], [],
      bedrock_func_body:(
        stackalloc num_bytes as xrsep {
          stackalloc num_bytes as xisep {
            stackalloc num_bytes as yrsep {
              stackalloc num_bytes as yisep {
                (*Copies real part of first operand*)
                felem_copy (xrsep, xr);
                felem_copy (yrsep, yr);
                felem_copy (xisep, xi);
                felem_copy (yisep, yi);

                Fp2_sub (outr, outi, xrsep, xisep, yrsep, yisep)
              }
            }
          }
        }
      )
    )).

  Instance spec_of_my_sub_alt2: spec_of Fp2_sub_alt2 :=
  fun functions : list (string * (list string * list string * Syntax.cmd)) =>
      forall (wxr wxi wyr wyi : list Interface.word.rep)
      (pxr pxi pyr pyi poutr pouti : Interface.word.rep)
      (wold_outr wold_outi : list Interface.word.rep) (t : Semantics.trace)
      (m0 : Interface.map.rep) (Rxr Rxi Ryr Ryi Rout : Interface.map.rep -> Prop),
      (*typeclass isntead of valid?*)
      valid (List.map Interface.word.unsigned wxr) /\
      valid (List.map Interface.word.unsigned wxi) /\
      valid (List.map Interface.word.unsigned wyr) /\
      valid (List.map Interface.word.unsigned wyi) ->
      ((Bignum n pxr wxr) * Rxr)%sep m0 ->
      ((Bignum n pxi wxi) * Rxi)%sep m0 ->
      ((Bignum n pyr wyr) * Ryr)%sep m0 ->
      ((Bignum n pyi wyi) * Ryi)%sep m0 ->
      ((Bignum n poutr wold_outr) * (Bignum n pouti wold_outi) * Rout)%sep m0 ->
      WeakestPrecondition.call functions ( "Fp2_sub_alt2") t m0
      ([poutr; pouti; pxr; pxi; pyr; pyi])
      (fun (t' : Semantics.trace) (m' : Interface.map.rep)
          (rets : list Interface.word.rep) =>
      t = t' /\
      rets = nil /\
      (exists (woutr wouti : list Interface.word.rep) Routnew,
          (
                  (Fp2_sub_Gallina_spec (List.map Interface.word.unsigned wxr, List.map Interface.word.unsigned wxi)
                  (List.map Interface.word.unsigned wyr, List.map Interface.word.unsigned wyi)
                  (List.map Interface.word.unsigned woutr, List.map Interface.word.unsigned wouti) /\
                  valid (List.map Interface.word.unsigned woutr) /\
                  valid (List.map Interface.word.unsigned wouti)) /\
              ((Bignum n poutr woutr) * (Bignum n pouti wouti) * Rout * Routnew)%sep m'))).

  Theorem Fp2_sub_alt2_okay: program_logic_goal_for_function! Fp2_sub_alt2.
  Proof.
    do 7 straightline'.

    (*Assert single hypothesis for stackallocation.*)
    remember (Bignum n pxr wxr * Rxr)%sep as Rxr'.
    remember (Bignum n pyr wyr * Ryr)%sep as Ryr'.
    remember (Bignum n pxi wxi * Rxi)%sep as Rxi'.
    remember (Bignum n pyi wyi * Ryi)%sep as Ryi'.
    remember ((Bignum n poutr wold_outr * Bignum n pouti wold_outi * Rout)%sep) as Rout'.

    assert (
        id (fun m => (Rxr' m /\ Ryr' m /\ Rxi' m /\ Ryi' m /\ Rout' m)) m0).
    {
      cbv [id]. split; auto.
    }

    (*Allocate memory on stack. *)
    repeat straightline'. clear H1 Hmnew Hmnew0 Hmnew1. cbv [id] in *.

  (*Handle calls to felem_copy*)
    copy_next Rxr' (fun m => Ryr' m /\ Rxi' m /\ Ryi' m /\ Rout' m) mnew2 pxr wxr Rxr a Hmnew2.
    copy_next Ryr' (fun m => Rxi' m /\ Ryi' m /\ Rout' m) a4 pyr wyr Ryr a1 H15.
    copy_next Rxi' (fun m => Ryi' m /\ Rout' m) a6 pxi wxi Rxi a0 H15.
    copy_next Ryi' (fun m => Rout' m) a4 pyi wyi Ryi a2 H15.

  (*Handle function call*)
  repeat straightline.
  straightline_call.
  2: {
    assert (Hnumlimbs : n = num_limbs) by auto. rewrite !Hnumlimbs. rewrite !Hnumlimbs in H15. ecancel_assumption.
  }
  1: split; auto.

  (*Defragment memory in context after stack allocation. *)
  repeat straightline.
  repeat defrag_in_context'.

  (*Postcondition*)
  postcondition_pre.
  split; [auto| split; auto].
  Qed.

  Definition Fp2_mul_alt2 : Syntax.func :=
    let outr := "outr" in
    let outi := "outi" in
    let xr := "xr" in
    let xi := "xi" in
    let yr := "yr" in
    let yi := "yi" in
    let xrsep := "xrsep" in
    let xisep := "xisep" in
    let yrsep := "yrsep" in
    let yisep := "yisep" in
    let add := (append prefix "add") in
    let felem_copy := ("felem_copy" ++ felem_suffix) in
    ("Fp2_mul_alt2", (
      [outr; outi; xr; xi; yr; yi], [],
      bedrock_func_body:(
        stackalloc num_bytes as xrsep {
          stackalloc num_bytes as xisep {
            stackalloc num_bytes as yrsep {
              stackalloc num_bytes as yisep {
                (*Copies real part of first operand*)
                felem_copy (xrsep, xr);
                felem_copy (yrsep, yr);
                felem_copy (xisep, xi);
                felem_copy (yisep, yi);

                Fp2_mul (outr, outi, xrsep, xisep, yrsep, yisep)
              }
            }
          }
        }
      )
    )).

  Instance spec_of_my_mul_alt2: spec_of Fp2_mul_alt2 :=
  fun functions : list (string * (list string * list string * Syntax.cmd)) =>
      forall (wxr wxi wyr wyi : list Interface.word.rep)
      (pxr pxi pyr pyi poutr pouti : Interface.word.rep)
      (wold_outr wold_outi : list Interface.word.rep) (t : Semantics.trace)
      (m0 : Interface.map.rep) (Rxr Rxi Ryr Ryi Rout : Interface.map.rep -> Prop),
      (*typeclass isntead of valid?*)
      valid (List.map Interface.word.unsigned wxr) /\
      valid (List.map Interface.word.unsigned wxi) /\
      valid (List.map Interface.word.unsigned wyr) /\
      valid (List.map Interface.word.unsigned wyi) ->
      ((Bignum n pxr wxr) * Rxr)%sep m0 ->
      ((Bignum n pxi wxi) * Rxi)%sep m0 ->
      ((Bignum n pyr wyr) * Ryr)%sep m0 ->
      ((Bignum n pyi wyi) * Ryi)%sep m0 ->
      ((Bignum n poutr wold_outr) * (Bignum n pouti wold_outi) * Rout)%sep m0 ->
      WeakestPrecondition.call functions ( "Fp2_mul_alt2") t m0
      ([poutr; pouti; pxr; pxi; pyr; pyi])
      (fun (t' : Semantics.trace) (m' : Interface.map.rep)
          (rets : list Interface.word.rep) =>
      t = t' /\
      rets = nil /\
      (exists (woutr wouti : list Interface.word.rep) Routnew,
          (
                  (Fp2_mul_Gallina_spec (List.map Interface.word.unsigned wxr, List.map Interface.word.unsigned wxi)
                  (List.map Interface.word.unsigned wyr, List.map Interface.word.unsigned wyi)
                  (List.map Interface.word.unsigned woutr, List.map Interface.word.unsigned wouti) /\
                  valid (List.map Interface.word.unsigned woutr) /\
                  valid (List.map Interface.word.unsigned wouti)) /\
              ((Bignum n poutr woutr) * (Bignum n pouti wouti) * Rout * Routnew)%sep m'))).

  Theorem Fp2_mul_alt2_okay: program_logic_goal_for_function! Fp2_mul_alt2.
  Proof.
    do 7 straightline'.

    (*Assert single hypothesis for stackallocation.*)
    remember (Bignum n pxr wxr * Rxr)%sep as Rxr'.
    remember (Bignum n pyr wyr * Ryr)%sep as Ryr'.
    remember (Bignum n pxi wxi * Rxi)%sep as Rxi'.
    remember (Bignum n pyi wyi * Ryi)%sep as Ryi'.
    remember ((Bignum n poutr wold_outr * Bignum n pouti wold_outi * Rout)%sep) as Rout'.

    assert (
        id (fun m => (Rxr' m /\ Ryr' m /\ Rxi' m /\ Ryi' m /\ Rout' m)) m0).
    {
      cbv [id]. split; auto.
    }

    (*Allocate memory on stack. *)
    repeat straightline'. clear H1 Hmnew Hmnew0 Hmnew1. cbv [id] in *.

  (*Handle calls to felem_copy*)
    copy_next Rxr' (fun m => Ryr' m /\ Rxi' m /\ Ryi' m /\ Rout' m) mnew2 pxr wxr Rxr a Hmnew2.
    copy_next Ryr' (fun m => Rxi' m /\ Ryi' m /\ Rout' m) a4 pyr wyr Ryr a1 H15.
    copy_next Rxi' (fun m => Ryi' m /\ Rout' m) a6 pxi wxi Rxi a0 H15.
    copy_next Ryi' (fun m => Rout' m) a4 pyi wyi Ryi a2 H15.

  (*Handle function call*)
  repeat straightline.
  straightline_call.
  2: {
    assert (Hnumlimbs : n = num_limbs) by auto. rewrite !Hnumlimbs. rewrite !Hnumlimbs in H15.
    ecancel_assumption.
  }
  1: split; auto.

  (*Defragment memory in context after stack allocation. *)
  repeat straightline.
  repeat defrag_in_context'.

  (*Postcondition*)
  postcondition_pre.
  split; [auto| split; auto].
  Qed.

  Definition Fp2_square_alt2 : Syntax.func :=
    let outr := "outr" in
    let outi := "outi" in
    let xr := "xr" in
    let xi := "xi" in
    let xrsep := "xrsep" in
    let xisep := "xisep" in
    let felem_copy := ("felem_copy" ++ felem_suffix) in
    ("Fp2_square_alt2", (
      [outr; outi; xr; xi], [],
      bedrock_func_body:(
        stackalloc num_bytes as xrsep {
          stackalloc num_bytes as xisep {
            (*Copies real part of first operand*)
            felem_copy (xrsep, xr);
            felem_copy (xisep, xi);

            Fp2_square (outi, outr, xrsep, xisep)
          }
        }
      )
    )).

  Instance spec_of_my_square_alt2: spec_of Fp2_square_alt2 :=
  fun functions : list (string * (list string * list string * Syntax.cmd)) =>
      forall (wxr wxi : list Interface.word.rep)
      (pxr pxi poutr pouti : Interface.word.rep)
      (wold_outr wold_outi : list Interface.word.rep) (t : Semantics.trace)
      (m0 : Interface.map.rep) (Rxr Rxi Rout : Interface.map.rep -> Prop),
      (*typeclass isntead of valid?*)
      valid (List.map Interface.word.unsigned wxr) /\
      valid (List.map Interface.word.unsigned wxi) ->
      ((Bignum n pxr wxr) * Rxr)%sep m0 ->
      ((Bignum n pxi wxi) * Rxi)%sep m0 ->
      ((Bignum n poutr wold_outr) * (Bignum n pouti wold_outi) * Rout)%sep m0 ->
      WeakestPrecondition.call functions ( "Fp2_square_alt2") t m0
      ([pouti; poutr; pxr; pxi])
      (fun (t' : Semantics.trace) (m' : Interface.map.rep)
          (rets : list Interface.word.rep) =>
      t = t' /\
      rets = nil /\
      (exists (woutr wouti : list Interface.word.rep) Routnew,
          (
                  (Fp2_square_Gallina_spec (List.map Interface.word.unsigned wxr, List.map Interface.word.unsigned wxi)
                  (List.map Interface.word.unsigned woutr, List.map Interface.word.unsigned wouti) /\
                  valid (List.map Interface.word.unsigned woutr) /\
                  valid (List.map Interface.word.unsigned wouti)) /\
              ((Bignum n poutr woutr) * (Bignum n pouti wouti) * Routnew)%sep m'))).

  Theorem Fp2_square_alt2_okay: program_logic_goal_for_function! Fp2_square_alt2.
  Proof.
    do 4 straightline'.

    (*Assert single hypothesis for stackallocation.*)
    remember (Bignum n pxr wxr * Rxr)%sep as Rxr'.
    remember (Bignum n pxi wxi * Rxi)%sep as Rxi'.
    remember ((Bignum n poutr wold_outr * Bignum n pouti wold_outi * Rout)%sep) as Rout'.

    assert (
        id (fun m => (Rxr' m /\ Rxi' m /\ Rout' m)) m0).
    {
      cbv [id]. split; auto.
    }

    (*Allocate memory on stack. *)
    repeat straightline'. clear Hmnew. cbv [id] in *.

  (*Handle calls to felem_copy*)
    copy_next Rxr' (fun m => Rxi' m /\ Rout' m) mnew0 pxr wxr Rxr a Hmnew0.
    copy_next Rxi' (fun m => Rout' m) a2 pxi wxi Rxi a0 H10.

  (*Handle function call*)
  repeat straightline.
  straightline_call.
  2: {
    assert (Hnumlimbs : n = num_limbs) by auto. rewrite !Hnumlimbs. rewrite !Hnumlimbs in H10. ecancel_assumption.
  }
  1: split; auto.

  (*Defragment memory in context after stack allocation. *)
  repeat straightline.
  repeat defrag_in_context'.

  (*Postcondition*)
  postcondition_pre.
  split; [auto| destruct H13 as [ Hvalid [Hvalid' _]]; split; auto].
  Qed.

  (* From bedrock2 Require Import ToCString Bytedump.
  Definition bls12_c_add :=
    c_module (add :: nil).
    Definition bls12_c_mul :=
    c_module (mul :: nil).
    Definition bls12_c_sub :=
    c_module (sub :: nil).
    Definition bls12_c_Fp2_add :=
    c_module (Fp2_add :: nil).
    Definition bls12_c_Fp2_mul :=
    c_module (Fp2_mul :: nil).
    Definition bls12_c_Fp2_sub :=
    c_module (Fp2_sub :: nil).
    Definition bls12_c_Fp2_add_alt2 :=
    c_module (Fp2_add_alt2 :: nil).
    Definition bls12_c_Fp2_sub_alt2 :=
    c_module (Fp2_sub_alt2 :: nil).
    Definition bls12_c_Fp2_mul_alt2 :=
    c_module (Fp2_mul_alt2 :: nil).
    Definition bls12_c_Fp2_square_alt2 :=
      c_module (Fp2_square_alt2 :: nil).

    Eval compute in bls12_c_Fp2_mul. *)

    (*Theory*)
    (*Connects the Gallina specification above to algebraic field theory.*)

    Notation Fp2elem := ((GZnZ.znz m) * (GZnZ.znz m)).
    Notation Fp2_add_spec x y z := (z = addp2 m x y).
    Notation Fp2_mul_spec x y z := (z = mulp2 m x y).
    Notation Fp2_sub_spec x y z := (z = subp2 m x y).
    Definition valid_Fp2 x := valid (fst x) /\ valid (snd x).

    Lemma m_mod4_bool : Z.eqb (m mod 4) 3 = true.
    Proof. apply Z.eqb_eq; auto with zarith. Qed.

    Local Open Scope Z_scope.

    Lemma Quad_non_res_val : GZnZ.val m (Quad_non_res m) = (- 1) mod m.
    Proof. auto. Qed.

    Definition list_to_Fp x (H: valid x) := GZnZ.mkznz m (eval (from_mont x)) (eq_sym (valid_mod H)).
    Definition list_to_Fp2 x (H : valid_Fp2 x) := (GZnZ.mkznz m (evfst x) (eq_sym (valid_mod (proj1 H))), GZnZ.mkznz m (evsnd x) (eq_sym (valid_mod (proj2 H)))).

    Lemma znz_val : forall x H, GZnZ.val m {|GZnZ.val := x; GZnZ.inZnZ := H|} = x.
    Proof. reflexivity. Qed.

    Theorem Gallina_spec_add_field : forall x y z (Hx : valid_Fp2 x) (Hy : valid_Fp2 y) (Hz : valid_Fp2 z),
      Fp2_add_spec (list_to_Fp2 x Hx) (list_to_Fp2 y Hy) (list_to_Fp2 z Hz) <-> Fp2_add_Gallina_spec x y z.
    Proof.
      split.
      -
      intros. unfold Fp2_add_Gallina_spec. destruct Hx, Hy, Hz.
      split; [auto| ].
      split; [auto| ].
      unfold list_to_Fp2 in H. apply pair_equal_spec in H. destruct H.
      repeat rewrite Prod.fst_pair in H. repeat rewrite Prod.snd_pair in H0. apply GZnZ.znz_inj in H, H0.
      unfold GZnZ.add in H, H0. repeat rewrite znz_val in H, H0. auto.
        - intros. unfold Fp2_add_Gallina_spec in H. destruct H. destruct H0. destruct H1.
          unfold list_to_Fp2. unfold addp2. unfold GZnZ.add.
          apply pair_equal_spec. repeat rewrite Prod.snd_pair. repeat rewrite Prod.fst_pair.
          split; (apply GZnZ.zirr; repeat rewrite znz_val; auto).
    Qed.

  Theorem Gallina_spec_sub_field : forall x y z (Hx : valid_Fp2 x) (Hy : valid_Fp2 y) (Hz : valid_Fp2 z),
    Fp2_sub_spec (list_to_Fp2 x Hx) (list_to_Fp2 y Hy) (list_to_Fp2 z Hz) <-> Fp2_sub_Gallina_spec x y z.
  Proof.
    split.
    - intros. unfold Fp2_sub_Gallina_spec. destruct Hx, Hy, Hz.
      split; [auto| ].
      split; [auto| ].
      unfold list_to_Fp2 in H. apply pair_equal_spec in H. destruct H.
      repeat rewrite Prod.fst_pair in H. repeat rewrite Prod.snd_pair in H0. apply GZnZ.znz_inj in H, H0.
      unfold GZnZ.sub in H, H0. repeat rewrite znz_val in H, H0. auto.
    - intros. unfold Fp2_sub_Gallina_spec in H. destruct H. destruct H0. destruct H1.
      unfold list_to_Fp2. unfold subp2. unfold GZnZ.sub.
      apply pair_equal_spec. repeat rewrite Prod.snd_pair. repeat rewrite Prod.fst_pair.
      split; (apply GZnZ.zirr; repeat rewrite znz_val; auto).
  Qed.

  Theorem Gallina_spec_mul_field : forall x y z (Hx : valid_Fp2 x) (Hy : valid_Fp2 y) (Hz : valid_Fp2 z),
    Fp2_mul_spec (list_to_Fp2 x Hx) (list_to_Fp2 y Hy) (list_to_Fp2 z Hz) <-> Fp2_mul_Gallina_spec x y z.
  Proof.
    split.
      - intros. unfold Fp2_mul_Gallina_spec. destruct Hx, Hy, Hz.
        split; [auto| ].
        split; [auto| ].
        unfold list_to_Fp2 in H. apply pair_equal_spec in H. destruct H.
        apply GZnZ.znz_inj in H, H0.
        unfold GZnZ.mul in H, H0. unfold GZnZ.add in H, H0. unfold GZnZ.mul in H, H0. rewrite Quad_non_res_val in H.
        repeat rewrite Prod.fst_pair in H, H0. repeat rewrite Prod.snd_pair in H, H0. repeat rewrite znz_val in H, H0. rewrite znz_val in H.
        rewrite H, H0.
        remember (evfst x) as xr. remember (evfst y) as yr.
        remember (evsnd x) as xi. remember (evsnd y) as yi. pull_Zmod.
        split; (apply (f_equal (fun y => y mod m)); ring).
      - intros. unfold Fp2_mul_Gallina_spec in H. destruct H. destruct H0. destruct H1.
        unfold list_to_Fp2. unfold mulp2. unfold GZnZ.add.
        unfold GZnZ.sub. unfold GZnZ.mul. rewrite Quad_non_res_val.
        apply pair_equal_spec. repeat rewrite Prod.snd_pair. repeat rewrite Prod.fst_pair.
        repeat rewrite znz_val. remember (evfst x) as xr. remember (evfst y) as yr.
        remember (evsnd x) as xi. remember (evsnd y) as yi. split; apply GZnZ.zirr.
          + rewrite H1. pull_Zmod. apply (f_equal (fun y => y mod m)); ring.
          + rewrite H2. pull_Zmod. apply (f_equal (fun y => y mod m)); ring.
  Qed.

End Spec.


Load LFindLoad.
From lfind Require Import LFind.
Unset Printing Notations.
Set Printing Implicit.

Inductive natural : Type := Succ : natural -> natural |  Zero : natural.

Inductive lst : Type := Cons : natural -> lst -> lst |  Nil : lst.

Inductive tree : Type := Node : natural -> tree -> tree -> tree |  Leaf : tree.

Inductive Pair : Type := mkpair : natural -> natural -> Pair
with Zlst : Type := zcons : Pair -> Zlst -> Zlst |  zNil : Zlst.

Fixpoint plus (plus_arg0 : natural) (plus_arg1 : natural) : natural
           := match plus_arg0, plus_arg1 with
              | Zero, n => n
              | Succ n, m => Succ (plus n m)
              end.

Fixpoint append (append_arg0 : lst) (append_arg1 : lst) : lst
           := match append_arg0, append_arg1 with
              | Nil, x => x
              | Cons x y, z => Cons x (append y z)
              end.

Fixpoint len (len_arg0 : lst) : natural
           := match len_arg0 with
              | Nil => Zero
              | Cons x y => Succ (len y)
              end.

Fixpoint rev (rev_arg0 : lst) : lst
           := match rev_arg0 with
              | Nil => Nil
              | Cons x y => append (rev y) (Cons x Nil)
              end.

Fixpoint qreva (qreva_arg0 : lst) (qreva_arg1 : lst) : lst
           := match qreva_arg0, qreva_arg1 with
              | Nil, x => x
              | Cons z x, y => qreva x (Cons z y)
              end.

Theorem plus_comm: forall (n m: natural), plus n m = plus m n.
Proof.
  induction n; induction m.
  { simpl. rewrite IHn. rewrite <- IHm. simpl. rewrite IHn. reflexivity. }
  { simpl. rewrite IHn. simpl. reflexivity. }
  { simpl. rewrite <- IHm. simpl. reflexivity. }
  { reflexivity. }
Qed.

Theorem theorem0 : forall (x : lst) (y : lst), eq (len (qreva x y)) (plus (len x) (len y)).
Proof.
  induction x; induction y; simpl; try reflexivity.
  +
    rewrite plus_comm. simpl.
    rewrite IHx. simpl. rewrite plus_comm.
    simpl. reflexivity.
  +
    lfind. Admitted.


Require Import vcfloat.VCFloat.
Require Import Interval.Tactic.
Import Binary Coq.Lists.List ListNotations.
Set Bullet Behavior "Strict Subproofs".
Section WITHNANS.
Context {NANS:Nans}.
Open Scope R_scope.

Definition turbine1_bmap_list := [Build_varinfo Tdouble 1%positive (-45e-1) (-3e-1);Build_varinfo Tdouble 2%positive (4e-1) (9e-1);Build_varinfo Tdouble 3%positive (38e-1) (78e-1)].

Definition turbine1_bmap :=
 ltac:(let z := compute_PTree (boundsmap_of_list turbine1_bmap_list) in exact z).

Definition turbine1 (v : ftype Tdouble) (w : ftype Tdouble) (r : ftype Tdouble) :=
  cast Tdouble (((((3)%F64 + ((2)%F64 / (r * r)%F64)%F64)%F64 - ((((125e-3)%F64 * ((3)%F64 - ((2)%F64 * v)%F64)%F64)%F64 * (((w * w)%F64 * r)%F64 * r)%F64)%F64 / ((1)%F64 - v)%F64)%F64)%F64 - (45e-1)%F64)%F64).

Definition turbine1_expr :=
 ltac:(let e' :=  HO_reify_float_expr constr:([1%positive;2%positive;3%positive]) turbine1 in exact e').

Derive a
SuchThat
(forall (v0 e2 d7 : R)
 (H : 38 / 10 <= v0 <= 78 / 10)
 (H0 : Rabs d7 <= / 9007199254740992)
 (H1 : Rabs e2 <=
     /
     404804506614621236704990693437834614099113299528284236713802716054860679135990693783920767402874248990374155728633623822779617474771586953734026799881477019843034848553132722728933815484186432682479535356945490137124014966849385397236206711298319112681620113024717539104666829230461005064372655017292012526615415482186989568),
 Rabs (v0 ^ 2 / (v0 ^ 2 * d7 + v0 ^ 2 + e2)) <= a - 0)
As a_proof.
Proof.
intros.
subst a.
match goal with |- Rabs ?a <= _ =>
   let G := fresh "G" in
   bisect_all_vars constr:(Rabs a) (@nil interval_tac_parameters); intro G;
   eapply Rle_trans;
   [apply G | apply Rminus_plus_le_minus; apply Rle_refl]
end.
Qed.

Derive turbine1_b
SuchThat (forall vmap, prove_roundoff_bound turbine1_bmap vmap turbine1_expr turbine1_b)
As turbine1_bound.
Proof.
idtac "Starting turbine1".
intro.
prove_roundoff_bound.
-
clear.
time  abstract (prove_rndval; interval).
-
time "prove_roundoff_bound2" prove_roundoff_bound2.
time "error_rewrites" error_rewrites.
all: time "prune_terms" prune_terms (cutoff 70); unfold Rsqr.
all: time "interval1"
try match goal with |- (Rabs ?e <= ?a - ?b)%R =>
                      let G := fresh "G" in
                      interval_intro (Rabs e) as G ;
                      eapply Rle_trans;
                      [apply G | apply Rminus_plus_le_minus; apply Rle_refl]
        end.
all: time "field_simplify" field_simplify_Rabs.
all: time "interval2"
match goal with |- Rabs ?a <= _ =>
   let G := fresh "G" in
   bisect_all_vars constr:(Rabs a) [i_depth 15]; intro G;
   eapply Rle_trans;
   [apply G | apply Rminus_plus_le_minus; apply Rle_refl]
end.
Time Qed.

Lemma check_turbine1_bound: ltac:(CheckBound turbine1_b 7.9e-14%F64).
Proof. reflexivity. Qed.

End WITHNANS.
Close Scope R_scope.


Require Utf8.

Require Import S00_setoid_basics S01_Wty S02_PolyFun S10_Wstd_Obj S11_Wstd_Fam S12_Wstd_Alg.

(*--------------------------*)
(* Glue and restr functions *)
(*--------------------------*)

Section Restriction.
  Context  {A : setoid}{B : setoidfamily A}{X : setoid}.

  (* Definition 4.1(17) *)

  Definition restr_fnc : (Wstd B ⇒ X) → ∀ u, ImSubTrees B u ⇒ X
    := λ h u, h ∘ M_ist u.

  (* Proposition 4.2(i) *)

  Definition restrIsCoh (h : Wstd B ⇒ X) : isCoh (restr_fnc h).

    intros s s' q ss. apply (setoidmapextensionality _ _ h).
    apply (M_ist_coh q ss).
  Defined.

  (* Proposition 4.2(iii) *)

  Definition restr : (Wstd B ⇒ X) ⇒ CohFam (ImSubTrees B) X.

    apply (Build_setoidmap (Wstd B ⇒ X) (CohFam (ImSubTrees B) X)
                           (λ h, existT _ (restr_fnc h) (restrIsCoh h))).
    intros h h' p u s. cbn. apply (p (ist u s)).
  Defined.

  Definition subrestr : (Wstd B ⇒ X) → ∀ u, CohFam (SubSubTrees (B := B) u) X.

    intros h u. exists (λ s, restr_fnc h (M_ist u s)).
    intros s s' q ss. apply (setoidmapextensionality _ _ h).
    apply M_ist_coh with (r := q).
  Defined.

End Restriction.

Section Glueing_along_Algebra.
  Context  {A : setoid}{B : setoidfamily A}{X : setoid}(algX : PolyObj B X ⇒ X).

  (* Definition 4.1(18) and Proposition 4.2(ii,iv) *)

  Definition glue_fnc : CohFam (ImSubTrees B) X → Wstd B ⇒ X
    := λ  CF, algX ∘ InPoly (node B) (E_action CF).

  Definition glue : CohFam (ImSubTrees B) X ⇒ Wstd B ⇒ X.

    apply (Build_setoidmap _ _ glue_fnc).
    intros CF CF' p u. apply (setoidmapextensionality _ _ algX).
    exists (setoidrefl _ (node B u)). cbn. intro b.
    refine (_ ⊙ (p u b)). apply (setoidmapextensionality _ _ (projT1 CF' u)).
    apply setoidmapextensionality. apply setoidfamilyrefgeneralinv.
  Defined.

  (* Proposition 4.2(v) *)

  Lemma GRfixIffAlgMor (h : Wstd B ⇒ X)
    : glue (restr h) ≈ h ↔ isAlgMor (SupMap B) algX h.
  Proof.
    split.
    intro H. apply (AlgSquareAlt algX h). apply (H ˢ).
    intro H. apply setoidsym. apply (AlgSquareAlt algX h). apply H.
  Qed.

  (* Proposition 4.2(vi) *)

  Lemma RGfix2AlgMor (CF : CohFam (ImSubTrees B) X)
    : restr (glue CF) ≈ CF → isAlgMor (SupMap B) algX (glue CF).
  Proof.
    intro H. intros [a f]. set (u := SupFnc B (existT _ a f)).
    apply (setoidmapextensionality _ _ algX).
    exists (setoidrefl _ a).
    intro b. specialize (H u b).
    refine (_ ⊙ H ˢ).
    apply setoidtra with (y := projT2 (PolyArr B (glue CF) (existT _ a f)) b).
    2: { apply (setoidmapextensionality _ _ (projT2 (PolyArr B (glue CF) (existT _ a f)))).
         apply setoidfamilyrefgeneralinv. }
    assert (K : PolyArr B (glue CF) (UnsupMap B u)
                   ≈ PolyArr B (glue CF) (existT (λ a0 : A, B a0 ⇒ Wstd B) a f)).
    apply (setoidmapextensionality _ _ (PolyArr B (glue CF))).
    exists (setoidrefl _ _). intro bb. cbn in bb. apply (setoidmapextensionality _ _ f).
    apply setoidfamilyrefgeneralinv.
    apply setoidfamilyrefgeneralfunction_rev with (f0 := projT2 (PolyArr B (glue CF) (UnsupMap B u)))
                                                  (f' := projT2 (PolyArr B (glue CF) (existT (λ a0 : A, B a0 ⇒ Wstd B) a f)))
                                                  (p := projT1 K).
    apply (projT2 K).
  Qed.

  (* CohFamSST_trsp only needed in Lemma 4.13 *)

  Definition CohFamSST_trsp {u u' : Wstd B}(r : u ≈ u')
    : CohFam (SubSubTrees u') X → CohFam (SubSubTrees u) X.

    intro CF'. exists (λ s, projT1 CF' ((ImSubTrees B)•r s) ∘ (ImSubTrees B)•(M_ist_coh r s)).
    cbn in CF'. unfold isCoh in CF'.
    intros s₁ s₂ q ss.
    set (s'₁ := (ImSubTrees B)•r s₁). set (s'₂ := (ImSubTrees B)•r s₂).
    set (q' := (ImSubTrees B)•r ↱ q : s'₁ ≈ s'₂).
    set (ss' := (ImSubTrees B)•(M_ist_coh r s₁) ss).
    set (C' := projT2 CF' s'₁ s'₂ q').
    refine (_ ⊙ C' ss').
    apply (setoidmapextensionality _ _ (projT1 CF' s'₂)).
    assert ( H1 : (ImSubTrees B)•q' ss' ≈ (ImSubTrees B)•(q' ⊙ (M_ist_coh r s₁)) ss ).
    apply setoidfamilycmpgeneral.
    refine (_ ⊙ H1).
    assert ( H2 : (ImSubTrees B)•(M_ist_coh r s₂ ⊙ (M_ist u ↱ q)) ss
                          ≈ (ImSubTrees B)•(M_ist_coh r s₂) ((ImSubTrees B)•q ss)).
    apply setoidsym, setoidfamilycmpgeneral.
    refine (H2 ⊙ _).
    apply setoidfamilyirr.
  Defined.

  (*------------------------------------*)
  (* Glueing of families on subsubtrees *)
  (*------------------------------------*)

  (* Lemma 4.5(i) *)

  Definition subglue_fnc (u : Wstd B)
    : CohFam (SubSubTrees u) X → ImSubTrees B u ⇒ X
    := λ CF, algX ∘ InPoly (node B ∘ M_ist (B := B) u) (subE_action (B := B) u CF).

  (* Lemma 4.5(ii) *)

  Definition subglue (u : Wstd B)
    : CohFam (SubSubTrees u) X ⇒ ImSubTrees B u ⇒ X.

    apply (Build_setoidmap (CohFam (SubSubTrees u) X) (ImSubTrees B u ⇒ X) (subglue_fnc u)).
    intros CF CF' pp s. apply (setoidmapextensionality (PolyObj B X) X algX).
    set (rn := setoidrefl A (node B (M_ist u s))).
    exists rn. cbn.
    intro bb. refine (_ ⊙ pp s bb).
    apply (setoidmapextensionality (B (node B (M_ist u s))) X
                                   (projT1 CF' s ∘ E_ist (M_ist u s))).
    apply setoidfamilyrefgeneralinv with (F := B)
                                         (x := node B (M_ist u s))
                                         (p := rn)
                                         (y := bb).
  Defined.

  (* Lemma 4.5(iii) *)

  Lemma subglue_coh {u u' : Wstd B}(r : u ≈ u')
        {CF : CohFam (SubSubTrees u) X}{CF' : CohFam (SubSubTrees u') X}
    : (∀ s, projT1 CF s ≈ projT1 CF' ((ImSubTrees B)•r s) ∘ (ImSubTrees B)•(M_ist_coh r s))
           → subglue_fnc u CF ≈ subglue_fnc u' CF' ∘ (ImSubTrees B)•r.
  Proof.
    intros H s. apply (setoidmapextensionality _ _ algX).
    exists (node B ↱ (M_ist_coh r s)).
    intro ss. refine (_ ⊙ H s ss).
    apply (setoidmapextensionality _ _ (projT1 CF' ((ImSubTrees B)•r s))).
    apply setoidrefl.
  Qed.

End Glueing_along_Algebra.


(* -*- coding: utf-8 -*- *)
(************************************************************************)
(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010     *)
(*   \VV/  **************************************************************)
(*    //   *      This file is distributed under the terms of the       *)
(*         *       GNU Lesser General Public License Version 2.1        *)
(************************************************************************)
(** * Proofs about standard combinators, exports functional extensionality.

   Author: Matthieu Sozeau
   Institution: LRI, CNRS UMR 8623 - University Paris Sud
*)

Require Import Coq.Program.Basics.
Require Export FunctionalExtensionality.

Open Scope program_scope.

(** Composition has [id] for neutral element and is associative. *)

Lemma compose_id_left : forall A B (f : A -> B), id ∘ f = f.
Proof.
  intros.
  unfold id, compose.
  symmetry. apply eta_expansion.
Qed.

Lemma compose_id_right : forall A B (f : A -> B), f ∘ id = f.
Proof.
  intros.
  unfold id, compose.
  symmetry ; apply eta_expansion.
Qed.

Lemma compose_assoc : forall A B C D (f : A -> B) (g : B -> C) (h : C -> D),
  h ∘ g ∘ f = h ∘ (g ∘ f).
Proof.
  intros.
  reflexivity.
Qed.

Hint Rewrite @compose_id_left @compose_id_right : core.
Hint Rewrite <- @compose_assoc : core.

(** [flip] is involutive. *)

Lemma flip_flip : forall A B C, @flip A B C ∘ flip = id.
Proof.
  unfold flip, compose.
  intros.
  extensionality x ; extensionality y ; extensionality z.
  reflexivity.
Qed.

(** [prod_curry] and [prod_uncurry] are each others inverses. *)

Lemma prod_uncurry_curry : forall A B C, @prod_uncurry A B C ∘ prod_curry = id.
Proof.
  simpl ; intros.
  unfold prod_uncurry, prod_curry, compose.
  extensionality x ; extensionality y ; extensionality z.
  reflexivity.
Qed.

Lemma prod_curry_uncurry : forall A B C, @prod_curry A B C ∘ prod_uncurry = id.
Proof.
  simpl ; intros.
  unfold prod_uncurry, prod_curry, compose.
  extensionality x ; extensionality p.
  destruct p ; simpl ; reflexivity.
Qed.