From Test Require Import tactic.

Section FOFProblem.

Variable Universe : Set.
Variable UniverseElement : Universe.

Variable wd_ : Universe -> Universe -> Prop.
Variable col_ : Universe -> Universe -> Universe -> Prop.

Variable col_swap1_1 : (forall A B C : Universe, (col_ A B C -> col_ B A C)).
Variable col_swap2_2 : (forall A B C : Universe, (col_ A B C -> col_ B C A)).
Variable col_triv_3 : (forall A B : Universe, col_ A B B).
Variable wd_swap_4 : (forall A B : Universe, (wd_ A B -> wd_ B A)).
Variable col_trans_5 : (forall P Q A B C : Universe, ((wd_ P Q /\ (col_ P Q A /\ (col_ P Q B /\ col_ P Q C))) -> col_ A B C)).

Theorem pipo_6 : (forall A B X Y C I : Universe, ((wd_ X Y /\ (wd_ A B /\ (wd_ A C /\ (wd_ B C /\ (col_ A C B /\ col_ A I C))))) -> col_ A I B)).
Proof.
  time tac.
Qed.

End FOFProblem.


(** * LogRel.Normalisation: well-typed terms always reduce to a normal form. *)
From Coq Require Import CRelationClasses.
From LogRel.AutoSubst Require Import core unscoped Ast Extra.
From LogRel Require Import Utils BasicAst Notations Context NormalForms Weakening UntypedReduction
  GenericTyping DeclarativeTyping DeclarativeInstance AlgorithmicTyping.
From LogRel Require Import LogicalRelation UntypedValues Validity Fundamental.
From LogRel.LogicalRelation Require Import Escape Neutral Induction ShapeView.
From LogRel.Substitution Require Import Escape.

Section Normalisation.
  Context `{GenericTypingProperties}.

  Theorem typing_nf : WfDeclInductionConcl
    (fun _ => True)
    (fun Γ A => Nf[Γ |- A])
    (fun Γ A t => Nf[Γ |- t : A])
    (fun Γ A B => Nf[Γ |- A] × Nf[Γ |- B])
    (fun Γ A t u => Nf[Γ |- t : A] × Nf[Γ |- u : A]).
  Proof.
    red.
    prod_splitter.
    all: intros * []%Fundamental.
    - easy.
    - now eapply reifyType, reducibleTy.
    - now eapply reifyTerm, reducibleTm.
    - split.
      all: now eapply reifyType, reducibleTy.
    - split.
      all: now eapply reifyTerm, reducibleTm.
  Qed.

End Normalisation.

Import DeclarativeTypingProperties.

Record cored t t' : Prop := { _ : [t' ⇒ t] }.

Theorem typing_SN Γ t :
  well_typed Γ t ->
  Acc cored t.
Proof.
  intros [? Hty].
  eapply typing_nf in Hty as [? [red wh]].
  induction red.
  - econstructor.
    intros t' [red].
    exfalso.
    now eapply whnf_nored.
  - econstructor.
    intros t'' [red'].
    now eapply ored_det in red' as <-.
Qed.

Section NeutralConversion.
  Import AlgorithmicTypingData.

  Lemma ne_conv_conv : forall (Γ : context) (A m n : term),
    [Γ |-[de] A] ->
    [Γ |-[al] m ~ n ▹ A] ->
    [Γ |-[al] m ≅ n : A].
  Proof.
    intros * Hty.
    pose proof (Hty' := Hty).
    eapply Fundamental in Hty' as [? Hfund%reducibleTy].
    revert m n.
    pose (P := (fun Γ A _ _ _ _ =>
      forall m n, [Γ |-[ al ] m ~ n ▹ A] -> [Γ |-[ al ] m ≅ n : A]) :
      forall Γ A rEq rTe rTeEq, LR (LogRelRec one) Γ A rEq rTe rTeEq  -> Type).
    change (P Γ A Hfund.(LRPack.eqTy) Hfund.(LRPack.redTm) Hfund.(LRPack.eqTm) Hfund.(LRAd.adequate)).
    apply LR_rect.
    all: subst P ; cbn.
    - intros.
      econstructor.
      1: eapply redty_red; now destruct h as [??? [??]].
      1-2: reflexivity.
      econstructor.
      2: now constructor.
      eassumption.
    - intros * [] ?.
      econstructor.
      1: gen_typing.
      1-2: reflexivity.
      econstructor.
      1: eassumption.
      econstructor; eapply (ty_ne_whne ne).
    - intros ? ? ΠAd ΠAad IHdom IHcod m n Hconv ; cbn in *.
      rewrite <- (PiRedTyPack.pack_beta ΠAd ΠAad) in *.
      remember (PiRedTyPack.pack ΠAd ΠAad) as ΠA in *.
      clear ΠAd ΠAad HeqΠA.
      destruct ΠA ; cbn in *.
      econstructor.
      1: gen_typing.
      1-2: reflexivity.
      econstructor.
      1-2: econstructor ; now eapply algo_conv_wh in Hconv.
      eapply convtm_meta_conv.
      3: reflexivity.
      1: unshelve eapply IHcod.
      + exact (tRel var_zero).
      + apply wk1.
      + gen_typing.
      + eapply neuTerm.
        1: econstructor; reflexivity.
        2: constructor.
        all: eapply typing_meta_conv.
        1,3: now do 2 econstructor ; tea ; boundary.
        all: now bsimpl.
      + eapply convne_meta_conv.
        3: reflexivity.
        1: econstructor.
        * replace (tProd _ _) with ((tProd dom cod)⟨↑⟩) by
            (cbn ; reflexivity).
          eapply algo_conv_shift.
          econstructor ; tea.
          1: now gen_typing.
          econstructor.
        * eapply convtm_meta_conv.
          1: unshelve eapply IHdom.
          -- now eapply wk1.
          -- gen_typing.
          -- eapply convne_meta_conv.
             1: do 2 econstructor.
             2: reflexivity.
             now bsimpl.
          -- now bsimpl.
          -- reflexivity.
        * now bsimpl.
      + bsimpl.
        rewrite scons_eta'.
        now bsimpl.
  - intros Δ B NB **; destruct NB.
    econstructor.
    + now eapply redtywf_red.
    + reflexivity.
    + reflexivity.
    + econstructor; [eassumption|constructor].
  - intros Δ B NB **; destruct NB.
    econstructor.
    + now eapply redtywf_red.
    + reflexivity.
    + reflexivity.
    + econstructor; [eassumption|constructor].
Qed.

End NeutralConversion.


Require Export prosa.analysis.definitions.task_schedule.
Require Export prosa.analysis.facts.model.rbf.
Require Export prosa.analysis.facts.model.task_arrivals.
Require Export prosa.analysis.facts.model.sequential.
Require Export prosa.analysis.abstract.abstract_rta.

(** * Abstract Response-Time Analysis with sequential tasks *)
(** In this section we propose the general framework for response-time analysis (RTA)
    of uni-processor scheduling of real-time tasks with arbitrary arrival models
    and sequential tasks. *)

  (** We prove that the maximum among the solutions of the response-time bound
     recurrence for some set of parameters is a response-time bound for [tsk].
     Note that in this section we _do_ rely on the hypothesis about task
     sequentiality. This allows us to provide a more precise response-time
     bound function, since jobs of the same task will be executed strictly
     in the order they arrive. *)
Section Sequential_Abstract_RTA.

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

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

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

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

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

  (** Assume that the job costs are no larger than the task costs. *)
  Hypothesis H_valid_job_cost:
    arrivals_have_valid_job_costs arr_seq.

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

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

  (** Consider a valid preemption model... *)
  Hypothesis H_valid_preemption_model:
    valid_preemption_model arr_seq sched.

  (** ...and a valid task run-to-completion threshold function. That is,
     [task_run_to_completion_threshold tsk] is (1) no bigger than [tsk]'s
     cost, (2) for any job of task [tsk] [job_run_to_completion_threshold]
     is bounded by [task_run_to_completion_threshold]. *)
  Hypothesis H_valid_run_to_completion_threshold:
    valid_task_run_to_completion_threshold arr_seq tsk.

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

  (** Assume we are provided with abstract functions for interference and interfering workload. *)
  Variable interference : Job -> instant -> bool.
  Variable interfering_workload : Job -> instant -> duration.

  (** Let's define some local names for clarity. *)
  Let task_rbf := task_request_bound_function tsk.
  Let busy_interval := busy_interval sched interference interfering_workload.
  Let arrivals_between := arrivals_between arr_seq.
  Let service_of_jobs_at := service_of_jobs_at sched.
  Let task_workload_between := task_workload_between arr_seq tsk.
  Let task_service_of_jobs_in := task_service_of_jobs_in sched tsk.
  Let response_time_bounded_by := task_response_time_bound arr_seq sched.

  (** In this section, we introduce a few new definitions to make it easier
     to express the new bound of the worst-case execution time. *)
  Section Definitions.

    (** When assuming sequential tasks, we can introduce an additional hypothesis that
       ensures that the values of interference and workload remain consistent. It states
       that any of [tsk]'s job, that arrived before the busy interval, should be
       completed by the beginning of the busy interval. *)
    Definition interference_and_workload_consistent_with_sequential_tasks :=
      forall (j : Job) (t1 t2 : instant),
          arrives_in arr_seq j ->
          job_task j = tsk ->
          job_cost j > 0 ->
          busy_interval j t1 t2 ->
          task_workload_between 0 t1 = task_service_of_jobs_in (arrivals_between 0 t1) 0 t1.

    (** Next we introduce the notion of task interference. Intuitively, task [tsk] incurs
       interference when some of the jobs of task [tsk] incur interference. As a result,
       [tsk] cannot make any progress. More formally, task [tsk] experiences interference at
       a time instant time [t], if at time t task [tsk] is not scheduled and there exists
       a job of [tsk] that (1) experiences interference and (2) has arrived before some
       time instant [upper_bound].

       It is important to note two subtle points: according to our semantics of the
       interference function, jobs from the same task can cause interference to each other.
       In the definition of interference of a task we want to avoid such situations. That
       is why we use the term [~~ task_scheduled_at tsk t].

       Moreover, in order to make the definition constructive, we introduce an upper bound
       on the arrival time of jobs from task [tsk]. As a result, we need to consider only a
       finite number of jobs. For the function to produce the correct values it is enough
       to specify a sufficiently large upper_bound. Usually as upper_bound one can use the
       end of the corresponding busy interval. *)
    Definition task_interference_received_before (tsk : Task) (upper_bound : instant) (t : instant) :=
      (~~ task_scheduled_at sched tsk t)
        && has (fun j => interference j t) (task_arrivals_before arr_seq tsk upper_bound).

    (** Next we define the cumulative task interference. *)
    Definition cumul_task_interference tsk upper_bound t1 t2 :=
      \sum_(t1 <= t < t2) task_interference_received_before tsk upper_bound t.

    (** We say that task interference is bounded by task_interference_bound_function ([tIBF])
       iff for any job [j] of task [tsk] cumulative _task_ interference within the interval
       [t1, t1 + R) is bounded by function [tIBF(tsk, A, R)].
       Note that this definition is almost the same as the definition of job_interference_is_bounded_by
       from the non-necessary-sequential case. However, in this case we ignore the
       interference that comes from jobs from the same task. *)
    Definition task_interference_is_bounded_by
               (task_interference_bound_function : Task -> duration -> duration -> duration) :=
      forall j R t1 t2,
        arrives_in arr_seq j ->
        job_task j = tsk ->
        t1 + R < t2 ->
        ~~ completed_by sched j (t1 + R) ->
        busy_interval j t1 t2 ->
        let offset := job_arrival j - t1 in
        cumul_task_interference tsk t2 t1 (t1 + R) <= task_interference_bound_function tsk offset R.

  End Definitions.

  (** In this section, we prove that the maximum among the solutions of the
     response-time bound recurrence is a response-time bound for [tsk]. *)
  Section ResponseTimeBound.

    (** For simplicity, let's define some local names. *)
    Let cumul_interference := cumul_interference interference.
    Let cumul_workload := cumul_interfering_workload interfering_workload.
    Let cumul_task_interference := cumul_task_interference tsk.

    (** We assume that the schedule is work-conserving. *)
    Hypothesis H_work_conserving:
      work_conserving arr_seq sched tsk interference interfering_workload.

    (** Unlike the previous theorem [uniprocessor_response_time_bound], we assume
       that (1) tasks are sequential, moreover (2) functions interference and
       interfering_workload are consistent with the hypothesis of sequential tasks. *)
    Hypothesis H_sequential_tasks : sequential_tasks sched.
    Hypothesis H_interference_and_workload_consistent_with_sequential_tasks:
      interference_and_workload_consistent_with_sequential_tasks.

    (** Assume we have a constant L which bounds the busy interval of any of [tsk]'s jobs. *)
    Variable L : duration.
    Hypothesis H_busy_interval_exists:
      busy_intervals_are_bounded_by arr_seq sched tsk interference interfering_workload L.

    (** Next, we assume that task_interference_bound_function is a bound on interference incurred by the task. *)
    Variable task_interference_bound_function : Task -> duration -> duration -> duration.
    Hypothesis H_task_interference_is_bounded:
      task_interference_is_bounded_by task_interference_bound_function.

    (** Given any job [j] of task [tsk] that arrives exactly [A] units after the beginning of the busy
       interval, the bound on the total interference incurred by [j] within an interval of length [Δ]
       is no greater than [task_rbf (A + ε) - task_cost tsk + task's IBF Δ]. Note that in case of
       sequential tasks the bound consists of two parts: (1) the part that bounds the interference
       received from other jobs of task [tsk] -- [task_rbf (A + ε) - task_cost tsk] and (2) any other
       interference that is bounded by [task_IBF(tsk, A, Δ)]. *)
    Let total_interference_bound (tsk : Task) (A Δ : duration) :=
      task_rbf (A + ε) - task_cost tsk + task_interference_bound_function tsk A Δ.

    (** Note that since we consider the modified interference bound function, the search space has
       also changed. One can see that the new search space is guaranteed to include any A for which
       [task_rbf (A) ≠ task_rbf (A + ε)], since this implies the fact that
       [total_interference_bound (tsk, A, Δ) ≠ total_interference_bound (tsk, A + ε, Δ)]. *)
    Let is_in_search_space_seq := is_in_search_space tsk L total_interference_bound.

    (** Consider any value [R], and assume that for any relative arrival time [A] from the search
       space there is a solution [F] of the response-time recurrence that is bounded by [R]. In
       contrast to the formula in "non-sequential" Abstract RTA, assuming that tasks are
       sequential leads to a more precise response-time bound. Now we can explicitly express
       the interference caused by other jobs of the task under consideration.

       To understand the right part of the fix-point in the equation it is helpful to note
       that the bound on the total interference ([bound_of_total_interference]) is equal to
       [task_rbf (A + ε) - task_cost tsk + tIBF tsk A Δ]. Besides, a job must receive
       enough service to become non-preemptive [task_lock_in_service tsk]. The sum of
       these two quantities is exactly the right-hand side of the equation. *)
    Variable R : nat.
    Hypothesis H_R_is_maximum_seq:
      forall (A : duration),
        is_in_search_space_seq A ->
        exists (F : duration),
          A + F = (task_rbf (A + ε) - (task_cost tsk - task_run_to_completion_threshold tsk))
                  + task_interference_bound_function tsk A (A + F) /\
          F + (task_cost tsk - task_run_to_completion_threshold tsk) <= R.

    (** In this section we prove a few simple lemmas about the completion of jobs from the task
       considering the busy interval of the job under consideration. *)
    Section CompletionOfJobsFromSameTask.

      (** Consider any two jobs [j1] [j2] of [tsk]. *)
      Variable j1 j2 : Job.
      Hypothesis H_j1_arrives: arrives_in arr_seq j1.
      Hypothesis H_j2_arrives: arrives_in arr_seq j2.
      Hypothesis H_j1_from_tsk: job_task j1 = tsk.
      Hypothesis H_j2_from_tsk: job_task j2 = tsk.
      Hypothesis H_j1_cost_positive: job_cost_positive j1.

      (** Consider the busy interval <<[t1, t2)>> of job j1. *)
      Variable t1 t2 : instant.
      Hypothesis H_busy_interval : busy_interval j1 t1 t2.

      (** We prove that if a job from task [tsk] arrived before the beginning of the busy
         interval, then it must be completed before the beginning of the busy interval *)
      Lemma completed_before_beginning_of_busy_interval:
        job_arrival j2 < t1 ->
        completed_by sched j2 t1.
      Proof.
        move => JA; move: (H_j2_from_tsk) => /eqP TSK2eq.
        move: (posnP (@job_cost _ H3 j2)) => [ZERO|POS].
        { by rewrite /completed_by /service.completed_by ZERO. }
        move: (H_interference_and_workload_consistent_with_sequential_tasks
                 j1 t1 t2 H_j1_arrives H_j1_from_tsk H_j1_cost_positive H_busy_interval) => SWEQ.
        eapply all_jobs_have_completed_equiv_workload_eq_service
          with (j := j2) in SWEQ; eauto 2; try done.
          by apply arrived_between_implies_in_arrivals.
      Qed.

      (** Next we prove that if a job is pending after the beginning
         of the busy interval <<[t1, t2)>> then it arrives after t1. *)
      Lemma arrives_after_beginning_of_busy_interval:
        forall t,
          t1 <= t ->
          pending sched j2 t ->
          arrived_between j2 t1 t.+1.
      Proof.
        intros t GE PEND.
        rewrite /arrived_between; apply/andP; split; last first.
        { by move: PEND => /andP [ARR _]; rewrite ltnS. }
        rewrite leqNgt; apply/negP; intros LT.
        move: (H_busy_interval) => [[/andP [AFR1 AFR2] [QT _]] _].
        have L12 := completed_before_beginning_of_busy_interval LT.
        apply completion_monotonic with (t' := t) in L12; try done.
          by move: PEND => /andP [_ /negP T2].
      Qed.

    End CompletionOfJobsFromSameTask.

    (** Since we are going to use the [uniprocessor_response_time_bound] theorem to prove
       the theorem of this section, we have to show that all the hypotheses are satisfied.
       Namely, we need to show that hypotheses [H_sequential_tasks, H_i_w_are_task_consistent
       and H_task_interference_is_bounded_by] imply [H_job_interference_is_bounded], and the
       fact that [H_R_is_maximum_seq] implies [H_R_is_maximum]. *)

    (** In this section we show that there exists a bound for cumulative interference for any
       job of task [tsk], i.e., the hypothesis [H_job_interference_is_bounded] holds. *)
    Section BoundOfCumulativeJobInterference.

      (** Consider any job [j] of [tsk]. *)
      Variable j : Job.
      Hypothesis H_j_arrives : arrives_in arr_seq j.
      Hypothesis H_job_of_tsk : job_task j = tsk.
      Hypothesis H_job_cost_positive : job_cost_positive j.

      (** Consider the busy interval <<[t1, t2)>> of job j. *)
      Variable t1 t2 : instant.
      Hypothesis H_busy_interval : busy_interval j t1 t2.

      (** Let's define A as a relative arrival time of job j (with respect to time t1). *)
      Let A : duration := job_arrival j - t1.

      (** Consider an arbitrary time x ... *)
      Variable x : duration.
      (** ... such that (t1 + x) is inside the busy interval... *)
      Hypothesis H_inside_busy_interval : t1 + x < t2.
      (** ... and job j is not completed by time (t1 + x). *)
      Hypothesis H_job_j_is_not_completed : ~~ completed_by sched j (t1 + x).

      (** In this section, we show that the cumulative interference of job j in the interval <<[t1, t1 + x)>>
         is bounded by the sum of the task workload in the interval [t1, t1 + A + ε) and the cumulative
         interference of [j]'s task in the interval [t1, t1 + x). Note that the task workload is computed
         only on the interval [t1, t1 + A + ε). Thanks to the hypothesis about sequential tasks, jobs of
         task [tsk] that arrive after [t1 + A + ε] cannot interfere with j. *)
      Section TaskInterferenceBoundsInterference.

        (** We start by proving a simpler analog of the lemma which states that at
           any time instant t ∈ <<[t1, t1 + x)>> the sum of [interference j t] and
           [scheduled_at j t] is no larger than the sum of [the service received
           by jobs of task tsk at time t] and [task_iterference tsk t]. *)

        (** Next we consider 4 cases. *)
        Section CaseAnalysis.

          (** Consider an arbitrary time instant t ∈ <<[t1, t1 + x)>>. *)
          Variable t : instant.
          Hypothesis H_t_in_interval : t1 <= t < t1 + x.

          Section Case1.

            (** Assume the processor is idle at time [t]. *)
            Hypothesis H_idle : sched t = None.

            (** In case when the processor is idle, one can show that
               [interference j t = 1, scheduled_at j t = 0]. But since
               interference doesn't come from a job of task [tsk]
               [task_interference tsk = 1]. Which reduces to [1 ≤ 1]. *)
            Lemma interference_plus_sched_le_serv_of_task_plus_task_interference_idle:
              interference j t + scheduled_at sched j t <=
              service_of_jobs_at (job_of_task tsk) (arrivals_between t1 (t1 + A + ε)) t +
              task_interference_received_before tsk t2 t.
            Proof.
              move: (H_busy_interval) => [[/andP [BUS LT] _] _].
              rewrite /cumul_task_interference /definitions.cumul_interference
                      /Sequential_Abstract_RTA.cumul_task_interference /task_interference_received_before
                      /task_scheduled_at /task_schedule.task_scheduled_at /service_of_jobs_at
                      /service_of_jobs.service_of_jobs_at/= scheduled_at_def.
              rewrite !H_idle/=.
              rewrite big1_eq addn0 add0n.
              case INT: (interference j t); last by done.
              simpl; rewrite lt0b.
              apply/hasP; exists j; last by done.
                by rewrite mem_filter; apply/andP; split;
                  [rewrite H_job_of_tsk | eapply arrived_between_implies_in_arrivals; eassumption].
            Qed.

          End Case1.

          Section Case2.

            (** Assume a job [j'] from another task is scheduled at time [t]. *)
            Variable j' : Job.
            Hypothesis H_sched :  sched t = Some j'.
            Hypothesis H_not_job_of_tsk : job_task j' != tsk.

            (** If a job [j]' from another task is scheduled at time [t],
               then [interference j t = 1, scheduled_at j t = 0]. But
               since interference doesn't come from a job of task [tsk]
               [task_interference tsk = 1]. Which reduces to [1 ≤ 1]. *)
            Lemma interference_plus_sched_le_serv_of_task_plus_task_interference_task:
              interference j t + scheduled_at sched j t <=
              service_of_jobs_at (job_of_task tsk) (arrivals_between t1 (t1 + A + ε)) t +
              task_interference_received_before tsk t2 t.
            Proof.
              move: (H_busy_interval) => [[/andP [BUS LT] _] _].
              rewrite /cumul_task_interference /definitions.cumul_interference
                      /Sequential_Abstract_RTA.cumul_task_interference /task_interference_received_before
                      /task_scheduled_at /task_schedule.task_scheduled_at /service_of_jobs_at
                      /service_of_jobs.service_of_jobs_at scheduled_at_def/=.
              have ARRs: arrives_in arr_seq j'; first by apply H_jobs_come_from_arrival_sequence with t; rewrite scheduled_at_def; apply/eqP.
              rewrite H_sched H_not_job_of_tsk; simpl.
              rewrite (negbTE (option_inj_neq (neqprop_to_neqbool
                                                 (diseq (fun j => job_task j = tsk) _ _
                                                        (neqbool_to_neqprop H_not_job_of_tsk) H_job_of_tsk)))) addn0.
              have ZERO: \sum_(i <- arrivals_between t1 (t1 + A + ε) | job_task i == tsk) (Some j' == Some i) = 0.
              { apply big1; move => j2 /eqP TSK2; apply/eqP; rewrite eqb0.
                apply option_inj_neq, neqprop_to_neqbool, (diseq (fun j => job_task j = tsk) _ _
                                                                 (neqbool_to_neqprop H_not_job_of_tsk) TSK2).
              } rewrite ZERO ?addn0 add0n; simpl; clear ZERO.
              case INT: (interference j t); last by done.
              simpl; rewrite lt0b.
              apply/hasP; exists j; last by done.
                by rewrite  mem_filter; apply/andP; split;
                  [rewrite H_job_of_tsk | eapply arrived_between_implies_in_arrivals; eassumption].
            Qed.

          End Case2.

          Section Case3.

            (** Assume a job [j'] (different from j) of task [tsk] is scheduled at time [t]. *)
            Variable j' : Job.
            Hypothesis H_sched :  sched t = Some j'.
            Hypothesis H_not_job_of_tsk : job_task j' == tsk.
            Hypothesis H_j_neq_j' : j != j'.

            (** If a job [j'] (different from [j]) of task [tsk] is scheduled at time [t], then
               [interference j t = 1, scheduled_at j t = 0]. Moreover, since interference
               comes from a job of the same task [task_interference tsk = 0]. However,
               in this case [service_of_jobs of tsk = 1]. Which reduces to [1 ≤ 1]. *)
            Lemma interference_plus_sched_le_serv_of_task_plus_task_interference_job:
              interference j t + scheduled_at sched j t <=
              service_of_jobs_at (job_of_task tsk) (arrivals_between t1 (t1 + A + ε)) t +
              task_interference_received_before tsk t2 t.
            Proof.
              move: (H_busy_interval) => [[/andP [BUS LT] _] _].
              rewrite /cumul_task_interference /definitions.cumul_interference
                      /Sequential_Abstract_RTA.cumul_task_interference /task_interference_received_before
                      /task_scheduled_at /task_schedule.task_scheduled_at /service_of_jobs_at
                      /service_of_jobs.service_of_jobs_at scheduled_at_def/=.
              have ARRs: arrives_in arr_seq j'; first by apply H_jobs_come_from_arrival_sequence with t; rewrite scheduled_at_def; apply/eqP.
              rewrite H_sched H_not_job_of_tsk addn0; simpl;
                rewrite [Some j' == Some j](negbTE (option_inj_neq (neq_sym H_j_neq_j'))) addn0.
              replace (interference j t) with true; last first.
              { have NEQT: t1 <= t < t2.
                { by move: H_t_in_interval => /andP [NEQ1 NEQ2]; apply/andP; split; last apply ltn_trans with (t1 + x). }
                move: (H_work_conserving j t1 t2 t H_j_arrives H_job_of_tsk H_job_cost_positive H_busy_interval NEQT) => [Hn _].
                apply/eqP;rewrite eq_sym eqb_id; apply/negPn/negP; intros CONTR; move: CONTR => /negP CONTR.
                apply Hn in CONTR; rewrite scheduled_at_def in CONTR; simpl in CONTR.
                  by rewrite H_sched [Some j' == Some j](negbTE (option_inj_neq (neq_sym H_j_neq_j'))) in CONTR.
              }
              rewrite big_mkcond; apply/sum_seq_gt0P; exists j'; split; last first.
              { by move: H_not_job_of_tsk => /eqP TSK; rewrite /job_of_task TSK eq_refl eq_refl. }
              { intros. have ARR:= arrives_after_beginning_of_busy_interval j j' _ _ _ _ _ t1 t2 _ t.
                feed_n 8 ARR; try (done || by move: H_t_in_interval => /andP [T1 T2]).
                { by move: H_not_job_of_tsk => /eqP TSK; rewrite TSK. }
                { move: H_sched => /eqP SCHEDt.
                  apply scheduled_implies_pending;
                  auto using ideal_proc_model_ensures_ideal_progress.
                  by rewrite scheduled_at_def. }
                case_eq (job_arrival j' <= job_arrival j) => ARRNEQ.
                { move: ARR => /andP [РР _].
                  eapply arrived_between_implies_in_arrivals; eauto 2.
                    by apply/andP; split; last rewrite /A subnKC // addn1 ltnS. }
                { exfalso.
                  apply negbT in ARRNEQ; rewrite -ltnNge in ARRNEQ.
                  move: (H_sequential_tasks j j' t) => CONTR.
                  feed_n 3 CONTR; try done.
                  { by rewrite /same_task eq_sym H_job_of_tsk. }
                  { by move: H_sched => /eqP SCHEDt; rewrite scheduled_at_def. }
                  move: H_job_j_is_not_completed => /negP T; apply: T.
                  apply completion_monotonic with t; try done.
                    by apply ltnW; move: H_t_in_interval => /andP [_ NEQ]. }
              }
            Qed.

          End Case3.

          Section Case4.

            (** Assume that job [j] is scheduled at time [t]. *)
            Hypothesis H_sched : sched t = Some j.

            (** If job [j] is scheduled at time [t], then [interference = 0, scheduled_at = 1], but
             note that [service_of_jobs of tsk = 1], therefore inequality reduces to [1 ≤ 1]. *)
            Lemma interference_plus_sched_le_serv_of_task_plus_task_interference_j:
              interference j t + scheduled_at sched j t <=
              service_of_jobs_at (job_of_task tsk) (arrivals_between t1 (t1 + A + ε)) t +
              task_interference_received_before tsk t2 t.
            Proof.
              have j_is_in_arrivals_between: j \in arrivals_between t1 (t1 + A + ε).
              { eapply arrived_between_implies_in_arrivals; eauto 2.
                move: (H_busy_interval) => [[/andP [GE _] [_ _]] _].
                  by apply/andP; split; last rewrite /A subnKC // addn1.
              } intros.
              rewrite /cumul_task_interference /definitions.cumul_interference
                      /Sequential_Abstract_RTA.cumul_task_interference /task_interference_received_before
                      /task_scheduled_at /task_schedule.task_scheduled_at /service_of_jobs_at
                      /service_of_jobs.service_of_jobs_at scheduled_at_def.
              rewrite H_sched H_job_of_tsk neq_antirefl addn0; simpl.
              move: (H_work_conserving j _ _ t H_j_arrives H_job_of_tsk H_job_cost_positive H_busy_interval) => WORK.
              feed WORK.
              { move: H_t_in_interval => /andP [NEQ1 NEQ2].
                  by apply/andP; split; last apply ltn_trans with (t1 + x). }
              move: WORK => [_ ZIJT].
              feed ZIJT; first by rewrite scheduled_at_def H_sched; simpl.
              move: ZIJT => /negP /eqP; rewrite eqb_negLR; simpl; move => /eqP ZIJT; rewrite ZIJT; simpl; rewrite add0n.
              rewrite !eq_refl; simpl; rewrite big_mkcond //=; apply/sum_seq_gt0P.
                by exists j; split; [apply j_is_in_arrivals_between | rewrite /job_of_task H_job_of_tsk H_sched !eq_refl].
            Qed.

          End Case4.

          (** We use the above case analysis to prove that any time instant
             t ∈ <<[t1, t1 + x)>> the sum of [interference j t] and [scheduled_at j t]
             is no larger than the sum of [the service received by jobs of task
             tsk at time t] and [task_iterference tsk t]. *)
          Lemma interference_plus_sched_le_serv_of_task_plus_task_interference:
            interference j t + scheduled_at sched j t
            <= service_of_jobs_at (job_of_task tsk) (arrivals_between t1 (t1 + A + ε)) t
              + task_interference_received_before tsk t2 t.
          Proof.
            move: (H_busy_interval) => [[/andP [BUS LT] _] _].
            case SCHEDt: (sched t) => [j1 | ].
            2: by apply interference_plus_sched_le_serv_of_task_plus_task_interference_idle.
            have ARRs: arrives_in arr_seq j1;
              first by apply H_jobs_come_from_arrival_sequence with t; rewrite scheduled_at_def; apply/eqP.
            case_eq (job_task j1 == tsk) => TSK.
            2: by eapply interference_plus_sched_le_serv_of_task_plus_task_interference_task; [eassumption| apply/negbT].
            case EQ: (j == j1); [move: EQ => /eqP EQ; subst j1 | ].
            1: by apply interference_plus_sched_le_serv_of_task_plus_task_interference_j.
            eapply interference_plus_sched_le_serv_of_task_plus_task_interference_job;
              auto; repeat split; eauto; apply/eqP; move: EQ => /eqP EQ; auto.
          Qed.

        End CaseAnalysis.

        (** Next we prove cumulative version of the lemma above. *)
        Lemma cumul_interference_plus_sched_le_serv_of_task_plus_cumul_task_interference:
          cumul_interference j t1 (t1 + x)
          <= (task_service_of_jobs_in (arrivals_between t1 (t1 + A + ε)) t1 (t1 + x)
             - service_during sched j t1 (t1 + x)) + cumul_task_interference t2 t1 (t1 + x).
        Proof.
          have j_is_in_arrivals_between: j \in arrivals_between t1 (t1 + A + ε).
          { eapply arrived_between_implies_in_arrivals; eauto 2.
            move: (H_busy_interval) => [[/andP [GE _] [_ _]] _].
              by apply/andP; split; last rewrite /A subnKC // addn1.
          }
          rewrite /cumul_interference /cumul_interference /task_service_of_jobs_in
          /service_of_jobs.task_service_of_jobs_in
          /service_of_jobs exchange_big //=.
          rewrite -(leq_add2r (\sum_(t1 <= t < (t1 + x)) service_at sched j t)).
          rewrite [X in _ <= X]addnC addnA subnKC; last first.
          { rewrite exchange_big //= (big_rem j) //=; auto using j_is_in_arrivals_between.
              by rewrite /job_of_task H_job_of_tsk eq_refl leq_addr. }
          rewrite -big_split -big_split //=.
          rewrite big_nat_cond [X in _ <= X]big_nat_cond leq_sum //; move => t /andP [NEQ _].
          rewrite -scheduled_at_def.
            by apply interference_plus_sched_le_serv_of_task_plus_task_interference.
        Qed.

        (** On the other hand, the service terms in the inequality
           above can be upper-bound by the workload terms. *)
        Lemma serv_of_task_le_workload_of_task_plus:
          task_service_of_jobs_in (arrivals_between t1 (t1 + A + ε)) t1 (t1 + x)
          - service_during sched j t1 (t1 + x) + cumul_task_interference t2 t1 (t1 + x)
          <= (task_workload_between t1 (t1 + A + ε) - job_cost j)
            + cumul_task_interference t2 t1 (t1 + x).
        Proof.
          have j_is_in_arrivals_between: j \in arrivals_between t1 (t1 + A + ε).
          { eapply arrived_between_implies_in_arrivals; eauto 2.
            move: (H_busy_interval) => [[/andP [GE _] [_ _]] _].
              by apply/andP; split; last rewrite /A subnKC // addn1.
          }
          rewrite leq_add2r.
          rewrite /task_workload /task_service_of_jobs_in
                  /service_of_jobs.task_service_of_jobs_in/service_of_jobs /workload_of_jobs /job_of_task.
          rewrite (big_rem j) ?[X in _ <= X - _](big_rem j) //=; auto using j_is_in_arrivals_between.
          rewrite /job_of_task  H_job_of_tsk eq_refl.
          rewrite addnC -addnBA; last by done.
          rewrite [X in _ <= X - _]addnC -addnBA; last by done.
          rewrite !subnn !addn0.
            by apply service_of_jobs_le_workload; auto using ideal_proc_model_provides_unit_service.
        Qed.

        (** Finally, we show that the cumulative interference of job j in the interval <<[t1, t1 + x)>>
           is bounded by the sum of the task workload in the interval [t1, t1 + A + ε) and
           the cumulative interference of [j]'s task in the interval [t1, t1 + x). *)
        Lemma cumulative_job_interference_le_task_interference_bound:
          cumul_interference j t1 (t1 + x)
          <= (task_workload_between t1 (t1 + A + ε) - job_cost j)
            + cumul_task_interference t2 t1 (t1 + x).
        Proof.
          apply leq_trans with
              (task_service_of_jobs_in (arrivals_between t1 (t1 + A + ε)) t1 (t1 + x)
               - service_during sched j t1 (t1 + x)
               + cumul_task_interference t2 t1 (t1 + x));
            [ apply cumul_interference_plus_sched_le_serv_of_task_plus_cumul_task_interference
            | apply serv_of_task_le_workload_of_task_plus].
        Qed.

      End TaskInterferenceBoundsInterference.

      (** In order to obtain a more convenient bound of the cumulative interference, we need to
         abandon the actual workload in favor of a bound which depends on task parameters only.
         So, we show that actual workload of the task excluding workload of any job [j] is no
         greater than bound of workload excluding the cost of job [j]'s task. *)
      Lemma task_rbf_excl_tsk_bounds_task_workload_excl_j:
        task_workload_between t1 (t1 + A + ε) - job_cost j <= task_rbf (A + ε) - task_cost tsk.
      Proof.
        move: H_j_arrives H_job_of_tsk H_busy_interval => ARR TSK [[/andP [JAGET1 JALTT2] _] _].
        apply leq_trans with
            (task_cost tsk * number_of_task_arrivals arr_seq tsk t1 (t1 + A + ε) - task_cost tsk); last first.
        { rewrite leq_sub2r // leq_mul2l; apply/orP; right.
          rewrite -addnA -{2}[(A+1)](addKn t1).
            by apply H_is_arrival_curve; auto using leq_addr. }
        have Fact6: j \in arrivals_between (t1 + A) (t1 + A + ε).
        { apply arrived_between_implies_in_arrivals; try done.
          apply/andP; split; rewrite /A subnKC //.
            by rewrite addn1 ltnSn //. }
        have Fact4: j \in arrivals_at arr_seq (t1 + A).
        { by move: ARR => [t ARR]; rewrite subnKC //; feed (H_arrival_times_are_consistent j t); try (subst t). }
        have Fact1: 1 <= number_of_task_arrivals arr_seq tsk (t1 + A) (t1 + A + ε).
        { rewrite /number_of_task_arrivals /task_arrivals_between /arrival_sequence.arrivals_between.
            by rewrite -count_filter_fun -has_count; apply/hasP; exists j; last rewrite TSK.
        }
        rewrite (@num_arrivals_of_task_cat _ _ _ _ _ (t1 + A)); last by apply/andP; split; rewrite leq_addr //.
        rewrite mulnDr.
        have Step1: task_workload_between t1 (t1 + A + ε)
                    = task_workload_between t1 (t1 + A) + task_workload_between (t1 + A) (t1 + A + ε).
        { by apply workload_of_jobs_cat; apply/andP; split; rewrite leq_addr. } rewrite Step1; clear Step1.
        rewrite -!addnBA; first last.
        { by rewrite /task_workload_between /workload.task_workload_between /task_workload
                     /workload_of_jobs /job_of_task (big_rem j) //=  TSK eq_refl leq_addr. }
        { apply leq_trans with (task_cost tsk); first by done.
            by rewrite -{1}[task_cost tsk]muln1 leq_mul2l; apply/orP; right. }
        rewrite leq_add; [by done | by eapply task_workload_le_num_of_arrivals_times_cost; eauto | ].
        rewrite /task_workload_between /workload.task_workload_between /task_workload /workload_of_jobs
                /arrival_sequence.arrivals_between /number_of_task_arrivals /task_arrivals_between
                /arrival_sequence.arrivals_between /job_of_task.
        rewrite {1}addn1 big_nat1 addn1 big_nat1.
        rewrite (big_rem j) //= TSK !eq_refl; simpl.
        rewrite addnC -addnBA // subnn addn0.
        rewrite (filter_size_rem _ j); [ | by done | by rewrite TSK].
        rewrite mulnDr mulnC muln1 -addnBA // subnn addn0 mulnC.
        apply sum_majorant_constant.
        move => j' ARR' /eqP TSK2.
          by rewrite -TSK2; apply H_valid_job_cost; exists (t1 + A); apply rem_in in ARR'.
      Qed.

      (** Finally, we use the lemmas above to obtain the bound on
         [interference] in terms of [task_rbf] and [task_interference]. *)
      Lemma cumulative_job_interference_bound:
        cumul_interference j t1 (t1 + x)
        <= (task_rbf (A + ε) - task_cost tsk) + cumul_task_interference t2 t1 (t1 + x).
      Proof.
        set (y := t1 + x) in *.
        have IN: j \in arrivals_between t1 (t1 + A + ε).
        { eapply arrived_between_implies_in_arrivals; eauto 2.
          move: (H_busy_interval) => [[/andP [GE _] _] _].
            by apply/andP; split; last rewrite /A subnKC // addn1.
        }
        apply leq_trans with (task_workload_between t1 (t1+A+ε) - job_cost j + cumul_task_interference t2 t1 y).
        - by apply cumulative_job_interference_le_task_interference_bound.
        - rewrite leq_add2r.
          eapply task_rbf_excl_tsk_bounds_task_workload_excl_j; eauto 2.
      Qed.

    End BoundOfCumulativeJobInterference.

    (** In this section, we prove that [H_R_is_maximum_seq] implies [H_R_is_maximum]. *)
    Section MaxInSeqHypothesisImpMaxInNonseqHypothesis.

      (** Consider any job [j] of [tsk]. *)
      Variable j : Job.
      Hypothesis H_j_arrives : arrives_in arr_seq j.
      Hypothesis H_job_of_tsk : job_task j = tsk.

      (** For simplicity, let's define a local name for the search space. *)
      Let is_in_search_space A :=
        is_in_search_space tsk L total_interference_bound A.

      (** We prove that [H_R_is_maximum] holds. *)
      Lemma max_in_seq_hypothesis_implies_max_in_nonseq_hypothesis:
        forall (A : duration),
          is_in_search_space A ->
          exists (F : duration),
            A + F = task_run_to_completion_threshold tsk +
                    (task_rbf (A + ε) - task_cost tsk + task_interference_bound_function tsk A (A + F)) /\
            F + (task_cost tsk - task_run_to_completion_threshold tsk) <= R.
      Proof.
        move: H_valid_run_to_completion_threshold => [PRT1 PRT2].
        intros A INSP.
        clear H_sequential_tasks H_interference_and_workload_consistent_with_sequential_tasks.
        move: (H_R_is_maximum_seq _ INSP) => [F [FIX LE]].
        exists F; split; last by done.
        rewrite {1}FIX.
        apply/eqP.
        rewrite addnA eqn_add2r.
        rewrite addnBA; last first.
        { apply leq_trans with (task_rbf 1).
          eapply task_rbf_1_ge_task_cost; eauto 2.
              eapply task_rbf_monotone; eauto 2.
                by rewrite addn1.
        }
          by rewrite subnBA; auto; rewrite addnC.
      Qed.

    End MaxInSeqHypothesisImpMaxInNonseqHypothesis.

    (** Finally, we apply the [uniprocessor_response_time_bound] theorem, and using the
       lemmas above, we prove that all the requirements are satisfied. So, R is a response
       time bound. *)
    Theorem uniprocessor_response_time_bound_seq:
      response_time_bounded_by tsk R.
    Proof.
      intros j ARR TSK.
      eapply uniprocessor_response_time_bound with
          (interference_bound_function :=
             fun tsk A R => task_rbf (A + ε) - task_cost tsk + task_interference_bound_function tsk A R)
          (interfering_workload0 := interfering_workload); eauto 2.
      apply ideal_proc_model_ensures_ideal_progress.
      apply ideal_proc_model_provides_unit_service.
      { clear ARR TSK H_R_is_maximum_seq R j.
        intros t1 t2 R j BUSY NEQ ARR TSK COMPL.
        move: (posnP (@job_cost _ H3 j)) => [ZERO|POS].
        { exfalso.
          move: COMPL => /negP COMPL; apply: COMPL.
            by rewrite /service.completed_by /completed_by ZERO.
        }
        set (A := job_arrival j - t1) in *.
        apply leq_trans with
            (task_rbf (A + ε) - task_cost tsk + cumul_task_interference t2 t1 (t1 + R)).
        - by eapply cumulative_job_interference_bound; eauto 2.
        - by rewrite leq_add2l; apply H_task_interference_is_bounded.
      }
      { by eapply max_in_seq_hypothesis_implies_max_in_nonseq_hypothesis; eauto. }
    Qed.

  End ResponseTimeBound.

End Sequential_Abstract_RTA.


Require Export CatSem.PCF_order_comp.RPCF_rep_hom.

Set Implicit Arguments.
Unset Strict Implicit.
Unset Transparent Obligations.
Unset Automatic Introduction.

Section id_rep.

Variable P : PCFPO_rep.

Definition id_rep_car c:
(forall t : type_type P,
  (retype_ipo (fun u : type_type P => u) (P c)) t ->
  (P (retype (fun u : type_type P => u) c)) t) :=
fun  t y =>
   match y with ctype _ z =>
     rlift P (@id_retype _ c) _ z end.

Obligation Tactic :=
  intros; do 2 red;
  simpl; intros;
  try match goal with [H: retype_ord _ _ |- _ ] => induction H end;
  try apply IPO_mor_monotone; auto.

Program Instance id_rep_pos c:
ipo_mor_struct (a:=retype_ipo (fun u : type_type P => u) (P c))
  (b:=P (retype (fun u : type_type P => u) c)) (@id_rep_car c).

Definition id_rep_po c := Build_ipo_mor (id_rep_pos c).

Definition id_rep_c :
(forall c : ITYPE (type_type P),
  (RETYPE_PO (fun u : type_type P => u)) (P c) --->
  P ((RETYPE (fun u : type_type P => u)) c)) :=
      id_rep_po.

Ltac elim_retype := match goal with
    [y : retype _ _ _ |- _ ] => destruct y end.

Obligation Tactic := cat; repeat elim_retype;
  cat;
  try rew (rlift_rweta P);
  try rew (rlift_rkleisli (M:=P));
  try rew (rkleisli_rlift (M:=P));
  try apply (rkl_eq P); cat.

Program Instance RMon_id_s :
  gen_RMonad_Hom_struct (P:=P) (Q:=P)
   (G1:=RETYPE (fun u : type_type P => u))
   (G2:=RETYPE_PO (fun u : type_type P => u))
   (NNNT1 (fun u : type_type P => u)) id_rep_c.

Definition RMon_id := Build_gen_RMonad_Hom RMon_id_s.

Obligation Tactic := simpl; intros; unfold rlift;
  match goal with [|- _ = (_ _ _ ((rmodule_hom ?H) _ )) _ ] =>
  rerew  (rmod_hom_rmkl H) end;
  try apply f_equal; try rew (rklkl P); try apply (rkl_eq P);
  simpl; intros; try rew (retakl P); elim_opt;
  try rew (rlift_rweta P); auto.

Program Instance PCFPO_id_struct : PCFPO_rep_Hom_struct
   (P:=P) (R:=P)
   (f:=fun u => u) (fun u => eq_refl) RMon_id.

Definition PCFPO_id := Build_PCFPO_rep_Hom PCFPO_id_struct.

End id_rep.


(**
Coqでの形式化された不完全性定理の証明
========

ご注意。この資料は、可導性条件から形式化された第一不完全性定理と第二不完全性定理を求めよう
としたものですが、本文中にも述べているように、可導性条件のひとつに不適切な箇所があります。
それを理解したうえで、定理証明支援系による形式化の試みのひとつとして、みていただきたいとお
もいます。

2014/12/08 @suharahiromichi

2015/10/11 @suharahiromichi D1についての注意を加筆した。

この文章のソースコードは以下にあります。

https://github.com/suharahiromichi/coq/blob/master/tit/tit_formal.v
 *)

(**
# はじめに

菊池誠さん著「不完全性定理」共立出版 2014 の 7.4節と7.5節の形式化された
第一不完全性定理と第二不完全性定理の証明をCoq SSReflectに写してみた。

原則として説明は省くので、必要に応じてオリジナルを参照してください。
*)

From mathcomp Require Import ssreflect ssrbool eqtype ssrnat.
Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.

(**
# 準備

## 古典論理の公理

全体に、排中律や二重否定除去を使用するので、古典論理をインポートする。
*)

Require Import Coq.Logic.Decidable.
Require Import Coq.Logic.Classical.
Check classic : forall P : Prop, P \/ ~ P.
Check not_not : forall P : Prop, decidable P -> ~ ~ P -> P.

(**
## 命題論理の公理

2.3節で導入された「命題論理の公理」をCoqの枠組みの中で証明しておく。
*)

Lemma Ax1 {φ ψ : Prop} : φ -> (ψ -> φ).
Proof.
  move=> Hpai Hpsi.
  by apply: Hpai.
Qed.

Lemma Ax2 {φ ψ ρ : Prop} : (φ -> (ψ -> ρ)) -> ((φ -> ψ) -> (φ -> ρ)).
Proof.
  move=> H1 H2 Hpai.
  apply: H1.
  - by apply: Hpai.
  - by apply: H2; apply: Hpai.
Qed.

Lemma Ax3 {φ ψ : Prop} : (~ φ -> ~ ψ) -> (ψ -> φ).
Proof.
  apply contrapositive.
  - by apply: classic.
Qed.

(**
対偶については、他の組み合わせも証明しておく。
 *)
Lemma Ax31 (φ ψ : Prop) : (φ -> ψ) -> (~ ψ -> ~ φ).
Proof.
  move=> H Hnpai Hpsi.
  by apply: Hnpai; apply: H; apply: Hpsi.
Qed.

Lemma Ax32 (φ ψ : Prop) : (φ -> ~ ψ) -> (ψ -> ~ φ).
Proof.
  by move=> H /H.
Qed.

Lemma Ax33 (φ ψ : Prop) : (~ φ -> ψ) -> (~ ψ -> φ).
Proof.
  move=> H.
  apply: Ax3 => Hnpai Hnpsi.
  by apply: Hnpsi; apply: H; apply: Hnpai.
Qed.

(*
以下は使用しない：

Variable model theory : Set.
Variable T : theory.
Variable v : model.
Variable assertion : theory -> Prop -> Prop.
Variable models : model -> Prop -> Prop.
Notation "T ⊦ φ" := (assertion T φ) (at level 100, no associativity).
Notation "v ⊧ φ" := (models v φ) (at level 100, no associativity).
*)

(**
## 可導性条件

本資料では、7.4節で導入された可動性条件を出発点とする。

- 言語Lを、算術の言語 LA={0,1,+,・,≦} を含み、ゲーデル数化を伴う言語とする。
- 理論Tを、ペアノ算術を含む言語Lの理論とする。

理論Tの上で、次のD1,D2,D3が成立するものとする。ただし、

- ⌜φ⌝は、論理式φのゲーデル数化（エンコード）した自然数を示す。
- PrT(x)は、自然数xに対する、論理Tで証明のある論理式を示す。
*)

Variable enc : Prop -> nat.
Notation "⌜ φ ⌝" := (enc φ) (at level 9, no associativity).
Variable PrT : nat -> Prop.

Axiom D1' : forall {φ : Prop}, φ -> PrT ⌜φ⌝. (* 注意 *)
Axiom D2 : forall {φ ψ : Prop}, (PrT ⌜φ -> ψ⌝) -> PrT ⌜φ⌝ -> PrT ⌜ψ⌝.
Axiom D3 : forall {φ : Prop}, PrT ⌜φ⌝ -> PrT ⌜(PrT ⌜φ⌝)⌝.

(**
注意：D1'について：

D1 は、正しくは、「T ⊦ φ ならば T ⊦ PrT(⌜φ⌝)」 である。

- D3 は、このD1を形式化したものである。
D3は、D1がT上で形式化できる（形式的に証明できる）ことを主張している。
- φをΣ1論理式に制限したD1'が、定理7.4.4である。
PrT(⌜φ⌝)は、Σ1論理式なので、定理7.4.4からD3を求めることはできる。
- D1' は定理7.4.4より前提が弱いので、D1'からD3を求めることができてしまう。

以上より、D1 に代えて D1' を使うのは適切とはいえない。
そのため、以下の証明のうち D1' を使う箇所は改める必要がある。
*)

Lemma L7_4_3 (φ ψ : Prop) : (φ -> ψ) -> PrT ⌜φ⌝ -> PrT ⌜ψ⌝.
Proof.
  move=> H.
  by apply: D2; apply: D1'; apply: H.       (* 注意 *)
Qed.

Lemma L7_5_3 (φ : Prop) :
  (PrT ⌜φ⌝ -> PrT ⌜~ φ⌝) -> (PrT ⌜φ⌝ -> PrT ⌜0 = 1⌝).
Proof.
  Check (@Ax2 (PrT ⌜~ φ⌝) (PrT ⌜0 = 1⌝)).
  apply: Ax2 => H.
  apply: D2.
  have Hcontra : φ -> (~ φ -> 0 = 1) by [].
  move/L7_4_3 in Hcontra.
  apply: Hcontra.
  by apply: H.
Qed.

Lemma L7_5_4 (φ : Prop) :
  (PrT ⌜~ φ⌝ -> PrT ⌜φ⌝) -> (PrT ⌜~ φ⌝ -> PrT ⌜0 = 1⌝).
Proof.
  apply: Ax2.
  move=> H.
  apply: D2.
  have Hcontra : ~ φ -> (φ -> 0 = 1) by [].
  move/L7_4_3 in Hcontra.
  apply Hcontra.
  by apply H.
Qed.

(**
# ゲーデル文と無矛盾性をあらわす文
 *)

(** ゲーデル文 σ *)
Variable σ : Prop.

(** ゲーデル文の満たす性質 *)
Axiom G : σ <-> ~ PrT ⌜σ⌝.

(** 無矛盾性をあらわす文 Con *)
Definition Con := ~ PrT ⌜0 = 1⌝.

(**
# 第一不完全性定理
*)

(**
## 第一不完全性定理 (1)

Tが無矛盾ならば、σを導けない(T ⊬ σ) 。
*)
Theorem T7_5_5_1 : Con -> ~ PrT ⌜σ⌝.
Proof.
  have G' : PrT ⌜σ⌝ -> ~ σ.
  - move=> G2 /G.
    apply.
    by apply: G2.
  apply: Ax31; apply: L7_5_3.
  move/D3.
  by apply: L7_4_3; apply: G'.
Qed.

(**
## 第一不完全性定理 (2)

TがΣ1健全ならば、~σを導けない(T ⊬ ~σ) 。

ただし、「TがΣ1健全である」を以下のように弱める。

- Tが無矛盾であること(前提の/\の右のCom)、かつ、
- T ⊦ PrT ⌜σ⌝ ならば、T ⊦ σ である(前提の/\の左)。
*)
Theorem T7_5_5_2 :
  (PrT ⌜(PrT ⌜σ⌝)⌝ -> PrT ⌜σ⌝) /\ Con -> ~ PrT ⌜~ σ⌝.
Proof.
  case=> H.
  apply Ax3 => H1.
  apply not_not in H1.
  - apply.
    apply: (@L7_5_4 σ).
    + move=> H2.
      have G' : ~ σ -> PrT ⌜σ ⌝ by apply Ax33 => /G.
      * move/(@L7_4_3 (~ σ) (PrT ⌜σ⌝)) in G'.
        apply: H; apply: G'.
        by apply: H1.
    + by apply: H1.
  - by apply: classic.
Qed.

(**
# 第二不完全性定理
 *)
Lemma L7_5_8 : Con <-> σ.
Proof.
  split.
  (* -> *)
  - move=> H.
    apply G.
    by apply T7_5_5_1 in H.
  (* <- *)
  - move/G.
    apply: Ax31.
    by apply: L7_4_3.
Qed.

(**
Tが無矛盾ならは、Comを導けない(T ⊬ Com)。
*)
Theorem T7_5_13 : Con -> ~ PrT ⌜Con⌝.
Proof.
  apply: Ax31.
  move/(L7_4_3 (iffLR L7_5_8)).
  apply: Ax3.
  by apply: T7_5_5_1.
Qed.

(* END *)