Require Import prosa.classic.util.all.
Require Import prosa.classic.model.arrival.basic.job
               prosa.classic.model.arrival.basic.task_arrival
               prosa.classic.model.priority.
Require Import prosa.classic.model.schedule.uni.service
               prosa.classic.model.schedule.uni.workload
               prosa.classic.model.schedule.uni.schedule
               prosa.classic.model.schedule.uni.response_time.
Require Import prosa.classic.model.schedule.uni.limited.schedule
               prosa.classic.model.schedule.uni.limited.edf.response_time_bound
               prosa.classic.model.schedule.uni.limited.edf.nonpr_reg.response_time_bound
               prosa.classic.model.schedule.uni.limited.rbf.
Require Import prosa.classic.model.arrival.curves.bounds
               prosa.classic.analysis.uni.arrival_curves.workload_bound.
Require Import prosa.classic.model.schedule.uni.nonpreemptive.schedule
               prosa.classic.model.schedule.uni.limited.platform.limited
               prosa.classic.model.schedule.uni.limited.platform.preemptive
               prosa.classic.model.schedule.uni.limited.platform.nonpreemptive.

From mathcomp Require Import ssreflect ssrbool eqtype ssrnat seq path fintype bigop.

(** * RTA for concrete models *)
(** In this module we prove the RTA theorems for (1) fully preemptive EDF model,
    (2) fully nonpreemptive EDF model, (3) EDF with fixed premption points, and
    (4) EDF with floating nonpreemptive regions. *)
Module RTAforConcreteModels.

  Import Job ArrivalCurves TaskArrival Priority UniprocessorSchedule Workload Service
         ResponseTime MaxArrivalsWorkloadBound LimitedPreemptionPlatform ModelWithLimitedPreemptions
         RTAforEDFwithBoundedNonpreemptiveSegmentsWithArrivalCurves NonpreemptiveSchedule
         FullyNonPreemptivePlatform FullyPreemptivePlatform AbstractRTAforEDFwithArrivalCurves.

  Section Analysis.

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

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

    (* For clarity, let's denote the relative deadline of a task as D. *)
    Let D tsk := task_deadline tsk.

    (* The relative deadline of a job is equal to the deadline of the corresponding task. *)
    Let job_relative_deadline j := D (job_task j).

    (* Consider the EDF policy that indicates a higher-or-equal priority relation. *)
    Let higher_eq_priority: JLFP_policy Job := EDF job_arrival job_relative_deadline.

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

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

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

    (* ...and the cost of a job cannot be larger than the task cost. *)
    Hypothesis H_job_cost_le_task_cost:
      cost_of_jobs_from_arrival_sequence_le_task_cost
        task_cost job_cost job_task arr_seq.

    (* Let max_arrivals be a family of proper 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. *)
    Variable max_arrivals: Task -> time -> nat.
    Hypothesis H_family_of_proper_arrival_curves:
      family_of_proper_arrival_curves job_task arr_seq max_arrivals ts.

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

    (* Next, consider any uniprocessor schedule... *)
    Variable sched: schedule Job.
    Hypothesis H_jobs_come_from_arrival_sequence: jobs_come_from_arrival_sequence sched arr_seq.

    (* ... where jobs do not execute before their arrival nor after completion. *)
    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 we have sequential jobs, i.e, jobs from the same
       task execute in the order of their arrival. *)
    Hypothesis H_sequential_jobs: sequential_jobs job_arrival job_cost sched job_task.

    (* Next, we assume that the schedule is a work-conserving schedule. *)
    Hypothesis H_work_conserving: work_conserving job_arrival job_cost arr_seq sched.

    (* Let's define some local names for clarity. *)
    Let response_time_bounded_by :=
      is_response_time_bound_of_task job_arrival job_cost job_task arr_seq sched.
    Let task_rbf_changes_at A := task_rbf_changes_at task_cost max_arrivals tsk A.
    Let bound_on_total_hep_workload_changes_at :=
      bound_on_total_hep_workload_changes_at task_cost task_deadline ts max_arrivals tsk.

    (* We introduce the abbreviation "rbf" for the task request bound function,
       which is defined as [task_cost(T) × max_arrivals(T,Δ)] for a task T. *)
    Let rbf := task_request_bound_function task_cost max_arrivals.

    (* Next, we introduce task_rbf as an abbreviation
       for the task request bound function of task tsk. *)
    Let task_rbf := rbf tsk.

    (* Using the sum of individual request bound functions, we define the request bound
       function of all tasks (total request bound function). *)
    Let total_rbf := total_request_bound_function task_cost max_arrivals ts.

    (* Next, we define an upper bound on interfering workload received from jobs
       of other tasks with higher-than-or-equal priority. *)
    Let bound_on_total_hep_workload A Δ :=
      \sum_(tsk_o <- ts | tsk_o != tsk)
       rbf tsk_o (minn ((A + ε) + D tsk - D tsk_o) Δ).

    (** * RTA for fully preemptive EDF model *)
    (** In this section we prove the RTA theorem for the fully preemptive EDF model *)
    Section RTAforFullyPreemptiveEDFModelwithArrivalCurves.

      (* First, we assume that the schedule respects the JLFP policy
         under a model with fixed preemption points. *)
      Hypothesis H_respects_policy:
        respects_JLFP_policy_at_preemption_point
          job_arrival job_cost arr_seq sched
          can_be_preempted_for_fully_preemptive_model higher_eq_priority.

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

      (* To reduce the time complexity of the analysis, recall the notion of search space. *)
      Let is_in_search_space A :=
        (A < L) && (task_rbf_changes_at A || bound_on_total_hep_workload_changes_at A).

      (* Consider any value R, and assume that for any given arrival offset A in the search space,
         there is a solution of the response-time bound recurrence which is bounded by R. *)
      Variable R: nat.
      Hypothesis H_R_is_maximum:
        forall A,
          is_in_search_space A ->
          exists F,
            A + F = task_rbf (A + ε) + bound_on_total_hep_workload A (A + F) /\
            F <= R.

      (* Now, we can leverage the results for the abstract model with bounded nonpreemptive segments
         to establish a response-time bound for the more concrete model of fully preemptive scheduling. *)
      Theorem uniprocessor_response_time_bound_fully_preemptive_edf:
        response_time_bounded_by tsk R.
      Proof.
        have BLOCK: RTAforEDFwithBoundedNonpreemptiveSegmentsWithArrivalCurves.blocking_bound
                      (fun _ => ε) D ts tsk = 0.
        { by rewrite /RTAforEDFwithBoundedNonpreemptiveSegmentsWithArrivalCurves.blocking_bound
                     subnn big1_eq. }
        eapply uniprocessor_response_time_bound_edf_with_bounded_nonpreemptive_segments with
            (task_max_nps := fun _ => ε)
            (can_be_preempted := fun j prog => true)
            (task_lock_in_service := fun tsk => task_cost tsk)
            (job_lock_in_service := fun j => job_cost j)
            (job_max_nps := fun j => ε); eauto 2; try done.
        - by eapply fully_preemptive_model_is_model_with_bounded_nonpreemptive_regions.
        - repeat split; try done.
          intros ? ? ? ARR; move => LE COMPL /negP NCOMPL.
          exfalso; apply: NCOMPL.
          apply completion_monotonic with t; try done.
        - repeat split; try done.
          rewrite /task_lock_in_service_le_task_cost. by done.
          unfold task_lock_in_service_bounds_job_lock_in_service.
            by intros ? ARR TSK; rewrite -TSK; apply H_job_cost_le_task_cost.
        - move => A /andP [LT NEQ].
          specialize (H_R_is_maximum A); feed H_R_is_maximum.
          { by apply/andP; split. }
          move: H_R_is_maximum => [F [FIX BOUND]].
          exists F; split.
          + by rewrite BLOCK add0n subnn subn0.
          + by rewrite subnn addn0.
      Qed.

    End RTAforFullyPreemptiveEDFModelwithArrivalCurves.

    (** * RTA for fully nonpreemptive EDF model *)
    (** In this section we prove the RTA theorem for the fully nonpreemptive EDF model. *)
    Section RTAforFullyNonPreemptiveEDFModelwithArrivalCurves.

      (* First, we assume that the schedule is nonpreemptive. *)
      Hypothesis H_nonpreemptive_sched: is_nonpreemptive_schedule job_cost sched.

      (* Next, we assume that the schedule respects the JLFP policy
         under a model with fixed preemption points. *)
      Hypothesis H_respects_policy:
        respects_JLFP_policy_at_preemption_point
          job_arrival job_cost arr_seq sched
          (can_be_preempted_for_fully_nonpreemptive_model job_cost) higher_eq_priority.

      (* We also define a bound for the priority inversion caused by jobs with lower priority. *)
      Let blocking_bound :=
        \max_(tsk_other <- ts | (tsk_other != tsk) && (D tsk_other > D tsk))
         (task_cost tsk_other - ε).

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

      (* To reduce the time complexity of the analysis, recall the notion of search space. *)
      Let is_in_search_space A :=
        (A < L) && (task_rbf_changes_at A || bound_on_total_hep_workload_changes_at A).

      (* Consider any value R, and assume that for any given arrival offset A in the search space,
         there is a solution of the response-time bound recurrence which is bounded by R. *)
      Variable R: nat.
      Hypothesis H_R_is_maximum:
        forall A,
          is_in_search_space A ->
          exists F,
            A + F = blocking_bound + (task_rbf (A + ε) - (task_cost tsk - ε))
                    + bound_on_total_hep_workload A (A + F) /\
            F + (task_cost tsk - ε) <= R.

      (* Now, we can leverage the results for the abstract model with bounded nonpreemptive segments
         to establish a response-time bound for the more concrete model of fully nonpreemptive scheduling. *)
      Theorem uniprocessor_response_time_bound_fully_nonpreemptive_edf:
        response_time_bounded_by tsk R.
      Proof.
        move: (posnP (task_cost tsk)) => [ZERO|POS].
        { intros j ARR TSK.
          have ZEROj: job_cost j = 0.
          { move: (H_job_cost_le_task_cost j ARR) => NEQ.
            rewrite /job_cost_le_task_cost TSK ZERO in NEQ.
              by apply/eqP; rewrite -leqn0.
          }
            by rewrite /is_response_time_bound_of_job /completed_by ZEROj.
        }
        eapply uniprocessor_response_time_bound_edf_with_bounded_nonpreemptive_segments with
            (job_max_nps := fun j => job_cost j)
            (task_max_nps := fun tsk => task_cost tsk)
            (job_lock_in_service := fun j => ε)
            (task_lock_in_service := fun tsk => ε)
            (L0 := L); eauto 2.
        - by eapply fully_nonpreemptive_model_is_correct; eauto 2.
        - eapply fully_nonpreemptive_model_is_model_with_bounded_nonpreemptive_regions; eauto 2.
        - repeat split; try done.
        - intros j t t' ARR LE SERV NCOMPL.
          rewrite /service in SERV; apply incremental_service_during in SERV.
          move: SERV => [t_first [/andP [_ H1] [H2 H3]]].
          apply H_nonpreemptive_sched with t_first; try done.
            by apply leq_trans with t; first apply ltnW.
        - repeat split; try done.
      Qed.

    End RTAforFullyNonPreemptiveEDFModelwithArrivalCurves.

    (** * RTA for EDF with fixed premption points *)
    (** In this module we prove a general RTA theorem for EDF-schedulers with fixed preemption points *)
    Section RTAforFixedPreemptionPointsModelwithArrivalCurves.

      (* First, let's assume we have the model with fixed preemption points.
         I.e., each task is divided into a number of nonpreemptive segments
         separated by statically predefined preemption points. *)
      Variable job_preemption_points: Job -> seq time.
      Variable task_preemption_points: Task -> seq time.
      Hypothesis H_model_with_fixed_preemption_points:
        fixed_preemption_points_model
          task_cost job_cost job_task arr_seq
          job_preemption_points task_preemption_points ts.

      (* Assume that the schedule is a uniprocessor schedule with limited preemptions... *)
      Hypothesis H_schedule_with_limited_preemptions:
        is_schedule_with_limited_preemptions arr_seq job_preemption_points sched.

      (* ... that respects the JLFP policy under a model with fixed preemption points. *)
      Hypothesis H_respects_policy:
        respects_JLFP_policy_at_preemption_point
          job_arrival job_cost arr_seq sched
          (can_be_preempted_for_model_with_limited_preemptions job_preemption_points) higher_eq_priority.

      (* We also have a set of functions that map job or task
         to its max or last nonpreemptive segment. *)
      Let job_max_nps := job_max_nps job_preemption_points.
      Let job_last_nps := job_last_nps job_preemption_points.
      Let task_max_nps := task_max_nps task_preemption_points.
      Let task_last_nps := task_last_nps task_preemption_points.

      (* We define a bound for the priority inversion caused by jobs with lower priority. *)
      Let blocking_bound :=
        \max_(tsk_other <- ts | (tsk_other != tsk) && (D tsk_other > D tsk))
         (task_max_nps tsk_other - ε).

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

      (* To reduce the time complexity of the analysis, recall the notion of search space. *)
      Let is_in_search_space A :=
        (A < L) && (task_rbf_changes_at A || bound_on_total_hep_workload_changes_at A).

      (* Consider any value R, and assume that for any given arrival offset A in the search space,
         there is a solution of the response-time bound recurrence which is bounded by R. *)
      Variable R: nat.
      Hypothesis H_R_is_maximum:
        forall A,
          is_in_search_space A ->
          exists F,
            A + F = blocking_bound
                    + (task_rbf (A + ε) - (task_last_nps tsk - ε))
                    + bound_on_total_hep_workload A (A + F) /\
            F + (task_last_nps tsk - ε) <= R.

      (* Now, we can leverage the results for the abstract model with bounded nonpreemptive segments
         to establish a response-time bound for the more concrete model of fixed preemption points.  *)
      Theorem uniprocessor_response_time_bound_edf_with_fixed_preemption_points:
        response_time_bounded_by tsk R.
      Proof.
        move: (H_model_with_fixed_preemption_points) => [MLP [BEG [END [INCR [HYP1 [HYP2 HYP3]]]]]].
        move: (MLP) => [EMPTj [LSMj [BEGj [ENDj HH]]]].
        move: (posnP (task_cost tsk)) => [ZERO|POSt].
        { intros j ARR TSK.
          move: (H_job_cost_le_task_cost _ ARR) => POSt.
          move: POSt; rewrite /job_cost_le_task_cost TSK ZERO leqn0; move => /eqP Z.
            by rewrite /is_response_time_bound_of_job /completed_by Z.
        }
        have Fact2: 1 < size (task_preemption_points tsk).
        { have Fact2: 0 < size (task_preemption_points tsk).
          { apply/negPn/negP; rewrite -eqn0Ngt; intros CONTR; move: CONTR => /eqP CONTR.
            move: (END _ H_tsk_in_ts) => EQ.
            move: EQ; rewrite /last0 -nth_last nth_default; last by rewrite CONTR.
              by intros; rewrite -EQ in POSt.
          }
          have EQ: 2 = size [::0; task_cost tsk]; first by done.
          rewrite EQ; clear EQ.
          apply subseq_leq_size.
          rewrite !cons_uniq.
          { apply/andP; split.
            rewrite in_cons negb_or; apply/andP; split; last by done.
            rewrite neq_ltn; apply/orP; left; eauto 2.
            apply/andP; split; by done. }
          intros t EQ; move: EQ; rewrite !in_cons.
          move => /orP [/eqP EQ| /orP [/eqP EQ|EQ]]; last by done.
          { rewrite EQ; clear EQ.
            move: (BEG _ H_tsk_in_ts) => EQ.
            rewrite -EQ; clear EQ.
            rewrite /first0 -nth0.
            apply/(nthP 0).
            exists 0; by done.
          }
          { rewrite EQ; clear EQ.
            move: (END _ H_tsk_in_ts) => EQ.
            rewrite -EQ; clear EQ.
            rewrite /last0 -nth_last.
            apply/(nthP 0).
            exists ((size (task_preemption_points tsk)).-1); last by done.
              by rewrite -(leq_add2r 1) !addn1 prednK //.
          }
        }
        eapply uniprocessor_response_time_bound_edf_with_bounded_nonpreemptive_segments
          with (task_lock_in_service := fun tsk => (task_cost tsk - (task_last_nps tsk - ε)))
               (job_lock_in_service := fun job => (job_cost job - (job_last_nps job - ε)))
               (L0 := L)(job_cost0 := job_cost) (task_max_nps0 := task_max_nps)
        ; eauto 2.
        { by apply model_with_fixed_preemption_points_is_correct. }
        { eapply model_with_fixed_preemption_points_is_model_with_bounded_nonpreemptive_regions; eauto 2.
          intros j ARR.
          unfold ModelWithLimitedPreemptions.job_max_nps, task_max_nps, lengths_of_segments.
          apply max_of_dominating_seq.
          intros. apply HYP2.
            by done.
        }
        { split; last split.
          { intros j ARR POS.
            rewrite subn_gt0.
            rewrite subn1 -(leq_add2r 1) !addn1 prednK; last first.
            apply LSMj; try done.
            rewrite /job_last_nps /ModelWithLimitedPreemptions.job_last_nps
                    ltnS /last0 -nth_last function_of_distances_is_correct.
            apply leq_trans with (job_max_nps j);
              first by apply distance_between_neighboring_elements_le_max_distance_in_seq.
            rewrite -ENDj; last by done.
              by apply max_distance_in_seq_le_last_element_of_seq; eauto 2.
          }
          { by intros j ARR; rewrite leq_subLR leq_addl. }
          { intros ? ? ? ARR LE LS NCOMPL.
            rewrite subnBA in LS; last first.
            apply LSMj; try done.
            { rewrite lt0n; apply/negP; intros Z; move: Z => /eqP Z.
                by move: NCOMPL; rewrite /completed_by -ltnNge Z ltn0; move => LT.
            }
            have EQ: exists Δ, t' = t + Δ.
            { exists (t' - t); rewrite subnKC; by done. }
            move: EQ => [Δ EQ]; subst t'; clear LE.
            rewrite -subh1 in LS.
            rewrite addn1 in LS.
            apply H_schedule_with_limited_preemptions; first by done.
            rewrite /can_be_preempted_for_model_with_limited_preemptions; apply/negP.
            intros CONTR.
            move: NCOMPL; rewrite /completed_by -ltnNge; move => SERV.
            have NEQ: job_cost j - job_last_nps j < service sched j (t + Δ).
            { apply leq_trans with (service sched j t); first by done.
              rewrite /service /service_during [in X in _ <= X](@big_cat_nat _ _ _ t) //=.
              rewrite leq_addr //.
              rewrite leq_addr //.
            }
            clear LS.
            rewrite -ENDj in NEQ, SERV; last by done.
            rewrite last_seq_minus_last_distance_seq in NEQ; last by eauto 2.
            rewrite /last0 -nth_last in SERV.
            have EQ := antidensity_of_nondecreasing_seq.
            specialize (EQ (job_preemption_points j) (service sched j (t + Δ)) (size (job_preemption_points j)).-2).
            rewrite CONTR in EQ.
            feed_n 2 EQ; first by eauto 2.
            {
              apply/andP; split; first by done.
              rewrite prednK; first by done.
              rewrite -(leq_add2r 1) !addn1 prednK.
              eapply number_of_preemption_points_at_least_two with (job_cost0 := job_cost); eauto 2.
              eapply list_of_preemption_point_is_not_empty with (job_cost0 := job_cost); eauto 2.
            }
              by done.
            rewrite -ENDj; last by done.
            apply leq_trans with (job_max_nps j).
            - by apply last_of_seq_le_max_of_seq.
            - by apply max_distance_in_seq_le_last_element_of_seq; eauto 2.
          }
        }
        {
          split.
          - by rewrite /task_lock_in_service_le_task_cost leq_subLR leq_addl.
          - intros j ARR TSK.
            move: (posnP (job_cost j)) => [ZERO | POS].
            { by rewrite ZERO. }
            unfold task_last_nps.
            rewrite !subnBA; first last.
            apply LSMj; try done.
            rewrite /ModelWithLimitedPreemptions.task_last_nps /last0 -nth_last.
            apply HYP3.
              by done.
              rewrite -(ltn_add2r 1) !addn1 prednK //.
              move: (Fact2) => Fact3.
              rewrite size_of_seq_of_distances // addn1 ltnS // in Fact2.
              rewrite -subh1 -?[in X in _ <= X]subh1; first last.
              { apply leq_trans with (job_max_nps j).
                - by apply last_of_seq_le_max_of_seq.
                - by rewrite -ENDj //; apply max_distance_in_seq_le_last_element_of_seq; eauto 2.
              }
              { apply leq_trans with (task_max_nps tsk).
                - by apply last_of_seq_le_max_of_seq.
                - by rewrite -END //; apply max_distance_in_seq_le_last_element_of_seq; eauto 2.
              }
              rewrite -ENDj; last eauto 2.
              rewrite -END; last eauto 2.
              rewrite !last_seq_minus_last_distance_seq.
              have EQ: size (job_preemption_points j) = size (task_preemption_points tsk).
              { rewrite -TSK.
                  by apply HYP1.
              }
              rewrite EQ; clear EQ.
              rewrite leq_add2r.
              apply domination_of_distances_implies_domination_of_seq; try done; eauto 2.
              rewrite BEG // BEGj //.
              eapply number_of_preemption_points_at_least_two with (job_cost0 := job_cost); eauto 2.
              rewrite -TSK; apply HYP1; try done.
              intros.              rewrite -TSK; eauto 2.
              eauto 2.
              eauto 2.
        }
        { rewrite subKn; first by done.
          rewrite /task_last_nps  -(leq_add2r 1) subn1 !addn1 prednK; last first.
          { rewrite /ModelWithLimitedPreemptions.task_last_nps /last0 -nth_last.
            apply HYP3; try by done.
            rewrite -(ltn_add2r 1) !addn1 prednK //.
            move: (Fact2) => Fact3.
              by rewrite size_of_seq_of_distances // addn1 ltnS // in Fact2.
          }
          { apply leq_trans with (task_max_nps tsk).
            - by apply last_of_seq_le_max_of_seq.
            - rewrite -END; last by done.
              apply ltnW; rewrite ltnS; try done.
                by apply max_distance_in_seq_le_last_element_of_seq; eauto 2.
          }
        }
      Qed.

    End RTAforFixedPreemptionPointsModelwithArrivalCurves.

    (** * RTA for EDF with floating nonpreemptive regions *)
    (** In this module we prove a general RTA theorem for EDF-schedulers with floating nonpreemptive regions *)
    Section RTAforModelWithFloatingNonpreemptiveRegionsWithArrivalCurves.

      (* First, assume we have model with floating nonpreemptive regions.
         I.e., for each task only the length of the maximal nonpreemptive
         segment is known. *)
      Variable job_preemption_points: Job -> seq time.
      Variable task_max_nps: Task -> time.
      Hypothesis H_task_model_with_floating_nonpreemptive_regions:
        model_with_floating_nonpreemptive_regions
          job_cost job_task arr_seq job_preemption_points task_max_nps.

      (* Assume that the schedule is a uniprocessor schedule with limited preemptions... *)
      Hypothesis H_schedule_with_limited_preemptions:
        is_schedule_with_limited_preemptions arr_seq job_preemption_points sched.

      (* ... that respects the JLFP policy under a model with floating nonpreemptive regions. *)
      Hypothesis H_respects_policy:
        respects_JLFP_policy_at_preemption_point
          job_arrival job_cost arr_seq sched
          (can_be_preempted_for_model_with_limited_preemptions job_preemption_points) higher_eq_priority.

      (* We also have two functions that map job to its max or last nonpreemptive segment. *)
      Let job_max_nps := job_max_nps job_preemption_points.
      Let job_last_nps := job_last_nps job_preemption_points.

      (* We define a bound for the priority inversion caused by jobs with lower priority. *)
      Definition blocking_bound :=
        \max_(tsk_other <- ts | (tsk_other != tsk) && (D tsk_other > D tsk))
         (task_max_nps tsk_other - ε).

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

      (* To reduce the time complexity of the analysis, recall the notion of search space. *)
      Let is_in_search_space A :=
        (A < L) && (task_rbf_changes_at A || bound_on_total_hep_workload_changes_at A).

      (* Consider any value R, and assume that for any given arrival offset A in the search space,
         there is a solution of the response-time bound recurrence which is bounded by R. *)
      Variable R: nat.
      Hypothesis H_R_is_maximum:
        forall A,
          is_in_search_space A ->
          exists F,
            A + F = blocking_bound + task_rbf (A + ε) + bound_on_total_hep_workload A (A + F) /\
            F <= R.

      (* Now, we can leverage the results for the abstract model with bounded nonpreemptive segments
         to establish a response-time bound for the more concrete model with floating nonpreemptive regions.  *)
      Theorem uniprocessor_response_time_bound_edf_with_floating_nonpreemptive_regions:
        response_time_bounded_by tsk R.
      Proof.
        move: (H_task_model_with_floating_nonpreemptive_regions) => [LIMJ JMLETM].
        move: (LIMJ) => [ZERO [LSMj [BEG [END HH]]]].
        eapply uniprocessor_response_time_bound_edf_with_bounded_nonpreemptive_segments
          with (task_lock_in_service := fun tsk => task_cost tsk)
               (job_lock_in_service := fun job => (job_cost job - (job_last_nps job - ε)))
               (L0 := L) (job_max_nps0 := job_max_nps)
               (job_cost0 := job_cost )
        ; eauto 2.
        { by apply model_with_fixed_preemption_points_is_correct. }
        { by eapply model_with_fixed_preemption_points_is_model_with_bounded_nonpreemptive_regions; eauto 2. }
        { split; last split.
          { intros j ARR POS.
            rewrite subn_gt0.
            rewrite subn1 -(leq_add2r 1) !addn1 prednK; last first.
            apply LSMj; try done.
            rewrite /job_last_nps /ModelWithLimitedPreemptions.job_last_nps
                    ltnS /last0 -nth_last function_of_distances_is_correct.
            apply leq_trans with (job_max_nps j); first by apply distance_between_neighboring_elements_le_max_distance_in_seq.
            rewrite -END; last by done.
              by apply max_distance_in_seq_le_last_element_of_seq; eauto 2.
          }
          { by intros j ARR; rewrite leq_subLR leq_addl. }
          { intros ? ? ? ARR LE LS NCOMPL.
            rewrite subnBA in LS; last first.
            apply LSMj; try done.
            { rewrite lt0n; apply/negP; intros Z; move: Z => /eqP Z.
                by move: NCOMPL; rewrite /completed_by -ltnNge Z ltn0.
            }
            have EQ: exists Δ, t' = t + Δ.
            { exists (t' - t); rewrite subnKC; by done. }
            move: EQ => [Δ EQ]; subst t'; clear LE.
            rewrite -subh1 in LS.
            rewrite addn1 in LS.
            apply H_schedule_with_limited_preemptions; first by done.
            rewrite /can_be_preempted_for_model_with_limited_preemptions; apply/negP.
            intros CONTR.
            move: NCOMPL; rewrite /completed_by -ltnNge; move => SERV.
            have NEQ: job_cost j - (job_last_nps j) < service sched j (t + Δ).
            { apply leq_trans with (service sched j t); first by done.
              rewrite /service /service_during [in X in _ <= X](@big_cat_nat _ _ _ t) //=.
              rewrite leq_addr //.
              rewrite leq_addr //.
            }
            clear LS.
            rewrite -END in NEQ, SERV; last by done.
            rewrite last_seq_minus_last_distance_seq in NEQ.
            rewrite /last0 -nth_last in SERV.
            have EQ := antidensity_of_nondecreasing_seq.
            specialize (EQ (job_preemption_points j) (service sched j (t + Δ)) (size (job_preemption_points j)).-2).
            rewrite CONTR in EQ.
            feed_n 2 EQ; first by eauto 2.
            {
              apply/andP; split; first by done.
              rewrite prednK; first by done.
              rewrite -(leq_add2r 1) !addn1 prednK.
              eapply number_of_preemption_points_at_least_two with (job_cost0 := job_cost); eauto 2.
              eapply list_of_preemption_point_is_not_empty with (job_cost0 := job_cost); eauto 2.
            }
              by done.
            eauto 2.
            rewrite -END; last by done.
            apply leq_trans with (job_max_nps j).
            - by apply last_of_seq_le_max_of_seq.
            - by apply max_distance_in_seq_le_last_element_of_seq; eauto 2.
          }
        }
        {
          split.
          - by rewrite /task_lock_in_service_le_task_cost.
          - intros j ARR TSK.
            apply leq_trans with (job_cost j); first by rewrite leq_subr.
              by rewrite -TSK; eauto 2.
        }
        {
          rewrite subnn.
          intros.
          apply H_R_is_maximum in H.
          move: H => [F [EQ LE]].
          exists F.
            by rewrite subn0 addn0; split.
        }
      Qed.

    End RTAforModelWithFloatingNonpreemptiveRegionsWithArrivalCurves.

  End Analysis.

End RTAforConcreteModels.


From algebra Require Export cmra.
From algebra Require Import upred.
Local Arguments validN _ _ _ !_ /.
Local Arguments valid _ _  !_ /.

Inductive excl (A : Type) :=
  | Excl : A → excl A
  | ExclUnit : excl A
  | ExclBot : excl A.
Arguments Excl {_} _.
Arguments ExclUnit {_}.
Arguments ExclBot {_}.
Instance maybe_Excl {A} : Maybe (@Excl A) := λ x,
  match x with Excl a => Some a | _ => None end.

Section excl.
Context {A : cofeT}.
Implicit Types a b : A.
Implicit Types x y : excl A.

(* Cofe *)
Inductive excl_equiv : Equiv (excl A) :=
  | Excl_equiv a b : a ≡ b → Excl a ≡ Excl b
  | ExclUnit_equiv : ExclUnit ≡ ExclUnit
  | ExclBot_equiv : ExclBot ≡ ExclBot.
Existing Instance excl_equiv.
Inductive excl_dist : Dist (excl A) :=
  | Excl_dist a b n : a ≡{n}≡ b → Excl a ≡{n}≡ Excl b
  | ExclUnit_dist n : ExclUnit ≡{n}≡ ExclUnit
  | ExclBot_dist n : ExclBot ≡{n}≡ ExclBot.
Existing Instance excl_dist.

Global Instance Excl_ne n : Proper (dist n ==> dist n) (@Excl A).
Proof. by constructor. Qed.
Global Instance Excl_proper : Proper ((≡) ==> (≡)) (@Excl A).
Proof. by constructor. Qed.
Global Instance Excl_inj : Inj (≡) (≡) (@Excl A).
Proof. by inversion_clear 1. Qed.
Global Instance Excl_dist_inj n : Inj (dist n) (dist n) (@Excl A).
Proof. by inversion_clear 1. Qed.

Program Definition excl_chain
    (c : chain (excl A)) (a : A) (H : maybe Excl (c 0) = Some a) : chain A :=
  {| chain_car n := match c n return _ with Excl y => y | _ => a end |}.
Next Obligation.
  intros c a ? n i ?; simpl.
  destruct (c 0) eqn:?; simplify_eq/=.
  by feed inversion (chain_cauchy c n i).
Qed.
Instance excl_compl : Compl (excl A) := λ c,
  match Some_dec (maybe Excl (c 0)) with
  | inleft (exist a H) => Excl (compl (excl_chain c a H)) | inright _ => c 0
  end.
Definition excl_cofe_mixin : CofeMixin (excl A).
Proof.
  split.
  - intros x y; split; [by destruct 1; constructor; apply equiv_dist|].
    intros Hxy; feed inversion (Hxy 1); subst; constructor; apply equiv_dist.
    by intros n; feed inversion (Hxy n).
  - intros n; split.
    + by intros []; constructor.
    + by destruct 1; constructor.
    + destruct 1; inversion_clear 1; constructor; etrans; eauto.
  - by inversion_clear 1; constructor; apply dist_S.
  - intros n c; unfold compl, excl_compl.
    destruct (Some_dec (maybe Excl (c 0))) as [[a Ha]|].
    { assert (c 0 = Excl a) by (by destruct (c 0); simplify_eq/=).
      assert (∃ b, c n = Excl b) as [b Hb].
      { feed inversion (chain_cauchy c 0 n); eauto with lia congruence. }
      rewrite Hb; constructor.
      by rewrite (conv_compl n (excl_chain c a Ha)) /= Hb. }
    feed inversion (chain_cauchy c 0 n); first lia;
       constructor; destruct (c 0); simplify_eq/=.
Qed.
Canonical Structure exclC : cofeT := CofeT excl_cofe_mixin.
Global Instance excl_discrete : Discrete A → Discrete exclC.
Proof. by inversion_clear 2; constructor; apply (timeless _). Qed.
Global Instance excl_leibniz : LeibnizEquiv A → LeibnizEquiv (excl A).
Proof. by destruct 2; f_equal; apply leibniz_equiv. Qed.

Global Instance Excl_timeless a : Timeless a → Timeless (Excl a).
Proof. by inversion_clear 2; constructor; apply (timeless _). Qed.
Global Instance ExclUnit_timeless : Timeless (@ExclUnit A).
Proof. by inversion_clear 1; constructor. Qed.
Global Instance ExclBot_timeless : Timeless (@ExclBot A).
Proof. by inversion_clear 1; constructor. Qed.

(* CMRA *)
Instance excl_valid : Valid (excl A) := λ x,
  match x with Excl _ | ExclUnit => True | ExclBot => False end.
Instance excl_validN : ValidN (excl A) := λ n x,
  match x with Excl _ | ExclUnit => True | ExclBot => False end.
Global Instance excl_empty : Empty (excl A) := ExclUnit.
Instance excl_core : Core (excl A) := λ _, ∅.
Instance excl_op : Op (excl A) := λ x y,
  match x, y with
  | Excl a, ExclUnit | ExclUnit, Excl a => Excl a
  | ExclUnit, ExclUnit => ExclUnit
  | _, _=> ExclBot
  end.
Instance excl_div : Div (excl A) := λ x y,
  match x, y with
  | _, ExclUnit => x
  | Excl _, Excl _ => ExclUnit
  | _, _ => ExclBot
  end.
Definition excl_cmra_mixin : CMRAMixin (excl A).
Proof.
  split.
  - by intros n []; destruct 1; constructor.
  - constructor.
  - by destruct 1; intros ?.
  - by destruct 1; inversion_clear 1; constructor.
  - intros x; split. done. by move=> /(_ 0).
  - intros n [?| |]; simpl; auto with lia.
  - by intros [?| |] [?| |] [?| |]; constructor.
  - by intros [?| |] [?| |]; constructor.
  - by intros [?| |]; constructor.
  - constructor.
  - by intros [?| |] [?| |]; exists ∅.
  - by intros n [?| |] [?| |].
  - by intros [?| |] [?| |] [[?| |] Hz]; inversion_clear Hz; constructor.
  - intros n x y1 y2 ? Hx.
    by exists match y1, y2 with
      | Excl a1, Excl a2 => (Excl a1, Excl a2)
      | ExclBot, _ => (ExclBot, y2) | _, ExclBot => (y1, ExclBot)
      | ExclUnit, _ => (ExclUnit, x) | _, ExclUnit => (x, ExclUnit)
      end; destruct y1, y2; inversion_clear Hx; repeat constructor.
Qed.
Canonical Structure exclR : cmraT := CMRAT excl_cofe_mixin excl_cmra_mixin.
Global Instance excl_cmra_unit : CMRAUnit exclR.
Proof. split. done. by intros []. apply _. Qed.
Global Instance excl_cmra_discrete : Discrete A → CMRADiscrete exclR.
Proof. split. apply _. by intros []. Qed.

Lemma excl_validN_inv_l n x a : ✓{n} (Excl a ⋅ x) → x = ∅.
Proof. by destruct x. Qed.
Lemma excl_validN_inv_r n x a : ✓{n} (x ⋅ Excl a) → x = ∅.
Proof. by destruct x. Qed.
Lemma Excl_includedN n a x : ✓{n} x → Excl a ≼{n} x ↔ x ≡{n}≡ Excl a.
Proof.
  intros Hvalid; split; [|by intros ->].
  intros [z ?]; cofe_subst. by rewrite (excl_validN_inv_l n z a).
Qed.

(** Internalized properties *)
Lemma excl_equivI {M} (x y : excl A) :
  (x ≡ y)%I ≡ (match x, y with
               | Excl a, Excl b => a ≡ b
               | ExclUnit, ExclUnit | ExclBot, ExclBot => True
               | _, _ => False
               end : uPred M)%I.
Proof.
  uPred.unseal. do 2 split. by destruct 1. by destruct x, y; try constructor.
Qed.
Lemma excl_validI {M} (x : excl A) :
  (✓ x)%I ≡ (if x is ExclBot then False else True : uPred M)%I.
Proof. uPred.unseal. by destruct x. Qed.

(** ** Local updates *)
Global Instance excl_local_update y :
  LocalUpdate (λ x, if x is Excl _ then ✓ y else False) (λ _, y).
Proof. split. apply _. by destruct y; intros n [a| |] [b'| |]. Qed.

(** Updates *)
Lemma excl_update a y : ✓ y → Excl a ~~> y.
Proof. destruct y; by intros ?? [?| |]. Qed.
Lemma excl_updateP (P : excl A → Prop) a y : ✓ y → P y → Excl a ~~>: P.
Proof. intros ?? n z ?; exists y. by destruct y, z as [?| |]. Qed.
End excl.

Arguments exclC : clear implicits.
Arguments exclR : clear implicits.

(* Functor *)
Definition excl_map {A B} (f : A → B) (x : excl A) : excl B :=
  match x with
  | Excl a => Excl (f a) | ExclUnit => ExclUnit | ExclBot => ExclBot
  end.
Lemma excl_map_id {A} (x : excl A) : excl_map id x = x.
Proof. by destruct x. Qed.
Lemma excl_map_compose {A B C} (f : A → B) (g : B → C) (x : excl A) :
  excl_map (g ∘ f) x = excl_map g (excl_map f x).
Proof. by destruct x. Qed.
Lemma excl_map_ext {A B : cofeT} (f g : A → B) x :
  (∀ x, f x ≡ g x) → excl_map f x ≡ excl_map g x.
Proof. by destruct x; constructor. Qed.
Instance excl_map_cmra_ne {A B : cofeT} n :
  Proper ((dist n ==> dist n) ==> dist n ==> dist n) (@excl_map A B).
Proof. by intros f f' Hf; destruct 1; constructor; apply Hf. Qed.
Instance excl_map_cmra_monotone {A B : cofeT} (f : A → B) :
  (∀ n, Proper (dist n ==> dist n) f) → CMRAMonotone (excl_map f).
Proof.
  split; try apply _.
  - by intros n [a| |].
  - intros x y [z Hy]; exists (excl_map f z); apply equiv_dist=> n.
    move: Hy=> /equiv_dist /(_ n) ->; by destruct x, z.
Qed.
Definition exclC_map {A B} (f : A -n> B) : exclC A -n> exclC B :=
  CofeMor (excl_map f).
Instance exclC_map_ne A B n : Proper (dist n ==> dist n) (@exclC_map A B).
Proof. by intros f f' Hf []; constructor; apply Hf. Qed.

Program Definition exclRF (F : cFunctor) : rFunctor := {|
  rFunctor_car A B := exclR (cFunctor_car F A B);
  rFunctor_map A1 A2 B1 B2 fg := exclC_map (cFunctor_map F fg)
|}.
Next Obligation.
  intros F A1 A2 B1 B2 n x1 x2 ??. by apply exclC_map_ne, cFunctor_ne.
Qed.
Next Obligation.
  intros F A B x; simpl. rewrite -{2}(excl_map_id x).
  apply excl_map_ext=>y. by rewrite cFunctor_id.
Qed.
Next Obligation.
  intros F A1 A2 A3 B1 B2 B3 f g f' g' x; simpl. rewrite -excl_map_compose.
  apply excl_map_ext=>y; apply cFunctor_compose.
Qed.

Instance exclRF_contractive F :
  cFunctorContractive F → rFunctorContractive (exclRF F).
Proof.
  intros A1 A2 B1 B2 n x1 x2 ??. by apply exclC_map_ne, cFunctor_contractive.
Qed.


Inductive day : Type :=
    | monday
    | tuesday
    | wednesday
    | thursday
    | friday
    | saturday
    | sunday.

Definition next_weekday (d:day) : day :=
    match d with
    | monday => tuesday
    | tuesday => wednesday
    | wednesday => thursday
    | thursday => friday
    | friday => monday
    | saturday => monday
    | sunday => monday
    end.

Compute (next_weekday friday).
Compute (next_weekday saturday).


Set Implicit Arguments.

Require Import Coq.Strings.String.

Inductive ADTScheme :=
| Primitive : string -> ADTScheme
| Product : ADTScheme -> ADTScheme -> ADTScheme.

Require Import Platform.AutoSep.

Record ADTEntry :=
  {
    Model : Type;
    RepInv : W -> Model -> HProp;
    RepInvGood : forall p a, RepInv p a ===> p =?> 1 * any
  }.

Require Import Platform.Cito.StringMap.
Import StringMap.

Definition PrimitiveTable := t ADTEntry.

Definition Empty_adt : ADTEntry :=
  {|
    Model := Empty_set;
    RepInv := fun _ a => match a with end;
    RepInvGood := fun _ a => match a with end
  |}.

Definition product_adt (a b : ADTEntry) : ADTEntry.
  refine (
      {|
        Model := (Model a * Model b)%type;
        RepInv := fun p adt => (Ex x, Ex y, (p ==*> x, y) * RepInv a x (fst adt) * RepInv b y (snd adt))%Sep;
        RepInvGood := _
      |}).

  intros.
  destruct a0; simpl in *.
  unfold any.
  sepLemma.
  unfold himp.
  intros.
  step auto_ext.
  eauto.
Defined.

Section TableSection.

  Variable primitive_table : PrimitiveTable.

  Fixpoint interp_adt (ty : ADTScheme) : ADTEntry :=
    match ty with
      | Primitive name =>
        match find name primitive_table with
          | Some adt => adt
          | None => Empty_adt
        end
      | Product a b => product_adt (interp_adt a) (interp_adt b)
    end.

  Record ADTValue :=
    {
      Ty : ADTScheme;
      Value : Model (interp_adt Ty)
    }.

End TableSection.

Module Type ADTTable.

  Parameter primitive_table : PrimitiveTable.

End ADTTable.

Require Import Platform.Cito.ADT.

Module TabledADT (Import T : ADTTable) <: ADT.

  Definition ADTValue := ADTValue primitive_table.

End TabledADT.

Module Make (Import T : ADTTable).

  Module Import A := TabledADT T.

  Require Import Platform.Cito.RepInv.

  Module TabledADTRepInv <: RepInv A.

    Definition rep_inv p a := RepInv (interp_adt primitive_table (Ty a)) p (Value a).

    Definition rep_inv_ptr p a := RepInvGood (interp_adt primitive_table (Ty a)) p (Value a).

    Definition RepInv := W -> ADTValue -> HProp.

  End TabledADTRepInv.

End Make.


Require Import Coq.Lists.List.
Require Import PerformanceExperiments.Harness.
(** https://github.com/coq/coq/issues/11151 *)

Inductive type := NAT | LIST (t : type) | ARROW (A B : type).
Fixpoint interpt (t : type) : Set
  := match t with
     | NAT => nat
     | LIST t => list (interpt t)
     | ARROW A B => interpt A -> interpt B
     end.
Inductive expr {var : type -> Type} {ident : type -> Type} : type -> Type :=
| LetIn {A B} : expr A -> (var A -> expr B) -> expr B
| App {A B} : expr (ARROW A B) -> expr A -> expr B
| Ident {A} : ident A -> expr A
| Var {A} : var A -> expr A.
Inductive ident : type -> Type :=
| ident_literal : nat -> ident NAT
| ident_cons : ident (ARROW NAT (ARROW (LIST NAT) (LIST NAT)))
| ident_nil : ident (LIST NAT)
| ident_f : ident (ARROW NAT (ARROW NAT NAT)).
Axiom Let_In : forall {A B : Set}, A -> (A -> B) -> B.
Axiom f : nat -> nat -> nat.
Fixpoint interp (ident_interp : forall t, ident t -> interpt t) {T} (v : expr T) : interpt T
  := match v with
     | LetIn v f => Let_In (interp ident_interp v) (fun v => interp ident_interp (f v))
     | App f x => interp ident_interp f (interp ident_interp x)
     | Var v => v
     | Ident idc => ident_interp _ idc
     end.
Definition ident_interp {t} (idc : ident t) : interpt t
  := match idc with
     | ident_literal x => x
     | ident_cons => fun x xs => cons x xs
     | ident_nil => nil
     | ident_f => fun x y => f x y
     end.

Definition map_double_cps {T} {var} (ls : list (expr (ident:=ident) (var:=var) NAT)) (k : list (expr (ident:=ident) (var:=var) NAT) -> expr (ident:=ident) (var:=var) T) :=
  list_rect
    (fun _ => (list (expr (var:=var) NAT) -> expr T) -> _)
    (fun k => k nil)
    (fun x xs rec k
     => LetIn (App (App (Ident ident_f) x) x)
              (fun y =>
                 rec (fun ys => k (cons (Var y) ys))))
    ls
    k.

Definition make_cps {var} {T} (n : nat) (m : nat) (v : expr (var:=var)(ident:=ident) NAT) (k : list (expr (var:=var) NAT) -> expr T)
  := nat_rect
       _
       (fun k => k (List.repeat v n))
       (fun _ rec k => rec (fun ls => map_double_cps ls k))
       m
       k.
Fixpoint reify_list {var} (ls : list (expr (var:=var) NAT)) : expr (var:=var) (LIST NAT)
  := match ls with
     | nil => Ident ident_nil
     | cons x xs => App (App (Ident ident_cons) x) (reify_list xs)
     end.

Local Infix "/" := Nat.div : nat_scope.

Definition args_of_size (s : size) : list nat
  := match s with
     | Sanity => seq 0 3
     | SuperFast => List.map (fun x => x * 5) (seq 0 (70 / 5))
     | Fast => List.map (fun x => x * 5) (seq 0 (120 / 5))
     | Medium => []
     | Slow => []
     | VerySlow => []
     end.

Axiom P : forall {T}, T -> Prop.

Ltac mkgoal n := constr:(P (fun x var => make_cps (T:=LIST NAT) (var:=var) n n (Ident (ident_literal x)) (@reify_list var))).
Ltac describe_goal n :=
  let n2 := (eval cbv in (n * n)) in
  idtac "Params: a-num-binders=" n2 ", n=" n.
Ltac redgoal _ := vm_compute.
Ltac get_term _ :=
  let preterm := lazymatch goal with |- P ?preterm => preterm end in
  let term := constr:(fun x => interp (@ident_interp) (preterm x _)) in
  term.
Ltac time_solve_goal0 n :=
  let term := get_term () in
  try (once (time "cbv" (idtac; let res := (eval cbv in term) in idtac)); fail);
  try (once (time "lazy" (idtac; let res := (eval cbv in term) in idtac)); fail).
Ltac run0 sz := Harness.runtests args_of_size describe_goal mkgoal redgoal time_solve_goal0 sz.
(*
Goal True. run0 SuperFast.
*)


(** * Machine architectures *)

From mathcomp Require Import ssreflect ssrbool ssrnat eqtype.

Module Type ARCH.
  Parameter wordsize : nat.
  Parameter wordsize_positive : wordsize > 0.
End ARCH.

Module AMD64 <: ARCH.
  Definition wordsize : nat := 64.
  Lemma wordsize_positive : wordsize > 0.
  Proof.
    exact: eqxx.
  Qed.
End AMD64.

Module X86 <: ARCH.
  Definition wordsize : nat := 32.
  Lemma wordsize_positive : wordsize > 0.
  Proof.
    exact: eqxx.
  Qed.
End X86.


(*
int crypto_scalarmult(u8 *q,const u8 *n,const u8 *p)
{
  u8 z[32];
  i64 x[80],r;
  int i;
  gf a,b,c,d,e,f;
  FOR(i,31) z[i]=n[i];
  z[31]=(n[31]&127)|64;
  z[0]&=248;
  unpack25519(x,p);
  FOR(i,16) {
    b[i]=x[i];
    d[i]=a[i]=c[i]=0;
  }
  a[0]=d[0]=1;
  for(i=254;i>=0;--i) {
    r=(z[i>>3]>>(i&7))&1;
    sel25519(a,b,r);
    sel25519(c,d,r);
    A(e,a,c);
    Z(a,a,c);
    A(c,b,d);
    Z(b,b,d);
    S(d,e);
    S(f,a);
    M(a,c,a);
    M(c,b,e);
    A(e,a,c);
    Z(a,a,c);
    S(b,a);
    Z(c,d,f);
    M(a,c,_121665);
    A(a,a,d);
    M(c,c,a);
    M(a,d,f);
    M(d,b,x);
    S(b,e);
    sel25519(a,b,r);
    sel25519(c,d,r);
  }
  FOR(i,16) {
    x[i+16]=a[i];
    x[i+32]=c[i];
    x[i+48]=b[i];
    x[i+64]=d[i];
  }
  inv25519(x+32,x+32);
  M(x+16,x+16,x+32);
  pack25519(q,x+16);
  return 0;
}
*)

Set Warnings "-notation-overridden,-parsing".
Require Import Tweetnacl.Libs.Export.
Require Import Tweetnacl_verif.init_tweetnacl.
Require Import Tweetnacl_verif.spec_sel25519.
Require Import Tweetnacl_verif.spec_unpack25519.
Require Import Tweetnacl_verif.spec_pack25519.
Require Import Tweetnacl_verif.spec_inv25519.
Require Import Tweetnacl_verif.spec_A.
Require Import Tweetnacl_verif.spec_Z.
Require Import Tweetnacl_verif.spec_S.
Require Import Tweetnacl_verif.spec_M.
Require Import Tweetnacl_verif.verif_crypto_scalarmult_lemmas.
Require Import Tweetnacl.Low.Get_abcdef.
Require Import Tweetnacl.Low.ScalarMult_rev.
Require Import Tweetnacl.Low.Constant.
Require Import Tweetnacl.Mid.Instances.
Require Import Tweetnacl.rfc.rfc.
Open Scope Z.

Import Low.

Definition crypto_scalarmult_spec :=
 DECLARE _crypto_scalarmult_curve25519_tweet
  WITH
    v_q: val, v_n: val, v_p: val, c121665:val,
    sh : share,
    q : list val,
    n : list Z,
    p : list Z
 PRE [ _q OF (tptr tuchar),
       _n OF (tptr tuchar), _p OF (tptr tuchar) ]
        PROP  (writable_share sh;
                Forall (fun x => 0 <= x < Z.pow 2 8) p;
                Forall (fun x => 0 <= x < Z.pow 2 8) n;
                Zlength q = 32;
                Zlength n = 32;
                Zlength p = 32)
        LOCAL(temp _q v_q; temp _n v_n; temp _p v_p; gvar __121665 c121665)
        SEP  (sh [{ v_q }] <<(uch32)-- q;
              sh [{ v_n }] <<(uch32)-- mVI n;
              sh [{ v_p }] <<(uch32)-- mVI p;
              Ews [{ c121665 }] <<(lg16)-- mVI64 C_121665)
  POST [ tint ]
        PROP (
                Forall (fun x => 0 <= x < Z.pow 2 8) (RFC n p);
                Zlength (RFC n p) = 32)
        LOCAL(temp ret_temp (Vint Int.zero))
        SEP (sh [{ v_q }] <<(uch32)-- mVI (RFC n p);
              sh [{ v_n }] <<(uch32)-- mVI n;
              sh [{ v_p }] <<(uch32)-- mVI p;
              Ews [{ c121665 }] <<(lg16)-- mVI64 C_121665
        ).

Definition crypto_scalarmult_Zinit_Inv F (L:list localdef) sh v_z n (contents_n:list Z) :=
  EX i : Z,
   PROP  (writable_share sh;
          Forall (fun x => 0 <= x < Z.pow 2 8) contents_n;
          Zlength contents_n = 32;
          i >= 0)
   (LOCALx L
   SEP   (FRZL F;
          Tsh [{ v_z }] <<(uch32)-- (list.take (nat_of_Z i) (map Vint (map Int.repr contents_n)) ++ list.drop (nat_of_Z i) undef32);
           sh [{  n  }] <<(uch32)-- mVI contents_n
          )).

Definition crypto_scalarmult_BDACinit_Inv F L sh v_x v_a v_b v_c v_d contents_x :=
  EX i : Z,
   PROP  (writable_share sh;
          Forall (fun x => 0 <= x < Z.pow 2 16) contents_x;
          Zlength contents_x = 16;
          i >= 0)
   (LOCALx L
   SEP   (FRZL F;
          Tsh [{ v_b }] <<(lg16)-- (list.take (nat_of_Z i) (mVI64 contents_x) ++ list.drop (nat_of_Z i) undef16) ;
          Tsh [{ v_a }] <<(lg16)-- (list.take (nat_of_Z i) (mVI64 nil16) ++ list.drop (nat_of_Z i) undef16) ;
          Tsh [{ v_c }] <<(lg16)-- (list.take (nat_of_Z i) (mVI64 nil16) ++ list.drop (nat_of_Z i) undef16) ;
          Tsh [{ v_d }] <<(lg16)-- (list.take (nat_of_Z i) (mVI64 nil16) ++ list.drop (nat_of_Z i) undef16) ;
          Tsh [{ v_x }] <<(lg16)-- mVI64 contents_x)).

Definition crypto_scalarmult_ladder_Inv F sh v_z v_x v_a v_b v_c v_d v_e v_f q z a b c d x c121665 :=
(* Loop Invariant *)
fun i:Z =>
  PROP (
    writable_share sh;
    Forall (fun x => 0 <= x < Z.pow 2 8) z;
    Forall (fun x => -38 <= x < Z.pow 2 16 + 38) a;
    Forall (fun x => -38 <= x < Z.pow 2 16 + 38) b;
    Forall (fun x => -38 <= x < Z.pow 2 16 + 38) c;
    Forall (fun x => -38 <= x < Z.pow 2 16 + 38) d;
    Forall (fun x => 0 <= x < Z.pow 2 16) x;
    Zlength z = 32;
    Zlength a = 16;
    Zlength b = 16;
    Zlength c = 16;
    Zlength d = 16;
    Zlength x = 16;
    -1 <= i <= 254
    )
  LOCAL ( (temp _i (Vint (Int.repr i))) ;
      lvar _f (tarray tlg 16) v_f; lvar _e (tarray tlg 16) v_e; lvar _d (tarray tlg 16) v_d;
      lvar _c (tarray tlg 16) v_c; lvar _b (tarray tlg 16) v_b; lvar _a (tarray tlg 16) v_a;
      lvar _x (tarray tlg 16) v_x; lvar _z (tarray tuchar 32) v_z; temp _q q;
      gvar __121665 c121665)
  SEP (FRZL F;
    Tsh [{ v_z }] <<(uch32)-- (map Vint (map Int.repr z));
    Tsh [{ v_a }] <<(lg16)-- (mVI64 (get_a (montgomery_fn List_Z_Ops (254 - i) 254 z a b c d nil16 nil16 x))) ;
    Tsh [{ v_b }] <<(lg16)-- (mVI64 (get_b (montgomery_fn List_Z_Ops (254 - i) 254 z a b c d nil16 nil16 x))) ;
    Tsh [{ v_c }] <<(lg16)-- (mVI64 (get_c (montgomery_fn List_Z_Ops (254 - i) 254 z a b c d nil16 nil16 x))) ;
    Tsh [{ v_d }] <<(lg16)-- (mVI64 (get_d (montgomery_fn List_Z_Ops (254 - i) 254 z a b c d nil16 nil16 x))) ;
    set_undef_array_sep Tsh 254 i (mVI64 (get_e (montgomery_fn List_Z_Ops (254 - i) 254 z a b c d nil16 nil16 x))) v_e;
    set_undef_array_sep Tsh 254 i (mVI64 (get_f (montgomery_fn List_Z_Ops (254 - i) 254 z a b c d nil16 nil16 x))) v_f;
    Tsh [{ v_x }] <<(lg16)-- mVI64 x;
    Ews [{ c121665 }] <<(lg16)-- (mVI64 C_121665)).

Definition crypto_scalarmult_ladder_PreIncInv F sh v_z v_x v_a v_b v_c v_d v_e v_f q z a b c d x c121665 :=
(* PreDec invariant *)
  fun i:Z =>
  PROP (
    writable_share sh;
    Forall (fun x => 0 <= x < Z.pow 2 8) z;
    Forall (fun x => -38 <= x < Z.pow 2 16 + 38) a;
    Forall (fun x => -38 <= x < Z.pow 2 16 + 38) b;
    Forall (fun x => -38 <= x < Z.pow 2 16 + 38) c;
    Forall (fun x => -38 <= x < Z.pow 2 16 + 38) d;
    Forall (fun x => 0 <= x < Z.pow 2 16) x;
    Zlength z = 32;
    Zlength a = 16;
    Zlength b = 16;
    Zlength c = 16;
    Zlength d = 16;
    Zlength x = 16;
    0 <= i <= 254
   )
  LOCAL ((temp _i (Vint (Int.repr i)));
      lvar _f (tarray tlg 16) v_f; lvar _e (tarray tlg 16) v_e; lvar _d (tarray tlg 16) v_d;
      lvar _c (tarray tlg 16) v_c; lvar _b (tarray tlg 16) v_b; lvar _a (tarray tlg 16) v_a;
      lvar _x (tarray tlg 16) v_x; lvar _z (tarray tuchar 32) v_z; temp _q q;
      gvar __121665 c121665)
   SEP (FRZL F;
    Tsh [{ v_z }] <<(uch32)-- (map Vint (map Int.repr z));
    Tsh [{ v_a }] <<(lg16)-- (mVI64 (get_a (montgomery_fn List_Z_Ops (254 - (i - 1)) 254 z a b c d nil16 nil16 x))) ;
    Tsh [{ v_b }] <<(lg16)-- (mVI64 (get_b (montgomery_fn List_Z_Ops (254 - (i - 1)) 254 z a b c d nil16 nil16 x))) ;
    Tsh [{ v_c }] <<(lg16)-- (mVI64 (get_c (montgomery_fn List_Z_Ops (254 - (i - 1)) 254 z a b c d nil16 nil16 x))) ;
    Tsh [{ v_d }] <<(lg16)-- (mVI64 (get_d (montgomery_fn List_Z_Ops (254 - (i - 1)) 254 z a b c d nil16 nil16 x))) ;
    Tsh [{ v_e }] <<(lg16)-- (mVI64 (get_e (montgomery_fn List_Z_Ops (254 - (i - 1)) 254 z a b c d nil16 nil16 x))) ;
    Tsh [{ v_f }] <<(lg16)-- (mVI64 (get_f (montgomery_fn List_Z_Ops (254 - (i - 1)) 254 z a b c d nil16 nil16 x))) ;
    Tsh [{ v_x }] <<(lg16)-- mVI64 x;
    Ews [{ c121665 }] <<(lg16)-- (mVI64 C_121665)).

Definition crypto_scalarmult_ladder_PostInv F sh v_z v_x v_a v_b v_c v_d v_e v_f q z a b c d x c121665 :=
(* Loop postcondition *)
 PROP (
    writable_share sh;
    Forall (fun x => 0 <= x < Z.pow 2 8) z;
    Forall (fun x => -38 <= x < Z.pow 2 16 + 38) a;
    Forall (fun x => -38 <= x < Z.pow 2 16 + 38) b;
    Forall (fun x => -38 <= x < Z.pow 2 16 + 38) c;
    Forall (fun x => -38 <= x < Z.pow 2 16 + 38) d;
    Forall (fun x => 0 <= x < Z.pow 2 16) x;
    Zlength z = 32;
    Zlength a = 16;
    Zlength b = 16;
    Zlength c = 16;
    Zlength d = 16;
    Zlength x = 16
  )
 LOCAL (
      lvar _f (tarray tlg 16) v_f; lvar _e (tarray tlg 16) v_e; lvar _d (tarray tlg 16) v_d;
      lvar _c (tarray tlg 16) v_c; lvar _b (tarray tlg 16) v_b; lvar _a (tarray tlg 16) v_a;
      lvar _x (tarray tlg 16) v_x; lvar _z (tarray tuchar 32) v_z; temp _q q;
      gvar __121665 c121665)
   SEP (FRZL F;
    Tsh [{ v_z }] <<(uch32)-- (map Vint (map Int.repr z));
    Tsh [{ v_a }] <<(lg16)-- (mVI64 (get_a (montgomery_fn List_Z_Ops 255 254 z a b c d nil16 nil16 x))) ;
    Tsh [{ v_b }] <<(lg16)-- (mVI64 (get_b (montgomery_fn List_Z_Ops 255 254 z a b c d nil16 nil16 x))) ;
    Tsh [{ v_c }] <<(lg16)-- (mVI64 (get_c (montgomery_fn List_Z_Ops 255 254 z a b c d nil16 nil16 x))) ;
    Tsh [{ v_d }] <<(lg16)-- (mVI64 (get_d (montgomery_fn List_Z_Ops 255 254 z a b c d nil16 nil16 x))) ;
    Tsh [{ v_e }] <<(lg16)-- (mVI64 (get_e (montgomery_fn List_Z_Ops 255 254 z a b c d nil16 nil16 x))) ;
    Tsh [{ v_f }] <<(lg16)-- (mVI64 (get_f (montgomery_fn List_Z_Ops 255 254 z a b c d nil16 nil16 x))) ;
    Tsh [{ v_x }] <<(lg16)-- mVI64 x;
    Ews [{ c121665 }] <<(lg16)-- (mVI64 C_121665)).


(** * Postscript *)

(** * Looking back... *)

(**  - _Functional programming_
          - "declarative" programming (recursion over persistent data
            structures)
          - higher-order functions
          - polymorphism *)

(**
     - _Logic_, the mathematical basis for software engineering:
<<
               logic                        calculus
        --------------------   =   ----------------------------
        software engineering       mechanical/civil engineering
>>

          - inductively defined sets and relations
          - inductive proofs
          - proof objects *)

(**
     - _Coq_, an industrial-strength proof assistant
          - functional core language
          - core tactics
          - automation
*)

(**
     - _Foundations of programming languages_

           - notations and definitional techniques for precisely specifying
                - abstract syntax
                - operational semantics
                    - big-step style
                    - small-step style
                - type systems

           - program equivalence

           - Hoare logic

           - fundamental metatheory of type systems

              - progress and preservation

           - theory of subtyping
*)

(* ###################################################################### *)
(** * Looking Forward *)

(** Some good places to go for more...

       - Several optional chapters of _Software Foundations_

       - Cutting-edge conferences on programming languages and formal
         verification:
            - POPL
            - PLDI
            - OOPSLA
            - ICFP
            - CAV
            - (and many others)

       - More on functional programming
            - Learn You a Haskell for Great Good, by Miran
              Lipovaca (ebook)
            - and many other texts on Haskell, OCaml, Scheme, Scala, ...

       - More on Hoare logic and program verification
            - The Formal Semantics of Programming Languages: An
              Introduction, by Glynn Winskel.  MIT Press, 1993.
            - Many practical verification tools, e.g. Microsoft's
              Boogie system, Java Extended Static Checking, etc.

       - More on the foundations of programming languages:
            - Types and Programming Languages, by Benjamin C. Pierce. MIT
              Press, 2002.
            - Practical Foundations for Programming Languages, by Robert
              Harper.  Forthcoming from MIT Press.  Manuscript available
              from his web page.
            - Foundations for Programming Languages, by John C. Mitchell.
              MIT Press, 1996.

       - More on Coq:
           - Certified Programming with Dependent Types, by Adam
             Chlipala.  A draft textbook on practical proof
             engineering with Coq, available from his web page.
           - Interactive Theorem Proving and Program Development:
             Coq'Art: The Calculus of Inductive Constructions, by Yves
             Bertot and Pierre Casteran.  Springer-Verlag, 2004.
           - Iron Lambda (http://iron.ouroborus.net/) is a collection
             of Coq formalisations for functional languages of
             increasing complexity. It fills part of the gap between
             the end of the Software Foundations course and what
             appears in current research papers.  The collection has
             at least Progress and Preservation theorems for a number
             of variants of STLC and the polymorphic
             lambda-calculus (System F)

*)

(* $Date: 2013-04-21 20:27:02 -0400 (Sun, 21 Apr 2013) $ *)


(* -*- coq-prog-args: ("-emacs" "-indices-matter" "-type-in-type") -*- *)

Require Export Utf8_core.
Require Import HoTT HoTT.hit.Truncations Connectedness.
Require Import Limit.
Require Import T.

Set Universe Polymorphism.
Global Set Primitive Projections.

Local Open Scope path_scope.
Local Open Scope type_scope.

Section T_telescope.

  Context {X Y: Type} (f: X -> Y).

  Definition Ttelescope_aux (n: nat) : {T: Type & T -> Y}.
    induction n as [|n [U g]].
    - exists X. exact f.
    - exists (T g).
      simple refine (T_rec _ _ _ _). exact g.
      intros a b; exact idmap.
      intro a; reflexivity.
  Defined.

  Definition Ttelescope : diagram mappingtelescope_graph.
    simple refine (Build_diagram _ _ _).
    - intros n. exact (Ttelescope_aux n).1.
    - intros n m q; destruct q; simpl. apply t.
  Defined.

  Definition Ttelescope_cocone : cocone Ttelescope Y.
  Proof.
    simple refine (Build_cocone _ _).
    intro i. apply (Ttelescope_aux i).2.
    intros i j g x; destruct g; reflexivity.
  Defined.

  Axiom Colimit_Ttelescope : IsSurjection f -> is_universal Ttelescope_cocone.

End T_telescope.


Require Import List.
Import ListNotations.
Require Import Lia.
Require Import Coq.Numbers.Natural.Peano.NPeano.
Require Import Coq.Bool.Bool.
From Coq.Arith Require Import Compare_dec Peano_dec Minus Plus Wf_nat.

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

Module EdfPolicyMod (J : JobsAxiomsMod) (Assms : AssumptionsMod J).
  Import J.
  Import Assms.

  Definition idleAt ( t : nat) := bforall (fun i => negb (run  i t)) N.

  Definition countersAt(t : nat) :=
    generic_sum (fun i => c i t) (fun _ => true) 0 N.

  Lemma idleAt_countersAt : forall t,
      idleAt  t = true ->  countersAt  (S t) = countersAt  t.
  Proof.
      intros  t Hidle.
      generalize (bforall_forall _ _ Hidle) ;
        clear Hidle; intro Hidle.
      unfold countersAt in *.
      erewrite generic_sum_f_eq
        with (f2 := fun k =>  c  k t); auto with arith.
      intros k _ HkSN _.
      rewrite c_constant_when_not_running ; auto.
      replace true with (negb false) in Hidle; auto.
      apply negb_inj.
      apply Hidle ; auto.
Qed.

  Lemma notidleAt_runAt : forall t,
      idleAt  t = false ->
      exists i, i < N /\ run i t = true /\
         forall j, j < N -> j <> i -> run  j t = false.
  Proof.
    unfold countersAt, idleAt ; intros.
    destruct (notbforall_exists _ _ H) as (i & HxN & Hnegb);
      clear H.
    replace false with (negb true) in Hnegb ; auto.
    apply negb_inj in Hnegb.
    exists i ; repeat split ; auto.
    intros.
    generalize (at_most_one_runs _ _ _ HxN H Hnegb) ; intro Habs.
    case_eq (run  j t) ; intro Hcas ; try reflexivity.
    rewrite Habs in H0 ; auto ; exfalso ; apply H0 ; reflexivity.
  Qed.

  Lemma runAt_countersAt :
    forall t,
      (exists i, i < N /\ run i t = true /\
         forall j, j < N -> j <> i -> run j t = false) ->
      S (countersAt  (S t)) = countersAt  t.
  Proof.
    intros  t (i & HiN & Hruntrue & Hrunfalse).
    unfold countersAt.
    rewrite generic_sum_index_split with (k :=i); auto with arith.
    symmetry.
    rewrite generic_sum_index_split with (k :=i); auto with arith.
    replace ( generic_sum (fun i0 : nat => c  i0 (S t)) (fun _ : nat => true) 0 i) with ( generic_sum (fun i0 : nat => c  i0 t) (fun _ : nat => true) 0 i).
    {
      replace (generic_sum (fun i0 : nat => c i0 (S t))
                           (fun _ : nat => true) (S i) N) with
        (generic_sum (fun i0 : nat => c  i0 t)
                     (fun _ : nat => true) (S i) N).
      {
        replace (S
    (generic_sum (fun i0 : nat => c i0 t)
       (fun _ : nat => true) 0 i + c  i (S t) +
     generic_sum (fun i0 : nat => c i0 t)
       (fun _ : nat => true) (S i) N))
          with
     (generic_sum (fun i0 : nat => c  i0 t)
       (fun _ : nat => true) 0 i + S (c  i (S t)) +
     generic_sum (fun i0 : nat => c  i0 t)
                 (fun _ : nat => true) (S i) N).
        {
          assert ( c  i t = S (c  i (S t))).
          {
            destruct (c_decreases_when_running  _ _ HiN Hruntrue).
            lia.
          }
          rewrite H; auto.

        }
        lia.
      }
      apply generic_sum_f_eq; auto with arith.
      intros k Hle HkN _ .
      rewrite c_constant_when_not_running ; auto.
      apply Hrunfalse; auto; try lia.
    }
     apply generic_sum_f_eq; auto with arith.
      intros k Hle HkN _ .
      rewrite c_constant_when_not_running ; auto ; try lia.
      apply Hrunfalse; auto; try lia.
 Qed.

   Lemma notidleAt_countersAt_aux : forall t,
      idleAt  t = false ->  S (countersAt (S t)) = countersAt t.
   Proof.
     intros; apply runAt_countersAt, notidleAt_runAt ; auto.
   Qed.

   Lemma notidleAt_countersAt_gt_0 : forall  t,
      idleAt  t = false ->  countersAt  t > 0.
   Proof.
     intros  t Hidle.
     generalize (notidleAt_countersAt_aux  _ Hidle) ; intro Haux.
     lia.
   Qed.

   Lemma notidleAt_countersAt : forall t,
      idleAt  t = false ->  countersAt (S t) = countersAt t -1.
   Proof.
     intros t Hidle.
     generalize (notidleAt_countersAt_aux  _ Hidle) ; intro Haux.
     lia.
  Qed.

  Definition idle( l r : nat) := generic_sum (fun _ => 1) (idleAt ) l r.

  Lemma idle_idleAt_grows : forall  l r,
      l <= r ->  idleAt r = true -> idle  l (S r) = S (idle l r).
  Proof.
    intros l r Hle Hidle.
    cbn.
    rewrite Hidle.
    replace (l <=? r) with true.
    * reflexivity.
    * symmetry; rewrite Nat.leb_le; auto.
  Qed.

  Lemma idle_notidleAt_stays : forall l r,
      l <= r ->  idleAt r = false -> idle l (S r) = idle l r.
  Proof.
    intros l r Hle Hidle.
    cbn.
    rewrite Hidle.
    reflexivity.
  Qed.

  Lemma idle_mono :  forall  l r, l <= r ->  idle  l r <= idle  l (S r).
  Proof.
    intros  l r Hle.
    case_eq (idleAt  r); intro Hidle.
    * rewrite idle_idleAt_grows; auto.
    * rewrite idle_notidleAt_stays; auto.
  Qed.

  Lemma idle_le_interval : forall l r, l <= r -> idle  l r <= r - l.
  Proof.
  intros l r Hle.
  induction Hle.
  * unfold idle;
    rewrite  generic_sum_eq; lia.
  * case_eq (idleAt  m); intro Hidle.
    +
      rewrite idle_idleAt_grows; auto; lia.
    +  rewrite idle_notidleAt_stays; auto; lia.
 Qed.

 Lemma countersAt_interval :  forall l r, l <= r -> countersAt r <= countersAt  l.
 Proof.
   intros l r Hle.
   induction Hle; auto.
   case_eq (idleAt m); intro Hidle.
   +  rewrite idleAt_countersAt; auto; lia.
   +  rewrite  notidleAt_countersAt; auto; lia.
 Qed.

 Lemma idle_lem_aux : forall  l r,
      l <= r -> r - l -  (idle l r)  =  (countersAt  l) -  (countersAt r) .
  Proof.
   intros l r Hle.
   induction Hle; intros.
    * unfold idle.
      rewrite  generic_sum_eq ; auto; lia.
    *  case_eq (idleAt  m); intro Hidle.
     +  rewrite idle_idleAt_grows, idleAt_countersAt; auto.
        rewrite <- IHHle.
        clear ;  lia.
     + rewrite idle_notidleAt_stays ; auto.
       rewrite  notidleAt_countersAt; auto.

       replace (countersAt  l - (countersAt  m - 1)) with
           (S (countersAt  l - countersAt  m )).
       -  generalize (countersAt_interval _ _ Hle); intro Hle0.
          generalize (notidleAt_countersAt_gt_0  m Hidle); intro Hgt0.
          generalize (idle_le_interval  _ _ Hle); intro Hle1.
          replace ( S m - l - idle  l m) with (S (m - l - idle  l m)).
          ** rewrite IHHle; reflexivity.
          ** rewrite subs1; auto.
             rewrite IHHle; lia.
       - generalize (notidleAt_countersAt_gt_0  m Hidle); intro Hgt0.
         generalize (countersAt_interval  _ _ Hle); intro Hle0.
         lia.
 Qed.

  Lemma idle_lem : forall  l r,
      l <= r -> idle  l r = r - l - ((countersAt l) - (countersAt r)).
  Proof.
    intros  l r Hle.
    generalize (idle_lem_aux  _ _ Hle); intro Haux.
    generalize (countersAt_interval  _ _ Hle); intro Hle0.
    generalize (idle_le_interval  _ _ Hle); intro Hle1.
    assert (r - l - idle  l r + idle  l r =  countersAt  l - countersAt  r + idle l r).
    * rewrite Haux; auto.
    * rewrite NPeano.Nat.sub_add in H ; auto.
      rewrite H.
      rewrite minus_plus; auto.
  Qed.

  Definition laterAt (t  r: nat) :=
    bexists (fun i => andb (run  i t) (r <? deadline(Jobs i) )) N.

  Definition ctrs_laterAt(t r : nat) :=
    generic_sum (fun i => c i t) (fun i =>  (r <? deadline(Jobs i) )) 0 N.

  Lemma not_laterAt_ctrs : forall t r,
      laterAt t r = false ->
      ctrs_laterAt (S t) r = ctrs_laterAt  t r.
 Proof.
      intros  t r Hlater.
      generalize (notbexists_forall _ _ Hlater) ; clear Hlater; intro Hlater.
      unfold ctrs_laterAt in *.
      erewrite generic_sum_f_eq
        with (f2 := fun k =>  c k t); auto with arith.
      intros k _ HkN Hdead.
      rewrite c_constant_when_not_running ; auto.
      specialize (Hlater _ HkN).
      rewrite Hdead in Hlater.
      rewrite  andb_false_iff in Hlater; intuition; discriminate.
 Qed.

  Lemma laterAt_runAt : forall t r,
      laterAt  t r = true ->
      exists i, i < N /\ run i t = true /\ r <? deadline(Jobs i)  = true
       /\   forall j, j < N -> j <> i -> run j t = false.
  Proof.
    unfold laterAt ; intros.
    destruct (bexists_exists _ _ H) as (i & HxN & Hnegb);
      clear H.
    rewrite andb_true_iff in Hnegb ; destruct Hnegb.

    exists i ; repeat split ; auto.
    intros.
    generalize (at_most_one_runs  _ _ _ HxN H1 H); intro Habs.
    case_eq (run  j t) ; intro Hcas ; try reflexivity.
    rewrite Hcas in Habs ; auto ; exfalso ; apply H2; rewrite Habs; reflexivity.
  Qed.

  Lemma runAt_ctrs_laterAt :
    forall t r,
      (exists i, i < N /\ run  i t = true /\ r <? deadline(Jobs i)  = true /\
         forall j, j < N -> j <> i -> run  j t = false) ->
      S ( ctrs_laterAt  (S t) r) =  ctrs_laterAt t r.
  Proof.
    intros  t r (i & HiN & Hruntrue & Hdead & Hrunfalse).
    unfold ctrs_laterAt.
    rewrite generic_sum_index_split with (k :=i); auto with arith.
    symmetry.
    rewrite generic_sum_index_split with (k :=i); auto with arith.
    replace (generic_sum (fun i0 : nat => c  i0 (S t))
                         (fun i0 : nat => r <? deadline (Jobs i0)) 0 i) with
        (generic_sum (fun i0 : nat => c  i0 t)
       (fun i0 : nat => r <? deadline (Jobs i0)) 0 i).
    {
      replace (generic_sum (fun i0 : nat => c  i0 (S t))
       (fun i0 : nat => r <? deadline (Jobs i0))
       (S i) N) with
        (generic_sum (fun i0 : nat => c  i0 t)
       (fun i0 : nat => r <? deadline (Jobs i0))
       (S i) N).
      {
        rewrite Hdead.
        replace (S
    (generic_sum (fun i0 : nat => c  i0 t)
       (fun i0 : nat => r <? deadline (Jobs i0)) 0 i +
     c  i (S t) +
     generic_sum (fun i0 : nat => c i0 t)
       (fun i0 : nat => r <? deadline (Jobs i0))
       (S i) N))
          with
    (generic_sum (fun i0 : nat => c  i0 t)
       (fun i0 : nat => r <? deadline (Jobs i0)) 0 i +
      S (c i (S t)) +
     generic_sum (fun i0 : nat => c i0 t)
       (fun i0 : nat => r <? deadline (Jobs i0))
       (S i) N).
        {
          assert ( c  i t = S (c  i (S t))).
          {
            destruct (c_decreases_when_running  _ _ HiN Hruntrue).
            lia.
          }
          rewrite H; auto.

        }
        lia.
      }
      apply generic_sum_f_eq; auto with arith.
      intros k Hle HkN _ .
      rewrite c_constant_when_not_running ; auto.
      apply Hrunfalse; auto; try lia.
    }
     apply generic_sum_f_eq; auto with arith.
      intros k Hle HkN _ .
      rewrite c_constant_when_not_running ; auto ; try lia.
      apply Hrunfalse; auto; try lia.
 Qed.

  Lemma  laterAt_ctrs_aux : forall t r,
      laterAt t r = true ->  S ( ctrs_laterAt  (S t) r) =  ctrs_laterAt  t r.
  Proof.
    intros ; apply runAt_ctrs_laterAt, laterAt_runAt; auto.
  Qed.

  Lemma laterAt_ctrs_gt_0 :  forall t r,
      laterAt t r = true ->  ctrs_laterAt t r > 0.
  Proof.
  intros; rewrite <- laterAt_ctrs_aux; auto; lia.
  Qed.

  Lemma  laterAt_ctrs : forall  t r,
      laterAt  t r = true ->  ctrs_laterAt  (S t) r =  ctrs_laterAt t r -1 .
  Proof.
    intros; symmetry; rewrite <- laterAt_ctrs_aux; auto; lia.
  Qed.

  Definition later ( r' l r : nat) :=
    generic_sum (fun _ => 1) (fun t => laterAt  t r') l r.

  Lemma laterAt_later_grows : forall  l r r' ,
      l <= r ->  laterAt  r r' = true -> later r' l (S r) = S (later r' l r).
  Proof.
    intros  l r r' Hle HlaterAt.
    cbn.
    rewrite HlaterAt.
    replace (l <=? r) with true.
    * reflexivity.
    * symmetry; rewrite Nat.leb_le; auto.
  Qed.

  Lemma notLaterAt_later_stays : forall  l r r',
      l <= r ->  laterAt  r r' = false -> later r' l (S r) = later  r' l r.
  Proof.
    intros l r r' Hle Hlat.
    cbn.
    rewrite Hlat.
    reflexivity.
  Qed.

  Lemma later_mono :  forall  l r r' , l <= r ->  later r' l r <= later r' l (S r).
  Proof.
    intros l r r' Hle.
    case_eq (laterAt r r'); intro Hlat.
    * rewrite laterAt_later_grows; auto.
    * rewrite notLaterAt_later_stays; auto.
  Qed.

  Lemma later_le_interval : forall l r r', l <= r -> later r' l r <= r - l.
  Proof.
  intros  l r r' Hle.
  induction Hle.
  * unfold later;
    rewrite  generic_sum_eq; lia.
  * case_eq (laterAt  m r'); intro Hlat.
    + rewrite laterAt_later_grows; auto ; lia.
    + rewrite notLaterAt_later_stays; auto; lia.
 Qed.

  Lemma ctrs_laterAt_interval :
    forall l r r', l <= r -> ctrs_laterAt r r'  <= ctrs_laterAt l r'.
 Proof.
   intros l r r' Hle.
   induction Hle; auto.
   case_eq (laterAt m r'); intro Hlat.
    + rewrite laterAt_ctrs; auto ; lia.
    + rewrite not_laterAt_ctrs; auto; lia.
 Qed.

  Lemma later_lem : forall  l r r',
      l <= r ->
      later r' l r =  ctrs_laterAt l r' -  ctrs_laterAt r r'.
  Proof.
   intros  l r r' Hle.
   induction Hle; intros.
   * unfold later.
      rewrite  generic_sum_eq ; auto; lia.
   *  case_eq (laterAt  m r'); intro Hlat.
    +  rewrite laterAt_ctrs, laterAt_later_grows ; auto.
      generalize ( laterAt_ctrs_gt_0 _ _ Hlat); intro Hgt.
      generalize (ctrs_laterAt_interval _ _ r' Hle); intro Hle'.
      rewrite IHHle; lia.
    + rewrite not_laterAt_ctrs, notLaterAt_later_stays ; auto.
  Qed.

  Definition earlyAt (t  r: nat) :=
    bexists (fun i => andb (run  i t) (deadline(Jobs i) <=? r )) N.

  Definition ctrs_earlyAt( t r : nat) :=
    generic_sum (fun i => c  i t) (fun i =>  (deadline(Jobs i) <=? r )) 0 N.

  Lemma not_earlyAt_ctrs : forall  t r,
      earlyAt  t r = false ->
      ctrs_earlyAt (S t) r = ctrs_earlyAt  t r.
 Proof.
      intros  t r Hearly.
      generalize (notbexists_forall _ _ Hearly) ; clear Hearly; intro Hearly.
      unfold ctrs_earlyAt in *.
      erewrite generic_sum_f_eq
        with (f2 := fun k =>  c  k t); auto with arith.
      intros k _ HkN Hdead.
      rewrite c_constant_when_not_running ; auto.
      specialize (Hearly _ HkN).
      rewrite Hdead in Hearly.
      rewrite  andb_false_iff in Hearly; intuition; discriminate.
 Qed.

  Lemma earlyAt_runAt : forall t r,
      earlyAt  t r = true ->
      exists i, i < N /\ run i t = true /\ deadline(Jobs i) <=? r  = true
       /\   forall j, j < N -> j <> i -> run  j t = false.
  Proof.
    unfold earlyAt ; intros.
    destruct (bexists_exists _ _ H) as (i & HxN & Hnegb);
      clear H.
    rewrite andb_true_iff in Hnegb ; destruct Hnegb.

    exists i ; repeat split ; auto.
    intros.
    generalize (at_most_one_runs  _ _ _ HxN H1 H); intro Habs.
    case_eq (run  j t) ; intro Hcas ; try reflexivity.
    rewrite Hcas in Habs ; auto ; exfalso ; apply H2; rewrite Habs; reflexivity.
  Qed.

  Lemma runAt_ctrs_earlyAt :
    forall t r,
      (exists i, i < N /\ run i t = true /\ deadline(Jobs i) <=? r = true /\
         forall j, j < N -> j <> i -> run  j t = false) ->
      S ( ctrs_earlyAt  (S t) r) =  ctrs_earlyAt t r.
   Proof.
    intros t r (i & HiN & Hruntrue & Hdead & Hrunfalse).
    unfold ctrs_earlyAt.
    rewrite generic_sum_index_split with (k :=i); auto with arith.
    symmetry.
    rewrite generic_sum_index_split with (k :=i); auto with arith.
    replace (generic_sum (fun i0 : nat => c i0 (S t))
                         (fun i0 : nat =>  deadline (Jobs i0) <=? r) 0 i) with
        (generic_sum (fun i0 : nat => c i0 t)
       (fun i0 : nat =>  deadline (Jobs i0) <=? r) 0 i).
    {
      replace (generic_sum (fun i0 : nat => c  i0 (S t))
       (fun i0 : nat =>  deadline (Jobs i0) <=? r)
       (S i) N) with
        (generic_sum (fun i0 : nat => c  i0 t)
       (fun i0 : nat =>  deadline (Jobs i0) <=? r)
       (S i) N).
      {
        rewrite Hdead.
        replace (S
    (generic_sum (fun i0 : nat => c  i0 t)
       (fun i0 : nat =>  deadline (Jobs i0) <=? r) 0 i +
     c  i (S t) +
     generic_sum (fun i0 : nat => c  i0 t)
       (fun i0 : nat =>  deadline (Jobs i0) <=? r)
       (S i) N))
          with
    (generic_sum (fun i0 : nat => c  i0 t)
       (fun i0 : nat =>  deadline (Jobs i0) <=? r) 0 i +
      S (c i (S t)) +
     generic_sum (fun i0 : nat => c  i0 t)
       (fun i0 : nat =>  deadline (Jobs i0) <=? r)
       (S i) N).
        {
          assert ( c  i t = S (c  i (S t))).
          {
            destruct (c_decreases_when_running  _ _ HiN Hruntrue).
            lia.
          }
          rewrite H; auto.

        }
        lia.
      }
      apply generic_sum_f_eq; auto with arith.
      intros k Hle HkN _ .
      rewrite c_constant_when_not_running ; auto.
      apply Hrunfalse; auto; try lia.
    }
     apply generic_sum_f_eq; auto with arith.
      intros k Hle HkN _ .
      rewrite c_constant_when_not_running ; auto ; try lia.
      apply Hrunfalse; auto; try lia.
 Qed.

  Lemma  earlyAt_ctrs_aux : forall  t r,
      earlyAt  t r = true ->  S ( ctrs_earlyAt  (S t) r) =  ctrs_earlyAt  t r.
  Proof.
    intros ; apply runAt_ctrs_earlyAt, earlyAt_runAt; auto.
  Qed.

  Lemma earlyAt_ctrs_gt_0 :  forall  t r,
      earlyAt t r = true ->  ctrs_earlyAt t r > 0.
  Proof.
  intros; rewrite <- earlyAt_ctrs_aux; auto; lia.
  Qed.

  Lemma  earlyAt_ctrs : forall  t r,
      earlyAt  t r = true ->  ctrs_earlyAt (S t) r =  ctrs_earlyAt  t r -1 .
  Proof.
    intros; symmetry; rewrite <- earlyAt_ctrs_aux; auto; lia.
  Qed.

  Definition early ( r' l r : nat) :=
    generic_sum (fun _ => 1) (fun t => earlyAt t r') l r.

  Lemma earlyAt_early_grows : forall  l r r' ,
      l <= r ->  earlyAt r r' = true -> early  r' l (S r) = S (early r' l r).
  Proof.
    intros l r r' Hle HearlyAt.
    cbn.
    rewrite HearlyAt.
    replace (l <=? r) with true.
    * reflexivity.
    * symmetry; rewrite Nat.leb_le; auto.
  Qed.

  Lemma notEarlyAt_early_stays : forall l r r',
      l <= r ->  earlyAt r r' = false -> early r' l (S r) = early r' l r.
  Proof.
    intros  l r r' Hle Hlat.
    cbn.
    rewrite Hlat.
    reflexivity.
  Qed.

  Lemma early_mono :  forall  l r r' , l <= r ->  early r' l r <= early r' l (S r).
  Proof.
    intros  l r r' Hle.
    case_eq (earlyAt  r r'); intro Hlat.
    * rewrite earlyAt_early_grows; auto.
    * rewrite notEarlyAt_early_stays; auto.
  Qed.

  Lemma early_le_interval : forall l r r', l <= r -> early r' l r <= r - l.
  Proof.
  intros l r r' Hle.
  induction Hle.
  * unfold early;
    rewrite  generic_sum_eq; lia.
  * case_eq (earlyAt m r'); intro Hlat.
    + rewrite earlyAt_early_grows; auto ; lia.
    + rewrite notEarlyAt_early_stays; auto; lia.
 Qed.

  Lemma ctrs_earlyAt_interval :
    forall l r r', l <= r -> ctrs_earlyAt r r'  <= ctrs_earlyAt l r' .
 Proof.
   intros l r r' Hle.
   induction Hle; auto.
   case_eq (earlyAt m r'); intro Hlat.
    + rewrite earlyAt_ctrs; auto ; lia.
    + rewrite not_earlyAt_ctrs; auto; lia.
 Qed.

  Lemma early_lem : forall  l r r',
      l <= r ->
      early r' l r =  ctrs_earlyAt l r' -  ctrs_earlyAt r r'.
  Proof.
   intros l r r' Hle.
   induction Hle; intros.
   * unfold early.
      rewrite  generic_sum_eq ; auto; lia.
   *  case_eq (earlyAt m r'); intro Hear.
    +  rewrite earlyAt_ctrs, earlyAt_early_grows ; auto.
      generalize ( earlyAt_ctrs_gt_0  _ _ Hear); intro Hgt.
      generalize (ctrs_earlyAt_interval _ _ r' Hle); intro Hle'.
      rewrite IHHle; lia.
    + rewrite not_earlyAt_ctrs, notEarlyAt_early_stays ; auto.
  Qed.

  Lemma idle_not_early :  forall  t r,
       idleAt t = true -> earlyAt t r = false.
  Proof.
    unfold idleAt, earlyAt ; intros t r; intro Hbfor.
    apply  forall_notbexists.
    intros i Hin.
    apply bforall_forall with (i:=i) in Hbfor; auto.
    rewrite andb_false_iff.
    left.
    replace true with (negb false) in Hbfor; auto.
    apply negb_inj ; auto.
  Qed.

  Lemma idle_not_later :  forall  t r,
      idleAt  t = true -> laterAt  t r = false.
   Proof.
    unfold idleAt, laterAt ; intros t r; intro Hbfor.
    apply  forall_notbexists.
    intros i Hin.
    apply bforall_forall with (i:=i) in Hbfor; auto.
    rewrite andb_false_iff.
    left.
    replace true with (negb false) in Hbfor; auto.
    apply negb_inj ; auto.
  Qed.

  Lemma early_not_idle :  forall  t r,
      earlyAt t r = true -> idleAt  t = false .
   Proof.
    unfold earlyAt, idleAt ; intros  t r; intro Hbfor.
    apply  exists_notbforall.
    apply bexists_exists in Hbfor; auto.
    destruct Hbfor as (i & HiN & Hrun).
    rewrite andb_true_iff in Hrun; destruct Hrun.
    exists i ; split; auto.
    rewrite H ; auto.
  Qed.

  Lemma early_not_later :  forall  t r,
      earlyAt t r = true -> laterAt t r = false .
  Proof.
    unfold earlyAt, laterAt ; intros t r; intro Hbfor.
    apply bexists_exists in Hbfor; auto.
    destruct Hbfor as (i & HiN & Hrun).
    rewrite andb_true_iff in Hrun; destruct Hrun.
    apply forall_notbexists; intros j HjN.
    rewrite andb_false_iff.
    generalize ( at_most_one_runs  _ _ _ HiN HjN H) ; intro Hij.
    case_eq (run j t) ; intro Hcas.
    * right.
      rewrite leb_le in H0.
      rewrite (Hij Hcas) in H0.
      rewrite PeanoNat.Nat.ltb_ge; auto.
   *  left; auto.
  Qed.

  Lemma later_not_idle :  forall  t r,
      laterAt t r = true -> idleAt  t = false .
   Proof.
    unfold laterAt, idleAt ; intros t r; intro Hbfor.
    apply  exists_notbforall.
    apply bexists_exists in Hbfor; auto.
    destruct Hbfor as (i & HiN & Hrun).
    rewrite andb_true_iff in Hrun; destruct Hrun.
    exists i ; split; auto.
    rewrite H ; auto.
  Qed.

  Lemma later_not_early :  forall  t r,
      laterAt t r = true -> earlyAt  t r = false.
   Proof.
    unfold earlyAt, laterAt ; intros  t r; intro Hbfor.
    apply bexists_exists in Hbfor; auto.
    destruct Hbfor as (i & HiN & Hrun).
    rewrite andb_true_iff in Hrun; destruct Hrun.
    apply forall_notbexists; intros j HjN.
    rewrite andb_false_iff.
    generalize ( at_most_one_runs  _ _ _ HiN HjN H) ; intro Hij.
    case_eq (run  j t) ; intro Hcas.
    * right.
      rewrite ltb_lt in H0.
      rewrite (Hij Hcas) in H0.
      rewrite PeanoNat.Nat.leb_gt; auto.
   *  left; auto.
  Qed.

  Lemma not_idle_not_later_early : forall t r,
    idleAt t  = false ->
    laterAt t r = false ->
    earlyAt t r = true.
  Proof.
  unfold idleAt, laterAt, earlyAt.
  intros t r Hidle Hlater.
  apply exists_bexists.
  apply notbforall_exists in Hidle.
  destruct Hidle as (i & HiN & Hrun).
  apply notbexists_forall with (i :=i) in Hlater; auto.
  rewrite andb_false_iff in Hlater.
  destruct Hlater as [Hlater | Hlater ].
  * rewrite Hlater in Hrun ;  discriminate.
  * exists i ; repeat split ; auto.
    rewrite andb_true_iff ; split.
   + replace false with (negb true) in Hrun ; auto; apply negb_inj;
     auto.
   + rewrite PeanoNat.Nat.ltb_ge in Hlater.
     rewrite leb_le; assumption.
Qed.

  Lemma idle_later_early :
    forall  l r r',
      l <= r -> r - l = idle l r + later r' l r + early  r' l r.
  Proof.
  intros l r r' Hle.
  induction Hle; intros.
  * unfold early, later, idle;
      repeat rewrite generic_sum_eq ; auto ; lia.
  *  rewrite idle_lem, later_lem, early_lem in *; auto.
     case_eq (idleAt  m) ; intro Hidle.
     { generalize (idle_not_early  _ r' Hidle) ; intro Hear.
       generalize (idle_not_later  _ r' Hidle) ; intro Hlat.
       rewrite  idleAt_countersAt in *; auto.
       rewrite not_laterAt_ctrs ; auto.
       rewrite not_earlyAt_ctrs ; auto.
       rewrite <- idle_lem, <- later_lem, <- early_lem in *; auto.
       replace (S m - l) with (S (m -l)) ; try lia.
       rewrite <- idle_lem_aux; auto.
       rewrite IHHle.
       lia; auto.
   }
   { case_eq (laterAt m r') ; intro Hlat.
     { generalize ( later_not_early  _ _ Hlat) ; intro Hear.
        rewrite  notidleAt_countersAt in *; auto.
        rewrite laterAt_ctrs in *; auto.
        rewrite not_earlyAt_ctrs in *; auto.
        rewrite <- idle_lem, <- later_lem, <- early_lem in *; auto.
        replace (S m - l) with (S (m -l)) ; [| lia].

        rewrite IHHle.
        replace (countersAt  l - (countersAt  m - 1)) with
            (S (countersAt l - countersAt m)).
       + rewrite <- idle_lem_aux; auto.
         replace (ctrs_laterAt  l r' - (ctrs_laterAt  m r' - 1))
           with (S (ctrs_laterAt  l r' - ctrs_laterAt  m r')).
         - rewrite IHHle.
           rewrite <- later_lem; auto.
            lia.
         - generalize ( laterAt_ctrs_gt_0   _ _ Hlat) ;
           intro Hc.
           generalize (ctrs_laterAt_interval  _ _ r' Hle);
           intro Hc'.
          lia.
      + generalize ( notidleAt_countersAt_gt_0  _ Hidle) ;
        intro Hc.
        generalize (countersAt_interval  _ _  Hle);
               intro Hc'.
        lia.
      }
     {
       generalize ( not_idle_not_later_early  _ _ Hidle Hlat) ;
         intro Hear.
        rewrite  notidleAt_countersAt in *; auto.
        rewrite not_laterAt_ctrs in *; auto.
        rewrite earlyAt_ctrs in *; auto.
        rewrite <- idle_lem, <- later_lem, <- early_lem in *; auto.
        replace (S m - l) with (S (m -l)) ; [| lia].
         replace (countersAt  l - (countersAt  m - 1)) with
            (S (countersAt l - countersAt  m)).
       + rewrite <- idle_lem_aux; auto.
         replace (ctrs_earlyAt  l r' - (ctrs_earlyAt m r' - 1))
           with (S (ctrs_earlyAt  l r' - ctrs_earlyAt  m r')).
         - rewrite IHHle.
           rewrite <- early_lem; auto.
           lia.
         - generalize (earlyAt_ctrs_gt_0   _ _ Hear) ;
           intro Hc.
           generalize (ctrs_earlyAt_interval _ _ r' Hle);
           intro Hc'.
          lia.
      + generalize ( notidleAt_countersAt_gt_0  _ Hidle) ;
        intro Hc.
        generalize (countersAt_interval _ _  Hle);
               intro Hc'.
        lia.
     }
   }
  Qed.

  Definition waiting(i t : nat)  :=
    i < N /\ arrival (Jobs i) <= t /\ c i t > 0 /\ run i t = false.

  (*
  Definition EdfPolicyUpTo(r : nat) :=
    forall (N i t : nat),
      i < N -> t <= r -> run N  i t = true ->
      forall (j : nat),
            waiting N j t -> deadline (Jobs i) <= deadline (Jobs j).
   *)

  Definition EdfPolicyUpTo(r : nat) :=
     forall i t, i < N -> t <= r -> run  i t = true ->
      forall (j : nat),
        waiting  j t -> deadline (Jobs i) <= deadline (Jobs j).

  Definition EdfPolicy := forall r, EdfPolicyUpTo  r.

  Definition DBF( l r : nat) :nat :=
    generic_sum
      (fun i => duration (Jobs i))
      (fun i =>  (deadline (Jobs i) <=? r)&& (l <=? arrival(Jobs i)))
      0 N.

   Lemma eq1 : forall l r , l <= r ->
    r - l  +  generic_sum (fun i => c  i r) (
                            fun i =>  (deadline(Jobs i) <=? r)) 0 N
    = idle l r + later  r l r +
             generic_sum (fun i => c i l)
                         (fun i =>  (deadline(Jobs i) <=? r)) 0 N.
  Proof.
    intros l r Hle.
    rewrite  idle_later_early with (r' := r); auto.
    repeat rewrite <- Nat.add_assoc.
    repeat rewrite Nat.add_cancel_l.
    rewrite plus_comm.
    rewrite early_lem; auto.
    erewrite le_plus_minus; eauto.
    apply ctrs_earlyAt_interval ; auto.
Qed.

  Lemma eq2_aux : forall l r,
    generic_sum (fun i => c  i l)
                (fun i =>  (deadline(Jobs i) <=? r)) 0 N =
    generic_sum (fun i => c i l)
                (fun i =>  (deadline(Jobs i) <=? r) &&
                           (arrival (Jobs i) <? l)) 0 N +
    generic_sum (fun i => c  i l)
                (fun i =>  (deadline(Jobs i) <=? r) &&
                           (l <=? arrival (Jobs i))) 0 N.
  Proof.
    intros  l r.
    replace (generic_sum (fun i : nat => c  i l)
    (fun i : nat =>
     (deadline (Jobs i) <=? r) &&
     (l <=? arrival (Jobs i))) 0 N) with
    (generic_sum (fun i : nat => c  i l)
    (fun i : nat =>
     (deadline (Jobs i) <=? r) &&
     negb  (arrival (Jobs i) <? l)) 0 N).
    * apply  generic_sum_split ; auto with arith.
    * apply generic_sum_filter_eq ; auto with arith.
      intros.

      assert (Heq :  negb (arrival (Jobs k) <? l) =  (l <=? arrival (Jobs k))).
     + case_eq (l <=? arrival (Jobs k)); intro Hcas.
        - rewrite leb_le in Hcas.
          assert (Hf : (arrival (Jobs k) <? l = false)) ; [ | rewrite  Hf;auto ].
          rewrite PeanoNat.Nat.ltb_ge ; auto.
        - rewrite PeanoNat.Nat.leb_gt in Hcas.
          replace false with (negb true); auto.
          assert (Hf : (arrival (Jobs k) <? l = true)) ; [ | rewrite  Hf;auto ].
          apply ltb_lt; auto.
     + rewrite Heq ; auto.
Qed.

  Lemma eq3_aux : forall  l r,  generic_sum (fun i => c  i l)
                (fun i =>  (deadline(Jobs i) <=? r) &&
                           (l <=? arrival (Jobs i))) 0 N = DBF  l r.
  Proof.
    intros l r.
    apply  generic_sum_f_eq ; auto with arith.
    intros k H0K HkN Heq.
    rewrite andb_true_iff in Heq.
    destruct Heq as (Heq1 & Heq2).
    rewrite leb_le in Heq1, Heq2.
    eapply  c_is_duration_upto_arrival; eauto.
  Qed.

 Lemma eq3 :  forall  l r, l <= r ->
      r - l +  generic_sum (fun i => c i r) (
                             fun i =>  (deadline(Jobs i) <=? r)) 0 N
      = idle l r + later r l r + DBF  l r +
             generic_sum (fun i => c  i l)
             (fun i =>  (deadline(Jobs i) <=? r) &&  (arrival (Jobs i) <? l)) 0 N.
  Proof.
    intros l r Hle.
    rewrite eq1 ; auto.
    (* repeat rewrite <- plus_assoc ; auto.
    rewrite Nat.add_cancel_l.*)
    rewrite <- eq3_aux, eq2_aux;  lia.
  Qed.

  Lemma min_eq3_aux :  forall l r,
      l <= r ->
      exists l',
        (l' <= l /\ idle  l' r = idle  l r /\ later  r l' r = later r l r) /\
        forall l'',
          l'' <= l ->  idle l'' r = idle  l r -> later  r l'' r = later r l r ->
                       ~ (l'' < l').
  Proof.
    intros  l r Hle.
    assert
      (Hex :
         exists l0,
           l0 <= l /\ idle l0 r = idle  l r /\ later r l0 r = later  r l r);
      [now exists l |].
    generalize ( nonempty_set_minimal_elt _ _ lt_wf
     (fun x => x <= l /\ idle x r = idle l r /\ later r x r = later r l r) Hex) ;
      clear Hex; intro Hex.
    destruct Hex as (y & (Hly & Hi & Hl) & Hz).
    exists y ; repeat split ; auto.
  Qed.

    Lemma min_eq3 : forall  l r,
      l <= r ->   EdfPolicyUpTo r ->
      exists l', l' <= l /\ idle  l' r = idle l r /\ later r l' r = later r l r /\
         r - l' + ctrs_earlyAt r r = idle l r + later r l r + DBF l' r .
  Proof.
    intros  l r Hle Hedf.
    destruct (min_eq3_aux _ _ Hle) as  (y & (Hly & Hi & Hl) & Hz).
    exists y ; repeat split ; auto.
    rewrite eq3; try lia.
    unfold  ctrs_earlyAt.
    case_eq (generic_sum (fun i : nat => c i y)
    (fun i : nat =>
     (deadline (Jobs i) <=? r) &&
     (arrival (Jobs i) <? y)) 0 N) ; intros.
      * rewrite Hi,Hl; auto.
      * exfalso.
        destruct y.
    +rewrite
       generic_sum_filter_eq with (filter2 := fun _ => false) in H;
       auto with arith.
      - rewrite generic_sum_0 in H; auto with arith.
        discriminate.
      -  intros K Hk0 HkN.
         rewrite andb_false_iff.
         right.
         rewrite NPeano.Nat.ltb_ge ; auto with arith.
         + (* from H : at y there is an active task with deadline <= r *)
           assert (Hgen : generic_sum (fun i : nat => c i y)
        (fun i : nat =>
         (deadline (Jobs i) <=? r) &&
         (arrival (Jobs i) <? S y)) 0 N >= S n).
           {rewrite <- H.
             apply generic_sum_f_ge; auto with arith.
             intros k  Hk0 HkN.
             case_eq (run k y) ; intro Hcas.
             * destruct ( c_decreases_when_running  _ _ HkN Hcas); lia.
             *rewrite c_constant_when_not_running; auto with arith.
           }
           clear H.
           replace (generic_sum (fun i : nat => c   i y)
           (fun i : nat =>
            (deadline (Jobs i) <=? r) &&
            (arrival (Jobs i) <? S y)) 0 N)
            with (generic_sum (fun i : nat => c i y)
           (fun i : nat =>
            (deadline (Jobs i) <=? r) &&
            (arrival (Jobs i) <=?  y)) 0 N) in Hgen.
           {
             assert (Hex :  exists j, j < N /\ run j y = true).
             {
               apply sum_arrived_some_running.
               unfold sum_counters_arrived.
               assert
                 (Hge: generic_sum (fun i : nat => c  i y)
                               (fun i : nat =>
                                  arrival (Jobs i) <=? y) 0 N >=
                   generic_sum (fun i : nat => c  i y)
                               (fun i : nat =>
            (deadline (Jobs i) <=? r) && (arrival (Jobs i) <=? y))
                               0 N).
               {
                 apply  generic_sum_filter_ge; auto with arith.
               }
             lia.
             }
            destruct Hex as ( j & HjN & Hrun).

           assert (Hyl : y <=l) ; try lia.
           apply  (Hz _ Hyl) ; try lia.
            (* amounts to prove not idle at y : *)
             (* because  at y there is a running task  *)
             - rewrite <- Hi.
               unfold idle.
               rewrite generic_sum_rev_le_S; try lia.
               unfold idleAt.
               rewrite exists_notbforall; auto.
               exists j; split; auto.
               rewrite Hrun ; auto.

               -(* amounts to prove no job with deadline > r runs at y : *)
                (* because  at y there is an active task with deadline <= r
                and by edf policy assumption.*)
               rewrite <- Hl.
               unfold later.
               rewrite generic_sum_rev_le_S; try lia.
               unfold laterAt.
               rewrite forall_notbexists ; auto.
               intros i HiN.
               rewrite andb_false_iff.
               case (Nat.eq_dec i j) ; intros ; subst.
               **   right.
                    assert (Hgen' : generic_sum (fun i : nat => c i y)
                           (fun i : nat =>
                            (deadline (Jobs i) <=? r) &&
                            (arrival (Jobs i) <=? y)) 0 N > 0);
                      try lia; clear Hgen.
                    apply  generic_sum_gt_0_ex in Hgen' ;
                      auto with arith.
                    destruct Hgen' as (k & HkN & Hk  &Hc).
                    rewrite andb_true_iff in Hk.
                    destruct Hk as (Hded & Harr).
                    unfold EdfPolicyUpTo in Hedf.

                    assert (Hyr : y <= r) ; try lia.

                    specialize (Hedf  j y HjN Hyr Hrun k).
                    unfold waiting in Hedf.
                    case_eq (run  k y); intro Hcas.
                   ++
                    generalize
                      (at_most_one_runs _ _ y HiN HkN Hrun Hcas);
                      intro ; subst.
                    rewrite leb_le in Hded.
                    rewrite  NPeano.Nat.ltb_ge; auto.
                   ++  rewrite leb_le in Harr.
                        assert
                         (Hded': deadline (Jobs j) <=
                                 deadline (Jobs k));
                         [apply Hedf; repeat split ; auto|].
                        rewrite leb_le in Hded.
                    rewrite  NPeano.Nat.ltb_ge; auto; lia.

               **   left.
                    generalize (at_most_one_runs  _ _ y HiN HjN); intro Htm.
                    rewrite Hrun in Htm ; cbn in Htm.
                    case_eq (run  i y) ; intro Hcas; auto.
                    rewrite Htm in n0; auto ; lia.

           }
           {
             apply generic_sum_filter_eq ; auto with arith.
           }
   Qed.

  Definition overdue(i t : nat) :=
    i < N /\ c i t > 0 /\ deadline(Jobs i) <= t.

  Lemma overdue_not_idle : forall i r,  overdue i r ->  idleAt r = false.
  Proof.
  unfold overdue, idleAt.
  intros i r (Hi & Hc & Hded).
  apply exists_notbforall.
  assert (Harr : arrival (Jobs i) <= r).
  {
    generalize ( job_arrival_plus_duration_le_deadline i); intro; lia.
  }
  assert (Hrun : exists j, j < N /\ run  j r = true).
  {
    apply sum_arrived_some_running.
    apply generic_sum_rev_gt_0_ex; auto with arith.
    exists i ; repeat split ; auto with arith.
    rewrite leb_le; auto.
  }
  destruct Hrun as (j & Hj & Hrun).
  exists j ; split ; auto.
  rewrite Hrun ; auto.
  Qed.

  Lemma overdue_not_later :
    forall  i r,
      overdue  i r ->
      EdfPolicyUpTo r ->
      laterAt r r = false.

  Proof.
  unfold overdue, laterAt, EdfPolicyUpTo.
  intros i r  (Hi & Hc & Hded) Hedf.
   assert (Harr : arrival (Jobs i) <= r).
  {
    generalize ( job_arrival_plus_duration_le_deadline i); intro; lia.
  }
  assert (Hrun : exists j, j < N /\ run j r = true).
  {
    apply sum_arrived_some_running.
    apply generic_sum_rev_gt_0_ex; auto with arith.
    exists i ; repeat split ; auto with arith.
    rewrite leb_le; auto.
  }
  destruct Hrun as (j & Hj & Hrun).
  assert (Hr : r <=r); auto.
  specialize (Hedf  _ _ Hj Hr Hrun); clear Hr.
  apply forall_notbexists.
  intros.
  rewrite andb_false_iff.
  case (Nat.eq_dec i j); intros ; subst.
  *  case (Nat.eq_dec i0 j); intros ; subst.
     + right.
       rewrite NPeano.Nat.ltb_ge ; auto with arith.
     + left.
       case_eq (run  i0 r) ; intros ; auto.
       exfalso; apply n.
       apply at_most_one_runs with (t:=r) ; auto.
  * specialize (Hedf i).
    case_eq (run  i r) ; intros.
     + exfalso; apply n.
       eapply at_most_one_runs; eauto.
     +
    unfold waiting in Hedf.
    assert (Hded' : deadline (Jobs j) <=  deadline (Jobs i));
      [ apply Hedf; repeat split; auto |].
     case (Nat.eq_dec i0 j); intros ; subst.
      -  right.
         rewrite NPeano.Nat.ltb_ge ; lia.
      -   case_eq (run i0 r) ; intros ; auto.
       exfalso; apply n.
       assert (j = i0); [eapply at_most_one_runs; eauto |]; subst; lia.
  Qed.

  Definition feasible := forall l r,l <= r -> DBF l r <= r - l.

  Theorem EdfPolicyMainTheorem :
    feasible ->
    forall ( i r: nat),
      EdfPolicyUpTo  r -> ~overdue  i r.
  Proof.
   intros Hsched  i r Hedf Hover.
   generalize (overdue_not_idle  _ _ Hover) ; intro HidleAt.
   generalize (overdue_not_later  _ _ Hover Hedf) ; intro HlaterAt.
   assert (Hr : r <= r)  ; auto.
   generalize (min_eq3  _ _ Hr Hedf) ; intro Hmin.
   destruct Hmin as (l' & Hl'r & Hidleeq & Hlatereq & Hdiff).
   assert (His0: idle  r r = 0) ; [rewrite idle_lem ; auto ; lia |].
   rewrite His0 in Hdiff ; cbn in Hdiff; clear His0.
   assert (His0: later r r r = 0) ; [rewrite later_lem ; auto ; lia |].
   rewrite His0 in Hdiff ; cbn in Hdiff; clear His0.
   generalize (not_idle_not_later_early  _ _ HidleAt HlaterAt); intro Hearly.
   generalize (earlyAt_ctrs_gt_0 _ _ Hearly); intro Hgt.
   specialize (Hsched  _ _ Hl'r).
   lia.
 Qed.

End EdfPolicyMod.


From Undecidability.H10 Require Export H10.
From Undecidability.H10.Dio Require Import dio_single.

From Coq Require Import List Vector Nat.
Import ListNotations Vector.VectorNotations.

Definition Diophantine' {k} (R : Vector.t nat k -> nat -> Prop) : Prop :=
  Diophantine (fun v : Vector.t nat (S k) =>
   match v with cons _ m n v => fun R : Vector.t nat n -> nat -> Prop =>
     R v m
   end R).

Definition functional {X Y} (R : X -> Y -> Prop) :=
  forall x y1 y2, R x y1 -> R x y2 -> y1 = y2.