(* ---------------------------------------------------------------------

   This file is part of a repository containing the definitions and
   proof scripts related to the formalization of context-free language
   theory in Coq. Specifically, the following results were obtained:

   (i) languages square, prime and anbncn are not context-free;
   (ii) context-free languages are not closed under intersection.

   More information can be found in the paper "Some Applications of the
   Formalization of the Pumping Lemma for Context-Free Languages",
   submitted to LSFA 2018 by Marcus Vinícius Midena Ramos, Ruy J. G. B.
   de Queiroz, Nelma Moreira and José Carlos Bacelar Almeida.
   Also, in the thesis "Formalization of
   Context-Free Language Theory", submitted to the Informatics
   Center of the Pernambuco Federal University (CIn/UFPE) in
   Brazil.

   The file README.md describes the contents of each file and
   provides instructions on how to compile them.

   Marcus Vinícius Midena Ramos
   mvmramos@gmail.com
   --------------------------------------------------------------------- *)

   (* --------------------------------------------------------------------- *)
(* SIMPLIFICATION - USELESS SYMBOLS                                      *)
(* --------------------------------------------------------------------- *)

Require Import List.
Require Import Ring.
Require Import Omega.

Require Import misc_arith.
Require Import misc_list.
Require Import cfg.

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

Import ListNotations.
Open Scope list_scope.

(* --------------------------------------------------------------------- *)
(* SIMPLIFICATION - USELESS SYMBOLS - DEFINITIONS                        *)
(* --------------------------------------------------------------------- *)

Section Useless.

Variables terminal non_terminal: Type.
Notation sf := (list (non_terminal + terminal)).
Notation sentence := (list terminal).
Notation term_lift:= ((terminal_lift non_terminal) terminal).
Notation nlist:= (list non_terminal).
Notation tlist:= (list terminal).

Definition useful (g: cfg _ _) (s: non_terminal + terminal): Prop:=
match s with
| inr t => True
| inl n => exists s: sentence, derives g [inl n] (map term_lift s)
end.

Definition useful_sf (g: cfg _ _)(l: _): Prop:=
forall s: _,
In s l -> useful g s.

Inductive g_use_rules (g: cfg _ _): non_terminal -> sf -> Prop :=
| Lift_use : forall left: non_terminal,
             forall right: sf,
             rules g left right ->
             useful g (inl left) ->
             useful_sf g right ->
             g_use_rules g left right.

Lemma g_use_finite:
forall g: cfg _ _,
exists n: nat,
exists ntl: nlist,
exists tl: tlist,
In (start_symbol g) ntl /\
forall left: non_terminal,
forall right: sf,
g_use_rules g left right ->
(length right <= n) /\
(In left ntl) /\
(forall s: non_terminal, In (inl s) right -> In s ntl) /\
(forall s: terminal, In (inr s) right -> In s tl).
Proof.
intros g.
destruct (rules_finite g) as [n [ntl [ tl H1]]].
exists n, ntl, tl.
split.
- destruct H1 as [H1 _].
  exact H1.
- intros left right H2.
  inversion H2.
  subst.
  destruct H1 as [_ H1].
  specialize (H1 left right H).
  destruct H1 as [H4 [H5 H6]].
  split.
  + exact H4.
  + split.
    * exact H5.
    * exact H6.
Qed.

Definition g_use (g: cfg _ _): cfg _ _:= {|
start_symbol:= start_symbol g;
rules:= g_use_rules g;
t_eqdec:= t_eqdec g;
nt_eqdec:= nt_eqdec g;
rules_finite:= g_use_finite g
|}.

Definition has_no_useless_symbols (g: cfg _ _): Prop:=
forall n: _, appears g (inl n) -> useful g (inl n).

Definition non_empty (g: cfg _ _): Prop:=
useful g (inl (start_symbol g)).

(* --------------------------------------------------------------------- *)
(* SIMPLIFICATION - USELESS SYMBOLS - LEMMAS AND THEOREMS                *)
(* --------------------------------------------------------------------- *)

Lemma useful_exists:
forall g: cfg _ _,
forall n:non_terminal,
useful g (inl n) ->
exists (left : non_terminal) (right : sf),
rules g left right /\ (n = left \/ In (inl n) right).
Proof.
intros g n H1.
destruct H1 as [s H2].
apply exists_rule in H2.
destruct H2 as [H2 | H2].
- exists n, (map term_lift s).
  split.
  + exact H2.
  + left.
    reflexivity.
- destruct H2 as [right [H3 H4]].
  exists n, right.
  split.
  + exact H3.
  + left.
    reflexivity.
Qed.

Lemma useful_sf_sentence:
forall l: sf,
forall g: cfg _ _,
useful_sf g l -> exists s': sentence, derives g l (map term_lift s').
Proof.
intros l g H.
induction l.
- exists [].
  simpl.
  apply derives_refl.
- replace (a :: l) with ([a]++l) in H.
  + assert (H1: forall s: non_terminal + terminal, In s l -> useful g s).
      {
      intros s H1.
      specialize (H s).
      apply H.
      apply in_or_app.
      right.
      exact H1.
      }
    specialize (IHl H1).
    assert (H2: useful g a).
      {
      apply H.
      simpl.
      left.
      reflexivity.
      }
    unfold useful in H2.
    destruct a.
    * destruct IHl as [s' H3].
      destruct H2 as [s H2].
      exists (s ++ s').
      simpl.
      {
      rewrite map_app.
      change (inl n :: l) with ([inl n] ++ l).
      apply derives_combine.
      split.
      - exact H2.
      - exact H3.
      }
    * destruct IHl as [s2 H5].
      exists ([t] ++ s2).
      rewrite map_app.
      change (inr t :: l) with ([inr t] ++ l).
      apply derives_combine.
      {
      split.
      - simpl.
        constructor.
      - exact H5.
      }
  + simpl.
    reflexivity.
Qed.

Lemma use_step:
forall g: cfg _ _,
forall left: non_terminal,
forall right: sf,
rules g left right ->
(forall s: non_terminal + terminal, In s right -> useful g s) ->
useful g (inl left).
Proof.
intros g left right H1 H2.
unfold useful.
apply derives_rule with (s1:=[]) (s2:=[]) in H1.
simpl in H1.
rewrite app_nil_r in H1.
apply useful_sf_sentence in H2.
destruct H2 as [s' H3].
exists s'.
apply derives_trans with (s2:=right).
- exact H1.
- exact H3.
Qed.

Lemma useful_g_g_use:
forall g: cfg _ _,
forall n: non_terminal,
useful g (inl n) -> useful (g_use g) (inl n).
Proof.
intros g n H.
unfold useful in H.
destruct H as [x H].
unfold useful.
exists x.
apply derives_sflist in H.
apply derives_sflist.
destruct H as [l [H2 [H3 H4]]].
exists l.
split.
- assert (H5: length l >= 2 \/ length l < 2).
    {
    omega.
    }
  destruct H5 as [H5 | H5].
  + assert (H6:= H5).
    apply sflist_rules with (g:=g) in H5.
    destruct H5 as [H5 _].
    specialize (H5 H2).
    apply sflist_rules.
    * exact H6.
    * intros i H7.
      specialize (H5 i H7).
      destruct H5 as [left [right [s0 [s' [H10 [H11 H12]]]]]].
      exists left, right, s0, s'.
      {
      split.
      - exact H10.
      - split.
        + exact H11.
        + simpl.
          apply Lift_use.
          * exact H12.
          * unfold useful.
            assert (H20: derives g (s0 ++ inl left :: s') (map term_lift x)).
              {
              apply derives_sflist.
              rewrite <- (firstn_skipn i l) in H2.
              apply sflist_app_l in H2.
              exists (skipn i l).
              split.
              - exact H2.
              - split.
                + rewrite hd_skip.
                  exact H10.
                + rewrite last_skip.
                  * exact H4.
                  * omega.
              }
            assert (H21: exists s'': sentence, derives g [inl left] (map term_lift s'')).
              {
              apply derives_split in H20.
              destruct H20 as [s1' [s2' [H21 [_ H22]]]].
              replace (inl left :: s') with ([inl left] ++ s') in H22.
              - apply derives_split in H22.
                destruct H22 as [s1'0 [s2'0 [H31 [H32 _]]]].
                symmetry in H21.
                apply map_expand in H21.
                destruct H21 as [s1'' [s2'' [H40 [H41 H42]]]].
                rewrite <- H42 in H31.
                symmetry in H31.
                apply map_expand in H31.
                destruct H31 as [s1''' [s2''' [H50 [H51 H52]]]].
                rewrite <- H51 in H32.
                exists s1'''.
                exact H32.
              - simpl.
                reflexivity.
              }
            exact H21.
          * intros s1 H8.
            {
            destruct s1.
            - assert (H30: derives g (s0 ++ right ++ s') (map term_lift x)).
                {
                apply derives_sflist.
                rewrite <- (firstn_skipn (S i) l) in H2.
                apply sflist_app_l in H2.
                exists (skipn (S i) l).
                split.
                - exact H2.
                - split.
                  + rewrite <- H11.
                    apply hd_skip.
                  + rewrite <- H4.
                    apply last_skip.
                    omega.
                }
              assert (H31: exists s'': sentence, derives g right (map term_lift s'')).
                {
                apply derives_split in H30.
                destruct H30 as [s1' [s2' [H35 [H36 H37]]]].
                apply derives_split in H37.
                destruct H37 as [s1'0 [s2'0 [H38 [H39 H40]]]].
                symmetry in H35.
                apply map_expand in H35.
                destruct H35 as [s1'' [s2'' [H41 [H42 H43]]]].
                rewrite <- H43 in H38.
                symmetry in H38.
                apply map_expand in H38.
                destruct H38 as [s1''' [s2''' [H50 [H51 H52]]]].
                rewrite <- H51 in H39.
                exists s1'''.
                exact H39.
                }
              assert (H32: exists s'': sentence, derives g [inl n0] (map term_lift s'')).
                {
                apply in_split in H8.
                destruct H8 as [l1 [l2 H60]].
                rewrite H60 in H31.
                destruct H31 as [s'' H61].
                apply derives_split in H61.
                destruct H61 as [s1' [s2' [H35 [H36 H37]]]].
                replace (inl n0 :: l2) with ([inl n0] ++ l2) in H37.
                - apply derives_split in H37.
                  destruct H37 as [s1'0 [s2'0 [H38 [H39 H40]]]].
                  symmetry in H35.
                  apply map_expand in H35.
                  destruct H35 as [s1'' [s2'' [H41 [H42 H43]]]].
                  rewrite <- H43 in H38.
                  symmetry in H38.
                  apply map_expand in H38.
                  destruct H38 as [s1''' [s2''' [H50 [H51 H52]]]].
                  rewrite <- H51 in H39.
                  exists s1'''.
                  exact H39.
                - simpl.
                  reflexivity.
                }
              exact H32.
            - simpl.
              auto.
          }
      }
  + destruct l as [|s0 l].
    * apply sflist_empty.
    * {
      destruct l as [|s1 l].
      - apply sflist_start.
      - replace (s0 :: s1 :: l) with ([s0] ++ [s1] ++ l) in H5.
        + repeat rewrite app_length in H5.
          simpl in H5.
          repeat apply lt_S_n in H5.
          apply lt_n_0 in H5.
          contradiction.
        + simpl.
          reflexivity.
      }
- split.
  + exact H3.
  + exact H4.
Qed.

Lemma useful_g_use:
forall g: cfg _ _,
forall n: non_terminal,
appears (g_use g) (inl n) -> useful (g_use g) (inl n).
Proof.
intros g n H.
inversion H.
clear H.
destruct H0 as [right [H1 H2]].
destruct H2 as [H2| H2].
- subst.
  simpl in H1.
  inversion H1.
  subst.
  apply useful_g_g_use.
  exact H0.
- simpl in H1.
  inversion H1.
  subst.
  apply useful_g_g_use.
  specialize (H3 (inl n)).
  apply H3.
  exact H2.
Qed.

Lemma sflist_g_use_g:
forall g: cfg _ _,
forall l: list sf,
sflist (g_use g) l -> sflist g l.
Proof.
intros g l H.
induction H.
- apply sflist_empty.
- apply sflist_start.
- apply sflist_step with (left:=left).
  exact IHsflist.
  exact H0.
  simpl in H1.
  inversion H1.
  exact H2.
Qed.

Lemma produces_g_use_g:
forall g: cfg _ _,
forall s: sentence,
produces (g_use g) s -> produces g s.
Proof.
unfold produces.
unfold generates.
intros g s H.
apply derives_sflist in H.
destruct H as [l [H1 [H2 H3]]].
simpl in H2.
apply derives_sflist.
exists l.
split.
- apply sflist_g_use_g.
  exact H1.
- split.
  + exact H2.
  + exact H3.
Qed.

Lemma sflist_g_g_use:
forall g: cfg _ _,
forall l: list sf,
forall s: sentence,
sflist g l /\ last l [] = map term_lift s -> sflist (g_use g) l.
Proof.
intros g l s [H1 H2].
assert (H3: length l >= 2 \/ length l < 2).
  {
  omega.
  }
destruct H3 as [H3 | H3].
- assert (H3':=H3).
  apply sflist_rules with (g:=g) in H3.
  destruct H3 as [H3 _].
  specialize (H3 H1).
  apply sflist_rules.
  + exact H3'.
  + intros i H4.
    specialize (H3 i H4).
    destruct H3 as [left [right [s0 [s' [H5 [H6 H7]]]]]].
    exists left, right, s0, s'.
    split.
    * exact H5.
    * {
      split.
      - exact H6.
      - simpl.
        apply Lift_use.
        + exact H7.
        + unfold useful.
          assert (H20: derives g (s0 ++ inl left :: s') (map term_lift s)).
            {
            apply derives_sflist.
            rewrite <- (firstn_skipn i l) in H1.
            apply sflist_app_l in H1.
            exists (skipn i l).
            split.
            - exact H1.
            - split.
              + rewrite hd_skip.
                exact H5.
              + rewrite last_skip.
                * exact H2.
                * omega.
            }
          assert (H21: exists s'': sentence, derives g [inl left] (map term_lift s'')).
            {
            apply derives_split in H20.
            destruct H20 as [s1' [s2' [H21 [_ H22]]]].
            replace (inl left :: s') with ([inl left] ++ s') in H22.
            - apply derives_split in H22.
              destruct H22 as [s1'0 [s2'0 [H31 [H32 _]]]].
              symmetry in H21.
              apply map_expand in H21.
              destruct H21 as [s1'' [s2'' [H40 [H41 H42]]]].
              rewrite <- H42 in H31.
              symmetry in H31.
              apply map_expand in H31.
              destruct H31 as [s1''' [s2''' [H50 [H51 H52]]]].
              rewrite <- H51 in H32.
              exists s1'''.
              exact H32.
            - simpl.
              reflexivity.
            }
          exact H21.
        + intros s1 H99.
          destruct s1.
          * assert (H30: derives g (s0 ++ right ++ s') (map term_lift s)).
              {
              apply derives_sflist.
              rewrite <- (firstn_skipn (S i) l) in H1.
              apply sflist_app_l in H1.
              exists (skipn (S i) l).
                split.
              - exact H1.
              - split.
                + rewrite <- H6.
                  apply hd_skip.
                + rewrite <- H2.
                  apply last_skip.
                  omega.
              }
            assert (H31: exists s'': sentence, derives g right (map term_lift s'')).
              {
              apply derives_split in H30.
              destruct H30 as [s1' [s2' [H35 [H36 H37]]]].
              apply derives_split in H37.
              destruct H37 as [s1'0 [s2'0 [H38 [H39 H40]]]].
              symmetry in H35.
              apply map_expand in H35.
              destruct H35 as [s1'' [s2'' [H41 [H42 H43]]]].
              rewrite <- H43 in H38.
              symmetry in H38.
              apply map_expand in H38.
              destruct H38 as [s1''' [s2''' [H50 [H51 H52]]]].
              rewrite <- H51 in H39.
              exists s1'''.
              exact H39.
              }
            assert (H32: exists s'': sentence, derives g [inl n] (map term_lift s'')).
              {
              apply in_split in H99.
              destruct H99 as [l1 [l2 H60]].
              rewrite H60 in H31.
              destruct H31 as [s'' H61].
              apply derives_split in H61.
              destruct H61 as [s1' [s2' [H35 [H36 H37]]]].
              replace (inl n :: l2) with ([inl n] ++ l2) in H37.
              - apply derives_split in H37.
                destruct H37 as [s1'0 [s2'0 [H38 [H39 H40]]]].
                symmetry in H35.
                apply map_expand in H35.
                destruct H35 as [s1'' [s2'' [H41 [H42 H43]]]].
                rewrite <- H43 in H38.
                symmetry in H38.
                apply map_expand in H38.
                destruct H38 as [s1''' [s2''' [H50 [H51 H52]]]].
                rewrite <- H51 in H39.
                exists s1'''.
                exact H39.
              - simpl.
                reflexivity.
              }
            unfold useful.
            exact H32.
          * simpl.
            auto.
      }
- destruct l as [|s0 l].
  + apply sflist_empty.
  + destruct l as [|s1 l].
    * apply sflist_start.
    * {
      replace (s0 :: s1 :: l) with ([s0] ++ [s1] ++ l) in H3.
      - repeat rewrite app_length in H3.
        simpl in H3.
        repeat apply lt_S_n in H3.
        apply lt_n_0 in H3.
        contradiction.
      - simpl.
        reflexivity.
      }
Qed.

Lemma produces_g_g_use:
forall g: cfg _ _,
forall s: sentence,
produces g s -> produces (g_use g) s.
Proof.
unfold produces.
unfold generates.
intros g s H.
apply derives_sflist in H.
destruct H as [l [H1 [H2 H3]]].
apply derives_sflist.
exists l.
split.
- apply sflist_g_g_use with (s:=s).
  split.
  + exact H1.
  + exact H3.
- split.
  + exact H2.
  + exact H3.
Qed.

Theorem g_equiv_use:
forall g: cfg _ _,
non_empty g -> g_equiv (g_use g) g.
Proof.
unfold g_equiv.
intros g H' s.
split.
- apply produces_g_use_g.
- apply produces_g_g_use.
Qed.

Theorem g_use_correct:
forall g: cfg _ _,
non_empty g ->
g_equiv (g_use g) g /\
has_no_useless_symbols (g_use g).
Proof.
intros g H'.
split.
- apply g_equiv_use.
  exact H'.
- unfold has_no_useless_symbols.
  intros n H.
  inversion H.
  destruct H0 as [right [H1 H2]].
  simpl in H1.
  inversion H1.
  subst.
  destruct H2.
  + subst.
    apply useful_g_g_use in H3.
    exact H3.
  + specialize (H4 (inl n) H2).
    apply useful_g_g_use in H4.
    exact H4.
Qed.

(* --------------------------------------------------------------------- *)
(* SIMPLIFICATION - USELESS SYMBOLS - ALTERNATIVE DEFINITIONS            *)
(* --------------------------------------------------------------------- *)

Inductive useful2 (g: cfg non_terminal terminal): (non_terminal + terminal) -> Prop:=
| use_1: forall t: terminal,
         useful2 g (inr t)
| use_2: forall left: non_terminal,
         forall right: sf,
         rules g left right ->
         (forall s: non_terminal + terminal,
         In s right ->
         useful2 g s) ->
         useful2 g (inl left).

Fixpoint useful3 (g: cfg non_terminal terminal) (s: non_terminal + terminal): Prop:=
match s with
| inl n => False
| inr t => True
end.

End Useless.


Inductive Id (X:Set) : X -> X -> Prop :=
| refl : forall (x:X), Id X x x
.

Arguments Id {X} _ _.
Arguments refl {X} _.

Notation "x == y" := (Id x y) (at level 70, no associativity).

Lemma unit_singleton : forall (x:unit), x = tt.
Proof. intros []. reflexivity. Qed.

(*
Lemma Id_singleton : forall (X:Set) (x y:X) (p q: x == y), p = q.
Proof.
    intros X x y p q. destruct p.

Show.
*)


Require Export XR_R.
Require Export XR_Rlt.
Require Export XR_Rlt_irrefl.

Implicit Type r : R.
Local Open Scope R_scope.

Lemma Rlt_not_eq : forall r1 r2, r1 < r2 -> r1 <> r2.
Proof.
  intros x y.
  intro hxy.
  unfold not.
  intro eq.
  subst y.
  generalize dependent hxy.
  apply Rlt_irrefl.
Qed.


Require Import GL4ip_PSGL4ip_calcs.
Require Import List.
Export ListNotations.

Require Import existsT.
Require Import PeanoNat.
Require Import Lia.

Set Implicit Arguments.

Parameter eq_dec_propvar : forall x y : V, {x = y}+{x <> y}.

Lemma In_dec : forall l (a : MPropF) , (In a l) + ((In a l) -> False).
Proof.
induction l.
- right. intro. destruct H.
- intro a0. pose (IHl a0). destruct s.
  * left. apply in_cons. assumption.
  * destruct (eq_dec_form a a0).
    + subst. left. apply in_eq.
    + right. intro. inversion H.
      { apply n. assumption. }
      { apply f. assumption. }
Qed.

(* Let us prove some lemmas about remove. *)

Lemma in_not_touched_remove : forall l1 (a0 a1 : MPropF),
        In a0 l1 -> a0 <> a1 -> In a0 (remove eq_dec_form a1 l1).
Proof.
induction l1.
- intros. inversion H.
- intros. simpl. destruct (eq_dec_form a1 a).
  * subst. apply IHl1. inversion H. exfalso. apply H0. auto. assumption. assumption.
  * inversion H. subst. apply in_eq. apply in_cons. apply IHl1. assumption. assumption.
Qed.

Lemma remove_dist_app {A : Type} (eq_dec : forall x y : A, {x = y} + {x <> y}) :
        forall (a : A) l1 l2, (@remove A eq_dec a (l1 ++ l2)) =
                              (@remove A eq_dec a l1) ++ (@remove A eq_dec a l2).
Proof.
intros a l1. induction l1.
- intro l2. rewrite app_nil_l. simpl. reflexivity.
- intro l2. simpl. destruct (eq_dec a a0).
  * apply IHl1.
  * simpl. rewrite IHl1. reflexivity.
Qed.

Lemma remove_not_in_anymore : forall l (A : MPropF),
          (In A (remove eq_dec_form A l)) -> False.
Proof.
induction l.
- intros. simpl in H. inversion H.
- intros. simpl in H. destruct (eq_dec_form A a). subst. apply IHl in H. assumption.
  inversion H. apply n. symmetry. assumption. apply IHl in H0. assumption.
Qed.

Lemma in_remove_in_init : forall l A B,
    In A (remove eq_dec_form B l) -> In A l.
Proof.
induction l.
- intros. simpl. inversion H.
- intros. destruct (eq_dec_form A a). subst. apply in_eq. apply in_cons.
  pose (IHl A B). apply i. simpl in H. destruct (eq_dec_form B a).
  * subst. assumption.
  * inversion H. exfalso. apply n. symmetry. assumption. assumption.
Qed.

Lemma remove_preserv_NoDup : forall l (A : MPropF), NoDup l -> NoDup (remove eq_dec_form A l).
Proof.
induction l.
- intros. simpl. apply NoDup_nil.
- intros. simpl. destruct (eq_dec_form A a).
  * subst. apply IHl. inversion H. assumption.
  * apply NoDup_cons. intro. apply in_remove_in_init in H0. inversion H. apply H3. assumption.
    apply IHl. inversion H. assumption.
Qed.

Lemma NoDup_destr_split : forall l1 l2 (A : MPropF), NoDup (l1 ++ A :: l2) -> NoDup (l1 ++ l2).
Proof.
induction l1.
- intros. rewrite app_nil_l. rewrite app_nil_l in H. inversion H. assumption.
- intros. simpl. apply NoDup_cons. intro. inversion H. subst. apply H3. apply in_app_or in H0.
  destruct H0. apply in_or_app. left. assumption. apply in_or_app. right. apply in_cons.
  assumption. simpl in H. inversion H. subst. apply IHl1 with (A:=A). assumption.
Qed.

Lemma remove_le_length : forall l (A : MPropF), length (remove eq_dec_form A l) <= length l.
Proof.
induction l.
- intros. simpl. reflexivity.
- intros. simpl. destruct (eq_dec_form A a).
  * subst. apply le_S. apply IHl.
  * simpl. apply le_n_S. apply IHl.
Qed.

Lemma remove_In_smaller_length : forall l (A : MPropF),
                                 In A l -> length (remove eq_dec_form A l) < length l.
Proof.
induction l.
- intros. inversion H.
- intros. simpl. destruct (eq_dec_form A a).
  * subst. unfold lt. apply le_n_S. apply remove_le_length.
  * simpl. apply Lt.lt_n_S. apply IHl. inversion H. subst. exfalso. apply n. auto.
    assumption.
Qed.

Lemma double_remove {A : Type} (eq_dec : forall x y : A, {x = y} + {x <> y}) :
      forall a l, (@remove A eq_dec a (@remove A eq_dec a l)) = (@remove A eq_dec a l).
Proof.
intros a l. induction l.
- simpl. reflexivity.
- simpl. destruct (eq_dec a a0).
  * subst. apply IHl.
  * simpl. destruct (eq_dec a a0).
    + exfalso. apply n. assumption.
    + rewrite IHl. reflexivity.
Qed.

Lemma permut_remove {A : Type} (eq_dec : forall x y : A, {x = y} + {x <> y}) :
      forall a0 a1 l, (@remove A eq_dec a0 (@remove A eq_dec a1 l)) =
                      (@remove A eq_dec a1 (@remove A eq_dec a0 l)).
Proof.
intros a0 a1 l. induction l.
- simpl. reflexivity.
- simpl. destruct (eq_dec a1 a).
  * subst. simpl. destruct (eq_dec a0 a).
    + subst. reflexivity.
    + simpl. destruct (eq_dec a a). apply IHl. exfalso. apply n0. reflexivity.
  * simpl. destruct (eq_dec a0 a).
    + subst. assumption.
    + simpl. destruct (eq_dec a1 a). exfalso. apply n. assumption.
      rewrite IHl. reflexivity.
Qed.

Lemma In_remove_diff : forall l (A B : MPropF), In A (remove eq_dec_form B l) -> A <> B.
Proof.
induction l ; intros.
- intro. simpl in H. assumption.
- simpl in H. destruct (eq_dec_form B a).
  * subst. apply IHl. assumption.
  * inversion H.
    + subst. intro. apply n. symmetry. assumption.
    + apply IHl. assumption.
Qed.

(* Now we define remove_list and prove some lemmas about it. *)

Fixpoint remove_list (l1 l2: list MPropF) : list MPropF :=
match l1 with
  | [] => l2
  | h1 :: t1 => remove eq_dec_form h1 (remove_list t1 l2)
end.

Lemma remove_list_of_nil : forall (l : list MPropF), remove_list l nil = nil.
Proof.
induction l.
- simpl. reflexivity.
- simpl. rewrite IHl. simpl. reflexivity.
Qed.

Lemma app_remove_list : forall (l1 l2 l3 : list MPropF),
        remove_list (l1 ++ l2) l3 = remove_list l1 (remove_list l2 l3).
Proof.
induction l1.
- simpl. firstorder.
- induction l2.
  * intro l3. rewrite app_nil_r. simpl. reflexivity.
  * intro l3. simpl. pose (IHl1 (a0 :: l2) l3). simpl in e.
    rewrite e. reflexivity.
Qed.

Lemma remove_list_preserv_NoDup : forall l1 l2, NoDup l2 -> NoDup (remove_list l1 l2).
Proof.
induction l1.
- intros. simpl. assumption.
- intros. simpl. apply IHl1 in H. apply remove_preserv_NoDup with (A:=a) in H.
  assumption.
Qed.

Lemma remove_list_cont : forall l1 A, In A l1 -> (forall l2, In A (remove_list l1 l2) -> False).
Proof.
induction l1.
- intros. inversion H.
- intros. inversion H.
  * subst. simpl in H0. apply remove_not_in_anymore in H0. assumption.
  * simpl in H0. pose (IHl1 A H1 l2). apply f. apply in_remove_in_init with (B:= a). assumption.
Qed.

Lemma remove_list_dist_app : forall (l1 l2 l3 : list MPropF),
        remove_list l1 (l2 ++ l3) = (remove_list l1 l2) ++ (remove_list l1 l3).
Proof.
induction l1.
- intros. simpl. reflexivity.
- simpl. intros. rewrite IHl1. simpl. rewrite remove_dist_app. reflexivity.
Qed.

Lemma permut_remove_remove_list : forall a (l1 l2 : list MPropF),
      remove eq_dec_form a (remove_list l1 l2) =
      remove_list l1 (remove eq_dec_form a l2).
Proof.
intros a l1. generalize dependent a. induction l1 ; simpl.
- reflexivity.
- intros. rewrite permut_remove. rewrite IHl1. reflexivity.
Qed.

Lemma swap_remove_list : forall (l1 l2 l3 : list MPropF),
      remove_list (l1 ++ l2) l3 = remove_list (l2 ++ l1) l3.
Proof.
induction l1.
- intros. rewrite app_nil_l. rewrite app_nil_r. reflexivity.
- induction l2.
  * rewrite app_nil_l. rewrite app_nil_r. reflexivity.
  * intro l3. simpl. rewrite IHl1. simpl. rewrite permut_remove.
    rewrite <- IHl2. simpl. rewrite IHl1. reflexivity.
Qed.

Lemma redund_remove_remove_list : forall a (l1 l2 : list MPropF),
      remove eq_dec_form a (remove_list (remove eq_dec_form a l1) l2) =
      remove eq_dec_form a (remove_list l1 l2).
Proof.
intro a. induction l1.
- intro l2. simpl. reflexivity.
- intro l2. simpl. destruct (eq_dec_form a a0).
  * rewrite IHl1. subst. rewrite double_remove. reflexivity.
  * simpl. rewrite permut_remove. rewrite IHl1. apply permut_remove.
Qed.

Lemma redund_remove : forall (l1 l2 l3 : list MPropF) a,
      remove eq_dec_form a (remove_list l1 (remove_list (remove eq_dec_form a l2) l3)) =
      remove eq_dec_form a (remove_list l1 (remove_list l2 l3)).
Proof.
intros. repeat rewrite <- app_remove_list. rewrite swap_remove_list.
rewrite app_remove_list. rewrite redund_remove_remove_list. rewrite <- app_remove_list.
rewrite swap_remove_list. reflexivity.
Qed.

Lemma redund_remove_list : forall (l1 l2 l3 : list MPropF),
      remove_list l1 (remove_list (remove_list l1 l2) l3) = remove_list l1 (remove_list l2 l3).
Proof.
induction l1 ; intros ; simpl.
- reflexivity.
- rewrite redund_remove. rewrite IHl1. reflexivity.
Qed.

Lemma remove_list_in_single : forall l1 a, (In a l1) -> remove_list l1 [a] = nil.
Proof.
induction l1.
- intros. inversion H.
- intros. inversion H.
  * subst. simpl. rewrite permut_remove_remove_list. simpl. destruct (eq_dec_form a0 a0).
    apply remove_list_of_nil. exfalso. apply n. reflexivity.
  * apply IHl1 in H0. simpl. rewrite H0. simpl. reflexivity.
Qed.

Lemma not_removed_remove_list : forall l2 l1 A, In A l2 -> (In A l1 -> False) -> In A (remove_list l1 l2).
Proof.
induction l2.
- intros. inversion H.
- induction l1.
  * intros. simpl. assumption.
  * intros. simpl. pose (in_not_touched_remove (remove_list l1 (a :: l2))). pose (i A).
    pose (i0 a0). apply i1. apply IHl1. assumption. intro. apply H0. apply in_cons. assumption.
    clear i1. clear i0. clear i. destruct (eq_dec_form A a0). intro. apply H0. subst. apply in_eq.
    assumption.
Qed.

Lemma add_remove_list_preserve_NoDup : forall (l1 l2 : list MPropF),
            NoDup l1 -> NoDup l2 -> NoDup (l1 ++ (remove_list l1 l2)).
Proof.
induction l1.
- intros. rewrite app_nil_l. simpl. assumption.
- intros. simpl. apply NoDup_cons.
  * intro. apply in_app_or in H1. destruct H1. inversion H. apply H4. assumption.
    apply remove_not_in_anymore in H1. assumption.
  * rewrite permut_remove_remove_list. apply IHl1. inversion H. assumption.
    apply remove_preserv_NoDup. assumption.
Qed.

Lemma remove_list_is_in : forall l1 l2 A, In A l1 -> In A (l2 ++ (remove_list l2 l1)).
Proof.
intros. pose (In_dec l2 A). destruct s.
- apply in_or_app. left. assumption.
- apply in_or_app. right. apply not_removed_remove_list ; assumption.
Qed.

Lemma In_remove_same : forall l1 l2 (A : MPropF), In A l1 ->
                remove_list l1 (A :: l2) = remove_list l1 l2.
Proof.
induction l1.
- intros. inversion H.
- intros. inversion H.
  * subst. simpl. rewrite permut_remove_remove_list. simpl. destruct (eq_dec_form A A).
    rewrite permut_remove_remove_list. reflexivity. exfalso. apply n. reflexivity.
  * simpl. pose (IHl1 l2 A H0). rewrite e. reflexivity.
Qed.

Lemma In_remove_length_same : forall l1 l2 (A : MPropF), In A l1 ->
                length (remove_list l1 (A :: l2)) = length (remove_list l1 l2).
Proof.
intros. rewrite In_remove_same. reflexivity. assumption.
Qed.

Lemma length_le_remove_list : forall (l1 l2 : list MPropF), length (remove_list l1 l2) <= length l2.
Proof.
induction l1.
- intros. auto.
- intros. simpl. rewrite permut_remove_remove_list. pose (IHl1 (remove eq_dec_form a l2)).
  apply Nat.le_trans with (m:=length (remove eq_dec_form a l2)). assumption.
  apply remove_le_length.
Qed.

Lemma remove_list_singl_id_or_nil : forall l (A : MPropF), remove_list l [A] = nil \/ remove_list l [A] = [A].
Proof.
induction l.
- intros. right. auto.
- intros. pose (IHl A). destruct o. left. simpl. rewrite H. auto.
  simpl. rewrite H. destruct (eq_dec_form A a).
  * subst. left. simpl. destruct (eq_dec_form a a). reflexivity. exfalso. apply n.
    reflexivity.
  * right. simpl. destruct (eq_dec_form a A). exfalso. apply n. symmetry. assumption.
    reflexivity.
Qed.

Lemma remove_list_non_empty_inter_smaller_length : forall l2 l1 (A : MPropF),
                                 In A l1 -> In A l2 -> length (remove_list l1 l2) < length l2.
Proof.
induction l2.
- intros. inversion H0.
- intros. simpl. destruct (eq_dec_form A a).
  * subst. rewrite In_remove_length_same. 2: assumption. unfold lt. apply le_n_S.
    apply length_le_remove_list.
  * inversion H0.
    + exfalso. apply n. symmetry. assumption.
    + assert (a :: l2 = [a] ++ l2). auto. rewrite H2. rewrite remove_list_dist_app.
      rewrite app_length. pose (remove_list_singl_id_or_nil l1 a). destruct o.
      rewrite H3. simpl. apply Nat.lt_lt_succ_r. apply IHl2 with (A:=A) ; assumption.
      rewrite H3. simpl. apply Lt.lt_n_S. apply IHl2 with (A:=A) ; assumption.
Qed.

Lemma remove_list_delete_head : forall l1 l2 l3 A, remove_list (l1 ++ A :: l2) (A :: l3) = remove_list (l1 ++ A :: l2) l3.
Proof.
induction l1 ; intros ; simpl.
- rewrite permut_remove_remove_list. simpl. destruct (eq_dec_form A A). symmetry. apply permut_remove_remove_list.
  exfalso. apply n. reflexivity.
- rewrite IHl1. reflexivity.
Qed.

Lemma remove_list_delete_head_In : forall l1 l2 A, In A l1 -> remove_list l1 (A :: l2) = remove_list l1 l2.
Proof.
intros. pose (In_split A l1 H). destruct e. destruct H0. subst. apply remove_list_delete_head.
Qed.

Lemma remove_list_in_nil : forall l1 l2 l3 A,
        remove_list l1 (l2 ++ A :: l3) = nil ->
        (existsT2 l4 l5, l1 = l4 ++ A :: l5).
Proof.
induction l1.
- intros. simpl in H. destruct l2 ; inversion H.
- induction l2.
  * intros. simpl in H. rewrite permut_remove_remove_list in H. simpl in H. destruct (eq_dec_form a A).
    + subst. exists []. exists l1. auto.
    + pose (IHl1 [] (remove eq_dec_form a l3)). simpl in s. apply s in H. destruct H. destruct s0.
      exists ([a] ++ x). exists x0. subst. auto.
  * intros. simpl in H. rewrite permut_remove_remove_list in H. simpl in H. destruct (eq_dec_form a a0).
    + subst. pose (IHl2 l3 A). apply s. rewrite <- permut_remove_remove_list in H. simpl. assumption.
    + pose (IHl1 [] (remove eq_dec_form a (l2 ++ A :: l3)) a0). pose (s H). repeat destruct s0.
      subst. apply IHl2 with (l3:= l3). simpl. rewrite permut_remove_remove_list.
      rewrite remove_list_delete_head in H. assumption.
Qed.

Lemma remove_list_is_nil : forall l1 l2, (remove_list l1 l2 = nil <-> (forall A, (In A l2) -> (In A l1))).
Proof.
induction l1.
- intro l2. split.
  * intros. simpl in H. rewrite <- H. assumption.
  * intros. simpl. destruct l2.
    + reflexivity.
    + exfalso. pose (H m). assert (In m (m :: l2)). apply in_eq. apply i in H0. inversion H0.
- induction l2.
  * split.
    + intros. inversion H0.
    + intros. apply remove_list_of_nil.
  * split.
    + intros. simpl in H. rewrite permut_remove_remove_list in H. simpl in H. destruct (eq_dec_form a a0).
      subst. inversion H0. subst. apply in_eq. rewrite <- permut_remove_remove_list in H. simpl in IHl2.
      rewrite IHl2 in H. apply H in H1. destruct H1. subst. apply in_eq. apply in_cons. assumption.
      inversion H0. subst. apply in_cons. pose (remove_list_in_nil l1 [] (remove eq_dec_form a l2) A).
      simpl in s. apply s in H. destruct H. destruct s0. subst. apply in_or_app. right. apply in_eq.
      apply IHl2. 2: assumption. simpl. rewrite permut_remove_remove_list.
      pose (app_eq_nil (remove_list l1 [a0]) (remove_list l1 (remove eq_dec_form a l2))). simpl in a1.
      assert (H2: remove_list l1 [a0] ++ remove_list l1 (remove eq_dec_form a l2) = []).
      rewrite <- remove_list_dist_app. simpl. assumption. apply a1 in H2. destruct H2. assumption.
    + intros. simpl. rewrite permut_remove_remove_list. simpl. destruct (eq_dec_form a a0).
      { subst. rewrite <- permut_remove_remove_list. simpl in IHl2. rewrite IHl2. intros.
        pose (H A). apply i. apply in_cons. assumption. }
      { assert (H1: (forall A : MPropF, In A l2 -> In A (a :: l1))). intros. apply H.
        apply in_cons. assumption. apply IHl2 in H1.
        assert (H2: a0 :: remove eq_dec_form a l2 = [a0] ++ remove eq_dec_form a l2). auto.
        rewrite H2. rewrite remove_list_dist_app. clear H2. rewrite <- permut_remove_remove_list.
        simpl in H1. rewrite H1. rewrite app_nil_r. apply remove_list_in_single. pose (H a0).
        assert (H3: In a0 (a0 :: l2)). apply in_eq. apply i in H3. inversion H3. exfalso. apply n.
        assumption. assumption. }
Qed.

Lemma remove_delete_origin : forall l1 l2 (A B : MPropF), (A <> B) ->
            length (remove eq_dec_form A (l1 ++ B :: l2)) = S (length (remove eq_dec_form A (l1 ++ l2))).
Proof.
induction l1.
- intros. repeat rewrite app_nil_l. simpl. destruct (eq_dec_form A B). exfalso. apply H. assumption.
  simpl. reflexivity.
- intros. simpl. destruct (eq_dec_form A a).
  * apply IHl1. assumption.
  * simpl. apply eq_S. apply IHl1. assumption.
Qed.

Lemma keep_list_delete_head_not_origin : forall l1 l2 l3 A, ((In A l1) -> False) ->
                length (remove_list l1 (l2 ++ A :: l3)) = S (length (remove_list l1 (l2 ++ l3))).
Proof.
induction l1.
- intros. simpl. rewrite app_length. simpl. rewrite app_length. auto.
- intros. simpl. repeat rewrite remove_list_dist_app. assert (In A l1 -> False).
  intro. apply H. apply in_cons. assumption. assert (A :: l3 = [A] ++ l3).
  auto. rewrite H1. rewrite remove_list_dist_app. pose (remove_list_singl_id_or_nil l1 A).
  destruct o. exfalso. rewrite remove_list_is_nil in H2. apply H0. apply H2.
  apply in_eq. rewrite H2. apply remove_delete_origin. intro. apply H. subst. apply in_eq.
Qed.

Lemma keep_list_delete_head_not_In : forall l1 l2 A, ((In A l1) -> False) ->
                length (remove_list l1 (A :: l2)) = S (length (remove_list l1 l2)).
Proof.
intros. pose (@keep_list_delete_head_not_origin l1 [] l2 A H). repeat rewrite app_nil_l in e.
assumption.
Qed.

Lemma In_remove_In_list : forall (A B : MPropF) l, In A (remove eq_dec_form B l) -> In A l.
Proof.
induction l ; intros.
- simpl in H. destruct H.
- simpl in H. destruct (eq_dec_form B a).
  * subst. apply in_cons. apply IHl. assumption.
  * inversion H.
    + subst. apply in_eq.
    + apply in_cons. apply IHl. assumption.
Qed.

Lemma In_remove_list_In_list : forall (A : MPropF) l1 l2, In A (remove_list l1 l2) -> In A l2.
Proof.
intro A. induction l1 ; intros.
- simpl in H. assumption.
- simpl in H. apply In_remove_In_list in H. apply IHl1. assumption.
Qed.

Lemma In_remove_list_In_list_not_In_remove_list : forall (A : MPropF) l1 l2,
            In A (remove_list l1 l2) -> (In A l2 /\ ((In A l1) -> False)).
Proof.
intro A. induction l1 ; intros.
- simpl in H. split. assumption. intro. inversion H0.
- simpl in H. split. apply In_remove_In_list in H. apply IHl1. assumption. intro.
  inversion H0.
  * subst. apply remove_not_in_anymore in H. assumption.
  * apply In_remove_In_list in H. apply IHl1 in H. destruct H. apply H2. assumption.
Qed.

Lemma remove_list_incr_decr3 : forall (l3 l2 l1 : list MPropF),
              (incl l1 l2) ->
              length (remove_list l2 l3) <= length (remove_list l1 l3).
Proof.
induction l3 ; intros.
- repeat rewrite remove_list_of_nil. auto.
- destruct (In_dec l2 a).
  + rewrite remove_list_delete_head_In. 2: assumption. destruct (In_dec l1 a).
    * rewrite remove_list_delete_head_In. 2: assumption. apply IHl3 ; auto.
    * rewrite keep_list_delete_head_not_In. 2: assumption. apply Nat.le_le_succ_r.
      apply IHl3. assumption.
  + repeat rewrite keep_list_delete_head_not_In. apply le_n_S. apply IHl3 ; auto.
    intro. apply f. apply H. assumption. assumption.
Qed.

Lemma remove_list_incr_decr1 : forall (l3 l1 l2: list MPropF),
              (exists A, In A l2 /\ In A l3 /\ (In A l1 -> False)) ->
              (incl l1 l2) ->
              length (remove_list l2 l3) < length (remove_list l1 l3).
Proof.
induction l3.
- intros. destruct H. destruct H. destruct H1. exfalso. inversion H1.
- intros. destruct H. destruct H. destruct H1. destruct (eq_dec_form a x).
  * subst. rewrite remove_list_delete_head_In. 2: assumption.
    rewrite keep_list_delete_head_not_In. 2: assumption. unfold lt.
    apply le_n_S. apply remove_list_incr_decr3. assumption.
  * inversion H1. exfalso. apply n ; assumption.
    assert (H4: exists A : MPropF, In A l2 /\ In A l3 /\ (In A l1 -> False)).
    exists x. auto. apply IHl3 in H4. 2 : assumption. unfold lt.
    destruct (In_dec l2 a).
    + rewrite remove_list_delete_head_In. 2: assumption. destruct (In_dec l1 a).
      { rewrite remove_list_delete_head_In. 2: assumption. apply H4. }
      { rewrite keep_list_delete_head_not_In. 2: assumption. apply le_n_S.
        unfold lt in H4. apply Le.le_Sn_le. assumption. }
    + rewrite keep_list_delete_head_not_In. 2: assumption. rewrite keep_list_delete_head_not_In.
      unfold lt in H4. apply le_n_S. assumption. intro. apply f. apply H0. assumption.
Qed.

Lemma remove_list_incr_decr2 : forall (l4 l3 l1 : list MPropF),
              (NoDup l4) ->
              (NoDup l3) ->
              (incl l4 l3) ->
              length (remove_list l1 l4) <= length (remove_list l1 l3).
Proof.
induction l4.
- intros. rewrite remove_list_of_nil. simpl. apply le_0_n.
- intros. destruct (In_dec l1 a).
  * rewrite remove_list_delete_head_In. 2: assumption. apply IHl4 ; try assumption.
    inversion H. assumption. unfold incl. intros. apply H1. apply in_cons. assumption.
  * rewrite keep_list_delete_head_not_In. 2: assumption. assert (H2: In a l3). apply H1.
    apply in_eq. pose (in_split a l3 H2). repeat destruct e. destruct H3. rewrite H3.
    rewrite keep_list_delete_head_not_origin. 2: assumption. apply le_n_S. apply IHl4.
    inversion H. assumption. subst. apply NoDup_destr_split with (A:=a). assumption.
    inversion H. unfold incl. intros. subst. assert (H9 : In a0 (a :: l4)). apply in_cons.
    assumption. pose (H1 a0 H9). apply in_app_or in i. destruct i. apply in_or_app. left.
    assumption. inversion H3. subst. exfalso. apply H6. assumption. apply in_or_app. right.
    assumption.
Qed.

Lemma remove_list_incr_decr4 : forall (l4 l3 l1: list MPropF),
              (NoDup l4) ->
              (NoDup l3) ->
              (incl l4 l3) ->
              ((incl l3 l4) -> False) ->
              (exists A, (In A l3) /\ ((In A l1) -> False) /\ ((In A l4) -> False)) ->
              length (remove_list l1 l4) < length (remove_list l1 l3).
Proof.
induction l4.
- intros. rewrite remove_list_of_nil. simpl. destruct H3. destruct H3. destruct H4. pose (In_split x l3 H3).
  destruct e. destruct H6. subst. rewrite keep_list_delete_head_not_origin. 2: assumption.
  apply Nat.lt_0_succ.
- intros. destruct (In_dec l1 a).
  * rewrite remove_list_delete_head_In. 2: assumption. apply IHl4 ; try assumption.
    inversion H. assumption. unfold incl. intros. apply H1. apply in_cons. assumption.
    intro. apply H2. unfold incl. intros. apply in_cons. apply H4. assumption. destruct H3.
    destruct H3. destruct H4. exists x. repeat split ; try assumption. intro. apply H5.
    apply in_cons. assumption.
  * rewrite keep_list_delete_head_not_In. 2: assumption. assert (In a l3). apply H1.
    apply in_eq. pose (In_split a l3 H4). destruct e. destruct H5. subst.
    rewrite keep_list_delete_head_not_origin. 2 : assumption. apply Lt.lt_n_S.
    apply IHl4. inversion H. assumption. apply NoDup_destr_split with (A:=a). assumption.
    unfold incl. intros. pose (H1 a0). assert (In a0 (a :: l4)). apply in_cons. assumption.
    apply i in H6. apply in_app_or in H6. destruct H6. apply in_or_app. left. assumption.
    inversion H6. subst. inversion H. exfalso. apply H9. assumption. apply in_or_app. right.
    assumption. intro. apply H2. unfold incl. intros. apply in_app_or in H6. destruct H6.
    apply in_cons. apply H5. apply in_or_app. left. assumption. inversion H6. subst. apply in_eq.
    apply in_cons. apply H5. apply in_or_app. right. assumption.
    destruct H3. destruct H3. destruct H5. exists x1. repeat split ; try assumption.
    apply in_app_or in H3. destruct H3. apply in_or_app. left. assumption. inversion H3.
    subst. exfalso. apply H6. apply in_eq. apply in_or_app. right. assumption.
    intro. apply H6. apply in_cons. assumption.
Qed.

Lemma remove_list_incr_decr : forall (l1 l2 l3 l4 : list MPropF),
              (NoDup l4) ->
              (NoDup l3) ->
              (exists A, In A l2 /\ In A l3 /\ (In A l1 -> False)) ->
              (incl l1 l2) ->
              (incl l4 l3) ->
              length (remove_list l2 l4) < length (remove_list l1 l3).
Proof.
intros. unfold lt.
pose (remove_list_incr_decr2 l1 H H0 H3).
repeat destruct H1. destruct H4. destruct (In_dec l4 x).
- assert (H6: (exists A, In A l2 /\ In A l4 /\ (In A l1 -> False))).
  exists x. repeat split ; assumption. pose (@remove_list_incr_decr1 l4 l1 l2 H6 H2).
  unfold lt in l0. apply Nat.le_trans with (m:=length (remove_list l1 l4)) ; assumption.
- assert ((incl l3 l4) -> False). intros. apply f. apply H6. assumption.
  assert ((exists A, (In A l3) /\ ((In A l1) -> False) /\ ((In A l4) -> False))). exists x. auto.
  pose (@remove_list_incr_decr3 l4 l2 l1 H2). pose (@remove_list_incr_decr4 l4 l3 l1 H H0 H3 H6 H7).
  unfold lt in l5. apply le_n_S in l0.
  apply Nat.le_trans with (m:=S (length (remove_list l1 l4))) ; assumption.
Qed.

Lemma In_remove_list_remove_redund : forall l1 l2 a, In a l1 ->
                remove eq_dec_form a (remove_list l1 l2) = remove_list l1 l2.
Proof.
induction l1.
- intros. inversion H.
- intros. simpl. inversion H.
  * subst. rewrite double_remove. reflexivity.
  * pose (IHl1 l2 a0 H0). rewrite permut_remove. rewrite e. reflexivity.
Qed.

Lemma In_matters_remove_list : forall l1 l2, (incl l1 l2 /\ incl l2 l1) -> (forall l0,
                                    remove_list l1 l0 = remove_list l2 l0).
Proof.
induction l1.
- intros. destruct H. destruct l2. auto. unfold incl in H0. pose (H0 m). assert (In m (m :: l2)).
  apply in_eq. apply i in H1. inversion H1.
- intros. destruct H. simpl. pose (H a). assert (In a (a :: l1)). apply in_eq. apply i in H1.
  apply in_split in H1. destruct H1. destruct H1. subst. destruct (In_dec l1 a).
  * rewrite In_remove_list_remove_redund. 2: assumption. apply IHl1. split. intro. intro.
    apply H. apply in_cons. assumption. intro. intro. apply H0 in H1. inversion H1. subst.
    assumption. assumption.
  * rewrite swap_remove_list. simpl. rewrite <- redund_remove_remove_list with (l1:=(x0 ++ x)).
    pose (IHl1 (remove eq_dec_form a (x0 ++ x))). rewrite e.
    auto. split. intro. intro. apply in_not_touched_remove. assert (In a0 (a :: l1)). apply in_cons.
    assumption. apply H in H2. apply in_app_or in H2. destruct H2. apply in_or_app. right. assumption.
    inversion H2. subst. exfalso. apply f. assumption. apply in_or_app. left. assumption.
    intro. subst. apply f. assumption. intro. intro. pose (In_remove_diff (x0 ++ x) H1).
    pose (In_remove_In_list a0 a (x0 ++ x) H1). assert (In a0 (x ++ a :: x0)). apply in_app_or in i0.
    destruct i0. apply in_or_app. right. apply in_cons. assumption. apply in_or_app. left. assumption.
    apply H0 in H2. inversion H2. exfalso. apply n. symmetry. assumption. assumption.
Qed.


Require Import Coq.Bool.Bool.
Require Import Coq.Classes.RelationClasses.
Require Coq.Setoids.Setoid.

Set Implicit Arguments.
Set Strict Implicit.

Class RelDec (T : Type) (equ : T -> T -> Prop) : Type :=
{ rel_dec : T -> T -> bool }.

Arguments rel_dec {_} {equ} {_} _ _.
Arguments rel_dec _ _ _ !x !y.

Class RelDec_Correct T (equ : T -> T -> Prop) (ED : RelDec equ) : Prop :=
{ rel_dec_correct : forall x y : T, rel_dec x y = true <-> equ x y }.

Notation "a ?[ r  ]  b" := (@rel_dec _ r _ a b) (at level 30, b at next level).

Definition eq_dec {T : Type} {ED : RelDec (@eq T)} := rel_dec.

Section neg_rel_dec_correct.
  Context {T} {R:T -> T -> Prop} {RD:RelDec R} {RDC:RelDec_Correct RD}.

  Definition neg_rel_dec_correct : forall {x y}, ~R x y <-> rel_dec x y = false.
  Proof. intros x y. destruct (bool_dec (rel_dec x y) true) ; constructor ; intros ;
    repeat
      match goal with
      | [ |- ~ _ ] => unfold not ; intros
      | [ H1 : ?P, H2 : ~?P |- _ ] => specialize (H2 H1) ; contradiction
      | [ H1 : ?P = true, H2 : ?P = false |- _ ] => rewrite H1 in H2 ; discriminate
      | [ H1 : ?P <> true |- ?P = false ] => apply not_true_is_false ; exact H1
      | [ H1 : ?rel_dec ?a ?b = true, H2 : ~?R ?a ?b |- _ ] =>
          apply rel_dec_correct in H1
      | [ H1 : ?rel_dec ?a ?b = false, H2 : ?R ?a ?b |- _ ] =>
          apply rel_dec_correct in H2
      end.
  Qed.
End neg_rel_dec_correct.

Section rel_dec_p.
  Context {T} {R:T -> T -> Prop} {RD:RelDec R} {RDC:RelDec_Correct RD}.

  Definition rel_dec_p (x:T) (y:T) : {R x y} + {~R x y}.
  Proof. destruct (bool_dec (rel_dec x y) true) as [H | H].
    apply rel_dec_correct in H ; eauto.
    apply not_true_is_false in H ; apply neg_rel_dec_correct in H ; eauto.
  Qed.

  Definition neg_rel_dec_p (x:T) (y:T) : {~R x y} + {R x y}.
  Proof. destruct (rel_dec_p x y) ; [ right | left ] ; auto. Qed.
End rel_dec_p.

Section lemmas.
  Variable T : Type.
  Variable eqt : T -> T -> Prop.
  Variable r : RelDec eqt.
  Variable rc : RelDec_Correct r.

  Theorem rel_dec_eq_true : forall x y,
    eqt x y -> rel_dec x y = true.
  Proof.
    intros. eapply rel_dec_correct in H. assumption.
  Qed.

  Theorem rel_dec_neq_false : forall x y,
    ~eqt x y -> rel_dec x y = false.
  Proof.
    intros. remember (x ?[ eqt ] y).
    symmetry in Heqb.
    destruct b; try reflexivity.
    exfalso. eapply (@rel_dec_correct _ _ _ rc) in Heqb. auto.
  Qed.

  Theorem rel_dec_sym : Symmetric eqt -> forall x y,
    x ?[ eqt ] y = y ?[ eqt ] x.
  Proof.
    intros.
    remember (x ?[ eqt ] y); remember (y ?[ eqt ] x); intuition.
    destruct b; destruct b0; auto.
    { symmetry in Heqb; symmetry in Heqb0.
      eapply (@rel_dec_correct _ _ _ rc) in Heqb.
      symmetry in Heqb.
      eapply (@rel_dec_correct _ _ _ rc) in Heqb.
      congruence. }
    { symmetry in Heqb; symmetry in Heqb0.
      eapply (@rel_dec_correct _ _ _ rc) in Heqb0.
      symmetry in Heqb0.
      eapply (@rel_dec_correct _ _ _ rc) in Heqb0.
      congruence. }
  Qed.
End lemmas.

Section RelDec_from_dec.
  Context {T} (R : T -> T -> Prop).
  Variable (f : forall a b : T, {R a b} + {~R a b}).
  Definition RelDec_from_dec
  : RelDec R :=
  {| rel_dec := fun a b =>
                  match f a b with
                  | left _ => true
                  | right _ => false
                  end |}.

  Global Instance RelDec_Correct_eq_typ : RelDec_Correct RelDec_from_dec.
  Proof.
    constructor.
    intros.
    unfold rel_dec; simpl.
    destruct (f x y).
    - tauto.
    - split.
      + inversion 1.
      + intro. apply n in H. tauto.
  Qed.
End RelDec_from_dec.

(*
Section SumEq.
  Variable T : Type.
  Variable U : Type.

  Variable EDT : RelDec (@eq T).
  Variable EDU : RelDec (@eq U).

  (** Specialization for equality **)
  Global Instance RelDec_eq_sum : RelDec (@eq (T + U)) :=
  { rel_dec := fun x y =>
    match x , y with
      | inl x , inl y => eq_dec x y
      | inr x , inr y => eq_dec x y
      | _ , _ => false
    end }.

  Variable EDCT : RelDec_Correct EDT.
  Variable EDCU : RelDec_Correct EDU.

  Global Instance RelDec_Correct_eq_sum : RelDec_Correct RelDec_eq_sum.
  Proof.
    constructor; destruct x; destruct y; split; simpl in *; intros; try congruence;
      f_equal; try match goal with
                     | [ H : context [ eq_dec ?X ?Y ] |- _ ] =>
                       consider (eq_dec X Y)
                     | [ |- context [ eq_dec ?X ?Y ] ] =>
                       consider (eq_dec X Y)
                   end; auto; congruence.
  Qed.

End SumEq.
*)


Require Import Crypto.Arithmetic.PrimeFieldTheorems.
Require Import Crypto.Specific.solinas32_2e384m2e128m2e96p2e32m1_18limbs.Synthesis.

(* TODO : change this to field once field isomorphism happens *)
Definition carry :
  { carry : feBW_loose -> feBW_tight
  | forall a, phiBW_tight (carry a) = (phiBW_loose a) }.
Proof.
  Set Ltac Profiling.
  Time synthesize_carry ().
  Show Ltac Profile.
Time Defined.

Print Assumptions carry.


Require Import prosa.classic.util.all.
Require Import prosa.classic.model.arrival.basic.arrival_sequence prosa.classic.model.arrival.basic.task prosa.classic.model.arrival.basic.task_arrival prosa.classic.model.arrival.basic.job.
Require Import prosa.classic.implementation.uni.jitter.task
               prosa.classic.implementation.uni.jitter.job.
From mathcomp Require Import ssreflect ssrbool ssrfun ssrnat eqtype seq div.

Module ConcreteArrivalSequence.

  Import Job ArrivalSequence ConcreteTask ConcreteJob SporadicTaskset TaskArrival.

  Section PeriodicArrivals.

    Variable ts: concrete_taskset.

    (* At any time t, we release Some job of tsk if t is a multiple of the period,
       otherwise we release None. *)
    Definition add_job (arr_time: time) (tsk: concrete_task) :=
      if task_period tsk %| arr_time  then
        Some (Build_concrete_job (arr_time %/ task_period tsk) arr_time
                                 (task_cost tsk) (task_deadline tsk) tsk)
      else
        None.

    (* The arrival sequence at any time t is simply the partial map of add_job. *)
    Definition periodic_arrival_sequence (t: time) := pmap (add_job t) ts.

  End PeriodicArrivals.

  Section Proofs.

    (* Let ts be any concrete task set with valid parameters. *)
    Variable ts: concrete_taskset.

    (* Regarding the periodic arrival sequence built from ts, we prove that...*)
    Let arr_seq := periodic_arrival_sequence ts.

    (* ... arrival times are consistent, ... *)
    Theorem periodic_arrivals_are_consistent:
      arrival_times_are_consistent job_arrival arr_seq.
    Proof.
      move => j t ARRj.
      rewrite /arrives_at mem_pmap in ARRj.
      move: ARRj => /mapP ARRj; destruct ARRj as [tsk IN SOME].
      by unfold add_job in *; desf.
    Qed.

    (* ... every job comes from the task set, ... *)
    Theorem periodic_arrivals_all_jobs_from_taskset:
      forall j,
        arrives_in arr_seq j ->
        job_task j \in ts.
    Proof.
      move => j [t ARRj].
      rewrite mem_pmap in ARRj.
      move: ARRj => /mapP ARRj; destruct ARRj as [tsk IN SOME].
      by unfold add_job in *; desf.
    Qed.

    (* ... job arrivals satisfy the sporadic task model, ... *)
    Theorem periodic_arrivals_are_sporadic:
      sporadic_task_model task_period job_arrival job_task arr_seq.
    Proof.
      move => j j' /eqP DIFF [arr ARR] [arr' ARR'] SAMEtsk LE.
      rewrite eqE /= /job_eqdef negb_and /= SAMEtsk eq_refl orbF in DIFF.
      rewrite 2!mem_pmap in ARR ARR'.
      move: ARR ARR' => /mapP [tsk_j INj SOMEj] /mapP [tsk_j' INj' SOMEj'].
      unfold add_job in SOMEj, SOMEj'; desf; simpl in *;
      move: Heq0 Heq => /dvdnP [k DIV] /dvdnP [k' DIV'].
      {
        rewrite DIV DIV' -mulSnr.
        rewrite leq_eqVlt in LE; move: LE => /orP [/eqP EQ | LESS].
        {
          exfalso; move: DIFF => /negP DIFF; apply DIFF.
          by subst; rewrite EQ !eq_refl.
        }
        subst; rewrite leq_mul2r; apply/orP; right.
        by rewrite ltn_mul2r in LESS; move: LESS => /andP [_ LT].
      }
    Qed.

    (* ... and the arrival sequence has no duplicate jobs. *)
    Theorem periodic_arrivals_is_a_set:
      arrival_sequence_is_a_set arr_seq.
    Proof.
      intros t.
      unfold arr_seq, periodic_arrival_sequence.
      apply (pmap_uniq) with (g := job_task); last by destruct ts.
      by unfold add_job, ocancel; intro tsk; desf.
    Qed.

    (* We also show that job costs are bounded by task costs... *)
    Theorem periodic_arrivals_job_cost_le_task_cost:
      forall j,
        arrives_in arr_seq j ->
        job_cost j <= task_cost (job_task j).
    Proof.
      intros j [t ARRj].
      rewrite mem_pmap in ARRj.
      move: ARRj => /mapP [tsk_j INj SOMEj].
      by unfold add_job in SOMEj; desf.
    Qed.

    (* ...and that job deadlines equal task deadlines. *)
    Theorem periodic_arrivals_job_deadline_eq_task_deadline:
      forall j,
        arrives_in arr_seq j ->
        job_deadline j = task_deadline (job_task j).
    Proof.
      intros j [t ARRj].
      rewrite mem_pmap in ARRj.
      move: ARRj => /mapP [tsk_j INj SOMEj].
      by unfold add_job in SOMEj; desf.
    Qed.

  End Proofs.

End ConcreteArrivalSequence.


Require Import Coq.Numbers.BinNums.
Require Import Coq.Classes.Morphisms.
Require Import Crypto.Spec.WeierstrassCurve Crypto.Curves.Weierstrass.Affine.
Require Import Crypto.Algebra.Field Crypto.Algebra.Hierarchy.
Require Import Crypto.Util.Decidable Crypto.Util.Tactics.DestructHead Crypto.Util.Tactics.BreakMatch.
Require Import Coq.PArith.BinPos.

Module W.
  Section W.
    Context {F Feq Fzero Fone Fopp Fadd Fsub Fmul Finv Fdiv} {a b:F}
            {field:@Algebra.Hierarchy.field F Feq Fzero Fone Fopp Fadd Fsub Fmul Finv Fdiv}
            {Feq_dec:DecidableRel Feq}.
    Local Infix "=" := Feq : type_scope. Local Notation "a <> b" := (not (a = b)) : type_scope.
    Local Notation "0" := Fzero.  Local Notation "1" := Fone.
    Local Infix "+" := Fadd. Local Infix "-" := Fsub. Local Infix "*" := Fmul.
    Local Notation "4" := (1+1+1+1). Local Notation "27" := (4*4 + 4+4 +1+1+1).

    Local Ltac Algebra_split :=
      repeat match goal with
             | |- Proper _ _ => cbv [Proper respectful]; intros
             | |- Equivalence _ => split; [intros ? | intros ??? | intros ????? ]
             | |- monoid => split
             | |- group => split
             | |- commutative_group => split
             | |- is_associative => split; intros ???
             | |- is_commutative => split; intros ??
             | |- is_left_inverse => split; intros ?
             | |- is_right_inverse => split; intros ?
             | |- is_left_identity => split; intros ?
             | |- is_right_identity => split; intros ?
             end.

    Global Instance commutative_group
           char_ge_3
           {char_ge_12:@Ring.char_ge F Feq Fzero Fone Fopp Fadd Fsub Fmul 12%positive} (* FIXME: shouldn't need we need 4, not 12? *)
           {discriminant_nonzero:id(4*a*a*a + 27*b*b <> 0)}
      : commutative_group(eq:=W.eq(a:=a)(b:=b))(op:=W.add(char_ge_3:=char_ge_3))(id:=W.zero)(inv:=W.opp).
    Proof using Type.
      Time
        cbv [W.opp W.eq W.zero W.add W.coordinates proj1_sig];
          repeat match goal with
                 | _ => progress Algebra_split
                 | H: _ /\ _ |- _ => destruct H
                 | |- _ /\ _ => split
                 | _ => progress break_match
                 | _ => progress break_match_hyps
                 end; try contradiction; trivial.
      Time par: abstract (fsatz || (cbv [id] in *; fsatz)).
    Time Qed.
  End W.
End W.


Require Export SystemFR.Syntax.
Require Export SystemFR.WFLemmas.
Require Import Coq.Lists.List.
Import ListNotations.
Open Scope bool_scope.

(* Decidable equality for trees *)
Definition fv_tag_dec : forall (x y : fv_tag), {x = y} + {x <> y}.
Proof.
  intros.
  destruct x, y; try solve [(left; reflexivity) || (right; congruence)].
Defined.

Definition tree_eq_dec : forall (x y : tree), {x = y} + {x <> y}.
Proof.
  repeat decide equality || apply fv_tag_dec.
Defined.
Definition tree_eq t1 t2 : bool := if (tree_eq_dec t1 t2) then true else false.

Lemma tree_eq_prop : forall t1 t2, (tree_eq t1 t2 = true) <-> t1 = t2.
Proof.
  unfold tree_eq.
  steps.
Qed.

Definition mod_tree_eq a b t1 t2 :=
  exists C, t1 = open 0 C a /\ t2 = open 0 C b.

(* If t and t' are equal modulo substitutions of a for b, it returns true
 *)
Fixpoint mod_tree_eqb t1 t2 a b : bool :=
  if (tree_eq t1 t2) then true
  else
    if (tree_eq t1 a && tree_eq t2 b) then true
    else
      match (t1, t2) with
      | (err T1, err T2) => mod_tree_eqb T1 T2 a b
      | (tsize t1, tsize t2) => mod_tree_eqb t1 t2 a b

      | (notype_lambda t1, notype_lambda t2) => mod_tree_eqb t1 t2 a b
      | (lambda T1 t1, lambda T2 t2) => (mod_tree_eqb T1 T2 a b) && (mod_tree_eqb t1 t2 a b)

      | ((pp t11 t12), (pp t21 t22)) => (mod_tree_eqb t11 t21 a b) && (mod_tree_eqb t12 t22 a b)
      | _ => false
      end
.

Lemma mod_tree_eqb_correct :
  forall a b t2 t1,
    wf t1 0 ->
    wf t2 0 ->
    mod_tree_eqb t1 t2 a b = true ->
    mod_tree_eq t1 t2 a b.
Proof.
  unfold mod_tree_eq; intros.
  unfold mod_tree_eqb in H1.
Abort.


(* -*- coq-prog-args: ("-emacs-U" "-R" "." "FingerTree" "-R" "../safe" " "-R" "../monads" ") -*- *)
Require Import Coq.subtac.Utils.
Require Import Coq.Lists.List.
Require Import Monoid.
Set Implicit Arguments.

Section ListMonoid.
  Variable A : Type.

  Program Definition listMonoid := @mkMonoid (list A) nil (@app A) _ _ _.

  Next Obligation.
  Proof.
    intros.
    red ; intros.
    rewrite app_nil_end ; reflexivity.
  Qed.

  Next Obligation.
  Proof.
    intros.
    red ; intros.
    apply app_ass.
  Qed.

End ListMonoid.


Require Import Coq.Lists.List.
Require Import Coq.Setoids.Setoid.
Require Import Coq.Lists.SetoidList.
Require Import Rewriter.Util.Option.

Import ListNotations.

Lemma list_elementwise_eqlistA : forall {T R} (l1 l2 : list T),
  (forall i, option_eq R (nth_error l1 i) (nth_error l2 i)) -> eqlistA R l1 l2.
Proof.
  induction l1, l2; intros H; try solve [ constructor ];
    pose proof (H 0%nat) as Hfirst; cbn in Hfirst; try solve [ inversion Hfirst ].
  constructor; [ assumption | ].
  apply IHl1.
  intros i; specialize (H (S i)).
  assumption.
Qed.

Lemma nth_error_Proper_eqlistA {T R}
  : Proper (eqlistA R ==> eq ==> option_eq R) (@nth_error T).
Proof.
  intros ls1 ls2 Hls n n' ?; subst n'.
  revert ls1 ls2 Hls.
  induction n; intros ls1 ls2 Hls; destruct Hls; cbn; auto.
Qed.

Lemma eqlistA_eq_iff {A}
  : forall ls1 ls2, eqlistA (@eq A) ls1 ls2 <-> ls1 = ls2.
Proof.
  induction ls1 as [|x xs IHxs], ls2 as [|y ys].
  all: split; intro H; inversion_clear H; repeat constructor; subst; f_equal; try reflexivity.
  apply IHxs; assumption.
Qed.

Lemma InA_map A B (f : A -> B) (eqA eqB : relation _) a b l
      (f_Proper_a_b : forall v, eqA a v -> eqB b (f v))
  : InA eqA a l -> InA eqB b (List.map f l).
Proof.
  rewrite !InA_alt.
  intros [v H]; exists (f v); split; [ now apply f_Proper_a_b | now apply in_map ].
Qed.

Lemma InA_map_iff A B (f : A -> B) (eqA eqB : relation _) a b l
      (f_Proper_a_b : forall v, eqA a v <-> eqB b (f v))
  : InA eqB b (List.map f l) <-> InA eqA a l.
Proof.
  split; [ | solve [ apply InA_map, f_Proper_a_b ] ].
  rewrite !InA_alt; intros [v [H1 H2]].
  induction l as [|? ? IH]; cbn [List.map List.In] in *;
    [ easy | ].
  destruct H2; subst; firstorder eauto.
Qed.

Lemma NoDupA_map_inv A B (f : A -> B) (eqA eqB : relation _) (l : list A)
      {f_Proper : Proper (eqA ==> eqB) f}
  : NoDupA eqB (List.map f l) -> NoDupA eqA l.
Proof.
  induction l as [|? ? IH]; cbn [List.map]; intro H; inversion_clear H;
    [ constructor | ].
  specialize (IH ltac:(assumption)).
  constructor; [ | assumption ].
  let H := match goal with H : ~ InA _ _ _ |- _ => H end in
  intro H'; apply H; clear H.
  eapply InA_map; [ | eassumption ].
  intro; apply f_Proper.
Qed.

Global Instance InA_Proper_impl {A} {eqA : relation A}
       {eqA_Proper : Proper (eqA ==> eqA ==> Basics.impl) eqA}
  : Proper (eqA ==> eqlistA eqA ==> Basics.impl) (@InA A eqA) | 10.
Proof.
  cbv [Basics.impl] in *.
  intros a a' Ha l l' Hl.
  induction Hl as [|?????? IH].
  { intro H'; inversion H'. }
  { intro H'; inversion_clear H';
      try solve [ constructor; eapply eqA_Proper; eassumption
                | constructor; eauto ]. }
Qed.

Global Instance InA_Proper_flip_impl {A} {eqA : relation A}
       {eqA_Proper : Proper (eqA ==> eqA ==> Basics.flip Basics.impl) eqA}
  : Proper (eqA ==> eqlistA eqA ==> Basics.flip Basics.impl) (@InA A eqA) | 10.
Proof.
  cbv [Basics.impl] in *.
  intros a a' Ha l l' Hl.
  induction Hl as [|?????? IH].
  { intro H'; inversion H'. }
  { intro H'; inversion_clear H';
      try solve [ constructor; eapply eqA_Proper; eassumption
                | constructor; eauto ]. }
Qed.

(** We could just use [now typeclasses eauto with core] in Coq >= 8.10, but it doesn't work in 8.9 :-( *)
Local Ltac grepeat_eapply :=
  multimatch goal with
  | [ H : _ |- _ ] => eapply H; clear H
  end;
  solve [ grepeat_eapply ].

Global Instance InA_Proper_iff {A} {eqA : relation A}
       {eqA_Proper : Proper (eqA ==> eqA ==> iff) eqA}
  : Proper (eqA ==> eqlistA eqA ==> iff) (@InA A eqA) | 10.
Proof.
  unshelve (split; (eapply InA_Proper_impl + eapply InA_Proper_flip_impl); assumption).
  all: repeat intro; solve [ edestruct eqA_Proper; grepeat_eapply ].
Qed.

Global Instance NoDupA_Proper_eqlistA_impl {A eqA}
       {eqA_Proper : Proper (eqA ==> eqA ==> flip impl) eqA}
  : Proper (eqlistA eqA ==> impl) (@NoDupA A eqA) | 10.
Proof.
  cbv [flip impl].
  intros l1 l2 Hl.
  induction Hl as [|? ? ? ? ? ? IH].
  { constructor. }
  { intro H'; inversion_clear H'; constructor; eauto.
    all: match goal with
         | [ H : ~InA _ _ _ |- ~ InA _ _ _ ] => intro H'; apply H; clear H
         end.
    eapply InA_Proper_flip_impl; eassumption. }
Qed.

Global Instance NoDupA_Proper_eqlistA_flip_impl {A eqA}
       {eqA_Proper : Proper (eqA ==> eqA ==> impl) eqA}
  : Proper (eqlistA eqA ==> flip impl) (@NoDupA A eqA) | 10.
Proof.
  cbv [flip impl].
  intros l1 l2 Hl.
  induction Hl as [|? ? ? ? ? ? IH].
  { constructor. }
  { intro H'; inversion_clear H'; constructor; eauto.
    all: match goal with
         | [ H : ~InA _ _ _ |- ~ InA _ _ _ ] => intro H'; apply H; clear H
         end.
    eapply InA_Proper_impl; eassumption. }
Qed.

Global Instance NoDupA_Proper_eqlistA_iff {A eqA}
       {eqA_Proper : Proper (eqA ==> eqA ==> iff) eqA}
  : Proper (eqlistA eqA ==> iff) (@NoDupA A eqA) | 10.
Proof.
  unshelve (split; (eapply NoDupA_Proper_eqlistA_impl + eapply NoDupA_Proper_eqlistA_flip_impl); assumption).
  all: repeat intro; solve [ edestruct eqA_Proper; grepeat_eapply ].
Qed.


Require Import Coq.Init.Datatypes.
Require Import Coq.Lists.List.
Import ListNotations.

Module Nondeterminism.
  Record t (A : Type) := mk { ahead : list A;
                                       behind : list A;
                                       default : A; }.

  Definition Decider {A : Type} (s : t A) : (t A * A) :=
    match ahead A s with
      [] => let rev_behind := List.rev (behind A s) in
            match rev_behind with
              [] => (mk A [] [] (default A s), default A s)
            | h::t => (mk A t (h::[]) (default A s), h)
            end
    | h::t => (mk A t (h::(behind A s)) (default A s), h)
    end.

  Definition init {A : Type} (pattern : list A) (default_val : A)
    : t A :=
    mk A pattern [] default_val.

  Fixpoint ToListN {A : Type} (s : t A) (n : nat) : list A :=
    match n with
    | 0 => []
    | S p =>
        let '(s, a) := Decider s in
        a :: (ToListN s p)
    end.

  Example test_repeats
    : ToListN (init [1; 2; 3] 4) 7 = [1; 2; 3; 1; 2; 3; 1].
  Proof.
    simpl.
    reflexivity.
  Qed.

  Example test_defaults : ToListN (init [] 4) 3 = [4; 4; 4].
  Proof.
    simpl.
    reflexivity.
  Qed.
End Nondeterminism.

Module Countdown.
  Record t :=
    mk { starting : nat; current : nat }.

  Definition init (starting_val : nat) : t :=
    {| starting := starting_val;
      current := starting_val |}.

  Definition reset (countdown : t) : t :=
    init (starting countdown).

  Definition decrement
    (countdown : t) (decrement_val : nat) : t :=
    {| starting := starting countdown;
      current := (current countdown) - decrement_val |}.

  Search (nat -> nat -> bool).

  Definition at_zero
    (countdown : t)
    : bool :=
    Nat.eqb (current countdown) 0.

  Example test_init1 : at_zero (init 0) = true.
  Proof.
    simpl.
    reflexivity.
  Qed.

  Example test_init2 : at_zero (init 1) = false.
  Proof.
    simpl.
    reflexivity.
  Qed.

  Example test_decr1 : forall x y : nat, x - y = 0 -> at_zero (decrement (init x) y) = true.
  Proof.
    intros x y H.
    unfold init.
    unfold decrement.
    unfold at_zero.
    unfold current.
    rewrite H.
    simpl.
    reflexivity.
  Qed.

  Example test_decr2 : at_zero (decrement (init 5) 3) = false.
  Proof.
    simpl.
    reflexivity.
  Qed.

  Example test_decr3 : at_zero (decrement (decrement (init 5) 3) 3) = true.
  Proof.
    simpl.
    reflexivity.
  Qed.

  Example test_reset : at_zero (decrement (reset (decrement (init 5) 3)) 3) = false.
  Proof.
    simpl.
    reflexivity.
  Qed.
End Countdown.

Module Name.
  Inductive t :=
    Sender
  | Receiver.

  Definition eq_dec : forall x y : t, {x = y} + {x <> y}.
    decide equality.
  Defined.
End Name.

Module Seq.
  Inductive t :=
    Zero
  | One.
  Definition eq_dec : forall x y : t, {x = y} + {x <> y}.
    decide equality.
  Defined.

  Definition flip (t : t) :=
    match t with
    | Zero => One
    | One => Zero
    end.

  Definition eq (a b : t) :=
    match (a, b) with
    | (Zero, Zero) | (One, One) => true
    | (_, _) => false
    end.
End Seq.

Module Packet.
  Definition t := nat.
  Definition eq_dec : forall x y : t, {x = y} + {x <> y}.
    decide equality.
  Defined.
End Packet.

Module Msg.
  Inductive t : Type :=
    Send : Packet.t -> Seq.t -> t
  | Ack : Seq.t -> t.
  Definition eq_dec : forall x y : t, {x = y} + {x <> y}.
    decide equality.
    - (* Seq *)
      apply Seq.eq_dec.
    - (* Packet *)
      apply Packet.eq_dec.
    - (* Seq *)
      apply Seq.eq_dec.
  Defined.
End Msg.

Module SendOrDrop.
  Inductive t :=
  | Send
  | Drop.
  Definition eq_dec
    : forall x y : t, {x = y} + {x <> y}.
    decide equality.
  Defined.
End SendOrDrop.

Module Input.
  Module ToSender.
    Inductive t : Type :=
      Packet : Packet.t -> t.
    Definition eq_dec
      : forall x y : t, {x = y} + {x <> y}.
      decide equality.
      - (* UserToSender *)
        apply Packet.eq_dec.
    Defined.
  End ToSender.

  Module ToReceiver.
    Inductive t : Type := .
    Definition eq_dec
      : forall x y : t, {x = y} + {x <> y}.
      decide equality.
    Defined.
  End ToReceiver.

  Module ToNetwork.
    Inductive t := .
    Definition eq_dec
      : forall x y : t, {x = y} + {x <> y}.
      decide equality.
    Defined.
  End ToNetwork.

  Inductive t :=
    Sender : ToSender.t -> t
  | Receiver : ToReceiver.t -> t
  | Network : ToNetwork.t -> t
  | Poll : t.
  Definition eq_dec : forall x y : t, {x = y} + {x <> y}.
    decide equality.
    - (* Sender *)
      apply ToSender.eq_dec.
    - (* Receiver *)
      apply ToReceiver.eq_dec.
    - (* Network *)
      apply ToNetwork.eq_dec.
  Defined.

  Definition packet (n : nat) :=
    Sender (ToSender.Packet n).

End Input.

Module Output.
  Module FromSender.
    Inductive t :=
      Reject : Packet.t -> t.
    Definition eq_dec : forall x y : t, {x = y} + {x <> y}.
      decide equality.
      - (* Packet *)
        apply Packet.eq_dec.
    Defined.
  End FromSender.

  Module FromReceiver.
    Inductive t :=
      Success : Packet.t -> t.
    Definition eq_dec : forall x y : t, {x = y} + {x <> y}.
      decide equality.
      - (* Packet *)
        apply Packet.eq_dec.
    Defined.
  End FromReceiver.

  Inductive t :=
    SenderOutput : FromSender.t -> t
  | ReceiverOutput : FromReceiver.t -> t.
  (*| Debug : -> t.*)
  Definition eq_dec : forall x y : t, {x = y} + {x <> y}.
    decide equality.
    - (* FromSender *)
      apply FromSender.eq_dec.
    - (* FromReceiver *)
      apply FromReceiver.eq_dec.
  Defined.
End Output.

Module State.
  Module Sender.
    Record t
      := mk { sent_unacked : option Packet.t;
              timeout : Countdown.t;
              seq : Seq.t;
              outgoing : list Msg.t}.

    Definition init (timeout_val : nat) : t :=
      mk None (Countdown.init timeout_val) Seq.Zero [].

    Definition append_outgoing
      (sender : t) (additional_outgoing : list Msg.t)
      : t :=
      {| sent_unacked := sent_unacked sender;
        timeout := timeout sender;
        seq := seq sender;
        outgoing := (outgoing sender) ++ additional_outgoing |}.

    Definition set_sent_unacked_reset_timer
      (sender : t) (packet : Packet.t)
      : t :=
      {| sent_unacked := Some packet;
        timeout := Countdown.reset (timeout sender);
        seq := seq sender;
        outgoing := outgoing sender |}.

    Definition flip_seq
      (sender : t)
      : t :=
      {| sent_unacked := sent_unacked sender;
        timeout := timeout sender;
        seq := Seq.flip (seq sender);
        outgoing := outgoing sender |}.

    Definition flush_outgoing
      (sender : t)
      : list Msg.t * t :=
      (outgoing sender,
        {| sent_unacked := sent_unacked sender;
          timeout := timeout sender;
          seq := seq sender;
          outgoing := [] |}).

    Definition decrement_timeout
      (sender : t) (decrement_val : nat)
      : t :=
      {| sent_unacked := sent_unacked sender;
        timeout := Countdown.decrement (timeout sender) decrement_val;
        seq := seq sender;
        outgoing := outgoing sender |}.

    Definition timeout_expired
      (sender : t)
      : bool :=
      Countdown.at_zero (timeout sender).

    Definition receive_ack
      (sender : t) (ack_seq : Seq.t)
      : t :=
      match Seq.eq ack_seq (seq sender) with
          | true =>
              {| sent_unacked := None;
                timeout := Countdown.reset (timeout sender);
                seq := Seq.flip ack_seq;
                outgoing := outgoing sender |}
          | false =>
              sender
      end.

    Definition update_by_poll
      (sender : t)
      : list Output.t * t :=
      match sent_unacked sender with
      | None =>
          ([], sender)
      | Some in_flight =>
          let seq := seq sender in
          let sender_timeout_decr :=
            decrement_timeout
              sender
              1 in
          match timeout_expired sender_timeout_decr with
          | true =>
              let sender_timeout_reset :=
                set_sent_unacked_reset_timer
                  sender
                  in_flight in
              let message := Msg.Send in_flight seq in
              let sender :=
                append_outgoing
                  sender_timeout_reset
                  [message] in
              ([],
                sender)
          | false =>
              ([],
                sender_timeout_decr)
          end
      end.

    Definition poll
      (sender : t)
      : list Output.t * list Msg.t * t :=
      let (outputs, sender) := update_by_poll sender in
      let (outgoing, sender) := flush_outgoing sender in
      (outputs, outgoing, sender).

    Definition handle_message
      (sender : t) (message : Msg.t)
      : list Output.t * t :=
      match message with
      | Msg.Send _ _ => ([], sender)
      | Msg.Ack ack_seq =>
          ([], receive_ack sender ack_seq)
      end.

    Fixpoint rec_handle_messages
      (sender : t) (messages : list Msg.t) (accum_outputs : list Output.t)
      : list Output.t * t :=
      match messages with
      | [] => (accum_outputs, sender)
      | first::rest =>
          let '(additional_outputs, sender) :=
            handle_message sender first in
          rec_handle_messages
            sender
            rest
            (accum_outputs ++ additional_outputs)
      end.

    Definition handle_messages
      (sender : t) (messages : list Msg.t)
      : list Output.t * t :=
      rec_handle_messages sender messages [].

    Definition handle_input
      (sender : t) (input : Input.ToSender.t)
      : list Output.t * t :=
      let seq := seq sender in
      match input with
      | Input.ToSender.Packet packet =>
          match sent_unacked sender with
          | None =>
              let messages := [Msg.Send packet seq] in
              let sender := append_outgoing sender messages in
              let sender := set_sent_unacked_reset_timer sender packet in
              ([], sender)
          | Some in_flight =>
              ([Output.SenderOutput (Output.FromSender.Reject packet)],
                sender)
          end
      end.
  End Sender.

  Module Receiver.
    Record t
      := mk { seq : Seq.t;
              outgoing : list Msg.t}.

    Definition init : t :=
      mk Seq.Zero [].

    Definition append_outgoing
      (receiver : t) (additional_outgoing : list Msg.t)
      : t :=
      {| seq := seq receiver;
        outgoing := (outgoing receiver) ++ additional_outgoing |}.

    Definition flip_seq
      (receiver : t)
      : t :=
      {| seq := Seq.flip (seq receiver);
        outgoing := outgoing receiver |}.

    Definition flush_outgoing
      (receiver : t)
      : list Msg.t * t :=
      (outgoing receiver,
        {| seq := seq receiver;
          outgoing := [] |}).

    Definition update_by_poll
      (receiver : t)
      : list Output.t * t :=
      ([], receiver).

    Definition poll
      (receiver : t)
      : list Output.t * list Msg.t * t :=
      let (outputs, receiver) := update_by_poll receiver in
      let (outgoing, receiver) := flush_outgoing receiver in
      (outputs, outgoing, receiver).

    Definition handle_message
      (receiver : t) (message : Msg.t)
      : list Output.t * t :=
      match message with
      | Msg.Ack _ => ([], receiver)
      | Msg.Send packet packet_seq =>
          let outputs :=
            match Seq.eq packet_seq (seq receiver) with
            | true =>
                [Output.ReceiverOutput
                   (Output.FromReceiver.Success packet)]
            | false => []
            end
          in
          let outgoing := Msg.Ack packet_seq::(outgoing receiver) in
          (outputs, mk (Seq.flip packet_seq) outgoing)
      end.

    Fixpoint rec_handle_messages
      (receiver : t)
      (messages : list Msg.t)
      (accum_outputs : list Output.t)
      : list Output.t * t :=
      match messages with
      | [] => (accum_outputs, receiver)
      | first::rest =>
          let '(additional_outputs, receiver) :=
            handle_message receiver first in
          rec_handle_messages
            receiver
            rest
            (accum_outputs ++ additional_outputs)
      end.

    Definition handle_messages
      (receiver : t) (messages : list Msg.t)
      : list Output.t * t :=
      rec_handle_messages receiver messages [].

    Definition handle_input
      (receiver : t) (input : Input.ToReceiver.t)
      : list Output.t * t :=
      ([], receiver).
  End Receiver.

  Module Network.
    Module NodeSpecific.
      Record t
        := mk { in_network : list Msg.t;
                drop_decider : Nondeterminism.t SendOrDrop.t;
                delay_decider : Nondeterminism.t Countdown.t;
                next_delay : Countdown.t}.

      Definition init
        (drop_pattern : list SendOrDrop.t) (delay_pattern : list nat)
        : t :=
        let delay_pattern :=
          List.map (fun delay => Countdown.init delay) delay_pattern in
        let delay_decider :=
          Nondeterminism.init delay_pattern (Countdown.init 0) in
        let (delay_decider, next_delay) :=
          Nondeterminism.Decider delay_decider in
        mk
          []
          (Nondeterminism.init drop_pattern SendOrDrop.Send)
          delay_decider
          next_delay.

      Fixpoint decide_on_messages
        (accum_outputs : list Output.t)
        (accum_outgoing : list Msg.t)
        (in_network : list Msg.t)
        (drop_decider : Nondeterminism.t SendOrDrop.t)
        (delay_decider : Nondeterminism.t Countdown.t)
        (next_delay : Countdown.t)
        : list Output.t * list Msg.t * t :=
        match in_network with
        | [] =>
            (accum_outputs, accum_outgoing,
              mk in_network drop_decider delay_decider next_delay)
        | head_packet::tail_packets =>
            match Countdown.at_zero next_delay with
            | true =>
                let (delay_decider, next_delay) :=
                  Nondeterminism.Decider delay_decider in
                let (drop_decider, next_decision) :=
                  Nondeterminism.Decider drop_decider in
                let accum_outgoing :=
                  match next_decision with
                  | SendOrDrop.Send => accum_outgoing ++ [head_packet]
                  | SendOrDrop.Drop => accum_outgoing
                  end in
                decide_on_messages
                  accum_outputs
                  accum_outgoing
                  tail_packets
                  drop_decider
                  delay_decider
                  next_delay
            | false =>
                (accum_outputs, accum_outgoing,
                  mk in_network drop_decider delay_decider next_delay)
            end
        end.

      Definition poll
        (network : t)
        : list Output.t * list Msg.t * t :=
        let '(outputs, messages, network) :=
          let accum_outputs := [] in
          let accum_outgoing := [] in
          decide_on_messages
            accum_outputs
            accum_outgoing
            (in_network network)
            (drop_decider network)
            (delay_decider network)
            (next_delay network) in
        match in_network network with
        | [] => (outputs, messages, network)
        | _ =>
            (outputs,
              messages,
              {| in_network := in_network network;
                drop_decider := drop_decider network;
                delay_decider := delay_decider network;
                next_delay :=
                  Countdown.decrement (next_delay network) 1 |})
        end.

      Definition handle_messages
        (network : t) (messages : list Msg.t)
        : list Output.t * t :=
        ([],
          {| in_network := (in_network network) ++ messages;
            drop_decider := drop_decider network;
            delay_decider := delay_decider network;
            next_delay := next_delay network |}).

      Definition handle_input
        (network : t) (input : Input.ToNetwork.t)
        : list Output.t * t :=
        ([], network).

    End NodeSpecific.

    Record t
      := mk { sender_network : NodeSpecific.t;
              receiver_network : NodeSpecific.t}.

    Definition init
      (drop_patterns : Name.t -> list SendOrDrop.t)
      (delay_patterns : Name.t -> list nat)
      : t :=
      {| sender_network :=
          NodeSpecific.init
            (drop_patterns Name.Sender)
            (delay_patterns Name.Sender);
        receiver_network :=
          NodeSpecific.init
            (drop_patterns Name.Receiver)
            (delay_patterns Name.Receiver) |}.

    Definition poll
      (network : t)
      : list Output.t * (list Msg.t * list Msg.t) * t :=
      let '(sender_outputs, sender_messages, sender_net) :=
        NodeSpecific.poll (sender_network network) in
      let '(receiver_outputs, receiver_messages, receiver_net) :=
        NodeSpecific.poll (receiver_network network) in
      (sender_outputs ++ receiver_outputs,
        (sender_messages, receiver_messages),
        {| sender_network := sender_net;
          receiver_network := receiver_net |}).

    Definition handle_messages
      (network : t) (recipient : Name.t) (messages : list Msg.t)
      : list Output.t * t :=
      let '(outputs, sender_net, receiver_net) :=
        match recipient with
        | Name.Sender =>
            let '(sender_outputs, sender_net) :=
              NodeSpecific.handle_messages
                (sender_network network)
                messages in
            (sender_outputs, sender_net, (receiver_network network))
        | Name.Receiver =>
            let '(receiver_outputs, receiver_net) :=
              NodeSpecific.handle_messages
                (receiver_network network)
                messages in
            (receiver_outputs, (sender_network network), receiver_net)
        end in
      (outputs,
        {| sender_network := sender_net;
          receiver_network := receiver_net |}).

    Definition handle_input
      (network : t) (input : Input.ToNetwork.t)
      : list Output.t * t :=
      ([], network).

  End Network.
End State.

Module StopAndWait.
(*  Fixpoint rec_feed_messages_ends
    (sender : State.Sender.t) (receiver : State.Receiver.t)
    (messages : list (Msg.t * Name.t)) (accum_output : list Output.t)
    : (list Output.t * State.Sender.t * State.Receiver.t) :=
    match messages with
    | [] => (accum_output, sender, receiver)
    | message::tail =>
        let '(additional_output, sender, receiver) :=
          match message with
          | (content, Name.Sender) =>
              let '(sender_output, sender) :=
                State.Sender.handle_message
                  sender
                  content in
              (sender_output, sender, receiver)

          | (content, Name.Receiver) =>
              let '(receiver_output, receiver) :=
                State.Receiver.handle_message
                  receiver
                  content in
              (receiver_output, sender, receiver)
          end in
        rec_feed_messages_ends
          sender
          receiver
          tail
          (accum_output ++ additional_output)
    end.

  Definition feed_messages_ends
    (sender : State.Sender.t) (receiver : State.Receiver.t)
    (messages : list (Msg.t * Name.t))
    : (list Output.t * State.Sender.t * State.Receiver.t) :=
    rec_feed_messages_ends sender receiver messages [].
*)
  Fixpoint rec_simulate
    (steps : nat)
    (inputs : Nondeterminism.t Input.t)
    (sender : State.Sender.t)
    (receiver : State.Receiver.t)
    (network : State.Network.t)
    (accum_output : list Output.t)
    : (State.Sender.t * State.Receiver.t * State.Network.t * list Output.t) :=
    match steps with
    | 0 => (sender, receiver, network, accum_output)
    | S p =>
        let '(inputs, input) := Nondeterminism.Decider inputs in
        let '(sender, receiver, network, outputs) :=
          match input with
          | Input.Sender in_to_sender =>
              let '(sender_output, sender) :=
                State.Sender.handle_input sender in_to_sender in
              (sender, receiver, network, sender_output)

          | Input.Receiver in_to_receiver =>
              let '(receiver_output, receiver) :=
                State.Receiver.handle_input receiver in_to_receiver in
              (sender, receiver, network, receiver_output)

          | Input.Network in_to_network =>
              let '(network_output, network) :=
                State.Network.handle_input network in_to_network in
              (sender, receiver, network, network_output)

          | Input.Poll =>
              let '(outputs_poll_sender, from_sender, sender) :=
                State.Sender.poll sender in
              let '(outputs_poll_receiver, from_receiver, receiver) :=
                State.Receiver.poll receiver in
              let '(outputs_poll_network,
                      (to_receiver, to_sender), network) :=
                State.Network.poll network in
              let '(outputs_feed_sender, sender) :=
                State.Sender.handle_messages sender to_sender in
              let '(outputs_feed_receiver, receiver) :=
                State.Receiver.handle_messages receiver to_receiver in
              let '(outputs_sender_feed_network, network) :=
                State.Network.handle_messages
                  network
                  Name.Sender
                  from_sender in
              let '(outputs_receiver_feed_network, network) :=
                State.Network.handle_messages
                  network
                  Name.Receiver
                  from_receiver in
              (sender, receiver, network,
                outputs_poll_sender ++
                  outputs_poll_receiver ++
                  outputs_poll_network ++
                  outputs_feed_sender ++
                  outputs_feed_receiver ++
                  outputs_sender_feed_network ++
                  outputs_receiver_feed_network)
          end in
        rec_simulate
          p
          inputs
          sender receiver network
          (accum_output ++ outputs)
    end.

  Definition pack {T : Type}
    (sender_part : T) (receiver_part : T) (name : Name.t) :=
    match name with
    | Name.Sender => sender_part
    | Name.Receiver => receiver_part
    end.

  Definition simulate
    (steps : nat)
    (inputs : list Input.t)
    (sender_drop_pattern : list SendOrDrop.t)
    (receiver_drop_pattern : list SendOrDrop.t)
    (sender_delay_pattern : list nat)
    (receiver_delay_pattern : list nat)
    (sender_timeout : nat) :
    (State.Sender.t *
       State.Receiver.t *
       State.Network.t *
       list Output.t) :=
    let sender_start := State.Sender.init sender_timeout in
    let receiver_start := State.Receiver.init in
    let network_start :=
      State.Network.init
        (pack sender_drop_pattern receiver_drop_pattern)
        (pack sender_delay_pattern receiver_delay_pattern) in
    let inputs := Nondeterminism.init inputs Input.Poll in
    rec_simulate
      steps inputs sender_start receiver_start network_start [].

End StopAndWait.

Module SuccessfulSend.

  Definition packet := Input.packet.
  Definition poll := Input.Poll.

  Definition steps := 3.
  Definition inputs := [poll; poll].
  Definition sender_drop_pattern : list SendOrDrop.t := [].
  Definition receiver_drop_pattern : list SendOrDrop.t := [].
  Definition sender_delay_pattern : list nat := [].
  Definition receiver_delay_pattern : list nat := [].
  Definition sender_timeout := 5.

  Definition result (packet_val : nat) :=
    StopAndWait.simulate
      steps
      ((packet packet_val)::inputs)
      sender_drop_pattern
      receiver_drop_pattern
      sender_delay_pattern
      receiver_delay_pattern
      sender_timeout.

  Compute result 5.

 (* Definition result_sender :=
    State.Sender.mk
      (Some 5)
      (Countdown.decrement (Countdown.init 5) 2)
      Seq.Zero
      [].

  Definition result_receiver :=
    State.Receiver.mk
      Seq.One
      [Msg.Ack Seq.Zero].

  Definition result_network :=
    State.Network.mk
      (State.Network.NodeSpecific.mk
         []
   *)

  Lemma sends_1 :
    forall packet_val, exists sender, exists receiver, exists network,
    result packet_val =
      (sender, receiver, network, [Output.ReceiverOutput (Output.FromReceiver.Success packet_val)]).
  Proof.
    intro packet_val.
    unfold result.
    unfold StopAndWait.simulate.
    unfold StopAndWait.rec_simulate.