Require Import Coq.Lists.List.
Require Import Coq.Sorting.Permutation.
Require Import Coq.Relations.Relations.
Require Import Coq.Classes.Morphisms.
Require Import Coq.Setoids.Setoid.
Require Import Coq.Wellfounded.Wellfounded.
Require Import Coq.Arith.Arith.
Require Import omega.Omega.
Require Import MyPermutations.

Section MultisetOrdering.

Hypothesis A:Type.
Hypothesis R: relation A.
Hypothesis R_wf: well_founded R.

Definition multiset_ordering(L1 L2:list A):Prop :=
  exists LH LT1 LT2,
    (Permutation L1 (LH ++ LT1) /\
     Permutation L2 (LH ++ LT2)) /\
    (LT2 <> nil) /\
    forall P1:A, In P1 LT1 ->
      exists P2:A, In P2 LT2 /\
        R P1 P2.

Global Instance multiset_ordering_comp:
  Proper (@Permutation A ==> @Permutation A ==> iff)
    multiset_ordering.
Proof.
unfold Proper, respectful.
intros L1A L1B H1 L2A L2B H2.
split.
- intros (LH,(LT1,(LT2,((HL1,HL2),H)))).
  exists LH,LT1,LT2.
  split.
  + rewrite <-H1.
    rewrite <-H2.
    exact (conj HL1 HL2).
  + exact H.
- intros (LH,(LT1,(LT2,((HL1,HL2),H)))).
  exists LH,LT1,LT2.
  split.
  + rewrite H1.
    rewrite H2.
    exact (conj HL1 HL2).
  + exact H.
Qed.

Instance multiset_ordering_Acc_comp:
  Proper (@Permutation A ==> iff)
    (Acc multiset_ordering).
Proof.
unfold Proper, respectful.
intros LA LB Heq.
split.
- intros H.
  induction H.
  exists.
  intros y Hy.
  apply H.
  rewrite Heq.
  exact Hy.
- intros H.
  induction H.
  exists.
  intros y Hy.
  apply H.
  rewrite <-Heq.
  exact Hy.
Qed.

Theorem multiset_ordering_wf: well_founded multiset_ordering.
Proof.
intros KL.
induction KL.
- exists.
  intros L (LH,(LT1,(LT2,((HL1,HL2),(HLI,HLA))))).
  apply Permutation_nil in HL2.
  apply app_eq_nil in HL2.
  destruct HL2 as (_,HL2).
  congruence.
- revert KL IHKL.
  induction a as (a,IHa) using (well_founded_ind R_wf).
  intros KL IHKL.
  remember IHKL as IHKL'; clear HeqIHKL'.
  induction IHKL as (KL,IHKL,IHIHKL).
  exists.
  intros L IHL.
  destruct (id IHL) as (LH,(LT1,(LT2,((HL1,HL2),(HLI,HLA))))).
  assert (Ha := in_eq a KL).
  rewrite HL2 in Ha.
  rewrite in_app_iff in Ha.
  destruct Ha as [Ha|Ha].
  + destruct (in_split _ _ Ha) as (LH1,(LH2,HLH)).
    rewrite HLH in HL1, HL2.
    clear LH Ha HLH.
    setoid_replace ((LH1 ++ a :: LH2) ++ LT2)
        with       (a :: (LH1 ++ LH2) ++ LT2)
        using relation (@Permutation A) in HL2; [|perm].
    apply Permutation_cons_inv in HL2.
    setoid_replace ((LH1 ++ a :: LH2) ++ LT1)
        with       (a :: (LH1 ++ LH2) ++ LT1)
        using relation (@Permutation A) in HL1; [|perm].
    remember (LH1 ++ LH2) as LH'; clear LH1 LH2 HeqLH'.
    rewrite HL1.
    apply IHIHKL.
    * rewrite HL2.
      exists LH',LT1,LT2.
      split.
      { split; reflexivity. }
      split.
      { exact HLI. }
      exact HLA.
    * apply IHKL.
      exists LH',LT1,LT2.
      {
        split.
        - split.
          + reflexivity.
          + exact HL2.
        - split.
          + exact HLI.
          + exact HLA.
      }
  + destruct (in_split _ _ Ha) as (LT2A,(LT2B,HLT2)).
    assert (HLT2' : Permutation LT2 (a :: LT2A ++ LT2B)) by (rewrite HLT2; perm).
    remember (LT2A ++ LT2B) as LT2'.
    clear LT2A LT2B Ha HLT2 HeqLT2'.
    rewrite HLT2' in HL2.
    clear HLI.
    assert (HLA2:
        forall P1:A, In P1 LT1 -> exists P2:A, In P2 (a::LT2') /\ R P1 P2).
    {
      intros P1 HP1.
      specialize (HLA P1 HP1).
      destruct HLA as (P2,(HP2A,HP2B)).
      exists P2.
      split; [|exact HP2B].
      rewrite <-HLT2'.
      exact HP2A.
    }
    clear LT2 HLT2' HLA.
    setoid_replace (LH ++ a :: LT2')
        with       (a :: LH ++ LT2')
        using relation (@Permutation A) in HL2; [|perm].
    apply Permutation_cons_inv in HL2.

    assert (HLA3:
        exists LT1H LT1T,
          Permutation LT1 (LT1H++LT1T) /\
          (forall P1H, In P1H LT1H -> R P1H a) /\
          (forall P1, In P1 LT1T -> exists P2:A, In P2 LT2' /\ R P1 P2)).
    {
      clear HL1.
      induction LT1.
      - exists nil,nil.
        split.
        + reflexivity.
        + split.
          * intros P1H [].
          * intros P1 [].
      - destruct IHLT1 as (LT1H,(LT1T,(HLT1P,(HLT1H,HLT1T)))).
        {
          intros P1 HP1.
          apply HLA2.
          right.
          exact HP1.
        }
        destruct (HLA2 _ (in_eq _ _)) as (P2,([HP2A|HP2A],HP2B)).
        + exists (a0::LT1H),LT1T.
          split.
          {
            apply Permutation_cons.
            exact HLT1P.
          }
          split.
          * intros P1H [HP1H|HP1H].
            {
              rewrite <-HP1H.
              rewrite HP2A.
              exact HP2B.
            }
            apply HLT1H.
            exact HP1H.
          * exact HLT1T.
        + exists LT1H,(a0::LT1T).
          split.
          {
            rewrite HLT1P; perm.
          }
          split.
          * exact HLT1H.
          * intros P1 [HP1|HP1].
            {
              exists P2.
              split.
              - exact HP2A.
              - rewrite <-HP1.
                exact HP2B.
            }
            apply HLT1T.
            exact HP1.
    }
    clear HLA2.
    destruct HLA3 as (LT1H,(LT1T,(HLT1P,(HLT1H,HLT1T)))).
    rewrite HLT1P in HL1.
    setoid_replace (LH++LT1H++LT1T) with (LT1H++LH++LT1T)
        using relation (@Permutation A) in HL1; [|perm].
    clear LT1 HLT1P.
    clear IHL.
    revert L HL1.
    induction LT1H.
    * intros L HL1.
      assert (LT1T_nilselect: LT1T = nil \/ LT1T <> nil).
      {
        destruct LT1T.
        - left; reflexivity.
        - right; congruence.
      }
      destruct LT1T_nilselect as [LT1T_nil|LT1T_nonnil].
      {
        rewrite LT1T_nil in HL1.
        rewrite app_nil_r in HL1.
        rewrite app_nil_l in HL1.
        clear LT1T HLT1T LT1T_nil.
        rewrite <-HL1 in HL2.
        clear LH HL1.
        {
          destruct LT2'.
          - rewrite app_nil_r in HL2.
            rewrite <-HL2.
            exact IHKL'.
          - apply IHKL.
            exists L,nil,(a0::LT2').
            {
              split.
              - split.
                + rewrite app_nil_r.
                  reflexivity.
                + exact HL2.
              - split.
                + congruence.
                + intros P1 [].
            }
        }
      }
      assert (HMO: multiset_ordering L KL).
      {
        exists LH,LT1T,LT2'.
        split.
        - exact (conj HL1 HL2).
        - split.
          + destruct LT1T as [|LT1Th LT1T].
            * congruence.
            * destruct LT2' as [|LT2h' LT2']; [|congruence].
              destruct (HLT1T _ (in_eq _ _)) as (P2,([],_)).
          + intros P1 HP1.
            apply HLT1T.
            exact HP1.
      }
      clear HL1.
      revert L HMO.
      refine (match _ with Acc_intro x => x end).
      exact IHKL'.
    * intros L HL1.
      assert (Ha0in := in_eq a0 (LT1H++LH++LT1T)).
      rewrite <-HL1 in Ha0in.
      destruct (in_split _ _ Ha0in) as (LT1A,(LT1B,HLT1)).
      rewrite HLT1.
      rewrite HLT1 in HL1.
      clear L Ha0in HLT1.
      setoid_replace (LT1A++a0::LT1B) with (a0::LT1A++LT1B)
          using relation (@Permutation A) in HL1; [|perm].
      setoid_replace (LT1A++a0::LT1B) with (a0::LT1A++LT1B)
          using relation (@Permutation A); [|perm].
      apply Permutation_cons_inv in HL1.
      apply IHa.
      {
        apply HLT1H.
        apply in_eq.
      }
      apply IHLT1H.
      {
        intros P1H HP1H.
        apply HLT1H.
        right.
        exact HP1H.
      }
      exact HL1.
Qed.

End MultisetOrdering.


Require Export GeoCoq.Elements.OriginalProofs.proposition_01.
Require Export GeoCoq.Elements.OriginalProofs.proposition_03.
Require Export GeoCoq.Elements.OriginalProofs.lemma_interior5.
Require Export GeoCoq.Elements.OriginalProofs.lemma_twolines.

Section Euclid.

Context `{Ax:euclidean_neutral_ruler_compass}.

Lemma proposition_10 :
   forall A B,
   neq A B ->
   exists X, BetS A X B /\ Cong X A X B.
Proof.
intros.
let Tf:=fresh in
assert (Tf:exists C, (equilateral A B C /\ Triangle A B C)) by (conclude proposition_01);destruct Tf as [C];spliter.
assert (nCol A B C) by (conclude_def Triangle ).
assert ((Cong A B B C /\ Cong B C C A)) by (conclude_def equilateral ).
assert (Cong A C C B) by (forward_using lemma_doublereverse).
assert (Cong A C B C) by (forward_using lemma_congruenceflip).
assert (~ eq C B).
 {
 intro.
 assert (Col A C B) by (conclude_def Col ).
 assert (Col A B C) by (forward_using lemma_collinearorder).
 contradict.
 }
let Tf:=fresh in
assert (Tf:exists D, (BetS C B D /\ Cong B D A B)) by (conclude lemma_extension);destruct Tf as [D];spliter.
assert (~ eq C A).
 {
 intro.
 assert (Col B C A) by (conclude_def Col ).
 assert (Col A B C) by (forward_using lemma_collinearorder).
 contradict.
 }
let Tf:=fresh in
assert (Tf:exists E, (BetS C A E /\ Cong A E A B)) by (conclude lemma_extension);destruct Tf as [E];spliter.
assert (BetS D B C) by (conclude axiom_betweennesssymmetry).
assert (BetS E A C) by (conclude axiom_betweennesssymmetry).
assert (~ Col D C E).
 {
 intro.
 assert (Col C A E) by (conclude_def Col ).
 assert (Col C B D) by (conclude_def Col ).
 assert (Col E C D) by (forward_using lemma_collinearorder).
 assert (Col E C A) by (forward_using lemma_collinearorder).
 assert (neq C E) by (forward_using lemma_betweennotequal).
 assert (neq E C) by (conclude lemma_inequalitysymmetric).
 assert (Col C D A) by (conclude lemma_collinear4).
 assert (Col D C B) by (forward_using lemma_collinearorder).
 assert (Col D C A) by (forward_using lemma_collinearorder).
 assert (neq C D) by (forward_using lemma_betweennotequal).
 assert (neq D C) by (conclude lemma_inequalitysymmetric).
 assert (Col C B A) by (conclude lemma_collinear4).
 assert (Col A B C) by (forward_using lemma_collinearorder).
 contradict.
 }
let Tf:=fresh in
assert (Tf:exists F, (BetS D F A /\ BetS E F B)) by (conclude postulate_Pasch_inner);destruct Tf as [F];spliter.
assert (BetS B F E) by (conclude axiom_betweennesssymmetry).
assert (BetS A F D) by (conclude axiom_betweennesssymmetry).
assert (neq C D) by (forward_using lemma_betweennotequal).
assert (neq D C) by (conclude lemma_inequalitysymmetric).
assert (~ Col A D C).
 {
 intro.
 assert (Col C B D) by (conclude_def Col ).
 assert (Col D C A) by (forward_using lemma_collinearorder).
 assert (Col D C B) by (forward_using lemma_collinearorder).
 assert (Col C A B) by (conclude lemma_collinear4).
 assert (Col A B C) by (forward_using lemma_collinearorder).
 contradict.
 }
let Tf:=fresh in
assert (Tf:exists M, (BetS A M B /\ BetS C M F)) by (conclude postulate_Pasch_inner);destruct Tf as [M];spliter.
assert (Cong C A C B) by (forward_using lemma_congruenceflip).
assert (Cong A B A E) by (conclude lemma_congruencesymmetric).
assert (Cong B D A E) by (conclude lemma_congruencetransitive).
assert (Cong A E B D) by (conclude lemma_congruencesymmetric).
assert (Cong A B B A) by (conclude cn_equalityreverse).
assert (Cong C B C A) by (conclude lemma_congruencesymmetric).
assert (Cong B E A D) by (conclude axiom_5_line).
assert (Cong B F B F) by (conclude cn_congruencereflexive).
assert (Lt B F B E) by (conclude_def Lt ).
assert (Cong A D B E) by (conclude lemma_congruencesymmetric).
let Tf:=fresh in
assert (Tf:exists G, (BetS A G D /\ Cong A G B F)) by (conclude proposition_03);destruct Tf as [G];spliter.
assert (Cong G D F E) by (conclude lemma_differenceofparts).
assert (Cong E F D G) by (forward_using lemma_doublereverse).
assert (Cong F B G A) by (forward_using lemma_doublereverse).
assert (Cong E A D B) by (forward_using lemma_congruenceflip).
assert (Cong B A A B) by (conclude cn_equalityreverse).
assert (BetS D G A) by (conclude axiom_betweennesssymmetry).
assert (Cong F A G B) by (conclude lemma_interior5).
assert (Cong A F B G) by (forward_using lemma_congruenceflip).
assert (Cong E D D E) by (conclude cn_equalityreverse).
assert (Cong F D G E) by (conclude lemma_interior5).
assert (BetS B G E) by (conclude lemma_betweennesspreserved).
assert (BetS E G B) by (conclude axiom_betweennesssymmetry).
assert (~ Col A D E).
 {
 intro.
 assert (Col C A E) by (conclude_def Col ).
 assert (Col A E D) by (forward_using lemma_collinearorder).
 assert (Col A E C) by (forward_using lemma_collinearorder).
 assert (neq A E) by (forward_using lemma_betweennotequal).
 assert (Col E D C) by (conclude lemma_collinear4).
 assert (Col E C D) by (forward_using lemma_collinearorder).
 assert (Col E C A) by (forward_using lemma_collinearorder).
 assert (neq C E) by (forward_using lemma_betweennotequal).
 assert (neq E C) by (conclude lemma_inequalitysymmetric).
 assert (Col C D A) by (conclude lemma_collinear4).
 assert (Col C B D) by (conclude_def Col ).
 assert (Col D C A) by (forward_using lemma_collinearorder).
 assert (Col D C B) by (forward_using lemma_collinearorder).
 assert (neq C D) by (forward_using lemma_betweennotequal).
 assert (neq D C) by (conclude lemma_inequalitysymmetric).
 assert (Col C A B) by (conclude lemma_collinear4).
 assert (Col A B C) by (forward_using lemma_collinearorder).
 contradict.
 }
assert (~ Col A D B).
 {
 intro.
 assert (Col D B A) by (forward_using lemma_collinearorder).
 assert (Col C B D) by (conclude_def Col ).
 assert (Col D B C) by (forward_using lemma_collinearorder).
 assert (neq B D) by (forward_using lemma_betweennotequal).
 assert (neq D B) by (conclude lemma_inequalitysymmetric).
 assert (Col B A C) by (conclude lemma_collinear4).
 assert (Col A B C) by (forward_using lemma_collinearorder).
 contradict.
 }
assert (Cut A D E B G) by (conclude_def Cut ).
assert (Cut A D E B F) by (conclude_def Cut ).
assert (~ Col D E B).
 {
 intro.
 assert (Col C B D) by (conclude_def Col ).
 assert (Col D B C) by (forward_using lemma_collinearorder).
 assert (Col D B E) by (forward_using lemma_collinearorder).
 assert (neq B D) by (forward_using lemma_betweennotequal).
 assert (neq D B) by (conclude lemma_inequalitysymmetric).
 assert (Col B C E) by (conclude lemma_collinear4).
 assert (Col C A E) by (conclude_def Col ).
 assert (Col E C A) by (forward_using lemma_collinearorder).
 assert (Col E C B) by (forward_using lemma_collinearorder).
 assert (neq C E) by (forward_using lemma_betweennotequal).
 assert (neq E C) by (conclude lemma_inequalitysymmetric).
 assert (Col C A B) by (conclude lemma_collinear4).
 assert (Col A B C) by (forward_using lemma_collinearorder).
 contradict.
 }
assert (eq G F) by (conclude lemma_twolines).
assert (Cong A F B F) by (conclude cn_equalitysub).
assert (Cong F A F B) by (forward_using lemma_congruenceflip).
assert (Cong C M C M) by (conclude cn_congruencereflexive).
assert (Cong M F M F) by (conclude cn_congruencereflexive).
assert (Cong M A M B) by (conclude lemma_interior5).
close.
Qed.

End Euclid.


(**************************************************************)
(*   Copyright Dominique Larchey-Wendling [*]                 *)
(*             Ralph Matthes [+]                              *)
(*                                                            *)
(*                             [*] Affiliation LORIA -- CNRS  *)
(*                             [*] Affiliation IRIT -- CNRS   *)
(**************************************************************)
(*      This file is distributed under the terms of the       *)
(*         CeCILL v2 FREE SOFTWARE LICENSE AGREEMENT          *)
(**************************************************************)

Require Import List Arith Omega.

Require Import wf_utils llist.

(* Is becomming obsolete --> replaced by fifo_{axm,triv,2lists,3llists}.v *)

Set Implicit Arguments.

Section fifo_props.

  Variables  (X Q : Type) (fifo_list : Q -> list X)
                          (fifo_nil : Q)
                          (fifo_enq : Q -> X -> Q)
                          (fifo_deq : forall q, fifo_list q <> nil -> X * Q)
                          (fifo_void : Q -> bool).

  Definition fifo_nil_prop := fifo_list fifo_nil = nil.
  Definition fifo_enq_prop := forall q x, fifo_list (fifo_enq q x) = fifo_list q ++ x :: nil.
  Definition fifo_deq_prop := forall q Hq, let (x,q') := @fifo_deq q Hq in fifo_list q = x::fifo_list q'.
  Definition fifo_void_prop := forall q, fifo_void q = true <-> fifo_list q = nil.

  Definition fifo_props := fifo_nil_prop /\ fifo_enq_prop /\ fifo_deq_prop /\ fifo_void_prop.

End fifo_props.

Module Type Fifo.

  Parameter  (X Q : Type) (fifo_list : Q -> list X)
                          (fifo_nil : Q)
                          (fifo_enq : Q -> X -> Q)
                          (fifo_deq : forall q, fifo_list q <> nil -> X * Q)
                          (fifo_void : Q -> bool).

  Axioms (fifo_nil_spec : fifo_nil_prop fifo_list fifo_nil)
         (fifo_enq_spec : fifo_enq_prop fifo_list fifo_enq)
         (fifo_deq_spec : fifo_deq_prop fifo_list fifo_deq)
         (fifo_void_spec : fifo_void_prop fifo_list fifo_void).

End Fifo.

Record fifo (X : Type) := {
  queue :> Type;
  fifo_list : queue -> list X;
  fifo_nil : queue;
  fifo_enq : queue -> X -> queue;
  fifo_deq : forall q, fifo_list q <> nil -> X * queue;
  fifo_void : queue -> bool;
  fifo_nil_spec : fifo_nil_prop fifo_list fifo_nil;
  fifo_enq_spec : fifo_enq_prop fifo_list fifo_enq;
  fifo_deq_spec : fifo_deq_prop fifo_list fifo_deq;
  fifo_void_spec : fifo_void_prop fifo_list fifo_void;
}.

Arguments fifo_list { X f }.
Arguments fifo_nil { X f }.
Arguments fifo_enq { X f }.
Arguments fifo_deq { X f }.
Arguments fifo_void { X f }.

Section fifo_trivial.

  Variable X : Type.

  Implicit Type q : list X.

  Let Q := list X.
  Let fifo_list q := q.
  Let fifo_nil := @nil X.
  Let fifo_enq q x := q++x::nil.
  Let fifo_deq q (Hq : fifo_list q <> nil) : X * Q.
  Proof.
    revert Hq.
    refine (match q with nil => _ | x::q => fun _ => (x,q) end).
    intros []; reflexivity.
  Defined.

  Let fifo_void q: bool:=  match q with nil => true | _ => false end.

  Definition fifo_trivial : fifo X.
  Proof.
    exists Q fifo_list fifo_nil fifo_enq fifo_deq fifo_void; red; auto.
    - intros [ | ] Hq; simpl; auto; destruct Hq; reflexivity.
    - intros [ | ]; simpl; split; auto; discriminate.
  Defined.

End fifo_trivial.

Section rev_linear.

  Variable (X : Type).
  Implicit Type (l m : list X).

  Fixpoint rev' l m : list X :=
    match m with
      | nil  => l
      | x::m => rev' (x::l) m
    end.

  Let rev'_spec l m : rev' l m = rev m ++ l.
  Proof.
    revert l; induction m as [ | x m IHm ]; simpl; intros l; auto.
    rewrite IHm, app_ass; auto.
  Qed.

  Definition rev_linear l: list X := rev' nil l.

  Fact rev_linear_spec l : rev_linear l = rev l.
  Proof.
    unfold rev_linear; rewrite rev'_spec, <- app_nil_end; auto.
  Qed.

End rev_linear.

Section fifo_two_lists.

  Variable X : Type.

  Definition fifo_2l := (list X * list X)%type.
  Notation Q := fifo_2l.

  Implicit Type q : Q.

  Definition fifo_2l_list q := let (l,r) := q in l ++ rev r.

  Definition fifo_2l_nil : Q := (nil,nil).
  Definition fifo_2l_nil_spec : fifo_nil_prop fifo_2l_list fifo_2l_nil.
  Proof. red; auto. Qed.

  Definition fifo_2l_enq q x := let (l,r) := q in (l,x::r).
  Definition fifo_2l_enq_spec : fifo_enq_prop fifo_2l_list fifo_2l_enq.
  Proof. intros (l,r) x; simpl; rewrite app_ass; auto. Qed.

  Section deq.

    (* Beware that the extracted code loops forever if q = (nil,nil)
       which is not problematic with the guard fifo_2l_list q <> nil
       but this is an interesting example of extraction of a partial
       function ...

       let rec deq = function (l,r) ->
         match l with
           | nil  => deq (rev_linear r,nil)
           | x::l => (x,(l,r))
         end

       *)

    (** the following definition aims at having as extracted code the function remove on p.584 in Okasaki, Simple and efficient purely functional queues and deques, JFP 1995 *)
    Let fifo_2l_deq_rec q : fifo_2l_list q <> nil -> { c : X * Q | let (x,q') := c in fifo_2l_list q = x::fifo_2l_list q' }.
    Proof.
      induction on q as fifo_deq with measure (length (fst q)+2*length (snd q)); intros Hq.
      refine (match q as q' return q = q' -> _ with
        | (nil,r)   => fun E  => let (res,Hres) := fifo_deq (rev_linear r,nil) _ _ in exist _ res _
        | (x::l,r)  => fun _  => exist _ (x,(l,r)) _
      end eq_refl); subst; simpl in * |- *; trivial.
      + rewrite rev_linear_spec, rev_length.
        destruct r; simpl; try omega; destruct Hq; reflexivity.
      + rewrite rev_linear_spec, <- app_nil_end; trivial.
      + destruct res; rewrite <- Hres, rev_linear_spec, <- app_nil_end; reflexivity.
    Qed.

    Definition fifo_2l_deq q Hq: X * Q := proj1_sig (fifo_2l_deq_rec q Hq).
    Definition fifo_2l_deq_spec : fifo_deq_prop fifo_2l_list fifo_2l_deq.
    Proof. intros q Hq; apply (proj2_sig (fifo_2l_deq_rec q Hq)). Qed.

  End deq.

  Definition fifo_2l_void q: bool :=
    match q with (nil,nil) => true | _ => false end.
  Definition fifo_2l_void_spec : fifo_void_prop fifo_2l_list fifo_2l_void.
  Proof.
    intros ([ | x l],[ | y r]); simpl; split; auto; try discriminate.
    generalize (rev r); clear r; intros [ | ]; discriminate.
  Qed.

  Hint Resolve fifo_2l_nil_spec fifo_2l_enq_spec fifo_2l_deq_spec fifo_2l_void_spec.

  Theorem fifo_2l_spec : fifo_props fifo_2l_list fifo_2l_nil fifo_2l_enq fifo_2l_deq fifo_2l_void.
  Proof. red; auto. Qed.

  Definition fifo_two_lists : fifo X.
  Proof.
    exists Q fifo_2l_list fifo_2l_nil fifo_2l_enq fifo_2l_deq fifo_2l_void; apply fifo_2l_spec; auto.
  Defined.

End fifo_two_lists.

Arguments fifo_2l_nil {X}.

Section fifo_two_lazy_lists.

  (** From "Simple and Efficient Purely Functional Queues and Deques" by Chris Okasaki

      this implements and proves the spec from page 587 with lazy lists (llist)
      with data (l,r,n) satisfying the invariant : n + llength r = llength l

      let fifo_2q_nil = (lnil,lnil,0)

      let fifo_2q_make l r = function
        | O   -> (llist_rotate l r lnil, lnil, llength l + llength r)
        | S n -> (l, r, n)

      let fifo_2q_enq (l,r,n) x = fifo_2q_make l (lcons x r) n

      let fifo_2q_deq (lcons x l,r,n) = (x,fifo_2q_make l r n)

      let fifo_2q_void (l,r,n) = l = lnil

    *)

  Variable X : Type.

  Implicit Types (l r : llist X).

  Let Q_spec (c : llist X * llist X * nat) :=
    match c with (l,r,n) => exists Hl Hr, n + lfin_length r Hr = lfin_length l Hl end.

  Definition fifo_2q_list : sig Q_spec -> list X.
  Proof.
    intros (((l,r),n) & H).
    refine (llist_list l _ ++ rev (llist_list r _));
    destruct H as (? & ? & _); assumption.
  Defined.

  Definition fifo_2q_nil : sig Q_spec.
  Proof.
    exists (lnil,lnil,0), (lfin_lnil _), (lfin_lnil _); simpl.
    reflexivity.
  Defined.

  Fact fifo_2q_nil_spec : fifo_nil_prop fifo_2q_list fifo_2q_nil.
  Proof. reflexivity. Qed.

  Definition fifo_2q_make l r n : (exists Hl Hr, n + lfin_length r Hr = 1 + lfin_length l Hl) -> sig Q_spec.
  Proof.
    destruct n as [ | n ]; intros E.
    + assert (Hl' : lfin l) by (destruct E as (? & ? & _); assumption).
      assert (Hr' : lfin r) by (destruct E as (? & ? & _); assumption).
      assert (E' : lfin_length r Hr' = 1 + lfin_length l Hl').
      { destruct E as (Hl & Hr & E).
        rewrite (lfin_length_eq _ Hr), (lfin_length_eq _ Hl); auto. }
      refine (exist _ (llist_rotate (@lfin_lnil _) E', lnil,lfin_length l Hl'+lfin_length r Hr') _); simpl.
      exists (lfin_rotate _ _ (@lfin_lnil _) E'), (@lfin_lnil _).
      rewrite llist_rotate_length; auto.
    + exists (l,r,n); destruct E as (Hl & Hr & Hn); exists Hl, Hr; omega.
  Defined.

  Hint Resolve llist_list_eq.

  Fact fifo_2q_make_spec l r n Hl Hr H : llist_list l Hl ++ rev (llist_list r Hr) = fifo_2q_list (@fifo_2q_make l r n H).
  Proof.
    destruct H as (Hl' & Hr' & Hn).
    unfold fifo_2q_list, fifo_2q_make; destruct n as [ | n ].
    + rewrite (llist_rotate_eq _ _ (@lfin_lnil _) _).
      rewrite llist_list_fix_0; simpl.
      do 2 rewrite <- app_nil_end; do 3 (f_equal; auto).
    + do 3 (f_equal; auto).
  Qed.

  Definition fifo_2q_enq (q : sig Q_spec) (x : X) : sig Q_spec.
  Proof.
    destruct q as (((l,r),n) & H).
    apply (@fifo_2q_make l (lcons x r) n).
    destruct H as (Hl & Hr & Hn).
    exists Hl, (lfin_lcons _ Hr).
    rewrite lfin_length_fix_1, (lfin_length_eq _ Hr); omega.
  Defined.

  Fact fifo_2q_enq_spec : fifo_enq_prop fifo_2q_list fifo_2q_enq.
  Proof.
    red; unfold fifo_2q_enq.
    intros  (((l,r),n) & Hl & Hr & Hn) x.
    rewrite <- (@fifo_2q_make_spec _ _ _ Hl (lfin_lcons x Hr)).
    unfold fifo_2q_list.
    rewrite llist_list_fix_1, app_ass; trivial.
  Qed.

  Definition fifo_2q_deq q : fifo_2q_list q <> nil -> X * sig Q_spec.
  Proof.
    destruct q as (((l,r),n) & H); revert H.
    refine (match l with
      | lnil      => fun H1 H2 => _
      | lcons x l => fun H1 H2 => (x,@fifo_2q_make l r n _)
    end).
    + exfalso.
      destruct H1 as (Hl & Hr & Hn).
      unfold fifo_2q_list in H2.
      destruct r.
      * do 2 rewrite llist_list_fix_0 in H2; destruct H2; trivial.
      * rewrite lfin_length_fix_1, lfin_length_fix_0 in Hn; omega.
    + destruct H1 as (Hl & Hr & Hn).
      exists (lfin_inv Hl), Hr.
      rewrite Hn, lfin_length_fix_1; auto.
  Defined.

  Fact fifo_2q_deq_spec : fifo_deq_prop fifo_2q_list fifo_2q_deq.
  Proof.
    red; unfold fifo_2q_deq.
    intros  ((([ | x l],r),n) & Hl & Hr & H) Hq.
    + exfalso.
      unfold fifo_2q_list in Hq.
      destruct r.
      * do 2 rewrite llist_list_fix_0 in Hq; destruct Hq; reflexivity.
      * rewrite lfin_length_fix_1, lfin_length_fix_0 in H; omega.
    + rewrite <- (@fifo_2q_make_spec _ _ _ (lfin_inv Hl) Hr).
      unfold fifo_2q_list.
      rewrite llist_list_fix_1; auto.
  Qed.

  Definition fifo_2q_void : sig Q_spec -> bool.
  Proof.
    intros ((([ | x l],r),n) & H).
    + exact true.
    + exact false.
  Defined.

  Fact fifo_2q_void_spec : fifo_void_prop fifo_2q_list fifo_2q_void.
  Proof.
    red; unfold fifo_2q_list, fifo_2q_void.
    intros ((([ | x l],r),n) & Hl & Hr & Hn).
    + split; auto; intros _.
      rewrite llist_list_fix_0.
      destruct r.
      * rewrite llist_list_fix_0; auto.
      * rewrite lfin_length_fix_0, lfin_length_fix_1 in Hn; omega.
    + split; try discriminate.
      rewrite llist_list_fix_1; discriminate.
  Qed.

End fifo_two_lazy_lists.

Recursive Extraction fifo_2q_nil fifo_2q_enq fifo_2q_deq fifo_2q_void.

Section fifo_three_lazy_lists.

  (** From "Simple and Efficient Purely Functional Queues and Deques" by Chris Okasaki

      this implements and proves the spec from page 588 with lazy lists (llist)
      with invariant (l,r,l') : llength l' + llength r = llength l

      let rec llist_rotate l r a := match r with
        | lcons y r -> match l with
          | lnil      -> lcons y a
          | lcons x l -> lcons x (llist_rotate l' r' (lcons y a))

      let fifo_3q_nil = (lnil,lnil,lnil)

      let fifo_3q_make l r l' = match l' with
        | lnil       -> let l' = llist_rotate l r lnil in (l',lnil,l')
        | lcons _ l' -> (l, r, l')

      let fifo_3q_enq (l,r,l') x = fifo_3q_make l (lcons x r) l'

      let fifo_3q_deq (lcons x l,r,l') = (x,fifo_3q_make l r l')

      let fifo_3q_void (l,r,n) = l = lnil

    *)

  Variable X : Type.

  Implicit Types (l r : llist X).

  Let Q_spec (c : llist X * llist X * llist X) :=
    match c with (l,r,l') => exists Hl Hr Hl', lfin_length l' Hl' + lfin_length r Hr = lfin_length l Hl end.

  Definition fifo_3q := sig Q_spec.

  Implicit Types (q : fifo_3q) (x : X).

  Definition fifo_3q_list : fifo_3q -> list X.
  Proof.
    intros (((l,r),l') & H).
    refine (llist_list l _ ++ rev (llist_list r _));
    destruct H as (? & ? & _); assumption.
  Defined.

  Definition fifo_3q_nil : fifo_3q.
  Proof.
    refine (exist _ (lnil,lnil,lnil) _).
    exists (lfin_lnil _), (lfin_lnil _), (lfin_lnil _); simpl.
    reflexivity.
  Defined.

  Fact fifo_3q_nil_spec : fifo_nil_prop fifo_3q_list fifo_3q_nil.
  Proof.
    red; unfold fifo_3q_list, fifo_3q_nil.
    trivial.
  Qed.

  Definition fifo_3q_make l r l' : (exists Hl Hr Hl', lfin_length l' Hl' + lfin_length r Hr = 1 + lfin_length l Hl) -> fifo_3q.
  Proof.
    destruct l' as [ | x l'' ]; intros E.
    + cut (lfin l); [ intros Hl1 | ].
      cut (lfin r); [ intros Hr1 | ].
      2-3 : cycle 1.
      cut (lfin_length r Hr1 = 1 + lfin_length l Hl1); [ intros E1 | ].
      2-4 : cycle 1.
      refine (let l'' := @llist_rotate _ l r lnil Hl1 Hr1 (@lfin_lnil _) E1
              in exist _ (l'',lnil,l'') _).
      all: cycle 1.
      * destruct E as (? & ? & _); assumption.
      * destruct E as (? & ? & _); assumption.
      * destruct E as (Hl & Hr & Hl' & E).
        rewrite lfin_length_fix_0 in E.
        rewrite (lfin_length_eq _ Hr), (lfin_length_eq _ Hl); auto.
      * exists (lfin_rotate _ _ (@lfin_lnil _) E1),
          (@lfin_lnil _),
          (lfin_rotate _ _ (@lfin_lnil _) E1).
        unfold l''; rewrite llist_rotate_length; auto.
    + refine (exist _ (l,r,l'') _).
      destruct E as (Hl & Hr & Hl'' & E).
      exists Hl, Hr, (lfin_inv Hl'').
      rewrite lfin_length_fix_1 in E; omega.
  Defined.

  Hint Resolve llist_list_eq.

  Fact fifo_3q_make_spec l r l' Hl Hr H : llist_list l Hl ++ rev (llist_list r Hr) = fifo_3q_list (@fifo_3q_make l r l' H).
  Proof.
    destruct H as (Hl1 & Hr1 & Hl' & E).
    unfold fifo_3q_list, fifo_3q_make; destruct l' as [ | x l' ].
    + rewrite (llist_rotate_eq _ _ (@lfin_lnil _) _).
      rewrite llist_list_fix_0; simpl.
      do 2 rewrite <- app_nil_end; do 2 (f_equal; auto).
    + do 2 (f_equal; auto).
  Qed.

  Definition fifo_3q_enq q x : fifo_3q.
  Proof.
    destruct q as (((l,r),l') & H).
    refine (@fifo_3q_make l (lcons x r) l' _).
    destruct H as (Hl & Hr & Hl' & E).
    exists Hl, (lfin_lcons _ Hr), Hl'.
    rewrite lfin_length_fix_1, (lfin_length_eq _ Hr); omega.
  Defined.

  Fact fifo_3q_enq_spec : fifo_enq_prop fifo_3q_list fifo_3q_enq.
  Proof.
    red; unfold fifo_3q_enq.
    intros  (((l,r),l') & Hl & Hr & Hl' & E) x.
    rewrite <- (@fifo_3q_make_spec _ _ _ Hl (lfin_lcons _ Hr)).
    unfold fifo_3q_list.
    rewrite llist_list_fix_1, app_ass; trivial.
  Qed.

  Definition fifo_3q_deq q : fifo_3q_list q <> nil -> X * fifo_3q.
  Proof.
    destruct q as (((l,r),l') & H); revert H.
    refine (match l with
      | lnil      => fun H1 H2 => _
      | lcons x l => fun H1 H2 => (x,@fifo_3q_make l r l' _)
    end); [ exfalso | ]; destruct H1 as (Hl & Hr & Hl' & E).
    + unfold fifo_3q_list in H2.
      destruct r.
      * do 2 rewrite llist_list_fix_0 in H2; destruct H2; reflexivity.
      * rewrite lfin_length_fix_1, lfin_length_fix_0 in E; omega.
    + exists (lfin_inv Hl), Hr, Hl'.
      rewrite E, lfin_length_fix_1; reflexivity.
  Defined.

  Fact fifo_3q_deq_spec : fifo_deq_prop fifo_3q_list fifo_3q_deq.
  Proof.
    red; unfold fifo_3q_deq.
    intros ((([ | x l],r),n) & Hl & Hr & Hl' & E) Hq.
    + exfalso.
      unfold fifo_3q_list in Hq.
      destruct r.
      * do 2 rewrite llist_list_fix_0 in Hq; destruct Hq; trivial.
      * rewrite lfin_length_fix_1, lfin_length_fix_0 in E; omega.
    + rewrite <- (@fifo_3q_make_spec _ _ _ (lfin_inv Hl) Hr).
      unfold fifo_3q_list.
      rewrite llist_list_fix_1; auto.
  Qed.

  Definition fifo_3q_void : fifo_3q -> bool.
  Proof.
    intros ((([ | x l],_),_) & _).
    + exact true.
    + exact false.
  Defined.

  Fact fifo_3q_void_spec : fifo_void_prop fifo_3q_list fifo_3q_void.
  Proof.
    red; unfold fifo_3q_list, fifo_3q_void.
    intros ((([ | x l],r),n) & Hl & Hr & Hl' & E).
    + split; auto; intros _.
      rewrite llist_list_fix_0.
      destruct r.
      * rewrite llist_list_fix_0; reflexivity.
      * rewrite lfin_length_fix_0, lfin_length_fix_1 in E; omega.
    + split; try discriminate.
      rewrite llist_list_fix_1; discriminate.
  Qed.

  Hint Resolve fifo_3q_nil_spec fifo_3q_enq_spec fifo_3q_deq_spec fifo_3q_void_spec.

  Theorem fifo_3q_spec : fifo_props fifo_3q_list fifo_3q_nil fifo_3q_enq fifo_3q_deq fifo_3q_void.
  Proof. red; auto. Qed.

  Definition fifo_3q_nil_full : { q | fifo_3q_list q = nil }.
  Proof. exists fifo_3q_nil; auto. Defined.

  Definition fifo_3q_enq_full q x : { q' | fifo_3q_list q' = fifo_3q_list q ++ x :: nil }.
  Proof. exists (fifo_3q_enq q x); auto. Defined.

  Definition fifo_3q_deq_full q : fifo_3q_list q <> nil -> { c : X * fifo_3q | let (x,q') := c in fifo_3q_list q = x::fifo_3q_list q' }.
  Proof. intros Hq; exists (fifo_3q_deq _ Hq); apply fifo_3q_deq_spec. Defined.

  Definition fifo_3q_void_full q : { b | b = true <-> fifo_3q_list q = nil }.
  Proof. exists (fifo_3q_void q); auto. Defined.

End fifo_three_lazy_lists.

Arguments fifo_3q_nil {X}.

Recursive Extraction fifo_3q_nil fifo_3q_enq fifo_3q_deq fifo_3q_void.

Extraction Inline fifo_3q_nil_full fifo_3q_enq_full fifo_3q_deq_full fifo_3q_void_full.

(*
Recursive Extraction fifo_2l_deq.
*)


Load LFindLoad.
From lfind Require Import LFind.
Unset Printing Notations.
Set Printing Implicit.

Inductive natural : Type := Succ : natural -> natural |  Zero : natural.

Inductive lst : Type := Cons : natural -> lst -> lst |  Nil : lst.

Inductive tree : Type := Node : natural -> tree -> tree -> tree |  Leaf : tree.

Inductive Pair : Type := mkpair : natural -> natural -> Pair
with Zlst : Type := zcons : Pair -> Zlst -> Zlst |  znil : Zlst.

Fixpoint double (double_arg0 : natural) : natural
           := match double_arg0 with
              | Zero => Zero
              | Succ n => Succ (Succ (double n))
              end.

Fixpoint append (append_arg0 : lst) (append_arg1 : lst) : lst
           := match append_arg0, append_arg1 with
              | Nil, x => x
              | Cons x y, z => Cons x (append y z)
              end.

Fixpoint len (len_arg0 : lst) : natural
           := match len_arg0 with
              | Nil => Zero
              | Cons x y => Succ (len y)
              end.

Lemma lem : forall l1 l2 n, Succ (len (append l1 l2)) = len (append l1 (Cons n l2)).
Proof.
   induction l1.
   - intros. simpl. f_equal. apply IHl1.
   - intros. reflexivity.
Qed.

Theorem theorem0 : forall (x : lst), eq (len (append x x)) (double (len x)).
Proof.
induction x.
   - simpl. rewrite <- IHx. f_equal. lfind. Admitted.


Require Import rt.util.all.
Require Import rt.model.arrival.basic.task rt.model.arrival.basic.job rt.model.priority rt.model.arrival.basic.task_arrival.
Require Import rt.model.schedule.global.response_time rt.model.schedule.global.workload
               rt.model.schedule.global.schedulability.
Require Import rt.model.schedule.global.basic.schedule rt.model.schedule.global.basic.platform
               rt.model.schedule.global.basic.interference rt.model.schedule.global.basic.interference_edf.
Require Import rt.analysis.global.parallel.workload_bound
               rt.analysis.global.parallel.interference_bound.
From mathcomp Require Import ssreflect ssrbool eqtype ssrnat seq fintype bigop div path.

Module InterferenceBoundEDF.

  Import Job SporadicTaskset Schedule ScheduleOfSporadicTask Schedulability
         WorkloadBound ResponseTime Priority
         TaskArrival Interference InterferenceEDF.
  Export InterferenceBoundGeneric.

  (* In this section, we define Bertogna and Cirinei's EDF-specific
     interference bound. *)
  Section SpecificBoundDef.

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

    (* Let tsk be the task to be analyzed. *)
    Variable tsk: sporadic_task.

    (* Consider the interference incurred by tsk in a window of length delta... *)
    Variable delta: time.

    (* due to a different task tsk_other, with response-time bound R_other. *)
    Variable tsk_other: sporadic_task.
    Variable R_other: time.

    (* Bertogna and Cirinei define the following bound for task interference
       under EDF scheduling. *)
    Definition edf_specific_interference_bound :=
      let d_tsk := task_deadline tsk in
      let e_other := task_cost tsk_other in
      let p_other := task_period tsk_other in
      let d_other := task_deadline tsk_other in
        (div_ceil (d_tsk + R_other - d_other + 1) p_other) * e_other.

  End SpecificBoundDef.

  (* Next, we define the total interference bound for EDF, which combines the generic
     and the EDF-specific bounds. *)
  Section TotalInterferenceBoundEDF.

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

    (* Let tsk be the task to be analyzed. *)
    Variable tsk: sporadic_task.

    Let task_with_response_time := (sporadic_task * time)%type.

    (* Assume a known response-time bound for each interfering task ... *)
    Variable R_prev: seq task_with_response_time.

    (* ... and an interval length delta. *)
    Variable delta: time.

    Section RecallInterferenceBounds.

      Variable tsk_R: task_with_response_time.
      Let tsk_other := fst tsk_R.
      Let R_other := snd tsk_R.

      (* By combining Bertogna's interference bound for a work-conserving
         scheduler ... *)
      Let basic_interference_bound := interference_bound_generic task_cost task_period delta tsk_R.

      (* ... with and EDF-specific interference bound, ... *)
      Let edf_specific_bound := edf_specific_interference_bound task_cost task_period task_deadline tsk tsk_other R_other.

      (* Bertogna and Cirinei define the following interference bound
         under EDF scheduling. *)
      Definition interference_bound_edf :=
        minn basic_interference_bound edf_specific_bound.

    End RecallInterferenceBounds.

    (* Next we define the computation of the total interference for APA scheduling. *)
    Section TotalInterference.

      (* Let other_task denote tasks different from tsk. *)
      Let other_task := different_task tsk.

      (* The total interference incurred by tsk is bounded by the sum
         of individual task interferences of the other tasks. *)
      Definition total_interference_bound_edf :=
        \sum_((tsk_other, R_other) <- R_prev | other_task tsk_other)
           interference_bound_edf (tsk_other, R_other).

    End TotalInterference.

  End TotalInterferenceBoundEDF.

  (* In this section, we show that the EDF-specific interference bound is safe. *)
  Section ProofSpecificBound.

    Import Schedule Interference Platform SporadicTaskset.

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

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

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

    (* ... in which jobs arrive sporadically and have valid parameters. *)
    Hypothesis H_sporadic_tasks:
      sporadic_task_model task_period job_arrival job_task arr_seq.
    Hypothesis H_valid_job_parameters:
      forall j,
        arrives_in arr_seq j ->
        valid_sporadic_job task_cost task_deadline job_cost job_deadline job_task j.

    (* Consider any schedule such that...*)
    Variable num_cpus: nat.
    Variable sched: schedule Job num_cpus.
    Hypothesis H_jobs_come_from_arrival_sequence:
      jobs_come_from_arrival_sequence sched arr_seq.

    (* ...jobs do not execute before their arrival times nor longer
       than their execution costs. *)
    Hypothesis H_jobs_must_arrive_to_execute:
      jobs_must_arrive_to_execute job_arrival sched.
    Hypothesis H_completed_jobs_dont_execute:
      completed_jobs_dont_execute job_cost sched.

    (* Assume there exists at least one processor. *)
    Hypothesis H_at_least_one_cpu: num_cpus > 0.

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

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

    (* Assume that the scheduler is a work-conserving EDF scheduler. *)
    Hypothesis H_work_conserving: work_conserving job_arrival job_cost arr_seq sched.
    Hypothesis H_edf_scheduler:
      respects_JLFP_policy job_arrival job_cost arr_seq sched (EDF job_arrival job_deadline).

    (* Let tsk_i be the task to be analyzed, ...*)
    Variable tsk_i: sporadic_task.
    Hypothesis H_tsk_i_in_task_set: tsk_i \in ts.

    (* and j_i one of its jobs. *)
    Variable j_i: Job.
    Hypothesis H_j_i_arrives: arrives_in arr_seq j_i.
    Hypothesis H_job_of_tsk_i: job_task j_i = tsk_i.

    (* Let tsk_k denote any interfering task, ... *)
    Variable tsk_k: sporadic_task.
    Hypothesis H_tsk_k_in_task_set: tsk_k \in ts.

    (* ...and R_k its response-time bound. *)
    Variable R_k: time.
    Hypothesis H_R_k_le_deadline: R_k <= task_deadline tsk_k.

    (* Consider a time window of length delta <= D_i, starting with j_i's arrival time. *)
    Variable delta: time.
    Hypothesis H_delta_le_deadline: delta <= task_deadline tsk_i.

    (* Assume that the jobs of tsk_k satisfy the response-time bound before the end of the interval *)
    Hypothesis H_all_previous_jobs_completed_on_time :
      forall j_k,
        arrives_in arr_seq j_k ->
        job_task j_k = tsk_k ->
        job_arrival j_k + R_k < job_arrival j_i + delta ->
        completed job_cost sched j_k (job_arrival j_k + R_k).

    (* In this section, we prove that Bertogna and Cirinei's EDF interference bound
       indeed bounds the interference caused by task tsk_k in the interval [t1, t1 + delta). *)
    Section MainProof.

      (* Let's call x the task interference incurred by job j due to tsk_k. *)
      Let x :=
        task_interference job_arrival job_cost job_task sched j_i
                          tsk_k (job_arrival j_i) (job_arrival j_i + delta).

      (* Also, recall the EDF-specific interference bound for EDF. *)
      Let interference_bound :=
        edf_specific_interference_bound task_cost task_period task_deadline tsk_i tsk_k R_k.

      (* Let's simplify the names a bit. *)
      Let t1 := job_arrival j_i.
      Let t2 := job_arrival j_i + delta.
      Let D_i := task_deadline tsk_i.
      Let D_k := task_deadline tsk_k.
      Let p_k := task_period tsk_k.

      Let n_k := div_ceil (D_i + R_k - D_k + 1) p_k.

      (* Let's give a simpler name to job interference. *)
      Let interference_caused_by := job_interference job_arrival job_cost sched j_i.

      (* Identify the subset of jobs that actually cause interference *)
      Let interfering_jobs :=
        filter (fun j' =>
                 (job_task j' == tsk_k) && (interference_caused_by j' t1 t2 != 0))
               (jobs_scheduled_between sched t1 t2).

      (* Now, consider the list of interfering jobs sorted by arrival time. *)
      Let earlier_arrival := fun x y => job_arrival x <= job_arrival y.
      Let sorted_jobs := sort earlier_arrival interfering_jobs.

      (* Now we proceed with the proof.
         The first step consists in simplifying the sum corresponding to the workload. *)
      Section SimplifyJobSequence.

        (* Use the alternative definition of task interference, based on
           individual job interference. *)
        Lemma interference_bound_edf_use_another_definition :
          x <= \sum_(j <- jobs_scheduled_between sched t1 t2 | job_task j == tsk_k)
                interference_caused_by j t1 t2.
        Proof.
          unfold x, task_interference, interference_caused_by, job_interference.
          rewrite [\sum_(_ <- _ sched _ _ | _) _]exchange_big /=.
          rewrite big_nat_cond [\sum_(_ <= _ < _ | true) _]big_nat_cond.
          apply leq_sum. move => t /andP [LEt _].
          rewrite exchange_big /=.
          apply leq_sum; intros cpu _.
          destruct (backlogged job_arrival job_cost sched j_i t) eqn:BACK;
            last by rewrite andFb (eq_bigr (fun x => 0));
              first by rewrite big_const_seq iter_addn mul0n addn0.
          rewrite andTb.
          destruct (task_scheduled_on job_task sched tsk_k cpu t) eqn:SCHED;
            last by done.
          unfold task_scheduled_on in *.
          destruct (sched cpu t) eqn:SOME; last by done.
          rewrite big_mkcond /= (bigD1_seq s) /=; last by apply undup_uniq.
          {
            rewrite SCHED -addn1 addnC; apply leq_add; last by done.
            apply eq_leq; symmetry; apply/eqP; rewrite eqb1.
            by unfold scheduled_on; apply/eqP.
          }
          {
            unfold jobs_scheduled_between.
            rewrite mem_undup; apply mem_bigcat_nat with (j := t);
              first by done.
            apply mem_bigcat_ord with (j := cpu); first by apply ltn_ord.
            by unfold make_sequence; rewrite SOME mem_seq1 eq_refl.
          }
        Qed.

        (* Remove the elements that we don't care about from the sum *)
        Lemma interference_bound_edf_simpl_by_filtering_interfering_jobs :
          \sum_(j <- jobs_scheduled_between sched t1 t2 | job_task j == tsk_k)
             interference_caused_by j t1 t2 =
          \sum_(j <- interfering_jobs) interference_caused_by j t1 t2.
        Proof.
          unfold interfering_jobs; rewrite big_filter.
          rewrite big_mkcond; rewrite [\sum_(_ <- _ | _) _]big_mkcond /=.
          apply eq_bigr; intros i _; clear -i.
          destruct (job_task i == tsk_k); rewrite ?andTb ?andFb; last by done.
          destruct (interference_caused_by i t1 t2 != 0) eqn:DIFF; first by done.
          by apply negbT in DIFF; rewrite negbK in DIFF; apply/eqP.
        Qed.

        (* Then, we consider the sum over the sorted sequence of jobs. *)
        Lemma interference_bound_edf_simpl_by_sorting_interfering_jobs :
          \sum_(j <- interfering_jobs) interference_caused_by j t1 t2 =
           \sum_(j <- sorted_jobs) interference_caused_by j t1 t2.
        Proof.
          by rewrite (eq_big_perm sorted_jobs) /=; last by rewrite -(perm_sort earlier_arrival).
        Qed.

        (* Note that both sequences have the same set of elements. *)
        Lemma interference_bound_edf_job_in_same_sequence :
          forall j,
            (j \in interfering_jobs) = (j \in sorted_jobs).
        Proof.
          by apply perm_eq_mem; rewrite -(perm_sort earlier_arrival).
        Qed.

        (* Also recall that all jobs in the sorted sequence is an interfering job of tsk_k, ... *)
        Lemma interference_bound_edf_all_jobs_from_tsk_k :
          forall j,
            j \in sorted_jobs ->
            arrives_in arr_seq j /\
            job_task j = tsk_k /\
            interference_caused_by j t1 t2 != 0 /\
            j \in jobs_scheduled_between sched t1 t2.
        Proof.
          intros j LT.
          rewrite -interference_bound_edf_job_in_same_sequence mem_filter in LT.
          move: LT => /andP [/andP [/eqP JOBi SERVi] INi].
          repeat split; try (by done).
          unfold jobs_scheduled_between in *; rewrite mem_undup in INi.
          apply mem_bigcat_nat_exists in INi; des.
          rewrite mem_scheduled_jobs_eq_scheduled in INi.
          by apply (H_jobs_come_from_arrival_sequence j i).
        Qed.

        (* ...and consecutive jobs are ordered by arrival. *)
        Lemma interference_bound_edf_jobs_ordered_by_arrival :
          forall i elem,
            i < (size sorted_jobs).-1 ->
            earlier_arrival (nth elem sorted_jobs i) (nth elem sorted_jobs i.+1).
        Proof.
          intros i elem LT.
          assert (SORT: sorted earlier_arrival sorted_jobs).
            by apply sort_sorted; unfold total, earlier_arrival; ins; apply leq_total.
          by destruct sorted_jobs; simpl in *; [by rewrite ltn0 in LT | by apply/pathP].
        Qed.

        (* Also, for any job of task tsk_k, the interference is bounded by the task cost. *)
        Lemma interference_bound_edf_interference_le_task_cost :
          forall j,
            j \in interfering_jobs ->
            interference_caused_by j t1 t2 <= task_cost tsk_k.
        Proof.
          rename H_valid_job_parameters into PARAMS.
          intros j INj.
          feed (interference_bound_edf_all_jobs_from_tsk_k j);
            first by rewrite -interference_bound_edf_job_in_same_sequence.
          move => [ARRj [TSKj _]].
          specialize (PARAMS j ARRj); des.
          apply leq_trans with (n := service_during sched j t1 t2);
            first by apply job_interference_le_service.
          by apply cumulative_service_le_task_cost with (job_task0 := job_task)
            (task_deadline0 := task_deadline) (job_cost0 := job_cost) (job_deadline0 := job_deadline).
        Qed.

      End SimplifyJobSequence.

      (* Next, we show that if the number of jobs is no larger than n_k,
         the workload bound trivially holds. *)
      Section InterferenceFewJobs.

        Hypothesis H_few_jobs: size sorted_jobs <= n_k.

        Lemma interference_bound_edf_holds_for_at_most_n_k_jobs :
           \sum_(j <- sorted_jobs) interference_caused_by j t1 t2 <=
             interference_bound.
        Proof.
          unfold interference_bound, edf_specific_interference_bound; fold D_i p_k n_k.
          apply leq_trans with (n := \sum_(x <- sorted_jobs) task_cost tsk_k);
            last first.
          {
            rewrite big_const_seq iter_addn addn0 count_predT mulnC.
            by rewrite leq_mul2r; apply/orP; right.
          }
          {
            rewrite big_seq_cond [\sum_(_ <- _ | true)_]big_seq_cond.
            apply leq_sum; move => j /andP [IN _].
            apply interference_bound_edf_interference_le_task_cost.
            by rewrite interference_bound_edf_job_in_same_sequence.
          }
        Qed.

      End InterferenceFewJobs.

      (* Otherwise, assume that the number of jobs is larger than n_k >= 0. *)
      Section InterferenceManyJobs.

        Hypothesis H_many_jobs: n_k < size sorted_jobs.

        (* This trivially implies that there's at least one job. *)
        Lemma interference_bound_edf_at_least_one_job: size sorted_jobs > 0.
        Proof.
          by apply leq_ltn_trans with (n := n_k).
        Qed.

        (* Let j_fst be the first job, and a_fst its arrival time. *)
        Variable elem: Job.
        Let j_fst := nth elem sorted_jobs 0.
        Let a_fst := job_arrival j_fst.

        (* In this section, we prove some basic lemmas about j_fst. *)
        Section FactsAboutFirstJob.

          (* The first job is an interfering job of task tsk_k. *)
          Lemma interference_bound_edf_j_fst_is_job_of_tsk_k :
            arrives_in arr_seq j_fst /\
            job_task j_fst = tsk_k /\
            interference_caused_by j_fst t1 t2 != 0 /\
            j_fst \in jobs_scheduled_between sched t1 t2.
          Proof.
            by apply interference_bound_edf_all_jobs_from_tsk_k, mem_nth,
                     interference_bound_edf_at_least_one_job.
          Qed.

          (* The deadline of j_fst is the deadline of tsk_k. *)
          Lemma interference_bound_edf_j_fst_deadline :
            job_deadline j_fst = task_deadline tsk_k.
          Proof.
            unfold valid_sporadic_job in *.
            rename H_valid_job_parameters into PARAMS.
            have FST := interference_bound_edf_j_fst_is_job_of_tsk_k.
            destruct FST as [FSTarr [FSTtask _]].
            by specialize (PARAMS j_fst FSTarr); des; rewrite PARAMS1 FSTtask.
          Qed.

          (* The deadline of j_i is the deadline of tsk_i. *)
          Lemma interference_bound_edf_j_i_deadline :
            job_deadline j_i = task_deadline tsk_i.
          Proof.
            unfold valid_sporadic_job in *.
            rename H_valid_job_parameters into PARAMS,
                   H_job_of_tsk_i into JOBtsk.
            by specialize (PARAMS j_i H_j_i_arrives); des; rewrite PARAMS1 JOBtsk.
          Qed.

          (* If j_fst completes by its response-time bound, then t1 <= a_fst + R_k,
             where t1 is the beginning of the time window (arrival of j_i). *)
          Lemma interference_bound_edf_j_fst_completion_implies_rt_bound_inside_interval :
            completed job_cost sched j_fst (a_fst + R_k) ->
            t1 <= a_fst + R_k.
          Proof.
            intros RBOUND.
            rewrite leqNgt; apply/negP; unfold not; intro BUG.
            have FST := interference_bound_edf_j_fst_is_job_of_tsk_k.
            destruct FST as [_ [_ [ FSTserv _]]].
            move: FSTserv => /negP FSTserv; apply FSTserv.
            rewrite -leqn0; apply leq_trans with (n := service_during sched j_fst t1 t2);
              first by apply job_interference_le_service.
            rewrite leqn0; apply/eqP.
            by apply cumulative_service_after_job_rt_zero with (job_cost0 := job_cost)
                                              (job_arrival0 := job_arrival) (R := R_k);
              try (by done); apply ltnW.
          Qed.

        End FactsAboutFirstJob.

        (* Now, let's prove the interference bound for the particular case of a single job.
           This case must be solved separately because the single job can simultaneously
           be carry-in and carry-out job, so its response time is not necessarily
           bounded by R_k (from the hypothesis H_all_previous_jobs_completed_on_time). *)
        Section InterferenceSingleJob.

          (* Assume that there's at least one job in the sorted list. *)
          Hypothesis H_only_one_job: size sorted_jobs = 1.

          Lemma interference_bound_edf_holds_for_a_single_job :
            interference_caused_by j_fst t1 t2 <= interference_bound.
          Proof.
            unfold valid_sporadic_taskset, is_valid_sporadic_task in *.
            rename H_many_jobs into NUM,
                   H_valid_task_parameters into PARAMS,
                   H_only_one_job into SIZE.
            apply leq_trans with (n := task_cost tsk_k).
            {
              apply interference_bound_edf_interference_le_task_cost.
              rewrite interference_bound_edf_job_in_same_sequence.
              by apply mem_nth; rewrite SIZE.
            }
            {
              unfold interference_bound, edf_specific_interference_bound.
              rewrite -{1}[task_cost tsk_k]mul1n.
              rewrite leq_mul2r; apply/orP; right.
              exploit (PARAMS tsk_i); [by done | intro PARAMSi]; des.
              exploit (PARAMS tsk_k); [by done | intro PARAMSk]; des.
              apply ceil_neq0; last by done.
              rewrite -subnBA; last by done.
              by rewrite addn1 ltnS.
            }
          Qed.

        End InterferenceSingleJob.

        (* Next, consider the other case where there are at least two jobs:
           the first job j_fst, and the last job j_lst. *)
        Section InterferenceTwoOrMoreJobs.

          (* Assume there are at least two jobs. *)
          Variable num_mid_jobs: nat.
          Hypothesis H_at_least_two_jobs : size sorted_jobs = num_mid_jobs.+2.

          (* Let j_lst be the last job of the sequence and a_lst its arrival time. *)
          Let j_lst := nth elem sorted_jobs num_mid_jobs.+1.
          Let a_lst := job_arrival j_lst.

          (* In this section, we prove some basic lemmas about the first and last jobs. *)
          Section FactsAboutFirstAndLastJobs.

            (* The last job is an interfering job of task tsk_k. *)
            Lemma interference_bound_edf_j_lst_is_job_of_tsk_k :
              arrives_in arr_seq j_lst /\
              job_task j_lst = tsk_k /\
              interference_caused_by j_lst t1 t2 != 0 /\
              j_lst \in jobs_scheduled_between sched t1 t2.
            Proof.
              apply interference_bound_edf_all_jobs_from_tsk_k, mem_nth.
              by rewrite H_at_least_two_jobs.
            Qed.

            (* The deadline of j_lst is the deadline of tsk_k. *)
            Lemma interference_bound_edf_j_lst_deadline :
              job_deadline j_lst = task_deadline tsk_k.
            Proof.
              unfold valid_sporadic_job in *.
              rename H_valid_job_parameters into PARAMS.
              have LST := interference_bound_edf_j_lst_is_job_of_tsk_k.
              destruct LST as [LSTarr [LSTtask _]].
              by specialize (PARAMS j_lst LSTarr); des; rewrite PARAMS1 LSTtask.
            Qed.

            (* The first job arrives before the last job. *)
            Lemma interference_bound_edf_j_fst_before_j_lst :
              job_arrival j_fst <= job_arrival j_lst.
            Proof.
              rename H_at_least_two_jobs into SIZE.
              unfold j_fst, j_lst; rewrite -[num_mid_jobs.+1]add0n.
              apply prev_le_next; last by rewrite SIZE leqnn.
              by intros i LT; apply interference_bound_edf_jobs_ordered_by_arrival.
            Qed.

            (* The last job arrives before the end of the interval. *)
            Lemma interference_bound_edf_last_job_arrives_before_end_of_interval :
              job_arrival j_lst < t2.
            Proof.
              rewrite leqNgt; apply/negP; unfold not; intro LT2.
              exploit interference_bound_edf_all_jobs_from_tsk_k.
              {
                apply mem_nth; instantiate (1 := num_mid_jobs.+1).
                by rewrite -(ltn_add2r 1) addn1 H_at_least_two_jobs addn1.
              }
              instantiate (1 := elem); move => [LSTarr [LSTtsk [/eqP LSTserv LSTin]]].
              apply LSTserv; apply/eqP; rewrite -leqn0.
              apply leq_trans with (n := service_during sched j_lst t1 t2);
                first by apply job_interference_le_service.
              rewrite leqn0; apply/eqP; unfold service_during.
              by apply cumulative_service_before_job_arrival_zero with (job_arrival0 := job_arrival).
            Qed.

            (* Since there are multiple jobs, j_fst is far enough from the end of
               the interval that its response-time bound is valid
               (by the assumption H_all_previous_jobs_completed_on_time). *)
            Lemma interference_bound_edf_j_fst_completed_on_time :
              completed job_cost sched j_fst (a_fst + R_k).
            Proof.
              have FST := interference_bound_edf_j_fst_is_job_of_tsk_k; des.
              set j_snd := nth elem sorted_jobs 1.
              exploit interference_bound_edf_all_jobs_from_tsk_k.
              {
                by apply mem_nth; instantiate (1 := 1); rewrite H_at_least_two_jobs.
              }
              instantiate (1 := elem); move => [SNDarr [SNDtsk [/eqP SNDserv _]]].
              apply H_all_previous_jobs_completed_on_time; try (by done).
              apply leq_ltn_trans with (n := job_arrival j_snd); last first.
              {
                rewrite ltnNge; apply/negP; red; intro BUG; apply SNDserv.
                apply/eqP; rewrite -leqn0; apply leq_trans with (n := service_during
                                                                          sched j_snd t1 t2);
                  first by apply job_interference_le_service.
                rewrite leqn0; apply/eqP.
                by apply cumulative_service_before_job_arrival_zero with (job_arrival0 := job_arrival).
              }
              apply leq_trans with (n := a_fst + p_k).
              {
                by rewrite leq_add2l; apply leq_trans with (n := D_k);
                  [by apply H_R_k_le_deadline | by apply H_constrained_deadlines].
              }

              (* Since jobs are sporadic, we know that the first job arrives
                 at least p_k units before the second. *)
              unfold p_k; rewrite -FST0.
              apply H_sporadic_tasks; try (by done); [| by rewrite SNDtsk | ]; last first.
              {
                apply interference_bound_edf_jobs_ordered_by_arrival.
                by rewrite H_at_least_two_jobs.
              }
              red; move => /eqP BUG.
              by rewrite nth_uniq in BUG; rewrite ?SIZE //;
                [ by apply interference_bound_edf_at_least_one_job
                | by rewrite H_at_least_two_jobs
                | by rewrite sort_uniq; apply filter_uniq, undup_uniq].
            Qed.

          End FactsAboutFirstAndLastJobs.

          (* Next, we prove that the distance between the first and last jobs is at least
             num_mid_jobs + 1 periods. *)
          Lemma interference_bound_edf_many_periods_in_between :
            a_lst - a_fst >= num_mid_jobs.+1 * p_k.
          Proof.
            unfold a_fst, a_lst, j_fst, j_lst.
            assert (EQnk: num_mid_jobs.+1=(size sorted_jobs).-1).
              by rewrite H_at_least_two_jobs.
            rewrite EQnk telescoping_sum;
              last by ins; apply interference_bound_edf_jobs_ordered_by_arrival.
            rewrite -[_ * _ tsk_k]addn0 mulnC -iter_addn -{1}[_.-1]subn0 -big_const_nat.
            rewrite big_nat_cond [\sum_(0 <= i < _)(_-_)]big_nat_cond.
            apply leq_sum; intros i; rewrite andbT; move => /andP LT; des.

            (* To simplify, call the jobs 'cur' and 'next' *)
            set cur := nth elem sorted_jobs i.
            set next := nth elem sorted_jobs i.+1.

            (* Show that cur arrives earlier than next *)
            assert (ARRle: job_arrival cur <= job_arrival next).
              by unfold cur, next; apply interference_bound_edf_jobs_ordered_by_arrival.

            feed (interference_bound_edf_all_jobs_from_tsk_k cur).
              by apply mem_nth, (ltn_trans LT0); destruct sorted_jobs.
            intros [CURarr [CURtsk [_ CURin]]].

            feed (interference_bound_edf_all_jobs_from_tsk_k next).
              by apply mem_nth; destruct sorted_jobs.
            intros [NEXTarr [NEXTtsk [_ NEXTin]]].

            (* Use the sporadic task model to conclude that cur and next are separated
               by at least (task_period tsk) units. Of course this only holds if cur != next.
               Since we don't know much about the list (except that it's sorted), we must
               also prove that it doesn't contain duplicates. *)
            assert (CUR_LE_NEXT: job_arrival cur + task_period (job_task cur) <= job_arrival next).
            {
              apply H_sporadic_tasks; try (by done).
              unfold cur, next, not; intro EQ; move: EQ => /eqP EQ.
              rewrite nth_uniq in EQ; first by move: EQ => /eqP EQ; intuition.
                by apply ltn_trans with (n := (size sorted_jobs).-1); destruct sorted_jobs; ins.
                by destruct sorted_jobs; ins.
                by rewrite sort_uniq -/interfering_jobs filter_uniq // undup_uniq.
                by rewrite CURtsk.
            }
            by rewrite subh3 // addnC /p_k -CURtsk.
          Qed.

          Lemma interference_bound_edf_slack_le_delta:
            D_k - R_k <= D_i.
          Proof.
            have AFTERt1 :=
                interference_bound_edf_j_fst_completion_implies_rt_bound_inside_interval
                interference_bound_edf_j_fst_completed_on_time.
            rewrite leq_subLR -(leq_add2r a_fst).
            rewrite -addnA [R_k + _]addnC -addnA.
            apply leq_trans with (n := D_i + t1);
              last by rewrite leq_add2l.
            have FST := interference_bound_edf_j_fst_is_job_of_tsk_k.
            destruct FST as [ARRfst [_ [ LEdl _]]].
            apply interference_under_edf_implies_shorter_deadlines with
                (arr_seq0 := arr_seq) (job_deadline0 := job_deadline) in LEdl; try (by done).
            rewrite addnC [D_i + _]addnC.
            unfold D_k, D_i.
            by rewrite -interference_bound_edf_j_fst_deadline
                       -interference_bound_edf_j_i_deadline.
          Qed.

          (* Using the lemma above, we prove that the ratio n_k is at least the number of
             middle jobs + 1, ... *)
          Lemma interference_bound_edf_n_k_covers_all_jobs :
            n_k >= num_mid_jobs.+2.
          Proof.
            have AFTERt1 :=
                interference_bound_edf_j_fst_completion_implies_rt_bound_inside_interval
                interference_bound_edf_j_fst_completed_on_time.
            have SLACK := interference_bound_edf_slack_le_delta.
            rename H_valid_task_parameters into TASK_PARAMS,
                   H_tsk_k_in_task_set into INk.
            unfold valid_sporadic_taskset, is_valid_sporadic_task,
                   interference_bound, edf_specific_interference_bound in *.
            have DIST := interference_bound_edf_many_periods_in_between.
            rewrite leqNgt; apply/negP; unfold not; rewrite ltnS;  intro LTnk.
            assert (BUG: a_lst - a_fst > D_i + R_k - D_k).
            {
              apply leq_trans with (n := num_mid_jobs.+1 * p_k); last by done.
              apply leq_trans with (n := n_k * p_k);
                last by rewrite leq_mul2r; apply/orP; right.
              unfold n_k, div_ceil.
              feed (TASK_PARAMS tsk_k); [by done | des].
              destruct (p_k %| D_i + R_k - D_k + 1) eqn:DIV.
                - by rewrite dvdn_eq in DIV; move: DIV => /eqP DIV; rewrite DIV addn1.
                - by rewrite -addn1; apply ltnW, ltn_ceil.
            }
            rewrite leq_subLR in SLACK.
            rewrite -(leq_add2r a_fst) subh1 in BUG;
              last by apply interference_bound_edf_j_fst_before_j_lst.
            rewrite -[a_lst + _ - _]subnBA // subnn subn0 in BUG.
            rewrite addnC addnS in BUG.
            rewrite addnBA // in BUG; last by rewrite addnC.
            rewrite -(ltn_add2r D_k) in BUG.
            rewrite subh1 in BUG; last first.
            {
              rewrite [D_i + R_k]addnC.
              by apply leq_trans with (n := R_k + D_i);
                last by apply leq_addl.
            }
            rewrite -addnBA // subnn addn0 in BUG.
            rewrite [D_i + _]addnC addnA in BUG.
            apply leq_ltn_trans with (m := t1 + D_i) in BUG;
              last by rewrite leq_add2r.
            have LST := interference_bound_edf_j_lst_is_job_of_tsk_k.
            destruct LST as [ARRlst [_ [ LEdl _]]].
            apply interference_under_edf_implies_shorter_deadlines with
                  (arr_seq0 := arr_seq) (job_deadline0 := job_deadline) in LEdl; try (by done).
            unfold D_i, D_k in DIST; rewrite interference_bound_edf_j_lst_deadline
                                             interference_bound_edf_j_i_deadline in LEdl.
            by rewrite ltnNge LEdl in BUG.
          Qed.

          (* ... which allows bounding the interference of the middle and last jobs
             using n_k multiplied by the cost. *)
          Lemma interference_bound_edf_holds_for_multiple_jobs :
            \sum_(0 <= i < num_mid_jobs.+2)
              interference_caused_by (nth elem sorted_jobs i) t1 t2
            <= interference_bound.
          Proof.
            apply leq_trans with (n := num_mid_jobs.+2 * task_cost tsk_k); last first.
            {
              rewrite leq_mul2r; apply/orP; right.
              by apply interference_bound_edf_n_k_covers_all_jobs.
            }
            {
              apply leq_trans with (n := \sum_(0 <= i < num_mid_jobs.+2) task_cost tsk_k);
                last by rewrite big_const_nat iter_addn addn0 mulnC subn0.
              rewrite big_nat_cond [\sum_(0 <= i < _ | true) _]big_nat_cond.
              apply leq_sum; intros i; rewrite andbT; move => /andP LT; des.
              apply interference_bound_edf_interference_le_task_cost.
              rewrite interference_bound_edf_job_in_same_sequence.
              by apply mem_nth; rewrite H_at_least_two_jobs.
            }
          Qed.

        End InterferenceTwoOrMoreJobs.

      End InterferenceManyJobs.

      Theorem interference_bound_edf_bounds_interference :
        x <= interference_bound.
      Proof.
        (* Use the definition of workload based on list of jobs. *)
        apply (leq_trans interference_bound_edf_use_another_definition).

        (* We only care about the jobs that cause interference. *)
        rewrite interference_bound_edf_simpl_by_filtering_interfering_jobs.

        (* Now we order the list by job arrival time. *)
        rewrite interference_bound_edf_simpl_by_sorting_interfering_jobs.

        (* Next, we show that the workload bound holds if n_k
           is no larger than the number of interferings jobs. *)
        destruct (size sorted_jobs <= n_k) eqn:NUM;
          first by apply interference_bound_edf_holds_for_at_most_n_k_jobs.
        apply negbT in NUM; rewrite -ltnNge in NUM.

        (* Find some dummy element to use in the nth function *)
        assert (EX: exists elem: Job, True).
          destruct sorted_jobs as [| j]; [by rewrite ltn0 in NUM | by exists j].
        destruct EX as [elem _].

        (* Now we index the sum to access the first and last elements. *)
        rewrite (big_nth elem).

        (* First, we show that the bound holds for an empty list of jobs. *)
        destruct (size sorted_jobs) as [| n] eqn:SIZE;
          first by rewrite big_geq.

        (* Then, we show the same for a single job, or for multiple jobs. *)
        destruct n as [| num_mid_jobs].
        {
          rewrite big_nat_recr // big_geq //.
          rewrite [nth]lock /= -lock add0n.
          by apply interference_bound_edf_holds_for_a_single_job; rewrite SIZE.
        }
        {
          by apply interference_bound_edf_holds_for_multiple_jobs; first by rewrite SIZE.
        }
      Qed.

    End MainProof.

  End ProofSpecificBound.

  (* As required by the proof of convergence of EDF RTA, we show that the
     EDF-specific bound is monotonically increasing with both the size
     of the interval and the value of the previous response-time bounds. *)
  Section MonotonicitySpecificBound.

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

    Variable tsk tsk_other: sporadic_task.
    Hypothesis H_period_positive: task_period tsk_other > 0.

    Variable delta delta' R R': time.
    Hypothesis H_delta_monotonic: delta <= delta'.
    Hypothesis H_response_time_monotonic: R <= R'.
    Hypothesis H_cost_le_rt_bound: task_cost tsk_other <= R.

    Lemma interference_bound_edf_monotonic :
      interference_bound_edf task_cost task_period task_deadline tsk delta (tsk_other, R) <=
      interference_bound_edf task_cost task_period task_deadline tsk delta' (tsk_other, R').
    Proof.
      rename H_response_time_monotonic into LEr, H_delta_monotonic into LEx,
             H_cost_le_rt_bound into LEcost, H_period_positive into GEperiod.
      unfold interference_bound_edf, interference_bound_generic.
      rewrite leq_min; apply/andP; split.
      {
        apply leq_trans with (n := W task_cost task_period (fst (tsk_other, R))
                                     (snd (tsk_other, R)) delta);
          [by apply geq_minl | by apply W_monotonic].
      }
      {
        apply leq_trans with (n := edf_specific_interference_bound task_cost task_period
                                                          task_deadline tsk tsk_other R);
          first by apply geq_minr.
        unfold edf_specific_interference_bound; simpl.
        rewrite leq_mul2r; apply/orP; right.
        apply leq_divceil2r; first by done.
        by rewrite leq_add2r leq_sub2r // leq_add2l.
      }
    Qed.

  End MonotonicitySpecificBound.

End InterferenceBoundEDF.


Require Export base.

(* The set of propositional variables. *)
Inductive prop : Set :=
  p : nat -> prop.

(* Valuation function *)
Definition valuation (W: Set) : Type := set (prop * W).

Structure model := {
  m_states :> Set;
  m_rel : relation m_states;
  m_val: valuation m_states
}.

Structure pointed_model := {
  pm_model :> model;
  pm_point : pm_model
}.

Structure state_model (W: Set) := {
  st_point: W;
  st_rel: relation W;
  st_val: valuation W
}.

Definition muf : Type := forall (W : Set),
  state_model W -> set (state_model W).

Notation "⟨ a , b , c ⟩" :=
  {| st_point := a; st_val := c; st_rel := b |}.

Notation "⟪ a , b , c ⟫, m" :=
  {| pm_model := {| m_states := a; m_rel := b; m_val := c |};
     pm_point := m |} (at level 0).

Arguments st_point {W}.
Arguments st_rel {W}.
Arguments st_val {W}.

Definition to_pm {W} (st: state_model W) :=
  ⟪ _, st.(st_rel), st.(st_val) ⟫, (st.(st_point)).

Coercion to_pm: state_model >-> pointed_model.

Definition to_st 𝔐 := ⟨𝔐.(pm_point), 𝔐.(m_rel), 𝔐.(m_val)⟩.

Coercion to_st: pointed_model >-> state_model.

Lemma to_st_val (𝔐: pointed_model) : m_val 𝔐 = st_val 𝔐.
  by [].
Qed.

Lemma to_st_point (𝔐: pointed_model) : pm_point 𝔐 = st_point 𝔐.
  by [].
Qed.

Lemma to_st_to_pm {W} (st: state_model W): to_st (to_pm st) = st.
  by case: st.
Defined.


Require Export XR_R.
Require Export XR_Ropp.
Require Export XR_Rplus_0_l.
Require Export XR_Rplus_opp_r.
Require Export XR_Rplus_eq_reg_r.

Local Open Scope R_scope.
Implicit Type r : R.

Lemma Ropp_neq_0_compat : forall r, r <> R0 -> - r <> R0.
Proof.
  intros x h.
  unfold not.
  unfold not in h.
  intro heq.
  apply h.
  apply Rplus_eq_reg_r with (-x).
  rewrite Rplus_opp_r.
  rewrite Rplus_0_l.
  symmetry.
  exact heq.
Qed.


Require Import Coq.Lists.List.
Require Import PL.Imp PL.RTClosure.

Inductive com : Type :=
  | CSkip
  | CAss (X: var) (a : aexp)
  | CSeq (c1 c2 : com)
  | CIf (b : bexp) (c1 c2 : com)
  | CWhile (b : bexp) (c : com)
  | CBreak
  | CCont
  .

Record denote: Type := {
  NormalExit: state -> state -> Prop;
  BreakExit: state -> state -> Prop;
  ContExit: state -> state -> Prop;
}.

Definition skip_sem: denote := {|
  NormalExit := BinRel.id;
  BreakExit := BinRel.empty;
  ContExit := BinRel.empty
|}.

Definition break_sem: denote := {|
  NormalExit := BinRel.empty;
  BreakExit := BinRel.id;
  ContExit := BinRel.empty
|}.

Definition cont_sem: denote := {|
  NormalExit := BinRel.empty;
  BreakExit := BinRel.empty;
  ContExit := BinRel.id
|}.

Definition asgn_sem (X: var) (E: aexp): denote := {|
  NormalExit :=
    fun st1 st2 =>
      st2 X = aeval E st1 /\
      (forall Y, X <> Y -> st1 Y = st2 Y);
  BreakExit := BinRel.empty;
  ContExit := BinRel.empty
|}.

Definition seq_sem (d1 d2: denote): denote := {|
  NormalExit := BinRel.concat (NormalExit d1) (NormalExit d2);
  BreakExit := BinRel.union
                 (BreakExit d1)
                 (BinRel.concat (NormalExit d1) (BreakExit d2));
  ContExit := BinRel.union
                (ContExit d1)
                (BinRel.concat (NormalExit d1) (ContExit d2));
|}.

Definition if_sem (b: bexp) (d1 d2: denote): denote := {|
  NormalExit := BinRel.union
                  (BinRel.concat
                     (BinRel.test_rel (beval b))
                     (NormalExit d1))
                  (BinRel.concat
                     (BinRel.test_rel (beval (BNot b)))
                     (NormalExit d2));
  BreakExit := BinRel.union
                 (BinRel.concat
                    (BinRel.test_rel (beval b))
                    (BreakExit d1))
                 (BinRel.concat
                    (BinRel.test_rel (beval (BNot b)))
                    (BreakExit d2));
  ContExit := BinRel.union
                (BinRel.concat
                   (BinRel.test_rel (beval b))
                   (ContExit d1))
                (BinRel.concat
                   (BinRel.test_rel (beval (BNot b)))
                   (ContExit d2))
|}.

Fixpoint iter_loop_body (b: bexp) (d: denote) (n: nat): state -> state -> Prop :=
  match n with
  | O    => BinRel.union
              (BinRel.test_rel (beval (! b)))
              (BinRel.concat (BinRel.test_rel (beval b)) (BreakExit d))
  | S n' => BinRel.concat
              (BinRel.test_rel (beval b))
              (BinRel.concat
                 (BinRel.union (NormalExit d) (ContExit d))
                 (iter_loop_body b d n'))
  end.

Definition loop_sem (b: bexp) (d: denote): denote := {|
  NormalExit := BinRel.omega_union (iter_loop_body b d);
  BreakExit := BinRel.empty;
  ContExit := BinRel.empty
|}.

Fixpoint ceval (c: com): denote :=
  match c with
  | CSkip => skip_sem
  | CAss X E => asgn_sem X E
  | CSeq c1 c2 => seq_sem (ceval c1) (ceval c2)
  | CIf b c1 c2 => if_sem b (ceval c1) (ceval c2)
  | CWhile b c => loop_sem b (ceval c)
  | CBreak => break_sem
  | CCont => cont_sem
  end.

Definition cstack: Type := list (bexp * com * com).

Inductive start_with_break: com -> Prop :=
| SWB_Break: start_with_break CBreak
| SWB_Seq: forall c1 c2,
             start_with_break c1 ->
             start_with_break (CSeq c1 c2).

Inductive start_with_cont: com -> Prop :=
| SWC_Cont: start_with_cont CCont
| SWC_Seq: forall c1 c2,
             start_with_cont c1 ->
             start_with_cont (CSeq c1 c2).

Inductive start_with_loop: com -> bexp -> com -> com -> Prop :=
| SWL_While: forall b c, start_with_loop (CWhile b c) b c CSkip
| SWL_Seq: forall c1 b c11 c12 c2,
             start_with_loop c1 b c11 c12 ->
             start_with_loop (CSeq c1 c2) b c11 (CSeq c12 c2).

Inductive cstep : (com * cstack * state) -> (com * cstack * state) -> Prop :=
  | CS_AssStep : forall st s X a a',
      astep st a a' ->
      cstep
        (CAss X a, s, st)
        (CAss X a', s, st)
  | CS_Ass : forall st1 st2 s X n,
      st2 X = n ->
      (forall Y, X <> Y -> st1 Y = st2 Y) ->
      cstep
        (CAss X (ANum n), s, st1)
        (CSkip, s, st2)
  | CS_SeqStep : forall st s c1 c1' st' c2,
      cstep
        (c1, s, st)
        (c1', s, st') ->
      cstep
        (CSeq c1 c2, s, st)
        (CSeq c1' c2, s, st')
  | CS_Seq : forall st s c2,
      cstep
        (CSeq CSkip c2, s, st)
        (c2, s, st)
  | CS_IfStep : forall st s b b' c1 c2,
      bstep st b b' ->
      cstep
        (CIf b c1 c2, s, st)
        (CIf b' c1 c2, s, st)
  | CS_IfTrue : forall st s c1 c2,
      cstep
        (CIf BTrue c1 c2, s, st)
        (c1, s, st)
  | CS_IfFalse : forall st s c1 c2,
      cstep
        (CIf BFalse c1 c2, s, st)
        (c2, s, st)
  | CS_While : forall st s c b c1 c2,
      start_with_loop c b c1 c2 ->
      cstep
        (c, s, st)
        (CIf b c1 CBreak, (b, c1, c2) :: s, st)
  | CS_Skip : forall st s b c1 c2,
      cstep
        (CSkip, (b, c1, c2) :: s, st)
        (CIf b c1 CBreak, (b, c1, c2) :: s, st)
  | CS_Break : forall st s b c1 c2 c,
      start_with_break c ->
      cstep
        (c, (b, c1, c2) :: s, st)
        (c2, s, st)
  | CS_Cont : forall st s b c1 c2 c,
      start_with_cont c ->
      cstep
        (c, (b, c1, c2) :: s, st)
        (CIf b c1 CBreak, (b, c1, c2) :: s, st)
.

Ltac induction_cstep H :=
  match type of H with
  | ?cstep ?a ?b =>
    revert_dependent_component a H;
    revert_dependent_component b H;
    let a0 := fresh "cst" in
    let b0 := fresh "cst" in
    let EQa := fresh "EQ" in
    let EQb := fresh "EQ" in
    remember a as a0 eqn:EQa in H;
    remember b as b0 eqn:EQb in H;
    revert EQa EQb;
    revert_component a;
    revert_component b;
    match goal with
    | |- ?Q =>
      let Pab := eval pattern a0, b0 in Q in
      match Pab with
      | ?P a0 b0 =>
        change (P a0 b0); induction H
      end
    end;
    intros ? ? ? ?;
    match goal with
    | IH: forall _ _ _ _, _ = _ -> _ = _ -> _ |- _ =>
      specialize_until_EQ IH;
      specialize (IH eq_refl)
    | _ => idtac
    end;
    intros_until_EQ EQa; intros EQb;
        match goal with
          | |- ?Base =>
            let Base0 := fresh in
            remember Base as Base0 in |- *;
            first [ injection EQa; clear EQa; intros_and_subst Base0
                  | revert EQa; intros_and_subst Base0
                  | idtac ];
            subst Base0
          end;
          match goal with
          | |- ?Base =>
            let Base0 := fresh in
            remember Base as Base0 in |- *;
            first [ injection EQb; clear EQb; intros_and_subst Base0
                  | revert EQb; intros_and_subst Base0
                  | idtac ];
            subst Base0
          end
  end.

(* 2021-05-08 18:58 *)