(********************************************************************)
(*                                                                  *)
(*  The Why3 Verification Platform   /   The Why3 Development Team  *)
(*  Copyright 2010-2015   --   INRIA - CNRS - Paris-Sud University  *)
(*                                                                  *)
(*  This software is distributed under the terms of the GNU Lesser  *)
(*  General Public License version 2.1, with the special exception  *)
(*  on linking described in file LICENSE.                           *)
(*                                                                  *)
(********************************************************************)

(* This file is generated by Why3's Coq-realize driver *)
(* Beware! Only edit allowed sections below    *)
Require Import BuiltIn.
Require BuiltIn.
Require int.Int.

(* This file is generated by Why3's Coq-realize driver *)
(* Beware! Only edit allowed sections below    *)
Require Import BuiltIn.
Require BuiltIn.
Require int.Int.

(* Why3 goal *)
Definition pow2: Z -> Z.
  exact (two_p).
Defined.

(* Why3 goal *)
Lemma Power_0 : ((pow2 0%Z) = 1%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma Power_s : forall (n:Z), (0%Z <= n)%Z ->
  ((pow2 (n + 1%Z)%Z) = (2%Z * (pow2 n))%Z).
  apply two_p_S.
Qed.

(* Why3 goal *)
Lemma Power_1 : ((pow2 1%Z) = 2%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma Power_sum : forall (n:Z) (m:Z), ((0%Z <= n)%Z /\ (0%Z <= m)%Z) ->
  ((pow2 (n + m)%Z) = ((pow2 n) * (pow2 m))%Z).
  unfold pow2.
  intros n m [H1 H2].
  apply two_p_is_exp; easy.
Qed.

(* Why3 goal *)
Lemma pow2pos : forall (i:Z), (0%Z <= i)%Z -> (0%Z < (pow2 i))%Z.
  intros i h1.
  Require Import Zorder.
  apply Zgt_lt.
  auto using two_p_gt_ZERO.
Qed.

(* Why3 goal *)
Lemma pow2_0 : ((pow2 0%Z) = 1%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma pow2_1 : ((pow2 1%Z) = 2%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma pow2_2 : ((pow2 2%Z) = 4%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma pow2_3 : ((pow2 3%Z) = 8%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma pow2_4 : ((pow2 4%Z) = 16%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma pow2_5 : ((pow2 5%Z) = 32%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma pow2_6 : ((pow2 6%Z) = 64%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma pow2_7 : ((pow2 7%Z) = 128%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma pow2_8 : ((pow2 8%Z) = 256%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma pow2_9 : ((pow2 9%Z) = 512%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma pow2_10 : ((pow2 10%Z) = 1024%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma pow2_11 : ((pow2 11%Z) = 2048%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma pow2_12 : ((pow2 12%Z) = 4096%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma pow2_13 : ((pow2 13%Z) = 8192%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma pow2_14 : ((pow2 14%Z) = 16384%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma pow2_15 : ((pow2 15%Z) = 32768%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma pow2_16 : ((pow2 16%Z) = 65536%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma pow2_17 : ((pow2 17%Z) = 131072%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma pow2_18 : ((pow2 18%Z) = 262144%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma pow2_19 : ((pow2 19%Z) = 524288%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma pow2_20 : ((pow2 20%Z) = 1048576%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma pow2_21 : ((pow2 21%Z) = 2097152%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma pow2_22 : ((pow2 22%Z) = 4194304%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma pow2_23 : ((pow2 23%Z) = 8388608%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma pow2_24 : ((pow2 24%Z) = 16777216%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma pow2_25 : ((pow2 25%Z) = 33554432%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma pow2_26 : ((pow2 26%Z) = 67108864%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma pow2_27 : ((pow2 27%Z) = 134217728%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma pow2_28 : ((pow2 28%Z) = 268435456%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma pow2_29 : ((pow2 29%Z) = 536870912%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma pow2_30 : ((pow2 30%Z) = 1073741824%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma pow2_31 : ((pow2 31%Z) = 2147483648%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma pow2_32 : ((pow2 32%Z) = 4294967296%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma pow2_33 : ((pow2 33%Z) = 8589934592%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma pow2_34 : ((pow2 34%Z) = 17179869184%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma pow2_35 : ((pow2 35%Z) = 34359738368%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma pow2_36 : ((pow2 36%Z) = 68719476736%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma pow2_37 : ((pow2 37%Z) = 137438953472%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma pow2_38 : ((pow2 38%Z) = 274877906944%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma pow2_39 : ((pow2 39%Z) = 549755813888%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma pow2_40 : ((pow2 40%Z) = 1099511627776%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma pow2_41 : ((pow2 41%Z) = 2199023255552%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma pow2_42 : ((pow2 42%Z) = 4398046511104%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma pow2_43 : ((pow2 43%Z) = 8796093022208%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma pow2_44 : ((pow2 44%Z) = 17592186044416%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma pow2_45 : ((pow2 45%Z) = 35184372088832%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma pow2_46 : ((pow2 46%Z) = 70368744177664%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma pow2_47 : ((pow2 47%Z) = 140737488355328%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma pow2_48 : ((pow2 48%Z) = 281474976710656%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma pow2_49 : ((pow2 49%Z) = 562949953421312%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma pow2_50 : ((pow2 50%Z) = 1125899906842624%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma pow2_51 : ((pow2 51%Z) = 2251799813685248%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma pow2_52 : ((pow2 52%Z) = 4503599627370496%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma pow2_53 : ((pow2 53%Z) = 9007199254740992%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma pow2_54 : ((pow2 54%Z) = 18014398509481984%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma pow2_55 : ((pow2 55%Z) = 36028797018963968%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma pow2_56 : ((pow2 56%Z) = 72057594037927936%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma pow2_57 : ((pow2 57%Z) = 144115188075855872%Z).
  easy.

Qed.

(* Why3 goal *)
Lemma pow2_58 : ((pow2 58%Z) = 288230376151711744%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma pow2_59 : ((pow2 59%Z) = 576460752303423488%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma pow2_60 : ((pow2 60%Z) = 1152921504606846976%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma pow2_61 : ((pow2 61%Z) = 2305843009213693952%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma pow2_62 : ((pow2 62%Z) = 4611686018427387904%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma pow2_63 : ((pow2 63%Z) = 9223372036854775808%Z).
  easy.
Qed.

(* Why3 goal *)
Lemma pow2_64 : ((pow2 64%Z) = 18446744073709551616%Z).
  easy.
Qed.


Require Import TM.Prelim TM.Relations TM.TM.

(** * Tapes-Lift *)

(** Select the [m] elements of [V], of that their index is in [I] *)
Definition select (m n: nat) (X: Type) (I : Vector.t (Fin.t n) m) (V : Vector.t X n) : Vector.t X m :=
  Vector.map (Vector.nth V) I.

Corollary select_nth m n X (I : Vector.t (Fin.t n) m) (V : Vector.t X n) (k : Fin.t m) :
  (select I V) [@ k] = V [@ (I [@ k])].
Proof. now apply Vector.nth_map. Qed.

(** Relational tapes-lift *)
Section LiftTapes_Rel.

  Variable (sig : finType) (F : Type).
  Variable m n : nat.

  Variable I : Vector.t (Fin.t n) m.

  Definition not_index (i : Fin.t n) : Prop :=
    ~ Vector.In i I.

  Variable (R : pRel sig F m).

  Definition LiftTapes_select_Rel : pRel sig F n :=
    fun t '(y, t') => R (select I t) (y, select I t').

  Definition LiftTapes_eq_Rel : pRel sig F n :=
    ignoreParam (fun t t' => forall i : Fin.t n, not_index i -> t'[@i] = t[@i]).

  Definition LiftTapes_Rel := LiftTapes_select_Rel ∩ LiftTapes_eq_Rel.

  Variable T : tRel sig m.

  Definition LiftTapes_T : tRel sig n :=
    fun t k => T (select I t) k.

End LiftTapes_Rel.

Arguments not_index : simpl never.
Arguments LiftTapes_select_Rel {sig F m n} I R x y /.
Arguments LiftTapes_eq_Rel {sig F m n} I x y /.
Arguments LiftTapes_Rel {sig F m n } I R x y /.
Arguments LiftTapes_T {sig m n} I T x y /.

Section Fill.
  Variable X : Type.

  (** Replace the elements of [init] of which the index is in [I] with the element in [V] of that index. *)
  Fixpoint fill {m n : nat} (I : Vector.t (Fin.t n) m) : forall (init : Vector.t X n) (V : Vector.t X m), Vector.t X n :=
    match I with
    | Vector.nil _ => fun init V => init
    | Vector.cons _ i m' I' =>
      fun init V =>
        Vector.replace (fill I' init (Vector.tl V)) i (Vector.hd V)
    end.

  Variable m n : nat.
  Implicit Types (i : Fin.t n) (j : Fin.t m).
  Implicit Types (I : Vector.t (Fin.t n) m) (init : Vector.t X n) (V : Vector.t X m).

  Lemma fill_correct_nth I init V i j :
    dupfree I ->
    I[@j] = i ->
    (fill I init V)[@i] = V[@j].
  Proof.
    intros HDup Heq. revert V. induction HDup as [ | m index I' H1 H2 IH]; intros; cbn in *.
    - exfalso. clear i Heq V. now apply fin_destruct_O in j.
    - pose proof destruct_vector_cons V as (v&V'&->).
      pose proof fin_destruct_S j as [(j'&?) | ? ]; cbn in *; subst; cbn in *.
      + decide (index = I'[@j']) as [ -> | Hneq].
        * contradict H1. eapply vect_nth_In; eauto.
        * rewrite replace_nth2; auto.
      + apply replace_nth.
  Qed.

  (* Not needed *)
  (*
  Corollary select_fill I init V :
    dupfree I ->
    select I (fill I init V) = V.
  Proof. intros H. unfold select. apply Vector.eq_nth_iff. intros p ? <-. erewrite Vector.nth_map; eauto. erewrite fill_correct_nth; eauto. Qed.

  Lemma fill_select_nth I init (i : Fin.t n) :
    dupfree I ->
    (fill I init (select I init))[@i] = init[@i].
  Proof.
    intros. induction H as [ | m index I H1 H2 IH]; cbn in *.
    - reflexivity.
    - decide (index = i) as [->|d].
      + now rewrite replace_nth.
      + rewrite <- IH. now rewrite replace_nth2.
  Qed.

  Corollary fill_select I t :
    dupfree I ->
    fill I t (select I t) = t.
  Proof.
    intros H. apply Vector.eq_nth_iff. intros p ? <-. now apply fill_select_nth.
  Qed.
   *)

  Lemma fill_not_index I init V (i : Fin.t n) :
    dupfree I ->
    not_index I i ->
    (fill I init V)[@i] = init[@i].
  Proof.
    intros HDupfree. revert V i. induction HDupfree as [ | m index I' H1 H2 IH]; intros; cbn in *.
    - reflexivity.
    - pose proof destruct_vector_cons V as (v&V'&->).
      unfold not_index in *.
      decide (index = i) as [ -> | Hneq].
      + exfalso. contradict H. constructor.
      + rewrite replace_nth2; eauto. apply IH; auto.
        { intros ?. contradict H. now constructor. }
  Qed.

  Definition fill_default I (def : X) V :=
    fill I (Vector.const def n) V.

  Corollary fill_default_not_index I V def i :
    dupfree I ->
    not_index I i ->
    (fill_default I def V)[@i] = def.
  Proof. intros. unfold fill_default. rewrite fill_not_index; auto. apply Vector.const_nth. Qed.

End Fill.

Section loop_map.
  Variable A B : Type.
  Variable (f : A -> A) (h : A -> bool) (g : A -> B).
  Hypothesis step_map_comp : forall a, g (f a) = g a.

  Lemma loop_map k a1 a2 :
    loop f h a1 k = Some a2 ->
    g a2 = g a1.
  Proof.
    revert a1 a2. induction k as [ | k' IH]; intros; cbn in *.
    - destruct (h a1); now inv H.
    - destruct (h a1).
      + now inv H.
      + apply IH in H. now rewrite step_map_comp in H.
  Qed.

End loop_map.

Section LiftNM.

  Variable sig : finType.

  Variable m n : nat.

  Variable F : finType.

  Variable pM : pTM sig F m.

  Variable I : Vector.t ((Fin.t n)) m.
  Variable I_dupfree : dupfree I.

  Definition LiftTapes_trans :=
    fun '(q, sym ) =>
      let (q', act) := trans (m := projT1 pM) (q, select I sym) in
      (q', fill_default I (None, N) act).

  Definition LiftTapes_TM : mTM sig n :=
    {|
      trans := LiftTapes_trans;
      start := start (projT1 pM);
      halt := halt (m := projT1 pM);
    |}.

  Definition LiftTapes : pTM sig F n := (LiftTapes_TM; projT2 pM).

  Definition selectConf : mconfig sig (states LiftTapes_TM) n -> mconfig sig (states (projT1 pM)) m :=
    fun c => mk_mconfig (cstate c) (select I (ctapes c)).

  Lemma current_chars_select (t : tapes sig n) :
    current_chars (select I t) = select I (current_chars t).
  Proof. unfold current_chars, select. apply Vector.eq_nth_iff; intros i ? <-. now simpl_tape. Qed.

  Lemma doAct_select (t : tapes sig n) act :
    doAct_multi (select I t) act = select I (doAct_multi t (fill_default I (None, N) act)).
  Proof.
    unfold doAct_multi, select. apply Vector.eq_nth_iff; intros i ? <-. simpl_tape.
    unfold fill_default. f_equal. symmetry. now apply fill_correct_nth.
  Qed.

  Lemma LiftTapes_comp_step (c1 : mconfig sig (states (projT1 pM)) n) :
    step (M := projT1 pM) (selectConf c1) = selectConf (step (M := LiftTapes_TM) c1).
  Proof.
    unfold selectConf. unfold step; cbn.
    destruct c1 as [q t] eqn:E1.
    unfold step in *. cbn -[current_chars doAct_multi] in *.
    rewrite current_chars_select.
    destruct (trans (q, select I (current_chars t))) as (q', act) eqn:E; cbn.
    f_equal. apply doAct_select.
  Qed.

  Lemma LiftTapes_lift (c1 c2 : mconfig sig (states LiftTapes_TM) n) (k : nat) :
    loopM (M := LiftTapes_TM) c1 k = Some c2 ->
    loopM (M := projT1 pM) (selectConf c1) k = Some (selectConf c2).
  Proof.
    intros HLoop.
    eapply loop_lift with (f := step (M := LiftTapes_TM)) (h := haltConf (M := LiftTapes_TM)).
    - cbn. auto.
    - intros ? _. now apply LiftTapes_comp_step.
    - apply HLoop.
  Qed.

  Lemma LiftTapes_comp_eq (c1 c2 : mconfig sig (states LiftTapes_TM) n) (i : Fin.t n) :
    not_index I i ->
    step (M := LiftTapes_TM) c1 = c2 ->
    (ctapes c2)[@i] = (ctapes c1)[@i].
  Proof.
    intros HI H. unfold LiftTapes_TM in *.
    destruct c1 as [state1 tapes1] eqn:E1, c2 as [state2 tapes2] eqn:E2.
    unfold step, select in *. cbn in *.
    destruct (trans (state1, select I (current_chars tapes1))) as (q, act) eqn:E3.
    inv H. erewrite Vector.nth_map2; eauto. now rewrite fill_default_not_index.
  Qed.

  Lemma LiftTapes_eq (c1 c2 : mconfig sig (states LiftTapes_TM) n) (k : nat) (i : Fin.t n) :
    not_index I i ->
    loopM (M := LiftTapes_TM) c1 k = Some c2 ->
    (ctapes c2)[@i] = (ctapes c1)[@i].
  Proof.
    intros Hi HLoop. unfold loopM in HLoop.
    eapply loop_map with (g := fun c => (ctapes c)[@i]); eauto.
    intros. now apply LiftTapes_comp_eq.
  Qed.

  Lemma LiftTapes_Realise (R : Rel (tapes sig m) (F * tapes sig m)) :
    pM ⊨ R ->
    LiftTapes ⊨ LiftTapes_Rel I R.
  Proof.
    intros H. split.
    - apply (H (select I t) k (selectConf outc)).
      now apply (@LiftTapes_lift (initc LiftTapes_TM t) outc k).
    - hnf. intros i HI. now apply (@LiftTapes_eq (initc LiftTapes_TM t) outc k i HI).
  Qed.

  Lemma LiftTapes_unlift (k : nat)
        (c1 : mconfig sig (states (LiftTapes_TM)) n)
        (c2 : mconfig sig (states (LiftTapes_TM)) m) :
    loopM (M := projT1 pM) (selectConf c1) k = Some c2 ->
    exists c2' : mconfig sig (states (LiftTapes_TM)) n,
      loopM (M := LiftTapes_TM) c1 k = Some c2' /\
      c2 = selectConf c2'.
  Proof.
    intros HLoop. unfold loopM in *. cbn in *.
    apply loop_unlift with (lift:=selectConf) (f:=step (M:=LiftTapes_TM)) (h:=haltConf (M:=LiftTapes_TM)) in HLoop as (c'&HLoop&->).
    - exists c'. split; auto.
    - auto.
    - intros ? _. apply LiftTapes_comp_step.
  Qed.

  Lemma LiftTapes_Terminates T :
    projT1 pM ↓ T ->
    projT1 LiftTapes ↓ LiftTapes_T I T.
  Proof.
    intros H initTapes k Term. hnf in *.
    specialize (H (select I initTapes) k Term) as (outc&H).
    pose proof (@LiftTapes_unlift k (initc LiftTapes_TM initTapes) outc H) as (X&X'&->). eauto.
  Qed.

  Lemma LiftTapes_RealiseIn R k :
    pM ⊨c(k) R ->
    LiftTapes ⊨c(k) LiftTapes_Rel I R.
  Proof.
    intros (H1&H2) % Realise_total. apply Realise_total. split.
    - now apply LiftTapes_Realise.
    - eapply TerminatesIn_monotone.
      + apply LiftTapes_Terminates; eauto.
      + firstorder.
  Qed.

End LiftNM.

Arguments LiftTapes : simpl never.

(* TODO: AddTapes is unused, remove it *)

(* Indexes vector for adding a fixed number [m] of additional tapes at the begin. *)
Section AddTapes.

  Variable n : nat.

  Eval simpl in Fin.L 4 (Fin1 : Fin.t 10).
  Check @Fin.L.
  Search Fin.L.
  Eval simpl in Fin.R 4 (Fin1 : Fin.t 10).
  Check @Fin.R.
  Search Fin.R.

  Lemma Fin_L_fillive (m : nat) (i1 i2 : Fin.t n) :
    Fin.L m i1 = Fin.L m i2 -> i1 = i2.
  Proof.
    induction n as [ | n' IH].
    - dependent destruct i1.
    - dependent destruct i1; dependent destruct i2; cbn in *; auto; try congruence.
      apply Fin.FS_inj in H. now apply IH in H as ->.
  Qed.

  Lemma Fin_R_fillive (m : nat) (i1 i2 : Fin.t n) :
    Fin.R m i1 = Fin.R m i2 -> i1 = i2.
  Proof.
    induction m as [ | n' IH]; cbn.
    - auto.
    - intros H % Fin.FS_inj. auto.
  Qed.

  Definition add_tapes (m : nat) : Vector.t (Fin.t (m + n)) n :=
    Vector.map (fun k => Fin.R m k) (Fin_initVect _).

  Lemma add_tapes_dupfree (m : nat) : dupfree (add_tapes m).
  Proof.
    apply dupfree_map_injective.
    - apply Fin_R_fillive.
    - apply Fin_initVect_dupfree.
  Qed.

  Lemma add_tapes_select_nth (X : Type) (m : nat) (ts : Vector.t X (m + n)) k :
    (select (add_tapes m) ts)[@k] = ts[@Fin.R m k].
  Proof.
    unfold add_tapes. unfold select. erewrite !VectorSpec.nth_map; eauto.
    cbn. now rewrite Fin_initVect_nth.
  Qed.

  Definition app_tapes (m : nat) : Vector.t (Fin.t (n + m)) n :=
    Vector.map (Fin.L _) (Fin_initVect _).

  Lemma app_tapes_dupfree (m : nat) : dupfree (app_tapes m).
  Proof.
    apply dupfree_map_injective.
    - apply Fin_L_fillive.
    - apply Fin_initVect_dupfree.
  Qed.

  Lemma app_tapes_select_nth (X : Type) (m : nat) (ts : Vector.t X (n + m)) k :
    (select (app_tapes m) ts)[@k] = ts[@Fin.L m k].
  Proof.
    unfold app_tapes. unfold select. erewrite !VectorSpec.nth_map; eauto.
    cbn. now rewrite Fin_initVect_nth.
  Qed.

End AddTapes.

(** * Tactic Support *)

Lemma smpl_dupfree_helper1 (n : nat) :
  dupfree [|Fin.F1 (n := n)|].
Proof. vector_dupfree. Qed.

Lemma smpl_dupfree_helper2 (n : nat) :
  dupfree [|Fin.FS (Fin.F1 (n := n))|].
Proof. vector_dupfree. Qed.

Ltac smpl_dupfree :=
  lazymatch goal with
  | [ |- dupfree [|Fin.F1 |] ] => apply smpl_dupfree_helper1
  | [ |- dupfree [|Fin.FS |] ] => apply smpl_dupfree_helper2
  | [ |- dupfree (add_tapes _ _)] => apply add_tapes_dupfree
  | [ |- dupfree (app_tapes _ _)] => apply app_tapes_dupfree
  | [ |- dupfree _ ] => now vector_dupfree (* fallback tactic *)
  end.

Ltac smpl_TM_LiftN :=
  lazymatch goal with
  | [ |- LiftTapes _ _ ⊨ _] =>
    apply LiftTapes_Realise; [ smpl_dupfree | ]
  | [ |- LiftTapes _ _ ⊨c(_) _] => apply LiftTapes_RealiseIn; [ smpl_dupfree | ]
  | [ |- projT1 (LiftTapes _ _) ↓ _] => apply LiftTapes_Terminates; [ smpl_dupfree | ]
  end.
Smpl Add smpl_TM_LiftN : TM_Correct.

Ltac is_num_const n :=
  lazymatch n with
  | O => idtac
  | S ?n => is_num_const n
  | _ => fail "Not a number"
  end.

(*
Section Test_Is_Num_Const.
  Variable n : nat.
  Eval cbn in ltac:(is_num_const 42).
  Fail Eval cbn in ltac:(is_num_const n).
  Fail Eval cbn in ltac:(is_num_const (S n)).
End Test_Is_Num_Const.
*)

(* This tactical executes [t 0], ..., [t (n-1)]. *)
Ltac do_n_times n t :=
  match n with
  | O => idtac
  | (S ?n') =>
    t 0;
    do_n_times n' ltac:(fun i => let next := constr:(S i) in t next)
  end.
(*
Eval cbn in ltac:(do_n_times 42 ltac:(fun a => idtac a)).
*)

(* This similiar tactical executes [t Fin0], ..., [t Fin_(n-1)]. *)
Ltac do_n_times_fin_rect n m t :=
  lazymatch n with
  | O => idtac
  | S ?n' =>
    let m' := eval simpl in (pred m) in
    let one := eval simpl in (@Fin.F1 _ : Fin.t m) in
    t one;
    do_n_times_fin_rect n' m' ltac:(fun i => let next := eval simpl in (Fin.FS i) in t next)
  end.

Ltac do_n_times_fin n t := do_n_times_fin_rect n n t.

(*
Eval cbn in ltac:(do_n_times_fin 3 ltac:(fun a => idtac a)).
Eval cbn in ltac:(do_n_times_fin 3 ltac:(fun a => let x := eval simpl in (a : Fin.t 3) in idtac x)).
*)

(* Support for [app_tapes] *)

(*
 * The tactic [simpl_not_in_add_tapes] specialises hypothesises of the form
 * [H : forall i : Fin.t _, not_index (add_tapes _ m) i -> _]
 * with [i := Fin0], ..., [i := Fin(m-1)] and proves [not_index (add_tapes _ m) i.
 *)

Ltac simpl_not_in_add_tapes_step H m' :=
  let H' := fresh "HIndex_" H in
  unshelve epose proof (H ltac:(getFin m') _) as H';
  [ hnf; unfold add_tapes, Fin_initVect; cbn [tabulate Vector.map Fin.L Fin.R]; vector_not_in
  | cbn [Fin.L Fin.R] in H'
  ].

Ltac simpl_not_in_add_tapes_loop H m :=
  do_n_times m ltac:(simpl_not_in_add_tapes_step H); clear H.

Ltac simpl_not_in_add_tapes_one :=
  lazymatch goal with
  | [ H : forall i : Fin.t _, not_index (add_tapes _ ?m) i -> _ |- _] =>
    simpl_not_in_add_tapes_loop H m; clear H
  | [ H : context [ (select (add_tapes _ ?m) _)[@_]] |- _ ] =>
    rewrite ! (add_tapes_select_nth (m := m)) in H; cbn in H
  | [ |- context [ (select (add_tapes _ ?m) _)[@_]] ] =>
    rewrite ! (add_tapes_select_nth (m := m)); cbn
  end.

Ltac simpl_not_in_add_tapes := repeat simpl_not_in_add_tapes_one.

(* Test *)
Goal True.
  assert (forall i : Fin.t 3, not_index (add_tapes _ 2) i -> i = i) by firstorder.
  simpl_not_in_add_tapes. (* :-) *)
Abort.

Goal True.
  assert (n : nat) by constructor.
  assert (forall i : Fin.t (S n), not_index (add_tapes n 1) i -> True) by firstorder.
  simpl_not_in_add_tapes.
Abort.

(* Support for [app_tapes] *)

Ltac simpl_not_in_app_tapes_step H n m' :=
  let H' := fresh "HIndex_" H in
  unshelve epose proof (H (Fin.R n ltac:(getFin m')) _) as H';
  [ hnf; unfold app_tapes, Fin_initVect; cbn [tabulate Vector.map Fin.L Fin.R]; vector_not_in
  | cbn [Fin.L Fin.R] in H'
  ].

Ltac simpl_not_in_app_tapes_loop H n m :=
  do_n_times m ltac:(fun m' => simpl_not_in_app_tapes_step H n m'); clear H.

Ltac simpl_not_in_app_tapes_one :=
  lazymatch goal with
  | [ H : forall i : Fin.t _, not_index (app_tapes ?n ?m) i -> _ |- _] =>
    simpl_not_in_app_tapes_loop H n m; clear H
  | [ H : context [ (select (app_tapes ?n ?m) _)[@_]] |- _ ] =>
    rewrite ! (app_tapes_select_nth (n := n) (m := m)) in H; cbn in H
  | [ |- context [ (select (app_tapes ?n ?m) _)[@_]] ] =>
    rewrite ! (app_tapes_select_nth (n := n) (m := m)); cbn
  end.

Ltac simpl_not_in_app_tapes := repeat simpl_not_in_app_tapes_one.

Goal True.
  assert (forall i : Fin.t 10, not_index (app_tapes 8 _) i -> i = i) as Inj by firstorder.
  simpl_not_in_app_tapes.
  Check HIndex_Inj : Fin8 = Fin8.
  Check HIndex_Inj0 : Fin9 = Fin9.
  Fail Check HInj.
Abort.

(* Check whether a vector (syntactically) contains an element *)
Ltac vector_contains a vect :=
  lazymatch vect with
  | @Vector.nil ?A => fail "Vector doesn't contain" a
  | @Vector.cons ?A a ?n ?vect' => idtac
  | @Vector.cons ?A ?b ?n ?vect' => vector_contains a vect'
  | _ => fail "No vector" vect
  end.

Fail Check ltac:(vector_contains 42 (@Vector.nil nat); idtac "yes!").
Check ltac:(vector_contains 42 [|4;8;15;16;23;42|]; idtac "yes!").

Ltac vector_doesnt_contain a vect :=
  tryif vector_contains a vect then fail "Vector DOES contain" a else idtac.

Check ltac:(vector_doesnt_contain 42 (@Vector.nil nat); idtac "yes!").
Check ltac:(vector_doesnt_contain 9 [|4;8;15;16;23;42|]; idtac "yes!").
Fail Check ltac:(vector_doesnt_contain 42 [|4;8;15;16;23;42|]; idtac "yes!").

(*
 * The tactic [simpl_not_in_vector] tries to specialise hypothesises of the form
 * [H : forall i : Fin.t n, not_index [F1; ...; Fk] i -> _]
 * with [i := Fin0], ..., [i := Fin(n-1)] to new assumptions [H_0].
 *)

Ltac simpl_not_in_vector_step H vect n m' :=
  let H' := fresh H "_" in
  tryif vector_contains m' vect
  then idtac (* skip m' *)
  else pose proof (H m' ltac:(vector_not_in)) as H'.

Ltac simpl_not_in_vector_loop H vect n :=
  let H' := fresh H "_" in
  pose proof I as H';
  do_n_times_fin n ltac:(fun m' => simpl_not_in_vector_step H vect n m');
  clear H'.

Ltac simpl_not_in_vector_one :=
  lazymatch goal with
  | [ H : forall i : Fin.t ?n, not_index ?vect i -> _ |- _ ] =>
    simpl_not_in_vector_loop H vect n; clear H
  end.

Ltac simpl_not_in_vector := repeat simpl_not_in_vector_one.

(* Test *)
Goal True.
  assert (forall i : Fin.t 10, not_index [|Fin8; Fin1; Fin2; Fin3|] i -> i = i) as HInj by firstorder.
  simpl_not_in_vector_one.
  Fail Check HInj.
  Show Proof.
  Check (HInj_0 : Fin0 = Fin0).
  Check (HInj_1 : Fin4 = Fin4).
  Check (HInj_2 : Fin5 = Fin5).
  Check (HInj_3 : Fin6 = Fin6).
  Check (HInj_4 : Fin7 = Fin7).
  Check (HInj_5 : Fin9 = Fin9).
Abort.

Ltac simpl_not_in :=
  repeat match goal with
         | _ => progress simpl_not_in_add_tapes
         | _ => progress simpl_not_in_app_tapes
         | _ => progress simpl_not_in_vector
         end.


Set Implicit Arguments.
Require Import Coq.Setoids.Setoid.
Require Import Coq.Arith.EqNat.

Local Open Scope bool_scope.

Definition pk : Set := (nat * nat * nat * nat) %type.

Inductive trace : Set :=
| tr_single : pk -> trace
| tr_cons : pk -> trace -> trace.

Inductive hdr :=
| sw : hdr
| pt : hdr
| src : hdr
| dst : hdr.

Definition val := nat.

Definition upd (h : hdr) (v : val) (p : pk) : pk :=
  match (h, p) with
    | (sw, (_, v2, v3, v4)) => (v, v2, v3, v4)
    | (pt, (v1, _, v3, v4)) => (v1, v, v3, v4)
    | (src, (v1, v2, _, v4)) => (v1, v2, v, v4)
    | (dst, (v1, v2, v3, _)) => (v1, v2, v3, v)
  end.

Definition test (h : hdr) (v : val) (p : pk) : bool :=
  match (h, p) with
    | (sw, (v1, v2, v3, v4)) => beq_nat v v1
    | (pt, (v1, v2, v3, v4)) => beq_nat v v2
    | (src, (v1, v2, v3, v4)) => beq_nat v v3
    | (dst, (v1, v2, v3, v4)) => beq_nat v v4
  end.

Definition head (tr : trace) : pk :=
  match tr with
    | tr_single pk => pk
    | tr_cons pk _ => pk
  end.

Definition replace_head (pk : pk) (tr : trace) : trace :=
  match tr with
    | tr_single _ => tr_single pk
    | tr_cons _ tr' => tr_cons pk tr'
  end.

Axiom hdr_eqdec : forall (h1 h2 : hdr), { h1 = h2 } + { h1 <> h2 }.
Axiom val_eqdec : forall (v1 v2 : val), { v1 = v2 } + { v1 <> v2 }.

Create HintDb pkt.

Lemma head_replace_head : forall pk a, head (replace_head pk a) = pk.
Proof with auto.
  intros.
  destruct a...
Qed.

Lemma replace_head2 :
  forall pk1 pk2 a,
    replace_head pk1 (replace_head pk2 a) = replace_head pk1 a.
Proof with auto.
  intros.
  destruct a...
Qed.

Hint Rewrite head_replace_head replace_head2 : pkt.

Lemma test_upd_true : forall h n pk, test h n (upd h n pk) = true.
Proof with auto.
  intros.
  destruct pk0 as [[[sw pt] src] dst].
  unfold test.
  unfold upd.
  destruct h; auto; rewrite <- beq_nat_refl...
Qed.

Lemma test_upd_ignore :
  forall h1 h2 m n pk,
    h1 <> h2 ->
    test h2 n (upd h1 m pk) = test h2 n pk.
Proof with auto.
  intros.
  destruct pk0 as [[[sw pt] src] dst].
  unfold not in H.
  destruct h1; destruct h2; try solve[contradiction H; auto];
  unfold upd;
  unfold test...
Qed.

Lemma test_upd_0 :
  forall h m n pk,
    m <> n ->
    test h m (upd h n pk) = false.
Proof with auto.
  intros.
  destruct pk0 as [[[sw pt] src] dst].
  destruct h; unfold upd; unfold test;
  rewrite -> beq_nat_false_iff...
Qed.

Lemma test_true_diff :
  forall h m n pk,
    true = test h m pk ->
    true = test h n pk ->
    m = n.
Proof with auto.
  intros.
  destruct pk0 as [[[sw pt] src] dst].
  unfold test in *.
  symmetry in H.
  symmetry in H0.
  destruct h; rewrite -> beq_nat_true_iff in *; subst...
Qed.

Lemma upd_upd_compress :
  forall h m n pk,
    upd h m (upd h n pk) = upd h m pk.
Proof with auto.
  intros.
  destruct pk0 as [[[sw pt] src] dst].
  unfold upd.
  destruct h; simpl...
Qed.


Require Import stdpp.list.
Require Import ssreflect.
From Tweetnacl Require Import Libs.Export.
From Tweetnacl Require Export ListsOp.ZofList.
Open Scope Z.

Section Integer.

Variable n:Z.
Hypothesis Hn: n > 0.

(*
  Forall LEMMAS
*)

Definition ZList_pos (l:list Z) : Prop := Forall (Z.le 0) l.

Notation "ℤ.lst A" := (ZofList n A) (at level 65, right associativity).

Lemma ZofList_pos : forall l, ZList_pos l -> 0 <= ℤ.lst l.
Proof.
  intros l Hl.
  dependent induction Hl => //=.
  - apply OMEGA2.
    done.
    rewrite Z.mul_comm.
    apply Zmult_gt_0_le_0_compat.
    apply pown0 ; done.
    done.
Qed.

Lemma ZofList_null: forall l, ZList_pos l -> ℤ.lst l = 0 -> Forall (Z.eq 0) l.
Proof.
  move => l HFl HSl.
  induction HFl => //=.
  - assert(Hx: {x < 0} + {x = 0} + {x > 0}) by apply Ztrichotomy_inf.
    assert(Hl: {ℤ.lst l < 0} + {ℤ.lst l = 0} + {ℤ.lst l > 0}) by apply Ztrichotomy_inf.
    rewrite ZofList_cons in HSl.
    assert(Hlpos:= ZofList_pos l HFl).
    case Hl => Hl'.
    case Hl' => Hl''.
    by apply Zle_not_lt in Hlpos.
    + clear Hl' Hl Hlpos.
      case Hx => Hx'.
      case Hx' => Hx''.
      by apply Zle_not_lt in H.
      * clear Hx' Hx.
      apply Forall_cons; go.
      * assert(2 ^ n * (ℤ.lst l) = 0).
        rewrite Z.eq_mul_0 ; auto.
        rewrite H0 in HSl.
        omega. (* contradiction between x = 0 and x > 0*)
    + clear Hlpos Hl.
      case Hx => Hx'.
      case Hx' => Hx''.
      apply Zle_not_lt in H.
      false.
      * clear Hx' Hx.
        subst x ; clear H.
        move: HSl. rewrite Z.add_0_l Z.eq_mul_0 => HSl.
        destruct HSl.
          assert(H0' := pown0 n Hn) ; omega.
          omega (* contraction between H and Hl'*).
      * (*once again we need to show a contradiction in HSl. *)
        assert(0 < x + 2 ^ n * (ℤ.lst l)).
          apply Z.add_pos_pos.
          omega. (*see Hx' *)
          rewrite Z.lt_0_mul.
          left ; split ; rewrite -Z.gt_lt_iff.
          apply pown0 ; auto.
          assumption. (* apply Hl' *)
        omega.
Qed.

Lemma ZofList_bound: forall (m:Z) l , 0 <= m < 2 ^ n -> ZList_pos l -> ℤ.lst l = m -> nth 0 l 0 = m.
Proof.
  intros m [|x l] Hm HFl HSlm.
  - go.
  - rewrite ZofList_cons in HSlm.
    unfold nth.
    subst m.
    replace (2 ^ n * (ℤ.lst l)) with 0.
    apply Zplus_0_r_reverse.
    move: HFl ; unfold ZList_pos.
    rewrite Forall_cons => HSl. destruct HSl as [Hz Hpos].
    apply ZofList_pos in Hpos.
    assert(Hl: {ℤ.lst l < 0} + {ℤ.lst l = 0} + {ℤ.lst l > 0}) by apply Ztrichotomy_inf.
    case Hl => Hl'.
    case Hl' => Hl''.
    apply Zle_not_lt in Hpos.
    false.
    + symmetry. rewrite Z.eq_mul_0 ; auto.
    + exfalso.
      clear Hl Hpos.
      assert(1 <= ℤ.lst l).
      omega.
      assert(2 ^ n * 1 <= 2 ^ n * (ℤ.lst l)).
      apply Zmult_le_compat_l ; auto.
      rewrite <- Z.ge_le_iff.
      assert(Ht:= pown0).
      omega.
      omega.
Qed.

Lemma ZofList_n_nn_bound_length: forall l (m:nat),
  length l = m ->
  Forall (fun x => 0 <= x < 2^n) l ->
    ℤ.lst l < 2^(n*ℤ.ℕ m).
Proof.
  induction l using rev_ind => m Hl Hbounds.
  simpl in Hl ; subst m.
  rewrite <- Zmult_0_r_reverse ; go.
  destruct m;
  move : Hl ; rewrite app_length.
  simpl; oreplace (length l + 1)%nat (S (length l))%nat => Hl.
  try congruence.
  move=> Hl.
  rewrite Nat2Z.inj_succ -Zmult_succ_r_reverse ZofList_app'.
  inversion Hl; clear Hl.
  have : length l = m by omega.
  move => ->.
  replace (ℤ.lst [x]) with x by (simpl ZofList ; omega).
  eapply (Z.lt_le_trans _ (2 ^ (n * (ℤ.ℕ m)) + 2 ^ (n * (ℤ.ℕ m)) * x)).
  - apply Zplus_lt_compat_r.
    apply IHl.
    omega.
    move : Hbounds ; rewrite !Forall_forall => Hbounds.
    intros ; apply Hbounds.
    rewrite elem_of_app.
    left ; assumption.
  - clear H0.
    rewrite Zred_factor2.
    eapply (Z.le_trans _ (2 ^ (n * (ℤ.ℕ m)) * (2^n))).
    + apply Zmult_le_compat_l.
      rewrite Z.add_1_l.
      apply Zlt_le_succ.
      apply Forall_app in Hbounds.
      destruct Hbounds as [Hl Hx].
      move : Hx.
      rewrite Forall_forall => Hx.
      destruct (Hx x) ; go.
      apply Z.pow_nonneg ; omega.
    + apply Z.eq_le_incl.
      rewrite Z.pow_add_r ; try omega.
      rewrite Z.mul_comm.
      apply Zmult_gt_0_le_0_compat ; try omega.
      done.
Qed.

Lemma ZofList_n_nn_bound_Zlength: forall l (m:nat),
  Zlength l = m ->
  Forall (fun x => 0 <= x < 2^n) l ->
    ℤ.lst l < 2^(n*m).
Proof. convert_length_to_Zlength ZofList_n_nn_bound_length. Qed.

Fixpoint ZofList_Bound (p:nat) (m: Z) : Z := match p with
| 0%nat => 0
| S p => m + Z.pow 2 n * ZofList_Bound p m
end.

Lemma ZofList_bounds: forall l (m:nat) (a b:Z),
  (length l = m)%nat ->
  a < 0 < b ->
  Forall (fun x => a < x < b) l ->
   ZofList_Bound m a <= ℤ.lst l <= ZofList_Bound m b.
Proof.
  elim => [| h q IHl] => m a b Hm Hab Hl //=.
  subst m ; go.
  destruct m.
  inv Hm.
  inversion Hm.
  rewrite H0.
  apply Forall_cons in Hl.
  destruct Hl as [Hh Hl].
  destruct (IHl m a b H0 Hab Hl) as [Hinf Hsup].
  simpl.
  split.
  apply Z.add_le_mono ; try omega.
  apply Zmult_le_compat_l ; try apply Z.pow_nonneg ; omega.
  apply Z.add_le_mono ; try omega.
  apply Zmult_le_compat_l ; try apply Z.pow_nonneg ; omega.
Qed.

Lemma ZofList_bounds_Zlength: forall l (m:nat) (a b:Z),
  Zlength l = m ->
  a < 0 < b ->
  Forall (fun x => a < x < b) l ->
   ZofList_Bound m a <= ℤ.lst l <= ZofList_Bound m b.
Proof. convert_length_to_Zlength ZofList_bounds. Qed.

Lemma ZofList_nth_mod_div : forall l (m:nat), Forall (fun x => 0 <= x < 2^n) l ->
  m < length l ->
  nth m l 0 = (ℤ.lst l) mod 2^(n*(S m)) / 2 ^ (n * m).
Proof.
  intros l m Hl Hlm.
  assert(length (take m l) = m).
    apply firstn_length_le ; omega.
  assert(Forall (λ x : ℤ, 0 ≤ x ∧ x < 2 ^ n) (take m l)).
    by apply Forall_take.
  assert((ℤ.lst take m l) < 2 ^ (n * m)).
    by apply ZofList_n_nn_bound_length.
  assert(0 <= ℤ.lst take m l).
  {
    apply ZofList_pos.
    unfold ZList_pos.
    eapply list.Forall_impl ; eauto.
    intros x Hx; simpl in Hx; omega.
  }
  assert(0 < 2 ^ (m*n)).
  {
    apply Z.pow_pos_nonneg. done.
    apply Z.mul_nonneg_nonneg; omega.
  }
  assert( 0 <= (ℤ.lst take m l) + nth m l 0 * 2 ^ (n * m)).
  {
    apply OMEGA2. done.
    apply Zmult_gt_0_le_0_compat.
    omega.
    apply Forall_nth_d.
    omega.
    eapply Forall_impl ; eauto ; intros x Hx ; simpl in Hx ; omega.
  }
  replace (ℤ.lst l) with ((ℤ.lst take m l) + 2^(n * Zlength (take m l)) * nth m l 0 + 2^(n * Zlength (take (S m) l)) * (ℤ.lst drop (S m) l)).
  2: by rewrite ZofList_take_nth_drop.
  replace (Zlength (take m l)) with (Z.of_nat m).
  2: rewrite Zlength_correct ; omega.
  replace (Zlength (take (S m) l)) with (Z.of_nat (S m)).
  2: rewrite Zlength_correct ; symmetry ; apply inj_eq ; apply firstn_length_le ; omega.
  rewrite -Zplus_mod_idemp_r.
  replace ((2 ^ (n * S m) * (ℤ.lst drop (S m) l)) `mod` 2 ^ (n * S m)) with 0.
  2: symmetry; rewrite Z.mul_comm ; apply Z_mod_mult.
  rewrite Z.add_0_r.
  rewrite Z.mod_small.
  2: {
    split.
      rewrite Z.mul_comm; omega.
    - assert((ℤ.lst (take m l)) + 2 ^ (n * m) * nth m l 0 < 2 ^ (n * m) + 2 ^ (n * m) * nth m l 0).
        apply Zplus_lt_compat_r. omega.
      assert(2 ^ (n * m) + 2 ^ (n * m) * nth m l 0 <= 2 ^ (n * S m)).
        replace (n * S m) with (n * m + n).
        rewrite Zred_factor2 Z.pow_add_r ; try omega.
        apply Zmult_le_compat_l ; try omega.
        assert(minilemma : forall a b, a < b -> 1 + a <= b).
          intros ; omega.
        apply minilemma.
        eapply Forall_nth_d.
        apply Z.gt_lt.
        apply pown0.
        omega.
        eapply Forall_impl ; eauto ; intros x Hx ; simpl in Hx ; omega.
        apply Z.mul_nonneg_nonneg; omega.
        replace (Z.of_nat (S m)) with (Z.of_nat (m + 1)).
        rewrite Nat2Z.inj_add.
        ring.
        rewrite -plus_n_Sm.
        rewrite Nat.add_0_r.
        reflexivity.
      omega.
  }
  rewrite Z.mul_comm.
  rewrite Z.Private_NZDiv.div_add ; try omega.
  rewrite Zdiv_small.
  omega.
  omega.
Qed.

Lemma ZofList_nth_last_div : forall l (m:nat),
  S m = length l ->
  Forall (λ x : ℤ, 0 ≤ x ∧ x < 2 ^ n) (take m l) ->
  nth m l 0 = (ℤ.lst l) / 2 ^ (n * m).
Proof.
  intros.
  assert(length (take m l) = m).
    apply firstn_length_le ; omega.
  assert((ℤ.lst take m l) < 2 ^ (n * m)).
    by apply ZofList_n_nn_bound_length.
  assert(0 <= ℤ.lst take m l).
  {
    apply ZofList_pos.
    unfold ZList_pos.
    eapply list.Forall_impl ; eauto.
    intros x Hx; simpl in Hx; omega.
  }
  assert(0 < 2 ^ (m*n)).
  {
    apply Z.pow_pos_nonneg. done.
    apply Z.mul_nonneg_nonneg; omega.
  }
  replace (ℤ.lst l) with ((ℤ.lst take m l) + 2^(n * Zlength (take m l)) * nth m l 0 + 2^(n * Zlength (take (S m) l)) * (ℤ.lst drop (S m) l)).
  2: by rewrite ZofList_take_nth_drop.
  replace (Zlength (take m l)) with (Z.of_nat m).
  2: rewrite Zlength_correct ; omega.
  replace (Zlength (take (S m) l)) with (Z.of_nat (S m)).
  2: rewrite Zlength_correct ; symmetry ; apply inj_eq ; apply firstn_length_le ; omega.
  replace (2 ^ (n * S m) * (ℤ.lst drop (S m) l)) with 0.
  2: rewrite drop_ge ; simpl ; try omega; ring.
  rewrite -Zplus_0_r_reverse Z.mul_comm Z_div_plus ; try omega.
  rewrite Zdiv_small ; omega.
Qed.

Lemma ZofList_eq_ZxorList: forall l,
  Forall (fun x => 0 <= x < 2^n) l ->
  ZofList n l = ZxorList n l.
Proof.
  induction l ; intros.
  reflexivity.
  simpl.
  orewrite Z.shiftl_mul_pow2.
  rewrite -IHl.
  rewrite Zxor_add.
  f_equal.
  ring.
  omega.
  all: apply list.Forall_cons in H ; destruct H ; assumption.
Qed.

End Integer.


Require Import prosa.classic.util.all.
Require Import prosa.classic.model.arrival.basic.task prosa.classic.model.priority prosa.classic.model.arrival.basic.task_arrival.
Require Import prosa.classic.model.schedule.global.jitter.job prosa.classic.model.schedule.global.jitter.schedule
               prosa.classic.model.schedule.global.jitter.interference prosa.classic.model.schedule.global.jitter.platform.
From mathcomp Require Import ssreflect ssrbool ssrfun eqtype ssrnat seq fintype bigop.

Module ConstrainedDeadlines.

  Import Job SporadicTaskset ScheduleOfSporadicTaskWithJitter SporadicTaskset
         TaskArrival Interference Priority Platform.

  Section Lemmas.

    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.
    Variable job_jitter: Job -> time.

    (* Consider any job arrival sequence ... *)
    Variable arr_seq: arrival_sequence Job.

    (* ... and any schedule of this arrival sequence. *)
    Context {num_cpus: nat}.
    Variable sched: schedule Job num_cpus.
    Hypothesis H_jobs_come_from_arrival_sequence:
      jobs_come_from_arrival_sequence sched arr_seq.

    (* For simplicity, let's define some local names. *)
    Let job_is_pending := pending job_arrival job_cost job_jitter sched.
    Let job_is_backlogged := backlogged job_arrival job_cost job_jitter sched.

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

    (* In this section we prove the absence of multiple jobs of the same
       task when constrained deadlines are assumed.  *)
    Section NoMultipleJobs.

        (* Assume any work-conserving priority-based scheduler. *)
        Variable higher_eq_priority: JLDP_policy Job.
        Hypothesis H_work_conserving:
          work_conserving job_arrival job_cost job_jitter arr_seq sched.
        Hypothesis H_respects_JLDP_policy:
          respects_JLDP_policy job_arrival job_cost job_jitter arr_seq sched higher_eq_priority.

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

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

        (* Suppose that jobs are sequential, ...*)
        Hypothesis H_sequential_jobs: sequential_jobs sched.
        (* ... jobs only execute after the jitter, ... *)
        Hypothesis H_jobs_execute_after_jitter:
          jobs_execute_after_jitter job_arrival job_jitter sched.
        (* ... and jobs do not execute after completion. *)
        Hypothesis H_completed_jobs_dont_execute:
          completed_jobs_dont_execute job_cost sched.

        (* Assume that the schedule satisfies the sporadic task model. *)
        Hypothesis H_sporadic_tasks:
          sporadic_task_model task_period job_arrival job_task arr_seq.

        (* Consider a valid task tsk, ...*)
        Variable tsk: sporadic_task.
        Hypothesis H_valid_task: is_valid_sporadic_task task_cost task_period task_deadline tsk.

        (*... whose job j ... *)
        Variable j: Job.
        Hypothesis H_j_arrives: arrives_in arr_seq j.
        Hypothesis H_job_of_tsk: job_task j = tsk.

        (*... is backlogged at time t. *)
        Variable t: time.
        Hypothesis H_j_backlogged: job_is_backlogged j t.

        (* Assume that any previous jobs of tsk have completed by the period. *)
        Hypothesis H_all_previous_jobs_completed :
          forall j_other tsk_other,
            arrives_in arr_seq j_other ->
            job_task j_other = tsk_other ->
            job_arrival j_other + task_period tsk_other <= t ->
            completed job_cost sched j_other (job_arrival j_other + task_period (job_task j_other)).

        Let scheduled_task_other_than (tsk tsk_other: sporadic_task) :=
          task_is_scheduled job_task sched tsk_other t && (tsk_other != tsk).

        (* Then, there can be at most one pending job of each task at time t. *)
        Lemma platform_at_most_one_pending_job_of_each_task :
          forall j1 j2,
            arrives_in arr_seq j1 ->
            arrives_in arr_seq j2 ->
            job_is_pending j1 t ->
            job_is_pending j2 t ->
            job_task j1 = job_task j2 ->
            j1 = j2.
        Proof.
          rename H_sporadic_tasks into SPO, H_all_previous_jobs_completed into PREV.
          intros j1 j2 ARRin1 ARRin2 PENDING1 PENDING2 SAMEtsk.
          apply/eqP; rewrite -[_ == _]negbK; apply/negP; red; move => /eqP DIFF.
          move: PENDING1 PENDING2 => /andP [ARRIVED1 /negP NOTCOMP1] /andP [ARRIVED2 /negP NOTCOMP2].
          unfold jitter_has_passed, actual_arrival in *.
          destruct (leqP (job_arrival j1) (job_arrival j2)) as [BEFORE1 | BEFORE2].
          {
            specialize (SPO j1 j2 DIFF ARRin1 ARRin2 SAMEtsk BEFORE1).
            assert (LEt: job_arrival j1 + task_period (job_task j1) <= t).
            {
              apply leq_trans with (n := job_arrival j2); first by done.
              by apply leq_trans with (n := job_arrival j2 + job_jitter j2); first by apply leq_addr.
            }
            exploit (PREV j1 (job_task j1)); try (by done).
            intros COMP1; apply NOTCOMP1.
            by apply completion_monotonic with (t0 := job_arrival j1 + task_period (job_task j1)).
          }
          {
            apply ltnW in BEFORE2.
            exploit (SPO j2 j1); try (by done); [by red; ins; subst | intro SPO'].
            assert (LEt: job_arrival j2 + task_period (job_task j2) <= t).
            {
              apply leq_trans with (n := job_arrival j1); first by done.
              by apply leq_trans with (n := job_arrival j1 + job_jitter j1); first by apply leq_addr.
            }
            exploit (PREV j2 (job_task j2)); try (by done).
            intros COMP2; apply NOTCOMP2.
            by apply completion_monotonic with (t0 := job_arrival j2 + task_period (job_task j2)).
          }
        Qed.

        (* Therefore, all processors are busy with tasks other than tsk. *)
        Lemma platform_cpus_busy_with_interfering_tasks :
          count (scheduled_task_other_than tsk) ts = num_cpus.
        Proof.
          have UNIQ := platform_at_most_one_pending_job_of_each_task.
          rename H_all_jobs_from_taskset into FROMTS, H_sequential_jobs into SEQUENTIAL,
                 H_work_conserving into WORK, H_jobs_come_from_arrival_sequence into FROMarr,
                 H_respects_JLDP_policy into PRIO, H_j_backlogged into BACK,
                 H_job_of_tsk into JOBtsk, H_valid_job_parameters into JOBPARAMS,
                 H_valid_task into TASKPARAMS, H_all_previous_jobs_completed into PREV,
                 H_completed_jobs_dont_execute into COMP, H_jobs_execute_after_jitter into JITTER.
          apply work_conserving_eq_work_conserving_count in WORK.
          unfold valid_sporadic_job, valid_realtime_job,
                 respects_JLDP_policy, completed_jobs_dont_execute,
                 sporadic_task_model, is_valid_sporadic_task,
                 jobs_of_same_task_dont_execute_in_parallel,
                 sequential_jobs in *.
          apply/eqP; rewrite eqn_leq; apply/andP; split.
          {
            apply leq_trans with (n := count (fun x => task_is_scheduled job_task sched x t) ts);
              first by apply sub_count; first by red; move => x /andP [SCHED _].
            unfold task_is_scheduled.
            apply count_exists; first by destruct ts.
            {
              intros cpu x1 x2 SCHED1 SCHED2.
              destruct (sched cpu t); last by done.
              move: SCHED1 SCHED2 => /eqP SCHED1 /eqP SCHED2.
              by rewrite -SCHED1 -SCHED2.
            }
          }
          {
            rewrite -(WORK j t) // -count_predT.
            apply leq_trans with (n := count
                                         (fun j => scheduled_task_other_than tsk (job_task j))
                                         (jobs_scheduled_at sched t));
              last first.
            {
              rewrite -count_map.
              apply count_sub_uniqr; last first.
              {
                move => tsk' /mapP [j' INj' JOBtsk']; subst; apply FROMTS.
                by rewrite mem_scheduled_jobs_eq_scheduled in INj'; eauto 2.
              }
              rewrite map_inj_in_uniq; first by apply scheduled_jobs_uniq.
              red; intros j1 j2 SCHED1 SCHED2 SAMEtsk.
              rewrite 2!mem_scheduled_jobs_eq_scheduled in SCHED1 SCHED2.
              have ARRin1: arrives_in arr_seq j1 by apply (FROMarr j1 t).
              have ARRin2: arrives_in arr_seq j2 by apply (FROMarr j2 t).
              by apply UNIQ; try (by done); apply scheduled_implies_pending.
            }
            {
              apply sub_in_count; intros j' SCHED' _.
              rewrite mem_scheduled_jobs_eq_scheduled in SCHED'.
              unfold scheduled_task_other_than; apply/andP; split.
              {
                move: SCHED' => /existsP [cpu /eqP SCHED'].
                by apply/existsP; exists cpu; rewrite /task_scheduled_on SCHED' eq_refl.
              }
              {
                apply/eqP; red; intro SAMEtsk; symmetry in SAMEtsk.
                move: BACK => /andP [PENDING NOTSCHED].
                generalize SCHED'; intro PENDING'.
                have ARRin': arrives_in arr_seq j' by apply (FROMarr j' t).
                exploit (UNIQ j j'); try (by done);
                  [by apply scheduled_implies_pending | by rewrite -SAMEtsk |].
                by intro EQjob; subst; rewrite SCHED' in NOTSCHED.
              }
            }
          }
        Qed.

    End NoMultipleJobs.

    (* In this section we also prove the absence of multiple jobs of the same
       task when constrained deadlines are assumed, but in the specific case
       of fixed-priority scheduling.  *)
    Section NoMultipleJobsFP.

      (* Assume any work-conserving priority-based scheduler. *)
      Variable higher_eq_priority: FP_policy sporadic_task.
      Hypothesis H_work_conserving: work_conserving job_arrival job_cost job_jitter arr_seq sched.
      Hypothesis H_respects_JLDP_policy:
        respects_FP_policy job_arrival job_cost job_task job_jitter arr_seq sched higher_eq_priority.

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

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

      (* Suppose that jobs are sequential, ...*)
      Hypothesis H_sequential_jobs: sequential_jobs sched.
      (* ... jobs only execute after the jitter, ... *)
      Hypothesis H_jobs_execute_after_jitter:
        jobs_execute_after_jitter job_arrival job_jitter sched.
      (* ... and jobs do not execute after completion. *)
      Hypothesis H_completed_jobs_dont_execute:
        completed_jobs_dont_execute job_cost sched.

      (* Assume that the schedule satisfies the sporadic task model. *)
      Hypothesis H_sporadic_tasks:
        sporadic_task_model task_period job_arrival job_task arr_seq.

      (* Consider a valid task tsk, ...*)
      Variable tsk: sporadic_task.
      Hypothesis H_valid_task: is_valid_sporadic_task task_cost task_period task_deadline tsk.

      (*... whose job j ... *)
      Variable j: Job.
      Hypothesis H_j_arrives: arrives_in arr_seq j.
      Hypothesis H_job_of_tsk: job_task j = tsk.

      (*... is backlogged at time t <= job_arrival j + task_period tsk. *)
      Variable t: time.
      Hypothesis H_j_backlogged: job_is_backlogged j t.
      Hypothesis H_t_before_period: t < job_arrival j + task_period tsk.

      (* Recall the definition of a higher-priority task (with respect to tsk). *)
      Let is_hp_task := higher_priority_task higher_eq_priority tsk.

      (* Assume that any jobs of higher-priority tasks complete by their period. *)
      Hypothesis H_all_previous_jobs_completed :
        forall j_other tsk_other,
          arrives_in arr_seq j_other ->
          job_task j_other = tsk_other ->
          is_hp_task tsk_other ->
          completed job_cost sched j_other (job_arrival j_other + task_period tsk_other).

      (* Assume that any jobs of tsk prior to j complete by their period. *)
      Hypothesis H_all_previous_jobs_of_tsk_completed :
        forall j0,
          arrives_in arr_seq j0 ->
          job_task j0 = tsk ->
          job_arrival j0 < job_arrival j ->
          completed job_cost sched j0 (job_arrival j0 + task_period tsk).

      Definition scheduled_task_with_higher_eq_priority (tsk_other: sporadic_task) :=
        task_is_scheduled job_task sched tsk_other t &&
        is_hp_task tsk_other.

      (* Then, there can be at most one pending job of higher-priority tasks at time t. *)
      Lemma platform_fp_no_multiple_jobs_of_interfering_tasks :
        forall j1 j2,
          arrives_in arr_seq j1 ->
          arrives_in arr_seq j2 ->
          job_is_pending j1 t ->
          job_is_pending j2 t ->
          job_task j1 = job_task j2 ->
          is_hp_task (job_task j1) ->
          j1 = j2.
      Proof.
        unfold sporadic_task_model in *.
        rename H_sporadic_tasks into SPO, H_all_previous_jobs_of_tsk_completed into PREVtsk,
               H_all_previous_jobs_completed into PREV.
        intros j1 j2 ARRin1 ARRin2 PENDING1 PENDING2 SAMEtsk INTERF.
        apply/eqP; rewrite -[_ == _]negbK; apply/negP; red; move => /eqP DIFF.
        move: PENDING1 PENDING2 => /andP [ARRIVED1 /negP NOTCOMP1] /andP [ARRIVED2 /negP NOTCOMP2].
        destruct (leqP (job_arrival j1) (job_arrival j2)) as [BEFORE1 | BEFORE2].
        {
          specialize (SPO j1 j2 DIFF ARRin1 ARRin2 SAMEtsk BEFORE1).
          assert (LEt: job_arrival j1 + task_period (job_task j1) <= t).
          {
            apply leq_trans with (n := job_arrival j2); first by done.
            by apply leq_trans with (n := job_arrival j2 + job_jitter j2); first by apply leq_addr.
          }
          exploit (PREV j1 (job_task j1) ARRin1); [by done | by apply INTERF | intros COMP1].
          apply NOTCOMP1.
          by apply completion_monotonic with (t0 := job_arrival j1 + task_period (job_task j1)).
        }
        {
          apply ltnW in BEFORE2.
          feed (SPO j2 j1); first by red; ins; subst j2.
          feed (SPO ARRin2 ARRin1); first by rewrite SAMEtsk.
          feed SPO; first by done.
          assert (LEt: job_arrival j2 + task_period (job_task j2) <= t).
          {
            apply leq_trans with (n := job_arrival j1); first by done.
            by apply leq_trans with (n := job_arrival j1 + job_jitter j1); first by apply leq_addr.
          }
          exploit (PREV j2 (job_task j2) ARRin2);
            [by done | by rewrite -SAMEtsk | intro COMP2 ].
          apply NOTCOMP2.
          by apply completion_monotonic with (t0 := job_arrival j2 + task_period (job_task j2)).
        }
      Qed.

      (* Also, there can be at most one pending job of tsk at time t. *)
      Lemma platform_fp_no_multiple_jobs_of_tsk :
        forall j',
          arrives_in arr_seq j' ->
          job_is_pending j' t ->
          job_task j' = tsk ->
          j' = j.
      Proof.
        unfold sporadic_task_model in *.
        rename H_sporadic_tasks into SPO,
               H_valid_task into PARAMS,
               H_all_previous_jobs_of_tsk_completed into PREVtsk,
               H_all_previous_jobs_completed into PREV,
               H_j_backlogged into BACK, H_job_of_tsk into JOBtsk.
        intros j' ARRin' PENDING' SAMEtsk.
        apply/eqP; rewrite -[_ == _]negbK; apply/negP; red; move => /eqP DIFF.
        move: BACK PENDING' => /andP [/andP [ARRIVED /negP NOTCOMP] NOTSCHED]
                               /andP [ARRIVED' /negP NOTCOMP'].
        destruct (leqP (job_arrival j') (job_arrival j)) as [BEFORE | BEFORE'].
        {
          exploit (SPO j' j DIFF ARRin' H_j_arrives); [by rewrite JOBtsk | by done | intro SPO'].
          assert (LEt: job_arrival j' + task_period tsk <= t).
          {
            apply leq_trans with (n := job_arrival j); first by rewrite -SAMEtsk.
            by apply leq_trans with (n := job_arrival j + job_jitter j); first by apply leq_addr.
          }
          apply NOTCOMP'.
          apply completion_monotonic with (t0 := job_arrival j' + task_period tsk); try (by done).
          apply PREVtsk; try (by done).
          apply leq_trans with (n := job_arrival j' + task_period tsk); last by rewrite -SAMEtsk.
          rewrite -addn1; apply leq_add; first by done.
          by unfold is_valid_sporadic_task in *; des.
        }
        {
          unfold jitter_has_passed, actual_arrival in *.
          rewrite leqNgt in ARRIVED'; move: ARRIVED' => /negP BUG; apply BUG.
          apply leq_trans with (n := job_arrival j'); last by apply leq_addr.
          apply leq_trans with (n := job_arrival j + task_period tsk); first by done.
          by rewrite -JOBtsk; apply SPO; try (by done);
            [by red; ins; subst j' | by rewrite SAMEtsk | by apply ltnW].
        }
      Qed.

      (* Therefore, all processors are busy with tasks other than tsk. *)
      Lemma platform_fp_cpus_busy_with_interfering_tasks :
        count scheduled_task_with_higher_eq_priority ts = num_cpus.
      Proof.
        have UNIQ := platform_fp_no_multiple_jobs_of_interfering_tasks.
        have UNIQ' := platform_fp_no_multiple_jobs_of_tsk.
        rename H_all_jobs_from_taskset into FROMTS, H_sequential_jobs into SEQUENTIAL,
               H_work_conserving into WORK, H_respects_JLDP_policy into PRIO,
               H_j_backlogged into BACK, H_job_of_tsk into JOBtsk,
               H_sporadic_tasks into SPO, H_valid_job_parameters into JOBPARAMS,
               H_valid_task into TASKPARAMS, H_all_previous_jobs_completed into PREV,
               H_completed_jobs_dont_execute into COMP,
               H_jobs_come_from_arrival_sequence into FROMarr,
               H_all_previous_jobs_of_tsk_completed into PREVtsk,
               H_jobs_execute_after_jitter into JITTER.
        apply work_conserving_eq_work_conserving_count in WORK.
        unfold valid_sporadic_job, valid_realtime_job,
               respects_FP_policy, respects_JLDP_policy, FP_to_JLDP,
               completed_jobs_dont_execute, sequential_jobs,
               sporadic_task_model, is_valid_sporadic_task,
               jobs_of_same_task_dont_execute_in_parallel,
               is_hp_task in *.
        apply/eqP; rewrite eqn_leq; apply/andP; split.
        {
          apply leq_trans with (n := count (fun x => task_is_scheduled job_task sched x t) ts);
            first by apply sub_count; red; move => x /andP [SCHED _].
          unfold task_is_scheduled.
          apply count_exists; first by destruct ts.
          {
            intros cpu x1 x2 SCHED1 SCHED2.
            destruct (sched cpu t); last by done.
            move: SCHED1 SCHED2 => /eqP SCHED1 /eqP SCHED2.
            by rewrite -SCHED1 -SCHED2.
          }
        }
        {
          rewrite -(WORK j t) // -count_predT.
          apply leq_trans with (n := count (fun j =>
            scheduled_task_with_higher_eq_priority (job_task j)) (jobs_scheduled_at sched t));
            last first.
          {
            rewrite -count_map.
            apply leq_trans with (n := count predT
                    [seq x <- (map (fun j => job_task j) (jobs_scheduled_at sched t))
                      | scheduled_task_with_higher_eq_priority x]);
              first by rewrite count_filter; apply sub_count; red; ins.
            apply leq_trans with (n := count predT
                                   [seq x <- ts | scheduled_task_with_higher_eq_priority x]);
              last by rewrite count_predT size_filter.
            apply count_sub_uniqr; last first.
            {
              red; intros tsk' IN'.
              rewrite mem_filter in IN'; move: IN' => /andP [SCHED IN'].
              rewrite mem_filter; apply/andP; split; first by done.
              move: IN' => /mapP [j' IN'] ->; apply FROMTS.
              by rewrite mem_scheduled_jobs_eq_scheduled in IN'; eauto 2.
            }
            {
              rewrite filter_map.
              rewrite map_inj_in_uniq; first by apply filter_uniq, scheduled_jobs_uniq.
              red; intros j1 j2 SCHED1 SCHED2 SAMEtsk.
              rewrite 2!mem_filter in SCHED1 SCHED2.
              move: SCHED1 SCHED2 => /andP [/andP [_ HP1] SCHED1] /andP [/andP [_ HP2] SCHED2].
              rewrite 2!mem_scheduled_jobs_eq_scheduled in SCHED1 SCHED2.
              have ARRin1: arrives_in arr_seq j1 by apply (FROMarr j1 t).
              have ARRIn2: arrives_in arr_seq j2 by apply (FROMarr j2 t).
              by apply UNIQ; try (by done); apply scheduled_implies_pending.
            }
          }
          {
            apply sub_in_count; intros j' SCHED' _.
            rewrite mem_scheduled_jobs_eq_scheduled in SCHED'.
            apply/andP; split.
            {
              move: SCHED' => /existsP [cpu /eqP SCHED'].
              by apply/existsP; exists cpu; rewrite /task_scheduled_on SCHED' eq_refl.
            }
            apply/andP; split; first by rewrite -JOBtsk; apply PRIO with (t := t).
            {
              apply/eqP; red; intro SAMEtsk.
              generalize SCHED'; intro PENDING'.
              have ARRin': arrives_in arr_seq j' by apply (FROMarr j' t).
              apply scheduled_implies_pending with (job_arrival0 := job_arrival)
                (job_cost0 := job_cost) (job_jitter0 := job_jitter) in PENDING'; try (by done).
              specialize (UNIQ' j' ARRin' PENDING' SAMEtsk); subst j'.
              by move: BACK => /andP [_ NOTSCHED]; rewrite SCHED' in NOTSCHED.
            }
          }
        }
      Qed.

    End NoMultipleJobsFP.

  End Lemmas.

End ConstrainedDeadlines.