Require Import Crypto.Specific.Framework.SynthesisFramework.
Require Import Crypto.Specific.solinas32_2e336m3_13limbs.CurveParameters.

Module P <: PrePackage.
  Definition package : Tag.Context.
  Proof. make_Synthesis_package curve extra_prove_mul_eq extra_prove_square_eq. Defined.
End P.

Module Export S := PackageSynthesis P.


Require Import Crypto.Specific.Framework.RawCurveParameters.
Require Import Crypto.Util.LetIn.

(***
Modulus : 2^384 - 5*2^368 - 1
Base: 64
***)

Definition curve : CurveParameters :=
  {|
    sz := 6%nat;
    base := 64;
    bitwidth := 64;
    s := 2^384;
    c := [(1, 1); (5, 2^368)];
    carry_chains := None;

    a24 := None;
    coef_div_modulus := None;

    goldilocks := None;
    karatsuba := None;
    montgomery := true;
    freeze := Some false;
    ladderstep := false;

    mul_code := None;

    square_code := None;

    upper_bound_of_exponent_loose := None;
    upper_bound_of_exponent_tight := None;
    allowable_bit_widths := None;
    freeze_extra_allowable_bit_widths := None;
    modinv_fuel := None
  |}.

Ltac extra_prove_mul_eq _ := idtac.
Ltac extra_prove_square_eq _ := idtac.


Require Import Crypto.Specific.Framework.RawCurveParameters.
Require Import Crypto.Util.LetIn.

(***
Modulus : 2^255 - 19
Base: 51
***)

Definition curve : CurveParameters :=
  {|
    sz := 5%nat;
    base := 51;
    bitwidth := 64;
    s := 2^255;
    c := [(1, 19)];
    carry_chains := Some [seq 0 (pred 5); [0; 1]]%nat;

    a24 := None;
    coef_div_modulus := Some 2%nat;

    goldilocks := None;
    karatsuba := None;
    montgomery := false;
    freeze := Some true;
    ladderstep := false;

    mul_code := None;

    square_code := None;

    upper_bound_of_exponent_loose := None;
    upper_bound_of_exponent_tight := None;
    allowable_bit_widths := None;
    freeze_extra_allowable_bit_widths := None;
    modinv_fuel := None
  |}.

Ltac extra_prove_mul_eq _ := idtac.
Ltac extra_prove_square_eq _ := idtac.


(* File: NRules.v  (last edited on 27/10/2000) (c) Klaus Weich  *)

Require Export Cons_Counter_Model.
Require Export NSound.

Inductive nsearch_spec_result_aux (goal : Int) (work : nf_list)
(ds : disjs) (ni : nested_imps) (ai : atomic_imps)
(a : atoms) (context : flist) : Set :=
  | NDerivable :
      Derivable context (Atom goal) ->
      nsearch_spec_result_aux goal work ds ni ai a context
  | NRefutable :
      forall k : kripke_tree,
      Is_Monotone_kripke_tree k ->
      forces_ngamma work ds ni ai a k ->
      (forces_t k (Atom goal) -> False) ->
      nsearch_spec_result_aux goal work ds ni ai a context.

Inductive nsearch_spec_result (goal : Int) (work : nf_list)
(ds : disjs) (ni : nested_imps) (ai : atomic_imps)
(a : atoms) (context : flist) : Set :=
    NSearch_Res :
      forall ni1 : nested_imps,
      le_ni ni1 ni ->
      deco_sound work ds ni1 ai a ->
      nsearch_spec_result_aux goal work ds ni1 ai a context ->
      nsearch_spec_result goal work ds ni ai a context.

Definition nsearch_spec (goal : Int) (work : nf_list)
  (ds : disjs) (ni : nested_imps) (ai : atomic_imps)
  (a : atoms) (context : flist) :=
  deco_sound work ds ni ai a ->
  nsound work ds ni ai a context ->
  nminimal work ds ni ai a context ->
  nsearch_spec_result goal work ds ni ai a context.

(**********************************************************************)

Lemma fail :
 forall (i : Int) (dni : decorated_nested_imps) (ai : atomic_imps)
   (a : atoms) (context : flist),
 a_ai_disj a ai ->
 a_goal_disj a i ->
 nsearch_spec i nf_nil DNil (rev_app dni NNil) ai a context.
unfold nsearch_spec in |- *.
intros i dni ai a context a_ai_disjunct goal_a_disj complete sound mon.
apply NSearch_Res with (rev_app dni NNil); try assumption.
apply le_ni_refl.
elim (cons_counter_model i dni ai a); try assumption.
intros k k_is_mon k_forces_ngamma k_notforces_goal.
apply NRefutable with k; assumption.
Qed.

(**********************************************************************)

Lemma rule_shift_work_ds :
 forall (goal i j : Int) (work : nf_list) (ds : disjs)
   (ni : nested_imps) (ai : atomic_imps) (a : atoms)
   (context : flist),
 nsearch_spec goal work ((i, j) :: ds) ni ai a context ->
 nsearch_spec goal (NDisj i j :: work) ds ni ai a context.
intros goal i j work ds ni ai a context premiss.
unfold nsearch_spec in |- *; intros complete sound mon.
elim premiss; clear premiss.
intros ni1 less1 complete1 spec1.
apply NSearch_Res with ni1.
assumption.
apply deco_sound_shift_ds_work; assumption.
elim spec1; clear spec1.

intros derivable_goal; apply NDerivable; assumption.

intros k k_is_mon k_forces_ngamma k_nonforces_goal.
apply NRefutable with k; try assumption.
apply forces_ngamma_shift_ds_work; assumption.
(* side premisses: Elim premiss. *)
apply deco_sound_shift_work_ds; assumption.
apply nsound_shift_work_ds; assumption.
apply nminimal_shift_work_ds; assumption.
Qed.

Lemma rule_shift_work_ni0 :
 forall (goal : Int) (x : nimp) (work : nf_list) (ds : disjs)
   (ni : nested_imps) (ai : atomic_imps) (a : atoms)
   (context : flist),
 nsearch_spec goal work ds (Undecorated x :: ni) ai a context ->
 nsearch_spec goal (NImp_NF x :: work) ds ni ai a context.
intros goal x work ds ni ai a context premiss.
unfold nsearch_spec in |- *; intros complete sound mon.
elim premiss; clear premiss.
intros ni1 less1 complete1 spec1.
apply NSearch_Res with (tail ni1).
inversion_clear less1; assumption.
generalize complete1; clear spec1 complete1.
inversion_clear less1; intros.
apply deco_sound_shift_ni_work with (x := Undecorated x); assumption.
apply deco_sound_shift_ni_work with (x := Decorated x k); assumption.
elim spec1; clear spec1.
intros derivable_goal; apply NDerivable; assumption.
intros k k_is_mon k_forces_ngamma k_nonforces_goal.
apply NRefutable with k; try assumption.
generalize k_forces_ngamma; clear complete1 k_forces_ngamma.
inversion_clear less1; intros.
apply forces_ngamma_shift_ni_work with (x := Undecorated x); assumption.
apply forces_ngamma_shift_ni_work with (x := Decorated x k0); assumption.
(* side premisses: Elim premiss.  *)
apply deco_sound_shift_work_ni0; assumption.
apply nsound_shift_work_ni; assumption.
apply nminimal_shift_work_ni; assumption.
Qed.

Lemma rule_shift_work_ai_new :
 forall (goal i : Int) (b : normal_form) (work : nf_list)
   (ds : disjs) (ni : nested_imps) (ai ai' : atomic_imps)
   (a : atoms) (context : flist),
 (forall x : unit, LOOKUP unit i a x -> False) ->
 (forall bs : nf_list, LOOKUP nf_list i ai bs -> False) ->
 EQUIV_INS nf_list i (cons b) nf_nil ai ai' ->
 nsearch_spec goal work ds ni ai' a context ->
 nsearch_spec goal (AImp i b :: work) ds ni ai a context.
intros goal i b work ds ni ai ai' a context notlookup_i notlookup_bs
 equiv_ins premiss.
unfold nsearch_spec in |- *; intros complete sound mon.
elim premiss; clear premiss.
intros ni1 less1 complete1 spec1.
apply NSearch_Res with ni1.
assumption.
apply deco_sound_shift_ai_work_new with ai'; assumption.
elim spec1; clear spec1.

intros derivable_goal; apply NDerivable; assumption.

intros k k_is_mon k_forces_ngamma k_nonforces_goal.
apply NRefutable with k; try assumption.
apply forces_ngamma_shift_ai_work_new with ai'; assumption.
(* side premisses: Elim premiss.  *)
apply deco_sound_shift_work_ai with i b ai; assumption.
apply nsound_shift_work_ai with i b ai; assumption.
apply nminimal_shift_work_ai_new with i b ai; assumption.
Qed.

Lemma rule_shift_work_ai_old :
 forall (goal i : Int) (b : normal_form) (work : nf_list)
   (ds : disjs) (ni : nested_imps) (bs : nf_list) (ai ai' : atomic_imps)
   (a : atoms) (context : flist),
 (forall x : unit, LOOKUP unit i a x -> False) ->
 LOOKUP nf_list i ai bs ->
 EQUIV_INS nf_list i (cons b) nf_nil ai ai' ->
 nsearch_spec goal work ds ni ai' a context ->
 nsearch_spec goal (AImp i b :: work) ds ni ai a context.
intros goal i b work ds ni bs ai ai' a context notlookup_i lookup_bs
 equiv_ins premiss.
unfold nsearch_spec in |- *; intros complete sound mon.
elim premiss; clear premiss.
intros ni1 less1 complete1 spec1.
apply NSearch_Res with ni1.
assumption.
apply deco_sound_shift_ai_work_old with bs ai'; assumption.
elim spec1; clear spec1.

intros derivable_goal; apply NDerivable; assumption.

intros k k_is_mon k_forces_ngamma k_nonforces_goal.
apply NRefutable with k; try assumption.
apply forces_ngamma_shift_ai_work_old with bs ai'; assumption.
(* side premisses: Elim premiss.  *)
apply deco_sound_shift_work_ai with i b ai; assumption.
apply nsound_shift_work_ai with i b ai; assumption.
apply nminimal_shift_work_ai_old with i b bs ai; assumption.
Qed.

Lemma rule_shift_work_a :
 forall (goal i : Int) (work : nf_list) (ds : disjs)
   (ni : nested_imps) (ai : atomic_imps) (a a' : atoms)
   (context : flist),
 (forall bs : nf_list, LOOKUP nf_list i ai bs -> False) ->
 (forall d : unit, LOOKUP unit i a d -> False) ->
 EQUIV_INS unit i (fun _ : unit => tt) tt a a' ->
 nsearch_spec goal work ds ni ai a' context ->
 nsearch_spec goal (NAtom i :: work) ds ni ai a context.
intros goal i work ds ni ai a a' context notlookup_bs notlookup_i equiv_ins
 premiss.
unfold nsearch_spec in |- *; intros complete sound mon.
elim premiss; clear premiss.
intros ni1 less1 complete1 spec1.
apply NSearch_Res with ni1.
assumption.
apply deco_sound_shift_a_work with a'; assumption.
elim spec1; clear spec1.

intros derivable_goal; apply NDerivable; assumption.

intros k k_is_mon k_forces_ngamma k_nonforces_goal.
apply NRefutable with k; try assumption.
apply forces_ngamma_shift_a_work with a'; assumption.
(* side premisses: Elim premiss.  *)
apply deco_sound_shift_work_a with i a; assumption.
apply nsound_shift_work_a with i a; assumption.
apply nminimal_shift_work_a with i a; assumption.
Qed.

Lemma shift_ni_dni :
 forall (goal : Int) (work : nf_list) (ds : disjs)
   (x : nimp) (k : kripke_tree) (ni : nested_imps)
   (dni : decorated_nested_imps) (ai : atomic_imps)
   (a : atoms) (context : flist),
 nsearch_spec goal work ds (rev_app ((x, k) :: dni) ni) ai a context ->
 nsearch_spec goal work ds (rev_app dni (Decorated x k :: ni)) ai a context.
intros; assumption.
Qed.

(*************************************************************************)

Lemma nax :
 forall (goal : Int) (work : nf_list) (ds : disjs)
   (ni : nested_imps) (ai : atomic_imps) (a : atoms)
   (context : flist),
 in_ngamma work ds ni ai a (NAtom goal) ->
 nsearch_spec goal work ds ni ai a context.
unfold nsearch_spec in |- *.
intros goal work ds ni ai a context in_ngamma complete sound mon.
apply NSearch_Res with ni; try assumption.
apply le_ni_refl.
apply NDerivable.
apply sound with (c := NAtom goal); assumption.
Qed.

(**********************************************************************)

Lemma nefq :
 forall (goal : Int) (work : nf_list) (ds : disjs)
   (ni : nested_imps) (ai : atomic_imps) (a : atoms)
   (context : flist), nsearch_spec goal (NFalsum :: work) ds ni ai a context.
unfold nsearch_spec in |- *.
intros goal work ds ni ai a context complete sound mon.
apply NSearch_Res with ni; try assumption.
apply le_ni_refl.
apply NDerivable.
elim (sound NFalsum).
intros t der_t.
apply Derivable_Intro with (Efq t (Atom goal)).
apply ByAbsurdity; assumption.
apply in_ngamma_cons_work_head.
Qed.

Lemma contradiction_atoms :
 forall (goal i : Int) (work : nf_list) (ds : disjs)
   (ni : nested_imps) (ai : atomic_imps) (a : atoms)
   (context : flist),
 LOOKUP unit i a tt ->
 nsearch_spec goal work ds ni ai a context ->
 nsearch_spec goal (NAtom i :: work) ds ni ai a context.
intros goal i work ds ni ai a context in_atoms premiss.
unfold nsearch_spec in |- *; intros complete sound mon.
cut (EQUIV_INS unit i (fun _ => tt) tt a a).
intros equiv_ins.
elim premiss; clear premiss.
clear mon sound complete.
intros ni1 le1 complete1 spec1.
apply NSearch_Res with ni1; try assumption.
apply deco_sound_shift_a_work with a; assumption.
elim spec1; clear spec1.

intros der_goal; apply NDerivable; assumption.

intros k k_is_mon k_forces_ngamma k_notforces_goal.
apply NRefutable with k; try assumption.
apply forces_ngamma_shift_a_work with a; assumption.

(* side premisses: (Elim spec ..)  *)
apply deco_sound_shift_work_a with i a; assumption.
apply nsound_shift_work_a with i a; assumption.
apply nminimal_shift_work_a with i a; assumption.

(* side premiss (Cut (EQUIV_INS ....))  *)
clear complete sound mon premiss context ai ni ds work goal.
generalize in_atoms; clear in_atoms.
elim a; clear a; intros t avl_t.
unfold LOOKUP in |- *.
unfold EQUIV_INS in |- *.
intros lookup.
apply equiv_ins_intro.
intros k d eq_k lookup0.
 rewrite (equal_eq k i eq_k); assumption.
intros k eq_k notlookup0.
 rewrite (equal_eq k i eq_k); assumption.
intros; assumption.
intros; assumption.
Qed.

(**************************************************************************)

Lemma left_p_imp_work :
 forall (goal i : Int) (b : normal_form) (work : nf_list)
   (ds : disjs) (ni : nested_imps) (ai : atomic_imps)
   (a : atoms) (context : flist),
 forces0_t a i ->
 nsearch_spec goal (b :: work) ds ni ai a context ->
 nsearch_spec goal (AImp i b :: work) ds ni ai a context.
intros goal i b work ds ni ai a context forces_i premiss.
unfold nsearch_spec in |- *; intros complete sound mon.
elim premiss; clear premiss.
intros ni1 less1 complete1 spec1.
apply NSearch_Res with ni1; try assumption.
apply deco_sound_cons_work_weak with b; try assumption.
intros.
apply forces_b__forces_a_imp_b_t with (a := Atom i) (b := nf2form b);
 assumption.
elim spec1; clear spec1.

intros derivable_goal; apply NDerivable; assumption.

intros k k_is_mon k_forces_ngamma k_nonforces_goal.
apply NRefutable with k; try assumption.
apply forces_ngamma_cons_work_weak with b; try assumption.
intros forces_b.
simpl in |- *; apply forces_b__forces_a_imp_b_t; assumption.

(* side premisses: Elim premiss.  *)
apply deco_sound_cons_work_strength with (AImp i b); try assumption.
intros k k_is_mon k_forces_ngamma.
apply forces_a_a_imp_b__forces_b_t with (Atom i); try assumption.
apply k_forces_ngamma with (c := NAtom i).
apply In_Atoms; assumption.
apply k_forces_ngamma with (c := AImp i b).
apply in_ngamma_cons_work_head.

apply nsound_cons_work_weak with (AImp i b); try assumption.
intros der_ab.
apply derivable_a_a_imp_b__derivable_b with (Atom i); try assumption.
apply sound with (c := NAtom i).
apply In_Atoms; assumption.

apply nminimal_cons_work_weak with (AImp i b); try assumption.
intros k k_is_mon forces_b.
simpl in |- *; apply forces_b__forces_a_imp_b_t; assumption.
Qed.

(****************************************************************)

Lemma left_p_imp_ai :
 forall (goal i : Int) (work : nf_list) (ds : disjs)
   (ni : nested_imps) (bs : nf_list) (ai ai' : atomic_imps)
   (a a' : atoms) (context : flist),
 LOOKUP nf_list i ai bs ->
 EQUIV_DEL nf_list i ai ai' ->
 (forall d : unit, LOOKUP unit i a d -> False) ->
 EQUIV_INS unit i (fun _ : unit => tt) tt a a' ->
 nsearch_spec goal (bs ++ work) ds ni ai' a' context ->
 nsearch_spec goal (NAtom i :: work) ds ni ai a context.
intros goal i work ds ni bs ai ai' a a' context lookup_bs equiv_del
 notlookup_i equiv_ins premiss.
unfold nsearch_spec in |- *; intros complete sound mon.
elim premiss; clear premiss.
intros ni1 less1 complete1 spec1.
apply NSearch_Res with ni1; try assumption.
apply deco_sound_shift_a_work with a'; try assumption.
apply deco_sound_shift_work_ai_weak with i bs ai'; assumption.
elim spec1; clear spec1.

intros derivable_goal; apply NDerivable; assumption.

intros k k_is_mon k_forces_ngamma k_nonforces_goal.
apply NRefutable with k; try assumption.
apply forces_ngamma_shift_a_work with a'; try assumption.
apply forces_ngamma_shift_work_ai_weak with i bs ai'; assumption.

(* side premisses: Elim premiss.  *)
apply deco_sound_shift_work_ai_strength with i ai a; try assumption.
apply deco_sound_shift_work_a with i a; assumption.
apply nsound_shift_work_ai_strength with i ai a; try assumption.
apply nsound_shift_work_a with i a; assumption.
apply nminimal_shift_work_ai_weak with i ai; try assumption.
apply nminimal_shift_work_a with i a; assumption.
Qed.

(****************************************************************)

Lemma left_disj :
 forall (goal : Int) (work : nf_list) (i j : Int) (ds : disjs)
   (ni : nested_imps) (ai : atomic_imps) (a : atoms)
   (context : flist),
 (forall ni1 : nested_imps,
  le_ni ni ni1 ->
  nsearch_spec goal (NAtom i :: work) ds ni1 ai a (Atom i :: context)) ->
 (forall ni2 : nested_imps,
  eqv_ni ni2 ni ->
  nsearch_spec goal (NAtom j :: work) ds ni2 ai a (Atom j :: context)) ->
 nsearch_spec goal work ((i, j) :: ds) ni ai a context.
intros goal work i j ds ni ai a context left_premiss right_premiss.
unfold nsearch_spec in |- *; intros complete sound mon.
elim (filter_deco i ni).
intros ni1 le1 forces_i.
elim (left_premiss ni1 le1); clear left_premiss.
clear forces_i.
intros ni2 le2 complete2 spec2.
elim (inf_deco ni ni2).
intros ni3 le30 le32 inf3.
elim spec2; clear spec2.
(* left_premiss yields a derivation *)
intros der2.
elim (filter_deco j ni3).
intros ni4 le4 forces_j.
elim (right_premiss ni4); clear right_premiss.
clear forces_j inf3.
intros ni5 le5 complete5 spec5.
elim (inf_deco ni ni5).
intros ni6 le60 le65 inf6.
apply NSearch_Res with ni6.
assumption.
apply deco_sound_inf with ni ni5; try assumption.
apply deco_sound_shift_work_ds.
apply deco_sound_cons_work_weak with (NAtom j); try assumption.
intros; right; assumption.

clear inf6.
elim spec5; clear spec5.
clear complete complete2 complete5 mon le65 le60 le5 le4 le30 le32 le2 le1.
intros der5.
apply NDerivable.
elim der2; clear der2; intros s der_s.
elim der5; clear der5; intros t der_t.
elim (sound (NDisj i j)); clear sound.
intros r der_r.
apply Derivable_Intro with (Cas (Atom i) (Atom j) r s t).
apply OrFElim; assumption.
apply In_Disjs with 0; apply My_NthO.

clear der2 mon sound.
intros k k_is_mon k_forces_ngamma k_notforces_goal.
apply NRefutable with k; try assumption.
apply forces_ngamma_eqv with ni5; try assumption.
apply forces_ngamma_shift_work_ds.
apply forces_ngamma_cons_work_weak with (NAtom j); try assumption.
intros; right; assumption.
apply eqv_ni_trans with ni4.
apply eqv_ni_trans with ni3.
apply ge_eqv; assumption.
apply le_eqv; assumption.
apply ge_eqv; assumption.
apply eqv_ni_trans with ni3.
apply ge_eqv; assumption.
apply le_eqv; assumption.
(* side premisses: Elim right_premiss.  *)
apply deco_sound_filter_deco; try assumption.
apply deco_sound_le with ni3; try assumption.
apply deco_sound_inf with ni ni2; try assumption.
apply deco_sound_cons_ds_tail with i j; assumption.
apply deco_sound_cons_work_tail with (NAtom i); assumption.

clear forces_j complete2 complete inf3 mon.
apply nsound_eqv with ni.
apply eqv_ni_trans with ni3.
apply ge_eqv; assumption.
apply le_eqv; assumption.
apply nsound_cons_work_cons_context with (c := NAtom j).
apply nsound_cons_ds_tail with i j; assumption.

clear forces_j complete2 complete inf3 sound.
apply nminimal_eqv with ni.
apply eqv_ni_trans with ni3.
apply ge_eqv; assumption.
apply le_eqv; assumption.
apply nminimal_shift_ds_work_context with (c := NAtom j) (i := i) (j := j);
 try assumption.
intros; right; assumption.
(* left_premiss yields a counter--model *)
clear right_premiss.
intros k k_is_mon k_forces_ngamma k_notforces_goal.
apply NSearch_Res with ni3.
assumption.
clear sound mon.
apply deco_sound_inf with ni ni2; try assumption.
apply deco_sound_shift_work_ds.
apply deco_sound_cons_work_weak with (NAtom i); try assumption.
intros; left; assumption.

apply NRefutable with k.
assumption.
apply forces_ngamma_eqv with ni2; try assumption.
apply forces_ngamma_shift_work_ds.
apply forces_ngamma_cons_work_weak with (NAtom i); try assumption.
intros; left; assumption.
assumption.
(* side premiss: Elim inf???? *)
clear right_premiss.
apply eqv_ni_trans with ni1.
apply le_eqv; assumption.
apply ge_eqv; assumption.
(* side premisses: Elim left_premiss.  *)
apply deco_sound_filter_deco.
assumption.
apply deco_sound_le with ni.
assumption.
apply deco_sound_cons_ds_tail with i j; assumption.

apply nsound_le with ni.
assumption.
apply nsound_cons_work_cons_context with (c := NAtom i).
apply nsound_cons_ds_tail with i j; assumption.

apply nminimal_eqv with ni.
apply le_eqv; assumption.
apply nminimal_shift_ds_work_context with (c := NAtom i) (i := i) (j := j).
intros; left; assumption.
assumption.
Qed.

(**********************************************************************)

Lemma left_nimp :
 forall (goal : Int) (work : nf_list) (ds : disjs)
   (a0 a1 : Int) (b : normal_form) (ni : nested_imps)
   (dni : decorated_nested_imps) (ai : atomic_imps)
   (a : atoms) (context : flist),
 (forall ni1 : nested_imps,
  le_ni (rev_app dni ni) ni1 ->
  nsearch_spec a1 (AImp a1 b :: NAtom a0 :: work) ds ni1 ai a
    (Atom a0 :: context)) ->
 (forall ni1 : nested_imps,
  le_ni ni1 (rev_app dni ni) ->
  nsearch_spec goal (b :: work) ds ni1 ai a context) ->
 (forall (ni1 : nested_imps) (k : kripke_tree),
  le_ni ni1 (rev_app ((NImp a0 a1 b, k) :: dni) ni) ->
  nsearch_spec goal work ds ni1 ai a context) ->
 nsearch_spec goal work ds (rev_app dni (Undecorated (NImp a0 a1 b) :: ni))
   ai a context.
intros goal work ds a0 a1 b ni dni ai a context left_premiss right_premiss
 fail0.
apply rev_app_lemma2 with dni ni.
intros dni_ni dni_ni_eq.
unfold nsearch_spec in |- *.
intros complete sound mon.
elim (filter_deco a0 dni_ni).
intros ni1 le1 forces_a0.
elim (left_premiss ni1); clear left_premiss; try assumption.
intros ni2 le2 complete2 spec2.
elim (inf_deco dni_ni ni2).
intros ni3 le3 eqv3 inf3.
elim spec2; clear spec2.
(* left_premiss yields a derivation  *)
intros derivable_a0a1; clear fail0.
elim right_premiss with ni3; clear right_premiss; try assumption.
intros ni4 le4 complete4 spec4.
elim (le_app0 ni4 (rev_app dni NNil) ni).
intros ni41 ni42 eq_ni4 len.
apply NSearch_Res with (ni41 ++ Undecorated (NImp a0 a1 b) :: ni42).
 rewrite (rev_app_app dni (Undecorated (NImp a0 a1 b) :: ni)).
apply le_ni_app_nn; try assumption.
 rewrite <- eq_ni4.
 rewrite <- (rev_app_app dni ni).
 rewrite <- dni_ni_eq.
apply le_ni_trans with ni3; assumption.
apply deco_sound_shift_work_ninni.
 rewrite <- eq_ni4.
apply deco_sound_cons_work_weak with b; try assumption.
intros; simpl in |- *; apply forces_b__forces_a_imp_b_t; assumption.

elim spec4; clear spec4.
intros der_goal; apply NDerivable; assumption.

intros k k_is_mon k_forces_ngamma k_nonforces_goal.
apply NRefutable with k; try assumption.
apply forces_ngamma_shift_work_ni_x_ni.
 rewrite <- eq_ni4.
apply forces_ngamma_cons_work_weak with b; try assumption.
intros; simpl in |- *; apply forces_b__forces_a_imp_b_t; assumption.
 rewrite <- (rev_app_app dni ni).
 rewrite <- dni_ni_eq.
apply le_ni_trans with ni3; assumption.
 rewrite <- dni_ni_eq; assumption.

(* side premiss: Elim right_premiss with ni3 dni3 *)
apply deco_sound_inf with dni_ni ni2; try assumption.
apply deco_sound_cons_work_strength with (NImp_NF (NImp a0 a1 b)).
intros k k_is_mon k_forces_ngamma.
apply forces_a_a_imp_b__forces_b_t with (Imp (Atom a0) (Atom a1));
 try assumption.
apply
 nminimal_derivable_forces
  with work ds (rev_app dni (Undecorated (NImp a0 a1 b) :: ni)) ai a context;
 try assumption.
 rewrite (rev_app_app dni (Undecorated (NImp a0 a1 b) :: ni)).
apply forces_ngamma_shift_work_ni_x_ni; try assumption.
 rewrite <- (rev_app_app dni ni).
 rewrite <- dni_ni_eq; assumption.
apply derivable_a_context_b__derivable_a_imp_b; assumption.
apply k_forces_ngamma with (c := NImp_NF (NImp a0 a1 b)).
apply in_ngamma_cons_work_head.
 rewrite dni_ni_eq.
 rewrite (rev_app_app dni ni).
apply deco_sound_shift_ni_x_ni_work with (x := Undecorated (NImp a0 a1 b));
 try assumption.
 rewrite <- (rev_app_app dni (Undecorated (NImp a0 a1 b) :: ni)).
assumption.
apply deco_sound_cons_work_strength with (NImp_NF (NImp a0 a1 b)).
intros k k_is_mon k_forces_ngamma.
apply forces_a_a_imp_b__forces_b_t with (Imp (Atom a0) (Atom a1));
 try assumption.
apply
 nminimal_derivable_forces
  with work ds (rev_app dni (Undecorated (NImp a0 a1 b) :: ni)) ai a context;
 try assumption.
 rewrite (rev_app_app dni (Undecorated (NImp a0 a1 b) :: ni)).
apply forces_ngamma_shift_work_ni_x_ni.
apply forces_ngamma_eqv with ni2; try assumption.
apply eqv_ni_trans with ni1.
 rewrite <- (rev_app_app dni ni).
 rewrite <- dni_ni_eq.
apply le_eqv; assumption.
apply ge_eqv; assumption.
apply derivable_a_context_b__derivable_a_imp_b; assumption.
apply k_forces_ngamma with (c := NImp_NF (NImp a0 a1 b)).
apply in_ngamma_cons_work_head.

apply deco_sound_cons_work_weak2 with (AImp a1 b) (NAtom a0); try assumption.
intros k k_is_mon forces_a1_b forces_a1.
simpl in |- *; apply forces_a1_imp_b__forces_a0_imp_a1_imp_b_t; assumption.

apply nsound_ge with (rev_app dni ni); try assumption.
 rewrite <- dni_ni_eq; assumption.
apply nsound_cons_work_weak with (NImp_NF (NImp a0 a1 b)).
intros der.
apply derivable_a_a_imp_b__derivable_b with (Imp (Atom a0) (Atom a1)).
apply derivable_a_context_b__derivable_a_imp_b; assumption.
assumption.
 rewrite (rev_app_app dni ni).
apply nsound_shift_ni_x_ni_work with (x := Undecorated (NImp a0 a1 b));
 try assumption.
 rewrite <- (rev_app_app dni (Undecorated (NImp a0 a1 b) :: ni)).
assumption.

apply nminimal_eqv with (rev_app dni ni).
apply ge_eqv; try assumption.
 rewrite <- dni_ni_eq; assumption.
apply nminimal_cons_work_weak with (NImp_NF (NImp a0 a1 b)).
intros; simpl in |- *; apply forces_b__forces_a_imp_b_t; assumption.
 rewrite (rev_app_app dni ni).
apply nminimal_shift_ni_x_ni_work with (x := Undecorated (NImp a0 a1 b));
 try assumption.
 rewrite <- (rev_app_app dni (Undecorated (NImp a0 a1 b) :: ni)).
assumption.

(* left premiss yields a counter-model *)
clear right_premiss.
intros k k_is_mon k_forces_ngamma k_nonforces_goal.
elim (le_app0 ni3 (rev_app dni NNil) ni).
intros ni31 ni32 eq_ni3 len.
elim (fail0 (ni31 ++ Decorated (NImp a0 a1 b) k :: ni32) k); clear fail0.
intros ni5 le5 complete5 spec5.
apply NSearch_Res with ni5.
apply le_ni_trans with (ni31 ++ Decorated (NImp a0 a1 b) k :: ni32).
assumption.
 rewrite (rev_app_app dni (Undecorated (NImp a0 a1 b) :: ni)).
apply le_ni_app_dn; try assumption.
 rewrite <- eq_ni3; try assumption.
 rewrite <- (rev_app_app dni ni).
 rewrite <- dni_ni_eq; assumption.
assumption.
assumption.
(* side premisses: Elim (fail0 ... )  *)
simpl in |- *.
 rewrite (rev_app_app dni (Decorated (NImp a0 a1 b) k :: ni)).
apply le_ni_app_dd.
assumption.
 rewrite <- eq_ni3; try assumption.
 rewrite <- (rev_app_app dni ni).
 rewrite <- dni_ni_eq; assumption.
apply deco_sound_shift_work_nirni.
apply k_deco_sound_intro; try assumption.
apply forces_ngamma_shift_work_ni_x_ni.
 rewrite <- eq_ni3.
apply forces_ngamma_cons_work_weak2 with (AImp a1 b) (NAtom a0).
assumption.
intros; simpl in |- *; apply forces_a1_imp_b__forces_a0_imp_a1_imp_b_t;
 assumption.
apply forces_ngamma_eqv with ni2; try assumption.
intros forces_a0a1.
apply k_nonforces_goal.
apply forces_a_a_imp_b__forces_b_t with (Atom a0); try assumption.
apply k_forces_ngamma with (c := NAtom a0).
apply in_ngamma_cons_work_tail.
apply in_ngamma_cons_work_head.
 rewrite <- eq_ni3.
apply deco_sound_inf with dni_ni ni2; try assumption.
 rewrite dni_ni_eq.
 rewrite (rev_app_app dni ni).
apply deco_sound_shift_ni_x_ni_work with (x := Undecorated (NImp a0 a1 b));
 try assumption.
 rewrite <- (rev_app_app dni (Undecorated (NImp a0 a1 b) :: ni)); assumption.
apply deco_sound_cons_work_weak2 with (AImp a1 b) (NAtom a0); try assumption.
intros; simpl in |- *; apply forces_a1_imp_b__forces_a0_imp_a1_imp_b_t;
 assumption.

unfold nsound in |- *.
intros c in_ngamma.
apply sound.
elim in_ngamma; clear in_ngamma c.
intros n x nth; apply In_Work with n; assumption.
intros n i j nth; apply In_Disjs with n; assumption.
intros n x nth; apply In_Nested_Imps with n.
 rewrite <-
 (eqv_nimps_eq (ni31 ++ Decorated (NImp a0 a1 b) k :: ni32)
    (rev_app dni (Undecorated (NImp a0 a1 b) :: ni)))
 .
assumption.
 rewrite (rev_app_app dni (Undecorated (NImp a0 a1 b) :: ni)).
apply le_eqv.
apply le_ni_app_dn.
assumption.
 rewrite <- eq_ni3.
 rewrite <- (rev_app_app dni ni).
 rewrite <- dni_ni_eq.
assumption.
intros i b0 n bs lookup0 nth.
apply In_Atomic_Imps with n bs; assumption.
intros i lookup; apply In_Atoms; assumption.

apply nminimal_shift_work_ni_x_ni.
 rewrite <- eq_ni3.
apply nminimal_eqv with dni_ni; try assumption.
apply ge_eqv; assumption.
 rewrite dni_ni_eq.
 rewrite (rev_app_app dni ni).
apply nminimal_shift_ni_x_ni_work with (x := Undecorated (NImp a0 a1 b));
 try assumption.
 rewrite <- (rev_app_app dni (Undecorated (NImp a0 a1 b) :: ni)); assumption.
 rewrite <- (rev_app_app dni ni).
 rewrite <- dni_ni_eq; assumption.
apply eqv_ni_trans with ni1.
apply le_eqv; assumption.
apply ge_eqv; assumption.
 rewrite <- dni_ni_eq; assumption.

(* side premiss: Elim left_premiss with ni1 dni1 H0 H1  *)
clear right_premiss fail0.
apply deco_sound_cons_work_strength with (NImp_NF (NImp a0 a1 b)).
intros; simpl in |- *.
apply forces_a0_imp_a1_imp_b__forces_a1_imp_b_t with (Atom a0);
 try assumption.
apply H0 with (c := NAtom a0).
apply in_ngamma_cons_work_tail.
apply in_ngamma_cons_work_head.
apply H0 with (c := NImp_NF (NImp a0 a1 b)).
apply in_ngamma_cons_work_head.
apply deco_sound_shift_ni_work with (x := Undecorated (NImp a0 a1 b)).
apply deco_sound_filter_deco; try assumption.
intros x k in_x.
apply forces_a0 with x.
inversion_clear in_x.
 discriminate H.
assumption.
apply deco_sound_shift_work_ni0.
apply deco_sound_le with dni_ni.
assumption.
 rewrite dni_ni_eq.
 rewrite (rev_app_app dni ni).
apply deco_sound_shift_ni_x_ni_work with (x := Undecorated (NImp a0 a1 b));
 try assumption.
 rewrite <- (rev_app_app dni (Undecorated (NImp a0 a1 b) :: ni)); assumption.

apply nsound_le with dni_ni; try assumption.
apply nsound_cons_work_weak with (NImp_NF (NImp a0 a1 b)).
intros der.
elim der; clear der; intros t der_t.
apply
 Derivable_Intro
  with
    (Abs (Atom a1)
       (App (Imp (Atom a0) (Atom a1)) (Shift t)
          (Abs (Atom a0) (Shift (Var 0))))).
simpl in |- *; apply ImpIntro.
apply ImpElim.
apply ShiftIntro; assumption.
apply ImpIntro.
apply ShiftIntro.
apply ByAssumption; apply My_NthO.
 rewrite dni_ni_eq.
 rewrite (rev_app_app dni ni).
apply nsound_shift_ni_x_ni_work with (x := Undecorated (NImp a0 a1 b)).
apply nsound_cons_work_cons_context with (c := NAtom a0); try assumption.
 rewrite <- (rev_app_app dni (Undecorated (NImp a0 a1 b) :: ni)); assumption.

apply nminimal_eqv with dni_ni.
apply le_eqv; assumption.
apply nminimal_cons_work_strength with (NImp_NF (NImp a0 a1 b)).
intros k k_is_mon k_forces_ngamma.
simpl in |- *; apply forces_a1_imp_b__forces_a0_imp_a1_imp_b_t;
 try assumption.
apply k_forces_ngamma with (c := NAtom a0).
apply in_ngamma_cons_work_tail.
apply in_ngamma_cons_work_head.
change (forces_t k (nf2form (AImp a1 b))) in |- *.
apply k_forces_ngamma.
apply in_ngamma_cons_work_head.
 rewrite dni_ni_eq.
 rewrite (rev_app_app dni ni).
apply nminimal_shift_ni_x_ni_work with (x := Undecorated (NImp a0 a1 b)).
apply nminimal_cons_work_cons_context with (c := NAtom a0); try assumption.
 rewrite <- (rev_app_app dni (Undecorated (NImp a0 a1 b) :: ni)); assumption.
Qed.


Require Import Crypto.Specific.Framework.RawCurveParameters.
Require Import Crypto.Util.LetIn.

(***
Modulus : 2^383 - 421
Base: 47.875
***)

Definition curve : CurveParameters :=
  {|
    sz := 8%nat;
    base := 47 + 7/8;
    bitwidth := 64;
    s := 2^383;
    c := [(1, 421)];
    carry_chains := Some [seq 0 (pred 8); [0; 1]]%nat;

    a24 := None;
    coef_div_modulus := Some 2%nat;

    goldilocks := None;
    karatsuba := None;
    montgomery := false;
    freeze := Some true;
    ladderstep := false;

    mul_code := None;

    square_code := None;

    upper_bound_of_exponent_loose := None;
    upper_bound_of_exponent_tight := None;
    allowable_bit_widths := None;
    freeze_extra_allowable_bit_widths := None;
    modinv_fuel := None
  |}.

Ltac extra_prove_mul_eq _ := idtac.
Ltac extra_prove_square_eq _ := idtac.


Require Import Crypto.Specific.Framework.RawCurveParameters.
Require Import Crypto.Util.LetIn.

(***
Modulus : 2^137 - 13
Base: 45 + 2/3
***)

Definition curve : CurveParameters :=
  {|
    sz := 3%nat;
    base := 45 + 2/3;
    bitwidth := 64;
    s := 2^137;
    c := [(1, 13)];
    carry_chains := Some [seq 0 (pred 3); [0; 1]]%nat;

    a24 := None;
    coef_div_modulus := Some 2%nat;

    goldilocks := None;
    karatsuba := None;
    montgomery := false;
    freeze := Some true;
    ladderstep := false;

    mul_code := None;

    square_code := None;

    upper_bound_of_exponent_loose := None;
    upper_bound_of_exponent_tight := None;
    allowable_bit_widths := None;
    freeze_extra_allowable_bit_widths := None;
    modinv_fuel := None
  |}.

Ltac extra_prove_mul_eq _ := idtac.
Ltac extra_prove_square_eq _ := idtac.


Require Import List.
Require Import Classical.
Import ListNotations.
Require Import Coq.Bool.Bool.
Require Import Lia.

From Coq.Arith Require Import Compare_dec EqNat Gt Le PeanoNat.

From Scheduler.Proof Require Import Lib Assumptions JobsAxioms EdfPolicy.
From Scheduler.Model Require Import PureFunctionModels.
From Scheduler.Model.Interface.Types Require Import TypesModel Jobs.

Module FunctionalEdfImplementsAssumptionsMod (J :JobsAxiomsMod) <: AssumptionsMod J.
Import J.

Definition init : State := mk_State 0 [].

Definition functional_update_entries(s:State) : ((option nat *bool)* State) :=
  let  l :=
     filter (fun j =>  j <? N) (jobs_arriving_at s.(now))  in
let b :=
     match hd_error s.(active) with
     | Some e =>
         let j := Jobs (id e) in
         (cnt e <=? budget j - duration j)
     | None => false
     end
in
let active1 := if b  then tl s.(active) else s.(active) in
let active2 :=
       insert_all Entry
         (fun e1 e2 : Entry =>
          deadline (Jobs (id e1)) <=? deadline (Jobs (id e2)))
         (map
            (fun j  =>
             {|
             id :=  j;
             cnt := budget (Jobs j);
             del :=  (deadline (Jobs j) - (arrival (Jobs j))) |}) l) active1 in
( match active2 with
     | [] => (None, false )
     | e :: _ => (Some (id e), del e =? 0)
  end,  mk_State  s.(now) active2).

Definition decrease_all_del_func(l : list Entry) := map (fun e => {|
      id := e.(id);
      cnt := e.(cnt);
      del := pred e.(del)
     |}) l.

Definition functional_update_counters (s:State) :
  unit * State :=
  let active3 :=
       match s.(active) with
       | [] => []
       | e :: es =>
           {|
           id := id e;
           cnt := Init.Nat.pred (cnt e);
           del := del e |} :: es
       end in
let active4 :=  (decrease_all_del_func active3) in
  (tt, mk_State (S s.(now))  active4 ).

Definition functional_scheduler  (s: State)  :=
  let (r,s')  := functional_update_entries  s in
  let (_,s'') := functional_update_counters  s' in
  (r,s'').

Fixpoint running (t : nat) : (option nat * bool *State) :=
  match t with
    0 => functional_update_entries init
  | S t' => let (_,s') := running  t' in
            let (_,s'') := functional_update_counters  s' in
            functional_update_entries s''
  end.

(* for better controlled rewriting *)
Lemma running_0 :  running  0 = functional_update_entries  init.
Proof.
intros;
reflexivity.
Qed.

Lemma running_S : forall t,
    running (S t) = let (_,s') := running t in
            let (_,s'') := functional_update_counters  s' in
            functional_update_entries  s''.
Proof.
intros; reflexivity.
Qed.

Lemma  update_counters_changes_now :
  forall s o s', functional_update_counters s = (o, s') ->
                   now s' = S (now s).
Proof.
 intros.
 injection H; intros.
 rewrite <- H0; auto.
Qed.

Lemma update_entries_leaves_now :
  forall  s o s', functional_update_entries s = (o, s') ->
                   now s' = now s.
 Proof.
 intros.
 injection H; intros.
 rewrite <- H0; auto.
Qed.

Lemma time_counter_now:
  forall  t o s,  running  t = (o,s) ->  now s = t.
Proof.
  induction t; intros.
  * rewrite running_0 in H.
    remember (functional_update_entries  init) as rbs.
    destruct rbs as ((a & b) & c).
    cbn in H.
    injection H ; intros ; subst ; clear H.
    rewrite surjective_pairing in Heqrbs.
    rewrite pair_equal_spec in Heqrbs.
    destruct Heqrbs as (_ & Hs).
    rewrite Hs; auto.
  * rewrite running_S in H.
    case_eq (running t); intros.
    rewrite H0 in *.
    case_eq (functional_update_counters s0); intros.
    rewrite H1 in H.
    specialize (IHt _ _ (eq_refl _)).
    rewrite <- IHt.
    case_eq (functional_update_entries  s1) ; intros.
    rewrite H2 in H ; cbn in H.
    destruct p.
    injection H ; intros; subst.
    erewrite update_entries_leaves_now; eauto.
    erewrite update_counters_changes_now; eauto.
Qed.

Lemma ids_after_update_entries : forall s o b s' e',
    functional_update_entries s = ((o,b),s') ->
    In e' (active s') ->
       In (id e') ( filter (fun j =>  j <? N) (jobs_arriving_at s.(now)))
         \/
       In e' (active s).
Proof.
intros s o b s' e' Hfss Hin.
unfold functional_update_entries in Hfss.
remember  (insert_all Entry
              (fun e1 e2 : Entry =>
               deadline (Jobs (id e1)) <=? deadline (Jobs (id e2)))
              (map
                 (fun j : CNat =>
                  {|
                  id := j;
                  cnt := budget (Jobs j);
                  del := deadline (Jobs j) - arrival (Jobs j) |})
                 (filter (fun j : nat => j <? N) (jobs_arriving_at (now s))))
              (if
                match hd_error (active s) with
                | Some e =>
                    cnt e <=? budget (Jobs (id e)) - duration (Jobs (id e))
                | None => false
                end
               then tl (active s)
               else active s)) as ins.
destruct ins.
* injection Hfss ; intros; subst; clear Hfss.
   inversion Hin.
* injection Hfss ; intros; subst; clear Hfss.
  cbn [active] in Hin.
  rewrite Heqins in Hin.
  rewrite <- insert_all_contents_iff in Hin;
  destruct Hin as [ Hin | Hin].
 +
   rewrite in_map_iff in Hin.
   destruct Hin as (i & Heqe & Hin).
   apply f_equal with (f := id) in Heqe.
   cbn in Heqe.
   rewrite Heqe in *; auto.
 +
   right.
   remember (active s) as acs.
   destruct acs.
   - inversion Hin.
   - cbn in Hin.
          destruct
            (cnt e0 <=?
             budget (Jobs (id e0)) - duration (Jobs (id e0))) ; auto.
          apply in_tl ; auto.
Qed.

Lemma ids_after_update_counters : forall s r s' e',
  functional_update_counters s = (r,s') ->
  In e' (active s') ->
   exists e,  In e (active s) /\ id e = id e' /\ del e' = del e - 1.
Proof.
intros s r s' e' Hfss Hin.
unfold functional_update_counters in Hfss.
injection Hfss ; intros ; subst ; clear Hfss.
cbn in Hin.
remember (active s) as as0.
destruct as0.
* inversion Hin.
* cbn in Hin.
  rewrite in_map_iff in Hin.
  destruct Hin as [Heq | (e'' & Heq & Hin)].
  +
     generalize Heq ; intro Heq'.
     apply f_equal with (f := id) in Heq.
     apply f_equal with (f := del) in Heq'.
     cbn in Heq, Heq'.
     exists e; cbn ; repeat split ; auto ; lia.
  +
     generalize Heq ; intro Heq'.
     apply f_equal with (f := id) in Heq.
     apply f_equal with (f := del) in Heq'.
    cbn in Heq, Heq'.
    exists e'' ; cbn ; repeat split ; auto ; lia.
Qed.

Lemma active_from_earlier_arrivals : forall  t o s,
    running t = (o,s) ->
    forall e,
      In e (active s) ->
          exists t', t' <= t /\
                     In (id e)
                        (filter (fun j => j <? N) (jobs_arriving_at t')).
Proof.
induction t; intros (o,b)  s Hrun e Hin.
*
  rewrite running_0 in Hrun.
  exists 0 ; split; auto.
  apply ids_after_update_entries with (e' := e) in Hrun; auto.
  inversion Hrun; auto.
  inversion H.
*
  rewrite running_S in Hrun.
  case_eq (running t) ; intros (o',b') sr Hr; rewrite Hr in *.
  case_eq (functional_update_counters sr) ; intros oc sc Hc; rewrite Hc in *.
  apply ids_after_update_entries with (e' := e) in Hrun ; auto.
  destruct Hrun as [Hin' | Hin'].
 +
   exists (S t) ; split ; auto.
   replace t with (now sr) ; [| apply time_counter_now with (o := (o',b')); auto].
   apply update_counters_changes_now in Hc.
   rewrite <- Hc ; auto.
 +
   apply ids_after_update_counters with (e' := e) in Hc ; auto.
   destruct Hc as (e' & Hin'' & Heqid & _).

   specialize (IHt _ _ (eq_refl _ ) e' Hin'').
   rewrite <- Heqid.
   destruct IHt as (t' & Hle & Hin''').
   exists t' ; split; auto.
Qed.

Definition run(i t : nat) : bool :=
  match  running  t with
        (None, _,_) => false
       | (Some k, _,_) =>   (Nat.eqb i k)
  end.

Fixpoint c (i t : nat) : nat :=
  match t with
      0 => duration (Jobs i)
    | S t' => if run i t'  then (c i t') - 1 else c  i t'
  end.

Lemma  at_most_one_runs: forall (i j t : nat),
      i < N -> j < N ->
      run i t  = true -> run j t = true -> i = j.
Proof.
  intros  i j t HiN HjN Hruni Hrunj.
  unfold run in *.
  case_eq (running t) ; intros.
  rewrite H in *.
  destruct p.
  destruct o; try discriminate.
  rewrite Nat.eqb_eq in * ; subst ; auto.
Qed.

Lemma ue_return_is_first: forall s n b s',
    functional_update_entries s = (Some n, b, s')  ->
    exists e es,  s'.(active) = e::es  /\ e.(id) = n.
Proof.
intros s n b s' He.
unfold functional_update_entries in He.
remember ( insert_all Entry
            (fun e1 e2 : Entry =>
             deadline (Jobs (id e1)) <=? deadline (Jobs (id e2)))
            (map
               (fun j : CNat =>
                {|
                id := j;
                cnt := budget (Jobs j);
                del := deadline (Jobs j) - arrival (Jobs j) |})
               (filter (fun j : nat => j <? N) (jobs_arriving_at (now s))))
            (if
              match hd_error (active s) with
              | Some e =>
                  cnt e <=? budget (Jobs (id e)) - duration (Jobs (id e))
              | None => false
              end
             then tl (active s)
             else active s)) as ins.
destruct ins.
* inversion He.
* inversion He ; subst ; clear He.
  exists e, ins; repeat split; auto.
Qed.

Lemma running_is_first: forall t n b s,
    running  t = (Some n, b, s)  ->
    exists e es,  s.(active) = e::es  /\ e.(id) = n.
Proof.
 intros t n b s Hrun.
destruct t.
* rewrite running_0 in Hrun.
  eapply ue_return_is_first; eauto.
*
  rewrite running_S in Hrun.
  remember (running t) as rs ; destruct rs as ((o' & b') & s').
  remember (functional_update_counters s') as rs ; destruct rs as (r & s'').
   eapply ue_return_is_first; eauto.
Qed.

Lemma run_after_arrival :
  forall ( i t : nat), i < N ->
         run i t = true -> arrival (Jobs i) <= t.
Proof.
intros i t HiN Hrun.
unfold run in Hrun.
case_eq (running t) ; intros o' s Hrunning.
rewrite Hrunning in Hrun.
destruct o'; destruct o ; try discriminate.
rewrite Nat.eqb_eq in Hrun.
rewrite <- Hrun in *; clear Hrun.
destruct ( running_is_first  _ _ _ _ Hrunning) as (e & es & Heqe & Hine).
rewrite <- Hine in *; clear Hine.
generalize (in_eq e es) ; intro Hin.
rewrite <- Heqe in Hin.
destruct (active_from_earlier_arrivals  _ _ _ Hrunning _ Hin)
  as (t' & Hle' & Hin').
rewrite filter_In in Hin'.
destruct Hin' as (Hin' & Hlt).
rewrite jobs_arriving_at_prop in Hin'; rewrite Hin' ; auto.
Qed.

Lemma c_is_duration_upto_arrival :
  forall (i t : nat), i < N ->  t <= arrival (Jobs i) ->
                        c  i t = duration (Jobs i).
Proof.
  intros i.
  induction t ; intros HiN Ht.
  * reflexivity.
  * cbn.
    case_eq (run i t) ; intros Hcas.
  +  exfalso.
     specialize (run_after_arrival  _ _ HiN Hcas); intro Hge;lia.
  +  rewrite IHt; auto  ; lia.
Qed.

Lemma uc_effect_on_active : forall s s' r',
functional_update_counters s = (r',s') ->
map id (active s') = map id (active s).
Proof.
intros s s' r' Hfss.
unfold functional_update_counters in Hfss.
apply f_equal  with (f := snd) in Hfss ; cbn in Hfss.
remember (active s) as acts.
destruct acts.
* destruct s' ; cbn in *.
   injection Hfss  ; intros ; subst ; auto.
*  destruct s' ; cbn in *.
   destruct (Init.Nat.pred (cnt e)).
  +
    injection Hfss  ; intros ; subst; clear Hfss.
    cbn in *.
    f_equal.
    rewrite map_map.
    reflexivity.
 +
    assert( Hn : S n <> 0) ; auto.
    rewrite <- Nat.eqb_neq in Hn.
    injection Hfss  ; intros ; subst.
    cbn.
    rewrite map_map.
    reflexivity.
Qed.

Lemma active_id_after_uc_subset  : forall s s' r' e,
    functional_update_counters s = (r',s') ->
    In (id e) (map id (active s')) -> In (id e) (map id (active s)) .
Proof.
intros s s' r' e He Hin.
apply uc_effect_on_active in He.
rewrite He in Hin ; auto.
Qed.

Lemma uc_preserves_unique_id : forall s s' r',
    functional_update_counters s = (r',s') ->
    unique_for id (active s) ->
    unique_for id (active s').
Proof.
intros s s' r' Hc Hu.
unfold unique_for in *.
apply uc_effect_on_active in Hc.
rewrite Hc ; auto.
Qed.

Lemma ue_preserves_unique_id : forall s r s',
  functional_update_entries s = (r,s') ->
  unique_for id (active s) ->
   (forall e,   In (id e)
                   (filter (fun j => j <? N) (jobs_arriving_at (now s)))
                -> ~In (id e) (map id (active s)))
   ->
      unique_for id (active s').
Proof.
  intros s r s' Hue Hu HH.
  unfold functional_update_entries in Hue.
  remember  (insert_all Entry
             (fun e1 e2 : Entry =>
              deadline (Jobs (id e1)) <=? deadline (Jobs (id e2)))
             (map
                (fun j : CNat =>
                 {|
                 id := j;
                 cnt := budget (Jobs j);
                 del := deadline (Jobs j) - arrival (Jobs j) |})
                (filter (fun j : nat => j <? N) (jobs_arriving_at (now s))))
             (if
               match hd_error (active s) with
               | Some e =>
                   cnt e <=? budget (Jobs (id e)) - duration (Jobs (id e))
               | None => false
               end
              then tl (active s)
              else active s)) as ins.
destruct ins.
  * inversion Hue ; subst; clear Hue.
    cbn.
    apply NoDup_nil.
  *
    inversion Hue ; subst; clear Hue.
    cbn.
    rewrite Heqins; clear Heqins e.
    eapply insert_all_unique.
    +
      intros e Hin1 Hin2.
      rewrite map_map in Hin1.
      cbn in Hin1.
      rewrite in_map_iff in Hin1.
      destruct Hin1 as (i & Heqi & Hin1).
      cbn in HH.
      rewrite Heqi in * ; clear Heqi.
      specialize (HH _ Hin1) ; clear Hin1.
      apply HH.
      destruct (active s) ; auto.
      cbn in Hin2.
      destruct ((cnt e0 <=?
                 budget (Jobs (id e0)) - duration (Jobs (id e0)))); auto.
      apply in_tl; auto.
    +
      unfold CNat, unique_for.
      rewrite map_map, map_id.
      apply NoDup_filter.
      rewrite NoDup_nth with (d := 0).
      intros i j Hi Hj Heq.
      destruct (jobs_arriving_at_unique _ _ _ _ Hi Hj Heq); auto.
     +
      destruct (active s) ; auto.
      cbn.
      destruct ((cnt e <=?
                 budget (Jobs (id e)) - duration (Jobs (id e)))); auto.
       inversion Hu ; subst; auto.
Qed.

Lemma active_unique_for_id :
  forall t r s,  running t = (r,s) ->  unique_for id (active s).
Proof.
induction t ; intros (o,b) s Hrun.
* rewrite running_0 in Hrun.
  eapply ue_preserves_unique_id ; eauto.
  apply NoDup_nil.
*
  rewrite running_S in Hrun.
  case_eq  (running  t); intros (o'&b')  s' Hr.
  rewrite Hr in Hrun.
  case_eq (functional_update_counters s'); intros o'' s'' Hc.
  rewrite Hc in Hrun.
  remember (functional_update_entries  s'') as rbs.
  rewrite Hrun in * ; clear Hrun.
  symmetry in Heqrbs.
  specialize (IHt _ _ Hr).
  generalize Hc ; intro Hc'.
  generalize (active_from_earlier_arrivals  _ _ _ Hr) ; intros He.
  eapply uc_preserves_unique_id in Hc; eauto.
  eapply ue_preserves_unique_id in Hc; eauto.
  intros e Hin Hin'.
  rewrite in_map_iff in Hin'.
  destruct Hin' as (e' & Heqid & Hin').
  apply in_map with (f := id) in Hin'.
  eapply  active_id_after_uc_subset in Hin' ; eauto.
  rewrite Heqid in *; clear Heqid e'.
  rewrite in_map_iff in Hin'.
  destruct Hin' as (e' & Heqid & Hin').
  destruct (He _ Hin') as (t' & Hle & Hin''); clear He.
  apply time_counter_now in Hr.
  apply update_counters_changes_now in Hc'.
  rewrite Hr in Hc'.
  rewrite Hc' in Hin.
  rewrite Heqid in *.
  rewrite filter_In in Hin, Hin''.
  destruct Hin as (Hin & _).
  destruct Hin'' as (Hin'' & _).
  apply In_nth  with (d := 0) in Hin.
  apply In_nth  with (d := 0) in Hin''.
  destruct Hin as (i & Hlen & Hnth).
  destruct Hin'' as (i' & Hlen' & Hnth'').
  rewrite <- Hnth'' in Hnth.
  destruct (jobs_arriving_at_unique _ _ _ _ Hlen Hlen' Hnth); lia.
Qed.

Lemma ue_preserves_sorted_entries : forall s o b s',
    functional_update_entries s = ((o,b),s') ->
     is_sorted _ (fun x y : Entry =>
                 deadline (Jobs (id x)) <=? deadline (Jobs (id y)))
               (active s) ->
      is_sorted _ (fun x y : Entry =>
                 deadline (Jobs (id x)) <=? deadline (Jobs (id y)))
                             (active s').
Proof.
intros s o b s' Hfss Hsor.
unfold functional_update_entries in Hfss.
remember ( insert_all Entry
              (fun e1 e2 : Entry =>
               deadline (Jobs (id e1)) <=? deadline (Jobs (id e2)))
              (map
                 (fun j : CNat =>
                  {|
                  id := j;
                  cnt := budget (Jobs j);
                  del := deadline (Jobs j) - arrival (Jobs j) |})
                 (filter (fun j : nat => j <? N) (jobs_arriving_at (now s))))
              (if
                match hd_error (active s) with
                | Some e =>
                    cnt e <=? budget (Jobs (id e)) - duration (Jobs (id e))
                | None => false
                end
               then tl (active s)
               else active s)) as ins.
destruct ins.
*
  injection Hfss ; intros ; subst ; clear Hfss.
  constructor.
*
  injection Hfss ; intros ; subst ; clear Hfss.
  cbn.
  rewrite Heqins.
  apply insert_all_sorted ; auto.
 +
   intros a b; destruct a, b.
   cbn.
   case (le_gt_dec (deadline (Jobs id)) (deadline (Jobs id0))) ; intro Hcas.
   -
     left.
     rewrite Nat.leb_le ; auto.
   -
     right.
      rewrite Nat.leb_le ; lia.
 +
   remember (active s) as acs.
   destruct acs.
   -
     constructor.
   -
     cbn.
     destruct ((cnt e0 <=?
       budget (Jobs (id e0)) - duration (Jobs (id e0)))); auto.
       eapply is_sorted_tail; eauto.
Qed.

Lemma uc_preserves_sorted_entries : forall s r  s',
    functional_update_counters s = (r,s') ->
     is_sorted _ (fun x y : Entry =>
                 deadline (Jobs (id x)) <=? deadline (Jobs (id y)))
               (active s) ->
      is_sorted _ (fun x y : Entry =>
                 deadline (Jobs (id x)) <=? deadline (Jobs (id y)))
                             (active s').
Proof.
intros s r s' Hc Hsor.
unfold functional_update_counters in Hc.
injection Hc ; intros Hr Hs ; subst; clear Hc.
cbn.
remember (active s) as acs.
destruct acs.
*
  constructor.
*
  apply is_sorted_map.
  cbn in *.
  inversion Hsor ; subst;constructor ; auto.
Qed.

Lemma active_sorted : forall t r s,
    running  t  =  (r,s) ->
    is_sorted _ (fun x y : Entry =>
                 deadline (Jobs (id x)) <=? deadline (Jobs (id y)))
                             (active s).
Proof.
    induction t; intros (o,b) s Hf.
    *
      rewrite running_0 in Hf.
      eapply ue_preserves_sorted_entries in Hf; eauto.
      constructor.
    *
      rewrite running_S in Hf.
      remember (running t) as rbs.
      destruct rbs as ((r' & b') & s').
      remember (functional_update_counters s') as rs.
      destruct rs as (r'' & s'').
      symmetry in Heqrs, Heqrbs.
      eapply ue_preserves_sorted_entries ; eauto.
      eapply uc_preserves_sorted_entries ; eauto.
Qed.

Lemma ue_effect_on_cnt : forall s o b s',
    functional_update_entries s = (o,b,s') ->
   (forall e,  In e  (tl (active s) )->
            cnt e > budget (Jobs (id e)) - duration (Jobs (id e))) ->
   forall e',  In e' (active s')->
                 cnt e' > budget (Jobs (id e')) - duration (Jobs (id e')).
Proof.
intros s o b s' Hfss Hcnt e' Hin'.
unfold functional_update_entries in Hfss.
remember ( insert_all Entry
              (fun e1 e2 : Entry =>
               deadline (Jobs (id e1)) <=? deadline (Jobs (id e2)))
              (map
                 (fun j : CNat =>
                  {|
                  id := j;
                  cnt := budget (Jobs j);
                  del := deadline (Jobs j) - arrival (Jobs j) |})
                 (filter (fun j : nat => j <? N) (jobs_arriving_at (now s))))
              (if
                match hd_error (active s) with
                | Some e =>
                    cnt e <=? budget (Jobs (id e)) - duration (Jobs (id e))
                | None => false
                end
               then tl (active s)
               else active s))
         as ins.
destruct ins;  injection Hfss; intros; subst ; clear Hfss  ; [inversion Hin' | ].
cbn [active] in Hin'.
rewrite Heqins in Hin'.
rewrite <- insert_all_contents_iff in Hin'.
destruct Hin' as [Hin' | Hin'].
*
  rewrite in_map_iff in Hin'.
  destruct Hin' as (i & Heqi & _).
  generalize Heqi ; intro Heqi'.
  apply f_equal with (f := id) in Heqi ; cbn in Heqi.
  apply f_equal with (f := cnt) in Heqi' ; cbn in Heqi'.
  rewrite Heqi in * ; clear Heqi.
  rewrite <- Heqi'; clear Heqi'.
  generalize (job_duration_gt_0 (id e')), (job_budget_enough (id e')) ;
        intros;  lia.
*
  remember (active s) as acs.
  destruct acs ; [inversion Hin'|].
  cbn [hd_error tl] in *.
  remember (cnt e0 <=? budget (Jobs (id e0)) - duration (Jobs (id e0))) as b.
  destruct b.
  +
    apply Hcnt ; auto.
  +
    symmetry in Heqb.
    rewrite Nat.leb_gt in Heqb.
    inversion Hin' ; subst  ; auto.
Qed.

Lemma uc_effect_on_cnt: forall s r s',
  functional_update_counters s = (r,s') ->
   (forall e,  In e  (active s) ->
                 cnt e > budget (Jobs (id e)) - duration (Jobs (id e)))
  -> (forall e',  In e' (tl (active s'))->
                 cnt e' > budget (Jobs (id e')) - duration (Jobs (id e'))).
Proof.
intros s r s' Hfc Hcnt e' Hin'.
unfold functional_update_counters in Hfc.
injection Hfc ; intros Hs' _ ; clear Hfc.
rewrite <- Hs' in Hin' ; clear Hs' s' ; cbn [active]  in Hin'.
remember (active s) as acs.
destruct acs ; [inversion Hin' |].
unfold decrease_all_del_func in Hin'.
cbn in Hin'.
rewrite in_map_iff in Hin'.
destruct Hin' as (e'' & Heqi & Hin').
cbn in Hin'.
generalize Heqi ; intro Heqi'.
apply f_equal with (f := cnt) in Heqi ; cbn in Heqi.
apply f_equal with (f := id) in Heqi' ; cbn in Heqi'.
rewrite <- Heqi, <- Heqi' in * ; clear Heqi Heqi'.
 apply Hcnt.
 constructor 2 ; auto.
Qed.

Lemma in_active_gt_budget_min_duration : forall  t s r,
    running t = (r,s) ->
    forall e,
      In e (active s) -> cnt e > budget (Jobs (id e)) - duration (Jobs (id e)).
Proof.
induction t ; intros s (o,b) Hrun e Hin.
*
  rewrite running_0 in Hrun.
  generalize Hrun ; intro Hrun'.
  eapply  ue_effect_on_cnt ; eauto ; intros e0 Hin' ; inversion Hin'.
*
  rewrite running_S in Hrun.
  remember (running t) as rbs.
  destruct rbs as ((o' & b') & s').
  remember (functional_update_counters s') as rs.
  destruct rs as (r & s'').
  symmetry in Heqrs, Heqrbs.
  eapply ue_effect_on_cnt ; eauto.
  eapply uc_effect_on_cnt; eauto.
Qed.

Lemma running_is_first': forall t r  b s e es,
    running  t = ((r,b),s)  ->
    s.(active) = e::es -> r = Some (id e).
Proof.
  intros  t r b' s e es  Hrun Hact.
  destruct t.
  *
    rewrite running_0 in Hrun.
    remember (functional_update_entries init) as rbs.
    destruct rbs as ((r' & b) & s').
    injection Hrun ; intros Hs Ho ; rewrite <- Hs in *;
      clear Hs Hrun; cbn.
    rewrite surjective_pairing in Heqrbs.
    rewrite pair_equal_spec in Heqrbs.
    destruct Heqrbs as (Hr & Hs).
    rewrite Hs in *.
    cbn in *.
    rewrite Hact in *; auto.
    injection Hr  ; intros ; subst ; auto.
  *
    rewrite running_S in Hrun.
    case_eq  (running  t); intros o s' Hr.
    rewrite Hr in Hrun.
    case_eq (functional_update_counters  s'); intros o'' s'' Hc.
    rewrite Hc in Hrun.
    remember (functional_update_entries  s'') as rbs.
    destruct rbs as ((r' & b) & s''').
    injection Hrun ; intros Hs Ho ; rewrite <- Hs in *;
      clear Hs Hrun; cbn.
    rewrite surjective_pairing in Heqrbs.
    rewrite pair_equal_spec in Heqrbs.
    destruct Heqrbs as (Hr' & Hs).
    rewrite Hs in *.
    cbn in *.
    rewrite Hact in *; auto.
    injection Hr' ; intros ; subst ; auto.
Qed.

Lemma ue_preserves_c_prop : forall s o b s',
    functional_update_entries s = (o,b,s') ->
    (forall e,
        In e (active s) ->
        cnt e  =  c (id e) (now s) + (budget (Jobs (id e)) - duration (Jobs (id e)))) ->
    forall e',
      In e' (active s') ->
        cnt e'  =  c (id e') (now s') + (budget (Jobs (id e')) - duration (Jobs (id e'))).
Proof.
intros s o b s' Hfss Hcnt e' Hin'.
erewrite update_entries_leaves_now ; eauto.
unfold functional_update_entries in Hfss.
remember (insert_all Entry
              (fun e1 e2 : Entry =>
               deadline (Jobs (id e1)) <=? deadline (Jobs (id e2)))
              (map
                 (fun j : CNat =>
                  {|
                  id := j;
                  cnt := budget (Jobs j);
                  del := deadline (Jobs j) - arrival (Jobs j) |})
                 (filter (fun j : nat => j <? N) (jobs_arriving_at (now s))))
              (if
                match hd_error (active s) with
                | Some e =>
                    cnt e <=? budget (Jobs (id e)) - duration (Jobs (id e))
                | None => false
                end
               then tl (active s)
               else active s)) as ins.
destruct ins ;  injection Hfss ; intros ; subst ; clear Hfss ; [inversion Hin'|].
cbn [active] in Hin'.
rewrite Heqins in Hin' ; clear Heqins.
rewrite <- insert_all_contents_iff in Hin'.
destruct Hin' as [Hin' | Hin'].
*
  rewrite in_map_iff in Hin'.
  destruct Hin' as (i & Heqi & Hin').
  generalize Heqi ; intro Heqi'.
  apply f_equal with (f := id) in Heqi ; cbn in Heqi.
  apply f_equal with (f := cnt) in Heqi'; cbn in Heqi'.
  rewrite <- Heqi, <- Heqi' in * ; clear Heqi Heqi'.
  rewrite filter_In in Hin'.
  destruct Hin' as  (Hin' & HiN).
  rewrite jobs_arriving_at_prop in Hin'.
  rewrite NPeano.Nat.ltb_lt in HiN.
  generalize (job_budget_enough i) ; intros Hen.
  rewrite c_is_duration_upto_arrival; auto; lia.
*
  apply Hcnt.
  remember (active s) as acs ; destruct acs; [inversion Hin' |].
  cbn [hd_error] in Hin'.
  destruct (cnt e0 <=? budget (Jobs (id e0)) - duration (Jobs (id e0))) ; auto.
  apply in_tl ; auto.
Qed.

Lemma uc_preserves_c_prop : forall s r s',
    functional_update_counters s = (r,s') ->
    (forall e ,  hd_error (active s) = Some e -> run (id e) (now s) = true) ->
    (forall e ,  In e  (tl (active s )) -> run (id e) (now s) = false) ->
    (forall e ,  In e (active s) -> cnt e > budget (Jobs (id e)) - duration (Jobs (id e))) ->
    (forall e,
        In e (active s) ->
        cnt e  =  c (id e) (now s) + (budget (Jobs (id e)) - duration (Jobs (id e)))) ->
    forall e',
      In e' (active s') ->
        cnt e'  =  c (id e') (now s') + (budget (Jobs (id e')) - duration (Jobs (id e'))).
Proof.
intros s r s'  Hc Hhd Htl Hinv Hcnt e' Hin'.
erewrite update_counters_changes_now ; eauto.
unfold functional_update_counters in Hc.
injection Hc  ; intros Hr  Hs ; subst; clear Hc.
cbn [active] in Hin'.
unfold decrease_all_del_func in Hin'.
rewrite in_map_iff in Hin'.
destruct Hin' as (e & Heqe & Hin').
generalize Heqe ; intro Heqe'.
apply f_equal with (f := id) in Heqe; cbn in Heqe.
apply f_equal with (f := cnt) in Heqe'; cbn in Heqe'.
rewrite <- Heqe, <- Heqe' ; clear Heqe Heqe'.
remember (active s) as acs  ; destruct acs ; inversion Hin' ; subst; cbn ; clear Hin'.
*
  specialize (Hcnt _ (in_eq _ _)).
  specialize (Hinv _ (in_eq _ _)).
  specialize (Hhd _ (eq_refl _)).
  rewrite Hhd.
  lia.
*
  specialize (Htl _ H).
  rewrite Htl.
  apply Hcnt.
  constructor 2; auto.
Qed.

  Lemma in_active_cnt_c: forall t s r b,
    running  t = ((r,b),s) ->
    forall e,
      In e (active s) ->  cnt e  =  c (id e) t + (budget (Jobs (id e)) - duration (Jobs (id e))).
Proof.
induction t ; intros s r b0 Hrun e Hin.
*
  replace 0 with (now s) ; [| erewrite time_counter_now; eauto].
  rewrite running_0 in Hrun.
  eapply ue_preserves_c_prop ; eauto.
  intros e0 Hin' ; inversion Hin'.
*
   replace (S t) with (now s) ; [| erewrite time_counter_now; eauto].
   rewrite running_S in Hrun.
   remember (running t) as rbs.
   destruct rbs as ((o' & b') & s').
   symmetry in Heqrbs.
   remember (functional_update_counters s') as rs.
   destruct rs as (r' & s'').
   symmetry in Heqrs.
   eapply ue_preserves_c_prop ; eauto.
   intros e' Hin'.
   specialize (IHt _ _ _ (eq_refl _)).
   eapply uc_preserves_c_prop ; eauto.
  +
    intros e0 Hhd.
    destruct  (ids_after_update_counters  _ _ _ _ Heqrs Hin') as (e'' & Hin'' & Heq'' & _).
    remember (active s') as acs ; destruct acs  ; [inversion Hin''|].
    injection Hhd ; intros ; subst ; clear Hhd.
    unfold run.
    erewrite time_counter_now; eauto.
    rewrite Heqrbs.

    symmetry in Heqacs.
    generalize (running_is_first' _ _ _ _ _ _ Heqrbs Heqacs) ; intro Hsom.
    rewrite Hsom.
    apply Nat.eqb_refl.
  +
    intros e0 Htl.
    destruct  (ids_after_update_counters  _ _ _ _ Heqrs Hin') as (e'' & Hin'' & Heq'' & _).
     unfold run.
     erewrite time_counter_now; eauto.
     rewrite Heqrbs.
     remember (active s') as acs ; destruct acs  ; [inversion Hin''|].
     generalize (running_is_first' _ _ _ _ _ _ Heqrbs (sym_eq Heqacs)) ; intro Hsom.
     cbn in Htl.
     rewrite Hsom, Nat.eqb_neq.
     generalize  (active_unique_for_id _ _ _ Heqrbs) ; intro Hun.
     rewrite <- Heqacs in Hun.
     inversion Hun ; subst.
     intro Heq.
     apply H1 ; clear H1.
     rewrite <- Heq.
     rewrite in_map_iff.
     now exists e0.
  +
    eapply in_active_gt_budget_min_duration;  eauto.
  +
    intros e0 Hin0.
     erewrite time_counter_now; eauto.
Qed.

(* in_active_cnt_c *)
Lemma in_active_c_gt_0: forall t s r b,
    running  t = (r,b,s) ->
    forall e,
      In e (active s) ->  c  (id e) t > 0.
Proof.
  intros  t s r b Hrun e Hin.
  specialize (in_active_cnt_c  _ _ _ _ Hrun _ Hin); intro Hnct.
  specialize (in_active_gt_budget_min_duration   _ _ _ Hrun _ Hin);
    intro Hgt.
  lia.
Qed.

Lemma notrunning_when_c_0 :  forall  i t,  i < N ->
                                            c i t = 0 -> run  i t = false.
 Proof.
 intros  i t HiN Hc0.
 unfold run.
 case_eq (running t); intros (r,o) s Hr.
 destruct r ; auto.
 rewrite Nat.eqb_neq.
 intro Heq ; subst.
 destruct (running_is_first  _ _ _ _ Hr) as (e & es & Hact & Heq).
 rewrite <- Heq in * ; clear Heq.
 assert (Hin : In e (active s)) ; [rewrite Hact ; constructor ; auto |].
 generalize (in_active_c_gt_0  _ _ _ _ Hr _ Hin); intro; lia.
Qed.

Lemma c_decreases_when_running : forall (i t : nat), i < N ->
      run i t  = true -> (c  i t  > 0 /\
                        c i (S t)  = c  i t - 1).
Proof.
  intros  i t HiN Hrun.
  case (le_gt_dec t (arrival (Jobs i))); intros Hcas.
  *apply  c_is_duration_upto_arrival  in Hcas; auto.
   split.
   + generalize (job_duration_gt_0 i); intro Hgt; lia.
   + cbn.
         rewrite Hcas.
         rewrite Hrun; auto.
  * case_eq (c i t) ; intros.
       +
          apply notrunning_when_c_0  in H ; auto.
          rewrite H in Hrun ; discriminate.
       + repeat split ; auto with arith.
         cbn.
         rewrite H, Hrun; lia.
Qed.

Lemma c_constant_when_not_running : forall (i t : nat), i < N ->
      run  i t  = false -> c i (S t) = c i t.
Proof.
intros  i t HiN Hrun.
cbn.
rewrite Hrun; auto.
Qed.

Lemma fss_arrived_now_in_next_active :
forall s  r b s' i,
  functional_update_entries s = (r, b, s') ->
  i < N ->
  arrival (Jobs i) = (now s') ->
  exists e : Entry, In e (active s') /\ id e = i.
Proof.
intros s r b s' i Hfss HiN Harr.
erewrite  update_entries_leaves_now in Harr ;eauto.
rewrite <- jobs_arriving_at_prop in Harr.
rewrite <- Nat.ltb_lt in HiN.
assert (Hfil :  In i (filter (fun j : nat => j <? N) (jobs_arriving_at (now s))));
  [rewrite filter_In; auto| clear Harr].
exists {|  id := i ; cnt := budget (Jobs i);   del := deadline (Jobs i) - arrival (Jobs i) |};
  split ; auto.
remember ( (if
                match hd_error (active s) with
                | Some e =>
                    cnt e <=? budget (Jobs (id e)) - duration (Jobs (id e))
                | None => false
                end
               then tl (active s)
               else active s)) as l.
remember (insert_all Entry
              (fun e1 e2 : Entry =>
               deadline (Jobs (id e1)) <=? deadline (Jobs (id e2)))
              (map
                 (fun j : CNat =>
                  {|
                  id := j;
                  cnt := budget (Jobs j);
                  del := deadline (Jobs j) - arrival (Jobs j) |})
                 (filter (fun j : nat => j <? N) (jobs_arriving_at (now s))))
              l) as ins.
unfold functional_update_entries in Hfss.
rewrite <- Heql, <- Heqins in Hfss.
replace (active s') with ins.
*
  rewrite Heqins.
  rewrite <- insert_all_contents_iff.
  left.
  rewrite in_map_iff.
  now exists i.
*
  destruct ins;  injection Hfss; intros ; subst; auto.
Qed.

  Lemma ids_after_update_counters_rev :
    forall t o b (s : State) (r : unit) (s' : State) (e : Entry),
       running t = (o,b,s) ->
       functional_update_counters s = (r, s') ->
       In e (active s) ->
       exists e' : Entry,
         In e' (active s') /\
         id e = id e' /\
         (run (id e) (now s) = true -> cnt e' = pred (cnt e)) /\
         (run (id e) (now s) = false -> cnt e = cnt e').
Proof.
intros t o b s r s' e Hrun Hc Hin.
unfold functional_update_counters in Hc.
injection Hc ; intros Hs Hr ; clear Hc Hr.
rewrite <- Hs; cbn ; clear Hs.
unfold decrease_all_del_func.
remember (active s) as acs.
destruct acs ; inversion Hin; subst ; cbn.
*
  exists ({|
     id := id e;
     cnt := Init.Nat.pred (cnt e);
     del := Init.Nat.pred (del e) |}).
  cbn.
  repeat split ; auto ; intro Hr; try lia.
  exfalso.
  symmetry in Heqacs.
  generalize (running_is_first' _ _ _ _ _  _ Hrun Heqacs); intro Hsom.
  unfold run in Hr.
  erewrite  time_counter_now in Hr ; eauto.
  rewrite Hrun in Hr.
  rewrite Hsom in Hr.
  apply beq_nat_false in Hr.
  apply Hr ; auto.
*
  symmetry in Heqacs.
  generalize (running_is_first' _ _ _ _ _  _ Hrun Heqacs); intro Hsom.
  exists ({|
              id := id e;
     cnt :=  (cnt e);
     del := Init.Nat.pred (del e) |}).
  cbn.
  repeat split ; auto; try lia.
  +

    right.
    rewrite in_map_iff.
    now exists e.
  +
    intro Hr.
    exfalso.
   unfold run in Hr.
   erewrite  time_counter_now in Hr ; eauto.
   rewrite Hrun in Hr.
   rewrite Hsom in Hr.
   rewrite Nat.eqb_eq in Hr.
   apply active_unique_for_id in Hrun.
   unfold unique_for in Hrun.
   rewrite Heqacs in Hrun.
   cbn in Hrun.
   rewrite NoDup_cons_iff in Hrun.
   destruct Hrun as (Hin' & _).
   apply Hin'.
   rewrite in_map_iff.
   now exists e.
Qed.

Lemma ue_keeps_entries_with_enough_cnt : forall s o b s' e,
functional_update_entries s = (o, b, s') ->
In e (active s) ->
cnt  e >  (budget (Jobs (id e)) - duration (Jobs (id e)))
 ->
 In e (active s').
Proof.
intros s o b s' e Hfss Hin Hnct.
unfold functional_update_entries in Hfss.
remember (insert_all Entry
              (fun e1 e2 : Entry =>
               deadline (Jobs (id e1)) <=? deadline (Jobs (id e2)))
              (map
                 (fun j : CNat =>
                  {|
                  id := j;
                  cnt := budget (Jobs j);
                  del := deadline (Jobs j) - arrival (Jobs j) |})
                 (filter (fun j : nat => j <? N) (jobs_arriving_at (now s))))
              (if
                match hd_error (active s) with
                | Some e =>
                    cnt e <=? budget (Jobs (id e)) - duration (Jobs (id e))
                | None => false
                end
               then tl (active s)
               else active s)) as ins.
destruct ins.
*
 remember (active s) as acs.
 destruct acs ; inversion Hin ; subst.
 +
   cbn [hd_error  tl] in Hfss, Heqins.
   unfold gt in Hnct.
   rewrite <- Nat.leb_gt in Hnct.
   rewrite Hnct in *.
   exfalso.
   generalize  (in_nil) ; intro Hnil.
   generalize (Hnil Entry e) ; intro Hin' ; apply Hin'.
   rewrite Heqins.
   rewrite <- insert_all_contents_iff.
   right ; auto.
 +
   cbn [hd_error  tl] in Hfss, Heqins.
   exfalso.
   generalize  (in_nil) ; intro Hnil.
   generalize (Hnil Entry e) ; intro Hin' ; apply Hin'.
   rewrite Heqins.
   rewrite <- insert_all_contents_iff.
   right ; auto.
   destruct (cnt e0 <=? budget (Jobs (id e0)) - duration (Jobs (id e0))); auto.

 * injection Hfss ; intros ; subst; clear Hfss.
   cbn [active].
   rewrite Heqins  ; clear Heqins.
   rewrite <- insert_all_contents_iff.
   right.
   destruct (active s) ; inversion Hin; subst.
   +
     cbn [hd_error  tl].
      unfold gt in Hnct.
      rewrite <- Nat.leb_gt in Hnct.
      rewrite Hnct ; auto.
   +
     cbn [hd_error  tl].
     destruct (cnt e1 <=? budget (Jobs (id e1)) - duration (Jobs (id e1))); auto.
Qed.

   Lemma arrived_now_active : forall  t i,
      i < N -> arrival (Jobs i) <= t -> c  i t > 0 ->
      forall r s b , running  t = (r,b,s) ->
                   exists e, In e (active s) /\ id e = i.
Proof.
induction t ; intros i HiN Harr Hcgt r s b Hr.
*
  assert (Harr' : arrival (Jobs i) = 0) ; [lia | clear Harr ; rename Harr' into Harr].
  erewrite <- time_counter_now in Harr ; eauto.
  eapply fss_arrived_now_in_next_active ; eauto.
*
  generalize (time_counter_now _ _ _ Hr) ; intro Hnow.
  rewrite running_S in Hr.
  remember (running t) as rbs.
  destruct rbs as ((r' & b') & s').
  remember (functional_update_counters s') as rs.
  destruct rs as  (r'' & s'').
  symmetry in Heqrbs, Heqrs.
  apply le_lt_eq_dec in Harr.
  destruct Harr as [Hlt | Heq].
  +
    apply le_S_n in Hlt.
    specialize (IHt _ HiN Hlt).
    cbn in Hcgt.
    remember (c i t) as cit.
    destruct cit.
    -
      destruct (run i t) ; lia.
    -
      cbn in Hcgt.
      replace (cit - 0) with cit in Hcgt ; try lia.
      specialize (IHt (gt_Sn_O _) _ _ _ (eq_refl _)).
      destruct IHt as (e' & Hin' & Heq').
      destruct (ids_after_update_counters_rev  _ _ _ _ _ _ _ Heqrbs Heqrs Hin') as
          (e'' & Hin'' & Heq'' & Hle & Hle').
      erewrite time_counter_now in Hle, Hle'; eauto.
      exists e'' ; split ; try congruence.
      rewrite Heqcit in Hcgt.
      remember (run i t) as runit.
      destruct runit ; symmetry in Heqrunit.
      **
        generalize (in_active_cnt_c _ _ _ _ Heqrbs _ Hin') ; intro Hcnt.
        eapply ue_keeps_entries_with_enough_cnt; eauto.
        rewrite <- Heq'',Heq' in *.
        specialize (Hle Heqrunit).
        rewrite <- Heqcit in Hcnt.
        lia.
      **
         generalize (in_active_cnt_c _ _ _ _ Heqrbs _ Hin') ; intro Hcnt.
         eapply ue_keeps_entries_with_enough_cnt; eauto.
        rewrite <- Heq'',Heq' in *.
        specialize (Hle' Heqrunit).
        rewrite <- Heqcit in Hcnt.
        lia.
  +
    eapply  fss_arrived_now_in_next_active ; eauto.
    rewrite Hnow; auto.
Qed.

Lemma in_active_id_lt_N : forall t r s,
  running t = (r,s) ->
   forall e, In e (active s) -> id e < N.
Proof.
  intros t r s Hrun e Hin.
  destruct (active_from_earlier_arrivals  _ _ _ Hrun _ Hin)
    as (t' &  _  & Hin').
  rewrite filter_In in Hin'.
  destruct Hin' as (_ & Hide).
  rewrite Nat.ltb_lt in Hide; auto.
Qed.

  Lemma all_arrived_some_running :  forall  t i,
      i < N -> arrival (Jobs i) <= t -> c  i t > 0 ->
      exists j, j < N /\ run  j t = true.
Proof.
  intros t i HiN Harr Hc.
  case_eq (running  t) ; intros (r,b') s Hr.
  destruct (arrived_now_active  _ _ HiN Harr Hc _ _ _ Hr)
    as (e & Hin & _).
  unfold run.
  rewrite Hr.
  remember (active s) as acts.
  destruct acts; [inversion Hin | ].
  symmetry in Heqacts.
  rewrite (running_is_first'  _ _ _ _ _ _ Hr Heqacts) in *.
  exists (id e0) ; split ; auto;  [| rewrite Nat.eqb_eq; auto].
  eapply in_active_id_lt_N; eauto.
  rewrite  Heqacts ; constructor ; auto.
Qed.

Definition sum_counters_arrived( t : nat) :=
    generic_sum
      (fun i  => c i t)
        (fun i  => arrival(Jobs i) <=? t)
        0 N.

Lemma sum_arrived_some_running : forall  t,
      sum_counters_arrived  t > 0 ->
      exists j, j < N /\ run j t = true.
  Proof.
  intros  t Hsum.
  apply generic_sum_gt_0_ex in Hsum; auto with arith.
  destruct Hsum as (k & HkN & Harr & Hc).
  rewrite Nat.leb_le in Harr.
  apply all_arrived_some_running with (i := k); auto.
  Qed.

End FunctionalEdfImplementsAssumptionsMod.

Module FunctionalEdfIsCorrectMod (J : JobsAxiomsMod).

Import J.
Module Alg := FunctionalEdfImplementsAssumptionsMod J.
Module Pol :=  EdfPolicyMod J Alg.
Import Alg.
Import Pol.

Fixpoint functional_scheduler_star (t: nat):=
  match t with
    0 => ((None,false),init)
  |S t' =>
   let (_,s') := functional_scheduler_star  t' in
   functional_scheduler  s'
  end.

Lemma functional_scheduler_star_0 :
    functional_scheduler_star 0 = ((None,false),init).
Proof.
reflexivity.
Qed.

Lemma functional_scheduler_star_S : forall  t,
    functional_scheduler_star (S t) =
     let (_,s') := functional_scheduler_star t in
     functional_scheduler s'.
Proof.
reflexivity.
Qed.

Lemma fss_running : forall t,
    functional_scheduler_star (S t) =
    let (r,s) := running t in
    let (_,s') := functional_update_counters s  in (r,s').
Proof.
  induction t.
* case_eq (running 0) ; intros r s Hr.
  case_eq (functional_update_counters  s) ; intros o s' Hc.
  rewrite running_0 in Hr.
  rewrite functional_scheduler_star_S,functional_scheduler_star_0.
  unfold functional_scheduler.
  remember (functional_update_entries init) as rbs.
  destruct rbs as ((r' & b) & s'').
  injection Hr ; intros ; subst ; clear Hr.
  cbn.
  rewrite pair_equal_spec; split; auto.
  injection Hc ; intros Hs _ ; rewrite <- Hs in * ; auto.
* repeat rewrite functional_scheduler_star_S in *.
  (* rewrite IHt; clear IHt.*)
  rewrite running_S.
  case_eq (running  t) ; intros r s Hr.
  rewrite Hr in *.
  case_eq (functional_update_counters  s) ; intros o s' Hc.
  rewrite Hc in *.
  case_eq (functional_scheduler_star  t);intros o' s''' Hfs.
  rewrite Hfs in *.
  case_eq (functional_scheduler  s''') ; intros (o'' & b) s_ Hf.
  rewrite Hf in *.
  injection IHt ; intros ; subst.

  unfold functional_scheduler ; auto.
Qed.

Lemma run_scheduler_star : forall  i t,
  run i t = true ->
   fst (fst ((functional_scheduler_star (S t)))) = Some i.
Proof.
  intros  i t Hrun.
  case_eq (functional_scheduler_star  (S t)) ;
    intros (r & b) s Hfss.
  generalize (fss_running t); rewrite Hfss; intro Hd.
  case_eq (running t) ; intros r' s' Hr.
  rewrite Hr in *.
  case_eq (functional_update_counters  s'); intros u s'' Hc.
  rewrite Hc in *.
  cbn.
  injection Hd ; intros ; subst.
  unfold run in Hrun.
  rewrite Hr in *.
  destruct r; try discriminate.
  rewrite Nat.eqb_eq in Hrun ; subst; auto.
Qed.

Lemma scheduler_star_run : forall i t,
    fst (fst (functional_scheduler_star (S t))) = Some i ->
    run i t = true.
Proof.
  intros i t Hfss.
  case_eq (functional_scheduler_star  (S t)) ;
    intros (r & b) s Hfss'.
  rewrite Hfss' in Hfss.
  cbn in Hfss ; subst.
  generalize (fss_running  t); rewrite Hfss'; intro Hd.
case_eq (running t) ; intros (r,b')  s' Hr.
unfold run.
rewrite Hr in *.
destruct r; try discriminate.
rewrite Nat.eqb_eq.
case_eq (functional_update_counters  s') ; intros o s'' Hc.
rewrite Hc in Hd.
injection Hd; intros ; auto.
Qed.

Lemma run_iff_scheduler_star : forall i t,
    run i t = true <->
    fst (fst ((functional_scheduler_star (S t)))) = Some i.
Proof.
 split; intros.
 * apply run_scheduler_star; auto.
 * apply scheduler_star_run; auto.
Qed.

Lemma functional_scheduler_implements_policy :
  forall t o s,
 functional_scheduler_star  t = (o,s)  ->
  EdfPolicyUpTo (now s).
 Proof.
   intros  t o s Hfss.
   unfold  EdfPolicyUpTo.
   intros i t0 HiN0 Ht0now Hrun j Hw.
   destruct (Nat.eq_dec i j); subst; auto.
   destruct Hw as (HjN & Harrj  & Hcj & Hrj).
   rewrite  run_iff_scheduler_star in Hrun.
   case_eq (functional_scheduler_star  (S t0)) ;
    intros (r & b) s' Hfss'.
   rewrite Hfss' in Hrun.
   cbn in Hrun; subst.
  (*  injection Hrun ; intros; subst.  *)
    generalize (fss_running  t0); rewrite Hfss'; intro Hd.
   (*rewrite fss_running in Hrun.*)

   case_eq (running  t0) ; intros r' s'' Hr.
   rewrite Hr in Hd.
   case_eq (functional_update_counters s'') ; intros o' s''' Hc.
   rewrite Hc in Hd.
   cbn in Hd.
   injection Hd ;intros ; subst; clear Hd.
   destruct (running_is_first  _ _ _ _ Hr)
       as (e & es & Hact & Hid).
   rewrite <- Hid in * ; clear Hid.
   destruct (arrived_now_active  _ _ HjN Harrj Hcj _ _ _ Hr)
       as (e' & Hin & Hid').
   rewrite <- Hid' in * ; clear Hid'.
   rewrite Hact in Hin.
   inversion Hin.
     * exfalso ; apply n ; subst ; auto.
     * rewrite <- Nat.leb_le.
       generalize (active_sorted  _ _ _ Hr); intros Hsorted.
       rewrite Hact in *.
       apply
         (is_sorted_R_forall
            Entry
            (fun x y : Entry =>
               deadline (Jobs (id x)) <=? deadline (Jobs (id y))))
         with (l := es); auto.
       intros a b' c ; destruct a, b', c ; cbn.
       repeat rewrite Nat.leb_le.
       intros.
       eapply le_trans ; eauto.
 Qed.

Lemma functional_scheduler_correct :
  feasible ->  forall (t i: nat) r s ,
    functional_scheduler_star t = (r,s) ->
    i < N -> ~overdue  i (now s).
Proof.
intros Hf t i r s Hfss HiN.
apply  EdfPolicyMainTheorem; auto.
eapply  functional_scheduler_implements_policy; eauto.
Qed.

End FunctionalEdfIsCorrectMod.

Module FunctionalEdfErrorHandlingMod(J : JobsAxiomsMod).
 Import J.
Module Alg := FunctionalEdfImplementsAssumptionsMod J.
Module Pol :=  EdfPolicyMod J Alg.
Module Cor := FunctionalEdfIsCorrectMod J.
Import Alg.
Import Pol.
Import Cor.

Lemma update_entries_del_0 :
forall s e s',
  functional_update_entries s = (Some (id e), true,s') ->
  exists e' l,  active s' = e' :: l /\ id e' = id e /\ del e' = 0.
Proof.
  intros s e s' Hfss.
  unfold functional_update_entries in Hfss.
  remember ( insert_all Entry
              (fun e1 e2 : Entry =>
               deadline (Jobs (id e1)) <=?
               deadline (Jobs (id e2)))
              (map
                 (fun j : CNat =>
                  {|
                  id := j;
                  cnt := budget (Jobs j);
                  del := deadline (Jobs j) - arrival (Jobs j) |})
                 (filter (fun j : nat => j <? N)
                    (jobs_arriving_at (now s))))
              (if
                match hd_error (active s) with
                | Some e =>
                    cnt e <=?
                    budget (Jobs (id e)) -
                    duration (Jobs (id e))
                | None => false
                end
               then tl (active s)
               else active s)) as ins.
    destruct ins.
  *  injection Hfss ; intros ; discriminate.
  * cbn in Hfss.  injection Hfss; intros ; subst.
    cbn in *.
    exists e0, ins ; repeat split ; auto.
    apply beq_nat_eq ; auto.
Qed.

Lemma del_counts_to_deadline :  forall t o b s,
    running  t  =  (o, b ,s)  ->
       forall e,  In e (active s) ->
             del e = deadline (Jobs (id e)) - t.
Proof.
induction t  ; intros o b s  Hrun e Hin.
*  rewrite running_0 in Hrun.
   cbn in *.
   unfold functional_update_entries, init in Hrun.
   cbn in Hrun.
   remember ( insert_all Entry
              (fun e1 e2 : Entry =>
               deadline (Jobs (id e1)) <=?
               deadline (Jobs (id e2)))
              (map
                 (fun j : CNat =>
                  {|
                  id := j;
                  cnt := budget (Jobs j);
                  del := deadline (Jobs j) - arrival (Jobs j) |})
                 (filter
                    (fun j : nat =>
                     match N with
                     | 0 => false
                     | S m' => j <=? m'
                     end) (jobs_arriving_at 0))) []) as ins.
   destruct ins.
   + injection Hrun  ; intros ; subst.
       inversion Hin.
   +
      injection Hrun ; intros; subst.
      clear Hrun.
      cbn [active ]in Hin.
      rewrite Heqins in Hin.
      clear Heqins.
      rewrite <- insert_all_contents_iff in Hin.
      destruct Hin as [Hin | Habs]; [| inversion Habs].
      rewrite in_map_iff in Hin.
      destruct Hin as (i & Heq & Hin).
      rewrite <- Heq ; cbn.
      rewrite filter_In in Hin.
      destruct Hin as (Hin & _ ).
      rewrite  jobs_arriving_at_prop in Hin.
      rewrite Hin; auto.
*
  generalize Hrun; intro Hrun_cp.
  apply time_counter_now in Hrun_cp.
  rewrite <- Hrun_cp.
  clear Hrun_cp.
  rewrite running_S in Hrun.
  remember (running t) as rs.
  destruct rs as ((o',b'),s').
  remember (functional_update_counters s') as rs.
  destruct rs as (r'',s'').
  specialize (IHt _ _ _ (eq_refl _ )).
  symmetry in Heqrs, Heqrs0.
  generalize Heqrs; intro Hrun'.
  apply time_counter_now in Heqrs.
  rewrite <- Heqrs in IHt.
  clear Heqrs.
  unfold functional_update_entries in Hrun.
  remember (insert_all Entry
              (fun e1 e2 : Entry =>
               deadline (Jobs (id e1)) <=?
               deadline (Jobs (id e2)))
              (map
                 (fun j : CNat =>
                  {|
                  id := j;
                  cnt := budget (Jobs j);
                  del := deadline (Jobs j) - arrival (Jobs j) |})
                 (filter (fun j : nat => j <? N)
                    (jobs_arriving_at (now s''))))
              (if
                match hd_error (active s'') with
                | Some e =>
                    cnt e <=?
                    budget (Jobs (id e)) -
                    duration (Jobs (id e))
                | None => false
                end
               then tl (active s'')
               else active s'')) as ins.
  destruct ins.
   +
     injection Hrun ; intros ; subst.
     inversion Hin.
  +
     injection Hrun ; intros ; subst.
     cbn [active] in Hin.
     clear Hrun.
     cbn.
     rewrite Heqins in Hin.

     rewrite <- insert_all_contents_iff in Hin.
     destruct Hin as [Hin | Hin].
     -
      rewrite in_map_iff in Hin.
      destruct Hin as (i & Heq & Hin).
      rewrite <- Heq ; cbn.
      rewrite filter_In in Hin.
      destruct Hin as (Hin & _ ).
      rewrite  jobs_arriving_at_prop in Hin.
      rewrite Hin; auto.
    - assert (Hin'' : In e (active s'')).
      {
        destruct (active s'') ; auto.
        cbn in Hin.
        destruct ((cnt e1 <=?
             budget (Jobs (id e1)) -
             duration (Jobs (id e1)))) ; auto.
        constructor 2; auto.
      }

    destruct  (ids_after_update_counters _ _ _ _ Heqrs0  Hin'') as (e' & Hin' & Heq' & Hdel).
    specialize (IHt _ Hin').
    rewrite Heq' in *.
    generalize Heqrs0 ; intro Hfc.
    apply  update_counters_changes_now in Heqrs0.
    rewrite Heqrs0.
    rewrite  IHt in Hdel.
    lia.
Qed.

 Lemma running_overdue : forall t o b s i,
    running  t  =  ( (o, b) ,s) -> b = true -> o = Some i ->
    overdue i (now s).
Proof.
intros t o b s i Hrun Hb Ho.
unfold overdue.
rewrite Ho in Hrun.
destruct (running_is_first _ _ _ _ Hrun) as (e & l & Hact & Heq).
rewrite <- Heq in *.
repeat split.
* eapply in_active_id_lt_N  ; eauto.
   rewrite Hact ; constructor; auto.
* erewrite time_counter_now with (t :=t) ; eauto.
  eapply in_active_c_gt_0 ; eauto.
  rewrite Hact ; constructor; auto.
*  erewrite time_counter_now with (t :=t) ; eauto.
   assert (Hin : In e (e ::l)) ; [constructor; auto|].
    rewrite <- Hact in Hin.
    generalize (del_counts_to_deadline _ _ _ _ Hrun _ Hin); intro Hdel.
    destruct t .
+  rewrite running_0, Hb in Hrun.
     destruct (update_entries_del_0 _ _ _ Hrun) as (e' & l' & Hact'  & Hid & Hdel0).
     rewrite Hact in Hact'.
     injection Hact' ; intros ; subst.
     rewrite Hdel0 in Hdel.
     lia.
+  rewrite running_S, Hb in Hrun.
     remember (running t) as rs.
     destruct rs as (r',s').
     remember (functional_update_counters s') as rs.
     destruct rs as (r'',s'').
     destruct (update_entries_del_0 _ _ _ Hrun) as (e' & l' & Hact'  & Hid & Hdel0).
     rewrite Hact in Hact'.
     injection Hact' ; intros ; subst.
     rewrite Hdel0 in Hdel.
     lia.
Qed.

Lemma functional_scheduler_star_overdue : forall t o b s i,
    functional_scheduler_star  t  =  ( (o, b) ,s) -> b = true -> o = Some i ->
    overdue i ( now s  -1).
Proof.
intros t o b s i Hfss Hb Ho.
destruct t.
* cbn in Hfss.
  rewrite Hb in Hfss.
  inversion Hfss.
* rewrite fss_running in Hfss.
  remember (Alg.running t) as rs.
  destruct rs as ((o' & b') & s').
  remember (Alg.functional_update_counters s') as rs.
  destruct rs as (r  & s'').
  symmetry in Heqrs, Heqrs0.
  injection Hfss; intros; subst; clear Hfss.
  generalize Heqrs ; intro Hrun.
  apply running_overdue with (i := i) in Heqrs; auto.
  apply time_counter_now in Hrun.
  apply  update_counters_changes_now in Heqrs0.
  rewrite Heqrs0,  Hrun in *.
  replace (S t -1) with t ; auto ; lia.
Qed.

End  FunctionalEdfErrorHandlingMod.


Require Import Crypto.Specific.Framework.SynthesisFramework.
Require Import Crypto.Specific.solinas32_2e468m17_18limbs.CurveParameters.

Module P <: PrePackage.
  Definition package : Tag.Context.
  Proof. make_Synthesis_package curve extra_prove_mul_eq extra_prove_square_eq. Defined.
End P.

Module Export S := PackageSynthesis P.


Require Import Crypto.Specific.Framework.RawCurveParameters.
Require Import Crypto.Util.LetIn.

(***
Modulus : 2^251 - 9
Base: 25.1
***)

Definition curve : CurveParameters :=
  {|
    sz := 10%nat;
    base := 25 + 1/10;
    bitwidth := 32;
    s := 2^251;
    c := [(1, 9)];
    carry_chains := Some [seq 0 (pred 10); [0; 1]]%nat;

    a24 := None;
    coef_div_modulus := Some 2%nat;

    goldilocks := None;
    karatsuba := None;
    montgomery := false;
    freeze := Some true;
    ladderstep := false;

    mul_code := None;

    square_code := None;

    upper_bound_of_exponent_loose := None;
    upper_bound_of_exponent_tight := None;
    allowable_bit_widths := None;
    freeze_extra_allowable_bit_widths := None;
    modinv_fuel := None
  |}.

Ltac extra_prove_mul_eq _ := idtac.
Ltac extra_prove_square_eq _ := idtac.


Require Import Crypto.Specific.Framework.SynthesisFramework.
Require Import Crypto.Specific.solinas64_2e129m25_4limbs.CurveParameters.

Module P <: PrePackage.
  Definition package : Tag.Context.
  Proof. make_Synthesis_package curve extra_prove_mul_eq extra_prove_square_eq. Defined.
End P.

Module Export S := PackageSynthesis P.


From Test Require Import tactic.

Section FOFProblem.

Variable Universe : Set.
Variable UniverseElement : Universe.

Variable wd_ : Universe -> Universe -> Prop.
Variable col_ : Universe -> Universe -> Universe -> Prop.

Variable col_swap1_1 : (forall A B C : Universe, (col_ A B C -> col_ B A C)).
Variable col_swap2_2 : (forall A B C : Universe, (col_ A B C -> col_ B C A)).
Variable col_triv_3 : (forall A B : Universe, col_ A B B).
Variable wd_swap_4 : (forall A B : Universe, (wd_ A B -> wd_ B A)).
Variable col_trans_5 : (forall P Q A B C : Universe, ((wd_ P Q /\ (col_ P Q A /\ (col_ P Q B /\ col_ P Q C))) -> col_ A B C)).

Theorem pipo_6 : (forall O E Eprime A B C D U Bu Xu : Universe, ((wd_ U O /\ (wd_ O E /\ (wd_ O Eprime /\ (wd_ E Eprime /\ (wd_ A O /\ (wd_ B O /\ (wd_ C O /\ (wd_ D O /\ (wd_ U Eprime /\ (wd_ A Eprime /\ (wd_ Bu Xu /\ (wd_ B Bu /\ (col_ O E A /\ (col_ O E B /\ (col_ O E C /\ (col_ O E D /\ (col_ O E U /\ (col_ O Eprime Bu /\ (col_ O E Xu /\ col_ O Eprime D))))))))))))))))))) -> col_ O E Eprime)).
Proof.
  time tac.
Qed.

End FOFProblem.


Load LFindLoad.
From lfind Require Import LFind.
From QuickChick Require Import QuickChick.
From adtind Require Import goal33.

Derive Show for natural.

              Derive Arbitrary for natural.

              Instance Dec_Eq_natural : Dec_Eq natural.

              Proof. dec_eq. Qed.

Lemma conj17synthconj4 : forall  (lv0 : natural) (lv1 : natural) (lv2 : natural), (@eq natural (Succ (plus (plus lv0 lv1) lv2)) (plus lv1 (Succ (plus lv2 lv0)))).
Admitted.
QuickChick conj17synthconj4.


Require Export List.
Require Export Bool.
Require Export Arith.
Require Export Peano_dec.
Require Export Coq.Arith.PeanoNat.
Require Import CpdtTactics.
Require Export Coq.Program.Wf.
Require Export Coq.Program.Tactics.
Require Export Coq.Logic.FunctionalExtensionality.
Require Export Recdef.
Require Import wyv_common.
Require Import rhs_mat_tree.
Require Import rhs_mat_subtype_lhs_sel_low_reduce.
Require Import rhs_mat_subtype_lhs_sel_upp_reduce.
Require Import rhs_mat_subtype_lhs_sel_equ_reduce.
Require Import rhs_mat_subtype_lhs_sel_nom_reduce.
Require Import rhs_mat_subtype_lhs_all_reduce.
Require Import rhs_mat_subtype_lhs_rfn_top_reduce.
Require Import rhs_mat_subtype_lhs_rfn_sel_reduce.
Require Import rhs_mat_subtype_lhs_sha_top_reduce.
Require Import rhs_mat_subtype_lhs_sha_sel_reduce.
Require Import rhs_mat_subtype_lhs_upp_reduce.
Require Import rhs_mat_subtype_lhs_low_reduce.
Require Import rhs_mat_subtype_lhs_equ_reduce.
Require Import rhs_mat_subtype_lhs_nom_reduce.
Require Import rhs_mat_subtype_lhs_nil_reduce.
Require Import rhs_mat_subtype_lhs_con_reduce.
Set Implicit Arguments.

Import WfExtensionality.

Lemma subtype_lhs_sha_sel_reduce :
  forall T1 x1 L1 ss T1', T1 = t_sha_sel x1 L1 ss T1' ->
                     forall T2, subtype T1' T2 = true ->
                           (T2 <> t_nil) ->
                           (forall T2' Ts2, T2 <> t_con T2' Ts2) ->
                           (forall L2 T2', T2 <> t_upp L2 T2') ->
                           (forall L2 T2', T2 <> t_low L2 T2') ->
                           (forall L2 T2', T2 <> t_equ L2 T2') ->
                           (forall L2 T2', T2 <> t_nom L2 T2') ->
                           subtype T1 T2 = true.
Proof.
  intros.

  subst T1.
  rewrite subtype_sha_sel_reduce with (x1:=x1)(L1:=L1)(T1':=T1')(ss1:=ss);
    [|auto].

  destruct T2; simpl; auto.

  rewrite H0, orb_true_r; auto.

  rewrite H0, orb_true_r; auto.

  contradiction (H3 l T2); auto.
  contradiction (H4 l T2); auto.
  contradiction (H5 l T2); auto.
  contradiction (H6 l T2); auto.
  contradiction (H2 T2_1 T2_2); auto.
Qed.


(* ------------------------------------------------------- *)
(** #

#
        The double time redundancy (DTR) transformation
#
#
-   states of ctr block and their transition properties
          Dmitry Burlyaev - Pascal Fradet - 2015
#
#                                           *)
(* ------------------------------------------------------- *)
(*Add LoadPath "..\..\Common\".
Require Import CirReflect .
Add LoadPath "..\..\TMRProof\".
Require Import tmrDef.
Add LoadPath "..\".
*)

Add LoadPath "..\..\Common\".
Add LoadPath "..\..\TMRProof\".
Add LoadPath "..\Transf\".

Require Import dtrTransform.

Set Implicit Arguments.

(* ####################################################### *)
(**       Basic properties of DTR control block  - SINGLE NON-REDUNDANT VERSION  *)
(* ####################################################### *)
(* Input: failM_out -> Outputs:  ((save # rollBack) # fail)) # rB) # subst  *)

(*Properties about the state transitions of the FSM*)

(*Normal mode: If the current binary encoded state is '000',
               the next is '001' with the corresponding output *)
Lemma fact_stepCtrBl_12 : forall fI t c, step (ctrBl_dtr false false false) fI t c
                                     -> t={~0,~0,~0,~0,~0} /\ c=(ctrBl_dtr false false true).
Proof.
introv H. assert (F:fstep (ctrBl_dtr false false false) fI
                  = Some ({~0,~0,~0,~0,~0}, ctrBl_dtr false false true)) by
(Destruct_s fI ; destruct x; vm_compute; easy).
eapply fstep_imp_detstep in F; Simpl.
Qed.

(*Normal mode: If the current binary encoded state is '001' and no fail signal,
               the next is '000' with the corresponding output *)
Lemma fact_stepCtrBl_21 : forall t c, step (ctrBl_dtr false false true) (~0) t c
                                     -> t={~1,~0,~0,~0,~0} /\ c=(ctrBl_dtr false false false).
Proof.
introv H. assert (F:fstep (ctrBl_dtr false false true ) (~0) (*input fail =0 - no errors*)
                  = (Some ({~1,~0,~0,~0,~0},ctrBl_dtr  false false false ))) by (vm_compute; easy).
eapply fstep_imp_detstep in F; Simpl.
Qed.

(*Error detection: If the current binary encoded state is '001' and a fail signal=1,
                   the recovery process starts with the next state '010' *)
Lemma fact_stepCtrBl_23 : forall t c, step (ctrBl_dtr false false true) (~1) t c
                                      -> t={~1,~1,~1,~1,~1} /\ c=(ctrBl_dtr false true false).
Proof.
introv H. assert (F:fstep (ctrBl_dtr false false true ) (~1) (*input fail =1 - Error detected*)
              = (Some ({~1,~1,~1,~1,~1}, ctrBl_dtr  false true false ))) by (vm_compute; easy).
eapply fstep_imp_detstep in F; Simpl.
Qed.

(*Recovery: If the current binary encoded state is '010', the next recovery state is '011' *)
Lemma fact_stepCtrBl_34 : forall fI  t c, step (ctrBl_dtr false true false) fI  t c
                                     -> t={~0,~1,~1,~1,~1} /\ c=(ctrBl_dtr false true true).
Proof.
introv H. assert (F:fstep (ctrBl_dtr false true false ) fI (*input fail =1 - Error detected*)
              = (Some ({~0,~1,~1,~1,~1}, ctrBl_dtr  false true true ))) by
(Destruct_s fI ; destruct x;  vm_compute; easy).
eapply fstep_imp_detstep in F; Simpl.
Qed.

(*Recovery: If the current binary encoded state is '011' , the  next recovery state is '100' *)
Lemma fact_stepCtrBl_45 : forall fI  t c,   step (ctrBl_dtr  false true true) fI  t c
                                          -> t={~0,~1,~0,~0,~1} /\ c=(ctrBl_dtr true false false ).
Proof.
introv H. assert (F:fstep (ctrBl_dtr  false true true) fI (*input fail =1 - Error detected*)
              = (Some ({~0,~1,~0,~0,~1}, ctrBl_dtr   true false false  ))) by
(Destruct_s fI ; destruct x;  vm_compute; easy).
eapply fstep_imp_detstep in F; Simpl.
Qed.

(*Return to normal mode: If the current binary encoded state is '101' , the  recovery state is normal '000' *)
Lemma fact_stepCtrBl_61 : forall fI  t c,   step (ctrBl_dtr true false true ) fI  t c
                                     -> t={~1,~0,~0,~0,~0} /\ c=(ctrBl_dtr false false false).
Proof.
introv H. assert (F:fstep (ctrBl_dtr true false true  ) fI (*input fail =1 - Error detected*)
              = (Some ({~1,~0,~0,~0,~0}, ctrBl_dtr   false false false  ))) by
(Destruct_s fI ; destruct x;  vm_compute; easy).
eapply fstep_imp_detstep in F; Simpl.
Qed.

(*Supporting property: if three redundant inputs are the same in the voting sub-circuit ctrVoting of
  control block- then the output equals to them and the returning circuit is statelss voting sub-circtuit ctrVoting*)
Lemma votNorm: forall s t c', step ctrVoting {s, s, s} t c' -> pure_bset s-> t=s /\c'=ctrVoting.
Proof.
introv H. Destruct_s s; Destruct_s x; Destruct_s x; Destruct_s x;
Destruct_s x; Destruct_s y2 ; Destruct_s y1; Destruct_s y0; Destruct_s y.
assert (F:fstep ctrVoting {~ x, ~ x0, ~ x1, ~ x2, ~ x3, {~ x, ~ x0, ~ x1, ~ x2, ~ x3}, {~ x, ~ x0, ~ x1, ~ x2, ~ x3}}
                 = (Some ({~ x, ~ x0, ~ x1, ~ x2, ~ x3}, ctrVoting))) by
(destruct x; destruct x0 ; destruct x1; destruct x2; destruct x3 ; vm_compute; try easy; Simpl).
apply fstep_imp_detstep with (c2:=c') (t2:=t) in F; Simpl. Qed.

(*If input signals are the same and pure, no glitches, then after voting the output equals to the truplicated output
buses after the TMR-ed FSM of control block*)
Lemma tmrVotRelat:
forall a1 a2 a3  b1 b2 b3 fI t,  pure_bset fI->  pure_bset {t, t, t} ->
step (tmr (ctrBl_dtr a1 a2 a3)) {fI, fI, fI} {t, t, t} (tmr (ctrBl_dtr b1 b2 b3))
->
step (ctrBlockTMR a1 a2 a3)  {fI, fI, fI} t (ctrBlockTMR b1 b2 b3).
Proof.
intros.
unfold ctrBlockTMR. eapply Sseq. exact H1.
assert ( exists s, exists c', step ctrVoting {t, t, t} s c' ). apply step_all_ex. Simpl.
Simpl. assert (HA :=  H2). apply votNorm in H2. SimpS. Simpl. Checkpure.
Qed.