Require Import Coq.Sets.Ensembles.
Require Import Coq.Lists.List.
Require Import CertiGraph.lib.EquivDec_ext.
Require Import CertiGraph.lib.Coqlib.
Require Import CertiGraph.lib.Ensembles_ext.
Require Import CertiGraph.graph.graph_model.
Require Import CertiGraph.graph.path_lemmas.
Require Import CertiGraph.graph.reachable_computable.
Require Import CertiGraph.graph.graph_gen.
Require Import CertiGraph.graph.FiniteGraph.
Require Import CertiGraph.graph.MathGraph.
Require Import CertiGraph.graph.LstGraph.
Require Import CertiGraph.graph.UnionFind.

Section UnionFindGraph.

  Context {V E: Type}.
  Context {VE: EqDec V eq}.
  Context {EE: EqDec E eq}.

  Context {isNullDec: DecidablePred V}.
  Context {out_edge: V -> E}.

  (* Context {ufg: UnionFindGraph}. *)

  Class LiMaFin (g: PreGraph V E) :=
    {
      li: LstGraph g out_edge;
      ma: MathGraph g isNullDec;
      fin: FiniteGraph g
    }.

  Context {DV DE DG: Type}.

  Definition LGraph := LabeledGraph V E DV DE DG.
  Definition UFGraph := (GeneralGraph V E DV DE DG (fun g => LiMaFin (pg_lg g))).

  Definition UFGraph_LGraph (G: UFGraph): LGraph := lg_gg G.

  Local Coercion UFGraph_LGraph: UFGraph >-> LGraph.
  Local Identity Coercion LGraph_LabeledGraph: LGraph >-> LabeledGraph.
  Local Coercion pg_lg: LabeledGraph >-> PreGraph.

  #[export] Instance maGraph(G: UFGraph): MathGraph G isNullDec := @ma G (@sound_gg _ _ _ _ _ _ _ _ G).
  #[export] Instance finGraph (G: UFGraph): FiniteGraph G := @fin G (@sound_gg _ _ _ _ _ _ _ _ G).
  #[export] Instance liGraph (G: UFGraph):  LstGraph G out_edge := @li G (@sound_gg _ _ _ _ _ _ _ _ G).

  (*Returns the rank (vlabel) and parent of a vertex
    Parent is: take (any?) dst x has an edge to.
                What is projT2 isNullDec?
                I suppose it means if the expr of target is valid
  *)
  Definition vgamma (g: LGraph) (x: V) : DV * V := (vlabel g x, let target := dst (pg_lg g) (out_edge x) in if (projT2 isNullDec target) then x else target).

  (*If v is in graph, and vgamma g v = some rank and parent, then the parent is also valid. *)
  Lemma valid_parent: forall (g: UFGraph) v n p, vvalid g v -> vgamma g v = (n, p) -> vvalid g p.
  Proof.
    intros. unfold vgamma in H0. simpl in H0. inversion H0. clear H0 H2. destruct (projT2 isNullDec (dst g (out_edge v))); auto.
    assert (~ isNullDec (dst g (out_edge v))) by (intro; apply n0; auto).
    pose proof (only_one_edge v (out_edge v) H). assert (out_edge v = out_edge v) by auto. rewrite <- H1 in H2. destruct H2.
    pose proof (valid_graph _ _ H4). destruct H5 as [_ [? | ?]]; auto. exfalso; auto.
  Qed.

  Lemma parent_loop: forall (g: UFGraph) v n y, vgamma g v = (n, v) -> reachable g v y -> v = y.
  Proof.
    intros. unfold vgamma in H. destruct (projT2 isNullDec (dst g (out_edge v))).
    - apply (lst_out_edge_only_one g _ v (dst g (out_edge v)) y); auto. intro. apply reachable_head_valid in H1. apply (valid_not_null g (dst g (out_edge v)) H1); auto.
    - apply (lst_self_loop _ (liGraph g)) in H0; auto. inversion H. rewrite H3. auto.
  Qed.

  Lemma gamma_parent_reachable_included: forall (g: UFGraph) x r pa, vvalid g x -> vgamma g x = (r, pa) -> Included (reachable g pa) (reachable g x).
  Proof.
    intros. intro y; intros. unfold vgamma in H0. destruct (projT2 isNullDec (dst g (out_edge x))).
    - inversion H0. auto.
    - apply edge_reachable_by with pa; auto. split; auto. split.
      + apply reachable_head_valid in H1; auto.
      + inversion H0. rewrite H4. rewrite (dst_step _ (liGraph g) _ _ H H4). auto.
  Qed.

  Lemma Prop_join_reachable_parent: forall (g: UFGraph) x r pa,
      vvalid g x -> vgamma g x = (r, pa) ->
      Prop_join
        (reachable g pa)
        (Intersection _ (reachable g x) (Complement V (reachable g pa)))
        (reachable g x).
  Proof.
    intros. apply Ensemble_join_Intersection_Complement.
    - eapply gamma_parent_reachable_included; eauto.
    - intros. apply decidable_prop_decidable. pose proof (finGraph g).
      apply (@reachable_decidable_prime _ _ _ _ _ _ (maGraph g)).
      + apply LocalFiniteGraph_FiniteGraph; auto.
      + apply (valid_parent _ x r); auto.
      + apply FiniteGraph_EnumCovered; auto.
  Qed.

  Definition Graph_gen_redirect_parent (g: UFGraph) (x: V) (pa: V) (H: weak_valid g pa) (Hv: vvalid g x) (Hn: ~ reachable g pa x): UFGraph.
  Proof.
    refine (generalgraph_gen_dst g (out_edge x) pa _). constructor.
    - simpl. apply (gen_dst_preserve_lst g (liGraph g)); auto.
    - apply (gen_dst_preserve_math g (out_edge x) pa (maGraph g) H).
    - apply (gen_dst_preserve_finite g (out_edge x) pa (finGraph g)).
  Defined.

  Lemma Graph_reachable_dec: forall (G: UFGraph) x, Decidable (vvalid G x) -> forall y, Decidable (reachable G x y).
  Proof.
    intros. apply reachable_decidable with (is_null := isNullDec); auto.
    + apply maGraph.
    + apply LocalFiniteGraph_FiniteGraph, finGraph.
    + apply FiniteGraph_EnumCovered, finGraph.
  Qed.

  Definition Graph_vgen (G: UFGraph) (x: V) (d: DV) : UFGraph := generalgraph_vgen G x d (sound_gg G).

  Lemma uf_root_vgamma: forall (g: UFGraph) v n, vvalid g v -> vgamma g v = (n, v) -> uf_root g v v.
  Proof. intros. split; [apply reachable_refl | intros; apply (parent_loop g _ n)]; auto. Qed.

  Lemma vgamma_not_dst: forall (g: UFGraph) x r pa, vgamma g x = (r, pa) -> pa <> x -> dst g (out_edge x) = pa.
  Proof. intros. unfold vgamma in H. destruct (projT2 isNullDec (dst g (out_edge x))); inversion H; [exfalso |]; auto. Qed.

  Lemma vgamma_not_edge: forall (g: UFGraph) x r pa, vvalid g x -> vgamma g x = (r, pa) -> pa <> x -> g |= x ~> pa.
  Proof.
    intros. assert (vvalid g pa) by (apply valid_parent in H0; auto). hnf. split; [|split]; auto.
    apply (vgamma_not_dst g x r) in H1; auto. rewrite step_spec. exists (out_edge x).
    pose proof (vvalid_src_evalid _ (liGraph g) _ H). destruct H3. split; auto.
  Qed.

  Lemma vgamma_not_reachable': forall (g: UFGraph) x r pa y, vvalid g x -> vgamma g x = (r, pa) -> pa <> x -> reachable g pa y -> ~ reachable g y x.
  Proof. intros. apply (dst_not_reachable _ (liGraph g) _ pa); auto. apply (vgamma_not_dst g x r); auto. Qed.

  Lemma vgamma_not_reachable: forall (g: UFGraph) x r pa, vvalid g x -> vgamma g x = (r, pa) -> pa <> x -> ~ reachable g pa x.
  Proof. intros. assert (vvalid g pa) by (apply valid_parent in H0; auto). apply (vgamma_not_reachable' g x r pa pa); auto. apply reachable_refl; auto. Qed.

  Lemma uf_root_not_eq_root_vgamma: forall (g: UFGraph) x r pa root, vgamma g x = (r, pa) -> uf_root g x root -> x <> root -> x <> pa.
  Proof.
    intros. unfold vgamma in H. destruct (projT2 isNullDec (dst g (out_edge x))).
    - destruct H0. apply reachable_ind.reachable_ind in H0. destruct H0. 1: exfalso; auto. destruct H0 as [z [[? [? ?]] [? ?]]]. rewrite step_spec in H4.
      destruct H4 as [ed [? [? ?]]]. pose proof (conj H7 H4). rewrite (@only_one_edge _ _ _ _ g _ (liGraph g)) in H9; auto. subst ed. rewrite H8 in p.
      exfalso. apply (@valid_not_null _ _ _ _ g _ (maGraph g)) in H3; auto.
    - inversion H. clear H H3. assert (vvalid g x) by (destruct H0; apply reachable_head_valid in H; auto).
      assert (g |= (x, (out_edge x) :: nil) is x ~o~> pa satisfying (fun _ => True)). {
        split; split; intros; hnf; simpl; auto. unfold strong_evalid. assert (out_edge x = out_edge x) by auto. rewrite <- (@only_one_edge _ _ _ _ g _ (liGraph g)) in H2; auto.
        destruct H2. split; [|split]; auto. rewrite H2. split; auto. apply (@valid_graph _ _ _ _ g _ (maGraph g)) in H3. destruct H3 as [_ [? | ?]]; auto.
        hnf in H3. exfalso; auto.
      } rewrite H4. intro. rewrite <- H3 in H2. apply (@no_loop_path _ _ _ _ g _ (liGraph g)) in H2. inversion H2.
  Qed.

  Lemma vgamma_uf_root: forall (g: UFGraph) x r pa root, vvalid g x -> vgamma g x = (r, pa) -> uf_root g x root -> x <> root -> uf_root g pa root.
  Proof.
    intros. pose proof (uf_root_not_eq_root_vgamma g _ _ _ _ H0 H1 H2). destruct H1. split; auto. pose proof (valid_parent g _ _ _ H H0).
    assert (Decidable (reachable g pa root)) by (apply Graph_reachable_dec; left; auto). apply decidable_prop_decidable in H6. destruct H6; auto. exfalso.
    pose proof (lst_out_edge_only_one g (liGraph g) x pa root). simpl in H7. apply H2. apply H7; auto. apply (vgamma_not_dst _ _ r); auto.
  Qed.

  #[global] Instance fml : FML_General V E DV DE DG LiMaFin out_edge isNullDec. Proof. constructor; intros; destruct X; auto. Defined.

  Lemma findS_preserves_vgamma: forall (g1 g2: UFGraph) x r pa, vvalid g1 x -> vgamma g1 x = (r, pa) -> pa <> x -> findS g1 pa g2 -> vgamma g2 x = (r, pa).
  Proof.
    intros. assert (Hr: ~ reachable g1 pa x) by (apply vgamma_not_reachable with r; auto). unfold vgamma in *. destruct (projT2 isNullDec (dst g1 (out_edge x))).
    1: inversion H0; exfalso; auto. rewrite <- H0. destruct H2 as [? [[? ?] ?]]. f_equal.
    - assert (vvalid g2 x) by (rewrite <- H3; auto). specialize (H5 x H H6). unfold UFGraph_LGraph. rewrite H5. auto.
    - assert (evalid (predicate_partialgraph (lg_gg g1) (fun n : V => ~ reachable (lg_gg g1) pa n)) (out_edge x)). {
        simpl. hnf. pose proof (vvalid_src_evalid _ (liGraph g1) _ H). unfold UFGraph_LGraph in H6. destruct H6. rewrite H6. split; auto.
      } destruct H2 as [_ [? [_ ?]]]. pose proof H6. rewrite H2 in H8. clear H2. specialize (H7 _ H6 H8). simpl in H7. unfold UFGraph_LGraph. rewrite <- H7.
      destruct (projT2 isNullDec (dst (lg_gg g1) (out_edge x))); [exfalso |]; auto.
  Qed.

  Lemma the_same_root_union: forall (g g1 g2: UFGraph) x y root,
      vvalid g x -> vvalid g y -> uf_equiv g g1 -> uf_equiv g1 g2 -> uf_root g1 x root -> uf_root g2 y root -> uf_union g x y g2.
  Proof. intros. apply (same_root_union g g1 g2 x y root); auto. Qed.

  Lemma uf_equiv_root_the_same: forall (g1 g2: UFGraph) x root, uf_equiv g1 g2 -> uf_root g1 x root <-> uf_root g2 x root.
  Proof. intros. pose proof (@uf_equiv_the_same_root _ _ _ _ _ _ _ _ out_edge isNullDec fml g1 g2 x root H). apply H0. Qed.

  Lemma uf_equiv_not_reachable: forall (g1 g2: UFGraph) x r pa root,
      vvalid g1 x -> vgamma g1 x = (r, pa) -> pa <> x -> uf_equiv g1 g2 -> uf_root g2 pa root -> ~ reachable g2 root x.
  Proof.
    intros. pose proof H3. rewrite <- (uf_equiv_root_the_same _ _ pa root H2) in H4. destruct H3. intro. apply H5 in H6. subst x.
    pose proof (vgamma_not_reachable g1 root r pa H H0 H1). destruct H4. auto.
  Qed.

  Lemma graph_gen_redirect_parent_equiv': forall (g1 g2: UFGraph) x root,
      uf_equiv g1 g2 -> vvalid g2 x -> (~ reachable g2 root x) -> uf_root g2 x root -> uf_equiv g1 (pregraph_gen_dst g2 (out_edge x) root).
  Proof.
    intros. apply (@uf_equiv_trans _ _ _ _ g2 _ (liGraph g2) _ (maGraph g2) (finGraph g2)); auto. split; intro y; simpl; [intuition |]. intros.
    assert (Decidable (reachable g2 y x)) by (apply Graph_reachable_dec; left; destruct H3; apply reachable_head_valid in H3; auto).
    apply decidable_prop_decidable in H5. destruct H5.
    - pose proof (uf_root_gen_dst_same g2 (liGraph g2) _ _ _ H2 H1 H5). simpl in H6.
      pose proof (uf_root_unique _ (gen_dst_preserve_lst g2 (liGraph g2) _ _ H1 H0) _ _ _ H4 H6). subst r2.
      pose proof (uf_root_reachable _ _ _ _ H5 H2). apply (uf_root_unique g2 (liGraph g2) _ _ _ H3 H7).
    - apply (uf_root_unique _ (gen_dst_preserve_lst g2 (liGraph g2) _ _ H1 H0) y); auto. apply (uf_root_gen_dst_preserve g2 (liGraph g2)); auto.
  Qed.

  Lemma graph_gen_redirect_parent_equiv: forall (g1 g2: UFGraph) x r pa root (Hv: vvalid g2 x) (Hn: ~ reachable g2 root x),
      vvalid g1 x -> vgamma g1 x = (r, pa) -> pa <> x -> uf_equiv g1 g2 -> uf_root g2 pa root -> uf_equiv g1 (pregraph_gen_dst g2 (out_edge x) root).
  Proof.
    intros. apply graph_gen_redirect_parent_equiv'; auto. rewrite <- (uf_equiv_root_the_same g1); auto.
    apply (uf_root_edge g1 (liGraph g1) x pa); [| apply (vgamma_not_dst g1 x r) | rewrite (uf_equiv_root_the_same g1 g2)]; auto.
  Qed.

  Lemma graph_gen_redirect_parent_findS: forall (g1 g2: UFGraph) x r1 r2 pa pa' (H: weak_valid g2 pa') (Hv: vvalid g2 x) (Hn: ~ reachable g2 pa' x),
      vvalid g1 x -> vgamma g1 x = (r1, pa) -> pa <> x -> vgamma g2 x = (r2, pa) -> findS g1 pa g2 -> uf_root g2 pa pa' ->
      findS g1 x (Graph_gen_redirect_parent g2 x pa' H Hv Hn).
  Proof.
    intros. hnf. simpl. destruct H4 as [? [? ?]]. hnf in H4. simpl in H4. unfold predicate_vvalid, predicate_weak_evalid in H4. split; [|split].
    - assert (forall v, ~ reachable (lg_gg g1) x v -> ~ reachable (lg_gg g1) pa v). {
        intros. intro. apply H8. pose proof (gamma_parent_reachable_included g1 x r1 pa H0 H1). apply H10. auto. }
      assert (forall v, ~ reachable (lg_gg g1) pa v <-> ~ reachable (lg_gg g1) x v \/ x = v). {
        intros. split; intros.
        - destruct_eq_dec x v; [right | left]; auto. intro. apply H9. apply reachable_ind.reachable_ind in H11. destruct H11. 1: exfalso; auto.
          destruct H11 as [z [[_ [_ ?]] [? ?]]]. rewrite (dst_step g1 (liGraph g1) x pa) in H11; auto; [subst pa | apply (vgamma_not_dst g1 x r1)]; auto.
        - destruct H9.
          + apply H8; auto.
          + subst v. apply vgamma_not_reachable with r1; auto.
      } hnf. simpl. unfold predicate_vvalid, predicate_weak_evalid. simpl. destruct H4 as [? [? [? ?]]]. split; [|split; [|split]]; intros.
      + split; intros; destruct H13; split; auto; apply H8 in H14; pose proof (conj H13 H14); [rewrite H4 in H15 | rewrite <- H4 in H15]; destruct H15; auto.
      + split; intros; destruct H13.
        * pose proof (H8 _ H14). pose proof (conj H13 H15). rewrite H10 in H16. destruct H16. rewrite H9 in H17. destruct H17. 1: split; auto. symmetry in H17.
          pose proof (conj H17 H16). rewrite (@only_one_edge _ _ _ _ g2 _ (liGraph g2)) in H18; auto. subst e. pose proof (vvalid_src_evalid _ (liGraph g1) _ H0).
          destruct H18 as [? _]. unfold UFGraph_LGraph in H18. rewrite H18 in H14. exfalso. apply H14. apply reachable_refl. auto.
        * pose proof (H8 _ H14). pose proof (conj H13 H15). rewrite <- H10 in H16. destruct H16. rewrite H9 in H17. destruct H17. 1: split; auto. symmetry in H17.
          pose proof (conj H17 H16). rewrite (@only_one_edge _ _ _ _ g1 _ (liGraph g1)) in H18; auto. subst e. pose proof (vvalid_src_evalid _ (liGraph g2) _ Hv).
          destruct H18 as [? _]. unfold UFGraph_LGraph in H18. rewrite H18 in H14. exfalso. apply H14. apply reachable_refl. auto.
      + destruct H13, H14. apply H8 in H15. apply H8 in H16. apply H11; auto.
      + unfold updateEdgeFunc. destruct (equiv_dec (out_edge x) e).
        * unfold Equivalence.equiv in e0. subst e. pose proof (vvalid_src_evalid _ (liGraph g1) _ H0).
          destruct H15. unfold UFGraph_LGraph in H15. destruct H13. exfalso. apply H17. rewrite H15. apply reachable_refl; auto.
        * destruct H13, H14. apply H8 in H15. apply H8 in H16. apply H12; auto.
    - apply (graph_gen_redirect_parent_equiv _ _ _ r1 pa); auto.
    - apply H7.
  Qed.

  Lemma diff_root_union_1: forall (g g1 g2: UFGraph) x y x_root y_root,
      uf_equiv g g1 -> uf_root g1 x x_root -> uf_equiv g1 g2 -> uf_root g2 y y_root -> x_root <> y_root ->
      (@weak_valid _ _ _ _ g2 _ (maGraph g2) y_root) -> vvalid g2 x_root ->
      ~ reachable g2 y_root x_root -> uf_union g x y (pregraph_gen_dst g2 (out_edge x_root) y_root).
  Proof.
    intros. assert (uf_equiv g g2) by (apply (@uf_equiv_trans _ _ _ _ g1 _ (liGraph g1) _ (maGraph g1) (finGraph g1)); auto).
    pose proof (uf_equiv_union g g2 (Graph_gen_redirect_parent g2 x_root y_root H4 H5 H6) x y H7). simpl in H8. apply H8.
    apply (@diff_root_union _ _ _ _ _ _ _ _ out_edge isNullDec fml); auto. apply (uf_equiv_root_the_same g1); auto.
  Qed.

  Lemma diff_root_union_2: forall (g g1 g2: UFGraph) x y x_root y_root,
      uf_equiv g g1 -> uf_root g1 x x_root -> uf_equiv g1 g2 -> uf_root g2 y y_root -> x_root <> y_root -> (@weak_valid _ _ _ _ g2 _ (maGraph g2) x_root) -> vvalid g2 y_root ->
      ~ reachable g2 x_root y_root -> uf_union g x y (pregraph_gen_dst g2 (out_edge y_root) x_root).
  Proof.
    intros. assert (uf_equiv g g2) by (apply (@uf_equiv_trans _ _ _ _ g1 _ (liGraph g1) _ (maGraph g1) (finGraph g1)); auto).
    pose proof (uf_equiv_union g g2 (Graph_gen_redirect_parent g2 y_root x_root H4 H5 H6) y x H7). simpl in H8. apply uf_union_sym. apply H8.
    apply (@diff_root_union _ _ _ _ _ _ _ _ out_edge isNullDec fml); auto. apply (uf_equiv_root_the_same g1); auto.
  Qed.

  Lemma graph_gen_redirect_parent_vgamma: forall (g1 g2: UFGraph) x r pa y (H: weak_valid g1 x) (Hv: vvalid g1 y) (Hn: ~ reachable g1 x y),
      (forall a b, out_edge a = out_edge b -> a = b) -> vgamma g1 x = (r, pa) -> g2 = (Graph_gen_redirect_parent g1 y x H Hv Hn) -> vgamma g2 x = (r, pa).
  Proof.
    intros. rewrite H2. clear H2. unfold vgamma in *. simpl in *. inversion H1. f_equal. unfold updateEdgeFunc.
    destruct (equiv_dec (out_edge y) (out_edge x)); auto. hnf in e. apply H0 in e. subst y. exfalso; apply Hn; apply reachable_refl; auto.
  Qed.

End UnionFindGraph.


Require Import prosa.classic.util.all.
Require Import prosa.classic.model.arrival.basic.job prosa.classic.model.arrival.basic.task prosa.classic.model.priority prosa.classic.model.arrival.basic.task_arrival
               prosa.classic.model.arrival.basic.arrival_bounds.
Require Import prosa.classic.model.schedule.uni.schedule_of_task prosa.classic.model.schedule.uni.workload
               prosa.classic.model.schedule.uni.schedulability prosa.classic.model.schedule.uni.response_time
               prosa.classic.model.schedule.uni.service.
Require Import prosa.classic.model.schedule.uni.limited.busy_interval prosa.classic.model.schedule.uni.basic.platform.
Require Import prosa.classic.analysis.uni.basic.workload_bound_fp.
From mathcomp Require Import ssreflect ssrbool eqtype ssrnat seq fintype bigop.

Module ResponseTimeAnalysisFP.

  Import Job ScheduleOfTask SporadicTaskset Priority ResponseTime
         TaskArrival ArrivalBounds WorkloadBoundFP Platform Schedulability
         BusyIntervalJLFP Workload Service.

  (* In this section, we prove that any fixed point in the RTA for uniprocessor
     FP scheduling is a response-time bound. *)
  Section ResponseTimeBound.

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

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

    (* Assume any job arrival sequence with consistent, duplicate-free arrivals... *)
    Variable arr_seq: arrival_sequence Job.
    Hypothesis H_arrival_times_are_consistent: arrival_times_are_consistent job_arrival arr_seq.
    Hypothesis H_no_duplicate_arrivals: arrival_sequence_is_a_set arr_seq.

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

    (* Consider a task set ts where all tasks have valid parameters... *)
    Variable ts: seq SporadicTask.
    Hypothesis H_valid_task_parameters:
      valid_sporadic_taskset task_cost task_period task_deadline ts.

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

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

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

    (* Consider an FP policy that indicates a higher-or-equal priority relation,
       and assume that the relation is reflexive and transitive. *)
    Variable higher_eq_priority: FP_policy SporadicTask.
    Hypothesis H_priority_is_reflexive: FP_is_reflexive higher_eq_priority.
    Hypothesis H_priority_is_transitive: FP_is_transitive higher_eq_priority.

    (* Next, assume that the schedule is a work-conserving FP schedule. *)
    Hypothesis H_work_conserving: work_conserving job_arrival job_cost arr_seq sched.
    Hypothesis H_respects_fp_policy:
      respects_FP_policy job_arrival job_cost job_task arr_seq sched higher_eq_priority.

    (* Now we proceed with the analysis.
       Let tsk be any task in ts that is to be analyzed. *)
    Variable tsk: SporadicTask.
    Hypothesis H_tsk_in_ts: tsk \in ts.

    (* Recall the definition of response-time bound and the total workload bound W
       for tasks with higher-or-equal priority (with respect to tsk). *)
    Let response_time_bounded_by :=
      is_response_time_bound_of_task job_arrival job_cost job_task arr_seq sched.
    Let W := total_workload_bound_fp task_cost task_period higher_eq_priority ts tsk.

    (* Let R be any positive fixed point of the response-time recurrence. *)
    Variable R: time.
    Hypothesis H_R_positive: R > 0.
    Hypothesis H_response_time_is_fixed_point: R = W R.

    (* Since R = W R bounds the workload of higher-or-equal priority
       in any interval of length R, it follows from the busy-interval
       lemmas that R bounds the response-time of job j.
       (For more details, see model/uni/basic/busy_interval.v and
        analysis/uni/basic/workload_bound_fp.v.) *)
    Theorem uniprocessor_response_time_bound_fp:
      response_time_bounded_by tsk R.
    Proof.
      rename H_response_time_is_fixed_point into FIX.
      intros j ARRj JOBtsk.
      move: (posnP (job_cost j)) => [Z|POS].
      { by rewrite /is_response_time_bound_of_job /completed_by Z. }
      set prio := FP_to_JLFP job_task higher_eq_priority.
      apply busy_interval_bounds_response_time with
          (arr_seq0 := arr_seq)
          (higher_eq_priority0 := prio)
          (priority_inversion_bound := 0); try by done.
      - by intros x; apply H_priority_is_reflexive.
      { intros t1 t2 BUSY.
        rewrite /cumulative_priority_inversion /is_priority_inversion leqn0.
        rewrite big_nat big1 //; move => t NEQ.
        destruct (sched t) eqn:SCHED; last by done.
        have HP := pending_hp_job_exists
                     job_arrival job_cost arr_seq _ sched
                     prio _ ARRj _ _ _ _ _ BUSY _ NEQ.
        feed_n 4 HP; try done.
        { by intros x; apply H_priority_is_reflexive. }
        move: HP => [jhp [ARRjhp [PEND PRIO]]].
        apply/eqP; rewrite eqb0 Bool.negb_involutive.
        rewrite /prio /FP_to_JLFP.
        eapply H_priority_is_transitive with (job_task jhp); last by done.
        destruct (s == jhp) eqn:EQ; first by move: EQ => /eqP EQ; subst s.
        apply H_respects_fp_policy with t; try done.
        { apply/andP; split; first by done.
          rewrite /scheduled_at SCHED.
          apply/negP. intros SNEQ; move: SNEQ => /eqP SNEQ.
          move: EQ => /negP EQ; apply EQ.
            by inversion SNEQ.
        }
        { by rewrite /scheduled_at SCHED. }
      }
      apply fp_workload_bound_holds with
          (job_arrival0 := job_arrival) (task_cost0 := task_cost)
          (task_period0 := task_period) (task_deadline0 := task_deadline)
          (job_deadline0 := job_deadline) (ts0 := ts); try (by done).
        by rewrite JOBtsk.
    Qed.

  End ResponseTimeBound.

End ResponseTimeAnalysisFP.


Require Import prosa.classic.util.all.
Require Import prosa.classic.model.arrival.basic.arrival_sequence prosa.classic.model.suspension
               prosa.classic.model.priority.
Require Import prosa.classic.model.schedule.uni.susp.schedule.
From mathcomp Require Import ssreflect ssrbool eqtype ssrnat seq fintype bigop.

Module PlatformWithSuspensions.

  Export ScheduleWithSuspensions Priority.

  Section Definitions.

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

    (* Assume that job suspension times are given. *)
    Variable next_suspension: job_suspension Job.

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

    (* ...and any uniprocessor schedule of these jobs. *)
    Variable sched: schedule Job.

    (* For simplicity, let's recall the definitions of pending, scheduled, and backlogged job.
       Note that this notion of backlogged is specific for suspension-aware schedulers. *)
    Let job_pending_at := pending job_arrival job_cost sched.
    Let job_scheduled_at := scheduled_at sched.
    Let job_backlogged_at := backlogged job_arrival job_cost next_suspension sched.

    (* In this section, we define schedule constraints for suspension-aware schedules. *)
    Section ScheduleConstraints.

      (* First, we consider constraints related to execution. *)
      Section Execution.

        (* We say that a scheduler is work-conserving iff whenever a job j
           is backlogged, the processor is always busy with another job. *)
        Definition work_conserving :=
          forall j t,
            arrives_in arr_seq j ->
            job_backlogged_at j t ->
            exists j_other, job_scheduled_at j_other t.

      End Execution.

      (* Next, we consider constraints related to FP policies. *)
      Section FP.

        (* We say that an FP policy...*)
        Variable higher_eq_priority: FP_policy Task.

        (* ... is respected by the scheduler iff at any time t, a scheduled job
           has higher (or same) priority than (as) any backlogged job. *)
        Definition respects_FP_policy :=
          forall j j_hp t,
            arrives_in arr_seq j ->
            job_backlogged_at j t ->
            job_scheduled_at j_hp t ->
            higher_eq_priority (job_task j_hp) (job_task j).

      End FP.

      (* Next, we consider constraints related to JLFP policies. *)
      Section JLFP.

        (* We say that a JLFP policy ...*)
        Variable higher_eq_priority: JLFP_policy Job.

        (* ... is respected by the scheduler iff every scheduled job
           has higher (or same) priority than (as) any backlogged job. *)
        Definition respects_JLFP_policy :=
          forall j j_hp t,
            arrives_in arr_seq j ->
            job_backlogged_at j t ->
            job_scheduled_at j_hp t ->
            higher_eq_priority j_hp j.

      End JLFP.

      (* Next, we consider constraints related to JLDP policies. *)
      Section JLDP.

        (* We say that a JLDP policy ...*)
        Variable higher_eq_priority: JLDP_policy Job.

        (* ... is respected by the scheduler iff at any time t, a scheduled job
           has higher (or same) priority than (as) any backlogged job. *)
        Definition respects_JLDP_policy :=
          forall j j_hp t,
            arrives_in arr_seq j ->
            job_backlogged_at j t ->
            job_scheduled_at j_hp t ->
            higher_eq_priority t j_hp j.

      End JLDP.

    End ScheduleConstraints.

  End Definitions.

End PlatformWithSuspensions.


Require Export SystemFR.Judgments.
Require Export SystemFR.AnnotatedTactics.
Require Export SystemFR.RedTactics.
Require Export SystemFR.EquivalentContext.

Lemma annotated_equivalence_context:
  forall Θ Γ C t1 t2,
    wf C 1 ->
    is_annotated_term C ->
    subset (fv C) (support Γ) ->
    is_annotated_term t1 ->
    is_annotated_term t2 ->
    [[ Θ; Γ ⊨ t1 ≡ t2 ]] ->
    [[ Θ; Γ ⊨ open 0 C t1 ≡ open 0 C t2 ]].
Proof.
  unfold open_equivalent;
    repeat step || erase_open || t_substitutions || apply equivalent_context;
    eauto with erased;
    eauto with wf;
    eauto with fv.
Qed.

Lemma annotated_equivalence_lambdas:
  forall Θ Γ t1 t2 A B,
    is_annotated_term t1 ->
    is_annotated_term t2 ->
    is_annotated_type A ->
    wf A 1 ->
    subset (fv A) (support Γ) ->
    [[ Θ; Γ ⊨ t1 ≡ t2 ]] ->
    [[ Θ; Γ ⊨ lambda A t1 ≡ lambda B t2 ]].
Proof.
  intros.
  unshelve epose proof
    (annotated_equivalence_context Θ Γ (lambda A (lvar 1 term_var)) t1 t2 _ _ _ _ _);
    repeat step || list_utils.
Qed.


Require Import Coq.Lists.List.
Require Import Coq.micromega.Lia.
Require Import Coq.Init.Peano.
Require Import Coq.Arith.PeanoNat.
Require Import Coq.Arith.Compare_dec.
Require Import Coq.PArith.BinPosDef.
Require Import Coq.ZArith.BinInt Coq.ZArith.ZArith Coq.ZArith.Zdiv Coq.ZArith.Znumtheory Coq.NArith.NArith. (* import Zdiv before Znumtheory *)
Require Import Coq.NArith.Nnat.
Require Import Coq.ZArith.Znat.

Require Import Crypto.Algebra.Hierarchy Crypto.Algebra.Field.
Require Import Crypto.Spec.ModularArithmetic.
Require Import Crypto.Arithmetic.ModularArithmeticTheorems Crypto.Arithmetic.PrimeFieldTheorems.

Require Import Crypto.Util.Decidable. (* Crypto.Util.Notations. *)
Require Import Coq.setoid_ring.Ring_theory Coq.setoid_ring.Field_theory Coq.setoid_ring.Field_tac.
Require Import Ring.

From Circom Require Import Circom Default Util DSL Tuple ListUtil LibTactics Simplify.
From Circom Require Import Repr ReprZ.
From Circom.CircomLib Require Import Bitify Comparators Gates.

(* Circuit:
* https://github.com/yi-sun/circom-pairing/blob/master/circuits/bigint.circom
*)

Module CheckCarryToZero.

Module B := Bitify.
Module D := DSL.
Module Cmp := Comparators.
Module RZS := ReprZSigned.
Module RZ := RZS.RZ.

Import B.

Local Open Scope list_scope.
Local Open Scope Z_scope.
Local Open Scope F_scope.
Local Open Scope circom_scope.
Local Open Scope tuple_scope.

Local Coercion Z.of_nat: nat >-> Z.
Local Coercion N.of_nat: nat >-> N.

Section _CheckCarryToZero.
Context {n m k: nat}.

Local Notation "[| xs |]" := (RZ.as_le n xs).

Definition cons (_in: F^k) :=
  let EPSILON := 1%nat in
  exists
  (carry: F^k)
  (carryRangeChecks: (@Num2Bits.t (m + EPSILON - n)) ^ k),
    D.iter (fun (i: nat) _cons => _cons /\
      (if (dec (i=0))%nat then
        _in[i] = carry[i] * 2^n
      else
        _in[i] + carry[i-1] = carry[i] * 2^n) /\
      carryRangeChecks[i].(Num2Bits._in) = carry[i] + 2^(m+EPSILON-n-1)
      )
      (k-1) True /\
    _in[k-1] + carry[k-2] = 0.

Local Close Scope F_scope.

Record t := {
  _in: F^k;
  _cons: cons _in
}.

End _CheckCarryToZero.
End CheckCarryToZero.


Require Export euclidean__axioms.
Require Export euclidean__defs.
Require Export euclidean__tactics.
Require Export lemma__8__2.
Require Export lemma__8__7.
Require Export lemma__NCdistinct.
Require Export lemma__collinear4.
Require Export lemma__collinearorder.
Require Export lemma__collinearright.
Require Export lemma__inequalitysymmetric.
Require Export lemma__legsmallerhypotenuse.
Require Export lemma__lessthancongruence2.
Require Export lemma__lessthantransitive.
Require Export lemma__ray4.
Require Export lemma__ray5.
Require Export lemma__rightangleNC.
Require Export lemma__trichotomy2.
Require Export lemma__tworays.
Require Export logic.
Definition lemma__altitudeofrighttriangle : forall A B C M p, (euclidean__defs.Per B A C) -> ((euclidean__defs.Per A M p) -> ((euclidean__axioms.Col B C p) -> ((euclidean__axioms.Col B C M) -> (euclidean__axioms.BetS B M C)))).
Proof.
intro A.
intro B.
intro C.
intro M.
intro p.
intro H.
intro H0.
intro H1.
intro H2.
assert (* Cut *) (euclidean__axioms.nCol B A C) as H3.
- apply (@lemma__rightangleNC.lemma__rightangleNC B A C H).
- assert (* Cut *) (euclidean__axioms.neq C B) as H4.
-- assert (* Cut *) ((euclidean__axioms.neq B A) /\ ((euclidean__axioms.neq A C) /\ ((euclidean__axioms.neq B C) /\ ((euclidean__axioms.neq A B) /\ ((euclidean__axioms.neq C A) /\ (euclidean__axioms.neq C B)))))) as H4.
--- apply (@lemma__NCdistinct.lemma__NCdistinct B A C H3).
--- destruct H4 as [H5 H6].
destruct H6 as [H7 H8].
destruct H8 as [H9 H10].
destruct H10 as [H11 H12].
destruct H12 as [H13 H14].
exact H14.
-- assert (* Cut *) (~(B = M)) as H5.
--- intro H5.
assert (* Cut *) (euclidean__defs.Per A B p) as H6.
---- apply (@eq__ind__r euclidean__axioms.Point M (fun B0 => (euclidean__defs.Per B0 A C) -> ((euclidean__axioms.Col B0 C p) -> ((euclidean__axioms.Col B0 C M) -> ((euclidean__axioms.nCol B0 A C) -> ((euclidean__axioms.neq C B0) -> (euclidean__defs.Per A B0 p))))))) with (x := B).
-----intro H6.
intro H7.
intro H8.
intro H9.
intro H10.
exact H0.

----- exact H5.
----- exact H.
----- exact H1.
----- exact H2.
----- exact H3.
----- exact H4.
---- assert (* Cut *) (euclidean__axioms.Col p B C) as H7.
----- assert (* Cut *) ((euclidean__axioms.Col C B p) /\ ((euclidean__axioms.Col C p B) /\ ((euclidean__axioms.Col p B C) /\ ((euclidean__axioms.Col B p C) /\ (euclidean__axioms.Col p C B))))) as H7.
------ apply (@lemma__collinearorder.lemma__collinearorder B C p H1).
------ destruct H7 as [H8 H9].
destruct H9 as [H10 H11].
destruct H11 as [H12 H13].
destruct H13 as [H14 H15].
exact H12.
----- assert (* Cut *) (euclidean__defs.Per p B A) as H8.
------ apply (@lemma__8__2.lemma__8__2 A B p H6).
------ assert (* Cut *) (euclidean__defs.Per C B A) as H9.
------- apply (@lemma__collinearright.lemma__collinearright p B C A H8 H7 H4).
------- assert (* Cut *) (~(euclidean__defs.Per C B A)) as H10.
-------- apply (@lemma__8__7.lemma__8__7 C A B H).
-------- apply (@H10 H9).
--- assert (* Cut *) (euclidean__defs.Per p M A) as H6.
---- apply (@lemma__8__2.lemma__8__2 A M p H0).
---- assert (* Cut *) (euclidean__axioms.Col C B p) as H7.
----- assert (* Cut *) ((euclidean__axioms.Col C B p) /\ ((euclidean__axioms.Col C p B) /\ ((euclidean__axioms.Col p B C) /\ ((euclidean__axioms.Col B p C) /\ (euclidean__axioms.Col p C B))))) as H7.
------ apply (@lemma__collinearorder.lemma__collinearorder B C p H1).
------ destruct H7 as [H8 H9].
destruct H9 as [H10 H11].
destruct H11 as [H12 H13].
destruct H13 as [H14 H15].
exact H8.
----- assert (* Cut *) (euclidean__axioms.Col C B M) as H8.
------ assert (* Cut *) ((euclidean__axioms.Col C B M) /\ ((euclidean__axioms.Col C M B) /\ ((euclidean__axioms.Col M B C) /\ ((euclidean__axioms.Col B M C) /\ (euclidean__axioms.Col M C B))))) as H8.
------- apply (@lemma__collinearorder.lemma__collinearorder B C M H2).
------- destruct H8 as [H9 H10].
destruct H10 as [H11 H12].
destruct H12 as [H13 H14].
destruct H14 as [H15 H16].
exact H9.
------ assert (euclidean__axioms.nCol B A C) as H9 by exact H3.
assert (* Cut *) (euclidean__axioms.neq C B) as H10.
------- assert (* Cut *) ((euclidean__axioms.neq B A) /\ ((euclidean__axioms.neq A C) /\ ((euclidean__axioms.neq B C) /\ ((euclidean__axioms.neq A B) /\ ((euclidean__axioms.neq C A) /\ (euclidean__axioms.neq C B)))))) as H10.
-------- apply (@lemma__NCdistinct.lemma__NCdistinct B A C H9).
-------- destruct H10 as [H11 H12].
destruct H12 as [H13 H14].
destruct H14 as [H15 H16].
destruct H16 as [H17 H18].
destruct H18 as [H19 H20].
exact H20.
------- assert (* Cut *) (euclidean__axioms.Col B p M) as H11.
-------- apply (@euclidean__tactics.not__nCol__Col B p M).
---------intro H11.
apply (@euclidean__tactics.Col__nCol__False B p M H11).
----------apply (@lemma__collinear4.lemma__collinear4 C B p M H7 H8 H10).

-------- assert (* Cut *) (euclidean__axioms.Col p M B) as H12.
--------- assert (* Cut *) ((euclidean__axioms.Col p B M) /\ ((euclidean__axioms.Col p M B) /\ ((euclidean__axioms.Col M B p) /\ ((euclidean__axioms.Col B M p) /\ (euclidean__axioms.Col M p B))))) as H12.
---------- apply (@lemma__collinearorder.lemma__collinearorder B p M H11).
---------- destruct H12 as [H13 H14].
destruct H14 as [H15 H16].
destruct H16 as [H17 H18].
destruct H18 as [H19 H20].
exact H15.
--------- assert (* Cut *) (euclidean__defs.Per B M A) as H13.
---------- apply (@lemma__collinearright.lemma__collinearright p M B A H6 H12 H5).
---------- assert (* Cut *) (euclidean__axioms.Col B C p) as H14.
----------- assert (* Cut *) ((euclidean__axioms.Col M p B) /\ ((euclidean__axioms.Col M B p) /\ ((euclidean__axioms.Col B p M) /\ ((euclidean__axioms.Col p B M) /\ (euclidean__axioms.Col B M p))))) as H14.
------------ apply (@lemma__collinearorder.lemma__collinearorder p M B H12).
------------ destruct H14 as [H15 H16].
destruct H16 as [H17 H18].
destruct H18 as [H19 H20].
destruct H20 as [H21 H22].
exact H1.
----------- assert (* Cut *) (euclidean__axioms.Col B C M) as H15.
------------ assert (* Cut *) ((euclidean__axioms.Col C B p) /\ ((euclidean__axioms.Col C p B) /\ ((euclidean__axioms.Col p B C) /\ ((euclidean__axioms.Col B p C) /\ (euclidean__axioms.Col p C B))))) as H15.
------------- apply (@lemma__collinearorder.lemma__collinearorder B C p H14).
------------- destruct H15 as [H16 H17].
destruct H17 as [H18 H19].
destruct H19 as [H20 H21].
destruct H21 as [H22 H23].
exact H2.
------------ assert (* Cut *) (euclidean__axioms.neq B C) as H16.
------------- apply (@lemma__inequalitysymmetric.lemma__inequalitysymmetric C B H10).
------------- assert (* Cut *) (euclidean__axioms.Col C p M) as H17.
-------------- apply (@euclidean__tactics.not__nCol__Col C p M).
---------------intro H17.
apply (@euclidean__tactics.Col__nCol__False C p M H17).
----------------apply (@lemma__collinear4.lemma__collinear4 B C p M H14 H15 H16).

-------------- assert (* Cut *) (euclidean__axioms.Col p M C) as H18.
--------------- assert (* Cut *) ((euclidean__axioms.Col p C M) /\ ((euclidean__axioms.Col p M C) /\ ((euclidean__axioms.Col M C p) /\ ((euclidean__axioms.Col C M p) /\ (euclidean__axioms.Col M p C))))) as H18.
---------------- apply (@lemma__collinearorder.lemma__collinearorder C p M H17).
---------------- destruct H18 as [H19 H20].
destruct H20 as [H21 H22].
destruct H22 as [H23 H24].
destruct H24 as [H25 H26].
exact H21.
--------------- assert (* Cut *) (euclidean__defs.Per C A B) as H19.
---------------- apply (@lemma__8__2.lemma__8__2 B A C H).
---------------- assert (* Cut *) (~(C = M)) as H20.
----------------- intro H20.
assert (* Cut *) (euclidean__defs.Per A C p) as H21.
------------------ apply (@eq__ind__r euclidean__axioms.Point M (fun C0 => (euclidean__defs.Per B A C0) -> ((euclidean__axioms.Col B C0 p) -> ((euclidean__axioms.Col B C0 M) -> ((euclidean__axioms.nCol B A C0) -> ((euclidean__axioms.neq C0 B) -> ((euclidean__axioms.Col C0 B p) -> ((euclidean__axioms.Col C0 B M) -> ((euclidean__axioms.nCol B A C0) -> ((euclidean__axioms.neq C0 B) -> ((euclidean__axioms.Col B C0 p) -> ((euclidean__axioms.Col B C0 M) -> ((euclidean__axioms.neq B C0) -> ((euclidean__axioms.Col C0 p M) -> ((euclidean__axioms.Col p M C0) -> ((euclidean__defs.Per C0 A B) -> (euclidean__defs.Per A C0 p))))))))))))))))) with (x := C).
-------------------intro H21.
intro H22.
intro H23.
intro H24.
intro H25.
intro H26.
intro H27.
intro H28.
intro H29.
intro H30.
intro H31.
intro H32.
intro H33.
intro H34.
intro H35.
exact H0.

------------------- exact H20.
------------------- exact H.
------------------- exact H1.
------------------- exact H2.
------------------- exact H3.
------------------- exact H4.
------------------- exact H7.
------------------- exact H8.
------------------- exact H9.
------------------- exact H10.
------------------- exact H14.
------------------- exact H15.
------------------- exact H16.
------------------- exact H17.
------------------- exact H18.
------------------- exact H19.
------------------ assert (* Cut *) (euclidean__axioms.Col p C B) as H22.
------------------- assert (* Cut *) ((euclidean__axioms.Col C B p) /\ ((euclidean__axioms.Col C p B) /\ ((euclidean__axioms.Col p B C) /\ ((euclidean__axioms.Col B p C) /\ (euclidean__axioms.Col p C B))))) as H22.
-------------------- apply (@lemma__collinearorder.lemma__collinearorder B C p H14).
-------------------- destruct H22 as [H23 H24].
destruct H24 as [H25 H26].
destruct H26 as [H27 H28].
destruct H28 as [H29 H30].
exact H30.
------------------- assert (* Cut *) (euclidean__defs.Per p C A) as H23.
-------------------- apply (@eq__ind__r euclidean__axioms.Point M (fun C0 => (euclidean__defs.Per B A C0) -> ((euclidean__axioms.Col B C0 p) -> ((euclidean__axioms.Col B C0 M) -> ((euclidean__axioms.nCol B A C0) -> ((euclidean__axioms.neq C0 B) -> ((euclidean__axioms.Col C0 B p) -> ((euclidean__axioms.Col C0 B M) -> ((euclidean__axioms.nCol B A C0) -> ((euclidean__axioms.neq C0 B) -> ((euclidean__axioms.Col B C0 p) -> ((euclidean__axioms.Col B C0 M) -> ((euclidean__axioms.neq B C0) -> ((euclidean__axioms.Col C0 p M) -> ((euclidean__axioms.Col p M C0) -> ((euclidean__defs.Per C0 A B) -> ((euclidean__defs.Per A C0 p) -> ((euclidean__axioms.Col p C0 B) -> (euclidean__defs.Per p C0 A))))))))))))))))))) with (x := C).
---------------------intro H23.
intro H24.
intro H25.
intro H26.
intro H27.
intro H28.
intro H29.
intro H30.
intro H31.
intro H32.
intro H33.
intro H34.
intro H35.
intro H36.
intro H37.
intro H38.
intro H39.
exact H6.

--------------------- exact H20.
--------------------- exact H.
--------------------- exact H1.
--------------------- exact H2.
--------------------- exact H3.
--------------------- exact H4.
--------------------- exact H7.
--------------------- exact H8.
--------------------- exact H9.
--------------------- exact H10.
--------------------- exact H14.
--------------------- exact H15.
--------------------- exact H16.
--------------------- exact H17.
--------------------- exact H18.
--------------------- exact H19.
--------------------- exact H21.
--------------------- exact H22.
-------------------- assert (* Cut *) (euclidean__defs.Per B C A) as H24.
--------------------- apply (@eq__ind__r euclidean__axioms.Point M (fun C0 => (euclidean__defs.Per B A C0) -> ((euclidean__axioms.Col B C0 p) -> ((euclidean__axioms.Col B C0 M) -> ((euclidean__axioms.nCol B A C0) -> ((euclidean__axioms.neq C0 B) -> ((euclidean__axioms.Col C0 B p) -> ((euclidean__axioms.Col C0 B M) -> ((euclidean__axioms.nCol B A C0) -> ((euclidean__axioms.neq C0 B) -> ((euclidean__axioms.Col B C0 p) -> ((euclidean__axioms.Col B C0 M) -> ((euclidean__axioms.neq B C0) -> ((euclidean__axioms.Col C0 p M) -> ((euclidean__axioms.Col p M C0) -> ((euclidean__defs.Per C0 A B) -> ((euclidean__defs.Per A C0 p) -> ((euclidean__axioms.Col p C0 B) -> ((euclidean__defs.Per p C0 A) -> (euclidean__defs.Per B C0 A)))))))))))))))))))) with (x := C).
----------------------intro H24.
intro H25.
intro H26.
intro H27.
intro H28.
intro H29.
intro H30.
intro H31.
intro H32.
intro H33.
intro H34.
intro H35.
intro H36.
intro H37.
intro H38.
intro H39.
intro H40.
intro H41.
exact H13.

---------------------- exact H20.
---------------------- exact H.
---------------------- exact H1.
---------------------- exact H2.
---------------------- exact H3.
---------------------- exact H4.
---------------------- exact H7.
---------------------- exact H8.
---------------------- exact H9.
---------------------- exact H10.
---------------------- exact H14.
---------------------- exact H15.
---------------------- exact H16.
---------------------- exact H17.
---------------------- exact H18.
---------------------- exact H19.
---------------------- exact H21.
---------------------- exact H22.
---------------------- exact H23.
--------------------- assert (* Cut *) (~(euclidean__defs.Per B C A)) as H25.
---------------------- apply (@lemma__8__7.lemma__8__7 B A C H19).
---------------------- apply (@H25 H24).
----------------- assert (* Cut *) (euclidean__defs.Per C M A) as H21.
------------------ apply (@lemma__collinearright.lemma__collinearright p M C A H6 H18 H20).
------------------ assert (* Cut *) (euclidean__defs.Per A M B) as H22.
------------------- apply (@lemma__8__2.lemma__8__2 B M A H13).
------------------- assert (* Cut *) (euclidean__defs.Per A M C) as H23.
-------------------- apply (@lemma__8__2.lemma__8__2 C M A H21).
-------------------- assert (* Cut *) (euclidean__defs.Lt M B A B) as H24.
--------------------- assert (* Cut *) (forall A0 B0 C0, (euclidean__defs.Per A0 B0 C0) -> (euclidean__defs.Lt B0 C0 A0 C0)) as H24.
---------------------- intro A0.
intro B0.
intro C0.
intro __.
assert (* AndElim *) ((euclidean__defs.Lt A0 B0 A0 C0) /\ (euclidean__defs.Lt B0 C0 A0 C0)) as __0.
----------------------- apply (@lemma__legsmallerhypotenuse.lemma__legsmallerhypotenuse A0 B0 C0 __).
----------------------- destruct __0 as [__0 __1].
exact __1.
---------------------- apply (@H24 A M B H22).
--------------------- assert (* Cut *) (euclidean__defs.Lt B A B C) as H25.
---------------------- assert (* Cut *) (forall A0 B0 C0, (euclidean__defs.Per A0 B0 C0) -> (euclidean__defs.Lt A0 B0 A0 C0)) as H25.
----------------------- intro A0.
intro B0.
intro C0.
intro __.
assert (* AndElim *) ((euclidean__defs.Lt A0 B0 A0 C0) /\ (euclidean__defs.Lt B0 C0 A0 C0)) as __0.
------------------------ apply (@lemma__legsmallerhypotenuse.lemma__legsmallerhypotenuse A0 B0 C0 __).
------------------------ destruct __0 as [__0 __1].
exact __0.
----------------------- apply (@H25 B A C H).
---------------------- assert (* Cut *) (euclidean__axioms.Cong B A A B) as H26.
----------------------- apply (@euclidean__axioms.cn__equalityreverse B A).
----------------------- assert (* Cut *) (euclidean__defs.Lt A B B C) as H27.
------------------------ apply (@lemma__lessthancongruence2.lemma__lessthancongruence2 B A B C A B H25 H26).
------------------------ assert (* Cut *) (euclidean__defs.Lt M B B C) as H28.
------------------------- apply (@lemma__lessthantransitive.lemma__lessthantransitive M B A B B C H24 H27).
------------------------- assert (* Cut *) (euclidean__axioms.Cong M B B M) as H29.
-------------------------- apply (@euclidean__axioms.cn__equalityreverse M B).
-------------------------- assert (* Cut *) (euclidean__defs.Lt B M B C) as H30.
--------------------------- apply (@lemma__lessthancongruence2.lemma__lessthancongruence2 M B B C B M H28 H29).
--------------------------- assert (* Cut *) (euclidean__defs.Lt M C A C) as H31.
---------------------------- assert (* Cut *) (forall A0 B0 C0, (euclidean__defs.Per A0 B0 C0) -> (euclidean__defs.Lt B0 C0 A0 C0)) as H31.
----------------------------- intro A0.
intro B0.
intro C0.
intro __.
assert (* AndElim *) ((euclidean__defs.Lt A0 B0 A0 C0) /\ (euclidean__defs.Lt B0 C0 A0 C0)) as __0.
------------------------------ apply (@lemma__legsmallerhypotenuse.lemma__legsmallerhypotenuse A0 B0 C0 __).
------------------------------ destruct __0 as [__0 __1].
exact __1.
----------------------------- apply (@H31 A M C H23).
---------------------------- assert (* Cut *) (euclidean__axioms.Cong M C C M) as H32.
----------------------------- apply (@euclidean__axioms.cn__equalityreverse M C).
----------------------------- assert (* Cut *) (euclidean__defs.Lt C M A C) as H33.
------------------------------ apply (@lemma__lessthancongruence2.lemma__lessthancongruence2 M C A C C M H31 H32).
------------------------------ assert (* Cut *) (euclidean__defs.Lt A C B C) as H34.
------------------------------- assert (* Cut *) (forall A0 B0 C0, (euclidean__defs.Per A0 B0 C0) -> (euclidean__defs.Lt B0 C0 A0 C0)) as H34.
-------------------------------- intro A0.
intro B0.
intro C0.
intro __.
assert (* AndElim *) ((euclidean__defs.Lt A0 B0 A0 C0) /\ (euclidean__defs.Lt B0 C0 A0 C0)) as __0.
--------------------------------- apply (@lemma__legsmallerhypotenuse.lemma__legsmallerhypotenuse A0 B0 C0 __).
--------------------------------- destruct __0 as [__0 __1].
exact __1.
-------------------------------- apply (@H34 B A C H).
------------------------------- assert (* Cut *) (euclidean__defs.Lt C M B C) as H35.
-------------------------------- apply (@lemma__lessthantransitive.lemma__lessthantransitive C M A C B C H33 H34).
-------------------------------- assert (* Cut *) (~(euclidean__axioms.BetS M B C)) as H36.
--------------------------------- intro H36.
assert (* Cut *) (euclidean__axioms.BetS C B M) as H37.
---------------------------------- apply (@euclidean__axioms.axiom__betweennesssymmetry M B C H36).
---------------------------------- assert (* Cut *) (euclidean__axioms.Cong C B C B) as H38.
----------------------------------- apply (@euclidean__axioms.cn__congruencereflexive C B).
----------------------------------- assert (* Cut *) (euclidean__defs.Lt C B C M) as H39.
------------------------------------ exists B.
split.
------------------------------------- exact H37.
------------------------------------- exact H38.
------------------------------------ assert (* Cut *) (euclidean__axioms.Cong C B B C) as H40.
------------------------------------- apply (@euclidean__axioms.cn__equalityreverse C B).
------------------------------------- assert (* Cut *) (euclidean__defs.Lt B C C M) as H41.
-------------------------------------- apply (@lemma__lessthancongruence2.lemma__lessthancongruence2 C B C M B C H39 H40).
-------------------------------------- assert (* Cut *) (~(euclidean__defs.Lt C M B C)) as H42.
--------------------------------------- apply (@lemma__trichotomy2.lemma__trichotomy2 B C C M H41).
--------------------------------------- apply (@H42 H35).
--------------------------------- assert ((B = C) \/ ((B = M) \/ ((C = M) \/ ((euclidean__axioms.BetS C B M) \/ ((euclidean__axioms.BetS B C M) \/ (euclidean__axioms.BetS B M C)))))) as H37 by exact H15.
assert (* Cut *) (euclidean__defs.Out B C M) as H38.
---------------------------------- assert ((B = C) \/ ((B = M) \/ ((C = M) \/ ((euclidean__axioms.BetS C B M) \/ ((euclidean__axioms.BetS B C M) \/ (euclidean__axioms.BetS B M C)))))) as H38 by exact H37.
assert ((B = C) \/ ((B = M) \/ ((C = M) \/ ((euclidean__axioms.BetS C B M) \/ ((euclidean__axioms.BetS B C M) \/ (euclidean__axioms.BetS B M C)))))) as __TmpHyp by exact H38.
destruct __TmpHyp as [H39|H39].
----------------------------------- assert (* Cut *) (~(~(euclidean__defs.Out B C M))) as H40.
------------------------------------ intro H40.
apply (@H16 H39).
------------------------------------ apply (@euclidean__tactics.NNPP (euclidean__defs.Out B C M)).
-------------------------------------intro H41.
destruct H3 as [H42 H43].
destruct H9 as [H44 H45].
destruct H43 as [H46 H47].
destruct H45 as [H48 H49].
destruct H47 as [H50 H51].
destruct H49 as [H52 H53].
destruct H51 as [H54 H55].
destruct H53 as [H56 H57].
destruct H55 as [H58 H59].
destruct H57 as [H60 H61].
assert (* Cut *) (False) as H62.
-------------------------------------- apply (@H16 H39).
-------------------------------------- assert (* Cut *) (False) as H63.
--------------------------------------- apply (@H40 H41).
--------------------------------------- contradiction H63.

----------------------------------- destruct H39 as [H40|H40].
------------------------------------ assert (* Cut *) (~(~(euclidean__defs.Out B C M))) as H41.
------------------------------------- intro H41.
apply (@H5 H40).
------------------------------------- apply (@euclidean__tactics.NNPP (euclidean__defs.Out B C M)).
--------------------------------------intro H42.
destruct H3 as [H43 H44].
destruct H9 as [H45 H46].
destruct H44 as [H47 H48].
destruct H46 as [H49 H50].
destruct H48 as [H51 H52].
destruct H50 as [H53 H54].
destruct H52 as [H55 H56].
destruct H54 as [H57 H58].
destruct H56 as [H59 H60].
destruct H58 as [H61 H62].
assert (* Cut *) (False) as H63.
--------------------------------------- apply (@H5 H40).
--------------------------------------- assert (* Cut *) (False) as H64.
---------------------------------------- apply (@H41 H42).
---------------------------------------- contradiction H64.

------------------------------------ destruct H40 as [H41|H41].
------------------------------------- assert (* Cut *) (~(~(euclidean__defs.Out B C M))) as H42.
-------------------------------------- intro H42.
apply (@H20 H41).
-------------------------------------- apply (@euclidean__tactics.NNPP (euclidean__defs.Out B C M)).
---------------------------------------intro H43.
destruct H3 as [H44 H45].
destruct H9 as [H46 H47].
destruct H45 as [H48 H49].
destruct H47 as [H50 H51].
destruct H49 as [H52 H53].
destruct H51 as [H54 H55].
destruct H53 as [H56 H57].
destruct H55 as [H58 H59].
destruct H57 as [H60 H61].
destruct H59 as [H62 H63].
assert (* Cut *) (False) as H64.
---------------------------------------- apply (@H20 H41).
---------------------------------------- assert (* Cut *) (False) as H65.
----------------------------------------- apply (@H42 H43).
----------------------------------------- contradiction H65.

------------------------------------- destruct H41 as [H42|H42].
-------------------------------------- assert (* Cut *) (~(~(euclidean__defs.Out B C M))) as H43.
--------------------------------------- intro H43.
assert (* Cut *) (euclidean__axioms.BetS M B C) as H44.
---------------------------------------- apply (@euclidean__axioms.axiom__betweennesssymmetry C B M H42).
---------------------------------------- apply (@H36 H44).
--------------------------------------- apply (@euclidean__tactics.NNPP (euclidean__defs.Out B C M)).
----------------------------------------intro H44.
destruct H3 as [H45 H46].
destruct H9 as [H47 H48].
destruct H46 as [H49 H50].
destruct H48 as [H51 H52].
destruct H50 as [H53 H54].
destruct H52 as [H55 H56].
destruct H54 as [H57 H58].
destruct H56 as [H59 H60].
destruct H58 as [H61 H62].
destruct H60 as [H63 H64].
assert (* Cut *) (False) as H65.
----------------------------------------- apply (@H43 H44).
----------------------------------------- contradiction H65.

-------------------------------------- destruct H42 as [H43|H43].
--------------------------------------- assert (* Cut *) (euclidean__defs.Out B C M) as H44.
---------------------------------------- apply (@lemma__ray4.lemma__ray4 B C M).
-----------------------------------------right.
right.
exact H43.

----------------------------------------- exact H16.
---------------------------------------- exact H44.
--------------------------------------- assert (* Cut *) (euclidean__defs.Out B M C) as H44.
---------------------------------------- apply (@lemma__ray4.lemma__ray4 B M C).
-----------------------------------------right.
right.
exact H43.

----------------------------------------- exact H5.
---------------------------------------- assert (* Cut *) (euclidean__defs.Out B C M) as H45.
----------------------------------------- apply (@lemma__ray5.lemma__ray5 B M C H44).
----------------------------------------- exact H45.
---------------------------------- assert (* Cut *) (~(euclidean__axioms.BetS B C M)) as H39.
----------------------------------- intro H39.
assert (* Cut *) (euclidean__axioms.Cong B C B C) as H40.
------------------------------------ apply (@euclidean__axioms.cn__congruencereflexive B C).
------------------------------------ assert (* Cut *) (euclidean__defs.Lt B C B M) as H41.
------------------------------------- exists C.
split.
-------------------------------------- exact H39.
-------------------------------------- exact H40.
------------------------------------- assert (* Cut *) (~(euclidean__defs.Lt B M B C)) as H42.
-------------------------------------- apply (@lemma__trichotomy2.lemma__trichotomy2 B C B M H41).
-------------------------------------- apply (@H42 H30).
----------------------------------- assert (* Cut *) (euclidean__defs.Out C B M) as H40.
------------------------------------ assert ((B = C) \/ ((B = M) \/ ((C = M) \/ ((euclidean__axioms.BetS C B M) \/ ((euclidean__axioms.BetS B C M) \/ (euclidean__axioms.BetS B M C)))))) as H40 by exact H37.
assert ((B = C) \/ ((B = M) \/ ((C = M) \/ ((euclidean__axioms.BetS C B M) \/ ((euclidean__axioms.BetS B C M) \/ (euclidean__axioms.BetS B M C)))))) as __TmpHyp by exact H40.
destruct __TmpHyp as [H41|H41].
------------------------------------- assert (* Cut *) (~(~(euclidean__defs.Out C B M))) as H42.
-------------------------------------- intro H42.
apply (@H16 H41).
-------------------------------------- apply (@euclidean__tactics.NNPP (euclidean__defs.Out C B M)).
---------------------------------------intro H43.
destruct H3 as [H44 H45].
destruct H9 as [H46 H47].
destruct H45 as [H48 H49].
destruct H47 as [H50 H51].
destruct H49 as [H52 H53].
destruct H51 as [H54 H55].
destruct H53 as [H56 H57].
destruct H55 as [H58 H59].
destruct H57 as [H60 H61].
destruct H59 as [H62 H63].
assert (* Cut *) (False) as H64.
---------------------------------------- apply (@H16 H41).
---------------------------------------- assert (* Cut *) (False) as H65.
----------------------------------------- apply (@H42 H43).
----------------------------------------- contradiction H65.

------------------------------------- destruct H41 as [H42|H42].
-------------------------------------- assert (* Cut *) (~(~(euclidean__defs.Out C B M))) as H43.
--------------------------------------- intro H43.
apply (@H5 H42).
--------------------------------------- apply (@euclidean__tactics.NNPP (euclidean__defs.Out C B M)).
----------------------------------------intro H44.
destruct H3 as [H45 H46].
destruct H9 as [H47 H48].
destruct H46 as [H49 H50].
destruct H48 as [H51 H52].
destruct H50 as [H53 H54].
destruct H52 as [H55 H56].
destruct H54 as [H57 H58].
destruct H56 as [H59 H60].
destruct H58 as [H61 H62].
destruct H60 as [H63 H64].
assert (* Cut *) (False) as H65.
----------------------------------------- apply (@H5 H42).
----------------------------------------- assert (* Cut *) (False) as H66.
------------------------------------------ apply (@H43 H44).
------------------------------------------ contradiction H66.

-------------------------------------- destruct H42 as [H43|H43].
--------------------------------------- assert (* Cut *) (~(~(euclidean__defs.Out C B M))) as H44.
---------------------------------------- intro H44.
apply (@H20 H43).
---------------------------------------- apply (@euclidean__tactics.NNPP (euclidean__defs.Out C B M)).
-----------------------------------------intro H45.
destruct H3 as [H46 H47].
destruct H9 as [H48 H49].
destruct H47 as [H50 H51].
destruct H49 as [H52 H53].
destruct H51 as [H54 H55].
destruct H53 as [H56 H57].
destruct H55 as [H58 H59].
destruct H57 as [H60 H61].
destruct H59 as [H62 H63].
destruct H61 as [H64 H65].
assert (* Cut *) (False) as H66.
------------------------------------------ apply (@H20 H43).
------------------------------------------ assert (* Cut *) (False) as H67.
------------------------------------------- apply (@H44 H45).
------------------------------------------- contradiction H67.

--------------------------------------- destruct H43 as [H44|H44].
---------------------------------------- assert (* Cut *) (euclidean__defs.Out C B M) as H45.
----------------------------------------- apply (@lemma__ray4.lemma__ray4 C B M).
------------------------------------------right.
right.
exact H44.

------------------------------------------ exact H10.
----------------------------------------- exact H45.
---------------------------------------- destruct H44 as [H45|H45].
----------------------------------------- assert (* Cut *) (~(~(euclidean__defs.Out C B M))) as H46.
------------------------------------------ intro H46.
apply (@H39 H45).
------------------------------------------ apply (@euclidean__tactics.NNPP (euclidean__defs.Out C B M)).
-------------------------------------------intro H47.
destruct H3 as [H48 H49].
destruct H9 as [H50 H51].
destruct H49 as [H52 H53].
destruct H51 as [H54 H55].
destruct H53 as [H56 H57].
destruct H55 as [H58 H59].
destruct H57 as [H60 H61].
destruct H59 as [H62 H63].
destruct H61 as [H64 H65].
destruct H63 as [H66 H67].
assert (* Cut *) (False) as H68.
-------------------------------------------- apply (@H39 H45).
-------------------------------------------- assert (* Cut *) (False) as H69.
--------------------------------------------- apply (@H46 H47).
--------------------------------------------- contradiction H69.

----------------------------------------- assert (* Cut *) (euclidean__axioms.BetS C M B) as H46.
------------------------------------------ apply (@euclidean__axioms.axiom__betweennesssymmetry B M C H45).
------------------------------------------ assert (* Cut *) (euclidean__defs.Out C M B) as H47.
------------------------------------------- apply (@lemma__ray4.lemma__ray4 C M B).
--------------------------------------------right.
right.
exact H46.

-------------------------------------------- exact H20.
------------------------------------------- assert (* Cut *) (euclidean__defs.Out C B M) as H48.
-------------------------------------------- apply (@lemma__ray5.lemma__ray5 C M B H47).
-------------------------------------------- exact H48.
------------------------------------ assert (* Cut *) (euclidean__axioms.BetS B M C) as H41.
------------------------------------- apply (@lemma__tworays.lemma__tworays B C M H38 H40).
------------------------------------- exact H41.
Qed.