Require Import rt.util.all.
Require Import rt.model.jitter.job rt.model.jitter.task rt.model.jitter.task_arrival
               rt.model.jitter.schedule rt.model.jitter.platform rt.model.jitter.interference
               rt.model.jitter.workload rt.model.jitter.schedulability
               rt.model.jitter.priority rt.model.jitter.platform rt.model.jitter.response_time.
Require Import rt.analysis.jitter.workload_bound
               rt.analysis.jitter.interference_bound_edf.
From mathcomp Require Import ssreflect ssrbool eqtype ssrnat seq fintype bigop div path.

Module ResponseTimeAnalysisEDFJitter.

  Export JobWithJitter SporadicTaskset ScheduleOfSporadicTaskWithJitter Workload
         Schedulability ResponseTime Priority SporadicTaskArrival WorkloadBoundJitter
         InterferenceBoundEDFJitter Platform Interference.

  (* In this section, we prove that Bertogna and Cirinei's RTA yields
     safe response-time bounds. *)
  Section ResponseTimeBound.

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

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

    (* Assume any job arrival sequence... *)
    Context {arr_seq: arrival_sequence Job}.

    (* ... in which jobs arrive sporadically and have valid parameters.
       Note: the jitter of a valid job is bounded by the jitter of its task. *)
    Hypothesis H_sporadic_tasks:
      sporadic_task_model task_period arr_seq job_task.
    Hypothesis H_valid_job_parameters:
      forall (j: JobIn arr_seq),
        valid_sporadic_job_with_jitter task_cost task_deadline task_jitter job_cost
                                                 job_deadline job_task job_jitter j.

    (* Consider any schedule such that...*)
    Variable num_cpus: nat.
    Variable sched: schedule num_cpus arr_seq.

    (* ...jobs execute after jitter and no longer than their execution costs. *)
    Hypothesis H_jobs_execute_after_jitter:
      jobs_execute_after_jitter job_jitter sched.
    Hypothesis H_completed_jobs_dont_execute:
      completed_jobs_dont_execute job_cost sched.

    (* Also assume that jobs are sequential and that there exists
       at least one processor. *)
    Hypothesis H_sequential_jobs: sequential_jobs sched.
    Hypothesis H_at_least_one_cpu: num_cpus > 0.

    (* Assume that we have a task set ts, such that all jobs come
       from the task set, and all tasks have valid parameters and
       constrained deadlines. *)
    Variable ts: taskset_of sporadic_task.
    Hypothesis H_all_jobs_from_taskset:
      forall (j: JobIn arr_seq), job_task j \in ts.
    Hypothesis H_valid_task_parameters:
      valid_sporadic_taskset task_cost task_period task_deadline ts.
    Hypothesis H_constrained_deadlines:
      forall tsk, tsk \in ts -> task_deadline tsk <= task_period tsk.

    Let no_deadline_is_missed_by_tsk (tsk: sporadic_task) :=
      task_misses_no_deadline job_cost job_deadline job_task sched tsk.
    Let response_time_bounded_by (tsk: sporadic_task) :=
      is_response_time_bound_of_task job_cost job_task tsk sched.

    (* Assume a known response-time bound R is known...  *)
    Let task_with_response_time := (sporadic_task * time)%type.
    Variable rt_bounds: seq task_with_response_time.

    (* ...for any task in the task set. *)
    Hypothesis H_rt_bounds_contains_all_tasks: unzip1 rt_bounds = ts.

    (* Also, assume that R is a fixed-point of the response-time recurrence, ... *)
    Let I (tsk: sporadic_task) (delta: time) :=
      total_interference_bound_edf task_cost task_period task_deadline task_jitter tsk rt_bounds delta.
    Hypothesis H_response_time_is_fixed_point :
      forall tsk R,
        (tsk, R) \in rt_bounds ->
        R = task_cost tsk + div_floor (I tsk R) num_cpus.

    (* ..., and R is no larger than the deadline. *)
    Hypothesis H_tasks_miss_no_deadlines:
      forall tsk R,
        (tsk, R) \in rt_bounds ->
        task_jitter tsk + R <= task_deadline tsk.

    (* Assume that we have a work-conserving EDF scheduler. *)
    Hypothesis H_work_conserving: work_conserving job_cost job_jitter sched.
    Hypothesis H_edf_policy: enforces_JLDP_policy job_cost job_jitter sched (EDF job_deadline).

    (* Assume that the task set has no duplicates. This is required to
       avoid problems when counting tasks (for example, when stating
       that the number of interfering tasks is at most num_cpus). *)
    Hypothesis H_ts_is_a_set : uniq ts.

    (* In order to prove that R is a response-time bound, we first present some lemmas. *)
    Section Lemmas.

      (* Let (tsk, R) be any task to be analyzed, with its response-time bound R. *)
      Variable tsk: sporadic_task.
      Variable R: time.
      Hypothesis H_tsk_R_in_rt_bounds: (tsk, R) \in rt_bounds.

      (* Consider any job j of tsk. *)
      Variable j: JobIn arr_seq.
      Hypothesis H_job_of_tsk: job_task j = tsk.

      (* Let t1 be the first point in time where j can actually be scheduled. *)
      Let t1 := job_arrival j + job_jitter j.

      (* Assume that job j did not complete on time, ... *)
      Hypothesis H_j_not_completed: ~~ completed job_cost sched j (t1 + R).

      (* and that it is the first job not to satisfy its response-time bound. *)
      Hypothesis H_all_previous_jobs_completed_on_time :
        forall (j_other: JobIn arr_seq) tsk_other R_other,
          job_task j_other = tsk_other ->
          (tsk_other, R_other) \in rt_bounds ->
          job_arrival j_other + task_jitter tsk_other + R_other < job_arrival j + task_jitter tsk + R ->
          completed job_cost sched j_other (job_arrival j_other + task_jitter tsk_other + R_other).

      (* Let's call x the interference incurred by job j due to tsk_other, ...*)
      Let x (tsk_other: sporadic_task) :=
        task_interference job_cost job_task job_jitter sched j tsk_other t1 (t1 + R).

      (* and X the total interference incurred by job j due to any task. *)
      Let X := total_interference job_cost job_jitter sched j t1 (t1 + R).

      (* Recall Bertogna and Cirinei's workload bound ... *)
      Let workload_bound (tsk_other: sporadic_task) (R_other: time) :=
        W_jitter task_cost task_period task_jitter tsk_other R_other R.

      (*... and the EDF-specific bound, ... *)
      Let edf_specific_bound (tsk_other: sporadic_task) (R_other: time) :=
        edf_specific_interference_bound task_cost task_period task_deadline task_jitter tsk tsk_other R_other.

      (* ... which combined form the interference bound. *)
      Let interference_bound (tsk_other: sporadic_task) (R_other: time) :=
        interference_bound_edf task_cost task_period task_deadline task_jitter tsk R (tsk_other, R_other).

      (* Also, let ts_interf be the subset of tasks that interfere with tsk. *)
      Let ts_interf := [seq tsk_other <- ts | jldp_can_interfere_with tsk tsk_other].

      Section LemmasAboutInterferingTasks.

        (* Let (tsk_other, R_other) be any pair of higher-priority task and
           response-time bound computed in previous iterations. *)
        Variable tsk_other: sporadic_task.
        Variable R_other: time.
        Hypothesis H_response_time_of_tsk_other: (tsk_other, R_other) \in rt_bounds.

        (* Note that tsk_other is in task set ts ...*)
        Lemma bertogna_edf_tsk_other_in_ts: tsk_other \in ts.
        Proof.
          by rewrite -H_rt_bounds_contains_all_tasks; apply/mapP; exists (tsk_other, R_other).
        Qed.

        (* Also, R_other is larger than the cost of tsk_other. *)
        Lemma bertogna_edf_R_other_ge_cost :
          R_other >= task_cost tsk_other.
        Proof.
          by rewrite [R_other](H_response_time_is_fixed_point tsk_other);
            first by apply leq_addr.
        Qed.

        (* Since tsk_other cannot interfere more than it executes, we show that
           the interference caused by tsk_other is no larger than workload bound W. *)
        Lemma bertogna_edf_workload_bounds_interference :
          x tsk_other <= workload_bound tsk_other R_other.
        Proof.
          unfold valid_sporadic_job in *.
          rename H_all_previous_jobs_completed_on_time into BEFOREok,
                 H_valid_job_parameters into PARAMS,
                 H_valid_task_parameters into TASK_PARAMS,
                 H_constrained_deadlines into RESTR,
                 H_tasks_miss_no_deadlines into NOMISS.
          unfold x, task_interference, valid_sporadic_job_with_jitter, valid_sporadic_job in *.
          have INts := bertogna_edf_tsk_other_in_ts.
          apply leq_trans with (n := workload job_task sched tsk_other t1 (t1 + R));
            first by apply task_interference_le_workload.
          apply workload_bounded_by_W with (task_deadline0 := task_deadline)
            (job_jitter0 := job_jitter) (job_cost0 := job_cost) (job_deadline0 := job_deadline);
            try (by ins); last 2 first;
            [ by apply NOMISS |
            | by ins; apply TASK_PARAMS
            | by apply RESTR
            | by apply bertogna_edf_R_other_ge_cost].
          {
            intros j0 JOB0 LT0; apply BEFOREok; try (by done).
            unfold t1 in *.
            apply leq_trans with (n := job_arrival j + job_jitter j + R); first by done.
            rewrite leq_add2r leq_add2l.
            specialize (PARAMS j); des.
            rewrite -H_job_of_tsk; apply PARAMS0.
          }
        Qed.

        (* Recall that the edf-specific interference bound also holds. *)
        Lemma bertogna_edf_specific_bound_holds :
          x tsk_other <= edf_specific_bound tsk_other R_other.
        Proof.
          by apply interference_bound_edf_bounds_interference with (job_deadline0 := job_deadline)
                                                                  (ts0 := ts); try (by done);
          [  by apply bertogna_edf_tsk_other_in_ts
          |  by apply H_tasks_miss_no_deadlines
          |  by apply leq_trans with (n := task_jitter tsk + R);
               [apply leq_addl | by apply H_tasks_miss_no_deadlines]
          |  by ins; apply H_all_previous_jobs_completed_on_time with (tsk_other := tsk_other)].
        Qed.

      End LemmasAboutInterferingTasks.

      (* Next we prove some lemmas that help to derive a contradiction.*)
      Section DerivingContradiction.

        (* 0) Since job j did not complete by its response time bound, it follows that
              the total interference X >= R - e_k + 1. *)
        Lemma bertogna_edf_too_much_interference : X >= R - task_cost tsk + 1.
        Proof.
          rename H_completed_jobs_dont_execute into COMP,
                 H_valid_job_parameters into PARAMS, H_response_time_is_fixed_point into REC,
                 H_job_of_tsk into JOBtsk, H_j_not_completed into NOTCOMP.
          unfold completed, valid_sporadic_job_with_jitter, valid_sporadic_job in *.
          unfold X, total_interference; rewrite addn1.
          rewrite -(ltn_add2r (task_cost tsk)).
          rewrite subh1; last by rewrite [R](REC tsk) // leq_addr.
          rewrite -addnBA // subnn addn0.
          move: (NOTCOMP) => /negP NOTCOMP'.
          rewrite neq_ltn in NOTCOMP.
          move: NOTCOMP => /orP [LT | BUG]; last first.
          {
            exfalso; rewrite ltnNge in BUG; move: BUG => /negP BUG; apply BUG.
            by apply cumulative_service_le_job_cost.
          }
          apply leq_ltn_trans with (n := (\sum_(t1 <= t < t1 + R)
                                       backlogged job_cost job_jitter sched j t) +
                                     service sched j (t1 + R)); last first.
          {
            rewrite -addn1 -addnA leq_add2l addn1.
            apply leq_trans with (n := job_cost j); first by done.
            by specialize (PARAMS j); des; rewrite -JOBtsk.
          }
          unfold service.
          rewrite -> big_cat_nat with (n := t1) (m := 0); rewrite ?leq_addr // /=.
          rewrite (cumulative_service_before_jitter_zero job_jitter) // add0n.
          rewrite -big_split /=.
          apply leq_trans with (n := \sum_(t1 <= i < t1 + R) 1);
            first by simpl_sum_const; rewrite addKn.
          apply leq_sum_nat; move => i /andP [GEi LTi] _.
          destruct (backlogged job_cost job_jitter sched j i) eqn:BACK;
            first by rewrite -addn1 addnC; apply leq_add.
          apply negbT in BACK.
          rewrite add0n lt0n -not_scheduled_no_service negbK.
          rewrite /backlogged negb_and negbK in BACK.
          move: BACK => /orP [/negP NOTPENDING | SCHED]; last by done.
          exfalso; apply NOTPENDING; unfold pending; apply/andP; split; first by done.
          apply/negP; red; intro BUG; apply NOTCOMP'.
          by apply completion_monotonic with (t := i); try (by done); apply ltnW.
        Qed.

        Let scheduled_task_other_than_tsk (t: time) (tsk_other: sporadic_task) :=
          task_is_scheduled job_task sched tsk_other t &&
          jldp_can_interfere_with tsk tsk_other.

        (* 1) At all times that j is backlogged, all processors are busy with other tasks. *)
        Lemma bertogna_edf_scheduling_invariant:
          forall t,
            t1 <= t < t1 + R ->
            backlogged job_cost job_jitter sched j t ->
            count (scheduled_task_other_than_tsk t) ts = num_cpus.
        Proof.
          rename H_all_jobs_from_taskset into FROMTS,
                 H_valid_task_parameters into PARAMS,
                 H_valid_job_parameters into JOBPARAMS,
                 H_job_of_tsk into JOBtsk,
                 H_sporadic_tasks into SPO,
                 H_tsk_R_in_rt_bounds into INbounds,
                 H_all_previous_jobs_completed_on_time into BEFOREok,
                 H_tasks_miss_no_deadlines into NOMISS,
                 H_rt_bounds_contains_all_tasks into UNZIP,
                 H_constrained_deadlines into RESTR,
                 H_work_conserving into WORK.
          unfold x, X, total_interference, task_interference,
                 valid_sporadic_job_with_jitter, valid_sporadic_job in *.
          move => t /andP [LEt LTt] BACK.
          unfold scheduled_task_other_than_tsk in *.
          eapply platform_cpus_busy_with_interfering_tasks; try (by done);
            [ by apply WORK | by done | by apply SPO
            | apply PARAMS; rewrite -JOBtsk; apply FROMTS
            | by apply JOBtsk | by apply BACK | ].
          {
            intros j0 tsk0 TSK0 LE.
            cut (tsk0 \in unzip1 rt_bounds = true); last by rewrite UNZIP -TSK0 FROMTS.
            move => /mapP [p IN EQ]; destruct p as [tsk' R0]; simpl in *; subst tsk'.
            apply completion_monotonic with (t0 := job_arrival j0 + task_jitter tsk0 + R0); try (by done).
            {
              rewrite -addnA leq_add2l TSK0.
              apply leq_trans with (n := task_deadline tsk0); first by apply NOMISS.
              by apply RESTR; rewrite -TSK0 FROMTS.
            }
            {
              apply BEFOREok with (tsk_other := tsk0); try (by done).
              apply leq_trans with (n := t1 + R); last first.
              {
                  rewrite leq_add2r leq_add2l -JOBtsk.
                  by specialize (JOBPARAMS j); des.
              }
              apply leq_ltn_trans with (n := t); last by done.
              apply leq_trans with (n := job_arrival j0 + task_period tsk0);
                last by done.
              rewrite -addnA leq_add2l.
              apply leq_trans with (n := task_deadline tsk0); first by apply NOMISS.
              by apply RESTR; rewrite -TSK0; apply FROMTS.
            }
          }
        Qed.

        (* 2) Prove that during the scheduling window of j, any job that is scheduled while j is
           backlogged comes from a different task. *)
        Lemma bertogna_edf_interference_by_different_tasks :
          forall t j_other,
            t1 <= t < t1 + R ->
            backlogged job_cost job_jitter sched j t ->
            scheduled sched j_other t ->
            job_task j_other != tsk.
        Proof.
          rename H_all_jobs_from_taskset into FROMTS,
                 H_valid_task_parameters into PARAMS,
                 H_valid_job_parameters into JOBPARAMS,
                 H_job_of_tsk into JOBtsk, H_sporadic_tasks into SPO,
                 H_work_conserving into WORK,
                 H_tsk_R_in_rt_bounds into INbounds,
                 H_all_previous_jobs_completed_on_time into BEFOREok,
                 H_tasks_miss_no_deadlines into NOMISS,
                 H_constrained_deadlines into CONSTR.
          unfold valid_sporadic_job_with_jitter, valid_sporadic_job in *.
          move => t j_other /andP [LEt GEt] BACK SCHED.
          apply/eqP; red; intro SAMEtsk.
          move: SCHED => /existsP [cpu SCHED].
          assert (SCHED': scheduled sched j_other t).
            by apply/existsP; exists cpu.
          clear SCHED; rename SCHED' into SCHED.
          move: (SCHED) => PENDING.
          apply scheduled_implies_pending with (job_cost0 := job_cost) (job_jitter0 := job_jitter)
            in PENDING; try (by done).
          destruct (ltnP (job_arrival j_other) (job_arrival j)) as [BEFOREother | BEFOREj].
          {
            move: (BEFOREother) => LT; rewrite -(ltn_add2r R) in LT.
            exploit (BEFOREok j_other tsk R SAMEtsk INbounds).
            {
              rewrite -addnA [_ + R]addnC addnA -[(_ + _) + R]addnA [_ tsk + R]addnC addnA.
              by rewrite ltn_add2r.
            }
            intros COMP.
            move: PENDING => /andP [_ /negP NOTCOMP]; apply NOTCOMP.
            apply completion_monotonic with (t0 := job_arrival j_other + task_jitter tsk + R);
              try by done.
            apply leq_trans with (n := job_arrival j);
              last by apply leq_trans with (n := t1); [by apply leq_addr | by done].
            apply leq_trans with (n := job_arrival j_other + task_period tsk).
            {
              rewrite -addnA leq_add2l.
              by apply leq_trans with (n := task_deadline tsk);
                [by apply NOMISS | by apply CONSTR; rewrite -JOBtsk FROMTS].
            }
            rewrite -SAMEtsk; apply SPO; [ | by rewrite JOBtsk | by apply ltnW].
            by red; intro EQ; subst; rewrite ltnn in BEFOREother.
          }
          {
            move: PENDING => /andP [ARRIVED _].
            exploit (SPO j j_other); [ | by rewrite SAMEtsk | by done | ]; last first.
            {
              apply/negP; rewrite -ltnNge JOBtsk.
              apply leq_trans with (n := job_arrival j + task_deadline tsk);
                last by rewrite leq_add2l; apply CONSTR; rewrite -JOBtsk FROMTS.
              apply leq_trans with (n := job_arrival j + task_jitter tsk + R);
                last by rewrite -addnA leq_add2l; apply NOMISS.
              apply leq_trans with (n := t1 + R); last first.
              {
                rewrite leq_add2r leq_add2l -JOBtsk.
                by specialize (JOBPARAMS j); des.
              }
              apply leq_ltn_trans with (n := job_arrival j_other + job_jitter j_other);
                first by apply leq_addr.
              by apply leq_ltn_trans with (n := t).
            }
            by intros EQtsk; subst j_other; rewrite /backlogged SCHED andbF in BACK.
          }
        Qed.

      (* 3) Next, we prove that the sum of the interference of each task is equal
          to the total interference multiplied by the number of processors. This
          holds because interference only occurs when all processors are busy. *)
        Lemma bertogna_edf_all_cpus_busy :
          \sum_(tsk_k <- ts_interf) x tsk_k = X * num_cpus.
        Proof.
          have DIFFTASK := bertogna_edf_interference_by_different_tasks.
          rename H_all_jobs_from_taskset into FROMTS,
                 H_valid_task_parameters into PARAMS,
                 H_job_of_tsk into JOBtsk, H_sporadic_tasks into SPO,
                 H_work_conserving into WORK,
                 H_tsk_R_in_rt_bounds into INbounds,
                 H_all_previous_jobs_completed_on_time into BEFOREok,
                 H_tasks_miss_no_deadlines into NOMISS,
                 H_rt_bounds_contains_all_tasks into UNZIP,
                 H_constrained_deadlines into CONSTR.
          unfold sporadic_task_model in *.
          unfold x, X, total_interference, task_interference.
          rewrite -big_mkcond -exchange_big big_distrl /= mul1n.
          rewrite [\sum_(_ <= _ < _ | backlogged _ _ _ _ _) _]big_mkcond.
          apply eq_big_nat; move => t /andP [GEt LTt].
          destruct (backlogged job_cost job_jitter sched j t) eqn:BACK;
            last by rewrite big1 //; ins; rewrite big1.
          rewrite big_mkcond /=.
          rewrite exchange_big /=.
          apply eq_trans with (y := \sum_(cpu < num_cpus) 1); last by simpl_sum_const.
          apply eq_bigr; intros cpu _.
          move: (WORK j t BACK cpu) => [j_other /eqP SCHED]; unfold scheduled_on in *.
          rewrite (bigD1_seq (job_task j_other)) /=; last by rewrite filter_uniq.
          {
            rewrite (eq_bigr (fun i => 0));
              last by intros i DIFF; rewrite /task_scheduled_on SCHED;apply/eqP;rewrite eqb0 eq_sym.
            simpl_sum_const; apply/eqP; rewrite eqb1.
            by unfold task_scheduled_on; rewrite SCHED.
          }
          rewrite mem_filter; apply/andP; split; last by apply FROMTS.
          unfold jldp_can_interfere_with.
          apply DIFFTASK with (t := t); [by auto | by done |].
          by apply/existsP; exists cpu; apply/eqP.
        Qed.

        (* 4) Show that by the induction hypothesis, all jobs released
           before the end of the interval complete by their periods. *)
        Lemma bertogna_edf_all_previous_jobs_complete_by_their_period:
          forall t (j0: JobIn arr_seq),
            t < t1 + R ->
            job_arrival j0 + task_period (job_task j0) <= t ->
            completed job_cost sched j0
               (job_arrival j0 + task_period (job_task j0)).
        Proof.
          rename H_valid_job_parameters into JOBPARAMS,
                 H_rt_bounds_contains_all_tasks into UNZIP,
                 H_job_of_tsk into JOBtsk,
                 H_constrained_deadlines into CONSTR,
                 H_tasks_miss_no_deadlines into NOMISS,
                 H_all_jobs_from_taskset into FROMTS,
                 H_all_previous_jobs_completed_on_time into BEFOREok.
          unfold valid_sporadic_job_with_jitter, valid_sporadic_job in *.
          intros t j0 LEt LE.
          cut ((job_task j0) \in unzip1 rt_bounds = true); last by rewrite UNZIP FROMTS.
          move => /mapP [p IN EQ]; destruct p as [tsk' R0]; simpl in *; subst tsk'.
          apply completion_monotonic with (t0 := job_arrival j0 +
                                        task_jitter (job_task j0) + R0); first by done.
          {
            rewrite -addnA leq_add2l.
            apply leq_trans with (n := task_deadline (job_task j0));
              [by apply NOMISS | by apply CONSTR; rewrite FROMTS].
          }
          apply BEFOREok with (tsk_other := (job_task j0)); try by done.
          apply leq_ltn_trans with (n := t); last first.
          {
            apply leq_trans with (n := t1 + R); first by done.
            rewrite leq_add2r leq_add2l -JOBtsk.
            by specialize (JOBPARAMS j); des.
          }
          apply leq_trans with (n := job_arrival j0 + task_period (job_task j0)); last by done.
          by rewrite -addnA leq_add2l; apply leq_trans with (n := task_deadline (job_task j0));
            [by apply NOMISS | apply CONSTR; rewrite FROMTS].
        Qed.

        (* Let (cardGE delta) be the number of interfering tasks whose interference
           is larger than delta. *)
        Let cardGE (delta: time) := count (fun i => x i >= delta) ts_interf.

        (* 5) If there is at least one of such tasks (e.g., cardGE > 0), then the
           cumulative interference caused by the complementary set of interfering
           tasks fills at least (num_cpus - cardGE) processors. *)
        Lemma bertogna_edf_helper_lemma :
          forall delta,
            0 < cardGE delta < num_cpus ->
            \sum_(i <- ts_interf | x i < delta) x i >= delta * (num_cpus - cardGE delta).
        Proof.
          have COMP := bertogna_edf_all_previous_jobs_complete_by_their_period.
          have INV := bertogna_edf_scheduling_invariant.
          rename H_all_jobs_from_taskset into FROMTS,
                 H_valid_task_parameters into PARAMS,
                 H_job_of_tsk into JOBtsk, H_sporadic_tasks into SPO,
                 H_tsk_R_in_rt_bounds into INbounds,
                 H_all_previous_jobs_completed_on_time into BEFOREok,
                 H_tasks_miss_no_deadlines into NOMISS,
                 H_constrained_deadlines into CONSTR, H_sequential_jobs into SEQ.
          unfold sporadic_task_model in *.
          move => delta /andP [HAS LT].
          rewrite -has_count in HAS.

          set some_interference_A := fun t =>
            has (fun tsk_k => backlogged job_cost job_jitter sched j t &&
                              (x tsk_k >= delta) &&
                              task_is_scheduled job_task sched tsk_k t) ts_interf.
          set total_interference_B := fun t =>
              backlogged job_cost job_jitter sched j t *
              count (fun tsk_k => (x tsk_k < delta) &&
                    task_is_scheduled job_task sched tsk_k t) ts_interf.

          apply leq_trans with ((\sum_(t1 <= t < t1 + R)
                                some_interference_A t) * (num_cpus - cardGE delta)).
          {
            rewrite leq_mul2r; apply/orP; right.
            move: HAS => /hasP HAS; destruct HAS as [tsk_a INa LEa].
            apply leq_trans with (n := x tsk_a); first by apply LEa.
            unfold x, task_interference, some_interference_A.
            apply leq_sum_nat; move => t /andP [GEt LTt] _.
            destruct (backlogged job_cost job_jitter sched j t) eqn:BACK;
              last by rewrite (eq_bigr (fun x => 0)); [by simpl_sum_const | by ins].
            destruct ([exists cpu, task_scheduled_on job_task sched tsk_a cpu t]) eqn:SCHED;
              last first.
            {
              apply negbT in SCHED; rewrite negb_exists in SCHED; move: SCHED => /forallP ALL.
              rewrite (eq_bigr (fun x => 0)); first by simpl_sum_const.
              by intros cpu _; specialize (ALL cpu); apply negbTE in ALL; rewrite ALL.
            }
            move: SCHED => /existsP [cpu SCHED].
            apply leq_trans with (n := 1); last first.
            {
              rewrite lt0b; apply/hasP; exists tsk_a; first by done.
              by rewrite LEa 2!andTb; apply/existsP; exists cpu.
            }
            rewrite (bigD1 cpu) /= // SCHED.
            rewrite (eq_bigr (fun x => 0)); first by simpl_sum_const; rewrite leq_b1.
            intros cpu' DIFF.
            apply/eqP; rewrite eqb0; apply/negP.
            intros SCHED'.
            move: DIFF => /negP DIFF; apply DIFF; apply/eqP.
            unfold task_scheduled_on in *.
            destruct (sched cpu t) as [j1|] eqn:SCHED1; last by done.
            destruct (sched cpu' t) as [j2|] eqn:SCHED2; last by done.
            move: SCHED SCHED' => /eqP JOB /eqP JOB'.
            subst tsk_a; symmetry in JOB'.
            assert (PENDING1: pending job_cost job_jitter sched j1 t).
            {
              apply scheduled_implies_pending; try by done.
              by apply/existsP; exists cpu; apply/eqP.
            }
            assert (PENDING2: pending job_cost job_jitter sched j2 t).
            {
              apply scheduled_implies_pending; try by done.
              by apply/existsP; exists cpu'; apply/eqP.
            }
            assert (BUG: j1 = j2).
            {
              apply platform_at_most_one_pending_job_of_each_task with (task_cost0 := task_cost)
               (job_jitter0 := job_jitter) (task_period0 := task_period) (job_cost0 := job_cost)
               (task_deadline0 := task_deadline) (tsk0 := tsk) (job_task0 := job_task) (sched0 := sched)
               (j0 := j) (t0 := t);
              rewrite ?JOBtsk ?SAMEtsk //; first by apply PARAMS; rewrite -JOBtsk FROMTS.
              by intros j0 tsk0 TSK0 LE; apply (COMP t); rewrite ?TSK0.
            }
            by subst j2; apply SEQ with (j := j1) (t := t).
          }

          apply leq_trans with (\sum_(t1 <= t < t1 + R) total_interference_B t).
          {
            rewrite big_distrl /=.
            apply leq_sum_nat; move => t LEt _.
            unfold some_interference_A, total_interference_B.
            destruct (backlogged job_cost job_jitter sched j t) eqn:BACK;
              [rewrite mul1n /= | by rewrite has_pred0 //].

            destruct (has (fun tsk_k : sporadic_task => (delta <= x tsk_k) &&
                       task_is_scheduled job_task sched tsk_k t) ts_interf) eqn:HAS';
              last by done.
            rewrite mul1n; move: HAS => /hasP [tsk_k INk LEk].
            unfold cardGE.
            apply leq_trans with (n := num_cpus -
                         count (fun i => (x i >= delta) &&
                            task_is_scheduled job_task sched i t) ts_interf).
            {
              apply leq_sub2l.
              rewrite -2!sum1_count big_mkcond /=.
              rewrite [\sum_(_ <- _ | _ <= _)_]big_mkcond /=.
              apply leq_sum; intros i _.
              by destruct (task_is_scheduled job_task sched i t);
                [by rewrite andbT | by rewrite andbF].
            }
            rewrite -count_filter -[count _ ts_interf]count_filter.
            eapply leq_trans with (n := count (predC (fun tsk => delta <= x tsk)) _);
              last by apply eq_leq, eq_in_count; red; ins; rewrite ltnNge.
            rewrite leq_subLR count_predC size_filter.
            by apply leq_trans with (n := count (scheduled_task_other_than_tsk t) ts);
              [by rewrite INV | by rewrite count_filter].
          }
          {
            unfold x at 2, total_interference_B.
            rewrite exchange_big /=; apply leq_sum; intros t _.
            destruct (backlogged job_cost job_jitter sched j t) eqn:BACK; last by ins.
            rewrite mul1n -sum1_count.
            rewrite big_mkcond [\sum_(i <- ts_interf | _ < _) _]big_mkcond /=.
            apply leq_sum_seq; move => tsk_k IN _.
            destruct (x tsk_k < delta); [rewrite andTb | by rewrite andFb].
            destruct (task_is_scheduled job_task sched tsk_k t) eqn:SCHED; last by done.
            move: SCHED => /existsP [cpu SCHED].
            by rewrite (bigD1 cpu) /= // SCHED.
          }
        Qed.

        (* 6) Next, we prove that, for any interval delta, if the sum of per-task
              interference exceeds delta * num_cpus, the same applies for the
              sum of the minimum between the interference and delta. *)
        Lemma bertogna_edf_minimum_exceeds_interference :
          forall delta,
            \sum_(tsk_k <- ts_interf) x tsk_k >= delta * num_cpus ->
               \sum_(tsk_k <- ts_interf) minn (x tsk_k) delta >=
               delta * num_cpus.
        Proof.
          intros delta SUMLESS.
          set more_interf := fun tsk_k => x tsk_k >= delta.
          rewrite [\sum_(_ <- _) minn _ _](bigID more_interf) /=.
          unfold more_interf, minn.
          rewrite [\sum_(_ <- _ | delta <= _)_](eq_bigr (fun i => delta));
            last by intros i COND; rewrite leqNgt in COND; destruct (delta > x i).
          rewrite [\sum_(_ <- _ | ~~_)_](eq_big (fun i => x i < delta)
                                                (fun i => x i));
            [| by red; ins; rewrite ltnNge
             | by intros i COND; rewrite -ltnNge in COND; rewrite COND].

          (* Case 1: cardGE = 0 *)
          destruct (~~ has (fun i => delta <= x i) ts_interf) eqn:HASa.
          {
            rewrite [\sum_(_ <- _ | _ <= _) _]big_hasC; last by apply HASa.
            rewrite big_seq_cond; move: HASa => /hasPn HASa.
            rewrite add0n (eq_bigl (fun i => (i \in ts_interf) && true));
              last by red; intros tsk_k; destruct (tsk_k \in ts_interf) eqn:INk;
                [by rewrite andTb ltnNge; apply HASa | by rewrite andFb].
            by rewrite -big_seq_cond.
          } apply negbFE in HASa.

          (* Case 2: cardGE >= num_cpus *)
          destruct (cardGE delta >= num_cpus) eqn:CARD.
          {
            apply leq_trans with (delta * cardGE delta);
              first by rewrite leq_mul2l; apply/orP; right.
            unfold cardGE; rewrite -sum1_count big_distrr /=.
            rewrite -[\sum_(_ <- _ | _) _]addn0.
            by apply leq_add; [by apply leq_sum; ins; rewrite muln1|by ins].
          } apply negbT in CARD; rewrite -ltnNge in CARD.

          (* Case 3: cardGE < num_cpus *)
          rewrite big_const_seq iter_addn addn0; fold cardGE.
          apply leq_trans with (n := delta * cardGE delta +
                                     delta * (num_cpus - cardGE delta));
            first by rewrite -mulnDr subnKC //; apply ltnW.
          rewrite leq_add2l; apply bertogna_edf_helper_lemma.
          by apply/andP; split; first by rewrite -has_count.
        Qed.

        (* 7) Now, we prove that the Bertogna's interference bound
              is not enough to cover the sum of the "minimum" term over
              all tasks (artifact of the proof by contradiction). *)
        Lemma bertogna_edf_sum_exceeds_total_interference:
          \sum_((tsk_other, R_other) <- rt_bounds | jldp_can_interfere_with tsk tsk_other)
            minn (x tsk_other) (R - task_cost tsk + 1) > I tsk R.
        Proof.
          have GE_COST := bertogna_edf_R_other_ge_cost.
          have EXCEEDS := bertogna_edf_minimum_exceeds_interference.
          have ALLBUSY := bertogna_edf_all_cpus_busy.
          have TOOMUCH := bertogna_edf_too_much_interference.
          rename H_rt_bounds_contains_all_tasks into UNZIP,
            H_response_time_is_fixed_point into REC.
          apply leq_trans with (n := \sum_(tsk_other <- ts_interf) minn (x tsk_other) (R - task_cost tsk + 1));
            last first.
          {
            rewrite (eq_bigr (fun i => minn (x (fst i)) (R - task_cost tsk + 1)));
              last by ins; destruct i.
            move: UNZIP => UNZIP.
            assert (FILTER: filter (jldp_can_interfere_with tsk) (unzip1 rt_bounds) =
                            filter (jldp_can_interfere_with tsk) ts).
              by f_equal.
            unfold ts_interf; rewrite -FILTER; clear FILTER.
            rewrite -[\sum_(_ <- rt_bounds | _)_]big_filter.
            assert (SUBST: [seq i <- rt_bounds
                   | let '(tsk_other, _) := i in
                          jldp_can_interfere_with tsk tsk_other] = [seq i <- rt_bounds
                             | jldp_can_interfere_with tsk (fst i)]).
            {
              by apply eq_filter; red; intro i; destruct i.
            } rewrite SUBST; clear SUBST.
            have MAP := big_map (fun x => fst x) (fun i => true) (fun i => minn (x i) (R - task_cost tsk + 1)).
            by rewrite -MAP; apply eq_leq; f_equal; rewrite filter_map.
          }

          apply ltn_div_trunc with (d := num_cpus); first by apply H_at_least_one_cpu.
          rewrite -(ltn_add2l (task_cost tsk)) -REC; last by done.
          rewrite -addn1 -leq_subLR.
          rewrite -[R + 1 - _]subh1; last by apply GE_COST.
          rewrite leq_divRL; last by apply H_at_least_one_cpu.
          apply EXCEEDS.
          apply leq_trans with (n := X * num_cpus); last by rewrite ALLBUSY.
          by rewrite leq_mul2r; apply/orP; right; apply TOOMUCH.
        Qed.

        (* 8) After concluding that the sum of the minimum exceeds (R - e_i + 1),
              we prove that there exists a tuple (tsk_k, R_k) such that
              min (x_k, R - e_i + 1) > min (W_k, edf_bound, R - e_i + 1). *)
        Lemma bertogna_edf_exists_task_that_exceeds_bound :
          exists tsk_other R_other,
            (tsk_other, R_other) \in rt_bounds /\
            (minn (x tsk_other) (R - task_cost tsk + 1) > interference_bound tsk_other R_other).
        Proof.
          have SUM := bertogna_edf_sum_exceeds_total_interference.
          have BOUND := bertogna_edf_workload_bounds_interference.
          have EDFBOUND := bertogna_edf_specific_bound_holds.
          rename H_rt_bounds_contains_all_tasks into UNZIP.
          assert (HAS: has (fun tup : task_with_response_time =>
                              let (tsk_other, R_other) := tup in
                              (tsk_other \in ts) && jldp_can_interfere_with tsk tsk_other &&
                                (minn (x tsk_other) (R - task_cost tsk + 1)  >
                                interference_bound tsk_other R_other))
                           rt_bounds).
          {
            apply/negP; unfold not; intro NOTHAS.
            move: NOTHAS => /negP /hasPn ALL.
            rewrite -[_ < _]negbK in SUM.
            move: SUM => /negP SUM; apply SUM; rewrite -leqNgt.
            unfold I, total_interference_bound_edf.
            rewrite big_seq_cond [\sum_(_ <- _ | let _ := _ in _)_]big_seq_cond.
            apply leq_sum; move => tsk_k /andP [INBOUNDSk INTERFk]; destruct tsk_k as [tsk_k R_k].
            specialize (ALL (tsk_k, R_k) INBOUNDSk).
            unfold interference_bound_edf; simpl in *.
            rewrite leq_min; apply/andP; split.
            {
              unfold interference_bound; rewrite leq_min; apply/andP; split;
                last by rewrite geq_minr.
              by apply leq_trans with (n := x tsk_k);
                [by rewrite geq_minl | by apply BOUND].
            }
            {
              apply leq_trans with (n := x tsk_k); first by rewrite geq_minl.
              by apply EDFBOUND.
            }
          }
          move: HAS => /hasP HAS; destruct HAS as [[tsk_k R_k] HPk MIN].
          move: MIN => /andP [/andP [INts INTERFk] MINk].
          by exists tsk_k, R_k; repeat split.
        Qed.

      End DerivingContradiction.

    End Lemmas.

    Section MainProof.

      (* Let (tsk, R) be any task to be analyzed, with its response-time bound R. *)
      Variable tsk: sporadic_task.
      Variable R: time.
      Hypothesis H_tsk_R_in_rt_bounds: (tsk, R) \in rt_bounds.

      (* Using the lemmas above, we prove that R bounds the response time of task tsk. *)
      Theorem bertogna_cirinei_response_time_bound_edf :
        response_time_bounded_by tsk (task_jitter tsk + R).
      Proof.
        have EXISTS := bertogna_edf_exists_task_that_exceeds_bound.
        have BASICBOUND := bertogna_edf_workload_bounds_interference.
        have EDFBOUND := bertogna_edf_specific_bound_holds.
        rename H_valid_job_parameters into JOBPARAMS.
        unfold valid_sporadic_job_with_jitter, valid_sporadic_job in *.
        intros j JOBtsk.

        rewrite addnA.
        (* First, rewrite the claim in terms of the *absolute* response-time bound (arrival + R) *)
        remember (job_arrival j + task_jitter tsk + R) as ctime.

        revert H_tsk_R_in_rt_bounds.
        generalize dependent R; generalize dependent tsk; generalize dependent j.

        (* Now, we apply strong induction on the absolute response-time bound. *)
        induction ctime as [ctime IH] using strong_ind.

        intros j tsk' JOBtsk R' EQc INbounds; subst ctime.

        (* First, let's simplify the induction hypothesis. *)
        assert (BEFOREok: forall (j0: JobIn arr_seq) tsk R0,
                                 job_task j0 = tsk ->
                               (tsk, R0) \in rt_bounds ->
                               job_arrival j0 + task_jitter tsk + R0 < job_arrival j + task_jitter tsk' + R' ->
                               service sched j0 (job_arrival j0 + task_jitter tsk + R0) == job_cost j0).
        {
            by ins; apply IH with (tsk := tsk0) (R := R0).
        }
        clear IH.

        (* The proof follows by contradiction. Assume that job j does not complete by its
           response-time bound. By the induction hypothesis, all jobs with absolute
           response-time bound t < (job_arrival j + R) have correct response-time bounds. *)
        destruct (completed job_cost sched j (job_arrival j + job_jitter j + R')) eqn:NOTCOMP.
        {
          apply completion_monotonic with (t := job_arrival j + job_jitter j + R'); try (by done).
          rewrite leq_add2r leq_add2l.
          specialize (JOBPARAMS j); des.
          by rewrite -JOBtsk; apply JOBPARAMS0.
        }
        apply negbT in NOTCOMP; exfalso.

        (* Next, we derive a contradiction using the previous lemmas. *)
        exploit (EXISTS tsk' R' INbounds j JOBtsk NOTCOMP).
        {
          by ins; apply IH with (tsk := tsk_other) (R := R_other).
        }
        intro EX; destruct EX as [tsk_other [R_other [HP LTmin]]].
        unfold interference_bound_edf, interference_bound_generic in LTmin.
        rewrite minnAC in LTmin; apply min_lt_same in LTmin.
        specialize (BASICBOUND tsk' R' j JOBtsk BEFOREok tsk_other R_other HP).
        specialize (EDFBOUND tsk' R' INbounds j JOBtsk BEFOREok tsk_other R_other HP).
        unfold minn in LTmin; clear -LTmin HP BASICBOUND EDFBOUND tsk; desf.
        {
          by apply (leq_ltn_trans BASICBOUND) in LTmin; rewrite ltnn in LTmin.
        }
        {
          by apply (leq_ltn_trans EDFBOUND) in LTmin; rewrite ltnn in LTmin.
        }
      Qed.

    End MainProof.

  End ResponseTimeBound.

End ResponseTimeAnalysisEDFJitter.


Require Import Coq.Strings.String.
Require Import Coq.Lists.List.
Require Import Coq.ZArith.ZArith.
Require Import Crypto.Arithmetic.PrimeFieldTheorems.
Require Import Crypto.Bedrock.Field.Interface.Representation.
Require Import Crypto.Bedrock.Field.Synthesis.New.ComputedOp.
Require Import Crypto.Bedrock.Field.Synthesis.New.WordByWordMontgomery.
Require Import Crypto.Bedrock.Field.Translation.Parameters.Defaults32.
Require Import Crypto.Bedrock.Specs.Field.
Import ListNotations.
Require Import bedrock2.WeakestPreconditionProperties.
Require Import bedrock2.WeakestPrecondition.
Require Import bedrock2.ProgramLogic.
Require Import bedrock2.Map.Separation.
Require Import bedrock2.Map.SeparationLogic.
Require Import bedrock2.Syntax.
Local Open Scope string_scope.
Local Infix "*" := sep : sep_scope.
Delimit Scope sep_scope with sep.
Local Notation function_t := ((String.string * (list String.string * list String.string * Syntax.cmd.cmd))%type).
Local Notation functions_t := (list function_t).
Local Open Scope sep_scope.

(* Parameters for p224 field. *)
Section Field.
  Definition n : nat := 4.
  Definition m : Z := (2^224 - 2^96 + 1)%Z.

  Existing Instances Defaults32.default_parameters
           Defaults32.default_parameters_ok.
  Existing Instances no_select_size split_mul_to split_multiret_to.
  Definition prefix : string := "p224_"%string.

  (* Define p224 field *)
  Instance field_parameters : FieldParameters.
  Proof using Type.
    let M := (eval vm_compute in (Z.to_pos (m))) in
    (* curve 'A' parameter *)
    let a := constr:(F.of_Z M (m - 3)) in
    let prefix := constr:("p224_felem_"%string) in
    eapply
      (field_parameters_prefixed
         M ((a - F.of_Z _ 2) / F.of_Z _ 4)%F prefix).
  Defined.

  Definition to_mont_string := prefix ++ "to_mont".
  Definition from_mont_string := prefix ++ "from_mont".

  (* Call fiat-crypto pipeline on all field operations *)
  Instance p224_ops : @word_by_word_Montgomery_ops from_mont_string to_mont_string _ _ _ _ _ _ _ _ _ _ _ (WordByWordMontgomery.n m machine_wordsize) m.
  Proof using Type. Time constructor; make_computed_op. Defined.

  (**** Translate each field operation into bedrock2 and apply bedrock2 backend
        field pipeline proofs to prove the bedrock2 functions are correct. ****)

        Local Ltac begin_derive_bedrock2_func :=
        lazymatch goal with
        | |- context [spec_of_BinOp bin_mul] => eapply mul_func_correct
        | |- context [spec_of_UnOp un_square] => eapply square_func_correct
        | |- context [spec_of_BinOp bin_add] => eapply add_func_correct
        | |- context [spec_of_BinOp bin_sub] => eapply sub_func_correct
        | |- context [spec_of_UnOp un_opp] => eapply opp_func_correct
        (* | |- context [spec_of_UnOp un_scmula24] => eapply scmula24_func_correct *)
        | |- context [spec_of_from_bytes] => eapply from_bytes_func_correct
        | |- context [spec_of_to_bytes] => eapply to_bytes_func_correct
        end.

      Ltac derive_bedrock2_func op :=
        begin_derive_bedrock2_func;
        (* this goal fills in the evar, so do it first for [abstract] to be happy *)
        try lazymatch goal with
            | |- _ = b2_func _ => vm_compute; reflexivity
            end;
        (* solve all the remaining goals *)
        lazymatch goal with
        | |- _ = @ErrorT.Success ?ErrT unit tt =>
          abstract (vm_cast_no_check (@eq_refl _ (@ErrorT.Success ErrT unit tt)))
        | |- Func.valid_func _ =>
          eapply Func.valid_func_bool_iff;
          abstract vm_cast_no_check (eq_refl true)
        | |- (_ = _)%Z => vm_compute; reflexivity
        end.

  Derive p224_from_bytes
         SuchThat (forall functions,
                      spec_of_from_bytes
                        (field_representation:=field_representation_raw m)
                        (p224_from_bytes :: functions))
         As p224_from_bytes_correct.
  Proof. Time derive_bedrock2_func from_bytes_op. Qed.

  Derive p224_to_bytes
         SuchThat (forall functions,
                      spec_of_to_bytes
                        (field_representation:=field_representation_raw m)
                        (p224_to_bytes :: functions))
         As p224_to_bytes_correct.
  Proof. Time derive_bedrock2_func to_bytes_op. Qed.

  Derive p224_mul
         SuchThat (forall functions,
                      spec_of_BinOp bin_mul
                        (field_representation:=field_representation m)
                        (p224_mul :: functions))
         As p224_mul_correct.
  Proof. Time derive_bedrock2_func mul_op. Qed.

  Derive p224_square
         SuchThat (forall functions,
                      spec_of_UnOp un_square
                        (field_representation:=field_representation m)
                        (p224_square :: functions))
         As p224_square_correct.
  Proof. Time derive_bedrock2_func square_op. Qed.

  Derive p224_add
         SuchThat (forall functions,
                      spec_of_BinOp bin_add
                        (field_representation:=field_representation m)
                        (p224_add :: functions))
         As p224_add_correct.
  Proof. Time derive_bedrock2_func add_op. Qed.

  Derive p224_sub
         SuchThat (forall functions,
                      spec_of_BinOp bin_sub
                        (field_representation:=field_representation m)
                        (p224_sub :: functions))
         As p224_sub_correct.
  Proof. Time derive_bedrock2_func sub_op. Qed.

  (*TODO: adapt derive_bedrock2_func to also derive the remaining functions.*)
  Derive p224_from_mont
         SuchThat (forall functions,
                      spec_of_UnOp un_from_mont
                        (field_representation:=field_representation m)
                        (p224_from_mont :: functions))
         As p224_from_mont_correct.
  Proof.
    eapply (from_mont_func_correct _ _ _ from_mont_string to_mont_string); auto.
        - vm_compute; reflexivity.
        - eapply Func.valid_func_bool_iff. abstract vm_cast_no_check (eq_refl true).
          Unshelve.
            + auto.
            + auto.
  Qed.

  Derive p224_to_mont
         SuchThat (forall functions,
                      spec_of_UnOp un_to_mont
                        (field_representation:=field_representation m)
                        (p224_to_mont :: functions))
         As to_from_mont_correct.
  Proof.
    eapply (to_mont_func_correct _ _ _ from_mont_string to_mont_string); auto.
        - vm_compute; reflexivity.
        - eapply Func.valid_func_bool_iff. abstract vm_cast_no_check (eq_refl true).
          Unshelve. all: auto.
     Qed.

  Derive p224_select_znz
           SuchThat (forall functions,
                      spec_of_selectznz
                        (field_representation:=field_representation m)
                        (p224_select_znz :: functions))
         As select_znz_correct.
  Proof.
    eapply select_znz_func_correct; auto.
        - vm_compute; reflexivity.
        - eapply Func.valid_func_bool_iff. abstract vm_cast_no_check (eq_refl true).
     Qed.
End Field.


Require Import HoTT.Types.Universe.
Require Import
  HoTT.Classes.interfaces.abstract_algebra
  HoTT.Classes.interfaces.naturals
  HoTT.Classes.interfaces.orders
  HoTT.Classes.theory.naturals
  HoTT.Classes.theory.rings
  HoTT.Classes.implementations.peano_naturals.
Require Export
  HoTT.Classes.orders.semirings.

Generalizable Variables N R f.

Section Univ.
Context `{Funext} `{Univalence}.

(*
We axiomatize the order on the naturals and the integers as a non trivial
pseudo semiring order that satisfies the biinduction principle. We prove
some results that hold for the order on the naturals and the integers.
In particular, we show that given another non trivial pseudo semiring order
(that not necessarily has to satisfy the biinduction principle, for example
the rationals or the reals), any morphism to it is an order embedding.
*)
Lemma to_semiring_nonneg `{FullPseudoSemiRingOrder N}
  `{!NaturalsToSemiRing N} `{!Naturals N} `{FullPseudoSemiRingOrder R}
  `{!IsSemiRing R}
  `{!IsSemiRingPreserving (f : N -> R)} n : 0 ≤ f n.
Proof.
revert n. apply naturals.induction.
- rewrite (preserves_0 (f:=f)).
  reflexivity.
- intros n E.
  rewrite (preserves_plus (f:=f)), (preserves_1 (f:=f)).
  apply nonneg_plus_compat.
  + solve_propholds.
  + trivial.
Qed.

Section nat_int_order.
Context `{Naturals N} `{Apart N} `{Le N} `{Lt N} `{!FullPseudoSemiRingOrder le lt}
  `{FullPseudoSemiRingOrder R} `{!IsSemiRing R}
  `{!Biinduction R} `{PropHolds (1 ≶ 0)}.

(* Add Ring R : (stdlib_semiring_theory R). *)

Lemma nat_int_to_semiring : forall x : R, exists z, x = naturals_to_semiring N R z |_|
  (x + naturals_to_semiring N R z)%mc = 0.
Proof.
apply biinduction.
- exists 0.
  left. symmetry. apply preserves_0.
- intros. split;intros E.
  + destruct E as [z [E|E]].
    * exists (1+z).
      left. rewrite E.
      rewrite (preserves_plus (f:=naturals_to_semiring N R)),
      (preserves_1 (f:=naturals_to_semiring N R)). reflexivity.
    * destruct (naturals.case z) as [Ez|[z' Ez]].
      ** rewrite Ez in *.
         rewrite (preserves_0 (A:=N)),plus_0_r in E.
         rewrite E. exists 1. left.
         rewrite (preserves_1 (A:=N)),plus_0_r. reflexivity.
      ** rewrite Ez in *;clear z Ez.
         exists z';right.
         path_via (n + naturals_to_semiring N R (1 + z')).
         clear E. rewrite (preserves_plus (A:=N)),(preserves_1 (A:=N)).
         rewrite plus_assoc,(plus_comm n);reflexivity.
  + destruct E as [z [E|E]].
    * destruct (naturals.case z) as [Ez|[z' Ez]];rewrite Ez in *;clear z Ez.
      ** exists 1;right.
         rewrite (preserves_1 (A:=N)),plus_comm,E.
         apply preserves_0.
      ** exists z';left.
         rewrite (preserves_plus (A:=N)),(preserves_1 (A:=N)) in E.
         apply (left_cancellation plus 1). trivial.
    * exists (1+z).
      right. rewrite (preserves_plus (A:=N)), (preserves_1 (A:=N)),<-E.
      rewrite plus_assoc,(plus_comm n);reflexivity.
Qed.

Lemma nat_int_nonneg_decompose x : 0 ≤ x -> exists z, x = naturals_to_semiring N R z.
Proof.
destruct (nat_int_to_semiring x) as [z [Ez1 | Ez2]].
- exists z. trivial.
- intros E. exists 0. rewrite (preserves_0 (A:=N)).
  apply (antisymmetry (≤)); trivial.
  rewrite <-Ez2. apply nonneg_plus_le_compat_r.
  apply to_semiring_nonneg.
Qed.

Lemma nat_int_le_plus x y : x ≤ y <-> exists z, y = x + naturals_to_semiring N R z.
Proof.
split.
- intros E. destruct (decompose_le E) as [z [Ez1 Ez2]].
  destruct (nat_int_nonneg_decompose _ Ez1) as [u Eu].
  exists u. rewrite <-Eu. trivial.
- intros [z Ez]. rewrite Ez.
  apply nonneg_plus_le_compat_r, to_semiring_nonneg.
Qed.

Lemma nat_int_lt_plus x y : x < y <-> exists z, y = x + 1 + naturals_to_semiring N R z.
Proof.
split.
- intros E.
  destruct ((fst (nat_int_le_plus x y) (lt_le _ _ E))) as [z0 Ez].
  destruct (naturals.case z0) as [E1|[z E1]];rewrite E1 in *;clear z0 E1.
  + rewrite preserves_0, plus_0_r in Ez.
    destruct (lt_ne_flip x y);trivial.
  + exists z.
    rewrite (preserves_plus (A:=N)), preserves_1, plus_assoc in Ez.
    trivial.
- intros [z Ez]. rewrite Ez.
  apply nonneg_plus_lt_compat_r.
  + apply to_semiring_nonneg.
  + apply pos_plus_lt_compat_r; solve_propholds.
Qed.

Lemma lt_iff_plus_1_le x y : x < y <-> x + 1 ≤ y.
Proof.
etransitivity.
- apply nat_int_lt_plus.
- apply symmetry,nat_int_le_plus.
Qed.

Lemma lt_iff_S_le x y : x < y <-> 1 + x ≤ y.
Proof.
rewrite plus_comm. apply lt_iff_plus_1_le.
Qed.

Lemma pos_ge_1 x : 0 < x <-> 1 ≤ x.
Proof.
split; intros E.
- rewrite <-(plus_0_l 1). apply lt_iff_plus_1_le. trivial.
- apply lt_le_trans with 1; [solve_propholds | trivial].
Qed.

Lemma le_iff_lt_plus_1 x y : x ≤ y <-> x < y + 1.
Proof.
split; intros E.
- apply lt_iff_plus_1_le. apply (order_preserving (+1)). trivial.
- apply (order_reflecting (+1)), lt_iff_plus_1_le. trivial.
Qed.

Lemma le_iff_lt_S x y : x ≤ y <-> x < 1 + y.
Proof. rewrite plus_comm. apply le_iff_lt_plus_1. Qed.

Section another_semiring.
  Context `{FullPseudoSemiRingOrder R2} `{!IsSemiRing R2}
    `{PropHolds ((1 : R2) ≶ 0)}
    `{!IsSemiRingPreserving (f : R -> R2)}.

  Instance: OrderPreserving f.
  Proof.
  repeat (split; try apply _).
  intros x y E. apply nat_int_le_plus in E. destruct E as [z E].
  rewrite E, (preserves_plus (f:=f)), (naturals.to_semiring_twice f _ _).
  apply nonneg_plus_le_compat_r. apply to_semiring_nonneg.
  Qed.

  Global Instance: StrictlyOrderPreserving f | 50.
  Proof.
  repeat (split; try apply _).
  intros x y E. apply nat_int_lt_plus in E. destruct E as [z E].
  rewrite E, !(preserves_plus (f:=f)), preserves_1,
  (naturals.to_semiring_twice f _ _).
  apply nonneg_plus_lt_compat_r.
  - apply to_semiring_nonneg.
  - apply pos_plus_lt_compat_r; solve_propholds.
  Qed.

  Global Instance nat_morphism_order_embedding : OrderEmbedding f | 50.
  Proof. split; try apply _. apply full_pseudo_order_reflecting. Qed.
End another_semiring.
End nat_int_order.
End Univ.


Require Import
        Fiat.Computation
        Fiat.Narcissus.Common.Specs
        Fiat.Narcissus.Common.Notations
        Fiat.Narcissus.Common.Compose.

Definition composeIf E B
           (monoid : Monoid B)
           (iComp : Comp bool)
           (formatT : E -> Comp (B * E))
           (formatE : E -> Comp (B * E))
           (e : E)
  := b <- iComp;
       If b Then formatT e
          Else formatE e.

Notation "'Either' t 'Or' e " :=
  (composeIf _ _ _ { _ : bool | True} t e) : format_scope.

Lemma composeIf_format_correct
      {A B}
      {cache : Cache}
      {P  : CacheDecode -> Prop}
      {P_invT P_invE : (CacheDecode -> Prop) -> Prop}
      (P_inv_pf : cache_inv_Property P (fun P => P_invT P /\ P_invE P))
      (monoid : Monoid B)
      (predicate : A -> Prop)
      (predicate_rest : A -> B -> Prop)
      (ICompb : B -> bool)
      (formatT : A -> CacheFormat -> Comp (B * CacheFormat))
      (decodeT : B -> CacheDecode -> option (A * B * CacheDecode))
      (formatE : A -> CacheFormat -> Comp (B * CacheFormat))
      (decodeE : B -> CacheDecode -> option (A * B * CacheDecode))
      (decodeT_pf :
         cache_inv_Property P P_invT
         -> CorrectDecoder
              monoid predicate predicate_rest
              formatT decodeT P)
      (decodeE_pf :
         cache_inv_Property P P_invE
         -> CorrectDecoder
              monoid predicate predicate_rest
              formatE decodeE P)
      (ICompb_OKT : forall data bin env xenv ext,
          predicate data
          -> formatT data env ↝ (bin, xenv)
          -> ICompb (mappend bin ext) = true)
      (ICompb_OKE : forall data bin env xenv ext,
          predicate data
          -> formatE data env ↝ (bin, xenv)
          -> ICompb (mappend bin ext) = false)
  : CorrectDecoder
      monoid
      (fun a => predicate a)
      predicate_rest
      (fun (data : A) =>
         composeIf _ _ _ {b : bool | True }
                   (formatT data)
                   (formatE data)
      )%comp
      (fun (b : B) (env : CacheDecode) =>
         If ICompb b Then
            decodeT b env
            Else
            decodeE b env
      ) P.
Proof.
  unfold cache_inv_Property in *; split.
  { intros env env' xenv data bin ext ? env_pm pred_pm pred_pm_rest com_pf.
    unfold composeIf, Bind2 in com_pf; computes_to_inv; destruct v;
      simpl in com_pf'; computes_to_inv.
    - erewrite ICompb_OKT; eauto.
      simpl; eapply decodeT_pf; intuition eauto.
    - erewrite ICompb_OKE; eauto.
      simpl; eapply decodeE_pf; intuition eauto.
  }
  { intros.
    destruct (ICompb bin) eqn : IComp_v ; simpl in *.
    - eapply decodeT_pf in H1; intuition eauto.
      destruct_ex; intuition; eexists; eexists;
        unfold composeIf; intuition eauto.
      refine pick val true; eauto.
    - eapply decodeE_pf in H1; intuition eauto.
      destruct_ex; intuition; eexists; eexists;
        unfold composeIf; intuition eauto.
      refine pick val false; eauto. }
Qed.

Definition composeIf' E B
           (monoid : Monoid B)
           (format1 : E -> Comp (B * E))
           (format2 : E -> Comp (B * E))
           (iComp : Comp bool)
           (formatT : E -> Comp (B * E))
           (formatE : E -> Comp (B * E))
  :=
    (fun e0 =>
         b <- iComp;
           If b Then
              `(p, e1) <- format1 e0;
            `(q, e2) <- formatT e1;
            ret (mappend p q, e2)
                Else (`(p, e1) <- format2 e0;
                      `(q, e2) <- formatE e1;
                      ret (mappend p q, e2))
    )%comp.

Lemma composeIf'_format_correct
      {A A' B}
      {cache : Cache}
      {P  : CacheDecode -> Prop}
      {P_inv1 P_invT P_invE : (CacheDecode -> Prop) -> Prop}
      (P_inv_pf : cache_inv_Property P (fun P => P_inv1 P /\ P_invT P /\ P_invE P))
      (monoid : Monoid B)
      (projectT : A -> A')
      (projectE : A -> A')
      (predicate : A -> Prop)
      (predicate_rest : A' -> B -> Prop)
      (predicate_rest' : A -> B -> Prop)
      (predicate' : A' -> Prop)
      (format1 : A' -> CacheFormat -> Comp (B * CacheFormat))
      (decode1 : B -> CacheDecode -> option (A' * B * CacheDecode))
      (ICompb : A' -> bool)
      (formatT : A -> CacheFormat -> Comp (B * CacheFormat))
      (decodeT : A' -> B -> CacheDecode -> option (A * B * CacheDecode))
      (formatE : A -> CacheFormat -> Comp (B * CacheFormat))
      (decodeE : A' -> B -> CacheDecode -> option (A * B * CacheDecode))
      (decode1_pf :
         cache_inv_Property P P_inv1
         -> CorrectDecoder
              monoid predicate' predicate_rest
              format1 decode1 P)
      (decodeT_pf : forall proj,
          ICompb proj = true ->
          predicate' proj ->
          cache_inv_Property P P_invT ->
          CorrectDecoder
            monoid
            (fun data => predicate data /\ projectT data = proj)
            predicate_rest'
            formatT
            (decodeT proj) P)
      (decodeE_pf : forall proj,
          ICompb proj = false ->
          predicate' proj ->
          cache_inv_Property P P_invE ->
          CorrectDecoder
            monoid
            (fun data => predicate data /\ projectE data = proj)
            predicate_rest'
            formatE
            (decodeE proj) P)
      (predicate_rest_implT : forall a' b b'',
          (ICompb a' = true /\
           exists a ce ce' ce'' b' b'',
             computes_to (format1 a' ce) (b', ce')
             /\ projectT a = a'
             /\ predicate a
             /\ computes_to (formatT a ce') (b'', ce'')
             /\ predicate_rest' a b)
          -> predicate_rest a' (mappend b'' b))
      (predicate_rest_implE : forall a' b b'',
          (ICompb a' = false /\
           exists a ce ce' ce'' b',
             computes_to (format1 a' ce) (b', ce')
             /\ projectE a = a'
             /\ predicate a
             /\ computes_to (formatE a ce') (b'', ce'')
             /\ predicate_rest' a b)
          -> predicate_rest a' (mappend b'' b))
      (pred_pf : forall data, predicate data -> predicate' (projectT data))
      (pred_pf' : forall data, predicate data -> predicate' (projectE data))
      (ICombT_OK : forall data, ICompb (projectT data) = true)
      (ICombE_OK : forall data, ICompb (projectE data) = false)
  : CorrectDecoder
      monoid
      (fun a => predicate a)
      predicate_rest'
      (fun (data : A) (ctx : CacheFormat) =>
         composeIf' _ _ _ (format1 (projectT data))
                   (format1 (projectE data)) {b : bool | True } (formatT data) (formatE data)  ctx
      )%comp
      (fun (bin : B) (env : CacheDecode) =>
         `(proj, rest, env') <- decode1 bin env;
           If ICompb proj Then
              decodeT proj rest env'
              Else
              decodeE proj rest env'
      ) P.
Proof.
  unfold cache_inv_Property in *; split.
  { intros env env' xenv data bin ext ? env_pm pred_pm pred_pm_rest com_pf.
    unfold composeIf', Bind2 in com_pf; computes_to_inv; destruct v;
      simpl in com_pf'; computes_to_inv; destruct v; destruct v0;
        simpl in com_pf'', com_pf'''.
    - injections.
      destruct (fun H => proj1 (decode1_pf (proj1 P_inv_pf)) _ _ _ _ _ (mappend b0 ext) env_OK env_pm (pred_pf _ pred_pm) H com_pf'); intuition; simpl in *; injections.
      eapply predicate_rest_implT; repeat eexists; intuition eauto.
      destruct (fun H' => proj1 (decodeT_pf (projectT data) (ICombT_OK data) (pred_pf _ pred_pm)
                                            H)
                                _ _ _ _ _ ext H5 H1 (conj pred_pm (eq_refl _)) H' com_pf'');
        intuition; simpl in *; injections.
      setoid_rewrite <- mappend_assoc; rewrite H2.
      intuition; simpl in *; injections.
      rewrite ICombT_OK, H7; simpl; eauto.
    - injections.
      destruct (fun H' => proj1 (decode1_pf (proj1 P_inv_pf)) _ _ _ _ _ (mappend b0 ext) env_OK env_pm (pred_pf' _ pred_pm) H' com_pf'); intuition; simpl in *; injections.
      eapply predicate_rest_implE; intuition; repeat eexists; intuition eauto.
      destruct (fun H' => proj1 (decodeE_pf (projectE data) (ICombE_OK data) (pred_pf' _ pred_pm)
                                            H4)
                                _ _ _ _ _ ext H5 H1 (conj pred_pm (eq_refl _)) H' com_pf'');
        intuition; simpl in *; injections.
      setoid_rewrite <- mappend_assoc; rewrite H2.
      intuition; simpl in *; injections.
      rewrite ICombE_OK, H7; simpl; eauto.
  }
  { intros.
    destruct (decode1 bin env') as [ [ [? ?] ? ] | ] eqn : ? ;
      simpl in *; try discriminate.
    destruct (ICompb a) eqn: ?; simpl in *.
    - eapply (proj2 (decode1_pf (proj1 P_inv_pf))) in Heqo; eauto;
        destruct Heqo; destruct_ex; intuition;
          eapply (proj2 (decodeT_pf a Heqb0 H7 H3)) in H1; eauto;
            destruct H1; destruct_ex; intuition; subst.
      eexists; eexists; repeat split.
      unfold composeIf'; refine pick val true.
      repeat computes_to_econstructor; eauto.
      eauto.
      simpl; rewrite mappend_assoc; reflexivity.
      eassumption.
      eassumption.
    - eapply (proj2 (decode1_pf (proj1 P_inv_pf))) in Heqo; eauto;
        destruct Heqo; destruct_ex; intuition;
          eapply (proj2 (decodeE_pf a Heqb0 H7 H8)) in H1; eauto;
            destruct H1; destruct_ex; intuition; subst.
      eexists; eexists; repeat split.
      unfold composeIf'; refine pick val false.
      repeat computes_to_econstructor; eauto.
      eauto.
      simpl; repeat computes_to_econstructor; eauto.
      simpl; rewrite mappend_assoc; reflexivity.
      eassumption.
      eassumption.
  }
Qed.


Require Export prosa.model.schedule.priority_driven.
Require Export prosa.analysis.facts.busy_interval.busy_interval.
Require Import prosa.analysis.abstract.ideal_jlfp_rta.

(** Throughout this file, we assume ideal uni-processor schedules. *)
Require Import prosa.model.processor.ideal.

(** Throughout this file, we assume the basic (i.e., Liu & Layland) readiness model. *)
Require Import prosa.model.readiness.basic.

(** * Abstract RTA for FP-schedulers with Bounded Priority Inversion *)
(** In this module we instantiate the Abstract Response-Time analysis
    (aRTA) to FP-schedulers for ideal uni-processor model of
    real-time tasks with arbitrary arrival models. *)

(** Given FP priority policy and an ideal uni-processor scheduler
    model, we can explicitly specify [interference],
    [interfering_workload], and [interference_bound_function]. In this
    settings, we can define natural notions of service, workload, busy
    interval, etc. The important feature of this instantiation is that
    we can induce the meaningful notion of priority
    inversion. However, we do not specify the exact cause of priority
    inversion (as there may be different reasons for this, like
    execution of a non-preemptive segment or blocking due to resource
    locking). We only assume that that a priority inversion is
    bounded. *)
Section AbstractRTAforFPwithArrivalCurves.

  (** Consider any type of tasks ... *)
  Context {Task : TaskType}.
  Context `{TaskCost Task}.
  Context `{TaskRunToCompletionThreshold Task}.

  (**  ... and any type of jobs associated with these tasks. *)
  Context {Job : JobType}.
  Context `{JobTask Job Task}.
  Context `{JobArrival Job}.
  Context `{JobCost Job}.
  Context `{JobPreemptable Job}.

  (** Consider any arrival sequence with consistent, non-duplicate arrivals. *)
  Variable arr_seq : arrival_sequence Job.
  Hypothesis H_arrival_times_are_consistent : consistent_arrival_times arr_seq.
  Hypothesis H_arr_seq_is_a_set : arrival_sequence_uniq arr_seq.

  (** Next, consider any ideal uniprocessor schedule of this arrival sequence ... *)
  Variable sched : schedule (ideal.processor_state Job).
  Hypothesis H_jobs_come_from_arrival_sequence:
    jobs_come_from_arrival_sequence sched arr_seq.

  (** ... where jobs do not execute before their arrival or after completion. *)
  Hypothesis H_jobs_must_arrive_to_execute : jobs_must_arrive_to_execute sched.
  Hypothesis H_completed_jobs_dont_execute : completed_jobs_dont_execute sched.

  (** Note that we differentiate between abstract and
     classical notions of work conserving schedule. *)
  Let work_conserving_ab := definitions.work_conserving arr_seq sched.
  Let work_conserving_cl := work_conserving.work_conserving arr_seq sched.

  (** We assume that the schedule is a work-conserving schedule
     in the _classical_ sense, and later prove that the hypothesis
     about abstract work-conservation also holds. *)
  Hypothesis H_work_conserving : work_conserving_cl.

  (** Assume we have sequential tasks, i.e, jobs from the
     same task execute in the order of their arrival. *)
  Hypothesis H_sequential_tasks : sequential_tasks sched.

  (** Assume that a job cost cannot be larger than a task cost. *)
  Hypothesis H_valid_job_cost:
    arrivals_have_valid_job_costs arr_seq.

  (** Consider an arbitrary task set ts. *)
  Variable ts : list Task.

  (** Next, we assume that all jobs come from the task set. *)
  Hypothesis H_all_jobs_from_taskset : all_jobs_from_taskset arr_seq ts.

  (** Let max_arrivals be a family of valid arrival curves, i.e., for any task [tsk] in ts
     [max_arrival tsk] is (1) an arrival bound of [tsk], and (2) it is a monotonic function
     that equals 0 for the empty interval delta = 0. *)
  Context `{MaxArrivals Task}.
  Hypothesis H_valid_arrival_curve : valid_taskset_arrival_curve ts max_arrivals.
  Hypothesis H_is_arrival_curve : taskset_respects_max_arrivals arr_seq ts.

  (** Let [tsk] be any task in ts that is to be analyzed. *)
  Variable tsk : Task.
  Hypothesis H_tsk_in_ts : tsk \in ts.

  (** Consider a valid preemption model... *)
  Hypothesis H_valid_preemption_model:
    valid_preemption_model arr_seq sched.

  (** ...and a valid task run-to-completion threshold function. That is,
     [task_run_to_completion_threshold tsk] is (1) no bigger than [tsk]'s
     cost, (2) for any job of task [tsk] job_run_to_completion_threshold
     is bounded by task_run_to_completion_threshold. *)
  Hypothesis H_valid_run_to_completion_threshold:
    valid_task_run_to_completion_threshold arr_seq tsk.

  (** Consider an FP policy that indicates a higher-or-equal priority relation,
     and assume that the relation is reflexive. Note that we do not relate
     the FP policy with the scheduler. However, we define functions for
     Interference and Interfering Workload that actively use the concept of
     priorities. We require the FP policy to be reflexive, so a job cannot
     cause lower-priority interference (i.e. priority inversion) to itself. *)
  Context `{FP_policy Task}.
  Hypothesis H_priority_is_reflexive : reflexive_priorities.

  (** For clarity, let's define some local names. *)
  Let job_pending_at := pending sched.
  Let job_scheduled_at := scheduled_at sched.
  Let job_completed_by := completed_by sched.
  Let job_backlogged_at := backlogged sched.
  Let response_time_bounded_by := task_response_time_bound arr_seq sched.

  (** We introduce [task_rbf] as an abbreviation of the task request bound function,
     which is defined as [task_cost(tsk) × max_arrivals(tsk,Δ)]. *)
  Let task_rbf := task_request_bound_function tsk.

  (** Using the sum of individual request bound functions, we define the request bound
     function of all tasks with higher-or-equal priority (with respect to [tsk]). *)
  Let total_hep_rbf := total_hep_request_bound_function_FP ts tsk.

  (** Similarly, we define the request bound function of all tasks other
     than [tsk] with higher-or-equal priority (with respect to [tsk]). *)
  Let total_ohep_rbf :=
    total_ohep_request_bound_function_FP ts tsk.

  (** Assume that there exists a constant priority_inversion_bound that bounds
     the length of any priority inversion experienced by any job of [tsk].
     Since we analyze only task [tsk], we ignore the lengths of priority
     inversions incurred by any other tasks. *)
  Variable priority_inversion_bound : duration.
  Hypothesis H_priority_inversion_is_bounded:
    priority_inversion_is_bounded_by
      arr_seq sched tsk priority_inversion_bound.

  (** Let L be any positive fixed point of the busy interval recurrence. *)
  Variable L : duration.
  Hypothesis H_L_positive : L > 0.
  Hypothesis H_fixed_point : L = priority_inversion_bound + total_hep_rbf L.

  (** To reduce the time complexity of the analysis, recall the notion of search space.
     Intuitively, this corresponds to all "interesting" arrival offsets that the job under
     analysis might have with regard to the beginning of its busy-window. *)
  Definition is_in_search_space A := (A < L) && (task_rbf A != task_rbf (A + ε)).

  (** Let R be a value that upper-bounds the solution of each response-time recurrence,
     i.e., for any relative arrival time A in the search space, there exists a corresponding
     solution F such that [F + (task cost - task lock-in service) <= R]. *)
  Variable R : duration.
  Hypothesis H_R_is_maximum :
    forall (A : duration),
      is_in_search_space A ->
      exists (F : duration),
        A + F = priority_inversion_bound
                + (task_rbf (A + ε) - (task_cost tsk - task_run_to_completion_threshold tsk))
                + total_ohep_rbf (A + F) /\
        F + (task_cost tsk - task_run_to_completion_threshold tsk) <= R.

  (** Instantiation of Interference *)
  (** We say that job j incurs interference at time t iff it cannot execute due to
     a higher-or-equal-priority job being scheduled, or if it incurs a priority inversion. *)
  Let interference (j : Job) (t : instant) :=
    ideal_jlfp_rta.interference sched j t.

  (** Instantiation of Interfering Workload *)
  (** The interfering workload, in turn, is defined as the sum of the
      priority inversion function and interfering workload of jobs
      with higher or equal priority. *)
  Let interfering_workload (j : Job) (t : instant) :=
    ideal_jlfp_rta.interfering_workload arr_seq sched j t.

  (** Finally, we define the interference bound function as the sum of the priority
      interference bound and the higher-or-equal-priority workload. *)
  Let IBF (R : duration) := priority_inversion_bound + total_ohep_rbf R.

  (** ** Filling Out Hypotheses Of Abstract RTA Theorem *)
  (** In this section we prove that all preconditions necessary to use the abstract theorem are satisfied. *)
  Section FillingOutHypothesesOfAbstractRTATheorem.

    (** First, we prove that in the instantiation of interference and interfering workload,
       we really take into account everything that can interfere with [tsk]'s jobs, and thus,
       the scheduler satisfies the abstract notion of work conserving schedule. *)
    Lemma instantiated_i_and_w_are_consistent_with_schedule:
      work_conserving_ab tsk interference interfering_workload.
    Proof.
      intros j t1 t2 t ARR TSK POS BUSY NEQ; split; intros HYP.
      - move: HYP => /negP.
        rewrite negb_or /is_priority_inversion /is_priority_inversion
                /is_interference_from_another_hep_job.
        move => /andP [HYP1 HYP2].
        case SCHED: (sched t) => [s | ].
        + rewrite SCHED in HYP1, HYP2.
          move: HYP1 HYP2.
          rewrite !Bool.negb_involutive negb_and Bool.negb_involutive.
          move => HYP1 /orP [/negP HYP2| /eqP HYP2].
          * by exfalso.
          * by subst s; rewrite scheduled_at_def //; apply eqprop_to_eqbool.
        + exfalso; clear HYP1 HYP2.
          eapply instantiated_busy_interval_equivalent_edf_busy_interval in BUSY; eauto with basic_facts.
            by move: BUSY => [PREF _]; eapply not_quiet_implies_not_idle;
                              eauto 2 using eqprop_to_eqbool.
      - move: (HYP); rewrite scheduled_at_def; move => /eqP HYP2; apply/negP.
        rewrite /interference /ideal_jlfp_rta.interference /is_priority_inversion
                  /is_interference_from_another_hep_job HYP2 negb_or.
         apply/andP; split.
         + rewrite Bool.negb_involutive; eauto 2.
             by eapply H_priority_is_reflexive with (t := 0).
         + by rewrite negb_and Bool.negb_involutive; apply/orP; right.
    Qed.

    (** Next, we prove that the interference and interfering workload
       functions are consistent with sequential tasks. *)
    Lemma instantiated_interference_and_workload_consistent_with_sequential_tasks:
      interference_and_workload_consistent_with_sequential_tasks
        arr_seq sched tsk interference interfering_workload.
    Proof.
      intros j t1 t2 ARR TSK POS BUSY.
      eapply instantiated_busy_interval_equivalent_edf_busy_interval in BUSY; eauto with basic_facts.
      eapply all_jobs_have_completed_equiv_workload_eq_service; eauto 2; intros s ARRs TSKs.
      move: (BUSY) => [[_ [QT _]] _].
      apply QT.
      - by apply in_arrivals_implies_arrived in ARRs.
      - move: TSKs => /eqP TSKs.
        rewrite /hep_job /FP_to_JLFP TSK -TSKs; eauto 2.
          by eapply (H_priority_is_reflexive 0); eauto.
      - by eapply in_arrivals_implies_arrived_before; eauto 2.
    Qed.

    (** Recall that L is assumed to be a fixed point of the busy interval recurrence. Thanks to
       this fact, we can prove that every busy interval (according to the concrete definition)
       is bounded. In addition, we know that the conventional concept of busy interval and the
       one obtained from the abstract definition (with the interference and interfering
       workload) coincide. Thus, it follows that any busy interval (in the abstract sense)
       is bounded. *)
    Lemma instantiated_busy_intervals_are_bounded:
      busy_intervals_are_bounded_by arr_seq sched tsk interference interfering_workload L.
    Proof.
      intros j ARR TSK POS.
      edestruct (exists_busy_interval) with (delta := L) as [t1 [t2 [T1 [T2 GGG]]]]; eauto 2.
      { by intros; rewrite {2}H_fixed_point leq_add //; apply total_workload_le_total_rbf'. }
      exists t1, t2; split; first by done.
      split.
      - by done.
      - by eapply instantiated_busy_interval_equivalent_edf_busy_interval; eauto 2 with basic_facts.
    Qed.

    (** Next, we prove that IBF is indeed an interference bound.

       Recall that in module abstract_seq_RTA hypothesis task_interference_is_bounded_by expects
       to receive a function that maps some task t, the relative arrival time of a job j of task t,
       and the length of the interval to the maximum amount of interference (for more details see
       files limited.abstract_RTA.definitions and limited.abstract_RTA.abstract_seq_rta).

       However, in this module we analyze only one task -- [tsk], therefore it is “hard-coded”
       inside the interference bound function IBF. Moreover, in case of a model with fixed
       priorities, interference that some job j incurs from higher-or-equal priority jobs does not
       depend on the relative arrival time of job j. Therefore, in order for the IBF signature to
       match the required signature in module abstract_seq_RTA, we wrap the IBF function in a
       function that accepts, but simply ignores, the task and the relative arrival time. *)
    Lemma instantiated_task_interference_is_bounded:
      task_interference_is_bounded_by
        arr_seq sched tsk interference interfering_workload (fun t A R => IBF R).
    Proof.
      intros ? ? ? ? ARR TSK ? NCOMPL BUSY; simpl.
      move: (posnP (@job_cost _ H3 j)) => [ZERO|POS].
      { by exfalso; rewrite /completed_by ZERO in  NCOMPL. }
      eapply instantiated_busy_interval_equivalent_edf_busy_interval in BUSY; eauto 2 with basic_facts.
      rewrite /interference; erewrite cumulative_task_interference_split; eauto 2 with basic_facts; last first.
      { move: BUSY => [[_ [_ [_ /andP [GE LT]]]] _].
          by eapply arrived_between_implies_in_arrivals; eauto 2. }
      unfold IBF, interference.
      rewrite leq_add; try done.
      { move: (H_priority_inversion_is_bounded j ARR TSK) => BOUND.
        apply leq_trans with (cumulative_priority_inversion sched j t1 (t1 + R0)); first by done.
        apply leq_trans with (cumulative_priority_inversion sched j t1 t2); last first.
        { by apply BOUND; move: BUSY => [PREF QT2]. }
        rewrite [X in _ <= X](@big_cat_nat _ _ _ (t1 + R0)) //=.
        - by rewrite leq_addr.
        - by rewrite leq_addr.
        - by rewrite ltnW.
      }
      { erewrite instantiated_cumulative_interference_of_hep_tasks_equal_total_interference_of_hep_tasks;
          eauto 2; last by unfold quiet_time; move: BUSY => [[_ [T1 T2]] _].
        apply leq_trans with
            (workload_of_jobs
               (fun jhp : Job => (FP_to_JLFP _ _) jhp j && (job_task jhp != job_task j))
               (arrivals_between arr_seq t1 (t1 + R0))
            ).
        { by apply service_of_jobs_le_workload; last apply ideal_proc_model_provides_unit_service.  }
        { rewrite  /workload_of_jobs /total_ohep_rbf /total_ohep_request_bound_function_FP.
            by rewrite -TSK; apply total_workload_le_total_rbf.
        }
      }
    Qed.

    (** Finally, we show that there exists a solution for the response-time recurrence. *)
    Section SolutionOfResponseTimeRecurrenceExists.

      (** Consider any job [j] of [tsk]. *)
      Variable j : Job.
      Hypothesis H_j_arrives : arrives_in arr_seq j.
      Hypothesis H_job_of_tsk : job_task j = tsk.
      Hypothesis H_job_cost_positive: job_cost_positive j.

      (** Given any job j of task [tsk] that arrives exactly A units after the beginning of
         the busy interval, the bound of the total interference incurred by j within an
         interval of length Δ is equal to [task_rbf (A + ε) - task_cost tsk + IBF Δ]. *)
      Let total_interference_bound tsk A Δ :=
        task_rbf (A + ε) - task_cost tsk + IBF Δ.

      (** Next, consider any A from the search space (in the abstract sense). *)
      Variable A : duration.
      Hypothesis H_A_is_in_abstract_search_space :
        search_space.is_in_search_space tsk L total_interference_bound A.

      (** We prove that A is also in the concrete search space. *)
      Lemma A_is_in_concrete_search_space:
        is_in_search_space A.
      Proof.
        move: H_A_is_in_abstract_search_space => [INSP | [/andP [POSA LTL] [x [LTx INSP2]]]].
        - rewrite INSP.
          apply/andP; split; first by done.
          rewrite neq_ltn; apply/orP; left.
          rewrite {1}/task_rbf; erewrite task_rbf_0_zero; eauto 2; try done.
          rewrite add0n /task_rbf; apply leq_trans with (task_cost tsk).
          + by apply leq_trans with (job_cost j); rewrite -?H_job_of_tsk; eauto 2.
          + eapply task_rbf_1_ge_task_cost; eauto 2.
        - apply/andP; split; first by done.
          apply/negP; intros EQ; move: EQ => /eqP EQ.
          apply INSP2.
          unfold total_interference_bound in *.
          rewrite subn1 addn1 prednK; last by done.
            by rewrite -EQ.
      Qed.

      (** Then, there exists a solution for the response-time recurrence (in the abstract sense). *)
      Corollary correct_search_space:
        exists (F : duration),
          A + F = task_rbf (A + ε) - (task_cost tsk - task_run_to_completion_threshold tsk) + IBF (A + F) /\
          F + (task_cost tsk - task_run_to_completion_threshold tsk) <= R.
      Proof.
        move: (H_R_is_maximum A) => FIX.
        feed FIX; first by apply A_is_in_concrete_search_space.
        move: FIX => [F [FIX NEQ]].
        exists F; split; last by done.
        apply/eqP; rewrite {1}FIX.
          by rewrite addnA [_ + priority_inversion_bound]addnC -!addnA.
      Qed.

    End SolutionOfResponseTimeRecurrenceExists.

  End FillingOutHypothesesOfAbstractRTATheorem.

  (** ** Final Theorem *)
  (** Based on the properties established above, we apply the abstract analysis
     framework to infer that [R] is a response-time bound for [tsk]. *)
  Theorem uniprocessor_response_time_bound_fp:
    response_time_bounded_by tsk R.
  Proof.
    intros js ARRs TSKs.
    move: (posnP (@job_cost _ H3 js)) => [ZERO|POS].
    { by rewrite /job_response_time_bound /completed_by ZERO. }
    eapply uniprocessor_response_time_bound_seq; eauto 3.
    - by apply instantiated_i_and_w_are_consistent_with_schedule.
    - by apply instantiated_interference_and_workload_consistent_with_sequential_tasks.
    - by apply instantiated_busy_intervals_are_bounded.
    - by apply instantiated_task_interference_is_bounded.
    - by eapply correct_search_space; eauto 2.
  Qed.

End AbstractRTAforFPwithArrivalCurves.


From solutions Require Export sem_type_formers.

(** * The semantic typing judgment *)

(** We define the judgment [Γ ⊨ e : A] for semantic typing of the expression [e]
at semantic type [A], assuming that free variables in [e] belong to the semantic
types described by [Γ]. This notion is defined as follows:

- We define the semantic typing relation [env_sem_typed] for typing contexts:
  An environments (mappings from free variables to values) [vs] is in the
  semantic type for a typing context [Γ], [env_sem_typed Γ vs], if for any free
  variable [x], [vs(x)] is in the semantic type [Γ(x)].
- The semantic typing judgment [Γ ⊨ e : A] holds if for any environment [vs]
  such that [env_sem_typed Γ vs] we have that [subst_map vs e] is an expression
  in the semantics of type [A], i.e., [WP subst_map vs e {{ A }}] holds. *)

(** The semantic type for the typing context (environment). *)
Definition env_sem_typed `{!heapG Σ} (Γ : gmap string (sem_ty Σ))
    (vs : gmap string val) : iProp Σ :=
  ([∗ map] i ↦ A;v ∈ Γ; vs, sem_ty_car A v)%I.
Instance: Params (@env_sem_typed) 2 := {}.

(** The semantics typing judgment. *)
Definition sem_typed `{!heapG Σ}
    (Γ : gmap string (sem_ty Σ)) (e : expr) (A : sem_ty Σ) : iProp Σ :=
  tc_opaque (□ ∀ vs,
    env_sem_typed Γ vs -∗ WP subst_map vs e {{ A }})%I.
Instance: Params (@sem_typed) 2 := {}.
Notation "Γ ⊨ e : A" := (sem_typed Γ e A)
  (at level 74, e, A at next level) : bi_scope.

Definition sem_val_typed `{!heapG Σ} (v : val) (A : sem_ty Σ) : iProp Σ :=
  tc_opaque (A v).
Instance: Params (@sem_val_typed) 3 := {}.
Notation "⊨ᵥ v : A" := (sem_val_typed v A)
  (at level 20, v, A at next level) : bi_scope.
Arguments sem_val_typed : simpl never.

(** A few useful lemmas about the semantic typing judgment. The first
few lemmas involving [Proper]ness are boilerplate required for supporting setoid
rewriting. *)
Section sem_typed.
  Context `{!heapG Σ}.
  Implicit Types A B : sem_ty Σ.
  Implicit Types C : sem_ty Σ → sem_ty Σ.

  Global Instance env_sem_typed_ne n :
    Proper (dist n ==> (=) ==> dist n) (@env_sem_typed Σ _).
  Proof.
    intros Γ1 Γ2 HΓ ρ ? <-.
    apply big_sepM2_ne_2=> // k A1 v1 A2 v2 _ _ HA _ _ /discrete_iff / leibniz_equiv_iff ->.
    by apply HA.
  Qed.
  Global Instance env_sem_typed_proper :
    Proper ((≡) ==> (=) ==> (≡)) (@env_sem_typed Σ _).
  Proof. intros Γ1 Γ2 HΓ ρ ? <-. apply equiv_dist=> n. f_equiv. by rewrite HΓ. Qed.

  Global Instance sem_typed_ne n :
    Proper (dist n ==> (=) ==> dist n ==> dist n) (@sem_typed Σ _).
  Proof. solve_proper. Qed.
  Global Instance sem_typed_proper :
    Proper ((≡) ==> (=) ==> (≡) ==> (≡)) (@sem_typed Σ _).
  Proof. solve_proper. Qed.

  Global Instance sem_typed_persistent Γ e A : Persistent (Γ ⊨ e : A).
  Proof. rewrite /sem_typed /=. apply _. Qed.

  Global Instance sem_val_typed_ne v : NonExpansive (@sem_val_typed Σ _ v).
  Proof. solve_proper. Qed.
  Global Instance sem_val_typed_proper v :
    Proper ((≡) ==> (≡)) (@sem_val_typed Σ _ v).
  Proof. solve_proper. Qed.

  Global Instance sem_val_typed_persistent v A : Persistent (⊨ᵥ v : A).
  Proof. rewrite /sem_val_typed /=. apply _. Qed.

  (* Environments *)
  Lemma env_sem_typed_lookup Γ vs x A :
    Γ !! x = Some A →
    env_sem_typed Γ vs -∗ ∃ v, ⌜ vs !! x = Some v ⌝ ∧ A v.
  Proof.
    iIntros (HΓx) "HΓ". rewrite /env_sem_typed.
    by iApply (big_sepM2_lookup_1 with "HΓ").
  Qed.
  Lemma env_sem_typed_insert Γ vs x A v :
    A v -∗ env_sem_typed Γ vs -∗
    env_sem_typed (binder_insert x A Γ) (binder_insert x v vs).
  Proof.
    destruct x as [|x]=> /=; first by auto. rewrite /env_sem_typed.
    iIntros "#HA #HΓ". by iApply (big_sepM2_insert_2 with "[] HΓ").
  Qed.

  Lemma env_sem_typed_empty : ⊢ env_sem_typed ∅ ∅.
  Proof. iIntros "". by rewrite /env_sem_typed. Qed.
  Lemma env_sem_typed_empty_l_inv vs : env_sem_typed ∅ vs -∗ ⌜vs = ∅⌝.
  Proof. by iIntros "?"; iApply big_sepM2_empty_r. Qed.
End sem_typed.