Require Import Coq.Classes.Morphisms.
Require Import Coq.Classes.RelationClasses.
Require Import Coq.Relations.Relation_Definitions.

Require Import Domains.Continuous Domains.Domain Domains.FunctorClasses
        Domains.Functors Domains.Order Domains.ProjectiveLimit.

(* Section store. *)
(*   Variable ptr : Type. *)
(*   Variable val : Type. *)
(*   Definition store := ptr -> val. *)
(* End store. *)

Section perm.
  Context ptr `{CPO ptr}.
  Context value `{CPO value}.

  Definition permF : TypeF :=
    fun X _ _ _ => ProductTypeF
                  (PERTypeF (ptr -> value))
                  (PreOrderTypeF (ptr -> value))
                  X _ _ _.

  (* The type of permissions. *)
  Definition perm := pLim (type_n permF).

  (* The recursive domain instance for permissions. *)
  Definition permDomain := ProjLimitRecursiveDomain permF.

  (* Aliases for the permission type fold and unfold operations. *)
  Definition permFold := Fold (pLim (type_n permF)).
  Definition permUnfold := Unfold (pLim (type_n permF)).

  (* (* OType instance for permissions. p1 ⊑ p2 whenever the PER and *)
  (*    preorder of p1 are subrelations of those of p2 at every n. *) *)
  (* Global Program Instance OTperm : OType perm := *)
  (*   {| oleq := fun p1 p2 => *)
  (*                forall n, match n with *)
  (*                     | O => True *)
  (*                     | S n' => fst (p1 (S n')) <o= fst (p2 (S n')) /\ *)
  (*                              snd (p1 (S n')) <o= snd (p2 (S n')) *)
  (*                     end |}. *)
  (* Next Obligation. *)
  (* split. *)
  (* - intros x []; auto; split; intros ? ? ?; auto. *)
  (* - intros x y z H1 H2 n. *)
  (*   specialize (H1 n); specialize (H2 n); destruct n; auto. *)
  (*   + destruct H1. destruct H2. split. *)
  (*     * intros ? ? ?; apply H2; apply H1; auto. *)
  (*     * intros ? ? ?; apply H4; apply H3; auto. *)
  (* Qed. *)

  (* Set Printing All. *)
  (* Print permUnfold. *)

  (* Program Definition cRelationEmpty A `{CPO A} : cRelation A := *)
  (*   const_cfun False. *)

  (* Program Definition cRelationFull A `{CPO A} : cRelation A := *)
  (*   const_cfun True. *)

  (* This isn't monotone... *)
  (* Program Definition cRelationRefl A `{CPO A} : cRelation A := *)
  (*   {| cfun_app := fun p => fst p =o= snd p|}. *)
  (* Admit Obligations. *)

  (* Program Definition unitPerm : perm := *)
  (*   fun n => match n with *)
  (*         | O => tt *)
  (*         | S n' => (_, _) *)
  (*         end. *)

  (* The least reflexive relation. *)
  Definition relationRefl A `{OType A} : relation A :=
    fun a b => a =o= b.

  (* Definition relationOrder A `{OType A} : relation A := *)
  (*   fun a b => a <o= b. *)

  (* Instance reflProper A `{OType A} : *)
  (*   Proper (oeq ==> oeq) (relationRefl A). *)
  (* Proof. *)
  (*   intros x y Heq; split; intros z ?; try rewrite Heq; auto; *)
  (*     rewrite <- Heq; auto. *)
  (* Qed. *)

  (* Instance orderProper A `{OType A} : *)
  (*   Proper (oeq ==> oleq ==> oleq) (relationOrder A). *)
  (* Proof. *)
  (*   intros x y Heq z w Hleq H2. *)
  (*   unfold relationOrder in *. *)
  (*   rewrite <- Heq. etransitivity; eauto. *)
  (* Qed. *)

  Instance reflProper A `{OType A} :
    Proper (oeq ==> oeq ==> oleq) (relationRefl A).
  Proof.
    intros ? ? Heq ? ? ? ?; rewrite <- Heq; etransitivity; eauto.
  Qed.

  (* Instance asdfOType A B {oA : OType A} {oB : OType B} (x : TypeWithCPO) *)
  (*   : OType ((A -> B) * ty_ty x) := *)
  (*   @OTpair _ _ (OTarrow A B) (ty_otype x). *)

  (* Let Coq find the OType instance form a TypeWithCPO. *)
  Instance TypeWithCPOOType (x : TypeWithCPO): OType (ty_ty x) :=
    ty_otype x.
  (* Instance TypeWithCPOSupremum (x : TypeWithCPO): Supremum (ty_ty x) := *)
  (*   ty_sup x. *)
  (* Instance TypeWithCPOCPO (x : TypeWithCPO): CPO (ty_ty x) := *)
  (*   ty_cpo x. *)

  (* The least reflexive relation is a PER. *)
  Lemma relationRefl_isPER A `{OType A} :
    isPER (relationRefl A).
  Proof.
    split; intros ?; try apply oeq_symm; auto; etransitivity; eauto.
  Qed.

  (* The least reflexive relation is a preorder. *)
  Lemma relationRefl_isPreOrder A `{OType A} :
    isPreOrder (relationRefl A).
  Proof.
    split.
    - intros ?; reflexivity.
    - split.
      + intros ?; etransitivity; eauto.
      + intros x y Heq1 z w Heq2 ?.
        rewrite <- Heq1. etransitivity; eauto.
  Qed.

  Lemma relationTotal_isPreOrder A `{OType A} :
    isPreOrder (fun _ _ => True).
  Proof. firstorder. Qed.

  (* The permission representing no permissions at all.*)
  Program Definition noPerm : perm :=
    fun n => match n with
          | O => tt
          | S n' => (fun _ _ => True, relationRefl _)
          end.
  Next Obligation. split; auto. Qed.
  Next Obligation. apply relationRefl_isPreOrder. Qed.
  (* Next Obligation. *)
  (*   destruct n; simpl. reflexivity.     *)
  (*   split. simpl. *)
  (*   split; simpl. *)
  (*   - intros x y _; auto. *)
  (*   - intros x y H1. unfold relationRefl in *. *)
  (*     split; simpl. split. *)
  (*     + intros z. destruct x, y. destruct H1 as [[] []]. simpl in *. *)
  (*       auto. *)
  (*     + split. *)
  (*       * admit. *)
  (*       * admit. *)
  (*     + split. *)
  (*       * intros z. destruct x, y. destruct H1 as [[] []]. simpl in *. *)
  (*         auto. *)
  (*       * admit. *)
  (*   - split; simpl. *)
  (*     + intros ? ? ?; auto. *)
  (*     + admit. *)
  (* Admitted. *)
  Admit Obligations.

  (* The permission representing full control over everything. *)
  Program Definition allPerm : perm :=
    fun n => match n with
          | O => tt
          | S n' => (relationRefl _, fun _ _ => True)
          end.
  Next Obligation. apply relationRefl_isPER. Qed.
  Next Obligation. apply relationTotal_isPreOrder. Qed.
  Admit Obligations.
End perm.

Section mem.
  Context ptr `{CPO ptr}.
  Context value `{CPO value}.

  Definition mem : Type := (ptr -> value) * (perm ptr value).
End mem.


From Test Require Import tactic.

Section FOFProblem.

Variable Universe : Set.
Variable UniverseElement : Universe.

Variable triangle_ : Universe -> Universe -> Universe -> Prop.
Variable out_ : Universe -> Universe -> Universe -> Prop.
Variable ltA_ : Universe -> Universe -> Universe -> Universe -> Universe -> Universe -> Prop.
Variable lt_ : Universe -> Universe -> Universe -> Universe -> Prop.
Variable congA_ : Universe -> Universe -> Universe -> Universe -> Universe -> Universe -> Prop.
Variable cong_ : Universe -> Universe -> Universe -> Universe -> Prop.
Variable col_ : Universe -> Universe -> Universe -> Prop.
Variable betS_ : Universe -> Universe -> Universe -> Prop.

Variable deftriangle_1 : (forall A B C : Universe, (triangle_ A B C -> ~(col_ A B C))).
Variable deftriangle2_2 : (forall A B C : Universe, (~(col_ A B C) -> triangle_ A B C)).
Variable defcollinear_3 : (forall A B C : Universe, (col_ A B C -> (A = B \/ (A = C \/ (B = C \/ (betS_ B A C \/ (betS_ A B C \/ betS_ A C B))))))).
Variable defcollinear2a_4 : (forall A B C : Universe, (A = B -> col_ A B C)).
Variable defcollinear2b_5 : (forall A B C : Universe, (A = C -> col_ A B C)).
Variable defcollinear2c_6 : (forall A B C : Universe, (B = C -> col_ A B C)).
Variable defcollinear2d_7 : (forall A B C : Universe, (betS_ B A C -> col_ A B C)).
Variable defcollinear2e_8 : (forall A B C : Universe, (betS_ A B C -> col_ A B C)).
Variable defcollinear2f_9 : (forall A B C : Universe, (betS_ A C B -> col_ A B C)).
Variable lemma_inequalitysymmetric_10 : (forall A B : Universe, (A <> B -> B <> A)).
Variable cn_equalityreverse_11 : (forall A B : Universe, cong_ A B B A).
Variable lemma_lessthancongruence_12 : (forall A B C D E F : Universe, ((lt_ A B C D /\ cong_ C D E F) -> lt_ A B E F)).
Variable deflessthan_13 : (forall A B C D : Universe, (exists X : Universe, (lt_ A B C D -> (betS_ C X D /\ cong_ C X A B)))).
Variable deflessthan2_14 : (forall A B C D X : Universe, ((betS_ C X D /\ cong_ C X A B) -> lt_ A B C D)).
Variable lemma_betweennotequal_15 : (forall A B C : Universe, (betS_ A B C -> (B <> C /\ (A <> B /\ A <> C)))).
Variable lemma_congruenceflip_16 : (forall A B C D : Universe, (cong_ A B C D -> (cong_ B A D C /\ (cong_ B A C D /\ cong_ A B D C)))).
Variable lemma_ray4_1_17 : (forall A B E : Universe, ((betS_ A E B /\ A <> B) -> out_ A B E)).
Variable lemma_ray4_2_18 : (forall A B E : Universe, ((E = B /\ A <> B) -> out_ A B E)).
Variable lemma_ray4_3_19 : (forall A B E : Universe, ((betS_ A B E /\ A <> B) -> out_ A B E)).
Variable cn_congruencereflexive_20 : (forall A B : Universe, cong_ A B A B).
Variable defequalangles_21 : (forall A B C Ca Cb Cc : Universe, (exists U V Su Sv : Universe, (congA_ A B C Ca Cb Cc -> (out_ B A U /\ (out_ B C V /\ (out_ Cb Ca Su /\ (out_ Cb Cc Sv /\ (cong_ B U Cb Su /\ (cong_ B V Cb Sv /\ (cong_ U V Su Sv /\ ~(col_ A B C))))))))))).
Variable defequalangles2_22 : (forall A B C Ca Cb Cc U V Su Sv : Universe, ((out_ B A U /\ (out_ B C V /\ (out_ Cb Ca Su /\ (out_ Cb Cc Sv /\ (cong_ B U Cb Su /\ (cong_ B V Cb Sv /\ (cong_ U V Su Sv /\ ~(col_ A B C)))))))) -> congA_ A B C Ca Cb Cc)).
Variable lemma_equalanglessymmetric_23 : (forall A B C Xa Xb Xc : Universe, (congA_ A B C Xa Xb Xc -> congA_ Xa Xb Xc A B C)).
Variable lemma_equalanglestransitive_24 : (forall A B C D E F P Q R : Universe, ((congA_ A B C D E F /\ congA_ D E F P Q R) -> congA_ A B C P Q R)).
Variable proposition_04_25 : (forall A B C Xa Xb Xc : Universe, ((cong_ A B Xa Xb /\ (cong_ A C Xa Xc /\ congA_ B A C Xb Xa Xc)) -> (cong_ B C Xb Xc /\ (congA_ A B C Xa Xb Xc /\ congA_ A C B Xa Xc Xb)))).
Variable defanglelessthan_26 : (forall A B C D E F : Universe, (exists U X V : Universe, (ltA_ A B C D E F -> (betS_ U X V /\ (out_ E D U /\ (out_ E F V /\ congA_ A B C D E X)))))).
Variable defanglelessthan2_27 : (forall A B C D E F U X V : Universe, ((betS_ U X V /\ (out_ E D U /\ (out_ E F V /\ congA_ A B C D E X))) -> ltA_ A B C D E F)).
Variable lemma_angletrichotomy_28 : (forall A B C D E F : Universe, (ltA_ A B C D E F -> ~(ltA_ D E F A B C))).
Variable lemma_raystrict_29 : (forall A B C : Universe, (out_ A B C -> A <> C)).
Variable lemma_congruencesymmetric_30 : (forall A B C D : Universe, (cong_ B C A D -> cong_ A D B C)).
Variable lemma_equalanglesNC_31 : (forall A B C Xa Xb Xc : Universe, (congA_ A B C Xa Xb Xc -> ~(col_ Xa Xb Xc))).
Variable lemma_equalanglesreflexive_32 : (forall A B C : Universe, (~(col_ A B C) -> congA_ A B C A B C)).
Variable lemma_angledistinct_33 : (forall A B C Xa Xb Xc : Universe, (congA_ A B C Xa Xb Xc -> (A <> B /\ (B <> C /\ (A <> C /\ (Xa <> Xb /\ (Xb <> Xc /\ Xa <> Xc))))))).
Variable lemma_trichotomy1_34 : (forall A B C D : Universe, ((~(lt_ A B C D) /\ (~(lt_ C D A B) /\ (A <> B /\ C <> D))) -> cong_ A B C D)).

Theorem proposition_26A_35 : (forall A B C D E F : Universe, ((triangle_ A B C /\ (triangle_ D E F /\ (congA_ A B C D E F /\ (congA_ B C A E F D /\ cong_ B C E F)))) -> (cong_ A B D E /\ (cong_ A C D F /\ congA_ B A C E D F)))).
Proof.
  time tac.
Qed.

End FOFProblem.


Require Import rt.util.all.
Require Import rt.model.basic.job rt.model.basic.task
               rt.model.basic.schedule rt.model.basic.schedulability
               rt.model.basic.priority rt.model.basic.platform.
Require Import rt.analysis.basic.workload_bound
               rt.analysis.basic.interference_bound_edf
               rt.analysis.basic.bertogna_edf_comp.
Require Import rt.implementation.basic.job
               rt.implementation.basic.task
               rt.implementation.basic.schedule
               rt.implementation.basic.arrival_sequence.
From mathcomp Require Import ssreflect ssrbool ssrnat eqtype seq bigop div.

Module ResponseTimeAnalysisEDF.

  Import Job Schedule SporadicTaskset Priority Schedulability Platform InterferenceBoundEDF WorkloadBound ResponseTimeIterationEDF.
  Import ConcreteJob ConcreteTask ConcreteArrivalSequence ConcreteScheduler.

  Section ExampleRTA.

    Let tsk1 := {| task_id := 1; task_cost := 2; task_period := 5; task_deadline := 3|}.
    Let tsk2 := {| task_id := 2; task_cost := 4; task_period := 6; task_deadline := 5|}.
    Let tsk3 := {| task_id := 3; task_cost := 3; task_period := 12; task_deadline := 11|}.

    (* Let ts be a task set containing these three tasks. *)
    Let ts := [:: tsk1; tsk2; tsk3].

    Section FactsAboutTaskset.

      Fact ts_is_a_set: uniq ts.
      Proof.
        by compute.
      Qed.

      Fact ts_has_valid_parameters:
        valid_sporadic_taskset task_cost task_period task_deadline ts.
      Proof.
        intros tsk IN.
        repeat (move: IN => /orP [/eqP EQ | IN]; subst; compute); by done.
      Qed.

      Fact ts_has_constrained_deadlines:
        forall tsk,
          tsk \in ts ->
          task_deadline tsk <= task_period tsk.
      Proof.
        intros tsk IN.
        repeat (move: IN => /orP [/eqP EQ | IN]; subst; compute); by done.
      Qed.

    End FactsAboutTaskset.

    (* Assume there are two processors. *)
    Let num_cpus := 2.

    (* Recall the EDF RTA schedulability test. *)
    Let schedulability_test :=
      edf_schedulable task_cost task_period task_deadline num_cpus.

    Fact schedulability_test_succeeds :
      schedulability_test ts = true.
    Proof.
      unfold schedulability_test, edf_schedulable, edf_claimed_bounds; desf.
      apply negbT in Heq; move: Heq => /negP ALL.
      exfalso; apply ALL; clear ALL.
      assert (STEPS: \sum_(tsk <- ts) (task_deadline tsk - task_cost tsk) + 1 = 11).
      {
        by rewrite unlock; compute.
      } rewrite STEPS; clear STEPS.

      Ltac f :=
        unfold edf_rta_iteration; simpl;
        unfold edf_response_time_bound, div_floor, total_interference_bound_edf, interference_bound_edf, interference_bound_generic, W; simpl;
        repeat rewrite addnE;
        repeat rewrite big_cons; repeat rewrite big_nil;
        repeat rewrite addnE; simpl;
        unfold num_cpus, divn; simpl.

      rewrite [edf_rta_iteration]lock; simpl.

      unfold locked at 11; destruct master_key; f.
      unfold locked at 10; destruct master_key; f.
      unfold locked at 9; destruct master_key; f.
      unfold locked at 8; destruct master_key; f.
      unfold locked at 7; destruct master_key; f.
      unfold locked at 6; destruct master_key; f.
      unfold locked at 5; destruct master_key; f.
      unfold locked at 4; destruct master_key; f.
      unfold locked at 3; destruct master_key; f.
      unfold locked at 2; destruct master_key; f.
      by unfold locked at 1; destruct master_key; f.
    Qed.

    (* Let arr_seq be the periodic arrival sequence from ts. *)
    Let arr_seq := periodic_arrival_sequence ts.

    (* Let sched be the work-conserving EDF scheduler. *)
    Let sched := scheduler job_cost num_cpus arr_seq (EDF job_deadline).

    (* Recall the definition of deadline miss. *)
    Let no_deadline_missed_by :=
      task_misses_no_deadline job_cost job_deadline job_task sched.

    (* Next, we prove that ts is schedulable with the result of the test. *)
    Corollary ts_is_schedulable:
      forall tsk,
        tsk \in ts ->
        no_deadline_missed_by tsk.
    Proof.
      intros tsk IN.
      have VALID := periodic_arrivals_valid_job_parameters ts ts_has_valid_parameters.
      have EDFVALID := @edf_valid_policy _ arr_seq job_deadline.
      unfold valid_JLDP_policy, valid_sporadic_job, valid_realtime_job in *; des.
      apply taskset_schedulable_by_edf_rta with (task_cost := task_cost) (task_period := task_period) (task_deadline := task_deadline) (ts0 := ts).
      - by apply ts_is_a_set.
      - by apply ts_has_valid_parameters.
      - by apply ts_has_constrained_deadlines.
      - by apply periodic_arrivals_all_jobs_from_taskset.
      - by apply periodic_arrivals_valid_job_parameters, ts_has_valid_parameters.
      - by apply periodic_arrivals_are_sporadic.
      - by compute.
      - by apply scheduler_jobs_must_arrive_to_execute.
      - apply scheduler_completed_jobs_dont_execute; intro j'.
        -- by specialize (VALID j'); des.
        -- by apply periodic_arrivals_is_a_set.
      - by apply scheduler_sequential_jobs, periodic_arrivals_is_a_set.
      - by apply scheduler_work_conserving.
      - by apply scheduler_enforces_policy; ins.
      - by apply schedulability_test_succeeds.
      - by apply IN.
    Qed.

  End ExampleRTA.

End ResponseTimeAnalysisEDF.


(** **)

(*** param_test: tests for unary parametricity translation ***)

Load param_unary.

Definition f := Type -> Type.
MetaCoq Run (persistentTranslate f).
Print fᵗ.
(** fun f : Type -> Type => forall H : Type, (H -> Type) -> f H -> Type **)

MetaCoq Run (persistentTranslate nat).
Print natᵗ.
MetaCoq Run (persistentTranslate nat).
Print natᵗ0. (** makeFresh testing **)
(** Inductive natᵗ : (fun X : Set => X -> Set) nat :=
	Oᵗ : natᵗ 0
  | Sᵗ : (fun f : nat -> nat => forall H : nat, natᵗ H -> natᵗ (f H)) S.
  **)

MetaCoq Run (TC <- Translate emptyTC "nat" ;;
                tmDefinition "nat_TC" TC ).
MetaCoq Run (TC <- Translate nat_TC "VectorDef.t" ;;(** needs nat **)
                tmDefinition "vec_TC" TC ).
MetaCoq Run (persistentTranslate VectorDef.t).
Print VectorDef.t.
Print tᵗ.
Print tᵗ0.
Fail Print tᵗ1.

(** persistent finds the correct translations **)
MetaCoq Run (persistentTranslate_prune VectorDef.t true).
Print tᵗ0.
Print tᵗ1.

Print sig.
MetaCoq Run (persistentTranslate sigT).
Print sigTᵗ.
(**
Inductive
sigTᵗ (A : Type) (Aᵗ P : A -> Type) (Pᵗ : forall H : A, Aᵗ H -> P H -> Type)
  : (∑ y, P y) -> Type :=
	existTᵗ : forall (x : A) (xᵗ : Aᵗ x) (H : P x),
              Pᵗ x xᵗ H -> sigTᵗ A Aᵗ P Pᵗ (x; H)

sigTᵗ is a predicate on sigT proofs:
take a type A and predicates At on A
take a predicate for the element P
and a predicate on Pt proofs of P:
  on related elements on H (here on elements satisfying At)
  the proofs have to fulfill Pt
**)

Print list.
MetaCoq Run (persistentTranslate list).
Print listᵗ.

(**

Inductive listᵗ (A : Type) (Aᵗ : A -> Type) : list A -> Type :=
	nilᵗ2 : listᵗ A Aᵗ []
  | consᵗ2 : forall H : A,
             Aᵗ H ->
             forall H0 : list A, listᵗ A Aᵗ H0 -> listᵗ A Aᵗ (H :: H0)

a predicate on lists
every element in the list fulfills At
**)

Inductive G X := C (f:nat -> X).
MetaCoq Run (persistentTranslate G).
Print Gᵗ.

(* translation of sorts *)
Definition type := Type.
MetaCoq Run (Translate emptyTC "type").
Print typeᵗ.
Check (natᵗ:typeᵗ nat).

Fail Print tᵗ2.
MetaCoq Run (persistentTranslate Fin.t).
Print tᵗ2.
Fail Print tᵗ3.
MetaCoq Run (TC <- Translate nat_TC "Fin.t" ;;(* needs nat *)
                tmDefinition "fin_TC" TC ).
Print tᵗ3.

Inductive List (X:Set) : Set := nil | cons (x:X) (xs:List X).
Inductive rose : Set := node (xs:List rose).

MetaCoq Run (persistentTranslate List).
MetaCoq Run (persistentTranslate rose).
Print roseᵗ.
(**

Inductive roseᵗ : rose -> Set :=
	nodeᵗ : forall xs : List rose, Listᵗ rose roseᵗ xs -> roseᵗ (node xs)

**)


Require Export prosa.model.task.preemption.parameters.

(** Furthermore, we assume the fully preemptive job model. *)
Require Import prosa.model.preemption.fully_preemptive.

(** * Preemptions in Fully Preemptive Model *)
(** In this section, we prove that instantiation of predicate
    [job_preemptable] to the fully preemptive model indeed defines
    a valid preemption model. *)
Section FullyPreemptiveModel.

  (**  Consider any type of jobs. *)
  Context {Job : JobType}.
  Context `{JobArrival Job}.
  Context `{JobCost Job}.

  (** Consider any kind of processor state model, ... *)
  Context {PState : Type}.
  Context `{ProcessorState Job PState}.

  (** ... any job arrival sequence, ... *)
  Variable arr_seq : arrival_sequence Job.

  (** ... and any given schedule. *)
  Variable sched : schedule PState.

  (** Then, we prove that fully_preemptive_model is a valid preemption model. *)
  Lemma valid_fully_preemptive_model:
    valid_preemption_model arr_seq sched.
  Proof.
      by intros j ARR; repeat split; intros t CONTR.
  Qed.

  (** We also prove that under the fully preemptive model
      [job_max_nonpreemptive_segment j] is equal to 0, when [job_cost
      j = 0] ... *)
  Lemma job_max_nps_is_0:
    forall j,
      job_cost j = 0 ->
      job_max_nonpreemptive_segment j = 0.
  Proof.
    intros.
    rewrite /job_max_nonpreemptive_segment /lengths_of_segments
            /job_preemption_points.
      by rewrite H2; compute.
  Qed.

  (** ... or ε when [job_cost j > 0]. *)
  Lemma job_max_nps_is_ε:
    forall j,
      job_cost j > 0 ->
      job_max_nonpreemptive_segment j = ε.
  Proof.
    intros ? POS.
    rewrite /job_max_nonpreemptive_segment /lengths_of_segments
            /job_preemption_points.
    rewrite /job_preemptable /fully_preemptive_model.
    rewrite filter_predT.
    apply max0_of_uniform_set.
    - rewrite /range /index_iota subn0.
      rewrite [size _]pred_Sn -[in X in _ <= X]addn1 -size_of_seq_of_distances size_iota.
      + by rewrite -pred_Sn.
      + by rewrite ltnS.
    - by apply distances_of_iota_ε.
  Qed.

End FullyPreemptiveModel.
Hint Resolve valid_fully_preemptive_model : basic_facts.


From Coq Require Import Lists.List.
From Coq Require Import Bool.Bool.
From Coq Require Import Logic.FunctionalExtensionality.
Require Import RBT.Verif.RBtree_Type.
Require Import RBT.Verif.RBtree_Definition.
Require Import RBT.Verif.Half_Tree.
Require Import RBT.Verif.relation_map.
Require Import RBT.Verif.Abstract.

Section Section_lookup.

Context {rbt:RBtree_setting}.
Existing Instance rbt.

Fixpoint lookup  (x: Key) (t : RBtree) :option Value :=
  match t with
  | Empty => None
  | T c a y v t b  => if  x <? y then
                         match (lookup x a ) with
                         |None => None
                         |Some v' => Some (f v' t)
                         end
                         else if  y <? x then
                         match (lookup x b) with
                         |None => None
                         |Some u => Some (f u t)
                         end
                         else Some (f v t)
end.
Theorem lookup_relate:
  forall k t cts ,   SearchTree t ->Abs t cts -> lookup k t =  cts  k.
Proof.
  intros. inversion H. subst. clear H.  revert lo hi k H1.
  induction H0.
  + intros. simpl. unfold relate_default. reflexivity.
  + intros.
  simpl.
  unfold tag_update,v_update, combine.
  inversion H1. subst.
  remember (k0 <? k) as m.
  remember (k <? k0) as n.
  destruct m.
  - assert (Equal_bool k k0 = false). {  rewrite eqb_comm. apply lt_eqb_false. symmetry in Heqm.
  pose proof ltb_lt k0 k. rewrite <- H in Heqm. auto. }
  rewrite H. pose proof IHAbs1 lo k k0 H8. rewrite H0.
  assert (b k0 = None).
  {
  pose proof (search_relate k0 right b k hi H9 H0_0). destruct (b k0).
  assert (Some v0 <> None). { unfold not.  intros.  inversion H3. }
  apply H2 in H3. destruct H3. symmetry in Heqm. apply (ltb_lt k0 k ) in Heqm. apply Total_Asymmetric in Heqm. apply Heqm in H3. inversion H3. reflexivity.
  } rewrite H2. destruct (a k0). reflexivity. reflexivity.
  - destruct n.
    * assert (Equal_bool k k0 = false). { apply lt_eqb_false. symmetry in Heqn.
  pose proof ltb_lt  k k0. rewrite <- H in Heqn. auto. }
  rewrite H. pose proof IHAbs2 k hi k0 H9. rewrite H0.
  assert (a k0 = None).
  {
  pose proof (search_relate k0 left a lo k H8 H0_). destruct (a k0).
  assert (Some v0 <> None). { unfold not.  intros.  inversion H3. }
  apply H2 in H3. destruct H3. symmetry in Heqn. apply (ltb_lt k k0 ) in Heqn. apply Total_Asymmetric in Heqn. apply Heqn in H4. inversion H4. reflexivity.
  }
   rewrite H2. destruct (b k0). reflexivity. reflexivity.
    * assert (Equal_bool k k0 = true).
    {  apply eqb_eq_k. apply (lt_eq  k k0). split. apply ltb_false. auto. apply ltb_false. auto. }
     rewrite H.  reflexivity.
Qed.

End Section_lookup.


Require Import prosa.classic.util.all.
Require Import prosa.classic.model.arrival.basic.job prosa.classic.model.arrival.basic.task prosa.classic.model.priority.
Require Import prosa.classic.model.schedule.global.schedulability.
Require Import prosa.classic.model.schedule.global.basic.schedule prosa.classic.model.schedule.global.basic.platform.
Require Import prosa.classic.analysis.global.parallel.workload_bound
               prosa.classic.analysis.global.parallel.interference_bound_edf
               prosa.classic.analysis.global.parallel.bertogna_edf_comp.
Require Import prosa.classic.implementation.job prosa.classic.implementation.task
               prosa.classic.implementation.arrival_sequence.
Require Import prosa.classic.implementation.global.basic.schedule. (* Use sequential scheduler. *)
From mathcomp Require Import ssreflect ssrbool ssrnat eqtype seq bigop div.

Module ResponseTimeAnalysisEDF.

  Import Job Schedule SporadicTaskset Priority Schedulability Platform InterferenceBoundEDF WorkloadBound ResponseTimeIterationEDF.
  Import ConcreteJob ConcreteTask ConcreteArrivalSequence ConcreteScheduler.

  Section ExampleRTA.

    Let tsk1 := {| task_id := 1; task_cost := 2; task_period := 6; task_deadline := 6|}.
    Let tsk2 := {| task_id := 2; task_cost := 3; task_period := 8; task_deadline := 6|}.
    Let tsk3 := {| task_id := 3; task_cost := 2; task_period := 12; task_deadline := 12|}.

    (* Let ts be a task set containing these three tasks. *)
    Program Let ts := Build_set [:: tsk1; tsk2; tsk3] _.

    Section FactsAboutTaskset.

      Fact ts_has_valid_parameters:
        valid_sporadic_taskset task_cost task_period task_deadline ts.
      Proof.
        intros tsk IN.
        repeat (move: IN => /orP [/eqP EQ | IN]; subst; compute); by done.
      Qed.

      Fact ts_has_constrained_deadlines:
        forall tsk,
          tsk \in ts ->
          task_deadline tsk <= task_period tsk.
      Proof.
        intros tsk IN.
        repeat (move: IN => /orP [/eqP EQ | IN]; subst; compute); by done.
      Qed.

    End FactsAboutTaskset.

    (* Assume there are two processors. *)
    Let num_cpus := 2.

    (* Recall the EDF RTA schedulability test. *)
    Let schedulability_test :=
      edf_schedulable task_cost task_period task_deadline num_cpus.

    Fact schedulability_test_succeeds :
      schedulability_test ts = true.
    Proof.
      unfold schedulability_test, edf_schedulable, edf_claimed_bounds; desf.
      apply negbT in Heq; move: Heq => /negP ALL.
      exfalso; apply ALL; clear ALL.
      assert (STEPS: \sum_(tsk <- ts) (task_deadline tsk - task_cost tsk) + 1 = 18).
      {
        by rewrite unlock; compute.
      } rewrite STEPS; clear STEPS.

      Ltac f :=
        unfold edf_rta_iteration; simpl;
        unfold edf_response_time_bound, div_floor, total_interference_bound_edf, interference_bound_edf, interference_bound_generic, W; simpl;
        repeat rewrite addnE;
        repeat rewrite big_cons; repeat rewrite big_nil;
        repeat rewrite addnE; simpl;
        unfold num_cpus, divn; simpl.

      rewrite [edf_rta_iteration]lock; simpl.

      unfold locked at 18; destruct master_key; f.
      unfold locked at 17; destruct master_key; f.
      unfold locked at 16; destruct master_key; f.
      unfold locked at 15; destruct master_key; f.
      unfold locked at 14; destruct master_key; f.
      unfold locked at 13; destruct master_key; f.
      unfold locked at 12; destruct master_key; f.
      unfold locked at 11; destruct master_key; f.
      unfold locked at 10; destruct master_key; f.
      unfold locked at 9; destruct master_key; f.
      unfold locked at 8; destruct master_key; f.
      unfold locked at 7; destruct master_key; f.
      unfold locked at 6; destruct master_key; f.
      unfold locked at 5; destruct master_key; f.
      unfold locked at 4; destruct master_key; f.
      unfold locked at 3; destruct master_key; f.
      unfold locked at 2; destruct master_key; f.
      by unfold locked at 1; destruct master_key; f.
    Qed.

    (* Let arr_seq be the periodic arrival sequence from ts. *)
    Let arr_seq := periodic_arrival_sequence ts.

    (* Let sched be the work-conserving EDF scheduler. *)
    Let sched := scheduler job_arrival job_cost num_cpus arr_seq
                           (JLFP_to_JLDP (EDF job_arrival job_deadline)).

    (* Recall the definition of deadline miss. *)
    Let no_deadline_missed_by :=
      task_misses_no_deadline job_arrival job_cost job_deadline job_task arr_seq sched.

    (* Next, we prove that ts is schedulable with the result of the test. *)
    Corollary ts_is_schedulable:
      forall tsk,
        tsk \in ts ->
        no_deadline_missed_by tsk.
    Proof.
      intros tsk IN.
      have VALID := periodic_arrivals_valid_job_parameters ts ts_has_valid_parameters.
      have TSVALID := ts_has_valid_parameters.
      unfold valid_sporadic_job, valid_realtime_job in *; des.
      apply taskset_schedulable_by_edf_rta with (task_cost := task_cost)
        (task_period := task_period) (task_deadline := task_deadline) (ts0 := ts); try (by done).
      - by apply ts_has_constrained_deadlines.
      - by apply periodic_arrivals_all_jobs_from_taskset.
      - by apply periodic_arrivals_are_sporadic.
      - by apply scheduler_jobs_come_from_arrival_sequence.
      - by apply scheduler_jobs_must_arrive_to_execute.
      - apply scheduler_completed_jobs_dont_execute.
        -- by apply periodic_arrivals_are_consistent.
        -- by apply periodic_arrivals_is_a_set.
      - by apply scheduler_work_conserving, periodic_arrivals_are_consistent.
      - apply scheduler_respects_policy.
        -- by apply periodic_arrivals_are_consistent.
        -- by intros t; apply RM_is_transitive.
        -- by intros t x y; apply leq_total.
      - by apply schedulability_test_succeeds.
    Qed.

  End ExampleRTA.

End ResponseTimeAnalysisEDF.


(** * Coercions between the various (co)unit definitions *)
Require Import Category.Core Functor.Core NaturalTransformation.Core.
Require Import Category.Dual Functor.Dual NaturalTransformation.Dual.
Require Import Adjoint.UnitCounit Adjoint.Dual.
Require Import Functor.Composition.Core Functor.Identity NaturalTransformation.Composition.Core.
Require Import HoTT.Tactics Basics.Trunc Types.Sigma.

Set Universe Polymorphism.
Set Implicit Arguments.
Generalizable All Variables.
Set Asymmetric Patterns.

Local Open Scope natural_transformation_scope.
Local Open Scope category_scope.
Local Open Scope morphism_scope.

Section equivalences.
  Section from_unit_counit.
    Local Ltac unit_counit_of_t :=
      repeat
        match goal with
          | _ => split
          | _ => intro
          | _ => progress auto with morphism
          | _ => progress simpl
          | _ => rewrite !composition_of
          | [ |- context[components_of ?T] ]
            => (try_associativity_quick simpl rewrite <- (commutes T));
              try_associativity_quick
                progress
                rewrite ?unit_counit_equation_1, ?unit_counit_equation_2
          | [ |- context[components_of ?T] ]
            => (try_associativity_quick simpl rewrite (commutes T));
              try_associativity_quick
                progress
                rewrite ?unit_counit_equation_1, ?unit_counit_equation_2
          | _ => progress path_induction
        end.

    (** ** unit+counit+zig+zag → unit+UMP *)
    Definition adjunction_unit__of__adjunction_unit_counit
               C D F G (A : @AdjunctionUnitCounit C D F G)
    : AdjunctionUnit F G.
    Proof.
      exists (unit A).
      intros c d f.
      apply contr_inhabited_hprop;
        [ apply hprop_allpath
        | (exists (counit A d o F _1 f));
          abstract unit_counit_of_t ].
      intros [? ?] [? ?].
      apply path_sigma_uncurried.
      let A := match goal with |- @sigT ?A ?P => constr:(A) end in
      let H := fresh in
      assert (H : A);
        [
        | exists H;
            exact (center _) ].
      simpl.
      let x := match goal with |- ?x = ?y => constr:(x) end in
      let y := match goal with |- ?x = ?y => constr:(y) end in
      rewrite <- (right_identity _ _ _ x),
      <- (right_identity _ _ _ y),
      <- !(unit_counit_equation_1 A),
      <- ?associativity;
        repeat simpl rewrite <- (commutes (counit A));
        (try_associativity_quick rewrite <- !composition_of);
        repeat apply ap;
        etransitivity; [ | symmetry ]; eassumption.
    Defined.

    (** ** unit+counit+zig+zag → counit+UMP *)
    Definition adjunction_counit__of__adjunction_unit_counit
               C D F G (A : @AdjunctionUnitCounit C D F G)
    : AdjunctionCounit F G
      := adjunction_counit__op__adjunction_unit
           (adjunction_unit__of__adjunction_unit_counit A^op).
  End from_unit_counit.

  Section to_unit_counit.
    Ltac to_unit_counit_nt helper commutes_tac :=
      simpl;
      intros;
      apply helper;
      repeat match goal with
               | _ => reflexivity
               | _ => rewrite !composition_of
               | _ => progress
                        rewrite ?identity_of, ?left_identity, ?right_identity
               | [ |- context[?x.1] ]
                 => try_associativity_quick simpl rewrite x.2
               | [ |- context[components_of ?T] ]
                 => simpl_do_clear commutes_tac (commutes T)
             end.

    (** ** unit+UMP → unit+counit+zig+zag *)
    Section from_unit.
      Variables C D : PreCategory.
      Variable F : Functor C D.
      Variable G : Functor D C.

      Lemma counit_natural_transformation__of__adjunction_unit_helper
            (A : AdjunctionUnit F G)
            s d (m : morphism D s d)
            (eta := A.1)
            (eps := fun X => (@center _ (A.2 (G X) X 1)).1)
      : G _1 (eps d o F _1 (G _1 m)) o eta (G s) = G _1 m
        -> G _1 (m o eps s) o eta (G s) = G _1 m
        -> eps d o F _1 (G _1 m) = m o eps s.
      Proof.
        intros.
        transitivity (@center _ (A.2 _ _ (G _1 m))).1; [ symmetry | ];
        let x := match goal with |- _ = ?x => constr:(x) end in
        refine ((fun H => ap pr1 (@contr _ (A.2 _ _ (G _1 m)) (x; H))) _);
        assumption.
      Qed.

      Definition counit_natural_transformation__of__adjunction_unit
                 (A : AdjunctionUnit F G)
      : NaturalTransformation (F o G) 1.
      Proof.
        refine (Build_NaturalTransformation
                  (F o G) 1
                  (fun d => (@center _ (A.2 (G d) d 1)).1)
                  _).
        abstract (
            to_unit_counit_nt
              counit_natural_transformation__of__adjunction_unit_helper
              ltac:(fun H => try_associativity_quick rewrite <- H)
          ).
      Defined.

      Definition zig__of__adjunction_unit
                 (A : AdjunctionUnit F G)
                 (Y : C)
                 (eta := A.1)
                 (eps := fun X => (@center _ (A.2 (G X) X 1)).1)
      : G _1 (eps (F Y) o F _1 (eta Y)) o eta Y = eta Y
        -> eps (F Y) o F _1 (eta Y) = 1.
      Proof.
        intros.
        etransitivity; [ symmetry | ];
        simpl_do_clear
          ltac:(fun H => apply H)
                 (fun y H => (@contr _ (A.2 _ _ (A.1 Y)) (y; H))..1);
        try assumption.
        simpl.
        rewrite ?identity_of, ?left_identity, ?right_identity;
          reflexivity.
      Qed.

      Definition adjunction_unit_counit__of__adjunction_unit
                 (A : AdjunctionUnit F G)
      : AdjunctionUnitCounit F G.
      Proof.
        exists A.1
               (counit_natural_transformation__of__adjunction_unit A);
        simpl;
        intros;
        try match goal with
              | [ |- context[?x.1] ] => exact x.2
            end;
        [].
        abstract (to_unit_counit_nt
                    zig__of__adjunction_unit
                    ltac:(fun H => try_associativity_quick rewrite <- H)).
      Defined.
    End from_unit.

    (** ** counit+UMP → unit+counit+zig+zag *)
    Definition adjunction_unit_counit__of__adjunction_counit
               C D F G (A : @AdjunctionCounit C D F G)
    : AdjunctionUnitCounit F G
      := ((adjunction_unit_counit__of__adjunction_unit
             (adjunction_unit__op__adjunction_counit__inv A))^op)%adjunction.
  End to_unit_counit.
End equivalences.

Coercion adjunction_unit__of__adjunction_unit_counit
: AdjunctionUnitCounit >-> AdjunctionUnit.
Coercion adjunction_counit__of__adjunction_unit_counit
: AdjunctionUnitCounit >-> AdjunctionCounit.


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

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

Print Assumptions freeze.


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

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

Print Assumptions freeze.


Require Import ListAux.
Require Import TreeAux.
Lemma stream1consistent_Force0 (il_0:list nat) (il_1:list nat) (u_0:nat) : (id_spec  il_0 il_1) -> (((list_member  il_0 u_0)) -> (list_member  il_1 u_0)).
Proof. solve_id. Qed.

Lemma stream1consistent_Force1 (il_0:list nat) (il_1:list nat) (u_0:nat) : (id_spec  il_0 il_1) -> (((not (list_member  il_0 u_0))) -> (not (list_member  il_1 u_0))).
Proof. solve_id. Qed.


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

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

Print Assumptions freeze.


Require Import ModelProperties.
Require Import AuxiliaryLemmas.

Section writeIsSecure.

Lemma WritePSS :
 forall (s t : SFSstate) (eSub : ENTITY),
 SecureState s -> TransFunc eSub s Write t -> SecureState t.
StartPSS.
inversion H.
auto.

Qed.

Lemma WritePSP :
 forall (s t : SFSstate) (eSub : ENTITY),
 StarProperty s -> TransFunc eSub s Write t -> StarProperty t.
StartPSP.
inversion H.
auto.

Qed.

End writeIsSecure.

Hint Resolve WritePSS WritePSP.


(**  ** Syntax

The syntactic elements (type [Econ]) includes:
- [cn]: Denoting a constant of type [nat]
- [pl]: Denoting addition of numerical constants.
- [tup4]: Denoting tuples of 4 elements

The signature also includes the following atomic predicates:

- [T(t)]: denoting the current time-unit

- [C(n,c,f,lm)]: denoting a cell n, in a compartment c (breast, blood, or
  bone), with a phenotype given by a fitness degree (a number in the interval 0
.. 12) and a list of driver mutations lm.

 - [A(n)]: representing the fact that the cell n has gone to apoptosis.

This file defines some numerical constants used in the model. For instance,
there are three possible locations: [breast], [blood] and [bone] denotes,
respectively as the constants 1,2,3.

 *)

Require Export FLL.Misc.Hybrid.
Require Export FLL.SL.FLLTactics.
Require Export FLL.Misc.Permutations.
Require Import Coq.Init.Nat.

Export ListNotations.
Export LLNotations.
Set Implicit Arguments.

(** ** Numerical constants *)
(** Mutations *)
Definition TGFbeta := 1 .
Definition EPCAM   := 2 .
Definition CD47    := 3 .
Definition CD44    := 4 .
Definition MET     := 5 .
Definition seeded  := 6.

(** Locations *)
Definition breast  := 1.
Definition blood   := 2.
Definition bone    := 3.

(** Binary encoding of (some) lists of Mutations *)
Definition NONE       := 0 .
Definition TG         := 32 .
Definition EP         := 16 .
Definition EPCD       := 24 .
Definition EPCDME     := 26 .
Definition EPCDCD     := 28 .
Definition EPCDCDME   := 30 .
Definition EPCDCDMEse := 31 .

(** [plusOne] defines how to "add" a new mutation to a list of mutations *)
Inductive plusOne : nat ->nat -> Prop :=
| po_nt : plusOne NONE TG
| po_ne  :plusOne TG EP
| po_ep1 : plusOne EP EPCD
| po_epcd1 : plusOne EPCD EPCDME
| po_epcd2 : plusOne EPCD EPCDCD
| po_epcdme1 : plusOne EPCDCD EPCDCDME
| po_epcdme2 : plusOne EPCDME EPCDCDME
| po_epmese : plusOne EPCDCDME EPCDCDMEse.

Hint Constructors plusOne : core .

(** Numerical constants defining how the time pass in each cell's
* transformation *)

Definition d00 := 1 .
Definition d01 (f:nat) := 1 .
Definition d02 := 3 .
Definition d10 := 1 .
Definition d10r := 1 .
Definition d11 (f:nat) := 1 .
Definition d12 := 3 .
Definition d20 (f:nat) := 1 .
Definition d20r (f:nat) := f .
Definition d21 (f:nat) := f .
Definition d22 (f:nat) := 1 .
Definition d30 (f:nat) := 1 .
Definition d30r (f:nat) := f .
Definition d31 (f:nat) := f .
Definition d32 (f:nat) := f .
Definition d40 (f:nat) := f .
Definition d41 (f:nat) := f .
Definition d42 (f:nat) := f .
Definition d43 (f:nat) := f .
Definition d50 (f:nat) := f .
Definition d51 (f:nat) := match f with
                          | 1 | 2 => f
                          | 3 | 4 => f -1
                          | _ => f -2
                          end.
Definition d52 (f:nat) := 3 .
Definition d60 (f:nat) := 1 .
Definition d61 (f:nat) := match f with
                          | 1 | 2 => f
                          | 3 | 4 => f -1
                          | _ => f -2
                          end.
Definition d62 (f:nat) := 3 .
Definition d70 (f:nat) := 1 .

Definition d71 (f:nat) := match f with
                          | 1 | 2 => f
                          | 3 | 4 => f -1
                          | 5 | 6 => f -2
                          | _ => f -3
                          end.

Definition d72 (f:nat) := 2 .
Definition d80 (f:nat) := 1 .

Definition d81 (f:nat) := match f with
                          | 1  => f
                          | 2 | 3 => 2
                          | 4 | 5 => 3
                          | 6 | 7 => 4
                          | _ => 5
                          end.

Definition d82 (f:nat) := 2 .

(** Syntactic elements *)
Inductive Econ : Set :=
| cn :  nat -> Econ (* Constant of type nat *)
| pl : Econ (* plus *)
| tup4 : Econ (* tuples of 4 elements *)
.

Definition uexp := expr Econ.

(** The three needed atomic predicates *)
Inductive Atom:Set :=
| T : uexp -> Atom (* Time unit *)
| C : uexp -> Atom (* cell representation *)
| A : uexp -> Atom (* Apoptosis *)
.

(** Uniform conditions on atomic propositions *)
Inductive uniform_atm' : (uexp -> Atom) -> Prop :=
| uniform_t: forall FX, uniform FX -> uniform_atm' (fun x:uexp => T (FX x))
| uniform_c: forall FX, uniform FX -> uniform_atm' (fun x:uexp => C (FX x))
| uniform_a: forall FX, uniform FX -> uniform_atm' (fun x:uexp => A (FX x))
  .

  (** More suitable constructors to work with *)
  Definition CN n   := (CON (cn n)) .
  Definition PL T1 T2 := (APP (APP (CON pl) T1) T2).
  Definition TUP T1 T2 T3 T4 := (APP (APP (APP (APP (CON pl) T1) T2) T3) T4).

  Notation "d 's+' t" := (PL d t) (at level 80, right associativity).
  Notation "A{ n }"   := (A n) . (* nat constants *)
  Notation "C{ n ; c ; f ; lm }" := (C (TUP n (CN c) (CN f) (CN lm))) . (* nat constants *)
  Notation "T{ n }"   := (T n) .

  Hint Constructors uniform_atm'  : core.

  (** Instantiating the LL signature *)
  Global Instance Signature : OLSig :=
    {|
      con := Econ;
      atm := Atom;
      uniform_atm := uniform_atm'
    |}.

  Definition T' : uexp -> atm := T.
  Definition C' : uexp -> atm := C.
  Definition A' : uexp -> atm := A.

  Notation "A'{ n }"   := (A' n) . (* nat constants *)
  Notation "C'{ n ; c ; f ; lm }" := (C' (TUP n (CN c) (CN f) (CN lm))) . (* nat constants *)
  Notation "T'{ n }"   := (T' n) .

  (** Well formed condition for terms *)

  Inductive IsTerm : uexp -> Prop :=
  | isTerm1 : forall n, IsTerm (CN n)
  | isTerm2 : forall A B, IsTerm A -> IsTerm B -> IsTerm (PL A B)
  .
  Hint Constructors IsTerm : core .


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

Derive Show for natural.

              Derive Arbitrary for natural.

              Instance Dec_Eq_natural : Dec_Eq natural.

              Proof. dec_eq. Qed.
Derive Show for lst.

              Derive Arbitrary for lst.

              Instance Dec_Eq_lst : Dec_Eq lst.

              Proof. dec_eq. Qed.

Lemma conj13synthconj3 : forall  (lv0 : lst) (lv1 : natural), (@eq natural (len (append lv0 (Cons lv1 lv0))) (len (Cons lv1 (append lv0 lv0)))).
Admitted.
QuickChick conj13synthconj3.


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

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

Print Assumptions freeze.


(** * Attributes of functors (full, faithful, split essentially surjective) *)
Require Import Category.Core Functor.Core HomFunctor Category.Morphisms Category.Dual Functor.Dual Category.Prod Functor.Prod NaturalTransformation.Core SetCategory.Core Functor.Composition.Core.
Require Import Basics.Trunc Types.Universe HIT.iso HoTT.Truncations.

Set Universe Polymorphism.
Set Implicit Arguments.
Generalizable All Variables.
Set Asymmetric Patterns.

Local Open Scope category_scope.

Section full_faithful.
  Context `{Funext}.
  Variables C D : PreCategory.
  Variable F : Functor C D.

  (** ** Natural transformation [hom_C(─, ─) → hom_D(Fᵒᵖ(─), F(─))] *)
  (** TODO(JasonGross): Come up with a better name and location for this. *)
  Definition induced_hom_natural_transformation
  : NaturalTransformation (hom_functor C) (hom_functor D o (F^op, F)).
  Proof.
    refine (Build_NaturalTransformation
              (hom_functor C)
              (hom_functor D o (F^op, F))
              (fun (sd : object (C^op * C)) m => (F _1 m)%morphism)
              _
           ).
    abstract (
        repeat (intros [] || intro);
        simpl in *;
          repeat (apply path_forall; intro);
        simpl;
        rewrite !composition_of;
        reflexivity
      ).
  Defined.

  (** ** Full *)
  Class IsFull
    := is_full
       : forall x y : C,
           IsEpimorphism (induced_hom_natural_transformation (x, y)).
  (** ** Faithful *)
  Class IsFaithful
    := is_faithful
       : forall x y : C,
           IsMonomorphism (induced_hom_natural_transformation (x, y)).

  (** ** Fully Faithful *)
  Class IsFullyFaithful
    := is_fully_faithful
       : forall x y : C,
           IsIsomorphism (induced_hom_natural_transformation (x, y)).

  (** ** Fully Faithful → Full *)
  Global Instance isfull_isfullyfaithful `{IsFullyFaithful}
  : IsFull.
  Proof.
    intros ? ?; hnf in * |- .
    typeclasses eauto.
  Qed.

  (** ** Fully Faithful → Faithful *)
  Global Instance isfaithful_isfullyfaithful `{IsFullyFaithful}
  : IsFaithful.
  Proof.
    intros ? ?; hnf in * |- .
    typeclasses eauto.
  Qed.

  (** ** Full * Faithful → Fully Faithful *)
  (** We start with a helper method, which assumes that epi * mono → iso, and ten prove this assumption *)
  Lemma isfullyfaithful_isfull_isfaithful_helper `{IsFull} `{IsFaithful}
        (H' : forall x y (m : morphism set_cat x y),
                IsEpimorphism m
                -> IsMonomorphism m
                -> IsIsomorphism m)
  : IsFullyFaithful.
  Proof.
    intros ? ?; hnf in * |- .
    apply H'; eauto.
  Qed.
End full_faithful.

Section fully_faithful_helpers.
  Context `{ua : Univalence}.
  Variables x y : HSet.
  Variable m : x -> y.

  Lemma isisomorphism_isequiv_set_cat
        `{H' : IsEquiv _ _ m}
  : IsIsomorphism (m : morphism set_cat x y).
  Proof.
    exists (m^-1)%core;
    apply path_forall; intro;
    destruct H';
    simpl in *;
    eauto.
  Qed.

  Definition isequiv_isepimorphism_ismonomorphism
             (Hepi : IsEpimorphism (m : morphism set_cat x y))
             (Hmono : IsMonomorphism (m : morphism set_cat x y))
  : @IsEquiv _ _ m
    (* NB: This depends on the (arguably accidental) fact that `ismono` and `isepi` from HoTT core are *definitionally* identical to the specialization of `IsMonomorphism` and `IsEpimorphism` to the category of sets. *)
    := @isequiv_isepi_ismono _ x y m Hepi Hmono.
End fully_faithful_helpers.

Global Instance isfullyfaithful_isfull_isfaithful
       `{Univalence}
       `{Hfull : @IsFull _ C D F}
       `{Hfaithful : @IsFaithful _ C D F}
: @IsFullyFaithful _ C D F
  := fun x y => @isisomorphism_isequiv_set_cat
                  _ _ _ _
                  (@isequiv_isepimorphism_ismonomorphism
                     _ _ _ _
                     (Hfull x y)
                     (Hfaithful x y)).

(** ** Split Essentially Surjective *)
(** Quoting the HoTT Book:

    We say a functor [F : A → B] is _split essentially surjective_ if
    for all [b : B] there exists an [a : A] such that [F a ≅ b]. *)

Class IsSplitEssentiallySurjective A B (F : Functor A B)
  := is_split_essentially_surjective
     : forall b : B, exists a : A, F a <~=~> b.

(** ** Essentially Surjective *)
(** Quoting the HoTT Book:

    A functor [F : A → B] is _split essentially surjective_ if for all
    [b : B] there _merely_ exists an [a : A] such that [F a ≅ b]. *)
Class IsEssentiallySurjective A B (F : Functor A B)
  := is_essentially_surjective
     : forall b : B, hexists (fun a : A => F a <~=~> b).

(** ** Weak Equivalence *)
(** Quoting the HoTT Book:

    We say [F] is a _weak equivalence_ if it is fully faithful and
    essentially surjective. *)
Class IsWeakEquivalence `{Funext} A B (F : Functor A B)
  := { is_fully_faithful__is_weak_equivalence : IsFullyFaithful F;
       is_essentially_surjective__is_weak_equivalence : IsEssentiallySurjective F }.
#[export] Existing Instances
  is_fully_faithful__is_weak_equivalence
  is_essentially_surjective__is_weak_equivalence.


Require Import List.
Require Export Util Get Drop Var Val Isa.Ops IL.Exp
        Envs Map CSet AutoIndTac MoreList OptionMap.
Require Export IL.Events SizeInduction SmallStepRelations StateType.
Require Import SetOperations.

Inductive statement :=
| WhileCond (e:op) (s t:list statement)
| WhileWhile (e:op) (s:list statement)
| WhileLet (x:var) (e:exp)
| WhileReturn (e:op).

Instance statement_size : Size statement. gen_Size. Defined.

Definition program := list statement.

Definition state : Type := (onv val * list statement)%type.

Inductive step : state -> event -> state -> Prop :=
| StepLet p E x e v
          (def:op_eval E e = Some v)
  : step (E, WhileLet x (Operation e)::p) EvtTau (E[x<-Some v], p)
| StepExtern p E x f Y vl v
             (def:omap (op_eval E) Y = Some vl)
  : step  (E, WhileLet x (Call f Y)::p)
          (EvtExtern (ExternI f vl v))
          (E[x <- Some v], p)
| StepIfT p E e b1 b2 v
          (def:op_eval E e = Some v)
          (condTrue: val2bool v = true)
  : step (E, WhileCond e b1 b2::p) EvtTau (E, b1 ++ p)
| StepIfF p E e b1 b2 v
          (def:op_eval E e = Some v)
          (condFalse: val2bool v = false)
  : step (E, WhileCond e b1 b2::p) EvtTau (E, b2 ++ p)
| StepWhileF p E e s v
            (def:op_eval E e = Some v)
            (condFalse: val2bool v = false)
  : step (E, WhileWhile e s::p) EvtTau (E, p)
| StepWhileT p E e s v
          (def:op_eval E e = Some v)
          (condFalse: val2bool v = true)
  : step (E, WhileWhile e s::p) EvtTau (E, s ++ WhileWhile e s::p).

Lemma step_dec
  : reddec2 step.
Proof.
  hnf; intros. destruct x as [V [|[| | |]]].
  - right. stuck.
  - case_eq (op_eval V e); intros.
    left. case_eq (val2bool v); intros; do 2 eexists; eauto using step.
    right. stuck.
  - case_eq (op_eval V e); intros.
    left. case_eq (val2bool v); intros; do 2 eexists; eauto using step.
    right. stuck.
  - destruct e.
    + case_eq (op_eval V e); intros. left. do 2 eexists. eauto 20 using step.
      right. stuck.
    + case_eq (omap (op_eval V) Y); intros; try now (right; stuck).
      left; eexists (EvtExtern (ExternI f l0 (default_val))).
      eexists; eauto using step.
  - right. stuck.
Qed.

Lemma step_internally_deterministic
  : internally_deterministic step.
Proof.
  hnf; intros.
  inv H; inv H0; split; eauto; try get_functional; try congruence.
Qed.

Lemma step_externally_determined
  : externally_determined step.
Proof.
  hnf; intros.
  inv H; inv H0; eauto; try get_functional; try congruence.
Qed.

Definition state_result (s:state) : option val :=
  match s with
    | (E, WhileReturn e::_) => op_eval E e
    | _ => None
  end.

Instance statetype_While : StateType state := {
  step := step;
  result := state_result;
  step_dec := step_dec;
  step_internally_deterministic := step_internally_deterministic;
  step_externally_determined := step_externally_determined
}.


(******************************************)
(*   Finite multiset library              *)
(*   Developped for the PACTOLE project   *)
(*   L. Rieg                              *)
(*                                        *)
(*   This file is distributed under       *)
(*   the terms of the CeCILL-C licence    *)
(*                                        *)
(******************************************)

Require Import Lia.
Require Import Arith.Div2.
Require Import Reals.
Require Import List.
Require Import Morphisms.
Require Import Sorting.Permutation.
Require Import Psatz.
Require Import SetoidList.
Require Export SetoidPermutation.

Set Implicit Arguments.
Require Import Bool.

Ltac autoclass := eauto with typeclass_instances.
Ltac inv H := inversion H; subst; clear H.

(* A tactic to destruct matches *)
Ltac destr_match A :=
  match A with | context[match ?x with | _ => _ end] =>
    destr_match x (* recursive call *)
    || destruct x eqn:? (* if innermost match, destruct it *)
  end.

Ltac destruct_match := match goal with | |- ?A => destr_match A end.

(* Seems useless…
Global Instance NotRel_symmetric A (R : relation A) `(Symmetric A R) : Symmetric (fun x y => ~R x y).
Proof. intros x y Hxy Habs. apply Hxy. now symmetry. Qed.
*)
Lemma nat_compare_Eq_comm : forall n m, Nat.compare n m = Eq <-> Nat.compare m n = Eq.
Proof using . intros n m. do 2 rewrite Nat.compare_eq_iff. now split. Qed.

Lemma nat_compare_Lt_Gt : forall n m, Nat.compare n m = Lt <-> Nat.compare m n = Gt.
Proof using . intros n m. rewrite <- nat_compare_lt, <- nat_compare_gt. now split. Qed.

Definition injective {A B : Type} eqA eqB (f : A -> B) := (forall x y, eqB (f x) (f y) -> eqA x y).

Definition transpose2 {A B C : Type} eqC (f : A -> B -> C -> C) :=
  forall x y x' y' z, eqC (f x x' (f y y' z)) (f y y' (f x x' z)).

Definition additive2 {A B : Type} eqB (f : A -> nat -> B -> B) :=
  forall x n p z, eqB (f x n (f x p z)) (f x (n + p) z).

Instance compose_compat {A B C : Type} eqA eqB eqC : forall (f : A -> B) (g : B -> C),
  Proper (eqA ==> eqB) f -> Proper (eqB ==> eqC) g -> Proper (eqA ==> eqC) (fun x => g (f x)).
Proof using . intros f g Hf Hg x y Heq. now apply Hg, Hf. Qed.

Instance compose2_compat {A B C D : Type} eqA eqB eqC eqD : forall (f : A -> B) (g : B -> C -> D),
  Proper (eqA ==> eqB) f -> Proper (eqB ==> eqC ==> eqD) g -> Proper (eqA ==> eqC ==> eqD) (fun x => g (f x)).
Proof using . intros f g Hf Hg x y Heq. now apply Hg, Hf. Qed.

Instance compose3_compat {A B C D E : Type} eqA eqB eqC eqD eqE : forall (f : A -> B) (g : B -> C -> D -> E),
  Proper (eqA ==> eqB) f -> Proper (eqB ==> eqC ==> eqD ==> eqE) g ->
  Proper (eqA ==> eqC ==> eqD ==> eqE) (fun x => g (f x)).
Proof using . intros f g Hf Hg x y Heq. now apply Hg, Hf. Qed.

(* ************************************ *)
(** * Some necessary results on Lists.  *)
(* ************************************ *)

Section List_results.
Context (A B C : Type).
Context (eqA eqA' : relation A) (eqB : relation B).
Context (HeqA : Equivalence eqA) (HeqB : Equivalence eqB).

Lemma length_1 : forall l : list A, length l = 1 <-> exists x, l = x :: nil.
Proof using . intros [| ? [| ? ?]]; simpl; split; try discriminate; eauto; intros [? ?]; discriminate. Qed.

Lemma In_InA_weak : forall x l, In x l -> InA eqA x l.
Proof using HeqA.
intros x l Hin. induction l.
- inversion Hin.
- destruct Hin. subst. now left. right. auto.
Qed.

Lemma PermutationA_subrelation_compat : Proper (subrelation ==> eq ==> eq ==> impl) (@PermutationA A).
Proof using .
intros eqA1 eqA2 Hrel l1 l2 H12 l3 l4 H34 Hperm. subst. induction Hperm.
- constructor.
- constructor. now apply Hrel. assumption.
- constructor 3.
- now constructor 4 with l₂.
Qed.

Lemma NoDupA_2 : forall x y, ~eqA x y -> NoDupA eqA (x :: y :: nil).
Proof using .
intros x y Hdiff. constructor.
  intro Habs. inversion_clear Habs.
    now elim Hdiff.
    inversion H.
  apply NoDupA_singleton.
Qed.

Lemma NoDupA_3 : forall x y z, ~eqA x y -> ~eqA y z -> ~eqA x z -> NoDupA eqA (x :: y :: z :: nil).
Proof using .
intros x y z Hxy Hyz Hxz. constructor.
  intro Habs. inversion_clear Habs. contradiction. inversion_clear H. contradiction. inversion_clear H0.
  now apply NoDupA_2.
Qed.

Global Instance PermutationA_eq_compat : Proper ((eq ==> eq ==> iff) ==> eq ==> eq ==> iff) (@PermutationA A).
Proof using .
intros f g Hfg l1 l2 Hl12 l3 l4 Hl34. subst l4 l2. split; intro H.
+ induction H.
  - constructor.
  - constructor. now rewrite <- (Hfg _ _ (eq_refl x₁) _ _ (eq_refl x₂)). assumption.
  - constructor 3.
  - now constructor 4 with l₂.
+ induction H.
  - constructor.
  - constructor. now rewrite (Hfg _ _ (eq_refl x₁) _ _ (eq_refl x₂)). assumption.
  - constructor 3.
  - now constructor 4 with l₂.
Qed.

Global Instance eqlistA_PermutationA_subrelation : subrelation (eqlistA eqA) (PermutationA eqA).
Proof using . intros l l' Hl. induction Hl; constructor; assumption. Qed.

Theorem InA_map_iff : forall f, Proper (eqA ==> eqB) f ->
  forall l y, InA eqB y (map f l) <-> exists x, eqB (f x) y /\ InA eqA x l.
Proof using HeqA HeqB.
intros f Hf l y. induction l.
+ split; intro Hin.
  - inversion Hin.
  - destruct Hin as [x [_ Hin]]. inversion Hin.
+ split; intro Hin.
  - inversion_clear Hin.
      exists a. split. now symmetry. now left.
      rewrite IHl in H. destruct H as [x [Hx H]]. exists x; auto.
  - destruct Hin as [x [Hx Hin]]. inversion_clear Hin.
      left. now rewrite <- Hx, H.
      simpl. right. rewrite IHl. exists x. now split.
Qed.

Lemma removeA_out eq_dec : forall x l, ~InA eqA x l -> @removeA A eqA eq_dec x l = l.
Proof using .
intros x l Hin. induction l; simpl.
+ reflexivity.
+ destruct (eq_dec x a).
  - elim Hin. now left.
  - f_equal. apply IHl. intro Habs. apply Hin. now right.
Qed.

Lemma removeA_InA_out eq_dec : forall x y l, ~eqA x y ->
  (InA eqA x (@removeA A eqA eq_dec y l) <-> InA eqA x l).
Proof using HeqA.
intros x y l Hxy. induction l. reflexivity.
simpl. destruct (eq_dec y a).
  subst. rewrite IHl. split; intro H. now right. inversion_clear H.
    elim Hxy. now transitivity a.
    assumption.
  split; intro H; inversion_clear H; (now left) || right; now rewrite IHl in *.
Qed.
Global Arguments removeA_InA_out eq_dec [x] y l _.

Theorem removeA_InA_iff_strong eqA'' eq_dec : subrelation eqA'' eqA ->
  forall x y l, InA eqA'' x (@removeA A eqA eq_dec y l) <-> InA eqA'' x l /\ ~eqA x y.
Proof using HeqA.
intros Hsub x y l. induction l as [| a l].
* split; intro Habs. inversion Habs. destruct Habs as [Habs _]. inversion Habs.
* simpl. destruct (eq_dec y a) as [Heq | Hneq].
  + rewrite IHl. intuition. inversion_clear H2. apply Hsub in H0. now elim H3; transitivity a. assumption.
  + split; intro Hin.
    - inversion_clear Hin.
        split. now left. rewrite H. intro. now apply Hneq.
        rewrite IHl in H. destruct H. split; trivial. now right.
    - destruct Hin as [Hin ?]. inversion_clear Hin.
        now left.
        right. rewrite IHl. now split.
Qed.

Theorem removeA_InA_iff eq_dec : forall x y l, InA eqA x (@removeA A eqA eq_dec y l) <-> InA eqA x l /\ ~eqA x y.
Proof using HeqA. apply (removeA_InA_iff_strong eq_dec). reflexivity. Qed.

Lemma removeA_InA_weak eq_dec : forall x y l, InA eqA' x (@removeA A eqA eq_dec y l) -> InA eqA' x l.
Proof using .
intros x y l Hin. induction l; simpl in *.
+ rewrite InA_nil in Hin. elim Hin.
+ destruct (eq_dec y a) as [Heq | Heq].
  - auto.
  - inversion_clear Hin; auto.
Qed.

Corollary removeA_inclA eq_dec : subrelation eqA' eqA -> forall x l, inclA eqA' (@removeA A eqA eq_dec x l) l.
Proof using HeqA. intros. intro. rewrite removeA_InA_iff_strong; tauto. Qed.

Global Instance removeA_eq_compat eq_dec : Proper (eqA ==> eq ==> eq) (@removeA A eqA eq_dec).
Proof using HeqA.
intros x y Hxy l l' ?. subst l'. induction l; simpl.
+ reflexivity.
+ destruct (eq_dec x a) as [Heqx | Hneqx], (eq_dec y a) as [Heqy | Hneqy].
  - apply IHl.
  - elim Hneqy. now rewrite <- Hxy.
  - elim Hneqx. now rewrite Hxy.
  - f_equal. apply IHl.
Qed.

Global Instance removeA_Perm_compat eq_dec :
  Proper (eqA ==> PermutationA eqA ==> PermutationA eqA) (@removeA A eqA eq_dec).
Proof using HeqA.
intros x y ? l1 l2 Hl. subst. induction Hl.
+ constructor.
+ simpl. destruct (eq_dec x x₁) as [Heq₁ | Hneq₁], (eq_dec y x₂) as [Heq₂ | Hneq₂].
  - assumption.
  - elim Hneq₂. now rewrite <- H, Heq₁.
  - elim Hneq₁. now rewrite H, Heq₂.
  - now apply PermutationA_cons.
+ simpl. destruct (eq_dec x x0), (eq_dec y y0), (eq_dec y x0), (eq_dec x y0);
  try (now elim n; rewrite H) || (now elim n; rewrite <- H).
  - now erewrite removeA_eq_compat.
  - constructor. reflexivity. now erewrite removeA_eq_compat.
  - elim n0. now rewrite <- H.
  - constructor. reflexivity. now erewrite removeA_eq_compat.
  - elim n1. now rewrite H.
  - elim n0. now rewrite <- H.
  - etransitivity. constructor 3. repeat constructor; reflexivity || now erewrite removeA_eq_compat.
+ constructor 4 with (removeA eq_dec y l₂).
  - assumption.
  - transitivity (removeA (eqA:=eqA) eq_dec x l₂). now erewrite removeA_eq_compat. assumption.
Qed.

Lemma removeA_app eq_dec : forall (x : A) l1 l2,
  @removeA A eqA eq_dec x (l1 ++ l2) = removeA eq_dec x l1 ++ removeA eq_dec x l2.
Proof using .
intros x l1 l2. induction l1. reflexivity. simpl.
destruct (eq_dec x a). apply IHl1. simpl. f_equal. apply IHl1.
Qed.

Corollary removeA_inside_in eq_dec :
  forall (x : A) l1 l2, @removeA A eqA eq_dec x (l1 ++ x :: l2) = removeA eq_dec x l1 ++ removeA eq_dec x l2.
Proof using HeqA. intros x ? ?. rewrite removeA_app. simpl. destruct (eq_dec x x) as [| Hneq]; trivial. now elim Hneq. Qed.

Corollary removeA_inside_out eq_dec : forall (x y : A) l1 l2,
  ~eqA x y -> @removeA A eqA eq_dec x (l1 ++ y :: l2) = removeA eq_dec x l1 ++ y :: removeA eq_dec x l2.
Proof using . intros x y ? ? ?. rewrite removeA_app. simpl. destruct (eq_dec x y). contradiction. reflexivity. Qed.

Lemma removeA_idempotent eq_dec : forall x l, @removeA A eqA eq_dec x (removeA eq_dec x l) = removeA eq_dec x l.
Proof using .
intros x l. induction l.
+ reflexivity.
+ simpl. destruct (eq_dec x a) eqn:Hx.
  - assumption.
  - simpl. rewrite Hx. now rewrite IHl.
Qed.

Lemma removeA_comm eq_dec : forall (x y : A) l,
  @removeA A eqA eq_dec x (removeA eq_dec y l) = removeA eq_dec y (removeA eq_dec x l).
Proof using .
intros x y l. induction l.
  reflexivity.
  simpl. destruct (eq_dec y a) eqn:Hy, (eq_dec x a) eqn:Hx; simpl;
  try rewrite Hx; try rewrite Hy; simpl; now rewrite IHl.
Qed.

Lemma removeA_length_le eq_dec : forall l (x : A), length (@removeA A eqA eq_dec x l) <= length l.
Proof using .
intros l x. induction l; simpl.
  reflexivity.
  destruct (eq_dec x a); simpl; lia.
Qed.

Lemma removeA_NoDupA eq_dec : forall x l, NoDupA eqA l -> NoDupA eqA (@removeA A eqA eq_dec x l).
Proof using HeqA.
intros x l Hl. induction Hl; simpl.
+ constructor.
+ destruct (eq_dec x x0).
  - assumption.
  - constructor; trivial. intro Habs. apply H. eapply removeA_InA_iff; eassumption.
Qed.

Global Instance InA_impl_compat : Proper (subrelation ==> eq ==> eq ==> impl) (@InA A).
Proof using .
intros R1 R2 HR x y Hxy l l2 Hl Hin. subst y l2. induction l.
  now inversion Hin.
  inversion_clear Hin.
    constructor. now apply HR.
    constructor 2. now apply IHl.
Qed.

Lemma PermutationA_nil : forall l, PermutationA eqA l nil -> l = nil.
Proof using HeqA.
intros l Hl. destruct l.
  reflexivity.
  exfalso. rewrite <- InA_nil. rewrite (PermutationA_equivlistA HeqA).
    now left.
    symmetry. eassumption.
Qed.

Global Instance InA_compat : Proper (eqA ==> equivlistA eqA ==> iff) (InA eqA).
Proof using HeqA.
intros x y Hxy l1 l2 Hl. split; intro H; eapply InA_eqA; try eassumption.
  now rewrite <- Hl.
  symmetry. eassumption.
  now rewrite Hl.
Qed.

Global Instance InA_perm_compat : Proper (eqA ==> PermutationA eqA ==> iff) (InA eqA).
Proof using HeqA. intros x y Hxy l1 l2 Hl. now apply InA_compat; try apply PermutationA_equivlistA. Qed.

Lemma PermutationA_InA_inside : forall (x : A) l l',
  PermutationA eqA l l' -> InA eqA x l -> exists l1 y l2, eqA x y /\ l' = l1 ++ y :: l2.
Proof using HeqA. intros x l l' Hperm Hin. rewrite Hperm in Hin. apply (InA_split Hin). Qed.

Lemma PermutationA_cons_split : forall (x : A) l l',
  PermutationA eqA (x :: l) l' -> exists l'', PermutationA eqA l' (x :: l'').
Proof using HeqA.
intros x l l' Hperm. assert (Hin : InA eqA x l'). { rewrite <- Hperm. now left. }
symmetry in Hperm. destruct (PermutationA_InA_inside Hperm Hin) as [l1 [y [l2 [Heq Hll]]]].
exists (l1 ++ l2). rewrite Hperm, Hll. etransitivity. symmetry. apply (PermutationA_middle _).
constructor. now symmetry. reflexivity.
Qed.

Theorem PermutationA_ind_bis :
 forall P : list A -> list A -> Prop,
   P nil nil ->
   (forall x₁ x₂ l l', eqA x₁ x₂ -> PermutationA eqA l l' -> P l l' -> P (x₁ :: l) (x₂ :: l')) ->
   (forall x y l l', PermutationA eqA l l' -> P l l' -> P (y :: x :: l) (x :: y :: l')) ->
   (forall l l' l'', PermutationA eqA l l' -> P l l' -> PermutationA eqA l' l'' -> P l' l'' -> P l l'') ->
   forall l l', PermutationA eqA l l' -> P l l'.
Proof using HeqA.
  intros P Hnil Hskip Hswap Htrans.
  induction 1; auto.
    apply Hswap; auto.
      reflexivity.
      induction l; auto. now apply Hskip.
    now apply Htrans with l₂.
Qed.

Ltac break_list l x l' H := destruct l as [| x l']; inversion H; subst; simpl in *.

Theorem PermutationA_app_inv : forall (l1 l2 l3 l4:list A) a,
  PermutationA eqA (l1++a::l2) (l3++a::l4) -> PermutationA eqA (l1++l2) (l3 ++ l4).
Proof using HeqA.
  set (P l l' :=
         forall a b l1 l2 l3 l4, eqA a b -> l=l1++a::l2 -> l'=l3++b::l4 -> PermutationA eqA (l1++l2) (l3++l4)).
  cut (forall l l', PermutationA eqA l l' -> P l l').
  intros; apply (H _ _ H0 a a); auto. reflexivity.
  intros; apply (PermutationA_ind_bis P); unfold P; clear P; try clear H l l'; simpl; auto.
+ (* nil *)
  intros; destruct l1; simpl in *; discriminate.
+ (* skip *)
  intros x x' l l' Heq H IH; intros.
  break_list l1 c l1' H1; break_list l3 d l3' H2.
  - now auto.
  - rewrite H. symmetry. etransitivity.
      constructor 2. transitivity a. symmetry. apply Heq. apply H0. reflexivity.
      now apply PermutationA_middle.
  - rewrite <- H. etransitivity.
      constructor 2. transitivity b. apply Heq. symmetry. apply H0. reflexivity.
      now apply PermutationA_middle.
  - rewrite (IH a _ _ _ _ _ H0 eq_refl eq_refl). now constructor 2.
+ (* contradict *)
  intros x y l l' Hp IH; intros.
  break_list l1 c l1' H0; break_list l3 d l3' H1.
  - now constructor 2.
  - break_list l3' c l3'' H4.
      now constructor 2.
      rewrite <- PermutationA_middle in Hp. now rewrite Hp, H. refine _.
  - break_list l1' d l1'' H0.
      now constructor 2.
      rewrite <- PermutationA_middle in Hp. now rewrite <- H, Hp. refine _.
  - break_list l3' e l3'' H1; break_list l1' g l1'' H4.
      now constructor 2.
      rewrite <- PermutationA_middle in Hp. rewrite permA_swap, <- H. now constructor 2. refine _.
      rewrite permA_swap, PermutationA_middle, H. now constructor 2. refine _.
      now rewrite permA_swap, (IH a _ _ _ _ _ H eq_refl eq_refl).
+ (* trans *)
  intros.
  destruct (@InA_split _ eqA l' a) as [l'1 [y [l'2 [H7 H6]]]].
  - rewrite <- H. subst l. rewrite InA_app_iff. now right; left.
  - apply permA_trans with (l'1++l'2).
      apply (H0 _ _ _ _ _ _ H7 H4 H6).
      rewrite H7 in H3. apply (H2 _ _ _ _ _ _ H3 H6 H5).
Qed.

Theorem PermutationA_cons_inv :
   forall l l' (a : A), PermutationA eqA (a::l) (a::l') -> PermutationA eqA l l'.
Proof using HeqA. intros; exact (PermutationA_app_inv nil l nil l' a H). Qed.

Global Instance PermutationA_length : Proper (PermutationA eqA ==> Logic.eq) (@length A).
Proof using HeqA.
intro l. induction l; intros l' Hperm.
  symmetry in Hperm. apply PermutationA_nil in Hperm. now subst.
  assert (Hp := @PermutationA_InA_inside a _ _ Hperm).
  destruct Hp as [l1 [y [l2 [Heq1 Heq2]]]]. now left. subst l'.
  rewrite app_length. simpl. rewrite <- plus_n_Sm. f_equal. rewrite <- app_length.
  apply IHl. apply PermutationA_cons_inv with a.
  transitivity (l1 ++ y :: l2). assumption. etransitivity. symmetry. apply PermutationA_middle. assumption.
  constructor. now symmetry. reflexivity.
Qed.

Lemma PermutationA_NoDupA : forall (l l' : list A), PermutationA eqA l l' -> NoDupA eqA l -> NoDupA eqA l'.
Proof using HeqA.
intros l l' Hperm. induction Hperm; intro Hdup.
+ trivial.
+ inversion_clear Hdup. constructor.
    intro Habs. apply H0. now rewrite Hperm, H.
    now apply IHHperm.
+ inversion_clear Hdup. inversion_clear H0. constructor.
    intros Habs. inversion_clear Habs. apply H. now left. contradiction.
    constructor. intro Habs. apply H. now right. assumption.
+ auto.
Qed.

Global Instance PermutationA_NoDupA_compat : Proper (PermutationA eqA ==> iff) (NoDupA eqA).
Proof using HeqA. now repeat intro; split; apply PermutationA_NoDupA. Qed.

Lemma PermutationA_length1 : forall x l, PermutationA eqA l (x :: nil) -> eqlistA eqA l (x :: nil).
Proof using HeqA.
intros x l Hperm. destruct l as [| a [| b l]].
- symmetry in Hperm. apply PermutationA_nil in Hperm. discriminate Hperm.
- repeat constructor. apply PermutationA_InA_inside with a _ _ in Hperm; try now left.
  destruct Hperm as [l1 [y [l2 [Heq Hl]]]].
  destruct l1 as [| ? [| ? ?]], l2 as [| ? ?]; try discriminate Hl. inversion_clear Hl. assumption.
- apply PermutationA_length in Hperm. simpl in Hperm. lia.
Qed.

Lemma NoDupA_strengthen : forall l, subrelation eqA eqA' -> NoDupA eqA' l -> NoDupA eqA l.
Proof using .
intros l HAB Hl. induction l.
  constructor.
  inversion_clear Hl. constructor.
    intro Habs. apply H. clear -Habs HAB. induction Habs.
      left. now apply (HAB a y).
      now right.
    now apply IHl.
Qed.

Global Instance fold_left_start : forall f, Proper (eqB ==> eqA ==> eqB) f ->
  forall l, Proper (eqB ==> eqB) (fold_left f l).
Proof using HeqA HeqB.
intros f Hf l. induction l; intros i1 i2 Hi; simpl.
  assumption.
  rewrite IHl. reflexivity. now rewrite Hi.
Qed.

Global Instance fold_left_symmetry_PermutationA : forall (f : B -> A -> B),
  Proper (eqB ==> eqA ==> eqB) f -> (forall x y z, eqB (f (f z x) y) (f (f z y) x)) ->
  Proper (PermutationA eqA ==> eqB ==> eqB) (fold_left f).
Proof using HeqA HeqB.
intros f Hfcomm Hf l1 l2 perm. induction perm; simpl.
- now repeat intro.
- intros ? ? Heq. rewrite H, Heq. now apply IHperm.
- intros ? ? Heq. now rewrite Hf, Heq.
- repeat intro. etransitivity. now apply IHperm1. now apply IHperm2.
Qed.

Global Instance fold_left_compat : forall f, Proper (eqB ==> eqA ==> eqB) f ->
  Proper (eqlistA eqA ==> eqB ==> eqB) (fold_left f).
Proof using .
intros (*A' B' eqA2 eqB2*) f Hf l1 l2 eq. induction eq as [| ? ? ? ? Hx Hl IHeq].
+ repeat intro. simpl. assumption.
+ intros a b Hab. simpl. apply IHeq. apply Hf; assumption.
Qed.

Global Instance fold_left_extensional :
  Proper ((eqB ==> eqA ==> eqB) ==> eqlistA eqA ==> eqB ==> eqB) (@fold_left _ _).
Proof using .
intros f g Hfg l. induction l.
+ intros l' Hl ? ? ?. destruct l'; trivial; []. inversion Hl.
+ intros l' Hl ? ? ?. destruct l'; simpl.
  - inversion Hl.
  - inversion_clear Hl. now apply IHl, Hfg.
Qed.

Global Instance PermutationA_map : forall f, Proper (eqA ==> eqB) f ->
  Proper (PermutationA eqA ==> PermutationA eqB) (map f).
Proof using HeqB.
intros f Hf l l' perm. induction perm; simpl.
  reflexivity.
  constructor 2. now rewrite H. now apply IHperm.
  now constructor 3.
  now transitivity (map f l₂).
Qed.

Lemma HdRel_app : forall l1 l2 R (a : A), HdRel R a l1 -> HdRel R a l2 -> HdRel R a (l1++l2).
Proof using . induction l1; simpl; auto. intros. inversion_clear H. now constructor. Qed.

Lemma sort_app : forall R,
  forall l1 l2 : list A, sort R l1 -> sort R l2 -> (forall x y, In x l1 -> In y l2 -> R x y) -> sort R (l1 ++ l2).
Proof using .
induction l1; simpl in *; intuition. constructor.
+ apply IHl1.
  - now inversion_clear H.
  - assumption.
  - intros. apply H1. now right. assumption.
+ apply HdRel_app.
  - now inversion H.
  - destruct l2; constructor. apply H1; now left.
Qed.

Lemma NoDupA_dec : (forall x y : A, {eqA x y} + {~eqA x y}) -> forall l : list A, {NoDupA eqA l} + {~NoDupA eqA l}.
Proof using .
intros eq_dec l. induction l. now left; constructor.
destruct IHl as [Hbad | Hok].
  destruct (InA_dec eq_dec a l).
    right. intro Habs. inversion_clear Habs. contradiction.
    left. now constructor.
  right. intro Habs. inversion_clear Habs. contradiction.
Qed.

Lemma PermutationA_split : forall x l, InA eqA x l -> exists l', PermutationA eqA l (x :: l').
Proof using HeqA.
intros x l Hin. induction l; inversion_clear Hin.
  exists l. now rewrite H.
  apply IHl in H. destruct H as [l' Hperm]. exists (a :: l'). transitivity (a :: x :: l').
    now rewrite <- Hperm.
    constructor 3.
Qed.

Lemma inclA_cons : forall x y l1 l2, eqA x y -> inclA eqA l1 l2 -> inclA eqA (x :: l1) (y :: l2).
Proof using HeqA.
intros x y l1 l2 Heq Hincl z Hin. inversion_clear Hin.
- left. now transitivity x.
- right. now apply Hincl.
Qed.

Global Instance inclA_PermutationA_compat : Proper (PermutationA eqA ==> PermutationA eqA ==> iff) (inclA eqA).
Proof using HeqA. intros ? ? Hperm1 ? ? Hperm2. unfold inclA. setoid_rewrite Hperm1. setoid_rewrite Hperm2. reflexivity. Qed.

Lemma inclA_cons_inv : forall x y l1 l2,
  ~InA eqA x l1 -> eqA x y -> inclA eqA (x :: l1) (y :: l2) -> inclA eqA l1 l2.
Proof using HeqA.
intros x y l1 l2 Hx Heq Hincl z Hin.
assert (Hin' : InA eqA z (x :: l1)) by now right. apply Hincl in Hin'.
inversion_clear Hin'; trivial. elim Hx. now rewrite Heq, <- H.
Qed.

Lemma inclA_length : forall l1 l2, NoDupA eqA l1 -> inclA eqA l1 l2 -> length l1 <= length l2.
Proof using HeqA.
intro l1. induction l1 as [| x l]; intros l2 Hnodup Hle.
+ auto with arith.
+ assert (Hin : InA eqA x l2). { apply Hle. now left. }
  apply PermutationA_split in Hin. destruct Hin as [l' Hin]. rewrite Hin. simpl. apply le_n_S. apply IHl.
  - now inversion Hnodup.
  - intros y Hy. rewrite Hin in Hle. inversion_clear Hnodup. apply inclA_cons_inv in Hle; auto. reflexivity.
Qed.

Lemma not_NoDupA : (forall x y, {eqA x y} + {~eqA x y} ) ->
 forall l, ~NoDupA eqA l <-> exists (x : A) l', PermutationA eqA l (x :: x :: l').
Proof using HeqA.
intros eq_dec l. split; intro Hl.
+ induction l.
    elim Hl. now constructor.
    destruct (InA_dec eq_dec a l) as [Hin | Hnin].
      exists a. apply PermutationA_split in Hin. destruct Hin as [l' Hperm]. exists l'. now rewrite Hperm.
      destruct IHl as [x [l' Hperm]].
        intro Habs. apply Hl. now constructor.
        exists x. exists (a :: l'). rewrite Hperm. transitivity (x :: a :: x :: l').
          now constructor 3.
          apply PermutationA_cons. reflexivity. constructor 3.
+ destruct Hl as [x [l' Hperm]]. rewrite Hperm. intro Habs. inversion_clear Habs. apply H. now left.
Qed.

Theorem PermutationA_rev : forall l, PermutationA eqA l (rev l).
Proof using HeqA.
induction l; simpl.
+ reflexivity.
+ change (a :: l) with ((a :: Datatypes.nil) ++ l).
  rewrite PermutationA_app_comm; trivial. now apply PermutationA_app.
Qed.

Theorem partition_filter : forall (f : A -> bool) l, partition f l = (filter f l, filter (fun x => negb (f x)) l).
Proof using .
intros f l. induction l as [| a l]; simpl.
  reflexivity.
  rewrite IHl. now destruct (f a).
Qed.

Corollary partition_fst_In : forall (x : A) f l, In x (fst (partition f l)) <-> In x l /\ f x = true.
Proof using . intros. rewrite partition_filter. apply filter_In. Qed.

Corollary partition_snd_In : forall (x : A) f l, In x (snd (partition f l)) <-> In x l /\ f x = false.
Proof using . intros. rewrite partition_filter. rewrite <- negb_true_iff. apply filter_In. Qed.

Theorem partition_length : forall f (l : list A),
  length (fst (partition f l)) + length (snd (partition f l)) = length l.
Proof using .
intros f l. rewrite partition_filter in *. induction l; simpl.
+ reflexivity.
+ destruct (f a); simpl.
  - f_equal. apply IHl.
  - rewrite <- plus_n_Sm. f_equal. apply IHl.
Qed.

Corollary filter_length : forall f (l : list A),
  length (filter f l) = length l - length (filter (fun x => negb (f x)) l).
Proof using . intros. apply plus_minus. rewrite <- (partition_length f), partition_filter. simpl. apply plus_comm. Qed.

Lemma map_cond_Permutation : forall (f : A -> bool) (g₁ g₂ : A -> B) l,
  Permutation (map (fun x => if f x then g₁ x else g₂ x) l)
              (map g₁ (filter f l) ++ map g₂ (filter (fun x => negb (f x)) l)).
Proof using .
intros f ? ? l. induction l; simpl.
+ reflexivity.
+ destruct (f a); simpl.
  - apply Permutation_cons; trivial.
  - rewrite IHl. apply Permutation_middle.
Qed.

Theorem Forall_dec : forall P (Pdec : forall x : A, {P x} + {~P x}), forall l, {Forall P l} + {~Forall P l}.
Proof using .
intros P Pdec l. induction l; simpl.
+ left. constructor.
+ destruct (Pdec a) as [Ha | Ha].
  - destruct IHl as [Hok | Hko].
      left. now constructor.
      right. intros Habs. inversion_clear Habs. contradiction.
  - right. intros Habs. inversion_clear Habs. contradiction.
Qed.

Lemma fold_left_map : forall (f : C -> B -> C) (g : A -> B) (l : list A) (x : C),
  fold_left f (map g l) x = fold_left (fun acc x => f acc (g x)) l x.
Proof using .
intros f g l. induction l; intro x; simpl.
  reflexivity.
  now rewrite IHl.
Qed.

Lemma fold_left_cons_length_aux : forall (f : A -> B) l1 l2,
  length (fold_left (fun acc x => f x :: acc) l1 l2) = length l1 + length l2.
Proof using .
intros f l1. induction l1; intro l2; simpl.
  reflexivity.
  rewrite IHl1. simpl. lia.
Qed.

Corollary fold_left_cons_length : forall (f : A -> B) l,
  length (fold_left (fun acc x => f x :: acc) l nil) = length l.
Proof using . intros. rewrite fold_left_cons_length_aux. simpl. lia. Qed.

Lemma NoDupA_inj_map :
  forall (f : A -> B) (l : list A), Proper (eqA ==> eqB) f -> injective eqA eqB f ->
  (NoDupA eqB (map f l) <-> NoDupA eqA l).
Proof using HeqA HeqB.
intros f l Hf Hinj. induction l; simpl.
+ split; constructor.
+ split; intro Hl; constructor.
  - intro Habs. inversion_clear Hl. apply H. rewrite InA_map_iff; try eassumption. exists a. now split.
  - rewrite <- IHl. now inversion_clear Hl.
  - intro Habs. inversion_clear Hl. apply H. rewrite InA_map_iff in Habs; try eassumption.
    destruct Habs as [x [Heq Hin]]. apply Hinj in Heq. now rewrite Heq in Hin.
  - rewrite IHl. now inversion_clear Hl.
Qed.

Lemma NoDupA_inclA_length : forall l1 l2, NoDupA eqA l1 -> inclA eqA l1 l2 -> length l1 <= length l2.
Proof using HeqA.
intro l1. induction l1 as [| a l1]; intros l2 Hnodup Hincl.
+ simpl. lia.
+ assert (Hin : InA eqA a l2). { apply Hincl. now left. }
  apply PermutationA_split in Hin. destruct Hin as [l2' Heql2].
  rewrite Heql2 in *. inversion_clear Hnodup.
  apply inclA_cons_inv in Hincl; reflexivity || trivial; [].
  simpl. apply le_n_S. now apply IHl1.
Qed.

Lemma NoDupA_app_iff : forall l l' : list A, NoDupA eqA (l ++ l')
  <-> NoDupA eqA l /\ NoDupA eqA l' /\ (forall x : A, InA eqA x l -> InA eqA x l' -> False).
Proof using HeqA.
intros l l'. split; intro H; try now apply NoDupA_app.
induction l; simpl in *.
  split. constructor. split. assumption. intros ? Habs. now inversion Habs.
  inversion_clear H. apply IHl in H1. destruct H1 as [H1 [H2 H3]]. repeat split; trivial.
    constructor. intro Habs. apply H0. rewrite InA_app_iff; trivial. now left. assumption.
    intros x Hin1 Hin2. inversion_clear Hin1.
      apply H0. rewrite InA_app_iff. right. now rewrite <- H.
      now apply (H3 x).
Qed.

Lemma NoDupA_swap_iff : forall (l l' : list A) (x : A), NoDupA eqA (l ++ x :: l') <-> NoDupA eqA (x :: l ++ l').
Proof using HeqA.
intros l l'. split; intro H. now apply NoDupA_swap.
inversion_clear H. rewrite InA_app_iff in H0; trivial.
rewrite NoDupA_app_iff in *; trivial. destruct H1 as [H1 [H2 H3]]. repeat split.
  assumption.
  constructor.
    intro Habs. apply H0. now right.
    assumption.
  intros a Hl Hl'. inversion_clear Hl'.
    apply H0. left. now rewrite <- H.
    now apply (H3 a).
Qed.

Lemma NoDupA_filter_compat : forall f, Proper (eqA ==> eq) f -> forall l, NoDupA eqA l -> NoDupA eqA (filter f l).
Proof using .
intros f Hf l Hnodup. induction Hnodup; simpl.
- constructor.
- destruct (f x) eqn:Hfx; trivial. constructor; trivial. rewrite filter_InA; intuition.
Qed.

Global Instance filter_PermutationA_compat : forall f, Proper (eqA ==> eq) f ->
  Proper (PermutationA eqA ==> PermutationA eqA) (filter f).
Proof using HeqA.
intros f Hf l1 l2 perm. induction perm.
- reflexivity.
- simpl. destruct (f x₁) eqn:Hfx; rewrite H in Hfx; rewrite Hfx; now try constructor.
- simpl. destruct (f x), (f y); try now constructor. reflexivity.
- rewrite IHperm1. apply IHperm2.
Qed.

Global Instance Forall_PermutationA_compat : forall f, Proper (eqA ==> iff) f ->
  Proper (PermutationA eqA ==> iff) (Forall f).
Proof using .
intros f Hf l1 l2 perm. induction perm.
- tauto.
- apply Hf in H. split; intro Hrec; inversion_clear Hrec; left + right; tauto.
- split; intro Hrec; inversion_clear Hrec; inversion_clear H0; repeat constructor; assumption.
- tauto.
Qed.

Global Instance Exists_PermutationA_compat : forall f, Proper (eqA ==> iff) f ->
  Proper (PermutationA eqA ==> iff) (Exists f).
Proof using .
intros f Hf l1 l2 perm. induction perm.
- tauto.
- apply Hf in H. split; intro Hrec; inversion_clear Hrec; left + right; tauto.
- split; intro Hrec; inversion_clear Hrec; try inversion_clear H; left + right; tauto || (left + right; tauto).
- tauto.
Qed.

End List_results.

Lemma le_neq_lt : forall m n : nat, n <= m -> n <> m -> n < m.
Proof using . intros n m Hle Hneq. now destruct (le_lt_or_eq _ _ Hle). Qed.

Lemma min_is_0 : forall n m, min n m = 0 <-> n = 0 \/ m = 0.
Proof using . intros [| n] [| m]; intuition;discriminate. Qed.

Lemma max_is_0 : forall n m, max n m = 0 <-> n = 0 /\ m = 0.
Proof using . intros [| n] [| m]; intuition; discriminate. Qed.

Lemma Bleb_refl : forall x, Bool.le x x.
Proof using . intros [|]; simpl; auto. Qed.


Require Import VerdiRaft.Raft.
Require Import VerdiRaft.RaftRefinementInterface.

Section LeaderLogsLogProperties.
  Context {orig_base_params : BaseParams}.
  Context {one_node_params : OneNodeParams orig_base_params}.
  Context {raft_params : RaftParams orig_base_params}.

  Definition log_property (P : list entry -> Prop) :=
    forall net h,
      refined_raft_intermediate_reachable net ->
      P (log (snd (nwState net h))).

  Definition log_properties_hold_on_leader_logs net :=
    forall P h t ll,
      log_property P ->
      In (t, ll) (leaderLogs (fst (nwState net h))) ->
      P ll.

  Class log_properties_hold_on_leader_logs_interface : Prop :=
    {
      log_properties_hold_on_leader_logs_invariant :
        forall (net : network),
          refined_raft_intermediate_reachable net ->
          log_properties_hold_on_leader_logs net
    }.

End LeaderLogsLogProperties.