(** * Syntax for the rowing machines *)
Require Export fintype.
Require Import Vectors.Vector Lia.
Require Import Utils.Various_utils.
Import VectorNotations.

Section row.

Context {w : nat}.

Inductive row (nrow : nat) : Type :=
  | var_row : fin w -> (fin) (nrow) -> row (nrow)
  | abst : Vector.t (row  ((S) nrow)) w -> row (nrow)
  | halt : row (nrow).

(** ** Custom induction for rows *)
Fixpoint size {n} (r : row n) : nat:=
   match r with
   | abst _ t => S (vsum (map size t))
   | _ => 1
   end.

Fact lt_S {l k} : l < S k -> (l = k) + (l < k).
Proof. intros Hk. destruct (Compare_dec.lt_eq_lt_dec l k) as [[H|H]|H]; auto. lia.
Qed.

Lemma row_size_ind (P : forall nrow, row nrow -> Prop) :
  (forall nrow x, (forall mrow y, size y < size x -> P mrow y) -> P nrow x) ->
  forall nrow x, P nrow x.
Proof. intro H. intros. apply H. induction (size x); intros. lia. destruct (lt_S H0).
  -apply H. rewrite e. apply IHn.
  -apply IHn,l.
Qed.

Fact inSize {n} {t : Vector.t (row (S n)) w} {a} : In a t -> size a < size (abst _ t).
Proof. intro. cbn. assert (In (size a) (map size t)).
  { induction H. now apply In_cons_hd. now apply In_cons_tl. }
  pose (in_smaller _ _ H0). lia.
Qed.

Lemma row_vect_ind (P : forall nrow, row nrow -> Prop):
  (forall nrow (f : fin w) (f0 : fin nrow), P nrow (var_row nrow f f0)) ->
  (forall nrow (t : t (row (S nrow)) w), Forall (P (S nrow)) t -> P nrow (abst nrow t)) ->
  (forall nrow, P nrow (halt nrow)) ->
  forall nrow (r : row nrow), P nrow r.
Proof. intros Hv Ha Hh. eapply row_size_ind. destruct x; intros. 1,3: auto.
  apply Ha. apply Forall_forall. intros. apply H. now apply inSize.
Qed.

(** ** Modified Autosubst output
Renamings and substitutions have an extra argument to access the vectors, this argument remains unchanged when the renaming or substitution is modified
*)
Lemma congr_abst { mrow : nat } { s0 : Vector.t (row  ((S) mrow)) w } { t0 : Vector.t (row  ((S) mrow)) w } (H1 : s0 = t0) : abst (mrow) s0 = abst (mrow) t0 .
Proof. congruence. Qed.

Lemma congr_halt { mrow : nat } : halt (mrow) = halt (mrow) .
Proof. congruence. Qed.

Definition upRen_row_row { m : nat } { n : nat } (xi : (fin) (m) -> (fin) (n)) : (fin) ((S) (m)) -> (fin) ((S) (n)) :=
  (up_ren) xi.

Fixpoint ren_row { mrow : nat } { nrow : nat } (xirow : (fin) (mrow) -> (fin) (nrow)) (s : row (mrow)) : row (nrow) :=
    match s return row (nrow) with
    | var_row (_) i s => (var_row (nrow) i) (xirow s)
    | abst (_) s0 => abst (nrow) (map (ren_row (upRen_row_row xirow)) s0)
    | halt (_)  => halt (nrow)
    end.

Definition up_row_row { m : nat } { nrow : nat } (sigma : fin w -> (fin) (m) -> row (nrow)) : fin w -> (fin) ((S) (m)) -> row ((S) nrow) :=
  fun i => (scons) ((var_row ((S) nrow) i) (var_zero)) ((funcomp) (ren_row (shift)) (sigma i)).

Fixpoint subst_row { mrow : nat } { nrow : nat } (sigmarow : fin w -> (fin) (mrow) -> row (nrow)) (s : row (mrow)) : row (nrow) :=
    match s return row (nrow) with
    | var_row (_) i s => sigmarow i s
    | abst (_) s0 => abst (nrow) (map (subst_row (up_row_row sigmarow)) s0)
    | halt (_)  => halt (nrow)
    end.

Definition upId_row_row { mrow : nat } (sigma : fin w -> (fin) (mrow) -> row (mrow)) (Eq : forall i x, sigma i x = (var_row (mrow) i) x) : forall i x, (up_row_row sigma) i x = (var_row ((S) mrow) i) x :=
  fun i n => match n with
  | Some fin_n => (ap) (ren_row (shift)) (Eq i fin_n)
  | None  => eq_refl
  end.

(* Fixpoint idSubst_row { mrow : nat } (sigmarow : (fin) (mrow) -> row (mrow)) (Eqrow : forall x, sigmarow x = (var_row (mrow)) x) (s : row (mrow)) : subst_row sigmarow s = s :=
    match s return subst_row sigmarow s = s with
    | var_row (_) s => Eqrow s
    | abst (_) s0 => congr_abst ((idSubst_row (up_row_row sigmarow) (upId_row_row (_) Eqrow)) s0)
    | halt (_)  => congr_halt
    end. *)
Lemma idSubst_row' { mrow : nat } (s : row (mrow)):
  forall (sigmarow : fin w -> (fin) (mrow) -> row (mrow)) (Eqrow : forall i x, sigmarow i x = (var_row (mrow) i) x), subst_row sigmarow s = s.
Proof. apply (row_vect_ind (fun n (s : row n) => forall (sig : fin w -> fin n -> row n) (Eq : forall (i : fin w) (x : fin n), sig i x = var_row n i x), subst_row sig s = s)); intros.
  -apply Eq.
  -apply congr_abst. rewrite (map_ext_in _ _ _ id). apply map_id. unfold id. apply Forall_forall.
    apply (Forall_impl _ (fun s : row (S nrow) => forall sig : fin w -> fin (S nrow) -> row (S nrow), (forall (i : fin w) (x : fin (S nrow)), sig i x = var_row (S nrow) i x) -> subst_row sig s = s)); auto.
    intros. apply H0. apply (upId_row_row _ Eq).
  -apply congr_halt.
Defined.
Definition idSubst_row { mrow : nat } (sigmarow : fin w -> (fin) (mrow) -> row (mrow)) (Eqrow : forall i x, sigmarow i x = (var_row (mrow)i ) x) (s : row (mrow)) : subst_row sigmarow s = s.
Proof. now apply idSubst_row'. Defined.

Definition upExtRen_row_row { m : nat } { n : nat } (xi : (fin) (m) -> (fin) (n)) (zeta : (fin) (m) -> (fin) (n)) (Eq : forall x, xi x = zeta x) : forall x, (upRen_row_row xi) x = (upRen_row_row zeta) x :=
  fun n => match n with
  | Some fin_n => (ap) (shift) (Eq fin_n)
  | None  => eq_refl
  end.

(* Fixpoint extRen_row { mrow : nat } { nrow : nat } (xirow : (fin) (mrow) -> (fin) (nrow)) (zetarow : (fin) (mrow) -> (fin) (nrow)) (Eqrow : forall x, xirow x = zetarow x) (s : row (mrow)) : ren_row xirow s = ren_row zetarow s :=
    match s return ren_row xirow s = ren_row zetarow s with
    | var_row (_) s => (ap) (var_row (nrow)) (Eqrow s)
    | abst (_) s0 => congr_abst ((extRen_row (upRen_row_row xirow) (upRen_row_row zetarow) (upExtRen_row_row (_) (_) Eqrow)) s0)
    | halt (_)  => congr_halt
    end. *)
Lemma extRen_row' { mrow : nat } (s : row (mrow)) :
  forall (nrow : nat) (xirow : (fin) (mrow) -> (fin) (nrow)) (zetarow : (fin) (mrow) -> (fin) (nrow)) (Eqrow : forall x, xirow x = zetarow x), ren_row xirow s = ren_row zetarow s.
Proof. eapply (row_vect_ind (fun m r => forall n xi zeta (Eq : forall x, xi x = zeta x), ren_row xi r = ren_row zeta r)); intros.
  - apply (ap (var_row _ f) (Eq f0)).
  - apply congr_abst. apply map_ext_in. apply Forall_forall.
    apply (Forall_impl _ (fun r  => forall (n : nat) (xi zeta : fin (S nrow) -> fin n), (forall x : fin (S nrow), xi x = zeta x) -> ren_row xi r = ren_row zeta r) ); auto.
    intros. apply H0. apply upExtRen_row_row,Eq.
  - apply congr_halt.
Defined.
Definition extRen_row { mrow : nat } { nrow : nat } (xirow : (fin) (mrow) -> (fin) (nrow)) (zetarow : (fin) (mrow) -> (fin) (nrow)) (Eqrow : forall x, xirow x = zetarow x) (s : row (mrow)) : ren_row xirow s = ren_row zetarow s.
Proof. now apply extRen_row'. Defined.

Definition upExt_row_row { m : nat } { nrow : nat } (sigma : fin w -> (fin) (m) -> row (nrow)) (tau : fin w -> (fin) (m) -> row (nrow)) (Eq : forall i x, sigma i x = tau i x) : forall i x, (up_row_row sigma) i x = (up_row_row tau) i x :=
  fun i n => match n with
  | Some fin_n => (ap) (ren_row (shift)) (Eq i fin_n)
  | None  => eq_refl
  end.

(* Fixpoint ext_row { mrow : nat } { nrow : nat } (sigmarow : (fin) (mrow) -> row (nrow)) (taurow : (fin) (mrow) -> row (nrow)) (Eqrow : forall x, sigmarow x = taurow x) (s : row (mrow)) : subst_row sigmarow s = subst_row taurow s :=
    match s return subst_row sigmarow s = subst_row taurow s with
    | var_row (_) s => Eqrow s
    | abst (_) s0 => congr_abst ((ext_row (up_row_row sigmarow) (up_row_row taurow) (upExt_row_row (_) (_) Eqrow)) s0)
    | halt (_)  => congr_halt
    end. *)
Lemma ext_row' { mrow : nat } (s : row (mrow)):
  forall (nrow :  nat) (sigmarow : fin w -> (fin) (mrow) -> row (nrow)) (taurow : fin w -> (fin) (mrow) -> row (nrow)) (Eqrow : forall i x, sigmarow i x = taurow i x), subst_row sigmarow s = subst_row taurow s.
Proof. apply (row_vect_ind (fun m r => forall (nrow : nat) (sigmarow taurow : fin w -> fin m -> row nrow) (Eq: forall (i : fin w) (x : fin m), sigmarow i x = taurow i x), subst_row sigmarow r = subst_row taurow r)); intros.
  - apply Eq.
  - apply congr_abst. apply map_ext_in. apply Forall_forall.
    apply (Forall_impl _ (fun r : row (S nrow) => forall (nrow0 : nat) (sigmarow taurow : fin w -> fin (S nrow) -> row nrow0), (forall (i : fin w) (x : fin (S nrow)), sigmarow i x = taurow i x) -> subst_row sigmarow r = subst_row taurow r)); auto.
    intros. apply H0. apply upExt_row_row,Eq.
  - apply congr_halt.
Defined.
Definition ext_row { mrow : nat } { nrow : nat } (sigmarow : fin w -> (fin) (mrow) -> row (nrow)) (taurow : fin w -> (fin) (mrow) -> row (nrow)) (Eqrow : forall i x, sigmarow i x = taurow i x) (s : row (mrow)) : subst_row sigmarow s = subst_row taurow s.
Proof. now apply ext_row'. Defined.

Definition up_ren_ren_row_row { k : nat } { l : nat } { m : nat } (xi : (fin) (k) -> (fin) (l)) (tau : (fin) (l) -> (fin) (m)) (theta : (fin) (k) -> (fin) (m)) (Eq : forall x, ((funcomp) tau xi) x = theta x) : forall x, ((funcomp) (upRen_row_row tau) (upRen_row_row xi)) x = (upRen_row_row theta) x :=
  up_ren_ren xi tau theta Eq.

(* Fixpoint compRenRen_row { krow : nat } { lrow : nat } { mrow : nat } (xirow : (fin) (mrow) -> (fin) (krow)) (zetarow : (fin) (krow) -> (fin) (lrow)) (rhorow : (fin) (mrow) -> (fin) (lrow)) (Eqrow : forall x, ((funcomp) zetarow xirow) x = rhorow x) (s : row (mrow)) : ren_row zetarow (ren_row xirow s) = ren_row rhorow s :=
    match s return ren_row zetarow (ren_row xirow s) = ren_row rhorow s with
    | var_row (_) s => (ap) (var_row (lrow)) (Eqrow s)
    | abst (_) s0 => congr_abst ((compRenRen_row (upRen_row_row xirow) (upRen_row_row zetarow) (upRen_row_row rhorow) (up_ren_ren (_) (_) (_) Eqrow)) s0)
    | halt (_)  => congr_halt
    end. *)
Lemma compRenRen_row' m (s : row m):
  forall { krow : nat } { lrow : nat } (xirow : (fin) (m) -> (fin) (krow)) (zetarow : (fin) (krow) -> (fin) (lrow)) (rhorow : (fin) (m) -> (fin) (lrow)) (Eqrow : forall x, ((funcomp) zetarow xirow) x = rhorow x), ren_row zetarow (ren_row xirow s) = ren_row rhorow s.
Proof. apply (row_vect_ind (fun m s => forall (krow lrow : nat) (xirow : fin m -> fin krow) (zetarow : fin krow -> fin lrow) (rhorow : fin m -> fin lrow) (Eq : forall x : fin m, (xirow >> zetarow) x = rhorow x), ren_row zetarow (ren_row xirow s) = ren_row rhorow s)); intros.
  - apply (ap (var_row lrow f) (Eq f0)).
  - apply congr_abst. rewrite map_map. apply map_ext_in. apply Forall_forall.
    apply (Forall_impl _ (fun s : row (S nrow) => forall (krow lrow : nat) (xirow : fin (S nrow) -> fin krow) (zetarow : fin krow -> fin lrow) (rhorow : fin (S nrow) -> fin lrow), (forall x : fin (S nrow), (xirow >> zetarow) x = rhorow x) -> ren_row zetarow (ren_row xirow s) = ren_row rhorow s)); auto.
    intros. apply H0. apply up_ren_ren,Eq.
  - apply congr_halt.
Defined.
Definition compRenRen_row { krow : nat } { lrow : nat } { mrow : nat } (xirow : (fin) (mrow) -> (fin) (krow)) (zetarow : (fin) (krow) -> (fin) (lrow)) (rhorow : (fin) (mrow) -> (fin) (lrow)) (Eqrow : forall x, ((funcomp) zetarow xirow) x = rhorow x) (s : row (mrow)) : ren_row zetarow (ren_row xirow s) = ren_row rhorow s.
Proof. now apply compRenRen_row'. Defined.

Definition up_ren_subst_row_row { k : nat } { l : nat } { mrow : nat } (xi : (fin) (k) -> (fin) (l)) (tau : fin w -> (fin) (l) -> row (mrow)) (theta : fin w -> (fin) (k) -> row (mrow)) (Eq : forall i x, ((funcomp) (tau i) xi) x = theta i x) : forall i x, ((funcomp) (up_row_row tau i) (upRen_row_row xi)) x = (up_row_row theta) i x :=
  fun i n => match n with
  | Some fin_n => (ap) (ren_row (shift)) (Eq i fin_n)
  | None  => eq_refl
  end.

(* Fixpoint compRenSubst_row { krow : nat } { lrow : nat } { mrow : nat } (xirow : (fin) (mrow) -> (fin) (krow)) (taurow : (fin) (krow) -> row (lrow)) (thetarow : (fin) (mrow) -> row (lrow)) (Eqrow : forall x, ((funcomp) taurow xirow) x = thetarow x) (s : row (mrow)) : subst_row taurow (ren_row xirow s) = subst_row thetarow s :=
    match s return subst_row taurow (ren_row xirow s) = subst_row thetarow s with
    | var_row (_) s => Eqrow s
    | abst (_) s0 => congr_abst ((compRenSubst_row (upRen_row_row xirow) (up_row_row taurow) (up_row_row thetarow) (up_ren_subst_row_row (_) (_) (_) Eqrow)) s0)
    | halt (_)  => congr_halt
    end. *)
Lemma compRenSubst_row' m (s : row m):
  forall { krow : nat } { lrow : nat } (xirow : (fin) m -> (fin) (krow)) (taurow : fin w -> (fin) (krow) -> row (lrow)) (thetarow : fin w -> (fin) m -> row (lrow)) (Eqrow : forall i x, ((funcomp) (taurow i) xirow) x = thetarow i x), subst_row taurow (ren_row xirow s) = subst_row thetarow s.
Proof. apply (row_vect_ind (fun m s => forall (krow lrow : nat) (xirow : fin m -> fin krow) (taurow : fin w -> fin krow -> row lrow) (thetarow : fin w -> fin m -> row lrow) (Eq : forall (i : fin w) (x : fin m), (xirow >> taurow i) x = thetarow i x), subst_row taurow (ren_row xirow s) = subst_row thetarow s)); intros.
  - apply Eq.
  - apply congr_abst. rewrite map_map. apply map_ext_in. apply Forall_forall.
    apply (Forall_impl _ (fun s : row (S nrow) => forall (krow lrow : nat) (xirow : fin (S nrow) -> fin krow) (taurow : fin w -> fin krow -> row lrow) (thetarow : fin w -> fin (S nrow) -> row lrow), (forall (i : fin w) (x : fin (S nrow)), (xirow >> taurow i) x = thetarow i x) -> subst_row taurow (ren_row xirow s) = subst_row thetarow s)); auto.
    intros. apply H0. apply up_ren_subst_row_row,Eq.
  - apply congr_halt.
Defined.
Definition compRenSubst_row { krow : nat } { lrow : nat } { mrow : nat } (xirow : (fin) (mrow) -> (fin) (krow)) (taurow : fin w -> (fin) (krow) -> row (lrow)) (thetarow : fin w -> (fin) (mrow) -> row (lrow)) (Eqrow : forall i x, ((funcomp) (taurow i) xirow) x = thetarow i x) (s : row (mrow)) : subst_row taurow (ren_row xirow s) = subst_row thetarow s.
Proof. now apply compRenSubst_row'. Defined.

Definition up_subst_ren_row_row { k : nat } { lrow : nat } { mrow : nat } (sigma : fin w -> (fin) (k) -> row (lrow)) (zetarow : (fin) (lrow) -> (fin) (mrow)) (theta : fin w -> (fin) (k) -> row (mrow)) (Eq : forall i x, ((funcomp) (ren_row zetarow) (sigma i)) x = theta i x) : forall i x, ((funcomp) (ren_row (upRen_row_row zetarow)) (up_row_row sigma i)) x = (up_row_row theta) i x :=
  fun i n => match n with
  | Some fin_n => (eq_trans) (compRenRen_row (shift) (upRen_row_row zetarow) ((funcomp) (shift) zetarow) (fun x => eq_refl) (sigma i fin_n)) ((eq_trans) ((eq_sym) (compRenRen_row zetarow (shift) ((funcomp) (shift) zetarow) (fun x => eq_refl) (sigma i fin_n))) ((ap) (ren_row (shift)) (Eq i fin_n)))
  | None  => eq_refl
  end.

(* Fixpoint compSubstRen_row { krow : nat } { lrow : nat } { mrow : nat } (sigmarow : (fin) (mrow) -> row (krow)) (zetarow : (fin) (krow) -> (fin) (lrow)) (thetarow : (fin) (mrow) -> row (lrow)) (Eqrow : forall x, ((funcomp) (ren_row zetarow) sigmarow) x = thetarow x) (s : row (mrow)) : ren_row zetarow (subst_row sigmarow s) = subst_row thetarow s :=
    match s return ren_row zetarow (subst_row sigmarow s) = subst_row thetarow s with
    | var_row (_) s => Eqrow s
    | abst (_) s0 => congr_abst ((compSubstRen_row (up_row_row sigmarow) (upRen_row_row zetarow) (up_row_row thetarow) (up_subst_ren_row_row (_) (_) (_) Eqrow)) s0)
    | halt (_)  => congr_halt
    end. *)
Lemma compSubstRen_row' m (s : row m):
  forall { krow : nat } { lrow : nat } (sigmarow : fin w -> (fin) m -> row (krow)) (zetarow : (fin) (krow) -> (fin) (lrow)) (thetarow : fin w -> (fin) m -> row (lrow)) (Eqrow : forall i x, ((funcomp) (ren_row zetarow) (sigmarow i)) x = thetarow i x), ren_row zetarow (subst_row sigmarow s) = subst_row thetarow s.
Proof. apply (row_vect_ind (fun m s => forall (krow lrow : nat) (sigmarow : fin w -> fin m -> row krow) (zetarow : fin krow -> fin lrow) (thetarow : fin w -> fin m -> row lrow) (Eq: forall (i : fin w) (x : fin m), (sigmarow i >> ren_row zetarow) x = thetarow i x), ren_row zetarow (subst_row sigmarow s) = subst_row thetarow s)); intros.
  - apply Eq.
  - apply congr_abst. rewrite map_map. apply map_ext_in. apply Forall_forall.
    apply (Forall_impl _ (fun s : row (S nrow) => forall (krow lrow : nat) (sigmarow : fin w -> fin (S nrow) -> row krow) (zetarow : fin krow -> fin lrow) (thetarow : fin w -> fin (S nrow) -> row lrow), (forall (i : fin w) (x : fin (S nrow)), (sigmarow i >> ren_row zetarow) x = thetarow i x) -> ren_row zetarow (subst_row sigmarow s) = subst_row thetarow s)); auto.
   intros. apply H0. apply up_subst_ren_row_row,Eq.
  - apply congr_halt.
Defined.
Definition compSubstRen_row { krow : nat } { lrow : nat } { mrow : nat } (sigmarow : fin w -> (fin) (mrow) -> row (krow)) (zetarow : (fin) (krow) -> (fin) (lrow)) (thetarow : fin w -> (fin) (mrow) -> row (lrow)) (Eqrow : forall i x, ((funcomp) (ren_row zetarow) (sigmarow i)) x = thetarow i x) (s : row (mrow)) : ren_row zetarow (subst_row sigmarow s) = subst_row thetarow s.
Proof. now apply compSubstRen_row'. Defined.

(* Definition up_subst_subst_row_row { k : nat } { lrow : nat } { mrow : nat } (sigma : fin w -> (fin) (k) -> row (lrow)) (taurow : fin w -> (fin) (lrow) -> row (mrow)) (theta : fin w -> (fin) (k) -> row (mrow)) (Eq : forall i x, ((funcomp) (subst_row (taurow)) (sigma i)) x = theta i x) : forall i x, ((funcomp) (subst_row (up_row_row taurow)) (up_row_row sigma i)) x = (up_row_row theta) i x :=
  fun i n => match n with
  | Some fin_n => (eq_trans) (compRenSubst_row (shift) (up_row_row taurow) ((funcomp) (up_row_row taurow) (shift)) (fun x => eq_refl) (sigma fin_n)) ((eq_trans) ((eq_sym) (compSubstRen_row taurow (shift) ((funcomp) (ren_row (shift)) taurow) (fun x => eq_refl) (sigma fin_n))) ((ap) (ren_row (shift)) (Eq fin_n)))
  | None  => eq_refl
  end.
 *)
Definition up_subst_subst_row_row { k : nat } { lrow : nat } { mrow : nat } (sigma : fin w -> (fin) (k) -> row (lrow)) (taurow : fin w -> (fin) (lrow) -> row (mrow)) (theta : fin w -> (fin) (k) -> row (mrow)) (Eq : forall i x, ((funcomp) (subst_row (taurow)) (sigma i)) x = theta i x) : forall i x, ((funcomp) (subst_row (up_row_row taurow)) (up_row_row sigma i)) x = (up_row_row theta) i x.
Proof. intros i [j |]. 2: apply eq_refl. apply (eq_trans (compRenSubst_row ↑ (up_row_row taurow) (fun i => ↑ >> up_row_row taurow i) (fun _ _ => eq_refl) (sigma i j) )).
  apply (eq_trans (eq_sym (compSubstRen_row taurow ↑ (fun i => taurow i >> ren_row ↑) (fun _ _ => eq_refl) (sigma i j)))).
  apply (ap (ren_row ↑)), Eq.
Defined.

(* Fixpoint compSubstSubst_row { krow : nat } { lrow : nat } { mrow : nat } (sigmarow : (fin) (mrow) -> row (krow)) (taurow : (fin) (krow) -> row (lrow)) (thetarow : (fin) (mrow) -> row (lrow)) (Eqrow : forall x, ((funcomp) (subst_row taurow) sigmarow) x = thetarow x) (s : row (mrow)) : subst_row taurow (subst_row sigmarow s) = subst_row thetarow s :=
    match s return subst_row taurow (subst_row sigmarow s) = subst_row thetarow s with
    | var_row (_) s => Eqrow s
    | abst (_) s0 => congr_abst ((compSubstSubst_row (up_row_row sigmarow) (up_row_row taurow) (up_row_row thetarow) (up_subst_subst_row_row (_) (_) (_) Eqrow)) s0)
    | halt (_)  => congr_halt
    end. *)
Lemma compSubstSubst_row' m (s : row m) :
  forall { krow : nat } { lrow : nat } (sigmarow : fin w -> (fin) m -> row (krow)) (taurow : fin w -> (fin) (krow) -> row (lrow)) (thetarow : fin w -> (fin) (m) -> row (lrow)) (Eqrow : forall i x, ((funcomp) (subst_row taurow) (sigmarow i)) x = thetarow i x), subst_row taurow (subst_row sigmarow s) = subst_row thetarow s.
Proof. apply (row_vect_ind (fun m s => forall (krow lrow : nat) (sigmarow : fin w -> fin m -> row krow) (taurow : fin w -> fin krow -> row lrow) (thetarow : fin w -> fin m -> row lrow) (Eq : forall (i : fin w) (x : fin m), (sigmarow i >> subst_row taurow) x = thetarow i x), subst_row taurow (subst_row sigmarow s) = subst_row thetarow s)); intros.
  -apply Eq.
  -apply congr_abst. rewrite map_map. apply map_ext_in. apply Forall_forall.
    apply (Forall_impl _ (fun s : row (S nrow) => forall (krow lrow : nat) (sigmarow : fin w -> fin (S nrow) -> row krow) (taurow : fin w -> fin krow -> row lrow) (thetarow : fin w -> fin (S nrow) -> row lrow), (forall (i : fin w) (x : fin (S nrow)), (sigmarow i >> subst_row taurow) x = thetarow i x) -> subst_row taurow (subst_row sigmarow s) = subst_row thetarow s)); auto.
    intros. apply H0. apply up_subst_subst_row_row,Eq.
  -apply congr_halt.
Defined.
Definition compSubstSubst_row { krow : nat } { lrow : nat } { mrow : nat } (sigmarow : fin w -> (fin) (mrow) -> row (krow)) (taurow : fin w -> (fin) (krow) -> row (lrow)) (thetarow : fin w -> (fin) (mrow) -> row (lrow)) (Eqrow : forall i x, ((funcomp) (subst_row taurow) (sigmarow i)) x = thetarow i x) (s : row (mrow)) : subst_row taurow (subst_row sigmarow s) = subst_row thetarow s.
Proof. now apply compSubstSubst_row'. Defined.

Definition rinstInst_up_row_row { m : nat } { nrow : nat } (xi : (fin) (m) -> (fin) (nrow)) (sigma : fin w -> (fin) (m) -> row (nrow)) (Eq : forall i x, ((funcomp) (var_row (nrow) i) xi) x = sigma i x) : forall i x, ((funcomp) (var_row ((S) nrow) i) (upRen_row_row xi)) x = (up_row_row sigma) i x :=
  fun i n => match n with
  | Some fin_n => (ap) (ren_row (shift)) (Eq i fin_n)
  | None  => eq_refl
  end.

(* Fixpoint rinst_inst_row { mrow : nat } { nrow : nat } (xirow : (fin) (mrow) -> (fin) (nrow)) (sigmarow : (fin) (mrow) -> row (nrow)) (Eqrow : forall x, ((funcomp) (var_row (nrow)) xirow) x = sigmarow x) (s : row (mrow)) : ren_row xirow s = subst_row sigmarow s :=
    match s return ren_row xirow s = subst_row sigmarow s with
    | var_row (_) s => Eqrow s
    | abst (_) s0 => congr_abst ((rinst_inst_row (upRen_row_row xirow) (up_row_row sigmarow) (rinstInst_up_row_row (_) (_) Eqrow)) s0)
    | halt (_)  => congr_halt
    end. *)
Lemma rinst_inst_row' m (s : row m) :
  forall { nrow : nat } (xirow : (fin) (m) -> (fin) (nrow)) (sigmarow : fin w -> (fin) (m) -> row (nrow)) (Eqrow : forall i x, ((funcomp) (var_row (nrow) i) xirow) x = sigmarow i x), ren_row xirow s = subst_row sigmarow s.
Proof. apply (row_vect_ind (fun m s => forall (nrow : nat) (xirow : fin m -> fin nrow) (sigmarow : fin w -> fin m -> row nrow) (Eq : forall (i : fin w) (x : fin m), (xirow >> var_row nrow i) x = sigmarow i x), ren_row xirow s = subst_row sigmarow s)); intros.
  -apply Eq.
  -apply congr_abst. apply map_ext_in. apply Forall_forall.
   apply (Forall_impl _ (fun s : row (S nrow) => forall (nrow0 : nat) (xirow : fin (S nrow) -> fin nrow0) (sigmarow : fin w -> fin (S nrow) -> row nrow0), (forall (i : fin w) (x : fin (S nrow)), (xirow >> var_row nrow0 i) x = sigmarow i x) -> ren_row xirow s = subst_row sigmarow s)); auto.
    intros. apply H0. apply rinstInst_up_row_row,Eq.
  -apply congr_halt.
Defined.
Definition rinst_inst_row { mrow : nat } { nrow : nat } (xirow : (fin) (mrow) -> (fin) (nrow)) (sigmarow : fin w -> (fin) (mrow) -> row (nrow)) (Eqrow : forall i x, ((funcomp) (var_row (nrow) i) xirow) x = sigmarow i x) (s : row (mrow)) : ren_row xirow s = subst_row sigmarow s.
Proof. now apply rinst_inst_row'. Defined.

Lemma rinstInst_row { mrow : nat } { nrow : nat } (xirow : (fin) (mrow) -> (fin) (nrow)) : ren_row xirow = subst_row (fun i => (funcomp) (var_row (nrow) i) xirow) .
Proof. exact ((FunctionalExtensionality.functional_extensionality _ _ ) (fun x => rinst_inst_row xirow (_) (fun _ n => eq_refl) x)). Qed.

Lemma instId_row { mrow : nat } : subst_row (var_row (mrow)) = id .
Proof. exact ((FunctionalExtensionality.functional_extensionality _ _ ) (fun x => idSubst_row (var_row (mrow)) (fun _ n => eq_refl) ((id) x))). Qed.

Lemma rinstId_row { mrow : nat } : @ren_row (mrow) (mrow) (id) = id .
Proof. exact ((eq_trans) (rinstInst_row ((id) (_))) instId_row). Qed.

Lemma varL_row { mrow : nat } { nrow : nat } (sigmarow : fin w -> (fin) (mrow) -> row (nrow)) : (fun i => (funcomp) (subst_row sigmarow) (var_row (mrow) i)) = sigmarow .
Proof. exact ((FunctionalExtensionality.functional_extensionality _ _ ) (fun x => eq_refl)). Qed.

Lemma varLRen_row { mrow : nat } { nrow : nat } (xirow : (fin) (mrow) -> (fin) (nrow)) : (fun i => (funcomp) (ren_row xirow) (var_row (mrow) i)) = (fun i => (funcomp) (var_row (nrow) i) xirow) .
Proof. exact ((FunctionalExtensionality.functional_extensionality _ _ ) (fun x => eq_refl)). Qed.

Lemma compComp_row { krow : nat } { lrow : nat } { mrow : nat } (sigmarow : fin w -> (fin) (mrow) -> row (krow)) (taurow : fin w -> (fin) (krow) -> row (lrow)) (s : row (mrow)) : subst_row taurow (subst_row sigmarow s) = subst_row (fun i => (funcomp) (subst_row taurow) (sigmarow i)) s .
Proof. exact (compSubstSubst_row sigmarow taurow (_) (fun _ n => eq_refl) s). Qed.

Lemma compComp'_row { krow : nat } { lrow : nat } { mrow : nat } (sigmarow : fin w -> (fin) (mrow) -> row (krow)) (taurow : fin w -> (fin) (krow) -> row (lrow)) : (funcomp) (subst_row taurow) (subst_row sigmarow) = subst_row (fun i => (funcomp) (subst_row taurow) (sigmarow i)) .
Proof. exact ((FunctionalExtensionality.functional_extensionality _ _ ) (fun n => compComp_row sigmarow taurow n)). Qed.

Lemma compRen_row { krow : nat } { lrow : nat } { mrow : nat } (sigmarow : fin w -> (fin) (mrow) -> row (krow)) (zetarow : (fin) (krow) -> (fin) (lrow)) (s : row (mrow)) : ren_row zetarow (subst_row sigmarow s) = subst_row (fun i => (funcomp) (ren_row zetarow) (sigmarow i)) s .
Proof. exact (compSubstRen_row sigmarow zetarow (_) (fun _ n => eq_refl) s). Qed.

Lemma compRen'_row { krow : nat } { lrow : nat } { mrow : nat } (sigmarow : fin w -> (fin) (mrow) -> row (krow)) (zetarow : (fin) (krow) -> (fin) (lrow)) : (funcomp) (ren_row zetarow) (subst_row sigmarow) = subst_row (fun i => (funcomp) (ren_row zetarow) (sigmarow i)) .
Proof. exact ((FunctionalExtensionality.functional_extensionality _ _ ) (fun n => compRen_row sigmarow zetarow n)). Qed.

Lemma renComp_row { krow : nat } { lrow : nat } { mrow : nat } (xirow : (fin) (mrow) -> (fin) (krow)) (taurow : fin w -> (fin) (krow) -> row (lrow)) (s : row (mrow)) : subst_row taurow (ren_row xirow s) = subst_row (fun i => (funcomp) (taurow i) xirow) s .
Proof. exact (compRenSubst_row xirow taurow (_) (fun _ n => eq_refl) s). Qed.

Lemma renComp'_row { krow : nat } { lrow : nat } { mrow : nat } (xirow : (fin) (mrow) -> (fin) (krow)) (taurow : fin w -> (fin) (krow) -> row (lrow)) : (funcomp) (subst_row taurow) (ren_row xirow) = subst_row (fun i => (funcomp) (taurow i) xirow) .
Proof. exact ((FunctionalExtensionality.functional_extensionality _ _ ) (fun n => renComp_row xirow taurow n)). Qed.

Lemma renRen_row { krow : nat } { lrow : nat } { mrow : nat } (xirow : (fin) (mrow) -> (fin) (krow)) (zetarow : (fin) (krow) -> (fin) (lrow)) (s : row (mrow)) : ren_row zetarow (ren_row xirow s) = ren_row ((funcomp) zetarow xirow) s .
Proof. exact (compRenRen_row xirow zetarow (_) (fun n => eq_refl) s). Qed.

Lemma renRen'_row { krow : nat } { lrow : nat } { mrow : nat } (xirow : (fin) (mrow) -> (fin) (krow)) (zetarow : (fin) (krow) -> (fin) (lrow)) : (funcomp) (ren_row zetarow) (ren_row xirow) = ren_row ((funcomp) zetarow xirow) .
Proof. exact ((FunctionalExtensionality.functional_extensionality _ _ ) (fun n => renRen_row xirow zetarow n)). Qed.

End row.

Arguments var_row {w} {nrow}.

Arguments abst {w} {nrow}.

Arguments halt {w} {nrow}.

(* Global Instance Subst_row { mrow : nat } { nrow : nat } : Subst1 ((fin) (mrow) -> row (nrow)) (row (mrow)) (row (nrow)) := @subst_row (mrow) (nrow) . *)

(* Global Instance Ren_row { mrow : nat } { nrow : nat } : Ren1 ((fin) (mrow) -> (fin) (nrow)) (row (mrow)) (row (nrow)) := @ren_row (mrow) (nrow) . *)

(* Global Instance VarInstance_row { mrow : nat } : Var ((fin) (mrow)) (row (mrow)) := @var_row (mrow) . *)

(* Notation "x '__row'" := (var_row x) (at level 5, format "x __row") : subst_scope. *)

(* Notation "x '__row'" := (@ids (_) (_) VarInstance_row x) (at level 5, only printing, format "x __row") : subst_scope. *)

(* Notation "'var'" := (var_row) (only printing, at level 1) : subst_scope. *)

Class Up_row X Y := up_row : X -> Y.

(* Notation "↑__row" := (up_row) (only printing) : subst_scope. *)

(* Notation "↑__row" := (up_row_row) (only printing) : subst_scope. *)

(* Global Instance Up_row_row { m : nat } { nrow : nat } : Up_row (_) (_) := @up_row_row (m) (nrow) . *)

(* Notation "s [ sigmarow ]" := (subst_row sigmarow s) (at level 7, left associativity, only printing) : subst_scope. *)

(* Notation "[ sigmarow ]" := (subst_row sigmarow) (at level 1, left associativity, only printing) : fscope. *)

(* Notation "s ⟨ xirow ⟩" := (ren_row xirow s) (at level 7, left associativity, only printing) : subst_scope. *)

(* Notation "⟨ xirow ⟩" := (ren_row xirow) (at level 1, left associativity, only printing) : fscope. *)

Ltac auto_unfold := repeat unfold subst1,  subst2,  Subst1,  Subst2,  ids,  ren1,  ren2,  Ren1,  Ren2(* ,  Subst_row,  Ren_row,  VarInstance_row *).

Tactic Notation "auto_unfold" "in" "*" := repeat unfold subst1,  subst2,  Subst1,  Subst2,  ids,  ren1,  ren2,  Ren1,  Ren2(* ,  Subst_row,  Ren_row,  VarInstance_row *) in *.

Ltac asimpl' := repeat first [progress rewrite ?instId_row| progress rewrite ?compComp_row| progress rewrite ?compComp'_row| progress rewrite ?rinstId_row| progress rewrite ?compRen_row| progress rewrite ?compRen'_row| progress rewrite ?renComp_row| progress rewrite ?renComp'_row| progress rewrite ?renRen_row| progress rewrite ?renRen'_row| progress rewrite ?varL_row| progress rewrite ?varLRen_row| progress (unfold up_ren, upRen_row_row, up_row_row)| progress (cbn [subst_row ren_row])| fsimpl].

Ltac asimpl := repeat try unfold_funcomp; auto_unfold in *; asimpl'; repeat try unfold_funcomp.

Tactic Notation "asimpl" "in" hyp(J) := revert J; asimpl; intros J.

Tactic Notation "auto_case" := auto_case (asimpl; cbn; eauto).

Tactic Notation "asimpl" "in" "*" := auto_unfold in *; repeat first [progress rewrite ?instId_row in *| progress rewrite ?compComp_row in *| progress rewrite ?compComp'_row in *| progress rewrite ?rinstId_row in *| progress rewrite ?compRen_row in *| progress rewrite ?compRen'_row in *| progress rewrite ?renComp_row in *| progress rewrite ?renComp'_row in *| progress rewrite ?renRen_row in *| progress rewrite ?renRen'_row in *| progress rewrite ?varL_row in *| progress rewrite ?varLRen_row in *| progress (unfold up_ren, upRen_row_row, up_row_row in *)| progress (cbn [subst_row ren_row] in *)| fsimpl in *].

Ltac substify := auto_unfold; try repeat (erewrite rinstInst_row).

Ltac renamify := auto_unfold; try repeat (erewrite <- rinstInst_row).


(***********************************************************************

 Monads in the bicategory of univalent categories

 In this file, we relate the concept of monad internal to a bicategory
 to the concept of monad given in category theory

 Contents
 1. Monads internal to `bicat_of_univ_cats` to monads
 2. The inverse
 3. The equivalence

 ***********************************************************************)
Require Import UniMath.Foundations.All.
Require Import UniMath.MoreFoundations.All.
Require Import UniMath.CategoryTheory.Core.Categories.
Require Import UniMath.CategoryTheory.Core.Isos.
Require Import UniMath.CategoryTheory.Core.Functors.
Require Import UniMath.CategoryTheory.Core.NaturalTransformations.
Require Import UniMath.CategoryTheory.Core.Univalence.
Require Import UniMath.CategoryTheory.Monads.Monads.
Require Import UniMath.CategoryTheory.DisplayedCats.Core.
Require Import UniMath.Bicategories.Core.Bicat.
Import Bicat.Notations.
Require Import UniMath.Bicategories.Core.Examples.BicatOfUnivCats.
Require Import UniMath.Bicategories.DisplayedBicats.DispBicat.
Import DispBicat.Notations.
Require Import UniMath.Bicategories.DisplayedBicats.Examples.MonadsLax.

Local Open Scope cat.

(**
 1. Monads internal to `bicat_of_univ_cats` to monads
 *)
Definition mnd_bicat_of_univ_cats_to_Monad
           (m : mnd bicat_of_univ_cats)
  : Monad (pr1 (ob_of_mnd m)).
Proof.
  simple refine (((_ ,, _) ,, _) ,, _).
  - exact (endo_of_mnd m).
  - exact (mult_of_mnd m).
  - exact (unit_of_mnd m).
  - repeat split.
    + abstract
        (intro x ; cbn ;
         pose (nat_trans_eq_pointwise (mnd_unit_right m) x) as p ;
         cbn in p ;
         rewrite id_left in p ;
         exact p).
    + abstract
        (intro x ; cbn ;
         pose (nat_trans_eq_pointwise (mnd_unit_left m) x) as p ;
         cbn in p ;
         rewrite id_left in p ;
         exact p).
    + abstract
        (intro x ; cbn ;
         pose (nat_trans_eq_pointwise (mnd_mult_assoc m) x) as p ;
         cbn in p ;
         rewrite id_left in p ;
         exact (!p)).
Defined.

(**
 2. The inverse
 *)
Definition Monad_to_mnd_bicat_of_univ_cats
           {C : univalent_category}
           (m : Monad C)
  : mnd bicat_of_univ_cats.
Proof.
  use make_mnd.
  - use make_mnd_data.
    + exact C.
    + cbn.
      exact m.
    + exact (η m).
    + exact (μ m).
  - repeat split.
    + abstract
        (use nat_trans_eq ; [ apply homset_property | ] ;
         intro x ;
         cbn ;
         rewrite id_left ;
         apply m).
    + abstract
        (use nat_trans_eq ; [ apply homset_property | ] ;
         intro x ;
         cbn ;
         rewrite id_left ;
         apply m).
    + abstract
        (use nat_trans_eq ; [ apply homset_property | ] ;
         intro x ;
         cbn ;
         rewrite id_left ;
         refine (!_) ;
         apply m).
Defined.

(**
 3. The equivalence
 *)
Definition mnd_bicat_of_univ_cats_weq_Monad_inv₁
           (m : mnd bicat_of_univ_cats)
  : Monad_to_mnd_bicat_of_univ_cats (mnd_bicat_of_univ_cats_to_Monad m) = m.
Proof.
  use total2_paths_f.
  - apply idpath.
  - cbn.
    use subtypePath.
    {
      intro.
      apply isaprop_is_mnd.
    }
    apply idpath.
Qed.

Definition mnd_bicat_of_univ_cats_weq_Monad_inv₂
           {C : univalent_category}
           (m : Monad C)
  : mnd_bicat_of_univ_cats_to_Monad (Monad_to_mnd_bicat_of_univ_cats m) = m.
Proof.
  use subtypePath.
  {
    intro.
    apply isaprop_Monad_laws.
  }
  apply idpath.
Qed.

Definition mnd_bicat_of_univ_cats_weq_Monad
  : mnd bicat_of_univ_cats ≃ ∑ (C : univalent_category), Monad C.
Proof.
  use make_weq.
  - exact (λ m, ob_of_mnd m ,, mnd_bicat_of_univ_cats_to_Monad m).
  - use isweq_iso.
    + exact (λ m, Monad_to_mnd_bicat_of_univ_cats (pr2 m)).
    + exact mnd_bicat_of_univ_cats_weq_Monad_inv₁.
    + abstract
        (intro m ;
         refine (maponpaths (λ z, pr1 m ,, z) _) ;
         exact (mnd_bicat_of_univ_cats_weq_Monad_inv₂ (pr2 m))).
Defined.


Require Export prosa.results.fixed_priority.rta.bounded_nps.
Require Export prosa.analysis.facts.preemption.rtc_threshold.limited.

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

(** * RTA for FP-schedulers with Fixed Preemption Points *)
(** In this module we prove the RTA theorem for FP-schedulers with
    fixed preemption points. *)

(** Throughout this file, we assume the FP priority policy, ideal uni-processor
    schedules, and the basic (i.e., Liu & Layland) readiness model. *)
Require Import prosa.model.processor.ideal.
Require Import prosa.model.readiness.basic.

(** Furthermore, we assume the task model with fixed preemption points. *)
Require Import prosa.model.preemption.limited_preemptive.
Require Import prosa.model.task.preemption.limited_preemptive.

(** ** Setup and Assumptions *)

Section RTAforFixedPreemptionPointsModelwithArrivalCurves.

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

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

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

  (** 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 : all_jobs_from_taskset arr_seq ts.

  (** ... and the cost of a job cannot be larger than the task cost. *)
  Hypothesis H_valid_job_cost:
    arrivals_have_valid_job_costs arr_seq.

  (** First, we assume we have the model with fixed preemption points.
      I.e., each task is divided into a number of non-preemptive segments
      by inserting statically predefined preemption points. *)
  Context `{JobPreemptionPoints Job}
          `{TaskPreemptionPoints Task}.
  Hypothesis H_valid_model_with_fixed_preemption_points:
    valid_fixed_preemption_points_model arr_seq ts.

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

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

  (** Next, consider any ideal uni-processor schedule  with limited preemptions of this arrival sequence ... *)
  Variable sched : schedule (ideal.processor_state Job).
  Hypothesis H_jobs_come_from_arrival_sequence:
    jobs_come_from_arrival_sequence sched arr_seq.
  Hypothesis H_schedule_respects_preemption_model:
    schedule_respects_preemption_model arr_seq sched.

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

  (** Consider an FP policy that indicates a higher-or-equal priority relation,
     and assume that the relation is reflexive and transitive. *)
  Context `{FP_policy Task}.
  Hypothesis H_priority_is_reflexive : reflexive_priorities.
  Hypothesis H_priority_is_transitive : transitive_priorities.

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

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

  (** ... and the schedule respects the policy defined by the [job_preemptable]
     function (i.e., jobs have bounded non-preemptive segments). *)
  Hypothesis H_respects_policy : respects_policy_at_preemption_point arr_seq sched.

  (** ** Total Workload and Length of Busy Interval *)

  (** 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.

  (** 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 with higher priority
      ... *)
  Let total_hep_rbf := total_hep_request_bound_function_FP ts tsk.

  (** ... and the request bound function of all tasks with higher
      priority other than task [tsk]. *)
  Let total_ohep_rbf := total_ohep_request_bound_function_FP ts tsk.

  (** Next, we define a bound for the priority inversion caused by tasks of lower priority. *)
  Let blocking_bound :=
    \max_(tsk_other <- ts | ~~ hep_task tsk_other tsk)
     (task_max_nonpreemptive_segment tsk_other - ε).

  (** Let L be any positive fixed point of the busy interval recurrence, determined by
     the sum of blocking and higher-or-equal-priority workload. *)
  Variable L : duration.
  Hypothesis H_L_positive : L > 0.
  Hypothesis H_fixed_point : L = blocking_bound + total_hep_rbf L.

  (** ** Response-Time Bound *)

  (** To reduce the time complexity of the analysis, recall the notion of search space. *)
  Let is_in_search_space := is_in_search_space tsk L.

  (** Next, consider any value R, and assume that for any given arrival A from 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 : duration),
      is_in_search_space A ->
      exists (F : duration),
        A + F = blocking_bound
                + (task_rbf (A + ε) - (task_last_nonpr_segment tsk - ε))
                + total_ohep_rbf (A + F) /\
        F + (task_last_nonpr_segment tsk - ε) <= R.

  (** Now, we can reuse the results for the abstract model with
      bounded non-preemptive segments to establish a response-time
      bound for the more concrete model of fixed preemption points. *)

  Let response_time_bounded_by := task_response_time_bound arr_seq sched.

  Theorem uniprocessor_response_time_bound_fp_with_fixed_preemption_points:
    response_time_bounded_by tsk R.
  Proof.
    move: (H_valid_model_with_fixed_preemption_points) => [MLP [BEG [END [INCR [HYP1 [HYP2 HYP3]]]]]].
    move: (MLP) => [BEGj [ENDj _]].
    edestruct (posnP (task_cost tsk)) as [ZERO|POSt].
    { intros j ARR TSK.
      move: (H_valid_job_cost _ ARR) => POSt.
      move: POSt; rewrite /valid_job_cost TSK ZERO leqn0; move => /eqP Z.
        by rewrite /job_response_time_bound /completed_by Z.
    }
    eapply uniprocessor_response_time_bound_fp_with_bounded_nonpreemptive_segments
      with (L0 := L).
    all: eauto 2 with basic_facts.
    intros A SP.
    destruct (H_R_is_maximum _ SP) as[FF [EQ1 EQ2]].
    exists FF; rewrite subKn; first by done.
    rewrite /task_last_nonpr_segment  -(leq_add2r 1) subn1 !addn1 prednK; last first.
    - rewrite /last0 -nth_last.
      apply HYP3; try by done.
      rewrite -(ltn_add2r 1) !addn1 prednK //.
      move: (number_of_preemption_points_in_task_at_least_two
               _ _ H_valid_model_with_fixed_preemption_points _ H_tsk_in_ts POSt) => Fact2.
      move: (Fact2) => Fact3.
        by rewrite size_of_seq_of_distances // addn1 ltnS // in Fact2.
    - apply leq_trans with (task_max_nonpreemptive_segment 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.


Require Import Category.Lib.
Require Import Category.Theory.Category.
Require Import Category.Theory.Isomorphism.
Require Import Category.Theory.Functor.
Require Import Category.Structure.Cartesian.
Require Import Category.Structure.Cartesian.Closed.
Require Import Category.Functor.Structure.Cartesian.

Generalizable All Variables.

Section ClosedFunctor.

Context `{F : C ⟶ D}.
Context `{@CartesianFunctor C D F CA CB}.
Context `{@Closed C CA}.
Context `{@Closed D CB}.

Class ClosedFunctor := {
  fobj_exp_iso {x y : C} : F (y^x) ≅ F y ^ F x;

  exp_in  := fun x y => from (@fobj_exp_iso x y);
  exp_out := fun x y => to   (@fobj_exp_iso x y);

  fmap_curry {x y z : C} {f : x × y ~> z} :
    fmap (curry f) ≈ exp_in _ _ ∘ curry (fmap f ∘ prod_in);
  fmap_uncurry {x y z : C} (f : x ~> z^y) :
    fmap (uncurry f) ≈ uncurry (exp_out _ _ ∘ fmap f) ∘ prod_out
}.

Context `{@ClosedFunctor}.

Arguments exp_in {_ _ _} /.
Arguments exp_out {_ _ _} /.

Corollary fmap_eval {x y : C} :
  fmap (@eval C _ _ x y) ≈ uncurry (curry eval ∘ exp_out) ∘ prod_out.
Proof.
  intros.
  unfold eval, eval'.
  rewrite fmap_uncurry; cat.
Qed.

Corollary exp_in_out {x y : C} :
  exp_in ∘ exp_out ≈ @id _ (F (y^x)).
Proof. apply iso_from_to. Qed.

#[local] Hint Rewrite @exp_in_out : functors.

Corollary exp_out_in {x y : C} :
  exp_out ∘ exp_in ≈ @id _ (F y ^ F x).
Proof. apply iso_to_from. Qed.

#[local] Hint Rewrite @exp_out_in : functors.

Corollary exp_in_inj {x y z : C} (f g : F x ~> F z ^ F y) :
  exp_in ∘ f ≈ exp_in ∘ g ↔ f ≈ g.
Proof.
  split; intros Hexp.
  - rewrite <- id_left.
    rewrite <- exp_out_in.
    rewrite <- comp_assoc.
    rewrite Hexp.
    rewrite comp_assoc.
    autorewrite with functors; cat.
  - subst.
    rewrite Hexp.
    reflexivity.
Qed.

Corollary exp_out_inj {x y z : C} (f g : F x ~> F (z^y)) :
  exp_out ∘ f ≈ exp_out ∘ g ↔ f ≈ g.
Proof.
  split; intros Hexp.
  - rewrite <- id_left.
    rewrite <- exp_in_out.
    rewrite <- comp_assoc.
    rewrite Hexp.
    rewrite comp_assoc.
    autorewrite with functors; cat.
  - subst.
    rewrite Hexp.
    reflexivity.
Qed.

End ClosedFunctor.

Arguments exp_in {_ _ _ _ _ _ _ _ _ _ _} /.
Arguments exp_out {_ _ _ _ _ _ _ _ _ _ _} /.

#[export] Hint Rewrite @exp_in_out : functors.
#[export] Hint Rewrite @exp_out_in : functors.


Require Import SetoidClass.
Require Import Views.BasicSetoids.
Require Import Views.Setof.
Require Import Views.Tactics.
Require Import Views.Structures.

Section BasicDisjointPartialMaps.
  Variables Dom Codom : Type.
  Let PartialMap := Dom -> option Codom.
  Program Instance Map_Extensional_Setoid : Setoid PartialMap :=
    {| equiv := fun m m' => forall d, m d = m' d |}.
  Obligation 1.
   split; try firstorder.
   repeat intro.
   use_foralls; rewr auto.
  Qed.


(* Author : CESally *)
Require Export Setoid Ensembles Utf8.
Reserved Notation "x @ y" (at level 20, left associativity).

Delimit Scope group_scope with grp.
Arguments In [_].
Arguments Included [_].
Notation "e ∈ S" := (In S e) (at level 20) : group_scope.
Notation "A ⊆ B" := (Included A B) (at level 20) : group_scope.
Open Scope group_scope.

Section top.
Context {C : Type}.
Variable D  : Ensemble C.
Variable op : C -> C -> C.
Variable   e  : C.
Hypothesis ein: e ∈ D.
Local Infix "@" := op (at level 20, left associativity).

Definition is_assoc : Prop := ∀ x y z : C,
  x ∈ D -> y ∈ D -> z ∈ D ->
  x @ y @ z = x @ (y @ z).

Definition is_comm : Prop := ∀ x y : C,
  x ∈ D -> y ∈ D -> x @ y = y @ x.

Definition idempotent (x: C) : Prop :=
  x ∈ D /\ x @ x = x.

Definition order2 (x: C) : Prop :=
  x ∈ D /\ x @ x = e.

Definition l_ident : Prop := ∀ x, x ∈ D -> e @ x = x.
Definition r_ident : Prop := ∀ x, x ∈ D -> x @ e = x.
Definition   ident : Prop := ∀ x, x ∈ D -> e @ x = x /\ x @ e = x.

Definition l_inv (inv:C -> C) : Prop := ∀ x, x ∈ D -> inv x @ x = e.
Definition r_inv (inv:C -> C) : Prop := ∀ x, x ∈ D -> x @ inv x = e.

Definition closed_u (inv: C -> C) : Prop := ∀ x,
  x ∈ D -> (inv x) ∈ D.
Definition closed_b : Prop := ∀ x y,
  x ∈ D -> y ∈ D -> (x @ y) ∈ D.

Definition is_l_inv_of (x' x e:C) : Prop := x' @ x = e.
Definition is_r_inv_of (x' x e:C) : Prop := x @ x' = e.

Definition conjugate (h g: C) (inv: C -> C) : C := h @ g @ (inv h).

End top.

Close Scope group_scope.


Require Import Category.Lib.
Require Import Category.Theory.Category.
Require Import Category.Theory.Isomorphism.
Require Import Category.Theory.Functor.
Require Import Category.Construction.Comma.
Require Import Category.Functor.Diagonal.
Require Import Category.Instance.Cat.

Generalizable All Variables.

Program Definition Slice `(C : Category) `(c : C) : Category := {|
  obj     := ∃ a : C, a ~> c;
  hom     := fun x y => ∃ f : (`1 x) ~> (`1 y), `2 y ∘ f ≈ `2 x;
  homset  := fun _ _ => {| equiv := fun f g => `1 f ≈ `1 g |} ;
  id      := fun _ => (id; _);
  compose := fun _ _ _ f g => (`1 f ∘ `1 g; _)
|}.
Next Obligation. rewrite comp_assoc; rewrites; reflexivity. Defined.

Notation "C  ̸ c" := (@Slice C c) (at level 90) : category_scope.

(* Although the encoding of Slice above is more convenient, theoretically it's
   the comma category (Id[C] ↓ Δ(c)). *)

#[local] Set Transparent Obligations.

#[export]
Program Instance Comma_Slice `(C : Category) `(c : C) :
  C ̸ c ≅[Cat] (Id ↓ =(c)) := {
  to   := {| fobj := _; fmap := _ |};
  from := {| fobj := _; fmap := _ |}
}.
Next Obligation.
  destruct p, p0; simpl.
  exists h.
  rewrites; cat.
Defined.
Next Obligation.
  proper; simpl.
  now destruct H0, H1, p; simpl.
Qed.
Next Obligation.
  now destruct p.
Qed.
Next Obligation.
  now destruct p, p0, p1, p2.
Qed.
Next Obligation.
  constructive; simplify; simpl in *; cat.
  - destruct H, H0; simpl; cat.
  - destruct H, H0; cat.
Qed.
Next Obligation.
  constructive; simplify; simpl in *; cat.
Qed.

Program Definition Coslice `(C : Category) `(c : C) : Category := {|
  obj     := ∃ a : C, c ~> a;
  hom     := fun x y => ∃ f : (`1 x) ~> (`1 y), `2 y ≈ f ∘ `2 x;
  homset  := fun _ _ => {| equiv := fun f g => `1 f ≈ `1 g |} ;
  id      := fun _ => (id; _);
  compose := fun _ _ _ f g => (`1 f ∘ `1 g; _)
|}.
Next Obligation. rewrite <- comp_assoc; rewrites; reflexivity. Defined.

Notation "c  ̸co C" := (@Coslice C c) (at level 90) : category_scope.

#[export]
Program Instance Comma_Coslice `(C : Category) `(c : C) :
  c ̸co C ≅[Cat] (=(c) ↓ Id) := {
  to   := {| fobj := _; fmap := _ |};
  from := {| fobj := _; fmap := _ |}
}.
Next Obligation.
  destruct p, p0; simpl.
  exists h.
  rewrites; cat.
Defined.
Next Obligation.
  proper; simpl.
  now destruct x0, x1, p; simpl.
Qed.
Next Obligation.
  now destruct p.
Qed.
Next Obligation.
  now destruct p, p0, p1, p2.
Qed.
Next Obligation.
  constructive; simplify; simpl in *; cat.
  - destruct x0, x1; simpl; cat.
  - destruct x0, x1; simpl; cat.
Qed.
Next Obligation.
  constructive; simplify; simpl in *; cat.
Qed.


From MatchingLogic Require Import Logic ProofMode.MLPM.

From Coq Require Import String.

Import
  MatchingLogic.Logic.Notations
  MatchingLogic.DerivedOperators_Syntax.Notations
.

Set Default Proof Mode "Classic".

Open Scope ml_scope.
Open Scope string_scope.
Open Scope list_scope.

Section with_signature.

Context {Σ : Signature}.

Local Lemma P1_complete (Γ : Theory) (ϕ ψ : Pattern):
  well_formed ϕ -> well_formed ψ ->
  mkMLGoal _ Γ [] (ϕ ---> ψ ---> ϕ) BasicReasoning.
Proof.
  intros.
  do 2 mlIntro. mlAssumption.
Qed.

Local Lemma P2_complete (Γ : Theory) (ϕ ψ ξ : Pattern):
  well_formed ϕ -> well_formed ψ -> well_formed ξ ->
  mkMLGoal _ Γ [] ((ϕ ---> ψ ---> ξ) ---> (ϕ ---> ψ) ---> ϕ ---> ξ) BasicReasoning.
Proof.
  intros.
  do 3 mlIntro.
  mlApply "0". mlSplitAnd.
  * mlAssumption.
  * mlApply "1". mlAssumption.
Qed.

Local Lemma P3_complete Γ ϕ :
  well_formed ϕ ->
  mkMLGoal _ Γ [] (! ! ϕ ---> ϕ) BasicReasoning.
Proof.
  intros.
  mlIntro.
  mlAssert ("H" : (ϕ or ! ϕ)). wf_auto2.
  { mlIntro. mlAssumption. }
  mlDestructOr "H".
  * mlAssumption.
  * mlExFalso. mlApply "0". mlAssumption.
Qed.

Local Lemma MP_complete Γ ϕ ψ i:
  well_formed ϕ -> well_formed ψ ->
  mkMLGoal _ Γ [] ϕ i -> mkMLGoal _ Γ [] (ϕ ---> ψ) i  ->
  mkMLGoal _ Γ [] ψ i.
Proof.
  intros.
  mlAssert ("H" : (ϕ and (ϕ ---> ψ))). wf_auto2.
  { mlSplitAnd; assumption. }
  mlDestructAnd "H".
  mlApply "1". mlAssumption.
Qed.

Local Lemma Ex_quan_complete (Γ : Theory) (ϕ : Pattern) (y : evar):
  well_formed (ex , ϕ) ->
  mkMLGoal _ Γ [] ((ex , ϕ) ^ [patt_free_evar y] ---> (ex , ϕ)) BasicReasoning.
Proof.
  intros. mlIntro "H".
  unfold instantiate.
  mlExists y. mlAssumption.
Qed.

Local Lemma Ex_gen_complete (Γ : Theory) (ϕ₁ ϕ₂ : Pattern) (x : evar) (i : ProofInfo):
  well_formed ϕ₁ -> well_formed ϕ₂ ->
  ProofInfoLe (ExGen := {[x]}, SVSubst := ∅, KT := false, AKT := false) i ->
  x ∉ free_evars ϕ₂ ->
  mkMLGoal _ Γ [] (ϕ₁ ---> ϕ₂) i ->
  mkMLGoal _ Γ [] (exists_quantify x ϕ₁ ---> ϕ₂) i.
Proof.
  unfold exists_quantify. intros.
  mlIntro "H0".
  mlDestructEx "H0" as x.
  rewrite evar_open_evar_quantify. wf_auto2.
  mlRevertLast. assumption.
Qed.

End with_signature.


Require Export XR_R1_neq_R0.
Require Export XR_Rinv_r.
Require Export XR_Rmult_eq_reg_l.

Local Open Scope R_scope.

Lemma Rinv_1 : / R1 = R1.
Proof.
  apply Rmult_eq_reg_l with R1.
  {
    rewrite Rinv_r.
    {
      rewrite Rmult_1_l.
      reflexivity.
    }
    { exact R1_neq_R0. }
  }
  { exact R1_neq_R0. }
Qed.


(* We start with
    specification of stepAS : AS f x -> AS f y -> Prop
    which models all the operation AS_spec

    This should be plausible to prove the termination
*)

(* Specification of step : CDCLState f -> CDCLState f -> Prop
  1. step is terminating

  I will relax proving 1, by only proving 1
    in the version of stepAS
      (unless I have time later)
  for 2 and 3, the correspondent in stepAS will also be proved
    as lemma
*)

Inductive step  {f : CNF V}:
  CDCLState f -> CDCLState f -> Prop :=
  | unit_prop :
      step (existT _ (existT _ ))

(* This is not so important but
    we have a partial ordering on Assignment Stack
    and if we have finite number of variables
    i.e. V is of finite size,
    then we have, for every chain, a "largest" stack

    This is not important because it is just a theorem/verification
     we need to prove

    It will disappear after extraction.

    The important is the four theorem that act as small-step transition
    Basically unit prop, decide, checkFail, and backjump.

    We might need to add more
    *)
Proposition Terminating:
  forall x y,
    steps x y ->
    exists z,
    steps y z /\ FinalState z.
Admitted.