Require Import GraphBasics.Graphs.
Require Import GraphBasics.Trees.
Require Import Coq.Logic.Classical_Prop.
Require Export Coq.Bool.BoolEq.

(* part of the network model that represents the underlying network graph *)
(* we model the topology of a network as a connected undirected graph *)
Section Topology.

Notation "a =/= b" := (beq_nat (Some a) (Some b)) (at level 70).
Notation "a == b" := (beq_nat a b) (at level 70).

(* a component is modelled as a vertex (of a graph) *)
Definition Component := Vertex.

(* each component has a unique identifier *)
Definition component_index (c : Component):nat := match c with
                          | index x => x
                          end.

(* from vertices to components *)
(* our universe is a set of components *)
Definition C_set := U_set Component.
Definition C_list := U_list Component.
Definition C_nil:= V_nil.

(* it is decidable whether two components x,y are the same or different *)
Lemma C_eq_dec : forall x y : Component, {x = y} + {x <> y}.
Proof.
        simple destruct x; simple destruct y; intros.
        case (eq_nat_dec n n0); intros.
        left; rewrite e; trivial.
        right; injection; trivial.
Qed.

(* CA_list is a list of the set of arcs a *)
(* we match over the constructors of the connected graph c *)
Fixpoint CA_list (v : V_set) (a : A_set) (c : Connected v a) {struct c} :
 A_list :=
  match c with
  | C_isolated x => A_nil
  | C_leaf v' a' c' x y _ _ => A_ends x y :: A_ends y x :: CA_list v' a' c'
  | C_edge v' a' c' x y _ _ _ _ _ =>
      A_ends x y :: A_ends y x :: CA_list v' a' c'
  | C_eq v' _ a' _ _ _ c' => CA_list v' a' c'
  end.

(* CV_list is a list of the set vertices v *)
Fixpoint CV_list (v : V_set) (a : A_set) (c: Connected v a) {struct c} :
 V_list :=
  match c with
  | C_isolated x => x::V_nil
  | C_leaf v' a' c' x y _ _ => y :: CV_list v' a' c'
  | C_edge v' a' c' x y _ _ _ _ _  => CV_list v' a' c'
  | C_eq v' _ a' _ _ _ c' => CV_list v' a' c'
  end.

(* necessary as an Axiom?
Variable Component_prop: forall (c:Component)(v : V_set) (a : A_set)(g : Connected v a),
In c (CV_list v a g). *)

(* connected graph is symmetric and thereby represents an undirected graph *)
Lemma C_non_directed: forall (v : V_set) (a : A_set) (c : Connected v a) (x y : Vertex),
 a (A_ends x y) -> a (A_ends y x).
Proof.
intros.
apply Connected_Isa_Graph in c.
apply G_non_directed with (v:=v).
apply c.
apply H.
Qed.

(**)
Fixpoint beq_nat (n m : nat) : bool :=
  match n with
  | O => match m with
         | O => true
         | S m' => false
         end
  | S n' => match m with
            | O => false
            | S m' => beq_nat n' m'
            end
  end.

(* true iff components n and m are equal *)
Definition beq_comp (n m : Component) : bool :=
beq_nat (component_index n) (component_index m).

(* Basic properties for beq: maybe these arent used*)
(*
(* alternatively to the definition of beq *)
Variable beq : Component -> Component -> bool.
Variable beq_refl : forall x:Component, true = beq x x.

Variable beq_eq : forall x y:Component, true = beq x y -> x = y.

Variable beq_eq_true : forall x y:Component, x = y -> true = beq x y.

Variable beq_eq_not_false : forall x y:Component, x = y -> false <> beq x y.

Variable beq_false_not_eq : forall x y:Component, false = beq x y -> x <> y.

Variable exists_beq_eq : forall x y:Component, {b : bool | b = beq x y}.

Variable not_eq_false_beq : forall x y:Component, x <> y -> false = beq x y.

Variable eq_dec : forall x y:Component, {x = y} + {x <> y}.
*)

(* true iff component a is in list l *)
Fixpoint In_bool (a: Component) (l:C_list) : bool:=
  match l with
  | nil => false
  | b :: m => beq_comp b a || In_bool a m
  end.

(* list of neighbors of component c *)
Definition neighbors (v : V_set) (a : A_set) (g : Connected v a) (c: Component) : C_list :=
(A_in_neighborhood c (CA_list v a g)).

(* since the graph is symmetric, the in- and out-neighborhood is the same*)
Lemma neighbors_connected_prop :
forall k (v : V_set) (a : A_set)(g : Connected v a) (c: Component),
 In k (A_out_neighborhood c (CA_list v a g)) <-> In k (A_in_neighborhood c (CA_list v a g)).
Proof.
  split.
{ intros.
  induction g.
  - auto.
  - simpl in *.
    destruct (V_eq_dec c y).
    destruct (V_eq_dec c x).
    simpl in *.
    repeat destruct H; auto.
    simpl in *; auto.
    repeat destruct H; auto.
    destruct (V_eq_dec c x).
    simpl in *; auto.
    repeat destruct H; auto.
    apply (IHg H).
  - simpl in *.
    destruct (V_eq_dec c y).
    destruct (V_eq_dec c x).
    simpl.
    simpl in H.
    destruct H.
    right.
    left.
    apply H.
    destruct H.
    left.
    apply H.
    apply IHg in H.
    right.
    right.
    apply H.

    simpl in *.
    destruct H.
    left. apply H.
    right. apply (IHg H).

    destruct (V_eq_dec c x).
    simpl in *.
    destruct H.
    left. apply H.
    right. apply (IHg H).
    apply (IHg H).
  - rewrite <- e.
    rewrite <- e0.
    apply (IHg H). }

{ intros.
  induction g.
  - auto.
  - simpl in *.
    destruct (V_eq_dec c x).
    destruct (V_eq_dec c y).
    simpl in *.
    repeat destruct H; auto.
    simpl in *.
    repeat destruct H; auto.
    destruct (V_eq_dec c y).
    simpl in *.
    repeat destruct H; auto.
    apply (IHg H).
  - simpl in *.
    destruct (V_eq_dec c x).
    destruct (V_eq_dec c y).
    simpl in *.
    repeat destruct H; auto.
    simpl in *.
    repeat destruct H; auto.
    destruct (V_eq_dec c y).
    simpl in *.
    repeat destruct H; auto.
    apply (IHg H).
  - rewrite <- e.
    rewrite <- e0.
    apply (IHg H). }
Qed.

(* for a parent k of c holds that k is also a neighbor of c *)
Lemma parent_neighbors_: forall (v: V_set) (a: A_set)(g: Connected v a) (c k:Component),
a (A_ends c k) <-> In k (A_in_neighborhood c (CA_list v a g)).
Proof.
  split; intros.
{ induction g.
  - auto.
    inversion H.
  - simpl in *.
    destruct (V_eq_dec c y).
    destruct (V_eq_dec c x).
    simpl in *.
    inversion H.
    inversion H0.
    right. left. reflexivity.
    left. reflexivity.
    right. right. apply (IHg H0).
    simpl in *.
    inversion H.
    inversion H0.
    symmetry in H3. intuition.
    left. auto.
    right. apply (IHg H0).
    destruct (V_eq_dec c x).
    simpl in *.
    inversion H.
    inversion H0.
    left. reflexivity.
    symmetry in H3. intuition.
    right. apply (IHg H0).
    inversion H.
    inversion H0; symmetry in H3; intuition.
    apply (IHg H0).
  - simpl in *.
    destruct (V_eq_dec c y).
    destruct (V_eq_dec c x).
    simpl in *.
    inversion H.
    inversion H0.
    right. left. reflexivity.
    left. reflexivity.
    right. right. apply (IHg H0).
    simpl in *.
    inversion H.
    inversion H0.
    symmetry in H3. intuition.
    left. auto.
    right. apply (IHg H0).
    destruct (V_eq_dec c x).
    simpl in *.
    inversion H.
    inversion H0.
    left. reflexivity.
    symmetry in H3. intuition.
    right. apply (IHg H0).
    inversion H.
    inversion H0; symmetry in H3; intuition.
    apply (IHg H0).
  - rewrite <- e.
    rewrite <- e0.
    rewrite <- e0 in H.
    simpl.
    apply (IHg H). }
{ induction g.
  - auto.
    inversion H.
  - simpl in *.
    destruct (V_eq_dec c y).
    destruct (V_eq_dec c x).
    rewrite e in *. rewrite e0 in *.
    apply n in v0. intuition.
    rewrite e in *. simpl in *.
    destruct H. apply In_left. rewrite H in *. apply E_left.
    apply In_right. apply (IHg H).
    destruct (V_eq_dec c x).
    simpl in *; destruct H; auto.
    rewrite e in *; rewrite H in *.
    apply In_left. apply E_right.
    apply In_right. apply (IHg H).
    apply In_right. apply (IHg H).
  - simpl in *.
    destruct (V_eq_dec c y).
    destruct (V_eq_dec c x).
    rewrite e in *. rewrite e0 in *.
    intuition.
    rewrite e in *. simpl in *.
    destruct H. apply In_left. rewrite H in *. apply E_left.
    apply In_right. apply (IHg H).
    destruct (V_eq_dec c x).
    simpl in *; destruct H; auto.
    rewrite e in *; rewrite H in *.
    apply In_left. apply E_right.
    apply In_right. apply (IHg H).
    apply In_right. apply (IHg H).
  - rewrite <- e in *.
    rewrite <- e0 in *.
    simpl in *.
    apply (IHg H). }
Qed.

(* true iff list l contains (multiple times) only component c *)
Fixpoint forallb_neighbors (l:C_list) (c:Component) : bool :=
      match l with
        | nil => true
        | a::k => beq_comp a c && forallb_neighbors k c
      end.

(*  *)
Lemma forallb_forall_ : forall (l:C_list) (c:Component),
(forallb_neighbors l c = true) <-> (forall x, In x l ->  x = c).
Proof.
  split; intros.
{ induction l.
  - inversion H0.
  - simpl in H.
    apply andb_prop in H.
    destruct H.
    unfold beq_comp in H.
    apply Nat.eqb_eq in H.
    destruct (a).
    destruct (c).
    unfold component_index in H.
    simpl in H0.
    destruct H0.
    rewrite <- H. rewrite <- H0. reflexivity.
    apply (IHl H1 H0). }
{ induction l.
  - reflexivity.
  - intuition.
    simpl. apply andb_true_intro.
    split.
    symmetry. apply beq_eq_true.
    simpl in H. intuition.
    destruct x.
    unfold beq_comp.
    simpl.
    symmetry.
    apply <- Nat.eqb_eq.
    reflexivity.
    specialize (H a).
    apply H.
    simpl.
    left.
    reflexivity.
    apply IHl.
    intros.
    apply H.
    simpl. right. apply H0. }
Qed.

(* if an arc is in the arc set a, then it is also in the arc list CA_list *)
Lemma arc_list_set: forall (v: V_set)(a: A_set)(g: Connected v a) (x y : Component),
a (A_ends x y) -> In (A_ends x y) (CA_list v a g).
Proof.
  intros.
  induction g.
  - inversion H.
  - simpl in *.
    inversion H.
    inversion H0.
    auto.
    auto.
    right. right. apply (IHg H0).
  - simpl in *.
    inversion H.
    inversion H0 ; auto.
    right. right. apply (IHg H0).
  - rewrite <- e in *. rewrite <- e0 in *.
    apply (IHg H).
Qed.

(* if there is an arc from y to x in the list CA_list, then x is a neighbor of y *)
Lemma arc_list_neighbors:
forall (v: V_set)(a: A_set)(g: Connected v a) x y,
In (A_ends x y) (CA_list v a g) -> In x (neighbors v a g y).
Proof.
intros.
unfold neighbors.
unfold A_in_neighborhood.
induction ( (CA_list v a g)).
contradiction.
destruct a0.
destruct (V_eq_dec y v1).
destruct H.
unfold In.
left.
inversion H.
destruct H.
trivial.
unfold In.
right.
unfold In in IHa0.
apply IHa0.
unfold In in H.
trivial.
destruct H.
inversion H.
rewrite H2 in n.
contradiction.
apply IHa0.
trivial.
Qed.

(* if there is an arc from y to x in a, then comp1 is a neighbor of comp2 *)
Lemma neighbourslist_prep:
forall (v: V_set)(a: A_set)(g: Connected v a)(comp1 comp2: Component),
a (A_ends comp1 comp2) -> In comp1 (neighbors v a g comp2).
Proof.
unfold neighbors.
intros.
apply (arc_list_set v a g) in H.
apply arc_list_neighbors in H.
unfold neighbors in H.
trivial.
Qed.

(* if there is a path from comp1 to comp2 with x being the first component on the path,
 * then comp1 is a neighbor of x *)
Lemma neighbourslist2:
forall (v: V_set)(a: A_set)(g: Connected v a)(x comp1 comp2: Component)  (el : E_list) (clist: list Component),
 Path v a comp1 comp2 (x::clist) el -> In comp1  (neighbors v a g x).
Proof.
intros.
apply neighbourslist_prep.
inversion H.
trivial.
Qed.

(* removes a component from a list of components *)
Fixpoint remove (x : Component) (l : list Component) : list Component :=
    match l with
    | nil => nil
    | y::tl => if ((component_index x) == (component_index y)) then tl else y::(remove x tl)
    end.

(* true iff a list of component is empty *)
Definition empty (l : list Component) : bool :=
  match l with
  | nil => true
  | a :: m => false
  end.

End Topology.


Require Import rt.util.all.
Require Import rt.analysis.global.parallel.bertogna_edf_theory.
From mathcomp Require Import ssreflect ssrbool eqtype ssrnat seq fintype bigop div path.

Module ResponseTimeIterationEDF.

  Import ResponseTimeAnalysisEDF.

  (* In this section, we define the algorithm for Bertogna and Cirinei's
     response-time analysis for EDF scheduling with parallel jobs. *)
  Section Analysis.

    Context {sporadic_task: eqType}.
    Variable task_cost: sporadic_task -> time.
    Variable task_period: sporadic_task -> time.
    Variable task_deadline: sporadic_task -> time.

    (* As input for each iteration of the algorithm, we consider pairs
       of tasks and computed response-time bounds. *)
    Let task_with_response_time := (sporadic_task * time)%type.

    Context {Job: eqType}.
    Variable job_arrival: Job -> time.
    Variable job_cost: Job -> time.
    Variable job_deadline: Job -> time.
    Variable job_task: Job -> sporadic_task.

    (* Consider a platform with num_cpus processors. *)
    Variable num_cpus: nat.

    (* First, recall the jitter-aware interference bound for EDF, ... *)
    Let I (rt_bounds: seq task_with_response_time)
          (tsk: sporadic_task) (delta: time) :=
      total_interference_bound_edf task_cost task_period task_deadline tsk rt_bounds delta.

    (* ..., which yields the following response-time bound. *)
    Definition edf_response_time_bound (rt_bounds: seq task_with_response_time)
                                           (tsk: sporadic_task) (delta: time) :=
      task_cost tsk + div_floor (I rt_bounds tsk delta) num_cpus.

    (* Also note that a response-time is only valid if it is no larger
       than the deadline. *)
    Definition R_le_deadline (pair: task_with_response_time) :=
      let (tsk, R) := pair in
        R <= task_deadline tsk.

    (* Next we define the fixed-point iteration for computing
       Bertogna's response-time bound of a task set. *)

    (* Given a sequence 'rt_bounds' of task and response-time bounds
       from the previous iteration, we compute the response-time
       bound of a single task using the RTA for EDF. *)
    Definition update_bound (rt_bounds: seq task_with_response_time)
                        (pair : task_with_response_time) :=
      let (tsk, R) := pair in
        (tsk, edf_response_time_bound rt_bounds tsk R).

    (* To compute the response-time bounds of the entire task set,
       We start the iteration with a sequence of tasks and costs:
       <(task1, cost1), (task2, cost2), ...>. *)
    Let initial_state (ts: seq sporadic_task) :=
      map (fun t => (t, task_cost t)) ts.

    (* Then, we successively update the the response-time bounds based
       on the slack computed in the previous iteration. *)
    Definition edf_rta_iteration (rt_bounds: seq task_with_response_time) :=
      map (update_bound rt_bounds) rt_bounds.

    (* To ensure that the procedure converges, we run the iteration a
       "sufficient" number of times: task_deadline tsk - task_cost tsk + 1.
       This corresponds to the time complexity of the procedure. *)
    Let max_steps (ts: seq sporadic_task) :=
      \sum_(tsk <- ts) (task_deadline tsk - task_cost tsk) + 1.

    (* This yields the following definition for the RTA. At the end of
       the iteration, we check if all computed response-time bounds
       are less than or equal to the deadline, in which case they are
       valid. *)
    Definition edf_claimed_bounds (ts: seq sporadic_task) :=
      let R_values := iter (max_steps ts) edf_rta_iteration (initial_state ts) in
        if (all R_le_deadline R_values) then
          Some R_values
        else None.

    (* The schedulability test simply checks if we got a list of
       response-time bounds (i.e., if the computation did not fail). *)
    Definition edf_schedulable (ts: seq sporadic_task) :=
      edf_claimed_bounds ts != None.

    (* In the following section, we prove several helper lemmas about the
       list of tasks/response-time bounds. *)
    Section SimpleLemmas.

      (* Updating a single response-time bound does not modify the task. *)
      Lemma edf_claimed_bounds_unzip1_update_bound :
        forall l rt_bounds,
          unzip1 (map (update_bound rt_bounds) l) = unzip1 l.
      Proof.
        induction l; first by done.
        intros rt_bounds.
        simpl; f_equal; last by done.
        by unfold update_bound; desf.
      Qed.

      (* At any point of the iteration, the tasks are the same. *)
      Lemma edf_claimed_bounds_unzip1_iteration :
        forall l k,
          unzip1 (iter k edf_rta_iteration (initial_state l)) = l.
      Proof.
        intros l k; clear -k.
        induction k; simpl.
        {
          unfold initial_state.
          induction l; first by done.
          by simpl; rewrite IHl.
        }
        {
          unfold edf_rta_iteration.
          by rewrite edf_claimed_bounds_unzip1_update_bound.
        }
      Qed.

      (* The iteration preserves the size of the list. *)
      Lemma edf_claimed_bounds_size :
        forall l k,
          size (iter k edf_rta_iteration (initial_state l)) = size l.
      Proof.
        intros l k; clear -k.
        induction k; simpl; first by rewrite size_map.
        by rewrite size_map.
      Qed.

      (* If the analysis succeeds, the computed response-time bounds are no smaller
         than the task cost. *)
      Lemma edf_claimed_bounds_ge_cost :
        forall l k tsk R,
          (tsk, R) \in (iter k edf_rta_iteration (initial_state l)) ->
          R >= task_cost tsk.
      Proof.
        intros l k tsk R IN.
        destruct k.
        {
          move: IN => /mapP IN; destruct IN as [x IN EQ]; inversion EQ.
          by apply leqnn.
        }
        {
          rewrite iterS in IN.
          move: IN => /mapP IN; destruct IN as [x IN EQ].
          unfold update_bound in EQ; destruct x; inversion EQ.
          by unfold edf_response_time_bound; apply leq_addr.
        }
      Qed.

      (* If the analysis suceeds, the computed response-time bounds are no larger
         than the deadline. *)
      Lemma edf_claimed_bounds_le_deadline :
        forall ts rt_bounds tsk R,
          edf_claimed_bounds ts = Some rt_bounds ->
          (tsk, R) \in rt_bounds ->
          R <= task_deadline tsk.
      Proof.
        intros ts rt_bounds tsk R SOME PAIR; unfold edf_claimed_bounds in SOME.
        destruct (all R_le_deadline (iter (max_steps ts)
                                          edf_rta_iteration (initial_state ts))) eqn:DEADLINE;
          last by done.
        move: DEADLINE => /allP DEADLINE.
        inversion SOME as [EQ]; rewrite -EQ in PAIR.
        by specialize (DEADLINE (tsk, R) PAIR).
      Qed.

      (* The list contains a response-time bound for every task in the task set. *)
      Lemma edf_claimed_bounds_has_R_for_every_task :
        forall ts rt_bounds tsk,
          edf_claimed_bounds ts = Some rt_bounds ->
          tsk \in ts ->
          exists R,
            (tsk, R) \in rt_bounds.
      Proof.
        intros ts rt_bounds tsk SOME IN.
        unfold edf_claimed_bounds in SOME.
        destruct (all R_le_deadline (iter (max_steps ts) edf_rta_iteration (initial_state ts)));
          last by done.
        inversion SOME as [EQ]; clear SOME EQ.
        generalize dependent tsk.
        induction (max_steps ts) as [| step]; simpl in *.
        {
          intros tsk IN; unfold initial_state.
          exists (task_cost tsk).
          by apply/mapP; exists tsk.
        }
        {
          intros tsk IN.
          set prev_state := iter step edf_rta_iteration (initial_state ts).
          fold prev_state in IN, IHstep.
          specialize (IHstep tsk IN); des.
          exists (edf_response_time_bound prev_state tsk R).
          by apply/mapP; exists (tsk, R); [by done | by f_equal].
        }
      Qed.

    End SimpleLemmas.

    (* In this section, we prove the convergence of the RTA procedure.
       Since we define the RTA procedure as the application of a function
       a fixed number of times, this translates into proving that the value
       of the iteration at (max_steps ts) is equal to the value at (max_steps ts) + 1. *)
    Section Convergence.

      (* Consider any sequence of tasks with valid parameters. *)
      Variable ts: seq sporadic_task.
      Hypothesis H_valid_task_parameters:
        valid_sporadic_taskset task_cost task_period task_deadline ts.

      (* To simplify, let f denote the RTA procedure. *)
      Let f (k: nat) := iter k edf_rta_iteration (initial_state ts).

      (* Since the iteration is applied directly to a list of tasks and response-times,
         we define a corresponding relation "<=" over those lists. *)

      (* Let 'all_le' be a binary relation over lists of tasks/response-time bounds.
         It states that every element of list l1 has a response-time bound R that is less
         than or equal to the corresponding response-time bound R' in list l2 (point-wise).
         In addition, the relation states that the tasks of both lists are unchanged. *)
      Let all_le := fun (l1 l2: list task_with_response_time) =>
        (unzip1 l1 == unzip1 l2) &&
        all (fun p => (snd (fst p)) <= (snd (snd p))) (zip l1 l2).

      (* Similarly, we define a strict version of 'all_le' called 'one_lt', which states that
         there exists at least one element whose response-time bound increases. *)
      Let one_lt := fun (l1 l2: list task_with_response_time) =>
        (unzip1 l1 == unzip1 l2) &&
        has (fun p => (snd (fst p)) < (snd (snd p))) (zip l1 l2).

      (* Next, we prove some basic properties about the relation all_le. *)
      Section RelationProperties.

        (* The relation is reflexive, ... *)
        Lemma all_le_reflexive : reflexive all_le.
        Proof.
          intros l; unfold all_le; rewrite eq_refl andTb.
          destruct l; first by done.
          by apply/(zipP t (fun x y => snd x <= snd y)).
        Qed.

        (* ... and transitive. *)
        Lemma all_le_transitive: transitive all_le.
        Proof.
          unfold transitive, all_le.
          move => y x z /andP [/eqP ZIPxy LExy] /andP [/eqP ZIPyz LEyz].
          apply/andP; split; first by rewrite ZIPxy -ZIPyz.
          move: LExy => /(zipP _ (fun x y => snd x <= snd y)) LExy.
          move: LEyz => /(zipP _ (fun x y => snd x <= snd y)) LEyz.
          assert (SIZExy: size (unzip1 x) = size (unzip1 y)).
            by rewrite ZIPxy.
          assert (SIZEyz: size (unzip1 y) = size (unzip1 z)).
            by rewrite ZIPyz.
          rewrite 2!size_map in SIZExy; rewrite 2!size_map in SIZEyz.
          destruct y.
          {
            apply size0nil in SIZExy; symmetry in SIZEyz.
            by apply size0nil in SIZEyz; subst.
          }
          apply/(zipP t (fun x y => snd x <= snd y));
            first by rewrite SIZExy -SIZEyz.
          intros i LTi.
          exploit LExy; first by rewrite SIZExy.
          {
            rewrite size_zip -SIZEyz -SIZExy minnn in LTi.
            by rewrite size_zip -SIZExy minnn; apply LTi.
          }
          instantiate (1 := t); intro LE.
          exploit LEyz; first by apply SIZEyz.
          {
            rewrite size_zip SIZExy SIZEyz minnn in LTi.
            by rewrite size_zip SIZEyz minnn; apply LTi.
          }
          by instantiate (1 := t); intro LE'; apply (leq_trans LE).
        Qed.

        (* At any step of the iteration, the corresponding list
           is larger than or equal to the initial state. *)
        Lemma bertogna_edf_comp_iteration_preserves_minimum :
          forall step, all_le (initial_state ts) (f step).
        Proof.
          unfold f.
          intros step; destruct step; first by apply all_le_reflexive.
          apply/andP; split.
          {
            assert (UNZIP0 := edf_claimed_bounds_unzip1_iteration ts 0).
            by simpl in UNZIP0; rewrite UNZIP0 edf_claimed_bounds_unzip1_iteration.
          }
          destruct ts as [| tsk0 ts'].
          {
            clear -step; induction step; first by done.
            by rewrite iterSr IHstep.
          }

          apply/(zipP (tsk0,0) (fun x y => snd x <= snd y));
            first by rewrite edf_claimed_bounds_size size_map.

          intros i LTi; rewrite iterS; unfold edf_rta_iteration at 1.
          have MAP := @nth_map _ (tsk0,0) _ (tsk0,0).
          rewrite size_zip edf_claimed_bounds_size size_map minnn in LTi.
          rewrite MAP; clear MAP; last by rewrite edf_claimed_bounds_size.
          destruct (nth (tsk0, 0) (initial_state (tsk0 :: ts')) i) as [tsk_i R_i] eqn:SUBST.
          rewrite SUBST; unfold update_bound.
          unfold initial_state in SUBST.
          have MAP := @nth_map _ tsk0 _ (tsk0, 0).
          rewrite ?MAP // in SUBST; inversion SUBST; clear MAP.
          assert (EQtsk: tsk_i = fst (nth (tsk0, 0) (iter step edf_rta_iteration
                                                         (initial_state (tsk0 :: ts'))) i)).
          {
            have MAP := @nth_map _ (tsk0,0) _ tsk0 (fun x => fst x).
            rewrite -MAP; clear MAP; last by rewrite edf_claimed_bounds_size.
            have UNZIP := edf_claimed_bounds_unzip1_iteration; unfold unzip1 in UNZIP.
            by rewrite UNZIP; symmetry.
          }
          destruct (nth (tsk0, 0) (iter step edf_rta_iteration (initial_state (tsk0 :: ts')))) as [tsk_i' R_i'].
          by simpl in EQtsk; rewrite -EQtsk; subst; apply leq_addr.
        Qed.

        (* The application of the function is inductive. *)
        Lemma bertogna_edf_comp_iteration_inductive (P : seq task_with_response_time -> Type) :
          P (initial_state ts) ->
          (forall k, P (f k) -> P (f (k.+1))) ->
          P (f (max_steps ts)).
        Proof.
          by intros P0 Pn; induction (max_steps ts); last by apply Pn.
        Qed.

        (* As a last step, we show that edf_rta_iteration preserves order, i.e., for any
           list l1 no smaller than the initial state, and list l2 such that
           l1 <= l2, we have (edf_rta_iteration l1) <= (edf_rta_iteration l2). *)
        Lemma bertogna_edf_comp_iteration_preserves_order :
          forall l1 l2,
            all_le (initial_state ts) l1 ->
            all_le l1 l2 ->
            all_le (edf_rta_iteration l1) (edf_rta_iteration l2).
        Proof.
          rename H_valid_task_parameters into VALID.
          intros x1 x2 LEinit LE.
          move: LE => /andP [/eqP ZIP LE]; unfold all_le.

          assert (UNZIP': unzip1 (edf_rta_iteration x1) = unzip1 (edf_rta_iteration x2)).
          {
            by rewrite 2!edf_claimed_bounds_unzip1_update_bound.
          }

          apply/andP; split; first by rewrite UNZIP'.
          apply f_equal with (B := nat) (f := fun x => size x) in UNZIP'.
          rename UNZIP' into SIZE.
          rewrite size_map [size (unzip1 _)]size_map in SIZE.
          move: LE => /(zipP _ (fun x y => snd x <= snd y)) LE.
          destruct x1 as [| p0 x1'], x2 as [| p0' x2']; try (by ins).
          apply/(zipP p0 (fun x y => snd x <= snd y)); first by done.

          intros i LTi.
          exploit LE; first by rewrite 2!size_map in SIZE.
          {
            by rewrite size_zip 2!size_map -size_zip in LTi; apply LTi.
          }
          rewrite 2!size_map in SIZE.
          instantiate (1 := p0); intro LEi.
          rewrite (nth_map p0);
            last by rewrite size_zip 2!size_map -SIZE minnn in LTi.
          rewrite (nth_map p0);
            last by rewrite size_zip 2!size_map SIZE minnn in LTi.
          unfold update_bound, edf_response_time_bound; desf; simpl.
          rename s into tsk_i, s0 into tsk_i', t into R_i, t0 into R_i', Heq into EQ, Heq0 into EQ'.
          assert (EQtsk: tsk_i = tsk_i').
          {
            destruct p0 as [tsk0 R0], p0' as [tsk0' R0']; simpl in H2; subst.
            have MAP := @nth_map _ (tsk0',R0) _ tsk0' (fun x => fst x) i ((tsk0', R0) :: x1').
            have MAP' := @nth_map _ (tsk0',R0) _ tsk0' (fun x => fst x) i ((tsk0', R0') :: x2').
            assert (FSTeq: fst (nth (tsk0', R0)((tsk0', R0) :: x1') i) =
                           fst (nth (tsk0',R0) ((tsk0', R0') :: x2') i)).
            {
              rewrite -MAP;
                last by simpl; rewrite size_zip 2!size_map /= -H0 minnn in LTi.
              rewrite -MAP';
                last by simpl; rewrite size_zip 2!size_map /= H0 minnn in LTi.
              by f_equal; simpl; f_equal.
            }
            apply f_equal with (B := sporadic_task) (f := fun x => fst x) in EQ.
            apply f_equal with (B := sporadic_task) (f := fun x => fst x) in EQ'.
            by rewrite FSTeq EQ' /= in EQ; rewrite EQ.
          }
          subst tsk_i'; rewrite leq_add2l.
          unfold I, total_interference_bound_edf; apply leq_div2r.
          rewrite 2!big_cons.
          destruct p0 as [tsk0 R0], p0' as [tsk0' R0'].
          simpl in H2; subst tsk0'.
          rename R_i into delta, R_i' into delta'.
          rewrite EQ EQ' in LEi; simpl in LEi.
          rename H0 into SIZE, H1 into UNZIP; clear EQ EQ'.

          assert (SUBST: forall l delta,
                    \sum_(j <- l | let '(tsk_other, _) := j in
                      different_task tsk_i tsk_other)
                        (let '(tsk_other, R_other) := j in
                          interference_bound_edf task_cost task_period task_deadline tsk_i delta
                            (tsk_other, R_other)) =
                    \sum_(j <- l | different_task tsk_i (fst j))
                      interference_bound_edf task_cost task_period task_deadline tsk_i delta j).
          {
            intros l x; clear -l.
            induction l; first by rewrite 2!big_nil.
            by rewrite 2!big_cons; rewrite IHl; desf; rewrite /= Heq in Heq0.
          } rewrite 2!SUBST; clear SUBST.

          assert (VALID': valid_sporadic_taskset task_cost task_period task_deadline
                                                       (unzip1 ((tsk0, R0) :: x1'))).
          {
            move: LEinit => /andP [/eqP EQinit _].
            rewrite -EQinit; unfold valid_sporadic_taskset.
            move => tsk /mapP IN. destruct IN as [p INinit EQ]; subst.
            by move: INinit => /mapP INinit; destruct INinit as [tsk INtsk]; subst; apply VALID.
          }

          assert (GE_COST: all (fun p => task_cost (fst p) <= snd p) ((tsk0, R0) :: x1')).
          {
            clear LE; move: LEinit => /andP [/eqP UNZIP' LE].
            move: LE => /(zipP _ (fun x y => snd x <= snd y)) LE.
            specialize (LE (tsk0, R0)).
            apply/(all_nthP (tsk0,R0)).
            intros j LTj; generalize UNZIP'; simpl; intro SIZE'.
            have F := @f_equal _ _ size (unzip1 (initial_state ts)).
            apply F in SIZE'; clear F; rewrite /= 3!size_map in SIZE'.
            exploit LE; [by rewrite size_map /= | |].
            {
              rewrite size_zip size_map /= SIZE' minnn.
              by simpl in LTj; apply LTj.
            }
            clear LE; intro LE.
            unfold initial_state in LE.
            have MAP := @nth_map _ tsk0 _ (tsk0,R0).
            rewrite MAP /= in LE;
              [clear MAP | by rewrite SIZE'; simpl in LTj].
            apply leq_trans with (n := task_cost (nth tsk0 ts j));
              [apply eq_leq; f_equal | by done].
            have MAP := @nth_map _ (tsk0, R0) _ tsk0 (fun x => fst x).
            rewrite -MAP; [clear MAP | by done].
            unfold unzip1 in UNZIP'; rewrite -UNZIP'; f_equal.
            clear -ts; induction ts; [by done | by simpl; f_equal].
          }
          move: GE_COST => /allP GE_COST.

          assert (LESUM: \sum_(j <- x1' | different_task tsk_i (fst j))
                        interference_bound_edf task_cost task_period task_deadline tsk_i delta j <=                                  \sum_(j <- x2' | different_task tsk_i (fst j))
                        interference_bound_edf task_cost task_period task_deadline tsk_i delta' j).
          {
            set elem := (tsk0, R0); rewrite 2!(big_nth elem).
            rewrite -SIZE.
            rewrite big_mkcond [\sum_(_ <- _ | different_task _ _)_]big_mkcond.
            rewrite big_seq_cond [\sum_(_ <- _ | true) _]big_seq_cond.
            apply leq_sum; intros j; rewrite andbT; intros INj.
            rewrite mem_iota add0n subn0 in INj; move: INj => /andP [_ INj].
            assert (FSTeq: fst (nth elem x1' j) = fst (nth elem x2' j)).
            {
              have MAP := @nth_map _ elem _ tsk0 (fun x => fst x).
              by rewrite -2?MAP -?SIZE //; f_equal.
            } rewrite -FSTeq.
            destruct (different_task tsk_i (fst (nth elem x1' j))) eqn:INTERF;
              last by done.
            {
              exploit (LE elem); [by rewrite /= SIZE | | intro LEj].
              {
                rewrite size_zip 2!size_map /= -SIZE minnn in LTi.
                by rewrite size_zip /= -SIZE minnn; apply (leq_ltn_trans INj).
              }
              simpl in LEj.
              exploit (VALID' (fst (nth elem x1' j))); last intro VALIDj.
              {
                apply/mapP; exists (nth elem x1' j); last by done.
                by rewrite in_cons; apply/orP; right; rewrite mem_nth.
              }
              exploit (GE_COST (nth elem x1' j)); last intro GE_COSTj.
              {
                by rewrite in_cons; apply/orP; right; rewrite mem_nth.
              }
              unfold is_valid_sporadic_task in *.
              destruct (nth elem x1' j) as [tsk_j R_j] eqn:SUBST1,
                       (nth elem x2' j) as [tsk_j' R_j'] eqn:SUBST2.
              rewrite SUBST1 SUBST2 in LEj.
              simpl in FSTeq; rewrite -FSTeq; simpl in LEj; simpl in VALIDj; des.
              by apply interference_bound_edf_monotonic.
            }
          }
          destruct (different_task tsk_i tsk0) eqn:INTERFtsk0; last by done.
          apply leq_add; last by done.
          {
            exploit (LE (tsk0, R0)); [by rewrite /= SIZE | | intro LEj];
              first by instantiate (1 := 0); rewrite size_zip /= -SIZE minnn.
            exploit (VALID' tsk0); first by rewrite in_cons; apply/orP; left.
            exploit (GE_COST (tsk0, R0)); first by rewrite in_cons eq_refl orTb.
            unfold is_valid_sporadic_task; intros GE_COST0 VALID0; des; simpl in LEj.
            by apply interference_bound_edf_monotonic.
          }
        Qed.

        (* It follows from the properties above that the iteration is monotonically increasing. *)
        Lemma bertogna_edf_comp_iteration_monotonic: forall k, all_le (f k) (f k.+1).
        Proof.
          unfold f; intros k.
          apply fun_mon_iter_mon_generic with (x1 := k) (x2 := k.+1);
            try (by done);
            [ by apply all_le_reflexive
            | by apply all_le_transitive
            | by apply bertogna_edf_comp_iteration_preserves_order
            | by apply bertogna_edf_comp_iteration_preserves_minimum].
        Qed.

      End RelationProperties.

      (* Knowing that the iteration is monotonically increasing (with respect to all_le),
         we show that the RTA procedure converges to a fixed point. *)

      (* First, note that when there are no tasks, the iteration trivially converges. *)
      Lemma bertogna_edf_comp_f_converges_with_no_tasks :
        size ts = 0 ->
        f (max_steps ts) = f (max_steps ts).+1.
      Proof.
        intro SIZE; destruct ts; last by inversion SIZE.
        unfold max_steps; rewrite big_nil /=.
        by unfold edf_rta_iteration.
      Qed.

      (* Otherwise, if the iteration reached a fixed point before (max_steps ts), then
         the value at (max_steps ts) is still at a fixed point. *)
      Lemma bertogna_edf_comp_f_converges_early :
        (exists k, k <= max_steps ts /\ f k = f k.+1) ->
        f (max_steps ts) = f (max_steps ts).+1.
      Proof.
        by intros EX; des; apply iter_fix with (k := k).
      Qed.

      (* Else, we derive a contradiction. *)
      Section DerivingContradiction.

        (* Assume that there are tasks. *)
        Hypothesis H_at_least_one_task: size ts > 0.

        (* Assume that the iteration continued to diverge. *)
        Hypothesis H_keeps_diverging:
          forall k,
            k <= max_steps ts -> f k != f k.+1.

        (* Since the iteration is monotonically increasing, it must be
           strictly increasing. *)
        Lemma bertogna_edf_comp_f_increases :
          forall k,
            k <= max_steps ts -> one_lt (f k) (f k.+1).
        Proof.
          rename H_at_least_one_task into NONEMPTY.
          intros step LEstep; unfold one_lt; apply/andP; split;
            first by rewrite 2!edf_claimed_bounds_unzip1_iteration.
          rewrite -[has _ _]negbK; apply/negP; unfold not; intro ALL.
          rewrite -all_predC in ALL.
          move: ALL => /allP ALL.
          exploit (H_keeps_diverging step); [by done | intro DIFF].
          assert (DUMMY: exists tsk: sporadic_task, True).
          {
            destruct ts as [|tsk0]; first by rewrite ltnn in NONEMPTY.
            by exists tsk0.
          }
          des; clear DUMMY.
          move: DIFF => /eqP DIFF; apply DIFF.
          apply eq_from_nth with (x0 := (tsk, 0));
            first by simpl; rewrite size_map.
          {
            intros i LTi.
            remember (nth (tsk, 0)(f step) i) as p_i;rewrite -Heqp_i.
            remember (nth (tsk, 0)(f step.+1) i) as p_i';rewrite -Heqp_i'.
            rename Heqp_i into EQ, Heqp_i' into EQ'.
            exploit (ALL (p_i, p_i')).
            {
              rewrite EQ EQ'.
              rewrite -nth_zip; last by unfold f; rewrite iterS size_map.
              apply mem_nth; rewrite size_zip.
              unfold f; rewrite iterS size_map.
              by rewrite minnn.
            }
            unfold predC; simpl; rewrite -ltnNge; intro LTp.

            have GROWS := bertogna_edf_comp_iteration_monotonic step.
            move: GROWS => /andP [_ /allP GROWS].
            exploit (GROWS (p_i, p_i')).
            {
              rewrite EQ EQ'.
              rewrite -nth_zip; last by unfold f; rewrite iterS size_map.
              apply mem_nth; rewrite size_zip.
              unfold f; rewrite iterS size_map.
              by rewrite minnn.
            }
            simpl; intros LE.
            destruct p_i as [tsk_i R_i], p_i' as [tsk_i' R_i'].
            simpl in *.
            assert (EQtsk: tsk_i = tsk_i').
            {
              unfold edf_rta_iteration in EQ'.
              rewrite (nth_map (tsk, 0)) in EQ'; last by done.
              by unfold update_bound in EQ'; desf.
            }
            rewrite EQtsk; f_equal.
            by apply/eqP; rewrite eqn_leq; apply/andP; split.
          }
        Qed.

        (* In the end, each response-time bound is so high that the sum
           of all response-time bounds exceeds the sum of all deadlines.
           Contradiction! *)
        Lemma bertogna_edf_comp_rt_grows_too_much :
          forall k,
            k <= max_steps ts ->
            \sum_((tsk, R) <- f k) (R - task_cost tsk) + 1 > k.
        Proof.
          have LT := bertogna_edf_comp_f_increases.
          have MONO := bertogna_edf_comp_iteration_monotonic.
          rename H_at_least_one_task into NONEMPTY.
          unfold valid_sporadic_taskset, is_valid_sporadic_task in *.
          rename H_valid_task_parameters into VALID.
          intros step LE.
          assert (DUMMY: exists tsk: sporadic_task, True).
          {
            destruct ts as [|tsk0]; first by rewrite ltnn in NONEMPTY.
            by exists tsk0.
          } destruct DUMMY as [elem _].

          induction step; first by rewrite addn1.
          {
            rewrite -addn1 ltn_add2r.
            apply leq_ltn_trans with (n := \sum_(i <- f step) (let '(tsk, R) := i in R - task_cost tsk)).
            {
              rewrite -ltnS; rewrite addn1 in IHstep.
              by apply IHstep, ltnW.
            }
            rewrite (eq_bigr (fun x => snd x - task_cost (fst x)));
              last by ins; destruct i.
            rewrite [\sum_(_ <- f step.+1)_](eq_bigr (fun x => snd x - task_cost (fst x)));
              last by ins; destruct i.
            unfold f at 2; rewrite iterS.
            rewrite big_map; fold (f step).
            rewrite -(ltn_add2r (\sum_(i <- f step) task_cost (fst i))).
            rewrite -2!big_split /=.
            rewrite big_seq_cond [\sum_(_ <- _ | true)_]big_seq_cond.
            rewrite (eq_bigr (fun i => snd i)); last first.
            {
              intro i; rewrite andbT; intro IN;
              rewrite subh1; first by rewrite -addnBA // subnn addn0.
              have GE_COST := edf_claimed_bounds_ge_cost ts step.
              by destruct i; apply GE_COST.
            }
            rewrite [\sum_(_ <- _ | _)(_ - _ + _)](eq_bigr (fun i => snd (update_bound (f step) i))); last first.
            {
              intro i; rewrite andbT; intro IN.
              unfold update_bound; destruct i; simpl.
              rewrite subh1; first by rewrite -addnBA // subnn addn0.
              apply (edf_claimed_bounds_ge_cost ts step.+1).
              by rewrite iterS; apply/mapP; exists (s, t).
            }
            rewrite -2!big_seq_cond.

            specialize (LT step (ltnW LE)).
            specialize (MONO step).
            move: LT => /andP [_ LT]; move: LT => /hasP LT.
            destruct LT as [[x1 x2] INzip LT]; simpl in *.
            move: MONO => /andP [_ /(zipP _ (fun x y => snd x <= snd y)) MONO].
            rewrite 2!(big_nth (elem, 0)).
            apply mem_zip_exists with (elem := (elem, 0)) (elem' := (elem, 0)) in INzip; des;
              last by rewrite size_map.
            rewrite -> big_cat_nat with (m := 0) (n := idx) (p := size (f step));
              [simpl | by done | by apply ltnW].
            rewrite -> big_cat_nat with (m := idx) (n := idx.+1) (p := size (f step));
              [simpl | by done | by done].
            rewrite big_nat_recr /=; last by done.
            rewrite -> big_cat_nat with (m := 0) (n := idx) (p := size (f step));
              [simpl | by done | by apply ltnW].
            rewrite -> big_cat_nat with (m := idx) (n := idx.+1) (p := size (f step));
              [simpl | by done | by done].
            rewrite big_nat_recr /=; last by done.
            rewrite [\sum_(idx <= i < idx) _]big_geq // add0n.
            rewrite [\sum_(idx <= i < idx) _]big_geq // add0n.
            rewrite -addn1 -addnA; apply leq_add.
            {
              rewrite big_nat_cond [\sum_(_ <= _ < _ | true) _]big_nat_cond.
              apply leq_sum; move => i /andP [/andP [LT1 LT2] _].
              exploit (MONO (elem,0)); [by rewrite size_map | | intro LEi].
              {
                rewrite size_zip; apply (ltn_trans LT2).
                by apply leq_trans with (n := size (f step));
                  [by done | by rewrite size_map minnn].
              }
              unfold edf_rta_iteration in LEi.
              by rewrite -> nth_map with (x1 := (elem, 0)) in LEi;
                last by apply (ltn_trans LT2).
            }
            rewrite -addnA [_ + 1]addnC addnA; apply leq_add.
            {
              unfold edf_rta_iteration in INzip2; rewrite addn1.
              rewrite -> nth_map with (x1 := (elem, 0)) in INzip2; last by done.
              by rewrite -INzip2 -INzip1.
            }
            {
              rewrite big_nat_cond [\sum_(_ <= _ < _ | true) _]big_nat_cond.
              apply leq_sum; move => i /andP [/andP [LT1 LT2] _].
              exploit (MONO (elem,0));
                [ by rewrite size_map
                | by rewrite size_zip; apply (leq_trans LT2); rewrite size_map minnn | intro LEi ].
              unfold edf_rta_iteration in LEi.
              by rewrite -> nth_map with (x1 := (elem, 0)) in LEi; last by done.
            }
          }
        Qed.

      End DerivingContradiction.

      (* Using the lemmas above, we prove that edf_rta_iteration reaches
         a fixed point after (max_steps ts) step, ... *)
      Lemma edf_claimed_bounds_finds_fixed_point_of_list :
        forall rt_bounds,
          edf_claimed_bounds ts = Some rt_bounds ->
          valid_sporadic_taskset task_cost task_period task_deadline ts ->
          f (max_steps ts) = edf_rta_iteration (f (max_steps ts)).
      Proof.
        intros rt_bounds SOME VALID.
        unfold valid_sporadic_taskset, is_valid_sporadic_task in *.
        unfold edf_claimed_bounds in SOME; desf.
        rename Heq into LE.
        fold (f (max_steps ts)) in *; fold (f (max_steps ts).+1).

        (* Either the task set is empty or not. *)
        destruct (size ts == 0) eqn:EMPTY;
          first by apply bertogna_edf_comp_f_converges_with_no_tasks; apply/eqP.
        apply negbT in EMPTY; rewrite -lt0n in EMPTY.

        (* Either f converges by the deadline or not. *)
        destruct ([exists k in 'I_((max_steps ts).+1), f k == f k.+1]) eqn:EX.
        {
          move: EX => /exists_inP EX; destruct EX as [k _ ITERk].
          destruct k as [k LTk]; simpl in ITERk.
          apply bertogna_edf_comp_f_converges_early.
          exists k; split; [by apply LTk | by apply/eqP].
        }

        (* If not, then we reach a contradiction *)
        apply negbT in EX; rewrite negb_exists_in in EX.
        move: EX => /forall_inP EX.

        assert (SAMESUM: \sum_(tsk <- ts) task_cost tsk = \sum_(p <- f (max_steps ts)) task_cost (fst p)).
        {
          have MAP := @big_map _ 0 addn _ _ (fun x => fst x) (f (max_steps ts))
                               (fun x => true) (fun x => task_cost x).
          have UNZIP := edf_claimed_bounds_unzip1_iteration ts (max_steps ts).
          fold (f (max_steps ts)) in UNZIP; unfold unzip1 in UNZIP.
          by rewrite UNZIP in MAP; rewrite MAP.
        }

        (* Show that the sum is less than the sum of all deadlines. *)
        assert (SUM: \sum_(p <- f (max_steps ts)) (snd p - task_cost (fst p)) + 1 <= max_steps ts).
        {
          unfold max_steps at 2; rewrite leq_add2r.
          rewrite -(leq_add2r (\sum_(tsk <- ts) task_cost tsk)).
          rewrite {1}SAMESUM -2!big_split /=.
          rewrite big_seq_cond [\sum_(_ <- _ | true)_]big_seq_cond.
          rewrite (eq_bigr (fun x => snd x)); last first.
          {
            intro i; rewrite andbT; intro IN.
            rewrite subh1; first by rewrite -addnBA // subnn addn0.
            have GE_COST := edf_claimed_bounds_ge_cost ts (max_steps ts).
            fold (f (max_steps ts)) in GE_COST.
            by destruct i; apply GE_COST.
          }
          rewrite (eq_bigr (fun x => task_deadline x)); last first.
          {
            intro i; rewrite andbT; intro IN.
            rewrite subh1; first by rewrite -addnBA // subnn addn0.
            by specialize (VALID i IN); des.
          }
          rewrite -2!big_seq_cond.
          have MAP := @big_map _ 0 addn _ _ (fun x => fst x) (f (max_steps ts))
                               (fun x => true) (fun x => task_deadline x).
          have UNZIP := edf_claimed_bounds_unzip1_iteration ts (max_steps ts).
          fold (f (max_steps ts)) in UNZIP; unfold unzip1 in UNZIP.
          rewrite UNZIP in MAP; rewrite MAP.
          rewrite big_seq_cond [\sum_(_ <- _|true)_]big_seq_cond.
          apply leq_sum; intro i; rewrite andbT; intro IN.
          move: LE => /allP LE; unfold R_le_deadline in LE.
          by specialize (LE i IN); destruct i.
        }

        have TOOMUCH :=
          bertogna_edf_comp_rt_grows_too_much EMPTY _ (max_steps ts) (leqnn (max_steps ts)).
        exploit TOOMUCH; [| intro BUG].
        {
          intros k LEk; rewrite -ltnS in LEk.
          by exploit (EX (Ordinal LEk)); [by done | by ins].
        }
        rewrite (eq_bigr (fun i => snd i - task_cost (fst i))) in BUG;
          last by ins; destruct i.
        by apply (leq_ltn_trans SUM) in BUG; rewrite ltnn in BUG.
      Qed.

      (* ...and since there cannot be a vector of response-time bounds with values less than
         the task costs, this solution is also the least fixed point. *)
      Lemma edf_claimed_bounds_finds_least_fixed_point :
        forall v,
          all_le (initial_state ts) v ->
          v = edf_rta_iteration v ->
          all_le (f (max_steps ts)) v.
      Proof.
        intros v GE0 EQ.
        apply bertogna_edf_comp_iteration_inductive; first by done.
        intros k GEk.
        rewrite EQ.
        apply bertogna_edf_comp_iteration_preserves_order; last by done.
        by apply bertogna_edf_comp_iteration_preserves_minimum.
      Qed.

      (* Therefore, with regard to the response-time bound recurrence, ...*)

      (* ..., the individual response-time bounds (elements of the list) are also fixed points. *)
      Theorem edf_claimed_bounds_finds_fixed_point_for_each_bound :
        forall tsk R rt_bounds,
          edf_claimed_bounds ts = Some rt_bounds ->
          (tsk, R) \in rt_bounds ->
          R = edf_response_time_bound rt_bounds tsk R.
      Proof.
        intros tsk R rt_bounds SOME IN.
        have CONV := edf_claimed_bounds_finds_fixed_point_of_list rt_bounds.
        rewrite -iterS in CONV; fold (f (max_steps ts).+1) in CONV.
        unfold edf_claimed_bounds in *; desf.
        exploit (CONV); [by done | by done | intro ITER; clear CONV].
        unfold f in ITER.

        cut (update_bound (iter (max_steps ts)
               edf_rta_iteration (initial_state ts)) (tsk,R) = (tsk, R)).
        {
          intros EQ.
          have F := @f_equal _ _ (fun x => snd x) _ (tsk, R).
          by apply F in EQ; simpl in EQ.
        }
        set s := iter (max_steps ts) edf_rta_iteration (initial_state ts).
        fold s in ITER, IN.
        move: IN => /(nthP (tsk,0)) IN; destruct IN as [i LT EQ].
        generalize EQ; rewrite ITER iterS in EQ; intro EQ'.
        fold s in EQ.
        unfold edf_rta_iteration in EQ.
        have MAP := @nth_map _ (tsk,0) _ _ (update_bound s).
        by rewrite MAP // EQ' in EQ; rewrite EQ.
      Qed.

    End Convergence.

    Section MainProof.

      (* Consider a task set ts where... *)
      Variable ts: taskset_of sporadic_task.

      (* ...all tasks have valid parameters ... *)
      Hypothesis H_valid_task_parameters:
        valid_sporadic_taskset task_cost task_period task_deadline ts.

      (* ...and constrained deadlines.*)
      Hypothesis H_constrained_deadlines:
        forall tsk, tsk \in ts -> task_deadline tsk <= task_period tsk.

      (* Next, consider any arrival sequence such that...*)
      Context {arr_seq: arrival_sequence Job}.

     (* ...all jobs come from task set ts, ...*)
      Hypothesis H_all_jobs_from_taskset:
        forall j, arrives_in arr_seq j -> job_task j \in ts.

      (* ...they have valid parameters,...*)
      Hypothesis H_valid_job_parameters:
        forall j,
          arrives_in arr_seq j ->
          valid_sporadic_job task_cost task_deadline job_cost job_deadline job_task j.

      (* ... and satisfy the sporadic task model.*)
      Hypothesis H_sporadic_tasks:
        sporadic_task_model task_period job_arrival job_task arr_seq.

      (* Then, consider any platform with at least one CPU such that...*)
      Variable sched: schedule Job num_cpus.
      Hypothesis H_at_least_one_cpu: num_cpus > 0.
      Hypothesis H_jobs_come_from_arrival_sequence:
        jobs_come_from_arrival_sequence sched arr_seq.

      (* ...jobs only execute after they arrived and no longer
         than their execution costs,... *)
      Hypothesis H_jobs_must_arrive_to_execute:
        jobs_must_arrive_to_execute job_arrival sched.
      Hypothesis H_completed_jobs_dont_execute:
        completed_jobs_dont_execute job_cost sched.

      (* Assume a work-conserving scheduler with EDF policy. *)
      Hypothesis H_work_conserving: work_conserving job_arrival job_cost arr_seq sched.
      Hypothesis H_edf_policy: respects_JLFP_policy job_arrival job_cost arr_seq sched
                                                    (EDF job_arrival job_deadline).

      Definition no_deadline_missed_by_task (tsk: sporadic_task) :=
        task_misses_no_deadline job_arrival job_cost job_deadline job_task arr_seq sched tsk.
      Definition no_deadline_missed_by_job :=
        job_misses_no_deadline job_arrival job_cost job_deadline sched.
      Let response_time_bounded_by (tsk: sporadic_task) :=
        is_response_time_bound_of_task job_arrival job_cost job_task arr_seq sched tsk.

      (* In the following theorem, we prove that any response-time bound contained
         in edf_claimed_bounds is safe. The proof follows by direct application of
         the main Theorem from bertogna_edf_theory.v. *)
      Theorem edf_analysis_yields_response_time_bounds :
        forall tsk R,
          (tsk, R) \In edf_claimed_bounds ts ->
          response_time_bounded_by tsk R.
      Proof.
        intros tsk R IN j JOBj.
        destruct (edf_claimed_bounds ts) as [rt_bounds |] eqn:SOME; last by done.
        unfold edf_rta_iteration in *.
        have BOUND := bertogna_cirinei_response_time_bound_edf.
        unfold is_response_time_bound_of_task in *.
        apply BOUND with (task_cost := task_cost) (task_period := task_period)
           (arr_seq := arr_seq) (task_deadline := task_deadline) (job_deadline := job_deadline)
           (job_task := job_task) (ts := ts) (tsk := tsk) (rt_bounds := rt_bounds); try (by ins).
          by unfold edf_claimed_bounds in SOME; desf; rewrite edf_claimed_bounds_unzip1_iteration.
          by ins; apply edf_claimed_bounds_finds_fixed_point_for_each_bound with (ts := ts).
          by ins; rewrite (edf_claimed_bounds_le_deadline ts rt_bounds).
      Qed.

      (* Therefore, if the schedulability test suceeds, ...*)
      Hypothesis H_test_succeeds: edf_schedulable ts.

      (*... no task misses its deadline. *)
      Theorem taskset_schedulable_by_edf_rta :
        forall tsk, tsk \in ts -> no_deadline_missed_by_task tsk.
      Proof.
        have RLIST := (edf_analysis_yields_response_time_bounds).
        have DL := (edf_claimed_bounds_le_deadline ts).
        have HAS := (edf_claimed_bounds_has_R_for_every_task ts).
        unfold no_deadline_missed_by_task, task_misses_no_deadline,
               job_misses_no_deadline, completed,
               edf_schedulable,
               valid_sporadic_job in *.
        rename H_valid_job_parameters into JOBPARAMS,
               H_valid_task_parameters into TASKPARAMS,
               H_constrained_deadlines into RESTR,
               H_completed_jobs_dont_execute into COMP,
               H_jobs_must_arrive_to_execute into MUSTARRIVE,
               H_all_jobs_from_taskset into ALLJOBS,
               H_test_succeeds into TEST.

        move => tsk INtsk j ARRj JOBtsk.
        destruct (edf_claimed_bounds ts) as [rt_bounds |] eqn:SOME; last by ins.
        exploit (HAS rt_bounds tsk); [by ins | by ins | clear HAS; intro HAS; des].
        have COMPLETED := RLIST tsk R HAS j ARRj JOBtsk.
        exploit (DL rt_bounds tsk R);
          [by ins | by ins | clear DL; intro DL].

        rewrite eqn_leq; apply/andP; split; first by apply cumulative_service_le_job_cost.
        apply leq_trans with (n := service sched j (job_arrival j + R)); last first.
        {
          unfold valid_sporadic_taskset, is_valid_sporadic_task in *.
          apply extend_sum; rewrite // leq_add2l.
          specialize (JOBPARAMS j ARRj); des; rewrite JOBPARAMS1.
          by rewrite JOBtsk.
        }
        rewrite leq_eqVlt; apply/orP; left; rewrite eq_sym.
        by apply COMPLETED.
      Qed.

      (* For completeness, since all jobs of the arrival sequence
         are spawned by the task set, we conclude that no job misses
         its deadline. *)
      Theorem jobs_schedulable_by_edf_rta :
        forall j, arrives_in arr_seq j -> no_deadline_missed_by_job j.
      Proof.
        intros j ARRj.
        have SCHED := taskset_schedulable_by_edf_rta.
        unfold no_deadline_missed_by_task, task_misses_no_deadline in *.
        apply SCHED with (tsk := job_task j); try (by done).
        by apply H_all_jobs_from_taskset.
      Qed.

    End MainProof.

  End Analysis.

End ResponseTimeIterationEDF.


Load "include/ops_header.v".

Module precond.

Definition Sn (n k : int) := (k != n + 1) /\ (n != -1).

Definition Sk (n k : int) := (k + 1 != 0) /\ (n != 0).

End precond.

Definition not_D (n k : int) := (n >= 0) && (k >= 0) && (k < n).

Load "include/ann_c.v".

Definition CT (c : int -> int -> rat) := forall (n_ k_ : int), not_D n_ k_ ->
P_horner (c ^~ k_) n_ = Q_flat c n_ (int.shift 1 k_) - Q_flat c n_ k_.

Record Ann c : Type := ann {
  Sn_ : Sn c;
  Sk_ : Sk c
}.


Require Import Cast.
Require Import Eq.
Require Import Setoids.

Definition fw (a b:Setoid) (p:elems a = elems b) (x:elems a) : elems b := cast p x.
Definition bw (a b:Setoid) (p:elems a = elems b) (y:elems b) : elems a := cast' p y.

Arguments fw {a} {b} _ _.
Arguments bw {a} {b} _ _.

Lemma bwfw : forall (a b:Setoid) (p q:elems a = elems b) (x:elems a),
    bw p (fw q x) = x.
Proof. intros a b p q x. apply cast_inv_left. Qed.

Lemma fwbw : forall (a b:Setoid) (p q:elems a = elems b) (y:elems b),
    fw p (bw q y) = y.
Proof. intros a b p q y. apply cast_inv_right. Qed.

Lemma sameSetoid : forall (a b:Setoid) (p:elems a = elems b),
    (forall (x y:elems a), x == y -> fw p x == fw p y) ->
    (forall (x y:elems b), x == y -> bw p x == bw p y) ->
    a = b.
Proof.
    intros [a eqA] [b eqB]. simpl. intro p. revert eqA eqB.
    rewrite <- p. clear p. unfold fw, bw, cast'. simpl.
    intros eqA eqB Hf Hb.
    assert (eqA = eqB) as E.
        { apply sameEq. split.
            - apply Hf.
            - apply Hb.
        }
    rewrite E. reflexivity.
Qed.


(* Prefer to not include this file
Require Export ECAlg.
Require Export SM3.

Open Scope N_scope.

(* TODO RANDOMLY sample a number in [low, high] *)
Definition SampleN (low : N)(high : N)(seed : N) : N :=
  low + (seed mod (high + 1 - low)).

(*Compute map (SampleN 10 20) (Nlist 15). *)

(* Generally try each element in l until func returns false. Should all true returns true *)
Fixpoint Scrutinize (DomType : Type)(test : DomType -> bool)(l : list DomType) : bool :=
  match l with
  | [] => true
  | h :: tl =>
      match test h with
      | false => false
      | true => Scrutinize DomType test tl
      end
  end.

Definition ScrutN (test : N -> bool)(l : list N): bool :=
  Scrutinize N test l.

(* For B.1.10, false if composite *)
Definition TryFunb (func : N -> bool)(l : list N) : bool :=
  ScrutN func l.
(*
  match l with
  | [] => true
  | j :: tl =>
      match func j with
      | false => false (* b.5 *)
      | true => TryFunb tl func (* b.6 *)
      end
  end.
*)
(*
Fixpoint TryFunb (l : list N)(func : N -> (bool * N)) : (bool * N * N) :=
  match l with
  | [] => (true, 0, 0)
  | j :: tl =>
      match func j with
      | (false, i) => (false, j, i) (* b.5 *)
      | (true, i) => TryFunb tl func (* b.6 *)
      end
  end.
*)
Fixpoint TryFunb4 (b u : N)(func : N -> N -> option bool)(l : list N) : bool :=
  match l with
  | [] => false (* b.5 *)
  | i :: tl =>
      let b2 := (N.square b) mod u in
        match func i b2 with
        | Some result => result
        | None => TryFunb4 b2 u func tl
        end
  end.

Definition NInterval (low : N)(high : N) : list N :=
  map (N.add low) (Nlist (high + 1 - low)).

(* Returns (v, w) so that m = 2 ^ v * w and w is odd *)
Fixpoint Decom_tail (v : N)(n : positive) : N * positive :=
  match n with
  | xH => (v, xH)
  | xI _ => (v, n)
  | xO n' => Decom_tail (v + 1) n'
  end.

Definition Decom (m : N) : N * N :=
  match m with
  | N0 => (0, 0)
  | Npos n =>
      match Decom_tail N0 n with
      | (v, w) => (v, Npos w)
      end
  end.

(*B.1.10 u is odd and T is positive. If returns true then u is a ProbPrime.
If Returns false then u is a composite.  *)
(* TODO NInterval is too long in memory *)
Definition ProPrimTest (T : N)(u : N) : bool :=
  let m := u - 1 in
  let (v, w) := Decom m in (
  TryFunb
  (fun j =>
    let a := SampleN 2 m j in
    let b := (a ^ w) mod u in
    if orb (N.eqb b 1) (N.eqb b m) then true (* b.3 *) else
      TryFunb4 b u  (* b.4 *)
      (fun i b2 =>
          if N.eqb b2 m then Some true else (* b.4.2 *)
          if N.eqb b2 1 then Some false else (* b.4.3 *)
          None (* b.4.4 *)
      ) (NInterval 1 (v - 1)))
  )
  (NInterval 1 T).

(*
Definition ProPrimTest_debug (T : N)(u : N) : (bool * N * N * N * N * N * N) :=
  let m := u - 1 in
  let (v, w) := Decom m in (
  TryFunb (NInterval 1 T)
  (fun j =>
    let a := SampleN 2 m j in
    let b := (a ^ w) mod u in
    if orb (N.eqb b 1) (N.eqb b m) then (true, j) (* b.3 *) else
      TryFunb4 (NInterval 1 (v - 1)) b u (* b.4 *)
      (fun i b2 =>
          if N.eqb b2 m then Some true else (* b.4.2 *)
          if N.eqb b2 1 then Some false else (* b.4.3 *)
          None (* b.4.4 *)
      )
  ), u, m, v, w).

Definition ProPrimTest (T : N)(u : N) : bool :=
  match ProPrimTest_debug T u with
  | (result, _, _, _, _, _, _) => result
  end.
*)
(*
Compute map (ProPrimTest_debug 999) (NInterval 3 99). (* 100% Correct *)
*)

(* From C.2 Example 1 *)
Definition constant_a := HexString.to_N "0xBB8E5E8FBC115E139FE6A814FE48AAA6F0ADA1AA5DF91985".
Definition constant_p := HexString.to_N "0xBDB6F4FE3E8B1D9E0DA8C0D46F4C318CEFE4AFE3B6B8551F".

(* true if passed the test, i.e. not singular *)
Definition SingTest (a b p : N) : bool :=
 negb (4 * (P_power a 3 p) + 27 * (square b) =? 0).
(* D.1.1 method 2, true if this tuple is valid*)
Definition CheckSEED (SEED : bL)(a p : N) : option (bL * N * N) :=
  (*if Nat.leb (List.length SEED) 191%nat then None else*)
  let b := (SM3_HashN SEED) mod p in
    if negb (SingTest a b p) then None
    else Some (SEED, a, b).

Fixpoint GenSab_tail (p a : N)(seedl : list bL) : option (bL * N * N) :=
  match seedl with
  | [] => None
  | h :: tl =>
      match CheckSEED h a p with
      | Some tuple => Some tuple
      | None => GenSab_tail p a tl
      end
  end.

Definition constant_seedlist := map
  (fun x => NtobL_len 192 x) [0; 1; 2 ^ 90; 2 ^ 191].

Definition GenSab (a p : N) : option (bL * N * N) :=
  GenSab_tail p a constant_seedlist.

Definition DisplaySab (para : option (bL * N * N)) :=
  match para with
  | None => ("", "", "")
  | Some (SEED, a, b) => (bStohS (bLtobS SEED), HexString.of_N a, HexString.of_N b)
  end.

(* D.2.1 method 2 *)
Definition VeriSab (p b : N)(SEED : bL) : bool :=
  b =? (SM3_HashN SEED) mod p.

Definition constant_T := 999.

(* A.4.2.1, true means pass *)
(* j = B - i + 1 *)
Fixpoint MOV_Test_tail (q n : N)(j : nat)(acc : list (bool * N)) : list (bool * N)  :=
  match j with
  | O => acc (* i = B + 1, break *)
  | S j' =>
      match acc with
      | [] => [] (*which will not happen*)
      | (b_old, t_old) :: tl =>
        let t := (t_old * q) mod n in
        let b := andb b_old (negb (t =? 1)) in
          MOV_Test_tail q n j' ((b, t) :: acc)
      end
  end.

(* n is a prime and q is a prime exponent *)
Definition MOV_Test (B: nat)(q n : N) : bool :=
  fst (List.hd (false, 0) (MOV_Test_tail q n B [(true, 1)])).

Definition constant_B := 27%nat.

(* A.4.2.2, true means pass *)
Definition Anomalous_Curve_Test (p order: N) : bool :=
  negb (p =? order).

(* floor(2*sqrt(p)) *)
Definition floor2sqrt(p : N) : N :=
  let r2 := N.double (N.sqrt p) in
  if r2 =? N.sqrt (p * 4) then r2 else r2 + 1.

Definition Computeh' (p n : N) : N :=
  N.div (p + 1 + (floor2sqrt p)) n.
(* 5.2.2 returns None if valid, otherwise Some error message*)
(* Quick tests for large inputs *)
Definition VeriSysPara_Quick (p a b n h xG yG order : N)(SEED : bL) : option string :=
  if even p then Some "p is even." else
  if p <=? a then Some "a >= p" else
  if p <=? b then Some "b >= p" else
  if p <=? xG then Some "xG >= p" else
  if p <=? yG then Some "yG >= p" else
  let SEED_len := (N.of_nat (List.length SEED)) in
  if andb (0 <? SEED_len) (SEED_len <? 192) then Some "SEED is shorter than 192." else
  if andb (0 <? SEED_len ) (negb (VeriSab p b SEED)) then Some "Failed in VeriSab." else
  if negb (SingTest p a b) then Some "Failed in SingTest." else
  if negb (OnCurve_pf p a b xG yG) then Some "Failed in OnCurveTest." else
  if n <=? N.shiftl 1 191 then Some "n <= 2 ^ 192." else
  if square n <=? 16 * p then Some "n <= 4 p ^ 1/2." else
  if negb (h =? Computeh' p n) then Some "h != h'." else
  None.

(* These tests are quite time consuming *)
Definition VeriSysPara (p a b n h xG yG order: N)(SEED : bL) : option string :=
  match VeriSysPara_Quick p a b n h xG yG order SEED with
  | Some msg => Some msg
  | None =>
    if negb (GE_eqb (pf_mul p a (Cop (xG, yG)) n) InfO) then Some "[n]G != O." else
    if negb (ProPrimTest constant_T p) then Some "p is a composite." else
    if negb (ProPrimTest constant_T n)  then Some "n is a composite." else
    if negb (MOV_Test constant_B p n ) then Some "Failed in MOV test" else
    if negb (Anomalous_Curve_Test p order) then Some "Failed in Anomalous Curve Test" else
    None
  end.
Module tests.

(*
(* C.2 *)
(* Example 1 *)
Time Compute
let p := hStoN "BDB6F4FE3E8B1D9E0DA8C0D46F4C318CEFE4AFE3B6B8551F" in
let a := hStoN "BB8E5E8FBC115E139FE6A814FE48AAA6F0ADA1AA5DF91985" in
let b := hStoN "1854BEBDC31B21B7AEFC80AB0ECD10D5B1B3308E6DBF11C1" in
let xG := hStoN "4AD5F7048DE709AD51236DE65E4D4B482C836DC6E4106640" in
let yG := hStoN "02BB3A02D4AAADACAE24817A4CA3A1B014B5270432DB27D2" in
let n := hStoN "BDB6F4FE3E8B1D9E0DA8C0D40FC962195DFAE76F56564677" in
let h := 1 in (*By Hasse Thm*)
let order := 1 in (*There is no way for me to know it, just assign it to test*)
  VeriSysPara_Quick p a b n h xG yG order []

. (* None *)

(* Example 2 *)
Time Compute
let p := hStoN "8542D69E4C044F18E8B92435BF6FF7DE457283915C45517D722EDB8B08F1DFC3" in
let a := hStoN "787968B4FA32C3FD2417842E73BBFEFF2F3C848B6831D7E0EC65228B3937E498" in
let b := hStoN "63E4C6D3B23B0C849CF84241484BFE48F61D59A5B16BA06E6E12D1DA27C5249A" in
let xG := hStoN "421DEBD61B62EAB6746434EBC3CC315E32220B3BADD50BDC4C4E6C147FEDD43D" in
let yG := hStoN "0680512BCBB42C07D47349D2153B70C4E5D7FDFCBFA36EA1A85841B9E46E09A2" in
let n := hStoN "8542D69E4C044F18E8B92435BF6FF7DD297720630485628D5AE74EE7C32E79B7" in
let h := 1 in (*By Hasse Thm*)
let order := 1 in (*There is no way for me to know it, just assign it to test*)
  VeriSysPara_Quick p a b n h xG yG order []
. (* None *)

End tests.
*)

(* B.2.4, Irredicible Polynomial Test*)
(* j = d/2 - i *)
Fixpoint IrdBody (sq : N -> N)(gcd : N -> N -> N)(f u' : N)(j : nat) : bool :=
  match j with
  | O => true
  | S j' =>
    let u := B_mod (sq u') f in
    let g := gcd (B_add u 2) f in
      if N.eqb g 1 then IrdBody sq gcd f u j'
        else false
  end.

Definition IrdTest (f : N) : bool :=
  let d := size_nat f in
  let u := 2%N in
    IrdBody (Bp_sq_raw) B_gcd f u (Nat.div d 2).

(*
(* TODO need test casess *)

Compute IrdTest  37. (* Correct  *)

Compute List.length [].

Print map.

Compute map N.double [2; 3].

Definition TPB_list := map decode_TPB TPB_IRP.

(*Compute map IrdTest (TPB_list). All true, correct *)
Definition PPB_list := map decode_PPB PPB_IRP.
(*Time Compute map IrdTest (PPB_list).*) (*Finished transaction in 393.439 secs (393.19u,0.153s) (successful)All true, correct *)
*)
End tests.
*)


Require Import Coq.Lists.List.
Require Import Coq.micromega.Lia.
Require Import Coq.Arith.PeanoNat.
Require Import Coq.Arith.Compare_dec.
Require Import Coq.PArith.BinPosDef.
Require Import Coq.ZArith.Znumtheory.

Require Import Crypto.Spec.ModularArithmetic.
Require Import Crypto.Arithmetic.PrimeFieldTheorems.
Require Import Coq.Bool.Bool.

Require Import Circom.Tuple.
Require Import Crypto.Util.Decidable. (* Crypto.Util.Notations. *)
Require Import BabyJubjub.
Require Import Coq.setoid_ring.Ring_theory Coq.setoid_ring.Field_theory Coq.setoid_ring.Field_tac.
Require Import Crypto.Algebra.Ring Crypto.Algebra.Field.

From Circom Require Import Circom Default LibTactics Util.
Require Import Circom.Circom Circom.Default.

(* Circuit:
* https://github.com/iden3/circomlib/blob/master/circuits/gates.circom
*)

Local Open Scope list_scope.
Local Open Scope F_scope.

Module Gates.

#[local] Hint Extern 10 (_ = _) => fqsatz : core.
#[local] Hint Extern 10 (binary _) => (left; fqsatz) || (right; fqsatz): core.

Module XOR.
(* template XOR() {
    signal input a;
    signal input b;
    signal output out;
    out <== a + b - 2*a*b;
} *)

Definition cons (a b out: F) :=
  out = a + b - (1 + 1) * a * b.

Record t := { a:F; b:F; out:F; _cons: cons a b out; }.

Theorem soundness: forall (c: t),
  (* pre-conditions *)
  binary c.(a) ->
  binary c.(b) ->
  (* post-conditions *)
  if (c.(a) = c.(b))? then c.(out) = 0 else c.(out) = 1 /\
  binary c.(out).
Proof.
  unwrap_C.
  intros c Ha Hb. destruct c as [a b c _cons].
  unfold cons in *. simpl in *.
  destruct Ha; destruct Hb; subst; split_dec; intuit;
  auto.
Qed.
End XOR.

Module AND.
(* template AND() {
    signal input a;
    signal input b;
    signal output out;
    out <== a*b;
} *)

Definition cons (a b out: F) :=
  out = a * b.

Record t := { a:F; b:F; out:F; _cons: cons a b out; }.

Theorem soundness: forall (c: t),
  (* pre-conditions *)
  binary c.(a) ->
  binary c.(b) ->
  (* post-conditions *)
  binary c.(out) /\
  ((c.(a) = 1)?) && ((c.(b) = 1)?) = ((c.(out) = 1)?).
Proof.
  unwrap_C.
  intros c Ha Hb. destruct c as [a b c _cons].
  unfold cons in *. simpl in *.
  destruct Ha; destruct Hb; subst; split_dec; intuit;
  auto || (exfalso; auto).
Qed.

Lemma is_sound (c: t):
  binary c.(a) ->
  binary c.(b) ->
  (c.(out) = 1 <-> (c.(a) = 1 /\ c.(b) = 1)).
Proof.
  intros Hbin_a Hbin_b.
  specialize (soundness c Hbin_a Hbin_b). intro.
  split_dec; simpl in *; intuit; auto || discriminate.
Qed.

Lemma is_binary (c: t):
  binary c.(a) ->
  binary c.(b) ->
  binary c.(out).
Proof. specialize (soundness c). intuit. Qed.

Definition wgen: t. skip. Defined.

#[global] Instance Default: Default t. constructor. exact wgen. Defined.

End AND.

Module OR.
(* template OR() {
    signal input a;
    signal input b;
    signal output out;

    out <== a + b - a*b;
} *)
Definition cons (a b out: F) :=
  out = a + b - a*b.

Record t := { a:F; b:F; out:F; _cons: cons a b out; }.

Theorem soundness: forall (c: t),
  (* pre-conditions *)
  binary c.(a) ->
  binary c.(b) ->
  (* post-conditions *)
  binary c.(out) /\
  ((c.(a) = 1)?) || ((c.(b) = 1)?) = ((c.(out) = 1)?).
Proof.
  unwrap_C.
  intros c Ha Hb. destruct c as [a b c _cons].
  unfold cons in *. simpl in *.
  destruct Ha; destruct Hb; subst; split_dec; intuit;
  auto || (exfalso; auto).
Qed.

Lemma is_sound (c: t):
  binary c.(a) ->
  binary c.(b) ->
  (c.(out) = 1 <-> (c.(a) = 1 \/ c.(b) = 1)).
Proof.
  intros Hbin_a Hbin_b.
  specialize (soundness c Hbin_a Hbin_b). intro.
  split_dec; simpl in *; intuit; auto || discriminate.
Qed.

Lemma is_binary (c: t):
  binary c.(a) ->
  binary c.(b) ->
  binary c.(out).
Proof. specialize (soundness c). intuition idtac. Qed.

Definition wgen: t. skip. Defined.

#[global] Instance Default: Default t. constructor. exact wgen. Defined.
End OR.

Module NOT.
(* template NOT() {
    signal input in;
    signal output out;

    out <== 1 + in - 2*in;
} *)
Definition cons (_in out: F) :=
  out = 1 + _in - (1 + 1) * _in.

Record t := { _in:F; out:F; _cons: cons _in out; }.

Lemma not_0_eq_1: (0:F) <> (1:F).
Proof. unwrap_C. fqsatz.
Qed.

Theorem soundness: forall (c: t),
  (* pre-conditions *)
  binary c.(_in) ->
  (* post-conditions *)
  binary c.(out) /\
  ((c.(_in) = 1)?) = ((c.(out) = 0)?).
Proof.
  unwrap_C.
  intros c Ha. destruct c as [_in out _cons].
  unfold cons in *. simpl in *.
  destruct Ha; subst; split_dec; intuit; auto || (exfalso; auto).
Qed.

Definition wgen: t. skip. Defined.

#[global] Instance Default: Default t. constructor. exact wgen. Defined.
End NOT.

Module NAND.
(* template NAND() {
    signal input a;
    signal input b;
    signal output out;

    out <== 1 - a*b;
} *)

Definition cons (a b out: F) :=
  out = 1 - a * b.

Record t := { a:F; b:F; out:F; _cons: cons a b out; }.

Theorem soundness: forall (c: t),
  (* pre-conditions *)
  binary c.(a) ->
  binary c.(b) ->
  (* post-conditions *)
  binary c.(out) /\
  ((c.(a) = 1)?) && ((c.(b) = 1)?) = ((c.(out) = 0)?).
Proof.
  unwrap_C.
  intros c Ha Hb. destruct c as [a b c _cons].
  unfold cons in *. simpl in *.
  destruct Ha; destruct Hb; subst; split_dec; intuit;
  auto || (exfalso; auto).
Qed.

Definition wgen: t. skip. Defined.

#[global] Instance Default: Default t. constructor. exact wgen. Defined.

End NAND.

Module NOR.
(* template NOR() {
    signal input a;
    signal input b;
    signal output out;

    out <== a*b + 1 - a - b;
} *)
Definition cons (a b out: F) :=
  out = a*b + 1 - a - b.

Record t := { a:F; b:F; out:F; _cons: cons a b out; }.

Theorem soundness: forall (c: t),
  (* pre-conditions *)
  binary c.(a) ->
  binary c.(b) ->
  (* post-conditions *)
  binary c.(out) /\
  ((c.(a) = 1)?) || ((c.(b) = 1)?) = ((c.(out) = 0)?).
Proof.
  unwrap_C.
  intros c Ha Hb. destruct c as [a b c _cons].
  unfold cons in *. simpl in *.
  destruct Ha; destruct Hb; subst; split_dec; intuit;
  auto || (exfalso; auto).
Qed.

Definition wgen: t. skip. Defined.

#[global] Instance Default: Default t. constructor. exact wgen. Defined.
End NOR.

Module MultiAND.

(* template MultiAND(n) {
    signal input in[n];
    signal output out;
    component and1;
    component and2;
    component ands[2];
    if (n==1) {
        out <== in[0];
    } else if (n==2) {
        and1 = AND();
        and1.a <== in[0];
        and1.b <== in[1];
        out <== and1.out;
    } else {
        and2 = AND();
        var n1 = n\2;
        var n2 = n-n\2;
        ands[0] = MultiAND(n1);
        ands[1] = MultiAND(n2);
        var i;
        for (i=0; i<n1; i++) ands[0].in[i] <== in[i];
        for (i=0; i<n2; i++) ands[1].in[i] <== in[n1+i];
        and2.a <== ands[0].out;
        and2.b <== ands[1].out;
        out <== and2.out;
    }
} *)

End MultiAND.

End Gates.


Require Import ILL.Definitions.

(** ** PCP reduces to BPCP *)

(* natural numbers n to bitstrings of the form 1^n *)

Definition to_bitstring (n : nat) : string bool := Nat.iter n (cons true) [].

Lemma bitstring_false a : ~ false el to_bitstring a.
Proof.
  induction a; cbn; firstorder.
Qed.

(* strings of natural numbers to bitstrings, [ n1, ... n2 ] |-> 1^n1 0 ... 1^n2 0 *)
Fixpoint f_s (x : string nat) : string bool :=
  match x with
  | nil => nil
  | a :: x => to_bitstring a ++ [false] ++ f_s x
  end.

Lemma f_s_app x y : f_s (x ++ y) = f_s x ++ f_s y.
Proof.
  induction x; cbn.
  - reflexivity.
  - rewrite IHx. now simpl_list.
Qed.

(* extension to cards and stacks *)
Definition f_c '(x,y) := (f_s x, f_s y).
Definition f (P : SRS) : BSRS :=
  map f_c P.

Lemma tau1_f A : tau1 (f A) = f_s (tau1 A).
Proof.
  induction A as [ | (x,y) ]; cbn.
  - reflexivity.
  - unfold f in IHA. now rewrite IHA, f_s_app.
Qed.

Lemma tau2_f A : tau2 (f A) = f_s (tau2 A).
Proof.
  induction A as [ | (x,y) ]; cbn.
  - reflexivity.
  - unfold f in IHA. now rewrite IHA, f_s_app.
Qed.

(* interpretation of a bitstring as list of natural numbers *)
Fixpoint g_s' (x : string bool) (n : nat) : string nat :=
  match x with
  | nil => nil
  | true :: x' => g_s' x' (S n)
  | false :: x' => n :: g_s' x' 0
  end.

Lemma g_s'_app n x y :
  g_s' (f_s x ++ y) n = match x with nil => g_s' y n | m :: x => n + m :: x ++ g_s' y 0 end.
Proof.
  revert n y. induction x as [ | m]; intros; cbn in *.
  - reflexivity.
  - revert n; induction m; intros; cbn in *.
    + destruct x.
      * do 2 f_equal. omega.
      * rewrite IHx. f_equal. omega.
    + rewrite IHm. f_equal. omega.
Qed.

Definition g_s x := g_s' x 0.

Lemma f_g_s'_inv x : g_s (f_s x) = x.
Proof.
  unfold g_s. setoid_rewrite <- app_nil_r at 2. rewrite g_s'_app.
  destruct x; now simpl_list.
Qed.

(* extension to cards and stacks *)
Definition g_c '(x,y) := (g_s x, g_s y).
Definition g (P : BSRS) : SRS :=
  map g_c P.

(* Invariants *)

Lemma tau1_g A B : A <<= f B -> tau1 (g A) = g_s (tau1 A).
Proof.
  induction A as [ | (x,y)]; cbn.
  - reflexivity.
  - unfold g in IHA. intros. rewrite !IHA.
    assert ( x /y el map f_c B) as ((x',y') & ? & ?) % in_map_iff by firstorder; inv H0.
    rewrite g_s'_app. destruct x'.
    + cbn. reflexivity.
    + rewrite f_g_s'_inv. cbn. reflexivity.
    + firstorder.
Qed.

Lemma tau2_g A B : A <<= f B -> tau2 (g A) = g_s (tau2 A).
Proof.
  induction A as [ | (x,y)]; cbn.
  - reflexivity.
  - unfold g in IHA. intros. rewrite !IHA.
    assert ( x /y el map f_c B) as ((x',y') & ? & ?) % in_map_iff by firstorder; inv H0.
    rewrite g_s'_app. destruct y'.
    + cbn. reflexivity.
    + rewrite f_g_s'_inv. cbn. reflexivity.
    + firstorder.
Qed.

Lemma f_subset B A : A <<= B -> f A <<= f B.
Proof.
  induction A in B |- *; intros H; cbn.
  * firstorder.
  * intros ? [| H0]; subst.
    -- unfold f. eapply in_map_iff. eauto.
    -- eapply IHA in H0; eauto.
Qed.

Lemma f_g_subset B A : A <<= f B -> g A <<= B.
Proof.
  revert B; induction A; intros B H; cbn.
  * firstorder.
  * assert (a el f B) by firstorder.
    unfold f in H0. eapply in_map_iff in H0 as ((x,y) & ? & ?). inv H0.
    intros ? [|]; subst. cbn. now rewrite !f_g_s'_inv. firstorder.
Qed.

Lemma PCP_BPCP : PCP ⪯  BPCP.
Proof.
  exists f. intros B. split.
  - intros (A & HP & He & H). exists (f A). repeat split.
    + now eapply f_subset.
    + destruct A; cbn; congruence.
    + unfold f, f_c, f_s. setoid_rewrite tau1_f. setoid_rewrite tau2_f. now rewrite H.
  - intros (A & HP & He & H). exists (g A). repeat split.
    + eapply f_g_subset; eauto.
    + destruct A; cbn; congruence.
    + erewrite tau1_g, tau2_g, H; eauto.
Qed.