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


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.


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.


Require Import FM.

(* Gensym avec la monade libre *)
Module gensym.
  Export FreeMonad.

  Inductive Fresh {ident} : Type -> Type :=
  | Gensym : Fresh ident.

  Definition gensym {ident} : mon Fresh ident := syntax_effect Gensym.

End gensym.

Module gensym_run.
  Export gensym.

  Definition ident := nat.

  Definition Fresh := @Fresh ident.

  Definition initial_state := 0.

  Fixpoint run {X} (m : mon Fresh X) : ident -> ident * X :=
    match m with
    | ret v => fun n => (n, v)
    | op Gensym f =>
      fun n => run (f n) (S n)
    end.

End gensym_run.

Require Import SepList.

(* Raisonnement pour gensym avec la SL sur liste minimaliste *)
Module weakestpre_gensym.
  Export SepList.
  Export weakestpre.
  Export gensym_run.

  Definition iProp := @iPropGen (@hpropList ident) biInd.

  Definition op_spec X (m : Fresh X) : iProp * (X -> iProp) :=
    match m with
    | Gensym => (emp, IsFresh)
    end.

  Definition wp {X} (m : mon Fresh X) (Q : X -> iProp) : iProp :=
    @wp_gen _ _ _ op_spec _ m Q.

  Notation "'{{' P } } e {{ v ; Q } }" := (@triple _ _ _ op_spec _ P e (fun v => Q))
      (at level 20, format "'[hv' {{  P  } }  '/  ' e  '/'  {{  v ;  Q  } } ']'").
  (** triple rules *)

  Lemma gensym_spec :
  ⊢{{ emp }} gensym {{ l; IsFresh l }}.
  Proof. unfold triple. simpl. auto. Qed.

End weakestpre_gensym.

(* Adequacy pour gensym avec la SL minimaliste *)
Module adequacy_gensym.
  Export weakestpre_gensym.

  Definition inject n := seq 0 n.

  Lemma inject_last : forall n, inject (S n) = inject n ++ [n].
  Proof. intros. unfold inject. rewrite seq_S. reflexivity. Qed.

  Lemma next_disjoint : forall n, list_disjoint (inject n) [n].
  Proof.
    intros n x y P0 P1 eq. subst. inversion P1. subst. apply in_seq in P0.
    destruct P0. lia. inversion H.
  Qed.

  Lemma adequacy {X} : forall (e : mon Fresh X) (Q : X -> iProp) n n' v,
      (heap_ctx (inject n) ⊢ wp e Q ) ->
      run e n = (n', v) ->
      (Q v) () (inject n').
  Proof.
    fix e 1.
    destruct e0; intros.
    - inversion H0; subst. apply soundness2. iApply H.
    - simpl in *. destruct f. eapply e.
      2 : apply H0.
      + iIntros "HA". rewrite inject_last.
        iDestruct (heap_ctx_split with "HA") as "[HA HB]". apply next_disjoint.
        iDestruct (H with "HA") as "[_ HA]".
        iApply ("HA" with "HB").
  Qed.

  Lemma adequacy_init {X} : forall (e : mon Fresh X) (Q : X -> iProp) (s' : nat) v ,
      (⊢ wp e Q) ->
      run e initial_state = (s', v) ->
      (Q v) () (inject s').
  Proof. intros. eapply adequacy; eauto. iIntros "_". auto. Qed.

  Lemma adequacy_triple {X} : forall (e : mon Fresh X) (Q : X -> iProp) n v n' H,
      (heap_ctx (inject n) ⊢ H) -> (⊢ {{ H }} e {{ v; Q v }}) ->
      run e n = (n', v) ->
      (Q v) () (inject n').
  Proof.
    intros. eapply adequacy; eauto. iIntros "HA". iDestruct (H0 with "HA") as "HA".
    iApply (H1 with "HA").
  Qed.

  Lemma adequacy_triple_init {X} : forall (e : mon Fresh X) (Q : X -> iProp) v n' H,
      (⊢ H) -> (⊢ {{ H }} e {{ v; Q v }}) ->
      run e initial_state = (n', v) ->
      (Q v) () (inject n').
  Proof.
    intros. eapply adequacy_init; eauto. iApply H1; eauto.
  Qed.

  Lemma use_adequacy {X} : forall (e : mon Fresh X) (Q : X -> iProp) v n' H,
      (⊢ H) -> (⊢ {{ H }} e {{ v; Q v }}) ->
      run e initial_state = (n', v) ->
      ∃ s, (Q v) () s.
  Proof.
    intros. exists (inject n'). apply (adequacy_triple_init _ _ _ _ _ H0 H1 H2).
  Qed.

  Lemma adequacy_wp_pure {X} : forall (e : mon Fresh X) (Q : X -> Prop) n v n',
      (heap_ctx (inject n) ⊢ wp e (fun v =>  ⌜Q v⌝)) ->
      run e n = (n', v) ->
      Q v.
  Proof.
    intros. apply (soundness1 (inject n')). iApply soundness3.
    eapply (adequacy _ _ _ _ _ H H0).
  Qed.

  Lemma adequacy_pure {X} : forall (e : mon Fresh X) (Q : X -> Prop) n v n' H,
      (heap_ctx (inject n) ⊢ H) -> (⊢ {{ H }} e {{ v; ⌜ Q v ⌝}}) ->
      run e n = (n', v) ->
      Q v.
  Proof.
    intros. eapply adequacy_wp_pure; eauto. iIntros "HA". iDestruct (H0 with "HA") as "HA".
    iApply (H1 with "HA").
  Qed.

  Lemma adequacy_pure_init {X} : forall (e : mon Fresh X) (Q : X -> Prop) v s' H,
      (⊢ H) -> (⊢ {{ H }} e {{ v; ⌜ Q v ⌝}}) ->
      run e initial_state = (s', v) ->
      Q v.
  Proof.
    intros. eapply adequacy_pure; eauto.
    iIntros "_". iApply H1; auto.
  Qed.

End adequacy_gensym.


(** * Definition of a functor *)

From Coq Require Import
     Setoid
     Morphisms.

From ITree Require Import
     CategoryOps.

Import CatNotations.
Local Open Scope cat_scope.

Section Functor.

Context
  {obj1 obj2 : Type}
  {C1 : obj1 -> obj1 -> Type}
  {C2 : obj2 -> obj2 -> Type}
  {F : obj1 -> obj2} {fmap : forall a b, C1 a b -> C2 (F a) (F b)}
  `{Eq2 _ C1} `{Id_ _ C1} `{Cat _ C1}
  `{Eq2 _ C2} `{Id_ _ C2} `{Cat _ C2}.

Arguments fmap {a b}.

Class Functor : Prop :=
  { fmap_id : forall a, fmap (id_ a) ⩯ id_ (F a)
  ; fmap_cat : forall a b c (f : C1 a b) (g : C1 b c), fmap (cat f g) ⩯ cat (fmap f) (fmap g)
  ; fmap_proper : forall a b, Proper (eq2 ==> eq2) (@fmap a b)
  }.

End Functor.

Arguments Functor : clear implicits.
Arguments Functor {_ _} C1 C2 F fmap {_ _ _ _ _ _}.

Section FunctorId.

Context
  {obj : Type} {C1 C2 : obj -> obj -> Type}
  {fmap : forall a b, C1 a b -> C2 a b}
  `{Eq2 _ C1} `{Id_ _ C1} `{Cat _ C1}
  `{Eq2 _ C2} `{Id_ _ C2} `{Cat _ C2}
  {Functor_id : Functor C1 C2 (fun x => x) fmap}.

Lemma fmap_id0 : forall a, fmap _ _ (id_ a) ⩯ id_ a.
Proof. apply fmap_id. Qed.

Lemma fmap_cat0 : forall a b c (f : C1 a b) (g : C1 b c),
    fmap _ _ (f >>> g) ⩯ fmap _ _ f >>> fmap _ _ g.
Proof. apply fmap_cat. Qed.

End FunctorId.